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