home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / srev13g.zip / enc_test.cmd < prev    next >
OS/2 REXX Batch file  |  1999-06-19  |  7KB  |  181 lines
  1. /* demo of the use of sre-http encryption of forms.
  2.    This is "called" by called by the form in enc_form.sht.
  3.  
  4. The key points are:
  5.   a) You must ascertain the client's shared secret. Typically, this   
  6.      will be done by examining her secret_privileges (which means she
  7.      must have a valid username & password).  Although not required,
  8.      a secret privilege that starts with ?ENCRYPT: is often used to
  9.      store the "encryption-useable shared secret". For example:
  10.                 ?ENCRYPT:foo132z
  11.      Note that the shared secret is always converted to upper case.
  12.  
  13.      The IS_ALLOWED procedure can be used (with suitable modifications)
  14.      to request a suitable (one with an ?ENCRYPT: secret privilege) 
  15.      username and password from the client.
  16.  
  17.   b) For each "encrypted" variable, you should call the SREF_FORM_DECRYPT
  18.      procedure.
  19.  
  20. */
  21. enc_form:
  22.  
  23. parse arg ddir,tempfile,sel,list,verb,uri,user,basedir,workdir,privset0, ,
  24.            enmadd,transaction,verbose,servername,host_nickname,homedir
  25. parse var privset0 privset ',' privset_secret 
  26. signal on error name badguys; signal on syntax name badguys
  27. crlf = '0d0a'x
  28.  
  29. /* 1) A quick check for a legit call */
  30.  
  31. if verb="" then do
  32.    say " This SRE-http procedure is not meant to be run in stand-alone mode. "
  33.    exit
  34. end  
  35.  
  36.  
  37. /*2) get the client's "shared secret" (might need to force an 
  38.      authorization request */
  39.  
  40. ssecret=is_allowed("ENCRYPT",privset_secret)
  41. if completed()=1 then return ssecret    /*is_allowed might do force an authorization request */
  42.  
  43. /* 3) Parse the request string, store in the varlist.! stem */
  44.  
  45. varlist.=''
  46. alist=read_vars(list)
  47.  
  48. /* 4) Extract the nonce */
  49.  
  50. nonce=varlist.!nonce
  51. if nonce='' then do             /* error: nonce not available */
  52.         call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
  53.         call lineout tempfile, "<html><head><title>ENC_TEST error</title>"
  54.         call lineout tempfile, '</head><body>'
  55.  
  56.         call lineout tempfile,' <strong> Missing information.</strong> <pre>'
  57.         call lineout tempfile,' The nonce is not available </pre>'
  58.         call lineout tempfile,' </body> </html> '
  59.         call lineout tempfile
  60.         foo=sref_gos('FILE ERASE TYPE text/html NAME' tempfile)
  61.         signal off error ; signal off syntax
  62.         return foo
  63. end
  64.  
  65.  
  66. /* 5) We now have the shared-secret password and the nonce.
  67.    Check to see if is correct. */
  68.  
  69. akey=translate(nonce||ssecret)
  70. md5=strip(sref_md5(akey,0))
  71. foo=translate(left(md5,16))
  72. if foo<>strip(translate(varlist.!verify)) then do  /* no match, hence wrong password */
  73.    call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
  74.    call lineout tempfile, "<html><head><title>ENC_TEST: wrong password</title>"
  75.    call lineout tempfile, '</head><body>'
  76.  
  77.    call lineout tempfile,' <strong> You entered an incorrect password.</strong> <pre>'
  78.    call lineout tempfile,' Please re-enter. </pre>'
  79.    call lineout tempfile,' </body> </html> '
  80.    call lineout tempfile
  81.    foo=sref_gos('FILE ERASE TYPE text/html NAME' tempfile)
  82.    signal off error ; signal off syntax
  83.    return foo
  84. end
  85.  
  86.  
  87. /* 6)Decyrpt the ENC_MESSAGE1 and ENC_MYVOTE */
  88.  
  89. if varlist.!enc_message1<>'' then 
  90.    varlist.!enc_message1a=sref_form_decrypt(varlist.!enc_message1,nonce,ssecret)
  91. if varlist.!enc_myvote<>'' then 
  92.    varlist.!enc_myvotea=sref_form_decrypt(varlist.!enc_myvote,nonce,ssecret)
  93.  
  94. /* 7) Display some results */
  95.  
  96. call lineout tempfile, "<html><head><title>ENC_TEST results</title>"
  97. call lineout tempfile, '</head><body>'
  98. call lineout tempfile,'<h2>ENC_TEST results</h2>'
  99. call lineout tempfile,'<b>Non-encrypted variables: </b><ul>'
  100. call lineout tempfile,'<LI> YourName: 'varlist.!yourname
  101. call lineout tempfile,'<li> Regular visitor (RVISTOR) : 'varlist.!rvisitor 
  102. call lineout tempfile,'</ul>'
  103. call lineout tempfile,'<b>Encrypted variables: </b><ul>'
  104. call lineout tempfile,'<li>MYVOTE: 'varlist.!enc_myvotea
  105. call lineout tempfile,' <br>(encrypted: 'varlist.!enc_myvote')'
  106. call lineout tempfile,'<li>MESSAGE1: ' varlist.!enc_message1a
  107. call lineout tempfile,' <br>(encrypted: 'varlist.!enc_message1')'
  108.  
  109. call lineout tempfile,'</ul>'
  110. call lineout tempfile,'</body></html>'
  111. call lineout tempfile
  112. foo=sref_gos('FILE ERASE TYPE text/html NAME' tempfile)
  113. return foo
  114.  
  115.  
  116. /***************/
  117. /* Check for SUPERUSER permissions */
  118. is_allowed:procedure expose tempfile servername
  119. parse arg preface,privset_secret
  120.  
  121. if reqfield('authorization')='' then do               /* always get user name */
  122.       'header add WWW-Authenticate: Basic Realm=ENC_FORM'  /* challenge */
  123.         call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
  124.         call lineout tempfile, "<html><head><title>ENC_FORM requires a  username </title>"
  125.         call lineout tempfile, '</head><body bgcolor="#'||usecolor||'">'
  126.         call lineout tempfile,' <strong>To use  ENC_FORM, you must supply a username and password.</strong> <pre>'
  127.         call lineout tempfile,'<br><a href="javascript:self.back()">back</a><br>'
  128.         call lineout tempfile,' </body> </html> '
  129.         call lineout tempfile
  130.         signal off error ; signal off syntax
  131.         return sref_response('unauth'," ENC_FORM-- requires a valid username/password ",servername,1)
  132. end /* do */
  133.  
  134. /* see if an ?ENCRYPT secret privilege */
  135. ssecret=''
  136. preface=strip(translate(preface))
  137. do mm=1 to words(privset_secret)
  138.      app=strip(translate(word(privset_secret,mm)))
  139.      if abbrev(app,preface||':')=0 then iterate          
  140.      parse var app . ':' ssecret 
  141.      return ssecret
  142. end /* do */
  143.  
  144. /* no shared secret */
  145. 'header add WWW-Authenticate: Basic Realm=<ENC_FORM>'  /* challenge */
  146.         call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
  147.         call lineout tempfile, "<html><head><title>Not authorized </title>"
  148.         call lineout tempfile, '</head><body bgcolor="#'||usecolor||'">'
  149.  
  150.         call lineout tempfile,' <strong> You do not an encryption-useable shared-secret.</strong> <pre>'
  151.         call lineout tempfile,'<br><a href="javascript:self.back()">back</a><br>'
  152.         call lineout tempfile,' </body> </html> '
  153.         call lineout tempfile
  154.          signal off error ; signal off syntax
  155.  
  156. return sref_response('unauth'," You do not have an encryption-useable shared secret ",servername,1)
  157.  
  158. /************/
  159. /*  parse varlist, return in varlisrt.!name.
  160.    With varlist.0 containing list of names */
  161. read_vars:procedure expose varlist.  allowed_dirs.
  162.  
  163. parse arg alist
  164. varlist.=''
  165. alist=translate(alist, ' ', '+'||'090a0d'x)  /* Whitespace, etc. */
  166.  
  167. do forever
  168.     if alist='' then leave
  169.     parse var alist a1 '&' alist
  170.     parse var a1 aname '=' avalue
  171.     if avalue='' then iterate             /* ignore empty entries */
  172.     aname=packur(translate(space(translate(aname,' ','+'||'00090a0d'x),0)))
  173.     aval=strip(packur(translate(avalue,' ','+'||'00090a0d'x)))
  174.     aa='!'||aname
  175.     varlist.aa=aval
  176.     varlist.0=varlist.0' 'aname
  177. end
  178. return varlist.0
  179.  
  180.  
  181.