/* Dynamic Passwd Server - DMS - aug 00 - by Sylvain HUET */
/* rev 08-01 - Sebastien DENEUX */


typeof req=[[CLIENT S S Tag] r1];;
fun reqbycli(x,cli)= let x->[c _ _ _] in c==cli;;

/* cryptage */

fun BigSizebis(n,b,i)=
 if (BigCmp b n) >0 then i
 else BigSizebis n BigAdd b b i+1;;

fun BigSize(n)= BigSizebis n BigFromAsc "1" 0;;

fun BigCutstring(s,i,n)=
 let substr s i n -> z in
 if strlen z then z::BigCutstring s i+n n
 else nil;;

fun CRPdecryptone(l,p,x,n)=
 if l==nil then nil else
 let l->[a [b nxt]] in
  (BigMuln BigFromString b (BigInvn (BigExpn BigFromString a x p) p) p)::CRPdecryptone nxt p x n;;

/* decryptage d'un message s avec la clef publique n et la clef privee x -> retourne une string */
fun CRPdecrypt(s,pub,priv)=
 let pub->[p g y] in
 let ((BigSize p)-1)>>3 -> nbyte in
 BigListToString (CRPdecryptone (BigCutstring s 0 nbyte+1) p priv pub) nbyte;;

/* creation d'une clef [pub priv] sur i bits */
fun CRPcreate(i)=
 let BigPrimal i -> p in
 let BigMod BigRand p -> g in
 let BigMod BigRand p -> x in
 let BigExpn g x p -> y in
 [[p g y] x];;

fun _CRPgetkeys()=
 let CRPcreate 64 -> [[p g y] x] in
 let (BigToString p)::(BigToString g)::(BigToString y)::nil -> pub in
  [strbuild pub::nil strbuild ((BigToString x)::pub)::nil];;
  
fun _CRPdecrypt(k,crypted)=
 if crypted==nil then nil
 else let hd strextr k->[x [p [g [y _]]]] in
 CRPdecrypt crypted [BigFromString p BigFromString g BigFromString y] BigFromString x;;
/* fin cryptage */

fun checkpass(answer,passw,priv)=
 if !strcmp passw _getlongname _CRPdecrypt priv answer "" "#" then 1
 else 0;;
 
fun Aaskpassword(from,u,action,param,ulist,tag)=
 let UtoC u-> cli in
 if cli==nil || param==nil then _DMSreplyTag tag "yes" nil 0
 else let _CRPgetkeys ->[pub priv] in 
 if _DMScreateClientDMI this cli pub
 then
 (_DMStagKeepAlive tag;
  set req=[cli param priv tag]::req;
  0)
 else nil;
 0;;

fun __answer(answer)=
 let search_in_list req @reqbycli DMSsender ->z in
 if z==nil then nil
 else let z->[cli pass priv tag] in
 (set req=remove_from_list req z;
  _DMSdelClientDMI this DMSsender;
  _DMSreplyTag tag (if answer==nil then "cancel" else if checkpass answer pass priv then "yes" else "no") nil 0;
  0);;

fun delcli(client)=__answer nil;;

fun IniDMI(param)=
 _DMSregister this nil @delcli nil;
 _DMSdefineActions this ["askpassword" @Aaskpassword]::nil;;