Theory ShoupRubin
section‹Original Shoup-Rubin protocol›
theory ShoupRubin imports Smartcard begin
axiomatization sesK :: "nat*key => key"
where
inj_sesK [iff]: "(sesK(m,k) = sesK(m',k')) = (m = m' ∧ k = k')" and
shrK_disj_sesK [iff]: "shrK A ≠ sesK(m,pk)" and
crdK_disj_sesK [iff]: "crdK C ≠ sesK(m,pk)" and
pin_disj_sesK [iff]: "pin P ≠ sesK(m,pk)" and
pairK_disj_sesK[iff]:"pairK(A,B) ≠ sesK(m,pk)" and
Atomic_distrib [iff]: "Atomic`(KEY`K ∪ NONCE`N) =
Atomic`(KEY`K) ∪ Atomic`(NONCE`N)" and
shouprubin_assumes_securemeans [iff]: "evs ∈ sr ⟹ secureM"
definition Unique :: "[event, event list] => bool" ("Unique _ on _") where
"Unique ev on evs ==
ev ∉ set (tl (dropWhile (% z. z ≠ ev) evs))"
inductive_set sr :: "event list set"
where
Nil: "[]∈ sr"
| Fake: "⟦ evsF∈ sr; X∈ synth (analz (knows Spy evsF));
illegalUse(Card B) ⟧
⟹ Says Spy A X #
Inputs Spy (Card B) X # evsF ∈ sr"
| Forge:
"⟦ evsFo ∈ sr; Nonce Nb ∈ analz (knows Spy evsFo);
Key (pairK(A,B)) ∈ knows Spy evsFo ⟧
⟹ Notes Spy (Key (sesK(Nb,pairK(A,B)))) # evsFo ∈ sr"
| Reception: "⟦ evsR∈ sr; Says A B X ∈ set evsR ⟧
⟹ Gets B X # evsR ∈ sr"
| SR1: "⟦ evs1∈ sr; A ≠ Server⟧
⟹ Says A Server ⦃Agent A, Agent B⦄
# evs1 ∈ sr"
| SR2: "⟦ evs2∈ sr;
Gets Server ⦃Agent A, Agent B⦄ ∈ set evs2 ⟧
⟹ Says Server A ⦃Nonce (Pairkey(A,B)),
Crypt (shrK A) ⦃Nonce (Pairkey(A,B)), Agent B⦄
⦄
# evs2 ∈ sr"
| SR3: "⟦ evs3∈ sr; legalUse(Card A);
Says A Server ⦃Agent A, Agent B⦄ ∈ set evs3;
Gets A ⦃Nonce Pk, Certificate⦄ ∈ set evs3 ⟧
⟹ Inputs A (Card A) (Agent A)
# evs3 ∈ sr"
| SR4: "⟦ evs4∈ sr; A ≠ Server;
Nonce Na ∉ used evs4; legalUse(Card A);
Inputs A (Card A) (Agent A) ∈ set evs4 ⟧
⟹ Outpts (Card A) A ⦃Nonce Na, Crypt (crdK (Card A)) (Nonce Na)⦄
# evs4 ∈ sr"
| SR4Fake: "⟦ evs4F∈ sr; Nonce Na ∉ used evs4F;
illegalUse(Card A);
Inputs Spy (Card A) (Agent A) ∈ set evs4F ⟧
⟹ Outpts (Card A) Spy ⦃Nonce Na, Crypt (crdK (Card A)) (Nonce Na)⦄
# evs4F ∈ sr"
| SR5: "⟦ evs5∈ sr;
Outpts (Card A) A ⦃Nonce Na, Certificate⦄ ∈ set evs5;
∀ p q. Certificate ≠ ⦃p, q⦄ ⟧
⟹ Says A B ⦃Agent A, Nonce Na⦄ # evs5 ∈ sr"
| SR6: "⟦ evs6∈ sr; legalUse(Card B);
Gets B ⦃Agent A, Nonce Na⦄ ∈ set evs6 ⟧
⟹ Inputs B (Card B) ⦃Agent A, Nonce Na⦄
# evs6 ∈ sr"
| SR7: "⟦ evs7∈ sr;
Nonce Nb ∉ used evs7; legalUse(Card B); B ≠ Server;
K = sesK(Nb,pairK(A,B));
Key K ∉ used evs7;
Inputs B (Card B) ⦃Agent A, Nonce Na⦄ ∈ set evs7⟧
⟹ Outpts (Card B) B ⦃Nonce Nb, Key K,
Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄,
Crypt (pairK(A,B)) (Nonce Nb)⦄
# evs7 ∈ sr"
| SR7Fake: "⟦ evs7F∈ sr; Nonce Nb ∉ used evs7F;
illegalUse(Card B);
K = sesK(Nb,pairK(A,B));
Key K ∉ used evs7F;
Inputs Spy (Card B) ⦃Agent A, Nonce Na⦄ ∈ set evs7F ⟧
⟹ Outpts (Card B) Spy ⦃Nonce Nb, Key K,
Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄,
Crypt (pairK(A,B)) (Nonce Nb)⦄
# evs7F ∈ sr"
| SR8: "⟦ evs8∈ sr;
Inputs B (Card B) ⦃Agent A, Nonce Na⦄ ∈ set evs8;
Outpts (Card B) B ⦃Nonce Nb, Key K,
Cert1, Cert2⦄ ∈ set evs8 ⟧
⟹ Says B A ⦃Nonce Nb, Cert1⦄ # evs8 ∈ sr"
| SR9: "⟦ evs9∈ sr; legalUse(Card A);
Gets A ⦃Nonce Pk, Cert1⦄ ∈ set evs9;
Outpts (Card A) A ⦃Nonce Na, Cert2⦄ ∈ set evs9;
Gets A ⦃Nonce Nb, Cert3⦄ ∈ set evs9;
∀ p q. Cert2 ≠ ⦃p, q⦄ ⟧
⟹ Inputs A (Card A)
⦃Agent B, Nonce Na, Nonce Nb, Nonce Pk,
Cert1, Cert3, Cert2⦄
# evs9 ∈ sr"
| SR10: "⟦ evs10∈ sr; legalUse(Card A); A ≠ Server;
K = sesK(Nb,pairK(A,B));
Inputs A (Card A) ⦃Agent B, Nonce Na, Nonce Nb,
Nonce (Pairkey(A,B)),
Crypt (shrK A) ⦃Nonce (Pairkey(A,B)),
Agent B⦄,
Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄,
Crypt (crdK (Card A)) (Nonce Na)⦄
∈ set evs10 ⟧
⟹ Outpts (Card A) A ⦃Key K, Crypt (pairK(A,B)) (Nonce Nb)⦄
# evs10 ∈ sr"
| SR10Fake: "⟦ evs10F∈ sr;
illegalUse(Card A);
K = sesK(Nb,pairK(A,B));
Inputs Spy (Card A) ⦃Agent B, Nonce Na, Nonce Nb,
Nonce (Pairkey(A,B)),
Crypt (shrK A) ⦃Nonce (Pairkey(A,B)),
Agent B⦄,
Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄,
Crypt (crdK (Card A)) (Nonce Na)⦄
∈ set evs10F ⟧
⟹ Outpts (Card A) Spy ⦃Key K, Crypt (pairK(A,B)) (Nonce Nb)⦄
# evs10F ∈ sr"
| SR11: "⟦ evs11∈ sr;
Says A Server ⦃Agent A, Agent B⦄ ∈ set evs11;
Outpts (Card A) A ⦃Key K, Certificate⦄ ∈ set evs11 ⟧
⟹ Says A B (Certificate)
# evs11 ∈ sr"
| Oops1:
"⟦ evsO1 ∈ sr;
Outpts (Card B) B ⦃Nonce Nb, Key K, Certificate,
Crypt (pairK(A,B)) (Nonce Nb)⦄ ∈ set evsO1 ⟧
⟹ Notes Spy ⦃Key K, Nonce Nb, Agent A, Agent B⦄ # evsO1 ∈ sr"
| Oops2:
"⟦ evsO2 ∈ sr;
Outpts (Card A) A ⦃Key K, Crypt (pairK(A,B)) (Nonce Nb)⦄
∈ set evsO2 ⟧
⟹ Notes Spy ⦃Key K, Nonce Nb, Agent A, Agent B⦄ # evsO2 ∈ sr"
declare Fake_parts_insert_in_Un [dest]
declare analz_into_parts [dest]
lemma Gets_imp_Says:
"⟦ Gets B X ∈ set evs; evs ∈ sr ⟧ ⟹ ∃ A. Says A B X ∈ set evs"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Gets_imp_knows_Spy:
"⟦ Gets B X ∈ set evs; evs ∈ sr ⟧ ⟹ X ∈ knows Spy evs"
apply (blast dest!: Gets_imp_Says Says_imp_knows_Spy)
done
lemma Gets_imp_knows_Spy_parts_Snd:
"⟦ Gets B ⦃X, Y⦄ ∈ set evs; evs ∈ sr ⟧ ⟹ Y ∈ parts (knows Spy evs)"
apply (blast dest!: Gets_imp_Says Says_imp_knows_Spy parts.Inj parts.Snd)
done
lemma Gets_imp_knows_Spy_analz_Snd:
"⟦ Gets B ⦃X, Y⦄ ∈ set evs; evs ∈ sr ⟧ ⟹ Y ∈ analz (knows Spy evs)"
apply (blast dest!: Gets_imp_Says Says_imp_knows_Spy analz.Inj analz.Snd)
done
lemma Inputs_imp_knows_Spy_secureM_sr:
"⟦ Inputs Spy C X ∈ set evs; evs ∈ sr ⟧ ⟹ X ∈ knows Spy evs"
apply (simp (no_asm_simp) add: Inputs_imp_knows_Spy_secureM)
done
lemma knows_Spy_Inputs_secureM_sr_Spy:
"evs ∈sr ⟹ knows Spy (Inputs Spy C X # evs) = insert X (knows Spy evs)"
apply (simp (no_asm_simp))
done
lemma knows_Spy_Inputs_secureM_sr:
"⟦ A ≠ Spy; evs ∈sr ⟧ ⟹ knows Spy (Inputs A C X # evs) = knows Spy evs"
apply (simp (no_asm_simp))
done
lemma knows_Spy_Outpts_secureM_sr_Spy:
"evs ∈sr ⟹ knows Spy (Outpts C Spy X # evs) = insert X (knows Spy evs)"
apply (simp (no_asm_simp))
done
lemma knows_Spy_Outpts_secureM_sr:
"⟦ A ≠ Spy; evs ∈sr ⟧ ⟹ knows Spy (Outpts C A X # evs) = knows Spy evs"
apply (simp (no_asm_simp))
done
lemma Inputs_A_Card_3:
"⟦ Inputs A C (Agent A) ∈ set evs; A ≠ Spy; evs ∈ sr ⟧
⟹ legalUse(C) ∧ C = (Card A) ∧
(∃ Pk Certificate. Gets A ⦃Pk, Certificate⦄ ∈ set evs)"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Inputs_B_Card_6:
"⟦ Inputs B C ⦃Agent A, Nonce Na⦄ ∈ set evs; B ≠ Spy; evs ∈ sr ⟧
⟹ legalUse(C) ∧ C = (Card B) ∧ Gets B ⦃Agent A, Nonce Na⦄ ∈ set evs"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Inputs_A_Card_9:
"⟦ Inputs A C ⦃Agent B, Nonce Na, Nonce Nb, Nonce Pk,
Cert1, Cert2, Cert3⦄ ∈ set evs;
A ≠ Spy; evs ∈ sr ⟧
⟹ legalUse(C) ∧ C = (Card A) ∧
Gets A ⦃Nonce Pk, Cert1⦄ ∈ set evs ∧
Outpts (Card A) A ⦃Nonce Na, Cert3⦄ ∈ set evs ∧
Gets A ⦃Nonce Nb, Cert2⦄ ∈ set evs"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Outpts_A_Card_4:
"⟦ Outpts C A ⦃Nonce Na, (Crypt (crdK (Card A)) (Nonce Na))⦄ ∈ set evs;
evs ∈ sr ⟧
⟹ legalUse(C) ∧ C = (Card A) ∧
Inputs A (Card A) (Agent A) ∈ set evs"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Outpts_B_Card_7:
"⟦ Outpts C B ⦃Nonce Nb, Key K,
Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄,
Cert2⦄ ∈ set evs;
evs ∈ sr ⟧
⟹ legalUse(C) ∧ C = (Card B) ∧
Inputs B (Card B) ⦃Agent A, Nonce Na⦄ ∈ set evs"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Outpts_A_Card_10:
"⟦ Outpts C A ⦃Key K, (Crypt (pairK(A,B)) (Nonce Nb))⦄ ∈ set evs;
evs ∈ sr ⟧
⟹ legalUse(C) ∧ C = (Card A) ∧
(∃ Na Ver1 Ver2 Ver3.
Inputs A (Card A) ⦃Agent B, Nonce Na, Nonce Nb, Nonce (Pairkey(A,B)),
Ver1, Ver2, Ver3⦄ ∈ set evs)"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Outpts_A_Card_10_imp_Inputs:
"⟦ Outpts (Card A) A ⦃Key K, Certificate⦄ ∈ set evs; evs ∈ sr ⟧
⟹ (∃ B Na Nb Ver1 Ver2 Ver3.
Inputs A (Card A) ⦃Agent B, Nonce Na, Nonce Nb, Nonce (Pairkey(A,B)),
Ver1, Ver2, Ver3⦄ ∈ set evs)"
apply (erule rev_mp, erule sr.induct)
apply simp_all
apply blast+
done
lemma Outpts_honest_A_Card_4:
"⟦ Outpts C A ⦃Nonce Na, Crypt K X⦄ ∈set evs;
A ≠ Spy; evs ∈ sr ⟧
⟹ legalUse(C) ∧ C = (Card A) ∧
Inputs A (Card A) (Agent A) ∈ set evs"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Outpts_honest_B_Card_7:
"⟦ Outpts C B ⦃Nonce Nb, Key K, Cert1, Cert2⦄ ∈ set evs;
B ≠ Spy; evs ∈ sr ⟧
⟹ legalUse(C) ∧ C = (Card B) ∧
(∃ A Na. Inputs B (Card B) ⦃Agent A, Nonce Na⦄ ∈ set evs)"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Outpts_honest_A_Card_10:
"⟦ Outpts C A ⦃Key K, Certificate⦄ ∈ set evs;
A ≠ Spy; evs ∈ sr ⟧
⟹ legalUse (C) ∧ C = (Card A) ∧
(∃ B Na Nb Pk Ver1 Ver2 Ver3.
Inputs A (Card A) ⦃Agent B, Nonce Na, Nonce Nb, Pk,
Ver1, Ver2, Ver3⦄ ∈ set evs)"
apply (erule rev_mp, erule sr.induct)
apply simp_all
apply blast+
done
lemma Outpts_which_Card_4:
"⟦ Outpts (Card A) A ⦃Nonce Na, Crypt K X⦄ ∈ set evs; evs ∈ sr ⟧
⟹ Inputs A (Card A) (Agent A) ∈ set evs"
apply (erule rev_mp, erule sr.induct)
apply (simp_all (no_asm_simp))
apply clarify
done
lemma Outpts_which_Card_7:
"⟦ Outpts (Card B) B ⦃Nonce Nb, Key K, Cert1, Cert2⦄ ∈ set evs;
evs ∈ sr ⟧
⟹ ∃ A Na. Inputs B (Card B) ⦃Agent A, Nonce Na⦄ ∈ set evs"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Outpts_which_Card_10:
"⟦ Outpts (Card A) A ⦃Key (sesK(Nb,pairK(A,B))),
Crypt (pairK(A,B)) (Nonce Nb) ⦄ ∈ set evs;
evs ∈ sr ⟧
⟹ ∃ Na. Inputs A (Card A) ⦃Agent B, Nonce Na, Nonce Nb, Nonce (Pairkey(A,B)),
Crypt (shrK A) ⦃Nonce (Pairkey(A,B)), Agent B⦄,
Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄,
Crypt (crdK (Card A)) (Nonce Na) ⦄ ∈ set evs"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Outpts_A_Card_form_4:
"⟦ Outpts (Card A) A ⦃Nonce Na, Certificate⦄ ∈ set evs;
∀ p q. Certificate ≠ ⦃p, q⦄; evs ∈ sr ⟧
⟹ Certificate = (Crypt (crdK (Card A)) (Nonce Na))"
apply (erule rev_mp, erule sr.induct)
apply (simp_all (no_asm_simp))
done
lemma Outpts_B_Card_form_7:
"⟦ Outpts (Card B) B ⦃Nonce Nb, Key K, Cert1, Cert2⦄ ∈ set evs;
evs ∈ sr ⟧
⟹ ∃ A Na.
K = sesK(Nb,pairK(A,B)) ∧
Cert1 = (Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄) ∧
Cert2 = (Crypt (pairK(A,B)) (Nonce Nb))"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Outpts_A_Card_form_10:
"⟦ Outpts (Card A) A ⦃Key K, Certificate⦄ ∈ set evs; evs ∈ sr ⟧
⟹ ∃ B Nb.
K = sesK(Nb,pairK(A,B)) ∧
Certificate = (Crypt (pairK(A,B)) (Nonce Nb))"
apply (erule rev_mp, erule sr.induct)
apply (simp_all (no_asm_simp))
done
lemma Outpts_A_Card_form_bis:
"⟦ Outpts (Card A') A' ⦃Key (sesK(Nb,pairK(A,B))), Certificate⦄ ∈ set evs;
evs ∈ sr ⟧
⟹ A' = A ∧
Certificate = (Crypt (pairK(A,B)) (Nonce Nb))"
apply (erule rev_mp, erule sr.induct)
apply (simp_all (no_asm_simp))
done
lemma Inputs_A_Card_form_9:
"⟦ Inputs A (Card A) ⦃Agent B, Nonce Na, Nonce Nb, Nonce Pk,
Cert1, Cert2, Cert3⦄ ∈ set evs;
evs ∈ sr ⟧
⟹ Cert3 = Crypt (crdK (Card A)) (Nonce Na)"
apply (erule rev_mp)
apply (erule sr.induct)
apply (simp_all (no_asm_simp))
apply force
apply (blast dest!: Outpts_A_Card_form_4)
done
lemma Inputs_Card_legalUse:
"⟦ Inputs A (Card A) X ∈ set evs; evs ∈ sr ⟧ ⟹ legalUse(Card A)"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Outpts_Card_legalUse:
"⟦ Outpts (Card A) A X ∈ set evs; evs ∈ sr ⟧ ⟹ legalUse(Card A)"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Inputs_Card: "⟦ Inputs A C X ∈ set evs; A ≠ Spy; evs ∈ sr ⟧
⟹ C = (Card A) ∧ legalUse(C)"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Outpts_Card: "⟦ Outpts C A X ∈ set evs; A ≠ Spy; evs ∈ sr ⟧
⟹ C = (Card A) ∧ legalUse(C)"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Inputs_Outpts_Card:
"⟦ Inputs A C X ∈ set evs ∨ Outpts C A Y ∈ set evs;
A ≠ Spy; evs ∈ sr ⟧
⟹ C = (Card A) ∧ legalUse(Card A)"
apply (blast dest: Inputs_Card Outpts_Card)
done
lemma Inputs_Card_Spy:
"⟦ Inputs Spy C X ∈ set evs ∨ Outpts C Spy X ∈ set evs; evs ∈ sr ⟧
⟹ C = (Card Spy) ∧ legalUse(Card Spy) ∨
(∃ A. C = (Card A) ∧ illegalUse(Card A))"
apply (erule rev_mp, erule sr.induct)
apply auto
done
lemma Outpts_A_Card_unique_nonce:
"⟦ Outpts (Card A) A ⦃Nonce Na, Crypt (crdK (Card A)) (Nonce Na)⦄
∈ set evs;
Outpts (Card A') A' ⦃Nonce Na, Crypt (crdK (Card A')) (Nonce Na)⦄
∈ set evs;
evs ∈ sr ⟧ ⟹ A=A'"
apply (erule rev_mp, erule rev_mp, erule sr.induct, simp_all)
apply (fastforce dest: Outpts_parts_used)
apply blast
done
lemma Outpts_B_Card_unique_nonce:
"⟦ Outpts (Card B) B ⦃Nonce Nb, Key SK, Cert1, Cert2⦄ ∈ set evs;
Outpts (Card B') B' ⦃Nonce Nb, Key SK', Cert1', Cert2'⦄ ∈ set evs;
evs ∈ sr ⟧ ⟹ B=B' ∧ SK=SK' ∧ Cert1=Cert1' ∧ Cert2=Cert2'"
apply (erule rev_mp, erule rev_mp, erule sr.induct, simp_all)
apply (fastforce dest: Outpts_parts_used)
apply blast
done
lemma Outpts_B_Card_unique_key:
"⟦ Outpts (Card B) B ⦃Nonce Nb, Key SK, Cert1, Cert2⦄ ∈ set evs;
Outpts (Card B') B' ⦃Nonce Nb', Key SK, Cert1', Cert2'⦄ ∈ set evs;
evs ∈ sr ⟧ ⟹ B=B' ∧ Nb=Nb' ∧ Cert1=Cert1' ∧ Cert2=Cert2'"
apply (erule rev_mp, erule rev_mp, erule sr.induct, simp_all)
apply (fastforce dest: Outpts_parts_used)
apply blast
done
lemma Outpts_A_Card_unique_key: "⟦ Outpts (Card A) A ⦃Key K, V⦄ ∈ set evs;
Outpts (Card A') A' ⦃Key K, V'⦄ ∈ set evs;
evs ∈ sr ⟧ ⟹ A=A' ∧ V=V'"
apply (erule rev_mp, erule rev_mp, erule sr.induct, simp_all)
apply (blast dest: Outpts_A_Card_form_bis)
apply blast
done
lemma Outpts_A_Card_Unique:
"⟦ Outpts (Card A) A ⦃Nonce Na, rest⦄ ∈ set evs; evs ∈ sr ⟧
⟹ Unique (Outpts (Card A) A ⦃Nonce Na, rest⦄) on evs"
apply (erule rev_mp, erule sr.induct, simp_all add: Unique_def)
apply (fastforce dest: Outpts_parts_used)
apply blast
apply (fastforce dest: Outpts_parts_used)
apply blast
done
lemma Spy_knows_Na:
"⟦ Says A B ⦃Agent A, Nonce Na⦄ ∈ set evs; evs ∈ sr ⟧
⟹ Nonce Na ∈ analz (knows Spy evs)"
apply (blast dest!: Says_imp_knows_Spy [THEN analz.Inj, THEN analz.Snd])
done
lemma Spy_knows_Nb:
"⟦ Says B A ⦃Nonce Nb, Certificate⦄ ∈ set evs; evs ∈ sr ⟧
⟹ Nonce Nb ∈ analz (knows Spy evs)"
apply (blast dest!: Says_imp_knows_Spy [THEN analz.Inj, THEN analz.Fst])
done
lemma Pairkey_Gets_analz_knows_Spy:
"⟦ Gets A ⦃Nonce (Pairkey(A,B)), Certificate⦄ ∈ set evs; evs ∈ sr ⟧
⟹ Nonce (Pairkey(A,B)) ∈ analz (knows Spy evs)"
apply (blast dest!: Gets_imp_knows_Spy [THEN analz.Inj])
done
lemma Pairkey_Inputs_imp_Gets:
"⟦ Inputs A (Card A)
⦃Agent B, Nonce Na, Nonce Nb, Nonce (Pairkey(A,B)),
Cert1, Cert3, Cert2⦄ ∈ set evs;
A ≠ Spy; evs ∈ sr ⟧
⟹ Gets A ⦃Nonce (Pairkey(A,B)), Cert1⦄ ∈ set evs"
apply (erule rev_mp, erule sr.induct)
apply (simp_all (no_asm_simp))
apply force
done
lemma Pairkey_Inputs_analz_knows_Spy:
"⟦ Inputs A (Card A)
⦃Agent B, Nonce Na, Nonce Nb, Nonce (Pairkey(A,B)),
Cert1, Cert3, Cert2⦄ ∈ set evs;
evs ∈ sr ⟧
⟹ Nonce (Pairkey(A,B)) ∈ analz (knows Spy evs)"
apply (case_tac "A = Spy")
apply (fastforce dest!: Inputs_imp_knows_Spy_secureM [THEN analz.Inj])
apply (blast dest!: Pairkey_Inputs_imp_Gets [THEN Pairkey_Gets_analz_knows_Spy])
done
declare shrK_disj_sesK [THEN not_sym, iff]
declare pin_disj_sesK [THEN not_sym, iff]
declare crdK_disj_sesK [THEN not_sym, iff]
declare pairK_disj_sesK [THEN not_sym, iff]
ML
‹
structure ShoupRubin =
struct
fun prepare_tac ctxt =
forward_tac ctxt [@{thm Outpts_B_Card_form_7}] 14 THEN
eresolve_tac ctxt [exE] 15 THEN eresolve_tac ctxt [exE] 15 THEN
forward_tac ctxt [@{thm Outpts_A_Card_form_4}] 16 THEN
forward_tac ctxt [@{thm Outpts_A_Card_form_10}] 21 THEN
eresolve_tac ctxt [exE] 22 THEN eresolve_tac ctxt [exE] 22
fun parts_prepare_tac ctxt =
prepare_tac ctxt THEN
dresolve_tac ctxt [@{thm Gets_imp_knows_Spy_parts_Snd}] 18 THEN
dresolve_tac ctxt [@{thm Gets_imp_knows_Spy_parts_Snd}] 19 THEN
dresolve_tac ctxt [@{thm Outpts_B_Card_form_7}] 25 THEN
dresolve_tac ctxt [@{thm Outpts_A_Card_form_10}] 27 THEN
(force_tac ctxt) 1
fun analz_prepare_tac ctxt =
prepare_tac ctxt THEN
dresolve_tac ctxt @{thms Gets_imp_knows_Spy_analz_Snd} 18 THEN
dresolve_tac ctxt @{thms Gets_imp_knows_Spy_analz_Snd} 19 THEN
REPEAT_FIRST (eresolve_tac ctxt [asm_rl, conjE] ORELSE' hyp_subst_tac ctxt)
end
›
method_setup prepare = ‹
Scan.succeed (SIMPLE_METHOD o ShoupRubin.prepare_tac)›
"to launch a few simple facts that will help the simplifier"
method_setup parts_prepare = ‹
Scan.succeed (fn ctxt => SIMPLE_METHOD (ShoupRubin.parts_prepare_tac ctxt))›
"additional facts to reason about parts"
method_setup analz_prepare = ‹
Scan.succeed (fn ctxt => SIMPLE_METHOD (ShoupRubin.analz_prepare_tac ctxt))›
"additional facts to reason about analz"
lemma Spy_parts_keys [simp]: "evs ∈ sr ⟹
(Key (shrK P) ∈ parts (knows Spy evs)) = (Card P ∈ cloned) ∧
(Key (pin P) ∈ parts (knows Spy evs)) = (P ∈ bad ∨ Card P ∈ cloned) ∧
(Key (crdK C) ∈ parts (knows Spy evs)) = (C ∈ cloned) ∧
(Key (pairK(A,B)) ∈ parts (knows Spy evs)) = (Card B ∈ cloned)"
apply (erule sr.induct)
apply parts_prepare
apply simp_all
apply (blast intro: parts_insertI)
done
lemma Spy_analz_shrK[simp]: "evs ∈ sr ⟹
(Key (shrK P) ∈ analz (knows Spy evs)) = (Card P ∈ cloned)"
apply (auto dest!: Spy_knows_cloned)
done
lemma Spy_analz_crdK[simp]: "evs ∈ sr ⟹
(Key (crdK C) ∈ analz (knows Spy evs)) = (C ∈ cloned)"
apply (auto dest!: Spy_knows_cloned)
done
lemma Spy_analz_pairK[simp]: "evs ∈ sr ⟹
(Key (pairK(A,B)) ∈ analz (knows Spy evs)) = (Card B ∈ cloned)"
apply (auto dest!: Spy_knows_cloned)
done
lemma analz_image_Key_Un_Nonce:
"analz (Key ` K ∪ Nonce ` N) = Key ` K ∪ Nonce ` N"
by (auto simp del: parts_image)
method_setup sc_analz_freshK = ‹
Scan.succeed (fn ctxt =>
(SIMPLE_METHOD
(EVERY [REPEAT_FIRST
(resolve_tac ctxt [allI, ballI, impI]),
REPEAT_FIRST (resolve_tac ctxt @{thms analz_image_freshK_lemma}),
ALLGOALS (asm_simp_tac (put_simpset Smartcard.analz_image_freshK_ss ctxt
addsimps [@{thm knows_Spy_Inputs_secureM_sr_Spy},
@{thm knows_Spy_Outpts_secureM_sr_Spy},
@{thm shouprubin_assumes_securemeans},
@{thm analz_image_Key_Un_Nonce}]))])))›
"for proving the Session Key Compromise theorem for smartcard protocols"
lemma analz_image_freshK [rule_format]:
"evs ∈ sr ⟹ ∀ K KK.
(Key K ∈ analz (Key`KK ∪ (knows Spy evs))) =
(K ∈ KK ∨ Key K ∈ analz (knows Spy evs))"
apply (erule sr.induct)
apply analz_prepare
apply sc_analz_freshK
apply spy_analz
done
lemma analz_insert_freshK: "evs ∈ sr ⟹
Key K ∈ analz (insert (Key K') (knows Spy evs)) =
(K = K' ∨ Key K ∈ analz (knows Spy evs))"
apply (simp only: analz_image_freshK_simps analz_image_freshK)
done
lemma Na_Nb_certificate_authentic:
"⟦ Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄ ∈ parts (knows Spy evs);
¬illegalUse(Card B);
evs ∈ sr ⟧
⟹ Outpts (Card B) B ⦃Nonce Nb, Key (sesK(Nb,pairK(A,B))),
Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄,
Crypt (pairK(A,B)) (Nonce Nb)⦄ ∈ set evs"
apply (erule rev_mp, erule sr.induct)
apply parts_prepare
apply simp_all
apply spy_analz
apply clarify
done
lemma Nb_certificate_authentic:
"⟦ Crypt (pairK(A,B)) (Nonce Nb) ∈ parts (knows Spy evs);
B ≠ Spy; ¬illegalUse(Card A); ¬illegalUse(Card B);
evs ∈ sr ⟧
⟹ Outpts (Card A) A ⦃Key (sesK(Nb,pairK(A,B))),
Crypt (pairK(A,B)) (Nonce Nb)⦄ ∈ set evs"
apply (erule rev_mp, erule sr.induct)
apply parts_prepare
apply (case_tac [17] "Aa = Spy")
apply simp_all
apply spy_analz
apply clarify+
done
lemma Outpts_A_Card_imp_pairK_parts:
"⟦ Outpts (Card A) A
⦃Key K, Crypt (pairK(A,B)) (Nonce Nb)⦄ ∈ set evs;
evs ∈ sr ⟧
⟹ ∃ Na. Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄ ∈ parts (knows Spy evs)"
apply (erule rev_mp, erule sr.induct)
apply parts_prepare
apply simp_all
apply (blast dest: parts_insertI)
apply force
apply force
apply blast
apply (blast dest: Inputs_imp_knows_Spy_secureM_sr parts.Inj Inputs_A_Card_9 Gets_imp_knows_Spy elim: knows_Spy_partsEs)
apply (blast dest: Inputs_imp_knows_Spy_secureM_sr [THEN parts.Inj]
Inputs_A_Card_9 Gets_imp_knows_Spy
elim: knows_Spy_partsEs)
done
lemma Nb_certificate_authentic_bis:
"⟦ Crypt (pairK(A,B)) (Nonce Nb) ∈ parts (knows Spy evs);
B ≠ Spy; ¬illegalUse(Card B);
evs ∈ sr ⟧
⟹ ∃ Na. Outpts (Card B) B ⦃Nonce Nb, Key (sesK(Nb,pairK(A,B))),
Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄,
Crypt (pairK(A,B)) (Nonce Nb)⦄ ∈ set evs"
apply (erule rev_mp, erule sr.induct)
apply parts_prepare
apply (simp_all (no_asm_simp))
apply spy_analz
apply blast
apply blast
apply (blast dest: Na_Nb_certificate_authentic Inputs_imp_knows_Spy_secureM_sr [THEN parts.Inj] elim: knows_Spy_partsEs)
apply (blast dest: Na_Nb_certificate_authentic Inputs_imp_knows_Spy_secureM_sr [THEN parts.Inj] elim: knows_Spy_partsEs)
apply (blast dest: Na_Nb_certificate_authentic Outpts_A_Card_imp_pairK_parts)
done
lemma Pairkey_certificate_authentic:
"⟦ Crypt (shrK A) ⦃Nonce Pk, Agent B⦄ ∈ parts (knows Spy evs);
Card A ∉ cloned; evs ∈ sr ⟧
⟹ Pk = Pairkey(A,B) ∧
Says Server A ⦃Nonce Pk,
Crypt (shrK A) ⦃Nonce Pk, Agent B⦄⦄
∈ set evs"
apply (erule rev_mp, erule sr.induct)
apply parts_prepare
apply (simp_all (no_asm_simp))
apply spy_analz
done
lemma sesK_authentic:
"⟦ Key (sesK(Nb,pairK(A,B))) ∈ parts (knows Spy evs);
A ≠ Spy; B ≠ Spy; ¬illegalUse(Card A); ¬illegalUse(Card B);
evs ∈ sr ⟧
⟹ Notes Spy ⦃Key (sesK(Nb,pairK(A,B))), Nonce Nb, Agent A, Agent B⦄
∈ set evs"
apply (erule rev_mp, erule sr.induct)
apply parts_prepare
apply (simp_all (no_asm_simp))
apply spy_analz
apply (fastforce dest: analz.Inj)
apply clarify
apply clarify
apply simp_all
done
lemma Confidentiality:
"⟦ Notes Spy ⦃Key (sesK(Nb,pairK(A,B))), Nonce Nb, Agent A, Agent B⦄
∉ set evs;
A ≠ Spy; B ≠ Spy; ¬illegalUse(Card A); ¬illegalUse(Card B);
evs ∈ sr ⟧
⟹ Key (sesK(Nb,pairK(A,B))) ∉ analz (knows Spy evs)"
apply (blast intro: sesK_authentic)
done
lemma Confidentiality_B:
"⟦ Outpts (Card B) B ⦃Nonce Nb, Key K, Certificate,
Crypt (pairK(A,B)) (Nonce Nb)⦄ ∈ set evs;
Notes Spy ⦃Key K, Nonce Nb, Agent A, Agent B⦄ ∉ set evs;
A ≠ Spy; B ≠ Spy; ¬illegalUse(Card A); Card B ∉ cloned;
evs ∈ sr ⟧
⟹ Key K ∉ analz (knows Spy evs)"
apply (erule rev_mp, erule rev_mp, erule sr.induct)
apply analz_prepare
apply (simp_all add: analz_insert_eq analz_insert_freshK pushes split_ifs)
apply spy_analz
apply (rotate_tac 7)
apply (drule parts.Inj)
apply (fastforce dest: Outpts_B_Card_form_7)
apply (blast dest!: Outpts_B_Card_form_7)
apply clarify
apply (drule Outpts_parts_used)
apply simp
apply (fastforce dest: Outpts_B_Card_form_7)
apply clarify
apply (drule Outpts_B_Card_form_7, assumption)
apply simp
apply (blast dest!: Outpts_B_Card_form_7)
apply (blast dest!: Outpts_B_Card_form_7 Outpts_A_Card_form_10)
done
lemma A_authenticates_B:
"⟦ Outpts (Card A) A ⦃Key K, Crypt (pairK(A,B)) (Nonce Nb)⦄ ∈ set evs;
¬illegalUse(Card B);
evs ∈ sr ⟧
⟹ ∃ Na.
Outpts (Card B) B ⦃Nonce Nb, Key K,
Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄,
Crypt (pairK(A,B)) (Nonce Nb)⦄ ∈ set evs"
apply (blast dest: Na_Nb_certificate_authentic Outpts_A_Card_form_10 Outpts_A_Card_imp_pairK_parts)
done
lemma A_authenticates_B_Gets:
"⟦ Gets A ⦃Nonce Nb, Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄⦄
∈ set evs;
¬illegalUse(Card B);
evs ∈ sr ⟧
⟹ Outpts (Card B) B ⦃Nonce Nb, Key (sesK(Nb, pairK (A, B))),
Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄,
Crypt (pairK(A,B)) (Nonce Nb)⦄ ∈ set evs"
apply (blast dest: Gets_imp_knows_Spy [THEN parts.Inj, THEN parts.Snd, THEN Na_Nb_certificate_authentic])
done
lemma B_authenticates_A:
"⟦ Gets B (Crypt (pairK(A,B)) (Nonce Nb)) ∈ set evs;
B ≠ Spy; ¬illegalUse(Card A); ¬illegalUse(Card B);
evs ∈ sr ⟧
⟹ Outpts (Card A) A
⦃Key (sesK(Nb,pairK(A,B))), Crypt (pairK(A,B)) (Nonce Nb)⦄ ∈ set evs"
apply (erule rev_mp)
apply (erule sr.induct)
apply (simp_all (no_asm_simp))
apply (blast dest: Says_imp_knows_Spy [THEN parts.Inj] Nb_certificate_authentic)
done
lemma Confidentiality_A: "⟦ Outpts (Card A) A
⦃Key K, Crypt (pairK(A,B)) (Nonce Nb)⦄ ∈ set evs;
Notes Spy ⦃Key K, Nonce Nb, Agent A, Agent B⦄ ∉ set evs;
A ≠ Spy; B ≠ Spy; ¬illegalUse(Card A); ¬illegalUse(Card B);
evs ∈ sr ⟧
⟹ Key K ∉ analz (knows Spy evs)"
apply (drule A_authenticates_B)
prefer 3
apply (erule exE)
apply (drule Confidentiality_B)
apply auto
done
lemma Outpts_imp_knows_agents_secureM_sr:
"⟦ Outpts (Card A) A X ∈ set evs; evs ∈ sr ⟧ ⟹ X ∈ knows A evs"
apply (simp (no_asm_simp) add: Outpts_imp_knows_agents_secureM)
done
lemma A_keydist_to_B:
"⟦ Outpts (Card A) A
⦃Key K, Crypt (pairK(A,B)) (Nonce Nb)⦄ ∈ set evs;
¬illegalUse(Card B);
evs ∈ sr ⟧
⟹ Key K ∈ analz (knows B evs)"
apply (drule A_authenticates_B)
prefer 3
apply (erule exE)
apply (rule Outpts_imp_knows_agents_secureM_sr [THEN analz.Inj, THEN analz.Snd, THEN analz.Fst])
apply assumption+
done
lemma B_keydist_to_A:
"⟦ Outpts (Card B) B ⦃Nonce Nb, Key K, Certificate,
(Crypt (pairK(A,B)) (Nonce Nb))⦄ ∈ set evs;
Gets B (Crypt (pairK(A,B)) (Nonce Nb)) ∈ set evs;
B ≠ Spy; ¬illegalUse(Card A); ¬illegalUse(Card B);
evs ∈ sr ⟧
⟹ Key K ∈ analz (knows A evs)"
apply (frule B_authenticates_A)
apply (drule_tac [5] Outpts_B_Card_form_7)
apply (rule_tac [6] Outpts_imp_knows_agents_secureM_sr [THEN analz.Inj, THEN analz.Fst])
prefer 6 apply force
apply assumption+
done
lemma Nb_certificate_authentic_B:
"⟦ Gets B (Crypt (pairK(A,B)) (Nonce Nb)) ∈ set evs;
B ≠ Spy; ¬illegalUse(Card B);
evs ∈ sr ⟧
⟹ ∃ Na.
Outpts (Card B) B ⦃Nonce Nb, Key (sesK(Nb,pairK(A,B))),
Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄,
Crypt (pairK(A,B)) (Nonce Nb)⦄ ∈ set evs"
apply (blast dest: Gets_imp_knows_Spy [THEN parts.Inj, THEN Nb_certificate_authentic_bis])
done
lemma Pairkey_certificate_authentic_A_Card:
"⟦ Inputs A (Card A)
⦃Agent B, Nonce Na, Nonce Nb, Nonce Pk,
Crypt (shrK A) ⦃Nonce Pk, Agent B⦄,
Cert2, Cert3⦄ ∈ set evs;
A ≠ Spy; Card A ∉ cloned; evs ∈ sr ⟧
⟹ Pk = Pairkey(A,B) ∧
Says Server A ⦃Nonce (Pairkey(A,B)),
Crypt (shrK A) ⦃Nonce (Pairkey(A,B)), Agent B⦄⦄
∈ set evs "
apply (blast dest: Inputs_A_Card_9 Gets_imp_knows_Spy [THEN parts.Inj, THEN parts.Snd] Pairkey_certificate_authentic)
done
lemma Na_Nb_certificate_authentic_A_Card:
"⟦ Inputs A (Card A)
⦃Agent B, Nonce Na, Nonce Nb, Nonce Pk,
Cert1,
Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄, Cert3⦄ ∈ set evs;
A ≠ Spy; ¬illegalUse(Card B); evs ∈ sr ⟧
⟹ Outpts (Card B) B ⦃Nonce Nb, Key (sesK(Nb, pairK (A, B))),
Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄,
Crypt (pairK(A,B)) (Nonce Nb)⦄
∈ set evs "
apply (blast dest: Inputs_A_Card_9 Gets_imp_knows_Spy [THEN parts.Inj, THEN parts.Snd, THEN Na_Nb_certificate_authentic])
done
lemma Na_authentic_A_Card:
"⟦ Inputs A (Card A)
⦃Agent B, Nonce Na, Nonce Nb, Nonce Pk,
Cert1, Cert2, Cert3⦄ ∈ set evs;
A ≠ Spy; evs ∈ sr ⟧
⟹ Outpts (Card A) A ⦃Nonce Na, Cert3⦄
∈ set evs"
apply (blast dest: Inputs_A_Card_9)
done
lemma Inputs_A_Card_9_authentic:
"⟦ Inputs A (Card A)
⦃Agent B, Nonce Na, Nonce Nb, Nonce Pk,
Crypt (shrK A) ⦃Nonce Pk, Agent B⦄,
Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄, Cert3⦄ ∈ set evs;
A ≠ Spy; Card A ∉ cloned;¬illegalUse(Card B); evs ∈ sr ⟧
⟹ Says Server A ⦃Nonce Pk, Crypt (shrK A) ⦃Nonce Pk, Agent B⦄⦄
∈ set evs ∧
Outpts (Card B) B ⦃Nonce Nb, Key (sesK(Nb, pairK (A, B))),
Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄,
Crypt (pairK(A,B)) (Nonce Nb)⦄
∈ set evs ∧
Outpts (Card A) A ⦃Nonce Na, Cert3⦄
∈ set evs"
apply (blast dest: Inputs_A_Card_9 Na_Nb_certificate_authentic Gets_imp_knows_Spy [THEN parts.Inj, THEN parts.Snd] Pairkey_certificate_authentic)
done
lemma SR4_imp:
"⟦ Outpts (Card A) A ⦃Nonce Na, Crypt (crdK (Card A)) (Nonce Na)⦄
∈ set evs;
A ≠ Spy; evs ∈ sr ⟧
⟹ ∃ Pk V. Gets A ⦃Pk, V⦄ ∈ set evs"
apply (blast dest: Outpts_A_Card_4 Inputs_A_Card_3)
done
lemma SR7_imp:
"⟦ Outpts (Card B) B ⦃Nonce Nb, Key K,
Crypt (pairK(A,B)) ⦃Nonce Na, Nonce Nb⦄,
Cert2⦄ ∈ set evs;
B ≠ Spy; evs ∈ sr ⟧
⟹ Gets B ⦃Agent A, Nonce Na⦄ ∈ set evs"
apply (blast dest: Outpts_B_Card_7 Inputs_B_Card_6)
done
lemma SR10_imp:
"⟦ Outpts (Card A) A ⦃Key K, Crypt (pairK(A,B)) (Nonce Nb)⦄
∈ set evs;
A ≠ Spy; evs ∈ sr ⟧
⟹ ∃ Cert1 Cert2.
Gets A ⦃Nonce (Pairkey (A, B)), Cert1⦄ ∈ set evs ∧
Gets A ⦃Nonce Nb, Cert2⦄ ∈ set evs"
apply (blast dest: Outpts_A_Card_10 Inputs_A_Card_9)
done
lemma Outpts_Server_not_evs: "evs ∈ sr ⟹ Outpts (Card Server) P X ∉ set evs"
apply (erule sr.induct)
apply auto
done
text‹\<^term>‹step2_integrity› also is a reliability theorem›
lemma Says_Server_message_form:
"⟦ Says Server A ⦃Pk, Certificate⦄ ∈ set evs;
evs ∈ sr ⟧
⟹ ∃ B. Pk = Nonce (Pairkey(A,B)) ∧
Certificate = Crypt (shrK A) ⦃Nonce (Pairkey(A,B)), Agent B⦄"
apply (erule rev_mp)
apply (erule sr.induct)
apply auto
apply (blast dest!: Outpts_Server_not_evs)+
done
text‹
step4integrity is \<^term>‹Outpts_A_Card_form_4›
step7integrity is \<^term>‹Outpts_B_Card_form_7›
›
lemma step8_integrity:
"⟦ Says B A ⦃Nonce Nb, Certificate⦄ ∈ set evs;
B ≠ Server; B ≠ Spy; evs ∈ sr ⟧
⟹ ∃ Cert2 K.
Outpts (Card B) B ⦃Nonce Nb, Key K, Certificate, Cert2⦄ ∈ set evs"
apply (erule rev_mp)
apply (erule sr.induct)
prefer 18 apply (fastforce dest: Outpts_A_Card_form_10)
apply auto
done
text‹step9integrity is \<^term>‹Inputs_A_Card_form_9›
step10integrity is \<^term>‹Outpts_A_Card_form_10›.
›
lemma step11_integrity:
"⟦ Says A B (Certificate) ∈ set evs;
∀ p q. Certificate ≠ ⦃p, q⦄;
A ≠ Spy; evs ∈ sr ⟧
⟹ ∃ K.
Outpts (Card A) A ⦃Key K, Certificate⦄ ∈ set evs"
apply (erule rev_mp)
apply (erule sr.induct)
apply auto
done
end