(* Needham Schroeder shared key protocol.
   Corrected version.
   Removed last two messages of key confirmation, so that
   the secrecy of the key is preserved in the cryptographic sense. *)

proof {
crypto int_ctxt(enc) Kas_1; (* applying that first allows to prove event(fullA(B,k,x)) && event(fullB(A,k',x)) ==> k = k' *)
auto
}

param NA, NB, NS, NK.

type nonce [large,fixed].
type host [bounded].
type key [fixed].
type enc_seed [fixed].

(* Shared-key encryption (IND-CPA + INT-CTXT Stream cipher) *)

proba Penc.
proba Pencctxt.

expand IND_CPA_INT_CTXT_sym_enc_all_args(key, bitstring, bitstring, enc_seed, enc, enc_r, enc_r', dec, injbot, Z, Penc, Pencctxt).

(* Utility functions *)
fun concat1(nonce, host, key, bitstring):bitstring [data].
fun concat2(host, nonce):bitstring [data].
fun concat3(key, host, nonce):bitstring [data].

ifdef(`CryptoVerif',`
equation forall y:key,z:host,t:nonce,y2:nonce,z2:host,t2:key,v2:bitstring;
	concat3(y,z,t) <> concat1(y2,z2,t2,v2).
equation forall z:host,t:nonce,y2:nonce,z2:host,t2:key,v2:bitstring;
	concat2(z,t) <> concat1(y2,z2,t2,v2).
equation forall z:host,t:nonce,y2:key,z2:host,t2:nonce;
	concat2(z,t) <> concat3(y2,z2,t2).

(* The function Z returns for each bitstring, a bitstring
   of the same length, consisting only of zeroes. *)
fun Zconcat1(bitstring):bitstring.
const Zconcat2:bitstring.
const Zconcat3:bitstring.
equation forall y:nonce,z:host,t:key,u:bitstring;
	Z(concat1(y,z,t,u)) = Zconcat1(Z(u)).
equation forall y:host,z:nonce; 
	Z(concat2(y,z)) = Zconcat2.
equation forall y:key,z:host,t:nonce; 
	Z(concat3(y,z,t)) = Zconcat3.
equation forall m:bitstring, k:key, r:enc_seed; 
	Z(enc_r(m, k, r)) = Z(m).
',`
const Zbitstring:bitstring.
equation forall x:bitstring; Z(x) = Zbitstring.
')

(* Queries *)

channel c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13,
	start, cAK, cBK.
const A : host.
const B : host.
fun acceptA(host):bitstring.
fun acceptB(host):bitstring.

event partA(host, bitstring).
event fullA(host, key, bitstring).
event partB(host, bitstring).
event fullB(host, key, bitstring).

query x:bitstring;
      event(partA(B,x)) ==> event(partB(A,x)) public_vars keyA.
query x:bitstring, k:key;
      event(fullB(A,k,x)) ==> event(fullA(B,k,x)) public_vars keyA.
query x:bitstring;
      inj-event(partA(B,x)) ==> inj-event(partB(A,x)) public_vars keyA.
query x:bitstring, k:key;
      inj-event(fullB(A,k,x)) ==> inj-event(fullA(B,k,x)) public_vars keyA. 
query x:bitstring, k:key, k':key;
      event(fullA(B,k,x)) && event(fullB(A,k',x)) ==> k = k' public_vars keyA. 

query secret keyA.
query secret keyA [cv_onesession]. 

let processA(Kas: key) =
	in(c1, (h: host, bm: bitstring));
        new Na: nonce;
        out(c3, (A, h, Na, bm));
        in(c4, m2: bitstring);
        let injbot(concat1(=Na, =h, k, m)) = dec(m2, Kas) in
	(* last message and OK *)
	event partA(h, ());	
	event fullA(h, k, m);
	if h = B then
	(
	let keyA:key = k in out(c5, (m, acceptA(h)))
	)
	else 
	(
	out(c5, (m, acceptA(h))); in(cAK, ()); out(cAK, k)
	).

let processB(Kbs: key) =
	in(c6, h: host);
	new J: nonce;
	let e2 = enc(concat2(h,J), Kbs) in
	event partB(h, ());
	out(c7, e2);
	in(c8, m4: bitstring);
	let injbot(concat3(k, =h, =J)) = dec(m4, Kbs) in
	(* OK *)
	event fullB(h, k, m4);
	if h = A then
	(
	out(c12, acceptB(h))
	)
	else 
	(
	out(c12, acceptB(h)); in(cBK, ()); out(cBK, k)
	).

table keys(host, key).

let processK(Kas:key, Kbs:key) =
   in(c9, (Khost: host, Kkey: key));
   if Khost = A then
      insert keys(A,Kas)
   else if Khost = B then
      insert keys(B,Kbs)
   else
      insert keys(Khost,Kkey).

let processS = 
	in(c10, (h1: host, h2: host, n: nonce, bm: bitstring));
	get keys(=h1, kh1) in
	get keys(=h2, kh2) in
	let injbot(concat2(=h1, j)) = dec(bm, kh2) in
	new k: key;
	let e3 = enc(concat3(k, h1, j), kh2) in
	let e4 = enc(concat1(n, h2, k, e3), kh1) in
	out(c11, e4).

process 
	in(start, ());
	new Kas: key;
	new Kbs: key;
	out(c11, ());
    	((! iA <= NA processA(Kas)) |
	 (! iB <= NB processB(Kbs)) |
	 (! iS <= NS processS) |
	 (! iK <= NK processK(Kas,Kbs)))


(* EXPECTED
RESULT Could not prove inj-event(fullB(A, k, x)) ==> inj-event(fullA(B, k, x)) with public variables keyA; inj-event(partA(B, x)) ==> inj-event(partB(A, x)) with public variables keyA; event(fullB(A, k, x)) ==> event(fullA(B, k, x)) with public variables keyA.
0.580s (user 0.560s + system 0.020s), max rss 25212K
END *)

(* EXPECTPV
RESULT event(partA(B,x)) ==> event(partB(A,x)) public_vars keyA is true.
RESULT event(fullB(A,k_3,x)) ==> event(fullA(B,k_3,x)) public_vars keyA is true.
RESULT inj-event(partA(B,x)) ==> inj-event(partB(A,x)) public_vars keyA is false.
RESULT (query encoded as inj-event(partA(B,x)) ==> inj-event(partB(A,x)))
RESULT (but event(partA(B,x)) ==> event(partB(A,x)) is true.)
RESULT inj-event(fullB(A,k_3,x)) ==> inj-event(fullA(B,k_3,x)) public_vars keyA is true.
RESULT event(fullA(B,k_3,x)) && event(fullB(A,k',x)) ==> k_3 = k' public_vars keyA is true.
RESULT secret keyA is true.
RESULT secret keyA is true.
0.080s (user 0.064s + system 0.016s), max rss 12016K
END *)
