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