(* Needham Schroeder shared key protocol.
   With messages of key confirmation, in order to prove correspondence
   properties. The secrecy is wrong, because of key confirmation messages.
 *)

ifdef(`ProVerif',`
(* Parameters required to prove the first query and disprove the second query. *)
set preciseActions = true.
set nounifIgnoreAFewTimes = auto.
')

(* Example updated from CV 1.28 by Benjamin Beurdouche *)

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;
out_game "g1.cv";
crypto int_ctxt_corrupt(enc) k_9; (* we need the _corrupt version because k_9 = keyA may leak *)
success (* proves inj-event(partA(B,x)) ==> inj-event(partB(A,x)) *)
}

param NA, NB, NS, NK.

type nonce [large,fixed].
type host [bounded].
type key [fixed,large].
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):bitstring [data].

fun minusone(nonce):nonce [data].
fun nonceToBitstring(nonce):bitstring [data].


(* Internal structure of terms only are considered in Cryptoverif *)
ifdef(`CryptoVerif',`
equation forall y:key,z:host,y2:nonce,z2:host,t2:key,v2:bitstring;
	concat3(y,z) <> 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;
	concat2(z,t) <> concat3(y2,z2).
equation forall x:nonce; minusone(x) <> x.

(* 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;
	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.
')


(* Peers *)
const A : host.
const B : host.
fun acceptA(host):bitstring.
fun acceptB(host):bitstring.

(* Queries and Events *)
event partA(host, bitstring).
event fullA(host, key, bitstring).
event partB(host, bitstring).
event fullB(host, key, bitstring).

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. 
      (* This property is wrong for this script: 
      	 after a first session, the adversary has keyA = k, 
	 he can then replay the first message to B, 
	 decrypt {NB}k, and encrypt {NB-1}k. *)
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]. 
      (* Key keyA is not secret in the computational sense 
      	 because it is used for encrypting and decrypting messages *)

(* Channels and Processes *)
channel c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14,
	c15, c16, c17, start, cAK, cBK.

let processA(Kas: key) =
	in(c1, h: host);
   	new Na: nonce;
   	out(c3, (A, h, Na)); (* To server *)
   	in(c4, m2: bitstring); (* From server *)
   	let injbot(concat1(=Na, =h, k, m)) = dec(m2, Kas) in
	out(c5, m); (* To B *)
	in(c15, e4:bitstring); (* From B *)
	let injbot(nonceToBitstring(Nb)) = dec(e4, k) in
	let e5 = enc(nonceToBitstring(minusone(Nb)), k) in
	event partA(h, (m,e4));
	event fullA(h, k, (m,e4,e5));
	if h = B then
	(
	let keyA:key = k in out(c16, (e5, acceptA(h)))
	)
	else
	(
	out(c16, (e5, acceptA(h))); in(cAK, ()); out(cAK, k)
	).

let processB(Kbs: key) =
	in(c8, m4: bitstring);
	let injbot(concat3(k, h)) = dec(m4, Kbs) in
	new Nb:nonce;
	let e3 = enc(nonceToBitstring(Nb), k) in
	event partB(h, (m4,e3));
	out(c14, e3);
	in(c17, e6:bitstring);
	if injbot(nonceToBitstring(minusone(Nb))) = dec(e6, k) then
	event fullB(h, k, (m4,e3,e6));
	if h = A then
	(
	out(c13, acceptB(h))
	)
	else
	(
	out(c13, 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));
	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(c11, e4).

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


(* EXPECTED
RESULT Could not prove one-session secrecy of keyA; secrecy of keyA; inj-event(fullB(A, k, x)) ==> inj-event(fullA(B, k, x)) with public variables keyA.
0.452s (user 0.444s + system 0.008s), max rss 27192K
END *)

(* EXPECTPV
RESULT inj-event(partA(B,x)) ==> inj-event(partB(A,x)) public_vars keyA is true.
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 (even event(fullB(A,k_3,x)) ==> event(fullA(B,k_3,x)) is false.)
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.264s (user 0.256s + system 0.008s), max rss 14320K
END *)
