# HG changeset patch
# User wenzelm
# Date 1256061803 -7200
# Node ID 9aa8bfb1649d8ae83f684852fc1f9119ba24dbec
# Parent  9cf389429f6df980c84b68fb90238c58900fad0b
modernized session SET_Protocol;

diff -r 9cf389429f6d -r 9aa8bfb1649d Admin/isatest/isatest-stats
--- a/Admin/isatest/isatest-stats	Tue Oct 20 19:52:04 2009 +0200
+++ b/Admin/isatest/isatest-stats	Tue Oct 20 20:03:23 2009 +0200
@@ -27,7 +27,7 @@
   HOL-Nominal-Examples \
   HOL-Number_Theory \
   HOL-Old_Number_Theory \
-  HOL-SET-Protocol \
+  HOL-SET_Protocol \
   HOL-UNITY \
   HOL-Word \
   HOL-ex \
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/IsaMakefile
--- a/src/HOL/IsaMakefile	Tue Oct 20 19:52:04 2009 +0200
+++ b/src/HOL/IsaMakefile	Tue Oct 20 20:03:23 2009 +0200
@@ -38,7 +38,7 @@
   HOL-Number_Theory \
   HOL-Old_Number_Theory \
   HOL-Prolog \
-  HOL-SET-Protocol \
+  HOL-SET_Protocol \
   HOL-SizeChange \
   HOL-SMT-Examples \
   HOL-Statespace \
@@ -932,16 +932,16 @@
 	@$(ISABELLE_TOOL) usedir $(OUT)/HOL Isar_Examples
 
 
-## HOL-SET-Protocol
+## HOL-SET_Protocol
 
-HOL-SET-Protocol: HOL $(LOG)/HOL-SET-Protocol.gz
+HOL-SET_Protocol: HOL $(LOG)/HOL-SET_Protocol.gz
 
-$(LOG)/HOL-SET-Protocol.gz: $(OUT)/HOL SET-Protocol/ROOT.ML		\
-  SET-Protocol/MessageSET.thy SET-Protocol/EventSET.thy			\
-  SET-Protocol/PublicSET.thy SET-Protocol/Cardholder_Registration.thy	\
-  SET-Protocol/Merchant_Registration.thy SET-Protocol/Purchase.thy	\
-  SET-Protocol/document/root.tex
-	@$(ISABELLE_TOOL) usedir -g true $(OUT)/HOL SET-Protocol
+$(LOG)/HOL-SET_Protocol.gz: $(OUT)/HOL SET_Protocol/ROOT.ML		\
+  SET_Protocol/Message_SET.thy SET_Protocol/Event_SET.thy		\
+  SET_Protocol/Public_SET.thy SET_Protocol/Cardholder_Registration.thy	\
+  SET_Protocol/Merchant_Registration.thy SET_Protocol/Purchase.thy	\
+  SET_Protocol/document/root.tex
+	@$(ISABELLE_TOOL) usedir -g true $(OUT)/HOL SET_Protocol
 
 
 ## HOL-Matrix
@@ -1315,7 +1315,7 @@
 		$(LOG)/HOL-MicroJava.gz $(LOG)/HOL-NanoJava.gz		\
 		$(LOG)/HOL-Nominal-Examples.gz $(LOG)/HOL-IOA.gz	\
 		$(LOG)/HOL-Lattice $(LOG)/HOL-Matrix			\
-		$(LOG)/HOL-Hahn_Banach.gz $(LOG)/HOL-SET-Protocol.gz	\
+		$(LOG)/HOL-Hahn_Banach.gz $(LOG)/HOL-SET_Protocol.gz	\
 		$(LOG)/TLA-Inc.gz $(LOG)/TLA-Buffer.gz			\
 		$(LOG)/TLA-Memory.gz $(LOG)/HOL-Library.gz		\
 		$(LOG)/HOL-Unix.gz $(OUT)/HOL-Word $(LOG)/HOL-Word.gz	\
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/README.html
--- a/src/HOL/README.html	Tue Oct 20 19:52:04 2009 +0200
+++ b/src/HOL/README.html	Tue Oct 20 20:03:23 2009 +0200
@@ -99,7 +99,7 @@
 <dt>Hahn_Banach
 <dd>the Hahn-Banach theorem for real vector spaces (in Isabelle/Isar)
 
-<dt>SET-Protocol
+<dt>SET_Protocol
 <dd>verification of the SET Protocol
 
 <dt>Subst
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/SET-Protocol/Cardholder_Registration.thy
--- a/src/HOL/SET-Protocol/Cardholder_Registration.thy	Tue Oct 20 19:52:04 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,1054 +0,0 @@
-(*  Title:      HOL/SET-Protocol/Cardholder_Registration.thy
-    Author:     Giampaolo Bella
-    Author:     Fabio Massacci
-    Author:     Lawrence C Paulson
-    Author:     Piero Tramontano
-*)
-
-header{*The SET Cardholder Registration Protocol*}
-
-theory Cardholder_Registration imports PublicSET begin
-
-text{*Note: nonces seem to consist of 20 bytes.  That includes both freshness
-challenges (Chall-EE, etc.) and important secrets (CardSecret, PANsecret)
-*}
-
-text{*Simplifications involving @{text analz_image_keys_simps} appear to
-have become much slower. The cause is unclear. However, there is a big blow-up
-and the rewriting is very sensitive to the set of rewrite rules given.*}
-
-subsection{*Predicate Formalizing the Encryption Association between Keys *}
-
-consts
-  KeyCryptKey :: "[key, key, event list] => bool"
-
-primrec
-
-KeyCryptKey_Nil:
-  "KeyCryptKey DK K [] = False"
-
-KeyCryptKey_Cons:
-      --{*Says is the only important case.
-        1st case: CR5, where KC3 encrypts KC2.
-        2nd case: any use of priEK C.
-        Revision 1.12 has a more complicated version with separate treatment of
-          the dependency of KC1, KC2 and KC3 on priEK (CA i.)  Not needed since
-          priEK C is never sent (and so can't be lost except at the start). *}
-  "KeyCryptKey DK K (ev # evs) =
-   (KeyCryptKey DK K evs |
-    (case ev of
-      Says A B Z =>
-       ((\<exists>N X Y. A \<noteq> Spy &
-                 DK \<in> symKeys &
-                 Z = {|Crypt DK {|Agent A, Nonce N, Key K, X|}, Y|}) |
-        (\<exists>C. DK = priEK C))
-    | Gets A' X => False
-    | Notes A' X => False))"
-
-
-subsection{*Predicate formalizing the association between keys and nonces *}
-
-consts
-  KeyCryptNonce :: "[key, key, event list] => bool"
-
-primrec
-
-KeyCryptNonce_Nil:
-  "KeyCryptNonce EK K [] = False"
-
-KeyCryptNonce_Cons:
-  --{*Says is the only important case.
-    1st case: CR3, where KC1 encrypts NC2 (distinct from CR5 due to EXH);
-    2nd case: CR5, where KC3 encrypts NC3;
-    3rd case: CR6, where KC2 encrypts NC3;
-    4th case: CR6, where KC2 encrypts NonceCCA;
-    5th case: any use of @{term "priEK C"} (including CardSecret).
-    NB the only Nonces we need to keep secret are CardSecret and NonceCCA.
-    But we can't prove @{text Nonce_compromise} unless the relation covers ALL
-        nonces that the protocol keeps secret.
-  *}
-  "KeyCryptNonce DK N (ev # evs) =
-   (KeyCryptNonce DK N evs |
-    (case ev of
-      Says A B Z =>
-       A \<noteq> Spy &
-       ((\<exists>X Y. DK \<in> symKeys &
-               Z = (EXHcrypt DK X {|Agent A, Nonce N|} Y)) |
-        (\<exists>X Y. DK \<in> symKeys &
-               Z = {|Crypt DK {|Agent A, Nonce N, X|}, Y|}) |
-        (\<exists>K i X Y.
-          K \<in> symKeys &
-          Z = Crypt K {|sign (priSK (CA i)) {|Agent B, Nonce N, X|}, Y|} &
-          (DK=K | KeyCryptKey DK K evs)) |
-        (\<exists>K C NC3 Y.
-          K \<in> symKeys &
-          Z = Crypt K
-                {|sign (priSK C) {|Agent B, Nonce NC3, Agent C, Nonce N|},
-                  Y|} &
-          (DK=K | KeyCryptKey DK K evs)) |
-        (\<exists>C. DK = priEK C))
-    | Gets A' X => False
-    | Notes A' X => False))"
-
-
-subsection{*Formal protocol definition *}
-
-inductive_set
-  set_cr :: "event list set"
-where
-
-  Nil:    --{*Initial trace is empty*}
-          "[] \<in> set_cr"
-
-| Fake:    --{*The spy MAY say anything he CAN say.*}
-           "[| evsf \<in> set_cr; X \<in> synth (analz (knows Spy evsf)) |]
-            ==> Says Spy B X  # evsf \<in> set_cr"
-
-| Reception: --{*If A sends a message X to B, then B might receive it*}
-             "[| evsr \<in> set_cr; Says A B X \<in> set evsr |]
-              ==> Gets B X  # evsr \<in> set_cr"
-
-| SET_CR1: --{*CardCInitReq: C initiates a run, sending a nonce to CCA*}
-             "[| evs1 \<in> set_cr;  C = Cardholder k;  Nonce NC1 \<notin> used evs1 |]
-              ==> Says C (CA i) {|Agent C, Nonce NC1|} # evs1 \<in> set_cr"
-
-| SET_CR2: --{*CardCInitRes: CA responds sending NC1 and its certificates*}
-             "[| evs2 \<in> set_cr;
-                 Gets (CA i) {|Agent C, Nonce NC1|} \<in> set evs2 |]
-              ==> Says (CA i) C
-                       {|sign (priSK (CA i)) {|Agent C, Nonce NC1|},
-                         cert (CA i) (pubEK (CA i)) onlyEnc (priSK RCA),
-                         cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|}
-                    # evs2 \<in> set_cr"
-
-| SET_CR3:
-   --{*RegFormReq: C sends his PAN and a new nonce to CA.
-   C verifies that
-    - nonce received is the same as that sent;
-    - certificates are signed by RCA;
-    - certificates are an encryption certificate (flag is onlyEnc) and a
-      signature certificate (flag is onlySig);
-    - certificates pertain to the CA that C contacted (this is done by
-      checking the signature).
-   C generates a fresh symmetric key KC1.
-   The point of encrypting @{term "{|Agent C, Nonce NC2, Hash (Pan(pan C))|}"}
-   is not clear. *}
-"[| evs3 \<in> set_cr;  C = Cardholder k;
-    Nonce NC2 \<notin> used evs3;
-    Key KC1 \<notin> used evs3; KC1 \<in> symKeys;
-    Gets C {|sign (invKey SKi) {|Agent X, Nonce NC1|},
-             cert (CA i) EKi onlyEnc (priSK RCA),
-             cert (CA i) SKi onlySig (priSK RCA)|}
-       \<in> set evs3;
-    Says C (CA i) {|Agent C, Nonce NC1|} \<in> set evs3|]
- ==> Says C (CA i) (EXHcrypt KC1 EKi {|Agent C, Nonce NC2|} (Pan(pan C)))
-       # Notes C {|Key KC1, Agent (CA i)|}
-       # evs3 \<in> set_cr"
-
-| SET_CR4:
-    --{*RegFormRes:
-    CA responds sending NC2 back with a new nonce NCA, after checking that
-     - the digital envelope is correctly encrypted by @{term "pubEK (CA i)"}
-     - the entire message is encrypted with the same key found inside the
-       envelope (here, KC1) *}
-"[| evs4 \<in> set_cr;
-    Nonce NCA \<notin> used evs4;  KC1 \<in> symKeys;
-    Gets (CA i) (EXHcrypt KC1 EKi {|Agent C, Nonce NC2|} (Pan(pan X)))
-       \<in> set evs4 |]
-  ==> Says (CA i) C
-          {|sign (priSK (CA i)) {|Agent C, Nonce NC2, Nonce NCA|},
-            cert (CA i) (pubEK (CA i)) onlyEnc (priSK RCA),
-            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|}
-       # evs4 \<in> set_cr"
-
-| SET_CR5:
-   --{*CertReq: C sends his PAN, a new nonce, its proposed public signature key
-       and its half of the secret value to CA.
-       We now assume that C has a fixed key pair, and he submits (pubSK C).
-       The protocol does not require this key to be fresh.
-       The encryption below is actually EncX.*}
-"[| evs5 \<in> set_cr;  C = Cardholder k;
-    Nonce NC3 \<notin> used evs5;  Nonce CardSecret \<notin> used evs5; NC3\<noteq>CardSecret;
-    Key KC2 \<notin> used evs5; KC2 \<in> symKeys;
-    Key KC3 \<notin> used evs5; KC3 \<in> symKeys; KC2\<noteq>KC3;
-    Gets C {|sign (invKey SKi) {|Agent C, Nonce NC2, Nonce NCA|},
-             cert (CA i) EKi onlyEnc (priSK RCA),
-             cert (CA i) SKi onlySig (priSK RCA) |}
-        \<in> set evs5;
-    Says C (CA i) (EXHcrypt KC1 EKi {|Agent C, Nonce NC2|} (Pan(pan C)))
-         \<in> set evs5 |]
-==> Says C (CA i)
-         {|Crypt KC3
-             {|Agent C, Nonce NC3, Key KC2, Key (pubSK C),
-               Crypt (priSK C)
-                 (Hash {|Agent C, Nonce NC3, Key KC2,
-                         Key (pubSK C), Pan (pan C), Nonce CardSecret|})|},
-           Crypt EKi {|Key KC3, Pan (pan C), Nonce CardSecret|} |}
-    # Notes C {|Key KC2, Agent (CA i)|}
-    # Notes C {|Key KC3, Agent (CA i)|}
-    # evs5 \<in> set_cr"
-
-
-  --{* CertRes: CA responds sending NC3 back with its half of the secret value,
-   its signature certificate and the new cardholder signature
-   certificate.  CA checks to have never certified the key proposed by C.
-   NOTE: In Merchant Registration, the corresponding rule (4)
-   uses the "sign" primitive. The encryption below is actually @{term EncK}, 
-   which is just @{term "Crypt K (sign SK X)"}.
-*}
-
-| SET_CR6:
-"[| evs6 \<in> set_cr;
-    Nonce NonceCCA \<notin> used evs6;
-    KC2 \<in> symKeys;  KC3 \<in> symKeys;  cardSK \<notin> symKeys;
-    Notes (CA i) (Key cardSK) \<notin> set evs6;
-    Gets (CA i)
-      {|Crypt KC3 {|Agent C, Nonce NC3, Key KC2, Key cardSK,
-                    Crypt (invKey cardSK)
-                      (Hash {|Agent C, Nonce NC3, Key KC2,
-                              Key cardSK, Pan (pan C), Nonce CardSecret|})|},
-        Crypt (pubEK (CA i)) {|Key KC3, Pan (pan C), Nonce CardSecret|} |}
-      \<in> set evs6 |]
-==> Says (CA i) C
-         (Crypt KC2
-          {|sign (priSK (CA i))
-                 {|Agent C, Nonce NC3, Agent(CA i), Nonce NonceCCA|},
-            certC (pan C) cardSK (XOR(CardSecret,NonceCCA)) onlySig (priSK (CA i)),
-            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})
-      # Notes (CA i) (Key cardSK)
-      # evs6 \<in> set_cr"
-
-
-declare Says_imp_knows_Spy [THEN parts.Inj, dest]
-declare parts.Body [dest]
-declare analz_into_parts [dest]
-declare Fake_parts_insert_in_Un [dest]
-
-text{*A "possibility property": there are traces that reach the end.
-      An unconstrained proof with many subgoals.*}
-
-lemma Says_to_Gets:
-     "Says A B X # evs \<in> set_cr ==> Gets B X # Says A B X # evs \<in> set_cr"
-by (rule set_cr.Reception, auto)
-
-text{*The many nonces and keys generated, some simultaneously, force us to
-  introduce them explicitly as shown below.*}
-lemma possibility_CR6:
-     "[|NC1 < (NC2::nat);  NC2 < NC3;  NC3 < NCA ;
-        NCA < NonceCCA;  NonceCCA < CardSecret;
-        KC1 < (KC2::key);  KC2 < KC3;
-        KC1 \<in> symKeys;  Key KC1 \<notin> used [];
-        KC2 \<in> symKeys;  Key KC2 \<notin> used [];
-        KC3 \<in> symKeys;  Key KC3 \<notin> used [];
-        C = Cardholder k|]
-   ==> \<exists>evs \<in> set_cr.
-       Says (CA i) C
-            (Crypt KC2
-             {|sign (priSK (CA i))
-                    {|Agent C, Nonce NC3, Agent(CA i), Nonce NonceCCA|},
-               certC (pan C) (pubSK (Cardholder k)) (XOR(CardSecret,NonceCCA))
-                     onlySig (priSK (CA i)),
-               cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})
-          \<in> set evs"
-apply (intro exI bexI)
-apply (rule_tac [2] 
-       set_cr.Nil 
-        [THEN set_cr.SET_CR1 [of concl: C i NC1], 
-         THEN Says_to_Gets, 
-         THEN set_cr.SET_CR2 [of concl: i C NC1], 
-         THEN Says_to_Gets,  
-         THEN set_cr.SET_CR3 [of concl: C i KC1 _ NC2], 
-         THEN Says_to_Gets,  
-         THEN set_cr.SET_CR4 [of concl: i C NC2 NCA], 
-         THEN Says_to_Gets,  
-         THEN set_cr.SET_CR5 [of concl: C i KC3 NC3 KC2 CardSecret],
-         THEN Says_to_Gets,  
-         THEN set_cr.SET_CR6 [of concl: i C KC2]])
-apply basic_possibility
-apply (simp_all (no_asm_simp) add: symKeys_neq_imp_neq)
-done
-
-text{*General facts about message reception*}
-lemma Gets_imp_Says:
-     "[| Gets B X \<in> set evs; evs \<in> set_cr |] ==> \<exists>A. Says A B X \<in> set evs"
-apply (erule rev_mp)
-apply (erule set_cr.induct, auto)
-done
-
-lemma Gets_imp_knows_Spy:
-     "[| Gets B X \<in> set evs; evs \<in> set_cr |]  ==> X \<in> knows Spy evs"
-by (blast dest!: Gets_imp_Says Says_imp_knows_Spy)
-declare Gets_imp_knows_Spy [THEN parts.Inj, dest]
-
-
-subsection{*Proofs on keys *}
-
-text{*Spy never sees an agent's private keys! (unless it's bad at start)*}
-
-lemma Spy_see_private_Key [simp]:
-     "evs \<in> set_cr
-      ==> (Key(invKey (publicKey b A)) \<in> parts(knows Spy evs)) = (A \<in> bad)"
-by (erule set_cr.induct, auto)
-
-lemma Spy_analz_private_Key [simp]:
-     "evs \<in> set_cr ==>
-     (Key(invKey (publicKey b A)) \<in> analz(knows Spy evs)) = (A \<in> bad)"
-by auto
-
-declare Spy_see_private_Key [THEN [2] rev_iffD1, dest!]
-declare Spy_analz_private_Key [THEN [2] rev_iffD1, dest!]
-
-
-subsection{*Begin Piero's Theorems on Certificates*}
-text{*Trivial in the current model, where certificates by RCA are secure *}
-
-lemma Crypt_valid_pubEK:
-     "[| Crypt (priSK RCA) {|Agent C, Key EKi, onlyEnc|}
-           \<in> parts (knows Spy evs);
-         evs \<in> set_cr |] ==> EKi = pubEK C"
-apply (erule rev_mp)
-apply (erule set_cr.induct, auto)
-done
-
-lemma certificate_valid_pubEK:
-    "[| cert C EKi onlyEnc (priSK RCA) \<in> parts (knows Spy evs);
-        evs \<in> set_cr |]
-     ==> EKi = pubEK C"
-apply (unfold cert_def signCert_def)
-apply (blast dest!: Crypt_valid_pubEK)
-done
-
-lemma Crypt_valid_pubSK:
-     "[| Crypt (priSK RCA) {|Agent C, Key SKi, onlySig|}
-           \<in> parts (knows Spy evs);
-         evs \<in> set_cr |] ==> SKi = pubSK C"
-apply (erule rev_mp)
-apply (erule set_cr.induct, auto)
-done
-
-lemma certificate_valid_pubSK:
-    "[| cert C SKi onlySig (priSK RCA) \<in> parts (knows Spy evs);
-        evs \<in> set_cr |] ==> SKi = pubSK C"
-apply (unfold cert_def signCert_def)
-apply (blast dest!: Crypt_valid_pubSK)
-done
-
-lemma Gets_certificate_valid:
-     "[| Gets A {| X, cert C EKi onlyEnc (priSK RCA),
-                      cert C SKi onlySig (priSK RCA)|} \<in> set evs;
-         evs \<in> set_cr |]
-      ==> EKi = pubEK C & SKi = pubSK C"
-by (blast dest: certificate_valid_pubEK certificate_valid_pubSK)
-
-text{*Nobody can have used non-existent keys!*}
-lemma new_keys_not_used:
-     "[|K \<in> symKeys; Key K \<notin> used evs; evs \<in> set_cr|]
-      ==> K \<notin> keysFor (parts (knows Spy evs))"
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule set_cr.induct)
-apply (frule_tac [8] Gets_certificate_valid)
-apply (frule_tac [6] Gets_certificate_valid, simp_all)
-apply (force dest!: usedI keysFor_parts_insert) --{*Fake*}
-apply (blast,auto)  --{*Others*}
-done
-
-
-subsection{*New versions: as above, but generalized to have the KK argument *}
-
-lemma gen_new_keys_not_used:
-     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_cr |]
-      ==> Key K \<notin> used evs --> K \<in> symKeys -->
-          K \<notin> keysFor (parts (Key`KK Un knows Spy evs))"
-by (auto simp add: new_keys_not_used)
-
-lemma gen_new_keys_not_analzd:
-     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_cr |]
-      ==> K \<notin> keysFor (analz (Key`KK Un knows Spy evs))"
-by (blast intro: keysFor_mono [THEN [2] rev_subsetD]
-          dest: gen_new_keys_not_used)
-
-lemma analz_Key_image_insert_eq:
-     "[|K \<in> symKeys; Key K \<notin> used evs; evs \<in> set_cr |]
-      ==> analz (Key ` (insert K KK) \<union> knows Spy evs) =
-          insert (Key K) (analz (Key ` KK \<union> knows Spy evs))"
-by (simp add: gen_new_keys_not_analzd)
-
-lemma Crypt_parts_imp_used:
-     "[|Crypt K X \<in> parts (knows Spy evs);
-        K \<in> symKeys; evs \<in> set_cr |] ==> Key K \<in> used evs"
-apply (rule ccontr)
-apply (force dest: new_keys_not_used Crypt_imp_invKey_keysFor)
-done
-
-lemma Crypt_analz_imp_used:
-     "[|Crypt K X \<in> analz (knows Spy evs);
-        K \<in> symKeys; evs \<in> set_cr |] ==> Key K \<in> used evs"
-by (blast intro: Crypt_parts_imp_used)
-
-
-(*<*) 
-subsection{*Messages signed by CA*}
-
-text{*Message @{text SET_CR2}: C can check CA's signature if he has received
-     CA's certificate.*}
-lemma CA_Says_2_lemma:
-     "[| Crypt (priSK (CA i)) (Hash{|Agent C, Nonce NC1|})
-           \<in> parts (knows Spy evs);
-         evs \<in> set_cr; (CA i) \<notin> bad |]
-     ==> \<exists>Y. Says (CA i) C {|sign (priSK (CA i)) {|Agent C, Nonce NC1|}, Y|}
-                 \<in> set evs"
-apply (erule rev_mp)
-apply (erule set_cr.induct, auto)
-done
-
-text{*Ever used?*}
-lemma CA_Says_2:
-     "[| Crypt (invKey SK) (Hash{|Agent C, Nonce NC1|})
-           \<in> parts (knows Spy evs);
-         cert (CA i) SK onlySig (priSK RCA) \<in> parts (knows Spy evs);
-         evs \<in> set_cr; (CA i) \<notin> bad |]
-      ==> \<exists>Y. Says (CA i) C {|sign (priSK (CA i)) {|Agent C, Nonce NC1|}, Y|}
-                  \<in> set evs"
-by (blast dest!: certificate_valid_pubSK intro!: CA_Says_2_lemma)
-
-
-text{*Message @{text SET_CR4}: C can check CA's signature if he has received
-      CA's certificate.*}
-lemma CA_Says_4_lemma:
-     "[| Crypt (priSK (CA i)) (Hash{|Agent C, Nonce NC2, Nonce NCA|})
-           \<in> parts (knows Spy evs);
-         evs \<in> set_cr; (CA i) \<notin> bad |]
-      ==> \<exists>Y. Says (CA i) C {|sign (priSK (CA i))
-                     {|Agent C, Nonce NC2, Nonce NCA|}, Y|} \<in> set evs"
-apply (erule rev_mp)
-apply (erule set_cr.induct, auto)
-done
-
-text{*NEVER USED*}
-lemma CA_Says_4:
-     "[| Crypt (invKey SK) (Hash{|Agent C, Nonce NC2, Nonce NCA|})
-           \<in> parts (knows Spy evs);
-         cert (CA i) SK onlySig (priSK RCA) \<in> parts (knows Spy evs);
-         evs \<in> set_cr; (CA i) \<notin> bad |]
-      ==> \<exists>Y. Says (CA i) C {|sign (priSK (CA i))
-                   {|Agent C, Nonce NC2, Nonce NCA|}, Y|} \<in> set evs"
-by (blast dest!: certificate_valid_pubSK intro!: CA_Says_4_lemma)
-
-
-text{*Message @{text SET_CR6}: C can check CA's signature if he has
-      received CA's certificate.*}
-lemma CA_Says_6_lemma:
-     "[| Crypt (priSK (CA i)) 
-               (Hash{|Agent C, Nonce NC3, Agent (CA i), Nonce NonceCCA|})
-           \<in> parts (knows Spy evs);
-         evs \<in> set_cr; (CA i) \<notin> bad |]
-      ==> \<exists>Y K. Says (CA i) C (Crypt K {|sign (priSK (CA i))
-      {|Agent C, Nonce NC3, Agent (CA i), Nonce NonceCCA|}, Y|}) \<in> set evs"
-apply (erule rev_mp)
-apply (erule set_cr.induct, auto)
-done
-
-text{*NEVER USED*}
-lemma CA_Says_6:
-     "[| Crypt (invKey SK) (Hash{|Agent C, Nonce NC3, Agent (CA i), Nonce NonceCCA|})
-           \<in> parts (knows Spy evs);
-         cert (CA i) SK onlySig (priSK RCA) \<in> parts (knows Spy evs);
-         evs \<in> set_cr; (CA i) \<notin> bad |]
-      ==> \<exists>Y K. Says (CA i) C (Crypt K {|sign (priSK (CA i))
-                    {|Agent C, Nonce NC3, Agent (CA i), Nonce NonceCCA|}, Y|}) \<in> set evs"
-by (blast dest!: certificate_valid_pubSK intro!: CA_Says_6_lemma)
-(*>*)
-
-
-subsection{*Useful lemmas *}
-
-text{*Rewriting rule for private encryption keys.  Analogous rewriting rules
-for other keys aren't needed.*}
-
-lemma parts_image_priEK:
-     "[|Key (priEK C) \<in> parts (Key`KK Un (knows Spy evs));
-        evs \<in> set_cr|] ==> priEK C \<in> KK | C \<in> bad"
-by auto
-
-text{*trivial proof because (priEK C) never appears even in (parts evs)*}
-lemma analz_image_priEK:
-     "evs \<in> set_cr ==>
-          (Key (priEK C) \<in> analz (Key`KK Un (knows Spy evs))) =
-          (priEK C \<in> KK | C \<in> bad)"
-by (blast dest!: parts_image_priEK intro: analz_mono [THEN [2] rev_subsetD])
-
-
-subsection{*Secrecy of Session Keys *}
-
-subsubsection{*Lemmas about the predicate KeyCryptKey *}
-
-text{*A fresh DK cannot be associated with any other
-  (with respect to a given trace). *}
-lemma DK_fresh_not_KeyCryptKey:
-     "[| Key DK \<notin> used evs; evs \<in> set_cr |] ==> ~ KeyCryptKey DK K evs"
-apply (erule rev_mp)
-apply (erule set_cr.induct)
-apply (simp_all (no_asm_simp))
-apply (blast dest: Crypt_analz_imp_used)+
-done
-
-text{*A fresh K cannot be associated with any other.  The assumption that
-  DK isn't a private encryption key may be an artifact of the particular
-  definition of KeyCryptKey.*}
-lemma K_fresh_not_KeyCryptKey:
-     "[|\<forall>C. DK \<noteq> priEK C; Key K \<notin> used evs|] ==> ~ KeyCryptKey DK K evs"
-apply (induct evs)
-apply (auto simp add: parts_insert2 split add: event.split)
-done
-
-
-text{*This holds because if (priEK (CA i)) appears in any traffic then it must
-  be known to the Spy, by @{term Spy_see_private_Key}*}
-lemma cardSK_neq_priEK:
-     "[|Key cardSK \<notin> analz (knows Spy evs);
-        Key cardSK : parts (knows Spy evs);
-        evs \<in> set_cr|] ==> cardSK \<noteq> priEK C"
-by blast
-
-lemma not_KeyCryptKey_cardSK [rule_format (no_asm)]:
-     "[|cardSK \<notin> symKeys;  \<forall>C. cardSK \<noteq> priEK C;  evs \<in> set_cr|] ==>
-      Key cardSK \<notin> analz (knows Spy evs) --> ~ KeyCryptKey cardSK K evs"
-by (erule set_cr.induct, analz_mono_contra, auto)
-
-text{*Lemma for message 5: pubSK C is never used to encrypt Keys.*}
-lemma pubSK_not_KeyCryptKey [simp]: "~ KeyCryptKey (pubSK C) K evs"
-apply (induct_tac "evs")
-apply (auto simp add: parts_insert2 split add: event.split)
-done
-
-text{*Lemma for message 6: either cardSK is compromised (when we don't care)
-  or else cardSK hasn't been used to encrypt K.  Previously we treated
-  message 5 in the same way, but the current model assumes that rule
-  @{text SET_CR5} is executed only by honest agents.*}
-lemma msg6_KeyCryptKey_disj:
-     "[|Gets B {|Crypt KC3 {|Agent C, Nonce N, Key KC2, Key cardSK, X|}, Y|}
-          \<in> set evs;
-        cardSK \<notin> symKeys;  evs \<in> set_cr|]
-      ==> Key cardSK \<in> analz (knows Spy evs) |
-          (\<forall>K. ~ KeyCryptKey cardSK K evs)"
-by (blast dest: not_KeyCryptKey_cardSK intro: cardSK_neq_priEK)
-
-text{*As usual: we express the property as a logical equivalence*}
-lemma Key_analz_image_Key_lemma:
-     "P --> (Key K \<in> analz (Key`KK Un H)) --> (K \<in> KK | Key K \<in> analz H)
-      ==>
-      P --> (Key K \<in> analz (Key`KK Un H)) = (K \<in> KK | Key K \<in> analz H)"
-by (blast intro: analz_mono [THEN [2] rev_subsetD])
-
-method_setup valid_certificate_tac = {*
-  Args.goal_spec >> (fn quant => K (SIMPLE_METHOD'' quant
-    (fn i =>
-      EVERY [ftac @{thm Gets_certificate_valid} i,
-             assume_tac i,
-             etac conjE i, REPEAT (hyp_subst_tac i)])))
-*} ""
-
-text{*The @{text "(no_asm)"} attribute is essential, since it retains
-  the quantifier and allows the simprule's condition to itself be simplified.*}
-lemma symKey_compromise [rule_format (no_asm)]:
-     "evs \<in> set_cr ==>
-      (\<forall>SK KK. SK \<in> symKeys \<longrightarrow> (\<forall>K \<in> KK. ~ KeyCryptKey K SK evs)   -->
-               (Key SK \<in> analz (Key`KK Un (knows Spy evs))) =
-               (SK \<in> KK | Key SK \<in> analz (knows Spy evs)))"
-apply (erule set_cr.induct)
-apply (rule_tac [!] allI) +
-apply (rule_tac [!] impI [THEN Key_analz_image_Key_lemma, THEN impI])+
-apply (valid_certificate_tac [8]) --{*for message 5*}
-apply (valid_certificate_tac [6]) --{*for message 5*}
-apply (erule_tac [9] msg6_KeyCryptKey_disj [THEN disjE])
-apply (simp_all
-         del: image_insert image_Un imp_disjL
-         add: analz_image_keys_simps analz_knows_absorb
-              analz_Key_image_insert_eq notin_image_iff
-              K_fresh_not_KeyCryptKey
-              DK_fresh_not_KeyCryptKey ball_conj_distrib
-              analz_image_priEK disj_simps)
-  --{*9 seconds on a 1.6GHz machine*}
-apply spy_analz
-apply blast  --{*3*}
-apply blast  --{*5*}
-done
-
-text{*The remaining quantifiers seem to be essential.
-  NO NEED to assume the cardholder's OK: bad cardholders don't do anything
-  wrong!!*}
-lemma symKey_secrecy [rule_format]:
-     "[|CA i \<notin> bad;  K \<in> symKeys;  evs \<in> set_cr|]
-      ==> \<forall>X c. Says (Cardholder c) (CA i) X \<in> set evs -->
-                Key K \<in> parts{X} -->
-                Cardholder c \<notin> bad -->
-                Key K \<notin> analz (knows Spy evs)"
-apply (erule set_cr.induct)
-apply (frule_tac [8] Gets_certificate_valid) --{*for message 5*}
-apply (frule_tac [6] Gets_certificate_valid) --{*for message 3*}
-apply (erule_tac [11] msg6_KeyCryptKey_disj [THEN disjE])
-apply (simp_all del: image_insert image_Un imp_disjL
-         add: symKey_compromise fresh_notin_analz_knows_Spy
-              analz_image_keys_simps analz_knows_absorb
-              analz_Key_image_insert_eq notin_image_iff
-              K_fresh_not_KeyCryptKey
-              DK_fresh_not_KeyCryptKey
-              analz_image_priEK)
-  --{*2.5 seconds on a 1.6GHz machine*}
-apply spy_analz  --{*Fake*}
-apply (auto intro: analz_into_parts [THEN usedI] in_parts_Says_imp_used)
-done
-
-
-subsection{*Primary Goals of Cardholder Registration *}
-
-text{*The cardholder's certificate really was created by the CA, provided the
-    CA is uncompromised *}
-
-text{*Lemma concerning the actual signed message digest*}
-lemma cert_valid_lemma:
-     "[|Crypt (priSK (CA i)) {|Hash {|Nonce N, Pan(pan C)|}, Key cardSK, N1|}
-          \<in> parts (knows Spy evs);
-        CA i \<notin> bad; evs \<in> set_cr|]
-  ==> \<exists>KC2 X Y. Says (CA i) C
-                     (Crypt KC2 
-                       {|X, certC (pan C) cardSK N onlySig (priSK (CA i)), Y|})
-                  \<in> set evs"
-apply (erule rev_mp)
-apply (erule set_cr.induct)
-apply (simp_all (no_asm_simp))
-apply auto
-done
-
-text{*Pre-packaged version for cardholder.  We don't try to confirm the values
-  of KC2, X and Y, since they are not important.*}
-lemma certificate_valid_cardSK:
-    "[|Gets C (Crypt KC2 {|X, certC (pan C) cardSK N onlySig (invKey SKi),
-                              cert (CA i) SKi onlySig (priSK RCA)|}) \<in> set evs;
-        CA i \<notin> bad; evs \<in> set_cr|]
-  ==> \<exists>KC2 X Y. Says (CA i) C
-                     (Crypt KC2 
-                       {|X, certC (pan C) cardSK N onlySig (priSK (CA i)), Y|})
-                   \<in> set evs"
-by (force dest!: Gets_imp_knows_Spy [THEN parts.Inj, THEN parts.Body]
-                    certificate_valid_pubSK cert_valid_lemma)
-
-
-lemma Hash_imp_parts [rule_format]:
-     "evs \<in> set_cr
-      ==> Hash{|X, Nonce N|} \<in> parts (knows Spy evs) -->
-          Nonce N \<in> parts (knows Spy evs)"
-apply (erule set_cr.induct, force)
-apply (simp_all (no_asm_simp))
-apply (blast intro: parts_mono [THEN [2] rev_subsetD])
-done
-
-lemma Hash_imp_parts2 [rule_format]:
-     "evs \<in> set_cr
-      ==> Hash{|X, Nonce M, Y, Nonce N|} \<in> parts (knows Spy evs) -->
-          Nonce M \<in> parts (knows Spy evs) & Nonce N \<in> parts (knows Spy evs)"
-apply (erule set_cr.induct, force)
-apply (simp_all (no_asm_simp))
-apply (blast intro: parts_mono [THEN [2] rev_subsetD])
-done
-
-
-subsection{*Secrecy of Nonces*}
-
-subsubsection{*Lemmas about the predicate KeyCryptNonce *}
-
-text{*A fresh DK cannot be associated with any other
-  (with respect to a given trace). *}
-lemma DK_fresh_not_KeyCryptNonce:
-     "[| DK \<in> symKeys; Key DK \<notin> used evs; evs \<in> set_cr |]
-      ==> ~ KeyCryptNonce DK K evs"
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule set_cr.induct)
-apply (simp_all (no_asm_simp))
-apply blast
-apply blast
-apply (auto simp add: DK_fresh_not_KeyCryptKey)
-done
-
-text{*A fresh N cannot be associated with any other
-      (with respect to a given trace). *}
-lemma N_fresh_not_KeyCryptNonce:
-     "\<forall>C. DK \<noteq> priEK C ==> Nonce N \<notin> used evs --> ~ KeyCryptNonce DK N evs"
-apply (induct_tac "evs")
-apply (case_tac [2] "a")
-apply (auto simp add: parts_insert2)
-done
-
-lemma not_KeyCryptNonce_cardSK [rule_format (no_asm)]:
-     "[|cardSK \<notin> symKeys;  \<forall>C. cardSK \<noteq> priEK C;  evs \<in> set_cr|] ==>
-      Key cardSK \<notin> analz (knows Spy evs) --> ~ KeyCryptNonce cardSK N evs"
-apply (erule set_cr.induct, analz_mono_contra, simp_all)
-apply (blast dest: not_KeyCryptKey_cardSK)  --{*6*}
-done
-
-subsubsection{*Lemmas for message 5 and 6:
-  either cardSK is compromised (when we don't care)
-  or else cardSK hasn't been used to encrypt K. *}
-
-text{*Lemma for message 5: pubSK C is never used to encrypt Nonces.*}
-lemma pubSK_not_KeyCryptNonce [simp]: "~ KeyCryptNonce (pubSK C) N evs"
-apply (induct_tac "evs")
-apply (auto simp add: parts_insert2 split add: event.split)
-done
-
-text{*Lemma for message 6: either cardSK is compromised (when we don't care)
-  or else cardSK hasn't been used to encrypt K.*}
-lemma msg6_KeyCryptNonce_disj:
-     "[|Gets B {|Crypt KC3 {|Agent C, Nonce N, Key KC2, Key cardSK, X|}, Y|}
-          \<in> set evs;
-        cardSK \<notin> symKeys;  evs \<in> set_cr|]
-      ==> Key cardSK \<in> analz (knows Spy evs) |
-          ((\<forall>K. ~ KeyCryptKey cardSK K evs) &
-           (\<forall>N. ~ KeyCryptNonce cardSK N evs))"
-by (blast dest: not_KeyCryptKey_cardSK not_KeyCryptNonce_cardSK
-          intro: cardSK_neq_priEK)
-
-
-text{*As usual: we express the property as a logical equivalence*}
-lemma Nonce_analz_image_Key_lemma:
-     "P --> (Nonce N \<in> analz (Key`KK Un H)) --> (Nonce N \<in> analz H)
-      ==> P --> (Nonce N \<in> analz (Key`KK Un H)) = (Nonce N \<in> analz H)"
-by (blast intro: analz_mono [THEN [2] rev_subsetD])
-
-
-text{*The @{text "(no_asm)"} attribute is essential, since it retains
-  the quantifier and allows the simprule's condition to itself be simplified.*}
-lemma Nonce_compromise [rule_format (no_asm)]:
-     "evs \<in> set_cr ==>
-      (\<forall>N KK. (\<forall>K \<in> KK. ~ KeyCryptNonce K N evs)   -->
-               (Nonce N \<in> analz (Key`KK Un (knows Spy evs))) =
-               (Nonce N \<in> analz (knows Spy evs)))"
-apply (erule set_cr.induct)
-apply (rule_tac [!] allI)+
-apply (rule_tac [!] impI [THEN Nonce_analz_image_Key_lemma])+
-apply (frule_tac [8] Gets_certificate_valid) --{*for message 5*}
-apply (frule_tac [6] Gets_certificate_valid) --{*for message 3*}
-apply (frule_tac [11] msg6_KeyCryptNonce_disj)
-apply (erule_tac [13] disjE)
-apply (simp_all del: image_insert image_Un
-         add: symKey_compromise
-              analz_image_keys_simps analz_knows_absorb
-              analz_Key_image_insert_eq notin_image_iff
-              N_fresh_not_KeyCryptNonce
-              DK_fresh_not_KeyCryptNonce K_fresh_not_KeyCryptKey
-              ball_conj_distrib analz_image_priEK)
-  --{*14 seconds on a 1.6GHz machine*}
-apply spy_analz  --{*Fake*}
-apply blast  --{*3*}
-apply blast  --{*5*}
-txt{*Message 6*}
-apply (metis symKey_compromise)
-  --{*cardSK compromised*}
-txt{*Simplify again--necessary because the previous simplification introduces
-  some logical connectives*} 
-apply (force simp del: image_insert image_Un imp_disjL
-          simp add: analz_image_keys_simps symKey_compromise)
-done
-
-
-subsection{*Secrecy of CardSecret: the Cardholder's secret*}
-
-lemma NC2_not_CardSecret:
-     "[|Crypt EKj {|Key K, Pan p, Hash {|Agent D, Nonce N|}|}
-          \<in> parts (knows Spy evs);
-        Key K \<notin> analz (knows Spy evs);
-        Nonce N \<notin> analz (knows Spy evs);
-       evs \<in> set_cr|]
-      ==> Crypt EKi {|Key K', Pan p', Nonce N|} \<notin> parts (knows Spy evs)"
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule set_cr.induct, analz_mono_contra, simp_all)
-apply (blast dest: Hash_imp_parts)+
-done
-
-lemma KC2_secure_lemma [rule_format]:
-     "[|U = Crypt KC3 {|Agent C, Nonce N, Key KC2, X|};
-        U \<in> parts (knows Spy evs);
-        evs \<in> set_cr|]
-  ==> Nonce N \<notin> analz (knows Spy evs) -->
-      (\<exists>k i W. Says (Cardholder k) (CA i) {|U,W|} \<in> set evs & 
-               Cardholder k \<notin> bad & CA i \<notin> bad)"
-apply (erule_tac P = "U \<in> ?H" in rev_mp)
-apply (erule set_cr.induct)
-apply (valid_certificate_tac [8])  --{*for message 5*}
-apply (simp_all del: image_insert image_Un imp_disjL
-         add: analz_image_keys_simps analz_knows_absorb
-              analz_knows_absorb2 notin_image_iff)
-  --{*4 seconds on a 1.6GHz machine*}
-apply (simp_all (no_asm_simp)) --{*leaves 4 subgoals*}
-apply (blast intro!: analz_insertI)+
-done
-
-lemma KC2_secrecy:
-     "[|Gets B {|Crypt K {|Agent C, Nonce N, Key KC2, X|}, Y|} \<in> set evs;
-        Nonce N \<notin> analz (knows Spy evs);  KC2 \<in> symKeys;
-        evs \<in> set_cr|]
-       ==> Key KC2 \<notin> analz (knows Spy evs)"
-by (force dest!: refl [THEN KC2_secure_lemma] symKey_secrecy)
-
-
-text{*Inductive version*}
-lemma CardSecret_secrecy_lemma [rule_format]:
-     "[|CA i \<notin> bad;  evs \<in> set_cr|]
-      ==> Key K \<notin> analz (knows Spy evs) -->
-          Crypt (pubEK (CA i)) {|Key K, Pan p, Nonce CardSecret|}
-             \<in> parts (knows Spy evs) -->
-          Nonce CardSecret \<notin> analz (knows Spy evs)"
-apply (erule set_cr.induct, analz_mono_contra)
-apply (valid_certificate_tac [8]) --{*for message 5*}
-apply (valid_certificate_tac [6]) --{*for message 5*}
-apply (frule_tac [9] msg6_KeyCryptNonce_disj [THEN disjE])
-apply (simp_all
-         del: image_insert image_Un imp_disjL
-         add: analz_image_keys_simps analz_knows_absorb
-              analz_Key_image_insert_eq notin_image_iff
-              EXHcrypt_def Crypt_notin_image_Key
-              N_fresh_not_KeyCryptNonce DK_fresh_not_KeyCryptNonce
-              ball_conj_distrib Nonce_compromise symKey_compromise
-              analz_image_priEK)
-  --{*2.5 seconds on a 1.6GHz machine*}
-apply spy_analz  --{*Fake*}
-apply (simp_all (no_asm_simp))
-apply blast  --{*1*}
-apply (blast dest!: Gets_imp_knows_Spy [THEN analz.Inj])  --{*2*}
-apply blast  --{*3*}
-apply (blast dest: NC2_not_CardSecret Gets_imp_knows_Spy [THEN analz.Inj] analz_symKeys_Decrypt)  --{*4*}
-apply blast  --{*5*}
-apply (blast dest: KC2_secrecy)+  --{*Message 6: two cases*}
-done
-
-
-text{*Packaged version for cardholder*}
-lemma CardSecret_secrecy:
-     "[|Cardholder k \<notin> bad;  CA i \<notin> bad;
-        Says (Cardholder k) (CA i)
-           {|X, Crypt EKi {|Key KC3, Pan p, Nonce CardSecret|}|} \<in> set evs;
-        Gets A {|Z, cert (CA i) EKi onlyEnc (priSK RCA),
-                    cert (CA i) SKi onlySig (priSK RCA)|} \<in> set evs;
-        KC3 \<in> symKeys;  evs \<in> set_cr|]
-      ==> Nonce CardSecret \<notin> analz (knows Spy evs)"
-apply (frule Gets_certificate_valid, assumption)
-apply (subgoal_tac "Key KC3 \<notin> analz (knows Spy evs) ")
-apply (blast dest: CardSecret_secrecy_lemma)
-apply (rule symKey_secrecy)
-apply (auto simp add: parts_insert2)
-done
-
-
-subsection{*Secrecy of NonceCCA [the CA's secret] *}
-
-lemma NC2_not_NonceCCA:
-     "[|Hash {|Agent C', Nonce N', Agent C, Nonce N|}
-          \<in> parts (knows Spy evs);
-        Nonce N \<notin> analz (knows Spy evs);
-       evs \<in> set_cr|]
-      ==> Crypt KC1 {|{|Agent B, Nonce N|}, Hash p|} \<notin> parts (knows Spy evs)"
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule set_cr.induct, analz_mono_contra, simp_all)
-apply (blast dest: Hash_imp_parts2)+
-done
-
-
-text{*Inductive version*}
-lemma NonceCCA_secrecy_lemma [rule_format]:
-     "[|CA i \<notin> bad;  evs \<in> set_cr|]
-      ==> Key K \<notin> analz (knows Spy evs) -->
-          Crypt K
-            {|sign (priSK (CA i))
-                   {|Agent C, Nonce N, Agent(CA i), Nonce NonceCCA|},
-              X, Y|}
-             \<in> parts (knows Spy evs) -->
-          Nonce NonceCCA \<notin> analz (knows Spy evs)"
-apply (erule set_cr.induct, analz_mono_contra)
-apply (valid_certificate_tac [8]) --{*for message 5*}
-apply (valid_certificate_tac [6]) --{*for message 5*}
-apply (frule_tac [9] msg6_KeyCryptNonce_disj [THEN disjE])
-apply (simp_all
-         del: image_insert image_Un imp_disjL
-         add: analz_image_keys_simps analz_knows_absorb sign_def
-              analz_Key_image_insert_eq notin_image_iff
-              EXHcrypt_def Crypt_notin_image_Key
-              N_fresh_not_KeyCryptNonce DK_fresh_not_KeyCryptNonce
-              ball_conj_distrib Nonce_compromise symKey_compromise
-              analz_image_priEK)
-  --{*3 seconds on a 1.6GHz machine*}
-apply spy_analz  --{*Fake*}
-apply blast  --{*1*}
-apply (blast dest!: Gets_imp_knows_Spy [THEN analz.Inj])  --{*2*}
-apply blast  --{*3*}
-apply (blast dest: NC2_not_NonceCCA)  --{*4*}
-apply blast  --{*5*}
-apply (blast dest: KC2_secrecy)+  --{*Message 6: two cases*}
-done
-
-
-text{*Packaged version for cardholder*}
-lemma NonceCCA_secrecy:
-     "[|Cardholder k \<notin> bad;  CA i \<notin> bad;
-        Gets (Cardholder k)
-           (Crypt KC2
-            {|sign (priSK (CA i)) {|Agent C, Nonce N, Agent(CA i), Nonce NonceCCA|},
-              X, Y|}) \<in> set evs;
-        Says (Cardholder k) (CA i)
-           {|Crypt KC3 {|Agent C, Nonce NC3, Key KC2, X'|}, Y'|} \<in> set evs;
-        Gets A {|Z, cert (CA i) EKi onlyEnc (priSK RCA),
-                    cert (CA i) SKi onlySig (priSK RCA)|} \<in> set evs;
-        KC2 \<in> symKeys;  evs \<in> set_cr|]
-      ==> Nonce NonceCCA \<notin> analz (knows Spy evs)"
-apply (frule Gets_certificate_valid, assumption)
-apply (subgoal_tac "Key KC2 \<notin> analz (knows Spy evs) ")
-apply (blast dest: NonceCCA_secrecy_lemma)
-apply (rule symKey_secrecy)
-apply (auto simp add: parts_insert2)
-done
-
-text{*We don't bother to prove guarantees for the CA.  He doesn't care about
-  the PANSecret: it isn't his credit card!*}
-
-
-subsection{*Rewriting Rule for PANs*}
-
-text{*Lemma for message 6: either cardSK isn't a CA's private encryption key,
-  or if it is then (because it appears in traffic) that CA is bad,
-  and so the Spy knows that key already.  Either way, we can simplify
-  the expression @{term "analz (insert (Key cardSK) X)"}.*}
-lemma msg6_cardSK_disj:
-     "[|Gets A {|Crypt K {|c, n, k', Key cardSK, X|}, Y|}
-          \<in> set evs;  evs \<in> set_cr |]
-      ==> cardSK \<notin> range(invKey o pubEK o CA) | Key cardSK \<in> knows Spy evs"
-by auto
-
-lemma analz_image_pan_lemma:
-     "(Pan P \<in> analz (Key`nE Un H)) --> (Pan P \<in> analz H)  ==>
-      (Pan P \<in> analz (Key`nE Un H)) =   (Pan P \<in> analz H)"
-by (blast intro: analz_mono [THEN [2] rev_subsetD])
-
-lemma analz_image_pan [rule_format]:
-     "evs \<in> set_cr ==>
-       \<forall>KK. KK <= - invKey ` pubEK ` range CA -->
-            (Pan P \<in> analz (Key`KK Un (knows Spy evs))) =
-            (Pan P \<in> analz (knows Spy evs))"
-apply (erule set_cr.induct)
-apply (rule_tac [!] allI impI)+
-apply (rule_tac [!] analz_image_pan_lemma)
-apply (valid_certificate_tac [8]) --{*for message 5*}
-apply (valid_certificate_tac [6]) --{*for message 5*}
-apply (erule_tac [9] msg6_cardSK_disj [THEN disjE])
-apply (simp_all
-         del: image_insert image_Un
-         add: analz_image_keys_simps disjoint_image_iff
-              notin_image_iff analz_image_priEK)
-  --{*6 seconds on a 1.6GHz machine*}
-apply spy_analz
-apply (simp add: insert_absorb)  --{*6*}
-done
-
-lemma analz_insert_pan:
-     "[| evs \<in> set_cr;  K \<notin> invKey ` pubEK ` range CA |] ==>
-          (Pan P \<in> analz (insert (Key K) (knows Spy evs))) =
-          (Pan P \<in> analz (knows Spy evs))"
-by (simp del: image_insert image_Un
-         add: analz_image_keys_simps analz_image_pan)
-
-
-text{*Confidentiality of the PAN\@.  Maybe we could combine the statements of
-  this theorem with @{term analz_image_pan}, requiring a single induction but
-  a much more difficult proof.*}
-lemma pan_confidentiality:
-     "[| Pan (pan C) \<in> analz(knows Spy evs); C \<noteq>Spy; evs :set_cr|]
-    ==> \<exists>i X K HN.
-        Says C (CA i) {|X, Crypt (pubEK (CA i)) {|Key K, Pan (pan C), HN|} |}
-           \<in> set evs
-      & (CA i) \<in> bad"
-apply (erule rev_mp)
-apply (erule set_cr.induct)
-apply (valid_certificate_tac [8]) --{*for message 5*}
-apply (valid_certificate_tac [6]) --{*for message 5*}
-apply (erule_tac [9] msg6_cardSK_disj [THEN disjE])
-apply (simp_all
-         del: image_insert image_Un
-         add: analz_image_keys_simps analz_insert_pan analz_image_pan
-              notin_image_iff analz_image_priEK)
-  --{*3.5 seconds on a 1.6GHz machine*}
-apply spy_analz  --{*fake*}
-apply blast  --{*3*}
-apply blast  --{*5*}
-apply (simp (no_asm_simp) add: insert_absorb)  --{*6*}
-done
-
-
-subsection{*Unicity*}
-
-lemma CR6_Says_imp_Notes:
-     "[|Says (CA i) C (Crypt KC2
-          {|sign (priSK (CA i)) {|Agent C, Nonce NC3, Agent (CA i), Nonce Y|},
-            certC (pan C) cardSK X onlySig (priSK (CA i)),
-            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})  \<in> set evs;
-        evs \<in> set_cr |]
-      ==> Notes (CA i) (Key cardSK) \<in> set evs"
-apply (erule rev_mp)
-apply (erule set_cr.induct)
-apply (simp_all (no_asm_simp))
-done
-
-text{*Unicity of cardSK: it uniquely identifies the other components.  
-      This holds because a CA accepts a cardSK at most once.*}
-lemma cardholder_key_unicity:
-     "[|Says (CA i) C (Crypt KC2
-          {|sign (priSK (CA i)) {|Agent C, Nonce NC3, Agent (CA i), Nonce Y|},
-            certC (pan C) cardSK X onlySig (priSK (CA i)),
-            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})
-          \<in> set evs;
-        Says (CA i) C' (Crypt KC2'
-          {|sign (priSK (CA i)) {|Agent C', Nonce NC3', Agent (CA i), Nonce Y'|},
-            certC (pan C') cardSK X' onlySig (priSK (CA i)),
-            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})
-          \<in> set evs;
-        evs \<in> set_cr |] ==> C=C' & NC3=NC3' & X=X' & KC2=KC2' & Y=Y'"
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule set_cr.induct)
-apply (simp_all (no_asm_simp))
-apply (blast dest!: CR6_Says_imp_Notes)
-done
-
-
-(*<*)
-text{*UNUSED unicity result*}
-lemma unique_KC1:
-     "[|Says C B {|Crypt KC1 X, Crypt EK {|Key KC1, Y|}|}
-          \<in> set evs;
-        Says C B' {|Crypt KC1 X', Crypt EK' {|Key KC1, Y'|}|}
-          \<in> set evs;
-        C \<notin> bad;  evs \<in> set_cr|] ==> B'=B & Y'=Y"
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule set_cr.induct, auto)
-done
-
-text{*UNUSED unicity result*}
-lemma unique_KC2:
-     "[|Says C B {|Crypt K {|Agent C, nn, Key KC2, X|}, Y|} \<in> set evs;
-        Says C B' {|Crypt K' {|Agent C, nn', Key KC2, X'|}, Y'|} \<in> set evs;
-        C \<notin> bad;  evs \<in> set_cr|] ==> B'=B & X'=X"
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule set_cr.induct, auto)
-done
-(*>*)
-
-
-text{*Cannot show cardSK to be secret because it isn't assumed to be fresh
-  it could be a previously compromised cardSK [e.g. involving a bad CA]*}
-
-
-end
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/SET-Protocol/EventSET.thy
--- a/src/HOL/SET-Protocol/EventSET.thy	Tue Oct 20 19:52:04 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,196 +0,0 @@
-(*  Title:      HOL/SET-Protocol/EventSET.thy
-    Author:     Giampaolo Bella
-    Author:     Fabio Massacci
-    Author:     Lawrence C Paulson
-*)
-
-header{*Theory of Events for SET*}
-
-theory EventSET imports MessageSET begin
-
-text{*The Root Certification Authority*}
-syntax        RCA :: agent
-translations "RCA" == "CA 0"
-
-
-text{*Message events*}
-datatype
-  event = Says  agent agent msg
-        | Gets  agent       msg
-        | Notes agent       msg
-
-
-text{*compromised agents: keys known, Notes visible*}
-consts bad :: "agent set"
-
-text{*Spy has access to his own key for spoof messages, but RCA is secure*}
-specification (bad)
-  Spy_in_bad     [iff]: "Spy \<in> bad"
-  RCA_not_bad [iff]: "RCA \<notin> bad"
-    by (rule exI [of _ "{Spy}"], simp)
-
-
-subsection{*Agents' Knowledge*}
-
-consts  (*Initial states of agents -- parameter of the construction*)
-  initState :: "agent => msg set"
-  knows  :: "[agent, event list] => msg set"
-
-(* Message reception does not extend spy's knowledge because of
-   reception invariant enforced by Reception rule in protocol definition*)
-primrec
-
-knows_Nil:
-  "knows A []       = initState A"
-knows_Cons:
-    "knows A (ev # evs) =
-       (if A = Spy then
-        (case ev of
-           Says A' B X => insert X (knows Spy evs)
-         | Gets A' X => knows Spy evs
-         | Notes A' X  =>
-             if A' \<in> bad then insert X (knows Spy evs) else knows Spy evs)
-        else
-        (case ev of
-           Says A' B X =>
-             if A'=A then insert X (knows A evs) else knows A evs
-         | Gets A' X    =>
-             if A'=A then insert X (knows A evs) else knows A evs
-         | Notes A' X    =>
-             if A'=A then insert X (knows A evs) else knows A evs))"
-
-
-subsection{*Used Messages*}
-
-consts
-  (*Set of items that might be visible to somebody:
-    complement of the set of fresh items*)
-  used :: "event list => msg set"
-
-(* As above, message reception does extend used items *)
-primrec
-  used_Nil:  "used []         = (UN B. parts (initState B))"
-  used_Cons: "used (ev # evs) =
-                 (case ev of
-                    Says A B X => parts {X} Un (used evs)
-                  | Gets A X   => used evs
-                  | Notes A X  => parts {X} Un (used evs))"
-
-
-
-(* Inserted by default but later removed.  This declaration lets the file
-be re-loaded. Addsimps [knows_Cons, used_Nil, *)
-
-(** Simplifying   parts (insert X (knows Spy evs))
-      = parts {X} Un parts (knows Spy evs) -- since general case loops*)
-
-lemmas parts_insert_knows_A = parts_insert [of _ "knows A evs", standard]
-
-lemma knows_Spy_Says [simp]:
-     "knows Spy (Says A B X # evs) = insert X (knows Spy evs)"
-by auto
-
-text{*Letting the Spy see "bad" agents' notes avoids redundant case-splits
-      on whether @{term "A=Spy"} and whether @{term "A\<in>bad"}*}
-lemma knows_Spy_Notes [simp]:
-     "knows Spy (Notes A X # evs) =
-          (if A:bad then insert X (knows Spy evs) else knows Spy evs)"
-apply auto
-done
-
-lemma knows_Spy_Gets [simp]: "knows Spy (Gets A X # evs) = knows Spy evs"
-by auto
-
-lemma initState_subset_knows: "initState A <= knows A evs"
-apply (induct_tac "evs")
-apply (auto split: event.split) 
-done
-
-lemma knows_Spy_subset_knows_Spy_Says:
-     "knows Spy evs <= knows Spy (Says A B X # evs)"
-by auto
-
-lemma knows_Spy_subset_knows_Spy_Notes:
-     "knows Spy evs <= knows Spy (Notes A X # evs)"
-by auto
-
-lemma knows_Spy_subset_knows_Spy_Gets:
-     "knows Spy evs <= knows Spy (Gets A X # evs)"
-by auto
-
-(*Spy sees what is sent on the traffic*)
-lemma Says_imp_knows_Spy [rule_format]:
-     "Says A B X \<in> set evs --> X \<in> knows Spy evs"
-apply (induct_tac "evs")
-apply (auto split: event.split) 
-done
-
-(*Use with addSEs to derive contradictions from old Says events containing
-  items known to be fresh*)
-lemmas knows_Spy_partsEs =
-     Says_imp_knows_Spy [THEN parts.Inj, THEN revcut_rl, standard] 
-     parts.Body [THEN revcut_rl, standard]
-
-
-subsection{*The Function @{term used}*}
-
-lemma parts_knows_Spy_subset_used: "parts (knows Spy evs) <= used evs"
-apply (induct_tac "evs")
-apply (auto simp add: parts_insert_knows_A split: event.split) 
-done
-
-lemmas usedI = parts_knows_Spy_subset_used [THEN subsetD, intro]
-
-lemma initState_subset_used: "parts (initState B) <= used evs"
-apply (induct_tac "evs")
-apply (auto split: event.split) 
-done
-
-lemmas initState_into_used = initState_subset_used [THEN subsetD]
-
-lemma used_Says [simp]: "used (Says A B X # evs) = parts{X} Un used evs"
-by auto
-
-lemma used_Notes [simp]: "used (Notes A X # evs) = parts{X} Un used evs"
-by auto
-
-lemma used_Gets [simp]: "used (Gets A X # evs) = used evs"
-by auto
-
-
-lemma Notes_imp_parts_subset_used [rule_format]:
-     "Notes A X \<in> set evs --> parts {X} <= used evs"
-apply (induct_tac "evs")
-apply (induct_tac [2] "a", auto)
-done
-
-text{*NOTE REMOVAL--laws above are cleaner, as they don't involve "case"*}
-declare knows_Cons [simp del]
-        used_Nil [simp del] used_Cons [simp del]
-
-
-text{*For proving theorems of the form @{term "X \<notin> analz (knows Spy evs) --> P"}
-  New events added by induction to "evs" are discarded.  Provided 
-  this information isn't needed, the proof will be much shorter, since
-  it will omit complicated reasoning about @{term analz}.*}
-
-lemmas analz_mono_contra =
-       knows_Spy_subset_knows_Spy_Says [THEN analz_mono, THEN contra_subsetD]
-       knows_Spy_subset_knows_Spy_Notes [THEN analz_mono, THEN contra_subsetD]
-       knows_Spy_subset_knows_Spy_Gets [THEN analz_mono, THEN contra_subsetD]
-
-lemmas analz_impI = impI [where P = "Y \<notin> analz (knows Spy evs)", standard]
-
-ML
-{*
-val analz_mono_contra_tac = 
-  rtac @{thm analz_impI} THEN' 
-  REPEAT1 o (dresolve_tac @{thms analz_mono_contra})
-  THEN' mp_tac
-*}
-
-method_setup analz_mono_contra = {*
-    Scan.succeed (K (SIMPLE_METHOD (REPEAT_FIRST analz_mono_contra_tac))) *}
-    "for proving theorems of the form X \<notin> analz (knows Spy evs) --> P"
-
-end
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/SET-Protocol/Merchant_Registration.thy
--- a/src/HOL/SET-Protocol/Merchant_Registration.thy	Tue Oct 20 19:52:04 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,427 +0,0 @@
-(*  Title:      HOL/SET-Protocol/Merchant_Registration.thy
-    Author:     Giampaolo Bella
-    Author:     Fabio Massacci
-    Author:     Lawrence C Paulson
-*)
-
-header{*The SET Merchant Registration Protocol*}
-
-theory Merchant_Registration imports PublicSET begin
-
-text{*Copmpared with Cardholder Reigstration, @{text KeyCryptKey} is not
-  needed: no session key encrypts another.  Instead we
-  prove the "key compromise" theorems for sets KK that contain no private
-  encryption keys (@{term "priEK C"}). *}
-
-
-inductive_set
-  set_mr :: "event list set"
-where
-
-  Nil:    --{*Initial trace is empty*}
-           "[] \<in> set_mr"
-
-
-| Fake:    --{*The spy MAY say anything he CAN say.*}
-           "[| evsf \<in> set_mr; X \<in> synth (analz (knows Spy evsf)) |]
-            ==> Says Spy B X  # evsf \<in> set_mr"
-        
-
-| Reception: --{*If A sends a message X to B, then B might receive it*}
-             "[| evsr \<in> set_mr; Says A B X \<in> set evsr |]
-              ==> Gets B X  # evsr \<in> set_mr"
-
-
-| SET_MR1: --{*RegFormReq: M requires a registration form to a CA*}
-           "[| evs1 \<in> set_mr; M = Merchant k; Nonce NM1 \<notin> used evs1 |]
-            ==> Says M (CA i) {|Agent M, Nonce NM1|} # evs1 \<in> set_mr"
-
-
-| SET_MR2: --{*RegFormRes: CA replies with the registration form and the 
-               certificates for her keys*}
-  "[| evs2 \<in> set_mr; Nonce NCA \<notin> used evs2;
-      Gets (CA i) {|Agent M, Nonce NM1|} \<in> set evs2 |]
-   ==> Says (CA i) M {|sign (priSK (CA i)) {|Agent M, Nonce NM1, Nonce NCA|},
-                       cert (CA i) (pubEK (CA i)) onlyEnc (priSK RCA),
-                       cert (CA i) (pubSK (CA i)) onlySig (priSK RCA) |}
-         # evs2 \<in> set_mr"
-
-| SET_MR3:
-         --{*CertReq: M submits the key pair to be certified.  The Notes
-             event allows KM1 to be lost if M is compromised. Piero remarks
-             that the agent mentioned inside the signature is not verified to
-             correspond to M.  As in CR, each Merchant has fixed key pairs.  M
-             is only optionally required to send NCA back, so M doesn't do so
-             in the model*}
-  "[| evs3 \<in> set_mr; M = Merchant k; Nonce NM2 \<notin> used evs3;
-      Key KM1 \<notin> used evs3;  KM1 \<in> symKeys;
-      Gets M {|sign (invKey SKi) {|Agent X, Nonce NM1, Nonce NCA|},
-               cert (CA i) EKi onlyEnc (priSK RCA),
-               cert (CA i) SKi onlySig (priSK RCA) |}
-        \<in> set evs3;
-      Says M (CA i) {|Agent M, Nonce NM1|} \<in> set evs3 |]
-   ==> Says M (CA i)
-            {|Crypt KM1 (sign (priSK M) {|Agent M, Nonce NM2,
-                                          Key (pubSK M), Key (pubEK M)|}),
-              Crypt EKi (Key KM1)|}
-         # Notes M {|Key KM1, Agent (CA i)|}
-         # evs3 \<in> set_mr"
-
-| SET_MR4:
-         --{*CertRes: CA issues the certificates for merSK and merEK,
-             while checking never to have certified the m even
-             separately. NOTE: In Cardholder Registration the
-             corresponding rule (6) doesn't use the "sign" primitive. "The
-             CertRes shall be signed but not encrypted if the EE is a Merchant
-             or Payment Gateway."-- Programmer's Guide, page 191.*}
-    "[| evs4 \<in> set_mr; M = Merchant k;
-        merSK \<notin> symKeys;  merEK \<notin> symKeys;
-        Notes (CA i) (Key merSK) \<notin> set evs4;
-        Notes (CA i) (Key merEK) \<notin> set evs4;
-        Gets (CA i) {|Crypt KM1 (sign (invKey merSK)
-                                 {|Agent M, Nonce NM2, Key merSK, Key merEK|}),
-                      Crypt (pubEK (CA i)) (Key KM1) |}
-          \<in> set evs4 |]
-    ==> Says (CA i) M {|sign (priSK(CA i)) {|Agent M, Nonce NM2, Agent(CA i)|},
-                        cert  M      merSK    onlySig (priSK (CA i)),
-                        cert  M      merEK    onlyEnc (priSK (CA i)),
-                        cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|}
-          # Notes (CA i) (Key merSK)
-          # Notes (CA i) (Key merEK)
-          # evs4 \<in> set_mr"
-
-
-text{*Note possibility proofs are missing.*}
-
-declare Says_imp_knows_Spy [THEN parts.Inj, dest]
-declare parts.Body [dest]
-declare analz_into_parts [dest]
-declare Fake_parts_insert_in_Un [dest]
-
-text{*General facts about message reception*}
-lemma Gets_imp_Says:
-     "[| Gets B X \<in> set evs; evs \<in> set_mr |] ==> \<exists>A. Says A B X \<in> set evs"
-apply (erule rev_mp)
-apply (erule set_mr.induct, auto)
-done
-
-lemma Gets_imp_knows_Spy:
-     "[| Gets B X \<in> set evs; evs \<in> set_mr |]  ==> X \<in> knows Spy evs"
-by (blast dest!: Gets_imp_Says Says_imp_knows_Spy)
-
-
-declare Gets_imp_knows_Spy [THEN parts.Inj, dest]
-
-subsubsection{*Proofs on keys *}
-
-text{*Spy never sees an agent's private keys! (unless it's bad at start)*}
-lemma Spy_see_private_Key [simp]:
-     "evs \<in> set_mr
-      ==> (Key(invKey (publicKey b A)) \<in> parts(knows Spy evs)) = (A \<in> bad)"
-apply (erule set_mr.induct)
-apply (auto dest!: Gets_imp_knows_Spy [THEN parts.Inj])
-done
-
-lemma Spy_analz_private_Key [simp]:
-     "evs \<in> set_mr ==>
-     (Key(invKey (publicKey b A)) \<in> analz(knows Spy evs)) = (A \<in> bad)"
-by auto
-
-declare Spy_see_private_Key [THEN [2] rev_iffD1, dest!]
-declare Spy_analz_private_Key [THEN [2] rev_iffD1, dest!]
-
-(*This is to state that the signed keys received in step 4
-  are into parts - rather than installing sign_def each time.
-  Needed in Spy_see_priSK_RCA, Spy_see_priEK and in Spy_see_priSK
-Goal "[|Gets C \<lbrace>Crypt KM1
-                (sign K \<lbrace>Agent M, Nonce NM2, Key merSK, Key merEK\<rbrace>), X\<rbrace>
-          \<in> set evs;  evs \<in> set_mr |]
-    ==> Key merSK \<in> parts (knows Spy evs) \<and>
-        Key merEK \<in> parts (knows Spy evs)"
-by (fast_tac (claset() addss (simpset())) 1);
-qed "signed_keys_in_parts";
-???*)
-
-text{*Proofs on certificates -
-  they hold, as in CR, because RCA's keys are secure*}
-
-lemma Crypt_valid_pubEK:
-     "[| Crypt (priSK RCA) {|Agent (CA i), Key EKi, onlyEnc|}
-           \<in> parts (knows Spy evs);
-         evs \<in> set_mr |] ==> EKi = pubEK (CA i)"
-apply (erule rev_mp)
-apply (erule set_mr.induct, auto)
-done
-
-lemma certificate_valid_pubEK:
-    "[| cert (CA i) EKi onlyEnc (priSK RCA) \<in> parts (knows Spy evs);
-        evs \<in> set_mr |]
-     ==> EKi = pubEK (CA i)"
-apply (unfold cert_def signCert_def)
-apply (blast dest!: Crypt_valid_pubEK)
-done
-
-lemma Crypt_valid_pubSK:
-     "[| Crypt (priSK RCA) {|Agent (CA i), Key SKi, onlySig|}
-           \<in> parts (knows Spy evs);
-         evs \<in> set_mr |] ==> SKi = pubSK (CA i)"
-apply (erule rev_mp)
-apply (erule set_mr.induct, auto)
-done
-
-lemma certificate_valid_pubSK:
-    "[| cert (CA i) SKi onlySig (priSK RCA) \<in> parts (knows Spy evs);
-        evs \<in> set_mr |] ==> SKi = pubSK (CA i)"
-apply (unfold cert_def signCert_def)
-apply (blast dest!: Crypt_valid_pubSK)
-done
-
-lemma Gets_certificate_valid:
-     "[| Gets A {| X, cert (CA i) EKi onlyEnc (priSK RCA),
-                      cert (CA i) SKi onlySig (priSK RCA)|} \<in> set evs;
-         evs \<in> set_mr |]
-      ==> EKi = pubEK (CA i) & SKi = pubSK (CA i)"
-by (blast dest: certificate_valid_pubEK certificate_valid_pubSK)
-
-
-text{*Nobody can have used non-existent keys!*}
-lemma new_keys_not_used [rule_format,simp]:
-     "evs \<in> set_mr
-      ==> Key K \<notin> used evs --> K \<in> symKeys -->
-          K \<notin> keysFor (parts (knows Spy evs))"
-apply (erule set_mr.induct, simp_all)
-apply (force dest!: usedI keysFor_parts_insert)  --{*Fake*}
-apply force  --{*Message 2*}
-apply (blast dest: Gets_certificate_valid)  --{*Message 3*}
-apply force  --{*Message 4*}
-done
-
-
-subsubsection{*New Versions: As Above, but Generalized with the Kk Argument*}
-
-lemma gen_new_keys_not_used [rule_format]:
-     "evs \<in> set_mr
-      ==> Key K \<notin> used evs --> K \<in> symKeys -->
-          K \<notin> keysFor (parts (Key`KK Un knows Spy evs))"
-by auto
-
-lemma gen_new_keys_not_analzd:
-     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_mr |]
-      ==> K \<notin> keysFor (analz (Key`KK Un knows Spy evs))"
-by (blast intro: keysFor_mono [THEN [2] rev_subsetD]
-          dest: gen_new_keys_not_used)
-
-lemma analz_Key_image_insert_eq:
-     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_mr |]
-      ==> analz (Key ` (insert K KK) \<union> knows Spy evs) =
-          insert (Key K) (analz (Key ` KK \<union> knows Spy evs))"
-by (simp add: gen_new_keys_not_analzd)
-
-
-lemma Crypt_parts_imp_used:
-     "[|Crypt K X \<in> parts (knows Spy evs);
-        K \<in> symKeys; evs \<in> set_mr |] ==> Key K \<in> used evs"
-apply (rule ccontr)
-apply (force dest: new_keys_not_used Crypt_imp_invKey_keysFor)
-done
-
-lemma Crypt_analz_imp_used:
-     "[|Crypt K X \<in> analz (knows Spy evs);
-        K \<in> symKeys; evs \<in> set_mr |] ==> Key K \<in> used evs"
-by (blast intro: Crypt_parts_imp_used)
-
-text{*Rewriting rule for private encryption keys.  Analogous rewriting rules
-for other keys aren't needed.*}
-
-lemma parts_image_priEK:
-     "[|Key (priEK (CA i)) \<in> parts (Key`KK Un (knows Spy evs));
-        evs \<in> set_mr|] ==> priEK (CA i) \<in> KK | CA i \<in> bad"
-by auto
-
-text{*trivial proof because (priEK (CA i)) never appears even in (parts evs)*}
-lemma analz_image_priEK:
-     "evs \<in> set_mr ==>
-          (Key (priEK (CA i)) \<in> analz (Key`KK Un (knows Spy evs))) =
-          (priEK (CA i) \<in> KK | CA i \<in> bad)"
-by (blast dest!: parts_image_priEK intro: analz_mono [THEN [2] rev_subsetD])
-
-
-subsection{*Secrecy of Session Keys*}
-
-text{*This holds because if (priEK (CA i)) appears in any traffic then it must
-  be known to the Spy, by @{text Spy_see_private_Key}*}
-lemma merK_neq_priEK:
-     "[|Key merK \<notin> analz (knows Spy evs);
-        Key merK \<in> parts (knows Spy evs);
-        evs \<in> set_mr|] ==> merK \<noteq> priEK C"
-by blast
-
-text{*Lemma for message 4: either merK is compromised (when we don't care)
-  or else merK hasn't been used to encrypt K.*}
-lemma msg4_priEK_disj:
-     "[|Gets B {|Crypt KM1
-                       (sign K {|Agent M, Nonce NM2, Key merSK, Key merEK|}),
-                 Y|} \<in> set evs;
-        evs \<in> set_mr|]
-  ==> (Key merSK \<in> analz (knows Spy evs) | merSK \<notin> range(\<lambda>C. priEK C))
-   &  (Key merEK \<in> analz (knows Spy evs) | merEK \<notin> range(\<lambda>C. priEK C))"
-apply (unfold sign_def)
-apply (blast dest: merK_neq_priEK)
-done
-
-
-lemma Key_analz_image_Key_lemma:
-     "P --> (Key K \<in> analz (Key`KK Un H)) --> (K\<in>KK | Key K \<in> analz H)
-      ==>
-      P --> (Key K \<in> analz (Key`KK Un H)) = (K\<in>KK | Key K \<in> analz H)"
-by (blast intro: analz_mono [THEN [2] rev_subsetD])
-
-lemma symKey_compromise:
-     "evs \<in> set_mr ==>
-      (\<forall>SK KK. SK \<in> symKeys \<longrightarrow> (\<forall>K \<in> KK. K \<notin> range(\<lambda>C. priEK C)) -->
-               (Key SK \<in> analz (Key`KK Un (knows Spy evs))) =
-               (SK \<in> KK | Key SK \<in> analz (knows Spy evs)))"
-apply (erule set_mr.induct)
-apply (safe del: impI intro!: Key_analz_image_Key_lemma [THEN impI])
-apply (drule_tac [7] msg4_priEK_disj)
-apply (frule_tac [6] Gets_certificate_valid)
-apply (safe del: impI)
-apply (simp_all del: image_insert image_Un imp_disjL
-         add: analz_image_keys_simps abbrev_simps analz_knows_absorb
-              analz_knows_absorb2 analz_Key_image_insert_eq notin_image_iff
-              Spy_analz_private_Key analz_image_priEK)
-  --{*5 seconds on a 1.6GHz machine*}
-apply spy_analz  --{*Fake*}
-apply auto  --{*Message 3*}
-done
-
-lemma symKey_secrecy [rule_format]:
-     "[|CA i \<notin> bad; K \<in> symKeys;  evs \<in> set_mr|]
-      ==> \<forall>X m. Says (Merchant m) (CA i) X \<in> set evs -->
-                Key K \<in> parts{X} -->
-                Merchant m \<notin> bad -->
-                Key K \<notin> analz (knows Spy evs)"
-apply (erule set_mr.induct)
-apply (drule_tac [7] msg4_priEK_disj)
-apply (frule_tac [6] Gets_certificate_valid)
-apply (safe del: impI)
-apply (simp_all del: image_insert image_Un imp_disjL
-         add: analz_image_keys_simps abbrev_simps analz_knows_absorb
-              analz_knows_absorb2 analz_Key_image_insert_eq
-              symKey_compromise notin_image_iff Spy_analz_private_Key
-              analz_image_priEK)
-apply spy_analz  --{*Fake*}
-apply force  --{*Message 1*}
-apply (auto intro: analz_into_parts [THEN usedI] in_parts_Says_imp_used)  --{*Message 3*}
-done
-
-subsection{*Unicity *}
-
-lemma msg4_Says_imp_Notes:
- "[|Says (CA i) M {|sign (priSK (CA i)) {|Agent M, Nonce NM2, Agent (CA i)|},
-                    cert  M      merSK    onlySig (priSK (CA i)),
-                    cert  M      merEK    onlyEnc (priSK (CA i)),
-                    cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|} \<in> set evs;
-    evs \<in> set_mr |]
-  ==> Notes (CA i) (Key merSK) \<in> set evs
-   &  Notes (CA i) (Key merEK) \<in> set evs"
-apply (erule rev_mp)
-apply (erule set_mr.induct)
-apply (simp_all (no_asm_simp))
-done
-
-text{*Unicity of merSK wrt a given CA:
-  merSK uniquely identifies the other components, including merEK*}
-lemma merSK_unicity:
- "[|Says (CA i) M {|sign (priSK(CA i)) {|Agent M, Nonce NM2, Agent (CA i)|},
-                    cert  M      merSK    onlySig (priSK (CA i)),
-                    cert  M      merEK    onlyEnc (priSK (CA i)),
-                    cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|} \<in> set evs;
-    Says (CA i) M' {|sign (priSK(CA i)) {|Agent M', Nonce NM2', Agent (CA i)|},
-                    cert  M'      merSK    onlySig (priSK (CA i)),
-                    cert  M'      merEK'    onlyEnc (priSK (CA i)),
-                    cert (CA i) (pubSK(CA i)) onlySig (priSK RCA)|} \<in> set evs;
-    evs \<in> set_mr |] ==> M=M' & NM2=NM2' & merEK=merEK'"
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule set_mr.induct)
-apply (simp_all (no_asm_simp))
-apply (blast dest!: msg4_Says_imp_Notes)
-done
-
-text{*Unicity of merEK wrt a given CA:
-  merEK uniquely identifies the other components, including merSK*}
-lemma merEK_unicity:
- "[|Says (CA i) M {|sign (priSK(CA i)) {|Agent M, Nonce NM2, Agent (CA i)|},
-                    cert  M      merSK    onlySig (priSK (CA i)),
-                    cert  M      merEK    onlyEnc (priSK (CA i)),
-                    cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|} \<in> set evs;
-    Says (CA i) M' {|sign (priSK(CA i)) {|Agent M', Nonce NM2', Agent (CA i)|},
-                     cert  M'      merSK'    onlySig (priSK (CA i)),
-                     cert  M'      merEK    onlyEnc (priSK (CA i)),
-                     cert (CA i) (pubSK(CA i)) onlySig (priSK RCA)|} \<in> set evs;
-    evs \<in> set_mr |] 
-  ==> M=M' & NM2=NM2' & merSK=merSK'"
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule set_mr.induct)
-apply (simp_all (no_asm_simp))
-apply (blast dest!: msg4_Says_imp_Notes)
-done
-
-
-text{* -No interest on secrecy of nonces: they appear to be used
-    only for freshness.
-   -No interest on secrecy of merSK or merEK, as in CR.
-   -There's no equivalent of the PAN*}
-
-
-subsection{*Primary Goals of Merchant Registration *}
-
-subsubsection{*The merchant's certificates really were created by the CA,
-provided the CA is uncompromised *}
-
-text{*The assumption @{term "CA i \<noteq> RCA"} is required: step 2 uses 
-  certificates of the same form.*}
-lemma certificate_merSK_valid_lemma [intro]:
-     "[|Crypt (priSK (CA i)) {|Agent M, Key merSK, onlySig|}
-          \<in> parts (knows Spy evs);
-        CA i \<notin> bad;  CA i \<noteq> RCA;  evs \<in> set_mr|]
- ==> \<exists>X Y Z. Says (CA i) M
-                  {|X, cert M merSK onlySig (priSK (CA i)), Y, Z|} \<in> set evs"
-apply (erule rev_mp)
-apply (erule set_mr.induct)
-apply (simp_all (no_asm_simp))
-apply auto
-done
-
-lemma certificate_merSK_valid:
-     "[| cert M merSK onlySig (priSK (CA i)) \<in> parts (knows Spy evs);
-         CA i \<notin> bad;  CA i \<noteq> RCA;  evs \<in> set_mr|]
- ==> \<exists>X Y Z. Says (CA i) M
-                  {|X, cert M merSK onlySig (priSK (CA i)), Y, Z|} \<in> set evs"
-by auto
-
-lemma certificate_merEK_valid_lemma [intro]:
-     "[|Crypt (priSK (CA i)) {|Agent M, Key merEK, onlyEnc|}
-          \<in> parts (knows Spy evs);
-        CA i \<notin> bad;  CA i \<noteq> RCA;  evs \<in> set_mr|]
- ==> \<exists>X Y Z. Says (CA i) M
-                  {|X, Y, cert M merEK onlyEnc (priSK (CA i)), Z|} \<in> set evs"
-apply (erule rev_mp)
-apply (erule set_mr.induct)
-apply (simp_all (no_asm_simp))
-apply auto
-done
-
-lemma certificate_merEK_valid:
-     "[| cert M merEK onlyEnc (priSK (CA i)) \<in> parts (knows Spy evs);
-         CA i \<notin> bad;  CA i \<noteq> RCA;  evs \<in> set_mr|]
- ==> \<exists>X Y Z. Says (CA i) M
-                  {|X, Y, cert M merEK onlyEnc (priSK (CA i)), Z|} \<in> set evs"
-by auto
-
-text{*The two certificates - for merSK and for merEK - cannot be proved to
-  have originated together*}
-
-end
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/SET-Protocol/MessageSET.thy
--- a/src/HOL/SET-Protocol/MessageSET.thy	Tue Oct 20 19:52:04 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,957 +0,0 @@
-(*  Title:      HOL/SET-Protocol/MessageSET.thy
-    Author:     Giampaolo Bella
-    Author:     Fabio Massacci
-    Author:     Lawrence C Paulson
-*)
-
-header{*The Message Theory, Modified for SET*}
-
-theory MessageSET
-imports Main Nat_Int_Bij
-begin
-
-subsection{*General Lemmas*}
-
-text{*Needed occasionally with @{text spy_analz_tac}, e.g. in
-     @{text analz_insert_Key_newK}*}
-
-lemma Un_absorb3 [simp] : "A \<union> (B \<union> A) = B \<union> A"
-by blast
-
-text{*Collapses redundant cases in the huge protocol proofs*}
-lemmas disj_simps = disj_comms disj_left_absorb disj_assoc 
-
-text{*Effective with assumptions like @{term "K \<notin> range pubK"} and 
-   @{term "K \<notin> invKey`range pubK"}*}
-lemma notin_image_iff: "(y \<notin> f`I) = (\<forall>i\<in>I. f i \<noteq> y)"
-by blast
-
-text{*Effective with the assumption @{term "KK \<subseteq> - (range(invKey o pubK))"} *}
-lemma disjoint_image_iff: "(A <= - (f`I)) = (\<forall>i\<in>I. f i \<notin> A)"
-by blast
-
-
-
-types
-  key = nat
-
-consts
-  all_symmetric :: bool        --{*true if all keys are symmetric*}
-  invKey        :: "key=>key"  --{*inverse of a symmetric key*}
-
-specification (invKey)
-  invKey [simp]: "invKey (invKey K) = K"
-  invKey_symmetric: "all_symmetric --> invKey = id"
-    by (rule exI [of _ id], auto)
-
-
-text{*The inverse of a symmetric key is itself; that of a public key
-      is the private key and vice versa*}
-
-constdefs
-  symKeys :: "key set"
-  "symKeys == {K. invKey K = K}"
-
-text{*Agents. We allow any number of certification authorities, cardholders
-            merchants, and payment gateways.*}
-datatype
-  agent = CA nat | Cardholder nat | Merchant nat | PG nat | Spy
-
-text{*Messages*}
-datatype
-     msg = Agent  agent     --{*Agent names*}
-         | Number nat       --{*Ordinary integers, timestamps, ...*}
-         | Nonce  nat       --{*Unguessable nonces*}
-         | Pan    nat       --{*Unguessable Primary Account Numbers (??)*}
-         | Key    key       --{*Crypto keys*}
-         | Hash   msg       --{*Hashing*}
-         | MPair  msg msg   --{*Compound messages*}
-         | Crypt  key msg   --{*Encryption, public- or shared-key*}
-
-
-(*Concrete syntax: messages appear as {|A,B,NA|}, etc...*)
-syntax
-  "@MTuple"      :: "['a, args] => 'a * 'b"       ("(2{|_,/ _|})")
-
-syntax (xsymbols)
-  "@MTuple"      :: "['a, args] => 'a * 'b"       ("(2\<lbrace>_,/ _\<rbrace>)")
-
-translations
-  "{|x, y, z|}"   == "{|x, {|y, z|}|}"
-  "{|x, y|}"      == "MPair x y"
-
-
-constdefs
-  nat_of_agent :: "agent => nat"
-   "nat_of_agent == agent_case (curry nat2_to_nat 0)
-                               (curry nat2_to_nat 1)
-                               (curry nat2_to_nat 2)
-                               (curry nat2_to_nat 3)
-                               (nat2_to_nat (4,0))"
-    --{*maps each agent to a unique natural number, for specifications*}
-
-text{*The function is indeed injective*}
-lemma inj_nat_of_agent: "inj nat_of_agent"
-by (simp add: nat_of_agent_def inj_on_def curry_def
-              nat2_to_nat_inj [THEN inj_eq]  split: agent.split) 
-
-
-constdefs
-  (*Keys useful to decrypt elements of a message set*)
-  keysFor :: "msg set => key set"
-  "keysFor H == invKey ` {K. \<exists>X. Crypt K X \<in> H}"
-
-subsubsection{*Inductive definition of all "parts" of a message.*}
-
-inductive_set
-  parts :: "msg set => msg set"
-  for H :: "msg set"
-  where
-    Inj [intro]:               "X \<in> H ==> X \<in> parts H"
-  | Fst:         "{|X,Y|}   \<in> parts H ==> X \<in> parts H"
-  | Snd:         "{|X,Y|}   \<in> parts H ==> Y \<in> parts H"
-  | Body:        "Crypt K X \<in> parts H ==> X \<in> parts H"
-
-
-(*Monotonicity*)
-lemma parts_mono: "G<=H ==> parts(G) <= parts(H)"
-apply auto
-apply (erule parts.induct)
-apply (auto dest: Fst Snd Body)
-done
-
-
-subsubsection{*Inverse of keys*}
-
-(*Equations hold because constructors are injective; cannot prove for all f*)
-lemma Key_image_eq [simp]: "(Key x \<in> Key`A) = (x\<in>A)"
-by auto
-
-lemma Nonce_Key_image_eq [simp]: "(Nonce x \<notin> Key`A)"
-by auto
-
-lemma Cardholder_image_eq [simp]: "(Cardholder x \<in> Cardholder`A) = (x \<in> A)"
-by auto
-
-lemma CA_image_eq [simp]: "(CA x \<in> CA`A) = (x \<in> A)"
-by auto
-
-lemma Pan_image_eq [simp]: "(Pan x \<in> Pan`A) = (x \<in> A)"
-by auto
-
-lemma Pan_Key_image_eq [simp]: "(Pan x \<notin> Key`A)"
-by auto
-
-lemma Nonce_Pan_image_eq [simp]: "(Nonce x \<notin> Pan`A)"
-by auto
-
-lemma invKey_eq [simp]: "(invKey K = invKey K') = (K=K')"
-apply safe
-apply (drule_tac f = invKey in arg_cong, simp)
-done
-
-
-subsection{*keysFor operator*}
-
-lemma keysFor_empty [simp]: "keysFor {} = {}"
-by (unfold keysFor_def, blast)
-
-lemma keysFor_Un [simp]: "keysFor (H \<union> H') = keysFor H \<union> keysFor H'"
-by (unfold keysFor_def, blast)
-
-lemma keysFor_UN [simp]: "keysFor (\<Union>i\<in>A. H i) = (\<Union>i\<in>A. keysFor (H i))"
-by (unfold keysFor_def, blast)
-
-(*Monotonicity*)
-lemma keysFor_mono: "G\<subseteq>H ==> keysFor(G) \<subseteq> keysFor(H)"
-by (unfold keysFor_def, blast)
-
-lemma keysFor_insert_Agent [simp]: "keysFor (insert (Agent A) H) = keysFor H"
-by (unfold keysFor_def, auto)
-
-lemma keysFor_insert_Nonce [simp]: "keysFor (insert (Nonce N) H) = keysFor H"
-by (unfold keysFor_def, auto)
-
-lemma keysFor_insert_Number [simp]: "keysFor (insert (Number N) H) = keysFor H"
-by (unfold keysFor_def, auto)
-
-lemma keysFor_insert_Key [simp]: "keysFor (insert (Key K) H) = keysFor H"
-by (unfold keysFor_def, auto)
-
-lemma keysFor_insert_Pan [simp]: "keysFor (insert (Pan A) H) = keysFor H"
-by (unfold keysFor_def, auto)
-
-lemma keysFor_insert_Hash [simp]: "keysFor (insert (Hash X) H) = keysFor H"
-by (unfold keysFor_def, auto)
-
-lemma keysFor_insert_MPair [simp]: "keysFor (insert {|X,Y|} H) = keysFor H"
-by (unfold keysFor_def, auto)
-
-lemma keysFor_insert_Crypt [simp]:
-    "keysFor (insert (Crypt K X) H) = insert (invKey K) (keysFor H)"
-by (unfold keysFor_def, auto)
-
-lemma keysFor_image_Key [simp]: "keysFor (Key`E) = {}"
-by (unfold keysFor_def, auto)
-
-lemma Crypt_imp_invKey_keysFor: "Crypt K X \<in> H ==> invKey K \<in> keysFor H"
-by (unfold keysFor_def, blast)
-
-
-subsection{*Inductive relation "parts"*}
-
-lemma MPair_parts:
-     "[| {|X,Y|} \<in> parts H;
-         [| X \<in> parts H; Y \<in> parts H |] ==> P |] ==> P"
-by (blast dest: parts.Fst parts.Snd)
-
-declare MPair_parts [elim!]  parts.Body [dest!]
-text{*NB These two rules are UNSAFE in the formal sense, as they discard the
-     compound message.  They work well on THIS FILE.
-  @{text MPair_parts} is left as SAFE because it speeds up proofs.
-  The Crypt rule is normally kept UNSAFE to avoid breaking up certificates.*}
-
-lemma parts_increasing: "H \<subseteq> parts(H)"
-by blast
-
-lemmas parts_insertI = subset_insertI [THEN parts_mono, THEN subsetD, standard]
-
-lemma parts_empty [simp]: "parts{} = {}"
-apply safe
-apply (erule parts.induct, blast+)
-done
-
-lemma parts_emptyE [elim!]: "X\<in> parts{} ==> P"
-by simp
-
-(*WARNING: loops if H = {Y}, therefore must not be repeated!*)
-lemma parts_singleton: "X\<in> parts H ==> \<exists>Y\<in>H. X\<in> parts {Y}"
-by (erule parts.induct, fast+)
-
-
-subsubsection{*Unions*}
-
-lemma parts_Un_subset1: "parts(G) \<union> parts(H) \<subseteq> parts(G \<union> H)"
-by (intro Un_least parts_mono Un_upper1 Un_upper2)
-
-lemma parts_Un_subset2: "parts(G \<union> H) \<subseteq> parts(G) \<union> parts(H)"
-apply (rule subsetI)
-apply (erule parts.induct, blast+)
-done
-
-lemma parts_Un [simp]: "parts(G \<union> H) = parts(G) \<union> parts(H)"
-by (intro equalityI parts_Un_subset1 parts_Un_subset2)
-
-lemma parts_insert: "parts (insert X H) = parts {X} \<union> parts H"
-apply (subst insert_is_Un [of _ H])
-apply (simp only: parts_Un)
-done
-
-(*TWO inserts to avoid looping.  This rewrite is better than nothing.
-  Not suitable for Addsimps: its behaviour can be strange.*)
-lemma parts_insert2:
-     "parts (insert X (insert Y H)) = parts {X} \<union> parts {Y} \<union> parts H"
-apply (simp add: Un_assoc)
-apply (simp add: parts_insert [symmetric])
-done
-
-lemma parts_UN_subset1: "(\<Union>x\<in>A. parts(H x)) \<subseteq> parts(\<Union>x\<in>A. H x)"
-by (intro UN_least parts_mono UN_upper)
-
-lemma parts_UN_subset2: "parts(\<Union>x\<in>A. H x) \<subseteq> (\<Union>x\<in>A. parts(H x))"
-apply (rule subsetI)
-apply (erule parts.induct, blast+)
-done
-
-lemma parts_UN [simp]: "parts(\<Union>x\<in>A. H x) = (\<Union>x\<in>A. parts(H x))"
-by (intro equalityI parts_UN_subset1 parts_UN_subset2)
-
-(*Added to simplify arguments to parts, analz and synth.
-  NOTE: the UN versions are no longer used!*)
-
-
-text{*This allows @{text blast} to simplify occurrences of
-  @{term "parts(G\<union>H)"} in the assumption.*}
-declare parts_Un [THEN equalityD1, THEN subsetD, THEN UnE, elim!]
-
-
-lemma parts_insert_subset: "insert X (parts H) \<subseteq> parts(insert X H)"
-by (blast intro: parts_mono [THEN [2] rev_subsetD])
-
-subsubsection{*Idempotence and transitivity*}
-
-lemma parts_partsD [dest!]: "X\<in> parts (parts H) ==> X\<in> parts H"
-by (erule parts.induct, blast+)
-
-lemma parts_idem [simp]: "parts (parts H) = parts H"
-by blast
-
-lemma parts_trans: "[| X\<in> parts G;  G \<subseteq> parts H |] ==> X\<in> parts H"
-by (drule parts_mono, blast)
-
-(*Cut*)
-lemma parts_cut:
-     "[| Y\<in> parts (insert X G);  X\<in> parts H |] ==> Y\<in> parts (G \<union> H)"
-by (erule parts_trans, auto)
-
-lemma parts_cut_eq [simp]: "X\<in> parts H ==> parts (insert X H) = parts H"
-by (force dest!: parts_cut intro: parts_insertI)
-
-
-subsubsection{*Rewrite rules for pulling out atomic messages*}
-
-lemmas parts_insert_eq_I = equalityI [OF subsetI parts_insert_subset]
-
-
-lemma parts_insert_Agent [simp]:
-     "parts (insert (Agent agt) H) = insert (Agent agt) (parts H)"
-apply (rule parts_insert_eq_I)
-apply (erule parts.induct, auto)
-done
-
-lemma parts_insert_Nonce [simp]:
-     "parts (insert (Nonce N) H) = insert (Nonce N) (parts H)"
-apply (rule parts_insert_eq_I)
-apply (erule parts.induct, auto)
-done
-
-lemma parts_insert_Number [simp]:
-     "parts (insert (Number N) H) = insert (Number N) (parts H)"
-apply (rule parts_insert_eq_I)
-apply (erule parts.induct, auto)
-done
-
-lemma parts_insert_Key [simp]:
-     "parts (insert (Key K) H) = insert (Key K) (parts H)"
-apply (rule parts_insert_eq_I)
-apply (erule parts.induct, auto)
-done
-
-lemma parts_insert_Pan [simp]:
-     "parts (insert (Pan A) H) = insert (Pan A) (parts H)"
-apply (rule parts_insert_eq_I)
-apply (erule parts.induct, auto)
-done
-
-lemma parts_insert_Hash [simp]:
-     "parts (insert (Hash X) H) = insert (Hash X) (parts H)"
-apply (rule parts_insert_eq_I)
-apply (erule parts.induct, auto)
-done
-
-lemma parts_insert_Crypt [simp]:
-     "parts (insert (Crypt K X) H) =
-          insert (Crypt K X) (parts (insert X H))"
-apply (rule equalityI)
-apply (rule subsetI)
-apply (erule parts.induct, auto)
-apply (erule parts.induct)
-apply (blast intro: parts.Body)+
-done
-
-lemma parts_insert_MPair [simp]:
-     "parts (insert {|X,Y|} H) =
-          insert {|X,Y|} (parts (insert X (insert Y H)))"
-apply (rule equalityI)
-apply (rule subsetI)
-apply (erule parts.induct, auto)
-apply (erule parts.induct)
-apply (blast intro: parts.Fst parts.Snd)+
-done
-
-lemma parts_image_Key [simp]: "parts (Key`N) = Key`N"
-apply auto
-apply (erule parts.induct, auto)
-done
-
-lemma parts_image_Pan [simp]: "parts (Pan`A) = Pan`A"
-apply auto
-apply (erule parts.induct, auto)
-done
-
-
-(*In any message, there is an upper bound N on its greatest nonce.*)
-lemma msg_Nonce_supply: "\<exists>N. \<forall>n. N\<le>n --> Nonce n \<notin> parts {msg}"
-apply (induct_tac "msg")
-apply (simp_all (no_asm_simp) add: exI parts_insert2)
-(*MPair case: blast_tac works out the necessary sum itself!*)
-prefer 2 apply (blast elim!: add_leE)
-(*Nonce case*)
-apply (rule_tac x = "N + Suc nat" in exI)
-apply (auto elim!: add_leE)
-done
-
-(* Ditto, for numbers.*)
-lemma msg_Number_supply: "\<exists>N. \<forall>n. N<=n --> Number n \<notin> parts {msg}"
-apply (induct_tac "msg")
-apply (simp_all (no_asm_simp) add: exI parts_insert2)
-prefer 2 apply (blast elim!: add_leE)
-apply (rule_tac x = "N + Suc nat" in exI, auto)
-done
-
-subsection{*Inductive relation "analz"*}
-
-text{*Inductive definition of "analz" -- what can be broken down from a set of
-    messages, including keys.  A form of downward closure.  Pairs can
-    be taken apart; messages decrypted with known keys.*}
-
-inductive_set
-  analz :: "msg set => msg set"
-  for H :: "msg set"
-  where
-    Inj [intro,simp] :    "X \<in> H ==> X \<in> analz H"
-  | Fst:     "{|X,Y|} \<in> analz H ==> X \<in> analz H"
-  | Snd:     "{|X,Y|} \<in> analz H ==> Y \<in> analz H"
-  | Decrypt [dest]:
-             "[|Crypt K X \<in> analz H; Key(invKey K): analz H|] ==> X \<in> analz H"
-
-
-(*Monotonicity; Lemma 1 of Lowe's paper*)
-lemma analz_mono: "G<=H ==> analz(G) <= analz(H)"
-apply auto
-apply (erule analz.induct)
-apply (auto dest: Fst Snd)
-done
-
-text{*Making it safe speeds up proofs*}
-lemma MPair_analz [elim!]:
-     "[| {|X,Y|} \<in> analz H;
-             [| X \<in> analz H; Y \<in> analz H |] ==> P
-          |] ==> P"
-by (blast dest: analz.Fst analz.Snd)
-
-lemma analz_increasing: "H \<subseteq> analz(H)"
-by blast
-
-lemma analz_subset_parts: "analz H \<subseteq> parts H"
-apply (rule subsetI)
-apply (erule analz.induct, blast+)
-done
-
-lemmas analz_into_parts = analz_subset_parts [THEN subsetD, standard]
-
-lemmas not_parts_not_analz = analz_subset_parts [THEN contra_subsetD, standard]
-
-
-lemma parts_analz [simp]: "parts (analz H) = parts H"
-apply (rule equalityI)
-apply (rule analz_subset_parts [THEN parts_mono, THEN subset_trans], simp)
-apply (blast intro: analz_increasing [THEN parts_mono, THEN subsetD])
-done
-
-lemma analz_parts [simp]: "analz (parts H) = parts H"
-apply auto
-apply (erule analz.induct, auto)
-done
-
-lemmas analz_insertI = subset_insertI [THEN analz_mono, THEN [2] rev_subsetD, standard]
-
-subsubsection{*General equational properties*}
-
-lemma analz_empty [simp]: "analz{} = {}"
-apply safe
-apply (erule analz.induct, blast+)
-done
-
-(*Converse fails: we can analz more from the union than from the
-  separate parts, as a key in one might decrypt a message in the other*)
-lemma analz_Un: "analz(G) \<union> analz(H) \<subseteq> analz(G \<union> H)"
-by (intro Un_least analz_mono Un_upper1 Un_upper2)
-
-lemma analz_insert: "insert X (analz H) \<subseteq> analz(insert X H)"
-by (blast intro: analz_mono [THEN [2] rev_subsetD])
-
-subsubsection{*Rewrite rules for pulling out atomic messages*}
-
-lemmas analz_insert_eq_I = equalityI [OF subsetI analz_insert]
-
-lemma analz_insert_Agent [simp]:
-     "analz (insert (Agent agt) H) = insert (Agent agt) (analz H)"
-apply (rule analz_insert_eq_I)
-apply (erule analz.induct, auto)
-done
-
-lemma analz_insert_Nonce [simp]:
-     "analz (insert (Nonce N) H) = insert (Nonce N) (analz H)"
-apply (rule analz_insert_eq_I)
-apply (erule analz.induct, auto)
-done
-
-lemma analz_insert_Number [simp]:
-     "analz (insert (Number N) H) = insert (Number N) (analz H)"
-apply (rule analz_insert_eq_I)
-apply (erule analz.induct, auto)
-done
-
-lemma analz_insert_Hash [simp]:
-     "analz (insert (Hash X) H) = insert (Hash X) (analz H)"
-apply (rule analz_insert_eq_I)
-apply (erule analz.induct, auto)
-done
-
-(*Can only pull out Keys if they are not needed to decrypt the rest*)
-lemma analz_insert_Key [simp]:
-    "K \<notin> keysFor (analz H) ==>
-          analz (insert (Key K) H) = insert (Key K) (analz H)"
-apply (unfold keysFor_def)
-apply (rule analz_insert_eq_I)
-apply (erule analz.induct, auto)
-done
-
-lemma analz_insert_MPair [simp]:
-     "analz (insert {|X,Y|} H) =
-          insert {|X,Y|} (analz (insert X (insert Y H)))"
-apply (rule equalityI)
-apply (rule subsetI)
-apply (erule analz.induct, auto)
-apply (erule analz.induct)
-apply (blast intro: analz.Fst analz.Snd)+
-done
-
-(*Can pull out enCrypted message if the Key is not known*)
-lemma analz_insert_Crypt:
-     "Key (invKey K) \<notin> analz H
-      ==> analz (insert (Crypt K X) H) = insert (Crypt K X) (analz H)"
-apply (rule analz_insert_eq_I)
-apply (erule analz.induct, auto)
-done
-
-lemma analz_insert_Pan [simp]:
-     "analz (insert (Pan A) H) = insert (Pan A) (analz H)"
-apply (rule analz_insert_eq_I)
-apply (erule analz.induct, auto)
-done
-
-lemma lemma1: "Key (invKey K) \<in> analz H ==>
-               analz (insert (Crypt K X) H) \<subseteq>
-               insert (Crypt K X) (analz (insert X H))"
-apply (rule subsetI)
-apply (erule_tac x = x in analz.induct, auto)
-done
-
-lemma lemma2: "Key (invKey K) \<in> analz H ==>
-               insert (Crypt K X) (analz (insert X H)) \<subseteq>
-               analz (insert (Crypt K X) H)"
-apply auto
-apply (erule_tac x = x in analz.induct, auto)
-apply (blast intro: analz_insertI analz.Decrypt)
-done
-
-lemma analz_insert_Decrypt:
-     "Key (invKey K) \<in> analz H ==>
-               analz (insert (Crypt K X) H) =
-               insert (Crypt K X) (analz (insert X H))"
-by (intro equalityI lemma1 lemma2)
-
-(*Case analysis: either the message is secure, or it is not!
-  Effective, but can cause subgoals to blow up!
-  Use with split_if;  apparently split_tac does not cope with patterns
-  such as "analz (insert (Crypt K X) H)" *)
-lemma analz_Crypt_if [simp]:
-     "analz (insert (Crypt K X) H) =
-          (if (Key (invKey K) \<in> analz H)
-           then insert (Crypt K X) (analz (insert X H))
-           else insert (Crypt K X) (analz H))"
-by (simp add: analz_insert_Crypt analz_insert_Decrypt)
-
-
-(*This rule supposes "for the sake of argument" that we have the key.*)
-lemma analz_insert_Crypt_subset:
-     "analz (insert (Crypt K X) H) \<subseteq>
-           insert (Crypt K X) (analz (insert X H))"
-apply (rule subsetI)
-apply (erule analz.induct, auto)
-done
-
-lemma analz_image_Key [simp]: "analz (Key`N) = Key`N"
-apply auto
-apply (erule analz.induct, auto)
-done
-
-lemma analz_image_Pan [simp]: "analz (Pan`A) = Pan`A"
-apply auto
-apply (erule analz.induct, auto)
-done
-
-
-subsubsection{*Idempotence and transitivity*}
-
-lemma analz_analzD [dest!]: "X\<in> analz (analz H) ==> X\<in> analz H"
-by (erule analz.induct, blast+)
-
-lemma analz_idem [simp]: "analz (analz H) = analz H"
-by blast
-
-lemma analz_trans: "[| X\<in> analz G;  G \<subseteq> analz H |] ==> X\<in> analz H"
-by (drule analz_mono, blast)
-
-(*Cut; Lemma 2 of Lowe*)
-lemma analz_cut: "[| Y\<in> analz (insert X H);  X\<in> analz H |] ==> Y\<in> analz H"
-by (erule analz_trans, blast)
-
-(*Cut can be proved easily by induction on
-   "Y: analz (insert X H) ==> X: analz H --> Y: analz H"
-*)
-
-(*This rewrite rule helps in the simplification of messages that involve
-  the forwarding of unknown components (X).  Without it, removing occurrences
-  of X can be very complicated. *)
-lemma analz_insert_eq: "X\<in> analz H ==> analz (insert X H) = analz H"
-by (blast intro: analz_cut analz_insertI)
-
-
-text{*A congruence rule for "analz"*}
-
-lemma analz_subset_cong:
-     "[| analz G \<subseteq> analz G'; analz H \<subseteq> analz H'
-               |] ==> analz (G \<union> H) \<subseteq> analz (G' \<union> H')"
-apply clarify
-apply (erule analz.induct)
-apply (best intro: analz_mono [THEN subsetD])+
-done
-
-lemma analz_cong:
-     "[| analz G = analz G'; analz H = analz H'
-               |] ==> analz (G \<union> H) = analz (G' \<union> H')"
-by (intro equalityI analz_subset_cong, simp_all)
-
-lemma analz_insert_cong:
-     "analz H = analz H' ==> analz(insert X H) = analz(insert X H')"
-by (force simp only: insert_def intro!: analz_cong)
-
-(*If there are no pairs or encryptions then analz does nothing*)
-lemma analz_trivial:
-     "[| \<forall>X Y. {|X,Y|} \<notin> H;  \<forall>X K. Crypt K X \<notin> H |] ==> analz H = H"
-apply safe
-apply (erule analz.induct, blast+)
-done
-
-(*These two are obsolete (with a single Spy) but cost little to prove...*)
-lemma analz_UN_analz_lemma:
-     "X\<in> analz (\<Union>i\<in>A. analz (H i)) ==> X\<in> analz (\<Union>i\<in>A. H i)"
-apply (erule analz.induct)
-apply (blast intro: analz_mono [THEN [2] rev_subsetD])+
-done
-
-lemma analz_UN_analz [simp]: "analz (\<Union>i\<in>A. analz (H i)) = analz (\<Union>i\<in>A. H i)"
-by (blast intro: analz_UN_analz_lemma analz_mono [THEN [2] rev_subsetD])
-
-
-subsection{*Inductive relation "synth"*}
-
-text{*Inductive definition of "synth" -- what can be built up from a set of
-    messages.  A form of upward closure.  Pairs can be built, messages
-    encrypted with known keys.  Agent names are public domain.
-    Numbers can be guessed, but Nonces cannot be.*}
-
-inductive_set
-  synth :: "msg set => msg set"
-  for H :: "msg set"
-  where
-    Inj    [intro]:   "X \<in> H ==> X \<in> synth H"
-  | Agent  [intro]:   "Agent agt \<in> synth H"
-  | Number [intro]:   "Number n  \<in> synth H"
-  | Hash   [intro]:   "X \<in> synth H ==> Hash X \<in> synth H"
-  | MPair  [intro]:   "[|X \<in> synth H;  Y \<in> synth H|] ==> {|X,Y|} \<in> synth H"
-  | Crypt  [intro]:   "[|X \<in> synth H;  Key(K) \<in> H|] ==> Crypt K X \<in> synth H"
-
-(*Monotonicity*)
-lemma synth_mono: "G<=H ==> synth(G) <= synth(H)"
-apply auto
-apply (erule synth.induct)
-apply (auto dest: Fst Snd Body)
-done
-
-(*NO Agent_synth, as any Agent name can be synthesized.  Ditto for Number*)
-inductive_cases Nonce_synth [elim!]: "Nonce n \<in> synth H"
-inductive_cases Key_synth   [elim!]: "Key K \<in> synth H"
-inductive_cases Hash_synth  [elim!]: "Hash X \<in> synth H"
-inductive_cases MPair_synth [elim!]: "{|X,Y|} \<in> synth H"
-inductive_cases Crypt_synth [elim!]: "Crypt K X \<in> synth H"
-inductive_cases Pan_synth   [elim!]: "Pan A \<in> synth H"
-
-
-lemma synth_increasing: "H \<subseteq> synth(H)"
-by blast
-
-subsubsection{*Unions*}
-
-(*Converse fails: we can synth more from the union than from the
-  separate parts, building a compound message using elements of each.*)
-lemma synth_Un: "synth(G) \<union> synth(H) \<subseteq> synth(G \<union> H)"
-by (intro Un_least synth_mono Un_upper1 Un_upper2)
-
-lemma synth_insert: "insert X (synth H) \<subseteq> synth(insert X H)"
-by (blast intro: synth_mono [THEN [2] rev_subsetD])
-
-subsubsection{*Idempotence and transitivity*}
-
-lemma synth_synthD [dest!]: "X\<in> synth (synth H) ==> X\<in> synth H"
-by (erule synth.induct, blast+)
-
-lemma synth_idem: "synth (synth H) = synth H"
-by blast
-
-lemma synth_trans: "[| X\<in> synth G;  G \<subseteq> synth H |] ==> X\<in> synth H"
-by (drule synth_mono, blast)
-
-(*Cut; Lemma 2 of Lowe*)
-lemma synth_cut: "[| Y\<in> synth (insert X H);  X\<in> synth H |] ==> Y\<in> synth H"
-by (erule synth_trans, blast)
-
-lemma Agent_synth [simp]: "Agent A \<in> synth H"
-by blast
-
-lemma Number_synth [simp]: "Number n \<in> synth H"
-by blast
-
-lemma Nonce_synth_eq [simp]: "(Nonce N \<in> synth H) = (Nonce N \<in> H)"
-by blast
-
-lemma Key_synth_eq [simp]: "(Key K \<in> synth H) = (Key K \<in> H)"
-by blast
-
-lemma Crypt_synth_eq [simp]: "Key K \<notin> H ==> (Crypt K X \<in> synth H) = (Crypt K X \<in> H)"
-by blast
-
-lemma Pan_synth_eq [simp]: "(Pan A \<in> synth H) = (Pan A \<in> H)"
-by blast
-
-lemma keysFor_synth [simp]:
-    "keysFor (synth H) = keysFor H \<union> invKey`{K. Key K \<in> H}"
-by (unfold keysFor_def, blast)
-
-
-subsubsection{*Combinations of parts, analz and synth*}
-
-lemma parts_synth [simp]: "parts (synth H) = parts H \<union> synth H"
-apply (rule equalityI)
-apply (rule subsetI)
-apply (erule parts.induct)
-apply (blast intro: synth_increasing [THEN parts_mono, THEN subsetD]
-                    parts.Fst parts.Snd parts.Body)+
-done
-
-lemma analz_analz_Un [simp]: "analz (analz G \<union> H) = analz (G \<union> H)"
-apply (intro equalityI analz_subset_cong)+
-apply simp_all
-done
-
-lemma analz_synth_Un [simp]: "analz (synth G \<union> H) = analz (G \<union> H) \<union> synth G"
-apply (rule equalityI)
-apply (rule subsetI)
-apply (erule analz.induct)
-prefer 5 apply (blast intro: analz_mono [THEN [2] rev_subsetD])
-apply (blast intro: analz.Fst analz.Snd analz.Decrypt)+
-done
-
-lemma analz_synth [simp]: "analz (synth H) = analz H \<union> synth H"
-apply (cut_tac H = "{}" in analz_synth_Un)
-apply (simp (no_asm_use))
-done
-
-
-subsubsection{*For reasoning about the Fake rule in traces*}
-
-lemma parts_insert_subset_Un: "X\<in> G ==> parts(insert X H) \<subseteq> parts G \<union> parts H"
-by (rule subset_trans [OF parts_mono parts_Un_subset2], blast)
-
-(*More specifically for Fake.  Very occasionally we could do with a version
-  of the form  parts{X} \<subseteq> synth (analz H) \<union> parts H *)
-lemma Fake_parts_insert: "X \<in> synth (analz H) ==>
-      parts (insert X H) \<subseteq> synth (analz H) \<union> parts H"
-apply (drule parts_insert_subset_Un)
-apply (simp (no_asm_use))
-apply blast
-done
-
-lemma Fake_parts_insert_in_Un:
-     "[|Z \<in> parts (insert X H);  X: synth (analz H)|] 
-      ==> Z \<in>  synth (analz H) \<union> parts H";
-by (blast dest: Fake_parts_insert [THEN subsetD, dest])
-
-(*H is sometimes (Key ` KK \<union> spies evs), so can't put G=H*)
-lemma Fake_analz_insert:
-     "X\<in> synth (analz G) ==>
-      analz (insert X H) \<subseteq> synth (analz G) \<union> analz (G \<union> H)"
-apply (rule subsetI)
-apply (subgoal_tac "x \<in> analz (synth (analz G) \<union> H) ")
-prefer 2 apply (blast intro: analz_mono [THEN [2] rev_subsetD] analz_mono [THEN synth_mono, THEN [2] rev_subsetD])
-apply (simp (no_asm_use))
-apply blast
-done
-
-lemma analz_conj_parts [simp]:
-     "(X \<in> analz H & X \<in> parts H) = (X \<in> analz H)"
-by (blast intro: analz_subset_parts [THEN subsetD])
-
-lemma analz_disj_parts [simp]:
-     "(X \<in> analz H | X \<in> parts H) = (X \<in> parts H)"
-by (blast intro: analz_subset_parts [THEN subsetD])
-
-(*Without this equation, other rules for synth and analz would yield
-  redundant cases*)
-lemma MPair_synth_analz [iff]:
-     "({|X,Y|} \<in> synth (analz H)) =
-      (X \<in> synth (analz H) & Y \<in> synth (analz H))"
-by blast
-
-lemma Crypt_synth_analz:
-     "[| Key K \<in> analz H;  Key (invKey K) \<in> analz H |]
-       ==> (Crypt K X \<in> synth (analz H)) = (X \<in> synth (analz H))"
-by blast
-
-
-lemma Hash_synth_analz [simp]:
-     "X \<notin> synth (analz H)
-      ==> (Hash{|X,Y|} \<in> synth (analz H)) = (Hash{|X,Y|} \<in> analz H)"
-by blast
-
-
-(*We do NOT want Crypt... messages broken up in protocols!!*)
-declare parts.Body [rule del]
-
-
-text{*Rewrites to push in Key and Crypt messages, so that other messages can
-    be pulled out using the @{text analz_insert} rules*}
-
-lemmas pushKeys [standard] =
-  insert_commute [of "Key K" "Agent C"]
-  insert_commute [of "Key K" "Nonce N"]
-  insert_commute [of "Key K" "Number N"]
-  insert_commute [of "Key K" "Pan PAN"]
-  insert_commute [of "Key K" "Hash X"]
-  insert_commute [of "Key K" "MPair X Y"]
-  insert_commute [of "Key K" "Crypt X K'"]
-
-lemmas pushCrypts [standard] =
-  insert_commute [of "Crypt X K" "Agent C"]
-  insert_commute [of "Crypt X K" "Nonce N"]
-  insert_commute [of "Crypt X K" "Number N"]
-  insert_commute [of "Crypt X K" "Pan PAN"]
-  insert_commute [of "Crypt X K" "Hash X'"]
-  insert_commute [of "Crypt X K" "MPair X' Y"]
-
-text{*Cannot be added with @{text "[simp]"} -- messages should not always be
-  re-ordered.*}
-lemmas pushes = pushKeys pushCrypts
-
-
-subsection{*Tactics useful for many protocol proofs*}
-(*<*)
-ML
-{*
-structure MessageSET =
-struct
-
-(*Prove base case (subgoal i) and simplify others.  A typical base case
-  concerns  Crypt K X \<notin> Key`shrK`bad  and cannot be proved by rewriting
-  alone.*)
-fun prove_simple_subgoals_tac (cs, ss) i =
-    force_tac (cs, ss addsimps [@{thm image_eq_UN}]) i THEN
-    ALLGOALS (asm_simp_tac ss)
-
-(*Analysis of Fake cases.  Also works for messages that forward unknown parts,
-  but this application is no longer necessary if analz_insert_eq is used.
-  Abstraction over i is ESSENTIAL: it delays the dereferencing of claset
-  DEPENDS UPON "X" REFERRING TO THE FRADULENT MESSAGE *)
-
-fun impOfSubs th = th RSN (2, @{thm rev_subsetD})
-
-(*Apply rules to break down assumptions of the form
-  Y \<in> parts(insert X H)  and  Y \<in> analz(insert X H)
-*)
-val Fake_insert_tac =
-    dresolve_tac [impOfSubs @{thm Fake_analz_insert},
-                  impOfSubs @{thm Fake_parts_insert}] THEN'
-    eresolve_tac [asm_rl, @{thm synth.Inj}];
-
-fun Fake_insert_simp_tac ss i =
-    REPEAT (Fake_insert_tac i) THEN asm_full_simp_tac ss i;
-
-fun atomic_spy_analz_tac (cs,ss) = SELECT_GOAL
-    (Fake_insert_simp_tac ss 1
-     THEN
-     IF_UNSOLVED (Blast.depth_tac
-                  (cs addIs [@{thm analz_insertI},
-                                   impOfSubs @{thm analz_subset_parts}]) 4 1))
-
-fun spy_analz_tac (cs,ss) i =
-  DETERM
-   (SELECT_GOAL
-     (EVERY
-      [  (*push in occurrences of X...*)
-       (REPEAT o CHANGED)
-           (res_inst_tac (Simplifier.the_context ss)
-             [(("x", 1), "X")] (insert_commute RS ssubst) 1),
-       (*...allowing further simplifications*)
-       simp_tac ss 1,
-       REPEAT (FIRSTGOAL (resolve_tac [allI,impI,notI,conjI,iffI])),
-       DEPTH_SOLVE (atomic_spy_analz_tac (cs,ss) 1)]) i)
-
-end
-*}
-(*>*)
-
-
-(*By default only o_apply is built-in.  But in the presence of eta-expansion
-  this means that some terms displayed as (f o g) will be rewritten, and others
-  will not!*)
-declare o_def [simp]
-
-
-lemma Crypt_notin_image_Key [simp]: "Crypt K X \<notin> Key ` A"
-by auto
-
-lemma Hash_notin_image_Key [simp] :"Hash X \<notin> Key ` A"
-by auto
-
-lemma synth_analz_mono: "G<=H ==> synth (analz(G)) <= synth (analz(H))"
-by (simp add: synth_mono analz_mono)
-
-lemma Fake_analz_eq [simp]:
-     "X \<in> synth(analz H) ==> synth (analz (insert X H)) = synth (analz H)"
-apply (drule Fake_analz_insert[of _ _ "H"])
-apply (simp add: synth_increasing[THEN Un_absorb2])
-apply (drule synth_mono)
-apply (simp add: synth_idem)
-apply (blast intro: synth_analz_mono [THEN [2] rev_subsetD])
-done
-
-text{*Two generalizations of @{text analz_insert_eq}*}
-lemma gen_analz_insert_eq [rule_format]:
-     "X \<in> analz H ==> ALL G. H \<subseteq> G --> analz (insert X G) = analz G";
-by (blast intro: analz_cut analz_insertI analz_mono [THEN [2] rev_subsetD])
-
-lemma synth_analz_insert_eq [rule_format]:
-     "X \<in> synth (analz H)
-      ==> ALL G. H \<subseteq> G --> (Key K \<in> analz (insert X G)) = (Key K \<in> analz G)";
-apply (erule synth.induct)
-apply (simp_all add: gen_analz_insert_eq subset_trans [OF _ subset_insertI])
-done
-
-lemma Fake_parts_sing:
-     "X \<in> synth (analz H) ==> parts{X} \<subseteq> synth (analz H) \<union> parts H";
-apply (rule subset_trans)
- apply (erule_tac [2] Fake_parts_insert)
-apply (simp add: parts_mono)
-done
-
-lemmas Fake_parts_sing_imp_Un = Fake_parts_sing [THEN [2] rev_subsetD]
-
-method_setup spy_analz = {*
-    Scan.succeed (fn ctxt =>
-        SIMPLE_METHOD' (MessageSET.spy_analz_tac (clasimpset_of ctxt))) *}
-    "for proving the Fake case when analz is involved"
-
-method_setup atomic_spy_analz = {*
-    Scan.succeed (fn ctxt =>
-        SIMPLE_METHOD' (MessageSET.atomic_spy_analz_tac (clasimpset_of ctxt))) *}
-    "for debugging spy_analz"
-
-method_setup Fake_insert_simp = {*
-    Scan.succeed (fn ctxt =>
-        SIMPLE_METHOD' (MessageSET.Fake_insert_simp_tac (simpset_of ctxt))) *}
-    "for debugging spy_analz"
-
-end
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/SET-Protocol/PublicSET.thy
--- a/src/HOL/SET-Protocol/PublicSET.thy	Tue Oct 20 19:52:04 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,532 +0,0 @@
-(*  Title:      HOL/SET-Protocol/PublicSET.thy
-    Author:     Giampaolo Bella
-    Author:     Fabio Massacci
-    Author:     Lawrence C Paulson
-*)
-
-header{*The Public-Key Theory, Modified for SET*}
-
-theory PublicSET imports EventSET begin
-
-subsection{*Symmetric and Asymmetric Keys*}
-
-text{*definitions influenced by the wish to assign asymmetric keys 
-  - since the beginning - only to RCA and CAs, namely we need a partial 
-  function on type Agent*}
-
-
-text{*The SET specs mention two signature keys for CAs - we only have one*}
-
-consts
-  publicKey :: "[bool, agent] => key"
-    --{*the boolean is TRUE if a signing key*}
-
-syntax
-  pubEK :: "agent => key"
-  pubSK :: "agent => key"
-  priEK :: "agent => key"
-  priSK :: "agent => key"
-
-translations
-  "pubEK"  == "publicKey False"
-  "pubSK"  == "publicKey True"
-
-  (*BEWARE!! priEK, priSK DON'T WORK with inj, range, image, etc.*)
-  "priEK A"  == "invKey (pubEK A)"
-  "priSK A"  == "invKey (pubSK A)"
-
-text{*By freeness of agents, no two agents have the same key. Since
- @{term "True\<noteq>False"}, no agent has the same signing and encryption keys.*}
-
-specification (publicKey)
-  injective_publicKey:
-    "publicKey b A = publicKey c A' ==> b=c & A=A'"
-(*<*)
-   apply (rule exI [of _ "%b A. 2 * nat_of_agent A + (if b then 1 else 0)"]) 
-   apply (auto simp add: inj_on_def inj_nat_of_agent [THEN inj_eq] split: agent.split) 
-   apply (drule_tac f="%x. x mod 2" in arg_cong, simp add: mod_Suc)+
-(*or this, but presburger won't abstract out the function applications
-   apply presburger+
-*)
-   done                       
-(*>*)
-
-axioms
-  (*No private key equals any public key (essential to ensure that private
-    keys are private!) *)
-  privateKey_neq_publicKey [iff]:
-      "invKey (publicKey b A) \<noteq> publicKey b' A'"
-
-declare privateKey_neq_publicKey [THEN not_sym, iff]
-
-  
-subsection{*Initial Knowledge*}
-
-text{*This information is not necessary.  Each protocol distributes any needed
-certificates, and anyway our proofs require a formalization of the Spy's 
-knowledge only.  However, the initial knowledge is as follows:
-   All agents know RCA's public keys;
-   RCA and CAs know their own respective keys;
-   RCA (has already certified and therefore) knows all CAs public keys; 
-   Spy knows all keys of all bad agents.*}
-primrec    
-(*<*)
-  initState_CA:
-    "initState (CA i)  =
-       (if i=0 then Key ` ({priEK RCA, priSK RCA} Un
-                            pubEK ` (range CA) Un pubSK ` (range CA))
-        else {Key (priEK (CA i)), Key (priSK (CA i)),
-              Key (pubEK (CA i)), Key (pubSK (CA i)),
-              Key (pubEK RCA), Key (pubSK RCA)})"
-
-  initState_Cardholder:
-    "initState (Cardholder i)  =    
-       {Key (priEK (Cardholder i)), Key (priSK (Cardholder i)),
-        Key (pubEK (Cardholder i)), Key (pubSK (Cardholder i)),
-        Key (pubEK RCA), Key (pubSK RCA)}"
-
-  initState_Merchant:
-    "initState (Merchant i)  =    
-       {Key (priEK (Merchant i)), Key (priSK (Merchant i)),
-        Key (pubEK (Merchant i)), Key (pubSK (Merchant i)),
-        Key (pubEK RCA), Key (pubSK RCA)}"
-
-  initState_PG:
-    "initState (PG i)  = 
-       {Key (priEK (PG i)), Key (priSK (PG i)),
-        Key (pubEK (PG i)), Key (pubSK (PG i)),
-        Key (pubEK RCA), Key (pubSK RCA)}"
-(*>*)
-  initState_Spy:
-    "initState Spy = Key ` (invKey ` pubEK ` bad Un
-                            invKey ` pubSK ` bad Un
-                            range pubEK Un range pubSK)"
-
-
-text{*Injective mapping from agents to PANs: an agent can have only one card*}
-
-consts  pan :: "agent => nat"
-
-specification (pan)
-  inj_pan: "inj pan"
-  --{*No two agents have the same PAN*}
-(*<*)
-   apply (rule exI [of _ "nat_of_agent"]) 
-   apply (simp add: inj_on_def inj_nat_of_agent [THEN inj_eq]) 
-   done
-(*>*)
-
-declare inj_pan [THEN inj_eq, iff]
-
-consts
-  XOR :: "nat*nat => nat"  --{*no properties are assumed of exclusive-or*}
-
-
-subsection{*Signature Primitives*}
-
-constdefs 
-
- (* Signature = Message + signed Digest *)
-  sign :: "[key, msg]=>msg"
-    "sign K X == {|X, Crypt K (Hash X) |}"
-
- (* Signature Only = signed Digest Only *)
-  signOnly :: "[key, msg]=>msg"
-    "signOnly K X == Crypt K (Hash X)"
-
- (* Signature for Certificates = Message + signed Message *)
-  signCert :: "[key, msg]=>msg"
-    "signCert K X == {|X, Crypt K X |}"
-
- (* Certification Authority's Certificate.
-    Contains agent name, a key, a number specifying the key's target use,
-              a key to sign the entire certificate.
-
-    Should prove if signK=priSK RCA and C=CA i,
-                  then Ka=pubEK i or pubSK i depending on T  ??
- *)
-  cert :: "[agent, key, msg, key] => msg"
-    "cert A Ka T signK == signCert signK {|Agent A, Key Ka, T|}"
-
-
- (* Cardholder's Certificate.
-    Contains a PAN, the certified key Ka, the PANSecret PS,
-    a number specifying the target use for Ka, the signing key signK.
- *)
-  certC :: "[nat, key, nat, msg, key] => msg"
-    "certC PAN Ka PS T signK ==
-     signCert signK {|Hash {|Nonce PS, Pan PAN|}, Key Ka, T|}"
-
-  (*cert and certA have no repeated elements, so they could be translations,
-    but that's tricky and makes proofs slower*)
-
-syntax
-  "onlyEnc" :: msg      
-  "onlySig" :: msg
-  "authCode" :: msg
-
-translations
-  "onlyEnc"   == "Number 0"
-  "onlySig"  == "Number (Suc 0)"
-  "authCode" == "Number (Suc (Suc 0))"
-
-subsection{*Encryption Primitives*}
-
-constdefs
-
-  EXcrypt :: "[key,key,msg,msg] => msg"
-  --{*Extra Encryption*}
-    (*K: the symmetric key   EK: the public encryption key*)
-    "EXcrypt K EK M m ==
-       {|Crypt K {|M, Hash m|}, Crypt EK {|Key K, m|}|}"
-
-  EXHcrypt :: "[key,key,msg,msg] => msg"
-  --{*Extra Encryption with Hashing*}
-    (*K: the symmetric key   EK: the public encryption key*)
-    "EXHcrypt K EK M m ==
-       {|Crypt K {|M, Hash m|}, Crypt EK {|Key K, m, Hash M|}|}"
-
-  Enc :: "[key,key,key,msg] => msg"
-  --{*Simple Encapsulation with SIGNATURE*}
-    (*SK: the sender's signing key
-      K: the symmetric key
-      EK: the public encryption key*)
-    "Enc SK K EK M ==
-       {|Crypt K (sign SK M), Crypt EK (Key K)|}"
-
-  EncB :: "[key,key,key,msg,msg] => msg"
-  --{*Encapsulation with Baggage.  Keys as above, and baggage b.*}
-    "EncB SK K EK M b == 
-       {|Enc SK K EK {|M, Hash b|}, b|}"
-
-
-subsection{*Basic Properties of pubEK, pubSK, priEK and priSK *}
-
-lemma publicKey_eq_iff [iff]:
-     "(publicKey b A = publicKey b' A') = (b=b' & A=A')"
-by (blast dest: injective_publicKey)
-
-lemma privateKey_eq_iff [iff]:
-     "(invKey (publicKey b A) = invKey (publicKey b' A')) = (b=b' & A=A')"
-by auto
-
-lemma not_symKeys_publicKey [iff]: "publicKey b A \<notin> symKeys"
-by (simp add: symKeys_def)
-
-lemma not_symKeys_privateKey [iff]: "invKey (publicKey b A) \<notin> symKeys"
-by (simp add: symKeys_def)
-
-lemma symKeys_invKey_eq [simp]: "K \<in> symKeys ==> invKey K = K"
-by (simp add: symKeys_def)
-
-lemma symKeys_invKey_iff [simp]: "(invKey K \<in> symKeys) = (K \<in> symKeys)"
-by (unfold symKeys_def, auto)
-
-text{*Can be slow (or even loop) as a simprule*}
-lemma symKeys_neq_imp_neq: "(K \<in> symKeys) \<noteq> (K' \<in> symKeys) ==> K \<noteq> K'"
-by blast
-
-text{*These alternatives to @{text symKeys_neq_imp_neq} don't seem any better
-in practice.*}
-lemma publicKey_neq_symKey: "K \<in> symKeys ==> publicKey b A \<noteq> K"
-by blast
-
-lemma symKey_neq_publicKey: "K \<in> symKeys ==> K \<noteq> publicKey b A"
-by blast
-
-lemma privateKey_neq_symKey: "K \<in> symKeys ==> invKey (publicKey b A) \<noteq> K"
-by blast
-
-lemma symKey_neq_privateKey: "K \<in> symKeys ==> K \<noteq> invKey (publicKey b A)"
-by blast
-
-lemma analz_symKeys_Decrypt:
-     "[| Crypt K X \<in> analz H;  K \<in> symKeys;  Key K \<in> analz H |]  
-      ==> X \<in> analz H"
-by auto
-
-
-subsection{*"Image" Equations That Hold for Injective Functions *}
-
-lemma invKey_image_eq [iff]: "(invKey x \<in> invKey`A) = (x\<in>A)"
-by auto
-
-text{*holds because invKey is injective*}
-lemma publicKey_image_eq [iff]:
-     "(publicKey b A \<in> publicKey c ` AS) = (b=c & A\<in>AS)"
-by auto
-
-lemma privateKey_image_eq [iff]:
-     "(invKey (publicKey b A) \<in> invKey ` publicKey c ` AS) = (b=c & A\<in>AS)"
-by auto
-
-lemma privateKey_notin_image_publicKey [iff]:
-     "invKey (publicKey b A) \<notin> publicKey c ` AS"
-by auto
-
-lemma publicKey_notin_image_privateKey [iff]:
-     "publicKey b A \<notin> invKey ` publicKey c ` AS"
-by auto
-
-lemma keysFor_parts_initState [simp]: "keysFor (parts (initState C)) = {}"
-apply (simp add: keysFor_def)
-apply (induct_tac "C")
-apply (auto intro: range_eqI)
-done
-
-text{*for proving @{text new_keys_not_used}*}
-lemma keysFor_parts_insert:
-     "[| K \<in> keysFor (parts (insert X H));  X \<in> synth (analz H) |]  
-      ==> K \<in> keysFor (parts H) | Key (invKey K) \<in> parts H"
-by (force dest!: 
-         parts_insert_subset_Un [THEN keysFor_mono, THEN [2] rev_subsetD]
-         analz_subset_parts [THEN keysFor_mono, THEN [2] rev_subsetD] 
-            intro: analz_into_parts)
-
-lemma Crypt_imp_keysFor [intro]:
-     "[|K \<in> symKeys; Crypt K X \<in> H|] ==> K \<in> keysFor H"
-by (drule Crypt_imp_invKey_keysFor, simp)
-
-text{*Agents see their own private keys!*}
-lemma privateKey_in_initStateCA [iff]:
-     "Key (invKey (publicKey b A)) \<in> initState A"
-by (case_tac "A", auto)
-
-text{*Agents see their own public keys!*}
-lemma publicKey_in_initStateCA [iff]: "Key (publicKey b A) \<in> initState A"
-by (case_tac "A", auto)
-
-text{*RCA sees CAs' public keys! *}
-lemma pubK_CA_in_initState_RCA [iff]:
-     "Key (publicKey b (CA i)) \<in> initState RCA"
-by auto
-
-
-text{*Spy knows all public keys*}
-lemma knows_Spy_pubEK_i [iff]: "Key (publicKey b A) \<in> knows Spy evs"
-apply (induct_tac "evs")
-apply (simp_all add: imageI knows_Cons split add: event.split)
-done
-
-declare knows_Spy_pubEK_i [THEN analz.Inj, iff]
-                            (*needed????*)
-
-text{*Spy sees private keys of bad agents! [and obviously public keys too]*}
-lemma knows_Spy_bad_privateKey [intro!]:
-     "A \<in> bad ==> Key (invKey (publicKey b A)) \<in> knows Spy evs"
-by (rule initState_subset_knows [THEN subsetD], simp)
-
-
-subsection{*Fresh Nonces for Possibility Theorems*}
-
-lemma Nonce_notin_initState [iff]: "Nonce N \<notin> parts (initState B)"
-by (induct_tac "B", auto)
-
-lemma Nonce_notin_used_empty [simp]: "Nonce N \<notin> used []"
-by (simp add: used_Nil)
-
-text{*In any trace, there is an upper bound N on the greatest nonce in use.*}
-lemma Nonce_supply_lemma: "\<exists>N. \<forall>n. N<=n --> Nonce n \<notin> used evs"
-apply (induct_tac "evs")
-apply (rule_tac x = 0 in exI)
-apply (simp_all add: used_Cons split add: event.split, safe)
-apply (rule msg_Nonce_supply [THEN exE], blast elim!: add_leE)+
-done
-
-lemma Nonce_supply1: "\<exists>N. Nonce N \<notin> used evs"
-by (rule Nonce_supply_lemma [THEN exE], blast)
-
-lemma Nonce_supply: "Nonce (@ N. Nonce N \<notin> used evs) \<notin> used evs"
-apply (rule Nonce_supply_lemma [THEN exE])
-apply (rule someI, fast)
-done
-
-
-subsection{*Specialized Methods for Possibility Theorems*}
-
-ML
-{*
-structure PublicSET =
-struct
-
-(*Tactic for possibility theorems*)
-fun possibility_tac ctxt =
-    REPEAT (*omit used_Says so that Nonces start from different traces!*)
-    (ALLGOALS (simp_tac (simpset_of ctxt delsimps [@{thm used_Says}, @{thm used_Notes}]))
-     THEN
-     REPEAT_FIRST (eq_assume_tac ORELSE' 
-                   resolve_tac [refl, conjI, @{thm Nonce_supply}]))
-
-(*For harder protocols (such as SET_CR!), where we have to set up some
-  nonces and keys initially*)
-fun basic_possibility_tac ctxt =
-    REPEAT 
-    (ALLGOALS (asm_simp_tac (simpset_of ctxt setSolver safe_solver))
-     THEN
-     REPEAT_FIRST (resolve_tac [refl, conjI]))
-
-end
-*}
-
-method_setup possibility = {*
-    Scan.succeed (SIMPLE_METHOD o PublicSET.possibility_tac) *}
-    "for proving possibility theorems"
-
-method_setup basic_possibility = {*
-    Scan.succeed (SIMPLE_METHOD o PublicSET.basic_possibility_tac) *}
-    "for proving possibility theorems"
-
-
-subsection{*Specialized Rewriting for Theorems About @{term analz} and Image*}
-
-lemma insert_Key_singleton: "insert (Key K) H = Key ` {K} Un H"
-by blast
-
-lemma insert_Key_image:
-     "insert (Key K) (Key`KK Un C) = Key ` (insert K KK) Un C"
-by blast
-
-text{*Needed for @{text DK_fresh_not_KeyCryptKey}*}
-lemma publicKey_in_used [iff]: "Key (publicKey b A) \<in> used evs"
-by auto
-
-lemma privateKey_in_used [iff]: "Key (invKey (publicKey b A)) \<in> used evs"
-by (blast intro!: initState_into_used)
-
-text{*Reverse the normal simplification of "image" to build up (not break down)
-  the set of keys.  Based on @{text analz_image_freshK_ss}, but simpler.*}
-lemmas analz_image_keys_simps =
-       simp_thms mem_simps --{*these two allow its use with @{text "only:"}*}
-       image_insert [THEN sym] image_Un [THEN sym] 
-       rangeI symKeys_neq_imp_neq
-       insert_Key_singleton insert_Key_image Un_assoc [THEN sym]
-
-
-(*General lemmas proved by Larry*)
-
-subsection{*Controlled Unfolding of Abbreviations*}
-
-text{*A set is expanded only if a relation is applied to it*}
-lemma def_abbrev_simp_relation:
-     "A == B ==> (A \<in> X) = (B \<in> X) &  
-                 (u = A) = (u = B) &  
-                 (A = u) = (B = u)"
-by auto
-
-text{*A set is expanded only if one of the given functions is applied to it*}
-lemma def_abbrev_simp_function:
-     "A == B  
-      ==> parts (insert A X) = parts (insert B X) &  
-          analz (insert A X) = analz (insert B X) &  
-          keysFor (insert A X) = keysFor (insert B X)"
-by auto
-
-subsubsection{*Special Simplification Rules for @{term signCert}*}
-
-text{*Avoids duplicating X and its components!*}
-lemma parts_insert_signCert:
-     "parts (insert (signCert K X) H) =  
-      insert {|X, Crypt K X|} (parts (insert (Crypt K X) H))"
-by (simp add: signCert_def insert_commute [of X])
-
-text{*Avoids a case split! [X is always available]*}
-lemma analz_insert_signCert:
-     "analz (insert (signCert K X) H) =  
-      insert {|X, Crypt K X|} (insert (Crypt K X) (analz (insert X H)))"
-by (simp add: signCert_def insert_commute [of X])
-
-lemma keysFor_insert_signCert: "keysFor (insert (signCert K X) H) = keysFor H"
-by (simp add: signCert_def)
-
-text{*Controlled rewrite rules for @{term signCert}, just the definitions
-  of the others. Encryption primitives are just expanded, despite their huge
-  redundancy!*}
-lemmas abbrev_simps [simp] =
-    parts_insert_signCert analz_insert_signCert keysFor_insert_signCert
-    sign_def     [THEN def_abbrev_simp_relation]
-    sign_def     [THEN def_abbrev_simp_function]
-    signCert_def [THEN def_abbrev_simp_relation]
-    signCert_def [THEN def_abbrev_simp_function]
-    certC_def    [THEN def_abbrev_simp_relation]
-    certC_def    [THEN def_abbrev_simp_function]
-    cert_def     [THEN def_abbrev_simp_relation]
-    cert_def     [THEN def_abbrev_simp_function]
-    EXcrypt_def  [THEN def_abbrev_simp_relation]
-    EXcrypt_def  [THEN def_abbrev_simp_function]
-    EXHcrypt_def [THEN def_abbrev_simp_relation]
-    EXHcrypt_def [THEN def_abbrev_simp_function]
-    Enc_def      [THEN def_abbrev_simp_relation]
-    Enc_def      [THEN def_abbrev_simp_function]
-    EncB_def     [THEN def_abbrev_simp_relation]
-    EncB_def     [THEN def_abbrev_simp_function]
-
-
-subsubsection{*Elimination Rules for Controlled Rewriting *}
-
-lemma Enc_partsE: 
-     "!!R. [|Enc SK K EK M \<in> parts H;  
-             [|Crypt K (sign SK M) \<in> parts H;  
-               Crypt EK (Key K) \<in> parts H|] ==> R|]  
-           ==> R"
-
-by (unfold Enc_def, blast)
-
-lemma EncB_partsE: 
-     "!!R. [|EncB SK K EK M b \<in> parts H;  
-             [|Crypt K (sign SK {|M, Hash b|}) \<in> parts H;  
-               Crypt EK (Key K) \<in> parts H;  
-               b \<in> parts H|] ==> R|]  
-           ==> R"
-by (unfold EncB_def Enc_def, blast)
-
-lemma EXcrypt_partsE: 
-     "!!R. [|EXcrypt K EK M m \<in> parts H;  
-             [|Crypt K {|M, Hash m|} \<in> parts H;  
-               Crypt EK {|Key K, m|} \<in> parts H|] ==> R|]  
-           ==> R"
-by (unfold EXcrypt_def, blast)
-
-
-subsection{*Lemmas to Simplify Expressions Involving @{term analz} *}
-
-lemma analz_knows_absorb:
-     "Key K \<in> analz (knows Spy evs)  
-      ==> analz (Key ` (insert K H) \<union> knows Spy evs) =  
-          analz (Key ` H \<union> knows Spy evs)"
-by (simp add: analz_insert_eq Un_upper2 [THEN analz_mono, THEN subsetD])
-
-lemma analz_knows_absorb2:
-     "Key K \<in> analz (knows Spy evs)  
-      ==> analz (Key ` (insert X (insert K H)) \<union> knows Spy evs) =  
-          analz (Key ` (insert X H) \<union> knows Spy evs)"
-apply (subst insert_commute)
-apply (erule analz_knows_absorb)
-done
-
-lemma analz_insert_subset_eq:
-     "[|X \<in> analz (knows Spy evs);  knows Spy evs \<subseteq> H|]  
-      ==> analz (insert X H) = analz H"
-apply (rule analz_insert_eq)
-apply (blast intro: analz_mono [THEN [2] rev_subsetD])
-done
-
-lemmas analz_insert_simps = 
-         analz_insert_subset_eq Un_upper2
-         subset_insertI [THEN [2] subset_trans] 
-
-
-subsection{*Freshness Lemmas*}
-
-lemma in_parts_Says_imp_used:
-     "[|Key K \<in> parts {X}; Says A B X \<in> set evs|] ==> Key K \<in> used evs"
-by (blast intro: parts_trans dest!: Says_imp_knows_Spy [THEN parts.Inj])
-
-text{*A useful rewrite rule with @{term analz_image_keys_simps}*}
-lemma Crypt_notin_image_Key: "Crypt K X \<notin> Key ` KK"
-by auto
-
-lemma fresh_notin_analz_knows_Spy:
-     "Key K \<notin> used evs ==> Key K \<notin> analz (knows Spy evs)"
-by (auto dest: analz_into_parts)
-
-end
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/SET-Protocol/Purchase.thy
--- a/src/HOL/SET-Protocol/Purchase.thy	Tue Oct 20 19:52:04 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,1170 +0,0 @@
-(*  Title:      HOL/SET-Protocol/Purchase.thy
-    Author:     Giampaolo Bella
-    Author:     Fabio Massacci
-    Author:     Lawrence C Paulson
-*)
-
-header{*Purchase Phase of SET*}
-
-theory Purchase imports PublicSET begin
-
-text{*
-Note: nonces seem to consist of 20 bytes.  That includes both freshness
-challenges (Chall-EE, etc.) and important secrets (CardSecret, PANsecret)
-
-This version omits @{text LID_C} but retains @{text LID_M}. At first glance
-(Programmer's Guide page 267) it seems that both numbers are just introduced
-for the respective convenience of the Cardholder's and Merchant's
-system. However, omitting both of them would create a problem of
-identification: how can the Merchant's system know what transaction is it
-supposed to process?
-
-Further reading (Programmer's guide page 309) suggest that there is an outside
-bootstrapping message (SET initiation message) which is used by the Merchant
-and the Cardholder to agree on the actual transaction. This bootstrapping
-message is described in the SET External Interface Guide and ought to generate
-@{text LID_M}. According SET Extern Interface Guide, this number might be a
-cookie, an invoice number etc. The Programmer's Guide on page 310, states that
-in absence of @{text LID_M} the protocol must somehow ("outside SET") identify
-the transaction from OrderDesc, which is assumed to be a searchable text only
-field. Thus, it is assumed that the Merchant or the Cardholder somehow agreed
-out-of-bad on the value of @{text LID_M} (for instance a cookie in a web
-transaction etc.). This out-of-band agreement is expressed with a preliminary
-start action in which the merchant and the Cardholder agree on the appropriate
-values. Agreed values are stored with a suitable notes action.
-
-"XID is a transaction ID that is usually generated by the Merchant system,
-unless there is no PInitRes, in which case it is generated by the Cardholder
-system. It is a randomly generated 20 byte variable that is globally unique
-(statistically). Merchant and Cardholder systems shall use appropriate random
-number generators to ensure the global uniqueness of XID."
---Programmer's Guide, page 267.
-
-PI (Payment Instruction) is the most central and sensitive data structure in
-SET. It is used to pass the data required to authorize a payment card payment
-from the Cardholder to the Payment Gateway, which will use the data to
-initiate a payment card transaction through the traditional payment card
-financial network. The data is encrypted by the Cardholder and sent via the
-Merchant, such that the data is hidden from the Merchant unless the Acquirer
-passes the data back to the Merchant.
---Programmer's Guide, page 271.*}
-
-consts
-
-    CardSecret :: "nat => nat"
-     --{*Maps Cardholders to CardSecrets.
-         A CardSecret of 0 means no cerificate, must use unsigned format.*}
-
-    PANSecret :: "nat => nat"
-     --{*Maps Cardholders to PANSecrets.*}
-
-inductive_set
-  set_pur :: "event list set"
-where
-
-  Nil:   --{*Initial trace is empty*}
-         "[] \<in> set_pur"
-
-| Fake:  --{*The spy MAY say anything he CAN say.*}
-         "[| evsf \<in> set_pur;  X \<in> synth(analz(knows Spy evsf)) |]
-          ==> Says Spy B X  # evsf \<in> set_pur"
-
-
-| Reception: --{*If A sends a message X to B, then B might receive it*}
-             "[| evsr \<in> set_pur;  Says A B X \<in> set evsr |]
-              ==> Gets B X  # evsr \<in> set_pur"
-
-| Start: 
-      --{*Added start event which is out-of-band for SET: the Cardholder and
-          the merchant agree on the amounts and uses @{text LID_M} as an
-          identifier.
-          This is suggested by the External Interface Guide. The Programmer's
-          Guide, in absence of @{text LID_M}, states that the merchant uniquely
-          identifies the order out of some data contained in OrderDesc.*}
-   "[|evsStart \<in> set_pur;
-      Number LID_M \<notin> used evsStart;
-      C = Cardholder k; M = Merchant i; P = PG j;
-      Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
-      LID_M \<notin> range CardSecret;
-      LID_M \<notin> range PANSecret |]
-     ==> Notes C {|Number LID_M, Transaction|}
-       # Notes M {|Number LID_M, Agent P, Transaction|}
-       # evsStart \<in> set_pur"
-
-| PInitReq:
-     --{*Purchase initialization, page 72 of Formal Protocol Desc.*}
-   "[|evsPIReq \<in> set_pur;
-      Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
-      Nonce Chall_C \<notin> used evsPIReq;
-      Chall_C \<notin> range CardSecret; Chall_C \<notin> range PANSecret;
-      Notes C {|Number LID_M, Transaction |} \<in> set evsPIReq |]
-    ==> Says C M {|Number LID_M, Nonce Chall_C|} # evsPIReq \<in> set_pur"
-
-| PInitRes:
-     --{*Merchant replies with his own label XID and the encryption
-         key certificate of his chosen Payment Gateway. Page 74 of Formal
-         Protocol Desc. We use @{text LID_M} to identify Cardholder*}
-   "[|evsPIRes \<in> set_pur;
-      Gets M {|Number LID_M, Nonce Chall_C|} \<in> set evsPIRes;
-      Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
-      Notes M {|Number LID_M, Agent P, Transaction|} \<in> set evsPIRes;
-      Nonce Chall_M \<notin> used evsPIRes;
-      Chall_M \<notin> range CardSecret; Chall_M \<notin> range PANSecret;
-      Number XID \<notin> used evsPIRes;
-      XID \<notin> range CardSecret; XID \<notin> range PANSecret|]
-    ==> Says M C (sign (priSK M)
-                       {|Number LID_M, Number XID,
-                         Nonce Chall_C, Nonce Chall_M,
-                         cert P (pubEK P) onlyEnc (priSK RCA)|})
-          # evsPIRes \<in> set_pur"
-
-| PReqUns:
-      --{*UNSIGNED Purchase request (CardSecret = 0).
-        Page 79 of Formal Protocol Desc.
-        Merchant never sees the amount in clear. This holds of the real
-        protocol, where XID identifies the transaction. We omit
-        Hash{|Number XID, Nonce (CardSecret k)|} from PIHead because
-        the CardSecret is 0 and because AuthReq treated the unsigned case
-        very differently from the signed one anyway.*}
-   "!!Chall_C Chall_M OrderDesc P PurchAmt XID evsPReqU.
-    [|evsPReqU \<in> set_pur;
-      C = Cardholder k; CardSecret k = 0;
-      Key KC1 \<notin> used evsPReqU;  KC1 \<in> symKeys;
-      Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
-      HOD = Hash{|Number OrderDesc, Number PurchAmt|};
-      OIData = {|Number LID_M, Number XID, Nonce Chall_C, HOD,Nonce Chall_M|};
-      PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M|};
-      Gets C (sign (priSK M)
-                   {|Number LID_M, Number XID,
-                     Nonce Chall_C, Nonce Chall_M,
-                     cert P EKj onlyEnc (priSK RCA)|})
-        \<in> set evsPReqU;
-      Says C M {|Number LID_M, Nonce Chall_C|} \<in> set evsPReqU;
-      Notes C {|Number LID_M, Transaction|} \<in> set evsPReqU |]
-    ==> Says C M
-             {|EXHcrypt KC1 EKj {|PIHead, Hash OIData|} (Pan (pan C)),
-               OIData, Hash{|PIHead, Pan (pan C)|} |}
-          # Notes C {|Key KC1, Agent M|}
-          # evsPReqU \<in> set_pur"
-
-| PReqS:
-      --{*SIGNED Purchase request.  Page 77 of Formal Protocol Desc.
-          We could specify the equation
-          @{term "PIReqSigned = {| PIDualSigned, OIDualSigned |}"}, since the
-          Formal Desc. gives PIHead the same format in the unsigned case.
-          However, there's little point, as P treats the signed and 
-          unsigned cases differently.*}
-   "!!C Chall_C Chall_M EKj HOD KC2 LID_M M OIData
-      OIDualSigned OrderDesc P PANData PIData PIDualSigned
-      PIHead PurchAmt Transaction XID evsPReqS k.
-    [|evsPReqS \<in> set_pur;
-      C = Cardholder k;
-      CardSecret k \<noteq> 0;  Key KC2 \<notin> used evsPReqS;  KC2 \<in> symKeys;
-      Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
-      HOD = Hash{|Number OrderDesc, Number PurchAmt|};
-      OIData = {|Number LID_M, Number XID, Nonce Chall_C, HOD, Nonce Chall_M|};
-      PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M,
-                  Hash{|Number XID, Nonce (CardSecret k)|}|};
-      PANData = {|Pan (pan C), Nonce (PANSecret k)|};
-      PIData = {|PIHead, PANData|};
-      PIDualSigned = {|sign (priSK C) {|Hash PIData, Hash OIData|},
-                       EXcrypt KC2 EKj {|PIHead, Hash OIData|} PANData|};
-      OIDualSigned = {|OIData, Hash PIData|};
-      Gets C (sign (priSK M)
-                   {|Number LID_M, Number XID,
-                     Nonce Chall_C, Nonce Chall_M,
-                     cert P EKj onlyEnc (priSK RCA)|})
-        \<in> set evsPReqS;
-      Says C M {|Number LID_M, Nonce Chall_C|} \<in> set evsPReqS;
-      Notes C {|Number LID_M, Transaction|} \<in> set evsPReqS |]
-    ==> Says C M {|PIDualSigned, OIDualSigned|}
-          # Notes C {|Key KC2, Agent M|}
-          # evsPReqS \<in> set_pur"
-
-  --{*Authorization Request.  Page 92 of Formal Protocol Desc.
-    Sent in response to Purchase Request.*}
-| AuthReq:
-   "[| evsAReq \<in> set_pur;
-       Key KM \<notin> used evsAReq;  KM \<in> symKeys;
-       Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
-       HOD = Hash{|Number OrderDesc, Number PurchAmt|};
-       OIData = {|Number LID_M, Number XID, Nonce Chall_C, HOD,
-                  Nonce Chall_M|};
-       CardSecret k \<noteq> 0 -->
-         P_I = {|sign (priSK C) {|HPIData, Hash OIData|}, encPANData|};
-       Gets M {|P_I, OIData, HPIData|} \<in> set evsAReq;
-       Says M C (sign (priSK M) {|Number LID_M, Number XID,
-                                  Nonce Chall_C, Nonce Chall_M,
-                                  cert P EKj onlyEnc (priSK RCA)|})
-         \<in> set evsAReq;
-        Notes M {|Number LID_M, Agent P, Transaction|}
-           \<in> set evsAReq |]
-    ==> Says M P
-             (EncB (priSK M) KM (pubEK P)
-               {|Number LID_M, Number XID, Hash OIData, HOD|}   P_I)
-          # evsAReq \<in> set_pur"
-
-  --{*Authorization Response has two forms: for UNSIGNED and SIGNED PIs.
-    Page 99 of Formal Protocol Desc.
-    PI is a keyword (product!), so we call it @{text P_I}. The hashes HOD and
-    HOIData occur independently in @{text P_I} and in M's message.
-    The authCode in AuthRes represents the baggage of EncB, which in the
-    full protocol is [CapToken], [AcqCardMsg], [AuthToken]:
-    optional items for split shipments, recurring payments, etc.*}
-
-| AuthResUns:
-    --{*Authorization Response, UNSIGNED*}
-   "[| evsAResU \<in> set_pur;
-       C = Cardholder k; M = Merchant i;
-       Key KP \<notin> used evsAResU;  KP \<in> symKeys;
-       CardSecret k = 0;  KC1 \<in> symKeys;  KM \<in> symKeys;
-       PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M|};
-       P_I = EXHcrypt KC1 EKj {|PIHead, HOIData|} (Pan (pan C));
-       Gets P (EncB (priSK M) KM (pubEK P)
-               {|Number LID_M, Number XID, HOIData, HOD|} P_I)
-           \<in> set evsAResU |]
-   ==> Says P M
-            (EncB (priSK P) KP (pubEK M)
-              {|Number LID_M, Number XID, Number PurchAmt|}
-              authCode)
-       # evsAResU \<in> set_pur"
-
-| AuthResS:
-    --{*Authorization Response, SIGNED*}
-   "[| evsAResS \<in> set_pur;
-       C = Cardholder k;
-       Key KP \<notin> used evsAResS;  KP \<in> symKeys;
-       CardSecret k \<noteq> 0;  KC2 \<in> symKeys;  KM \<in> symKeys;
-       P_I = {|sign (priSK C) {|Hash PIData, HOIData|},
-               EXcrypt KC2 (pubEK P) {|PIHead, HOIData|} PANData|};
-       PANData = {|Pan (pan C), Nonce (PANSecret k)|};
-       PIData = {|PIHead, PANData|};
-       PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M,
-                  Hash{|Number XID, Nonce (CardSecret k)|}|};
-       Gets P (EncB (priSK M) KM (pubEK P)
-                {|Number LID_M, Number XID, HOIData, HOD|}
-               P_I)
-           \<in> set evsAResS |]
-   ==> Says P M
-            (EncB (priSK P) KP (pubEK M)
-              {|Number LID_M, Number XID, Number PurchAmt|}
-              authCode)
-       # evsAResS \<in> set_pur"
-
-| PRes:
-    --{*Purchase response.*}
-   "[| evsPRes \<in> set_pur;  KP \<in> symKeys;  M = Merchant i;
-       Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
-       Gets M (EncB (priSK P) KP (pubEK M)
-              {|Number LID_M, Number XID, Number PurchAmt|}
-              authCode)
-          \<in> set evsPRes;
-       Gets M {|Number LID_M, Nonce Chall_C|} \<in> set evsPRes;
-       Says M P
-            (EncB (priSK M) KM (pubEK P)
-              {|Number LID_M, Number XID, Hash OIData, HOD|} P_I)
-         \<in> set evsPRes;
-       Notes M {|Number LID_M, Agent P, Transaction|}
-          \<in> set evsPRes
-      |]
-   ==> Says M C
-         (sign (priSK M) {|Number LID_M, Number XID, Nonce Chall_C,
-                           Hash (Number PurchAmt)|})
-         # evsPRes \<in> set_pur"
-
-
-specification (CardSecret PANSecret)
-  inj_CardSecret:  "inj CardSecret"
-  inj_PANSecret:   "inj PANSecret"
-  CardSecret_neq_PANSecret: "CardSecret k \<noteq> PANSecret k'"
-    --{*No CardSecret equals any PANSecret*}
-  apply (rule_tac x="curry nat2_to_nat 0" in exI)
-  apply (rule_tac x="curry nat2_to_nat 1" in exI)
-  apply (simp add: nat2_to_nat_inj [THEN inj_eq] inj_on_def)
-  done
-
-declare Says_imp_knows_Spy [THEN parts.Inj, dest]
-declare parts.Body [dest]
-declare analz_into_parts [dest]
-declare Fake_parts_insert_in_Un [dest]
-
-declare CardSecret_neq_PANSecret [iff] 
-        CardSecret_neq_PANSecret [THEN not_sym, iff]
-declare inj_CardSecret [THEN inj_eq, iff] 
-        inj_PANSecret [THEN inj_eq, iff]
-
-
-subsection{*Possibility Properties*}
-
-lemma Says_to_Gets:
-     "Says A B X # evs \<in> set_pur ==> Gets B X # Says A B X # evs \<in> set_pur"
-by (rule set_pur.Reception, auto)
-
-text{*Possibility for UNSIGNED purchases. Note that we need to ensure
-that XID differs from OrderDesc and PurchAmt, since it is supposed to be
-a unique number!*}
-lemma possibility_Uns:
-    "[| CardSecret k = 0;
-        C = Cardholder k;  M = Merchant i;
-        Key KC \<notin> used []; Key KM \<notin> used []; Key KP \<notin> used []; 
-        KC \<in> symKeys; KM \<in> symKeys; KP \<in> symKeys; 
-        KC < KM; KM < KP;
-        Nonce Chall_C \<notin> used []; Chall_C \<notin> range CardSecret \<union> range PANSecret;
-        Nonce Chall_M \<notin> used []; Chall_M \<notin> range CardSecret \<union> range PANSecret;
-        Chall_C < Chall_M; 
-        Number LID_M \<notin> used []; LID_M \<notin> range CardSecret \<union> range PANSecret;
-        Number XID \<notin> used []; XID \<notin> range CardSecret \<union> range PANSecret;
-        LID_M < XID; XID < OrderDesc; OrderDesc < PurchAmt |] 
-   ==> \<exists>evs \<in> set_pur.
-          Says M C
-               (sign (priSK M)
-                    {|Number LID_M, Number XID, Nonce Chall_C, 
-                      Hash (Number PurchAmt)|})
-                  \<in> set evs" 
-apply (intro exI bexI)
-apply (rule_tac [2]
-        set_pur.Nil
-         [THEN set_pur.Start [of _ LID_M C k M i _ _ _ OrderDesc PurchAmt], 
-          THEN set_pur.PInitReq [of concl: C M LID_M Chall_C],
-          THEN Says_to_Gets, 
-          THEN set_pur.PInitRes [of concl: M C LID_M XID Chall_C Chall_M], 
-          THEN Says_to_Gets,
-          THEN set_pur.PReqUns [of concl: C M KC],
-          THEN Says_to_Gets, 
-          THEN set_pur.AuthReq [of concl: M "PG j" KM LID_M XID], 
-          THEN Says_to_Gets, 
-          THEN set_pur.AuthResUns [of concl: "PG j" M KP LID_M XID],
-          THEN Says_to_Gets, 
-          THEN set_pur.PRes]) 
-apply basic_possibility
-apply (simp_all add: used_Cons symKeys_neq_imp_neq) 
-done
-
-lemma possibility_S:
-    "[| CardSecret k \<noteq> 0;
-        C = Cardholder k;  M = Merchant i;
-        Key KC \<notin> used []; Key KM \<notin> used []; Key KP \<notin> used []; 
-        KC \<in> symKeys; KM \<in> symKeys; KP \<in> symKeys; 
-        KC < KM; KM < KP;
-        Nonce Chall_C \<notin> used []; Chall_C \<notin> range CardSecret \<union> range PANSecret;
-        Nonce Chall_M \<notin> used []; Chall_M \<notin> range CardSecret \<union> range PANSecret;
-        Chall_C < Chall_M; 
-        Number LID_M \<notin> used []; LID_M \<notin> range CardSecret \<union> range PANSecret;
-        Number XID \<notin> used []; XID \<notin> range CardSecret \<union> range PANSecret;
-        LID_M < XID; XID < OrderDesc; OrderDesc < PurchAmt |] 
-   ==>  \<exists>evs \<in> set_pur.
-            Says M C
-                 (sign (priSK M) {|Number LID_M, Number XID, Nonce Chall_C, 
-                                   Hash (Number PurchAmt)|})
-               \<in> set evs"
-apply (intro exI bexI)
-apply (rule_tac [2]
-        set_pur.Nil
-         [THEN set_pur.Start [of _ LID_M C k M i _ _ _ OrderDesc PurchAmt], 
-          THEN set_pur.PInitReq [of concl: C M LID_M Chall_C],
-          THEN Says_to_Gets, 
-          THEN set_pur.PInitRes [of concl: M C LID_M XID Chall_C Chall_M], 
-          THEN Says_to_Gets,
-          THEN set_pur.PReqS [of concl: C M _ _ KC],
-          THEN Says_to_Gets, 
-          THEN set_pur.AuthReq [of concl: M "PG j" KM LID_M XID], 
-          THEN Says_to_Gets, 
-          THEN set_pur.AuthResS [of concl: "PG j" M KP LID_M XID],
-          THEN Says_to_Gets, 
-          THEN set_pur.PRes]) 
-apply basic_possibility
-apply (auto simp add: used_Cons symKeys_neq_imp_neq) 
-done
-
-text{*General facts about message reception*}
-lemma Gets_imp_Says:
-     "[| Gets B X \<in> set evs; evs \<in> set_pur |]
-   ==> \<exists>A. Says A B X \<in> set evs"
-apply (erule rev_mp)
-apply (erule set_pur.induct, auto)
-done
-
-lemma Gets_imp_knows_Spy:
-     "[| Gets B X \<in> set evs; evs \<in> set_pur |]  ==> X \<in> knows Spy evs"
-by (blast dest!: Gets_imp_Says Says_imp_knows_Spy)
-
-declare Gets_imp_knows_Spy [THEN parts.Inj, dest]
-
-text{*Forwarding lemmas, to aid simplification*}
-
-lemma AuthReq_msg_in_parts_spies:
-     "[|Gets M {|P_I, OIData, HPIData|} \<in> set evs;
-        evs \<in> set_pur|] ==> P_I \<in> parts (knows Spy evs)"
-by auto
-
-lemma AuthReq_msg_in_analz_spies:
-     "[|Gets M {|P_I, OIData, HPIData|} \<in> set evs;
-        evs \<in> set_pur|] ==> P_I \<in> analz (knows Spy evs)"
-by (blast dest: Gets_imp_knows_Spy [THEN analz.Inj])
-
-
-subsection{*Proofs on Asymmetric Keys*}
-
-text{*Private Keys are Secret*}
-
-text{*Spy never sees an agent's private keys! (unless it's bad at start)*}
-lemma Spy_see_private_Key [simp]:
-     "evs \<in> set_pur
-      ==> (Key(invKey (publicKey b A)) \<in> parts(knows Spy evs)) = (A \<in> bad)"
-apply (erule set_pur.induct)
-apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
-apply auto
-done
-declare Spy_see_private_Key [THEN [2] rev_iffD1, dest!]
-
-lemma Spy_analz_private_Key [simp]:
-     "evs \<in> set_pur ==>
-     (Key(invKey (publicKey b A)) \<in> analz(knows Spy evs)) = (A \<in> bad)"
-by auto
-declare Spy_analz_private_Key [THEN [2] rev_iffD1, dest!]
-
-text{*rewriting rule for priEK's*}
-lemma parts_image_priEK:
-     "[|Key (priEK C) \<in> parts (Key`KK Un (knows Spy evs));
-        evs \<in> set_pur|] ==> priEK C \<in> KK | C \<in> bad"
-by auto
-
-text{*trivial proof because @{term"priEK C"} never appears even in
-  @{term "parts evs"}. *}
-lemma analz_image_priEK:
-     "evs \<in> set_pur ==>
-          (Key (priEK C) \<in> analz (Key`KK Un (knows Spy evs))) =
-          (priEK C \<in> KK | C \<in> bad)"
-by (blast dest!: parts_image_priEK intro: analz_mono [THEN [2] rev_subsetD])
-
-
-subsection{*Public Keys in Certificates are Correct*}
-
-lemma Crypt_valid_pubEK [dest!]:
-     "[| Crypt (priSK RCA) {|Agent C, Key EKi, onlyEnc|}
-           \<in> parts (knows Spy evs);
-         evs \<in> set_pur |] ==> EKi = pubEK C"
-by (erule rev_mp, erule set_pur.induct, auto)
-
-lemma Crypt_valid_pubSK [dest!]:
-     "[| Crypt (priSK RCA) {|Agent C, Key SKi, onlySig|}
-           \<in> parts (knows Spy evs);
-         evs \<in> set_pur |] ==> SKi = pubSK C"
-by (erule rev_mp, erule set_pur.induct, auto)
-
-lemma certificate_valid_pubEK:
-    "[| cert C EKi onlyEnc (priSK RCA) \<in> parts (knows Spy evs);
-        evs \<in> set_pur |]
-     ==> EKi = pubEK C"
-by (unfold cert_def signCert_def, auto)
-
-lemma certificate_valid_pubSK:
-    "[| cert C SKi onlySig (priSK RCA) \<in> parts (knows Spy evs);
-        evs \<in> set_pur |] ==> SKi = pubSK C"
-by (unfold cert_def signCert_def, auto)
-
-lemma Says_certificate_valid [simp]:
-     "[| Says A B (sign SK {|lid, xid, cc, cm,
-                           cert C EK onlyEnc (priSK RCA)|}) \<in> set evs;
-         evs \<in> set_pur |]
-      ==> EK = pubEK C"
-by (unfold sign_def, auto)
-
-lemma Gets_certificate_valid [simp]:
-     "[| Gets A (sign SK {|lid, xid, cc, cm,
-                           cert C EK onlyEnc (priSK RCA)|}) \<in> set evs;
-         evs \<in> set_pur |]
-      ==> EK = pubEK C"
-by (frule Gets_imp_Says, auto)
-
-method_setup valid_certificate_tac = {*
-  Args.goal_spec >> (fn quant =>
-    K (SIMPLE_METHOD'' quant (fn i =>
-      EVERY [ftac @{thm Gets_certificate_valid} i,
-             assume_tac i, REPEAT (hyp_subst_tac i)])))
-*} ""
-
-
-subsection{*Proofs on Symmetric Keys*}
-
-text{*Nobody can have used non-existent keys!*}
-lemma new_keys_not_used [rule_format,simp]:
-     "evs \<in> set_pur
-      ==> Key K \<notin> used evs --> K \<in> symKeys -->
-          K \<notin> keysFor (parts (knows Spy evs))"
-apply (erule set_pur.induct)
-apply (valid_certificate_tac [8]) --{*PReqS*}
-apply (valid_certificate_tac [7]) --{*PReqUns*}
-apply auto
-apply (force dest!: usedI keysFor_parts_insert) --{*Fake*}
-done
-
-lemma new_keys_not_analzd:
-     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_pur |]
-      ==> K \<notin> keysFor (analz (knows Spy evs))"
-by (blast intro: keysFor_mono [THEN [2] rev_subsetD] dest: new_keys_not_used)
-
-lemma Crypt_parts_imp_used:
-     "[|Crypt K X \<in> parts (knows Spy evs);
-        K \<in> symKeys; evs \<in> set_pur |] ==> Key K \<in> used evs"
-apply (rule ccontr)
-apply (force dest: new_keys_not_used Crypt_imp_invKey_keysFor)
-done
-
-lemma Crypt_analz_imp_used:
-     "[|Crypt K X \<in> analz (knows Spy evs);
-        K \<in> symKeys; evs \<in> set_pur |] ==> Key K \<in> used evs"
-by (blast intro: Crypt_parts_imp_used)
-
-text{*New versions: as above, but generalized to have the KK argument*}
-
-lemma gen_new_keys_not_used:
-     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_pur |]
-      ==> Key K \<notin> used evs --> K \<in> symKeys -->
-          K \<notin> keysFor (parts (Key`KK Un knows Spy evs))"
-by auto
-
-lemma gen_new_keys_not_analzd:
-     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_pur |]
-      ==> K \<notin> keysFor (analz (Key`KK Un knows Spy evs))"
-by (blast intro: keysFor_mono [THEN subsetD] dest: gen_new_keys_not_used)
-
-lemma analz_Key_image_insert_eq:
-     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_pur |]
-      ==> analz (Key ` (insert K KK) \<union> knows Spy evs) =
-          insert (Key K) (analz (Key ` KK \<union> knows Spy evs))"
-by (simp add: gen_new_keys_not_analzd)
-
-
-subsection{*Secrecy of Symmetric Keys*}
-
-lemma Key_analz_image_Key_lemma:
-     "P --> (Key K \<in> analz (Key`KK Un H)) --> (K\<in>KK | Key K \<in> analz H)
-      ==>
-      P --> (Key K \<in> analz (Key`KK Un H)) = (K\<in>KK | Key K \<in> analz H)"
-by (blast intro: analz_mono [THEN [2] rev_subsetD])
-
-
-lemma symKey_compromise:
-     "evs \<in> set_pur \<Longrightarrow>
-      (\<forall>SK KK. SK \<in> symKeys \<longrightarrow>
-        (\<forall>K \<in> KK. K \<notin> range(\<lambda>C. priEK C)) \<longrightarrow>
-               (Key SK \<in> analz (Key`KK \<union> (knows Spy evs))) =
-               (SK \<in> KK \<or> Key SK \<in> analz (knows Spy evs)))"
-apply (erule set_pur.induct)
-apply (rule_tac [!] allI)+
-apply (rule_tac [!] impI [THEN Key_analz_image_Key_lemma, THEN impI])+
-apply (frule_tac [9] AuthReq_msg_in_analz_spies) --{*AReq*}
-apply (valid_certificate_tac [8]) --{*PReqS*}
-apply (valid_certificate_tac [7]) --{*PReqUns*}
-apply (simp_all
-         del: image_insert image_Un imp_disjL
-         add: analz_image_keys_simps disj_simps
-              analz_Key_image_insert_eq notin_image_iff
-              analz_insert_simps analz_image_priEK)
-  --{*8 seconds on a 1.6GHz machine*}
-apply spy_analz --{*Fake*}
-apply (blast elim!: ballE)+ --{*PReq: unsigned and signed*}
-done
-
-
-
-subsection{*Secrecy of Nonces*}
-
-text{*As usual: we express the property as a logical equivalence*}
-lemma Nonce_analz_image_Key_lemma:
-     "P --> (Nonce N \<in> analz (Key`KK Un H)) --> (Nonce N \<in> analz H)
-      ==> P --> (Nonce N \<in> analz (Key`KK Un H)) = (Nonce N \<in> analz H)"
-by (blast intro: analz_mono [THEN [2] rev_subsetD])
-
-text{*The @{text "(no_asm)"} attribute is essential, since it retains
-  the quantifier and allows the simprule's condition to itself be simplified.*}
-lemma Nonce_compromise [rule_format (no_asm)]:
-     "evs \<in> set_pur ==>
-      (\<forall>N KK. (\<forall>K \<in> KK. K \<notin> range(\<lambda>C. priEK C))   -->
-              (Nonce N \<in> analz (Key`KK \<union> (knows Spy evs))) =
-              (Nonce N \<in> analz (knows Spy evs)))"
-apply (erule set_pur.induct)
-apply (rule_tac [!] allI)+
-apply (rule_tac [!] impI [THEN Nonce_analz_image_Key_lemma])+
-apply (frule_tac [9] AuthReq_msg_in_analz_spies) --{*AReq*}
-apply (valid_certificate_tac [8]) --{*PReqS*}
-apply (valid_certificate_tac [7]) --{*PReqUns*}
-apply (simp_all
-         del: image_insert image_Un imp_disjL
-         add: analz_image_keys_simps disj_simps symKey_compromise
-              analz_Key_image_insert_eq notin_image_iff
-              analz_insert_simps analz_image_priEK)
-  --{*8 seconds on a 1.6GHz machine*}
-apply spy_analz --{*Fake*}
-apply (blast elim!: ballE) --{*PReqS*}
-done
-
-lemma PANSecret_notin_spies:
-     "[|Nonce (PANSecret k) \<in> analz (knows Spy evs);  evs \<in> set_pur|]
-      ==> 
-       (\<exists>V W X Y KC2 M. \<exists>P \<in> bad.
-          Says (Cardholder k) M
-               {|{|W, EXcrypt KC2 (pubEK P) X {|Y, Nonce (PANSecret k)|}|},
-                 V|}  \<in>  set evs)"
-apply (erule rev_mp)
-apply (erule set_pur.induct)
-apply (frule_tac [9] AuthReq_msg_in_analz_spies)
-apply (valid_certificate_tac [8]) --{*PReqS*}
-apply (simp_all
-         del: image_insert image_Un imp_disjL
-         add: analz_image_keys_simps disj_simps
-              symKey_compromise pushes sign_def Nonce_compromise
-              analz_Key_image_insert_eq notin_image_iff
-              analz_insert_simps analz_image_priEK)
-  --{*2.5 seconds on a 1.6GHz machine*}
-apply spy_analz
-apply (blast dest!: Gets_imp_knows_Spy [THEN analz.Inj])
-apply (blast dest: Says_imp_knows_Spy [THEN analz.Inj] 
-                   Gets_imp_knows_Spy [THEN analz.Inj])
-apply (blast dest: Gets_imp_knows_Spy [THEN analz.Inj]) --{*PReqS*}
-apply (blast dest: Says_imp_knows_Spy [THEN analz.Inj] 
-                   Gets_imp_knows_Spy [THEN analz.Inj]) --{*PRes*}
-done
-
-text{*This theorem is a bit silly, in that many CardSecrets are 0!
-  But then we don't care.  NOT USED*}
-lemma CardSecret_notin_spies:
-     "evs \<in> set_pur ==> Nonce (CardSecret i) \<notin> parts (knows Spy evs)"
-by (erule set_pur.induct, auto)
-
-
-subsection{*Confidentiality of PAN*}
-
-lemma analz_image_pan_lemma:
-     "(Pan P \<in> analz (Key`nE Un H)) --> (Pan P \<in> analz H)  ==>
-      (Pan P \<in> analz (Key`nE Un H)) =   (Pan P \<in> analz H)"
-by (blast intro: analz_mono [THEN [2] rev_subsetD])
-
-text{*The @{text "(no_asm)"} attribute is essential, since it retains
-  the quantifier and allows the simprule's condition to itself be simplified.*}
-lemma analz_image_pan [rule_format (no_asm)]:
-     "evs \<in> set_pur ==>
-       \<forall>KK. (\<forall>K \<in> KK. K \<notin> range(\<lambda>C. priEK C)) -->
-            (Pan P \<in> analz (Key`KK Un (knows Spy evs))) =
-            (Pan P \<in> analz (knows Spy evs))"
-apply (erule set_pur.induct)
-apply (rule_tac [!] allI impI)+
-apply (rule_tac [!] analz_image_pan_lemma)+
-apply (frule_tac [9] AuthReq_msg_in_analz_spies) --{*AReq*}
-apply (valid_certificate_tac [8]) --{*PReqS*}
-apply (valid_certificate_tac [7]) --{*PReqUns*}
-apply (simp_all
-         del: image_insert image_Un imp_disjL
-         add: analz_image_keys_simps
-              symKey_compromise pushes sign_def
-              analz_Key_image_insert_eq notin_image_iff
-              analz_insert_simps analz_image_priEK)
-  --{*7 seconds on a 1.6GHz machine*}
-apply spy_analz --{*Fake*}
-apply auto
-done
-
-lemma analz_insert_pan:
-     "[| evs \<in> set_pur;  K \<notin> range(\<lambda>C. priEK C) |] ==>
-          (Pan P \<in> analz (insert (Key K) (knows Spy evs))) =
-          (Pan P \<in> analz (knows Spy evs))"
-by (simp del: image_insert image_Un
-         add: analz_image_keys_simps analz_image_pan)
-
-text{*Confidentiality of the PAN, unsigned case.*}
-theorem pan_confidentiality_unsigned:
-     "[| Pan (pan C) \<in> analz(knows Spy evs);  C = Cardholder k;
-         CardSecret k = 0;  evs \<in> set_pur|]
-    ==> \<exists>P M KC1 K X Y.
-     Says C M {|EXHcrypt KC1 (pubEK P) X (Pan (pan C)), Y|}
-          \<in> set evs  &
-     P \<in> bad"
-apply (erule rev_mp)
-apply (erule set_pur.induct)
-apply (frule_tac [9] AuthReq_msg_in_analz_spies) --{*AReq*}
-apply (valid_certificate_tac [8]) --{*PReqS*}
-apply (valid_certificate_tac [7]) --{*PReqUns*}
-apply (simp_all
-         del: image_insert image_Un imp_disjL
-         add: analz_image_keys_simps analz_insert_pan analz_image_pan
-              notin_image_iff
-              analz_insert_simps analz_image_priEK)
-  --{*3 seconds on a 1.6GHz machine*}
-apply spy_analz --{*Fake*}
-apply blast --{*PReqUns: unsigned*}
-apply force --{*PReqS: signed*}
-done
-
-text{*Confidentiality of the PAN, signed case.*}
-theorem pan_confidentiality_signed:
- "[|Pan (pan C) \<in> analz(knows Spy evs);  C = Cardholder k;
-    CardSecret k \<noteq> 0;  evs \<in> set_pur|]
-  ==> \<exists>P M KC2 PIDualSign_1 PIDualSign_2 other OIDualSign.
-      Says C M {|{|PIDualSign_1, 
-                   EXcrypt KC2 (pubEK P) PIDualSign_2 {|Pan (pan C), other|}|}, 
-       OIDualSign|} \<in> set evs  &  P \<in> bad"
-apply (erule rev_mp)
-apply (erule set_pur.induct)
-apply (frule_tac [9] AuthReq_msg_in_analz_spies) --{*AReq*}
-apply (valid_certificate_tac [8]) --{*PReqS*}
-apply (valid_certificate_tac [7]) --{*PReqUns*}
-apply (simp_all
-         del: image_insert image_Un imp_disjL
-         add: analz_image_keys_simps analz_insert_pan analz_image_pan
-              notin_image_iff
-              analz_insert_simps analz_image_priEK)
-  --{*3 seconds on a 1.6GHz machine*}
-apply spy_analz --{*Fake*}
-apply force --{*PReqUns: unsigned*}
-apply blast --{*PReqS: signed*}
-done
-
-text{*General goal: that C, M and PG agree on those details of the transaction
-     that they are allowed to know about.  PG knows about price and account
-     details.  M knows about the order description and price.  C knows both.*}
-
-
-subsection{*Proofs Common to Signed and Unsigned Versions*}
-
-lemma M_Notes_PG:
-     "[|Notes M {|Number LID_M, Agent P, Agent M, Agent C, etc|} \<in> set evs;
-        evs \<in> set_pur|] ==> \<exists>j. P = PG j"
-by (erule rev_mp, erule set_pur.induct, simp_all)
-
-text{*If we trust M, then @{term LID_M} determines his choice of P
-      (Payment Gateway)*}
-lemma goodM_gives_correct_PG:
-     "[| MsgPInitRes = 
-            {|Number LID_M, xid, cc, cm, cert P EKj onlyEnc (priSK RCA)|};
-         Crypt (priSK M) (Hash MsgPInitRes) \<in> parts (knows Spy evs);
-         evs \<in> set_pur; M \<notin> bad |]
-      ==> \<exists>j trans.
-            P = PG j &
-            Notes M {|Number LID_M, Agent P, trans|} \<in> set evs"
-apply clarify
-apply (erule rev_mp)
-apply (erule set_pur.induct)
-apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
-apply simp_all
-apply (blast intro: M_Notes_PG)+
-done
-
-lemma C_gets_correct_PG:
-     "[| Gets A (sign (priSK M) {|Number LID_M, xid, cc, cm,
-                              cert P EKj onlyEnc (priSK RCA)|}) \<in> set evs;
-         evs \<in> set_pur;  M \<notin> bad|]
-      ==> \<exists>j trans.
-            P = PG j &
-            Notes M {|Number LID_M, Agent P, trans|} \<in> set evs &
-            EKj = pubEK P"
-by (rule refl [THEN goodM_gives_correct_PG, THEN exE], auto)
-
-text{*When C receives PInitRes, he learns M's choice of P*}
-lemma C_verifies_PInitRes:
- "[| MsgPInitRes = {|Number LID_M, Number XID, Nonce Chall_C, Nonce Chall_M,
-           cert P EKj onlyEnc (priSK RCA)|};
-     Crypt (priSK M) (Hash MsgPInitRes) \<in> parts (knows Spy evs);
-     evs \<in> set_pur;  M \<notin> bad|]
-  ==> \<exists>j trans.
-         Notes M {|Number LID_M, Agent P, trans|} \<in> set evs &
-         P = PG j &
-         EKj = pubEK P"
-apply clarify
-apply (erule rev_mp)
-apply (erule set_pur.induct)
-apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
-apply simp_all
-apply (blast intro: M_Notes_PG)+
-done
-
-text{*Corollary of previous one*}
-lemma Says_C_PInitRes:
-     "[|Says A C (sign (priSK M)
-                      {|Number LID_M, Number XID,
-                        Nonce Chall_C, Nonce Chall_M,
-                        cert P EKj onlyEnc (priSK RCA)|})
-           \<in> set evs;  M \<notin> bad;  evs \<in> set_pur|]
-      ==> \<exists>j trans.
-           Notes M {|Number LID_M, Agent P, trans|} \<in> set evs &
-           P = PG j &
-           EKj = pubEK (PG j)"
-apply (frule Says_certificate_valid)
-apply (auto simp add: sign_def)
-apply (blast dest: refl [THEN goodM_gives_correct_PG])
-apply (blast dest: refl [THEN C_verifies_PInitRes])
-done
-
-text{*When P receives an AuthReq, he knows that the signed part originated 
-      with M. PIRes also has a signed message from M....*}
-lemma P_verifies_AuthReq:
-     "[| AuthReqData = {|Number LID_M, Number XID, HOIData, HOD|};
-         Crypt (priSK M) (Hash {|AuthReqData, Hash P_I|})
-           \<in> parts (knows Spy evs);
-         evs \<in> set_pur;  M \<notin> bad|]
-      ==> \<exists>j trans KM OIData HPIData.
-            Notes M {|Number LID_M, Agent (PG j), trans|} \<in> set evs &
-            Gets M {|P_I, OIData, HPIData|} \<in> set evs &
-            Says M (PG j) (EncB (priSK M) KM (pubEK (PG j)) AuthReqData P_I)
-              \<in> set evs"
-apply clarify
-apply (erule rev_mp)
-apply (erule set_pur.induct, simp_all)
-apply (frule_tac [4] M_Notes_PG, auto)
-done
-
-text{*When M receives AuthRes, he knows that P signed it, including
-  the identifying tags and the purchase amount, which he can verify.
-  (Although the spec has SIGNED and UNSIGNED forms of AuthRes, they
-   send the same message to M.)  The conclusion is weak: M is existentially
-  quantified! That is because Authorization Response does not refer to M, while
-  the digital envelope weakens the link between @{term MsgAuthRes} and
-  @{term"priSK M"}.  Changing the precondition to refer to 
-  @{term "Crypt K (sign SK M)"} requires assuming @{term K} to be secure, since
-  otherwise the Spy could create that message.*}
-theorem M_verifies_AuthRes:
-  "[| MsgAuthRes = {|{|Number LID_M, Number XID, Number PurchAmt|}, 
-                     Hash authCode|};
-      Crypt (priSK (PG j)) (Hash MsgAuthRes) \<in> parts (knows Spy evs);
-      PG j \<notin> bad;  evs \<in> set_pur|]
-   ==> \<exists>M KM KP HOIData HOD P_I.
-        Gets (PG j)
-           (EncB (priSK M) KM (pubEK (PG j))
-                    {|Number LID_M, Number XID, HOIData, HOD|}
-                    P_I) \<in> set evs &
-        Says (PG j) M
-             (EncB (priSK (PG j)) KP (pubEK M)
-              {|Number LID_M, Number XID, Number PurchAmt|}
-              authCode) \<in> set evs"
-apply clarify
-apply (erule rev_mp)
-apply (erule set_pur.induct)
-apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
-apply simp_all
-apply blast+
-done
-
-
-subsection{*Proofs for Unsigned Purchases*}
-
-text{*What we can derive from the ASSUMPTION that C issued a purchase request.
-   In the unsigned case, we must trust "C": there's no authentication.*}
-lemma C_determines_EKj:
-     "[| Says C M {|EXHcrypt KC1 EKj {|PIHead, Hash OIData|} (Pan (pan C)),
-                    OIData, Hash{|PIHead, Pan (pan C)|} |} \<in> set evs;
-         PIHead = {|Number LID_M, Trans_details|};
-         evs \<in> set_pur;  C = Cardholder k;  M \<notin> bad|]
-  ==> \<exists>trans j.
-               Notes M {|Number LID_M, Agent (PG j), trans |} \<in> set evs &
-               EKj = pubEK (PG j)"
-apply clarify
-apply (erule rev_mp)
-apply (erule set_pur.induct, simp_all)
-apply (valid_certificate_tac [2]) --{*PReqUns*}
-apply auto
-apply (blast dest: Gets_imp_Says Says_C_PInitRes)
-done
-
-
-text{*Unicity of @{term LID_M} between Merchant and Cardholder notes*}
-lemma unique_LID_M:
-     "[|Notes (Merchant i) {|Number LID_M, Agent P, Trans|} \<in> set evs;
-        Notes C {|Number LID_M, Agent M, Agent C, Number OD,
-             Number PA|} \<in> set evs;
-        evs \<in> set_pur|]
-      ==> M = Merchant i & Trans = {|Agent M, Agent C, Number OD, Number PA|}"
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule set_pur.induct, simp_all)
-apply (force dest!: Notes_imp_parts_subset_used)
-done
-
-text{*Unicity of @{term LID_M}, for two Merchant Notes events*}
-lemma unique_LID_M2:
-     "[|Notes M {|Number LID_M, Trans|} \<in> set evs;
-        Notes M {|Number LID_M, Trans'|} \<in> set evs;
-        evs \<in> set_pur|] ==> Trans' = Trans"
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule set_pur.induct, simp_all)
-apply (force dest!: Notes_imp_parts_subset_used)
-done
-
-text{*Lemma needed below: for the case that
-  if PRes is present, then @{term LID_M} has been used.*}
-lemma signed_imp_used:
-     "[| Crypt (priSK M) (Hash X) \<in> parts (knows Spy evs);
-         M \<notin> bad;  evs \<in> set_pur|] ==> parts {X} \<subseteq> used evs"
-apply (erule rev_mp)
-apply (erule set_pur.induct)
-apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
-apply simp_all
-apply safe
-apply blast+
-done
-
-text{*Similar, with nested Hash*}
-lemma signed_Hash_imp_used:
-     "[| Crypt (priSK C) (Hash {|H, Hash X|}) \<in> parts (knows Spy evs);
-         C \<notin> bad;  evs \<in> set_pur|] ==> parts {X} \<subseteq> used evs"
-apply (erule rev_mp)
-apply (erule set_pur.induct)
-apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
-apply simp_all
-apply safe
-apply blast+
-done
-
-text{*Lemma needed below: for the case that
-  if PRes is present, then @{text LID_M} has been used.*}
-lemma PRes_imp_LID_used:
-     "[| Crypt (priSK M) (Hash {|N, X|}) \<in> parts (knows Spy evs);
-         M \<notin> bad;  evs \<in> set_pur|] ==> N \<in> used evs"
-by (drule signed_imp_used, auto)
-
-text{*When C receives PRes, he knows that M and P agreed to the purchase details.
-  He also knows that P is the same PG as before*}
-lemma C_verifies_PRes_lemma:
-     "[| Crypt (priSK M) (Hash MsgPRes) \<in> parts (knows Spy evs);
-         Notes C {|Number LID_M, Trans |} \<in> set evs;
-         Trans = {| Agent M, Agent C, Number OrderDesc, Number PurchAmt |};
-         MsgPRes = {|Number LID_M, Number XID, Nonce Chall_C,
-                Hash (Number PurchAmt)|};
-         evs \<in> set_pur;  M \<notin> bad|]
-  ==> \<exists>j KP.
-        Notes M {|Number LID_M, Agent (PG j), Trans |}
-          \<in> set evs &
-        Gets M (EncB (priSK (PG j)) KP (pubEK M)
-                {|Number LID_M, Number XID, Number PurchAmt|}
-                authCode)
-          \<in> set evs &
-        Says M C (sign (priSK M) MsgPRes) \<in> set evs"
-apply clarify
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule set_pur.induct)
-apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
-apply simp_all
-apply blast
-apply blast
-apply (blast dest: PRes_imp_LID_used)
-apply (frule M_Notes_PG, auto)
-apply (blast dest: unique_LID_M)
-done
-
-text{*When the Cardholder receives Purchase Response from an uncompromised
-Merchant, he knows that M sent it. He also knows that M received a message signed
-by a Payment Gateway chosen by M to authorize the purchase.*}
-theorem C_verifies_PRes:
-     "[| MsgPRes = {|Number LID_M, Number XID, Nonce Chall_C,
-                     Hash (Number PurchAmt)|};
-         Gets C (sign (priSK M) MsgPRes) \<in> set evs;
-         Notes C {|Number LID_M, Agent M, Agent C, Number OrderDesc,
-                   Number PurchAmt|} \<in> set evs;
-         evs \<in> set_pur;  M \<notin> bad|]
-  ==> \<exists>P KP trans.
-        Notes M {|Number LID_M,Agent P, trans|} \<in> set evs &
-        Gets M (EncB (priSK P) KP (pubEK M)
-                {|Number LID_M, Number XID, Number PurchAmt|}
-                authCode)  \<in>  set evs &
-        Says M C (sign (priSK M) MsgPRes) \<in> set evs"
-apply (rule C_verifies_PRes_lemma [THEN exE])
-apply (auto simp add: sign_def)
-done
-
-subsection{*Proofs for Signed Purchases*}
-
-text{*Some Useful Lemmas: the cardholder knows what he is doing*}
-
-lemma Crypt_imp_Says_Cardholder:
-     "[| Crypt K {|{|{|Number LID_M, others|}, Hash OIData|}, Hash PANData|}
-           \<in> parts (knows Spy evs);
-         PANData = {|Pan (pan (Cardholder k)), Nonce (PANSecret k)|};
-         Key K \<notin> analz (knows Spy evs);
-         evs \<in> set_pur|]
-  ==> \<exists>M shash EK HPIData.
-       Says (Cardholder k) M {|{|shash,
-          Crypt K
-            {|{|{|Number LID_M, others|}, Hash OIData|}, Hash PANData|},
-           Crypt EK {|Key K, PANData|}|},
-          OIData, HPIData|} \<in> set evs"
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule set_pur.induct, analz_mono_contra)
-apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
-apply simp_all
-apply auto
-done
-
-lemma Says_PReqS_imp_trans_details_C:
-     "[| MsgPReqS = {|{|shash,
-                 Crypt K
-                  {|{|{|Number LID_M, PIrest|}, Hash OIData|}, hashpd|},
-            cryptek|}, data|};
-         Says (Cardholder k) M MsgPReqS \<in> set evs;
-         evs \<in> set_pur |]
-   ==> \<exists>trans.
-           Notes (Cardholder k) 
-                 {|Number LID_M, Agent M, Agent (Cardholder k), trans|}
-            \<in> set evs"
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule set_pur.induct)
-apply (simp_all (no_asm_simp))
-apply auto
-done
-
-text{*Can't happen: only Merchants create this type of Note*}
-lemma Notes_Cardholder_self_False:
-     "[|Notes (Cardholder k)
-          {|Number n, Agent P, Agent (Cardholder k), Agent C, etc|} \<in> set evs;
-        evs \<in> set_pur|] ==> False"
-by (erule rev_mp, erule set_pur.induct, auto)
-
-text{*When M sees a dual signature, he knows that it originated with C.
-  Using XID he knows it was intended for him.
-  This guarantee isn't useful to P, who never gets OIData.*}
-theorem M_verifies_Signed_PReq:
- "[| MsgDualSign = {|HPIData, Hash OIData|};
-     OIData = {|Number LID_M, etc|};
-     Crypt (priSK C) (Hash MsgDualSign) \<in> parts (knows Spy evs);
-     Notes M {|Number LID_M, Agent P, extras|} \<in> set evs;
-     M = Merchant i;  C = Cardholder k;  C \<notin> bad;  evs \<in> set_pur|]
-  ==> \<exists>PIData PICrypt.
-        HPIData = Hash PIData &
-        Says C M {|{|sign (priSK C) MsgDualSign, PICrypt|}, OIData, Hash PIData|}
-          \<in> set evs"
-apply clarify
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule set_pur.induct)
-apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
-apply simp_all
-apply blast
-apply (metis subsetD insert_subset parts.Fst parts_increasing signed_Hash_imp_used)
-apply (metis unique_LID_M)
-apply (blast dest!: Notes_Cardholder_self_False)
-done
-
-text{*When P sees a dual signature, he knows that it originated with C.
-  and was intended for M. This guarantee isn't useful to M, who never gets
-  PIData. I don't see how to link @{term "PG j"} and @{text LID_M} without
-  assuming @{term "M \<notin> bad"}.*}
-theorem P_verifies_Signed_PReq:
-     "[| MsgDualSign = {|Hash PIData, HOIData|};
-         PIData = {|PIHead, PANData|};
-         PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M,
-                    TransStain|};
-         Crypt (priSK C) (Hash MsgDualSign) \<in> parts (knows Spy evs);
-         evs \<in> set_pur;  C \<notin> bad;  M \<notin> bad|]
-    ==> \<exists>OIData OrderDesc K j trans.
-          HOD = Hash{|Number OrderDesc, Number PurchAmt|} &
-          HOIData = Hash OIData &
-          Notes M {|Number LID_M, Agent (PG j), trans|} \<in> set evs &
-          Says C M {|{|sign (priSK C) MsgDualSign,
-                     EXcrypt K (pubEK (PG j))
-                                {|PIHead, Hash OIData|} PANData|},
-                     OIData, Hash PIData|}
-            \<in> set evs"
-apply clarify
-apply (erule rev_mp)
-apply (erule set_pur.induct, simp_all)
-apply (auto dest!: C_gets_correct_PG)
-done
-
-lemma C_determines_EKj_signed:
-     "[| Says C M {|{|sign (priSK C) text,
-                      EXcrypt K EKj {|PIHead, X|} Y|}, Z|} \<in> set evs;
-         PIHead = {|Number LID_M, Number XID, W|};
-         C = Cardholder k;  evs \<in> set_pur;  M \<notin> bad|]
-  ==> \<exists> trans j.
-         Notes M {|Number LID_M, Agent (PG j), trans|} \<in> set evs &
-         EKj = pubEK (PG j)"
-apply clarify
-apply (erule rev_mp)
-apply (erule set_pur.induct, simp_all, auto)
-apply (blast dest: C_gets_correct_PG)
-done
-
-lemma M_Says_AuthReq:
-     "[| AuthReqData = {|Number LID_M, Number XID, HOIData, HOD|};
-         sign (priSK M) {|AuthReqData, Hash P_I|} \<in> parts (knows Spy evs);
-         evs \<in> set_pur;  M \<notin> bad|]
-   ==> \<exists>j trans KM.
-           Notes M {|Number LID_M, Agent (PG j), trans |} \<in> set evs &
-             Says M (PG j)
-               (EncB (priSK M) KM (pubEK (PG j)) AuthReqData P_I)
-              \<in> set evs"
-apply (rule refl [THEN P_verifies_AuthReq, THEN exE])
-apply (auto simp add: sign_def)
-done
-
-text{*A variant of @{text M_verifies_Signed_PReq} with explicit PI information.
-  Even here we cannot be certain about what C sent to M, since a bad
-  PG could have replaced the two key fields.  (NOT USED)*}
-lemma Signed_PReq_imp_Says_Cardholder:
-     "[| MsgDualSign = {|Hash PIData, Hash OIData|};
-         OIData = {|Number LID_M, Number XID, Nonce Chall_C, HOD, etc|};
-         PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M,
-                    TransStain|};
-         PIData = {|PIHead, PANData|};
-         Crypt (priSK C) (Hash MsgDualSign) \<in> parts (knows Spy evs);
-         M = Merchant i;  C = Cardholder k;  C \<notin> bad;  evs \<in> set_pur|]
-      ==> \<exists>KC EKj.
-            Says C M {|{|sign (priSK C) MsgDualSign,
-                       EXcrypt KC EKj {|PIHead, Hash OIData|} PANData|},
-                       OIData, Hash PIData|}
-              \<in> set evs"
-apply clarify
-apply (erule rev_mp)
-apply (erule rev_mp)
-apply (erule set_pur.induct, simp_all, auto)
-done
-
-text{*When P receives an AuthReq and a dual signature, he knows that C and M
-  agree on the essential details.  PurchAmt however is never sent by M to
-  P; instead C and M both send 
-     @{term "HOD = Hash{|Number OrderDesc, Number PurchAmt|}"}
-  and P compares the two copies of HOD.
-
-  Agreement can't be proved for some things, including the symmetric keys
-  used in the digital envelopes.  On the other hand, M knows the true identity
-  of PG (namely j'), and sends AReq there; he can't, however, check that
-  the EXcrypt involves the correct PG's key.
-*}
-theorem P_sees_CM_agreement:
-     "[| AuthReqData = {|Number LID_M, Number XID, HOIData, HOD|};
-         KC \<in> symKeys;
-         Gets (PG j) (EncB (priSK M) KM (pubEK (PG j)) AuthReqData P_I)
-           \<in> set evs;
-         C = Cardholder k;
-         PI_sign = sign (priSK C) {|Hash PIData, HOIData|};
-         P_I = {|PI_sign,
-                 EXcrypt KC (pubEK (PG j)) {|PIHead, HOIData|} PANData|};
-         PANData = {|Pan (pan C), Nonce (PANSecret k)|};
-         PIData = {|PIHead, PANData|};
-         PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M,
-                    TransStain|};
-         evs \<in> set_pur;  C \<notin> bad;  M \<notin> bad|]
-  ==> \<exists>OIData OrderDesc KM' trans j' KC' KC'' P_I' P_I''.
-           HOD = Hash{|Number OrderDesc, Number PurchAmt|} &
-           HOIData = Hash OIData &
-           Notes M {|Number LID_M, Agent (PG j'), trans|} \<in> set evs &
-           Says C M {|P_I', OIData, Hash PIData|} \<in> set evs &
-           Says M (PG j') (EncB (priSK M) KM' (pubEK (PG j'))
-                           AuthReqData P_I'')  \<in>  set evs &
-           P_I' = {|PI_sign,
-             EXcrypt KC' (pubEK (PG j')) {|PIHead, Hash OIData|} PANData|} &
-           P_I'' = {|PI_sign,
-             EXcrypt KC'' (pubEK (PG j)) {|PIHead, Hash OIData|} PANData|}"
-apply clarify
-apply (rule exE)
-apply (rule P_verifies_Signed_PReq [OF refl refl refl])
-apply (simp (no_asm_use) add: sign_def EncB_def, blast)
-apply (assumption+, clarify, simp)
-apply (drule Gets_imp_knows_Spy [THEN parts.Inj], assumption)
-apply (blast elim: EncB_partsE dest: refl [THEN M_Says_AuthReq] unique_LID_M2)
-done
-
-end
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/SET-Protocol/ROOT.ML
--- a/src/HOL/SET-Protocol/ROOT.ML	Tue Oct 20 19:52:04 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,10 +0,0 @@
-(*  Title:      HOL/SET-Protocol/ROOT.ML
-    ID:         $Id$
-    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
-    Copyright   2003  University of Cambridge
-
-Root file for the SET protocol proofs.
-*)
-
-no_document use_thy "Nat_Int_Bij";
-use_thys ["Cardholder_Registration", "Merchant_Registration", "Purchase"];
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/SET-Protocol/document/root.tex
--- a/src/HOL/SET-Protocol/document/root.tex	Tue Oct 20 19:52:04 2009 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,27 +0,0 @@
-\documentclass[10pt,a4paper,twoside]{article}
-\usepackage{graphicx}
-\usepackage{latexsym,theorem}
-\usepackage{isabelle,isabellesym}
-\usepackage{pdfsetup}\urlstyle{rm}
-
-\begin{document}
-
-\pagestyle{headings}
-\pagenumbering{arabic}
-
-\title{Verification of The SET Protocol}
-\author{Giampaolo Bella, Fabio Massacci, Lawrence C. Paulson et al.}
-\maketitle
-
-\tableofcontents
-
-\begin{center}
-  \includegraphics[scale=0.5]{session_graph}  
-\end{center}
-
-\newpage
-
-\parindent 0pt\parskip 0.5ex
-
-\input{session}
-\end{document}
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/SET_Protocol/Cardholder_Registration.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/SET_Protocol/Cardholder_Registration.thy	Tue Oct 20 20:03:23 2009 +0200
@@ -0,0 +1,1056 @@
+(*  Title:      HOL/SET_Protocol/Cardholder_Registration.thy
+    Author:     Giampaolo Bella
+    Author:     Fabio Massacci
+    Author:     Lawrence C Paulson
+    Author:     Piero Tramontano
+*)
+
+header{*The SET Cardholder Registration Protocol*}
+
+theory Cardholder_Registration
+imports Public_SET
+begin
+
+text{*Note: nonces seem to consist of 20 bytes.  That includes both freshness
+challenges (Chall-EE, etc.) and important secrets (CardSecret, PANsecret)
+*}
+
+text{*Simplifications involving @{text analz_image_keys_simps} appear to
+have become much slower. The cause is unclear. However, there is a big blow-up
+and the rewriting is very sensitive to the set of rewrite rules given.*}
+
+subsection{*Predicate Formalizing the Encryption Association between Keys *}
+
+consts
+  KeyCryptKey :: "[key, key, event list] => bool"
+
+primrec
+
+KeyCryptKey_Nil:
+  "KeyCryptKey DK K [] = False"
+
+KeyCryptKey_Cons:
+      --{*Says is the only important case.
+        1st case: CR5, where KC3 encrypts KC2.
+        2nd case: any use of priEK C.
+        Revision 1.12 has a more complicated version with separate treatment of
+          the dependency of KC1, KC2 and KC3 on priEK (CA i.)  Not needed since
+          priEK C is never sent (and so can't be lost except at the start). *}
+  "KeyCryptKey DK K (ev # evs) =
+   (KeyCryptKey DK K evs |
+    (case ev of
+      Says A B Z =>
+       ((\<exists>N X Y. A \<noteq> Spy &
+                 DK \<in> symKeys &
+                 Z = {|Crypt DK {|Agent A, Nonce N, Key K, X|}, Y|}) |
+        (\<exists>C. DK = priEK C))
+    | Gets A' X => False
+    | Notes A' X => False))"
+
+
+subsection{*Predicate formalizing the association between keys and nonces *}
+
+consts
+  KeyCryptNonce :: "[key, key, event list] => bool"
+
+primrec
+
+KeyCryptNonce_Nil:
+  "KeyCryptNonce EK K [] = False"
+
+KeyCryptNonce_Cons:
+  --{*Says is the only important case.
+    1st case: CR3, where KC1 encrypts NC2 (distinct from CR5 due to EXH);
+    2nd case: CR5, where KC3 encrypts NC3;
+    3rd case: CR6, where KC2 encrypts NC3;
+    4th case: CR6, where KC2 encrypts NonceCCA;
+    5th case: any use of @{term "priEK C"} (including CardSecret).
+    NB the only Nonces we need to keep secret are CardSecret and NonceCCA.
+    But we can't prove @{text Nonce_compromise} unless the relation covers ALL
+        nonces that the protocol keeps secret.
+  *}
+  "KeyCryptNonce DK N (ev # evs) =
+   (KeyCryptNonce DK N evs |
+    (case ev of
+      Says A B Z =>
+       A \<noteq> Spy &
+       ((\<exists>X Y. DK \<in> symKeys &
+               Z = (EXHcrypt DK X {|Agent A, Nonce N|} Y)) |
+        (\<exists>X Y. DK \<in> symKeys &
+               Z = {|Crypt DK {|Agent A, Nonce N, X|}, Y|}) |
+        (\<exists>K i X Y.
+          K \<in> symKeys &
+          Z = Crypt K {|sign (priSK (CA i)) {|Agent B, Nonce N, X|}, Y|} &
+          (DK=K | KeyCryptKey DK K evs)) |
+        (\<exists>K C NC3 Y.
+          K \<in> symKeys &
+          Z = Crypt K
+                {|sign (priSK C) {|Agent B, Nonce NC3, Agent C, Nonce N|},
+                  Y|} &
+          (DK=K | KeyCryptKey DK K evs)) |
+        (\<exists>C. DK = priEK C))
+    | Gets A' X => False
+    | Notes A' X => False))"
+
+
+subsection{*Formal protocol definition *}
+
+inductive_set
+  set_cr :: "event list set"
+where
+
+  Nil:    --{*Initial trace is empty*}
+          "[] \<in> set_cr"
+
+| Fake:    --{*The spy MAY say anything he CAN say.*}
+           "[| evsf \<in> set_cr; X \<in> synth (analz (knows Spy evsf)) |]
+            ==> Says Spy B X  # evsf \<in> set_cr"
+
+| Reception: --{*If A sends a message X to B, then B might receive it*}
+             "[| evsr \<in> set_cr; Says A B X \<in> set evsr |]
+              ==> Gets B X  # evsr \<in> set_cr"
+
+| SET_CR1: --{*CardCInitReq: C initiates a run, sending a nonce to CCA*}
+             "[| evs1 \<in> set_cr;  C = Cardholder k;  Nonce NC1 \<notin> used evs1 |]
+              ==> Says C (CA i) {|Agent C, Nonce NC1|} # evs1 \<in> set_cr"
+
+| SET_CR2: --{*CardCInitRes: CA responds sending NC1 and its certificates*}
+             "[| evs2 \<in> set_cr;
+                 Gets (CA i) {|Agent C, Nonce NC1|} \<in> set evs2 |]
+              ==> Says (CA i) C
+                       {|sign (priSK (CA i)) {|Agent C, Nonce NC1|},
+                         cert (CA i) (pubEK (CA i)) onlyEnc (priSK RCA),
+                         cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|}
+                    # evs2 \<in> set_cr"
+
+| SET_CR3:
+   --{*RegFormReq: C sends his PAN and a new nonce to CA.
+   C verifies that
+    - nonce received is the same as that sent;
+    - certificates are signed by RCA;
+    - certificates are an encryption certificate (flag is onlyEnc) and a
+      signature certificate (flag is onlySig);
+    - certificates pertain to the CA that C contacted (this is done by
+      checking the signature).
+   C generates a fresh symmetric key KC1.
+   The point of encrypting @{term "{|Agent C, Nonce NC2, Hash (Pan(pan C))|}"}
+   is not clear. *}
+"[| evs3 \<in> set_cr;  C = Cardholder k;
+    Nonce NC2 \<notin> used evs3;
+    Key KC1 \<notin> used evs3; KC1 \<in> symKeys;
+    Gets C {|sign (invKey SKi) {|Agent X, Nonce NC1|},
+             cert (CA i) EKi onlyEnc (priSK RCA),
+             cert (CA i) SKi onlySig (priSK RCA)|}
+       \<in> set evs3;
+    Says C (CA i) {|Agent C, Nonce NC1|} \<in> set evs3|]
+ ==> Says C (CA i) (EXHcrypt KC1 EKi {|Agent C, Nonce NC2|} (Pan(pan C)))
+       # Notes C {|Key KC1, Agent (CA i)|}
+       # evs3 \<in> set_cr"
+
+| SET_CR4:
+    --{*RegFormRes:
+    CA responds sending NC2 back with a new nonce NCA, after checking that
+     - the digital envelope is correctly encrypted by @{term "pubEK (CA i)"}
+     - the entire message is encrypted with the same key found inside the
+       envelope (here, KC1) *}
+"[| evs4 \<in> set_cr;
+    Nonce NCA \<notin> used evs4;  KC1 \<in> symKeys;
+    Gets (CA i) (EXHcrypt KC1 EKi {|Agent C, Nonce NC2|} (Pan(pan X)))
+       \<in> set evs4 |]
+  ==> Says (CA i) C
+          {|sign (priSK (CA i)) {|Agent C, Nonce NC2, Nonce NCA|},
+            cert (CA i) (pubEK (CA i)) onlyEnc (priSK RCA),
+            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|}
+       # evs4 \<in> set_cr"
+
+| SET_CR5:
+   --{*CertReq: C sends his PAN, a new nonce, its proposed public signature key
+       and its half of the secret value to CA.
+       We now assume that C has a fixed key pair, and he submits (pubSK C).
+       The protocol does not require this key to be fresh.
+       The encryption below is actually EncX.*}
+"[| evs5 \<in> set_cr;  C = Cardholder k;
+    Nonce NC3 \<notin> used evs5;  Nonce CardSecret \<notin> used evs5; NC3\<noteq>CardSecret;
+    Key KC2 \<notin> used evs5; KC2 \<in> symKeys;
+    Key KC3 \<notin> used evs5; KC3 \<in> symKeys; KC2\<noteq>KC3;
+    Gets C {|sign (invKey SKi) {|Agent C, Nonce NC2, Nonce NCA|},
+             cert (CA i) EKi onlyEnc (priSK RCA),
+             cert (CA i) SKi onlySig (priSK RCA) |}
+        \<in> set evs5;
+    Says C (CA i) (EXHcrypt KC1 EKi {|Agent C, Nonce NC2|} (Pan(pan C)))
+         \<in> set evs5 |]
+==> Says C (CA i)
+         {|Crypt KC3
+             {|Agent C, Nonce NC3, Key KC2, Key (pubSK C),
+               Crypt (priSK C)
+                 (Hash {|Agent C, Nonce NC3, Key KC2,
+                         Key (pubSK C), Pan (pan C), Nonce CardSecret|})|},
+           Crypt EKi {|Key KC3, Pan (pan C), Nonce CardSecret|} |}
+    # Notes C {|Key KC2, Agent (CA i)|}
+    # Notes C {|Key KC3, Agent (CA i)|}
+    # evs5 \<in> set_cr"
+
+
+  --{* CertRes: CA responds sending NC3 back with its half of the secret value,
+   its signature certificate and the new cardholder signature
+   certificate.  CA checks to have never certified the key proposed by C.
+   NOTE: In Merchant Registration, the corresponding rule (4)
+   uses the "sign" primitive. The encryption below is actually @{term EncK}, 
+   which is just @{term "Crypt K (sign SK X)"}.
+*}
+
+| SET_CR6:
+"[| evs6 \<in> set_cr;
+    Nonce NonceCCA \<notin> used evs6;
+    KC2 \<in> symKeys;  KC3 \<in> symKeys;  cardSK \<notin> symKeys;
+    Notes (CA i) (Key cardSK) \<notin> set evs6;
+    Gets (CA i)
+      {|Crypt KC3 {|Agent C, Nonce NC3, Key KC2, Key cardSK,
+                    Crypt (invKey cardSK)
+                      (Hash {|Agent C, Nonce NC3, Key KC2,
+                              Key cardSK, Pan (pan C), Nonce CardSecret|})|},
+        Crypt (pubEK (CA i)) {|Key KC3, Pan (pan C), Nonce CardSecret|} |}
+      \<in> set evs6 |]
+==> Says (CA i) C
+         (Crypt KC2
+          {|sign (priSK (CA i))
+                 {|Agent C, Nonce NC3, Agent(CA i), Nonce NonceCCA|},
+            certC (pan C) cardSK (XOR(CardSecret,NonceCCA)) onlySig (priSK (CA i)),
+            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})
+      # Notes (CA i) (Key cardSK)
+      # evs6 \<in> set_cr"
+
+
+declare Says_imp_knows_Spy [THEN parts.Inj, dest]
+declare parts.Body [dest]
+declare analz_into_parts [dest]
+declare Fake_parts_insert_in_Un [dest]
+
+text{*A "possibility property": there are traces that reach the end.
+      An unconstrained proof with many subgoals.*}
+
+lemma Says_to_Gets:
+     "Says A B X # evs \<in> set_cr ==> Gets B X # Says A B X # evs \<in> set_cr"
+by (rule set_cr.Reception, auto)
+
+text{*The many nonces and keys generated, some simultaneously, force us to
+  introduce them explicitly as shown below.*}
+lemma possibility_CR6:
+     "[|NC1 < (NC2::nat);  NC2 < NC3;  NC3 < NCA ;
+        NCA < NonceCCA;  NonceCCA < CardSecret;
+        KC1 < (KC2::key);  KC2 < KC3;
+        KC1 \<in> symKeys;  Key KC1 \<notin> used [];
+        KC2 \<in> symKeys;  Key KC2 \<notin> used [];
+        KC3 \<in> symKeys;  Key KC3 \<notin> used [];
+        C = Cardholder k|]
+   ==> \<exists>evs \<in> set_cr.
+       Says (CA i) C
+            (Crypt KC2
+             {|sign (priSK (CA i))
+                    {|Agent C, Nonce NC3, Agent(CA i), Nonce NonceCCA|},
+               certC (pan C) (pubSK (Cardholder k)) (XOR(CardSecret,NonceCCA))
+                     onlySig (priSK (CA i)),
+               cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})
+          \<in> set evs"
+apply (intro exI bexI)
+apply (rule_tac [2] 
+       set_cr.Nil 
+        [THEN set_cr.SET_CR1 [of concl: C i NC1], 
+         THEN Says_to_Gets, 
+         THEN set_cr.SET_CR2 [of concl: i C NC1], 
+         THEN Says_to_Gets,  
+         THEN set_cr.SET_CR3 [of concl: C i KC1 _ NC2], 
+         THEN Says_to_Gets,  
+         THEN set_cr.SET_CR4 [of concl: i C NC2 NCA], 
+         THEN Says_to_Gets,  
+         THEN set_cr.SET_CR5 [of concl: C i KC3 NC3 KC2 CardSecret],
+         THEN Says_to_Gets,  
+         THEN set_cr.SET_CR6 [of concl: i C KC2]])
+apply basic_possibility
+apply (simp_all (no_asm_simp) add: symKeys_neq_imp_neq)
+done
+
+text{*General facts about message reception*}
+lemma Gets_imp_Says:
+     "[| Gets B X \<in> set evs; evs \<in> set_cr |] ==> \<exists>A. Says A B X \<in> set evs"
+apply (erule rev_mp)
+apply (erule set_cr.induct, auto)
+done
+
+lemma Gets_imp_knows_Spy:
+     "[| Gets B X \<in> set evs; evs \<in> set_cr |]  ==> X \<in> knows Spy evs"
+by (blast dest!: Gets_imp_Says Says_imp_knows_Spy)
+declare Gets_imp_knows_Spy [THEN parts.Inj, dest]
+
+
+subsection{*Proofs on keys *}
+
+text{*Spy never sees an agent's private keys! (unless it's bad at start)*}
+
+lemma Spy_see_private_Key [simp]:
+     "evs \<in> set_cr
+      ==> (Key(invKey (publicKey b A)) \<in> parts(knows Spy evs)) = (A \<in> bad)"
+by (erule set_cr.induct, auto)
+
+lemma Spy_analz_private_Key [simp]:
+     "evs \<in> set_cr ==>
+     (Key(invKey (publicKey b A)) \<in> analz(knows Spy evs)) = (A \<in> bad)"
+by auto
+
+declare Spy_see_private_Key [THEN [2] rev_iffD1, dest!]
+declare Spy_analz_private_Key [THEN [2] rev_iffD1, dest!]
+
+
+subsection{*Begin Piero's Theorems on Certificates*}
+text{*Trivial in the current model, where certificates by RCA are secure *}
+
+lemma Crypt_valid_pubEK:
+     "[| Crypt (priSK RCA) {|Agent C, Key EKi, onlyEnc|}
+           \<in> parts (knows Spy evs);
+         evs \<in> set_cr |] ==> EKi = pubEK C"
+apply (erule rev_mp)
+apply (erule set_cr.induct, auto)
+done
+
+lemma certificate_valid_pubEK:
+    "[| cert C EKi onlyEnc (priSK RCA) \<in> parts (knows Spy evs);
+        evs \<in> set_cr |]
+     ==> EKi = pubEK C"
+apply (unfold cert_def signCert_def)
+apply (blast dest!: Crypt_valid_pubEK)
+done
+
+lemma Crypt_valid_pubSK:
+     "[| Crypt (priSK RCA) {|Agent C, Key SKi, onlySig|}
+           \<in> parts (knows Spy evs);
+         evs \<in> set_cr |] ==> SKi = pubSK C"
+apply (erule rev_mp)
+apply (erule set_cr.induct, auto)
+done
+
+lemma certificate_valid_pubSK:
+    "[| cert C SKi onlySig (priSK RCA) \<in> parts (knows Spy evs);
+        evs \<in> set_cr |] ==> SKi = pubSK C"
+apply (unfold cert_def signCert_def)
+apply (blast dest!: Crypt_valid_pubSK)
+done
+
+lemma Gets_certificate_valid:
+     "[| Gets A {| X, cert C EKi onlyEnc (priSK RCA),
+                      cert C SKi onlySig (priSK RCA)|} \<in> set evs;
+         evs \<in> set_cr |]
+      ==> EKi = pubEK C & SKi = pubSK C"
+by (blast dest: certificate_valid_pubEK certificate_valid_pubSK)
+
+text{*Nobody can have used non-existent keys!*}
+lemma new_keys_not_used:
+     "[|K \<in> symKeys; Key K \<notin> used evs; evs \<in> set_cr|]
+      ==> K \<notin> keysFor (parts (knows Spy evs))"
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule set_cr.induct)
+apply (frule_tac [8] Gets_certificate_valid)
+apply (frule_tac [6] Gets_certificate_valid, simp_all)
+apply (force dest!: usedI keysFor_parts_insert) --{*Fake*}
+apply (blast,auto)  --{*Others*}
+done
+
+
+subsection{*New versions: as above, but generalized to have the KK argument *}
+
+lemma gen_new_keys_not_used:
+     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_cr |]
+      ==> Key K \<notin> used evs --> K \<in> symKeys -->
+          K \<notin> keysFor (parts (Key`KK Un knows Spy evs))"
+by (auto simp add: new_keys_not_used)
+
+lemma gen_new_keys_not_analzd:
+     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_cr |]
+      ==> K \<notin> keysFor (analz (Key`KK Un knows Spy evs))"
+by (blast intro: keysFor_mono [THEN [2] rev_subsetD]
+          dest: gen_new_keys_not_used)
+
+lemma analz_Key_image_insert_eq:
+     "[|K \<in> symKeys; Key K \<notin> used evs; evs \<in> set_cr |]
+      ==> analz (Key ` (insert K KK) \<union> knows Spy evs) =
+          insert (Key K) (analz (Key ` KK \<union> knows Spy evs))"
+by (simp add: gen_new_keys_not_analzd)
+
+lemma Crypt_parts_imp_used:
+     "[|Crypt K X \<in> parts (knows Spy evs);
+        K \<in> symKeys; evs \<in> set_cr |] ==> Key K \<in> used evs"
+apply (rule ccontr)
+apply (force dest: new_keys_not_used Crypt_imp_invKey_keysFor)
+done
+
+lemma Crypt_analz_imp_used:
+     "[|Crypt K X \<in> analz (knows Spy evs);
+        K \<in> symKeys; evs \<in> set_cr |] ==> Key K \<in> used evs"
+by (blast intro: Crypt_parts_imp_used)
+
+
+(*<*) 
+subsection{*Messages signed by CA*}
+
+text{*Message @{text SET_CR2}: C can check CA's signature if he has received
+     CA's certificate.*}
+lemma CA_Says_2_lemma:
+     "[| Crypt (priSK (CA i)) (Hash{|Agent C, Nonce NC1|})
+           \<in> parts (knows Spy evs);
+         evs \<in> set_cr; (CA i) \<notin> bad |]
+     ==> \<exists>Y. Says (CA i) C {|sign (priSK (CA i)) {|Agent C, Nonce NC1|}, Y|}
+                 \<in> set evs"
+apply (erule rev_mp)
+apply (erule set_cr.induct, auto)
+done
+
+text{*Ever used?*}
+lemma CA_Says_2:
+     "[| Crypt (invKey SK) (Hash{|Agent C, Nonce NC1|})
+           \<in> parts (knows Spy evs);
+         cert (CA i) SK onlySig (priSK RCA) \<in> parts (knows Spy evs);
+         evs \<in> set_cr; (CA i) \<notin> bad |]
+      ==> \<exists>Y. Says (CA i) C {|sign (priSK (CA i)) {|Agent C, Nonce NC1|}, Y|}
+                  \<in> set evs"
+by (blast dest!: certificate_valid_pubSK intro!: CA_Says_2_lemma)
+
+
+text{*Message @{text SET_CR4}: C can check CA's signature if he has received
+      CA's certificate.*}
+lemma CA_Says_4_lemma:
+     "[| Crypt (priSK (CA i)) (Hash{|Agent C, Nonce NC2, Nonce NCA|})
+           \<in> parts (knows Spy evs);
+         evs \<in> set_cr; (CA i) \<notin> bad |]
+      ==> \<exists>Y. Says (CA i) C {|sign (priSK (CA i))
+                     {|Agent C, Nonce NC2, Nonce NCA|}, Y|} \<in> set evs"
+apply (erule rev_mp)
+apply (erule set_cr.induct, auto)
+done
+
+text{*NEVER USED*}
+lemma CA_Says_4:
+     "[| Crypt (invKey SK) (Hash{|Agent C, Nonce NC2, Nonce NCA|})
+           \<in> parts (knows Spy evs);
+         cert (CA i) SK onlySig (priSK RCA) \<in> parts (knows Spy evs);
+         evs \<in> set_cr; (CA i) \<notin> bad |]
+      ==> \<exists>Y. Says (CA i) C {|sign (priSK (CA i))
+                   {|Agent C, Nonce NC2, Nonce NCA|}, Y|} \<in> set evs"
+by (blast dest!: certificate_valid_pubSK intro!: CA_Says_4_lemma)
+
+
+text{*Message @{text SET_CR6}: C can check CA's signature if he has
+      received CA's certificate.*}
+lemma CA_Says_6_lemma:
+     "[| Crypt (priSK (CA i)) 
+               (Hash{|Agent C, Nonce NC3, Agent (CA i), Nonce NonceCCA|})
+           \<in> parts (knows Spy evs);
+         evs \<in> set_cr; (CA i) \<notin> bad |]
+      ==> \<exists>Y K. Says (CA i) C (Crypt K {|sign (priSK (CA i))
+      {|Agent C, Nonce NC3, Agent (CA i), Nonce NonceCCA|}, Y|}) \<in> set evs"
+apply (erule rev_mp)
+apply (erule set_cr.induct, auto)
+done
+
+text{*NEVER USED*}
+lemma CA_Says_6:
+     "[| Crypt (invKey SK) (Hash{|Agent C, Nonce NC3, Agent (CA i), Nonce NonceCCA|})
+           \<in> parts (knows Spy evs);
+         cert (CA i) SK onlySig (priSK RCA) \<in> parts (knows Spy evs);
+         evs \<in> set_cr; (CA i) \<notin> bad |]
+      ==> \<exists>Y K. Says (CA i) C (Crypt K {|sign (priSK (CA i))
+                    {|Agent C, Nonce NC3, Agent (CA i), Nonce NonceCCA|}, Y|}) \<in> set evs"
+by (blast dest!: certificate_valid_pubSK intro!: CA_Says_6_lemma)
+(*>*)
+
+
+subsection{*Useful lemmas *}
+
+text{*Rewriting rule for private encryption keys.  Analogous rewriting rules
+for other keys aren't needed.*}
+
+lemma parts_image_priEK:
+     "[|Key (priEK C) \<in> parts (Key`KK Un (knows Spy evs));
+        evs \<in> set_cr|] ==> priEK C \<in> KK | C \<in> bad"
+by auto
+
+text{*trivial proof because (priEK C) never appears even in (parts evs)*}
+lemma analz_image_priEK:
+     "evs \<in> set_cr ==>
+          (Key (priEK C) \<in> analz (Key`KK Un (knows Spy evs))) =
+          (priEK C \<in> KK | C \<in> bad)"
+by (blast dest!: parts_image_priEK intro: analz_mono [THEN [2] rev_subsetD])
+
+
+subsection{*Secrecy of Session Keys *}
+
+subsubsection{*Lemmas about the predicate KeyCryptKey *}
+
+text{*A fresh DK cannot be associated with any other
+  (with respect to a given trace). *}
+lemma DK_fresh_not_KeyCryptKey:
+     "[| Key DK \<notin> used evs; evs \<in> set_cr |] ==> ~ KeyCryptKey DK K evs"
+apply (erule rev_mp)
+apply (erule set_cr.induct)
+apply (simp_all (no_asm_simp))
+apply (blast dest: Crypt_analz_imp_used)+
+done
+
+text{*A fresh K cannot be associated with any other.  The assumption that
+  DK isn't a private encryption key may be an artifact of the particular
+  definition of KeyCryptKey.*}
+lemma K_fresh_not_KeyCryptKey:
+     "[|\<forall>C. DK \<noteq> priEK C; Key K \<notin> used evs|] ==> ~ KeyCryptKey DK K evs"
+apply (induct evs)
+apply (auto simp add: parts_insert2 split add: event.split)
+done
+
+
+text{*This holds because if (priEK (CA i)) appears in any traffic then it must
+  be known to the Spy, by @{term Spy_see_private_Key}*}
+lemma cardSK_neq_priEK:
+     "[|Key cardSK \<notin> analz (knows Spy evs);
+        Key cardSK : parts (knows Spy evs);
+        evs \<in> set_cr|] ==> cardSK \<noteq> priEK C"
+by blast
+
+lemma not_KeyCryptKey_cardSK [rule_format (no_asm)]:
+     "[|cardSK \<notin> symKeys;  \<forall>C. cardSK \<noteq> priEK C;  evs \<in> set_cr|] ==>
+      Key cardSK \<notin> analz (knows Spy evs) --> ~ KeyCryptKey cardSK K evs"
+by (erule set_cr.induct, analz_mono_contra, auto)
+
+text{*Lemma for message 5: pubSK C is never used to encrypt Keys.*}
+lemma pubSK_not_KeyCryptKey [simp]: "~ KeyCryptKey (pubSK C) K evs"
+apply (induct_tac "evs")
+apply (auto simp add: parts_insert2 split add: event.split)
+done
+
+text{*Lemma for message 6: either cardSK is compromised (when we don't care)
+  or else cardSK hasn't been used to encrypt K.  Previously we treated
+  message 5 in the same way, but the current model assumes that rule
+  @{text SET_CR5} is executed only by honest agents.*}
+lemma msg6_KeyCryptKey_disj:
+     "[|Gets B {|Crypt KC3 {|Agent C, Nonce N, Key KC2, Key cardSK, X|}, Y|}
+          \<in> set evs;
+        cardSK \<notin> symKeys;  evs \<in> set_cr|]
+      ==> Key cardSK \<in> analz (knows Spy evs) |
+          (\<forall>K. ~ KeyCryptKey cardSK K evs)"
+by (blast dest: not_KeyCryptKey_cardSK intro: cardSK_neq_priEK)
+
+text{*As usual: we express the property as a logical equivalence*}
+lemma Key_analz_image_Key_lemma:
+     "P --> (Key K \<in> analz (Key`KK Un H)) --> (K \<in> KK | Key K \<in> analz H)
+      ==>
+      P --> (Key K \<in> analz (Key`KK Un H)) = (K \<in> KK | Key K \<in> analz H)"
+by (blast intro: analz_mono [THEN [2] rev_subsetD])
+
+method_setup valid_certificate_tac = {*
+  Args.goal_spec >> (fn quant => K (SIMPLE_METHOD'' quant
+    (fn i =>
+      EVERY [ftac @{thm Gets_certificate_valid} i,
+             assume_tac i,
+             etac conjE i, REPEAT (hyp_subst_tac i)])))
+*} ""
+
+text{*The @{text "(no_asm)"} attribute is essential, since it retains
+  the quantifier and allows the simprule's condition to itself be simplified.*}
+lemma symKey_compromise [rule_format (no_asm)]:
+     "evs \<in> set_cr ==>
+      (\<forall>SK KK. SK \<in> symKeys \<longrightarrow> (\<forall>K \<in> KK. ~ KeyCryptKey K SK evs)   -->
+               (Key SK \<in> analz (Key`KK Un (knows Spy evs))) =
+               (SK \<in> KK | Key SK \<in> analz (knows Spy evs)))"
+apply (erule set_cr.induct)
+apply (rule_tac [!] allI) +
+apply (rule_tac [!] impI [THEN Key_analz_image_Key_lemma, THEN impI])+
+apply (valid_certificate_tac [8]) --{*for message 5*}
+apply (valid_certificate_tac [6]) --{*for message 5*}
+apply (erule_tac [9] msg6_KeyCryptKey_disj [THEN disjE])
+apply (simp_all
+         del: image_insert image_Un imp_disjL
+         add: analz_image_keys_simps analz_knows_absorb
+              analz_Key_image_insert_eq notin_image_iff
+              K_fresh_not_KeyCryptKey
+              DK_fresh_not_KeyCryptKey ball_conj_distrib
+              analz_image_priEK disj_simps)
+  --{*9 seconds on a 1.6GHz machine*}
+apply spy_analz
+apply blast  --{*3*}
+apply blast  --{*5*}
+done
+
+text{*The remaining quantifiers seem to be essential.
+  NO NEED to assume the cardholder's OK: bad cardholders don't do anything
+  wrong!!*}
+lemma symKey_secrecy [rule_format]:
+     "[|CA i \<notin> bad;  K \<in> symKeys;  evs \<in> set_cr|]
+      ==> \<forall>X c. Says (Cardholder c) (CA i) X \<in> set evs -->
+                Key K \<in> parts{X} -->
+                Cardholder c \<notin> bad -->
+                Key K \<notin> analz (knows Spy evs)"
+apply (erule set_cr.induct)
+apply (frule_tac [8] Gets_certificate_valid) --{*for message 5*}
+apply (frule_tac [6] Gets_certificate_valid) --{*for message 3*}
+apply (erule_tac [11] msg6_KeyCryptKey_disj [THEN disjE])
+apply (simp_all del: image_insert image_Un imp_disjL
+         add: symKey_compromise fresh_notin_analz_knows_Spy
+              analz_image_keys_simps analz_knows_absorb
+              analz_Key_image_insert_eq notin_image_iff
+              K_fresh_not_KeyCryptKey
+              DK_fresh_not_KeyCryptKey
+              analz_image_priEK)
+  --{*2.5 seconds on a 1.6GHz machine*}
+apply spy_analz  --{*Fake*}
+apply (auto intro: analz_into_parts [THEN usedI] in_parts_Says_imp_used)
+done
+
+
+subsection{*Primary Goals of Cardholder Registration *}
+
+text{*The cardholder's certificate really was created by the CA, provided the
+    CA is uncompromised *}
+
+text{*Lemma concerning the actual signed message digest*}
+lemma cert_valid_lemma:
+     "[|Crypt (priSK (CA i)) {|Hash {|Nonce N, Pan(pan C)|}, Key cardSK, N1|}
+          \<in> parts (knows Spy evs);
+        CA i \<notin> bad; evs \<in> set_cr|]
+  ==> \<exists>KC2 X Y. Says (CA i) C
+                     (Crypt KC2 
+                       {|X, certC (pan C) cardSK N onlySig (priSK (CA i)), Y|})
+                  \<in> set evs"
+apply (erule rev_mp)
+apply (erule set_cr.induct)
+apply (simp_all (no_asm_simp))
+apply auto
+done
+
+text{*Pre-packaged version for cardholder.  We don't try to confirm the values
+  of KC2, X and Y, since they are not important.*}
+lemma certificate_valid_cardSK:
+    "[|Gets C (Crypt KC2 {|X, certC (pan C) cardSK N onlySig (invKey SKi),
+                              cert (CA i) SKi onlySig (priSK RCA)|}) \<in> set evs;
+        CA i \<notin> bad; evs \<in> set_cr|]
+  ==> \<exists>KC2 X Y. Says (CA i) C
+                     (Crypt KC2 
+                       {|X, certC (pan C) cardSK N onlySig (priSK (CA i)), Y|})
+                   \<in> set evs"
+by (force dest!: Gets_imp_knows_Spy [THEN parts.Inj, THEN parts.Body]
+                    certificate_valid_pubSK cert_valid_lemma)
+
+
+lemma Hash_imp_parts [rule_format]:
+     "evs \<in> set_cr
+      ==> Hash{|X, Nonce N|} \<in> parts (knows Spy evs) -->
+          Nonce N \<in> parts (knows Spy evs)"
+apply (erule set_cr.induct, force)
+apply (simp_all (no_asm_simp))
+apply (blast intro: parts_mono [THEN [2] rev_subsetD])
+done
+
+lemma Hash_imp_parts2 [rule_format]:
+     "evs \<in> set_cr
+      ==> Hash{|X, Nonce M, Y, Nonce N|} \<in> parts (knows Spy evs) -->
+          Nonce M \<in> parts (knows Spy evs) & Nonce N \<in> parts (knows Spy evs)"
+apply (erule set_cr.induct, force)
+apply (simp_all (no_asm_simp))
+apply (blast intro: parts_mono [THEN [2] rev_subsetD])
+done
+
+
+subsection{*Secrecy of Nonces*}
+
+subsubsection{*Lemmas about the predicate KeyCryptNonce *}
+
+text{*A fresh DK cannot be associated with any other
+  (with respect to a given trace). *}
+lemma DK_fresh_not_KeyCryptNonce:
+     "[| DK \<in> symKeys; Key DK \<notin> used evs; evs \<in> set_cr |]
+      ==> ~ KeyCryptNonce DK K evs"
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule set_cr.induct)
+apply (simp_all (no_asm_simp))
+apply blast
+apply blast
+apply (auto simp add: DK_fresh_not_KeyCryptKey)
+done
+
+text{*A fresh N cannot be associated with any other
+      (with respect to a given trace). *}
+lemma N_fresh_not_KeyCryptNonce:
+     "\<forall>C. DK \<noteq> priEK C ==> Nonce N \<notin> used evs --> ~ KeyCryptNonce DK N evs"
+apply (induct_tac "evs")
+apply (case_tac [2] "a")
+apply (auto simp add: parts_insert2)
+done
+
+lemma not_KeyCryptNonce_cardSK [rule_format (no_asm)]:
+     "[|cardSK \<notin> symKeys;  \<forall>C. cardSK \<noteq> priEK C;  evs \<in> set_cr|] ==>
+      Key cardSK \<notin> analz (knows Spy evs) --> ~ KeyCryptNonce cardSK N evs"
+apply (erule set_cr.induct, analz_mono_contra, simp_all)
+apply (blast dest: not_KeyCryptKey_cardSK)  --{*6*}
+done
+
+subsubsection{*Lemmas for message 5 and 6:
+  either cardSK is compromised (when we don't care)
+  or else cardSK hasn't been used to encrypt K. *}
+
+text{*Lemma for message 5: pubSK C is never used to encrypt Nonces.*}
+lemma pubSK_not_KeyCryptNonce [simp]: "~ KeyCryptNonce (pubSK C) N evs"
+apply (induct_tac "evs")
+apply (auto simp add: parts_insert2 split add: event.split)
+done
+
+text{*Lemma for message 6: either cardSK is compromised (when we don't care)
+  or else cardSK hasn't been used to encrypt K.*}
+lemma msg6_KeyCryptNonce_disj:
+     "[|Gets B {|Crypt KC3 {|Agent C, Nonce N, Key KC2, Key cardSK, X|}, Y|}
+          \<in> set evs;
+        cardSK \<notin> symKeys;  evs \<in> set_cr|]
+      ==> Key cardSK \<in> analz (knows Spy evs) |
+          ((\<forall>K. ~ KeyCryptKey cardSK K evs) &
+           (\<forall>N. ~ KeyCryptNonce cardSK N evs))"
+by (blast dest: not_KeyCryptKey_cardSK not_KeyCryptNonce_cardSK
+          intro: cardSK_neq_priEK)
+
+
+text{*As usual: we express the property as a logical equivalence*}
+lemma Nonce_analz_image_Key_lemma:
+     "P --> (Nonce N \<in> analz (Key`KK Un H)) --> (Nonce N \<in> analz H)
+      ==> P --> (Nonce N \<in> analz (Key`KK Un H)) = (Nonce N \<in> analz H)"
+by (blast intro: analz_mono [THEN [2] rev_subsetD])
+
+
+text{*The @{text "(no_asm)"} attribute is essential, since it retains
+  the quantifier and allows the simprule's condition to itself be simplified.*}
+lemma Nonce_compromise [rule_format (no_asm)]:
+     "evs \<in> set_cr ==>
+      (\<forall>N KK. (\<forall>K \<in> KK. ~ KeyCryptNonce K N evs)   -->
+               (Nonce N \<in> analz (Key`KK Un (knows Spy evs))) =
+               (Nonce N \<in> analz (knows Spy evs)))"
+apply (erule set_cr.induct)
+apply (rule_tac [!] allI)+
+apply (rule_tac [!] impI [THEN Nonce_analz_image_Key_lemma])+
+apply (frule_tac [8] Gets_certificate_valid) --{*for message 5*}
+apply (frule_tac [6] Gets_certificate_valid) --{*for message 3*}
+apply (frule_tac [11] msg6_KeyCryptNonce_disj)
+apply (erule_tac [13] disjE)
+apply (simp_all del: image_insert image_Un
+         add: symKey_compromise
+              analz_image_keys_simps analz_knows_absorb
+              analz_Key_image_insert_eq notin_image_iff
+              N_fresh_not_KeyCryptNonce
+              DK_fresh_not_KeyCryptNonce K_fresh_not_KeyCryptKey
+              ball_conj_distrib analz_image_priEK)
+  --{*14 seconds on a 1.6GHz machine*}
+apply spy_analz  --{*Fake*}
+apply blast  --{*3*}
+apply blast  --{*5*}
+txt{*Message 6*}
+apply (metis symKey_compromise)
+  --{*cardSK compromised*}
+txt{*Simplify again--necessary because the previous simplification introduces
+  some logical connectives*} 
+apply (force simp del: image_insert image_Un imp_disjL
+          simp add: analz_image_keys_simps symKey_compromise)
+done
+
+
+subsection{*Secrecy of CardSecret: the Cardholder's secret*}
+
+lemma NC2_not_CardSecret:
+     "[|Crypt EKj {|Key K, Pan p, Hash {|Agent D, Nonce N|}|}
+          \<in> parts (knows Spy evs);
+        Key K \<notin> analz (knows Spy evs);
+        Nonce N \<notin> analz (knows Spy evs);
+       evs \<in> set_cr|]
+      ==> Crypt EKi {|Key K', Pan p', Nonce N|} \<notin> parts (knows Spy evs)"
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule set_cr.induct, analz_mono_contra, simp_all)
+apply (blast dest: Hash_imp_parts)+
+done
+
+lemma KC2_secure_lemma [rule_format]:
+     "[|U = Crypt KC3 {|Agent C, Nonce N, Key KC2, X|};
+        U \<in> parts (knows Spy evs);
+        evs \<in> set_cr|]
+  ==> Nonce N \<notin> analz (knows Spy evs) -->
+      (\<exists>k i W. Says (Cardholder k) (CA i) {|U,W|} \<in> set evs & 
+               Cardholder k \<notin> bad & CA i \<notin> bad)"
+apply (erule_tac P = "U \<in> ?H" in rev_mp)
+apply (erule set_cr.induct)
+apply (valid_certificate_tac [8])  --{*for message 5*}
+apply (simp_all del: image_insert image_Un imp_disjL
+         add: analz_image_keys_simps analz_knows_absorb
+              analz_knows_absorb2 notin_image_iff)
+  --{*4 seconds on a 1.6GHz machine*}
+apply (simp_all (no_asm_simp)) --{*leaves 4 subgoals*}
+apply (blast intro!: analz_insertI)+
+done
+
+lemma KC2_secrecy:
+     "[|Gets B {|Crypt K {|Agent C, Nonce N, Key KC2, X|}, Y|} \<in> set evs;
+        Nonce N \<notin> analz (knows Spy evs);  KC2 \<in> symKeys;
+        evs \<in> set_cr|]
+       ==> Key KC2 \<notin> analz (knows Spy evs)"
+by (force dest!: refl [THEN KC2_secure_lemma] symKey_secrecy)
+
+
+text{*Inductive version*}
+lemma CardSecret_secrecy_lemma [rule_format]:
+     "[|CA i \<notin> bad;  evs \<in> set_cr|]
+      ==> Key K \<notin> analz (knows Spy evs) -->
+          Crypt (pubEK (CA i)) {|Key K, Pan p, Nonce CardSecret|}
+             \<in> parts (knows Spy evs) -->
+          Nonce CardSecret \<notin> analz (knows Spy evs)"
+apply (erule set_cr.induct, analz_mono_contra)
+apply (valid_certificate_tac [8]) --{*for message 5*}
+apply (valid_certificate_tac [6]) --{*for message 5*}
+apply (frule_tac [9] msg6_KeyCryptNonce_disj [THEN disjE])
+apply (simp_all
+         del: image_insert image_Un imp_disjL
+         add: analz_image_keys_simps analz_knows_absorb
+              analz_Key_image_insert_eq notin_image_iff
+              EXHcrypt_def Crypt_notin_image_Key
+              N_fresh_not_KeyCryptNonce DK_fresh_not_KeyCryptNonce
+              ball_conj_distrib Nonce_compromise symKey_compromise
+              analz_image_priEK)
+  --{*2.5 seconds on a 1.6GHz machine*}
+apply spy_analz  --{*Fake*}
+apply (simp_all (no_asm_simp))
+apply blast  --{*1*}
+apply (blast dest!: Gets_imp_knows_Spy [THEN analz.Inj])  --{*2*}
+apply blast  --{*3*}
+apply (blast dest: NC2_not_CardSecret Gets_imp_knows_Spy [THEN analz.Inj] analz_symKeys_Decrypt)  --{*4*}
+apply blast  --{*5*}
+apply (blast dest: KC2_secrecy)+  --{*Message 6: two cases*}
+done
+
+
+text{*Packaged version for cardholder*}
+lemma CardSecret_secrecy:
+     "[|Cardholder k \<notin> bad;  CA i \<notin> bad;
+        Says (Cardholder k) (CA i)
+           {|X, Crypt EKi {|Key KC3, Pan p, Nonce CardSecret|}|} \<in> set evs;
+        Gets A {|Z, cert (CA i) EKi onlyEnc (priSK RCA),
+                    cert (CA i) SKi onlySig (priSK RCA)|} \<in> set evs;
+        KC3 \<in> symKeys;  evs \<in> set_cr|]
+      ==> Nonce CardSecret \<notin> analz (knows Spy evs)"
+apply (frule Gets_certificate_valid, assumption)
+apply (subgoal_tac "Key KC3 \<notin> analz (knows Spy evs) ")
+apply (blast dest: CardSecret_secrecy_lemma)
+apply (rule symKey_secrecy)
+apply (auto simp add: parts_insert2)
+done
+
+
+subsection{*Secrecy of NonceCCA [the CA's secret] *}
+
+lemma NC2_not_NonceCCA:
+     "[|Hash {|Agent C', Nonce N', Agent C, Nonce N|}
+          \<in> parts (knows Spy evs);
+        Nonce N \<notin> analz (knows Spy evs);
+       evs \<in> set_cr|]
+      ==> Crypt KC1 {|{|Agent B, Nonce N|}, Hash p|} \<notin> parts (knows Spy evs)"
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule set_cr.induct, analz_mono_contra, simp_all)
+apply (blast dest: Hash_imp_parts2)+
+done
+
+
+text{*Inductive version*}
+lemma NonceCCA_secrecy_lemma [rule_format]:
+     "[|CA i \<notin> bad;  evs \<in> set_cr|]
+      ==> Key K \<notin> analz (knows Spy evs) -->
+          Crypt K
+            {|sign (priSK (CA i))
+                   {|Agent C, Nonce N, Agent(CA i), Nonce NonceCCA|},
+              X, Y|}
+             \<in> parts (knows Spy evs) -->
+          Nonce NonceCCA \<notin> analz (knows Spy evs)"
+apply (erule set_cr.induct, analz_mono_contra)
+apply (valid_certificate_tac [8]) --{*for message 5*}
+apply (valid_certificate_tac [6]) --{*for message 5*}
+apply (frule_tac [9] msg6_KeyCryptNonce_disj [THEN disjE])
+apply (simp_all
+         del: image_insert image_Un imp_disjL
+         add: analz_image_keys_simps analz_knows_absorb sign_def
+              analz_Key_image_insert_eq notin_image_iff
+              EXHcrypt_def Crypt_notin_image_Key
+              N_fresh_not_KeyCryptNonce DK_fresh_not_KeyCryptNonce
+              ball_conj_distrib Nonce_compromise symKey_compromise
+              analz_image_priEK)
+  --{*3 seconds on a 1.6GHz machine*}
+apply spy_analz  --{*Fake*}
+apply blast  --{*1*}
+apply (blast dest!: Gets_imp_knows_Spy [THEN analz.Inj])  --{*2*}
+apply blast  --{*3*}
+apply (blast dest: NC2_not_NonceCCA)  --{*4*}
+apply blast  --{*5*}
+apply (blast dest: KC2_secrecy)+  --{*Message 6: two cases*}
+done
+
+
+text{*Packaged version for cardholder*}
+lemma NonceCCA_secrecy:
+     "[|Cardholder k \<notin> bad;  CA i \<notin> bad;
+        Gets (Cardholder k)
+           (Crypt KC2
+            {|sign (priSK (CA i)) {|Agent C, Nonce N, Agent(CA i), Nonce NonceCCA|},
+              X, Y|}) \<in> set evs;
+        Says (Cardholder k) (CA i)
+           {|Crypt KC3 {|Agent C, Nonce NC3, Key KC2, X'|}, Y'|} \<in> set evs;
+        Gets A {|Z, cert (CA i) EKi onlyEnc (priSK RCA),
+                    cert (CA i) SKi onlySig (priSK RCA)|} \<in> set evs;
+        KC2 \<in> symKeys;  evs \<in> set_cr|]
+      ==> Nonce NonceCCA \<notin> analz (knows Spy evs)"
+apply (frule Gets_certificate_valid, assumption)
+apply (subgoal_tac "Key KC2 \<notin> analz (knows Spy evs) ")
+apply (blast dest: NonceCCA_secrecy_lemma)
+apply (rule symKey_secrecy)
+apply (auto simp add: parts_insert2)
+done
+
+text{*We don't bother to prove guarantees for the CA.  He doesn't care about
+  the PANSecret: it isn't his credit card!*}
+
+
+subsection{*Rewriting Rule for PANs*}
+
+text{*Lemma for message 6: either cardSK isn't a CA's private encryption key,
+  or if it is then (because it appears in traffic) that CA is bad,
+  and so the Spy knows that key already.  Either way, we can simplify
+  the expression @{term "analz (insert (Key cardSK) X)"}.*}
+lemma msg6_cardSK_disj:
+     "[|Gets A {|Crypt K {|c, n, k', Key cardSK, X|}, Y|}
+          \<in> set evs;  evs \<in> set_cr |]
+      ==> cardSK \<notin> range(invKey o pubEK o CA) | Key cardSK \<in> knows Spy evs"
+by auto
+
+lemma analz_image_pan_lemma:
+     "(Pan P \<in> analz (Key`nE Un H)) --> (Pan P \<in> analz H)  ==>
+      (Pan P \<in> analz (Key`nE Un H)) =   (Pan P \<in> analz H)"
+by (blast intro: analz_mono [THEN [2] rev_subsetD])
+
+lemma analz_image_pan [rule_format]:
+     "evs \<in> set_cr ==>
+       \<forall>KK. KK <= - invKey ` pubEK ` range CA -->
+            (Pan P \<in> analz (Key`KK Un (knows Spy evs))) =
+            (Pan P \<in> analz (knows Spy evs))"
+apply (erule set_cr.induct)
+apply (rule_tac [!] allI impI)+
+apply (rule_tac [!] analz_image_pan_lemma)
+apply (valid_certificate_tac [8]) --{*for message 5*}
+apply (valid_certificate_tac [6]) --{*for message 5*}
+apply (erule_tac [9] msg6_cardSK_disj [THEN disjE])
+apply (simp_all
+         del: image_insert image_Un
+         add: analz_image_keys_simps disjoint_image_iff
+              notin_image_iff analz_image_priEK)
+  --{*6 seconds on a 1.6GHz machine*}
+apply spy_analz
+apply (simp add: insert_absorb)  --{*6*}
+done
+
+lemma analz_insert_pan:
+     "[| evs \<in> set_cr;  K \<notin> invKey ` pubEK ` range CA |] ==>
+          (Pan P \<in> analz (insert (Key K) (knows Spy evs))) =
+          (Pan P \<in> analz (knows Spy evs))"
+by (simp del: image_insert image_Un
+         add: analz_image_keys_simps analz_image_pan)
+
+
+text{*Confidentiality of the PAN\@.  Maybe we could combine the statements of
+  this theorem with @{term analz_image_pan}, requiring a single induction but
+  a much more difficult proof.*}
+lemma pan_confidentiality:
+     "[| Pan (pan C) \<in> analz(knows Spy evs); C \<noteq>Spy; evs :set_cr|]
+    ==> \<exists>i X K HN.
+        Says C (CA i) {|X, Crypt (pubEK (CA i)) {|Key K, Pan (pan C), HN|} |}
+           \<in> set evs
+      & (CA i) \<in> bad"
+apply (erule rev_mp)
+apply (erule set_cr.induct)
+apply (valid_certificate_tac [8]) --{*for message 5*}
+apply (valid_certificate_tac [6]) --{*for message 5*}
+apply (erule_tac [9] msg6_cardSK_disj [THEN disjE])
+apply (simp_all
+         del: image_insert image_Un
+         add: analz_image_keys_simps analz_insert_pan analz_image_pan
+              notin_image_iff analz_image_priEK)
+  --{*3.5 seconds on a 1.6GHz machine*}
+apply spy_analz  --{*fake*}
+apply blast  --{*3*}
+apply blast  --{*5*}
+apply (simp (no_asm_simp) add: insert_absorb)  --{*6*}
+done
+
+
+subsection{*Unicity*}
+
+lemma CR6_Says_imp_Notes:
+     "[|Says (CA i) C (Crypt KC2
+          {|sign (priSK (CA i)) {|Agent C, Nonce NC3, Agent (CA i), Nonce Y|},
+            certC (pan C) cardSK X onlySig (priSK (CA i)),
+            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})  \<in> set evs;
+        evs \<in> set_cr |]
+      ==> Notes (CA i) (Key cardSK) \<in> set evs"
+apply (erule rev_mp)
+apply (erule set_cr.induct)
+apply (simp_all (no_asm_simp))
+done
+
+text{*Unicity of cardSK: it uniquely identifies the other components.  
+      This holds because a CA accepts a cardSK at most once.*}
+lemma cardholder_key_unicity:
+     "[|Says (CA i) C (Crypt KC2
+          {|sign (priSK (CA i)) {|Agent C, Nonce NC3, Agent (CA i), Nonce Y|},
+            certC (pan C) cardSK X onlySig (priSK (CA i)),
+            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})
+          \<in> set evs;
+        Says (CA i) C' (Crypt KC2'
+          {|sign (priSK (CA i)) {|Agent C', Nonce NC3', Agent (CA i), Nonce Y'|},
+            certC (pan C') cardSK X' onlySig (priSK (CA i)),
+            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})
+          \<in> set evs;
+        evs \<in> set_cr |] ==> C=C' & NC3=NC3' & X=X' & KC2=KC2' & Y=Y'"
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule set_cr.induct)
+apply (simp_all (no_asm_simp))
+apply (blast dest!: CR6_Says_imp_Notes)
+done
+
+
+(*<*)
+text{*UNUSED unicity result*}
+lemma unique_KC1:
+     "[|Says C B {|Crypt KC1 X, Crypt EK {|Key KC1, Y|}|}
+          \<in> set evs;
+        Says C B' {|Crypt KC1 X', Crypt EK' {|Key KC1, Y'|}|}
+          \<in> set evs;
+        C \<notin> bad;  evs \<in> set_cr|] ==> B'=B & Y'=Y"
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule set_cr.induct, auto)
+done
+
+text{*UNUSED unicity result*}
+lemma unique_KC2:
+     "[|Says C B {|Crypt K {|Agent C, nn, Key KC2, X|}, Y|} \<in> set evs;
+        Says C B' {|Crypt K' {|Agent C, nn', Key KC2, X'|}, Y'|} \<in> set evs;
+        C \<notin> bad;  evs \<in> set_cr|] ==> B'=B & X'=X"
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule set_cr.induct, auto)
+done
+(*>*)
+
+
+text{*Cannot show cardSK to be secret because it isn't assumed to be fresh
+  it could be a previously compromised cardSK [e.g. involving a bad CA]*}
+
+
+end
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/SET_Protocol/Event_SET.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/SET_Protocol/Event_SET.thy	Tue Oct 20 20:03:23 2009 +0200
@@ -0,0 +1,198 @@
+(*  Title:      HOL/SET_Protocol/Event_SET.thy
+    Author:     Giampaolo Bella
+    Author:     Fabio Massacci
+    Author:     Lawrence C Paulson
+*)
+
+header{*Theory of Events for SET*}
+
+theory Event_SET
+imports Message_SET
+begin
+
+text{*The Root Certification Authority*}
+syntax        RCA :: agent
+translations "RCA" == "CA 0"
+
+
+text{*Message events*}
+datatype
+  event = Says  agent agent msg
+        | Gets  agent       msg
+        | Notes agent       msg
+
+
+text{*compromised agents: keys known, Notes visible*}
+consts bad :: "agent set"
+
+text{*Spy has access to his own key for spoof messages, but RCA is secure*}
+specification (bad)
+  Spy_in_bad     [iff]: "Spy \<in> bad"
+  RCA_not_bad [iff]: "RCA \<notin> bad"
+    by (rule exI [of _ "{Spy}"], simp)
+
+
+subsection{*Agents' Knowledge*}
+
+consts  (*Initial states of agents -- parameter of the construction*)
+  initState :: "agent => msg set"
+  knows  :: "[agent, event list] => msg set"
+
+(* Message reception does not extend spy's knowledge because of
+   reception invariant enforced by Reception rule in protocol definition*)
+primrec
+
+knows_Nil:
+  "knows A []       = initState A"
+knows_Cons:
+    "knows A (ev # evs) =
+       (if A = Spy then
+        (case ev of
+           Says A' B X => insert X (knows Spy evs)
+         | Gets A' X => knows Spy evs
+         | Notes A' X  =>
+             if A' \<in> bad then insert X (knows Spy evs) else knows Spy evs)
+        else
+        (case ev of
+           Says A' B X =>
+             if A'=A then insert X (knows A evs) else knows A evs
+         | Gets A' X    =>
+             if A'=A then insert X (knows A evs) else knows A evs
+         | Notes A' X    =>
+             if A'=A then insert X (knows A evs) else knows A evs))"
+
+
+subsection{*Used Messages*}
+
+consts
+  (*Set of items that might be visible to somebody:
+    complement of the set of fresh items*)
+  used :: "event list => msg set"
+
+(* As above, message reception does extend used items *)
+primrec
+  used_Nil:  "used []         = (UN B. parts (initState B))"
+  used_Cons: "used (ev # evs) =
+                 (case ev of
+                    Says A B X => parts {X} Un (used evs)
+                  | Gets A X   => used evs
+                  | Notes A X  => parts {X} Un (used evs))"
+
+
+
+(* Inserted by default but later removed.  This declaration lets the file
+be re-loaded. Addsimps [knows_Cons, used_Nil, *)
+
+(** Simplifying   parts (insert X (knows Spy evs))
+      = parts {X} Un parts (knows Spy evs) -- since general case loops*)
+
+lemmas parts_insert_knows_A = parts_insert [of _ "knows A evs", standard]
+
+lemma knows_Spy_Says [simp]:
+     "knows Spy (Says A B X # evs) = insert X (knows Spy evs)"
+by auto
+
+text{*Letting the Spy see "bad" agents' notes avoids redundant case-splits
+      on whether @{term "A=Spy"} and whether @{term "A\<in>bad"}*}
+lemma knows_Spy_Notes [simp]:
+     "knows Spy (Notes A X # evs) =
+          (if A:bad then insert X (knows Spy evs) else knows Spy evs)"
+apply auto
+done
+
+lemma knows_Spy_Gets [simp]: "knows Spy (Gets A X # evs) = knows Spy evs"
+by auto
+
+lemma initState_subset_knows: "initState A <= knows A evs"
+apply (induct_tac "evs")
+apply (auto split: event.split) 
+done
+
+lemma knows_Spy_subset_knows_Spy_Says:
+     "knows Spy evs <= knows Spy (Says A B X # evs)"
+by auto
+
+lemma knows_Spy_subset_knows_Spy_Notes:
+     "knows Spy evs <= knows Spy (Notes A X # evs)"
+by auto
+
+lemma knows_Spy_subset_knows_Spy_Gets:
+     "knows Spy evs <= knows Spy (Gets A X # evs)"
+by auto
+
+(*Spy sees what is sent on the traffic*)
+lemma Says_imp_knows_Spy [rule_format]:
+     "Says A B X \<in> set evs --> X \<in> knows Spy evs"
+apply (induct_tac "evs")
+apply (auto split: event.split) 
+done
+
+(*Use with addSEs to derive contradictions from old Says events containing
+  items known to be fresh*)
+lemmas knows_Spy_partsEs =
+     Says_imp_knows_Spy [THEN parts.Inj, THEN revcut_rl, standard] 
+     parts.Body [THEN revcut_rl, standard]
+
+
+subsection{*The Function @{term used}*}
+
+lemma parts_knows_Spy_subset_used: "parts (knows Spy evs) <= used evs"
+apply (induct_tac "evs")
+apply (auto simp add: parts_insert_knows_A split: event.split) 
+done
+
+lemmas usedI = parts_knows_Spy_subset_used [THEN subsetD, intro]
+
+lemma initState_subset_used: "parts (initState B) <= used evs"
+apply (induct_tac "evs")
+apply (auto split: event.split) 
+done
+
+lemmas initState_into_used = initState_subset_used [THEN subsetD]
+
+lemma used_Says [simp]: "used (Says A B X # evs) = parts{X} Un used evs"
+by auto
+
+lemma used_Notes [simp]: "used (Notes A X # evs) = parts{X} Un used evs"
+by auto
+
+lemma used_Gets [simp]: "used (Gets A X # evs) = used evs"
+by auto
+
+
+lemma Notes_imp_parts_subset_used [rule_format]:
+     "Notes A X \<in> set evs --> parts {X} <= used evs"
+apply (induct_tac "evs")
+apply (induct_tac [2] "a", auto)
+done
+
+text{*NOTE REMOVAL--laws above are cleaner, as they don't involve "case"*}
+declare knows_Cons [simp del]
+        used_Nil [simp del] used_Cons [simp del]
+
+
+text{*For proving theorems of the form @{term "X \<notin> analz (knows Spy evs) --> P"}
+  New events added by induction to "evs" are discarded.  Provided 
+  this information isn't needed, the proof will be much shorter, since
+  it will omit complicated reasoning about @{term analz}.*}
+
+lemmas analz_mono_contra =
+       knows_Spy_subset_knows_Spy_Says [THEN analz_mono, THEN contra_subsetD]
+       knows_Spy_subset_knows_Spy_Notes [THEN analz_mono, THEN contra_subsetD]
+       knows_Spy_subset_knows_Spy_Gets [THEN analz_mono, THEN contra_subsetD]
+
+lemmas analz_impI = impI [where P = "Y \<notin> analz (knows Spy evs)", standard]
+
+ML
+{*
+val analz_mono_contra_tac = 
+  rtac @{thm analz_impI} THEN' 
+  REPEAT1 o (dresolve_tac @{thms analz_mono_contra})
+  THEN' mp_tac
+*}
+
+method_setup analz_mono_contra = {*
+    Scan.succeed (K (SIMPLE_METHOD (REPEAT_FIRST analz_mono_contra_tac))) *}
+    "for proving theorems of the form X \<notin> analz (knows Spy evs) --> P"
+
+end
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/SET_Protocol/Merchant_Registration.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/SET_Protocol/Merchant_Registration.thy	Tue Oct 20 20:03:23 2009 +0200
@@ -0,0 +1,429 @@
+(*  Title:      HOL/SET_Protocol/Merchant_Registration.thy
+    Author:     Giampaolo Bella
+    Author:     Fabio Massacci
+    Author:     Lawrence C Paulson
+*)
+
+header{*The SET Merchant Registration Protocol*}
+
+theory Merchant_Registration
+imports Public_SET
+begin
+
+text{*Copmpared with Cardholder Reigstration, @{text KeyCryptKey} is not
+  needed: no session key encrypts another.  Instead we
+  prove the "key compromise" theorems for sets KK that contain no private
+  encryption keys (@{term "priEK C"}). *}
+
+
+inductive_set
+  set_mr :: "event list set"
+where
+
+  Nil:    --{*Initial trace is empty*}
+           "[] \<in> set_mr"
+
+
+| Fake:    --{*The spy MAY say anything he CAN say.*}
+           "[| evsf \<in> set_mr; X \<in> synth (analz (knows Spy evsf)) |]
+            ==> Says Spy B X  # evsf \<in> set_mr"
+        
+
+| Reception: --{*If A sends a message X to B, then B might receive it*}
+             "[| evsr \<in> set_mr; Says A B X \<in> set evsr |]
+              ==> Gets B X  # evsr \<in> set_mr"
+
+
+| SET_MR1: --{*RegFormReq: M requires a registration form to a CA*}
+           "[| evs1 \<in> set_mr; M = Merchant k; Nonce NM1 \<notin> used evs1 |]
+            ==> Says M (CA i) {|Agent M, Nonce NM1|} # evs1 \<in> set_mr"
+
+
+| SET_MR2: --{*RegFormRes: CA replies with the registration form and the 
+               certificates for her keys*}
+  "[| evs2 \<in> set_mr; Nonce NCA \<notin> used evs2;
+      Gets (CA i) {|Agent M, Nonce NM1|} \<in> set evs2 |]
+   ==> Says (CA i) M {|sign (priSK (CA i)) {|Agent M, Nonce NM1, Nonce NCA|},
+                       cert (CA i) (pubEK (CA i)) onlyEnc (priSK RCA),
+                       cert (CA i) (pubSK (CA i)) onlySig (priSK RCA) |}
+         # evs2 \<in> set_mr"
+
+| SET_MR3:
+         --{*CertReq: M submits the key pair to be certified.  The Notes
+             event allows KM1 to be lost if M is compromised. Piero remarks
+             that the agent mentioned inside the signature is not verified to
+             correspond to M.  As in CR, each Merchant has fixed key pairs.  M
+             is only optionally required to send NCA back, so M doesn't do so
+             in the model*}
+  "[| evs3 \<in> set_mr; M = Merchant k; Nonce NM2 \<notin> used evs3;
+      Key KM1 \<notin> used evs3;  KM1 \<in> symKeys;
+      Gets M {|sign (invKey SKi) {|Agent X, Nonce NM1, Nonce NCA|},
+               cert (CA i) EKi onlyEnc (priSK RCA),
+               cert (CA i) SKi onlySig (priSK RCA) |}
+        \<in> set evs3;
+      Says M (CA i) {|Agent M, Nonce NM1|} \<in> set evs3 |]
+   ==> Says M (CA i)
+            {|Crypt KM1 (sign (priSK M) {|Agent M, Nonce NM2,
+                                          Key (pubSK M), Key (pubEK M)|}),
+              Crypt EKi (Key KM1)|}
+         # Notes M {|Key KM1, Agent (CA i)|}
+         # evs3 \<in> set_mr"
+
+| SET_MR4:
+         --{*CertRes: CA issues the certificates for merSK and merEK,
+             while checking never to have certified the m even
+             separately. NOTE: In Cardholder Registration the
+             corresponding rule (6) doesn't use the "sign" primitive. "The
+             CertRes shall be signed but not encrypted if the EE is a Merchant
+             or Payment Gateway."-- Programmer's Guide, page 191.*}
+    "[| evs4 \<in> set_mr; M = Merchant k;
+        merSK \<notin> symKeys;  merEK \<notin> symKeys;
+        Notes (CA i) (Key merSK) \<notin> set evs4;
+        Notes (CA i) (Key merEK) \<notin> set evs4;
+        Gets (CA i) {|Crypt KM1 (sign (invKey merSK)
+                                 {|Agent M, Nonce NM2, Key merSK, Key merEK|}),
+                      Crypt (pubEK (CA i)) (Key KM1) |}
+          \<in> set evs4 |]
+    ==> Says (CA i) M {|sign (priSK(CA i)) {|Agent M, Nonce NM2, Agent(CA i)|},
+                        cert  M      merSK    onlySig (priSK (CA i)),
+                        cert  M      merEK    onlyEnc (priSK (CA i)),
+                        cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|}
+          # Notes (CA i) (Key merSK)
+          # Notes (CA i) (Key merEK)
+          # evs4 \<in> set_mr"
+
+
+text{*Note possibility proofs are missing.*}
+
+declare Says_imp_knows_Spy [THEN parts.Inj, dest]
+declare parts.Body [dest]
+declare analz_into_parts [dest]
+declare Fake_parts_insert_in_Un [dest]
+
+text{*General facts about message reception*}
+lemma Gets_imp_Says:
+     "[| Gets B X \<in> set evs; evs \<in> set_mr |] ==> \<exists>A. Says A B X \<in> set evs"
+apply (erule rev_mp)
+apply (erule set_mr.induct, auto)
+done
+
+lemma Gets_imp_knows_Spy:
+     "[| Gets B X \<in> set evs; evs \<in> set_mr |]  ==> X \<in> knows Spy evs"
+by (blast dest!: Gets_imp_Says Says_imp_knows_Spy)
+
+
+declare Gets_imp_knows_Spy [THEN parts.Inj, dest]
+
+subsubsection{*Proofs on keys *}
+
+text{*Spy never sees an agent's private keys! (unless it's bad at start)*}
+lemma Spy_see_private_Key [simp]:
+     "evs \<in> set_mr
+      ==> (Key(invKey (publicKey b A)) \<in> parts(knows Spy evs)) = (A \<in> bad)"
+apply (erule set_mr.induct)
+apply (auto dest!: Gets_imp_knows_Spy [THEN parts.Inj])
+done
+
+lemma Spy_analz_private_Key [simp]:
+     "evs \<in> set_mr ==>
+     (Key(invKey (publicKey b A)) \<in> analz(knows Spy evs)) = (A \<in> bad)"
+by auto
+
+declare Spy_see_private_Key [THEN [2] rev_iffD1, dest!]
+declare Spy_analz_private_Key [THEN [2] rev_iffD1, dest!]
+
+(*This is to state that the signed keys received in step 4
+  are into parts - rather than installing sign_def each time.
+  Needed in Spy_see_priSK_RCA, Spy_see_priEK and in Spy_see_priSK
+Goal "[|Gets C \<lbrace>Crypt KM1
+                (sign K \<lbrace>Agent M, Nonce NM2, Key merSK, Key merEK\<rbrace>), X\<rbrace>
+          \<in> set evs;  evs \<in> set_mr |]
+    ==> Key merSK \<in> parts (knows Spy evs) \<and>
+        Key merEK \<in> parts (knows Spy evs)"
+by (fast_tac (claset() addss (simpset())) 1);
+qed "signed_keys_in_parts";
+???*)
+
+text{*Proofs on certificates -
+  they hold, as in CR, because RCA's keys are secure*}
+
+lemma Crypt_valid_pubEK:
+     "[| Crypt (priSK RCA) {|Agent (CA i), Key EKi, onlyEnc|}
+           \<in> parts (knows Spy evs);
+         evs \<in> set_mr |] ==> EKi = pubEK (CA i)"
+apply (erule rev_mp)
+apply (erule set_mr.induct, auto)
+done
+
+lemma certificate_valid_pubEK:
+    "[| cert (CA i) EKi onlyEnc (priSK RCA) \<in> parts (knows Spy evs);
+        evs \<in> set_mr |]
+     ==> EKi = pubEK (CA i)"
+apply (unfold cert_def signCert_def)
+apply (blast dest!: Crypt_valid_pubEK)
+done
+
+lemma Crypt_valid_pubSK:
+     "[| Crypt (priSK RCA) {|Agent (CA i), Key SKi, onlySig|}
+           \<in> parts (knows Spy evs);
+         evs \<in> set_mr |] ==> SKi = pubSK (CA i)"
+apply (erule rev_mp)
+apply (erule set_mr.induct, auto)
+done
+
+lemma certificate_valid_pubSK:
+    "[| cert (CA i) SKi onlySig (priSK RCA) \<in> parts (knows Spy evs);
+        evs \<in> set_mr |] ==> SKi = pubSK (CA i)"
+apply (unfold cert_def signCert_def)
+apply (blast dest!: Crypt_valid_pubSK)
+done
+
+lemma Gets_certificate_valid:
+     "[| Gets A {| X, cert (CA i) EKi onlyEnc (priSK RCA),
+                      cert (CA i) SKi onlySig (priSK RCA)|} \<in> set evs;
+         evs \<in> set_mr |]
+      ==> EKi = pubEK (CA i) & SKi = pubSK (CA i)"
+by (blast dest: certificate_valid_pubEK certificate_valid_pubSK)
+
+
+text{*Nobody can have used non-existent keys!*}
+lemma new_keys_not_used [rule_format,simp]:
+     "evs \<in> set_mr
+      ==> Key K \<notin> used evs --> K \<in> symKeys -->
+          K \<notin> keysFor (parts (knows Spy evs))"
+apply (erule set_mr.induct, simp_all)
+apply (force dest!: usedI keysFor_parts_insert)  --{*Fake*}
+apply force  --{*Message 2*}
+apply (blast dest: Gets_certificate_valid)  --{*Message 3*}
+apply force  --{*Message 4*}
+done
+
+
+subsubsection{*New Versions: As Above, but Generalized with the Kk Argument*}
+
+lemma gen_new_keys_not_used [rule_format]:
+     "evs \<in> set_mr
+      ==> Key K \<notin> used evs --> K \<in> symKeys -->
+          K \<notin> keysFor (parts (Key`KK Un knows Spy evs))"
+by auto
+
+lemma gen_new_keys_not_analzd:
+     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_mr |]
+      ==> K \<notin> keysFor (analz (Key`KK Un knows Spy evs))"
+by (blast intro: keysFor_mono [THEN [2] rev_subsetD]
+          dest: gen_new_keys_not_used)
+
+lemma analz_Key_image_insert_eq:
+     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_mr |]
+      ==> analz (Key ` (insert K KK) \<union> knows Spy evs) =
+          insert (Key K) (analz (Key ` KK \<union> knows Spy evs))"
+by (simp add: gen_new_keys_not_analzd)
+
+
+lemma Crypt_parts_imp_used:
+     "[|Crypt K X \<in> parts (knows Spy evs);
+        K \<in> symKeys; evs \<in> set_mr |] ==> Key K \<in> used evs"
+apply (rule ccontr)
+apply (force dest: new_keys_not_used Crypt_imp_invKey_keysFor)
+done
+
+lemma Crypt_analz_imp_used:
+     "[|Crypt K X \<in> analz (knows Spy evs);
+        K \<in> symKeys; evs \<in> set_mr |] ==> Key K \<in> used evs"
+by (blast intro: Crypt_parts_imp_used)
+
+text{*Rewriting rule for private encryption keys.  Analogous rewriting rules
+for other keys aren't needed.*}
+
+lemma parts_image_priEK:
+     "[|Key (priEK (CA i)) \<in> parts (Key`KK Un (knows Spy evs));
+        evs \<in> set_mr|] ==> priEK (CA i) \<in> KK | CA i \<in> bad"
+by auto
+
+text{*trivial proof because (priEK (CA i)) never appears even in (parts evs)*}
+lemma analz_image_priEK:
+     "evs \<in> set_mr ==>
+          (Key (priEK (CA i)) \<in> analz (Key`KK Un (knows Spy evs))) =
+          (priEK (CA i) \<in> KK | CA i \<in> bad)"
+by (blast dest!: parts_image_priEK intro: analz_mono [THEN [2] rev_subsetD])
+
+
+subsection{*Secrecy of Session Keys*}
+
+text{*This holds because if (priEK (CA i)) appears in any traffic then it must
+  be known to the Spy, by @{text Spy_see_private_Key}*}
+lemma merK_neq_priEK:
+     "[|Key merK \<notin> analz (knows Spy evs);
+        Key merK \<in> parts (knows Spy evs);
+        evs \<in> set_mr|] ==> merK \<noteq> priEK C"
+by blast
+
+text{*Lemma for message 4: either merK is compromised (when we don't care)
+  or else merK hasn't been used to encrypt K.*}
+lemma msg4_priEK_disj:
+     "[|Gets B {|Crypt KM1
+                       (sign K {|Agent M, Nonce NM2, Key merSK, Key merEK|}),
+                 Y|} \<in> set evs;
+        evs \<in> set_mr|]
+  ==> (Key merSK \<in> analz (knows Spy evs) | merSK \<notin> range(\<lambda>C. priEK C))
+   &  (Key merEK \<in> analz (knows Spy evs) | merEK \<notin> range(\<lambda>C. priEK C))"
+apply (unfold sign_def)
+apply (blast dest: merK_neq_priEK)
+done
+
+
+lemma Key_analz_image_Key_lemma:
+     "P --> (Key K \<in> analz (Key`KK Un H)) --> (K\<in>KK | Key K \<in> analz H)
+      ==>
+      P --> (Key K \<in> analz (Key`KK Un H)) = (K\<in>KK | Key K \<in> analz H)"
+by (blast intro: analz_mono [THEN [2] rev_subsetD])
+
+lemma symKey_compromise:
+     "evs \<in> set_mr ==>
+      (\<forall>SK KK. SK \<in> symKeys \<longrightarrow> (\<forall>K \<in> KK. K \<notin> range(\<lambda>C. priEK C)) -->
+               (Key SK \<in> analz (Key`KK Un (knows Spy evs))) =
+               (SK \<in> KK | Key SK \<in> analz (knows Spy evs)))"
+apply (erule set_mr.induct)
+apply (safe del: impI intro!: Key_analz_image_Key_lemma [THEN impI])
+apply (drule_tac [7] msg4_priEK_disj)
+apply (frule_tac [6] Gets_certificate_valid)
+apply (safe del: impI)
+apply (simp_all del: image_insert image_Un imp_disjL
+         add: analz_image_keys_simps abbrev_simps analz_knows_absorb
+              analz_knows_absorb2 analz_Key_image_insert_eq notin_image_iff
+              Spy_analz_private_Key analz_image_priEK)
+  --{*5 seconds on a 1.6GHz machine*}
+apply spy_analz  --{*Fake*}
+apply auto  --{*Message 3*}
+done
+
+lemma symKey_secrecy [rule_format]:
+     "[|CA i \<notin> bad; K \<in> symKeys;  evs \<in> set_mr|]
+      ==> \<forall>X m. Says (Merchant m) (CA i) X \<in> set evs -->
+                Key K \<in> parts{X} -->
+                Merchant m \<notin> bad -->
+                Key K \<notin> analz (knows Spy evs)"
+apply (erule set_mr.induct)
+apply (drule_tac [7] msg4_priEK_disj)
+apply (frule_tac [6] Gets_certificate_valid)
+apply (safe del: impI)
+apply (simp_all del: image_insert image_Un imp_disjL
+         add: analz_image_keys_simps abbrev_simps analz_knows_absorb
+              analz_knows_absorb2 analz_Key_image_insert_eq
+              symKey_compromise notin_image_iff Spy_analz_private_Key
+              analz_image_priEK)
+apply spy_analz  --{*Fake*}
+apply force  --{*Message 1*}
+apply (auto intro: analz_into_parts [THEN usedI] in_parts_Says_imp_used)  --{*Message 3*}
+done
+
+subsection{*Unicity *}
+
+lemma msg4_Says_imp_Notes:
+ "[|Says (CA i) M {|sign (priSK (CA i)) {|Agent M, Nonce NM2, Agent (CA i)|},
+                    cert  M      merSK    onlySig (priSK (CA i)),
+                    cert  M      merEK    onlyEnc (priSK (CA i)),
+                    cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|} \<in> set evs;
+    evs \<in> set_mr |]
+  ==> Notes (CA i) (Key merSK) \<in> set evs
+   &  Notes (CA i) (Key merEK) \<in> set evs"
+apply (erule rev_mp)
+apply (erule set_mr.induct)
+apply (simp_all (no_asm_simp))
+done
+
+text{*Unicity of merSK wrt a given CA:
+  merSK uniquely identifies the other components, including merEK*}
+lemma merSK_unicity:
+ "[|Says (CA i) M {|sign (priSK(CA i)) {|Agent M, Nonce NM2, Agent (CA i)|},
+                    cert  M      merSK    onlySig (priSK (CA i)),
+                    cert  M      merEK    onlyEnc (priSK (CA i)),
+                    cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|} \<in> set evs;
+    Says (CA i) M' {|sign (priSK(CA i)) {|Agent M', Nonce NM2', Agent (CA i)|},
+                    cert  M'      merSK    onlySig (priSK (CA i)),
+                    cert  M'      merEK'    onlyEnc (priSK (CA i)),
+                    cert (CA i) (pubSK(CA i)) onlySig (priSK RCA)|} \<in> set evs;
+    evs \<in> set_mr |] ==> M=M' & NM2=NM2' & merEK=merEK'"
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule set_mr.induct)
+apply (simp_all (no_asm_simp))
+apply (blast dest!: msg4_Says_imp_Notes)
+done
+
+text{*Unicity of merEK wrt a given CA:
+  merEK uniquely identifies the other components, including merSK*}
+lemma merEK_unicity:
+ "[|Says (CA i) M {|sign (priSK(CA i)) {|Agent M, Nonce NM2, Agent (CA i)|},
+                    cert  M      merSK    onlySig (priSK (CA i)),
+                    cert  M      merEK    onlyEnc (priSK (CA i)),
+                    cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|} \<in> set evs;
+    Says (CA i) M' {|sign (priSK(CA i)) {|Agent M', Nonce NM2', Agent (CA i)|},
+                     cert  M'      merSK'    onlySig (priSK (CA i)),
+                     cert  M'      merEK    onlyEnc (priSK (CA i)),
+                     cert (CA i) (pubSK(CA i)) onlySig (priSK RCA)|} \<in> set evs;
+    evs \<in> set_mr |] 
+  ==> M=M' & NM2=NM2' & merSK=merSK'"
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule set_mr.induct)
+apply (simp_all (no_asm_simp))
+apply (blast dest!: msg4_Says_imp_Notes)
+done
+
+
+text{* -No interest on secrecy of nonces: they appear to be used
+    only for freshness.
+   -No interest on secrecy of merSK or merEK, as in CR.
+   -There's no equivalent of the PAN*}
+
+
+subsection{*Primary Goals of Merchant Registration *}
+
+subsubsection{*The merchant's certificates really were created by the CA,
+provided the CA is uncompromised *}
+
+text{*The assumption @{term "CA i \<noteq> RCA"} is required: step 2 uses 
+  certificates of the same form.*}
+lemma certificate_merSK_valid_lemma [intro]:
+     "[|Crypt (priSK (CA i)) {|Agent M, Key merSK, onlySig|}
+          \<in> parts (knows Spy evs);
+        CA i \<notin> bad;  CA i \<noteq> RCA;  evs \<in> set_mr|]
+ ==> \<exists>X Y Z. Says (CA i) M
+                  {|X, cert M merSK onlySig (priSK (CA i)), Y, Z|} \<in> set evs"
+apply (erule rev_mp)
+apply (erule set_mr.induct)
+apply (simp_all (no_asm_simp))
+apply auto
+done
+
+lemma certificate_merSK_valid:
+     "[| cert M merSK onlySig (priSK (CA i)) \<in> parts (knows Spy evs);
+         CA i \<notin> bad;  CA i \<noteq> RCA;  evs \<in> set_mr|]
+ ==> \<exists>X Y Z. Says (CA i) M
+                  {|X, cert M merSK onlySig (priSK (CA i)), Y, Z|} \<in> set evs"
+by auto
+
+lemma certificate_merEK_valid_lemma [intro]:
+     "[|Crypt (priSK (CA i)) {|Agent M, Key merEK, onlyEnc|}
+          \<in> parts (knows Spy evs);
+        CA i \<notin> bad;  CA i \<noteq> RCA;  evs \<in> set_mr|]
+ ==> \<exists>X Y Z. Says (CA i) M
+                  {|X, Y, cert M merEK onlyEnc (priSK (CA i)), Z|} \<in> set evs"
+apply (erule rev_mp)
+apply (erule set_mr.induct)
+apply (simp_all (no_asm_simp))
+apply auto
+done
+
+lemma certificate_merEK_valid:
+     "[| cert M merEK onlyEnc (priSK (CA i)) \<in> parts (knows Spy evs);
+         CA i \<notin> bad;  CA i \<noteq> RCA;  evs \<in> set_mr|]
+ ==> \<exists>X Y Z. Says (CA i) M
+                  {|X, Y, cert M merEK onlyEnc (priSK (CA i)), Z|} \<in> set evs"
+by auto
+
+text{*The two certificates - for merSK and for merEK - cannot be proved to
+  have originated together*}
+
+end
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/SET_Protocol/Message_SET.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/SET_Protocol/Message_SET.thy	Tue Oct 20 20:03:23 2009 +0200
@@ -0,0 +1,957 @@
+(*  Title:      HOL/SET_Protocol/Message_SET.thy
+    Author:     Giampaolo Bella
+    Author:     Fabio Massacci
+    Author:     Lawrence C Paulson
+*)
+
+header{*The Message Theory, Modified for SET*}
+
+theory Message_SET
+imports Main Nat_Int_Bij
+begin
+
+subsection{*General Lemmas*}
+
+text{*Needed occasionally with @{text spy_analz_tac}, e.g. in
+     @{text analz_insert_Key_newK}*}
+
+lemma Un_absorb3 [simp] : "A \<union> (B \<union> A) = B \<union> A"
+by blast
+
+text{*Collapses redundant cases in the huge protocol proofs*}
+lemmas disj_simps = disj_comms disj_left_absorb disj_assoc 
+
+text{*Effective with assumptions like @{term "K \<notin> range pubK"} and 
+   @{term "K \<notin> invKey`range pubK"}*}
+lemma notin_image_iff: "(y \<notin> f`I) = (\<forall>i\<in>I. f i \<noteq> y)"
+by blast
+
+text{*Effective with the assumption @{term "KK \<subseteq> - (range(invKey o pubK))"} *}
+lemma disjoint_image_iff: "(A <= - (f`I)) = (\<forall>i\<in>I. f i \<notin> A)"
+by blast
+
+
+
+types
+  key = nat
+
+consts
+  all_symmetric :: bool        --{*true if all keys are symmetric*}
+  invKey        :: "key=>key"  --{*inverse of a symmetric key*}
+
+specification (invKey)
+  invKey [simp]: "invKey (invKey K) = K"
+  invKey_symmetric: "all_symmetric --> invKey = id"
+    by (rule exI [of _ id], auto)
+
+
+text{*The inverse of a symmetric key is itself; that of a public key
+      is the private key and vice versa*}
+
+constdefs
+  symKeys :: "key set"
+  "symKeys == {K. invKey K = K}"
+
+text{*Agents. We allow any number of certification authorities, cardholders
+            merchants, and payment gateways.*}
+datatype
+  agent = CA nat | Cardholder nat | Merchant nat | PG nat | Spy
+
+text{*Messages*}
+datatype
+     msg = Agent  agent     --{*Agent names*}
+         | Number nat       --{*Ordinary integers, timestamps, ...*}
+         | Nonce  nat       --{*Unguessable nonces*}
+         | Pan    nat       --{*Unguessable Primary Account Numbers (??)*}
+         | Key    key       --{*Crypto keys*}
+         | Hash   msg       --{*Hashing*}
+         | MPair  msg msg   --{*Compound messages*}
+         | Crypt  key msg   --{*Encryption, public- or shared-key*}
+
+
+(*Concrete syntax: messages appear as {|A,B,NA|}, etc...*)
+syntax
+  "@MTuple"      :: "['a, args] => 'a * 'b"       ("(2{|_,/ _|})")
+
+syntax (xsymbols)
+  "@MTuple"      :: "['a, args] => 'a * 'b"       ("(2\<lbrace>_,/ _\<rbrace>)")
+
+translations
+  "{|x, y, z|}"   == "{|x, {|y, z|}|}"
+  "{|x, y|}"      == "MPair x y"
+
+
+constdefs
+  nat_of_agent :: "agent => nat"
+   "nat_of_agent == agent_case (curry nat2_to_nat 0)
+                               (curry nat2_to_nat 1)
+                               (curry nat2_to_nat 2)
+                               (curry nat2_to_nat 3)
+                               (nat2_to_nat (4,0))"
+    --{*maps each agent to a unique natural number, for specifications*}
+
+text{*The function is indeed injective*}
+lemma inj_nat_of_agent: "inj nat_of_agent"
+by (simp add: nat_of_agent_def inj_on_def curry_def
+              nat2_to_nat_inj [THEN inj_eq]  split: agent.split) 
+
+
+constdefs
+  (*Keys useful to decrypt elements of a message set*)
+  keysFor :: "msg set => key set"
+  "keysFor H == invKey ` {K. \<exists>X. Crypt K X \<in> H}"
+
+subsubsection{*Inductive definition of all "parts" of a message.*}
+
+inductive_set
+  parts :: "msg set => msg set"
+  for H :: "msg set"
+  where
+    Inj [intro]:               "X \<in> H ==> X \<in> parts H"
+  | Fst:         "{|X,Y|}   \<in> parts H ==> X \<in> parts H"
+  | Snd:         "{|X,Y|}   \<in> parts H ==> Y \<in> parts H"
+  | Body:        "Crypt K X \<in> parts H ==> X \<in> parts H"
+
+
+(*Monotonicity*)
+lemma parts_mono: "G<=H ==> parts(G) <= parts(H)"
+apply auto
+apply (erule parts.induct)
+apply (auto dest: Fst Snd Body)
+done
+
+
+subsubsection{*Inverse of keys*}
+
+(*Equations hold because constructors are injective; cannot prove for all f*)
+lemma Key_image_eq [simp]: "(Key x \<in> Key`A) = (x\<in>A)"
+by auto
+
+lemma Nonce_Key_image_eq [simp]: "(Nonce x \<notin> Key`A)"
+by auto
+
+lemma Cardholder_image_eq [simp]: "(Cardholder x \<in> Cardholder`A) = (x \<in> A)"
+by auto
+
+lemma CA_image_eq [simp]: "(CA x \<in> CA`A) = (x \<in> A)"
+by auto
+
+lemma Pan_image_eq [simp]: "(Pan x \<in> Pan`A) = (x \<in> A)"
+by auto
+
+lemma Pan_Key_image_eq [simp]: "(Pan x \<notin> Key`A)"
+by auto
+
+lemma Nonce_Pan_image_eq [simp]: "(Nonce x \<notin> Pan`A)"
+by auto
+
+lemma invKey_eq [simp]: "(invKey K = invKey K') = (K=K')"
+apply safe
+apply (drule_tac f = invKey in arg_cong, simp)
+done
+
+
+subsection{*keysFor operator*}
+
+lemma keysFor_empty [simp]: "keysFor {} = {}"
+by (unfold keysFor_def, blast)
+
+lemma keysFor_Un [simp]: "keysFor (H \<union> H') = keysFor H \<union> keysFor H'"
+by (unfold keysFor_def, blast)
+
+lemma keysFor_UN [simp]: "keysFor (\<Union>i\<in>A. H i) = (\<Union>i\<in>A. keysFor (H i))"
+by (unfold keysFor_def, blast)
+
+(*Monotonicity*)
+lemma keysFor_mono: "G\<subseteq>H ==> keysFor(G) \<subseteq> keysFor(H)"
+by (unfold keysFor_def, blast)
+
+lemma keysFor_insert_Agent [simp]: "keysFor (insert (Agent A) H) = keysFor H"
+by (unfold keysFor_def, auto)
+
+lemma keysFor_insert_Nonce [simp]: "keysFor (insert (Nonce N) H) = keysFor H"
+by (unfold keysFor_def, auto)
+
+lemma keysFor_insert_Number [simp]: "keysFor (insert (Number N) H) = keysFor H"
+by (unfold keysFor_def, auto)
+
+lemma keysFor_insert_Key [simp]: "keysFor (insert (Key K) H) = keysFor H"
+by (unfold keysFor_def, auto)
+
+lemma keysFor_insert_Pan [simp]: "keysFor (insert (Pan A) H) = keysFor H"
+by (unfold keysFor_def, auto)
+
+lemma keysFor_insert_Hash [simp]: "keysFor (insert (Hash X) H) = keysFor H"
+by (unfold keysFor_def, auto)
+
+lemma keysFor_insert_MPair [simp]: "keysFor (insert {|X,Y|} H) = keysFor H"
+by (unfold keysFor_def, auto)
+
+lemma keysFor_insert_Crypt [simp]:
+    "keysFor (insert (Crypt K X) H) = insert (invKey K) (keysFor H)"
+by (unfold keysFor_def, auto)
+
+lemma keysFor_image_Key [simp]: "keysFor (Key`E) = {}"
+by (unfold keysFor_def, auto)
+
+lemma Crypt_imp_invKey_keysFor: "Crypt K X \<in> H ==> invKey K \<in> keysFor H"
+by (unfold keysFor_def, blast)
+
+
+subsection{*Inductive relation "parts"*}
+
+lemma MPair_parts:
+     "[| {|X,Y|} \<in> parts H;
+         [| X \<in> parts H; Y \<in> parts H |] ==> P |] ==> P"
+by (blast dest: parts.Fst parts.Snd)
+
+declare MPair_parts [elim!]  parts.Body [dest!]
+text{*NB These two rules are UNSAFE in the formal sense, as they discard the
+     compound message.  They work well on THIS FILE.
+  @{text MPair_parts} is left as SAFE because it speeds up proofs.
+  The Crypt rule is normally kept UNSAFE to avoid breaking up certificates.*}
+
+lemma parts_increasing: "H \<subseteq> parts(H)"
+by blast
+
+lemmas parts_insertI = subset_insertI [THEN parts_mono, THEN subsetD, standard]
+
+lemma parts_empty [simp]: "parts{} = {}"
+apply safe
+apply (erule parts.induct, blast+)
+done
+
+lemma parts_emptyE [elim!]: "X\<in> parts{} ==> P"
+by simp
+
+(*WARNING: loops if H = {Y}, therefore must not be repeated!*)
+lemma parts_singleton: "X\<in> parts H ==> \<exists>Y\<in>H. X\<in> parts {Y}"
+by (erule parts.induct, fast+)
+
+
+subsubsection{*Unions*}
+
+lemma parts_Un_subset1: "parts(G) \<union> parts(H) \<subseteq> parts(G \<union> H)"
+by (intro Un_least parts_mono Un_upper1 Un_upper2)
+
+lemma parts_Un_subset2: "parts(G \<union> H) \<subseteq> parts(G) \<union> parts(H)"
+apply (rule subsetI)
+apply (erule parts.induct, blast+)
+done
+
+lemma parts_Un [simp]: "parts(G \<union> H) = parts(G) \<union> parts(H)"
+by (intro equalityI parts_Un_subset1 parts_Un_subset2)
+
+lemma parts_insert: "parts (insert X H) = parts {X} \<union> parts H"
+apply (subst insert_is_Un [of _ H])
+apply (simp only: parts_Un)
+done
+
+(*TWO inserts to avoid looping.  This rewrite is better than nothing.
+  Not suitable for Addsimps: its behaviour can be strange.*)
+lemma parts_insert2:
+     "parts (insert X (insert Y H)) = parts {X} \<union> parts {Y} \<union> parts H"
+apply (simp add: Un_assoc)
+apply (simp add: parts_insert [symmetric])
+done
+
+lemma parts_UN_subset1: "(\<Union>x\<in>A. parts(H x)) \<subseteq> parts(\<Union>x\<in>A. H x)"
+by (intro UN_least parts_mono UN_upper)
+
+lemma parts_UN_subset2: "parts(\<Union>x\<in>A. H x) \<subseteq> (\<Union>x\<in>A. parts(H x))"
+apply (rule subsetI)
+apply (erule parts.induct, blast+)
+done
+
+lemma parts_UN [simp]: "parts(\<Union>x\<in>A. H x) = (\<Union>x\<in>A. parts(H x))"
+by (intro equalityI parts_UN_subset1 parts_UN_subset2)
+
+(*Added to simplify arguments to parts, analz and synth.
+  NOTE: the UN versions are no longer used!*)
+
+
+text{*This allows @{text blast} to simplify occurrences of
+  @{term "parts(G\<union>H)"} in the assumption.*}
+declare parts_Un [THEN equalityD1, THEN subsetD, THEN UnE, elim!]
+
+
+lemma parts_insert_subset: "insert X (parts H) \<subseteq> parts(insert X H)"
+by (blast intro: parts_mono [THEN [2] rev_subsetD])
+
+subsubsection{*Idempotence and transitivity*}
+
+lemma parts_partsD [dest!]: "X\<in> parts (parts H) ==> X\<in> parts H"
+by (erule parts.induct, blast+)
+
+lemma parts_idem [simp]: "parts (parts H) = parts H"
+by blast
+
+lemma parts_trans: "[| X\<in> parts G;  G \<subseteq> parts H |] ==> X\<in> parts H"
+by (drule parts_mono, blast)
+
+(*Cut*)
+lemma parts_cut:
+     "[| Y\<in> parts (insert X G);  X\<in> parts H |] ==> Y\<in> parts (G \<union> H)"
+by (erule parts_trans, auto)
+
+lemma parts_cut_eq [simp]: "X\<in> parts H ==> parts (insert X H) = parts H"
+by (force dest!: parts_cut intro: parts_insertI)
+
+
+subsubsection{*Rewrite rules for pulling out atomic messages*}
+
+lemmas parts_insert_eq_I = equalityI [OF subsetI parts_insert_subset]
+
+
+lemma parts_insert_Agent [simp]:
+     "parts (insert (Agent agt) H) = insert (Agent agt) (parts H)"
+apply (rule parts_insert_eq_I)
+apply (erule parts.induct, auto)
+done
+
+lemma parts_insert_Nonce [simp]:
+     "parts (insert (Nonce N) H) = insert (Nonce N) (parts H)"
+apply (rule parts_insert_eq_I)
+apply (erule parts.induct, auto)
+done
+
+lemma parts_insert_Number [simp]:
+     "parts (insert (Number N) H) = insert (Number N) (parts H)"
+apply (rule parts_insert_eq_I)
+apply (erule parts.induct, auto)
+done
+
+lemma parts_insert_Key [simp]:
+     "parts (insert (Key K) H) = insert (Key K) (parts H)"
+apply (rule parts_insert_eq_I)
+apply (erule parts.induct, auto)
+done
+
+lemma parts_insert_Pan [simp]:
+     "parts (insert (Pan A) H) = insert (Pan A) (parts H)"
+apply (rule parts_insert_eq_I)
+apply (erule parts.induct, auto)
+done
+
+lemma parts_insert_Hash [simp]:
+     "parts (insert (Hash X) H) = insert (Hash X) (parts H)"
+apply (rule parts_insert_eq_I)
+apply (erule parts.induct, auto)
+done
+
+lemma parts_insert_Crypt [simp]:
+     "parts (insert (Crypt K X) H) =
+          insert (Crypt K X) (parts (insert X H))"
+apply (rule equalityI)
+apply (rule subsetI)
+apply (erule parts.induct, auto)
+apply (erule parts.induct)
+apply (blast intro: parts.Body)+
+done
+
+lemma parts_insert_MPair [simp]:
+     "parts (insert {|X,Y|} H) =
+          insert {|X,Y|} (parts (insert X (insert Y H)))"
+apply (rule equalityI)
+apply (rule subsetI)
+apply (erule parts.induct, auto)
+apply (erule parts.induct)
+apply (blast intro: parts.Fst parts.Snd)+
+done
+
+lemma parts_image_Key [simp]: "parts (Key`N) = Key`N"
+apply auto
+apply (erule parts.induct, auto)
+done
+
+lemma parts_image_Pan [simp]: "parts (Pan`A) = Pan`A"
+apply auto
+apply (erule parts.induct, auto)
+done
+
+
+(*In any message, there is an upper bound N on its greatest nonce.*)
+lemma msg_Nonce_supply: "\<exists>N. \<forall>n. N\<le>n --> Nonce n \<notin> parts {msg}"
+apply (induct_tac "msg")
+apply (simp_all (no_asm_simp) add: exI parts_insert2)
+(*MPair case: blast_tac works out the necessary sum itself!*)
+prefer 2 apply (blast elim!: add_leE)
+(*Nonce case*)
+apply (rule_tac x = "N + Suc nat" in exI)
+apply (auto elim!: add_leE)
+done
+
+(* Ditto, for numbers.*)
+lemma msg_Number_supply: "\<exists>N. \<forall>n. N<=n --> Number n \<notin> parts {msg}"
+apply (induct_tac "msg")
+apply (simp_all (no_asm_simp) add: exI parts_insert2)
+prefer 2 apply (blast elim!: add_leE)
+apply (rule_tac x = "N + Suc nat" in exI, auto)
+done
+
+subsection{*Inductive relation "analz"*}
+
+text{*Inductive definition of "analz" -- what can be broken down from a set of
+    messages, including keys.  A form of downward closure.  Pairs can
+    be taken apart; messages decrypted with known keys.*}
+
+inductive_set
+  analz :: "msg set => msg set"
+  for H :: "msg set"
+  where
+    Inj [intro,simp] :    "X \<in> H ==> X \<in> analz H"
+  | Fst:     "{|X,Y|} \<in> analz H ==> X \<in> analz H"
+  | Snd:     "{|X,Y|} \<in> analz H ==> Y \<in> analz H"
+  | Decrypt [dest]:
+             "[|Crypt K X \<in> analz H; Key(invKey K): analz H|] ==> X \<in> analz H"
+
+
+(*Monotonicity; Lemma 1 of Lowe's paper*)
+lemma analz_mono: "G<=H ==> analz(G) <= analz(H)"
+apply auto
+apply (erule analz.induct)
+apply (auto dest: Fst Snd)
+done
+
+text{*Making it safe speeds up proofs*}
+lemma MPair_analz [elim!]:
+     "[| {|X,Y|} \<in> analz H;
+             [| X \<in> analz H; Y \<in> analz H |] ==> P
+          |] ==> P"
+by (blast dest: analz.Fst analz.Snd)
+
+lemma analz_increasing: "H \<subseteq> analz(H)"
+by blast
+
+lemma analz_subset_parts: "analz H \<subseteq> parts H"
+apply (rule subsetI)
+apply (erule analz.induct, blast+)
+done
+
+lemmas analz_into_parts = analz_subset_parts [THEN subsetD, standard]
+
+lemmas not_parts_not_analz = analz_subset_parts [THEN contra_subsetD, standard]
+
+
+lemma parts_analz [simp]: "parts (analz H) = parts H"
+apply (rule equalityI)
+apply (rule analz_subset_parts [THEN parts_mono, THEN subset_trans], simp)
+apply (blast intro: analz_increasing [THEN parts_mono, THEN subsetD])
+done
+
+lemma analz_parts [simp]: "analz (parts H) = parts H"
+apply auto
+apply (erule analz.induct, auto)
+done
+
+lemmas analz_insertI = subset_insertI [THEN analz_mono, THEN [2] rev_subsetD, standard]
+
+subsubsection{*General equational properties*}
+
+lemma analz_empty [simp]: "analz{} = {}"
+apply safe
+apply (erule analz.induct, blast+)
+done
+
+(*Converse fails: we can analz more from the union than from the
+  separate parts, as a key in one might decrypt a message in the other*)
+lemma analz_Un: "analz(G) \<union> analz(H) \<subseteq> analz(G \<union> H)"
+by (intro Un_least analz_mono Un_upper1 Un_upper2)
+
+lemma analz_insert: "insert X (analz H) \<subseteq> analz(insert X H)"
+by (blast intro: analz_mono [THEN [2] rev_subsetD])
+
+subsubsection{*Rewrite rules for pulling out atomic messages*}
+
+lemmas analz_insert_eq_I = equalityI [OF subsetI analz_insert]
+
+lemma analz_insert_Agent [simp]:
+     "analz (insert (Agent agt) H) = insert (Agent agt) (analz H)"
+apply (rule analz_insert_eq_I)
+apply (erule analz.induct, auto)
+done
+
+lemma analz_insert_Nonce [simp]:
+     "analz (insert (Nonce N) H) = insert (Nonce N) (analz H)"
+apply (rule analz_insert_eq_I)
+apply (erule analz.induct, auto)
+done
+
+lemma analz_insert_Number [simp]:
+     "analz (insert (Number N) H) = insert (Number N) (analz H)"
+apply (rule analz_insert_eq_I)
+apply (erule analz.induct, auto)
+done
+
+lemma analz_insert_Hash [simp]:
+     "analz (insert (Hash X) H) = insert (Hash X) (analz H)"
+apply (rule analz_insert_eq_I)
+apply (erule analz.induct, auto)
+done
+
+(*Can only pull out Keys if they are not needed to decrypt the rest*)
+lemma analz_insert_Key [simp]:
+    "K \<notin> keysFor (analz H) ==>
+          analz (insert (Key K) H) = insert (Key K) (analz H)"
+apply (unfold keysFor_def)
+apply (rule analz_insert_eq_I)
+apply (erule analz.induct, auto)
+done
+
+lemma analz_insert_MPair [simp]:
+     "analz (insert {|X,Y|} H) =
+          insert {|X,Y|} (analz (insert X (insert Y H)))"
+apply (rule equalityI)
+apply (rule subsetI)
+apply (erule analz.induct, auto)
+apply (erule analz.induct)
+apply (blast intro: analz.Fst analz.Snd)+
+done
+
+(*Can pull out enCrypted message if the Key is not known*)
+lemma analz_insert_Crypt:
+     "Key (invKey K) \<notin> analz H
+      ==> analz (insert (Crypt K X) H) = insert (Crypt K X) (analz H)"
+apply (rule analz_insert_eq_I)
+apply (erule analz.induct, auto)
+done
+
+lemma analz_insert_Pan [simp]:
+     "analz (insert (Pan A) H) = insert (Pan A) (analz H)"
+apply (rule analz_insert_eq_I)
+apply (erule analz.induct, auto)
+done
+
+lemma lemma1: "Key (invKey K) \<in> analz H ==>
+               analz (insert (Crypt K X) H) \<subseteq>
+               insert (Crypt K X) (analz (insert X H))"
+apply (rule subsetI)
+apply (erule_tac x = x in analz.induct, auto)
+done
+
+lemma lemma2: "Key (invKey K) \<in> analz H ==>
+               insert (Crypt K X) (analz (insert X H)) \<subseteq>
+               analz (insert (Crypt K X) H)"
+apply auto
+apply (erule_tac x = x in analz.induct, auto)
+apply (blast intro: analz_insertI analz.Decrypt)
+done
+
+lemma analz_insert_Decrypt:
+     "Key (invKey K) \<in> analz H ==>
+               analz (insert (Crypt K X) H) =
+               insert (Crypt K X) (analz (insert X H))"
+by (intro equalityI lemma1 lemma2)
+
+(*Case analysis: either the message is secure, or it is not!
+  Effective, but can cause subgoals to blow up!
+  Use with split_if;  apparently split_tac does not cope with patterns
+  such as "analz (insert (Crypt K X) H)" *)
+lemma analz_Crypt_if [simp]:
+     "analz (insert (Crypt K X) H) =
+          (if (Key (invKey K) \<in> analz H)
+           then insert (Crypt K X) (analz (insert X H))
+           else insert (Crypt K X) (analz H))"
+by (simp add: analz_insert_Crypt analz_insert_Decrypt)
+
+
+(*This rule supposes "for the sake of argument" that we have the key.*)
+lemma analz_insert_Crypt_subset:
+     "analz (insert (Crypt K X) H) \<subseteq>
+           insert (Crypt K X) (analz (insert X H))"
+apply (rule subsetI)
+apply (erule analz.induct, auto)
+done
+
+lemma analz_image_Key [simp]: "analz (Key`N) = Key`N"
+apply auto
+apply (erule analz.induct, auto)
+done
+
+lemma analz_image_Pan [simp]: "analz (Pan`A) = Pan`A"
+apply auto
+apply (erule analz.induct, auto)
+done
+
+
+subsubsection{*Idempotence and transitivity*}
+
+lemma analz_analzD [dest!]: "X\<in> analz (analz H) ==> X\<in> analz H"
+by (erule analz.induct, blast+)
+
+lemma analz_idem [simp]: "analz (analz H) = analz H"
+by blast
+
+lemma analz_trans: "[| X\<in> analz G;  G \<subseteq> analz H |] ==> X\<in> analz H"
+by (drule analz_mono, blast)
+
+(*Cut; Lemma 2 of Lowe*)
+lemma analz_cut: "[| Y\<in> analz (insert X H);  X\<in> analz H |] ==> Y\<in> analz H"
+by (erule analz_trans, blast)
+
+(*Cut can be proved easily by induction on
+   "Y: analz (insert X H) ==> X: analz H --> Y: analz H"
+*)
+
+(*This rewrite rule helps in the simplification of messages that involve
+  the forwarding of unknown components (X).  Without it, removing occurrences
+  of X can be very complicated. *)
+lemma analz_insert_eq: "X\<in> analz H ==> analz (insert X H) = analz H"
+by (blast intro: analz_cut analz_insertI)
+
+
+text{*A congruence rule for "analz"*}
+
+lemma analz_subset_cong:
+     "[| analz G \<subseteq> analz G'; analz H \<subseteq> analz H'
+               |] ==> analz (G \<union> H) \<subseteq> analz (G' \<union> H')"
+apply clarify
+apply (erule analz.induct)
+apply (best intro: analz_mono [THEN subsetD])+
+done
+
+lemma analz_cong:
+     "[| analz G = analz G'; analz H = analz H'
+               |] ==> analz (G \<union> H) = analz (G' \<union> H')"
+by (intro equalityI analz_subset_cong, simp_all)
+
+lemma analz_insert_cong:
+     "analz H = analz H' ==> analz(insert X H) = analz(insert X H')"
+by (force simp only: insert_def intro!: analz_cong)
+
+(*If there are no pairs or encryptions then analz does nothing*)
+lemma analz_trivial:
+     "[| \<forall>X Y. {|X,Y|} \<notin> H;  \<forall>X K. Crypt K X \<notin> H |] ==> analz H = H"
+apply safe
+apply (erule analz.induct, blast+)
+done
+
+(*These two are obsolete (with a single Spy) but cost little to prove...*)
+lemma analz_UN_analz_lemma:
+     "X\<in> analz (\<Union>i\<in>A. analz (H i)) ==> X\<in> analz (\<Union>i\<in>A. H i)"
+apply (erule analz.induct)
+apply (blast intro: analz_mono [THEN [2] rev_subsetD])+
+done
+
+lemma analz_UN_analz [simp]: "analz (\<Union>i\<in>A. analz (H i)) = analz (\<Union>i\<in>A. H i)"
+by (blast intro: analz_UN_analz_lemma analz_mono [THEN [2] rev_subsetD])
+
+
+subsection{*Inductive relation "synth"*}
+
+text{*Inductive definition of "synth" -- what can be built up from a set of
+    messages.  A form of upward closure.  Pairs can be built, messages
+    encrypted with known keys.  Agent names are public domain.
+    Numbers can be guessed, but Nonces cannot be.*}
+
+inductive_set
+  synth :: "msg set => msg set"
+  for H :: "msg set"
+  where
+    Inj    [intro]:   "X \<in> H ==> X \<in> synth H"
+  | Agent  [intro]:   "Agent agt \<in> synth H"
+  | Number [intro]:   "Number n  \<in> synth H"
+  | Hash   [intro]:   "X \<in> synth H ==> Hash X \<in> synth H"
+  | MPair  [intro]:   "[|X \<in> synth H;  Y \<in> synth H|] ==> {|X,Y|} \<in> synth H"
+  | Crypt  [intro]:   "[|X \<in> synth H;  Key(K) \<in> H|] ==> Crypt K X \<in> synth H"
+
+(*Monotonicity*)
+lemma synth_mono: "G<=H ==> synth(G) <= synth(H)"
+apply auto
+apply (erule synth.induct)
+apply (auto dest: Fst Snd Body)
+done
+
+(*NO Agent_synth, as any Agent name can be synthesized.  Ditto for Number*)
+inductive_cases Nonce_synth [elim!]: "Nonce n \<in> synth H"
+inductive_cases Key_synth   [elim!]: "Key K \<in> synth H"
+inductive_cases Hash_synth  [elim!]: "Hash X \<in> synth H"
+inductive_cases MPair_synth [elim!]: "{|X,Y|} \<in> synth H"
+inductive_cases Crypt_synth [elim!]: "Crypt K X \<in> synth H"
+inductive_cases Pan_synth   [elim!]: "Pan A \<in> synth H"
+
+
+lemma synth_increasing: "H \<subseteq> synth(H)"
+by blast
+
+subsubsection{*Unions*}
+
+(*Converse fails: we can synth more from the union than from the
+  separate parts, building a compound message using elements of each.*)
+lemma synth_Un: "synth(G) \<union> synth(H) \<subseteq> synth(G \<union> H)"
+by (intro Un_least synth_mono Un_upper1 Un_upper2)
+
+lemma synth_insert: "insert X (synth H) \<subseteq> synth(insert X H)"
+by (blast intro: synth_mono [THEN [2] rev_subsetD])
+
+subsubsection{*Idempotence and transitivity*}
+
+lemma synth_synthD [dest!]: "X\<in> synth (synth H) ==> X\<in> synth H"
+by (erule synth.induct, blast+)
+
+lemma synth_idem: "synth (synth H) = synth H"
+by blast
+
+lemma synth_trans: "[| X\<in> synth G;  G \<subseteq> synth H |] ==> X\<in> synth H"
+by (drule synth_mono, blast)
+
+(*Cut; Lemma 2 of Lowe*)
+lemma synth_cut: "[| Y\<in> synth (insert X H);  X\<in> synth H |] ==> Y\<in> synth H"
+by (erule synth_trans, blast)
+
+lemma Agent_synth [simp]: "Agent A \<in> synth H"
+by blast
+
+lemma Number_synth [simp]: "Number n \<in> synth H"
+by blast
+
+lemma Nonce_synth_eq [simp]: "(Nonce N \<in> synth H) = (Nonce N \<in> H)"
+by blast
+
+lemma Key_synth_eq [simp]: "(Key K \<in> synth H) = (Key K \<in> H)"
+by blast
+
+lemma Crypt_synth_eq [simp]: "Key K \<notin> H ==> (Crypt K X \<in> synth H) = (Crypt K X \<in> H)"
+by blast
+
+lemma Pan_synth_eq [simp]: "(Pan A \<in> synth H) = (Pan A \<in> H)"
+by blast
+
+lemma keysFor_synth [simp]:
+    "keysFor (synth H) = keysFor H \<union> invKey`{K. Key K \<in> H}"
+by (unfold keysFor_def, blast)
+
+
+subsubsection{*Combinations of parts, analz and synth*}
+
+lemma parts_synth [simp]: "parts (synth H) = parts H \<union> synth H"
+apply (rule equalityI)
+apply (rule subsetI)
+apply (erule parts.induct)
+apply (blast intro: synth_increasing [THEN parts_mono, THEN subsetD]
+                    parts.Fst parts.Snd parts.Body)+
+done
+
+lemma analz_analz_Un [simp]: "analz (analz G \<union> H) = analz (G \<union> H)"
+apply (intro equalityI analz_subset_cong)+
+apply simp_all
+done
+
+lemma analz_synth_Un [simp]: "analz (synth G \<union> H) = analz (G \<union> H) \<union> synth G"
+apply (rule equalityI)
+apply (rule subsetI)
+apply (erule analz.induct)
+prefer 5 apply (blast intro: analz_mono [THEN [2] rev_subsetD])
+apply (blast intro: analz.Fst analz.Snd analz.Decrypt)+
+done
+
+lemma analz_synth [simp]: "analz (synth H) = analz H \<union> synth H"
+apply (cut_tac H = "{}" in analz_synth_Un)
+apply (simp (no_asm_use))
+done
+
+
+subsubsection{*For reasoning about the Fake rule in traces*}
+
+lemma parts_insert_subset_Un: "X\<in> G ==> parts(insert X H) \<subseteq> parts G \<union> parts H"
+by (rule subset_trans [OF parts_mono parts_Un_subset2], blast)
+
+(*More specifically for Fake.  Very occasionally we could do with a version
+  of the form  parts{X} \<subseteq> synth (analz H) \<union> parts H *)
+lemma Fake_parts_insert: "X \<in> synth (analz H) ==>
+      parts (insert X H) \<subseteq> synth (analz H) \<union> parts H"
+apply (drule parts_insert_subset_Un)
+apply (simp (no_asm_use))
+apply blast
+done
+
+lemma Fake_parts_insert_in_Un:
+     "[|Z \<in> parts (insert X H);  X: synth (analz H)|] 
+      ==> Z \<in>  synth (analz H) \<union> parts H";
+by (blast dest: Fake_parts_insert [THEN subsetD, dest])
+
+(*H is sometimes (Key ` KK \<union> spies evs), so can't put G=H*)
+lemma Fake_analz_insert:
+     "X\<in> synth (analz G) ==>
+      analz (insert X H) \<subseteq> synth (analz G) \<union> analz (G \<union> H)"
+apply (rule subsetI)
+apply (subgoal_tac "x \<in> analz (synth (analz G) \<union> H) ")
+prefer 2 apply (blast intro: analz_mono [THEN [2] rev_subsetD] analz_mono [THEN synth_mono, THEN [2] rev_subsetD])
+apply (simp (no_asm_use))
+apply blast
+done
+
+lemma analz_conj_parts [simp]:
+     "(X \<in> analz H & X \<in> parts H) = (X \<in> analz H)"
+by (blast intro: analz_subset_parts [THEN subsetD])
+
+lemma analz_disj_parts [simp]:
+     "(X \<in> analz H | X \<in> parts H) = (X \<in> parts H)"
+by (blast intro: analz_subset_parts [THEN subsetD])
+
+(*Without this equation, other rules for synth and analz would yield
+  redundant cases*)
+lemma MPair_synth_analz [iff]:
+     "({|X,Y|} \<in> synth (analz H)) =
+      (X \<in> synth (analz H) & Y \<in> synth (analz H))"
+by blast
+
+lemma Crypt_synth_analz:
+     "[| Key K \<in> analz H;  Key (invKey K) \<in> analz H |]
+       ==> (Crypt K X \<in> synth (analz H)) = (X \<in> synth (analz H))"
+by blast
+
+
+lemma Hash_synth_analz [simp]:
+     "X \<notin> synth (analz H)
+      ==> (Hash{|X,Y|} \<in> synth (analz H)) = (Hash{|X,Y|} \<in> analz H)"
+by blast
+
+
+(*We do NOT want Crypt... messages broken up in protocols!!*)
+declare parts.Body [rule del]
+
+
+text{*Rewrites to push in Key and Crypt messages, so that other messages can
+    be pulled out using the @{text analz_insert} rules*}
+
+lemmas pushKeys [standard] =
+  insert_commute [of "Key K" "Agent C"]
+  insert_commute [of "Key K" "Nonce N"]
+  insert_commute [of "Key K" "Number N"]
+  insert_commute [of "Key K" "Pan PAN"]
+  insert_commute [of "Key K" "Hash X"]
+  insert_commute [of "Key K" "MPair X Y"]
+  insert_commute [of "Key K" "Crypt X K'"]
+
+lemmas pushCrypts [standard] =
+  insert_commute [of "Crypt X K" "Agent C"]
+  insert_commute [of "Crypt X K" "Nonce N"]
+  insert_commute [of "Crypt X K" "Number N"]
+  insert_commute [of "Crypt X K" "Pan PAN"]
+  insert_commute [of "Crypt X K" "Hash X'"]
+  insert_commute [of "Crypt X K" "MPair X' Y"]
+
+text{*Cannot be added with @{text "[simp]"} -- messages should not always be
+  re-ordered.*}
+lemmas pushes = pushKeys pushCrypts
+
+
+subsection{*Tactics useful for many protocol proofs*}
+(*<*)
+ML
+{*
+structure MessageSET =
+struct
+
+(*Prove base case (subgoal i) and simplify others.  A typical base case
+  concerns  Crypt K X \<notin> Key`shrK`bad  and cannot be proved by rewriting
+  alone.*)
+fun prove_simple_subgoals_tac (cs, ss) i =
+    force_tac (cs, ss addsimps [@{thm image_eq_UN}]) i THEN
+    ALLGOALS (asm_simp_tac ss)
+
+(*Analysis of Fake cases.  Also works for messages that forward unknown parts,
+  but this application is no longer necessary if analz_insert_eq is used.
+  Abstraction over i is ESSENTIAL: it delays the dereferencing of claset
+  DEPENDS UPON "X" REFERRING TO THE FRADULENT MESSAGE *)
+
+fun impOfSubs th = th RSN (2, @{thm rev_subsetD})
+
+(*Apply rules to break down assumptions of the form
+  Y \<in> parts(insert X H)  and  Y \<in> analz(insert X H)
+*)
+val Fake_insert_tac =
+    dresolve_tac [impOfSubs @{thm Fake_analz_insert},
+                  impOfSubs @{thm Fake_parts_insert}] THEN'
+    eresolve_tac [asm_rl, @{thm synth.Inj}];
+
+fun Fake_insert_simp_tac ss i =
+    REPEAT (Fake_insert_tac i) THEN asm_full_simp_tac ss i;
+
+fun atomic_spy_analz_tac (cs,ss) = SELECT_GOAL
+    (Fake_insert_simp_tac ss 1
+     THEN
+     IF_UNSOLVED (Blast.depth_tac
+                  (cs addIs [@{thm analz_insertI},
+                                   impOfSubs @{thm analz_subset_parts}]) 4 1))
+
+fun spy_analz_tac (cs,ss) i =
+  DETERM
+   (SELECT_GOAL
+     (EVERY
+      [  (*push in occurrences of X...*)
+       (REPEAT o CHANGED)
+           (res_inst_tac (Simplifier.the_context ss)
+             [(("x", 1), "X")] (insert_commute RS ssubst) 1),
+       (*...allowing further simplifications*)
+       simp_tac ss 1,
+       REPEAT (FIRSTGOAL (resolve_tac [allI,impI,notI,conjI,iffI])),
+       DEPTH_SOLVE (atomic_spy_analz_tac (cs,ss) 1)]) i)
+
+end
+*}
+(*>*)
+
+
+(*By default only o_apply is built-in.  But in the presence of eta-expansion
+  this means that some terms displayed as (f o g) will be rewritten, and others
+  will not!*)
+declare o_def [simp]
+
+
+lemma Crypt_notin_image_Key [simp]: "Crypt K X \<notin> Key ` A"
+by auto
+
+lemma Hash_notin_image_Key [simp] :"Hash X \<notin> Key ` A"
+by auto
+
+lemma synth_analz_mono: "G<=H ==> synth (analz(G)) <= synth (analz(H))"
+by (simp add: synth_mono analz_mono)
+
+lemma Fake_analz_eq [simp]:
+     "X \<in> synth(analz H) ==> synth (analz (insert X H)) = synth (analz H)"
+apply (drule Fake_analz_insert[of _ _ "H"])
+apply (simp add: synth_increasing[THEN Un_absorb2])
+apply (drule synth_mono)
+apply (simp add: synth_idem)
+apply (blast intro: synth_analz_mono [THEN [2] rev_subsetD])
+done
+
+text{*Two generalizations of @{text analz_insert_eq}*}
+lemma gen_analz_insert_eq [rule_format]:
+     "X \<in> analz H ==> ALL G. H \<subseteq> G --> analz (insert X G) = analz G";
+by (blast intro: analz_cut analz_insertI analz_mono [THEN [2] rev_subsetD])
+
+lemma synth_analz_insert_eq [rule_format]:
+     "X \<in> synth (analz H)
+      ==> ALL G. H \<subseteq> G --> (Key K \<in> analz (insert X G)) = (Key K \<in> analz G)";
+apply (erule synth.induct)
+apply (simp_all add: gen_analz_insert_eq subset_trans [OF _ subset_insertI])
+done
+
+lemma Fake_parts_sing:
+     "X \<in> synth (analz H) ==> parts{X} \<subseteq> synth (analz H) \<union> parts H";
+apply (rule subset_trans)
+ apply (erule_tac [2] Fake_parts_insert)
+apply (simp add: parts_mono)
+done
+
+lemmas Fake_parts_sing_imp_Un = Fake_parts_sing [THEN [2] rev_subsetD]
+
+method_setup spy_analz = {*
+    Scan.succeed (fn ctxt =>
+        SIMPLE_METHOD' (MessageSET.spy_analz_tac (clasimpset_of ctxt))) *}
+    "for proving the Fake case when analz is involved"
+
+method_setup atomic_spy_analz = {*
+    Scan.succeed (fn ctxt =>
+        SIMPLE_METHOD' (MessageSET.atomic_spy_analz_tac (clasimpset_of ctxt))) *}
+    "for debugging spy_analz"
+
+method_setup Fake_insert_simp = {*
+    Scan.succeed (fn ctxt =>
+        SIMPLE_METHOD' (MessageSET.Fake_insert_simp_tac (simpset_of ctxt))) *}
+    "for debugging spy_analz"
+
+end
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/SET_Protocol/Public_SET.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/SET_Protocol/Public_SET.thy	Tue Oct 20 20:03:23 2009 +0200
@@ -0,0 +1,529 @@
+(*  Title:      HOL/SET_Protocol/Public_SET.thy
+    Author:     Giampaolo Bella
+    Author:     Fabio Massacci
+    Author:     Lawrence C Paulson
+*)
+
+header{*The Public-Key Theory, Modified for SET*}
+
+theory Public_SET
+imports Event_SET
+begin
+
+subsection{*Symmetric and Asymmetric Keys*}
+
+text{*definitions influenced by the wish to assign asymmetric keys 
+  - since the beginning - only to RCA and CAs, namely we need a partial 
+  function on type Agent*}
+
+
+text{*The SET specs mention two signature keys for CAs - we only have one*}
+
+consts
+  publicKey :: "[bool, agent] => key"
+    --{*the boolean is TRUE if a signing key*}
+
+syntax
+  pubEK :: "agent => key"
+  pubSK :: "agent => key"
+  priEK :: "agent => key"
+  priSK :: "agent => key"
+
+translations
+  "pubEK"  == "publicKey False"
+  "pubSK"  == "publicKey True"
+
+  (*BEWARE!! priEK, priSK DON'T WORK with inj, range, image, etc.*)
+  "priEK A"  == "invKey (pubEK A)"
+  "priSK A"  == "invKey (pubSK A)"
+
+text{*By freeness of agents, no two agents have the same key. Since
+ @{term "True\<noteq>False"}, no agent has the same signing and encryption keys.*}
+
+specification (publicKey)
+  injective_publicKey:
+    "publicKey b A = publicKey c A' ==> b=c & A=A'"
+(*<*)
+   apply (rule exI [of _ "%b A. 2 * nat_of_agent A + (if b then 1 else 0)"]) 
+   apply (auto simp add: inj_on_def inj_nat_of_agent [THEN inj_eq] split: agent.split) 
+   apply (drule_tac f="%x. x mod 2" in arg_cong, simp add: mod_Suc)+
+(*or this, but presburger won't abstract out the function applications
+   apply presburger+
+*)
+   done                       
+(*>*)
+
+axioms
+  (*No private key equals any public key (essential to ensure that private
+    keys are private!) *)
+  privateKey_neq_publicKey [iff]:
+      "invKey (publicKey b A) \<noteq> publicKey b' A'"
+
+declare privateKey_neq_publicKey [THEN not_sym, iff]
+
+  
+subsection{*Initial Knowledge*}
+
+text{*This information is not necessary.  Each protocol distributes any needed
+certificates, and anyway our proofs require a formalization of the Spy's 
+knowledge only.  However, the initial knowledge is as follows:
+   All agents know RCA's public keys;
+   RCA and CAs know their own respective keys;
+   RCA (has already certified and therefore) knows all CAs public keys; 
+   Spy knows all keys of all bad agents.*}
+primrec    
+(*<*)
+  initState_CA:
+    "initState (CA i)  =
+       (if i=0 then Key ` ({priEK RCA, priSK RCA} Un
+                            pubEK ` (range CA) Un pubSK ` (range CA))
+        else {Key (priEK (CA i)), Key (priSK (CA i)),
+              Key (pubEK (CA i)), Key (pubSK (CA i)),
+              Key (pubEK RCA), Key (pubSK RCA)})"
+
+  initState_Cardholder:
+    "initState (Cardholder i)  =    
+       {Key (priEK (Cardholder i)), Key (priSK (Cardholder i)),
+        Key (pubEK (Cardholder i)), Key (pubSK (Cardholder i)),
+        Key (pubEK RCA), Key (pubSK RCA)}"
+
+  initState_Merchant:
+    "initState (Merchant i)  =    
+       {Key (priEK (Merchant i)), Key (priSK (Merchant i)),
+        Key (pubEK (Merchant i)), Key (pubSK (Merchant i)),
+        Key (pubEK RCA), Key (pubSK RCA)}"
+
+  initState_PG:
+    "initState (PG i)  = 
+       {Key (priEK (PG i)), Key (priSK (PG i)),
+        Key (pubEK (PG i)), Key (pubSK (PG i)),
+        Key (pubEK RCA), Key (pubSK RCA)}"
+(*>*)
+  initState_Spy:
+    "initState Spy = Key ` (invKey ` pubEK ` bad Un
+                            invKey ` pubSK ` bad Un
+                            range pubEK Un range pubSK)"
+
+
+text{*Injective mapping from agents to PANs: an agent can have only one card*}
+
+consts  pan :: "agent => nat"
+
+specification (pan)
+  inj_pan: "inj pan"
+  --{*No two agents have the same PAN*}
+(*<*)
+   apply (rule exI [of _ "nat_of_agent"]) 
+   apply (simp add: inj_on_def inj_nat_of_agent [THEN inj_eq]) 
+   done
+(*>*)
+
+declare inj_pan [THEN inj_eq, iff]
+
+consts
+  XOR :: "nat*nat => nat"  --{*no properties are assumed of exclusive-or*}
+
+
+subsection{*Signature Primitives*}
+
+constdefs 
+
+ (* Signature = Message + signed Digest *)
+  sign :: "[key, msg]=>msg"
+    "sign K X == {|X, Crypt K (Hash X) |}"
+
+ (* Signature Only = signed Digest Only *)
+  signOnly :: "[key, msg]=>msg"
+    "signOnly K X == Crypt K (Hash X)"
+
+ (* Signature for Certificates = Message + signed Message *)
+  signCert :: "[key, msg]=>msg"
+    "signCert K X == {|X, Crypt K X |}"
+
+ (* Certification Authority's Certificate.
+    Contains agent name, a key, a number specifying the key's target use,
+              a key to sign the entire certificate.
+
+    Should prove if signK=priSK RCA and C=CA i,
+                  then Ka=pubEK i or pubSK i depending on T  ??
+ *)
+  cert :: "[agent, key, msg, key] => msg"
+    "cert A Ka T signK == signCert signK {|Agent A, Key Ka, T|}"
+
+
+ (* Cardholder's Certificate.
+    Contains a PAN, the certified key Ka, the PANSecret PS,
+    a number specifying the target use for Ka, the signing key signK.
+ *)
+  certC :: "[nat, key, nat, msg, key] => msg"
+    "certC PAN Ka PS T signK ==
+     signCert signK {|Hash {|Nonce PS, Pan PAN|}, Key Ka, T|}"
+
+  (*cert and certA have no repeated elements, so they could be translations,
+    but that's tricky and makes proofs slower*)
+
+syntax
+  "onlyEnc" :: msg      
+  "onlySig" :: msg
+  "authCode" :: msg
+
+translations
+  "onlyEnc"   == "Number 0"
+  "onlySig"  == "Number (Suc 0)"
+  "authCode" == "Number (Suc (Suc 0))"
+
+subsection{*Encryption Primitives*}
+
+constdefs
+
+  EXcrypt :: "[key,key,msg,msg] => msg"
+  --{*Extra Encryption*}
+    (*K: the symmetric key   EK: the public encryption key*)
+    "EXcrypt K EK M m ==
+       {|Crypt K {|M, Hash m|}, Crypt EK {|Key K, m|}|}"
+
+  EXHcrypt :: "[key,key,msg,msg] => msg"
+  --{*Extra Encryption with Hashing*}
+    (*K: the symmetric key   EK: the public encryption key*)
+    "EXHcrypt K EK M m ==
+       {|Crypt K {|M, Hash m|}, Crypt EK {|Key K, m, Hash M|}|}"
+
+  Enc :: "[key,key,key,msg] => msg"
+  --{*Simple Encapsulation with SIGNATURE*}
+    (*SK: the sender's signing key
+      K: the symmetric key
+      EK: the public encryption key*)
+    "Enc SK K EK M ==
+       {|Crypt K (sign SK M), Crypt EK (Key K)|}"
+
+  EncB :: "[key,key,key,msg,msg] => msg"
+  --{*Encapsulation with Baggage.  Keys as above, and baggage b.*}
+    "EncB SK K EK M b == 
+       {|Enc SK K EK {|M, Hash b|}, b|}"
+
+
+subsection{*Basic Properties of pubEK, pubSK, priEK and priSK *}
+
+lemma publicKey_eq_iff [iff]:
+     "(publicKey b A = publicKey b' A') = (b=b' & A=A')"
+by (blast dest: injective_publicKey)
+
+lemma privateKey_eq_iff [iff]:
+     "(invKey (publicKey b A) = invKey (publicKey b' A')) = (b=b' & A=A')"
+by auto
+
+lemma not_symKeys_publicKey [iff]: "publicKey b A \<notin> symKeys"
+by (simp add: symKeys_def)
+
+lemma not_symKeys_privateKey [iff]: "invKey (publicKey b A) \<notin> symKeys"
+by (simp add: symKeys_def)
+
+lemma symKeys_invKey_eq [simp]: "K \<in> symKeys ==> invKey K = K"
+by (simp add: symKeys_def)
+
+lemma symKeys_invKey_iff [simp]: "(invKey K \<in> symKeys) = (K \<in> symKeys)"
+by (unfold symKeys_def, auto)
+
+text{*Can be slow (or even loop) as a simprule*}
+lemma symKeys_neq_imp_neq: "(K \<in> symKeys) \<noteq> (K' \<in> symKeys) ==> K \<noteq> K'"
+by blast
+
+text{*These alternatives to @{text symKeys_neq_imp_neq} don't seem any better
+in practice.*}
+lemma publicKey_neq_symKey: "K \<in> symKeys ==> publicKey b A \<noteq> K"
+by blast
+
+lemma symKey_neq_publicKey: "K \<in> symKeys ==> K \<noteq> publicKey b A"
+by blast
+
+lemma privateKey_neq_symKey: "K \<in> symKeys ==> invKey (publicKey b A) \<noteq> K"
+by blast
+
+lemma symKey_neq_privateKey: "K \<in> symKeys ==> K \<noteq> invKey (publicKey b A)"
+by blast
+
+lemma analz_symKeys_Decrypt:
+     "[| Crypt K X \<in> analz H;  K \<in> symKeys;  Key K \<in> analz H |]  
+      ==> X \<in> analz H"
+by auto
+
+
+subsection{*"Image" Equations That Hold for Injective Functions *}
+
+lemma invKey_image_eq [iff]: "(invKey x \<in> invKey`A) = (x\<in>A)"
+by auto
+
+text{*holds because invKey is injective*}
+lemma publicKey_image_eq [iff]:
+     "(publicKey b A \<in> publicKey c ` AS) = (b=c & A\<in>AS)"
+by auto
+
+lemma privateKey_image_eq [iff]:
+     "(invKey (publicKey b A) \<in> invKey ` publicKey c ` AS) = (b=c & A\<in>AS)"
+by auto
+
+lemma privateKey_notin_image_publicKey [iff]:
+     "invKey (publicKey b A) \<notin> publicKey c ` AS"
+by auto
+
+lemma publicKey_notin_image_privateKey [iff]:
+     "publicKey b A \<notin> invKey ` publicKey c ` AS"
+by auto
+
+lemma keysFor_parts_initState [simp]: "keysFor (parts (initState C)) = {}"
+apply (simp add: keysFor_def)
+apply (induct_tac "C")
+apply (auto intro: range_eqI)
+done
+
+text{*for proving @{text new_keys_not_used}*}
+lemma keysFor_parts_insert:
+     "[| K \<in> keysFor (parts (insert X H));  X \<in> synth (analz H) |]  
+      ==> K \<in> keysFor (parts H) | Key (invKey K) \<in> parts H"
+by (force dest!: 
+         parts_insert_subset_Un [THEN keysFor_mono, THEN [2] rev_subsetD]
+         analz_subset_parts [THEN keysFor_mono, THEN [2] rev_subsetD] 
+            intro: analz_into_parts)
+
+lemma Crypt_imp_keysFor [intro]:
+     "[|K \<in> symKeys; Crypt K X \<in> H|] ==> K \<in> keysFor H"
+by (drule Crypt_imp_invKey_keysFor, simp)
+
+text{*Agents see their own private keys!*}
+lemma privateKey_in_initStateCA [iff]:
+     "Key (invKey (publicKey b A)) \<in> initState A"
+by (case_tac "A", auto)
+
+text{*Agents see their own public keys!*}
+lemma publicKey_in_initStateCA [iff]: "Key (publicKey b A) \<in> initState A"
+by (case_tac "A", auto)
+
+text{*RCA sees CAs' public keys! *}
+lemma pubK_CA_in_initState_RCA [iff]:
+     "Key (publicKey b (CA i)) \<in> initState RCA"
+by auto
+
+
+text{*Spy knows all public keys*}
+lemma knows_Spy_pubEK_i [iff]: "Key (publicKey b A) \<in> knows Spy evs"
+apply (induct_tac "evs")
+apply (simp_all add: imageI knows_Cons split add: event.split)
+done
+
+declare knows_Spy_pubEK_i [THEN analz.Inj, iff]
+                            (*needed????*)
+
+text{*Spy sees private keys of bad agents! [and obviously public keys too]*}
+lemma knows_Spy_bad_privateKey [intro!]:
+     "A \<in> bad ==> Key (invKey (publicKey b A)) \<in> knows Spy evs"
+by (rule initState_subset_knows [THEN subsetD], simp)
+
+
+subsection{*Fresh Nonces for Possibility Theorems*}
+
+lemma Nonce_notin_initState [iff]: "Nonce N \<notin> parts (initState B)"
+by (induct_tac "B", auto)
+
+lemma Nonce_notin_used_empty [simp]: "Nonce N \<notin> used []"
+by (simp add: used_Nil)
+
+text{*In any trace, there is an upper bound N on the greatest nonce in use.*}
+lemma Nonce_supply_lemma: "\<exists>N. \<forall>n. N<=n --> Nonce n \<notin> used evs"
+apply (induct_tac "evs")
+apply (rule_tac x = 0 in exI)
+apply (simp_all add: used_Cons split add: event.split, safe)
+apply (rule msg_Nonce_supply [THEN exE], blast elim!: add_leE)+
+done
+
+lemma Nonce_supply1: "\<exists>N. Nonce N \<notin> used evs"
+by (rule Nonce_supply_lemma [THEN exE], blast)
+
+lemma Nonce_supply: "Nonce (@ N. Nonce N \<notin> used evs) \<notin> used evs"
+apply (rule Nonce_supply_lemma [THEN exE])
+apply (rule someI, fast)
+done
+
+
+subsection{*Specialized Methods for Possibility Theorems*}
+
+ML
+{*
+(*Tactic for possibility theorems*)
+fun possibility_tac ctxt =
+    REPEAT (*omit used_Says so that Nonces start from different traces!*)
+    (ALLGOALS (simp_tac (simpset_of ctxt delsimps [@{thm used_Says}, @{thm used_Notes}]))
+     THEN
+     REPEAT_FIRST (eq_assume_tac ORELSE' 
+                   resolve_tac [refl, conjI, @{thm Nonce_supply}]))
+
+(*For harder protocols (such as SET_CR!), where we have to set up some
+  nonces and keys initially*)
+fun basic_possibility_tac ctxt =
+    REPEAT 
+    (ALLGOALS (asm_simp_tac (simpset_of ctxt setSolver safe_solver))
+     THEN
+     REPEAT_FIRST (resolve_tac [refl, conjI]))
+*}
+
+method_setup possibility = {*
+    Scan.succeed (SIMPLE_METHOD o possibility_tac) *}
+    "for proving possibility theorems"
+
+method_setup basic_possibility = {*
+    Scan.succeed (SIMPLE_METHOD o basic_possibility_tac) *}
+    "for proving possibility theorems"
+
+
+subsection{*Specialized Rewriting for Theorems About @{term analz} and Image*}
+
+lemma insert_Key_singleton: "insert (Key K) H = Key ` {K} Un H"
+by blast
+
+lemma insert_Key_image:
+     "insert (Key K) (Key`KK Un C) = Key ` (insert K KK) Un C"
+by blast
+
+text{*Needed for @{text DK_fresh_not_KeyCryptKey}*}
+lemma publicKey_in_used [iff]: "Key (publicKey b A) \<in> used evs"
+by auto
+
+lemma privateKey_in_used [iff]: "Key (invKey (publicKey b A)) \<in> used evs"
+by (blast intro!: initState_into_used)
+
+text{*Reverse the normal simplification of "image" to build up (not break down)
+  the set of keys.  Based on @{text analz_image_freshK_ss}, but simpler.*}
+lemmas analz_image_keys_simps =
+       simp_thms mem_simps --{*these two allow its use with @{text "only:"}*}
+       image_insert [THEN sym] image_Un [THEN sym] 
+       rangeI symKeys_neq_imp_neq
+       insert_Key_singleton insert_Key_image Un_assoc [THEN sym]
+
+
+(*General lemmas proved by Larry*)
+
+subsection{*Controlled Unfolding of Abbreviations*}
+
+text{*A set is expanded only if a relation is applied to it*}
+lemma def_abbrev_simp_relation:
+     "A == B ==> (A \<in> X) = (B \<in> X) &  
+                 (u = A) = (u = B) &  
+                 (A = u) = (B = u)"
+by auto
+
+text{*A set is expanded only if one of the given functions is applied to it*}
+lemma def_abbrev_simp_function:
+     "A == B  
+      ==> parts (insert A X) = parts (insert B X) &  
+          analz (insert A X) = analz (insert B X) &  
+          keysFor (insert A X) = keysFor (insert B X)"
+by auto
+
+subsubsection{*Special Simplification Rules for @{term signCert}*}
+
+text{*Avoids duplicating X and its components!*}
+lemma parts_insert_signCert:
+     "parts (insert (signCert K X) H) =  
+      insert {|X, Crypt K X|} (parts (insert (Crypt K X) H))"
+by (simp add: signCert_def insert_commute [of X])
+
+text{*Avoids a case split! [X is always available]*}
+lemma analz_insert_signCert:
+     "analz (insert (signCert K X) H) =  
+      insert {|X, Crypt K X|} (insert (Crypt K X) (analz (insert X H)))"
+by (simp add: signCert_def insert_commute [of X])
+
+lemma keysFor_insert_signCert: "keysFor (insert (signCert K X) H) = keysFor H"
+by (simp add: signCert_def)
+
+text{*Controlled rewrite rules for @{term signCert}, just the definitions
+  of the others. Encryption primitives are just expanded, despite their huge
+  redundancy!*}
+lemmas abbrev_simps [simp] =
+    parts_insert_signCert analz_insert_signCert keysFor_insert_signCert
+    sign_def     [THEN def_abbrev_simp_relation]
+    sign_def     [THEN def_abbrev_simp_function]
+    signCert_def [THEN def_abbrev_simp_relation]
+    signCert_def [THEN def_abbrev_simp_function]
+    certC_def    [THEN def_abbrev_simp_relation]
+    certC_def    [THEN def_abbrev_simp_function]
+    cert_def     [THEN def_abbrev_simp_relation]
+    cert_def     [THEN def_abbrev_simp_function]
+    EXcrypt_def  [THEN def_abbrev_simp_relation]
+    EXcrypt_def  [THEN def_abbrev_simp_function]
+    EXHcrypt_def [THEN def_abbrev_simp_relation]
+    EXHcrypt_def [THEN def_abbrev_simp_function]
+    Enc_def      [THEN def_abbrev_simp_relation]
+    Enc_def      [THEN def_abbrev_simp_function]
+    EncB_def     [THEN def_abbrev_simp_relation]
+    EncB_def     [THEN def_abbrev_simp_function]
+
+
+subsubsection{*Elimination Rules for Controlled Rewriting *}
+
+lemma Enc_partsE: 
+     "!!R. [|Enc SK K EK M \<in> parts H;  
+             [|Crypt K (sign SK M) \<in> parts H;  
+               Crypt EK (Key K) \<in> parts H|] ==> R|]  
+           ==> R"
+
+by (unfold Enc_def, blast)
+
+lemma EncB_partsE: 
+     "!!R. [|EncB SK K EK M b \<in> parts H;  
+             [|Crypt K (sign SK {|M, Hash b|}) \<in> parts H;  
+               Crypt EK (Key K) \<in> parts H;  
+               b \<in> parts H|] ==> R|]  
+           ==> R"
+by (unfold EncB_def Enc_def, blast)
+
+lemma EXcrypt_partsE: 
+     "!!R. [|EXcrypt K EK M m \<in> parts H;  
+             [|Crypt K {|M, Hash m|} \<in> parts H;  
+               Crypt EK {|Key K, m|} \<in> parts H|] ==> R|]  
+           ==> R"
+by (unfold EXcrypt_def, blast)
+
+
+subsection{*Lemmas to Simplify Expressions Involving @{term analz} *}
+
+lemma analz_knows_absorb:
+     "Key K \<in> analz (knows Spy evs)  
+      ==> analz (Key ` (insert K H) \<union> knows Spy evs) =  
+          analz (Key ` H \<union> knows Spy evs)"
+by (simp add: analz_insert_eq Un_upper2 [THEN analz_mono, THEN subsetD])
+
+lemma analz_knows_absorb2:
+     "Key K \<in> analz (knows Spy evs)  
+      ==> analz (Key ` (insert X (insert K H)) \<union> knows Spy evs) =  
+          analz (Key ` (insert X H) \<union> knows Spy evs)"
+apply (subst insert_commute)
+apply (erule analz_knows_absorb)
+done
+
+lemma analz_insert_subset_eq:
+     "[|X \<in> analz (knows Spy evs);  knows Spy evs \<subseteq> H|]  
+      ==> analz (insert X H) = analz H"
+apply (rule analz_insert_eq)
+apply (blast intro: analz_mono [THEN [2] rev_subsetD])
+done
+
+lemmas analz_insert_simps = 
+         analz_insert_subset_eq Un_upper2
+         subset_insertI [THEN [2] subset_trans] 
+
+
+subsection{*Freshness Lemmas*}
+
+lemma in_parts_Says_imp_used:
+     "[|Key K \<in> parts {X}; Says A B X \<in> set evs|] ==> Key K \<in> used evs"
+by (blast intro: parts_trans dest!: Says_imp_knows_Spy [THEN parts.Inj])
+
+text{*A useful rewrite rule with @{term analz_image_keys_simps}*}
+lemma Crypt_notin_image_Key: "Crypt K X \<notin> Key ` KK"
+by auto
+
+lemma fresh_notin_analz_knows_Spy:
+     "Key K \<notin> used evs ==> Key K \<notin> analz (knows Spy evs)"
+by (auto dest: analz_into_parts)
+
+end
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/SET_Protocol/Purchase.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/SET_Protocol/Purchase.thy	Tue Oct 20 20:03:23 2009 +0200
@@ -0,0 +1,1172 @@
+(*  Title:      HOL/SET_Protocol/Purchase.thy
+    Author:     Giampaolo Bella
+    Author:     Fabio Massacci
+    Author:     Lawrence C Paulson
+*)
+
+header{*Purchase Phase of SET*}
+
+theory Purchase
+imports Public_SET
+begin
+
+text{*
+Note: nonces seem to consist of 20 bytes.  That includes both freshness
+challenges (Chall-EE, etc.) and important secrets (CardSecret, PANsecret)
+
+This version omits @{text LID_C} but retains @{text LID_M}. At first glance
+(Programmer's Guide page 267) it seems that both numbers are just introduced
+for the respective convenience of the Cardholder's and Merchant's
+system. However, omitting both of them would create a problem of
+identification: how can the Merchant's system know what transaction is it
+supposed to process?
+
+Further reading (Programmer's guide page 309) suggest that there is an outside
+bootstrapping message (SET initiation message) which is used by the Merchant
+and the Cardholder to agree on the actual transaction. This bootstrapping
+message is described in the SET External Interface Guide and ought to generate
+@{text LID_M}. According SET Extern Interface Guide, this number might be a
+cookie, an invoice number etc. The Programmer's Guide on page 310, states that
+in absence of @{text LID_M} the protocol must somehow ("outside SET") identify
+the transaction from OrderDesc, which is assumed to be a searchable text only
+field. Thus, it is assumed that the Merchant or the Cardholder somehow agreed
+out-of-bad on the value of @{text LID_M} (for instance a cookie in a web
+transaction etc.). This out-of-band agreement is expressed with a preliminary
+start action in which the merchant and the Cardholder agree on the appropriate
+values. Agreed values are stored with a suitable notes action.
+
+"XID is a transaction ID that is usually generated by the Merchant system,
+unless there is no PInitRes, in which case it is generated by the Cardholder
+system. It is a randomly generated 20 byte variable that is globally unique
+(statistically). Merchant and Cardholder systems shall use appropriate random
+number generators to ensure the global uniqueness of XID."
+--Programmer's Guide, page 267.
+
+PI (Payment Instruction) is the most central and sensitive data structure in
+SET. It is used to pass the data required to authorize a payment card payment
+from the Cardholder to the Payment Gateway, which will use the data to
+initiate a payment card transaction through the traditional payment card
+financial network. The data is encrypted by the Cardholder and sent via the
+Merchant, such that the data is hidden from the Merchant unless the Acquirer
+passes the data back to the Merchant.
+--Programmer's Guide, page 271.*}
+
+consts
+
+    CardSecret :: "nat => nat"
+     --{*Maps Cardholders to CardSecrets.
+         A CardSecret of 0 means no cerificate, must use unsigned format.*}
+
+    PANSecret :: "nat => nat"
+     --{*Maps Cardholders to PANSecrets.*}
+
+inductive_set
+  set_pur :: "event list set"
+where
+
+  Nil:   --{*Initial trace is empty*}
+         "[] \<in> set_pur"
+
+| Fake:  --{*The spy MAY say anything he CAN say.*}
+         "[| evsf \<in> set_pur;  X \<in> synth(analz(knows Spy evsf)) |]
+          ==> Says Spy B X  # evsf \<in> set_pur"
+
+
+| Reception: --{*If A sends a message X to B, then B might receive it*}
+             "[| evsr \<in> set_pur;  Says A B X \<in> set evsr |]
+              ==> Gets B X  # evsr \<in> set_pur"
+
+| Start: 
+      --{*Added start event which is out-of-band for SET: the Cardholder and
+          the merchant agree on the amounts and uses @{text LID_M} as an
+          identifier.
+          This is suggested by the External Interface Guide. The Programmer's
+          Guide, in absence of @{text LID_M}, states that the merchant uniquely
+          identifies the order out of some data contained in OrderDesc.*}
+   "[|evsStart \<in> set_pur;
+      Number LID_M \<notin> used evsStart;
+      C = Cardholder k; M = Merchant i; P = PG j;
+      Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
+      LID_M \<notin> range CardSecret;
+      LID_M \<notin> range PANSecret |]
+     ==> Notes C {|Number LID_M, Transaction|}
+       # Notes M {|Number LID_M, Agent P, Transaction|}
+       # evsStart \<in> set_pur"
+
+| PInitReq:
+     --{*Purchase initialization, page 72 of Formal Protocol Desc.*}
+   "[|evsPIReq \<in> set_pur;
+      Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
+      Nonce Chall_C \<notin> used evsPIReq;
+      Chall_C \<notin> range CardSecret; Chall_C \<notin> range PANSecret;
+      Notes C {|Number LID_M, Transaction |} \<in> set evsPIReq |]
+    ==> Says C M {|Number LID_M, Nonce Chall_C|} # evsPIReq \<in> set_pur"
+
+| PInitRes:
+     --{*Merchant replies with his own label XID and the encryption
+         key certificate of his chosen Payment Gateway. Page 74 of Formal
+         Protocol Desc. We use @{text LID_M} to identify Cardholder*}
+   "[|evsPIRes \<in> set_pur;
+      Gets M {|Number LID_M, Nonce Chall_C|} \<in> set evsPIRes;
+      Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
+      Notes M {|Number LID_M, Agent P, Transaction|} \<in> set evsPIRes;
+      Nonce Chall_M \<notin> used evsPIRes;
+      Chall_M \<notin> range CardSecret; Chall_M \<notin> range PANSecret;
+      Number XID \<notin> used evsPIRes;
+      XID \<notin> range CardSecret; XID \<notin> range PANSecret|]
+    ==> Says M C (sign (priSK M)
+                       {|Number LID_M, Number XID,
+                         Nonce Chall_C, Nonce Chall_M,
+                         cert P (pubEK P) onlyEnc (priSK RCA)|})
+          # evsPIRes \<in> set_pur"
+
+| PReqUns:
+      --{*UNSIGNED Purchase request (CardSecret = 0).
+        Page 79 of Formal Protocol Desc.
+        Merchant never sees the amount in clear. This holds of the real
+        protocol, where XID identifies the transaction. We omit
+        Hash{|Number XID, Nonce (CardSecret k)|} from PIHead because
+        the CardSecret is 0 and because AuthReq treated the unsigned case
+        very differently from the signed one anyway.*}
+   "!!Chall_C Chall_M OrderDesc P PurchAmt XID evsPReqU.
+    [|evsPReqU \<in> set_pur;
+      C = Cardholder k; CardSecret k = 0;
+      Key KC1 \<notin> used evsPReqU;  KC1 \<in> symKeys;
+      Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
+      HOD = Hash{|Number OrderDesc, Number PurchAmt|};
+      OIData = {|Number LID_M, Number XID, Nonce Chall_C, HOD,Nonce Chall_M|};
+      PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M|};
+      Gets C (sign (priSK M)
+                   {|Number LID_M, Number XID,
+                     Nonce Chall_C, Nonce Chall_M,
+                     cert P EKj onlyEnc (priSK RCA)|})
+        \<in> set evsPReqU;
+      Says C M {|Number LID_M, Nonce Chall_C|} \<in> set evsPReqU;
+      Notes C {|Number LID_M, Transaction|} \<in> set evsPReqU |]
+    ==> Says C M
+             {|EXHcrypt KC1 EKj {|PIHead, Hash OIData|} (Pan (pan C)),
+               OIData, Hash{|PIHead, Pan (pan C)|} |}
+          # Notes C {|Key KC1, Agent M|}
+          # evsPReqU \<in> set_pur"
+
+| PReqS:
+      --{*SIGNED Purchase request.  Page 77 of Formal Protocol Desc.
+          We could specify the equation
+          @{term "PIReqSigned = {| PIDualSigned, OIDualSigned |}"}, since the
+          Formal Desc. gives PIHead the same format in the unsigned case.
+          However, there's little point, as P treats the signed and 
+          unsigned cases differently.*}
+   "!!C Chall_C Chall_M EKj HOD KC2 LID_M M OIData
+      OIDualSigned OrderDesc P PANData PIData PIDualSigned
+      PIHead PurchAmt Transaction XID evsPReqS k.
+    [|evsPReqS \<in> set_pur;
+      C = Cardholder k;
+      CardSecret k \<noteq> 0;  Key KC2 \<notin> used evsPReqS;  KC2 \<in> symKeys;
+      Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
+      HOD = Hash{|Number OrderDesc, Number PurchAmt|};
+      OIData = {|Number LID_M, Number XID, Nonce Chall_C, HOD, Nonce Chall_M|};
+      PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M,
+                  Hash{|Number XID, Nonce (CardSecret k)|}|};
+      PANData = {|Pan (pan C), Nonce (PANSecret k)|};
+      PIData = {|PIHead, PANData|};
+      PIDualSigned = {|sign (priSK C) {|Hash PIData, Hash OIData|},
+                       EXcrypt KC2 EKj {|PIHead, Hash OIData|} PANData|};
+      OIDualSigned = {|OIData, Hash PIData|};
+      Gets C (sign (priSK M)
+                   {|Number LID_M, Number XID,
+                     Nonce Chall_C, Nonce Chall_M,
+                     cert P EKj onlyEnc (priSK RCA)|})
+        \<in> set evsPReqS;
+      Says C M {|Number LID_M, Nonce Chall_C|} \<in> set evsPReqS;
+      Notes C {|Number LID_M, Transaction|} \<in> set evsPReqS |]
+    ==> Says C M {|PIDualSigned, OIDualSigned|}
+          # Notes C {|Key KC2, Agent M|}
+          # evsPReqS \<in> set_pur"
+
+  --{*Authorization Request.  Page 92 of Formal Protocol Desc.
+    Sent in response to Purchase Request.*}
+| AuthReq:
+   "[| evsAReq \<in> set_pur;
+       Key KM \<notin> used evsAReq;  KM \<in> symKeys;
+       Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
+       HOD = Hash{|Number OrderDesc, Number PurchAmt|};
+       OIData = {|Number LID_M, Number XID, Nonce Chall_C, HOD,
+                  Nonce Chall_M|};
+       CardSecret k \<noteq> 0 -->
+         P_I = {|sign (priSK C) {|HPIData, Hash OIData|}, encPANData|};
+       Gets M {|P_I, OIData, HPIData|} \<in> set evsAReq;
+       Says M C (sign (priSK M) {|Number LID_M, Number XID,
+                                  Nonce Chall_C, Nonce Chall_M,
+                                  cert P EKj onlyEnc (priSK RCA)|})
+         \<in> set evsAReq;
+        Notes M {|Number LID_M, Agent P, Transaction|}
+           \<in> set evsAReq |]
+    ==> Says M P
+             (EncB (priSK M) KM (pubEK P)
+               {|Number LID_M, Number XID, Hash OIData, HOD|}   P_I)
+          # evsAReq \<in> set_pur"
+
+  --{*Authorization Response has two forms: for UNSIGNED and SIGNED PIs.
+    Page 99 of Formal Protocol Desc.
+    PI is a keyword (product!), so we call it @{text P_I}. The hashes HOD and
+    HOIData occur independently in @{text P_I} and in M's message.
+    The authCode in AuthRes represents the baggage of EncB, which in the
+    full protocol is [CapToken], [AcqCardMsg], [AuthToken]:
+    optional items for split shipments, recurring payments, etc.*}
+
+| AuthResUns:
+    --{*Authorization Response, UNSIGNED*}
+   "[| evsAResU \<in> set_pur;
+       C = Cardholder k; M = Merchant i;
+       Key KP \<notin> used evsAResU;  KP \<in> symKeys;
+       CardSecret k = 0;  KC1 \<in> symKeys;  KM \<in> symKeys;
+       PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M|};
+       P_I = EXHcrypt KC1 EKj {|PIHead, HOIData|} (Pan (pan C));
+       Gets P (EncB (priSK M) KM (pubEK P)
+               {|Number LID_M, Number XID, HOIData, HOD|} P_I)
+           \<in> set evsAResU |]
+   ==> Says P M
+            (EncB (priSK P) KP (pubEK M)
+              {|Number LID_M, Number XID, Number PurchAmt|}
+              authCode)
+       # evsAResU \<in> set_pur"
+
+| AuthResS:
+    --{*Authorization Response, SIGNED*}
+   "[| evsAResS \<in> set_pur;
+       C = Cardholder k;
+       Key KP \<notin> used evsAResS;  KP \<in> symKeys;
+       CardSecret k \<noteq> 0;  KC2 \<in> symKeys;  KM \<in> symKeys;
+       P_I = {|sign (priSK C) {|Hash PIData, HOIData|},
+               EXcrypt KC2 (pubEK P) {|PIHead, HOIData|} PANData|};
+       PANData = {|Pan (pan C), Nonce (PANSecret k)|};
+       PIData = {|PIHead, PANData|};
+       PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M,
+                  Hash{|Number XID, Nonce (CardSecret k)|}|};
+       Gets P (EncB (priSK M) KM (pubEK P)
+                {|Number LID_M, Number XID, HOIData, HOD|}
+               P_I)
+           \<in> set evsAResS |]
+   ==> Says P M
+            (EncB (priSK P) KP (pubEK M)
+              {|Number LID_M, Number XID, Number PurchAmt|}
+              authCode)
+       # evsAResS \<in> set_pur"
+
+| PRes:
+    --{*Purchase response.*}
+   "[| evsPRes \<in> set_pur;  KP \<in> symKeys;  M = Merchant i;
+       Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
+       Gets M (EncB (priSK P) KP (pubEK M)
+              {|Number LID_M, Number XID, Number PurchAmt|}
+              authCode)
+          \<in> set evsPRes;
+       Gets M {|Number LID_M, Nonce Chall_C|} \<in> set evsPRes;
+       Says M P
+            (EncB (priSK M) KM (pubEK P)
+              {|Number LID_M, Number XID, Hash OIData, HOD|} P_I)
+         \<in> set evsPRes;
+       Notes M {|Number LID_M, Agent P, Transaction|}
+          \<in> set evsPRes
+      |]
+   ==> Says M C
+         (sign (priSK M) {|Number LID_M, Number XID, Nonce Chall_C,
+                           Hash (Number PurchAmt)|})
+         # evsPRes \<in> set_pur"
+
+
+specification (CardSecret PANSecret)
+  inj_CardSecret:  "inj CardSecret"
+  inj_PANSecret:   "inj PANSecret"
+  CardSecret_neq_PANSecret: "CardSecret k \<noteq> PANSecret k'"
+    --{*No CardSecret equals any PANSecret*}
+  apply (rule_tac x="curry nat2_to_nat 0" in exI)
+  apply (rule_tac x="curry nat2_to_nat 1" in exI)
+  apply (simp add: nat2_to_nat_inj [THEN inj_eq] inj_on_def)
+  done
+
+declare Says_imp_knows_Spy [THEN parts.Inj, dest]
+declare parts.Body [dest]
+declare analz_into_parts [dest]
+declare Fake_parts_insert_in_Un [dest]
+
+declare CardSecret_neq_PANSecret [iff] 
+        CardSecret_neq_PANSecret [THEN not_sym, iff]
+declare inj_CardSecret [THEN inj_eq, iff] 
+        inj_PANSecret [THEN inj_eq, iff]
+
+
+subsection{*Possibility Properties*}
+
+lemma Says_to_Gets:
+     "Says A B X # evs \<in> set_pur ==> Gets B X # Says A B X # evs \<in> set_pur"
+by (rule set_pur.Reception, auto)
+
+text{*Possibility for UNSIGNED purchases. Note that we need to ensure
+that XID differs from OrderDesc and PurchAmt, since it is supposed to be
+a unique number!*}
+lemma possibility_Uns:
+    "[| CardSecret k = 0;
+        C = Cardholder k;  M = Merchant i;
+        Key KC \<notin> used []; Key KM \<notin> used []; Key KP \<notin> used []; 
+        KC \<in> symKeys; KM \<in> symKeys; KP \<in> symKeys; 
+        KC < KM; KM < KP;
+        Nonce Chall_C \<notin> used []; Chall_C \<notin> range CardSecret \<union> range PANSecret;
+        Nonce Chall_M \<notin> used []; Chall_M \<notin> range CardSecret \<union> range PANSecret;
+        Chall_C < Chall_M; 
+        Number LID_M \<notin> used []; LID_M \<notin> range CardSecret \<union> range PANSecret;
+        Number XID \<notin> used []; XID \<notin> range CardSecret \<union> range PANSecret;
+        LID_M < XID; XID < OrderDesc; OrderDesc < PurchAmt |] 
+   ==> \<exists>evs \<in> set_pur.
+          Says M C
+               (sign (priSK M)
+                    {|Number LID_M, Number XID, Nonce Chall_C, 
+                      Hash (Number PurchAmt)|})
+                  \<in> set evs" 
+apply (intro exI bexI)
+apply (rule_tac [2]
+        set_pur.Nil
+         [THEN set_pur.Start [of _ LID_M C k M i _ _ _ OrderDesc PurchAmt], 
+          THEN set_pur.PInitReq [of concl: C M LID_M Chall_C],
+          THEN Says_to_Gets, 
+          THEN set_pur.PInitRes [of concl: M C LID_M XID Chall_C Chall_M], 
+          THEN Says_to_Gets,
+          THEN set_pur.PReqUns [of concl: C M KC],
+          THEN Says_to_Gets, 
+          THEN set_pur.AuthReq [of concl: M "PG j" KM LID_M XID], 
+          THEN Says_to_Gets, 
+          THEN set_pur.AuthResUns [of concl: "PG j" M KP LID_M XID],
+          THEN Says_to_Gets, 
+          THEN set_pur.PRes]) 
+apply basic_possibility
+apply (simp_all add: used_Cons symKeys_neq_imp_neq) 
+done
+
+lemma possibility_S:
+    "[| CardSecret k \<noteq> 0;
+        C = Cardholder k;  M = Merchant i;
+        Key KC \<notin> used []; Key KM \<notin> used []; Key KP \<notin> used []; 
+        KC \<in> symKeys; KM \<in> symKeys; KP \<in> symKeys; 
+        KC < KM; KM < KP;
+        Nonce Chall_C \<notin> used []; Chall_C \<notin> range CardSecret \<union> range PANSecret;
+        Nonce Chall_M \<notin> used []; Chall_M \<notin> range CardSecret \<union> range PANSecret;
+        Chall_C < Chall_M; 
+        Number LID_M \<notin> used []; LID_M \<notin> range CardSecret \<union> range PANSecret;
+        Number XID \<notin> used []; XID \<notin> range CardSecret \<union> range PANSecret;
+        LID_M < XID; XID < OrderDesc; OrderDesc < PurchAmt |] 
+   ==>  \<exists>evs \<in> set_pur.
+            Says M C
+                 (sign (priSK M) {|Number LID_M, Number XID, Nonce Chall_C, 
+                                   Hash (Number PurchAmt)|})
+               \<in> set evs"
+apply (intro exI bexI)
+apply (rule_tac [2]
+        set_pur.Nil
+         [THEN set_pur.Start [of _ LID_M C k M i _ _ _ OrderDesc PurchAmt], 
+          THEN set_pur.PInitReq [of concl: C M LID_M Chall_C],
+          THEN Says_to_Gets, 
+          THEN set_pur.PInitRes [of concl: M C LID_M XID Chall_C Chall_M], 
+          THEN Says_to_Gets,
+          THEN set_pur.PReqS [of concl: C M _ _ KC],
+          THEN Says_to_Gets, 
+          THEN set_pur.AuthReq [of concl: M "PG j" KM LID_M XID], 
+          THEN Says_to_Gets, 
+          THEN set_pur.AuthResS [of concl: "PG j" M KP LID_M XID],
+          THEN Says_to_Gets, 
+          THEN set_pur.PRes]) 
+apply basic_possibility
+apply (auto simp add: used_Cons symKeys_neq_imp_neq) 
+done
+
+text{*General facts about message reception*}
+lemma Gets_imp_Says:
+     "[| Gets B X \<in> set evs; evs \<in> set_pur |]
+   ==> \<exists>A. Says A B X \<in> set evs"
+apply (erule rev_mp)
+apply (erule set_pur.induct, auto)
+done
+
+lemma Gets_imp_knows_Spy:
+     "[| Gets B X \<in> set evs; evs \<in> set_pur |]  ==> X \<in> knows Spy evs"
+by (blast dest!: Gets_imp_Says Says_imp_knows_Spy)
+
+declare Gets_imp_knows_Spy [THEN parts.Inj, dest]
+
+text{*Forwarding lemmas, to aid simplification*}
+
+lemma AuthReq_msg_in_parts_spies:
+     "[|Gets M {|P_I, OIData, HPIData|} \<in> set evs;
+        evs \<in> set_pur|] ==> P_I \<in> parts (knows Spy evs)"
+by auto
+
+lemma AuthReq_msg_in_analz_spies:
+     "[|Gets M {|P_I, OIData, HPIData|} \<in> set evs;
+        evs \<in> set_pur|] ==> P_I \<in> analz (knows Spy evs)"
+by (blast dest: Gets_imp_knows_Spy [THEN analz.Inj])
+
+
+subsection{*Proofs on Asymmetric Keys*}
+
+text{*Private Keys are Secret*}
+
+text{*Spy never sees an agent's private keys! (unless it's bad at start)*}
+lemma Spy_see_private_Key [simp]:
+     "evs \<in> set_pur
+      ==> (Key(invKey (publicKey b A)) \<in> parts(knows Spy evs)) = (A \<in> bad)"
+apply (erule set_pur.induct)
+apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
+apply auto
+done
+declare Spy_see_private_Key [THEN [2] rev_iffD1, dest!]
+
+lemma Spy_analz_private_Key [simp]:
+     "evs \<in> set_pur ==>
+     (Key(invKey (publicKey b A)) \<in> analz(knows Spy evs)) = (A \<in> bad)"
+by auto
+declare Spy_analz_private_Key [THEN [2] rev_iffD1, dest!]
+
+text{*rewriting rule for priEK's*}
+lemma parts_image_priEK:
+     "[|Key (priEK C) \<in> parts (Key`KK Un (knows Spy evs));
+        evs \<in> set_pur|] ==> priEK C \<in> KK | C \<in> bad"
+by auto
+
+text{*trivial proof because @{term"priEK C"} never appears even in
+  @{term "parts evs"}. *}
+lemma analz_image_priEK:
+     "evs \<in> set_pur ==>
+          (Key (priEK C) \<in> analz (Key`KK Un (knows Spy evs))) =
+          (priEK C \<in> KK | C \<in> bad)"
+by (blast dest!: parts_image_priEK intro: analz_mono [THEN [2] rev_subsetD])
+
+
+subsection{*Public Keys in Certificates are Correct*}
+
+lemma Crypt_valid_pubEK [dest!]:
+     "[| Crypt (priSK RCA) {|Agent C, Key EKi, onlyEnc|}
+           \<in> parts (knows Spy evs);
+         evs \<in> set_pur |] ==> EKi = pubEK C"
+by (erule rev_mp, erule set_pur.induct, auto)
+
+lemma Crypt_valid_pubSK [dest!]:
+     "[| Crypt (priSK RCA) {|Agent C, Key SKi, onlySig|}
+           \<in> parts (knows Spy evs);
+         evs \<in> set_pur |] ==> SKi = pubSK C"
+by (erule rev_mp, erule set_pur.induct, auto)
+
+lemma certificate_valid_pubEK:
+    "[| cert C EKi onlyEnc (priSK RCA) \<in> parts (knows Spy evs);
+        evs \<in> set_pur |]
+     ==> EKi = pubEK C"
+by (unfold cert_def signCert_def, auto)
+
+lemma certificate_valid_pubSK:
+    "[| cert C SKi onlySig (priSK RCA) \<in> parts (knows Spy evs);
+        evs \<in> set_pur |] ==> SKi = pubSK C"
+by (unfold cert_def signCert_def, auto)
+
+lemma Says_certificate_valid [simp]:
+     "[| Says A B (sign SK {|lid, xid, cc, cm,
+                           cert C EK onlyEnc (priSK RCA)|}) \<in> set evs;
+         evs \<in> set_pur |]
+      ==> EK = pubEK C"
+by (unfold sign_def, auto)
+
+lemma Gets_certificate_valid [simp]:
+     "[| Gets A (sign SK {|lid, xid, cc, cm,
+                           cert C EK onlyEnc (priSK RCA)|}) \<in> set evs;
+         evs \<in> set_pur |]
+      ==> EK = pubEK C"
+by (frule Gets_imp_Says, auto)
+
+method_setup valid_certificate_tac = {*
+  Args.goal_spec >> (fn quant =>
+    K (SIMPLE_METHOD'' quant (fn i =>
+      EVERY [ftac @{thm Gets_certificate_valid} i,
+             assume_tac i, REPEAT (hyp_subst_tac i)])))
+*} ""
+
+
+subsection{*Proofs on Symmetric Keys*}
+
+text{*Nobody can have used non-existent keys!*}
+lemma new_keys_not_used [rule_format,simp]:
+     "evs \<in> set_pur
+      ==> Key K \<notin> used evs --> K \<in> symKeys -->
+          K \<notin> keysFor (parts (knows Spy evs))"
+apply (erule set_pur.induct)
+apply (valid_certificate_tac [8]) --{*PReqS*}
+apply (valid_certificate_tac [7]) --{*PReqUns*}
+apply auto
+apply (force dest!: usedI keysFor_parts_insert) --{*Fake*}
+done
+
+lemma new_keys_not_analzd:
+     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_pur |]
+      ==> K \<notin> keysFor (analz (knows Spy evs))"
+by (blast intro: keysFor_mono [THEN [2] rev_subsetD] dest: new_keys_not_used)
+
+lemma Crypt_parts_imp_used:
+     "[|Crypt K X \<in> parts (knows Spy evs);
+        K \<in> symKeys; evs \<in> set_pur |] ==> Key K \<in> used evs"
+apply (rule ccontr)
+apply (force dest: new_keys_not_used Crypt_imp_invKey_keysFor)
+done
+
+lemma Crypt_analz_imp_used:
+     "[|Crypt K X \<in> analz (knows Spy evs);
+        K \<in> symKeys; evs \<in> set_pur |] ==> Key K \<in> used evs"
+by (blast intro: Crypt_parts_imp_used)
+
+text{*New versions: as above, but generalized to have the KK argument*}
+
+lemma gen_new_keys_not_used:
+     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_pur |]
+      ==> Key K \<notin> used evs --> K \<in> symKeys -->
+          K \<notin> keysFor (parts (Key`KK Un knows Spy evs))"
+by auto
+
+lemma gen_new_keys_not_analzd:
+     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_pur |]
+      ==> K \<notin> keysFor (analz (Key`KK Un knows Spy evs))"
+by (blast intro: keysFor_mono [THEN subsetD] dest: gen_new_keys_not_used)
+
+lemma analz_Key_image_insert_eq:
+     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_pur |]
+      ==> analz (Key ` (insert K KK) \<union> knows Spy evs) =
+          insert (Key K) (analz (Key ` KK \<union> knows Spy evs))"
+by (simp add: gen_new_keys_not_analzd)
+
+
+subsection{*Secrecy of Symmetric Keys*}
+
+lemma Key_analz_image_Key_lemma:
+     "P --> (Key K \<in> analz (Key`KK Un H)) --> (K\<in>KK | Key K \<in> analz H)
+      ==>
+      P --> (Key K \<in> analz (Key`KK Un H)) = (K\<in>KK | Key K \<in> analz H)"
+by (blast intro: analz_mono [THEN [2] rev_subsetD])
+
+
+lemma symKey_compromise:
+     "evs \<in> set_pur \<Longrightarrow>
+      (\<forall>SK KK. SK \<in> symKeys \<longrightarrow>
+        (\<forall>K \<in> KK. K \<notin> range(\<lambda>C. priEK C)) \<longrightarrow>
+               (Key SK \<in> analz (Key`KK \<union> (knows Spy evs))) =
+               (SK \<in> KK \<or> Key SK \<in> analz (knows Spy evs)))"
+apply (erule set_pur.induct)
+apply (rule_tac [!] allI)+
+apply (rule_tac [!] impI [THEN Key_analz_image_Key_lemma, THEN impI])+
+apply (frule_tac [9] AuthReq_msg_in_analz_spies) --{*AReq*}
+apply (valid_certificate_tac [8]) --{*PReqS*}
+apply (valid_certificate_tac [7]) --{*PReqUns*}
+apply (simp_all
+         del: image_insert image_Un imp_disjL
+         add: analz_image_keys_simps disj_simps
+              analz_Key_image_insert_eq notin_image_iff
+              analz_insert_simps analz_image_priEK)
+  --{*8 seconds on a 1.6GHz machine*}
+apply spy_analz --{*Fake*}
+apply (blast elim!: ballE)+ --{*PReq: unsigned and signed*}
+done
+
+
+
+subsection{*Secrecy of Nonces*}
+
+text{*As usual: we express the property as a logical equivalence*}
+lemma Nonce_analz_image_Key_lemma:
+     "P --> (Nonce N \<in> analz (Key`KK Un H)) --> (Nonce N \<in> analz H)
+      ==> P --> (Nonce N \<in> analz (Key`KK Un H)) = (Nonce N \<in> analz H)"
+by (blast intro: analz_mono [THEN [2] rev_subsetD])
+
+text{*The @{text "(no_asm)"} attribute is essential, since it retains
+  the quantifier and allows the simprule's condition to itself be simplified.*}
+lemma Nonce_compromise [rule_format (no_asm)]:
+     "evs \<in> set_pur ==>
+      (\<forall>N KK. (\<forall>K \<in> KK. K \<notin> range(\<lambda>C. priEK C))   -->
+              (Nonce N \<in> analz (Key`KK \<union> (knows Spy evs))) =
+              (Nonce N \<in> analz (knows Spy evs)))"
+apply (erule set_pur.induct)
+apply (rule_tac [!] allI)+
+apply (rule_tac [!] impI [THEN Nonce_analz_image_Key_lemma])+
+apply (frule_tac [9] AuthReq_msg_in_analz_spies) --{*AReq*}
+apply (valid_certificate_tac [8]) --{*PReqS*}
+apply (valid_certificate_tac [7]) --{*PReqUns*}
+apply (simp_all
+         del: image_insert image_Un imp_disjL
+         add: analz_image_keys_simps disj_simps symKey_compromise
+              analz_Key_image_insert_eq notin_image_iff
+              analz_insert_simps analz_image_priEK)
+  --{*8 seconds on a 1.6GHz machine*}
+apply spy_analz --{*Fake*}
+apply (blast elim!: ballE) --{*PReqS*}
+done
+
+lemma PANSecret_notin_spies:
+     "[|Nonce (PANSecret k) \<in> analz (knows Spy evs);  evs \<in> set_pur|]
+      ==> 
+       (\<exists>V W X Y KC2 M. \<exists>P \<in> bad.
+          Says (Cardholder k) M
+               {|{|W, EXcrypt KC2 (pubEK P) X {|Y, Nonce (PANSecret k)|}|},
+                 V|}  \<in>  set evs)"
+apply (erule rev_mp)
+apply (erule set_pur.induct)
+apply (frule_tac [9] AuthReq_msg_in_analz_spies)
+apply (valid_certificate_tac [8]) --{*PReqS*}
+apply (simp_all
+         del: image_insert image_Un imp_disjL
+         add: analz_image_keys_simps disj_simps
+              symKey_compromise pushes sign_def Nonce_compromise
+              analz_Key_image_insert_eq notin_image_iff
+              analz_insert_simps analz_image_priEK)
+  --{*2.5 seconds on a 1.6GHz machine*}
+apply spy_analz
+apply (blast dest!: Gets_imp_knows_Spy [THEN analz.Inj])
+apply (blast dest: Says_imp_knows_Spy [THEN analz.Inj] 
+                   Gets_imp_knows_Spy [THEN analz.Inj])
+apply (blast dest: Gets_imp_knows_Spy [THEN analz.Inj]) --{*PReqS*}
+apply (blast dest: Says_imp_knows_Spy [THEN analz.Inj] 
+                   Gets_imp_knows_Spy [THEN analz.Inj]) --{*PRes*}
+done
+
+text{*This theorem is a bit silly, in that many CardSecrets are 0!
+  But then we don't care.  NOT USED*}
+lemma CardSecret_notin_spies:
+     "evs \<in> set_pur ==> Nonce (CardSecret i) \<notin> parts (knows Spy evs)"
+by (erule set_pur.induct, auto)
+
+
+subsection{*Confidentiality of PAN*}
+
+lemma analz_image_pan_lemma:
+     "(Pan P \<in> analz (Key`nE Un H)) --> (Pan P \<in> analz H)  ==>
+      (Pan P \<in> analz (Key`nE Un H)) =   (Pan P \<in> analz H)"
+by (blast intro: analz_mono [THEN [2] rev_subsetD])
+
+text{*The @{text "(no_asm)"} attribute is essential, since it retains
+  the quantifier and allows the simprule's condition to itself be simplified.*}
+lemma analz_image_pan [rule_format (no_asm)]:
+     "evs \<in> set_pur ==>
+       \<forall>KK. (\<forall>K \<in> KK. K \<notin> range(\<lambda>C. priEK C)) -->
+            (Pan P \<in> analz (Key`KK Un (knows Spy evs))) =
+            (Pan P \<in> analz (knows Spy evs))"
+apply (erule set_pur.induct)
+apply (rule_tac [!] allI impI)+
+apply (rule_tac [!] analz_image_pan_lemma)+
+apply (frule_tac [9] AuthReq_msg_in_analz_spies) --{*AReq*}
+apply (valid_certificate_tac [8]) --{*PReqS*}
+apply (valid_certificate_tac [7]) --{*PReqUns*}
+apply (simp_all
+         del: image_insert image_Un imp_disjL
+         add: analz_image_keys_simps
+              symKey_compromise pushes sign_def
+              analz_Key_image_insert_eq notin_image_iff
+              analz_insert_simps analz_image_priEK)
+  --{*7 seconds on a 1.6GHz machine*}
+apply spy_analz --{*Fake*}
+apply auto
+done
+
+lemma analz_insert_pan:
+     "[| evs \<in> set_pur;  K \<notin> range(\<lambda>C. priEK C) |] ==>
+          (Pan P \<in> analz (insert (Key K) (knows Spy evs))) =
+          (Pan P \<in> analz (knows Spy evs))"
+by (simp del: image_insert image_Un
+         add: analz_image_keys_simps analz_image_pan)
+
+text{*Confidentiality of the PAN, unsigned case.*}
+theorem pan_confidentiality_unsigned:
+     "[| Pan (pan C) \<in> analz(knows Spy evs);  C = Cardholder k;
+         CardSecret k = 0;  evs \<in> set_pur|]
+    ==> \<exists>P M KC1 K X Y.
+     Says C M {|EXHcrypt KC1 (pubEK P) X (Pan (pan C)), Y|}
+          \<in> set evs  &
+     P \<in> bad"
+apply (erule rev_mp)
+apply (erule set_pur.induct)
+apply (frule_tac [9] AuthReq_msg_in_analz_spies) --{*AReq*}
+apply (valid_certificate_tac [8]) --{*PReqS*}
+apply (valid_certificate_tac [7]) --{*PReqUns*}
+apply (simp_all
+         del: image_insert image_Un imp_disjL
+         add: analz_image_keys_simps analz_insert_pan analz_image_pan
+              notin_image_iff
+              analz_insert_simps analz_image_priEK)
+  --{*3 seconds on a 1.6GHz machine*}
+apply spy_analz --{*Fake*}
+apply blast --{*PReqUns: unsigned*}
+apply force --{*PReqS: signed*}
+done
+
+text{*Confidentiality of the PAN, signed case.*}
+theorem pan_confidentiality_signed:
+ "[|Pan (pan C) \<in> analz(knows Spy evs);  C = Cardholder k;
+    CardSecret k \<noteq> 0;  evs \<in> set_pur|]
+  ==> \<exists>P M KC2 PIDualSign_1 PIDualSign_2 other OIDualSign.
+      Says C M {|{|PIDualSign_1, 
+                   EXcrypt KC2 (pubEK P) PIDualSign_2 {|Pan (pan C), other|}|}, 
+       OIDualSign|} \<in> set evs  &  P \<in> bad"
+apply (erule rev_mp)
+apply (erule set_pur.induct)
+apply (frule_tac [9] AuthReq_msg_in_analz_spies) --{*AReq*}
+apply (valid_certificate_tac [8]) --{*PReqS*}
+apply (valid_certificate_tac [7]) --{*PReqUns*}
+apply (simp_all
+         del: image_insert image_Un imp_disjL
+         add: analz_image_keys_simps analz_insert_pan analz_image_pan
+              notin_image_iff
+              analz_insert_simps analz_image_priEK)
+  --{*3 seconds on a 1.6GHz machine*}
+apply spy_analz --{*Fake*}
+apply force --{*PReqUns: unsigned*}
+apply blast --{*PReqS: signed*}
+done
+
+text{*General goal: that C, M and PG agree on those details of the transaction
+     that they are allowed to know about.  PG knows about price and account
+     details.  M knows about the order description and price.  C knows both.*}
+
+
+subsection{*Proofs Common to Signed and Unsigned Versions*}
+
+lemma M_Notes_PG:
+     "[|Notes M {|Number LID_M, Agent P, Agent M, Agent C, etc|} \<in> set evs;
+        evs \<in> set_pur|] ==> \<exists>j. P = PG j"
+by (erule rev_mp, erule set_pur.induct, simp_all)
+
+text{*If we trust M, then @{term LID_M} determines his choice of P
+      (Payment Gateway)*}
+lemma goodM_gives_correct_PG:
+     "[| MsgPInitRes = 
+            {|Number LID_M, xid, cc, cm, cert P EKj onlyEnc (priSK RCA)|};
+         Crypt (priSK M) (Hash MsgPInitRes) \<in> parts (knows Spy evs);
+         evs \<in> set_pur; M \<notin> bad |]
+      ==> \<exists>j trans.
+            P = PG j &
+            Notes M {|Number LID_M, Agent P, trans|} \<in> set evs"
+apply clarify
+apply (erule rev_mp)
+apply (erule set_pur.induct)
+apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
+apply simp_all
+apply (blast intro: M_Notes_PG)+
+done
+
+lemma C_gets_correct_PG:
+     "[| Gets A (sign (priSK M) {|Number LID_M, xid, cc, cm,
+                              cert P EKj onlyEnc (priSK RCA)|}) \<in> set evs;
+         evs \<in> set_pur;  M \<notin> bad|]
+      ==> \<exists>j trans.
+            P = PG j &
+            Notes M {|Number LID_M, Agent P, trans|} \<in> set evs &
+            EKj = pubEK P"
+by (rule refl [THEN goodM_gives_correct_PG, THEN exE], auto)
+
+text{*When C receives PInitRes, he learns M's choice of P*}
+lemma C_verifies_PInitRes:
+ "[| MsgPInitRes = {|Number LID_M, Number XID, Nonce Chall_C, Nonce Chall_M,
+           cert P EKj onlyEnc (priSK RCA)|};
+     Crypt (priSK M) (Hash MsgPInitRes) \<in> parts (knows Spy evs);
+     evs \<in> set_pur;  M \<notin> bad|]
+  ==> \<exists>j trans.
+         Notes M {|Number LID_M, Agent P, trans|} \<in> set evs &
+         P = PG j &
+         EKj = pubEK P"
+apply clarify
+apply (erule rev_mp)
+apply (erule set_pur.induct)
+apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
+apply simp_all
+apply (blast intro: M_Notes_PG)+
+done
+
+text{*Corollary of previous one*}
+lemma Says_C_PInitRes:
+     "[|Says A C (sign (priSK M)
+                      {|Number LID_M, Number XID,
+                        Nonce Chall_C, Nonce Chall_M,
+                        cert P EKj onlyEnc (priSK RCA)|})
+           \<in> set evs;  M \<notin> bad;  evs \<in> set_pur|]
+      ==> \<exists>j trans.
+           Notes M {|Number LID_M, Agent P, trans|} \<in> set evs &
+           P = PG j &
+           EKj = pubEK (PG j)"
+apply (frule Says_certificate_valid)
+apply (auto simp add: sign_def)
+apply (blast dest: refl [THEN goodM_gives_correct_PG])
+apply (blast dest: refl [THEN C_verifies_PInitRes])
+done
+
+text{*When P receives an AuthReq, he knows that the signed part originated 
+      with M. PIRes also has a signed message from M....*}
+lemma P_verifies_AuthReq:
+     "[| AuthReqData = {|Number LID_M, Number XID, HOIData, HOD|};
+         Crypt (priSK M) (Hash {|AuthReqData, Hash P_I|})
+           \<in> parts (knows Spy evs);
+         evs \<in> set_pur;  M \<notin> bad|]
+      ==> \<exists>j trans KM OIData HPIData.
+            Notes M {|Number LID_M, Agent (PG j), trans|} \<in> set evs &
+            Gets M {|P_I, OIData, HPIData|} \<in> set evs &
+            Says M (PG j) (EncB (priSK M) KM (pubEK (PG j)) AuthReqData P_I)
+              \<in> set evs"
+apply clarify
+apply (erule rev_mp)
+apply (erule set_pur.induct, simp_all)
+apply (frule_tac [4] M_Notes_PG, auto)
+done
+
+text{*When M receives AuthRes, he knows that P signed it, including
+  the identifying tags and the purchase amount, which he can verify.
+  (Although the spec has SIGNED and UNSIGNED forms of AuthRes, they
+   send the same message to M.)  The conclusion is weak: M is existentially
+  quantified! That is because Authorization Response does not refer to M, while
+  the digital envelope weakens the link between @{term MsgAuthRes} and
+  @{term"priSK M"}.  Changing the precondition to refer to 
+  @{term "Crypt K (sign SK M)"} requires assuming @{term K} to be secure, since
+  otherwise the Spy could create that message.*}
+theorem M_verifies_AuthRes:
+  "[| MsgAuthRes = {|{|Number LID_M, Number XID, Number PurchAmt|}, 
+                     Hash authCode|};
+      Crypt (priSK (PG j)) (Hash MsgAuthRes) \<in> parts (knows Spy evs);
+      PG j \<notin> bad;  evs \<in> set_pur|]
+   ==> \<exists>M KM KP HOIData HOD P_I.
+        Gets (PG j)
+           (EncB (priSK M) KM (pubEK (PG j))
+                    {|Number LID_M, Number XID, HOIData, HOD|}
+                    P_I) \<in> set evs &
+        Says (PG j) M
+             (EncB (priSK (PG j)) KP (pubEK M)
+              {|Number LID_M, Number XID, Number PurchAmt|}
+              authCode) \<in> set evs"
+apply clarify
+apply (erule rev_mp)
+apply (erule set_pur.induct)
+apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
+apply simp_all
+apply blast+
+done
+
+
+subsection{*Proofs for Unsigned Purchases*}
+
+text{*What we can derive from the ASSUMPTION that C issued a purchase request.
+   In the unsigned case, we must trust "C": there's no authentication.*}
+lemma C_determines_EKj:
+     "[| Says C M {|EXHcrypt KC1 EKj {|PIHead, Hash OIData|} (Pan (pan C)),
+                    OIData, Hash{|PIHead, Pan (pan C)|} |} \<in> set evs;
+         PIHead = {|Number LID_M, Trans_details|};
+         evs \<in> set_pur;  C = Cardholder k;  M \<notin> bad|]
+  ==> \<exists>trans j.
+               Notes M {|Number LID_M, Agent (PG j), trans |} \<in> set evs &
+               EKj = pubEK (PG j)"
+apply clarify
+apply (erule rev_mp)
+apply (erule set_pur.induct, simp_all)
+apply (valid_certificate_tac [2]) --{*PReqUns*}
+apply auto
+apply (blast dest: Gets_imp_Says Says_C_PInitRes)
+done
+
+
+text{*Unicity of @{term LID_M} between Merchant and Cardholder notes*}
+lemma unique_LID_M:
+     "[|Notes (Merchant i) {|Number LID_M, Agent P, Trans|} \<in> set evs;
+        Notes C {|Number LID_M, Agent M, Agent C, Number OD,
+             Number PA|} \<in> set evs;
+        evs \<in> set_pur|]
+      ==> M = Merchant i & Trans = {|Agent M, Agent C, Number OD, Number PA|}"
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule set_pur.induct, simp_all)
+apply (force dest!: Notes_imp_parts_subset_used)
+done
+
+text{*Unicity of @{term LID_M}, for two Merchant Notes events*}
+lemma unique_LID_M2:
+     "[|Notes M {|Number LID_M, Trans|} \<in> set evs;
+        Notes M {|Number LID_M, Trans'|} \<in> set evs;
+        evs \<in> set_pur|] ==> Trans' = Trans"
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule set_pur.induct, simp_all)
+apply (force dest!: Notes_imp_parts_subset_used)
+done
+
+text{*Lemma needed below: for the case that
+  if PRes is present, then @{term LID_M} has been used.*}
+lemma signed_imp_used:
+     "[| Crypt (priSK M) (Hash X) \<in> parts (knows Spy evs);
+         M \<notin> bad;  evs \<in> set_pur|] ==> parts {X} \<subseteq> used evs"
+apply (erule rev_mp)
+apply (erule set_pur.induct)
+apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
+apply simp_all
+apply safe
+apply blast+
+done
+
+text{*Similar, with nested Hash*}
+lemma signed_Hash_imp_used:
+     "[| Crypt (priSK C) (Hash {|H, Hash X|}) \<in> parts (knows Spy evs);
+         C \<notin> bad;  evs \<in> set_pur|] ==> parts {X} \<subseteq> used evs"
+apply (erule rev_mp)
+apply (erule set_pur.induct)
+apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
+apply simp_all
+apply safe
+apply blast+
+done
+
+text{*Lemma needed below: for the case that
+  if PRes is present, then @{text LID_M} has been used.*}
+lemma PRes_imp_LID_used:
+     "[| Crypt (priSK M) (Hash {|N, X|}) \<in> parts (knows Spy evs);
+         M \<notin> bad;  evs \<in> set_pur|] ==> N \<in> used evs"
+by (drule signed_imp_used, auto)
+
+text{*When C receives PRes, he knows that M and P agreed to the purchase details.
+  He also knows that P is the same PG as before*}
+lemma C_verifies_PRes_lemma:
+     "[| Crypt (priSK M) (Hash MsgPRes) \<in> parts (knows Spy evs);
+         Notes C {|Number LID_M, Trans |} \<in> set evs;
+         Trans = {| Agent M, Agent C, Number OrderDesc, Number PurchAmt |};
+         MsgPRes = {|Number LID_M, Number XID, Nonce Chall_C,
+                Hash (Number PurchAmt)|};
+         evs \<in> set_pur;  M \<notin> bad|]
+  ==> \<exists>j KP.
+        Notes M {|Number LID_M, Agent (PG j), Trans |}
+          \<in> set evs &
+        Gets M (EncB (priSK (PG j)) KP (pubEK M)
+                {|Number LID_M, Number XID, Number PurchAmt|}
+                authCode)
+          \<in> set evs &
+        Says M C (sign (priSK M) MsgPRes) \<in> set evs"
+apply clarify
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule set_pur.induct)
+apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
+apply simp_all
+apply blast
+apply blast
+apply (blast dest: PRes_imp_LID_used)
+apply (frule M_Notes_PG, auto)
+apply (blast dest: unique_LID_M)
+done
+
+text{*When the Cardholder receives Purchase Response from an uncompromised
+Merchant, he knows that M sent it. He also knows that M received a message signed
+by a Payment Gateway chosen by M to authorize the purchase.*}
+theorem C_verifies_PRes:
+     "[| MsgPRes = {|Number LID_M, Number XID, Nonce Chall_C,
+                     Hash (Number PurchAmt)|};
+         Gets C (sign (priSK M) MsgPRes) \<in> set evs;
+         Notes C {|Number LID_M, Agent M, Agent C, Number OrderDesc,
+                   Number PurchAmt|} \<in> set evs;
+         evs \<in> set_pur;  M \<notin> bad|]
+  ==> \<exists>P KP trans.
+        Notes M {|Number LID_M,Agent P, trans|} \<in> set evs &
+        Gets M (EncB (priSK P) KP (pubEK M)
+                {|Number LID_M, Number XID, Number PurchAmt|}
+                authCode)  \<in>  set evs &
+        Says M C (sign (priSK M) MsgPRes) \<in> set evs"
+apply (rule C_verifies_PRes_lemma [THEN exE])
+apply (auto simp add: sign_def)
+done
+
+subsection{*Proofs for Signed Purchases*}
+
+text{*Some Useful Lemmas: the cardholder knows what he is doing*}
+
+lemma Crypt_imp_Says_Cardholder:
+     "[| Crypt K {|{|{|Number LID_M, others|}, Hash OIData|}, Hash PANData|}
+           \<in> parts (knows Spy evs);
+         PANData = {|Pan (pan (Cardholder k)), Nonce (PANSecret k)|};
+         Key K \<notin> analz (knows Spy evs);
+         evs \<in> set_pur|]
+  ==> \<exists>M shash EK HPIData.
+       Says (Cardholder k) M {|{|shash,
+          Crypt K
+            {|{|{|Number LID_M, others|}, Hash OIData|}, Hash PANData|},
+           Crypt EK {|Key K, PANData|}|},
+          OIData, HPIData|} \<in> set evs"
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule set_pur.induct, analz_mono_contra)
+apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
+apply simp_all
+apply auto
+done
+
+lemma Says_PReqS_imp_trans_details_C:
+     "[| MsgPReqS = {|{|shash,
+                 Crypt K
+                  {|{|{|Number LID_M, PIrest|}, Hash OIData|}, hashpd|},
+            cryptek|}, data|};
+         Says (Cardholder k) M MsgPReqS \<in> set evs;
+         evs \<in> set_pur |]
+   ==> \<exists>trans.
+           Notes (Cardholder k) 
+                 {|Number LID_M, Agent M, Agent (Cardholder k), trans|}
+            \<in> set evs"
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule set_pur.induct)
+apply (simp_all (no_asm_simp))
+apply auto
+done
+
+text{*Can't happen: only Merchants create this type of Note*}
+lemma Notes_Cardholder_self_False:
+     "[|Notes (Cardholder k)
+          {|Number n, Agent P, Agent (Cardholder k), Agent C, etc|} \<in> set evs;
+        evs \<in> set_pur|] ==> False"
+by (erule rev_mp, erule set_pur.induct, auto)
+
+text{*When M sees a dual signature, he knows that it originated with C.
+  Using XID he knows it was intended for him.
+  This guarantee isn't useful to P, who never gets OIData.*}
+theorem M_verifies_Signed_PReq:
+ "[| MsgDualSign = {|HPIData, Hash OIData|};
+     OIData = {|Number LID_M, etc|};
+     Crypt (priSK C) (Hash MsgDualSign) \<in> parts (knows Spy evs);
+     Notes M {|Number LID_M, Agent P, extras|} \<in> set evs;
+     M = Merchant i;  C = Cardholder k;  C \<notin> bad;  evs \<in> set_pur|]
+  ==> \<exists>PIData PICrypt.
+        HPIData = Hash PIData &
+        Says C M {|{|sign (priSK C) MsgDualSign, PICrypt|}, OIData, Hash PIData|}
+          \<in> set evs"
+apply clarify
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule set_pur.induct)
+apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
+apply simp_all
+apply blast
+apply (metis subsetD insert_subset parts.Fst parts_increasing signed_Hash_imp_used)
+apply (metis unique_LID_M)
+apply (blast dest!: Notes_Cardholder_self_False)
+done
+
+text{*When P sees a dual signature, he knows that it originated with C.
+  and was intended for M. This guarantee isn't useful to M, who never gets
+  PIData. I don't see how to link @{term "PG j"} and @{text LID_M} without
+  assuming @{term "M \<notin> bad"}.*}
+theorem P_verifies_Signed_PReq:
+     "[| MsgDualSign = {|Hash PIData, HOIData|};
+         PIData = {|PIHead, PANData|};
+         PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M,
+                    TransStain|};
+         Crypt (priSK C) (Hash MsgDualSign) \<in> parts (knows Spy evs);
+         evs \<in> set_pur;  C \<notin> bad;  M \<notin> bad|]
+    ==> \<exists>OIData OrderDesc K j trans.
+          HOD = Hash{|Number OrderDesc, Number PurchAmt|} &
+          HOIData = Hash OIData &
+          Notes M {|Number LID_M, Agent (PG j), trans|} \<in> set evs &
+          Says C M {|{|sign (priSK C) MsgDualSign,
+                     EXcrypt K (pubEK (PG j))
+                                {|PIHead, Hash OIData|} PANData|},
+                     OIData, Hash PIData|}
+            \<in> set evs"
+apply clarify
+apply (erule rev_mp)
+apply (erule set_pur.induct, simp_all)
+apply (auto dest!: C_gets_correct_PG)
+done
+
+lemma C_determines_EKj_signed:
+     "[| Says C M {|{|sign (priSK C) text,
+                      EXcrypt K EKj {|PIHead, X|} Y|}, Z|} \<in> set evs;
+         PIHead = {|Number LID_M, Number XID, W|};
+         C = Cardholder k;  evs \<in> set_pur;  M \<notin> bad|]
+  ==> \<exists> trans j.
+         Notes M {|Number LID_M, Agent (PG j), trans|} \<in> set evs &
+         EKj = pubEK (PG j)"
+apply clarify
+apply (erule rev_mp)
+apply (erule set_pur.induct, simp_all, auto)
+apply (blast dest: C_gets_correct_PG)
+done
+
+lemma M_Says_AuthReq:
+     "[| AuthReqData = {|Number LID_M, Number XID, HOIData, HOD|};
+         sign (priSK M) {|AuthReqData, Hash P_I|} \<in> parts (knows Spy evs);
+         evs \<in> set_pur;  M \<notin> bad|]
+   ==> \<exists>j trans KM.
+           Notes M {|Number LID_M, Agent (PG j), trans |} \<in> set evs &
+             Says M (PG j)
+               (EncB (priSK M) KM (pubEK (PG j)) AuthReqData P_I)
+              \<in> set evs"
+apply (rule refl [THEN P_verifies_AuthReq, THEN exE])
+apply (auto simp add: sign_def)
+done
+
+text{*A variant of @{text M_verifies_Signed_PReq} with explicit PI information.
+  Even here we cannot be certain about what C sent to M, since a bad
+  PG could have replaced the two key fields.  (NOT USED)*}
+lemma Signed_PReq_imp_Says_Cardholder:
+     "[| MsgDualSign = {|Hash PIData, Hash OIData|};
+         OIData = {|Number LID_M, Number XID, Nonce Chall_C, HOD, etc|};
+         PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M,
+                    TransStain|};
+         PIData = {|PIHead, PANData|};
+         Crypt (priSK C) (Hash MsgDualSign) \<in> parts (knows Spy evs);
+         M = Merchant i;  C = Cardholder k;  C \<notin> bad;  evs \<in> set_pur|]
+      ==> \<exists>KC EKj.
+            Says C M {|{|sign (priSK C) MsgDualSign,
+                       EXcrypt KC EKj {|PIHead, Hash OIData|} PANData|},
+                       OIData, Hash PIData|}
+              \<in> set evs"
+apply clarify
+apply (erule rev_mp)
+apply (erule rev_mp)
+apply (erule set_pur.induct, simp_all, auto)
+done
+
+text{*When P receives an AuthReq and a dual signature, he knows that C and M
+  agree on the essential details.  PurchAmt however is never sent by M to
+  P; instead C and M both send 
+     @{term "HOD = Hash{|Number OrderDesc, Number PurchAmt|}"}
+  and P compares the two copies of HOD.
+
+  Agreement can't be proved for some things, including the symmetric keys
+  used in the digital envelopes.  On the other hand, M knows the true identity
+  of PG (namely j'), and sends AReq there; he can't, however, check that
+  the EXcrypt involves the correct PG's key.
+*}
+theorem P_sees_CM_agreement:
+     "[| AuthReqData = {|Number LID_M, Number XID, HOIData, HOD|};
+         KC \<in> symKeys;
+         Gets (PG j) (EncB (priSK M) KM (pubEK (PG j)) AuthReqData P_I)
+           \<in> set evs;
+         C = Cardholder k;
+         PI_sign = sign (priSK C) {|Hash PIData, HOIData|};
+         P_I = {|PI_sign,
+                 EXcrypt KC (pubEK (PG j)) {|PIHead, HOIData|} PANData|};
+         PANData = {|Pan (pan C), Nonce (PANSecret k)|};
+         PIData = {|PIHead, PANData|};
+         PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M,
+                    TransStain|};
+         evs \<in> set_pur;  C \<notin> bad;  M \<notin> bad|]
+  ==> \<exists>OIData OrderDesc KM' trans j' KC' KC'' P_I' P_I''.
+           HOD = Hash{|Number OrderDesc, Number PurchAmt|} &
+           HOIData = Hash OIData &
+           Notes M {|Number LID_M, Agent (PG j'), trans|} \<in> set evs &
+           Says C M {|P_I', OIData, Hash PIData|} \<in> set evs &
+           Says M (PG j') (EncB (priSK M) KM' (pubEK (PG j'))
+                           AuthReqData P_I'')  \<in>  set evs &
+           P_I' = {|PI_sign,
+             EXcrypt KC' (pubEK (PG j')) {|PIHead, Hash OIData|} PANData|} &
+           P_I'' = {|PI_sign,
+             EXcrypt KC'' (pubEK (PG j)) {|PIHead, Hash OIData|} PANData|}"
+apply clarify
+apply (rule exE)
+apply (rule P_verifies_Signed_PReq [OF refl refl refl])
+apply (simp (no_asm_use) add: sign_def EncB_def, blast)
+apply (assumption+, clarify, simp)
+apply (drule Gets_imp_knows_Spy [THEN parts.Inj], assumption)
+apply (blast elim: EncB_partsE dest: refl [THEN M_Says_AuthReq] unique_LID_M2)
+done
+
+end
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/SET_Protocol/ROOT.ML
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/SET_Protocol/ROOT.ML	Tue Oct 20 20:03:23 2009 +0200
@@ -0,0 +1,9 @@
+(*  Title:      HOL/SET_Protocol/ROOT.ML
+    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
+    Copyright   2003  University of Cambridge
+
+Root file for the SET protocol proofs.
+*)
+
+no_document use_thy "Nat_Int_Bij";
+use_thys ["Cardholder_Registration", "Merchant_Registration", "Purchase"];
diff -r 9cf389429f6d -r 9aa8bfb1649d src/HOL/SET_Protocol/document/root.tex
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/SET_Protocol/document/root.tex	Tue Oct 20 20:03:23 2009 +0200
@@ -0,0 +1,27 @@
+\documentclass[10pt,a4paper,twoside]{article}
+\usepackage{graphicx}
+\usepackage{latexsym,theorem}
+\usepackage{isabelle,isabellesym}
+\usepackage{pdfsetup}\urlstyle{rm}
+
+\begin{document}
+
+\pagestyle{headings}
+\pagenumbering{arabic}
+
+\title{Verification of The SET Protocol}
+\author{Giampaolo Bella, Fabio Massacci, Lawrence C. Paulson et al.}
+\maketitle
+
+\tableofcontents
+
+\begin{center}
+  \includegraphics[scale=0.5]{session_graph}  
+\end{center}
+
+\newpage
+
+\parindent 0pt\parskip 0.5ex
+
+\input{session}
+\end{document}