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