SLAC's REXX WWW CGI Function Library
Скачать скрипты с Яндекс.Диск
Last Update: 3 Mar 1997. URL=https://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'
| Function | Owner | Group | Bytes | Updated | Comment |
|---|---|---|---|---|---|
| testfinger | cottrell | sf | 1018 | Nov 11 18:06 | Example of a script to provide a finger function |
| minimal | cottrell | sf | 459 | Mar 3 1996 | Simple Illustration of a Form CGI Script |
| testinput | Mwww | oh | 1306 | Mar 1 1996 | Example to show processing of input |
| cleanquery | cottrell | sf | 707 | Feb 21 18:37 | Removes all occurences of unassigned variables from CGI query string |
| cgierror | cottrell | sf | 524 | Nov 11 18:04 | Reports an error and returns |
| cgidie | cottrell | sf | 535 | Mar 2 1996 | Reports an error and Exits |
| chkpwd | cottrell | sf | 1664 | Nov 11 18:06 | Check a username/password combination |
| delquery | cottrell | sf | 904 | Mar 3 15:29 | Remove item from CGI query string |
| deweb | cottrell | sf | 1549 | Nov 11 18:06 | Converts ASCII Hex coded %XX to ASCII characters |
| formatdate | cottrell | sf | 1344 | Feb 21 18:37 | Parses the date expression given and returns in Oracle format |
| fullurl | cottrell | sf | 531 | Feb 21 18:37 | Returns the complete CGI query URL |
| getowner | cottrell | sf | 384 | Feb 21 18:36 | Returns owner of a specified file |
| getfullhost | cottrell | sf | 414 | Feb 21 19:26 | Returns the fully qualified domain name of the local host |
| htmlbreak | cottrell | sf | 785 | Feb 21 18:37 | Breaks a long line into lines appropriate for HTML parsing |
| htmlbot | cottrell | sf | 135 | Jan 20 1996 | Insert boiler plate at end of page |
| htmltop | cottrell | sf | 305 | Nov 11 18:19 | Insert title and h1 header at top of page |
| httab | cottrell | sf | 2991 | Nov 11 18:06 | Convert a tab delimited file to an HTML table |
| methget | cottrell | sf | 153 | Nov 21 1995 | Returns true if the form is using METHOD="GET" |
| methpost | cottrell | sf | 158 | Nov 21 1995 | Returns true if the form is using METHOD="POST" |
| myurl | cottrell | sf | 239 | Nov 11 18:06 | Adds the URL of the script to the page |
| oraenv | crane | bs | 656 | Feb 7 1996 | Sets up the SLAC Oracle/REXX environment |
| printheader | cottrell | sf | 1192 | Feb 18 15:02 | Inserts the Content-type header |
| printvariables | cottrell | sf | 629 | Mar 3 1996 | Adds a listing of the Form name=value& variables to the page |
| readform | cottrell | sf | 531 | Jan 26 1996 | Reads a Form's "GET" or "POST" input and returns it decoded |
| readpost | cottrell | sf | 1697 | Nov 11 18:06 | Reads the standard input from a form with METHOD="POST" |
| slacfnok | cottrell | sf | 1711 | Nov 11 18:06 | Identifies the allowed visibility of a file |
| striphtml | cottrell | sf | 618 | Feb 21 18:36 | Removes HTML markup from an input string |
| suspect | cottrell | sf | 555 | Nov 11 18:06 | Provides an error message if the input string contains a suspect character |
| webify | cottrell | sf | 1038 | Nov 11 18:06 | Encodes special characters in hex ASCCII %XX form |
| wraplines | cottrell | sf | 716 | Feb 21 18:36 | Breaks long lines into lines appropriate for terminal output |
cgi-lib.rxx
Les Cottrell. Last Update: 3 Mar 1997
/* REXX Routines to Manipulate CGI input
cottrell@slac.stanford.edu
https://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:
https://www.bio.cam.ac.uk/web/form.html
https://www.seas.upenn.edu/~mengwong/forms/
For more information on "HTML and CGI Unleashed" see
https://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:
https://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:
https://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='https://'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('https://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