/*---------------------------------------------------------------------
| This file is for use under CMS only.
|
| This is a front-end PIPE stage to interface with IXCGICMS MODULE.
| Its main purposes are:
| 1. Copy relevant environment variables from the current group to
|    the CENV group where IXCGICMS MODULE expects them to be.
| 2. Set up the PATH_TRANSLATED environment variable in the form
|    required by IXCGICMS.
| 3. Invoke IXCGICMS.
| 4. Pipe the output.
|
| This code has been tested with these servers:
|  EnterpriseWeb/VM 1.1.0 and 1.1.4
|  Webshare 1.2.3
|
| This file must be installed in the .sashtml.scripts subdirectory of the
|   Online Documentation.  Examples below assume that this directory
|   is named VMSYSU:ONLDOC.WEBSHARE.SASHTML.SCRIPTS.
|
| For Webshare:
| 1. Create HTBIN FILELIST in this same directory, containing the line
|      IXCGICMS *CGI *
| 2. Modify the SearchToolURL param in APPLET HTM as
| <param name=HTTPSearchToolURL value=/~onldoc/sashtml/scripts/htbin/ixcgicms;>
|
| For EnterpriseWeb/VM
| 1. Using an HTBIN FILELIST is optional.
| 2. If you don't use HTBIN FILELIST, modify the SearchToolURL param
|    in APPLET HTM as
| <param name=HTTPSearchToolURL value=/~onldoc/sashtml/scripts/ixcgicms.cgi;>
|
| Be sure that your server is configured to serve filetypes of CAB,
| JAR, and ZIP in binary mode.
|
'---------------------------------------------------------------------*/

/* Keep IXCGICMS nucxloaded for performance */
address command
'NUCEXT IXCGICMS'
if rc = 1 then 'NUCXLOAD IXCGICMS'
address

/* Get the current set of environment variables */
'callpipe command GLOBALV LIST',
   '| stem globalv.'

/* Copy the environment variables to the CENV group */
address command
'GLOBALV SELECT CENV'
'GLOBALV SET HTTP_HOST' /* Clear this one in case not supported */
parse var globalv.1 ':' original_globalv_table
do i = 2 to globalv.0
   parse var globalv.i var '=' val
   'GLOBALV SETL' var val
end

/* Get more vars that may be in a different group */
'GLOBALV SELECT HTTPD GET GATEWAY_INTERFACE',
   'SERVER_NAME SERVER_PORT SERVER_SOFTWARE'
'GLOBALV SELECT CENV PUT GATEWAY_INTERFACE',
   'SERVER_NAME SERVER_PORT SERVER_SOFTWARE'

'GLOBALV SELECT CENV GET HTTP_HOST'  /* e.g., vm.sas.com */
if HTTP_HOST = '' then do
   if server_port = 80
   then server_port = ''
   else server_port = ':'server_port
   'GLOBALV SET HTTP_HOST' server_name||server_port
end

/* Get the information that we need to transform PATH_INFO */
'GLOBALV GET PATH'             /* Location of the CGI */
'GLOBALV GET PATH_INFO'        /* Passed argument     */
'GLOBALV GET PATH_TRANSLATED'  /* Location of the CGI */
path_fm = word(path_translated,3)

/*---------------------------------------------------------------------
| PATH and PATH_TRANSLATED specify the location of the CGI.
| We'll use PATH, PATH_TRANSLATED, and PATH_INFO to resolve the
| actual CMS fileid referenced by PATH_INFO, and store that
| fileid as PATH_TRANSLATED.
|
| For this to work, the CGI has to be located in the .sashtml.scripts
| subdirectory.
|
| Examples -- The Web server might provide:
| PATH         /~onldoc/sashtml/scripts/ixcgicms.cgi
| PATH_INFO    /~onldoc/sashtml/search.ix
| PATH_TRANSLATED IXCGICMS CGI C
|
| We need to do this conversion for IXCGICMS:
| PATH_TRANSLATED sf:search ix vmsysu:onldoc.webshare.sashtml
'---------------------------------------------------------------------*/
/* Get the directory name of the path */
address
'callpipe command LISTDIR' path_fm '(NOSUB',
   '| drop 1',
   '| specs word 2 1',
   '| var directory'  /* e.g., VMSYSU:ONLDOC.WEBSHARE.SASHTML.SCRIPTS */

/* Get the common part of the directory path */
lastdot = lastpos('.',directory)
if substr(directory,lastdot) = '.SCRIPTS'
then directory=left(directory,lastdot-1)

/* From path, path_info, and directory name, construct the name  */
/* of the file's SFS directory.                                  */
path_split = compare(path_info,path)
/* e.g., 19 for
| path_info /~onldoc/sashtml/search.ix
| path      /~onldoc/sashtml/scripts/ixcgicms.cgi
*/
lslash = lastpos('/',left(path_info,path_split)) /* e.g., 17 */
if lslash = 0 then signal badpath
parse var path_info =(lslash) +1 subpath    /* e.g. books/search.ix */
lslash = lastpos('/',subpath)
if lslash = 0 then do
   fileid = subpath
   subpath = ''
end
else parse var subpath subpath =(lslash) + 1 fileid /* books search.ix */

/* Check for any aliasing */
dirid = directory'.'
do while subpath <> ''
   parse var subpath subdir'/'subpath
   testdir = dirid||subdir'.'
   if direxist(testdir)
   then dirid=testdir
   else do forever
      testfile = translate(subdir 'FILELIST' dirid)
      if subpath = ''
      then target = fileid
      else parse var subpath target'/'subpath
      'callpipe <' testfile '|locate word 4 /'target'/',
         '|append literal  |var alias'
      if rc <> 0 | alias = ''
      then signal badpath
      parse var alias fn ft .
      select
         when ft = 'FILELIST' then do
            subdir = fn
         end
         when ft = '*' then do
            dirid = dirid || fn
            leave
         end
         otherwise do
            fileid = fn ft
            leave
         end
      end
   end
end

fileid = translate(fileid,' ','.') dirid
if words(fileid) <> 3 then signal badfile
address command 'GLOBALV SETL PATH_TRANSLATED' 'sf:' || fileid

'callpipe command IXCGICMS',
   '| *:'
exitcode = rc

exit:
/* Restore the original default GLOBALV group */
address command 'GLOBALV SELECT' original_globalv_table
exit exitcode

badpath:
   'output <html><body>"'path_info'" is not valid.</body></html>'
   exitcode = 28
   signal exit

badfile:
   'output <html><body>"'fileid'" is not valid.</body></html>'
   exitcode = 28
   signal exit

direxist: procedure
parse upper arg dirid .
'callpipe command LISTDIR' dirid '(NOSUB | hole'
return (rc=0)