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

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