$!-----------------------------------------------------------------'f$verify(0)
$! ACCOUNTS.COM
$!
$! Creates or modifies the HTTP$SERVER and HTTP$NOBODY accounts.
$!
$! P1..P3   "INSTALL"            called from INSTALL.COM
$! P1..P3   "SERVER=<string>"    specifying the server account username
$! P1..P3   "NOBODY=<string>"    specifying the scripting account username
$!
$! 28-MAY-2016  MGD  v1.8, ensure LOGIN.COM exists even if account unmodified
$! 07-NOV-2009  MGD  v1.7, v10 logical naming schema
$! 30-MAR-2009  MGD  V1.6, bugfix; account modification line lengths (VAX)
$! 27-MAR-2008  MGD  V1.5, bugfix; apostrophe (thanks TP)
$! 25-JAN-2008  MGD  v1.4, bugfix; substitution of account names
$! 02-OCT-2007  MGD  v1.3, bugfix; clear scripting account using NOALL too!
$! 05-OCT-2006  MGD  v1.2, clear any extra privileges first with NOALL
$! 04-SEP-2005  MGD  v1.1, bugfix; .WWW_HIDDEN in account default directory
$! 13-JUN-2005  MGD  v1.1, up HTTP$SERVER BYTLM from 500000 to 5000000
$! 01-NOV-2002  MGD  v1.0, initial
$!-----------------------------------------------------------------------------
$!
$ if f$trnlnm("INSTALL$DBUG") .nes. "" then set verify
$ ss$_abort = 44
$ ss$_bugcheck = 676
$ delete = "delete"
$ say = "write sys$output"
$ vms_version = f$integer(f$extract(1,1,f$getsyi("version"))) * 10 +-
                f$integer(f$extract(3,1,f$getsyi("version")))
$ if vms_version .ge. 72 then set process /parse=traditional
$ on controly then exit ss$_abort
$!
$ if f$environment("depth") .eq. 1
$ then
$    type sys$input

      WASD VMS Web Services, Copyright (C) 1996-2020 Mark G.Daniel.
  This package (all associated programs), 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 3, or any later version.
                    http://www.gnu.org/licenses/gpl.txt

$ endif
$!
$!(if called by INSTALL.COM to create required accounts)
$ install = 0
$ if p1 .eqs. "INSTALL" then install = 1
$!
$ @WASD_ROOT:[INSTALL]SECHAN.COM
$!
$!(run SECHAN to ensure the three required rights identifiers exist)
$ sechan /identifiers
$!
$ if install
$ then
$!   (defaults for package installation)
$    http$server_username == "HTTP$SERVER"
$    http$nobody_username == "HTTP$NOBODY"
$ else
$!   (try to establish the current usernames)
$    http$server_username == ""
$    http$nobody_username == ""
$ endif
$!
$ http$server_device == "WASD_ROOT:"
$ http$server_uic == "[077,1]"
$!
$ http$nobody_device == "WASD_ROOT:"
$ http$nobody_uic == "[076,1]"
$!
$ if http$server_username .eqs. ""
$ then
$    @WASD_ROOT:[INSTALL]USERNAMES "''p1'" "''p2'" "''p3'"
$    if .not. $status then exit $status
$ endif
$!
$ current_default = f$environment("default")
$!
$ set noon
$ sechan /getuai "''http$server_username'" 
$ set on
$ type sys$input
                     **********************************
                     *  CREATE/MODIFY SERVER ACCOUNT  *
                     **********************************

$ say "The 'server' account ''http$server_username' is the one the HTTPd process executes as."
$ type sys$input
It is considered a security advantage to script using a different account.

It must have a unique UIC, preferably in a group of it's own.
DO NOT choose the SYSTEM group ([1,*]) or other privileged group, or [3nn,*]
which is reserved to OpenVMS!
$!
$ call get_account_uic "''http$server_username'" "''http$server_uic'"
$ http$server_uic == account_uic
$ delete /symbol /global account_uic
$ if http$server_uic .nes. ""
$ then
$    call get_account_device "''http$server_username'" "''http$server_device'"
$    http$server_device == account_device
$    delete /symbol /global account_device
$    if http$server_device .nes. ""
$    then
$       call account_http$server
$       call account_home "''http$server_username'" "''http$server_device'"
$    endif
$ endif
$ if f$search("''http$server_device'[''http$server_username'].WWW_HIDDEN") .eqs. "" -
     then create /log /owner='http$server_username' 'http$server_device'['http$server_username'].WWW_HIDDEN
$ sechan /package /asif='http$server_username' "''http$server_device'[''http$server_username']*.*;*"
$ call account_login_com "''http$server_username'" "''http$server_device'"
$ sechan /package /asif=SERVER-LOGIN.COM "''http$server_device'[''http$server_username']LOGIN.COM;*"
$ set noon
$ sechan /getuai "''http$server_username'" 
$ if .not. $status then exit $status .and. %x0fffffff
$ set on
$!
$ if http$server_username .nes. http$nobody_username
$ then
$    set noon
$    sechan /getuai "''http$nobody_username'" 
$    set on
$    type sys$input
                    *************************************
                    *  CREATE/MODIFY SCRIPTING ACCOUNT  *
                    *************************************

$    say "The 'scripting' account ''http$nobody_username' is used for DCL & DECnet scripting."
$    type sys$input
It is considered a security advantage to script using an account different to
that used for the HTTPd server.

It must have a unique UIC, preferably in a group of it's own.
DO NOT choose the SYSTEM group ([1,*]) or other privileged group, or [3nn,*]
which is reserved to OpenVMS!
$!
$    call get_account_uic "''http$nobody_username'" "''http$nobody_uic'"
$    http$nobody_uic == account_uic
$    if http$nobody_uic .nes. ""
$    then
$       call get_account_device "''http$nobody_username'" "''http$nobody_device'"
$       http$nobody_device == account_device
$       if http$nobody_device .nes. ""
$       then
$          call account_http$nobody
$          call account_home "''http$nobody_username'" "''http$nobody_device'"
$       endif
$    else
$       if http$nobody_username .eqs. "" -
           then http$nobody_username == http$server_username
$    endif
$    if f$search("''http$nobody_device'[''http$nobody_username'].WWW_HIDDEN") .eqs. "" -
        then create /log /owner='http$nobody_username' 'http$nobody_device'['http$nobody_username'].WWW_HIDDEN
$    sechan /package /asif='http$nobody_username' "''http$nobody_device'[''http$nobody_username']*.*;*"
$    call account_login_com "''http$nobody_username'" "''http$nobody_device'"
$    sechan /package /asif=NOBODY-LOGIN.COM "''http$nobody_device'[''http$nobody_username']LOGIN.COM;*"
$ endif
$ set noon
$ sechan /getuai "''http$nobody_username'" 
$ if .not. $status then exit $status .and. %x0fffffff
$ set on
$!
$!(delete the symbols it created)
$ sechan /getuai
$ set default 'current_default'
$!
$    type sys$input
          ********************************************************
          *  GRANT WASD_HTTP_NOBODY TO OTHER SCRIPTING ACCOUNTS  *
          ********************************************************

If you have other accounts that script using files contained in the general
scripting areas ([CGI-BIN], [AXP-BIN], [IA64-BIN] or [VAX-BIN]) you almost
certainly will need to grant the WASD_HTTP_NOBODY rights identifer to allow
those accounts access to the files in the scripting directories.

If you use a scripting account (HTTP$NOBODY) separate to the server account
(HTTP$SERVER) you should never, and should never need to, grant the
WASD_HTTP_NOBODY identifier to the server account.  The idea is to isolate the
two environments as much as possible.
$!
$ current_default = f$environment("default")
$ grantLoop:
$    say ""
$    response = ""
$    read sys$command response /prompt="Account name? []: "
$    say ""
$    if response .eqs. "0" then response = ""
$    if response .eqs. "" then goto grantLoopEnd
$    set noon
$    set default sys$system
$    mcr authorize grant /ident WASD_HTTP_NOBODY 'response'
$    set on
$    set default 'current_default'
$    goto grantLoop
$ grantLoopEnd:
$!
$ exit
$!
$!-----------------------------------------------------------------------------
$!
$ GET_ACCOUNT_UIC: SUBROUTINE
$!
$! prompts for a UIC in the format [n,n]
$! P1 the account name
$! P2 the default UIC for the account
$! returns: global symbol ACCOUNT_UIC
$!
$ if p1 .eqs. "" then exit ss$_bugcheck
$ if p2 .eqs. "" then exit ss$_bugcheck
$ on controly then exit ss$_abort
$ current_default = f$environment("default")
$!
$ uic = ""
$!
$ get_account_uic_loop:
$    say ""
$    if f$type(sechan_uic) .eqs. ""
$    then
$       default_uic = p2
$       say "Note: ''default_uic' is a suggested UIC."
$       say "You will be shown whether the entered uic exists before continuing."
$    else
$       default_uic = sechan_uic
$       say "Note: ''default_uic' is the account's current UIC."
$       say "This can be changed if desired (''p2' is a suggested UIC)."
$       type sys$input

Continuing with this existing UIC will result in the account being modified
in-line with current WASD recommendations.  If a different UIC is entered this
will be modified also (this may require security settings on some resources to
be reviewed).  Any specific local requirements may need to be reviewed after
appying this procedure.

$ endif
$    type sys$input
Entering "NONE" OR "0" skips account creation/modification.

$    response = ""
$    read sys$command response /prompt="''default_uic': "
$    if response .eqs. "" then response = default_uic
$    response = f$edit(response,"upcase")
$    uic = response
$    if uic .eqs. "NONE" then uic = ""
$    if uic .eqs. "0" then uic = ""
$    if uic .eqs. "" then goto end_get_account_uic_loop
$    if f$extract(0,1,uic) .nes. "[" then uic = "[" + uic + "]"
$    set default sys$system
$    say ""
$    set noon
$    mcr authorize show /brief 'uic'
$    set on
$    say ""
$    set default 'current_default'
$    if f$type(sechan_uic) .eqs. ""
$    then
$       type sys$input
If no user matched the specification then the UIC is available!
Choices: YES, create the account using this UIC.  NO, select another.

$    else
$       type sys$input
Check the detail of the displayed account (if any).
Choices: YES, create/modify the account using this UIC.  NO, select another.

$    endif
$    response = ""
$    read sys$command response /prompt="[NO]: "
$    if .not. response then goto get_account_uic_loop
$ end_get_account_uic_loop:
$!
$ say ""
$ account_uic == uic
$ exit
$ endsubroutine
$!
$!-----------------------------------------------------------------------------
$!
$ GET_ACCOUNT_DEVICE: SUBROUTINE
$!
$! prompts for a disk device
$! P1 the account name
$! P2 should be the default device for the account
$! returns global symbol ACCOUNT_DEVICE
$!
$ if p1 .eqs. "" then exit ss$_bugcheck
$ if p2 .eqs. "" then exit ss$_bugcheck
$ on controly then exit ss$_abort
$ device = ""
$!
$ get_account_device_loop:
$    say "The server account ""''P1'"" must have a unique home directory."
$    type sys$input

The default is a reasonable location for most sites.

If another device is prefered or already in place, out of the package tree,
then that can be specified and used.  The directory name should remain as
$    say "[''p1'] however.  Package security settings are applied to this."
$    type sys$input

You will be shown whether the home area already exists before continuing.
Entering "NONE" OR "0" exits this dialog.

$    response = ""
$    read sys$command response /prompt="[''p2']: "
$    if response .eqs. "" then response = p2
$    response = f$edit(response,"upcase")
$    device = response
$    if device .eqs. "NONE" then device = ""
$    if device .eqs. "0" then device = ""
$    if device .eqs. "" then goto end_get_account_device_loop
$    device = device - ":" + ":"
$    define /user sys$output nl:
$    define /user sys$error nl:
$    directory = "directory"
$    set noon
$    directory 'device'[000000]'p1'.dir
$    status = $status
$    set on
$    if .not. status .and. status .ne. %x10018290
$    then
$       say ""
$       SAY "*** THERE IS A PROBLEM WITH THE SUPPLIED DEVICE NAME! ***"
$       SAY ""
$       set noon
$       directory 'device'[000000]'p1'.dir
$       set on
$       wait 'pause'
$       goto get_account_device_loop
$    endif
$    if .not. status
$    then
$       say ""
$       SAY "The area ''device'[''p1'] does NOT currently exist."
$       SAY "Use this, creating it if necessary?"
$       SAY ""
$    ELSE
$       SAY ""
$       SAY "The area ''device'[''p1'] currently exists."
$       SAY "Continue to use this?"
$       SAY ""
$    endif
$    response = ""
$    read sys$command response /prompt="[NO]: "
$    say ""
$    if .not. response then goto get_account_device_loop
$ end_get_account_device_loop:
$!
$ account_device == device
$ exit
$ endsubroutine
$!
$!-----------------------------------------------------------------------------
$!
$ ACCOUNT_HOME: SUBROUTINE
$!
$! create the directory if it does not already exist
$! P1 the account name
$! P2 should be the default device for the account
$!
$ if p1 .eqs. "" then exit ss$_bugcheck
$ if p2 .eqs. "" then exit ss$_bugcheck
$ on controly then exit ss$_abort
$!
$ define /user sys$output nl:
$ define /user sys$error nl:
$ directory = "directory"
$ set noon
$ directory 'p2'[000000]'p1'.dir
$ status = $status
$ set on
$ if .not. status .and. status .ne. %x10018290 then exit ss$_abort
$ if status then exit
$ set noon
$ create /log /directory 'p2'['p1'] /owner='p1'
$ status = $status
$ set on
$ if .not. status then exit ss$_abort
$!
$ set noon
$ show quota /disk=WASD_ROOT: /user='http$server_username'
$ quotastatus = $status
$ set on
$ if quotaStatus .eq. %x00003e4
$ then
$    tmp = "sys$scratch:install_accounts.tmp"
$    open /write tmpf 'tmp'
$    write tmpf "$ define /user sys$output nl:"
$    write tmpf "$ define /user sys$error nl:"
$    write tmpf "$ set noon"
$    write tmpf "$ mcr diskquota"
$    write tmpf "use ''p2'"
$    write tmpf "add ''p1' /permquota=100000"
$    write tmpf "$ mcr diskquota"
$    write tmpf "use ''p2'"
$    write tmpf "show ''p1'"
$    write tmpf "$ set on"
$    close tmpf
$    set noon
$    @'tmp'
$    if .not. $status then exit $status
$    set on
$    delete /nolog /noconfirm 'tmp';*
$ endif
$!
$ exit
$ endsubroutine
$!
$!-----------------------------------------------------------------------------
$!
$ ACCOUNT_LOGIN_COM: SUBROUTINE
$!
$! create the directory if it does not already exist
$! P1 the account name
$! P2 should be the default device for the account
$!
$ if p1 .eqs. "" then exit ss$_bugcheck
$ if p2 .eqs. "" then exit ss$_bugcheck
$ on controly then exit ss$_abort
$!
$ if f$search("''p2'[''p1']login.com") .nes. "" then exit
$!
$!(create an empty LOGIN.COM that a restricted account requires)
$ set noon
$ create /log 'p2'['p1']login.com
$ status = $status
$ set on
$ say ""
$ if .not. status then exit ss$_abort
$!
$ exit
$ endsubroutine
$!
$!-----------------------------------------------------------------------------
$!
$ ACCOUNT_HTTP$SERVER: SUBROUTINE
$!
$ on controly then exit ss$_abort
$!
$ current_default = f$environment("default")
$ set default sys$system
$ set noon
$ define /user sys$output nl:
$ define /user sys$error nl:
$ mcr authorize add 'http$server_username' /uic='http$server_uic'
$ status = $status
$ if status then say "''http$server_username' account created, setting ..."
$ if status .eq. %x13f1943a -
     then say "''http$server_username' account already existed, modifying ..."
$ if .not. status .and. status .ne. %x13f1943a then exit ss$_abort
$ mcr authorize modify 'http$server_username' -
/uic='http$server_uic' -
/device='http$server_device' -
/directory=['http$server_username'] -
/owner="WASD Server"
$ mcr authorize modify 'http$server_username' -
/cli=dcl -
/clitables=dcltables -
/lgicmd=LOGIN.COM -
/flags=(dismail,disnewmail,nodisuser)-
/network/batch/nolocal/nodialup/nointeractive -
/privileges=(noall,tmpmbx,netmbx) -
/defprivileges=(noall,tmpmbx,netmbx)
$ mcr authorize modify 'http$server_username' -
/astlm=2000 -
/cpu=0 -
/biolm=2000 -
/bytlm=5000000 -
/diolm=1000 -
/enqlm=500 -
/fillm=300 -
/jtquota=4000 -
/maxjobs=0 -
/maxacctjobs=0 -
/maxdetach=0
$ mcr authorize modify 'http$server_username' -
/pbytlm=0 -
/pgflquo=500000 -
/prclm=100 -
/prio=4 -
/queprio=0 -
/shrfillm=0 -
/tqelm=100 -
/wsdef=1000 -
/wsquo=4000 -
/wsextent=20000
$!
$ mcr authorize grant /ident WASD_HTTP_SERVER 'http$server_username'
$!
$ mcr authorize show 'http$server_username'
$ set on
$ set default 'current_default'
$!
$ say ""
$ response = ""
$ read sys$command response /prompt="Press RETURN to continue: "
$ say ""
$!
$ exit
$ endsubroutine
$!
$!-----------------------------------------------------------------------------
$!
$ ACCOUNT_HTTP$NOBODY: SUBROUTINE
$!
$ on controly then exit ss$_abort
$!
$ current_default = f$environment("default")
$ set default sys$system
$ set noon
$ define /user sys$output nl:
$ define /user sys$error nl:
$ mcr authorize add 'http$nobody_username' /uic='http$nobody_uic'
$ status = $status
$ say ""
$ if status then say "''http$nobody_username' account created, setting ..."
$ if status .eq. %x13f1943a -
     then say "''http$nobody_username' account already existed, modifying ..."
$ if .not. status .and. status .ne. %x13f1943a then exit ss$_abort
$ mcr authorize modify 'http$nobody_username' -
/uic='http$nobody_uic' -
/device='http$nobody_device' -
/directory=['http$nobody_username'] -
/owner="WASD Scripting"
$ mcr authorize modify 'http$nobody_username' -
/cli=dcl -
/clitables=dcltables -
/lgicmd=LOGIN.COM -
/flags=(dismail,disnewmail,nodisuser)-
/network/nobatch/nolocal/nodialup/nointeractive -
/privileges=(noall,tmpmbx,netmbx) -
/defprivileges=(noall,tmpmbx,netmbx)
$ mcr authorize modify 'http$nobody_username' -
/astlm=2000 -
/cpu=0 -
/biolm=2000 -
/bytlm=500000 -
/diolm=1000 -
/enqlm=500 -
/fillm=300 -
/jtquota=4000 -
/maxjobs=0 -
/maxacctjobs=0 -
/maxdetach=0
$ mcr authorize modify 'http$nobody_username' -
/pbytlm=0 -
/pgflquo=500000 -
/prclm=100 -
/prio=4 -
/queprio=0 -
/shrfillm=0 -
/tqelm=100 -
/wsdef=1000 -
/wsquo=4000 -
/wsextent=20000
$!
$ mcr authorize grant /ident WASD_HTTP_NOBODY 'http$nobody_username'
$!
$ mcr authorize show 'http$nobody_username'
$ set on
$ set default 'current_default'
$!
$ say ""
$ response = ""
$ read sys$command response /prompt="Press RETURN to continue: "
$ say ""
$!
$ exit
$ endsubroutine
$!
$!-----------------------------------------------------------------------------