pintos-os.org Git - pspp/blob - src/data/sys-file-reader.c

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