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