'Title'

/* REXX Routines to Manipulate CGI input cottrell@slac.stanford.edu http://www.slac.stanford.edu/~cottrell.html/cottrell.html These routines are modelled on a set of Perl routines from S.E.Brenner@bioc.cam.ac.uk, with some additions suggested by "Gateway Programming I: ..." in "HTML and CGI Unleashed" by John December and Mark Ginsberg, published by Sams/Macmillan. For more information on Steve's functions, see: http://www.bio.cam.ac.uk/web/form.html http://www.seas.upenn.edu/~mengwong/forms/ For more information on "HTML and CGI Unleashed" see http://www.rpi.edu/~decemj/works/wdg.html This document and/or portions of the material and data furnished herewith, was developed under sponsorship of the U.S. Government. Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior University, nor their employees, nor their respective contractors, subcontractors, or their employees, makes any warranty, express or implied, or assumes any liability or responsibility for accuracy, completeness or usefulness of any information, apparatus, product or process disclosed, or represents that its use will not infringe privately-owned rights. Mention of any product, its manufacturer, or suppliers shall not, nor is it intended to, imply approval, disapproval, or fitness for any particular use. The U.S. and the University at all times retain the right to use and disseminate same for any purpose whatsoever. Copyright (c) Stanford University 1995, 1996. Permission granted to use and modify this library so long as the copyright above is maintained, modifications are documented, and credit is given for any use of the library. The main functional differences of the REXX version to the Perl version are: *ReadParse is replaced by ReadForm which returns the results in a different fashion. ReadForm returns the results as a string, whereas ReadParse uses an associative variable. This difference is necessitated since REXX does not support returning associative (stem) variables from external functions. *PrintVariables takes as input a string rather than an asociative variable. This difference is driven by the expectation that it will be used with a string returned from ReadForm. */ #!/usr/local/bin/rxx /* The above line indicates that the code is a REXX script and where the REXX interpreter is to be found. This may be different at your site. Sample CGI Script in Uni-REXX, invoke from: http://www.slac.stanford.edu/cgi-wrap/finger?cottrell*/ Fail=PUTENV('REXXPATH=/afs/slac/www/slac/www/tool/cgi-rexx') /* The above line tells the REXX interpreter where to find the external REXX library functions, such as PrintHeader, HTMLTop, DeWeb and HTMLBot. */ SAY PrintHeader() /*Put out Content-type stuff*/ SAY '' In=DeWeb(TRANSLATE(GETENV('QUERY_STRING'),' ','+')) /*Decode + signs to spaces and hex %XX to chars*/ SAY HTMLTop('Finger' In)'

'
Valid=' abcdefghijklmnopqrstuvwxyz'
Valid=Valid||'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
Valid=Valid||'0123456789-_/.@'

V=VERIFY(In,Valid) /*Check input is valid*/
IF V\=0 THEN
  SAY 'Bad char('SUBSTR(In,V,1)')in:"'In'"'
ELSE ADDRESS COMMAND '/usr/ucb/finger' In
SAY HTMLBot() /*Put out trailer boilerplate*/
EXIT

#!/usr/local/bin/rxx
/*  Minimalist http form and script           */
F=PUTENV("REXXPATH=/afs/slac/www/slac/www/tool/cgi-rexx")
SAY PrintHeader(); SAY ''
Input=ReadForm()
IF Input='' THEN DO  /*Part 1*/
  SAY HTMLTop('Minimal Form')
  SAY '',
      '
Data: '
END
ELSE DO              /*Part 2*/
  SAY HTMLTop('Output from Minimal Form') 
  SAY PrintVariables(Input)
END
SAY HTMLBot()

#!/usr/local/bin/rxx
/* The above line indicates that the code is a 
REXX script and where the REXX interpreter is 
to be found. This may be different at your site.    

Sample CGI Script in  Uni-REXX, invoke from:
http://www.slac.stanford.edu/cgi-wrap/testinput*/

Fail=PUTENV('REXXPATH=/afs/slac/www/slac/www/tool/cgi-rexx')
/* The above line tells the REXX interpreter 
where to find the external REXX library 
functions, such as PrintHeader, HTMLTop, 
ReadPost, DeWeb and HTMLBot.            */ 

StdinFile='/tmp/stdin'_GETPID()/*Get unique name*/
  /*_GETPID() provides the process Id in Uni-REXX*/
SAY PrintHeader(); SAY HTMLTop('testinput')
/*********************************************** */
/*Read input from the various sources.           */
/*Note that we preserve or save                  */
/*input in case we need to send it to another    */
/*script. If so we can restore the stdin for the */
/*the called command by  using the REXX command: */
/*ADDRESS UNIX script '<' StdinFile              */ 
/*********************************************** */      

PARSE ARG Parms/*QUERY_STRING input for non FORMS*/
SAY 'Command line parms="'Parms'"'
SAY '
Standard input="'ReadPost(StdinFile)'"'
SAY '
PATH_INFO="'GETENV('PATH_INFO')'"'
SAY '
QUERY_INPUT="'GETENV('QUERY_STRING')'"'
EXIT

/* This package includes (in alphabetical order): */

/*
 * CleanQuery(cgi_string)
 *
 * Removes all occurences of unassigned variables from a CGI query string.
 * CGI query strings are of the form VAR1=value1&VAR2=value2&...  It is
 * possible for a Web form to generate "VAR=" elements, with no assignment,
 * which in many cases are removable from the query without effect.  The
 * remaining elements are preserved in order and in case.
 *
 * Example: CleanQuery("A=5&B=&C=&B=abc") returns "A=5&B=abc".
 *
 * 970221  Michael Kelsey
 */

CleanQuery:	PROCEDURE
  Parse arg Qstring

  Qnew = ''
  Do while Qstring <> ''
     Parse var Qstring var '=' val '&' Qstring
     If val <> '' Then Qnew = Qnew'&'var'='val
  End
  Qnew = STRIP(Qnew,'B','&')
Return Qnew

/* CgiError
Prints out an error message which contains 
appropriate headers, markup, etcetera.
Parameters:
If no parameters, gives a generic error message
Otherwise, the first parameter will be the title 
and the rest will be given as the body
*/
CgiError: PROCEDURE; PARSE ARG Title, Body
  IF Title='' THEN 
    Title='Error: script' MyURL(),
          'encountered fatal error.'
  SAY ''Title''
  SAY ''Title''
  IF Body\='' THEN SAY Body
  SAY ''
RETURN ''

/* CgiDie
   Identical to CgiError, but also quits with the 
   passed error message. This appears to work on SunOS. 
   On AIX 3.2 it appears to be  necessary to enter an
   extra carriage return if cgidie is called from a 
   REXX script initiated from the command line.
*/
CgiDie: PROCEDURE
  PARSE ARG Title, Body
  Fail=CgiError(Title, Body)
  Pid=_GETPID()
  Kill=_KILL(Pid,9)
  SAY 'Kill='Kill
  SAY 'Error killing process id',
      Pid', system error:' _errno()
  SAY _sys_errlist(_errno())
  SAY 'Process not killed.'
  EXIT

chkpwd: PROCEDURE; PARSE ARG PasswordFile, UserName, Password
/* Check's user's password (fails if there is no such user).
Returns zero if the password is correct. Otherwise returns
an error message and message number.

The parameters PasswordFile, UserName and Password must only contain
alphanumerics plus .-_/@,

This function uses the CERN httpd password file, that is maintained
using the htadm program which is part of the CERN httpd distribution.
At SLAC htadm is located at /afs/slac/g/www/bin/htadm-sun or
/afs/slac/g/www/bin/htadm-aix
Before using this function the password admin must use the
htadm function to create the password file and enter the password
for the selected username.

Example:
Msg=chkpwd('/afs/slac/u/sf/cottrell/www/test.pwd','cottrell',password)

*/
IF PasswordFile='' THEN RETURN 'chkpwd(1): null PasswordFile name given!'
IF LINES(PasswordFile)=0 THEN RETURN "chkpwd(2): either can't find or found an empty PasswordFile" PasswordFile
IF UserName=''     THEN RETURN 'chkpwd(3): needs a UserName, but none was provided!'
IF Password=''     THEN RETURN 'chkpwd(4): needs a Password, but none was provided!'
IF LENGTH(Password)>8 THEN RETURN 'chkpwd(5): password must be 8 characters or less!'
Parms=PasswordFile Username Password
IF Suspect(Parms)\='' THEN RETURN 'chkpwd(6):' Suspect(Parms) 'in input parameters!' 
Fail=POPEN('/afs/slac/g/www/bin/htadm-sun -check' Parms)
IF QUEUED()>0      THEN PARSE PULL Line
ELSE RETURN 'chkpwd('10+Fail'): htadm failed, maybe a problem with passwordfile' PasswordFile'!'
IF Fail\=0         THEN RETURN 'chkpwd(-'Fail'): username/password' Line
IF Line='Correct'  THEN RETURN 0
ELSE RETURN Line

/*
 * DelQuery(cgi_string,varname)
 *
 * Removes all occurences of a given CGI query variable from the input
 * string.  CGI query strings are of the form VAR1=value1&VAR2=value2&...
 * The matching is not case sensitive, and the result is returned with
 * the same case as the input string.
 *
 * Example: DelQuery("A=5&B=2&C=3&B=ABC","B") returns "A=5&C=3".
 *
 * 970221  Michael Kelsey
 * 970303  Steve Meyer, replace UPPER with TRANSLATE, add Qstring to all RETURNs
 */

DelQuery:	PROCEDURE
  Parse arg Qstring, Varname
  Parse upper arg Qup, Vup	/* Case-insensitive version for matching */

  If Varname = '' Then Return Qstring

  Do while POS(Vup'=',Qup) > 0		/* Case-insensitive matching */
     a = POS(Vup'=',Qup) ; b = POS('&',Qup,a)
     If b = 0 Then b = LENGTH(Qup)
     Qstring = STRIP(SUBSTR(Qstring,1,a-1)||SUBSTR(Qstring,b+1),'T','&')
     Qup = TRANSLATE(Qstring)
  End
Return Qstring

DeWeb: PROCEDURE; PARSE ARG In, Op
/* *******************************************
DeWeb converts hex encoded (e.g. %3B=semi-colon) 
characters in the In string to the equivalent 
ASCII characters and returns the decoded string.
If the 2 characters following a % sign do not
represent a hexadecimal 2 digit number, then 
the % and following 2 characters are returned
unchanged. If the string terminates with a % then
the % sign is returned unchanged. If the final
two characters in the string are a % sign 
followed by a single hexadecimal digit then  
they are returned unchanged.

The optional Op argument contains a set of 
characters which allows you to tell DeWeb to:
'+' convert plus signs (+) to spaces
    in the input before the hex decoding is done.
'*' convert asterisks (*) to percent signs (%) 
    after the decoding.  This option
    is often used with Oracle.
   
Authors: Les Cottrell & Steve Meyer - SLAC

Examples:
  SAY DeWeb('%3Cpre%3e%20%%25Loss  %Util%') 
  results in:  ' %%Loss  %Util%'
  SAY DeWeb('%3cpre%3eName++Address*','*+')
  results in   'Name  Address%'
******************************************* */
IF POS('+',Op)\=0 THEN In=TRANSLATE(In,' ','+')
Start=1; Decoded=''; String=In
DO WHILE POS('%',String)\=0
   PARSE VAR String Pre'%'+1 Ch +2 In
   IF DATATYPE(Ch,'X') & LENGTH(Ch)=2 THEN 
        Ch=X2C(Ch)
   ELSE DO; In=Ch||In; Ch='%'; END
   Decoded=Decoded||Pre||Ch
   Start=LENGTH(Decoded)+1
   In=Decoded||In
   String=SUBSTR(In,Start)
END
IF POS('*',Op)\=0 THEN In=TRANSLATE(In,'%','*')
RETURN In

/*
 * FormatDate(DTexpr)
 *
 * Parses the date expression given, and converts it to a standard
 * format DD-MON-YY:HH:MM:SS, for use by Oracle.  The date may be
 * given in any of the formats
 *
 *	mm/dd/yy	mm/dd/yyyy
 *      dd/mm/yy	dd/mm/yyyy
 *      dd-Mon-yy	dd-Mon-yyyy
 *
 * and with an optional hh:mm[:ss] time string, with hours in 12- or
 * 24-hour format, appended with a colon.
 *
 * 970221  Michael Kelsey
 */

FormatDate:	PROCEDURE
  Parse Arg DTexpr
  Parse Var DTexpr date ':' time

  months = 'JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC'
  days =   '31  29  31  30  31  30  31  31  30  31  30  31'

  Parse Var date mm '/' dd '/' yy		/* eg 10/18/96 */
  If Datatype(mm,'W') = 0 | Datatype(dd,'W') = 0 ,
     | Datatype(yy,'W') = 0 Then Do

     Parse Upper Var date dd '-' mon '-' yy	/* eg 18-oct-96 */
     mm = WordPos(mon,months)

     If Datatype(dd,'W') = 0 | Datatype(yy,'W') = 0 | mm = 0 ,
     Then Return ''
  End
  Else Do
     dd = Format(dd)
     mm = Format(mm)
     If dd > Word(days,mm) | dd < 1 Then Do
        parse value dd mm with mm dd
        If dd > Word(days,mm) | dd < 1 Then Call DateError DTexpr
     End
  End

  If yy > 1900 Then yy = RIGHT(yy,2)

  date = dd"-"Word(months,mm)"-"yy

  If time='' then result = date		/* Return full date-time string */
  Else result = date':'time
Return result

/*
 * FullURL()
 *
 * Rebuilds complete CGI query URL from CGI environment variables.  The
 * "REFERER_URL" string stops at the name of the CGI script, eliminating
 * any path or query information.  This makes it difficult to embed the
 * original query for reference in script output.
 *
 * 970221  Michael Kelsey
 */

FullURL:	PROCEDURE
  path  = GetEnv('PATH_INFO')
  query = GetENV('QUERY_STRING')

  FullURL = MyURL()
  If path <> '' Then FullURL = FullURL||path
  If query <> '' Then FullURL = FullURL'?'query
Return FullURL

/*
 * GetOwner(file)
 *
 * Return username of owner of specified file.  This function is ONLY
 * valid for UniREXX (Rexx running on Unix).  It uses the POPEN routine
 * to fetch file information from 'ls'.
 *
 * 970221  Michael Kelsey
 */

GetOwner:	PROCEDURE
   Parse Arg fname
   Call POPEN 'ls -dloL' fname		/* This is UniREXX Specific! */
   Parse pull . . owner .
Return owner



/*
 * GetFullHost()
 *
 * Returns the fully qualified domain name (FQDN) of the local host,
 * using the UniREXX specific _GETHOSTNAME and _GETHOSTBYNAME functions.
 */
GetFullHost:	PROCEDURE
   fullhost = _GETHOSTNAME()		/* This is UniREXX Specific! */

   If POS('.',host) = 0 Then Do		/* Get domain information */
     Call _GETHOSTBYNAME fullhost,'hinfo.'
     fullhost = hinfo.H_NAME
   End
Return fullhost



/*
 * HTMLBreak(long_string[,len])
 *
 * Breaks the specified "very long" message string into lines appropriate
 * for HTML parsing.  Each "line" will be up to _len_ characters long
 * (80 if len not specified), and will be broken at word boundaries (spaces
 * or tabs).  The string will have HTML break tags "
" inserted at each
 * line break point.
 *
 * 970221  Michael Kelsey
 */

HTMLBreak:	PROCEDURE
  Parse arg message, len
  If len='' Then len = 80

  broken = ''
  br = ''
  Do while message <> ''
     cut = LASTPOS(' ',LEFT(message,len))	/* Find word break at end */
     if cut = 0 Then cut = len-1

     broken = broken||br||LEFT(message,cut)
     If broken<>'' Then br = '
'		/* Add breaks to later lines */
     message = SUBSTR(message,cut+1)
  End
Return broken

/* HtmlBot
   Returns the ,  codes for 
   the bottom of every HTML page
*/
HtmlBot: PROCEDURE
  RETURN ''

/* HtmlTop
 Returns the head of a document and the  
 beginning of the body with the title and a 
 body h1 header as specified by the parameter.
 Example: SAY HTMLBot('Heading for WWW Page')
*/
HtmlTop: PROCEDURE; PARSE ARG Title
  RETURN ''Title''Title''

HTtab: PROCEDURE; PARSE ARG InFn, OutFn, Delim, Options
/* httab - Converts a tab delimited file into an HTML Table */
/*
   httab - Converts a tab delimited file into an HTML Table

  .....................................................................
  Command Format:
       CALL HTtab(InFn, OutFn)
       
Where: InFn is the fully qualified inout filename of the tab delimited
       file.
       IF InFn is equal to '-' THEN input is read from stdin.
       OutFn is the fully qualified name of the output filename where the
       HTML table will be written.  The default for OutFn is standard
       output. If OutFn="=" then the output filename=InFn||'.html',
       unles InFn='-' in which case OutFn='/tmp/qall.html'.      
       If OutFn='-' then no output file is written.
       Delim specifies the tab delimter to be used.  The default
       is '09'X an horizontal tab.

The converted file contents are returned by HTTab.  If an error
is encountered (e.g. no Input filename is provided), then an
HTML error message is returned with the first character being an
exclamation mark (!).
       
Examples:
 Msg=HTTab(Fn),1,1); IF SUBSTR(Msg,1,1)='!' THEN DO; SAY Msg''; EXIT; END
 SAY HTTab(Fn,'=')

Note this function can be much more simply done in Perl.

Please send comments and/or suggestion to Les Cottrell.
*/
/* **************************************************************** */
/* Owner(s): Les Cottrell, Jan 23, 1996                             */
/* Revision History:                                                */
/* **************************************************************** */

   /* ********************************************************** */
   /* Get the  parameters                                        */
   /* ********************************************************** */
   IF InFn=''        THEN RETURN '!
No input file specified.
'
   IF InFn='-'       THEN InFn=''
   IF LINES(InFn)=0  THEN RETURN "!
Can't find file' InFn 'or it is empty.
"
   Out=1
   IF OutFn='='      THEN DO;
      IF InFn='' THEN OutFn='/tmp/qall.html'
      ELSE            OutFn=InFn'.html'
   END
   ELSE IF OutFn='-' THEN Out=0
   IF Delim=''       THEN Delim='09'X /* Horizontal Tab */

   /* *********************************************************** */
   /* Do the conversion.                                          */
   /* *********************************************************** */
   Body=''InFn''
   IF Out THEN CALL LINEOUT(OutFn,Body,1)
   DO L=1 BY 1 WHILE LINES(InFn)>0
      Line=LINEIN(InFn); LineO=''
      DO WHILE Line\=''
         PARSE VAR Line Pre (Delim) Line 
         LineO=LineO||''
      END
      Body=Body||'0a'X||LineO||''
      IF Out THEN CALL LINEOUT(OutFn,LineO||'')
   END
   Body=Body||'0a'x||''Pre''
   IF Out THEN DO
      CALL LINEOUT(OutFn,'')
      CALL LINEOUT(OutFn) /*Close File*/
   END
   RETURN Body
   

/* MethGet
   Return true if this cgi call was using the GET request, false otherwise
*/
MethGet: PROCEDURE
   RETURN 'GET'=GETENV('REQUEST_METHOD')
   

/* MethPost
   Return true if this cgi call was using the POST request, false otherwise
*/
MethPost: PROCEDURE
  RETURN 'POST'=GETENV('REQUEST_METHOD')
     

/* MyURL
   Returns a URL to the script
*/
MyURL: PROCEDURE
   IF GETENV('SERVER_PORT')\='80' THEN 
        Port=':'GETENV('SERVER_PORT')
   ELSE Port=''
   Url='http://'GETENV('SERVER_NAME')||Port
   RETURN Url||GETENV('SCRIPT_NAME')
   

OraEnv: PROCEDURE

   /* oraenv - set up Oracle database environment variables */     
   /* George Crane, January 1996                            */

   Address command

   /* Set up the correct environment variables for */
   /* communcations with Oracle and set some       */
   /* required environment variables for Oracle    */
 
   call popen "grep 'setenv ORACLE_HOME' /usr/local/bin/coraenvp"
   If queued() = 0 Then exit
   parse pull . . home
   path = GetEnv('PATH')
   rc = putenv("LIBHOME="home"/lib")
   rc = putenv("PATH="path":"home"/bin")
   rc = putenv("TWO_TASK=SLAC_TCP")
   rc = putenv("TNS_ADMIN="home"/network/admin")
 
   Return 0


/* PrintHeader
   Returns the magic line which tells WWW what    
   kind of document is to follow.  If no first  
   argument is provided, then the default 
   document type is HTML, and this is returned together
   with an extra newline to terminate the HTTP header.
   Otherwise the first argument provides the type/subtype.
   If the second argument is 1 then a Location: 
   header is returned instead of the text/html header.
   If the second argument is present (i.e. not null)
   but not equal to 1, then the first argument is returned. 
   If the second argument is not provided and there is
   a non null first argument then 
   Content-type: nl is returned.
   Examples:
     SAY PrintHeader()
     SAY PrintHeader('http://www.halcyon.com/hedlund/cgi-faq/',1)
     SAY PrintHeader('Status: 305 Document moved',0)
     SAY PrintHeader('application/postscript')   
*/
PrintHeader: PROCEDURE; PARSE ARG Content, IsURL
  nl=d2c(10) /*N.B. 10 is the decimal code for a newline*/
  IF Content='' THEN RETURN 'Content-type: text/html'nl
  ELSE IF IsUrl=1 THEN RETURN 'Location:' Content
  ELSE IF IsUrl\='' THEN RETURN Content
  ELSE RETURN 'Content-type:' Content||nl
  

/* PrintVariables
Decodes the Form data block variables 
in the In argument (which are in the format 
key1=value1&key2=value2&...) and returns them 
in a nicely formatted HTML string.
Example:  
  SAY PrintVariables(GETENV('QUERY_STRING'))
*/
PrintVariables: PROCEDURE; PARSE ARG In
  n='0A'X; /*Newline*/; Out=n||''||n
  DO I=1 BY 1 UNTIL In=''
    /* Split into key and value */
    PARSE VAR In Key.I'='Val.I'&' In
    /* Convert %XX from hex to alphanumeric*/
    Key.I=DeWeb(Key.I,'+'); Val.I=DeWeb(Val.I,'+')
    Out=Out''Key.I''n,
           '
'Val.I'
'n
  END I
RETURN Out||''||n

/* ReadForm
Reads in GET or POST data, converts plus signs (+) 
to spaces. Does not convert %XX encoded characters 
to unescaped text since this would confuse 
encoded ampersands and equal signs with
those used to separate the fields in the 
name=value& pairs.
Returns the converted input if there is any, 
else returns ''.
*/
ReadForm: PROCEDURE
  /* Read in text */
  IF MethGet() THEN In=GETENV('QUERY_STRING')
  ELSE IF MethPost() THEN 
     In=CHARIN(,1,GETENV('CONTENT_LENGTH'))
  ELSE RETURN ''
RETURN TRANSLATE(In,' ','+')

ReadPost: PROCEDURE; PARSE ARG StdinFile
  /******************************************** */
  /*Read HTML FORM POST input (if any) from     */
  /*standard input. Note that if the caller     */
  /*provides a filename then we save the input  */
  /*in case we need to send it to another       */
  /*script. If so we can restore the stdin for  */
  /*the called command by  using the command:   */
  /*ADDRESS UNIX script '<' StdinFile           */
  /*A good way to get a unique filename to save */
  /*the standard input in, is to use the process*/
  /*id. For example in Uni-REXX:                */
  /* StdinFile='/tmp/stdin'_GETPID()            */
  /* Post=ReadPost(StdinFile)                   */
  /*If a StdinFile is specified, but ReadPost   */
  /*is unable to write the standard input to    */
  /*StdInFile, then ReadPost EXITs.             */ 
  /*ReadPost returns the POST input if the      */
  /*REQUEST_METHOD="POST" else it returns null. */
  /*ReadPost also returns a null string if the  */
  /*REQUEST_METHOD="POST" but there is no input */
  /*in the standard input.                      */
  /*N.b. the returned Post input does NOT have  */
  /*plus signs (+) converted to spaces or hex   */
  /*ASCII %XX encodings converted to characters.*/  
  /******************************************** */      
  In=''
  IF GETENV('REQUEST_METHOD')="POST" THEN DO
    N=GETENV('CONTENT_LENGTH')
    IF N='' THEN RETURN In
    In=CHARIN(,1,GETENV('CONTENT_LENGTH'))
    IF StdinFile\='' THEN DO
      IF CHAROUT(StdinFile,In,1) \=0 THEN DO
        SAY "500: Can't write all POST chars!" 
        EXIT
      END
      Fail=CHAROUT(StdinFile)/*Close the file*/
    END
  END
RETURN In


/* SLACfnOK
Checks that the filename is OK to be made accessible.
IF OK then it returns a null string, else it returns a
string with the reason why the file is not accessible.
*/
SLACfnOK: PROCEDURE; PARSE ARG Fn

Valid='abcdefghijklmnopqrstuvwxyz0123456789'
Valid=Valid||'ABCDEFGHIJKLMNOPQRSTUVWXYZ.-_/'
CharNb=VERIFY(Fn,Valid)
IF CharNb\=0                                      THEN
  RETURN 'contains an invalid character ('SUBSTR(Fn,CharNb,1)')'

IF POS('..',Fn)\=0                                THEN
  RETURN '.. in filename'
IF LEFT(Fn,1)='-'                                 THEN
  RETURN '- at start of filename'
IF POS('SLACONLY',TRANSLATE(Fn))\=0 THEN DO
  IF SUBSTR(GETENV('REMOTE_ADDR'),1,7)\='134.79.' &,
     GETENV('REMOTE_ADDR')\='' THEN
     RETURN 'SLAC only access'
END
IF SUBSTR(Fn,1,10)='/afs/slac/' THEN
  Fn='/afs/slac.stanford.edu/'||SUBSTR(Fn,11)
IF SUBSTR(Fn,1,27)='/afs/slac.stanford.edu/www/'  THEN RETURN ''
IF POS('public_html/',Fn)\=0                      THEN RETURN ''
IF SUBSTR(GETENV('REMOTE_ADDR'),1,7)\='134.79.' &,
  GETENV('REMOTE_ADDR')\=''                      THEN
  RETURN 'file not accessible from outside SLAC'
IF SUBSTR(Fn,1,25)='/usr/local/scs/net/cando/'    THEN RETURN ''
IF Fn='/etc/printcap'                             THEN RETURN ''
IF SUBSTR(,1,28)='/var/www/log/httpd.prod/err.'   THEN RETURN ''
IF Fn=''                                          THEN RETURN ''
IF LEFT(Fn,5)='/tmp/'                       THEN RETURN ''
IF Fn='/var/www/harvest/gatherers/slac/log.errors' THEN RETURN ''
IF Fn='/var/www/harvest/gatherers/slac/log.gatherer' THEN RETURN ''
IF POS('/tmp/htlog',Fn)\=0                        THEN RETURN ''
ELSE RETURN 'file not in access list'

/*
 * StripHTML(markup)
 *
 * Simplistically removes HTML markup from an input string.  No use of
 * context or semantic information is done -- every <.....> tag is just
 * removed.
 *
 * Example: StripHTML(" BaBar Experiment")
 *          returns " BaBar Experiment"
 *
 * 970221  Michael Kelsey
 */

StripHTML:	PROCEDURE
  Parse arg in

  out = ''
  tag = 0
  i = 1
  Do until i > LENGTH(in)
    ch = SUBSTR(in,i,1)
    tag = tag | (ch = '<')		/* Beginning of HTML tag */
    If tag=0 Then out = out||ch
    tag = tag & (ch <> '>')		/* End of HTML tag */
    i = i + 1
  End
Return out

Suspect: PROCEDURE; PARSE ARG Input
/*
Checks that the Input string is composed of valid
characters which should not cause problems with 
shell expansions. Suspect returns null if Input 
is composed of valid characters otherwise it 
returns an error message.
Example:
IF Suspect(In)\='' THEN DO; 
   SAY Suspect(In) 'in:' '"'In'"'; EXIT; END
*/
Valid=' abcdefghijklmnopqrstuvwxyz' ||,
       'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
Valid=Valid||'0123456789-_/.@,'
V=VERIFY(Input,Valid)
IF V\=0 THEN 
   RETURN 'Invalid character('SUBSTR(Input,V,1)')'
ELSE RETURN ''

Webify: PROCEDURE; PARSE ARG Input
/* ***************************************************
Some characters may not be usable in a URL since its
use may conflict with a reserved character. In such
cases the character may be encoded with a % followed
by its ASCII hexadecimal equivalent code.  Webify
encodes the Input provided in the argument for
a selected set of ASCII characters (see the variable
Esc) and provides the encoded Input as output.
*************************************************** */
Esc='%'||XRANGE('00'X,'$')||XRANGE('&','/'),
       ||XRANGE(':','@')||XRANGE('[','`'),
       ||XRANGE('{','FF'X) /* List of chars to be encoded*/
DO UNTIL Esc=''/*Check for chars to be escaped*/
   PARSE VAR Esc Char 2 Esc
   P=POS(Char,Input); Enc='%'C2X(Char)
   Start=1; Decoded=''
   DO WHILE POS(Char,SUBSTR(Input,Start))\=0
      String=SUBSTR(Input,Start)
      PARSE VAR String Pre (Char) Input
      Start=LENGTH(Decoded||Pre||Enc)+1
      Input=Decoded||Pre||Enc||Input
      Decoded=Decoded||Pre||Enc
   END
END
RETURN Input

/*
 * CALL WrapLines long_string [,len]
 *
 * Breaks the specified "very long" message string into lines appropriate
 * for terminal output.  Each line will be up to _len_ characters long
 * (80 if len not specified), and will be broken at word boundaries (spaces
 * or tabs).  Each resulting line is written to standard output.
 *
 * 970221  Michael Kelsey
 */

WrapLines:	PROCEDURE
  Parse arg message, len
  If len='' Then len = 80

  Do while message <> ''
     cuts = LASTPOS(' ',LEFT(message,len))	/* Find word break at end */
     cutt = LASTPOS(d2c(9),LEFT(message,len))
     cut = MAX(cuts,cutt)
     if cut = 0 Then cut = len-1

     Say LEFT(message,cut)
     message = SUBSTR(message,cut+1)
  End
Return