1/*
2  Copyright (c) 1990-2007 Info-ZIP.  All rights reserved.
3
4  See the accompanying file LICENSE, version 2007-Mar-4 or later
5  (the contents of which are also included in zip.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 *  vms.c (zip) by Igor Mandrichenko    Version 2.2-2
11 *
12 *  Revision history:
13 *  ...
14 *  2.2-2       18-jan-1993     I.Mandrichenko
15 *      vms_stat() added - version of stat() that handles special
16 *      case when end-of-file-block == 0
17 *
18 *  3.0         11-oct-2004     SMS
19 *      It would be nice to know why vms_stat() is needed.  If EOF can't
20 *      be trusted for a zero-length file, why trust it for any file?
21 *      Anyway, I removed the (int) cast on ->st_size, which may now be
22 *      bigger than an int, just in case this code ever does get used.
23 *      (A true zero-length file should still report zero length, even
24 *      after the long fight with RMS.)
25 *      Moved the VMS_PK_EXTRA test(s) into VMS_IM.C and VMS_PK.C to
26 *      allow more general automatic dependency generation.
27 */
28
29#ifdef VMS                      /* For VMS only ! */
30
31#define NO_ZIPUP_H              /* Prevent full inclusion of vms/zipup.h. */
32
33#include "zip.h"
34#include "zipup.h"              /* Only partial. */
35
36#include <stdio.h>
37#include <string.h>
38
39#include <jpidef.h>
40#include <fab.h>                /* Needed only in old environments. */
41#include <nam.h>                /* Needed only in old environments. */
42#include <starlet.h>
43#include <ssdef.h>
44#include <stsdef.h>
45
46/* On VAX, define Goofy VAX Type-Cast to obviate /standard = vaxc.
47   Otherwise, lame system headers on VAX cause compiler warnings.
48   (GNU C may define vax but not __VAX.)
49*/
50#ifdef vax
51# define __VAX 1
52#endif /* def vax */
53
54#ifdef __VAX
55# define GVTC (unsigned int)
56#else /* def __VAX */
57# define GVTC
58#endif /* def __VAX */
59
60
61#ifdef UTIL
62
63/* For utilities, include only vms.h, as either of the vms_XX.c files
64 * would do.
65 */
66
67# include "vms.h"
68
69#else /* not UTIL */
70
71/* Include the `VMS attributes' preserving file-io code. We distinguish
72   between two incompatible flavours of storing VMS attributes in the
73   Zip archive:
74   a) The "PKware" style follows the extra field specification for
75      PKware's VMS Zip.
76   b) The "IM (Info-ZIP)" flavour was defined from scratch by
77      Igor Mandrichenko. This version has be used in official Info-ZIP
78      releases for several years and is known to work well.
79 */
80
81/* Note that only one of these #include directives will include any
82 * active code, depending on VMS_PK_EXTRA.  Both are included here (and
83 * tested there) to allow more general automatic dependency generation.
84 */
85
86#include "vms_pk.c"
87#include "vms_im.c"
88
89#endif /* not UTIL [else] */
90
91#ifndef ERR
92#define ERR(x) (((x)&1)==0)
93#endif
94
95#ifndef NULL
96#define NULL (void*)(0L)
97#endif
98
99int vms_stat( char *file, stat_t *s)
100{
101    int status;
102    int staterr;
103    struct FAB fab;
104    struct NAM_STRUCT nam;
105    struct XABFHC fhc;
106
107    /*
108     *  In simplest case when stat() returns "ok" and file size is
109     *  nonzero or this is directory, finish with this
110     */
111
112    if( (staterr=stat(file,s)) == 0
113        && ( s->st_size >= 0                      /* Size - ok */
114             || (s->st_mode & S_IFREG) == 0       /* Not a plain file */
115           )
116    ) return staterr;
117
118    /*
119     *  Get here to handle the special case when stat() returns
120     *  invalid file size. Use RMS to compute the size.
121     *  When EOF block is zero, set file size to its physical size.
122     *  One more case to get here is when this is remote file accessed
123     *  via DECnet.
124     */
125
126    fab = cc$rms_fab;
127    nam = CC_RMS_NAM;
128    fhc = cc$rms_xabfhc;
129    fab.FAB_NAM = &nam;
130    fab.fab$l_xab = (char*)(&fhc);
131
132#ifdef NAML$C_MAXRSS
133
134    fab.fab$l_dna = (char *) -1;    /* Using NAML for default name. */
135    fab.fab$l_fna = (char *) -1;    /* Using NAML for file name. */
136
137#endif /* def NAML$C_MAXRSS */
138
139    FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNA = file;
140    FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNS = strlen( file);
141
142    fab.fab$b_fac = FAB$M_GET;
143
144    status = sys$open(&fab);
145    fab.fab$l_xab = (char*)0L;
146    sys$close(&fab);
147
148    if( !ERR(status) )
149    {
150        if( fhc.xab$l_ebk > 0 )
151            s->st_size = ( fhc.xab$l_ebk-1 ) * 512 + fhc.xab$w_ffb;
152        else if( fab.fab$b_org == FAB$C_IDX
153                 || fab.fab$b_org == FAB$C_REL
154                 || fab.fab$b_org == FAB$C_HSH )
155                /* Special case, when ebk=0: save entire allocated space */
156                    s->st_size = fhc.xab$l_hbk * 512;
157        else
158            s->st_size = fhc.xab$w_ffb;
159        return 0; /* stat() success code */
160    }
161    else
162        return status;
163}
164
165
166/*
167 * 2007-01-29 SMS.
168 *
169 *  VMS Status Code Summary  (See STSDEF.H for details.)
170 *
171 *      Bits:   31:28    27:16     15:3     2:0
172 *      Field:  Control  Facility  Message  Severity
173 *
174 *  In the Control field, bits 31:29 are reserved.  Bit 28 inhibits
175 *  printing the message.  In the Facility field, bit 27 means
176 *  customer-defined (not HP-assigned, like us).  In the Message field,
177 *  bit 15 means facility-specific (which our messages are).  The
178 *  Severity codes are 0 = Warning, 1 = Success, 2 = Error, 3 = Info,
179 *  4 = Severe (fatal).
180 *
181 *  Previous versions of Info-ZIP programs used a generic ("chosen (by
182 *  experimentation)") Control+Facility code of 0x7FFF, which included
183 *  some reserved control bits, the inhibit-printing bit, and the
184 *  customer-defined bit.
185 *
186 *  HP has now assigned official Facility names and corresponding
187 *  Facility codes for the Info-ZIP products:
188 *
189 *      Facility Name    Facility Code
190 *      IZ_UNZIP         1954 = 0x7A2
191 *      IZ_ZIP           1955 = 0x7A3
192 *
193 *  Now, unless the CTL_FAC_IZ_ZIP macro is defined at build-time, we
194 *  will use the official Facility code.
195 *
196 */
197
198/* Official HP-assigned Info-ZIP Zip Facility code. */
199#define FAC_IZ_ZIP 1955   /* 0x7A3 */
200
201#ifndef CTL_FAC_IZ_ZIP
202   /*
203    * Default is inhibit-printing with the official Facility code.
204    */
205#  define CTL_FAC_IZ_ZIP ((0x1 << 12)| FAC_IZ_ZIP)
206#  define MSG_FAC_SPEC 0x8000   /* Facility-specific code. */
207#else /* ndef CTL_FAC_IZ_ZIP */
208   /* Use the user-supplied Control+Facility code for err or warn. */
209#  define OLD_STATUS
210#  ifndef MSG_FAC_SPEC          /* Old default is not Facility-specific. */
211#    define MSG_FAC_SPEC 0x0    /* Facility-specific code.  Or 0x8000. */
212#  endif /* ndef MSG_FAC_SPEC */
213#endif /* ndef CTL_FAC_IZ_ZIP [else] */
214
215
216/* Return an intelligent status/severity code. */
217
218void vms_exit(e)
219   int e;
220{
221  {
222#ifndef OLD_STATUS
223
224    /*
225     * Exit with code comprising Control, Facility, (facility-specific)
226     * Message, and Severity.
227     */
228    exit( (CTL_FAC_IZ_ZIP << 16) |              /* Facility                */
229          MSG_FAC_SPEC |                        /* Facility-specific       */
230          (e << 4) |                            /* Message code            */
231          (ziperrors[ e].severity & 0x07)       /* Severity                */
232        );
233
234#else /* ndef OLD_STATUS */
235
236    /* 2007-01-17 SMS.
237     * Defining OLD_STATUS provides the same behavior as in Zip versions
238     * before an official VMS Facility code had been assigned, which
239     * means that Success (ZE_OK) gives a status value of 1 (SS$_NORMAL)
240     * with no Facility code, while any error or warning gives a status
241     * value which includes a Facility code.  (Curiously, under the old
242     * scheme, message codes were left-shifted by 4 instead of 3,
243     * resulting in all-even message codes.)  I don't like this, but I
244     * was afraid to remove it, as someone, somewhere may be depending
245     * on it.  Define CTL_FAC_IZ_ZIP as 0x7FFF to get the old behavior.
246     * Define only OLD_STATUS to get the old behavior for Success
247     * (ZE_OK), but using the official HP-assigned Facility code for an
248     * error or warning.  Define MSG_FAC_SPEC to get the desired
249     * behavior.
250     *
251     * Exit with simple SS$_NORMAL for ZE_OK.  Otherwise, exit with code
252     * comprising Control, Facility, Message, and Severity.
253     */
254    exit(
255         (e == ZE_OK) ? SS$_NORMAL :            /* Success (others below)  */
256         ((CTL_FAC_IZ_ZIP << 16) |              /* Facility                */
257          MSG_FAC_SPEC |                        /* Facility-specific (?)   */
258          (e << 4) |                            /* Message code            */
259          (ziperrors[ e].severity & 0x07)       /* Severity                */
260         )
261        );
262
263#endif /* ndef OLD_STATUS */
264   }
265}
266
267
268/******************************/
269/*  Function version_local()  */
270/******************************/
271
272void version_local()
273{
274    static ZCONST char CompiledWith[] = "Compiled with %s%s for %s%s%s%s.\n\n";
275#ifdef VMS_VERSION
276    char *chrp1;
277    char *chrp2;
278    char buf[40];
279    char vms_vers[ 16];
280    int ver_maj;
281#endif
282#ifdef __DECC_VER
283    char buf2[40];
284    int  vtyp;
285#endif
286
287#ifdef VMS_VERSION
288    /* Truncate the version string at the first (trailing) space. */
289    strncpy( vms_vers, VMS_VERSION, sizeof( vms_vers));
290    chrp1 = strchr( vms_vers, ' ');
291    if (chrp1 != NULL)
292        *chrp1 = '\0';
293
294    /* Determine the major version number. */
295    ver_maj = 0;
296    chrp1 = strchr( &vms_vers[ 1], '.');
297    for (chrp2 = &vms_vers[ 1];
298     chrp2 < chrp1;
299     ver_maj = ver_maj* 10+ *(chrp2++)- '0');
300
301#endif /* def VMS_VERSION */
302
303/*  DEC C in ANSI mode does not like "#ifdef MACRO" inside another
304    macro when MACRO is equated to a value (by "#define MACRO 1").   */
305
306    printf(CompiledWith,
307
308#ifdef __GNUC__
309      "gcc ", __VERSION__,
310#else
311#  if defined(DECC) || defined(__DECC) || defined (__DECC__)
312      "DEC C",
313#    ifdef __DECC_VER
314      (sprintf(buf2, " %c%d.%d-%03d",
315               ((vtyp = (__DECC_VER / 10000) % 10) == 6 ? 'T' :
316                (vtyp == 8 ? 'S' : 'V')),
317               __DECC_VER / 10000000,
318               (__DECC_VER % 10000000) / 100000, __DECC_VER % 1000), buf2),
319#    else
320      "",
321#    endif
322#  else
323#  ifdef VAXC
324      "VAX C", "",
325#  else
326      "unknown compiler", "",
327#  endif
328#  endif
329#endif
330
331#ifdef VMS_VERSION
332#  if defined( __alpha)
333      "OpenVMS",
334      (sprintf( buf, " (%s Alpha)", vms_vers), buf),
335#  elif defined( __ia64) /* defined( __alpha) */
336      "OpenVMS",
337      (sprintf( buf, " (%s IA64)", vms_vers), buf),
338#  else /* defined( __alpha) */
339      (ver_maj >= 6) ? "OpenVMS" : "VMS",
340      (sprintf( buf, " (%s VAX)", vms_vers), buf),
341#  endif /* defined( __alpha) */
342#else
343      "VMS",
344      "",
345#endif /* def VMS_VERSION */
346
347#ifdef __DATE__
348      " on ", __DATE__
349#else
350      "", ""
351#endif
352      );
353
354} /* end function version_local() */
355
356/* 2004-10-08 SMS.
357 *
358 *       tempname() for VMS.
359 *
360 *    Generate a temporary Zip archive file name, near the actual
361 *    destination Zip archive file, or at "tempath", if specified.
362 *
363 *    Using sys$parse() is probably more work than it's worth, but it
364 *    should also be ODS5-safe.
365 *
366 *    Note that the generic method using tmpnam() (in FILEIO.C)
367 *    produces "ziXXXXXX", where "XXXXXX" is the low six digits of the
368 *    decimal representation of the process ID.  This method produces
369 *    "ZIxxxxxxxx", where "xxxxxxxx" is the (whole) eight-digit
370 *    hexadecimal representation of the process ID.  More important, it
371 *    actually uses the directory part of the argument or "tempath".
372 */
373
374
375char *tempname( char *zip)
376/* char *zip; */                /* Path name of Zip archive. */
377{
378    char *temp_name;            /* Return value. */
379    int sts;                    /* System service status. */
380
381    static int pid;             /* Process ID. */
382    static int pid_len;         /* Returned size of process ID. */
383
384    struct                      /* Item list for GETJPIW. */
385    {
386        short buf_len;          /* Buffer length. */
387        short itm_cod;          /* Item code. */
388        int *buf;               /* Buffer address. */
389        int *ret_len;           /* Returned length. */
390        int term;               /* Item list terminator. */
391    } jpi_itm_lst = { sizeof( pid), JPI$_PID, &pid, &pid_len };
392
393    /* ZI<UNIQUE> name storage. */
394    static char zip_tmp_nam[ 16] = "ZI<unique>.;";
395
396    struct FAB fab;             /* FAB structure. */
397    struct NAM_STRUCT nam;      /* NAM[L] structure. */
398
399    char exp_str[ NAM_MAXRSS+ 1];   /* Expanded name storage. */
400
401#ifdef VMS_UNIQUE_TEMP_BY_TIME
402
403    /* Use alternate time-based scheme to generate a unique temporary name. */
404    sprintf( &zip_tmp_nam[ 2], "%08X", time( NULL));
405
406#else /* def VMS_UNIQUE_TEMP_BY_TIME */
407
408    /* Use the process ID to generate a unique temporary name. */
409    sts = sys$getjpiw( 0, 0, 0, &jpi_itm_lst, 0, 0, 0);
410    sprintf( &zip_tmp_nam[ 2], "%08X", pid);
411
412#endif /* def VMS_UNIQUE_TEMP_BY_TIME */
413
414    /* Smoosh the unique temporary name against the actual Zip archive
415       name (or "tempath") to create the full temporary path name.
416       (Truncate it at the file type to remove any file type.)
417    */
418    if (tempath != NULL)        /* Use "tempath", if it's been specified. */
419        zip = tempath;
420
421    /* Initialize the FAB and NAM[L], and link the NAM[L] to the FAB. */
422    fab = cc$rms_fab;
423    nam = CC_RMS_NAM;
424    fab.FAB_NAM = &nam;
425
426    /* Point the FAB/NAM[L] fields to the actual name and default name. */
427
428#ifdef NAML$C_MAXRSS
429
430    fab.fab$l_dna = (char *) -1;    /* Using NAML for default name. */
431    fab.fab$l_fna = (char *) -1;    /* Using NAML for file name. */
432
433#endif /* def NAML$C_MAXRSS */
434
435    /* Default name = Zip archive name. */
436    FAB_OR_NAML( fab, nam).FAB_OR_NAML_DNA = zip;
437    FAB_OR_NAML( fab, nam).FAB_OR_NAML_DNS = strlen( zip);
438
439    /* File name = "ZI<unique>,;". */
440    FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNA = zip_tmp_nam;
441    FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNS = strlen( zip_tmp_nam);
442
443    nam.NAM_ESA = exp_str;      /* Expanded name (result) storage. */
444    nam.NAM_ESS = NAM_MAXRSS;   /* Size of expanded name storage. */
445
446    nam.NAM_NOP = NAM_M_SYNCHK; /* Syntax-only analysis. */
447
448    temp_name = NULL;           /* Prepare for failure (unlikely). */
449    sts = sys$parse( &fab, 0, 0);       /* Parse the name(s). */
450
451    if ((sts& STS$M_SEVERITY) == STS$M_SUCCESS)
452    {
453        /* Overlay any resulting file type (typically ".ZIP") with none. */
454        strcpy( nam.NAM_L_TYPE, ".;");
455
456        /* Allocate temp name storage (as caller expects), and copy the
457           (truncated) temp name into the new location.
458        */
459        temp_name = malloc( strlen( nam.NAM_ESA)+ 1);
460
461        if (temp_name != NULL)
462        {
463            strcpy( temp_name, nam.NAM_ESA);
464        }
465    }
466    return temp_name;
467} /* tempname() for VMS. */
468
469
470/* 2005-02-17 SMS.
471 *
472 *       ziptyp() for VMS.
473 *
474 *    Generate a real Zip archive file name (exact, if it exists), using
475 *    a default file name.
476 *
477 *    2005-02-17 SMS.  Moved to here from [-]ZIPFILE.C, to segregate
478 *    better the RMS stuff.
479 *
480 *    Before 2005-02-17, if sys$parse() failed, ziptyp() returned a null
481 *    string ("&zero", where "static char zero = '\0';").  This
482 *    typically caused Zip to proceed, but then the final rename() of
483 *    the temporary archive would (silently) fail (null file name, after
484 *    all), leaving only the temporary archive file, and providing no
485 *    warning message to the victim.  Now, when sys$parse() fails,
486 *    ziptyp() returns the original string, so a later open() fails, and
487 *    a relatively informative message is provided.  (A VMS-specific
488 *    message could also be provided here, if desired.)
489 *
490 *    2005-09-16 SMS.
491 *    Changed name parsing in ziptyp() to solve a problem with a
492 *    search-list logical name device-directory spec for the zipfile.
493 *    Previously, when the zipfile did not exist (so sys$search()
494 *    failed), the expanded name was used, but as it was
495 *    post-sys$search(), it was based on the _last_ member of the search
496 *    list instead of the first.  Now, the expanded name from the
497 *    original sys$parse() (pre-sys$search()) is retained, and it is
498 *    used if sys$search() fails.  This name is based on the first
499 *    member of the search list, as a user might expect.
500 */
501
502/* Default Zip archive file spec. */
503#define DEF_DEVDIRNAM "SYS$DISK:[].zip"
504
505char *ziptyp( char *s)
506{
507    int status;
508    int exp_len;
509    struct FAB fab;
510    struct NAM_STRUCT nam;
511    char result[ NAM_MAXRSS+ 1];
512    char exp[ NAM_MAXRSS+ 1];
513    char *p;
514
515    fab = cc$rms_fab;                           /* Initialize FAB. */
516    nam = CC_RMS_NAM;                           /* Initialize NAM[L]. */
517    fab.FAB_NAM = &nam;                         /* FAB -> NAM[L] */
518
519#ifdef NAML$C_MAXRSS
520
521    fab.fab$l_dna =(char *) -1;         /* Using NAML for default name. */
522    fab.fab$l_fna = (char *) -1;        /* Using NAML for file name. */
523
524#endif /* def NAML$C_MAXRSS */
525
526    /* Argument file name and length. */
527    FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNA = s;
528    FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNS = strlen( s);
529
530    /* Default file spec and length. */
531    FAB_OR_NAML( fab, nam).FAB_OR_NAML_DNA = DEF_DEVDIRNAM;
532    FAB_OR_NAML( fab, nam).FAB_OR_NAML_DNS = sizeof( DEF_DEVDIRNAM)- 1;
533
534    nam.NAM_ESA = exp;                 /* Expanded name, */
535    nam.NAM_ESS = NAM_MAXRSS;          /* storage size. */
536    nam.NAM_RSA = result;              /* Resultant name, */
537    nam.NAM_RSS = NAM_MAXRSS;          /* storage size. */
538
539    status = sys$parse(&fab);
540    if ((status & 1) == 0)
541    {
542        /* Invalid file name.  Return (re-allocated) original, and hope
543           for a later error message.
544        */
545        if ((p = malloc( strlen( s)+ 1)) != NULL )
546        {
547            strcpy( p, s);
548        }
549        return p;
550    }
551
552    /* Save expanded name length from sys$parse(). */
553    exp_len = nam.NAM_ESL;
554
555    /* Leave expanded name as-is, in case of search failure. */
556    nam.NAM_ESA = NULL;                 /* Expanded name, */
557    nam.NAM_ESS = 0;                    /* storage size. */
558
559    status = sys$search(&fab);
560    if (status & 1)
561    {   /* Zip file exists.  Use resultant (complete, exact) name. */
562        if ((p = malloc( nam.NAM_RSL+ 1)) != NULL )
563        {
564            result[ nam.NAM_RSL] = '\0';
565            strcpy( p, result);
566        }
567    }
568    else
569    {   /* New Zip file.  Use pre-search expanded name. */
570        if ((p = malloc( exp_len+ 1)) != NULL )
571        {
572            exp[ exp_len] = '\0';
573            strcpy( p, exp);
574        }
575    }
576    return p;
577} /* ziptyp() for VMS. */
578
579
580/* 2005-12-30 SMS.
581 *
582 *       vms_file_version().
583 *
584 *    Return the ";version" part of a VMS file specification.
585 */
586
587char *vms_file_version( char *s)
588{
589    int status;
590    struct FAB fab;
591    struct NAM_STRUCT nam;
592    char *p;
593
594    static char exp[ NAM_MAXRSS+ 1];    /* Expanded name storage. */
595
596
597    fab = cc$rms_fab;                   /* Initialize FAB. */
598    nam = CC_RMS_NAM;                   /* Initialize NAM[L]. */
599    fab.FAB_NAM = &nam;                 /* FAB -> NAM[L] */
600
601#ifdef NAML$C_MAXRSS
602
603    fab.fab$l_dna =(char *) -1;         /* Using NAML for default name. */
604    fab.fab$l_fna = (char *) -1;        /* Using NAML for file name. */
605
606#endif /* def NAML$C_MAXRSS */
607
608    /* Argument file name and length. */
609    FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNA = s;
610    FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNS = strlen( s);
611
612    nam.NAM_ESA = exp;                 /* Expanded name, */
613    nam.NAM_ESS = NAM_MAXRSS;          /* storage size. */
614
615    nam.NAM_NOP = NAM_M_SYNCHK;        /* Syntax-only analysis. */
616
617    status = sys$parse(&fab);
618
619    if ((status & 1) == 0)
620    {
621        /* Invalid file name.  Return "". */
622        exp[ 0] = '\0';
623        p = exp;
624    }
625    else
626    {
627        /* Success.  NUL-terminate, and return a pointer to the ";" in
628           the expanded name storage buffer.
629        */
630        p = nam.NAM_L_VER;
631        p[ nam.NAM_B_VER] = '\0';
632    }
633    return p;
634} /* vms_file_version(). */
635
636
637/* 2004-11-23 SMS.
638 *
639 *       get_rms_defaults().
640 *
641 *    Get user-specified values from (DCL) SET RMS_DEFAULT.  FAB/RAB
642 *    items of particular interest are:
643 *
644 *       fab$w_deq         default extension quantity (blocks) (write).
645 *       rab$b_mbc         multi-block count.
646 *       rab$b_mbf         multi-buffer count (used with rah and wbh).
647 */
648
649#define DIAG_FLAG (verbose >= 2)
650
651/* Default RMS parameter values. */
652
653#define RMS_DEQ_DEFAULT 16384   /* About 1/4 the max (65535 blocks). */
654#define RMS_MBC_DEFAULT 127     /* The max, */
655#define RMS_MBF_DEFAULT 2       /* Enough to enable rah and wbh. */
656
657/* GETJPI item descriptor structure. */
658typedef struct
659    {
660    short buf_len;
661    short itm_cod;
662    void *buf;
663    int *ret_len;
664    } jpi_item_t;
665
666/* Durable storage */
667
668static int rms_defaults_known = 0;
669
670/* JPI item buffers. */
671static unsigned short rms_ext;
672static char rms_mbc;
673static unsigned char rms_mbf;
674
675/* Active RMS item values. */
676unsigned short rms_ext_active;
677char rms_mbc_active;
678unsigned char rms_mbf_active;
679
680/* GETJPI item lengths. */
681static int rms_ext_len;         /* Should come back 2. */
682static int rms_mbc_len;         /* Should come back 1. */
683static int rms_mbf_len;         /* Should come back 1. */
684
685/* Desperation attempts to define unknown macros.  Probably doomed.
686 * If these get used, expect sys$getjpiw() to return %x00000014 =
687 * %SYSTEM-F-BADPARAM, bad parameter value.
688 * They keep compilers with old header files quiet, though.
689 */
690#ifndef JPI$_RMS_EXTEND_SIZE
691#  define JPI$_RMS_EXTEND_SIZE 542
692#endif /* ndef JPI$_RMS_EXTEND_SIZE */
693
694#ifndef JPI$_RMS_DFMBC
695#  define JPI$_RMS_DFMBC 535
696#endif /* ndef JPI$_RMS_DFMBC */
697
698#ifndef JPI$_RMS_DFMBFSDK
699#  define JPI$_RMS_DFMBFSDK 536
700#endif /* ndef JPI$_RMS_DFMBFSDK */
701
702/* GETJPI item descriptor set. */
703
704struct
705    {
706    jpi_item_t rms_ext_itm;
707    jpi_item_t rms_mbc_itm;
708    jpi_item_t rms_mbf_itm;
709    int term;
710    } jpi_itm_lst =
711     { { 2, JPI$_RMS_EXTEND_SIZE, &rms_ext, &rms_ext_len },
712       { 1, JPI$_RMS_DFMBC, &rms_mbc, &rms_mbc_len },
713       { 1, JPI$_RMS_DFMBFSDK, &rms_mbf, &rms_mbf_len },
714       0
715     };
716
717int get_rms_defaults()
718{
719int sts;
720
721/* Get process RMS_DEFAULT values. */
722
723sts = sys$getjpiw( 0, 0, 0, &jpi_itm_lst, 0, 0, 0);
724if ((sts& STS$M_SEVERITY) != STS$M_SUCCESS)
725    {
726    /* Failed.  Don't try again. */
727    rms_defaults_known = -1;
728    }
729else
730    {
731    /* Fine, but don't come back. */
732    rms_defaults_known = 1;
733    }
734
735/* Limit the active values according to the RMS_DEFAULT values. */
736
737if (rms_defaults_known > 0)
738    {
739    /* Set the default values. */
740
741    rms_ext_active = RMS_DEQ_DEFAULT;
742    rms_mbc_active = RMS_MBC_DEFAULT;
743    rms_mbf_active = RMS_MBF_DEFAULT;
744
745    /* Default extend quantity.  Use the user value, if set. */
746    if (rms_ext > 0)
747        {
748        rms_ext_active = rms_ext;
749        }
750
751    /* Default multi-block count.  Use the user value, if set. */
752    if (rms_mbc > 0)
753        {
754        rms_mbc_active = rms_mbc;
755        }
756
757    /* Default multi-buffer count.  Use the user value, if set. */
758    if (rms_mbf > 0)
759        {
760        rms_mbf_active = rms_mbf;
761        }
762    }
763
764if (DIAG_FLAG)
765    {
766    fprintf( stderr,
767     "Get RMS defaults.  getjpi sts = %%x%08x.\n",
768     sts);
769
770    if (rms_defaults_known > 0)
771        {
772        fprintf( stderr,
773         "               Default: deq = %6d, mbc = %3d, mbf = %3d.\n",
774         rms_ext, rms_mbc, rms_mbf);
775        }
776    }
777return sts;
778}
779
780#ifdef __DECC
781
782/* 2004-11-23 SMS.
783 *
784 *       acc_cb(), access callback function for DEC C zfopen().
785 *
786 *    Set some RMS FAB/RAB items, with consideration of user-specified
787 * values from (DCL) SET RMS_DEFAULT.  Items of particular interest are:
788 *
789 *       fab$w_deq         default extension quantity (blocks).
790 *       rab$b_mbc         multi-block count.
791 *       rab$b_mbf         multi-buffer count (used with rah and wbh).
792 *
793 *    See also the FOP* macros in OSDEP.H.  Currently, no notice is
794 * taken of the caller-ID value, but options could be set differently
795 * for read versus write access.  (I assume that specifying fab$w_deq,
796 * for example, for a read-only file has no ill effects.)
797 */
798
799/* Global storage. */
800
801int fopm_id = FOPM_ID;          /* Callback id storage, modify. */
802int fopr_id = FOPR_ID;          /* Callback id storage, read. */
803int fopw_id = FOPW_ID;          /* Callback id storage, write. */
804
805int fhow_id = FHOW_ID;          /* Callback id storage, in read. */
806
807/* acc_cb() */
808
809int acc_cb( int *id_arg, struct FAB *fab, struct RAB *rab)
810{
811int sts;
812
813/* Get process RMS_DEFAULT values, if not already done. */
814if (rms_defaults_known == 0)
815    {
816    get_rms_defaults();
817    }
818
819/* If RMS_DEFAULT (and adjusted active) values are available, then set
820 * the FAB/RAB parameters.  If RMS_DEFAULT values are not available,
821 * suffer with the default parameters.
822 */
823if (rms_defaults_known > 0)
824    {
825    /* Set the FAB/RAB parameters accordingly. */
826    fab-> fab$w_deq = rms_ext_active;
827    rab-> rab$b_mbc = rms_mbc_active;
828    rab-> rab$b_mbf = rms_mbf_active;
829
830    /* Truncate at EOF on close, as we'll probably over-extend. */
831    fab-> fab$v_tef = 1;
832
833    /* If using multiple buffers, enable read-ahead and write-behind. */
834    if (rms_mbf_active > 1)
835        {
836        rab-> rab$v_rah = 1;
837        rab-> rab$v_wbh = 1;
838        }
839
840    if (DIAG_FLAG)
841        {
842        fprintf( mesg,
843         "Open callback.  ID = %d, deq = %6d, mbc = %3d, mbf = %3d.\n",
844         *id_arg, fab-> fab$w_deq, rab-> rab$b_mbc, rab-> rab$b_mbf);
845        }
846    }
847
848/* Declare success. */
849return 0;
850}
851
852#endif /* def __DECC */
853
854/*
855 * 2004-09-19 SMS.
856 *
857 *----------------------------------------------------------------------
858 *
859 *       decc_init()
860 *
861 *    On non-VAX systems, uses LIB$INITIALIZE to set a collection of C
862 *    RTL features without using the DECC$* logical name method.
863 *
864 *----------------------------------------------------------------------
865 */
866
867#ifdef __DECC
868
869#ifdef __CRTL_VER
870
871#if !defined( __VAX) && (__CRTL_VER >= 70301000)
872
873#include <unixlib.h>
874
875/*--------------------------------------------------------------------*/
876
877/* Global storage. */
878
879/*    Flag to sense if decc_init() was called. */
880
881int decc_init_done = -1;
882
883/*--------------------------------------------------------------------*/
884
885/* decc_init()
886
887      Uses LIB$INITIALIZE to set a collection of C RTL features without
888      requiring the user to define the corresponding logical names.
889*/
890
891/* Structure to hold a DECC$* feature name and its desired value. */
892
893typedef struct
894   {
895   char *name;
896   int value;
897   } decc_feat_t;
898
899/* Array of DECC$* feature names and their desired values. */
900
901decc_feat_t decc_feat_array[] = {
902
903   /* Preserve command-line case with SET PROCESS/PARSE_STYLE=EXTENDED */
904 { "DECC$ARGV_PARSE_STYLE", 1 },
905
906   /* Preserve case for file names on ODS5 disks. */
907 { "DECC$EFS_CASE_PRESERVE", 1 },
908
909   /* Enable multiple dots (and most characters) in ODS5 file names,
910      while preserving VMS-ness of ";version". */
911 { "DECC$EFS_CHARSET", 1 },
912
913   /* List terminator. */
914 { (char *)NULL, 0 } };
915
916/* LIB$INITIALIZE initialization function. */
917
918static void decc_init( void)
919{
920int feat_index;
921int feat_value;
922int feat_value_max;
923int feat_value_min;
924int i;
925int sts;
926
927/* Set the global flag to indicate that LIB$INITIALIZE worked. */
928
929decc_init_done = 1;
930
931/* Loop through all items in the decc_feat_array[]. */
932
933for (i = 0; decc_feat_array[ i].name != NULL; i++)
934   {
935   /* Get the feature index. */
936   feat_index = decc$feature_get_index( decc_feat_array[ i].name);
937   if (feat_index >= 0)
938      {
939      /* Valid item.  Collect its properties. */
940      feat_value = decc$feature_get_value( feat_index, 1);
941      feat_value_min = decc$feature_get_value( feat_index, 2);
942      feat_value_max = decc$feature_get_value( feat_index, 3);
943
944      if ((decc_feat_array[ i].value >= feat_value_min) &&
945       (decc_feat_array[ i].value <= feat_value_max))
946         {
947         /* Valid value.  Set it if necessary. */
948         if (feat_value != decc_feat_array[ i].value)
949            {
950            sts = decc$feature_set_value( feat_index,
951             1,
952             decc_feat_array[ i].value);
953            }
954         }
955      else
956         {
957         /* Invalid DECC feature value. */
958         printf( " INVALID DECC FEATURE VALUE, %d: %d <= %s <= %d.\n",
959          feat_value,
960          feat_value_min, decc_feat_array[ i].name, feat_value_max);
961         }
962      }
963   else
964      {
965      /* Invalid DECC feature name. */
966      printf( " UNKNOWN DECC FEATURE: %s.\n", decc_feat_array[ i].name);
967      }
968   }
969}
970
971/* Get "decc_init()" into a valid, loaded LIB$INITIALIZE PSECT. */
972
973#pragma nostandard
974
975/* Establish the LIB$INITIALIZE PSECTs, with proper alignment and
976   other attributes.  Note that "nopic" is significant only on VAX.
977*/
978#pragma extern_model save
979
980#pragma extern_model strict_refdef "LIB$INITIALIZ" 2, nopic, nowrt
981const int spare[ 8] = { 0 };
982
983#pragma extern_model strict_refdef "LIB$INITIALIZE" 2, nopic, nowrt
984void (*const x_decc_init)() = decc_init;
985
986#pragma extern_model restore
987
988/* Fake reference to ensure loading the LIB$INITIALIZE PSECT. */
989
990#pragma extern_model save
991
992int LIB$INITIALIZE( void);
993
994#pragma extern_model strict_refdef
995int dmy_lib$initialize = (int) LIB$INITIALIZE;
996
997#pragma extern_model restore
998
999#pragma standard
1000
1001#endif /* !defined( __VAX) && (__CRTL_VER >= 70301000) */
1002
1003#endif /* def __CRTL_VER */
1004
1005#endif /* def __DECC */
1006
1007#endif /* VMS */
1008