(* 

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

*)

(* param eqInNames = true. *)
param redundantHypElim = beginOnly.

(* 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.

ifdef(`PROP4',

(* It is assumed that an attacker cannot relate q and r = Reply(h,q) 
   except for the hosts h it creates itself *)

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

,
ifdef(`SECRECY',

(* It is assumed that an attacker cannot relate q and r = Reply(h,q) 
   except for the hosts h it creates itself *)

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

,

(* R or S are included in the adversary, so the adversary can compute Reply *)

fun Reply/2.

))

data Null/0.

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

param movenew = false.

(* Build a message *)

private fun Message/3.

(* Secrecy assumptions *)

not TTPDecKey.
not TTPSigKey.

(* Queries *)

ifdef(`PROP1',`
  (* For proposition 1, we want to know under which
     conditions the adversary can have the message sent by S,
     when TTP authenticates R *)
  query putbegin ev:Shas, TTPSendS;
	ev:Rreceived(Message(x,y,(z,Auth))).
')
ifdef(`PROP2',`
  query putbegin ev:Rhas, TTPSendR;
	ev:JudgeSays(Received,PasswdTable(Rpwd),x).
')
ifdef(`PROP3',`
  (* For proposition 3, we want to know under which
     conditions the adversary can have the message sent by S *)
  query putbegin ev:Shas, TTPSendS, TTPSendS2;
	ev:Rreceived(Message(x,y,z)).
')
ifdef(`PROP4',`
  query putbegin ev:Rhas, TTPSendR, TTPSendR2;
	ev:SThinksRhas(Message(PasswdTable(Rpwd),y,(Auth,z))).
')
ifdef(`SECRECY',
  (* For secrecy, we also want to know under which
     conditions the adversary can have the message sent by S
     to R, that is Message(PasswdTable(Rpwd),x,z).
   *)
  query attacker:Message(PasswdTable(Rpwd),x,z).
)

(* 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 =
ifdef(`PROP4',
  0.
,ifdef(`PROP3',
  0.
,ifdef(`SECRECY',
  0.
,
  (* 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 = 
ifdef(`PROP2',
  (* S is included in the adversary *)
  0.
,
  (* 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);
     ifdef(`SECRECY',0,
       (* 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 = 
ifdef(`PROP3',
  (* R is included in the adversary *)
  out(c, RsecchannelToTTP);
  out(c, RsecchannelFromTTP);
  out(c, Rpwd)
  |
  in(c,m);
  event Rreceived(m).
,
ifdef(`PROP1',
  (* R is included in the adversary *)
  out(c, RsecchannelToTTP);
  out(c, RsecchannelFromTTP);
  out(c, Rpwd)
  |
  in(c,m);
  event Rreceived(m).
,
  (* 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
  event Rhas(idTTPtoR,em2,hr);

  out(RsecchannelToTTP, (S2TTP2, (Wants, getAuth(Rpwd,ttpauth), hr)));

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

let processTTP = 
  (* Step 3 *)
  in(TTPsecchannelFromR, (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(idTTPtoR, (Try, k3, hr3));

        (* Step 3 *)
        out(TTPsecchannelToR, (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(idTTPtoR, (Try, k3, hr3));

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

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


(* When establishing a connection, R always first sends its IP
   address. *)

(****** SECURE CHANNEL R-TTP BUILT WITH AN ASYMMETRIC CHANNEL ******)

ifdef(`CHTOTTP',

let processRandTTP =
  new ChannelToTTP; 
  ((  !
      in(c,m);
      out(ChannelToTTP,m)
   ) 
   | 
   (  !
      (* R *)
      new secchannel;
      out(ChannelToTTP, Rname);
      out(ChannelToTTP, secchannel);
      let idTTPtoR = (Rname,secchannel) in
      let RsecchannelToTTP = (TTPname,secchannel) in
      let RsecchannelFromTTP = (Rname,secchannel) in
      processR
   )
   |
   (  !
      (* TTP *)
      in(ChannelToTTP, receivername);
      in(ChannelToTTP, secchannel);
      let idTTPtoR = (receivername,secchannel) in
      let TTPsecchannelToR = (receivername,secchannel) in
      let TTPsecchannelFromR = (TTPname,secchannel) in
      processTTP
   )).

)

(****** SECURE CHANNEL R-TTP BUILT WITH A SIMPLE PUBLIC KEY PROTOCOL ******)

ifdef(`PKCHANNEL', 

data ChKey/0.

let processRandTTP = 
  (  !  
     (* R *)
     new shkey;
     out(TTPname, Rname);
     out(TTPname, A(TTPEncKey, (ChKey,shkey)));

     let idTTPtoR = shkey in
     new RsecchannelToTTP;
     new RsecchannelFromTTP;

     (  !
        in(RsecchannelToTTP, m);
	out(TTPname,  E(shkey, m))
     )
     |
     (  !
        in(Rname, mR);
        out(RsecchannelFromTTP, decE(shkey, mR))
     )
     |
     processR
  )
  |
  (  !
     (* TTP *)
     in(TTPname, receivername);
     in(TTPname, m1);
     let (=ChKey,shkey) = decA(TTPDecKey, m1) in
     let idTTPtoR = shkey in
     new TTPsecchannelToR;
     new TTPsecchannelFromR;
     (  !
        in(TTPsecchannelToR, m);
        out(receivername,  E(shkey, m))
     )
     |
     (  !
        in(TTPname, mTTP); 
        out(TTPsecchannelFromR,decE(shkey, mTTP))
     )
     |
     processTTP
  ).

)

(****** SECURE CHANNEL R-TTP BUILT BY SSH ******)

(* In fact, we consider a simplified version of SSH, without negociation.
   We assume that the chosen parameters are 
   - the standard Diffie-Hellman key exchange
   - a symmetric encryption algorithm (different from none)
   - a mac algorithm (different from none)
   - no compression
   We do not consider key re-exchange.

   Only the transport layer protocol of SSH is considered. The 
   authentication is performed by the certified mail protocol,
   so we do not consider the SSH authentication protocol.

   In the computation of the mac, we ignore the sequence of the
   messages (difficult to model in our framework). Also note
   that the mac is really useful only when the encryption is malleable,
   and we model a perfect encryption that is not malleable.
 *)

ifdef(`SSH', 

(* Non-message revealing signatures *)

fun nmrS/2.
data true/0.
reduc checknmrS(Spk(y), nmrS(y,x), x) = true.

(* Diffie-Hellman *)

fun f/2.
fun g/1.
equation f(x,g(y)) = f(y,g(x)).

(* Mac *)

fun mac/2.

(* Constants *)

data KEXDHINIT/0.
data KEXDHREPLY/0.

data keyEncTTPtoR/0.
data keyEncRtoTTP/0.
data keyMacTTPtoR/0.
data keyMacRtoTTP/0.

(* Secrecy assumptions *)

not dhsecretR[].
not dhsecretTTP[].

let processRandTTP = 
  ( !
    (* R: Create a channel with TTP *)
    new dhsecretR;
    let dhpublicR = g(dhsecretR) in
    out(TTPname, Rname);
    out(TTPname, (KEXDHINIT, dhpublicR));
    in(Rname, (=KEXDHREPLY, =TTPVerKey, dhpublicTTP, sign));
    let K = f(dhsecretR, dhpublicTTP) in
    let h = H((TTPVerKey, dhpublicR, dhpublicTTP, K)) in
    if checknmrS(TTPVerKey, sign, h) = true then
    let enckeyRtoTTP = H((K, h, keyEncRtoTTP)) in
    let enckeyTTPtoR = H((K, h, keyEncTTPtoR)) in
    let mackeyRtoTTP = H((K, h, keyMacRtoTTP)) in
    let mackeyTTPtoR = H((K, h, keyMacTTPtoR)) in

    let idTTPtoR = (Rname,enckeyTTPtoR, mackeyTTPtoR) in
    new RsecchannelToTTP;
    new RsecchannelFromTTP;

    (! in(RsecchannelToTTP, m2payload);
       out(TTPname, (E(enckeyRtoTTP, m2payload), mac(mackeyRtoTTP, m2payload)))
    ) 
    |
    (! in (Rname,(m4enc, m4mac));
       let m4payload = decE(enckeyTTPtoR, m4enc) in
       if m4mac = mac(mackeyTTPtoR, m4payload) then
       out(RsecchannelFromTTP, m4payload))
    |
    processR
  )
  |
  ( !
    (* TTP: Create a channel with R *)
    in(TTPname, receivername);
    in(TTPname, (=KEXDHINIT, dhpublicR));
    new dhsecretTTP;
    let dhpublicTTP = g(dhsecretTTP) in
    let K = f(dhsecretTTP, dhpublicR) in
    let h = H((TTPVerKey, dhpublicR, dhpublicTTP, K)) in
    out(receivername, (KEXDHREPLY, TTPVerKey, dhpublicTTP, nmrS(TTPSigKey, h)));
    let enckeyRtoTTP = H((K, h, keyEncRtoTTP)) in
    let enckeyTTPtoR = H((K, h, keyEncTTPtoR)) in
    let mackeyRtoTTP = H((K, h, keyMacRtoTTP)) in
    let mackeyTTPtoR = H((K, h, keyMacTTPtoR)) in

    let idTTPtoR = (receivername,enckeyTTPtoR, mackeyTTPtoR) in
    new TTPsecchannelToR;
    new TTPsecchannelFromR;

    (! in(TTPsecchannelToR, m3payload);
       out(receivername, (E(enckeyTTPtoR, m3payload), mac(mackeyTTPtoR, m3payload)))
    )
    |
    (! in(TTPname, (m2enc,m2mac));
       let m2payload = decE(enckeyRtoTTP, m2enc) in
       if m2mac = mac(mackeyRtoTTP, m2payload) then
       out(TTPsecchannelFromR, m2payload)
    )
    |
    processTTP
  ).

)

(****** COMMON PART FOR ANY WAY OF BUILDING THE SECURE CHANNEL ******)

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);
        ((!processS) | (!processJudge) | processRandTTP)

  (* processRandTTP defines the two processes for R and TTP
     using processR and processTTP.

     It must define two channels RsecchannelToTTP and
     RsecchannelFromTTP above processR. processR uses these
     channels to communicate with TTP.

     Similarly, it must define two channels TTPsecchannelToR
     and TTPsecchannelFromR above processTTP, that processTTP
     uses to communicate with R. It must also define receivername,
     above processTTP. This identifier is used as address of the 
     receiver of the message TTP->R, and TTP will check that it is
     correctly set.
     
     At last, it must define idTTPtoR above both processTTP and
     processR. This identifier is used in events, to check that
     the channel TTP->R is the same from the point of views of 
     R and TTP.
  *)

ifdef(`CHTOTTP',`
ifdef(`SECRECY',`
(* EXPECTPV FILENAME: examples/pi/mailprotAbadi/onefile2/protocol.m4.pi TAG: 1
RESULT not attacker:Message(PasswdTable(Rpwd[]),x,z) is false.
0.120s (user 0.096s + system 0.024s), max rss 10828K
END *)
')
ifdef(`PROP1',`
(* EXPECTPV FILENAME: examples/pi/mailprotAbadi/onefile2/protocol.m4.pi TAG: 2
RESULT not ev:Rreceived(Message(x,y,(z,Auth()))) cannot be proved.
0.128s (user 0.108s + system 0.020s), max rss 11380K
END *)
')
ifdef(`PROP2',`
(* EXPECTPV FILENAME: examples/pi/mailprotAbadi/onefile2/protocol.m4.pi TAG: 3
RESULT not ev:JudgeSays(Received(),PasswdTable(Rpwd[]),x) cannot be proved.
0.060s (user 0.044s + system 0.016s), max rss 9852K
END *)
')
ifdef(`PROP3',`
(* EXPECTPV FILENAME: examples/pi/mailprotAbadi/onefile2/protocol.m4.pi TAG: 4
RESULT not ev:Rreceived(Message(x,y,z)) cannot be proved.
0.172s (user 0.140s + system 0.032s), max rss 11840K
END *)
')
ifdef(`PROP4',`
(* EXPECTPV FILENAME: examples/pi/mailprotAbadi/onefile2/protocol.m4.pi TAG: 5
RESULT not ev:SThinksRhas(Message(PasswdTable(Rpwd[]),y,(Auth(),z))) cannot be proved.
0.260s (user 0.240s + system 0.020s), max rss 14396K
END *)
')
')
ifdef(`PKCHANNEL',`
ifdef(`SECRECY',`
(* EXPECTPV FILENAME: examples/pi/mailprotAbadi/onefile2/protocol.m4.pi TAG: 6
RESULT not attacker:Message(PasswdTable(Rpwd[]),x,z) is false.
0.132s (user 0.108s + system 0.024s), max rss 11268K
END *)
')
ifdef(`PROP1',`
(* EXPECTPV FILENAME: examples/pi/mailprotAbadi/onefile2/protocol.m4.pi TAG: 7
RESULT not ev:Rreceived(Message(x,y,(z,Auth()))) cannot be proved.
0.132s (user 0.112s + system 0.020s), max rss 11104K
END *)
')
ifdef(`PROP2',`
(* EXPECTPV FILENAME: examples/pi/mailprotAbadi/onefile2/protocol.m4.pi TAG: 8
RESULT not ev:JudgeSays(Received(),PasswdTable(Rpwd[]),x) cannot be proved.
0.080s (user 0.064s + system 0.016s), max rss 10680K
END *)
')
ifdef(`PROP3',`
(* EXPECTPV FILENAME: examples/pi/mailprotAbadi/onefile2/protocol.m4.pi TAG: 9
RESULT not ev:Rreceived(Message(x,y,z)) is false.
0.136s (user 0.116s + system 0.020s), max rss 11892K
END *)
')
ifdef(`PROP4',`
(* EXPECTPV FILENAME: examples/pi/mailprotAbadi/onefile2/protocol.m4.pi TAG: 10
RESULT not ev:SThinksRhas(Message(PasswdTable(Rpwd[]),y,(Auth(),z))) cannot be proved.
0.232s (user 0.212s + system 0.020s), max rss 15296K
END *)
')
')
ifdef(`SSH',`
ifdef(`SECRECY',`
(* EXPECTPV FILENAME: examples/pi/mailprotAbadi/onefile2/protocol.m4.pi TAG: 11
RESULT not attacker:Message(PasswdTable(Rpwd[]),x,z) is false.
0.368s (user 0.340s + system 0.028s), max rss 19032K
END *)
')
ifdef(`PROP1',`
(* EXPECTPV FILENAME: examples/pi/mailprotAbadi/onefile2/protocol.m4.pi TAG: 12
RESULT not ev:Rreceived(Message(x,y,(z,Auth()))) cannot be proved.
0.712s (user 0.688s + system 0.024s), max rss 26792K
END *)
')
ifdef(`PROP2',`
(* EXPECTPV FILENAME: examples/pi/mailprotAbadi/onefile2/protocol.m4.pi TAG: 13
RESULT not ev:JudgeSays(Received(),PasswdTable(Rpwd[]),x) cannot be proved.
0.772s (user 0.728s + system 0.044s), max rss 64636K
END *)
')
ifdef(`PROP3',`
(* EXPECTPV FILENAME: examples/pi/mailprotAbadi/onefile2/protocol.m4.pi TAG: 14
RESULT not ev:Rreceived(Message(x,y,z)) is false.
1.144s (user 1.116s + system 0.028s), max rss 29608K
END *)
')
ifdef(`PROP4',`
(* EXPECTPV FILENAME: examples/pi/mailprotAbadi/onefile2/protocol.m4.pi TAG: 15
RESULT not ev:SThinksRhas(Message(PasswdTable(Rpwd[]),y,(Auth(),z))) cannot be proved.
4.152s (user 4.100s + system 0.052s), max rss 157916K
END *)
')
')
