SLAC's REXX WWW CGI Function Library

Last Update: 3 Mar 1997. URL=http://www.slac.stanford.edu/slac/www/tool/cgi-rexx/
To call the following functions from your script you will need to include the following in your script:

CALL PUTENV 'REXXPATH=/afs/slac/www/slac/www/tool/cgi-rexx'

Index of REXX CGI Functions
FunctionOwnerGroupBytesUpdatedComment
testfinger cottrellsf1018Nov 11 18:06 Example of a script to provide a finger function
minimal cottrellsf459Mar 3 1996 Simple Illustration of a Form CGI Script
testinput Mwwwoh1306Mar 1 1996 Example to show processing of input
cleanquery cottrellsf707Feb 21 18:37 Removes all occurences of unassigned variables from CGI query string
cgierror cottrellsf524Nov 11 18:04 Reports an error and returns
cgidie cottrellsf535Mar 2 1996 Reports an error and Exits
chkpwd cottrellsf1664Nov 11 18:06 Check a username/password combination
delquery cottrellsf904Mar 3 15:29 Remove item from CGI query string
deweb cottrellsf1549Nov 11 18:06 Converts ASCII Hex coded %XX to ASCII characters
formatdate cottrellsf1344Feb 21 18:37 Parses the date expression given and returns in Oracle format
fullurl cottrellsf531Feb 21 18:37 Returns the complete CGI query URL
getowner cottrellsf384Feb 21 18:36 Returns owner of a specified file
getfullhost cottrellsf414Feb 21 19:26 Returns the fully qualified domain name of the local host
htmlbreak cottrellsf785Feb 21 18:37 Breaks a long line into lines appropriate for HTML parsing
htmlbot cottrellsf135Jan 20 1996 Insert boiler plate at end of page
htmltop cottrellsf305Nov 11 18:19 Insert title and h1 header at top of page
httab cottrellsf2991Nov 11 18:06 Convert a tab delimited file to an HTML table
methget cottrellsf153Nov 21 1995 Returns true if the form is using METHOD="GET"
methpost cottrellsf158Nov 21 1995 Returns true if the form is using METHOD="POST"
myurl cottrellsf239Nov 11 18:06 Adds the URL of the script to the page
oraenv cranebs656Feb 7 1996 Sets up the SLAC Oracle/REXX environment
printheader cottrellsf1192Feb 18 15:02 Inserts the Content-type header
printvariables cottrellsf629Mar 3 1996 Adds a listing of the Form name=value& variables to the page
readform cottrellsf531Jan 26 1996 Reads a Form's "GET" or "POST" input and returns it decoded
readpost cottrellsf1697Nov 11 18:06 Reads the standard input from a form with METHOD="POST"
slacfnok cottrellsf1711Nov 11 18:06 Identifies the allowed visibility of a file
striphtml cottrellsf618Feb 21 18:36 Removes HTML markup from an input string
suspect cottrellsf555Nov 11 18:06 Provides an error message if the input string contains a suspect character
webify cottrellsf1038Nov 11 18:06 Encodes special characters in hex ASCCII %XX form
wraplines cottrellsf716Feb 21 18:36 Breaks long lines into lines appropriate for terminal output


Les Cottrell [Feedback]


cgi-lib.rxx

cgi-lib.rxx

Les Cottrell. Last Update: 3 Mar 1997


/* 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 '<body bgcolor="FFFFFF">'



In=DeWeb(TRANSLATE(GETENV('QUERY_STRING'),' ','+'))

  /*Decode + signs to spaces and hex %XX to chars*/

SAY HTMLTop('Finger' In)'<pre>'

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 '<body bgcolor="FFFFFF">'

Input=ReadForm()

IF Input='' THEN DO  /*Part 1*/

  SAY HTMLTop('Minimal Form')

  SAY '<form><input type="submit">',

      '<br>Data: <input name="myfield">'

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 '<br>Standard input="'ReadPost(StdinFile)'"'

SAY '<br>PATH_INFO="'GETENV('PATH_INFO')'"'

SAY '<br>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 '<html><head><title>'Title'</title></head>'

  SAY '<body><h1>'Title'</h1>'

  IF Body\='' THEN SAY Body

  SAY '</body></html>'

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:  '<pre> %%Loss  %Util%'

  SAY DeWeb('%3cpre%3eName++Address*','*+')

  results in   '<pre>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 "<BR>" 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 = '<BR>'		/* Add breaks to later lines */

     message = SUBSTR(message,cut+1)

  End

Return broken



/* HtmlBot

   Returns the </body>, </html> codes for 

   the bottom of every HTML page

*/

HtmlBot: PROCEDURE

  RETURN '</body></html>'



/* 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 '<html><head><title>'Title'</title></head><body><h1>'Title'</h1>'



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'</body></html>'; 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 '!<br>No input file specified.</br>'

   IF InFn='-'       THEN InFn=''

   IF LINES(InFn)=0  THEN RETURN "!<br>Can't find file' InFn 'or it is empty.</br>"

   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='<CAPTION><b>'InFn'</b></CAPTION><TABLE Border>'

   IF Out THEN CALL LINEOUT(OutFn,Body,1)

   DO L=1 BY 1 WHILE LINES(InFn)>0

      Line=LINEIN(InFn); LineO='<TR>'

      DO WHILE Line\=''

         PARSE VAR Line Pre (Delim) Line 

         LineO=LineO||'<TD>'Pre'</TD>'

      END

      Body=Body||'0a'X||LineO||'</TR>'

      IF Out THEN CALL LINEOUT(OutFn,LineO||'</TR>')

   END

   Body=Body||'0a'x||'</TABLE>'

   IF Out THEN DO

      CALL LINEOUT(OutFn,'</TABLE>')

      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: <first-argument>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||'<dl compact>'||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'<dt><b>'Key.I'</b>'n,

           '<dd><i>'Val.I'</i><br>'n

  END I

RETURN Out||'</dl>'||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("<H1><IMG SRC="babar.gif"> BaBar Experiment</H1>")

 *          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