/* 21 April 1999. Daniel Hellerstein (danielh@crosslink.net)

    de_sreA.CMD: The client-side component of the "SRE_A" 
                 SRE-http encryption method

This os/2 rexx program will decrypt responses from SRE-http servers
that have been encrypted using the "SRE_A" encryption method.

To use this program, you'll need to do the following (assuming
you are running OS/2, and you have netspacape for OS/2):

a) Copy this file to an applications directory (it does NOT need
   to be in your path). For example, C:\OS2\APPS

b) Tell Netscape to use this DE_SREA whenever it is recieves
   a response from a server that has a mime type of
   application/x-encrypt_SRE_A  
  
   To do this, you should set the following in NetScape:
     1) Open NetScape "applications". 
          for NS4.04 -- look in Edit-Preferences-Applications
          for NS2.02 -- look in Options-General_Preferences-Applications

     2) Create a "new type" with:

         Mime Type: application/x-encrypt_SRE_A
         Application to Use: cmd.exe /c "x:\dir\DoSREA.cmd PWD:sspwd"
 
           NOTE: the  double quote (") characters MUST be included in 
                 this definition!

        where :

           sspwd   : is your "shared-secret password"
                     If you do NOT specify the PWD:sspwd, then
                     DE_SREA will ask you to provide a "shared-secret"
                     password
           x:\dir\ : is the path you copied this file to (for example,
                     C:\OS2\APPS).

After completing steps a and b, you are ready to recieve encrypted
files from an SRE-http web server. 

When you do recieve an "SRE_A encrypted" response from an SRE-http
web server, NetScape should pop up a window that asks you to  
"load" or"save" the file -- you should choose "load".  
de_sreA.CMD will then be invoked.

After making sure you entered the correct password, de_sreA will
decrypt the message, and will then ask you whether to display
the message in a new NetScape window, or whether to save it to disk.

Although DE_SREA.CMD was developed under OS/2, it might work under
different flavors of REXX -- we'll be checking on that.

*/

/* ---------- Begin user changeable parameters --------- */

/* set this to be the  fully qualified default output directory */
default_outdir=''


/* ---------- END of user changeable parameters --------- */


parse arg dafile 

hispwd=''

dafile=strip(dafile)
if abbrev(translate(dafile),'PWD:')=1 then do
   parse var dafile pwd dafile
   parse var pwd . ':' hispwd
   hispwd=strip(translate(hispwd))
end /* do */



say "  <<<< The SRE-http decrypter (for the SRE_A encryption method) >>>>"
say ' '
if default_outdir='' then default_outdir=directory()
outdir=strip(default_outdir,'t','\')||'\'
crlf='0d0a'x
daname='TEMP.OUT'

foo=rxfuncquery('sysloadfuncs') /* use rexxutil if it's available */
if foo=1 then do
  call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  call SysLoadFuncs
end

if dafile='' then do
   call charout, "Enter name of application/x-encrypt_SRE_A file: "
   pull dafile
end 

dafile=strip(dafile)

/* 1) read the file */
a=stream(dafile,'c','open read')
if abbrev(translate(a),'READY')<>1 then do
    say "Problem opening: "dafile '= 'a
    call charout, ' (hit ENTER to continue)' ; pull foo
    exit
end /* do */
ilen=stream(dafile,'c','query size')
if ilen=0 | ilen='' then do
    say "Problem querying: "dafile
    call charout, ' (hit ENTER to continue)' ; pull foo
    exit
end /* do */
stuff=charin(dafile,1,ilen)
foo=stream(dafile,'c','close')

hash16='' ; ctype='' ; nonce='' ; seed='' ; epwd=''; clength=''
server=''
selector=''


/* parse into head and body */
abound=''

do forever
   if stuff='' then do
        say "Problem: no body for this file: " dafile
        call charout, ' (hit ENTER to continue)';pull foo
        exit
   end /* do */
   parse var stuff aline (crlf) stuff

   taline=strip(translate(aline))
   if taline='' then leave      /* empty line signifies end of head */

   select
     when abbrev(taline,'X-NONCE')=1  then do
          parse var aline . ':' NONCE
     end 

     when abbrev(taline,'X-HASH16')=1 then do
        parse var aline . ':' hash16
     end 

     when abbrev(taline,'CONTENT-TYPE')=1 then do
          parse var aline . ':' ctype
     end /* do */

     when abbrev(taline,'CONTENT-LENGTH')=1  then do
          parse var aline . ':' clength
        
     end /* do */

     when abbrev(taline,'SERVER')=1     then do
          parse var aline . ':' SERVER   
     end /* do */
    
     when abbrev(taline,'X-SELECTOR')=1   then do
          parse var aline . ':' SELECTOR   
     end /* do */

     when abbrev(taline,'X-SEED')=1  then do   /* this should never be available */
          parse var aline . ':' SEED    /* -- only used for debug runs */
     end /* do */

     when abbrev(taline,'X-EPWD')=1  then do   /* this should never be available */
          parse var aline . ':' EPWD    /* -- only used for debug runs */
     end /* do */

     when abbrev(taline,'CONTENT-DISPOSITION')=1 then do      /* get "Filename" */
          parse var taline . 'FILENAME' daname ';' .
          daname=space(daname,0)
          daname=strip(daname,,'=')
          daname=strip(daname,,'"')
     end /* do */

     otherwise nop
   end  /* select */
end /* do */

/* nonce and hash16 must be present */
if nonce='' | hash16='' then do 
    say ' Problem: nonce or hash16 is missing '
    call charout, ' (hit ENTER to continue)' ; pull foo
    exit
end /* do */

say "De-encrypting: "||space(server'/'selector,0)
ctype=strip(ctype); clength=strip(clength)
say "    (mimetype= "ctype', length='clength 'bytes)'
say

getspwd:
if hispwd='' then do
  call charout,' Please enter your "shared-secret" password: '
  pull hispwd ; hispwd=space(hispwd,0)
end

/* 1) combine nonce and hispwd */
ss=strip(nonce)||hispwd

/* 2) compute md5 hash */
md5=sref_md5x(ss)

/* 3) pull out first 16 characters */
a16=translate(left(md5,16))

/* 4) compare to hash16 -- if wrong, ask for new password */
if translate(a16)<>hash16 then do
    say '  ! Incorrect "shared-secret" password. Please re-enter.'
    say
    hispwd=''
    signal getspwd
end

/* 5) extract last 3 seed numbers  */
numeric digits 13
ix=x2d(substr(md5,30,3))
iy=x2d(substr(md5,27,3))
iz=x2d(substr(md5,25,2))

/* 6) de-encrypt the file using a random number sequence */
numeric digits 12
mx32=4294967295

/* pack to multiple of 4 length */
i4s=trunc(length(stuff)/4)
i4sb=length(stuff)//4
if i4sb>0 then do
 i4s=i4s+1
 stuff=stuff||copies(' ',i4sb)
end

amask=''
do mm=1 to length(stuff)/4
  arand=random3(mx32)
  darand=right(d2c(arand),4,0)
  amask=amask||darand
  if (mm//2500)=0 then say " @ "mm*4 
end

aanew=bitxor(stuff,amask)

aanew=left(aanew,clength)  /* get rid of pad characters */

say
call charout, "Display in a new NetScape window (Y/N)? "
pull yn
if yn='Y' then do
    tmpfile=dafile
    ijj=lastpos('.',dafile)
    if ijj>0 then tmpfile=left(dafile,ijj-1)
    do mm=1 to 99
    t2=tmpfile||'.$'||mm
       if stream(t2,'c','query exists')='' then leave
    end /* do */
/* write to t2 */
    foo=stream(t2,'c','open write')
    if abbrev(translate(foo),'READY')=0 then do
        say "Problem: could not create temporary file: "t2
        call charout, ' (hit ENTER to continue)' ; pull foo
        exit
    end /* do */
    foo=charout(t2,aanew,1)
    if foo<>0 then do
        say "Problem: could not write temporary file: "t2
        call charout, ' (hit ENTER to continue)' ; pull foo
        exit
    end /* do */
    address cmd '@NETSCAPE  file:///'t2
    foo=deleteme(t2)             /* cleanup */
end /* do */
else do
   useout=getofile(outdir||daname)
   if useout<>"" then do
           foo=stream(useout,'c','open write')
           foo=charout(useout,aanew,1)
           if foo<>0 then do
                say "Problem writing "useout
           end /* do */
           else
                say "   .... "useout " written successfully "
          foo=stream(useout,'c','close')
           ill=lastpos('\',useout)
           if ill>0 then  outdir=left(useout,ill)
   end /* do */
end /* do */

exit


/****************************************************/
/************** Ask for an output file *************/
getofile:procedure
parse arg defout
do forever
  aa="   Output to file (ENTER="defout"):"
  if length(aa)>40 then do
     say aa
     call charout, "    ? "
  end
  else do
    call charout,aa' ?'
  end

  pull gfile2 ; gfile2=strip(gfile2)
  if right(gfile2,1)='\' & defout<>'' then do
     iu=lastpos('\',defout)
     gfile2=gfile2||substr(defout,iu+1)
  end
  if gfile2='.'  then return ''
  if gfile2="" then gfile2=defout
  if gfile2="" then iterate
  gfile0=stream(gfile2,'c','query exists')
  if gfile0<>"" then do
      call charout,'   'Gfile0 ' exists.  Overwrite (Y/N)'
      pull anans
      if abbrev(strip(anans),'Y')<>1 then iterate
      foo=deleteme(gfile0)
      if foo=1 then do
         say "    Could not delete gfile0. Try a different file name"
         iterate
      end
  end
  return gfile2
end /* do */


deleteme:procedure
parse arg afile
if rxfuncquery('SYSFILEDELETE')=0 then foo=sysfiledelete(gfile0)
if stream(gfile,'c','query exists')<>''then return 0
return 1

/****************************************************/
/****************************************************/
/**************  Compute an MD5 hash *************/
/* 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))



/****************************************************/
/****************************************************/
/****************************************************/
/* *********************** */
/* UNIFORM DISTRIBUTION RANDOM # GENERATOR.  
  FROM APPL STATIS 1982, VOL31 Pg183
  Requires one to set ix iy and iz sees beforehand 
*/
random3:procedure expose ix iy iz 
parse arg mx32
IX=(171*IX)//30269
IY=(172*IY)//30307
IZ=(170*IZ)//30323
RANDOM=(IX/30269.) + (IY/30307.)  + (IZ/30323)
random=trunc((random // 1.0)*mx32)

RETURN random