/* demo of the use of sre-http encryption of forms.
   This is "called" by called by the form in enc_form.sht.

The key points are:
  a) You must ascertain the client's shared secret. Typically, this   
     will be done by examining her secret_privileges (which means she
     must have a valid username & password).  Although not required,
     a secret privilege that starts with ?ENCRYPT: is often used to
     store the "encryption-useable shared secret". For example:
                ?ENCRYPT:foo132z
     Note that the shared secret is always converted to upper case.

     The IS_ALLOWED procedure can be used (with suitable modifications)
     to request a suitable (one with an ?ENCRYPT: secret privilege) 
     username and password from the client.

  b) For each "encrypted" variable, you should call the SREF_FORM_DECRYPT
     procedure.

*/
enc_form:

parse arg ddir,tempfile,sel,list,verb,uri,user,basedir,workdir,privset0, ,
           enmadd,transaction,verbose,servername,host_nickname,homedir
parse var privset0 privset ',' privset_secret 
signal on error name badguys; signal on syntax name badguys
crlf = '0d0a'x

/* 1) A quick check for a legit call */

if verb="" then do
   say " This SRE-http procedure is not meant to be run in stand-alone mode. "
   exit
end  


/*2) get the client's "shared secret" (might need to force an 
     authorization request */

ssecret=is_allowed("ENCRYPT",privset_secret)
if completed()=1 then return ssecret    /*is_allowed might do force an authorization request */

/* 3) Parse the request string, store in the varlist.! stem */

varlist.=''
alist=read_vars(list)

/* 4) Extract the nonce */

nonce=varlist.!nonce
if nonce='' then do             /* error: nonce not available */
        call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
        call lineout tempfile, "<html><head><title>ENC_TEST error</title>"
        call lineout tempfile, '</head><body>'

        call lineout tempfile,' <strong> Missing information.</strong> <pre>'
        call lineout tempfile,' The nonce is not available </pre>'
        call lineout tempfile,' </body> </html> '
        call lineout tempfile
        foo=sref_gos('FILE ERASE TYPE text/html NAME' tempfile)
        signal off error ; signal off syntax
        return foo
end


/* 5) We now have the shared-secret password and the nonce.
   Check to see if is correct. */

akey=translate(nonce||ssecret)
md5=strip(sref_md5(akey,0))
foo=translate(left(md5,16))
if foo<>strip(translate(varlist.!verify)) then do  /* no match, hence wrong password */
   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
   call lineout tempfile, "<html><head><title>ENC_TEST: wrong password</title>"
   call lineout tempfile, '</head><body>'

   call lineout tempfile,' <strong> You entered an incorrect password.</strong> <pre>'
   call lineout tempfile,' Please re-enter. </pre>'
   call lineout tempfile,' </body> </html> '
   call lineout tempfile
   foo=sref_gos('FILE ERASE TYPE text/html NAME' tempfile)
   signal off error ; signal off syntax
   return foo
end


/* 6)Decyrpt the ENC_MESSAGE1 and ENC_MYVOTE */

if varlist.!enc_message1<>'' then 
   varlist.!enc_message1a=sref_form_decrypt(varlist.!enc_message1,nonce,ssecret)
if varlist.!enc_myvote<>'' then 
   varlist.!enc_myvotea=sref_form_decrypt(varlist.!enc_myvote,nonce,ssecret)

/* 7) Display some results */

call lineout tempfile, "<html><head><title>ENC_TEST results</title>"
call lineout tempfile, '</head><body>'
call lineout tempfile,'<h2>ENC_TEST results</h2>'
call lineout tempfile,'<b>Non-encrypted variables: </b><ul>'
call lineout tempfile,'<LI> YourName: 'varlist.!yourname
call lineout tempfile,'<li> Regular visitor (RVISTOR) : 'varlist.!rvisitor 
call lineout tempfile,'</ul>'
call lineout tempfile,'<b>Encrypted variables: </b><ul>'
call lineout tempfile,'<li>MYVOTE: 'varlist.!enc_myvotea
call lineout tempfile,' <br>(encrypted: 'varlist.!enc_myvote')'
call lineout tempfile,'<li>MESSAGE1: ' varlist.!enc_message1a
call lineout tempfile,' <br>(encrypted: 'varlist.!enc_message1')'

call lineout tempfile,'</ul>'
call lineout tempfile,'</body></html>'
call lineout tempfile
foo=sref_gos('FILE ERASE TYPE text/html NAME' tempfile)
return foo


/***************/
/* Check for SUPERUSER permissions */
is_allowed:procedure expose tempfile servername
parse arg preface,privset_secret

if reqfield('authorization')='' then do               /* always get user name */
      'header add WWW-Authenticate: Basic Realm=ENC_FORM'  /* challenge */
        call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
        call lineout tempfile, "<html><head><title>ENC_FORM requires a  username </title>"
        call lineout tempfile, '</head><body bgcolor="#'||usecolor||'">'
        call lineout tempfile,' <strong>To use  ENC_FORM, you must supply a username and password.</strong> <pre>'
        call lineout tempfile,'<br><a href="javascript:self.back()">back</a><br>'
        call lineout tempfile,' </body> </html> '
        call lineout tempfile
        signal off error ; signal off syntax
        return sref_response('unauth'," ENC_FORM-- requires a valid username/password ",servername,1)
end /* do */

/* see if an ?ENCRYPT secret privilege */
ssecret=''
preface=strip(translate(preface))
do mm=1 to words(privset_secret)
     app=strip(translate(word(privset_secret,mm)))
     if abbrev(app,preface||':')=0 then iterate          
     parse var app . ':' ssecret 
     return ssecret
end /* do */

/* no shared secret */
'header add WWW-Authenticate: Basic Realm=<ENC_FORM>'  /* challenge */
        call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
        call lineout tempfile, "<html><head><title>Not authorized </title>"
        call lineout tempfile, '</head><body bgcolor="#'||usecolor||'">'

        call lineout tempfile,' <strong> You do not an encryption-useable shared-secret.</strong> <pre>'
        call lineout tempfile,'<br><a href="javascript:self.back()">back</a><br>'
        call lineout tempfile,' </body> </html> '
        call lineout tempfile
         signal off error ; signal off syntax

return sref_response('unauth'," You do not have an encryption-useable shared secret ",servername,1)

/************/
/*  parse varlist, return in varlisrt.!name.
   With varlist.0 containing list of names */
read_vars:procedure expose varlist.  allowed_dirs.

parse arg alist
varlist.=''
alist=translate(alist, ' ', '+'||'090a0d'x)  /* Whitespace, etc. */

do forever
    if alist='' then leave
    parse var alist a1 '&' alist
    parse var a1 aname '=' avalue
    if avalue='' then iterate             /* ignore empty entries */
    aname=packur(translate(space(translate(aname,' ','+'||'00090a0d'x),0)))
    aval=strip(packur(translate(avalue,' ','+'||'00090a0d'x)))
    aa='!'||aname
    varlist.aa=aval
    varlist.0=varlist.0' 'aname
end
return varlist.0


