home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / packback.zip / PACKBACK.CMD next >
OS/2 REXX Batch file  |  1999-04-27  |  15KB  |  534 lines
  1. /*  26 April 1999. Timur Kazimrov (timur@r1.sax.inkom.ru) 
  2.     and Daniel Hellerstein (danielh@econ.ag.gov)
  3.  
  4.     Pre-reply procedure that strips CRLFs, unused spaces, and comments
  5.     from outgoing HTML documents, for selected clients. 
  6.     This can be useful for large HTML documents in low bandwidth situations.
  7.  
  8.     You can also run it in stand-alone mode (possibly even under non-os/2 rexx)
  9.  
  10. Setup:
  11.  1)  Copy this to your  GoServe\SRE "working directory"
  12.  2)  Edit the ClientsToPack. parameters 
  13.     a) set ClientsToPack.0= # of entries
  14.     b) set ClientsToPack.n= a numeric IP address (n=1,..,ClientsToPack.0).
  15.        You can use * as wildcards.
  16.        For example:   if the client's IP address is 199.122.33.1, then
  17.        the following will match:
  18.                 ClientsToPack.3='199.122.33.1'
  19.                 ClientsToPack.3='199.122.*'
  20.                 ClientsToPack.3='199.12*'
  21.  3) Modify the other user-changeable parameters -- pay special attention to  
  22.     pieces_size and maxdocsize
  23.  
  24.  4) Idenfity PACKBACK as a Pre-Reply procedure (see PREREPLY.DOC for instructions on
  25.     working with Pre-Reply procedures.
  26.  
  27. Notes:
  28.   *  If you are using more then one pre-reply procedure, you'll have to create
  29.      your own "pre-reply" manager that calls each pre-reply procedure in the
  30.      proper sequence.
  31.  
  32. */
  33.  
  34.  
  35.  
  36. /*   ---------- Begin   USER CHANGEABLE PARAMETERS   ------------------ */
  37.  
  38. /* If client's address is presented here the HTML compressing
  39.    will be performed -- note that * wildcards are allowed
  40.    If ClientsToPack.0=0, then this procedure does nothing. */
  41.  
  42. CLIENTSTOPACK.0=1
  43.  
  44. CLIENTSTOPACK.1='*' 
  45.  
  46. /* If the source document is larger than MAXDOCSIZE the compression
  47.    won't be performed. This parameter should be tuned. Size is
  48.    in bytes.
  49.    Note: large files can take a minute or longer to process, which can cause
  50.          an "inactive-timeout". To avoid this,  increase the options-limit-
  51.          end_client_after_inactive GoServe parameter
  52. */
  53.  
  54.  
  55. MAXDOCSIZE=1500000  /* All documents larger that 1,500,000 bytes won't be compressed */
  56.  
  57. /* If the source document is smaller than MINDOCSIZE the compressing
  58.    won't be performed. This parameter should be tuned. Size is
  59.    in bytes. */
  60.  
  61. MINDOCSIZE=2000  /* All documents smaller that 2000 bytes won't be compressed */
  62.  
  63.  
  64. /* If size exceeds this limit (in bytes), and is less then maxdocsize, 
  65.    then send  it 'in pieces'.
  66.       This avoids inactive-timeout problems, but also means that
  67.        transfer-encoding and encryption will NOT be attempted
  68.    To disable, set pieces_size > maxdocsize  */
  69.  
  70. Pieces_Size=3000
  71.  
  72. /*   ----------  End  USER CHANGEABLE PARAMETERS   ------------------ */
  73.  
  74.  
  75. parse arg contents,fileflag,mimetype,clen
  76.  
  77. isalone=0
  78. if fileflag='' then do          /* stand alone mode */
  79.   call init_standalone
  80.   inpieces=0
  81.   isalone=1
  82.   aa=stuff ; drop stuff
  83.   signal doalone
  84. end /* do */
  85.  
  86.  
  87. if pos('TEXT/HTML', translate(mimetype))=0 then return 0
  88.  
  89. if CLIENTSTOPACK.0=0 then
  90.   return 0
  91.  
  92. clientfound=0
  93. caddr=extract('CLIENTADDR')
  94.  
  95. do mm=1 to clientstopack.0
  96.   oo=sref_wild_match(caddr,clientstopack.mm)
  97.   if oo=0 then iterate          /* not a match */
  98.   clientfound=1
  99.   leave
  100. end
  101.  
  102. if clientfound=0 then return 0
  103.  
  104. if fileflag=1 then 
  105.    jlen=stream(contents,'c','query size')
  106. else
  107.    jlen=clen
  108.  
  109.  
  110. if (clen > MAXDOCSIZE) | (jlen > MAXDOCSIZE) then return 0
  111. if (clen < MINDOCSIZE) | (jlen < MINDOCSIZE) then return 0
  112.  
  113. inpieces=0
  114. if jlen>pieces_size | clen>pieces_size then do
  115.   inpieces=1
  116.   cprotocol=extract('clientprotocol')
  117.   parse upper var cprotocol 'HTTP/' ver .
  118.   if datatype(ver)<>'NUM' then ver=0.9
  119.   'set netbuffer off'         /* turn off buffering */
  120.   if  ver>1.0 then do
  121.      'HEADER ADD Transfer-Encoding: Chunked'
  122.        goo=sref_value('!CHUNK',1,'REQ')
  123.   end
  124.   'HEADER ADD Content-Type: 'mimetype
  125.   foo=reqfield('connection')
  126.   if pos('CLOSE',upper(foo))>0 | doclose=1 then 'Header add Connection: close '
  127.   'send  as packback'
  128. end
  129.  
  130.  
  131. if fileflag=1 then do
  132.   foo=stream(contents,'c','open read')
  133.   aa=charin(contents,1,jlen)
  134.   foo=stream(contents,'c','close')
  135. end 
  136. else do
  137.   aa=contents
  138. end
  139.  
  140. doalone: ;
  141.  
  142. aa=htmlpack(aa,inpieces,isalone)
  143. if inpieces=1 then do
  144.    if broken=1 then return ''   /* busted connection, don't bother with proper close */
  145.    thevalue=aa
  146.    if ver>1.0 then thevalue=sref_chunk(aa,1)
  147.    foo=reqfield('connection')
  148.    if pos('CLOSE',upper(foo))>0 | doclose=1 then
  149.        'var nowait name thevalue'
  150.      else 
  151.        'var name thevalue'
  152.    'SEND Complete'          /* and complete the send */
  153.    return ''    /* signal sre-http that "I did it" */
  154. end /* do */
  155.  
  156.  
  157. if isalone=1 then do    /* write file and exit */
  158.    foo=charout(outfile,aa,1)
  159.    if foo>0 then
  160.         say "Problem writing: "outfile
  161.    else
  162.         say outfile "written succesfully"
  163.   exit
  164. end
  165.  
  166. newlen=length(aa)               /* return to sre-http */
  167. return aa
  168.  
  169. /*************************/
  170. htmlpack:procedure expose broken ver
  171. parse arg stuff,inpieces,isalone
  172.  
  173. ssi_list='REPLACE # % INCLUDE $ SELECT INTERPRET OPTIONS CACHE'
  174.  
  175. broken=0
  176.  
  177. ssi_list.0=0
  178. if ssi_list<>'' then do
  179.   do ioo=1 to words(ssi_list)
  180.     ssi_list.ioo=translate(strip(word(ssi_list,ioo)))
  181.   end
  182.   ssi_list.0=words(ssi_list)
  183. end
  184.  
  185. tstuff=translate(stuff)
  186.  
  187. /* parse the file, removing crls and spaces where possible */
  188. /* but -- pull out PRE SCRIPT and APPLET chunks */
  189.  
  190. i1=pos('PRE',tstuff); i2=pos('SCRIPT',tstuff) ; i3=pos('APPLET',tstuff)
  191. if i1+i2+i3=0 then do
  192.     newstuff=space(translate(stuff,' ','00090d0a'x),1)
  193.     signal alldone    
  194. end 
  195.  
  196. newstuff=''
  197. iwas=0
  198. do forever
  199.     if length(newstuff)>1000 & inpieces=1 then do
  200.         if ver>1.0 then newstuff=sref_chunk(newstuff)
  201.         'Var name newstuff'
  202.          res1=rc
  203.          if res1<0 then do
  204.             broken=1
  205.             return ''
  206.          end 
  207.          newstuff=''
  208.     end /* do */
  209.     if isalone=1 then do
  210.         if length(newstuff)-iwas > 10000 then do
  211.                 say " Processed "length(newstuff)
  212.                 iwas=length(newstuff)
  213.         end /* do */
  214.     end /* do */
  215.     else
  216.     if stuff='' | stuff=' ' then leave
  217.     parse var stuff a1 '<' a2 '>' stuff
  218.     a1=space(translate(a1,' ','0d0a0009'x),1)
  219.     newstuff=newstuff||a1
  220.     if a2="" & stuff="" then  leave
  221.  
  222. /* what kind of element? */
  223.    parse var a2 a2a a2b a2bb ; a2a=strip(translate(a2a))
  224.  
  225. /* get rid of comments? */
  226.     a2b=translate(strip(a2b))
  227.     if a2a='!--' then do                /* a comment -- remove it (if not an ssi)? */
  228.         iscomment=1
  229.         parse var a2b a2c . 
  230.         do mm=1 to ssi_list.0
  231.            if abbrev(ssi_list.mm,a2b)=1 then do
  232.                iscomment=0 ; leave
  233.            end /* do */
  234.         end /* do */
  235.        if iscomment=1 then iterate
  236.     end /* do */
  237.  
  238. /* is a2a=PRE, SCRIPT or APPLET? If so, read as is (until /a2a) */
  239.     if wordpos(a2a,'PRE SCRIPT APPLET')=0 then do
  240.          a2=space(translate(a2,' ','0d0a0009'x),1)
  241.          newstuff=newstuff||'<'||a2||'>'
  242.          iterate
  243.     end /* do */
  244. /* add to newstuff until /a2a */
  245.     newstuff=newstuff||'<'||a2||'>'
  246.     endat='/'||a2a
  247.     do forever                  /* use as is */
  248.        if stuff='' | stuff=' ' then leave
  249.        parse var stuff b1 '<' b2 '>' stuff
  250.        newstuff=newstuff||b1||'<'||b2||'>'
  251.        parse var b2 b2a . ; b2a=strip(translate(b2a))
  252.        if b2a=endat then leave
  253.     end /* do */
  254. end                     /* stuff parsing */   
  255.  
  256.  
  257. alldone:
  258.  
  259. return newstuff         /* might be full doc, or last piece */
  260.  
  261.  
  262.  
  263. /****************************************/
  264. /* initializations; when run as a standalone program */
  265. init_standalone:
  266.  
  267. opsys=''
  268.  
  269. do forever
  270.  if queued()=0 then leave
  271.  pull foo
  272. end
  273. parse upper version oof
  274.  
  275. if opsys=''  then do
  276.   if pos('REXXSAA',oof)>0 then
  277.     '@VER | rxqueue'
  278.   else
  279.     'VER | rxqueue'
  280.  
  281.   do forever
  282.     if queued()=0 then leave
  283.     pull oot
  284.     if oot<>'' then otype=oot
  285.   end
  286.   select
  287.     when pos('95',otype)>0 then opsys='WIN95'
  288.     when pos('OPERATING SYSTEM/2',otype)>0 then opsys='OS/2'
  289.     when pos('DOS',otype>0) then opsys='DOS'
  290.     when pos('NT',otype)>0 then opsys='NT'
  291.     otherwise opsys=''
  292.   end
  293. end
  294.  
  295. parse version fooa aa
  296. say "You are using REXX version: "fooa" (under "opsys ')'
  297.  
  298.  
  299. foo2=1
  300. foo=rxfuncquery('sysloadfuncs')
  301. if foo=1 then do
  302.   foo2=RxFuncAdd('SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs')
  303.   if foo2=0 then call SysLoadFuncs
  304.   foo=rxfuncquery('sysloadfuncs')
  305. end
  306. if foo=0 then  do
  307.    got_rexxutil=1
  308. end
  309. else do
  310.   say "Note: RexxUtil is NOT installed, so some options will not be available."
  311.   got_rexxutil=0
  312. end
  313.  
  314. if opsys='OS/2' then  cansi=checkansi()
  315.  
  316. if  cansi=1 then do
  317.   aesc='1B'x
  318.   cy_ye=aesc||'[37;46;m'
  319.   normal=aesc||'[0;m'
  320.   bold=aesc||'[1;m'
  321.   re_wh=aesc||'[31;47;m'
  322.   reverse=aesc||'[7;m'
  323. end
  324. else do
  325.   say "Warning: ANSI not available, output will be simpler."
  326. end
  327.  
  328.  
  329. infile='';outfile=''
  330.  
  331. getin:
  332. if infile="" then do
  333.     call lineout,bold " Enter name of HTML file (?DIR for a directory, EXIT to quit) "normal
  334.     call charout,"  "reverse " :" normal
  335.     pull infile ; infile=strip(infile)
  336. end
  337.  
  338. if strip(translate(infile))='EXIT' then do
  339.    if addonmode<>1 then say "bye "
  340.    exit
  341. end /* do */
  342.  
  343.  
  344. if abbrev(translate(infile),'?DIR')=1 then do
  345.     parse var infile . thisdir
  346.  
  347.     if thisdir="" then do
  348.       if opsys='OS/2'then
  349.         thisdir=strip(directory(),'t','\')||'\*.*'
  350.      else
  351.        thisdir='.\*.*'
  352.     end
  353.     say
  354.     say reverse ' List of files in: ' normal bold thisdir normal
  355.     do while queued()>0
  356.             pull .
  357.     end /* do */
  358.     toget=thisdir
  359.     select
  360.        when  opsys='OS/2' then '@DIR /b  '||toget||' | rxqueue'
  361.        when  opsys='LINUX' then 'ls '||toget||' | rxqueue'
  362.        otherwise 'DIR /b  '||toget||' | rxqueue'
  363.     end
  364.     foo=show_dir_queue('*')
  365.     say
  366.     infile=''
  367.     signal getin
  368. end
  369.  
  370. if abbrev(translate(strip(infile)),'/DIR')=1 then do
  371.     infile=substr(strip(infile),2)
  372.     address cmd infile
  373.     infile=''
  374.     signal getin
  375. end /* do */
  376.  
  377.  
  378. /* maybe it's actually a file name */
  379.  
  380. infile=strip(infile)
  381. infile0=infile
  382. if pos('.',infile)=0 then infile=infile||'.HTM'
  383. htmlfile=stream(infile,'c','query exists')              /* does it, or .html or .htm version of it, exist*/
  384. if htmlfile='' & pos('.',infile0)=0 then htmlfile=stream(infile0,'c','query exists')
  385. if htmlfile='' then htmlfile=stream(infile0||'.HTML','c','query exists')
  386.  
  387.  
  388. if htmlfile='' then do
  389.     Say "Sorry. could not find: " infile
  390.     exit
  391. end /* do */
  392.  
  393. htmllen=stream(htmlfile,'c','query size')
  394. if htmllen=0 then do
  395.    say " Sorry -- " htmlfile " is empty "
  396.    infile=''
  397.    signal getin
  398. end /* do */
  399. stuff=charin(htmlfile,1,htmllen)
  400. Say "Reading " HTMLlen " characters from " htmlfile
  401.  
  402. outget: nop
  403. if outfile='' then do
  404.    parse var htmlfile tout '.' .
  405.    tout=tout||'.TXT'
  406.    say " "
  407.    say bold " Enter name of output file (ENTER="tout")"normal
  408.    call charout,"  "reverse " :" normal
  409.    parse pull outfile
  410.    if outfile='' then outfile=tout
  411. end /* do */
  412.  
  413. foo=stream(outfile,'c','query size')
  414. if foo='' then foo=0
  415.  
  416. signal off syntax ; signal off error
  417. signal on syntax name hoy1 ; signal on error name hoy1
  418. if foo<>0 then do
  419.      if forceout=0 then do
  420.         arf=yesno(normal"     "bold"Overwrite")
  421.         if arf=0 then do
  422.             outfile='' ; signal outget
  423.         end /* do */
  424.      end                /* else, command line mode implies overrwrite */
  425.      else do
  426.           say "     Overwriting "foo
  427.      end /* do */
  428.      if got_rexxutil=1 then do
  429.          foo=sysfiledelete(outfile)
  430.      end
  431.      else do
  432.         say "     .... trying to delete "outfile
  433.         if opsys="LINUX" then
  434.            'rm 'outfile
  435.         else
  436.            'DEL 'outfile
  437.         foo=0
  438.      end
  439.      foo=stream(outfile,'c','query exists')
  440.      if foo<>'' then do
  441.             say "      Could not delete "outfile
  442.             outfile=''
  443.             signal outget
  444.      end /* do */
  445. end /* do */
  446.  
  447. return 0                /* outfile and stuff are set */
  448.  
  449. hoy1:
  450. outfile=' '
  451. say " % " sigl " : " rc
  452. say "File exists. Try another name"
  453. signal off syntax ; signal off error
  454. signal outget
  455.  
  456.  
  457.  
  458.  /* ------------------------------------------------------------------ */
  459.  /* function: Check if ANSI is activated                               */
  460.  /*                                                                    */
  461.  /* call:     CheckAnsi                                                */
  462.  /*                                                                    */
  463.  /* where:    -                                                        */
  464.  /*                                                                    */
  465.  /* returns:  1 - ANSI support detected                                */
  466.  /*           0 - no ANSI support available                            */
  467.  /*          -1 - error detecting ansi                                 */
  468.  /*                                                                    */
  469.  /* note:     Tested with the German and the US version of OS/2 3.0    */
  470.  /*                                                                    */
  471.  /*                                                                    */
  472.  CheckAnsi: PROCEDURE
  473.    thisRC = -1
  474.  
  475.    trace off
  476.                          /* install a local error handler              */
  477.    SIGNAL ON ERROR Name InitAnsiEnd
  478.  
  479.    "@ANSI 2>NUL | rxqueue 2>NUL"
  480.  
  481.    thisRC = 0
  482.  
  483.    do while queued() <> 0
  484.      queueLine = lineIN( "QUEUE:" )
  485.      if pos( " on.", queueLine ) <> 0 | ,                       /* USA */
  486.         pos( " (ON).", queueLine ) <> 0 then                    /* GER */
  487.        thisRC = 1
  488.    end /* do while queued() <> 0 */
  489.  
  490.  InitAnsiEnd:
  491.  signal off error
  492.  RETURN thisRC
  493.  
  494.  
  495.  
  496. /*********/
  497. /* show stuff in queue as a list */
  498. show_dir_queue:procedure expose qlist.
  499. parse arg lookfor
  500.     ibs=0 ;mxlen=0
  501.     if lookfor<>1 then
  502.        nq=queued()
  503.      else
  504.         nq=qlist.0
  505.     do ii=1 to nq
  506.        if lookfor=1 then do
  507.           aa=qlist.ii
  508.           ii2=lastpos('\',aa) ; anam=substr(aa,ii2+1)
  509.        end /* do */
  510.        else do
  511.           pull aa
  512.           if pos(lookfor,aa)=0 & lookfor<>'*' then iterate
  513.           parse var aa anam (lookfor) .
  514.           if strip(anam)='.' | strip(anam)='..' then iterate
  515.        end
  516.        ibs=ibs+1
  517.        blist.ibs=anam
  518.        mxlen=max(length(anam),mxlen)
  519.     end /* do */
  520. arf=""
  521. do il=1 to ibs
  522.    anam=blist.il
  523.    arf=arf||left(anam,mxlen+2)
  524.    if length(arf)+mxlen+2>75  then do
  525.         say arf
  526.         arf=""
  527.    end /* do */
  528. end /* do */
  529. if length(arf)>1 then say arf
  530. say
  531. return 1
  532.  
  533.  
  534.