$!----------------------------------------------------------------------------- $! DEMO.COM $! $! Copyright (C) 1996-2021 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= 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 @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 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 $! $!-----------------------------------------------------------------------------