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