$!-----------------------------------------------------------------------------
$! DEMO.COM
$!
$! 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 later version.
$! http://www.gnu.org/licenses/gpl.txt
$!
$! For demonstration/checking of WASD HTTP server and environment.
$!
$! Standard version ........................... @WASD_ROOT:[INSTALL]DEMO
$! With SSL support (if installed) ............ @WASD_ROOT:[INSTALL]DEMO SSL
$!
$! P1 or P2 can be used to supply an /ACCEPT=<ip-address> qualifier.
$!
$! 07-NOV-2009  MGD  v10.0.0, logical naming schema
$! 14-SEP-2007  MGD  up-case procedure spec to avoid mixed-case issues
$! 02-JAN-2004  MGD  ensure SYSTEM group membership (file and script access)
$! 15-OCT-2002  MGD  updated for v8.1
$! 07-JUN-2002  MGD  /demo required for v8.0 functionality
$! 02-JUN-2001  MGD  add loop around spawn (for more realistic Admin Menu)
$! 30-NOV-1999  MGD  remove NETLIB support,
$!                   bugfix; HT_ROOT derived from concealed device
$! 27-JUN-1998  MGD  allow calling by INSTALL.COM and UPDATE.COM
$! 20-FEB-1998  MGD  add support for optional SSL
$! 23-JUL-1997  MGD  add NETLIB support
$! 01-JUN-1997  MGD  demo uses /promiscuous to provide "authentication"
$! 10-JAN-1996  MGD  initial development
$!-----------------------------------------------------------------------------
$!
$ set noon
$ verified = f$verify(0)
$ ss$_normal = 1
$ ss$_abort = 44
$ ss$_bugcheck = 676
$ 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")))
$ on controly then exit ss$_abort
$!
$ ssl_demo = 0
$ if p1 .eqs. "SSL" then ssl_demo = 1
$ if p2 .eqs. "SSL" then ssl_demo = 1
$ if f$search("WASD_EXE:HTTPD.EXE") .eqs. "" .and. -
     f$search("WASD_EXE:HTTPD_SSL.EXE") .nes. "" then ssl_demo = 1 
$!(this symbol is created by SSL_DETECT.COM)
$ if f$type(DEMO_SSL) .nes. ""
$ then
$    ssl_demo = 1
$    delete/symbol/global DEMO_SSL
$ endif
$!
$ accept = ""
$ if f$extract(0,8,f$edit(p1,"upcase")) .eqs. "/ACCEPT=" then accept = p1
$ if f$extract(0,8,f$edit(p2,"upcase")) .eqs. "/ACCEPT=" then accept = p2
$!
$ if f$environment("depth") .eq. 1 then say ""
$ type sys$input
                       *******************************
                       *  WASD PACKAGE DEMONSTRATOR  *
                       *******************************

$ if f$environment("depth") .eq. 1 .and. .not. ssl_demo
$ then
$    type sys$input
If you have the SSL package then just add "SSL" as parameter 1!

$ endif
$ type sys$input
When finished using demonstrator abort server execution using control-Y
(a subprocess will be spawned to preserve current process environment)

$ if ssl_demo
$ then
$    type sys$input
Use a browser to access either of the "%HTTPD-I-SERVICE"s when the server
starts.  (There will be one for a standard service and another for SSL.)
$ else
$    type sys$input
Use a browser to access the "%HTTPD-I-SERVICE" shown when the server starts.
$ endif
$ type sys$input

The server will be running in promiscuous mode!
Any username with the password specified below can be used for authentication.
Enter a string to use as a password when later prompted by your browser.

$!
$ read sys$command prompass /prompt="Password (for demo authentication)? []: "
$ say ""
$ if prompass .eqs. "" then exit ss$_normal
$!
$ on error then goto exit_demo
$ on controly then goto exit_demo
$!
$ archName = f$edit(f$getsyi("ARCH_NAME"),"UPCASE")
$ if archName .eqs. "ALPHA" then archName = "AXP"
$!
$ definedHtRoot = 0
$ if f$trnlnm("WASD_ROOT","LNM$JOB") .eqs. ""
$ then
$!   (define local logicals, in line with INSTALL.COM and UPDATE.COM)
$    definedHtRoot = 1
$    procCom = f$edit(f$environment("PROCEDURE"),"UPCASE")
$    procDev = f$parse(procCom,,,"DEVICE","NO_CONCEAL")
$    procDir = f$parse(procCom,,,"DIRECTORY","NO_CONCEAL")
$    wasdRoot = procDev+f$extract(0,f$locate("WASD_ROOT",procDir)+9,procDir)+".]"
$    define /job /nolog /translation=concealed WASD_ROOT 'wasdRoot'
$    wasdExe = "WASD_ROOT:[''archName']"
$    define /job /nolog WASD_EXE 'wasdExe'
$ else
$    wasdRoot = f$trnlnm("WASD_ROOT","LNM$JOB")
$ endif
$!
$!(demo uses script files from the build areas, not production areas)
$ exeRoot = wasdRoot - ".]" + ".''archName'.]"
$ scriptRoot = wasdRoot - ".]" + ".SCRIPT.]"
$ define /job /translation=concealed CGI-BIN 'exeRoot','scriptRoot'
$ define /job CGI_BIN WASD_ROOT:[SCRIPT]
$ define /job CGI_EXE WASD_ROOT:['archName']
$!
$!(demo uses configuration files direct from the examples directory)
$ define /job WASD_CONFIG_AUTH WASD_ROOT:[EXAMPLE]WASD_CONFIG_AUTH.CONF
$ define /job WASD_CONFIG_GLOBAL WASD_ROOT:[EXAMPLE]WASD_CONFIG_GLOBAL.CONF
$ define /job WASD_CONFIG_MAP WASD_ROOT:[EXAMPLE]WASD_CONFIG_MAP_DEMO.CONF
$ define /job WASD_CONFIG_MSG WASD_ROOT:[EXAMPLE]WASD_CONFIG_MSG.CONF
$ if f$trnlnm("HTTPD$CONFIG","LNM$SYSTEM") .nes. ""
$ then
$!   (during update accomodate an existing v9.n environment)
$    define /job HTTPD$AUTH WASD_CONFIG_AUTH
$    define /job HTTPD$CONFIG WASD_CONFIG_GLOBAL
$    define /job HTTPD$MAP WASD_CONFIG_MAP
$    define /job HTTPD$MSG WASD_CONFIG_MSG
$ endif
$ define /job WASD_AUTH WASD_ROOT:[EXAMPLE]
$ define /job WASD_SCRATCH WASD_ROOT:[SCRATCH]
$ define /job WASD_ENABLE_SHOW 1
$!
$!(if necessary base ourselves in London just for want of anywhere better!)
$ if vms_version .lt. 70 then define /job WASD_GMT "+00:00"
$!
$ httpd = "$WASD_EXE:HTTPD"
$ if ssl_demo
$ then
$    httpd = httpd + "_SSL"
$    httpService = "http:7080,https:7443"
$ else
$    httpService = "7080"
$ endif
$!(the ";0" ensures the latest version, not any prior INSTALLed version)
$ httpd = httpd + ".EXE;0"
$!
$ curpriv = f$getjpi(0,"CURPRIV")
$ set process /privilege=(SETPRV,SYSPRV)
$!
$!(ensure this process appears to be a member of the SYSTEM group)
$ if f$getjpi(0,"GRP") .ne. 1
$ then
$    uic = f$user()
$    set process /privilege=CMKRNL
$    set uic [1,4]
$ endif
$!
$ restartLoop:
$    spawn /wait httpd /demo /promiscuous='prompass' /service='httpService' 'accept'
$    if $STATUS then goto restartLoop
$!
$ exit_demo:
$!
$ if f$type(uic) .nes. "" then set uic 'uic'
$ if f$type(curpriv) .nes. "" then set proc /privilege=(NOALL,'curpriv')
$!
$ if definedHtRoot
$ then
$    deassign /job WASD_ROOT
$    deassign /job WASD_EXE
$ endif
$ deassign /job WASD_CONFIG_AUTH
$ deassign /job WASD_CONFIG_GLOBAL
$ deassign /job WASD_CONFIG_MAP
$ deassign /job WASD_CONFIG_MSG
$ if f$trnlnm("HTTPD$CONFIG","LNM$JOB") .nes. ""
$ then
$    define /job HTTPD$AUTH WASD_CONFIG_AUTH
$    define /job HTTPD$CONFIG WASD_CONFIG_GLOBAL
$    define /job HTTPD$MAP WASD_CONFIG_MAP
$    define /job HTTPD$MSG WASD_CONFIG_MSG
$ endif
$ deassign /job WASD_AUTH
$ deassign /job WASD_SCRATCH
$ deassign /job WASD_ENABLE_SHOW
$ deassign /job CGI-BIN
$ deassign /job CGI_BIN
$ deassign /job CGI_EXE
$ if f$trnlnm("HTTPD$GMT","LNM$JOB") .nes. "" then deassign /job HTTPD$GMT
$!
$ say ""
$ if .not. verified then set noverify
$ exit ss$_normal
$!
$!-----------------------------------------------------------------------------