home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / c-kermit / ckvfio.c < prev    next >
C/C++ Source or Header  |  2020-01-01  |  231KB  |  7,170 lines
  1. #ifndef VMS
  2.       ERROR -- CKVFIO.C is used only on the OpenVMS(tm) Operating System
  3. #endif /* VMS */
  4.  
  5. /* On VAX, define Goofy VAX Type-Cast to obviate /standard = vaxc.
  6.    Otherwise, lame system headers (<atrdef.h>) on VAX cause compiler
  7.    warnings.  (GNU C may define vax but not __VAX.)
  8. */
  9. #ifdef vax
  10. # define __VAX 1
  11. #endif /* def vax */
  12.  
  13. #ifdef __VAX
  14. # define GVTC (unsigned int)
  15. #else /* def __VAX */
  16. # define GVTC
  17. #endif /* def __VAX */
  18.  
  19. #if defined(__ia64) || defined(__ia64__)
  20. # define CKVFIO_OS_ARCH_STRING " OpenVMS(tm) IA64"
  21.  
  22. #else
  23. # if defined(__ALPHA) || defined(__alpha)
  24. #  define CKVFIO_OS_ARCH_STRING " OpenVMS(tm) Alpha(tm)"
  25.          /* do nothing */
  26. #else
  27. # ifdef VAX
  28. #  define CKVFIO_OS_ARCH_STRING " OpenVMS(tm) VAX(tm)"
  29. # else
  30. #  ifdef __GNUC__
  31. #     define CKVFIO_OS_ARCH_STRING " OpenVMS(tm) VAX(tm) (GCC)"
  32. #  else
  33. #     ERROR -- CKVFIO.C unknown architecture - Not VAX ALPHA or IA64
  34. #  endif /* __GNUC__ */
  35. # endif /* VAX */
  36. #endif /* __ALPHA */
  37. #endif /* __IA64 */
  38.  
  39. char *ckzv = "File support, 9.0.184,  28 Jun 2011";
  40. char *ckzsys = CKVFIO_OS_ARCH_STRING;
  41.  
  42. /* C K V F I O  --  Kermit file system support for VAX/VMS.  */
  43.  
  44. /*
  45.   Author: Frank da Cruz <fdc@columbia.edu>
  46.   Columbia University Academic Information Systems, New York City.
  47.  
  48.   Copyright (C) 1985, 2011,
  49.     Trustees of Columbia University in the City of New York.
  50.     All rights reserved.  See the C-Kermit COPYING.TXT file or the
  51.     copyright text in the ckcmai.c module for disclaimer and permissions.
  52. */
  53.  
  54. /*
  55.   Originally adapted to VMS by:
  56.   Stew Rubenstein, Harvard University Chemical Labs, 1985,
  57.   Contributors:
  58.   Frank da Cruz (fdc), Columbia University, New York City (1985-present)
  59.   Terry Kennedy (TMK), St. Peter's College, Jersey City, NJ (1990-present)
  60.   William Bader (WB), Lehigh University, Bethlehem, PA (1990-present)
  61.   Mark Berryman (mb), SAIC (1994-present)
  62.   Lucas Hart (LH), Oregon State U, (1998-present)
  63.   Stew Rubenstein, Harvard University Chemical Labs, Cambridge, MA (1985)
  64.   Martin Minow (MM), Digital Equipment Corporation, Maynard MA (1985) (d.2000)
  65.   Dan Schullman (DS), Digital Equipment Corporation, Maynard MA (1985)
  66.   Mark Buda (MAB), Digital Equipment Corporation, Nashua, NH (1989-90)
  67.   Gary Mussar (GM), Bell-Northern Research, Ottawa, Canada (1991)
  68.   James Sturdevant (JS) (1992)
  69.   Tarjei T. Jensen (ttj), Norwegian Hydrographic Service (1993-94)
  70.   Martin PJ Zinzer (mpjz), Gesellschaft fuer Schwerionenforschung GSI Darmstadt
  71. */
  72. /* Edit history
  73.  * 003 20-Mar-85 MM  fixed fprintf bug in zsout.c
  74.  * 004 21-Mar-84 MM  create text files in variable-stream.
  75.  * 005  8-May-85 MM  filled in zkself (not tested), fixed other minor bugs
  76.  * 006  5-Jul-85 DS  handle version number in zltor, zrtol
  77.  * 007 11-Jul-85 fdc fix zclose() to give return codes
  78.  * 008 19-Mar-86 fdc Fix system() for "!", zopeni() for REMOTE commands.
  79.  * 008 17-Sep-87 fdc Define PWDCMD.
  80.  * 009 (???)
  81.  * 010 24-Jan-88 fdc Add zgtdir() function, even tho it doesn't work...
  82.  * 011 14-Feb-89 mab Make zgtdir() work in V2/V3 C envirements,
  83.  *             Make zkself work using delprc() using Will Wood's changes.
  84.  * 012 26-Feb-89 mab Add function that searches for kermit.ini file in various
  85.  *                   ways
  86.  * 013 05-Mar-89 mab Add Barry Archers enhancements/fixes.
  87.  * 014 15-Mar-89 mab Check for non-null data, not array of pointers in
  88.  *                   zkermini
  89.  * 015 04-Apr-89 mab Add latent support for attribute packet.  Clean up
  90.  *             file name translation code.
  91.  * 016 05-Apr-89 mab Add PWP code to optimize packetizing.
  92.  * 017 16-Apr-89 mab PWP changes broke REMOTE command.  Fixed.
  93.  * 018 18-Apr-89 mab #ifdef chkfn.  This removes a lot of overhead.
  94.  *             Add code to gtdir() for V4.x.
  95.  * 019 12-Jun-89 mab Add PWP's encode logic
  96.  * 020 09-Jul-89 mab Add logic to check for system() availability
  97.  * 021 10-Jul-89 mab Fix SHOW USER USERNAME.  Added space after 'SHOW USER'.
  98.  * 022 27-Sep-89 mab Added zmail/zprint, plus added changes from CKUFIO.C
  99.  * 023 01-Dec-89 mab Add RMS file support
  100.  * 024 20-Jul-90 wb  Add support for old VAX C & VMS versions + zstrip & rename
  101.  * 025 29-Jul-90 tmk Change space command to show avail, not used (match spec)
  102.  * 026 29-Jul-90 tmk Hack out the RMS stuff - it can come back when it works
  103.  * 027 29-Jul-90 tmk Likewise the VMS V3 stuff - ancient history
  104.  * 028 29-Jul-90 tmk Replace the attribute stuff. It now works.
  105.  * 029 31-Jul-90 tmk Fix CWD command (via hack)
  106.  * 030 31-Jul-90 tmk Fix assorted bugs preventing remote commands from working
  107.  * 031 31-Jul-90 tmk Correctly handle interrupted remote commands
  108.  * 032 04-Aug-90 tmk Start work on full RMS support for input files
  109.  * 033 04-Aug-90 tmk Tack LF on end of subprocess output lines
  110.  * 034 04-Aug-90 tmk Complete work on full RMS support for input files
  111.  * 035 04-Aug-90 tmk Add support for Fortran CC, fill in recfm data
  112.  * 036 05-Aug-90 tmk Add trailing CRLF on print format files
  113.  * 037 12-Aug-90 tmk Start work on full RMS support for output files
  114.  * 038 12-Aug-90 tmk Honor first free byte (FFB) on SENDs
  115.  * 039 13-Aug-90 tmk Finished first cut of full RMS support for output files
  116.  * 040 29-Sep-90 tmk Add iswild() from FDC for C-Kermit 5A edit 157
  117.  * 041 06-Oct-90 tmk Add filetype IMAGE support for outbound transfers. Note
  118.  *             that this doesn't currently work as the receiver overrides
  119.  *             it (must talk to fdc).
  120.  * 042 06-Oct-90 tmk Make logfiles MRS=80. Being able to edit them outweighs
  121.  *             any use for un-split lines.
  122.  * 043 17-Oct-90 wb  Make zclosf() remove delete mailboxes & deassign channels
  123.  *                   used to talk to the subprocess, so quotas are not used
  124.  *                   up after repeated mailbox use (installed by fdc).
  125.  * 044 19-Oct-90 fdc Changed zxcmd() to use the fp[] arrays in the normal way,
  126.  *                   and zsyscmd to call zxcmd(ZIFILE) rather than
  127.  *                   zxcmd(ZSYSFN).  Got rid of all calls to system(), used
  128.  *                   zsyscmd() instead, so commands like DIR could be
  129.  *                   interrupted.  Made zoutdump() return(-1) rather than
  130.  *                   exit() when "line too long for buffer", and increased
  131.  *                   line output buffer from 1K to 4K.
  132.  * 045 01-Nov-90 tmk Corrected behavior of error check on $create call so a
  133.  *             file supersede would work properly.
  134.  * 046 01-Nov-90 tmk Clone binary flag to ofile_bmode so we have a consistent
  135.  *             view of this flag during file operations - the binary flag
  136.  *             tends to toggle when we don't want/expect it to.
  137.  * 047 01-Nov-90 tmk Make IMAGE mode work. Note that image mode is only used
  138.  *             when VMS is sending a file, and includes all record
  139.  *             control characters not normally sent. Only useful in
  140.  *             unusual circumstances.
  141.  * 048 01-Nov-90 tmk Remove spurious \n from zsoutl() which caused debug logs
  142.  *             to have spurious <CR>'s when viewed with editors.
  143.  * 049 02-Nov-90 fdc Adapt to dynamic allocation of file i/o buffers.  Changes
  144.  *                   are within #ifdef DYNAMIC..#else..#endif brackets.
  145.  * 050 02-Nov-90 fdc Make zsyscmd() close inferior process.
  146.  * 051 ??-???-?? ??? Add ckermit_init logical, return 0 on wildcard operations.
  147.  * 052 24-Dec-90 tmk Fix performance problems after 32Kb w/ ASCII receives, fix
  148.              2-nulls-per-32Kb in binary mode bug (actually in ckcker.h,
  149.              this is a placeholder).
  150.  * 053 13-Jan-91 tmk Add support for SET FILE RECORD-LENGTH.
  151.  * 054 14-Jan-91 tmk Fix cases of /x/CR/LF/y/ and /x/CR/LF/y/CR/LF/ in ASCII
  152.  *             file receives.
  153.  * 055 16-Jan-91 tmk Log requested file type to debug log when receiving.
  154.  * 056 16-Jan-91 tmk Add support for all zstime() functions.
  155.  * 057 17-Jan-91 tmk Add support for zchkspa() function.
  156.  * 058 17-Jan-91 tmk Move debug() call into if clause in zxpand, per fdc.
  157.  * 059 18-Jan-91 tmk Support remote (DECnet) file accesses.
  158.  * 060 18-Jan-91 tmk Fix READ command.
  159.  * 061 30-Jan-91 tmk Support creation of UNDEFINED file types for brain-dead
  160.  *             BASIC implementation.
  161.  * 062 30-Jan-91 tmk Fix REMOTE commands when VERIFY is set.
  162.  * 063 29-Mar-91 tmk Add padding factor for received text files to accomodate
  163.  *             space taken up by record delimiters (per fdc).
  164.  * 064 29-Mar-91 gm  Remove unnecessary mem-mem moves during ASCII receives.
  165.  *             (Installed by tmk. To back out, #define OLD_WAY).
  166.  * 065 30-Mar-91 tmk First pass at implementing LABELED. Send only, dummy
  167.  *             data records.
  168.  * 066 02-Apr-91 tmk Finish first pass at LABELED. Send VMS filename, attri-
  169.  *             butes. Still need ACL's, "hidden" char. longword, recep-
  170.  *             tion.
  171.  * 067 09-Apr-91 tmk LABELED bugfixes - VMSFILE is 70 bytes, not 74, use the
  172.  *             xab$w_lrl field instead of rab$w_rsz, fab$w_deq instead
  173.  *             of xab$w_rsz, fab$b_bks instead of xab$b_bkz, always pro-
  174.  *             cess an even multiple of 512 bytes when LABELED.
  175.  * 068 14-Apr-91 tmk Don't use C definition of fab$b_journal as it doesn't ex-
  176.  *             ist before C V3.1. Compute it ourselves instead.
  177.  * 069 15-Apr-91 tmk Initial work on retrieving ACL information for LABELED.
  178.  * 070 16-Apr-91 tmk Make edits 066-069 compatible with DECnet.
  179.  * 071 21-May-91 tmk Address R. Weiner QAR item 2 (filesize).
  180.  * 072 21-Jun-91 tmk Check (and prohibit) spawns from captive accounts.
  181.  * 073 21-Jun-91 tmk Fix session logging (for Charlie Luce/DECUServe).
  182.  * 074 21-Jun-91 tmk Rework 071 to only apply to SPAWN/PUSH and not to the
  183.  *             pseudo-builtins like DEL, SPACE, WHO, PWD, etc.
  184.  * 075 21-Jun-91 tmk Fix possible endless loop when flushing output file in
  185.  *             zclosf() after zoutdump() error.
  186.  * 076 21-Jun-91 tmk First pass on handling inbound LABELED files.
  187.  * 077 14-Nov-91 tmk Fix zprint(), zmail() (need to use system() for these).
  188.  *                   This is a partial backout of 044.
  189.  * 078 14-Nov-91 tmk Various cleanups.  Delete files after successful mailing
  190.  *             or printing, remove dead code inside #ifdef COMMENT and
  191.  *                   #ifdef OLD_WAY, fix typo in spawning message, make sure
  192.  *                   all source lines < 80 chars.
  193.  * 079 22-Nov-91 fdc Change zmail(), zprint() error return values to improve
  194.  *             error reporting.
  195.  * 080 18-Jan-92 tmk Fix REMOTE so output from a remote command correctly dis-
  196.  *             plays on terminal. This has been broken since 040 or so.
  197.  * 081 10-Jun-92 tmk Add William Bader's fix for fixed-length files which have
  198.  *                   record attributes.
  199.  * 082 03-Jul-92 tmk Fix really bad bug introduced in 081 (which made *all*
  200.  *                   fixed-format files be sent as text).
  201.  * 083 15-Jul-92 jah Fix fencepost error in zoutdump when line breaks at 32K.
  202.  * 084 03-Aug-92 fdc Remove current directory from init file search.
  203.  * 085 26-Aug-92 tmk Add Bernd Onasch's fix for fgen().
  204.  * 086 28-Aug-92 tmk Fix bug reported by Bill Hoelzer where C-K would execute
  205.  *             a file named "." as a C-K initialization file.
  206.  * 087 04-Sep-92 tmk Fix bug reported by Chuck McMichael where C-K would not
  207.  *             set the FFB properly when receiving a labeled file which
  208.  *             did not have the FFB on a record boundary.
  209.  * 088 09-Sep-92 tmk Fix Hunter Goatley's problem with SPAWN command ignoring
  210.  *             Ctrl-C.
  211.  * 089 11-Sep-92  js Fixed malloc() in zmail().
  212.  * 090 28-Oct-92 tmk Fix null-byte error introduced by 087. Gee, this looked
  213.  *             so simple when I designed it.
  214.  * 091 02-Nov-92 tmk Start work on fixing spawn/push/remote commands, due to
  215.  *             popular whining.
  216.  * 092 03-Nov-92 tmk Finish up initial 091 work. Vote for Kermit!
  217.  * 093 03-Nov-92 fdc Change zkermini() to work with "-y" command-line option.
  218.  * 094 04-Nov-92 tmk Make zxpand() not return all files if given null string.
  219.  * 095 05-Nov-92 fdc Make zxcmd(), zclose(), etc, handle ZRFILE (OPEN !READ).
  220.  * 096 17-Feb-93 fdc prevent zopeno from calling zstime if date struct is NULL,
  221.  *                   and add support for ZMFILE (misc output file).
  222.  * 097 08-Apr-93 tmk Correctly handle "international VMS" which uses <> instead
  223.  *             of [] for directory delimiters.
  224.  * 098 16-May-93 fdc ANSIfication for GNU CC, from James Sturdevant, plus
  225.  *                   add FAB$M_PRN to list of text-file types, for VMS batch
  226.  *                   logs.
  227.  * 099 07-Jun-93 fdc Fix calculation of file size in zchki(), fix declaration
  228.  *                   of mbxnam[] (add one to size) to prevent overflow, which
  229.  *                   would result in failure of server to respond to REMOTE
  230.  *                   directory, etc.  Both fixes from Bill Glass.
  231.  * 100 21-Jun-93 fdc file_date[] and attr_date[] declarations in zstime()
  232.  *                   changed from long to unsigned long to prevent signed date
  233.  *                   comparisons, which could prevent SET FILE COLLISION
  234.  *                   UPDATE from working.  From James Sturdevant.
  235.  * 101  8-Aug-93 fdc Add types to all function declarations.
  236.  * 102 18-Aug-93 ttj Minor updates in zsattr() and do_label_recv() mainly to
  237.  *                   quieten the compiler (which had every reason to complain).
  238.  * 103  5-Nov-93 wb   Add isdir() function.
  239.  * 104  8-Nov-93 wb   Add zfcdate() function.
  240.  * 105 25-Nov-93 fdc  Correct record format for session log; change name of
  241.  *                    password structure member of zattr struct.
  242.  * 106 22-Dec-93 tmk  Correct fd "leakage" in OPEN READ/CLOSE READ pairs.
  243.  * 107 26-Feb-94 mb   Addition of zmkdir() routine.
  244.  * 108 27-Mar-94 tmk  Increase max record size for logs from 80 to 254.
  245.  *                    Add support for file append operations.
  246.  *                    Make zkself() retry a few times to avoid zombies on BYE.
  247.  * 109  5-Apr-94 tmk  Fix xx->lengthk not being set in zsattr().
  248.  * 110  8-Jun-94 tmk  Use private fab in zchki (fixes OPEN READ bug).
  249.  * 111 17-Jun-94 tmk  Let zsattr() work even if there is no rights database.
  250.  * 112  7-Jul-94 js   A couple small ANSIfications for gcc.
  251.  * 113  7-Aug-94 fdc  Make zshcmd()/zsyscmd() return proper return code, with
  252.  *                    help from Larry Henry at TWG.  Still not quite right...
  253.  * 114 29-Sep-94 fdc  Increase max wildcard matches from 500 to 4096.
  254.  * 115  4-Oct-94 mb   Add support for RESEND.
  255.  * 116 26-Oct-94 mb   Minor fix to 115.
  256.  * 117  1-Nov-94 wb   A couple #ifdefs added to allow compilation in VMS v4.
  257.  * 118 25-Feb-95 mpjz Fix for DECC on VAX.
  258.  * 119 11-May-96 fdc  Change znewn() to change version to x+1, or add ;0.
  259.  * 120 31-May-96 fdc  Fix zfnqfp() to remove trailing .; if directory name.
  260.  * 121 12-Jun-96 fdc  Prevent dereferencing null pointer in do_label_recv().
  261.  * 122 23-Jun-96 fdc  Fix a bug in do_label_recv that I introduced in edit 121.
  262.  * 123 21-Aug-96 fdc  Separate ZRFILE from ZIFILE so now we can have both.
  263.  * 124 21-Aug-96 fdc  Fix includes for getenv & strcpy for DECC vs VAXC.
  264.  * 125 25-Aug-96 mpjz More DECC/VAX fixes.
  265.  * 126 05-Sep-96 fdc  Remove #module, remove refs to xaballdef$$_fill_7.
  266.  * 127 06-Sep-96 fdc  Recover from interrupted labeled-mode receives.
  267.  * 128 06-Sep-96 fdc  Recover from the previous edit.
  268.  * 129 06-Sep-96 fdc  Fix zchki() to return -2 if blah.DIR;n is a directory.
  269.  * 130 06-Sep-96 fdc  Fixes to isdir(), zstrip(), zchdir().
  270.  * 131 17-Feb-97 fdc  Another fix to isdir() (free() was called too early).
  271.  * 132 14-Jul-97 fdc  fgen() malloc'd but never freed filenames; isdir()
  272.  *                    now handles directory files too (like [FOO]BAR.DIR;1).
  273.  * 133 14-Jul-97 mb   New isdir() function uses sys$parse().
  274.  * 134 15-Jul-97 fdc  Added cvtdir(); rewrote zchdir() to use it & new isdir().
  275.  * 135 14-Aug-97 fdc  zopeni: Change mainline binary variable when switching
  276.  *                    automatically from text to binary mode (cosmetic only).
  277.  * 136 24-Aug-97 fdc  zhome: Return SYS$LOGIN value rather than HOME value.
  278.  * 137 04-Sep-97 fdc  zchdir: use sys$setddir() rather than chdir() because
  279.  *                    VMS 6.2 CRTL chdir() has bugs.
  280.  * 138 06-Sep-97 fdc  zchdir again -- try one, then the other.  Add startupdir.
  281.  * 139 04-Nov-97 fdc  Handle absolute/relative/standard/literal dir names.
  282.  * 140 12-Dec-97 fdc  Fix fgen() to report directories if not told not to.
  283.  * 141  1-Jan-98 fdc  Send and set file protections: zsattr(), zstime().
  284.  * 142 15-Jan-98 fdc  Raised max number of files (MAXWLD) from 4K to 1024K.
  285.  *                    and made the mtchs[] array dynamic.
  286.  * 143 29-Jan-98 fdc  Make zshcmd() (RUN command) return proper status,
  287.  *                    ditto for zxcmd(), and make both set pexitstat.
  288.  *                    Also, added ckvmserrstr().
  289.  * 144  8-Feb-98 lh   Add diagnostic message when SPAWN fails; handle files
  290.  *                    with odd fixed record length; isdir() improvements.
  291.  * 145  8-Feb-98 fdc  Slightly better handling of failures in zrmdir().
  292.  * 146  3-May-98 fdc  Fix out-of-bounds cdate[] array reference.
  293.  * 147  7-May-98 lh   another isdir() update; expanded mb (Apr-98) version.
  294.  *               lh   Add REL_DIR item for do_label transfers.
  295.  *               lh   FTN CC to handle zero-length records and overprinting.
  296.  *               lh   Fix zltor for fspath and no match.
  297.  *               fdc  Fix zmkdir to return 1 if >0 directories were created.
  298.  * 148 28-Jun-98 fdc  Fix to odd-record-length code from edit 144, which broke
  299.  *                    RESEND/REGET.  Added zgetfs().
  300.  * 149  5-Sep-98 fdc  cdate[] array declaration needed to be 24, not 23.
  301.  * 150 21-Dec-98 fdc  Added zrelname(), zgperm(), and ziperm().
  302.  * 151 26-Jan-99 fdc  nzltor(): convert path format if other Kermit not VMS.
  303.  * 152  8-Feb-99 lh   Fix constructions like "cd sys$manager" in isdir().
  304.  * 153  8-Feb-99 fdc  Add zxrewind(), add support for recursion in fgen(),
  305.  *                    make zgetfs call stat() to get size.
  306.  *                    Fix chkfn() for connection log.
  307.  * 154 17-Mar-99 lh   Add support for sending PRN files.
  308.  * 155 15-Apr-99 fdc  Fix zmkdir() to tolerate long filenames.
  309.  * 156 16-Apr-99 fdc  Add (nonworking) timeout support to get_subprc_line().
  310.  *                    Somebody please look at this routine & fix it.  It's
  311.  *                    supposed to time out and return after 1 second if nothing
  312.  *                    comes from the subprocess, but instead it seems wait
  313.  *                    forever.  To test, put VMS C-K in server mode and then
  314.  *                    tell the client "remote host wait 00:00:30".  VMS C-K
  315.  *                    is supposed to send back an empty data packet every
  316.  *                    second but it doesn't.
  317.  * 157 16-Apr-99 lh   Fix 156.
  318.  * 158 20-Jun-99 fdc  Fix rinfill() to also work with mailboxes.  I don't see
  319.  *                    how OPEN !READ/ READ/ CLOSE READ could ever have worked.
  320.  * 159 22-Jul-99 lh   Add zcopy().
  321.  * 160 23-Jul-99 fdc  Add lots of signed-vs-unsigned char casts.
  322.  * 161 27-Jul-99 lh   Fix sys$synch() call in get_subprc_line().
  323.  * 162 29-Jul-99 lh   Fixed get_subprc_line() keepalive performance.
  324.  * 163 24-Aug-99 fdc  Fix do_label_send() broken by edit 160 (diagnosis by lh).
  325.  * 164 02-Sep-99 fdc  Add nopush checks to zxcmd(), zshcmd(), and zsyscmd().
  326.  * 165 19-Sep-99 lh   Fix zfnqfp() error return (NULL, not -1).
  327.  *                    Subtly alter fgen()'s expansion of wildcards (*.* -> .*).
  328.  * 166 06-Oct-99 lh   Fill in zchko.  Change log file error handling, zopen
  329.  *                    and zclose.  Use parse result to handle <> and rel names
  330.  *                    in zmkdir; cleanup.  Extend nzrtol to handle device spec
  331.  *                    in absolute to relative; more <> dir syntax; no longer
  332.  *                    need absolute for zmkdir.  Convert non-file oriented
  333.  *                    device name to upper case in zfnqfp instead of appending
  334.  *                    cwd; replace multiple strncat calls.  Fix fgen edit 165.
  335.  *                    Fix typo in zrmdir.
  336.  * 167 11-Oct-99 fdc  Replace all strncpy() and most strcpy() by ckstrncpy()
  337.  *                    from ckclib.c.
  338.  * 168 19-Nov-99 fdc  Fix a couple from the previous edit that were wrong.
  339.  * 169 29-Aug-A0 fdc  Fix a couple signed/unsigned conflicts.
  340.  * 170 01-Feb-A2 fdc  Make zkermini() return 1 on success and 0 on failure.
  341.  * 171 27-Apr-A2 fdc  Fix zgetfs() to fail when file doesn't exist.
  342.  * 172 30-Jul-A2 mb   Create a proper zchkpath().
  343.  * 173 24-Oct-A2 fdc  Don't #include <conv$routines.h> ifdef NOCONVROUTINES,
  344.  *                    needed in VMS 6.1 with UCX 4.2.
  345.  * 174 24-Oct-A2 lh   define nam$w_did_num/_seq for VAX C 2.x.
  346.  * 175 28-Oct-A2 fdc  Separate text and binary mode open for session log.
  347.  * 176  3-May-A2 jea  ON_CD support.
  348.  * 177  2-Jul-A2 fdc  #include <ckucmd.h> for prototypes needed by ON_CD.
  349.  * 178 05-Apr-A2 fdc  Add __ia64 arch_string.
  350.  * 179 23-Aug-A5 fdc  Fix nzrtol() for filenames like DEV:FOO.BAR.
  351.  * 180 29-Dec-A5 fdc  Change file-size/offset variables from long to CK_OFF_T.
  352.  * 181 15-Feb-A7 sms  Add zxin() routine.
  353.  * 182 15-Mar-B0 sms  Fix include of stat.h for old VMS's
  354.  *                    Added conditionality on ZCOPY for zcopy().
  355.  *
  356.  *  Note: If it makes sense to look for <conv$routines.h> only
  357.  *  "#ifndef BUGFILL7", then it might make as much sense to require
  358.  *  "#ifndef OLDFIB", too, because OLDFIB seems to apply to even older
  359.  *  compiler environments than BUGFILL7.  But I didn't do that.
  360.  *
  361.  * 183 15-Mar-B0 sms  Added local prototypes for conv$*() functions, to be
  362.  *                    used if <conv$routines.h> is missing (NOCONVROUTINES).
  363.  *                    Changed to use NAML where available, to allow longer
  364.  *                    file names.  New NAMX macros are defined in new
  365.  *                    "ckvrms.h" header file.  Still no serious attempt to
  366.  *                    handle exotic characters in ODS5 extended file names,
  367.  *                    but caret escapes are handled in some places.
  368.  *                    Moved some "#ifdef COMMENT" code for isdir() out of the
  369.  *                    way.  Fixed a case-sensitivity problem in nzltor().
  370.  *                    Changed zrmdir() to use QIO to set directory file
  371.  *                    protection on local files, and delete() to delete them.
  372.  *                    Changed cvtdir() to handle some (any?) non-trivial
  373.  *                    cases, and to stop upcasing the path.
  374.  *                    Removed some type-cast clutter.  Added a crude unit test
  375.  *                    main program ("#ifdef UNIT_TEST").
  376.  */
  377.  
  378. /* Definitions of some VMS system commands */
  379.  
  380. char *DIRCMD = "directory ";        /* For directory listing */
  381. char *DIRCM2 = "directory ";        /* For directory listing, no args */
  382. char *DELCMD = "delete ";        /* For file deletion */
  383. char *TYPCMD = "type ";            /* For typing a file */
  384. char *SPACMD = "show quota ";         /* Space/quota of current directory */
  385. char *SPACM2 = "show quota ";         /* Space/quota of specified dir */
  386. char *WHOCMD = "show users ";        /* For seeing who's logged in */
  387. char *PWDCMD = "show default ";        /* For seeing current directory */
  388.  
  389. /*
  390.   Functions (n is one of the predefined file numbers from ckermi.h):
  391.  
  392.    zopeni(n,name)   -- Opens an existing file for input.
  393.    zopeno(n,name)   -- Opens a new file for output.
  394.    zclose(n)        -- Closes a file.
  395.    zchin(n)         -- Gets the next character from an input file.
  396.    zsout(n,s)       -- Write a null-terminated string to output file, buffered.
  397.    zsoutl(n,s)      -- Like zsout, but appends a line terminator.
  398.    zsoutx(n,s,x)    -- Write x characters to output file, unbuffered.
  399.    zchout(n,c)      -- Add a character to an output file, unbuffered.
  400.    zchki(name)      -- Check if named file exists and is readable, return size.
  401.    zchko(name)      -- Check if named file can be created.
  402.    zchkspa(name,n)  -- Check if n bytes available to create new file, name.
  403.    znewn(name,s)    -- Make a new unique file name based on the given name.
  404.    zdelet(name)     -- Delete the named file.
  405.    zxpand(string)   -- Expands the given wildcard string into a list of files.
  406.    znext(string)    -- Returns the next file from the list in "string".
  407.    zxcmd(n,cmd)     -- Execute the command in a lower fork on file number n.
  408.    zclosf()         -- Close input file associated with zxcmd()'s lower fork.
  409.    zrtol(n1,n2)     -- Convert remote filename into local form.
  410.    zltor(n1,n2)     -- Convert local filename into remote form.
  411.    zchdir(dirnam)   -- Change working directory.
  412.    zhome()          -- Return pointer to home directory name string.
  413.    zkself()         -- Log self out
  414.    zsattr(struc zattr *) -- Return attributes for file which is being sent.
  415.    zkermini(n1,n2)  -- Find kermit.ini using default scanning process
  416.  */
  417.  
  418. /* Includes */
  419.  
  420. #define CKVFIO_C
  421. #include "ckcdeb.h"
  422. #include "ckcasc.h"
  423. #include "ckcker.h"
  424. #ifndef NOSPL
  425. #include "ckuusr.h"                     /* ON_CD: mlook, parser, dodo */
  426. #endif /* NOSPL */
  427. #include "ckvvms.h"
  428. #include "ckvrtl.h"
  429. #include <stdio.h>
  430. #include <types.h>
  431. #include <stat.h>
  432. #include <ctype.h>
  433. #include <time.h>
  434. #include <errno.h>
  435. #include <rms.h>
  436. #include <ssdef.h>
  437. #include <atrdef.h>
  438. #include <descrip.h>
  439. #include <dvidef.h>
  440. #include <dcdef.h>
  441. #include <fibdef.h>
  442. #include <iodef.h>
  443. #include <jpidef.h>
  444. #include <signal.h>
  445. #include <string.h>
  446. #include <stsdef.h>
  447. #include <syidef.h>
  448. #ifndef OLD_VMS
  449. #include <uaidef.h>
  450. #endif  /* OLD_VMS */
  451.  
  452. /* rms.h above includes nam, fab, xab and rmsdef */
  453. /* vms v4 headers do not check against multiple inclusion */
  454. /* ifndefs below prevent multiple declaration of FAB and NAM structs */
  455.  
  456. #ifndef FAB$C_BID
  457. #include <fab.h>            /* These are needed for isdir() */
  458. #endif /* FAB$C_BID */
  459.  
  460. #ifndef NAM$C_BID
  461. #include <nam.h>
  462. #endif /* NAM$C_BID */
  463.  
  464. #ifdef VAXCV2         /* VAX C v2.x nam.h does not define the unions */
  465. #define nam$w_did_num  nam$w_did[0]
  466. #define nam$w_did_seq  nam$w_did[1]
  467. #endif
  468.  
  469. #include <lnmdef.h>
  470. #include <rmsdef.h>
  471.  
  472. #ifndef MAXWLD
  473. #define MAXWLD 102400            /* Maximum wildcard filenames */
  474. #endif /* MAXWLD */
  475.  
  476. /* external def. of things used in buffered file input and output */
  477.  
  478. #ifdef DYNAMIC
  479. extern CHAR *zinbuffer, *zoutbuffer;
  480. #else
  481. extern CHAR zinbuffer[], zoutbuffer[];
  482. #endif /* DYNAMIC */
  483.  
  484. static CHAR rinbuffer[INBUFSIZE], *rinptr;
  485. static int rincnt;
  486. static int lastcount = 0;
  487. static int mtchsinit = 0;
  488.  
  489. extern CHAR *zinptr, *zoutptr;
  490. extern int zincnt, zoutcnt, binary, nopush, rcflag, frecl;
  491. extern long vernum;
  492.  
  493. /* Declarations */
  494.  
  495. FILE *fp[ZNFILS] = {             /* File pointers */
  496.     NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL
  497. };
  498.  
  499. #define VMSVERSIONS
  500.  
  501. int vmssversions = 0;            /* Include version number w/filename */
  502. int vmsrversions = 0;            /* Send and Receive.... */
  503.  
  504. /* Flags for each file indicating whether it is a mailbox */
  505. int ispipe[ZNFILS] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
  506.  
  507. static CK_OFF_T iflen = (CK_OFF_T)-1;    /* Input file length */
  508. static long rflen = -1;
  509. static long oflen = -1;            /* Output file length */
  510. static int fcount = 0;            /* Number of files in wild group */
  511. static int nxpand = 0;            /* Copy of fcount */
  512. static char nambuf[ CKMAXPATH];        /* maximum size of a file spec */
  513. static char cwdbuf[ NAMX_C_MAXRSS];
  514. static struct iosb_struct tmpiosb;    /* For QIOW */
  515.  
  516. extern unsigned int vms_status;        /* Used by CHECK_ERR */
  517. extern unsigned int vms_lasterr;
  518. static int cflag;            /* Flag indicating console in use */
  519.  
  520. int check_spawn(void);
  521. int do_label_recv(void);
  522. int do_label_send(char *name);
  523. int fgen(char *pat, char *resarry[], int len);
  524. static int rinfill(void);
  525.  
  526. #ifdef COMMENT
  527. #ifdef __DECC
  528. #include <stdlib.h>
  529. #else /* def __DECC */
  530. char *getenv(), *strcpy();
  531. #endif /* __DEC [else] */
  532. #else /* def COMMENT */
  533. /* Recommended by Lee Tibbert */
  534. #ifdef __DECC
  535. #include <stdlib.h>
  536. #include <string.h>
  537. #else /* def __DECC */
  538. char *getenv(), *strcpy();
  539. #endif /* def __DECC [else] */
  540. #endif /* def COMMENT [else] */
  541.  
  542. #ifdef __DECC
  543. #include <lib$routines.h>
  544. #include <starlet.h>
  545. #endif /* __DECC */
  546.  
  547. int pexitstat = -2;            /* Process exit status */
  548. unsigned long pexitlong = -2L;        /* ULONG version of same */
  549.  
  550. #ifdef COMMENT
  551. /* static */                /* Not static any more! */
  552. char *mtchs[MAXWLD],            /* Matches found for filename */
  553.   **mtchptr;                /* Pointer to current match */
  554. #else /* def COMMENT */
  555. char **mtchs = NULL, **mtchptr = NULL;
  556. #endif /* def COMMENT [else] */
  557. static unsigned short mbx_chan;        /* Mailbox chan for REMOTE commands */
  558. static int subprocess_input = 0, sub_count;
  559. static char *sub_ptr, sub_buf[SUB_BUF_SIZE];
  560.  
  561. #define PIPETIMEOUT            /* For timing out subprocess reads */
  562. #define    SUPERSAFE            /* For safe subprocesses */
  563.  
  564. static unsigned long sub_pid;
  565.  
  566. /*
  567.  * Structures for input (SEND) file
  568.  */
  569.  
  570. static    struct FAB fab_ifile;        /* For SEND file */
  571. static    struct NAMX nam_ifile;
  572. static    struct RAB rab_ifile;
  573. static    struct XABDAT xabdat_ifile;
  574. static    struct XABFHC xabfhc_ifile;
  575. static    struct XABPRO xabpro_ifile;
  576. static    struct XABALL xaball_ifile;
  577.  
  578. static    int ifile_bmode;        /* For SEND file */
  579. static    int ifile_bcount;
  580. static    char aclbuf[512];
  581. static    unsigned long xuchar = 0;
  582.  
  583. static    struct FAB fab_rfile;        /* For OPEN READ file */
  584. static    struct NAMX nam_rfile;
  585. static    struct RAB rab_rfile;
  586.  
  587. static    struct XABDAT xabdat_rfile;
  588. static    struct XABFHC xabfhc_rfile;
  589. static    struct XABPRO xabpro_rfile;
  590. static    struct XABALL xaball_rfile;
  591.  
  592. static    int rfile_bmode;        /* For READ file */
  593. static    int rfile_bcount;
  594. static    char raclbuf[512];
  595.  
  596. /*
  597.  * Structures for output (RECEIVE) file
  598.  */
  599.  
  600. static    struct FAB fab_ofile;
  601. static    struct NAMX nam_ofile;
  602. static    struct RAB rab_ofile;
  603. static    struct XABDAT xabdat_ofile;
  604. static    struct XABFHC xabfhc_ofile;
  605. static    struct XABPRO xabpro_ofile;
  606. static    struct XABALL xaball_ofile;
  607. static    struct XABRDT xabrdt_ofile;
  608. static    int ofile_dump;
  609. static    int ofile_bmode;
  610. static    int ofile_lblopts;
  611. static    int ofile_lblproc = 0;
  612. static    char revdat[8];
  613. static    unsigned short revnum;
  614.  
  615. static    char ofile_vmsname[CKMAXPATH+1];
  616. static    char ofile_vmsacl[512];
  617. static    int ofile_acllen;
  618. static    short ofile_ffb;
  619.  
  620. /*
  621.  * Structures for miscellaneous is*() functions.
  622.  */
  623.  
  624. static    struct FAB path_fab;
  625. static    struct NAMX path_nam;
  626. static    char path_exp_name[ NAMX_C_MAXRSS];
  627. static    char path_res_name[ NAMX_C_MAXRSS];
  628.  
  629. char startupdir[NAMX_C_MAXRSS+1];
  630.  
  631. /*
  632.  * Common RMS items
  633.  */
  634. static unsigned long int rms_sts;
  635.  
  636.  
  637. #ifdef __DECC
  638.  
  639. /* Get process RMS_DEFAULT values. */
  640.  
  641. /* 2010-03-22 SMS.
  642.  *
  643.  *       get_rms_defaults().
  644.  *
  645.  *    Get user-specified values from (DCL) SET RMS_DEFAULT.  FAB/RAB
  646.  *    items of particular interest are:
  647.  *
  648.  *       fab$w_deq         default extension quantity (blocks) (write).
  649.  *       rab$b_mbc         multi-block count.
  650.  *       rab$b_mbf         multi-buffer count (used with rah and wbh).
  651.  *
  652.  *    Kermit I/O currently seems insensitive to mbc and mbf.
  653.  *
  654.  *    This code was adapted from an access callback routine used in the
  655.  *    Info-ZIP programs, and that's what forced the DEC C requirement.
  656.  *    Practically, the GETJPI stuff will fail even with older DEC C
  657.  *    and/or VMS versions, so it makes some sense to retain the DEC C
  658.  *    conditionality.
  659.  */
  660.  
  661. /* Default RMS parameter values. */
  662.  
  663. #define RMS_DEQ_DEFAULT 16384   /* About 1/4 the max (65535 blocks). */
  664. #define RMS_MBC_DEFAULT 127     /* The max, */
  665. #define RMS_MBF_DEFAULT 2       /* Enough to enable rah and wbh. */
  666.  
  667. /* GETJPI item descriptor structure. */
  668. typedef struct
  669. {
  670.     short buf_len;
  671.     short itm_cod;
  672.     void *buf;
  673.     int *ret_len;
  674. } jpi_item_t;
  675.  
  676. /* Durable storage */
  677.  
  678. static int rms_defaults_known = 0;
  679.  
  680. /* JPI item buffers. */
  681. static unsigned short rms_deq;
  682. static char rms_mbc;
  683. static unsigned char rms_mbf;
  684.  
  685. /* Active RMS item values. */
  686. unsigned short rms_deq_active;
  687. char rms_mbc_active;
  688. unsigned char rms_mbf_active;
  689.  
  690. /* GETJPI item lengths. */
  691. static int rms_deq_len;         /* Should come back 2. */
  692. static int rms_mbc_len;         /* Should come back 1. */
  693. static int rms_mbf_len;         /* Should come back 1. */
  694.  
  695. /* Desperation attempts to define unknown macros.  Probably doomed.
  696.  * If these get used, expect sys$getjpiw() to return %x00000014 =
  697.  * %SYSTEM-F-BADPARAM, bad parameter value.
  698.  * They keep compilers with old header files quiet, though.
  699.  */
  700. #ifndef JPI$_RMS_EXTEND_SIZE
  701. #  define JPI$_RMS_EXTEND_SIZE 542
  702. #endif /* ndef JPI$_RMS_EXTEND_SIZE */
  703.  
  704. #ifndef JPI$_RMS_DFMBC
  705. #  define JPI$_RMS_DFMBC 535
  706. #endif /* ndef JPI$_RMS_DFMBC */
  707.  
  708. #ifndef JPI$_RMS_DFMBFSDK
  709. #  define JPI$_RMS_DFMBFSDK 536
  710. #endif /* ndef JPI$_RMS_DFMBFSDK */
  711.  
  712. /* GETJPI item descriptor set. */
  713.  
  714. struct
  715. {
  716.     jpi_item_t rms_deq_itm;
  717.     jpi_item_t rms_mbc_itm;
  718.     jpi_item_t rms_mbf_itm;
  719.     int term;
  720. } jpi_itm_lst =
  721.  { { 2, JPI$_RMS_EXTEND_SIZE, &rms_deq, &rms_deq_len },
  722.    { 1, JPI$_RMS_DFMBC, &rms_mbc, &rms_mbc_len },
  723.    { 1, JPI$_RMS_DFMBFSDK, &rms_mbf, &rms_mbf_len },
  724.    0
  725. };
  726.  
  727. int get_rms_defaults()
  728. {
  729.     int sts;
  730.  
  731.     sts = sys$getjpiw( 0, 0, 0, &jpi_itm_lst, 0, 0, 0);
  732.     debug(F111, "rms defaults, sts", "", sts);
  733.     if ((sts& STS$M_SEVERITY) != STS$M_SUCCESS)
  734.     {
  735.         /* Failed.  Don't try again. */
  736.         rms_defaults_known = -1;
  737.     }
  738.     else
  739.     {
  740.         /* Fine, but don't come back. */
  741.         rms_defaults_known = 1;
  742.     }
  743.  
  744.     /* Limit the active values according to the RMS_DEFAULT values. */
  745.  
  746.     if (rms_defaults_known > 0)
  747.     {
  748.         /* Set the default values. */
  749.  
  750.         rms_deq_active = RMS_DEQ_DEFAULT;
  751.         rms_mbc_active = RMS_MBC_DEFAULT;
  752.         rms_mbf_active = RMS_MBF_DEFAULT;
  753.  
  754.         /* Default extend quantity.  Use the user value, if set. */
  755.         if (rms_deq > 0)
  756.         {
  757.             rms_deq_active = rms_deq;
  758.             debug(F111, "deq =", "", rms_deq);
  759.         }
  760.  
  761.         /* Default multi-block count.  Use the user value, if set. */
  762.         if (rms_mbc > 0)
  763.         {
  764.             rms_mbc_active = rms_mbc;
  765.             debug(F111, "mbc =", "", rms_mbc);
  766.         }
  767.  
  768.         /* Default multi-buffer count.  Use the user value, if set. */
  769.         if (rms_mbf > 0)
  770.         {
  771.             rms_mbf_active = rms_mbf;
  772.             debug(F111, "mbf =", "", rms_mbf);
  773.         }
  774.     }
  775.     return sts;
  776. }
  777.  
  778. #endif /* def __DECC */
  779.  
  780.  
  781. /*  I S A B S O L U T E  --  Tell if a pathname is absolute (not relative)
  782.  *
  783.  * Returns:
  784.  *   0 if relative (or invalid) path
  785.  *   1 if absolute path
  786.  *
  787.  * 2010-03-22 SMS.
  788.  * This would seem to be a somewhat fuzzy concept on VMS.  For example,
  789.  * is "SYS$DISK:[]" not as relative as "[]"?  We say it's absolute. 
  790.  * What about some other device, like, say, "DUA0:[]"?  We say it's
  791.  * absolute.  Perhaps a check for a real logical name (with a directory
  792.  * spec?) would be more realistic.
  793.  *
  794.  * Old (ckcmai.c) code said relative was anything containing no dev and
  795.  * no dir or "[." (or "<.").  New code here also includes "[-]" and "[]"
  796.  * as relative.  And, it skips caret-escaped ODS5 extended name
  797.  * characters.
  798.  */
  799. int
  800. isabsolute(path) char * path; {
  801.     int i;
  802.     int colon = -1;
  803.     int rc = -1;
  804.  
  805.     for (i = 0; i < strlen( path); i++)
  806.     {
  807.         if (path[ i] == '^')            /* Skip caret-escaped chars. */
  808.         {
  809.             i++;
  810.         }
  811.         else if (path[ i] == ':')       /* Record colon. */
  812.         {
  813.             colon = i;
  814.         }
  815.         else if ((path[ i] == '[') || (path[ i] == '<'))
  816.         {
  817.             /* We call "[." or "[-" or "[]" relative. */
  818.             rc = 0;
  819.             debug(F111, "isabsolute left bracket", path, i);
  820.             if ((path[ i+ 1] != '.') && /* Worst case: [i+1] is NUL. */
  821.                 (path[ i+ 1] != '-') &&
  822.                 (path[ i+ 1] != (path[ i]+ 2)))
  823.             {
  824.                 rc = 1;
  825.             }
  826.             break;                      /* In any case, we know now. */
  827.         }
  828.     }
  829.     if (rc < 0)
  830.     {
  831.         rc = 0;
  832.         if (colon > 0)
  833.         {
  834.             /* Colon (device or logical) with no directory. */
  835.             /* We treat both as absolute, although this may make little
  836.              * sense for a directory-free device (or logical) name.
  837.              */
  838.             debug(F111, "isabsolute logical", path, colon);
  839.             rc = 1;
  840.         }
  841.     }
  842.     debug(F101, "isabsolute rc", "", rc);
  843.     return rc;
  844. }
  845.  
  846. /* For the record, old VMS isabsolute() code from ckcmai.c. */
  847. #ifdef COMMENT
  848.  
  849. /* Tell if a pathname is absolute (versus relative) */
  850. /* This should be parceled out to each of the ck*fio.c modules... */
  851. int
  852. isabsolute(path) char * path; {
  853.     int rc = 0;
  854.     int x;
  855.     if (!path)
  856.       return(0);
  857.     if (!*path)
  858.       return(0);
  859.     x = (int) strlen(path);
  860.     debug(F111,"isabsolute",path,x);
  861. #ifdef VMS
  862.     rc = 0;
  863.     x = ckindex("[",path,0,0,0);        /* 1-based */
  864.     if (!x)
  865.        x = ckindex("<",path,0,0,0);
  866.     debug(F111,"isabsolute left bracket",path,x);
  867.     if (!x) {
  868.         x = ckindex(":",path,-1,1,1);
  869.         if (x)
  870.           debug(F111,"isabsolute logical",path,x);
  871.     }
  872.     if (x > 0)
  873.       if (path[x] != '.')               /* 0-based */
  874.         rc = 1;
  875. #else
  876. [...]
  877. #endif /* VMS */
  878.     debug(F101,"isabsolute rc","",rc);
  879.     return(rc);
  880. }
  881.  
  882. #endif /* def COMMENT */
  883.  
  884.  
  885. #ifdef CK_TMPDIR
  886.  
  887. /*  I S D I R  --  Tells if string pointer s is the name of a directory. */
  888. /*
  889.    Returns:
  890.     0 if s is not a directory or doesn't exist
  891.     Nonzero if it is a directory:
  892.       1 if the string is a directory specification, e.g., [FOO.BAR]
  893.       2 if it is the name of a directory file, like [FOO]BAR.DIR;1
  894. */
  895.  
  896. /*  Searching for a file ".;" in the specified directory handles both local
  897.  *  and DECNET references and determines whether a ".DIR;1" file is indeed
  898.  *  a directory. No test is performed for multiple directories matching a
  899.  *  wildcard expansion; cmifi2 does that after a isdir call.
  900.  */
  901.  
  902. /* Mark Berryman's version.  See (far) below for (old) FDC version. */
  903.  
  904. int
  905. isdir(path) char *path; {
  906.     unsigned int retval, status, srch_lst;
  907.     const char *directory_type_l = ".dir";      /* Use case-insensitive */
  908.     const char *directory_type_u = ".DIR";      /* compare below, instead? */
  909.     char ch;
  910.  
  911.     path_fab = cc$rms_fab;                      /* Initialize FAB. */
  912.     path_nam = CC_RMS_NAMX;                     /* Initialize NAM[L]. */
  913.     path_fab.FAB_L_NAMX = &path_nam;            /* Point FAB to NAM[L]. */
  914.  
  915.     /* Install the path argument in the FAB or NAML. */
  916. #ifdef NAML$C_MAXRSS
  917.     path_fab.fab$l_dna = (char *) -1;   /* Using NAML for default name. */
  918.     path_fab.fab$l_fna = (char *) -1;   /* Using NAML for file name. */
  919. #endif /* def NAML$C_MAXRSS */
  920.     FAB_OR_NAML( path_fab, path_nam).FAB_OR_NAML_FNA = path;
  921.     FAB_OR_NAML( path_fab, path_nam).FAB_OR_NAML_FNS = strlen( path);
  922.  
  923.     path_nam.NAMX_L_ESA = (char *) &path_exp_name;
  924.     path_nam.NAMX_B_ESS = sizeof( path_exp_name);
  925.     path_nam.NAMX_L_RSA = (char *) &path_res_name;
  926.     path_nam.NAMX_B_RSS = sizeof( path_res_name);
  927.  
  928.     path_nam.NAMX_B_NOP = NAMX_M_SRCHXABS | NAMX_M_NOCONCEAL;
  929.                                          /* remote node DISPLAY w/o OPEN */
  930.                                           /* show physical device & root */
  931.     retval = 1;                             /* default type return value */
  932.  
  933. /* PARSE the string */
  934.     status = sys$parse(&path_fab,0,0);
  935.     if (!(status & 1)) {          /* any $PARSE errors are fatal */
  936.         debug(F111,"isdir $PARSE", path, status);
  937.         vms_lasterr = status;
  938.         return (0);
  939.     }
  940.  
  941. /* a directory may be specified as "lnm:foo.dir". Do a $SEARCH to traverse
  942.  * a search list logical and locate the file;  pass on the resultant name
  943.  * to determine whether the file is a directory file.
  944.  */
  945.     srch_lst = path_nam.NAMX_L_FNB & NAMX_M_SEARCH_LIST;
  946.     if (srch_lst && ((path_nam.NAMX_B_NAME + path_nam.NAMX_B_TYPE) != 1)) {
  947.         status = sys$search(&path_fab,0,0);
  948.         if (!(status & 1)) {
  949.             vms_lasterr = status;
  950.             debug(F101,"isdir srch_lst status", "", status);
  951.             return(0);
  952.         }
  953.         *(path_nam.NAMX_L_VER + path_nam.NAMX_B_VER) = '\0';
  954.         debug(F110, "isdir srch_lst result", path_nam.NAMX_L_NODE,0);
  955.     }
  956.  
  957. /* Was a file name given ? */
  958.  
  959.     if (path_nam.NAMX_B_NAME == 0) {
  960.         if (path_nam.NAMX_B_TYPE != 1)
  961.       return(0);
  962.  
  963. /* Parse returns a file name of ".;" if no filename is given.  However,
  964.  * that is a valid filename.  Testing gets complicated; the following
  965.  * will not catch the case of such a file name passed as a logical,
  966.  * but will otherwise return(0) when given a file name as "." or ";"
  967.  */
  968.         if (*path_nam.NAMX_L_DIR == '[' )
  969.       ch = ']';
  970.         else
  971.       ch = '>';
  972.         if (strchr(path,ch)) {        /* directory in path */
  973.             if (*(strchr(path,ch)+1) == '.' ||
  974.                 *(strchr(path,ch)+1) == ';'    ) {
  975.                 debug(F111,"isdir file w/ zero length name" ,path, 0);
  976.                 return(0);
  977.             }
  978.         } else {                        /* no directory specification */
  979.             if (strchr(path, '.') || strchr(path, ';') )
  980.               return(0);
  981.         }
  982.         if (srch_lst) return(retval);  /* already did the SEARCH for ".;" */
  983.     } else {
  984.  
  985. /* If a filename was in the path, a directory will only be something.dir */
  986. /* Check to see if a directory was specified as a filename.
  987.    This is done as follows:
  988.     a) The result of the parse has been returned in a string pointed
  989.        to by path_nam.nam$l_esa in the form of device:[dir.dir]name.type;
  990.        nam$l_dev ==> start of device
  991.        nam$l_dir ==> first [
  992.        nam$l_name ==> first char after closing ]
  993.        nam$l_type ==> period between name and type
  994.        nam$l_ver ==> the semicolon
  995.     b) NUL-terminate the TYPE by replacing the ; with a NUL
  996.     c) Make sure TYPE is .DIR
  997.     d) replace the closing ] with a .
  998.     e) replace the . that starts the file TYPE with a ]
  999.     f) reparse
  1000. */
  1001.         *path_nam.NAMX_L_VER = '\0';    /* zero terminate file TYPE */
  1002.     if ((!strcmp(path_nam.NAMX_L_TYPE, directory_type_u)) ||
  1003.      (!strcmp(path_nam.NAMX_L_TYPE, directory_type_l))) {
  1004.         *path_nam.NAMX_L_TYPE = *(path_nam.NAMX_L_NAME-1); /* copy the ] */
  1005.         *(path_nam.NAMX_L_NAME-1) = '.';        /* then change to . */
  1006.             /* Point FAB_OR_NAML to result. */
  1007.             FAB_OR_NAML( path_fab, path_nam).FAB_OR_NAML_FNA =
  1008.              path_nam.NAMX_L_NODE;
  1009.             FAB_OR_NAML( path_fab, path_nam).FAB_OR_NAML_FNS =
  1010.              path_nam.NAMX_L_TYPE+ 1- path_nam.NAMX_L_NODE;
  1011.  
  1012.         status = sys$parse(&path_fab,0,0);        /* parse new string */
  1013.             if (!(status & 1)) {
  1014.                 debug(F111,"isdir second $PARSE", path, status);
  1015.                 vms_lasterr = status;
  1016.                 return (0);
  1017.             }
  1018.         retval = 2;
  1019.         } else
  1020.       return(0);            /* non-directory filename specified */
  1021.     }
  1022.  
  1023. /* Access the directory */
  1024.  
  1025.     status = sys$search(&path_fab,0,0);
  1026.     if (!((status == RMS$_FNF) || (status & 1))) {
  1027.     switch (status) {
  1028.       case RMS$_DNF:
  1029.         debug(F100,"isdir SEARCH RMS$_DNF", "", 0);
  1030.         break;
  1031.       case RMS$_FND:
  1032.         if (path_fab.fab$l_stv == SS$_BADIRECTORY) {
  1033.         debug(F100,"isdir .DIR file not a directory", "" ,0);
  1034.         break;
  1035.         } else {
  1036.         debug(F101,"isdir directory access RMS$_FND stv","",
  1037.               path_fab.fab$l_stv);
  1038.         vms_lasterr = status;
  1039.         break;
  1040.         }
  1041.       default:
  1042.         retval = 0;
  1043.         debug(F101,"isdir $SEARCH status","", status);
  1044.         vms_lasterr = status;
  1045.         }
  1046.         return(0);
  1047.     }
  1048.     *(path_nam.NAMX_L_VER + path_nam.NAMX_B_VER) = '\0';
  1049.     debug(F110,"isdir final string", path_nam.NAMX_L_NODE, 0);
  1050.     debug(F101,"isdir directory code","",retval);
  1051.     return(retval);
  1052. }
  1053. #endif /* CK_TMPDIR */
  1054.  
  1055.  
  1056. /*  I S W I L D  --  Tells whether filespec "str" is wild  */
  1057. /*  Returns 0 if not wild, 1 if wild */
  1058.  
  1059. int
  1060. iswild(path) char *path; {
  1061.     char c;
  1062.     int status;
  1063.  
  1064.     if (!path) return(0);
  1065.  
  1066.     path_fab = cc$rms_fab;                      /* Initialize FAB. */
  1067.     path_nam = CC_RMS_NAMX;                     /* Initialize NAM[L]. */
  1068.     path_fab.FAB_L_NAMX = &path_nam;            /* Point FAB to NAM[L]. */
  1069.  
  1070.     /* Install the path argument in the FAB or NAML. */
  1071. #ifdef NAML$C_MAXRSS
  1072.     path_fab.fab$l_dna = (char *) -1;   /* Using NAML for default name. */
  1073.     path_fab.fab$l_fna = (char *) -1;   /* Using NAML for file name. */
  1074. #endif /* def NAML$C_MAXRSS */
  1075.     FAB_OR_NAML( path_fab, path_nam).FAB_OR_NAML_FNA = path;
  1076.     FAB_OR_NAML( path_fab, path_nam).FAB_OR_NAML_FNS = strlen( path);
  1077.  
  1078.     path_nam.NAMX_L_ESA = (char *) &path_exp_name;
  1079.     path_nam.NAMX_B_ESS = sizeof( path_exp_name);
  1080.     path_nam.NAMX_L_RSA = (char *) &path_res_name;
  1081.     path_nam.NAMX_B_RSS = sizeof( path_res_name);
  1082.  
  1083.     path_nam.NAMX_V_SYNCHK = 1;            /* SYNTAX_ONLY. */
  1084.     status = sys$parse( &path_fab);
  1085.     if (!(status & 1)) {          /* any $PARSE errors are fatal */
  1086.         debug(F111,"iswild $PARSE", path, status);
  1087.         vms_lasterr = status;
  1088.         return 0;
  1089.     }
  1090.  
  1091.     /* Note that we also have these specific flags available:
  1092.      *     nam$v_wild_ver  : Version contained a wild card.
  1093.      *     nam$v_wild_type : Type contained a wild card,
  1094.      *     nam$v_wild_name : Name contained a wild card.
  1095.      *     nam$v_wild_dir  : Directory spec included a wild card.
  1096.      *     and a host of others.
  1097.      * This one is claimed to be "inclusive or of other wild card bits".
  1098.      */
  1099.     return path_nam.NAMX_V_WILDCARD;
  1100. }
  1101.  
  1102.  
  1103. #ifdef COMMENT          /* Replaced by sys$parse() code, above. */
  1104. int
  1105. iswild(str) char *str; {
  1106.     char c;
  1107.     if (!str) return(0);
  1108.     /* Should also check for [dir...] */
  1109.     while ((c = *str++) != '\0')
  1110.       if (c == '*' || c == '%') return(1);
  1111.     return(0);
  1112. }
  1113. #endif /* def COMMENT */
  1114.  
  1115.  
  1116. /*  Z K S E L F  --  Log self out.  */
  1117.  
  1118. int
  1119. zkself() {
  1120.     int i;
  1121.     unsigned long int rms_s;
  1122. /*
  1123.   We need a better way.  If C-Kermit was spawned, this does not log out the
  1124.   whole job.    It also does not hang up LAT terminal sessions.
  1125. */
  1126.     for (i = 0; i < 10; i++) {
  1127.     rms_s = sys$delprc(0,0);    /* Maybe some output is still */
  1128.     if (!(rms_s & 1)) vms_lasterr = rms_s;
  1129.     debug(F101,"zkself rms_s","",rms_s);
  1130.     if (rms_s == SS$_NORMAL)    /* queued; try a few times... */
  1131.       exit(1);
  1132.     sleep(1);
  1133.     }
  1134.     exit(rms_s == SS$_NORMAL);
  1135.     return(0); /* dummy - required as this is called in a non-void context */
  1136. }
  1137.  
  1138. /*  Z O P E N I  --  Open an existing file for input. */
  1139.  
  1140. int
  1141. zopeni(n,name) int n; char *name; {
  1142.     debug(F111,"zopeni",name,n);
  1143.     debug(F101,"zopeni fp","",(int) fp[n]);
  1144.     if (chkfn(n)) return(0);
  1145.     ispipe[n] = 0;
  1146.     if (n == ZSYSFN) {            /* Input from a system function? */
  1147.     debug(F110,"zopeni called with ZSYSFN, failing!",name,0);
  1148.     *nambuf = '\0';            /* No filename. */
  1149.     return(0);            /* fail. */
  1150.     }
  1151.     zincnt = 0;                /* Initializing these couldn't hurt */
  1152.     zinptr = zinbuffer;
  1153.     if (n == ZSTDIO) {            /* Standard input? */
  1154.     if (isatty(0)) {
  1155.         ermsg("?Terminal input not allowed\n");
  1156.         debug(F110,"zopeni attempted input from unredirected stdin","",0);
  1157.         return(0);
  1158.     }
  1159.     fp[ZIFILE] = stdin;
  1160.     return(1);
  1161.     }
  1162. /*
  1163.  * We open the file but waffle on the access mode we're going to use. We then
  1164.  * inspect the file characteristics to see if the organization is fixed or un-
  1165.  * defined. If it is, we convert to block mode operation. This is needed since
  1166.  * VMS maintains a "first free byte" field to tell us how much of the last rec-
  1167.  * ord really contains data, but won't terminate reads at that point. Thus, if
  1168.  * we want to SEND the exact same file we RECEIVEd, we have to honor the FFB
  1169.  * internally.
  1170.  */
  1171.     if (n == ZIFILE) {
  1172.     ifile_bmode = 0;        /* 0 = not binary */
  1173.     ifile_bcount = 0;
  1174.     fab_ifile = cc$rms_fab;                 /* Initialize FAB. */
  1175.     nam_ifile = CC_RMS_NAMX;                /* Initialize NAM[L]. */
  1176.     fab_ifile.FAB_L_NAMX = &nam_ifile;      /* Point FAB to NAM[L]. */
  1177.     fab_ifile.fab$b_fac = FAB$M_BRO | FAB$M_GET;
  1178. /*
  1179.  * Some non-VMS DECnet implementations don't allow switching modes, so set
  1180.  * block-I/O only mode if the user said SET FILE TYPE IMAGE or LABELED.
  1181.  */
  1182.     if (binary == XYFT_I || binary == XYFT_L)
  1183.       fab_ifile.fab$b_fac = FAB$M_BIO | FAB$M_GET;
  1184.  
  1185.     /* Install the path name in the FAB or NAML. */
  1186. #ifdef NAML$C_MAXRSS
  1187.     fab_ifile.fab$l_dna = (char *) -1;  /* Using NAML for default name. */
  1188.     fab_ifile.fab$l_fna = (char *) -1;  /* Using NAML for file name. */
  1189. #endif /* def NAML$C_MAXRSS */
  1190.     FAB_OR_NAML( fab_ifile, nam_ifile).FAB_OR_NAML_FNA = name;
  1191.     FAB_OR_NAML( fab_ifile, nam_ifile).FAB_OR_NAML_FNS = strlen( name);
  1192.  
  1193.     fab_ifile.fab$l_xab = (char *)&xabdat_ifile;
  1194.     rab_ifile = cc$rms_rab;
  1195.     rab_ifile.rab$l_fab = &fab_ifile;
  1196.     xabdat_ifile = cc$rms_xabdat;
  1197.     xabdat_ifile.xab$l_nxt = (char *)&xabfhc_ifile;
  1198.     xabfhc_ifile = cc$rms_xabfhc;
  1199.     xabfhc_ifile.xab$l_nxt = (char *)&xabpro_ifile;
  1200.     xabpro_ifile = cc$rms_xabpro;
  1201.     memset(&aclbuf, 0, sizeof(aclbuf));
  1202.     xabpro_ifile.xab$l_aclsts = SS$_NORMAL;        /* Oh Joy! DECnet */
  1203.     xabpro_ifile.xab$l_aclbuf = (char *)&aclbuf;
  1204.     xabpro_ifile.xab$w_aclsiz = sizeof(aclbuf);
  1205.     xabpro_ifile.xab$l_aclctx = 0;
  1206.     xabpro_ifile.xab$l_nxt = (char *)&xaball_ifile;
  1207.     xaball_ifile = cc$rms_xaball;
  1208.  
  1209.     rms_sts = sys$open(&fab_ifile);
  1210.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  1211.     if (rms_sts != RMS$_NORMAL) {
  1212.         debug(F101,"zopeni $open failed, status","",rms_sts);
  1213.         debug(F101,"zopeni $open failed, stv","",fab_ifile.fab$l_stv);
  1214.         return(0);
  1215.     }
  1216.     if (!(xabpro_ifile.xab$l_aclsts & 1)) {
  1217.         if (xabpro_ifile.xab$l_aclsts != SS$_ACLEMPTY) {
  1218.         debug(F101,"zopeni $open ACL failed, status","",
  1219.           xabpro_ifile.xab$l_aclsts);
  1220.         return(0);
  1221.         }
  1222.     }
  1223.  
  1224. /* We have the file opened. See if it's fixed or undefined format... */
  1225.  
  1226.     iflen = ((xabfhc_ifile.xab$l_ebk-1)*512)+xabfhc_ifile.xab$w_ffb;
  1227.     if (fab_ifile.fab$b_rfm == FAB$C_UDF) {
  1228.         debug(F100,"zopeni undefined file format - using blk I/O","",0);
  1229.         ifile_bmode = 1;
  1230.     }
  1231.     if (fab_ifile.fab$b_rfm == FAB$C_FIX) {
  1232.         if ((fab_ifile.fab$b_rat & (FAB$M_FTN | FAB$M_CR | FAB$M_PRN))
  1233.         == 0) {
  1234. /* But it may be changed later, for BINARY mode and odd record length */
  1235.         debug(F100,"zopeni fixed file format - using blk I/O","",0);
  1236.         ifile_bmode = 1;
  1237.         }
  1238.       }
  1239.     debug(F101,"zopeni binary flag at open","",binary);
  1240.     if (binary == XYFT_I) {
  1241.         debug(F100,"zopeni using IMAGE mode by user request","",0);
  1242.         ifile_bmode = 1;
  1243.     }
  1244.     if (binary == XYFT_L) {
  1245.         debug(F100,"zopeni using LABELED mode by user request","",0);
  1246.         ifile_bmode = 2;
  1247.     }
  1248.     debug(F101,"zopeni ifile_bmode","",ifile_bmode);
  1249.     debug(F101,"zopeni binary","",binary);
  1250.     if (ifile_bmode == 1 && binary == XYFT_T) {
  1251.         debug(F100,"zopeni autoswitch from TEXT to BINARY","",0);
  1252.         binary = XYFT_B;
  1253.     } else if (ifile_bmode == 0 && binary == XYFT_B) {
  1254.         debug(F100,"zopeni autoswitch from BINARY to TEXT","",0);
  1255.         binary = XYFT_T;
  1256.     }
  1257. /*
  1258.  * In BINARY mode, for the case of fixed record length format with odd
  1259.  * length records, use record i/o to suppress the RMS NUL pad ala Kermit-32
  1260.  */
  1261.     if ((fab_ifile.fab$b_rfm == FAB$C_FIX) &&
  1262.         (fab_ifile.fab$w_mrs & 1) && /* was "(...mrs | 1)" oops! */
  1263.         (binary == XYFT_B)) {
  1264.         ifile_bmode = 0;
  1265.  
  1266.         /* WARNING: setting ifile_bmode = 0 here can break RESEND */
  1267.         /* (but only for odd-record length fixed-block files) */
  1268.  
  1269.         debug(F100,"zopeni record i/o for BINARY, Odd Fixed RL","",0);
  1270.           }
  1271.     rab_ifile.rab$l_rop = 0;
  1272.     rms_sts = sys$connect(&rab_ifile);
  1273.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  1274.     if (rms_sts != RMS$_NORMAL) {
  1275.         debug(F101,"zopeni $connect failed, status","",rms_sts);
  1276.         return(0);
  1277.     }
  1278.     debug(F100,"zopeni RMS operations completed ok","",0);
  1279.     fp[n] = fopen("NLA0:","r");    /* it wants a fp, give it one */
  1280.     zincnt = 0;            /* reset input buffer */
  1281.     if (binary == XYFT_L)
  1282.         do_label_send(name);    /* make a file label */
  1283.     return(1);
  1284.     } else if (n == ZRFILE) {        /* READ file */
  1285.     rfile_bmode = 0;
  1286.     rfile_bcount = 0;
  1287.     fab_rfile = cc$rms_fab;                 /* Initialize FAB. */
  1288.     nam_rfile = CC_RMS_NAMX;                /* Initialize NAM[L]. */
  1289.     fab_rfile.FAB_L_NAMX = &nam_rfile;      /* Point FAB to NAM[L]. */
  1290.  
  1291.         /* Always READ in text mode */
  1292.     fab_rfile.fab$b_fac = FAB$M_BRO | FAB$M_GET;
  1293.  
  1294.     /* Install the path name in the FAB or NAML. */
  1295. #ifdef NAML$C_MAXRSS
  1296.     fab_rfile.fab$l_dna = (char *) -1;  /* Using NAML for default name. */
  1297.     fab_rfile.fab$l_fna = (char *) -1;  /* Using NAML for file name. */
  1298. #endif /* def NAML$C_MAXRSS */
  1299.     FAB_OR_NAML( fab_rfile, nam_rfile).FAB_OR_NAML_FNA = name;
  1300.     FAB_OR_NAML( fab_rfile, nam_rfile).FAB_OR_NAML_FNS = strlen( name);
  1301.  
  1302.     fab_rfile.fab$l_xab = (char *)&xabdat_rfile;
  1303.     rab_rfile = cc$rms_rab;
  1304.     rab_rfile.rab$l_fab = &fab_rfile;
  1305.     xabdat_rfile = cc$rms_xabdat;
  1306.     xabdat_rfile.xab$l_nxt = (char *)&xabfhc_rfile;
  1307.     xabfhc_rfile = cc$rms_xabfhc;
  1308.     xabfhc_rfile.xab$l_nxt = (char *)&xabpro_rfile;
  1309.     xabpro_rfile = cc$rms_xabpro;
  1310.     memset(&raclbuf, 0, sizeof(raclbuf)); /* Do we need this for READ? */
  1311.     xabpro_rfile.xab$l_aclsts = SS$_NORMAL; /* Oh Joy! DECnet */
  1312.     xabpro_rfile.xab$l_aclbuf = (char *)&raclbuf;
  1313.     xabpro_rfile.xab$w_aclsiz = sizeof(raclbuf);
  1314.     xabpro_rfile.xab$l_aclctx = 0;
  1315.     xabpro_rfile.xab$l_nxt = (char *)&xaball_rfile;
  1316.     xaball_rfile = cc$rms_xaball;
  1317.  
  1318.     rms_sts = sys$open(&fab_rfile);
  1319.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  1320.     if (rms_sts != RMS$_NORMAL) {
  1321.         debug(F101,"zopeni $open ZRFILE failed, status","",rms_sts);
  1322.         debug(F101,"zopeni $open ZRFILE failed, stv","",
  1323.           fab_rfile.fab$l_stv);
  1324.         return(0);
  1325.     }
  1326. #ifdef COMMENT                /* who needs it */
  1327.     if (!(xabpro_rfile.xab$l_aclsts & 1)) {
  1328.         if (xabpro_rfile.xab$l_aclsts != SS$_ACLEMPTY) {
  1329.         debug(F101,"zopeni $open ACL failed, status","",
  1330.           xabpro_rfile.xab$l_aclsts);
  1331.         return(0);
  1332.         }
  1333.     }
  1334. #endif /* COMMENT */
  1335.  
  1336. /* We have the file opened. See if it's fixed or undefined format... */
  1337.  
  1338.     rflen = ((xabfhc_rfile.xab$l_ebk-1)*512)+xabfhc_rfile.xab$w_ffb;
  1339.     if (fab_rfile.fab$b_rfm == FAB$C_UDF) {
  1340.         debug(F100,"zopeni ZRFILE undefined file format - fail","",0);
  1341.         return(0);
  1342.     }
  1343.     if (fab_rfile.fab$b_rfm == FAB$C_FIX) {
  1344.         if ((fab_rfile.fab$b_rat & (FAB$M_FTN | FAB$M_CR | FAB$M_PRN))
  1345.         == 0) {
  1346.         debug(F100,"zopeni ZRFILE fixed file format - fail","",0);
  1347.         return(0);
  1348.         }
  1349.       }
  1350.     rab_rfile.rab$l_rop = 0;
  1351.     rms_sts = sys$connect(&rab_rfile);
  1352.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  1353.     if (rms_sts != RMS$_NORMAL) {
  1354.         debug(F101,"zopeni $connect failed, status","",rms_sts);
  1355.         return(0);
  1356.     }
  1357.     debug(F100,"zopeni RFILE RMS operations completed ok","",0);
  1358.     fp[n] = fopen("NLA0:","r");    /* it wants a fp, give it one */
  1359.     rincnt = 0;            /* reset input buffer */
  1360.     return(1);
  1361.     }
  1362.     zincnt = 0;                /* Reset input buffer */
  1363.     fp[n] = fopen(name,"r");        /* Real file. */
  1364.     debug(F111,"zopeni", name, (int) fp[n]);
  1365.     if (fp[n] == NULL) perror("zopeni");
  1366.     return((fp[n] != NULL) ? 1 : 0);
  1367. }
  1368.  
  1369. /*  Z O P E N O  --  Open a new file for output.  */
  1370.  
  1371. char * ckvmserrstr(unsigned long);
  1372.  
  1373. int
  1374. zopeno(n,name,zz,fcb)
  1375.     int n; char *name; struct zattr *zz; struct filinfo *fcb; {
  1376. /*
  1377.   As of Version 5A, the attribute structure and the file information
  1378.   structure are included in the arglist.
  1379. */
  1380.     int x;
  1381.     int fildes;
  1382.     int writeover = 0;
  1383.     extern int rs_len;
  1384.     char p[4];
  1385.  
  1386.     debug(F111,"zopeno",name,n);
  1387.     x = chkfn(n);
  1388.     debug(F101,"zopeno chkfn","",x);
  1389.     if (x != 0)
  1390.       return(0);
  1391.     ispipe[n] = 0;
  1392.     zoutcnt = 0;            /* Reset output buffer */
  1393.     zoutptr = zoutbuffer;
  1394.     cflag = 0;                /* Default to not using console */
  1395.     ofile_lblproc = 0;
  1396.  
  1397.     /* Open terminal or STDIO */
  1398.  
  1399.     if ((n == ZCTERM) || (n == ZSTDIO)) {
  1400.     fp[ZOFILE] = stdout;
  1401.     cflag = 1;            /* Say using console */
  1402.     debug(F101,"zopeno fp[]=stdout", "", (int) fp[n]);
  1403.     return(1);
  1404.     }
  1405. /*
  1406.   Open Debug, Transaction, Packet, Session logfile, or a Write file.
  1407.   The only other possibility at this point is the output file, so we test that.
  1408. */
  1409. #ifdef DEBUG
  1410.     if (deblog) {
  1411.     if (fcb)
  1412.       debug(F101,"zopeno fcb disposition", "", fcb->dsp);
  1413.     if (zz)
  1414.       debug(F111,"zopeno zz disposition",zz->disp.val,zz->disp.len);
  1415.     }
  1416. #endif /* DEBUG */
  1417.     if (n != ZOFILE) {
  1418.     strcpy(p,"w");                /* Assume write/create mode */
  1419.     if (fcb) {                /* If called with an FCB... */
  1420.         if (fcb->dsp == XYFZ_A)        /* Does it say Append? */
  1421.         strcpy(p,"a");            /* Yes. */
  1422.     }
  1423.  
  1424. /* Note: don't add "ctx=rec", "shr=get" here - it slows writes to a crawl */
  1425.  
  1426.     if (n != ZSFILE) {
  1427.         /* was mrs = 80; 254 is max record size for EDT */
  1428.         fp[n] = fopen(name, p, "rat=cr", "rfm=var", "mrs=254");
  1429.     } else {            /* Session Log */
  1430.         extern int sessft;        /* Type */
  1431.         if (sessft == XYFT_T) {    /* Text */
  1432.         fp[n] = fopen(name, p, "ctx=stm", "rat=cr", "rfm=stmlf");
  1433.         } else {            /* Binary */
  1434.         fp[n] = fopen(name, p, "ctx=bin", "rat=none",
  1435.                            "rfm=fix", "mrs=512");
  1436.         }
  1437.     }
  1438.     if (fp[n] == NULL) {        /* Failed */
  1439.             if (errno == EVMSERR) {
  1440.             debug(F111,"zopeno fopen failed vaxc$errno",name,vaxc$errno);
  1441.                 if (vaxc$errno == RMS$_SYN)
  1442.                   printf("?fopen file name syntax error : %s\n", name);
  1443.                 else
  1444.                   printf("?fopen failed %s : %s\n",name,
  1445.                          ckvmserrstr(vaxc$errno));
  1446.             } else {
  1447.             debug(F111,"zopeno fopen failed errno",name,errno);
  1448.                 perror(name);
  1449.             }
  1450.     } else {            /* Didn't fail */
  1451.         debug(F100,"zopeno fopen ok", "", 0);
  1452.     }
  1453.     return((fp[n] != NULL) ? 1 : 0);
  1454.     }
  1455.  
  1456. /* Open a file to store data being RECEIVEd */
  1457.  
  1458.     if (n == ZOFILE) {
  1459. #ifdef DEBUG
  1460.     if (deblog)
  1461.       switch (binary) {
  1462.         case XYFT_T:
  1463.         debug(F100,"zopeno receiving TEXT file","",0);
  1464.         break;
  1465.         case XYFT_B:
  1466.         debug(F100,"zopeno receiving BINARY file","",0);
  1467.         break;
  1468.         case XYFT_I:
  1469.         debug(F100,"zopeno receiving IMAGE file-program bug!","",0);
  1470.         break;
  1471.         case XYFT_L:
  1472.         debug(F100,"zopeno receiving LABELED file","",0);
  1473.         break;
  1474.         case XYFT_U:
  1475.         debug(F100,"zopeno receiving UNDEFINED file","",0);
  1476.         break;
  1477.         default:
  1478.         debug(F101,"zopeno unknown file type","",binary);
  1479.     }
  1480. #endif /* DEBUG */
  1481.     ofile_bmode = binary;
  1482.     ofile_dump = 0;
  1483.     ofile_ffb = -1;
  1484.     fab_ofile = cc$rms_fab;                 /* Initialize FAB. */
  1485.     nam_ofile = CC_RMS_NAMX;                /* Initialize NAM[L]. */
  1486.     fab_ofile.FAB_L_NAMX = &nam_ofile;      /* Point FAB to NAM[L]. */
  1487.  
  1488.     /* Install the path name in the FAB or NAML. */
  1489. #ifdef NAML$C_MAXRSS
  1490.     fab_ofile.fab$l_dna = (char *) -1;  /* Using NAML for default name. */
  1491.     fab_ofile.fab$l_fna = (char *) -1;  /* Using NAML for file name. */
  1492. #endif /* def NAML$C_MAXRSS */
  1493.     FAB_OR_NAML( fab_ofile, nam_ofile).FAB_OR_NAML_FNA = name;
  1494.     FAB_OR_NAML( fab_ofile, nam_ofile).FAB_OR_NAML_FNS = strlen( name);
  1495.  
  1496.     fab_ofile.fab$l_fop = FAB$M_MXV;
  1497.     fab_ofile.fab$b_fac = FAB$M_PUT;
  1498. /*
  1499.   Note that we could actually implement a true overwrite (step on existing
  1500.   file version) operation here by testing for a new XYFZ_* type as well in
  1501.   the line below, and then simply not doing a RAB$M_EOF about 25 lines down
  1502.   from here. We might also have to do something to reset the file allocation
  1503.   so we aren't left with a large number of "leftover" blocks if the new file
  1504.   is smaller than the old one.
  1505. */
  1506.     if (fcb) {
  1507.         if (fcb->dsp == XYFZ_A) {
  1508.         fab_ofile.fab$l_fop = FAB$M_CIF;
  1509. /*
  1510.   This is for RESEND.  If the output mode is APPEND and the incoming
  1511.   attributes structure (zz) says "Resend", then we know this file is
  1512.   being resent.
  1513. */
  1514.         if (*(zz->disp.val) == 'R' && ofile_bmode)
  1515.           writeover = 1;
  1516.         debug(F101,"zopeno APPENDing, writeover","",writeover);
  1517.         if (writeover)
  1518.           debug(F101,"zopeno RESEND, rs_len","",rs_len);
  1519. /*
  1520.   So if writeover != 0, we can take rs_len to be the length of the existing
  1521.   file to keep, and to write over the rest, which normally should be the final
  1522.   block.
  1523. */
  1524.         }
  1525.     }
  1526.  
  1527. #ifdef __DECC
  1528.         /* Revise some RMS parameters, if available. */
  1529.  
  1530.         if (rms_defaults_known > 0)
  1531.         {
  1532. #if 0       /* These appear to be useless here. */
  1533.             rab_ofile.rab$b_mbf = rms_mbf_active;
  1534.             rab_ofile.rab$v_rah = 1;
  1535.             rab_ofile.rab$v_wbh = 1;
  1536. #endif /* 0 */
  1537.  
  1538.             /* Default extend quantity. */
  1539.             fab_ofile.fab$w_deq = rms_deq_active;
  1540.  
  1541.             /* "Sequential access only" helps write with high-water marking. */
  1542.             fab_ofile.fab$v_sqo = 1;
  1543.         }
  1544. #endif /* def __DECC */
  1545.  
  1546.     if (ofile_bmode) {
  1547.         fab_ofile.fab$b_fac = FAB$M_BIO;
  1548.         debug(F101,"zopeno using record size","",frecl);
  1549.         fab_ofile.fab$w_mrs = frecl;
  1550.         if (ofile_bmode == XYFT_U)
  1551.           fab_ofile.fab$b_rfm = FAB$C_UDF;
  1552.         else
  1553.           fab_ofile.fab$b_rfm = FAB$C_FIX;
  1554.     } else {
  1555.         fab_ofile.fab$b_rat = FAB$M_CR;
  1556.         fab_ofile.fab$b_rfm = FAB$C_VAR;
  1557.     }
  1558.     fab_ofile.fab$b_shr = FAB$M_NIL;
  1559.     fab_ofile.fab$l_xab = (char *)&xabdat_ofile;
  1560.     rab_ofile = cc$rms_rab;
  1561.     rab_ofile.rab$l_fab = &fab_ofile;
  1562.     if (fcb)
  1563.         if ((fcb->dsp == XYFZ_A) && (writeover == 0))
  1564.         rab_ofile.rab$l_rop = RAB$M_EOF;
  1565.     xabdat_ofile = cc$rms_xabdat;
  1566.     xabdat_ofile.xab$l_nxt = (char *)&xabfhc_ofile;
  1567.     xabfhc_ofile = cc$rms_xabfhc;
  1568. #ifndef THIS_IS_WRONG
  1569.     xabfhc_ofile.xab$l_nxt = (char *)&xabpro_ofile;
  1570.     xabpro_ofile = cc$rms_xabpro;
  1571. #endif /* THIS_IS_WRONG */
  1572.     if (zz)
  1573.       zstime(name, zz, 2);        /* Set creation date from A packet */
  1574.     if (ofile_bmode == XYFT_L) {    /* DEFER OPEN IF LABELED <-- NOTE  */
  1575.         ofile_lblproc = 0;        /* (Haven't processed labels yet.) */
  1576.         ofile_lblopts = fcb->lblopts;
  1577.         debug(F101,"zopeno lblopts","",ofile_lblopts);
  1578.         debug(F100,"zopeno RMS operations deferred","",0);
  1579.     } else {
  1580.         rms_sts = sys$create(&fab_ofile);
  1581.         if (!(rms_sts & 1)) {
  1582.         vms_lasterr = rms_sts;
  1583.         debug(F101,"zopeno $create failed, status","",rms_sts);
  1584.         return(0);
  1585.         }
  1586.         rms_sts = sys$connect(&rab_ofile);
  1587.         if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  1588.         if (rms_sts != RMS$_NORMAL) {
  1589.         debug(F101,"zopeno $connect failed, status","",rms_sts);
  1590.         return(0);
  1591.         }
  1592.         if (writeover == 1) {        /* if resend ... */
  1593.         rab_ofile.rab$l_bkt = (unsigned long) rs_len >> 9;
  1594.         rms_sts = sys$space(&rab_ofile);/* space forward to last */
  1595.         if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  1596.         rab_ofile.rab$l_bkt = 0;    /* complete block */
  1597.         if (rms_sts != RMS$_NORMAL) {
  1598.             debug(F101,"zopeno $space failed, status","",rms_sts);
  1599.             return(0);
  1600.         }
  1601.         }
  1602.         debug(F100,"zopeno RMS operations completed ok","",0);
  1603.     }
  1604.     fp[n] = fopen("NLA0:","r");    /* CK wants a fp, give it one */
  1605.     return(1);
  1606.     }
  1607. }
  1608.  
  1609. /*  Z C L O S E  --  Close the given file.  */
  1610.  
  1611. /*  Returns 0 if arg out of range, 1 if successful, -1 if close failed.  */
  1612.  
  1613. int
  1614. zclose(n) int n; {
  1615.     int x = 0;
  1616.  
  1617.     debug(F101,"zclose n","",n);
  1618.     if (chkfn(n) < 1)
  1619.       return(0);
  1620.  
  1621. /* If this is the subprocess file, close it to flush output */
  1622.  
  1623.     if ((n == ZIFILE || (n == ZRFILE)) && (subprocess_input != 0)) {
  1624.         debug(F100, "zclose calling zclosf", "", 0);
  1625.     return (zclosf(n));
  1626.     }
  1627.     if (n == ZIFILE) {            /* Input (e.g. SEND) file */
  1628.     rms_sts = sys$close(&fab_ifile);
  1629.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  1630.     if (rms_sts != RMS$_NORMAL) {
  1631.         debug(F101,"zclose ZIFILE $close failed, status","",rms_sts);
  1632.         return(-1);
  1633.     }
  1634.     debug(F100,"zclose ZIFILE RMS operations completed ok","",0);
  1635.     x = fclose(fp[n]);        /* Close the dummy C library file */
  1636.     fp[n] = NULL;            /* Mark it closed */
  1637.     iflen = -1;            /* Invalidate length */
  1638.     return(1);
  1639.     } else if (n == ZRFILE) {        /* READ file */
  1640.     rms_sts = sys$close(&fab_rfile); /* Close it */
  1641.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  1642.     if (rms_sts != RMS$_NORMAL) {    /* Check status */
  1643.         debug(F101,"zclose ZRFILE $close failed, status","",rms_sts);
  1644.         return(-1);
  1645.     }
  1646.     debug(F100,"zclose ZRFILE RMS operations completed ok","",0);
  1647.     x = fclose(fp[n]);        /* Close the dummy C-Library file */
  1648.     fp[n] = NULL;            /* and mark it closed */
  1649.     rflen = -1;            /* invalidate its length */
  1650.     return(1);
  1651.     }
  1652.     if (n == ZOFILE) {            /* Output (e.g. RECEIVE) file */
  1653.     ofile_dump = 1;            /* Force complete dump */
  1654.     while (zoutcnt != 0) {
  1655.         rms_sts = zoutdump();    /* Flush buffers to disk */
  1656.         if (rms_sts != 0) {
  1657.         x = fclose(fp[n]);    /* Close the associated dummy file */
  1658.         fp[n] = NULL;        /* Mark it closed */
  1659.         iflen = -1;        /* Invalidate length */
  1660.         return(-1);
  1661.         }
  1662.     }
  1663.     if (ofile_bmode == XYFT_L) {    /* Update revisions if labeled */
  1664. #ifdef BUGFILL7                /* We should use a separate symbol.. */
  1665.         int i;
  1666.         char * s1, * s2;
  1667.         s1 = (char *)&xabrdt_ofile.xab$q_rdt;
  1668.         s2 = (char *)revdat;
  1669.         for (i = 0; i < 8; i++)
  1670.           *s1++ = *s2++;
  1671.         s1 = (char *)&xabrdt_ofile.xab$w_rvn;
  1672.         s2 = (char *)revnum;
  1673.         for (i = 0; i < 2; i++)
  1674.           *s1++ = *s2++;
  1675. #else
  1676.         memmove(&xabrdt_ofile.xab$q_rdt, revdat, 8);
  1677.         memmove(&xabrdt_ofile.xab$w_rvn, &revnum, 2);
  1678. #endif /* BUGFILL7 */
  1679.         debug(F100,"zclose ZOFILE updated labeled revision count","",0);
  1680.     }
  1681.     if (cflag != 1) {        /* Not console */
  1682.         rms_sts = sys$close(&fab_ofile); /* So close */
  1683.         if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  1684.         if (rms_sts != RMS$_NORMAL) {
  1685.         debug(F101,"zclose ZOFILE $close failed, status","",rms_sts);
  1686.         return(-1);
  1687.         }
  1688.         x = fclose(fp[n]);        /* Close the associated dummy file */
  1689.     } else                /* Console */
  1690.       cflag = 0;            /* So not console any more */
  1691.  
  1692.     ofile_lblproc = 0;        /* Done with this file's labels */
  1693.     debug(F100,"zclose ZOFILE RMS operations completed ok","",0);
  1694.     fp[n] = NULL;            /* Mark it closed */
  1695.     iflen = -1;            /* Invalidate length */
  1696.     return(1);
  1697.     }
  1698.     if ((fp[n] != stdout) && (fp[n] != stdin)) { /* Other kind of file */
  1699.         x = fclose(fp[n]);        /* C-Library close */
  1700.         if (x == EOF) {            /* If we got a close error */
  1701.             debug(F101,"zclose failed errno","",errno);
  1702.             perror("zclose");
  1703.         }
  1704.     }
  1705.     debug(F101,"zclose OTHER ","",fp[n]);
  1706.     fp[n] = NULL;            /* Mark it closed */
  1707.     iflen = -1;             /* Invalidate file length */
  1708.     if (x == EOF)             /* If we got a close error */
  1709.       return (-1);            /* fail */
  1710.     else                 /* otherwise */
  1711.       return (1);            /* succeed */
  1712. }
  1713.  
  1714. int
  1715. get_subprc_line() {
  1716.     struct iosb_struct subiosb;
  1717.     int timedout = 0;
  1718. #ifdef PIPETIMEOUT
  1719.     extern int kactive, srvping;
  1720. #endif /* PIPETIMEOUT */
  1721.  
  1722.     unsigned int sts;
  1723. /*
  1724.  * Someone complained that subprocess deletion would hang the Kermit server.
  1725.  * This can be triggered by sending something silly like REMOTE HOST STOP/ID=0.
  1726.  * If SUPERSAFE is defined we will check to make sure the subprocess still
  1727.  * exists before every read from the mailbox. This will slow things down a bit,
  1728.  * but should stop the "C-Kermit just dies" reports.
  1729.  */
  1730. #ifdef    SUPERSAFE
  1731.     unsigned short pid;
  1732.  
  1733.     struct itmlstdef {
  1734.     short int buflen;
  1735.     short int itmcod;
  1736.     char *bufaddr;
  1737.     long int *retlen;
  1738.     };
  1739.     struct itmlstdef itmlst[] = {
  1740.     4, JPI$_PID, NULL, 0,
  1741.     0, 0, 0, 0
  1742.     };
  1743.     itmlst[0].bufaddr = (char *)&pid;
  1744.  
  1745.     sts = sys$getjpiw(0, &sub_pid, 0, &itmlst, 0, 0, 0);
  1746.     if (!(sts & 1)) vms_lasterr = sts;
  1747.  
  1748.     debug(F101,"get_subprc_line sys$getjpiw status", "", sts);
  1749.     if (sts == SS$_NONEXPR)
  1750.       return(-1);
  1751. #endif    /* SUPERSAFE */
  1752.  
  1753. #ifndef PIPETIMEOUT
  1754.     sts = sys$qiow(QIOW_EFN, mbx_chan, IO$_READVBLK, &subiosb, 0, 0, sub_buf,
  1755.            sizeof(sub_buf), 0, 0, 0, 0);
  1756. #else
  1757.     if (kactive && srvping)  {
  1758.     unsigned long wait_sts, reqidt = 0L;
  1759.     unsigned long int mask = (1 << QIOW_EFN) | (1 << TIM_EFN);
  1760.     struct { int hi, lo; } qtime;
  1761.     qtime.hi = -10*1000*1000;    /* One second delta-time */
  1762.     qtime.lo = -1;
  1763.  
  1764.     sts = sys$setimr(TIM_EFN, &qtime, 0, reqidt, 0);
  1765.     if (sts != SS$_NORMAL) {
  1766.         debug(F101,"get_subprc_line sys$setimr", "", sts);
  1767.         vms_lasterr = sts;
  1768.         return(-1);
  1769.     }
  1770.     sts = sys$qio(QIOW_EFN, mbx_chan, IO$_READVBLK,
  1771.               &subiosb, 0, 0, sub_buf, sizeof(sub_buf), 0, 0, 0, 0);
  1772.  
  1773.     wait_sts = sys$wflor(TIM_EFN,mask);
  1774.     if (wait_sts != SS$_NORMAL) {
  1775.         debug(F101,"get_subprc_line sys$wflor status", "", wait_sts);
  1776.         vms_lasterr = wait_sts;
  1777.         return(-1);
  1778.     }
  1779.     wait_sts = sys$readef(TIM_EFN, &mask);
  1780.     if (wait_sts != SS$_WASCLR && wait_sts != SS$_WASSET) {
  1781.         vms_lasterr = wait_sts;
  1782.         return(-1);
  1783.     }
  1784.     if (wait_sts == SS$_WASSET) {
  1785.         sys$clref(TIM_EFN);
  1786.         debug(F100,"get_subprc_line TIM_EFN timedout", "",0);
  1787.         timedout = 1;
  1788.     } else {
  1789.         wait_sts = sys$cantim(reqidt,0);
  1790.         debug(F100,"get_subprc_line TIM_EFN was clear", "",0);
  1791.         sys$synch(QIOW_EFN,&subiosb); /* Check QIO completion */
  1792.         debug(F100,"get_subprc_line $synch(QIO) complete","",0);
  1793.     }
  1794.     } else
  1795.       sts = sys$qiow(QIOW_EFN, mbx_chan, IO$_READVBLK,
  1796.              &subiosb, 0, 0, sub_buf, sizeof(sub_buf), 0, 0, 0, 0);
  1797. #endif /* PIPETIMEOUT */
  1798.  
  1799.     debug(F101,"get_subprc_line sys$qio{w} status", "", sts);
  1800.     if (sts != SS$_NORMAL) {
  1801.         vms_lasterr = sts;
  1802.         return(-1);
  1803.     }
  1804.     debug(F101,"get_subprc_line sys$qiow subiosb.status", "", subiosb.status);
  1805.     if (subiosb.status != SS$_NORMAL && !timedout) {
  1806.         vms_lasterr = subiosb.status;
  1807.         return(-1);
  1808.     }
  1809.     sub_count = subiosb.size;
  1810.     debug(F111,"get_subprc_line size", sub_buf, sub_count);
  1811.  
  1812.     if (timedout && (sub_count == 0))
  1813.       return(-3);
  1814.  
  1815.     sub_buf[sub_count] = '\r';
  1816.     sub_buf[sub_count + 1] = '\n';
  1817.     sub_buf[sub_count + 2] = '\0';
  1818.     sub_count += 2;
  1819.     debug(F111,"get_subprc_line size 2", sub_buf, sub_count);
  1820.     sub_ptr = sub_buf;
  1821.  
  1822.     return(0);
  1823. }
  1824.  
  1825. /*  Z C H I N  --  Get a character from the input file.  */
  1826.  
  1827. /*  Returns -1 if EOF, 0 otherwise with character returned in argument  */
  1828.  
  1829. int
  1830. zchin(n,c) int n, *c; {
  1831.     int a = -1;
  1832.  
  1833. #ifdef DEBUG
  1834.     if (chkfn(n) < 1) return(-1);
  1835. #endif /* DEBUG */
  1836.  
  1837.     if (n == ZIFILE) {
  1838.     if (subprocess_input) {
  1839.         if (--sub_count < 0)
  1840.           if (get_subprc_line()) return(-1);
  1841.         a = *sub_ptr++;
  1842.     } else {
  1843.         a = zminchar();
  1844.     }
  1845.     } else if (n == ZRFILE) {
  1846.     a = ((--rincnt)>=0) ? ((int)(*rinptr++) & 0377) : rinfill();
  1847.     /* debug(F101,"zchin a","",a); */
  1848.     }
  1849.     if (a == -1)
  1850.       return(-1);
  1851.     *c = (unsigned char)a;
  1852.     return(0);
  1853. }
  1854.  
  1855. /*  Z S I N L  --  Read a line from a file.  */
  1856.  
  1857. /*
  1858.   Writes the line into the address provided by the caller.
  1859.   n is the Kermit "channel number".
  1860.   Writing terminates when newline is encountered, newline is not copied.
  1861.   Writing also terminates upon EOF or if length x is exhausted.
  1862.   Returns 0 on success, -1 on EOF or error.
  1863. */
  1864.  
  1865. int
  1866. zsinl(n,s,x) int n, x; char *s; {
  1867.     int a, z = 0, count = 0;
  1868.     int old;
  1869.  
  1870.     if (!s || chkfn(n) < 1)        /* Make sure file is open etc */
  1871.       return(-1);
  1872.     s[0] = '\0';            /* Clear buffer */
  1873.     a = -1;
  1874.     while (x--) {
  1875.     old = a;            /* Previous character */
  1876.     z = zchin(n,&a);
  1877.     /* debug(F101,"zsinl z","",z); */
  1878.     if (z < 0) {            /* Read a character from the file */
  1879.         if (count == 0)
  1880.           return(-1);        /* Signal EOF if problem */
  1881.         else            /* Or if we have something */
  1882.           return(0);        /* save failure till next time */
  1883.     } else
  1884.       count++;
  1885.     a = a & 0377;
  1886. #ifdef NLCHAR
  1887.     if (a == (char) NLCHAR) break;    /* Single-character line terminator */
  1888. #else
  1889.     if (a == '\r') {
  1890.         continue;
  1891.     }
  1892.     if (old == '\r') {
  1893.         if (a == '\n') break;
  1894.         else *s++ = '\r';
  1895.     }
  1896. #endif /* NLCHAR */
  1897.     *s = a;
  1898.     s++;
  1899.     }
  1900.     *s = '\0';
  1901.     return(z);
  1902. }
  1903.  
  1904. /*  Z X I N  --  Read x bytes from a file  */
  1905.  
  1906. /*
  1907.   Reads x bytes (or less) from channel n and writes them
  1908.   to the address provided by the caller.
  1909.   Returns number of bytes read on success, 0 on EOF or error.
  1910. */
  1911. int
  1912. zxin(n,s,x) int n, x; char *s; {
  1913. #ifdef IKSD
  1914.     if (inserver && !local && (n == ZCTERM || n == ZSTDIO)) {
  1915.         int a, i;
  1916.         a = ttchk();
  1917.         if (a < 1) return(0);
  1918.         for (i = 0; i < a && i < x; i++)
  1919.           s[i] = coninc(0);
  1920.         return(i);
  1921.     }
  1922. #endif /* IKSD */
  1923.     return(fread(s, sizeof (char), x, fp[n]));
  1924. }
  1925.  
  1926.  
  1927. /*  Z I N F I L L  --  Read a line from a file.  */
  1928.  
  1929. /*
  1930.  * (re)fill the buffered file input buffer with data.  All file input
  1931.  * should go through this routine, usually by calling the zminchar()
  1932.  * macro (defined in ckcker.h).
  1933.  */
  1934.  
  1935. int
  1936. zinfill() {
  1937.     char cchar;
  1938.     int x, linelen;
  1939.     unsigned char vfcbuf[255];    /* 2 is default for PRN, but 255 is max */
  1940.  
  1941.     debug(F101,"zinfill rab_ifile.rab$l_bkt 1","",rab_ifile.rab$l_bkt);
  1942.     debug(F101,"zinfill ifile_bmode","",ifile_bmode);
  1943.  
  1944.     if (subprocess_input) {
  1945.     x = get_subprc_line();
  1946.     debug(F101,"zinfill get_subprc_line","",x);
  1947.     if (x == -3)
  1948.       return(-3);
  1949.     if (x != 0)
  1950.       return(-1);
  1951. /*
  1952.  * The size problem should never happen.  sub_buf of a size greater than
  1953.  * 1k is highly unlikely to be needed.
  1954.  */
  1955.     if (INBUFSIZE < SUB_BUF_SIZE) {
  1956.         fprintf(stderr,"zinfill: sub_buf too large for zinbuffer");
  1957.         exit(BAD_EXIT);
  1958.     }
  1959.     zinptr = (CHAR *)sub_buf;
  1960.     zincnt = sub_count;
  1961.     } else {
  1962.     if (ifile_bmode != 0) {
  1963.         rab_ifile.rab$l_rop = RAB$M_BIO;    /* block mode I/O */
  1964. #ifdef DYNAMIC
  1965.         rab_ifile.rab$l_ubf = (char *)zinbuffer;
  1966. #else
  1967. /* NOTE: Might need "(char *)&zinbuffer" here */
  1968.         rab_ifile.rab$l_ubf = &zinbuffer;
  1969. #endif /* DYNAMIC */
  1970. /*
  1971.   There is a serious flaw here, namely that reading blocks rather than
  1972.   records *includes* the record pad byte (NUL) when the record has an
  1973.   odd length.  All RMS records are stored on even-numbered byte boundaries.
  1974.   Kermit-32 did it right, sigh.  So we need a total rewrite to allow for
  1975.   odd-length records.  Hmmm.. I wonder what the impact on RESEND is...
  1976. */
  1977.         rab_ifile.rab$w_usz = 512;
  1978.         rms_sts = sys$read(&rab_ifile);
  1979.         if (!(rms_sts & 1)) {
  1980.         debug(F101,"zinfill sys$read failed, status","",rms_sts);
  1981.         vms_lasterr = rms_sts;
  1982.         }
  1983.         if (rms_sts == RMS$_EOF)
  1984.           return(-1);        /* End of file */
  1985.         if (rms_sts != RMS$_NORMAL)
  1986.           return(-1);        /* Fatal */
  1987.  
  1988.         ifile_bcount++;        /* No error, say another block read */
  1989.         debug(F101,"zinfill sys$read ok, ifile_bcount","",ifile_bcount);
  1990.         zincnt = 512;
  1991.         zinptr = zinbuffer;
  1992.         if (rab_ifile.rab$l_bkt != 0) { /* If just a file position... */
  1993.         debug(F101,"zinfill updating block counter","",0);
  1994.         ifile_bcount = rab_ifile.rab$l_bkt; /* update block counter */
  1995.         }
  1996.         if (ifile_bcount == xabfhc_ifile.xab$l_ebk) {
  1997.         if (ifile_bmode == 1)    /* BINARY but not LABELED */
  1998.             zincnt = xabfhc_ifile.xab$w_ffb;
  1999.         }
  2000.         debug(F101,"zinfill rab_ifile.rab$l_bkt 2","",rab_ifile.rab$l_bkt);
  2001.         if (rab_ifile.rab$l_bkt != 0) { /* If just a file position... */
  2002.         return(0);            /*...then done                */
  2003.         }
  2004.         zincnt--;            /* one less char in buffer */
  2005.         return((int)(*zinptr++) & 0377); /* because we return the first */
  2006.     }
  2007.  
  2008. /* if we reached this point, we want to do record IO; first initialize RAB */
  2009.  
  2010.     if (fab_ifile.fab$b_rat & FAB$M_FTN) {
  2011. #ifdef DYNAMIC
  2012.         rab_ifile.rab$l_ubf = (char *)zinbuffer+2;
  2013. #else
  2014. /* NOTE: Might need "(char *)&zinbuffer+2" here */
  2015.         rab_ifile.rab$l_ubf = &zinbuffer+2;
  2016. #endif /* DYNAMIC */
  2017.         rab_ifile.rab$w_usz = INBUFSIZE-4; /* Space for carriage control */
  2018.     } else {
  2019. #ifdef DYNAMIC
  2020.         rab_ifile.rab$l_ubf = (char *)zinbuffer;
  2021. #else
  2022. /* NOTE: Might need "(char *)&zinbuffer" here */
  2023.         rab_ifile.rab$l_ubf = &zinbuffer;
  2024. #endif /* DYNAMIC */
  2025.         rab_ifile.rab$w_usz = INBUFSIZE-2; /* Space for possible CR/LF */
  2026.     }
  2027.     if (fab_ifile.fab$b_rat & FAB$M_PRN) { /* A fixed control area */
  2028.         rab_ifile.rab$l_rhb = (char *)&vfcbuf;
  2029.         rab_ifile.rab$w_usz = INBUFSIZE-255; /* Max fixed size*/
  2030.         }
  2031.     rab_ifile.rab$l_rop = 0;    /* Now do the record I/O */
  2032.     rms_sts = sys$get(&rab_ifile);
  2033.     if (!(rms_sts & 1)) {
  2034.         debug(F101,"zinfill sys$get failed, status","",rms_sts);
  2035.         vms_lasterr = rms_sts;
  2036.     }
  2037.     if (rms_sts == RMS$_EOF)
  2038.       return(-1);            /* End of file */
  2039.     if (rms_sts != RMS$_NORMAL)
  2040.       return(-1);            /* Fatal */
  2041. /*
  2042.  * Do assorted contortions with Fortran carriage control to make it formatted
  2043.  * ASCII instead, since many systems don't know about Fortran format in files.
  2044.  */
  2045.     if (fab_ifile.fab$b_rat & FAB$M_FTN) {
  2046.             linelen = rab_ifile.rab$w_rsz;
  2047.             if (linelen > 0) {
  2048.             linelen --;        /* sans control code */
  2049.             cchar = zinbuffer[2];    /* control code */
  2050.             } else {            /* zero length record */
  2051.                 cchar = ' ';        /* space to give <LF><CR> */
  2052.             }
  2053.         switch (cchar) {
  2054.           case '\0':        /* data */
  2055.         zinptr = zinbuffer+3;
  2056.         zincnt = linelen;
  2057.         break;
  2058.           case '+':                /* data<CR> */
  2059.         zinbuffer[linelen+3] = '\r';    /* insert return */
  2060.         zinptr = zinbuffer+3;
  2061.         zincnt = linelen+1;        /* count it */
  2062.         break;
  2063.           case '$':                /* <LF>data */
  2064.         zinbuffer[2] = '\n';        /*  insert newline */
  2065.         zinptr = zinbuffer+2;
  2066.         zincnt = linelen+1;        /* count it */
  2067.         break;
  2068.           case ' ':                /* <LF>data<CR> */
  2069.         zinbuffer[2] = '\n';        /*  insert newline */
  2070.         zinbuffer[linelen+3] = '\r';    /*  insert return */
  2071.         zinptr = zinbuffer+2;
  2072.         zincnt = linelen+2;        /*  count 'em */
  2073.         break;
  2074.           case '0':                /* <LF><CR><LF>data<CR> */
  2075.         zinbuffer[0] = '\n';        /*  insert 1st newline */
  2076.         zinbuffer[1] = '\r';        /*  insert 1st return */
  2077.         zinbuffer[2] = '\n';        /*  insert 2nd newline */
  2078.         zinbuffer[linelen+3] = '\r';    /*  insert 2nd return */
  2079.         zinptr = zinbuffer;
  2080.         zincnt = linelen+4;        /*  count 'em */
  2081.         break;
  2082.           case '1':                /* <FF>data<CR> */
  2083.         zinbuffer[2] = '\f';        /*  insert formfeed */
  2084.         zinbuffer[linelen+3] = '\r';    /*  insert return */
  2085.         zinptr = zinbuffer+2;
  2086.         zincnt = linelen+2;        /*  count 'em */
  2087.         break;
  2088.           default:                /* <LF>data<CR> */
  2089.         zinbuffer[2] = '\n';        /*  insert newline */
  2090.         zinbuffer[linelen+3] = '\r';    /*  insert return */
  2091.         zinptr = zinbuffer+2;
  2092.         zincnt = linelen+2;        /*  count 'em */
  2093.         break;
  2094.         }
  2095.     } else {
  2096.         zincnt = rab_ifile.rab$w_rsz;
  2097.         zinptr = zinbuffer;            /* reset pointer */
  2098.     }
  2099. /*
  2100.  * Here we see if we need to insert CR/LF pairs at the record boundary. For
  2101.  * the moment, we will add them if the file has "carriage return carriage
  2102.  * control" when looked at by a DIRECTORY command. As of edit 036 we also do
  2103.  * this for "print file carriage control" files. I'm open to comments de-
  2104.  * scribing cases where this doesn't work...
  2105.  */
  2106.     if (fab_ifile.fab$b_rat & FAB$M_CR) {
  2107.         zinbuffer[zincnt] = '\r';
  2108.         zinbuffer[zincnt + 1] = '\n';
  2109.         zincnt += 2;
  2110.     }
  2111.  
  2112. /* that worked for the default PRN format of batch log files etc., but
  2113.  * ignored any user format specification (v. RMS FAB$B_RAT docs).
  2114.  */
  2115.     if (fab_ifile.fab$b_rat & FAB$M_PRN) {
  2116.  
  2117.             int i, ifcv, ipcnt, iscnt;
  2118.             unsigned char ipchr, ischr;    /* Eight bit ASCII control code */
  2119.  
  2120.         if (vfcbuf[0] == 0x01 && vfcbuf[1] == 0x8D) {
  2121.             zinbuffer[zincnt] = '\r'; /* Do batch log files the old way */
  2122.             zinbuffer[zincnt + 1] = '\n';
  2123.             zincnt += 2;
  2124.         } else {            /* Decode the control area */
  2125.         ipcnt = 0;        /* First, the prefix byte */
  2126.         ipchr = '\0';
  2127.                 if (vfcbuf[0] != '\0') {
  2128.                     ifcv =  (vfcbuf[0] & 0xe0) >> 5; /* The control bits */
  2129.                     switch (ifcv) {
  2130.               case 0: ipcnt = (int) vfcbuf[0];
  2131.             break;
  2132.               case 4: ipchr = vfcbuf[0] & 0x1f;
  2133.             break;
  2134.               case 6: ipchr = (vfcbuf[0] & 0x1f) + 128;
  2135.             break;
  2136.               case 7:
  2137.             debug(F101,
  2138.                   "zinfill illegal PRN code, byte 0 :",
  2139.                   "",
  2140.                   vfcbuf[0]
  2141.                   );
  2142.             ipcnt = 1;    /* Ignore code, apply CRLF */
  2143.             break;
  2144.               default:
  2145.             debug(F101,
  2146.                   "zinfill unknown PRN code, byte 0 :",
  2147.                   "",
  2148.                   vfcbuf[0]
  2149.                   );
  2150.             ipcnt = 1;
  2151.             break;
  2152.             }
  2153.         }
  2154.         iscnt = 0;        /* Now, the suffix byte */
  2155.         ischr = '\0';
  2156.                 if (vfcbuf[1] != '\0') {
  2157.                     ifcv =  (vfcbuf[1] & 0xe0) >> 5; /* The control bits */
  2158.                     switch (ifcv) {
  2159.               case 0: iscnt = (int) vfcbuf[1];
  2160.             break;
  2161.               case 4: ischr = vfcbuf[1] & 0x1f;
  2162.             break;
  2163.               case 6: ischr = (vfcbuf[1] & 0x1f) + 128;
  2164.             break;
  2165.               case 7:
  2166.             debug(F101,
  2167.                   "zinfill illegal PRN code, byte 1 :",
  2168.                   "",
  2169.                   vfcbuf[1]
  2170.                   );
  2171.             iscnt = 1;    /* Ignore code,  apply CRLF */
  2172.             break;
  2173.               default :
  2174.             debug(F101,
  2175.                   "zinfill unknown PRN code, byte 1 :",
  2176.                   "",
  2177.                   vfcbuf[1]
  2178.                   );
  2179.             iscnt = 1;
  2180.             break;
  2181.             }
  2182.         }
  2183.         if (ipcnt != 0 || ipchr != '\0') { /* Insert */
  2184.             if (ipcnt > 0) {           /* CR & n LF's */
  2185.             memmove(zinbuffer+ipcnt+1, zinbuffer, zincnt);
  2186.             zincnt += ipcnt + 1;
  2187.             zinbuffer[0] = '\r';
  2188.             for (i = 1; i <= ipcnt; i++)
  2189.               zinbuffer[i] = '\n';
  2190.             } else {        /* Or an ASCII control code */
  2191.             memmove(zinbuffer+1, zinbuffer, zincnt);
  2192.             zincnt ++;
  2193.             zinbuffer[0] = ipchr;
  2194.             }
  2195.         }
  2196.         if (iscnt != 0 || ischr != '\0') { /* Append */
  2197.             if (iscnt > 0) {
  2198.             zinbuffer[zincnt++]='\r';
  2199.             for (i = 1; i <= iscnt; i++)
  2200.               zinbuffer[zincnt++]='\n';
  2201.             } else {
  2202.             zinbuffer[zincnt++] = ischr;
  2203.             }
  2204.         }
  2205.         }
  2206.         }
  2207.     }
  2208. /*
  2209.  * And finally return the record
  2210.  */
  2211.     zincnt--;                /* one less char in buffer */
  2212.     return((int)(*zinptr++) & 0377);    /* because we return the first */
  2213. }
  2214.  
  2215. static int
  2216. rinfill() {
  2217.     char cchar;
  2218.     int linelen;
  2219.  
  2220.     if (ispipe[ZRFILE]) {        /* OPEN !READ file */
  2221.     int x;
  2222.     x = get_subprc_line();
  2223.     debug(F101,"rinfill get_subprc_line","",x);
  2224.     if (x < 0) return(x);
  2225.     rinptr = (CHAR *)sub_buf;
  2226.     rincnt = sub_count - 1;
  2227.     debug(F101,"rinfill rincount","",rincnt);
  2228.     return((int)(*rinptr++) & 0377);
  2229.     }
  2230.     /* Regular file... */
  2231.  
  2232.     debug(F101,"rinfill rfile_bmode","",rfile_bmode);
  2233.     if (rfile_bmode != 0) {
  2234.     rab_rfile.rab$l_rop = RAB$M_BIO; /* Block mode I/O */
  2235. #ifdef DYNAMIC
  2236.     rab_rfile.rab$l_ubf = (char *)rinbuffer;
  2237. #else
  2238. /* NOTE: Might need "(char *)&rinbuffer" here */
  2239.     rab_rfile.rab$l_ubf = &rinbuffer;
  2240. #endif /* DYNAMIC */
  2241.     rab_rfile.rab$w_usz = 512;
  2242.     rms_sts = sys$read(&rab_rfile);
  2243.     if (!(rms_sts & 1)) {
  2244.         debug(F101,"rinfill sys$read failed, status","",rms_sts);
  2245.         vms_lasterr = rms_sts;
  2246.     }
  2247.     if (rms_sts == RMS$_EOF)
  2248.       return(-1);            /* End of file */
  2249.     if (rms_sts != RMS$_NORMAL)
  2250.       return(-1);            /* Fatal */
  2251.     rfile_bcount++;            /* Say another block read */
  2252.     debug(F101,"rinfill sys$read ok, rfile_bcount","",rfile_bcount);
  2253.     rincnt = 512;
  2254.     rinptr = rinbuffer;
  2255.  
  2256.     if (rab_rfile.rab$l_bkt != 0) { /* If just a file position... */
  2257.         rfile_bcount = rab_rfile.rab$l_bkt; /* update block counter */
  2258.     }
  2259.     if (rfile_bcount == xabfhc_rfile.xab$l_ebk) {
  2260.         if (rfile_bmode == 1)    /* BINARY but not LABELED */
  2261.           rincnt = xabfhc_rfile.xab$w_ffb;
  2262.     }
  2263.     if (rab_rfile.rab$l_bkt != 0) { /* If just a file position... */
  2264.         return(0);            /*...then done                */
  2265.     }
  2266.     rincnt--;            /* one less char in buffer */
  2267.     return((int)(*rinptr++) & 0377); /* because we return the first */
  2268.     }
  2269.     if (fab_rfile.fab$b_rat & FAB$M_FTN) {
  2270.     debug(F100,"rinfill FAB$M_FTN","",0);
  2271. #ifdef DYNAMIC
  2272.     rab_rfile.rab$l_ubf = (char *)rinbuffer+2;
  2273. #else
  2274. /* NOTE: Might need "(char *)&rinbuffer" here */
  2275.     rab_rfile.rab$l_ubf = &rinbuffer+2;
  2276. #endif /* DYNAMIC */
  2277.     rab_rfile.rab$w_usz = INBUFSIZE-4; /* space for carriage ctl */
  2278.     } else {
  2279.     debug(F100,"rinfill not FAB$M_FTN","",0);
  2280. #ifdef DYNAMIC
  2281.     rab_rfile.rab$l_ubf = (char *)rinbuffer;
  2282. #else
  2283. /* NOTE: Might need "(char *)&rinbuffer" here */
  2284.     rab_rfile.rab$l_ubf = &rinbuffer;
  2285. #endif /* DYNAMIC */
  2286.     rab_rfile.rab$w_usz = INBUFSIZE-2; /* space for possible CR/LF */
  2287.     }
  2288.     rab_rfile.rab$l_rop = 0;        /* doing record I/O */
  2289.     rms_sts = sys$get(&rab_rfile);
  2290.     if (!(rms_sts & 1)) {
  2291.     debug(F101,"rinfill sys$get failed, status","",rms_sts);
  2292.     vms_lasterr = rms_sts;
  2293.     }
  2294.     if (rms_sts == RMS$_EOF)
  2295.       return(-1);            /* End of file */
  2296.     if (rms_sts != RMS$_NORMAL)
  2297.       return(-1);            /* Fatal */
  2298. /*
  2299.  * Do assorted contortions with Fortran carriage control to make it formatted
  2300.  * ASCII instead, since many systems don't know about Fortran format in files.
  2301.  */
  2302.     if (fab_rfile.fab$b_rat & FAB$M_FTN) {
  2303.     linelen = rab_rfile.rab$w_rsz-1; /* sans control code */
  2304.     cchar = rinbuffer[2];        /* control code */
  2305.     switch (cchar) {
  2306.       case '\0':            /* data<CR> */
  2307.       case '+':
  2308.         rinbuffer[linelen+3] = '\r';/*  insert return */
  2309.         rinptr = rinbuffer+3;
  2310.         rincnt = linelen+1;        /* count it */
  2311.         break;
  2312.       case '$':            /* <LF>data<CR> */
  2313.       case ' ':
  2314.         rinbuffer[2] = '\n';    /*  insert newline */
  2315.         rinbuffer[linelen+3] = '\r';/*  insert return */
  2316.         rinptr = rinbuffer+2;
  2317.         rincnt = linelen+2;        /*  count 'em */
  2318.         break;
  2319.       case '0':            /* <LF><CR><LF>data<CR> */
  2320.         rinbuffer[0] = '\n';    /*  insert 1st newline */
  2321.         rinbuffer[1] = '\r';    /*  insert 1st return */
  2322.         rinbuffer[2] = '\n';    /*  insert 2nd newline */
  2323.         rinbuffer[linelen+3] = '\r';/*  insert 2nd return */
  2324.         rinptr = rinbuffer;
  2325.         rincnt = linelen+4;        /*  count 'em */
  2326.         break;
  2327.       case '1':            /* <FF>data<CR> */
  2328.         rinbuffer[2] = '\f';    /*  insert formfeed */
  2329.         rinbuffer[linelen+3] = '\r';/*  insert return */
  2330.         rinptr = rinbuffer+2;
  2331.         rincnt = linelen+2;        /*  count 'em */
  2332.         break;
  2333.       default:            /* <LF>data<CR> */
  2334.         rinbuffer[2] = '\n';    /*  insert newline */
  2335.         rinbuffer[linelen+3] = '\r';/*  insert return */
  2336.         rinptr = rinbuffer+2;
  2337.         rincnt = linelen+2;        /*  count 'em */
  2338.         break;
  2339.     }
  2340.     } else {
  2341.     rincnt = rab_rfile.rab$w_rsz;
  2342.     rinptr = rinbuffer;        /* reset pointer */
  2343.     }
  2344. /*
  2345.  * Here we see if we need to insert CR/LF pairs at the record boundary. For
  2346.  * the moment, we will add them if the file has "carriage return carriage
  2347.  * control" when looked at by a DIRECTORY command. As of edit 036 we also do
  2348.  * this for "print file carriage control" files. I'm open to comments de-
  2349.  * scribing cases where this doesn't work...
  2350.  */
  2351.     if (fab_rfile.fab$b_rat & (FAB$M_CR | FAB$M_PRN)) {
  2352.     rinbuffer[rincnt] = '\r';
  2353.     rinbuffer[rincnt + 1] = '\n';
  2354.     rincnt += 2;
  2355.     }
  2356.     rincnt--;            /* one less char in buffer */
  2357.     return((int)(*rinptr++) & 0377); /* because we return the first */
  2358. }
  2359.  
  2360. /*  Z F S E E K -- Seek to a given position with an input file */
  2361. /*                 Assumes block-mode I/O being used           */
  2362.  
  2363. int
  2364. zfseek(CK_OFF_T pos) {
  2365.     CK_OFF_T offset;
  2366.     unsigned long errtmp;
  2367.     int x;
  2368.  
  2369.     debug(F101,"zfseek pos","",pos);
  2370.     rab_ifile.rab$l_bkt = (unsigned long) pos >> 9; /* Get block number */
  2371.     debug(F101,"zfseek rab_ifile.rab$l_bkt","",rab_ifile.rab$l_bkt);
  2372.     rab_ifile.rab$l_bkt++;        /* VBN's are 1-based */
  2373.     offset = (unsigned long) pos & 511;    /* Get offset with block */
  2374.     debug(F101,"zfseek offset","",offset);
  2375.     errtmp = vms_lasterr;        /* Make sure we get the real error */
  2376.     vms_lasterr = 0;            /* ... */
  2377.     x = zinfill();            /* Read in the block */
  2378.     debug(F101,"zfseek zinfill","",x);
  2379.     if (x != 0) {            /* Handle any errors */
  2380.     rab_ifile.rab$l_bkt = 0;    /* Sequentially from now on */
  2381.     debug(F101,"zfseek failed","",vms_lasterr);
  2382.     return(-1);
  2383.     }
  2384.     vms_lasterr = errtmp;
  2385.     rab_ifile.rab$l_bkt = 0;        /* Sequentially from now on */
  2386.     if (offset != 0) {            /* if not block boundary... */
  2387.     zincnt = zincnt - offset;    /* ...adjust count and pointer */
  2388.     zinptr = zinptr + offset;
  2389.     }
  2390.     return(0);
  2391. }
  2392.  
  2393. /*  Z S O U T  --  Write a string to the given file, buffered.  */
  2394.  
  2395. int
  2396. zsout(n,s) int n; char *s; {
  2397. #ifdef DEBUG
  2398.     if (chkfn(n) < 1) return(-1);
  2399. #endif
  2400.     fputs(s, fp[n]);            /* Don't use fprintf here MM */
  2401.     return(0);
  2402. }
  2403.  
  2404.  
  2405. /*  Z S O U T L  --  Write string to file, with line terminator, buffered.  */
  2406.  
  2407. int
  2408. zsoutl(n,s) int n; char *s; {
  2409. #ifdef DEBUG
  2410.     if (chkfn(n) < 1) return(-1);
  2411. #endif /* DEBUG */
  2412.     if (fputs(s, fp[n]) == EOF)
  2413.       return(-1);
  2414.     putc('\n', fp[n]);
  2415.     return(0);
  2416. }
  2417.  
  2418.  
  2419. /*  Z S O U T X  --  Write x characters to file, unbuffered.  */
  2420.  
  2421. int
  2422. zsoutx(n,s,x) int n, x; char *s; {
  2423. #ifdef DEBUG
  2424.     if (chkfn(n) < 1) return(-1);
  2425. #endif
  2426.     return(write(fileno(fp[n]),s,x));
  2427. }
  2428.  
  2429.  
  2430. /*  Z C H O U T  --  Add a character to the given file.  */
  2431.  
  2432. int
  2433. #ifdef CK_ANSIC
  2434. zchout(register int n, char c)
  2435. #else
  2436. zchout(n,c) register int n; char c;
  2437. #endif /* CK_ANSIC */
  2438. /* zchout */ {
  2439. #ifdef DEBUG
  2440.     if (chkfn(n) < 1) return(-1);
  2441. #endif
  2442.     if (n == ZSFILE) {
  2443.         return(write(fileno(fp[n]),&c,1)); /* Use unbuffered for session log */
  2444.     } else {
  2445.     if (putc(c,fp[n]) == EOF)    /* If true, maybe there was an error */
  2446.       return(ferror(fp[n]) ? -1 : 0); /* Check to make sure */
  2447.     else                /* Otherwise... */
  2448.       return(0);            /* There was no error. */
  2449.     }
  2450. }
  2451.  
  2452. /*  Z O U T D U M P  --  dump buffered output characters to file.  */
  2453.  
  2454. /* Buffered file output, buffer dump */
  2455.  
  2456. /*
  2457.   No, this isn't an entry in the 199x Obfuscated C programming contest, nor
  2458.   did we get it at an all-night convenience store.  VMS requires that stream
  2459.   format files be written as records, so we have to do _lots_ of contortions
  2460.   to make sure we write whole lines as records.  Not pretty.  - TMK
  2461. */
  2462. int
  2463. zoutdump() {
  2464.     int ocnt;
  2465.     int wrote_one_line = 0;
  2466.     CHAR *optr, *srcptr, *endptr;
  2467.     char csave;
  2468.  
  2469.     debug(F101,"zoutdump zoutcnt","",zoutcnt);
  2470.     debug(F101,"zoutdump ofile_bmode","",ofile_bmode);
  2471. /*
  2472.   Well, this could be to the console. If it is, chop it into itty-bitty parts
  2473.   (the VMS CRTL can't handle a %s spec bigger than 512 bytes) and print it.
  2474. */
  2475.     if (cflag == 1) {            /* If we're dumping to console */
  2476.     endptr = zoutbuffer + zoutcnt;
  2477.     for (optr = zoutbuffer; optr < endptr; optr += 511) {
  2478.         if (optr+511 < endptr) {    /* More than 511, break up */
  2479.         csave = *(optr+511);
  2480.         *(optr+511) = '\0';
  2481.         printf("%s", optr);
  2482.         *(optr+511) = csave;
  2483.         } else {
  2484.         *endptr = '\0';        /* Make sure null-terminated */
  2485.         printf("%s", optr);
  2486.         }
  2487.     }
  2488.     zoutcnt = 0;
  2489.     zoutptr = zoutbuffer;
  2490.     return(0);
  2491.     }
  2492.  
  2493. /* Do we need to processed TYPE LABELED contortions? */
  2494.  
  2495.     if (ofile_bmode == XYFT_L) {    /* Is it labeled? */
  2496.     int x;
  2497.     if (ofile_lblproc == 0)    {    /* I've never gone this way before? */
  2498.         x = do_label_recv();    /* Beyond revolving rainbow door... */
  2499.         if (x == -1)
  2500.           return(-1);        /* Got a hard error in label proc. */
  2501.         if (x == 1 && ofile_dump != 1)
  2502.           return(0);        /* Exit so we can fill up the buffer */
  2503.     }
  2504.     }
  2505. /*
  2506.  * Well, we could be lucky...
  2507.  */
  2508.     if (zoutcnt == 0)
  2509.     return(0);
  2510. /*
  2511.  * Oh well. See if doing binary - that's easy...
  2512.  */
  2513.     if (ofile_bmode) {
  2514.     if (zoutcnt == OBUFSIZE) {
  2515. #ifdef DYNAMIC
  2516.         rab_ofile.rab$l_rbf = (char *)zoutbuffer;
  2517. #else
  2518. /* NOTE: Might need "(char *)&zoutbuffer" here */
  2519.         rab_ofile.rab$l_rbf = &zoutbuffer;
  2520. #endif /* DYNAMIC */
  2521.         rab_ofile.rab$w_rsz = OBUFSIZE;
  2522.         if (ofile_ffb != -1 && ofile_dump == 1) {
  2523.         /*
  2524.          * Only do this when doing _last_ file segment.
  2525.          */
  2526.         xabfhc_ofile.xab$w_ffb = ofile_ffb;
  2527.         if (ofile_ffb)
  2528.             rab_ofile.rab$w_rsz -= (512 - ofile_ffb);
  2529.         debug(F101,"zoutdump ofile_ffb","",(int)ofile_ffb);
  2530.         debug(F101,"zoutdump rab$w_rsz","",rab_ofile.rab$w_rsz);
  2531.         }
  2532.         rms_sts = sys$write(&rab_ofile);
  2533.         if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  2534.         if (rms_sts != RMS$_NORMAL) {
  2535.         debug(F101,"zoutdump $write failed, status","",rms_sts);
  2536.         return(-1);
  2537.         }
  2538.     } else {
  2539. #ifdef DYNAMIC
  2540.         rab_ofile.rab$l_rbf = (char *)zoutbuffer;
  2541. #else
  2542. /* NOTE: Might need "(char *)&zoutbuffer" here */
  2543.         rab_ofile.rab$l_rbf = &zoutbuffer;
  2544. #endif
  2545.         rab_ofile.rab$w_rsz = zoutcnt;
  2546.         xabfhc_ofile.xab$w_ffb = (zoutcnt & 511)+1;
  2547.         if (ofile_ffb != -1) {
  2548.         xabfhc_ofile.xab$w_ffb = ofile_ffb;
  2549.         if (ofile_ffb)
  2550.             rab_ofile.rab$w_rsz -= (512 - ofile_ffb);
  2551.         debug(F101,"zoutdump ofile_ffb","",(int)ofile_ffb);
  2552.         debug(F101,"zoutdump rab$w_rsz","",rab_ofile.rab$w_rsz);
  2553.         }
  2554.         rms_sts = sys$write(&rab_ofile);
  2555.         if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  2556.         if (rms_sts != RMS$_NORMAL) {
  2557.         debug(F101,"zoutdump $write failed, status","",rms_sts);
  2558.         return(-1);
  2559.         }
  2560.     }
  2561.     debug(F100,"zoutdump RMS operations completed ok","",0);
  2562.     zoutcnt = 0;
  2563.     zoutptr = zoutbuffer;
  2564.     return(0);
  2565.     }
  2566.  
  2567. /*
  2568.  * Must be ASCII. This is harder, and weirder... It's actually easier than
  2569.  * it looks, but there's (unfortunately) no really easy way to _implement_
  2570.  * it. (sigh, whimper, groan)
  2571.  */
  2572.  
  2573.     srcptr = zoutbuffer;            /* Points to first line in buffer */
  2574.     endptr = zoutbuffer + zoutcnt;  /* Points to location after last char */
  2575. zoutdump_ascii:
  2576.     /* Scan through buffer until we find a CR or we run out of chars */
  2577.     for (optr = srcptr; optr < endptr; optr++) if (*optr == CR) break;
  2578.  
  2579.     /* If there are at least 2 chars left in the buffer when we stop   */
  2580.     /* scanning, then it is assumed the above loop terminated because  */
  2581.     /* it found the CR and that both the CR and LF are present in the  */
  2582.     /* buffer (situation normal.                                       */
  2583.     /* If there are not 2 chars left in the buffer, we have one of two */
  2584.     /* cases which we treat identically:                               */
  2585.     /*  1) If there are 0 chars left in the buffer, then the line's    */
  2586.     /*     terminating CR LF are yet to come. So... we copy the data   */
  2587.     /*     to the front of the buffer and exit (next time it should be */
  2588.     /*     there.)                                                     */
  2589.     /*  2) If there is one char left in the buffer, we have the case of*/
  2590.     /*     a line with the CR but no LF present. So... do the same     */
  2591.     /*     because the LF will be coming next time.                    */
  2592.     if (optr+2 > endptr) {            /* drat! ran off the end */
  2593.     if (ofile_dump && (srcptr == endptr)) {
  2594.         /* If the beginning and end ptrs are the same, then there the  */
  2595.         /* is empty. Good news, 'cause we're clsoing up.               */
  2596.         zoutcnt = 0;        /* No looping, please. */
  2597.         zoutptr = zoutbuffer;
  2598.     }
  2599.     else if (ofile_dump) {        /* but it's cool, we're closing up */
  2600.         /* Oops, we've got a line with no LF and maybe no CR. Well     */
  2601.         /* write it out and exit abnormally.                           */
  2602.         rab_ofile.rab$l_rbf = (char *)srcptr;
  2603.         rab_ofile.rab$w_rsz = optr-srcptr;
  2604.         rms_sts = sys$put(&rab_ofile);
  2605.         if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  2606.         zoutcnt = 0;
  2607.         zoutptr = zoutbuffer;
  2608.         if (rms_sts != RMS$_NORMAL) {
  2609.         debug(F101, "zoutdump $put failed, status","",rms_sts);
  2610.         return(-1);
  2611.         }
  2612.     } else if (wrote_one_line) {    /* it's still cool, we did one... */
  2613.         zoutcnt = optr - srcptr;    /* number of chars left */
  2614.         if (optr < endptr) zoutcnt++; /*[jah083] including CR if present */
  2615.         if (zoutcnt) memmove(zoutbuffer, srcptr, zoutcnt);
  2616.             /* Move'em to front of buffer*/
  2617.         zoutptr = zoutbuffer+zoutcnt;
  2618.     } else {            /* WRONG!!! */
  2619.         /* We've got a buffer full of chars with no LF (it may or may  */
  2620.         /* not have a terminating CR. In either case its just plain too*/
  2621.         /* long. I suppose we could check here for the optr+1 == endptr*/
  2622.         /* which indicates that there was a CR but no LF so we could   */
  2623.         /* issue a "line barely too long", but, is it useful?          */
  2624.         debug(F100, "zoutdump: line too long","",0);
  2625.         zoutcnt = 0;        /* No looping, please. */
  2626.         zoutptr = zoutbuffer;
  2627.         return(-1);
  2628.     }
  2629.     debug(F101, "zoutdump exiting, zoutcnt","",zoutcnt);
  2630.     return(0);
  2631.     }
  2632.  
  2633.     /* We now have a line that we can write, so... */
  2634.  
  2635.     rab_ofile.rab$l_rbf = (char *)srcptr;
  2636.     rab_ofile.rab$w_rsz = optr-srcptr;
  2637.     rms_sts = sys$put(&rab_ofile);
  2638.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  2639.     if (rms_sts != RMS$_NORMAL) {
  2640.     debug(F101, "zoutdump $put failed, status","",rms_sts);
  2641.     return(-1);
  2642.     }
  2643.     srcptr = optr + 2;        /* Account for CR, LF */
  2644.     wrote_one_line = 1;
  2645.     goto zoutdump_ascii;
  2646. }
  2647.  
  2648. /*  C H K F N  --  Internal function to verify file number is ok.  */
  2649.  
  2650. /*
  2651.  Returns:
  2652.   -1: File number n is out of range
  2653.    0: n is in range, but file is not open
  2654.    1: n in range and file is open
  2655. */
  2656. int
  2657. chkfn(n) int n; {
  2658.     int x;
  2659.     if (n != ZDFILE)
  2660.       debug(F101,"chkfn","",n);
  2661.     switch (n) {
  2662.       case ZCTERM:
  2663.       case ZSTDIO:
  2664.       case ZIFILE:
  2665.       case ZOFILE:
  2666.       case ZDFILE:
  2667.       case ZTFILE:
  2668.       case ZPFILE:
  2669.       case ZSFILE:
  2670.     break;
  2671.       case ZSYSFN:            /* System functions */
  2672.     return(0);
  2673.       case ZRFILE:            /* READ and WRITE files */
  2674.       case ZWFILE:
  2675.       case ZMFILE:
  2676.       case ZDIFIL:
  2677.     break;
  2678.       default:
  2679.     if (n >= ZNFILS) {
  2680.         debug(F101,"chkfn: file number out of range","",n);
  2681.         fprintf(stderr,"?File number out of range - %d\n",n);
  2682.         return(-1);
  2683.     }
  2684.     }
  2685.     x = (fp[n] == NULL) ? 0 : 1;
  2686.     if (n != ZDFILE)
  2687.       debug(F101,"chkfn return","",x);
  2688.     return(x);
  2689. }
  2690.  
  2691. static int zgetfs_active = 0;
  2692. static CK_OFF_T zgfs_size = -1L;
  2693. int zgfs_dir = -1;
  2694. int zgfs_link = 0;
  2695. char linkname[2] = { '\0', '\0' };    /* No symlinks in VMS */
  2696.  
  2697. CK_OFF_T
  2698. zgetfs(name) char *name; {
  2699.     CK_OFF_T x;
  2700.     if (!name)
  2701.       name = "";
  2702.     if (!*name)
  2703.       return(-1);
  2704.     zgfs_size = -1L;
  2705.     zgfs_dir = -1;
  2706.     zgetfs_active = 1;
  2707.     x = zchki(name);
  2708.     zgetfs_active = 0;
  2709.     if (zgfs_dir < 0)
  2710.       zgfs_dir = isdir(name);
  2711.     if (x < 0 && zgfs_size >= 0)
  2712.       return(zgfs_size);
  2713.     return((x < -2) ? (CK_OFF_T)-1 : x);
  2714. }
  2715.  
  2716. /*  Z C H K I  --  Check if input file exists and is readable.  */
  2717.  
  2718. /*
  2719.   Returns:
  2720.    >= 0 if the file can be read (returns the size).
  2721.      -1 if file doesn't exist or can't be accessed,
  2722.      -2 if file exists but is not readable (e.g. a directory file).
  2723.      -3 if file exists but protected against read access.
  2724. */
  2725. CK_OFF_T
  2726. zchki(name) char *name; {
  2727.     struct stat statbuf;
  2728.     extern int zchkid;
  2729.     int x;
  2730.     struct FAB fab_chki;
  2731.     struct NAMX nam_chki;
  2732.     struct XABFHC xabfhc_chki;
  2733.     CK_OFF_T iflen = (CK_OFF_T)-1;
  2734.  
  2735.     if (!zchkid && !zgetfs_active && isdir(name))
  2736.       return(-2);
  2737.  
  2738.     if (!name) name = "";
  2739.     if (!*name) return(-1);
  2740.  
  2741.     if (zgetfs_active) {
  2742.         if (stat(name,&statbuf) == 0) {
  2743.         zgfs_link = 0;
  2744. #ifdef S_ISDIR
  2745.         zgfs_dir = (S_ISDIR(statbuf.st_mode)) ? 1 : 0;
  2746.         debug(F110,"zgetfs S_ISDIR",name,zgfs_dir);
  2747. #else
  2748.         zgfs_dir = isdir(name);
  2749.         debug(F110,"zgetfs isdir",name,zgfs_dir);
  2750. #endif /* S_ISDIR */
  2751.         zgfs_size = statbuf.st_size;
  2752.         debug(F110,"zgetfs size",name,zgfs_size);
  2753.         return(zgfs_size);
  2754.     }
  2755.     /* If stat() failed try RMS... */
  2756.     }
  2757.     fab_chki = cc$rms_fab;                      /* Initialize FAB. */
  2758.     nam_chki = CC_RMS_NAMX;                     /* Initialize NAM[L]. */
  2759.     fab_chki.FAB_L_NAMX = &nam_chki;            /* Point FAB to NAM[L]. */
  2760.  
  2761.     /* Install the path name in the FAB or NAML. */
  2762. #ifdef NAML$C_MAXRSS
  2763.     fab_chki.fab$l_dna = (char *) -1;  /* Using NAML for default name. */
  2764.     fab_chki.fab$l_fna = (char *) -1;  /* Using NAML for file name. */
  2765. #endif /* def NAML$C_MAXRSS */
  2766.     FAB_OR_NAML( fab_chki, nam_chki).FAB_OR_NAML_FNA = name;
  2767.     FAB_OR_NAML( fab_chki, nam_chki).FAB_OR_NAML_FNS = strlen( name);
  2768.  
  2769.     fab_chki.fab$b_fac = FAB$M_BIO;
  2770.     fab_chki.fab$l_xab = (char *)&xabfhc_chki;
  2771.     xabfhc_chki = cc$rms_xabfhc;
  2772.     rms_sts = sys$open(&fab_chki);
  2773.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  2774.     if (rms_sts == RMS$_PRV)            /* No privs */
  2775.       return(-3);
  2776.     if (rms_sts != RMS$_NORMAL) {
  2777.     debug(F101,"zchki $open failed, status","",rms_sts);
  2778.     return(-1);
  2779.     }
  2780.     iflen = (((CK_OFF_T)xabfhc_chki.xab$l_ebk-1)*512)+xabfhc_chki.xab$w_ffb;
  2781.  
  2782.     rms_sts = sys$close(&fab_chki);
  2783.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  2784.     if (rms_sts != RMS$_NORMAL) {
  2785.     debug(F101,"zchki $close failed, status","",rms_sts);
  2786.     return(-1);
  2787.     }
  2788.     ckstrncpy(nambuf,name,CKMAXPATH);    /* Keep local copy of name */
  2789.     debug(F111,"zchki access ok:",name,(int) iflen);
  2790.     return( (iflen > -1) ? iflen : 0 );
  2791. }
  2792.  
  2793. /*  Z C H K O  --  Check if output file can be created.  */
  2794.  
  2795. /*
  2796.  Returns -1 if write permission for the file would be denied, 0 otherwise.
  2797. */
  2798. #include <devdef.h>
  2799.  
  2800. int
  2801. zchko(name) char *name; {
  2802.     extern int zchkod;                  /* Used by IF WRITEABLE */
  2803.  
  2804.     struct FAB fab;            /* let RMS do the work */
  2805.     struct NAMX nam;
  2806.     char expanded_str[NAMX_C_MAXRSS+ 1];
  2807.  
  2808.     if (!name) return(-1);              /* Watch out for null pointer. */
  2809.     debug(F111,"zchko",name,zchkod);
  2810.  
  2811.     fab = cc$rms_fab;                   /* Initialize FAB. */
  2812.     nam = CC_RMS_NAMX;                  /* Initialize NAM[L]. */
  2813.     fab.FAB_L_NAMX = &nam;              /* Point FAB to NAM[L]. */
  2814.  
  2815.     /* Install the path name in the FAB or NAML. */
  2816. #ifdef NAML$C_MAXRSS
  2817.     fab.fab$l_dna = (char *) -1;  /* Using NAML for default name. */
  2818.     fab.fab$l_fna = (char *) -1;  /* Using NAML for file name. */
  2819. #endif /* def NAML$C_MAXRSS */
  2820.     FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNA = name;
  2821.     FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNS = strlen( name);
  2822.  
  2823.     fab.fab$l_alq = 1;                   /* zero length file may not be writeable */
  2824.     fab.fab$b_fac = FAB$M_BIO | FAB$M_PUT;     /* block i/o setup faster ? */
  2825.     fab.fab$l_fop = FAB$M_DLT;       /* TMD does not check directory file perm */
  2826.  
  2827.     nam.NAMX_L_ESA = expanded_str;
  2828.     nam.NAMX_B_ESS = sizeof( expanded_str)- 1;
  2829.  
  2830.     rms_sts = sys$parse(&fab);             /* check the file spec */
  2831.     if (!(rms_sts & 1)) {
  2832.         if (rms_sts == RMS$_SYN) {        /* nzrtol may fix */
  2833.             debug(F110,"zchko syntax error",name,0);
  2834.             return(0);
  2835.         } else {
  2836.             CHECK_ERR("zchko ", rms_sts);
  2837.             debug(F111,"zchko parse error",name,rms_sts);
  2838.             return(-1);
  2839.         }
  2840.     }                        /* file oriented device */
  2841.     if ((fab.fab$l_dev & DEV$M_NET) || (fab.fab$l_dev & DEV$M_FOD)) {
  2842.         *(nam.NAMX_L_VER+ nam.NAMX_B_VER) = '\0';
  2843.         debug(F110,"zchko create",expanded_str,0);
  2844.         rms_sts = sys$create(&fab);        /* test write capability */
  2845.         if (rms_sts & 1) {
  2846.             rms_sts = sys$close(&fab);
  2847.             return(0);
  2848.         } else {
  2849.             CHECK_ERR("zchko ", rms_sts);
  2850.             debug(F101,"zchko create error","",rms_sts);
  2851.             return(-1);
  2852.         }
  2853.      } else {
  2854.         *(nam.NAMX_L_DIR) = '\0';
  2855.         if (fab.fab$l_dev & DEV$M_REC) {     /* record-oriented device */
  2856.             debug(F110,"zchko non-fod",expanded_str,0);
  2857.             return(0);                /* omit access test */
  2858.         } else {
  2859.             debug(F111,"zchko invalid device",expanded_str,fab.fab$l_dev);
  2860.             return(-1);
  2861.         }
  2862.     }
  2863. }
  2864.  
  2865.  
  2866. /*  Z C H K S P A  --  Check if there is enough space to store the file.  */
  2867.  
  2868. /*
  2869.  Call with file specification f, size n in bytes.
  2870.  Returns -1 on error, 0 if not enough space, 1 if enough space.
  2871. */
  2872.  
  2873. int
  2874. zchkspa(f,n) char *f; CK_OFF_T n; {
  2875.  
  2876. /*
  2877.  * This is complicated. The user could have specified an explicit path when
  2878.  * sending the file, or could have done a CWD, or could be using the default
  2879.  * directory. If not the latter, the path may not even be a disk device, as
  2880.  * CWD LPA0: is perfect legal for uploading to the lineprinter. After that,
  2881.  * if it's a disk, we should check the user's quota.  However, the user may
  2882.  * have SYSPRV, EXQUOTA, BYPASS, or maybe even GRPPRV, and it would be hard
  2883.  * to  properly check for all these cases.  So, if the file will fit on the
  2884.  * disk, we'll accept it.
  2885.  */
  2886.  
  2887.     char   *zgtdir();
  2888.  
  2889.     struct itmlstdef {
  2890.     short int buflen;
  2891.     short int itmcod;
  2892.     char *bufaddr;
  2893.     long int *retlen;
  2894.     };
  2895.  
  2896.     static char device[64];
  2897.  
  2898.     struct dsc$descriptor_s
  2899.     dev_desc = {sizeof(device), DSC$K_DTYPE_T, DSC$K_CLASS_S,
  2900.               (char *)&device};
  2901.     unsigned long freeblocks, devclass, fileblocks;
  2902.     long freelength, classlength;
  2903.  
  2904.     struct itmlstdef itmlst[] =
  2905.     {4,DVI$_FREEBLOCKS,0,0,4,DVI$_DEVCLASS,0,0,0,0,0,0};
  2906.  
  2907.     int rms_sts;
  2908.  
  2909. /* First, figure out the device we're interested in */
  2910.  
  2911.     ckstrncpy(device,zgtdir(),64);    /* Handles default or CWD */
  2912.  
  2913.     if (strchr(f, ':'))            /* If user specified path */
  2914.       ckstrncpy(device, f, 64);
  2915.  
  2916.     debug(F110,"zchkspa target device is ",device,0);
  2917.  
  2918. /* Next, ask for free block count and device type (disk vs. non-disk) */
  2919.  
  2920.     itmlst[0].bufaddr = (char *)&freeblocks;
  2921.     itmlst[0].retlen = &freelength;
  2922.     itmlst[1].bufaddr = (char *)&devclass;
  2923.     itmlst[1].retlen = &classlength;
  2924.  
  2925.     rms_sts = sys$getdviw(0,0,&dev_desc,&itmlst,0,0,0,0);
  2926.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  2927.     debug(F101,"zchkspa $getdvi returned rms_sts","",rms_sts);
  2928.  
  2929.     if (devclass != DC$_DISK)
  2930.       return(1);                /* assume space if not disk */
  2931.  
  2932.     if (rms_sts != SS$_NORMAL)
  2933.       return(1);                /* assume free space if err */
  2934.  
  2935.     debug(F101,"zchkspa $getdvi returned freeblocks","",freeblocks);
  2936.  
  2937. /* Pad file size if it's a text file */
  2938.  
  2939.     if (ofile_bmode == XYFT_T)
  2940.       n += (n/40) * 3;
  2941.  
  2942.     fileblocks = n / 512 + 1;            /* compute file size in blks */
  2943.                         /* we may want some fuzz */
  2944.     if (fileblocks >= freeblocks)
  2945.       return(0);                /* Won't fit */
  2946.     else
  2947.       return(1);                /* Will fit */
  2948. }
  2949.  
  2950. /*  Z D E L E T  --  Delete the named file.  */
  2951.  
  2952. int
  2953. zdelet(name) char *name; {
  2954.     return(delete(name));
  2955. }
  2956.  
  2957. /*  Z R T O L  --  Convert remote filename into local form.  */
  2958.  
  2959. VOID
  2960. zrtol(name,name2) char *name, *name2; {
  2961.     nzrtol(name,name2,1,0,CKMAXPATH);
  2962. }
  2963. /*  N Z R T O L  --  New zrtol handles native and standard-format pathnames */
  2964.  
  2965. VOID
  2966. nzrtol(name,name2,fncnv,fnrpath,max)
  2967.     char *name, *name2; int fncnv, fnrpath, max;
  2968. { /* nzrtol */
  2969.     int start, sfncnv, colon = 0;
  2970.     char *np, *vp = NULL, c;
  2971.     char *ls = NULL;
  2972.     static char *spcl_set = "_-$[]<>:.\";";
  2973.     char tmpbuf[ NAMX_C_MAXRSS+ 2], *tmp;
  2974.     char * dotp = NULL;
  2975.  
  2976.     debug(F110,"nzrtol name",name,0);
  2977.     if (!name2) return;
  2978.     sfncnv = fncnv;
  2979.  
  2980.     tmpbuf[0] = NUL;
  2981.     tmpbuf[1] = NUL;
  2982.     tmpbuf[2] = NUL;
  2983.     start = 0;
  2984.     tmp = tmpbuf+start;
  2985.     {
  2986.     /* Autodetection of path format */
  2987.     int lb = 0, rb = 0, sl = 0, bl = 0;
  2988.     char *p = name;
  2989.     while (*p) {
  2990.         if (*p == '[' || *p == '<' ) lb++;
  2991.         if (*p == ']' || *p == '>' ) rb++;
  2992.         if (*p == ':') colon++;
  2993.         if (*p == '/') sl++;
  2994.         if (*p == '\\') bl++;
  2995.         p++;
  2996.     }
  2997.     if (lb == 1 && rb == 1 && !sl) { /* VMS detected */
  2998.         fncnv = 0;
  2999.         debug(F100,"nzrtol VMS brackets detected","",0);
  3000.     } else if (colon == 1 && !sl) { /* VMS detected */
  3001.         fncnv = 0;
  3002.         debug(F100,"nzrtol VMS colon detected","",0);
  3003.     } else if (!lb && !rb && sl > 0) { /* UNIX detected */
  3004.         fncnv = 1;
  3005.         debug(F101,"nzrtol UNIX slashes detected","",sl);
  3006.     }
  3007.     }
  3008.     debug(F101,"nzrtol fncnv","",fncnv);
  3009.  
  3010.     /* If converting pathnames, convert to VMS format */
  3011.  
  3012.     if (fncnv) {            /* Converting, so assume UNIX format */
  3013.     np = name;            /* Set name pointer */
  3014.     *tmp++ = '[';            /* Insert opening VMS bracket */
  3015.     if (*np == '/') {        /* It's an absolute pathname */
  3016.         np++;            /* Skip past leading slash */
  3017.     } else {            /* Relative pathname */
  3018.         *tmp++ = '.';        /* Insert '.' here */
  3019.     }
  3020.     while (*np) {            /* Convert to VMS format */
  3021.         if (*np == '/') {        /* Have directory separator */
  3022.         *tmp = '.';        /* So use this notation in VMS */
  3023.         ls = tmp;        /* Remember position of last slash */
  3024.         } else {
  3025.         *tmp = *np;
  3026.         }
  3027.         np++;
  3028.         tmp++;
  3029.     }
  3030.     *tmp = NUL;
  3031.     if (ls) {            /* Replace last slash by */
  3032.         *ls = ']';            /* closing directory bracket */
  3033.     } else {            /* No slashes */
  3034.         start += 2;            /* So skip past opening "[." */
  3035.     }
  3036.     } else {                /* Assume VMS format already */
  3037. #ifdef COMMENT
  3038. /* No, this would ruin any as-name the sender gave */
  3039. /* "Be conservative in what you send, liberal in what you receive" */
  3040.     int flag = 0;            /* Copy */
  3041.     np = name;            /* But strip node and device */
  3042.     while (*np) {
  3043.         if (*np == '[')
  3044.           flag = 1;
  3045.         if (flag)
  3046.           *tmp++ = *np;
  3047.         np++;
  3048.     }
  3049.     if (!flag)
  3050. #endif /* COMMENT */
  3051.       ckstrncpy(tmp, name, NAMX_C_MAXRSS); /* Just copy */
  3052.     }
  3053.     tmpbuf[ NAMX_C_MAXRSS] = NUL;    /* Make sure buffer is terminated */
  3054.     tmp = tmpbuf + start;        /* Reset pointer */
  3055.     name = tmp;                /* Treat new string as original arg */
  3056.     debug(F110,"nzrtol tmp 1",tmp,0);
  3057.  
  3058.     /* Now we have VMS path format in tmpbuf */
  3059.  
  3060.     if (fnrpath == PATH_OFF) {        /* RECEIVE PATHNAMES OFF */
  3061.     zstrip(name,&np);
  3062.     ckstrncpy(tmpbuf, np, NAMX_C_MAXRSS);
  3063.     tmp = tmpbuf;
  3064.     debug(F110,"nzrtol PATH_OFF",tmp,0);
  3065.     } else if (fnrpath == PATH_ABS) {    /* RECEIVE PATHNAMES ABSOLUTE */
  3066.     /* Nothing to do */
  3067.     debug(F110,"nzrtol PATH_ABS",tmp,0);
  3068.     } else if (isabsolute(name)) {    /* RECEIVE PATHNAMES RELATIVE */
  3069.     int x;
  3070.     char * bb = NULL;
  3071.     x = strlen(name);
  3072.     debug(F111,"nzrtol converting absolute to relative tmp",tmp,x);
  3073. #ifdef COMMENT
  3074.     if (bb = malloc(x+x+1)) {    /* Be safe */
  3075.         char * b = bb;
  3076.         np = name;
  3077.         while (*np) {
  3078.         *b++ = *np;
  3079.         if (*np == '[' && *(np+1) != '.')
  3080.           *b++ = '.';
  3081.         np++;
  3082.         }
  3083.         *b = NUL;
  3084.         ckstrncpy(tmpbuf, bb, NAMX_C_MAXRSS);
  3085.         tmp = tmpbuf;
  3086.         free(bb);
  3087.     }
  3088. #else  /* Not COMMENT - From Lucas Hart, Oct 1999 */
  3089.        /* strip any node or device and move in place */
  3090.         start = ckindex(":",name,-1,1,1);
  3091.         np = name + start;        /* ptr to name in tmpbuf */
  3092.         bb = tmpbuf;            /* destination */
  3093.     if (tmpbuf[0] == '[') {        /* [179] If it starts with a bracket */
  3094.         *bb++ = *np++;        
  3095.         if (*np != '.')
  3096.           *bb++ = '.';        /* make relative */
  3097.     }
  3098.         memmove(bb,np,strlen(np)+1);    /* safe: tmpbuf[NAMX_C_MAXRSS] = NUL */
  3099.         tmp = tmpbuf;
  3100. #endif  /* COMMENT */
  3101.     debug(F110,"nzrtol PATH_REL 1",tmp,0);
  3102.     } else {                /* Ditto */
  3103.     /* Nothing to do - it's already done */
  3104.     debug(F110,"nzrtol PATH_REL 2",tmp,0);
  3105.     }
  3106.     tmpbuf[ NAMX_C_MAXRSS] = NUL;
  3107.     debug(F110,"nzrtol tmp 2",tmp,0);
  3108.  
  3109. #ifdef COMMENT                /* Not needed for Edit 166 zmkdir */
  3110.     /* But wait, there's more... */
  3111.     /* Convert relative name to absolute or else zmkdir won't work */
  3112.     {
  3113.     char buf2[ NAMX_C_MAXRSS+ 2], *p, *b;
  3114.     int n = 0, flag = 0;
  3115.     np = tmp;            /* Source pointer */
  3116.     b = buf2;            /* Where to put new name */
  3117.     while (*np && n < NAMX_C_MAXRSS) { /* And substitute it; */
  3118.         *b++ = *np;
  3119.         n++;
  3120.         if (*np == '[' && *(np+1) == '.') {
  3121.         p = zgtdir();        /* Get current directory */
  3122.         while (*p && *p != '[')    /* The part inside the brackets */
  3123.           p++;
  3124.         if (*p = '[') {        /* Substitute it in */
  3125.             p++;
  3126.             while (*p && *p != ']') {
  3127.             *b++ = *p++;
  3128.             if (n++ >= NAMX_C_MAXRSS)
  3129.               break;
  3130.             }
  3131.         }
  3132.         }
  3133.         np++;
  3134.     }
  3135.     *b = NUL;
  3136.     tmp = buf2;
  3137.     debug(F110,"nzrtol tmp 3",tmp,0);
  3138.     }
  3139. #endif /* COMMENT */
  3140.     fncnv = sfncnv;            /* Restore original value of this */
  3141.     if (!fncnv) {            /* Now check it; if not converting */
  3142.     ckstrncpy(name2,tmp,max);    /* We're done. */
  3143.     debug(F110,"nzrtol name2",name2,0);
  3144.     return;
  3145.     }
  3146.     /* Now convert the characters themselves */
  3147.  
  3148.     name = tmp;
  3149.     for (np = name2; c = *name; name++) {
  3150.     if (islower(c))
  3151.       c = toupper(c);
  3152.     else if (c == '~' || c == SP)
  3153.       c = '_';
  3154.     else if (!isalnum(c) && !strchr(spcl_set,c))
  3155.       c = '$';
  3156.     *np++ = c;
  3157.     }
  3158.     *np = NUL;                /* End of name */
  3159.     {                    /* Now take care of periods. */
  3160.     int x;
  3161.     int ndots = 0;
  3162.     char * ld = NULL;        /* Last dot */
  3163.     char * nld = NULL;        /* Next to last dot */
  3164.     x = strlen(name2) - 1;
  3165.     for (; x >= 0; x--) {        /* Keep only the last one. */
  3166.         if (name2[x] == ']' ||    /* But only do this */
  3167.         name2[x] == ':' ||    /* in the filename part */
  3168.         name2[x] == '>'
  3169.         )
  3170.           break;
  3171.         if (name2[x] == '.') {    /* Turn prior ones to underscore. */
  3172.         ndots++;
  3173.         if (ndots == 1)
  3174.           ld = name2+x;
  3175.         else if (ndots == 2)
  3176.           nld = name2+x;
  3177.         else if (ndots > 2)
  3178.           name2[x] = '_';
  3179.         }
  3180.     }
  3181. /*
  3182.   Finally we check to see if the final dot was really a version-number
  3183.   introducer; if so, we turn it into a semicolon and keep the next-to-last
  3184.   dot, otherwise we replace the next-to-last dot with an underscore.  Then we
  3185.   have exactly one dot in the name.
  3186. */
  3187.     if (nld && ld) {        /* We have two dots left */
  3188.         char *sld = ld;        /* Save position of last one */
  3189.         ld++;            /* Point past it */
  3190.         while (*ld <= '9' && *ld >= '0') /* See if only digits follow */
  3191.           ld++;
  3192.         if (*ld) {            /* No */
  3193.         *nld = '_';        /* replace previous '.' by '_' */
  3194.         } else {            /* yes */
  3195.         *sld = ';';        /* replace '.' by ';' */
  3196.         }
  3197.     }
  3198.     }
  3199.     debug(F110,"nzrtol name2 1",name2,0);
  3200.  
  3201.     /* But wait, there's more -- each dotted segment must be <= 39 chars  */
  3202.  
  3203.     {
  3204.     char buf3[ NAMX_C_MAXRSS+ 2], *p, *b;
  3205.     int n = 0;
  3206.     for (b = buf3, p = name2; *p; p++) {
  3207.         if (*p == ';'
  3208. #ifdef VMSVERSIONS
  3209.         && !vmsrversions
  3210. #endif /* VMSVERSIONS */
  3211.         ) {            /* Discard version number */
  3212.         if (rdigits(p+1)) {
  3213.             *b++ = '\0';
  3214.             break;
  3215.         }
  3216.         }
  3217.         if (*p == '.' ||        /* Check for segment boundary */
  3218.         *p == '[' ||
  3219.         *p == ']' ||
  3220.         *p == ':' ||
  3221.         *p == '<' ||
  3222.         *p == '>' ||
  3223.         *p == ';')
  3224.           n = 0;
  3225.         if (n < 39) {        /* In segment copy up to 39 chars */
  3226.         *b++ = *p;
  3227.         n++;
  3228.         }
  3229.     }
  3230.     *b = '\0';
  3231.     ckstrncpy(name2,buf3,max);
  3232.     }
  3233.     debug(F110,"nzrtol name2 2",name2,0);
  3234. }
  3235.  
  3236. /*  Z L T O R  --  Convert filename from local format to common form.  */
  3237.  
  3238. VOID
  3239. zltor(name,name2) char *name, *name2; {
  3240.     nzltor(name,name2,1,0,CKMAXPATH);
  3241. }
  3242.  
  3243. VOID
  3244. nzltor(name,name2,fncnv,fnspath,cp_len)
  3245.     char *name, *name2; int fncnv, fnspath, cp_len;
  3246. /* nzltor */ {
  3247.     char *cp, *pp;
  3248.     int flag;
  3249.     struct FAB fab;
  3250.     struct NAMX nam;
  3251.     char expanded_name[ NAMX_C_MAXRSS];
  3252.     char dirbuf[ NAMX_C_MAXRSS], *p, *q, *q2, *r, *s, *s2;
  3253.     int long rms_status;
  3254.     int cur_len = 0;
  3255.  
  3256.     debug(F111,"zltor fncnv",name,fncnv);
  3257.  
  3258.     flag = PARSE_NAME|PARSE_TYPE;
  3259.     if (fnspath == PATH_REL || fnspath == PATH_ABS)
  3260.       flag |= PARSE_DIRECTORY;
  3261. #ifdef VMSVERSIONS
  3262.     if (vmssversions)
  3263.       flag |= PARSE_VERSION;
  3264. #endif /* VMSVERSIONS */
  3265.  
  3266.     fab = cc$rms_fab;                   /* Initialize FAB. */
  3267.     nam = CC_RMS_NAMX;                  /* Initialize NAM[L]. */
  3268.     fab.FAB_L_NAMX = &nam;              /* Point FAB to NAM[L]. */
  3269.  
  3270.     /* Install the path name in the FAB or NAML. */
  3271. #ifdef NAML$C_MAXRSS
  3272.     fab.fab$l_dna = (char *) -1;  /* Using NAML for default name. */
  3273.     fab.fab$l_fna = (char *) -1;  /* Using NAML for file name. */
  3274. #endif /* def NAML$C_MAXRSS */
  3275.     FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNA = name;
  3276.     FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNS = strlen( name);
  3277.  
  3278.     /* Install the default path name in the FAB or NAML. */
  3279. #define NONAME "NONAME"
  3280.     FAB_OR_NAML( fab, nam).FAB_OR_NAML_DNA = NONAME;
  3281.     FAB_OR_NAML( fab, nam).FAB_OR_NAML_DNS = strlen( NONAME);
  3282.  
  3283.     nam.NAMX_L_ESA = expanded_name;
  3284.     nam.NAMX_B_ESS = sizeof( expanded_name);
  3285.  
  3286.     if (!CHECK_ERR("%%CKERMIT-W-ZLTOR",sys$parse(&fab)))
  3287.       return;
  3288.  
  3289.     cp = name2;                /* Point to result */
  3290.     *cp = '\0';                /* Initialize it to empty */
  3291.  
  3292.     if ((PARSE_NODE & flag) && nam.NAMX_B_NODE && /* DECnet node:: */
  3293.     cur_len+ nam.NAMX_B_NODE < cp_len) {
  3294.     cur_len += nam.NAMX_B_NODE;
  3295.     strncat(cp, nam.NAMX_L_NODE, nam.NAMX_B_NODE);
  3296.     }
  3297.     if ((PARSE_DEVICE & flag) && nam.NAMX_B_DEV && /* Device: */
  3298.         cur_len+ nam.NAMX_B_DEV < cp_len) {
  3299.     cur_len += nam.NAMX_B_DEV;
  3300.     strncat(cp, nam.NAMX_L_DEV, nam.NAMX_B_DEV);
  3301.     }
  3302.  
  3303.     /* Directory Name [] */
  3304.  
  3305.     if ((PARSE_DIRECTORY & flag) && nam.NAMX_B_DIR &&
  3306.         cur_len+ nam.NAMX_B_DIR < cp_len) {
  3307.     int i; char * tmp;
  3308.         q = nam.NAMX_L_DIR;        /* The directory name from RMS */
  3309.     i = nam.NAMX_B_DIR;        /* Length; string not NUL-terminated */
  3310.     debug(F111,"zltor nam$_dir",q,i);
  3311.     if (!q) q = "[]";
  3312.     if (!*q) q = "[]";
  3313.     if (i < 0) i = 0;
  3314.     tmp = NULL;
  3315.     if (i > 0) {            /* Copy directory part */
  3316.         if (tmp = malloc(i+1)) {
  3317.         p = tmp;
  3318.         for (; i > 0 ; i--)
  3319.           *p++ = *q++;
  3320.         *p = NUL;
  3321.         }
  3322.     }
  3323.     q = tmp;
  3324.     debug(F111,"zltor directory part",q,i);
  3325.  
  3326.     s = zgtdir();            /* Get current directory */
  3327.     debug(F110,"zltor zgtdir",s,0);
  3328.     if (!s) s = "[]";
  3329.     if (!*s) s = "[]";
  3330.     s2 = "";
  3331.     while (*s && *s != '[')
  3332.       s++;
  3333.     if (*s) {
  3334.         s2 = s+1;
  3335.         while (*s2 && *s2 != ']') s2++; /* Closing bracket */
  3336.     }
  3337.     if (*s2) if (!*(s2+1)) *(s2+1) = NUL;
  3338.     debug(F110,"zltor current dir",s,0);
  3339.  
  3340. /* First change the VMS pathname to relative format if fnspath == PATH_REL */
  3341.  
  3342. /* Note that the user-specified default directory from zgtdir() may
  3343.  * differ in case from the actual directory spec from sys$parse(), so a
  3344.  * case-insensitive comparison is needed here (between *s and *q).
  3345.  */
  3346.     p = dirbuf;            /* Result */
  3347.     *p++ = *q++;            /* Copy left bracket and... */
  3348.  
  3349.     s++;                /* Point past it */
  3350.     q2 = q;                /* Remember this place */
  3351.     if (fnspath == PATH_REL) {    /* Compare this and current dir */
  3352.         while (((islower( *s) ? toupper( *s) : *s) ==
  3353.          (islower( *q) ? toupper( *q) : *q)) &&
  3354.          *s && *q && *s != ']') {
  3355.         s++;
  3356.         q++;
  3357.         }
  3358.     }
  3359.     if ( (*s != ']' && *q != ']' && *q != '.') ||
  3360.              (*q == ']' && *s != ']') ) {               /* No match */
  3361.         p-- ;            /* So rewind source pointer */
  3362.     } else if (*q == ']' && *s == ']') { /* Current directory */
  3363.         p = dirbuf;            /* So make directory part blank */
  3364.     } else {            /* Not current directory */
  3365.         while (*q) *p++ = *q++;    /* so copy the rest */
  3366.     }
  3367.     *p = NUL;
  3368.     debug(F110,"zltor result 1",dirbuf,0);
  3369. /*
  3370.    VMS directory name is now in dirbuf in either absolute or relative format.
  3371.    Now change it to standard (UNIX) format if desired.
  3372. */
  3373.     p = dirbuf;            /* Working pointer */
  3374.     r = dirbuf;            /* Result pointer */
  3375.     if (dirbuf[0]) {
  3376.         extern char whoareu[], * cksysid;
  3377.         /* Converting directory format */
  3378.         debug(F110,"zltor whoareu",whoareu,0);
  3379.         debug(F110,"zltor cksysid",cksysid,0);
  3380.         if (fncnv || (whoareu[0] && strcmp((char *)whoareu,cksysid))) {
  3381.         int xflag = 0;
  3382.         if (p[1] == '.') {    /* Directory name is relative */
  3383.             r += 2;        /* Point past the leading dot */
  3384.             p += 2;
  3385.         }
  3386.         while (*p) {        /* Now convert the rest */
  3387.             if (*p == '.' || *p == '[' || *p == ']') {
  3388.             if (!xflag) *p = '/';
  3389.             if (*p == ']')
  3390.               xflag = 1;
  3391.             }
  3392.             p++;
  3393.         }
  3394.         }
  3395.     }
  3396.     debug(F110,"zltor result 2",r,0);
  3397.     if (tmp) free(tmp);
  3398.     i = strlen(r);
  3399.     if (i > 0) {
  3400.         strncat(cp,r,cp_len);
  3401.         cur_len += i;
  3402.     }
  3403.     }
  3404.     if ((PARSE_NAME & flag) && nam.NAMX_B_NAME &&
  3405.         cur_len+ nam.NAMX_B_NAME < cp_len) {
  3406.     cur_len += nam.NAMX_B_NAME;
  3407.     strncat(cp, nam.NAMX_L_NAME, nam.NAMX_B_NAME);
  3408.     }
  3409.     if ((PARSE_TYPE & flag) && nam.NAMX_B_TYPE &&
  3410.         cur_len+ nam.NAMX_B_TYPE < cp_len) {
  3411.     cur_len += nam.NAMX_B_TYPE;
  3412.     strncat(cp, nam.NAMX_L_TYPE, nam.NAMX_B_TYPE);
  3413.     }
  3414.     if ((PARSE_VERSION & flag) && nam.NAMX_B_VER &&
  3415.         cur_len+ nam.NAMX_B_VER < cp_len) {
  3416.     cur_len += nam.NAMX_B_VER;
  3417.     strncat(cp, nam.NAMX_L_VER, nam.NAMX_B_VER);
  3418.     }
  3419.     if (fncnv && name2[cur_len] == NUL && name2[cur_len-1] == '.')
  3420.       name2[cur_len-1] = NUL;
  3421.     name2[cp_len-1] = NUL;
  3422.     debug(F111,"zltor result",name2,cur_len);
  3423. }
  3424.  
  3425. /*  C V T D I R  --  Convert directory name from [FOO]BAR.DIR;1 to [FOO.BAR] */
  3426.  
  3427. /*
  3428.   Call with:
  3429.     s = pointer to a string that has already been verified as a directory name
  3430.     s2 = pointer to where to put result
  3431.     len = size of destination buffer
  3432.   Returns:
  3433.     n on success, n > 0, size of result
  3434.     0 if no conversion was needed
  3435.    -1 on failure
  3436. */
  3437. int
  3438. cvtdir(s,s2,len) char * s, * s2; int len; {
  3439.     int i, n;
  3440.     char dirbuf[ NAMX_C_MAXRSS+ 1];
  3441.     char * p = NULL;            /* Pointer to period */
  3442.     char * o = NULL;            /* Pointer to left bracket */
  3443.     char * r = NULL;            /* Pointer to right bracket */
  3444.     char * v = NULL;            /* Pointer to version */
  3445.     char * c = NULL;            /* Pointer to colon */
  3446.     char * q = NULL;
  3447.     char * t;
  3448.     int xx = NAMX_C_MAXRSS+ 1;
  3449.  
  3450.     debug(F111,"cvtdir",s,len);
  3451.  
  3452.     if (!s || !s2)
  3453.       return(-1);
  3454.     n = strlen(s);
  3455.     if (n < 1)
  3456.       return(-1);
  3457.     q = malloc(n+1);
  3458.     if (!q)
  3459.       return(-1);
  3460.     t = q;
  3461.     strcpy( q, s);
  3462.     s = t;
  3463.     debug(F111,"cvtdir 2",s,n);
  3464.  
  3465.     /* Find special characters.
  3466.      * 2010-03-15 SMS.
  3467.      * Changed to look for the rightmost dot, because the old scheme
  3468.      * (leftmost dot) got confused by directory dots in specs like
  3469.      * "[a.b.c]d.DIR;1".
  3470.      * If the path argument is supoposed to be legitimate, then it might
  3471.      * make more sense to use sys$parse() to parse the thing.
  3472.      * Otherwise, it might make some sense to check for realism, like,
  3473.      * say, ":" comes before "[", "[" comes before "]", and so on.
  3474.      */
  3475.     for (i = n; i > 0; i--) {
  3476.         if ((i > 0) && (s[ i- 1] == '^'))   /* Skip caret-escaped chars. */
  3477.         {
  3478.             i--;
  3479.             continue;
  3480.         }
  3481.     if (s[i] == ';')
  3482.     {
  3483.         if (v == NULL)
  3484.           v = s+i;                          /* Rightmost semicolon. */
  3485.     }
  3486.     else if (s[i] == '.')
  3487.     {
  3488.           if (p == NULL)
  3489.         p = s+i;                            /* Rightmost dot. */
  3490.     }
  3491.     else if (s[i] == ':')
  3492.       c = s+i;                              /* Leftmost colon. */
  3493.     else if (s[i] == ']' || s[i] == '>')
  3494.     {
  3495.       if (r == NULL)
  3496.         r = s+i;                            /* Rightmost dir bracket. */
  3497.     }
  3498.     else if (s[i] == '[' || s[i] == '<')
  3499.       o = s+i;                              /* Leftmost dir bracket. */
  3500.     }
  3501.     debug(F110,"cvtdir c",c,0);
  3502.     debug(F110,"cvtdir r",r,0);
  3503.     debug(F110,"cvtdir o",o,0);
  3504.     debug(F110,"cvtdir p",p,0);
  3505.     debug(F110,"cvtdir v",v,0);
  3506.  
  3507.     dirbuf[0] = NUL;
  3508.  
  3509.     if (c) {                /* Have colon? */
  3510.     *c = NUL;
  3511.     ckstrncat(dirbuf,s,xx);
  3512.     ckstrncat(dirbuf,":",xx);
  3513.     s = c+1;
  3514.     }
  3515.     debug(F110,"cvtdir 3",dirbuf,0);
  3516.  
  3517.     if (o) {                /* Have opening bracket? */
  3518.     if (r) {
  3519.         *r = NUL;
  3520.         s = r+1;
  3521.         ckstrncat(dirbuf,"[",xx);
  3522.         ckstrncat(dirbuf,o+1,xx);
  3523.     } else
  3524.       return(-1);
  3525.     } else
  3526.       ckstrncat(dirbuf,"[",xx);
  3527.     debug(F110,"cvtdir 4",dirbuf,0);
  3528.  
  3529.     /* Look for ".DIR;".
  3530.      * (Why look for ".DIR." here, when anything but a semicolon would
  3531.      * bewilder the whole dot search?)
  3532.      */
  3533.     if (p) {
  3534.     if (((*(p+1) == 'D') || (*(p+1) == 'd')) &&
  3535.         ((*(p+2) == 'I') || (*(p+2) == 'i')) &&
  3536.         ((*(p+3) == 'R') || (*(p+3) == 'r')) &&
  3537.         (*(p+4) == ';' || *(p+4) == '.' || *(p+4) == NUL))
  3538.       *p = NUL;
  3539.     else
  3540.       return(-1);
  3541.     ckstrncat(dirbuf,".",xx);
  3542.     ckstrncat(dirbuf,s,xx);
  3543.     }
  3544.     ckstrncat(dirbuf,"]",xx);
  3545.     xx = ckstrncpy(s2,dirbuf,len);
  3546.     debug(F111,"cvtdir 5", dirbuf, xx);
  3547.     return((xx < (int)strlen(dirbuf)) ? -1 : xx);
  3548.  
  3549. #ifdef COMMENT
  3550.     if (r && p && v) {
  3551.     if (*(p+1) == 'D' &&
  3552.         *(p+2) == 'I' &&
  3553.         *(p+3) == 'R' &&
  3554.         *(p+4) == ';') {
  3555.         *r = NUL;
  3556.         strcpy(q,s);
  3557.         strcat(q,".");
  3558.         *p = NUL;
  3559.         strcat(q,p);
  3560.         strcat(q,"]");
  3561.     }
  3562.     debug(F110,"cvtdir result",q,0);
  3563.     return(1);
  3564.     }
  3565.     return(0);
  3566. #endif /* COMMENT */
  3567. }
  3568.  
  3569. /*  Z C H D I R  --  Change directory.  */
  3570.  
  3571. static int setddir = 0;
  3572. /*
  3573.   This one is for restoring the startup directory in case SYS$SETDDIR() was
  3574.   ever called -- see comments below in zchdir().
  3575. */
  3576. VOID
  3577. zrestoredir() {
  3578.     int status;
  3579.     struct dsc$descriptor_s indesc;
  3580.     if (!setddir)
  3581.       return;
  3582.     debug(F101,"zrestoredir setddir","",setddir);
  3583.     indesc.dsc$w_length = strlen( startupdir);
  3584.     indesc.dsc$a_pointer = startupdir;
  3585.     indesc.dsc$b_class = DSC$K_CLASS_S;
  3586.     indesc.dsc$b_dtype = DSC$K_DTYPE_T;
  3587.     status = sys$setddir(&indesc, 0, 0);
  3588.     if (!(status & 1)) vms_lasterr = status;
  3589.     debug(F111,"zrestoredir sys$setddir",startupdir,status);
  3590.     return;
  3591. }
  3592.  
  3593. int
  3594. zchdir(dirnam) char *dirnam; {
  3595. #ifndef NOSPL
  3596.     extern struct mtab *mactab;             /* Main macro table */
  3597.     extern int nmac;                        /* Number of macros */
  3598. #endif /* NOSPL */
  3599.     char dirbuf[ NAMX_C_MAXRSS+ 1];
  3600.     int status;
  3601.     struct dsc$descriptor_s indesc;
  3602.  
  3603.     if (!dirnam)            /* Watch out for null pointers */
  3604.       dirnam = "";
  3605.     debug(F110,"zchdir",dirnam,0);
  3606.  
  3607.     if (!*dirnam) {            /* No arg so back to home directory */
  3608. #ifdef COMMENT
  3609.     ckstrcpy(dirbuf, getenv("HOME"), NAMX_C_MAXRSS);
  3610.     dirnam = (char *) dirbuf;
  3611.     debug(F110,"zchdir home","",0);
  3612.     if (!isdir(dirnam))
  3613.       return(0);
  3614. #else /* def COMMENT */
  3615.     dirnam = "SYS$LOGIN";        /* Supply default */
  3616. #endif /* def COMMENT [else] */
  3617.     }
  3618.  
  3619. #ifdef COMMENT                /* Why is this commented out? */
  3620. /* We now assume that dirnam is a valid directory name */
  3621.     status = isdir(dirnam);        /* Preverify to prevent C lib traps */
  3622.     debug(F111,"zchdir isdir 1",dirnam,status);
  3623.     x = strlen(dirnam);
  3624.     if (!status) {            /* Not a directory */
  3625.     if (dirnam[0] == '[')
  3626.       return(0);
  3627.     if (x > 0 && (dirnam[x-1] == ']' || dirnam[x-1] == ':'))
  3628.       return(0);
  3629.     if (*dirnam == '.')        /* Be nice - is it a subdirectory */
  3630.       sprintf(dirbuf,"[%s]",dirnam); /* of the current directory? */
  3631.     else
  3632.       sprintf(dirbuf,"[.%s]",dirnam);
  3633.     status = isdir(dirbuf);
  3634.     debug(F111,"zchdir isdir 2",dirnam,status);
  3635.     if (!status)
  3636.       return(0);            /* Nope */
  3637.     dirnam = dirbuf;        /* Ayup */
  3638.     } /* ( We should really save "ayup" comments for the Maine program :-) */
  3639.  
  3640.     if (status == 2) {            /* It's [FOO]BAR.DIR;1 */
  3641.     /* Must convert to [FOO.BAR] */
  3642.     debug(F111,"zchdir malloc",dirnam,x);
  3643.     if (cvtdir(dirnam, dirbuf, NAMX_C_MAXRSS+ 1) > 0) {
  3644.         debug(F110,"zchdir cvtdir",dirbuf,0);
  3645.         dirnam = dirbuf;
  3646.     }
  3647.     }
  3648. #endif /* def COMMENT */
  3649. /*
  3650.   chdir() works as expected, when it works.  It only affects this process
  3651.   and those below it, and it handles search lists, hidden devices, etc.
  3652.   EXCEPT in VMS 6.2, in which a bug was introduced in the C runtime library.
  3653.   So we try chdir() first...
  3654. */
  3655.     debug(F110,"zchdir chdir",dirnam,0);
  3656.     status = chdir(dirnam);
  3657.     debug(F101,"zchdir status","",status);
  3658. /*
  3659.   chdir() fails in VMS 6.2 when given a logical name like SYS$LOGIN that
  3660.   refers to a search list (e.g. for the SYSMGR ID on a cluster) or to a
  3661.   hidden device.  In this case SYS$SETDDIR works, but it has the unfortunate
  3662.   side effect of changing the default directory for the whole job, not just
  3663.   C-Kermit and below.
  3664. */
  3665.     if (status == 0) {            /* chdir() worked */
  3666.     return(1);
  3667.     } else {                /* chdir() failed */
  3668.     indesc.dsc$w_length = (int) strlen(dirnam);
  3669.     indesc.dsc$a_pointer = dirnam;
  3670.     indesc.dsc$b_class = DSC$K_CLASS_S;
  3671.     indesc.dsc$b_dtype = DSC$K_DTYPE_T;
  3672.     status = sys$setddir(&indesc, 0, 0);
  3673.     if (!(status & 1)) vms_lasterr = status;
  3674.     debug(F111,"zchdir sys$setddir",dirnam,status);
  3675.     if (status == RMS$_NORMAL) {
  3676.         setddir = 1;        /* Set this if setddir() ever used */
  3677. #ifndef NOSPL
  3678.             if (nmac) {            /* Any macros defined? */
  3679.                 int k;            /* Yes */
  3680.                 static on_cd = 0;
  3681.                 if (!on_cd) {
  3682.                     on_cd = 1;
  3683.                     k = mlook(mactab,"on_cd",nmac);  /* Look this up */
  3684.                     if (k >= 0) {                    /* If found, */
  3685.                         if (dodo(k,zgtdir(),0) > -1) /* set it up, */
  3686.               parser(1);                 /* and execute it */
  3687.                     }
  3688.                     on_cd = 0;
  3689.                 }
  3690.             }
  3691. #endif /* NOSPL */
  3692.         return(1);
  3693.     } else
  3694.       return(0);
  3695.     }
  3696. }
  3697.  
  3698. /*  Z H O M E  --  Return pointer to user's home (login) directory.  */
  3699.  
  3700. char *
  3701. zhome() {
  3702.  
  3703. /*  return(getenv("HOME")); */          /* No... */
  3704. /*  return(getenv("SYS$LOGIN")); */     /* No... */
  3705. /*  return("SYS$LOGIN"); */             /* Maybe - but we need a terminator */
  3706.     return("SYS$LOGIN:");
  3707. }
  3708.  
  3709. /*  Z R E L N A M E  --  Make full pathname to relative to given directory */
  3710. /*
  3711.   Inputs:
  3712.     filespec: a full VMS pathname for a file, e.g.      DSK0:[DIR]OOFA.TXT;3
  3713.     dir:      a full VMS pathname for a directory, e.g. DSK0:[DIR.SUBDIR]
  3714.   Returns:
  3715.     Pointer to filespec relative to the given directory.
  3716.   Examples:
  3717.     1. filespec: DSK0:[OLGA]LOGIN.COM;63
  3718.        dir:      DSK0:[OLGA]
  3719.        result:   LOGIN.COM;63
  3720.     2. filespec: DSK0:[OLGA.LETTERS]JURY.TXT;1
  3721.        dir:      DSK0:[OLGA]
  3722.        result:   [.LETTERS]JURY.TXT;1
  3723.     3. filespec: DSK0:[OLGA.LETTERS.ANGRY]COMPLAINT.TXT;1
  3724.        dir:      DSK0:[OLGA]
  3725.        result:   [.LETTERS.ANGRY]COMPLAINT.TXT;1
  3726.     4. filespec: DSK0:[OLGA]LOGIN.COM;63
  3727.        dir:      DSK0:[OLGA.LETTERS.ANGRY]
  3728.        result:   [--]LOGIN.COM;63
  3729.     5. filespec: DSK0:[OLGA.LETTERS.NICE]PRAISE.TXT;3
  3730.        dir:      DSK0:[OLGA.LETTERS.ANGRY]
  3731.        result:   [-.NICE]PRAISE.TXT;3
  3732.     6. filespec: DSK1:[SYSTOOLS]KERMIT.EXE;1
  3733.        dir:      DSK0:[OLGA.LETTERS.ANGRY]
  3734.        result:   DSK1:[SYSTOOLS]KERMIT.EXE;1
  3735. */
  3736. static char relnambuf[CKMAXPATH];
  3737.  
  3738. char *
  3739. zrelname(filespec, dir) char *filespec, *dir; {
  3740.     char * xs = filespec;        /* Should be a complete filespec, */
  3741.     char * s = filespec;        /* like DEV:[DIR]NAME.EXT;n. */
  3742.     char * p = dir;            /* Should be complete DEV:[DIR] */
  3743.     char * xp = NULL;
  3744.     char indir = NUL;
  3745.  
  3746.     debug(F110,"zrelname filespec",filespec,0);
  3747.     debug(F110,"zrelname dir",dir,0);
  3748.  
  3749.     for (; *s; s++,p++) {        /* Compare */
  3750.     if (*s == *p) {
  3751.         if (*s == ':') {        /* End of device portion */
  3752.         xs = s;
  3753.         } else if (*s == '[') {    /* Begin directory portion */
  3754.         indir = ']';
  3755.         } else if (*s == '<') {    /* Ditto */
  3756.         indir = '>';
  3757.         } else if (*s == '.' && indir) { /* End of directory segment */
  3758.         xs = s;            /* Remember it */
  3759.         xp = p;
  3760.         } else if (*s == indir) {    /* End of directory portion */
  3761.         xs = s;
  3762.         break;
  3763.         } else if (*p == indir) {
  3764.         xp = p;
  3765.         break;
  3766.         }
  3767.         continue;
  3768.     } else if (*s == '.' && indir && *p == indir) {
  3769.         xp = NULL;
  3770.         xs = s;
  3771.     } else if (*p == '.' && indir && *s == indir) {
  3772.         xp = p;
  3773.         xs = s;
  3774.     }
  3775.     break;
  3776.     }
  3777.  
  3778.     debug(F110,"zrelname xs",xs,0);
  3779.     debug(F110,"zrelname xp",xp,0);
  3780.  
  3781.     if (xs == filespec || !*xs) {    /* Nothing to strip */
  3782.     ckstrncpy(relnambuf,filespec,CKMAXPATH);
  3783.     } else if (xp && (*s != indir || *p != indir)) { /* File is above here */
  3784.     int i, m = 0;
  3785.     char c, * s2 = xp;
  3786.     while (c = *s2++) {
  3787.         if (c == '.')        /* Count the levels */
  3788.           m++;
  3789.         else if (c == indir)
  3790.           break;
  3791.     }
  3792.     relnambuf[0] = (indir == ']') ? '[' : '<'; /* Emit opening bracket */
  3793.     for (i = 1; i <= m; i++)    /* then the right number of dashes */
  3794.       relnambuf[i] = '-';
  3795.     ckstrncpy(relnambuf+i,xs,CKMAXPATH-i); /* then the rest. */
  3796.     debug(F110,"zrelnam result 1",relnambuf,0);
  3797.     } else {                /* File is in a subdirectory */
  3798.     switch (*xs) {            /* so we can strip some parts */
  3799.       case ':':
  3800.       case ']':
  3801.       case '>':
  3802.         ckstrncpy(relnambuf,xs+1,CKMAXPATH);
  3803.         break;
  3804.       case '.':
  3805.         sprintf(relnambuf,"%c%s",(indir == ']') ? '[' : '<',xs);
  3806.         break;
  3807.       default:
  3808.         ckstrncpy(relnambuf,filespec,CKMAXPATH);
  3809.     }
  3810.     debug(F110,"zrelnam result 2",relnambuf,0);
  3811.     }
  3812.     return((char *)relnambuf);
  3813. }
  3814.  
  3815. /*  Z G T D I R  --  Return pointer to user's current directory.  */
  3816.  
  3817. char *
  3818. zgtdir() {
  3819.  
  3820. /* OLD_VMS (pre V5.0) is defined in the build file */
  3821.  
  3822. #ifdef OLD_VMS
  3823.     static char *gtdir_buf = 0;
  3824.     static char sysdisk[] = "SYS$DISK";
  3825.     char tmp_buf[ NAMX_C_MAXRSS+ 1];
  3826.     struct dsc$descriptor_s
  3827.     tmp_buf_dsc = {sizeof(tmp_buf),DSC$K_DTYPE_T,DSC$K_CLASS_S,&tmp_buf},
  3828.     sysdisk_dsc = {sizeof(sysdisk)-1,DSC$K_DTYPE_T,DSC$K_CLASS_S,&sysdisk};
  3829.     unsigned short int buf_len;
  3830. /*
  3831.  * Allocate buffer dynamically, first time through.  This makes the image
  3832.  * smaller.
  3833.  */
  3834.     if (!gtdir_buf) gtdir_buf = malloc( NAMX_C_MAXRSS+ 1);
  3835. /*
  3836.  * Translate device name.
  3837.  */
  3838.     lib$sys_trnlog(     &sysdisk_dsc,
  3839.             &buf_len,
  3840.             &tmp_buf_dsc,
  3841.             0,
  3842.             0,
  3843.             0);
  3844.     tmp_buf[buf_len] = '\0';
  3845.     ckstrncpy(gtdir_buf, tmp_buf, NAMX_C_MAXRSS);
  3846. /*
  3847.  * Get directory name.
  3848.  */
  3849.     sys$setddir(    0,      /* New dir addr */
  3850.             &buf_len, /* length addr */
  3851.             &tmp_buf_dsc);
  3852.     tmp_buf[buf_len] = '\0';
  3853.     strcat(gtdir_buf,tmp_buf);
  3854.  
  3855.     return(gtdir_buf);  /* Can't seem to make LINK find getcwd()... */
  3856.             /* (wbader: removed &) */
  3857. #else /* def OLD_VMS */
  3858.     char *getcwd();
  3859.     char *buf;
  3860.  
  3861.     buf = cwdbuf;
  3862.     return(getcwd(buf, NAMX_C_MAXRSS));
  3863. #endif /* def OLD_VMS [else] */
  3864. }
  3865.  
  3866. /*  Z G P I D  --  Get process ID (of Kermit)  */
  3867.  
  3868. long
  3869. zgpid() {
  3870.     unsigned long sts, pid;
  3871.     struct itmlstdef {
  3872.     short int buflen;
  3873.     short int itmcod;
  3874.     char *bufaddr;
  3875.     long int *retlen;
  3876.     };
  3877.  
  3878. /* Should maybe this be JPI$_PROC_INDEX instead? */
  3879.  
  3880.     struct itmlstdef itmlst[] = {
  3881.     4, JPI$_PID, NULL, 0,
  3882.     0, 0, 0, 0
  3883.     };
  3884.     itmlst[0].bufaddr = (char *)&pid;
  3885.     sts = sys$getjpiw(0, 0, 0, &itmlst, 0, 0, 0);
  3886.     if (!(sts & 1)) vms_lasterr = sts;
  3887.     debug(F101,"zgpid sys$getjpiw status", "", sts);
  3888.     if (sts != SS$_NORMAL)
  3889.       return(0);
  3890.     else
  3891.       return(pid);
  3892. }
  3893.  
  3894. /*  Z X C M D  --  Run a system command so its output can be read as a file. */
  3895.  
  3896. int
  3897. zxcmd(filnum, comand) int filnum; char *comand; {
  3898.     char mbxnam[21], inpchan[6] = "NLA0:";
  3899.     unsigned long sts, pid;
  3900.     int one=1;
  3901.  
  3902.     struct dsc$descriptor_s
  3903.     mbx_desc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0},
  3904.     cmd_line = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0},
  3905.     inp_desc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
  3906.  
  3907.     struct itmlstdef {
  3908.     short int buflen;
  3909.     short int itmcod;
  3910.     char *bufaddr;
  3911.     long int *retlen;
  3912.     };
  3913.     struct itmlstdef itmlst[] = {
  3914.     4, JPI$_PID, NULL, 0,
  3915.     0, 0, 0, 0
  3916.     };
  3917.     itmlst[0].bufaddr = (char *)&pid;
  3918.  
  3919.     if (nopush) {
  3920.     debug(F100,"zxcmd fails: nopush","",0);
  3921.     return(-1);
  3922.     }
  3923.     debug(F111,"zxcmd filnum", comand, filnum);
  3924.     if (filnum != ZIFILE && filnum != ZRFILE)
  3925.       return(0);
  3926.  
  3927.     sts = sys$getjpiw(0, 0, 0, &itmlst, 0, 0, 0);
  3928.     if (!(sts & 1)) vms_lasterr = sts;
  3929.     debug(F101,"zxcmd sys$getjpiw status", "", sts);
  3930.     if (sts != SS$_NORMAL)
  3931.       return(0);
  3932.  
  3933.     sprintf(mbxnam,"KERMIT$MBX_%08X", pid);
  3934.     debug(F110,"zxcmd mailbox logical", mbxnam, 0);
  3935.     mbx_desc.dsc$w_length = strlen(mbxnam);
  3936.     mbx_desc.dsc$a_pointer = mbxnam;
  3937.  
  3938.     sts = sys$crembx(0, &mbx_chan, SUB_BUF_SIZE, 0, 0, 0, &mbx_desc, 0);
  3939.     if (!(sts & 1)) vms_lasterr = sts;
  3940.     debug(F101,"zxcmd sys$crembx status", "", sts);
  3941.     if (sts != SS$_NORMAL)
  3942.       return(0);
  3943.  
  3944.     debug(F101,"zxcmd sys$crembx mbx_chan", "", mbx_chan);
  3945.     strcat(mbxnam, ":");
  3946.     mbx_desc.dsc$w_length++;
  3947.  
  3948.     cmd_line.dsc$w_length = strlen(comand);
  3949.     cmd_line.dsc$a_pointer = comand;
  3950.  
  3951.     inp_desc.dsc$w_length = strlen(inpchan);
  3952.     inp_desc.dsc$a_pointer = inpchan;
  3953.  
  3954.     sts = lib$spawn(&cmd_line, &inp_desc, &mbx_desc, &one, 0, &sub_pid,
  3955.             &pexitlong, 0, 0, &mbx_chan);
  3956.     if (!(sts & 1)) vms_lasterr = sts;
  3957.  
  3958.     debug(F101,"zxcmd lib$spawn status", "", sts);
  3959.     if (sts != SS$_NORMAL)
  3960.       return(0);
  3961.  
  3962.     subprocess_input = 1;
  3963.     ispipe[filnum] = 1;            /* Remember this file is a "pipe" */
  3964.  
  3965.     sub_count = 0;
  3966.     fp[filnum] = fopen("NLA0:","r");    /* It wants a fp, give it one */
  3967.     debug(F101,"zxcmd fp[filnum]", "", fp[filnum]);
  3968.     fp[ZSYSFN] = fp[filnum];        /* Set ZSYSFN too, so we remember */
  3969.     return(1);
  3970. }
  3971.  
  3972. /*  Z C L O S F  - close the suprocess output file.  */
  3973.  
  3974. int
  3975. zclosf(filnum) int filnum; {
  3976.     unsigned long sts;
  3977.  
  3978.     if (subprocess_input != 0) {
  3979.     sts = sys$delprc(&sub_pid, 0);
  3980.     if (!(sts & 1)) vms_lasterr = sts;
  3981.     debug(F101,"zclosf sys$delprc status", "", sts);
  3982.     sts = sys$delmbx(mbx_chan);
  3983.     if (!(sts & 1)) vms_lasterr = sts;
  3984.     debug(F101,"zclosf sys$delmbx status", "", sts);
  3985.     sts = sys$dassgn(mbx_chan);
  3986.     if (!(sts & 1)) vms_lasterr = sts;
  3987.     debug(F101,"zclosf sys$dassgn status", "", sts);
  3988.     sub_ptr = sub_buf;        /* flush remaining data */
  3989.     sub_count = 1;
  3990.     *sub_buf = '\0';
  3991.     zincnt = 0;
  3992.     fclose(fp[filnum]);        /* Close the place-holders */
  3993.     fp[filnum] = fp[ZSYSFN] = NULL;
  3994.     }
  3995.     debug(F101,"zxcmd pexitlong","",pexitlong);
  3996.     subprocess_input = 0;        /* Say we're done */
  3997.     pexitstat = (pexitlong & 0x7fff);    /* Set status */
  3998.     return(pexitstat & 1 ? 1 : -1);
  3999. }
  4000.  
  4001. /*  Z X P A N D  --  Expand a wildcard string into an array of strings.  */
  4002.  
  4003. /*
  4004.   Returns the number of files that match s, with data structures set up
  4005.   so that first file (if any) will be returned by the next znext() call.
  4006. */
  4007. static int xdironly = 0;
  4008. static int xfilonly = 0;
  4009. /* static int xmatchdot = 0; */
  4010. static int xrecursive = 0;
  4011. static int xnobackup = 0;
  4012.  
  4013. static int
  4014. zxpand(s) char * s; {
  4015.     int x;
  4016.  
  4017.     if (!s) s = "";
  4018.     x = strlen(s);
  4019.     debug(F111,"zxpand",s,x);
  4020.     if (x <= 0)                /* Nothing asked for, */
  4021.       return(0);            /* nothing returned. */
  4022.     fcount = (mtchs == NULL &&    /* Kermit */
  4023.           (mtchs = (char **)malloc(MAXWLD * sizeof(*mtchs))) == NULL)
  4024.       ? 0
  4025.     : fgen(s,mtchs,MAXWLD);        /* Look up the file. */
  4026.     if (fcount > 0) {
  4027.     mtchptr = mtchs;        /* Save pointer for next. */
  4028.     debug(F111,"zxpand fcount",mtchs[0],fcount);
  4029.     }
  4030.     nxpand = fcount;
  4031.     return(fcount);
  4032. }
  4033.  
  4034. int
  4035. nzxpand(s,flags) char * s; int flags; {
  4036.     int x;
  4037.  
  4038.     debug(F111,"nzxpand",s,flags);
  4039.     x = flags & (ZX_DIRONLY|ZX_FILONLY);
  4040.     xdironly = (x == ZX_DIRONLY);
  4041.     xfilonly = (x == ZX_FILONLY);
  4042.     if (xdironly && xfilonly) {
  4043.     xdironly = 0;
  4044.     xfilonly = 0;
  4045.     }
  4046.     xrecursive = (flags & ZX_RECURSE);
  4047.     xnobackup  = (flags & ZX_NOBACKUP);
  4048.  
  4049.     debug(F101,"nzxpand xdironly","",xdironly);
  4050.     debug(F101,"nzxpand xfilonly","",xfilonly);
  4051.     debug(F101,"nzxpand xrecursive","",xrecursive);
  4052.     debug(F101,"nzxpand xnobackup","",xnobackup);
  4053.  
  4054.     x = zxpand(s);
  4055.     xdironly = 0;
  4056.     xfilonly = 0;
  4057.     xrecursive = 0;
  4058.     xnobackup = 0;
  4059.     return(x);
  4060. }
  4061.  
  4062.  
  4063. /*  Z X R E W I N D  --  Rewinds the zxpand() list */
  4064.  
  4065. int
  4066. zxrewind() {
  4067.     if (!mtchsinit || !mtchs) return(-1);
  4068.     fcount = nxpand;
  4069.     mtchptr = mtchs;
  4070.     return(nxpand);
  4071. }
  4072.  
  4073.  
  4074. /*  Z N E X T  --  Get name of next file from list created by zxpand(). */
  4075.  
  4076. /*
  4077.  Returns >0 if there's another file, with its name copied into the arg string,
  4078.  or 0 if no more files in list.
  4079. */
  4080. int
  4081. znext(fn) char *fn; {
  4082.  
  4083.     if (fcount-- > 0)
  4084.       strcpy(fn,*mtchptr++);
  4085.     else
  4086.       *fn = '\0';
  4087.     debug(F111,"znext",fn,fcount+1);
  4088.     return(fcount+1);
  4089. }
  4090.  
  4091. /*  Z N E W N  --  Make a new name for the given file.  */
  4092.  
  4093. VOID
  4094. znewn(fn,s) char *fn, **s; {
  4095.     static char buf[ NAMX_C_MAXRSS+ 8];
  4096.     int x, flag = 0;
  4097.     long v = -1L;
  4098.     x = strlen(fn) - 1;
  4099.     ckstrncpy(buf, fn, NAMX_C_MAXRSS);
  4100.     while (x >= 0) {
  4101.     if (buf[x] == ';') {
  4102.         v = atol(buf+x+1);
  4103.         sprintf(buf+x+1,"%ld",v+1);
  4104.         flag = 1;
  4105.         break;
  4106.     }
  4107.     x--;
  4108.     }
  4109.     if (!flag) strcat(buf,";0");
  4110.     *s = buf;
  4111. }
  4112.  
  4113. #ifdef COMMENT
  4114. /*
  4115.   This returns the version number the given file, if it exists.  But it causes
  4116.   more trouble than it's worth.  For example, if zfnqfp() calls this to get
  4117.   the version number and includes it in its result, it breaks the LOG command.
  4118. */
  4119. int
  4120. getvnum(fn) char * fn; {
  4121.     int rc = -1;
  4122.     char * p;
  4123.     struct dsc$descriptor_s
  4124.     file_spec = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0},
  4125.     result = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0},
  4126.     deflt = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
  4127.     unsigned long context = 0, status;
  4128.  
  4129.     file_spec.dsc$w_length  = strlen(fn);
  4130.     file_spec.dsc$a_pointer = fn;
  4131.  
  4132.     status = lib$find_file(&file_spec, &result, &context, &deflt);
  4133.     if (status == RMS$_NORMAL) {
  4134.     if (!(status & 1)) {
  4135.         vms_lasterr = status;
  4136.         debug(F101,"getvnum error", fn, status);
  4137.     } else if (result.dsc$a_pointer) {
  4138.         debug(F111,"getvnum", result.dsc$a_pointer, result.dsc$w_length);
  4139.         p = strchr(result.dsc$a_pointer,';');
  4140.         if (p) {
  4141.         if (*(p+1)) {
  4142.             if (rdigits(p+1)) {
  4143.             rc = atoi(p+1);
  4144.             }
  4145.         }
  4146.         }
  4147.     }
  4148.     }
  4149. #ifdef DVI$_ALT_HOST_TYPE
  4150.     lib$find_file_end(&context);    /* Only on VMS V4 and later */
  4151. #endif /* DVI$_ALT_HOST_TYPE */
  4152.     return(rc);
  4153. }
  4154. #endif /* COMMENT */
  4155.  
  4156. /*
  4157.   Given a possibly unqualified or relative file specification fn, zfnqfp()
  4158.   returns the fully qualified filespec for the same file, returning a struct
  4159.   that contains the length (len) of the result, a pointer (fpath) to the
  4160.   whole result, and a pointer (fname) to where the filename starts.
  4161. */
  4162. struct zfnfp *
  4163. zfnqfp(fn, buflen, buf)  char * fn; int buflen; char * buf; {
  4164.     int x = 0, y = 0;
  4165.     char * cp;
  4166.     static struct zfnfp fnfp;
  4167.  
  4168.     struct FAB fab;
  4169.     struct NAMX nam;
  4170.     char expanded_name[NAMX_C_MAXRSS];
  4171.     char tmpnam[NAMX_C_MAXRSS+ 16];
  4172.     int long rms_status;
  4173.     int cur_len = 0;
  4174.     int cp_len = buflen;
  4175.  
  4176.     if (!fn)
  4177.       return(NULL);
  4178.  
  4179.     cp = fn;
  4180.     debug(F111,"zfnqfp 1",cp,buflen);
  4181.  
  4182. #ifdef COMMENT
  4183.     /* This works but it messes up LOG commands, etc. */
  4184.     if (!strchr(cp,';')) {
  4185.     int v;
  4186.     v = getvnum(cp);
  4187.     if (v > 0) {
  4188.         sprintf(tmpnam,"%s;%d",cp,v);
  4189.         cp = tmpnam;
  4190.         debug(F111,"zfnqfp getvnum",cp,v);
  4191.     }
  4192.     }
  4193. #endif /* COMMENT */
  4194.  
  4195.     /* initialize the data structure */
  4196.  
  4197.     fnfp.len = buflen;
  4198.     fnfp.fpath = buf;
  4199.     fnfp.fname = NULL;
  4200.  
  4201.     fab = cc$rms_fab;                   /* Initialize the FAB. */
  4202.     nam = CC_RMS_NAMX;                  /* Initialize the NAM[L]. */
  4203.     fab.FAB_L_NAMX = &nam;              /* Point the FAB to the NAM[L]. */
  4204.  
  4205.     /* Install the path name in the FAB or NAML. */
  4206. #ifdef NAML$C_MAXRSS
  4207.     fab.fab$l_dna = (char *) -1;  /* Using NAML for default name. */
  4208.     fab.fab$l_fna = (char *) -1;  /* Using NAML for file name. */
  4209. #endif /* def NAML$C_MAXRSS */
  4210.     FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNA = cp;
  4211.     FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNS = strlen( cp);
  4212.  
  4213.     nam.NAMX_L_ESA = expanded_name;
  4214.     nam.NAMX_B_ESS = sizeof( expanded_name);
  4215.  
  4216.     if (!CHECK_ERR("%%CKERMIT-W-ZFNQFP",sys$parse(&fab)))
  4217.       return(NULL);
  4218.  
  4219.     /* if not a file oriented device, convert name to upper case */
  4220.  
  4221.     if (!(fab.fab$l_dev & DEV$M_NET) && !(fab.fab$l_dev & DEV$M_FOD)) {
  4222.         cp = fn;
  4223.         while (*cp) {
  4224.             if (islower(*cp))
  4225.               *cp = toupper(*cp);
  4226.             cp++;
  4227.         }
  4228.         return(NULL);
  4229.     }
  4230.     cp = buf;
  4231.     *cp = '\0';            /* Make a zero length string */
  4232.     fnfp.fpath = cp;
  4233.     if (nam.NAMX_B_NODE && nam.NAMX_B_NODE < cp_len) /* Node */
  4234.       cur_len = nam.NAMX_B_NODE;
  4235.     if (nam.NAMX_B_DEV && cur_len+ nam.NAMX_B_DEV < cp_len) /* Device */
  4236.       cur_len += nam.NAMX_B_DEV;
  4237.     if (nam.NAMX_B_DIR && cur_len+ nam.NAMX_B_DIR < cp_len) /* Directory */
  4238.       cur_len += nam.NAMX_B_DIR;
  4239.     if (nam.NAMX_B_NAME && cur_len+nam.NAMX_B_NAME < cp_len) { /* Name */
  4240.     fnfp.fname = buf + cur_len;
  4241.     cur_len += nam.NAMX_B_NAME;
  4242.     }
  4243.     if (nam.NAMX_B_TYPE && cur_len+ nam.NAMX_B_TYPE < cp_len) /* Extension */
  4244.       cur_len += nam.NAMX_B_TYPE;
  4245.     if (nam.NAMX_B_VER && cur_len+ nam.NAMX_B_VER < cp_len)
  4246.       cur_len += nam.NAMX_B_VER;
  4247.     strncat(cp, nam.NAMX_L_NODE, cur_len);
  4248.     debug(F111,"zfnqfp 2",buf,cur_len);
  4249.     if (cur_len > 1) {
  4250.     if (buf[cur_len-1] == ';' && buf[cur_len-2] == '.') {
  4251.         buf[cur_len-2] = NUL;
  4252.         cur_len -= 2;
  4253.     }
  4254.     }
  4255.     fnfp.len = cur_len;
  4256.     debug(F111,"zfnqfp 3",buf,cur_len);
  4257.  
  4258.     return(&fnfp);
  4259. }
  4260.  
  4261. /*
  4262.  * fgen:
  4263.  *  This is the actual name generator.  It is passed a string,
  4264.  *  possibly containing wildcards, and an array of character pointers.
  4265.  *  It finds all the matching filenames and stores them into the array.
  4266.  *  The returned strings are allocated from a static buffer local to
  4267.  *  this module (so the caller doesn't have to worry about deallocating
  4268.  *  them); this means that successive calls to fgen will wipe out
  4269.  *  the results of previous calls.  This isn't a problem here
  4270.  *  because we process one wildcard string at a time.
  4271.  *
  4272.  * Input: a wildcard string, an array to write names to, the
  4273.  *        length of the array.
  4274.  * Returns: the number of matches.  The array is filled with filenames
  4275.  *          that matched the pattern.  If there wasn't enough room in the
  4276.  *        array, -1 is returned.
  4277.  */
  4278. int
  4279. fgen(pat,resarry,len) char *pat, *resarry[]; int len; {
  4280.     char * p, * f;
  4281.     int i, x, y;
  4282.     struct dsc$descriptor_s
  4283.     file_spec = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0},
  4284.     result = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0},
  4285.     deflt = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
  4286.     unsigned long context = 0, status;
  4287.     int count = 0;
  4288.     char *def_str = "*.*";
  4289.     char dirbuf[ NAMX_C_MAXRSS+ 1];
  4290.     char tmpbuf[ NAMX_C_MAXRSS+ 1];
  4291.     char patbuf[ NAMX_C_MAXRSS+ 4];
  4292.  
  4293.     debug(F101,"fgen len","",len);
  4294.  
  4295.     if (!mtchsinit) {            /* Initialize filename array */
  4296.     mtchsinit = 1;
  4297.     for (i = 0; i < MAXWLD; i++)
  4298.       mtchs[i] = NULL;
  4299.     } else {
  4300.     for (i = 0; i < lastcount; i++) { /* Free previous filenames */
  4301.         if (resarry[i]) {
  4302.         free(resarry[i]);
  4303.         resarry[i] = NULL;
  4304.         }
  4305.     }
  4306.     }
  4307.     debug(F111,"fgen pat",pat,xrecursive);
  4308.     debug(F101,"fgen xdironly","",xdironly);
  4309.     debug(F101,"fgen xfilonly","",xfilonly);
  4310.  
  4311.     /* Too bad the LIB$FIND_FILE() flags word doesn't have a "recurse" bit */
  4312.     /* If recursive search requested stuff "..." into the directory name */
  4313.  
  4314.     if (xrecursive && !ckindex("...",pat,0,0,1)) {
  4315.     if (zfnqfp(pat, NAMX_C_MAXRSS, patbuf)) {
  4316.         int x;
  4317.         char * p;
  4318.         x = strlen(patbuf);
  4319.         debug(F110,"fgen patbuf 1",patbuf,x);
  4320.         if (x > 0) {
  4321.         p = patbuf + x - 1;
  4322.         *(p+4) = '\0';
  4323.         while (*p) {
  4324.             *(p+3) = *p;
  4325.             if (*p == ']' || *p == '>') {
  4326.             *(p+2) = '.';
  4327.             *(p+1) = '.';
  4328.             *p = '.';
  4329.             break;
  4330.             }
  4331.             p--;
  4332.         }
  4333.         debug(F110,"fgen patbuf 2",patbuf,x);
  4334.         pat = patbuf;
  4335.         }
  4336.     }
  4337.     }
  4338.     file_spec.dsc$w_length  = strlen(pat);
  4339.     file_spec.dsc$a_pointer = pat;
  4340.  
  4341.     x = file_spec.dsc$w_length -1;    /* kludge to keep zero length name */
  4342.     p = def_str;                /* "[foo]"  -> "[foo]*.*" */
  4343.     if (pat[x] != ']' && pat[x] != '>')
  4344.       p++;                    /* "[foo]." -> "[foo].*"  */
  4345.     deflt.dsc$w_length  = strlen(p);
  4346.     deflt.dsc$a_pointer = p;
  4347.  
  4348.     while (count < len
  4349.        && (status = lib$find_file(&file_spec, &result, &context, &deflt))
  4350.         == RMS$_NORMAL) {
  4351.     if (!(status & 1)) vms_lasterr = status;
  4352.     f = tmpbuf;
  4353.     strncpy(f, result.dsc$a_pointer, result.dsc$w_length);
  4354.     tmpbuf[result.dsc$w_length] = '\0';
  4355.     x = isdir(tmpbuf);
  4356.     debug(F111,"fgen isdir",f,x);
  4357.     if (x != 0 && xfilonly)        /* Want files only and not a file */
  4358.       continue;
  4359.     if (x == 0 && xdironly)        /* Want dirs only but not a dir */
  4360.       continue;
  4361.     if (xdironly) {
  4362.         if (x == 2) {
  4363.         y = cvtdir(tmpbuf, (char *)dirbuf, NAMX_C_MAXRSS+ 1);
  4364.         if (y > 0) f = dirbuf;
  4365.         }
  4366.     }
  4367.     resarry[count] = malloc((int) strlen(f) + 1);
  4368.     if (resarry[count]) {
  4369.         strcpy(resarry[count], f);
  4370.         count++;
  4371.         lastcount = count;
  4372.     } else {
  4373.         debug(F100,"fgen malloc failure","",0);
  4374.         return(-1);
  4375.     }
  4376.     }
  4377. #ifdef DVI$_ALT_HOST_TYPE
  4378.     lib$find_file_end(&context);    /* Only on VMS V4 and later */
  4379. #endif /* DVI$_ALT_HOST_TYPE */
  4380.  
  4381.     lib$sfree1_dd(&result);
  4382.  
  4383.     if (status == RMS$_FNF)        /* File Not Found */
  4384.       return((count <= len) ? 0 : -1);
  4385.     if (status == RMS$_NMF)        /* No More Found */
  4386.       return(count);
  4387.     /* Bernd Onasch says that VMS sometimes returns RMS$_NORMAL here, so... */
  4388.     if (status == RMS$_NORMAL)
  4389.       return(count);
  4390.  
  4391.     /* Some other status.  Return 0. */
  4392.     /* Improve this later based on results from following debug stmt. */
  4393.     debug(F101,"fgen unexpected failure status","",status);
  4394.     return(0);
  4395. }
  4396.  
  4397.  
  4398. /*  Z C O P Y  --  Copy a single file. */
  4399.  
  4400. /*
  4401.   Call with source and destination names.
  4402.   If destination is a directory (specification, not directory file name),
  4403.   the source file is copied to that directory with its original name.
  4404.   Returns:
  4405.    0 on success.
  4406.   <0 on failure:
  4407.   -2 = source file is a directory file {or link on Unix}.
  4408.   -3 = source file not found or not accessible {locked}.
  4409.   -4 = permission denied {read, isguest}.
  4410.   -5 = source and destination are same file {not used on VMS}
  4411.   -6 = i/o error.
  4412.   -7 = open output file error {permissions, existing file, directory file}
  4413.   -1 = other error.
  4414. */
  4415.  
  4416. #include <shrdef.h>
  4417. #include <stsdef.h>
  4418. #ifdef __DECC
  4419. #ifndef BUGFILL7
  4420. #ifndef NOCONVROUTINES
  4421. #include <conv$routines.h>
  4422. #define HAVE_CONVROUTINES
  4423. #endif /* NOCONVROUTINES */
  4424. #endif /* BUGFILL7 */
  4425. #ifndef HAVE_CONVROUTINES
  4426. /* 2010-03-09 SMS.
  4427.  * Minimal ("#ifndef __NEW_STARLET") declarations to reduce
  4428.  * %CC-I-IMPLICITFUNC diagnostics.
  4429.  */
  4430. unsigned int conv$convert(__unknown_params);
  4431. unsigned int conv$pass_files(__unknown_params);
  4432. unsigned int conv$pass_options(__unknown_params);
  4433. #endif /* ndef HAVE_CONVROUTINES */
  4434. #endif /* __DECC */
  4435.  
  4436. #ifdef ZCOPY
  4437.  
  4438. int
  4439. zcopy(source,destination) char *source, *destination; {
  4440.     char *src = source, *dst = destination; /* Local pointers to filenames */
  4441.  
  4442.     int  rc, n;
  4443.     unsigned long int sts;
  4444.     unsigned long int options[] = {2,1,1}; /* CONV$ options CREATE SHARE */
  4445.     char *p, buf[ NAMX_C_MAXRSS+ 1];    /* File name buffer */
  4446.  
  4447.  
  4448.     struct dsc$descriptor_s  ifd = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
  4449.     struct dsc$descriptor_s  ofd = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
  4450.  
  4451.     debug(F110,"zcopy src arg",src,0);
  4452.     debug(F110,"zcopy dst arg",dst,0);
  4453.  
  4454. #ifdef CK_LOGIN
  4455.     if (inserver && isguest)
  4456.       return(-4);
  4457. #endif /* CK_LOGIN */
  4458.  
  4459.     switch (zchki(src)) {
  4460.         case -1 : return(-3);    /* not found or not accessible */
  4461.         case -2 : return(-2);    /* a directory file */
  4462.         case -3 : return(-4);    /* no read permission */
  4463.     }
  4464.  
  4465. /* If destination is a directory name, append the source file name */
  4466.  
  4467.     switch (isdir(dst)) {
  4468.       case 0:
  4469.     debug(F100,"zcopy destination is not a directory","",0);
  4470.     break;
  4471.       case 2:
  4472.     debug(F100,"zcopy destination is a directory file","",0);
  4473.     return(-7);
  4474.       case 1: {
  4475.       char *q = NULL;
  4476.       debug(F100,"zcopy destination is a directory spec","",0);
  4477.       zstrip(src,&q);
  4478.       n = strlen(dst);
  4479.       if (strlen(q) + n < sizeof(buf)) {
  4480.           ckstrncpy(buf, dst, NAMX_C_MAXRSS); /* dst dir */
  4481.           p = buf + n - 1;
  4482.           if (*p != ']' && *p != '>' && *p != ':' )
  4483.         *(++p) = ':';        /* logical w/o ":" */
  4484.           strcpy(++p,q);        /* nam from src */
  4485.           dst = buf;
  4486.           debug(F110,"zcopy dst result",dst,0);
  4487.           strcpy(destination,dst);
  4488.           break;
  4489.       } else {
  4490.           debug(F100,"zcopy dir+name overflow","",0);
  4491.           return(-7);
  4492.       }
  4493.       }
  4494.     }
  4495.     ifd.dsc$a_pointer = src;
  4496.     ifd.dsc$w_length  = strlen(src);
  4497.     ofd.dsc$a_pointer = dst;
  4498.     ofd.dsc$w_length  = strlen(dst);
  4499.  
  4500.     sts = conv$pass_files(&ifd, &ofd);
  4501.     if (sts != SS$_NORMAL) {
  4502.     debug(F101,"zcopy conv$pass_files error","", sts);
  4503.     return(-1);
  4504.     }
  4505. /*
  4506.   CONV option CREATE limits zcopy dst to a new file; to overwrite
  4507.   an existing file, delete the old version first
  4508. */
  4509.     sts = conv$pass_options(&options);
  4510.     if (sts != SS$_NORMAL) {
  4511.         debug(F101,"zcopy conv$pass_option error","",sts);
  4512.         return(-1);
  4513.     }
  4514.     sts = conv$convert();
  4515.  
  4516. /* CONV$_ errors are shared error codes (facility 178) */
  4517.  
  4518.     if (sts != SS$_NORMAL) {
  4519.         debug(F101,"zcopy conv$convert error","", sts);
  4520.         switch (sts & STS$M_CODE) {
  4521.       case SHR$_OPENOUT:
  4522.         rc = -7;
  4523.         break;
  4524.       case SHR$_OPENIN:
  4525.         rc = -4;
  4526.         break;
  4527.       case SHR$_READERR || SHR$_WRITEERR:
  4528.         rc = -6;
  4529.         break;
  4530.       default : rc = -1;
  4531.     }
  4532.     } else
  4533.       rc = 0;
  4534.     debug(F101,"zcopy status","",rc);
  4535.  
  4536. #ifdef CKSYSLOG
  4537.     if (rc > -1 && ckxsyslog >= SYSLG_FC && ckxlogging) {
  4538.     if (rc)
  4539.       syslog(LOG_INFO,"file[] %s: copy to %s failed (%u)", src, dst, sts);
  4540.     else
  4541.       syslog(LOG_INFO,"file[] %s: copy to %s ok", src, dst);
  4542.     }
  4543. #endif /* CKSYSLOG */
  4544.  
  4545.     return(rc);
  4546. }
  4547.  
  4548. #endif /* def ZCOPY */
  4549.  
  4550.  
  4551. /*  Z R E N A M E  --  Rename a file.  */
  4552.  
  4553. /*  Call with old and new names */
  4554. /*  Returns 0 on success, -1 on failure. */
  4555. int
  4556. zrename(old,new) char *old, *new; {
  4557.     int sts;
  4558.  
  4559.     sts = rename(old,new);
  4560.  
  4561.     return((sts ? -1 : 0));
  4562. }
  4563.  
  4564. /*  Z C F D A T  --  Return a file's modification time.  */
  4565.  
  4566. char *
  4567. zfcdat(name) char *name; {
  4568. /*
  4569.   Returns modification date/time of file whose name is given in the argument
  4570.   string.  Return value is a pointer to a string of the form:
  4571.  
  4572.     yyyymmdd hh:mm:ss
  4573.  
  4574.   for example 19931231 23:59:59, which represents the local time (no timezone
  4575.   or daylight savings time finagling required).  Returns an empty string ("")
  4576.   on failure.  The text pointed to by the string pointer is in a static
  4577.   buffer, and so should be copied to a safe place by the caller before any
  4578.   subsequent calls to this function.
  4579. */
  4580.  
  4581. /*
  4582.   Contributed by William Bader, 9 Nov 93, based on UNIX version: "It would
  4583.   probably be possible to get the date by opening the file and requesting a
  4584.   NAM block like ckvfio.c does, but stat seems to do the trick."
  4585. */
  4586.     struct stat statbuf;
  4587.     struct tm *tm;
  4588.     static char datebuf[20];
  4589.  
  4590.     datebuf[0] = '\0';
  4591.  
  4592.     if (name &&
  4593.         *name &&
  4594.         stat(name,&statbuf) != -1 &&
  4595. #ifdef COMMENT
  4596.     /* Modification date/time */
  4597.         (tm = localtime((const time_t *)&statbuf.st_mtime)))
  4598. #else
  4599.         /* Creation date/time */
  4600.         (tm = localtime((const time_t *)&statbuf.st_ctime)))
  4601. #endif /* COMMENT */
  4602.       sprintf(datebuf, "%04d%02d%02d %02d:%02d:%02d",
  4603.         tm->tm_year + 1900, tm->tm_mon + 1, tm->tm_mday,
  4604.         tm->tm_hour, tm->tm_min, tm->tm_sec);
  4605.  
  4606.     return(datebuf);
  4607. }
  4608.  
  4609.  
  4610. /*  Z S T I M E  --  Set or compare a file's creation date/time.  */
  4611.  
  4612. /*
  4613.  * Note: There's an additional value for parameter X on VAX/VMS systems. As
  4614.  * it's horribly painful to change a file's creation date after-the-fact we
  4615.  * call zstime with an argument  of 2 to pre-set the date when creating the
  4616.  * file. An argument of 0 (which the main-line code thinks sets the date of
  4617.  * the output file) returns success but does nothing.  Note that an invalid
  4618.  * or missing attribute packet will cause $bintim to return an error, which
  4619.  * causes the routine to exit. Since we pre-set the binary time to zero, we
  4620.  * will create the file "now", or say the incoming file is newer, whichever
  4621.  * is appropriate.
  4622.  */
  4623. static char mth[13][4] = {
  4624.     "JAN","FEB","MAR","APR",
  4625.     "MAY","JUN","JUL","AUG",
  4626.     "SEP","OCT","NOV","DEC",
  4627.     ""
  4628. };
  4629.  
  4630. int
  4631. zstime(f,yy,x) char *f; struct zattr *yy; int x; {
  4632.     int rms_sts;
  4633.     unsigned short attr_pro = 0;
  4634.     static char cdate[24];          /* File date yyyy-mm-dd hh:mm:ss.00 */
  4635.     static char mnum[2];
  4636.     struct dsc$descriptor_s
  4637.     bintim_desc = {sizeof(cdate) - 1, DSC$K_DTYPE_T, DSC$K_CLASS_S,
  4638.              (char *)&cdate};
  4639.     unsigned long file_date[2], attr_date[2];
  4640.     char *dptr;
  4641.     int setperms = 0;
  4642.     int setdate = 0;
  4643. #ifdef DEBUG
  4644.     char xbuf[24];            /* Hex buffer for debugging only */
  4645. #endif /* DEBUG */
  4646.  
  4647.     debug(F111,"zstime entry",f,x);
  4648.     if (yy->date.len == 0) {        /* No date in struct */
  4649.     if (yy->lprotect.len != 0) {    /* So go do permissions */
  4650.         goto zsperms;
  4651.     } else {
  4652.         debug(F100,"zstime: nothing to do","",0);
  4653.         return(0);
  4654.     }
  4655.     }
  4656.  
  4657. /* First, make a system quadword date from our attribute struct parameter */
  4658.  
  4659.     dptr = yy->date.val;
  4660.     strncpy(cdate,"dd-mmm-yyyy 00:00:00.00",24);
  4661.     attr_date[0]=0;            /* Clear time in case of error */
  4662.     attr_date[1]=0;
  4663.     strncpy(cdate+7, dptr, 4);        /* yyyy */
  4664.     dptr += 4;
  4665.     strncpy(mnum, dptr, 2);
  4666.     strncpy(cdate+3, mth[atoi(mnum)-1], 3); /* mm */
  4667.     dptr += 2;
  4668.     strncpy(cdate, dptr, 2);        /* dd */
  4669.     dptr += 3;
  4670.     strncpy(cdate+12, dptr, 8);        /* hhmmss */
  4671.     cdate[23] = '\0';            /* terminate */
  4672.     rms_sts = sys$bintim(&bintim_desc, &attr_date); /* Convert to internal */
  4673.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  4674.     if (rms_sts != SS$_NORMAL) {            /* time format */
  4675.     debug(F111,"zstime - $bintim returns",cdate,rms_sts);
  4676.     return(-1);
  4677.     }
  4678.     debug(F110,"zstime built",cdate,0);
  4679.     sprintf(cdate, "%08X%08X", attr_date[1], attr_date[0]);
  4680.     debug(F110,"zstime $bintim attr_date", cdate, 0);
  4681.     setdate = 1;
  4682.  
  4683.   zsperms:                /* File protection */
  4684.     if (x != 1) {            /* We're not just comparing dates... */
  4685.     int i, xx, flag = 0;
  4686.     char * s;
  4687. #ifdef DEBUG
  4688.     if (deblog) {
  4689.         debug(F111,"zstime lperms",yy->lprotect.val,yy->lprotect.len);
  4690.         debug(F111,"zstime gperms",yy->gprotect.val,yy->gprotect.len);
  4691.         debug(F110,"zstime system id",yy->systemid.val,0);
  4692.         sprintf(xbuf,"%X",xabpro_ofile.xab$w_pro);
  4693.         debug(F110,"zstime xabpro_ofile.xab$w_pro 1",xbuf,0);
  4694.     }
  4695. #endif /* DEBUG */
  4696.     if ((yy->lprotect.len > 0 &&    /* Have sys-dependent permissions */
  4697.          yy->systemid.len > 0 &&    /* from A-packet... */
  4698.          !strcmp(yy->systemid.val,"D7"))) { /* AND you are VMS like me */
  4699.         attr_pro = 0;
  4700.         flag = 1;
  4701.         s = yy->lprotect.val;    /* VMS protections */
  4702.         xx = yy->lprotect.len;
  4703.         if (xx < 0)            /* Length < 0 means inheritance */
  4704.           xx = 0 - xx;        /* (ignored in VMS) */
  4705.         if (xx > 4) {        /* Bad format - must be 4 bytes */
  4706.         flag = 0;
  4707.         } else {
  4708.         for (i = 0; i < xx; i++) {    /* Decode hex string */
  4709.             if (*s <= '9' && *s >= '0') {
  4710.             attr_pro = 16 * attr_pro + (int)(*s) - '0';
  4711.             } else if ((*s <= 'F' && *s >= 'A')) {
  4712.             attr_pro = 16 * attr_pro + 10 + (int)(*s) - 'A';
  4713.             } else if ((*s <= 'f' && *s >= 'a')) {
  4714.             attr_pro = 16 * attr_pro + 10 + (int)(*s) - 'a';
  4715.             } else {
  4716.             flag = 0;
  4717.             break;
  4718.             }
  4719.             s++;
  4720.         }
  4721.         }
  4722. #ifdef DEBUG
  4723.         if (deblog) {
  4724.         debug(F101,"zstime VMS local protection flag","",flag);
  4725.         sprintf(xbuf,"%X",attr_pro);
  4726.         debug(F111,"zstime VMS local protection",xbuf,attr_pro);
  4727.         }
  4728. #endif /* DEBUG */
  4729.     } else if (!flag && yy->gprotect.len > 0) { /* Systems differ */
  4730.         int g;                        /* Use the generic one */
  4731.         unsigned long dfpro = 0L, mask = 0L;
  4732.         unsigned short tmp;
  4733.         tmp = xabpro_ofile.xab$w_pro;
  4734.             rms_sts = sys$setdfprot(0,&dfpro); /* Get default protection */
  4735.         if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  4736. #ifdef DEBUG
  4737.         if (deblog) {
  4738.         sprintf(xbuf,"%X",dfpro);
  4739.         debug(F111,"zstime sys$setdfprot",xbuf,rms_sts);
  4740.         }
  4741. #endif /* DEBUG */
  4742.         if (rms_sts & 1)        /* Succeeded so use it */
  4743.           tmp = dfpro;
  4744.         tmp &= 0xff0f;        /* But remove Owner field */
  4745.  
  4746. /* Convert generic protection to number and translate to internal VMS form */
  4747.  
  4748.         g = xunchar(*(yy->gprotect.val));
  4749.         attr_pro = 0x0F;           /* 1111 Initial value = No access */
  4750.         if (g &  1)              /* 1=Read */
  4751.           attr_pro &= ~XAB$M_NOREAD;  /* 0001 */
  4752.         if (g &  2)              /* 2=Write */
  4753.           attr_pro &= ~XAB$M_NOWRITE; /* 0010 */
  4754.         if (g &  4)              /* 4=Execute */
  4755.           attr_pro &= ~XAB$M_NOEXE;   /* 0100 */
  4756.         if (g &  8)              /* 8=Append */
  4757.           attr_pro &= ~XAB$M_NOWRITE; /* 0010 */
  4758.         if (g & 16)              /* 16=Delete */
  4759.           attr_pro &= ~XAB$M_NODEL;   /* 1000 */
  4760.         mask = attr_pro    |      /* Don't give S,G,W any */
  4761.           (attr_pro <<  4) |      /* more access than Owner... */
  4762.           (attr_pro <<  8) |
  4763.           (attr_pro << 12);
  4764.         attr_pro = attr_pro << 4;    /* Shift to owner field */
  4765.         tmp |= attr_pro;        /* OR in Owner protection */
  4766.         attr_pro = tmp | mask;    /* Mask off any higher permissions */
  4767.         flag = 1;            /* Flag we have the protection value */
  4768. #ifdef DEBUG
  4769.         if (deblog) {
  4770.         debug(F101,"zstime g attr_pro 4","",attr_pro);
  4771.         sprintf(xbuf,"%X",attr_pro);
  4772.         debug(F111,"zstime generic protections",xbuf,attr_pro);
  4773.         }
  4774. #endif /* DEBUG */
  4775.     }
  4776.     if (flag)
  4777.       setperms = 1;
  4778.     }
  4779.     debug(F101,"zstime setperms","",setperms);
  4780.     debug(F101,"zstime setdate","",setdate);
  4781.  
  4782.     switch (x) {
  4783.       case 1:                /* Function code 1, compare dates */
  4784.     if (!setdate)            /* Do we have a date? */
  4785.       return(-1);            /* Nothing to do */
  4786.     fab_ifile = cc$rms_fab;         /* Initialize the FAB. */
  4787.     nam_ifile = CC_RMS_NAMX;        /* Initialize the NAM[L]. */
  4788.     fab_ifile.FAB_L_NAMX = &nam_ifile;  /* Point the FAB to the NAM[L]. */
  4789.  
  4790.     /* Install the path name in the FAB or NAML. */
  4791. #ifdef NAML$C_MAXRSS
  4792.     fab_ifile.fab$l_dna = (char *) -1;  /* Using NAML for default name. */
  4793.     fab_ifile.fab$l_fna = (char *) -1;  /* Using NAML for file name. */
  4794. #endif /* def NAML$C_MAXRSS */
  4795.     FAB_OR_NAML( fab_ifile, nam_ifile).FAB_OR_NAML_FNA = f;
  4796.     FAB_OR_NAML( fab_ifile, nam_ifile).FAB_OR_NAML_FNS = strlen( f);
  4797.  
  4798.     fab_ifile.fab$b_fac = FAB$M_BIO | FAB$M_GET;
  4799.     fab_ifile.fab$l_xab = (char *)&xabdat_ifile;
  4800.     rab_ifile = cc$rms_rab;
  4801.     rab_ifile.rab$l_fab = &fab_ifile;
  4802.     xabdat_ifile = cc$rms_xabdat;
  4803.     rms_sts = sys$open(&fab_ifile);
  4804.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  4805.     if (rms_sts != RMS$_NORMAL) {
  4806.         debug(F101,"zstime $open failed, status","",rms_sts);
  4807.         return(-1);
  4808.     }
  4809.     memcpy(file_date, &xabdat_ifile.xab$q_cdt, 8);
  4810.     sprintf(cdate, "%08x%08x", file_date[1], file_date[0]);
  4811.     debug(F110,"zstime $bintim file_date", cdate, 0);
  4812.     rms_sts = sys$close(&fab_ifile);
  4813.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  4814.     if (rms_sts != RMS$_NORMAL) {
  4815.         debug(F101,"zstime $close failed, status","",rms_sts);
  4816.         return(-1);
  4817.     }
  4818.     if (attr_date[1] < file_date[1]) {
  4819.         debug(F100,"zstime incoming file is older","",0);
  4820.         return(1);
  4821.     }
  4822.     if (attr_date[1] == file_date[1]) {
  4823.         if (attr_date[0] <= file_date[0]) {
  4824.         debug(F100,"zstime incoming file is older, not by much","",0);
  4825.         return(1);
  4826.         }
  4827.         debug(F100,"zstime incoming file is newer","",0);
  4828.         return(0);
  4829.     }
  4830.     break;
  4831.  
  4832.       case 0:                /* Function code 0, set attributes */
  4833.     return(0);            /* Say we did (see comments above) */
  4834.  
  4835.       case 2:                /* Function code 2, really set them */
  4836.     if (setdate) {            /* Do we have a date? */
  4837.         debug(F100,"zstime setting date","",0);
  4838.         memcpy(&xabdat_ofile.xab$q_cdt, attr_date, 8); /* File date */
  4839.     }
  4840.     if (setperms) {            /* File protection... */
  4841.         debug(F100,"zstime setting protection","",0);
  4842.         xabpro_ofile.xab$w_pro = attr_pro;
  4843.     }
  4844.     return(0);
  4845.     }
  4846.     return(-1);
  4847. }
  4848.  
  4849.  
  4850. /*  Z K E R M I N I  --  Find initialization file.  */
  4851. /*
  4852.   Places name of init file in buffer pointed to by s.
  4853.   If no init file found, the device name of the null device is used.
  4854.   returns 0 always.
  4855. */
  4856. int
  4857. zkermini(s, s_len, def) char *s; int s_len; char *def; {
  4858.     FILE fd;
  4859.     struct dsc$descriptor_s
  4860.         dsc_in = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0},
  4861.         dsc_out = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0},
  4862.         dsc_def = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
  4863.     int max_len;
  4864.     long unsigned int rms_s;
  4865.     unsigned long find_file_context = 0;
  4866.  
  4867.     struct TRNLIST {
  4868.     char *name;            /* ASCII file or logical name */
  4869.     unsigned char flag;        /* Zero to use default filename */
  4870.     } *p;
  4871.  
  4872.     static struct TRNLIST slist[] = {
  4873.     {"", 0},            /* Dummy first entry points to file */
  4874.     {"ckermit_ini:", 0},        /* CKERMIT_INI: points to directory */
  4875.     {"ckermit_init", 1},        /* CKERMIT_INIT points to file      */
  4876.     {"sys$login:",   0},        /* CKERMIT.INI in login directory   */
  4877.     {"", 0}
  4878.     };
  4879.     p = slist;                /* Point to list */
  4880.     if (rcflag) {            /* Name given on command line? */
  4881.     slist[0].name = def;        /* Yes, stuff its name into slist */
  4882.     slist[1].name = "";
  4883.     } else {                /* No, */
  4884.     *p++;                /* skip past dummy entry. */
  4885.     }
  4886.     while(*(p->name)) {            /* Search the list top to bottom */
  4887.  
  4888.     dsc_in.dsc$w_length = strlen(p->name); /* Length of work area */
  4889.     dsc_in.dsc$a_pointer = p->name; /* Address of string */
  4890.  
  4891.     if (!(p->flag)) {
  4892.         dsc_def.dsc$w_length = strlen(def); /* Length of work area */
  4893.         dsc_def.dsc$a_pointer = def; /* Address of string */
  4894.     } else {
  4895.         dsc_def.dsc$w_length = 0;    /* Length of work area */
  4896.         dsc_def.dsc$a_pointer = 0;    /* Address of string */
  4897.     }
  4898.     rms_s = lib$find_file(
  4899.                 &dsc_in,    /* File spec */
  4900.                 &dsc_out,    /* Result file spec */
  4901.                 &find_file_context, /* Context */
  4902.                 &dsc_def,    /* Default file spec */
  4903.                 0,        /* Related spec */
  4904.                 0,        /* STV error */
  4905.                 0);        /* Flags */
  4906.  
  4907.     if (!(rms_s & 1)) vms_lasterr = rms_s;
  4908.     if (rms_s == RMS$_NORMAL) {
  4909.         max_len = ((unsigned short int) dsc_out.dsc$w_length < s_len ?
  4910.                (unsigned short int) dsc_out.dsc$w_length : 0);
  4911.         if (!max_len) {
  4912.         fprintf(stderr,
  4913.         "%%ZKERMINI out string not long enough, ignoring .ini file\n");
  4914.         } else {
  4915.         strncpy(s,dsc_out.dsc$a_pointer,max_len);
  4916.         s[max_len] = '\0';
  4917.         }
  4918.         lib$find_file_end(&find_file_context);
  4919.         lib$sfree1_dd(&dsc_out);    /* Return dyno memory */
  4920.         return(1);
  4921.     }
  4922.     p++;
  4923.     lib$find_file_end(&find_file_context);
  4924.     }
  4925. /*
  4926.  * No initialization file found.  We can't return the null string because the
  4927.  * runtime library will successfully open it if the file ".;" exists in the
  4928.  * user's directory.  Instead we return the name of the null device.
  4929.  */
  4930.     strcpy(s, "NLA0:");                /* Return null init file */
  4931.     lib$sfree1_dd(&dsc_out);
  4932.     return(0);
  4933. }
  4934.  
  4935. #ifdef COMMENT
  4936. static int
  4937. parse_fname(cp, cp_len, defnam, flag, fncnv, fnspath)
  4938. char *cp;        /* Pointer to file spec to parse */
  4939. int cp_len;        /* Length of cp field */
  4940. char *defnam;        /* Default file spec */
  4941. int flag;        /* Flag word PARSE_xxx */
  4942. int fncnv;        /* Filename conversion */
  4943. int fnspath;        /* Pathname handling */
  4944. {
  4945.     struct FAB fab;
  4946.     struct NAM nam;
  4947.     char expanded_name[ NAMX_C_MAXRSS];
  4948.     char dirbuf[ NAMX_C_MAXRSS], *p, *q, *q2, *r, *s, *s2;
  4949.     int long rms_status;
  4950.     int cur_len = 0;
  4951.  
  4952.     debug(F110,"zltor entry",defnam,0);
  4953.  
  4954.     fab = cc$rms_fab;
  4955.     fab.fab$l_nam = &nam;
  4956.     fab.fab$l_fna = cp;
  4957.     fab.fab$b_fns = strlen(cp);
  4958.     if (defnam) {
  4959.     fab.fab$b_dns = strlen(defnam);
  4960.     fab.fab$l_dna = defnam;
  4961.     } else
  4962.       fab.fab$l_dna = 0;
  4963.  
  4964.     nam = cc$rms_nam;
  4965.     nam.nam$l_esa = (char *)&expanded_name;
  4966.     nam.nam$b_ess = sizeof(expanded_name);
  4967.  
  4968.     if (!CHECK_ERR("%%CKERMIT-W-PARSE, ",
  4969.         sys$parse(&fab)))
  4970.     return(-1);
  4971.  
  4972.     *cp = '\0';                /* Start with an empty result */
  4973.  
  4974.     if ((PARSE_NODE & flag) && nam.nam$b_node && /* DECnet node:: */
  4975.         cur_len+nam.nam$b_node < cp_len) {
  4976.     cur_len += nam.nam$b_node;
  4977.     strncat(cp, nam.nam$l_node, (int)nam.nam$b_node);
  4978.     }
  4979.     if ((PARSE_DEVICE & flag) && nam.nam$b_dev && /* Device: */
  4980.         cur_len+nam.nam$b_dev < cp_len) {
  4981.     cur_len += nam.nam$b_dev;
  4982.     strncat(cp, nam.nam$l_dev, (int)nam.nam$b_dev);
  4983.     }
  4984.  
  4985.     /* Directory Name [] */
  4986.  
  4987.     if ((PARSE_DIRECTORY & flag) && nam.nam$b_dir &&
  4988.         cur_len+nam.nam$b_dir < cp_len) {
  4989.     int i; char * tmp;
  4990.         q = nam.nam$l_dir;        /* The directory name from RMS */
  4991.     i = nam.nam$b_dir;        /* Length; string not nul-terminated */
  4992.     debug(F111,"zltor nam$_dir",q,i);
  4993.     if (!q) q = "[]";
  4994.     if (!*q) q = "[]";
  4995.     if (i < 0) i = 0;
  4996.     tmp = NULL;
  4997.     if (i > 0) {            /* Copy directory part */
  4998.         if (tmp = malloc(i+1)) {
  4999.         p = tmp;
  5000.         for ( ; i > 0 ; i--)
  5001.           *p++ = *q++;
  5002.         *p = NUL;
  5003.         }
  5004.     }
  5005.     q = tmp;
  5006.     debug(F111,"zltor directory part",q,i);
  5007.  
  5008.     s = zgtdir();            /* Get current directory */
  5009.     debug(F110,"zltor zgtdir",s,0);
  5010.     if (!s) s = "[]";
  5011.     if (!*s) s = "[]";
  5012.     s2 = "";
  5013.     while (*s && *s != '[')
  5014.       s++;
  5015.     if (*s) {
  5016.         s2 = s+1;
  5017.         while (*s2 && *s2 != ']') s2++; /* Closing bracket */
  5018.     }
  5019.     if (!*s)
  5020.       s = "[]";
  5021.     else
  5022.       if (*s2) if (!*(s2+1)) *(s2+1) = NUL;
  5023.     debug(F110,"zltor current dir",s,0);
  5024.  
  5025. /* First change the VMS pathname to relative format if fnspath == PATH_REL */
  5026.  
  5027.     p = dirbuf;            /* Result */
  5028.     *p++ = *q++;            /* Copy left bracket and... */
  5029.  
  5030.     s++;                /* Point past it */
  5031.     q2 = q;                /* Remember this place */
  5032.     if (fnspath == PATH_REL) {    /* Compare this and current dir */
  5033.         while (*s == *q && *s && *q && *s != ']') {
  5034.         s++;
  5035.         q++;
  5036.         }
  5037.     }
  5038.     if (*s != ']' && *q != ']' && *q != '.') /* No match */
  5039.       q = q2;            /* So rewind source pointer */
  5040.  
  5041.     while (*q) *p++ = *q++;        /* Now copy the rest */
  5042.     *p = NUL;
  5043.     debug(F110,"zltor result 1",dirbuf,0);
  5044. /*
  5045.    VMS directory name is now in dirbuf in either absolute or relative format.
  5046.    Now change it to standard (UNIX) format if desired.
  5047. */
  5048.     p = dirbuf;            /* Working pointer */
  5049.     r = dirbuf;            /* Result pointer */
  5050.     if (fncnv) {            /* Converting directory format */
  5051.         int flag = 0;
  5052.         if (p[1] == '.') {        /* Directory name is relative */
  5053.         r += 2;            /* Point past the leading dot */
  5054.         p += 2;
  5055.         }
  5056.         while (*p) {        /* Now convert the rest */
  5057.         if (*p == '.' || *p == '[' || *p == ']') {
  5058.             if (!flag) *p = '/';
  5059.             if (*p == ']')
  5060.               flag = 1;
  5061.         }
  5062.         p++;
  5063.         }
  5064.     }
  5065.     debug(F110,"zltor result 2",r,0);
  5066.     if (tmp) free(tmp);
  5067.     strncat(cp, r, (int)nam.nam$b_dir);
  5068.     cur_len += strlen(r);
  5069.     }
  5070.     if ((PARSE_NAME & flag) && nam.nam$b_name &&
  5071.         cur_len+nam.nam$b_name < cp_len) {
  5072.     cur_len += nam.nam$b_name;
  5073.     strncat(cp, nam.nam$l_name, (int)nam.nam$b_name);
  5074.     }
  5075.     if ((PARSE_TYPE & flag) && nam.nam$b_type &&
  5076.         cur_len+nam.nam$b_type < cp_len) {
  5077.     cur_len += nam.nam$b_type;
  5078.     strncat(cp, nam.nam$l_type, (int)nam.nam$b_type);
  5079.     }
  5080.     if ((PARSE_VERSION & flag) && nam.nam$b_ver &&
  5081.         cur_len+nam.nam$b_ver < cp_len) {
  5082.     cur_len += nam.nam$b_ver;
  5083.     strncat(cp, nam.nam$l_ver, (int)nam.nam$b_ver);
  5084.     }
  5085.     return(cur_len);
  5086. }
  5087. #endif /* COMMENT */
  5088.  
  5089. /* Z G P E R M  --  Returns the permissions (protection) of the given file. */
  5090.  
  5091. static char zgpbuf[24];
  5092.  
  5093. char *
  5094. zgperm(f) char *f; {
  5095.     int x, x1, x2, x3, x4;
  5096.     struct FAB fab_perm;
  5097.     struct NAMX nam_perm;
  5098.     struct XABFHC xabfhc_perm;
  5099.     struct XABPRO xabpro_perm;
  5100.     struct XABDAT xabdat_perm;
  5101.     long iflen = -1L;
  5102.  
  5103.     fab_perm = cc$rms_fab;              /* Initialize the FAB. */
  5104.     nam_perm = CC_RMS_NAMX;             /* Initialize the NAM[L]. */
  5105.     fab_perm.FAB_L_NAMX = &nam_perm;    /* Point the FAB to the NAM[L]. */
  5106.  
  5107.     /* Install the path name in the FAB or NAML. */
  5108. #ifdef NAML$C_MAXRSS
  5109.     fab_perm.fab$l_dna = (char *) -1;  /* Using NAML for default name. */
  5110.     fab_perm.fab$l_fna = (char *) -1;  /* Using NAML for file name. */
  5111. #endif /* def NAML$C_MAXRSS */
  5112.     FAB_OR_NAML( fab_perm, nam_perm).FAB_OR_NAML_FNA = f;
  5113.     FAB_OR_NAML( fab_perm, nam_perm).FAB_OR_NAML_FNS = strlen( f);
  5114.  
  5115.     fab_perm.fab$b_fac = FAB$M_BIO;
  5116.     fab_perm.fab$l_xab = (char *)&xabdat_perm;
  5117.     xabdat_perm = cc$rms_xabdat;
  5118.     xabdat_perm.xab$l_nxt = (char *)&xabfhc_perm;
  5119.     xabfhc_perm = cc$rms_xabfhc;
  5120.     xabfhc_perm.xab$l_nxt = (char *)&xabpro_perm;
  5121.     xabpro_perm = cc$rms_xabpro;
  5122.     rms_sts = sys$open(&fab_perm);
  5123.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  5124.     if (rms_sts == RMS$_PRV)
  5125.       return(NULL);
  5126.     if (rms_sts != RMS$_NORMAL) {
  5127.     debug(F111,"zperm $open failed, status",f,rms_sts);
  5128.     return(NULL);
  5129.     }
  5130.     rms_sts = sys$close(&fab_perm);
  5131.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  5132.     if (rms_sts != RMS$_NORMAL) {
  5133.     debug(F101,"zgperm $close failed, status","",rms_sts);
  5134.     return(NULL);
  5135.     }
  5136.     debug(F111,"zgperm xabpro_perm.xab$w_pro",f,xabpro_perm.xab$w_pro);
  5137.     sprintf(zgpbuf,"%04X",xabpro_perm.xab$w_pro); /* Convert to hex string */
  5138.     debug(F110,"zgperm hex",zgpbuf,0);
  5139.     return(zgpbuf);
  5140. }
  5141.  
  5142. static char zgibuf[24];
  5143.  
  5144. char *
  5145. ziperm(f) char * f; {
  5146.     char * p, pbuf[6];
  5147.     int i, x;
  5148.     char c;
  5149.     p = zgperm(f);
  5150.     if (!p)
  5151.       return("(,,,)");
  5152.     if ((int)strlen(p) != 4)
  5153.       return("(,,,)");
  5154.     ckstrncpy(pbuf,p,6);
  5155.     p = zgibuf;
  5156.     *p = '\0';
  5157.     for (i = 3; i >= 0; i--) {
  5158.     c = pbuf[i];
  5159.     if (i < 3)
  5160.       *p++ = ',';
  5161.     else
  5162.       *p++ = '(';
  5163.     if (c >= '0' && c <= '9')
  5164.       x = c - '0';
  5165.     else if (c >= 'A' && c <= 'F')
  5166.       x = c - 'A' + 10;
  5167.     else if (c >= 'a' && c <= 'f')
  5168.       x = c - 'a' + 10;
  5169.     else
  5170.       return(NULL);
  5171.     if (!(x & XAB$M_NOREAD))  *p++ = 'R';
  5172.     if (!(x & XAB$M_NOWRITE)) *p++ = 'W';
  5173.     if (!(x & XAB$M_NOEXE))   *p++ = 'E';
  5174.     if (!(x & XAB$M_NODEL))   *p++ = 'D';
  5175.     }
  5176.     *p++ = ')';
  5177.     *p = '\0';
  5178.     debug(F110,"ziperm",zgibuf,0);
  5179.     return((char *) zgibuf);
  5180. }
  5181.  
  5182. /*  Z S A T T R  --  Fill in a Kermit attribute structure for current file.  */
  5183.  
  5184. /*
  5185.  Fills in a Kermit file attribute structure for the file which is to be sent.
  5186.  Returns 0 on success with the structure filled in, or -1 on failure.
  5187.  If any string member is null, then it should be ignored.
  5188.  If any numeric member is -1, then it should be ignored.
  5189. */
  5190. int
  5191. zsattr(xx) struct zattr *xx; {
  5192.     CK_OFF_T k;
  5193.     int x;
  5194.     static char mth[13][4] = {
  5195.     "JAN","FEB","MAR","APR",
  5196.     "MAY","JUN","JUL","AUG",
  5197.     "SEP","OCT","NOV","DEC",
  5198.     ""
  5199.     };
  5200.     static char recfm[15];        /* Record format */
  5201.     static char cdate[20];          /* Creation date [yy]yymmdd[hh:mm[:ss]] */
  5202.     static char creater_id[31];        /* Creator ID string */
  5203.     static char genprot;            /* Generic protection */
  5204.     static char gpbuf[2];        /* String representation thereof */
  5205.     static unsigned short lclprot;  /* Local protection */
  5206.     static char lpbuf[32];        /* String representation thereof */
  5207.     static long sysparam_size=0;    /* Length of system paramater buffer */
  5208.     static char *sysparam_adr=0;    /* Address of system paramater buffer */
  5209.     char type;                /* File type */
  5210.     short int asctim_retlen;
  5211.     char asctim_buf[24];        /* Work buffer for ASCTIM() */
  5212.     struct dsc$descriptor_s
  5213.       asctim_dsc = {sizeof(asctim_buf),DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};
  5214. /*  static long int i;  */
  5215.     static unsigned short id_len;
  5216.     static struct dsc$descriptor_s id_str =
  5217.       {31,DSC$K_DTYPE_T,DSC$K_CLASS_S,creater_id};
  5218.  
  5219. /* Zero out strings */
  5220.  
  5221.     type = 0;
  5222.     recfm[0] = '\0';
  5223.     cdate[0] = '\0';
  5224.     creater_id[0] = '\0';
  5225.     id_len = 0;
  5226.     genprot = 0;            /* Blank protections by default */
  5227.     gpbuf[0] = '\0';
  5228.     lclprot = 0;
  5229.     lpbuf[0] = '\0';
  5230.     asctim_dsc.dsc$a_pointer = (char *)&asctim_buf;
  5231.  
  5232. /* See if we are sending "attributes" from a REMOTE command response */
  5233.  
  5234.     if (*nambuf == '\0') {
  5235.     xx->lengthk = 1;        /* Number of 1K blocks rounded up */
  5236.     xx->type.len = 0;        /* File type can't be filled in here */
  5237.     xx->type.val = "";
  5238.     xx->date.len = strlen(cdate);    /* File creation date */
  5239.     xx->date.val = (char *)&cdate;
  5240.     xx->creator.len = strlen(creater_id); /* File creator */
  5241.     xx->creator.val = (char *)&creater_id;
  5242.     xx->account.len = 0;        /* File account */
  5243.     xx->account.val = "";
  5244.     xx->area.len = 0;        /* File area */
  5245.     xx->area.val = "";
  5246.     xx->password.len = 0;        /* Area password */
  5247.     xx->password.val = "";
  5248.     xx->blksize = -1L;        /* File blocksize */
  5249.     xx->xaccess.len = 0;        /* File access */
  5250.     xx->xaccess.val = "";
  5251.     xx->encoding.len = 1;        /* Transfer syntax */
  5252.     xx->encoding.val = "A";        /* ASCII */
  5253.     xx->disp.len = 0;        /* Disposition upon arrival */
  5254.     xx->disp.val = "";
  5255.     xx->lprotect.len = strlen(lpbuf); /* Local protection */
  5256.     xx->lprotect.val = (char *)lpbuf;
  5257.     xx->gprotect.len = strlen(gpbuf); /* Generic protection */
  5258.     xx->gprotect.val = (char *)gpbuf;
  5259.     xx->systemid.len = 2;        /* System ID for DEC VMS */
  5260.     xx->systemid.val = "D7";
  5261.     xx->recfm.len = strlen(recfm);    /* Record format */
  5262.     xx->recfm.val = (char *)&recfm;
  5263.     xx->sysparam.len = sysparam_size; /* System-dependent parameters */
  5264.     xx->sysparam.val = sysparam_adr;
  5265.     xx->length = 1;            /* Length */
  5266.     return(0);            /* mumble sweet nothings at it */
  5267.     }
  5268.  
  5269. /* Load the generic protection */
  5270.  
  5271. #ifdef COMMENT
  5272.     x = xabpro_ifile.xab$w_pro >> XAB$V_WLD;    /* World protection */
  5273. #else
  5274.     x = (xabpro_ifile.xab$w_pro >> 4) & 0xFF;    /* Owner protection */
  5275. #endif /* COMMENT */
  5276.     if (!(x & XAB$M_NOREAD))  genprot |= 1;    /* Read */
  5277.     if (!(x & XAB$M_NOWRITE)) genprot |= 2+8;    /* Write (and append) */
  5278.     if (!(x & XAB$M_NOEXE))   genprot |= 4;    /* Execute */
  5279.     if (!(x & XAB$M_NODEL))   genprot |= 16;    /* Delete */
  5280.     gpbuf[0] = tochar(genprot);                /* Generic prot as string */
  5281.     gpbuf[1] = '\0';
  5282.     lclprot = xabpro_ifile.xab$w_pro;        /* Local-format protection */
  5283.     sprintf(lpbuf,"%04X",lclprot);        /* Convert to hex string */
  5284.  
  5285. /* Convert creation date from an internal value to common ascii string */
  5286.  
  5287.     sys$asctim(&asctim_retlen,&asctim_dsc,&xabdat_ifile.xab$q_cdt,0);
  5288.     asctim_buf[asctim_retlen] = '\0';
  5289.     debug(F110,"zsattr asctim_buf",asctim_buf,0);
  5290.     for (x = 0; strncmp(mth[x], asctim_buf+3,3); x++) /* Find month */
  5291.       ;
  5292.     strncpy(cdate,asctim_buf+7,4);    /* 'yyyy' */
  5293.     sprintf(cdate+4,"%02d",x+1);    /* 'mm' */
  5294.     strncpy(cdate+6,asctim_buf+0,2);    /* 'dd' */
  5295.     strncpy(cdate+8,asctim_buf+11,9);    /* ' hh:mm:ss' */
  5296.     if (cdate[6] == ' ')
  5297.     cdate[6] = '0';
  5298.     debug(F110,"zsattr cdate",cdate,0);
  5299.  
  5300. /* Convert the owner UIC into an alpha name */
  5301.  
  5302.     creater_id[0] = '\0';
  5303.     rms_sts = sys$idtoasc(xabpro_ifile.xab$l_uic,&id_len,&id_str,0,0,0);
  5304.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  5305.     creater_id[id_len] = '\0';            /* terminating null, please */
  5306.     debug(F111,"zsattr $idtoasc owner",creater_id,strlen(creater_id));
  5307.     if (rms_sts == SS$_NOSUCHID ||
  5308. #ifdef SS$_NORIGHTSDB    /* only vms 5 and higher */
  5309.     rms_sts == SS$_NORIGHTSDB ||
  5310. #endif /* SS$_NORIGHTSDB */
  5311.     rms_sts == SS$_IVIDENT) {
  5312.     creater_id[0] = '\0';
  5313.     rms_sts = SS$_NORMAL;            /* if unknown, null it out */
  5314.     }
  5315.     if (!(rms_sts & 1)) {
  5316.     debug(F101,"zsattr $idtoasc failed, status","",rms_sts);
  5317.     return(-1);                /* fatal */
  5318.     }
  5319.  
  5320. /* Fill in the record format blockette */
  5321.  
  5322.     if (fab_ifile.fab$b_rat & (FAB$M_CR | FAB$M_FTN | FAB$M_PRN)) {
  5323.     strcpy(recfm,"AMJ");
  5324.     } else {
  5325.     strcpy(recfm,"F");
  5326.     sprintf(recfm+1,"%05d",xabfhc_ifile.xab$w_lrl);
  5327.     }
  5328.     debug(F111,"zsattr recfm",recfm,strlen(recfm));
  5329.  
  5330. /* Fill in the returned data structure */
  5331.  
  5332.     xx->lengthk = (iflen/1024)+1;    /* Number of 1K blocks rounded up */
  5333.     xx->type.len = 0;            /* File type can't be filled in here */
  5334.     xx->type.val = "";
  5335.     xx->date.len = strlen(cdate);    /* File creation date */
  5336.     xx->date.val = (char *)&cdate;
  5337.     xx->creator.len = strlen(creater_id); /* File creator */
  5338.     xx->creator.val = (char *)&creater_id;
  5339.     xx->account.len = 0;        /* File account */
  5340.     xx->account.val = "";
  5341.     xx->area.len = 0;            /* File area */
  5342.     xx->area.val = "";
  5343.     xx->password.len = 0;        /* Area password */
  5344.     xx->password.val = "";
  5345.     xx->blksize = -1L;            /* File blocksize */
  5346.     xx->xaccess.len = 0;        /* File access */
  5347.     xx->xaccess.val = "";
  5348.     xx->encoding.len = 1;        /* Transfer syntax */
  5349.     xx->encoding.val = "A";        /* ASCII */
  5350.     xx->disp.len = 0;            /* Disposition upon arrival */
  5351.     xx->disp.val = "";
  5352.     xx->lprotect.len = strlen(lpbuf);    /* Local protection */
  5353.     xx->lprotect.val = (char *)lpbuf;
  5354.     xx->gprotect.len = strlen(gpbuf);    /* Generic protection */
  5355.     xx->gprotect.val = (char *)gpbuf;
  5356.     xx->systemid.len = 2;        /* System ID for (Open)VMS */
  5357.     xx->systemid.val = "D7";
  5358.     xx->recfm.len = strlen(recfm);    /* Record format */
  5359.     xx->recfm.val = (char *)&recfm;
  5360.     xx->sysparam.len = sysparam_size;    /* System-dependent parameters */
  5361.     xx->sysparam.val = sysparam_adr;
  5362.     xx->length = iflen;            /* Length */
  5363.     debug(F111,"zsattr lengthk","",xx->lengthk);
  5364.     debug(F111,"zsattr length","",xx->length);
  5365.     return(0);
  5366. }
  5367.  
  5368. /* Z M K D I R  --  Create directory(s) if necessary */
  5369. /*
  5370.    Call with:
  5371.      A pointer to a file specification that might contain directory
  5372.      information.  The filename is expected to be included.
  5373.      If the file specification does not include any directory separators,
  5374.      then it is assumed to be a plain file.
  5375.      If one or more directories are included in the file specification,
  5376.      this routine tries to create them if they don't already exist.
  5377.    Returns:
  5378.      0 on success, i.e. the directory was created, or didn't need to be.
  5379.     -1 on failure to create the directory
  5380.    VMS version by Mark Berryman, Feb 94.
  5381. */
  5382. int
  5383. zmkdir(path) char *path; {
  5384.     struct FAB dir_fab;
  5385.     struct NAMX dir_nam;
  5386.     struct dsc$descriptor_s expanded_filename;
  5387.  
  5388.     char expanded_name[ NAMX_C_MAXRSS];
  5389.  
  5390.     dir_fab = cc$rms_fab;               /* Initialize the FAB. */
  5391.     dir_nam = CC_RMS_NAMX;              /* Initialize the NAM[L]. */
  5392.     dir_fab.FAB_L_NAMX = &dir_nam;      /* Point the FAB to the NAM[L]. */
  5393.  
  5394.     /* Install the path name in the FAB or NAML. */
  5395. #ifdef NAML$C_MAXRSS
  5396.     dir_fab.fab$l_dna = (char *) -1;  /* Using NAML for default name. */
  5397.     dir_fab.fab$l_fna = (char *) -1;  /* Using NAML for file name. */
  5398. #endif /* def NAML$C_MAXRSS */
  5399.     FAB_OR_NAML( dir_fab, dir_nam).FAB_OR_NAML_FNA = path;
  5400.     FAB_OR_NAML( dir_fab, dir_nam).FAB_OR_NAML_FNS = strlen( path);
  5401.  
  5402.     dir_nam.NAMX_L_ESA = expanded_name;
  5403.     dir_nam.NAMX_B_ESS = sizeof( expanded_name);
  5404.  
  5405.     rms_sts = sys$parse(&dir_fab,0,0);
  5406.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  5407.     switch (rms_sts) {
  5408.         case RMS$_NORMAL :
  5409.         debug(F110,"zmkdir path already exists",path,0);
  5410.         return 0;
  5411.  
  5412.         case RMS$_FNM :            /* E.g. too long... (99628) */
  5413.         debug(F110,"zmkdir bad filename",path,0);
  5414.         return 0;            /* Let zrtol() handle it. */
  5415.  
  5416.         case RMS$_DNF :            /* Directory Not Found, create it */
  5417.             debug(F110,"zmkdir RMS$_DNF",path,0);
  5418.             break;
  5419.  
  5420.         default :            /*  Any other result is fatal. */
  5421.             debug(F111,"zmkdir status",path,rms_sts);
  5422.         return -1;
  5423.     }
  5424.  
  5425. /*  The parse succeeded but said the directory didn't exist, so create it. */
  5426.     expanded_filename.dsc$b_class = DSC$K_CLASS_S;
  5427.     expanded_filename.dsc$b_dtype = DSC$K_DTYPE_T;
  5428.     expanded_filename.dsc$a_pointer = expanded_name;
  5429.     expanded_filename.dsc$w_length = dir_nam.NAMX_B_ESL;
  5430.  
  5431. /* Locate the closing bracket, ']' or '>', using the $PARSE results */
  5432. /* node names are not allowed, but let lib$create_dir return the error */
  5433.  
  5434.     expanded_filename.dsc$w_length = dir_nam.NAMX_B_NODE +
  5435.                                      dir_nam.NAMX_B_DEV +
  5436.                                      dir_nam.NAMX_B_DIR;
  5437.  
  5438.     rms_sts = lib$create_dir(&expanded_filename,0,0,0,0,0);
  5439.     expanded_name[expanded_filename.dsc$w_length] = '\0';
  5440.     debug(F111,"zmkdir create_dir status",(char *)&expanded_name, rms_sts);
  5441.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  5442.     CHECK_ERR("zmkdir create error", rms_sts);
  5443.     return (rms_sts == SS$_CREATED ? 1 : -1);
  5444. }
  5445.  
  5446. /*  Z R M D I R  --  Delete a directory  */
  5447.  
  5448. int
  5449. zrmdir(path) char *path; {
  5450.     int i;
  5451.     int status;
  5452.     char *cp;
  5453.     char *dir_begin;
  5454.     char *dir_end;
  5455.     char *dot_last;
  5456.     struct FAB fab_dir;
  5457.     struct NAMX nam_dir;
  5458.     char exp_name[ NAMX_C_MAXRSS];
  5459.     char dir_name[ NAMX_C_MAXRSS];
  5460.  
  5461.     /* Special ODS5-QIO-compatible name storage. */
  5462. #ifdef NAML$C_MAXRSS
  5463.     char sys_name[ NAML$C_MAXRSS];
  5464. #endif /* def NAML$C_MAXRSS */
  5465.  
  5466.     int atr_devchn;                     /* Disk device channel. */
  5467.     struct fibdef atr_fib;              /* File Information Block. */
  5468.     unsigned short atr_prot;            /* Protection attributes. */
  5469.  
  5470.     int lb = 0;                         /* Left bracket count. */
  5471.     int rb = 0;                         /* Right bracket count. */
  5472.  
  5473.     /* Disk device name descriptor. */
  5474.     struct dsc$descriptor_s atr_devdsc =
  5475.      { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, NULL };
  5476.  
  5477.     /* File Information Block descriptor. */
  5478.     struct dsc$descriptor atr_fibdsc =
  5479.      { sizeof( atr_fib), DSC$K_DTYPE_Z, DSC$K_CLASS_S, NULL };
  5480.  
  5481.     /* File name descriptor. */
  5482.     struct dsc$descriptor_s atr_fnam =
  5483.      { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, NULL };
  5484.  
  5485.     /* IOSB for QIO[W] miscellaneous ACP operations. */
  5486.     struct
  5487.     {
  5488.         unsigned short  status;
  5489.         unsigned short  dummy;
  5490.         unsigned int    count;
  5491.     } atr_acp_iosb;
  5492.  
  5493.     /* Attribute item list: file protection, terminator. */
  5494.     struct atrdef atr_atr[ 2] =
  5495.      { { ATR$S_FPRO, ATR$C_FPRO, GVTC NULL },
  5496.        { 0, 0, GVTC NULL }
  5497.      };
  5498.  
  5499.     /* Execution begins. */
  5500.  
  5501.     /* Make safe, then debug-display path argument. */
  5502.     if (path == NULL)
  5503.         path = "";
  5504.     debug(F110, "zrmdir path 1", path, 0);
  5505.  
  5506.     /* Quit early on a null path. */
  5507.     if (!*path)
  5508.         return(-1);
  5509.  
  5510.     /* Convert (plain) "dir_name" to "[.dir_name]". */
  5511.     for (cp = path; *cp != '\0'; cp++)
  5512.     {
  5513.         if (*cp == '^')                 /* Skip caret-escaped characters. */
  5514.         {
  5515.             cp++;
  5516.             continue;
  5517.         }
  5518.     if (*cp == '[')                 /* Count left brackets. */
  5519.             lb++;
  5520.     else if (*cp == ']')            /* Count right brackets. */
  5521.             rb++;
  5522.     }
  5523.  
  5524.     /* If bare "name", then construct (relative) VMS dir spec, "[.name]". */
  5525.     if (lb != 1 && rb != 1 && cp > path && *(cp- 1) != ':')
  5526.     {
  5527.     sprintf( dir_name, "[.%s]", path);
  5528.         path = dir_name;
  5529.     }
  5530.     debug(F110, "zrmdir path 2", path, 0);
  5531.  
  5532.     fab_dir = cc$rms_fab;               /* Initialize the FAB. */
  5533.     nam_dir = CC_RMS_NAMX;              /* Initialize the NAM[L]. */
  5534.     fab_dir.FAB_L_NAMX = &nam_dir;      /* Point the FAB to the NAM[L]. */
  5535.  
  5536.     /* Install the path name in the FAB or NAML. */
  5537. #ifdef NAML$C_MAXRSS
  5538.     fab_dir.fab$l_dna = (char *) -1;  /* Using NAML for default name. */
  5539.     fab_dir.fab$l_fna = (char *) -1;  /* Using NAML for file name. */
  5540. #endif /* def NAML$C_MAXRSS */
  5541.     FAB_OR_NAML( fab_dir, nam_dir).FAB_OR_NAML_FNA = path;
  5542.     FAB_OR_NAML( fab_dir, nam_dir).FAB_OR_NAML_FNS = strlen( path);
  5543.  
  5544.     /* Expanded name storage. */
  5545.     nam_dir.NAMX_L_ESA = exp_name;
  5546.     nam_dir.NAMX_B_ESS = sizeof( exp_name);
  5547.  
  5548.     status = sys$parse( &fab_dir);
  5549.     if (!(status& 1)) vms_lasterr = status;
  5550.     if (status != RMS$_NORMAL)        /* Does not exist */
  5551.         return(-1);
  5552.     debug(F100, "zrmdir directory exists", exp_name, 0);
  5553.  
  5554. #define DIR_TYPE  ".DIR;1"
  5555.  
  5556.     /* Transform "[a.b]" to "[a]b.DIR;1".
  5557.      * First, find the last true "." in the directory field.
  5558.      */
  5559.     dir_begin = nam_dir.NAMX_L_DIR;
  5560.     dir_end = dir_begin- 1+ nam_dir.NAMX_B_DIR;
  5561.     dot_last = NULL;
  5562.     for (cp = dir_end- 1; cp > dir_begin; cp--)
  5563.     {
  5564.         if (*cp == '.')
  5565.         {
  5566.             if (*(cp- 1) == '^')        /* Skip an escaped dot. */
  5567.             {
  5568.                 cp--;
  5569.             }
  5570.             else
  5571.             {
  5572.                 dot_last = cp;          /* Found it. */
  5573.                 break;
  5574.             }
  5575.         }
  5576.     }
  5577.  
  5578.     /* Construct a file spec for the directory file. */
  5579.     if (dot_last == NULL)
  5580.     {
  5581.         /* No last dot.  "[a]" -> "[000000]a.DIR;1". */
  5582.         dir_begin++;                     /* Now first char after "[". */
  5583.         cp = dir_begin;
  5584.         strncpy( dir_name, exp_name, (cp- exp_name));   /* "dev:[". */
  5585.         cp = dir_name+ (cp- exp_name);
  5586.         strncpy( cp, "000000", 6);              /* "dev:[000000". */
  5587.         cp += 6;
  5588.         strncpy( cp, dir_end, 1);               /* "dev:[000000]". */
  5589.         cp += 1;
  5590.         strncpy( cp, dir_begin, (dir_end- dir_begin));  /* "dev:[000000]a". */
  5591.         cp += dir_end- dir_begin;
  5592.         strcpy( cp, DIR_TYPE);                  /* "dev:[000000]a.DIR;1". */
  5593.     }
  5594.     else
  5595.     {
  5596.         /* Last dot found.  "[a.b]" -> "[a]b.DIR;1". */
  5597.         *dot_last = *dir_end;                   /* "dev:[a]b". */
  5598.         strcpy( dir_end, DIR_TYPE);             /* "dev:[a]b.DIR;1". */
  5599.         strcpy( dir_name, exp_name);
  5600.     }
  5601.  
  5602.     debug(F100, "zrmdir dir file spec", dir_name, 0);
  5603.     debug(F101, "zrmdir DECnet =", "", nam_dir.NAMX_V_NODE);
  5604.  
  5605.     /* Change protection on the directory file, then delete it. */
  5606.  
  5607.     if (nam_dir.NAMX_V_NODE != 0)
  5608.     {
  5609.         /* DECnet node name detected.  QIO won't work, so use the
  5610.          * (fossil) "system()" scheme.  First, SET PROT.
  5611.          * ("OWNER:RWED"?  Why not WORLD:RWED?  What if we don't own it?)
  5612.          * It's not immediately obvious that SET PROT works any better
  5613.          * than QIO on a DECnet file spec, so it may make more sense to
  5614.          * discard all this old system() code, and just use the QIO
  5615.          * scheme on local files, and delete() on everything.
  5616.          * (Who says that "delete() won't do it"?)
  5617.          */
  5618.     sprintf( exp_name, "set protection=owner:RWED %s", dir_name);
  5619.     status = system( exp_name);
  5620.     debug(F111, "zrmdir system() status ", exp_name, status);
  5621. #ifdef COMMENT
  5622. /* If this failed it doesn't necessarily mean there is no Delete access */
  5623.     if ((status& 1) != 1)
  5624.       return(-1);
  5625. #endif /* COMMENT */
  5626.     sprintf( exp_name, "delete %s", dir_name); /* delete() won't do it. */
  5627.     status = system( exp_name);
  5628.     debug(F111, "zrmdir system() status ", exp_name, status);
  5629.     if ((status& 1) != 1)
  5630.       return(-1);
  5631.     return(0);
  5632.     }
  5633.     else
  5634.     {
  5635.         /* No DECnet node name detected.  Use QIO to set protection. */
  5636.         fab_dir = cc$rms_fab;           /* Initialize the FAB. */
  5637.         nam_dir = CC_RMS_NAMX;          /* Initialize the NAM[L]. */
  5638.         fab_dir.FAB_L_NAMX = &nam_dir;  /* Point the FAB to the NAM[L]. */
  5639.  
  5640.         /* Install the path name in the FAB or NAML. */
  5641. #ifdef NAML$C_MAXRSS
  5642.         fab_dir.fab$l_dna = (char *) -1;    /* Using NAML for default name. */
  5643.         fab_dir.fab$l_fna = (char *) -1;    /* Using NAML for file name. */
  5644.  
  5645.         /* Special ODS5-QIO-compatible name storage. */
  5646.         nam_dir.naml$l_filesys_name = sys_name;
  5647.         nam_dir.naml$l_filesys_name_alloc = sizeof( sys_name);
  5648. #endif /* def NAML$C_MAXRSS */
  5649.         FAB_OR_NAML( fab_dir, nam_dir).FAB_OR_NAML_FNA = dir_name;
  5650.         FAB_OR_NAML( fab_dir, nam_dir).FAB_OR_NAML_FNS = strlen( dir_name);
  5651.  
  5652.         /* Expanded name storage. */
  5653.         nam_dir.NAMX_L_ESA = exp_name;
  5654.         nam_dir.NAMX_B_ESS = sizeof( exp_name);
  5655.  
  5656.         status = sys$parse( &fab_dir);
  5657.         if ((status& STS$M_SEVERITY) == STS$M_SUCCESS)
  5658.         {
  5659.             debug(F100, "zrmdir dir file exists", exp_name, 0);
  5660.  
  5661.             /* Set the address in the device name descriptor. */
  5662.             atr_devdsc.dsc$a_pointer = &nam_dir.NAMX_T_DVI[ 1];
  5663.  
  5664.             /* Set the length in the device name descriptor. */
  5665.             atr_devdsc.dsc$w_length = (unsigned short) nam_dir.NAMX_T_DVI[ 0];
  5666.  
  5667.             /* Open a channel to the disk device. */
  5668.             status = sys$assign( &atr_devdsc, &atr_devchn, 0, 0);
  5669.             if ((status& STS$M_SEVERITY) == STS$M_SUCCESS)
  5670.             {
  5671.                 debug(F011, "zrmdir assign disk",
  5672.                  atr_devdsc.dsc$a_pointer, atr_devdsc.dsc$w_length);
  5673.  
  5674.                 /* Move the directory ID from the NAM[L] to the FIB.
  5675.                    Clear the FID in the FIB, as we're using the name.
  5676.                 */
  5677.                 for (i = 0; i < 3; i++)
  5678.                 {
  5679.                     atr_fib.FIB_W_DID[ i] = nam_dir.NAMX_W_DID[ i];
  5680.                     atr_fib.FIB_W_FID[ i] = 0;
  5681.                 }
  5682.  
  5683. #ifdef NAML$C_MAXRSS
  5684.  
  5685.                 /* Enable fancy name characters.  Note that "fancy" here does
  5686.                    not include Unicode, for which there's no support elsewhere.
  5687.                 */
  5688.                 atr_fib.fib$v_names_8bit = 1;
  5689.                 atr_fib.fib$b_name_format_in = FIB$C_ISL1;
  5690.  
  5691.                 /* ODS5 Extended names used as input to QIO have peculiar
  5692.                    encoding (perhaps to minimize storage?), so the special
  5693.                    filesys_name result (typically containing fewer carets) must
  5694.                    be used here.
  5695.                 */
  5696.                 atr_fnam.dsc$a_pointer = nam_dir.naml$l_filesys_name;
  5697.                 atr_fnam.dsc$w_length = nam_dir.naml$l_filesys_name_size;
  5698.  
  5699. #else /* def NAML$C_MAXRSS */
  5700.  
  5701.                 /* ODS2-only: Use the whole name. */
  5702.                 atr_fnam.dsc$a_pointer = nam_dir.NAMX_L_NAME;
  5703.                 atr_fnam.dsc$w_length =
  5704.                  nam_dir.NAMX_B_NAME+ nam_dir.NAMX_B_TYPE+ nam_dir.NAMX_B_VER;
  5705.  
  5706. #endif /* def NAML$C_MAXRSS [else] */
  5707.  
  5708.                 /* Set the address in the FIB descriptor. */
  5709.                 atr_fibdsc.dsc$a_pointer = (void *) &atr_fib;
  5710.  
  5711.                 /* Set the address of the prot word in the prot descriptor. */
  5712.                 atr_atr[ 0].atr$l_addr = GVTC &atr_prot;
  5713.  
  5714.                 /* Fetch the file (directory) protection attributes. */
  5715.                 status = sys$qiow( 0,               /* event flag */
  5716.                                    atr_devchn,      /* channel */
  5717.                                    IO$_ACCESS,      /* function code */
  5718.                                    &atr_acp_iosb,   /* IOSB */
  5719.                                    0,               /* AST address */
  5720.                                    0,               /* AST parameter */
  5721.                                    &atr_fibdsc,     /* P1 = File Info Block */
  5722.                                    &atr_fnam,       /* P2 = File name */
  5723.                                    0,               /* P3 = Rslt nm len */
  5724.                                    0,               /* P4 = Rslt nm str */
  5725.                                    atr_atr,         /* P5 = Attributes */
  5726.                                    0);              /* P6 (not used) */
  5727.  
  5728.                 debug(F101, "zrmdir access status", "", status);
  5729.  
  5730.                 /* Mask out or clear No-Delete bits. */
  5731.                 if ((status & STS$M_SEVERITY) == STS$K_SUCCESS)
  5732.                 {
  5733.                     atr_prot &= 0x7777;     /* Add (S:D, O:D, G:D, W:D) */
  5734.                 }
  5735.                 else
  5736.                 {
  5737.                     atr_prot = 0x7777;      /* Set (S:D, O:D, G:D, W:D) */
  5738.                 }
  5739.  
  5740.                 /* Try to modify the file (directory) attributes. */
  5741.                 status = sys$qiow( 0,               /* event flag */
  5742.                                    atr_devchn,      /* channel */
  5743.                                    IO$_MODIFY,      /* function code */
  5744.                                    &atr_acp_iosb,   /* IOSB */
  5745.                                    0,               /* AST address */
  5746.                                    0,               /* AST parameter */
  5747.                                    &atr_fibdsc,     /* P1 = File Info Block */
  5748.                                    &atr_fnam,       /* P2 = File name */
  5749.                                    0,               /* P3 = Rslt nm len */
  5750.                                    0,               /* P4 = Rslt nm str */
  5751.                                    atr_atr,         /* P5 = Attributes */
  5752.                                    0);              /* P6 (not used) */
  5753.  
  5754.                 debug(F101, "zrmdir modify status", "", status);
  5755.                 if ((status & STS$M_SEVERITY) == STS$K_SUCCESS)
  5756.                 {
  5757.                     status = atr_acp_iosb.status;
  5758.                     debug(F101, "zrmdir modify iosb status", "", status);
  5759.                 }
  5760.             }
  5761.         }
  5762.         /* Finally, delete the thing. */
  5763.         status = delete( dir_name);
  5764.         if (status == 0)
  5765.             status = SS$_NORMAL;
  5766.         else
  5767.             status = vaxc$errno;
  5768.         debug(F101, "zrmdir delete status", "", status);
  5769.     }
  5770.     if ((status&1) != 1)
  5771.         return(-1);
  5772.     return(0);
  5773. }
  5774.  
  5775.  
  5776. /*  Z M A I L  --  Send file f as mail to address p.  */
  5777. /*
  5778.   Returns 0 on success
  5779.    2 if mail delivered but temp file can't be deleted
  5780.   -2 if mail can't be delivered
  5781. */
  5782. int
  5783. zmail(p,f) char *p; char *f; {
  5784.     char *zmbuf;
  5785.     static char spbuf[] = "$ mail %s %s/subj=\"Enclosed file %s\"";
  5786.     static char spbuf2[] = "%s;";
  5787.     unsigned long int sts;
  5788.  
  5789.     zmbuf = malloc(strlen(p)+(2*strlen(f))+sizeof(spbuf));
  5790.     sprintf(zmbuf,spbuf, f, p, f);
  5791.     sts = system(zmbuf);
  5792.     debug(F111,"zmail: system returns status ",zmbuf,sts);
  5793.     free(zmbuf);
  5794.     if ((sts&1) != 1) {
  5795.     debug(F101,"zmail: returning","",-2);
  5796.     return(-2);
  5797.     }
  5798.     zmbuf = malloc(strlen(f)+sizeof(spbuf2));
  5799.     sprintf(zmbuf,spbuf2, f);
  5800.     sts = delete(zmbuf);
  5801.     debug(F111,"zmail: delete returns status ",zmbuf,sts);
  5802.     free(zmbuf);
  5803.     if (sts) sts = 2;
  5804.     debug(F101,"zmail: returning","",sts);
  5805.     return(sts);
  5806. }
  5807.  
  5808. /* Z P R I N T  --  Print file f with options p.  */
  5809. /*
  5810.   Returns 0 on success, -3 on failure.
  5811. */
  5812. int
  5813. zprint(p,f) char *p; char *f; {
  5814.     char *zmbuf;
  5815.     static char spbuf[] = "$ print/delete %s %s";
  5816.     unsigned long int sts;
  5817.  
  5818.     zmbuf = malloc(strlen(p)+strlen(f)+sizeof(spbuf));
  5819.     sprintf(zmbuf,spbuf, p, f);
  5820.     sts = system(zmbuf);
  5821.     debug(F111,"zprint: system returns status ",zmbuf,sts);
  5822.     free(zmbuf);
  5823.     debug(F101,"zprint: returning","",(sts&1) ? 0 : -3);
  5824.     return((sts&1) ? 0 : -3);
  5825. }
  5826.  
  5827. /* Z S Y S C M D  --  Execute a DCL command with direct output.  */
  5828.  
  5829. /*
  5830.  * Since it's really difficult to have an alternate CLI under VMS (since the
  5831.  * MCR interface isn't documented and POSIX hasn't published the interface,
  5832.  * we'll just assume everybody uses DCL and hand it of to zshcmd().
  5833.  */
  5834. int
  5835. zsyscmd(s) char *s; {
  5836.     if (nopush) {
  5837.     debug(F100,"zsyscmd fails: nopush","",0);
  5838.     return(-1);
  5839.     }
  5840.     return(zshcmd(s));
  5841. }
  5842.  
  5843. /*
  5844.  * Dummy function, since SIG_DFL seems to be broken with DEC C
  5845.  */
  5846. VOID
  5847. sig_dum() {
  5848.  
  5849. }
  5850.  
  5851. /* Z S H C M D  --  Execute a default CLI command with direct output.  */
  5852.  
  5853. /*
  5854.  * As it's _REALLY_ unlikely that the user is using MCR as his default CLI,
  5855.  * and DEC doesn't document how to write any other alternate CLIs, use DCL.
  5856.  */
  5857.  
  5858. #ifndef    SS$_EXPRCLM        /* VMS doesn't return this yet, but let's */
  5859. #define SS$_EXPRCLM 10804    /* be forward-thinking and anticpate VMS */
  5860. #endif /* SS$_EXPRCLM */    /* V6.0, which will return it. */
  5861.  
  5862. int
  5863. zshcmd(s) char *s; {
  5864.     unsigned long sts, cc;
  5865.     void (*cct)();
  5866.     void (*sig_dum_ptr)() = sig_dum;
  5867.     struct dsc$descriptor_s
  5868.       cmd_line = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
  5869.     char *i;
  5870.  
  5871.     pexitstat = -1;
  5872.     if (nopush) {
  5873.     debug(F100,"zshcmd fails: nopush","",0);
  5874.     return(-1);
  5875.     }
  5876.     if (!s) s = "";
  5877.     debug(F110,"zshcmd",s,0);
  5878.     if (check_spawn() != 0) {
  5879.     debug(F100,"zshcmd: spawning prohibited by UAF flags","",0);
  5880.     return(0);
  5881.     }
  5882.  
  5883.     i = strstr(zgtdir(),"::");
  5884.     if (i != NULL) {
  5885.         debug(F100,"zshcmd: spawn prohibited on remote node","",0);
  5886.         printf("Cannot SPAWN with remote node as default directory\n");
  5887.      if (*s)
  5888.       printf("therefore, cannot execute the DCL command \"%s\"\n", s);
  5889.         return(0);
  5890.     }
  5891.  
  5892.     cct = signal(SIGINT,sig_dum_ptr);    /* Let inferior process catch ^C */
  5893.  
  5894.     cmd_line.dsc$w_length = strlen(s);
  5895.     cmd_line.dsc$a_pointer = s;
  5896.  
  5897.     if (!(*s))
  5898.       printf("Type LOGOUT to return to VMS C-Kermit.\n\n");
  5899.     sts = lib$spawn(&cmd_line, 0, 0, 0, 0, 0, &cc, 0, 0, 0, 0, 0);
  5900.     if (!(sts & 1)) vms_lasterr = sts;
  5901.     signal(SIGINT,cct);
  5902. /*
  5903.  * Note: We can't check for this beforehand as doing a getjpi for prclm will
  5904.  *     only return the UAF value, not the available value. So we try it and
  5905.  *     print this message if it didn't work.
  5906.  */
  5907.     if ((sts == SS$_EXQUOTA) || (sts == SS$_EXPRCLM)) {
  5908.     printf(
  5909. "Your account does not have sufficient quotas to use this command.\n");
  5910.     printf(
  5911. "Please ask your system manager to increase your UAF PRCLM quota.\n");
  5912.     }
  5913.     debug(F101,"zshcmd lib$spawn sts", "", sts);
  5914.     debug(F101,"zshcmd lib$spawn cc ", "", cc);
  5915.     debug(F101,"zshcmd lib$spawn SS$_NORMAL", "", SS$_NORMAL);
  5916.     if (sts == SS$_NORMAL) {
  5917.     pexitstat = cc;
  5918.     return((cc & 1) ? 1 : 0);    /* Success */
  5919.     } else {
  5920.     return(0);            /* Failure */
  5921.     }
  5922. }
  5923.  
  5924. /*  Z S T R I P  --  Strip device & directory name from file specification.  */
  5925.  
  5926. /*  Strip pathname from filename "name", return pointer to result in name2 */
  5927.  
  5928. static char work[1100];    /* buffer for use by zstrip and zltor */
  5929.  
  5930. VOID
  5931. zstrip(name,name2) char *name, **name2; {
  5932.     char *cp, *pp;
  5933.     char last;
  5934.     int len;
  5935.     debug(F110,"zstrip entry",name,0);
  5936.     pp = work;                /* Default return is empty string */
  5937.     *name2 = work;
  5938.     *pp = '\0';
  5939.     if (!name)
  5940.       return;
  5941.     if (!*name)
  5942.       return;
  5943.  
  5944. /*  NODE::DEV:[DIR] terminates on on final ':', '>' or ']'.  */
  5945.  
  5946.     for (cp = name; *cp; cp++) {
  5947.     last = *cp;
  5948.         if (*cp == '/' || *cp == ':' || *cp == '>' || *cp == ']') /* slash? */
  5949.       pp = work;
  5950.     else if (*cp == ';')        /* Chop off any version number */
  5951.       break;
  5952.     else                /* Part of filename */
  5953.       *pp++ = *cp;
  5954.     }
  5955.     *pp = '\0';                /* Terminate the string */
  5956.     debug(F000,"zstrip 2",work,last);
  5957. #ifdef COMMENT
  5958. /*
  5959.   This is a bad idea because the result will need to be passed thru zstrip()
  5960.   again, but zstrip() isn't designed to call itself.
  5961. */
  5962.     if (work[0] == '\0' && last == ':') { /* Result is empty? */
  5963.     char * q;            /* Maybe it's a logical name */
  5964.     q = (char *)malloc(1100);
  5965.     if (q) {
  5966.         ckstrncpy(q,name,1100);
  5967.         len = strlen(q);
  5968.         if (len > 0) {
  5969.         if (q[len-1] == ':') {
  5970.             char *t = q;
  5971.             q[len-1] = '\0';
  5972.             while (*t) { if (islower(*t)) *t = toupper(*t); t++; }
  5973.             debug(F110,"zstrip checking",q,0);
  5974.             pp = getenv(q);
  5975.             if (!pp) pp = "";
  5976.             ckstrncpy(work,pp,1100);
  5977.             debug(F110,"zstrip getenv",work,0);
  5978.         }
  5979.         }
  5980.         free(q);
  5981.     }
  5982.     }
  5983.     debug(F110,"zstrip 3",work,0);
  5984. #endif /* COMMENT */
  5985.  
  5986. /* The following should allow us to receive files to LPT:, LTA1:, etc. */
  5987.  
  5988.     if (work[0] == '\0') {        /* Still empty? */
  5989.     debug(F000,"zstrip last",name,last); /* If it's a device name */
  5990.     if (last == ':')        /* put it back */
  5991.       ckstrncpy(work,name,1100);
  5992.     }
  5993.     debug(F110,"zstrip result",*name2,0);
  5994. }
  5995.  
  5996. int
  5997. zchkpath(s) char *s; {
  5998. #ifdef COMMENT
  5999. /*
  6000.   This needs to be replaced with something more intelligent.
  6001.   The idea is to see if the file, whose specification is pointed to by s,
  6002.   is in the current directory.  This function should return 0 if it is,
  6003.   nonzero otherwise.  Presently we rely on being called with a full
  6004.   filespec of the form DISK:[DEV]NAME.TYP;V, so this works more or less
  6005.   by accident.  What we really need is to call some kind of VMS service
  6006.   to get the NODE::DEV:[DIR] of the file, and compare with the current
  6007.   NODE::DEV:[DIR].
  6008. */
  6009.     char *p;
  6010.     p = zgtdir();            /* Get current dir. */
  6011.     debug(F110,"zchkpath file",s,0);
  6012.     debug(F110,"zchkpath current dir",p,0);
  6013.     return(strncmp(p,s,strlen(p)));    /* Compare it. */
  6014. #else /* def COMMENT */
  6015. /*
  6016.     The purpose of this routine is to determine whether the file specified
  6017.     by *s would be in the current default directory or not.
  6018.  
  6019.     Inputs:
  6020.     *s = filename to check, can be just a filename or full path
  6021.  
  6022.     Outputs:
  6023.     0 = in the current default directory
  6024.         nonzero = not in the current directory
  6025.  
  6026.     Algorithm:
  6027.     Uses SYS$PARSE.  As long as the current default directory is not
  6028.     on a remote DECnet node, SYS$PARSE will return the Directory ID
  6029.     of the directory where the parsed filename would be found.  This
  6030.     means all we need do is parse both the default directory and the
  6031.     filename passed to us and compare DIDs (as well as make sure the
  6032.     two DIDs reference the same disk).  If so, it doesn't matter how
  6033.     convoluted the filename passed to us is, or what logical names
  6034.     may be involved, SYS$PARSE will tell us with certainty if it
  6035.     resolves to the current directory or not.
  6036.  
  6037.     However, if the current default directory is on a remote DECnet
  6038.     node, this information is not available (since SYS$PARSE executes
  6039.     locally, not remotely).  In this case, SYS$PARSE will still expand
  6040.     the filename as much as possible and then we can simply compare
  6041.     the default directory with the directory reference returned by the
  6042.     parse of the filename in *s using a simple string compare.  Since
  6043.     we cannot evaluate remote logical names, this may cause a false
  6044.     negative to occur if the user is playing games with the filename,
  6045.     but it guarantees that we do not get a false positive.
  6046.  */
  6047.     unsigned int dd_len, status;
  6048.     struct FAB my_fab;
  6049.     struct NAMX dd_nam, s_nam;
  6050.     const char *default_dir = "dummy.name";    /* guaranteed to resolve to */
  6051.                         /* the current default dir. */
  6052.     char dd_expanded_name[ NAMX_C_MAXRSS];
  6053.     char s_expanded_name[ NAMX_C_MAXRSS];
  6054.  
  6055.     my_fab = cc$rms_fab;                /* Initialize the FAB. */
  6056.     dd_nam = CC_RMS_NAMX;               /* Initialize the NAM[L]. */
  6057.     my_fab.FAB_L_NAMX = &dd_nam;        /* Point the FAB to the NAM[L]. */
  6058.  
  6059.     /* Install the path name in the FAB or NAML. */
  6060. #ifdef NAML$C_MAXRSS
  6061.     my_fab.fab$l_dna = (char *) -1;  /* Using NAML for default name. */
  6062.     my_fab.fab$l_fna = (char *) -1;  /* Using NAML for file name. */
  6063. #endif /* def NAML$C_MAXRSS */
  6064.     FAB_OR_NAML( my_fab, dd_nam).FAB_OR_NAML_FNA = (char *)default_dir;
  6065.     FAB_OR_NAML( my_fab, dd_nam).FAB_OR_NAML_FNS = strlen( default_dir);
  6066.  
  6067.     dd_nam.NAMX_L_ESA = dd_expanded_name;
  6068.     dd_nam.NAMX_B_ESS = sizeof( dd_expanded_name);
  6069.  
  6070. /* PARSE the current default directory */
  6071.     status = sys$parse(&my_fab,0,0);
  6072.     if (!(status & 1)) {                  /* any $PARSE errors are fatal */
  6073.         return (status);
  6074.     }
  6075.  
  6076.     s_nam = CC_RMS_NAMX;
  6077.     s_nam.NAMX_L_ESA = s_expanded_name;
  6078.     s_nam.NAMX_B_ESS = sizeof( s_expanded_name);
  6079.  
  6080.     my_fab.FAB_L_NAMX = &s_nam;
  6081.  
  6082.     /* Install the path name in the FAB or NAML. */
  6083. #ifdef NAML$C_MAXRSS
  6084.     my_fab.fab$l_dna = (char *) -1;  /* Using NAML for default name. */
  6085.     my_fab.fab$l_fna = (char *) -1;  /* Using NAML for file name. */
  6086. #endif /* def NAML$C_MAXRSS */
  6087.     FAB_OR_NAML( my_fab, s_nam).FAB_OR_NAML_FNA = s;
  6088.     FAB_OR_NAML( my_fab, s_nam).FAB_OR_NAML_FNS = strlen( s);
  6089.  
  6090. /* PARSE the filename in question */
  6091.     status = sys$parse(&my_fab,0,0);
  6092.     if (!(status & 1)) {                  /* any $PARSE errors are fatal */
  6093.         return (status);
  6094.     }
  6095.  
  6096.    if (dd_nam.NAMX_B_NODE == 0) {    /* default dir is not via DECnet */
  6097.     if (dd_nam.NAMX_T_DVI[0] != s_nam.NAMX_T_DVI[0])
  6098.         return (1);        /* disk name sizes do not match*/
  6099.     if (strncmp( &dd_nam.NAMX_T_DVI[1], &s_nam.NAMX_T_DVI[1],
  6100.             dd_nam.NAMX_T_DVI[0] ))
  6101.         return (1);        /* disk names do not match */
  6102.  
  6103. /*    At this point it is known that the current default directory is
  6104.     a local directory and that the device portion of the default
  6105.     directory and that of the filename passed to us are identical.
  6106.     Now compare the major and minor number of the DID (but not the RVN,
  6107.     we do not care if the result is on another disk of a bound volumset)
  6108.     of the two parse results.  If they are the same, the filename passed
  6109.     to us is definitely a reference to the default directory.
  6110.  */
  6111.     if ( (dd_nam.NAMX_W_DID_NUM == s_nam.NAMX_W_DID_NUM) &&
  6112.          (dd_nam.NAMX_W_DID_SEQ == s_nam.NAMX_W_DID_SEQ) )
  6113.          return (0);        /* in the same dir */
  6114.     return (1);            /* not the same dir */
  6115.    }
  6116.  
  6117. /*
  6118.    The default file spec contains a DECnet node reference.  SYS$PARSE does
  6119.    not return as much data when done across DECnet, mainly because the parse
  6120.    is still executed on the local node, not the remote node.  The result of
  6121.    the parse will still expand the string as much as possible however
  6122.    (.e.g., if one does a SET DEFAULT to NODE::DEV:[DIR] then a result of the
  6123.     parse of FILENAME.EXT will return NODE::DEV:[DIR]FILENAME.EXT).  Because
  6124.    of this, we simply compare the two resultant strings from the two SYS$PARSE
  6125.    operations in order to check the path of a file that contains a node name.
  6126.    This still has the benefit of no longer requiring that a full path name
  6127.    be passed to this routine.
  6128.  */
  6129.    dd_len =                /* only want node::dev:[dir] */
  6130.        dd_nam.NAMX_L_NAME - dd_nam.NAMX_L_NODE;
  6131.    dd_expanded_name[ dd_len ] = '\0';    /* terminate after the ] */
  6132.    s_expanded_name[ s_nam.NAMX_L_NAME - s_nam.NAMX_L_NODE ] = '\0';
  6133.    return (strncmp (dd_expanded_name, s_expanded_name, dd_len) );
  6134. #endif /* def COMMENT [else] */
  6135. }
  6136.  
  6137. #ifdef OLD_VMS
  6138. #ifndef VMS_V46    /* rename() included in VAXCRTL as of VMS v4.6*/
  6139.  
  6140. static VOID
  6141. descname(desc,name) struct dsc$descriptor_s *desc; char *name; {
  6142.     desc->dsc$w_length = strlen(name);    /* Length of name */
  6143.     desc->dsc$a_pointer = name;        /* Address */
  6144.     desc->dsc$b_class = DSC$K_CLASS_S;    /* String descriptor class */
  6145.     desc->dsc$b_dtype = DSC$K_DTYPE_T;    /* ASCII string data type */
  6146. }
  6147.  
  6148. /* VMS version of RENAME */
  6149. int /* ? */
  6150. rename(oldname, newname) char oldname[], newname[]; {
  6151.     struct dsc$descriptor_s old_desc, new_desc;
  6152.     int lib$rename_file();
  6153.  
  6154.     /* Build string descriptors */
  6155.  
  6156.     descname(&old_desc, oldname);
  6157.     descname(&new_desc, newname);
  6158.  
  6159.     /* Call lib$rename_file routine */
  6160.  
  6161.     return(lib$rename_file(&old_desc, &new_desc, 0,0,0,0,0,0,0,0,0,0));
  6162. }
  6163. #endif /* !VMS_46 */
  6164. #endif /* OLD_VMS */
  6165.  
  6166. /*
  6167.  * Check to see if we have spawn priv's.
  6168.  */
  6169. int
  6170. check_spawn() {
  6171.     struct itmlstdef {
  6172.     short int buflen;
  6173.     short int itmcod;
  6174.     char *bufaddr;
  6175.     long int *retlen;
  6176.     };
  6177.  
  6178.     struct itmlstdef itmlst[] =
  6179.     {4,JPI$_UAF_FLAGS,0,0,0,0,0,0};
  6180.  
  6181.     long uaf_flags_size;
  6182.     unsigned long uaf_flags;
  6183.  
  6184.     itmlst[0].bufaddr = (char *)&uaf_flags;
  6185.     itmlst[0].retlen = &uaf_flags_size;
  6186.  
  6187.  
  6188.     vms_status = sys$getjpiw(0, 0, 0, &itmlst, 0, 0, 0);
  6189.     if (!(vms_status & 1)) vms_lasterr = vms_status;
  6190.     if ((vms_status) != SS$_NORMAL)
  6191.       return(-1);                /* Assume the worst... */
  6192.  
  6193. #ifdef UAI$M_CAPTIVE
  6194.     if (uaf_flags & UAI$M_CAPTIVE) {
  6195.     printf(
  6196. "\nThis command cannot be executed. Your account is CAPTIVE.\n\n");
  6197.     return(-1);
  6198.     }
  6199. #endif  /* UAI$M_CAPTIVE */
  6200. #ifdef    UAI$M_RESTRICTED            /* for pre-V5.2 systems */
  6201.     if (uaf_flags & UAI$M_RESTRICTED) {
  6202.     printf(
  6203. "\nThis command cannot be executed. Your account is CAPTIVE.\n\n");
  6204.     return(-1);
  6205.     }
  6206. #endif    /* uai$v_restricted */
  6207.     return(0);
  6208. }
  6209.  
  6210. /*
  6211.  * Stuff having to do with SET FILE TYPE LABELED
  6212.  */
  6213. char *
  6214. get_vms_vers() {
  6215.     static char sysver[9];
  6216.     int len;
  6217.     struct itmlst {
  6218.           short int buflen;
  6219.           short int code;
  6220.           char *bufadr;
  6221.           int *retlen;
  6222.           } vms_sysver[2];
  6223.  
  6224.     vms_sysver[0].buflen = 8;
  6225.     vms_sysver[0].code = SYI$_VERSION;
  6226.     vms_sysver[0].bufadr = (char *)&sysver;
  6227.     vms_sysver[0].retlen = &len;
  6228.     vms_sysver[1].buflen = 0;
  6229.     vms_sysver[1].code = 0;
  6230.     sys$getsyiw(0,0,0,&vms_sysver,0,0,0);
  6231.     sysver[8]='\0';
  6232.     len = 7;
  6233.     while (sysver[len] == ' ') {
  6234.     sysver[len] = '\0';
  6235.     len--;
  6236.     }
  6237.     return(sysver);
  6238. }
  6239.  
  6240. /* Find where a relative file specification starts in the expanded file
  6241.  * name.  Returns the number of characters preceeding the relative portion
  6242.  */
  6243.  
  6244. int
  6245. fnd_rel(name) char *name; {
  6246.  
  6247.     int ix=0;
  6248.     char relnam[ NAMX_C_MAXRSS];
  6249.     char *ip;
  6250.  
  6251.     nzltor(name, relnam, 0, PATH_REL, NAMX_C_MAXRSS);
  6252.  
  6253.     debug(F111, " fnd_rel: absolute name and length", name, strlen(name));
  6254.     debug(F111, " fnd_rel: relative name and length", relnam, strlen(relnam));
  6255.  
  6256.     if ( (*relnam == '[') || (*relnam == '<') ) {
  6257.         ip = strstr(name, &relnam[1]);
  6258.         if (ip) ix = ip - name;
  6259.     } else {                       /* no common path; send as PATH OFF */
  6260.         ip = strstr(name, relnam);
  6261.         if (ip) ix = ip - name -1;  /* do_label_rcv will use the bracket */
  6262.     }
  6263.     return(ix);
  6264. }
  6265.  
  6266. int
  6267. do_label_send(name) char *name; {
  6268.     int pad_size;
  6269.     int rel_dspec;
  6270.     extern int fnspath;
  6271.     char * zp;                /* To shut up compilers whining */
  6272.                     /* about signed vs unsigned chars */
  6273.     zp = (char *)zinptr;
  6274.     zp += sprintf(zp,"KERMIT LABELED FILE:02D704VERS");
  6275.     zp += sprintf(zp,"%08d%s", strlen(get_vms_vers()), get_vms_vers());
  6276.     zp += sprintf(zp,"05KVERS00000008%08ld", vernum);
  6277.     if (fnspath == PATH_REL) {
  6278.         rel_dspec = fnd_rel(name);
  6279.         debug(F101," do_label_send: rel dir at char","", rel_dspec);
  6280.         zp += sprintf(zp,"07REL_DIR00000008%08ld", rel_dspec);
  6281.     }
  6282.     zp += sprintf(zp,"07VMSNAME%08d", strlen(name));
  6283.     zp += sprintf(zp,"%s", name);
  6284.     zp += sprintf(zp,"07VMSFILE%08d", 70);
  6285.     memmove(zp, &xabpro_ifile.xab$w_pro, 2);
  6286.     zp += 2;
  6287.     memmove(zp, &xabpro_ifile.xab$l_uic, 4);
  6288.     zp += 4;
  6289.     memmove(zp, &fab_ifile.fab$b_rfm, 1);
  6290.     zp += 1;
  6291.     memmove(zp, &fab_ifile.fab$b_org, 1);
  6292.     zp += 1;
  6293.     memmove(zp, &fab_ifile.fab$b_rat, 1);
  6294.     zp += 1;
  6295.     memmove(zp, &xuchar, 4);    /* Dummy for file chars. */
  6296.     zp += 4;
  6297.     memmove(zp, &fab_ifile.fab$b_fsz, 1);
  6298.     zp += 1;
  6299.     memmove(zp, &xabfhc_ifile.xab$w_lrl, 2);
  6300.     zp += 2;
  6301.     memmove(zp, &fab_ifile.fab$w_mrs, 2);
  6302.     zp += 2;
  6303.     memmove(zp, &xabfhc_ifile.xab$l_ebk, 4);
  6304.     zp += 4;
  6305.     memmove(zp, &xabfhc_ifile.xab$w_ffb, 2);
  6306.     zp += 2;
  6307.     memmove(zp, &xabfhc_ifile.xab$l_hbk, 4);
  6308.     zp += 4;
  6309.     memmove(zp, &fab_ifile.fab$w_deq, 2);
  6310.     zp += 2;
  6311.     memmove(zp, &fab_ifile.fab$b_bks, 1);
  6312.     zp += 1;
  6313.     memmove(zp, &fab_ifile.fab$w_gbc, 2);
  6314.     zp += 2;
  6315.     memmove(zp, &xabfhc_ifile.xab$w_verlimit, 2);
  6316.     zp += 2;
  6317.     memmove(zp, &fab_ifile.fab$b_rfm+1, 1);    /* This is fab$b_journal */
  6318.     zp += 1;
  6319.     memmove(zp, &xabdat_ifile.xab$q_cdt, 8);
  6320.     zp += 8;
  6321.     memmove(zp, &xabdat_ifile.xab$q_rdt, 8);
  6322.     zp += 8;
  6323.     memmove(zp, &xabdat_ifile.xab$w_rvn, 2);
  6324.     zp += 2;
  6325.     memmove(zp, &xabdat_ifile.xab$q_edt, 8);
  6326.     zp += 8;
  6327.     memmove(zp, &xabdat_ifile.xab$q_bdt, 8);
  6328.     zp += 8;
  6329.     if (xabpro_ifile.xab$w_acllen != 0) {
  6330.         debug(F101, "do_label_send: acllen", "", xabpro_ifile.xab$w_acllen);
  6331.     zp += sprintf(zp,"06VMSACL%08d", xabpro_ifile.xab$w_acllen);
  6332.     memmove(zp, &aclbuf, xabpro_ifile.xab$w_acllen);
  6333.     zp += xabpro_ifile.xab$w_acllen;
  6334.     }
  6335.     zp += sprintf(zp,"04DATA00000000");
  6336.     zincnt = (zp - (char *)zinbuffer);    /* How big */
  6337.     zinptr = zinbuffer;            /* Reset pointer for readout */
  6338.     return(1);
  6339. }
  6340.  
  6341. /*
  6342.   D O _ L A B E L _ R E C V
  6343.  
  6344.   Note that we don't honor SET FILE COLLISION APPEND for labeled receives --
  6345.   the whole point of labeled receives is to generate an exact copy of the
  6346.   source file, attributes and all.
  6347. */
  6348. #define CK_LBLBUFLEN 16
  6349. #define CK_VMSFILELEN 70
  6350.  
  6351. int
  6352. do_label_recv() {
  6353.  
  6354.     extern int fnrpath;            /* (look at this later...) */
  6355.  
  6356.     char *recv_ptr;
  6357.     char buffer[CK_LBLBUFLEN+1];
  6358.     char vmsfile[CK_VMSFILELEN];
  6359.     char *filptr = vmsfile;
  6360.     int lblen, alen;
  6361.     int gotname = 0, gotfile = 0, gotacl = 0, gotrel = 0;
  6362.     char *i, *j;
  6363.     unsigned short jnlflg;
  6364.  
  6365.     debug(F101,"do_label_recv: options","",ofile_lblopts);
  6366.     ofile_lblproc = 1;            /* Don't come here again */
  6367.  
  6368.     if (strncmp((char *)zoutbuffer,"KERMIT LABELED FILE:02D704VERS",30) != 0)
  6369.       return(0);            /* Just continue if unlabeled */
  6370.  
  6371.     recv_ptr = (char *)zoutbuffer+30;    /* start at front of buffer */
  6372.  
  6373.     memcpy(buffer, recv_ptr, 8);
  6374.     recv_ptr += 8;
  6375.     buffer[8] = '\0';
  6376.     lblen = atoi(buffer);
  6377.     if (lblen > CK_LBLBUFLEN) {
  6378.     debug(F101,"do_label_recv: lblen too long 1","",lblen);
  6379.     return(-1);
  6380.     }
  6381.     memcpy(buffer, recv_ptr, lblen);
  6382.     recv_ptr += lblen;
  6383.     buffer[lblen] = '\0';
  6384.     debug(F110,"do_label_recv: file created under {Open}VMS: ",buffer,0);
  6385.  
  6386.     memcpy(buffer, recv_ptr, 7);
  6387.     recv_ptr += 7;
  6388.     if (strncmp(buffer, "05KVERS", 7) != 0) {
  6389.     debug(F100,"do_label_recv: lost sync at KVERS","",0);
  6390.     return(-1);
  6391.     }
  6392.     memcpy(buffer, recv_ptr, 8);
  6393.     recv_ptr += 8;
  6394.     buffer[8] = '\0';
  6395.     lblen = atoi(buffer);
  6396.     if (lblen > CK_LBLBUFLEN) {
  6397.     debug(F101,"do_label_recv: lblen too long 2","",lblen);
  6398.     return(-1);
  6399.     }
  6400.     memcpy(buffer, recv_ptr, lblen);
  6401.     recv_ptr += lblen;
  6402.     buffer[lblen] = '\0';
  6403.     debug(F110,"do_label_recv: file created with C-Kermit/VMS: ",buffer,0);
  6404.  
  6405.   next_label:
  6406.     memcpy(buffer, recv_ptr, 2);
  6407.     recv_ptr += 2;
  6408.     buffer[2] = '\0';
  6409.     lblen = atoi(buffer);
  6410.     if (lblen == 0) {
  6411.     debug(F100,"do_label_recv: lost sync at next_label: ","",0);
  6412.     return(-1);
  6413.     } else if (lblen > CK_LBLBUFLEN) {
  6414.     debug(F101,"do_label_recv: lblen too long 3","",lblen);
  6415.     return(-1);
  6416.     }
  6417.     memcpy(buffer, recv_ptr, lblen);
  6418.     recv_ptr += lblen;
  6419.     buffer[lblen] = '\0';
  6420.     debug(F110,"do_label_recv: found tag: ",buffer,0);
  6421.     if (strcmp(buffer, "VMSNAME") == 0) {
  6422.     memcpy(buffer, recv_ptr, 8);
  6423.         recv_ptr += 8;
  6424.     buffer[8] = '\0';
  6425.     lblen = atoi(buffer);
  6426.     if (lblen > CKMAXPATH) {    /* fdc 23 Jun 96 */
  6427.         debug(F101,"do_label_recv: lblen too long 4","",lblen);
  6428.         return(-1);
  6429.     }
  6430.     memcpy(ofile_vmsname, recv_ptr, lblen);
  6431.         recv_ptr += lblen;
  6432.     ofile_vmsname[lblen] = '\0';
  6433.     gotname++;
  6434.     debug(F110,"do_label_recv: loaded file name block as: ",
  6435.           ofile_vmsname,
  6436.           0
  6437.           );
  6438.     debug(F110,"do_label_recv: ofile_vmsname 2",ofile_vmsname,0);
  6439.         if ((ofile_lblopts & LBL_PTH) == 0) {
  6440.             if ( (fnrpath == PATH_REL) && (gotrel > 0) ) {
  6441.                 i = strrchr(ofile_vmsname, '[');
  6442.                 if (i != NULL) {
  6443.                     ofile_vmsname[0] = '[';
  6444.                 } else {
  6445.                     ofile_vmsname[0] = '<';
  6446.                 }
  6447.                 ckstrncpy(&ofile_vmsname[1],
  6448.               &ofile_vmsname[gotrel],
  6449.               CKMAXPATH
  6450.               );
  6451.             } else {
  6452.                 i = strstr(ofile_vmsname, "::");
  6453.         if (i != NULL) {
  6454.             i += 2;
  6455.             memmove(ofile_vmsname, i, strlen(ofile_vmsname));
  6456.                 }
  6457.             i = strrchr(ofile_vmsname, ':');
  6458.             j = strrchr(ofile_vmsname, ']');
  6459.             if (j == NULL)
  6460.         j = strrchr(ofile_vmsname, '>');
  6461.             if (j > i)
  6462.           i = j;
  6463.             if (i) {            /* fdc 6-12-96 */
  6464.             i++;
  6465.             memmove(ofile_vmsname, i, strlen(ofile_vmsname));
  6466.             }
  6467.             }
  6468.         } else {
  6469.             i = strstr(ofile_vmsname, "::");
  6470.         if (i != NULL) {
  6471.             i += 2;
  6472.             memmove(ofile_vmsname, i, strlen(ofile_vmsname));
  6473.         }
  6474.     }
  6475.     debug(F110,"do_label_recv: ofile_vmsname 3",ofile_vmsname,0);
  6476.     if (strchr(ofile_vmsname, ';') != NULL) {
  6477.         for (alen = strlen(ofile_vmsname);
  6478.          ofile_vmsname[alen] != ';' && alen > 0;
  6479.          alen--)
  6480.           ;
  6481.         ofile_vmsname[alen] = '\0';
  6482.     }
  6483.     debug(F110,"do_label_recv: resultant filespec: ",ofile_vmsname,0);
  6484.     goto next_label;
  6485.     } else if (strcmp(buffer, "REL_DIR") == 0) {
  6486.     memcpy(buffer, recv_ptr, 8);
  6487.     recv_ptr += 8;
  6488.     buffer[8] = '\0';
  6489.     lblen = atoi(buffer);
  6490.     if (lblen > CK_LBLBUFLEN) {
  6491.         debug(F101,"do_label_recv: lblen too long 5","",lblen);
  6492.         return(-1);
  6493.     }
  6494.         memcpy(buffer, recv_ptr, lblen);
  6495.         recv_ptr += lblen;
  6496.         buffer[lblen] = '\0';
  6497.         gotrel = atoi(buffer);
  6498.     if ( (gotrel < 3) || (gotrel > NAMX_C_MAXRSS) ) {
  6499.         debug(F101,
  6500.           "do_label_recv: rel dir head position wrong",
  6501.           "",
  6502.           gotrel
  6503.           );
  6504.         return(-1);
  6505.     }
  6506.     debug(F101,"do_label_recv: relative directory position","", gotrel);
  6507.     goto next_label;
  6508.     } else if (strcmp(buffer, "VMSFILE") == 0) {
  6509.     memcpy(buffer, recv_ptr, 8);
  6510.     recv_ptr += 8;
  6511.     buffer[8] = '\0';
  6512.     lblen = atoi(buffer);
  6513.     if (lblen > CK_VMSFILELEN) {
  6514.         debug(F101,"do_label_recv: lblen too long 5","",lblen);
  6515.         return(-1);
  6516.     }
  6517.     memcpy(vmsfile, recv_ptr, lblen);
  6518.     recv_ptr += lblen;
  6519.     vmsfile[lblen] = '\0';
  6520.     gotfile++;
  6521.     debug(F100,"do_label_recv: loaded file attribute block","",0);
  6522.     goto next_label;
  6523.     } else if (strcmp(buffer, "VMSACL") == 0) {
  6524.     memcpy(buffer, recv_ptr, 8);
  6525.     recv_ptr += 8;
  6526.     buffer[8] = '\0';
  6527.     ofile_acllen = atoi(buffer);
  6528.     if (ofile_acllen > sizeof(ofile_vmsacl) ) {
  6529.         debug(F101,"do_label_recv: ofile_acllen too long","",ofile_acllen);
  6530.         return(-1);
  6531.     }
  6532.     memcpy(ofile_vmsacl, recv_ptr, ofile_acllen);
  6533.     recv_ptr += ofile_acllen;
  6534. /*    ofile_vmsacl[ofile_acllen] = '\0'; */    /* ACL buffer is binary */
  6535.     gotacl++;
  6536.     debug(F100,"do_label_recv: loaded file ACL block","",0);
  6537.     goto next_label;
  6538.     } else if (strcmp(buffer, "DATA") == 0) {
  6539.     memcpy(buffer, recv_ptr, 8);
  6540.     recv_ptr += 8;
  6541.     buffer[8] = '\0';
  6542.     lblen = atoi(buffer);
  6543.     if (lblen != 0) {
  6544.         debug(F101,"do_label_recv: length of DATA tag not zero","",lblen);
  6545.         return(-1);
  6546.     }
  6547.     debug(F100,"do_label_recv: positioned at start of file data","",0);
  6548.     goto all_set;
  6549.     } else {
  6550.     debug(F110,"do_label_recv: unrecognized label: ",buffer,0);
  6551.     memcpy(buffer, recv_ptr, 8);
  6552.     recv_ptr += 8;
  6553.     buffer[8] = '\0';
  6554.     lblen = atoi(buffer);
  6555.     recv_ptr += lblen;
  6556.     goto next_label;
  6557.     }
  6558.   all_set:
  6559.     if (gotfile != 1 || gotname != 1) {
  6560.     debug(F100,"do_label_recv: missing one or more required labels","",0);
  6561.     return(-1);
  6562.     }
  6563.  
  6564. /* Prep the characteristics */
  6565.  
  6566.     if ((ofile_lblopts & LBL_NAM) != 0) {
  6567.     /* Install the path name in the FAB or NAML. */
  6568. #ifdef NAML$C_MAXRSS
  6569.     fab_ofile.fab$l_dna = (char *) -1;  /* Using NAML for default name. */
  6570.     fab_ofile.fab$l_fna = (char *) -1;  /* Using NAML for file name. */
  6571. #endif /* def NAML$C_MAXRSS */
  6572.     FAB_OR_NAML( fab_ofile, nam_ofile).FAB_OR_NAML_FNA = ofile_vmsname;
  6573.     FAB_OR_NAML( fab_ofile, nam_ofile).FAB_OR_NAML_FNS =
  6574.      strlen( ofile_vmsname);
  6575.     }
  6576.     fab_ofile.fab$b_fac = FAB$M_BIO | FAB$M_PUT;
  6577.     fab_ofile.fab$l_fop = FAB$M_MXV;
  6578.     fab_ofile.fab$l_xab = (char *)&xabdat_ofile;
  6579.     rab_ofile = cc$rms_rab;
  6580.     rab_ofile.rab$l_fab = &fab_ofile;
  6581.     xabdat_ofile = cc$rms_xabdat;
  6582.     xabdat_ofile.xab$l_nxt = (char *)&xabrdt_ofile;
  6583.     xabrdt_ofile = cc$rms_xabrdt;
  6584.     xabrdt_ofile.xab$l_nxt = (char *)&xabfhc_ofile;
  6585.     xabfhc_ofile = cc$rms_xabfhc;
  6586.     xabfhc_ofile.xab$l_nxt = (char *)&xabpro_ofile;
  6587.     xabpro_ofile = cc$rms_xabpro;
  6588.     xabpro_ofile.xab$l_nxt = (char *)&xaball_ofile;
  6589.     xaball_ofile = cc$rms_xaball;
  6590.  
  6591. /* Load 'em up */
  6592.  
  6593.     memmove(&xabpro_ofile.xab$w_pro, filptr, 2);
  6594.     filptr += 2;
  6595.     if ((ofile_lblopts & LBL_OWN) != 0)
  6596.       memmove(&xabpro_ofile.xab$l_uic, filptr, 4);
  6597.     filptr += 4;
  6598.     memmove(&fab_ofile.fab$b_rfm, filptr, 1);
  6599.     filptr += 1;
  6600.     memmove(&fab_ofile.fab$b_org, filptr, 1);
  6601.     filptr += 1;
  6602.     memmove(&fab_ofile.fab$b_rat, filptr, 1);
  6603.     filptr += 1;
  6604.     filptr += 4;            /* reserved */
  6605.     memmove(&fab_ofile.fab$b_fsz, filptr, 1);
  6606.     filptr += 1;
  6607.     memmove(&xabfhc_ofile.xab$w_lrl, filptr, 2);
  6608.     filptr += 2;
  6609.     memmove(&fab_ofile.fab$w_mrs, filptr, 2);
  6610.     filptr += 2;
  6611.     memmove(&xabfhc_ofile.xab$l_ebk, filptr, 4);
  6612.     filptr += 4;
  6613. /* preserve this as RMS won't remember it for us */
  6614.     memmove(&ofile_ffb, filptr, 2);
  6615.     filptr += 2;
  6616.     memmove(&xaball_ofile.xab$l_alq, filptr, 4);
  6617.     filptr += 4;
  6618.     memmove(&xaball_ofile.xab$w_deq, filptr, 2);
  6619.     filptr += 2;
  6620.  
  6621. #ifdef BUGFILL7
  6622. /*
  6623.   When DEC C first came out for the VAX, the xab$b_bkz definition was missing
  6624.   and they used xaballdef$$_fill_7 instead.  But that was a long time ago.
  6625.   (This change made for C-Kermit 6.0, 19 Sep 96.)
  6626. */
  6627. #ifdef COMMENT
  6628.     memmove((char *)&xaball_ofile.xaballdef$$_fill_7, (char *)filptr, 1);
  6629. #else
  6630.     {
  6631.     char * s1, * s2;
  6632.     s1 = (char *)&xaball_ofile.xaballdef$$_fill_7;
  6633.     s2 = (char *)filptr;
  6634.     *s1 = *s2;
  6635.     }
  6636. #endif /* COMMENT */
  6637. #else
  6638.     memmove(&xaball_ofile.xab$b_bkz, filptr, 1);
  6639. #endif /* BUGFILL7 */
  6640.  
  6641.     filptr += 1;
  6642.     memmove(&fab_ofile.fab$w_gbc, filptr, 2);
  6643.     filptr += 2;
  6644.     memmove(&xabfhc_ofile.xab$w_verlimit, filptr, 2);
  6645.     filptr += 2;
  6646.     memmove(&jnlflg, filptr, 1);
  6647.     if (jnlflg !=0)
  6648.       debug(F100,"do_label_recv: journaling status removed for file","",0);
  6649.     filptr += 1;
  6650.     memmove(&xabdat_ofile.xab$q_cdt, filptr, 8);
  6651.     filptr += 8;
  6652.     memmove(&revdat, filptr, 8);
  6653.     filptr += 8;
  6654.     memmove(&revnum, filptr, 2);
  6655.     filptr += 2;
  6656.     memmove(&xabdat_ofile.xab$q_edt, filptr, 8);
  6657.     filptr += 8;
  6658.     if ((ofile_lblopts & LBL_BCK) != 0)
  6659.     memmove(&xabdat_ofile.xab$q_bdt, filptr, 8);
  6660.     filptr += 8;
  6661.  
  6662. /* ACL's? */
  6663.  
  6664.     if ((ofile_lblopts & LBL_ACL) != 0 && gotacl != 0) {
  6665.     xabpro_ofile.xab$l_aclbuf = (char *)&ofile_vmsacl;
  6666.     xabpro_ofile.xab$w_aclsiz = ofile_acllen;
  6667.     }
  6668.  
  6669. /* Try to create the file */
  6670.  
  6671.     rms_sts = sys$create(&fab_ofile);
  6672.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  6673.     if (!(rms_sts & 1)) {
  6674.     debug(F101,"do_label_recv: $create failed, status","",rms_sts);
  6675.     return(-1);
  6676.     }
  6677.     if ((ofile_lblopts & LBL_ACL) != 0 && gotacl != 0) {
  6678.     if (!(xabpro_ofile.xab$l_aclsts & 1)) {
  6679.         debug(F101,"do_label_recv: ACL chain failed, status",
  6680.           "",
  6681.           xabpro_ofile.xab$l_aclsts
  6682.           );
  6683.         return(-1);
  6684.     }
  6685.     }
  6686.     rms_sts = sys$connect(&rab_ofile);
  6687.     if (!(rms_sts & 1)) vms_lasterr = rms_sts;
  6688.     if (!(rms_sts & 1)) {
  6689.     debug(F101,"do_label_recv: $connect failed, status","",rms_sts);
  6690.     return(-1);
  6691.     }
  6692. /*
  6693.   Slide the remainder of the data to the head of the buffer and adjust the
  6694.   counter and pointer. This will cause the buffer to be re-filled to the full
  6695.   32Kb capacity, which is necessary for proper operation of zoutdump().
  6696. */
  6697.     zoutcnt -= ((char *)recv_ptr - (char *)zoutbuffer);
  6698.     debug(F101,"do_label_recv: zoutcnt","",zoutcnt);
  6699.     memcpy(zoutbuffer, recv_ptr, zoutcnt);
  6700.     zoutptr = zoutbuffer + zoutcnt;
  6701.     return(1);                /* Go fill some more */
  6702. }
  6703.  
  6704. static char xxvmsmsg[PMSG_MSG_SIZE];
  6705.  
  6706. char *
  6707. ckvmserrstr(x) unsigned long x; {
  6708.     long int n = 0;
  6709.     struct dsc$descriptor_s b = {
  6710.     PMSG_BUF_SIZE - 1,
  6711.     DSC$K_DTYPE_T,
  6712.     DSC$K_CLASS_S,
  6713.     NULL
  6714.     };
  6715.     if (x < 1) x = vms_lasterr;
  6716.     b.dsc$a_pointer = (char *)&xxvmsmsg;
  6717.     if (!((vms_status = sys$getmsg(x, &n, &b, 0, 0)) & 1))
  6718.       return("%CKERMIT-W-UNKERR, Unknown error");
  6719.     xxvmsmsg[n] = '\0';
  6720.     return((char *)xxvmsmsg);
  6721. }
  6722.  
  6723. /* End of CKVFIO.C */
  6724.  
  6725.  
  6726. /* DEAD CODE follows... */
  6727.  
  6728. #ifdef CK_TMPDIR
  6729. #ifdef COMMENT /* FDC */        /* Frank's version */
  6730. int
  6731. isdir(s) char *s; {
  6732.     int x;
  6733.     int i, s_len;
  6734.     char *full_name = NULL;
  6735.     char *p = NULL;
  6736.  
  6737.     static char dot_dir[] = ".dir";
  6738.     static char zero_dir[] = "[000000]";
  6739.  
  6740.     char name_buf[255];            /* Was 512 but that's too big */
  6741.     char tmpbuf[255];            /* for unsigned char... */
  6742.  
  6743.     struct FAB fab;
  6744.     struct NAM nam;
  6745.  
  6746.     struct dsc$descriptor_s indesc;
  6747.     $DESCRIPTOR(lnmtable, "LNM$FILE_DEV");
  6748.     int new_len;
  6749.     int serial_num;
  6750.     struct {
  6751.     short length;
  6752.     short code;
  6753.     char *address;
  6754.     int *len;
  6755.     int term;
  6756.     } itemlist;
  6757.  
  6758.     if (!s) return(0);
  6759.     if (!*s) return(0);
  6760.  
  6761.     /* Determine if this is something we can SET DEFAULT to...  */
  6762.  
  6763.     s_len = strlen(s);
  6764.     debug(F111,"isdir",s,s_len);
  6765.  
  6766.     /* Does it look like a directory name? */
  6767.  
  6768.     if (s[s_len-1] != ':' && s[s_len-1] != ']' && s[s_len-1] != '>') {
  6769. #ifdef COMMENT
  6770. /*
  6771.   Bad idea.  No, the user really has to include the colon, otherwise the
  6772.   intention is ambiguous.
  6773. */
  6774.     p = tmpbuf;            /* No, maybe it's a logical name */
  6775.     ckstrncpy(tmpbuf,getenv(s),255);
  6776.     if (*p) {
  6777.         s = p;
  6778.         s_len = strlen(s);
  6779.         if (s < 1)            /* No definition */
  6780.           return(0);
  6781.  
  6782.         /* It is a logical name, but does it look like a dir name? */
  6783.         if (s[s_len-1] != ':' && s[s_len-1] != ']' && s[s_len-1] != '>')
  6784.           return(0);        /* No, it doesn't */
  6785.     }
  6786. #else /* def COMMENT */
  6787.  
  6788. /*  Check for "DEV:[FOO]BLAH.DIR;1"... */
  6789.  
  6790.     if (zchki(s) == -2) {        /* It's a directory */
  6791.         int i;
  6792.         char * p = NULL;        /* Pointer to period */
  6793.         debug(F111,"isdir zchki",s,-2);
  6794.         /* Note: This does not handle "FOO.DIR.1"... */
  6795.         for (i = s_len; i > 0; i--) {
  6796.         if (s[i] == '.')
  6797.           p = s+i;
  6798.         else if (s[i] == ']' || s[i] == '>')
  6799.           break;
  6800.         }
  6801.         debug(F110,"isdir p",p,0);
  6802.         if (p) {
  6803.         if ((*(p+1) == 'D' || *(p+1) == 'd') &&
  6804.             (*(p+2) == 'I' || *(p+2) == 'i') &&
  6805.             (*(p+3) == 'R' || *(p+3) == 'r') &&
  6806.             (*(p+4) == ';' || *(p+4) == NUL || *(p+4) == SP))
  6807.           return(2);
  6808.         }
  6809.     }
  6810.     return(0);
  6811. #endif /* def COMMENT [else] */
  6812.     }
  6813.     /* Check that the directory part is valid... */
  6814.  
  6815.     if (s[s_len-1] == ']' || s[s_len-1] == '>') {
  6816.         fab = cc$rms_fab;
  6817.         nam = cc$rms_nam;
  6818.  
  6819.         fab.fab$l_dna = 0;
  6820.         fab.fab$b_dns = 0;
  6821.  
  6822.         fab.fab$l_fna = s;
  6823.         fab.fab$b_fns = s_len;
  6824.  
  6825.         fab.fab$l_fop = 0;
  6826.         fab.fab$w_ifi = 0;
  6827.         fab.fab$l_nam = &nam;
  6828.  
  6829.         nam.nam$l_esa = name_buf;
  6830.         nam.nam$b_ess = sizeof(name_buf);
  6831.         nam.nam$b_nop = 0;
  6832.         nam.nam$l_rlf = 0;
  6833.         nam.nam$l_rsa = 0;
  6834.         nam.nam$b_rsl = 0;
  6835.         nam.nam$l_fnb = 0;
  6836.  
  6837.         i = sys$parse(&fab, 0, 0);
  6838.     if (!(i & 1)) vms_lasterr = i;
  6839. #ifdef COMMENT
  6840.     printf("parse returned %d 0x%x, nam fnb is %d 0x%x\n",
  6841.            i, i, nam.nam$l_fnb, nam.nam$l_fnb);
  6842. #endif /* def COMMENT */
  6843.         if ((i & 1) == 0) return(0);
  6844.     }
  6845.  
  6846.     /* Check that the logical name is valid */
  6847.  
  6848.     i = s_len - 1;
  6849.     while (i >= 0 && s[i] != ':') i--;
  6850.  
  6851.     if (i >= 0 && s[i] == ':') {
  6852.         if (i == 0) return(0);        /* Single colon (:) */
  6853.         if (s[i-1] == ':') {
  6854.             if (i > 1) return(1);    /* DECnet node name (blah::) */
  6855.             else return(0);        /* or :: alone. */
  6856.         }
  6857.     s_len = i;
  6858.     full_name = malloc(s_len + 1);
  6859.     if (!full_name) return(0);
  6860.     /* Logicals must be upper case */
  6861.     for (i = 0; i < s_len; i++) {
  6862.         full_name[i] = s[i];
  6863.         if (full_name[i] >= 'a' && full_name[i] <= 'z')
  6864.           full_name[i] -= ('a' - 'A');
  6865.     }
  6866.     indesc.dsc$w_length = s_len;
  6867.     indesc.dsc$a_pointer = full_name;
  6868.     indesc.dsc$b_class = DSC$K_CLASS_S;
  6869.     indesc.dsc$b_dtype = DSC$K_DTYPE_T;
  6870.  
  6871.     itemlist.length = new_len = sizeof(name_buf);
  6872.     itemlist.code = LNM$_STRING;
  6873.     itemlist.address = name_buf;
  6874.     itemlist.len = &new_len;
  6875.     itemlist.term = 0;
  6876.  
  6877.     i = sys$trnlnm(0, &lnmtable, &indesc, 0, &itemlist);
  6878.     if (!(i & 1)) vms_lasterr = i;
  6879.     if (i != SS$_NORMAL || new_len < 0) new_len = 0;
  6880.     if (new_len >= sizeof(name_buf)) new_len = sizeof(name_buf) - 1;
  6881.     name_buf[new_len] = '\0';
  6882.  
  6883. #ifdef COMMENT
  6884.     printf("trnlnm result %d 0x%x, '%.*s'\n", i, i, new_len, name_buf);
  6885. #endif /* def COMMENT */
  6886.  
  6887.     if (new_len == 0) {
  6888.         /* Could still be a device name. */
  6889.         /* Only disks have serial numbers... */
  6890.         serial_num = 0;
  6891.         itemlist.length = new_len = sizeof(serial_num);
  6892.         itemlist.code = DVI$_SERIALNUM;
  6893.         itemlist.address = (char *) &serial_num;
  6894.         itemlist.len = &new_len;
  6895.         itemlist.term = 0;
  6896.         i = sys$getdvi(0, 0, &indesc, &itemlist, 0, 0, 0, 0);
  6897.         if (!(i & 1)) vms_lasterr = i;
  6898. #ifdef COMMENT
  6899.         printf("getdvi ret %d 0x%x, serial %d len %d\n",
  6900.            i, i, serial_num, new_len);
  6901. #endif /* def COMMENT */
  6902.         free(full_name);
  6903.         return(((i & 1) == 1 && new_len > 0) ? 1: 0);
  6904.  
  6905.     } else if (name_buf[new_len-1] == ':' ||
  6906.             name_buf[new_len-1] == ']' ||
  6907.             name_buf[new_len-1] == '>') {
  6908.         /* Check returned value */
  6909.         if (new_len > 2 &&
  6910.             (name_buf[new_len-1] == ']' || name_buf[new_len-1] == '>') &&
  6911.             name_buf[new_len-2] == '.') {
  6912.             /* Remove trailing dot in directory of logical name */
  6913.             name_buf[new_len-2] = name_buf[new_len-1];
  6914.             name_buf[new_len-1] = '\0';
  6915.         }
  6916.         free(full_name);
  6917.         return( isdir(name_buf) );
  6918.     } else {
  6919.         /* Logical name is just a random string signifying nothing */
  6920.         free(full_name);
  6921.         return(0);
  6922.     }
  6923.     }
  6924.     return(1);
  6925. }
  6926. #endif /* def COMMENT */ /* FDC */
  6927. #endif /* CK_TMPDIR */
  6928.  
  6929. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  6930.  
  6931. /* 2010-03-15 SMS.
  6932.  * Unit test main program.
  6933.  *
  6934.  * cc ckvfio.c /obj = testn /def = (UNIT_TEST)
  6935.  * cc ckvfio.c /obj = testnl /def = (UNIT_TEST, _LARGEFILE)
  6936.  * link testn  ! (Expect several %LINK-W-USEUNDEF complaints.)
  6937.  * link testnl
  6938.  *
  6939.  */
  6940.  
  6941.  
  6942. #ifdef UNIT_TEST
  6943.  
  6944. /* Globals. */
  6945.  
  6946. unsigned int vms_status;
  6947. unsigned int vms_lasterr;
  6948.  
  6949. int binary = 0;
  6950. int zchkid = 0;
  6951. int zchkod = 0;
  6952. int zincnt, zoutcnt;
  6953. CHAR *zinptr, *zoutptr;
  6954. CHAR *zinbuffer, *zoutbuffer;
  6955.  
  6956. char whoareu[ 16] = "U1";               /* UNIX. */
  6957. char *cksysid = "D7";                   /* VMS. */
  6958.  
  6959. int deblog = 1;
  6960.  
  6961. /* MAIN. */
  6962.  
  6963. int main( int argc, char **argv)
  6964. {
  6965.     int sts;
  6966.     int argi1;
  6967.     int argi2;
  6968.     int argi3;
  6969.  
  6970.     if (argc > 1)
  6971.     {
  6972.         argi1 = strtol( argv[ 1], NULL, 10);
  6973.         if (argi1 == 0)
  6974.         {
  6975.             sts = get_rms_defaults();
  6976.             printf( " sts = %d.\n", sts);
  6977.         }
  6978.         else if (argi1 == 1)
  6979.         {
  6980.             if (argc < 3)
  6981.             {
  6982.                 printf( " arg1 = %d.  Insuff args (%d < 3).\n", argi1, argc);
  6983.             }
  6984.             else
  6985.             {
  6986.                 sts = isabsolute( argv[ 2]);
  6987.                 printf( " sts = %d.\n", sts);
  6988.             }
  6989.         }
  6990.         if (argi1 == 2)
  6991.         {
  6992.             if (argc < 3)
  6993.             {
  6994.                 printf( " arg1 = %d.  Insuff args (%d < 3).\n", argi1, argc);
  6995.             }
  6996.             else
  6997.             {
  6998.                 sts = isdir( argv[ 2]);
  6999.                 printf( " sts = %d.\n", sts);
  7000.             }
  7001.         }
  7002.         if (argi1 == 3)
  7003.         {
  7004.             if (argc < 3)
  7005.             {
  7006.                 printf( " arg1 = %d.  Insuff args (%d < 3).\n", argi1, argc);
  7007.             }
  7008.             else
  7009.             {
  7010.                 sts = iswild( argv[ 2]);
  7011.                 printf( " sts = %d.\n", sts);
  7012.             }
  7013.         }
  7014.         else if (argi1 == 4)
  7015.         {
  7016.             if (argc < 4)
  7017.             {
  7018.                 printf( " arg1 = %d.  Insuff args (%d < 4).\n", argi1, argc);
  7019.             }
  7020.             else
  7021.             {
  7022.                 argi2 = strtol( argv[ 2], NULL, 10);
  7023.                 sts = zopeni( argi2, argv[ 3]);
  7024.                 printf( " sts = %d.\n", sts);
  7025.             }
  7026.         }
  7027.         else if (argi1 == 5)
  7028.         {
  7029.             if (argc < 4)
  7030.             {
  7031.                 printf( " arg1 = %d.  Insuff args (%d < 4).\n", argi1, argc);
  7032.             }
  7033.             else
  7034.             {
  7035.                 struct zattr zz;
  7036.                 struct filinfo fcb;
  7037.  
  7038.                 argi2 = strtol( argv[ 2], NULL, 10);
  7039.                 sts = zopeno( argi2, argv[ 3], &zz, &fcb);
  7040.                 printf( " sts = %d.\n", sts);
  7041.             }
  7042.         }
  7043.         else if (argi1 == 6)
  7044.         {
  7045.             if (argc < 3)
  7046.             {
  7047.                 printf( " arg1 = %d.  Insuff args (%d < 3).\n", argi1, argc);
  7048.             }
  7049.             else
  7050.             {
  7051.                 sts = zchki( argv[ 2]);
  7052.                 printf( " sts = %d.\n", sts);
  7053.             }
  7054.         }
  7055.         else if (argi1 == 7)
  7056.         {
  7057.             if (argc < 3)
  7058.             {
  7059.                 printf( " arg1 = %d.  Insuff args (%d < 3).\n", argi1, argc);
  7060.             }
  7061.             else
  7062.             {
  7063.                 sts = zchko( argv[ 2]);
  7064.                 printf( " sts = %d.\n", sts);
  7065.             }
  7066.         }
  7067.         else if (argi1 == 8)
  7068.         {
  7069.             if (argc < 5)
  7070.             {
  7071.                 printf( " arg1 = %d.  Insuff args (%d < 5).\n", argi1, argc);
  7072.             }
  7073.             else
  7074.             {
  7075.                 argi2 = strtol( argv[ 2], NULL, 10);
  7076.                 argi3 = strtol( argv[ 3], NULL, 10);
  7077.                 char name2[ NAMX_C_MAXRSS];
  7078.  
  7079.                 nzltor( argv[ 4], name2, argi2, argi3, NAMX_C_MAXRSS);
  7080.                 printf( " nameq: >%s<.\n", name2);
  7081.             }
  7082.         }
  7083.         else if (argi1 == 9)
  7084.         {
  7085.             if (argc < 3)
  7086.             {
  7087.                 printf( " arg1 = %d.  Insuff args (%d < 3).\n", argi1, argc);
  7088.             }
  7089.             else
  7090.             {
  7091.                 char name2[ NAMX_C_MAXRSS];
  7092.  
  7093.                 sts = cvtdir( argv[ 2], name2, NAMX_C_MAXRSS);
  7094.                 printf( " sts = %d.\n", sts);
  7095.             }
  7096.         }
  7097.         else if (argi1 == 10)
  7098.         {
  7099.             if (argc < 3)
  7100.             {
  7101.                 printf( " arg1 = %d.  Insuff args (%d < 3).\n", argi1, argc);
  7102.             }
  7103.             else
  7104.             {
  7105.                 sts = zmkdir( argv[ 2]);
  7106.                 printf( " sts = %d.\n", sts);
  7107.             }
  7108.         }
  7109.         else if (argi1 == 11)
  7110.         {
  7111.             if (argc < 3)
  7112.             {
  7113.                 printf( " arg1 = %d.  Insuff args (%d < 3).\n", argi1, argc);
  7114.             }
  7115.             else
  7116.             {
  7117.                 sts = zrmdir( argv[ 2]);
  7118.                 printf( " sts = %d.\n", sts);
  7119.             }
  7120.         }
  7121.         else if (argi1 == 12)
  7122.         {
  7123.             if (argc < 3)
  7124.             {
  7125.                 printf( " arg1 = %d.  Insuff args (%d < 3).\n", argi1, argc);
  7126.             }
  7127.             else
  7128.             {
  7129.                 sts = zchkpath( argv[ 2]);
  7130.                 printf( " sts = %d.\n", sts);
  7131.             }
  7132.         }
  7133.     }
  7134. }
  7135.  
  7136. /* Dummy run-time library functions. */
  7137.  
  7138. #define MIN( a, b) ((a) < (b) ? (a) : (b))
  7139.  
  7140. int ckstrncpy(char * dest, const char * src, int len)
  7141. {
  7142.     strncpy( dest, src, len);
  7143.     return MIN( strlen( src), len);
  7144. }
  7145.  
  7146. int ckstrncat(char * dest, const char * src, int len)
  7147. {
  7148.     strncat( dest, src, len);
  7149.     return MIN( strlen( src), len);
  7150. }
  7151.  
  7152. int dodebug( int f, char *s1, char *s2, CK_OFF_T n)
  7153. {
  7154. #if __USE_OFF64_T
  7155.     printf( " %s %s %lld (%%x%016llx).\n", s1, s2, n, n);
  7156. #else /* __USE_OFF64_T */
  7157.     printf( " %s %s %d (%%x%08x).\n", s1, s2, n, n);
  7158. #endif /* __USE_OFF64_T [else] */
  7159.     return 0;
  7160. }
  7161.  
  7162. int print_msg( char *msg)
  7163. {
  7164.     printf( " v_s = %d (%%x%08x), msg: >%s<.\n",
  7165.      vms_status, vms_status, msg);
  7166.     return 0;
  7167. }
  7168.  
  7169. #endif /* def UNIT_TEST */
  7170.