home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / srev13g.zip / VARSTORE.RXX < prev    next >
Text File  |  1999-02-28  |  32KB  |  1,140 lines
  1. /* The "variable storage" thread 
  2. Currently (nov 1997) used for:
  3.   1) Check  clientname cache for an entry
  4.   2) Add clientname/ipaddress to clientname cache
  5.   3) Check the hit_cache for a matching entry
  6.   4) Store entry in the "hit cache"
  7.   5) Variable storage (using SREF_VALUE
  8.   6) SRE-http queue support (using SREF_QUEUE
  9.   7) Request specific variables storage
  10. Future uses may occur.
  11. */
  12.  
  13. /****************** User Changeable Variables */
  14.  
  15. /* Length of time a "clientname" entry stays in the cache.
  16.     Longer values speed up throughput, but risk errors when ip-name (DNS)
  17.     matches change.  Value is in fractions of a day (0.05 is about 1 hour) */
  18.  
  19. clientname_duration=0.05
  20.  
  21. /* Maximum number of entries in clientname cache */
  22. clientname_max=800
  23.  
  24.  
  25. /* Maximum number of requests to store information about (for retrieval by
  26.    SREF_VALUE(,,'REQ',a_request_number)
  27.    This MUST be at least as great as the GoServe "maximum simultaneous clients"
  28.    variable
  29.    Larger values are needed if postfiltering wants to access request specific
  30.    variables. */
  31. reqvars.!max=150 
  32.  
  33. /************* END of user changable parameters  */
  34.  
  35. parse upper arg usequeue , USESEM , max_semwait,sport,limcli
  36.  
  37.  
  38. mytid=dostid()
  39. foo=pmprintf_sref(' SRE-http Varstore: thread and queue='||mytid', 'usequeue)
  40.  
  41. hit_cache.0=0 ; hit_cache.!freelist=' '
  42. client_cache.0=0 ; client_cache.!freelist=' '
  43. last_cleanup=0
  44. queue.0=' '
  45. numeric digits 11
  46. reqvars.0=' '
  47. reqvars.!OTHER.0=' '
  48.  
  49. foo=limcli    /*foo=extract('limitclients')*/
  50. if foo>reqvars.!max then do
  51.    call pmprintf(' SRE-http Varstore: Warning! REQVARS.!MAX too low, resetting to 'foo)
  52.    reqvars.!max=foo+5
  53. end
  54.  
  55. resetit:
  56. if  usequeue="" | USESEM="" then do
  57.    call pmprintf('SRE-http Varstore ERROR: initialization ERROR: '||usequeue)
  58.    exit
  59. end
  60.  
  61. /* Initialization now done == start waiting for requests for variables. */
  62. /* request body is in the ISIT variable below. It will consist of
  63.    TYPE ,  data
  64. where type can be:
  65.    GET_CLIENT, PUT_CLIENT, GET_HIT,  PUT_HIT, GET_VAR, PUT_VAR, PUT_VAR2, QUEUE,
  66.    REQ_GET, REQ_PUT, REQ_INI
  67. */
  68.  
  69. signal on error name iserror
  70. signal on syntax name iserror
  71. bakme:
  72.  a=rxqueue('s',usequeue)
  73.  aq=queued()
  74.  if aq=0 then do
  75.    foo=cleanup_stuff()       /* nothing happening; clean up stuff? */
  76.     WOW=EVENTSEM_WAIT(USESEM,max_semwait)
  77.     aq=-1
  78.     if wow=640 then do
  79.         signal bakme
  80.     end
  81.     IF WOW<>0 THEN do         /* FATAL ERROR */
  82.         call pmprintf(' Fatal semaphore error in VARSTORE thread ')
  83.         EXIT
  84.     end
  85.  end
  86.  wow=EVENTSEM_RESET(usesem)
  87.  if aq=-1 then do
  88.    if queued()=0 then signal bakme
  89.  end
  90.  
  91. parse pull isit0
  92.  
  93. goobs: 
  94.  if isit0=" " then signal bakme
  95.  
  96.  parse var isit0  idnum ',' newq ',' newsem ',' ISIT
  97.  IDNUM=TRANSLATE(IDNUM,' ','00090A0D'X)
  98.  parse var idnum idnum host_nickname
  99.  if newq="" | newsem="" then do
  100.         call pmprintf(' SRE-http Varstore ERROR: missing queue or semaphore ')
  101.         signal bakme
  102.   end
  103.   newq=strip(newq); newsem=strip(newsem) 
  104.  
  105.  if abbrev(strip(translate(isit)),'*DIE*')=1 then  exit
  106.  
  107.  if abbrev(strip(translate(isit)),'*RESET*')=1 then do
  108.         drop client_cache. ; drop hit_cache. ; drop vars.
  109.         client_cache.0=0 ;        hit_cache.0=0 ;  hit_cache.!freelist=' '
  110.         client_cache.!freelist=' '
  111.         foo=pmprintf_sref('SRE-http Varstore: Resetting ',,sport)
  112.         signal bakme
  113.   end
  114.  
  115. /* do something ... */
  116. parse var isit  type ',' stuff ; type=upper(strip(type))
  117.  
  118. select
  119.   when type="GET_CLIENT" then do
  120.      dog1=get_client(stuff) ; isend=1
  121.   end
  122.   when type='PUT_CLIENT' then do
  123.      dog1=put_client(stuff) ; isend=0
  124.   end
  125.   when type="PUT_HIT" then do
  126.      dog1=put_hit(stuff) ; isend=0
  127.   end
  128.   when type="GET_HIT" then do
  129.      dog1=get_hit(stuff)
  130.      isend=1
  131.   end
  132.   when type="PUT_VAR" then do
  133.      dog1=put_var(stuff) ; isend=0
  134.   end
  135.   when type="PUT_VAR2" then do
  136.      dog1=put_var(stuff) ; isend=1
  137.   end
  138.   when type="GET_VAR" then do
  139.      dog1=get_var(stuff) ; isend=1
  140.   end
  141.   when type='QUEUE' then do
  142.      dog1=do_queue(stuff)  
  143.      isend=1-quick_mode
  144.   end
  145.   when abbrev(type,'REQ')=1 then do
  146.      dog1=do_req_vars(type,stuff)
  147.      isend=1-quick_mode
  148.   end
  149.   otherwise do
  150.      call pmprintf(" SRE-http Varstore ERROR: bad request to Varstore Thread: "type)
  151.      isend=1
  152.      dog1='Error '
  153.   end
  154. end
  155.  
  156. /* return result? */
  157. if isend=1 then do
  158.       a=rxqueue('s',newq)
  159.       dog1=idnum','dog1
  160.       push  dog1
  161.       wow=eventsem_post(newsem)
  162. end
  163. signal bakme            /* do it again */
  164.  
  165. iserror:
  166. signal off error ; signal off syntax
  167. call pmprintf('SRE-http Varstore ERROR: in Varstore thread 'sigl)
  168. a=rxqueue('d',usequeue)
  169. a=rxqueue('c',usequeue)
  170. a=eventsem_close(usesem)
  171. a=eventsem_create(usesem)
  172. a=rxqueue('s',newq)
  173. push idnum  ', 0 '
  174. wow=eventsem_post(newsem)
  175. call pmprintf('SRE-http Varstore: done resetting Varstore thread ')
  176. signal on error name iserror
  177. signal on syntax name iserror
  178. signal bakme
  179.  
  180. exit
  181.  
  182.  
  183.  
  184. /**********************************/
  185. /* store a variable, return old value */
  186. put_var:procedure expose vars.
  187. parse arg stuff
  188.  
  189. parse var stuff aname','avalue
  190.  
  191. aname='!'||strip(upper(aname))
  192. if vars.aname<>upper('VARS.'aname) then
  193.    oldval=vars.aname
  194. else
  195.   oldval=''
  196. vars.aname=avalue
  197. return oldval
  198.  
  199. /**********************************/
  200. /* retireive a variable */
  201. get_var:procedure expose vars.
  202. parse arg stuff
  203.  
  204. parse var stuff aname','avalue
  205.  
  206. if aname='*' then do            /* return list of currently stored variables */
  207.    aa=cvtails(vars,vtails)
  208.    oog=""
  209.    do ii=1 to vtails.0
  210.        oog=oog||' '||substr(vtails.ii,2)
  211.    end
  212.    return oog
  213. end
  214.  
  215. /* get the aname variable */
  216. aname='!'||strip(upper(aname))
  217. if vars.aname<>upper('VARS.'||aname) then
  218.    return vars.aname
  219. else
  220.    return ' '
  221.  
  222.  
  223. /**********************************/
  224. /* look in cache for a clientname that matches the IP address. If none found, then
  225.     return 0 */
  226. get_client:procedure expose client_cache. hit_cache.
  227. parse arg stuff
  228.  
  229. amin=time('M')
  230. aday=date('b')
  231. nowtime=aday+(amin/(24*60))
  232.  
  233. /* stuff should contain an IP number */
  234. do mm=1 to client_cache.0
  235.   if client_cache.mm=stuff then do
  236.      if client_cache.mm.!expire>nowtime then do
  237.             return client_cache.mm.!address
  238.      end
  239.      client_cache.mm=' '        /* this has expired -- mark for deletion */
  240.      client_cache.!freelist=client_cache.!freelist||' '||mm
  241.      return 0      /* and stop looking */
  242.   end
  243. end
  244. return 0
  245.  
  246. /**********************************/
  247. /* add clientname to cache */
  248.  
  249. put_client:procedure expose client_cache. clientname_duration clientname_max last_cleanup
  250. parse arg stuff
  251.  
  252. amin=time('M')
  253. aday=date('b')
  254. nowtime=aday+(amin/(24*60))
  255.  
  256. parse var stuff ipnum ipname aduration amax
  257. if aduration=' ' | datatype(aduration)<>"NUM" then aduration=clientname_duration
  258. if amax=' ' | datatype(amax)<>'NUM' then amax=clientname_max
  259.  
  260. if client_cache.!freelist<>' ' then do
  261.    parse var client_cache.!freelist ido client_cache.!freelist
  262.    ido=strip(ido)
  263. end
  264. else do
  265.   ido=client_cache.0+1
  266.    if ido>amax then do
  267.         foo=cleanup_stuff(2)       /* remove 1/2 entries & old stuff */
  268.         ido=client_cache.0+1
  269.    end
  270.   client_cache.0=ido
  271. end
  272.  
  273. client_cache.ido=strip(ipnum)
  274. client_cache.ido.!address=strip(ipname)
  275. client_cache.ido.!expire=nowtime+aduration
  276. return ' '   
  277.  
  278.  
  279. /**************************/
  280. /* cleanup client_cache and hit_cache
  281. Do it every 0.01 days (about every 10 minutes) */
  282. cleanup_stuff:procedure expose last_cleanup client_cache. hit_cache.
  283. parse arg drophalf   /* blank= cleanup both, 1=drophalf cleanup hit, 2=drophalf cleanup client */
  284.  
  285. amin=time('M')
  286. aday=date('b')
  287. nowtime=aday+(amin/(24*60))
  288.  
  289. if drophalf=' ' then do
  290.    if nowtime<(last_cleanup+0.0001)  then return 0    /* not time to do it yet */
  291.    last_cleanup=nowtime
  292. end
  293.  
  294. ido=0
  295. jm=client_cache.0; if drophalf=1 then jm=0   /* a skip hack */
  296. do mm=1 to jm
  297.    if client_cache.mm.!expire<nowtime  then iterate  /* drop this one */
  298.    if drophalf=2 & mm<(1+client_cache.0/2) then iterate /* overflow, get rid of old ones */
  299.    ido=ido+1
  300.    tmp.ido=client_cache.mm ; tmp.ido.!expire=client_cache.mm.!expire
  301.    tmp.ido.!address=client_cache.mm.!address
  302. end
  303. client_cache.0=ido ; client_cache.!freelist=' '
  304. do mm=1 to ido
  305.    client_cache.mm=tmp.mm ; client_cache.mm.!expire=tmp.mm.!expire
  306.    client_cache.mm.!address=tmp.mm.!address
  307. end
  308.  
  309. if drophalf=2 then return 0
  310.  
  311. ido=0
  312. do mm=1 to hit_cache.0
  313.    if hit_cache.mm.!expire<nowtime  then iterate  /* drop this one */
  314.    if drophalf=1 & mm<(hit_cache.0/2) then iterate /* overflow, get rid of old ones */
  315.    ido=ido+1                    /* add to temporary list */
  316.    tmp.ido.!atype=hit_cache.ido.!atype
  317.    tmp.ido.!aurl= hit_cache.ido.!aurl
  318.    tmp.ido.!aip=hit_cache.ido.!aip
  319.    tmp.ido.!expire=hit_cache.ido.!expire
  320.    tmp.ido.!stuff=hit_cache.ido.!stuff
  321. end
  322. hit_cache.0=ido ; hit_cache.!freelist=' '
  323. do mm=1 to ido
  324.    hit_cache.ido.!atype=tmp.ido.!atype
  325.    hit_cache.ido.!aurl=tmp.ido.!aurl
  326.    hit_cache.ido.!aip =tmp.ido.!aip
  327.    hit_cache.ido.!expire=tmp.ido.!expire
  328.    hit_cache.ido.!stuff=tmp.ido.!stuff
  329. end
  330.  
  331. return 0
  332.  
  333. /**********************************/
  334. /* add hit to cache */
  335. put_hit:procedure expose hit_cache. last_cleanup
  336. parse arg stuff
  337.  
  338. /* moo=lenc||' '||thetype||' '||theurl0||' '||who||' '||endtime||' '||stuff */
  339.  
  340. amin=time('M')
  341. aday=date('b')
  342. nowtime=aday+(amin/(24*60))
  343.  
  344. /* note that aduration and amax MUST be sent with other info! */
  345. parse var stuff amax anent
  346. if datatype(aduration)<>"NUM" then aduration=0.01
  347. if datatype(amax)<>"NUM" then amax=500
  348. if amax<50 & amax>0 then amax=100 /* in case of old style "5 = 5000 bytes " */
  349.  
  350. if hit_cache.!freelist<>' ' then do
  351.    parse var hit_cache.!freelist ido hit_cache.!freelist
  352.    ido=strip(ido)
  353. end
  354. else do
  355.    ido=hit_cache.0+1
  356.    if ido>amax then do   /* drop first 1/2 of the entries */
  357.         foo=cleanup_stuff(1)      
  358.         ido=hit_cache.0+1
  359.    end
  360.    hit_cache.0=ido
  361. end
  362.  
  363. parse var anent atype aurl aip  aexpire stuff
  364. hit_cache.ido.!atype=upper(strip(atype))
  365. hit_cache.ido.!aurl=upper(strip(aurl))
  366. hit_cache.ido.!aip =strip(aip)
  367. hit_cache.ido.!expire=strip(aexpire) 
  368. hit_cache.ido.!stuff=strip(stuff)
  369.  
  370. return ' '
  371.  
  372.  
  373. /**********************************/
  374. /* look for matching entry in hit_cache */
  375. get_hit:procedure expose hit_cache.
  376.  
  377. parse arg stuff
  378. parse upper var stuff thetype who theurl
  379. thetype=strip(thetype)
  380. who=strip(who) ; theurl=strip(theurl)
  381.  
  382. amin=time('M') ; aday=date('b')
  383. nowtime=aday+(amin/(24*60))
  384.  
  385. /* stuff should contain an info that was saved (such as a hit count) */
  386. do mm=1 to hit_cache.0
  387.    if hit_cache.mm.!atype=' ' then iterate  /* emtpy means deleted entry */
  388.    if theurl<>hit_cache.mm.!aurl | hit_cache.mm.!aip<>who | hit_cache.mm.!atype<>thetype then iterate
  389.    if hit_cache.mm.!expire >= nowtime then  return hit_cache.mm.!stuff
  390.  
  391. /* else expired.. */
  392.    hit_cache.mm.!atype=' '
  393.    hit_cache.!freelist=hit_cache.!freelist||' 'mm 
  394.    return ' '           /* don't check for duplicate entries */
  395.  
  396. end
  397. return ' '  /* blank means "not found in hit cache" */
  398.  
  399.  
  400. /**********************************/
  401. /* called via 
  402.       retvalue=SREF_QUEUE(QueueName,action,value,port)
  403. Note: queue.0 will contain a list of all currently active queue.
  404.      
  405. This is designed to work with  SREF_QUEUE.
  406.  
  407. */
  408.  
  409. do_queue:procedure  expose queue. quick_mode
  410.  
  411.  
  412. parse arg stuff
  413. parse var stuff queuename','action','mod1','mod2','aval
  414.  
  415. quick_mode=0            /* may be temporarily set to one by a PUSH call */
  416.  
  417. queuename=upper(strip(queuename))
  418. action=upper(strip(action))
  419. mod1=upper(strip(mod1))
  420. mod2=upper(strip(mod2))
  421.  
  422. if wordpos(action,'POP READ PUSH QUEUE STRIP INIT KILL LOCKON LOCKOFF FIND INFO')=0 then do
  423.    call pmprintf_sref('SREF_QUEUE Storage: bad action: 'action)
  424.    return ""
  425. end
  426.  
  427. a1=date('b') ; a2=time('s')/(24*60*60)
  428. nowtime=a1+a2
  429.  
  430. crlf='0d0a'x
  431.  
  432. aqn='!'||queuename
  433.  
  434. /* init? */
  435. if action='INIT' then do       
  436.     if symbol('QUEUE.!'||queuename)='VAR' then return -5  /* queue exists */    
  437.     if aval="" then aval=0
  438.     if queuename="" then do
  439.        call pmprintf_sref('SREF_QUEUE Storage: no queuename ')
  440.        return -10
  441.     end
  442.     if aval="" then aval='0d0a'x
  443.     queue.aqn=nowtime
  444.     queue.aqn.!max=mod1
  445.     queue.aqn.!lifespan=mod2
  446.     queue.aqn.!dlm=aval
  447.     queue.aqn.!bot=1000
  448.     queue.aqn.!top=999
  449.     queue.0=queue.0' 'queuename
  450.     queue.aqn.!lock=0           /*unlocked*/
  451.     queue.aqn.!key=1            /* generic key */
  452.     return 1
  453. end
  454.  
  455. /* kill? */
  456. if action='KILL' then do
  457.    if symbol('QUEUE.!'||queuename)<>'VAR' then return -1  /* queue does not exist */    
  458.     if queuename="" then do
  459.        call pmprintf_sref('SREF_QUEUE Storage: no queuename ')
  460.        return -10
  461.     end
  462.    ido=1+queue.aqn.!top-queue.aqn.!bot
  463.    do mm=queue.aqn.!bot to queue.aqn.!top
  464.       fii=drop_a_rec(aqn,mm)
  465.    end
  466.    drop   queue.aqn   queue.aqn.!max   queue.aqn.!bot   queue.aqn.!top ,
  467.           queue.aqn.!lock 
  468.    ii=wordpos(queuename,queue.0)
  469.    if ii>0 then queue.0=delword(queue.0,ii,1)
  470.    return ido
  471. end
  472.  
  473. /* info */
  474. if action='INFO' then do       
  475.    if symbol('QUEUE.!'||queuename)<>'VAR' & queuename<>'*' then return -1  /* queue does not exists */    
  476.     if queuename="" then do
  477.        call pmprintf_sref('SREF_QUEUE Storage: no queuename ')
  478.        return -10
  479.     end
  480.     aval=strip(aval)
  481.     taval=upper(aval)
  482.     select 
  483.        when (queuename='*') & abbrev(taval,'#QUE')=1 then return words(queue.0)
  484.        when (queuename='*') & abbrev(taval,'NAMES')=1 then return queue.0
  485.        when (queuename='*') & abbrev(taval,'SIZ')=1 then do
  486.            tott=0
  487.            do ll=1 to words(queue.0)
  488.                aw=strip(word(queue.0,ll))
  489.                aq='!'||aw
  490.                do lll=queue.aq.!bot to queue.aq.!top
  491.                   tott=tott+queue.aq.lll.!bytes
  492.                end
  493.            end
  494.            return tott
  495.        end
  496.  
  497.        when abbrev(taval,'REC')=1 then do
  498.           isiz=1+queue.aqn.!top-queue.aqn.!bot
  499.           return isiz
  500.        end
  501.        when abbrev(taval,'CREAT')=1 then return queue.aqn
  502.        when abbrev(taval,'MAX')=1 then return queue.aqn.!max
  503.        when abbrev(taval,'LOCK')=1 then do
  504.           if queue.aqn.!lock>nowtime then return queue.aqn.!key
  505.           return 0
  506.        end
  507.        when abbrev(taval,'SIZ')=1 then do
  508.          tott=0
  509.          do mm=queue.aqn.!bot to queue.aqn.!top
  510.             tott=tott+queue.aqn.mm.!bytes
  511.          end
  512.          return tott
  513.        end
  514.        otherwise do
  515.           return -4
  516.        end
  517.     end   
  518. end
  519.  
  520. if action='LOCKON' then do
  521.     if aqn='!' then return -10
  522.  
  523.     if symbol('QUEUE.!'||queuename)<>'VAR' then return -1  /* queue does not exists */    
  524.     if nowtime<queue.aqn.!lock then return -14  /* already locked */
  525.     queue.aqn.!lock=nowtime+aval
  526.     queue.aqn.!key=upper(strip(mod1))
  527.     return 1
  528. end
  529.  
  530. if action="LOCKOFF" then do
  531.     if aqn='!' then return -10
  532.     if symbol('QUEUE.!'||queuename)<>'VAR' then return -1  /* queue does not exists */    
  533.     if queue.aqn.!key<>1 upper(strip(mod1))<>1 & queue.aqn.!key<>upper(strip(mod1)) then return -15 /* key mismatch */
  534.     queue.aqn.!lock=0
  535.     return 1
  536. end
  537.  
  538. /* POP and READ */
  539.   if action='POP' | action='READ'  then do
  540.      yow=queue_pop(aqn,action,mod1,mod2,aval)
  541.      return yow
  542.   end
  543.  
  544. /* FIND */
  545.   if action="FIND" then do
  546.      yow=queue_find(aqn,mod1,mod2,aval)
  547.   end
  548.  
  549. /* PUSH  */
  550.  if action='PUSH' then do
  551.      yow=queue_push(aqn,mod1,mod2,aval)
  552.   end
  553.  
  554.  return yow
  555.  
  556.  
  557. /**********************************************/
  558. /* PUSH
  559. type=TOP BOTTOM REC=
  560. options=QUICK REMOVE ID= (any combo)
  561. aval=value to write
  562.   */
  563. queue_push:procedure expose queue. quick_mode nowtime
  564. parse arg aqn,type,options,aval
  565.  
  566. recoffset=""
  567. if aqn='!' then do
  568.     return -10
  569. end
  570.  
  571. if symbol('QUEUE.'||aqn)<>'VAR' then do   /* initialize an unlimited length queue */
  572.    queue.aqn.!max=0
  573.    queue.aqn=nowtime
  574.    queue.aqn.!dlm='0d0a'x
  575.    queue.aqn.!top=999
  576.    queue.aqn.!bot=1000 
  577.    queue.aqn.!lock=0
  578.    queue.aqn.!key=1            /* generic key */
  579.    fq=strip(aqn,'l','!')
  580.    queue.0=queue.0' 'fq
  581. end
  582.  
  583. remove_full=0 ; quick_mode=0 ; id=""
  584.  
  585.  
  586. /* First, remove lifespan-expired records */
  587. if queue.aqn.!lifespan>0 then do        /* 0 means infinite */
  588.    ikill=0
  589.    do ll=queue.aqn.!bot to queue.aqn.!top
  590.        if nowtime-queue.aqn.ll.!time < queue.aqn.!lifespan then leave
  591.        ikill=ll
  592.    end
  593.    if ikill>0 then do           /* got some old duffers */
  594.      do ll=queue.aqn.!bot to ikill
  595.         foo=drop_a_rec(aqn,ll)
  596.      end
  597.      queue.aqn.!bot=ikill+1
  598.    end
  599. end
  600.  
  601.  
  602. /* dig stuff out of options */
  603. do until options=""
  604.   parse upper var options ax options ; ax=strip(ax)
  605.   if abbrev(ax,'REM')=1 then remove_full=1
  606.   if abbrev(ax,'QUI')=1 then quick_mode=1
  607.   if abbrev(ax,'ID')=1 then do
  608.       parse upper var ax . '=' id
  609.   end
  610. end
  611.  
  612. /* check for filled up */
  613. currecs=1+queue.aqn.!top-queue.aqn.!bot
  614. if currecs>queue.aqn.!max & queue.aqn.!max<>0 then do
  615.   if remove_full=0 then return -8
  616. end
  617. else do
  618.   remove_full=0         /* not full, so no removal needed */
  619. end
  620.  
  621. if abbrev(type,'REC')=1 then do         /* overwrite a record */
  622.     parse var type . '=' recoffset ; 
  623.     recoffset=strip(recoffset)
  624.     if recoffset="" | datatype(recoffset)<>'NUM' then return -2
  625.     type='REC'
  626.     remove_full=0  /*overwrite, so no overflow worries */
  627. end
  628. else do         /* locked against PUSH and QUEUE ? */
  629.    if nowtime<queue.aqn.!lock then return -20
  630. end
  631.  
  632. select                  /* add to top or bottom */
  633.   when type='BOTTOM' then do
  634.      ii=queue.aqn.!bot-1
  635.      queue.aqn.ii.!value=aval
  636.      queue.aqn.ii.!bytes=length(aval)
  637.      queue.aqn.ii.!time=nowtime
  638.      queue.aqn.ii.!id=id
  639.      queue.aqn.!bot=ii
  640.      if remove_full=1 then do   /* remove top */
  641.         eek=queue.aqn.!top
  642.         fii=drop_a_rec(aqn,eek)
  643.         queue.aqn.!top=eek-1
  644.      end
  645.   end
  646.  
  647.   when  type='TOP' then do
  648.      ii=queue.aqn.!top+1
  649.      queue.aqn.ii.!value=aval
  650.      queue.aqn.ii.!bytes=length(aval)
  651.      queue.aqn.ii.!time=nowtime
  652.      queue.aqn.ii.!id=id
  653.      queue.aqn.!top=ii
  654.      if remove_full=1 then do   /* remove bottom */
  655.         eek=queue.aqn.!bot
  656.         fii=drop_a_rec(aqn,eek)
  657.         queue.aqn.!bot=eek+1
  658.      end
  659.         
  660.   end
  661.   when abbrev(type,'REC')=1 then do
  662.      if recoffset>0 then 
  663.         ii=queue.aqn.!bot+aval-1
  664.      else
  665.         ii=1+queue.aqn.!top-aval
  666.      if ii>queue.aqn.!top | ii<queue.aqn.!bot then return -2
  667.      queue.aqn.ii.!value=aval
  668.      queue.aqn.ii.!bytes=length(aval)
  669.      queue.aqn.ii.!id=id
  670.      queue.aqn.ii.!time=nowtime
  671.   end
  672.   otherwise nop
  673. end
  674.  
  675. /* check if bottom to close to 0 */
  676. if queue.aqn.!bot=1 then do    /* to close; move it up */
  677.       igoo=0
  678.       do ll=queue.aqn.!top to 1 by -1
  679.         igoo=1000+ll
  680.         queue.aqn.igoo.!value=queue.aqn.ll.!value
  681.         queue.aqn.igoo.!bytes=queue.aqn.ll.!bytes
  682.         queue.aqn.igoo.!time=queue.aqn.ll.!time
  683.         queue.aqn.igoo.!id=queue.aqn.ll.!id
  684.         if ll<1000 then foo=drop_a_rec(aqn,ll)   /* delete this record */
  685.       end
  686.       queue.aqn.!top=queue.aqn.!top+999
  687.       queue.aqn.!bot=1000
  688. end
  689.  
  690. return 1      
  691.  
  692.  
  693. /**********************************************/
  694. /* do FIND id 
  695. type= TOP or BOTTOM (or top= or bottom=)
  696. infofield=value time size id rec, exact partial wild, id=no id=yes
  697. aval=the id look for
  698.  */
  699. queue_find:procedure expose queue. nowtime
  700. parse upper arg aqn,type0,inf0,aval
  701.  
  702. parse var inf0 infofield srchtype fieldtype
  703. infofield=strip(infofield); srchtype=strip(srchtype); fieldtype=strip(fieldtype)
  704.  
  705.  
  706. parse var type0 type  '=' ioffset
  707. type=strip(type)
  708. if ioffset="" | datatype(ioffset)<>'NUM' then ioffset=1
  709. ioffset=max(ioffset,1)
  710.  
  711. if aqn='!' then do
  712.     if infofield="" | infofield='VALUE' then return ""
  713.     return -10
  714. end
  715.  
  716. if symbol('QUEUE.'||aqn)<>'VAR' then do
  717.     if infofield="" | infofield='VALUE' then return ""
  718.     return -1
  719. end
  720.  
  721. if aval="" then do
  722.    if infofield="" | infofield='VALUE' then return ""
  723.    return  -11   /* bad aval */
  724. end
  725.  
  726. nrecs=1+queue.aqn.!top-queue.aqn.!bot
  727.  
  728. /* check for empty queue */
  729. if nrecs<1 then do
  730.   if infofield="" | infofield='VALUE' then return ""
  731.   return -3
  732. end
  733.  
  734. if nrecs<ioffset then do
  735.   if infofield="" | infofield='VALUE' then return ""
  736.   return -16
  737. end
  738.  
  739. /* what info to get */
  740. select                                 /* the info to return */
  741.      when infofield='VALUE' then want='!VALUE'
  742.      when infofield='TIME' then want='!TIME'
  743.      when infofield='ID' then want='!ID'
  744.      when infofield='SIZE' then want='!BYTES'
  745.      otherwise want='!VALUE'
  746. end
  747.  
  748. igot=0
  749. if fieldtype='ID=YES' then aval=upper(strip(aval))
  750. do jj0=ioffset to nrecs
  751.    jj=jj0
  752.    if type='TOP' then jj=1+nrecs-jj
  753.  
  754.    jj=queue.aqn.!bot+jj-1  /* includes 1000 offset */
  755.  
  756.    vfield=queue.aqn.jj.!id
  757.    if fieldtype='ID=NO' then vfield=queue.aqn.jj.!value /* what to search */
  758.    select               /* 3 different types of search */
  759.       when srchtype='EXACT' then do
  760.          if vfield==aval then igot=jj
  761.       end
  762.       when srchtype='PARTIAL' then  do
  763.          if pos(aval,upper(vfield))>0 then igot=jj
  764.       end
  765.       when srchtype='WILD' then do
  766.          if wild_match(vfield,aval)<>'0' then igot=jj
  767.       end
  768.       otherwise do
  769.          if queue.aqn.jj.!id==aval then igot=jj
  770.       end
  771.    end                  /*select */
  772.    if igot=0 then iterate
  773. /* got match, return info */
  774.     if abbrev(infofield,'REC')=1 then do
  775.           daval=jj0
  776.     end
  777.     else do
  778.           daval=queue.aqn.jj.want
  779.     end
  780.     return daval
  781. end
  782.  
  783. /* not found */
  784. if infofield="" | infofield='VALUE' then return ""  
  785. return -12
  786.  
  787.  
  788. /**********************************************/
  789. /* do POP and READ 
  790. Action is READ or POP
  791. type is TOP, BOTTOM,  NEWEST, OLDEST, REC
  792. infofield is VALUE, ID, TIME, SIZE, #RECORDS NOREAD
  793. aval is count, or timespan (or nothing).
  794.  
  795. */
  796. queue_pop:procedure expose queue. nowtime quick_mode
  797.  
  798. parse arg aqn,action,type,infofield,aval
  799.  
  800. buildit=""
  801.  
  802. if aqn='!' then do
  803.    if infofield="" | infofield='VALUE' then return ""
  804.     call pmprintf_sref('SREF_QUEUE Storage: no queuename ')
  805.     return -10
  806. end
  807. if symbol('QUEUE.'||aqn)<>'VAR' then do
  808.    if infofield="" | infofield='VALUE' then return ""
  809.     return -1
  810. end
  811. /* check for empty queue */
  812. if queue.aqn.!top<queue.aqn.!bot then do
  813.   if infofield="" | infofield='VALUE' then return ""
  814.   return -3
  815. end
  816.  
  817. if datatype(aval)<>'NUM' & aval<>"" then do
  818.    if infofield="" | infofield='VALUE' then return ""
  819.    return  -8   /* bad aval */
  820. end
  821.  
  822. if action='POP' then do
  823.    if nowtime<queue.aqn.!lock then return -20
  824. end
  825.  
  826. dlm=queue.aqn.!dlm
  827.  
  828. /* what info to get */
  829. select                                 /* the info to return */
  830.      when infofield='VALUE' then want='!VALUE'
  831.      when infofield='TIME' then want='!TIME'
  832.      when infofield='ID' then want='!ID'
  833.      when infofield='SIZE' then want='!BYTES'
  834.      when infofield='NOREAD' then quick_Mode=1
  835.      otherwise want='!VALUE'
  836. end
  837.  
  838. /* convert NEWEST and OLDEST into TOP and BOTTOM,
  839.  aval has been converted into fractional days */
  840. if type="NEWEST" then do
  841.   chktime=nowTIME-aval            /* any !time after chktime is okay */
  842.   igot=0
  843.   do mm=queue.aqn.!top to queue.aqn.!bot by -1  
  844.       if queue.aqn.mm.!time<chktime then leave
  845.       igot=IGOT+1
  846.   end 
  847.   aval=igot
  848.   type='TOP'
  849. end
  850. if type='OLDEST' then do      
  851.    chktime=queue.aqn+aval       /*anytime before chktime */
  852.    igot=0
  853.    do mm= queue.aqn.!bot to queue.aqn.!top
  854.          if queue.aqn.mm.!time>chktime then leave
  855.          igot=igot + 1
  856.    end
  857.    type='BOTTOM'
  858.    aval=igot
  859. end
  860.  
  861. /* make sure aval isn't too big */
  862.  
  863.  
  864. aval=min(aval,1+queue.aqn.!top-queue.aqn.!bot)
  865.  
  866. if aval=0 then do               /* nothing within timespan */
  867.    if infofield="" | infofield='VALUE' then return ""
  868.    return -9
  869. end
  870.  
  871.  
  872. /* pop or read something */
  873. select 
  874.  
  875.  when type='TOP' then do          /* from top of queue */
  876.      if infofield="#RECORDS" then do            /* how many records would be returned */
  877.          icur=1+queue.aqn.!top-queue.aqn.!bot              
  878.          return min(icur,aval)
  879.      end
  880.  
  881.      ifoo=queue.aqn.!top
  882.      if quick_mode=0 then buildit=queue.aqn.ifoo.want    /* info from first record to return */
  883.      if action='POP' then   fii=drop_a_rec(aqn,ifoo)
  884.      do ij=1 to aval-1                      /* perhaps add more */
  885.             ifoo=queue.aqn.!top-ij
  886.             if quick_mode=0 then  buildit=buildit||dlm||queue.aqn.ifoo.want
  887.             if ifoo=queue.aqn.!bot then leave
  888.             if action="POP" then 
  889.                  fii=drop_a_rec(aqn,ifoo)
  890.      end
  891.      if action="POP" then do               /* if pop, reset limits */
  892.             newtop=max(queue.aqn.!bot-1,queue.aqn.!top-aval)
  893.             queue.aqn.!top=newtop
  894.      end
  895.      return buildit
  896.  end            /* when   TOP */
  897.  
  898.  
  899.  when type='BOTTOM' then do          /* from bottom of queue */
  900.      if infofield='#RECORDS' then do            /* how many records would be returned */
  901.          icur=1+queue.aqn.!top-queue.aqn.!bot              
  902.          return min(icur,aval)
  903.      end
  904.      ifoo=queue.aqn.!BOT
  905.      if quick_mode=0 then buildit=queue.aqn.ifoo.want            /* first record to return */
  906.      if action='POP' then fii=drop_a_rec(aqn,ifoo)
  907.  
  908.      do ij=1 to aval-1                      /* perhaps add more */
  909.             ifoo=queue.aqn.!bot+ij
  910.             if quick_mode=0 then buildit=buildit||dlm||queue.aqn.ifoo.want
  911.             if ifoo=queue.aqn.!top then leave
  912.             if action="POP" then fii=drop_a_rec(aqn,ifoo)
  913.      end
  914.      if action="POP" then do               /* if pop, reset limits */
  915.             newbot=min(queue.aqn.!top+1,queue.aqn.!bot+aval)
  916.             queue.aqn.!bot=newbot
  917.      end
  918.      return buildit
  919.  end            /* when  DEFAULT OR TOP */
  920.  
  921.  when type='REC' then do             /* explicit record */
  922.     if aval<0 then
  923.          ido=1+queue.aqn.!top-aval
  924.     else
  925.          ido=queue.aqn.!bot+aval-1
  926.     if ido>queue.aqn.!top | ido<queue.aqn.!bot then do
  927.        if infofield="" | infofield="VALUE" then return ''
  928.        return -2
  929.     end
  930.     return queue.aqn.ido.want
  931.  end
  932.  
  933.  otherwise do
  934.     if ido>queue.aqn.!top then do
  935.        if infofield="" | infofield='VALUE' then return ""
  936.        return -100
  937.     end
  938.  end
  939.  
  940. end             /* select */
  941.  
  942.  
  943. /*****************/
  944. /* drop a record */
  945. drop_a_rec:procedure expose queue. 
  946. parse arg aqn,mm
  947.     drop queue.aqn.mm.!value queue.aqn.mm.!time queue.aqn.mm.!bytes queue.aqn.mm.!id
  948. return 1
  949.  
  950.  
  951. /************************/
  952. /* Do a multi wild card match -- return stats on match
  953.    Stats are list of letter positions (in needle) that are matched
  954.    Or, -1 for "exact match"
  955.    OR, 0 for "no match"
  956. Example: Needle="THIS/IS/VERY/SILLY"
  957.         haystack="THIS*VERY*"
  958.         would yield: 1 2 3 4 9 10 11 12
  959.  One can then compare this result list to other result lists (to ascertain
  960.  best match */
  961.  
  962.  
  963. wild_match:procedure
  964. parse upper arg needle, haystack ; haystack=strip(haystack)
  965.  
  966. if needle=haystack then return -1        /* -1 signals exact match */
  967. ast1=pos('*',haystack)
  968. if ast1=0 then return 0                 /* 0 means no match */
  969. if haystack='*' then do
  970.   if length(needle)=0 then
  971.       return 100000
  972.    else 
  973.       return length(needle)
  974. end
  975. ff=haystack
  976. ii=0
  977. do until ff=""
  978.   ii=ii+1
  979.   parse var ff hw.ii '*'  ff
  980.   hw.ii=strip(hw.ii)
  981. end
  982. if hw.ii='' then ii=ii-1
  983. hw.0=ii
  984.  
  985.  
  986. /* check each component of haystackw against needle -- all components
  987. must be there */
  988.  
  989. resu=' '
  990. istart=1 ; ido=2
  991. if ast1>1 then do       /* first check abbrev */
  992.   if abbrev(needle,hw.1)=0 then return 0
  993.   aresu=length(hw.1)
  994.   if hw.0=1 then do
  995.      do nm=1 to aresu
  996.         resu=resu||' '||nm
  997.      end /* do */
  998.      return resu         /* if haystacy of form abc*, we have a match */
  999.   end
  1000.   ido=2 ; istart=aresu+1
  1001.   do mm=1 to aresu
  1002.         resu=resu||' '||mm
  1003.   end /* do */
  1004. end
  1005. /* if here, then first part (a non wildcard) of haystack matches first
  1006. part of needle
  1007. Now check sequentially that each remaining part also exists
  1008. */
  1009. do mm=ido to hw.0
  1010.   igoo=pos(hw.mm,needle,istart)
  1011.   if igoo=0 then return 0
  1012.   tres=length(hw.mm)
  1013.   istart=igoo+tres
  1014.   do nn=igoo to (istart-1)
  1015.      resu=resu||' '||nn
  1016.   end /* do */
  1017. end
  1018. if istart >= length(needle) | right(haystack,1)='*' then
  1019.    return resu
  1020. return 0
  1021.  
  1022.  
  1023. /**********************************/
  1024. /* request specific variables
  1025. syntax of stuff is
  1026.     request_thread,info
  1027. where info depends on type:
  1028.   REQ_GET : The variable name (returns '' if no such request variable)
  1029.   REQ_PUT : varname','value  
  1030.   REQ_INI : host_Nickname,servername
  1031.  
  1032. special REQ_GET varnames:
  1033.   * -- all varnames for this request
  1034.  !MAX -- value of reqvars.!max
  1035.  !ACTIVE -- value of reqvars.0
  1036. */
  1037.  
  1038.  
  1039. do_req_vars:procedure expose reqvars. quick_mode
  1040. parse arg  type,stuff
  1041.  
  1042. /* get the thread id that identifies the request space */
  1043. parse var stuff tid','stuff
  1044.  
  1045.  
  1046. /* catch non specific tid */
  1047. if datatype(tid)<>'NUM' then do         /* non specfic request (daemons, postfilter */
  1048.    tid='!OTHER'
  1049. end
  1050.  
  1051. /* need thread id */
  1052. quick_mode=1
  1053.  
  1054. select
  1055.   when type='REQ_GET' then do
  1056.      quick_Mode=0
  1057.      ipp=wordpos(tid,reqvars.0)
  1058.      if ipp=0 then return '.'           /* no info on this request */
  1059.      toget=strip(upper(stuff))
  1060.      if toget='*' then return reqvars.tid.0     /* return variable list */
  1061.      if toget='!ACTIVE' then return reqvars.0  /* requests for which info is avaialable */
  1062.      if toget='!MAX' then return reqvars.!max   /* max # requests to store info on */
  1063.      if wordpos(toget,reqvars.tid.0)=0 then return ''  /* no such var for this request */
  1064.      aa='!'||toget
  1065.      return reqvars.tid.aa
  1066.   end
  1067.   when type='REQ_PUT' then do
  1068.      quick_mode=1
  1069.      ipp=wordpos(tid,reqvars.0)
  1070.      if ipp=0 then return ''
  1071.      parse var stuff vname','stuff
  1072.      if words(vname)=1 then do
  1073.        vname=strip(upper(vname))
  1074.        aa='!'VNAME
  1075.        reqvars.tid.aa=stuff
  1076.        if wordpos(vname,reqvars.tid.0)=0 then reqvars.tid.0=reqvars.tid.0' 'vname
  1077.      end
  1078.      else do
  1079.        do forever
  1080.          if vname="" then leave
  1081.          parse var vname vname0 vname
  1082.          parse var stuff stuff0','stuff
  1083.          vname0=strip(upper(vname0))
  1084.          aa='!'VNAME0
  1085.          reqvars.tid.aa=stuff0
  1086.          if wordpos(vname0,reqvars.tid.0)=0 then reqvars.tid.0=reqvars.tid.0' 'vname0
  1087.        end
  1088.      end
  1089.   end
  1090.   when type='REQ_INI' then do
  1091.      dmax=reqvars.!max ; dloop=0
  1092.      if  words(reqvars.0)>=reqvars.!max then do
  1093.           dloop=(words(reqvars.0)-reqvars.!max)+3
  1094.      end   
  1095.      do jj=1 to dloop                /* prune old request info */
  1096.        nid=strip(word(reqvars.0,1))
  1097.        do ii=1 to words(reqvars.nid.0)   /* drop vars associated with this request */
  1098.            aw='!'||strip(word(reqvars.nid.0,ii))
  1099.            drop reqvars.nid.aw
  1100.        end
  1101.        drop reqvars.nid.0
  1102.        parse var reqvars.0 foo reqvars.0
  1103.      end
  1104.  
  1105.  
  1106. /* == DEBUG stuff.
  1107. foo=cvtails(reqvars,aa)
  1108. call pmprintf(" # items in reqvars= "aa.0)
  1109.  
  1110. aff='g:\goserve\a.out'
  1111. call lineout aff,' '
  1112. call lineout aff,reqvars.0
  1113. call lineout aff,'# items in reqvars= 'aa.0
  1114. do jj=1 to aa.0
  1115.    call lineout aff,aa.jj
  1116. end
  1117. call lineout aff
  1118. ******/
  1119.  
  1120.      reqvars.0=reqvars.0' 'tid          /* add this request id; always have OTHER  */
  1121.      if pos('!OTHER',reqvars.0)=0 then reqvars.0='!OTHER 'reqvars.0
  1122.      reqvars.tid.0=''
  1123.      do until stuff=''
  1124.         parse var stuff a1  stuff
  1125.         parse var a1 a1a'='a1b  ; a1a=strip(upper(a1a))
  1126.         reqvars.tid.0=reqvars.tid.0' 'a1a
  1127.         foo='!'a1a
  1128.         reqvars.tid.foo=a1b
  1129.      end
  1130.      quick_mode=1
  1131.   end
  1132.   otherwise nop
  1133.      
  1134. end
  1135.         
  1136. return 0
  1137.        
  1138.  
  1139.  
  1140.