$!-----------------------------------------------------------------------------
$! DEMO.COM
$!
$! Copyright (C) 1996-2024 Mark G.Daniel.
$!
$! Licensed under the Apache License, Version 2.0 (the "License");
$! you may not use this file except in compliance with the License.
$! You may obtain a copy of the License at
$!
$!    http://www.apache.org/licenses/LICENSE-2.0
$!
$! Unless required by applicable law or agreed to in writing, software
$! distributed under the License is distributed on an "AS IS" BASIS,
$! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
$! See the License for the specific language governing permissions and
$! limitations under the License.
$!
$! 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.
$!
$!
$! 10-SEP-2024  MGD  v12.3.0, minor tweaks
$! 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 logical is created by SSL_DETECT.COM)
$ if f$trnlnm("WASD_DEMO_SSL") .nes. ""
$ then
$    ssl_demo = 1
$    deassign /process /nolog WASD_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 @wasd_root:[install]copyright.com
$!
$ 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

For TLS/SSL service the server will generate its own self-signed certificate.
This MAY be rejected outright by the browser in use ... use another browser.
Alternatively, the browser may request special permission to connect.

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

$!
$ read sys$command prompass /prompt="Password (for username 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)+".]"
$    wasdRoot = procDev+procDir
$    locn = f$locate(".][",wasdRoot)
$    if locn .lt. f$length(wasdRoot) -
        then wasdRoot = f$extract(0,locn+2,wasdRoot)
$    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
$ 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' '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
$ deassign /job WASD_CONFIG_SERVICE
$ 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
$!
$!-----------------------------------------------------------------------------