OS/2 Shareware BBS: 35 Internet/35-Internet.zip/srev13h.zip/doget.cmd

OS/2 REXX Batch file | 2001-05-29 | 49KB | 1,689 lines

/* DOGET -- GET's a resource from an HTTP server
   Call as: DOGET serveraddress requeststring
   or DOGET, and program will prompt you for information

Note: this looks better if you have ANSI.SYS installed as a device
driver (i.e.; when your config.sys file contains
DEVICE=x:\os2\mdos\ansi.sys, where x: is where OS/2 is installed)

*/

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

/*BEGINUSER*/

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

/* set to 1 to enable diff "diff decoding".  This REQUIRES
   that gnu patch, diff, and ed be installed on you machine;
   or that the SRE-http GDIFF utility be installed */
allow_delta=1

/* Set to 1 to issue HEAD, instead of GET, requests */
as_head=0

/* Set to 1 to pretend to be http/1.0 */
as_http10=0

/* set this to the "delta cache files" directory (not strictly
  necessary, but it does help with a delta-encoding option) */
deltas_dir='temp\deltas'

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


/* the output file -- the contents of a response are written here
   (a prior version of the file will be overwritten)  */
outfile='doget.lst'

/* Display options:
   0 = extract and display response headers, and try and do several
       encodings. Write (possibly decoded) request body to outfile
   1 = write everything (headers and content), without decoding, to outfile
   2 = same as 1, but display response headers on screen
   3 = same as 2, but also write request (line and headers) to out file  */
out_literal=0


/* Number of blocks to use when creating rsync-signature request header.
   More blocks means longer request header, but more chances of a match
   45 yields about a 500 byte header, which is pushing acceptable
   limits. Rsync_blocks must be  between 10 and 255  */
rsync_blocks=45

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

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

call load /* load functions if necessary */
signal on error name err1 ; signal on syntax name err1
signal on halt name abend

call checkansi  /* ansi screen stuff */

deltas_dir=strip(deltas_dir,'t','\')
httpport=80
sendclose=1
gosock=0

parse arg server request mode viewit rsyncarg .

parse source somewhere
parse var somewhere . . somewhere . ; somewhere=strip(somewhere)

if server='?' then do
  call show_intro
  exit
end

say "      "cy_ye" GET an http resource. "normal" (DOGET ? for the details ...)";say " "

mehost=get_hostname()
crlf    ='0d0a'x                        /* constants */
opts="" ;upwd=""
ietags=0 ;etaglist='' ; efilelist=''
out_literal=0
oldverfile=''
batchmode=0
if mode<>'' then out_literal=mode

if request='' & pos('.',server)>0 then do   /* batch mode */
   call do_batch
   batch_mode=1
end


if server="" then do
    mehost=get_hostname()
    say " Please enter server address (ENTER= " mehost":"httpport')'
    call charout,"    "cy_ye":"normal" "

    parse pull server
    if server="" then server=mehost
end  /* Do */
parse var server server ':' bport
if bport<>'' then httpport=bport

if request="" then  do
  cmd_mode=0
  say " Enter resource (on "server") to GET: "
  call charout,"    "cy_ye":"normal" "
  parse pull request

  getmore=yesno('Select more options ','No Few_more Many_more','N')
  if getmore>0 then
       call do_getmore getmore

end

else do                 /* request is on command line */
  if batchmode=0 then do
   cmd_mode=1
   iss=stream('doget.hdr','c','query size')
   if iss<>0 & iss<>'' then do
         afil='doget.hdr'
         goo=charin(afil,1,iss); foo=stream(afil,'c','close')
         say "Note: using request headers specified in "afil
         opts=opts||goo
   end
  end
end /* do */


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 'ERROR: Unable to resolve "'server'"'; exit; end
dotserver=serv.0addr                    /* .. */
say
say cy_ye"Request sent to: "normal||"  "||reverse||dotserver||normal ;say " "

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'
if as_head=1 then gethead='HEAD'
httpis='HTTP/1.1'
if as_http10=1 then httpis='HTTP/1.0'
message=gethead' 'request' 'httpis||crlf'HOST:'server||crlf

message=message||'Referer:do_get@'||mehost||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 message=message||'Connection: close' crlf

if rsyncarg<>'' then do
   oldverfile=rsyncarg ; enable_rsync=1
   if pos('\',oldverfile)=0 then do
           oldverfile=deltas_dir'\'||strip(oldverfile)
   end /* do */
   if stream(oldverfile,'c','query exists')='' then do
      say " ... Problem: no such file (for rsync): "oldverfile
      enable_rsync=0
   end /* do */
   else do
      say " ... computing rsync synopsis for: "oldverfile
   end
end /* do */
if enable_rsync=1  then do
   aa=rsync_synopsis(oldverfile,rsync_blocks)
   say " ... Rsync-signature request header is "||length(aa)||" bytes long"
   message=message||'Rsync-signature: 'aa||crlf
end /* do */

message=message||crlf
say bold"Request message: "normal
say message

rc = SockConnect(gosock,"gosaddr.0")
if rc<0 then do; say 'ERROR: Unable to connect to "'server'"'; exit; end
rc = SockSend(gosock, message)
say bold' ...  request length = 'normal||rc " bytes "
/* 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 verbose=1 then say " ... :" runlen
  if rs=1 then say " ... got first "rc " bytes of the response "
  if rc<=0 then leave
end

rc = SockClose(gosock)

tim3=time('e')
say  ' ... response complete. Got' runlen 'bytes.'

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)

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

goo1=yesno('  Unauthorized: retry with (new) password')
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 */

if out_literal>=2  then do
   say
   say cy_ye||"The response line, and response headers: "normal;say " "
   say t1
   if out_literal=2 then
      t2=got
   else
      t2=message||got
   signal outit
end

if out_literal=1 then do             /* save response verbatim */
  t2=got
  signal outit
end

say
say cy_ye"The response line, and response headers: "normal;say " "
say t1

/* see if any transfer encodings to do */
telist='';CELIST=''
deltabase='';crange=''
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='DELTA-BASE' then deltabase=strip(strip(a1b),,'"')
    if a1a='CONTENT-RANGE' then crange=strip(strip(a1b),,'"')
end
t2=substr(got,foo+length(findit))

/* if found transfer encodings, see if you can do 'em
(you can always do chunk) */
if telist<>'' & out_literal=0 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
           say " "
           say " Chunked response -- "reverse"will unchunk "normal
           t2=unchunk(t2)
         end
         when (atype='GZIP' | atype='COMPRESS') & do_gzip=1 then do
            say " "
            say " GZIP transfer-encoded response -- "reverse"will decompress "normal
            t2=sref_ungzip(t2)
         end /* do */
         when (atype="DIFF-E" | atype="DIFFE") & allow_delta>0   then do
            if  crange<>' ' then do
                 say
                 say "Range encountered, DIFF-e delta transfer decoding will "bold"not"normal" be attempted "
                iterate
            end /* do */
            ikk=wordpos(deltabase,etaglist)
            if ikk=0 then
                useafile=deltas_dir'\'strip(deltabase)         /* the default */
            else
                useafile=strip(word(efilelist,ikk))
            say  " "
            say " diff-e transfer-encoded response -- "reverse"will undiff"normal
            t2=sref_undiff(useafile,t2)
         end
         when (atype="GDIFF") & allow_delta>0   then do
            if  crange<>' ' then do
                 say
                 say "Range encountered, GDIFF delta transfer decoding will "bold"not"normal" be attempted "
                iterate
            end /* do */
            ikk=wordpos(deltabase,etaglist)
            if ikk=0 then
                useafile=deltas_dir'\'strip(deltabase)         /* the default */
            else
                useafile=strip(word(efilelist,ikk))
            say  " "
            say " gdiff transfer-encoded response -- "reverse"will undiff"normal
            t2=sref_ungdiff(useafile,t2)
         end

         otherwise nop
      end      /* select */
   end          /* transfer encoding options */
end             /* telist not empty */


/* if found CONTENT encodings, see if you can do 'em  */
if Celist<>'' & out_literal=0 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') & strip(do_gzip)=1 then do
            say " "
            say " GZIP content-encoding -- "reverse"will decompress "normal
            t2=sref_ungzip(t2)
         end /* do */
         when (atype="DIFF-E" | atype="DIFFE") & allow_delta>0   then do
            if  crange<>' ' then do
                 say
                 say "Range encountered, "bold"unDIFF"normal" of delta content encoding  will "bold"not"normal" be attempted "
                iterate
            end /* do */
            else do
               ikk=wordpos(deltabase,etaglist)
               if ikk=0 then
                  useafile=deltas_dir'\'strip(deltabase)         /* the default */
               else
                  useafile=strip(word(efilelist,ikk))
               say  " "
               say " diff-e  content-encoding -- "reverse"will undiff"normal
               t2=sref_undiff(useafile,t2)
            end
         end
         when atype='GDIFF'   & allow_delta>0 then do       /* gdiff */
            ikk=wordpos(deltabase,etaglist)
            if ikk=0 then
                useafile=deltas_dir'\'strip(deltabase)         /* the default */
            else
                useafile=strip(word(efilelist,ikk))
            if oldverfile<>'' then useafile=oldverfile
            say  " "
            say " gdiff content-encoded response -- "reverse"will undiff"normal
            t2=sref_ungdiff(useafile,t2)
         end
         otherwise nop
      end      /* select */
   end          /* content encoding options */
end             /* celist not empty */

outit:
if outfile='' then do
   say "Done (results NOT saved) "

   exit 0
end

tt=outfile
foo=sysfiledelete(tt)
eek=charout(tt,t2,1)

say " "
d1=strip(tim2-tim1,'t',0) ; d2=strip(tim3-tim2,'t',0)
amm=cy_ye"Elapsed time: "normal||bold||d1||normal "to establish connection. "bold||d2||normal " duration"
say amm

if eek<>0 then do
   say "Error: unable to write response to "outfile ": "eek
end
else do
   if out_literal<>0 then
        say "Entire response ("||length(t2)||" bytes in headers, body etc.) written to "bold||outfile||normal
   else
       say "A "||length(t2)||" byte response was written to "bold||outfile||normal
end

d1=strip(tim2-tim1,,'0') ; d2=strip(tim3-tim2,,'0')
if viewer<>'' & ( cmd_mode=0 | viewit=1) then do
    aa=1
    if viewit<>1 then do
       aa=yesno(normal"  "bold"View the response (using "reverse||viewer||normal") ",,'N')
    end
   if aa=1 then do
      if viewer_not_pm=1 then
         arf='@START /f /c "'||strip(outfile)||' == DoGET request for '||strip(left(server' 'request,60))||'" 'viewer' 'outfile
      else
         arf='@START /f  "'||strip(outfile)||' == DoGET request for '||strip(left(server' 'request,60))||'" 'viewer' 'outfile
       address cmd arf
   end /* do */
end


exit 0

err1:
say "Rexx error "rc " at line "sigl
exit

abend:
tim3=time('e')
if gosock<>0 then do
  say "Closing socket "gosock
  rc=sockshutdown(gosock,2)
  rc = SockClose(gosock)
  dumpit=yesno('Write 'runlen' recieved bytes?')
  if dumpit=1 then do
     t2=''
     do mm=1 to rs
        t2=t2||gots.mm
     end
     drop gots.
     signal outit
  end
  exit
end

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

signal on error name err2 ; signal on syntax name err2
enable_rsync2=1
if rxfuncquery('rx_md4')=1  then do
    aa=RXFuncAdd( 'RXRsyncLoad', 'RXRSYNC', 'RxRsyncLoad')
    if aa=0 then call RxRsyncLoad
    if rxfuncquery('rx_md4')=1  then  enable_rsync2=0
end
signal on syntax name err1 ; signal on error name err1
return
err2:
enable_rsync2=0
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:

dopause=0
afil=strip(server)
iss=stream(afil,'c','query size')
if iss=0 | iss='' then do
   say 'Sorry, could not find 'afil
   exit
end
goo=charin(afil,1,iss); foo=stream(afil,'c','close')

/* concatenate , lines, etc. */
goo2=''
do until goo=''
   parse var goo aline '0d0a'x goo ; aline=strip(aline)
   if aline='' then iterate
   if  abbrev(aline,';')=1 then  iterate
   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='SERVER' then server=space(avalue,0)
      when atype='MODE' then out_literal=space(avalue,0)
      when atype='VIEW' then viewit=space(avalue,0)
      when atype='PAUSE' then dopause=space(avalue,0)
      when atype='RSYNCFILE' then rsyncarg=space(avalue,0)
      when atype='HEADER' then do
        if opts<>'' then
          opts=opts||strip(avalue)||'0d0a'x
        else
           opts=strip(avalue)||'0d0a'x
      end /* do */
      when atype='OUTFILE' 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 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 dopause=1 then do
say cy_ye"Your request: "normal
   say "Server: " server
   say "Request selector: " request
   if upwd<>'' then say 'Authorization: 'upwd
   say reverse"Custom headers:"normal
   ao=opts
   do until ao=''
      parse var opts ali '0d0a'x ao
      say "    "ali
  end
end
say
call charout,"hit any key to continue .... "
foo=sysgetkey('noecho')
say
batchmode=1
return 1




return 1

/****************/
show_intro:
say clear_screen
say cy_ye"DOGET"normal" will issue a GET method request to an HTTP server, and will:"
say "  "bold"*"normal" display the response header "
say "  "bold"*"normal" save the  response to: "outfile
say bold"Features include:"
say "  "bold"*"normal" You can include authorization info (username and password) --"
say "    "bold"basic"normal" and "bold"digest"normal" authentication are supported"
say "  "bold"*"normal" The ability to include custom request headers "
say "  "bold"*"normal" http/1.1 capabilities include unchunking, GZIP decompression, and"
say "    delta-encoding undifferencing"
say bold"Usage:"normal

say " Command line mode: "bold"DOGET"normal" "reverse"server"normal" "reverse" request"normal" ["normal" "reverse"output_mode "normal" "reverse"viewit "normal" "reverse"rsync_base"normal" ]"
say "   "cy_ye"Notes:"normal" * The contents of DOGET.HDR are used as extra request headers"
say "          * The "reverse"output_mode"normal", "reverse"viewit"normal", and "reverse"rsync_base"normal" parameters are optional."
say "          * "reverse"output_mode"normal" overrides the default (set in DOGET.CMD)"
say "          * "reverse"viewit"normal", if 1, display results w/ viewer program (set in DOGET.CMD) "
say "          * "reverse"rsync_base"normal" is a filename used to create an rsync-signature header "
say "          * Example: "bold"D:>doget  www.foobar.net   /sports/index.html"normal
say " Batch mode:  "bold"DOGET"normal" "reverse"filename.ext"normal
say '          * FILENAME.EXT should be the name of a 'bold'DOGET'normal' batch file.'
say '          * DOGET batch files contain server:, request:, and header: entries'
say " Interactive mode: just enter "bold"DOGET"normal" at an OS/2 prompt, and answer away..."
say


do forever
  say
  vuparams=yesno("More info",'No Parameters BatchInfo','N')
  if vuparams=0 then exit
  if vuparams=1 then call do_vuparams
  if vuparams=2 then call do_batchdoc
end

exit

/**************************/
do_batchdoc:

say
say "The "bold"DOGET"normal" BATCH mode files can contain the following entries:"
say bold"   Request: "normal' the request "selector". '
say bold'    Server: 'normal' IP name/number of the server. www.mysite.org'
say bold'      Mode: 'normal' What to write (0=response content, 1=response headers & content,'
say     '                       2=request, response headers & content'
say bold"      View: "normal' If View: 1, then display response (using 'reverse||viewer||normal
say bold"    Header: "normal' A header to add. You can have as many Header:  entries as needed.'
say     '             Example: 'bold' Header: X-relevance: few 'normal
say bold" RsyncFile: "normal' A file to use to construct an rsync-synopsis'
/*say bold"     Delta: "normal' A file to use to construct delta encoding' */
say bold"   Outfile: "normal' Name of the output file'
say bold"   Do_GZIP: "normal' If 1,then attempt to unGZIP (if GZIP content/transfer encoding'
say bold" SendClose: "normal' If 1, then immediately close the connection'
say bold"  UserName: "normal' Your username '
say bold"  PassWord: "normal' Your password '
say bold"     Pause: "normal' Pause before connecting to the server '

      call charout,reverse||"hit any key to continue"||normal
      getmore=sysgetkey('echo');say

say
say bold"Notes:"normal
say bold"  * "normal"Entries have the format:"bold" name: value "normal
say bold"  * "normal"One entry per line "
say bold"  * "normal"A ! as a first character means this is a continuation line."
say bold"  * "normal'For several parameters, such as Do_Gzip, default entries can be'
say '    set in the user-configurable parameters section of DOGET.CMD'

say
say bold" Example: "normal
say '         request: samples/dir.doc'
say '         server: www.mysite.org'
say '         header: x-wow: abc'
say '         Username: joey'
say '         header: x-home: Maryland'
say '         password: skeezik'
say '         outfile: d:\results\ver1.lst'
say '         pause: 1'

      call charout,reverse||"hit any key to continue"||normal
      getmore=sysgetkey('echo');say
return 0

/**************************/
do_vuparams:

foo=stream(somewhere,'c','open read')
if abbrev(strip(translate(foo)),'READY')=0 then do
   say "Sorry, can not read "somewhere
   exit
end
jsz=stream(somewhere,'c','query size')
if jsz=0 | jsz='' then do
   say "Sorry, can not read "somewhere
   exit
end
aa=charin(somewhere,1,jsz)
foo=stream(somewhere,'c','close')
parse var  aa . '/*BEGINUSER*/' stuff '/*ENDUSER*/' .

ii=0
commenton=0
do until stuff=''
   c2=0
   parse var stuff aline '0d0a'x stuff
   if pos('/*',aline)>0 then do
        parse var aline . '/*' aline ; aline='* 'aline
        commenton=1
   end
   if pos('*/',aline)>0 then do
        parse var aline aline '*/' .
        c2=1
   end
   if commenton=0 then
      say bold||aline||normal
   else
     say aline
   ii=ii+1
   if ii=20 then do
      aa=yesno("continue ....",,'Y')
      if aa=0 then return 1
      ii=0
   end
   if c2=1 then commenton=0
end
return 1

/**************/
/* ask user for a variety of other fields */
do_getmore:
parse arg getmore
 say
  say " Enter a (space seperated) USERNAME PASSWORD (ENTER=None, DIGEST xx xx):"
   call charout,"    "cy_ye":"normal" "

  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

  say
  say " Enter optional request headers (?=examples, ENTER=no more)"
  aopt=0
  do until aopt=""
      call charout,"    "cy_ye":"normal" "

      parse pull aopt
      aopt=strip(aopt)
      if aopt="" then leave
      if aopt="?" then do
              say " "bold"Examples:"normal
              say "    Connection:keep-alive"
              say "    Range:bytes=0-50,200-400"
              say " "
              say " "bold"or"normal", 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 */

if getmore<>2 then return 1

  sendclose=yesno(' Send a "Connection: Close" header ',,'Y')

  as_head=yesno(' Issue HEAD request (instead of GET) ',,'N')


  say "Output file (ENTER="reverse||outfile||normal"):"
  call charout,"    "cy_ye":"normal" "

  parse pull outfile1
  if outfile1<>"" then outfile=outfile1



  out_literal=yesno('Write to output file','Response Hdr&Response Everything','R')
  select
     when out_literal=1 then out_literal=2
     when out_literal=2 then out_literal=3
     otherwise nop
 end

  if out_literal=0 then do
     do_gzip=yesno('unGZIP, when GZIP is a Transfer or Content Encoding',,'Y')
   end


  if allow_delta>0 then do
    say ""
    allow_delta=yesno(normal||"  "||bold||"Send delta-encoding info"normal,,'N')
  end

  if allow_delta>0 then do              /* ask for etag file */
     say "   "bold"?"normal" for examples, "bold"ENTER"normal" when done, "bold"?DIR"normal" for a directory:"
     do forever
       call charout,"    "cy_ye":"normal" "

       parse pull infile ; infile=strip(infile)
       if infile='' then leave

       if infile="?" then do
               say
              say "Enter the etag, and (optionally) a cache-filename, of a "bold"cached"normal" response"
              say "  "bold"Examples: "normal
              say "    67_136FD_F99.2  "
              say "    oba36  e:\temps\cas33.32a "
              say
              say "  "bold"Notes:"normal||reverse"*"normal" if no file is entered, a file (in the "bold"default cache directory"normal")"
              say "          with the same name will be used (if it exists) "
              call charout, "        "reverse"*"normal" the "bold"default cache directory"normal" is: "
              if length(deltas_dir)>40 then do
                      say; say deltas_dir
              end /* do */
              else do
                 say deltas_dir
              end /* do */
              say "     "
              say " "
              iterate
       end  /* Do */

      if abbrev(translate(infile),'?DIR')=1 then do
           call get_dir
           iterate
      end
      parse var infile anetag anfile
      if anfile='' then anfile=anetag
      if pos('\',anfile)=0 then do
           anfile=deltas_dir'\'||strip(anfile)
      end /* do */
      dogr=stream(anfile,'c','query exists')
      if dogr='' then do
            say "  "bold"Error"normal": no such delta file:"anfile','
            iterate
      end /* do */
      ietags=ietags+1
      etaglist=etaglist' 'anetag
      efilelist=efilelist' 'dogr
   end          /*keep getting files */
   say "# of "bold"etag / file "normal" entries is "ietags

   if ietags>0 then do
       opts=opts||'If-none-match:"'||strip(word(etaglist,1))||'"'
       do mm=2 to ietags
          opts=opts||',"'||strip(word(etaglist,mm))||'"'
       end /* do */
       opts=opts||crlf||'TE: diff-e'||crlf
   end

 end                    /* allow delta */



  if enable_rsync2=1 then do
    enable_rsync=yesno('Include an Rsync-signature header',,'N')
    if enable_rsync=1 then do
       do forever
         say '    Enter name of "old version" file (?DIR =display directory, .=Quit):'
         call charout,bold '     ? 'normal ; pull oldverfile
         if oldverfile='.' then do
                enable_rsync=0; leave
         end /* do */
         if oldverfile='?DIR' then do
             call get_dir
             iterate
         end
         if pos('\',oldverfile)=0 then do
             oldverfile=deltas_dir'\'||strip(oldverfile)
         end /* do */

         if  stream(oldverfile,'c','query exists')='' then iterate
         leave
       end
    end
  end

return 1


/************/
get_dir:

       parse var infile . thisdir

      if thisdir="" then do
           if deltas_dir='' & deltas_dir<>0 then do
               thisdir=strip(directory(),'t','\')||'\*.*'
           end
           else do
               thisdir=deltas_dir||'\*.*'
           end /* do */
       end
       say
       say reverse ' List of files in: ' normal bold thisdir normal
       do while queued()>0
            pull .
       end /* do */
       toget=thisdir

       '@DIR /b  '||toget||' | rxqueue'
       foo=show_dir_queue('*')
       say
       infile=''
return 1

/************/
/* 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,'  'bold'Username'normal' (enter='username0'):'
    parse pull username
    if username='' then username=username0

    call charout,' 'bold'Password'normal' (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)
say " Upwd after dig " upwd
    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="[e-mail]", 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))

 /* function: Check if ANSI is activated                               */
 /*                                                                    */
 /* returns:  1 - ANSI support detected                                */
 /*           0 - no ANSI support available                            */
 /*          -1 - error detecting ansi                                 */
 CheckAnsi:
   thisRC = -1

   trace off
                         /* install a local error handler              */
   SIGNAL ON ERROR Name InitAnsiEnd

   "@ANSI 2>NUL | rxqueue 2>NUL"

   thisRC = 0

   do while queued() <> 0
     queueLine = lineIN( "QUEUE:" )
     if pos( " on.", queueLine ) <> 0 | ,                       /* USA */
        pos( " (ON).", queueLine ) <> 0 then                    /* GER */
       thisRC = 1
   end /* do while queued() <> 0 */

 InitAnsiEnd:
 signal off error

if thisrc=1 then do
  aesc='1B'x
  cy_ye=aesc||'[37;46;m'
  cyanon=cy_ye
  normal=aesc||'[0;m'
  bold=aesc||'[1;m'
  re_wh=aesc||'[31;47;m'
  reverse=aesc||'[7;m'
  clear_screen=aesc||'[2J'
end
else do
  cy_ye="" ; normal="" ; bold="" ;re_wh="" ;clear_screen=''
  reverse=""
end  /* Do */



 RETURN 1




/*********/
/* show stuff in queue as a list */
show_dir_queue:procedure expose qlist. bold cy_ye normal reverse
parse arg lookfor
    ibs=0 ;mxlen=0
    if lookfor<>1 then
       nq=queued()
     else
        nq=qlist.0
    do ii=1 to nq
       if lookfor=1 then do
          aa=qlist.ii
          ii2=lastpos('\',aa) ; anam=substr(aa,ii2+1)
       end /* do */
       else do
          parse pull aa
          if pos(lookfor,aa)=0 & lookfor<>'*' then iterate
          parse var aa anam (lookfor) .
          if strip(anam)='.' | strip(anam)='..' then iterate
       end
       ibs=ibs+1
       blist.ibs=anam
       mxlen=max(length(anam),mxlen)
    end /* do */
arf=""
isaid=0
do il=1 to ibs
   anam=blist.il
   arf=arf||left(anam,mxlen+2)
   if length(arf)+mxlen+2>78  then do
        say arf
        isaid=(1+isaid)//22
        if isaid==0 then do
            say cy_YE " ... hit any key to continue, X to exit " NORMAL
            foo=translate(sysgetkey('noecho'))
            if foo='X' then do
                arf='' ; leave
            end /* do */
        end
        arf=""
   end /* do */
end /* do */
if length(arf)>1 then say arf
say
return 1


/***********************************/
/* ungzip a string */
sref_ungzip:procedure
parse arg astring
atid='DOGET'
tmpd=value('TEMP',,'os2environment')
tmpf=systempfilename(tmpd'\'||atid||'???.')
tmpfgz=tmpf||'GZ'
if stream(tmpfgz,'c','query exists')<>'' then foo=sysfiledelete(tmpfgz)
wow=charout(tmpfgz,astring,1)
wow=stream(tmpfgz,'c','close')
address cmd '@gzip  -d  ' tmpfgz
if rc=0 then
   awords=charin(tmpf,1,dosdir(tmpf,'s'))
else
   awords=''
foo=sysfiledelete(tmpfgz)
foo=sysfiledelete(tmpf)
return awords


/*******************************************/
rsync_synopsis:procedure

parse arg afile,nblocks

if nblocks='' then nblocks=45
if datatype(nblocks)<>'NUM' then nblocks=45
if nblocks<10 | nblocks>255 then nblocks=45   /* 255 limit on # of blocks */

if afile='' then return "ERROR no old-version file specified"

/* read "Afile" */
aa=translate(stream(afile,'c','open read'))
if  abbrev(aa,'READY')=0 then return "ERROR could not open "afile
isize=stream(afile,'c','query size')
if isize='' | isize=0 then do
    return 'ERROR 'afile " is unaccessible"
    exit
end
astuff=charin(afile,1,isize)
aa=stream(afile,'c','close')


blocksize=trunc(0.9999 + (isize/nblocks))
if blocksize<200 then do
    blocksize=200
    nblocks=trunc((isize/blocksize)+0.999)
end /* do */
ac1=d2c(blocksize)
ac1=right(ac1,4,x2c('00'))
ac1=ac1||d2c(nblocks)
iat=1
do mm=1 to nblocks
  if mm=nblocks then
     ablock=substr(astuff,iat)
  else
     ablock=substr(astuff,iat,blocksize)
  ac0=left(x2c(rx_rsync32_md4(ablock)),8)
  ac1=ac1||ac0
  iat=iat+blocksize
end
ac1=mkpack64(ac1)

return ac1


/***********************************/
/* ungdiff: given a base file and gdiff-formatted difference file
   (as may be returned in a delta encoded response)output from gdiff-e (against this same
   base file) */

sref_ungdiff:procedure
parse arg basefile,adiff

atid='DOGET'
tmpd=value('TEMP',,'os2environment')
tmpf=systempfilename(tmpd'\'||atid||'???.')
tmpfdif=tmpf||'DIF'
tmpfout=tmpf||'DOU'

if stream(tmpfdif,'c','query exists')<>'' then foo=sysfiledelete(tmpfdif)
if stream(tmpfout,'c','query exists')<>'' then foo=sysfiledelete(tmpfout)

wow=charout(tmpfdif,adiff,1)
wow=stream(tmpfdif,'c','close')
goo= '@gdiff -u -q 'basefile' 'tmpfdif' 'tmpfout
address cmd goo

if rc=0 then do
   iii=stream(tmpfout,'c','query size')
   if iii='' | iii=0 then
        awords=""     /* error */
   else
       awords=charin(tmpfout,1,iii)
end
else do
   awords=''
end

foo=sysfiledelete(tmpfout)
foo=sysfiledelete(tmpfdif)

return awords

/***********************************/
/* undiff: given a basen file and output from diff-e (against this same
   base file) */

sref_undiff:procedure
parse arg basefile,adiff

atid='DOGET'
tmpd=value('TEMP',,'os2environment')
tmpf=systempfilename(tmpd'\'||atid||'???.')
tmpfdif=tmpf||'DIF'
tmpfout=tmpf||'DOU'

if stream(tmpfdif,'c','query exists')<>'' then foo=sysfiledelete(tmpfdif)
if stream(tmpfout,'c','query exists')<>'' then foo=sysfiledelete(tmpfout)

wow=charout(tmpfdif,adiff,1)
wow=stream(tmpfdif,'c','close')
goo= '@patch -s -e -o 'tmpfout' 'basefile' < 'tmpfdif
address cmd goo

if rc=0 then do
   iii=stream(tmpfout,'c','query size')
   if iii='' | iii=0 then
        awords=""     /* error */
   else
       awords=charin(tmpfout,1,iii)
end
else do
   awords=''
end


foo=sysfiledelete(tmpfout)
foo=sysfiledelete(tmpfdif)

return awords
/**********************/
mkPACK64:procedure
parse arg mess

biga=xrange('A','Z')||xrange('a','z')||xrange('0','9')||'+/'

s2=x2b(c2x(mess))

nith=trunc((length(s2)/6)+.9)
cont=copies(' ',nith)
oof=""
do mm=0 to 63
      oof=oof||x2c(b2x(right('00'||x2b(d2x(mm)),6)))
end /* do */
do ith=1 to nith
  a1=substr(s2,(ith*6)-5,6,0)
  cont=overlay(x2c(b2x(a1)),cont,ith)
end /* do */
pint=""
pint=translate(cont,biga,oof)
j1=length(pint)//4
if j1<>0 then pint=pint||copies('=',4-j1)
return pint


/* -------------------- */
/* choose between 3 alternatives (by default,a yes or no ),
return 1 if yes (or 0,1,2 for chosen altenative ) */

yesno:procedure expose normal reverse bold cy_ye     mm0a listfile
parse arg amessage , altans,def,arrowok
ony2:
aynn=' '
if def='' then
 defans=''
else
 defans=translate(left(strip(def),1))
if altans='' then altans='No Yes'

w.0=words(altans)
goo=aynn
do iw0=1 to w.0
     w.iw0=strip(word(altans,iw0))
     a.iw0=translate(left(w.iw0,1))
     aa.iw0=substr(w.iw0,2)
     aynn=aynn||bold
     if  a.iw0=defans then aynn=aynn||cy_ye
     aynn=aynn||a.iw0||normal||aa.iw0
     goo=goo||a.iw0||aa.iw0
     if iw0<w.0 then do
       aynn=aynn'  '
       goo=goo||'  '
     end
end
if arrowok=1 then aynn=aynn||' [UP]'

do forever
 foo1=normal||reverse||amessage||'? '||normal||aynn||': 'normal
 goo=amessage'?'||goo':'

 if length(goo)<73 then do
    call charout,foo1
 end
 else do
    foo1=normal||reverse||amessage||'? '||normal
    say foo1
    call charout,'     : 'aynn||': 'normal
 end

 anans=translate(sysgetkey('echo'))

 ianans=c2d(anans)
 if anans='' | ianans=13 | ianans=10 then  anans=defans

 if arrowok=1 & ianans=0  then do
     ians=c2d(sysgetkey('noecho'))
     if ians=72 then  do
           say ;say
           return -1  /* -1 : up key */
     end
 end /* do */

 do ijj=1 to w.0
    if abbrev(anans,a.ijj)=1 then do
        say
        return Ijj-1
    end
 end /* do */
 call charout,'0d'x
end


/***************/
/* return 0 for no, 1 for yes, default otherwise */
is_yes_no:procedure expose bold normal mm0a  reverse cy_ye listfile
parse arg aval,def
tdef=strip(translate(aval))
if wordpos(tdef,'Y YES 1')>0 then return 1
if wordpos(tdef,'N NO 0')>0 then return 0
return def



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