/* DOGET -- get's a resource from an HTTP server                 */
/* ------------------------------------------------------------------- */
/* Call as: DOGET [serveraddress [requeststring]]                   */
/* ------------------------------------------------------------------- */
/* This program requires that the RxSock.DLL be in your LIBPATH (it is */
/* usually in your \TCPIP\DLL directory.  It was shipped with the      */
/* August 1994 CSD for the TCP/IP base (UN64092).                      */

call load /* load functions if necessary */

httpport=80

say " Issue a GET method request to an HTTP server, and display complete response "
parse arg server request .
mehost=get_hostname()
crlf    ='0d0a'x                        /* constants */
opts="" ;upwd=""



if server="" then do 
    mehost=get_hostname()
    say " Please enter server address (ENTER= " mehost":"httpport')'
    parse pull server
    if server="" then server=mehost
end  /* Do */
parse var server server ':' bport
if bport<>'' then httpport=bport

if request="" then  do
  say " Please enter url to GET: "
  parse pull request
  say " Enter a (space seperated) USERNAME PASSWORD (ENTER=None, DIGEST xx xx):"
  parse pull upwd
  if abbrev(strip(translate(upwd)),'DIGEST')=1  then do
      upwd_hold=upwd ; upwd=''
  end /* do */
  if upwd<>' ' then do
    upwd=space(strip(upwd))
    upwd=mk_base64(translate(upwd,':',' '))
    upwd='Basic 'upwd
  end
  call charout, 'Enter 1 to NOT send a "Connection: Close" header: '
  pull sendclose
  say
  say " Enter optional request headers (?=examples, ENTER=no more)"
  opts=""
  aopt=0
  do until aopt=""
      call charout," : "
      parse pull aopt
      aopt=strip(aopt)
      if aopt="" then leave
      if aopt="?" then do
              say " Examples: "
              say "    Connection:keep-alive"
              say "    Range:bytes=0-50,200-400"
              say " "
              say " or, to load in a file containing request headers: "
              say "     FILE=filename.ext "
              say
              iterate
      end  /* Do */
      if abbrev(translate(aopt),'FILE=')=1 then do
           parse var aopt . '=' afil
           goo=charin(afil,1,chars(afil)); foo=stream(afil,'c','close')
           opts=opts||goo
      end /* do */
      else do
        opts=opts||aopt||crlf
      end
  end /* do */
end

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

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; say 'Unable to resolve "'server'"'; exit; end
dotserver=serv.0addr                    /* .. */
say " dotserver " dotserver

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

setup1:

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

message='GET 'request ' HTTP/1.1'crlf'HOST:'server||crlf

message=message||'Referer:do_get@'||mehost||crlf
if upwd<>' ' then
  message=message||'Authorization: '||upwd||crlf
if opts<>"" then message=message||opts
if sendclose<>1 then message=message||'Connection: close' crlf
message=message||crlf
say message


got=''
rc = SockConnect(gosock,"gosaddr.0")
if rc<0 then do; say 'Unable to connect to "'server'"'; exit; end
rc = SockSend(gosock, message)
say " rc " rc
/* Now wait for the response */
do r=1 by 1
  rc = SockRecv(gosock, "response", 1000)
  got=got||response
/*say length(got)*/
  /* say '>'rc'>' response */
  if rc<=0 then leave
  end r
rc = SockClose(gosock)

say 'Got' length(got) 'bytes of response:'

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

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

call charout,'  Unauthorized: enter 1 to retry with (new) password?'
parse pull goo1
if goo1<>1 then signal writeit

parse var upwd_hold gg username password
upwd=make_auth(t2,username,password)
if upwd<>0 then signal setup1

writeit:                        /* jump here to write stuff */
say t1
/* see if chunked */
ischunked=0
do until t1=""
    parse var t1 aa '0d0a'x t1
    parse  upper var t1  a1a ':' a1b
    if a1a='TRANSFER-ENCODING' & pos('CHUNKED',a1b)>0 then do
         ischunked=1
         leave
    end /* do */
end /* do */

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

if ischunked=1 then do
   say " Chunked response -- will unchunk "
   t2=sref_unchunk(t2)
end

tt='doget.lst'
foo=sysfiledelete(tt)
eek=charout(tt,t2,1)
if eek<>0 then 
   say "Error writing to doget.lst: "eek
else
    say " =--- results written to doget.lst "

exit

/* --- Load the function library, if necessary --- */
load:
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


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


/************/
/* 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

/*else-- parse r2 and create digest style request header */
    call charout,' Username (enter='username0'):'
    parse pull username
    if username='' then username=username0
    
    call charout,' Password (enter='password0'):'
    parse pull passwd
    if passwd='' then passwd=password0

    parse var aheader atype aheader
    atype=strip(translate(atype))
    if atype='BASIC' then do
       upwd=mk_base64(strip(username)':'strip(passwd))
       upwd='Basic 'upwd
       return upwd
    end /* do */

    call charout," Qop response (1=yes): "
     parse pull iqop
    upwd=digest_mkupwd(request,username,passwd,aheader,iqop)
    if upwd=0 then return 0
    return upwd   


/************/
/* 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
    say '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))




