home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 35 Internet
/
35-Internet.zip
/
srev13h.zip
/
VIRTCHK.RXX
< prev
next >
Wrap
Text File
|
1999-11-11
|
15KB
|
535 lines
/* Check virtual dir module for SRE-http. Uses contents of virtualfile
call with queue containing:
newq, newsem , SEL DEFDIR
returns
mapped_file_name (or 0 if error )
*/
lverbose=0 /* set to 1 for "verbose" mode */
parse upper arg stuff, usequeue , USESEM, max_semwait,sport
parse upper var stuff virtualfile dlist
virtualfile=strip(virtualfile)
standards=" !UPLOAD !CGI-BIN !ADDONS !HTML " /* shorthands used in limitation list */
mytid=dostid()
foo=pmprintf_sref(' SRE-http Virtual: thread, file, queue= 'mytid', 'virtualfile', 'usequeue)
cfgs_dir=value('SRE_CFGS_DIR',,'os2environment')
cfglist_file=cfgs_dir||'\CFGLIST.CFG'
defrealm=value('SREF_DEFREALM_FILE_TEMP',,'os2environment')
resetit:
if virtualfile="" | usequeue="" | USESEM="" then do
call pmprintf('SRE-http Virtual: initialization ERROR: '||usequeue)
exit
end
call set_virtual(virtualfile)
foo=pmprintf_sref(' SRE-http Virtual: #virtual dirs= '||nvirtuals,,sport)
/* Initialization now done == start waiting for requests for virtual info */
signal on error name iserror
signal on syntax name iserror
idid=0
bakme:
a=rxqueue('s',usequeue)
aq=queued()
if aq=0 then do
WOW=EVENTSEM_WAIT(USESEM,max_semwait)
aq=-1
if wow=640 then do
signal bakme
end
IF WOW<>0 THEN do /* FATAL ERROR */
call pmprintf(' SRE-Http Virtual ERROR: fatal semaphore error: 'wow)
EXIT
end
end
wow=EVENTSEM_RESET(usesem)
if aq=-1 then
if queued()=0 then signal bakme
PARSE pull isit0
isit0=translate(isit0,' ','000d0a09'x)
if isit0=" " then signal bakme
/* die command? */
if abbrev(isit0,'*DIE*')=1 then
exit
goobs:
parse var isit0 idnum ',' newq ',' newsem ',' GOOFER ',' limtype .
A=WORDS(GOOFER)
DEFDIR=STRIP(WORD(GOOFER,WORDS(GOOFER)))
ISIT=STRIP(DELWORD(GOOFER,WORDS(GOOFER)))
parse var idnum idnum host_nickname
host_nickname=strip(upper(host_nickname))
isitorig=isit
if newq="" | newsem="" then do
call pmprintf(' SRE-http Virtual ERROR: missing queue or semaphore ')
exit
end
newq=upper(strip(newq)); newsem=upper(strip(newsem))
defdir=strip(defdir) ; isit=strip(isit)
if abbrev(strip(goofer),'*LIST*') then do
dog1=''
do mm=1 to virturl.0
dog1=dog1||virthosts.mm '// ' virturl.mm' , 'virtdir.mm ','virtsubs.mm||' , '
dog1=dog1||virtdir.mm.!upwd' , 'virtdir.mm.limitlist||'0d0a'x
end
a=rxqueue('s',newq)
push idnum ',' dog1
wow=eventsem_post(newsem)
signal bakme
end
if abbrev(isit,'*RESET*') then do
newfile=defdir
if newfile<>' ' then virtualfile=newfile
call set_virtual(virtualfile)
foo=pmprintf_sref(' SRE-http Virtual: reset: #virtual dirs= '||nvirtuals,,sport)
end
else do
if isit=" " then do
dog1=' 0 '
end
else do
isit=translate(isit,'\','/')
isit=strip(isit,'l','\')
defdir=translate(defdir,'\','/')
defdir=strip(defdir,,'\')
dog1=fig_virtual(isit,defdir,host_nickname,limtype)
end
a=rxqueue('s',newq)
push idnum ',' dog1
wow=eventsem_post(newsem)
end
signal bakme
iserror: /* jump here on an error */
signal off error ; signal off syntax
call pmprintf_sref(' Error in daemon ('usequeue'), exiting: 'sigl','rc)
a=rxqueue('d',usequeue)
call pmprintf(" Status= "a " shutting down "usequeue)
a=eventsem_close(usesem)
call pmprintf(" Status= "a " shutting down "usesem)
foo=value('SREF_REDO',1,'os2environment')
badt=value('SREF_VIRTUAL_BAD',1,'os2environment')
exit
/*---------------------*/
fig_virtual:procedure expose virturl. virtdir. virtsubs. virthosts. lverbose usesem usequeue
parse UPPER arg ACTION, ddir,host_nickname,limtype
ddir2=translate(ddir,'\','/')
ddir2=strip(ddir2,'t','\')||'\'
if action="*LIST*" then do
crlf='0d0a'x
aa=virturl.0' '||crlf
do mm=1 to virturl.0
aa=aa' 'virturl.mm' 'virtdir.mm||crlf
end
return aa
end
ACTION=STRIP(TRANSLATE(ACTION,'/','\'))
/* check for illegal action (with .. in it) */
if pos("..",action)>0 then return 0
limtype=translate(limtype)
gotit=0 ; starat=0
if lverbose>0 then call pmprintf("SRE-http Virtual: checking "action', 'ddir', 'limtype)
if abbrev(host_nickname,'_!')=1 then do /* look for superceding-host specfic entry */
call check_entry 1
end
if gotit=0 & abbrev(host_nickname,'_!!')=0 then do /* not strict superceding */
call check_entry 0
end
/* append to data dir ? */
if gotit=0 then do
t1=strip(strip(translate(ddir,'\','/')),,'\')||'\'
action=translate(action,'\','/')
action=strip(action,'l','\')
tryfile=t1||action
end
if pos('//',tryfile)=0 then tryfile=translate(tryfile,'\','/')
if pos('HTTP:',upper(tryfile))>0 & aupwd<>' ' then
tryfile=tryfile||' '||MK_BASE64(aupwd)
if lverbose>0 then call pmprintf("SRE-http Virtual: match = " tryfile)
return tryfile /* success */
/*******************/
/* check virtual dir entry */
check_entry:
parse arg atype
do ii =1 to virturl.0
if atype=1 then do /* superceding-host specific entries only */
if host_nickname<>virthosts.ii then iterate
end
else do /* non-superceding host and non-host entries only */
if virthosts.ii<>' ' & virthosts.ii<>host_nickname then iterate
if abbrev(host_nickname,'_!')=1 & virthosts.ii<>'' then iterate
end
if translate(virtdir.ii.limitlist,' ',',')>' ' then do
if limtype<>'' then do /* we know which sort of request this is*/
if wordpos(limtype,virtdir.ii.limitlist)=0 then iterate
end
else do /* we don't, so use "default directory" hack */
if wordpos(ddir2,virtdir.ii.limitlist)=0 then iterate
end
end
alabel=virturl.ii
if abbrev(action,upper(alabel))=1 then do
if length(alabel)< starat then iterate
t1=STRIP(delstr(action,1,length(alabel)))
t1=translate(t1,'\','/')
tadir=virtdir.ii
taupwd=virtdir.ii.!upwd
if VIRTsubs.ii=1 then do
gotit=1
adir=tadir
aupwd=taupwd
starat=length(alabel)
tryfile=adir||t1
iterate
end
else do
if pos('\',t1)>0 then do
iterate /* violation of no subdirs */
end
else do
gotit=1
adir=tadir
aupwd=taupwd
starat=length(alabel)
tryfile=adir||t1
iterate
end
end
end
end
return 1
/* ---------------- */
/* read and set up virtual dir */
set_virtual:
parse arg afile
nvirtuals=0 ; virturl.0=0
a=sref_fileread(afile,'ulines',,'E') /* read it to a stem variable */
foo=do_extends(1)
if a=0 then do
call pmprintf(' SRE-http Virtual ERROR: ERROR reading virtual-file: '||afile)
exit
end
foo=add_cfglist('VIRTUAL','VIRTUAL.IN') /*augment the ulines stem variable, using CFGLIST.CFG files */
foo=add_defrealm('VIRTUAL')
do mm=1 to ulines.0
t1=strip(ulines.mm)
if t1="" then iterate
if abbrev(t1,';')=1 then iterate
tm1=strip(word(t1,1)) ; ahost=' '
if right(tm1,2)='//' then do
ahost=upper(left(tm1,length(tm1)-2))
parse var t1 foo t1a t1b t1c ',' upwd
end
else
parse var t1 t1a t1b t1c ',' upwd
upwd=strip(upwd); t1c=strip(t1c)
/* fix and addd / to candidate url */
t1a=strip(t1a); t1a=strip(t1a,'t','*')
t1a=strip(translate(strip(t1a),'/','\'),,'/')||'/'
t1b=strip(t1b) /* subdirectories ok ? */
subok=0
if right(t1b,1)='*' then do
t1b=left(t1b,length(t1b)-1)
subok=1
end
/* fix and add \ to candidate dir */
if pos('//',t1b)=0 then do
adir=strip(translate(strip(t1b),'\','/'),'t','\')||'\'
mdir=filespec('p',adir)
mdrv=filespec('d',adir)
if drv="" then drv=filespec('d',ddir)
t1b=mdrv||mdir
end /* else, http, leave as is */
t4=" "
if t1c<>' ' then do
do mm9=1 to words(t1c)
tmp=upper(strip(word(t1c,mm9)))
/* check if tmp is one of the !standard items */
imu=wordpos(tmp,standards)
if imu>0 then tmp=strip(word(dlist,imu))
tmp=translate(tmp,'\','/')
tmp=strip(tmp,'t','\')||'\'
t4=t4||' '||upper(tmp)
end
end
nvirtuals=nvirtuals+1
virtsubs.nvirtuals=subok
virturl.nvirtuals=STRIP(TRANSLATE(t1a,' ','000D0A'X))
virtdir.nvirtuals=STRIP(t1b)
virtdir.nvirtuals.limitlist=t4' , '||translate(t1c)
virtdir.nvirtuals.!upwd=upwd
virthosts.nvirtuals=ahost
end
virturl.0=nvirtuals
return 0
/************/
/* Redo ulines, by treating lines starting with , as continuation lines */
do_extends:procedure expose ulines.
if ulines.0=0 then return
isnew=1
tmps.1=ulines.1
do mm=2 to ulines.0
ali=strip(ulines.mm)
if abbrev(ali,',')=0 then do
isnew=isnew+1
tmps.isnew=ulines.mm
end
else do
tmps.isnew=tmps.isnew||substr(ali,2)
end
end
do mm=1 to isnew
ulines.mm=tmps.mm
end
ulines.0=isnew
return 0
/************/
/* create a base64 packing of a message */
mk_base64:procedure
do mm=0 to 25 /* set base 64 encoding keys */
a.mm=d2c(65+mm)
end /* do */
do mm=26 to 51
a.mm=d2c(97+mm-26)
end /* do */
do mm=52 to 61
a.mm=d2c(48+mm-52)
end /* do */
a.62='+'
a.63='/'
parse arg mess
s2=x2b(c2x(mess))
ith=0
do forever
ith=ith+1
a1=substr(s2,1,6,0)
ms.ith=x2d(b2x(a1))
if length(s2)<7 then leave
s2=substr(s2,7)
end /* do */
pint=""
do kk=1 to ith
oi=ms.kk ; pint=pint||a.oi
end /* do */
j1=length(pint)//4
if j1<>0 then pint=pint||copies('=',4-j1)
return pint
/**********************************/
/* Add entries to ulines. variable, from the defrealm_temp file.
Note that this file only has the appropriate port entries
in it */
add_defrealm:procedure expose defrealm ulines.
parse upper arg atype
atype=strip(atype)
crlf='0d0a'x
/* call pmprintf(' xxx 'atype' 'defrealm) */
if defrealm='' then return 0
aa=sref_open_read(defrealm,15,'READ')
if aa<=0 then return 0
ii=stream(defrealm,'c','query size')
if ii=0 | ii='' then return 0
stuff=charin(defrealm,1,ii)
foo=stream(defrealm,'c','close')
do forever
if stuff="" then return 1
parse var stuff aline (crlf) stuff
if abbrev(aline,';')=1 then iterate
parse var aline btype ':' aline
if btype<>atype then iterate
ii=ulines.0+1
ulines.ii=aline
ulines.0=ii
end
/**********************************/
/* Add entries to ulines. variable, from the ATYPE files listed in the CFGLIST.CFG file
(but only for port SPORT)
*/
add_cfglist:procedure expose ulines. cfglist_file sport cfgs_dir
parse upper arg atype,defname
atype=strip(atype)
if cfglist_file='' then return /* nothing to do */
/* look for files */
foo=translate(stream(cfglist_file,'c','open read'))
if abbrev(foo,'READY')<>1 then do
call pmprintf('SRE-http: ' atype ' Warning: Unable to open cfglist.cfg ')
return 0 /* unable to open */
end
inj=stream(cfglist_file,'c','query size')
if inj=0 | inj='' then return 0 /* empty file */
astuff=charin(cfglist_file,1,inj)
foo=stream(cfglist_file,'c','close')
crlf='0d0a'x
astuff=astuff||crlf||' ' /* place an elephant in cairo */
/* determine which files apply to this atype and port, by readling CFGLIST.CFG */
mm=0
/* note: file is organized in blocks */
curport=80 /* defaults port and host */
curhost=''
curfile=''
do forever /* for all blocks in file */
if astuff='' then leave /* all done (note we always put an elephant in cairo */
parse var astuff aline (crlf) astuff
if abbrev(aline,';')=1 then iterate /* ignore comments */
if aline='' then do /* block end */
if curport<>sport | curfile='' then do /* different port, or this atype file not specified */
nop
end
else do /* otherwise, add this entry to filelist */
mm=mm+1
ufiles.mm.!host=curhost
ufiles.mm.!file=curfile
end
curport=80 ; curhost='' ; curfile='' /* clear block */
iterate
end
/* process an entry in this block */
parse upper var aline ltype ':' lstuff ;ltype=strip(ltype) ; lstuff=strip(lstuff)
select
when ltype='PORT' then curport=lstuff
when ltype='HOST' then curhost=lstuff
when abbrev(ltype,atype)=1 then do
curfile=strip(translate(lstuff,'\','/'),'l','\')
if pos(':',curfile)=0 then curfile=cfgs_dir||'\'||curfile
end
when ltype='*' then do
curfile=strip(translate(lstuff,'\','/'),,'\')
if pos(':',curfile)=0 then curfile=cfgs_dir||'\'||curfile
curfile=stream(curfile'\'defname,'c','query exists')
end
otherwise nop
end
end
/* done reading cfglist; add entries from appropriate files */
if mm=0 then return 1 /* no auxillary files of this type */
ufiles.0=mm
do mm=1 to ulines.0 /* retain old uline */
ULINEStmp.mm=ulines.mm
end
ULINEStmp.0=ulines.0
do mm=1 to ufiles.0
afile=ufiles.mm.!file
ahost=ufiles.mm.!host
a=sref_fileread(afile,'ulines',,'E') /* read it to a stem variable */
if a=0 | ulines.0=0 then do
call pmprintf(' SRE-http 'atype': WARNING**: bad auxillary file: '||afile)
iterate
end
foo=do_extends(1) /* fixup ulines. */
call pmprintf(' SRE-http '||lower(atype)||': adding from 'AHOST ' specific file 'afile ',' ulines.0)
do ii=1 to ulines.0
aline=strip(ulines.ii)
if ALINE=' ' then iterate
aline=translate(aline,' ','0009'x)
if abbrev(strip(aline),';')=1 then iterate
parse var aline aw1 .
if pos('//',aw1)>0 then do
call pmprintf('SRE-http: 'atype 'warning: disallowed auxillary entry: 'aline)
iterate
end
if ahost<>'' then aline=ahost||'// '||aline
ii2=ULINEStmp.0+1
ULINEStmp.ii2=aline
ULINEStmp.0=ii2
end
end
do mm=1 to ULINEStmp.0
ulines.mm=ULINEStmp.mm
end
ulines.0=ULINEStmp.0
drop ULINEStmp.
return 1