home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Spezial
/
SPEZIAL2_97.zip
/
SPEZIAL2_97.iso
/
ANWEND
/
ONLINE
/
SREFPRC1
/
SSI.SRF
< prev
next >
Wrap
Text File
|
1997-08-27
|
59KB
|
1,866 lines
/* -----------Sre-filter Server side include routine -------------- */
/* Main routine for doing server side includes (ssi's)
1) Check in ssi-cache for thefile? If yes, then
(2) Found in an "as is" state, so send cachefile "as is"
(1) Found in a "partially compiled state", so read the cachefile,
and do ssi's on it (not on thefile)
(0) Not in cache, do ssi's on the thefile.
Possibly save results when done
2) If 1 or 0, then charin thefile into a big string.
Add headers right after the the (first) <BODY> entry.
add footers to the portion right BEFORE the (last) </BODY> entry.
Check for existence of include types.
if include types are found, then process them recursively
Returns:
-1 -- Error when sending (probably a broken connection)
0 --- no ssi's, or some problem == treat as a non-ssi html file
1 -- ssi's done, results 'VAR 'ed back.
2 -- ssi-cached file used "as is"
To reset SSi-cache, call as sref_do_ssi('*RESET*',0,privset)
To report on stattus, call as sref_do_ssi('*STATUS*',0,privset)
In both cases, privset MUST contain SUPERUSER
*/
/* ----------------------------------------------------------------------- */
/* gotit=sref_do_ssi(tfile,usef,sel0,awords,seloriginal,privset,enmadd, ,
DIRLIST,verbose,transaction,tempfile,key_preface,,
servername,host_nickname,home_name, ,
no_processing||' '||no_interpret_code||' '||force_norecord||' '||is_owner_suppress,
myqueue' 'mysem' 'basesem,who,forceit)
*/
sref_do_ssi:
parse arg afile,usef,urlnew,awords,seloriginal,privset,enmadd,,
DIRLIST,VERBOSE,TRANSACTION,TEMPFILE,KEY_PREFACE,,
ss1,home_name,nopes,qstuff,WHO2,forceit,adv_opts
signal on syntax name ssierr ; signal on error name ssierr
parse var ss1 servername host_nickname
parse var who2 who clientname0
if clientname0=' ' then clientname0=0
PARSE VAR DIRLIST SERVDIR CGI_BIN_DIR DDIR HOMEDIR
parse var qstuff myqueue mysem basesem
parse var nopes no_processing no_interpret_code force_norecord is_owner_suppress
no_processing=strip(no_processing); no_interpret_code=strip(no_interpret_code)
is_owner_suppress=strip(is_owner_suppress)
privset=upper(privset);
os2e='os2environment'
OPTION_hit_line=":: still access # "
PARSE VAR SELORIGINAL DOCNAME '?' . /* sometimes used */
docname=strip(docname,'l','/')
docname=strip(docname)
sel0=docname
filter_name=sref_version()
crlf='0d0a'x
/* default value for cgi includes */
cgi_inc_errmsg="Error in CGI Include "
cgi_inc_sizefmt="ABBREV"
cgi_inc_timefmt="%c"
bigin=0
gotdynamics=0
usef=strip(usef)
nocache=1 /* assume no caching */
tdir=strip(get_value('TEMPDATA_DIR'),'t','\')||'\'
/* set flags using adv_opts */
call set_no_ssis adv_opts
/*
do mm=1 to words(ssinos)
aa='!'||substr(strip(word(ssinos,mm)),5)
end
*/
/* should we check cache? First, see if one is active,
Second, see if in ssi_cache_list */
if usef=1 then do /* use passed string */
bigin=afile ; afile=action ; nocache=1
end
else do /* read from a file --- PERHAPS FROM CACHE? */
/* but, first check if its a clear cache or status call */
astatus=0 ; cacheme=0 /* not now cached, don't cache */
cache_size=get_value('SSI_CACHE_SIZE') /* or from cache? */
if ABBREV(strip(upper(afile)),'*RESET')=1 then do
if cache_size=0 then return ' 0 SSI-caching not enabled '
if wordpos('SUPERUSER',privset)+wordpos('CONTROL',privset)=0 then return '-1 Not a superuser '
foo=ssi_queue(afile,tempfile,1)
'file erase type text/plain name ' tempfile
return ' 1 SSI-cache reset '
end /* Do */
if ABBREV(strip(upper(afile)),'*REMOVE')=1 then do
if cache_size=0 then return ' 0 SSI-caching not enabled '
if wordpos('SUPERUSER',privset)+wordpos('CONTROL',privset)=0 then return '-1 Not a superuser '
foo=ssi_queue(afile,tempfile,1)
'file erase type text/plain name ' tempfile
return ' 1 SSI-cache removals '
end /* Do */
if ABBREV(strip(upper(afile)),'*STATUS')=1 then do
if cache_size=0 then return ' 0 SSI-caching not enabled '
if wordpos('SUPERUSER',upper(privset))=0 then return '-1 Not a superuser '
foo=ssi_queue(afile,tempfile,1)
'file erase type text/plain name ' tempfile
return ' 1 SSI-cache status report '
end /* Do */
if strip(upper(afile))='*CLEANUP'then do
if cache_size=0 then return ' 0 SSI-caching not enabled '
if wordpos('SUPERUSER',upper(privset))=0 then return '-1 Not a superuser '
foo=ssi_queue('*CLEANUP',tempfile,1)
'file erase type text/plain name ' tempfile
return ' 1 SSI-cache cleanup report '
end /* Do */
if cache_size>0 & forceit<>1 & ssino.!NO_CACHE=0 then do /* is caching ok?*/
nocache=0
foo=ssi_queue(afile,,0) /* it is, go look it up*/
parse var foo astatus afile2 ; astatus=strip(astatus); afile2=strip(afile2)
end /* caching okay */
if astatus=1 then do /* FROM CACHE AS IS ----------*/
if stream(afile2,'c','query exists')<>' ' then do
ysz=dosdir(afile2,'s')
if adv_opts<>' ' then foo=sref_adv_opts_header(adv_opts,'200 '||ysz,servername)
'file type text/html nocache NAME ' afile2 /* tell goserve to send it */
return (ysz+0.01) /* ssi-file send from cache */
end
else do /* error in cache */
call pmprintf_srf(" SSI-cache error 1: no such file= " afile2)
astatus=0 ; cacheme=0
end
end
if astatus=2 then do /* FROM CACHE WITH CHANGES */
bigin=sref_grab_file(afile2,30)
if bigin=0 | bigin="" then do /*problem opening ! */
call pmprintf_sref( "SSI cache error 2: file could not be read:" afile2)
astatus=0
end
else do
if verbose>2 then call pmprintf_sref(" Using partially cached file: " afile2)
end
end /* status 2 */
if astatus=0 then do /*NOT IN CACHE, OR ERROR IN CACHE */
bigin=sref_grab_file(afile,30)
if bigin=0 | bigin="" then do /*problem opening ! */
call pmprintf_sref(" ERROR: Could not open file for includes : " afile)
return 0 /* error, treat as non-ssi html file */
end
cacheme=1 /* 1 signals "new entry */
end
end /* USEF -- from file, or from passed string (remotely gathered */
usedfile=afile
if c2d(right(bigin,1))=26 then
bigin=left(bigin,length(bigin)-1)
tbigin=translate(bigin)
inctype.1="INTERPRET"
inctype.2="OPTION"
inctype.3="INCLUDE"
inctype.4="REPLACE"
inctype.5="SELECT"
inctype.6='#'
inctype.7='CACHE'
i5=7
if key_preface<>" " & key_preface<>0 then do
do mm=1 to 5
inctype.mm=key_preface||inctype.mm
end
inctype.7=key_preface||inctype.7
end
apre=1 ; apost=1
headers=get_value('HEADERS')
footers=get_value('FOOTERS')
if headers=0 then headers=" "
if footers=0 then footers=" "
if headers=" " then apre=0
if footers=" " then apost=0
/* note that j.i may or may not be in a keyphrase! */
booger=apre+apost
do mm=1 to i5
if booger>0 then leave
booger=booger+pos(inctype.mm,tbigin)
end
/* NO include keyphrases -- so send it (note we could use a VAR with bigin,
but this complicates caching and generates an expires inappropriately) */
if booger = 0 then do
return 0
end
interpret_file=value(enmadd||'INTERPRET_FILE',,os2e)
counter_file=value(enmadd||'COUNTER_FILE',,os2e)
optlist.0= make_optlist(awords) /* used by options keyphrase */
interp_data=""
current_hit.num=0 /* 0 means not counted yet */
current_hit.item=""
current_hit.mess1=""
current_hit.mess2=""
cache_args=' '
force_asis=0 /* set by cache asis */
check_initfilt=0 ; check_repstrgs=0
include_list=' ' ; notrigger=0
/* add pre or post blocks if they have been specified (typically in initfilt) */
if apre=1 & astatus=0 & ssino.!no_header=0 then do
foo=upper(space(strip(headers),0))
idog=1
if abbrev(foo,'<BODY')=1 then idog=2
bigin=sref_insert_block(bigin,'BODY',headers,idog,'<','>')
end
if apost=1 & astatus=0 & ssino.!no_footer=0 then do
bigin=bigf_footer(footers)
end
delims=get_value('DELIMS')
do_send_piece=get_value('DO_SEND_PIECE')
fix_expire=get_value('FIX_EXPIRE')
if delims>1 then nocache=1 /* avoid trouble: only cache if one delimiter set */
dynamics.0=0 /* dynamic caches, need for ssi-cache constructin */
pass1=0 /* number of passes through data */
/* check for "send in pieces " --no fix_expire, no 2nd delimiter, no advanced opts */
if delims=1 & nocache=1 & fix_expire=0 & do_Send_piece=1 & adv_opts="" then
send_piece=1
else
send_piece=0
if send_piece=1 then do
'SET NETBUFFER OFF '
'SEND TYPE text/html as ' afile
end
/* now start processing bigin */
nsubs=0 /* # of substitutions encountered */
totinc=0 ; badints=0 ; goodints=0
/* For flexibility, we process this for each set of "keyphrase delimiters",
where set k=1..K is defined using delim_1.k and delim_2.k (typically set
in initfilt) */
do mm=1 to delims
delim_1.mm=get_value('DELIM_1.'mm)
delim_2.mm=get_value('DELIM_2.'mm)
end
ithdelim=1
adelim1=delim_1.1
adelim2=delim_2.1
if adelim1="" | adelim2="" | adelim1=0 | adelim2=0 then return 0 /* bad initial delimiter -- don't do includes */
one_more_scan: /* jump here for multiple delimiters sets */
outbig=''
found_a_select=0
do forever /* done when done */
parse var bigin t1 (adelim1) in1 (adelim2) bigin
if send_piece=1 & t1<>"" then do
'VAR NAME T1 '
if rc<0 then do
'send complete'
return -1
end
end
else do
outbig=outbig||t1
end
if in1="" & bigin="" then leave
/* see if in1 is one of the inctypes (inctypes are aka keywords)*/
in2=translate(in1)
in2=translate(in2,' ','=:;') /* space is the generic seperater */
aninc=0 ;
/* is first one of our keywords ? */
do mm=1 to i5
if abbrev(word(in2,1),inctype.mm)=1 then do /* it's the mm'th inc type */
aninc=mm
if mm>1 & mm<5 then do /* option include replace */
thearg=word(in2,2)
end
else do
if mm=1 then do
foo=pos('INTERPRET',translate(in1))
thearg=substr(in1,foo+9)
end
if mm=6 then do
foo=pos('#',translate(in1))
thearg=substr(in1,foo+1)
end
if mm=5 then do
foo=pos('SELECT',translate(in1))
thearg=substr(in1,foo+6)
end
if mm=7 then do
foo=pos('CACHE',translate(in1))
thearg=substr(in1,foo+5)
end
end
leave /* leave this lttle loop */
end
end
/* Not a keyword, or a syntactically bad keyphrase */
if aninc=0 then do
if bigin<>"" then
t1=adelim1||in1||adelim2 /* leave it be */
else
t1=adelim1||in1 /* openended "comment" */
if send_piece=1 then do
'VAR NAME T1'
if rc<0 then do
'send complete'
return -1
end
end
else
outbig=outbig||t1
iterate
end
/* ------- DO SOME WORK (if here, we have a (possibly) good keyphrase) */
nsubs=nsubs+1
asis_ok=1 /* assume non- "dynamic" include */
got_select=0 /* is a SELECT */
select
when aninc=6 then do /* NCSA stuff */
putme=do_cgi_include(thearg)
if completed() then return extract('bytessent') /* might happen */
end
when aninc=1 & no_processing=0 & ssino.!NO_INTERPRET=0 then do /* INTERPRET */
asis_ok=0 /* too dynamic, don't try to cache */
putme=line_interpret(thearg,no_interpret_code)
if completed() then return extract('bytessent') /* might happen */
if putme="" then
badints=badints+1
else
goodints=goodints+1
end
when aninc=2 & ssino.!NO_OPTION=0 then do /* OPTION */
asis_ok=0 /* too dynamic, don't try to cache */
putme=line_message(thearg)
end
when aninc=3 & ssino.!NO_INCLUDE=0 then do /* INCLUDE */
putme=line_include(thearg)
if putme<>"" then
totinc=length(putme)+totinc
end
when aninc=4 & ssino.!NO_REPLACE=0 then do /* REPLACE */
putme=line_replace(thearg)
end
when aninc=7 then do /* CACHE directive. Store for later */
if nocache=0 then do /* ignore if nocache is on */
if wordpos('NO',upper(thearg))| wordpos('OFF',upper(thearg)) >0 then do
nocache=1
cacheme=0
end /* Do */
if wordpos(strip(upper(thearg)),'ASIS') then force_asis=1
if wordpos(strip(upper(thearg)),'NOTRIGGER') then notrigger=1
cache_args=cache_args" "upper(thearg)" ; " /* other arguments */
end
putme=' ' /* it's a directive, so just remove it */
end
when aninc=5 & no_interpret_code=1 & ssino.!NO_SELECT=0 then do /* SELECT */
if verbose>2 then
call pmprintf_sref(" Unallowed SELECT (using in-document code): " seloriginal)
putme=""
end
when aninc=5 & no_processing=0 & no_interpret_code=0 & ssino.!NO_SELECT=0 then do
asis_ok=0 /* too dynamic, don't try to cache */
got_select=1
if pass1=0 then do /* SELECT ONLY on 2nd pass */
putme=in1; found_a_select=1
end
else do /* do the SELECT */
prot1=enmadd ; prot2=host_nickname ; prot3=servername
prot5=host_nickname
useit=do_select(thearg) /* note protected globals */
enmadd=prot1 ; host_nickname=prot2 ; servername=prot3
host_nickname=prot5
putme=""
if useit=0 then do /* 0=EXCLUDE it ! */
/* scan for next SELECT, and delete everything in between */
bigin=bigin
putme=""
do until bigin=""
parse var bigin tt1 (adelim1) tt2 (adelim2) bigin
if TT2="" & bigin="" then leave
IF translate(word(tt2,1))=inctype.5 then leave
end /* until bigin="" */
end /* useit */
end /* pass1=0 */
end /* WHEN select */
otherwise /* possibly a suppressed keyphrase */
putme=""
end
/* strip trailing ctl-z ? */
if c2d(right(putme,1))=26 then
putme=left(putme,length(putme)-1)
/* if it's a dynamic include, and caching is on, then put in a placemarker */
if pass1=0 & nocache=0 & asis_ok=0 then do /* use placemarker? */
il=dynamics.0+1 ; dynamics.0=il
dynamics.il=putme /* the replacmente */
aputme=adelim1||in1||adelim2 /* leave it be (for later processing */
dynamics.il.!putme=aputme
dynamics.il.!gotselect=got_select
outbig=outbig||aputme /* don't recurse, you'll be trapped */
end
else do
if got_select=1 then do
aputme=adelim1||in1||adelim2
outbig=outbig||aputme /* don't recurse, you'll be trapped */
end
else do
bigin=putme||bigin /* this is the recursive part */
end
end
end /*of bigin parse loop */
/* if send mode, then all done (note, if send mode, then caching was NOT done */
if send_piece=1 then do
if totinc>0 | (goodints+badints)>0 then
if VERBOSE>1 then sall pmprintf_sref(" Includes: " totinc " ; (good/bad interps ) " goodints "," badints)
'SEND COMPLETE '
return extract('bytessent')
end
/* if caching on, store current state to temporary file
Note that placeholders are saved */
pass1=pass1+1
if dynamics.0>0 then gotdynamics=1 /* dictates if this is a NOCHANGEr */
/* first pass -- then possibly save to cache */
if pass1=1 then do
/* if force_asis=1, then fix dynamics BEFORE saveing*/
if force_asis=1 then do
do jj=1 to dynamics.0
foo=ssi_replacestrg(jj)
end
end
if nocache=0 & cacheme>0 then do
i80=extract('serverport')
t2=tdir'_CSH????.'||i80
savef=dostempname(t2)
if savef="" then nocache=1 /* error, don't cache */
foo=charout(savef,outbig,1)
aa=stream(savef,'c','close')
if foo<>0 then nocache=1 /* ereror */
end
/* resolve "dynamic" includes?
Check even if nocache=1 (might be stuff from before a cache no keyphrase )*/
if force_asis=0 then do
do jj=1 to dynamics.0
foo=ssi_replacestrg(jj)
end
end
end
/* might have to do another pass, if dynamic placemarkers were used (or a SELECT ) */
if dynamics.0>0 | found_a_select=1 then do /* continue recursie processing, after delayed dynamic includes */
dynamics.0=0 /* when pass1>0, no more dynamics will not be placemarked */
bigin=outbig
signal one_more_scan
end /* Do */
/* check for another set of delimiters ? */
ithdelim=ithdelim+1
do until ithdelim>delims
adelim1=strip(get_value('DELIM_1.'||ithdelim))
adelim2=strip(get_value('DELIM_2.'||ithdelim))
if adelim1=' ' | adelim2=' ' | adelim1=0 | adelim2=0 then iterate
if pos(adelim1,outbig)=0 then do
ithdelim=ithdelim+1
iterate
end
leave
end
if ithdelim <= delims then do
bigin=outbig
signal one_more_scan
end
/* else, we are done */
if c2d(right(outbig,1))=26 then
outbig=left(outbig,length(outbig)-1)
ncc2=length(outbig)
if fix_expire>0 then do /* override goserve response headers */
foo=sref_expire_response(fix_expire,ncc2)
end
if totinc>0 | (goodints+badints)>0 then
if VERBOSE>1 then call pmprintf_sref(" Includes: " totinc " ; (good/bad interps ) " goodints "," badints)
if adv_opts<>' ' then foo=sref_adv_opts_header(adv_opts,'200 '||length(outbig),servername)
saveas=space(afile,0)
oof=min(39,length(saveas))
saveas=right(saveas,oof)
'var type text/html as ' saveas 'NAME outbig ' /* tell goserve to send it */
retstat=ncc2
if rc<0 then retstat=-1
/* note: cache_args: NO, then do NOT cache
AS IS: then send "as is"
TRIGGER: then check this file(s) to be sure that
it's up to date
*/
returnit: /* jump here to write cache?, then exit */
if nocache=0 & cacheme>0 then do /* useing cache, on a not-in-cache file */
arglist=""
if check_repstrgs=1 & notrigger=0 then do
foo=get_value(repstrgs_file)
include_list=include_list||' '||foo
end
if check_initfilt=1 & notrigger=0 then do
foo=get_value(initfilt_file)
include_list=include_list||' '||foo
end
/* notrigger argument is dealt with in ssicache */
if notrigger=0 & include_list<>' ' then cache_args=cache_args||' ; TRIGGER '||include_list
if gotdynamics=0 then cache_args=cache_args||' ; NOCHANGE ' /* all statics */
foo=ssi_queue(afile,savef||' '||cache_args,0)
if verbose>2 then call pmprintf_sref(" Saved " afile " to ssi cache:" savef ' (args='cache_args)
end
return retstat
/* -----------procedure---------------------------*/
/* make optlist for use by options keyphrase */
make_optlist: procedure expose optlist. verbose servername host_Nickname enmadd privset
parse arg selinfo
if selinfo=" " then return 0
eek=0
if selinfo<>0 then do /* note we convert url's to regular ascii */
selinfo=translate(selinfo, ' ', '+'||'090a0d'x) /* Whitespace, etc. */
selinfo=packur(selinfo)
do until selinfo = " "
eek=eek + 1
parse var selinfo optlist.eek '&' selinfo
end
end
return eek
/* -----------------------------------------------------------
Evaluate a cgi-bin (NSCA HTTPD style server side include
----------------------------------------------------------- */
do_cgi_include:
parse arg thearg
parse var thearg atype aval
/* valid atypes:
INCLUDE = Include a file
ECHO = "replace" with a cgi-bin variable
FSIZE= Size of a file
FLASTMOD = Last modification date of a file
EXEC = Execute a command file or a cgi-program
*/
tatype=strip(translate(atype))
a1='!NO_#ECHO';a2='!NO_#CONFIG';a3='!NO_#FILESTAT';a4='!NO_#INCLUDE';a5='!NO_#EXEC'
if ( tatype="ECHO" & ssino.a1=1) ,
| (tatype="CONFIG" & ssino.a2=1) ,
| ( (tatype="FSIZE" | tatype="FLASTMOD") & ssino.a3=1) ,
| (tatype="INCLUDE" & ssino.a4=1) ,
| (tatype="EXEC" & ssino.a5=1) then do
return " "
end
if wordpos(tatype,' INCLUDE FLASTMOD FSIZE ')>0 then do
parse upper var aval ftype '=' aval
aval=strip(strip(aval),,'"') ; ftype=strip(ftype) ; figit=0
if ftype='FILE' then do /* relative to absolute directory" */
if usef=1 then do
return cgi_inc_errmsg
end
adr=filespec('d',afile)
apt=filespec('p',afile)
aval=adr||apt||aval
figit=1
end
else do
nop
end
end
if tatype="INCLUDE" then do
putme=line_include(aval,,figit,1)
if putme=0 | putme="" then putme=cgi_inc_errmsg
return putme
end
if (tatype="FSIZE" | tatype="FLASTMOD") then do
cfile=line_include(aval,'YES',figit,1)
oy=sysfiletree(cfile,'stuff','FT')
if stuff.0=0 then
return cgi_inc_errmsg
parse var stuff.1 adate asize .
parse var adate yy '/' mo '/' dd '/' hh '/' mm '/' ss
if ss=' ' then ss='00'
yip=yy||'/'||mo||'/'||dd
adatef=dateconv(yip,'O','B')
atimef=hh||':'||mm||':'||ss
if tatype="FLASTMOD" then do
asis_ok=0
putme=sref_datetime_convert(cgi_inc_timefmt,adatef,atimef)
return putme
end
if tatype="FSIZE" then do
asis_ok=0
if translate(cgi_inc_sizefmt)="ABBREV" then do
if asize>=1000000 then
return format(asize/1000000,,0)||'M'
if asize>=1000 then
return format(asize/1000,,0)||'K'
end
/* convert to xxx,yyy,zzz */
il=length(asize)
if il>3 then do
oop=""
do mm=il to 3 by -3
tt=substr(asize,mm-2,3)
if mm=il then
oop=tt
else
oop=tt||','||oop
end /* do */
if mm<>0 then oop=substr(asize,1,mm)||','||oop
asize=oop
end
return asize /* not abbrev, or < 1000 */
end
end
if tatype="CONFIG" then do
asis_ok=0
parse var aval t1 '=' t2 ;t1=translate(t1)
t2a=strip(strip(t2),,'"')
putme=""
select
when t1="ERRMSG" then
cgi_inc_errmsg=t2a
when t1="TIMEFMT" then /* non standard for now */
cgi_inc_timefmt=t2a
when t1="SIZEFMT" then
cgi_inc_sizefmt=translate(t2a)
otherwise
putme=cgi_inc_errmsg
end
return putme
end
if tatype="ECHO" then do
parse var aval foo '=' findme ; findme=translate(findme)
findme=strip(strip(findme),,'"')
select
when findme="DOCUMENT_NAME" then
putme=afile
when findme="DOCUMENT_URI" then do
asis_ok=0
putme=seloriginal
end
when findme="DATE_LOCAL" then do
asis_ok=0
putme=sref_datetime_convert(cgi_inc_timefmt)
end
when findme="DATE_GMT" then do
asis_ok=0
putme=sref_new_gmt(,,,1)
parse var putme adate atime
putme=sref_datetime_convert(cgi_inc_timefmt,adate,atime)
end
when findme="LAST_MODIFIED" then do
if usef=1 then do
putme=cgi_inc_errmsg
end
else do
eek=sysfiletree(translate(afile,'\','/'),gosh,'FT')
parse var gosh.1 adate asize .
parse var adate yy '/' mo '/' dd '/' hh '/' mm '/' ss
if ss=' ' then ss='00'
adatef=dateconv(yy||'/'||mo||'/'||dd,'O','B')
atimef=hh||':'||mm||':'||ss
putme=sref_datetime_convert(cgi_inc_timefmt,adatef,atimef)
return putme
end /* usef */
end /* last modified */
when findme="SERVER_SOFTWARE" then do
putme=server('H')||' '||filter_name
end
when findme="SERVER_NAME" then
putme=servername
when findme="GATEWAY_INTERFACE" then
putme="CGI/1.1"
when findme="SERVER_PROTOCOL" then do
'Extract serverprotocol'
putme=serverprotocol
end
when findme="SERVER_PORT" Then do
'extract serverport'
putme=serverport
end
when findme="REQUEST_METHOD" then do
asis_ok=0
'extract clientmethod'
putme=clientmethod
end
when findme="PATH_INFO" then
putme=" Path_info n.a. "
when findme="PATH_TRANSLATED" Then
putme="Path_translated n.a. "
when findme="SCRIPT_NAME" then do
asis_ok=0
putme=sel0
end
when findme="QUERY_STRING" then do
asis_ok=0
putme=awords
end
when findme="REMOTE_HOST" then do
asis_ok=0
if clientname0=0 then do
putme=sref_clientname(who,mysem,myqueue,basesem,enmadd,transaction)
clientname0=putme
end
else do
putme=clientname0
end
end
when findme="REMOTE_ADDR" then do
asis_ok=0
'extract clientaddr'
putme=clientaddr
end
when findme="AUTH_TYPE" then
putme="Basic Access Authentication Scheme"
when findme="AUTH_NAME" then do
asis_ok=0
afield=reqfield('Authorization')
parse var afield . m64 . /* get the encoded cookie */
dec=pack64(m64) /* and decode it */
parse upper var dec putme ':' .
end
when findme="REMOTE_IDENT" then
putme="Remote_ident n.a. "
when findme="CONTENT_TYPE" then
putme="Content_type n.a."
when findme="CONTENT_LENGTH" then
putme="Content_length n.a."
when abbrev(findme,"HTTP_") then do
asis_ok=0
if findme="HTTP_ACCEPT" then do
i = 1
_acc = REQFIELD("accept")
acc = '%'
ClientAccepts = ''
do while (acc \= _acc)
acc = REQFIELD("accept", i)
if (ClientAccepts \= '') then ClientAccepts = ClientAccepts', 'acc
else ClientAccepts = acc
i = i+1
end
putme=clientaccepts
end
else do
parse var findme . '_' findme2
putme=reqfield(findme2)
end
end
otherwise
putme=cgi_inc_errmsg
end /* select */
return putme
end
if tatype="EXEC" then do
asis_ok=0
if no_Processing=1 then return ' ' /* do not allow ssps */
parse var aval foo '=' aval2
aval2=strip(strip(aval2),,'"')
aval2='cgi-bin/'||aval2
tempdata_dir=value(enmadd||'TEMPdata_DIR',,os2e)
cmdfile=dostempname(tempdata_dir||'\f?'||space(right(transaction,6),0)||'.cmd')
clientname0=sref_clientname(who,mysem,myqueue,basesem,enmadd,transaction)
'extract clientmethod'
servername=servername
'extract clientprotocol'
'extract clientaddr'
'extract serverport '
aa=rxqueue('s','SESSION')
gotit=sref_docgi(cgi_bin_dir,aval2 ,clientmethod, clientname0, filter_name, serverport , ,
servername, clientprotocol, ddir,clientaddr,tempfile,cmdfile,1, ,
verbose,enmadd,,,privset)
/* see if a content-type:xxx first line, followed by blank. if so, strip it)*/
foo=strip(upper(left(gotit,150)))
if abbrev(foo,'CONTENT-TYPE:') then do
crlf='0d0a'x
parse var gotit foo2 (crlf) foo3 (crlf) restx
if foo3="" then gotit=restx
end
return gotit
end /* not a cgi-bin/mapimage call */
return cgi_inc_errmsg
/* ----------------------------------------------------------- */
/* Evaluate thearg in SELECT keyphrase */
/* call as procedure to protect internal variables */
/* ----------------------------------------------------------- */
do_select:procedure expose enmadd host_nickname optlist. privset servername verbose ,
docname usedfile
parse arg thearg
result='RESULT' ; results='RESULTS'
select.result=1
select.results=-135 /* an arbitrary non 0 / 1 value */
if translate(thearg)="END" then /* if thearg="END", it's junk */
return 1
thearg=translate(thearg, ' ', '090a0d'x)
signal off syntax ; signal off error
signal on syntax name sele1
signal on error name sele1
interpret thearg
signal off syntax
signal off error
signal on syntax name ssierr ; signal on error name ssierr
result='RESULT' ; results='RESULTS'
if select.results <> -135 then /* aid to sloppy programmers */
select.result=select.results
signal sele2
sele1: /* here on syntax error */
signal off syntax
signal off error
signal on syntax name ssierr ; signal on error name ssierr
foo=condition('d')
call pmprintf_sref(" Error in SELECT: " foo ; audit "Error in SELECT: " thearg " : " foo)
return 1
sele2:
if select.result=1 then return 1
return 0
/* ----------------------------------------------------------------------- */
/* Look for INTERPRET keyphrases
. Note: Results of these INTERPRET keyphrases, for inclusion in the document,
. must be stored in the INTERPRET.RESULTS variable.
.
. There are 3 types of code-blocks:
. 1) Included in the keyphrase: INTERPET CODE rexx code
. 2) Included in the INTERPET.IN collection of code-blocks: INTERPRET ALABEL
. 3) In it's own file: INTERPET FILE FILENAME.
*/
/* ----------------------------------------------------------------------- */
line_interpret:
parse arg thisarg,no_code
/* pull block from: { thisarg } block {nextarg } */
thisarg=translate(thisarg, ' ','090a0d'x) /* Whitespace, etc. */
atype=strip(translate(word(thisarg,1)))
do koi=1 to 10
al.koi=' '
end
select
when atype='FILE' then do /*file match */
bfile=strip(word(thisarg,2))
if words(thisarg)>2 then do /* extract optional arguments*/
atmp=subword(thisarg,3)
koi=0
do until atmp=""
koi=koi+1
parse var atmp aww ',' atmp
al.koi=strip(aww)
end
end
addir=get_value('ADDON_DIR')
filename=sref_do_virtual(addir,bfile,enmadd,1,transaction,homedir,host_nickname)
if filename=0 then do
thestring=0
end
else do
j0=sref_fileread(filename,'tmp1')
if tmp1.0=0 then do
call pmprintf_sref(" SSI error: empty INTERPRET file: "filename "(" thisarg)
return ' '
end
thestring=""
do j1=1 to j0
j2=strip(translate(tmp1.j1,' ','000d0a001a'x))
j3=right(j2,1)
select
when j3=";" then
thestring=thestring||j2||crlf
when j3="," then
thestring=thestring||left(j2,length(j2)-1)
otherwise
thestring=thestring||j2||" ; "||crlf
end
end
end
end
when atype="CODE" then do
if no_code=1 then do
if verbose>2 then
call pmprintf_sref(" Unallowed attempt at interpreting in-document code: " seloriginal)
return " " /* no interpret code*/
end
else do
thestring= strip(subword(thisarg,2))
end
end
otherwise do
call get_interpret /* set interp_data global */
thestring=strip(sref_extract_block(interp_data,thisarg))
end
end
if thestring="" | thestring=0 then do
call pmprintf_sref(" Can not find INTERPRET keyphrase: " thisarg ; audit " Can not find INTERPRET keyphrase: " thisarg)
return ""
end
/* isolate interpret, and feed is arg list - thestring is exposed */
prot1=enmadd ; prot2=host_nickname ; prot3=servername ; prot4=docname
prot5=host_nickname
usesay=get_value('USE_STDOUT')
aresu=interpret_phrase(al.1,al.2,al.3,al.4,al.5,al.6,al.7,al.8,al.9,al.10)
enmadd=prot1 ; host_nickname=prot2 ; servername=prot3 ; docname=prot4
host_nickname=prot5
/* clean out queue */
if usesay=1 then do
do while queued()>0
pull foo
end
end
return aresu
/* Interpret a phrase --- protecting other global variables */
interpret_phrase:procedure expose enmadd host_nickname optlist. privset servername verbose ,
docname usedfile thestring myqueue usesay host_nickname
/* note that upto 10 args are available to the code block, using standard
rexx syntax: i.e.; av1=arg(1) */
thestring=translate(thestring, ' ','090a0d'x) /* Whitespace, etc. */
result='RESULT' ; results='RESULTS'
interpret.result="" /* clear any residual value */
interpret.results="" /* for sloppy programmers.... */
if usesay=1 then foo=rxqueue('s',myqueue)
signal off syntax ; signal off error
signal on syntax name doggs ;signal on error name doggs
interpret thestring
signal off syntax ; signal off error
signal on syntax name ssierr ; signal on error name ssierr
result='RESULT'
if interpret.result="" then do /* help out forgetfull programmers */
results='RESULTS'
interpret.result=interpret.results
end
if usesay=1 then do
tmpres='';crlf='0d0a'x
pigs=queued()
do jj=1 to pigs
parse pull eek1
tmpres=tmpres||eek1||crlf
end
if tmpres<>'' then interpret.result=interpret.result||crlf||tmpres
end
return interpret.result
doggs: /* here on syntax error */
signal off syntax ; signal off error
signal on syntax name ssierr ; signal on error name ssierr
foo=condition('d')
call pmprintf_sref(" Error interpreting: " thestring )
audit "Error interpeting: " left(thestring,30)
return ""
/* ----------------------------------------------------------------------- */
/* Look for INCLUDE keyphrases
. If present, pull in lines from INCLUDE file.
.
. Note: INCLUDE files are subject to further processing
. -- so BEWARE of recursive TRAPS !
. Justfile argument used by CGI_INCLUDE routine
*/
/* ----------------------------------------------------------------------- */
line_include:
parse arg incfil0 , justfile ,absname,nocheck
justfile=translate(justfile)
if absname=1 then do
incfile=incfil0
end
else do
incfile=sref_do_virtual(ddir,incfil0,enmadd,1,transaction,homedir,host_nickname)
end
if justfile="YES" then return(incfile)
/* recursion check */
if (nocheck<>1 ) & ( wordpos(upper(incfile),include_list||' '||upper(afile))>0) then do
if verbose>0 then call pmprintf_sref( " Warning: recursive ssi in " docname " (can not get " incfile)
putme='<!-- Error: recursive SSI of ' incfil0 ' -->'
return putme
end
putme=sref_grab_file(incfile,20)
if putme=0 then putme=""
include_list=include_list||' '||upper(incfile)
return putme
/* ----------------------------------------------------------------------- */
/* This will do a OPTION replace on the line.
Keyphrases of the form <!--OPTION=nnn--> are looked for, the nnn is decoded,
and optlist.nnn is use to replace the keyphrase (if nnn not specified,
the keyphrase is removed).
Note that optlist is construced from elements following a ?xxx&xxx type of
request string (c
*/
/* ----------------------------------------------------------------------- */
line_message:
parse arg id1
putme=""
if datatype(id1)='NUM' then
if symbol('optlist.id1')='VAR' then /* check for a mess up */
putme=optlist.id1
return putme
/* ----------------------------------------------------------------------- */
/* This will do a REPLACE: on a line. The currently supported values are
DATE todays date
TIMEGMT current time (GMT)
TIME current time
CREATION A message on the creation date & time of the file
CREATION_DATE Just the creation date
CREATION_TIME Just the creation time (use with CREATION_DATE and your own message)
WEBMASTER The contents of the WEBMASTER parameter
REFERER The referer (from the request header)
BROWSER The requesters browser (from the request header)
CLIENTNAME USERNAME ABC.DDD.GOV type name, or ip address if n.a.
INHOUSE.n n = an integer. Used for messages to INHOUSE users only.
SUPERUSER.n n = an integer. Used for messages to Superusers only
HITS The nth hit for this file (requires looking at Counter_file
Also COUNTS, OPTION_HITS.n and OPTION_COUNT.n variants
WEBMASTER = Webmaster address
SERVERNAME = Name of server (i.e.; WWW.FOO.ORG)
SERVER = Server software (i.e. GOSERV 2.45)
FILTER_NAME = The name of this filter (set at the top of this file)
VARIABLE.varname = Extract value of varname from environment
If not in environment, see if a built in variable
(such as SERVERPORT and PRIVSET).
See srefmon.cmd for examples of environment vars.
READ_HEAD Do a READ HEADER VAR PUTME , append <PRE>
and ... Check replacestrg_file (static replacements) if no match from above.
/* ----------------------------------------------------------------------- */
*/
line_replace:
parse arg targ
parse upper var targ reparg "." repargn /* parse out VAR.j types of labels */
issuper=0 ; isin=0;
if wordpos('SUPERUSER',translate(privset))>0 then
issuper=1
else
if wordpos('INHOUSE',translate(privset))>0 then
isin=1
select
when reparg="DATE" | reparg="DATE_LOCAL" then do
putme=date('N')
asis_ok=0
end
when reparg="TIME" | reparg="TIMELOCAL" | reparg="TIME_LOCAL" then do
putme=time('C')
asis_ok=0
end
when reparg="TIMEGMT" | reparg="TIME_GMT" then do
/* Computes GMT time as Wed, 12 Aug 1996 21:18:20 format */
asis_ok=0
fii=sref_new_gmt()
parse var fii eek ',' d1 d2 d3 t1
putme=t1||' GMT '
end
when reparg="DATEGMT" | reparg="DATE_GMT" then do
asis_ok=0
fii=sref_new_gmt()
parse var fii eek ',' d1 d2 d3 .
putme=d1||' '||d2||' '||d3
end
when reparg="USERNAME" | reparg="USER" | reparg="USER_NAME" ,
| reparg="CLIENTNAME" | reparg='CLIENT' then do
asis_ok=0
if clientname0=0 then
putme=sref_clientname(who,mysem,myqueue,basesem,enmadd,transaction)
else
putme=clientname0
clientname0=putme
end
when reparg="FILTER_NAME" | reparg="FILTER_NAME" then
putme=filter_name
when reparg="HOME_NAME" | reparg="HOMENAME" then do
putme=home_name
check_initfilt=1
end
when reparg="CREATION" then do /* a creation-date-time message */
if usef=1 then do
putme='n.a.'
end
else do
eek=sysfiletree(translate(afile,'\','/'),gosh,'F')
poop=gosh.1
parse var poop adate atime .
adate=dateconv(adate,'u','n')
putme =' <em> This document last modified at '||atime||', on '||adate|| '. </em>'
end
end
when reparg="CREATION_DATE" then do /*just the creation date */
if usef=1 then do
putme='n.a.'
end
else do
eek=sysfiletree(translate(afile,'\','/'),gosh,'F')
poop=gosh.1
parse var poop adate atime .
adate=dateconv(adate,'u','n')
putme =adate
END
end
when reparg="CREATION_TIME" then do /* just the creation time */
if usef=1 then do
putme='n.a.'
end
else do
eek=sysfiletree(translate(afile,'\','/'),gosh,'F')
poop=gosh.1
parse var poop adate atime .
putme =atime
END
end
when reparg="READ_HEAD" | reparg='HEADER'then do /* read/display the request header */
asis_ok=0
'READ HEADER VAR PUTME '
putme='<PRE>'||putme||'</pre>'
end
when (reparg="INHMESS" | reparg="INHOUSE" )& isin=1 then do
asis_ok=0
check_initfilt=1
putme=get_value('INHOUSE.'||repargn)
end
when (reparg="SUPMESS" | reparg="SUPERUSER") & issuper=1 then do
asis_ok=0
check_initfilt=1
putme=get_value('SUPERUSER.'||repargn)
end
when abbrev(reparg,"REFER")=1 then do
asis_ok=0
putme=reqfield("Referer")
end
when (reparg="USER-AGENT" | reparg="BROWSER" ) THen do
asis_ok=0
putme=reqfield("User-Agent")
end
when (reparg="URL") then do
asis_ok=0
servername=servername
'extract serverport'
putme=sref_fix_url(seloriginal,servername,serverport)
end
when wordpos(reparg,'HIT_FILE HITS_FILE COUNT_FILE COUNTS_FILE')>0 then do
asis_ok=0
dowordy=0
dowordy=abbrev(reparg,"HIT")
putme=get_hit(afile,dowordy,1)
end
when pos("HIT",reparg)+pos("COUNT",reparg) > 0 then do
asis_ok=0
trymess=pos("OPTION",reparg)
dowordy=pos("HIT",reparg)
if dowordy>0 then dowordy=1
if trymess>0 & symbol('optlist.repargn')='VAR' then do
putme=optlist.repargn
if dowordy>0 then
putme=OPTION_hit_line||putme /* use a "message" argument */
end
else do /* get from file (or prior count */
if sel0="" then
do1="--DEFAULT--"
else
do1=sel0
putme=get_hit(do1,dowordy,0)
end
end
when reparg="SERVERNAME" | reparg="SERVER_NAME" then /* servers ip name */
putme=servername /* servername set at top of filter */
when reparg="VARIABLE" then do /* get a variable defined in this filter program */
putme=" "
check_initfilt=1
check_REPSTRGS=1
if repargn<>"" then do
if abbrev(repargn,'OWNER')=1 | abbrev(repargn,'INHOUSEIP')=1 | abbrev(repargn,'UNALLOWEDIP')=1 then do
putme='n.a.'
end
else do /* check host_nickhame, and then generic versiosn */
putme=value(enmadd||repargn,,os2e)
end
if putme="" then
if symbol('repargn')="VAR" then
putme= value(repargn)
end
end
when reparg="SERVER" then
putme=server('H')
when reparg="WEBMASTER" then do
putme=get_value('WEBMASTER')
check_initfilt=1
end
otherwise do /* see if in the replacement strings file*/
putme=get_value(targ)
check_repstrgs=1
check_initfilt=1
end
END /* select */
return putme /* return it */
/* ----------------------------------------------------------------------- */
/* GET_HIT: (used by REPLACE HIT and REPLACE HIT_MESS keyphrases)
. look in counter_file for # of hits (augment count or add entry),
. Returns a string with containing # of hits.
. If make_wordy_flag, uses the message in the counter_file to
. make a "wordy" string.
. Note that current_hit stem variable is saved/used (if this
. is not the first request for this "anaction", we use results
. stored in current_hit.xx)
. If Do_by_file=1, then it's a file name -- so SUPPRESS
. addition of host nickname (otherwise, if a host nickname
. is active, look for a host_nickname// to the front of anaction,
.
.
. usage: astring=get_hit(anaction,make_wordy_flag,do_by_file)
.
*/
/* ----------------------------------------------------------------------- */
get_hit: procedure expose counter_file current_hit. verbose servername host_nickname enmadd ,
WHO force_norecord is_owner_suppress myqueue mysem basesem
parse arg taction , dowordy ,do_by_file
/* did we already find out which hit this is ? */
if translate(current_hit.item)=upper(taction) then do /* Must know current_hit */
anum=current_hit.num
use1=current_hit.mess1
use2=current_hit.mess2
if dowordy>0 then
putme=use1||" "||anum||" "||use2 ;
else
putme=anum
return putme
end
/* is this in hit_cache? if so, skip recording (sort of like above) */
if host_nickname="" | do_by_file=1 then
tase=taction
else
tase=host_nickname||'//'||taction
stuff=look_hit_cache('L',tase,who,enmadd)
if stuff<>' ' then do /*in the cache */
parse var stuff ict use1 ',' use2
if dowordy=0 then do
putme=ict
end
else do
if use1=" " & use2=" " then do
use1=" # of hits = "
end
else do
use1=STRIP(use1) ; use2= STRIP(use2)
end
putme=use1||" "||ict||" "||use2
end
current_hit.num=ict /* save current hit */
current_hit.item=taction
current_hit.mess1=use1
current_hit.mess2=use2
return putme
end
/* if here, not in cache */
if stuff=' ' then do
if counter_file=0 then return "" /* no file? give up */
/* add to counter file, but check for owner suppression first */
if is_owner_suppress=1 | force_norecord=1 then do
stuff=sref_lookup_count(counter_file,tase,'NO',0,0)
end
else do /* no owner suppression */
stuff=sref_lookup_count(counter_file,tase,'ADD',0,0)
end
/* what's the result? */
parse var stuff status stuff
if status=0 then stuff=0 /* no file or no entry, assume 0 hits*/
parse var stuff ict use1 ',' use2
end
/* now put into a string if dowordy>0 */
if dowordy=0 then
putme=ict
else do
if use1=" " & use2=" " then do
use1=" # of hits = "
end
else do
use1=STRIP(use1) ; use2= STRIP(use2)
end
putme=use1||" "||ict||" "||use2
end
current_hit.num=ict /* save current hit */
current_hit.item=taction
current_hit.mess1=use1
current_hit.mess2=use2
foo=add_hit_cache('L',tase,who,enmadd,stuff) /* add to hit cache */
return putme
/* --------------------------------------------------- */
/* Read interpret mini-code-blocks (from file or macrospac */
/* --------------------------------------------------- */
get_interpret:
if interpret_file=" " then return 0
if interp_data<>"" then return 1
ause=sref_fileread(interpret_file,'filelines',,'E')
if filelines.0 =0 then do
interp_data=" "
return 0
end
interp_data=filelines.1
do mm=2 to filelines.0
interp_data=interp_data||crlf||filelines.mm
end
return filelines.0
/* ---------------------- */
/* insert footers in a large file */
bigf_footer:procedure expose bigin servername host_nickname enmadd
parse arg footers
iat=length(bigin)
iaa:
foo=lastpos('/BODY',translate(bigin),iat)
if foo=0 then do
return bigin
end /* do */
foo2=lastpos('<',bigin,foo)
if foo2=0 then
return bigin
yow=strip(substr(bigin,foo2+1,foo-(1+foo2)))
if yow=" " then do
return insert(footers,bigin,foo2-1)
end
else do
iat=foo2
signal iaa
end
/* ------------------------------------------------------ */
/* call the ssi cache thread
returns:
0 == no match (or fatal error)
1 filename == use the cache in "filename" as is
2 filename == read filename, and perform more ssi's on it
*/
/* ------------------------------------------------------*/
ssi_queue: procedure expose mysem myqueue enmadd basesem ,
transaction host_nickname tdir
parse arg anfile,cshfile,waitreply
goober=enmadd||'SSICACHE'
a=rxqueue('s',goober)
queue transaction ' ' host_nickname ',' myqueue ',' mysem ',' cshfile ',' waitreply ',' anfile
a=eventsem_reset(mysem)
dothread=basesem||'SSICACHE'
a=eventsem_post(dothread)
if cshfile<>' ' & waitreply<>1 then return 0 /* no return expected */
/* else, wait for return info (the cached file)... */
a=eventsem_wait(mysem)
if a<>0 then do
call pmprintf_sref(' A Fatal Semaphore failure in SSI_Cache: 'a)
return 0
end
a=rxqueue('s',myqueue)
parse pull aline
PARSE VAR ALINE idnum ',' aline
idnum=strip(translate(idnum,' ','000d0a'x));TRANSACTION=STRIP(TRANSACTION)
if idnum<>transaction then do /*wierd error: got someone else's message, give up */
say ' Read odd id from ssi queue :' transaction ',' idnum
return 0
end
aline=strip(aline)
return aline
/********************/
/* ssi replaces string */
ssi_replacestrg:procedure expose outbig dynamics.
parse arg kj
if dynamics.kj.!gotselect=1 then return 0
putme=dynamics.kj
target=dynamics.kj.!putme
iat=1
joelen=length(target)
joelen2=length(putme)
joe= pos(translate(target),translate(outbig),iat)
if joe=0 then do
say " Warning: inconsistency in ssi_replacestrg "
return outbig /* should never happen ! */
end
outbig=delstr(outbig,joe,joelen)
if putme<>' ' then
outbig=insert(putme,outbig,joe-1)
return 0
/***********************/
/* search for ssi suprresion flags. sets globals */
set_no_ssis:
parse arg adv
ssinos='SSI_NO_HEADER SSI_NO_FOOTER SSI_NO_CACHE SSI_NO_INCLUDE SSI_NO_REPLACE '
ssinos=ssinos||'SSI_NO_INTERPRET SSI_NO_SELECT SSI_NO_OPTION SSI_NO_#EXEC '
ssinos=ssinos||' SSI_NO_#FILESTAT SSI_NO_#CONFIG SSI_NO_#ECHO SSI_NO_#INCLUDE'
do ifo=1 to words(ssinos)
axe='!'||substr(strip(word(ssinos,ifo)),5)
ssino.axe=0
end
do until adv=""
parse upper var adv aline (crlf) adv
aline=word(strip(aline),1)
if wordpos(aline,ssinos)>0 then do
axe='!'||substr(aline,5)
ssino.axe=1
end
end
return 0
/* ----------- */
/* get environment value, possibly host specific */
/* ------------ */
get_value: procedure expose enmadd host_nickname transaction
parse arg vname
vname=strip(vname) ; hname=strip(host_nickname)
if hname<>' ' then do
aval=value(enmadd||vname||'.'||hname,,'os2environment')
if aval<>' ' Then do
return aval
end
end
aval=value(enmadd||vname,,'os2environment')
return aval
/******************************/
/* Add entry to the hit cache*/
add_hit_cache:procedure expose myqueue basesem mysem transaction
parse arg thetype, theurl0, who , enmadd,stuff
theurl0=upper(theurl0) ; thetype=upper(thetype)
nogi=digits()
lenc=value(enmadd||'HIT_CACHE_LEN',,'OS2ENVIRONMENT')
if lenc=0 then return ' ' /* suppressed */
numeric digits 11
ttc=value(enmadd||'HIT_CACHE_DURATION',,'OS2ENVIRONMENT')
ttc=ttc/(60*24)
d1=date('b')
t1=time('m')/(24*60)
nowtime=d1+t1
endtime=nowtime+ttc
theurl0=translate(theurl0,'/','\')
moo=lenc||' '||thetype||' '||theurl0||' '||who||' '||endtime||' '||stuff
if lenc='FILE' then do /* add to cache file */
itis=file_addhitc(moo,nowtime)
numeric digits nogi
return 0
end
/* or use VARSTORE thread */
goober=enmadd||'VARSTORE'
a=rxqueue('s',goober)
queue transaction ' ' host_nickname ',' myqueue ',' mysem ',' 'PUT_HIT, '||moo
dothread=basesem||'VARSTORE'
a=eventsem_post(dothread) /* no return expected */
return 0
/* --------------- */
/* add to the .stem file (slower, but perhaps better for huge numbers of hits */
file_addhitc:procedure expose enmadd
parse arg moo,nowtime
arf=extract('serverport')
adir=strip(value(enmadd||'TEMPDATA_DIR',,'os2environment'),'t','\')||'\'
cfile=adir||'_HITCACH.'||arf
if stream(cfile,'c','query exists')=' ' then do
call pmprintf_sref(" Creating hit-cache file " cfile)
eek.1=";The sre-filter hit cache file-- do NOT edit ! "
foo=filewrite(cfile,'eek','R',1,1)
if foo=0 then do
call pmprintf_sref( " Error creating hit-cache file: " cfile)
return
end
end
/* wait for it to be unlocked */
isnow=time('r')
do until twait>30
twait=time('e')
aa=sref_fileread(cfile,'yy',,'E')
if aa>=0 then leave
ddt=syssleep(0.2)
end
if aa<0 then do
call pmprintf_sref(" Hit cache file could not be opened for augmentation: " cfile)
return ' '
end
/* now lock it! We'll clean it up, and add current hit to beginning */
aa=sref_open_read(cfile,10,'write')
if aa<0 then do
call pmprintf_sref(" Hit cache file could not be opened for augmentation: " cfile)
return ' '
end
newl.1=moo
i1=1
/* remove expired entries */
do iu=1 to yy.0
aline=yy.iu
if aline=' ' then iterate
if abbrev(strip(aline),';')=1 then do
i1=i1+1
newl.i1=aline
iterate
end
parse var aline atype aurl aip aendtime .
aendtime=strip(aendtime)
if aendtime >= nowtime then do
i1=i1+1
newl.i1=aline
end
else do
end
if i1>10000 then leave /* prevent too big */
end
newl.0=i1
aa=stream(cfile,'c','close')
foo=filewrite(cfile,'newl','R',i1,1)
if foo=0 then
call pmprintf_sref( " Could not augment&update hit-cache file ")
return ' '
/*****************************/
/* see if url is in the "hit cache" */
look_hit_cache:procedure expose basesem mysem myqueue transaction
parse upper arg thetype, theurl, who , enmadd
theurl=translate(theurl,'/','\')
lenc=value(enmadd||'HIT_CACHE_LEN',,'OS2ENVIRONMENT')
if lenc=0 then return ' ' /* suppresed */
nogi=digits()
numeric digits 12
d1=date('b')
t1=time('m')/(24*60)
nowtime=d1+t1
if lenc='FILE' then do
itis=file_lenhitc(thetype,theurl,who,enmadd,nowtime)
numeric digits nogi
return itis
end
/* here to read from VARSTORE thread */
/* or use VARSTORE thread */
goober=enmadd||'VARSTORE'
moo=thetype||' '||who||' '||theurl
a=eventsem_reset(mysem)
a=rxqueue('s',goober)
queue transaction ' ' host_nickname ',' myqueue ',' mysem ',' 'GET_HIT, '||moo
dothread=basesem||'VARSTORE'
a=eventsem_post(dothread)
a=eventsem_wait(mysem) /* wait for answer */
if a<>0 then do
call pmprintf_sref(' A Fatal Semaphore failure in Look_hit_cache: 'a)
return ' '
end
a=rxqueue('s',myqueue)
parse pull aline
PARSE VAR ALINE idnum ',' aline
idnum=strip(translate(idnum,' ','000d0a'x));TRANSACTION=STRIP(TRANSACTION)
if idnum<>transaction then do /*wierd error: got someone else's message, give up */
say ' Read odd id from VARSTORE queue :' transaction ',' idnum
return ' '
end
return strip(aline)
/* --------------- */
/* read from cachelist from an .idx file,, slower but perhaps better for huge number of hits */
file_lenhitc:procedure
parse arg thetype,theurl,who,enmadd,nowtime
arf=extract('serverport')
adir=strip(value(enmadd||'TEMPDATA_DIR',,'os2environment'),'t','\')||'\'
theurl=strip(translate(theurl,'/','\'))
cfile=adir||'_HITCACH.'||arf
if stream(cfile,'c','query exists')=' ' then do
call pmprintf_sref(" No hit cache file " cfile)
return ' '
end
/* wait for it to be unlocked */
isnow=time('r')
do until twait>30
twait=time('e')
aa=sref_fileread(cfile,'yy')
if aa>=0 then leave
ddt=syssleep(0.2)
end
if aa<0 then do
call pmprintf_sref(" Hit cache file could not be opened: " cfile)
return ' '
end
/* see if a match exists */
do iu=1 to aa
aline=yy.iu
if aline=' ' then iterate
if abbrev(strip(aline),';')=1 then iterate
parse var aline atype aurl aip aendtime stuff
atype=strip(atype) ; aurl=strip(aurl) ; aip=strip(aip)
aendtime=strip(aendtime)
if theurl<>aurl | aip<>who | atype<>thetype then iterate
if aendtime >= nowtime then do
return stuff
end
end
return ' ' /* no match */
ssierr: /* jump here on generic error */
IF RC=-7 | rc=-6 THEN return -1 /* if just a closed connection ,then no error messages */
call pmprintf_sref(' Error in SSI procedure at line: 'sigl)
'AUDIT Error in SSI procedure at line: ' sigl
return -2 /* error occured */
