home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / srev13g.zip / VIRTCHK.RXX < prev    next >
Text File  |  1999-06-22  |  15KB  |  544 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.  
  123. iserror:
  124. signal off error ; signal off syntax
  125. foo=condition('d')
  126. call pmprintf(' SRE-http Virtual ERROR: error in virtual thread 'SIGL','RC)
  127.  
  128. n1=queued()
  129. a=rxqueue('d',usequeue)
  130. a=rxqueue('c',usequeue)
  131. foo=eventsem_reset(usesem)
  132. a=eventsem_close(usesem)
  133. a=eventsem_create(usesem)
  134. a=rxqueue('s',newq)
  135. push idnum ', 0 '
  136. wow=eventsem_post(newsem)
  137. call pmprintf('SRE-http VIRTUAL: done resetting virtual thread ')
  138. signal on error name iserror
  139. signal on syntax name iserror
  140. signal bakme
  141.  
  142. exit
  143.  
  144. /*---------------------*/
  145. fig_virtual:procedure  expose virturl. virtdir. virtsubs. virthosts. lverbose
  146.  
  147. parse UPPER arg ACTION, ddir,host_nickname,limtype
  148.  
  149. ddir2=translate(ddir,'\','/')
  150. ddir2=strip(ddir2,'t','\')||'\'
  151.  
  152. if action="*LIST*" then do
  153.    crlf='0d0a'x
  154.    aa=virturl.0' '||crlf
  155.    do mm=1 to virturl.0
  156.      aa=aa' 'virturl.mm' 'virtdir.mm||crlf
  157.    end
  158.    return aa
  159. end
  160.  
  161. ACTION=STRIP(TRANSLATE(ACTION,'/','\'))
  162. /* check for illegal action (with .. in it) */
  163. if pos("..",action)>0 then return 0
  164.  
  165. limtype=translate(limtype)
  166. gotit=0 ; starat=0
  167.  
  168. if lverbose>0 then call pmprintf("SRE-http Virtual: checking "action', 'ddir', 'limtype)
  169.  
  170. if abbrev(host_nickname,'_!')=1 then do    /* look for superceding-host specfic entry */
  171.   call check_entry 1
  172. end
  173. if gotit=0 & abbrev(host_nickname,'_!!')=0 then do  /* not strict superceding */
  174.    call check_entry  0
  175. end
  176.  
  177. /*  append to data dir ? */
  178. if gotit=0 then do
  179.       t1=strip(strip(translate(ddir,'\','/')),,'\')||'\'
  180.       action=translate(action,'\','/')
  181.       action=strip(action,'l','\')
  182.       tryfile=t1||action
  183.  end
  184.  
  185.  if pos('//',tryfile)=0 then tryfile=translate(tryfile,'\','/')
  186.  if pos('HTTP:',upper(tryfile))>0 & aupwd<>' ' then
  187.   tryfile=tryfile||' '||MK_BASE64(aupwd)
  188.  
  189. if lverbose>0 then call pmprintf("SRE-http Virtual: match = " tryfile)
  190.  return  tryfile  /* success */
  191.  
  192.  
  193. /*******************/
  194. /* check virtual dir entry */
  195. check_entry:
  196. parse arg atype
  197.  
  198. do ii =1 to virturl.0
  199.   if atype=1 then do            /* superceding-host specific entries only */
  200.       if host_nickname<>virthosts.ii then iterate
  201.   end
  202.   else do               /* non-superceding host and non-host  entries only */
  203.       if virthosts.ii<>' ' & virthosts.ii<>host_nickname then iterate
  204.       if abbrev(host_nickname,'_!')=1 & virthosts.ii<>'' then iterate
  205.   end
  206.   if translate(virtdir.ii.limitlist,' ',',')>' ' then do
  207.       if limtype<>'' then do    /* we know which sort of request this is*/
  208.          if wordpos(limtype,virtdir.ii.limitlist)=0 then iterate
  209.        end
  210.        else do  /* we don't, so use "default directory" hack */
  211.          if wordpos(ddir2,virtdir.ii.limitlist)=0 then iterate 
  212.        end
  213.   end
  214.   alabel=virturl.ii
  215.  
  216.   if abbrev(action,upper(alabel))=1 then do
  217.          if length(alabel)< starat then iterate
  218.          t1=STRIP(delstr(action,1,length(alabel)))
  219.          t1=translate(t1,'\','/')
  220.          tadir=virtdir.ii
  221.          taupwd=virtdir.ii.!upwd
  222.          if VIRTsubs.ii=1 then do 
  223.              gotit=1
  224.              adir=tadir
  225.              aupwd=taupwd
  226.              starat=length(alabel)
  227.              tryfile=adir||t1
  228.              iterate
  229.          end
  230.          else do
  231.             if pos('\',t1)>0 then do
  232.                  iterate                /* violation of no subdirs */
  233.             end
  234.             else do
  235.                gotit=1
  236.                adir=tadir
  237.                aupwd=taupwd
  238.                starat=length(alabel)
  239.                tryfile=adir||t1
  240.                iterate
  241.              end
  242.          end
  243.    end
  244. end
  245.  
  246. return 1
  247.  
  248.  
  249. /* ---------------- */
  250. /* read and set up virtual dir */
  251. set_virtual:
  252. parse arg afile
  253.  
  254. nvirtuals=0 ; virturl.0=0
  255. a=sref_fileread(afile,'ulines',,'E')   /* read it to a stem variable */
  256. foo=do_extends(1)
  257.  
  258. if a=0 then do
  259.       call pmprintf(' SRE-http Virtual ERROR: ERROR reading virtual-file: '||afile)
  260.       exit
  261. end
  262.  
  263. foo=add_cfglist('VIRTUAL','VIRTUAL.IN')          /*augment the ulines stem variable, using CFGLIST.CFG files */
  264.  
  265. foo=add_defrealm('VIRTUAL')
  266.  
  267. do mm=1 to ulines.0
  268.   t1=strip(ulines.mm)
  269.   if t1="" then iterate
  270.   if abbrev(t1,';')=1 then iterate
  271.  
  272.   tm1=strip(word(t1,1)) ; ahost=' '
  273.   if right(tm1,2)='//' then do
  274.         ahost=upper(left(tm1,length(tm1)-2))
  275.         parse var t1 foo t1a t1b t1c ',' upwd
  276.   end
  277.   else
  278.          parse var t1 t1a t1b t1c ',' upwd
  279.  
  280.   upwd=strip(upwd); t1c=strip(t1c)
  281.  
  282. /* fix and addd / to candidate url */
  283.   t1a=strip(t1a); t1a=strip(t1a,'t','*')
  284.   t1a=strip(translate(strip(t1a),'/','\'),,'/')||'/'
  285.  
  286.   t1b=strip(t1b)              /* subdirectories ok ? */
  287.   subok=0
  288.   if right(t1b,1)='*' then do
  289.         t1b=left(t1b,length(t1b)-1)
  290.         subok=1
  291.   end
  292.  
  293. /* fix and add \ to candidate dir */
  294.   if pos('//',t1b)=0 then do
  295.     adir=strip(translate(strip(t1b),'\','/'),'t','\')||'\'
  296.     mdir=filespec('p',adir)
  297.     mdrv=filespec('d',adir)
  298.     if drv="" then drv=filespec('d',ddir)
  299.     t1b=mdrv||mdir
  300.   end                   /* else, http, leave as is */
  301.  
  302.   t4=" "
  303.   if t1c<>' ' then do
  304.        do mm9=1 to words(t1c)
  305.           tmp=upper(strip(word(t1c,mm9)))
  306. /* check if tmp is one of the !standard items */
  307.           imu=wordpos(tmp,standards)
  308.           if imu>0 then tmp=strip(word(dlist,imu))
  309.           tmp=translate(tmp,'\','/')
  310.           tmp=strip(tmp,'t','\')||'\'
  311.           t4=t4||' '||upper(tmp)
  312.        end
  313.   end
  314.   nvirtuals=nvirtuals+1
  315.   virtsubs.nvirtuals=subok
  316.   virturl.nvirtuals=STRIP(TRANSLATE(t1a,' ','000D0A'X))
  317.   virtdir.nvirtuals=STRIP(t1b)
  318.    virtdir.nvirtuals.limitlist=t4' , '||translate(t1c)
  319.   virtdir.nvirtuals.!upwd=upwd
  320.   virthosts.nvirtuals=ahost
  321. end
  322. virturl.0=nvirtuals
  323. return 0
  324.  
  325.                                                                              
  326.                                                                              
  327. /************/
  328. /* Redo ulines, by treating lines starting with , as continuation lines */
  329. do_extends:procedure expose ulines.
  330.  
  331. if ulines.0=0 then return
  332. isnew=1
  333. tmps.1=ulines.1
  334. do mm=2 to ulines.0
  335.    ali=strip(ulines.mm)
  336.    if abbrev(ali,',')=0 then do
  337.         isnew=isnew+1
  338.         tmps.isnew=ulines.mm
  339.     end
  340.     else do
  341.         tmps.isnew=tmps.isnew||substr(ali,2)
  342.     end
  343. end
  344. do mm=1 to isnew
  345.     ulines.mm=tmps.mm
  346. end
  347. ulines.0=isnew
  348. return 0
  349.  
  350.  
  351.  
  352. /************/
  353. /* create a base64 packing of a message */
  354. mk_base64:procedure
  355.  
  356. do mm=0 to 25           /* set base 64 encoding keys */
  357.    a.mm=d2c(65+mm)
  358. end /* do */
  359. do mm=26 to 51
  360.    a.mm=d2c(97+mm-26)
  361. end /* do */
  362. do mm=52 to 61
  363.    a.mm=d2c(48+mm-52)
  364. end /* do */
  365. a.62='+'
  366. a.63='/'
  367.  
  368. parse arg mess
  369. s2=x2b(c2x(mess))
  370. ith=0
  371. do forever
  372.    ith=ith+1
  373.    a1=substr(s2,1,6,0)
  374.    ms.ith=x2d(b2x(a1))
  375.    if length(s2)<7 then leave
  376.    s2=substr(s2,7)
  377. end /* do */
  378. pint=""
  379. do kk=1 to ith
  380.     oi=ms.kk ; pint=pint||a.oi
  381. end /* do */
  382. j1=length(pint)//4
  383. if j1<>0 then pint=pint||copies('=',4-j1)
  384. return pint
  385.  
  386.  
  387. /**********************************/
  388. /* Add entries to ulines. variable, from the defrealm_temp file.
  389.   Note that this file only has the appropriate port entries
  390.   in it */
  391. add_defrealm:procedure expose defrealm ulines. 
  392.  
  393. parse upper arg atype
  394. atype=strip(atype)
  395. crlf='0d0a'x
  396.  
  397. /* call pmprintf(' xxx 'atype' 'defrealm) */
  398. if defrealm='' then return 0
  399. aa=sref_open_read(defrealm,15,'READ')
  400. if aa<=0 then return 0
  401.  
  402. ii=stream(defrealm,'c','query size')
  403. if ii=0 | ii='' then return 0
  404.  
  405. stuff=charin(defrealm,1,ii)
  406. foo=stream(defrealm,'c','close')
  407.  
  408. do forever
  409.   if stuff="" then return 1
  410.   parse var stuff aline (crlf) stuff
  411.   if abbrev(aline,';')=1 then iterate
  412.   parse var aline btype ':' aline
  413.   if btype<>atype then iterate
  414.   ii=ulines.0+1
  415.   ulines.ii=aline
  416.   ulines.0=ii
  417. end
  418.  
  419.  
  420.  
  421.  
  422.  
  423. /**********************************/
  424. /* Add entries to ulines. variable, from the  ATYPE files listed in  the CFGLIST.CFG file
  425.    (but only for port SPORT) 
  426. */
  427.  
  428. add_cfglist:procedure expose ulines. cfglist_file sport cfgs_dir
  429. parse upper arg atype,defname
  430. atype=strip(atype)
  431.  
  432. if cfglist_file='' then return /* nothing to do */
  433.  
  434. /* look for files */
  435. foo=translate(stream(cfglist_file,'c','open read'))
  436. if abbrev(foo,'READY')<>1 then do
  437.   call pmprintf('SRE-http: ' atype ' Warning: Unable to open cfglist.cfg ')
  438.   return 0            /* unable to open */
  439. end
  440. inj=stream(cfglist_file,'c','query size')
  441.  
  442. if inj=0 | inj='' then return   0        /* empty file */
  443. astuff=charin(cfglist_file,1,inj)
  444. foo=stream(cfglist_file,'c','close')
  445.  
  446. crlf='0d0a'x
  447. astuff=astuff||crlf||' '        /* place an elephant in cairo */
  448.  
  449. /* determine which files apply to this atype and port, by readling CFGLIST.CFG */
  450. mm=0
  451.  
  452. /* note: file is organized in blocks */
  453. curport=80              /* defaults port and host */
  454. curhost=''
  455. curfile=''
  456.  
  457. do forever              /* for all blocks in file */
  458.   if astuff='' then leave       /* all done  (note we always put an elephant in cairo */
  459.   parse var astuff aline (crlf) astuff
  460.  
  461.   if abbrev(aline,';')=1 then iterate   /* ignore comments */
  462.   if aline='' then do           /* block end */
  463.      if curport<>sport | curfile='' then do     /* different port, or this atype file not specified */ 
  464.         nop 
  465.      end
  466.      else do        /* otherwise, add this entry to filelist */
  467.         mm=mm+1
  468.         ufiles.mm.!host=curhost
  469.         ufiles.mm.!file=curfile
  470.      end
  471.      curport=80 ; curhost='' ; curfile=''  /* clear block */
  472.      iterate
  473.   end
  474.  
  475. /* process an entry in this block */
  476.   parse upper var aline ltype ':' lstuff ;ltype=strip(ltype) ; lstuff=strip(lstuff)
  477.   select
  478.     when ltype='PORT' then curport=lstuff
  479.     when ltype='HOST' then curhost=lstuff
  480.     when abbrev(ltype,atype)=1  then do
  481.        curfile=strip(translate(lstuff,'\','/'),'l','\')
  482.        if pos(':',curfile)=0 then curfile=cfgs_dir||'\'||curfile
  483.     end
  484.     when ltype='*'  then do
  485.        curfile=strip(translate(lstuff,'\','/'),,'\')
  486.        if pos(':',curfile)=0 then curfile=cfgs_dir||'\'||curfile
  487.        curfile=stream(curfile'\'defname,'c','query exists')
  488.     end
  489.     otherwise nop
  490.   end
  491.  
  492. end
  493.  
  494. /* done reading cfglist; add entries from appropriate files */
  495. if mm=0 then return 1     /* no auxillary files of this type */
  496. ufiles.0=mm
  497.  
  498. do mm=1 to ulines.0              /* retain old uline */
  499.   ULINEStmp.mm=ulines.mm
  500. end
  501. ULINEStmp.0=ulines.0
  502.  
  503.  
  504. do mm=1 to ufiles.0
  505.   afile=ufiles.mm.!file
  506.   ahost=ufiles.mm.!host
  507.  
  508.   a=sref_fileread(afile,'ulines',,'E')   /* read it to a stem variable */
  509.  
  510.   if a=0 | ulines.0=0 then do
  511.       call pmprintf(' SRE-http 'atype': WARNING**: bad auxillary file: '||afile)
  512.       iterate
  513.   end
  514.    
  515.   foo=do_extends(1)             /* fixup ulines. */
  516.    call pmprintf('SRE-http 'atype': adding from 'AHOST ' specific file 'afile ',' ulines.0)
  517.  
  518.    do ii=1 to ulines.0
  519.         aline=strip(ulines.ii)
  520.         if ALINE=' ' then iterate
  521.         aline=translate(aline,' ','0009'x)
  522.         if  abbrev(strip(aline),';')=1 then iterate
  523.         parse var aline aw1 .
  524.         if pos('//',aw1)>0 then do
  525.             call pmprintf('SRE-http: 'atype 'warning: disallowed auxillary entry: 'aline)
  526.             iterate
  527.         end
  528.         if ahost<>'' then aline=ahost||'// '||aline
  529.         ii2=ULINEStmp.0+1
  530.         ULINEStmp.ii2=aline
  531.         ULINEStmp.0=ii2
  532.    end
  533. end
  534.  
  535. do mm=1 to ULINEStmp.0
  536.    ulines.mm=ULINEStmp.mm
  537. end
  538. ulines.0=ULINEStmp.0
  539. drop ULINEStmp.
  540. return 1
  541.  
  542.  
  543.   
  544.