sys-file-reader: Fix memory leak.
[pspp] / src / data / sys-file-reader.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-2000, 2006-2007, 2009-2012 Free Software Foundation, Inc.
3
4    This program is free software: you can redistribute it and/or modify
5    it under the terms of the GNU General Public License as published by
6    the Free Software Foundation, either version 3 of the License, or
7    (at your option) any later version.
8
9    This program is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12    GNU General Public License for more details.
13
14    You should have received a copy of the GNU General Public License
15    along with this program.  If not, see <http://www.gnu.org/licenses/>. */
16
17 #include <config.h>
18
19 #include "data/sys-file-reader.h"
20 #include "data/sys-file-private.h"
21
22 #include <errno.h>
23 #include <float.h>
24 #include <inttypes.h>
25 #include <setjmp.h>
26 #include <stdlib.h>
27
28 #include "data/attributes.h"
29 #include "data/case.h"
30 #include "data/casereader-provider.h"
31 #include "data/casereader.h"
32 #include "data/dictionary.h"
33 #include "data/file-handle-def.h"
34 #include "data/file-name.h"
35 #include "data/format.h"
36 #include "data/identifier.h"
37 #include "data/missing-values.h"
38 #include "data/mrset.h"
39 #include "data/short-names.h"
40 #include "data/value-labels.h"
41 #include "data/value.h"
42 #include "data/variable.h"
43 #include "libpspp/array.h"
44 #include "libpspp/assertion.h"
45 #include "libpspp/compiler.h"
46 #include "libpspp/i18n.h"
47 #include "libpspp/message.h"
48 #include "libpspp/misc.h"
49 #include "libpspp/pool.h"
50 #include "libpspp/str.h"
51 #include "libpspp/stringi-set.h"
52
53 #include "gl/c-ctype.h"
54 #include "gl/inttostr.h"
55 #include "gl/localcharset.h"
56 #include "gl/minmax.h"
57 #include "gl/unlocked-io.h"
58 #include "gl/xalloc.h"
59 #include "gl/xsize.h"
60
61 #include "gettext.h"
62 #define _(msgid) gettext (msgid)
63 #define N_(msgid) (msgid)
64
65 enum
66   {
67     /* subtypes 0-2 unknown */
68     EXT_INTEGER       = 3,      /* Machine integer info. */
69     EXT_FLOAT         = 4,      /* Machine floating-point info. */
70     EXT_VAR_SETS      = 5,      /* Variable sets. */
71     EXT_DATE          = 6,      /* DATE. */
72     EXT_MRSETS        = 7,      /* Multiple response sets. */
73     EXT_DATA_ENTRY    = 8,      /* SPSS Data Entry. */
74     /* subtypes 9-10 unknown */
75     EXT_DISPLAY       = 11,     /* Variable display parameters. */
76     /* subtype 12 unknown */
77     EXT_LONG_NAMES    = 13,     /* Long variable names. */
78     EXT_LONG_STRINGS  = 14,     /* Long strings. */
79     /* subtype 15 unknown */
80     EXT_NCASES        = 16,     /* Extended number of cases. */
81     EXT_FILE_ATTRS    = 17,     /* Data file attributes. */
82     EXT_VAR_ATTRS     = 18,     /* Variable attributes. */
83     EXT_MRSETS2       = 19,     /* Multiple response sets (extended). */
84     EXT_ENCODING      = 20,     /* Character encoding. */
85     EXT_LONG_LABELS   = 21      /* Value labels for long strings. */
86   };
87
88 /* Fields from the top-level header record. */
89 struct sfm_header_record
90   {
91     char magic[5];              /* First 4 bytes of file, then null. */
92     int weight_idx;             /* 0 if unweighted, otherwise a var index. */
93     int nominal_case_size;      /* Number of var positions. */
94
95     /* These correspond to the members of struct sfm_file_info or a dictionary
96        but in the system file's encoding rather than ASCII. */
97     char creation_date[10];     /* "dd mmm yy". */
98     char creation_time[9];      /* "hh:mm:ss". */
99     char eye_catcher[61];       /* Eye-catcher string, then product name. */
100     char file_label[65];        /* File label. */
101   };
102
103 struct sfm_var_record
104   {
105     off_t pos;
106     int width;
107     char name[8];
108     int print_format;
109     int write_format;
110     int missing_value_code;
111     uint8_t missing[24];
112     char *label;
113     struct variable *var;
114   };
115
116 struct sfm_value_label
117   {
118     uint8_t value[8];
119     char *label;
120   };
121
122 struct sfm_value_label_record
123   {
124     off_t pos;
125     struct sfm_value_label *labels;
126     size_t n_labels;
127
128     int *vars;
129     size_t n_vars;
130   };
131
132 struct sfm_document_record
133   {
134     off_t pos;
135     char *documents;
136     size_t n_lines;
137   };
138
139 struct sfm_extension_record
140   {
141     off_t pos;                  /* Starting offset in file. */
142     size_t size;                /* Size of data elements. */
143     size_t count;               /* Number of data elements. */
144     void *data;                 /* Contents. */
145   };
146
147 /* System file reader. */
148 struct sfm_reader
149   {
150     /* Resource tracking. */
151     struct pool *pool;          /* All system file state. */
152     jmp_buf bail_out;           /* longjmp() target for error handling. */
153
154     /* File state. */
155     struct file_handle *fh;     /* File handle. */
156     struct fh_lock *lock;       /* Mutual exclusion for file handle. */
157     FILE *file;                 /* File stream. */
158     off_t pos;                  /* Position in file. */
159     bool error;                 /* I/O or corruption error? */
160     struct caseproto *proto;    /* Format of output cases. */
161
162     /* File format. */
163     enum integer_format integer_format; /* On-disk integer format. */
164     enum float_format float_format; /* On-disk floating point format. */
165     struct sfm_var *sfm_vars;   /* Variables. */
166     size_t sfm_var_cnt;         /* Number of variables. */
167     casenumber case_cnt;        /* Number of cases */
168     const char *encoding;       /* String encoding. */
169
170     /* Decompression. */
171     bool compressed;            /* File is compressed? */
172     double bias;                /* Compression bias, usually 100.0. */
173     uint8_t opcodes[8];         /* Current block of opcodes. */
174     size_t opcode_idx;          /* Next opcode to interpret, 8 if none left. */
175     bool corruption_warning;    /* Warned about possible corruption? */
176   };
177
178 static const struct casereader_class sys_file_casereader_class;
179
180 static bool close_reader (struct sfm_reader *);
181
182 static struct variable *lookup_var_by_index (struct sfm_reader *, off_t,
183                                              const struct sfm_var_record *,
184                                              size_t n, int idx);
185
186 static void sys_msg (struct sfm_reader *r, off_t, int class,
187                      const char *format, va_list args)
188      PRINTF_FORMAT (4, 0);
189 static void sys_warn (struct sfm_reader *, off_t, const char *, ...)
190      PRINTF_FORMAT (3, 4);
191 static void sys_error (struct sfm_reader *, off_t, const char *, ...)
192      PRINTF_FORMAT (3, 4)
193      NO_RETURN;
194
195 static void read_bytes (struct sfm_reader *, void *, size_t);
196 static bool try_read_bytes (struct sfm_reader *, void *, size_t);
197 static int read_int (struct sfm_reader *);
198 static double read_float (struct sfm_reader *);
199 static void read_string (struct sfm_reader *, char *, size_t);
200 static void skip_bytes (struct sfm_reader *, size_t);
201
202 static int parse_int (struct sfm_reader *, const void *data, size_t ofs);
203 static double parse_float (struct sfm_reader *, const void *data, size_t ofs);
204
205 static void read_variable_record (struct sfm_reader *,
206                                   struct sfm_var_record *);
207 static void read_value_label_record (struct sfm_reader *,
208                                      struct sfm_value_label_record *,
209                                      size_t n_vars);
210 static struct sfm_document_record *read_document_record (struct sfm_reader *);
211 static struct sfm_extension_record *read_extension_record (
212   struct sfm_reader *, int subtype);
213 static void skip_extension_record (struct sfm_reader *, int subtype);
214
215 static const char *choose_encoding (
216   struct sfm_reader *,
217   const struct sfm_header_record *,
218   const struct sfm_extension_record *ext_integer,
219   const struct sfm_extension_record *ext_encoding);
220
221 static struct text_record *open_text_record (
222   struct sfm_reader *, const struct sfm_extension_record *,
223   bool recode_to_utf8);
224 static void close_text_record (struct sfm_reader *,
225                                struct text_record *);
226 static bool read_variable_to_value_pair (struct sfm_reader *,
227                                          struct dictionary *,
228                                          struct text_record *,
229                                          struct variable **var, char **value);
230 static void text_warn (struct sfm_reader *r, struct text_record *text,
231                        const char *format, ...)
232   PRINTF_FORMAT (3, 4);
233 static char *text_get_token (struct text_record *,
234                              struct substring delimiters, char *delimiter);
235 static bool text_match (struct text_record *, char c);
236 static bool text_read_variable_name (struct sfm_reader *, struct dictionary *,
237                                      struct text_record *,
238                                      struct substring delimiters,
239                                      struct variable **);
240 static bool text_read_short_name (struct sfm_reader *, struct dictionary *,
241                                   struct text_record *,
242                                   struct substring delimiters,
243                                   struct variable **);
244 static const char *text_parse_counted_string (struct sfm_reader *,
245                                               struct text_record *);
246 static size_t text_pos (const struct text_record *);
247
248 static bool close_reader (struct sfm_reader *r);
249 \f
250 /* Dictionary reader. */
251
252 enum which_format
253   {
254     PRINT_FORMAT,
255     WRITE_FORMAT
256   };
257
258 static void read_header (struct sfm_reader *, struct sfm_read_info *,
259                          struct sfm_header_record *);
260 static void parse_header (struct sfm_reader *,
261                           const struct sfm_header_record *,
262                           struct sfm_read_info *, struct dictionary *);
263 static void parse_variable_records (struct sfm_reader *, struct dictionary *,
264                                     struct sfm_var_record *, size_t n);
265 static void parse_format_spec (struct sfm_reader *, off_t pos,
266                                unsigned int format, enum which_format,
267                                struct variable *, int *format_warning_cnt);
268 static void parse_document (struct dictionary *, struct sfm_document_record *);
269 static void parse_display_parameters (struct sfm_reader *,
270                                       const struct sfm_extension_record *,
271                                       struct dictionary *);
272 static void parse_machine_integer_info (struct sfm_reader *,
273                                         const struct sfm_extension_record *,
274                                         struct sfm_read_info *);
275 static void parse_machine_float_info (struct sfm_reader *,
276                                       const struct sfm_extension_record *);
277 static void parse_mrsets (struct sfm_reader *,
278                           const struct sfm_extension_record *,
279                           struct dictionary *);
280 static void parse_long_var_name_map (struct sfm_reader *,
281                                      const struct sfm_extension_record *,
282                                      struct dictionary *);
283 static void parse_long_string_map (struct sfm_reader *,
284                                    const struct sfm_extension_record *,
285                                    struct dictionary *);
286 static void parse_value_labels (struct sfm_reader *, struct dictionary *,
287                                 const struct sfm_var_record *,
288                                 size_t n_var_recs,
289                                 const struct sfm_value_label_record *);
290 static void parse_data_file_attributes (struct sfm_reader *,
291                                         const struct sfm_extension_record *,
292                                         struct dictionary *);
293 static void parse_variable_attributes (struct sfm_reader *,
294                                        const struct sfm_extension_record *,
295                                        struct dictionary *);
296 static void parse_long_string_value_labels (struct sfm_reader *,
297                                             const struct sfm_extension_record *,
298                                             struct dictionary *);
299
300 /* Frees the strings inside INFO. */
301 void
302 sfm_read_info_destroy (struct sfm_read_info *info)
303 {
304   if (info)
305     {
306       free (info->creation_date);
307       free (info->creation_time);
308       free (info->product);
309     }
310 }
311
312 /* Opens the system file designated by file handle FH for reading.  Reads the
313    system file's dictionary into *DICT.
314
315    Ordinarily the reader attempts to automatically detect the character
316    encoding based on the file's contents.  This isn't always possible,
317    especially for files written by old versions of SPSS or PSPP, so specifying
318    a nonnull ENCODING overrides the choice of character encoding.
319
320    If INFO is non-null, then it receives additional info about the system file,
321    which the caller must eventually free with sfm_read_info_destroy() when it
322    is no longer needed. */
323 struct casereader *
324 sfm_open_reader (struct file_handle *fh, const char *volatile encoding,
325                  struct dictionary **dictp, struct sfm_read_info *infop)
326 {
327   struct sfm_reader *volatile r = NULL;
328   struct sfm_read_info info;
329
330   struct sfm_header_record header;
331
332   struct sfm_var_record *vars;
333   size_t n_vars, allocated_vars;
334
335   struct sfm_value_label_record *labels;
336   size_t n_labels, allocated_labels;
337
338   struct sfm_document_record *document;
339
340   struct sfm_extension_record *extensions[32];
341
342   struct dictionary *volatile dict = NULL;
343   size_t i;
344
345   /* Create and initialize reader. */
346   r = pool_create_container (struct sfm_reader, pool);
347   r->fh = fh_ref (fh);
348   r->lock = NULL;
349   r->file = NULL;
350   r->pos = 0;
351   r->error = false;
352   r->opcode_idx = sizeof r->opcodes;
353   r->corruption_warning = false;
354
355   memset (&info, 0, sizeof info);
356
357   /* TRANSLATORS: this fragment will be interpolated into
358      messages in fh_lock() that identify types of files. */
359   r->lock = fh_lock (fh, FH_REF_FILE, N_("system file"), FH_ACC_READ, false);
360   if (r->lock == NULL)
361     goto error;
362
363   r->file = fn_open (fh_get_file_name (fh), "rb");
364   if (r->file == NULL)
365     {
366       msg (ME, _("Error opening `%s' for reading as a system file: %s."),
367            fh_get_file_name (r->fh), strerror (errno));
368       goto error;
369     }
370
371   if (setjmp (r->bail_out))
372     goto error;
373
374   /* Read header. */
375   read_header (r, &info, &header);
376
377   vars = NULL;
378   n_vars = allocated_vars = 0;
379
380   labels = NULL;
381   n_labels = allocated_labels = 0;
382
383   document = NULL;
384
385   memset (extensions, 0, sizeof extensions);
386
387   for (;;)
388     {
389       int subtype;
390       int type;
391
392       type = read_int (r);
393       if (type == 999)
394         {
395           read_int (r);         /* Skip filler. */
396           break;
397         }
398
399       switch (type)
400         {
401         case 2:
402           if (n_vars >= allocated_vars)
403             vars = pool_2nrealloc (r->pool, vars, &allocated_vars,
404                                    sizeof *vars);
405           read_variable_record (r, &vars[n_vars++]);
406           break;
407
408         case 3:
409           if (n_labels >= allocated_labels)
410             labels = pool_2nrealloc (r->pool, labels, &allocated_labels,
411                                      sizeof *labels);
412           read_value_label_record (r, &labels[n_labels++], n_vars);
413           break;
414
415         case 4:
416           /* A Type 4 record is always immediately after a type 3 record,
417              so the code for type 3 records reads the type 4 record too. */
418           sys_error (r, r->pos, _("Misplaced type 4 record."));
419
420         case 6:
421           if (document != NULL)
422             sys_error (r, r->pos, _("Duplicate type 6 (document) record."));
423           document = read_document_record (r);
424           break;
425
426         case 7:
427           subtype = read_int (r);
428           if (subtype < 0 || subtype >= sizeof extensions / sizeof *extensions)
429             {
430               sys_warn (r, r->pos,
431                         _("Unrecognized record type 7, subtype %d.  Please "
432                           "send a copy of this file, and the syntax which "
433                           "created it to %s."),
434                         subtype, PACKAGE_BUGREPORT);
435               skip_extension_record (r, subtype);
436             }
437           else if (extensions[subtype] != NULL)
438             {
439               sys_warn (r, r->pos,
440                         _("Record type 7, subtype %d found here has the same "
441                           "type as the record found near offset 0x%llx.  "
442                           "Please send a copy of this file, and the syntax "
443                           "which created it to %s."),
444                         subtype, (long long int) extensions[subtype]->pos,
445                         PACKAGE_BUGREPORT);
446               skip_extension_record (r, subtype);
447             }
448           else
449             extensions[subtype] = read_extension_record (r, subtype);
450           break;
451
452         default:
453           sys_error (r, r->pos, _("Unrecognized record type %d."), type);
454           goto error;
455         }
456     }
457
458   /* Now actually parse what we read.
459
460      First, figure out the correct character encoding, because this determines
461      how the rest of the header data is to be interpreted. */
462   dict = dict_create (encoding
463                       ? encoding
464                       : choose_encoding (r, &header, extensions[EXT_INTEGER],
465                                          extensions[EXT_ENCODING]));
466   r->encoding = dict_get_encoding (dict);
467
468   /* These records don't use variables at all. */
469   if (document != NULL)
470     parse_document (dict, document);
471
472   if (extensions[EXT_INTEGER] != NULL)
473     parse_machine_integer_info (r, extensions[EXT_INTEGER], &info);
474
475   if (extensions[EXT_FLOAT] != NULL)
476     parse_machine_float_info (r, extensions[EXT_FLOAT]);
477
478   if (extensions[EXT_FILE_ATTRS] != NULL)
479     parse_data_file_attributes (r, extensions[EXT_FILE_ATTRS], dict);
480
481   parse_header (r, &header, &info, dict);
482
483   /* Parse the variable records, the basis of almost everything else. */
484   parse_variable_records (r, dict, vars, n_vars);
485
486   /* Parse value labels and the weight variable immediately after the variable
487      records.  These records use indexes into var_recs[], so we must parse them
488      before those indexes become invalidated by very long string variables. */
489   for (i = 0; i < n_labels; i++)
490     parse_value_labels (r, dict, vars, n_vars, &labels[i]);
491   if (header.weight_idx != 0)
492     {
493       struct variable *weight_var;
494
495       weight_var = lookup_var_by_index (r, 76, vars, n_vars,
496                                         header.weight_idx);
497       if (var_is_numeric (weight_var))
498         dict_set_weight (dict, weight_var);
499       else
500         sys_error (r, -1, _("Weighting variable must be numeric "
501                             "(not string variable `%s')."),
502                    var_get_name (weight_var));
503     }
504
505   if (extensions[EXT_DISPLAY] != NULL)
506     parse_display_parameters (r, extensions[EXT_DISPLAY], dict);
507
508   /* The following records use short names, so they need to be parsed before
509      parse_long_var_name_map() changes short names to long names. */
510   if (extensions[EXT_MRSETS] != NULL)
511     parse_mrsets (r, extensions[EXT_MRSETS], dict);
512
513   if (extensions[EXT_MRSETS2] != NULL)
514     parse_mrsets (r, extensions[EXT_MRSETS2], dict);
515
516   if (extensions[EXT_LONG_STRINGS] != NULL)
517     parse_long_string_map (r, extensions[EXT_LONG_STRINGS], dict);
518
519   /* Now rename variables to their long names. */
520   parse_long_var_name_map (r, extensions[EXT_LONG_NAMES], dict);
521
522   /* The following records use long names, so they need to follow renaming. */
523   if (extensions[EXT_VAR_ATTRS] != NULL)
524     parse_variable_attributes (r, extensions[EXT_VAR_ATTRS], dict);
525
526   if (extensions[EXT_LONG_LABELS] != NULL)
527     parse_long_string_value_labels (r, extensions[EXT_LONG_LABELS], dict);
528
529   /* Warn if the actual amount of data per case differs from the
530      amount that the header claims.  SPSS version 13 gets this
531      wrong when very long strings are involved, so don't warn in
532      that case. */
533   if (header.nominal_case_size != -1 && header.nominal_case_size != n_vars
534       && info.version_major != 13)
535     sys_warn (r, -1, _("File header claims %d variable positions but "
536                        "%zu were read from file."),
537               header.nominal_case_size, n_vars);
538
539   /* Create an index of dictionary variable widths for
540      sfm_read_case to use.  We cannot use the `struct variable's
541      from the dictionary we created, because the caller owns the
542      dictionary and may destroy or modify its variables. */
543   sfm_dictionary_to_sfm_vars (dict, &r->sfm_vars, &r->sfm_var_cnt);
544   pool_register (r->pool, free, r->sfm_vars);
545   r->proto = caseproto_ref_pool (dict_get_proto (dict), r->pool);
546
547   *dictp = dict;
548   if (infop)
549     *infop = info;
550   else
551     sfm_read_info_destroy (&info);
552
553   return casereader_create_sequential
554     (NULL, r->proto,
555      r->case_cnt == -1 ? CASENUMBER_MAX: r->case_cnt,
556                                        &sys_file_casereader_class, r);
557
558 error:
559   sfm_read_info_destroy (&info);
560   close_reader (r);
561   dict_destroy (dict);
562   *dictp = NULL;
563   return NULL;
564 }
565
566 /* Closes a system file after we're done with it.
567    Returns true if an I/O error has occurred on READER, false
568    otherwise. */
569 static bool
570 close_reader (struct sfm_reader *r)
571 {
572   bool error;
573
574   if (r == NULL)
575     return true;
576
577   if (r->file)
578     {
579       if (fn_close (fh_get_file_name (r->fh), r->file) == EOF)
580         {
581           msg (ME, _("Error closing system file `%s': %s."),
582                fh_get_file_name (r->fh), strerror (errno));
583           r->error = true;
584         }
585       r->file = NULL;
586     }
587
588   fh_unlock (r->lock);
589   fh_unref (r->fh);
590
591   error = r->error;
592   pool_destroy (r->pool);
593
594   return !error;
595 }
596
597 /* Destroys READER. */
598 static void
599 sys_file_casereader_destroy (struct casereader *reader UNUSED, void *r_)
600 {
601   struct sfm_reader *r = r_;
602   close_reader (r);
603 }
604
605 /* Returns true if FILE is an SPSS system file,
606    false otherwise. */
607 bool
608 sfm_detect (FILE *file)
609 {
610   char magic[5];
611
612   if (fread (magic, 4, 1, file) != 1)
613     return false;
614   magic[4] = '\0';
615
616   return !strcmp (ASCII_MAGIC, magic) || !strcmp (EBCDIC_MAGIC, magic);
617 }
618 \f
619 /* Reads the global header of the system file.  Initializes *HEADER and *INFO,
620    except for the string fields in *INFO, which parse_header() will initialize
621    later once the file's encoding is known. */
622 static void
623 read_header (struct sfm_reader *r, struct sfm_read_info *info,
624              struct sfm_header_record *header)
625 {
626   uint8_t raw_layout_code[4];
627   uint8_t raw_bias[8];
628
629   read_string (r, header->magic, sizeof header->magic);
630   read_string (r, header->eye_catcher, sizeof header->eye_catcher);
631
632   if (strcmp (ASCII_MAGIC, header->magic)
633       && strcmp (EBCDIC_MAGIC, header->magic))
634     sys_error (r, 0, _("This is not an SPSS system file."));
635
636   /* Identify integer format. */
637   read_bytes (r, raw_layout_code, sizeof raw_layout_code);
638   if ((!integer_identify (2, raw_layout_code, sizeof raw_layout_code,
639                           &r->integer_format)
640        && !integer_identify (3, raw_layout_code, sizeof raw_layout_code,
641                              &r->integer_format))
642       || (r->integer_format != INTEGER_MSB_FIRST
643           && r->integer_format != INTEGER_LSB_FIRST))
644     sys_error (r, 64, _("This is not an SPSS system file."));
645
646   header->nominal_case_size = read_int (r);
647   if (header->nominal_case_size < 0
648       || header->nominal_case_size > INT_MAX / 16)
649     header->nominal_case_size = -1;
650
651   r->compressed = read_int (r) != 0;
652
653   header->weight_idx = read_int (r);
654
655   r->case_cnt = read_int (r);
656   if ( r->case_cnt > INT_MAX / 2)
657     r->case_cnt = -1;
658
659   /* Identify floating-point format and obtain compression bias. */
660   read_bytes (r, raw_bias, sizeof raw_bias);
661   if (float_identify (100.0, raw_bias, sizeof raw_bias, &r->float_format) == 0)
662     {
663       uint8_t zero_bias[8] = { 0, 0, 0, 0, 0, 0, 0, 0 };
664
665       if (memcmp (raw_bias, zero_bias, 8))
666         sys_warn (r, r->pos - 8,
667                   _("Compression bias is not the usual "
668                     "value of 100, or system file uses unrecognized "
669                     "floating-point format."));
670       else
671         {
672           /* Some software is known to write all-zeros to this
673              field.  Such software also writes floating-point
674              numbers in the format that we expect by default
675              (it seems that all software most likely does, in
676              reality), so don't warn in this case. */
677         }
678
679       if (r->integer_format == INTEGER_MSB_FIRST)
680         r->float_format = FLOAT_IEEE_DOUBLE_BE;
681       else
682         r->float_format = FLOAT_IEEE_DOUBLE_LE;
683     }
684   float_convert (r->float_format, raw_bias, FLOAT_NATIVE_DOUBLE, &r->bias);
685
686   read_string (r, header->creation_date, sizeof header->creation_date);
687   read_string (r, header->creation_time, sizeof header->creation_time);
688   read_string (r, header->file_label, sizeof header->file_label);
689   skip_bytes (r, 3);
690
691   info->integer_format = r->integer_format;
692   info->float_format = r->float_format;
693   info->compressed = r->compressed;
694   info->case_cnt = r->case_cnt;
695 }
696
697 /* Reads a variable (type 2) record from R into RECORD. */
698 static void
699 read_variable_record (struct sfm_reader *r, struct sfm_var_record *record)
700 {
701   int has_variable_label;
702
703   memset (record, 0, sizeof *record);
704
705   record->pos = r->pos;
706   record->width = read_int (r);
707   has_variable_label = read_int (r);
708   record->missing_value_code = read_int (r);
709   record->print_format = read_int (r);
710   record->write_format = read_int (r);
711   read_bytes (r, record->name, sizeof record->name);
712
713   if (has_variable_label == 1)
714     {
715       enum { MAX_LABEL_LEN = 255 };
716       size_t len, read_len;
717
718       len = read_int (r);
719
720       /* Read up to MAX_LABEL_LEN bytes of label. */
721       read_len = MIN (MAX_LABEL_LEN, len);
722       record->label = pool_malloc (r->pool, read_len + 1);
723       read_string (r, record->label, read_len + 1);
724
725       /* Skip unread label bytes. */
726       skip_bytes (r, len - read_len);
727
728       /* Skip label padding up to multiple of 4 bytes. */
729       skip_bytes (r, ROUND_UP (len, 4) - len);
730     }
731   else if (has_variable_label != 0)
732     sys_error (r, record->pos,
733                _("Variable label indicator field is not 0 or 1."));
734
735   /* Set missing values. */
736   if (record->missing_value_code != 0)
737     {
738       int code = record->missing_value_code;
739       if (record->width == 0)
740         {
741           if (code < -3 || code > 3 || code == -1)
742             sys_error (r, record->pos,
743                        _("Numeric missing value indicator field is not "
744                          "-3, -2, 0, 1, 2, or 3."));
745         }
746       else
747         {
748           if (code < 1 || code > 3)
749             sys_error (r, record->pos,
750                        _("String missing value indicator field is not "
751                          "0, 1, 2, or 3."));
752         }
753
754       read_bytes (r, record->missing, 8 * abs (code));
755     }
756 }
757
758 /* Reads value labels from R into RECORD. */
759 static void
760 read_value_label_record (struct sfm_reader *r,
761                          struct sfm_value_label_record *record,
762                          size_t n_vars)
763 {
764   size_t i;
765
766   /* Read type 3 record. */
767   record->pos = r->pos;
768   record->n_labels = read_int (r);
769   if (record->n_labels > SIZE_MAX / sizeof *record->labels)
770     sys_error (r, r->pos - 4, _("Invalid number of labels %zu."),
771                record->n_labels);
772   record->labels = pool_nmalloc (r->pool, record->n_labels,
773                                  sizeof *record->labels);
774   for (i = 0; i < record->n_labels; i++)
775     {
776       struct sfm_value_label *label = &record->labels[i];
777       unsigned char label_len;
778       size_t padded_len;
779
780       read_bytes (r, label->value, sizeof label->value);
781
782       /* Read label length. */
783       read_bytes (r, &label_len, sizeof label_len);
784       padded_len = ROUND_UP (label_len + 1, 8);
785
786       /* Read label, padding. */
787       label->label = pool_malloc (r->pool, padded_len + 1);
788       read_bytes (r, label->label, padded_len - 1);
789       label->label[label_len] = '\0';
790     }
791
792   /* Read record type of type 4 record. */
793   if (read_int (r) != 4)
794     sys_error (r, r->pos - 4,
795                _("Variable index record (type 4) does not immediately "
796                  "follow value label record (type 3) as it should."));
797
798   /* Read number of variables associated with value label from type 4
799      record. */
800   record->n_vars = read_int (r);
801   if (record->n_vars < 1 || record->n_vars > n_vars)
802     sys_error (r, r->pos - 4,
803                _("Number of variables associated with a value label (%zu) "
804                  "is not between 1 and the number of variables (%zu)."),
805                record->n_vars, n_vars);
806   record->vars = pool_nmalloc (r->pool, record->n_vars, sizeof *record->vars);
807   for (i = 0; i < record->n_vars; i++)
808     record->vars[i] = read_int (r);
809 }
810
811 /* Reads a document record from R and returns it. */
812 static struct sfm_document_record *
813 read_document_record (struct sfm_reader *r)
814 {
815   struct sfm_document_record *record;
816   int n_lines;
817
818   record = pool_malloc (r->pool, sizeof *record);
819   record->pos = r->pos;
820
821   n_lines = read_int (r);
822   if (n_lines <= 0 || n_lines >= INT_MAX / DOC_LINE_LENGTH)
823     sys_error (r, record->pos,
824                _("Number of document lines (%d) "
825                  "must be greater than 0 and less than %d."),
826                n_lines, INT_MAX / DOC_LINE_LENGTH);
827
828   record->n_lines = n_lines;
829   record->documents = pool_malloc (r->pool, DOC_LINE_LENGTH * n_lines);
830   read_bytes (r, record->documents, DOC_LINE_LENGTH * n_lines);
831
832   return record;
833 }
834
835 static void
836 read_extension_record_header (struct sfm_reader *r, int subtype,
837                               struct sfm_extension_record *record)
838 {
839   record->pos = r->pos;
840   record->size = read_int (r);
841   record->count = read_int (r);
842
843   /* Check that SIZE * COUNT + 1 doesn't overflow.  Adding 1
844      allows an extra byte for a null terminator, used by some
845      extension processing routines. */
846   if (record->size != 0
847       && size_overflow_p (xsum (1, xtimes (record->count, record->size))))
848     sys_error (r, record->pos, "Record type 7 subtype %d too large.", subtype);
849 }
850
851 /* Reads an extension record from R into RECORD. */
852 static struct sfm_extension_record *
853 read_extension_record (struct sfm_reader *r, int subtype)
854 {
855   struct extension_record_type
856     {
857       int subtype;
858       int size;
859       int count;
860     };
861
862   static const struct extension_record_type types[] =
863     {
864       /* Implemented record types. */
865       { EXT_INTEGER,      4, 8 },
866       { EXT_FLOAT,        8, 3 },
867       { EXT_MRSETS,       1, 0 },
868       { EXT_DISPLAY,      4, 0 },
869       { EXT_LONG_NAMES,   1, 0 },
870       { EXT_LONG_STRINGS, 1, 0 },
871       { EXT_NCASES,       8, 2 },
872       { EXT_FILE_ATTRS,   1, 0 },
873       { EXT_VAR_ATTRS,    1, 0 },
874       { EXT_MRSETS2,      1, 0 },
875       { EXT_ENCODING,     1, 0 },
876       { EXT_LONG_LABELS,  1, 0 },
877
878       /* Ignored record types. */
879       { EXT_VAR_SETS,     0, 0 },
880       { EXT_DATE,         0, 0 },
881       { EXT_DATA_ENTRY,   0, 0 },
882     };
883
884   const struct extension_record_type *type;
885   struct sfm_extension_record *record;
886   size_t n_bytes;
887
888   record = pool_malloc (r->pool, sizeof *record);
889   read_extension_record_header (r, subtype, record);
890   n_bytes = record->count * record->size;
891
892   for (type = types; type < &types[sizeof types / sizeof *types]; type++)
893     if (subtype == type->subtype)
894       {
895         if (type->size > 0 && record->size != type->size)
896           sys_warn (r, record->pos,
897                     _("Record type 7, subtype %d has bad size %zu "
898                       "(expected %d)."), subtype, record->size, type->size);
899         else if (type->count > 0 && record->count != type->count)
900           sys_warn (r, record->pos,
901                     _("Record type 7, subtype %d has bad count %zu "
902                       "(expected %d)."), subtype, record->count, type->count);
903         else if (type->count == 0 && type->size == 0)
904           {
905             /* Ignore this record. */
906           }
907         else
908           {
909             char *data = pool_malloc (r->pool, n_bytes + 1);
910             data[n_bytes] = '\0';
911
912             record->data = data;
913             read_bytes (r, record->data, n_bytes);
914             return record;
915           }
916
917         goto skip;
918       }
919
920   sys_warn (r, record->pos,
921             _("Unrecognized record type 7, subtype %d.  Please send a "
922               "copy of this file, and the syntax which created it to %s."),
923             subtype, PACKAGE_BUGREPORT);
924
925 skip:
926   skip_bytes (r, n_bytes);
927   return NULL;
928 }
929
930 static void
931 skip_extension_record (struct sfm_reader *r, int subtype)
932 {
933   struct sfm_extension_record record;
934
935   read_extension_record_header (r, subtype, &record);
936   skip_bytes (r, record.count * record.size);
937 }
938
939 static void
940 parse_header (struct sfm_reader *r, const struct sfm_header_record *header,
941               struct sfm_read_info *info, struct dictionary *dict)
942 {
943   const char *dict_encoding = dict_get_encoding (dict);
944   struct substring product;
945   struct substring label;
946
947   /* Convert file label to UTF-8 and put it into DICT. */
948   label = recode_substring_pool ("UTF-8", dict_encoding,
949                                  ss_cstr (header->file_label), r->pool);
950   ss_trim (&label, ss_cstr (" "));
951   label.string[label.length] = '\0';
952   dict_set_label (dict, label.string);
953
954   /* Put creation date and time in UTF-8 into INFO. */
955   info->creation_date = recode_string ("UTF-8", dict_encoding,
956                                        header->creation_date, -1);
957   info->creation_time = recode_string ("UTF-8", dict_encoding,
958                                        header->creation_time, -1);
959
960   /* Put product name into INFO, dropping eye-catcher string if present. */
961   product = recode_substring_pool ("UTF-8", dict_encoding,
962                                    ss_cstr (header->eye_catcher), r->pool);
963   ss_match_string (&product, ss_cstr ("@(#) SPSS DATA FILE"));
964   ss_trim (&product, ss_cstr (" "));
965   info->product = ss_xstrdup (product);
966 }
967
968 /* Reads a variable (type 2) record from R and adds the
969    corresponding variable to DICT.
970    Also skips past additional variable records for long string
971    variables. */
972 static void
973 parse_variable_records (struct sfm_reader *r, struct dictionary *dict,
974                         struct sfm_var_record *var_recs, size_t n_var_recs)
975 {
976   const char *dict_encoding = dict_get_encoding (dict);
977   struct sfm_var_record *rec;
978   int n_warnings = 0;
979
980   for (rec = var_recs; rec < &var_recs[n_var_recs]; )
981     {
982       struct variable *var;
983       size_t n_values;
984       char *name;
985       size_t i;
986
987       name = recode_string_pool ("UTF-8", dict_encoding,
988                                  rec->name, 8, r->pool);
989       name[strcspn (name, " ")] = '\0';
990
991       if (!dict_id_is_valid (dict, name, false)
992           || name[0] == '$' || name[0] == '#')
993         sys_error (r, rec->pos, _("Invalid variable name `%s'."), name);
994
995       if (rec->width < 0 || rec->width > 255)
996         sys_error (r, rec->pos,
997                    _("Bad width %d for variable %s."), rec->width, name);
998
999       var = rec->var = dict_create_var (dict, name, rec->width);
1000       if (var == NULL)
1001         sys_error (r, rec->pos, _("Duplicate variable name `%s'."), name);
1002
1003       /* Set the short name the same as the long name. */
1004       var_set_short_name (var, 0, name);
1005
1006       /* Get variable label, if any. */
1007       if (rec->label)
1008         {
1009           char *utf8_label;
1010
1011           utf8_label = recode_string_pool ("UTF-8", dict_encoding,
1012                                            rec->label, -1, r->pool);
1013           var_set_label (var, utf8_label, false);
1014         }
1015
1016       /* Set missing values. */
1017       if (rec->missing_value_code != 0)
1018         {
1019           int width = var_get_width (var);
1020           struct missing_values mv;
1021
1022           mv_init_pool (r->pool, &mv, width);
1023           if (var_is_numeric (var))
1024             {
1025               bool has_range = rec->missing_value_code < 0;
1026               int n_discrete = (has_range
1027                                 ? rec->missing_value_code == -3
1028                                 : rec->missing_value_code);
1029               int ofs = 0;
1030
1031               if (has_range)
1032                 {
1033                   double low = parse_float (r, rec->missing, 0);
1034                   double high = parse_float (r, rec->missing, 8);
1035                   mv_add_range (&mv, low, high);
1036                   ofs += 16;
1037                 }
1038
1039               for (i = 0; i < n_discrete; i++)
1040                 {
1041                   mv_add_num (&mv, parse_float (r, rec->missing, ofs));
1042                   ofs += 8;
1043                 }
1044             }
1045           else
1046             {
1047               union value value;
1048
1049               value_init_pool (r->pool, &value, width);
1050               value_set_missing (&value, width);
1051               for (i = 0; i < rec->missing_value_code; i++)
1052                 {
1053                   uint8_t *s = value_str_rw (&value, width);
1054                   memcpy (s, rec->missing + 8 * i, MIN (width, 8));
1055                   mv_add_str (&mv, s);
1056                 }
1057             }
1058           var_set_missing_values (var, &mv);
1059         }
1060
1061       /* Set formats. */
1062       parse_format_spec (r, rec->pos + 12, rec->print_format,
1063                          PRINT_FORMAT, var, &n_warnings);
1064       parse_format_spec (r, rec->pos + 16, rec->write_format,
1065                          WRITE_FORMAT, var, &n_warnings);
1066
1067       /* Account for values.
1068          Skip long string continuation records, if any. */
1069       n_values = rec->width == 0 ? 1 : DIV_RND_UP (rec->width, 8);
1070       for (i = 1; i < n_values; i++)
1071         if (i + (rec - var_recs) >= n_var_recs || rec[i].width != -1)
1072           sys_error (r, rec->pos, _("Missing string continuation record."));
1073       rec += n_values;
1074     }
1075 }
1076
1077 /* Translates the format spec from sysfile format to internal
1078    format. */
1079 static void
1080 parse_format_spec (struct sfm_reader *r, off_t pos, unsigned int format,
1081                    enum which_format which, struct variable *v,
1082                    int *n_warnings)
1083 {
1084   const int max_warnings = 8;
1085   uint8_t raw_type = format >> 16;
1086   uint8_t w = format >> 8;
1087   uint8_t d = format;
1088   struct fmt_spec f;
1089   bool ok;
1090
1091   f.w = w;
1092   f.d = d;
1093
1094   msg_disable ();
1095   ok = (fmt_from_io (raw_type, &f.type)
1096         && fmt_check_output (&f)
1097         && fmt_check_width_compat (&f, var_get_width (v)));
1098   msg_enable ();
1099
1100   if (ok)
1101     {
1102       if (which == PRINT_FORMAT)
1103         var_set_print_format (v, &f);
1104       else
1105         var_set_write_format (v, &f);
1106     }
1107   else if (format == 0)
1108     {
1109       /* Actually observed in the wild.  No point in warning about it. */
1110     }
1111   else if (++*n_warnings <= max_warnings)
1112     {
1113       if (which == PRINT_FORMAT)
1114         sys_warn (r, pos, _("Variable %s with width %d has invalid print "
1115                             "format 0x%x."),
1116                   var_get_name (v), var_get_width (v), format);
1117       else
1118         sys_warn (r, pos, _("Variable %s with width %d has invalid write "
1119                             "format 0x%x."),
1120                   var_get_name (v), var_get_width (v), format);
1121
1122       if (*n_warnings == max_warnings)
1123         sys_warn (r, -1, _("Suppressing further invalid format warnings."));
1124     }
1125 }
1126
1127 static void
1128 parse_document (struct dictionary *dict, struct sfm_document_record *record)
1129 {
1130   const char *p;
1131
1132   for (p = record->documents;
1133        p < record->documents + DOC_LINE_LENGTH * record->n_lines;
1134        p += DOC_LINE_LENGTH)
1135     {
1136       struct substring line;
1137
1138       line = recode_substring_pool ("UTF-8", dict_get_encoding (dict),
1139                                     ss_buffer (p, DOC_LINE_LENGTH), NULL);
1140       ss_rtrim (&line, ss_cstr (" "));
1141       line.string[line.length] = '\0';
1142
1143       dict_add_document_line (dict, line.string, false);
1144
1145       ss_dealloc (&line);
1146     }
1147 }
1148
1149 /* Parses record type 7, subtype 3. */
1150 static void
1151 parse_machine_integer_info (struct sfm_reader *r,
1152                             const struct sfm_extension_record *record,
1153                             struct sfm_read_info *info)
1154 {
1155   int float_representation, expected_float_format;
1156   int integer_representation, expected_integer_format;
1157
1158   /* Save version info. */
1159   info->version_major = parse_int (r, record->data, 0);
1160   info->version_minor = parse_int (r, record->data, 4);
1161   info->version_revision = parse_int (r, record->data, 8);
1162
1163   /* Check floating point format. */
1164   float_representation = parse_int (r, record->data, 16);
1165   if (r->float_format == FLOAT_IEEE_DOUBLE_BE
1166       || r->float_format == FLOAT_IEEE_DOUBLE_LE)
1167     expected_float_format = 1;
1168   else if (r->float_format == FLOAT_Z_LONG)
1169     expected_float_format = 2;
1170   else if (r->float_format == FLOAT_VAX_G || r->float_format == FLOAT_VAX_D)
1171     expected_float_format = 3;
1172   else
1173     NOT_REACHED ();
1174   if (float_representation != expected_float_format)
1175     sys_error (r, record->pos, _("Floating-point representation indicated by "
1176                  "system file (%d) differs from expected (%d)."),
1177                float_representation, expected_float_format);
1178
1179   /* Check integer format. */
1180   integer_representation = parse_int (r, record->data, 24);
1181   if (r->integer_format == INTEGER_MSB_FIRST)
1182     expected_integer_format = 1;
1183   else if (r->integer_format == INTEGER_LSB_FIRST)
1184     expected_integer_format = 2;
1185   else
1186     NOT_REACHED ();
1187   if (integer_representation != expected_integer_format)
1188     sys_warn (r, record->pos,
1189               _("Integer format indicated by system file (%d) "
1190                 "differs from expected (%d)."),
1191               integer_representation, expected_integer_format);
1192
1193 }
1194
1195 static const char *
1196 choose_encoding (struct sfm_reader *r,
1197                  const struct sfm_header_record *header,
1198                  const struct sfm_extension_record *ext_integer,
1199                  const struct sfm_extension_record *ext_encoding)
1200 {
1201   /* The EXT_ENCODING record is a more reliable way to determine dictionary
1202      encoding. */
1203   if (ext_encoding)
1204     return ext_encoding->data;
1205
1206   /* But EXT_INTEGER is better than nothing as a fallback. */
1207   if (ext_integer)
1208     {
1209       int codepage = parse_int (r, ext_integer->data, 7 * 4);
1210       const char *encoding;
1211
1212       switch (codepage)
1213         {
1214         case 1:
1215           return "EBCDIC-US";
1216
1217         case 2:
1218         case 3:
1219           /* These ostensibly mean "7-bit ASCII" and "8-bit ASCII"[sic]
1220              respectively.  However, there are known to be many files in the wild
1221              with character code 2, yet have data which are clearly not ASCII.
1222              Therefore we ignore these values. */
1223           break;
1224
1225         case 4:
1226           return "MS_KANJI";
1227
1228         default:
1229           encoding = sys_get_encoding_from_codepage (codepage);
1230           if (encoding != NULL)
1231             return encoding;
1232           break;
1233         }
1234     }
1235
1236   /* If the file magic number is EBCDIC then its character data is too. */
1237   if (!strcmp (header->magic, EBCDIC_MAGIC))
1238     return "EBCDIC-US";
1239
1240   return locale_charset ();
1241 }
1242
1243 /* Parses record type 7, subtype 4. */
1244 static void
1245 parse_machine_float_info (struct sfm_reader *r,
1246                           const struct sfm_extension_record *record)
1247 {
1248   double sysmis = parse_float (r, record->data, 0);
1249   double highest = parse_float (r, record->data, 8);
1250   double lowest = parse_float (r, record->data, 16);
1251
1252   if (sysmis != SYSMIS)
1253     sys_warn (r, record->pos, _("File specifies unexpected value %g as %s."),
1254               sysmis, "SYSMIS");
1255
1256   if (highest != HIGHEST)
1257     sys_warn (r, record->pos, _("File specifies unexpected value %g as %s."),
1258               highest, "HIGHEST");
1259
1260   if (lowest != LOWEST)
1261     sys_warn (r, record->pos, _("File specifies unexpected value %g as %s."),
1262               lowest, "LOWEST");
1263 }
1264
1265 /* Parses record type 7, subtype 7 or 19. */
1266 static void
1267 parse_mrsets (struct sfm_reader *r, const struct sfm_extension_record *record,
1268               struct dictionary *dict)
1269 {
1270   struct text_record *text;
1271   struct mrset *mrset;
1272
1273   text = open_text_record (r, record, false);
1274   for (;;)
1275     {
1276       const char *counted = NULL;
1277       const char *name;
1278       const char *label;
1279       struct stringi_set var_names;
1280       size_t allocated_vars;
1281       char delimiter;
1282       int width;
1283
1284       mrset = xzalloc (sizeof *mrset);
1285
1286       name = text_get_token (text, ss_cstr ("="), NULL);
1287       if (name == NULL)
1288         break;
1289       mrset->name = recode_string ("UTF-8", r->encoding, name, -1);
1290
1291       if (mrset->name[0] != '$')
1292         {
1293           sys_warn (r, record->pos,
1294                     _("`%s' does not begin with `$' at offset %zu "
1295                       "in MRSETS record."), mrset->name, text_pos (text));
1296           break;
1297         }
1298
1299       if (text_match (text, 'C'))
1300         {
1301           mrset->type = MRSET_MC;
1302           if (!text_match (text, ' '))
1303             {
1304               sys_warn (r, record->pos,
1305                         _("Missing space following `%c' at offset %zu "
1306                           "in MRSETS record."), 'C', text_pos (text));
1307               break;
1308             }
1309         }
1310       else if (text_match (text, 'D'))
1311         {
1312           mrset->type = MRSET_MD;
1313           mrset->cat_source = MRSET_VARLABELS;
1314         }
1315       else if (text_match (text, 'E'))
1316         {
1317           char *number;
1318
1319           mrset->type = MRSET_MD;
1320           mrset->cat_source = MRSET_COUNTEDVALUES;
1321           if (!text_match (text, ' '))
1322             {
1323               sys_warn (r, record->pos,
1324                         _("Missing space following `%c' at offset %zu "
1325                           "in MRSETS record."), 'E',  text_pos (text));
1326               break;
1327             }
1328
1329           number = text_get_token (text, ss_cstr (" "), NULL);
1330           if (!strcmp (number, "11"))
1331             mrset->label_from_var_label = true;
1332           else if (strcmp (number, "1"))
1333             sys_warn (r, record->pos,
1334                       _("Unexpected label source value `%s' following `E' "
1335                         "at offset %zu in MRSETS record."),
1336                       number, text_pos (text));
1337         }
1338       else
1339         {
1340           sys_warn (r, record->pos,
1341                     _("Missing `C', `D', or `E' at offset %zu "
1342                       "in MRSETS record."),
1343                     text_pos (text));
1344           break;
1345         }
1346
1347       if (mrset->type == MRSET_MD)
1348         {
1349           counted = text_parse_counted_string (r, text);
1350           if (counted == NULL)
1351             break;
1352         }
1353
1354       label = text_parse_counted_string (r, text);
1355       if (label == NULL)
1356         break;
1357       if (label[0] != '\0')
1358         mrset->label = recode_string ("UTF-8", r->encoding, label, -1);
1359
1360       stringi_set_init (&var_names);
1361       allocated_vars = 0;
1362       width = INT_MAX;
1363       do
1364         {
1365           const char *raw_var_name;
1366           struct variable *var;
1367           char *var_name;
1368
1369           raw_var_name = text_get_token (text, ss_cstr (" \n"), &delimiter);
1370           if (raw_var_name == NULL)
1371             {
1372               sys_warn (r, record->pos,
1373                         _("Missing new-line parsing variable names "
1374                           "at offset %zu in MRSETS record."),
1375                         text_pos (text));
1376               break;
1377             }
1378           var_name = recode_string ("UTF-8", r->encoding, raw_var_name, -1);
1379
1380           var = dict_lookup_var (dict, var_name);
1381           if (var == NULL)
1382             {
1383               free (var_name);
1384               continue;
1385             }
1386           if (!stringi_set_insert (&var_names, var_name))
1387             {
1388               sys_warn (r, record->pos,
1389                         _("Duplicate variable name %s "
1390                           "at offset %zu in MRSETS record."),
1391                         var_name, text_pos (text));
1392               free (var_name);
1393               continue;
1394             }
1395           free (var_name);
1396
1397           if (mrset->label == NULL && mrset->label_from_var_label
1398               && var_has_label (var))
1399             mrset->label = xstrdup (var_get_label (var));
1400
1401           if (mrset->n_vars
1402               && var_get_type (var) != var_get_type (mrset->vars[0]))
1403             {
1404               sys_warn (r, record->pos,
1405                         _("MRSET %s contains both string and "
1406                           "numeric variables."), name);
1407               continue;
1408             }
1409           width = MIN (width, var_get_width (var));
1410
1411           if (mrset->n_vars >= allocated_vars)
1412             mrset->vars = x2nrealloc (mrset->vars, &allocated_vars,
1413                                       sizeof *mrset->vars);
1414           mrset->vars[mrset->n_vars++] = var;
1415         }
1416       while (delimiter != '\n');
1417
1418       if (mrset->n_vars < 2)
1419         {
1420           sys_warn (r, record->pos,
1421                     _("MRSET %s has only %zu variables."), mrset->name,
1422                     mrset->n_vars);
1423           mrset_destroy (mrset);
1424           stringi_set_destroy (&var_names);
1425           continue;
1426         }
1427
1428       if (mrset->type == MRSET_MD)
1429         {
1430           mrset->width = width;
1431           value_init (&mrset->counted, width);
1432           if (width == 0)
1433             mrset->counted.f = strtod (counted, NULL);
1434           else
1435             value_copy_str_rpad (&mrset->counted, width,
1436                                  (const uint8_t *) counted, ' ');
1437         }
1438
1439       dict_add_mrset (dict, mrset);
1440       mrset = NULL;
1441       stringi_set_destroy (&var_names);
1442     }
1443   mrset_destroy (mrset);
1444   close_text_record (r, text);
1445 }
1446
1447 /* Read record type 7, subtype 11, which specifies how variables
1448    should be displayed in GUI environments. */
1449 static void
1450 parse_display_parameters (struct sfm_reader *r,
1451                          const struct sfm_extension_record *record,
1452                          struct dictionary *dict)
1453 {
1454   bool includes_width;
1455   bool warned = false;
1456   size_t n_vars;
1457   size_t ofs;
1458   size_t i;
1459
1460   n_vars = dict_get_var_cnt (dict);
1461   if (record->count == 3 * n_vars)
1462     includes_width = true;
1463   else if (record->count == 2 * n_vars)
1464     includes_width = false;
1465   else
1466     {
1467       sys_warn (r, record->pos,
1468                 _("Extension 11 has bad count %zu (for %zu variables)."),
1469                 record->count, n_vars);
1470       return;
1471     }
1472
1473   ofs = 0;
1474   for (i = 0; i < n_vars; ++i)
1475     {
1476       struct variable *v = dict_get_var (dict, i);
1477       int measure, width, align;
1478
1479       measure = parse_int (r, record->data, ofs);
1480       ofs += 4;
1481
1482       if (includes_width)
1483         {
1484           width = parse_int (r, record->data, ofs);
1485           ofs += 4;
1486         }
1487       else
1488         width = 0;
1489
1490       align = parse_int (r, record->data, ofs);
1491       ofs += 4;
1492
1493       /* SPSS 14 sometimes seems to set string variables' measure
1494          to zero. */
1495       if (0 == measure && var_is_alpha (v))
1496         measure = 1;
1497
1498       if (measure < 1 || measure > 3 || align < 0 || align > 2)
1499         {
1500           if (!warned)
1501             sys_warn (r, record->pos,
1502                       _("Invalid variable display parameters for variable "
1503                         "%zu (%s).  Default parameters substituted."),
1504                       i, var_get_name (v));
1505           warned = true;
1506           continue;
1507         }
1508
1509       var_set_measure (v, (measure == 1 ? MEASURE_NOMINAL
1510                            : measure == 2 ? MEASURE_ORDINAL
1511                            : MEASURE_SCALE));
1512       var_set_alignment (v, (align == 0 ? ALIGN_LEFT
1513                              : align == 1 ? ALIGN_RIGHT
1514                              : ALIGN_CENTRE));
1515
1516       /* Older versions (SPSS 9.0) sometimes set the display
1517          width to zero.  This causes confusion in the GUI, so
1518          only set the width if it is nonzero. */
1519       if (width > 0)
1520         var_set_display_width (v, width);
1521     }
1522 }
1523
1524 static void
1525 rename_var_and_save_short_names (struct dictionary *dict, struct variable *var,
1526                                  const char *new_name)
1527 {
1528   size_t n_short_names;
1529   char **short_names;
1530   size_t i;
1531
1532   /* Renaming a variable may clear its short names, but we
1533      want to retain them, so we save them and re-set them
1534      afterward. */
1535   n_short_names = var_get_short_name_cnt (var);
1536   short_names = xnmalloc (n_short_names, sizeof *short_names);
1537   for (i = 0; i < n_short_names; i++)
1538     {
1539       const char *s = var_get_short_name (var, i);
1540       short_names[i] = s != NULL ? xstrdup (s) : NULL;
1541     }
1542
1543   /* Set long name. */
1544   dict_rename_var (dict, var, new_name);
1545
1546   /* Restore short names. */
1547   for (i = 0; i < n_short_names; i++)
1548     {
1549       var_set_short_name (var, i, short_names[i]);
1550       free (short_names[i]);
1551     }
1552   free (short_names);
1553 }
1554
1555 /* Parses record type 7, subtype 13, which gives the long name that corresponds
1556    to each short name.  Modifies variable names in DICT accordingly.  */
1557 static void
1558 parse_long_var_name_map (struct sfm_reader *r,
1559                          const struct sfm_extension_record *record,
1560                          struct dictionary *dict)
1561 {
1562   struct text_record *text;
1563   struct variable *var;
1564   char *long_name;
1565
1566   if (record == NULL)
1567     {
1568       /* Convert variable names to lowercase. */
1569       size_t i;
1570
1571       for (i = 0; i < dict_get_var_cnt (dict); i++)
1572         {
1573           struct variable *var = dict_get_var (dict, i);
1574           char *new_name;
1575
1576           new_name = xstrdup (var_get_name (var));
1577           str_lowercase (new_name);
1578
1579           rename_var_and_save_short_names (dict, var, new_name);
1580
1581           free (new_name);
1582         }
1583
1584       return;
1585     }
1586
1587   /* Rename each of the variables, one by one.  (In a correctly constructed
1588      system file, this cannot create any intermediate duplicate variable names,
1589      because all of the new variable names are longer than any of the old
1590      variable names and thus there cannot be any overlaps.) */
1591   text = open_text_record (r, record, true);
1592   while (read_variable_to_value_pair (r, dict, text, &var, &long_name))
1593     {
1594       /* Validate long name. */
1595       if (!dict_id_is_valid (dict, long_name, false))
1596         {
1597           sys_warn (r, record->pos,
1598                     _("Long variable mapping from %s to invalid "
1599                       "variable name `%s'."),
1600                     var_get_name (var), long_name);
1601           continue;
1602         }
1603
1604       /* Identify any duplicates. */
1605       if (strcasecmp (var_get_short_name (var, 0), long_name)
1606           && dict_lookup_var (dict, long_name) != NULL)
1607         {
1608           sys_warn (r, record->pos,
1609                     _("Duplicate long variable name `%s'."), long_name);
1610           continue;
1611         }
1612
1613       rename_var_and_save_short_names (dict, var, long_name);
1614     }
1615   close_text_record (r, text);
1616 }
1617
1618 /* Reads record type 7, subtype 14, which gives the real length
1619    of each very long string.  Rearranges DICT accordingly. */
1620 static void
1621 parse_long_string_map (struct sfm_reader *r,
1622                        const struct sfm_extension_record *record,
1623                        struct dictionary *dict)
1624 {
1625   struct text_record *text;
1626   struct variable *var;
1627   char *length_s;
1628
1629   text = open_text_record (r, record, true);
1630   while (read_variable_to_value_pair (r, dict, text, &var, &length_s))
1631     {
1632       size_t idx = var_get_dict_index (var);
1633       long int length;
1634       int segment_cnt;
1635       int i;
1636
1637       /* Get length. */
1638       length = strtol (length_s, NULL, 10);
1639       if (length < 1 || length > MAX_STRING)
1640         {
1641           sys_warn (r, record->pos,
1642                     _("%s listed as string of invalid length %s "
1643                       "in very long string record."),
1644                     var_get_name (var), length_s);
1645           continue;
1646         }
1647
1648       /* Check segments. */
1649       segment_cnt = sfm_width_to_segments (length);
1650       if (segment_cnt == 1)
1651         {
1652           sys_warn (r, record->pos,
1653                     _("%s listed in very long string record with width %s, "
1654                       "which requires only one segment."),
1655                     var_get_name (var), length_s);
1656           continue;
1657         }
1658       if (idx + segment_cnt > dict_get_var_cnt (dict))
1659         sys_error (r, record->pos,
1660                    _("Very long string %s overflows dictionary."),
1661                    var_get_name (var));
1662
1663       /* Get the short names from the segments and check their
1664          lengths. */
1665       for (i = 0; i < segment_cnt; i++)
1666         {
1667           struct variable *seg = dict_get_var (dict, idx + i);
1668           int alloc_width = sfm_segment_alloc_width (length, i);
1669           int width = var_get_width (seg);
1670
1671           if (i > 0)
1672             var_set_short_name (var, i, var_get_short_name (seg, 0));
1673           if (ROUND_UP (width, 8) != ROUND_UP (alloc_width, 8))
1674             sys_error (r, record->pos,
1675                        _("Very long string with width %ld has segment %d "
1676                          "of width %d (expected %d)."),
1677                        length, i, width, alloc_width);
1678         }
1679       dict_delete_consecutive_vars (dict, idx + 1, segment_cnt - 1);
1680       var_set_width (var, length);
1681     }
1682   close_text_record (r, text);
1683   dict_compact_values (dict);
1684 }
1685
1686 static void
1687 parse_value_labels (struct sfm_reader *r, struct dictionary *dict,
1688                     const struct sfm_var_record *var_recs, size_t n_var_recs,
1689                     const struct sfm_value_label_record *record)
1690 {
1691   struct variable **vars;
1692   char **utf8_labels;
1693   size_t i;
1694
1695   utf8_labels = pool_nmalloc (r->pool, sizeof *utf8_labels, record->n_labels);
1696   for (i = 0; i < record->n_labels; i++)
1697     utf8_labels[i] = recode_string_pool ("UTF-8", dict_get_encoding (dict),
1698                                          record->labels[i].label, -1,
1699                                          r->pool);
1700
1701   vars = pool_nmalloc (r->pool, record->n_vars, sizeof *vars);
1702   for (i = 0; i < record->n_vars; i++)
1703     vars[i] = lookup_var_by_index (r, record->pos,
1704                                    var_recs, n_var_recs, record->vars[i]);
1705
1706   for (i = 1; i < record->n_vars; i++)
1707     if (var_get_type (vars[i]) != var_get_type (vars[0]))
1708       sys_error (r, record->pos,
1709                  _("Variables associated with value label are not all of "
1710                    "identical type.  Variable %s is %s, but variable "
1711                    "%s is %s."),
1712                  var_get_name (vars[0]),
1713                  var_is_numeric (vars[0]) ? _("numeric") : _("string"),
1714                  var_get_name (vars[i]),
1715                  var_is_numeric (vars[i]) ? _("numeric") : _("string"));
1716
1717   for (i = 0; i < record->n_vars; i++)
1718     {
1719       struct variable *var = vars[i];
1720       int width;
1721       size_t j;
1722
1723       width = var_get_width (var);
1724       if (width > 8)
1725         sys_error (r, record->pos,
1726                    _("Value labels may not be added to long string "
1727                      "variables (e.g. %s) using records types 3 and 4."),
1728                    var_get_name (var));
1729
1730       for (j = 0; j < record->n_labels; j++)
1731         {
1732           struct sfm_value_label *label = &record->labels[j];
1733           union value value;
1734
1735           value_init (&value, width);
1736           if (width == 0)
1737             value.f = parse_float (r, label->value, 0);
1738           else
1739             memcpy (value_str_rw (&value, width), label->value, width);
1740
1741           if (!var_add_value_label (var, &value, utf8_labels[j]))
1742             {
1743               if (var_is_numeric (var))
1744                 sys_warn (r, record->pos,
1745                           _("Duplicate value label for %g on %s."),
1746                           value.f, var_get_name (var));
1747               else
1748                 sys_warn (r, record->pos,
1749                           _("Duplicate value label for `%.*s' on %s."),
1750                           width, value_str (&value, width),
1751                           var_get_name (var));
1752             }
1753
1754           value_destroy (&value, width);
1755         }
1756     }
1757
1758   pool_free (r->pool, vars);
1759   for (i = 0; i < record->n_labels; i++)
1760     pool_free (r->pool, utf8_labels[i]);
1761   pool_free (r->pool, utf8_labels);
1762 }
1763
1764 static struct variable *
1765 lookup_var_by_index (struct sfm_reader *r, off_t offset,
1766                      const struct sfm_var_record *var_recs, size_t n_var_recs,
1767                      int idx)
1768 {
1769   const struct sfm_var_record *rec;
1770
1771   if (idx < 1 || idx > n_var_recs)
1772     {
1773       sys_error (r, offset,
1774                  _("Variable index %d not in valid range 1...%zu."),
1775                  idx, n_var_recs);
1776       return NULL;
1777     }
1778
1779   rec = &var_recs[idx - 1];
1780   if (rec->var == NULL)
1781     {
1782       sys_error (r, offset,
1783                  _("Variable index %d refers to long string continuation."),
1784                  idx);
1785       return NULL;
1786     }
1787
1788   return rec->var;
1789 }
1790
1791 /* Parses a set of custom attributes from TEXT into ATTRS.
1792    ATTRS may be a null pointer, in which case the attributes are
1793    read but discarded. */
1794 static void
1795 parse_attributes (struct sfm_reader *r, struct text_record *text,
1796                   struct attrset *attrs)
1797 {
1798   do
1799     {
1800       struct attribute *attr;
1801       char *key;
1802       int index;
1803
1804       /* Parse the key. */
1805       key = text_get_token (text, ss_cstr ("("), NULL);
1806       if (key == NULL)
1807         return;
1808
1809       attr = attribute_create (key);
1810       for (index = 1; ; index++)
1811         {
1812           /* Parse the value. */
1813           char *value;
1814           size_t length;
1815
1816           value = text_get_token (text, ss_cstr ("\n"), NULL);
1817           if (value == NULL)
1818             {
1819               text_warn (r, text, _("Error parsing attribute value %s[%d]."),
1820                          key, index);
1821               break;
1822             }              
1823
1824           length = strlen (value);
1825           if (length >= 2 && value[0] == '\'' && value[length - 1] == '\'') 
1826             {
1827               value[length - 1] = '\0';
1828               attribute_add_value (attr, value + 1); 
1829             }
1830           else 
1831             {
1832               text_warn (r, text,
1833                          _("Attribute value %s[%d] is not quoted: %s."),
1834                          key, index, value);
1835               attribute_add_value (attr, value); 
1836             }
1837
1838           /* Was this the last value for this attribute? */
1839           if (text_match (text, ')'))
1840             break;
1841         }
1842       if (attrs != NULL)
1843         attrset_add (attrs, attr);
1844       else
1845         attribute_destroy (attr);
1846     }
1847   while (!text_match (text, '/'));
1848 }
1849
1850 /* Reads record type 7, subtype 17, which lists custom
1851    attributes on the data file.  */
1852 static void
1853 parse_data_file_attributes (struct sfm_reader *r,
1854                             const struct sfm_extension_record *record,
1855                             struct dictionary *dict)
1856 {
1857   struct text_record *text = open_text_record (r, record, true);
1858   parse_attributes (r, text, dict_get_attributes (dict));
1859   close_text_record (r, text);
1860 }
1861
1862 /* Parses record type 7, subtype 18, which lists custom
1863    attributes on individual variables.  */
1864 static void
1865 parse_variable_attributes (struct sfm_reader *r,
1866                            const struct sfm_extension_record *record,
1867                            struct dictionary *dict)
1868 {
1869   struct text_record *text;
1870   struct variable *var;
1871
1872   text = open_text_record (r, record, true);
1873   while (text_read_variable_name (r, dict, text, ss_cstr (":"), &var))
1874     parse_attributes (r, text, var != NULL ? var_get_attributes (var) : NULL);
1875   close_text_record (r, text);
1876 }
1877
1878 static void
1879 check_overflow (struct sfm_reader *r,
1880                 const struct sfm_extension_record *record,
1881                 size_t ofs, size_t length)
1882 {
1883   size_t end = record->size * record->count;
1884   if (length >= end || ofs + length > end)
1885     sys_error (r, record->pos + end,
1886                _("Long string value label record ends unexpectedly."));
1887 }
1888
1889 static void
1890 parse_long_string_value_labels (struct sfm_reader *r,
1891                                 const struct sfm_extension_record *record,
1892                                 struct dictionary *dict)
1893 {
1894   const char *dict_encoding = dict_get_encoding (dict);
1895   size_t end = record->size * record->count;
1896   size_t ofs = 0;
1897
1898   while (ofs < end)
1899     {
1900       char *var_name;
1901       size_t n_labels, i;
1902       struct variable *var;
1903       union value value;
1904       int var_name_len;
1905       int width;
1906
1907       /* Parse variable name length. */
1908       check_overflow (r, record, ofs, 4);
1909       var_name_len = parse_int (r, record->data, ofs);
1910       ofs += 4;
1911
1912       /* Parse variable name, width, and number of labels. */
1913       check_overflow (r, record, ofs, var_name_len + 8);
1914       var_name = recode_string_pool ("UTF-8", dict_encoding,
1915                                      (const char *) record->data + ofs,
1916                                      var_name_len, r->pool);
1917       width = parse_int (r, record->data, ofs + var_name_len);
1918       n_labels = parse_int (r, record->data, ofs + var_name_len + 4);
1919       ofs += var_name_len + 8;
1920
1921       /* Look up 'var' and validate. */
1922       var = dict_lookup_var (dict, var_name);
1923       if (var == NULL)
1924         sys_warn (r, record->pos + ofs,
1925                   _("Ignoring long string value record for "
1926                     "unknown variable %s."), var_name);
1927       else if (var_is_numeric (var))
1928         {
1929           sys_warn (r, record->pos + ofs,
1930                     _("Ignoring long string value record for "
1931                       "numeric variable %s."), var_name);
1932           var = NULL;
1933         }
1934       else if (width != var_get_width (var))
1935         {
1936           sys_warn (r, record->pos + ofs,
1937                     _("Ignoring long string value record for variable %s "
1938                       "because the record's width (%d) does not match the "
1939                       "variable's width (%d)."),
1940                     var_name, width, var_get_width (var));
1941           var = NULL;
1942         }
1943
1944       /* Parse values. */
1945       value_init_pool (r->pool, &value, width);
1946       for (i = 0; i < n_labels; i++)
1947         {
1948           size_t value_length, label_length;
1949           bool skip = var == NULL;
1950
1951           /* Parse value length. */
1952           check_overflow (r, record, ofs, 4);
1953           value_length = parse_int (r, record->data, ofs);
1954           ofs += 4;
1955
1956           /* Parse value. */
1957           check_overflow (r, record, ofs, value_length);
1958           if (!skip)
1959             {
1960               if (value_length == width)
1961                 memcpy (value_str_rw (&value, width),
1962                         (const uint8_t *) record->data + ofs, width);
1963               else
1964                 {
1965                   sys_warn (r, record->pos + ofs,
1966                             _("Ignoring long string value %zu for variable "
1967                               "%s, with width %d, that has bad value "
1968                               "width %zu."),
1969                             i, var_get_name (var), width, value_length);
1970                   skip = true;
1971                 }
1972             }
1973           ofs += value_length;
1974
1975           /* Parse label length. */
1976           check_overflow (r, record, ofs, 4);
1977           label_length = parse_int (r, record->data, ofs);
1978           ofs += 4;
1979
1980           /* Parse label. */
1981           check_overflow (r, record, ofs, label_length);
1982           if (!skip)
1983             {
1984               char *label;
1985
1986               label = recode_string_pool ("UTF-8", dict_encoding,
1987                                           (const char *) record->data + ofs,
1988                                           label_length, r->pool);
1989               if (!var_add_value_label (var, &value, label))
1990                 sys_warn (r, record->pos + ofs,
1991                           _("Duplicate value label for `%.*s' on %s."),
1992                           width, value_str (&value, width),
1993                           var_get_name (var));
1994               pool_free (r->pool, label);
1995             }
1996           ofs += label_length;
1997         }
1998     }
1999 }
2000 \f
2001 /* Case reader. */
2002
2003 static void partial_record (struct sfm_reader *r)
2004      NO_RETURN;
2005
2006 static void read_error (struct casereader *, const struct sfm_reader *);
2007
2008 static bool read_case_number (struct sfm_reader *, double *);
2009 static bool read_case_string (struct sfm_reader *, uint8_t *, size_t);
2010 static int read_opcode (struct sfm_reader *);
2011 static bool read_compressed_number (struct sfm_reader *, double *);
2012 static bool read_compressed_string (struct sfm_reader *, uint8_t *);
2013 static bool read_whole_strings (struct sfm_reader *, uint8_t *, size_t);
2014 static bool skip_whole_strings (struct sfm_reader *, size_t);
2015
2016 /* Reads and returns one case from READER's file.  Returns a null
2017    pointer if not successful. */
2018 static struct ccase *
2019 sys_file_casereader_read (struct casereader *reader, void *r_)
2020 {
2021   struct sfm_reader *r = r_;
2022   struct ccase *volatile c;
2023   int i;
2024
2025   if (r->error)
2026     return NULL;
2027
2028   c = case_create (r->proto);
2029   if (setjmp (r->bail_out))
2030     {
2031       casereader_force_error (reader);
2032       case_unref (c);
2033       return NULL;
2034     }
2035
2036   for (i = 0; i < r->sfm_var_cnt; i++)
2037     {
2038       struct sfm_var *sv = &r->sfm_vars[i];
2039       union value *v = case_data_rw_idx (c, sv->case_index);
2040
2041       if (sv->var_width == 0)
2042         {
2043           if (!read_case_number (r, &v->f))
2044             goto eof;
2045         }
2046       else
2047         {
2048           uint8_t *s = value_str_rw (v, sv->var_width);
2049           if (!read_case_string (r, s + sv->offset, sv->segment_width))
2050             goto eof;
2051           if (!skip_whole_strings (r, ROUND_DOWN (sv->padding, 8)))
2052             partial_record (r);
2053         }
2054     }
2055   return c;
2056
2057 eof:
2058   if (i != 0)
2059     partial_record (r);
2060   if (r->case_cnt != -1)
2061     read_error (reader, r);
2062   case_unref (c);
2063   return NULL;
2064 }
2065
2066 /* Issues an error that R ends in a partial record. */
2067 static void
2068 partial_record (struct sfm_reader *r)
2069 {
2070   sys_error (r, r->pos, _("File ends in partial case."));
2071 }
2072
2073 /* Issues an error that an unspecified error occurred SFM, and
2074    marks R tainted. */
2075 static void
2076 read_error (struct casereader *r, const struct sfm_reader *sfm)
2077 {
2078   msg (ME, _("Error reading case from file %s."), fh_get_name (sfm->fh));
2079   casereader_force_error (r);
2080 }
2081
2082 /* Reads a number from R and stores its value in *D.
2083    If R is compressed, reads a compressed number;
2084    otherwise, reads a number in the regular way.
2085    Returns true if successful, false if end of file is
2086    reached immediately. */
2087 static bool
2088 read_case_number (struct sfm_reader *r, double *d)
2089 {
2090   if (!r->compressed)
2091     {
2092       uint8_t number[8];
2093       if (!try_read_bytes (r, number, sizeof number))
2094         return false;
2095       float_convert (r->float_format, number, FLOAT_NATIVE_DOUBLE, d);
2096       return true;
2097     }
2098   else
2099     return read_compressed_number (r, d);
2100 }
2101
2102 /* Reads LENGTH string bytes from R into S.
2103    Always reads a multiple of 8 bytes; if LENGTH is not a
2104    multiple of 8, then extra bytes are read and discarded without
2105    being written to S.
2106    Reads compressed strings if S is compressed.
2107    Returns true if successful, false if end of file is
2108    reached immediately. */
2109 static bool
2110 read_case_string (struct sfm_reader *r, uint8_t *s, size_t length)
2111 {
2112   size_t whole = ROUND_DOWN (length, 8);
2113   size_t partial = length % 8;
2114
2115   if (whole)
2116     {
2117       if (!read_whole_strings (r, s, whole))
2118         return false;
2119     }
2120
2121   if (partial)
2122     {
2123       uint8_t bounce[8];
2124       if (!read_whole_strings (r, bounce, sizeof bounce))
2125         {
2126           if (whole)
2127             partial_record (r);
2128           return false;
2129         }
2130       memcpy (s + whole, bounce, partial);
2131     }
2132
2133   return true;
2134 }
2135
2136 /* Reads and returns the next compression opcode from R. */
2137 static int
2138 read_opcode (struct sfm_reader *r)
2139 {
2140   assert (r->compressed);
2141   for (;;)
2142     {
2143       int opcode;
2144       if (r->opcode_idx >= sizeof r->opcodes)
2145         {
2146           if (!try_read_bytes (r, r->opcodes, sizeof r->opcodes))
2147             return -1;
2148           r->opcode_idx = 0;
2149         }
2150       opcode = r->opcodes[r->opcode_idx++];
2151
2152       if (opcode != 0)
2153         return opcode;
2154     }
2155 }
2156
2157 /* Reads a compressed number from R and stores its value in D.
2158    Returns true if successful, false if end of file is
2159    reached immediately. */
2160 static bool
2161 read_compressed_number (struct sfm_reader *r, double *d)
2162 {
2163   int opcode = read_opcode (r);
2164   switch (opcode)
2165     {
2166     case -1:
2167     case 252:
2168       return false;
2169
2170     case 253:
2171       *d = read_float (r);
2172       break;
2173
2174     case 254:
2175       float_convert (r->float_format, "        ", FLOAT_NATIVE_DOUBLE, d);
2176       if (!r->corruption_warning)
2177         {
2178           r->corruption_warning = true;
2179           sys_warn (r, r->pos,
2180                     _("Possible compressed data corruption: "
2181                       "compressed spaces appear in numeric field."));
2182         }
2183       break;
2184
2185     case 255:
2186       *d = SYSMIS;
2187       break;
2188
2189     default:
2190       *d = opcode - r->bias;
2191       break;
2192     }
2193
2194   return true;
2195 }
2196
2197 /* Reads a compressed 8-byte string segment from R and stores it
2198    in DST.
2199    Returns true if successful, false if end of file is
2200    reached immediately. */
2201 static bool
2202 read_compressed_string (struct sfm_reader *r, uint8_t *dst)
2203 {
2204   int opcode = read_opcode (r);
2205   switch (opcode)
2206     {
2207     case -1:
2208     case 252:
2209       return false;
2210
2211     case 253:
2212       read_bytes (r, dst, 8);
2213       break;
2214
2215     case 254:
2216       memset (dst, ' ', 8);
2217       break;
2218
2219     default:
2220       {
2221         double value = opcode - r->bias;
2222         float_convert (FLOAT_NATIVE_DOUBLE, &value, r->float_format, dst);
2223         if (value == 0.0)
2224           {
2225             /* This has actually been seen "in the wild".  The submitter of the
2226                file that showed that the contents decoded as spaces, but they
2227                were at the end of the field so it's possible that the null
2228                bytes just acted as null terminators. */
2229           }
2230         else if (!r->corruption_warning)
2231           {
2232             r->corruption_warning = true;
2233             sys_warn (r, r->pos,
2234                       _("Possible compressed data corruption: "
2235                         "string contains compressed integer (opcode %d)."),
2236                       opcode);
2237           }
2238       }
2239       break;
2240     }
2241
2242   return true;
2243 }
2244
2245 /* Reads LENGTH string bytes from R into S.
2246    LENGTH must be a multiple of 8.
2247    Reads compressed strings if S is compressed.
2248    Returns true if successful, false if end of file is
2249    reached immediately. */
2250 static bool
2251 read_whole_strings (struct sfm_reader *r, uint8_t *s, size_t length)
2252 {
2253   assert (length % 8 == 0);
2254   if (!r->compressed)
2255     return try_read_bytes (r, s, length);
2256   else
2257     {
2258       size_t ofs;
2259       for (ofs = 0; ofs < length; ofs += 8)
2260         if (!read_compressed_string (r, s + ofs))
2261           {
2262             if (ofs != 0)
2263               partial_record (r);
2264             return false;
2265           }
2266       return true;
2267     }
2268 }
2269
2270 /* Skips LENGTH string bytes from R.
2271    LENGTH must be a multiple of 8.
2272    (LENGTH is also limited to 1024, but that's only because the
2273    current caller never needs more than that many bytes.)
2274    Returns true if successful, false if end of file is
2275    reached immediately. */
2276 static bool
2277 skip_whole_strings (struct sfm_reader *r, size_t length)
2278 {
2279   uint8_t buffer[1024];
2280   assert (length < sizeof buffer);
2281   return read_whole_strings (r, buffer, length);
2282 }
2283 \f
2284 /* Helpers for reading records that contain structured text
2285    strings. */
2286
2287 /* Maximum number of warnings to issue for a single text
2288    record. */
2289 #define MAX_TEXT_WARNINGS 5
2290
2291 /* State. */
2292 struct text_record
2293   {
2294     struct substring buffer;    /* Record contents. */
2295     off_t start;                /* Starting offset in file. */
2296     size_t pos;                 /* Current position in buffer. */
2297     int n_warnings;             /* Number of warnings issued or suppressed. */
2298     bool recoded;               /* Recoded into UTF-8? */
2299   };
2300
2301 static struct text_record *
2302 open_text_record (struct sfm_reader *r,
2303                   const struct sfm_extension_record *record,
2304                   bool recode_to_utf8)
2305 {
2306   struct text_record *text;
2307   struct substring raw;
2308
2309   text = pool_alloc (r->pool, sizeof *text);
2310   raw = ss_buffer (record->data, record->size * record->count);
2311   text->start = record->pos;
2312   text->buffer = (recode_to_utf8
2313                   ? recode_substring_pool ("UTF-8", r->encoding, raw, r->pool)
2314                   : raw);
2315   text->pos = 0;
2316   text->n_warnings = 0;
2317   text->recoded = recode_to_utf8;
2318
2319   return text;
2320 }
2321
2322 /* Closes TEXT, frees its storage, and issues a final warning
2323    about suppressed warnings if necesary. */
2324 static void
2325 close_text_record (struct sfm_reader *r, struct text_record *text)
2326 {
2327   if (text->n_warnings > MAX_TEXT_WARNINGS)
2328     sys_warn (r, -1, _("Suppressed %d additional related warnings."),
2329               text->n_warnings - MAX_TEXT_WARNINGS);
2330   if (text->recoded)
2331     pool_free (r->pool, ss_data (text->buffer));
2332 }
2333
2334 /* Reads a variable=value pair from TEXT.
2335    Looks up the variable in DICT and stores it into *VAR.
2336    Stores a null-terminated value into *VALUE. */
2337 static bool
2338 read_variable_to_value_pair (struct sfm_reader *r, struct dictionary *dict,
2339                              struct text_record *text,
2340                              struct variable **var, char **value)
2341 {
2342   for (;;)
2343     {
2344       if (!text_read_short_name (r, dict, text, ss_cstr ("="), var))
2345         return false;
2346       
2347       *value = text_get_token (text, ss_buffer ("\t\0", 2), NULL);
2348       if (*value == NULL)
2349         return false;
2350
2351       text->pos += ss_span (ss_substr (text->buffer, text->pos, SIZE_MAX),
2352                             ss_buffer ("\t\0", 2));
2353
2354       if (*var != NULL)
2355         return true;
2356     }
2357 }
2358
2359 static bool
2360 text_read_variable_name (struct sfm_reader *r, struct dictionary *dict,
2361                          struct text_record *text, struct substring delimiters,
2362                          struct variable **var)
2363 {
2364   char *name;
2365
2366   name = text_get_token (text, delimiters, NULL);
2367   if (name == NULL)
2368     return false;
2369
2370   *var = dict_lookup_var (dict, name);
2371   if (*var != NULL)
2372     return true;
2373
2374   text_warn (r, text, _("Dictionary record refers to unknown variable %s."),
2375              name);
2376   return false;
2377 }
2378
2379
2380 static bool
2381 text_read_short_name (struct sfm_reader *r, struct dictionary *dict,
2382                       struct text_record *text, struct substring delimiters,
2383                       struct variable **var)
2384 {
2385   char *short_name = text_get_token (text, delimiters, NULL);
2386   if (short_name == NULL)
2387     return false;
2388
2389   *var = dict_lookup_var (dict, short_name);
2390   if (*var == NULL)
2391     text_warn (r, text, _("Dictionary record refers to unknown variable %s."),
2392                short_name);
2393   return true;
2394 }
2395
2396 /* Displays a warning for the current file position, limiting the
2397    number to MAX_TEXT_WARNINGS for TEXT. */
2398 static void
2399 text_warn (struct sfm_reader *r, struct text_record *text,
2400            const char *format, ...)
2401 {
2402   if (text->n_warnings++ < MAX_TEXT_WARNINGS) 
2403     {
2404       va_list args;
2405
2406       va_start (args, format);
2407       sys_msg (r, text->start + text->pos, MW, format, args);
2408       va_end (args);
2409     }
2410 }
2411
2412 static char *
2413 text_get_token (struct text_record *text, struct substring delimiters,
2414                 char *delimiter)
2415 {
2416   struct substring token;
2417   char *end;
2418
2419   if (!ss_tokenize (text->buffer, delimiters, &text->pos, &token))
2420     return NULL;
2421
2422   end = &ss_data (token)[ss_length (token)];
2423   if (delimiter != NULL)
2424     *delimiter = *end;
2425   *end = '\0';
2426   return ss_data (token);
2427 }
2428
2429 /* Reads a integer value expressed in decimal, then a space, then a string that
2430    consists of exactly as many bytes as specified by the integer, then a space,
2431    from TEXT.  Returns the string, null-terminated, as a subset of TEXT's
2432    buffer (so the caller should not free the string). */
2433 static const char *
2434 text_parse_counted_string (struct sfm_reader *r, struct text_record *text)
2435 {
2436   size_t start;
2437   size_t n;
2438   char *s;
2439
2440   start = text->pos;
2441   n = 0;
2442   while (text->pos < text->buffer.length)
2443     {
2444       int c = text->buffer.string[text->pos];
2445       if (c < '0' || c > '9')
2446         break;
2447       n = (n * 10) + (c - '0');
2448       text->pos++;
2449     }
2450   if (text->pos >= text->buffer.length || start == text->pos)
2451     {
2452       sys_warn (r, text->start,
2453                 _("Expecting digit at offset %zu in MRSETS record."),
2454                 text->pos);
2455       return NULL;
2456     }
2457
2458   if (!text_match (text, ' '))
2459     {
2460       sys_warn (r, text->start,
2461                 _("Expecting space at offset %zu in MRSETS record."),
2462                 text->pos);
2463       return NULL;
2464     }
2465
2466   if (text->pos + n > text->buffer.length)
2467     {
2468       sys_warn (r, text->start,
2469                 _("%zu-byte string starting at offset %zu "
2470                   "exceeds record length %zu."),
2471                 n, text->pos, text->buffer.length);
2472       return NULL;
2473     }
2474
2475   s = &text->buffer.string[text->pos];
2476   if (s[n] != ' ')
2477     {
2478       sys_warn (r, text->start,
2479                 _("Expecting space at offset %zu following %zu-byte string."),
2480                 text->pos + n, n);
2481       return NULL;
2482     }
2483   s[n] = '\0';
2484   text->pos += n + 1;
2485   return s;
2486 }
2487
2488 static bool
2489 text_match (struct text_record *text, char c)
2490 {
2491   if (text->buffer.string[text->pos] == c) 
2492     {
2493       text->pos++;
2494       return true;
2495     }
2496   else
2497     return false;
2498 }
2499
2500 /* Returns the current byte offset (as converted to UTF-8, if it was converted)
2501    inside the TEXT's string. */
2502 static size_t
2503 text_pos (const struct text_record *text)
2504 {
2505   return text->pos;
2506 }
2507 \f
2508 /* Messages. */
2509
2510 /* Displays a corruption message. */
2511 static void
2512 sys_msg (struct sfm_reader *r, off_t offset,
2513          int class, const char *format, va_list args)
2514 {
2515   struct msg m;
2516   struct string text;
2517
2518   ds_init_empty (&text);
2519   if (offset >= 0)
2520     ds_put_format (&text, _("`%s' near offset 0x%llx: "),
2521                    fh_get_file_name (r->fh), (long long int) offset);
2522   else
2523     ds_put_format (&text, _("`%s': "), fh_get_file_name (r->fh));
2524   ds_put_vformat (&text, format, args);
2525
2526   m.category = msg_class_to_category (class);
2527   m.severity = msg_class_to_severity (class);
2528   m.file_name = NULL;
2529   m.first_line = 0;
2530   m.last_line = 0;
2531   m.first_column = 0;
2532   m.last_column = 0;
2533   m.text = ds_cstr (&text);
2534
2535   msg_emit (&m);
2536 }
2537
2538 /* Displays a warning for offset OFFSET in the file. */
2539 static void
2540 sys_warn (struct sfm_reader *r, off_t offset, const char *format, ...)
2541 {
2542   va_list args;
2543
2544   va_start (args, format);
2545   sys_msg (r, offset, MW, format, args);
2546   va_end (args);
2547 }
2548
2549 /* Displays an error for the current file position,
2550    marks it as in an error state,
2551    and aborts reading it using longjmp. */
2552 static void
2553 sys_error (struct sfm_reader *r, off_t offset, const char *format, ...)
2554 {
2555   va_list args;
2556
2557   va_start (args, format);
2558   sys_msg (r, offset, ME, format, args);
2559   va_end (args);
2560
2561   r->error = true;
2562   longjmp (r->bail_out, 1);
2563 }
2564 \f
2565 /* Reads BYTE_CNT bytes into BUF.
2566    Returns true if exactly BYTE_CNT bytes are successfully read.
2567    Aborts if an I/O error or a partial read occurs.
2568    If EOF_IS_OK, then an immediate end-of-file causes false to be
2569    returned; otherwise, immediate end-of-file causes an abort
2570    too. */
2571 static inline bool
2572 read_bytes_internal (struct sfm_reader *r, bool eof_is_ok,
2573                    void *buf, size_t byte_cnt)
2574 {
2575   size_t bytes_read = fread (buf, 1, byte_cnt, r->file);
2576   r->pos += bytes_read;
2577   if (bytes_read == byte_cnt)
2578     return true;
2579   else if (ferror (r->file))
2580     sys_error (r, r->pos, _("System error: %s."), strerror (errno));
2581   else if (!eof_is_ok || bytes_read != 0)
2582     sys_error (r, r->pos, _("Unexpected end of file."));
2583   else
2584     return false;
2585 }
2586
2587 /* Reads BYTE_CNT into BUF.
2588    Aborts upon I/O error or if end-of-file is encountered. */
2589 static void
2590 read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
2591 {
2592   read_bytes_internal (r, false, buf, byte_cnt);
2593 }
2594
2595 /* Reads BYTE_CNT bytes into BUF.
2596    Returns true if exactly BYTE_CNT bytes are successfully read.
2597    Returns false if an immediate end-of-file is encountered.
2598    Aborts if an I/O error or a partial read occurs. */
2599 static bool
2600 try_read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
2601 {
2602   return read_bytes_internal (r, true, buf, byte_cnt);
2603 }
2604
2605 /* Reads a 32-bit signed integer from R and returns its value in
2606    host format. */
2607 static int
2608 read_int (struct sfm_reader *r)
2609 {
2610   uint8_t integer[4];
2611   read_bytes (r, integer, sizeof integer);
2612   return integer_get (r->integer_format, integer, sizeof integer);
2613 }
2614
2615 /* Reads a 64-bit floating-point number from R and returns its
2616    value in host format. */
2617 static double
2618 read_float (struct sfm_reader *r)
2619 {
2620   uint8_t number[8];
2621   read_bytes (r, number, sizeof number);
2622   return float_get_double (r->float_format, number);
2623 }
2624
2625 static int
2626 parse_int (struct sfm_reader *r, const void *data, size_t ofs)
2627 {
2628   return integer_get (r->integer_format, (const uint8_t *) data + ofs, 4);
2629 }
2630
2631 static double
2632 parse_float (struct sfm_reader *r, const void *data, size_t ofs)
2633 {
2634   return float_get_double (r->float_format, (const uint8_t *) data + ofs);
2635 }
2636
2637 /* Reads exactly SIZE - 1 bytes into BUFFER
2638    and stores a null byte into BUFFER[SIZE - 1]. */
2639 static void
2640 read_string (struct sfm_reader *r, char *buffer, size_t size)
2641 {
2642   assert (size > 0);
2643   read_bytes (r, buffer, size - 1);
2644   buffer[size - 1] = '\0';
2645 }
2646
2647 /* Skips BYTES bytes forward in R. */
2648 static void
2649 skip_bytes (struct sfm_reader *r, size_t bytes)
2650 {
2651   while (bytes > 0)
2652     {
2653       char buffer[1024];
2654       size_t chunk = MIN (sizeof buffer, bytes);
2655       read_bytes (r, buffer, chunk);
2656       bytes -= chunk;
2657     }
2658 }
2659 \f
2660 static const struct casereader_class sys_file_casereader_class =
2661   {
2662     sys_file_casereader_read,
2663     sys_file_casereader_destroy,
2664     NULL,
2665     NULL,
2666   };