home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / srev13g.zip / doget.cmd < prev    next >
OS/2 REXX Batch file  |  1999-04-07  |  17KB  |  612 lines
  1. /* DOGET -- get's a resource from an HTTP server                 */
  2. /* ------------------------------------------------------------------- */
  3. /* Call as: DOGET [serveraddress [requeststring]]                   */
  4. /* ------------------------------------------------------------------- */
  5. /* This program requires that the RxSock.DLL be in your LIBPATH (it is */
  6. /* usually in your \TCPIP\DLL directory.  It was shipped with the      */
  7. /* August 1994 CSD for the TCP/IP base (UN64092).                      */
  8.  
  9. call load /* load functions if necessary */
  10.  
  11. httpport=80
  12.  
  13. say " Issue a GET method request to an HTTP server, and display complete response "
  14. parse arg server request .
  15. mehost=get_hostname()
  16. crlf    ='0d0a'x                        /* constants */
  17. opts="" ;upwd=""
  18.  
  19.  
  20.  
  21. if server="" then do 
  22.     mehost=get_hostname()
  23.     say " Please enter server address (ENTER= " mehost":"httpport')'
  24.     parse pull server
  25.     if server="" then server=mehost
  26. end  /* Do */
  27. parse var server server ':' bport
  28. if bport<>'' then httpport=bport
  29.  
  30. if request="" then  do
  31.   say " Please enter url to GET: "
  32.   parse pull request
  33.   say " Enter a (space seperated) USERNAME PASSWORD (ENTER=None, DIGEST xx xx):"
  34.   parse pull upwd
  35.   if abbrev(strip(translate(upwd)),'DIGEST')=1  then do
  36.       upwd_hold=upwd ; upwd=''
  37.   end /* do */
  38.   if upwd<>' ' then do
  39.     upwd=space(strip(upwd))
  40.     upwd=mk_base64(translate(upwd,':',' '))
  41.     upwd='Basic 'upwd
  42.   end
  43.   call charout, 'Enter 1 to NOT send a "Connection: Close" header: '
  44.   pull sendclose
  45.   say
  46.   say " Enter optional request headers (?=examples, ENTER=no more)"
  47.   opts=""
  48.   aopt=0
  49.   do until aopt=""
  50.       call charout," : "
  51.       parse pull aopt
  52.       aopt=strip(aopt)
  53.       if aopt="" then leave
  54.       if aopt="?" then do
  55.               say " Examples: "
  56.               say "    Connection:keep-alive"
  57.               say "    Range:bytes=0-50,200-400"
  58.               say " "
  59.               say " or, to load in a file containing request headers: "
  60.               say "     FILE=filename.ext "
  61.               say
  62.               iterate
  63.       end  /* Do */
  64.       if abbrev(translate(aopt),'FILE=')=1 then do
  65.            parse var aopt . '=' afil
  66.            goo=charin(afil,1,chars(afil)); foo=stream(afil,'c','close')
  67.            opts=opts||goo
  68.       end /* do */
  69.       else do
  70.         opts=opts||aopt||crlf
  71.       end
  72.   end /* do */
  73. end
  74.  
  75. if abbrev(translate(request),'HTTP://')=0 then request='/'strip(request,'l','/')
  76.  
  77. family  ='AF_INET'
  78.  
  79. rc=1
  80. if verify(server,'1234567890.')>0 then 
  81.    rc=sockgethostbyname(server, "serv.0")  /* get dotaddress of server */
  82. else
  83.   serv.0addr=strip(server)
  84. if rc=0 then do; say 'Unable to resolve "'server'"'; exit; end
  85. dotserver=serv.0addr                    /* .. */
  86. say " dotserver " dotserver
  87.  
  88. gosaddr.0family=family                  /* set up address */
  89. gosaddr.0port  =httpport
  90. gosaddr.0addr  =dotserver
  91.  
  92. setup1:
  93.  
  94. gosock = SockSocket(family, "SOCK_STREAM", "IPPROTO_TCP")
  95.  
  96. message='GET 'request ' HTTP/1.1'crlf'HOST:'server||crlf
  97.  
  98. message=message||'Referer:do_get@'||mehost||crlf
  99. if upwd<>' ' then
  100.   message=message||'Authorization: '||upwd||crlf
  101. if opts<>"" then message=message||opts
  102. if sendclose<>1 then message=message||'Connection: close' crlf
  103. message=message||crlf
  104. say message
  105.  
  106.  
  107. got=''
  108. rc = SockConnect(gosock,"gosaddr.0")
  109. if rc<0 then do; say 'Unable to connect to "'server'"'; exit; end
  110. rc = SockSend(gosock, message)
  111. say " rc " rc
  112. /* Now wait for the response */
  113. do r=1 by 1
  114.   rc = SockRecv(gosock, "response", 1000)
  115.   got=got||response
  116. /*say length(got)*/
  117.   /* say '>'rc'>' response */
  118.   if rc<=0 then leave
  119.   end r
  120. rc = SockClose(gosock)
  121.  
  122. say 'Got' length(got) 'bytes of response:'
  123.  
  124. findit=crlf||crlf
  125. foo=pos(findit,got)
  126. t1=substr(got,1,foo)
  127.  
  128. /* look for 401 return code */
  129. parse var t1  line1 '0d0a'x t2
  130. parse var line1 . icode .
  131. if icode<>401  then signal writeit
  132.  
  133. call charout,'  Unauthorized: enter 1 to retry with (new) password?'
  134. parse pull goo1
  135. if goo1<>1 then signal writeit
  136.  
  137. parse var upwd_hold gg username password
  138. upwd=make_auth(t2,username,password)
  139. if upwd<>0 then signal setup1
  140.  
  141. writeit:                        /* jump here to write stuff */
  142. say t1
  143. /* see if chunked */
  144. ischunked=0
  145. do until t1=""
  146.     parse var t1 aa '0d0a'x t1
  147.     parse  upper var t1  a1a ':' a1b
  148.     if a1a='TRANSFER-ENCODING' & pos('CHUNKED',a1b)>0 then do
  149.          ischunked=1
  150.          leave
  151.     end /* do */
  152. end /* do */
  153.  
  154. t2=substr(got,foo+length(findit))
  155.  
  156. if ischunked=1 then do
  157.    say " Chunked response -- will unchunk "
  158.    t2=sref_unchunk(t2)
  159. end
  160.  
  161. tt='doget.lst'
  162. foo=sysfiledelete(tt)
  163. eek=charout(tt,t2,1)
  164. if eek<>0 then 
  165.    say "Error writing to doget.lst: "eek
  166. else
  167.     say " =--- results written to doget.lst "
  168.  
  169. exit
  170.  
  171. /* --- Load the function library, if necessary --- */
  172. load:
  173. if RxFuncQuery("SockLoadFuncs")=1 then do      /* already there */
  174.   call RxFuncAdd "SockLoadFuncs","rxSock","SockLoadFuncs"
  175.   call SockLoadFuncs
  176. end
  177.  
  178. /* Load up advanced REXX functions */
  179. foo=rxfuncquery('sysloadfuncs')
  180. if foo=1 then do
  181.   call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  182.   call SysLoadFuncs
  183. end
  184.  
  185.  
  186. return
  187.  
  188.  
  189.  
  190. /* get the hostname (aa.bb.cc) for this machine
  191.    Developed by Timur Kazimirov  */
  192.  
  193. get_hostname:procedure
  194. if \RxFuncQuery("SockLoadFuncs")
  195.   then
  196.     nop
  197.   else
  198.     do
  199.       call RxFuncAdd "SockLoadFuncs","rxSock","SockLoadFuncs"
  200.       call SockLoadFuncs
  201.     end
  202. dot_addr = SockGetHostId()
  203. rc = SockGetHostByAddr(dot_addr, "host.")
  204. return host.name
  205.  
  206.  
  207. /************/
  208. /* make an authorization header */
  209. make_auth:
  210.  
  211. ifoo=0
  212. parse arg r2,USERNAME0,PASSWORD0
  213. /* basic or digest? */
  214. do until r2=''
  215.    parse var r2 a1 '0d0a'x r2 ; a1=strip(a1)
  216.    parse var a1 atype ':' aheader ;atype=strip(atype)
  217.    if translate(atype)<>'WWW-AUTHENTICATE' then iterate
  218.    ifoo=1
  219.    leave
  220. end
  221.  
  222. if ifoo=0 then return 0
  223.  
  224. /*else-- parse r2 and create digest style request header */
  225.     call charout,' Username (enter='username0'):'
  226.     parse pull username
  227.     if username='' then username=username0
  228.     
  229.     call charout,' Password (enter='password0'):'
  230.     parse pull passwd
  231.     if passwd='' then passwd=password0
  232.  
  233.     parse var aheader atype aheader
  234.     atype=strip(translate(atype))
  235.     if atype='BASIC' then do
  236.        upwd=mk_base64(strip(username)':'strip(passwd))
  237.        upwd='Basic 'upwd
  238.        return upwd
  239.     end /* do */
  240.  
  241.     call charout," Qop response (1=yes): "
  242.      parse pull iqop
  243.     upwd=digest_mkupwd(request,username,passwd,aheader,iqop)
  244.     if upwd=0 then return 0
  245.     return upwd   
  246.  
  247.  
  248. /************/
  249. /* create a base64 packing of a message */
  250. mk_base64:procedure
  251.  
  252. do mm=0 to 25           /* set base 64 encoding keys */
  253.    a.mm=d2c(65+mm)
  254. end /* do */
  255. do mm=26 to 51
  256.    a.mm=d2c(97+mm-26)
  257. end /* do */
  258. do mm=52 to 61
  259.    a.mm=d2c(48+mm-52)
  260. end /* do */
  261. a.62='+'
  262. a.63='/'
  263.  
  264. parse arg mess
  265. s2=x2b(c2x(mess))
  266. ith=0
  267. do forever
  268.    ith=ith+1
  269.    a1=substr(s2,1,6,0)
  270.    ms.ith=x2d(b2x(a1))
  271.    if length(s2)<7 then leave
  272.    s2=substr(s2,7)
  273. end /* do */
  274. pint=""
  275. do kk=1 to ith
  276.     oi=ms.kk ; pint=pint||a.oi
  277. end /* do */
  278. j1=length(pint)//4
  279. if j1<>0 then pint=pint||copies('=',4-j1)
  280. return pint
  281.  
  282.  
  283.  
  284. /********************************************/
  285. /*Given client digest auth, form local copy of "response";
  286.  and compare to her "response" */
  287.  
  288. digest_mkupwd:procedure
  289. parse arg auri,username,passwd,aheader,iqop
  290.  
  291.  
  292. realm='' ; nonce=''; ;qop='';opaque=''
  293. do until aheader=''
  294.    parse var aheader a1 ',' aheader
  295.    parse var a1 a1a '=' a1b 
  296.    a1bb=strip(strip(a1b),,'"') ; a1a=strip(upper(a1a))
  297.    select 
  298.       when  a1a='REALM' then realm=a1bb
  299.       when a1a='NONCE' then nonce=a1bb
  300.       when a1a='QOP' & iqop=1 then qop=a1bb
  301.       when a1a='OPAQUE' then opaque=a1bb
  302.       otherwise nop
  303.    end
  304. end /* do */
  305.  
  306. /* if username, response, uri, nonce, realm ='', then failure */
  307. if username='' | nonce='' | realm='' then do
  308.     say 'Insufficient information; can not create digest style Autorization request '
  309.     return 0
  310. end /* do */
  311.  
  312. if abbrev(translate(auri),'HTTP://')=0 then auri='/'strip(auri,'l','/')
  313.  
  314. username=strip(username); passwd=strip(passwd)
  315.  
  316. qop=strip(qop)
  317. if pos('AUTH',translate(qop))>0 then do
  318.   cnonce='testhere'
  319.   nc=1
  320.   qop='auth'
  321. end /* do */
  322. else do
  323.   cnonce=''; nc='';qop=''
  324. end
  325.  
  326. VERB='GET'
  327.  
  328. /* 1) form h(a1) */
  329.   a1=username':'realm':'passwd
  330.   ha1=lower(sref_md5x(a1))
  331.  
  332. /* form h(a2) */
  333.   a2='GET:'auri
  334.   ha2=lower(sref_md5x(a2))
  335.  
  336. /* if no qop */
  337. if translate(qop)<>'AUTH' then do 
  338.     resp1=ha1':'nonce':'ha2
  339.     hresp=sref_md5x(resp1)
  340. end /* do */
  341. else do         /* AUTH */
  342.     resp1=ha1':'nonce':'nc':'cnonce':'qop':'ha2
  343.     hresp=sref_md5x(resp1)
  344. end /* do */
  345.  
  346. rar='Digest username="'username'", realm="'realm'"'
  347. rar=rar', uri="'auri'", nonce="'nonce'"'
  348. if translate(qop)='AUTH' then do
  349.    rar=rar', qop='qop', cnonce="'cnonce'", nc='nc
  350. end /* do */
  351. rar=rar', response="'hresp'"'
  352.  
  353. if opaque<>'' then rar=rar', opaque="'opaque'"'
  354.  
  355.  
  356. return rar
  357.  
  358. /*
  359. Authorization: Digest username="Mufasa", realm="testrealm@hopf.math.nwu.edu", ur
  360. i="/testpage/digest/index.html", nonce="86a88f9b4d927b79d9a21c53f0757a3abd", res
  361. ponse="d35edc9327c6149f0c3a6c5a46e84ed8"
  362. Connection: close
  363. */
  364.  
  365.  
  366.  
  367. /***********/
  368. /* A fully rexx md5 digest computation procedure.
  369.   This is NOT FAST  --  for small strings it is
  370.   toleable (0.15 seconds on a p166 for 50 character strings),
  371.   but for larger strings (or files) it can take many seconds --
  372.   you should instead use a DLL product (such as MD5_OS2) */
  373.  
  374.  
  375. /*  ------------------------------ */
  376. sref_md5x:procedure
  377. parse arg stuff
  378.  
  379. numeric digits 11
  380. lenstuff=length(stuff)
  381.  
  382. c0=d2c(0)
  383. c1=d2c(128)
  384. c1a=d2c(255)
  385. c1111=c1a||c1a||c1a||c1a
  386. slen=length(stuff)*8
  387. slen512=slen//512
  388.  
  389. /* pad message to multiple of 512 bits.  Last 2 words are 64 bit # bits in message*/
  390. if slen512=448 then  addme=512
  391. if slen512<448 then addme=448-slen512
  392. if slen512>448 then addme=960-slen512
  393. addwords=addme/8
  394.  
  395. apad=c1||copies(c0,addwords-1)
  396.  
  397. xlen=reverse(right(d2c(lenstuff*8),4,c0))||c0||c0||c0||c0  /* 2**32 max bytes in message */
  398.  
  399. /* NEWSTUFF is the message to be md5'ed */
  400. newstuff=stuff||apad||xlen
  401.  
  402. /* starting values of registers */
  403.  a ='67452301'x;
  404.  b ='efcdab89'x;
  405.  c ='98badcfe'x;
  406.  d ='10325476'x;
  407.  
  408. lennews=length(newstuff)/4
  409.  
  410. /* loop through entire message */
  411. do i1 = 0 to ((lennews/16)-1)
  412.   i16=i1*64
  413.   do j=1 to 16
  414.      j4=((j-1)*4)+1
  415.      jj=i16+j4
  416.      m.j=reverse(substr(newstuff,jj,4))
  417.   end /* do */
  418.  
  419. /* transform this block of 16 chars to 4 values. Save prior values first */
  420.  aa=a;bb=b;cc=c;dd=d
  421.  
  422. /* do 4 rounds, 16 operations per round (rounds differ in bit'ing functions */
  423. S11=7
  424. S12=12
  425. S13=17
  426. S14=22
  427.   a=round1( a, b, c, d,   0 , S11, 3614090360); /* 1 */
  428.   d=round1( d, a, b, c,   1 , S12, 3905402710); /* 2 */
  429.   c=round1( c, d, a, b,   2 , S13,  606105819); /* 3 */
  430.   b=round1( b, c, d, a,   3 , S14, 3250441966); /* 4 */
  431.   a=round1( a, b, c, d,   4 , S11, 4118548399); /* 5 */
  432.   d=round1( d, a, b, c,   5 , S12, 1200080426); /* 6 */
  433.   c=round1( c, d, a, b,   6 , S13, 2821735955); /* 7 */
  434.   b=round1( b, c, d, a,   7 , S14, 4249261313); /* 8 */
  435.   a=round1( a, b, c, d,   8 , S11, 1770035416); /* 9 */
  436.   d=round1( d, a, b, c,   9 , S12, 2336552879); /* 10 */
  437.   c=round1( c, d, a, b,  10 , S13, 4294925233); /* 11 */
  438.   b=round1( b, c, d, a,  11 , S14, 2304563134); /* 12 */
  439.   a=round1( a, b, c, d,  12 , S11, 1804603682); /* 13 */
  440.   d=round1( d, a, b, c,  13 , S12, 4254626195); /* 14 */
  441.   c=round1( c, d, a, b,  14 , S13, 2792965006); /* 15 */
  442.   b=round1( b, c, d, a,  15 , S14, 1236535329); /* 16 */
  443.  
  444.   /* Round 2 */
  445. S21=5
  446. S22=9
  447. S23=14
  448. S24=20
  449. a= round2( a, b, c, d,   1 , S21, 4129170786); /* 17 */
  450. d= round2( d, a, b, c,   6 , S22, 3225465664); /* 18 */
  451. c=  round2( c, d, a, b,  11 , S23,  643717713); /* 19 */
  452. b=  round2( b, c, d, a,   0 , S24, 3921069994); /* 20 */
  453. a=  round2( a, b, c, d,   5 , S21, 3593408605); /* 21 */
  454. d=  round2( d, a, b, c,  10 , S22,   38016083); /* 22 */
  455. c=  round2( c, d, a, b,  15 , S23, 3634488961); /* 23 */
  456. b= round2( b, c, d, a,   4 , S24, 3889429448); /* 24 */
  457. a= round2( a, b, c, d,   9 , S21,  568446438); /* 25 */
  458. d= round2( d, a, b, c,  14 , S22, 3275163606); /* 26 */
  459. c=  round2( c, d, a, b,   3 , S23, 4107603335); /* 27 */
  460. b=  round2( b, c, d, a,   8 , S24, 1163531501); /* 28 */
  461. a=  round2( a, b, c, d,  13 , S21, 2850285829); /* 29 */
  462. d=  round2( d, a, b, c,   2 , S22, 4243563512); /* 30 */
  463. c=  round2( c, d, a, b,   7 , S23, 1735328473); /* 31 */
  464. b= round2( b, c, d, a,  12 , S24, 2368359562); /* 32 */
  465.  
  466.   /* Round 3 */
  467. S31= 4
  468. S32= 11
  469. S33= 16
  470. S34= 23
  471. a= round3( a, b, c, d,   5 , S31, 4294588738); /* 33 */
  472. d=  round3( d, a, b, c,   8 , S32, 2272392833); /* 34 */
  473. c=  round3( c, d, a, b,  11 , S33, 1839030562); /* 35 */
  474. b=  round3( b, c, d, a,  14 , S34, 4259657740); /* 36 */
  475. a=  round3( a, b, c, d,   1 , S31, 2763975236); /* 37 */
  476. d=  round3( d, a, b, c,   4 , S32, 1272893353); /* 38 */
  477. c=  round3( c, d, a, b,   7 , S33, 4139469664); /* 39 */
  478. b=  round3( b, c, d, a,  10 , S34, 3200236656); /* 40 */
  479. a=  round3( a, b, c, d,  13 , S31,  681279174); /* 41 */
  480. d=  round3( d, a, b, c,   0 , S32, 3936430074); /* 42 */
  481. c=  round3( c, d, a, b,   3 , S33, 3572445317); /* 43 */
  482. b=  round3( b, c, d, a,   6 , S34,   76029189); /* 44 */
  483. a=  round3( a, b, c, d,   9 , S31, 3654602809); /* 45 */
  484. d=  round3( d, a, b, c,  12 , S32, 3873151461); /* 46 */
  485. c=  round3( c, d, a, b,  15 , S33,  530742520); /* 47 */
  486. b=  round3( b, c, d, a,   2 , S34, 3299628645); /* 48 */
  487.  
  488.   /* Round 4 */
  489. S41=6
  490. S42=10
  491. S43=15
  492. s44=21
  493. a=round4( a, b, c, d,   0 , S41, 4096336452); /* 49 */
  494. d=round4( d, a, b, c,   7 , S42, 1126891415); /* 50 */
  495. c=round4( c, d, a, b,  14 , S43, 2878612391); /* 51 */
  496. b=round4( b, c, d, a,   5 , s44, 4237533241); /* 52 */
  497. a=round4( a, b, c, d,  12 , S41, 1700485571); /* 53 */
  498. d=round4( d, a, b, c,   3 , S42, 2399980690); /* 54 */
  499. c=round4( c, d, a, b,  10 , S43, 4293915773); /* 55 */
  500. b=round4( b, c, d, a,   1 , s44,  2240044497); /* 56 */
  501. a=round4( a, b, c, d,   8 , S41, 1873313359); /* 57 */
  502. d=round4( d, a, b, c,  15 , S42, 4264355552); /* 58 */
  503. c=round4( c, d, a, b,   6 , S43, 2734768916); /* 59 */
  504. b=round4( b, c, d, a,  13 , s44, 1309151649); /* 60 */
  505. a=round4( a, b, c, d,   4 , S41, 4149444226); /* 61 */
  506. d=round4( d, a, b, c,  11 , S42, 3174756917); /* 62 */
  507. c=round4( c, d, a, b,   2 , S43,  718787259); /* 63 */
  508. b=round4( b, c, d, a,   9 , s44, 3951481745); /* 64 */
  509.  
  510.  
  511. a=m32add(aa,a) ; b=m32add(bb,b) ; c=m32add(cc,c) ; d=m32add(dd,d)
  512.  
  513. end
  514.  
  515. aa=c2x(reverse(a))||c2x(reverse(b))||c2x(reverse(C))||c2x(reverse(D))
  516.  
  517. return lower(aa)
  518.  
  519.  
  520. /* round 1 to 4 functins */
  521.  
  522. round1:procedure expose m. c1111 c0 c1
  523. parse arg a1,b1,c1,d1,kth,shift,sini
  524. kth=kth+1
  525. t1=c2d(a1)+c2d(f(b1,c1,d1))+ c2d(m.kth) + sini
  526. t1a=right(d2c(t1),4,c0)
  527. t2=rotleft(t1a,shift)
  528. t3=m32add(t2,b1)
  529. return t3
  530.  
  531. round2:procedure expose m. c1111 c0 c1
  532. parse arg a1,b1,c1,d1,kth,shift,sini
  533. kth=kth+1
  534. t1=c2d(a1)+c2d(g(b1,c1,d1))+ c2d(m.kth) + sini
  535. t1a=right(d2c(t1),4,c0)
  536. t2=rotleft(t1a,shift)
  537. t3=m32add(t2,b1)
  538. return t3
  539.  
  540. round3:procedure expose m. c1111 c0 c1
  541. parse arg a1,b1,c1,d1,kth,shift,sini
  542. kth=kth+1
  543. t1=c2d(a1)+c2d(h(b1,c1,d1))+ c2d(m.kth) + sini
  544. t1a=right(d2c(t1),4,c0)
  545. t2=rotleft(t1a,shift)
  546. t3=m32add(t2,b1)
  547. return t3
  548.  
  549. round4:procedure expose m. c1111 c0 c1
  550. parse arg a1,b1,c1,d1,kth,shift,sini
  551. kth=kth+1
  552. t1=c2d(a1)+c2d(i(b1,c1,d1))+ c2d(m.kth) + sini
  553. t1a=right(d2c(t1),4,c0)
  554. t2=rotleft(t1a,shift)
  555. t3=m32add(t2,b1)
  556. return t3
  557.  
  558. /* add to "char" numbers, modulo 2**32, return as char */
  559. m32add:procedure expose c0 c1 c1111
  560. parse arg v1,v2
  561. t1=c2d(v1)+c2d(v2)
  562. t2=d2c(t1)
  563. t3=right(t2,4,c0)
  564. return t3
  565.  
  566. /*********** Basic functions */
  567. /* F(x, y, z) == (((x) & (y)) | ((~x) & (z))) */
  568. f:procedure expose c0 c1 c1111 
  569. parse arg x,y,z
  570. t1=bitand(x,y)
  571. notx=bitxor(x,c1111)
  572. t2=bitand(notx,z)
  573. return bitor(t1,t2)
  574.  
  575.  
  576. /* G(x, y, z) == (((x) & (z)) | ((y) & (~z)))*/
  577. g:procedure expose c0 c1 c1111
  578. parse arg x,y,z
  579. t1=bitand(x,z)
  580. notz=bitxor(z,c1111)
  581. t2=bitand(y,notz)
  582. return bitor(t1,t2)
  583.  
  584. /* H(x, y, z) == ((x) ^ (y) ^ (z)) */
  585. h:procedure expose c0 c1 c1111
  586. parse arg x,y,z
  587. t1=bitxor(x,y)
  588. return bitxor(t1,z)
  589.  
  590. /* I(x, y, z) == ((y) ^ ((x) | (~z))) */
  591. i:procedure expose c0 c1 c1111
  592. parse arg x,y,z
  593. notz=bitxor(z,c1111)
  594. t2=bitor(x,notz)
  595. return bitxor(y,t2)
  596.  
  597. /* bit rotate to the left by s positions */
  598. rotleft:procedure 
  599. parse arg achar,s
  600. if s=0 then return achar
  601.  
  602. bits=x2b(c2x(achar))
  603. lb=length(bits)
  604. t1=left(bits,s)
  605. t2=bits||t1
  606. yib=right(t2,lb)
  607. return x2c(b2x(yib))
  608.  
  609.  
  610.  
  611.  
  612.