/* demo of the use of SREhttp/2 encryption of forms.
   This is "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 is used to find the ?ENCRYPT secret privilege

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

*/
enc_form:


parse arg list,servername,verb,tempfile,,
          prog_file,reqnum,verbose,user,privset0,,
          uri,host_nickname,id_info,aiter

signal on syntax name foo1
signal on error name foo1

if privset0='' then do
    if aiter=''  then do     /* Is this AFTER a 'PRIVS' elucidated  re-call of this addon */
          return 'PRIVS You need to provide a Usename with an appropriate secret privilege for this resource'
     end
/* if here, got username, but has no privs */
      rcode=sre_auth_response('Get Secret Privilege',servername,, ,
                 'You need to provide a Usename with an appropriate secret privilege for this resource', ,
                  id_info)
      return rcode
end 

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 SREhttp/2 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)
parse var ssecret oog rcode ; oog=strip(oog)
if oog=0 then return rcode              /* authoriztion request was done */
ssecret=strip(rcode)

/* 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
        return 'FILE no_pre erase type text/html name 'tempfile
end


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

akey=translate(nonce||ssecret)
md5=strip(sre_md5(akey))
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
   return 'FILE  no_pre erase type text/html name 'tempfile
end


/* 6)Decyrpt the ENC_MESSAGE1 and ENC_MYVOTE */

if varlist.!enc_message1<>'' then 
   varlist.!enc_message1a=sreh2_form_decrypt(varlist.!enc_message1,nonce,ssecret)
if varlist.!enc_myvote<>'' then 
   varlist.!enc_myvotea=sreh2_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, '<font size=-1><a href="/">Home</a></font>'
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
return 'FILE  no_pre erase type text/html name 'tempfile


/***************/
/* Check for SUPERUSER permissions */
is_allowed:procedure expose servername id_info
parse arg preface,sprivs

/* see if an ?ENCRYPT secret privilege */

tsprivs=' '||translate(sprivs)
ia=pos(' '||strip(translate(preface))||':',tsprivs)
ssecret=''
if ia>0 then do
   goo=substr(sprivs,ia)
   parse upper var goo . ':' ssecret .
end

if ssecret='' then do     /* if here,  no encrypt shared secret */
   rcode=sre_auth_response('Get ENCRYPT Secret Privilege',servername,, ,
                ' You have not been granted an encryption-useable shared-secret.',,
                  id_info)
   return ' 0 '||rcode
end

return '1 '||ssecret


/************/
/*  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=sre_packur(translate(space(translate(aname,' ','+'||'00090a0d'x),0)))
    aval=strip(sre_packur(translate(avalue,' ','+'||'00090a0d'x)))
    aa='!'||aname
    varlist.aa=aval
    varlist.0=varlist.0' 'aname
end
return varlist.0



foo1:
foo=sre_command('string enc_test error at 'sigl ','rc)
exit
