1/*
2  Copyright (c) 1990-2009 Info-ZIP.  All rights reserved.
3
4  See the accompanying file LICENSE, version 2009-Jan-02 or later
5  (the contents of which are also included in unzip.h) for terms of use.
6  If, for some reason, all these files are missing, the Info-ZIP license
7  also may be found at:  ftp://ftp.info-zip.org/pub/infozip/license.html
8*/
9/*---------------------------------------------------------------------------
10
11  vms.c                                        Igor Mandrichenko and others
12
13  This file contains routines to extract VMS file attributes from a zipfile
14  extra field and create a file with these attributes.  The code was almost
15  entirely written by Igor, with a couple of routines by GRR and lots of
16  modifications and fixes by Christian Spieler.
17
18  Contains:  check_format()
19             open_outfile()
20             find_vms_attrs()
21             flush()
22             close_outfile()
23             defer_dir_attribs()
24             set_direc_attribs()
25             dos_to_unix_time()         (TIMESTAMP only)
26             stamp_file()               (TIMESTAMP only)
27             vms_msg_text()
28             do_wild()
29             mapattr()
30             mapname()
31             checkdir()
32             check_for_newer()
33             return_VMS
34             screensize()
35             screenlinewrap()
36             version()
37
38  ---------------------------------------------------------------------------*/
39
40#ifdef VMS                      /* VMS only! */
41
42#define UNZIP_INTERNAL
43
44#include "unzip.h"
45#include "crc32.h"
46#include "vms.h"
47#include "vmsdefs.h"
48
49#ifdef MORE
50#  include <ttdef.h>
51#endif
52#include <unixlib.h>
53
54#include <dvidef.h>
55#include <ssdef.h>
56#include <stsdef.h>
57
58/* Workaround for broken header files of older DECC distributions
59 * that are incompatible with the /NAMES=AS_IS qualifier. */
60#define lib$getdvi LIB$GETDVI
61#define lib$getsyi LIB$GETSYI
62#define lib$sys_getmsg LIB$SYS_GETMSG
63#include <lib$routines.h>
64
65#ifndef EEXIST
66#  include <errno.h>    /* For mkdir() status codes */
67#endif
68
69/* On VAX, define Goofy VAX Type-Cast to obviate /standard = vaxc.
70   Otherwise, lame system headers on VAX cause compiler warnings.
71   (GNU C may define vax but not __VAX.)
72*/
73#ifdef vax
74#  define __VAX 1
75#endif
76
77#ifdef __VAX
78#  define GVTC (unsigned int)
79#else
80#  define GVTC
81#endif
82
83/* With GNU C, some FAB bits may be declared only as masks, not as
84 * structure bits.
85 */
86#ifdef __GNUC__
87#  define OLD_FABDEF 1
88#endif
89
90#define ASYNCH_QIO              /* Use asynchronous PK-style QIO writes */
91
92/* buffer size for a single block write (using RMS or QIO WRITEVBLK),
93   must be less than 64k and a multiple of 512 ! */
94#define BUFS512 (((OUTBUFSIZ>0xFFFF) ? 0xFFFF : OUTBUFSIZ) & (~511))
95/* buffer size for record output (RMS limit for max. record size) */
96#define BUFSMAXREC 32767
97/* allocation size for RMS and QIO output buffers */
98#define BUFSALLOC (BUFS512 * 2 > BUFSMAXREC ? BUFS512 * 2 : BUFSMAXREC)
99        /* locbuf size */
100
101/* VMS success or warning status */
102#define OK(s)   (((s) & STS$M_SUCCESS) != 0)
103#define STRICMP(s1, s2) STRNICMP(s1, s2, 2147483647)
104
105/* Interactive inquiry response codes for replace(). */
106
107#define REPL_NO_EXTRACT   0
108#define REPL_NEW_VERSION  1
109#define REPL_OVERWRITE    2
110#define REPL_ERRLV_WARN   256
111#define REPL_TASKMASK     255
112
113/* 2008-09-13 CS.
114 * Note: In extract.c, there are similar strings "InvalidResponse" and
115 * "AssumeNone" defined.  However, as the UI functionality of the VMS
116 * "version-aware" query is slightly different from the generic variant,
117 * these strings are kept separate for now to allow independent
118 * "fine tuning" without affecting the other variant of the
119 * "overwrite or ..." user query.
120 */
121ZCONST char Far InvalidResponse[] =
122  "error:  invalid response [%.1s]\n";
123ZCONST char Far AssumeNo[] =
124  "\n(EOF or read error, treating as \"[N]o extract (all)\" ...)\n";
125
126
127#ifdef SET_DIR_ATTRIB
128/* Structure for holding directory attribute data for final processing
129 * after all files are in place.
130 */
131typedef struct vmsdirattr {
132    struct vmsdirattr *next;            /* link to next in (linked) list */
133    char *fn;                           /* file (directory) name */
134
135    /* Non-VMS attributes data */
136    ulg mod_dos_datetime;               /* G.lrec.last_mod_dos_datetime */
137    unsigned perms;                     /* same as min_info.file_attr */
138
139    unsigned xlen;                      /* G.lrec.extra_field_length */
140    char buf[1];                        /* data buffer (extra_field, fn) */
141} vmsdirattr;
142#define VmsAtt(d)  ((vmsdirattr *)d)    /* typecast shortcut */
143#endif /* SET_DIR_ATTRIB */
144
145/*
146 *   Local static storage
147 */
148static struct FAB        fileblk;       /* File Access Block */
149static struct XABDAT     dattim;        /* date-time XAB */
150static struct XABRDT     rdt;           /* revision date-time XAB */
151static struct RAB        rab;           /* Record Access Block */
152static struct NAM_STRUCT nam;           /* name block */
153
154static struct FAB *outfab = NULL;
155static struct RAB *outrab = NULL;
156static struct XABFHC *xabfhc = NULL;    /* file header characteristics */
157static struct XABDAT *xabdat = NULL;    /* date-time */
158static struct XABRDT *xabrdt = NULL;    /* revision date-time */
159static struct XABPRO *xabpro = NULL;    /* protection */
160static struct XABKEY *xabkey = NULL;    /* key (indexed) */
161static struct XABALL *xaball = NULL;    /* allocation */
162static struct XAB *first_xab = NULL, *last_xab = NULL;
163
164static int replace_code_all = -1;       /* All-file response for replace(). */
165
166static uch rfm;
167
168static uch locbuf[BUFSALLOC];           /* Space for 2 buffers of BUFS512 */
169static unsigned loccnt = 0;
170static uch *locptr;
171static char got_eol = 0;
172
173struct bufdsc
174{
175    struct bufdsc *next;
176    uch *buf;
177    unsigned bufcnt;
178};
179
180static struct bufdsc b1, b2, *curbuf;   /* buffer ring for asynchronous I/O */
181
182static int  _flush_blocks(__GPRO__ uch *rawbuf, unsigned size, int final_flag);
183static int  _flush_stream(__GPRO__ uch *rawbuf, unsigned size, int final_flag);
184static int  _flush_varlen(__GPRO__ uch *rawbuf, unsigned size, int final_flag);
185static int  _flush_qio(__GPRO__ uch *rawbuf, unsigned size, int final_flag);
186static int  _close_rms(__GPRO);
187static int  _close_qio(__GPRO);
188#ifdef ASYNCH_QIO
189static int  WriteQIO(__GPRO__ uch *buf, unsigned len);
190#endif
191static int  WriteBuffer(__GPRO__ uch *buf, unsigned len);
192static int  WriteRecord(__GPRO__ uch *rec, unsigned len);
193
194static int  (*_flush_routine)(__GPRO__ uch *rawbuf, unsigned size,
195                              int final_flag);
196static int  (*_close_routine)(__GPRO);
197
198#ifdef SYMLINKS
199static int  _read_link_rms(__GPRO__ int byte_count, char *link_text_buf);
200#endif /* SYMLINKS */
201
202static void init_buf_ring(void);
203static void set_default_datetime_XABs(__GPRO);
204static int  create_default_output(__GPRO);
205static int  create_rms_output(__GPRO);
206static int  create_qio_output(__GPRO);
207static int  replace(__GPRO);
208static int  replace_rms_newversion(__GPRO);
209static int  replace_rms_overwrite(__GPRO);
210static int  find_vms_attrs(__GPRO__ int set_date_time);
211static void free_up(void);
212#ifdef CHECK_VERSIONS
213static int  get_vms_version(char *verbuf, int len);
214#endif /* CHECK_VERSIONS */
215static unsigned find_eol(ZCONST uch *p, unsigned n, unsigned *l);
216#ifdef SET_DIR_ATTRIB
217static char *vms_path_fixdown(ZCONST char *dir_spec, char *dir_file);
218#endif
219#ifdef TIMESTAMP
220static time_t mkgmtime(struct tm *tm);
221static void uxtime2vmstime(time_t utimeval, long int binval[2]);
222#endif /* TIMESTAMP */
223static int vms_msg_fetch(int status);
224static void vms_msg(__GPRO__ ZCONST char *string, int status);
225
226
227/*
228   2005-02-14 SMS.
229   Added some ODS5 support:
230      Use longer name structures in NAML, where available.
231      Locate special characters mindful of "^" escapes.
232*/
233
234/* Hex digit table. */
235
236char hex_digit[16] = {
237 '0', '1', '2', '3', '4', '5', '6', '7',
238 '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'
239};
240
241
242/* Character property table for converting Zip file names to
243   (simpler) ODS2 or (escaped) ODS5 extended file names.
244
245   ODS2 valid characters: 0-9 A-Z a-z $ - _
246
247   ODS5 Invalid characters:
248      C0 control codes (0x00 to 0x1F inclusive)
249      Asterisk (*)
250      Question mark (?)
251
252   ODS5 Invalid characters only in VMS V7.2 (which no one runs, right?):
253      Double quotation marks (")
254      Backslash (\)
255      Colon (:)
256      Left angle bracket (<)
257      Right angle bracket (>)
258      Slash (/)
259      Vertical bar (|)
260
261   Characters escaped by "^":
262      SP  !  "  #  %  &  '  (  )  +  ,  .  :  ;  =
263       @  [  \  ]  ^  `  {  |  }  ~
264
265   Either "^_" or "^ " is accepted as a space.  Period (.) is a special
266   case.  Note that un-escaped < and > can also confuse a directory
267   spec.
268
269   Characters put out as ^xx:
270      7F (DEL)
271      80-9F (C1 control characters)
272      A0 (nonbreaking space)
273      FF (Latin small letter y diaeresis)
274
275   Other cases:
276      Unicode: "^Uxxxx", where "xxxx" is four hex digits.
277
278   Property table values:
279      Normal ODS2           1
280      Lower-case ODS2       2
281      Period                4
282      Space                 8
283      ODS5 simple          16
284      ODS5 1-char escape   32
285      ODS5 hex-hex escape  64
286*/
287
288unsigned char char_prop[256] = {
289
290/* NUL SOH STX ETX EOT ENQ ACK BEL   BS  HT  LF  VT  FF  CR  SO  SI */
291    0,  0,  0,  0,  0,  0,  0,  0,   0,  0,  0,  0,  0,  0,  0,  0,
292
293/* DLE DC1 DC2 DC3 DC4 NAK SYN ETB  CAN  EM SUB ESC  FS  GS  RS  US */
294    0,  0,  0,  0,  0,  0,  0,  0,   0,  0,  0,  0,  0,  0,  0,  0,
295
296/*  SP  !   "   #   $   %   &   '    (   )   *   +   ,   -   .   /  */
297    8, 32, 32, 32, 17, 32, 32, 32,  32, 32,  0, 32, 32, 17,  4,  0,
298
299/*  0   1   2   3   4   5   6   7    8   9   :   ;   <   =   >   ?  */
300   17, 17, 17, 17, 17, 17, 17, 17,  17, 17, 32, 32, 32, 32, 32, 32,
301
302/*  @   A   B   C   D   E   F   G    H   I   J   K   L   M   N   O  */
303   32, 17, 17, 17, 17, 17, 17, 17,  17, 17, 17, 17, 17, 17, 17, 17,
304
305/*  P   Q   R   S   T   U   V   W    X   Y   Z   [   \   ]   ^   _  */
306   17, 17, 17, 17, 17, 17, 17, 17,  17, 17, 17, 32, 32, 32, 32, 17,
307
308/*  `   a   b   c   d   e   f   g    h   i   j   k   l   m   n   o  */
309   32, 18, 18, 18, 18, 18, 18, 18,  18, 18, 18, 18, 18, 18, 18, 18,
310
311/*  p   q   r   s   t   u   v   w    x   y   z   {   |   }   ~  DEL */
312   18, 18, 18, 18, 18, 18, 18, 18,  18, 18, 18, 32, 32, 32, 32, 64,
313
314   64, 64, 64, 64, 64, 64, 64, 64,  64, 64, 64, 64, 64, 64, 64, 64,
315   64, 64, 64, 64, 64, 64, 64, 64,  64, 64, 64, 64, 64, 64, 64, 64,
316   64, 16, 16, 16, 16, 16, 16, 16,  16, 16, 16, 16, 16, 16, 16, 16,
317   16, 16, 16, 16, 16, 16, 16, 16,  16, 16, 16, 16, 16, 16, 16, 16,
318   16, 16, 16, 16, 16, 16, 16, 16,  16, 16, 16, 16, 16, 16, 16, 16,
319   16, 16, 16, 16, 16, 16, 16, 16,  16, 16, 16, 16, 16, 16, 16, 16,
320   16, 16, 16, 16, 16, 16, 16, 16,  16, 16, 16, 16, 16, 16, 16, 16,
321   16, 16, 16, 16, 16, 16, 16, 16,  16, 16, 16, 16, 16, 16, 16, 64
322};
323
324
325/* 2004-11-23 SMS.
326 *
327 *       get_rms_defaults().
328 *
329 *    Get user-specified values from (DCL) SET RMS_DEFAULT.  FAB/RAB
330 *    items of particular interest are:
331 *
332 *       fab$w_deq         default extension quantity (blocks) (write).
333 *       rab$b_mbc         multi-block count.
334 *       rab$b_mbf         multi-buffer count (used with rah and wbh).
335 */
336
337#define DIAG_FLAG (uO.vflag >= 3)
338
339/* Default RMS parameter values.
340 * The default extend quantity (deq) should not matter much here, as the
341 * initial allocation should always be set according to the known file
342 * size, and no extension should be needed.
343 */
344
345#define RMS_DEQ_DEFAULT 16384   /* About 1/4 the max (65535 blocks). */
346#define RMS_MBC_DEFAULT 127     /* The max, */
347#define RMS_MBF_DEFAULT 2       /* Enough to enable rah and wbh. */
348
349/* GETJPI item descriptor structure. */
350typedef struct
351{
352    short buf_len;
353    short itm_cod;
354    void *buf;
355    int *ret_len;
356} jpi_item_t;
357
358/* Durable storage */
359static int rms_defaults_known = 0;
360
361/* JPI item buffers. */
362static unsigned short rms_ext;
363static char rms_mbc;
364static unsigned char rms_mbf;
365
366/* Active RMS item values. */
367unsigned short rms_ext_active;
368char rms_mbc_active;
369unsigned char rms_mbf_active;
370
371/* GETJPI item lengths. */
372static int rms_ext_len;         /* Should come back 2. */
373static int rms_mbc_len;         /* Should come back 1. */
374static int rms_mbf_len;         /* Should come back 1. */
375
376/* Desperation attempts to define unknown macros.  Probably doomed.
377 * If these get used, expect sys$getjpiw() to return %x00000014 =
378 * %SYSTEM-F-BADPARAM, bad parameter value.
379 * They keep compilers with old header files quiet, though.
380 */
381#ifndef JPI$_RMS_EXTEND_SIZE
382#  define JPI$_RMS_EXTEND_SIZE 542
383#endif /* ndef JPI$_RMS_EXTEND_SIZE */
384
385#ifndef JPI$_RMS_DFMBC
386#  define JPI$_RMS_DFMBC 535
387#endif /* ndef JPI$_RMS_DFMBC */
388
389#ifndef JPI$_RMS_DFMBFSDK
390#  define JPI$_RMS_DFMBFSDK 536
391#endif /* ndef JPI$_RMS_DFMBFSDK */
392
393/* GETJPI item descriptor set. */
394
395struct
396{
397    jpi_item_t rms_ext_itm;
398    jpi_item_t rms_mbc_itm;
399    jpi_item_t rms_mbf_itm;
400    int term;
401} jpi_itm_lst =
402     { { 2, JPI$_RMS_EXTEND_SIZE, &rms_ext, &rms_ext_len },
403       { 1, JPI$_RMS_DFMBC, &rms_mbc, &rms_mbc_len },
404       { 1, JPI$_RMS_DFMBFSDK, &rms_mbf, &rms_mbf_len },
405       0
406     };
407
408static int get_rms_defaults()
409{
410    int sts;
411
412    /* Get process RMS_DEFAULT values. */
413
414    sts = sys$getjpiw(0, 0, 0, &jpi_itm_lst, 0, 0, 0);
415    if ((sts & STS$M_SEVERITY) != STS$K_SUCCESS)
416    {
417        /* Failed.  Don't try again. */
418        rms_defaults_known = -1;
419    }
420    else
421    {
422        /* Fine, but don't come back. */
423        rms_defaults_known = 1;
424    }
425
426    /* Limit the active values according to the RMS_DEFAULT values. */
427
428    if (rms_defaults_known > 0)
429    {
430        /* Set the default values. */
431        rms_ext_active = RMS_DEQ_DEFAULT;
432        rms_mbc_active = RMS_MBC_DEFAULT;
433        rms_mbf_active = RMS_MBF_DEFAULT;
434
435        /* Default extend quantity.  Use the user value, if set. */
436        if (rms_ext > 0)
437        {
438            rms_ext_active = rms_ext;
439        }
440
441        /* Default multi-block count.  Use the user value, if set. */
442        if (rms_mbc > 0)
443        {
444            rms_mbc_active = rms_mbc;
445        }
446
447        /* Default multi-buffer count.  Use the user value, if set. */
448        if (rms_mbf > 0)
449        {
450            rms_mbf_active = rms_mbf;
451        }
452    }
453
454    if (DIAG_FLAG)
455    {
456        fprintf(stderr, "Get RMS defaults.  getjpi sts = %%x%08x.\n", sts);
457
458        if (rms_defaults_known > 0)
459        {
460            fprintf(stderr,
461              "               Default: deq = %6d, mbc = %3d, mbf = %3d.\n",
462              rms_ext, rms_mbc, rms_mbf);
463        }
464    }
465    return sts;
466}
467
468
469int check_format(__G)
470    __GDEF
471{
472    int rtype;
473    int sts;
474    struct FAB fab;
475#ifdef NAML$C_MAXRSS
476    struct NAML nam;
477#endif
478
479    fab = cc$rms_fab;                   /* Initialize FAB. */
480
481#ifdef NAML$C_MAXRSS
482
483    nam = cc$rms_naml;                  /* Initialize NAML. */
484    fab.fab$l_naml = &nam;              /* Point FAB to NAML. */
485
486    fab.fab$l_dna = (char *) -1;    /* Using NAML for default name. */
487    fab.fab$l_fna = (char *) -1;    /* Using NAML for file name. */
488
489#endif /* NAML$C_MAXRSS */
490
491    FAB_OR_NAML(fab, nam).FAB_OR_NAML_FNA = G.zipfn;
492    FAB_OR_NAML(fab, nam).FAB_OR_NAML_FNS = strlen(G.zipfn);
493
494    if (ERR(sts = sys$open(&fab)))
495    {
496        Info(slide, 1, ((char *)slide, "\n\
497     error:  cannot open zipfile [ %s ].\n",
498          FnFilter1(G.zipfn)));
499        vms_msg(__G__ "     sys$open() error: ", sts);
500        return PK_ERR;
501    }
502    rtype = fab.fab$b_rfm;
503    sys$close(&fab);
504
505    if (rtype == FAB$C_VAR || rtype == FAB$C_VFC)
506    {
507        Info(slide, 1, ((char *)slide, "\n\
508     Error:  zipfile is in variable-length record format.  Please\n\
509     run \"bilf l %s\" to convert the zipfile to stream-LF\n\
510     record format.  (BILF is available at various VMS archives.)\n\n",
511          FnFilter1(G.zipfn)));
512        return PK_ERR;
513    }
514
515    return PK_COOL;
516}
517
518
519
520#define PRINTABLE_FORMAT(x)      ( (x) == FAB$C_VAR     \
521                                || (x) == FAB$C_STMLF   \
522                                || (x) == FAB$C_STMCR   \
523                                || (x) == FAB$C_STM     )
524
525/* VMS extra field types */
526#define VAT_NONE    0
527#define VAT_IZ      1   /* old Info-ZIP format */
528#define VAT_PK      2   /* PKWARE format */
529
530/*
531 *  open_outfile() assignments:
532 *
533 *  VMS attributes ?        create_xxx      _flush_xxx
534 *  ----------------        ----------      ----------
535 *  not found               'default'       text mode ?
536 *                                          yes -> 'stream'
537 *                                          no  -> 'block'
538 *
539 *  yes, in IZ format       'rms'           uO.cflag ?
540 *                                          yes -> switch (fab.rfm)
541 *                                              VAR  -> 'varlen'
542 *                                              STM* -> 'stream'
543 *                                              default -> 'block'
544 *                                          no -> 'block'
545 *
546 *  yes, in PK format       'qio'           uO.cflag ?
547 *                                          yes -> switch (pka_rattr)
548 *                                              VAR  -> 'varlen'
549 *                                              STM* -> 'stream'
550 *                                              default -> 'block'
551 *                                          no -> 'qio'
552 *
553 *  "text mode" == G.pInfo->textmode || (uO.cflag && !uO.bflag)
554 *  (simplified, for complete expression see create_default_output() code)
555 */
556
557/* The VMS version of open_outfile() supports special return codes:
558 *      OPENOUT_OK            a file has been opened normally
559 *      OPENOUT_FAILED        the file open process failed
560 *      OPENOUT_SKIPOK        file open skipped at user request, err level OK
561 *      OPENOUT_SKIPWARN      file open skipped at user request, err level WARN
562 */
563int open_outfile(__G)
564    __GDEF
565{
566    /* Get process RMS_DEFAULT values, if not already done. */
567    if (rms_defaults_known == 0)
568    {
569        get_rms_defaults();
570    }
571
572    switch (find_vms_attrs(__G__ (uO.D_flag <= 1)))
573    {
574        case VAT_NONE:
575        default:
576            return  create_default_output(__G);
577        case VAT_IZ:
578            return  create_rms_output(__G);
579        case VAT_PK:
580            return  create_qio_output(__G);
581    }
582}
583
584static void init_buf_ring()
585{
586    locptr = &locbuf[0];
587    loccnt = 0;
588
589    b1.buf = &locbuf[0];
590    b1.bufcnt = 0;
591    b1.next = &b2;
592    b2.buf = &locbuf[BUFS512];
593    b2.bufcnt = 0;
594    b2.next = &b1;
595    curbuf = &b1;
596}
597
598
599/* Static data storage for time conversion: */
600
601/*   string constants for month names */
602static ZCONST char *month[] =
603            {"JAN", "FEB", "MAR", "APR", "MAY", "JUN",
604             "JUL", "AUG", "SEP", "OCT", "NOV", "DEC"};
605
606/*   buffer for time string */
607static char timbuf[24];         /* length = first entry in "date_str" + 1 */
608
609/*   fixed-length string descriptor for timbuf: */
610static ZCONST struct dsc$descriptor date_str =
611            {sizeof(timbuf)-1, DSC$K_DTYPE_T, DSC$K_CLASS_S, timbuf};
612
613
614static void set_default_datetime_XABs(__GPRO)
615{
616    unsigned yr, mo, dy, hh, mm, ss;
617#ifdef USE_EF_UT_TIME
618    iztimes z_utime;
619    struct tm *t;
620
621    if (G.extra_field &&
622#ifdef IZ_CHECK_TZ
623        G.tz_is_valid &&
624#endif
625        (ef_scan_for_izux(G.extra_field, G.lrec.extra_field_length, 0,
626                          G.lrec.last_mod_dos_datetime, &z_utime, NULL)
627         & EB_UT_FL_MTIME))
628        t = localtime(&(z_utime.mtime));
629    else
630        t = (struct tm *)NULL;
631    if (t != (struct tm *)NULL)
632    {
633        yr = t->tm_year + 1900;
634        mo = t->tm_mon;
635        dy = t->tm_mday;
636        hh = t->tm_hour;
637        mm = t->tm_min;
638        ss = t->tm_sec;
639    }
640    else
641    {
642        yr = ((G.lrec.last_mod_dos_datetime >> 25) & 0x7f) + 1980;
643        mo = ((G.lrec.last_mod_dos_datetime >> 21) & 0x0f) - 1;
644        dy = (G.lrec.last_mod_dos_datetime >> 16) & 0x1f;
645        hh = (G.lrec.last_mod_dos_datetime >> 11) & 0x1f;
646        mm = (G.lrec.last_mod_dos_datetime >> 5) & 0x3f;
647        ss = (G.lrec.last_mod_dos_datetime << 1) & 0x3e;
648    }
649#else /* !USE_EF_UT_TIME */
650
651    yr = ((G.lrec.last_mod_dos_datetime >> 25) & 0x7f) + 1980;
652    mo = ((G.lrec.last_mod_dos_datetime >> 21) & 0x0f) - 1;
653    dy = (G.lrec.last_mod_dos_datetime >> 16) & 0x1f;
654    hh = (G.lrec.last_mod_dos_datetime >> 11) & 0x1f;
655    mm = (G.lrec.last_mod_dos_datetime >> 5) & 0x3f;
656    ss = (G.lrec.last_mod_dos_datetime << 1) & 0x1f;
657#endif /* ?USE_EF_UT_TIME */
658
659    dattim = cc$rms_xabdat;     /* fill XABs with default values */
660    rdt = cc$rms_xabrdt;
661    sprintf(timbuf, "%02u-%3s-%04u %02u:%02u:%02u.00",
662            dy, month[mo], yr, hh, mm, ss);
663    sys$bintim(&date_str, &dattim.xab$q_cdt);
664    memcpy(&rdt.xab$q_rdt, &dattim.xab$q_cdt, sizeof(rdt.xab$q_rdt));
665}
666
667
668/* The following return codes are supported:
669 *      OPENOUT_OK            a file has been opened normally
670 *      OPENOUT_FAILED        the file open process failed
671 *      OPENOUT_SKIPOK        file open skipped at user request, err level OK
672 *      OPENOUT_SKIPWARN      file open skipped at user request, err level WARN
673 */
674static int create_default_output(__GPRO)
675{
676    int ierr;
677    int text_output, bin_fixed;
678
679    /* Extract the file in text format (Variable_length by default,
680     * Stream_LF with "-S" (/TEXT = STMLF), when
681     *  a) explicitly requested by the user (through the -a option),
682     *     and it is not a symbolic link,
683     * or
684     *  b) piping to SYS$OUTPUT, unless "binary" piping was requested
685     *     by the user (through the -b option).
686     */
687    text_output = (G.pInfo->textmode
688#ifdef SYMLINKS
689                   && !G.symlnk
690#endif
691                  ) ||
692                  (uO.cflag &&
693                   (!uO.bflag || (!(uO.bflag - 1) && G.pInfo->textfile)));
694    /* Use fixed length 512 byte record format for disk file when
695     *  a) explicitly requested by the user (-b option),
696     * and
697     *  b) it is not a symbolic link,
698     * and
699     *  c) it is not extracted in text mode.
700     */
701    bin_fixed = !text_output &&
702#ifdef SYMLINKS
703                !G.symlnk &&
704#endif
705                (uO.bflag != 0) && ((uO.bflag != 1) || !G.pInfo->textfile);
706
707    rfm = FAB$C_STMLF;  /* Default, stream-LF format from VMS or UNIX */
708
709    if (!uO.cflag)              /* Redirect output */
710    {
711        rab = cc$rms_rab;               /* Initialize RAB. */
712        fileblk = cc$rms_fab;           /* Initialize FAB. */
713
714        fileblk.fab$l_xab = NULL;       /* No XABs. */
715        rab.rab$l_fab = &fileblk;       /* Point RAB to FAB. */
716
717        outfab = &fileblk;              /* Set pointers used elsewhere. */
718        outrab = &rab;
719
720        if (text_output && (!uO.S_flag))
721        {   /* Default format for output `real' text file */
722            fileblk.fab$b_rfm = FAB$C_VAR;      /* variable length records */
723            fileblk.fab$b_rat = FAB$M_CR;       /* implied (CR) carriage ctrl */
724        }
725        else if (bin_fixed)
726        {   /* Default format for output `real' binary file */
727            fileblk.fab$b_rfm = FAB$C_FIX;      /* fixed length records */
728            fileblk.fab$w_mrs = 512;            /* record size 512 bytes */
729            fileblk.fab$b_rat = 0;              /* no carriage ctrl */
730        }
731        else
732        {   /* Default format for output misc (bin or text) file */
733            fileblk.fab$b_rfm = FAB$C_STMLF;    /* stream-LF record format */
734            fileblk.fab$b_rat = FAB$M_CR;       /* implied (CR) carriage ctrl */
735        }
736
737#ifdef NAML$C_MAXRSS
738
739        nam = CC_RMS_NAM;               /* Initialize NAML. */
740        fileblk.FAB_NAM = &nam;         /* Point FAB to NAML. */
741
742        fileblk.fab$l_dna = (char *) -1;    /* Using NAML for default name. */
743        fileblk.fab$l_fna = (char *) -1;    /* Using NAML for file name. */
744
745#endif /* NAML$C_MAXRSS */
746
747        FAB_OR_NAML(fileblk, nam).FAB_OR_NAML_FNA = G.filename;
748        FAB_OR_NAML(fileblk, nam).FAB_OR_NAML_FNS = strlen(G.filename);
749
750        /* Prepare date-time XABs, unless user requests not to. */
751        if (uO.D_flag <= 1) {
752            set_default_datetime_XABs(__G);
753            dattim.xab$l_nxt = fileblk.fab$l_xab;
754            fileblk.fab$l_xab = (void *) &dattim;
755        }
756
757/* 2005-02-14 SMS.  What does this mean?  ----vvvvvvvvvvvvvvvvvvvvvvvvvvv */
758        fileblk.fab$w_ifi = 0;  /* Clear IFI. It may be nonzero after ZIP */
759        fileblk.fab$b_fac = FAB$M_BRO | FAB$M_PUT;  /* {block|record} output */
760#ifdef SYMLINKS
761        if (G.symlnk)
762            /* Symlink file is read back to retrieve the link text. */
763            fileblk.fab$b_fac |= FAB$M_GET;
764#endif
765
766        /* 2004-11-23 SMS.
767         * If RMS_DEFAULT values have been determined, and have not been
768         * set by the user, then set some FAB/RAB parameters for faster
769         * output.  User-specified RMS_DEFAULT values override the
770         * built-in default values, so if the RMS_DEFAULT values could
771         * not be determined, then these (possibly unwise) values could
772         * not be overridden, and hence will not be set.  Honestly,
773         * this seems to be excessively cautious, but only old VMS
774         * versions will be affected.
775         */
776
777        /* If RMS_DEFAULT (and adjusted active) values are available,
778         * then set the FAB/RAB parameters.  If RMS_DEFAULT values are
779         * not available, then suffer with the default behavior.
780         */
781        if (rms_defaults_known > 0)
782        {
783            /* Set the FAB/RAB parameters accordingly. */
784            fileblk.fab$w_deq = rms_ext_active;
785            rab.rab$b_mbc = rms_mbc_active;
786            rab.rab$b_mbf = rms_mbf_active;
787
788#ifdef OLD_FABDEF
789
790            /* Truncate at EOF on close, as we may over-extend. */
791            fileblk.fab$l_fop |= FAB$M_TEF ;
792
793            /* If using multiple buffers, enable write-behind. */
794            if (rms_mbf_active > 1)
795            {
796                rab.rab$l_rop |= RAB$M_WBH;
797            }
798        }
799
800        /* Set the initial file allocation according to the file
801         * size.  Also set the "sequential access only" flag, as
802         * otherwise, on a file system with highwater marking
803         * enabled, allocating space for a large file may lock the
804         * disk for a long time (minutes).
805         */
806        fileblk.fab$l_alq = (unsigned) (G.lrec.ucsize+ 511)/ 512;
807        fileblk.fab$l_fop |= FAB$M_SQO;
808
809#else /* !OLD_FABDEF */
810
811            /* Truncate at EOF on close, as we may over-extend. */
812            fileblk.fab$v_tef = 1;
813
814            /* If using multiple buffers, enable write-behind. */
815            if (rms_mbf_active > 1)
816            {
817                rab.rab$v_wbh = 1;
818            }
819        }
820
821        /* Set the initial file allocation according to the file
822         * size.  Also set the "sequential access only" flag, as
823         * otherwise, on a file system with highwater marking
824         * enabled, allocating space for a large file may lock the
825         * disk for a long time (minutes).
826         */
827        fileblk.fab$l_alq = (unsigned) (G.lrec.ucsize+ 511)/ 512;
828        fileblk.fab$v_sqo = 1;
829
830#endif /* ?OLD_FABDEF */
831
832        ierr = sys$create(outfab);
833        if (ierr == RMS$_FEX)
834        {
835            /* File exists.
836             * Consider command-line options, or ask the user what to do.
837             */
838            ierr = replace(__G);
839            switch (ierr & REPL_TASKMASK)
840            {
841                case REPL_NO_EXTRACT:   /* No extract. */
842                    free_up();
843                    return ((ierr & REPL_ERRLV_WARN)
844                            ? OPENOUT_SKIPWARN : OPENOUT_SKIPOK);
845                case REPL_NEW_VERSION:  /* Create a new version. */
846                    ierr = replace_rms_newversion(__G);
847                    break;
848                case REPL_OVERWRITE:    /* Overwrite the existing file. */
849                    ierr = replace_rms_overwrite(__G);
850                    break;
851            }
852        }
853
854        if (ERR(ierr))
855        {
856            char buf[NAM_MAXRSS + 128]; /* Name length + message length. */
857
858            sprintf(buf, "[ Cannot create ($create) output file %s ]\n",
859              G.filename);
860            vms_msg(__G__ buf, ierr);
861            if (fileblk.fab$l_stv != 0)
862            {
863                vms_msg(__G__ "", fileblk.fab$l_stv);
864            }
865            free_up();
866            return OPENOUT_FAILED;
867        }
868
869        if (!text_output)
870        {
871            rab.rab$l_rop |= (RAB$M_BIO | RAB$M_ASY);
872        }
873        rab.rab$b_rac = RAB$C_SEQ;
874
875        if ((ierr = sys$connect(&rab)) != RMS$_NORMAL)
876        {
877#ifdef DEBUG
878            vms_msg(__G__ "create_default_output: sys$connect failed.\n", ierr);
879            if (fileblk.fab$l_stv != 0)
880            {
881                vms_msg(__G__ "", fileblk.fab$l_stv);
882            }
883#endif
884            Info(slide, 1, ((char *)slide,
885                 "Cannot create ($connect) output file:  %s\n",
886                 FnFilter1(G.filename)));
887            free_up();
888            return OPENOUT_FAILED;
889        }
890    }                   /* end if (!uO.cflag) */
891
892    init_buf_ring();
893
894    _flush_routine = text_output ? got_eol=0,_flush_stream : _flush_blocks;
895    _close_routine = _close_rms;
896    return OPENOUT_OK;
897}
898
899
900
901/* The following return codes are supported:
902 *      OPENOUT_OK            a file has been opened normally
903 *      OPENOUT_FAILED        the file open process failed
904 *      OPENOUT_SKIPOK        file open skipped at user request, err level OK
905 *      OPENOUT_SKIPWARN      file open skipped at user request, err level WARN
906 */
907static int create_rms_output(__GPRO)
908{
909    int ierr;
910    int text_output;
911
912    /* extract the file in text (variable-length) format, when
913     * piping to SYS$OUTPUT, unless "binary" piping was requested
914     * by the user (through the -b option); the "-a" option is
915     * ignored when extracting zip entries with VMS attributes saved
916     */
917    text_output = uO.cflag &&
918                  (!uO.bflag || (!(uO.bflag - 1) && G.pInfo->textfile));
919
920    rfm = outfab->fab$b_rfm;    /* Use record format from VMS extra field */
921
922    if (uO.cflag)               /* SYS$OUTPUT */
923    {
924        if (text_output && !PRINTABLE_FORMAT(rfm))
925        {
926            Info(slide, 1, ((char *)slide,
927               "[ File %s has illegal record format to put to screen ]\n",
928               FnFilter1(G.filename)));
929            free_up();
930            return OPENOUT_FAILED;
931        }
932    }
933    else                        /* File output */
934    {
935        rab = cc$rms_rab;               /* Initialize RAB. */
936
937        /* The output FAB has already been initialized with the values
938         * found in the Zip file's "VMS attributes" extra field.
939         */
940
941#ifdef NAML$C_MAXRSS
942
943        nam = CC_RMS_NAM;               /* Initialize NAML. */
944        outfab->FAB_NAM = &nam;         /* Point FAB to NAML. */
945
946        outfab->fab$l_dna = (char *) -1;    /* Using NAML for default name. */
947        outfab->fab$l_fna = (char *) -1;    /* Using NAML for file name. */
948
949#endif /* NAML$C_MAXRSS */
950
951        FAB_OR_NAML(*outfab, nam).FAB_OR_NAML_FNA = G.filename;
952        FAB_OR_NAML(*outfab, nam).FAB_OR_NAML_FNS = strlen(G.filename);
953
954        /* Prepare date-time XABs, unless user requests not to. */
955        if (uO.D_flag <= 1) {
956            /* If no XAB date/time, use attributes from non-VMS fields. */
957            if (!(xabdat && xabrdt))
958            {
959                set_default_datetime_XABs(__G);
960
961                if (xabdat == NULL)
962                {
963                    dattim.xab$l_nxt = outfab->fab$l_xab;
964                    outfab->fab$l_xab = (void *) &dattim;
965                }
966            }
967        }
968/* 2005-02-14 SMS.  What does this mean?  ----vvvvvvvvvvvvvvvvvvvvvvvvvvv */
969        outfab->fab$w_ifi = 0;  /* Clear IFI. It may be nonzero after ZIP */
970        outfab->fab$b_fac = FAB$M_BIO | FAB$M_PUT;      /* block-mode output */
971#ifdef SYMLINKS
972        /* 2007-02-28 SMS.
973         * VMS/RMS symlink properties will be restored naturally when
974         * the link file is recreated this way, so there's no need to do
975         * the deferred symlink post-processing step for this file.
976         * Therefore, clear the pInfo->symlink flag here, and the symlink
977         * "close file" processor will only display the link text.
978         */
979        if (G.symlnk) {
980            G.pInfo->symlink = 0;
981            if (QCOND2) {
982                /* Symlink file is read back to display the link text. */
983                outfab->fab$b_fac |= FAB$M_GET;
984            }
985        }
986#endif /* SYMLINKS */
987
988        /* 2004-11-23 SMS.
989         * Set the "sequential access only" flag, as otherwise, on a
990         * file system with highwater marking enabled, allocating space
991         * for a large file may lock the disk for a long time (minutes).
992         */
993#ifdef OLD_FABDEF
994        outfab-> fab$l_fop |= FAB$M_SQO;
995#else /* !OLD_FABDEF */
996        outfab-> fab$v_sqo = 1;
997#endif /* ?OLD_FABDEF */
998
999        ierr = sys$create(outfab);
1000        if (ierr == RMS$_FEX)
1001        {
1002            /* File exists.
1003             * Consider command-line options, or ask the user what to do.
1004             */
1005            ierr = replace(__G);
1006            switch (ierr & REPL_TASKMASK)
1007            {
1008                case REPL_NO_EXTRACT:   /* No extract. */
1009                    free_up();
1010                    return ((ierr & REPL_ERRLV_WARN)
1011                            ? OPENOUT_SKIPWARN : OPENOUT_SKIPOK);
1012                case REPL_NEW_VERSION:  /* Create a new version. */
1013                    ierr = replace_rms_newversion(__G);
1014                    break;
1015                case REPL_OVERWRITE:    /* Overwrite the existing file. */
1016                    ierr = replace_rms_overwrite(__G);
1017                    break;
1018            }
1019        }
1020
1021        if (ERR(ierr))
1022        {
1023            char buf[NAM_MAXRSS + 128]; /* Name length + message length. */
1024
1025            sprintf(buf, "[ Cannot create ($create) output file %s ]\n",
1026              G.filename);
1027            vms_msg(__G__ buf, ierr);
1028            if (outfab->fab$l_stv != 0)
1029            {
1030                vms_msg(__G__ "", outfab->fab$l_stv);
1031            }
1032            free_up();
1033            return OPENOUT_FAILED;
1034        }
1035
1036        if (outfab->fab$b_org & (FAB$C_REL | FAB$C_IDX)) {
1037            /* relative and indexed files require explicit allocation */
1038            ierr = sys$extend(outfab);
1039            if (ERR(ierr))
1040            {
1041                char buf[NAM_MAXRSS + 128];    /* Name length + msg length. */
1042
1043                sprintf(buf, "[ Cannot allocate space for %s ]\n", G.filename);
1044                vms_msg(__G__ buf, ierr);
1045                if (outfab->fab$l_stv != 0)
1046                {
1047                    vms_msg(__G__ "", outfab->fab$l_stv);
1048                }
1049                free_up();
1050                return OPENOUT_FAILED;
1051            }
1052        }
1053
1054        outrab = &rab;
1055        rab.rab$l_fab = outfab;
1056        {
1057            rab.rab$l_rop |= (RAB$M_BIO | RAB$M_ASY);
1058        }
1059        rab.rab$b_rac = RAB$C_SEQ;
1060
1061        if ((ierr = sys$connect(outrab)) != RMS$_NORMAL)
1062        {
1063#ifdef DEBUG
1064            vms_msg(__G__ "create_rms_output: sys$connect failed.\n", ierr);
1065            if (outfab->fab$l_stv != 0)
1066            {
1067                vms_msg(__G__ "", outfab->fab$l_stv);
1068            }
1069#endif
1070            Info(slide, 1, ((char *)slide,
1071                 "Cannot create ($connect) output file:  %s\n",
1072                 FnFilter1(G.filename)));
1073            free_up();
1074            return OPENOUT_FAILED;
1075        }
1076    }                   /* end if (!uO.cflag) */
1077
1078    init_buf_ring();
1079
1080    if ( text_output )
1081        switch (rfm)
1082        {
1083            case FAB$C_VAR:
1084                _flush_routine = _flush_varlen;
1085                break;
1086            case FAB$C_STM:
1087            case FAB$C_STMCR:
1088            case FAB$C_STMLF:
1089                _flush_routine = _flush_stream;
1090                got_eol = 0;
1091                break;
1092            default:
1093                _flush_routine = _flush_blocks;
1094                break;
1095        }
1096    else
1097        _flush_routine = _flush_blocks;
1098    _close_routine = _close_rms;
1099    return OPENOUT_OK;
1100}
1101
1102
1103
1104static  int pka_devchn;
1105static  int pka_io_pending;
1106static  unsigned pka_vbn;
1107
1108/* IOSB for QIO[W] read and write operations. */
1109#if defined(__DECC) || defined(__DECCXX)
1110#pragma __member_alignment __save
1111#pragma __nomember_alignment
1112#endif /* __DECC || __DECCXX */
1113static struct
1114{
1115    unsigned short  status;
1116    unsigned int    count;      /* Unaligned ! */
1117    unsigned short  dummy;
1118} pka_io_iosb;
1119#if defined(__DECC) || defined(__DECCXX)
1120#pragma __member_alignment __restore
1121#endif /* __DECC || __DECCXX */
1122
1123/* IOSB for QIO[W] miscellaneous ACP operations. */
1124static struct
1125{
1126    unsigned short  status;
1127    unsigned short  dummy;
1128    unsigned int    count;
1129} pka_acp_iosb;
1130
1131static struct fibdef    pka_fib;
1132static struct atrdef    pka_atr[VMS_MAX_ATRCNT];
1133static int              pka_idx;
1134static ulg              pka_uchar;
1135static struct fatdef    pka_rattr;
1136
1137/* Directory attribute storage, descriptor (list). */
1138static struct atrdef pka_recattr[2] =
1139 { { sizeof(pka_rattr), ATR$C_RECATTR, GVTC &pka_rattr},        /* RECATTR. */
1140   { 0, 0, 0 }                                          /* List terminator. */
1141 };
1142
1143static struct dsc$descriptor    pka_fibdsc =
1144{   sizeof(pka_fib), DSC$K_DTYPE_Z, DSC$K_CLASS_S, (void *) &pka_fib  };
1145
1146static struct dsc$descriptor_s  pka_devdsc =
1147{   0, DSC$K_DTYPE_T, DSC$K_CLASS_S, &nam.NAM_DVI[1]  };
1148
1149static struct dsc$descriptor_s  pka_fnam =
1150{   0, DSC$K_DTYPE_T, DSC$K_CLASS_S, NULL  };
1151
1152/* Expanded and resultant name storage. */
1153static char exp_nam[NAM_MAXRSS];
1154static char res_nam[NAM_MAXRSS];
1155
1156/* Special ODS5-QIO-compatible name storage. */
1157#ifdef NAML$C_MAXRSS
1158static char sys_nam[NAML$C_MAXRSS];     /* Probably need less here. */
1159#endif /* NAML$C_MAXRSS */
1160
1161#define PK_PRINTABLE_RECTYP(x)   ( (x) == FAT$C_VARIABLE \
1162                                || (x) == FAT$C_STREAMLF \
1163                                || (x) == FAT$C_STREAMCR \
1164                                || (x) == FAT$C_STREAM   )
1165
1166
1167/* The following return codes are supported:
1168 *      OPENOUT_OK            a file has been opened normally
1169 *      OPENOUT_FAILED        the file open process failed
1170 *      OPENOUT_SKIPOK        file open skipped at user request, err level OK
1171 *      OPENOUT_SKIPWARN      file open skipped at user request, err level WARN
1172 */
1173static int create_qio_output(__GPRO)
1174{
1175    int status;
1176    int i;
1177    int text_output;
1178
1179    /* extract the file in text (variable-length) format, when
1180     * piping to SYS$OUTPUT, unless "binary" piping was requested
1181     * by the user (through the -b option); the "-a" option is
1182     * ignored when extracting zip entries with VMS attributes saved
1183     */
1184    text_output = uO.cflag &&
1185                  (!uO.bflag || (!(uO.bflag - 1) && G.pInfo->textfile));
1186
1187    if ( uO.cflag )
1188    {
1189        int rtype;
1190
1191        if (text_output)
1192        {
1193            rtype = pka_rattr.fat$v_rtype;
1194            if (!PK_PRINTABLE_RECTYP(rtype))
1195            {
1196                Info(slide, 1, ((char *)slide,
1197                   "[ File %s has illegal record format to put to screen ]\n",
1198                   FnFilter1(G.filename)));
1199                return OPENOUT_FAILED;
1200            }
1201        }
1202        else
1203            /* force "block I/O" for binary piping mode */
1204            rtype = FAT$C_UNDEFINED;
1205
1206        init_buf_ring();
1207
1208        switch (rtype)
1209        {
1210            case FAT$C_VARIABLE:
1211                _flush_routine = _flush_varlen;
1212                break;
1213            case FAT$C_STREAM:
1214            case FAT$C_STREAMCR:
1215            case FAT$C_STREAMLF:
1216                _flush_routine = _flush_stream;
1217                got_eol = 0;
1218                break;
1219            default:
1220                _flush_routine = _flush_blocks;
1221                break;
1222        }
1223        _close_routine = _close_rms;
1224    }
1225    else                        /* !(uO.cflag) : redirect output */
1226    {
1227        fileblk = cc$rms_fab;           /* Initialize FAB. */
1228        nam = CC_RMS_NAM;               /* Initialize NAM[L]. */
1229        fileblk.FAB_NAM = &nam;         /* Point FAB to NAM[L]. */
1230
1231#ifdef NAML$C_MAXRSS
1232
1233        fileblk.fab$l_dna = (char *) -1;    /* Using NAML for default name. */
1234        fileblk.fab$l_fna = (char *) -1;    /* Using NAML for file name. */
1235
1236        /* Special ODS5-QIO-compatible name storage. */
1237        nam.naml$l_filesys_name = sys_nam;
1238        nam.naml$l_filesys_name_alloc = sizeof(sys_nam);
1239
1240#endif /* NAML$C_MAXRSS */
1241
1242        /* VMS-format file name, derived from archive. */
1243        FAB_OR_NAML(fileblk, nam).FAB_OR_NAML_FNA = G.filename;
1244        FAB_OR_NAML(fileblk, nam).FAB_OR_NAML_FNS = strlen(G.filename);
1245
1246        /* Expanded and resultant name storage. */
1247        nam.NAM_ESA = exp_nam;
1248        nam.NAM_ESS = sizeof(exp_nam);
1249        nam.NAM_RSA = res_nam;
1250        nam.NAM_RSS = sizeof(res_nam);
1251
1252        if ( ERR(status = sys$parse(&fileblk)) )
1253        {
1254            vms_msg(__G__ "create_qio_output: sys$parse failed.\n", status);
1255            return OPENOUT_FAILED;
1256        }
1257
1258        pka_devdsc.dsc$w_length = (unsigned short)nam.NAM_DVI[0];
1259
1260        if ( ERR(status = sys$assign(&pka_devdsc, &pka_devchn, 0, 0)) )
1261        {
1262            vms_msg(__G__ "create_qio_output: sys$assign failed.\n", status);
1263            return OPENOUT_FAILED;
1264        }
1265
1266#ifdef NAML$C_MAXRSS
1267
1268        /* Enable fancy name characters.  Note that "fancy" here does
1269           not include Unicode, for which there's no support elsewhere.
1270        */
1271        pka_fib.fib$v_names_8bit = 1;
1272        pka_fib.fib$b_name_format_in = FIB$C_ISL1;
1273
1274        /* ODS5 Extended names used as input to QIO have peculiar
1275           encoding (perhaps to minimize storage?), so the special
1276           filesys_name result (typically containing fewer carets) must
1277           be used here.
1278        */
1279        pka_fnam.dsc$a_pointer = nam.naml$l_filesys_name;
1280        pka_fnam.dsc$w_length = nam.naml$l_filesys_name_size;
1281
1282#else /* !NAML$C_MAXRSS */
1283
1284        /* Extract only the name.type;version.
1285           2005-02-14 SMS.
1286           Note: In old code, the version in the name here was retained
1287           only if -V (uO.V_flag, so that there might be an explicit
1288           version number in the archive (or perhaps not)), but the
1289           version should already have been stripped before this in
1290           adj_file_name_odsX(), and sys$parse() here should always
1291           return a good version number which may be used as-is.  If
1292           not, here's where to fix the (new) problem.  Note that the
1293           ODS5-compatible code uses the whole thing in filesys_name,
1294           too, and that's critical for proper interpretation of funny
1295           names.  (Omitting the ";" can cause trouble, so it should
1296           certainly be kept, even if the version digits are removed
1297           here.)
1298        */
1299
1300        pka_fnam.dsc$a_pointer = nam.NAM_L_NAME;
1301        pka_fnam.dsc$w_length =
1302          nam.NAM_B_NAME + nam.NAM_B_TYPE + nam.NAM_B_VER;
1303
1304#if 0
1305        pka_fnam.dsc$w_length = nam.NAM_B_NAME + nam.NAM_B_TYPE;
1306        if ( uO.V_flag /* keep versions */ )
1307            pka_fnam.dsc$w_length += nam.NAM_B_VER;
1308#endif /* 0 */
1309
1310#endif /* ?NAML$C_MAXRSS */
1311
1312        /* Move the directory ID from the NAM[L] to the FIB.
1313           Clear the FID in the FIB, as we're using the name.
1314        */
1315        for (i = 0; i < 3; i++)
1316        {
1317            pka_fib.FIB$W_DID[i] = nam.NAM_DID[i];
1318            pka_fib.FIB$W_FID[i] = 0;
1319        }
1320
1321        /* 2004-11-23 SMS.
1322         * Set the "sequential access only" flag, as otherwise, on a
1323         * file system with highwater marking enabled, allocating space
1324         * for a large file may lock the disk for a long time (minutes).
1325         * (The "no other readers" flag is also required, if you want
1326         * the "sequential access only" flag to have any effect.)
1327         */
1328        pka_fib.FIB$L_ACCTL = FIB$M_WRITE | FIB$M_SEQONLY | FIB$M_NOREAD;
1329
1330        /* Allocate space for the file */
1331        pka_fib.FIB$W_EXCTL = FIB$M_EXTEND;
1332        if ( pka_uchar & FCH$M_CONTIG )
1333            pka_fib.FIB$W_EXCTL |= FIB$M_ALCON | FIB$M_FILCON;
1334        if ( pka_uchar & FCH$M_CONTIGB )
1335            pka_fib.FIB$W_EXCTL |= FIB$M_ALCONB;
1336
1337#define SWAPW(x)        ( (((x)>>16)&0xFFFF) + ((x)<<16) )
1338
1339        pka_fib.fib$l_exsz = SWAPW(pka_rattr.fat$l_hiblk);
1340
1341        status = sys$qiow(0,                /* event flag */
1342                          pka_devchn,       /* channel */
1343                          IO$_CREATE|IO$M_CREATE|IO$M_ACCESS, /* funct */
1344                          &pka_acp_iosb,    /* IOSB */
1345                          0,                /* AST address */
1346                          0,                /* AST parameter */
1347                          &pka_fibdsc,      /* P1 = File Info Block */
1348                          &pka_fnam,        /* P2 = File name (descr) */
1349                          0,                /* P3 (= Resulting name len) */
1350                          0,                /* P4 (= Resulting name descr) */
1351                          pka_atr,          /* P5 = Attribute descr */
1352                          0);               /* P6 (not used) */
1353
1354        if ( !ERR(status) )
1355            status = pka_acp_iosb.status;
1356
1357        if ( status == SS$_DUPFILENAME )
1358        {
1359            /* File exists.  Prepare to ask user what to do. */
1360
1361            /* Arrange to store the resultant file spec (with new
1362             * version?) where the message code will find it.
1363             */
1364            short res_nam_len;
1365            struct dsc$descriptor_s  res_nam_dscr =
1366              { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, NULL };
1367
1368            res_nam_dscr.dsc$a_pointer = G.filename;
1369            res_nam_dscr.dsc$w_length = sizeof(G.filename);
1370
1371            /* File exists.
1372             * Consider command-line options, or ask the user what to do.
1373             */
1374            status = replace(__G);
1375            switch (status & REPL_TASKMASK)
1376            {
1377                case REPL_NO_EXTRACT:   /* No extract. */
1378                    free_up();
1379                    return ((status & REPL_ERRLV_WARN)
1380                            ? OPENOUT_SKIPWARN : OPENOUT_SKIPOK);
1381                case REPL_NEW_VERSION:  /* Create a new version. */
1382                    pka_fib.FIB$W_NMCTL |= FIB$M_NEWVER;
1383                    break;
1384                case REPL_OVERWRITE:    /* Overwrite the existing file. */
1385                    pka_fib.FIB$W_NMCTL |= FIB$M_SUPERSEDE;
1386                    break;
1387            }
1388
1389            /* Retry file creation with new (user-specified) policy. */
1390            status = sys$qiow(0,                /* event flag */
1391                              pka_devchn,       /* channel */
1392                              IO$_CREATE|IO$M_CREATE|IO$M_ACCESS, /* funct */
1393                              &pka_acp_iosb,    /* IOSB */
1394                              0,                /* AST address */
1395                              0,                /* AST parameter */
1396                              &pka_fibdsc,      /* P1 = File Info Block */
1397                              &pka_fnam,        /* P2 = File name (descr) */
1398                              &res_nam_len,     /* P3 = Resulting name len */
1399                              &res_nam_dscr,    /* P4 = Resulting name descr */
1400                              pka_atr,          /* P5 = Attribute descr */
1401                              0);               /* P6 (not used) */
1402
1403            if ( !ERR(status) )
1404                status = pka_acp_iosb.status;
1405
1406            if (res_nam_len > 0)
1407            {
1408                /* NUL-terminate the resulting file spec. */
1409                G.filename[res_nam_len] = '\0';
1410            }
1411
1412            /* Clear any user-specified version policy flags
1413             * (for the next file to be processed).
1414             */
1415            pka_fib.FIB$W_NMCTL &= (~(FIB$M_NEWVER| FIB$M_SUPERSEDE));
1416        }
1417
1418        if ( ERR(status) )
1419        {
1420            char buf[NAM_MAXRSS + 128]; /* Name length + message length. */
1421
1422            sprintf(buf, "[ Cannot create (QIO) output file %s ]\n",
1423              G.filename);
1424            vms_msg(__G__ buf, status);
1425            sys$dassgn(pka_devchn);
1426            return OPENOUT_FAILED;
1427        }
1428
1429#ifdef ASYNCH_QIO
1430        init_buf_ring();
1431        pka_io_pending = FALSE;
1432#else
1433        locptr = locbuf;
1434        loccnt = 0;
1435#endif
1436        pka_vbn = 1;
1437        _flush_routine = _flush_qio;
1438        _close_routine = _close_qio;
1439    }                   /* end if (!uO.cflag) */
1440    return OPENOUT_OK;
1441}
1442
1443
1444/* 2008-07-23 SMS.
1445 * Segregated user query function from file re-open functions/code.
1446 *
1447 * There was no code in create_qio_output() to deal with an
1448 * SS$_DUPFILENAME condition, leading to ugly run-time failures, and its
1449 * requirements differ from those of the RMS (non-QIO) functions,
1450 * create_default_output() and create_rms_output().
1451 *
1452 * Whether it makes sense to have a second layer of VMS-specific
1453 * querying after the generic UnZip query in extract.c:
1454 * extract_or_test_entrylist() is another question, but changing that
1455 * looks more scary than just getting the VMS-specific stuff to work
1456 * right (better?).
1457 */
1458
1459/* "File exists" handler(s).  Ask user about further action. */
1460
1461/* RMS create new version. */
1462static int replace_rms_newversion(__GPRO)
1463{
1464    int ierr;
1465    struct NAM_STRUCT nam;
1466
1467    nam = CC_RMS_NAM;           /* Initialize local NAM[L] block. */
1468    outfab->FAB_NAM = &nam;     /* Point FAB to local NAM[L]. */
1469
1470    /* Arrange to store the resultant file spec (with new version), so
1471     * that we can extract the actual file version from it, for later
1472     * use in the "extracting:/inflating:/..."  message (G.filename).
1473     */
1474    nam.NAM_RSA = res_nam;
1475    nam.NAM_RSS = sizeof(res_nam);
1476
1477#ifdef NAML$C_MAXRSS
1478
1479    outfab->fab$l_dna = (char *) -1;    /* Using NAML for default name. */
1480    outfab->fab$l_fna = (char *) -1;    /* Using NAML for file name. */
1481
1482#endif /* NAML$C_MAXRSS */
1483
1484    FAB_OR_NAML(*outfab, nam).FAB_OR_NAML_FNA = G.filename;
1485    FAB_OR_NAML(*outfab, nam).FAB_OR_NAML_FNS = strlen(G.filename);
1486
1487    /* Maximize version number. */
1488    outfab->fab$l_fop |= FAB$M_MXV;
1489
1490    /* Create the new-version file. */
1491    ierr = sys$create(outfab);
1492
1493    if (nam.NAM_RSL > 0)
1494    {
1495        /* File spec version pointers.
1496         * Versions must exist, so a simple right-to-left search for ";"
1497         * should work, even on ODS5 extended file specs.
1498         */
1499        char *semi_col_orig;
1500        char *semi_col_res;
1501
1502        /* NUL-terminate the (complete) resultant file spec. */
1503        res_nam[nam.NAM_RSL] = '\0';
1504
1505        /* Find the versions (";") in the original and resultant file specs. */
1506        semi_col_orig = strrchr(G.filename, ';');
1507        semi_col_res = strrchr(res_nam, ';');
1508
1509        if ((semi_col_orig != NULL) && (semi_col_res != NULL))
1510        {
1511            /* Transfer the resultant version to the original file spec. */
1512            strcpy((semi_col_orig + 1), (semi_col_res + 1));
1513        }
1514    }
1515    return ierr;
1516}
1517
1518
1519/* RMS overwrite original version. */
1520static int replace_rms_overwrite(__GPRO)
1521{
1522    /* Supersede existing file. */
1523    outfab->fab$l_fop |= FAB$M_SUP;
1524    /* Create (overwrite) the original-version file. */
1525    return sys$create(outfab);
1526}
1527
1528
1529/* Main query function to ask user how to handle an existing file
1530 * (unless command-line options already specify what to do).
1531 */
1532static int replace(__GPRO)
1533{
1534    char answ[10];
1535    int replace_code;
1536
1537    if (replace_code_all >= 0)
1538    {
1539        /* Use the previous all-file response. */
1540        replace_code = replace_code_all;
1541    }
1542    else if (uO.overwrite_none)
1543    {
1544        /* "-n".  Do not extract this (or any) file. */
1545        replace_code = replace_code_all = REPL_NO_EXTRACT;
1546    }
1547    else if (uO.overwrite_all == 1)
1548    {
1549        /* "-o".  Create a new version of this (or any) file. */
1550        replace_code = replace_code_all = REPL_NEW_VERSION;
1551    }
1552    else if (uO.overwrite_all > 1)
1553    {
1554        /* "-oo".  Overwrite (supersede) this (or any) existing file. */
1555        replace_code = replace_code_all = REPL_OVERWRITE;
1556    }
1557    else
1558    {
1559        replace_code = -1;
1560        do
1561        {
1562            /* Request, accept, and decode a response. */
1563            Info(slide, 0x81, ((char *)slide,
1564              "%s exists:  new [v]ersion, [o]verwrite, or [n]o extract?\n\
1565  (Uppercase response [V,O,N] => Do same for all files): ",
1566              FnFilter1(G.filename)));
1567            fflush(stderr);
1568
1569            if (fgets(answ, sizeof(answ), stdin) == (char *)NULL)
1570            {
1571                Info(slide, 1, ((char *)slide, AssumeNo));
1572                /* Handle the NULL answer as "N",
1573                 * do not extract any existing files.  */
1574                replace_code_all = REPL_NO_EXTRACT;
1575                /* Set a warning indicator. */
1576                replace_code = REPL_NO_EXTRACT | REPL_ERRLV_WARN;
1577                /* We are finished, break out of the query loop. */
1578                break;
1579            }
1580
1581            /* Strip off a trailing newline, to avoid corrupt
1582             * complaints when displaying the answer.
1583             */
1584            if (answ[strlen(answ) - 1] == '\n')
1585                answ[strlen(answ) - 1] = '\0';
1586
1587            /* Extra newline to avoid having the extracting:/inflating:/...:
1588             * message overwritten by the next query.
1589             */
1590            Info(slide, 1, ((char *)slide, "\n"));
1591
1592            /* Interpret response.  Store upper-case answer for future use. */
1593            switch (answ[0])
1594            {
1595                case 'N':
1596                    replace_code_all = REPL_NO_EXTRACT;
1597                case 'n':
1598                    /* Do not extract this file. */
1599                    replace_code = REPL_NO_EXTRACT;
1600                    break;
1601                case 'O':
1602                    replace_code_all = REPL_OVERWRITE;
1603                case 'o':
1604                    /* Overwrite (supersede) this existing file. */
1605                    replace_code = REPL_OVERWRITE;
1606                    break;
1607                case 'V':
1608                    replace_code_all = REPL_NEW_VERSION;
1609                case 'v':
1610                    /* Create a new version of this file. */
1611                    replace_code = REPL_NEW_VERSION;
1612                    break;
1613                default:
1614                    /* Invalid response.  Try again. */
1615                    Info(slide, 1, ((char *)slide, InvalidResponse, answ));
1616            }
1617        } while (replace_code < 0);
1618    }
1619    return replace_code;
1620}
1621
1622
1623
1624#define W(p)    (*(unsigned short*)(p))
1625#define L(p)    (*(unsigned long*)(p))
1626#define EQL_L(a, b)     ( L(a) == L(b) )
1627#define EQL_W(a, b)     ( W(a) == W(b) )
1628
1629/*
1630 * Function find_vms_attrs() scans the ZIP entry extra field, if any,
1631 * and looks for VMS attribute records.  Various date-time attributes
1632 * are ignored if set_date_time is FALSE (typically for a directory).
1633 *
1634 * For a set of IZ records, a FAB and various XABs are created and
1635 * chained together.
1636 *
1637 * For a PK record, the pka_atr[] attribute descriptor array is
1638 * populated.
1639 *
1640 * The return value is a VAT_* value, according to the type of extra
1641 * field attribute data found.
1642 */
1643static int find_vms_attrs(__GPRO__ int set_date_time)
1644{
1645    uch *scan = G.extra_field;
1646    struct  EB_header *hdr;
1647    int len;
1648    int type=VAT_NONE;
1649
1650    outfab = NULL;
1651    xabfhc = NULL;
1652    xabdat = NULL;
1653    xabrdt = NULL;
1654    xabpro = NULL;
1655    first_xab = last_xab = NULL;
1656
1657    if (scan == NULL)
1658        return VAT_NONE;
1659    len = G.lrec.extra_field_length;
1660
1661#define LINK(p) {/* Link xaballs and xabkeys into chain */      \
1662                if ( first_xab == NULL )                \
1663                        first_xab = (void *) p;         \
1664                if ( last_xab != NULL )                 \
1665                        last_xab->xab$l_nxt = (void *) p;       \
1666                last_xab = (void *) p;                  \
1667                p->xab$l_nxt = NULL;                    \
1668        }
1669    /* End of macro LINK */
1670
1671    while (len > 0)
1672    {
1673        hdr = (struct EB_header *)scan;
1674        if (EQL_W(&hdr->tag, IZ_SIGNATURE))
1675        {
1676            /*
1677             *  Info-ZIP-style extra block decoding.
1678             */
1679            uch *blk;
1680            unsigned siz;
1681            uch *block_id;
1682
1683            type = VAT_IZ;
1684
1685            siz = hdr->size;
1686            blk = (uch *)(&hdr->data[0]);
1687            block_id = (uch *)(&((struct IZ_block *)hdr)->bid);
1688
1689            if (EQL_L(block_id, FABSIG)) {
1690                outfab = (struct FAB *)extract_izvms_block(__G__ blk,
1691                  siz, NULL, (uch *)&cc$rms_fab, FABL);
1692            } else if (EQL_L(block_id, XALLSIG)) {
1693                xaball = (struct XABALL *)extract_izvms_block(__G__ blk,
1694                  siz, NULL, (uch *)&cc$rms_xaball, XALLL);
1695                LINK(xaball);
1696            } else if (EQL_L(block_id, XKEYSIG)) {
1697                xabkey = (struct XABKEY *)extract_izvms_block(__G__ blk,
1698                  siz, NULL, (uch *)&cc$rms_xabkey, XKEYL);
1699                LINK(xabkey);
1700            } else if (EQL_L(block_id, XFHCSIG)) {
1701                xabfhc = (struct XABFHC *) extract_izvms_block(__G__ blk,
1702                  siz, NULL, (uch *)&cc$rms_xabfhc, XFHCL);
1703            } else if (EQL_L(block_id, XDATSIG)) {
1704                if (set_date_time) {
1705                    xabdat = (struct XABDAT *) extract_izvms_block(__G__ blk,
1706                      siz, NULL, (uch *)&cc$rms_xabdat, XDATL);
1707                }
1708            } else if (EQL_L(block_id, XRDTSIG)) {
1709                if (set_date_time) {
1710                    xabrdt = (struct XABRDT *) extract_izvms_block(__G__ blk,
1711                      siz, NULL, (uch *)&cc$rms_xabrdt, XRDTL);
1712                }
1713            } else if (EQL_L(block_id, XPROSIG)) {
1714                xabpro = (struct XABPRO *) extract_izvms_block(__G__ blk,
1715                  siz, NULL, (uch *)&cc$rms_xabpro, XPROL);
1716            } else if (EQL_L(block_id, VERSIG)) {
1717#ifdef CHECK_VERSIONS
1718                char verbuf[80];
1719                unsigned verlen = 0;
1720                uch *vers;
1721                char *m;
1722
1723                get_vms_version(verbuf, sizeof(verbuf));
1724                vers = extract_izvms_block(__G__ blk, siz,
1725                                           &verlen, NULL, 0);
1726                if ((m = strrchr((char *) vers, '-')) != NULL)
1727                    *m = '\0';  /* Cut out release number */
1728                if (strcmp(verbuf, (char *) vers) && uO.qflag < 2)
1729                {
1730                    Info(slide, 0, ((char *)slide,
1731                         "[ Warning: VMS version mismatch."));
1732
1733                    Info(slide, 0, ((char *)slide,
1734                         "   This version %s --", verbuf));
1735                    strncpy(verbuf, (char *) vers, verlen);
1736                    verbuf[verlen] = '\0';
1737                    Info(slide, 0, ((char *)slide,
1738                         " version made by %s ]\n", verbuf));
1739                }
1740                free(vers);
1741#endif /* CHECK_VERSIONS */
1742            } else {
1743                Info(slide, 1, ((char *)slide,
1744                     "[ Warning: Unknown block signature %s ]\n",
1745                     block_id));
1746            }
1747        }
1748        else if (hdr->tag == PK_SIGNATURE)
1749        {
1750            /*
1751             *  PKWARE-style extra block decoding.
1752             */
1753            struct  PK_header   *blk;
1754            register byte   *scn;
1755            register int    len;
1756
1757            type = VAT_PK;
1758
1759            blk = (struct PK_header *)hdr;
1760            len = blk->size - (PK_HEADER_SIZE - EB_HEADSIZE);
1761            scn = (byte *)(&blk->data);
1762            pka_idx = 0;
1763
1764            if (blk->crc32 != crc32(CRCVAL_INITIAL, scn, (extent)len))
1765            {
1766                Info(slide, 1, ((char *)slide,
1767                  "[ Warning: CRC error, discarding PKWARE extra field ]\n"));
1768                len = 0;
1769                type = VAT_NONE;
1770            }
1771
1772            while (len > PK_FLDHDR_SIZE)
1773            {
1774                register struct  PK_field  *fld;
1775                int skip=0;
1776
1777                fld = (struct PK_field *)scn;
1778                switch(fld->tag)
1779                {
1780                    case ATR$C_UCHAR:
1781                        pka_uchar = L(&fld->value);
1782                        break;
1783                    case ATR$C_RECATTR:
1784                        pka_rattr = *(struct fatdef *)(&fld->value);
1785                        break;
1786                    case ATR$C_UIC:
1787                    case ATR$C_ADDACLENT:
1788                        skip = !uO.X_flag;
1789                        break;
1790                    case ATR$C_CREDATE:
1791                    case ATR$C_REVDATE:
1792                    case ATR$C_EXPDATE:
1793                    case ATR$C_BAKDATE:
1794                    case ATR$C_ASCDATES:
1795                        skip = (set_date_time == FALSE);
1796                        break;
1797                }
1798
1799                if ( !skip )
1800                {
1801                    pka_atr[pka_idx].atr$w_size = fld->size;
1802                    pka_atr[pka_idx].atr$w_type = fld->tag;
1803                    pka_atr[pka_idx].atr$l_addr = GVTC &fld->value;
1804                    ++pka_idx;
1805                }
1806                len -= fld->size + PK_FLDHDR_SIZE;
1807                scn += fld->size + PK_FLDHDR_SIZE;
1808            }
1809            pka_atr[pka_idx].atr$w_size = 0;    /* End of list */
1810            pka_atr[pka_idx].atr$w_type = 0;
1811            pka_atr[pka_idx].atr$l_addr = 0; /* NULL when DECC VAX gets fixed */
1812        }
1813        len -= hdr->size + EB_HEADSIZE;
1814        scan += hdr->size + EB_HEADSIZE;
1815    }
1816
1817    if ( type == VAT_IZ )
1818    {
1819        if (outfab != NULL)
1820        {
1821            /* Do not link XABPRO or XABRDT now.
1822             * Leave them for sys$close() resp. set_direc_attribs().
1823             */
1824            outfab->fab$l_xab = NULL;
1825            if (xabfhc != NULL)
1826            {
1827                xabfhc->xab$l_nxt = outfab->fab$l_xab;
1828                outfab->fab$l_xab = (void *) xabfhc;
1829            }
1830            if (xabdat != NULL)
1831            {
1832                xabdat->xab$l_nxt = outfab->fab$l_xab;
1833                outfab->fab$l_xab = (void *) xabdat;
1834            }
1835            if (first_xab != NULL)      /* Link xaball,xabkey subchain */
1836            {
1837                last_xab->xab$l_nxt = outfab->fab$l_xab;
1838                outfab->fab$l_xab = (void *) first_xab;
1839            }
1840        }
1841        else
1842            type = VAT_NONE;
1843    }
1844    return type;
1845}
1846
1847
1848
1849static void free_up()
1850{
1851    /*
1852     * Free up all allocated XABs.
1853     */
1854    if (xabdat != NULL) free(xabdat);
1855    if (xabpro != NULL) free(xabpro);
1856    if (xabrdt != NULL) free(xabrdt);
1857    if (xabfhc != NULL) free(xabfhc);
1858    while (first_xab != NULL)
1859    {
1860        struct XAB *x;
1861
1862        x = (struct XAB *) first_xab->xab$l_nxt;
1863        free(first_xab);
1864        first_xab = x;
1865    }
1866    /* Free FAB storage, if not the static one. */
1867    if (outfab != NULL && outfab != &fileblk)
1868        free(outfab);
1869}
1870
1871
1872
1873#ifdef CHECK_VERSIONS
1874
1875static int get_vms_version(verbuf, len)
1876    char *verbuf;
1877    int len;
1878{
1879    int i = SYI$_VERSION;
1880    int verlen = 0;
1881    struct dsc$descriptor version;
1882    char *m;
1883
1884    version.dsc$a_pointer = verbuf;
1885    version.dsc$w_length  = len - 1;
1886    version.dsc$b_dtype   = DSC$K_DTYPE_B;
1887    version.dsc$b_class   = DSC$K_CLASS_S;
1888
1889    if (ERR(lib$getsyi(&i, 0, &version, &verlen, 0, 0)) || verlen == 0)
1890        return 0;
1891
1892    /* Cut out trailing spaces "V5.4-3   " -> "V5.4-3" */
1893    for (m = verbuf + verlen, i = verlen - 1; i > 0 && verbuf[i] == ' '; --i)
1894        --m;
1895    *m = '\0';
1896
1897    /* Cut out release number "V5.4-3" -> "V5.4" */
1898    if ((m = strrchr(verbuf, '-')) != NULL)
1899        *m = '\0';
1900    return strlen(verbuf) + 1;  /* Transmit ending '\0' too */
1901}
1902
1903#endif /* CHECK_VERSIONS */
1904
1905
1906
1907/* flush contents of output buffer */
1908int flush(__G__ rawbuf, size, unshrink)    /* return PK-type error code */
1909    __GDEF
1910    uch *rawbuf;
1911    ulg size;
1912    int unshrink;
1913{
1914    G.crc32val = crc32(G.crc32val, rawbuf, (extent)size);
1915    if (uO.tflag)
1916        return PK_COOL; /* Do not output. Update CRC only */
1917    else
1918        return (*_flush_routine)(__G__ rawbuf, size, 0);
1919}
1920
1921
1922
1923static int _flush_blocks(__G__ rawbuf, size, final_flag)
1924                                                /* Asynchronous version */
1925    __GDEF
1926    uch *rawbuf;
1927    unsigned size;
1928    int final_flag;   /* 1 if this is the final flushout */
1929{
1930    int status;
1931    unsigned off = 0;
1932
1933    while (size > 0)
1934    {
1935        if (curbuf->bufcnt < BUFS512)
1936        {
1937            unsigned ncpy;
1938
1939            ncpy = size > (BUFS512 - curbuf->bufcnt) ?
1940                   (BUFS512 - curbuf->bufcnt) : size;
1941            memcpy(curbuf->buf + curbuf->bufcnt, rawbuf + off, ncpy);
1942            size -= ncpy;
1943            curbuf->bufcnt += ncpy;
1944            off += ncpy;
1945        }
1946        if (curbuf->bufcnt == BUFS512)
1947        {
1948            status = WriteBuffer(__G__ curbuf->buf, curbuf->bufcnt);
1949            if (status)
1950                return status;
1951            curbuf = curbuf->next;
1952            curbuf->bufcnt = 0;
1953        }
1954    }
1955
1956    return (final_flag && (curbuf->bufcnt > 0)) ?
1957        WriteBuffer(__G__ curbuf->buf, curbuf->bufcnt) :
1958        PK_COOL;
1959}
1960
1961
1962
1963#ifdef ASYNCH_QIO
1964static int WriteQIO(__G__ buf, len)
1965    __GDEF
1966    uch *buf;
1967    unsigned len;
1968{
1969    int status;
1970
1971    if (pka_io_pending) {
1972        status = sys$synch(0, &pka_io_iosb);
1973        if (!ERR(status))
1974            status = pka_io_iosb.status;
1975        if (ERR(status))
1976        {
1977            vms_msg(__G__ "[ WriteQIO: sys$synch found I/O failure ]\n",
1978                    status);
1979            return PK_DISK;
1980        }
1981        pka_io_pending = FALSE;
1982    }
1983    /*
1984     *   Put content of buffer as a single VB
1985     */
1986    status = sys$qio(0, pka_devchn, IO$_WRITEVBLK,
1987                     &pka_io_iosb, 0, 0,
1988                     buf, len, pka_vbn,
1989                     0, 0, 0);
1990    if (ERR(status))
1991    {
1992        vms_msg(__G__ "[ WriteQIO: sys$qio failed ]\n", status);
1993        return PK_DISK;
1994    }
1995    pka_io_pending = TRUE;
1996    pka_vbn += (len>>9);
1997
1998    return PK_COOL;
1999}
2000
2001/*
2002   2004-10-01 SMS.  Changed to clear the extra byte written out by qio()
2003   and sys$write() when an odd byte count is incremented to the next
2004   even value, either explicitly (qio), or implicitly (sys$write), on
2005   the theory that a reliable NUL beats left-over garbage.  Alpha and
2006   VAX object files seem frequently to have even more than one byte of
2007   extra junk past EOF, so this may not help them.
2008*/
2009
2010static int _flush_qio(__G__ rawbuf, size, final_flag)
2011                                                /* Asynchronous version */
2012    __GDEF
2013    uch *rawbuf;
2014    unsigned size;
2015    int final_flag;   /* 1 if this is the final flushout */
2016{
2017    int status;
2018    unsigned off = 0;
2019
2020    while (size > 0)
2021    {
2022        if (curbuf->bufcnt < BUFS512)
2023        {
2024            unsigned ncpy;
2025
2026            ncpy = size > (BUFS512 - curbuf->bufcnt) ?
2027                   (BUFS512 - curbuf->bufcnt) : size;
2028            memcpy(curbuf->buf + curbuf->bufcnt, rawbuf + off, ncpy);
2029            size -= ncpy;
2030            curbuf->bufcnt += ncpy;
2031            off += ncpy;
2032        }
2033        if (curbuf->bufcnt == BUFS512)
2034        {
2035            status = WriteQIO(__G__ curbuf->buf, curbuf->bufcnt);
2036            if (status)
2037                return status;
2038            curbuf = curbuf->next;
2039            curbuf->bufcnt = 0;
2040        }
2041    }
2042
2043    if (final_flag && (curbuf->bufcnt > 0))
2044    {
2045        unsigned bufcnt_even;
2046
2047        /* Round up to an even byte count. */
2048        bufcnt_even = (curbuf->bufcnt+1) & (~1);
2049        /* If there is one, clear the extra byte. */
2050        if (bufcnt_even > curbuf->bufcnt)
2051            curbuf->buf[curbuf->bufcnt] = '\0';
2052
2053        return WriteQIO(curbuf->buf, bufcnt_even);
2054    }
2055    else
2056    {
2057        return PK_COOL;
2058    }
2059}
2060
2061#else /* !ASYNCH_QIO */
2062
2063static int _flush_qio(__G__ rawbuf, size, final_flag)
2064    __GDEF
2065    uch *rawbuf;
2066    unsigned size;
2067    int final_flag;   /* 1 if this is the final flushout */
2068{
2069    int status;
2070    uch *out_ptr=rawbuf;
2071
2072    if ( final_flag )
2073    {
2074        if ( loccnt > 0 )
2075        {
2076            unsigned loccnt_even;
2077
2078            /* Round up to an even byte count. */
2079            loccnt_even = (loccnt+1) & (~1);
2080            /* If there is one, clear the extra byte. */
2081            if (loccnt_even > loccnt)
2082                locbuf[loccnt] = '\0';
2083
2084            status = sys$qiow(0, pka_devchn, IO$_WRITEVBLK,
2085                              &pka_io_iosb, 0, 0,
2086                              locbuf,
2087                              loccnt_even,
2088                              pka_vbn,
2089                              0, 0, 0);
2090            if (!ERR(status))
2091                status = pka_io_iosb.status;
2092            if (ERR(status))
2093            {
2094                vms_msg(__G__ "[ Write QIO failed ]\n", status);
2095                return PK_DISK;
2096            }
2097        }
2098        return PK_COOL;
2099    }
2100
2101    if ( loccnt > 0 )
2102    {
2103        /*
2104         *   Fill local buffer upto 512 bytes then put it out
2105         */
2106        unsigned ncpy;
2107
2108        ncpy = 512-loccnt;
2109        if ( ncpy > size )
2110            ncpy = size;
2111
2112        memcpy(locptr, out_ptr, ncpy);
2113        locptr += ncpy;
2114        loccnt += ncpy;
2115        size -= ncpy;
2116        out_ptr += ncpy;
2117        if ( loccnt == 512 )
2118        {
2119            status = sys$qiow(0, pka_devchn, IO$_WRITEVBLK,
2120                              &pka_io_iosb, 0, 0,
2121                              locbuf, loccnt, pka_vbn,
2122                              0, 0, 0);
2123            if (!ERR(status))
2124                status = pka_io_iosb.status;
2125            if (ERR(status))
2126            {
2127                vms_msg(__G__ "[ Write QIO failed ]\n", status);
2128                return PK_DISK;
2129            }
2130
2131            pka_vbn++;
2132            loccnt = 0;
2133            locptr = locbuf;
2134        }
2135    }
2136
2137    if ( size >= 512 )
2138    {
2139        unsigned nblk, put_cnt;
2140
2141        /*
2142         *   Put rest of buffer as a single VB
2143         */
2144        put_cnt = (nblk = size>>9)<<9;
2145        status = sys$qiow(0, pka_devchn, IO$_WRITEVBLK,
2146                          &pka_io_iosb, 0, 0,
2147                          out_ptr, put_cnt, pka_vbn,
2148                          0, 0, 0);
2149        if (!ERR(status))
2150            status = pka_io_iosb.status;
2151        if (ERR(status))
2152        {
2153            vms_msg(__G__ "[ Write QIO failed ]\n", status);
2154            return PK_DISK;
2155        }
2156
2157        pka_vbn += nblk;
2158        out_ptr += put_cnt;
2159        size -= put_cnt;
2160    }
2161
2162    if ( size > 0 )
2163    {
2164        memcpy(locptr, out_ptr, size);
2165        loccnt += size;
2166        locptr += size;
2167    }
2168
2169    return PK_COOL;
2170}
2171#endif /* ?ASYNCH_QIO */
2172
2173
2174
2175/*
2176 * The routine _flush_varlen() requires: "(size & 1) == 0"
2177 * (The variable-length record algorithm assumes an even byte-count!)
2178 */
2179static int _flush_varlen(__G__ rawbuf, size, final_flag)
2180    __GDEF
2181    uch *rawbuf;
2182    unsigned size;
2183    int final_flag;
2184{
2185    unsigned nneed;
2186    unsigned reclen;
2187    uch *inptr=rawbuf;
2188
2189    /*
2190     * Flush local buffer
2191     */
2192
2193    if ( loccnt > 0 )           /* incomplete record left from previous call */
2194    {
2195        reclen = *(ush*)locbuf;
2196        nneed = reclen + 2 - loccnt;
2197        if ( nneed > size )
2198        {
2199            if ( size+loccnt > BUFSMAXREC )
2200            {
2201                char buf[80];
2202                Info(buf, 1, (buf,
2203                     "[ Record too long (%u bytes) ]\n", reclen));
2204                return PK_DISK;
2205            }
2206            memcpy(locbuf+loccnt, inptr, size);
2207            loccnt += size;
2208            size = 0;
2209        }
2210        else
2211        {
2212            memcpy(locbuf+loccnt, inptr, nneed);
2213            loccnt += nneed;
2214            size -= nneed;
2215            inptr += nneed;
2216            if ( reclen & 1 )
2217            {
2218                size--;
2219                inptr++;
2220            }
2221            if ( WriteRecord(__G__ locbuf+2, reclen) )
2222                return PK_DISK;
2223            loccnt = 0;
2224        }
2225    }
2226    /*
2227     * Flush incoming records
2228     */
2229    while (size > 0)
2230    {
2231        reclen = *(ush*)inptr;
2232        if ( reclen+2 <= size )
2233        {
2234            if (WriteRecord(__G__ inptr+2, reclen))
2235                return PK_DISK;
2236            size -= 2+reclen;
2237            inptr += 2+reclen;
2238            if ( reclen & 1 )
2239            {
2240                --size;
2241                ++inptr;
2242            }
2243        }
2244        else
2245        {
2246            memcpy(locbuf, inptr, size);
2247            loccnt = size;
2248            size = 0;
2249        }
2250
2251    }
2252    /*
2253     * Final flush rest of local buffer
2254     */
2255    if ( final_flag && loccnt > 0 )
2256    {
2257        char buf[80];
2258
2259        Info(buf, 1, (buf,
2260             "[ Warning, incomplete record of length %u ]\n",
2261             (unsigned)*(ush*)locbuf));
2262        if ( WriteRecord(__G__ locbuf+2, loccnt-2) )
2263            return PK_DISK;
2264    }
2265    return PK_COOL;
2266}
2267
2268
2269
2270/*
2271 *   Routine _flush_stream breaks decompressed stream into records
2272 *   depending on format of the stream (fab->rfm, G.pInfo->textmode, etc.)
2273 *   and puts out these records. It also handles CR LF sequences.
2274 *   Should be used when extracting *text* files.
2275 */
2276
2277#define VT      0x0B
2278#define FF      0x0C
2279
2280/* The file is from MSDOS/OS2/NT -> handle CRLF as record end, throw out ^Z */
2281
2282/* GRR NOTES:  cannot depend on hostnum!  May have "flip'd" file or re-zipped
2283 * a Unix file, etc. */
2284
2285#ifdef USE_ORIG_DOS
2286# define ORG_DOS \
2287          (G.pInfo->hostnum==FS_FAT_    \
2288        || G.pInfo->hostnum==FS_HPFS_   \
2289        || G.pInfo->hostnum==FS_NTFS_)
2290#else
2291# define ORG_DOS    1
2292#endif
2293
2294/* Record delimiters */
2295#ifdef undef
2296#define RECORD_END(c, f)                                                \
2297(    ( ORG_DOS || G.pInfo->textmode ) && c==CTRLZ                       \
2298  || ( f == FAB$C_STMLF && c==LF )                                      \
2299  || ( f == FAB$C_STMCR || ORG_DOS || G.pInfo->textmode ) && c==CR      \
2300  || ( f == FAB$C_STM && (c==CR || c==LF || c==FF || c==VT) )           \
2301)
2302#else
2303#   define  RECORD_END(c, f)   ((c) == LF || (c) == (CR))
2304#endif
2305
2306static unsigned find_eol(p, n, l)
2307/*
2308 *  Find first CR, LF, CR/LF or LF/CR in string 'p' of length 'n'.
2309 *  Return offset of the sequence found or 'n' if not found.
2310 *  If found, return in '*l' length of the sequence (1 or 2) or
2311 *  zero if sequence end not seen, i.e. CR or LF is last char
2312 *  in the buffer.
2313 */
2314    ZCONST uch *p;
2315    unsigned n;
2316    unsigned *l;
2317{
2318    unsigned off = n;
2319    ZCONST uch *q;
2320
2321    *l = 0;
2322
2323    for (q=p ; n > 0 ; --n, ++q)
2324        if ( RECORD_END(*q, rfm) )
2325        {
2326            off = q-p;
2327            break;
2328        }
2329
2330    if ( n > 1 )
2331    {
2332        *l = 1;
2333        if ( ( q[0] == CR && q[1] == LF ) || ( q[0] == LF && q[1] == CR ) )
2334            *l = 2;
2335    }
2336
2337    return off;
2338}
2339
2340/* Record delimiters that must be put out */
2341#define PRINT_SPEC(c)   ( (c)==FF || (c)==VT )
2342
2343
2344
2345static int _flush_stream(__G__ rawbuf, size, final_flag)
2346    __GDEF
2347    uch *rawbuf;
2348    unsigned size;
2349    int final_flag; /* 1 if this is the final flushout */
2350{
2351    int rest;
2352    unsigned end = 0, start = 0;
2353
2354    if (size == 0 && loccnt == 0)
2355        return PK_COOL;         /* Nothing to do ... */
2356
2357    if ( final_flag )
2358    {
2359        unsigned recsize;
2360
2361        /*
2362         * This is flush only call. size must be zero now.
2363         * Just eject everything we have in locbuf.
2364         */
2365        recsize = loccnt - (got_eol ? 1 : 0);
2366        /*
2367         *  If the last char of file was ^Z ( end-of-file in MSDOS ),
2368         *  we will see it now.
2369         */
2370        if ( recsize==1 && locbuf[0] == CTRLZ )
2371            return PK_COOL;
2372
2373        return WriteRecord(__G__ locbuf, recsize);
2374    }
2375
2376
2377    if ( loccnt > 0 )
2378    {
2379        /* Find end of record partially saved in locbuf */
2380
2381        unsigned recsize;
2382        int complete=0;
2383
2384        if ( got_eol )
2385        {
2386            recsize = loccnt - 1;
2387            complete = 1;
2388
2389            if ( (got_eol == CR && rawbuf[0] == LF) ||
2390                 (got_eol == LF && rawbuf[0] == CR) )
2391                end = 1;
2392
2393            got_eol = 0;
2394        }
2395        else
2396        {
2397            unsigned eol_len;
2398            unsigned eol_off;
2399
2400            eol_off = find_eol(rawbuf, size, &eol_len);
2401
2402            if ( loccnt+eol_off > BUFSMAXREC )
2403            {
2404                /*
2405                 *  No room in locbuf. Dump it and clear
2406                 */
2407                char buf[80];           /* CANNOT use slide for Info() */
2408
2409                recsize = loccnt;
2410                start = 0;
2411                Info(buf, 1, (buf,
2412                     "[ Warning: Record too long (%u) ]\n", loccnt+eol_off));
2413                complete = 1;
2414                end = 0;
2415            }
2416            else
2417            {
2418                if ( eol_off >= size )
2419                {
2420                    end = size;
2421                    complete = 0;
2422                }
2423                else if ( eol_len == 0 )
2424                {
2425                    got_eol = rawbuf[eol_off];
2426                    end = size;
2427                    complete = 0;
2428                }
2429                else
2430                {
2431                    memcpy(locptr, rawbuf, eol_off);
2432                    recsize = loccnt + eol_off;
2433                    locptr += eol_off;
2434                    loccnt += eol_off;
2435                    end = eol_off + eol_len;
2436                    complete = 1;
2437                }
2438            }
2439        }
2440
2441        if ( complete )
2442        {
2443            if (WriteRecord(__G__ locbuf, recsize))
2444                return PK_DISK;
2445            loccnt = 0;
2446            locptr = locbuf;
2447        }
2448    }                           /* end if ( loccnt ) */
2449
2450    for (start = end; start < size && end < size; )
2451    {
2452        unsigned eol_off, eol_len;
2453
2454        got_eol = 0;
2455
2456#ifdef undef
2457        if (uO.cflag)
2458            /* skip CR's at the beginning of record */
2459            while (start < size && rawbuf[start] == CR)
2460                ++start;
2461#endif
2462
2463        if ( start >= size )
2464            continue;
2465
2466        /* Find record end */
2467        end = start+(eol_off = find_eol(rawbuf+start, size-start, &eol_len));
2468
2469        if ( end >= size )
2470            continue;
2471
2472        if ( eol_len > 0 )
2473        {
2474            if ( WriteRecord(__G__ rawbuf+start, end-start) )
2475                return PK_DISK;
2476            start = end + eol_len;
2477        }
2478        else
2479        {
2480            got_eol = rawbuf[end];
2481            end = size;
2482            continue;
2483        }
2484    }
2485
2486    rest = size - start;
2487
2488    if (rest > 0)
2489    {
2490        if ( rest > BUFSMAXREC )
2491        {
2492            unsigned recsize;
2493            char buf[80];               /* CANNOT use slide for Info() */
2494
2495            recsize = rest - (got_eol ? 1 : 0 );
2496            Info(buf, 1, (buf,
2497                 "[ Warning: Record too long (%u) ]\n", recsize));
2498            got_eol = 0;
2499            return WriteRecord(__G__ rawbuf+start, recsize);
2500        }
2501        else
2502        {
2503            memcpy(locptr, rawbuf + start, rest);
2504            locptr += rest;
2505            loccnt += rest;
2506        }
2507    }
2508    return PK_COOL;
2509}
2510
2511
2512
2513static int WriteBuffer(__G__ buf, len)
2514    __GDEF
2515    uch *buf;
2516    unsigned len;
2517{
2518    int status;
2519
2520    if (uO.cflag)
2521    {
2522        (void)(*G.message)((zvoid *)&G, buf, len, 0);
2523    }
2524    else
2525    {
2526        status = sys$wait(outrab);
2527        if (ERR(status))
2528        {
2529            vms_msg(__G__ "[ WriteBuffer: sys$wait failed ]\n", status);
2530            if (outrab->rab$l_stv != 0)
2531            {
2532                vms_msg(__G__ "", outrab->rab$l_stv);
2533            }
2534        }
2535
2536        /* If odd byte count, then this must be the final record.
2537           Clear the extra byte past EOF to help keep the file clean.
2538        */
2539        if (len & 1)
2540            buf[len] = '\0';
2541
2542        outrab->rab$w_rsz = len;
2543        outrab->rab$l_rbf = (char *) buf;
2544
2545        if (ERR(status = sys$write(outrab)))
2546        {
2547            vms_msg(__G__ "[ WriteBuffer: sys$write failed ]\n", status);
2548            if (outrab->rab$l_stv != 0)
2549            {
2550                vms_msg(__G__ "", outrab->rab$l_stv);
2551            }
2552            return PK_DISK;
2553        }
2554    }
2555    return PK_COOL;
2556}
2557
2558
2559
2560static int WriteRecord(__G__ rec, len)
2561    __GDEF
2562    uch *rec;
2563    unsigned len;
2564{
2565    int status;
2566
2567    if (uO.cflag)
2568    {
2569        (void)(*G.message)((zvoid *)&G, rec, len, 0);
2570        (void)(*G.message)((zvoid *)&G, (uch *) ("\n"), 1, 0);
2571    }
2572    else
2573    {
2574        if (ERR(status = sys$wait(outrab)))
2575        {
2576            vms_msg(__G__ "[ WriteRecord: sys$wait failed ]\n", status);
2577            if (outrab->rab$l_stv != 0)
2578            {
2579                vms_msg(__G__ "", outrab->rab$l_stv);
2580            }
2581        }
2582        outrab->rab$w_rsz = len;
2583        outrab->rab$l_rbf = (char *) rec;
2584
2585        if (ERR(status = sys$put(outrab)))
2586        {
2587            vms_msg(__G__ "[ WriteRecord: sys$put failed ]\n", status);
2588            if (outrab->rab$l_stv != 0)
2589            {
2590                vms_msg(__G__ "", outrab->rab$l_stv);
2591            }
2592            return PK_DISK;
2593        }
2594    }
2595    return PK_COOL;
2596}
2597
2598
2599
2600#ifdef SYMLINKS
2601/* Read symlink text from a still-open rms file. */
2602
2603static int _read_link_rms(int byte_count, char *link_text_buf)
2604{
2605    /* Use RMS to read the link text into the user's buffer.
2606     * Rewind, then read byte count = byte_count.
2607     * NUL-terminate the link text.
2608     *
2609     * $WAIT may be pointless if not async, but $WAIT elsewhere seems
2610     * to be used unconditionally, so what do I know?
2611     */
2612    int sts;
2613    int bytes_read;
2614
2615    /* Clear the bytes-read count. */
2616    bytes_read = 0;
2617
2618    /* Wait for anything pending. */
2619    sts = sys$wait(outrab);
2620    {
2621        /* Rewind. */
2622        sts = sys$rewind(outrab);
2623        if (!ERR(sts))
2624        {
2625            /* Wait for $REWIND. */
2626            sts = sys$wait(outrab);
2627            if (!ERR(sts))
2628            {
2629                /* Read the link text. */
2630                outrab->rab$w_usz = byte_count;
2631                outrab->rab$l_ubf = link_text_buf;
2632                sts = sys$read(outrab);
2633                if (!ERR(sts))
2634                {
2635                    /* Wait for $READ. */
2636                    sts = sys$wait(outrab);
2637
2638                    if (!ERR(sts))
2639                        /* Set the resultant byte count. */
2640                        bytes_read = outrab->rab$w_rsz;
2641                }
2642            }
2643        }
2644    }
2645
2646    /* NUL-terminate the link text. */
2647    link_text_buf[bytes_read] = '\0';
2648
2649    return sts;
2650}
2651
2652#endif /* SYMLINKS */
2653
2654
2655
2656void close_outfile(__G)
2657    __GDEF
2658{
2659    int status;
2660
2661    status = (*_flush_routine)(__G__ NULL, 0, 1);
2662    if (status)
2663        return /* PK_DISK */;
2664    if (uO.cflag)
2665        return /* PK_COOL */;   /* Don't close stdout */
2666    /* return */ (*_close_routine)(__G);
2667}
2668
2669
2670
2671static int _close_rms(__GPRO)
2672{
2673    int status;
2674    struct XABPRO pro;
2675    int retcode = PK_OK;
2676
2677#ifdef SYMLINKS
2678
2679/*----------------------------------------------------------------------
2680    UNIX description:
2681    If symbolic links are supported, allocate storage for a symlink
2682    control structure, put the uncompressed "data" and other required
2683    info in it, and add the structure to the "deferred symlinks" chain.
2684    Since we know it's a symbolic link to start with, we shouldn't have
2685    to worry about overflowing unsigned ints with unsigned longs.
2686----------------------------------------------------------------------*/
2687
2688    if (G.symlnk) {
2689        extent ucsize = (extent)G.lrec.ucsize;
2690
2691        /* 2007-03-03 SMS.
2692         * If the symlink is already a symlink (restored with VMS/RMS
2693         * symlink attributes), then read the link text from the file,
2694         * and close the file (using the appropriate methods), and then
2695         * return.
2696         */
2697        if (G.pInfo->symlink == 0)
2698        {
2699            if (QCOND2)
2700            {
2701                /* Link text storage. */
2702                char* link_target = malloc(ucsize + 1);
2703
2704                if (link_target == NULL)
2705                {
2706                    Info(slide, 0x201, ((char *)slide,
2707                      "warning:  cannot show symlink (%s) target, no mem\n",
2708                      FnFilter1(G.filename)));
2709                      retcode = PK_MEM;
2710                }
2711                else
2712                {
2713                    /* Read the link text. */
2714                    status = _read_link_rms(ucsize, link_target);
2715
2716                    if (ERR(status))
2717                    {
2718                        Info(slide, 0x201, ((char *)slide,
2719                          "warning:  error reading symlink text: %s\n",
2720                          strerror(EVMSERR, status)));
2721                        retcode = PK_DISK;
2722                    }
2723                    else
2724                    {
2725                        Info(slide, 0, ((char *)slide, "-> %s ",
2726                          FnFilter1(link_target)));
2727                    }
2728
2729                    free(link_target);
2730                }
2731            }
2732        }
2733        else
2734        {
2735            extent slnk_entrysize;
2736            slinkentry *slnk_entry;
2737
2738            /* It's a symlink in need of post-processing. */
2739            /* Size of the symlink entry is the sum of
2740             *  (struct size (includes 1st '\0') + 1 additional trailing '\0'),
2741             *  system specific attribute data size (might be 0),
2742             *  and the lengths of name and link target.
2743             */
2744            slnk_entrysize = (sizeof(slinkentry) + 1) +
2745                             ucsize + strlen(G.filename);
2746
2747            if (slnk_entrysize < ucsize) {
2748                Info(slide, 0x201, ((char *)slide,
2749                  "warning:  symbolic link (%s) failed: mem alloc overflow\n",
2750                  FnFilter1(G.filename)));
2751                retcode = PK_ERR;
2752            }
2753            else
2754            {
2755                if ((slnk_entry = (slinkentry *)malloc(slnk_entrysize))
2756                    == NULL) {
2757                    Info(slide, 0x201, ((char *)slide,
2758                      "warning:  symbolic link (%s) failed, no mem\n",
2759                      FnFilter1(G.filename)));
2760                    retcode = PK_MEM;
2761                }
2762                else
2763                {
2764                    slnk_entry->next = NULL;
2765                    slnk_entry->targetlen = ucsize;
2766                    /* don't set attributes for symlinks */
2767                    slnk_entry->attriblen = 0;
2768                    slnk_entry->target = slnk_entry->buf;
2769                    slnk_entry->fname = slnk_entry->target + ucsize + 1;
2770                    strcpy(slnk_entry->fname, G.filename);
2771
2772                    /* Read the link text using the appropriate method. */
2773                    status = _read_link_rms(ucsize, slnk_entry->target);
2774
2775                    if (ERR(status))
2776                    {
2777                        Info(slide, 0x201, ((char *)slide,
2778                          "warning:  error reading symlink text (rms): %s\n",
2779                          strerror(EVMSERR, status)));
2780                        free(slnk_entry);
2781                        retcode = PK_DISK;
2782                    }
2783                    else
2784                    {
2785                        if (QCOND2)
2786                            Info(slide, 0, ((char *)slide, "-> %s ",
2787                              FnFilter1(slnk_entry->target)));
2788
2789                        /* Add this symlink record to the list of
2790                           deferred symlinks. */
2791                        if (G.slink_last != NULL)
2792                            G.slink_last->next = slnk_entry;
2793                        else
2794                            G.slink_head = slnk_entry;
2795                        G.slink_last = slnk_entry;
2796                    }
2797                }
2798            }
2799        }
2800    }
2801#endif /* SYMLINKS */
2802
2803    /* Link XABRDT, XABDAT, and (optionally) XABPRO. */
2804    if (xabrdt != NULL)
2805    {
2806        xabrdt->xab$l_nxt = NULL;
2807        outfab->fab$l_xab = (void *) xabrdt;
2808    }
2809    else
2810    {
2811        rdt.xab$l_nxt = NULL;
2812        outfab->fab$l_xab = (void *) &rdt;
2813    }
2814    if (xabdat != NULL)
2815    {
2816        xabdat->xab$l_nxt = outfab->fab$l_xab;
2817        outfab->fab$l_xab = (void *)xabdat;
2818    }
2819
2820    if (xabpro != NULL)
2821    {
2822        if ( !uO.X_flag )
2823            xabpro->xab$l_uic = 0;    /* Use default (user's) uic */
2824        xabpro->xab$l_nxt = outfab->fab$l_xab;
2825        outfab->fab$l_xab = (void *) xabpro;
2826    }
2827    else
2828    {
2829        pro = cc$rms_xabpro;
2830        pro.xab$w_pro = G.pInfo->file_attr;
2831        pro.xab$l_nxt = outfab->fab$l_xab;
2832        outfab->fab$l_xab = (void *) &pro;
2833    }
2834
2835    status = sys$wait(outrab);
2836    if (ERR(status))
2837    {
2838        vms_msg(__G__ "[ _close_rms: sys$wait failed ]\n", status);
2839        if (outrab->rab$l_stv != 0)
2840        {
2841            vms_msg(__G__ "", outrab->rab$l_stv);
2842        }
2843    }
2844
2845    status = sys$close(outfab);
2846#ifdef DEBUG
2847    if (ERR(status))
2848    {
2849        vms_msg(__G__
2850          "\r[ Warning: cannot set owner/protection/time attributes ]\n",
2851          status);
2852        if (outfab->fab$l_stv != 0)
2853        {
2854            vms_msg(__G__ "", outfab->fab$l_stv);
2855        }
2856        retcode = PK_WARN;
2857    }
2858#endif
2859    free_up();
2860    return retcode;
2861}
2862
2863
2864
2865static int _close_qio(__GPRO)
2866{
2867    int status;
2868
2869    pka_fib.FIB$L_ACCTL =
2870        FIB$M_WRITE | FIB$M_NOTRUNC ;
2871    pka_fib.FIB$W_EXCTL = 0;
2872
2873    pka_fib.FIB$W_FID[0] =
2874    pka_fib.FIB$W_FID[1] =
2875    pka_fib.FIB$W_FID[2] =
2876    pka_fib.FIB$W_DID[0] =
2877    pka_fib.FIB$W_DID[1] =
2878    pka_fib.FIB$W_DID[2] = 0;
2879
2880#ifdef ASYNCH_QIO
2881    if (pka_io_pending) {
2882        status = sys$synch(0, &pka_io_iosb);
2883        if (!ERR(status))
2884            status = pka_io_iosb.status;
2885        if (ERR(status))
2886        {
2887            vms_msg(__G__ "[ _close_qio: sys$synch found I/O failure ]\n",
2888                    status);
2889        }
2890        pka_io_pending = FALSE;
2891    }
2892#endif /* ASYNCH_QIO */
2893
2894#ifdef SYMLINKS
2895    if (G.symlnk && QCOND2)
2896    {
2897        /* Read back the symlink target specification for display purpose. */
2898        extent ucsize = (extent)G.lrec.ucsize;
2899        char *link_target;   /* Link text storage. */
2900
2901        if ((link_target = malloc(ucsize + 1)) == NULL)
2902        {
2903            Info(slide, 0x201, ((char *)slide,
2904              "warning:  cannot show symlink (%s) target, no mem\n",
2905              FnFilter1(G.filename)));
2906        }
2907        else
2908        {
2909            unsigned bytes_read = 0;
2910
2911            status = sys$qiow(0,                /* event flag */
2912                              pka_devchn,       /* channel */
2913                              IO$_READVBLK,     /* function */
2914                              &pka_io_iosb,     /* IOSB */
2915                              0,                /* AST address */
2916                              0,                /* AST parameter */
2917                              link_target,      /* P1 = buffer address */
2918                              ucsize,           /* P2 = requested byte count */
2919                              1,                /* P3 = VBN (1 = first) */
2920                              0,                /* P4 (not used) */
2921                              0,                /* P5 (not used) */
2922                              0);               /* P6 (not used) */
2923
2924            if (!ERR(status))
2925                /* Final status. */
2926                status = pka_io_iosb.status;
2927
2928            /* Set the resultant byte count. */
2929            if (!ERR(status))
2930                bytes_read = pka_io_iosb.count;
2931
2932            /* NUL-terminate the link text. */
2933            link_target[bytes_read] = '\0';
2934
2935            if (ERR(status))
2936            {
2937                Info(slide, 0x201, ((char *)slide,
2938                  "warning:  error reading symlink text (qio): %s\n",
2939                  strerror(EVMSERR, status)));
2940            }
2941            else
2942            {
2943                Info(slide, 0, ((char *)slide, "-> %s ",
2944                  FnFilter1(link_target)));
2945            }
2946
2947            free(link_target);
2948
2949        }
2950    }
2951#endif /* SYMLINKS */
2952
2953    status = sys$qiow(0, pka_devchn, IO$_DEACCESS, &pka_acp_iosb,
2954                      0, 0,
2955                      &pka_fibdsc, 0, 0, 0,
2956                      pka_atr, 0);
2957
2958    sys$dassgn(pka_devchn);
2959    if ( !ERR(status) )
2960        status = pka_acp_iosb.status;
2961    if ( ERR(status) )
2962    {
2963        vms_msg(__G__ "[ Deaccess QIO failed ]\n", status);
2964        return PK_DISK;
2965    }
2966    return PK_COOL;
2967}
2968
2969
2970
2971#ifdef SET_DIR_ATTRIB
2972
2973/*
2974 * 2006-10-04 SMS.
2975 * vms_path_fixdown().
2976 *
2977 * Convert VMS directory spec to VMS directory file name.  That is,
2978 * change "dev:[a.b.c.e]" to "dev:[a.b.c]e.DIR;1".  The result (always
2979 * larger than the source) is returned in the user's buffer.
2980 */
2981
2982#define DIR_TYPE_VER ".DIR;1"
2983
2984static char *vms_path_fixdown(ZCONST char *dir_spec, char *dir_file)
2985{
2986    char dir_close;
2987    char dir_open;
2988    unsigned i;
2989    unsigned dir_spec_len;
2990
2991    dir_spec_len = strlen(dir_spec);
2992    if (dir_spec_len == 0) return NULL;
2993    i = dir_spec_len - 1;
2994    dir_close = dir_spec[i];
2995
2996    /* Identify the directory delimiters (which must exist). */
2997    if (dir_close == ']')
2998    {
2999        dir_open = '[';
3000    }
3001    else if (dir_close == '>')
3002    {
3003        dir_open = '<';
3004    }
3005    else
3006    {
3007        return NULL;
3008    }
3009
3010    /* Find the beginning of the last directory name segment. */
3011    while ((i > 0) && ((dir_spec[i - 1] == '^') ||
3012           ((dir_spec[i] != '.') && (dir_spec[i] != dir_open))))
3013    {
3014        i--;
3015    }
3016
3017    /* Form the directory file name from the pieces. */
3018    if (dir_spec[i] == dir_open)
3019    {
3020        /* Top-level directory. */
3021        sprintf(dir_file, "%.*s000000%c%.*s%s",
3022          /*  "dev:[" "000000" "]" */
3023          (i + 1), dir_spec, dir_close,
3024          /*  "a" ".DIR;1" */
3025          (dir_spec_len - i - 2), (dir_spec + i + 1), DIR_TYPE_VER);
3026    }
3027    else
3028    {
3029        /* Non-top-level directory. */
3030        sprintf(dir_file, "%.*s%c%.*s%s",
3031          /*  "dev:[a.b.c" "]" */
3032          i, dir_spec, dir_close,
3033          /*  "e" ".DIR;1" */
3034          (dir_spec_len - i - 2), (dir_spec + i + 1), DIR_TYPE_VER);
3035    }
3036    return dir_file;
3037} /* end function vms_path_fixdown(). */
3038
3039
3040
3041/* Save directory attributes (as the archive's extra field). */
3042
3043/* 2006-12-13 SMS.
3044 * This could probably be made more efficient by analyzing the data
3045 * here, extracting the important data, and saving only what's needed.
3046 * Given the existing code, it seemed simpler to save them all here, and
3047 * deal with what's important in set_direc_attribs().
3048 */
3049
3050int defer_dir_attribs(__G__ pd)
3051    __GDEF
3052    direntry **pd;
3053{
3054    vmsdirattr *d_entry;
3055    unsigned fnlen;
3056    unsigned xlen;
3057
3058    /* Allocate space to save the file (directory) name, the extra
3059     * block, and all the other data needed by the extra-block data
3060     * scanner functions.  If that works, save the data.
3061     */
3062    fnlen = strlen(G.filename);
3063    xlen = G.lrec.extra_field_length;
3064    d_entry = (vmsdirattr *) malloc(sizeof(vmsdirattr) + fnlen + xlen);
3065    *pd = (direntry *) d_entry;
3066    if (d_entry == (vmsdirattr *) NULL)
3067    {
3068        return PK_MEM;
3069    }
3070
3071    /* Save extra block length and data. */
3072    d_entry->xlen = xlen;
3073    memcpy(d_entry->buf, G.extra_field, xlen);
3074
3075    /* Set pointer to file (directory) name. */
3076    d_entry->fn = d_entry->buf + xlen;
3077
3078    /* Save file (directory) name. */
3079    strcpy(d_entry->fn, G.filename);
3080    /* Strip the closing ']' char, to allow proper sorting. */
3081    d_entry->fn[fnlen - 1] = '\0';
3082
3083    /* Save generic permission data from mapattr(). */
3084    d_entry->perms = G.pInfo->file_attr;
3085
3086    /* Save G.lrec.last_mod_dos_datetime. */
3087    d_entry->mod_dos_datetime = G.lrec.last_mod_dos_datetime;
3088
3089    return PK_OK;
3090} /* end function defer_dir_attribs() */
3091
3092
3093
3094int set_direc_attribs(__G__ d)
3095    __GDEF
3096    direntry *d;
3097{
3098    uch *sav_ef_ptr;
3099    int i;
3100    int status;
3101    int type;
3102    ush attr;
3103    struct XABPRO pro;
3104    char dir_name[NAM_MAXRSS + 1];
3105    char warnmsg[NAM_MAXRSS + 128]; /* Name length + message length. */
3106    int retcode = PK_OK;
3107
3108    /* Re-append the closing ']' character which has been stripped in
3109     * defer_dir_attribs() for compatibility with generic sorting code.
3110     */
3111    strcat(VmsAtt(d)->fn, "]");
3112
3113    /* Convert "[a.b.c]" form into "[a.b]c.DIR;1" */
3114    vms_path_fixdown(VmsAtt(d)->fn, dir_name);
3115
3116    /* Dummy up critical global (G) data from the preserved directory
3117     * attribute data.
3118     */
3119    sav_ef_ptr = G.extra_field;
3120    G.extra_field = (uch *)((VmsAtt(d)->xlen > 0) ? VmsAtt(d)->buf : NULL);
3121    G.lrec.extra_field_length = VmsAtt(d)->xlen;
3122
3123    /* Extract the VMS file attributes from the preserved attribute
3124     * data, if they exist, and restore the date-time stamps.
3125     */
3126    type = find_vms_attrs(__G__ (uO.D_flag <= 0));
3127
3128    if (outfab == NULL)
3129    {
3130        /* Default and PK schemes need a FAB.  (IZ supplies one.)
3131         * In a degenerate case, this could be the first use of fileblk,
3132         * so we assume that we need to initialize it.
3133         */
3134        fileblk = cc$rms_fab;           /* Initialize FAB. */
3135        outfab = &fileblk;              /* Set pointer used elsewhere. */
3136    }
3137
3138    /* Arrange FAB-NAM[L] for file (directory) access. */
3139    if (type != VAT_NONE)
3140    {
3141        if (type == VAT_IZ)
3142        {
3143            /* Make an attribute descriptor list for the VMS creation and
3144             * revision dates (which were stored in the IZ XABs by
3145             * find_vms_attrs()).
3146             */
3147            pka_idx = 0;
3148
3149            if (xabrdt != NULL)
3150            {
3151                /* Revision date-time from XABRDT. */
3152                pka_atr[pka_idx].atr$w_size = 8;
3153                pka_atr[pka_idx].atr$w_type = ATR$C_REVDATE;
3154                pka_atr[pka_idx].atr$l_addr = GVTC &xabrdt->xab$q_rdt;
3155                ++pka_idx;
3156            }
3157            if (xabdat != NULL)
3158            {
3159                /* Trust the XABRDT value for revision date. */
3160                if (xabrdt == NULL)
3161                {
3162                    /* Revision date-time from XABDAT. */
3163                    pka_atr[pka_idx].atr$w_size = 8;
3164                    pka_atr[pka_idx].atr$w_type = ATR$C_REVDATE;
3165                    pka_atr[pka_idx].atr$l_addr = GVTC &xabdat->xab$q_rdt;
3166                    ++pka_idx;
3167                }
3168                /* Creation date-time from XABDAT. */
3169                pka_atr[pka_idx].atr$w_size = 8;
3170                pka_atr[pka_idx].atr$w_type = ATR$C_CREDATE;
3171                pka_atr[pka_idx].atr$l_addr = GVTC &xabdat->xab$q_cdt;
3172                ++pka_idx;
3173            }
3174            if (xabpro != NULL)
3175            {
3176                if ( uO.X_flag ) {
3177                    pka_atr[pka_idx].atr$w_size = 4;
3178                    pka_atr[pka_idx].atr$w_type = ATR$C_UIC;
3179                    pka_atr[pka_idx].atr$l_addr = GVTC &xabpro->xab$l_uic;
3180                    ++pka_idx;
3181                }
3182                attr = xabpro->xab$w_pro;
3183            }
3184            else
3185            {
3186                /* Revoke directory Delete permission for all. */
3187                attr = VmsAtt(d)->perms
3188                      | (((1<< XAB$V_NODEL)<< XAB$V_SYS)|
3189                         ((1<< XAB$V_NODEL)<< XAB$V_OWN)|
3190                         ((1<< XAB$V_NODEL)<< XAB$V_GRP)|
3191                         ((1<< XAB$V_NODEL)<< XAB$V_WLD));
3192            }
3193            pka_atr[pka_idx].atr$w_size = 2;
3194            pka_atr[pka_idx].atr$w_type = ATR$C_FPRO;
3195            pka_atr[pka_idx].atr$l_addr = GVTC &attr;
3196            ++pka_idx;
3197        }
3198    }
3199    else
3200    {
3201        /* No VMS attribute data were found.  Prepare to assemble
3202         * non-VMS attribute data.
3203         */
3204        pka_idx = 0;
3205
3206        /* Get the (already converted) non-VMS permissions. */
3207        attr = VmsAtt(d)->perms;        /* Use right-sized prot storage. */
3208
3209        /* Revoke directory Delete permission for all. */
3210        attr |= (((1<< XAB$V_NODEL)<< XAB$V_SYS)|
3211                 ((1<< XAB$V_NODEL)<< XAB$V_OWN)|
3212                 ((1<< XAB$V_NODEL)<< XAB$V_GRP)|
3213                 ((1<< XAB$V_NODEL)<< XAB$V_WLD));
3214
3215        pka_atr[pka_idx].atr$w_size = 2;
3216        pka_atr[pka_idx].atr$w_type = ATR$C_FPRO;
3217        pka_atr[pka_idx].atr$l_addr = GVTC &attr;
3218        ++pka_idx;
3219
3220        /* Restore directory date-time if user requests it (-D). */
3221        if (uO.D_flag <= 0)
3222        {
3223            /* Set the directory date-time from the non-VMS data.
3224             * Dummy up the DOS-style modification date into global (G)
3225             * data from the preserved directory attribute data.
3226             */
3227            G.lrec.last_mod_dos_datetime = VmsAtt(d)->mod_dos_datetime;
3228
3229            /* Extract date-time data from the normal attribute data. */
3230            set_default_datetime_XABs(__G);
3231
3232            /* Make an attribute descriptor list for the VMS creation
3233             * and revision dates (which were stored in the XABs by
3234             * set_default_datetime_XABs()).
3235             */
3236            pka_atr[pka_idx].atr$w_size = 8;
3237            pka_atr[pka_idx].atr$w_type = ATR$C_CREDATE;
3238            pka_atr[pka_idx].atr$l_addr = GVTC &dattim.xab$q_cdt;
3239            ++pka_idx;
3240            pka_atr[pka_idx].atr$w_size = 8;
3241            pka_atr[pka_idx].atr$w_type = ATR$C_REVDATE;
3242            pka_atr[pka_idx].atr$l_addr = GVTC &rdt.xab$q_rdt;
3243            ++pka_idx;
3244        }
3245
3246        /* Set the directory protection from the non-VMS data. */
3247
3248        /* Terminate the attribute descriptor list. */
3249        pka_atr[pka_idx].atr$w_size = 0;    /* End of list */
3250        pka_atr[pka_idx].atr$w_type = 0;
3251        pka_atr[pka_idx].atr$l_addr = 0; /* NULL when DECC VAX gets fixed. */
3252    }
3253
3254    nam = CC_RMS_NAM;               /* Initialize NAM[L]. */
3255    outfab->FAB_NAM = &nam;         /* Point FAB to NAM[L]. */
3256
3257    /* Point the FAB-NAM[L] to the VMS-format directory file name. */
3258
3259#ifdef NAML$C_MAXRSS
3260
3261    outfab->fab$l_dna = (char *) -1;    /* Using NAML for default name. */
3262    outfab->fab$l_fna = (char *) -1;    /* Using NAML for file name. */
3263
3264    /* Special ODS5-QIO-compatible name storage. */
3265    nam.naml$l_filesys_name = sys_nam;
3266    nam.naml$l_filesys_name_alloc = sizeof(sys_nam);
3267
3268#endif /* NAML$C_MAXRSS */
3269
3270    FAB_OR_NAML(*outfab, nam).FAB_OR_NAML_FNA = dir_name;
3271    FAB_OR_NAML(*outfab, nam).FAB_OR_NAML_FNS = strlen(dir_name);
3272
3273    /* Expanded and resultant name storage. */
3274    nam.NAM_ESA = exp_nam;
3275    nam.NAM_ESS = sizeof(exp_nam);
3276    nam.NAM_RSA = res_nam;
3277    nam.NAM_RSS = sizeof(res_nam);
3278
3279    status = sys$parse(outfab);
3280    if ( ERR(status) )
3281    {
3282        sprintf(warnmsg,
3283          "warning:  set-dir-attributes failed ($parse) for %s.\n",
3284          dir_name);
3285        vms_msg(__G__ warnmsg, status);
3286        retcode = PK_WARN;
3287        goto cleanup_exit;
3288    }
3289
3290    /* Set the length in the device name descriptor. */
3291    pka_devdsc.dsc$w_length = (unsigned short) nam.NAM_DVI[0];
3292
3293    /* Open a channel to the disk device. */
3294    status = sys$assign(&pka_devdsc, &pka_devchn, 0, 0);
3295    if ( ERR(status) )
3296    {
3297        sprintf(warnmsg,
3298          "warning:  set-dir-attributes failed ($assign) for %s.\n",
3299          dir_name);
3300        vms_msg(__G__ warnmsg, status);
3301        retcode = PK_WARN;
3302        goto cleanup_exit;
3303    }
3304
3305    /* Move the directory ID from the NAM[L] to the FIB.
3306       Clear the FID in the FIB, as we're using the name.
3307    */
3308    for (i = 0; i < 3; i++)
3309    {
3310        pka_fib.FIB$W_DID[i] = nam.NAM_DID[i];
3311        pka_fib.FIB$W_FID[i] = 0;
3312    }
3313
3314#ifdef NAML$C_MAXRSS
3315
3316    /* Enable fancy name characters.  Note that "fancy" here does
3317       not include Unicode, for which there's no support elsewhere.
3318    */
3319    pka_fib.fib$v_names_8bit = 1;
3320    pka_fib.fib$b_name_format_in = FIB$C_ISL1;
3321
3322    /* ODS5 Extended names used as input to QIO have peculiar
3323       encoding (perhaps to minimize storage?), so the special
3324       filesys_name result (typically containing fewer carets) must
3325       be used here.
3326    */
3327    pka_fnam.dsc$a_pointer = nam.naml$l_filesys_name;
3328    pka_fnam.dsc$w_length = nam.naml$l_filesys_name_size;
3329
3330#else /* !NAML$C_MAXRSS */
3331
3332    /* ODS2-only: Use the whole name. */
3333    pka_fnam.dsc$a_pointer = nam.NAM_L_NAME;
3334    pka_fnam.dsc$w_length = nam.NAM_B_NAME + nam.NAM_B_TYPE + nam.NAM_B_VER;
3335
3336#endif /* ?NAML$C_MAXRSS */
3337
3338    /* 2007-07-13 SMS.
3339     * Our freshly created directory can easily contain fewer files than
3340     * the original archived directory (for example, if not all the
3341     * files in the original directory were included in the archive), so
3342     * its size may differ from that of the archived directory.  Thus,
3343     * simply restoring the original RECATTR attributes structure, which
3344     * includes EFBLK (and so on) can cause "SYSTEM-W-BADIRECTORY, bad
3345     * directory file format" complaints.  Instead, we overwrite
3346     * selected archived attributes with current attributes, to avoid
3347     * setting obsolete/inappropriate attributes on the newly created
3348     * directory file.
3349     *
3350     * First, see if there is a RECATTR structure about which we need to
3351     * worry.
3352     */
3353    for (i = 0; pka_atr[i].atr$w_type != 0; i++)
3354    {
3355        if (pka_atr[i].atr$w_type == ATR$C_RECATTR)
3356        {
3357            /* We found a RECATTR structure which (we must assume) needs
3358             * adjustment.  Retrieve the RECATTR data for the existing
3359             * (newly created) directory file.
3360             */
3361            status = sys$qiow(0,                    /* event flag */
3362                              pka_devchn,           /* channel */
3363                              IO$_ACCESS,           /* function code */
3364                              &pka_acp_iosb,        /* IOSB */
3365                              0,                    /* AST address */
3366                              0,                    /* AST parameter */
3367                              &pka_fibdsc,          /* P1 = File Info Block */
3368                              &pka_fnam,            /* P2 = File name */
3369                              0,                    /* P3 = Rslt nm len */
3370                              0,                    /* P4 = Rslt nm str */
3371                              pka_recattr,          /* P5 = Attributes */
3372                              0);                   /* P6 (not used) */
3373
3374            /* If initial success, then get the final status from the IOSB. */
3375            if ( !ERR(status) )
3376                status = pka_acp_iosb.status;
3377
3378            if ( ERR(status) )
3379            {
3380                sprintf(warnmsg,
3381                  "warning:  set-dir-attributes failed ($qiow acc) for %s.\n",
3382                  dir_name);
3383                vms_msg(__G__ warnmsg, status);
3384                retcode = PK_WARN;
3385            }
3386            else
3387            {
3388                /* We should have valid RECATTR data.  Overwrite the
3389                 * critical bits of the archive RECATTR structure with
3390                 * the current bits.  The book says that an attempt to
3391                 * modify HIBLK will be ignored, and FFBYTE should
3392                 * always be zero, but safety is cheap.
3393                 */
3394                struct fatdef *ptr_recattr;
3395
3396                ptr_recattr = (struct fatdef *) pka_atr[i].atr$l_addr;
3397                ptr_recattr->fat$l_hiblk =  pka_rattr.fat$l_hiblk;
3398                ptr_recattr->fat$l_efblk =  pka_rattr.fat$l_efblk;
3399                ptr_recattr->fat$w_ffbyte = pka_rattr.fat$w_ffbyte;
3400            }
3401        /* There should be only one RECATTR structure in the list, so
3402         * escape from the loop after the first/only one has been
3403         * processed.
3404         */
3405        break;
3406        }
3407    }
3408
3409    /* Modify the file (directory) attributes. */
3410    status = sys$qiow(0,                            /* event flag */
3411                      pka_devchn,                   /* channel */
3412                      IO$_MODIFY,                   /* function code */
3413                      &pka_acp_iosb,                /* IOSB */
3414                      0,                            /* AST address */
3415                      0,                            /* AST parameter */
3416                      &pka_fibdsc,                  /* P1 = File Info Block */
3417                      &pka_fnam,                    /* P2 = File name */
3418                      0,                            /* P3 = Rslt nm len */
3419                      0,                            /* P4 = Rslt nm str */
3420                      pka_atr,                      /* P5 = Attributes */
3421                      0);                           /* P6 (not used) */
3422
3423    /* If initial success, then get the final status from the IOSB. */
3424    if ( !ERR(status) )
3425        status = pka_acp_iosb.status;
3426
3427    if ( ERR(status) )
3428    {
3429        sprintf(warnmsg,
3430          "warning:  set-dir-attributes failed ($qiow mod) for %s.\n",
3431          dir_name);
3432        vms_msg(__G__ warnmsg, status);
3433        retcode = PK_WARN;
3434    }
3435    sys$dassgn(pka_devchn);
3436cleanup_exit:
3437    free_up();                          /* Free FAB, XAB storage. */
3438    free(d);                            /* Free directory attribute storage. */
3439    G.extra_field = sav_ef_ptr;         /* Restore original pointer. */
3440    return retcode;
3441} /* end function set_direc_attribs() */
3442
3443#endif /* SET_DIR_ATTRIB */
3444
3445
3446
3447#ifdef TIMESTAMP
3448
3449/* Nonzero if `y' is a leap year, else zero. */
3450#define leap(y) (((y) % 4 == 0 && (y) % 100 != 0) || (y) % 400 == 0)
3451
3452/* Number of leap years from 1970 to `y' (not including `y' itself). */
3453#define nleap(y) (((y) - 1969) / 4 - ((y) - 1901) / 100 + ((y) - 1601) / 400)
3454
3455/* Accumulated number of days from 01-Jan up to start of current month. */
3456static ZCONST short ydays[] = {
3457    0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365
3458};
3459
3460/***********************/
3461/* Function mkgmtime() */
3462/***********************/
3463
3464static time_t mkgmtime(tm)
3465    struct tm *tm;
3466{
3467    time_t m_time;
3468    int yr, mo, dy, hh, mm, ss;
3469    unsigned days;
3470
3471    yr = tm->tm_year - 70;
3472    mo = tm->tm_mon;
3473    dy = tm->tm_mday - 1;
3474    hh = tm->tm_hour;
3475    mm = tm->tm_min;
3476    ss = tm->tm_sec;
3477
3478    /* calculate days from BASE to this year and add expired days this year */
3479    dy = (unsigned)dy + ((unsigned)yr * 365) + (unsigned)nleap(yr+1970) +
3480         (unsigned)ydays[mo] + ((mo > 1) && leap(yr+1970));
3481
3482    /* convert date & time to seconds relative to 00:00:00, 01/01/1970 */
3483    return (time_t)((unsigned long)(unsigned)dy * 86400L +
3484                    (unsigned long)hh * 3600L +
3485                    (unsigned long)(mm * 60 + ss));
3486
3487} /* end function mkgmtime() */
3488
3489
3490
3491/*******************************/
3492/* Function dos_to_unix_time() */  /* only used for timestamping of archives */
3493/*******************************/
3494
3495time_t dos_to_unix_time(dosdatetime)
3496    ulg dosdatetime;
3497{
3498    struct tm *ltm;             /* Local time. */
3499    time_t loctime;             /* The time_t value of local time. */
3500    time_t then;                /* The time to return. */
3501    long tzoffset_adj;          /* timezone-adjustment `remainder' */
3502    int bailout_cnt;            /* counter of tries for tz correction */
3503
3504    then = time(NULL);
3505    ltm = localtime(&then);
3506
3507    /* dissect date */
3508    ltm->tm_year = ((int)(dosdatetime >> 25) & 0x7f) + 80;
3509    ltm->tm_mon  = ((int)(dosdatetime >> 21) & 0x0f) - 1;
3510    ltm->tm_mday = ((int)(dosdatetime >> 16) & 0x1f);
3511
3512    /* dissect time */
3513    ltm->tm_hour = (int)(dosdatetime >> 11) & 0x1f;
3514    ltm->tm_min  = (int)(dosdatetime >> 5) & 0x3f;
3515    ltm->tm_sec  = (int)(dosdatetime << 1) & 0x3e;
3516
3517    loctime = mkgmtime(ltm);
3518
3519    /* Correct for the timezone and any daylight savings time.
3520       The correction is verified and repeated when not correct, to
3521       take into account the rare case that a change to or from daylight
3522       savings time occurs between when it is the time in `tm' locally
3523       and when it is that time in Greenwich. After the second correction,
3524       the "timezone & daylight" offset should be correct in all cases. To
3525       be sure, we allow a third try, but then the loop is stopped. */
3526    bailout_cnt = 3;
3527    then = loctime;
3528    do {
3529      ltm = localtime(&then);
3530      tzoffset_adj = (ltm != NULL) ? (loctime - mkgmtime(ltm)) : 0L;
3531      if (tzoffset_adj == 0L)
3532        break;
3533      then += tzoffset_adj;
3534    } while (--bailout_cnt > 0);
3535
3536    if ( (dosdatetime >= DOSTIME_2038_01_18) &&
3537         (then < (time_t)0x70000000L) )
3538        then = U_TIME_T_MAX;    /* saturate in case of (unsigned) overflow */
3539    if (then < (time_t)0L)      /* a converted DOS time cannot be negative */
3540        then = S_TIME_T_MAX;    /*  -> saturate at max signed time_t value */
3541    return then;
3542
3543} /* end function dos_to_unix_time() */
3544
3545
3546
3547/*******************************/
3548/*  Function uxtime2vmstime()  */
3549/*******************************/
3550
3551static void uxtime2vmstime(  /* convert time_t value into 64 bit VMS bintime */
3552    time_t utimeval,
3553    long int binval[2] )
3554{
3555    time_t m_time = utimeval;
3556    struct tm *t = localtime(&m_time);
3557
3558    if (t == (struct tm *)NULL) {
3559        /* time conversion error; use current time instead, hoping
3560           that localtime() does not reject it as well! */
3561        m_time = time(NULL);
3562        t = localtime(&m_time);
3563    }
3564    sprintf(timbuf, "%02d-%3s-%04d %02d:%02d:%02d.00",
3565            t->tm_mday, month[t->tm_mon], t->tm_year + 1900,
3566            t->tm_hour, t->tm_min, t->tm_sec);
3567    sys$bintim(&date_str, binval);
3568} /* end function uxtime2vmstime() */
3569
3570
3571
3572/***************************/
3573/*  Function stamp_file()  */  /* adapted from VMSmunch...it just won't die! */
3574/***************************/
3575
3576int stamp_file(fname, modtime)
3577    ZCONST char *fname;
3578    time_t modtime;
3579{
3580    int status;
3581    int i;
3582    static long int Cdate[2], Rdate[2], Edate[2], Bdate[2];
3583    static short int revisions;
3584#if defined(__DECC) || defined(__DECCXX)
3585#pragma __member_alignment __save
3586#pragma __nomember_alignment
3587#endif /* __DECC || __DECCXX */
3588    static union {
3589      unsigned short int value;
3590      struct {
3591        unsigned system : 4;
3592        unsigned owner : 4;
3593        unsigned group : 4;
3594        unsigned world : 4;
3595      } bits;
3596    } prot;
3597#if defined(__DECC) || defined(__DECCXX)
3598#pragma __member_alignment __restore
3599#endif /* __DECC || __DECCXX */
3600    static unsigned long uic;
3601    static struct fjndef jnl;
3602
3603    static struct atrdef Atr[] = {
3604        {sizeof(pka_rattr), ATR$C_RECATTR, GVTC &pka_rattr},
3605        {sizeof(pka_uchar), ATR$C_UCHAR, GVTC &pka_uchar},
3606        {sizeof(Cdate), ATR$C_CREDATE, GVTC &Cdate[0]},
3607        {sizeof(Rdate), ATR$C_REVDATE, GVTC &Rdate[0]},
3608        {sizeof(Edate), ATR$C_EXPDATE, GVTC &Edate[0]},
3609        {sizeof(Bdate), ATR$C_BAKDATE, GVTC &Bdate[0]},
3610        {sizeof(revisions), ATR$C_ASCDATES, GVTC &revisions},
3611        {sizeof(prot), ATR$C_FPRO, GVTC &prot},
3612        {sizeof(uic), ATR$C_UIC, GVTC &uic},
3613        {sizeof(jnl), ATR$C_JOURNAL, GVTC &jnl},
3614        {0, 0, 0}
3615    };
3616
3617    fileblk = cc$rms_fab;               /* Initialize FAB. */
3618    nam = CC_RMS_NAM;                   /* Initialize NAM[L]. */
3619    fileblk.FAB_NAM = &nam;             /* Point FAB to NAM[L]. */
3620
3621#ifdef NAML$C_MAXRSS
3622
3623    fileblk.fab$l_dna = (char *) -1;    /* Using NAML for default name. */
3624    fileblk.fab$l_fna = (char *) -1;    /* Using NAML for file name. */
3625
3626    /* Special ODS5-QIO-compatible name storage. */
3627    nam.naml$l_filesys_name = sys_nam;
3628    nam.naml$l_filesys_name_alloc = sizeof(sys_nam);
3629
3630#endif /* NAML$C_MAXRSS */
3631
3632    FAB_OR_NAML(fileblk, nam).FAB_OR_NAML_FNA = (char *)fname;
3633    FAB_OR_NAML(fileblk, nam).FAB_OR_NAML_FNS = strlen(fname);
3634
3635    nam.NAM_ESA = exp_nam;
3636    nam.NAM_ESS = sizeof(exp_nam);
3637    nam.NAM_RSA = res_nam;
3638    nam.NAM_RSS = sizeof(res_nam);
3639
3640    if ( ERR(status = sys$parse(&fileblk)) )
3641    {
3642        vms_msg(__G__ "stamp_file: sys$parse failed.\n", status);
3643        return -1;
3644    }
3645
3646    pka_devdsc.dsc$w_length = (unsigned short)nam.NAM_DVI[0];
3647
3648    if ( ERR(status = sys$assign(&pka_devdsc, &pka_devchn, 0, 0)) )
3649    {
3650        vms_msg(__G__ "stamp_file: sys$assign failed.\n", status);
3651        return -1;
3652    }
3653
3654    /* Load the descriptor with the appropriate name data: */
3655#ifdef NAML$C_MAXRSS
3656
3657    /* Enable fancy name characters.  Note that "fancy" here does
3658       not include Unicode, for which there's no support elsewhere.
3659    */
3660    pka_fib.fib$v_names_8bit = 1;
3661    pka_fib.fib$b_name_format_in = FIB$C_ISL1;
3662
3663    /* ODS5 Extended names used as input to QIO have peculiar
3664       encoding (perhaps to minimize storage?), so the special
3665       filesys_name result (typically containing fewer carets) must
3666       be used here.
3667    */
3668    pka_fnam.dsc$a_pointer = nam.naml$l_filesys_name;
3669    pka_fnam.dsc$w_length = nam.naml$l_filesys_name_size;
3670
3671#else /* !NAML$C_MAXRSS */
3672
3673    /* Extract only the name.type;version. */
3674    pka_fnam.dsc$a_pointer = nam.NAM_L_NAME;
3675    pka_fnam.dsc$w_length = nam.NAM_B_NAME + nam.NAM_B_TYPE + nam.NAM_B_VER;
3676
3677#endif /* ?NAML$C_MAXRSS */
3678
3679    /* Move the directory ID from the NAM[L] to the FIB.
3680       Clear the FID in the FIB, as we're using the name.
3681    */
3682    for (i = 0; i < 3; i++)
3683    {
3684        pka_fib.FIB$W_DID[i] = nam.NAM_DID[i];
3685        pka_fib.FIB$W_FID[i] = 0;
3686    }
3687
3688    /* Use the IO$_ACCESS function to return info about the file.
3689       This way, the file is not opened, and the expiration and
3690       revision dates are not modified.
3691    */
3692    status = sys$qiow(0, pka_devchn, IO$_ACCESS,
3693                      &pka_acp_iosb, 0, 0,
3694                      &pka_fibdsc, &pka_fnam, 0, 0, Atr, 0);
3695
3696    if ( !ERR(status) )
3697        status = pka_acp_iosb.status;
3698
3699    if ( ERR(status) )
3700    {
3701        vms_msg(__G__ "[ Access file QIO failed. ]\n", status);
3702        sys$dassgn(pka_devchn);
3703        return -1;
3704    }
3705
3706    uxtime2vmstime(modtime, Cdate);
3707    memcpy(Rdate, Cdate, sizeof(Cdate));
3708
3709    /* Note: Part of the FIB was cleared by earlier QIOW, so reset it. */
3710    pka_fib.FIB$L_ACCTL = FIB$M_NORECORD;
3711
3712    /* Move the directory ID from the NAM[L] to the FIB.
3713       Clear the FID in the FIB, as we're using the name.
3714    */
3715    for (i = 0; i < 3; i++)
3716    {
3717        pka_fib.FIB$W_DID[i] = nam.NAM_DID[i];
3718        pka_fib.FIB$W_FID[i] = 0;
3719    }
3720
3721    /* Use the IO$_MODIFY function to change info about the file */
3722    /* Note, used this way, the file is not opened, however this would */
3723    /* normally cause the expiration and revision dates to be modified. */
3724    /* Using FIB$M_NORECORD prohibits this from happening. */
3725    status = sys$qiow(0, pka_devchn, IO$_MODIFY,
3726                      &pka_acp_iosb, 0, 0,
3727                      &pka_fibdsc, &pka_fnam, 0, 0, Atr, 0);
3728
3729    if ( !ERR(status) )
3730        status = pka_acp_iosb.status;
3731
3732    if ( ERR(status) )
3733    {
3734        vms_msg(__G__ "[ Modify file QIO failed. ]\n", status);
3735        sys$dassgn(pka_devchn);
3736        return -1;
3737    }
3738
3739    if ( ERR(status = sys$dassgn(pka_devchn)) )
3740    {
3741        vms_msg(__G__ "stamp_file: sys$dassgn failed.\n", status);
3742        return -1;
3743    }
3744
3745    return 0;
3746
3747} /* end function stamp_file() */
3748
3749#endif /* TIMESTAMP */
3750
3751
3752
3753#ifdef DEBUG
3754#if 0   /* currently not used anywhere ! */
3755void dump_rms_block(p)
3756    unsigned char *p;
3757{
3758    unsigned char bid, len;
3759    int err;
3760    char *type;
3761    char buf[132];
3762    int i;
3763
3764    err = 0;
3765    bid = p[0];
3766    len = p[1];
3767    switch (bid)
3768    {
3769        case FAB$C_BID:
3770            type = "FAB";
3771            break;
3772        case XAB$C_ALL:
3773            type = "xabALL";
3774            break;
3775        case XAB$C_KEY:
3776            type = "xabKEY";
3777            break;
3778        case XAB$C_DAT:
3779            type = "xabDAT";
3780            break;
3781        case XAB$C_RDT:
3782            type = "xabRDT";
3783            break;
3784        case XAB$C_FHC:
3785            type = "xabFHC";
3786            break;
3787        case XAB$C_PRO:
3788            type = "xabPRO";
3789            break;
3790        default:
3791            type = "Unknown";
3792            err = 1;
3793            break;
3794    }
3795    printf("Block @%08X of type %s (%d).", p, type, bid);
3796    if (err)
3797    {
3798        printf("\n");
3799        return;
3800    }
3801    printf(" Size = %d\n", len);
3802    printf(" Offset - Hex - Dec\n");
3803    for (i = 0; i < len; i += 8)
3804    {
3805        int j;
3806
3807        printf("%3d - ", i);
3808        for (j = 0; j < 8; j++)
3809            if (i + j < len)
3810                printf("%02X ", p[i + j]);
3811            else
3812                printf("   ");
3813        printf(" - ");
3814        for (j = 0; j < 8; j++)
3815            if (i + j < len)
3816                printf("%03d ", p[i + j]);
3817            else
3818                printf("    ");
3819        printf("\n");
3820    }
3821}
3822
3823#endif                          /* never */
3824#endif                          /* DEBUG */
3825
3826
3827
3828static char vms_msgbuf[256];            /* VMS-specific error message. */
3829static $DESCRIPTOR(vms_msgbuf_dscr, vms_msgbuf);
3830
3831
3832char *vms_msg_text(void)
3833{
3834    return vms_msgbuf;
3835}
3836
3837
3838static int vms_msg_fetch(int status)
3839{
3840    int msglen = 0;
3841    int sts;
3842
3843    sts = lib$sys_getmsg(&status, &msglen, &vms_msgbuf_dscr, 0, 0);
3844
3845    vms_msgbuf[msglen] = '\0';
3846    return sts;
3847}
3848
3849
3850static void vms_msg(__GPRO__ ZCONST char *string, int status)
3851{
3852    if (ERR(vms_msg_fetch(status)))
3853        Info(slide, 1, ((char *)slide,
3854             "%s[ VMS status = %d ]\n", string, status));
3855    else
3856        Info(slide, 1, ((char *)slide,
3857             "%s[ %s ]\n", string, vms_msgbuf));
3858}
3859
3860
3861
3862#ifndef SFX
3863
3864/* 2004-11-23 SMS.
3865 * Changed to return the resulting file name even when sys$search()
3866 * fails.  Before, if the user specified "fred.zip;4" and there was
3867 * none, the error message would complain:
3868 *    cannot find either fred.zip;4 or fred.zip;4.zip.
3869 * when it wasn't really looking for "fred.zip;4.zip".
3870 */
3871/* 2005-08-11 SPC.
3872 * The calling interface for the VMS version of do_wild() differs from all
3873 * other implementations in the way it returns status info.
3874 * There are three return states:
3875 * a) pointer to buffer with non-zero-length string
3876 *    - canonical full filespec of existing file (search succeeded).
3877 * b) pointer to buffer with zero-length string
3878 *    - initial file search has failed, extended VMS error info is available
3879 *      through call to vms_msg_text().
3880 * c) NULL pointer
3881 *    - repeated file search has failed, because
3882 *      i)   the list of matches for the pattern has been exhausted after at
3883 *           least one successful attempt.
3884 *      ii)  a second attempt for a failed initial pattern (where do_wild()
3885 *           has returned a zero-length string) was tried and failed again.
3886 */
3887char *do_wild( __G__ wld )
3888    __GDEF
3889    ZCONST char *wld;
3890{
3891    int status;
3892
3893    static char filenam[NAM_MAXRSS + 1];
3894    static char efn[NAM_MAXRSS];
3895    static char last_wild[NAM_MAXRSS + 1];
3896    static struct FAB fab;
3897    static struct NAM_STRUCT nam;
3898    static int first_call = 1;
3899    static ZCONST char deflt[] = "[]*.ZIP";
3900
3901    if ( first_call || strcmp(wld, last_wild) )
3902    {   /* (Re)Initialize everything */
3903
3904        strcpy( last_wild, wld );
3905
3906        fab = cc$rms_fab;               /* Initialize FAB. */
3907        nam = CC_RMS_NAM;               /* Initialize NAM[L]. */
3908        fab.FAB_NAM = &nam;             /* Point FAB to NAM[L]. */
3909
3910#ifdef NAML$C_MAXRSS
3911
3912        fab.fab$l_dna = (char *) -1;    /* Using NAML for default name. */
3913        fab.fab$l_fna = (char *) -1;    /* Using NAML for file name. */
3914
3915#endif /* NAML$C_MAXRSS */
3916
3917        FAB_OR_NAML(fab, nam).FAB_OR_NAML_DNA = (char *) deflt;
3918        FAB_OR_NAML(fab, nam).FAB_OR_NAML_DNS = sizeof(deflt) - 1;
3919
3920        FAB_OR_NAML(fab, nam).FAB_OR_NAML_FNA = last_wild;
3921        FAB_OR_NAML(fab, nam).FAB_OR_NAML_FNS = strlen(last_wild);
3922
3923        nam.NAM_ESA = efn;
3924        nam.NAM_ESS = sizeof(efn)-1;
3925        nam.NAM_RSA = filenam;
3926        nam.NAM_RSS = sizeof(filenam)-1;
3927
3928        first_call = 0;
3929
3930        /* 2005-08-08 SMS.
3931         * Parse the file spec.  If sys$parse() fails, save the VMS
3932         * error message for later use, and return an empty string.
3933         */
3934        nam.NAM_NOP = NAM_M_SYNCHK;     /* Syntax-only analysis. */
3935        if ( !OK(status = sys$parse(&fab)) )
3936        {
3937            vms_msg_fetch(status);
3938            filenam[0] = '\0';          /* Initialization failed */
3939            return filenam;
3940        }
3941
3942        /* 2005-11-16 SMS.
3943         * If syntax-only parse worked, re-parse normally so that
3944         * sys$search() will work properly.  Regardless of parse error,
3945         * leave filenam[] as-was.
3946         */
3947        nam.NAM_NOP = 0;                /* Normal analysis. */
3948        if ( OK(status = sys$parse(&fab)) )
3949        {
3950            status = sys$search(&fab);
3951        }
3952
3953        if ( !OK(status) )
3954        {
3955            /* Save the VMS error message for later use. */
3956            vms_msg_fetch(status);
3957        }
3958    }
3959    else
3960    {
3961        if ( !OK(sys$search(&fab)) )
3962        {
3963            first_call = 1;             /* Reinitialize next time */
3964            return (char *)NULL;
3965        }
3966    }
3967    filenam[nam.NAM_RSL] = '\0';        /* Add the NUL terminator. */
3968    return filenam;
3969
3970} /* end function do_wild() */
3971
3972#endif /* !SFX */
3973
3974
3975
3976static ulg unix_to_vms[8]={ /* Map from UNIX rwx to VMS rwed */
3977                            /* Note that unix w bit is mapped to VMS wd bits */
3978                                                              /* no access */
3979    XAB$M_NOREAD | XAB$M_NOWRITE | XAB$M_NODEL | XAB$M_NOEXE,    /* --- */
3980    XAB$M_NOREAD | XAB$M_NOWRITE | XAB$M_NODEL,                  /* --x */
3981    XAB$M_NOREAD |                               XAB$M_NOEXE,    /* -w- */
3982    XAB$M_NOREAD,                                                /* -wx */
3983                   XAB$M_NOWRITE | XAB$M_NODEL | XAB$M_NOEXE,    /* r-- */
3984                   XAB$M_NOWRITE | XAB$M_NODEL,                  /* r-x */
3985                                                 XAB$M_NOEXE,    /* rw- */
3986    0                                                            /* rwx */
3987                                                              /* full access */
3988};
3989
3990#define SETDFPROT   /* We are using undocumented VMS System Service     */
3991                    /* SYS$SETDFPROT here. If your version of VMS does  */
3992                    /* not have that service, undef SETDFPROT.          */
3993                    /* IM: Maybe it's better to put this to Makefile    */
3994                    /* and DESCRIP.MMS */
3995#ifdef SETDFPROT
3996extern int sys$setdfprot();
3997#endif
3998
3999int mapattr(__G)
4000    __GDEF
4001{
4002    ulg tmp = G.crec.external_file_attributes;
4003    ulg theprot;
4004    static ulg  defprot = (ulg)-1L,
4005                sysdef, owndef, grpdef, wlddef; /* Default protection fields */
4006
4007    /* IM: The only field of XABPRO we need to set here is */
4008    /*     file protection, so we need not to change type */
4009    /*     of G.pInfo->file_attr. WORD is quite enough. */
4010
4011    if ( defprot == (ulg)-1L )
4012    {
4013        /*
4014         * First time here -- Get user default settings
4015         */
4016
4017#ifdef SETDFPROT    /* Undef this if linker cat't resolve SYS$SETDFPROT */
4018        defprot = (ulg)0L;
4019        if ( !ERR(sys$setdfprot(0, &defprot)) )
4020        {
4021            sysdef = defprot & ( (1L<<XAB$S_SYS)-1 ) << XAB$V_SYS;
4022            owndef = defprot & ( (1L<<XAB$S_OWN)-1 ) << XAB$V_OWN;
4023            grpdef = defprot & ( (1L<<XAB$S_GRP)-1 ) << XAB$V_GRP;
4024            wlddef = defprot & ( (1L<<XAB$S_WLD)-1 ) << XAB$V_WLD;
4025        }
4026        else
4027#endif /* SETDFPROT */
4028        {
4029            umask(defprot = umask(0));
4030            defprot = ~defprot;
4031            wlddef = unix_to_vms[defprot & 07] << XAB$V_WLD;
4032            grpdef = unix_to_vms[(defprot>>3) & 07] << XAB$V_GRP;
4033            owndef = unix_to_vms[(defprot>>6) & 07] << XAB$V_OWN;
4034            sysdef = owndef >> (XAB$V_OWN - XAB$V_SYS);
4035            defprot = sysdef | owndef | grpdef | wlddef;
4036        }
4037    }
4038
4039    switch (G.pInfo->hostnum) {
4040        case AMIGA_:
4041            tmp = (unsigned)(tmp>>16 & 0x0f);   /* Amiga RWED bits */
4042            G.pInfo->file_attr =  (tmp << XAB$V_OWN) |
4043                                   grpdef | sysdef | wlddef;
4044            break;
4045
4046        case THEOS_:
4047            tmp &= 0xF1FFFFFFL;
4048            if ((tmp & 0xF0000000L) != 0x40000000L)
4049                tmp &= 0x01FFFFFFL;     /* not a dir, mask all ftype bits */
4050            else
4051                tmp &= 0x41FFFFFFL;     /* leave directory bit as set */
4052            /* fall through! */
4053
4054        case UNIX_:
4055        case VMS_:  /*IM: ??? Does VMS Zip store protection in UNIX format ?*/
4056                    /* GRR:  Yup.  Bad decision on my part... */
4057        case ACORN_:
4058        case ATARI_:
4059        case ATHEOS_:
4060        case BEOS_:
4061        case QDOS_:
4062        case TANDEM_:
4063            {
4064              int r = FALSE;
4065              unsigned uxattr = (unsigned)(tmp >> 16);  /* drwxrwxrwx */
4066
4067              if (uxattr == 0 && G.extra_field) {
4068                /* Some (non-Info-ZIP) implementations of Zip for Unix and
4069                 * VMS (and probably others ??) leave 0 in the upper 16-bit
4070                 * part of the external_file_attributes field. Instead, they
4071                 * store file permission attributes in some e.f. block.
4072                 * As a work-around, we search for the presence of one of
4073                 * these extra fields and fall back to the MSDOS compatible
4074                 * part of external_file_attributes if one of the known
4075                 * e.f. types has been detected.
4076                 * Later, we might implement extraction of the permission
4077                 * bits from the VMS extra field. But for now, the work-around
4078                 * should be sufficient to provide "readable" extracted files.
4079                 * (For ASI Unix e.f., an experimental remap of the e.f.
4080                 * mode value IS already provided!)
4081                 */
4082                ush ebID;
4083                unsigned ebLen;
4084                uch *ef = G.extra_field;
4085                unsigned ef_len = G.crec.extra_field_length;
4086
4087                while (!r && ef_len >= EB_HEADSIZE) {
4088                    ebID = makeword(ef);
4089                    ebLen = (unsigned)makeword(ef+EB_LEN);
4090                    if (ebLen > (ef_len - EB_HEADSIZE))
4091                        /* discoverd some e.f. inconsistency! */
4092                        break;
4093                    switch (ebID) {
4094                      case EF_ASIUNIX:
4095                        if (ebLen >= (EB_ASI_MODE+2)) {
4096                            uxattr =
4097                              (unsigned)makeword(ef+(EB_HEADSIZE+EB_ASI_MODE));
4098                            /* force stop of loop: */
4099                            ef_len = (ebLen + EB_HEADSIZE);
4100                            break;
4101                        }
4102                        /* else: fall through! */
4103                      case EF_PKVMS:
4104                        /* "found nondecypherable e.f. with perm. attr" */
4105                        r = TRUE;
4106                      default:
4107                        break;
4108                    }
4109                    ef_len -= (ebLen + EB_HEADSIZE);
4110                    ef += (ebLen + EB_HEADSIZE);
4111                }
4112              }
4113              if (!r) {
4114#ifdef SYMLINKS
4115                  /* Check if the file is a (POSIX-compatible) symbolic link.
4116                   * We restrict symlink support to those "made-by" hosts that
4117                   * are known to support symbolic links.
4118                   */
4119                  G.pInfo->symlink = S_ISLNK(uxattr) &&
4120                                     SYMLINK_HOST(G.pInfo->hostnum);
4121#endif
4122                  theprot  = (unix_to_vms[uxattr & 07] << XAB$V_WLD)
4123                           | (unix_to_vms[(uxattr>>3) & 07] << XAB$V_GRP)
4124                           | (unix_to_vms[(uxattr>>6) & 07] << XAB$V_OWN);
4125                  if ( uxattr & 0x4000 )
4126                      /* Directory -- set D bits */
4127                      theprot |= (XAB$M_NODEL << XAB$V_SYS)
4128                              | (XAB$M_NODEL << XAB$V_OWN)
4129                              | (XAB$M_NODEL << XAB$V_GRP)
4130                              | (XAB$M_NODEL << XAB$V_WLD);
4131                  G.pInfo->file_attr = theprot;
4132                  break;
4133              }
4134            }
4135            /* fall through! */
4136
4137        /* all remaining cases:  expand MSDOS read-only bit into write perms */
4138        case FS_FAT_:
4139        case FS_HPFS_:
4140        case FS_NTFS_:
4141        case MAC_:
4142        case TOPS20_:
4143        default:
4144            theprot = defprot;
4145            if ( tmp & 1 )   /* Test read-only bit */
4146            {   /* Bit is set -- set bits in all fields */
4147                tmp = XAB$M_NOWRITE | XAB$M_NODEL;
4148                theprot |= (tmp << XAB$V_SYS) | (tmp << XAB$V_OWN) |
4149                           (tmp << XAB$V_GRP) | (tmp << XAB$V_WLD);
4150            }
4151            G.pInfo->file_attr = theprot;
4152            break;
4153    } /* end switch (host-OS-created-by) */
4154
4155    return 0;
4156
4157} /* end function mapattr() */
4158
4159
4160#define PATH_DEFAULT "SYS$DISK:[]"
4161
4162/* dest_struct_level()
4163
4164      Returns file system structure level for argument, negative on
4165      error.
4166*/
4167
4168int dest_struct_level(char *path)
4169{
4170    int acp_code;
4171
4172#ifdef DVI$C_ACP_F11V5
4173
4174    /* Should know about ODS5 file system.  Do actual check.
4175       (This should be non-VAX with __CRTL_VER >= 70200000.)
4176    */
4177
4178    int sts;
4179
4180    struct FAB fab;
4181    struct NAM_STRUCT nam;
4182    char e_name[NAM_MAXRSS + 1];
4183
4184    struct dsc$descriptor_s dev_descr =
4185     { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0 };
4186
4187    fab = cc$rms_fab;                   /* Initialize FAB. */
4188    nam = CC_RMS_NAM;                   /* Initialize NAM[L]. */
4189    fab.FAB_NAM = &nam;                 /* Point FAB to NAM[L]. */
4190
4191#ifdef NAML$C_MAXRSS
4192
4193    fab.fab$l_dna = (char *) -1;        /* Using NAML for default name. */
4194    fab.fab$l_fna = (char *) -1;        /* Using NAML for file name. */
4195
4196#endif /* NAML$C_MAXRSS */
4197
4198    FAB_OR_NAML(fab, nam).FAB_OR_NAML_DNA = PATH_DEFAULT;
4199    FAB_OR_NAML(fab, nam).FAB_OR_NAML_DNS = strlen(PATH_DEFAULT);
4200
4201    FAB_OR_NAML(fab, nam).FAB_OR_NAML_FNA = path;
4202    FAB_OR_NAML(fab, nam).FAB_OR_NAML_FNS = strlen(path);
4203
4204    nam.NAM_ESA = e_name;
4205    nam.NAM_ESS = sizeof(e_name) - 1;
4206
4207    nam.NAM_NOP = NAM_M_SYNCHK;         /* Syntax-only analysis. */
4208    sts = sys$parse(&fab);
4209
4210    if ((sts & STS$M_SUCCESS) == STS$K_SUCCESS)
4211    {
4212        /* Load resultant device name into device descriptor. */
4213        dev_descr.dsc$a_pointer = nam.NAM_L_DEV;
4214        dev_descr.dsc$w_length = nam.NAM_B_DEV;
4215
4216        /* Get filesystem type code.
4217           (Text results for this item code have been unreliable.)
4218        */
4219        sts = lib$getdvi(&((int) DVI$_ACPTYPE),
4220                         0,
4221                         &dev_descr,
4222                         &acp_code,
4223                         0,
4224                         0);
4225
4226        if ((sts & STS$M_SUCCESS) != STS$K_SUCCESS)
4227        {
4228            acp_code = -2;
4229        }
4230    }
4231    else
4232    {
4233        acp_code = -1;
4234    }
4235
4236#else /* !DVI$C_ACP_F11V5 */
4237
4238/* Too old for ODS5 file system.  Return level 2. */
4239
4240    acp_code = DVI$C_ACP_F11V2;
4241
4242#endif /* ?DVI$C_ACP_F11V5 */
4243
4244    return acp_code;
4245}
4246
4247/* 2005-02-12 SMS.
4248   Note that these name conversion functions do no length checking.
4249   Buffer overflows are possible.
4250*/
4251
4252static void adj_dir_name_ods2(char *dest, char *src, int src_len)
4253{
4254    /* The source string (src) typically extends beyond the directory
4255       segment of interest, hence the confining src_len argument.
4256    */
4257    unsigned char uchr;
4258    unsigned char prop;
4259    char * src_last;
4260
4261    for (src_last = src + src_len; src < src_last; src++)
4262    {
4263        prop = char_prop[uchr = *src];  /* Get source char, properties. */
4264        if ((prop & 2) != 0)            /* Up-case lower case. */
4265        {
4266            uchr -= ('a' - 'A');        /* (Simple-fast is adequate.) */
4267        }
4268        else if ((prop & 1) == 0)       /* Replace invalid char */
4269        {
4270            uchr = '_';                 /* with "_". */
4271        }
4272        *dest++ = uchr;                 /* Store good char. */
4273    }
4274    *dest = '\0';                       /* Terminate destination. */
4275}
4276
4277
4278static void adj_dir_name_ods5(char *dest, char *src, int src_len)
4279{
4280    /* The source string (src) typically extends beyond the directory
4281       segment of interest, hence the confining src_len argument.
4282    */
4283    unsigned char uchr;
4284    unsigned char prop;
4285    char * src_last;
4286
4287    for (src_last = src + src_len; src < src_last; src++)
4288    {
4289        prop = char_prop[uchr = *src];          /* Get source char, props. */
4290        prop = char_prop[uchr];                 /* Get source char props. */
4291        if ((prop & (32+8+4)) != 0)             /* Escape 1-char, including */
4292        {                                       /* SP and dot. */
4293            *dest++ = '^';                      /* Insert caret. */
4294            if ((prop & 8) != 0)                /* Replace SP with "_". */
4295            {
4296                uchr = '_';
4297            }
4298            else if (uchr == '?')
4299            {
4300                uchr = '/';                     /* Replace "?" with "/". */
4301            }
4302        }
4303        else if ((prop & 64) != 0)              /* Escape hex-hex. */
4304        {
4305            *dest++ = '^';                      /* Insert caret. */
4306            *dest++ = hex_digit[uchr >> 4];     /* First hex digit. */
4307            uchr = hex_digit[uchr & 15];        /* Second hex digit. */
4308        }
4309        else if ((prop & 16) == 0)              /* Replace invalid with "_". */
4310        {
4311            uchr = '_';
4312        }
4313        *dest++ = uchr;                         /* Put good (or last) char. */
4314    }
4315    *dest = '\0';                               /* Terminate destination. */
4316}
4317
4318
4319static void adj_file_name_ods2(char *dest, char *src)
4320{
4321    unsigned char uchr;
4322    unsigned char prop;
4323    char *endp;
4324    char *versionp;
4325    char *last_dot;
4326
4327    endp = src + strlen(src);   /* Pointer to the NUL-terminator of src. */
4328    /* Starting at the end, find the last non-decimal-digit. */
4329    versionp = endp;
4330    while ((--versionp >= src) && isdigit(*versionp));
4331
4332    /* Left-most non-digit of a valid version is ";" (or perhaps "."). */
4333    if ((*versionp != ';') && ((uO.Y_flag == 0) || (*versionp != '.')))
4334    {
4335        /* No valid version.  The last dot is the last dot. */
4336        versionp = endp;
4337    }
4338    else
4339    {   /* Some kind of valid version. */
4340        if (!uO.V_flag)                 /* Not -V, so cut off version. */
4341        {
4342            *versionp = '\0';
4343        }
4344        else if (*versionp == '.')
4345        {
4346            *versionp = ';';            /* Replace version dot with ";". */
4347        }
4348    }
4349
4350    /* 2008-11-04 SMS.
4351     * Simplified the scheme here to escape all non-last dots.  This
4352     * should work when Zip works correctly (Zip 3.1).
4353     * Note that if no last dot is found, the non-last-dot test below
4354     * will always fail, but that's not a problem.
4355     */
4356
4357    /* Find the last dot (if any). */
4358    last_dot = versionp;
4359    while ((--last_dot >= src) && (*last_dot != '.'));
4360
4361    /* Critical features having been located, transform the name. */
4362    while ((uchr = *src++) != '\0')     /* Get source character. */
4363    {
4364        /* Note that "src" has been incremented, affecting "src <=". */
4365        prop = char_prop[uchr];         /* Get source char properties. */
4366        if ((prop & 2) != 0)            /* Up-case lower case. */
4367        {
4368            uchr -= ('a' - 'A');        /* (Simple-fast is adequate.) */
4369        }
4370        else if ((prop & 4) != 0)       /* Dot. */
4371        {
4372            if (src <= last_dot)        /* Replace non-last dot */
4373            {
4374                uchr = '_';             /* with "_". */
4375            }
4376        }
4377        else if ((prop & 1) == 0)       /* Replace SP or invalid char, */
4378        {
4379            if (src <= versionp)        /* if not in version, */
4380            {
4381                uchr = '_';             /* with "_". */
4382            }
4383        }
4384        *dest++ = uchr;                 /* Store good char. */
4385    }
4386    *dest = '\0';                       /* Terminate destination. */
4387}
4388
4389
4390static void adj_file_name_ods5(char *dest, char *src)
4391{
4392    unsigned char uchr;
4393    unsigned char prop;
4394    char *endp;
4395    char *versionp;
4396    char *last_dot;
4397
4398    endp = src + strlen(src);   /* Pointer to the NUL-terminator of src. */
4399    /* Starting at the end, find the last non-decimal-digit. */
4400    versionp = endp;
4401    while ((--versionp >= src) && isdigit(*versionp));
4402
4403    /* Left-most non-digit of a valid version is ";" (or perhaps "."). */
4404    if ((*versionp != ';') && ((uO.Y_flag == 0) || (*versionp != '.')))
4405    {
4406        /* No valid version.  The last dot is the last dot. */
4407        versionp = endp;
4408    }
4409    else
4410    {   /* Some kind of valid version. */
4411        if (!uO.V_flag)                 /* Not -V, so cut off version. */
4412        {
4413            *versionp = '\0';
4414        }
4415        else if (*versionp == '.')
4416        {
4417            *versionp = ';';            /* Replace version dot with ";". */
4418        }
4419    }
4420
4421    /* 2008-11-04 SMS.
4422     * Simplified the scheme here to escape all non-last dots.  This
4423     * should work when Zip works correctly (Zip 3.1).
4424     * Note that if no last dot is found, the non-last-dot test below
4425     * will always fail, but that's not a problem.
4426     */
4427
4428    /* Find the last dot (if any). */
4429    last_dot = versionp;
4430    while ((--last_dot >= src) && (*last_dot != '.'));
4431
4432    /* Critical features having been located, transform the name. */
4433    while ((uchr = *src++) != '\0')             /* Get source character. */
4434    {
4435        /* Note that "src" has been incremented, affecting "src <=". */
4436        prop = char_prop[uchr];                 /* Get source char props. */
4437        if ((prop & (32+8)) != 0)               /* Escape 1-char, including */
4438        {                                       /* SP (but not dot). */
4439            if (src <= versionp)                /* No escapes for version. */
4440            {
4441                *dest++ = '^';                  /* Insert caret. */
4442                if ((prop & 8) != 0)            /* Replace SP with "_". */
4443                {
4444                    uchr = '_';
4445                }
4446                else if (uchr == '?')
4447                {
4448                    uchr = '/';                 /* Replace "?" with "/". */
4449                }
4450            }
4451        }
4452        else if ((prop & 4) != 0)               /* Dot. */
4453        {
4454            if (src <= last_dot)                /* Escape non-last dot */
4455            {
4456                *dest++ = '^';                  /* Insert caret. */
4457            }
4458        }
4459        else if ((prop & 64) != 0)              /* Escape hex-hex. */
4460        {
4461            *dest++ = '^';                      /* Insert caret. */
4462            *dest++ = hex_digit[uchr >> 4];     /* First hex digit. */
4463            uchr = hex_digit[uchr & 15];        /* Second hex digit. */
4464        }
4465        else if ((prop & 16) == 0)              /* Replace invalid with "_". */
4466        {
4467            uchr = '_';
4468        }
4469        *dest++ = uchr;                         /* Put good (or last) char. */
4470    }
4471    *dest = '\0';                               /* Terminate destination. */
4472}
4473
4474
4475
4476#   define FN_MASK   7
4477#   define USE_DEFAULT  (FN_MASK+1)
4478
4479/*
4480 * Checkdir function codes:
4481 *      ROOT        -   set root path from unzip qq d:[dir]
4482 *      INIT        -   get ready for "filename"
4483 *      APPEND_DIR  -   append pathcomp
4484 *      APPEND_NAME -   append filename
4485 *      APPEND_NAME | USE_DEFAULT   -    expand filename using collected path
4486 *      GETPATH     -   return resulting filespec
4487 *      END         -   free dynamically allocated space prior to program exit
4488 */
4489
4490static int created_dir;
4491static int dest_file_sys_level;
4492static int ods2_names = -1;
4493
4494int mapname(__G__ renamed)
4495        /* returns: */
4496        /* MPN_OK if no error, */
4497        /* MPN_INF_TRUNC if caution (filename trunc), */
4498        /* MPN_INF_SKIP if warning (skip file, dir doesn't exist), */
4499        /* MPN_ERR_SKIP if error (skip file), */
4500        /* MPN_CREATED_DIR if has created directory, */
4501        /* MPN_VOL_LABEL if path was volume label (skip it) */
4502        /* MPN_NOMEM if no memory (skip file) */
4503    __GDEF
4504    int renamed;
4505{
4506    char pathcomp[FILNAMSIZ];       /* Path-component buffer. */
4507    char *last_slash;               /* Last slash in path. */
4508    char *next_slash;               /* Next slash in path. */
4509    int  dir_len;                   /* Length of a directory segment. */
4510
4511    char *cp = (char *)NULL;        /* character pointer */
4512    int killed_ddot = FALSE;        /* Set when skipping "../" pathcomp. */
4513    int error = MPN_OK;
4514
4515    if ( renamed )
4516    {
4517        if ( !(error = checkdir(__G__ pathcomp, APPEND_NAME | USE_DEFAULT)) )
4518            strcpy(G.filename, pathcomp);
4519        return error;
4520    }
4521
4522/*---------------------------------------------------------------------------
4523    Initialize various pointers and counters and stuff.
4524  ---------------------------------------------------------------------------*/
4525
4526    if (G.pInfo->vollabel)
4527        return MPN_VOL_LABEL;   /* can't set disk volume labels on VMS */
4528
4529    /* can create path as long as not just freshening, or if user told us */
4530    G.create_dirs = !uO.fflag;
4531
4532    created_dir = FALSE;        /* not yet */
4533
4534    /* If not yet known, determine the destination file system type
4535       (ODS2 or ODS5).  (If the user specified a destination, we should
4536       already have this, so use the default destination.)
4537    */
4538    if (ods2_names < 0)
4539    {
4540        /* If user doesn't force ODS2, set flag according to destination. */
4541        if (uO.ods2_flag == 0)
4542        {
4543            ods2_names =
4544             (dest_struct_level(PATH_DEFAULT) <= DVI$C_ACP_F11V2);
4545        }
4546        else
4547        {
4548            ods2_names = 1;     /* User demands ODS2 names. */
4549        }
4550    }
4551
4552/* GRR:  for VMS, convert to internal format now or later? or never? */
4553    if (checkdir(__G__ pathcomp, INIT) == 10)
4554        return MPN_NOMEM;       /* Initialize path buffer, unless no memory. */
4555
4556    /* Locate and treat directory segments one at a time.
4557       When pointer exceeds last_slash, then directory segments are
4558       done, and only the name (with version?) remains.
4559    */
4560
4561    *pathcomp = '\0';           /* Initialize translation buffer. */
4562    last_slash = strrchr(G.filename, '/');      /* Find last slash. */
4563
4564    if (uO.jflag)               /* If junking directories, */
4565        cp = last_slash;        /* start at (will be after) the last slash. */
4566
4567    if (cp == NULL)             /* If no '/', or keeping directories, */
4568        cp = G.filename;        /* start at the front of the pathname. */
4569    else                        /* Else, with directories to junk, */
4570        ++cp;                   /* start after the last slash. */
4571
4572    /* Loop through the directory segments. */
4573    while (cp < last_slash)
4574    {
4575        next_slash = strchr(cp, '/');  /* Find the next slash. */
4576        dir_len = next_slash- cp;
4577
4578        /* Filter out unacceptable directories. */
4579        if ((dir_len == 2) && (strncmp(cp, "..", 2) == 0))
4580        {   /* Double dot. */
4581            if (!uO.ddotflag)           /* Not allowed.  Skip it. */
4582            {
4583                dir_len = 0;
4584                killed_ddot = TRUE;     /* Record skipping double-dot. */
4585            }
4586        }
4587        else if ((dir_len == 1) && (strncmp(cp, ".", 1) == 0))
4588        {   /* Single dot.  No-op.  Skip it. */
4589            dir_len = 0;
4590        }
4591
4592        /* If non-null, acceptable directory, then process it. */
4593        if (dir_len > 0)
4594        {
4595            if (ods2_names)     /* Make directory name ODS2-compliant. */
4596            {
4597                adj_dir_name_ods2(pathcomp, cp, dir_len);
4598            }
4599            else                /* Make directory name ODS5-compliant. */
4600            {
4601                adj_dir_name_ods5(pathcomp, cp, dir_len);
4602            }
4603            if (((error = checkdir(__G__ pathcomp, APPEND_DIR))
4604                 & MPN_MASK) > MPN_INF_TRUNC)
4605                return error;
4606        }
4607        cp = next_slash+ 1;     /* Continue at the next name segment. */
4608    } /* end while loop */
4609
4610    /* Show warning when stripping insecure "parent dir" path components */
4611    if (killed_ddot && QCOND2) {
4612        Info(slide, 0, ((char *)slide,
4613          "warning:  skipped \"../\" path component(s) in %s\n",
4614          FnFilter1(G.filename)));
4615        if (!(error & ~MPN_MASK))
4616            error = (error & MPN_MASK) | PK_WARN;
4617    }
4618
4619    /* If there is one, adjust the name.type;version segment. */
4620    if (strlen(cp) == 0)
4621    {
4622        /* Directory only, no file name.  Create the directory, as needed.
4623           Report directory creation to user.
4624        */
4625        checkdir(__G__ "", APPEND_NAME);   /* create directory, if not found */
4626        checkdir(__G__ G.filename, GETPATH);
4627        if (created_dir) {
4628            if (QCOND2) {
4629                Info(slide, 0, ((char *)slide, "   creating: %s\n",
4630                  FnFilter1(G.filename)));
4631            }
4632            /* set dir time (note trailing '/') */
4633            return (error & ~MPN_MASK) | MPN_CREATED_DIR;
4634        }
4635        /* dir existed already; don't look for data to extract */
4636        return (error & ~MPN_MASK) | MPN_INF_SKIP;
4637    }
4638
4639    /* Process the file name. */
4640    if (ods2_names)     /* Make file name ODS2-compliant. */
4641    {
4642        adj_file_name_ods2(pathcomp, cp);
4643    }
4644    else                /* Make file name ODS5-compliant. */
4645    {
4646        adj_file_name_ods5(pathcomp, cp);
4647    }
4648
4649    checkdir(__G__ pathcomp, APPEND_NAME);  /* returns 1 if truncated: care? */
4650    checkdir(__G__ G.filename, GETPATH);
4651
4652    return error;
4653
4654} /* end function mapname() */
4655
4656
4657
4658int checkdir(__G__ pathcomp, fcn)
4659/*
4660 * returns:
4661 *  MPN_OK          - no problem detected
4662 *  MPN_INF_TRUNC   - (on APPEND_NAME) truncated filename
4663 *  MPN_INF_SKIP    - path doesn't exist, not allowed to create
4664 *  MPN_ERR_SKIP    - path doesn't exist, tried to create and failed; or path
4665 *                    exists and is not a directory, but is supposed to be
4666 *  MPN_ERR_TOOLONG - path is too long
4667 *  MPN_NOMEM       - can't allocate memory for filename buffers
4668 */
4669    __GDEF
4670    char *pathcomp;
4671    int fcn;
4672{
4673    int function=fcn & FN_MASK;
4674    static char pathbuf[FILNAMSIZ];
4675
4676    /* previously created directory (initialized to impossible dir. spec.) */
4677    static char lastdir[FILNAMSIZ] = "\t";
4678
4679    static char *pathptr = pathbuf;     /* For debugger */
4680    static char *devptr, *dirptr;
4681    static int  devlen, dirlen;
4682    static int  root_dirlen;
4683    static char *end;
4684    static int  first_comp, root_has_dir;
4685    static int  rootlen=0;
4686    static char *rootend;
4687    static int  mkdir_failed=0;
4688    int status;
4689    struct FAB fab;
4690    struct NAM_STRUCT nam;
4691
4692
4693/************
4694 *** ROOT ***
4695 ************/
4696
4697#if (!defined(SFX) || defined(SFX_EXDIR))
4698    if (function == ROOT)
4699    {   /*  Assume VMS root spec */
4700        /* 2006-01-20 SMS.
4701           Changed to use sys$parse() instead of sys$filescan() for analysis
4702           of the user-specified destination directory.  Previously, various
4703           values behaved badly, without complaint, e.g. "-d sys$scratch".
4704        */
4705        char *root_dest;
4706
4707        /* If the root path has already been set, return immediately. */
4708        if (rootlen > 0)
4709            return MPN_OK;
4710
4711        /* Initialization. */
4712        root_dest = PATH_DEFAULT;   /* Default destination for ODSx sensing. */
4713        root_has_dir = 0;           /* Root includes a directory. */
4714        fab = cc$rms_fab;           /* Initialize FAB. */
4715        nam = CC_RMS_NAM;           /* Initialize NAM[L]. */
4716        fab.FAB_NAM = &nam;         /* Point FAB to NAM[L]. */
4717
4718#ifdef NAML$C_MAXRSS
4719
4720        fab.fab$l_dna = (char *) -1;    /* Using NAML for default name. */
4721        fab.fab$l_fna = (char *) -1;    /* Using NAML for file name. */
4722
4723#endif /* NAML$C_MAXRSS */
4724
4725        /* Specified file spec. */
4726        FAB_OR_NAML(fab, nam).FAB_OR_NAML_FNA = pathcomp;
4727        FAB_OR_NAML(fab, nam).FAB_OR_NAML_FNS = strlen(pathcomp);
4728
4729        /* Default file spec. */
4730        FAB_OR_NAML(fab, nam).FAB_OR_NAML_DNA = PATH_DEFAULT;
4731        FAB_OR_NAML(fab, nam).FAB_OR_NAML_DNS = strlen(PATH_DEFAULT);
4732
4733        /* Expanded file spec. */
4734        nam.NAM_ESA = pathbuf;
4735        nam.NAM_ESS = NAM_MAXRSS;
4736
4737        status = sys$parse(&fab);
4738
4739        /* OK so far, if OK or if directory not found. */
4740        if (((status & STS$M_SEVERITY) != STS$K_SUCCESS) &&
4741            (status != RMS$_DNF))
4742        {
4743            /* Invalid destination directory specified. */
4744            Info(slide, 1, ((char *)slide,
4745              "Invalid destination directory (parse error): %s\n",
4746              FnFilter1(pathcomp)));
4747            return MPN_ERR_SKIP;
4748        }
4749
4750        /* Should be only a device:[directory], so name+type+version
4751           should have length 2 (".;").
4752        */
4753        if (nam.NAM_B_NAME + nam.NAM_B_TYPE + nam.NAM_B_VER > 2)
4754        {
4755            Info(slide, 1, ((char *)slide,
4756              "Invalid destination directory (includes file name): %s\n",
4757              FnFilter1(nam.NAM_ESA)));
4758            return MPN_ERR_SKIP;
4759        }
4760
4761        /* Truncate at name, leaving only "dev:[dir]". */
4762        *nam.NAM_L_NAME = '\0';
4763        rootlen = nam.NAM_L_NAME - nam.NAM_ESA;
4764
4765        /* Remove any trailing dots in directory. */
4766        if ((nam.NAM_ESA[rootlen-1] == ']') &&
4767            (nam.NAM_ESA[rootlen-2] != '^'))
4768        {
4769            root_has_dir = 1;
4770            rootlen -= 2;
4771            while ((nam.NAM_ESA[rootlen] == '.') &&
4772                   (nam.NAM_ESA[rootlen-1] != '^'))
4773            {
4774                rootlen--;
4775            }
4776            nam.NAM_ESA[++rootlen] = ']';
4777            nam.NAM_ESA[++rootlen] = '\0';
4778        }
4779
4780        devlen = nam.NAM_L_DIR - nam.NAM_ESA;
4781
4782        /* If directory not found, then create it. */
4783        if (status == RMS$_DNF)
4784        {
4785            if (status = mkdir(nam.NAM_ESA, 0))
4786            {
4787                Info(slide, 1, ((char *)slide,
4788                  "Can not create destination directory: %s\n",
4789                  FnFilter1(nam.NAM_ESA)));
4790
4791                /* path didn't exist, tried to create, and failed. */
4792                return MPN_ERR_SKIP;
4793            }
4794        }
4795
4796        /* Save the (valid) device:[directory] spec. */
4797        strcpy(pathbuf, nam.NAM_ESA);
4798        root_dest = pathbuf;
4799
4800        /* At this point, the true destination is known.  If the user
4801           supplied an invalid destination directory, the default
4802           directory will be used.  (This may be pointless, but should
4803           be safe.)
4804        */
4805
4806        /* If not yet known, determine the destination (root_dest) file
4807           system type (ODS2 or ODS5).
4808        */
4809        if (ods2_names < 0)
4810        {
4811            /* If user doesn't force ODS2, set flag according to dest. */
4812            if (uO.ods2_flag == 0)
4813            {
4814                ods2_names = (dest_struct_level(root_dest) <= DVI$C_ACP_F11V2);
4815            }
4816            else
4817            {
4818                ods2_names = 1;     /* User demands ODS2 names. */
4819            }
4820        }
4821
4822        /* Replace trailing "]" with ".", for later appending. */
4823        if ((pathbuf[rootlen-1] == ']') || (pathbuf[rootlen-1] == '>'))
4824        {
4825            pathbuf[rootlen-1] = '.';
4826        }
4827
4828        /* Set various pointers and lengths. */
4829        devptr = pathbuf;
4830        dirptr = pathbuf + (nam.NAM_L_DIR - nam.NAM_ESA);
4831        rootend = pathbuf + rootlen;
4832        *(end = rootend) = '\0';
4833        root_dirlen = dirlen = rootlen - devlen;
4834        first_comp = !root_has_dir;
4835        return MPN_OK;
4836    }
4837#endif /* !SFX || SFX_EXDIR */
4838
4839
4840/************
4841 *** INIT ***
4842 ************/
4843
4844    if ( function == INIT )
4845    {
4846        if ( strlen(G.filename) + rootlen + 13 > NAM_MAXRSS )
4847            return MPN_ERR_TOOLONG;
4848
4849        if ( rootlen == 0 )     /* No root given, reset everything. */
4850        {
4851            devptr = dirptr = rootend = pathbuf;
4852            devlen = dirlen = 0;
4853        }
4854        end = rootend;
4855        first_comp = !root_has_dir;
4856        if ( dirlen = root_dirlen )
4857            end[-1] = '.';
4858        *end = '\0';
4859        return MPN_OK;
4860    }
4861
4862
4863/******************
4864 *** APPEND_DIR ***
4865 ******************/
4866    if ( function == APPEND_DIR )
4867    {
4868        int cmplen;
4869
4870        cmplen = strlen(pathcomp);
4871
4872        if ( first_comp )
4873        {
4874            *end++ = '[';
4875            if ( cmplen )
4876                *end++ = '.';   /*       "dir/..." --> "[.dir...]"    */
4877            /*                     else  "/dir..." --> "[dir...]"     */
4878            first_comp = 0;
4879        }
4880
4881        if ( cmplen == 1 && *pathcomp == '.' )
4882            ; /* "..././..." -- ignore */
4883
4884        else if ( cmplen == 2 && pathcomp[0] == '.' && pathcomp[1] == '.' )
4885        {   /* ".../../..." -- convert to "...-..." */
4886            *end++ = '-';
4887            *end++ = '.';
4888        }
4889
4890        else if ( cmplen + (end-pathptr) > NAM_MAXRSS )
4891            return MPN_ERR_TOOLONG;
4892
4893        else
4894        {
4895            strcpy(end, pathcomp);
4896            *(end+=cmplen) = '.';
4897            ++end;
4898        }
4899        dirlen = end - dirptr;
4900        *end = '\0';
4901        return MPN_OK;
4902    }
4903
4904
4905/*******************
4906 *** APPEND_NAME ***
4907 *******************/
4908    if ( function == APPEND_NAME )
4909    {
4910        if ( fcn & USE_DEFAULT )
4911        {   /* Expand renamed filename using collected path, return
4912             *  at pathcomp */
4913            fab = cc$rms_fab;           /* Initialize FAB. */
4914            nam = CC_RMS_NAM;           /* Initialize NAM[L]. */
4915            fab.FAB_NAM = &nam;         /* Point FAB to NAM[L]. */
4916
4917#ifdef NAML$C_MAXRSS
4918
4919            fab.fab$l_dna = (char *) -1;    /* Using NAML for default name. */
4920            fab.fab$l_fna = (char *) -1;    /* Using NAML for file name. */
4921
4922#endif /* NAML$C_MAXRSS */
4923
4924            FAB_OR_NAML(fab, nam).FAB_OR_NAML_DNA = pathptr;
4925            FAB_OR_NAML(fab, nam).FAB_OR_NAML_DNS = end - pathptr;
4926            FAB_OR_NAML(fab, nam).FAB_OR_NAML_FNA = G.filename;
4927            FAB_OR_NAML(fab, nam).FAB_OR_NAML_FNS = strlen(G.filename);
4928
4929            nam.NAM_ESA = pathcomp;     /* (Great design. ---v.  SMS.) */
4930            nam.NAM_ESS = NAM_MAXRSS;   /* Assume large enough. */
4931
4932            if (!OK(status = sys$parse(&fab)) && status == RMS$_DNF )
4933                                         /* Directory not found: */
4934            {                            /* ... try to create it */
4935                char    save;
4936                char    *dirend;
4937                int     mkdir_failed;
4938
4939                dirend = (char*)nam.NAM_L_DIR + nam.NAM_B_DIR;
4940                save = *dirend;
4941                *dirend = '\0';
4942                if ( (mkdir_failed = mkdir(nam.NAM_L_DEV, 0)) &&
4943                     errno == EEXIST )
4944                    mkdir_failed = 0;
4945                *dirend = save;
4946                if ( mkdir_failed )
4947                    return 3;
4948                created_dir = TRUE;
4949            }                                /* if (sys$parse... */
4950            pathcomp[nam.NAM_ESL] = '\0';
4951            return MPN_OK;
4952        }                                /* if (USE_DEFAULT) */
4953        else
4954        {
4955            *end = '\0';
4956            if ( dirlen )
4957            {
4958                dirptr[dirlen-1] = ']'; /* Close directory */
4959
4960                /*
4961                 *  Try to create the target directory.
4962                 *  Don't waste time creating directory that was created
4963                 *  last time.
4964                 */
4965                if ( STRICMP(lastdir, pathbuf) )
4966                {
4967                    mkdir_failed = 0;
4968                    if ( mkdir(pathbuf, 0) )
4969                    {
4970                        if ( errno != EEXIST )
4971                            mkdir_failed = 1;   /* Mine for GETPATH */
4972                    }
4973                    else
4974                        created_dir = TRUE;
4975                    strcpy(lastdir, pathbuf);
4976                }
4977            }
4978            else
4979            {   /*
4980                 * Target directory unspecified.
4981                 * Try to create "SYS$DISK:[]"
4982                 */
4983                if ( strcmp(lastdir, PATH_DEFAULT) )
4984                {
4985                    strcpy(lastdir, PATH_DEFAULT);
4986                    mkdir_failed = 0;
4987                    if ( mkdir(lastdir, 0) && errno != EEXIST )
4988                        mkdir_failed = 1;   /* Mine for GETPATH */
4989                }
4990            }
4991            if ( strlen(pathcomp) + (end-pathbuf) > 255 )
4992                return MPN_INF_TRUNC;
4993            strcpy(end, pathcomp);
4994            end += strlen(pathcomp);
4995            return MPN_OK;
4996        }
4997    }
4998
4999
5000/***************
5001 *** GETPATH ***
5002 ***************/
5003    if ( function == GETPATH )
5004    {
5005        if ( mkdir_failed )
5006            return MPN_ERR_SKIP;
5007        *end = '\0';                    /* To be safe */
5008        strcpy( pathcomp, pathbuf );
5009        return MPN_OK;
5010    }
5011
5012
5013/***********
5014 *** END ***
5015 ***********/
5016    if ( function == END )
5017    {
5018        Trace((stderr, "checkdir(): nothing to free...\n"));
5019        rootlen = 0;
5020        return MPN_OK;
5021    }
5022
5023    return MPN_INVALID; /* should never reach */
5024
5025}
5026
5027
5028
5029int check_for_newer(__G__ filenam)   /* return 1 if existing file newer or */
5030    __GDEF                           /*  equal; 0 if older; -1 if doesn't */
5031    char *filenam;                   /*  exist yet */
5032{
5033#ifdef USE_EF_UT_TIME
5034    iztimes z_utime;
5035    struct tm *t;
5036#endif
5037    char *filenam_stat;
5038    unsigned short timbuf[7];
5039    unsigned dy, mo, yr, hh, mm, ss, dy2, mo2, yr2, hh2, mm2, ss2;
5040    struct FAB fab;
5041    struct XABDAT xdat;
5042#ifdef NAML$C_MAXRSS
5043    struct NAM_STRUCT nam;
5044#endif
5045
5046    /* 2008-07-12 SMS.
5047     * Special case for "." as a file name, not as the current directory.
5048     * Substitute ".;" to keep stat() from seeing a plain ".".
5049    */
5050    if (strcmp(filenam, ".") == 0)
5051        filenam_stat = ".;";
5052    else
5053        filenam_stat = filenam;
5054
5055    if (stat(filenam_stat, &G.statbuf))
5056        return DOES_NOT_EXIST;
5057
5058    fab  = cc$rms_fab;                  /* Initialize FAB. */
5059    xdat = cc$rms_xabdat;               /* Initialize XAB. */
5060
5061#ifdef NAML$C_MAXRSS
5062
5063    nam  = CC_RMS_NAM;                  /* Initialize NAM[L]. */
5064    fab.FAB_NAM = &nam;                 /* Point FAB to NAM[L]. */
5065
5066    fab.fab$l_dna = (char *) -1;    /* Using NAML for default name. */
5067    fab.fab$l_fna = (char *) -1;    /* Using NAML for file name. */
5068
5069#endif /* NAML$C_MAXRSS */
5070
5071    FAB_OR_NAML(fab, nam).FAB_OR_NAML_FNA = filenam;
5072    FAB_OR_NAML(fab, nam).FAB_OR_NAML_FNS = strlen(filenam);
5073
5074    fab.fab$l_xab = (char *) &xdat;
5075    fab.fab$l_fop = FAB$M_GET | FAB$M_UFO;
5076
5077    if (ERR(sys$open(&fab)))             /* open failure:  report exists and */
5078        return EXISTS_AND_OLDER;         /*  older so new copy will be made  */
5079    sys$numtim(&timbuf, &xdat.xab$q_cdt);
5080    fab.fab$l_xab = NULL;
5081
5082    sys$dassgn(fab.fab$l_stv);
5083    sys$close(&fab);   /* be sure file is closed and RMS knows about it */
5084
5085#ifdef USE_EF_UT_TIME
5086    if (G.extra_field &&
5087#ifdef IZ_CHECK_TZ
5088        G.tz_is_valid &&
5089#endif
5090        (ef_scan_for_izux(G.extra_field, G.lrec.extra_field_length, 0,
5091                          G.lrec.last_mod_dos_datetime, &z_utime, NULL)
5092         & EB_UT_FL_MTIME))
5093        t = localtime(&(z_utime.mtime));
5094    else
5095        t = (struct tm *)NULL;
5096
5097    if (t != (struct tm *)NULL)
5098    {
5099        yr2 = (unsigned)(t->tm_year) + 1900;
5100        mo2 = (unsigned)(t->tm_mon) + 1;
5101        dy2 = (unsigned)(t->tm_mday);
5102        hh2 = (unsigned)(t->tm_hour);
5103        mm2 = (unsigned)(t->tm_min);
5104        ss2 = (unsigned)(t->tm_sec);
5105
5106        /* round to nearest sec--may become 60,
5107           but doesn't matter for compare */
5108        ss = (unsigned)((float)timbuf[5] + (float)timbuf[6]*.01 + 0.5);
5109        TTrace((stderr, "check_for_newer:  using Unix extra field mtime\n"));
5110    }
5111    else
5112#endif /* USE_EF_UT_TIME */
5113    {
5114        yr2 = ((G.lrec.last_mod_dos_datetime >> 25) & 0x7f) + 1980;
5115        mo2 = (G.lrec.last_mod_dos_datetime >> 21) & 0x0f;
5116        dy2 = (G.lrec.last_mod_dos_datetime >> 16) & 0x1f;
5117        hh2 = (G.lrec.last_mod_dos_datetime >> 11) & 0x1f;
5118        mm2 = (G.lrec.last_mod_dos_datetime >> 5) & 0x3f;
5119        ss2 = (G.lrec.last_mod_dos_datetime << 1) & 0x1f;
5120
5121        /* round to nearest 2 secs--may become 60,
5122           but doesn't matter for compare */
5123        ss = (unsigned)((float)timbuf[5] + (float)timbuf[6]*.01 + 1.) & (~1);
5124    }
5125    yr = timbuf[0];
5126    mo = timbuf[1];
5127    dy = timbuf[2];
5128    hh = timbuf[3];
5129    mm = timbuf[4];
5130
5131    if (yr > yr2)
5132        return EXISTS_AND_NEWER;
5133    else if (yr < yr2)
5134        return EXISTS_AND_OLDER;
5135
5136    if (mo > mo2)
5137        return EXISTS_AND_NEWER;
5138    else if (mo < mo2)
5139        return EXISTS_AND_OLDER;
5140
5141    if (dy > dy2)
5142        return EXISTS_AND_NEWER;
5143    else if (dy < dy2)
5144        return EXISTS_AND_OLDER;
5145
5146    if (hh > hh2)
5147        return EXISTS_AND_NEWER;
5148    else if (hh < hh2)
5149        return EXISTS_AND_OLDER;
5150
5151    if (mm > mm2)
5152        return EXISTS_AND_NEWER;
5153    else if (mm < mm2)
5154        return EXISTS_AND_OLDER;
5155
5156    if (ss >= ss2)
5157        return EXISTS_AND_NEWER;
5158
5159    return EXISTS_AND_OLDER;
5160}
5161
5162
5163
5164#ifdef RETURN_CODES
5165void return_VMS(__G__ err)
5166    __GDEF
5167#else
5168void return_VMS(err)
5169#endif
5170    int err;
5171{
5172    int severity;
5173
5174#ifdef RETURN_CODES
5175/*---------------------------------------------------------------------------
5176    Do our own, explicit processing of error codes and print message, since
5177    VMS misinterprets return codes as rather obnoxious system errors ("access
5178    violation," for example).
5179  ---------------------------------------------------------------------------*/
5180
5181    switch (err) {
5182        case PK_COOL:
5183            break;   /* life is fine... */
5184        case PK_WARN:
5185            Info(slide, 1, ((char *)slide, "\n\
5186[return-code %d:  warning error \
5187(e.g., failed CRC or unknown compression method)]\n", err));
5188            break;
5189        case PK_ERR:
5190        case PK_BADERR:
5191            Info(slide, 1, ((char *)slide, "\n\
5192[return-code %d:  error in zipfile \
5193(e.g., cannot find local file header sig)]\n", err));
5194            break;
5195        case PK_MEM:
5196        case PK_MEM2:
5197        case PK_MEM3:
5198        case PK_MEM4:
5199        case PK_MEM5:
5200            Info(slide, 1, ((char *)slide,
5201              "\n[return-code %d:  insufficient memory]\n", err));
5202            break;
5203        case PK_NOZIP:
5204            Info(slide, 1, ((char *)slide,
5205              "\n[return-code %d:  zipfile not found]\n", err));
5206            break;
5207        case PK_PARAM:   /* exit(PK_PARAM); gives "access violation" */
5208            Info(slide, 1, ((char *)slide, "\n\
5209[return-code %d:  bad or illegal parameters specified on command line]\n",
5210              err));
5211            break;
5212        case PK_FIND:
5213            Info(slide, 1, ((char *)slide,
5214              "\n[return-code %d:  no files found to extract/view/etc.]\n",
5215              err));
5216            break;
5217        case PK_DISK:
5218            Info(slide, 1, ((char *)slide,
5219              "\n[return-code %d:  disk full or other I/O error]\n", err));
5220            break;
5221        case PK_EOF:
5222            Info(slide, 1, ((char *)slide, "\n\
5223[return-code %d:  unexpected EOF in zipfile (i.e., truncated)]\n", err));
5224            break;
5225        case IZ_CTRLC:
5226            Info(slide, 1, ((char *)slide,
5227              "\n[return-code %d:  you hit ctrl-C to terminate]\n", err));
5228            break;
5229        case IZ_UNSUP:
5230            Info(slide, 1, ((char *)slide, "\n\
5231[return-code %d:  unsupported compression or encryption for all files]\n",
5232              err));
5233            break;
5234        case IZ_BADPWD:
5235            Info(slide, 1, ((char *)slide,
5236              "\n[return-code %d:  bad decryption password for all files]\n",
5237              err));
5238            break;
5239#ifdef DO_SAFECHECK_2GB
5240        case IZ_ERRBF:
5241            Info(slide, 1, ((char *)slide,
5242              "\n[return-code %d:  big-file archive, small-file program]\n",
5243              err));
5244            break;
5245#endif /* DO_SAFECHECK_2GB */
5246        default:
5247            Info(slide, 1, ((char *)slide,
5248              "\n[return-code %d:  unknown return-code (screw-up)]\n", err));
5249            break;
5250    }
5251#endif /* RETURN_CODES */
5252
5253/*---------------------------------------------------------------------------
5254 *  Return an intelligent status/severity level:
5255 *
5256 *  2007-01-29 SMS.
5257 *
5258 *  VMS Status Code Summary  (See STSDEF.H for details.)
5259 *
5260 *      Bits:   31:28    27:16     15:3     2 1 0
5261 *      Field:  Control  Facility  Message  Severity
5262 *                                          -----
5263 *                                          0 0 0  0    Warning
5264 *                                          0 0 1  1    Success
5265 *                                          0 1 0  2    Error
5266 *                                          0 1 1  3    Information
5267 *                                          1 0 0  4    Severe (fatal) error
5268 *
5269 *  In the Control field, bits 31:29 are reserved.  Bit 28 inhibits
5270 *  printing the message.  In the Facility field, bit 27 means
5271 *  customer-defined (not HP-assigned, like us).  In the Message field,
5272 *  bit 15 means facility-specific (which our messages are).
5273 *
5274 *  Note that the C library translates exit(0) to a $STATUS value of 1
5275 *  (i.e., exit is both silent and has a $SEVERITY of "success").
5276 *
5277 *  Previous versions of Info-ZIP programs used a generic ("chosen (by
5278 *  experimentation)") Control+Facility code of 0x7FFF, which included
5279 *  some reserved control bits, the inhibit-printing bit, and the
5280 *  customer-defined bit.
5281 *
5282 *  HP has now assigned official Facility names and corresponding
5283 *  Facility codes for the Info-ZIP products:
5284 *
5285 *      Facility Name    Facility Code
5286 *      IZ_UNZIP         1954 = 0x7A2
5287 *      IZ_ZIP           1955 = 0x7A3
5288 *
5289 *  Now, unless the CTL_FAC_IZ_UZP macro is defined at build-time, we
5290 *  will use the official Facility code.
5291 *
5292  ---------------------------------------------------------------------------*/
5293
5294/* Official HP-assigned Info-ZIP UnZip Facility code. */
5295#define FAC_IZ_UZP 1954   /* 0x7A2 */
5296
5297#ifndef CTL_FAC_IZ_UZP
5298   /*
5299    * Default is inhibit-printing with the official Facility code.
5300    */
5301#  define CTL_FAC_IZ_UZP ((0x1 << 12) | FAC_IZ_UZP)
5302#  define MSG_FAC_SPEC 0x8000   /* Facility-specific code. */
5303#else /* CTL_FAC_IZ_UZP */
5304   /* Use the user-supplied Control+Facility code for err or warn. */
5305#  ifndef MSG_FAC_SPEC          /* Old default is not Facility-specific. */
5306#    define MSG_FAC_SPEC 0x0    /* Facility-specific code.  Or 0x8000. */
5307#  endif /* !MSG_FAC_SPEC */
5308#endif /* ?CTL_FAC_IZ_ZIP */
5309#define VMS_UZ_FAC_BITS       ((CTL_FAC_IZ_UZP << 16) | MSG_FAC_SPEC)
5310
5311    severity = (err == PK_WARN) ? 0 :                           /* warn  */
5312               (err == PK_ERR ||                                /* error */
5313                (err >= PK_NOZIP && err <= PK_FIND) ||          /*  ...  */
5314                (err >= IZ_CTRLC && err <= IZ_BADPWD)) ? 2 :    /*  ...  */
5315               4;                                               /* fatal */
5316
5317    exit(                                           /* $SEVERITY:            */
5318         (err == PK_COOL) ? SS$_NORMAL :            /* success               */
5319         (VMS_UZ_FAC_BITS | (err << 4) | severity)  /* warning, error, fatal */
5320        );
5321
5322} /* end function return_VMS() */
5323
5324
5325#ifdef MORE
5326static int scrnlines = -1;
5327static int scrncolumns = -1;
5328static int scrnwrap = -1;
5329
5330
5331static int getscreeninfo(int *tt_rows, int *tt_cols, int *tt_wrap)
5332{
5333    /*
5334     * For VMS v5.x:
5335     *   IO$_SENSEMODE/SETMODE info:  Programming, Vol. 7A, System Programming,
5336     *     I/O User's: Part I, sec. 8.4.1.1, 8.4.3, 8.4.5, 8.6
5337     *   sys$assign(), sys$qio() info:  Programming, Vol. 4B, System Services,
5338     *     System Services Reference Manual, pp. sys-23, sys-379
5339     *   fixed-length descriptor info:  Programming, Vol. 3, System Services,
5340     *     Intro to System Routines, sec. 2.9.2
5341     * GRR, 15 Aug 91 / SPC, 07 Aug 1995, 14 Nov 1999
5342     */
5343
5344#ifndef OUTDEVICE_NAME
5345#define OUTDEVICE_NAME  "SYS$OUTPUT"
5346#endif
5347
5348    static ZCONST struct dsc$descriptor_s OutDevDesc =
5349        {(sizeof(OUTDEVICE_NAME) - 1), DSC$K_DTYPE_T, DSC$K_CLASS_S,
5350         OUTDEVICE_NAME};
5351     /* {dsc$w_length, dsc$b_dtype, dsc$b_class, dsc$a_pointer}; */
5352
5353    short  OutDevChan, iosb[4];
5354    long   status;
5355    struct tt_characts
5356    {
5357        uch class, type;
5358        ush pagewidth;
5359        union {
5360            struct {
5361                uch ttcharsbits[3];
5362                uch pagelength;
5363            } ttdef_bits;
5364            unsigned ttcharflags;
5365        } ttdef_area;
5366    }      ttmode;              /* total length = 8 bytes */
5367
5368
5369    /* assign a channel to standard output */
5370    status = sys$assign(&OutDevDesc, &OutDevChan, 0, 0);
5371    if (OK(status))
5372    {
5373        /* use sys$qiow and the IO$_SENSEMODE function to determine
5374         * the current tty status.
5375         */
5376        status = sys$qiow(0, OutDevChan, IO$_SENSEMODE, &iosb, 0, 0,
5377                          &ttmode, sizeof(ttmode), 0, 0, 0, 0);
5378        /* deassign the output channel by way of clean-up */
5379        (void) sys$dassgn(OutDevChan);
5380    }
5381
5382    if ( OK(status) && OK(status = iosb[0]) ) {
5383        if (tt_rows != NULL)
5384            *tt_rows = ( (ttmode.ttdef_area.ttdef_bits.pagelength >= 5)
5385                        ? (int) (ttmode.ttdef_area.ttdef_bits.pagelength)
5386                                                        /* TT device value */
5387                        : (24) );                       /* VT 100 default  */
5388        if (tt_cols != NULL)
5389            *tt_cols = ( (ttmode.pagewidth >= 10)
5390                        ? (int) (ttmode.pagewidth)      /* TT device value */
5391                        : (80) );                       /* VT 100 default  */
5392        if (tt_wrap != NULL)
5393            *tt_wrap = ((ttmode.ttdef_area.ttcharflags & TT$M_WRAP) != 0);
5394    } else {
5395        /* VT 100 defaults */
5396        if (tt_rows != NULL)
5397            *tt_rows = 24;
5398        if (tt_cols != NULL)
5399            *tt_cols = 80;
5400        if (tt_wrap != NULL)
5401            *tt_wrap = FALSE;
5402    }
5403
5404    return (OK(status));
5405}
5406
5407int screensize(int *tt_rows, int *tt_cols)
5408{
5409    if (scrnlines < 0 || scrncolumns < 0)
5410        getscreeninfo(&scrnlines, &scrncolumns, &scrnwrap);
5411    if (tt_rows != NULL) *tt_rows = scrnlines;
5412    if (tt_cols != NULL) *tt_cols = scrncolumns;
5413    return !(scrnlines > 0 && scrncolumns > 0);
5414}
5415
5416int screenlinewrap()
5417{
5418    if (scrnwrap == -1)
5419        getscreeninfo(&scrnlines, &scrncolumns, &scrnwrap);
5420    return (scrnwrap);
5421}
5422#endif /* MORE */
5423
5424
5425#ifndef SFX
5426
5427/************************/
5428/*  Function version()  */
5429/************************/
5430
5431/* 2004-11-23 SMS.
5432 * Changed to include the "-x" part of the VMS version.
5433 * Added the IA64 system type name.
5434 * Prepared for VMS versions after 9.  (We should live so long.)
5435 */
5436
5437void version(__G)
5438    __GDEF
5439{
5440    int len;
5441#ifdef VMS_VERSION
5442    char *chrp1;
5443    char *chrp2;
5444    char buf[40];
5445    char vms_vers[16];
5446    int ver_maj;
5447#endif
5448#ifdef __DECC_VER
5449    char buf2[40];
5450    int  vtyp;
5451#endif
5452
5453#ifdef VMS_VERSION
5454    /* Truncate the version string at the first (trailing) space. */
5455    strncpy(vms_vers, VMS_VERSION, sizeof(vms_vers));
5456    vms_vers[sizeof(vms_vers)-1] = '\0';
5457    chrp1 = strchr(vms_vers, ' ');
5458    if (chrp1 != NULL)
5459        *chrp1 = '\0';
5460
5461    /* Determine the major version number. */
5462    ver_maj = 0;
5463    chrp1 = strchr(&vms_vers[1], '.');
5464    for (chrp2 = &vms_vers[1];
5465         chrp2 < chrp1;
5466         ver_maj = ver_maj * 10 + *(chrp2++) - '0');
5467#endif /* VMS_VERSION */
5468
5469/*  DEC C in ANSI mode does not like "#ifdef MACRO" inside another
5470    macro when MACRO is equated to a value (by "#define MACRO 1").   */
5471
5472    len = sprintf((char *)slide, LoadFarString(CompiledWith),
5473
5474#ifdef __GNUC__
5475      "gcc ", __VERSION__,
5476#else
5477#  if defined(DECC) || defined(__DECC) || defined (__DECC__)
5478      "DEC C",
5479#    ifdef __DECC_VER
5480      (sprintf(buf2, " %c%d.%d-%03d",
5481               ((vtyp = (__DECC_VER / 10000) % 10) == 6 ? 'T' :
5482                (vtyp == 8 ? 'S' : 'V')),
5483               __DECC_VER / 10000000,
5484               (__DECC_VER % 10000000) / 100000, __DECC_VER % 1000), buf2),
5485#    else
5486      "",
5487#    endif
5488#  else
5489#    ifdef VAXC
5490      "VAX C", "",
5491#    else
5492      "unknown compiler", "",
5493#    endif
5494#  endif
5495#endif
5496
5497#ifdef VMS_VERSION
5498#  if defined(__alpha)
5499      "OpenVMS",
5500      (sprintf(buf, " (%s Alpha)", vms_vers), buf),
5501#  elif defined(__ia64)
5502      "OpenVMS",
5503      (sprintf(buf, " (%s IA64)", vms_vers), buf),
5504#  else /* VAX */
5505      (ver_maj >= 6) ? "OpenVMS" : "VMS",
5506      (sprintf(buf, " (%s VAX)", vms_vers), buf),
5507#  endif
5508#else
5509      "VMS",
5510      "",
5511#endif /* ?VMS_VERSION */
5512
5513#ifdef __DATE__
5514      " on ", __DATE__
5515#else
5516      "", ""
5517#endif
5518    );
5519
5520    (*G.message)((zvoid *)&G, slide, (ulg)len, 0);
5521
5522} /* end function version() */
5523
5524#endif /* !SFX */
5525
5526
5527
5528#ifdef __DECC
5529
5530/* 2004-11-20 SMS.
5531 *
5532 *       acc_cb(), access callback function for DEC C open().
5533 *
5534 *    Set some RMS FAB/RAB items, with consideration of user-specified
5535 * values from (DCL) SET RMS_DEFAULT.  Items of particular interest are:
5536 *
5537 *       fab$w_deq         default extension quantity (blocks) (write).
5538 *       rab$b_mbc         multi-block count.
5539 *       rab$b_mbf         multi-buffer count (used with rah and wbh).
5540 *
5541 *    See also the OPEN* macros in VMSCFG.H.  Currently, no notice is
5542 * taken of the caller-ID value, but options could be set differently
5543 * for read versus write access.  (I assume that specifying fab$w_deq,
5544 * for example, for a read-only file has no ill effects.)
5545 */
5546
5547/* Global storage. */
5548
5549int openr_id = OPENR_ID;        /* Callback id storage, read. */
5550
5551/* acc_cb() */
5552
5553int acc_cb(int *id_arg, struct FAB *fab, struct RAB *rab)
5554{
5555    int sts;
5556
5557    /* Get process RMS_DEFAULT values, if not already done. */
5558    if (rms_defaults_known == 0)
5559    {
5560        get_rms_defaults();
5561    }
5562
5563    /* If RMS_DEFAULT (and adjusted active) values are available, then set
5564     * the FAB/RAB parameters.  If RMS_DEFAULT values are not available,
5565     * suffer with the default parameters.
5566     */
5567    if (rms_defaults_known > 0)
5568    {
5569        /* Set the FAB/RAB parameters accordingly. */
5570        fab-> fab$w_deq = rms_ext_active;
5571        rab-> rab$b_mbc = rms_mbc_active;
5572        rab-> rab$b_mbf = rms_mbf_active;
5573
5574        /* Truncate at EOF on close, as we'll probably over-extend. */
5575        fab-> fab$v_tef = 1;
5576
5577        /* If using multiple buffers, enable read-ahead and write-behind. */
5578        if (rms_mbf_active > 1)
5579        {
5580            rab-> rab$v_rah = 1;
5581            rab-> rab$v_wbh = 1;
5582        }
5583
5584        if (DIAG_FLAG)
5585        {
5586            fprintf(stderr,
5587              "Open callback.  ID = %d, deq = %6d, mbc = %3d, mbf = %3d.\n",
5588              *id_arg, fab-> fab$w_deq, rab-> rab$b_mbc, rab-> rab$b_mbf);
5589        }
5590    }
5591
5592    /* Declare success. */
5593    return 0;
5594}
5595
5596
5597
5598/*
5599 * 2004-09-19 SMS.
5600 *
5601 *----------------------------------------------------------------------
5602 *
5603 *       decc_init()
5604 *
5605 *    On non-VAX systems, uses LIB$INITIALIZE to set a collection of C
5606 *    RTL features without using the DECC$* logical name method.
5607 *
5608 *----------------------------------------------------------------------
5609 */
5610
5611#ifdef __CRTL_VER
5612#if !defined(__VAX) && (__CRTL_VER >= 70301000)
5613
5614#include <unixlib.h>
5615
5616/*--------------------------------------------------------------------*/
5617
5618/* Global storage. */
5619
5620/*    Flag to sense if decc_init() was called. */
5621
5622static int decc_init_done = -1;
5623
5624/*--------------------------------------------------------------------*/
5625
5626/* decc_init()
5627
5628      Uses LIB$INITIALIZE to set a collection of C RTL features without
5629      requiring the user to define the corresponding logical names.
5630*/
5631
5632/* Structure to hold a DECC$* feature name and its desired value. */
5633
5634typedef struct
5635{
5636   char *name;
5637   int value;
5638} decc_feat_t;
5639
5640/* Array of DECC$* feature names and their desired values. */
5641
5642decc_feat_t decc_feat_array[] = {
5643
5644   /* Preserve command-line case with SET PROCESS/PARSE_STYLE=EXTENDED */
5645 { "DECC$ARGV_PARSE_STYLE", 1 },
5646
5647   /* Preserve case for file names on ODS5 disks. */
5648 { "DECC$EFS_CASE_PRESERVE", 1 },
5649
5650   /* Enable multiple dots (and most characters) in ODS5 file names,
5651      while preserving VMS-ness of ";version". */
5652 { "DECC$EFS_CHARSET", 1 },
5653
5654   /* List terminator. */
5655 { (char *)NULL, 0 } };
5656
5657
5658/* LIB$INITIALIZE initialization function. */
5659
5660static void decc_init(void)
5661{
5662    int feat_index;
5663    int feat_value;
5664    int feat_value_max;
5665    int feat_value_min;
5666    int i;
5667    int sts;
5668
5669    /* Set the global flag to indicate that LIB$INITIALIZE worked. */
5670
5671    decc_init_done = 1;
5672
5673    /* Loop through all items in the decc_feat_array[]. */
5674
5675    for (i = 0; decc_feat_array[i].name != NULL; i++)
5676    {
5677        /* Get the feature index. */
5678        feat_index = decc$feature_get_index(decc_feat_array[i].name);
5679        if (feat_index >= 0)
5680        {
5681            /* Valid item.  Collect its properties. */
5682            feat_value = decc$feature_get_value(feat_index, 1);
5683            feat_value_min = decc$feature_get_value(feat_index, 2);
5684            feat_value_max = decc$feature_get_value(feat_index, 3);
5685
5686            if ((decc_feat_array[i].value >= feat_value_min) &&
5687                (decc_feat_array[i].value <= feat_value_max))
5688            {
5689                /* Valid value.  Set it if necessary. */
5690                if (feat_value != decc_feat_array[i].value)
5691                {
5692                    sts = decc$feature_set_value(
5693                              feat_index,
5694                              1,
5695                              decc_feat_array[i].value);
5696                }
5697            }
5698            else
5699            {
5700                /* Invalid DECC feature value. */
5701                printf(" INVALID DECC FEATURE VALUE, %d: %d <= %s <= %d.\n",
5702                  feat_value,
5703                  feat_value_min, decc_feat_array[i].name, feat_value_max);
5704            }
5705        }
5706        else
5707        {
5708            /* Invalid DECC feature name. */
5709            printf(" UNKNOWN DECC FEATURE: %s.\n", decc_feat_array[i].name);
5710        }
5711    }
5712}
5713
5714/* Get "decc_init()" into a valid, loaded LIB$INITIALIZE PSECT. */
5715
5716#pragma nostandard
5717
5718/* Establish the LIB$INITIALIZE PSECT, with proper alignment and
5719   attributes.
5720*/
5721globaldef {"LIB$INITIALIZ"} readonly _align (LONGWORD)
5722   int spare[8] = { 0 };
5723globaldef {"LIB$INITIALIZE"} readonly _align (LONGWORD)
5724   void (*x_decc_init)() = decc_init;
5725
5726/* Fake reference to ensure loading the LIB$INITIALIZE PSECT. */
5727
5728#pragma extern_model save
5729/* The declaration for LIB$INITIALIZE() is missing in the VMS system header
5730   files.  Addionally, the lowercase name "lib$initialize" is defined as a
5731   macro, so that this system routine can be reference in code using the
5732   traditional C-style lowercase convention of function names for readability.
5733   (VMS system functions declared in the VMS system headers are defined in a
5734   similar way to allow using lowercase names within the C code, whereas the
5735   "externally" visible names in the created object files are uppercase.)
5736 */
5737#ifndef lib$initialize
5738#  define lib$initialize LIB$INITIALIZE
5739#endif
5740int lib$initialize(void);
5741#pragma extern_model strict_refdef
5742int dmy_lib$initialize = (int)lib$initialize;
5743#pragma extern_model restore
5744
5745#pragma standard
5746
5747#endif /* !defined(__VAX) && (__CRTL_VER >= 70301000) */
5748#endif /* __CRTL_VER */
5749#endif /* __DECC */
5750
5751#endif /* VMS */
5752