home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / srev13h.zip / VIRTCHK.RXX < prev    next >
Text File  |  1999-11-11  |  15KB  |  535 lines
  1. /* Check virtual dir module for SRE-http. Uses contents of virtualfile
  2.   call with queue containing:
  3.        newq, newsem , SEL DEFDIR
  4.   returns
  5.        mapped_file_name  (or 0 if error )
  6.  */
  7.  
  8.  
  9. lverbose=0              /* set to 1 for "verbose" mode */
  10.  
  11. parse upper arg stuff,  usequeue , USESEM, max_semwait,sport
  12. parse upper var stuff virtualfile dlist
  13.  
  14.  
  15. virtualfile=strip(virtualfile)
  16. standards=" !UPLOAD !CGI-BIN !ADDONS !HTML "  /* shorthands used in limitation list */
  17.  
  18. mytid=dostid()
  19.  
  20. foo=pmprintf_sref(' SRE-http Virtual: thread, file, queue= 'mytid', 'virtualfile', 'usequeue)
  21.  
  22. cfgs_dir=value('SRE_CFGS_DIR',,'os2environment')
  23. cfglist_file=cfgs_dir||'\CFGLIST.CFG'
  24.  
  25. defrealm=value('SREF_DEFREALM_FILE_TEMP',,'os2environment')
  26.  
  27.  
  28. resetit:
  29. if virtualfile="" | usequeue="" | USESEM="" then do
  30.    call pmprintf('SRE-http Virtual: initialization ERROR: '||usequeue)
  31.    exit
  32. end
  33.  
  34. call set_virtual(virtualfile)
  35.  
  36. foo=pmprintf_sref(' SRE-http Virtual:  #virtual dirs= '||nvirtuals,,sport)
  37.  
  38. /* Initialization now done == start waiting for requests for virtual info */
  39.  
  40. signal on error name iserror
  41. signal on syntax name iserror
  42. idid=0
  43.  
  44. bakme:
  45.  a=rxqueue('s',usequeue)
  46.  aq=queued()
  47.  if aq=0 then do
  48.     WOW=EVENTSEM_WAIT(USESEM,max_semwait)
  49.     aq=-1
  50.     if wow=640 then do
  51.          signal bakme
  52.     end
  53.     IF WOW<>0 THEN do         /* FATAL ERROR */
  54.         call pmprintf(' SRE-Http Virtual ERROR: fatal semaphore error: 'wow)
  55.         EXIT
  56.     end
  57.  end
  58.  wow=EVENTSEM_RESET(usesem)
  59.  
  60.  if aq=-1 then
  61.    if queued()=0 then signal bakme
  62.  PARSE pull isit0
  63.  
  64.  
  65.  isit0=translate(isit0,' ','000d0a09'x)
  66.  if isit0=" " then signal bakme
  67.  
  68. /* die command? */
  69.      if abbrev(isit0,'*DIE*')=1 then
  70.           exit
  71. goobs:
  72.      parse var isit0  idnum ',' newq ',' newsem ',' GOOFER ',' limtype .
  73.      A=WORDS(GOOFER)
  74.      DEFDIR=STRIP(WORD(GOOFER,WORDS(GOOFER)))
  75.      ISIT=STRIP(DELWORD(GOOFER,WORDS(GOOFER)))
  76.      parse var idnum idnum host_nickname
  77.      host_nickname=strip(upper(host_nickname))
  78.      isitorig=isit
  79.      if newq="" | newsem="" then do
  80.         call pmprintf(' SRE-http Virtual ERROR: missing queue or semaphore ')
  81.         exit
  82.      end
  83.      newq=upper(strip(newq)); newsem=upper(strip(newsem))
  84.      defdir=strip(defdir) ; isit=strip(isit)
  85.    if abbrev(strip(goofer),'*LIST*') then do
  86.        dog1=''
  87.        do mm=1 to virturl.0
  88.            dog1=dog1||virthosts.mm '// ' virturl.mm' , 'virtdir.mm ','virtsubs.mm||' , '
  89.            dog1=dog1||virtdir.mm.!upwd' , 'virtdir.mm.limitlist||'0d0a'x
  90.        end
  91.        a=rxqueue('s',newq)
  92.        push idnum ',' dog1
  93.        wow=eventsem_post(newsem)
  94.        signal bakme
  95.    end
  96.  
  97.  
  98.    if abbrev(isit,'*RESET*') then do
  99.        newfile=defdir
  100.        if newfile<>' ' then virtualfile=newfile
  101.        call set_virtual(virtualfile)
  102.        foo=pmprintf_sref(' SRE-http Virtual: reset:  #virtual dirs= '||nvirtuals,,sport)
  103.    end
  104.    else do
  105.       if isit=" " then do
  106.            dog1=' 0 '
  107.       end
  108.       else do
  109.         isit=translate(isit,'\','/')
  110.         isit=strip(isit,'l','\')
  111.         defdir=translate(defdir,'\','/')
  112.         defdir=strip(defdir,,'\')
  113.         dog1=fig_virtual(isit,defdir,host_nickname,limtype)
  114.       end
  115.       a=rxqueue('s',newq)
  116.       push idnum ',' dog1
  117.       wow=eventsem_post(newsem)
  118.    end
  119.  
  120. signal bakme
  121.  
  122. iserror:                /* jump here on an error */
  123. signal off error ; signal off syntax
  124. call pmprintf_sref(' Error in daemon ('usequeue'), exiting: 'sigl','rc)
  125. a=rxqueue('d',usequeue)
  126. call pmprintf("   Status= "a " shutting down "usequeue)
  127. a=eventsem_close(usesem)
  128. call pmprintf("   Status= "a " shutting down "usesem)
  129. foo=value('SREF_REDO',1,'os2environment')
  130. badt=value('SREF_VIRTUAL_BAD',1,'os2environment')
  131.  
  132. exit
  133.  
  134.  
  135. /*---------------------*/
  136. fig_virtual:procedure  expose virturl. virtdir. virtsubs. virthosts. lverbose usesem usequeue
  137.  
  138. parse UPPER arg ACTION, ddir,host_nickname,limtype
  139.  
  140. ddir2=translate(ddir,'\','/')
  141. ddir2=strip(ddir2,'t','\')||'\'
  142.  
  143. if action="*LIST*" then do
  144.    crlf='0d0a'x
  145.    aa=virturl.0' '||crlf
  146.    do mm=1 to virturl.0
  147.      aa=aa' 'virturl.mm' 'virtdir.mm||crlf
  148.    end
  149.    return aa
  150. end
  151.  
  152. ACTION=STRIP(TRANSLATE(ACTION,'/','\'))
  153. /* check for illegal action (with .. in it) */
  154. if pos("..",action)>0 then return 0
  155.  
  156. limtype=translate(limtype)
  157. gotit=0 ; starat=0
  158.  
  159. if lverbose>0 then call pmprintf("SRE-http Virtual: checking "action', 'ddir', 'limtype)
  160.  
  161. if abbrev(host_nickname,'_!')=1 then do    /* look for superceding-host specfic entry */
  162.   call check_entry 1
  163. end
  164. if gotit=0 & abbrev(host_nickname,'_!!')=0 then do  /* not strict superceding */
  165.    call check_entry  0
  166. end
  167.  
  168. /*  append to data dir ? */
  169. if gotit=0 then do
  170.       t1=strip(strip(translate(ddir,'\','/')),,'\')||'\'
  171.       action=translate(action,'\','/')
  172.       action=strip(action,'l','\')
  173.       tryfile=t1||action
  174.  end
  175.  
  176.  if pos('//',tryfile)=0 then tryfile=translate(tryfile,'\','/')
  177.  if pos('HTTP:',upper(tryfile))>0 & aupwd<>' ' then
  178.   tryfile=tryfile||' '||MK_BASE64(aupwd)
  179.  
  180. if lverbose>0 then call pmprintf("SRE-http Virtual: match = " tryfile)
  181.  return  tryfile  /* success */
  182.  
  183.  
  184. /*******************/
  185. /* check virtual dir entry */
  186. check_entry:
  187. parse arg atype
  188.  
  189. do ii =1 to virturl.0
  190.   if atype=1 then do            /* superceding-host specific entries only */
  191.       if host_nickname<>virthosts.ii then iterate
  192.   end
  193.   else do               /* non-superceding host and non-host  entries only */
  194.       if virthosts.ii<>' ' & virthosts.ii<>host_nickname then iterate
  195.       if abbrev(host_nickname,'_!')=1 & virthosts.ii<>'' then iterate
  196.   end
  197.   if translate(virtdir.ii.limitlist,' ',',')>' ' then do
  198.       if limtype<>'' then do    /* we know which sort of request this is*/
  199.          if wordpos(limtype,virtdir.ii.limitlist)=0 then iterate
  200.        end
  201.        else do  /* we don't, so use "default directory" hack */
  202.          if wordpos(ddir2,virtdir.ii.limitlist)=0 then iterate 
  203.        end
  204.   end
  205.   alabel=virturl.ii
  206.  
  207.   if abbrev(action,upper(alabel))=1 then do
  208.          if length(alabel)< starat then iterate
  209.          t1=STRIP(delstr(action,1,length(alabel)))
  210.          t1=translate(t1,'\','/')
  211.          tadir=virtdir.ii
  212.          taupwd=virtdir.ii.!upwd
  213.          if VIRTsubs.ii=1 then do 
  214.              gotit=1
  215.              adir=tadir
  216.              aupwd=taupwd
  217.              starat=length(alabel)
  218.              tryfile=adir||t1
  219.              iterate
  220.          end
  221.          else do
  222.             if pos('\',t1)>0 then do
  223.                  iterate                /* violation of no subdirs */
  224.             end
  225.             else do
  226.                gotit=1
  227.                adir=tadir
  228.                aupwd=taupwd
  229.                starat=length(alabel)
  230.                tryfile=adir||t1
  231.                iterate
  232.              end
  233.          end
  234.    end
  235. end
  236.  
  237. return 1
  238.  
  239.  
  240. /* ---------------- */
  241. /* read and set up virtual dir */
  242. set_virtual:
  243. parse arg afile
  244.  
  245. nvirtuals=0 ; virturl.0=0
  246. a=sref_fileread(afile,'ulines',,'E')   /* read it to a stem variable */
  247. foo=do_extends(1)
  248.  
  249. if a=0 then do
  250.       call pmprintf(' SRE-http Virtual ERROR: ERROR reading virtual-file: '||afile)
  251.       exit
  252. end
  253.  
  254. foo=add_cfglist('VIRTUAL','VIRTUAL.IN')          /*augment the ulines stem variable, using CFGLIST.CFG files */
  255.  
  256. foo=add_defrealm('VIRTUAL')
  257.  
  258. do mm=1 to ulines.0
  259.   t1=strip(ulines.mm)
  260.   if t1="" then iterate
  261.   if abbrev(t1,';')=1 then iterate
  262.  
  263.   tm1=strip(word(t1,1)) ; ahost=' '
  264.   if right(tm1,2)='//' then do
  265.         ahost=upper(left(tm1,length(tm1)-2))
  266.         parse var t1 foo t1a t1b t1c ',' upwd
  267.   end
  268.   else
  269.          parse var t1 t1a t1b t1c ',' upwd
  270.  
  271.   upwd=strip(upwd); t1c=strip(t1c)
  272.  
  273. /* fix and addd / to candidate url */
  274.   t1a=strip(t1a); t1a=strip(t1a,'t','*')
  275.   t1a=strip(translate(strip(t1a),'/','\'),,'/')||'/'
  276.  
  277.   t1b=strip(t1b)              /* subdirectories ok ? */
  278.   subok=0
  279.   if right(t1b,1)='*' then do
  280.         t1b=left(t1b,length(t1b)-1)
  281.         subok=1
  282.   end
  283.  
  284. /* fix and add \ to candidate dir */
  285.   if pos('//',t1b)=0 then do
  286.     adir=strip(translate(strip(t1b),'\','/'),'t','\')||'\'
  287.     mdir=filespec('p',adir)
  288.     mdrv=filespec('d',adir)
  289.     if drv="" then drv=filespec('d',ddir)
  290.     t1b=mdrv||mdir
  291.   end                   /* else, http, leave as is */
  292.  
  293.   t4=" "
  294.   if t1c<>' ' then do
  295.        do mm9=1 to words(t1c)
  296.           tmp=upper(strip(word(t1c,mm9)))
  297. /* check if tmp is one of the !standard items */
  298.           imu=wordpos(tmp,standards)
  299.           if imu>0 then tmp=strip(word(dlist,imu))
  300.           tmp=translate(tmp,'\','/')
  301.           tmp=strip(tmp,'t','\')||'\'
  302.           t4=t4||' '||upper(tmp)
  303.        end
  304.   end
  305.   nvirtuals=nvirtuals+1
  306.   virtsubs.nvirtuals=subok
  307.   virturl.nvirtuals=STRIP(TRANSLATE(t1a,' ','000D0A'X))
  308.   virtdir.nvirtuals=STRIP(t1b)
  309.    virtdir.nvirtuals.limitlist=t4' , '||translate(t1c)
  310.   virtdir.nvirtuals.!upwd=upwd
  311.   virthosts.nvirtuals=ahost
  312. end
  313. virturl.0=nvirtuals
  314. return 0
  315.  
  316.                                                                              
  317.                                                                              
  318. /************/
  319. /* Redo ulines, by treating lines starting with , as continuation lines */
  320. do_extends:procedure expose ulines.
  321.  
  322. if ulines.0=0 then return
  323. isnew=1
  324. tmps.1=ulines.1
  325. do mm=2 to ulines.0
  326.    ali=strip(ulines.mm)
  327.    if abbrev(ali,',')=0 then do
  328.         isnew=isnew+1
  329.         tmps.isnew=ulines.mm
  330.     end
  331.     else do
  332.         tmps.isnew=tmps.isnew||substr(ali,2)
  333.     end
  334. end
  335. do mm=1 to isnew
  336.     ulines.mm=tmps.mm
  337. end
  338. ulines.0=isnew
  339. return 0
  340.  
  341.  
  342.  
  343. /************/
  344. /* create a base64 packing of a message */
  345. mk_base64:procedure
  346.  
  347. do mm=0 to 25           /* set base 64 encoding keys */
  348.    a.mm=d2c(65+mm)
  349. end /* do */
  350. do mm=26 to 51
  351.    a.mm=d2c(97+mm-26)
  352. end /* do */
  353. do mm=52 to 61
  354.    a.mm=d2c(48+mm-52)
  355. end /* do */
  356. a.62='+'
  357. a.63='/'
  358.  
  359. parse arg mess
  360. s2=x2b(c2x(mess))
  361. ith=0
  362. do forever
  363.    ith=ith+1
  364.    a1=substr(s2,1,6,0)
  365.    ms.ith=x2d(b2x(a1))
  366.    if length(s2)<7 then leave
  367.    s2=substr(s2,7)
  368. end /* do */
  369. pint=""
  370. do kk=1 to ith
  371.     oi=ms.kk ; pint=pint||a.oi
  372. end /* do */
  373. j1=length(pint)//4
  374. if j1<>0 then pint=pint||copies('=',4-j1)
  375. return pint
  376.  
  377.  
  378. /**********************************/
  379. /* Add entries to ulines. variable, from the defrealm_temp file.
  380.   Note that this file only has the appropriate port entries
  381.   in it */
  382. add_defrealm:procedure expose defrealm ulines. 
  383.  
  384. parse upper arg atype
  385. atype=strip(atype)
  386. crlf='0d0a'x
  387.  
  388. /* call pmprintf(' xxx 'atype' 'defrealm) */
  389. if defrealm='' then return 0
  390. aa=sref_open_read(defrealm,15,'READ')
  391. if aa<=0 then return 0
  392.  
  393. ii=stream(defrealm,'c','query size')
  394. if ii=0 | ii='' then return 0
  395.  
  396. stuff=charin(defrealm,1,ii)
  397. foo=stream(defrealm,'c','close')
  398.  
  399. do forever
  400.   if stuff="" then return 1
  401.   parse var stuff aline (crlf) stuff
  402.   if abbrev(aline,';')=1 then iterate
  403.   parse var aline btype ':' aline
  404.   if btype<>atype then iterate
  405.   ii=ulines.0+1
  406.   ulines.ii=aline
  407.   ulines.0=ii
  408. end
  409.  
  410.  
  411.  
  412.  
  413.  
  414. /**********************************/
  415. /* Add entries to ulines. variable, from the  ATYPE files listed in  the CFGLIST.CFG file
  416.    (but only for port SPORT) 
  417. */
  418.  
  419. add_cfglist:procedure expose ulines. cfglist_file sport cfgs_dir
  420. parse upper arg atype,defname
  421. atype=strip(atype)
  422.  
  423. if cfglist_file='' then return /* nothing to do */
  424.  
  425. /* look for files */
  426. foo=translate(stream(cfglist_file,'c','open read'))
  427. if abbrev(foo,'READY')<>1 then do
  428.   call pmprintf('SRE-http: ' atype ' Warning: Unable to open cfglist.cfg ')
  429.   return 0            /* unable to open */
  430. end
  431. inj=stream(cfglist_file,'c','query size')
  432.  
  433. if inj=0 | inj='' then return   0        /* empty file */
  434. astuff=charin(cfglist_file,1,inj)
  435. foo=stream(cfglist_file,'c','close')
  436.  
  437. crlf='0d0a'x
  438. astuff=astuff||crlf||' '        /* place an elephant in cairo */
  439.  
  440. /* determine which files apply to this atype and port, by readling CFGLIST.CFG */
  441. mm=0
  442.  
  443. /* note: file is organized in blocks */
  444. curport=80              /* defaults port and host */
  445. curhost=''
  446. curfile=''
  447.  
  448. do forever              /* for all blocks in file */
  449.   if astuff='' then leave       /* all done  (note we always put an elephant in cairo */
  450.   parse var astuff aline (crlf) astuff
  451.  
  452.   if abbrev(aline,';')=1 then iterate   /* ignore comments */
  453.   if aline='' then do           /* block end */
  454.      if curport<>sport | curfile='' then do     /* different port, or this atype file not specified */ 
  455.         nop 
  456.      end
  457.      else do        /* otherwise, add this entry to filelist */
  458.         mm=mm+1
  459.         ufiles.mm.!host=curhost
  460.         ufiles.mm.!file=curfile
  461.      end
  462.      curport=80 ; curhost='' ; curfile=''  /* clear block */
  463.      iterate
  464.   end
  465.  
  466. /* process an entry in this block */
  467.   parse upper var aline ltype ':' lstuff ;ltype=strip(ltype) ; lstuff=strip(lstuff)
  468.   select
  469.     when ltype='PORT' then curport=lstuff
  470.     when ltype='HOST' then curhost=lstuff
  471.     when abbrev(ltype,atype)=1  then do
  472.        curfile=strip(translate(lstuff,'\','/'),'l','\')
  473.        if pos(':',curfile)=0 then curfile=cfgs_dir||'\'||curfile
  474.     end
  475.     when ltype='*'  then do
  476.        curfile=strip(translate(lstuff,'\','/'),,'\')
  477.        if pos(':',curfile)=0 then curfile=cfgs_dir||'\'||curfile
  478.        curfile=stream(curfile'\'defname,'c','query exists')
  479.     end
  480.     otherwise nop
  481.   end
  482.  
  483. end
  484.  
  485. /* done reading cfglist; add entries from appropriate files */
  486. if mm=0 then return 1     /* no auxillary files of this type */
  487. ufiles.0=mm
  488.  
  489. do mm=1 to ulines.0              /* retain old uline */
  490.   ULINEStmp.mm=ulines.mm
  491. end
  492. ULINEStmp.0=ulines.0
  493.  
  494.  
  495. do mm=1 to ufiles.0
  496.   afile=ufiles.mm.!file
  497.   ahost=ufiles.mm.!host
  498.  
  499.   a=sref_fileread(afile,'ulines',,'E')   /* read it to a stem variable */
  500.  
  501.   if a=0 | ulines.0=0 then do
  502.       call pmprintf(' SRE-http 'atype': WARNING**: bad auxillary file: '||afile)
  503.       iterate
  504.   end
  505.    
  506.   foo=do_extends(1)             /* fixup ulines. */
  507.    call pmprintf('  SRE-http '||lower(atype)||': adding from 'AHOST ' specific file 'afile ',' ulines.0)
  508.  
  509.    do ii=1 to ulines.0
  510.         aline=strip(ulines.ii)
  511.         if ALINE=' ' then iterate
  512.         aline=translate(aline,' ','0009'x)
  513.         if  abbrev(strip(aline),';')=1 then iterate
  514.         parse var aline aw1 .
  515.         if pos('//',aw1)>0 then do
  516.             call pmprintf('SRE-http: 'atype 'warning: disallowed auxillary entry: 'aline)
  517.             iterate
  518.         end
  519.         if ahost<>'' then aline=ahost||'// '||aline
  520.         ii2=ULINEStmp.0+1
  521.         ULINEStmp.ii2=aline
  522.         ULINEStmp.0=ii2
  523.    end
  524. end
  525.  
  526. do mm=1 to ULINEStmp.0
  527.    ulines.mm=ULINEStmp.mm
  528. end
  529. ulines.0=ULINEStmp.0
  530. drop ULINEStmp.
  531. return 1
  532.  
  533.  
  534.   
  535.