(* 

Certified email protocol by Abadi, Glew, Horne, and Pinkas
WWW2002

*)
param reconstructOrder = true.
param traceDisplay = long.

(* Public key cryptography *)

fun pk/1.
fun A/2.
reduc decA(y, A(pk(y),x)) = x.

(* Signatures *)

fun S/2.
fun Spk/1.
reduc checkS(Spk(y), S(y, x)) = x.
reduc getS(S(y,x)) = x.

(* Shared key cryptography *)

fun E/2.
reduc decE(y, E(y,x)) = x.

(* Hash function *)

fun H/1.

(* Constants to identify messages *)

data Give/0.      (* Message 1 *)
data Wants/0.     (* Message 2 *)
data Try/0.       (* Message 3 *)
data Released/0.  (* Message 4 *)
data Received/0.  (* For the judge *)

(* Constant authentication modes 
   We encode the authentication modes as pairs:
     BothAuth in the paper is coded (Auth,Auth) 
     SAuth in the paper is coded (Auth,NoAuth)
     TTPAuth in the paper is coded (NoAuth,Auth)
     NoAuth in the paper is coded (NoAuth,NoAuth)
   This makes testing whether S / TTP must authenticate R easier *)

data Auth/0.
data NoAuth/0.

(* Function from R's password to R's name *)

fun PasswdTable/1.

private fun Reply/2. 
reduc ReplyOwnHost(x, q) = Reply(PasswdTable(x), q).

data Null/0.

reduc getAuth(q,NoAuth) = Null;
      getAuth(q,Auth) = q.

(* Build a message *)

private fun Message/3.

(* Secrecy assumptions *)

not TTPDecKey.
not TTPSigKey.

(* Queries *)

query ev:JudgeSays(x,y,z).
query ev:SThinksRhas(x).
query ev:Rhas(x,y,z).
query ev:Rreceived(x).

(* TTPname, Sname are public constants, representing the names
   of the hosts. We allow Sname to send to anybody, not just Rname.
   We also allow the TTP to talk to recipients other than Rname
   (represented by the adversary) on an insecure channel.
   cleartext is a public constant, header of the message from S to R *)	

free c,cleartext,Sname,Judgename,TTPname.
private free TTPSigKey, TTPDecKey, Rpwd.

let processJudge =
  (* S must send TTP's certificate plus other information *)
  in(Judgename, (certif, Sname5, k5, cleartext5, q5, r5, em5));
  let (=Released, S2TTP5, Rname5) = checkS(TTPVerKey, certif) in
  let m5 = decE(k5,em5) in
  let hs5 = H((cleartext5, q5, r5, em5)) in
  if S2TTP5 = A(TTPEncKey, (Sname5, (Auth, Auth), (Give, k5, Rname5, hs5))) then
     (* The judge says that Rname5 has received m5 *)
     event JudgeSays(Received, Rname5, m5)
  else if S2TTP5 = A(TTPEncKey, (Sname5, (NoAuth, Auth), (Give, k5, Rname5, hs5))) then
     (* The judge says that Rname5 has received m5 *)
     event JudgeSays(Received, Rname5, m5).

let processS = 
  (* The attacker chooses possible recipients of the message *)
  in(c, recipient);
  (* The attacker chooses the authentication mode *)
  in(c, (sauth,ttpauth));
  (* Build the message to send *)
  new msgid;
  let m = Message(recipient,msgid,(sauth,ttpauth)) in
  (* Step 1 *)
  new k;
  new qtmp;
  let q = getAuth(qtmp,sauth) in
  let r = getAuth(Reply(recipient,qtmp),sauth) in
  let em = E(k,m) in
  let hs = H((cleartext, q, r, em)) in
  let S2TTP = A(TTPEncKey, (Sname, (sauth,ttpauth), (Give, k, recipient, hs))) in
  event Shas(Sname, k, cleartext, q, r, m);
  out(recipient, (TTPname, em, (sauth,ttpauth), cleartext, q, S2TTP));

  (* Step 4 *)
  !
  in(Sname, inmess4);
  if ttpauth = Auth then
  (
     let (=Released, =S2TTP, =recipient) = checkS(TTPVerKey, inmess4) in
       (* S knows that R has read the message *)
       event SThinksRhas(m);
       (* S sends to the judge the necessary information so that the
          judge says that R has read the message *)
       out(Judgename, (inmess4, Sname, k, cleartext, q, r, em))
     else out(Sname, inmess4)
  ) else (
     let (=Released, =S2TTP) = checkS(TTPVerKey, inmess4) in 
       (* S knows that R has read the message, but cannot go to the judge,
          because in case S is dishonest, he could have queried TTP himself *)
       event SThinksRhas(m)
     else out(Sname, inmess4)
  ).

let processR = 
  (* Step 2 *)
  in(Rname, (=TTPname, em2, (sauth,ttpauth), cleartext2, q2, S2TTP2));
  let r2 = getAuth(Reply(Rname,q2),sauth) in
  let hr = H((cleartext2, q2, r2, em2)) in

  (* Establish the secure channel R-TTP *)
  new secchannel;
  out(ChannelToTTP, Rname);
  out(ChannelToTTP, secchannel);
  let outchannel = (TTPname, secchannel) in
  let inchannel = (Rname, secchannel) in

  event Rhas(secchannel,em2,hr);
  out(outchannel, (S2TTP2, (Wants, getAuth(Rpwd,ttpauth), hr)));

  (* Step 3 *)
  !
  in(inchannel, (=Try, k3, =hr));
  let m3 = decE(k3, em2) in
  (* R has obtained the message m3 = m *)
  event Rreceived(m3).

let processTTP = 
  (* Establish the secure channel R-TTP *)
  in(ChannelToTTP, receivername);
  in(ChannelToTTP, secchannel);
  let inchannel = (TTPname, secchannel) in
  let outchannel = (receivername, secchannel) in

  (* Step 3 *)
  in(inchannel, (S2TTP3, (=Wants, RPwd3, hr3)));
  let (Sname3, (sauth3,ttpauth3), (=Give, k3, R3, =hr3)) = 
     decA(TTPDecKey, S2TTP3) in
  if R3 = receivername then
  (
     if (ttpauth3, R3) = (Auth, PasswdTable(RPwd3)) then

        (* Records the event *)
        event TTPSendS(Sname3,S(TTPSigKey, (Released, S2TTP3, R3)));
        event TTPSendR(outchannel, (Try, k3, hr3));

        (* Step 3 *)
        out(outchannel, (Try, k3, hr3));
   
        (* Step 4 *)
        out(Sname3, S(TTPSigKey, (Released, S2TTP3, R3)))

    else if ttpauth3 = NoAuth then

        (* Records the event *)
        event TTPSendS2(Sname3,S(TTPSigKey, (Released, S2TTP3)));
        event TTPSendR2(outchannel, (Try, k3, hr3));

        (* Step 3 *)
        out(outchannel, (Try, k3, hr3));

        (* Step 4 *)
        out(Sname3, S(TTPSigKey, (Released, S2TTP3)))
  ).


process let TTPEncKey = pk(TTPDecKey) in
        out(c, TTPEncKey);
        let TTPVerKey = Spk(TTPSigKey) in
	out(c, TTPVerKey);
	let Rname = PasswdTable(Rpwd) in
	out(c, Rname);
        new ChannelToTTP; 
        ((!processS) | (!processJudge) | (!processR) | (!processTTP) |
         (!in(c,m); out(ChannelToTTP,m)))

