/*****************************************************************************/
/*
                                  sechan.c

WASD's SEcurity .CH Army kNife :^)

Guide to pronounciation: 'ch' as in "machine" making it something like
"seshun" or "session".  If only I could have found a way to integrate an
additional 'u' into the name it could have become a Chinese utility rather than
a Suisse one.  (Hey, this is fairly dry work, I've got to get some amusement
somehow :^)

  $ SECHAN == "$HT_EXE:SECHAN"

This very specialized utility is designed to provide some very specific
functionality required for securing the WASD package and directory tree.  It is
done using C code for efficiency and so that files with a special IGNORE_THIS
ACE in an ACL will not be changed.  This allows package security to be reset at
any stage without affecting site specific components of it.  It requires an
account with SYSPRV.  Control-T will provide a progress indicator.

When first used this utility will create the following rights identifiers if
they don't already exist.

  WASD_HTTP_SERVER     granted to the HTTPd server account
  WASD_HTTP_NOBODY     granted to the HTTPd scripting account
  WASD_IGNORE_THIS     used in an ACL to cause SECHAN to ignore a file


PACKAGE SECURITY FUNCTIONALITY
------------------------------
This sets file ownership, protection and required ACLs for the WASD package
directory tree.  It only sets WASD package directories.  Any other top-level
directory found in the tree is ignored (by default).  Each directory in the
package gets it's own, specialized ACL (if required).

  $ SECHAN /PACKAGE

The above usage will result in the entire HT_ROOT:[000000...] tree being
traversed and the standard WASD package security settings (re)applied.  To
apply standard settings to only part of the tree provide a file specification
as in the following example.  If using this functionality it's also necessary
to explicitly apply it to the parent directory as well.

  $ SECHAN /PACKAGE HT_ROOT:[CGI-BIN]
  $ SECHAN /PACKAGE HT_ROOT:[000000]CGI-BIN.DIR

Security settings appropriate to that portion will be applied.

With the scripting directories ([CGI-BIN], [AXP-BIN/[VAX-BIN]) the /NOSCRIPT
qualifier causes a SYSTEM identifier to be used instead of WASD_HTTP_NOBODY on
the script files.  This means all files in these directories are unavailable to
the scripting account until explicitly made so by modifying the ACE.

To set some other (non-package) directory to the same security settings as a
known package directory use the /ASIF= qualifier.  The setting will be made as
if it was that package directory.  Note that using this facility the parent
directory must be explicitly set (sorry, you are getting this for $0 :^).

  $ SECHAN /ASIF=DOC WEB:[LOCAL.DOC]*.*
  $ SECHAN /ASIF=DOC WEB:[LOCAL]DOC.DIR
  $ SECHAN /ASIF=CGI-BIN WEB:[LOCAL.SCRIPTS]*.*
  $ SECHAN /ASIF=CGI-BIN WEB:[LOCAL]SCRIPTS.DIR


SETTING FILES TO BE IGNORED
---------------------------
The SECHAN utility ignores files that have an ACL with an ACE containing the
rights identifier WASD_IGNORE_THIS.  An ACE containing this can be added to a
file manually or to a file or files (with a wildcard specification) by using
this utility as shown in the following example.

  $ SECHAN /IGNORE HT_ROOT:[CGI-BIN]LOCAL_SCRIPT.COM
  $ SECHAN /IGNORE HT_ROOT:[AXP-BIN]LOCAL_*.EXE

To remove this setting the /NOIGNORE qualifier may be applied (this does not
affect any other parts of the ACL, if any).  Alternatively the ACL can be
edited or otherwise directly modified to remove the relevant ACE.

  $ SECHAN /NOIGNORE HT_ROOT:[CGI-BIN]LOCAL_SCRIPT.COM
  $ SECHAN /NOIGNORE HT_ROOT:[AXP-BIN]LOCAL_*.EXE

The /ALL qualifier causes the utility to ignore the WASD_IGNORE_THIS ACE and
process the file anyway, overriding this protection mechanism.  Use with
caution, it could undo all your /IGNORE settings!

The /FIND qualifier may be used with a file specification to locate and list
all files containing one of these IGNORE ACEs.  The /FIND=NOIGNORE can be used
to list all those that do not contain this.

  $ SECHAN /FIND HT_ROOT:[000000...]*.*


CHANGING ACCESS
---------------
It is possible to add an ACE to allow either the server or nobody access (or
both for that matter) read or write access to particular files.

  $ SECHAN /READ /SERVER WEB:[DATA]*.TXT
  $ SECHAN /WRITE /NOBODY WEB:[DATA]*.DAT

It also possible to to use the utility to apply the CONTROL ACE used by the
server for UPDate PUT's and POSTs for SYSUAF and /PROFILEd requests.  This can
only be applied to the parent directory.

  $ SECHAN /CONTROL HT_ROOT:[000000]LOCAL.DIR


OTHER FUNCTIONALITY
-------------------
The utility will continue to honour the IGNORE_THIS ACE when using other
security related functionality.  The /ACL= qualifier allows specific Access
Control List to be set.  The /OWNER= qualifier allows file ownership to be set. 
The /WORLD and /NOWORLD alternately allow world read permission and not
respectively.  If any of these are not specified they are not changed on the
target file(s).

  $ SECHAN WEB:[LOCAL]*.* /ACL=(IDENT=*,ACCESS=READ) /OWNER=WEB
  $ SECHAN WEB:[LOCAL]*.* /OWNER=WEB /WORLD
  $ SECHAN WEB:[LOCAL]*.* /ACL=(IDENT=WEB_USER,ACCESS=READ) /NOWORLD

Of course this utility has far less functionality to SET SECURITY and should
not be considering even the palest imitation.


GETUAI FUNCTIONALITY
--------------------
Gets the user device and directory from the UAF and assigns global symbols
containing the contents in various formats.  This is intended for use during
WASD package installation and update.

  SECHAN_DEFDEV    default device (e.g. (DKA0:)
  SECHAN_DEFDIR    default directory (e.g. [DANIEL])
  SECHAN_HOME      concatentation of above (e.g. DKA0:[DANIEL])
  SECHAN_HOME_DIR  home area directory file name (e.g. DKA0:[000000]DANIEL.DIR)
  SECHAN_UIC       account UIC in standard [nnn,nnn] format
  SECHAN_VERSION   software ID for utility

To get UAI information provide a <username> parameter.  To delete symbols
containing the information provide no parameter.

  $ SECHAN = "$HT_EXE:SECHAN"
  $ SECHAN /GETUAI DANIEL
  $ SHOW SYM $STATUS
    $STATUS == "%X00000001"
  $ SHOW SYMBOL SECHAN_*
    SECHAN_DEFDEV == "DKA100:"
    SECHAN_DEFDIR == "[USER.DANIEL]"
    SECHAN_HOME == "DKA0:[USER.DANIEL]"
    SECHAN_HOME_DIR == "DKA0:[USER]DANIEL.DIR"
    SECHAN_UIC == "[100,1]"
    SECHAN_VERSION == "SECHAN AXP-1.0.0"

  $ SECHAN /GETUAI
  $ SHOW SYM $STATUS
    $STATUS == "%X00000001"
  $ SHOW SYMBOL SECHAN_*
  %DCL-W-UNDSYM, undefined symbol - check validity and spelling

  $ SECHAN /GETUAI DOESNOTEXIST
  $ SHOW SYM $STATUS
    $STATUS == "%X100182B2"
  $ SHOW SYMBOL SECHAN_*
  %DCL-W-UNDSYM, undefined symbol - check validity and spelling

If the UAF record (username) does not exist the utility exits quietly with a
%X100182B2 status (inhibited RNF) and leaves no symbols.


QUALIFIERS
----------
/ACL=           apply the specified ACL to the file specification
/ALL            do not ignore those files with the IGNORE ACL applied
/ASIF=          the specified directory (e.g. /ASIF=SRC or /ASIF=CGI-BIN)
/CONTROL        place a server CONTROL ACE on that directory (for UPDate)
/DBUG           enable all if(Debug)s
/DELETE         delete all ACLs from the file specification
/EXCEPTIONAL    apply security settings only to files in 'FileSecurity'
/FIND=          find all IGNORE files (default)
/GETUAI         get the parameter usernames UAI information into symbols
/IDENTIFIERS    check for and create rights identifiers if necessary
/IGNORE         add an IGNORE ACE to this file specification
/LOG            output the name of each file before it's modified
/NOBODY         apply the /READ or /WRITE for the nobody (scripting) account
/NOIGNORE       remove (all) IGNORE ACE from this file specification
/NOSCRIPT       make scripting directories available only to SYSTEM account
/OWNER=         sets the file ownership to the specified username
/PACKAGE        apply the default WASD package security profile
/PROGRESS       progress stamp every 100 files
/READ           place a server READ ACE on that directory (for UPDate)
/SERVER         (default) apply the /READ or /WRITE for the server account
/VERSION        output software ID and copyright information
/WORLD          allow world read access
/NOWORLD        deny world read access
/WRITE          place a server READ+WRITE ACE on that directory (for UPDate)


BUILD DETAILS
-------------
Compile then link:
  $ @BUILD_SECHAN
To just link:
  $ @BUILD_SECHAN LINK


COPYRIGHT
---------
Copyright (C) 2002,2003 Mark G.Daniel
This program, comes with ABSOLUTELY NO WARRANTY.
This is free software, and you are welcome to redistribute it
under the conditions of the GNU GENERAL PUBLIC LICENSE, version 2.


VERSION HISTORY (update SOFTWAREVN as well)
---------------
23-DEC-2003  MGD  v1.1.0, support IA64 exe directories (a la Alpha and VAX)
                          minor conditional mods to support IA64
15-FEB-2003  MGD  v1.0.3, ensure HT_ROOT.DIR has security set,
                          continue if 'exceptional files' directory not found
30-DEC-2002  MGD  v1.0.2, bugfix; only enable control-T when interactive
05-DEC-2002  MGD  v1.0.1, bugfix; fab$l_fna used incorrect string
16-NOV-2002  MGD  v1.0.0, initial development
*/
/*****************************************************************************/

#define SOFTWAREVN "1.1.0"
#define SOFTWARENM "SECHAN"
#ifdef __ALPHA
#  define SOFTWAREID SOFTWARENM " AXP-" SOFTWAREVN
#endif
#ifdef __ia64
#  define SOFTWAREID SOFTWARENM " IA64-" SOFTWAREVN
#endif
#ifdef __VAX
#  define SOFTWAREID SOFTWARENM " VAX-" SOFTWAREVN
#endif

/* standard C header files */
#include <ctype.h>
#include <errno.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

/* VMS related header files */
#include <descrip.h>
#include <iodef.h>
#include <jpidef.h>
#include <libclidef.h>
#include <lnmdef.h>
#include <prvdef.h>
#include <rms.h>
#include <ssdef.h>
#include <stsdef.h>
#include <syidef.h>
#include <uaidef.h>

#define OSS$M_WLOCK 1
#define OSS$M_RELCTX 2
#define OSS$M_LOCAL 4
#define OSS$_ACL_ADD_ENTRY 3
#define OSS$_ACL_DELETE_ENTRY 4
#define OSS$_ACL_DELETE_ALL 6
#define OSS$_ACL_FIND_NEXT 8
#define OSS$_ACL_POSITION_TOP 14
#define OSS$_ACL_READ_ENTRY 16
#define OSS$_OWNER 21
#define OSS$_PROTECTION 22
#define PSL$C_USER 3

#define CLI$_INSFPRM 229448

/* application header files */
#include "enamel.h"

#define BOOL int
#define true 1
#define false 0

#define VMSok(x) ((x) & STS$M_SUCCESS)
#define VMSnok(x) !(((x) & STS$M_SUCCESS))

#ifndef __VAX
#  ifndef NO_ODS_EXTENDED
#     define ODS_EXTENDED 1
      /* this is smaller than the technical maximum, but still quite large! */
#     define ODS_MAX_FILE_NAME_LENGTH 511
#     define ODS_MAX_FILESYS_NAME_LENGTH 264
#  endif
#endif
#define ODS2_MAX_FILE_NAME_LENGTH 255
#ifndef ODS_MAX_FILE_NAME_LENGTH
#  define ODS_MAX_FILE_NAME_LENGTH ODS2_MAX_FILE_NAME_LENGTH
#endif
#if ODS_MAX_FILE_NAME_LENGTH < ODS2_MAX_FILE_NAME_LENGTH
#  define ODS_MAX_FILE_NAME_LENGTH ODS2_MAX_FILE_NAME_LENGTH
#endif

   char  CopyrightInfo [] =
"Copyright (C) 2002,2003 Mark G.Daniel\n\
This program, comes with ABSOLUTELY NO WARRANTY.\n\
This is free software, and you are welcome to redistribute it\n\
under the conditions of the GNU GENERAL PUBLIC LICENSE, version 2.\n";

/***************/
/* some macros */
/***************/

#define FILE_DIR   1
#define FILE_WWW   2

#define WASD_HTTP_SERVER "WASD_HTTP_SERVER"
#define WASD_HTTP_NOBODY "WASD_HTTP_NOBODY"
#define WASD_IGNORE_THIS "WASD_IGNORE_THIS"

#define ACE_IGNORE_THIS "(IDENT=WASD_IGNORE_THIS,ACCESS=NONE)"

/* only used for controlling /PROFILE access to directory contents */
#define ACE_SERVER_CONTROL "(IDENT=WASD_HTTP_SERVER,ACCESS=CONTROL)"

#define ACE_SERVER_READ_DIR \
"((IDENT=WASD_HTTP_SERVER,ACCESS=R),\
(IDENT=WASD_HTTP_SERVER,OPTIONS=DEFAULT,ACCESS=R))"

#define ACE_SERVER_READ_FILE "(IDENT=WASD_HTTP_SERVER,ACCESS=R)"

#define ACE_SERVER_WRITE_DIR \
"((IDENT=WASD_HTTP_SERVER,ACCESS=R+W),\
(IDENT=WASD_HTTP_SERVER,OPTIONS=DEFAULT,ACCESS=R+W+D))"

#define ACE_SERVER_WRITE_FILE "(IDENT=WASD_HTTP_SERVER,ACCESS=R+W+D)"

#define ACE_NOBODY_READ_DIR \
"((IDENT=WASD_HTTP_NOBODY,ACCESS=R),\
(IDENT=WASD_HTTP_NOBODY,OPTIONS=DEFAULT,ACCESS=R))"

#define ACE_NOBODY_READ_FILE "(IDENT=WASD_HTTP_NOBODY,ACCESS=R)"

#define ACE_NOBODY_WRITE_DIR \
"((IDENT=WASD_HTTP_NOBODY,ACCESS=R+W),\
(IDENT=WASD_HTTP_NOBODY,OPTIONS=DEFAULT,ACCESS=R+W+D))"

#define ACE_NOBODY_WRITE_FILE "(IDENT=WASD_HTTP_NOBODY,ACCESS=R+W+D)"

/****************************/
/* package security profile */
/****************************/

#define IFSCRIPT 1
#define NOSCRIPT 2

#define ACCESS_WORLD    0xaa00  /* s:rwed,o:rwed,g:re,w:re */
#define ACCESS_NOWORLD  0xff00  /* s:rwed,o:rwed,g,w */

#define ACL_DEFAULT_WORLD \
"(DEFAULT_PROTECTION,S:RWED,O:RWED,G:RE,W:RE)"

#define ACL_NONE_DIR \
"((IDENT=*,ACCESS=NONE),\
(IDENT=*,OPTIONS=DEFAULT,ACCESS=NONE),\
(DEFAULT_PROTECTION,S:RWED,O:RWED,G,W))"

#define ACL_NONE_FILE \
"(IDENT=*,ACCESS=NONE)"

/*
Environments such as Java require the scripting account to have read access to
the directory in which (in that case) the class files are provided.
*/
#define ACL_BIN_DIR \
"((IDENT=WASD_HTTP_SERVER,ACCESS=E),\
(IDENT=WASD_HTTP_NOBODY,ACCESS=R+E),\
(IDENT=*,ACCESS=NONE),\
(IDENT=WASD_HTTP_NOBODY,OPTIONS=DEFAULT,ACCESS=R+E),\
(IDENT=*,OPTIONS=DEFAULT,ACCESS=NONE),\
(DEFAULT_PROTECTION,S:RWED,O:RWED,G,W))"

#define ACL_BIN_FILE \
     "((IDENT=WASD_HTTP_NOBODY,ACCESS=R+E),(IDENT=*,ACCESS=NONE))"

#define ACL_BIN_NOSCRIPT_DIR \
"((IDENT=WASD_HTTP_SERVER,ACCESS=E),\
(IDENT=WASD_HTTP_NOBODY,ACCESS=R+E),\
(IDENT=*,ACCESS=NONE),\
(IDENT=SYSTEM,OPTIONS=DEFAULT,ACCESS=R+E),\
(IDENT=*,OPTIONS=DEFAULT,ACCESS=NONE),\
(DEFAULT_PROTECTION,S:RWED,O:RWED,G,W))"

#define ACL_BIN_NOSCRIPT_FILE \
"((IDENT=SYSTEM,ACCESS=R+E),(IDENT=*,ACCESS=NONE))"

#define ACL_SERVER_READ_DIR \
"((IDENT=WASD_HTTP_SERVER,ACCESS=R+E),\
(IDENT=*,ACCESS=NONE),\
(IDENT=WASD_HTTP_SERVER,OPTIONS=DEFAULT,ACCESS=R+E),\
(IDENT=*,OPTIONS=DEFAULT,ACCESS=NONE),\
(DEFAULT_PROTECTION,S:RWED,O:RWED,G,W))"

#define ACL_SERVER_READ_FILE \
"((IDENT=WASD_HTTP_SERVER,ACCESS=R+E),(IDENT=*,ACCESS=NONE))"

#define ACL_SERVER_WRITE_DIR \
"((IDENT=WASD_HTTP_SERVER,ACCESS=R+W+E),\
(IDENT=*,ACCESS=NONE),\
(IDENT=WASD_HTTP_SERVER,OPTIONS=DEFAULT,ACCESS=R+W+E+D),\
(IDENT=*,OPTIONS=DEFAULT,ACCESS=NONE),\
(DEFAULT_PROTECTION,S:RWED,O:RWED,G,W))"

#define ACL_SERVER_WRITE_FILE \
"((IDENT=WASD_HTTP_SERVER,ACCESS=R+W+E+D),(IDENT=*,ACCESS=NONE))"

#define ACL_NOBODY_READ_FILE \
"((IDENT=WASD_HTTP_NOBODY,ACCESS=R+E),(IDENT=*,ACCESS=NONE))"

#define ACL_NOBODY_WRITE_DIR \
"((IDENT=WASD_HTTP_NOBODY,ACCESS=R+W+E),\
(IDENT=*,ACCESS=NONE),\
(IDENT=WASD_HTTP_NOBODY,OPTIONS=DEFAULT,ACCESS=R+W+E+D),\
(IDENT=*,OPTIONS=DEFAULT,ACCESS=NONE),\
(DEFAULT_PROTECTION,S:RWED,O:RWED,G,W))"

#define ACL_NOBODY_WRITE_FILE \
"((IDENT=WASD_HTTP_NOBODY,ACCESS=R+W+E+D),(IDENT=*,ACCESS=NONE))"

#define ACL_SCRATCH_DIR \
"((IDENT=WASD_HTTP_SERVER,ACCESS=R+E),\
(IDENT=WASD_HTTP_NOBODY,ACCESS=R+W+E),\
(IDENT=*,ACCESS=NONE),\
(IDENT=WASD_HTTP_SERVER,OPTIONS=DEFAULT,ACCESS=R),\
(IDENT=WASD_HTTP_NOBODY,OPTIONS=DEFAULT,ACCESS=R+W+E+D),\
(IDENT=*,OPTIONS=DEFAULT,ACCESS=NONE),\
(DEFAULT_PROTECTION,S:RWED,O:RWED,G,W))"

#define ACL_SCRATCH_FILE \
"((IDENT=WASD_HTTP_SERVER,ACCESS=R),\
(IDENT=WASD_HTTP_NOBODY,ACCESS=R+W+E+D),\
(IDENT=*,ACCESS=NONE))"

#define ACL_HTTP$SERVER_LOGIN \
"((IDENT=WASD_HTTP_SERVER,ACCESS=R+E),(IDENT=*,ACCESS=NONE))"

#define ACL_HTTP$NOBODY_LOGIN \
"((IDENT=WASD_HTTP_NOBODY,ACCESS=R+E),(IDENT=*,ACCESS=NONE))"

struct PackageStruct
{
   char  *DirectoryName,
         *DirectoryFileAcl,
         *DirectoryContentsAcl;
   unsigned short  Protection;
   int  WwwHidden,
        ScriptBin;
};

/* all of the package-recognized directories */
struct PackageStruct  PackageSecurity [] =
{
   /* zeroth element is a sentinal */
   { "",             NULL, NULL, 0, 0, 0 },
   /* top-level directories (both pre and post 8.1) */
   { "000000",       NULL, NULL, ACCESS_WORLD, 0, 0 },
   { "AXP-BIN",      ACL_BIN_DIR, ACL_BIN_FILE, ACCESS_NOWORLD, 1, IFSCRIPT },
   { "AXP-BIN",      ACL_BIN_NOSCRIPT_DIR, ACL_BIN_NOSCRIPT_FILE, ACCESS_NOWORLD, 1, NOSCRIPT },
   { "AXP",          ACL_NONE_DIR, ACL_NONE_FILE, ACCESS_NOWORLD, 1, 0 },
   { "CGI-BIN",      ACL_BIN_DIR, ACL_BIN_FILE, ACCESS_NOWORLD, 1, IFSCRIPT },
   { "CGI-BIN",      ACL_BIN_NOSCRIPT_DIR, ACL_BIN_NOSCRIPT_FILE, ACCESS_NOWORLD, 1, NOSCRIPT },
   { "DOC",          ACL_DEFAULT_WORLD, NULL, ACCESS_WORLD, 0, 0 },
   { "EXAMPLE",      ACL_DEFAULT_WORLD, NULL, ACCESS_WORLD, 0, 0 },
   { "EXERCISE",     ACL_DEFAULT_WORLD, NULL, ACCESS_WORLD, 0, 0 },
   { "HTTP$NOBODY",  ACL_NOBODY_WRITE_DIR, ACL_NOBODY_WRITE_FILE, ACCESS_NOWORLD, 1, 0 },
   { "HTTP$SERVER",  ACL_SERVER_WRITE_DIR, ACL_SERVER_WRITE_FILE, ACCESS_NOWORLD, 1, 0 },
   { "IA64-BIN",     ACL_BIN_DIR, ACL_BIN_FILE, ACCESS_NOWORLD, 1, IFSCRIPT },
   { "IA64-BIN",     ACL_BIN_NOSCRIPT_DIR, ACL_BIN_NOSCRIPT_FILE, ACCESS_NOWORLD, 1, NOSCRIPT },
   { "IA64",         ACL_NONE_DIR, ACL_NONE_FILE, ACCESS_NOWORLD, 1, 0 },
   { "INSTALL",      ACL_DEFAULT_WORLD, NULL, ACCESS_WORLD, 0, 0 },
   { "JAVA",         ACL_NONE_DIR, ACL_NONE_FILE, ACCESS_NOWORLD, 1, 0 },
   { "LOCAL",        ACL_NONE_DIR, ACL_NONE_FILE, ACCESS_NOWORLD, 1, 0 },
   { "LOG",          ACL_NONE_DIR, ACL_NONE_FILE, ACCESS_NOWORLD, 1, 0 },
   { "LOG_SERVER",   ACL_SERVER_WRITE_DIR, ACL_SERVER_WRITE_FILE, ACCESS_NOWORLD, 1, 0 },
   { "RUNTIME",      ACL_DEFAULT_WORLD, ACL_DEFAULT_WORLD, ACCESS_WORLD, 0, 0 },
   { "SCRATCH",      ACL_SCRATCH_DIR, ACL_SCRATCH_FILE, ACCESS_NOWORLD, 1, 0 },
   { "SCRIPT",       ACL_NONE_DIR, ACL_NONE_FILE, ACCESS_NOWORLD, 1, 0 },
   { "SCRIPT_LOCAL", ACL_NONE_DIR, ACL_NONE_FILE, ACCESS_NOWORLD, 1, 0 },
   { "SRC",          ACL_DEFAULT_WORLD, NULL, ACCESS_WORLD, 0, 0 },
   { "STARTUP",      ACL_SERVER_READ_DIR, ACL_SERVER_READ_FILE, ACCESS_NOWORLD, 1, 0 },
   { "VAX-BIN",      ACL_BIN_DIR, ACL_BIN_FILE, ACCESS_NOWORLD, 1, IFSCRIPT },
   { "VAX-BIN",      ACL_BIN_NOSCRIPT_DIR, ACL_BIN_NOSCRIPT_FILE, ACCESS_NOWORLD, 1, NOSCRIPT },
   { "VAX",          ACL_NONE_DIR, ACL_NONE_FILE, ACCESS_NOWORLD, 1, 0 },
   /* the following are not real directories, just programming conveniences */
   { "SERVER-LOGIN.COM", NULL, ACL_SERVER_READ_FILE, ACCESS_NOWORLD, 1, 0 },
   { "NOBODY-LOGIN.COM", NULL, ACL_NOBODY_READ_FILE, ACCESS_NOWORLD, 1, 0 },
   /* sentinal */
   { NULL,           NULL, NULL, 0, 0, 0 }
};

struct FileStruct
{
   char  *FileSpec,
         *AsIf;
};

/* those files that explicitly need settings contrary to the above */
struct FileStruct  FileSecurity [] =
{
   { "HT_ROOT:[000000]*.COM;*",          "LOCAL" },
   { "HT_ROOT:[HTTP$SERVER]LOGIN.COM;*", "SERVER-LOGIN.COM" },
   { "HT_ROOT:[HTTP$NOBODY]LOGIN.COM;*", "NOBODY-LOGIN.COM" },
   { "HT_ROOT:[AXP]HTTPD.EXE;*",         "STARTUP" },
   { "HT_ROOT:[AXP]HTTPD_SSL.EXE;*",     "STARTUP" },
   { "HT_ROOT:[VAX]HTTPD.EXE;*",         "STARTUP" },
   { "HT_ROOT:[VAX]HTTPD_SSL.EXE;*",     "STARTUP" },
   { NULL, NULL }
};

/******************/
/* global storage */
/******************/

BOOL  CliAllFiles,
      CliCheck,
      CliDelete,
      CliExceptionalFiles,
      CliGetUai,
      CliIdentifiers,
      CliLog,
      CliNoScript,
      CliPackage,
      CliProgress,
      CliSetControl,
      CliSetIgnore,
      CliSetNoIgnore,
      CliSetNobody,
      CliSetRead,
      CliSetServer,
      CliSetWrite,
      CliWorldAccess,
      CliNoWorldAccess,
      Debug,
      OdsExtended,
      WholePackage;

int  ProgressCount;

unsigned long  AccessMode = PSL$C_USER,
               OssRelCtx = OSS$M_RELCTX;

unsigned long  SysPrvMask [2] = { PRV$M_SYSPRV, 0 };

unsigned long  HttpServerId,
               HttpNobodyId,
               IgnoreId,
               OwnerUic;

char  *CliAclPtr,
      *CliAsIfPtr,
      *CliFindPtr,
      *CliOwnerPtr,
      *CliParam1Ptr,
      *ControlTFileNamePtr;

char  Utility [] = "SECHAN";

$DESCRIPTOR (ClassNameDsc, "FILE");

/**************/
/* prototypes */
/**************/

void ControlT (char);
int DeleteGlobalSymbol (char*);
int GetIdent (char*, unsigned long*, BOOL);
int GetParameters ();
int GetVmsVersion ();
int GetUai (char*);
char *HtRootDir ();
int SetGlobalSymbol (char*, char*);
int FindFiles (char*);
int SetCheckIgnore (char*, int);
int SetSecurity (char*, int, unsigned long, unsigned short, char*);
int SetPackage (char*, int, int);
BOOL strsame (char*, char*, int);

int lib$get_foreign (__unknown_params);
int lib$delete_symbol (__unknown_params);
int lib$get_symbol (__unknown_params);
int lib$set_symbol (__unknown_params);
int sys$add_ident (__unknown_params);
int sys$asctoid (__unknown_params);
int sys$assign (__unknown_params);
int sys$fao (__unknown_params);
int sys$getjpiw (__unknown_params);
int sys$getsyiw (__unknown_params);
int sys$get_security (__unknown_params);
int sys$getuai (__unknown_params);
int sys$parse (__unknown_params);
int sys$parse_acl (__unknown_params);
int sys$setprv (__unknown_params);
int sys$trnlnm (__unknown_params);
int sys$qiow (__unknown_params);
int sys$set_security (__unknown_params);
int sys$search (__unknown_params);

/*****************************************************************************/
/*
*/

main
(
int argc,
char *argv[]
)
{
   int  idx, status,
        CreateIdentCount;

   /*********/
   /* begin */
   /*********/

   if (getenv ("SECHAN$DBUG")) Debug = true;

   /* need this for most of what we're about to do */
   status = sys$setprv (1, &SysPrvMask, 0, 0);
   if (VMSnok (status)) exit (status);
   if (status == SS$_NOTALLPRIV) exit (SS$_NOSYSPRV);

   GetParameters ();

   if (CliGetUai) exit (GetUai (CliParam1Ptr));

   if (CliIdentifiers)
   {
      /* just check for and create the rights identifiers if necesary */
      CreateIdentCount = 0;
      status = GetIdent (WASD_HTTP_SERVER, &HttpServerId, false);
      if (VMSnok (status)) CreateIdentCount++;
      status = GetIdent (WASD_HTTP_NOBODY, &HttpNobodyId, false);
      if (VMSnok (status)) CreateIdentCount++;
      status = GetIdent (WASD_IGNORE_THIS, &IgnoreId, false);
      if (VMSnok (status)) CreateIdentCount++;
      if (!CreateIdentCount) return (SS$_NORMAL);
   }
   GetIdent (WASD_HTTP_SERVER, &HttpServerId, true);
   GetIdent (WASD_HTTP_NOBODY, &HttpNobodyId, true);
   GetIdent (WASD_IGNORE_THIS, &IgnoreId, true);
   if (CliIdentifiers)
   {
      /* this just makes install/update procedures look a little neater */
      if (CreateIdentCount) fputs ("\n", stdout);
      exit (SS$_NORMAL);
   }

   if ((CliPackage || CliFindPtr) && !CliParam1Ptr)
   {
      if (CliPackage) WholePackage = true;
      CliParam1Ptr = "HT_ROOT:[000000...]*.*;*";
   }

   /* package is always owned by SYSTEM! (at least to start with) */
   if (CliPackage) CliOwnerPtr = "SYSTEM";

   if (CliOwnerPtr && CliOwnerPtr[0])
   {
      status = GetIdent (CliOwnerPtr, &OwnerUic, false);
      if (VMSnok (status)) exit (status);
   }

   if (CliAsIfPtr || CliExceptionalFiles) CliPackage = true;

   if (!CliParam1Ptr) exit (CLI$_INSFPRM);

   ControlT (0);

   if (!CliExceptionalFiles)
      if (VMSnok (status = FindFiles (CliParam1Ptr)))
         exit (status);

   if (WholePackage || CliExceptionalFiles)
   {
      /* start with HT_ROOT.DIR itself */
      CliAsIfPtr = "DOC";
      FindFiles (HtRootDir());
      /* explicitly set these file specifications */
      for (idx = 0; FileSecurity[idx].FileSpec; idx++)
      {
         CliAsIfPtr = FileSecurity[idx].AsIf;
         FindFiles (FileSecurity[idx].FileSpec);
      }
      /* special case (otherwise overridden by logic in SetPackage()) */
      FindFiles ("HT_ROOT:[*].WWW_*;*");
   }

   if (CliProgress && ProgressCount > 100)
      fprintf (stdout, " (%d)\n", ProgressCount);

   exit (SS$_NORMAL);
}

/*****************************************************************************/
/*
Search for files matching the specification and then apply whatever has been
requested via the command line.
*/

int FindFiles (char *FileSpec)

{
   int  idx, status,
        ExpFileNameLength,
        SpecialFile,
        ResFileNameLength;
   unsigned long  Context;
   char  ExpFileName [ODS_MAX_FILE_NAME_LENGTH+1],
         ResFileName [ODS_MAX_FILE_NAME_LENGTH+1];
   char  *cptr;
   struct FAB  SearchFab;
   struct NAM  SearchNam;
#ifdef ODS_EXTENDED
   struct NAML  SearchNaml;
#endif /* ODS_EXTENDED */

   /*********/
   /* begin */
   /*********/

   if (Debug) fprintf (stdout, "FindFiles() |%s|\n", FileSpec);

#ifdef ODS_EXTENDED
   OdsExtended = (GetVmsVersion() >= 72);
   ENAMEL_NAML_SANITY_CHECK
#endif /* ODS_EXTENDED */

   SearchFab = cc$rms_fab;
   SearchFab.fab$l_dna = "*.*;0";
   SearchFab.fab$b_dns = 5;

#ifdef ODS_EXTENDED
   if (OdsExtended)
   {
      SearchFab.fab$l_fna = (char*)-1;
      SearchFab.fab$b_fns = 0;
      SearchFab.fab$l_nam = (struct namdef*)&SearchNaml;

      ENAMEL_RMS_NAML(SearchNaml)
      SearchNaml.naml$l_long_filename = FileSpec;
      SearchNaml.naml$l_long_filename_size = strlen(FileSpec);
      SearchNaml.naml$l_long_expand = ExpFileName;
      SearchNaml.naml$l_long_expand_alloc = sizeof(ExpFileName)-1;
      SearchNaml.naml$l_long_result = ResFileName;
      SearchNaml.naml$l_long_result_alloc = sizeof(ResFileName)-1;
   }
   else
#endif /* ODS_EXTENDED */
   {
      SearchFab.fab$l_fna = FileSpec;
      SearchFab.fab$b_fns = strlen(FileSpec);
      SearchFab.fab$l_nam = &SearchNam;

      SearchNam = cc$rms_nam;
      SearchNam.nam$l_esa = ExpFileName;
      SearchNam.nam$b_ess = ODS2_MAX_FILE_NAME_LENGTH;
      SearchNam.nam$l_rsa = ResFileName;
      SearchNam.nam$b_rss = ODS2_MAX_FILE_NAME_LENGTH;
   }

   if (VMSnok (status = sys$parse (&SearchFab, 0, 0)))
      return (status);

#ifdef ODS_EXTENDED
   if (OdsExtended)
   {
      SearchNaml.naml$l_long_ver[SearchNaml.naml$l_long_ver_size] = '\0';
      ExpFileNameLength = (SearchNaml.naml$l_long_ver - ExpFileName) +
                          SearchNaml.naml$l_long_ver_size;
   }
   else
#endif /* ODS_EXTENDED */
   {
      SearchNam.nam$l_ver[SearchNam.nam$b_ver] = '\0';
      ExpFileNameLength = (SearchNam.nam$l_ver - ExpFileName) +
                          SearchNam.nam$b_ver;
   }
   if (Debug)
      fprintf (stdout, "ExpFileName %d |%s|\n",
               ExpFileNameLength, ExpFileName);

   ControlTFileNamePtr = ResFileName;

   while (VMSok (status = sys$search (&SearchFab, 0, 0)))
   {
      SpecialFile = 0;

#ifdef ODS_EXTENDED
      if (OdsExtended)
      {
         SearchNaml.naml$l_long_ver[SearchNaml.naml$l_long_ver_size] = '\0';
         ResFileNameLength = (SearchNaml.naml$l_long_ver - ResFileName) +
                             SearchNaml.naml$l_long_ver_size;
         if (strsame (SearchNaml.naml$l_long_type, ".DIR;", 5))
            SpecialFile = FILE_DIR;
         else
         if (SearchNaml.naml$l_long_name == SearchNaml.naml$l_long_type &&
             strsame (SearchNaml.naml$l_long_type, ".WWW_", 5))
            SpecialFile = FILE_WWW;
      }
      else
#endif /* ODS_EXTENDED */
      {
         SearchNam.nam$l_ver[SearchNam.nam$b_ver] = '\0';
         ResFileNameLength = (SearchNam.nam$l_ver - ResFileName) +
                             SearchNam.nam$b_ver;
         if (strsame (SearchNam.nam$l_type, ".DIR;", 5))
            SpecialFile = FILE_DIR;
         else
         if (SearchNam.nam$l_name == SearchNam.nam$l_type &&
             strsame (SearchNam.nam$l_type, ".WWW_", 5))
            SpecialFile = FILE_WWW;
      }
      if (Debug)
         fprintf (stdout, "ResFileName %d %d |%s|\n",
                  SpecialFile, ResFileNameLength, ResFileName);

      ProgressCount++;
      if (CliProgress)
      {
         if (!(ProgressCount % 25) && ProgressCount >= 100)
         {
            if (ProgressCount == 100)
               fprintf (stdout, "PROGRESS: 100");
            else
            if (!(ProgressCount % 100))
               fprintf (stdout, "%d", ProgressCount);
            else
               fprintf (stdout, ".");
         }
      }

      if (CliFindPtr)
      {
         /* searching for files with/without the IGNORE ACL */
         status = SetCheckIgnore (ResFileName, ResFileNameLength);
         if (Debug) fprintf (stdout, "SetCheckIgnore() %%X%08.08X\n", status);
         if (!*CliFindPtr || *CliFindPtr == 'I')
            if (VMSok (status))
               fprintf (stdout, "%s\n", ResFileName);
            else
               continue;
         else
            if (VMSok (status))
               continue;
            else
               fprintf (stdout, "%s\n", ResFileName);
         continue;
      }

      if (CliSetControl)
      {
         if (SpecialFile != FILE_DIR)
         {
            fprintf (stdout, "%%%s-E-CONTROL, only on directory files\n",
                     Utility);
            exit (SS$_BADPARAM | STS$M_INHIB_MSG);
         }
         SetSecurity (ResFileName, ResFileNameLength,
                      0, 0, ACE_SERVER_CONTROL);
         if (!CliSetIgnore) continue;
      }

      if (CliSetRead)
      {
         if (SpecialFile == FILE_DIR)
            SetSecurity (ResFileName, ResFileNameLength,
                         0, 0, CliSetNobody ? ACE_NOBODY_READ_FILE
                                            : ACE_SERVER_READ_FILE);
         else
            SetSecurity (ResFileName, ResFileNameLength,
                         0, 0, CliSetNobody ? ACE_NOBODY_READ_FILE
                                            : ACE_SERVER_READ_FILE);
         if (!CliSetIgnore) continue;
      }

      if (CliSetWrite)
      {
         if (SpecialFile == FILE_DIR)
            SetSecurity (ResFileName, ResFileNameLength,
                         0, 0, CliSetNobody ? ACE_NOBODY_WRITE_DIR
                                            : ACE_SERVER_WRITE_DIR);
         else
            SetSecurity (ResFileName, ResFileNameLength,
                         0, 0, CliSetNobody ? ACE_NOBODY_WRITE_FILE
                                            : ACE_SERVER_WRITE_FILE);
         if (!CliSetIgnore) continue;
      }

      if (CliSetIgnore || CliSetNoIgnore)
      {
         SetCheckIgnore (ResFileName, ResFileNameLength);
         continue;
      }

      if (!CliAllFiles)
      {
         /* check if this file should be ignored */
         status = SetCheckIgnore (ResFileName, ResFileNameLength);
         if (Debug) fprintf (stdout, "SetCheckIgnore() %%X%08.08X\n", status);
         if (VMSok (status)) continue;
      }

      if (CliPackage)
         SetPackage (ResFileName, ResFileNameLength, SpecialFile);
      else
      if (CliWorldAccess)
         SetSecurity (ResFileName, ResFileNameLength,
                      OwnerUic, ACCESS_WORLD, CliAclPtr);
      else
      if (CliNoWorldAccess)
         SetSecurity (ResFileName, ResFileNameLength,
                      OwnerUic, ACCESS_NOWORLD, CliAclPtr);
      else
         SetSecurity (ResFileName, ResFileNameLength,
                      OwnerUic, 0, CliAclPtr);
   }

   if (Debug) fprintf (stdout, "sys$search() %%X%08.08X\n", status);

   ControlTFileNamePtr = NULL;

   if (status == RMS$_NMF) status = SS$_NORMAL;

   return (status);
}

/*****************************************************************************/
/*
This function sets the supplied file name's security (ownership, file
protection and optionally an ACL) according to package requirements stored in
the array 'PackageSecurity'.  It gets the leading directory name from the file
name.  It then compares this to the name stored in 'PrevDirectory' (if any). 
If they match then it just uses the previous directory security information to
set the security for this file.  If they don't then we must have changed
directories and it searches the 'PackageSecurity' array for a directory name
that matches that leading directory name from the file name.  If it finds one
that matches it uses the associated security information to set the security on
the supplied file name.  If none matches then it considers this is not a
package directory and makes no changes to any files within it.
*/

int SetPackage
(
char *FileName,
int FileNameLength,
int SpecialFile
)
{
   static char  PrevIndex;
   static char  PrevDirectory [64];

   int  cnt, idx, status;
   char  *cptr, *sptr, *tptr, *zptr;
   char  Scratch [256];
   FILE  *fptr;

   /*********/
   /* begin */
   /*********/

   if (Debug)
      fprintf (stdout, "SetPackage() %d |%s|%s|\n",
               SpecialFile, FileName, PrevDirectory);

   if (CliAsIfPtr)
   {
      if (!(idx = PrevIndex) || WholePackage || CliExceptionalFiles)
      {
         for (idx = 0; PackageSecurity[idx].DirectoryName; idx++)
            if (strsame (PackageSecurity[idx].DirectoryName, CliAsIfPtr, -1))
               break;
         PrevIndex = idx;
         if (Debug)
            fprintf (stdout, "%d |%s|\n",
                     idx, PackageSecurity[idx].DirectoryName);
         /* if not a known package directory name */
         if (!PackageSecurity[idx].DirectoryName)
         {
            fprintf (stdout, "%%%s-E-ASIF, unknown name\n \\%s\\\n",
                     Utility, CliAsIfPtr);
            exit (SS$_BADPARAM | STS$M_INHIB_MSG);
         }
      }
   }
   else
   {
      for (cptr = FileName; *cptr && *cptr != ':'; cptr++);
      if (*(unsigned short*)cptr == ':[') cptr += 2;
      if (!memcmp (cptr, "000000.", 7)) cptr += 7;
      tptr = cptr;
      sptr = PrevDirectory;
      while (*sptr && *cptr && *cptr != '.' && *cptr != ']' &&
             toupper(*cptr) == toupper(*sptr))
      {
         cptr++;
         sptr++;
      }
      /* if they are the same */
      if (!*sptr && (*cptr == '.' || *cptr == ']'))
         idx = PrevIndex;
      else
         idx = 0;
      if (Debug)
         fprintf (stdout, "SAME %d |%s|\n",
                  idx, PackageSecurity[idx].DirectoryName);
   }

   if (!idx)
   {
      for (idx = 0; sptr = PackageSecurity[idx].DirectoryName; idx++)
      {
         if (PackageSecurity[idx].ScriptBin == IFSCRIPT && CliNoScript)
            continue;
         if (PackageSecurity[idx].ScriptBin == NOSCRIPT && !CliNoScript)
            continue;

         cptr = tptr;
         while (*sptr && *cptr && *cptr != '.' && *cptr != ']' &&
                toupper(*cptr) == toupper(*sptr))
         {
            cptr++;
            sptr++;
         }
         /* if they are the same */
         if (!*sptr && (*cptr == '.' || *cptr == ']')) break;
      }
      PrevIndex = idx;
      if (Debug)
         fprintf (stdout, "NEW %d |%s|\n",
                  idx, PackageSecurity[idx].DirectoryName);

      /* store the current directory */
      zptr = (sptr = PrevDirectory) + sizeof(PrevDirectory)-1;
      cptr = tptr;
      while (*cptr && *cptr != '.' && *cptr != ']' && sptr < zptr)
         *sptr++ = *cptr++;
      *sptr = '\0';
   }

   /* if not a known package directory name */
   if (!PackageSecurity[idx].DirectoryName) return (SS$_NORMAL);

   if (SpecialFile == FILE_WWW)
   {
      /* the likes of .WWW_HIDDEN */
      SetSecurity (FileName, FileNameLength,
                   OwnerUic,
                   ACCESS_NOWORLD,
                   PackageSecurity[idx].DirectoryFileAcl ? ACL_NONE_FILE : 0); 
      return (SS$_NORMAL);
   }

   if (SpecialFile == FILE_DIR)
   {
      for (cnt = 0; PackageSecurity[cnt].DirectoryName; cnt++)
      {
         if (PackageSecurity[cnt].ScriptBin == IFSCRIPT && CliNoScript)
            continue;
         if (PackageSecurity[cnt].ScriptBin == NOSCRIPT && !CliNoScript)
            continue;

         sprintf (Scratch, "HT_ROOT:[000000]%s.DIR;1",
                  PackageSecurity[cnt].DirectoryName);
         if (strsame (Scratch, FileName, -1)) break;
      }

      if (PackageSecurity[cnt].DirectoryName)
      {
         /* recognised top-level package directory file */
         SetSecurity (Scratch, 0,
                      OwnerUic,
                      PackageSecurity[cnt].Protection,
                      PackageSecurity[cnt].DirectoryFileAcl);

         if (PackageSecurity[cnt].WwwHidden)
         {
            sprintf (Scratch, "HT_ROOT:[%s].WWW_HIDDEN;",
                     PackageSecurity[cnt].DirectoryName);
            fptr = fopen (Scratch, "r");
            if (!fptr) fptr = fopen (Scratch, "w");
            if (!fptr) exit (vaxc$errno);
            fclose (fptr);
         }
         return (SS$_NORMAL);
      }
   }

   SetSecurity (FileName, FileNameLength,
                OwnerUic,
                PackageSecurity[idx].Protection,
                SpecialFile == FILE_DIR
                   ? PackageSecurity[idx].DirectoryFileAcl
                   : PackageSecurity[idx].DirectoryContentsAcl);

   return (SS$_NORMAL);
}

/*****************************************************************************/
/*
Apply the supplied security settings (owner, protection, ACL) to the specified
file.  Any or all of these can be supplied.  Qualifiers used on the command
line are used to determine behaviour.
*/

int SetSecurity
(
char *FileName,
int FileNameLength,
unsigned long OwnerUic,
unsigned short ProtectionMask,
char *AclString
)
{
   static unsigned short  Length,
                          OssProtection;
   static unsigned long  OssOwner;
   static char  AceBinary [256];
   static $DESCRIPTOR (FileNameDsc, "");
   static $DESCRIPTOR (AceBinaryDsc, AceBinary);
   static $DESCRIPTOR (AceStringDsc, "");
   static struct {
      unsigned short  buf_len;
      unsigned short  item;
      unsigned char   *buf_addr;
      unsigned long  *long_ret_len;
   }
   OssDeleteAllItems [] =
   {
      { 0, OSS$_ACL_DELETE_ALL, 0, 0 },
      {0,0,0,0}
   },
   OssOwnerItems [] =
   {
      { sizeof(OssOwner), OSS$_OWNER, (unsigned char*)&OssOwner, 0 },
      {0,0,0,0}
   },
   OssProtectionItems [] =
   {
      { sizeof(OssProtection), OSS$_PROTECTION,
        (unsigned char*)&OssProtection, 0 },
      {0,0,0,0}
   },
   OssAclAddEntryItems [] =
   {
      { 0, OSS$_ACL_ADD_ENTRY, (unsigned char*)AceBinary, 0 },
      {0,0,0,0}
   };

   int  status;
   unsigned long  Context;
   unsigned short  ErrorPos;
   char  *cptr;
      
   /*********/
   /* begin */
   /*********/

   if (Debug)
      fprintf (stdout, "SetSecurity() %d |%s| %08.08X %04.04X |%s|\n",
               FileNameLength, FileName, OwnerUic, ProtectionMask,
               AclString ? AclString : "(null)");

   if (!FileNameLength) FileNameLength = strlen(FileName);
   FileNameDsc.dsc$a_pointer = FileName;
   FileNameDsc.dsc$w_length = FileNameLength;

   if (CliCheck)
   {
      fprintf (stdout, "SET SECURITY %s %08.08X %04.04X%s%s\n",
               FileName, OwnerUic, ProtectionMask,
               AclString ? " /ACL=" : "", AclString);
      return (SS$_NORMAL);
   }

   if (CliLog) fprintf (stdout, "%s\n", FileName);

   Context = 0;

   if (OwnerUic)
   {
      /* set ownership */
      OssOwner = OwnerUic;
      status = sys$set_security (&ClassNameDsc, &FileNameDsc, 0, 0,
                                 &OssOwnerItems, &Context, &AccessMode);
      if (Debug) fprintf (stdout, "sys$set_security() %%X%08.08X\n", status);
      if (VMSnok (status))
      {
         fprintf (stdout, "%%%s-E-OWNER, %s\n", Utility, FileName);
         exit (status);
      }
   }

   if (ProtectionMask)
   {
      /* set protection */
      OssProtection = ProtectionMask;
      status = sys$set_security (&ClassNameDsc, &FileNameDsc, 0, 0,
                                 &OssProtectionItems, &Context, &AccessMode);
      if (Debug) fprintf (stdout, "sys$set_security() %%X%08.08X\n", status);
      if (VMSnok (status))
      {
         fprintf (stdout, "%%%s-E-PROTECTION, %s\n", Utility, FileName);
         exit (status);
      }
   }

   if (CliDelete || CliPackage || CliAclPtr)
   {
      /* delete currect ACL */
      status = sys$set_security (&ClassNameDsc, &FileNameDsc, 0, 0,
                                 &OssDeleteAllItems, &Context, &AccessMode);
      if (Debug) fprintf (stdout, "sys$set_security() %%X%08.08X\n", status);
      if (VMSnok (status))
      {
         fprintf (stdout, "%%%s-E-DELACL, %s\n", Utility, FileName);
         exit (status);
      }
   }

   if (CliDelete || !AclString || !AclString[0])
   {
      /* release the context */
      sys$get_security (0, 0, 0, OssRelCtx, 0, &Context, &AccessMode);

      return (status);
   }

   cptr = AclString;
   while (*cptr)
   {
      /* parse and add the ACE */
      while (*cptr && *cptr != '(') cptr++;
      while (*(unsigned short*)cptr == '((') cptr++;
      AceStringDsc.dsc$a_pointer = cptr;
      while (*cptr && *cptr != ')') cptr++;
      if (*cptr) cptr++;
      AceStringDsc.dsc$w_length = cptr - AceStringDsc.dsc$a_pointer;
      while (*cptr == ')') cptr++;
      if (Debug)
         fprintf (stdout, "|%*.*s|\n",
                  AceStringDsc.dsc$w_length, AceStringDsc.dsc$w_length,
                  AceStringDsc.dsc$a_pointer);

      status = sys$parse_acl (&AceStringDsc, &AceBinaryDsc, &ErrorPos, 0, 0);
      if (Debug) fprintf (stdout, "sys$parse_acl() %%X%08.08X\n", status);
      if (VMSnok (status))
      {
         fprintf (stdout, "%%%s-E-PARSEACL, %*.*s\n",
                  Utility,
                  AceStringDsc.dsc$w_length, AceStringDsc.dsc$w_length,
                  AceStringDsc.dsc$a_pointer);
         exit (status);
      }

      OssAclAddEntryItems[0].buf_len = AceBinary[0];
      status = sys$set_security (&ClassNameDsc, &FileNameDsc, 0, 0,
                                 &OssAclAddEntryItems, &Context, &AccessMode);
      if (Debug) fprintf (stdout, "sys$set_security() %%X%08.08X\n", status);
      if (VMSnok (status))
      {
         fprintf (stdout, "%%%s-E-ADDACLENTRY, %s\n", Utility, FileName);
         exit (status);
      }
   }

   /* release the context */
   sys$get_security (0, 0, 0, OssRelCtx, 0, &Context, &AccessMode);

   return (status);
}

/*****************************************************************************/
/*
This function can check for a WASD_IGNORE_THIS ACE, can add one if not present,
and can delete any that are present.  Returns an appropriate VMS status.
*/

int SetCheckIgnore
(
char *FileName,
int FileNameLength
)
{
   static unsigned short  Length;
   static unsigned char  AclReadEntry [256];
   static char  AceBinary [256];
   static $DESCRIPTOR (AceBinaryDsc, AceBinary);
   static $DESCRIPTOR (AceStringDsc, "");
   static $DESCRIPTOR (FileNameDsc, "");
   static struct {
      unsigned short  buf_len;
      unsigned short  item;
      unsigned char   *buf_addr;
      unsigned short  *short_ret_len;
   }
   GetSecFindNextItems [] =
   {
      { 0, OSS$_ACL_FIND_NEXT, 0, 0 },
      {0,0,0,0}
   },
   GetSecReadEntryItems [] =
   {
      { sizeof(AclReadEntry), OSS$_ACL_READ_ENTRY, AclReadEntry, &Length },
      {0,0,0,0}
   },
   GetSecPositionTopItems [] =
   {
      { 0, OSS$_ACL_POSITION_TOP, 0, 0 },
      {0,0,0,0}
   },
   OssAclAddEntryItems [] =
   {
      { 0, OSS$_ACL_ADD_ENTRY, (unsigned char*)AceBinary, 0 },
      {0,0,0,0}
   },
   OssAclDeleteEntryItems [] =
   {
      { 0, OSS$_ACL_DELETE_ENTRY, 0, 0 },
      {0,0,0,0}
   };

   int  status;
   unsigned short  ErrorPos;
   unsigned long  AceAccess,
                  AceFlags,
                  AceIdent,
                  AceLength,
                  AceReserved,
                  AceType,
                  Context,
                  OssWriteLock;
   unsigned char  *aptr;

   /*********/
   /* begin */
   /*********/

   if (Debug)
      fprintf (stdout, "SetCheckIgnore() %d |%s|\n", FileNameLength, FileName);

   if (!FileNameLength) FileNameLength = strlen(FileName);
   FileNameDsc.dsc$a_pointer = FileName;
   FileNameDsc.dsc$w_length = FileNameLength;

   if (CliSetIgnore || CliSetNoIgnore)
      OssWriteLock = OSS$M_WLOCK;
   else
      OssWriteLock = 0;

   Context = 0;

   for (;;)
   {
      status = sys$get_security (&ClassNameDsc, &FileNameDsc, 0, OssWriteLock,
                                 &GetSecFindNextItems, &Context, &AccessMode);
      if (Debug) fprintf (stdout, "FIND_NEXT %%X%08.08X\n", status);
      if (VMSnok (status)) break;
      status = sys$get_security (0, 0, 0, 0,
                                 &GetSecReadEntryItems, &Context, &AccessMode);
      if (Debug)
         fprintf (stdout, "READ_ENTRY %%X%08.08X %d\n",
                  status, AclReadEntry[0]); 
      if (VMSnok (status)) break;

      aptr = AclReadEntry;
      AceLength = *aptr++;
      AceType = *aptr++;
      AceFlags = *(unsigned short*)aptr;
      aptr += 2;
      AceAccess = *(unsigned long*)aptr;
      aptr += 4;
      AceReserved = AceFlags & 0x000f;
      aptr += AceReserved * 4;
      AceIdent = *(unsigned long*)aptr;
      if (Debug)
         fprintf (stdout,
"AceLength:%d AceType:%d AceFlags:%d AceAccess:%d AceReserved:%d AceIdent:%08.08X\n",
                  AceLength, AceType, AceFlags,
                  AceAccess, AceReserved, AceIdent);

      if (AceIdent != IgnoreId) continue;

      /**************/
      /* found one! */
      /**************/

      if (CliSetNoIgnore)
      {
         /******************/
         /* delete the ACE */
         /******************/

         status = sys$set_security (0, 0, 0, 0, &OssAclDeleteEntryItems,
                                    &Context, &AccessMode);
         if (Debug) fprintf (stdout, "sys$set_security() %%X%08.08X\n", status);
         if (VMSnok (status))
         {
            fprintf (stdout, "%%%s-E-DELACLENTRY, %s\n", Utility, FileName);
            exit (status);
         }
         /* shouldn't be more that one of these, but check anyway */
         continue;
      }

      /***************/
      /* ignore file */
      /***************/

      status = SS$_NORMAL;
      break;
   }

   /* if there was a matching ACE, or we're not setting such an ACE */
   if (VMSok(status) || !CliSetIgnore)
   {
      /* release the context */
      sys$get_security (0, 0, 0, OssRelCtx, 0, &Context, &AccessMode);
      return (status);
   }

   /***********************/
   /* add an 'ignore' ACE */
   /***********************/

   if (!AceStringDsc.dsc$w_length)
   {
      AceStringDsc.dsc$a_pointer = ACE_IGNORE_THIS;
      AceStringDsc.dsc$w_length = strlen(AceStringDsc.dsc$a_pointer);

      status = sys$parse_acl (&AceStringDsc, &AceBinaryDsc, &ErrorPos, 0, 0);
      if (Debug) fprintf (stdout, "sys$parse_acl() %%X%08.08X\n", status);
      if (VMSnok (status))
      {
         fprintf (stdout, "%%%s-E-PARSEACL, %*.*s\n", Utility,
                  AceStringDsc.dsc$w_length, AceStringDsc.dsc$w_length,
                  AceStringDsc.dsc$a_pointer);
         exit (status);
      }
      OssAclAddEntryItems[0].buf_len = AceBinary[0];
   }

   status = sys$set_security (&ClassNameDsc, &FileNameDsc, 0, 0,
                              &OssAclAddEntryItems, &Context, &AccessMode);
   if (Debug) fprintf (stdout, "sys$set_security() %%X%08.08X\n", status);
   if (VMSnok (status))
   {
      fprintf (stdout, "%%%s-E-ADDACLENTRY, %s\n", Utility, FileName);
      exit (status);
   }

   /* release the context */
   sys$get_security (0, 0, 0, OssRelCtx, 0, &Context, &AccessMode);

   return (status);
}

/*****************************************************************************/
/*
Get the value of right identifier 'IdentName' into the storage pointed to
'IdentValuePtr'.  If the identifier does not currently exist then create it.
*/

int GetIdent
(
char *IdentName,
unsigned long *IdentValuePtr,
BOOL CreateIfNeeded
)
{
   static unsigned short  Length;
   static unsigned long  IgnoreId;
   static $DESCRIPTOR (IdentNameDsc, "");

   int  status;

   /*********/
   /* begin */
   /*********/

   if (Debug) fprintf (stdout, "GetIdent() |%s|\n", IdentName);

   IdentNameDsc.dsc$a_pointer = IdentName;
   IdentNameDsc.dsc$w_length = strlen(IdentName);
   status = sys$asctoid (&IdentNameDsc, IdentValuePtr, 0);
   if (Debug)
      fprintf (stdout, "sys$asctoid() %%X%08.08X %08.08X\n",
               status, *IdentValuePtr);

   if (VMSok (status) || !CreateIfNeeded) return (status);

   status = sys$add_ident (&IdentNameDsc, 0, 0, IdentValuePtr);
   if (Debug) fprintf (stdout, "sys$add_ident() %%X%08.08X\n", status);
   if (VMSok (status))
   {
      fprintf (stdout,
"%%%s-I-RDBADDMSG, identifier %s value %08.08X added to rights database\n",
               Utility, IdentName, *IdentValuePtr);
      return (status);
   }

   fprintf (stdout,
"%%%s-E-RDBADDERRU, unable to add %s to rights database\n",
            Utility, IdentName);
   exit (status);
}

/*****************************************************************************/
/*
For the specified username get various UAI fields from the SYSUAF and create
global symbols containing this content.  Intended as utility function during
package installation and security profiling.
*/

int GetUai (char *UserName)

{
   static unsigned long  Context = -1;
   static unsigned long  UaiUic;
   static char  UaiDefDev [31+1],
                UaiDefDir [63+1];

   static struct {
      short BufferLength;
      short ItemCode;
      void  *BufferPtr;
      void  *LengthPtr;
   } UaiItems [] = 
   {
      { sizeof(UaiUic), UAI$_UIC, &UaiUic, 0 },
      { sizeof(UaiDefDev), UAI$_DEFDEV, &UaiDefDev, 0 },
      { sizeof(UaiDefDir), UAI$_DEFDIR, &UaiDefDir, 0 },
      { 0, 0, 0, 0 }
   };

   int  cnt, status;
   char  *cptr, *sptr, *tptr, *zptr;
   char  UserHome [96],
         UserHomeDir [128],
         UserUic [16];
   $DESCRIPTOR (UserNameDsc, "");
   $DESCRIPTOR (UserUicDsc, UserUic);
   $DESCRIPTOR (UserUicFaoDsc, "!%U\0");

   /*********/
   /* begin */
   /*********/

   if (Debug) fprintf (stdout, "GetUai() |%s|\n", UserName);

   DeleteGlobalSymbol ("SECHAN_DEFDEV");
   DeleteGlobalSymbol ("SECHAN_DEFDIR");
   DeleteGlobalSymbol ("SECHAN_HOME");
   DeleteGlobalSymbol ("SECHAN_HOME_DIR");
   DeleteGlobalSymbol ("SECHAN_UIC");
   DeleteGlobalSymbol ("SECHAN_VERSION");

   if (!UserName || !UserName[0]) return (SS$_NORMAL);

   for (cptr = UserName; *cptr; cptr++) *cptr = toupper(*cptr);
   UserNameDsc.dsc$w_length = cptr - UserName;
   UserNameDsc.dsc$a_pointer = UserName;

   status = sys$getuai (0, &Context, &UserNameDsc, &UaiItems, 0, 0, 0);
   if (VMSnok(status)) exit (status | STS$M_INHIB_MSG);

   /* generate a DKA100:[USER.DANIEL] from DKA100: and [USER.DANIEL] */
   zptr = (sptr = UserHome) + sizeof(UserHome);
   cnt = UaiDefDev[0];
   for (cptr = UaiDefDev+1; cnt && sptr < zptr; cnt--) *sptr++ = *cptr++;
   *cptr = '\0';
   cnt = UaiDefDir[0];
   for (cptr = UaiDefDir+1; cnt && sptr < zptr; cnt--) *sptr++ = *cptr++;
   if (sptr >= zptr) exit (SS$_RESULTOVF);
   *sptr = *cptr = '\0';
   if (Debug) fprintf (stdout, "UserHome |%s|\n", UserHome);

   /* generate a DKA100:[USER]DANIEL.DIR from DKA100:[USER.DANIEL] */
   zptr = (sptr = UserHomeDir) + sizeof(UserHomeDir);
   cnt = 0;
   for (cptr = UserHome; *cptr; cptr++)
      if (*cptr == '.') cnt++;
   cptr = UserHome;
   while (*cptr && *cptr != ':' && sptr < zptr) *sptr++ = *cptr++;
   if (*cptr && sptr < zptr) *sptr++ = *cptr++;
   if (*cptr && sptr < zptr) *sptr++ = *cptr++;
   if (cnt)
   {
      while (cnt--)
      {
         while (*cptr && *cptr != '.' && sptr < zptr) *sptr++ = *cptr++;
         if (*cptr) cptr++;
         if (sptr < zptr) *sptr++ = ']';
         while (*cptr && *cptr != ']' && sptr < zptr) *sptr++ = *cptr++;
      }
   }
   else
   {
      tptr = "000000]";
      while (*tptr && sptr < zptr) *sptr++ = *tptr++;
      while (*cptr && *cptr != ']' && sptr < zptr) *sptr++ = *cptr++;
   }
   tptr = ".DIR";
   while (*tptr && sptr < zptr) *sptr++ = *tptr++;
   if (sptr >= zptr) exit (SS$_RESULTOVF);
   *sptr = '\0';
   if (Debug) fprintf (stdout, "UserHomeDir |%s|\n", UserHomeDir);

   status = sys$fao (&UserUicFaoDsc, NULL, &UserUicDsc, UaiUic);
   if (VMSnok(status)) exit (status);

   status = SetGlobalSymbol ("SECHAN_DEFDEV", UaiDefDev+1);
   if (VMSnok(status)) exit (status);
   status = SetGlobalSymbol ("SECHAN_DEFDIR", UaiDefDir+1);
   if (VMSnok(status)) exit (status);
   status = SetGlobalSymbol ("SECHAN_HOME", UserHome);
   if (VMSnok(status)) exit (status);
   status = SetGlobalSymbol ("SECHAN_HOME_DIR", UserHomeDir);
   if (VMSnok(status)) exit (status);
   status = SetGlobalSymbol ("SECHAN_UIC", UserUic);
   if (VMSnok(status)) exit (status);
   status = SetGlobalSymbol ("SECHAN_VERSION", SOFTWAREID);
   if (VMSnok(status)) exit (status);

   return (SS$_NORMAL);
}

/*****************************************************************************/
/*
Provide a progress line when Control-T is pressed.
*/

void ControlT (char ch)

{
   static unsigned short  SysOutChan;
   static unsigned long  ControlTMask [2] = { 0, 0x00100000 };
   static $DESCRIPTOR (SysOutputDsc, "SYS$OUTPUT");
   static long  Pid = -1;
   static unsigned long  JpiMode;

   static struct
   {
      unsigned short  buf_len;
      unsigned short  item;
      void  *buf_addr;
      void  *ret_len;
   }
      JpiItems [] =
   {
      { sizeof(JpiMode), JPI$_MODE, &JpiMode, 0 },
      {0,0,0,0}
   };

   int  status;

   /*********/
   /* begin */
   /*********/

   if (Debug) fprintf (stdout, "ControlT() %d\n", ch);

   if (ch)
   {
      if (ControlTFileNamePtr)
         fprintf (stdout, "%d %s\n", ProgressCount, ControlTFileNamePtr);
      return;
   }

   status = sys$getjpiw (0, &Pid, 0, &JpiItems, 0, 0, 0);
   if (VMSnok (status)) exit (status);
   if (JpiMode != JPI$K_INTERACTIVE) return;

   status = sys$assign (&SysOutputDsc, &SysOutChan, 0, 0);
   if (VMSnok(status)) exit (status);

   status = sys$qiow (0, SysOutChan, IO$_SETMODE | IO$M_OUTBAND,
                      0, 0, 0, &ControlT, &ControlTMask, 3, 0, 0, 0);
   if (VMSnok(status)) exit (status);
}

/*****************************************************************************/
/*
Get "command-line" parameters, whether from the command-line or from a
configuration symbol or logical containing the equivalent.
*/

GetParameters ()

{
   static char  CommandLine [256];
   static unsigned long  Flags = 0;

   register char  *aptr, *cptr, *clptr, *sptr;

   int  status;
   unsigned short  Length;
   char  ch;
   $DESCRIPTOR (CommandLineDsc, CommandLine);

   /*********/
   /* begin */
   /*********/

   if (Debug) fprintf (stdout, "GetParameters()\n");

   if (!(clptr = getenv ("SECHAN$PARAM")))
   {
      /* get the entire command line following the verb */
      if (VMSnok (status =
          lib$get_foreign (&CommandLineDsc, 0, &Length, &Flags)))
         exit (status);
      (clptr = CommandLine)[Length] = '\0';
   }

   aptr = NULL;
   ch = *clptr;
   for (;;)
   {
      if (aptr && *aptr == '/') *aptr = '\0';
      if (!ch) break;

      *clptr = ch;
      if (Debug) fprintf (stdout, "clptr |%s|\n", clptr);
      while (*clptr && isspace(*clptr)) *clptr++ = '\0';
      aptr = clptr;
      if (*clptr == '/') clptr++;
      while (*clptr && !isspace (*clptr) && *clptr != '/')
      {
         if (*clptr != '\"')
         {
            clptr++;
            continue;
         }
         cptr = clptr;
         clptr++;
         while (*clptr)
         {
            if (*clptr == '\"')
               if (*(clptr+1) == '\"')
                  clptr++;
               else
                  break;
            *cptr++ = *clptr++;
         }
         *cptr = '\0';
         if (*clptr) clptr++;
      }
      ch = *clptr;
      if (*clptr) *clptr = '\0';
      if (Debug) fprintf (stdout, "aptr |%s|\n", aptr);
      if (!*aptr) continue;

      if (strsame (aptr, "/ACL=", 4))
      {
         for (cptr = aptr; *cptr && *cptr != '='; cptr++);
         if (*cptr) cptr++;
         CliAclPtr = cptr;
         continue;
      }

      if (strsame (aptr, "/ALL", 4))
      {
         CliAllFiles = true;
         continue;
      }

      if (strsame (aptr, "/ASIF=", 4))
      {
         for (cptr = aptr; *cptr && *cptr != '='; cptr++);
         if (*cptr) cptr++;
         CliAsIfPtr = cptr;
         continue;
      }

      if (strsame (aptr, "/CHECK", -1))
      {
         CliCheck = true;
         continue;
      }

      if (strsame (aptr, "/CONTROL", 4))
      {
         CliSetControl = true;
         CliSetRead = false;
         CliSetWrite = false;
         continue;
      }

      if (strsame (aptr, "/DBUG", -1))
      {
         Debug = true;
         continue;
      }

      if (strsame (aptr, "/DELETE", 4))
      {
         CliDelete = true;
         continue;
      }

      if (strsame (aptr, "/EXCEPTIONAL", 4))
      {
         CliExceptionalFiles = CliPackage = true;
         continue;
      }

      if (strsame (aptr, "/FIND=", 4))
      {
         for (cptr = aptr; *cptr && *cptr != '='; cptr++);
         if (*cptr) cptr++;
         CliFindPtr = cptr;
         continue;
      }

      if (strsame (aptr, "/GETUAI", 4))
      {
         CliGetUai = true;
         continue;
      }

      if (strsame (aptr, "/IDENTIFIERS", 4))
      {
         CliIdentifiers = true;
         continue;
      }

      if (strsame (aptr, "/LOG", -1))
      {
         CliLog = true;
         continue;
      }

      if (strsame (aptr, "/IGNORE", 4))
      {
         CliSetIgnore = true;
         CliSetNoIgnore = false;
         continue;
      }
      if (strsame (aptr, "/NOIGNORE", 6))
      {
         CliSetNoIgnore = true;
         CliSetIgnore = false;
         continue;
      }

      if (strsame (aptr, "/NOBODY", 4))
      {
         CliSetNobody = true;
         CliSetServer = false;
         continue;
      }

      if (strsame (aptr, "/NOSCRIPT", 6))
      {
         CliNoScript = true;
         continue;
      }

      if (strsame (aptr, "/OWNER=", 4))
      {
         for (cptr = aptr; *cptr && *cptr != '='; cptr++);
         if (*cptr) cptr++;
         CliOwnerPtr = cptr;
         continue;
      }

      if (strsame (aptr, "/PACKAGE", 4))
      {
         CliPackage = true;
         continue;
      }

      if (strsame (aptr, "/PROGRESS", 4))
      {
         CliProgress = true;
         continue;
      }

      if (strsame (aptr, "/READ", 4))
      {
         CliSetRead = true;
         CliSetWrite = false;
         CliSetControl = false;
         continue;
      }

      if (strsame (aptr, "/SERVER", 4))
      {
         CliSetServer = true;
         CliSetNobody = false;
         continue;
      }

      if (strsame (aptr, "/WRITE", 4))
      {
         CliSetWrite = true;
         CliSetRead = false;
         CliSetControl = false;
         continue;
      }

      if (strsame (aptr, "/VERSION", 4))
      {
          fprintf (stdout, "%%%s-I-SOFTWAREID, %s\n%s",
                   Utility, SOFTWAREID, CopyrightInfo);
          exit (SS$_NORMAL);
      }

      if (strsame (aptr, "/WORLD", 4))
      {
         CliWorldAccess = true;
         continue;
      }
      if (strsame (aptr, "/NOWORLD", 6))
      {
         CliNoWorldAccess = true;
         continue;
      }

      if (*aptr == '/')
      {
         fprintf (stdout, "%%%s-E-IVQUAL, unrecognized qualifier\n \\%s\\\n",
                  Utility, aptr+1);
         exit (STS$K_ERROR | STS$M_INHIB_MSG);
      }

      if (!CliParam1Ptr)
      {
         CliParam1Ptr = aptr;
         continue;
      }

      fprintf (stdout, "%%%s-E-MAXPARM, too many parameters\n \\%s\\\n",
               Utility, aptr);
      exit (STS$K_ERROR | STS$M_INHIB_MSG);
   }
}

/*****************************************************************************/
/*
Translate the logical name HT_ROOT, generate a parent directory, append the
string HT_ROOT.DIR, and return a pointer to the resultant file specification.
*/

char* HtRootDir ()

{
   static unsigned short  Length;
   static char  LogicalValue [256];
   static $DESCRIPTOR (LogicalNameDsc, "HT_ROOT");
   static $DESCRIPTOR (LnmFileDevDsc, "LNM$FILE_DEV");
   static struct {
      short int  buf_len;
      short int  item;
      void  *buf_addr;
      unsigned short  *ret_len;
   } LnmItems [] =
   {
      { sizeof(LogicalValue)-1, LNM$_STRING, LogicalValue, &Length },
      { 0,0,0,0 }
   };

   int  status;
   char  *cptr;

   /*********/
   /* begin */
   /*********/

   if (Debug) fprintf (stdout, "HtRootDir()\n");

   status = sys$trnlnm (0, &LnmFileDevDsc, &LogicalNameDsc, 0, &LnmItems);
   if (Debug) fprintf (stdout, "sys$trnlnm() %%X%08.08X\n", status);
   if (VMSnok (status)) return (NULL);

   LogicalValue[Length] = '\0';
   if (Debug) fprintf (stdout, "|%s|\n", LogicalValue);
   cptr = LogicalValue + Length;
   while (cptr > LogicalValue && *cptr != ']') cptr--;
   if (cptr > LogicalValue && *cptr == ']') cptr--;
   if (cptr > LogicalValue && *cptr == '.') cptr--;
   while (cptr > LogicalValue && *cptr != '[' && *cptr != '.') cptr--;
   if (*cptr == '[')
      strcpy (cptr, "[000000]HT_ROOT.DIR");
   else
   if (*cptr == '.')
      strcpy (cptr, "]HT_ROOT.DIR");
   else
      exit (SS$_BUGCHECK);
   return (LogicalValue);
}

/****************************************************************************/
/*
Delete a global symbol.
*/ 

int DeleteGlobalSymbol (char *Name)

{
   static int  GlobalSymbol = LIB$K_CLI_GLOBAL_SYM;
   static $DESCRIPTOR (NameDsc, "");

   int  status;

   /*********/
   /* begin */
   /*********/

   if (Debug) fprintf (stdout, "DeleteGlobalSymbol() |%s|\n", Name);

   NameDsc.dsc$a_pointer = Name;
   NameDsc.dsc$w_length = strlen(Name);

   status = lib$delete_symbol (&NameDsc, &GlobalSymbol);
   return (status);
}

/****************************************************************************/
/*
Assign a global symbol.
*/ 

int SetGlobalSymbol
(
char *Name,
char *String
)
{
   static int  GlobalSymbol = LIB$K_CLI_GLOBAL_SYM;
   static $DESCRIPTOR (NameDsc, "");
   static $DESCRIPTOR (ValueDsc, "");

   int  status;

   /*********/
   /* begin */
   /*********/

   if (Debug) fprintf (stdout, "SetGlobalSymbol() |%s|%s|\n", Name, String);

   NameDsc.dsc$a_pointer = Name;
   NameDsc.dsc$w_length = strlen(Name);
   ValueDsc.dsc$a_pointer = String;
   ValueDsc.dsc$w_length = strlen(String);

   status = lib$set_symbol (&NameDsc, &ValueDsc, &GlobalSymbol);
   return (status);
}

/****************************************************************************/
/*
Return an integer reflecting the major and minor version of VMS (e.g. 60, 61,
62, 70, 71, 72, etc.)
*/ 

#ifdef ODS_EXTENDED

int GetVmsVersion ()

{
   static char  SyiVersion [16];

   static struct {
      short int  buf_len;
      short int  item;
      void  *buf_addr;
      unsigned short  *ret_len;
   }
   SyiItems [] =
   {
      { 8, SYI$_VERSION, &SyiVersion, 0 },
      { 0,0,0,0 }
   };

   int  status,
        version;

   /*********/
   /* begin */
   /*********/

   if (Debug) fprintf (stdout, "GetVmsVersion()\n");

   if (VMSnok (status = sys$getsyiw (0, 0, 0, &SyiItems, 0, 0, 0)))
      exit (status);
   SyiVersion[8] = '\0';
   version = ((SyiVersion[1]-48) * 10) + (SyiVersion[3]-48);
   if (Debug) fprintf (stdout, "|%s| %d\n", SyiVersion, version);
   return (version);
}

#endif /* ODS_EXTENDED */

/****************************************************************************/
/*
Does a case-insensitive, character-by-character string compare and returns 
true if two strings are the same, or false if not.  If a maximum number of 
characters are specified only those will be compared, if the entire strings 
should be compared then specify the number of characters as 0.
*/ 
 
BOOL strsame
(
char *sptr1,
char *sptr2,
int  count
)
{
   /*********/
   /* begin */
   /*********/

   if (Debug) fprintf (stdout, "strsame() |%s|%s| %d\n", sptr1, sptr2, count);

   while (*sptr1 && *sptr2)
   {
      if (toupper (*sptr1++) != toupper (*sptr2++)) return (false);
      if (count)
         if (!--count) return (true);
   }
   if (*sptr1 || *sptr2)
      return (false);
   else
      return (true);
}
 
/*****************************************************************************/

