home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Spezial / SPEZIAL2_97.zip / SPEZIAL2_97.iso / ANWEND / ONLINE / SREFV12J / ALIASCHK.RXX < prev    next >
Text File  |  1997-06-30  |  10KB  |  388 lines
  1. /* Check aliases module for SRE-FILTER. Uses contents of aliasfile
  2. To call: set queue/sempahore with:
  3.  newqueue,newsem,OLDURL
  4. Returns
  5.  match , newurl
  6.  
  7. If match=0. then no match (and newurl=oldurl)
  8.  
  9. */
  10.  
  11. parse upper arg aliasfile,  usequeue , USESEM, max_semwait
  12. call pmprintf_sref(' SRE-FILTER alias thread: aliasfile='||aliasfile)
  13. call pmprintf_sref(' SRE-FILTER alias thread: queue='||usequeue)
  14. call pmprintf_sref(' SRE-FILTER alias thread: semaphore='||usesem)
  15. mytid=dostid()
  16. call pmprintf_sref(' SRE-FILTER alias thread: thread id='||mytid)
  17.  
  18.  
  19. resetit:
  20. if usequeue="" | USESEM="" then do
  21.    call pmprintf_sref('SRE-FILTER alias thread: initialization ERROR: '||usequeue)
  22.    exit
  23. end
  24.  
  25. call set_alias(aliasfile)
  26.  
  27. if naliases=0 then do
  28.    call pmprintf_sref(' SRE-FILTER alias  thread: Warning: No valid entries in alias file:'||aliasfile)
  29. end
  30. else do
  31.    call pmprintf_sref(' SRE-FILTER alias thread:  #aliases= '||naliases)
  32. end
  33.  
  34.  
  35. /* Initialization now done == start waiting for requests for alias info */
  36. signal on error name iserror
  37. signal on syntax name iserror
  38. bakme:
  39.  a=rxqueue('s',usequeue)
  40.  aq=queued()
  41.  if aq=0 then do
  42.     WOW=EVENTSEM_WAIT(USESEM,max_semwait)
  43.     aq=-1
  44.     if wow=640 then do
  45.          signal bakme
  46.     end
  47.  
  48.     IF WOW<>0 THEN do         /* FATAL ERROR */
  49.        call pmprintf_sref(' SRE-FILTER alias thread:  fatal semaphore error ')
  50.        exit
  51.     end
  52.  end
  53.  wow=EVENTSEM_RESET(usesem)
  54.  if aq=-1 then
  55.     if queued()=0 then    signal bakme
  56.  
  57.   PARSE pull isit0
  58.  
  59.   isit0=translate(isit0,' ','000d0a09'x)
  60.   if isit0="" then signal bakme
  61.  
  62. /* die command? */
  63.      if abbrev(isit0,'*DIE*')=1 then
  64.           exit
  65.  
  66.      parse var isit0  idnum ',' newq ',' newsem ',' ISIT
  67.      parse var idnum idnum host_nickname
  68.  
  69.      isitorig=isit
  70.      if newq="" | newsem=""  then do
  71.         call pmprintf_sref(' SRE-FILTER alias thread: missing queue or semaphore ')
  72.         signal bakme
  73.      end
  74.      newq=upper(strip(newq)); newsem=upper(strip(newsem))
  75.      ISIT=STRIP(ISIT)
  76.  
  77.     if abbrev(isit,'*RESET*') then do
  78.        parse var isit foo newfile .
  79.           if newfile<>' ' then aliasfile=newfile
  80.           call set_alias(aliasfile)
  81.           call pmprintf_sref(' SRE-Filter alias thread: Reread aliases file: 'aliasfile)
  82.     end
  83.     else do
  84.        if  naliases=0 then do
  85.            dog1=' 0 '||isitorig
  86.        end
  87.        else do
  88.           if pos('?',isit)>0 then do
  89.              parse var isit a1 '?' a2
  90.              isit=translate(a1,'/','\')
  91.              isit=strip(isit,'l','/')||'?'||a2
  92.           end
  93.           dog1=fig_alias(isit,host_nickname)
  94.       end
  95.  
  96.       a=rxqueue('s',newq)
  97.       push idnum ',' dog1
  98.       wow=eventsem_post(newsem)
  99.     end
  100.  
  101.  
  102. signal bakme
  103.  
  104. iserror:
  105. signal off error ; signal off syntax
  106. call pmprintf_sref(' SRE-FIlter: error in alias thread 'sigl)
  107. a=rxqueue('d',usequeue)
  108. a=rxqueue('c',usequeue)
  109. a=eventsem_close(usesem)
  110. a=eventsem_create(usesem)
  111. a=rxqueue('s',newq)
  112. push idnum ', 0 '
  113. wow=eventsem_post(newsem)
  114. call pmprintf_sref('SRE-FIlter: done resetting alias thread ')
  115. signal on error name iserror
  116. signal on syntax name iserror
  117. signal bakme
  118.  
  119.  
  120.  
  121. exit
  122.  
  123.  
  124.  
  125. /* ---------- */
  126. fig_alias:procedure expose aliases. aliashosts.
  127.  
  128.  
  129.   parse arg inline , host_nickname,isit0
  130.   host_nickname=strip(upper(host_nickname))
  131.   sel=translate(inline,' ','000d0a09'x)
  132.   doexact=0
  133.   gotit=0 ; resu=' ';tsel=upper(sel)
  134.  
  135. do m=1 to aliases.0               
  136.     if host_nickname<>aliashosts.m & aliashosts.m<>' ' then iterate
  137.  
  138.     jlias=aliases.m
  139.     parse var jlias jlias1 .
  140.     aresu=wild_match(tsel,jlias1)
  141.     if aresu=0 then iterate     /* no match */
  142.     if aresu=-1 then do  /* exact match */
  143.         resu=-1
  144.         gotit=m
  145.         leave
  146.     end
  147.     if resu=' ' then do         /* FIRST WILDCARD MATCH */
  148.         resu=aresu
  149.         GOTIT=M
  150.         iterate
  151.     end
  152. /* DETERMINE WHICH IS BEST WILDCARD MATCH */
  153.      wrds2=words(ARESU);wrds1=words(RESU)
  154.      use1=1
  155.      do Nmm=1 to max(wrds1,wrds2)
  156.        if Nmm>wrds2 then leave
  157.        if Nmm>wrds1 then do
  158.              use1=0; leave
  159.        end  
  160.        a1=strip(word(resu,Nmm))
  161.        a2=strip(word(aresu,Nmm))
  162.        if a1=a2  then iterate
  163.        if a2>a1 then leave
  164.        use1=0
  165.        leave
  166.      end
  167.      IF USE1=0 THEN DO
  168.          GOTIT=M
  169.          RESU=ARESU
  170.      END
  171.  end
  172.  
  173. select
  174.   when gotit=0 then usesel=inline  /* no match, use original */
  175.   when resu=-1 then do            /* exact match, use candidate as is */
  176.      parse var aliases.gotit . usesel 
  177.   end
  178.   otherwise do                  /* wildcard match */
  179.     parse var aliases.gotit . jlias1 ; jlias1=strip(jlias1)
  180.     if pos('*',jlias1)=0 then do    /* no wildcards in candidate */
  181.         usesel=jlias1
  182.     end
  183.     else do               /* fill in * appropriately */
  184.       psel=sel
  185.       do il=1 to words(resu)
  186.         psel=overlay(' ',psel,strip(word(resu,il)))
  187.       end
  188.       arf='';idog=0 ; jlias2=jlias1
  189.       do until jlias2=""
  190.         parse var jlias2 a1 '*' jlias2
  191.         arf=arf||a1
  192.         if jlias2<>' ' then do
  193.            idog=idog+1
  194.            if idog<=words(psel) then arf=arf||strip(word(psel,idog))
  195.  
  196.         end
  197.         else do
  198.            if right(jlias1,1)='*' then do
  199.                idog=idog+1
  200.                if idog<=words(psel) then arf=arf||strip(word(psel,idog))
  201.             end
  202.             leave
  203.         end     /* parse on * */
  204.       end         /* scanning jlias2 */
  205.       usesel=space(arf,0)
  206.     end           /* fill in wildcards */
  207.   end           /* otherwise */
  208. end   /*select */
  209.  
  210. /* fix up / */
  211.  parse var usesel k1 '?' k2
  212.  k1=translate(k1,'/','\')
  213.  if pos('?',usesel)>0 then
  214.         usesel=k1||'?'||k2
  215.    else
  216.        usesel=k1
  217.  return gotit ' ' usesel
  218.  
  219.  
  220.  
  221. /* ---------------- */
  222. /* read and set up aliases */
  223. set_alias: 
  224. parse arg afile
  225.  
  226. naliases=0
  227. aliases.0=0
  228.  
  229. a=sref_fileread(afile,'ulines',,'E')   /* read it to a stem variable */
  230. foo=do_extends(1)
  231.  
  232. oo=stream(afile,'c','close')
  233. if a=0 then do
  234.       call pmprintf_sref(' SRE-FILTER alias thread: ERROR reading user-file: '||afile)
  235.       return
  236. end
  237.  
  238. exton=0
  239. do mm=1 to ulines.0
  240.   t1=strip(ulines.mm)
  241.  
  242.   if exton=1 then do
  243.        t1=t1storage||t1
  244.   end
  245.   exton=0 
  246.  
  247.   if t1="" then iterate
  248.   if abbrev(t1,';')=1 then iterate
  249.  
  250.   if right(t1,2)=' ,' & mm < ulines.0 then do
  251.         exton=1
  252.         t1=left(t1,length(t1)-2)
  253.         t1storage=strip(t1)
  254.         iterate
  255.   end
  256.  
  257.   tm1=strip(word(t1,1)) ; ahost=' '
  258.   if right(tm1,2)='//' then do
  259.         ahost=upper(left(tm1,length(tm1)-2))
  260.         parse var t1 foo t1a t1b
  261.   end
  262.   else
  263.       parse var t1 t1a t1b
  264.  
  265.   if pos('?',t1a)>0 then do
  266.      parse var t1a q1 '?' q2
  267.      t1a=strip(translate(q1,'/','\'),'l','/')||'?'||q2
  268.    end
  269.    else do
  270.       t1a=strip(translate(t1a,'/','\'),'l','/')
  271.    end
  272.   if pos('?',t1b)>0 then do
  273.      parse var t1b q1 '?' q2
  274.      t1b=strip(translate(q1,'/','\'),'l','/')||'?'||q2
  275.    end
  276.    else do
  277.       t1b=strip(translate(t1b,'/','\'),'l','/')
  278.    end
  279.  
  280.    naliases=naliases+1
  281.    aliases.naliases=upper(t1a)||'  '||t1b
  282.    aliashosts.naliases=ahost
  283. end
  284. aliases.0=naliases
  285.  
  286. return 0
  287.  
  288.  
  289.  
  290. /************/
  291. /* Redo ulines, by treating lines starting with , as continuation lines */
  292. do_extends:procedure expose ulines.
  293.  
  294. if ulines.0=0 then return
  295. isnew=1
  296. tmps.1=ulines.1
  297. do mm=2 to ulines.0
  298.    ali=strip(ulines.mm)
  299.    if abbrev(ali,',')=0 then do
  300.         isnew=isnew+1
  301.         tmps.isnew=ulines.mm
  302.     end
  303.     else do
  304.         tmps.isnew=tmps.isnew||substr(ali,2)
  305.     end
  306. end
  307. do mm=1 to isnew
  308.     ulines.mm=tmps.mm
  309. end
  310. ulines.0=isnew
  311. return 0
  312.  
  313.  
  314.  
  315. /************************/
  316. /* Do a multi wild card match -- return stats on match
  317.    Stats are list of letter positions (in needle) that are matched
  318.    Or, -1 for "exact match"
  319.    OR, 0 for "no match"
  320. Example: Needle="THIS/IS/VERY/SILLY"
  321.         haystack="THIS*VERY*"
  322.         would yield: 1 2 3 4 9 10 11 12
  323.  One can then compare this result list to other result lists (to ascertain
  324.  best match */
  325.  
  326.  
  327. wild_match:procedure
  328. parse upper arg needle, haystack ; haystack=strip(haystack)
  329.  
  330. if needle=haystack then return -1        /* -1 signals exact match */
  331. ast1=pos('*',haystack)
  332. if ast1=0 then return 0                 /* 0 means no match */
  333. if haystack='*' then do
  334.   if length(needle)=0 then
  335.       return 100000
  336.    else 
  337.       return length(needle)
  338. end
  339. ff=haystack
  340. ii=0
  341. do until ff=""
  342.   ii=ii+1
  343.   parse var ff hw.ii '*'  ff
  344.   hw.ii=strip(hw.ii)
  345. end
  346. if hw.ii='' then ii=ii-1
  347. hw.0=ii
  348.  
  349.  
  350. /* check each component of haystackw against needle -- all components
  351. must be there */
  352.  
  353. resu=' '
  354. istart=1 ; ido=2
  355. if ast1>1 then do       /* first check abbrev */
  356.   if abbrev(needle,hw.1)=0 then return 0
  357.   aresu=length(hw.1)
  358.   if hw.0=1 then do
  359.      do nm=1 to aresu
  360.         resu=resu||' '||nm
  361.      end /* do */
  362.      return resu         /* if haystacy of form abc*, we have a match */
  363.   end
  364.   ido=2 ; istart=aresu+1
  365.   do mm=1 to aresu
  366.         resu=resu||' '||mm
  367.   end /* do */
  368. end
  369. /* if here, then first part (a non wildcard) of haystack matches first
  370. part of needle
  371. Now check sequentially that each remaining part also exists
  372. */
  373. do mm=ido to hw.0
  374.   igoo=pos(hw.mm,needle,istart)
  375.   if igoo=0 then return 0
  376.   tres=length(hw.mm)
  377.   istart=igoo+tres
  378.   do nn=igoo to (istart-1)
  379.      resu=resu||' '||nn
  380.   end /* do */
  381. end
  382. if istart >= length(needle) | right(haystack,1)='*' then
  383.    return resu
  384. return 0
  385.  
  386.  
  387.  
  388.