(* Needham Schroeder shared key protocol.
   Removed last two messages of key confirmation, so that
   the secrecy of the key is preserved in the cryptographic sense.
   Semantic security of the key should not be preserved, due to a
   (well-known) flaw in the protocol.
 *)

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 concat3(key, host):bitstring [data].

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

(* The function Z returns for each bitstring, a bitstring
   of the same length, consisting only of zeroes. *)
fun Zconcat1(bitstring):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:key,z:host; 
	Z(concat3(y,z)) = 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, 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);
        new Na: nonce;
        out(c2, (A, h, Na));
        in(c3, 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(c4, (m, acceptA(h)))
	)
	else 
	(
	out(c4, (m, acceptA(h))); in(cAK, ()); out(cAK, k)
	).

let processB(Kbs:key) =
	in(c5, m4: bitstring);
	let injbot(concat3(k, h)) = dec(m4, Kbs) in
	event fullB(h, k, m4);
	if h = A then
	(
	out(c9, acceptB(h))
	)
	else 
	(
	out(c9, acceptB(h)); in(cBK, ()); out(cBK, k)
	).

table keys(host, key).

let processK(Kas:key, Kbs:key) =
   in(c6, (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(c7, (h1: host, h2: host, n: nonce));
	get keys(=h1, kh1) in
	get keys(=h2, kh2) in
	new k: key;
	let e3 = enc(concat3(k, h1),kh2) in
	let e4 = enc(concat1(n, h2, k, e3), kh1) in
	out(c8, 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; event(partA(B, x)) ==> event(partB(A, x)) with public variables keyA.
0.316s (user 0.296s + system 0.020s), max rss 24816K
END *)

(* EXPECTPV
RESULT event(partA(B,x)) ==> event(partB(A,x)) public_vars keyA is false.
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 (even event(partA(B,x)) ==> event(partB(A,x)) is false.)
RESULT inj-event(fullB(A,k_3,x)) ==> inj-event(fullA(B,k_3,x)) public_vars keyA is false.
RESULT (query encoded as inj-event(fullB(A,k_3,x)) ==> inj-event(fullA(B,k_3,x)))
RESULT (but event(fullB(A,k_3,x)) ==> event(fullA(B,k_3,x)) 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.104s (user 0.104s + system 0.000s), max rss 11392K
END *)
