/* dohead -- head's a resource from an HTTP server                 */
/* ------------------------------------------------------------------- */
/* Call as: dohead [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 */

say " Issue a HEAD 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 ": "
    parse pull server
    if server="" then server=mehost
end  /* Do */
if request="" then  do
  say " Please enter url to HEAD: "
  parse pull request
  say " Enter a (space seperated) USERNAME PASSWORD (ENTER=None):"
  parse pull upwd
  if upwd<>' ' then do
    upwd=space(strip(upwd))
    upwd=mk_base64(translate(upwd,':',' '))
  end
  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 " "
              iterate
      end  /* Do */
      opts=opts||aopt||crlf
  end /* do */
end


family  ='AF_INET'
httpport=80

rc=sockgethostbyname(server, "serv.0")  /* get dotaddress of server */
if rc=0 then do; say 'Unable to resolve "'server'"'; exit; end
dotserver=serv.0addr                    /* .. */

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

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

request=strip(request,'l','/')
message='HEAD /'request' HTTP/1.1'crlf'HOST:'server||crlf

/*Note: uncomment these lines, and changes the "bytes=" ranges,
if you only want a segment(s) of the URL*/
message=message||'Referer:do_head@'||mehost||crlf
if upwd<>' ' then
  message=message||'Authorization: Basic '||upwd||crlf
if opts<>"" then message=message||opts

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)
say t1
say " =--- writing results to dohead.lst "
t2=substr(got,foo+length(findit))
tt='dohead.lst'
foo=sysfiledelete(tt)
eek=charout(tt,t2,1)
say eek

exit

/* --- Load the function library, if necessary --- */
load:
if \RxFuncQuery("SockLoadFuncs") then return      /* already there */
call RxFuncAdd "SockLoadFuncs","rxSock","SockLoadFuncs"
call SockLoadFuncs

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


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


