home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / srev13g.zip / ALIASCHK.RXX < prev    next >
Text File  |  1999-06-24  |  13KB  |  499 lines
  1. /* Check aliases module for SRE-http. Uses contents of aliasfile
  2. To call: set queue/sempahore with:
  3.  newqueue,newsem,OLDURL
  4. Returns
  5.  match , newurl
  6. If match=0. then no match (and newurl=oldurl)
  7. */
  8.  
  9. parse upper arg aliasfile,  usequeue , USESEM, max_semwait,sport
  10.  
  11. mytid=dostid()
  12.  
  13. foo=pmprintf_sref(' SRE-http Alias:  thread, file and queue: 'mytid ', 'aliasfile', 'usequeue,,sport)
  14.  
  15. cfgs_dir=value('SRE_CFGS_DIR',,'os2environment')
  16. cfglist_file=cfgs_dir||'\CFGLIST.CFG'
  17.  
  18. defrealm=value('SREF_DEFREALM_FILE_TEMP',,'os2environment')
  19.  
  20.  
  21. resetit:
  22. if usequeue="" | USESEM="" then do
  23.    call pmprintf('SRE-http Alias ERROR: initialization ERROR: '||usequeue)
  24.    exit
  25. end
  26.  
  27. call set_alias(aliasfile)
  28.  
  29. foo=pmprintf_sref(' SRE-http Alias:  #aliases= '||naliases,,sport)
  30.  
  31.  
  32. /* Initialization now done == start waiting for requests for alias info */
  33. signal on error name iserror
  34. signal on syntax name iserror
  35. bakme:
  36.  a=rxqueue('s',usequeue)
  37.  aq=queued()
  38.  if aq=0 then do
  39.     WOW=EVENTSEM_WAIT(USESEM,max_semwait)
  40.     aq=-1
  41.     if wow=640 then do
  42.          signal bakme
  43.     end
  44.  
  45.     IF WOW<>0 THEN do         /* FATAL ERROR */
  46.        call pmprintf(' SRE-http Alias ERROR:  fatal semaphore error ')
  47.        exit
  48.     end
  49.  end
  50.  wow=EVENTSEM_RESET(usesem)
  51.  if aq=-1 then
  52.     if queued()=0 then    signal bakme
  53.  
  54.   PARSE pull isit0
  55.  
  56.   isit0=translate(isit0,' ','000d0a09'x)
  57.   if isit0="" then signal bakme
  58.  
  59. /* die command? */
  60.      if abbrev(isit0,'*DIE*')=1 then
  61.           exit
  62.  
  63.      parse var isit0  idnum ',' newq ',' newsem ',' ISIT
  64.      parse var idnum idnum host_nickname
  65.      isitorig=isit
  66.      if newq="" | newsem=""  then do
  67.         foo=pmprintf_sref(' SRE-http Alias ERROR: missing queue or semaphore ',,sport)
  68.         signal bakme
  69.      end
  70.      newq=upper(strip(newq)); newsem=upper(strip(newsem))
  71.      ISIT=STRIP(ISIT)
  72.  
  73.  
  74.    if abbrev(isit,'*LIST*') then do
  75.         dog1=''
  76.         do mm=1 to aliases.0
  77.             dog1=dog1||aliashosts.mm '// 'aliases.mm||'0d0a'x
  78.         end
  79.       a=rxqueue('s',newq)
  80.       push idnum ',' dog1
  81.       wow=eventsem_post(newsem)
  82.       signal bakme
  83.    end
  84.  
  85.   if abbrev(isit,'*RESET*') then do
  86.        parse var isit foo newfile .
  87.           if newfile<>' ' then aliasfile=newfile
  88.           call set_alias(aliasfile)
  89.           foo=pmprintf_sref(' SRE-http Alias reset:  #aliases= '||naliases,,sport)
  90.    end
  91.    else do
  92.        if  naliases=0 then do
  93.            dog1=' 0 '||isitorig
  94.        end
  95.        else do
  96.           if pos('?',isit)>0 then do
  97.              parse var isit a1 '?' a2
  98.              isit=translate(a1,'/','\')
  99.              isit=strip(isit,'l','/')||'?'||a2
  100.           end
  101.           dog1=fig_alias(isit,host_nickname)
  102.        end
  103.       a=rxqueue('s',newq)
  104.       push idnum ',' dog1
  105.       wow=eventsem_post(newsem)
  106.    end
  107.  
  108. signal bakme
  109.  
  110. iserror:
  111. signal off error ; signal off syntax
  112. call pmprintf(' SRE-http Aliase ERROR: error in alias thread 'sigl)
  113. a=rxqueue('d',usequeue)
  114. a=rxqueue('c',usequeue)
  115. a=eventsem_close(usesem)
  116. a=eventsem_create(usesem)
  117. a=rxqueue('s',newq)
  118. push idnum ', 0 '
  119. wow=eventsem_post(newsem)
  120. call pmprintf('SRE-http Alias ERROR: done resetting alias thread ')
  121. signal on error name iserror
  122. signal on syntax name iserror
  123. signal bakme
  124.  
  125.  
  126.  
  127. exit
  128.  
  129.  
  130.  
  131. /* ---------- */
  132. fig_alias:procedure expose aliases. aliashosts.
  133.  
  134.  
  135.   parse arg inline , host_nickname,isit0
  136.   isdebug=0
  137.   host_nickname=strip(upper(host_nickname))
  138.   inline=strip(inline)
  139.   if abbrev(inline,'++:')=1 then do
  140.       inline=substr(inline,4)
  141.       isdebug=1
  142.   end
  143.   inline=strip(strip(inline),'l','/')
  144.   sel=translate(inline,' ','000d0a09'x)
  145.   doexact=0
  146.   gotit=0 ; resu=' ';tsel=upper(sel); gotit2=''
  147.  
  148.  
  149. /* superceding host specific matches first? */
  150. if abbrev(host_nickname,'_!')=1 then do   /* check superceding-host specific matches first */
  151.   do m=1 to aliases.0
  152.       if host_nickname<>aliashosts.m then iterate  /* not for this host */
  153.       jlias=aliases.m
  154.       parse var jlias jlias1 .
  155.       aresu=sref_wild_match(tsel,jlias1,resu)
  156.       if aresu=0 then iterate     /* no match */
  157.       if aresu=-1 then do  /* exact match */
  158.           resu=-1
  159.           gotit=m
  160.           gotit2=jlias
  161.           leave
  162.       end
  163.       resu=aresu
  164.       GOTIT=M
  165.       gotit2=jlias
  166.       iterate
  167.   end
  168. end
  169.  
  170. /* no host specfic and not "strict-superceding host", try a generic match? */
  171. if gotit=0 & abbrev(host_nickname,'_!!')=0 then do
  172.   do m=1 to aliases.0               
  173.       if abbrev(host_nickname,'_!')=1 & aliashosts.m<>'' then iterate  /* do not check superceding hosts */
  174.       if (aliashosts.m<>'' & aliashosts.m<>host_nickname) then iterate
  175.       jlias=aliases.m
  176.       parse var jlias jlias1 .
  177.       aresu=sref_wild_match(tsel,jlias1,resu)
  178.       if aresu=0 then iterate     /* no match */
  179.       if aresu=-1 then do  /* exact match */
  180.           resu=-1
  181.           gotit=m
  182.           gotit2=jlias
  183.           leave
  184.       end
  185.       resu=aresu
  186.       GOTIT=M
  187.       gotit2=jlias
  188.      iterate 
  189.   end
  190. end
  191.  
  192. select
  193.   when gotit=0 then usesel=inline  /* no match, use original */
  194.   when resu=-1 then do            /* exact match, use candidate as is */
  195.      parse var aliases.gotit . usesel 
  196.   end
  197.   otherwise do                  /* wildcard match */
  198.     parse var aliases.gotit . jlias1 ; jlias1=strip(jlias1)
  199.     if pos('*',jlias1)=0 then do    /* no wildcards in candidate */
  200.         usesel=jlias1
  201.     end
  202.     else do               /* fill in * appropriately */
  203.       psel=sel
  204.       do il=1 to words(resu)
  205.         psel=overlay(' ',psel,strip(word(resu,il)))
  206.       end
  207.       arf='';idog=0 ; jlias2=jlias1
  208.       do until jlias2=""
  209.         parse var jlias2 a1 '*' jlias2
  210.         arf=arf||a1
  211.         if jlias2<>' ' then do
  212.            idog=idog+1
  213.            if idog<=words(psel) then arf=arf||strip(word(psel,idog))
  214.  
  215.         end
  216.         else do
  217.            if right(jlias1,1)='*' then do
  218.                idog=idog+1
  219.                if idog<=words(psel) then arf=arf||strip(word(psel,idog))
  220.             end
  221.             leave
  222.         end     /* parse on * */
  223.       end         /* scanning jlias2 */
  224.       usesel=space(arf,0)
  225.     end           /* fill in wildcards */
  226.   end           /* otherwise */
  227. end   /*select */
  228.  
  229. /* fix up / */
  230.  parse var usesel k1 '?' k2
  231.  k1=translate(k1,'/','\')
  232.  if pos('?',usesel)>0 then
  233.         usesel=k1||'?'||k2
  234.    else
  235.        usesel=k1
  236.  
  237. if isdebug=1 then gotit=STRIP(gotit)':'gotit2
  238.  
  239. return gotit ' ' usesel
  240.  
  241.  
  242.  
  243. /* ---------------- */
  244. /* read and set up aliases */
  245. set_alias: 
  246. parse arg afile
  247.  
  248. naliases=0
  249. aliases.0=0
  250.  
  251. a=sref_fileread(afile,'ulines',,'E')   /* read it to a stem variable */
  252. foo=do_extends(1)
  253.  
  254.  
  255. oo=stream(afile,'c','close')
  256. if a=0 then do
  257.       foo=pmprintf_sref(' SRE-http Alias ERROR: ERROR reading user-file: '||afile,,sport)
  258.       return
  259. end
  260.  
  261. foo=add_cfglist('ALIAS','ALIASES.IN')          /*augment the ulines stem variable, using CFGLIST.CFG files */
  262.  
  263.  
  264. foo=add_defrealm('ALIAS')               /* augment from DEFREALM_TEMP_FILE */
  265.  
  266. exton=0
  267. do mm=1 to ulines.0
  268.   t1=translate(ulines.mm,' ','0d0a09'x)
  269.   t1=strip(t1)
  270.  
  271.   if exton=1 then do
  272.        t1=t1storage||t1
  273.   end
  274.   exton=0 
  275.  
  276.   if t1="" then iterate
  277.   if abbrev(t1,';')=1 then iterate
  278.  
  279.   if right(t1,2)=' ,' & mm < ulines.0 then do
  280.         exton=1
  281.         t1=left(t1,length(t1)-2)
  282.         t1storage=strip(t1)
  283.         iterate
  284.   end
  285.  
  286.   tm1=strip(word(t1,1)) ; ahost=' '
  287.   if right(tm1,2)='//' then do
  288.         ahost=upper(left(tm1,length(tm1)-2))
  289.         parse var t1 foo t1a t1b
  290.   end
  291.   else
  292.       parse var t1 t1a t1b
  293.  
  294.   if pos('?',t1a)>0 then do
  295.      parse var t1a q1 '?' q2
  296.      t1a=strip(translate(q1,'/','\'),'l','/')||'?'||q2
  297.    end
  298.    else do
  299.       t1a=strip(translate(t1a,'/','\'),'l','/')
  300.    end
  301.   if pos('?',t1b)>0 then do
  302.      parse var t1b q1 '?' q2
  303.      t1b=strip(translate(q1,'/','\'),'l','/')||'?'||q2
  304.    end
  305.    else do
  306.       t1b=strip(translate(t1b,'/','\'),'l','/')
  307.    end
  308.  
  309.    naliases=naliases+1
  310.    aliases.naliases=upper(t1a)||'  '||t1b
  311.    aliashosts.naliases=ahost
  312. end
  313. aliases.0=naliases
  314.  
  315. return 0
  316.  
  317.  
  318.  
  319. /************/
  320. /* Redo ulines, by treating lines starting with , as continuation lines */
  321. do_extends:procedure expose ulines.
  322.  
  323. if ulines.0=0 then return
  324. isnew=1
  325. tmps.1=ulines.1
  326. do mm=2 to ulines.0
  327.    ali=strip(ulines.mm)
  328.    if abbrev(ali,',')=0 then do
  329.         isnew=isnew+1
  330.         tmps.isnew=ulines.mm
  331.     end
  332.     else do
  333.         tmps.isnew=tmps.isnew||substr(ali,2)
  334.     end
  335. end
  336. do mm=1 to isnew
  337.     ulines.mm=tmps.mm
  338. end
  339. ulines.0=isnew
  340. return 0
  341.  
  342.  
  343.  
  344. /**********************************/
  345. /* Add entries to ulines. variable, from the defrealm_temp file.
  346.   Note that this file only has the appropriate port entries
  347.   in it */
  348. add_defrealm:procedure expose defrealm ulines. 
  349.  
  350. parse upper arg atype
  351. atype=strip(atype)
  352. crlf='0d0a'x
  353.  
  354. /* call pmprintf(' xxx 'atype' 'defrealm) */
  355. if defrealm='' then return 0
  356. aa=sref_open_read(defrealm,15,'READ')
  357. if aa<=0 then return 0
  358.  
  359. ii=stream(defrealm,'c','query size')
  360. if ii=0 | ii='' then return 0
  361.  
  362. stuff=charin(defrealm,1,ii)
  363. foo=stream(defrealm,'c','close')
  364.  
  365. do forever
  366.   if stuff="" then return 1
  367.   parse var stuff aline (crlf) stuff
  368.   if abbrev(aline,';')=1 then iterate
  369.   parse var aline btype ':' aline
  370.   if btype<>atype then iterate
  371.   ii=ulines.0+1
  372.   ulines.ii=aline
  373.   ulines.0=ii
  374. end
  375.  
  376.  
  377. /**********************************/
  378. /* Add entries to ulines. variable, from the  ATYPE files listed in  the CFGLIST.CFG file
  379.    (but only for port SPORT) 
  380. */
  381.  
  382. add_cfglist:procedure expose ulines. cfglist_file sport cfgs_dir
  383. parse upper arg atype,defname
  384. atype=strip(atype)
  385.  
  386. if cfglist_file='' then return /* nothing to do */
  387.  
  388. /* look for files */
  389. foo=translate(stream(cfglist_file,'c','open read'))
  390. if abbrev(foo,'READY')<>1 then do
  391.   call pmprintf('SRE-http: ' atype ' Warning: Unable to open cfglist.cfg ')
  392.   return 0            /* unable to open */
  393. end
  394. inj=stream(cfglist_file,'c','query size')
  395.  
  396. if inj=0 | inj='' then return   0        /* empty file */
  397. astuff=charin(cfglist_file,1,inj)
  398. foo=stream(cfglist_file,'c','close')
  399.  
  400. crlf='0d0a'x
  401. astuff=astuff||crlf||' '        /* place an elephant in cairo */
  402.  
  403. /* determine which files apply to this atype and port, by readling CFGLIST.CFG */
  404. mm=0
  405.  
  406. /* note: file is organized in blocks */
  407. curport=80              /* defaults port and host */
  408. curhost=''
  409. curfile=''
  410.  
  411. do forever              /* for all blocks in file */
  412.   if astuff='' then leave       /* all done  (note we always put an elephant in cairo */
  413.   parse var astuff aline (crlf) astuff
  414.  
  415.   if abbrev(aline,';')=1 then iterate   /* ignore comments */
  416.   if aline='' then do           /* block end */
  417.      if curport<>sport | curfile='' then do     /* different port, or this atype file not specified */ 
  418.         nop 
  419.      end
  420.      else do        /* otherwise, add this entry to filelist */
  421.         mm=mm+1
  422.         ufiles.mm.!host=curhost
  423.         ufiles.mm.!file=curfile
  424.      end
  425.      curport=80 ; curhost='' ; curfile=''  /* clear block */
  426.      iterate
  427.   end
  428.  
  429. /* process an entry in this block */
  430.   parse upper var aline ltype ':' lstuff ;ltype=strip(ltype) ; lstuff=strip(lstuff)
  431.   select
  432.     when ltype='PORT' then curport=lstuff
  433.     when ltype='HOST' then curhost=lstuff
  434.     when abbrev(ltype,atype)=1  then do
  435.        curfile=strip(translate(lstuff,'\','/'),'l','\')
  436.        if pos(':',curfile)=0 then curfile=cfgs_dir||'\'||curfile
  437.     end
  438.     when ltype='*'  then do
  439.        curfile=strip(translate(lstuff,'\','/'),,'\')
  440.        if pos(':',curfile)=0 then curfile=cfgs_dir||'\'||curfile
  441.        curfile=stream(curfile'\'defname,'c','query exists')
  442.     end
  443.  
  444.     otherwise nop
  445.   end
  446.  
  447. end
  448.  
  449. /* done reading cfglist; add entries from appropriate files */
  450. if mm=0 then return 1     /* no auxillary files of this type */
  451. ufiles.0=mm
  452.  
  453. do mm=1 to ulines.0              /* retain old uline */
  454.   ulisttmp.mm=ulines.mm
  455. end
  456. ulisttmp.0=ulines.0
  457.  
  458.  
  459. do mm=1 to ufiles.0
  460.   afile=ufiles.mm.!file
  461.   ahost=ufiles.mm.!host
  462.  
  463.   a=sref_fileread(afile,'ulines',,'E')   /* read it to a stem variable */
  464.  
  465.   if a=0 | ulines.0=0 then do
  466.       call pmprintf(' SRE-http 'atype': WARNING**: bad auxillary file: '||afile)
  467.       iterate
  468.   end
  469.    
  470.   foo=do_extends(1)             /* fixup ulines. */
  471.    call pmprintf('SRE-http 'atype': adding from 'AHOST ' specific file 'afile ',' ulines.0)
  472.  
  473.    do ii=1 to ulines.0
  474.         aline=strip(ulines.ii)
  475.         if ALINE=' ' then iterate
  476.         aline=translate(aline,' ','0009'x)
  477.         if  abbrev(strip(aline),';')=1 then iterate
  478.         parse var aline aw1 .
  479.         if pos('//',aw1)>0 then do
  480.             call pmprintf('SRE-http: 'atype 'warning: disallowed auxillary entry: 'aline)
  481.             iterate
  482.         end
  483.         if ahost<>'' then aline=ahost||'// '||aline
  484.         ii2=ulisttmp.0+1
  485.         ulisttmp.ii2=aline
  486.         ulisttmp.0=ii2
  487.    end
  488. end
  489.  
  490. do mm=1 to ulisttmp.0
  491.    ulines.mm=ulisttmp.mm
  492. end
  493. ulines.0=ulisttmp.0
  494. drop ulisttmp.
  495. return 1
  496.  
  497.  
  498.   
  499.