(*

WooLam shared-key auth protocol
Corrections of Gordon, Jeffrey CSFW'01

A -> B : A
B -> A : N (fresh)
A -> B : { m3, B, N }_kAS
B -> S : A,B,{ m3, B, N }_kAS
S -> B : { m5, A, N }_kBS
B: verify { m5, A, N }_kBS = the message from S

Correct.

Full agreement is wrong because the adversary can make B see something
different from { m3, B, N }_kAS (even though the server and A correctly see it)
so this is no real attack.

*)

free c: channel.

type tag.
type host.
type nonce.
type key.

(* Tags *)

const m3: tag [data].
const m5: tag [data].

(* Shared key encryption *)

fun encrypt(bitstring,key): bitstring.
reduc forall x: bitstring, y: key; decrypt(encrypt(x,y),y) = x.

(* Secrecy assumptions *)

not attacker(new Kas).
not attacker(new Kbs).

(* 2 honest host names A and B *)

free A, B: host.

(* the table host names/keys 
   The key table consists of pairs 
   (host, key shared between the host and the server) *)
table keys(host, key).

(* Queries *)

event beginBparam(host, host).
event endBparam(host, host).
event beginBfull(host, host, nonce).
event endBfull(host, host, nonce).

query x: host, y: host; inj-event(endBparam(x,y)) ==> inj-event(beginBparam(x,y)).
query x: host, y: host, z: nonce; inj-event(endBfull(x,y,z)) ==> inj-event(beginBfull(x,y,z)).

(* Role of the initiator with identity xA and key kas shared with S *)

let processInitiator =
        (* The attacker starts the initiator by choosing identity xA,
	   and its interlocutor xB2.
	   We check that xA is honest (i.e. is A or B)
	   and get its corresponding key.
	*)
        in(c, (xA: host, xB2: host));
	if xA = A || xA = B then
	get keys(=xA, kas) in
	(* Real start of the role *)
	event beginBparam(xA,xB2);
        out(c,xA);
	in(c,n: nonce); 
	event beginBfull(xA, xB2, n);
        out(c, encrypt((m3, xB2, n), kas)).

(* Role of the responder with identity xB and key kbs shared with S *)

let processResponder =
        (* The attacker starts the responder by choosing identity xB.
	   We check that xB is honest (i.e. is A or B)
	   and get its corresponding key. *)
        in(c, xB: host);
	if xB = A || xB = B then
	get keys(=xB, kbs) in
	(* Real start of the role *)
	in(c, xA2: host); 
	new N: nonce; 
	out(c, N); 
	in(c, m: bitstring);
        out(c, (xA2, xB, m));
        in(c, m2: bitstring);
	let (=m5, =xA2, =N) = decrypt(m2, kbs) in
        (* OK *)
        if xA2 = A || xA2 = B then 
	event endBparam(xA2, xB);
	event endBfull(xA2, xB, N).

(* Server *)

let processS =
	in(c, (xA1: host, xB1: host, m2: bitstring));
	get keys(=xB1, kbs) in
	get keys(=xA1, kas) in
	let (=m3, =xB1, n:nonce) = decrypt(m2, kas) in
        out(c, encrypt((m5, xA1, n), kbs)).

(* Key registration *)

let processK =
        in(c, (h: host, k: key));
        if h <> A && h <> B then insert keys(h,k).

(* Start process *)

process
	new Kas: key; new Kbs: key;
	insert keys(A, Kas);
	insert keys(B, Kbs);
	(
          (* Launch an unbounded number of sessions of the initiator *)
          (!processInitiator) | 
          (* Launch an unbounded number of sessions of the responder *)
          (!processResponder) |
          (* Launch an unbounded number of sessions of the server *)
          (!processS) |
          (* Key registration process *)
	  (!processK)
        )

