/* SREhttp/2 initialization procedure:
     This launches itself as a process.
     When launched as a process, it will wait 5 seconds.
     Then, it will read startreq.rxx (in the srehttp2 directory).
     startreq.req should contain "DOGET" style requests.
     These request will be made, with output possibly saved
     Typically, the requests will be made to the site supported by this
     server.  
     For example, requests to this server to set up the CMS scheduler.

    Note: this is a simplified version of DOGET.CMD

*/

/* ------------------------------------------------------------------- */

/*BEGINUSER*/

/*    -------- User changeable parameters   ---------- */



/* The http version to report.
   Default is HTTP/1.1
   HTTP/1.0 can be used to emulate an older server */
http_ver='HTTP/1.1'


/* default "input" file. This is the batch file containing insturctions on what URI to GET 
   In general, we do NOT recommend changing this value! */
def_infile='startreq.req'

/* set to 1 to use GZIP to decompress, when GZIP is a Transfer Encoding 
   Enabling this option REQUIRES that you have rxGZIP.DLL installed on
   your computer */
do_gzip=1


/* the HOST: header to include with a request.  
     host_header='' means "include the SERVER name".  
    In ALMOST ALL cases, host_header='' SHOULD be used! */
host_header=''

/* the output file -- the contents of a response are written here
   (a prior version of the file will be overwritten)
   . means "do not write output to a file"
   Note that this can be over ridden by an output: line in a request file  */
outfile='.'


/* If SENDCLOSE=1, then close tcp/ip connection after sending requests. 
   Otherwise, keep it open to listen for another request (from this same
   client). */
sendclose=1


/* VIEWIT=1 to view (using VIEWER program) the body of the response.
   VIEWIT='' to NOT view (though response will be saved to outfile) */
viewit=''

/* viewer program to use (to view response). Leave blank
   to supress "view response?" option  */
viewer='E.EXE'

/* if viewer program is not a PM program (that is, if it's a simple
  "command line" program), set this to 1 to "close session after execution "*/
viewer_not_pm=0

/* Display extra status messages if verbose=1 */
verbose=0 

/*    -------- End of User changeable parameters   ---------- */

/*ENDUSER*/

signal on error name err1 ; signal on syntax name err1 
signal on halt name abend


/* note that if called as process, then port will be "PROCESS" */
parse arg PORT,SERVERNAME,FILTER_DIR,ARG_LIST

filter_dir=strip(strip(filter_dir),,'\')||'\'

if abbrev(strip(port),"PROCESS")<>1 then do       /* launch a process */
   if servername='' then do
        say "This SREhttp/2 initialization procedure can not be run from the command line."
        exit
   end 
  xxx2=filter_dir||'STARTREQ.CMD'
  garf='@cmd /c detach ' ||xxx2||' PROCESS  '||servername||' '||filteR_dir||' '||arg_list||' 2> nul '
/*  garf='@cmd /c detach ' ||xxx2||' PROCESS   2> nul ' */

  address cmd garf
  return 1 
end

/* if here, launched as process.  */
parse var port . servername filter_dir arg_list

/* first: Wait 10 seconds (give sre2003 time to start  recieving */

call syssleep(5)

if arg_list<>"" then def_infile=strip(arg_list)
def_infile=strip(def_infile)

if pos(':',def_infile)=0 then do  /* not fully qualified */
  def_infile=strip(def_infile,,'\')  /* must be relative to filter_dir */
  def_infile=filter_dir||def_infile
end


use_verb='GET'
output_mode=0

verbose=0
httpport=80
gosock=0
mehost=strip(servername)
crlf='0d0a'x 

call load /* load functions if necessary */

afil=strip(def_infile)
iss=stream(afil,'c','query size')
if iss=0 | iss='' then do
   call sre_pmprintf('StartReq: there is no requests file ('afil)
   exit
end 
goo=charin(afil,1,iss); foo=stream(afil,'c','close')

/*** Jump here to get next request listed in the batch file */
get_next_request: 

if goo='' then exit             /* nothing left to do */

opts="" ;upwd=""

sshost=host_header

call do_batch           /* read request from GOO (either original file, or remainder */
     
if got1=0 then exit     /* nothing to do */

batchmode=1

server0=server
parse var server server ':' bport
if bport<>'' then httpport=bport

if abbrev(translate(request),'HTTP://')=0 then request='/'strip(request,'l','/')

use_verb=translate(strip(word(use_verb,1)))

family  ='AF_INET'

rc=1
if verify(server,'1234567890.')>0 then 
   rc=sockgethostbyname(server, "serv.0")  /* get dotaddress of server */
else
  serv.0addr=strip(server)
if rc=0 then do; call sre_pmprintf('StartReq ERROR: Unable to resolve "'server'"'); exit; end
dotserver=serv.0addr                    /* .. */

gosaddr.0family=family                  /* set up address */
gosaddr.0port  =httpport
gosaddr.0addr  =dotserver

tim1=time('r')
setup1:

gosock = SockSocket(family, "SOCK_STREAM", "IPPROTO_TCP")

gethead='GET'

httpis='HTTP/1.1'
if http_ver<>'' then httpis=strip(word(http_ver,1))


if sshost='' then sshost=server

message=gethead' 'request' 'httpis||crlf
if strip(sshost)<>'.' then message=message||'HOST:'sshost||crlf

message=message||'Referer:do_get@'||mehost||crlf
message=message||'User-Agent: SRE2003_DOGET_v1.12d'||crlf 

if upwd<>' ' then
  message=message||'Authorization: '||upwd||crlf

if opts<>"" then do
   if right(opts,2)<>'0d0a'x then opts=opts||'0d0a'x
end 
message=message||opts
if sendclose=1 then do
  message=message||'Connection: close' crlf
end

message=message||crlf         /* "blank line" sginals end of headers */

rc = SockConnect(gosock,"gosaddr.0")
if rc<0 then do; call sre_pmprintF('StartReq ERROR: Unable to connect to "'server'"'); exit; end
rc = SockSend(gosock, message)

if verbose=1 then call sre_pmprintf('     Connected... ('||rc||')')

/* Now wait for the response */
tim2=time('e')
rs=0
gots.=''
gots.0=0
runlen=0
do forever
  response=''
  rc = SockRecv(gosock, "response", 1000)
  if response<>'' then do
     rs=rs+1
     gots.rs=response   
     gots.0=rs
     runlen=runlen+length(response)
  end 
  if rc<=0 then leave
end 

rc = SockClose(gosock)

tim3=time('e')

if runlen=0 then exit

got=''
do mm=1 to rs
   got=got||gots.mm
end 
drop gots.

findit=crlf||crlf
foo=pos(findit,got)
t1=substr(got,1,foo-1)

/* look for 401 return code */
parse var t1  line1 '0d0a'x t2
parse var line1 . icode .
if icode<>401  then signal writeit


writeit:                        /* jump here to write stuff */


/* see if any transfer encodings to do */
telist='';CELIST=''
crange='';ccontrol=''
ims='' ; etag=''
do until t1=""
    parse var t1 aa '0d0a'x  t1
    parse  upper var aa a1a ':' a1b
    if a1a='TRANSFER-ENCODING' then telist=telist','a1b
    if a1a='CONTENT-ENCODING' then Celist=Celist','a1b
    if a1a='CACHE-CONTROL' then ccontrol=a1b
    if a1a='ETAG' then etag=strip(strip(a1b),,'"')
    if a1a='CONTENT-RANGE' then crange=strip(strip(a1b),,'"')
end 

celist=translate(strip(space(translate(celist,' ',','||'0d0a09'x),1)))

t2=substr(got,foo+length(findit))

/* if found transfer encodings, see if you can do 'em 
(you can always do chunk) */
if telist<>''  then do
   telist=translate(telist,' ',',')
   do ww=words(telist) to 1 by -1    /* always do in reverse order of encoding */
      atype=strip(word(telist,ww))
      select
         when abbrev(atype,'CHUNK')=1 then do
           t2=unchunk(t2)
         end
         when (atype='GZIP' | atype='COMPRESS') & do_gzip=1 then do
            t2=sref_ungzip(t2)
         end /* do */
         otherwise nop             
      end      /* select */
   end          /* transfer encoding options */
end             /* telist not empty */



/* if found CONTENT encodings, see if you can do 'em  */
if Celist<>'' then do
   Celist=translate(Celist,' ',','||'0d0a0900'x)
   do ww=words(Celist) to 1 by -1    /* always do in reverse order of encoding */
      atype=strip(word(Celist,ww))
      select
         when (atype='GZIP' | atype='COMPRESS')  then do
            t2=sref_ungzip(t2)
         end /* do */
         otherwise nop             
      end      /* select */
   end          /* content encoding options */
end             /* celist not empty */

outit:


eek=0
if outfile<>"." then do
  tt=outfile
  if pos(':',outfile)=0 then tt=filter_dir||strip(outfile,,'\')
  foo=sysfiledelete(tt)
  eek=charout(tt,t2,1)
end

if verbose=1 then do 
  if outfile<>"." then
    call sre_pmprintf('     Bytes in response= '||length(t2)||', saved to '||tt)
  else    
    call sre_pmprintf('     Bytes in response= '||length(t2))
end

signal get_next_request

err1:
call sre_pmprintf('Startreq Rexx error 'rc " at line "sigl)
exit

abend:
tim3=time('e')
if gosock<>0 then do
  rc=sockshutdown(gosock,2)
  rc = SockClose(gosock)
  exit
end

/* --- Load the function library, if necessary --- */
load:

saves.0=0


if RxFuncQuery("SockLoadFuncs")=1 then do      /* already there */
  call RxFuncAdd "SockLoadFuncs","rxSock","SockLoadFuncs"
  call SockLoadFuncs
end

/* Load up advanced REXX functions */
foo=rxfuncquery('sysloadfuncs')
if foo=1 then do
  call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  call SysLoadFuncs
end

norexxlib=0
foo=rxfuncquery('rexxlibregister')
if foo=1 then do
 oy=rxfuncadd( 'rexxlibregister','rexxlib', 'rexxlibregister')
 if oy=0 then call rexxlibregister
end
foo=rxfuncquery('inkey')
if foo=1 then  norexxlib=1

signal on syntax name err1 ; signal on error name err1 
return

/* get the hostname (aa.bb.cc) for this machine
   Developed by Timur Kazimirov  */

get_hostname:procedure
if \RxFuncQuery("SockLoadFuncs")
  then
    nop
  else
    do
      call RxFuncAdd "SockLoadFuncs","rxSock","SockLoadFuncs"
      call SockLoadFuncs
    end
dot_addr = SockGetHostId()
rc = SockGetHostByAddr(dot_addr, "host.")
return host.name



/****************/
/* figure out batch mode */
do_batch:

/* concatenate , lines, etc. */
goo2=''
roptions.=''
roptions.0=0
got1=0

do until goo=''
   parse var goo aline '0d0a'x goo ; aline=strip(aline)
   if aline='' & got1=1 then leave
   if aline='' & got1=0 then iterate
   else
   if  abbrev(aline,';')=1 then  iterate
   got1=1
   if abbrev(aline,',')=1 then
      goo2=goo2||subsrt(aline,2)
   else
      goo2=goo2||'0d0a'x||aline
end
do until goo2=''
   parse var goo2 aline '0d0a'x goo2 ; aline=strip(aline)
   if aline='' then iterate
   if abbrev(aline,',')=1 then iterate

   parse var aline atype ':' avalue ; atype=translate(strip(atype))
   atype=strip(translate(atype))
   select
      when atype='REQUEST' then  request=space(avalue,0)

      when atype="REQUEST_OPTION" | atype="OPTION" then do
           nreqopt=roptions.0+1
           roptions.nreqopt=fix_option(strip(avalue),1)
           roptions.0=nreqopt
      end 
      when atype='SERVER' then server=space(avalue,0)
      when atype="HTTP_VER" | atype="VER" then http_ver=space(avalue,0)
      when atype="USE_VERB" | atype="VERB" | atype="METHOD" then use_VERB=space(avalue,0)
      when atype='VERBOSE' then verbose=space(avalue,0)

      when atype="HOST_HEADER" | atype="HOST:" then sshost=space(avalue,0)

      when atype='HEADER' then do
        if opts<>'' then
          opts=opts||strip(avalue)||'0d0a'x
        else
           opts=strip(avalue)||'0d0a'x
      end 
      when atype='OUTFILE' | atype="OUTPUT" then outfile=space(avalue,0)
      when atype='DO_GZIP' then do_gzip=space(avalue,0)
      when atype='SENDCLOSE' then sendclose=space(avalue,0)
      when atype='USERNAME' then username=space(avalue,0)
      when atype='PASSWORD' then password=space(avalue,0)
      otherwise nop
   end
 end /* do */
if server='.' then server=mehost
if username<>'' then do
  upwd=username':'password
  if upwd<>' ' then do
    upwd=space(strip(upwd))
    upwd=mk_base64(translate(upwd,':',' '))
    upwd='Basic 'upwd
  end
end

if roptions.0>0 then do         /* add request options */
   iqadd=0
   if pos('?',request)=0 then do
        request=request||'?'
        iqadd=1
   end
   do mm=1 to roptions.0   
      if iqadd=1 then do
       request=request||roptions.mm
       iqadd=0
      end
      else do
         request=request||'&'||roptions.mm
      end
   end
end 

if got1=1 & verbose=1 then do
   call sre_pmprintf("StartReq request== ")
   call sre_pmprintf("  Server: " server)
   call sre_pmprintf("  Request selector: " request)
   if upwd<>'' then    call sre_pmprintf('  Authorization: 'upwd)
   if opts<>"" then do
     call sre_pmprintf("  Custom headers:")
     ao=opts
     do until ao=''
        parse var opts ali '0d0a'x ao
       call sre_pmprintf("        "ali)
    end
   end
end 

return 1

/* roptions, and goo, are returned */


/************/
/* make an authorization header */
make_auth:

ifoo=0
parse arg r2,USERNAME0,PASSWORD0
/* basic or digest? */
do until r2=''
   parse var r2 a1 '0d0a'x r2 ; a1=strip(a1)
   parse var a1 atype ':' aheader ;atype=strip(atype)
   if translate(atype)<>'WWW-AUTHENTICATE' then iterate
   ifoo=1
   leave
end

if ifoo=0 then return 0



/************/
/* create a base64 packing of a message */
mk_base64:procedure

do mm=0 to 25           /* set base 64 encoding keys */
   a.mm=d2c(65+mm)
end /* do */
do mm=26 to 51
   a.mm=d2c(97+mm-26)
end /* do */
do mm=52 to 61
   a.mm=d2c(48+mm-52)
end /* do */
a.62='+'
a.63='/'

parse arg mess
s2=x2b(c2x(mess))
ith=0
do forever
   ith=ith+1
   a1=substr(s2,1,6,0)
   ms.ith=x2d(b2x(a1))
   if length(s2)<7 then leave
   s2=substr(s2,7)
end /* do */
pint=""
do kk=1 to ith
    oi=ms.kk ; pint=pint||a.oi
end /* do */
j1=length(pint)//4
if j1<>0 then pint=pint||copies('=',4-j1)
return pint



/********************************************/
/*Given client digest auth, form local copy of "response";
 and compare to her "response" */

digest_mkupwd:procedure
parse arg auri,username,passwd,aheader,iqop


realm='' ; nonce=''; ;qop='';opaque=''
do until aheader=''
   parse var aheader a1 ',' aheader
   parse var a1 a1a '=' a1b 
   a1bb=strip(strip(a1b),,'"') ; a1a=strip(upper(a1a))
   select 
      when  a1a='REALM' then realm=a1bb
      when a1a='NONCE' then nonce=a1bb
      when a1a='QOP' & iqop=1 then qop=a1bb
      when a1a='OPAQUE' then opaque=a1bb
      otherwise nop
   end
end /* do */

/* if username, response, uri, nonce, realm ='', then failure */
if username='' | nonce='' | realm='' then do
    call sre_pmprintf('StartReq: Insufficient information; can not create digest style Autorization request ')
    return 0
end /* do */

if abbrev(translate(auri),'HTTP://')=0 then auri='/'strip(auri,'l','/')

username=strip(username); passwd=strip(passwd)

qop=strip(qop)
if pos('AUTH',translate(qop))>0 then do
  cnonce='testhere'
  nc=1
  qop='auth'
end /* do */
else do
  cnonce=''; nc='';qop=''
end

VERB='GET'

/* 1) form h(a1) */
  a1=username':'realm':'passwd
  ha1=lower(sref_md5x(a1))

/* form h(a2) */
  a2='GET:'auri
  ha2=lower(sref_md5x(a2))

/* if no qop */
if translate(qop)<>'AUTH' then do 
    resp1=ha1':'nonce':'ha2
    hresp=sref_md5x(resp1)
end /* do */
else do         /* AUTH */
    resp1=ha1':'nonce':'nc':'cnonce':'qop':'ha2
    hresp=sref_md5x(resp1)
end /* do */

rar='Digest username="'username'", realm="'realm'"'
rar=rar', uri="'auri'", nonce="'nonce'"'
if translate(qop)='AUTH' then do
   rar=rar', qop='qop', cnonce="'cnonce'", nc='nc
end /* do */
rar=rar', response="'hresp'"'

if opaque<>'' then rar=rar', opaque="'opaque'"'


return rar

/*
Authorization: Digest username="Mufasa", realm="testrealm@hopf.math.nwu.edu", ur
i="/testpage/digest/index.html", nonce="86a88f9b4d927b79d9a21c53f0757a3abd", res
ponse="d35edc9327c6149f0c3a6c5a46e84ed8"
Connection: close
*/



/***********/
/* A fully rexx md5 digest computation procedure.
  This is NOT FAST  --  for small strings it is
  toleable (0.15 seconds on a p166 for 50 character strings),
  but for larger strings (or files) it can take many seconds --
  you should instead use a DLL product (such as MD5_OS2) */


/*  ------------------------------ */
sref_md5x:procedure
parse arg stuff

numeric digits 11
lenstuff=length(stuff)

c0=d2c(0)
c1=d2c(128)
c1a=d2c(255)
c1111=c1a||c1a||c1a||c1a
slen=length(stuff)*8
slen512=slen//512

/* pad message to multiple of 512 bits.  Last 2 words are 64 bit # bits in message*/
if slen512=448 then  addme=512
if slen512<448 then addme=448-slen512
if slen512>448 then addme=960-slen512
addwords=addme/8

apad=c1||copies(c0,addwords-1)

xlen=reverse(right(d2c(lenstuff*8),4,c0))||c0||c0||c0||c0  /* 2**32 max bytes in message */

/* NEWSTUFF is the message to be md5'ed */
newstuff=stuff||apad||xlen

/* starting values of registers */
 a ='67452301'x;
 b ='efcdab89'x;
 c ='98badcfe'x;
 d ='10325476'x;

lennews=length(newstuff)/4

/* loop through entire message */
do i1 = 0 to ((lennews/16)-1)
  i16=i1*64
  do j=1 to 16
     j4=((j-1)*4)+1
     jj=i16+j4
     m.j=reverse(substr(newstuff,jj,4))
  end /* do */

/* transform this block of 16 chars to 4 values. Save prior values first */
 aa=a;bb=b;cc=c;dd=d

/* do 4 rounds, 16 operations per round (rounds differ in bit'ing functions */
S11=7
S12=12
S13=17
S14=22
  a=round1( a, b, c, d,   0 , S11, 3614090360); /* 1 */
  d=round1( d, a, b, c,   1 , S12, 3905402710); /* 2 */
  c=round1( c, d, a, b,   2 , S13,  606105819); /* 3 */
  b=round1( b, c, d, a,   3 , S14, 3250441966); /* 4 */
  a=round1( a, b, c, d,   4 , S11, 4118548399); /* 5 */
  d=round1( d, a, b, c,   5 , S12, 1200080426); /* 6 */
  c=round1( c, d, a, b,   6 , S13, 2821735955); /* 7 */
  b=round1( b, c, d, a,   7 , S14, 4249261313); /* 8 */
  a=round1( a, b, c, d,   8 , S11, 1770035416); /* 9 */
  d=round1( d, a, b, c,   9 , S12, 2336552879); /* 10 */
  c=round1( c, d, a, b,  10 , S13, 4294925233); /* 11 */
  b=round1( b, c, d, a,  11 , S14, 2304563134); /* 12 */
  a=round1( a, b, c, d,  12 , S11, 1804603682); /* 13 */
  d=round1( d, a, b, c,  13 , S12, 4254626195); /* 14 */
  c=round1( c, d, a, b,  14 , S13, 2792965006); /* 15 */
  b=round1( b, c, d, a,  15 , S14, 1236535329); /* 16 */

  /* Round 2 */
S21=5
S22=9
S23=14
S24=20
a= round2( a, b, c, d,   1 , S21, 4129170786); /* 17 */
d= round2( d, a, b, c,   6 , S22, 3225465664); /* 18 */
c=  round2( c, d, a, b,  11 , S23,  643717713); /* 19 */
b=  round2( b, c, d, a,   0 , S24, 3921069994); /* 20 */
a=  round2( a, b, c, d,   5 , S21, 3593408605); /* 21 */
d=  round2( d, a, b, c,  10 , S22,   38016083); /* 22 */
c=  round2( c, d, a, b,  15 , S23, 3634488961); /* 23 */
b= round2( b, c, d, a,   4 , S24, 3889429448); /* 24 */
a= round2( a, b, c, d,   9 , S21,  568446438); /* 25 */
d= round2( d, a, b, c,  14 , S22, 3275163606); /* 26 */
c=  round2( c, d, a, b,   3 , S23, 4107603335); /* 27 */
b=  round2( b, c, d, a,   8 , S24, 1163531501); /* 28 */
a=  round2( a, b, c, d,  13 , S21, 2850285829); /* 29 */
d=  round2( d, a, b, c,   2 , S22, 4243563512); /* 30 */
c=  round2( c, d, a, b,   7 , S23, 1735328473); /* 31 */
b= round2( b, c, d, a,  12 , S24, 2368359562); /* 32 */

  /* Round 3 */
S31= 4
S32= 11
S33= 16
S34= 23
a= round3( a, b, c, d,   5 , S31, 4294588738); /* 33 */
d=  round3( d, a, b, c,   8 , S32, 2272392833); /* 34 */
c=  round3( c, d, a, b,  11 , S33, 1839030562); /* 35 */
b=  round3( b, c, d, a,  14 , S34, 4259657740); /* 36 */
a=  round3( a, b, c, d,   1 , S31, 2763975236); /* 37 */
d=  round3( d, a, b, c,   4 , S32, 1272893353); /* 38 */
c=  round3( c, d, a, b,   7 , S33, 4139469664); /* 39 */
b=  round3( b, c, d, a,  10 , S34, 3200236656); /* 40 */
a=  round3( a, b, c, d,  13 , S31,  681279174); /* 41 */
d=  round3( d, a, b, c,   0 , S32, 3936430074); /* 42 */
c=  round3( c, d, a, b,   3 , S33, 3572445317); /* 43 */
b=  round3( b, c, d, a,   6 , S34,   76029189); /* 44 */
a=  round3( a, b, c, d,   9 , S31, 3654602809); /* 45 */
d=  round3( d, a, b, c,  12 , S32, 3873151461); /* 46 */
c=  round3( c, d, a, b,  15 , S33,  530742520); /* 47 */
b=  round3( b, c, d, a,   2 , S34, 3299628645); /* 48 */

  /* Round 4 */
S41=6
S42=10
S43=15
s44=21
a=round4( a, b, c, d,   0 , S41, 4096336452); /* 49 */
d=round4( d, a, b, c,   7 , S42, 1126891415); /* 50 */
c=round4( c, d, a, b,  14 , S43, 2878612391); /* 51 */
b=round4( b, c, d, a,   5 , s44, 4237533241); /* 52 */
a=round4( a, b, c, d,  12 , S41, 1700485571); /* 53 */
d=round4( d, a, b, c,   3 , S42, 2399980690); /* 54 */
c=round4( c, d, a, b,  10 , S43, 4293915773); /* 55 */
b=round4( b, c, d, a,   1 , s44,  2240044497); /* 56 */
a=round4( a, b, c, d,   8 , S41, 1873313359); /* 57 */
d=round4( d, a, b, c,  15 , S42, 4264355552); /* 58 */
c=round4( c, d, a, b,   6 , S43, 2734768916); /* 59 */
b=round4( b, c, d, a,  13 , s44, 1309151649); /* 60 */
a=round4( a, b, c, d,   4 , S41, 4149444226); /* 61 */
d=round4( d, a, b, c,  11 , S42, 3174756917); /* 62 */
c=round4( c, d, a, b,   2 , S43,  718787259); /* 63 */
b=round4( b, c, d, a,   9 , s44, 3951481745); /* 64 */


a=m32add(aa,a) ; b=m32add(bb,b) ; c=m32add(cc,c) ; d=m32add(dd,d)

end

aa=c2x(reverse(a))||c2x(reverse(b))||c2x(reverse(C))||c2x(reverse(D))

return lower(aa)


/* round 1 to 4 functins */

round1:procedure expose m. c1111 c0 c1
parse arg a1,b1,c1,d1,kth,shift,sini
kth=kth+1
t1=c2d(a1)+c2d(f(b1,c1,d1))+ c2d(m.kth) + sini
t1a=right(d2c(t1),4,c0)
t2=rotleft(t1a,shift)
t3=m32add(t2,b1)
return t3

round2:procedure expose m. c1111 c0 c1
parse arg a1,b1,c1,d1,kth,shift,sini
kth=kth+1
t1=c2d(a1)+c2d(g(b1,c1,d1))+ c2d(m.kth) + sini
t1a=right(d2c(t1),4,c0)
t2=rotleft(t1a,shift)
t3=m32add(t2,b1)
return t3

round3:procedure expose m. c1111 c0 c1
parse arg a1,b1,c1,d1,kth,shift,sini
kth=kth+1
t1=c2d(a1)+c2d(h(b1,c1,d1))+ c2d(m.kth) + sini
t1a=right(d2c(t1),4,c0)
t2=rotleft(t1a,shift)
t3=m32add(t2,b1)
return t3

round4:procedure expose m. c1111 c0 c1
parse arg a1,b1,c1,d1,kth,shift,sini
kth=kth+1
t1=c2d(a1)+c2d(i(b1,c1,d1))+ c2d(m.kth) + sini
t1a=right(d2c(t1),4,c0)
t2=rotleft(t1a,shift)
t3=m32add(t2,b1)
return t3

/* add to "char" numbers, modulo 2**32, return as char */
m32add:procedure expose c0 c1 c1111
parse arg v1,v2
t1=c2d(v1)+c2d(v2)
t2=d2c(t1)
t3=right(t2,4,c0)
return t3

/*********** Basic functions */
/* F(x, y, z) == (((x) & (y)) | ((~x) & (z))) */
f:procedure expose c0 c1 c1111 
parse arg x,y,z
t1=bitand(x,y)
notx=bitxor(x,c1111)
t2=bitand(notx,z)
return bitor(t1,t2)


/* G(x, y, z) == (((x) & (z)) | ((y) & (~z)))*/
g:procedure expose c0 c1 c1111
parse arg x,y,z
t1=bitand(x,z)
notz=bitxor(z,c1111)
t2=bitand(y,notz)
return bitor(t1,t2)

/* H(x, y, z) == ((x) ^ (y) ^ (z)) */
h:procedure expose c0 c1 c1111
parse arg x,y,z
t1=bitxor(x,y)
return bitxor(t1,z)

/* I(x, y, z) == ((y) ^ ((x) | (~z))) */
i:procedure expose c0 c1 c1111
parse arg x,y,z
notz=bitxor(z,c1111)
t2=bitor(x,notz)
return bitxor(y,t2)

/* bit rotate to the left by s positions */
rotleft:procedure 
parse arg achar,s
if s=0 then return achar

bits=x2b(c2x(achar))
lb=length(bits)
t1=left(bits,s)
t2=bits||t1
yib=right(t2,lb)
return x2c(b2x(yib))


/***********************************/
/* ungzip a string */
sref_ungzip:procedure 
parse arg astring

awords=rxgzinflatestring(astring)

return awords




/* unchunk a chunked entity.
  a : the chunked entity entire body)
 inct: if 1, add trailers at beginning of entity (trailers crlf entity) 
*/

unchunk:procedure
parse arg a,inct

stuff=''
do forever 
  parse var a a1 '0d0a'x a
  parse var a1 a2 ';' .
  da2=x2d(strip(a2))
  if da2=0 then leave
  stuff=stuff||left(a,da2)
  a=substr(a,da2+3)     /* skip crlf */
end

if inct<>1 then return stuff
trailers=''
do forever
   parse var a t1 '0d0a'x a
   if t1='' then leave
   trailers=trailers||t1||'0d0a'x
end /* do */
return trailers||'0d0a'x||stuff



/************/
/* ADD COMMAS TO A NUMBER */
addcomma:procedure
parse arg aval,ndec
parse var aval p1 '.' p2

if ndec='' then do
   p2=''
end
else do
   p2='.'||left(p2,ndec,'0')
end /* do */

plen=length(p1)
p1new=''
do i=1 to 10000 while plen>3
   p1new=','right(p1,3)||p1new
   p1=delstr(p1,plen-2)
   plen=plen-3
end /* do */

return p1||p1new||p2



/**********/
/* fix an option for inclusion in request string */
fix_option:procedure
parse arg aval,dospace,moreenc

/* characters that must be url encoded: +, & */
charlist.1='+'
charlist.2='&'
charlist.1.0='%2b'
charlist.2.0='%26'
i2=2


/* if moreenc=1, encode more characters: " ! < > */
if moreenc=1 then do
charlist.3='"'
charlist.4='!'
charlist.5='<'
charlist.6='>'
charlist.7='?'
charlist.8='('
charlist.9=')'
charlist.3.0='%22'
charlist.4.0='%21'
charlist.5.0='%3c'
charlist.6.0='%3e'
charlist.7.0='%3f'
charlist.8.0='%28'
charlist.9.0='%29'
i2=9
end

do mm=1 to i2
  achar=charlist.mm
  makeit=aval
  newval=''
  do forever
    jj=pos(achar,makeit)
    if jj=0 then do
        newval=newval||makeit
        leave
    end
    if jj=1 then do
        newval=newval||charlist.mm.0
    end
    else do
         newval=newval||left(makeit,jj-1)||charlist.mm.0
    end
    makeit=substr(makeit,jj+1)
  end           /* forever */
  aval=newval
end
if dospace=1 then aval=translate(aval,'+',' ')
return aval



/*************/
