src/data/sys-file-reader.c

   1 /* PSPP - a program for statistical analysis.
   2    Copyright (C) 1997-2000, 2006-2007, 2009-2011 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
  28 #include "data/attributes.h"
  29 #include "data/case.h"
  30 #include "data/casereader-provider.h"
  31 #include "data/casereader.h"
  32 #include "data/dictionary.h"
  33 #include "data/file-handle-def.h"
  34 #include "data/file-name.h"
  35 #include "data/format.h"
  36 #include "data/missing-values.h"
  37 #include "data/mrset.h"
  38 #include "data/short-names.h"
  39 #include "data/value-labels.h"
  40 #include "data/value.h"
  41 #include "data/variable.h"
  42 #include "libpspp/array.h"
  43 #include "libpspp/assertion.h"
  44 #include "libpspp/compiler.h"
  45 #include "libpspp/i18n.h"
  46 #include "libpspp/message.h"
  47 #include "libpspp/misc.h"
  48 #include "libpspp/pool.h"
  49 #include "libpspp/str.h"
  50 #include "libpspp/stringi-set.h"
  51
  52 #include "gl/c-ctype.h"
  53 #include "gl/inttostr.h"
  54 #include "gl/localcharset.h"
  55 #include "gl/minmax.h"
  56 #include "gl/unlocked-io.h"
  57 #include "gl/xalloc.h"
  58 #include "gl/xsize.h"
  59
  60 #include "gettext.h"
  61 #define _(msgid) gettext (msgid)
  62 #define N_(msgid) (msgid)
  63
  64 enum
  65   {
  66     /* subtypes 0-2 unknown */
  67     EXT_INTEGER       = 3,      /* Machine integer info. */
  68     EXT_FLOAT         = 4,      /* Machine floating-point info. */
  69     EXT_VAR_SETS      = 5,      /* Variable sets. */
  70     EXT_DATE          = 6,      /* DATE. */
  71     EXT_MRSETS        = 7,      /* Multiple response sets. */
  72     EXT_DATA_ENTRY    = 8,      /* SPSS Data Entry. */
  73     /* subtypes 9-10 unknown */
  74     EXT_DISPLAY       = 11,     /* Variable display parameters. */
  75     /* subtype 12 unknown */
  76     EXT_LONG_NAMES    = 13,     /* Long variable names. */
  77     EXT_LONG_STRINGS  = 14,     /* Long strings. */
  78     /* subtype 15 unknown */
  79     EXT_NCASES        = 16,     /* Extended number of cases. */
  80     EXT_FILE_ATTRS    = 17,     /* Data file attributes. */
  81     EXT_VAR_ATTRS     = 18,     /* Variable attributes. */
  82     EXT_MRSETS2       = 19,     /* Multiple response sets (extended). */
  83     EXT_ENCODING      = 20,     /* Character encoding. */
  84     EXT_LONG_LABELS   = 21      /* Value labels for long strings. */
  85   };
  86
  87 struct sfm_var_record
  88   {
  89     off_t pos;
  90     int width;
  91     char name[8];
  92     int print_format;
  93     int write_format;
  94     int missing_value_code;
  95     uint8_t missing[24];
  96     char *label;
  97     struct variable *var;
  98   };
  99
 100 struct sfm_value_label
 101   {
 102     uint8_t value[8];
 103     char *label;
 104   };
 105
 106 struct sfm_value_label_record
 107   {
 108     off_t pos;
 109     struct sfm_value_label *labels;
 110     size_t n_labels;
 111
 112     int *vars;
 113     size_t n_vars;
 114   };
 115
 116 struct sfm_document_record
 117   {
 118     off_t pos;
 119     char *documents;
 120     size_t n_lines;
 121   };
 122
 123 struct sfm_extension_record
 124   {
 125     off_t pos;                  /* Starting offset in file. */
 126     size_t size;                /* Size of data elements. */
 127     size_t count;               /* Number of data elements. */
 128     void *data;                 /* Contents. */
 129   };
 130
 131 /* System file reader. */
 132 struct sfm_reader
 133   {
 134     /* Resource tracking. */
 135     struct pool *pool;          /* All system file state. */
 136     jmp_buf bail_out;           /* longjmp() target for error handling. */
 137
 138     /* File state. */
 139     struct file_handle *fh;     /* File handle. */
 140     struct fh_lock *lock;       /* Mutual exclusion for file handle. */
 141     FILE *file;                 /* File stream. */
 142     off_t pos;                  /* Position in file. */
 143     bool error;                 /* I/O or corruption error? */
 144     struct caseproto *proto;    /* Format of output cases. */
 145
 146     /* File format. */
 147     enum integer_format integer_format; /* On-disk integer format. */
 148     enum float_format float_format; /* On-disk floating point format. */
 149     struct sfm_var *sfm_vars;   /* Variables. */
 150     size_t sfm_var_cnt;         /* Number of variables. */
 151     casenumber case_cnt;        /* Number of cases */
 152     const char *encoding;       /* String encoding. */
 153
 154     /* Decompression. */
 155     bool compressed;            /* File is compressed? */
 156     double bias;                /* Compression bias, usually 100.0. */
 157     uint8_t opcodes[8];         /* Current block of opcodes. */
 158     size_t opcode_idx;          /* Next opcode to interpret, 8 if none left. */
 159     bool corruption_warning;    /* Warned about possible corruption? */
 160   };
 161
 162 static const struct casereader_class sys_file_casereader_class;
 163
 164 static bool close_reader (struct sfm_reader *);
 165
 166 static struct variable *lookup_var_by_index (struct sfm_reader *, off_t,
 167                                              const struct sfm_var_record *,
 168                                              size_t n, int idx);
 169
 170 static void sys_msg (struct sfm_reader *r, off_t, int class,
 171                      const char *format, va_list args)
 172      PRINTF_FORMAT (4, 0);
 173 static void sys_warn (struct sfm_reader *, off_t, const char *, ...)
 174      PRINTF_FORMAT (3, 4);
 175 static void sys_error (struct sfm_reader *, off_t, const char *, ...)
 176      PRINTF_FORMAT (3, 4)
 177      NO_RETURN;
 178
 179 static void read_bytes (struct sfm_reader *, void *, size_t);
 180 static bool try_read_bytes (struct sfm_reader *, void *, size_t);
 181 static int read_int (struct sfm_reader *);
 182 static double read_float (struct sfm_reader *);
 183 static void read_string (struct sfm_reader *, char *, size_t);
 184 static void skip_bytes (struct sfm_reader *, size_t);
 185
 186 static int parse_int (struct sfm_reader *, const void *data, size_t ofs);
 187 static double parse_float (struct sfm_reader *, const void *data, size_t ofs);
 188
 189 static void read_variable_record (struct sfm_reader *,
 190                                   struct sfm_var_record *);
 191 static void read_value_label_record (struct sfm_reader *,
 192                                      struct sfm_value_label_record *,
 193                                      size_t n_vars);
 194 static struct sfm_document_record *read_document_record (struct sfm_reader *);
 195 static struct sfm_extension_record *read_extension_record (
 196   struct sfm_reader *, int subtype);
 197 static void skip_extension_record (struct sfm_reader *, int subtype);
 198
 199 static const char *choose_encoding (
 200   struct sfm_reader *,
 201   const struct sfm_extension_record *ext_integer,
 202   const struct sfm_extension_record *ext_encoding);
 203
 204 static struct text_record *open_text_record (
 205   struct sfm_reader *, const struct sfm_extension_record *);
 206 static void close_text_record (struct sfm_reader *,
 207                                struct text_record *);
 208 static bool read_variable_to_value_pair (struct sfm_reader *,
 209                                          struct dictionary *,
 210                                          struct text_record *,
 211                                          struct variable **var, char **value);
 212 static void text_warn (struct sfm_reader *r, struct text_record *text,
 213                        const char *format, ...)
 214   PRINTF_FORMAT (3, 4);
 215 static char *text_get_token (struct text_record *,
 216                              struct substring delimiters, char *delimiter);
 217 static bool text_match (struct text_record *, char c);
 218 static bool text_read_variable_name (struct sfm_reader *, struct dictionary *,
 219                                      struct text_record *,
 220                                      struct substring delimiters,
 221                                      struct variable **);
 222 static bool text_read_short_name (struct sfm_reader *, struct dictionary *,
 223                                   struct text_record *,
 224                                   struct substring delimiters,
 225                                   struct variable **);
 226 static const char *text_parse_counted_string (struct sfm_reader *,
 227                                               struct text_record *);
 228 static size_t text_pos (const struct text_record *);
 229
 230 static bool close_reader (struct sfm_reader *r);
 231 \f
 232 /* Dictionary reader. */
 233
 234 enum which_format
 235   {
 236     PRINT_FORMAT,
 237     WRITE_FORMAT
 238   };
 239
 240 static void read_header (struct sfm_reader *, int *weight_idx,
 241                          int *claimed_oct_cnt, struct sfm_read_info *,
 242                          char **file_labelp);
 243 static void parse_file_label (struct sfm_reader *, const char *file_label,
 244                               struct dictionary *);
 245 static void parse_variable_records (struct sfm_reader *, struct dictionary *,
 246                                     struct sfm_var_record *, size_t n);
 247 static void parse_format_spec (struct sfm_reader *, off_t pos,
 248                                unsigned int format, enum which_format,
 249                                struct variable *, int *format_warning_cnt);
 250 static void parse_document (struct dictionary *, struct sfm_document_record *);
 251 static void parse_display_parameters (struct sfm_reader *,
 252                                       const struct sfm_extension_record *,
 253                                       struct dictionary *);
 254 static void parse_machine_integer_info (struct sfm_reader *,
 255                                         const struct sfm_extension_record *,
 256                                         struct sfm_read_info *);
 257 static void parse_machine_float_info (struct sfm_reader *,
 258                                       const struct sfm_extension_record *);
 259 static void parse_mrsets (struct sfm_reader *,
 260                           const struct sfm_extension_record *,
 261                           struct dictionary *);
 262 static void parse_long_var_name_map (struct sfm_reader *,
 263                                      const struct sfm_extension_record *,
 264                                      struct dictionary *);
 265 static void parse_long_string_map (struct sfm_reader *,
 266                                    const struct sfm_extension_record *,
 267                                    struct dictionary *);
 268 static void parse_value_labels (struct sfm_reader *, struct dictionary *,
 269                                 const struct sfm_var_record *,
 270                                 size_t n_var_recs,
 271                                 const struct sfm_value_label_record *);
 272 static void parse_data_file_attributes (struct sfm_reader *,
 273                                         const struct sfm_extension_record *,
 274                                         struct dictionary *);
 275 static void parse_variable_attributes (struct sfm_reader *,
 276                                        const struct sfm_extension_record *,
 277                                        struct dictionary *);
 278 static void parse_long_string_value_labels (struct sfm_reader *,
 279                                             const struct sfm_extension_record *,
 280                                             struct dictionary *);
 281
 282 /* Opens the system file designated by file handle FH for
 283    reading.  Reads the system file's dictionary into *DICT.
 284    If INFO is non-null, then it receives additional info about the
 285    system file. */
 286 struct casereader *
 287 sfm_open_reader (struct file_handle *fh, struct dictionary **dictp,
 288                  struct sfm_read_info *volatile info)
 289 {
 290   struct sfm_reader *volatile r = NULL;
 291   struct sfm_read_info local_info;
 292
 293   struct sfm_var_record *vars;
 294   size_t n_vars, allocated_vars;
 295
 296   struct sfm_value_label_record *labels;
 297   size_t n_labels, allocated_labels;
 298
 299   struct sfm_document_record *document;
 300
 301   struct sfm_extension_record *extensions[32];
 302
 303   int weight_idx;
 304   int claimed_oct_cnt;
 305   char *file_label;
 306
 307   struct dictionary *dict = NULL;
 308   size_t i;
 309
 310   /* Create and initialize reader. */
 311   r = pool_create_container (struct sfm_reader, pool);
 312   r->fh = fh_ref (fh);
 313   r->lock = NULL;
 314   r->file = NULL;
 315   r->pos = 0;
 316   r->error = false;
 317   r->opcode_idx = sizeof r->opcodes;
 318   r->corruption_warning = false;
 319
 320   /* TRANSLATORS: this fragment will be interpolated into
 321      messages in fh_lock() that identify types of files. */
 322   r->lock = fh_lock (fh, FH_REF_FILE, N_("system file"), FH_ACC_READ, false);
 323   if (r->lock == NULL)
 324     goto error;
 325
 326   r->file = fn_open (fh_get_file_name (fh), "rb");
 327   if (r->file == NULL)
 328     {
 329       msg (ME, _("Error opening `%s' for reading as a system file: %s."),
 330            fh_get_file_name (r->fh), strerror (errno));
 331       goto error;
 332     }
 333
 334   /* Initialize info. */
 335   if (info == NULL)
 336     info = &local_info;
 337   memset (info, 0, sizeof *info);
 338
 339   if (setjmp (r->bail_out))
 340     goto error;
 341
 342   /* Read header. */
 343   read_header (r, &weight_idx, &claimed_oct_cnt, info, &file_label);
 344
 345   vars = NULL;
 346   n_vars = allocated_vars = 0;
 347
 348   labels = NULL;
 349   n_labels = allocated_labels = 0;
 350
 351   document = NULL;
 352
 353   memset (extensions, 0, sizeof extensions);
 354
 355   for (;;)
 356     {
 357       int subtype;
 358       int type;
 359
 360       type = read_int (r);
 361       if (type == 999)
 362         {
 363           read_int (r);         /* Skip filler. */
 364           break;
 365         }
 366
 367       switch (type)
 368         {
 369         case 2:
 370           if (n_vars >= allocated_vars)
 371             vars = pool_2nrealloc (r->pool, vars, &allocated_vars,
 372                                    sizeof *vars);
 373           read_variable_record (r, &vars[n_vars++]);
 374           break;
 375
 376         case 3:
 377           if (n_labels >= allocated_labels)
 378             labels = pool_2nrealloc (r->pool, labels, &allocated_labels,
 379                                      sizeof *labels);
 380           read_value_label_record (r, &labels[n_labels++], n_vars);
 381           break;
 382
 383         case 4:
 384           /* A Type 4 record is always immediately after a type 3 record,
 385              so the code for type 3 records reads the type 4 record too. */
 386           sys_error (r, r->pos, _("Misplaced type 4 record."));
 387
 388         case 6:
 389           if (document != NULL)
 390             sys_error (r, r->pos, _("Duplicate type 6 (document) record."));
 391           document = read_document_record (r);
 392           break;
 393
 394         case 7:
 395           subtype = read_int (r);
 396           if (subtype < 0 || subtype >= sizeof extensions / sizeof *extensions)
 397             {
 398               sys_warn (r, r->pos,
 399                         _("Unrecognized record type 7, subtype %d.  Please "
 400                           "send a copy of this file, and the syntax which "
 401                           "created it to %s."),
 402                         subtype, PACKAGE_BUGREPORT);
 403               skip_extension_record (r, subtype);
 404             }
 405           else if (extensions[subtype] != NULL)
 406             {
 407               sys_warn (r, r->pos,
 408                         _("Record type 7, subtype %d found here has the same "
 409                           "type as the record found near offset 0x%llx.  "
 410                           "Please send a copy of this file, and the syntax "
 411                           "which created it to %s."),
 412                         subtype, (long long int) extensions[subtype]->pos,
 413                         PACKAGE_BUGREPORT);
 414               skip_extension_record (r, subtype);
 415             }
 416           else
 417             extensions[subtype] = read_extension_record (r, subtype);
 418           break;
 419
 420         default:
 421           sys_error (r, r->pos, _("Unrecognized record type %d."), type);
 422           goto error;
 423         }
 424     }
 425
 426   /* Now actually parse what we read.
 427
 428      First, figure out the correct character encoding, because this determines
 429      how the rest of the header data is to be interpreted. */
 430   dict = dict_create ();
 431   r->encoding = choose_encoding (r, extensions[EXT_INTEGER],
 432                                  extensions[EXT_ENCODING]);
 433   dict_set_encoding (dict, r->encoding);
 434
 435   /* These records don't use variables at all. */
 436   if (document != NULL)
 437     parse_document (dict, document);
 438
 439   if (extensions[EXT_INTEGER] != NULL)
 440     parse_machine_integer_info (r, extensions[EXT_INTEGER], info);
 441
 442   if (extensions[EXT_FLOAT] != NULL)
 443     parse_machine_float_info (r, extensions[EXT_FLOAT]);
 444
 445   if (extensions[EXT_FILE_ATTRS] != NULL)
 446     parse_data_file_attributes (r, extensions[EXT_FILE_ATTRS], dict);
 447
 448   parse_file_label (r, file_label, dict);
 449
 450   /* Parse the variable records, the basis of almost everything else. */
 451   parse_variable_records (r, dict, vars, n_vars);
 452
 453   /* Parse value labels and the weight variable immediately after the variable
 454      records.  These records use indexes into var_recs[], so we must parse them
 455      before those indexes become invalidated by very long string variables. */
 456   for (i = 0; i < n_labels; i++)
 457     parse_value_labels (r, dict, vars, n_vars, &labels[i]);
 458   if (weight_idx != 0)
 459     {
 460       struct variable *weight_var;
 461
 462       weight_var = lookup_var_by_index (r, 76, vars, n_vars, weight_idx);
 463       if (var_is_numeric (weight_var))
 464         dict_set_weight (dict, weight_var);
 465       else
 466         sys_error (r, -1, _("Weighting variable must be numeric "
 467                             "(not string variable `%s')."),
 468                    var_get_name (weight_var));
 469     }
 470
 471   if (extensions[EXT_DISPLAY] != NULL)
 472     parse_display_parameters (r, extensions[EXT_DISPLAY], dict);
 473
 474   /* The following records use short names, so they need to be parsed before
 475      parse_long_var_name_map() changes short names to long names. */
 476   if (extensions[EXT_MRSETS] != NULL)
 477     parse_mrsets (r, extensions[EXT_MRSETS], dict);
 478
 479   if (extensions[EXT_MRSETS2] != NULL)
 480     parse_mrsets (r, extensions[EXT_MRSETS2], dict);
 481
 482   if (extensions[EXT_LONG_STRINGS] != NULL)
 483     parse_long_string_map (r, extensions[EXT_LONG_STRINGS], dict);
 484
 485   /* Now rename variables to their long names. */
 486   parse_long_var_name_map (r, extensions[EXT_LONG_NAMES], dict);
 487
 488   /* The following records use long names, so they need to follow renaming. */
 489   if (extensions[EXT_VAR_ATTRS] != NULL)
 490     parse_variable_attributes (r, extensions[EXT_VAR_ATTRS], dict);
 491
 492   if (extensions[EXT_LONG_LABELS] != NULL)
 493     parse_long_string_value_labels (r, extensions[EXT_LONG_LABELS], dict);
 494
 495   /* Warn if the actual amount of data per case differs from the
 496      amount that the header claims.  SPSS version 13 gets this
 497      wrong when very long strings are involved, so don't warn in
 498      that case. */
 499   if (claimed_oct_cnt != -1 && claimed_oct_cnt != n_vars
 500       && info->version_major != 13)
 501     sys_warn (r, -1, _("File header claims %d variable positions but "
 502                        "%d were read from file."),
 503               claimed_oct_cnt, n_vars);
 504
 505   /* Create an index of dictionary variable widths for
 506      sfm_read_case to use.  We cannot use the `struct variable's
 507      from the dictionary we created, because the caller owns the
 508      dictionary and may destroy or modify its variables. */
 509   sfm_dictionary_to_sfm_vars (dict, &r->sfm_vars, &r->sfm_var_cnt);
 510   pool_register (r->pool, free, r->sfm_vars);
 511   r->proto = caseproto_ref_pool (dict_get_proto (dict), r->pool);
 512
 513   *dictp = dict;
 514   return casereader_create_sequential
 515     (NULL, r->proto,
 516      r->case_cnt == -1 ? CASENUMBER_MAX: r->case_cnt,
 517                                        &sys_file_casereader_class, r);
 518
 519 error:
 520   close_reader (r);
 521   dict_destroy (dict);
 522   *dictp = NULL;
 523   return NULL;
 524 }
 525
 526 /* Closes a system file after we're done with it.
 527    Returns true if an I/O error has occurred on READER, false
 528    otherwise. */
 529 static bool
 530 close_reader (struct sfm_reader *r)
 531 {
 532   bool error;
 533
 534   if (r == NULL)
 535     return true;
 536
 537   if (r->file)
 538     {
 539       if (fn_close (fh_get_file_name (r->fh), r->file) == EOF)
 540         {
 541           msg (ME, _("Error closing system file `%s': %s."),
 542                fh_get_file_name (r->fh), strerror (errno));
 543           r->error = true;
 544         }
 545       r->file = NULL;
 546     }
 547
 548   fh_unlock (r->lock);
 549   fh_unref (r->fh);
 550
 551   error = r->error;
 552   pool_destroy (r->pool);
 553
 554   return !error;
 555 }
 556
 557 /* Destroys READER. */
 558 static void
 559 sys_file_casereader_destroy (struct casereader *reader UNUSED, void *r_)
 560 {
 561   struct sfm_reader *r = r_;
 562   close_reader (r);
 563 }
 564
 565 /* Returns true if FILE is an SPSS system file,
 566    false otherwise. */
 567 bool
 568 sfm_detect (FILE *file)
 569 {
 570   char rec_type[5];
 571
 572   if (fread (rec_type, 4, 1, file) != 1)
 573     return false;
 574   rec_type[4] = '\0';
 575
 576   return !strcmp ("$FL2", rec_type);
 577 }
 578 \f
 579 /* Reads the global header of the system file.  Sets *WEIGHT_IDX to 0 if the
 580    system file is unweighted, or to the value index of the weight variable
 581    otherwise.  Sets *CLAIMED_OCT_CNT to the number of "octs" (8-byte units) per
 582    case that the file claims to have (although it is not always correct).
 583    Initializes INFO with header information.  Stores the file label as a string
 584    in dictionary encoding into *FILE_LABELP. */
 585 static void
 586 read_header (struct sfm_reader *r, int *weight_idx,
 587              int *claimed_oct_cnt, struct sfm_read_info *info,
 588              char **file_labelp)
 589 {
 590   char rec_type[5];
 591   char eye_catcher[61];
 592   uint8_t raw_layout_code[4];
 593   uint8_t raw_bias[8];
 594   char creation_date[10];
 595   char creation_time[9];
 596   char file_label[65];
 597   struct substring product;
 598
 599   read_string (r, rec_type, sizeof rec_type);
 600   read_string (r, eye_catcher, sizeof eye_catcher);
 601
 602   if (strcmp ("$FL2", rec_type) != 0)
 603     sys_error (r, 0, _("This is not an SPSS system file."));
 604
 605   /* Identify integer format. */
 606   read_bytes (r, raw_layout_code, sizeof raw_layout_code);
 607   if ((!integer_identify (2, raw_layout_code, sizeof raw_layout_code,
 608                           &r->integer_format)
 609        && !integer_identify (3, raw_layout_code, sizeof raw_layout_code,
 610                              &r->integer_format))
 611       || (r->integer_format != INTEGER_MSB_FIRST
 612           && r->integer_format != INTEGER_LSB_FIRST))
 613     sys_error (r, 64, _("This is not an SPSS system file."));
 614
 615   *claimed_oct_cnt = read_int (r);
 616   if (*claimed_oct_cnt < 0 || *claimed_oct_cnt > INT_MAX / 16)
 617     *claimed_oct_cnt = -1;
 618
 619   r->compressed = read_int (r) != 0;
 620
 621   *weight_idx = read_int (r);
 622
 623   r->case_cnt = read_int (r);
 624   if ( r->case_cnt > INT_MAX / 2)
 625     r->case_cnt = -1;
 626
 627   /* Identify floating-point format and obtain compression bias. */
 628   read_bytes (r, raw_bias, sizeof raw_bias);
 629   if (float_identify (100.0, raw_bias, sizeof raw_bias, &r->float_format) == 0)
 630     {
 631       uint8_t zero_bias[8] = { 0, 0, 0, 0, 0, 0, 0, 0 };
 632
 633       if (memcmp (raw_bias, zero_bias, 8))
 634         sys_warn (r, r->pos - 8,
 635                   _("Compression bias is not the usual "
 636                     "value of 100, or system file uses unrecognized "
 637                     "floating-point format."));
 638       else
 639         {
 640           /* Some software is known to write all-zeros to this
 641              field.  Such software also writes floating-point
 642              numbers in the format that we expect by default
 643              (it seems that all software most likely does, in
 644              reality), so don't warn in this case. */
 645         }
 646
 647       if (r->integer_format == INTEGER_MSB_FIRST)
 648         r->float_format = FLOAT_IEEE_DOUBLE_BE;
 649       else
 650         r->float_format = FLOAT_IEEE_DOUBLE_LE;
 651     }
 652   float_convert (r->float_format, raw_bias, FLOAT_NATIVE_DOUBLE, &r->bias);
 653
 654   read_string (r, creation_date, sizeof creation_date);
 655   read_string (r, creation_time, sizeof creation_time);
 656   read_string (r, file_label, sizeof file_label);
 657   skip_bytes (r, 3);
 658
 659   strcpy (info->creation_date, creation_date);
 660   strcpy (info->creation_time, creation_time);
 661   info->integer_format = r->integer_format;
 662   info->float_format = r->float_format;
 663   info->compressed = r->compressed;
 664   info->case_cnt = r->case_cnt;
 665
 666   product = ss_cstr (eye_catcher);
 667   ss_match_string (&product, ss_cstr ("@(#) SPSS DATA FILE"));
 668   ss_trim (&product, ss_cstr (" "));
 669   str_copy_buf_trunc (info->product, sizeof info->product,
 670                       ss_data (product), ss_length (product));
 671
 672   *file_labelp = pool_strdup0 (r->pool, file_label, sizeof file_label - 1);
 673 }
 674
 675 /* Reads a variable (type 2) record from R into RECORD. */
 676 static void
 677 read_variable_record (struct sfm_reader *r, struct sfm_var_record *record)
 678 {
 679   int has_variable_label;
 680
 681   memset (record, 0, sizeof *record);
 682
 683   record->pos = r->pos;
 684   record->width = read_int (r);
 685   has_variable_label = read_int (r);
 686   record->missing_value_code = read_int (r);
 687   record->print_format = read_int (r);
 688   record->write_format = read_int (r);
 689   read_bytes (r, record->name, sizeof record->name);
 690
 691   if (has_variable_label == 1)
 692     {
 693       enum { MAX_LABEL_LEN = 255 };
 694       size_t len, read_len;
 695
 696       len = read_int (r);
 697
 698       /* Read up to MAX_LABEL_LEN bytes of label. */
 699       read_len = MIN (MAX_LABEL_LEN, len);
 700       record->label = xmalloc (read_len + 1);
 701       read_string (r, record->label, read_len + 1);
 702
 703       /* Skip unread label bytes. */
 704       skip_bytes (r, len - read_len);
 705
 706       /* Skip label padding up to multiple of 4 bytes. */
 707       skip_bytes (r, ROUND_UP (len, 4) - len);
 708     }
 709   else if (has_variable_label != 0)
 710     sys_error (r, record->pos,
 711                _("Variable label indicator field is not 0 or 1."));
 712
 713   /* Set missing values. */
 714   if (record->missing_value_code != 0)
 715     {
 716       int code = record->missing_value_code;
 717       if (record->width == 0)
 718         {
 719           if (code < -3 || code > 3 || code == -1)
 720             sys_error (r, record->pos,
 721                        _("Numeric missing value indicator field is not "
 722                          "-3, -2, 0, 1, 2, or 3."));
 723         }
 724       else
 725         {
 726           if (code < 1 || code > 3)
 727             sys_error (r, record->pos,
 728                        _("String missing value indicator field is not "
 729                          "0, 1, 2, or 3."));
 730         }
 731
 732       read_bytes (r, record->missing, 8 * abs (code));
 733     }
 734 }
 735
 736 /* Reads value labels from R into RECORD. */
 737 static void
 738 read_value_label_record (struct sfm_reader *r,
 739                          struct sfm_value_label_record *record,
 740                          size_t n_vars)
 741 {
 742   size_t i;
 743
 744   /* Read type 3 record. */
 745   record->pos = r->pos;
 746   record->n_labels = read_int (r);
 747   if (record->n_labels > SIZE_MAX / sizeof *record->labels)
 748     sys_error (r, r->pos - 4, _("Invalid number of labels %zu."),
 749                record->n_labels);
 750   record->labels = pool_nmalloc (r->pool, record->n_labels,
 751                                  sizeof *record->labels);
 752   for (i = 0; i < record->n_labels; i++)
 753     {
 754       struct sfm_value_label *label = &record->labels[i];
 755       unsigned char label_len;
 756       size_t padded_len;
 757
 758       read_bytes (r, label->value, sizeof label->value);
 759
 760       /* Read label length. */
 761       read_bytes (r, &label_len, sizeof label_len);
 762       padded_len = ROUND_UP (label_len + 1, 8);
 763
 764       /* Read label, padding. */
 765       label->label = pool_malloc (r->pool, padded_len + 1);
 766       read_bytes (r, label->label, padded_len - 1);
 767       label->label[label_len] = '\0';
 768     }
 769
 770   /* Read record type of type 4 record. */
 771   if (read_int (r) != 4)
 772     sys_error (r, r->pos - 4,
 773                _("Variable index record (type 4) does not immediately "
 774                  "follow value label record (type 3) as it should."));
 775
 776   /* Read number of variables associated with value label from type 4
 777      record. */
 778   record->n_vars = read_int (r);
 779   if (record->n_vars < 1 || record->n_vars > n_vars)
 780     sys_error (r, r->pos - 4,
 781                _("Number of variables associated with a value label (%d) "
 782                  "is not between 1 and the number of variables (%zu)."),
 783                record->n_vars, n_vars);
 784   record->vars = pool_nmalloc (r->pool, record->n_vars, sizeof *record->vars);
 785   for (i = 0; i < record->n_vars; i++)
 786     record->vars[i] = read_int (r);
 787 }
 788
 789 /* Reads a document record from R and returns it. */
 790 static struct sfm_document_record *
 791 read_document_record (struct sfm_reader *r)
 792 {
 793   struct sfm_document_record *record;
 794   int n_lines;
 795
 796   record = pool_malloc (r->pool, sizeof *record);
 797   record->pos = r->pos;
 798
 799   n_lines = read_int (r);
 800   if (n_lines <= 0 || n_lines >= INT_MAX / DOC_LINE_LENGTH)
 801     sys_error (r, record->pos,
 802                _("Number of document lines (%d) "
 803                  "must be greater than 0 and less than %d."),
 804                n_lines, INT_MAX / DOC_LINE_LENGTH);
 805
 806   record->n_lines = n_lines;
 807   record->documents = pool_malloc (r->pool, DOC_LINE_LENGTH * n_lines);
 808   read_bytes (r, record->documents, DOC_LINE_LENGTH * n_lines);
 809
 810   return record;
 811 }
 812
 813 static void
 814 read_extension_record_header (struct sfm_reader *r, int subtype,
 815                               struct sfm_extension_record *record)
 816 {
 817   record->pos = r->pos;
 818   record->size = read_int (r);
 819   record->count = read_int (r);
 820
 821   /* Check that SIZE * COUNT + 1 doesn't overflow.  Adding 1
 822      allows an extra byte for a null terminator, used by some
 823      extension processing routines. */
 824   if (record->size != 0
 825       && size_overflow_p (xsum (1, xtimes (record->count, record->size))))
 826     sys_error (r, record->pos, "Record type 7 subtype %d too large.", subtype);
 827 }
 828
 829 /* Reads an extension record from R into RECORD. */
 830 static struct sfm_extension_record *
 831 read_extension_record (struct sfm_reader *r, int subtype)
 832 {
 833   struct extension_record_type
 834     {
 835       int subtype;
 836       int size;
 837       int count;
 838     };
 839
 840   static const struct extension_record_type types[] =
 841     {
 842       /* Implemented record types. */
 843       { EXT_INTEGER,      4, 8 },
 844       { EXT_FLOAT,        8, 3 },
 845       { EXT_MRSETS,       1, 0 },
 846       { EXT_DISPLAY,      4, 0 },
 847       { EXT_LONG_NAMES,   1, 0 },
 848       { EXT_LONG_STRINGS, 1, 0 },
 849       { EXT_NCASES,       8, 2 },
 850       { EXT_FILE_ATTRS,   1, 0 },
 851       { EXT_VAR_ATTRS,    1, 0 },
 852       { EXT_MRSETS2,      1, 0 },
 853       { EXT_ENCODING,     1, 0 },
 854       { EXT_LONG_LABELS,  1, 0 },
 855
 856       /* Ignored record types. */
 857       { EXT_VAR_SETS,     0, 0 },
 858       { EXT_DATE,         0, 0 },
 859       { EXT_DATA_ENTRY,   0, 0 },
 860     };
 861
 862   const struct extension_record_type *type;
 863   struct sfm_extension_record *record;
 864   size_t n_bytes;
 865
 866   record = pool_malloc (r->pool, sizeof *record);
 867   read_extension_record_header (r, subtype, record);
 868   n_bytes = record->count * record->size;
 869
 870   for (type = types; type < &types[sizeof types / sizeof *types]; type++)
 871     if (subtype == type->subtype)
 872       {
 873         if (type->size > 0 && record->size != type->size)
 874           sys_warn (r, record->pos,
 875                     _("Record type 7, subtype %d has bad size %zu "
 876                       "(expected %d)."), subtype, record->size, type->size);
 877         else if (type->count > 0 && record->count != type->count)
 878           sys_warn (r, record->pos,
 879                     _("Record type 7, subtype %d has bad count %zu "
 880                       "(expected %d)."), subtype, record->count, type->count);
 881         else if (type->count == 0 && type->size == 0)
 882           {
 883             /* Ignore this record. */
 884           }
 885         else
 886           {
 887             char *data = pool_malloc (r->pool, n_bytes + 1);
 888             data[n_bytes] = '\0';
 889
 890             record->data = data;
 891             read_bytes (r, record->data, n_bytes);
 892             return record;
 893           }
 894
 895         goto skip;
 896       }
 897
 898   sys_warn (r, record->pos,
 899             _("Unrecognized record type 7, subtype %d.  Please send a "
 900               "copy of this file, and the syntax which created it to %s."),
 901             subtype, PACKAGE_BUGREPORT);
 902
 903 skip:
 904   skip_bytes (r, n_bytes);
 905   return NULL;
 906 }
 907
 908 static void
 909 skip_extension_record (struct sfm_reader *r, int subtype)
 910 {
 911   struct sfm_extension_record record;
 912
 913   read_extension_record_header (r, subtype, &record);
 914   skip_bytes (r, record.count * record.size);
 915 }
 916
 917 static void
 918 parse_file_label (struct sfm_reader *r, const char *file_label,
 919                   struct dictionary *dict)
 920 {
 921   char *utf8_file_label;
 922   size_t file_label_len;
 923
 924   utf8_file_label = recode_string_pool ("UTF-8", dict_get_encoding (dict),
 925                                         file_label, -1, r->pool);
 926   file_label_len = strlen (utf8_file_label);
 927   while (file_label_len > 0 && utf8_file_label[file_label_len - 1] == ' ')
 928     file_label_len--;
 929   utf8_file_label[file_label_len] = '\0';
 930   dict_set_label (dict, utf8_file_label);
 931 }
 932
 933 /* Reads a variable (type 2) record from R and adds the
 934    corresponding variable to DICT.
 935    Also skips past additional variable records for long string
 936    variables. */
 937 static void
 938 parse_variable_records (struct sfm_reader *r, struct dictionary *dict,
 939                         struct sfm_var_record *var_recs, size_t n_var_recs)
 940 {
 941   const char *dict_encoding = dict_get_encoding (dict);
 942   struct sfm_var_record *rec;
 943   int n_warnings = 0;
 944
 945   for (rec = var_recs; rec < &var_recs[n_var_recs]; )
 946     {
 947       struct variable *var;
 948       size_t n_values;
 949       char *name;
 950       size_t i;
 951
 952       name = recode_string_pool ("UTF-8", dict_encoding,
 953                                  rec->name, 8, r->pool);
 954       name[strcspn (name, " ")] = '\0';
 955
 956       if (!var_is_valid_name (name, false) || name[0] == '$' || name[0] == '#')
 957         sys_error (r, rec->pos, _("Invalid variable name `%s'."), name);
 958
 959       if (rec->width < 0 || rec->width > 255)
 960         sys_error (r, rec->pos,
 961                    _("Bad width %d for variable %s."), rec->width, name);
 962
 963       var = rec->var = dict_create_var (dict, name, rec->width);
 964       if (var == NULL)
 965         sys_error (r, rec->pos, _("Duplicate variable name `%s'."), name);
 966
 967       /* Set the short name the same as the long name. */
 968       var_set_short_name (var, 0, name);
 969
 970       /* Get variable label, if any. */
 971       if (rec->label)
 972         {
 973           char *utf8_label;
 974
 975           utf8_label = recode_string_pool ("UTF-8", dict_encoding,
 976                                            rec->label, -1, r->pool);
 977           var_set_label (var, utf8_label);
 978         }
 979
 980       /* Set missing values. */
 981       if (rec->missing_value_code != 0)
 982         {
 983           int width = var_get_width (var);
 984           struct missing_values mv;
 985
 986           mv_init_pool (r->pool, &mv, width);
 987           if (var_is_numeric (var))
 988             {
 989               bool has_range = rec->missing_value_code < 0;
 990               int n_discrete = (has_range
 991                                 ? rec->missing_value_code == -3
 992                                 : rec->missing_value_code);
 993               int ofs = 0;
 994
 995               if (has_range)
 996                 {
 997                   double low = parse_float (r, rec->missing, 0);
 998                   double high = parse_float (r, rec->missing, 8);
 999                   mv_add_range (&mv, low, high);
1000                   ofs += 16;
1001                 }
1002
1003               for (i = 0; i < n_discrete; i++)
1004                 {
1005                   mv_add_num (&mv, parse_float (r, rec->missing, ofs));
1006                   ofs += 8;
1007                 }
1008             }
1009           else
1010             {
1011               union value value;
1012
1013               value_init_pool (r->pool, &value, width);
1014               value_set_missing (&value, width);
1015               for (i = 0; i < rec->missing_value_code; i++)
1016                 {
1017                   uint8_t *s = value_str_rw (&value, width);
1018                   memcpy (s, rec->missing + 8 * i, MIN (width, 8));
1019                   mv_add_str (&mv, s);
1020                 }
1021             }
1022           var_set_missing_values (var, &mv);
1023         }
1024
1025       /* Set formats. */
1026       parse_format_spec (r, rec->pos + 12, rec->print_format,
1027                          PRINT_FORMAT, var, &n_warnings);
1028       parse_format_spec (r, rec->pos + 16, rec->write_format,
1029                          WRITE_FORMAT, var, &n_warnings);
1030
1031       /* Account for values.
1032          Skip long string continuation records, if any. */
1033       n_values = rec->width == 0 ? 1 : DIV_RND_UP (rec->width, 8);
1034       for (i = 1; i < n_values; i++)
1035         if (i + (rec - var_recs) >= n_var_recs || rec[i].width != -1)
1036           sys_error (r, rec->pos, _("Missing string continuation record."));
1037       rec += n_values;
1038     }
1039 }
1040
1041 /* Translates the format spec from sysfile format to internal
1042    format. */
1043 static void
1044 parse_format_spec (struct sfm_reader *r, off_t pos, unsigned int format,
1045                    enum which_format which, struct variable *v,
1046                    int *n_warnings)
1047 {
1048   const int max_warnings = 8;
1049   uint8_t raw_type = format >> 16;
1050   uint8_t w = format >> 8;
1051   uint8_t d = format;
1052   struct fmt_spec f;
1053
1054   bool ok;
1055
1056   if (!fmt_from_io (raw_type, &f.type))
1057     sys_error (r, pos, _("Unknown variable format %"PRIu8"."), raw_type);
1058   f.w = w;
1059   f.d = d;
1060
1061   msg_disable ();
1062   ok = fmt_check_output (&f) && fmt_check_width_compat (&f, var_get_width (v));
1063   msg_enable ();
1064
1065   if (ok)
1066     {
1067       if (which == PRINT_FORMAT)
1068         var_set_print_format (v, &f);
1069       else
1070         var_set_write_format (v, &f);
1071     }
1072   else if (++*n_warnings <= max_warnings)
1073     {
1074       char fmt_string[FMT_STRING_LEN_MAX + 1];
1075       sys_warn (r, pos, _("%s variable %s has invalid %s format %s."),
1076                 var_is_numeric (v) ? _("Numeric") : _("String"),
1077                 var_get_name (v),
1078                 which == PRINT_FORMAT ? _("print") : _("write"),
1079                 fmt_to_string (&f, fmt_string));
1080
1081       if (*n_warnings == max_warnings)
1082         sys_warn (r, -1, _("Suppressing further invalid format warnings."));
1083     }
1084 }
1085
1086 static void
1087 parse_document (struct dictionary *dict, struct sfm_document_record *record)
1088 {
1089   const char *p;
1090
1091   for (p = record->documents;
1092        p < record->documents + DOC_LINE_LENGTH * record->n_lines;
1093        p += DOC_LINE_LENGTH)
1094     {
1095       struct substring line;
1096
1097       line = recode_substring_pool ("UTF-8", dict_get_encoding (dict),
1098                                     ss_buffer (p, DOC_LINE_LENGTH), NULL);
1099       ss_rtrim (&line, ss_cstr (" "));
1100       line.string[line.length] = '\0';
1101
1102       dict_add_document_line (dict, line.string);
1103
1104       ss_dealloc (&line);
1105     }
1106 }
1107
1108 /* Parses record type 7, subtype 3. */
1109 static void
1110 parse_machine_integer_info (struct sfm_reader *r,
1111                             const struct sfm_extension_record *record,
1112                             struct sfm_read_info *info)
1113 {
1114   int float_representation, expected_float_format;
1115   int integer_representation, expected_integer_format;
1116
1117   /* Save version info. */
1118   info->version_major = parse_int (r, record->data, 0);
1119   info->version_minor = parse_int (r, record->data, 4);
1120   info->version_revision = parse_int (r, record->data, 8);
1121
1122   /* Check floating point format. */
1123   float_representation = parse_int (r, record->data, 16);
1124   if (r->float_format == FLOAT_IEEE_DOUBLE_BE
1125       || r->float_format == FLOAT_IEEE_DOUBLE_LE)
1126     expected_float_format = 1;
1127   else if (r->float_format == FLOAT_Z_LONG)
1128     expected_float_format = 2;
1129   else if (r->float_format == FLOAT_VAX_G || r->float_format == FLOAT_VAX_D)
1130     expected_float_format = 3;
1131   else
1132     NOT_REACHED ();
1133   if (float_representation != expected_float_format)
1134     sys_error (r, record->pos, _("Floating-point representation indicated by "
1135                  "system file (%d) differs from expected (%d)."),
1136                float_representation, expected_float_format);
1137
1138   /* Check integer format. */
1139   integer_representation = parse_int (r, record->data, 24);
1140   if (r->integer_format == INTEGER_MSB_FIRST)
1141     expected_integer_format = 1;
1142   else if (r->integer_format == INTEGER_LSB_FIRST)
1143     expected_integer_format = 2;
1144   else
1145     NOT_REACHED ();
1146   if (integer_representation != expected_integer_format)
1147     sys_warn (r, record->pos,
1148               _("Integer format indicated by system file (%d) "
1149                 "differs from expected (%d)."),
1150               integer_representation, expected_integer_format);
1151
1152 }
1153
1154 static const char *
1155 choose_encoding (struct sfm_reader *r,
1156                  const struct sfm_extension_record *ext_integer,
1157                  const struct sfm_extension_record *ext_encoding)
1158 {
1159   /* The EXT_ENCODING record is a more reliable way to determine dictionary
1160      encoding. */
1161   if (ext_encoding)
1162     return ext_encoding->data;
1163
1164   /* But EXT_INTEGER is better than nothing as a fallback. */
1165   if (ext_integer)
1166     {
1167       int codepage = parse_int (r, ext_integer->data, 7 * 4);
1168
1169       switch (codepage)
1170         {
1171         case 1:
1172           return "EBCDIC-US";
1173
1174         case 2:
1175         case 3:
1176           /* These ostensibly mean "7-bit ASCII" and "8-bit ASCII"[sic]
1177              respectively.  However, there are known to be many files in the wild
1178              with character code 2, yet have data which are clearly not ASCII.
1179              Therefore we ignore these values. */
1180           break;
1181
1182         case 4:
1183           return "MS_KANJI";
1184
1185         case 65000:
1186           return "UTF-7";
1187
1188         case 65001:
1189           return "UTF-8";
1190
1191         default:
1192           return pool_asprintf (r->pool, "CP%d", codepage);
1193         }
1194     }
1195
1196   return locale_charset ();
1197 }
1198
1199 /* Parses record type 7, subtype 4. */
1200 static void
1201 parse_machine_float_info (struct sfm_reader *r,
1202                           const struct sfm_extension_record *record)
1203 {
1204   double sysmis = parse_float (r, record->data, 0);
1205   double highest = parse_float (r, record->data, 8);
1206   double lowest = parse_float (r, record->data, 16);
1207
1208   if (sysmis != SYSMIS)
1209     sys_warn (r, record->pos, _("File specifies unexpected value %g as %s."),
1210               sysmis, "SYSMIS");
1211
1212   if (highest != HIGHEST)
1213     sys_warn (r, record->pos, _("File specifies unexpected value %g as %s."),
1214               highest, "HIGHEST");
1215
1216   if (lowest != LOWEST)
1217     sys_warn (r, record->pos, _("File specifies unexpected value %g as %s."),
1218               lowest, "LOWEST");
1219 }
1220
1221 /* Parses record type 7, subtype 7 or 19. */
1222 static void
1223 parse_mrsets (struct sfm_reader *r, const struct sfm_extension_record *record,
1224               struct dictionary *dict)
1225 {
1226   struct text_record *text;
1227   struct mrset *mrset;
1228
1229   text = open_text_record (r, record);
1230   for (;;)
1231     {
1232       const char *counted = NULL;
1233       const char *name;
1234       const char *label;
1235       struct stringi_set var_names;
1236       size_t allocated_vars;
1237       char delimiter;
1238       int width;
1239
1240       mrset = xzalloc (sizeof *mrset);
1241
1242       name = text_get_token (text, ss_cstr ("="), NULL);
1243       if (name == NULL)
1244         break;
1245       mrset->name = xstrdup (name);
1246
1247       if (mrset->name[0] != '$')
1248         {
1249           sys_warn (r, record->pos,
1250                     _("`%s' does not begin with `$' at UTF-8 offset %zu "
1251                       "in MRSETS record."), mrset->name, text_pos (text));
1252           break;
1253         }
1254
1255       if (text_match (text, 'C'))
1256         {
1257           mrset->type = MRSET_MC;
1258           if (!text_match (text, ' '))
1259             {
1260               sys_warn (r, record->pos,
1261                         _("Missing space following `%c' at UTF-8 offset %zu "
1262                           "in MRSETS record."), 'C', text_pos (text));
1263               break;
1264             }
1265         }
1266       else if (text_match (text, 'D'))
1267         {
1268           mrset->type = MRSET_MD;
1269           mrset->cat_source = MRSET_VARLABELS;
1270         }
1271       else if (text_match (text, 'E'))
1272         {
1273           char *number;
1274
1275           mrset->type = MRSET_MD;
1276           mrset->cat_source = MRSET_COUNTEDVALUES;
1277           if (!text_match (text, ' '))
1278             {
1279               sys_warn (r, record->pos,
1280                         _("Missing space following `%c' at UTF-8 offset %zu "
1281                           "in MRSETS record."), 'E',  text_pos (text));
1282               break;
1283             }
1284
1285           number = text_get_token (text, ss_cstr (" "), NULL);
1286           if (!strcmp (number, "11"))
1287             mrset->label_from_var_label = true;
1288           else if (strcmp (number, "1"))
1289             sys_warn (r, record->pos,
1290                       _("Unexpected label source value `%s' following `E' "
1291                         "at UTF-8 offset %zu in MRSETS record."),
1292                       number, text_pos (text));
1293         }
1294       else
1295         {
1296           sys_warn (r, record->pos,
1297                     _("Missing `C', `D', or `E' at UTF-8 offset %zu "
1298                       "in MRSETS record."),
1299                     text_pos (text));
1300           break;
1301         }
1302
1303       if (mrset->type == MRSET_MD)
1304         {
1305           counted = text_parse_counted_string (r, text);
1306           if (counted == NULL)
1307             break;
1308         }
1309
1310       label = text_parse_counted_string (r, text);
1311       if (label == NULL)
1312         break;
1313       mrset->label = label[0] != '\0' ? xstrdup (label) : NULL;
1314
1315       stringi_set_init (&var_names);
1316       allocated_vars = 0;
1317       width = INT_MAX;
1318       do
1319         {
1320           struct variable *var;
1321           const char *var_name;
1322
1323           var_name = text_get_token (text, ss_cstr (" \n"), &delimiter);
1324           if (var_name == NULL)
1325             {
1326               sys_warn (r, record->pos,
1327                         _("Missing new-line parsing variable names "
1328                           "at UTF-8 offset %zu in MRSETS record."),
1329                         text_pos (text));
1330               break;
1331             }
1332
1333           var = dict_lookup_var (dict, var_name);
1334           if (var == NULL)
1335             continue;
1336           if (!stringi_set_insert (&var_names, var_name))
1337             {
1338               sys_warn (r, record->pos,
1339                         _("Duplicate variable name %s "
1340                           "at UTF-8 offset %zu in MRSETS record."),
1341                         var_name, text_pos (text));
1342               continue;
1343             }
1344
1345           if (mrset->label == NULL && mrset->label_from_var_label
1346               && var_has_label (var))
1347             mrset->label = xstrdup (var_get_label (var));
1348
1349           if (mrset->n_vars
1350               && var_get_type (var) != var_get_type (mrset->vars[0]))
1351             {
1352               sys_warn (r, record->pos,
1353                         _("MRSET %s contains both string and "
1354                           "numeric variables."), name);
1355               continue;
1356             }
1357           width = MIN (width, var_get_width (var));
1358
1359           if (mrset->n_vars >= allocated_vars)
1360             mrset->vars = x2nrealloc (mrset->vars, &allocated_vars,
1361                                       sizeof *mrset->vars);
1362           mrset->vars[mrset->n_vars++] = var;
1363         }
1364       while (delimiter != '\n');
1365
1366       if (mrset->n_vars < 2)
1367         {
1368           sys_warn (r, record->pos,
1369                     _("MRSET %s has only %zu variables."), mrset->name,
1370                     mrset->n_vars);
1371           mrset_destroy (mrset);
1372           continue;
1373         }
1374
1375       if (mrset->type == MRSET_MD)
1376         {
1377           mrset->width = width;
1378           value_init (&mrset->counted, width);
1379           if (width == 0)
1380             mrset->counted.f = strtod (counted, NULL);
1381           else
1382             value_copy_str_rpad (&mrset->counted, width,
1383                                  (const uint8_t *) counted, ' ');
1384         }
1385
1386       dict_add_mrset (dict, mrset);
1387       mrset = NULL;
1388       stringi_set_destroy (&var_names);
1389     }
1390   mrset_destroy (mrset);
1391   close_text_record (r, text);
1392 }
1393
1394 /* Read record type 7, subtype 11, which specifies how variables
1395    should be displayed in GUI environments. */
1396 static void
1397 parse_display_parameters (struct sfm_reader *r,
1398                          const struct sfm_extension_record *record,
1399                          struct dictionary *dict)
1400 {
1401   bool includes_width;
1402   bool warned = false;
1403   size_t n_vars;
1404   size_t ofs;
1405   size_t i;
1406
1407   n_vars = dict_get_var_cnt (dict);
1408   if (record->count == 3 * n_vars)
1409     includes_width = true;
1410   else if (record->count == 2 * n_vars)
1411     includes_width = false;
1412   else
1413     {
1414       sys_warn (r, record->pos,
1415                 _("Extension 11 has bad count %zu (for %zu variables)."),
1416                 record->count, n_vars);
1417       return;
1418     }
1419
1420   ofs = 0;
1421   for (i = 0; i < n_vars; ++i)
1422     {
1423       struct variable *v = dict_get_var (dict, i);
1424       int measure, width, align;
1425
1426       measure = parse_int (r, record->data, ofs);
1427       ofs += 4;
1428
1429       if (includes_width)
1430         {
1431           width = parse_int (r, record->data, ofs);
1432           ofs += 4;
1433         }
1434       else
1435         width = 0;
1436
1437       align = parse_int (r, record->data, ofs);
1438       ofs += 4;
1439
1440       /* SPSS 14 sometimes seems to set string variables' measure
1441          to zero. */
1442       if (0 == measure && var_is_alpha (v))
1443         measure = 1;
1444
1445       if (measure < 1 || measure > 3 || align < 0 || align > 2)
1446         {
1447           if (!warned)
1448             sys_warn (r, record->pos,
1449                       _("Invalid variable display parameters for variable "
1450                         "%zu (%s).  Default parameters substituted."),
1451                       i, var_get_name (v));
1452           warned = true;
1453           continue;
1454         }
1455
1456       var_set_measure (v, (measure == 1 ? MEASURE_NOMINAL
1457                            : measure == 2 ? MEASURE_ORDINAL
1458                            : MEASURE_SCALE));
1459       var_set_alignment (v, (align == 0 ? ALIGN_LEFT
1460                              : align == 1 ? ALIGN_RIGHT
1461                              : ALIGN_CENTRE));
1462
1463       /* Older versions (SPSS 9.0) sometimes set the display
1464          width to zero.  This causes confusion in the GUI, so
1465          only set the width if it is nonzero. */
1466       if (width > 0)
1467         var_set_display_width (v, width);
1468     }
1469 }
1470
1471 static void
1472 rename_var_and_save_short_names (struct dictionary *dict, struct variable *var,
1473                                  const char *new_name)
1474 {
1475   size_t n_short_names;
1476   char **short_names;
1477   size_t i;
1478
1479   /* Renaming a variable may clear its short names, but we
1480      want to retain them, so we save them and re-set them
1481      afterward. */
1482   n_short_names = var_get_short_name_cnt (var);
1483   short_names = xnmalloc (n_short_names, sizeof *short_names);
1484   for (i = 0; i < n_short_names; i++)
1485     {
1486       const char *s = var_get_short_name (var, i);
1487       short_names[i] = s != NULL ? xstrdup (s) : NULL;
1488     }
1489
1490   /* Set long name. */
1491   dict_rename_var (dict, var, new_name);
1492
1493   /* Restore short names. */
1494   for (i = 0; i < n_short_names; i++)
1495     {
1496       var_set_short_name (var, i, short_names[i]);
1497       free (short_names[i]);
1498     }
1499   free (short_names);
1500 }
1501
1502 /* Parses record type 7, subtype 13, which gives the long name that corresponds
1503    to each short name.  Modifies variable names in DICT accordingly.  */
1504 static void
1505 parse_long_var_name_map (struct sfm_reader *r,
1506                          const struct sfm_extension_record *record,
1507                          struct dictionary *dict)
1508 {
1509   struct text_record *text;
1510   struct variable *var;
1511   char *long_name;
1512
1513   if (record == NULL)
1514     {
1515       /* Convert variable names to lowercase. */
1516       size_t i;
1517
1518       for (i = 0; i < dict_get_var_cnt (dict); i++)
1519         {
1520           struct variable *var = dict_get_var (dict, i);
1521           char *new_name;
1522
1523           new_name = xstrdup (var_get_name (var));
1524           str_lowercase (new_name);
1525
1526           rename_var_and_save_short_names (dict, var, new_name);
1527
1528           free (new_name);
1529         }
1530
1531       return;
1532     }
1533
1534   /* Rename each of the variables, one by one.  (In a correctly constructed
1535      system file, this cannot create any intermediate duplicate variable names,
1536      because all of the new variable names are longer than any of the old
1537      variable names and thus there cannot be any overlaps.) */
1538   text = open_text_record (r, record);
1539   while (read_variable_to_value_pair (r, dict, text, &var, &long_name))
1540     {
1541       /* Validate long name. */
1542       if (!var_is_valid_name (long_name, false))
1543         {
1544           sys_warn (r, record->pos,
1545                     _("Long variable mapping from %s to invalid "
1546                       "variable name `%s'."),
1547                     var_get_name (var), long_name);
1548           continue;
1549         }
1550
1551       /* Identify any duplicates. */
1552       if (strcasecmp (var_get_short_name (var, 0), long_name)
1553           && dict_lookup_var (dict, long_name) != NULL)
1554         {
1555           sys_warn (r, record->pos,
1556                     _("Duplicate long variable name `%s'."), long_name);
1557           continue;
1558         }
1559
1560       rename_var_and_save_short_names (dict, var, long_name);
1561     }
1562   close_text_record (r, text);
1563 }
1564
1565 /* Reads record type 7, subtype 14, which gives the real length
1566    of each very long string.  Rearranges DICT accordingly. */
1567 static void
1568 parse_long_string_map (struct sfm_reader *r,
1569                        const struct sfm_extension_record *record,
1570                        struct dictionary *dict)
1571 {
1572   struct text_record *text;
1573   struct variable *var;
1574   char *length_s;
1575
1576   text = open_text_record (r, record);
1577   while (read_variable_to_value_pair (r, dict, text, &var, &length_s))
1578     {
1579       size_t idx = var_get_dict_index (var);
1580       long int length;
1581       int segment_cnt;
1582       int i;
1583
1584       /* Get length. */
1585       length = strtol (length_s, NULL, 10);
1586       if (length < 1 || length > MAX_STRING)
1587         {
1588           sys_warn (r, record->pos,
1589                     _("%s listed as string of invalid length %s "
1590                       "in very long string record."),
1591                     var_get_name (var), length_s);
1592           continue;
1593         }
1594
1595       /* Check segments. */
1596       segment_cnt = sfm_width_to_segments (length);
1597       if (segment_cnt == 1)
1598         {
1599           sys_warn (r, record->pos,
1600                     _("%s listed in very long string record with width %s, "
1601                       "which requires only one segment."),
1602                     var_get_name (var), length_s);
1603           continue;
1604         }
1605       if (idx + segment_cnt > dict_get_var_cnt (dict))
1606         sys_error (r, record->pos,
1607                    _("Very long string %s overflows dictionary."),
1608                    var_get_name (var));
1609
1610       /* Get the short names from the segments and check their
1611          lengths. */
1612       for (i = 0; i < segment_cnt; i++)
1613         {
1614           struct variable *seg = dict_get_var (dict, idx + i);
1615           int alloc_width = sfm_segment_alloc_width (length, i);
1616           int width = var_get_width (seg);
1617
1618           if (i > 0)
1619             var_set_short_name (var, i, var_get_short_name (seg, 0));
1620           if (ROUND_UP (width, 8) != ROUND_UP (alloc_width, 8))
1621             sys_error (r, record->pos,
1622                        _("Very long string with width %ld has segment %d "
1623                          "of width %d (expected %d)."),
1624                        length, i, width, alloc_width);
1625         }
1626       dict_delete_consecutive_vars (dict, idx + 1, segment_cnt - 1);
1627       var_set_width (var, length);
1628     }
1629   close_text_record (r, text);
1630   dict_compact_values (dict);
1631 }
1632
1633 static void
1634 parse_value_labels (struct sfm_reader *r, struct dictionary *dict,
1635                     const struct sfm_var_record *var_recs, size_t n_var_recs,
1636                     const struct sfm_value_label_record *record)
1637 {
1638   struct variable **vars;
1639   char **utf8_labels;
1640   size_t i;
1641
1642   utf8_labels = pool_nmalloc (r->pool, sizeof *utf8_labels, record->n_labels);
1643   for (i = 0; i < record->n_labels; i++)
1644     utf8_labels[i] = recode_string_pool ("UTF-8", dict_get_encoding (dict),
1645                                          record->labels[i].label, -1,
1646                                          r->pool);
1647
1648   vars = pool_nmalloc (r->pool, record->n_vars, sizeof *vars);
1649   for (i = 0; i < record->n_vars; i++)
1650     vars[i] = lookup_var_by_index (r, record->pos,
1651                                    var_recs, n_var_recs, record->vars[i]);
1652
1653   for (i = 1; i < record->n_vars; i++)
1654     if (var_get_type (vars[i]) != var_get_type (vars[0]))
1655       sys_error (r, record->pos,
1656                  _("Variables associated with value label are not all of "
1657                    "identical type.  Variable %s is %s, but variable "
1658                    "%s is %s."),
1659                  var_get_name (vars[0]),
1660                  var_is_numeric (vars[0]) ? _("numeric") : _("string"),
1661                  var_get_name (vars[i]),
1662                  var_is_numeric (vars[i]) ? _("numeric") : _("string"));
1663
1664   for (i = 0; i < record->n_vars; i++)
1665     {
1666       struct variable *var = vars[i];
1667       int width;
1668       size_t j;
1669
1670       width = var_get_width (var);
1671       if (width > 8)
1672         sys_error (r, record->pos,
1673                    _("Value labels may not be added to long string "
1674                      "variables (e.g. %s) using records types 3 and 4."),
1675                    var_get_name (var));
1676
1677       for (j = 0; j < record->n_labels; j++)
1678         {
1679           struct sfm_value_label *label = &record->labels[j];
1680           union value value;
1681
1682           value_init (&value, width);
1683           if (width == 0)
1684             value.f = parse_float (r, label->value, 0);
1685           else
1686             memcpy (value_str_rw (&value, width), label->value, width);
1687
1688           if (!var_add_value_label (var, &value, utf8_labels[j]))
1689             {
1690               if (var_is_numeric (var))
1691                 sys_warn (r, record->pos,
1692                           _("Duplicate value label for %g on %s."),
1693                           value.f, var_get_name (var));
1694               else
1695                 sys_warn (r, record->pos,
1696                           _("Duplicate value label for `%.*s' on %s."),
1697                           width, value_str (&value, width),
1698                           var_get_name (var));
1699             }
1700
1701           value_destroy (&value, width);
1702         }
1703     }
1704
1705   pool_free (r->pool, vars);
1706   for (i = 0; i < record->n_labels; i++)
1707     pool_free (r->pool, utf8_labels[i]);
1708   pool_free (r->pool, utf8_labels);
1709 }
1710
1711 static struct variable *
1712 lookup_var_by_index (struct sfm_reader *r, off_t offset,
1713                      const struct sfm_var_record *var_recs, size_t n_var_recs,
1714                      int idx)
1715 {
1716   const struct sfm_var_record *rec;
1717
1718   if (idx < 1 || idx > n_var_recs)
1719     {
1720       sys_error (r, offset,
1721                  _("Variable index %d not in valid range 1...%d."),
1722                  idx, n_var_recs);
1723       return NULL;
1724     }
1725
1726   rec = &var_recs[idx - 1];
1727   if (rec->var == NULL)
1728     {
1729       sys_error (r, offset,
1730                  _("Variable index %d refers to long string continuation."),
1731                  idx);
1732       return NULL;
1733     }
1734
1735   return rec->var;
1736 }
1737
1738 /* Parses a set of custom attributes from TEXT into ATTRS.
1739    ATTRS may be a null pointer, in which case the attributes are
1740    read but discarded. */
1741 static void
1742 parse_attributes (struct sfm_reader *r, struct text_record *text,
1743                   struct attrset *attrs)
1744 {
1745   do
1746     {
1747       struct attribute *attr;
1748       char *key;
1749       int index;
1750
1751       /* Parse the key. */
1752       key = text_get_token (text, ss_cstr ("("), NULL);
1753       if (key == NULL)
1754         return;
1755
1756       attr = attribute_create (key);
1757       for (index = 1; ; index++)
1758         {
1759           /* Parse the value. */
1760           char *value;
1761           size_t length;
1762
1763           value = text_get_token (text, ss_cstr ("\n"), NULL);
1764           if (value == NULL)
1765             {
1766               text_warn (r, text, _("Error parsing attribute value %s[%d]."),
1767                          key, index);
1768               break;
1769             }
1770
1771           length = strlen (value);
1772           if (length >= 2 && value[0] == '\'' && value[length - 1] == '\'')
1773             {
1774               value[length - 1] = '\0';
1775               attribute_add_value (attr, value + 1);
1776             }
1777           else
1778             {
1779               text_warn (r, text,
1780                          _("Attribute value %s[%d] is not quoted: %s."),
1781                          key, index, value);
1782               attribute_add_value (attr, value);
1783             }
1784
1785           /* Was this the last value for this attribute? */
1786           if (text_match (text, ')'))
1787             break;
1788         }
1789       if (attrs != NULL)
1790         attrset_add (attrs, attr);
1791       else
1792         attribute_destroy (attr);
1793     }
1794   while (!text_match (text, '/'));
1795 }
1796
1797 /* Reads record type 7, subtype 17, which lists custom
1798    attributes on the data file.  */
1799 static void
1800 parse_data_file_attributes (struct sfm_reader *r,
1801                             const struct sfm_extension_record *record,
1802                             struct dictionary *dict)
1803 {
1804   struct text_record *text = open_text_record (r, record);
1805   parse_attributes (r, text, dict_get_attributes (dict));
1806   close_text_record (r, text);
1807 }
1808
1809 /* Parses record type 7, subtype 18, which lists custom
1810    attributes on individual variables.  */
1811 static void
1812 parse_variable_attributes (struct sfm_reader *r,
1813                            const struct sfm_extension_record *record,
1814                            struct dictionary *dict)
1815 {
1816   struct text_record *text;
1817   struct variable *var;
1818
1819   text = open_text_record (r, record);
1820   while (text_read_variable_name (r, dict, text, ss_cstr (":"), &var))
1821     parse_attributes (r, text, var != NULL ? var_get_attributes (var) : NULL);
1822   close_text_record (r, text);
1823 }
1824
1825 static void
1826 check_overflow (struct sfm_reader *r,
1827                 const struct sfm_extension_record *record,
1828                 size_t ofs, size_t length)
1829 {
1830   size_t end = record->size * record->count;
1831   if (length >= end || ofs + length > end)
1832     sys_error (r, record->pos + end,
1833                _("Long string value label record ends unexpectedly."));
1834 }
1835
1836 static void
1837 parse_long_string_value_labels (struct sfm_reader *r,
1838                                 const struct sfm_extension_record *record,
1839                                 struct dictionary *dict)
1840 {
1841   const char *dict_encoding = dict_get_encoding (dict);
1842   size_t end = record->size * record->count;
1843   size_t ofs = 0;
1844
1845   while (ofs < end)
1846     {
1847       char *var_name;
1848       size_t n_labels, i;
1849       struct variable *var;
1850       union value value;
1851       int var_name_len;
1852       int width;
1853
1854       /* Parse variable name length. */
1855       check_overflow (r, record, ofs, 4);
1856       var_name_len = parse_int (r, record->data, ofs);
1857       ofs += 4;
1858
1859       /* Parse variable name, width, and number of labels. */
1860       check_overflow (r, record, ofs, var_name_len + 8);
1861       var_name = recode_string_pool ("UTF-8", dict_encoding,
1862                                      (const char *) record->data + ofs,
1863                                      var_name_len, r->pool);
1864       width = parse_int (r, record->data, ofs + var_name_len);
1865       n_labels = parse_int (r, record->data, ofs + var_name_len + 4);
1866       ofs += var_name_len + 8;
1867
1868       /* Look up 'var' and validate. */
1869       var = dict_lookup_var (dict, var_name);
1870       if (var == NULL)
1871         sys_warn (r, record->pos + ofs,
1872                   _("Ignoring long string value record for "
1873                     "unknown variable %s."), var_name);
1874       else if (var_is_numeric (var))
1875         {
1876           sys_warn (r, record->pos + ofs,
1877                     _("Ignoring long string value record for "
1878                       "numeric variable %s."), var_name);
1879           var = NULL;
1880         }
1881       else if (width != var_get_width (var))
1882         {
1883           sys_warn (r, record->pos + ofs,
1884                     _("Ignoring long string value record for variable %s "
1885                       "because the record's width (%d) does not match the "
1886                       "variable's width (%d)."),
1887                     var_name, width, var_get_width (var));
1888           var = NULL;
1889         }
1890
1891       /* Parse values. */
1892       value_init_pool (r->pool, &value, width);
1893       for (i = 0; i < n_labels; i++)
1894         {
1895           size_t value_length, label_length;
1896           bool skip = var == NULL;
1897
1898           /* Parse value length. */
1899           check_overflow (r, record, ofs, 4);
1900           value_length = parse_int (r, record->data, ofs);
1901           ofs += 4;
1902
1903           /* Parse value. */
1904           check_overflow (r, record, ofs, value_length);
1905           if (!skip)
1906             {
1907               if (value_length == width)
1908                 memcpy (value_str_rw (&value, width),
1909                         (const uint8_t *) record->data + ofs, width);
1910               else
1911                 {
1912                   sys_warn (r, record->pos + ofs,
1913                             _("Ignoring long string value %zu for variable "
1914                               "%s, with width %d, that has bad value "
1915                               "width %zu."),
1916                             i, var_get_name (var), width, value_length);
1917                   skip = true;
1918                 }
1919             }
1920           ofs += value_length;
1921
1922           /* Parse label length. */
1923           check_overflow (r, record, ofs, 4);
1924           label_length = parse_int (r, record->data, ofs);
1925           ofs += 4;
1926
1927           /* Parse label. */
1928           check_overflow (r, record, ofs, label_length);
1929           if (!skip)
1930             {
1931               char *label;
1932
1933               label = recode_string_pool ("UTF-8", dict_encoding,
1934                                           (const char *) record->data + ofs,
1935                                           label_length, r->pool);
1936               if (!var_add_value_label (var, &value, label))
1937                 sys_warn (r, record->pos + ofs,
1938                           _("Duplicate value label for `%.*s' on %s."),
1939                           width, value_str (&value, width),
1940                           var_get_name (var));
1941               pool_free (r->pool, label);
1942             }
1943           ofs += label_length;
1944         }
1945     }
1946 }
1947 \f
1948 /* Case reader. */
1949
1950 static void partial_record (struct sfm_reader *r)
1951      NO_RETURN;
1952
1953 static void read_error (struct casereader *, const struct sfm_reader *);
1954
1955 static bool read_case_number (struct sfm_reader *, double *);
1956 static bool read_case_string (struct sfm_reader *, uint8_t *, size_t);
1957 static int read_opcode (struct sfm_reader *);
1958 static bool read_compressed_number (struct sfm_reader *, double *);
1959 static bool read_compressed_string (struct sfm_reader *, uint8_t *);
1960 static bool read_whole_strings (struct sfm_reader *, uint8_t *, size_t);
1961 static bool skip_whole_strings (struct sfm_reader *, size_t);
1962
1963 /* Reads and returns one case from READER's file.  Returns a null
1964    pointer if not successful. */
1965 static struct ccase *
1966 sys_file_casereader_read (struct casereader *reader, void *r_)
1967 {
1968   struct sfm_reader *r = r_;
1969   struct ccase *volatile c;
1970   int i;
1971
1972   if (r->error)
1973     return NULL;
1974
1975   c = case_create (r->proto);
1976   if (setjmp (r->bail_out))
1977     {
1978       casereader_force_error (reader);
1979       case_unref (c);
1980       return NULL;
1981     }
1982
1983   for (i = 0; i < r->sfm_var_cnt; i++)
1984     {
1985       struct sfm_var *sv = &r->sfm_vars[i];
1986       union value *v = case_data_rw_idx (c, sv->case_index);
1987
1988       if (sv->var_width == 0)
1989         {
1990           if (!read_case_number (r, &v->f))
1991             goto eof;
1992         }
1993       else
1994         {
1995           uint8_t *s = value_str_rw (v, sv->var_width);
1996           if (!read_case_string (r, s + sv->offset, sv->segment_width))
1997             goto eof;
1998           if (!skip_whole_strings (r, ROUND_DOWN (sv->padding, 8)))
1999             partial_record (r);
2000         }
2001     }
2002   return c;
2003
2004 eof:
2005   if (i != 0)
2006     partial_record (r);
2007   if (r->case_cnt != -1)
2008     read_error (reader, r);
2009   case_unref (c);
2010   return NULL;
2011 }
2012
2013 /* Issues an error that R ends in a partial record. */
2014 static void
2015 partial_record (struct sfm_reader *r)
2016 {
2017   sys_error (r, r->pos, _("File ends in partial case."));
2018 }
2019
2020 /* Issues an error that an unspecified error occurred SFM, and
2021    marks R tainted. */
2022 static void
2023 read_error (struct casereader *r, const struct sfm_reader *sfm)
2024 {
2025   msg (ME, _("Error reading case from file %s."), fh_get_name (sfm->fh));
2026   casereader_force_error (r);
2027 }
2028
2029 /* Reads a number from R and stores its value in *D.
2030    If R is compressed, reads a compressed number;
2031    otherwise, reads a number in the regular way.
2032    Returns true if successful, false if end of file is
2033    reached immediately. */
2034 static bool
2035 read_case_number (struct sfm_reader *r, double *d)
2036 {
2037   if (!r->compressed)
2038     {
2039       uint8_t number[8];
2040       if (!try_read_bytes (r, number, sizeof number))
2041         return false;
2042       float_convert (r->float_format, number, FLOAT_NATIVE_DOUBLE, d);
2043       return true;
2044     }
2045   else
2046     return read_compressed_number (r, d);
2047 }
2048
2049 /* Reads LENGTH string bytes from R into S.
2050    Always reads a multiple of 8 bytes; if LENGTH is not a
2051    multiple of 8, then extra bytes are read and discarded without
2052    being written to S.
2053    Reads compressed strings if S is compressed.
2054    Returns true if successful, false if end of file is
2055    reached immediately. */
2056 static bool
2057 read_case_string (struct sfm_reader *r, uint8_t *s, size_t length)
2058 {
2059   size_t whole = ROUND_DOWN (length, 8);
2060   size_t partial = length % 8;
2061
2062   if (whole)
2063     {
2064       if (!read_whole_strings (r, s, whole))
2065         return false;
2066     }
2067
2068   if (partial)
2069     {
2070       uint8_t bounce[8];
2071       if (!read_whole_strings (r, bounce, sizeof bounce))
2072         {
2073           if (whole)
2074             partial_record (r);
2075           return false;
2076         }
2077       memcpy (s + whole, bounce, partial);
2078     }
2079
2080   return true;
2081 }
2082
2083 /* Reads and returns the next compression opcode from R. */
2084 static int
2085 read_opcode (struct sfm_reader *r)
2086 {
2087   assert (r->compressed);
2088   for (;;)
2089     {
2090       int opcode;
2091       if (r->opcode_idx >= sizeof r->opcodes)
2092         {
2093           if (!try_read_bytes (r, r->opcodes, sizeof r->opcodes))
2094             return -1;
2095           r->opcode_idx = 0;
2096         }
2097       opcode = r->opcodes[r->opcode_idx++];
2098
2099       if (opcode != 0)
2100         return opcode;
2101     }
2102 }
2103
2104 /* Reads a compressed number from R and stores its value in D.
2105    Returns true if successful, false if end of file is
2106    reached immediately. */
2107 static bool
2108 read_compressed_number (struct sfm_reader *r, double *d)
2109 {
2110   int opcode = read_opcode (r);
2111   switch (opcode)
2112     {
2113     case -1:
2114     case 252:
2115       return false;
2116
2117     case 253:
2118       *d = read_float (r);
2119       break;
2120
2121     case 254:
2122       float_convert (r->float_format, "        ", FLOAT_NATIVE_DOUBLE, d);
2123       if (!r->corruption_warning)
2124         {
2125           r->corruption_warning = true;
2126           sys_warn (r, r->pos,
2127                     _("Possible compressed data corruption: "
2128                       "compressed spaces appear in numeric field."));
2129         }
2130       break;
2131
2132     case 255:
2133       *d = SYSMIS;
2134       break;
2135
2136     default:
2137       *d = opcode - r->bias;
2138       break;
2139     }
2140
2141   return true;
2142 }
2143
2144 /* Reads a compressed 8-byte string segment from R and stores it
2145    in DST.
2146    Returns true if successful, false if end of file is
2147    reached immediately. */
2148 static bool
2149 read_compressed_string (struct sfm_reader *r, uint8_t *dst)
2150 {
2151   int opcode = read_opcode (r);
2152   switch (opcode)
2153     {
2154     case -1:
2155     case 252:
2156       return false;
2157
2158     case 253:
2159       read_bytes (r, dst, 8);
2160       break;
2161
2162     case 254:
2163       memset (dst, ' ', 8);
2164       break;
2165
2166     default:
2167       {
2168         double value = opcode - r->bias;
2169         float_convert (FLOAT_NATIVE_DOUBLE, &value, r->float_format, dst);
2170         if (value == 0.0)
2171           {
2172             /* This has actually been seen "in the wild".  The submitter of the
2173                file that showed that the contents decoded as spaces, but they
2174                were at the end of the field so it's possible that the null
2175                bytes just acted as null terminators. */
2176           }
2177         else if (!r->corruption_warning)
2178           {
2179             r->corruption_warning = true;
2180             sys_warn (r, r->pos,
2181                       _("Possible compressed data corruption: "
2182                         "string contains compressed integer (opcode %d)."),
2183                       opcode);
2184           }
2185       }
2186       break;
2187     }
2188
2189   return true;
2190 }
2191
2192 /* Reads LENGTH string bytes from R into S.
2193    LENGTH must be a multiple of 8.
2194    Reads compressed strings if S is compressed.
2195    Returns true if successful, false if end of file is
2196    reached immediately. */
2197 static bool
2198 read_whole_strings (struct sfm_reader *r, uint8_t *s, size_t length)
2199 {
2200   assert (length % 8 == 0);
2201   if (!r->compressed)
2202     return try_read_bytes (r, s, length);
2203   else
2204     {
2205       size_t ofs;
2206       for (ofs = 0; ofs < length; ofs += 8)
2207         if (!read_compressed_string (r, s + ofs))
2208           {
2209             if (ofs != 0)
2210               partial_record (r);
2211             return false;
2212           }
2213       return true;
2214     }
2215 }
2216
2217 /* Skips LENGTH string bytes from R.
2218    LENGTH must be a multiple of 8.
2219    (LENGTH is also limited to 1024, but that's only because the
2220    current caller never needs more than that many bytes.)
2221    Returns true if successful, false if end of file is
2222    reached immediately. */
2223 static bool
2224 skip_whole_strings (struct sfm_reader *r, size_t length)
2225 {
2226   uint8_t buffer[1024];
2227   assert (length < sizeof buffer);
2228   return read_whole_strings (r, buffer, length);
2229 }
2230 \f
2231 /* Helpers for reading records that contain structured text
2232    strings. */
2233
2234 /* Maximum number of warnings to issue for a single text
2235    record. */
2236 #define MAX_TEXT_WARNINGS 5
2237
2238 /* State. */
2239 struct text_record
2240   {
2241     struct substring buffer;    /* Record contents, in UTF-8. */
2242     off_t start;                /* Starting offset in file. */
2243     size_t pos;                 /* Current position in buffer. */
2244     int n_warnings;             /* Number of warnings issued or suppressed. */
2245   };
2246
2247 static struct text_record *
2248 open_text_record (struct sfm_reader *r,
2249                   const struct sfm_extension_record *record)
2250 {
2251   struct text_record *text;
2252   struct substring raw;
2253
2254   text = pool_alloc (r->pool, sizeof *text);
2255   raw = ss_buffer (record->data, record->size * record->count);
2256   text->start = record->pos;
2257   text->buffer = recode_substring_pool ("UTF-8", r->encoding, raw, r->pool);
2258   text->pos = 0;
2259   text->n_warnings = 0;
2260
2261   return text;
2262 }
2263
2264 /* Closes TEXT, frees its storage, and issues a final warning
2265    about suppressed warnings if necesary. */
2266 static void
2267 close_text_record (struct sfm_reader *r, struct text_record *text)
2268 {
2269   if (text->n_warnings > MAX_TEXT_WARNINGS)
2270     sys_warn (r, -1, _("Suppressed %d additional related warnings."),
2271               text->n_warnings - MAX_TEXT_WARNINGS);
2272   pool_free (r->pool, ss_data (text->buffer));
2273 }
2274
2275 /* Reads a variable=value pair from TEXT.
2276    Looks up the variable in DICT and stores it into *VAR.
2277    Stores a null-terminated value into *VALUE. */
2278 static bool
2279 read_variable_to_value_pair (struct sfm_reader *r, struct dictionary *dict,
2280                              struct text_record *text,
2281                              struct variable **var, char **value)
2282 {
2283   for (;;)
2284     {
2285       if (!text_read_short_name (r, dict, text, ss_cstr ("="), var))
2286         return false;
2287
2288       *value = text_get_token (text, ss_buffer ("\t\0", 2), NULL);
2289       if (*value == NULL)
2290         return false;
2291
2292       text->pos += ss_span (ss_substr (text->buffer, text->pos, SIZE_MAX),
2293                             ss_buffer ("\t\0", 2));
2294
2295       if (*var != NULL)
2296         return true;
2297     }
2298 }
2299
2300 static bool
2301 text_read_variable_name (struct sfm_reader *r, struct dictionary *dict,
2302                          struct text_record *text, struct substring delimiters,
2303                          struct variable **var)
2304 {
2305   char *name;
2306
2307   name = text_get_token (text, delimiters, NULL);
2308   if (name == NULL)
2309     return false;
2310
2311   *var = dict_lookup_var (dict, name);
2312   if (*var != NULL)
2313     return true;
2314
2315   text_warn (r, text, _("Dictionary record refers to unknown variable %s."),
2316              name);
2317   return false;
2318 }
2319
2320
2321 static bool
2322 text_read_short_name (struct sfm_reader *r, struct dictionary *dict,
2323                       struct text_record *text, struct substring delimiters,
2324                       struct variable **var)
2325 {
2326   char *short_name = text_get_token (text, delimiters, NULL);
2327   if (short_name == NULL)
2328     return false;
2329
2330   *var = dict_lookup_var (dict, short_name);
2331   if (*var == NULL)
2332     text_warn (r, text, _("Dictionary record refers to unknown variable %s."),
2333                short_name);
2334   return true;
2335 }
2336
2337 /* Displays a warning for the current file position, limiting the
2338    number to MAX_TEXT_WARNINGS for TEXT. */
2339 static void
2340 text_warn (struct sfm_reader *r, struct text_record *text,
2341            const char *format, ...)
2342 {
2343   if (text->n_warnings++ < MAX_TEXT_WARNINGS)
2344     {
2345       va_list args;
2346
2347       va_start (args, format);
2348       sys_msg (r, text->start + text->pos, MW, format, args);
2349       va_end (args);
2350     }
2351 }
2352
2353 static char *
2354 text_get_token (struct text_record *text, struct substring delimiters,
2355                 char *delimiter)
2356 {
2357   struct substring token;
2358   char *end;
2359
2360   if (!ss_tokenize (text->buffer, delimiters, &text->pos, &token))
2361     return NULL;
2362
2363   end = &ss_data (token)[ss_length (token)];
2364   if (delimiter != NULL)
2365     *delimiter = *end;
2366   *end = '\0';
2367   return ss_data (token);
2368 }
2369
2370 /* Reads a integer value expressed in decimal, then a space, then a string that
2371    consists of exactly as many bytes as specified by the integer, then a space,
2372    from TEXT.  Returns the string, null-terminated, as a subset of TEXT's
2373    buffer (so the caller should not free the string). */
2374 static const char *
2375 text_parse_counted_string (struct sfm_reader *r, struct text_record *text)
2376 {
2377   size_t start;
2378   size_t n;
2379   char *s;
2380
2381   start = text->pos;
2382   n = 0;
2383   for (;;)
2384     {
2385       int c = text->buffer.string[text->pos];
2386       if (c < '0' || c > '9')
2387         break;
2388       n = (n * 10) + (c - '0');
2389       text->pos++;
2390     }
2391   if (start == text->pos)
2392     {
2393       sys_warn (r, text->start,
2394                 _("Expecting digit at UTF-8 offset %zu in MRSETS record."),
2395                 text->pos);
2396       return NULL;
2397     }
2398
2399   if (!text_match (text, ' '))
2400     {
2401       sys_warn (r, text->start,
2402                 _("Expecting space at UTF-8 offset %zu in MRSETS record."),
2403                 text->pos);
2404       return NULL;
2405     }
2406
2407   if (text->pos + n > text->buffer.length)
2408     {
2409       sys_warn (r, text->start,
2410                 _("%zu-byte string starting at UTF-8 offset %zu "
2411                   "exceeds record length %zu."),
2412                 n, text->pos, text->buffer.length);
2413       return NULL;
2414     }
2415
2416   s = &text->buffer.string[text->pos];
2417   if (s[n] != ' ')
2418     {
2419       sys_warn (r, text->start,
2420                 _("Expecting space at UTF-8 offset %zu following %zu-byte "
2421                   "string."),
2422                 text->pos + n, n);
2423       return NULL;
2424     }
2425   s[n] = '\0';
2426   text->pos += n + 1;
2427   return s;
2428 }
2429
2430 static bool
2431 text_match (struct text_record *text, char c)
2432 {
2433   if (text->buffer.string[text->pos] == c)
2434     {
2435       text->pos++;
2436       return true;
2437     }
2438   else
2439     return false;
2440 }
2441
2442 /* Returns the current byte offset (as convertd to UTF-8) inside the TEXT's
2443    string. */
2444 static size_t
2445 text_pos (const struct text_record *text)
2446 {
2447   return text->pos;
2448 }
2449 \f
2450 /* Messages. */
2451
2452 /* Displays a corruption message. */
2453 static void
2454 sys_msg (struct sfm_reader *r, off_t offset,
2455          int class, const char *format, va_list args)
2456 {
2457   struct msg m;
2458   struct string text;
2459
2460   ds_init_empty (&text);
2461   if (offset >= 0)
2462     ds_put_format (&text, _("`%s' near offset 0x%llx: "),
2463                    fh_get_file_name (r->fh), (long long int) offset);
2464   else
2465     ds_put_format (&text, _("`%s': "), fh_get_file_name (r->fh));
2466   ds_put_vformat (&text, format, args);
2467
2468   m.category = msg_class_to_category (class);
2469   m.severity = msg_class_to_severity (class);
2470   m.where.file_name = NULL;
2471   m.where.line_number = 0;
2472   m.where.first_column = 0;
2473   m.where.last_column = 0;
2474   m.text = ds_cstr (&text);
2475
2476   msg_emit (&m);
2477 }
2478
2479 /* Displays a warning for offset OFFSET in the file. */
2480 static void
2481 sys_warn (struct sfm_reader *r, off_t offset, const char *format, ...)
2482 {
2483   va_list args;
2484
2485   va_start (args, format);
2486   sys_msg (r, offset, MW, format, args);
2487   va_end (args);
2488 }
2489
2490 /* Displays an error for the current file position,
2491    marks it as in an error state,
2492    and aborts reading it using longjmp. */
2493 static void
2494 sys_error (struct sfm_reader *r, off_t offset, const char *format, ...)
2495 {
2496   va_list args;
2497
2498   va_start (args, format);
2499   sys_msg (r, offset, ME, format, args);
2500   va_end (args);
2501
2502   r->error = true;
2503   longjmp (r->bail_out, 1);
2504 }
2505 \f
2506 /* Reads BYTE_CNT bytes into BUF.
2507    Returns true if exactly BYTE_CNT bytes are successfully read.
2508    Aborts if an I/O error or a partial read occurs.
2509    If EOF_IS_OK, then an immediate end-of-file causes false to be
2510    returned; otherwise, immediate end-of-file causes an abort
2511    too. */
2512 static inline bool
2513 read_bytes_internal (struct sfm_reader *r, bool eof_is_ok,
2514                    void *buf, size_t byte_cnt)
2515 {
2516   size_t bytes_read = fread (buf, 1, byte_cnt, r->file);
2517   r->pos += bytes_read;
2518   if (bytes_read == byte_cnt)
2519     return true;
2520   else if (ferror (r->file))
2521     sys_error (r, r->pos, _("System error: %s."), strerror (errno));
2522   else if (!eof_is_ok || bytes_read != 0)
2523     sys_error (r, r->pos, _("Unexpected end of file."));
2524   else
2525     return false;
2526 }
2527
2528 /* Reads BYTE_CNT into BUF.
2529    Aborts upon I/O error or if end-of-file is encountered. */
2530 static void
2531 read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
2532 {
2533   read_bytes_internal (r, false, buf, byte_cnt);
2534 }
2535
2536 /* Reads BYTE_CNT bytes into BUF.
2537    Returns true if exactly BYTE_CNT bytes are successfully read.
2538    Returns false if an immediate end-of-file is encountered.
2539    Aborts if an I/O error or a partial read occurs. */
2540 static bool
2541 try_read_bytes (struct sfm_reader *r, void *buf, size_t byte_cnt)
2542 {
2543   return read_bytes_internal (r, true, buf, byte_cnt);
2544 }
2545
2546 /* Reads a 32-bit signed integer from R and returns its value in
2547    host format. */
2548 static int
2549 read_int (struct sfm_reader *r)
2550 {
2551   uint8_t integer[4];
2552   read_bytes (r, integer, sizeof integer);
2553   return integer_get (r->integer_format, integer, sizeof integer);
2554 }
2555
2556 /* Reads a 64-bit floating-point number from R and returns its
2557    value in host format. */
2558 static double
2559 read_float (struct sfm_reader *r)
2560 {
2561   uint8_t number[8];
2562   read_bytes (r, number, sizeof number);
2563   return float_get_double (r->float_format, number);
2564 }
2565
2566 static int
2567 parse_int (struct sfm_reader *r, const void *data, size_t ofs)
2568 {
2569   return integer_get (r->integer_format, (const uint8_t *) data + ofs, 4);
2570 }
2571
2572 static double
2573 parse_float (struct sfm_reader *r, const void *data, size_t ofs)
2574 {
2575   return float_get_double (r->float_format, (const uint8_t *) data + ofs);
2576 }
2577
2578 /* Reads exactly SIZE - 1 bytes into BUFFER
2579    and stores a null byte into BUFFER[SIZE - 1]. */
2580 static void
2581 read_string (struct sfm_reader *r, char *buffer, size_t size)
2582 {
2583   assert (size > 0);
2584   read_bytes (r, buffer, size - 1);
2585   buffer[size - 1] = '\0';
2586 }
2587
2588 /* Skips BYTES bytes forward in R. */
2589 static void
2590 skip_bytes (struct sfm_reader *r, size_t bytes)
2591 {
2592   while (bytes > 0)
2593     {
2594       char buffer[1024];
2595       size_t chunk = MIN (sizeof buffer, bytes);
2596       read_bytes (r, buffer, chunk);
2597       bytes -= chunk;
2598     }
2599 }
2600 \f
2601 static const struct casereader_class sys_file_casereader_class =
2602   {
2603     sys_file_casereader_read,
2604     sys_file_casereader_destroy,
2605     NULL,
2606     NULL,
2607   };