modernized session SET_Protocol;
authorwenzelm
Tue Oct 20 20:03:23 2009 +0200 (2009-10-20)
changeset 330289aa8bfb1649d
parent 33027 9cf389429f6d
child 33029 2fefe039edf1
modernized session SET_Protocol;
Admin/isatest/isatest-stats
src/HOL/IsaMakefile
src/HOL/README.html
src/HOL/SET-Protocol/Cardholder_Registration.thy
src/HOL/SET-Protocol/EventSET.thy
src/HOL/SET-Protocol/Merchant_Registration.thy
src/HOL/SET-Protocol/MessageSET.thy
src/HOL/SET-Protocol/PublicSET.thy
src/HOL/SET-Protocol/Purchase.thy
src/HOL/SET-Protocol/ROOT.ML
src/HOL/SET-Protocol/document/root.tex
src/HOL/SET_Protocol/Cardholder_Registration.thy
src/HOL/SET_Protocol/Event_SET.thy
src/HOL/SET_Protocol/Merchant_Registration.thy
src/HOL/SET_Protocol/Message_SET.thy
src/HOL/SET_Protocol/Public_SET.thy
src/HOL/SET_Protocol/Purchase.thy
src/HOL/SET_Protocol/ROOT.ML
src/HOL/SET_Protocol/document/root.tex
     1.1 --- a/Admin/isatest/isatest-stats	Tue Oct 20 19:52:04 2009 +0200
     1.2 +++ b/Admin/isatest/isatest-stats	Tue Oct 20 20:03:23 2009 +0200
     1.3 @@ -27,7 +27,7 @@
     1.4    HOL-Nominal-Examples \
     1.5    HOL-Number_Theory \
     1.6    HOL-Old_Number_Theory \
     1.7 -  HOL-SET-Protocol \
     1.8 +  HOL-SET_Protocol \
     1.9    HOL-UNITY \
    1.10    HOL-Word \
    1.11    HOL-ex \
     2.1 --- a/src/HOL/IsaMakefile	Tue Oct 20 19:52:04 2009 +0200
     2.2 +++ b/src/HOL/IsaMakefile	Tue Oct 20 20:03:23 2009 +0200
     2.3 @@ -38,7 +38,7 @@
     2.4    HOL-Number_Theory \
     2.5    HOL-Old_Number_Theory \
     2.6    HOL-Prolog \
     2.7 -  HOL-SET-Protocol \
     2.8 +  HOL-SET_Protocol \
     2.9    HOL-SizeChange \
    2.10    HOL-SMT-Examples \
    2.11    HOL-Statespace \
    2.12 @@ -932,16 +932,16 @@
    2.13  	@$(ISABELLE_TOOL) usedir $(OUT)/HOL Isar_Examples
    2.14  
    2.15  
    2.16 -## HOL-SET-Protocol
    2.17 +## HOL-SET_Protocol
    2.18  
    2.19 -HOL-SET-Protocol: HOL $(LOG)/HOL-SET-Protocol.gz
    2.20 +HOL-SET_Protocol: HOL $(LOG)/HOL-SET_Protocol.gz
    2.21  
    2.22 -$(LOG)/HOL-SET-Protocol.gz: $(OUT)/HOL SET-Protocol/ROOT.ML		\
    2.23 -  SET-Protocol/MessageSET.thy SET-Protocol/EventSET.thy			\
    2.24 -  SET-Protocol/PublicSET.thy SET-Protocol/Cardholder_Registration.thy	\
    2.25 -  SET-Protocol/Merchant_Registration.thy SET-Protocol/Purchase.thy	\
    2.26 -  SET-Protocol/document/root.tex
    2.27 -	@$(ISABELLE_TOOL) usedir -g true $(OUT)/HOL SET-Protocol
    2.28 +$(LOG)/HOL-SET_Protocol.gz: $(OUT)/HOL SET_Protocol/ROOT.ML		\
    2.29 +  SET_Protocol/Message_SET.thy SET_Protocol/Event_SET.thy		\
    2.30 +  SET_Protocol/Public_SET.thy SET_Protocol/Cardholder_Registration.thy	\
    2.31 +  SET_Protocol/Merchant_Registration.thy SET_Protocol/Purchase.thy	\
    2.32 +  SET_Protocol/document/root.tex
    2.33 +	@$(ISABELLE_TOOL) usedir -g true $(OUT)/HOL SET_Protocol
    2.34  
    2.35  
    2.36  ## HOL-Matrix
    2.37 @@ -1315,7 +1315,7 @@
    2.38  		$(LOG)/HOL-MicroJava.gz $(LOG)/HOL-NanoJava.gz		\
    2.39  		$(LOG)/HOL-Nominal-Examples.gz $(LOG)/HOL-IOA.gz	\
    2.40  		$(LOG)/HOL-Lattice $(LOG)/HOL-Matrix			\
    2.41 -		$(LOG)/HOL-Hahn_Banach.gz $(LOG)/HOL-SET-Protocol.gz	\
    2.42 +		$(LOG)/HOL-Hahn_Banach.gz $(LOG)/HOL-SET_Protocol.gz	\
    2.43  		$(LOG)/TLA-Inc.gz $(LOG)/TLA-Buffer.gz			\
    2.44  		$(LOG)/TLA-Memory.gz $(LOG)/HOL-Library.gz		\
    2.45  		$(LOG)/HOL-Unix.gz $(OUT)/HOL-Word $(LOG)/HOL-Word.gz	\
     3.1 --- a/src/HOL/README.html	Tue Oct 20 19:52:04 2009 +0200
     3.2 +++ b/src/HOL/README.html	Tue Oct 20 20:03:23 2009 +0200
     3.3 @@ -99,7 +99,7 @@
     3.4  <dt>Hahn_Banach
     3.5  <dd>the Hahn-Banach theorem for real vector spaces (in Isabelle/Isar)
     3.6  
     3.7 -<dt>SET-Protocol
     3.8 +<dt>SET_Protocol
     3.9  <dd>verification of the SET Protocol
    3.10  
    3.11  <dt>Subst
     4.1 --- a/src/HOL/SET-Protocol/Cardholder_Registration.thy	Tue Oct 20 19:52:04 2009 +0200
     4.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.3 @@ -1,1054 +0,0 @@
     4.4 -(*  Title:      HOL/SET-Protocol/Cardholder_Registration.thy
     4.5 -    Author:     Giampaolo Bella
     4.6 -    Author:     Fabio Massacci
     4.7 -    Author:     Lawrence C Paulson
     4.8 -    Author:     Piero Tramontano
     4.9 -*)
    4.10 -
    4.11 -header{*The SET Cardholder Registration Protocol*}
    4.12 -
    4.13 -theory Cardholder_Registration imports PublicSET begin
    4.14 -
    4.15 -text{*Note: nonces seem to consist of 20 bytes.  That includes both freshness
    4.16 -challenges (Chall-EE, etc.) and important secrets (CardSecret, PANsecret)
    4.17 -*}
    4.18 -
    4.19 -text{*Simplifications involving @{text analz_image_keys_simps} appear to
    4.20 -have become much slower. The cause is unclear. However, there is a big blow-up
    4.21 -and the rewriting is very sensitive to the set of rewrite rules given.*}
    4.22 -
    4.23 -subsection{*Predicate Formalizing the Encryption Association between Keys *}
    4.24 -
    4.25 -consts
    4.26 -  KeyCryptKey :: "[key, key, event list] => bool"
    4.27 -
    4.28 -primrec
    4.29 -
    4.30 -KeyCryptKey_Nil:
    4.31 -  "KeyCryptKey DK K [] = False"
    4.32 -
    4.33 -KeyCryptKey_Cons:
    4.34 -      --{*Says is the only important case.
    4.35 -        1st case: CR5, where KC3 encrypts KC2.
    4.36 -        2nd case: any use of priEK C.
    4.37 -        Revision 1.12 has a more complicated version with separate treatment of
    4.38 -          the dependency of KC1, KC2 and KC3 on priEK (CA i.)  Not needed since
    4.39 -          priEK C is never sent (and so can't be lost except at the start). *}
    4.40 -  "KeyCryptKey DK K (ev # evs) =
    4.41 -   (KeyCryptKey DK K evs |
    4.42 -    (case ev of
    4.43 -      Says A B Z =>
    4.44 -       ((\<exists>N X Y. A \<noteq> Spy &
    4.45 -                 DK \<in> symKeys &
    4.46 -                 Z = {|Crypt DK {|Agent A, Nonce N, Key K, X|}, Y|}) |
    4.47 -        (\<exists>C. DK = priEK C))
    4.48 -    | Gets A' X => False
    4.49 -    | Notes A' X => False))"
    4.50 -
    4.51 -
    4.52 -subsection{*Predicate formalizing the association between keys and nonces *}
    4.53 -
    4.54 -consts
    4.55 -  KeyCryptNonce :: "[key, key, event list] => bool"
    4.56 -
    4.57 -primrec
    4.58 -
    4.59 -KeyCryptNonce_Nil:
    4.60 -  "KeyCryptNonce EK K [] = False"
    4.61 -
    4.62 -KeyCryptNonce_Cons:
    4.63 -  --{*Says is the only important case.
    4.64 -    1st case: CR3, where KC1 encrypts NC2 (distinct from CR5 due to EXH);
    4.65 -    2nd case: CR5, where KC3 encrypts NC3;
    4.66 -    3rd case: CR6, where KC2 encrypts NC3;
    4.67 -    4th case: CR6, where KC2 encrypts NonceCCA;
    4.68 -    5th case: any use of @{term "priEK C"} (including CardSecret).
    4.69 -    NB the only Nonces we need to keep secret are CardSecret and NonceCCA.
    4.70 -    But we can't prove @{text Nonce_compromise} unless the relation covers ALL
    4.71 -        nonces that the protocol keeps secret.
    4.72 -  *}
    4.73 -  "KeyCryptNonce DK N (ev # evs) =
    4.74 -   (KeyCryptNonce DK N evs |
    4.75 -    (case ev of
    4.76 -      Says A B Z =>
    4.77 -       A \<noteq> Spy &
    4.78 -       ((\<exists>X Y. DK \<in> symKeys &
    4.79 -               Z = (EXHcrypt DK X {|Agent A, Nonce N|} Y)) |
    4.80 -        (\<exists>X Y. DK \<in> symKeys &
    4.81 -               Z = {|Crypt DK {|Agent A, Nonce N, X|}, Y|}) |
    4.82 -        (\<exists>K i X Y.
    4.83 -          K \<in> symKeys &
    4.84 -          Z = Crypt K {|sign (priSK (CA i)) {|Agent B, Nonce N, X|}, Y|} &
    4.85 -          (DK=K | KeyCryptKey DK K evs)) |
    4.86 -        (\<exists>K C NC3 Y.
    4.87 -          K \<in> symKeys &
    4.88 -          Z = Crypt K
    4.89 -                {|sign (priSK C) {|Agent B, Nonce NC3, Agent C, Nonce N|},
    4.90 -                  Y|} &
    4.91 -          (DK=K | KeyCryptKey DK K evs)) |
    4.92 -        (\<exists>C. DK = priEK C))
    4.93 -    | Gets A' X => False
    4.94 -    | Notes A' X => False))"
    4.95 -
    4.96 -
    4.97 -subsection{*Formal protocol definition *}
    4.98 -
    4.99 -inductive_set
   4.100 -  set_cr :: "event list set"
   4.101 -where
   4.102 -
   4.103 -  Nil:    --{*Initial trace is empty*}
   4.104 -          "[] \<in> set_cr"
   4.105 -
   4.106 -| Fake:    --{*The spy MAY say anything he CAN say.*}
   4.107 -           "[| evsf \<in> set_cr; X \<in> synth (analz (knows Spy evsf)) |]
   4.108 -            ==> Says Spy B X  # evsf \<in> set_cr"
   4.109 -
   4.110 -| Reception: --{*If A sends a message X to B, then B might receive it*}
   4.111 -             "[| evsr \<in> set_cr; Says A B X \<in> set evsr |]
   4.112 -              ==> Gets B X  # evsr \<in> set_cr"
   4.113 -
   4.114 -| SET_CR1: --{*CardCInitReq: C initiates a run, sending a nonce to CCA*}
   4.115 -             "[| evs1 \<in> set_cr;  C = Cardholder k;  Nonce NC1 \<notin> used evs1 |]
   4.116 -              ==> Says C (CA i) {|Agent C, Nonce NC1|} # evs1 \<in> set_cr"
   4.117 -
   4.118 -| SET_CR2: --{*CardCInitRes: CA responds sending NC1 and its certificates*}
   4.119 -             "[| evs2 \<in> set_cr;
   4.120 -                 Gets (CA i) {|Agent C, Nonce NC1|} \<in> set evs2 |]
   4.121 -              ==> Says (CA i) C
   4.122 -                       {|sign (priSK (CA i)) {|Agent C, Nonce NC1|},
   4.123 -                         cert (CA i) (pubEK (CA i)) onlyEnc (priSK RCA),
   4.124 -                         cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|}
   4.125 -                    # evs2 \<in> set_cr"
   4.126 -
   4.127 -| SET_CR3:
   4.128 -   --{*RegFormReq: C sends his PAN and a new nonce to CA.
   4.129 -   C verifies that
   4.130 -    - nonce received is the same as that sent;
   4.131 -    - certificates are signed by RCA;
   4.132 -    - certificates are an encryption certificate (flag is onlyEnc) and a
   4.133 -      signature certificate (flag is onlySig);
   4.134 -    - certificates pertain to the CA that C contacted (this is done by
   4.135 -      checking the signature).
   4.136 -   C generates a fresh symmetric key KC1.
   4.137 -   The point of encrypting @{term "{|Agent C, Nonce NC2, Hash (Pan(pan C))|}"}
   4.138 -   is not clear. *}
   4.139 -"[| evs3 \<in> set_cr;  C = Cardholder k;
   4.140 -    Nonce NC2 \<notin> used evs3;
   4.141 -    Key KC1 \<notin> used evs3; KC1 \<in> symKeys;
   4.142 -    Gets C {|sign (invKey SKi) {|Agent X, Nonce NC1|},
   4.143 -             cert (CA i) EKi onlyEnc (priSK RCA),
   4.144 -             cert (CA i) SKi onlySig (priSK RCA)|}
   4.145 -       \<in> set evs3;
   4.146 -    Says C (CA i) {|Agent C, Nonce NC1|} \<in> set evs3|]
   4.147 - ==> Says C (CA i) (EXHcrypt KC1 EKi {|Agent C, Nonce NC2|} (Pan(pan C)))
   4.148 -       # Notes C {|Key KC1, Agent (CA i)|}
   4.149 -       # evs3 \<in> set_cr"
   4.150 -
   4.151 -| SET_CR4:
   4.152 -    --{*RegFormRes:
   4.153 -    CA responds sending NC2 back with a new nonce NCA, after checking that
   4.154 -     - the digital envelope is correctly encrypted by @{term "pubEK (CA i)"}
   4.155 -     - the entire message is encrypted with the same key found inside the
   4.156 -       envelope (here, KC1) *}
   4.157 -"[| evs4 \<in> set_cr;
   4.158 -    Nonce NCA \<notin> used evs4;  KC1 \<in> symKeys;
   4.159 -    Gets (CA i) (EXHcrypt KC1 EKi {|Agent C, Nonce NC2|} (Pan(pan X)))
   4.160 -       \<in> set evs4 |]
   4.161 -  ==> Says (CA i) C
   4.162 -          {|sign (priSK (CA i)) {|Agent C, Nonce NC2, Nonce NCA|},
   4.163 -            cert (CA i) (pubEK (CA i)) onlyEnc (priSK RCA),
   4.164 -            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|}
   4.165 -       # evs4 \<in> set_cr"
   4.166 -
   4.167 -| SET_CR5:
   4.168 -   --{*CertReq: C sends his PAN, a new nonce, its proposed public signature key
   4.169 -       and its half of the secret value to CA.
   4.170 -       We now assume that C has a fixed key pair, and he submits (pubSK C).
   4.171 -       The protocol does not require this key to be fresh.
   4.172 -       The encryption below is actually EncX.*}
   4.173 -"[| evs5 \<in> set_cr;  C = Cardholder k;
   4.174 -    Nonce NC3 \<notin> used evs5;  Nonce CardSecret \<notin> used evs5; NC3\<noteq>CardSecret;
   4.175 -    Key KC2 \<notin> used evs5; KC2 \<in> symKeys;
   4.176 -    Key KC3 \<notin> used evs5; KC3 \<in> symKeys; KC2\<noteq>KC3;
   4.177 -    Gets C {|sign (invKey SKi) {|Agent C, Nonce NC2, Nonce NCA|},
   4.178 -             cert (CA i) EKi onlyEnc (priSK RCA),
   4.179 -             cert (CA i) SKi onlySig (priSK RCA) |}
   4.180 -        \<in> set evs5;
   4.181 -    Says C (CA i) (EXHcrypt KC1 EKi {|Agent C, Nonce NC2|} (Pan(pan C)))
   4.182 -         \<in> set evs5 |]
   4.183 -==> Says C (CA i)
   4.184 -         {|Crypt KC3
   4.185 -             {|Agent C, Nonce NC3, Key KC2, Key (pubSK C),
   4.186 -               Crypt (priSK C)
   4.187 -                 (Hash {|Agent C, Nonce NC3, Key KC2,
   4.188 -                         Key (pubSK C), Pan (pan C), Nonce CardSecret|})|},
   4.189 -           Crypt EKi {|Key KC3, Pan (pan C), Nonce CardSecret|} |}
   4.190 -    # Notes C {|Key KC2, Agent (CA i)|}
   4.191 -    # Notes C {|Key KC3, Agent (CA i)|}
   4.192 -    # evs5 \<in> set_cr"
   4.193 -
   4.194 -
   4.195 -  --{* CertRes: CA responds sending NC3 back with its half of the secret value,
   4.196 -   its signature certificate and the new cardholder signature
   4.197 -   certificate.  CA checks to have never certified the key proposed by C.
   4.198 -   NOTE: In Merchant Registration, the corresponding rule (4)
   4.199 -   uses the "sign" primitive. The encryption below is actually @{term EncK}, 
   4.200 -   which is just @{term "Crypt K (sign SK X)"}.
   4.201 -*}
   4.202 -
   4.203 -| SET_CR6:
   4.204 -"[| evs6 \<in> set_cr;
   4.205 -    Nonce NonceCCA \<notin> used evs6;
   4.206 -    KC2 \<in> symKeys;  KC3 \<in> symKeys;  cardSK \<notin> symKeys;
   4.207 -    Notes (CA i) (Key cardSK) \<notin> set evs6;
   4.208 -    Gets (CA i)
   4.209 -      {|Crypt KC3 {|Agent C, Nonce NC3, Key KC2, Key cardSK,
   4.210 -                    Crypt (invKey cardSK)
   4.211 -                      (Hash {|Agent C, Nonce NC3, Key KC2,
   4.212 -                              Key cardSK, Pan (pan C), Nonce CardSecret|})|},
   4.213 -        Crypt (pubEK (CA i)) {|Key KC3, Pan (pan C), Nonce CardSecret|} |}
   4.214 -      \<in> set evs6 |]
   4.215 -==> Says (CA i) C
   4.216 -         (Crypt KC2
   4.217 -          {|sign (priSK (CA i))
   4.218 -                 {|Agent C, Nonce NC3, Agent(CA i), Nonce NonceCCA|},
   4.219 -            certC (pan C) cardSK (XOR(CardSecret,NonceCCA)) onlySig (priSK (CA i)),
   4.220 -            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})
   4.221 -      # Notes (CA i) (Key cardSK)
   4.222 -      # evs6 \<in> set_cr"
   4.223 -
   4.224 -
   4.225 -declare Says_imp_knows_Spy [THEN parts.Inj, dest]
   4.226 -declare parts.Body [dest]
   4.227 -declare analz_into_parts [dest]
   4.228 -declare Fake_parts_insert_in_Un [dest]
   4.229 -
   4.230 -text{*A "possibility property": there are traces that reach the end.
   4.231 -      An unconstrained proof with many subgoals.*}
   4.232 -
   4.233 -lemma Says_to_Gets:
   4.234 -     "Says A B X # evs \<in> set_cr ==> Gets B X # Says A B X # evs \<in> set_cr"
   4.235 -by (rule set_cr.Reception, auto)
   4.236 -
   4.237 -text{*The many nonces and keys generated, some simultaneously, force us to
   4.238 -  introduce them explicitly as shown below.*}
   4.239 -lemma possibility_CR6:
   4.240 -     "[|NC1 < (NC2::nat);  NC2 < NC3;  NC3 < NCA ;
   4.241 -        NCA < NonceCCA;  NonceCCA < CardSecret;
   4.242 -        KC1 < (KC2::key);  KC2 < KC3;
   4.243 -        KC1 \<in> symKeys;  Key KC1 \<notin> used [];
   4.244 -        KC2 \<in> symKeys;  Key KC2 \<notin> used [];
   4.245 -        KC3 \<in> symKeys;  Key KC3 \<notin> used [];
   4.246 -        C = Cardholder k|]
   4.247 -   ==> \<exists>evs \<in> set_cr.
   4.248 -       Says (CA i) C
   4.249 -            (Crypt KC2
   4.250 -             {|sign (priSK (CA i))
   4.251 -                    {|Agent C, Nonce NC3, Agent(CA i), Nonce NonceCCA|},
   4.252 -               certC (pan C) (pubSK (Cardholder k)) (XOR(CardSecret,NonceCCA))
   4.253 -                     onlySig (priSK (CA i)),
   4.254 -               cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})
   4.255 -          \<in> set evs"
   4.256 -apply (intro exI bexI)
   4.257 -apply (rule_tac [2] 
   4.258 -       set_cr.Nil 
   4.259 -        [THEN set_cr.SET_CR1 [of concl: C i NC1], 
   4.260 -         THEN Says_to_Gets, 
   4.261 -         THEN set_cr.SET_CR2 [of concl: i C NC1], 
   4.262 -         THEN Says_to_Gets,  
   4.263 -         THEN set_cr.SET_CR3 [of concl: C i KC1 _ NC2], 
   4.264 -         THEN Says_to_Gets,  
   4.265 -         THEN set_cr.SET_CR4 [of concl: i C NC2 NCA], 
   4.266 -         THEN Says_to_Gets,  
   4.267 -         THEN set_cr.SET_CR5 [of concl: C i KC3 NC3 KC2 CardSecret],
   4.268 -         THEN Says_to_Gets,  
   4.269 -         THEN set_cr.SET_CR6 [of concl: i C KC2]])
   4.270 -apply basic_possibility
   4.271 -apply (simp_all (no_asm_simp) add: symKeys_neq_imp_neq)
   4.272 -done
   4.273 -
   4.274 -text{*General facts about message reception*}
   4.275 -lemma Gets_imp_Says:
   4.276 -     "[| Gets B X \<in> set evs; evs \<in> set_cr |] ==> \<exists>A. Says A B X \<in> set evs"
   4.277 -apply (erule rev_mp)
   4.278 -apply (erule set_cr.induct, auto)
   4.279 -done
   4.280 -
   4.281 -lemma Gets_imp_knows_Spy:
   4.282 -     "[| Gets B X \<in> set evs; evs \<in> set_cr |]  ==> X \<in> knows Spy evs"
   4.283 -by (blast dest!: Gets_imp_Says Says_imp_knows_Spy)
   4.284 -declare Gets_imp_knows_Spy [THEN parts.Inj, dest]
   4.285 -
   4.286 -
   4.287 -subsection{*Proofs on keys *}
   4.288 -
   4.289 -text{*Spy never sees an agent's private keys! (unless it's bad at start)*}
   4.290 -
   4.291 -lemma Spy_see_private_Key [simp]:
   4.292 -     "evs \<in> set_cr
   4.293 -      ==> (Key(invKey (publicKey b A)) \<in> parts(knows Spy evs)) = (A \<in> bad)"
   4.294 -by (erule set_cr.induct, auto)
   4.295 -
   4.296 -lemma Spy_analz_private_Key [simp]:
   4.297 -     "evs \<in> set_cr ==>
   4.298 -     (Key(invKey (publicKey b A)) \<in> analz(knows Spy evs)) = (A \<in> bad)"
   4.299 -by auto
   4.300 -
   4.301 -declare Spy_see_private_Key [THEN [2] rev_iffD1, dest!]
   4.302 -declare Spy_analz_private_Key [THEN [2] rev_iffD1, dest!]
   4.303 -
   4.304 -
   4.305 -subsection{*Begin Piero's Theorems on Certificates*}
   4.306 -text{*Trivial in the current model, where certificates by RCA are secure *}
   4.307 -
   4.308 -lemma Crypt_valid_pubEK:
   4.309 -     "[| Crypt (priSK RCA) {|Agent C, Key EKi, onlyEnc|}
   4.310 -           \<in> parts (knows Spy evs);
   4.311 -         evs \<in> set_cr |] ==> EKi = pubEK C"
   4.312 -apply (erule rev_mp)
   4.313 -apply (erule set_cr.induct, auto)
   4.314 -done
   4.315 -
   4.316 -lemma certificate_valid_pubEK:
   4.317 -    "[| cert C EKi onlyEnc (priSK RCA) \<in> parts (knows Spy evs);
   4.318 -        evs \<in> set_cr |]
   4.319 -     ==> EKi = pubEK C"
   4.320 -apply (unfold cert_def signCert_def)
   4.321 -apply (blast dest!: Crypt_valid_pubEK)
   4.322 -done
   4.323 -
   4.324 -lemma Crypt_valid_pubSK:
   4.325 -     "[| Crypt (priSK RCA) {|Agent C, Key SKi, onlySig|}
   4.326 -           \<in> parts (knows Spy evs);
   4.327 -         evs \<in> set_cr |] ==> SKi = pubSK C"
   4.328 -apply (erule rev_mp)
   4.329 -apply (erule set_cr.induct, auto)
   4.330 -done
   4.331 -
   4.332 -lemma certificate_valid_pubSK:
   4.333 -    "[| cert C SKi onlySig (priSK RCA) \<in> parts (knows Spy evs);
   4.334 -        evs \<in> set_cr |] ==> SKi = pubSK C"
   4.335 -apply (unfold cert_def signCert_def)
   4.336 -apply (blast dest!: Crypt_valid_pubSK)
   4.337 -done
   4.338 -
   4.339 -lemma Gets_certificate_valid:
   4.340 -     "[| Gets A {| X, cert C EKi onlyEnc (priSK RCA),
   4.341 -                      cert C SKi onlySig (priSK RCA)|} \<in> set evs;
   4.342 -         evs \<in> set_cr |]
   4.343 -      ==> EKi = pubEK C & SKi = pubSK C"
   4.344 -by (blast dest: certificate_valid_pubEK certificate_valid_pubSK)
   4.345 -
   4.346 -text{*Nobody can have used non-existent keys!*}
   4.347 -lemma new_keys_not_used:
   4.348 -     "[|K \<in> symKeys; Key K \<notin> used evs; evs \<in> set_cr|]
   4.349 -      ==> K \<notin> keysFor (parts (knows Spy evs))"
   4.350 -apply (erule rev_mp)
   4.351 -apply (erule rev_mp)
   4.352 -apply (erule set_cr.induct)
   4.353 -apply (frule_tac [8] Gets_certificate_valid)
   4.354 -apply (frule_tac [6] Gets_certificate_valid, simp_all)
   4.355 -apply (force dest!: usedI keysFor_parts_insert) --{*Fake*}
   4.356 -apply (blast,auto)  --{*Others*}
   4.357 -done
   4.358 -
   4.359 -
   4.360 -subsection{*New versions: as above, but generalized to have the KK argument *}
   4.361 -
   4.362 -lemma gen_new_keys_not_used:
   4.363 -     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_cr |]
   4.364 -      ==> Key K \<notin> used evs --> K \<in> symKeys -->
   4.365 -          K \<notin> keysFor (parts (Key`KK Un knows Spy evs))"
   4.366 -by (auto simp add: new_keys_not_used)
   4.367 -
   4.368 -lemma gen_new_keys_not_analzd:
   4.369 -     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_cr |]
   4.370 -      ==> K \<notin> keysFor (analz (Key`KK Un knows Spy evs))"
   4.371 -by (blast intro: keysFor_mono [THEN [2] rev_subsetD]
   4.372 -          dest: gen_new_keys_not_used)
   4.373 -
   4.374 -lemma analz_Key_image_insert_eq:
   4.375 -     "[|K \<in> symKeys; Key K \<notin> used evs; evs \<in> set_cr |]
   4.376 -      ==> analz (Key ` (insert K KK) \<union> knows Spy evs) =
   4.377 -          insert (Key K) (analz (Key ` KK \<union> knows Spy evs))"
   4.378 -by (simp add: gen_new_keys_not_analzd)
   4.379 -
   4.380 -lemma Crypt_parts_imp_used:
   4.381 -     "[|Crypt K X \<in> parts (knows Spy evs);
   4.382 -        K \<in> symKeys; evs \<in> set_cr |] ==> Key K \<in> used evs"
   4.383 -apply (rule ccontr)
   4.384 -apply (force dest: new_keys_not_used Crypt_imp_invKey_keysFor)
   4.385 -done
   4.386 -
   4.387 -lemma Crypt_analz_imp_used:
   4.388 -     "[|Crypt K X \<in> analz (knows Spy evs);
   4.389 -        K \<in> symKeys; evs \<in> set_cr |] ==> Key K \<in> used evs"
   4.390 -by (blast intro: Crypt_parts_imp_used)
   4.391 -
   4.392 -
   4.393 -(*<*) 
   4.394 -subsection{*Messages signed by CA*}
   4.395 -
   4.396 -text{*Message @{text SET_CR2}: C can check CA's signature if he has received
   4.397 -     CA's certificate.*}
   4.398 -lemma CA_Says_2_lemma:
   4.399 -     "[| Crypt (priSK (CA i)) (Hash{|Agent C, Nonce NC1|})
   4.400 -           \<in> parts (knows Spy evs);
   4.401 -         evs \<in> set_cr; (CA i) \<notin> bad |]
   4.402 -     ==> \<exists>Y. Says (CA i) C {|sign (priSK (CA i)) {|Agent C, Nonce NC1|}, Y|}
   4.403 -                 \<in> set evs"
   4.404 -apply (erule rev_mp)
   4.405 -apply (erule set_cr.induct, auto)
   4.406 -done
   4.407 -
   4.408 -text{*Ever used?*}
   4.409 -lemma CA_Says_2:
   4.410 -     "[| Crypt (invKey SK) (Hash{|Agent C, Nonce NC1|})
   4.411 -           \<in> parts (knows Spy evs);
   4.412 -         cert (CA i) SK onlySig (priSK RCA) \<in> parts (knows Spy evs);
   4.413 -         evs \<in> set_cr; (CA i) \<notin> bad |]
   4.414 -      ==> \<exists>Y. Says (CA i) C {|sign (priSK (CA i)) {|Agent C, Nonce NC1|}, Y|}
   4.415 -                  \<in> set evs"
   4.416 -by (blast dest!: certificate_valid_pubSK intro!: CA_Says_2_lemma)
   4.417 -
   4.418 -
   4.419 -text{*Message @{text SET_CR4}: C can check CA's signature if he has received
   4.420 -      CA's certificate.*}
   4.421 -lemma CA_Says_4_lemma:
   4.422 -     "[| Crypt (priSK (CA i)) (Hash{|Agent C, Nonce NC2, Nonce NCA|})
   4.423 -           \<in> parts (knows Spy evs);
   4.424 -         evs \<in> set_cr; (CA i) \<notin> bad |]
   4.425 -      ==> \<exists>Y. Says (CA i) C {|sign (priSK (CA i))
   4.426 -                     {|Agent C, Nonce NC2, Nonce NCA|}, Y|} \<in> set evs"
   4.427 -apply (erule rev_mp)
   4.428 -apply (erule set_cr.induct, auto)
   4.429 -done
   4.430 -
   4.431 -text{*NEVER USED*}
   4.432 -lemma CA_Says_4:
   4.433 -     "[| Crypt (invKey SK) (Hash{|Agent C, Nonce NC2, Nonce NCA|})
   4.434 -           \<in> parts (knows Spy evs);
   4.435 -         cert (CA i) SK onlySig (priSK RCA) \<in> parts (knows Spy evs);
   4.436 -         evs \<in> set_cr; (CA i) \<notin> bad |]
   4.437 -      ==> \<exists>Y. Says (CA i) C {|sign (priSK (CA i))
   4.438 -                   {|Agent C, Nonce NC2, Nonce NCA|}, Y|} \<in> set evs"
   4.439 -by (blast dest!: certificate_valid_pubSK intro!: CA_Says_4_lemma)
   4.440 -
   4.441 -
   4.442 -text{*Message @{text SET_CR6}: C can check CA's signature if he has
   4.443 -      received CA's certificate.*}
   4.444 -lemma CA_Says_6_lemma:
   4.445 -     "[| Crypt (priSK (CA i)) 
   4.446 -               (Hash{|Agent C, Nonce NC3, Agent (CA i), Nonce NonceCCA|})
   4.447 -           \<in> parts (knows Spy evs);
   4.448 -         evs \<in> set_cr; (CA i) \<notin> bad |]
   4.449 -      ==> \<exists>Y K. Says (CA i) C (Crypt K {|sign (priSK (CA i))
   4.450 -      {|Agent C, Nonce NC3, Agent (CA i), Nonce NonceCCA|}, Y|}) \<in> set evs"
   4.451 -apply (erule rev_mp)
   4.452 -apply (erule set_cr.induct, auto)
   4.453 -done
   4.454 -
   4.455 -text{*NEVER USED*}
   4.456 -lemma CA_Says_6:
   4.457 -     "[| Crypt (invKey SK) (Hash{|Agent C, Nonce NC3, Agent (CA i), Nonce NonceCCA|})
   4.458 -           \<in> parts (knows Spy evs);
   4.459 -         cert (CA i) SK onlySig (priSK RCA) \<in> parts (knows Spy evs);
   4.460 -         evs \<in> set_cr; (CA i) \<notin> bad |]
   4.461 -      ==> \<exists>Y K. Says (CA i) C (Crypt K {|sign (priSK (CA i))
   4.462 -                    {|Agent C, Nonce NC3, Agent (CA i), Nonce NonceCCA|}, Y|}) \<in> set evs"
   4.463 -by (blast dest!: certificate_valid_pubSK intro!: CA_Says_6_lemma)
   4.464 -(*>*)
   4.465 -
   4.466 -
   4.467 -subsection{*Useful lemmas *}
   4.468 -
   4.469 -text{*Rewriting rule for private encryption keys.  Analogous rewriting rules
   4.470 -for other keys aren't needed.*}
   4.471 -
   4.472 -lemma parts_image_priEK:
   4.473 -     "[|Key (priEK C) \<in> parts (Key`KK Un (knows Spy evs));
   4.474 -        evs \<in> set_cr|] ==> priEK C \<in> KK | C \<in> bad"
   4.475 -by auto
   4.476 -
   4.477 -text{*trivial proof because (priEK C) never appears even in (parts evs)*}
   4.478 -lemma analz_image_priEK:
   4.479 -     "evs \<in> set_cr ==>
   4.480 -          (Key (priEK C) \<in> analz (Key`KK Un (knows Spy evs))) =
   4.481 -          (priEK C \<in> KK | C \<in> bad)"
   4.482 -by (blast dest!: parts_image_priEK intro: analz_mono [THEN [2] rev_subsetD])
   4.483 -
   4.484 -
   4.485 -subsection{*Secrecy of Session Keys *}
   4.486 -
   4.487 -subsubsection{*Lemmas about the predicate KeyCryptKey *}
   4.488 -
   4.489 -text{*A fresh DK cannot be associated with any other
   4.490 -  (with respect to a given trace). *}
   4.491 -lemma DK_fresh_not_KeyCryptKey:
   4.492 -     "[| Key DK \<notin> used evs; evs \<in> set_cr |] ==> ~ KeyCryptKey DK K evs"
   4.493 -apply (erule rev_mp)
   4.494 -apply (erule set_cr.induct)
   4.495 -apply (simp_all (no_asm_simp))
   4.496 -apply (blast dest: Crypt_analz_imp_used)+
   4.497 -done
   4.498 -
   4.499 -text{*A fresh K cannot be associated with any other.  The assumption that
   4.500 -  DK isn't a private encryption key may be an artifact of the particular
   4.501 -  definition of KeyCryptKey.*}
   4.502 -lemma K_fresh_not_KeyCryptKey:
   4.503 -     "[|\<forall>C. DK \<noteq> priEK C; Key K \<notin> used evs|] ==> ~ KeyCryptKey DK K evs"
   4.504 -apply (induct evs)
   4.505 -apply (auto simp add: parts_insert2 split add: event.split)
   4.506 -done
   4.507 -
   4.508 -
   4.509 -text{*This holds because if (priEK (CA i)) appears in any traffic then it must
   4.510 -  be known to the Spy, by @{term Spy_see_private_Key}*}
   4.511 -lemma cardSK_neq_priEK:
   4.512 -     "[|Key cardSK \<notin> analz (knows Spy evs);
   4.513 -        Key cardSK : parts (knows Spy evs);
   4.514 -        evs \<in> set_cr|] ==> cardSK \<noteq> priEK C"
   4.515 -by blast
   4.516 -
   4.517 -lemma not_KeyCryptKey_cardSK [rule_format (no_asm)]:
   4.518 -     "[|cardSK \<notin> symKeys;  \<forall>C. cardSK \<noteq> priEK C;  evs \<in> set_cr|] ==>
   4.519 -      Key cardSK \<notin> analz (knows Spy evs) --> ~ KeyCryptKey cardSK K evs"
   4.520 -by (erule set_cr.induct, analz_mono_contra, auto)
   4.521 -
   4.522 -text{*Lemma for message 5: pubSK C is never used to encrypt Keys.*}
   4.523 -lemma pubSK_not_KeyCryptKey [simp]: "~ KeyCryptKey (pubSK C) K evs"
   4.524 -apply (induct_tac "evs")
   4.525 -apply (auto simp add: parts_insert2 split add: event.split)
   4.526 -done
   4.527 -
   4.528 -text{*Lemma for message 6: either cardSK is compromised (when we don't care)
   4.529 -  or else cardSK hasn't been used to encrypt K.  Previously we treated
   4.530 -  message 5 in the same way, but the current model assumes that rule
   4.531 -  @{text SET_CR5} is executed only by honest agents.*}
   4.532 -lemma msg6_KeyCryptKey_disj:
   4.533 -     "[|Gets B {|Crypt KC3 {|Agent C, Nonce N, Key KC2, Key cardSK, X|}, Y|}
   4.534 -          \<in> set evs;
   4.535 -        cardSK \<notin> symKeys;  evs \<in> set_cr|]
   4.536 -      ==> Key cardSK \<in> analz (knows Spy evs) |
   4.537 -          (\<forall>K. ~ KeyCryptKey cardSK K evs)"
   4.538 -by (blast dest: not_KeyCryptKey_cardSK intro: cardSK_neq_priEK)
   4.539 -
   4.540 -text{*As usual: we express the property as a logical equivalence*}
   4.541 -lemma Key_analz_image_Key_lemma:
   4.542 -     "P --> (Key K \<in> analz (Key`KK Un H)) --> (K \<in> KK | Key K \<in> analz H)
   4.543 -      ==>
   4.544 -      P --> (Key K \<in> analz (Key`KK Un H)) = (K \<in> KK | Key K \<in> analz H)"
   4.545 -by (blast intro: analz_mono [THEN [2] rev_subsetD])
   4.546 -
   4.547 -method_setup valid_certificate_tac = {*
   4.548 -  Args.goal_spec >> (fn quant => K (SIMPLE_METHOD'' quant
   4.549 -    (fn i =>
   4.550 -      EVERY [ftac @{thm Gets_certificate_valid} i,
   4.551 -             assume_tac i,
   4.552 -             etac conjE i, REPEAT (hyp_subst_tac i)])))
   4.553 -*} ""
   4.554 -
   4.555 -text{*The @{text "(no_asm)"} attribute is essential, since it retains
   4.556 -  the quantifier and allows the simprule's condition to itself be simplified.*}
   4.557 -lemma symKey_compromise [rule_format (no_asm)]:
   4.558 -     "evs \<in> set_cr ==>
   4.559 -      (\<forall>SK KK. SK \<in> symKeys \<longrightarrow> (\<forall>K \<in> KK. ~ KeyCryptKey K SK evs)   -->
   4.560 -               (Key SK \<in> analz (Key`KK Un (knows Spy evs))) =
   4.561 -               (SK \<in> KK | Key SK \<in> analz (knows Spy evs)))"
   4.562 -apply (erule set_cr.induct)
   4.563 -apply (rule_tac [!] allI) +
   4.564 -apply (rule_tac [!] impI [THEN Key_analz_image_Key_lemma, THEN impI])+
   4.565 -apply (valid_certificate_tac [8]) --{*for message 5*}
   4.566 -apply (valid_certificate_tac [6]) --{*for message 5*}
   4.567 -apply (erule_tac [9] msg6_KeyCryptKey_disj [THEN disjE])
   4.568 -apply (simp_all
   4.569 -         del: image_insert image_Un imp_disjL
   4.570 -         add: analz_image_keys_simps analz_knows_absorb
   4.571 -              analz_Key_image_insert_eq notin_image_iff
   4.572 -              K_fresh_not_KeyCryptKey
   4.573 -              DK_fresh_not_KeyCryptKey ball_conj_distrib
   4.574 -              analz_image_priEK disj_simps)
   4.575 -  --{*9 seconds on a 1.6GHz machine*}
   4.576 -apply spy_analz
   4.577 -apply blast  --{*3*}
   4.578 -apply blast  --{*5*}
   4.579 -done
   4.580 -
   4.581 -text{*The remaining quantifiers seem to be essential.
   4.582 -  NO NEED to assume the cardholder's OK: bad cardholders don't do anything
   4.583 -  wrong!!*}
   4.584 -lemma symKey_secrecy [rule_format]:
   4.585 -     "[|CA i \<notin> bad;  K \<in> symKeys;  evs \<in> set_cr|]
   4.586 -      ==> \<forall>X c. Says (Cardholder c) (CA i) X \<in> set evs -->
   4.587 -                Key K \<in> parts{X} -->
   4.588 -                Cardholder c \<notin> bad -->
   4.589 -                Key K \<notin> analz (knows Spy evs)"
   4.590 -apply (erule set_cr.induct)
   4.591 -apply (frule_tac [8] Gets_certificate_valid) --{*for message 5*}
   4.592 -apply (frule_tac [6] Gets_certificate_valid) --{*for message 3*}
   4.593 -apply (erule_tac [11] msg6_KeyCryptKey_disj [THEN disjE])
   4.594 -apply (simp_all del: image_insert image_Un imp_disjL
   4.595 -         add: symKey_compromise fresh_notin_analz_knows_Spy
   4.596 -              analz_image_keys_simps analz_knows_absorb
   4.597 -              analz_Key_image_insert_eq notin_image_iff
   4.598 -              K_fresh_not_KeyCryptKey
   4.599 -              DK_fresh_not_KeyCryptKey
   4.600 -              analz_image_priEK)
   4.601 -  --{*2.5 seconds on a 1.6GHz machine*}
   4.602 -apply spy_analz  --{*Fake*}
   4.603 -apply (auto intro: analz_into_parts [THEN usedI] in_parts_Says_imp_used)
   4.604 -done
   4.605 -
   4.606 -
   4.607 -subsection{*Primary Goals of Cardholder Registration *}
   4.608 -
   4.609 -text{*The cardholder's certificate really was created by the CA, provided the
   4.610 -    CA is uncompromised *}
   4.611 -
   4.612 -text{*Lemma concerning the actual signed message digest*}
   4.613 -lemma cert_valid_lemma:
   4.614 -     "[|Crypt (priSK (CA i)) {|Hash {|Nonce N, Pan(pan C)|}, Key cardSK, N1|}
   4.615 -          \<in> parts (knows Spy evs);
   4.616 -        CA i \<notin> bad; evs \<in> set_cr|]
   4.617 -  ==> \<exists>KC2 X Y. Says (CA i) C
   4.618 -                     (Crypt KC2 
   4.619 -                       {|X, certC (pan C) cardSK N onlySig (priSK (CA i)), Y|})
   4.620 -                  \<in> set evs"
   4.621 -apply (erule rev_mp)
   4.622 -apply (erule set_cr.induct)
   4.623 -apply (simp_all (no_asm_simp))
   4.624 -apply auto
   4.625 -done
   4.626 -
   4.627 -text{*Pre-packaged version for cardholder.  We don't try to confirm the values
   4.628 -  of KC2, X and Y, since they are not important.*}
   4.629 -lemma certificate_valid_cardSK:
   4.630 -    "[|Gets C (Crypt KC2 {|X, certC (pan C) cardSK N onlySig (invKey SKi),
   4.631 -                              cert (CA i) SKi onlySig (priSK RCA)|}) \<in> set evs;
   4.632 -        CA i \<notin> bad; evs \<in> set_cr|]
   4.633 -  ==> \<exists>KC2 X Y. Says (CA i) C
   4.634 -                     (Crypt KC2 
   4.635 -                       {|X, certC (pan C) cardSK N onlySig (priSK (CA i)), Y|})
   4.636 -                   \<in> set evs"
   4.637 -by (force dest!: Gets_imp_knows_Spy [THEN parts.Inj, THEN parts.Body]
   4.638 -                    certificate_valid_pubSK cert_valid_lemma)
   4.639 -
   4.640 -
   4.641 -lemma Hash_imp_parts [rule_format]:
   4.642 -     "evs \<in> set_cr
   4.643 -      ==> Hash{|X, Nonce N|} \<in> parts (knows Spy evs) -->
   4.644 -          Nonce N \<in> parts (knows Spy evs)"
   4.645 -apply (erule set_cr.induct, force)
   4.646 -apply (simp_all (no_asm_simp))
   4.647 -apply (blast intro: parts_mono [THEN [2] rev_subsetD])
   4.648 -done
   4.649 -
   4.650 -lemma Hash_imp_parts2 [rule_format]:
   4.651 -     "evs \<in> set_cr
   4.652 -      ==> Hash{|X, Nonce M, Y, Nonce N|} \<in> parts (knows Spy evs) -->
   4.653 -          Nonce M \<in> parts (knows Spy evs) & Nonce N \<in> parts (knows Spy evs)"
   4.654 -apply (erule set_cr.induct, force)
   4.655 -apply (simp_all (no_asm_simp))
   4.656 -apply (blast intro: parts_mono [THEN [2] rev_subsetD])
   4.657 -done
   4.658 -
   4.659 -
   4.660 -subsection{*Secrecy of Nonces*}
   4.661 -
   4.662 -subsubsection{*Lemmas about the predicate KeyCryptNonce *}
   4.663 -
   4.664 -text{*A fresh DK cannot be associated with any other
   4.665 -  (with respect to a given trace). *}
   4.666 -lemma DK_fresh_not_KeyCryptNonce:
   4.667 -     "[| DK \<in> symKeys; Key DK \<notin> used evs; evs \<in> set_cr |]
   4.668 -      ==> ~ KeyCryptNonce DK K evs"
   4.669 -apply (erule rev_mp)
   4.670 -apply (erule rev_mp)
   4.671 -apply (erule set_cr.induct)
   4.672 -apply (simp_all (no_asm_simp))
   4.673 -apply blast
   4.674 -apply blast
   4.675 -apply (auto simp add: DK_fresh_not_KeyCryptKey)
   4.676 -done
   4.677 -
   4.678 -text{*A fresh N cannot be associated with any other
   4.679 -      (with respect to a given trace). *}
   4.680 -lemma N_fresh_not_KeyCryptNonce:
   4.681 -     "\<forall>C. DK \<noteq> priEK C ==> Nonce N \<notin> used evs --> ~ KeyCryptNonce DK N evs"
   4.682 -apply (induct_tac "evs")
   4.683 -apply (case_tac [2] "a")
   4.684 -apply (auto simp add: parts_insert2)
   4.685 -done
   4.686 -
   4.687 -lemma not_KeyCryptNonce_cardSK [rule_format (no_asm)]:
   4.688 -     "[|cardSK \<notin> symKeys;  \<forall>C. cardSK \<noteq> priEK C;  evs \<in> set_cr|] ==>
   4.689 -      Key cardSK \<notin> analz (knows Spy evs) --> ~ KeyCryptNonce cardSK N evs"
   4.690 -apply (erule set_cr.induct, analz_mono_contra, simp_all)
   4.691 -apply (blast dest: not_KeyCryptKey_cardSK)  --{*6*}
   4.692 -done
   4.693 -
   4.694 -subsubsection{*Lemmas for message 5 and 6:
   4.695 -  either cardSK is compromised (when we don't care)
   4.696 -  or else cardSK hasn't been used to encrypt K. *}
   4.697 -
   4.698 -text{*Lemma for message 5: pubSK C is never used to encrypt Nonces.*}
   4.699 -lemma pubSK_not_KeyCryptNonce [simp]: "~ KeyCryptNonce (pubSK C) N evs"
   4.700 -apply (induct_tac "evs")
   4.701 -apply (auto simp add: parts_insert2 split add: event.split)
   4.702 -done
   4.703 -
   4.704 -text{*Lemma for message 6: either cardSK is compromised (when we don't care)
   4.705 -  or else cardSK hasn't been used to encrypt K.*}
   4.706 -lemma msg6_KeyCryptNonce_disj:
   4.707 -     "[|Gets B {|Crypt KC3 {|Agent C, Nonce N, Key KC2, Key cardSK, X|}, Y|}
   4.708 -          \<in> set evs;
   4.709 -        cardSK \<notin> symKeys;  evs \<in> set_cr|]
   4.710 -      ==> Key cardSK \<in> analz (knows Spy evs) |
   4.711 -          ((\<forall>K. ~ KeyCryptKey cardSK K evs) &
   4.712 -           (\<forall>N. ~ KeyCryptNonce cardSK N evs))"
   4.713 -by (blast dest: not_KeyCryptKey_cardSK not_KeyCryptNonce_cardSK
   4.714 -          intro: cardSK_neq_priEK)
   4.715 -
   4.716 -
   4.717 -text{*As usual: we express the property as a logical equivalence*}
   4.718 -lemma Nonce_analz_image_Key_lemma:
   4.719 -     "P --> (Nonce N \<in> analz (Key`KK Un H)) --> (Nonce N \<in> analz H)
   4.720 -      ==> P --> (Nonce N \<in> analz (Key`KK Un H)) = (Nonce N \<in> analz H)"
   4.721 -by (blast intro: analz_mono [THEN [2] rev_subsetD])
   4.722 -
   4.723 -
   4.724 -text{*The @{text "(no_asm)"} attribute is essential, since it retains
   4.725 -  the quantifier and allows the simprule's condition to itself be simplified.*}
   4.726 -lemma Nonce_compromise [rule_format (no_asm)]:
   4.727 -     "evs \<in> set_cr ==>
   4.728 -      (\<forall>N KK. (\<forall>K \<in> KK. ~ KeyCryptNonce K N evs)   -->
   4.729 -               (Nonce N \<in> analz (Key`KK Un (knows Spy evs))) =
   4.730 -               (Nonce N \<in> analz (knows Spy evs)))"
   4.731 -apply (erule set_cr.induct)
   4.732 -apply (rule_tac [!] allI)+
   4.733 -apply (rule_tac [!] impI [THEN Nonce_analz_image_Key_lemma])+
   4.734 -apply (frule_tac [8] Gets_certificate_valid) --{*for message 5*}
   4.735 -apply (frule_tac [6] Gets_certificate_valid) --{*for message 3*}
   4.736 -apply (frule_tac [11] msg6_KeyCryptNonce_disj)
   4.737 -apply (erule_tac [13] disjE)
   4.738 -apply (simp_all del: image_insert image_Un
   4.739 -         add: symKey_compromise
   4.740 -              analz_image_keys_simps analz_knows_absorb
   4.741 -              analz_Key_image_insert_eq notin_image_iff
   4.742 -              N_fresh_not_KeyCryptNonce
   4.743 -              DK_fresh_not_KeyCryptNonce K_fresh_not_KeyCryptKey
   4.744 -              ball_conj_distrib analz_image_priEK)
   4.745 -  --{*14 seconds on a 1.6GHz machine*}
   4.746 -apply spy_analz  --{*Fake*}
   4.747 -apply blast  --{*3*}
   4.748 -apply blast  --{*5*}
   4.749 -txt{*Message 6*}
   4.750 -apply (metis symKey_compromise)
   4.751 -  --{*cardSK compromised*}
   4.752 -txt{*Simplify again--necessary because the previous simplification introduces
   4.753 -  some logical connectives*} 
   4.754 -apply (force simp del: image_insert image_Un imp_disjL
   4.755 -          simp add: analz_image_keys_simps symKey_compromise)
   4.756 -done
   4.757 -
   4.758 -
   4.759 -subsection{*Secrecy of CardSecret: the Cardholder's secret*}
   4.760 -
   4.761 -lemma NC2_not_CardSecret:
   4.762 -     "[|Crypt EKj {|Key K, Pan p, Hash {|Agent D, Nonce N|}|}
   4.763 -          \<in> parts (knows Spy evs);
   4.764 -        Key K \<notin> analz (knows Spy evs);
   4.765 -        Nonce N \<notin> analz (knows Spy evs);
   4.766 -       evs \<in> set_cr|]
   4.767 -      ==> Crypt EKi {|Key K', Pan p', Nonce N|} \<notin> parts (knows Spy evs)"
   4.768 -apply (erule rev_mp)
   4.769 -apply (erule rev_mp)
   4.770 -apply (erule rev_mp)
   4.771 -apply (erule set_cr.induct, analz_mono_contra, simp_all)
   4.772 -apply (blast dest: Hash_imp_parts)+
   4.773 -done
   4.774 -
   4.775 -lemma KC2_secure_lemma [rule_format]:
   4.776 -     "[|U = Crypt KC3 {|Agent C, Nonce N, Key KC2, X|};
   4.777 -        U \<in> parts (knows Spy evs);
   4.778 -        evs \<in> set_cr|]
   4.779 -  ==> Nonce N \<notin> analz (knows Spy evs) -->
   4.780 -      (\<exists>k i W. Says (Cardholder k) (CA i) {|U,W|} \<in> set evs & 
   4.781 -               Cardholder k \<notin> bad & CA i \<notin> bad)"
   4.782 -apply (erule_tac P = "U \<in> ?H" in rev_mp)
   4.783 -apply (erule set_cr.induct)
   4.784 -apply (valid_certificate_tac [8])  --{*for message 5*}
   4.785 -apply (simp_all del: image_insert image_Un imp_disjL
   4.786 -         add: analz_image_keys_simps analz_knows_absorb
   4.787 -              analz_knows_absorb2 notin_image_iff)
   4.788 -  --{*4 seconds on a 1.6GHz machine*}
   4.789 -apply (simp_all (no_asm_simp)) --{*leaves 4 subgoals*}
   4.790 -apply (blast intro!: analz_insertI)+
   4.791 -done
   4.792 -
   4.793 -lemma KC2_secrecy:
   4.794 -     "[|Gets B {|Crypt K {|Agent C, Nonce N, Key KC2, X|}, Y|} \<in> set evs;
   4.795 -        Nonce N \<notin> analz (knows Spy evs);  KC2 \<in> symKeys;
   4.796 -        evs \<in> set_cr|]
   4.797 -       ==> Key KC2 \<notin> analz (knows Spy evs)"
   4.798 -by (force dest!: refl [THEN KC2_secure_lemma] symKey_secrecy)
   4.799 -
   4.800 -
   4.801 -text{*Inductive version*}
   4.802 -lemma CardSecret_secrecy_lemma [rule_format]:
   4.803 -     "[|CA i \<notin> bad;  evs \<in> set_cr|]
   4.804 -      ==> Key K \<notin> analz (knows Spy evs) -->
   4.805 -          Crypt (pubEK (CA i)) {|Key K, Pan p, Nonce CardSecret|}
   4.806 -             \<in> parts (knows Spy evs) -->
   4.807 -          Nonce CardSecret \<notin> analz (knows Spy evs)"
   4.808 -apply (erule set_cr.induct, analz_mono_contra)
   4.809 -apply (valid_certificate_tac [8]) --{*for message 5*}
   4.810 -apply (valid_certificate_tac [6]) --{*for message 5*}
   4.811 -apply (frule_tac [9] msg6_KeyCryptNonce_disj [THEN disjE])
   4.812 -apply (simp_all
   4.813 -         del: image_insert image_Un imp_disjL
   4.814 -         add: analz_image_keys_simps analz_knows_absorb
   4.815 -              analz_Key_image_insert_eq notin_image_iff
   4.816 -              EXHcrypt_def Crypt_notin_image_Key
   4.817 -              N_fresh_not_KeyCryptNonce DK_fresh_not_KeyCryptNonce
   4.818 -              ball_conj_distrib Nonce_compromise symKey_compromise
   4.819 -              analz_image_priEK)
   4.820 -  --{*2.5 seconds on a 1.6GHz machine*}
   4.821 -apply spy_analz  --{*Fake*}
   4.822 -apply (simp_all (no_asm_simp))
   4.823 -apply blast  --{*1*}
   4.824 -apply (blast dest!: Gets_imp_knows_Spy [THEN analz.Inj])  --{*2*}
   4.825 -apply blast  --{*3*}
   4.826 -apply (blast dest: NC2_not_CardSecret Gets_imp_knows_Spy [THEN analz.Inj] analz_symKeys_Decrypt)  --{*4*}
   4.827 -apply blast  --{*5*}
   4.828 -apply (blast dest: KC2_secrecy)+  --{*Message 6: two cases*}
   4.829 -done
   4.830 -
   4.831 -
   4.832 -text{*Packaged version for cardholder*}
   4.833 -lemma CardSecret_secrecy:
   4.834 -     "[|Cardholder k \<notin> bad;  CA i \<notin> bad;
   4.835 -        Says (Cardholder k) (CA i)
   4.836 -           {|X, Crypt EKi {|Key KC3, Pan p, Nonce CardSecret|}|} \<in> set evs;
   4.837 -        Gets A {|Z, cert (CA i) EKi onlyEnc (priSK RCA),
   4.838 -                    cert (CA i) SKi onlySig (priSK RCA)|} \<in> set evs;
   4.839 -        KC3 \<in> symKeys;  evs \<in> set_cr|]
   4.840 -      ==> Nonce CardSecret \<notin> analz (knows Spy evs)"
   4.841 -apply (frule Gets_certificate_valid, assumption)
   4.842 -apply (subgoal_tac "Key KC3 \<notin> analz (knows Spy evs) ")
   4.843 -apply (blast dest: CardSecret_secrecy_lemma)
   4.844 -apply (rule symKey_secrecy)
   4.845 -apply (auto simp add: parts_insert2)
   4.846 -done
   4.847 -
   4.848 -
   4.849 -subsection{*Secrecy of NonceCCA [the CA's secret] *}
   4.850 -
   4.851 -lemma NC2_not_NonceCCA:
   4.852 -     "[|Hash {|Agent C', Nonce N', Agent C, Nonce N|}
   4.853 -          \<in> parts (knows Spy evs);
   4.854 -        Nonce N \<notin> analz (knows Spy evs);
   4.855 -       evs \<in> set_cr|]
   4.856 -      ==> Crypt KC1 {|{|Agent B, Nonce N|}, Hash p|} \<notin> parts (knows Spy evs)"
   4.857 -apply (erule rev_mp)
   4.858 -apply (erule rev_mp)
   4.859 -apply (erule set_cr.induct, analz_mono_contra, simp_all)
   4.860 -apply (blast dest: Hash_imp_parts2)+
   4.861 -done
   4.862 -
   4.863 -
   4.864 -text{*Inductive version*}
   4.865 -lemma NonceCCA_secrecy_lemma [rule_format]:
   4.866 -     "[|CA i \<notin> bad;  evs \<in> set_cr|]
   4.867 -      ==> Key K \<notin> analz (knows Spy evs) -->
   4.868 -          Crypt K
   4.869 -            {|sign (priSK (CA i))
   4.870 -                   {|Agent C, Nonce N, Agent(CA i), Nonce NonceCCA|},
   4.871 -              X, Y|}
   4.872 -             \<in> parts (knows Spy evs) -->
   4.873 -          Nonce NonceCCA \<notin> analz (knows Spy evs)"
   4.874 -apply (erule set_cr.induct, analz_mono_contra)
   4.875 -apply (valid_certificate_tac [8]) --{*for message 5*}
   4.876 -apply (valid_certificate_tac [6]) --{*for message 5*}
   4.877 -apply (frule_tac [9] msg6_KeyCryptNonce_disj [THEN disjE])
   4.878 -apply (simp_all
   4.879 -         del: image_insert image_Un imp_disjL
   4.880 -         add: analz_image_keys_simps analz_knows_absorb sign_def
   4.881 -              analz_Key_image_insert_eq notin_image_iff
   4.882 -              EXHcrypt_def Crypt_notin_image_Key
   4.883 -              N_fresh_not_KeyCryptNonce DK_fresh_not_KeyCryptNonce
   4.884 -              ball_conj_distrib Nonce_compromise symKey_compromise
   4.885 -              analz_image_priEK)
   4.886 -  --{*3 seconds on a 1.6GHz machine*}
   4.887 -apply spy_analz  --{*Fake*}
   4.888 -apply blast  --{*1*}
   4.889 -apply (blast dest!: Gets_imp_knows_Spy [THEN analz.Inj])  --{*2*}
   4.890 -apply blast  --{*3*}
   4.891 -apply (blast dest: NC2_not_NonceCCA)  --{*4*}
   4.892 -apply blast  --{*5*}
   4.893 -apply (blast dest: KC2_secrecy)+  --{*Message 6: two cases*}
   4.894 -done
   4.895 -
   4.896 -
   4.897 -text{*Packaged version for cardholder*}
   4.898 -lemma NonceCCA_secrecy:
   4.899 -     "[|Cardholder k \<notin> bad;  CA i \<notin> bad;
   4.900 -        Gets (Cardholder k)
   4.901 -           (Crypt KC2
   4.902 -            {|sign (priSK (CA i)) {|Agent C, Nonce N, Agent(CA i), Nonce NonceCCA|},
   4.903 -              X, Y|}) \<in> set evs;
   4.904 -        Says (Cardholder k) (CA i)
   4.905 -           {|Crypt KC3 {|Agent C, Nonce NC3, Key KC2, X'|}, Y'|} \<in> set evs;
   4.906 -        Gets A {|Z, cert (CA i) EKi onlyEnc (priSK RCA),
   4.907 -                    cert (CA i) SKi onlySig (priSK RCA)|} \<in> set evs;
   4.908 -        KC2 \<in> symKeys;  evs \<in> set_cr|]
   4.909 -      ==> Nonce NonceCCA \<notin> analz (knows Spy evs)"
   4.910 -apply (frule Gets_certificate_valid, assumption)
   4.911 -apply (subgoal_tac "Key KC2 \<notin> analz (knows Spy evs) ")
   4.912 -apply (blast dest: NonceCCA_secrecy_lemma)
   4.913 -apply (rule symKey_secrecy)
   4.914 -apply (auto simp add: parts_insert2)
   4.915 -done
   4.916 -
   4.917 -text{*We don't bother to prove guarantees for the CA.  He doesn't care about
   4.918 -  the PANSecret: it isn't his credit card!*}
   4.919 -
   4.920 -
   4.921 -subsection{*Rewriting Rule for PANs*}
   4.922 -
   4.923 -text{*Lemma for message 6: either cardSK isn't a CA's private encryption key,
   4.924 -  or if it is then (because it appears in traffic) that CA is bad,
   4.925 -  and so the Spy knows that key already.  Either way, we can simplify
   4.926 -  the expression @{term "analz (insert (Key cardSK) X)"}.*}
   4.927 -lemma msg6_cardSK_disj:
   4.928 -     "[|Gets A {|Crypt K {|c, n, k', Key cardSK, X|}, Y|}
   4.929 -          \<in> set evs;  evs \<in> set_cr |]
   4.930 -      ==> cardSK \<notin> range(invKey o pubEK o CA) | Key cardSK \<in> knows Spy evs"
   4.931 -by auto
   4.932 -
   4.933 -lemma analz_image_pan_lemma:
   4.934 -     "(Pan P \<in> analz (Key`nE Un H)) --> (Pan P \<in> analz H)  ==>
   4.935 -      (Pan P \<in> analz (Key`nE Un H)) =   (Pan P \<in> analz H)"
   4.936 -by (blast intro: analz_mono [THEN [2] rev_subsetD])
   4.937 -
   4.938 -lemma analz_image_pan [rule_format]:
   4.939 -     "evs \<in> set_cr ==>
   4.940 -       \<forall>KK. KK <= - invKey ` pubEK ` range CA -->
   4.941 -            (Pan P \<in> analz (Key`KK Un (knows Spy evs))) =
   4.942 -            (Pan P \<in> analz (knows Spy evs))"
   4.943 -apply (erule set_cr.induct)
   4.944 -apply (rule_tac [!] allI impI)+
   4.945 -apply (rule_tac [!] analz_image_pan_lemma)
   4.946 -apply (valid_certificate_tac [8]) --{*for message 5*}
   4.947 -apply (valid_certificate_tac [6]) --{*for message 5*}
   4.948 -apply (erule_tac [9] msg6_cardSK_disj [THEN disjE])
   4.949 -apply (simp_all
   4.950 -         del: image_insert image_Un
   4.951 -         add: analz_image_keys_simps disjoint_image_iff
   4.952 -              notin_image_iff analz_image_priEK)
   4.953 -  --{*6 seconds on a 1.6GHz machine*}
   4.954 -apply spy_analz
   4.955 -apply (simp add: insert_absorb)  --{*6*}
   4.956 -done
   4.957 -
   4.958 -lemma analz_insert_pan:
   4.959 -     "[| evs \<in> set_cr;  K \<notin> invKey ` pubEK ` range CA |] ==>
   4.960 -          (Pan P \<in> analz (insert (Key K) (knows Spy evs))) =
   4.961 -          (Pan P \<in> analz (knows Spy evs))"
   4.962 -by (simp del: image_insert image_Un
   4.963 -         add: analz_image_keys_simps analz_image_pan)
   4.964 -
   4.965 -
   4.966 -text{*Confidentiality of the PAN\@.  Maybe we could combine the statements of
   4.967 -  this theorem with @{term analz_image_pan}, requiring a single induction but
   4.968 -  a much more difficult proof.*}
   4.969 -lemma pan_confidentiality:
   4.970 -     "[| Pan (pan C) \<in> analz(knows Spy evs); C \<noteq>Spy; evs :set_cr|]
   4.971 -    ==> \<exists>i X K HN.
   4.972 -        Says C (CA i) {|X, Crypt (pubEK (CA i)) {|Key K, Pan (pan C), HN|} |}
   4.973 -           \<in> set evs
   4.974 -      & (CA i) \<in> bad"
   4.975 -apply (erule rev_mp)
   4.976 -apply (erule set_cr.induct)
   4.977 -apply (valid_certificate_tac [8]) --{*for message 5*}
   4.978 -apply (valid_certificate_tac [6]) --{*for message 5*}
   4.979 -apply (erule_tac [9] msg6_cardSK_disj [THEN disjE])
   4.980 -apply (simp_all
   4.981 -         del: image_insert image_Un
   4.982 -         add: analz_image_keys_simps analz_insert_pan analz_image_pan
   4.983 -              notin_image_iff analz_image_priEK)
   4.984 -  --{*3.5 seconds on a 1.6GHz machine*}
   4.985 -apply spy_analz  --{*fake*}
   4.986 -apply blast  --{*3*}
   4.987 -apply blast  --{*5*}
   4.988 -apply (simp (no_asm_simp) add: insert_absorb)  --{*6*}
   4.989 -done
   4.990 -
   4.991 -
   4.992 -subsection{*Unicity*}
   4.993 -
   4.994 -lemma CR6_Says_imp_Notes:
   4.995 -     "[|Says (CA i) C (Crypt KC2
   4.996 -          {|sign (priSK (CA i)) {|Agent C, Nonce NC3, Agent (CA i), Nonce Y|},
   4.997 -            certC (pan C) cardSK X onlySig (priSK (CA i)),
   4.998 -            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})  \<in> set evs;
   4.999 -        evs \<in> set_cr |]
  4.1000 -      ==> Notes (CA i) (Key cardSK) \<in> set evs"
  4.1001 -apply (erule rev_mp)
  4.1002 -apply (erule set_cr.induct)
  4.1003 -apply (simp_all (no_asm_simp))
  4.1004 -done
  4.1005 -
  4.1006 -text{*Unicity of cardSK: it uniquely identifies the other components.  
  4.1007 -      This holds because a CA accepts a cardSK at most once.*}
  4.1008 -lemma cardholder_key_unicity:
  4.1009 -     "[|Says (CA i) C (Crypt KC2
  4.1010 -          {|sign (priSK (CA i)) {|Agent C, Nonce NC3, Agent (CA i), Nonce Y|},
  4.1011 -            certC (pan C) cardSK X onlySig (priSK (CA i)),
  4.1012 -            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})
  4.1013 -          \<in> set evs;
  4.1014 -        Says (CA i) C' (Crypt KC2'
  4.1015 -          {|sign (priSK (CA i)) {|Agent C', Nonce NC3', Agent (CA i), Nonce Y'|},
  4.1016 -            certC (pan C') cardSK X' onlySig (priSK (CA i)),
  4.1017 -            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})
  4.1018 -          \<in> set evs;
  4.1019 -        evs \<in> set_cr |] ==> C=C' & NC3=NC3' & X=X' & KC2=KC2' & Y=Y'"
  4.1020 -apply (erule rev_mp)
  4.1021 -apply (erule rev_mp)
  4.1022 -apply (erule set_cr.induct)
  4.1023 -apply (simp_all (no_asm_simp))
  4.1024 -apply (blast dest!: CR6_Says_imp_Notes)
  4.1025 -done
  4.1026 -
  4.1027 -
  4.1028 -(*<*)
  4.1029 -text{*UNUSED unicity result*}
  4.1030 -lemma unique_KC1:
  4.1031 -     "[|Says C B {|Crypt KC1 X, Crypt EK {|Key KC1, Y|}|}
  4.1032 -          \<in> set evs;
  4.1033 -        Says C B' {|Crypt KC1 X', Crypt EK' {|Key KC1, Y'|}|}
  4.1034 -          \<in> set evs;
  4.1035 -        C \<notin> bad;  evs \<in> set_cr|] ==> B'=B & Y'=Y"
  4.1036 -apply (erule rev_mp)
  4.1037 -apply (erule rev_mp)
  4.1038 -apply (erule set_cr.induct, auto)
  4.1039 -done
  4.1040 -
  4.1041 -text{*UNUSED unicity result*}
  4.1042 -lemma unique_KC2:
  4.1043 -     "[|Says C B {|Crypt K {|Agent C, nn, Key KC2, X|}, Y|} \<in> set evs;
  4.1044 -        Says C B' {|Crypt K' {|Agent C, nn', Key KC2, X'|}, Y'|} \<in> set evs;
  4.1045 -        C \<notin> bad;  evs \<in> set_cr|] ==> B'=B & X'=X"
  4.1046 -apply (erule rev_mp)
  4.1047 -apply (erule rev_mp)
  4.1048 -apply (erule set_cr.induct, auto)
  4.1049 -done
  4.1050 -(*>*)
  4.1051 -
  4.1052 -
  4.1053 -text{*Cannot show cardSK to be secret because it isn't assumed to be fresh
  4.1054 -  it could be a previously compromised cardSK [e.g. involving a bad CA]*}
  4.1055 -
  4.1056 -
  4.1057 -end
     5.1 --- a/src/HOL/SET-Protocol/EventSET.thy	Tue Oct 20 19:52:04 2009 +0200
     5.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.3 @@ -1,196 +0,0 @@
     5.4 -(*  Title:      HOL/SET-Protocol/EventSET.thy
     5.5 -    Author:     Giampaolo Bella
     5.6 -    Author:     Fabio Massacci
     5.7 -    Author:     Lawrence C Paulson
     5.8 -*)
     5.9 -
    5.10 -header{*Theory of Events for SET*}
    5.11 -
    5.12 -theory EventSET imports MessageSET begin
    5.13 -
    5.14 -text{*The Root Certification Authority*}
    5.15 -syntax        RCA :: agent
    5.16 -translations "RCA" == "CA 0"
    5.17 -
    5.18 -
    5.19 -text{*Message events*}
    5.20 -datatype
    5.21 -  event = Says  agent agent msg
    5.22 -        | Gets  agent       msg
    5.23 -        | Notes agent       msg
    5.24 -
    5.25 -
    5.26 -text{*compromised agents: keys known, Notes visible*}
    5.27 -consts bad :: "agent set"
    5.28 -
    5.29 -text{*Spy has access to his own key for spoof messages, but RCA is secure*}
    5.30 -specification (bad)
    5.31 -  Spy_in_bad     [iff]: "Spy \<in> bad"
    5.32 -  RCA_not_bad [iff]: "RCA \<notin> bad"
    5.33 -    by (rule exI [of _ "{Spy}"], simp)
    5.34 -
    5.35 -
    5.36 -subsection{*Agents' Knowledge*}
    5.37 -
    5.38 -consts  (*Initial states of agents -- parameter of the construction*)
    5.39 -  initState :: "agent => msg set"
    5.40 -  knows  :: "[agent, event list] => msg set"
    5.41 -
    5.42 -(* Message reception does not extend spy's knowledge because of
    5.43 -   reception invariant enforced by Reception rule in protocol definition*)
    5.44 -primrec
    5.45 -
    5.46 -knows_Nil:
    5.47 -  "knows A []       = initState A"
    5.48 -knows_Cons:
    5.49 -    "knows A (ev # evs) =
    5.50 -       (if A = Spy then
    5.51 -        (case ev of
    5.52 -           Says A' B X => insert X (knows Spy evs)
    5.53 -         | Gets A' X => knows Spy evs
    5.54 -         | Notes A' X  =>
    5.55 -             if A' \<in> bad then insert X (knows Spy evs) else knows Spy evs)
    5.56 -        else
    5.57 -        (case ev of
    5.58 -           Says A' B X =>
    5.59 -             if A'=A then insert X (knows A evs) else knows A evs
    5.60 -         | Gets A' X    =>
    5.61 -             if A'=A then insert X (knows A evs) else knows A evs
    5.62 -         | Notes A' X    =>
    5.63 -             if A'=A then insert X (knows A evs) else knows A evs))"
    5.64 -
    5.65 -
    5.66 -subsection{*Used Messages*}
    5.67 -
    5.68 -consts
    5.69 -  (*Set of items that might be visible to somebody:
    5.70 -    complement of the set of fresh items*)
    5.71 -  used :: "event list => msg set"
    5.72 -
    5.73 -(* As above, message reception does extend used items *)
    5.74 -primrec
    5.75 -  used_Nil:  "used []         = (UN B. parts (initState B))"
    5.76 -  used_Cons: "used (ev # evs) =
    5.77 -                 (case ev of
    5.78 -                    Says A B X => parts {X} Un (used evs)
    5.79 -                  | Gets A X   => used evs
    5.80 -                  | Notes A X  => parts {X} Un (used evs))"
    5.81 -
    5.82 -
    5.83 -
    5.84 -(* Inserted by default but later removed.  This declaration lets the file
    5.85 -be re-loaded. Addsimps [knows_Cons, used_Nil, *)
    5.86 -
    5.87 -(** Simplifying   parts (insert X (knows Spy evs))
    5.88 -      = parts {X} Un parts (knows Spy evs) -- since general case loops*)
    5.89 -
    5.90 -lemmas parts_insert_knows_A = parts_insert [of _ "knows A evs", standard]
    5.91 -
    5.92 -lemma knows_Spy_Says [simp]:
    5.93 -     "knows Spy (Says A B X # evs) = insert X (knows Spy evs)"
    5.94 -by auto
    5.95 -
    5.96 -text{*Letting the Spy see "bad" agents' notes avoids redundant case-splits
    5.97 -      on whether @{term "A=Spy"} and whether @{term "A\<in>bad"}*}
    5.98 -lemma knows_Spy_Notes [simp]:
    5.99 -     "knows Spy (Notes A X # evs) =
   5.100 -          (if A:bad then insert X (knows Spy evs) else knows Spy evs)"
   5.101 -apply auto
   5.102 -done
   5.103 -
   5.104 -lemma knows_Spy_Gets [simp]: "knows Spy (Gets A X # evs) = knows Spy evs"
   5.105 -by auto
   5.106 -
   5.107 -lemma initState_subset_knows: "initState A <= knows A evs"
   5.108 -apply (induct_tac "evs")
   5.109 -apply (auto split: event.split) 
   5.110 -done
   5.111 -
   5.112 -lemma knows_Spy_subset_knows_Spy_Says:
   5.113 -     "knows Spy evs <= knows Spy (Says A B X # evs)"
   5.114 -by auto
   5.115 -
   5.116 -lemma knows_Spy_subset_knows_Spy_Notes:
   5.117 -     "knows Spy evs <= knows Spy (Notes A X # evs)"
   5.118 -by auto
   5.119 -
   5.120 -lemma knows_Spy_subset_knows_Spy_Gets:
   5.121 -     "knows Spy evs <= knows Spy (Gets A X # evs)"
   5.122 -by auto
   5.123 -
   5.124 -(*Spy sees what is sent on the traffic*)
   5.125 -lemma Says_imp_knows_Spy [rule_format]:
   5.126 -     "Says A B X \<in> set evs --> X \<in> knows Spy evs"
   5.127 -apply (induct_tac "evs")
   5.128 -apply (auto split: event.split) 
   5.129 -done
   5.130 -
   5.131 -(*Use with addSEs to derive contradictions from old Says events containing
   5.132 -  items known to be fresh*)
   5.133 -lemmas knows_Spy_partsEs =
   5.134 -     Says_imp_knows_Spy [THEN parts.Inj, THEN revcut_rl, standard] 
   5.135 -     parts.Body [THEN revcut_rl, standard]
   5.136 -
   5.137 -
   5.138 -subsection{*The Function @{term used}*}
   5.139 -
   5.140 -lemma parts_knows_Spy_subset_used: "parts (knows Spy evs) <= used evs"
   5.141 -apply (induct_tac "evs")
   5.142 -apply (auto simp add: parts_insert_knows_A split: event.split) 
   5.143 -done
   5.144 -
   5.145 -lemmas usedI = parts_knows_Spy_subset_used [THEN subsetD, intro]
   5.146 -
   5.147 -lemma initState_subset_used: "parts (initState B) <= used evs"
   5.148 -apply (induct_tac "evs")
   5.149 -apply (auto split: event.split) 
   5.150 -done
   5.151 -
   5.152 -lemmas initState_into_used = initState_subset_used [THEN subsetD]
   5.153 -
   5.154 -lemma used_Says [simp]: "used (Says A B X # evs) = parts{X} Un used evs"
   5.155 -by auto
   5.156 -
   5.157 -lemma used_Notes [simp]: "used (Notes A X # evs) = parts{X} Un used evs"
   5.158 -by auto
   5.159 -
   5.160 -lemma used_Gets [simp]: "used (Gets A X # evs) = used evs"
   5.161 -by auto
   5.162 -
   5.163 -
   5.164 -lemma Notes_imp_parts_subset_used [rule_format]:
   5.165 -     "Notes A X \<in> set evs --> parts {X} <= used evs"
   5.166 -apply (induct_tac "evs")
   5.167 -apply (induct_tac [2] "a", auto)
   5.168 -done
   5.169 -
   5.170 -text{*NOTE REMOVAL--laws above are cleaner, as they don't involve "case"*}
   5.171 -declare knows_Cons [simp del]
   5.172 -        used_Nil [simp del] used_Cons [simp del]
   5.173 -
   5.174 -
   5.175 -text{*For proving theorems of the form @{term "X \<notin> analz (knows Spy evs) --> P"}
   5.176 -  New events added by induction to "evs" are discarded.  Provided 
   5.177 -  this information isn't needed, the proof will be much shorter, since
   5.178 -  it will omit complicated reasoning about @{term analz}.*}
   5.179 -
   5.180 -lemmas analz_mono_contra =
   5.181 -       knows_Spy_subset_knows_Spy_Says [THEN analz_mono, THEN contra_subsetD]
   5.182 -       knows_Spy_subset_knows_Spy_Notes [THEN analz_mono, THEN contra_subsetD]
   5.183 -       knows_Spy_subset_knows_Spy_Gets [THEN analz_mono, THEN contra_subsetD]
   5.184 -
   5.185 -lemmas analz_impI = impI [where P = "Y \<notin> analz (knows Spy evs)", standard]
   5.186 -
   5.187 -ML
   5.188 -{*
   5.189 -val analz_mono_contra_tac = 
   5.190 -  rtac @{thm analz_impI} THEN' 
   5.191 -  REPEAT1 o (dresolve_tac @{thms analz_mono_contra})
   5.192 -  THEN' mp_tac
   5.193 -*}
   5.194 -
   5.195 -method_setup analz_mono_contra = {*
   5.196 -    Scan.succeed (K (SIMPLE_METHOD (REPEAT_FIRST analz_mono_contra_tac))) *}
   5.197 -    "for proving theorems of the form X \<notin> analz (knows Spy evs) --> P"
   5.198 -
   5.199 -end
     6.1 --- a/src/HOL/SET-Protocol/Merchant_Registration.thy	Tue Oct 20 19:52:04 2009 +0200
     6.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.3 @@ -1,427 +0,0 @@
     6.4 -(*  Title:      HOL/SET-Protocol/Merchant_Registration.thy
     6.5 -    Author:     Giampaolo Bella
     6.6 -    Author:     Fabio Massacci
     6.7 -    Author:     Lawrence C Paulson
     6.8 -*)
     6.9 -
    6.10 -header{*The SET Merchant Registration Protocol*}
    6.11 -
    6.12 -theory Merchant_Registration imports PublicSET begin
    6.13 -
    6.14 -text{*Copmpared with Cardholder Reigstration, @{text KeyCryptKey} is not
    6.15 -  needed: no session key encrypts another.  Instead we
    6.16 -  prove the "key compromise" theorems for sets KK that contain no private
    6.17 -  encryption keys (@{term "priEK C"}). *}
    6.18 -
    6.19 -
    6.20 -inductive_set
    6.21 -  set_mr :: "event list set"
    6.22 -where
    6.23 -
    6.24 -  Nil:    --{*Initial trace is empty*}
    6.25 -           "[] \<in> set_mr"
    6.26 -
    6.27 -
    6.28 -| Fake:    --{*The spy MAY say anything he CAN say.*}
    6.29 -           "[| evsf \<in> set_mr; X \<in> synth (analz (knows Spy evsf)) |]
    6.30 -            ==> Says Spy B X  # evsf \<in> set_mr"
    6.31 -        
    6.32 -
    6.33 -| Reception: --{*If A sends a message X to B, then B might receive it*}
    6.34 -             "[| evsr \<in> set_mr; Says A B X \<in> set evsr |]
    6.35 -              ==> Gets B X  # evsr \<in> set_mr"
    6.36 -
    6.37 -
    6.38 -| SET_MR1: --{*RegFormReq: M requires a registration form to a CA*}
    6.39 -           "[| evs1 \<in> set_mr; M = Merchant k; Nonce NM1 \<notin> used evs1 |]
    6.40 -            ==> Says M (CA i) {|Agent M, Nonce NM1|} # evs1 \<in> set_mr"
    6.41 -
    6.42 -
    6.43 -| SET_MR2: --{*RegFormRes: CA replies with the registration form and the 
    6.44 -               certificates for her keys*}
    6.45 -  "[| evs2 \<in> set_mr; Nonce NCA \<notin> used evs2;
    6.46 -      Gets (CA i) {|Agent M, Nonce NM1|} \<in> set evs2 |]
    6.47 -   ==> Says (CA i) M {|sign (priSK (CA i)) {|Agent M, Nonce NM1, Nonce NCA|},
    6.48 -                       cert (CA i) (pubEK (CA i)) onlyEnc (priSK RCA),
    6.49 -                       cert (CA i) (pubSK (CA i)) onlySig (priSK RCA) |}
    6.50 -         # evs2 \<in> set_mr"
    6.51 -
    6.52 -| SET_MR3:
    6.53 -         --{*CertReq: M submits the key pair to be certified.  The Notes
    6.54 -             event allows KM1 to be lost if M is compromised. Piero remarks
    6.55 -             that the agent mentioned inside the signature is not verified to
    6.56 -             correspond to M.  As in CR, each Merchant has fixed key pairs.  M
    6.57 -             is only optionally required to send NCA back, so M doesn't do so
    6.58 -             in the model*}
    6.59 -  "[| evs3 \<in> set_mr; M = Merchant k; Nonce NM2 \<notin> used evs3;
    6.60 -      Key KM1 \<notin> used evs3;  KM1 \<in> symKeys;
    6.61 -      Gets M {|sign (invKey SKi) {|Agent X, Nonce NM1, Nonce NCA|},
    6.62 -               cert (CA i) EKi onlyEnc (priSK RCA),
    6.63 -               cert (CA i) SKi onlySig (priSK RCA) |}
    6.64 -        \<in> set evs3;
    6.65 -      Says M (CA i) {|Agent M, Nonce NM1|} \<in> set evs3 |]
    6.66 -   ==> Says M (CA i)
    6.67 -            {|Crypt KM1 (sign (priSK M) {|Agent M, Nonce NM2,
    6.68 -                                          Key (pubSK M), Key (pubEK M)|}),
    6.69 -              Crypt EKi (Key KM1)|}
    6.70 -         # Notes M {|Key KM1, Agent (CA i)|}
    6.71 -         # evs3 \<in> set_mr"
    6.72 -
    6.73 -| SET_MR4:
    6.74 -         --{*CertRes: CA issues the certificates for merSK and merEK,
    6.75 -             while checking never to have certified the m even
    6.76 -             separately. NOTE: In Cardholder Registration the
    6.77 -             corresponding rule (6) doesn't use the "sign" primitive. "The
    6.78 -             CertRes shall be signed but not encrypted if the EE is a Merchant
    6.79 -             or Payment Gateway."-- Programmer's Guide, page 191.*}
    6.80 -    "[| evs4 \<in> set_mr; M = Merchant k;
    6.81 -        merSK \<notin> symKeys;  merEK \<notin> symKeys;
    6.82 -        Notes (CA i) (Key merSK) \<notin> set evs4;
    6.83 -        Notes (CA i) (Key merEK) \<notin> set evs4;
    6.84 -        Gets (CA i) {|Crypt KM1 (sign (invKey merSK)
    6.85 -                                 {|Agent M, Nonce NM2, Key merSK, Key merEK|}),
    6.86 -                      Crypt (pubEK (CA i)) (Key KM1) |}
    6.87 -          \<in> set evs4 |]
    6.88 -    ==> Says (CA i) M {|sign (priSK(CA i)) {|Agent M, Nonce NM2, Agent(CA i)|},
    6.89 -                        cert  M      merSK    onlySig (priSK (CA i)),
    6.90 -                        cert  M      merEK    onlyEnc (priSK (CA i)),
    6.91 -                        cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|}
    6.92 -          # Notes (CA i) (Key merSK)
    6.93 -          # Notes (CA i) (Key merEK)
    6.94 -          # evs4 \<in> set_mr"
    6.95 -
    6.96 -
    6.97 -text{*Note possibility proofs are missing.*}
    6.98 -
    6.99 -declare Says_imp_knows_Spy [THEN parts.Inj, dest]
   6.100 -declare parts.Body [dest]
   6.101 -declare analz_into_parts [dest]
   6.102 -declare Fake_parts_insert_in_Un [dest]
   6.103 -
   6.104 -text{*General facts about message reception*}
   6.105 -lemma Gets_imp_Says:
   6.106 -     "[| Gets B X \<in> set evs; evs \<in> set_mr |] ==> \<exists>A. Says A B X \<in> set evs"
   6.107 -apply (erule rev_mp)
   6.108 -apply (erule set_mr.induct, auto)
   6.109 -done
   6.110 -
   6.111 -lemma Gets_imp_knows_Spy:
   6.112 -     "[| Gets B X \<in> set evs; evs \<in> set_mr |]  ==> X \<in> knows Spy evs"
   6.113 -by (blast dest!: Gets_imp_Says Says_imp_knows_Spy)
   6.114 -
   6.115 -
   6.116 -declare Gets_imp_knows_Spy [THEN parts.Inj, dest]
   6.117 -
   6.118 -subsubsection{*Proofs on keys *}
   6.119 -
   6.120 -text{*Spy never sees an agent's private keys! (unless it's bad at start)*}
   6.121 -lemma Spy_see_private_Key [simp]:
   6.122 -     "evs \<in> set_mr
   6.123 -      ==> (Key(invKey (publicKey b A)) \<in> parts(knows Spy evs)) = (A \<in> bad)"
   6.124 -apply (erule set_mr.induct)
   6.125 -apply (auto dest!: Gets_imp_knows_Spy [THEN parts.Inj])
   6.126 -done
   6.127 -
   6.128 -lemma Spy_analz_private_Key [simp]:
   6.129 -     "evs \<in> set_mr ==>
   6.130 -     (Key(invKey (publicKey b A)) \<in> analz(knows Spy evs)) = (A \<in> bad)"
   6.131 -by auto
   6.132 -
   6.133 -declare Spy_see_private_Key [THEN [2] rev_iffD1, dest!]
   6.134 -declare Spy_analz_private_Key [THEN [2] rev_iffD1, dest!]
   6.135 -
   6.136 -(*This is to state that the signed keys received in step 4
   6.137 -  are into parts - rather than installing sign_def each time.
   6.138 -  Needed in Spy_see_priSK_RCA, Spy_see_priEK and in Spy_see_priSK
   6.139 -Goal "[|Gets C \<lbrace>Crypt KM1
   6.140 -                (sign K \<lbrace>Agent M, Nonce NM2, Key merSK, Key merEK\<rbrace>), X\<rbrace>
   6.141 -          \<in> set evs;  evs \<in> set_mr |]
   6.142 -    ==> Key merSK \<in> parts (knows Spy evs) \<and>
   6.143 -        Key merEK \<in> parts (knows Spy evs)"
   6.144 -by (fast_tac (claset() addss (simpset())) 1);
   6.145 -qed "signed_keys_in_parts";
   6.146 -???*)
   6.147 -
   6.148 -text{*Proofs on certificates -
   6.149 -  they hold, as in CR, because RCA's keys are secure*}
   6.150 -
   6.151 -lemma Crypt_valid_pubEK:
   6.152 -     "[| Crypt (priSK RCA) {|Agent (CA i), Key EKi, onlyEnc|}
   6.153 -           \<in> parts (knows Spy evs);
   6.154 -         evs \<in> set_mr |] ==> EKi = pubEK (CA i)"
   6.155 -apply (erule rev_mp)
   6.156 -apply (erule set_mr.induct, auto)
   6.157 -done
   6.158 -
   6.159 -lemma certificate_valid_pubEK:
   6.160 -    "[| cert (CA i) EKi onlyEnc (priSK RCA) \<in> parts (knows Spy evs);
   6.161 -        evs \<in> set_mr |]
   6.162 -     ==> EKi = pubEK (CA i)"
   6.163 -apply (unfold cert_def signCert_def)
   6.164 -apply (blast dest!: Crypt_valid_pubEK)
   6.165 -done
   6.166 -
   6.167 -lemma Crypt_valid_pubSK:
   6.168 -     "[| Crypt (priSK RCA) {|Agent (CA i), Key SKi, onlySig|}
   6.169 -           \<in> parts (knows Spy evs);
   6.170 -         evs \<in> set_mr |] ==> SKi = pubSK (CA i)"
   6.171 -apply (erule rev_mp)
   6.172 -apply (erule set_mr.induct, auto)
   6.173 -done
   6.174 -
   6.175 -lemma certificate_valid_pubSK:
   6.176 -    "[| cert (CA i) SKi onlySig (priSK RCA) \<in> parts (knows Spy evs);
   6.177 -        evs \<in> set_mr |] ==> SKi = pubSK (CA i)"
   6.178 -apply (unfold cert_def signCert_def)
   6.179 -apply (blast dest!: Crypt_valid_pubSK)
   6.180 -done
   6.181 -
   6.182 -lemma Gets_certificate_valid:
   6.183 -     "[| Gets A {| X, cert (CA i) EKi onlyEnc (priSK RCA),
   6.184 -                      cert (CA i) SKi onlySig (priSK RCA)|} \<in> set evs;
   6.185 -         evs \<in> set_mr |]
   6.186 -      ==> EKi = pubEK (CA i) & SKi = pubSK (CA i)"
   6.187 -by (blast dest: certificate_valid_pubEK certificate_valid_pubSK)
   6.188 -
   6.189 -
   6.190 -text{*Nobody can have used non-existent keys!*}
   6.191 -lemma new_keys_not_used [rule_format,simp]:
   6.192 -     "evs \<in> set_mr
   6.193 -      ==> Key K \<notin> used evs --> K \<in> symKeys -->
   6.194 -          K \<notin> keysFor (parts (knows Spy evs))"
   6.195 -apply (erule set_mr.induct, simp_all)
   6.196 -apply (force dest!: usedI keysFor_parts_insert)  --{*Fake*}
   6.197 -apply force  --{*Message 2*}
   6.198 -apply (blast dest: Gets_certificate_valid)  --{*Message 3*}
   6.199 -apply force  --{*Message 4*}
   6.200 -done
   6.201 -
   6.202 -
   6.203 -subsubsection{*New Versions: As Above, but Generalized with the Kk Argument*}
   6.204 -
   6.205 -lemma gen_new_keys_not_used [rule_format]:
   6.206 -     "evs \<in> set_mr
   6.207 -      ==> Key K \<notin> used evs --> K \<in> symKeys -->
   6.208 -          K \<notin> keysFor (parts (Key`KK Un knows Spy evs))"
   6.209 -by auto
   6.210 -
   6.211 -lemma gen_new_keys_not_analzd:
   6.212 -     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_mr |]
   6.213 -      ==> K \<notin> keysFor (analz (Key`KK Un knows Spy evs))"
   6.214 -by (blast intro: keysFor_mono [THEN [2] rev_subsetD]
   6.215 -          dest: gen_new_keys_not_used)
   6.216 -
   6.217 -lemma analz_Key_image_insert_eq:
   6.218 -     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_mr |]
   6.219 -      ==> analz (Key ` (insert K KK) \<union> knows Spy evs) =
   6.220 -          insert (Key K) (analz (Key ` KK \<union> knows Spy evs))"
   6.221 -by (simp add: gen_new_keys_not_analzd)
   6.222 -
   6.223 -
   6.224 -lemma Crypt_parts_imp_used:
   6.225 -     "[|Crypt K X \<in> parts (knows Spy evs);
   6.226 -        K \<in> symKeys; evs \<in> set_mr |] ==> Key K \<in> used evs"
   6.227 -apply (rule ccontr)
   6.228 -apply (force dest: new_keys_not_used Crypt_imp_invKey_keysFor)
   6.229 -done
   6.230 -
   6.231 -lemma Crypt_analz_imp_used:
   6.232 -     "[|Crypt K X \<in> analz (knows Spy evs);
   6.233 -        K \<in> symKeys; evs \<in> set_mr |] ==> Key K \<in> used evs"
   6.234 -by (blast intro: Crypt_parts_imp_used)
   6.235 -
   6.236 -text{*Rewriting rule for private encryption keys.  Analogous rewriting rules
   6.237 -for other keys aren't needed.*}
   6.238 -
   6.239 -lemma parts_image_priEK:
   6.240 -     "[|Key (priEK (CA i)) \<in> parts (Key`KK Un (knows Spy evs));
   6.241 -        evs \<in> set_mr|] ==> priEK (CA i) \<in> KK | CA i \<in> bad"
   6.242 -by auto
   6.243 -
   6.244 -text{*trivial proof because (priEK (CA i)) never appears even in (parts evs)*}
   6.245 -lemma analz_image_priEK:
   6.246 -     "evs \<in> set_mr ==>
   6.247 -          (Key (priEK (CA i)) \<in> analz (Key`KK Un (knows Spy evs))) =
   6.248 -          (priEK (CA i) \<in> KK | CA i \<in> bad)"
   6.249 -by (blast dest!: parts_image_priEK intro: analz_mono [THEN [2] rev_subsetD])
   6.250 -
   6.251 -
   6.252 -subsection{*Secrecy of Session Keys*}
   6.253 -
   6.254 -text{*This holds because if (priEK (CA i)) appears in any traffic then it must
   6.255 -  be known to the Spy, by @{text Spy_see_private_Key}*}
   6.256 -lemma merK_neq_priEK:
   6.257 -     "[|Key merK \<notin> analz (knows Spy evs);
   6.258 -        Key merK \<in> parts (knows Spy evs);
   6.259 -        evs \<in> set_mr|] ==> merK \<noteq> priEK C"
   6.260 -by blast
   6.261 -
   6.262 -text{*Lemma for message 4: either merK is compromised (when we don't care)
   6.263 -  or else merK hasn't been used to encrypt K.*}
   6.264 -lemma msg4_priEK_disj:
   6.265 -     "[|Gets B {|Crypt KM1
   6.266 -                       (sign K {|Agent M, Nonce NM2, Key merSK, Key merEK|}),
   6.267 -                 Y|} \<in> set evs;
   6.268 -        evs \<in> set_mr|]
   6.269 -  ==> (Key merSK \<in> analz (knows Spy evs) | merSK \<notin> range(\<lambda>C. priEK C))
   6.270 -   &  (Key merEK \<in> analz (knows Spy evs) | merEK \<notin> range(\<lambda>C. priEK C))"
   6.271 -apply (unfold sign_def)
   6.272 -apply (blast dest: merK_neq_priEK)
   6.273 -done
   6.274 -
   6.275 -
   6.276 -lemma Key_analz_image_Key_lemma:
   6.277 -     "P --> (Key K \<in> analz (Key`KK Un H)) --> (K\<in>KK | Key K \<in> analz H)
   6.278 -      ==>
   6.279 -      P --> (Key K \<in> analz (Key`KK Un H)) = (K\<in>KK | Key K \<in> analz H)"
   6.280 -by (blast intro: analz_mono [THEN [2] rev_subsetD])
   6.281 -
   6.282 -lemma symKey_compromise:
   6.283 -     "evs \<in> set_mr ==>
   6.284 -      (\<forall>SK KK. SK \<in> symKeys \<longrightarrow> (\<forall>K \<in> KK. K \<notin> range(\<lambda>C. priEK C)) -->
   6.285 -               (Key SK \<in> analz (Key`KK Un (knows Spy evs))) =
   6.286 -               (SK \<in> KK | Key SK \<in> analz (knows Spy evs)))"
   6.287 -apply (erule set_mr.induct)
   6.288 -apply (safe del: impI intro!: Key_analz_image_Key_lemma [THEN impI])
   6.289 -apply (drule_tac [7] msg4_priEK_disj)
   6.290 -apply (frule_tac [6] Gets_certificate_valid)
   6.291 -apply (safe del: impI)
   6.292 -apply (simp_all del: image_insert image_Un imp_disjL
   6.293 -         add: analz_image_keys_simps abbrev_simps analz_knows_absorb
   6.294 -              analz_knows_absorb2 analz_Key_image_insert_eq notin_image_iff
   6.295 -              Spy_analz_private_Key analz_image_priEK)
   6.296 -  --{*5 seconds on a 1.6GHz machine*}
   6.297 -apply spy_analz  --{*Fake*}
   6.298 -apply auto  --{*Message 3*}
   6.299 -done
   6.300 -
   6.301 -lemma symKey_secrecy [rule_format]:
   6.302 -     "[|CA i \<notin> bad; K \<in> symKeys;  evs \<in> set_mr|]
   6.303 -      ==> \<forall>X m. Says (Merchant m) (CA i) X \<in> set evs -->
   6.304 -                Key K \<in> parts{X} -->
   6.305 -                Merchant m \<notin> bad -->
   6.306 -                Key K \<notin> analz (knows Spy evs)"
   6.307 -apply (erule set_mr.induct)
   6.308 -apply (drule_tac [7] msg4_priEK_disj)
   6.309 -apply (frule_tac [6] Gets_certificate_valid)
   6.310 -apply (safe del: impI)
   6.311 -apply (simp_all del: image_insert image_Un imp_disjL
   6.312 -         add: analz_image_keys_simps abbrev_simps analz_knows_absorb
   6.313 -              analz_knows_absorb2 analz_Key_image_insert_eq
   6.314 -              symKey_compromise notin_image_iff Spy_analz_private_Key
   6.315 -              analz_image_priEK)
   6.316 -apply spy_analz  --{*Fake*}
   6.317 -apply force  --{*Message 1*}
   6.318 -apply (auto intro: analz_into_parts [THEN usedI] in_parts_Says_imp_used)  --{*Message 3*}
   6.319 -done
   6.320 -
   6.321 -subsection{*Unicity *}
   6.322 -
   6.323 -lemma msg4_Says_imp_Notes:
   6.324 - "[|Says (CA i) M {|sign (priSK (CA i)) {|Agent M, Nonce NM2, Agent (CA i)|},
   6.325 -                    cert  M      merSK    onlySig (priSK (CA i)),
   6.326 -                    cert  M      merEK    onlyEnc (priSK (CA i)),
   6.327 -                    cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|} \<in> set evs;
   6.328 -    evs \<in> set_mr |]
   6.329 -  ==> Notes (CA i) (Key merSK) \<in> set evs
   6.330 -   &  Notes (CA i) (Key merEK) \<in> set evs"
   6.331 -apply (erule rev_mp)
   6.332 -apply (erule set_mr.induct)
   6.333 -apply (simp_all (no_asm_simp))
   6.334 -done
   6.335 -
   6.336 -text{*Unicity of merSK wrt a given CA:
   6.337 -  merSK uniquely identifies the other components, including merEK*}
   6.338 -lemma merSK_unicity:
   6.339 - "[|Says (CA i) M {|sign (priSK(CA i)) {|Agent M, Nonce NM2, Agent (CA i)|},
   6.340 -                    cert  M      merSK    onlySig (priSK (CA i)),
   6.341 -                    cert  M      merEK    onlyEnc (priSK (CA i)),
   6.342 -                    cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|} \<in> set evs;
   6.343 -    Says (CA i) M' {|sign (priSK(CA i)) {|Agent M', Nonce NM2', Agent (CA i)|},
   6.344 -                    cert  M'      merSK    onlySig (priSK (CA i)),
   6.345 -                    cert  M'      merEK'    onlyEnc (priSK (CA i)),
   6.346 -                    cert (CA i) (pubSK(CA i)) onlySig (priSK RCA)|} \<in> set evs;
   6.347 -    evs \<in> set_mr |] ==> M=M' & NM2=NM2' & merEK=merEK'"
   6.348 -apply (erule rev_mp)
   6.349 -apply (erule rev_mp)
   6.350 -apply (erule set_mr.induct)
   6.351 -apply (simp_all (no_asm_simp))
   6.352 -apply (blast dest!: msg4_Says_imp_Notes)
   6.353 -done
   6.354 -
   6.355 -text{*Unicity of merEK wrt a given CA:
   6.356 -  merEK uniquely identifies the other components, including merSK*}
   6.357 -lemma merEK_unicity:
   6.358 - "[|Says (CA i) M {|sign (priSK(CA i)) {|Agent M, Nonce NM2, Agent (CA i)|},
   6.359 -                    cert  M      merSK    onlySig (priSK (CA i)),
   6.360 -                    cert  M      merEK    onlyEnc (priSK (CA i)),
   6.361 -                    cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|} \<in> set evs;
   6.362 -    Says (CA i) M' {|sign (priSK(CA i)) {|Agent M', Nonce NM2', Agent (CA i)|},
   6.363 -                     cert  M'      merSK'    onlySig (priSK (CA i)),
   6.364 -                     cert  M'      merEK    onlyEnc (priSK (CA i)),
   6.365 -                     cert (CA i) (pubSK(CA i)) onlySig (priSK RCA)|} \<in> set evs;
   6.366 -    evs \<in> set_mr |] 
   6.367 -  ==> M=M' & NM2=NM2' & merSK=merSK'"
   6.368 -apply (erule rev_mp)
   6.369 -apply (erule rev_mp)
   6.370 -apply (erule set_mr.induct)
   6.371 -apply (simp_all (no_asm_simp))
   6.372 -apply (blast dest!: msg4_Says_imp_Notes)
   6.373 -done
   6.374 -
   6.375 -
   6.376 -text{* -No interest on secrecy of nonces: they appear to be used
   6.377 -    only for freshness.
   6.378 -   -No interest on secrecy of merSK or merEK, as in CR.
   6.379 -   -There's no equivalent of the PAN*}
   6.380 -
   6.381 -
   6.382 -subsection{*Primary Goals of Merchant Registration *}
   6.383 -
   6.384 -subsubsection{*The merchant's certificates really were created by the CA,
   6.385 -provided the CA is uncompromised *}
   6.386 -
   6.387 -text{*The assumption @{term "CA i \<noteq> RCA"} is required: step 2 uses 
   6.388 -  certificates of the same form.*}
   6.389 -lemma certificate_merSK_valid_lemma [intro]:
   6.390 -     "[|Crypt (priSK (CA i)) {|Agent M, Key merSK, onlySig|}
   6.391 -          \<in> parts (knows Spy evs);
   6.392 -        CA i \<notin> bad;  CA i \<noteq> RCA;  evs \<in> set_mr|]
   6.393 - ==> \<exists>X Y Z. Says (CA i) M
   6.394 -                  {|X, cert M merSK onlySig (priSK (CA i)), Y, Z|} \<in> set evs"
   6.395 -apply (erule rev_mp)
   6.396 -apply (erule set_mr.induct)
   6.397 -apply (simp_all (no_asm_simp))
   6.398 -apply auto
   6.399 -done
   6.400 -
   6.401 -lemma certificate_merSK_valid:
   6.402 -     "[| cert M merSK onlySig (priSK (CA i)) \<in> parts (knows Spy evs);
   6.403 -         CA i \<notin> bad;  CA i \<noteq> RCA;  evs \<in> set_mr|]
   6.404 - ==> \<exists>X Y Z. Says (CA i) M
   6.405 -                  {|X, cert M merSK onlySig (priSK (CA i)), Y, Z|} \<in> set evs"
   6.406 -by auto
   6.407 -
   6.408 -lemma certificate_merEK_valid_lemma [intro]:
   6.409 -     "[|Crypt (priSK (CA i)) {|Agent M, Key merEK, onlyEnc|}
   6.410 -          \<in> parts (knows Spy evs);
   6.411 -        CA i \<notin> bad;  CA i \<noteq> RCA;  evs \<in> set_mr|]
   6.412 - ==> \<exists>X Y Z. Says (CA i) M
   6.413 -                  {|X, Y, cert M merEK onlyEnc (priSK (CA i)), Z|} \<in> set evs"
   6.414 -apply (erule rev_mp)
   6.415 -apply (erule set_mr.induct)
   6.416 -apply (simp_all (no_asm_simp))
   6.417 -apply auto
   6.418 -done
   6.419 -
   6.420 -lemma certificate_merEK_valid:
   6.421 -     "[| cert M merEK onlyEnc (priSK (CA i)) \<in> parts (knows Spy evs);
   6.422 -         CA i \<notin> bad;  CA i \<noteq> RCA;  evs \<in> set_mr|]
   6.423 - ==> \<exists>X Y Z. Says (CA i) M
   6.424 -                  {|X, Y, cert M merEK onlyEnc (priSK (CA i)), Z|} \<in> set evs"
   6.425 -by auto
   6.426 -
   6.427 -text{*The two certificates - for merSK and for merEK - cannot be proved to
   6.428 -  have originated together*}
   6.429 -
   6.430 -end
     7.1 --- a/src/HOL/SET-Protocol/MessageSET.thy	Tue Oct 20 19:52:04 2009 +0200
     7.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.3 @@ -1,957 +0,0 @@
     7.4 -(*  Title:      HOL/SET-Protocol/MessageSET.thy
     7.5 -    Author:     Giampaolo Bella
     7.6 -    Author:     Fabio Massacci
     7.7 -    Author:     Lawrence C Paulson
     7.8 -*)
     7.9 -
    7.10 -header{*The Message Theory, Modified for SET*}
    7.11 -
    7.12 -theory MessageSET
    7.13 -imports Main Nat_Int_Bij
    7.14 -begin
    7.15 -
    7.16 -subsection{*General Lemmas*}
    7.17 -
    7.18 -text{*Needed occasionally with @{text spy_analz_tac}, e.g. in
    7.19 -     @{text analz_insert_Key_newK}*}
    7.20 -
    7.21 -lemma Un_absorb3 [simp] : "A \<union> (B \<union> A) = B \<union> A"
    7.22 -by blast
    7.23 -
    7.24 -text{*Collapses redundant cases in the huge protocol proofs*}
    7.25 -lemmas disj_simps = disj_comms disj_left_absorb disj_assoc 
    7.26 -
    7.27 -text{*Effective with assumptions like @{term "K \<notin> range pubK"} and 
    7.28 -   @{term "K \<notin> invKey`range pubK"}*}
    7.29 -lemma notin_image_iff: "(y \<notin> f`I) = (\<forall>i\<in>I. f i \<noteq> y)"
    7.30 -by blast
    7.31 -
    7.32 -text{*Effective with the assumption @{term "KK \<subseteq> - (range(invKey o pubK))"} *}
    7.33 -lemma disjoint_image_iff: "(A <= - (f`I)) = (\<forall>i\<in>I. f i \<notin> A)"
    7.34 -by blast
    7.35 -
    7.36 -
    7.37 -
    7.38 -types
    7.39 -  key = nat
    7.40 -
    7.41 -consts
    7.42 -  all_symmetric :: bool        --{*true if all keys are symmetric*}
    7.43 -  invKey        :: "key=>key"  --{*inverse of a symmetric key*}
    7.44 -
    7.45 -specification (invKey)
    7.46 -  invKey [simp]: "invKey (invKey K) = K"
    7.47 -  invKey_symmetric: "all_symmetric --> invKey = id"
    7.48 -    by (rule exI [of _ id], auto)
    7.49 -
    7.50 -
    7.51 -text{*The inverse of a symmetric key is itself; that of a public key
    7.52 -      is the private key and vice versa*}
    7.53 -
    7.54 -constdefs
    7.55 -  symKeys :: "key set"
    7.56 -  "symKeys == {K. invKey K = K}"
    7.57 -
    7.58 -text{*Agents. We allow any number of certification authorities, cardholders
    7.59 -            merchants, and payment gateways.*}
    7.60 -datatype
    7.61 -  agent = CA nat | Cardholder nat | Merchant nat | PG nat | Spy
    7.62 -
    7.63 -text{*Messages*}
    7.64 -datatype
    7.65 -     msg = Agent  agent     --{*Agent names*}
    7.66 -         | Number nat       --{*Ordinary integers, timestamps, ...*}
    7.67 -         | Nonce  nat       --{*Unguessable nonces*}
    7.68 -         | Pan    nat       --{*Unguessable Primary Account Numbers (??)*}
    7.69 -         | Key    key       --{*Crypto keys*}
    7.70 -         | Hash   msg       --{*Hashing*}
    7.71 -         | MPair  msg msg   --{*Compound messages*}
    7.72 -         | Crypt  key msg   --{*Encryption, public- or shared-key*}
    7.73 -
    7.74 -
    7.75 -(*Concrete syntax: messages appear as {|A,B,NA|}, etc...*)
    7.76 -syntax
    7.77 -  "@MTuple"      :: "['a, args] => 'a * 'b"       ("(2{|_,/ _|})")
    7.78 -
    7.79 -syntax (xsymbols)
    7.80 -  "@MTuple"      :: "['a, args] => 'a * 'b"       ("(2\<lbrace>_,/ _\<rbrace>)")
    7.81 -
    7.82 -translations
    7.83 -  "{|x, y, z|}"   == "{|x, {|y, z|}|}"
    7.84 -  "{|x, y|}"      == "MPair x y"
    7.85 -
    7.86 -
    7.87 -constdefs
    7.88 -  nat_of_agent :: "agent => nat"
    7.89 -   "nat_of_agent == agent_case (curry nat2_to_nat 0)
    7.90 -                               (curry nat2_to_nat 1)
    7.91 -                               (curry nat2_to_nat 2)
    7.92 -                               (curry nat2_to_nat 3)
    7.93 -                               (nat2_to_nat (4,0))"
    7.94 -    --{*maps each agent to a unique natural number, for specifications*}
    7.95 -
    7.96 -text{*The function is indeed injective*}
    7.97 -lemma inj_nat_of_agent: "inj nat_of_agent"
    7.98 -by (simp add: nat_of_agent_def inj_on_def curry_def
    7.99 -              nat2_to_nat_inj [THEN inj_eq]  split: agent.split) 
   7.100 -
   7.101 -
   7.102 -constdefs
   7.103 -  (*Keys useful to decrypt elements of a message set*)
   7.104 -  keysFor :: "msg set => key set"
   7.105 -  "keysFor H == invKey ` {K. \<exists>X. Crypt K X \<in> H}"
   7.106 -
   7.107 -subsubsection{*Inductive definition of all "parts" of a message.*}
   7.108 -
   7.109 -inductive_set
   7.110 -  parts :: "msg set => msg set"
   7.111 -  for H :: "msg set"
   7.112 -  where
   7.113 -    Inj [intro]:               "X \<in> H ==> X \<in> parts H"
   7.114 -  | Fst:         "{|X,Y|}   \<in> parts H ==> X \<in> parts H"
   7.115 -  | Snd:         "{|X,Y|}   \<in> parts H ==> Y \<in> parts H"
   7.116 -  | Body:        "Crypt K X \<in> parts H ==> X \<in> parts H"
   7.117 -
   7.118 -
   7.119 -(*Monotonicity*)
   7.120 -lemma parts_mono: "G<=H ==> parts(G) <= parts(H)"
   7.121 -apply auto
   7.122 -apply (erule parts.induct)
   7.123 -apply (auto dest: Fst Snd Body)
   7.124 -done
   7.125 -
   7.126 -
   7.127 -subsubsection{*Inverse of keys*}
   7.128 -
   7.129 -(*Equations hold because constructors are injective; cannot prove for all f*)
   7.130 -lemma Key_image_eq [simp]: "(Key x \<in> Key`A) = (x\<in>A)"
   7.131 -by auto
   7.132 -
   7.133 -lemma Nonce_Key_image_eq [simp]: "(Nonce x \<notin> Key`A)"
   7.134 -by auto
   7.135 -
   7.136 -lemma Cardholder_image_eq [simp]: "(Cardholder x \<in> Cardholder`A) = (x \<in> A)"
   7.137 -by auto
   7.138 -
   7.139 -lemma CA_image_eq [simp]: "(CA x \<in> CA`A) = (x \<in> A)"
   7.140 -by auto
   7.141 -
   7.142 -lemma Pan_image_eq [simp]: "(Pan x \<in> Pan`A) = (x \<in> A)"
   7.143 -by auto
   7.144 -
   7.145 -lemma Pan_Key_image_eq [simp]: "(Pan x \<notin> Key`A)"
   7.146 -by auto
   7.147 -
   7.148 -lemma Nonce_Pan_image_eq [simp]: "(Nonce x \<notin> Pan`A)"
   7.149 -by auto
   7.150 -
   7.151 -lemma invKey_eq [simp]: "(invKey K = invKey K') = (K=K')"
   7.152 -apply safe
   7.153 -apply (drule_tac f = invKey in arg_cong, simp)
   7.154 -done
   7.155 -
   7.156 -
   7.157 -subsection{*keysFor operator*}
   7.158 -
   7.159 -lemma keysFor_empty [simp]: "keysFor {} = {}"
   7.160 -by (unfold keysFor_def, blast)
   7.161 -
   7.162 -lemma keysFor_Un [simp]: "keysFor (H \<union> H') = keysFor H \<union> keysFor H'"
   7.163 -by (unfold keysFor_def, blast)
   7.164 -
   7.165 -lemma keysFor_UN [simp]: "keysFor (\<Union>i\<in>A. H i) = (\<Union>i\<in>A. keysFor (H i))"
   7.166 -by (unfold keysFor_def, blast)
   7.167 -
   7.168 -(*Monotonicity*)
   7.169 -lemma keysFor_mono: "G\<subseteq>H ==> keysFor(G) \<subseteq> keysFor(H)"
   7.170 -by (unfold keysFor_def, blast)
   7.171 -
   7.172 -lemma keysFor_insert_Agent [simp]: "keysFor (insert (Agent A) H) = keysFor H"
   7.173 -by (unfold keysFor_def, auto)
   7.174 -
   7.175 -lemma keysFor_insert_Nonce [simp]: "keysFor (insert (Nonce N) H) = keysFor H"
   7.176 -by (unfold keysFor_def, auto)
   7.177 -
   7.178 -lemma keysFor_insert_Number [simp]: "keysFor (insert (Number N) H) = keysFor H"
   7.179 -by (unfold keysFor_def, auto)
   7.180 -
   7.181 -lemma keysFor_insert_Key [simp]: "keysFor (insert (Key K) H) = keysFor H"
   7.182 -by (unfold keysFor_def, auto)
   7.183 -
   7.184 -lemma keysFor_insert_Pan [simp]: "keysFor (insert (Pan A) H) = keysFor H"
   7.185 -by (unfold keysFor_def, auto)
   7.186 -
   7.187 -lemma keysFor_insert_Hash [simp]: "keysFor (insert (Hash X) H) = keysFor H"
   7.188 -by (unfold keysFor_def, auto)
   7.189 -
   7.190 -lemma keysFor_insert_MPair [simp]: "keysFor (insert {|X,Y|} H) = keysFor H"
   7.191 -by (unfold keysFor_def, auto)
   7.192 -
   7.193 -lemma keysFor_insert_Crypt [simp]:
   7.194 -    "keysFor (insert (Crypt K X) H) = insert (invKey K) (keysFor H)"
   7.195 -by (unfold keysFor_def, auto)
   7.196 -
   7.197 -lemma keysFor_image_Key [simp]: "keysFor (Key`E) = {}"
   7.198 -by (unfold keysFor_def, auto)
   7.199 -
   7.200 -lemma Crypt_imp_invKey_keysFor: "Crypt K X \<in> H ==> invKey K \<in> keysFor H"
   7.201 -by (unfold keysFor_def, blast)
   7.202 -
   7.203 -
   7.204 -subsection{*Inductive relation "parts"*}
   7.205 -
   7.206 -lemma MPair_parts:
   7.207 -     "[| {|X,Y|} \<in> parts H;
   7.208 -         [| X \<in> parts H; Y \<in> parts H |] ==> P |] ==> P"
   7.209 -by (blast dest: parts.Fst parts.Snd)
   7.210 -
   7.211 -declare MPair_parts [elim!]  parts.Body [dest!]
   7.212 -text{*NB These two rules are UNSAFE in the formal sense, as they discard the
   7.213 -     compound message.  They work well on THIS FILE.
   7.214 -  @{text MPair_parts} is left as SAFE because it speeds up proofs.
   7.215 -  The Crypt rule is normally kept UNSAFE to avoid breaking up certificates.*}
   7.216 -
   7.217 -lemma parts_increasing: "H \<subseteq> parts(H)"
   7.218 -by blast
   7.219 -
   7.220 -lemmas parts_insertI = subset_insertI [THEN parts_mono, THEN subsetD, standard]
   7.221 -
   7.222 -lemma parts_empty [simp]: "parts{} = {}"
   7.223 -apply safe
   7.224 -apply (erule parts.induct, blast+)
   7.225 -done
   7.226 -
   7.227 -lemma parts_emptyE [elim!]: "X\<in> parts{} ==> P"
   7.228 -by simp
   7.229 -
   7.230 -(*WARNING: loops if H = {Y}, therefore must not be repeated!*)
   7.231 -lemma parts_singleton: "X\<in> parts H ==> \<exists>Y\<in>H. X\<in> parts {Y}"
   7.232 -by (erule parts.induct, fast+)
   7.233 -
   7.234 -
   7.235 -subsubsection{*Unions*}
   7.236 -
   7.237 -lemma parts_Un_subset1: "parts(G) \<union> parts(H) \<subseteq> parts(G \<union> H)"
   7.238 -by (intro Un_least parts_mono Un_upper1 Un_upper2)
   7.239 -
   7.240 -lemma parts_Un_subset2: "parts(G \<union> H) \<subseteq> parts(G) \<union> parts(H)"
   7.241 -apply (rule subsetI)
   7.242 -apply (erule parts.induct, blast+)
   7.243 -done
   7.244 -
   7.245 -lemma parts_Un [simp]: "parts(G \<union> H) = parts(G) \<union> parts(H)"
   7.246 -by (intro equalityI parts_Un_subset1 parts_Un_subset2)
   7.247 -
   7.248 -lemma parts_insert: "parts (insert X H) = parts {X} \<union> parts H"
   7.249 -apply (subst insert_is_Un [of _ H])
   7.250 -apply (simp only: parts_Un)
   7.251 -done
   7.252 -
   7.253 -(*TWO inserts to avoid looping.  This rewrite is better than nothing.
   7.254 -  Not suitable for Addsimps: its behaviour can be strange.*)
   7.255 -lemma parts_insert2:
   7.256 -     "parts (insert X (insert Y H)) = parts {X} \<union> parts {Y} \<union> parts H"
   7.257 -apply (simp add: Un_assoc)
   7.258 -apply (simp add: parts_insert [symmetric])
   7.259 -done
   7.260 -
   7.261 -lemma parts_UN_subset1: "(\<Union>x\<in>A. parts(H x)) \<subseteq> parts(\<Union>x\<in>A. H x)"
   7.262 -by (intro UN_least parts_mono UN_upper)
   7.263 -
   7.264 -lemma parts_UN_subset2: "parts(\<Union>x\<in>A. H x) \<subseteq> (\<Union>x\<in>A. parts(H x))"
   7.265 -apply (rule subsetI)
   7.266 -apply (erule parts.induct, blast+)
   7.267 -done
   7.268 -
   7.269 -lemma parts_UN [simp]: "parts(\<Union>x\<in>A. H x) = (\<Union>x\<in>A. parts(H x))"
   7.270 -by (intro equalityI parts_UN_subset1 parts_UN_subset2)
   7.271 -
   7.272 -(*Added to simplify arguments to parts, analz and synth.
   7.273 -  NOTE: the UN versions are no longer used!*)
   7.274 -
   7.275 -
   7.276 -text{*This allows @{text blast} to simplify occurrences of
   7.277 -  @{term "parts(G\<union>H)"} in the assumption.*}
   7.278 -declare parts_Un [THEN equalityD1, THEN subsetD, THEN UnE, elim!]
   7.279 -
   7.280 -
   7.281 -lemma parts_insert_subset: "insert X (parts H) \<subseteq> parts(insert X H)"
   7.282 -by (blast intro: parts_mono [THEN [2] rev_subsetD])
   7.283 -
   7.284 -subsubsection{*Idempotence and transitivity*}
   7.285 -
   7.286 -lemma parts_partsD [dest!]: "X\<in> parts (parts H) ==> X\<in> parts H"
   7.287 -by (erule parts.induct, blast+)
   7.288 -
   7.289 -lemma parts_idem [simp]: "parts (parts H) = parts H"
   7.290 -by blast
   7.291 -
   7.292 -lemma parts_trans: "[| X\<in> parts G;  G \<subseteq> parts H |] ==> X\<in> parts H"
   7.293 -by (drule parts_mono, blast)
   7.294 -
   7.295 -(*Cut*)
   7.296 -lemma parts_cut:
   7.297 -     "[| Y\<in> parts (insert X G);  X\<in> parts H |] ==> Y\<in> parts (G \<union> H)"
   7.298 -by (erule parts_trans, auto)
   7.299 -
   7.300 -lemma parts_cut_eq [simp]: "X\<in> parts H ==> parts (insert X H) = parts H"
   7.301 -by (force dest!: parts_cut intro: parts_insertI)
   7.302 -
   7.303 -
   7.304 -subsubsection{*Rewrite rules for pulling out atomic messages*}
   7.305 -
   7.306 -lemmas parts_insert_eq_I = equalityI [OF subsetI parts_insert_subset]
   7.307 -
   7.308 -
   7.309 -lemma parts_insert_Agent [simp]:
   7.310 -     "parts (insert (Agent agt) H) = insert (Agent agt) (parts H)"
   7.311 -apply (rule parts_insert_eq_I)
   7.312 -apply (erule parts.induct, auto)
   7.313 -done
   7.314 -
   7.315 -lemma parts_insert_Nonce [simp]:
   7.316 -     "parts (insert (Nonce N) H) = insert (Nonce N) (parts H)"
   7.317 -apply (rule parts_insert_eq_I)
   7.318 -apply (erule parts.induct, auto)
   7.319 -done
   7.320 -
   7.321 -lemma parts_insert_Number [simp]:
   7.322 -     "parts (insert (Number N) H) = insert (Number N) (parts H)"
   7.323 -apply (rule parts_insert_eq_I)
   7.324 -apply (erule parts.induct, auto)
   7.325 -done
   7.326 -
   7.327 -lemma parts_insert_Key [simp]:
   7.328 -     "parts (insert (Key K) H) = insert (Key K) (parts H)"
   7.329 -apply (rule parts_insert_eq_I)
   7.330 -apply (erule parts.induct, auto)
   7.331 -done
   7.332 -
   7.333 -lemma parts_insert_Pan [simp]:
   7.334 -     "parts (insert (Pan A) H) = insert (Pan A) (parts H)"
   7.335 -apply (rule parts_insert_eq_I)
   7.336 -apply (erule parts.induct, auto)
   7.337 -done
   7.338 -
   7.339 -lemma parts_insert_Hash [simp]:
   7.340 -     "parts (insert (Hash X) H) = insert (Hash X) (parts H)"
   7.341 -apply (rule parts_insert_eq_I)
   7.342 -apply (erule parts.induct, auto)
   7.343 -done
   7.344 -
   7.345 -lemma parts_insert_Crypt [simp]:
   7.346 -     "parts (insert (Crypt K X) H) =
   7.347 -          insert (Crypt K X) (parts (insert X H))"
   7.348 -apply (rule equalityI)
   7.349 -apply (rule subsetI)
   7.350 -apply (erule parts.induct, auto)
   7.351 -apply (erule parts.induct)
   7.352 -apply (blast intro: parts.Body)+
   7.353 -done
   7.354 -
   7.355 -lemma parts_insert_MPair [simp]:
   7.356 -     "parts (insert {|X,Y|} H) =
   7.357 -          insert {|X,Y|} (parts (insert X (insert Y H)))"
   7.358 -apply (rule equalityI)
   7.359 -apply (rule subsetI)
   7.360 -apply (erule parts.induct, auto)
   7.361 -apply (erule parts.induct)
   7.362 -apply (blast intro: parts.Fst parts.Snd)+
   7.363 -done
   7.364 -
   7.365 -lemma parts_image_Key [simp]: "parts (Key`N) = Key`N"
   7.366 -apply auto
   7.367 -apply (erule parts.induct, auto)
   7.368 -done
   7.369 -
   7.370 -lemma parts_image_Pan [simp]: "parts (Pan`A) = Pan`A"
   7.371 -apply auto
   7.372 -apply (erule parts.induct, auto)
   7.373 -done
   7.374 -
   7.375 -
   7.376 -(*In any message, there is an upper bound N on its greatest nonce.*)
   7.377 -lemma msg_Nonce_supply: "\<exists>N. \<forall>n. N\<le>n --> Nonce n \<notin> parts {msg}"
   7.378 -apply (induct_tac "msg")
   7.379 -apply (simp_all (no_asm_simp) add: exI parts_insert2)
   7.380 -(*MPair case: blast_tac works out the necessary sum itself!*)
   7.381 -prefer 2 apply (blast elim!: add_leE)
   7.382 -(*Nonce case*)
   7.383 -apply (rule_tac x = "N + Suc nat" in exI)
   7.384 -apply (auto elim!: add_leE)
   7.385 -done
   7.386 -
   7.387 -(* Ditto, for numbers.*)
   7.388 -lemma msg_Number_supply: "\<exists>N. \<forall>n. N<=n --> Number n \<notin> parts {msg}"
   7.389 -apply (induct_tac "msg")
   7.390 -apply (simp_all (no_asm_simp) add: exI parts_insert2)
   7.391 -prefer 2 apply (blast elim!: add_leE)
   7.392 -apply (rule_tac x = "N + Suc nat" in exI, auto)
   7.393 -done
   7.394 -
   7.395 -subsection{*Inductive relation "analz"*}
   7.396 -
   7.397 -text{*Inductive definition of "analz" -- what can be broken down from a set of
   7.398 -    messages, including keys.  A form of downward closure.  Pairs can
   7.399 -    be taken apart; messages decrypted with known keys.*}
   7.400 -
   7.401 -inductive_set
   7.402 -  analz :: "msg set => msg set"
   7.403 -  for H :: "msg set"
   7.404 -  where
   7.405 -    Inj [intro,simp] :    "X \<in> H ==> X \<in> analz H"
   7.406 -  | Fst:     "{|X,Y|} \<in> analz H ==> X \<in> analz H"
   7.407 -  | Snd:     "{|X,Y|} \<in> analz H ==> Y \<in> analz H"
   7.408 -  | Decrypt [dest]:
   7.409 -             "[|Crypt K X \<in> analz H; Key(invKey K): analz H|] ==> X \<in> analz H"
   7.410 -
   7.411 -
   7.412 -(*Monotonicity; Lemma 1 of Lowe's paper*)
   7.413 -lemma analz_mono: "G<=H ==> analz(G) <= analz(H)"
   7.414 -apply auto
   7.415 -apply (erule analz.induct)
   7.416 -apply (auto dest: Fst Snd)
   7.417 -done
   7.418 -
   7.419 -text{*Making it safe speeds up proofs*}
   7.420 -lemma MPair_analz [elim!]:
   7.421 -     "[| {|X,Y|} \<in> analz H;
   7.422 -             [| X \<in> analz H; Y \<in> analz H |] ==> P
   7.423 -          |] ==> P"
   7.424 -by (blast dest: analz.Fst analz.Snd)
   7.425 -
   7.426 -lemma analz_increasing: "H \<subseteq> analz(H)"
   7.427 -by blast
   7.428 -
   7.429 -lemma analz_subset_parts: "analz H \<subseteq> parts H"
   7.430 -apply (rule subsetI)
   7.431 -apply (erule analz.induct, blast+)
   7.432 -done
   7.433 -
   7.434 -lemmas analz_into_parts = analz_subset_parts [THEN subsetD, standard]
   7.435 -
   7.436 -lemmas not_parts_not_analz = analz_subset_parts [THEN contra_subsetD, standard]
   7.437 -
   7.438 -
   7.439 -lemma parts_analz [simp]: "parts (analz H) = parts H"
   7.440 -apply (rule equalityI)
   7.441 -apply (rule analz_subset_parts [THEN parts_mono, THEN subset_trans], simp)
   7.442 -apply (blast intro: analz_increasing [THEN parts_mono, THEN subsetD])
   7.443 -done
   7.444 -
   7.445 -lemma analz_parts [simp]: "analz (parts H) = parts H"
   7.446 -apply auto
   7.447 -apply (erule analz.induct, auto)
   7.448 -done
   7.449 -
   7.450 -lemmas analz_insertI = subset_insertI [THEN analz_mono, THEN [2] rev_subsetD, standard]
   7.451 -
   7.452 -subsubsection{*General equational properties*}
   7.453 -
   7.454 -lemma analz_empty [simp]: "analz{} = {}"
   7.455 -apply safe
   7.456 -apply (erule analz.induct, blast+)
   7.457 -done
   7.458 -
   7.459 -(*Converse fails: we can analz more from the union than from the
   7.460 -  separate parts, as a key in one might decrypt a message in the other*)
   7.461 -lemma analz_Un: "analz(G) \<union> analz(H) \<subseteq> analz(G \<union> H)"
   7.462 -by (intro Un_least analz_mono Un_upper1 Un_upper2)
   7.463 -
   7.464 -lemma analz_insert: "insert X (analz H) \<subseteq> analz(insert X H)"
   7.465 -by (blast intro: analz_mono [THEN [2] rev_subsetD])
   7.466 -
   7.467 -subsubsection{*Rewrite rules for pulling out atomic messages*}
   7.468 -
   7.469 -lemmas analz_insert_eq_I = equalityI [OF subsetI analz_insert]
   7.470 -
   7.471 -lemma analz_insert_Agent [simp]:
   7.472 -     "analz (insert (Agent agt) H) = insert (Agent agt) (analz H)"
   7.473 -apply (rule analz_insert_eq_I)
   7.474 -apply (erule analz.induct, auto)
   7.475 -done
   7.476 -
   7.477 -lemma analz_insert_Nonce [simp]:
   7.478 -     "analz (insert (Nonce N) H) = insert (Nonce N) (analz H)"
   7.479 -apply (rule analz_insert_eq_I)
   7.480 -apply (erule analz.induct, auto)
   7.481 -done
   7.482 -
   7.483 -lemma analz_insert_Number [simp]:
   7.484 -     "analz (insert (Number N) H) = insert (Number N) (analz H)"
   7.485 -apply (rule analz_insert_eq_I)
   7.486 -apply (erule analz.induct, auto)
   7.487 -done
   7.488 -
   7.489 -lemma analz_insert_Hash [simp]:
   7.490 -     "analz (insert (Hash X) H) = insert (Hash X) (analz H)"
   7.491 -apply (rule analz_insert_eq_I)
   7.492 -apply (erule analz.induct, auto)
   7.493 -done
   7.494 -
   7.495 -(*Can only pull out Keys if they are not needed to decrypt the rest*)
   7.496 -lemma analz_insert_Key [simp]:
   7.497 -    "K \<notin> keysFor (analz H) ==>
   7.498 -          analz (insert (Key K) H) = insert (Key K) (analz H)"
   7.499 -apply (unfold keysFor_def)
   7.500 -apply (rule analz_insert_eq_I)
   7.501 -apply (erule analz.induct, auto)
   7.502 -done
   7.503 -
   7.504 -lemma analz_insert_MPair [simp]:
   7.505 -     "analz (insert {|X,Y|} H) =
   7.506 -          insert {|X,Y|} (analz (insert X (insert Y H)))"
   7.507 -apply (rule equalityI)
   7.508 -apply (rule subsetI)
   7.509 -apply (erule analz.induct, auto)
   7.510 -apply (erule analz.induct)
   7.511 -apply (blast intro: analz.Fst analz.Snd)+
   7.512 -done
   7.513 -
   7.514 -(*Can pull out enCrypted message if the Key is not known*)
   7.515 -lemma analz_insert_Crypt:
   7.516 -     "Key (invKey K) \<notin> analz H
   7.517 -      ==> analz (insert (Crypt K X) H) = insert (Crypt K X) (analz H)"
   7.518 -apply (rule analz_insert_eq_I)
   7.519 -apply (erule analz.induct, auto)
   7.520 -done
   7.521 -
   7.522 -lemma analz_insert_Pan [simp]:
   7.523 -     "analz (insert (Pan A) H) = insert (Pan A) (analz H)"
   7.524 -apply (rule analz_insert_eq_I)
   7.525 -apply (erule analz.induct, auto)
   7.526 -done
   7.527 -
   7.528 -lemma lemma1: "Key (invKey K) \<in> analz H ==>
   7.529 -               analz (insert (Crypt K X) H) \<subseteq>
   7.530 -               insert (Crypt K X) (analz (insert X H))"
   7.531 -apply (rule subsetI)
   7.532 -apply (erule_tac x = x in analz.induct, auto)
   7.533 -done
   7.534 -
   7.535 -lemma lemma2: "Key (invKey K) \<in> analz H ==>
   7.536 -               insert (Crypt K X) (analz (insert X H)) \<subseteq>
   7.537 -               analz (insert (Crypt K X) H)"
   7.538 -apply auto
   7.539 -apply (erule_tac x = x in analz.induct, auto)
   7.540 -apply (blast intro: analz_insertI analz.Decrypt)
   7.541 -done
   7.542 -
   7.543 -lemma analz_insert_Decrypt:
   7.544 -     "Key (invKey K) \<in> analz H ==>
   7.545 -               analz (insert (Crypt K X) H) =
   7.546 -               insert (Crypt K X) (analz (insert X H))"
   7.547 -by (intro equalityI lemma1 lemma2)
   7.548 -
   7.549 -(*Case analysis: either the message is secure, or it is not!
   7.550 -  Effective, but can cause subgoals to blow up!
   7.551 -  Use with split_if;  apparently split_tac does not cope with patterns
   7.552 -  such as "analz (insert (Crypt K X) H)" *)
   7.553 -lemma analz_Crypt_if [simp]:
   7.554 -     "analz (insert (Crypt K X) H) =
   7.555 -          (if (Key (invKey K) \<in> analz H)
   7.556 -           then insert (Crypt K X) (analz (insert X H))
   7.557 -           else insert (Crypt K X) (analz H))"
   7.558 -by (simp add: analz_insert_Crypt analz_insert_Decrypt)
   7.559 -
   7.560 -
   7.561 -(*This rule supposes "for the sake of argument" that we have the key.*)
   7.562 -lemma analz_insert_Crypt_subset:
   7.563 -     "analz (insert (Crypt K X) H) \<subseteq>
   7.564 -           insert (Crypt K X) (analz (insert X H))"
   7.565 -apply (rule subsetI)
   7.566 -apply (erule analz.induct, auto)
   7.567 -done
   7.568 -
   7.569 -lemma analz_image_Key [simp]: "analz (Key`N) = Key`N"
   7.570 -apply auto
   7.571 -apply (erule analz.induct, auto)
   7.572 -done
   7.573 -
   7.574 -lemma analz_image_Pan [simp]: "analz (Pan`A) = Pan`A"
   7.575 -apply auto
   7.576 -apply (erule analz.induct, auto)
   7.577 -done
   7.578 -
   7.579 -
   7.580 -subsubsection{*Idempotence and transitivity*}
   7.581 -
   7.582 -lemma analz_analzD [dest!]: "X\<in> analz (analz H) ==> X\<in> analz H"
   7.583 -by (erule analz.induct, blast+)
   7.584 -
   7.585 -lemma analz_idem [simp]: "analz (analz H) = analz H"
   7.586 -by blast
   7.587 -
   7.588 -lemma analz_trans: "[| X\<in> analz G;  G \<subseteq> analz H |] ==> X\<in> analz H"
   7.589 -by (drule analz_mono, blast)
   7.590 -
   7.591 -(*Cut; Lemma 2 of Lowe*)
   7.592 -lemma analz_cut: "[| Y\<in> analz (insert X H);  X\<in> analz H |] ==> Y\<in> analz H"
   7.593 -by (erule analz_trans, blast)
   7.594 -
   7.595 -(*Cut can be proved easily by induction on
   7.596 -   "Y: analz (insert X H) ==> X: analz H --> Y: analz H"
   7.597 -*)
   7.598 -
   7.599 -(*This rewrite rule helps in the simplification of messages that involve
   7.600 -  the forwarding of unknown components (X).  Without it, removing occurrences
   7.601 -  of X can be very complicated. *)
   7.602 -lemma analz_insert_eq: "X\<in> analz H ==> analz (insert X H) = analz H"
   7.603 -by (blast intro: analz_cut analz_insertI)
   7.604 -
   7.605 -
   7.606 -text{*A congruence rule for "analz"*}
   7.607 -
   7.608 -lemma analz_subset_cong:
   7.609 -     "[| analz G \<subseteq> analz G'; analz H \<subseteq> analz H'
   7.610 -               |] ==> analz (G \<union> H) \<subseteq> analz (G' \<union> H')"
   7.611 -apply clarify
   7.612 -apply (erule analz.induct)
   7.613 -apply (best intro: analz_mono [THEN subsetD])+
   7.614 -done
   7.615 -
   7.616 -lemma analz_cong:
   7.617 -     "[| analz G = analz G'; analz H = analz H'
   7.618 -               |] ==> analz (G \<union> H) = analz (G' \<union> H')"
   7.619 -by (intro equalityI analz_subset_cong, simp_all)
   7.620 -
   7.621 -lemma analz_insert_cong:
   7.622 -     "analz H = analz H' ==> analz(insert X H) = analz(insert X H')"
   7.623 -by (force simp only: insert_def intro!: analz_cong)
   7.624 -
   7.625 -(*If there are no pairs or encryptions then analz does nothing*)
   7.626 -lemma analz_trivial:
   7.627 -     "[| \<forall>X Y. {|X,Y|} \<notin> H;  \<forall>X K. Crypt K X \<notin> H |] ==> analz H = H"
   7.628 -apply safe
   7.629 -apply (erule analz.induct, blast+)
   7.630 -done
   7.631 -
   7.632 -(*These two are obsolete (with a single Spy) but cost little to prove...*)
   7.633 -lemma analz_UN_analz_lemma:
   7.634 -     "X\<in> analz (\<Union>i\<in>A. analz (H i)) ==> X\<in> analz (\<Union>i\<in>A. H i)"
   7.635 -apply (erule analz.induct)
   7.636 -apply (blast intro: analz_mono [THEN [2] rev_subsetD])+
   7.637 -done
   7.638 -
   7.639 -lemma analz_UN_analz [simp]: "analz (\<Union>i\<in>A. analz (H i)) = analz (\<Union>i\<in>A. H i)"
   7.640 -by (blast intro: analz_UN_analz_lemma analz_mono [THEN [2] rev_subsetD])
   7.641 -
   7.642 -
   7.643 -subsection{*Inductive relation "synth"*}
   7.644 -
   7.645 -text{*Inductive definition of "synth" -- what can be built up from a set of
   7.646 -    messages.  A form of upward closure.  Pairs can be built, messages
   7.647 -    encrypted with known keys.  Agent names are public domain.
   7.648 -    Numbers can be guessed, but Nonces cannot be.*}
   7.649 -
   7.650 -inductive_set
   7.651 -  synth :: "msg set => msg set"
   7.652 -  for H :: "msg set"
   7.653 -  where
   7.654 -    Inj    [intro]:   "X \<in> H ==> X \<in> synth H"
   7.655 -  | Agent  [intro]:   "Agent agt \<in> synth H"
   7.656 -  | Number [intro]:   "Number n  \<in> synth H"
   7.657 -  | Hash   [intro]:   "X \<in> synth H ==> Hash X \<in> synth H"
   7.658 -  | MPair  [intro]:   "[|X \<in> synth H;  Y \<in> synth H|] ==> {|X,Y|} \<in> synth H"
   7.659 -  | Crypt  [intro]:   "[|X \<in> synth H;  Key(K) \<in> H|] ==> Crypt K X \<in> synth H"
   7.660 -
   7.661 -(*Monotonicity*)
   7.662 -lemma synth_mono: "G<=H ==> synth(G) <= synth(H)"
   7.663 -apply auto
   7.664 -apply (erule synth.induct)
   7.665 -apply (auto dest: Fst Snd Body)
   7.666 -done
   7.667 -
   7.668 -(*NO Agent_synth, as any Agent name can be synthesized.  Ditto for Number*)
   7.669 -inductive_cases Nonce_synth [elim!]: "Nonce n \<in> synth H"
   7.670 -inductive_cases Key_synth   [elim!]: "Key K \<in> synth H"
   7.671 -inductive_cases Hash_synth  [elim!]: "Hash X \<in> synth H"
   7.672 -inductive_cases MPair_synth [elim!]: "{|X,Y|} \<in> synth H"
   7.673 -inductive_cases Crypt_synth [elim!]: "Crypt K X \<in> synth H"
   7.674 -inductive_cases Pan_synth   [elim!]: "Pan A \<in> synth H"
   7.675 -
   7.676 -
   7.677 -lemma synth_increasing: "H \<subseteq> synth(H)"
   7.678 -by blast
   7.679 -
   7.680 -subsubsection{*Unions*}
   7.681 -
   7.682 -(*Converse fails: we can synth more from the union than from the
   7.683 -  separate parts, building a compound message using elements of each.*)
   7.684 -lemma synth_Un: "synth(G) \<union> synth(H) \<subseteq> synth(G \<union> H)"
   7.685 -by (intro Un_least synth_mono Un_upper1 Un_upper2)
   7.686 -
   7.687 -lemma synth_insert: "insert X (synth H) \<subseteq> synth(insert X H)"
   7.688 -by (blast intro: synth_mono [THEN [2] rev_subsetD])
   7.689 -
   7.690 -subsubsection{*Idempotence and transitivity*}
   7.691 -
   7.692 -lemma synth_synthD [dest!]: "X\<in> synth (synth H) ==> X\<in> synth H"
   7.693 -by (erule synth.induct, blast+)
   7.694 -
   7.695 -lemma synth_idem: "synth (synth H) = synth H"
   7.696 -by blast
   7.697 -
   7.698 -lemma synth_trans: "[| X\<in> synth G;  G \<subseteq> synth H |] ==> X\<in> synth H"
   7.699 -by (drule synth_mono, blast)
   7.700 -
   7.701 -(*Cut; Lemma 2 of Lowe*)
   7.702 -lemma synth_cut: "[| Y\<in> synth (insert X H);  X\<in> synth H |] ==> Y\<in> synth H"
   7.703 -by (erule synth_trans, blast)
   7.704 -
   7.705 -lemma Agent_synth [simp]: "Agent A \<in> synth H"
   7.706 -by blast
   7.707 -
   7.708 -lemma Number_synth [simp]: "Number n \<in> synth H"
   7.709 -by blast
   7.710 -
   7.711 -lemma Nonce_synth_eq [simp]: "(Nonce N \<in> synth H) = (Nonce N \<in> H)"
   7.712 -by blast
   7.713 -
   7.714 -lemma Key_synth_eq [simp]: "(Key K \<in> synth H) = (Key K \<in> H)"
   7.715 -by blast
   7.716 -
   7.717 -lemma Crypt_synth_eq [simp]: "Key K \<notin> H ==> (Crypt K X \<in> synth H) = (Crypt K X \<in> H)"
   7.718 -by blast
   7.719 -
   7.720 -lemma Pan_synth_eq [simp]: "(Pan A \<in> synth H) = (Pan A \<in> H)"
   7.721 -by blast
   7.722 -
   7.723 -lemma keysFor_synth [simp]:
   7.724 -    "keysFor (synth H) = keysFor H \<union> invKey`{K. Key K \<in> H}"
   7.725 -by (unfold keysFor_def, blast)
   7.726 -
   7.727 -
   7.728 -subsubsection{*Combinations of parts, analz and synth*}
   7.729 -
   7.730 -lemma parts_synth [simp]: "parts (synth H) = parts H \<union> synth H"
   7.731 -apply (rule equalityI)
   7.732 -apply (rule subsetI)
   7.733 -apply (erule parts.induct)
   7.734 -apply (blast intro: synth_increasing [THEN parts_mono, THEN subsetD]
   7.735 -                    parts.Fst parts.Snd parts.Body)+
   7.736 -done
   7.737 -
   7.738 -lemma analz_analz_Un [simp]: "analz (analz G \<union> H) = analz (G \<union> H)"
   7.739 -apply (intro equalityI analz_subset_cong)+
   7.740 -apply simp_all
   7.741 -done
   7.742 -
   7.743 -lemma analz_synth_Un [simp]: "analz (synth G \<union> H) = analz (G \<union> H) \<union> synth G"
   7.744 -apply (rule equalityI)
   7.745 -apply (rule subsetI)
   7.746 -apply (erule analz.induct)
   7.747 -prefer 5 apply (blast intro: analz_mono [THEN [2] rev_subsetD])
   7.748 -apply (blast intro: analz.Fst analz.Snd analz.Decrypt)+
   7.749 -done
   7.750 -
   7.751 -lemma analz_synth [simp]: "analz (synth H) = analz H \<union> synth H"
   7.752 -apply (cut_tac H = "{}" in analz_synth_Un)
   7.753 -apply (simp (no_asm_use))
   7.754 -done
   7.755 -
   7.756 -
   7.757 -subsubsection{*For reasoning about the Fake rule in traces*}
   7.758 -
   7.759 -lemma parts_insert_subset_Un: "X\<in> G ==> parts(insert X H) \<subseteq> parts G \<union> parts H"
   7.760 -by (rule subset_trans [OF parts_mono parts_Un_subset2], blast)
   7.761 -
   7.762 -(*More specifically for Fake.  Very occasionally we could do with a version
   7.763 -  of the form  parts{X} \<subseteq> synth (analz H) \<union> parts H *)
   7.764 -lemma Fake_parts_insert: "X \<in> synth (analz H) ==>
   7.765 -      parts (insert X H) \<subseteq> synth (analz H) \<union> parts H"
   7.766 -apply (drule parts_insert_subset_Un)
   7.767 -apply (simp (no_asm_use))
   7.768 -apply blast
   7.769 -done
   7.770 -
   7.771 -lemma Fake_parts_insert_in_Un:
   7.772 -     "[|Z \<in> parts (insert X H);  X: synth (analz H)|] 
   7.773 -      ==> Z \<in>  synth (analz H) \<union> parts H";
   7.774 -by (blast dest: Fake_parts_insert [THEN subsetD, dest])
   7.775 -
   7.776 -(*H is sometimes (Key ` KK \<union> spies evs), so can't put G=H*)
   7.777 -lemma Fake_analz_insert:
   7.778 -     "X\<in> synth (analz G) ==>
   7.779 -      analz (insert X H) \<subseteq> synth (analz G) \<union> analz (G \<union> H)"
   7.780 -apply (rule subsetI)
   7.781 -apply (subgoal_tac "x \<in> analz (synth (analz G) \<union> H) ")
   7.782 -prefer 2 apply (blast intro: analz_mono [THEN [2] rev_subsetD] analz_mono [THEN synth_mono, THEN [2] rev_subsetD])
   7.783 -apply (simp (no_asm_use))
   7.784 -apply blast
   7.785 -done
   7.786 -
   7.787 -lemma analz_conj_parts [simp]:
   7.788 -     "(X \<in> analz H & X \<in> parts H) = (X \<in> analz H)"
   7.789 -by (blast intro: analz_subset_parts [THEN subsetD])
   7.790 -
   7.791 -lemma analz_disj_parts [simp]:
   7.792 -     "(X \<in> analz H | X \<in> parts H) = (X \<in> parts H)"
   7.793 -by (blast intro: analz_subset_parts [THEN subsetD])
   7.794 -
   7.795 -(*Without this equation, other rules for synth and analz would yield
   7.796 -  redundant cases*)
   7.797 -lemma MPair_synth_analz [iff]:
   7.798 -     "({|X,Y|} \<in> synth (analz H)) =
   7.799 -      (X \<in> synth (analz H) & Y \<in> synth (analz H))"
   7.800 -by blast
   7.801 -
   7.802 -lemma Crypt_synth_analz:
   7.803 -     "[| Key K \<in> analz H;  Key (invKey K) \<in> analz H |]
   7.804 -       ==> (Crypt K X \<in> synth (analz H)) = (X \<in> synth (analz H))"
   7.805 -by blast
   7.806 -
   7.807 -
   7.808 -lemma Hash_synth_analz [simp]:
   7.809 -     "X \<notin> synth (analz H)
   7.810 -      ==> (Hash{|X,Y|} \<in> synth (analz H)) = (Hash{|X,Y|} \<in> analz H)"
   7.811 -by blast
   7.812 -
   7.813 -
   7.814 -(*We do NOT want Crypt... messages broken up in protocols!!*)
   7.815 -declare parts.Body [rule del]
   7.816 -
   7.817 -
   7.818 -text{*Rewrites to push in Key and Crypt messages, so that other messages can
   7.819 -    be pulled out using the @{text analz_insert} rules*}
   7.820 -
   7.821 -lemmas pushKeys [standard] =
   7.822 -  insert_commute [of "Key K" "Agent C"]
   7.823 -  insert_commute [of "Key K" "Nonce N"]
   7.824 -  insert_commute [of "Key K" "Number N"]
   7.825 -  insert_commute [of "Key K" "Pan PAN"]
   7.826 -  insert_commute [of "Key K" "Hash X"]
   7.827 -  insert_commute [of "Key K" "MPair X Y"]
   7.828 -  insert_commute [of "Key K" "Crypt X K'"]
   7.829 -
   7.830 -lemmas pushCrypts [standard] =
   7.831 -  insert_commute [of "Crypt X K" "Agent C"]
   7.832 -  insert_commute [of "Crypt X K" "Nonce N"]
   7.833 -  insert_commute [of "Crypt X K" "Number N"]
   7.834 -  insert_commute [of "Crypt X K" "Pan PAN"]
   7.835 -  insert_commute [of "Crypt X K" "Hash X'"]
   7.836 -  insert_commute [of "Crypt X K" "MPair X' Y"]
   7.837 -
   7.838 -text{*Cannot be added with @{text "[simp]"} -- messages should not always be
   7.839 -  re-ordered.*}
   7.840 -lemmas pushes = pushKeys pushCrypts
   7.841 -
   7.842 -
   7.843 -subsection{*Tactics useful for many protocol proofs*}
   7.844 -(*<*)
   7.845 -ML
   7.846 -{*
   7.847 -structure MessageSET =
   7.848 -struct
   7.849 -
   7.850 -(*Prove base case (subgoal i) and simplify others.  A typical base case
   7.851 -  concerns  Crypt K X \<notin> Key`shrK`bad  and cannot be proved by rewriting
   7.852 -  alone.*)
   7.853 -fun prove_simple_subgoals_tac (cs, ss) i =
   7.854 -    force_tac (cs, ss addsimps [@{thm image_eq_UN}]) i THEN
   7.855 -    ALLGOALS (asm_simp_tac ss)
   7.856 -
   7.857 -(*Analysis of Fake cases.  Also works for messages that forward unknown parts,
   7.858 -  but this application is no longer necessary if analz_insert_eq is used.
   7.859 -  Abstraction over i is ESSENTIAL: it delays the dereferencing of claset
   7.860 -  DEPENDS UPON "X" REFERRING TO THE FRADULENT MESSAGE *)
   7.861 -
   7.862 -fun impOfSubs th = th RSN (2, @{thm rev_subsetD})
   7.863 -
   7.864 -(*Apply rules to break down assumptions of the form
   7.865 -  Y \<in> parts(insert X H)  and  Y \<in> analz(insert X H)
   7.866 -*)
   7.867 -val Fake_insert_tac =
   7.868 -    dresolve_tac [impOfSubs @{thm Fake_analz_insert},
   7.869 -                  impOfSubs @{thm Fake_parts_insert}] THEN'
   7.870 -    eresolve_tac [asm_rl, @{thm synth.Inj}];
   7.871 -
   7.872 -fun Fake_insert_simp_tac ss i =
   7.873 -    REPEAT (Fake_insert_tac i) THEN asm_full_simp_tac ss i;
   7.874 -
   7.875 -fun atomic_spy_analz_tac (cs,ss) = SELECT_GOAL
   7.876 -    (Fake_insert_simp_tac ss 1
   7.877 -     THEN
   7.878 -     IF_UNSOLVED (Blast.depth_tac
   7.879 -                  (cs addIs [@{thm analz_insertI},
   7.880 -                                   impOfSubs @{thm analz_subset_parts}]) 4 1))
   7.881 -
   7.882 -fun spy_analz_tac (cs,ss) i =
   7.883 -  DETERM
   7.884 -   (SELECT_GOAL
   7.885 -     (EVERY
   7.886 -      [  (*push in occurrences of X...*)
   7.887 -       (REPEAT o CHANGED)
   7.888 -           (res_inst_tac (Simplifier.the_context ss)
   7.889 -             [(("x", 1), "X")] (insert_commute RS ssubst) 1),
   7.890 -       (*...allowing further simplifications*)
   7.891 -       simp_tac ss 1,
   7.892 -       REPEAT (FIRSTGOAL (resolve_tac [allI,impI,notI,conjI,iffI])),
   7.893 -       DEPTH_SOLVE (atomic_spy_analz_tac (cs,ss) 1)]) i)
   7.894 -
   7.895 -end
   7.896 -*}
   7.897 -(*>*)
   7.898 -
   7.899 -
   7.900 -(*By default only o_apply is built-in.  But in the presence of eta-expansion
   7.901 -  this means that some terms displayed as (f o g) will be rewritten, and others
   7.902 -  will not!*)
   7.903 -declare o_def [simp]
   7.904 -
   7.905 -
   7.906 -lemma Crypt_notin_image_Key [simp]: "Crypt K X \<notin> Key ` A"
   7.907 -by auto
   7.908 -
   7.909 -lemma Hash_notin_image_Key [simp] :"Hash X \<notin> Key ` A"
   7.910 -by auto
   7.911 -
   7.912 -lemma synth_analz_mono: "G<=H ==> synth (analz(G)) <= synth (analz(H))"
   7.913 -by (simp add: synth_mono analz_mono)
   7.914 -
   7.915 -lemma Fake_analz_eq [simp]:
   7.916 -     "X \<in> synth(analz H) ==> synth (analz (insert X H)) = synth (analz H)"
   7.917 -apply (drule Fake_analz_insert[of _ _ "H"])
   7.918 -apply (simp add: synth_increasing[THEN Un_absorb2])
   7.919 -apply (drule synth_mono)
   7.920 -apply (simp add: synth_idem)
   7.921 -apply (blast intro: synth_analz_mono [THEN [2] rev_subsetD])
   7.922 -done
   7.923 -
   7.924 -text{*Two generalizations of @{text analz_insert_eq}*}
   7.925 -lemma gen_analz_insert_eq [rule_format]:
   7.926 -     "X \<in> analz H ==> ALL G. H \<subseteq> G --> analz (insert X G) = analz G";
   7.927 -by (blast intro: analz_cut analz_insertI analz_mono [THEN [2] rev_subsetD])
   7.928 -
   7.929 -lemma synth_analz_insert_eq [rule_format]:
   7.930 -     "X \<in> synth (analz H)
   7.931 -      ==> ALL G. H \<subseteq> G --> (Key K \<in> analz (insert X G)) = (Key K \<in> analz G)";
   7.932 -apply (erule synth.induct)
   7.933 -apply (simp_all add: gen_analz_insert_eq subset_trans [OF _ subset_insertI])
   7.934 -done
   7.935 -
   7.936 -lemma Fake_parts_sing:
   7.937 -     "X \<in> synth (analz H) ==> parts{X} \<subseteq> synth (analz H) \<union> parts H";
   7.938 -apply (rule subset_trans)
   7.939 - apply (erule_tac [2] Fake_parts_insert)
   7.940 -apply (simp add: parts_mono)
   7.941 -done
   7.942 -
   7.943 -lemmas Fake_parts_sing_imp_Un = Fake_parts_sing [THEN [2] rev_subsetD]
   7.944 -
   7.945 -method_setup spy_analz = {*
   7.946 -    Scan.succeed (fn ctxt =>
   7.947 -        SIMPLE_METHOD' (MessageSET.spy_analz_tac (clasimpset_of ctxt))) *}
   7.948 -    "for proving the Fake case when analz is involved"
   7.949 -
   7.950 -method_setup atomic_spy_analz = {*
   7.951 -    Scan.succeed (fn ctxt =>
   7.952 -        SIMPLE_METHOD' (MessageSET.atomic_spy_analz_tac (clasimpset_of ctxt))) *}
   7.953 -    "for debugging spy_analz"
   7.954 -
   7.955 -method_setup Fake_insert_simp = {*
   7.956 -    Scan.succeed (fn ctxt =>
   7.957 -        SIMPLE_METHOD' (MessageSET.Fake_insert_simp_tac (simpset_of ctxt))) *}
   7.958 -    "for debugging spy_analz"
   7.959 -
   7.960 -end
     8.1 --- a/src/HOL/SET-Protocol/PublicSET.thy	Tue Oct 20 19:52:04 2009 +0200
     8.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.3 @@ -1,532 +0,0 @@
     8.4 -(*  Title:      HOL/SET-Protocol/PublicSET.thy
     8.5 -    Author:     Giampaolo Bella
     8.6 -    Author:     Fabio Massacci
     8.7 -    Author:     Lawrence C Paulson
     8.8 -*)
     8.9 -
    8.10 -header{*The Public-Key Theory, Modified for SET*}
    8.11 -
    8.12 -theory PublicSET imports EventSET begin
    8.13 -
    8.14 -subsection{*Symmetric and Asymmetric Keys*}
    8.15 -
    8.16 -text{*definitions influenced by the wish to assign asymmetric keys 
    8.17 -  - since the beginning - only to RCA and CAs, namely we need a partial 
    8.18 -  function on type Agent*}
    8.19 -
    8.20 -
    8.21 -text{*The SET specs mention two signature keys for CAs - we only have one*}
    8.22 -
    8.23 -consts
    8.24 -  publicKey :: "[bool, agent] => key"
    8.25 -    --{*the boolean is TRUE if a signing key*}
    8.26 -
    8.27 -syntax
    8.28 -  pubEK :: "agent => key"
    8.29 -  pubSK :: "agent => key"
    8.30 -  priEK :: "agent => key"
    8.31 -  priSK :: "agent => key"
    8.32 -
    8.33 -translations
    8.34 -  "pubEK"  == "publicKey False"
    8.35 -  "pubSK"  == "publicKey True"
    8.36 -
    8.37 -  (*BEWARE!! priEK, priSK DON'T WORK with inj, range, image, etc.*)
    8.38 -  "priEK A"  == "invKey (pubEK A)"
    8.39 -  "priSK A"  == "invKey (pubSK A)"
    8.40 -
    8.41 -text{*By freeness of agents, no two agents have the same key. Since
    8.42 - @{term "True\<noteq>False"}, no agent has the same signing and encryption keys.*}
    8.43 -
    8.44 -specification (publicKey)
    8.45 -  injective_publicKey:
    8.46 -    "publicKey b A = publicKey c A' ==> b=c & A=A'"
    8.47 -(*<*)
    8.48 -   apply (rule exI [of _ "%b A. 2 * nat_of_agent A + (if b then 1 else 0)"]) 
    8.49 -   apply (auto simp add: inj_on_def inj_nat_of_agent [THEN inj_eq] split: agent.split) 
    8.50 -   apply (drule_tac f="%x. x mod 2" in arg_cong, simp add: mod_Suc)+
    8.51 -(*or this, but presburger won't abstract out the function applications
    8.52 -   apply presburger+
    8.53 -*)
    8.54 -   done                       
    8.55 -(*>*)
    8.56 -
    8.57 -axioms
    8.58 -  (*No private key equals any public key (essential to ensure that private
    8.59 -    keys are private!) *)
    8.60 -  privateKey_neq_publicKey [iff]:
    8.61 -      "invKey (publicKey b A) \<noteq> publicKey b' A'"
    8.62 -
    8.63 -declare privateKey_neq_publicKey [THEN not_sym, iff]
    8.64 -
    8.65 -  
    8.66 -subsection{*Initial Knowledge*}
    8.67 -
    8.68 -text{*This information is not necessary.  Each protocol distributes any needed
    8.69 -certificates, and anyway our proofs require a formalization of the Spy's 
    8.70 -knowledge only.  However, the initial knowledge is as follows:
    8.71 -   All agents know RCA's public keys;
    8.72 -   RCA and CAs know their own respective keys;
    8.73 -   RCA (has already certified and therefore) knows all CAs public keys; 
    8.74 -   Spy knows all keys of all bad agents.*}
    8.75 -primrec    
    8.76 -(*<*)
    8.77 -  initState_CA:
    8.78 -    "initState (CA i)  =
    8.79 -       (if i=0 then Key ` ({priEK RCA, priSK RCA} Un
    8.80 -                            pubEK ` (range CA) Un pubSK ` (range CA))
    8.81 -        else {Key (priEK (CA i)), Key (priSK (CA i)),
    8.82 -              Key (pubEK (CA i)), Key (pubSK (CA i)),
    8.83 -              Key (pubEK RCA), Key (pubSK RCA)})"
    8.84 -
    8.85 -  initState_Cardholder:
    8.86 -    "initState (Cardholder i)  =    
    8.87 -       {Key (priEK (Cardholder i)), Key (priSK (Cardholder i)),
    8.88 -        Key (pubEK (Cardholder i)), Key (pubSK (Cardholder i)),
    8.89 -        Key (pubEK RCA), Key (pubSK RCA)}"
    8.90 -
    8.91 -  initState_Merchant:
    8.92 -    "initState (Merchant i)  =    
    8.93 -       {Key (priEK (Merchant i)), Key (priSK (Merchant i)),
    8.94 -        Key (pubEK (Merchant i)), Key (pubSK (Merchant i)),
    8.95 -        Key (pubEK RCA), Key (pubSK RCA)}"
    8.96 -
    8.97 -  initState_PG:
    8.98 -    "initState (PG i)  = 
    8.99 -       {Key (priEK (PG i)), Key (priSK (PG i)),
   8.100 -        Key (pubEK (PG i)), Key (pubSK (PG i)),
   8.101 -        Key (pubEK RCA), Key (pubSK RCA)}"
   8.102 -(*>*)
   8.103 -  initState_Spy:
   8.104 -    "initState Spy = Key ` (invKey ` pubEK ` bad Un
   8.105 -                            invKey ` pubSK ` bad Un
   8.106 -                            range pubEK Un range pubSK)"
   8.107 -
   8.108 -
   8.109 -text{*Injective mapping from agents to PANs: an agent can have only one card*}
   8.110 -
   8.111 -consts  pan :: "agent => nat"
   8.112 -
   8.113 -specification (pan)
   8.114 -  inj_pan: "inj pan"
   8.115 -  --{*No two agents have the same PAN*}
   8.116 -(*<*)
   8.117 -   apply (rule exI [of _ "nat_of_agent"]) 
   8.118 -   apply (simp add: inj_on_def inj_nat_of_agent [THEN inj_eq]) 
   8.119 -   done
   8.120 -(*>*)
   8.121 -
   8.122 -declare inj_pan [THEN inj_eq, iff]
   8.123 -
   8.124 -consts
   8.125 -  XOR :: "nat*nat => nat"  --{*no properties are assumed of exclusive-or*}
   8.126 -
   8.127 -
   8.128 -subsection{*Signature Primitives*}
   8.129 -
   8.130 -constdefs 
   8.131 -
   8.132 - (* Signature = Message + signed Digest *)
   8.133 -  sign :: "[key, msg]=>msg"
   8.134 -    "sign K X == {|X, Crypt K (Hash X) |}"
   8.135 -
   8.136 - (* Signature Only = signed Digest Only *)
   8.137 -  signOnly :: "[key, msg]=>msg"
   8.138 -    "signOnly K X == Crypt K (Hash X)"
   8.139 -
   8.140 - (* Signature for Certificates = Message + signed Message *)
   8.141 -  signCert :: "[key, msg]=>msg"
   8.142 -    "signCert K X == {|X, Crypt K X |}"
   8.143 -
   8.144 - (* Certification Authority's Certificate.
   8.145 -    Contains agent name, a key, a number specifying the key's target use,
   8.146 -              a key to sign the entire certificate.
   8.147 -
   8.148 -    Should prove if signK=priSK RCA and C=CA i,
   8.149 -                  then Ka=pubEK i or pubSK i depending on T  ??
   8.150 - *)
   8.151 -  cert :: "[agent, key, msg, key] => msg"
   8.152 -    "cert A Ka T signK == signCert signK {|Agent A, Key Ka, T|}"
   8.153 -
   8.154 -
   8.155 - (* Cardholder's Certificate.
   8.156 -    Contains a PAN, the certified key Ka, the PANSecret PS,
   8.157 -    a number specifying the target use for Ka, the signing key signK.
   8.158 - *)
   8.159 -  certC :: "[nat, key, nat, msg, key] => msg"
   8.160 -    "certC PAN Ka PS T signK ==
   8.161 -     signCert signK {|Hash {|Nonce PS, Pan PAN|}, Key Ka, T|}"
   8.162 -
   8.163 -  (*cert and certA have no repeated elements, so they could be translations,
   8.164 -    but that's tricky and makes proofs slower*)
   8.165 -
   8.166 -syntax
   8.167 -  "onlyEnc" :: msg      
   8.168 -  "onlySig" :: msg
   8.169 -  "authCode" :: msg
   8.170 -
   8.171 -translations
   8.172 -  "onlyEnc"   == "Number 0"
   8.173 -  "onlySig"  == "Number (Suc 0)"
   8.174 -  "authCode" == "Number (Suc (Suc 0))"
   8.175 -
   8.176 -subsection{*Encryption Primitives*}
   8.177 -
   8.178 -constdefs
   8.179 -
   8.180 -  EXcrypt :: "[key,key,msg,msg] => msg"
   8.181 -  --{*Extra Encryption*}
   8.182 -    (*K: the symmetric key   EK: the public encryption key*)
   8.183 -    "EXcrypt K EK M m ==
   8.184 -       {|Crypt K {|M, Hash m|}, Crypt EK {|Key K, m|}|}"
   8.185 -
   8.186 -  EXHcrypt :: "[key,key,msg,msg] => msg"
   8.187 -  --{*Extra Encryption with Hashing*}
   8.188 -    (*K: the symmetric key   EK: the public encryption key*)
   8.189 -    "EXHcrypt K EK M m ==
   8.190 -       {|Crypt K {|M, Hash m|}, Crypt EK {|Key K, m, Hash M|}|}"
   8.191 -
   8.192 -  Enc :: "[key,key,key,msg] => msg"
   8.193 -  --{*Simple Encapsulation with SIGNATURE*}
   8.194 -    (*SK: the sender's signing key
   8.195 -      K: the symmetric key
   8.196 -      EK: the public encryption key*)
   8.197 -    "Enc SK K EK M ==
   8.198 -       {|Crypt K (sign SK M), Crypt EK (Key K)|}"
   8.199 -
   8.200 -  EncB :: "[key,key,key,msg,msg] => msg"
   8.201 -  --{*Encapsulation with Baggage.  Keys as above, and baggage b.*}
   8.202 -    "EncB SK K EK M b == 
   8.203 -       {|Enc SK K EK {|M, Hash b|}, b|}"
   8.204 -
   8.205 -
   8.206 -subsection{*Basic Properties of pubEK, pubSK, priEK and priSK *}
   8.207 -
   8.208 -lemma publicKey_eq_iff [iff]:
   8.209 -     "(publicKey b A = publicKey b' A') = (b=b' & A=A')"
   8.210 -by (blast dest: injective_publicKey)
   8.211 -
   8.212 -lemma privateKey_eq_iff [iff]:
   8.213 -     "(invKey (publicKey b A) = invKey (publicKey b' A')) = (b=b' & A=A')"
   8.214 -by auto
   8.215 -
   8.216 -lemma not_symKeys_publicKey [iff]: "publicKey b A \<notin> symKeys"
   8.217 -by (simp add: symKeys_def)
   8.218 -
   8.219 -lemma not_symKeys_privateKey [iff]: "invKey (publicKey b A) \<notin> symKeys"
   8.220 -by (simp add: symKeys_def)
   8.221 -
   8.222 -lemma symKeys_invKey_eq [simp]: "K \<in> symKeys ==> invKey K = K"
   8.223 -by (simp add: symKeys_def)
   8.224 -
   8.225 -lemma symKeys_invKey_iff [simp]: "(invKey K \<in> symKeys) = (K \<in> symKeys)"
   8.226 -by (unfold symKeys_def, auto)
   8.227 -
   8.228 -text{*Can be slow (or even loop) as a simprule*}
   8.229 -lemma symKeys_neq_imp_neq: "(K \<in> symKeys) \<noteq> (K' \<in> symKeys) ==> K \<noteq> K'"
   8.230 -by blast
   8.231 -
   8.232 -text{*These alternatives to @{text symKeys_neq_imp_neq} don't seem any better
   8.233 -in practice.*}
   8.234 -lemma publicKey_neq_symKey: "K \<in> symKeys ==> publicKey b A \<noteq> K"
   8.235 -by blast
   8.236 -
   8.237 -lemma symKey_neq_publicKey: "K \<in> symKeys ==> K \<noteq> publicKey b A"
   8.238 -by blast
   8.239 -
   8.240 -lemma privateKey_neq_symKey: "K \<in> symKeys ==> invKey (publicKey b A) \<noteq> K"
   8.241 -by blast
   8.242 -
   8.243 -lemma symKey_neq_privateKey: "K \<in> symKeys ==> K \<noteq> invKey (publicKey b A)"
   8.244 -by blast
   8.245 -
   8.246 -lemma analz_symKeys_Decrypt:
   8.247 -     "[| Crypt K X \<in> analz H;  K \<in> symKeys;  Key K \<in> analz H |]  
   8.248 -      ==> X \<in> analz H"
   8.249 -by auto
   8.250 -
   8.251 -
   8.252 -subsection{*"Image" Equations That Hold for Injective Functions *}
   8.253 -
   8.254 -lemma invKey_image_eq [iff]: "(invKey x \<in> invKey`A) = (x\<in>A)"
   8.255 -by auto
   8.256 -
   8.257 -text{*holds because invKey is injective*}
   8.258 -lemma publicKey_image_eq [iff]:
   8.259 -     "(publicKey b A \<in> publicKey c ` AS) = (b=c & A\<in>AS)"
   8.260 -by auto
   8.261 -
   8.262 -lemma privateKey_image_eq [iff]:
   8.263 -     "(invKey (publicKey b A) \<in> invKey ` publicKey c ` AS) = (b=c & A\<in>AS)"
   8.264 -by auto
   8.265 -
   8.266 -lemma privateKey_notin_image_publicKey [iff]:
   8.267 -     "invKey (publicKey b A) \<notin> publicKey c ` AS"
   8.268 -by auto
   8.269 -
   8.270 -lemma publicKey_notin_image_privateKey [iff]:
   8.271 -     "publicKey b A \<notin> invKey ` publicKey c ` AS"
   8.272 -by auto
   8.273 -
   8.274 -lemma keysFor_parts_initState [simp]: "keysFor (parts (initState C)) = {}"
   8.275 -apply (simp add: keysFor_def)
   8.276 -apply (induct_tac "C")
   8.277 -apply (auto intro: range_eqI)
   8.278 -done
   8.279 -
   8.280 -text{*for proving @{text new_keys_not_used}*}
   8.281 -lemma keysFor_parts_insert:
   8.282 -     "[| K \<in> keysFor (parts (insert X H));  X \<in> synth (analz H) |]  
   8.283 -      ==> K \<in> keysFor (parts H) | Key (invKey K) \<in> parts H"
   8.284 -by (force dest!: 
   8.285 -         parts_insert_subset_Un [THEN keysFor_mono, THEN [2] rev_subsetD]
   8.286 -         analz_subset_parts [THEN keysFor_mono, THEN [2] rev_subsetD] 
   8.287 -            intro: analz_into_parts)
   8.288 -
   8.289 -lemma Crypt_imp_keysFor [intro]:
   8.290 -     "[|K \<in> symKeys; Crypt K X \<in> H|] ==> K \<in> keysFor H"
   8.291 -by (drule Crypt_imp_invKey_keysFor, simp)
   8.292 -
   8.293 -text{*Agents see their own private keys!*}
   8.294 -lemma privateKey_in_initStateCA [iff]:
   8.295 -     "Key (invKey (publicKey b A)) \<in> initState A"
   8.296 -by (case_tac "A", auto)
   8.297 -
   8.298 -text{*Agents see their own public keys!*}
   8.299 -lemma publicKey_in_initStateCA [iff]: "Key (publicKey b A) \<in> initState A"
   8.300 -by (case_tac "A", auto)
   8.301 -
   8.302 -text{*RCA sees CAs' public keys! *}
   8.303 -lemma pubK_CA_in_initState_RCA [iff]:
   8.304 -     "Key (publicKey b (CA i)) \<in> initState RCA"
   8.305 -by auto
   8.306 -
   8.307 -
   8.308 -text{*Spy knows all public keys*}
   8.309 -lemma knows_Spy_pubEK_i [iff]: "Key (publicKey b A) \<in> knows Spy evs"
   8.310 -apply (induct_tac "evs")
   8.311 -apply (simp_all add: imageI knows_Cons split add: event.split)
   8.312 -done
   8.313 -
   8.314 -declare knows_Spy_pubEK_i [THEN analz.Inj, iff]
   8.315 -                            (*needed????*)
   8.316 -
   8.317 -text{*Spy sees private keys of bad agents! [and obviously public keys too]*}
   8.318 -lemma knows_Spy_bad_privateKey [intro!]:
   8.319 -     "A \<in> bad ==> Key (invKey (publicKey b A)) \<in> knows Spy evs"
   8.320 -by (rule initState_subset_knows [THEN subsetD], simp)
   8.321 -
   8.322 -
   8.323 -subsection{*Fresh Nonces for Possibility Theorems*}
   8.324 -
   8.325 -lemma Nonce_notin_initState [iff]: "Nonce N \<notin> parts (initState B)"
   8.326 -by (induct_tac "B", auto)
   8.327 -
   8.328 -lemma Nonce_notin_used_empty [simp]: "Nonce N \<notin> used []"
   8.329 -by (simp add: used_Nil)
   8.330 -
   8.331 -text{*In any trace, there is an upper bound N on the greatest nonce in use.*}
   8.332 -lemma Nonce_supply_lemma: "\<exists>N. \<forall>n. N<=n --> Nonce n \<notin> used evs"
   8.333 -apply (induct_tac "evs")
   8.334 -apply (rule_tac x = 0 in exI)
   8.335 -apply (simp_all add: used_Cons split add: event.split, safe)
   8.336 -apply (rule msg_Nonce_supply [THEN exE], blast elim!: add_leE)+
   8.337 -done
   8.338 -
   8.339 -lemma Nonce_supply1: "\<exists>N. Nonce N \<notin> used evs"
   8.340 -by (rule Nonce_supply_lemma [THEN exE], blast)
   8.341 -
   8.342 -lemma Nonce_supply: "Nonce (@ N. Nonce N \<notin> used evs) \<notin> used evs"
   8.343 -apply (rule Nonce_supply_lemma [THEN exE])
   8.344 -apply (rule someI, fast)
   8.345 -done
   8.346 -
   8.347 -
   8.348 -subsection{*Specialized Methods for Possibility Theorems*}
   8.349 -
   8.350 -ML
   8.351 -{*
   8.352 -structure PublicSET =
   8.353 -struct
   8.354 -
   8.355 -(*Tactic for possibility theorems*)
   8.356 -fun possibility_tac ctxt =
   8.357 -    REPEAT (*omit used_Says so that Nonces start from different traces!*)
   8.358 -    (ALLGOALS (simp_tac (simpset_of ctxt delsimps [@{thm used_Says}, @{thm used_Notes}]))
   8.359 -     THEN
   8.360 -     REPEAT_FIRST (eq_assume_tac ORELSE' 
   8.361 -                   resolve_tac [refl, conjI, @{thm Nonce_supply}]))
   8.362 -
   8.363 -(*For harder protocols (such as SET_CR!), where we have to set up some
   8.364 -  nonces and keys initially*)
   8.365 -fun basic_possibility_tac ctxt =
   8.366 -    REPEAT 
   8.367 -    (ALLGOALS (asm_simp_tac (simpset_of ctxt setSolver safe_solver))
   8.368 -     THEN
   8.369 -     REPEAT_FIRST (resolve_tac [refl, conjI]))
   8.370 -
   8.371 -end
   8.372 -*}
   8.373 -
   8.374 -method_setup possibility = {*
   8.375 -    Scan.succeed (SIMPLE_METHOD o PublicSET.possibility_tac) *}
   8.376 -    "for proving possibility theorems"
   8.377 -
   8.378 -method_setup basic_possibility = {*
   8.379 -    Scan.succeed (SIMPLE_METHOD o PublicSET.basic_possibility_tac) *}
   8.380 -    "for proving possibility theorems"
   8.381 -
   8.382 -
   8.383 -subsection{*Specialized Rewriting for Theorems About @{term analz} and Image*}
   8.384 -
   8.385 -lemma insert_Key_singleton: "insert (Key K) H = Key ` {K} Un H"
   8.386 -by blast
   8.387 -
   8.388 -lemma insert_Key_image:
   8.389 -     "insert (Key K) (Key`KK Un C) = Key ` (insert K KK) Un C"
   8.390 -by blast
   8.391 -
   8.392 -text{*Needed for @{text DK_fresh_not_KeyCryptKey}*}
   8.393 -lemma publicKey_in_used [iff]: "Key (publicKey b A) \<in> used evs"
   8.394 -by auto
   8.395 -
   8.396 -lemma privateKey_in_used [iff]: "Key (invKey (publicKey b A)) \<in> used evs"
   8.397 -by (blast intro!: initState_into_used)
   8.398 -
   8.399 -text{*Reverse the normal simplification of "image" to build up (not break down)
   8.400 -  the set of keys.  Based on @{text analz_image_freshK_ss}, but simpler.*}
   8.401 -lemmas analz_image_keys_simps =
   8.402 -       simp_thms mem_simps --{*these two allow its use with @{text "only:"}*}
   8.403 -       image_insert [THEN sym] image_Un [THEN sym] 
   8.404 -       rangeI symKeys_neq_imp_neq
   8.405 -       insert_Key_singleton insert_Key_image Un_assoc [THEN sym]
   8.406 -
   8.407 -
   8.408 -(*General lemmas proved by Larry*)
   8.409 -
   8.410 -subsection{*Controlled Unfolding of Abbreviations*}
   8.411 -
   8.412 -text{*A set is expanded only if a relation is applied to it*}
   8.413 -lemma def_abbrev_simp_relation:
   8.414 -     "A == B ==> (A \<in> X) = (B \<in> X) &  
   8.415 -                 (u = A) = (u = B) &  
   8.416 -                 (A = u) = (B = u)"
   8.417 -by auto
   8.418 -
   8.419 -text{*A set is expanded only if one of the given functions is applied to it*}
   8.420 -lemma def_abbrev_simp_function:
   8.421 -     "A == B  
   8.422 -      ==> parts (insert A X) = parts (insert B X) &  
   8.423 -          analz (insert A X) = analz (insert B X) &  
   8.424 -          keysFor (insert A X) = keysFor (insert B X)"
   8.425 -by auto
   8.426 -
   8.427 -subsubsection{*Special Simplification Rules for @{term signCert}*}
   8.428 -
   8.429 -text{*Avoids duplicating X and its components!*}
   8.430 -lemma parts_insert_signCert:
   8.431 -     "parts (insert (signCert K X) H) =  
   8.432 -      insert {|X, Crypt K X|} (parts (insert (Crypt K X) H))"
   8.433 -by (simp add: signCert_def insert_commute [of X])
   8.434 -
   8.435 -text{*Avoids a case split! [X is always available]*}
   8.436 -lemma analz_insert_signCert:
   8.437 -     "analz (insert (signCert K X) H) =  
   8.438 -      insert {|X, Crypt K X|} (insert (Crypt K X) (analz (insert X H)))"
   8.439 -by (simp add: signCert_def insert_commute [of X])
   8.440 -
   8.441 -lemma keysFor_insert_signCert: "keysFor (insert (signCert K X) H) = keysFor H"
   8.442 -by (simp add: signCert_def)
   8.443 -
   8.444 -text{*Controlled rewrite rules for @{term signCert}, just the definitions
   8.445 -  of the others. Encryption primitives are just expanded, despite their huge
   8.446 -  redundancy!*}
   8.447 -lemmas abbrev_simps [simp] =
   8.448 -    parts_insert_signCert analz_insert_signCert keysFor_insert_signCert
   8.449 -    sign_def     [THEN def_abbrev_simp_relation]
   8.450 -    sign_def     [THEN def_abbrev_simp_function]
   8.451 -    signCert_def [THEN def_abbrev_simp_relation]
   8.452 -    signCert_def [THEN def_abbrev_simp_function]
   8.453 -    certC_def    [THEN def_abbrev_simp_relation]
   8.454 -    certC_def    [THEN def_abbrev_simp_function]
   8.455 -    cert_def     [THEN def_abbrev_simp_relation]
   8.456 -    cert_def     [THEN def_abbrev_simp_function]
   8.457 -    EXcrypt_def  [THEN def_abbrev_simp_relation]
   8.458 -    EXcrypt_def  [THEN def_abbrev_simp_function]
   8.459 -    EXHcrypt_def [THEN def_abbrev_simp_relation]
   8.460 -    EXHcrypt_def [THEN def_abbrev_simp_function]
   8.461 -    Enc_def      [THEN def_abbrev_simp_relation]
   8.462 -    Enc_def      [THEN def_abbrev_simp_function]
   8.463 -    EncB_def     [THEN def_abbrev_simp_relation]
   8.464 -    EncB_def     [THEN def_abbrev_simp_function]
   8.465 -
   8.466 -
   8.467 -subsubsection{*Elimination Rules for Controlled Rewriting *}
   8.468 -
   8.469 -lemma Enc_partsE: 
   8.470 -     "!!R. [|Enc SK K EK M \<in> parts H;  
   8.471 -             [|Crypt K (sign SK M) \<in> parts H;  
   8.472 -               Crypt EK (Key K) \<in> parts H|] ==> R|]  
   8.473 -           ==> R"
   8.474 -
   8.475 -by (unfold Enc_def, blast)
   8.476 -
   8.477 -lemma EncB_partsE: 
   8.478 -     "!!R. [|EncB SK K EK M b \<in> parts H;  
   8.479 -             [|Crypt K (sign SK {|M, Hash b|}) \<in> parts H;  
   8.480 -               Crypt EK (Key K) \<in> parts H;  
   8.481 -               b \<in> parts H|] ==> R|]  
   8.482 -           ==> R"
   8.483 -by (unfold EncB_def Enc_def, blast)
   8.484 -
   8.485 -lemma EXcrypt_partsE: 
   8.486 -     "!!R. [|EXcrypt K EK M m \<in> parts H;  
   8.487 -             [|Crypt K {|M, Hash m|} \<in> parts H;  
   8.488 -               Crypt EK {|Key K, m|} \<in> parts H|] ==> R|]  
   8.489 -           ==> R"
   8.490 -by (unfold EXcrypt_def, blast)
   8.491 -
   8.492 -
   8.493 -subsection{*Lemmas to Simplify Expressions Involving @{term analz} *}
   8.494 -
   8.495 -lemma analz_knows_absorb:
   8.496 -     "Key K \<in> analz (knows Spy evs)  
   8.497 -      ==> analz (Key ` (insert K H) \<union> knows Spy evs) =  
   8.498 -          analz (Key ` H \<union> knows Spy evs)"
   8.499 -by (simp add: analz_insert_eq Un_upper2 [THEN analz_mono, THEN subsetD])
   8.500 -
   8.501 -lemma analz_knows_absorb2:
   8.502 -     "Key K \<in> analz (knows Spy evs)  
   8.503 -      ==> analz (Key ` (insert X (insert K H)) \<union> knows Spy evs) =  
   8.504 -          analz (Key ` (insert X H) \<union> knows Spy evs)"
   8.505 -apply (subst insert_commute)
   8.506 -apply (erule analz_knows_absorb)
   8.507 -done
   8.508 -
   8.509 -lemma analz_insert_subset_eq:
   8.510 -     "[|X \<in> analz (knows Spy evs);  knows Spy evs \<subseteq> H|]  
   8.511 -      ==> analz (insert X H) = analz H"
   8.512 -apply (rule analz_insert_eq)
   8.513 -apply (blast intro: analz_mono [THEN [2] rev_subsetD])
   8.514 -done
   8.515 -
   8.516 -lemmas analz_insert_simps = 
   8.517 -         analz_insert_subset_eq Un_upper2
   8.518 -         subset_insertI [THEN [2] subset_trans] 
   8.519 -
   8.520 -
   8.521 -subsection{*Freshness Lemmas*}
   8.522 -
   8.523 -lemma in_parts_Says_imp_used:
   8.524 -     "[|Key K \<in> parts {X}; Says A B X \<in> set evs|] ==> Key K \<in> used evs"
   8.525 -by (blast intro: parts_trans dest!: Says_imp_knows_Spy [THEN parts.Inj])
   8.526 -
   8.527 -text{*A useful rewrite rule with @{term analz_image_keys_simps}*}
   8.528 -lemma Crypt_notin_image_Key: "Crypt K X \<notin> Key ` KK"
   8.529 -by auto
   8.530 -
   8.531 -lemma fresh_notin_analz_knows_Spy:
   8.532 -     "Key K \<notin> used evs ==> Key K \<notin> analz (knows Spy evs)"
   8.533 -by (auto dest: analz_into_parts)
   8.534 -
   8.535 -end
     9.1 --- a/src/HOL/SET-Protocol/Purchase.thy	Tue Oct 20 19:52:04 2009 +0200
     9.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.3 @@ -1,1170 +0,0 @@
     9.4 -(*  Title:      HOL/SET-Protocol/Purchase.thy
     9.5 -    Author:     Giampaolo Bella
     9.6 -    Author:     Fabio Massacci
     9.7 -    Author:     Lawrence C Paulson
     9.8 -*)
     9.9 -
    9.10 -header{*Purchase Phase of SET*}
    9.11 -
    9.12 -theory Purchase imports PublicSET begin
    9.13 -
    9.14 -text{*
    9.15 -Note: nonces seem to consist of 20 bytes.  That includes both freshness
    9.16 -challenges (Chall-EE, etc.) and important secrets (CardSecret, PANsecret)
    9.17 -
    9.18 -This version omits @{text LID_C} but retains @{text LID_M}. At first glance
    9.19 -(Programmer's Guide page 267) it seems that both numbers are just introduced
    9.20 -for the respective convenience of the Cardholder's and Merchant's
    9.21 -system. However, omitting both of them would create a problem of
    9.22 -identification: how can the Merchant's system know what transaction is it
    9.23 -supposed to process?
    9.24 -
    9.25 -Further reading (Programmer's guide page 309) suggest that there is an outside
    9.26 -bootstrapping message (SET initiation message) which is used by the Merchant
    9.27 -and the Cardholder to agree on the actual transaction. This bootstrapping
    9.28 -message is described in the SET External Interface Guide and ought to generate
    9.29 -@{text LID_M}. According SET Extern Interface Guide, this number might be a
    9.30 -cookie, an invoice number etc. The Programmer's Guide on page 310, states that
    9.31 -in absence of @{text LID_M} the protocol must somehow ("outside SET") identify
    9.32 -the transaction from OrderDesc, which is assumed to be a searchable text only
    9.33 -field. Thus, it is assumed that the Merchant or the Cardholder somehow agreed
    9.34 -out-of-bad on the value of @{text LID_M} (for instance a cookie in a web
    9.35 -transaction etc.). This out-of-band agreement is expressed with a preliminary
    9.36 -start action in which the merchant and the Cardholder agree on the appropriate
    9.37 -values. Agreed values are stored with a suitable notes action.
    9.38 -
    9.39 -"XID is a transaction ID that is usually generated by the Merchant system,
    9.40 -unless there is no PInitRes, in which case it is generated by the Cardholder
    9.41 -system. It is a randomly generated 20 byte variable that is globally unique
    9.42 -(statistically). Merchant and Cardholder systems shall use appropriate random
    9.43 -number generators to ensure the global uniqueness of XID."
    9.44 ---Programmer's Guide, page 267.
    9.45 -
    9.46 -PI (Payment Instruction) is the most central and sensitive data structure in
    9.47 -SET. It is used to pass the data required to authorize a payment card payment
    9.48 -from the Cardholder to the Payment Gateway, which will use the data to
    9.49 -initiate a payment card transaction through the traditional payment card
    9.50 -financial network. The data is encrypted by the Cardholder and sent via the
    9.51 -Merchant, such that the data is hidden from the Merchant unless the Acquirer
    9.52 -passes the data back to the Merchant.
    9.53 ---Programmer's Guide, page 271.*}
    9.54 -
    9.55 -consts
    9.56 -
    9.57 -    CardSecret :: "nat => nat"
    9.58 -     --{*Maps Cardholders to CardSecrets.
    9.59 -         A CardSecret of 0 means no cerificate, must use unsigned format.*}
    9.60 -
    9.61 -    PANSecret :: "nat => nat"
    9.62 -     --{*Maps Cardholders to PANSecrets.*}
    9.63 -
    9.64 -inductive_set
    9.65 -  set_pur :: "event list set"
    9.66 -where
    9.67 -
    9.68 -  Nil:   --{*Initial trace is empty*}
    9.69 -         "[] \<in> set_pur"
    9.70 -
    9.71 -| Fake:  --{*The spy MAY say anything he CAN say.*}
    9.72 -         "[| evsf \<in> set_pur;  X \<in> synth(analz(knows Spy evsf)) |]
    9.73 -          ==> Says Spy B X  # evsf \<in> set_pur"
    9.74 -
    9.75 -
    9.76 -| Reception: --{*If A sends a message X to B, then B might receive it*}
    9.77 -             "[| evsr \<in> set_pur;  Says A B X \<in> set evsr |]
    9.78 -              ==> Gets B X  # evsr \<in> set_pur"
    9.79 -
    9.80 -| Start: 
    9.81 -      --{*Added start event which is out-of-band for SET: the Cardholder and
    9.82 -          the merchant agree on the amounts and uses @{text LID_M} as an
    9.83 -          identifier.
    9.84 -          This is suggested by the External Interface Guide. The Programmer's
    9.85 -          Guide, in absence of @{text LID_M}, states that the merchant uniquely
    9.86 -          identifies the order out of some data contained in OrderDesc.*}
    9.87 -   "[|evsStart \<in> set_pur;
    9.88 -      Number LID_M \<notin> used evsStart;
    9.89 -      C = Cardholder k; M = Merchant i; P = PG j;
    9.90 -      Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
    9.91 -      LID_M \<notin> range CardSecret;
    9.92 -      LID_M \<notin> range PANSecret |]
    9.93 -     ==> Notes C {|Number LID_M, Transaction|}
    9.94 -       # Notes M {|Number LID_M, Agent P, Transaction|}
    9.95 -       # evsStart \<in> set_pur"
    9.96 -
    9.97 -| PInitReq:
    9.98 -     --{*Purchase initialization, page 72 of Formal Protocol Desc.*}
    9.99 -   "[|evsPIReq \<in> set_pur;
   9.100 -      Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
   9.101 -      Nonce Chall_C \<notin> used evsPIReq;
   9.102 -      Chall_C \<notin> range CardSecret; Chall_C \<notin> range PANSecret;
   9.103 -      Notes C {|Number LID_M, Transaction |} \<in> set evsPIReq |]
   9.104 -    ==> Says C M {|Number LID_M, Nonce Chall_C|} # evsPIReq \<in> set_pur"
   9.105 -
   9.106 -| PInitRes:
   9.107 -     --{*Merchant replies with his own label XID and the encryption
   9.108 -         key certificate of his chosen Payment Gateway. Page 74 of Formal
   9.109 -         Protocol Desc. We use @{text LID_M} to identify Cardholder*}
   9.110 -   "[|evsPIRes \<in> set_pur;
   9.111 -      Gets M {|Number LID_M, Nonce Chall_C|} \<in> set evsPIRes;
   9.112 -      Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
   9.113 -      Notes M {|Number LID_M, Agent P, Transaction|} \<in> set evsPIRes;
   9.114 -      Nonce Chall_M \<notin> used evsPIRes;
   9.115 -      Chall_M \<notin> range CardSecret; Chall_M \<notin> range PANSecret;
   9.116 -      Number XID \<notin> used evsPIRes;
   9.117 -      XID \<notin> range CardSecret; XID \<notin> range PANSecret|]
   9.118 -    ==> Says M C (sign (priSK M)
   9.119 -                       {|Number LID_M, Number XID,
   9.120 -                         Nonce Chall_C, Nonce Chall_M,
   9.121 -                         cert P (pubEK P) onlyEnc (priSK RCA)|})
   9.122 -          # evsPIRes \<in> set_pur"
   9.123 -
   9.124 -| PReqUns:
   9.125 -      --{*UNSIGNED Purchase request (CardSecret = 0).
   9.126 -        Page 79 of Formal Protocol Desc.
   9.127 -        Merchant never sees the amount in clear. This holds of the real
   9.128 -        protocol, where XID identifies the transaction. We omit
   9.129 -        Hash{|Number XID, Nonce (CardSecret k)|} from PIHead because
   9.130 -        the CardSecret is 0 and because AuthReq treated the unsigned case
   9.131 -        very differently from the signed one anyway.*}
   9.132 -   "!!Chall_C Chall_M OrderDesc P PurchAmt XID evsPReqU.
   9.133 -    [|evsPReqU \<in> set_pur;
   9.134 -      C = Cardholder k; CardSecret k = 0;
   9.135 -      Key KC1 \<notin> used evsPReqU;  KC1 \<in> symKeys;
   9.136 -      Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
   9.137 -      HOD = Hash{|Number OrderDesc, Number PurchAmt|};
   9.138 -      OIData = {|Number LID_M, Number XID, Nonce Chall_C, HOD,Nonce Chall_M|};
   9.139 -      PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M|};
   9.140 -      Gets C (sign (priSK M)
   9.141 -                   {|Number LID_M, Number XID,
   9.142 -                     Nonce Chall_C, Nonce Chall_M,
   9.143 -                     cert P EKj onlyEnc (priSK RCA)|})
   9.144 -        \<in> set evsPReqU;
   9.145 -      Says C M {|Number LID_M, Nonce Chall_C|} \<in> set evsPReqU;
   9.146 -      Notes C {|Number LID_M, Transaction|} \<in> set evsPReqU |]
   9.147 -    ==> Says C M
   9.148 -             {|EXHcrypt KC1 EKj {|PIHead, Hash OIData|} (Pan (pan C)),
   9.149 -               OIData, Hash{|PIHead, Pan (pan C)|} |}
   9.150 -          # Notes C {|Key KC1, Agent M|}
   9.151 -          # evsPReqU \<in> set_pur"
   9.152 -
   9.153 -| PReqS:
   9.154 -      --{*SIGNED Purchase request.  Page 77 of Formal Protocol Desc.
   9.155 -          We could specify the equation
   9.156 -          @{term "PIReqSigned = {| PIDualSigned, OIDualSigned |}"}, since the
   9.157 -          Formal Desc. gives PIHead the same format in the unsigned case.
   9.158 -          However, there's little point, as P treats the signed and 
   9.159 -          unsigned cases differently.*}
   9.160 -   "!!C Chall_C Chall_M EKj HOD KC2 LID_M M OIData
   9.161 -      OIDualSigned OrderDesc P PANData PIData PIDualSigned
   9.162 -      PIHead PurchAmt Transaction XID evsPReqS k.
   9.163 -    [|evsPReqS \<in> set_pur;
   9.164 -      C = Cardholder k;
   9.165 -      CardSecret k \<noteq> 0;  Key KC2 \<notin> used evsPReqS;  KC2 \<in> symKeys;
   9.166 -      Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
   9.167 -      HOD = Hash{|Number OrderDesc, Number PurchAmt|};
   9.168 -      OIData = {|Number LID_M, Number XID, Nonce Chall_C, HOD, Nonce Chall_M|};
   9.169 -      PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M,
   9.170 -                  Hash{|Number XID, Nonce (CardSecret k)|}|};
   9.171 -      PANData = {|Pan (pan C), Nonce (PANSecret k)|};
   9.172 -      PIData = {|PIHead, PANData|};
   9.173 -      PIDualSigned = {|sign (priSK C) {|Hash PIData, Hash OIData|},
   9.174 -                       EXcrypt KC2 EKj {|PIHead, Hash OIData|} PANData|};
   9.175 -      OIDualSigned = {|OIData, Hash PIData|};
   9.176 -      Gets C (sign (priSK M)
   9.177 -                   {|Number LID_M, Number XID,
   9.178 -                     Nonce Chall_C, Nonce Chall_M,
   9.179 -                     cert P EKj onlyEnc (priSK RCA)|})
   9.180 -        \<in> set evsPReqS;
   9.181 -      Says C M {|Number LID_M, Nonce Chall_C|} \<in> set evsPReqS;
   9.182 -      Notes C {|Number LID_M, Transaction|} \<in> set evsPReqS |]
   9.183 -    ==> Says C M {|PIDualSigned, OIDualSigned|}
   9.184 -          # Notes C {|Key KC2, Agent M|}
   9.185 -          # evsPReqS \<in> set_pur"
   9.186 -
   9.187 -  --{*Authorization Request.  Page 92 of Formal Protocol Desc.
   9.188 -    Sent in response to Purchase Request.*}
   9.189 -| AuthReq:
   9.190 -   "[| evsAReq \<in> set_pur;
   9.191 -       Key KM \<notin> used evsAReq;  KM \<in> symKeys;
   9.192 -       Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
   9.193 -       HOD = Hash{|Number OrderDesc, Number PurchAmt|};
   9.194 -       OIData = {|Number LID_M, Number XID, Nonce Chall_C, HOD,
   9.195 -                  Nonce Chall_M|};
   9.196 -       CardSecret k \<noteq> 0 -->
   9.197 -         P_I = {|sign (priSK C) {|HPIData, Hash OIData|}, encPANData|};
   9.198 -       Gets M {|P_I, OIData, HPIData|} \<in> set evsAReq;
   9.199 -       Says M C (sign (priSK M) {|Number LID_M, Number XID,
   9.200 -                                  Nonce Chall_C, Nonce Chall_M,
   9.201 -                                  cert P EKj onlyEnc (priSK RCA)|})
   9.202 -         \<in> set evsAReq;
   9.203 -        Notes M {|Number LID_M, Agent P, Transaction|}
   9.204 -           \<in> set evsAReq |]
   9.205 -    ==> Says M P
   9.206 -             (EncB (priSK M) KM (pubEK P)
   9.207 -               {|Number LID_M, Number XID, Hash OIData, HOD|}   P_I)
   9.208 -          # evsAReq \<in> set_pur"
   9.209 -
   9.210 -  --{*Authorization Response has two forms: for UNSIGNED and SIGNED PIs.
   9.211 -    Page 99 of Formal Protocol Desc.
   9.212 -    PI is a keyword (product!), so we call it @{text P_I}. The hashes HOD and
   9.213 -    HOIData occur independently in @{text P_I} and in M's message.
   9.214 -    The authCode in AuthRes represents the baggage of EncB, which in the
   9.215 -    full protocol is [CapToken], [AcqCardMsg], [AuthToken]:
   9.216 -    optional items for split shipments, recurring payments, etc.*}
   9.217 -
   9.218 -| AuthResUns:
   9.219 -    --{*Authorization Response, UNSIGNED*}
   9.220 -   "[| evsAResU \<in> set_pur;
   9.221 -       C = Cardholder k; M = Merchant i;
   9.222 -       Key KP \<notin> used evsAResU;  KP \<in> symKeys;
   9.223 -       CardSecret k = 0;  KC1 \<in> symKeys;  KM \<in> symKeys;
   9.224 -       PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M|};
   9.225 -       P_I = EXHcrypt KC1 EKj {|PIHead, HOIData|} (Pan (pan C));
   9.226 -       Gets P (EncB (priSK M) KM (pubEK P)
   9.227 -               {|Number LID_M, Number XID, HOIData, HOD|} P_I)
   9.228 -           \<in> set evsAResU |]
   9.229 -   ==> Says P M
   9.230 -            (EncB (priSK P) KP (pubEK M)
   9.231 -              {|Number LID_M, Number XID, Number PurchAmt|}
   9.232 -              authCode)
   9.233 -       # evsAResU \<in> set_pur"
   9.234 -
   9.235 -| AuthResS:
   9.236 -    --{*Authorization Response, SIGNED*}
   9.237 -   "[| evsAResS \<in> set_pur;
   9.238 -       C = Cardholder k;
   9.239 -       Key KP \<notin> used evsAResS;  KP \<in> symKeys;
   9.240 -       CardSecret k \<noteq> 0;  KC2 \<in> symKeys;  KM \<in> symKeys;
   9.241 -       P_I = {|sign (priSK C) {|Hash PIData, HOIData|},
   9.242 -               EXcrypt KC2 (pubEK P) {|PIHead, HOIData|} PANData|};
   9.243 -       PANData = {|Pan (pan C), Nonce (PANSecret k)|};
   9.244 -       PIData = {|PIHead, PANData|};
   9.245 -       PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M,
   9.246 -                  Hash{|Number XID, Nonce (CardSecret k)|}|};
   9.247 -       Gets P (EncB (priSK M) KM (pubEK P)
   9.248 -                {|Number LID_M, Number XID, HOIData, HOD|}
   9.249 -               P_I)
   9.250 -           \<in> set evsAResS |]
   9.251 -   ==> Says P M
   9.252 -            (EncB (priSK P) KP (pubEK M)
   9.253 -              {|Number LID_M, Number XID, Number PurchAmt|}
   9.254 -              authCode)
   9.255 -       # evsAResS \<in> set_pur"
   9.256 -
   9.257 -| PRes:
   9.258 -    --{*Purchase response.*}
   9.259 -   "[| evsPRes \<in> set_pur;  KP \<in> symKeys;  M = Merchant i;
   9.260 -       Transaction = {|Agent M, Agent C, Number OrderDesc, Number PurchAmt|};
   9.261 -       Gets M (EncB (priSK P) KP (pubEK M)
   9.262 -              {|Number LID_M, Number XID, Number PurchAmt|}
   9.263 -              authCode)
   9.264 -          \<in> set evsPRes;
   9.265 -       Gets M {|Number LID_M, Nonce Chall_C|} \<in> set evsPRes;
   9.266 -       Says M P
   9.267 -            (EncB (priSK M) KM (pubEK P)
   9.268 -              {|Number LID_M, Number XID, Hash OIData, HOD|} P_I)
   9.269 -         \<in> set evsPRes;
   9.270 -       Notes M {|Number LID_M, Agent P, Transaction|}
   9.271 -          \<in> set evsPRes
   9.272 -      |]
   9.273 -   ==> Says M C
   9.274 -         (sign (priSK M) {|Number LID_M, Number XID, Nonce Chall_C,
   9.275 -                           Hash (Number PurchAmt)|})
   9.276 -         # evsPRes \<in> set_pur"
   9.277 -
   9.278 -
   9.279 -specification (CardSecret PANSecret)
   9.280 -  inj_CardSecret:  "inj CardSecret"
   9.281 -  inj_PANSecret:   "inj PANSecret"
   9.282 -  CardSecret_neq_PANSecret: "CardSecret k \<noteq> PANSecret k'"
   9.283 -    --{*No CardSecret equals any PANSecret*}
   9.284 -  apply (rule_tac x="curry nat2_to_nat 0" in exI)
   9.285 -  apply (rule_tac x="curry nat2_to_nat 1" in exI)
   9.286 -  apply (simp add: nat2_to_nat_inj [THEN inj_eq] inj_on_def)
   9.287 -  done
   9.288 -
   9.289 -declare Says_imp_knows_Spy [THEN parts.Inj, dest]
   9.290 -declare parts.Body [dest]
   9.291 -declare analz_into_parts [dest]
   9.292 -declare Fake_parts_insert_in_Un [dest]
   9.293 -
   9.294 -declare CardSecret_neq_PANSecret [iff] 
   9.295 -        CardSecret_neq_PANSecret [THEN not_sym, iff]
   9.296 -declare inj_CardSecret [THEN inj_eq, iff] 
   9.297 -        inj_PANSecret [THEN inj_eq, iff]
   9.298 -
   9.299 -
   9.300 -subsection{*Possibility Properties*}
   9.301 -
   9.302 -lemma Says_to_Gets:
   9.303 -     "Says A B X # evs \<in> set_pur ==> Gets B X # Says A B X # evs \<in> set_pur"
   9.304 -by (rule set_pur.Reception, auto)
   9.305 -
   9.306 -text{*Possibility for UNSIGNED purchases. Note that we need to ensure
   9.307 -that XID differs from OrderDesc and PurchAmt, since it is supposed to be
   9.308 -a unique number!*}
   9.309 -lemma possibility_Uns:
   9.310 -    "[| CardSecret k = 0;
   9.311 -        C = Cardholder k;  M = Merchant i;
   9.312 -        Key KC \<notin> used []; Key KM \<notin> used []; Key KP \<notin> used []; 
   9.313 -        KC \<in> symKeys; KM \<in> symKeys; KP \<in> symKeys; 
   9.314 -        KC < KM; KM < KP;
   9.315 -        Nonce Chall_C \<notin> used []; Chall_C \<notin> range CardSecret \<union> range PANSecret;
   9.316 -        Nonce Chall_M \<notin> used []; Chall_M \<notin> range CardSecret \<union> range PANSecret;
   9.317 -        Chall_C < Chall_M; 
   9.318 -        Number LID_M \<notin> used []; LID_M \<notin> range CardSecret \<union> range PANSecret;
   9.319 -        Number XID \<notin> used []; XID \<notin> range CardSecret \<union> range PANSecret;
   9.320 -        LID_M < XID; XID < OrderDesc; OrderDesc < PurchAmt |] 
   9.321 -   ==> \<exists>evs \<in> set_pur.
   9.322 -          Says M C
   9.323 -               (sign (priSK M)
   9.324 -                    {|Number LID_M, Number XID, Nonce Chall_C, 
   9.325 -                      Hash (Number PurchAmt)|})
   9.326 -                  \<in> set evs" 
   9.327 -apply (intro exI bexI)
   9.328 -apply (rule_tac [2]
   9.329 -        set_pur.Nil
   9.330 -         [THEN set_pur.Start [of _ LID_M C k M i _ _ _ OrderDesc PurchAmt], 
   9.331 -          THEN set_pur.PInitReq [of concl: C M LID_M Chall_C],
   9.332 -          THEN Says_to_Gets, 
   9.333 -          THEN set_pur.PInitRes [of concl: M C LID_M XID Chall_C Chall_M], 
   9.334 -          THEN Says_to_Gets,
   9.335 -          THEN set_pur.PReqUns [of concl: C M KC],
   9.336 -          THEN Says_to_Gets, 
   9.337 -          THEN set_pur.AuthReq [of concl: M "PG j" KM LID_M XID], 
   9.338 -          THEN Says_to_Gets, 
   9.339 -          THEN set_pur.AuthResUns [of concl: "PG j" M KP LID_M XID],
   9.340 -          THEN Says_to_Gets, 
   9.341 -          THEN set_pur.PRes]) 
   9.342 -apply basic_possibility
   9.343 -apply (simp_all add: used_Cons symKeys_neq_imp_neq) 
   9.344 -done
   9.345 -
   9.346 -lemma possibility_S:
   9.347 -    "[| CardSecret k \<noteq> 0;
   9.348 -        C = Cardholder k;  M = Merchant i;
   9.349 -        Key KC \<notin> used []; Key KM \<notin> used []; Key KP \<notin> used []; 
   9.350 -        KC \<in> symKeys; KM \<in> symKeys; KP \<in> symKeys; 
   9.351 -        KC < KM; KM < KP;
   9.352 -        Nonce Chall_C \<notin> used []; Chall_C \<notin> range CardSecret \<union> range PANSecret;
   9.353 -        Nonce Chall_M \<notin> used []; Chall_M \<notin> range CardSecret \<union> range PANSecret;
   9.354 -        Chall_C < Chall_M; 
   9.355 -        Number LID_M \<notin> used []; LID_M \<notin> range CardSecret \<union> range PANSecret;
   9.356 -        Number XID \<notin> used []; XID \<notin> range CardSecret \<union> range PANSecret;
   9.357 -        LID_M < XID; XID < OrderDesc; OrderDesc < PurchAmt |] 
   9.358 -   ==>  \<exists>evs \<in> set_pur.
   9.359 -            Says M C
   9.360 -                 (sign (priSK M) {|Number LID_M, Number XID, Nonce Chall_C, 
   9.361 -                                   Hash (Number PurchAmt)|})
   9.362 -               \<in> set evs"
   9.363 -apply (intro exI bexI)
   9.364 -apply (rule_tac [2]
   9.365 -        set_pur.Nil
   9.366 -         [THEN set_pur.Start [of _ LID_M C k M i _ _ _ OrderDesc PurchAmt], 
   9.367 -          THEN set_pur.PInitReq [of concl: C M LID_M Chall_C],
   9.368 -          THEN Says_to_Gets, 
   9.369 -          THEN set_pur.PInitRes [of concl: M C LID_M XID Chall_C Chall_M], 
   9.370 -          THEN Says_to_Gets,
   9.371 -          THEN set_pur.PReqS [of concl: C M _ _ KC],
   9.372 -          THEN Says_to_Gets, 
   9.373 -          THEN set_pur.AuthReq [of concl: M "PG j" KM LID_M XID], 
   9.374 -          THEN Says_to_Gets, 
   9.375 -          THEN set_pur.AuthResS [of concl: "PG j" M KP LID_M XID],
   9.376 -          THEN Says_to_Gets, 
   9.377 -          THEN set_pur.PRes]) 
   9.378 -apply basic_possibility
   9.379 -apply (auto simp add: used_Cons symKeys_neq_imp_neq) 
   9.380 -done
   9.381 -
   9.382 -text{*General facts about message reception*}
   9.383 -lemma Gets_imp_Says:
   9.384 -     "[| Gets B X \<in> set evs; evs \<in> set_pur |]
   9.385 -   ==> \<exists>A. Says A B X \<in> set evs"
   9.386 -apply (erule rev_mp)
   9.387 -apply (erule set_pur.induct, auto)
   9.388 -done
   9.389 -
   9.390 -lemma Gets_imp_knows_Spy:
   9.391 -     "[| Gets B X \<in> set evs; evs \<in> set_pur |]  ==> X \<in> knows Spy evs"
   9.392 -by (blast dest!: Gets_imp_Says Says_imp_knows_Spy)
   9.393 -
   9.394 -declare Gets_imp_knows_Spy [THEN parts.Inj, dest]
   9.395 -
   9.396 -text{*Forwarding lemmas, to aid simplification*}
   9.397 -
   9.398 -lemma AuthReq_msg_in_parts_spies:
   9.399 -     "[|Gets M {|P_I, OIData, HPIData|} \<in> set evs;
   9.400 -        evs \<in> set_pur|] ==> P_I \<in> parts (knows Spy evs)"
   9.401 -by auto
   9.402 -
   9.403 -lemma AuthReq_msg_in_analz_spies:
   9.404 -     "[|Gets M {|P_I, OIData, HPIData|} \<in> set evs;
   9.405 -        evs \<in> set_pur|] ==> P_I \<in> analz (knows Spy evs)"
   9.406 -by (blast dest: Gets_imp_knows_Spy [THEN analz.Inj])
   9.407 -
   9.408 -
   9.409 -subsection{*Proofs on Asymmetric Keys*}
   9.410 -
   9.411 -text{*Private Keys are Secret*}
   9.412 -
   9.413 -text{*Spy never sees an agent's private keys! (unless it's bad at start)*}
   9.414 -lemma Spy_see_private_Key [simp]:
   9.415 -     "evs \<in> set_pur
   9.416 -      ==> (Key(invKey (publicKey b A)) \<in> parts(knows Spy evs)) = (A \<in> bad)"
   9.417 -apply (erule set_pur.induct)
   9.418 -apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
   9.419 -apply auto
   9.420 -done
   9.421 -declare Spy_see_private_Key [THEN [2] rev_iffD1, dest!]
   9.422 -
   9.423 -lemma Spy_analz_private_Key [simp]:
   9.424 -     "evs \<in> set_pur ==>
   9.425 -     (Key(invKey (publicKey b A)) \<in> analz(knows Spy evs)) = (A \<in> bad)"
   9.426 -by auto
   9.427 -declare Spy_analz_private_Key [THEN [2] rev_iffD1, dest!]
   9.428 -
   9.429 -text{*rewriting rule for priEK's*}
   9.430 -lemma parts_image_priEK:
   9.431 -     "[|Key (priEK C) \<in> parts (Key`KK Un (knows Spy evs));
   9.432 -        evs \<in> set_pur|] ==> priEK C \<in> KK | C \<in> bad"
   9.433 -by auto
   9.434 -
   9.435 -text{*trivial proof because @{term"priEK C"} never appears even in
   9.436 -  @{term "parts evs"}. *}
   9.437 -lemma analz_image_priEK:
   9.438 -     "evs \<in> set_pur ==>
   9.439 -          (Key (priEK C) \<in> analz (Key`KK Un (knows Spy evs))) =
   9.440 -          (priEK C \<in> KK | C \<in> bad)"
   9.441 -by (blast dest!: parts_image_priEK intro: analz_mono [THEN [2] rev_subsetD])
   9.442 -
   9.443 -
   9.444 -subsection{*Public Keys in Certificates are Correct*}
   9.445 -
   9.446 -lemma Crypt_valid_pubEK [dest!]:
   9.447 -     "[| Crypt (priSK RCA) {|Agent C, Key EKi, onlyEnc|}
   9.448 -           \<in> parts (knows Spy evs);
   9.449 -         evs \<in> set_pur |] ==> EKi = pubEK C"
   9.450 -by (erule rev_mp, erule set_pur.induct, auto)
   9.451 -
   9.452 -lemma Crypt_valid_pubSK [dest!]:
   9.453 -     "[| Crypt (priSK RCA) {|Agent C, Key SKi, onlySig|}
   9.454 -           \<in> parts (knows Spy evs);
   9.455 -         evs \<in> set_pur |] ==> SKi = pubSK C"
   9.456 -by (erule rev_mp, erule set_pur.induct, auto)
   9.457 -
   9.458 -lemma certificate_valid_pubEK:
   9.459 -    "[| cert C EKi onlyEnc (priSK RCA) \<in> parts (knows Spy evs);
   9.460 -        evs \<in> set_pur |]
   9.461 -     ==> EKi = pubEK C"
   9.462 -by (unfold cert_def signCert_def, auto)
   9.463 -
   9.464 -lemma certificate_valid_pubSK:
   9.465 -    "[| cert C SKi onlySig (priSK RCA) \<in> parts (knows Spy evs);
   9.466 -        evs \<in> set_pur |] ==> SKi = pubSK C"
   9.467 -by (unfold cert_def signCert_def, auto)
   9.468 -
   9.469 -lemma Says_certificate_valid [simp]:
   9.470 -     "[| Says A B (sign SK {|lid, xid, cc, cm,
   9.471 -                           cert C EK onlyEnc (priSK RCA)|}) \<in> set evs;
   9.472 -         evs \<in> set_pur |]
   9.473 -      ==> EK = pubEK C"
   9.474 -by (unfold sign_def, auto)
   9.475 -
   9.476 -lemma Gets_certificate_valid [simp]:
   9.477 -     "[| Gets A (sign SK {|lid, xid, cc, cm,
   9.478 -                           cert C EK onlyEnc (priSK RCA)|}) \<in> set evs;
   9.479 -         evs \<in> set_pur |]
   9.480 -      ==> EK = pubEK C"
   9.481 -by (frule Gets_imp_Says, auto)
   9.482 -
   9.483 -method_setup valid_certificate_tac = {*
   9.484 -  Args.goal_spec >> (fn quant =>
   9.485 -    K (SIMPLE_METHOD'' quant (fn i =>
   9.486 -      EVERY [ftac @{thm Gets_certificate_valid} i,
   9.487 -             assume_tac i, REPEAT (hyp_subst_tac i)])))
   9.488 -*} ""
   9.489 -
   9.490 -
   9.491 -subsection{*Proofs on Symmetric Keys*}
   9.492 -
   9.493 -text{*Nobody can have used non-existent keys!*}
   9.494 -lemma new_keys_not_used [rule_format,simp]:
   9.495 -     "evs \<in> set_pur
   9.496 -      ==> Key K \<notin> used evs --> K \<in> symKeys -->
   9.497 -          K \<notin> keysFor (parts (knows Spy evs))"
   9.498 -apply (erule set_pur.induct)
   9.499 -apply (valid_certificate_tac [8]) --{*PReqS*}
   9.500 -apply (valid_certificate_tac [7]) --{*PReqUns*}
   9.501 -apply auto
   9.502 -apply (force dest!: usedI keysFor_parts_insert) --{*Fake*}
   9.503 -done
   9.504 -
   9.505 -lemma new_keys_not_analzd:
   9.506 -     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_pur |]
   9.507 -      ==> K \<notin> keysFor (analz (knows Spy evs))"
   9.508 -by (blast intro: keysFor_mono [THEN [2] rev_subsetD] dest: new_keys_not_used)
   9.509 -
   9.510 -lemma Crypt_parts_imp_used:
   9.511 -     "[|Crypt K X \<in> parts (knows Spy evs);
   9.512 -        K \<in> symKeys; evs \<in> set_pur |] ==> Key K \<in> used evs"
   9.513 -apply (rule ccontr)
   9.514 -apply (force dest: new_keys_not_used Crypt_imp_invKey_keysFor)
   9.515 -done
   9.516 -
   9.517 -lemma Crypt_analz_imp_used:
   9.518 -     "[|Crypt K X \<in> analz (knows Spy evs);
   9.519 -        K \<in> symKeys; evs \<in> set_pur |] ==> Key K \<in> used evs"
   9.520 -by (blast intro: Crypt_parts_imp_used)
   9.521 -
   9.522 -text{*New versions: as above, but generalized to have the KK argument*}
   9.523 -
   9.524 -lemma gen_new_keys_not_used:
   9.525 -     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_pur |]
   9.526 -      ==> Key K \<notin> used evs --> K \<in> symKeys -->
   9.527 -          K \<notin> keysFor (parts (Key`KK Un knows Spy evs))"
   9.528 -by auto
   9.529 -
   9.530 -lemma gen_new_keys_not_analzd:
   9.531 -     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_pur |]
   9.532 -      ==> K \<notin> keysFor (analz (Key`KK Un knows Spy evs))"
   9.533 -by (blast intro: keysFor_mono [THEN subsetD] dest: gen_new_keys_not_used)
   9.534 -
   9.535 -lemma analz_Key_image_insert_eq:
   9.536 -     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_pur |]
   9.537 -      ==> analz (Key ` (insert K KK) \<union> knows Spy evs) =
   9.538 -          insert (Key K) (analz (Key ` KK \<union> knows Spy evs))"
   9.539 -by (simp add: gen_new_keys_not_analzd)
   9.540 -
   9.541 -
   9.542 -subsection{*Secrecy of Symmetric Keys*}
   9.543 -
   9.544 -lemma Key_analz_image_Key_lemma:
   9.545 -     "P --> (Key K \<in> analz (Key`KK Un H)) --> (K\<in>KK | Key K \<in> analz H)
   9.546 -      ==>
   9.547 -      P --> (Key K \<in> analz (Key`KK Un H)) = (K\<in>KK | Key K \<in> analz H)"
   9.548 -by (blast intro: analz_mono [THEN [2] rev_subsetD])
   9.549 -
   9.550 -
   9.551 -lemma symKey_compromise:
   9.552 -     "evs \<in> set_pur \<Longrightarrow>
   9.553 -      (\<forall>SK KK. SK \<in> symKeys \<longrightarrow>
   9.554 -        (\<forall>K \<in> KK. K \<notin> range(\<lambda>C. priEK C)) \<longrightarrow>
   9.555 -               (Key SK \<in> analz (Key`KK \<union> (knows Spy evs))) =
   9.556 -               (SK \<in> KK \<or> Key SK \<in> analz (knows Spy evs)))"
   9.557 -apply (erule set_pur.induct)
   9.558 -apply (rule_tac [!] allI)+
   9.559 -apply (rule_tac [!] impI [THEN Key_analz_image_Key_lemma, THEN impI])+
   9.560 -apply (frule_tac [9] AuthReq_msg_in_analz_spies) --{*AReq*}
   9.561 -apply (valid_certificate_tac [8]) --{*PReqS*}
   9.562 -apply (valid_certificate_tac [7]) --{*PReqUns*}
   9.563 -apply (simp_all
   9.564 -         del: image_insert image_Un imp_disjL
   9.565 -         add: analz_image_keys_simps disj_simps
   9.566 -              analz_Key_image_insert_eq notin_image_iff
   9.567 -              analz_insert_simps analz_image_priEK)
   9.568 -  --{*8 seconds on a 1.6GHz machine*}
   9.569 -apply spy_analz --{*Fake*}
   9.570 -apply (blast elim!: ballE)+ --{*PReq: unsigned and signed*}
   9.571 -done
   9.572 -
   9.573 -
   9.574 -
   9.575 -subsection{*Secrecy of Nonces*}
   9.576 -
   9.577 -text{*As usual: we express the property as a logical equivalence*}
   9.578 -lemma Nonce_analz_image_Key_lemma:
   9.579 -     "P --> (Nonce N \<in> analz (Key`KK Un H)) --> (Nonce N \<in> analz H)
   9.580 -      ==> P --> (Nonce N \<in> analz (Key`KK Un H)) = (Nonce N \<in> analz H)"
   9.581 -by (blast intro: analz_mono [THEN [2] rev_subsetD])
   9.582 -
   9.583 -text{*The @{text "(no_asm)"} attribute is essential, since it retains
   9.584 -  the quantifier and allows the simprule's condition to itself be simplified.*}
   9.585 -lemma Nonce_compromise [rule_format (no_asm)]:
   9.586 -     "evs \<in> set_pur ==>
   9.587 -      (\<forall>N KK. (\<forall>K \<in> KK. K \<notin> range(\<lambda>C. priEK C))   -->
   9.588 -              (Nonce N \<in> analz (Key`KK \<union> (knows Spy evs))) =
   9.589 -              (Nonce N \<in> analz (knows Spy evs)))"
   9.590 -apply (erule set_pur.induct)
   9.591 -apply (rule_tac [!] allI)+
   9.592 -apply (rule_tac [!] impI [THEN Nonce_analz_image_Key_lemma])+
   9.593 -apply (frule_tac [9] AuthReq_msg_in_analz_spies) --{*AReq*}
   9.594 -apply (valid_certificate_tac [8]) --{*PReqS*}
   9.595 -apply (valid_certificate_tac [7]) --{*PReqUns*}
   9.596 -apply (simp_all
   9.597 -         del: image_insert image_Un imp_disjL
   9.598 -         add: analz_image_keys_simps disj_simps symKey_compromise
   9.599 -              analz_Key_image_insert_eq notin_image_iff
   9.600 -              analz_insert_simps analz_image_priEK)
   9.601 -  --{*8 seconds on a 1.6GHz machine*}
   9.602 -apply spy_analz --{*Fake*}
   9.603 -apply (blast elim!: ballE) --{*PReqS*}
   9.604 -done
   9.605 -
   9.606 -lemma PANSecret_notin_spies:
   9.607 -     "[|Nonce (PANSecret k) \<in> analz (knows Spy evs);  evs \<in> set_pur|]
   9.608 -      ==> 
   9.609 -       (\<exists>V W X Y KC2 M. \<exists>P \<in> bad.
   9.610 -          Says (Cardholder k) M
   9.611 -               {|{|W, EXcrypt KC2 (pubEK P) X {|Y, Nonce (PANSecret k)|}|},
   9.612 -                 V|}  \<in>  set evs)"
   9.613 -apply (erule rev_mp)
   9.614 -apply (erule set_pur.induct)
   9.615 -apply (frule_tac [9] AuthReq_msg_in_analz_spies)
   9.616 -apply (valid_certificate_tac [8]) --{*PReqS*}
   9.617 -apply (simp_all
   9.618 -         del: image_insert image_Un imp_disjL
   9.619 -         add: analz_image_keys_simps disj_simps
   9.620 -              symKey_compromise pushes sign_def Nonce_compromise
   9.621 -              analz_Key_image_insert_eq notin_image_iff
   9.622 -              analz_insert_simps analz_image_priEK)
   9.623 -  --{*2.5 seconds on a 1.6GHz machine*}
   9.624 -apply spy_analz
   9.625 -apply (blast dest!: Gets_imp_knows_Spy [THEN analz.Inj])
   9.626 -apply (blast dest: Says_imp_knows_Spy [THEN analz.Inj] 
   9.627 -                   Gets_imp_knows_Spy [THEN analz.Inj])
   9.628 -apply (blast dest: Gets_imp_knows_Spy [THEN analz.Inj]) --{*PReqS*}
   9.629 -apply (blast dest: Says_imp_knows_Spy [THEN analz.Inj] 
   9.630 -                   Gets_imp_knows_Spy [THEN analz.Inj]) --{*PRes*}
   9.631 -done
   9.632 -
   9.633 -text{*This theorem is a bit silly, in that many CardSecrets are 0!
   9.634 -  But then we don't care.  NOT USED*}
   9.635 -lemma CardSecret_notin_spies:
   9.636 -     "evs \<in> set_pur ==> Nonce (CardSecret i) \<notin> parts (knows Spy evs)"
   9.637 -by (erule set_pur.induct, auto)
   9.638 -
   9.639 -
   9.640 -subsection{*Confidentiality of PAN*}
   9.641 -
   9.642 -lemma analz_image_pan_lemma:
   9.643 -     "(Pan P \<in> analz (Key`nE Un H)) --> (Pan P \<in> analz H)  ==>
   9.644 -      (Pan P \<in> analz (Key`nE Un H)) =   (Pan P \<in> analz H)"
   9.645 -by (blast intro: analz_mono [THEN [2] rev_subsetD])
   9.646 -
   9.647 -text{*The @{text "(no_asm)"} attribute is essential, since it retains
   9.648 -  the quantifier and allows the simprule's condition to itself be simplified.*}
   9.649 -lemma analz_image_pan [rule_format (no_asm)]:
   9.650 -     "evs \<in> set_pur ==>
   9.651 -       \<forall>KK. (\<forall>K \<in> KK. K \<notin> range(\<lambda>C. priEK C)) -->
   9.652 -            (Pan P \<in> analz (Key`KK Un (knows Spy evs))) =
   9.653 -            (Pan P \<in> analz (knows Spy evs))"
   9.654 -apply (erule set_pur.induct)
   9.655 -apply (rule_tac [!] allI impI)+
   9.656 -apply (rule_tac [!] analz_image_pan_lemma)+
   9.657 -apply (frule_tac [9] AuthReq_msg_in_analz_spies) --{*AReq*}
   9.658 -apply (valid_certificate_tac [8]) --{*PReqS*}
   9.659 -apply (valid_certificate_tac [7]) --{*PReqUns*}
   9.660 -apply (simp_all
   9.661 -         del: image_insert image_Un imp_disjL
   9.662 -         add: analz_image_keys_simps
   9.663 -              symKey_compromise pushes sign_def
   9.664 -              analz_Key_image_insert_eq notin_image_iff
   9.665 -              analz_insert_simps analz_image_priEK)
   9.666 -  --{*7 seconds on a 1.6GHz machine*}
   9.667 -apply spy_analz --{*Fake*}
   9.668 -apply auto
   9.669 -done
   9.670 -
   9.671 -lemma analz_insert_pan:
   9.672 -     "[| evs \<in> set_pur;  K \<notin> range(\<lambda>C. priEK C) |] ==>
   9.673 -          (Pan P \<in> analz (insert (Key K) (knows Spy evs))) =
   9.674 -          (Pan P \<in> analz (knows Spy evs))"
   9.675 -by (simp del: image_insert image_Un
   9.676 -         add: analz_image_keys_simps analz_image_pan)
   9.677 -
   9.678 -text{*Confidentiality of the PAN, unsigned case.*}
   9.679 -theorem pan_confidentiality_unsigned:
   9.680 -     "[| Pan (pan C) \<in> analz(knows Spy evs);  C = Cardholder k;
   9.681 -         CardSecret k = 0;  evs \<in> set_pur|]
   9.682 -    ==> \<exists>P M KC1 K X Y.
   9.683 -     Says C M {|EXHcrypt KC1 (pubEK P) X (Pan (pan C)), Y|}
   9.684 -          \<in> set evs  &
   9.685 -     P \<in> bad"
   9.686 -apply (erule rev_mp)
   9.687 -apply (erule set_pur.induct)
   9.688 -apply (frule_tac [9] AuthReq_msg_in_analz_spies) --{*AReq*}
   9.689 -apply (valid_certificate_tac [8]) --{*PReqS*}
   9.690 -apply (valid_certificate_tac [7]) --{*PReqUns*}
   9.691 -apply (simp_all
   9.692 -         del: image_insert image_Un imp_disjL
   9.693 -         add: analz_image_keys_simps analz_insert_pan analz_image_pan
   9.694 -              notin_image_iff
   9.695 -              analz_insert_simps analz_image_priEK)
   9.696 -  --{*3 seconds on a 1.6GHz machine*}
   9.697 -apply spy_analz --{*Fake*}
   9.698 -apply blast --{*PReqUns: unsigned*}
   9.699 -apply force --{*PReqS: signed*}
   9.700 -done
   9.701 -
   9.702 -text{*Confidentiality of the PAN, signed case.*}
   9.703 -theorem pan_confidentiality_signed:
   9.704 - "[|Pan (pan C) \<in> analz(knows Spy evs);  C = Cardholder k;
   9.705 -    CardSecret k \<noteq> 0;  evs \<in> set_pur|]
   9.706 -  ==> \<exists>P M KC2 PIDualSign_1 PIDualSign_2 other OIDualSign.
   9.707 -      Says C M {|{|PIDualSign_1, 
   9.708 -                   EXcrypt KC2 (pubEK P) PIDualSign_2 {|Pan (pan C), other|}|}, 
   9.709 -       OIDualSign|} \<in> set evs  &  P \<in> bad"
   9.710 -apply (erule rev_mp)
   9.711 -apply (erule set_pur.induct)
   9.712 -apply (frule_tac [9] AuthReq_msg_in_analz_spies) --{*AReq*}
   9.713 -apply (valid_certificate_tac [8]) --{*PReqS*}
   9.714 -apply (valid_certificate_tac [7]) --{*PReqUns*}
   9.715 -apply (simp_all
   9.716 -         del: image_insert image_Un imp_disjL
   9.717 -         add: analz_image_keys_simps analz_insert_pan analz_image_pan
   9.718 -              notin_image_iff
   9.719 -              analz_insert_simps analz_image_priEK)
   9.720 -  --{*3 seconds on a 1.6GHz machine*}
   9.721 -apply spy_analz --{*Fake*}
   9.722 -apply force --{*PReqUns: unsigned*}
   9.723 -apply blast --{*PReqS: signed*}
   9.724 -done
   9.725 -
   9.726 -text{*General goal: that C, M and PG agree on those details of the transaction
   9.727 -     that they are allowed to know about.  PG knows about price and account
   9.728 -     details.  M knows about the order description and price.  C knows both.*}
   9.729 -
   9.730 -
   9.731 -subsection{*Proofs Common to Signed and Unsigned Versions*}
   9.732 -
   9.733 -lemma M_Notes_PG:
   9.734 -     "[|Notes M {|Number LID_M, Agent P, Agent M, Agent C, etc|} \<in> set evs;
   9.735 -        evs \<in> set_pur|] ==> \<exists>j. P = PG j"
   9.736 -by (erule rev_mp, erule set_pur.induct, simp_all)
   9.737 -
   9.738 -text{*If we trust M, then @{term LID_M} determines his choice of P
   9.739 -      (Payment Gateway)*}
   9.740 -lemma goodM_gives_correct_PG:
   9.741 -     "[| MsgPInitRes = 
   9.742 -            {|Number LID_M, xid, cc, cm, cert P EKj onlyEnc (priSK RCA)|};
   9.743 -         Crypt (priSK M) (Hash MsgPInitRes) \<in> parts (knows Spy evs);
   9.744 -         evs \<in> set_pur; M \<notin> bad |]
   9.745 -      ==> \<exists>j trans.
   9.746 -            P = PG j &
   9.747 -            Notes M {|Number LID_M, Agent P, trans|} \<in> set evs"
   9.748 -apply clarify
   9.749 -apply (erule rev_mp)
   9.750 -apply (erule set_pur.induct)
   9.751 -apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
   9.752 -apply simp_all
   9.753 -apply (blast intro: M_Notes_PG)+
   9.754 -done
   9.755 -
   9.756 -lemma C_gets_correct_PG:
   9.757 -     "[| Gets A (sign (priSK M) {|Number LID_M, xid, cc, cm,
   9.758 -                              cert P EKj onlyEnc (priSK RCA)|}) \<in> set evs;
   9.759 -         evs \<in> set_pur;  M \<notin> bad|]
   9.760 -      ==> \<exists>j trans.
   9.761 -            P = PG j &
   9.762 -            Notes M {|Number LID_M, Agent P, trans|} \<in> set evs &
   9.763 -            EKj = pubEK P"
   9.764 -by (rule refl [THEN goodM_gives_correct_PG, THEN exE], auto)
   9.765 -
   9.766 -text{*When C receives PInitRes, he learns M's choice of P*}
   9.767 -lemma C_verifies_PInitRes:
   9.768 - "[| MsgPInitRes = {|Number LID_M, Number XID, Nonce Chall_C, Nonce Chall_M,
   9.769 -           cert P EKj onlyEnc (priSK RCA)|};
   9.770 -     Crypt (priSK M) (Hash MsgPInitRes) \<in> parts (knows Spy evs);
   9.771 -     evs \<in> set_pur;  M \<notin> bad|]
   9.772 -  ==> \<exists>j trans.
   9.773 -         Notes M {|Number LID_M, Agent P, trans|} \<in> set evs &
   9.774 -         P = PG j &
   9.775 -         EKj = pubEK P"
   9.776 -apply clarify
   9.777 -apply (erule rev_mp)
   9.778 -apply (erule set_pur.induct)
   9.779 -apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
   9.780 -apply simp_all
   9.781 -apply (blast intro: M_Notes_PG)+
   9.782 -done
   9.783 -
   9.784 -text{*Corollary of previous one*}
   9.785 -lemma Says_C_PInitRes:
   9.786 -     "[|Says A C (sign (priSK M)
   9.787 -                      {|Number LID_M, Number XID,
   9.788 -                        Nonce Chall_C, Nonce Chall_M,
   9.789 -                        cert P EKj onlyEnc (priSK RCA)|})
   9.790 -           \<in> set evs;  M \<notin> bad;  evs \<in> set_pur|]
   9.791 -      ==> \<exists>j trans.
   9.792 -           Notes M {|Number LID_M, Agent P, trans|} \<in> set evs &
   9.793 -           P = PG j &
   9.794 -           EKj = pubEK (PG j)"
   9.795 -apply (frule Says_certificate_valid)
   9.796 -apply (auto simp add: sign_def)
   9.797 -apply (blast dest: refl [THEN goodM_gives_correct_PG])
   9.798 -apply (blast dest: refl [THEN C_verifies_PInitRes])
   9.799 -done
   9.800 -
   9.801 -text{*When P receives an AuthReq, he knows that the signed part originated 
   9.802 -      with M. PIRes also has a signed message from M....*}
   9.803 -lemma P_verifies_AuthReq:
   9.804 -     "[| AuthReqData = {|Number LID_M, Number XID, HOIData, HOD|};
   9.805 -         Crypt (priSK M) (Hash {|AuthReqData, Hash P_I|})
   9.806 -           \<in> parts (knows Spy evs);
   9.807 -         evs \<in> set_pur;  M \<notin> bad|]
   9.808 -      ==> \<exists>j trans KM OIData HPIData.
   9.809 -            Notes M {|Number LID_M, Agent (PG j), trans|} \<in> set evs &
   9.810 -            Gets M {|P_I, OIData, HPIData|} \<in> set evs &
   9.811 -            Says M (PG j) (EncB (priSK M) KM (pubEK (PG j)) AuthReqData P_I)
   9.812 -              \<in> set evs"
   9.813 -apply clarify
   9.814 -apply (erule rev_mp)
   9.815 -apply (erule set_pur.induct, simp_all)
   9.816 -apply (frule_tac [4] M_Notes_PG, auto)
   9.817 -done
   9.818 -
   9.819 -text{*When M receives AuthRes, he knows that P signed it, including
   9.820 -  the identifying tags and the purchase amount, which he can verify.
   9.821 -  (Although the spec has SIGNED and UNSIGNED forms of AuthRes, they
   9.822 -   send the same message to M.)  The conclusion is weak: M is existentially
   9.823 -  quantified! That is because Authorization Response does not refer to M, while
   9.824 -  the digital envelope weakens the link between @{term MsgAuthRes} and
   9.825 -  @{term"priSK M"}.  Changing the precondition to refer to 
   9.826 -  @{term "Crypt K (sign SK M)"} requires assuming @{term K} to be secure, since
   9.827 -  otherwise the Spy could create that message.*}
   9.828 -theorem M_verifies_AuthRes:
   9.829 -  "[| MsgAuthRes = {|{|Number LID_M, Number XID, Number PurchAmt|}, 
   9.830 -                     Hash authCode|};
   9.831 -      Crypt (priSK (PG j)) (Hash MsgAuthRes) \<in> parts (knows Spy evs);
   9.832 -      PG j \<notin> bad;  evs \<in> set_pur|]
   9.833 -   ==> \<exists>M KM KP HOIData HOD P_I.
   9.834 -        Gets (PG j)
   9.835 -           (EncB (priSK M) KM (pubEK (PG j))
   9.836 -                    {|Number LID_M, Number XID, HOIData, HOD|}
   9.837 -                    P_I) \<in> set evs &
   9.838 -        Says (PG j) M
   9.839 -             (EncB (priSK (PG j)) KP (pubEK M)
   9.840 -              {|Number LID_M, Number XID, Number PurchAmt|}
   9.841 -              authCode) \<in> set evs"
   9.842 -apply clarify
   9.843 -apply (erule rev_mp)
   9.844 -apply (erule set_pur.induct)
   9.845 -apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
   9.846 -apply simp_all
   9.847 -apply blast+
   9.848 -done
   9.849 -
   9.850 -
   9.851 -subsection{*Proofs for Unsigned Purchases*}
   9.852 -
   9.853 -text{*What we can derive from the ASSUMPTION that C issued a purchase request.
   9.854 -   In the unsigned case, we must trust "C": there's no authentication.*}
   9.855 -lemma C_determines_EKj:
   9.856 -     "[| Says C M {|EXHcrypt KC1 EKj {|PIHead, Hash OIData|} (Pan (pan C)),
   9.857 -                    OIData, Hash{|PIHead, Pan (pan C)|} |} \<in> set evs;
   9.858 -         PIHead = {|Number LID_M, Trans_details|};
   9.859 -         evs \<in> set_pur;  C = Cardholder k;  M \<notin> bad|]
   9.860 -  ==> \<exists>trans j.
   9.861 -               Notes M {|Number LID_M, Agent (PG j), trans |} \<in> set evs &
   9.862 -               EKj = pubEK (PG j)"
   9.863 -apply clarify
   9.864 -apply (erule rev_mp)
   9.865 -apply (erule set_pur.induct, simp_all)
   9.866 -apply (valid_certificate_tac [2]) --{*PReqUns*}
   9.867 -apply auto
   9.868 -apply (blast dest: Gets_imp_Says Says_C_PInitRes)
   9.869 -done
   9.870 -
   9.871 -
   9.872 -text{*Unicity of @{term LID_M} between Merchant and Cardholder notes*}
   9.873 -lemma unique_LID_M:
   9.874 -     "[|Notes (Merchant i) {|Number LID_M, Agent P, Trans|} \<in> set evs;
   9.875 -        Notes C {|Number LID_M, Agent M, Agent C, Number OD,
   9.876 -             Number PA|} \<in> set evs;
   9.877 -        evs \<in> set_pur|]
   9.878 -      ==> M = Merchant i & Trans = {|Agent M, Agent C, Number OD, Number PA|}"
   9.879 -apply (erule rev_mp)
   9.880 -apply (erule rev_mp)
   9.881 -apply (erule set_pur.induct, simp_all)
   9.882 -apply (force dest!: Notes_imp_parts_subset_used)
   9.883 -done
   9.884 -
   9.885 -text{*Unicity of @{term LID_M}, for two Merchant Notes events*}
   9.886 -lemma unique_LID_M2:
   9.887 -     "[|Notes M {|Number LID_M, Trans|} \<in> set evs;
   9.888 -        Notes M {|Number LID_M, Trans'|} \<in> set evs;
   9.889 -        evs \<in> set_pur|] ==> Trans' = Trans"
   9.890 -apply (erule rev_mp)
   9.891 -apply (erule rev_mp)
   9.892 -apply (erule set_pur.induct, simp_all)
   9.893 -apply (force dest!: Notes_imp_parts_subset_used)
   9.894 -done
   9.895 -
   9.896 -text{*Lemma needed below: for the case that
   9.897 -  if PRes is present, then @{term LID_M} has been used.*}
   9.898 -lemma signed_imp_used:
   9.899 -     "[| Crypt (priSK M) (Hash X) \<in> parts (knows Spy evs);
   9.900 -         M \<notin> bad;  evs \<in> set_pur|] ==> parts {X} \<subseteq> used evs"
   9.901 -apply (erule rev_mp)
   9.902 -apply (erule set_pur.induct)
   9.903 -apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
   9.904 -apply simp_all
   9.905 -apply safe
   9.906 -apply blast+
   9.907 -done
   9.908 -
   9.909 -text{*Similar, with nested Hash*}
   9.910 -lemma signed_Hash_imp_used:
   9.911 -     "[| Crypt (priSK C) (Hash {|H, Hash X|}) \<in> parts (knows Spy evs);
   9.912 -         C \<notin> bad;  evs \<in> set_pur|] ==> parts {X} \<subseteq> used evs"
   9.913 -apply (erule rev_mp)
   9.914 -apply (erule set_pur.induct)
   9.915 -apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
   9.916 -apply simp_all
   9.917 -apply safe
   9.918 -apply blast+
   9.919 -done
   9.920 -
   9.921 -text{*Lemma needed below: for the case that
   9.922 -  if PRes is present, then @{text LID_M} has been used.*}
   9.923 -lemma PRes_imp_LID_used:
   9.924 -     "[| Crypt (priSK M) (Hash {|N, X|}) \<in> parts (knows Spy evs);
   9.925 -         M \<notin> bad;  evs \<in> set_pur|] ==> N \<in> used evs"
   9.926 -by (drule signed_imp_used, auto)
   9.927 -
   9.928 -text{*When C receives PRes, he knows that M and P agreed to the purchase details.
   9.929 -  He also knows that P is the same PG as before*}
   9.930 -lemma C_verifies_PRes_lemma:
   9.931 -     "[| Crypt (priSK M) (Hash MsgPRes) \<in> parts (knows Spy evs);
   9.932 -         Notes C {|Number LID_M, Trans |} \<in> set evs;
   9.933 -         Trans = {| Agent M, Agent C, Number OrderDesc, Number PurchAmt |};
   9.934 -         MsgPRes = {|Number LID_M, Number XID, Nonce Chall_C,
   9.935 -                Hash (Number PurchAmt)|};
   9.936 -         evs \<in> set_pur;  M \<notin> bad|]
   9.937 -  ==> \<exists>j KP.
   9.938 -        Notes M {|Number LID_M, Agent (PG j), Trans |}
   9.939 -          \<in> set evs &
   9.940 -        Gets M (EncB (priSK (PG j)) KP (pubEK M)
   9.941 -                {|Number LID_M, Number XID, Number PurchAmt|}
   9.942 -                authCode)
   9.943 -          \<in> set evs &
   9.944 -        Says M C (sign (priSK M) MsgPRes) \<in> set evs"
   9.945 -apply clarify
   9.946 -apply (erule rev_mp)
   9.947 -apply (erule rev_mp)
   9.948 -apply (erule set_pur.induct)
   9.949 -apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
   9.950 -apply simp_all
   9.951 -apply blast
   9.952 -apply blast
   9.953 -apply (blast dest: PRes_imp_LID_used)
   9.954 -apply (frule M_Notes_PG, auto)
   9.955 -apply (blast dest: unique_LID_M)
   9.956 -done
   9.957 -
   9.958 -text{*When the Cardholder receives Purchase Response from an uncompromised
   9.959 -Merchant, he knows that M sent it. He also knows that M received a message signed
   9.960 -by a Payment Gateway chosen by M to authorize the purchase.*}
   9.961 -theorem C_verifies_PRes:
   9.962 -     "[| MsgPRes = {|Number LID_M, Number XID, Nonce Chall_C,
   9.963 -                     Hash (Number PurchAmt)|};
   9.964 -         Gets C (sign (priSK M) MsgPRes) \<in> set evs;
   9.965 -         Notes C {|Number LID_M, Agent M, Agent C, Number OrderDesc,
   9.966 -                   Number PurchAmt|} \<in> set evs;
   9.967 -         evs \<in> set_pur;  M \<notin> bad|]
   9.968 -  ==> \<exists>P KP trans.
   9.969 -        Notes M {|Number LID_M,Agent P, trans|} \<in> set evs &
   9.970 -        Gets M (EncB (priSK P) KP (pubEK M)
   9.971 -                {|Number LID_M, Number XID, Number PurchAmt|}
   9.972 -                authCode)  \<in>  set evs &
   9.973 -        Says M C (sign (priSK M) MsgPRes) \<in> set evs"
   9.974 -apply (rule C_verifies_PRes_lemma [THEN exE])
   9.975 -apply (auto simp add: sign_def)
   9.976 -done
   9.977 -
   9.978 -subsection{*Proofs for Signed Purchases*}
   9.979 -
   9.980 -text{*Some Useful Lemmas: the cardholder knows what he is doing*}
   9.981 -
   9.982 -lemma Crypt_imp_Says_Cardholder:
   9.983 -     "[| Crypt K {|{|{|Number LID_M, others|}, Hash OIData|}, Hash PANData|}
   9.984 -           \<in> parts (knows Spy evs);
   9.985 -         PANData = {|Pan (pan (Cardholder k)), Nonce (PANSecret k)|};
   9.986 -         Key K \<notin> analz (knows Spy evs);
   9.987 -         evs \<in> set_pur|]
   9.988 -  ==> \<exists>M shash EK HPIData.
   9.989 -       Says (Cardholder k) M {|{|shash,
   9.990 -          Crypt K
   9.991 -            {|{|{|Number LID_M, others|}, Hash OIData|}, Hash PANData|},
   9.992 -           Crypt EK {|Key K, PANData|}|},
   9.993 -          OIData, HPIData|} \<in> set evs"
   9.994 -apply (erule rev_mp)
   9.995 -apply (erule rev_mp)
   9.996 -apply (erule rev_mp)
   9.997 -apply (erule set_pur.induct, analz_mono_contra)
   9.998 -apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
   9.999 -apply simp_all
  9.1000 -apply auto
  9.1001 -done
  9.1002 -
  9.1003 -lemma Says_PReqS_imp_trans_details_C:
  9.1004 -     "[| MsgPReqS = {|{|shash,
  9.1005 -                 Crypt K
  9.1006 -                  {|{|{|Number LID_M, PIrest|}, Hash OIData|}, hashpd|},
  9.1007 -            cryptek|}, data|};
  9.1008 -         Says (Cardholder k) M MsgPReqS \<in> set evs;
  9.1009 -         evs \<in> set_pur |]
  9.1010 -   ==> \<exists>trans.
  9.1011 -           Notes (Cardholder k) 
  9.1012 -                 {|Number LID_M, Agent M, Agent (Cardholder k), trans|}
  9.1013 -            \<in> set evs"
  9.1014 -apply (erule rev_mp)
  9.1015 -apply (erule rev_mp)
  9.1016 -apply (erule set_pur.induct)
  9.1017 -apply (simp_all (no_asm_simp))
  9.1018 -apply auto
  9.1019 -done
  9.1020 -
  9.1021 -text{*Can't happen: only Merchants create this type of Note*}
  9.1022 -lemma Notes_Cardholder_self_False:
  9.1023 -     "[|Notes (Cardholder k)
  9.1024 -          {|Number n, Agent P, Agent (Cardholder k), Agent C, etc|} \<in> set evs;
  9.1025 -        evs \<in> set_pur|] ==> False"
  9.1026 -by (erule rev_mp, erule set_pur.induct, auto)
  9.1027 -
  9.1028 -text{*When M sees a dual signature, he knows that it originated with C.
  9.1029 -  Using XID he knows it was intended for him.
  9.1030 -  This guarantee isn't useful to P, who never gets OIData.*}
  9.1031 -theorem M_verifies_Signed_PReq:
  9.1032 - "[| MsgDualSign = {|HPIData, Hash OIData|};
  9.1033 -     OIData = {|Number LID_M, etc|};
  9.1034 -     Crypt (priSK C) (Hash MsgDualSign) \<in> parts (knows Spy evs);
  9.1035 -     Notes M {|Number LID_M, Agent P, extras|} \<in> set evs;
  9.1036 -     M = Merchant i;  C = Cardholder k;  C \<notin> bad;  evs \<in> set_pur|]
  9.1037 -  ==> \<exists>PIData PICrypt.
  9.1038 -        HPIData = Hash PIData &
  9.1039 -        Says C M {|{|sign (priSK C) MsgDualSign, PICrypt|}, OIData, Hash PIData|}
  9.1040 -          \<in> set evs"
  9.1041 -apply clarify
  9.1042 -apply (erule rev_mp)
  9.1043 -apply (erule rev_mp)
  9.1044 -apply (erule set_pur.induct)
  9.1045 -apply (frule_tac [9] AuthReq_msg_in_parts_spies) --{*AuthReq*}
  9.1046 -apply simp_all
  9.1047 -apply blast
  9.1048 -apply (metis subsetD insert_subset parts.Fst parts_increasing signed_Hash_imp_used)
  9.1049 -apply (metis unique_LID_M)
  9.1050 -apply (blast dest!: Notes_Cardholder_self_False)
  9.1051 -done
  9.1052 -
  9.1053 -text{*When P sees a dual signature, he knows that it originated with C.
  9.1054 -  and was intended for M. This guarantee isn't useful to M, who never gets
  9.1055 -  PIData. I don't see how to link @{term "PG j"} and @{text LID_M} without
  9.1056 -  assuming @{term "M \<notin> bad"}.*}
  9.1057 -theorem P_verifies_Signed_PReq:
  9.1058 -     "[| MsgDualSign = {|Hash PIData, HOIData|};
  9.1059 -         PIData = {|PIHead, PANData|};
  9.1060 -         PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M,
  9.1061 -                    TransStain|};
  9.1062 -         Crypt (priSK C) (Hash MsgDualSign) \<in> parts (knows Spy evs);
  9.1063 -         evs \<in> set_pur;  C \<notin> bad;  M \<notin> bad|]
  9.1064 -    ==> \<exists>OIData OrderDesc K j trans.
  9.1065 -          HOD = Hash{|Number OrderDesc, Number PurchAmt|} &
  9.1066 -          HOIData = Hash OIData &
  9.1067 -          Notes M {|Number LID_M, Agent (PG j), trans|} \<in> set evs &
  9.1068 -          Says C M {|{|sign (priSK C) MsgDualSign,
  9.1069 -                     EXcrypt K (pubEK (PG j))
  9.1070 -                                {|PIHead, Hash OIData|} PANData|},
  9.1071 -                     OIData, Hash PIData|}
  9.1072 -            \<in> set evs"
  9.1073 -apply clarify
  9.1074 -apply (erule rev_mp)
  9.1075 -apply (erule set_pur.induct, simp_all)
  9.1076 -apply (auto dest!: C_gets_correct_PG)
  9.1077 -done
  9.1078 -
  9.1079 -lemma C_determines_EKj_signed:
  9.1080 -     "[| Says C M {|{|sign (priSK C) text,
  9.1081 -                      EXcrypt K EKj {|PIHead, X|} Y|}, Z|} \<in> set evs;
  9.1082 -         PIHead = {|Number LID_M, Number XID, W|};
  9.1083 -         C = Cardholder k;  evs \<in> set_pur;  M \<notin> bad|]
  9.1084 -  ==> \<exists> trans j.
  9.1085 -         Notes M {|Number LID_M, Agent (PG j), trans|} \<in> set evs &
  9.1086 -         EKj = pubEK (PG j)"
  9.1087 -apply clarify
  9.1088 -apply (erule rev_mp)
  9.1089 -apply (erule set_pur.induct, simp_all, auto)
  9.1090 -apply (blast dest: C_gets_correct_PG)
  9.1091 -done
  9.1092 -
  9.1093 -lemma M_Says_AuthReq:
  9.1094 -     "[| AuthReqData = {|Number LID_M, Number XID, HOIData, HOD|};
  9.1095 -         sign (priSK M) {|AuthReqData, Hash P_I|} \<in> parts (knows Spy evs);
  9.1096 -         evs \<in> set_pur;  M \<notin> bad|]
  9.1097 -   ==> \<exists>j trans KM.
  9.1098 -           Notes M {|Number LID_M, Agent (PG j), trans |} \<in> set evs &
  9.1099 -             Says M (PG j)
  9.1100 -               (EncB (priSK M) KM (pubEK (PG j)) AuthReqData P_I)
  9.1101 -              \<in> set evs"
  9.1102 -apply (rule refl [THEN P_verifies_AuthReq, THEN exE])
  9.1103 -apply (auto simp add: sign_def)
  9.1104 -done
  9.1105 -
  9.1106 -text{*A variant of @{text M_verifies_Signed_PReq} with explicit PI information.
  9.1107 -  Even here we cannot be certain about what C sent to M, since a bad
  9.1108 -  PG could have replaced the two key fields.  (NOT USED)*}
  9.1109 -lemma Signed_PReq_imp_Says_Cardholder:
  9.1110 -     "[| MsgDualSign = {|Hash PIData, Hash OIData|};
  9.1111 -         OIData = {|Number LID_M, Number XID, Nonce Chall_C, HOD, etc|};
  9.1112 -         PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M,
  9.1113 -                    TransStain|};
  9.1114 -         PIData = {|PIHead, PANData|};
  9.1115 -         Crypt (priSK C) (Hash MsgDualSign) \<in> parts (knows Spy evs);
  9.1116 -         M = Merchant i;  C = Cardholder k;  C \<notin> bad;  evs \<in> set_pur|]
  9.1117 -      ==> \<exists>KC EKj.
  9.1118 -            Says C M {|{|sign (priSK C) MsgDualSign,
  9.1119 -                       EXcrypt KC EKj {|PIHead, Hash OIData|} PANData|},
  9.1120 -                       OIData, Hash PIData|}
  9.1121 -              \<in> set evs"
  9.1122 -apply clarify
  9.1123 -apply (erule rev_mp)
  9.1124 -apply (erule rev_mp)
  9.1125 -apply (erule set_pur.induct, simp_all, auto)
  9.1126 -done
  9.1127 -
  9.1128 -text{*When P receives an AuthReq and a dual signature, he knows that C and M
  9.1129 -  agree on the essential details.  PurchAmt however is never sent by M to
  9.1130 -  P; instead C and M both send 
  9.1131 -     @{term "HOD = Hash{|Number OrderDesc, Number PurchAmt|}"}
  9.1132 -  and P compares the two copies of HOD.
  9.1133 -
  9.1134 -  Agreement can't be proved for some things, including the symmetric keys
  9.1135 -  used in the digital envelopes.  On the other hand, M knows the true identity
  9.1136 -  of PG (namely j'), and sends AReq there; he can't, however, check that
  9.1137 -  the EXcrypt involves the correct PG's key.
  9.1138 -*}
  9.1139 -theorem P_sees_CM_agreement:
  9.1140 -     "[| AuthReqData = {|Number LID_M, Number XID, HOIData, HOD|};
  9.1141 -         KC \<in> symKeys;
  9.1142 -         Gets (PG j) (EncB (priSK M) KM (pubEK (PG j)) AuthReqData P_I)
  9.1143 -           \<in> set evs;
  9.1144 -         C = Cardholder k;
  9.1145 -         PI_sign = sign (priSK C) {|Hash PIData, HOIData|};
  9.1146 -         P_I = {|PI_sign,
  9.1147 -                 EXcrypt KC (pubEK (PG j)) {|PIHead, HOIData|} PANData|};
  9.1148 -         PANData = {|Pan (pan C), Nonce (PANSecret k)|};
  9.1149 -         PIData = {|PIHead, PANData|};
  9.1150 -         PIHead = {|Number LID_M, Number XID, HOD, Number PurchAmt, Agent M,
  9.1151 -                    TransStain|};
  9.1152 -         evs \<in> set_pur;  C \<notin> bad;  M \<notin> bad|]
  9.1153 -  ==> \<exists>OIData OrderDesc KM' trans j' KC' KC'' P_I' P_I''.
  9.1154 -           HOD = Hash{|Number OrderDesc, Number PurchAmt|} &
  9.1155 -           HOIData = Hash OIData &
  9.1156 -           Notes M {|Number LID_M, Agent (PG j'), trans|} \<in> set evs &
  9.1157 -           Says C M {|P_I', OIData, Hash PIData|} \<in> set evs &
  9.1158 -           Says M (PG j') (EncB (priSK M) KM' (pubEK (PG j'))
  9.1159 -                           AuthReqData P_I'')  \<in>  set evs &
  9.1160 -           P_I' = {|PI_sign,
  9.1161 -             EXcrypt KC' (pubEK (PG j')) {|PIHead, Hash OIData|} PANData|} &
  9.1162 -           P_I'' = {|PI_sign,
  9.1163 -             EXcrypt KC'' (pubEK (PG j)) {|PIHead, Hash OIData|} PANData|}"
  9.1164 -apply clarify
  9.1165 -apply (rule exE)
  9.1166 -apply (rule P_verifies_Signed_PReq [OF refl refl refl])
  9.1167 -apply (simp (no_asm_use) add: sign_def EncB_def, blast)
  9.1168 -apply (assumption+, clarify, simp)
  9.1169 -apply (drule Gets_imp_knows_Spy [THEN parts.Inj], assumption)
  9.1170 -apply (blast elim: EncB_partsE dest: refl [THEN M_Says_AuthReq] unique_LID_M2)
  9.1171 -done
  9.1172 -
  9.1173 -end
    10.1 --- a/src/HOL/SET-Protocol/ROOT.ML	Tue Oct 20 19:52:04 2009 +0200
    10.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.3 @@ -1,10 +0,0 @@
    10.4 -(*  Title:      HOL/SET-Protocol/ROOT.ML
    10.5 -    ID:         $Id$
    10.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    10.7 -    Copyright   2003  University of Cambridge
    10.8 -
    10.9 -Root file for the SET protocol proofs.
   10.10 -*)
   10.11 -
   10.12 -no_document use_thy "Nat_Int_Bij";
   10.13 -use_thys ["Cardholder_Registration", "Merchant_Registration", "Purchase"];
    11.1 --- a/src/HOL/SET-Protocol/document/root.tex	Tue Oct 20 19:52:04 2009 +0200
    11.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.3 @@ -1,27 +0,0 @@
    11.4 -\documentclass[10pt,a4paper,twoside]{article}
    11.5 -\usepackage{graphicx}
    11.6 -\usepackage{latexsym,theorem}
    11.7 -\usepackage{isabelle,isabellesym}
    11.8 -\usepackage{pdfsetup}\urlstyle{rm}
    11.9 -
   11.10 -\begin{document}
   11.11 -
   11.12 -\pagestyle{headings}
   11.13 -\pagenumbering{arabic}
   11.14 -
   11.15 -\title{Verification of The SET Protocol}
   11.16 -\author{Giampaolo Bella, Fabio Massacci, Lawrence C. Paulson et al.}
   11.17 -\maketitle
   11.18 -
   11.19 -\tableofcontents
   11.20 -
   11.21 -\begin{center}
   11.22 -  \includegraphics[scale=0.5]{session_graph}  
   11.23 -\end{center}
   11.24 -
   11.25 -\newpage
   11.26 -
   11.27 -\parindent 0pt\parskip 0.5ex
   11.28 -
   11.29 -\input{session}
   11.30 -\end{document}
    12.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.2 +++ b/src/HOL/SET_Protocol/Cardholder_Registration.thy	Tue Oct 20 20:03:23 2009 +0200
    12.3 @@ -0,0 +1,1056 @@
    12.4 +(*  Title:      HOL/SET_Protocol/Cardholder_Registration.thy
    12.5 +    Author:     Giampaolo Bella
    12.6 +    Author:     Fabio Massacci
    12.7 +    Author:     Lawrence C Paulson
    12.8 +    Author:     Piero Tramontano
    12.9 +*)
   12.10 +
   12.11 +header{*The SET Cardholder Registration Protocol*}
   12.12 +
   12.13 +theory Cardholder_Registration
   12.14 +imports Public_SET
   12.15 +begin
   12.16 +
   12.17 +text{*Note: nonces seem to consist of 20 bytes.  That includes both freshness
   12.18 +challenges (Chall-EE, etc.) and important secrets (CardSecret, PANsecret)
   12.19 +*}
   12.20 +
   12.21 +text{*Simplifications involving @{text analz_image_keys_simps} appear to
   12.22 +have become much slower. The cause is unclear. However, there is a big blow-up
   12.23 +and the rewriting is very sensitive to the set of rewrite rules given.*}
   12.24 +
   12.25 +subsection{*Predicate Formalizing the Encryption Association between Keys *}
   12.26 +
   12.27 +consts
   12.28 +  KeyCryptKey :: "[key, key, event list] => bool"
   12.29 +
   12.30 +primrec
   12.31 +
   12.32 +KeyCryptKey_Nil:
   12.33 +  "KeyCryptKey DK K [] = False"
   12.34 +
   12.35 +KeyCryptKey_Cons:
   12.36 +      --{*Says is the only important case.
   12.37 +        1st case: CR5, where KC3 encrypts KC2.
   12.38 +        2nd case: any use of priEK C.
   12.39 +        Revision 1.12 has a more complicated version with separate treatment of
   12.40 +          the dependency of KC1, KC2 and KC3 on priEK (CA i.)  Not needed since
   12.41 +          priEK C is never sent (and so can't be lost except at the start). *}
   12.42 +  "KeyCryptKey DK K (ev # evs) =
   12.43 +   (KeyCryptKey DK K evs |
   12.44 +    (case ev of
   12.45 +      Says A B Z =>
   12.46 +       ((\<exists>N X Y. A \<noteq> Spy &
   12.47 +                 DK \<in> symKeys &
   12.48 +                 Z = {|Crypt DK {|Agent A, Nonce N, Key K, X|}, Y|}) |
   12.49 +        (\<exists>C. DK = priEK C))
   12.50 +    | Gets A' X => False
   12.51 +    | Notes A' X => False))"
   12.52 +
   12.53 +
   12.54 +subsection{*Predicate formalizing the association between keys and nonces *}
   12.55 +
   12.56 +consts
   12.57 +  KeyCryptNonce :: "[key, key, event list] => bool"
   12.58 +
   12.59 +primrec
   12.60 +
   12.61 +KeyCryptNonce_Nil:
   12.62 +  "KeyCryptNonce EK K [] = False"
   12.63 +
   12.64 +KeyCryptNonce_Cons:
   12.65 +  --{*Says is the only important case.
   12.66 +    1st case: CR3, where KC1 encrypts NC2 (distinct from CR5 due to EXH);
   12.67 +    2nd case: CR5, where KC3 encrypts NC3;
   12.68 +    3rd case: CR6, where KC2 encrypts NC3;
   12.69 +    4th case: CR6, where KC2 encrypts NonceCCA;
   12.70 +    5th case: any use of @{term "priEK C"} (including CardSecret).
   12.71 +    NB the only Nonces we need to keep secret are CardSecret and NonceCCA.
   12.72 +    But we can't prove @{text Nonce_compromise} unless the relation covers ALL
   12.73 +        nonces that the protocol keeps secret.
   12.74 +  *}
   12.75 +  "KeyCryptNonce DK N (ev # evs) =
   12.76 +   (KeyCryptNonce DK N evs |
   12.77 +    (case ev of
   12.78 +      Says A B Z =>
   12.79 +       A \<noteq> Spy &
   12.80 +       ((\<exists>X Y. DK \<in> symKeys &
   12.81 +               Z = (EXHcrypt DK X {|Agent A, Nonce N|} Y)) |
   12.82 +        (\<exists>X Y. DK \<in> symKeys &
   12.83 +               Z = {|Crypt DK {|Agent A, Nonce N, X|}, Y|}) |
   12.84 +        (\<exists>K i X Y.
   12.85 +          K \<in> symKeys &
   12.86 +          Z = Crypt K {|sign (priSK (CA i)) {|Agent B, Nonce N, X|}, Y|} &
   12.87 +          (DK=K | KeyCryptKey DK K evs)) |
   12.88 +        (\<exists>K C NC3 Y.
   12.89 +          K \<in> symKeys &
   12.90 +          Z = Crypt K
   12.91 +                {|sign (priSK C) {|Agent B, Nonce NC3, Agent C, Nonce N|},
   12.92 +                  Y|} &
   12.93 +          (DK=K | KeyCryptKey DK K evs)) |
   12.94 +        (\<exists>C. DK = priEK C))
   12.95 +    | Gets A' X => False
   12.96 +    | Notes A' X => False))"
   12.97 +
   12.98 +
   12.99 +subsection{*Formal protocol definition *}
  12.100 +
  12.101 +inductive_set
  12.102 +  set_cr :: "event list set"
  12.103 +where
  12.104 +
  12.105 +  Nil:    --{*Initial trace is empty*}
  12.106 +          "[] \<in> set_cr"
  12.107 +
  12.108 +| Fake:    --{*The spy MAY say anything he CAN say.*}
  12.109 +           "[| evsf \<in> set_cr; X \<in> synth (analz (knows Spy evsf)) |]
  12.110 +            ==> Says Spy B X  # evsf \<in> set_cr"
  12.111 +
  12.112 +| Reception: --{*If A sends a message X to B, then B might receive it*}
  12.113 +             "[| evsr \<in> set_cr; Says A B X \<in> set evsr |]
  12.114 +              ==> Gets B X  # evsr \<in> set_cr"
  12.115 +
  12.116 +| SET_CR1: --{*CardCInitReq: C initiates a run, sending a nonce to CCA*}
  12.117 +             "[| evs1 \<in> set_cr;  C = Cardholder k;  Nonce NC1 \<notin> used evs1 |]
  12.118 +              ==> Says C (CA i) {|Agent C, Nonce NC1|} # evs1 \<in> set_cr"
  12.119 +
  12.120 +| SET_CR2: --{*CardCInitRes: CA responds sending NC1 and its certificates*}
  12.121 +             "[| evs2 \<in> set_cr;
  12.122 +                 Gets (CA i) {|Agent C, Nonce NC1|} \<in> set evs2 |]
  12.123 +              ==> Says (CA i) C
  12.124 +                       {|sign (priSK (CA i)) {|Agent C, Nonce NC1|},
  12.125 +                         cert (CA i) (pubEK (CA i)) onlyEnc (priSK RCA),
  12.126 +                         cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|}
  12.127 +                    # evs2 \<in> set_cr"
  12.128 +
  12.129 +| SET_CR3:
  12.130 +   --{*RegFormReq: C sends his PAN and a new nonce to CA.
  12.131 +   C verifies that
  12.132 +    - nonce received is the same as that sent;
  12.133 +    - certificates are signed by RCA;
  12.134 +    - certificates are an encryption certificate (flag is onlyEnc) and a
  12.135 +      signature certificate (flag is onlySig);
  12.136 +    - certificates pertain to the CA that C contacted (this is done by
  12.137 +      checking the signature).
  12.138 +   C generates a fresh symmetric key KC1.
  12.139 +   The point of encrypting @{term "{|Agent C, Nonce NC2, Hash (Pan(pan C))|}"}
  12.140 +   is not clear. *}
  12.141 +"[| evs3 \<in> set_cr;  C = Cardholder k;
  12.142 +    Nonce NC2 \<notin> used evs3;
  12.143 +    Key KC1 \<notin> used evs3; KC1 \<in> symKeys;
  12.144 +    Gets C {|sign (invKey SKi) {|Agent X, Nonce NC1|},
  12.145 +             cert (CA i) EKi onlyEnc (priSK RCA),
  12.146 +             cert (CA i) SKi onlySig (priSK RCA)|}
  12.147 +       \<in> set evs3;
  12.148 +    Says C (CA i) {|Agent C, Nonce NC1|} \<in> set evs3|]
  12.149 + ==> Says C (CA i) (EXHcrypt KC1 EKi {|Agent C, Nonce NC2|} (Pan(pan C)))
  12.150 +       # Notes C {|Key KC1, Agent (CA i)|}
  12.151 +       # evs3 \<in> set_cr"
  12.152 +
  12.153 +| SET_CR4:
  12.154 +    --{*RegFormRes:
  12.155 +    CA responds sending NC2 back with a new nonce NCA, after checking that
  12.156 +     - the digital envelope is correctly encrypted by @{term "pubEK (CA i)"}
  12.157 +     - the entire message is encrypted with the same key found inside the
  12.158 +       envelope (here, KC1) *}
  12.159 +"[| evs4 \<in> set_cr;
  12.160 +    Nonce NCA \<notin> used evs4;  KC1 \<in> symKeys;
  12.161 +    Gets (CA i) (EXHcrypt KC1 EKi {|Agent C, Nonce NC2|} (Pan(pan X)))
  12.162 +       \<in> set evs4 |]
  12.163 +  ==> Says (CA i) C
  12.164 +          {|sign (priSK (CA i)) {|Agent C, Nonce NC2, Nonce NCA|},
  12.165 +            cert (CA i) (pubEK (CA i)) onlyEnc (priSK RCA),
  12.166 +            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|}
  12.167 +       # evs4 \<in> set_cr"
  12.168 +
  12.169 +| SET_CR5:
  12.170 +   --{*CertReq: C sends his PAN, a new nonce, its proposed public signature key
  12.171 +       and its half of the secret value to CA.
  12.172 +       We now assume that C has a fixed key pair, and he submits (pubSK C).
  12.173 +       The protocol does not require this key to be fresh.
  12.174 +       The encryption below is actually EncX.*}
  12.175 +"[| evs5 \<in> set_cr;  C = Cardholder k;
  12.176 +    Nonce NC3 \<notin> used evs5;  Nonce CardSecret \<notin> used evs5; NC3\<noteq>CardSecret;
  12.177 +    Key KC2 \<notin> used evs5; KC2 \<in> symKeys;
  12.178 +    Key KC3 \<notin> used evs5; KC3 \<in> symKeys; KC2\<noteq>KC3;
  12.179 +    Gets C {|sign (invKey SKi) {|Agent C, Nonce NC2, Nonce NCA|},
  12.180 +             cert (CA i) EKi onlyEnc (priSK RCA),
  12.181 +             cert (CA i) SKi onlySig (priSK RCA) |}
  12.182 +        \<in> set evs5;
  12.183 +    Says C (CA i) (EXHcrypt KC1 EKi {|Agent C, Nonce NC2|} (Pan(pan C)))
  12.184 +         \<in> set evs5 |]
  12.185 +==> Says C (CA i)
  12.186 +         {|Crypt KC3
  12.187 +             {|Agent C, Nonce NC3, Key KC2, Key (pubSK C),
  12.188 +               Crypt (priSK C)
  12.189 +                 (Hash {|Agent C, Nonce NC3, Key KC2,
  12.190 +                         Key (pubSK C), Pan (pan C), Nonce CardSecret|})|},
  12.191 +           Crypt EKi {|Key KC3, Pan (pan C), Nonce CardSecret|} |}
  12.192 +    # Notes C {|Key KC2, Agent (CA i)|}
  12.193 +    # Notes C {|Key KC3, Agent (CA i)|}
  12.194 +    # evs5 \<in> set_cr"
  12.195 +
  12.196 +
  12.197 +  --{* CertRes: CA responds sending NC3 back with its half of the secret value,
  12.198 +   its signature certificate and the new cardholder signature
  12.199 +   certificate.  CA checks to have never certified the key proposed by C.
  12.200 +   NOTE: In Merchant Registration, the corresponding rule (4)
  12.201 +   uses the "sign" primitive. The encryption below is actually @{term EncK}, 
  12.202 +   which is just @{term "Crypt K (sign SK X)"}.
  12.203 +*}
  12.204 +
  12.205 +| SET_CR6:
  12.206 +"[| evs6 \<in> set_cr;
  12.207 +    Nonce NonceCCA \<notin> used evs6;
  12.208 +    KC2 \<in> symKeys;  KC3 \<in> symKeys;  cardSK \<notin> symKeys;
  12.209 +    Notes (CA i) (Key cardSK) \<notin> set evs6;
  12.210 +    Gets (CA i)
  12.211 +      {|Crypt KC3 {|Agent C, Nonce NC3, Key KC2, Key cardSK,
  12.212 +                    Crypt (invKey cardSK)
  12.213 +                      (Hash {|Agent C, Nonce NC3, Key KC2,
  12.214 +                              Key cardSK, Pan (pan C), Nonce CardSecret|})|},
  12.215 +        Crypt (pubEK (CA i)) {|Key KC3, Pan (pan C), Nonce CardSecret|} |}
  12.216 +      \<in> set evs6 |]
  12.217 +==> Says (CA i) C
  12.218 +         (Crypt KC2
  12.219 +          {|sign (priSK (CA i))
  12.220 +                 {|Agent C, Nonce NC3, Agent(CA i), Nonce NonceCCA|},
  12.221 +            certC (pan C) cardSK (XOR(CardSecret,NonceCCA)) onlySig (priSK (CA i)),
  12.222 +            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})
  12.223 +      # Notes (CA i) (Key cardSK)
  12.224 +      # evs6 \<in> set_cr"
  12.225 +
  12.226 +
  12.227 +declare Says_imp_knows_Spy [THEN parts.Inj, dest]
  12.228 +declare parts.Body [dest]
  12.229 +declare analz_into_parts [dest]
  12.230 +declare Fake_parts_insert_in_Un [dest]
  12.231 +
  12.232 +text{*A "possibility property": there are traces that reach the end.
  12.233 +      An unconstrained proof with many subgoals.*}
  12.234 +
  12.235 +lemma Says_to_Gets:
  12.236 +     "Says A B X # evs \<in> set_cr ==> Gets B X # Says A B X # evs \<in> set_cr"
  12.237 +by (rule set_cr.Reception, auto)
  12.238 +
  12.239 +text{*The many nonces and keys generated, some simultaneously, force us to
  12.240 +  introduce them explicitly as shown below.*}
  12.241 +lemma possibility_CR6:
  12.242 +     "[|NC1 < (NC2::nat);  NC2 < NC3;  NC3 < NCA ;
  12.243 +        NCA < NonceCCA;  NonceCCA < CardSecret;
  12.244 +        KC1 < (KC2::key);  KC2 < KC3;
  12.245 +        KC1 \<in> symKeys;  Key KC1 \<notin> used [];
  12.246 +        KC2 \<in> symKeys;  Key KC2 \<notin> used [];
  12.247 +        KC3 \<in> symKeys;  Key KC3 \<notin> used [];
  12.248 +        C = Cardholder k|]
  12.249 +   ==> \<exists>evs \<in> set_cr.
  12.250 +       Says (CA i) C
  12.251 +            (Crypt KC2
  12.252 +             {|sign (priSK (CA i))
  12.253 +                    {|Agent C, Nonce NC3, Agent(CA i), Nonce NonceCCA|},
  12.254 +               certC (pan C) (pubSK (Cardholder k)) (XOR(CardSecret,NonceCCA))
  12.255 +                     onlySig (priSK (CA i)),
  12.256 +               cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})
  12.257 +          \<in> set evs"
  12.258 +apply (intro exI bexI)
  12.259 +apply (rule_tac [2] 
  12.260 +       set_cr.Nil 
  12.261 +        [THEN set_cr.SET_CR1 [of concl: C i NC1], 
  12.262 +         THEN Says_to_Gets, 
  12.263 +         THEN set_cr.SET_CR2 [of concl: i C NC1], 
  12.264 +         THEN Says_to_Gets,  
  12.265 +         THEN set_cr.SET_CR3 [of concl: C i KC1 _ NC2], 
  12.266 +         THEN Says_to_Gets,  
  12.267 +         THEN set_cr.SET_CR4 [of concl: i C NC2 NCA], 
  12.268 +         THEN Says_to_Gets,  
  12.269 +         THEN set_cr.SET_CR5 [of concl: C i KC3 NC3 KC2 CardSecret],
  12.270 +         THEN Says_to_Gets,  
  12.271 +         THEN set_cr.SET_CR6 [of concl: i C KC2]])
  12.272 +apply basic_possibility
  12.273 +apply (simp_all (no_asm_simp) add: symKeys_neq_imp_neq)
  12.274 +done
  12.275 +
  12.276 +text{*General facts about message reception*}
  12.277 +lemma Gets_imp_Says:
  12.278 +     "[| Gets B X \<in> set evs; evs \<in> set_cr |] ==> \<exists>A. Says A B X \<in> set evs"
  12.279 +apply (erule rev_mp)
  12.280 +apply (erule set_cr.induct, auto)
  12.281 +done
  12.282 +
  12.283 +lemma Gets_imp_knows_Spy:
  12.284 +     "[| Gets B X \<in> set evs; evs \<in> set_cr |]  ==> X \<in> knows Spy evs"
  12.285 +by (blast dest!: Gets_imp_Says Says_imp_knows_Spy)
  12.286 +declare Gets_imp_knows_Spy [THEN parts.Inj, dest]
  12.287 +
  12.288 +
  12.289 +subsection{*Proofs on keys *}
  12.290 +
  12.291 +text{*Spy never sees an agent's private keys! (unless it's bad at start)*}
  12.292 +
  12.293 +lemma Spy_see_private_Key [simp]:
  12.294 +     "evs \<in> set_cr
  12.295 +      ==> (Key(invKey (publicKey b A)) \<in> parts(knows Spy evs)) = (A \<in> bad)"
  12.296 +by (erule set_cr.induct, auto)
  12.297 +
  12.298 +lemma Spy_analz_private_Key [simp]:
  12.299 +     "evs \<in> set_cr ==>
  12.300 +     (Key(invKey (publicKey b A)) \<in> analz(knows Spy evs)) = (A \<in> bad)"
  12.301 +by auto
  12.302 +
  12.303 +declare Spy_see_private_Key [THEN [2] rev_iffD1, dest!]
  12.304 +declare Spy_analz_private_Key [THEN [2] rev_iffD1, dest!]
  12.305 +
  12.306 +
  12.307 +subsection{*Begin Piero's Theorems on Certificates*}
  12.308 +text{*Trivial in the current model, where certificates by RCA are secure *}
  12.309 +
  12.310 +lemma Crypt_valid_pubEK:
  12.311 +     "[| Crypt (priSK RCA) {|Agent C, Key EKi, onlyEnc|}
  12.312 +           \<in> parts (knows Spy evs);
  12.313 +         evs \<in> set_cr |] ==> EKi = pubEK C"
  12.314 +apply (erule rev_mp)
  12.315 +apply (erule set_cr.induct, auto)
  12.316 +done
  12.317 +
  12.318 +lemma certificate_valid_pubEK:
  12.319 +    "[| cert C EKi onlyEnc (priSK RCA) \<in> parts (knows Spy evs);
  12.320 +        evs \<in> set_cr |]
  12.321 +     ==> EKi = pubEK C"
  12.322 +apply (unfold cert_def signCert_def)
  12.323 +apply (blast dest!: Crypt_valid_pubEK)
  12.324 +done
  12.325 +
  12.326 +lemma Crypt_valid_pubSK:
  12.327 +     "[| Crypt (priSK RCA) {|Agent C, Key SKi, onlySig|}
  12.328 +           \<in> parts (knows Spy evs);
  12.329 +         evs \<in> set_cr |] ==> SKi = pubSK C"
  12.330 +apply (erule rev_mp)
  12.331 +apply (erule set_cr.induct, auto)
  12.332 +done
  12.333 +
  12.334 +lemma certificate_valid_pubSK:
  12.335 +    "[| cert C SKi onlySig (priSK RCA) \<in> parts (knows Spy evs);
  12.336 +        evs \<in> set_cr |] ==> SKi = pubSK C"
  12.337 +apply (unfold cert_def signCert_def)
  12.338 +apply (blast dest!: Crypt_valid_pubSK)
  12.339 +done
  12.340 +
  12.341 +lemma Gets_certificate_valid:
  12.342 +     "[| Gets A {| X, cert C EKi onlyEnc (priSK RCA),
  12.343 +                      cert C SKi onlySig (priSK RCA)|} \<in> set evs;
  12.344 +         evs \<in> set_cr |]
  12.345 +      ==> EKi = pubEK C & SKi = pubSK C"
  12.346 +by (blast dest: certificate_valid_pubEK certificate_valid_pubSK)
  12.347 +
  12.348 +text{*Nobody can have used non-existent keys!*}
  12.349 +lemma new_keys_not_used:
  12.350 +     "[|K \<in> symKeys; Key K \<notin> used evs; evs \<in> set_cr|]
  12.351 +      ==> K \<notin> keysFor (parts (knows Spy evs))"
  12.352 +apply (erule rev_mp)
  12.353 +apply (erule rev_mp)
  12.354 +apply (erule set_cr.induct)
  12.355 +apply (frule_tac [8] Gets_certificate_valid)
  12.356 +apply (frule_tac [6] Gets_certificate_valid, simp_all)
  12.357 +apply (force dest!: usedI keysFor_parts_insert) --{*Fake*}
  12.358 +apply (blast,auto)  --{*Others*}
  12.359 +done
  12.360 +
  12.361 +
  12.362 +subsection{*New versions: as above, but generalized to have the KK argument *}
  12.363 +
  12.364 +lemma gen_new_keys_not_used:
  12.365 +     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_cr |]
  12.366 +      ==> Key K \<notin> used evs --> K \<in> symKeys -->
  12.367 +          K \<notin> keysFor (parts (Key`KK Un knows Spy evs))"
  12.368 +by (auto simp add: new_keys_not_used)
  12.369 +
  12.370 +lemma gen_new_keys_not_analzd:
  12.371 +     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_cr |]
  12.372 +      ==> K \<notin> keysFor (analz (Key`KK Un knows Spy evs))"
  12.373 +by (blast intro: keysFor_mono [THEN [2] rev_subsetD]
  12.374 +          dest: gen_new_keys_not_used)
  12.375 +
  12.376 +lemma analz_Key_image_insert_eq:
  12.377 +     "[|K \<in> symKeys; Key K \<notin> used evs; evs \<in> set_cr |]
  12.378 +      ==> analz (Key ` (insert K KK) \<union> knows Spy evs) =
  12.379 +          insert (Key K) (analz (Key ` KK \<union> knows Spy evs))"
  12.380 +by (simp add: gen_new_keys_not_analzd)
  12.381 +
  12.382 +lemma Crypt_parts_imp_used:
  12.383 +     "[|Crypt K X \<in> parts (knows Spy evs);
  12.384 +        K \<in> symKeys; evs \<in> set_cr |] ==> Key K \<in> used evs"
  12.385 +apply (rule ccontr)
  12.386 +apply (force dest: new_keys_not_used Crypt_imp_invKey_keysFor)
  12.387 +done
  12.388 +
  12.389 +lemma Crypt_analz_imp_used:
  12.390 +     "[|Crypt K X \<in> analz (knows Spy evs);
  12.391 +        K \<in> symKeys; evs \<in> set_cr |] ==> Key K \<in> used evs"
  12.392 +by (blast intro: Crypt_parts_imp_used)
  12.393 +
  12.394 +
  12.395 +(*<*) 
  12.396 +subsection{*Messages signed by CA*}
  12.397 +
  12.398 +text{*Message @{text SET_CR2}: C can check CA's signature if he has received
  12.399 +     CA's certificate.*}
  12.400 +lemma CA_Says_2_lemma:
  12.401 +     "[| Crypt (priSK (CA i)) (Hash{|Agent C, Nonce NC1|})
  12.402 +           \<in> parts (knows Spy evs);
  12.403 +         evs \<in> set_cr; (CA i) \<notin> bad |]
  12.404 +     ==> \<exists>Y. Says (CA i) C {|sign (priSK (CA i)) {|Agent C, Nonce NC1|}, Y|}
  12.405 +                 \<in> set evs"
  12.406 +apply (erule rev_mp)
  12.407 +apply (erule set_cr.induct, auto)
  12.408 +done
  12.409 +
  12.410 +text{*Ever used?*}
  12.411 +lemma CA_Says_2:
  12.412 +     "[| Crypt (invKey SK) (Hash{|Agent C, Nonce NC1|})
  12.413 +           \<in> parts (knows Spy evs);
  12.414 +         cert (CA i) SK onlySig (priSK RCA) \<in> parts (knows Spy evs);
  12.415 +         evs \<in> set_cr; (CA i) \<notin> bad |]
  12.416 +      ==> \<exists>Y. Says (CA i) C {|sign (priSK (CA i)) {|Agent C, Nonce NC1|}, Y|}
  12.417 +                  \<in> set evs"
  12.418 +by (blast dest!: certificate_valid_pubSK intro!: CA_Says_2_lemma)
  12.419 +
  12.420 +
  12.421 +text{*Message @{text SET_CR4}: C can check CA's signature if he has received
  12.422 +      CA's certificate.*}
  12.423 +lemma CA_Says_4_lemma:
  12.424 +     "[| Crypt (priSK (CA i)) (Hash{|Agent C, Nonce NC2, Nonce NCA|})
  12.425 +           \<in> parts (knows Spy evs);
  12.426 +         evs \<in> set_cr; (CA i) \<notin> bad |]
  12.427 +      ==> \<exists>Y. Says (CA i) C {|sign (priSK (CA i))
  12.428 +                     {|Agent C, Nonce NC2, Nonce NCA|}, Y|} \<in> set evs"
  12.429 +apply (erule rev_mp)
  12.430 +apply (erule set_cr.induct, auto)
  12.431 +done
  12.432 +
  12.433 +text{*NEVER USED*}
  12.434 +lemma CA_Says_4:
  12.435 +     "[| Crypt (invKey SK) (Hash{|Agent C, Nonce NC2, Nonce NCA|})
  12.436 +           \<in> parts (knows Spy evs);
  12.437 +         cert (CA i) SK onlySig (priSK RCA) \<in> parts (knows Spy evs);
  12.438 +         evs \<in> set_cr; (CA i) \<notin> bad |]
  12.439 +      ==> \<exists>Y. Says (CA i) C {|sign (priSK (CA i))
  12.440 +                   {|Agent C, Nonce NC2, Nonce NCA|}, Y|} \<in> set evs"
  12.441 +by (blast dest!: certificate_valid_pubSK intro!: CA_Says_4_lemma)
  12.442 +
  12.443 +
  12.444 +text{*Message @{text SET_CR6}: C can check CA's signature if he has
  12.445 +      received CA's certificate.*}
  12.446 +lemma CA_Says_6_lemma:
  12.447 +     "[| Crypt (priSK (CA i)) 
  12.448 +               (Hash{|Agent C, Nonce NC3, Agent (CA i), Nonce NonceCCA|})
  12.449 +           \<in> parts (knows Spy evs);
  12.450 +         evs \<in> set_cr; (CA i) \<notin> bad |]
  12.451 +      ==> \<exists>Y K. Says (CA i) C (Crypt K {|sign (priSK (CA i))
  12.452 +      {|Agent C, Nonce NC3, Agent (CA i), Nonce NonceCCA|}, Y|}) \<in> set evs"
  12.453 +apply (erule rev_mp)
  12.454 +apply (erule set_cr.induct, auto)
  12.455 +done
  12.456 +
  12.457 +text{*NEVER USED*}
  12.458 +lemma CA_Says_6:
  12.459 +     "[| Crypt (invKey SK) (Hash{|Agent C, Nonce NC3, Agent (CA i), Nonce NonceCCA|})
  12.460 +           \<in> parts (knows Spy evs);
  12.461 +         cert (CA i) SK onlySig (priSK RCA) \<in> parts (knows Spy evs);
  12.462 +         evs \<in> set_cr; (CA i) \<notin> bad |]
  12.463 +      ==> \<exists>Y K. Says (CA i) C (Crypt K {|sign (priSK (CA i))
  12.464 +                    {|Agent C, Nonce NC3, Agent (CA i), Nonce NonceCCA|}, Y|}) \<in> set evs"
  12.465 +by (blast dest!: certificate_valid_pubSK intro!: CA_Says_6_lemma)
  12.466 +(*>*)
  12.467 +
  12.468 +
  12.469 +subsection{*Useful lemmas *}
  12.470 +
  12.471 +text{*Rewriting rule for private encryption keys.  Analogous rewriting rules
  12.472 +for other keys aren't needed.*}
  12.473 +
  12.474 +lemma parts_image_priEK:
  12.475 +     "[|Key (priEK C) \<in> parts (Key`KK Un (knows Spy evs));
  12.476 +        evs \<in> set_cr|] ==> priEK C \<in> KK | C \<in> bad"
  12.477 +by auto
  12.478 +
  12.479 +text{*trivial proof because (priEK C) never appears even in (parts evs)*}
  12.480 +lemma analz_image_priEK:
  12.481 +     "evs \<in> set_cr ==>
  12.482 +          (Key (priEK C) \<in> analz (Key`KK Un (knows Spy evs))) =
  12.483 +          (priEK C \<in> KK | C \<in> bad)"
  12.484 +by (blast dest!: parts_image_priEK intro: analz_mono [THEN [2] rev_subsetD])
  12.485 +
  12.486 +
  12.487 +subsection{*Secrecy of Session Keys *}
  12.488 +
  12.489 +subsubsection{*Lemmas about the predicate KeyCryptKey *}
  12.490 +
  12.491 +text{*A fresh DK cannot be associated with any other
  12.492 +  (with respect to a given trace). *}
  12.493 +lemma DK_fresh_not_KeyCryptKey:
  12.494 +     "[| Key DK \<notin> used evs; evs \<in> set_cr |] ==> ~ KeyCryptKey DK K evs"
  12.495 +apply (erule rev_mp)
  12.496 +apply (erule set_cr.induct)
  12.497 +apply (simp_all (no_asm_simp))
  12.498 +apply (blast dest: Crypt_analz_imp_used)+
  12.499 +done
  12.500 +
  12.501 +text{*A fresh K cannot be associated with any other.  The assumption that
  12.502 +  DK isn't a private encryption key may be an artifact of the particular
  12.503 +  definition of KeyCryptKey.*}
  12.504 +lemma K_fresh_not_KeyCryptKey:
  12.505 +     "[|\<forall>C. DK \<noteq> priEK C; Key K \<notin> used evs|] ==> ~ KeyCryptKey DK K evs"
  12.506 +apply (induct evs)
  12.507 +apply (auto simp add: parts_insert2 split add: event.split)
  12.508 +done
  12.509 +
  12.510 +
  12.511 +text{*This holds because if (priEK (CA i)) appears in any traffic then it must
  12.512 +  be known to the Spy, by @{term Spy_see_private_Key}*}
  12.513 +lemma cardSK_neq_priEK:
  12.514 +     "[|Key cardSK \<notin> analz (knows Spy evs);
  12.515 +        Key cardSK : parts (knows Spy evs);
  12.516 +        evs \<in> set_cr|] ==> cardSK \<noteq> priEK C"
  12.517 +by blast
  12.518 +
  12.519 +lemma not_KeyCryptKey_cardSK [rule_format (no_asm)]:
  12.520 +     "[|cardSK \<notin> symKeys;  \<forall>C. cardSK \<noteq> priEK C;  evs \<in> set_cr|] ==>
  12.521 +      Key cardSK \<notin> analz (knows Spy evs) --> ~ KeyCryptKey cardSK K evs"
  12.522 +by (erule set_cr.induct, analz_mono_contra, auto)
  12.523 +
  12.524 +text{*Lemma for message 5: pubSK C is never used to encrypt Keys.*}
  12.525 +lemma pubSK_not_KeyCryptKey [simp]: "~ KeyCryptKey (pubSK C) K evs"
  12.526 +apply (induct_tac "evs")
  12.527 +apply (auto simp add: parts_insert2 split add: event.split)
  12.528 +done
  12.529 +
  12.530 +text{*Lemma for message 6: either cardSK is compromised (when we don't care)
  12.531 +  or else cardSK hasn't been used to encrypt K.  Previously we treated
  12.532 +  message 5 in the same way, but the current model assumes that rule
  12.533 +  @{text SET_CR5} is executed only by honest agents.*}
  12.534 +lemma msg6_KeyCryptKey_disj:
  12.535 +     "[|Gets B {|Crypt KC3 {|Agent C, Nonce N, Key KC2, Key cardSK, X|}, Y|}
  12.536 +          \<in> set evs;
  12.537 +        cardSK \<notin> symKeys;  evs \<in> set_cr|]
  12.538 +      ==> Key cardSK \<in> analz (knows Spy evs) |
  12.539 +          (\<forall>K. ~ KeyCryptKey cardSK K evs)"
  12.540 +by (blast dest: not_KeyCryptKey_cardSK intro: cardSK_neq_priEK)
  12.541 +
  12.542 +text{*As usual: we express the property as a logical equivalence*}
  12.543 +lemma Key_analz_image_Key_lemma:
  12.544 +     "P --> (Key K \<in> analz (Key`KK Un H)) --> (K \<in> KK | Key K \<in> analz H)
  12.545 +      ==>
  12.546 +      P --> (Key K \<in> analz (Key`KK Un H)) = (K \<in> KK | Key K \<in> analz H)"
  12.547 +by (blast intro: analz_mono [THEN [2] rev_subsetD])
  12.548 +
  12.549 +method_setup valid_certificate_tac = {*
  12.550 +  Args.goal_spec >> (fn quant => K (SIMPLE_METHOD'' quant
  12.551 +    (fn i =>
  12.552 +      EVERY [ftac @{thm Gets_certificate_valid} i,
  12.553 +             assume_tac i,
  12.554 +             etac conjE i, REPEAT (hyp_subst_tac i)])))
  12.555 +*} ""
  12.556 +
  12.557 +text{*The @{text "(no_asm)"} attribute is essential, since it retains
  12.558 +  the quantifier and allows the simprule's condition to itself be simplified.*}
  12.559 +lemma symKey_compromise [rule_format (no_asm)]:
  12.560 +     "evs \<in> set_cr ==>
  12.561 +      (\<forall>SK KK. SK \<in> symKeys \<longrightarrow> (\<forall>K \<in> KK. ~ KeyCryptKey K SK evs)   -->
  12.562 +               (Key SK \<in> analz (Key`KK Un (knows Spy evs))) =
  12.563 +               (SK \<in> KK | Key SK \<in> analz (knows Spy evs)))"
  12.564 +apply (erule set_cr.induct)
  12.565 +apply (rule_tac [!] allI) +
  12.566 +apply (rule_tac [!] impI [THEN Key_analz_image_Key_lemma, THEN impI])+
  12.567 +apply (valid_certificate_tac [8]) --{*for message 5*}
  12.568 +apply (valid_certificate_tac [6]) --{*for message 5*}
  12.569 +apply (erule_tac [9] msg6_KeyCryptKey_disj [THEN disjE])
  12.570 +apply (simp_all
  12.571 +         del: image_insert image_Un imp_disjL
  12.572 +         add: analz_image_keys_simps analz_knows_absorb
  12.573 +              analz_Key_image_insert_eq notin_image_iff
  12.574 +              K_fresh_not_KeyCryptKey
  12.575 +              DK_fresh_not_KeyCryptKey ball_conj_distrib
  12.576 +              analz_image_priEK disj_simps)
  12.577 +  --{*9 seconds on a 1.6GHz machine*}
  12.578 +apply spy_analz
  12.579 +apply blast  --{*3*}
  12.580 +apply blast  --{*5*}
  12.581 +done
  12.582 +
  12.583 +text{*The remaining quantifiers seem to be essential.
  12.584 +  NO NEED to assume the cardholder's OK: bad cardholders don't do anything
  12.585 +  wrong!!*}
  12.586 +lemma symKey_secrecy [rule_format]:
  12.587 +     "[|CA i \<notin> bad;  K \<in> symKeys;  evs \<in> set_cr|]
  12.588 +      ==> \<forall>X c. Says (Cardholder c) (CA i) X \<in> set evs -->
  12.589 +                Key K \<in> parts{X} -->
  12.590 +                Cardholder c \<notin> bad -->
  12.591 +                Key K \<notin> analz (knows Spy evs)"
  12.592 +apply (erule set_cr.induct)
  12.593 +apply (frule_tac [8] Gets_certificate_valid) --{*for message 5*}
  12.594 +apply (frule_tac [6] Gets_certificate_valid) --{*for message 3*}
  12.595 +apply (erule_tac [11] msg6_KeyCryptKey_disj [THEN disjE])
  12.596 +apply (simp_all del: image_insert image_Un imp_disjL
  12.597 +         add: symKey_compromise fresh_notin_analz_knows_Spy
  12.598 +              analz_image_keys_simps analz_knows_absorb
  12.599 +              analz_Key_image_insert_eq notin_image_iff
  12.600 +              K_fresh_not_KeyCryptKey
  12.601 +              DK_fresh_not_KeyCryptKey
  12.602 +              analz_image_priEK)
  12.603 +  --{*2.5 seconds on a 1.6GHz machine*}
  12.604 +apply spy_analz  --{*Fake*}
  12.605 +apply (auto intro: analz_into_parts [THEN usedI] in_parts_Says_imp_used)
  12.606 +done
  12.607 +
  12.608 +
  12.609 +subsection{*Primary Goals of Cardholder Registration *}
  12.610 +
  12.611 +text{*The cardholder's certificate really was created by the CA, provided the
  12.612 +    CA is uncompromised *}
  12.613 +
  12.614 +text{*Lemma concerning the actual signed message digest*}
  12.615 +lemma cert_valid_lemma:
  12.616 +     "[|Crypt (priSK (CA i)) {|Hash {|Nonce N, Pan(pan C)|}, Key cardSK, N1|}
  12.617 +          \<in> parts (knows Spy evs);
  12.618 +        CA i \<notin> bad; evs \<in> set_cr|]
  12.619 +  ==> \<exists>KC2 X Y. Says (CA i) C
  12.620 +                     (Crypt KC2 
  12.621 +                       {|X, certC (pan C) cardSK N onlySig (priSK (CA i)), Y|})
  12.622 +                  \<in> set evs"
  12.623 +apply (erule rev_mp)
  12.624 +apply (erule set_cr.induct)
  12.625 +apply (simp_all (no_asm_simp))
  12.626 +apply auto
  12.627 +done
  12.628 +
  12.629 +text{*Pre-packaged version for cardholder.  We don't try to confirm the values
  12.630 +  of KC2, X and Y, since they are not important.*}
  12.631 +lemma certificate_valid_cardSK:
  12.632 +    "[|Gets C (Crypt KC2 {|X, certC (pan C) cardSK N onlySig (invKey SKi),
  12.633 +                              cert (CA i) SKi onlySig (priSK RCA)|}) \<in> set evs;
  12.634 +        CA i \<notin> bad; evs \<in> set_cr|]
  12.635 +  ==> \<exists>KC2 X Y. Says (CA i) C
  12.636 +                     (Crypt KC2 
  12.637 +                       {|X, certC (pan C) cardSK N onlySig (priSK (CA i)), Y|})
  12.638 +                   \<in> set evs"
  12.639 +by (force dest!: Gets_imp_knows_Spy [THEN parts.Inj, THEN parts.Body]
  12.640 +                    certificate_valid_pubSK cert_valid_lemma)
  12.641 +
  12.642 +
  12.643 +lemma Hash_imp_parts [rule_format]:
  12.644 +     "evs \<in> set_cr
  12.645 +      ==> Hash{|X, Nonce N|} \<in> parts (knows Spy evs) -->
  12.646 +          Nonce N \<in> parts (knows Spy evs)"
  12.647 +apply (erule set_cr.induct, force)
  12.648 +apply (simp_all (no_asm_simp))
  12.649 +apply (blast intro: parts_mono [THEN [2] rev_subsetD])
  12.650 +done
  12.651 +
  12.652 +lemma Hash_imp_parts2 [rule_format]:
  12.653 +     "evs \<in> set_cr
  12.654 +      ==> Hash{|X, Nonce M, Y, Nonce N|} \<in> parts (knows Spy evs) -->
  12.655 +          Nonce M \<in> parts (knows Spy evs) & Nonce N \<in> parts (knows Spy evs)"
  12.656 +apply (erule set_cr.induct, force)
  12.657 +apply (simp_all (no_asm_simp))
  12.658 +apply (blast intro: parts_mono [THEN [2] rev_subsetD])
  12.659 +done
  12.660 +
  12.661 +
  12.662 +subsection{*Secrecy of Nonces*}
  12.663 +
  12.664 +subsubsection{*Lemmas about the predicate KeyCryptNonce *}
  12.665 +
  12.666 +text{*A fresh DK cannot be associated with any other
  12.667 +  (with respect to a given trace). *}
  12.668 +lemma DK_fresh_not_KeyCryptNonce:
  12.669 +     "[| DK \<in> symKeys; Key DK \<notin> used evs; evs \<in> set_cr |]
  12.670 +      ==> ~ KeyCryptNonce DK K evs"
  12.671 +apply (erule rev_mp)
  12.672 +apply (erule rev_mp)
  12.673 +apply (erule set_cr.induct)
  12.674 +apply (simp_all (no_asm_simp))
  12.675 +apply blast
  12.676 +apply blast
  12.677 +apply (auto simp add: DK_fresh_not_KeyCryptKey)
  12.678 +done
  12.679 +
  12.680 +text{*A fresh N cannot be associated with any other
  12.681 +      (with respect to a given trace). *}
  12.682 +lemma N_fresh_not_KeyCryptNonce:
  12.683 +     "\<forall>C. DK \<noteq> priEK C ==> Nonce N \<notin> used evs --> ~ KeyCryptNonce DK N evs"
  12.684 +apply (induct_tac "evs")
  12.685 +apply (case_tac [2] "a")
  12.686 +apply (auto simp add: parts_insert2)
  12.687 +done
  12.688 +
  12.689 +lemma not_KeyCryptNonce_cardSK [rule_format (no_asm)]:
  12.690 +     "[|cardSK \<notin> symKeys;  \<forall>C. cardSK \<noteq> priEK C;  evs \<in> set_cr|] ==>
  12.691 +      Key cardSK \<notin> analz (knows Spy evs) --> ~ KeyCryptNonce cardSK N evs"
  12.692 +apply (erule set_cr.induct, analz_mono_contra, simp_all)
  12.693 +apply (blast dest: not_KeyCryptKey_cardSK)  --{*6*}
  12.694 +done
  12.695 +
  12.696 +subsubsection{*Lemmas for message 5 and 6:
  12.697 +  either cardSK is compromised (when we don't care)
  12.698 +  or else cardSK hasn't been used to encrypt K. *}
  12.699 +
  12.700 +text{*Lemma for message 5: pubSK C is never used to encrypt Nonces.*}
  12.701 +lemma pubSK_not_KeyCryptNonce [simp]: "~ KeyCryptNonce (pubSK C) N evs"
  12.702 +apply (induct_tac "evs")
  12.703 +apply (auto simp add: parts_insert2 split add: event.split)
  12.704 +done
  12.705 +
  12.706 +text{*Lemma for message 6: either cardSK is compromised (when we don't care)
  12.707 +  or else cardSK hasn't been used to encrypt K.*}
  12.708 +lemma msg6_KeyCryptNonce_disj:
  12.709 +     "[|Gets B {|Crypt KC3 {|Agent C, Nonce N, Key KC2, Key cardSK, X|}, Y|}
  12.710 +          \<in> set evs;
  12.711 +        cardSK \<notin> symKeys;  evs \<in> set_cr|]
  12.712 +      ==> Key cardSK \<in> analz (knows Spy evs) |
  12.713 +          ((\<forall>K. ~ KeyCryptKey cardSK K evs) &
  12.714 +           (\<forall>N. ~ KeyCryptNonce cardSK N evs))"
  12.715 +by (blast dest: not_KeyCryptKey_cardSK not_KeyCryptNonce_cardSK
  12.716 +          intro: cardSK_neq_priEK)
  12.717 +
  12.718 +
  12.719 +text{*As usual: we express the property as a logical equivalence*}
  12.720 +lemma Nonce_analz_image_Key_lemma:
  12.721 +     "P --> (Nonce N \<in> analz (Key`KK Un H)) --> (Nonce N \<in> analz H)
  12.722 +      ==> P --> (Nonce N \<in> analz (Key`KK Un H)) = (Nonce N \<in> analz H)"
  12.723 +by (blast intro: analz_mono [THEN [2] rev_subsetD])
  12.724 +
  12.725 +
  12.726 +text{*The @{text "(no_asm)"} attribute is essential, since it retains
  12.727 +  the quantifier and allows the simprule's condition to itself be simplified.*}
  12.728 +lemma Nonce_compromise [rule_format (no_asm)]:
  12.729 +     "evs \<in> set_cr ==>
  12.730 +      (\<forall>N KK. (\<forall>K \<in> KK. ~ KeyCryptNonce K N evs)   -->
  12.731 +               (Nonce N \<in> analz (Key`KK Un (knows Spy evs))) =
  12.732 +               (Nonce N \<in> analz (knows Spy evs)))"
  12.733 +apply (erule set_cr.induct)
  12.734 +apply (rule_tac [!] allI)+
  12.735 +apply (rule_tac [!] impI [THEN Nonce_analz_image_Key_lemma])+
  12.736 +apply (frule_tac [8] Gets_certificate_valid) --{*for message 5*}
  12.737 +apply (frule_tac [6] Gets_certificate_valid) --{*for message 3*}
  12.738 +apply (frule_tac [11] msg6_KeyCryptNonce_disj)
  12.739 +apply (erule_tac [13] disjE)
  12.740 +apply (simp_all del: image_insert image_Un
  12.741 +         add: symKey_compromise
  12.742 +              analz_image_keys_simps analz_knows_absorb
  12.743 +              analz_Key_image_insert_eq notin_image_iff
  12.744 +              N_fresh_not_KeyCryptNonce
  12.745 +              DK_fresh_not_KeyCryptNonce K_fresh_not_KeyCryptKey
  12.746 +              ball_conj_distrib analz_image_priEK)
  12.747 +  --{*14 seconds on a 1.6GHz machine*}
  12.748 +apply spy_analz  --{*Fake*}
  12.749 +apply blast  --{*3*}
  12.750 +apply blast  --{*5*}
  12.751 +txt{*Message 6*}
  12.752 +apply (metis symKey_compromise)
  12.753 +  --{*cardSK compromised*}
  12.754 +txt{*Simplify again--necessary because the previous simplification introduces
  12.755 +  some logical connectives*} 
  12.756 +apply (force simp del: image_insert image_Un imp_disjL
  12.757 +          simp add: analz_image_keys_simps symKey_compromise)
  12.758 +done
  12.759 +
  12.760 +
  12.761 +subsection{*Secrecy of CardSecret: the Cardholder's secret*}
  12.762 +
  12.763 +lemma NC2_not_CardSecret:
  12.764 +     "[|Crypt EKj {|Key K, Pan p, Hash {|Agent D, Nonce N|}|}
  12.765 +          \<in> parts (knows Spy evs);
  12.766 +        Key K \<notin> analz (knows Spy evs);
  12.767 +        Nonce N \<notin> analz (knows Spy evs);
  12.768 +       evs \<in> set_cr|]
  12.769 +      ==> Crypt EKi {|Key K', Pan p', Nonce N|} \<notin> parts (knows Spy evs)"
  12.770 +apply (erule rev_mp)
  12.771 +apply (erule rev_mp)
  12.772 +apply (erule rev_mp)
  12.773 +apply (erule set_cr.induct, analz_mono_contra, simp_all)
  12.774 +apply (blast dest: Hash_imp_parts)+
  12.775 +done
  12.776 +
  12.777 +lemma KC2_secure_lemma [rule_format]:
  12.778 +     "[|U = Crypt KC3 {|Agent C, Nonce N, Key KC2, X|};
  12.779 +        U \<in> parts (knows Spy evs);
  12.780 +        evs \<in> set_cr|]
  12.781 +  ==> Nonce N \<notin> analz (knows Spy evs) -->
  12.782 +      (\<exists>k i W. Says (Cardholder k) (CA i) {|U,W|} \<in> set evs & 
  12.783 +               Cardholder k \<notin> bad & CA i \<notin> bad)"
  12.784 +apply (erule_tac P = "U \<in> ?H" in rev_mp)
  12.785 +apply (erule set_cr.induct)
  12.786 +apply (valid_certificate_tac [8])  --{*for message 5*}
  12.787 +apply (simp_all del: image_insert image_Un imp_disjL
  12.788 +         add: analz_image_keys_simps analz_knows_absorb
  12.789 +              analz_knows_absorb2 notin_image_iff)
  12.790 +  --{*4 seconds on a 1.6GHz machine*}
  12.791 +apply (simp_all (no_asm_simp)) --{*leaves 4 subgoals*}
  12.792 +apply (blast intro!: analz_insertI)+
  12.793 +done
  12.794 +
  12.795 +lemma KC2_secrecy:
  12.796 +     "[|Gets B {|Crypt K {|Agent C, Nonce N, Key KC2, X|}, Y|} \<in> set evs;
  12.797 +        Nonce N \<notin> analz (knows Spy evs);  KC2 \<in> symKeys;
  12.798 +        evs \<in> set_cr|]
  12.799 +       ==> Key KC2 \<notin> analz (knows Spy evs)"
  12.800 +by (force dest!: refl [THEN KC2_secure_lemma] symKey_secrecy)
  12.801 +
  12.802 +
  12.803 +text{*Inductive version*}
  12.804 +lemma CardSecret_secrecy_lemma [rule_format]:
  12.805 +     "[|CA i \<notin> bad;  evs \<in> set_cr|]
  12.806 +      ==> Key K \<notin> analz (knows Spy evs) -->
  12.807 +          Crypt (pubEK (CA i)) {|Key K, Pan p, Nonce CardSecret|}
  12.808 +             \<in> parts (knows Spy evs) -->
  12.809 +          Nonce CardSecret \<notin> analz (knows Spy evs)"
  12.810 +apply (erule set_cr.induct, analz_mono_contra)
  12.811 +apply (valid_certificate_tac [8]) --{*for message 5*}
  12.812 +apply (valid_certificate_tac [6]) --{*for message 5*}
  12.813 +apply (frule_tac [9] msg6_KeyCryptNonce_disj [THEN disjE])
  12.814 +apply (simp_all
  12.815 +         del: image_insert image_Un imp_disjL
  12.816 +         add: analz_image_keys_simps analz_knows_absorb
  12.817 +              analz_Key_image_insert_eq notin_image_iff
  12.818 +              EXHcrypt_def Crypt_notin_image_Key
  12.819 +              N_fresh_not_KeyCryptNonce DK_fresh_not_KeyCryptNonce
  12.820 +              ball_conj_distrib Nonce_compromise symKey_compromise
  12.821 +              analz_image_priEK)
  12.822 +  --{*2.5 seconds on a 1.6GHz machine*}
  12.823 +apply spy_analz  --{*Fake*}
  12.824 +apply (simp_all (no_asm_simp))
  12.825 +apply blast  --{*1*}
  12.826 +apply (blast dest!: Gets_imp_knows_Spy [THEN analz.Inj])  --{*2*}
  12.827 +apply blast  --{*3*}
  12.828 +apply (blast dest: NC2_not_CardSecret Gets_imp_knows_Spy [THEN analz.Inj] analz_symKeys_Decrypt)  --{*4*}
  12.829 +apply blast  --{*5*}
  12.830 +apply (blast dest: KC2_secrecy)+  --{*Message 6: two cases*}
  12.831 +done
  12.832 +
  12.833 +
  12.834 +text{*Packaged version for cardholder*}
  12.835 +lemma CardSecret_secrecy:
  12.836 +     "[|Cardholder k \<notin> bad;  CA i \<notin> bad;
  12.837 +        Says (Cardholder k) (CA i)
  12.838 +           {|X, Crypt EKi {|Key KC3, Pan p, Nonce CardSecret|}|} \<in> set evs;
  12.839 +        Gets A {|Z, cert (CA i) EKi onlyEnc (priSK RCA),
  12.840 +                    cert (CA i) SKi onlySig (priSK RCA)|} \<in> set evs;
  12.841 +        KC3 \<in> symKeys;  evs \<in> set_cr|]
  12.842 +      ==> Nonce CardSecret \<notin> analz (knows Spy evs)"
  12.843 +apply (frule Gets_certificate_valid, assumption)
  12.844 +apply (subgoal_tac "Key KC3 \<notin> analz (knows Spy evs) ")
  12.845 +apply (blast dest: CardSecret_secrecy_lemma)
  12.846 +apply (rule symKey_secrecy)
  12.847 +apply (auto simp add: parts_insert2)
  12.848 +done
  12.849 +
  12.850 +
  12.851 +subsection{*Secrecy of NonceCCA [the CA's secret] *}
  12.852 +
  12.853 +lemma NC2_not_NonceCCA:
  12.854 +     "[|Hash {|Agent C', Nonce N', Agent C, Nonce N|}
  12.855 +          \<in> parts (knows Spy evs);
  12.856 +        Nonce N \<notin> analz (knows Spy evs);
  12.857 +       evs \<in> set_cr|]
  12.858 +      ==> Crypt KC1 {|{|Agent B, Nonce N|}, Hash p|} \<notin> parts (knows Spy evs)"
  12.859 +apply (erule rev_mp)
  12.860 +apply (erule rev_mp)
  12.861 +apply (erule set_cr.induct, analz_mono_contra, simp_all)
  12.862 +apply (blast dest: Hash_imp_parts2)+
  12.863 +done
  12.864 +
  12.865 +
  12.866 +text{*Inductive version*}
  12.867 +lemma NonceCCA_secrecy_lemma [rule_format]:
  12.868 +     "[|CA i \<notin> bad;  evs \<in> set_cr|]
  12.869 +      ==> Key K \<notin> analz (knows Spy evs) -->
  12.870 +          Crypt K
  12.871 +            {|sign (priSK (CA i))
  12.872 +                   {|Agent C, Nonce N, Agent(CA i), Nonce NonceCCA|},
  12.873 +              X, Y|}
  12.874 +             \<in> parts (knows Spy evs) -->
  12.875 +          Nonce NonceCCA \<notin> analz (knows Spy evs)"
  12.876 +apply (erule set_cr.induct, analz_mono_contra)
  12.877 +apply (valid_certificate_tac [8]) --{*for message 5*}
  12.878 +apply (valid_certificate_tac [6]) --{*for message 5*}
  12.879 +apply (frule_tac [9] msg6_KeyCryptNonce_disj [THEN disjE])
  12.880 +apply (simp_all
  12.881 +         del: image_insert image_Un imp_disjL
  12.882 +         add: analz_image_keys_simps analz_knows_absorb sign_def
  12.883 +              analz_Key_image_insert_eq notin_image_iff
  12.884 +              EXHcrypt_def Crypt_notin_image_Key
  12.885 +              N_fresh_not_KeyCryptNonce DK_fresh_not_KeyCryptNonce
  12.886 +              ball_conj_distrib Nonce_compromise symKey_compromise
  12.887 +              analz_image_priEK)
  12.888 +  --{*3 seconds on a 1.6GHz machine*}
  12.889 +apply spy_analz  --{*Fake*}
  12.890 +apply blast  --{*1*}
  12.891 +apply (blast dest!: Gets_imp_knows_Spy [THEN analz.Inj])  --{*2*}
  12.892 +apply blast  --{*3*}
  12.893 +apply (blast dest: NC2_not_NonceCCA)  --{*4*}
  12.894 +apply blast  --{*5*}
  12.895 +apply (blast dest: KC2_secrecy)+  --{*Message 6: two cases*}
  12.896 +done
  12.897 +
  12.898 +
  12.899 +text{*Packaged version for cardholder*}
  12.900 +lemma NonceCCA_secrecy:
  12.901 +     "[|Cardholder k \<notin> bad;  CA i \<notin> bad;
  12.902 +        Gets (Cardholder k)
  12.903 +           (Crypt KC2
  12.904 +            {|sign (priSK (CA i)) {|Agent C, Nonce N, Agent(CA i), Nonce NonceCCA|},
  12.905 +              X, Y|}) \<in> set evs;
  12.906 +        Says (Cardholder k) (CA i)
  12.907 +           {|Crypt KC3 {|Agent C, Nonce NC3, Key KC2, X'|}, Y'|} \<in> set evs;
  12.908 +        Gets A {|Z, cert (CA i) EKi onlyEnc (priSK RCA),
  12.909 +                    cert (CA i) SKi onlySig (priSK RCA)|} \<in> set evs;
  12.910 +        KC2 \<in> symKeys;  evs \<in> set_cr|]
  12.911 +      ==> Nonce NonceCCA \<notin> analz (knows Spy evs)"
  12.912 +apply (frule Gets_certificate_valid, assumption)
  12.913 +apply (subgoal_tac "Key KC2 \<notin> analz (knows Spy evs) ")
  12.914 +apply (blast dest: NonceCCA_secrecy_lemma)
  12.915 +apply (rule symKey_secrecy)
  12.916 +apply (auto simp add: parts_insert2)
  12.917 +done
  12.918 +
  12.919 +text{*We don't bother to prove guarantees for the CA.  He doesn't care about
  12.920 +  the PANSecret: it isn't his credit card!*}
  12.921 +
  12.922 +
  12.923 +subsection{*Rewriting Rule for PANs*}
  12.924 +
  12.925 +text{*Lemma for message 6: either cardSK isn't a CA's private encryption key,
  12.926 +  or if it is then (because it appears in traffic) that CA is bad,
  12.927 +  and so the Spy knows that key already.  Either way, we can simplify
  12.928 +  the expression @{term "analz (insert (Key cardSK) X)"}.*}
  12.929 +lemma msg6_cardSK_disj:
  12.930 +     "[|Gets A {|Crypt K {|c, n, k', Key cardSK, X|}, Y|}
  12.931 +          \<in> set evs;  evs \<in> set_cr |]
  12.932 +      ==> cardSK \<notin> range(invKey o pubEK o CA) | Key cardSK \<in> knows Spy evs"
  12.933 +by auto
  12.934 +
  12.935 +lemma analz_image_pan_lemma:
  12.936 +     "(Pan P \<in> analz (Key`nE Un H)) --> (Pan P \<in> analz H)  ==>
  12.937 +      (Pan P \<in> analz (Key`nE Un H)) =   (Pan P \<in> analz H)"
  12.938 +by (blast intro: analz_mono [THEN [2] rev_subsetD])
  12.939 +
  12.940 +lemma analz_image_pan [rule_format]:
  12.941 +     "evs \<in> set_cr ==>
  12.942 +       \<forall>KK. KK <= - invKey ` pubEK ` range CA -->
  12.943 +            (Pan P \<in> analz (Key`KK Un (knows Spy evs))) =
  12.944 +            (Pan P \<in> analz (knows Spy evs))"
  12.945 +apply (erule set_cr.induct)
  12.946 +apply (rule_tac [!] allI impI)+
  12.947 +apply (rule_tac [!] analz_image_pan_lemma)
  12.948 +apply (valid_certificate_tac [8]) --{*for message 5*}
  12.949 +apply (valid_certificate_tac [6]) --{*for message 5*}
  12.950 +apply (erule_tac [9] msg6_cardSK_disj [THEN disjE])
  12.951 +apply (simp_all
  12.952 +         del: image_insert image_Un
  12.953 +         add: analz_image_keys_simps disjoint_image_iff
  12.954 +              notin_image_iff analz_image_priEK)
  12.955 +  --{*6 seconds on a 1.6GHz machine*}
  12.956 +apply spy_analz
  12.957 +apply (simp add: insert_absorb)  --{*6*}
  12.958 +done
  12.959 +
  12.960 +lemma analz_insert_pan:
  12.961 +     "[| evs \<in> set_cr;  K \<notin> invKey ` pubEK ` range CA |] ==>
  12.962 +          (Pan P \<in> analz (insert (Key K) (knows Spy evs))) =
  12.963 +          (Pan P \<in> analz (knows Spy evs))"
  12.964 +by (simp del: image_insert image_Un
  12.965 +         add: analz_image_keys_simps analz_image_pan)
  12.966 +
  12.967 +
  12.968 +text{*Confidentiality of the PAN\@.  Maybe we could combine the statements of
  12.969 +  this theorem with @{term analz_image_pan}, requiring a single induction but
  12.970 +  a much more difficult proof.*}
  12.971 +lemma pan_confidentiality:
  12.972 +     "[| Pan (pan C) \<in> analz(knows Spy evs); C \<noteq>Spy; evs :set_cr|]
  12.973 +    ==> \<exists>i X K HN.
  12.974 +        Says C (CA i) {|X, Crypt (pubEK (CA i)) {|Key K, Pan (pan C), HN|} |}
  12.975 +           \<in> set evs
  12.976 +      & (CA i) \<in> bad"
  12.977 +apply (erule rev_mp)
  12.978 +apply (erule set_cr.induct)
  12.979 +apply (valid_certificate_tac [8]) --{*for message 5*}
  12.980 +apply (valid_certificate_tac [6]) --{*for message 5*}
  12.981 +apply (erule_tac [9] msg6_cardSK_disj [THEN disjE])
  12.982 +apply (simp_all
  12.983 +         del: image_insert image_Un
  12.984 +         add: analz_image_keys_simps analz_insert_pan analz_image_pan
  12.985 +              notin_image_iff analz_image_priEK)
  12.986 +  --{*3.5 seconds on a 1.6GHz machine*}
  12.987 +apply spy_analz  --{*fake*}
  12.988 +apply blast  --{*3*}
  12.989 +apply blast  --{*5*}
  12.990 +apply (simp (no_asm_simp) add: insert_absorb)  --{*6*}
  12.991 +done
  12.992 +
  12.993 +
  12.994 +subsection{*Unicity*}
  12.995 +
  12.996 +lemma CR6_Says_imp_Notes:
  12.997 +     "[|Says (CA i) C (Crypt KC2
  12.998 +          {|sign (priSK (CA i)) {|Agent C, Nonce NC3, Agent (CA i), Nonce Y|},
  12.999 +            certC (pan C) cardSK X onlySig (priSK (CA i)),
 12.1000 +            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})  \<in> set evs;
 12.1001 +        evs \<in> set_cr |]
 12.1002 +      ==> Notes (CA i) (Key cardSK) \<in> set evs"
 12.1003 +apply (erule rev_mp)
 12.1004 +apply (erule set_cr.induct)
 12.1005 +apply (simp_all (no_asm_simp))
 12.1006 +done
 12.1007 +
 12.1008 +text{*Unicity of cardSK: it uniquely identifies the other components.  
 12.1009 +      This holds because a CA accepts a cardSK at most once.*}
 12.1010 +lemma cardholder_key_unicity:
 12.1011 +     "[|Says (CA i) C (Crypt KC2
 12.1012 +          {|sign (priSK (CA i)) {|Agent C, Nonce NC3, Agent (CA i), Nonce Y|},
 12.1013 +            certC (pan C) cardSK X onlySig (priSK (CA i)),
 12.1014 +            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})
 12.1015 +          \<in> set evs;
 12.1016 +        Says (CA i) C' (Crypt KC2'
 12.1017 +          {|sign (priSK (CA i)) {|Agent C', Nonce NC3', Agent (CA i), Nonce Y'|},
 12.1018 +            certC (pan C') cardSK X' onlySig (priSK (CA i)),
 12.1019 +            cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|})
 12.1020 +          \<in> set evs;
 12.1021 +        evs \<in> set_cr |] ==> C=C' & NC3=NC3' & X=X' & KC2=KC2' & Y=Y'"
 12.1022 +apply (erule rev_mp)
 12.1023 +apply (erule rev_mp)
 12.1024 +apply (erule set_cr.induct)
 12.1025 +apply (simp_all (no_asm_simp))
 12.1026 +apply (blast dest!: CR6_Says_imp_Notes)
 12.1027 +done
 12.1028 +
 12.1029 +
 12.1030 +(*<*)
 12.1031 +text{*UNUSED unicity result*}
 12.1032 +lemma unique_KC1:
 12.1033 +     "[|Says C B {|Crypt KC1 X, Crypt EK {|Key KC1, Y|}|}
 12.1034 +          \<in> set evs;
 12.1035 +        Says C B' {|Crypt KC1 X', Crypt EK' {|Key KC1, Y'|}|}
 12.1036 +          \<in> set evs;
 12.1037 +        C \<notin> bad;  evs \<in> set_cr|] ==> B'=B & Y'=Y"
 12.1038 +apply (erule rev_mp)
 12.1039 +apply (erule rev_mp)
 12.1040 +apply (erule set_cr.induct, auto)
 12.1041 +done
 12.1042 +
 12.1043 +text{*UNUSED unicity result*}
 12.1044 +lemma unique_KC2:
 12.1045 +     "[|Says C B {|Crypt K {|Agent C, nn, Key KC2, X|}, Y|} \<in> set evs;
 12.1046 +        Says C B' {|Crypt K' {|Agent C, nn', Key KC2, X'|}, Y'|} \<in> set evs;
 12.1047 +        C \<notin> bad;  evs \<in> set_cr|] ==> B'=B & X'=X"
 12.1048 +apply (erule rev_mp)
 12.1049 +apply (erule rev_mp)
 12.1050 +apply (erule set_cr.induct, auto)
 12.1051 +done
 12.1052 +(*>*)
 12.1053 +
 12.1054 +
 12.1055 +text{*Cannot show cardSK to be secret because it isn't assumed to be fresh
 12.1056 +  it could be a previously compromised cardSK [e.g. involving a bad CA]*}
 12.1057 +
 12.1058 +
 12.1059 +end
    13.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.2 +++ b/src/HOL/SET_Protocol/Event_SET.thy	Tue Oct 20 20:03:23 2009 +0200
    13.3 @@ -0,0 +1,198 @@
    13.4 +(*  Title:      HOL/SET_Protocol/Event_SET.thy
    13.5 +    Author:     Giampaolo Bella
    13.6 +    Author:     Fabio Massacci
    13.7 +    Author:     Lawrence C Paulson
    13.8 +*)
    13.9 +
   13.10 +header{*Theory of Events for SET*}
   13.11 +
   13.12 +theory Event_SET
   13.13 +imports Message_SET
   13.14 +begin
   13.15 +
   13.16 +text{*The Root Certification Authority*}
   13.17 +syntax        RCA :: agent
   13.18 +translations "RCA" == "CA 0"
   13.19 +
   13.20 +
   13.21 +text{*Message events*}
   13.22 +datatype
   13.23 +  event = Says  agent agent msg
   13.24 +        | Gets  agent       msg
   13.25 +        | Notes agent       msg
   13.26 +
   13.27 +
   13.28 +text{*compromised agents: keys known, Notes visible*}
   13.29 +consts bad :: "agent set"
   13.30 +
   13.31 +text{*Spy has access to his own key for spoof messages, but RCA is secure*}
   13.32 +specification (bad)
   13.33 +  Spy_in_bad     [iff]: "Spy \<in> bad"
   13.34 +  RCA_not_bad [iff]: "RCA \<notin> bad"
   13.35 +    by (rule exI [of _ "{Spy}"], simp)
   13.36 +
   13.37 +
   13.38 +subsection{*Agents' Knowledge*}
   13.39 +
   13.40 +consts  (*Initial states of agents -- parameter of the construction*)
   13.41 +  initState :: "agent => msg set"
   13.42 +  knows  :: "[agent, event list] => msg set"
   13.43 +
   13.44 +(* Message reception does not extend spy's knowledge because of
   13.45 +   reception invariant enforced by Reception rule in protocol definition*)
   13.46 +primrec
   13.47 +
   13.48 +knows_Nil:
   13.49 +  "knows A []       = initState A"
   13.50 +knows_Cons:
   13.51 +    "knows A (ev # evs) =
   13.52 +       (if A = Spy then
   13.53 +        (case ev of
   13.54 +           Says A' B X => insert X (knows Spy evs)
   13.55 +         | Gets A' X => knows Spy evs
   13.56 +         | Notes A' X  =>
   13.57 +             if A' \<in> bad then insert X (knows Spy evs) else knows Spy evs)
   13.58 +        else
   13.59 +        (case ev of
   13.60 +           Says A' B X =>
   13.61 +             if A'=A then insert X (knows A evs) else knows A evs
   13.62 +         | Gets A' X    =>
   13.63 +             if A'=A then insert X (knows A evs) else knows A evs
   13.64 +         | Notes A' X    =>
   13.65 +             if A'=A then insert X (knows A evs) else knows A evs))"
   13.66 +
   13.67 +
   13.68 +subsection{*Used Messages*}
   13.69 +
   13.70 +consts
   13.71 +  (*Set of items that might be visible to somebody:
   13.72 +    complement of the set of fresh items*)
   13.73 +  used :: "event list => msg set"
   13.74 +
   13.75 +(* As above, message reception does extend used items *)
   13.76 +primrec
   13.77 +  used_Nil:  "used []         = (UN B. parts (initState B))"
   13.78 +  used_Cons: "used (ev # evs) =
   13.79 +                 (case ev of
   13.80 +                    Says A B X => parts {X} Un (used evs)
   13.81 +                  | Gets A X   => used evs
   13.82 +                  | Notes A X  => parts {X} Un (used evs))"
   13.83 +
   13.84 +
   13.85 +
   13.86 +(* Inserted by default but later removed.  This declaration lets the file
   13.87 +be re-loaded. Addsimps [knows_Cons, used_Nil, *)
   13.88 +
   13.89 +(** Simplifying   parts (insert X (knows Spy evs))
   13.90 +      = parts {X} Un parts (knows Spy evs) -- since general case loops*)
   13.91 +
   13.92 +lemmas parts_insert_knows_A = parts_insert [of _ "knows A evs", standard]
   13.93 +
   13.94 +lemma knows_Spy_Says [simp]:
   13.95 +     "knows Spy (Says A B X # evs) = insert X (knows Spy evs)"
   13.96 +by auto
   13.97 +
   13.98 +text{*Letting the Spy see "bad" agents' notes avoids redundant case-splits
   13.99 +      on whether @{term "A=Spy"} and whether @{term "A\<in>bad"}*}
  13.100 +lemma knows_Spy_Notes [simp]:
  13.101 +     "knows Spy (Notes A X # evs) =
  13.102 +          (if A:bad then insert X (knows Spy evs) else knows Spy evs)"
  13.103 +apply auto
  13.104 +done
  13.105 +
  13.106 +lemma knows_Spy_Gets [simp]: "knows Spy (Gets A X # evs) = knows Spy evs"
  13.107 +by auto
  13.108 +
  13.109 +lemma initState_subset_knows: "initState A <= knows A evs"
  13.110 +apply (induct_tac "evs")
  13.111 +apply (auto split: event.split) 
  13.112 +done
  13.113 +
  13.114 +lemma knows_Spy_subset_knows_Spy_Says:
  13.115 +     "knows Spy evs <= knows Spy (Says A B X # evs)"
  13.116 +by auto
  13.117 +
  13.118 +lemma knows_Spy_subset_knows_Spy_Notes:
  13.119 +     "knows Spy evs <= knows Spy (Notes A X # evs)"
  13.120 +by auto
  13.121 +
  13.122 +lemma knows_Spy_subset_knows_Spy_Gets:
  13.123 +     "knows Spy evs <= knows Spy (Gets A X # evs)"
  13.124 +by auto
  13.125 +
  13.126 +(*Spy sees what is sent on the traffic*)
  13.127 +lemma Says_imp_knows_Spy [rule_format]:
  13.128 +     "Says A B X \<in> set evs --> X \<in> knows Spy evs"
  13.129 +apply (induct_tac "evs")
  13.130 +apply (auto split: event.split) 
  13.131 +done
  13.132 +
  13.133 +(*Use with addSEs to derive contradictions from old Says events containing
  13.134 +  items known to be fresh*)
  13.135 +lemmas knows_Spy_partsEs =
  13.136 +     Says_imp_knows_Spy [THEN parts.Inj, THEN revcut_rl, standard] 
  13.137 +     parts.Body [THEN revcut_rl, standard]
  13.138 +
  13.139 +
  13.140 +subsection{*The Function @{term used}*}
  13.141 +
  13.142 +lemma parts_knows_Spy_subset_used: "parts (knows Spy evs) <= used evs"
  13.143 +apply (induct_tac "evs")
  13.144 +apply (auto simp add: parts_insert_knows_A split: event.split) 
  13.145 +done
  13.146 +
  13.147 +lemmas usedI = parts_knows_Spy_subset_used [THEN subsetD, intro]
  13.148 +
  13.149 +lemma initState_subset_used: "parts (initState B) <= used evs"
  13.150 +apply (induct_tac "evs")
  13.151 +apply (auto split: event.split) 
  13.152 +done
  13.153 +
  13.154 +lemmas initState_into_used = initState_subset_used [THEN subsetD]
  13.155 +
  13.156 +lemma used_Says [simp]: "used (Says A B X # evs) = parts{X} Un used evs"
  13.157 +by auto
  13.158 +
  13.159 +lemma used_Notes [simp]: "used (Notes A X # evs) = parts{X} Un used evs"
  13.160 +by auto
  13.161 +
  13.162 +lemma used_Gets [simp]: "used (Gets A X # evs) = used evs"
  13.163 +by auto
  13.164 +
  13.165 +
  13.166 +lemma Notes_imp_parts_subset_used [rule_format]:
  13.167 +     "Notes A X \<in> set evs --> parts {X} <= used evs"
  13.168 +apply (induct_tac "evs")
  13.169 +apply (induct_tac [2] "a", auto)
  13.170 +done
  13.171 +
  13.172 +text{*NOTE REMOVAL--laws above are cleaner, as they don't involve "case"*}
  13.173 +declare knows_Cons [simp del]
  13.174 +        used_Nil [simp del] used_Cons [simp del]
  13.175 +
  13.176 +
  13.177 +text{*For proving theorems of the form @{term "X \<notin> analz (knows Spy evs) --> P"}
  13.178 +  New events added by induction to "evs" are discarded.  Provided 
  13.179 +  this information isn't needed, the proof will be much shorter, since
  13.180 +  it will omit complicated reasoning about @{term analz}.*}
  13.181 +
  13.182 +lemmas analz_mono_contra =
  13.183 +       knows_Spy_subset_knows_Spy_Says [THEN analz_mono, THEN contra_subsetD]
  13.184 +       knows_Spy_subset_knows_Spy_Notes [THEN analz_mono, THEN contra_subsetD]
  13.185 +       knows_Spy_subset_knows_Spy_Gets [THEN analz_mono, THEN contra_subsetD]
  13.186 +
  13.187 +lemmas analz_impI = impI [where P = "Y \<notin> analz (knows Spy evs)", standard]
  13.188 +
  13.189 +ML
  13.190 +{*
  13.191 +val analz_mono_contra_tac = 
  13.192 +  rtac @{thm analz_impI} THEN' 
  13.193 +  REPEAT1 o (dresolve_tac @{thms analz_mono_contra})
  13.194 +  THEN' mp_tac
  13.195 +*}
  13.196 +
  13.197 +method_setup analz_mono_contra = {*
  13.198 +    Scan.succeed (K (SIMPLE_METHOD (REPEAT_FIRST analz_mono_contra_tac))) *}
  13.199 +    "for proving theorems of the form X \<notin> analz (knows Spy evs) --> P"
  13.200 +
  13.201 +end
    14.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    14.2 +++ b/src/HOL/SET_Protocol/Merchant_Registration.thy	Tue Oct 20 20:03:23 2009 +0200
    14.3 @@ -0,0 +1,429 @@
    14.4 +(*  Title:      HOL/SET_Protocol/Merchant_Registration.thy
    14.5 +    Author:     Giampaolo Bella
    14.6 +    Author:     Fabio Massacci
    14.7 +    Author:     Lawrence C Paulson
    14.8 +*)
    14.9 +
   14.10 +header{*The SET Merchant Registration Protocol*}
   14.11 +
   14.12 +theory Merchant_Registration
   14.13 +imports Public_SET
   14.14 +begin
   14.15 +
   14.16 +text{*Copmpared with Cardholder Reigstration, @{text KeyCryptKey} is not
   14.17 +  needed: no session key encrypts another.  Instead we
   14.18 +  prove the "key compromise" theorems for sets KK that contain no private
   14.19 +  encryption keys (@{term "priEK C"}). *}
   14.20 +
   14.21 +
   14.22 +inductive_set
   14.23 +  set_mr :: "event list set"
   14.24 +where
   14.25 +
   14.26 +  Nil:    --{*Initial trace is empty*}
   14.27 +           "[] \<in> set_mr"
   14.28 +
   14.29 +
   14.30 +| Fake:    --{*The spy MAY say anything he CAN say.*}
   14.31 +           "[| evsf \<in> set_mr; X \<in> synth (analz (knows Spy evsf)) |]
   14.32 +            ==> Says Spy B X  # evsf \<in> set_mr"
   14.33 +        
   14.34 +
   14.35 +| Reception: --{*If A sends a message X to B, then B might receive it*}
   14.36 +             "[| evsr \<in> set_mr; Says A B X \<in> set evsr |]
   14.37 +              ==> Gets B X  # evsr \<in> set_mr"
   14.38 +
   14.39 +
   14.40 +| SET_MR1: --{*RegFormReq: M requires a registration form to a CA*}
   14.41 +           "[| evs1 \<in> set_mr; M = Merchant k; Nonce NM1 \<notin> used evs1 |]
   14.42 +            ==> Says M (CA i) {|Agent M, Nonce NM1|} # evs1 \<in> set_mr"
   14.43 +
   14.44 +
   14.45 +| SET_MR2: --{*RegFormRes: CA replies with the registration form and the 
   14.46 +               certificates for her keys*}
   14.47 +  "[| evs2 \<in> set_mr; Nonce NCA \<notin> used evs2;
   14.48 +      Gets (CA i) {|Agent M, Nonce NM1|} \<in> set evs2 |]
   14.49 +   ==> Says (CA i) M {|sign (priSK (CA i)) {|Agent M, Nonce NM1, Nonce NCA|},
   14.50 +                       cert (CA i) (pubEK (CA i)) onlyEnc (priSK RCA),
   14.51 +                       cert (CA i) (pubSK (CA i)) onlySig (priSK RCA) |}
   14.52 +         # evs2 \<in> set_mr"
   14.53 +
   14.54 +| SET_MR3:
   14.55 +         --{*CertReq: M submits the key pair to be certified.  The Notes
   14.56 +             event allows KM1 to be lost if M is compromised. Piero remarks
   14.57 +             that the agent mentioned inside the signature is not verified to
   14.58 +             correspond to M.  As in CR, each Merchant has fixed key pairs.  M
   14.59 +             is only optionally required to send NCA back, so M doesn't do so
   14.60 +             in the model*}
   14.61 +  "[| evs3 \<in> set_mr; M = Merchant k; Nonce NM2 \<notin> used evs3;
   14.62 +      Key KM1 \<notin> used evs3;  KM1 \<in> symKeys;
   14.63 +      Gets M {|sign (invKey SKi) {|Agent X, Nonce NM1, Nonce NCA|},
   14.64 +               cert (CA i) EKi onlyEnc (priSK RCA),
   14.65 +               cert (CA i) SKi onlySig (priSK RCA) |}
   14.66 +        \<in> set evs3;
   14.67 +      Says M (CA i) {|Agent M, Nonce NM1|} \<in> set evs3 |]
   14.68 +   ==> Says M (CA i)
   14.69 +            {|Crypt KM1 (sign (priSK M) {|Agent M, Nonce NM2,
   14.70 +                                          Key (pubSK M), Key (pubEK M)|}),
   14.71 +              Crypt EKi (Key KM1)|}
   14.72 +         # Notes M {|Key KM1, Agent (CA i)|}
   14.73 +         # evs3 \<in> set_mr"
   14.74 +
   14.75 +| SET_MR4:
   14.76 +         --{*CertRes: CA issues the certificates for merSK and merEK,
   14.77 +             while checking never to have certified the m even
   14.78 +             separately. NOTE: In Cardholder Registration the
   14.79 +             corresponding rule (6) doesn't use the "sign" primitive. "The
   14.80 +             CertRes shall be signed but not encrypted if the EE is a Merchant
   14.81 +             or Payment Gateway."-- Programmer's Guide, page 191.*}
   14.82 +    "[| evs4 \<in> set_mr; M = Merchant k;
   14.83 +        merSK \<notin> symKeys;  merEK \<notin> symKeys;
   14.84 +        Notes (CA i) (Key merSK) \<notin> set evs4;
   14.85 +        Notes (CA i) (Key merEK) \<notin> set evs4;
   14.86 +        Gets (CA i) {|Crypt KM1 (sign (invKey merSK)
   14.87 +                                 {|Agent M, Nonce NM2, Key merSK, Key merEK|}),
   14.88 +                      Crypt (pubEK (CA i)) (Key KM1) |}
   14.89 +          \<in> set evs4 |]
   14.90 +    ==> Says (CA i) M {|sign (priSK(CA i)) {|Agent M, Nonce NM2, Agent(CA i)|},
   14.91 +                        cert  M      merSK    onlySig (priSK (CA i)),
   14.92 +                        cert  M      merEK    onlyEnc (priSK (CA i)),
   14.93 +                        cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|}
   14.94 +          # Notes (CA i) (Key merSK)
   14.95 +          # Notes (CA i) (Key merEK)
   14.96 +          # evs4 \<in> set_mr"
   14.97 +
   14.98 +
   14.99 +text{*Note possibility proofs are missing.*}
  14.100 +
  14.101 +declare Says_imp_knows_Spy [THEN parts.Inj, dest]
  14.102 +declare parts.Body [dest]
  14.103 +declare analz_into_parts [dest]
  14.104 +declare Fake_parts_insert_in_Un [dest]
  14.105 +
  14.106 +text{*General facts about message reception*}
  14.107 +lemma Gets_imp_Says:
  14.108 +     "[| Gets B X \<in> set evs; evs \<in> set_mr |] ==> \<exists>A. Says A B X \<in> set evs"
  14.109 +apply (erule rev_mp)
  14.110 +apply (erule set_mr.induct, auto)
  14.111 +done
  14.112 +
  14.113 +lemma Gets_imp_knows_Spy:
  14.114 +     "[| Gets B X \<in> set evs; evs \<in> set_mr |]  ==> X \<in> knows Spy evs"
  14.115 +by (blast dest!: Gets_imp_Says Says_imp_knows_Spy)
  14.116 +
  14.117 +
  14.118 +declare Gets_imp_knows_Spy [THEN parts.Inj, dest]
  14.119 +
  14.120 +subsubsection{*Proofs on keys *}
  14.121 +
  14.122 +text{*Spy never sees an agent's private keys! (unless it's bad at start)*}
  14.123 +lemma Spy_see_private_Key [simp]:
  14.124 +     "evs \<in> set_mr
  14.125 +      ==> (Key(invKey (publicKey b A)) \<in> parts(knows Spy evs)) = (A \<in> bad)"
  14.126 +apply (erule set_mr.induct)
  14.127 +apply (auto dest!: Gets_imp_knows_Spy [THEN parts.Inj])
  14.128 +done
  14.129 +
  14.130 +lemma Spy_analz_private_Key [simp]:
  14.131 +     "evs \<in> set_mr ==>
  14.132 +     (Key(invKey (publicKey b A)) \<in> analz(knows Spy evs)) = (A \<in> bad)"
  14.133 +by auto
  14.134 +
  14.135 +declare Spy_see_private_Key [THEN [2] rev_iffD1, dest!]
  14.136 +declare Spy_analz_private_Key [THEN [2] rev_iffD1, dest!]
  14.137 +
  14.138 +(*This is to state that the signed keys received in step 4
  14.139 +  are into parts - rather than installing sign_def each time.
  14.140 +  Needed in Spy_see_priSK_RCA, Spy_see_priEK and in Spy_see_priSK
  14.141 +Goal "[|Gets C \<lbrace>Crypt KM1
  14.142 +                (sign K \<lbrace>Agent M, Nonce NM2, Key merSK, Key merEK\<rbrace>), X\<rbrace>
  14.143 +          \<in> set evs;  evs \<in> set_mr |]
  14.144 +    ==> Key merSK \<in> parts (knows Spy evs) \<and>
  14.145 +        Key merEK \<in> parts (knows Spy evs)"
  14.146 +by (fast_tac (claset() addss (simpset())) 1);
  14.147 +qed "signed_keys_in_parts";
  14.148 +???*)
  14.149 +
  14.150 +text{*Proofs on certificates -
  14.151 +  they hold, as in CR, because RCA's keys are secure*}
  14.152 +
  14.153 +lemma Crypt_valid_pubEK:
  14.154 +     "[| Crypt (priSK RCA) {|Agent (CA i), Key EKi, onlyEnc|}
  14.155 +           \<in> parts (knows Spy evs);
  14.156 +         evs \<in> set_mr |] ==> EKi = pubEK (CA i)"
  14.157 +apply (erule rev_mp)
  14.158 +apply (erule set_mr.induct, auto)
  14.159 +done
  14.160 +
  14.161 +lemma certificate_valid_pubEK:
  14.162 +    "[| cert (CA i) EKi onlyEnc (priSK RCA) \<in> parts (knows Spy evs);
  14.163 +        evs \<in> set_mr |]
  14.164 +     ==> EKi = pubEK (CA i)"
  14.165 +apply (unfold cert_def signCert_def)
  14.166 +apply (blast dest!: Crypt_valid_pubEK)
  14.167 +done
  14.168 +
  14.169 +lemma Crypt_valid_pubSK:
  14.170 +     "[| Crypt (priSK RCA) {|Agent (CA i), Key SKi, onlySig|}
  14.171 +           \<in> parts (knows Spy evs);
  14.172 +         evs \<in> set_mr |] ==> SKi = pubSK (CA i)"
  14.173 +apply (erule rev_mp)
  14.174 +apply (erule set_mr.induct, auto)
  14.175 +done
  14.176 +
  14.177 +lemma certificate_valid_pubSK:
  14.178 +    "[| cert (CA i) SKi onlySig (priSK RCA) \<in> parts (knows Spy evs);
  14.179 +        evs \<in> set_mr |] ==> SKi = pubSK (CA i)"
  14.180 +apply (unfold cert_def signCert_def)
  14.181 +apply (blast dest!: Crypt_valid_pubSK)
  14.182 +done
  14.183 +
  14.184 +lemma Gets_certificate_valid:
  14.185 +     "[| Gets A {| X, cert (CA i) EKi onlyEnc (priSK RCA),
  14.186 +                      cert (CA i) SKi onlySig (priSK RCA)|} \<in> set evs;
  14.187 +         evs \<in> set_mr |]
  14.188 +      ==> EKi = pubEK (CA i) & SKi = pubSK (CA i)"
  14.189 +by (blast dest: certificate_valid_pubEK certificate_valid_pubSK)
  14.190 +
  14.191 +
  14.192 +text{*Nobody can have used non-existent keys!*}
  14.193 +lemma new_keys_not_used [rule_format,simp]:
  14.194 +     "evs \<in> set_mr
  14.195 +      ==> Key K \<notin> used evs --> K \<in> symKeys -->
  14.196 +          K \<notin> keysFor (parts (knows Spy evs))"
  14.197 +apply (erule set_mr.induct, simp_all)
  14.198 +apply (force dest!: usedI keysFor_parts_insert)  --{*Fake*}
  14.199 +apply force  --{*Message 2*}
  14.200 +apply (blast dest: Gets_certificate_valid)  --{*Message 3*}
  14.201 +apply force  --{*Message 4*}
  14.202 +done
  14.203 +
  14.204 +
  14.205 +subsubsection{*New Versions: As Above, but Generalized with the Kk Argument*}
  14.206 +
  14.207 +lemma gen_new_keys_not_used [rule_format]:
  14.208 +     "evs \<in> set_mr
  14.209 +      ==> Key K \<notin> used evs --> K \<in> symKeys -->
  14.210 +          K \<notin> keysFor (parts (Key`KK Un knows Spy evs))"
  14.211 +by auto
  14.212 +
  14.213 +lemma gen_new_keys_not_analzd:
  14.214 +     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_mr |]
  14.215 +      ==> K \<notin> keysFor (analz (Key`KK Un knows Spy evs))"
  14.216 +by (blast intro: keysFor_mono [THEN [2] rev_subsetD]
  14.217 +          dest: gen_new_keys_not_used)
  14.218 +
  14.219 +lemma analz_Key_image_insert_eq:
  14.220 +     "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> set_mr |]
  14.221 +      ==> analz (Key ` (insert K KK) \<union> knows Spy evs) =
  14.222 +          insert (Key K) (analz (Key ` KK \<union> knows Spy evs))"
  14.223 +by (simp add: gen_new_keys_not_analzd)
  14.224 +
  14.225 +
  14.226 +lemma Crypt_parts_imp_used:
  14.227 +     "[|Crypt K X \<in> parts (knows Spy evs);
  14.228 +        K \<in> symKeys; evs \<in> set_mr |] ==> Key K \<in> used evs"
  14.229 +apply (rule ccontr)
  14.230 +apply (force dest: new_keys_not_used Crypt_imp_invKey_keysFor)
  14.231 +done
  14.232 +
  14.233 +lemma Crypt_analz_imp_used:
  14.234 +     "[|Crypt K X \<in> analz (knows Spy evs);
  14.235 +        K \<in> symKeys; evs \<in> set_mr |] ==> Key K \<in> used evs"
  14.236 +by (blast intro: Crypt_parts_imp_used)
  14.237 +
  14.238 +text{*Rewriting rule for private encryption keys.  Analogous rewriting rules
  14.239 +for other keys aren't needed.*}
  14.240 +
  14.241 +lemma parts_image_priEK:
  14.242 +     "[|Key (priEK (CA i)) \<in> parts (Key`KK Un (knows Spy evs));
  14.243 +        evs \<in> set_mr|] ==> priEK (CA i) \<in> KK | CA i \<in> bad"
  14.244 +by auto
  14.245 +
  14.246 +text{*trivial proof because (priEK (CA i)) never appears even in (parts evs)*}
  14.247 +lemma analz_image_priEK:
  14.248 +     "evs \<in> set_mr ==>
  14.249 +          (Key (priEK (CA i)) \<in> analz (Key`KK Un (knows Spy evs))) =
  14.250 +          (priEK (CA i) \<in> KK | CA i \<in> bad)"
  14.251 +by (blast dest!: parts_image_priEK intro: analz_mono [THEN [2] rev_subsetD])
  14.252 +
  14.253 +
  14.254 +subsection{*Secrecy of Session Keys*}
  14.255 +
  14.256 +text{*This holds because if (priEK (CA i)) appears in any traffic then it must
  14.257 +  be known to the Spy, by @{text Spy_see_private_Key}*}
  14.258 +lemma merK_neq_priEK:
  14.259 +     "[|Key merK \<notin> analz (knows Spy evs);
  14.260 +        Key merK \<in> parts (knows Spy evs);
  14.261 +        evs \<in> set_mr|] ==> merK \<noteq> priEK C"
  14.262 +by blast
  14.263 +
  14.264 +text{*Lemma for message 4: either merK is compromised (when we don't care)
  14.265 +  or else merK hasn't been used to encrypt K.*}
  14.266 +lemma msg4_priEK_disj:
  14.267 +     "[|Gets B {|Crypt KM1
  14.268 +                       (sign K {|Agent M, Nonce NM2, Key merSK, Key merEK|}),
  14.269 +                 Y|} \<in> set evs;
  14.270 +        evs \<in> set_mr|]
  14.271 +  ==> (Key merSK \<in> analz (knows Spy evs) | merSK \<notin> range(\<lambda>C. priEK C))
  14.272 +   &  (Key merEK \<in> analz (knows Spy evs) | merEK \<notin> range(\<lambda>C. priEK C))"
  14.273 +apply (unfold sign_def)
  14.274 +apply (blast dest: merK_neq_priEK)
  14.275 +done
  14.276 +
  14.277 +
  14.278 +lemma Key_analz_image_Key_lemma:
  14.279 +     "P --> (Key K \<in> analz (Key`KK Un H)) --> (K\<in>KK | Key K \<in> analz H)
  14.280 +      ==>
  14.281 +      P --> (Key K \<in> analz (Key`KK Un H)) = (K\<in>KK | Key K \<in> analz H)"
  14.282 +by (blast intro: analz_mono [THEN [2] rev_subsetD])
  14.283 +
  14.284 +lemma symKey_compromise:
  14.285 +     "evs \<in> set_mr ==>
  14.286 +      (\<forall>SK KK. SK \<in> symKeys \<longrightarrow> (\<forall>K \<in> KK. K \<notin> range(\<lambda>C. priEK C)) -->
  14.287 +               (Key SK \<in> analz (Key`KK Un (knows Spy evs))) =
  14.288 +               (SK \<in> KK | Key SK \<in> analz (knows Spy evs)))"
  14.289 +apply (erule set_mr.induct)
  14.290 +apply (safe del: impI intro!: Key_analz_image_Key_lemma [THEN impI])
  14.291 +apply (drule_tac [7] msg4_priEK_disj)
  14.292 +apply (frule_tac [6] Gets_certificate_valid)
  14.293 +apply (safe del: impI)
  14.294 +apply (simp_all del: image_insert image_Un imp_disjL
  14.295 +         add: analz_image_keys_simps abbrev_simps analz_knows_absorb
  14.296 +              analz_knows_absorb2 analz_Key_image_insert_eq notin_image_iff
  14.297 +              Spy_analz_private_Key analz_image_priEK)
  14.298 +  --{*5 seconds on a 1.6GHz machine*}
  14.299 +apply spy_analz  --{*Fake*}
  14.300 +apply auto  --{*Message 3*}
  14.301 +done
  14.302 +
  14.303 +lemma symKey_secrecy [rule_format]:
  14.304 +     "[|CA i \<notin> bad; K \<in> symKeys;  evs \<in> set_mr|]
  14.305 +      ==> \<forall>X m. Says (Merchant m) (CA i) X \<in> set evs -->
  14.306 +                Key K \<in> parts{X} -->
  14.307 +                Merchant m \<notin> bad -->
  14.308 +                Key K \<notin> analz (knows Spy evs)"
  14.309 +apply (erule set_mr.induct)
  14.310 +apply (drule_tac [7] msg4_priEK_disj)
  14.311 +apply (frule_tac [6] Gets_certificate_valid)
  14.312 +apply (safe del: impI)
  14.313 +apply (simp_all del: image_insert image_Un imp_disjL
  14.314 +         add: analz_image_keys_simps abbrev_simps analz_knows_absorb
  14.315 +              analz_knows_absorb2 analz_Key_image_insert_eq
  14.316 +              symKey_compromise notin_image_iff Spy_analz_private_Key
  14.317 +              analz_image_priEK)
  14.318 +apply spy_analz  --{*Fake*}
  14.319 +apply force  --{*Message 1*}
  14.320 +apply (auto intro: analz_into_parts [THEN usedI] in_parts_Says_imp_used)  --{*Message 3*}
  14.321 +done
  14.322 +
  14.323 +subsection{*Unicity *}
  14.324 +
  14.325 +lemma msg4_Says_imp_Notes:
  14.326 + "[|Says (CA i) M {|sign (priSK (CA i)) {|Agent M, Nonce NM2, Agent (CA i)|},
  14.327 +                    cert  M      merSK    onlySig (priSK (CA i)),
  14.328 +                    cert  M      merEK    onlyEnc (priSK (CA i)),
  14.329 +                    cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|} \<in> set evs;
  14.330 +    evs \<in> set_mr |]
  14.331 +  ==> Notes (CA i) (Key merSK) \<in> set evs
  14.332 +   &  Notes (CA i) (Key merEK) \<in> set evs"
  14.333 +apply (erule rev_mp)
  14.334 +apply (erule set_mr.induct)
  14.335 +apply (simp_all (no_asm_simp))
  14.336 +done
  14.337 +
  14.338 +text{*Unicity of merSK wrt a given CA:
  14.339 +  merSK uniquely identifies the other components, including merEK*}
  14.340 +lemma merSK_unicity:
  14.341 + "[|Says (CA i) M {|sign (priSK(CA i)) {|Agent M, Nonce NM2, Agent (CA i)|},
  14.342 +                    cert  M      merSK    onlySig (priSK (CA i)),
  14.343 +                    cert  M      merEK    onlyEnc (priSK (CA i)),
  14.344 +                    cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|} \<in> set evs;
  14.345 +    Says (CA i) M' {|sign (priSK(CA i)) {|Agent M', Nonce NM2', Agent (CA i)|},
  14.346 +                    cert  M'      merSK    onlySig (priSK (CA i)),
  14.347 +                    cert  M'      merEK'    onlyEnc (priSK (CA i)),
  14.348 +                    cert (CA i) (pubSK(CA i)) onlySig (priSK RCA)|} \<in> set evs;
  14.349 +    evs \<in> set_mr |] ==> M=M' & NM2=NM2' & merEK=merEK'"
  14.350 +apply (erule rev_mp)
  14.351 +apply (erule rev_mp)
  14.352 +apply (erule set_mr.induct)
  14.353 +apply (simp_all (no_asm_simp))
  14.354 +apply (blast dest!: msg4_Says_imp_Notes)
  14.355 +done
  14.356 +
  14.357 +text{*Unicity of merEK wrt a given CA:
  14.358 +  merEK uniquely identifies the other components, including merSK*}
  14.359 +lemma merEK_unicity:
  14.360 + "[|Says (CA i) M {|sign (priSK(CA i)) {|Agent M, Nonce NM2, Agent (CA i)|},
  14.361 +                    cert  M      merSK    onlySig (priSK (CA i)),
  14.362 +                    cert  M      merEK    onlyEnc (priSK (CA i)),
  14.363 +                    cert (CA i) (pubSK (CA i)) onlySig (priSK RCA)|} \<in> set evs;
  14.364 +    Says (CA i) M' {|sign (priSK(CA i)) {|Agent M', Nonce NM2', Agent (CA i)|},
  14.365 +                     cert  M'      merSK'    onlySig (priSK (CA i)),
  14.366 +                     cert  M'      merEK    onlyEnc (priSK (CA i)),
  14.367 +                     cert (CA i) (pubSK(CA i)) onlySig (priSK RCA)|} \<in> set evs;
  14.368 +    evs \<in> set_mr |] 
  14.369 +  ==> M=M' & NM2=NM2' & merSK=merSK'"
  14.370 +apply (erule rev_mp)
  14.371 +apply (erule rev_mp)
  14.372 +apply (erule set_mr.induct)
  14.373 +apply (simp_all (no_asm_simp))
  14.374 +apply (blast dest!: msg4_Says_imp_Notes)
  14.375 +done
  14.376 +
  14.377 +
  14.378 +text{* -No interest on secrecy of nonces: they appear to be used
  14.379 +    only for freshness.
  14.380 +   -No interest on secrecy of merSK or merEK, as in CR.
  14.381 +   -There's no equivalent of the PAN*}
  14.382 +
  14.383 +
  14.384 +subsection{*Primary Goals of Merchant Registration *}
  14.385 +
  14.386 +subsubsection{*The merchant's certificates really were created by the CA,
  14.387 +provided the CA is uncompromised *}
  14.388 +
  14.389 +text{*The assumption @{term "CA i \<noteq> RCA"} is required: step 2 uses 
  14.390 +  certificates of the same form.*}
  14.391 +lemma certificate_merSK_valid_lemma [intro]:
  14.392 +     "[|Crypt (priSK (CA i)) {|Agent M, Key merSK, onlySig|}
  14.393 +          \<in> parts (knows Spy evs);
  14.394 +        CA i \<notin> bad;  CA i \<noteq> RCA;  evs \<in> set_mr|]
  14.395 + ==> \<exists>X Y Z. Says (CA i) M
  14.396 +                  {|X, cert M merSK onlySig (priSK (CA i)), Y, Z|} \<in> set evs"
  14.397 +apply (erule rev_mp)
  14.398 +apply (erule set_mr.induct)
  14.399 +apply (simp_all (no_asm_simp))
  14.400 +apply auto
  14.401 +done
  14.402 +
  14.403 +lemma certificate_merSK_valid:
  14.404 +     "[| cert M merSK onlySig (priSK (CA i)) \<in> parts (knows Spy evs);
  14.405 +         CA i \<notin> bad;  CA i \<noteq> RCA;  evs \<in> set_mr|]
  14.406 + ==> \<exists>X Y Z. Says (CA i) M
  14.407 +                  {|X, cert M merSK onlySig (priSK (CA i)), Y, Z|} \<in> set evs"
  14.408 +by auto
  14.409 +
  14.410 +lemma certificate_merEK_valid_lemma [intro]:
  14.411 +     "[|Crypt (priSK (CA i)) {|Agent M, Key merEK, onlyEnc|}
  14.412 +          \<in> parts (knows Spy evs);
  14.413 +        CA i \<notin> bad;  CA i \<noteq> RCA;  evs \<in> set_mr|]
  14.414 + ==> \<exists>X Y Z. Says (CA i) M
  14.415 +                  {|X, Y, cert M merEK onlyEnc (priSK (CA i)), Z|} \<in> set evs"
  14.416 +apply (erule rev_mp)
  14.417 +apply (erule set_mr.induct)
  14.418 +apply (simp_all (no_asm_simp))
  14.419 +apply auto
  14.420 +done
  14.421 +
  14.422 +lemma certificate_merEK_valid:
  14.423 +     "[| cert M merEK onlyEnc (priSK (CA i)) \<in> parts (knows Spy evs);
  14.424 +         CA i \<notin> bad;  CA i \<noteq> RCA;  evs \<in> set_mr|]
  14.425 + ==> \<exists>X Y Z. Says (CA i) M
  14.426 +                  {|X, Y, cert M merEK onlyEnc (priSK (CA i)), Z|} \<in> set evs"
  14.427 +by auto
  14.428 +
  14.429 +text{*The two certificates - for merSK and for merEK - cannot be proved to
  14.430 +  have originated together*}
  14.431 +
  14.432 +end
    15.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.2 +++ b/src/HOL/SET_Protocol/Message_SET.thy	Tue Oct 20 20:03:23 2009 +0200
    15.3 @@ -0,0 +1,957 @@
    15.4 +(*  Title:      HOL/SET_Protocol/Message_SET.thy
    15.5 +    Author:     Giampaolo Bella
    15.6 +    Author:     Fabio Massacci
    15.7 +    Author:     Lawrence C Paulson
    15.8 +*)
    15.9 +
   15.10 +header{*The Message Theory, Modified for SET*}
   15.11 +
   15.12 +theory Message_SET
   15.13 +imports Main Nat_Int_Bij
   15.14 +begin
   15.15 +
   15.16 +subsection{*General Lemmas*}
   15.17 +
   15.18 +text{*Needed occasionally with @{text spy_analz_tac}, e.g. in
   15.19 +     @{text analz_insert_Key_newK}*}
   15.20 +
   15.21 +lemma Un_absorb3 [simp] : "A \<union> (B \<union> A) = B \<union> A"
   15.22 +by blast
   15.23 +
   15.24 +text{*Collapses redundant cases in the huge protocol proofs*}
   15.25 +lemmas disj_simps = disj_comms disj_left_absorb disj_assoc 
   15.26 +
   15.27 +text{*Effective with assumptions like @{term "K \<notin> range pubK"} and 
   15.28 +   @{term "K \<notin> invKey`range pubK"}*}
   15.29 +lemma notin_image_iff: "(y \<notin> f`I) = (\<forall>i\<in>I. f i \<noteq> y)"
   15.30 +by blast
   15.31 +
   15.32 +text{*Effective with the assumption @{term "KK \<subseteq> - (range(invKey o pubK))"} *}
   15.33 +lemma disjoint_image_iff: "(A <= - (f`I)) = (\<forall>i\<in>I. f i \<notin> A)"
   15.34 +by blast
   15.35 +
   15.36 +
   15.37 +
   15.38 +types
   15.39 +  key = nat
   15.40 +
   15.41 +consts
   15.42 +  all_symmetric :: bool        --{*true if all keys are symmetric*}
   15.43 +  invKey        :: "key=>key"  --{*inverse of a symmetric key*}
   15.44 +
   15.45 +specification (invKey)
   15.46 +  invKey [simp]: "invKey (invKey K) = K"
   15.47 +  invKey_symmetric: "all_symmetric --> invKey = id"
   15.48 +    by (rule exI [of _ id], auto)
   15.49 +
   15.50 +
   15.51 +text{*The inverse of a symmetric key is itself; that of a public key
   15.52 +      is the private key and vice versa*}
   15.53 +
   15.54 +constdefs
   15.55 +  symKeys :: "key set"
   15.56 +  "symKeys == {K. invKey K = K}"
   15.57 +
   15.58 +text{*Agents. We allow any number of certification authorities, cardholders
   15.59 +            merchants, and payment gateways.*}
   15.60 +datatype
   15.61 +  agent = CA nat | Cardholder nat | Merchant nat | PG nat | Spy
   15.62 +
   15.63 +text{*Messages*}
   15.64 +datatype
   15.65 +     msg = Agent  agent     --{*Agent names*}
   15.66 +         | Number nat       --{*Ordinary integers, timestamps, ...*}
   15.67 +         | Nonce  nat       --{*Unguessable nonces*}
   15.68 +         | Pan    nat       --{*Unguessable Primary Account Numbers (??)*}
   15.69 +         | Key    key       --{*Crypto keys*}
   15.70 +         | Hash   msg       --{*Hashing*}
   15.71 +         | MPair  msg msg   --{*Compound messages*}
   15.72 +         | Crypt  key msg   --{*Encryption, public- or shared-key*}
   15.73 +
   15.74 +
   15.75 +(*Concrete syntax: messages appear as {|A,B,NA|}, etc...*)
   15.76 +syntax
   15.77 +  "@MTuple"      :: "['a, args] => 'a * 'b"       ("(2{|_,/ _|})")
   15.78 +
   15.79 +syntax (xsymbols)
   15.80 +  "@MTuple"      :: "['a, args] => 'a * 'b"       ("(2\<lbrace>_,/ _\<rbrace>)")
   15.81 +
   15.82 +translations
   15.83 +  "{|x, y, z|}"   == "{|x, {|y, z|}|}"
   15.84 +  "{|x, y|}"      == "MPair x y"
   15.85 +
   15.86 +
   15.87 +constdefs
   15.88 +  nat_of_agent :: "agent => nat"
   15.89 +   "nat_of_agent == agent_case (curry nat2_to_nat 0)
   15.90 +                               (curry nat2_to_nat 1)
   15.91 +                               (curry nat2_to_nat 2)
   15.92 +                               (curry nat2_to_nat 3)
   15.93 +                               (nat2_to_nat (4,0))"
   15.94 +    --{*maps each agent to a unique natural number, for specifications*}
   15.95 +
   15.96 +text{*The function is indeed injective*}
   15.97 +lemma inj_nat_of_agent: "inj nat_of_agent"
   15.98 +by (simp add: nat_of_agent_def inj_on_def curry_def
   15.99 +              nat2_to_nat_inj [THEN inj_eq]  split: agent.split) 
  15.100 +
  15.101 +
  15.102 +constdefs
  15.103 +  (*Keys useful to decrypt elements of a message set*)
  15.104 +  keysFor :: "msg set => key set"
  15.105 +  "keysFor H == invKey ` {K. \<exists>X. Crypt K X \<in> H}"
  15.106 +
  15.107 +subsubsection{*Inductive definition of all "parts" of a message.*}
  15.108 +
  15.109 +inductive_set
  15.110 +  parts :: "msg set => msg set"
  15.111 +  for H :: "msg set"
  15.112 +  where
  15.113 +    Inj [intro]:               "X \<in> H ==> X \<in> parts H"
  15.114 +  | Fst:         "{|X,Y|}   \<in> parts H ==> X \<in> parts H"
  15.115 +  | Snd:         "{|X,Y|}   \<in> parts H ==> Y \<in> parts H"
  15.116 +  | Body:        "Crypt K X \<in> parts H ==> X \<in> parts H"
  15.117 +
  15.118 +
  15.119 +(*Monotonicity*)
  15.120 +lemma parts_mono: "G<=H ==> parts(G) <= parts(H)"
  15.121 +apply auto
  15.122 +apply (erule parts.induct)
  15.123 +apply (auto dest: Fst Snd Body)
  15.124 +done
  15.125 +
  15.126 +
  15.127 +subsubsection{*Inverse of keys*}
  15.128 +
  15.129 +(*Equations hold because constructors are injective; cannot prove for all f*)
  15.130 +lemma Key_image_eq [simp]: "(Key x \<in> Key`A) = (x\<in>A)"
  15.131 +by auto
  15.132 +
  15.133 +lemma Nonce_Key_image_eq [simp]: "(Nonce x \<notin> Key`A)"
  15.134 +by auto
  15.135 +
  15.136 +lemma Cardholder_image_eq [simp]: "(Cardholder x \<in> Cardholder`A) = (x \<in> A)"
  15.137 +by auto
  15.138 +
  15.139 +lemma CA_image_eq [simp]: "(CA x \<in> CA`A) = (x \<in> A)"
  15.140 +by auto
  15.141 +
  15.142 +lemma Pan_image_eq [simp]: "(Pan x \<in> Pan`A) = (x \<in> A)"
  15.143 +by auto
  15.144 +
  15.145 +lemma Pan_Key_image_eq [simp]: "(Pan x \<notin> Key`A)"
  15.146 +by auto
  15.147 +
  15.148 +lemma Nonce_Pan_image_eq [simp]: "(Nonce x \<notin> Pan`A)"
  15.149 +by auto
  15.150 +
  15.151 +lemma invKey_eq [simp]: "(invKey K = invKey K') = (K=K')"
  15.152 +apply safe
  15.153 +apply (drule_tac f = invKey in arg_cong, simp)
  15.154 +done
  15.155 +
  15.156 +
  15.157 +subsection{*keysFor operator*}
  15.158 +
  15.159 +lemma keysFor_empty [simp]: "keysFor {} = {}"
  15.160 +by (unfold keysFor_def, blast)
  15.161 +
  15.162 +lemma keysFor_Un [simp]: "keysFor (H \<union> H') = keysFor H \<union> keysFor H'"
  15.163 +by (unfold keysFor_def, blast)
  15.164 +
  15.165 +lemma keysFor_UN [simp]: "keysFor (\<Union>i\<in>A. H i) = (\<Union>i\<in>A. keysFor (H i))"
  15.166 +by (unfold keysFor_def, blast)
  15.167 +
  15.168 +(*Monotonicity*)
  15.169 +lemma keysFor_mono: "G\<subseteq>H ==> keysFor(G) \<subseteq> keysFor(H)"
  15.170 +by (unfold keysFor_def, blast)
  15.171 +
  15.172 +lemma keysFor_insert_Agent [simp]: "keysFor (insert (Agent A) H) = keysFor H"
  15.173 +by (unfold keysFor_def, auto)
  15.174 +
  15.175 +lemma keysFor_insert_Nonce [simp]: "keysFor (insert (Nonce N) H) = keysFor H"
  15.176 +by (unfold keysFor_def, auto)
  15.177 +
  15.178 +lemma keysFor_insert_Number [simp]: "keysFor (insert (Number N) H) = keysFor H"
  15.179 +by (unfold keysFor_def, auto)
  15.180 +
  15.181 +lemma keysFor_insert_Key [simp]: "keysFor (insert (Key K) H) = keysFor H"
  15.182 +by (unfold keysFor_def, auto)
  15.183 +
  15.184 +lemma keysFor_insert_Pan [simp]: "keysFor (insert (Pan A) H) = keysFor H"
  15.185 +by (unfold keysFor_def, auto)
  15.186 +
  15.187 +lemma keysFor_insert_Hash [simp]: "keysFor (insert (Hash X) H) = keysFor H"
  15.188 +by (unfold keysFor_def, auto)
  15.189 +
  15.190 +lemma keysFor_insert_MPair [simp]: "keysFor (insert {|X,Y|} H) = keysFor H"
  15.191 +by (unfold keysFor_def, auto)
  15.192 +
  15.193 +lemma keysFor_insert_Crypt [simp]:
  15.194 +    "keysFor (insert (Crypt K X) H) = insert (invKey K) (keysFor H)"
  15.195 +by (unfold keysFor_def, auto)
  15.196 +
  15.197 +lemma keysFor_image_Key [simp]: "keysFor (Key`E) = {}"
  15.198 +by (unfold keysFor_def, auto)
  15.199 +
  15.200 +lemma Crypt_imp_invKey_keysFor: "Crypt K X \<in> H ==> invKey K \<in> keysFor H"
  15.201 +by (unfold keysFor_def, blast)
  15.202 +
  15.203 +
  15.204 +subsection{*Inductive relation "parts"*}
  15.205 +
  15.206 +lemma MPair_parts:
  15.207 +     "[| {|X,Y|} \<in> parts H;
  15.208 +         [| X \<in> parts H; Y \<in> parts H |] ==> P |] ==> P"
  15.209 +by (blast dest: parts.Fst parts.Snd)
  15.210 +
  15.211 +declare MPair_parts [elim!]  parts.Body [dest!]
  15.212 +text{*NB These two rules are UNSAFE in the formal sense, as they discard the
  15.213 +     compound message.  They work well on THIS FILE.
  15.214 +  @{text MPair_parts} is left as SAFE because it speeds up proofs.
  15.215 +  The Crypt rule is normally kept UNSAFE to avoid breaking up certificates.*}
  15.216 +
  15.217 +lemma parts_increasing: "H \<subseteq> parts(H)"
  15.218 +by blast
  15.219 +
  15.220 +lemmas parts_insertI = subset_insertI [THEN parts_mono, THEN subsetD, standard]
  15.221 +
  15.222 +lemma parts_empty [simp]: "parts{} = {}"
  15.223 +apply safe
  15.224 +apply (erule parts.induct, blast+)
  15.225 +done
  15.226 +
  15.227 +lemma parts_emptyE [elim!]: "X\<in> parts{} ==> P"
  15.228 +by simp
  15.229 +
  15.230 +(*WARNING: loops if H = {Y}, therefore must not be repeated!*)
  15.231 +lemma parts_singleton: "X\<in> parts H ==> \<exists>Y\<in>H. X\<in> parts {Y}"
  15.232 +by (erule parts.induct, fast+)
  15.233 +
  15.234 +
  15.235 +subsubsection{*Unions*}
  15.236 +
  15.237 +lemma parts_Un_subset1: "parts(G) \<union> parts(H) \<subseteq> parts(G \<union> H)"
  15.238 +by (intro Un_least parts_mono Un_upper1 Un_upper2)
  15.239 +
  15.240 +lemma parts_Un_subset2: "parts(G \<union> H) \<subseteq> parts(G) \<union> parts(H)"
  15.241 +apply (rule subsetI)
  15.242 +apply (erule parts.induct, blast+)
  15.243 +done
  15.244 +
  15.245 +lemma parts_Un [simp]: "parts(G \<union> H) = parts(G) \<union> parts(H)"
  15.246 +by (intro equalityI parts_Un_subset1 parts_Un_subset2)
  15.247 +
  15.248 +lemma parts_insert: "parts (insert X H) = parts {X} \<union> parts H"
  15.249 +apply (subst insert_is_Un [of _ H])
  15.250 +apply (simp only: parts_Un)
  15.251 +done
  15.252 +
  15.253 +(*TWO inserts to avoid looping.  This rewrite is better than nothing.
  15.254 +  Not suitable for Addsimps: its behaviour can be strange.*)
  15.255 +lemma parts_insert2:
  15.256 +     "parts (insert X (insert Y H)) = parts {X} \<union> parts {Y} \<union> parts H"
  15.257 +apply (simp add: Un_assoc)
  15.258 +apply (simp add: parts_insert [symmetric])
  15.259 +done
  15.260 +
  15.261 +lemma parts_UN_subset1: "(\<Union>x\<in>A. parts(H x)) \<subseteq> parts(\<Union>x\<in>A. H x)"
  15.262 +by (intro UN_least parts_mono UN_upper)
  15.263 +
  15.264 +lemma parts_UN_subset2: "parts(\<Union>x\<in>A. H x) \<subseteq> (\<Union>x\<in>A. parts(H x))"
  15.265 +apply (rule subsetI)
  15.266 +apply (erule parts.induct, blast+)
  15.267 +done
  15.268 +
  15.269 +lemma parts_UN [simp]: "parts(\<Union>x\<in>A. H x) = (\<Union>x\<in>A. parts(H x))"
  15.270 +by (intro equalityI parts_UN_subset1 parts_UN_subset2)
  15.271 +
  15.272 +(*Added to simplify arguments to parts, analz and synth.
  15.273 +  NOTE: the UN versions are no longer used!*)
  15.274 +
  15.275 +
  15.276 +text{*This allows @{text blast} to simplify occurrences of
  15.277 +  @{term "parts(G\<union>H)"} in the assumption.*}
  15.278 +declare parts_Un [THEN equalityD1, THEN subsetD, THEN UnE, elim!]
  15.279 +
  15.280 +
  15.281 +lemma parts_insert_subset: "insert X (parts H) \<subseteq> parts(insert X H)"
  15.282 +by (blast intro: parts_mono [THEN [2] rev_subsetD])
  15.283 +
  15.284 +subsubsection{*Idempotence and transitivity*}
  15.285 +
  15.286 +lemma parts_partsD [dest!]: "X\<in> parts (parts H) ==> X\<in> parts H"
  15.287 +by (erule parts.induct, blast+)
  15.288 +
  15.289 +lemma parts_idem [simp]: "parts (parts H) = parts H"
  15.290 +by blast
  15.291 +
  15.292 +lemma parts_trans: "[| X\<in> parts G;  G \<subseteq> parts H |] ==> X\<in> parts H"
  15.293 +by (drule parts_mono, blast)
  15.294 +
  15.295 +(*Cut*)
  15.296 +lemma parts_cut:
  15.297 +     "[| Y\<in> parts (insert X G);  X\<in> parts H |] ==> Y\<in> parts (G \<union> H)"
  15.298 +by (erule parts_trans, auto)
  15.299 +
  15.300 +lemma parts_cut_eq [simp]: "X\<in> parts H ==> parts (insert X H) = parts H"
  15.301 +by (force dest!: parts_cut intro: parts_insertI)
  15.302 +
  15.303 +
  15.304 +subsubsection{*Rewrite rules for pulling out atomic messages*}
  15.305 +
  15.306 +lemmas parts_insert_eq_I = equalityI [OF subsetI parts_insert_subset]
  15.307 +
  15.308 +
  15.309 +lemma parts_insert_Agent [simp]:
  15.310 +     "parts (insert (Agent agt) H) = insert (Agent agt) (parts H)"
  15.311 +apply (rule parts_insert_eq_I)
  15.312 +apply (erule parts.induct, auto)
  15.313 +done
  15.314 +
  15.315 +lemma parts_insert_Nonce [simp]:
  15.316 +     "parts (insert (Nonce N) H) = insert (Nonce N) (parts H)"
  15.317 +apply (rule parts_insert_eq_I)
  15.318 +apply (erule parts.induct, auto)
  15.319 +done
  15.320 +
  15.321 +lemma parts_insert_Number [simp]:
  15.322 +     "parts (insert (Number N) H) = insert (Number N) (parts H)"
  15.323 +apply (rule parts_insert_eq_I)
  15.324 +apply (erule parts.induct, auto)
  15.325 +done
  15.326 +
  15.327 +lemma parts_insert_Key [simp]:
  15.328 +     "parts (insert (Key K) H) = insert (Key K) (parts H)"
  15.329 +apply (rule parts_insert_eq_I)
  15.330 +apply (erule parts.induct, auto)
  15.331 +done
  15.332 +
  15.333 +lemma parts_insert_Pan [simp]:
  15.334 +     "parts (insert (Pan A) H) = insert (Pan A) (parts H)"
  15.335 +apply (rule parts_insert_eq_I)
  15.336 +apply (erule parts.induct, auto)
  15.337 +done
  15.338 +
  15.339 +lemma parts_insert_Hash [simp]:
  15.340 +     "parts (insert (Hash X) H) = insert (Hash X) (parts H)"
  15.341 +apply (rule parts_insert_eq_I)
  15.342 +apply (erule parts.induct, auto)
  15.343 +done
  15.344 +
  15.345 +lemma parts_insert_Crypt [simp]:
  15.346 +     "parts (insert (Crypt K X) H) =
  15.347 +          insert (Crypt K X) (parts (insert X H))"
  15.348 +apply (rule equalityI)
  15.349 +apply (rule subsetI)
  15.350 +apply (erule parts.induct, auto)
  15.351 +apply (erule parts.induct)
  15.352 +apply (blast intro: parts.Body)+
  15.353 +done
  15.354 +
  15.355 +lemma parts_insert_MPair [simp]:
  15.356 +     "parts (insert {|X,Y|} H) =
  15.357 +          insert {|X,Y|} (parts (insert X (insert Y H)))"
  15.358 +apply (rule equalityI)
  15.359 +apply (rule subsetI)
  15.360 +apply (erule parts.induct, auto)
  15.361 +apply (erule parts.induct)
  15.362 +apply (blast intro: parts.Fst parts.Snd)+
  15.363 +done
  15.364 +
  15.365 +lemma parts_image_Key [simp]: "parts (Key`N) = Key`N"
  15.366 +apply auto
  15.367 +apply (erule parts.induct, auto)
  15.368 +done
  15.369 +
  15.370 +lemma parts_image_Pan [simp]: "parts (Pan`A) = Pan`A"
  15.371 +apply auto
  15.372 +apply (erule parts.induct, auto)
  15.373 +done
  15.374 +
  15.375 +
  15.376 +(*In any message, there is an upper bound N on its greatest nonce.*)
  15.377 +lemma msg_Nonce_supply: "\<exists>N. \<forall>n. N\<le>n --> Nonce n \<notin> parts {msg}"
  15.378 +apply (induct_tac "msg")
  15.379 +apply (simp_all (no_asm_simp) add: exI parts_insert2)
  15.380 +(*MPair case: blast_tac works out the necessary sum itself!*)
  15.381 +prefer 2 apply (blast elim!: add_leE)
  15.382 +(*Nonce case*)
  15.383 +apply (rule_tac x = "N + Suc nat" in exI)
  15.384 +apply (auto elim!: add_leE)
  15.385 +done
  15.386 +
  15.387 +(* Ditto, for numbers.*)
  15.388 +lemma msg_Number_supply: "\<exists>N. \<forall>n. N<=n --> Number n \<notin> parts {msg}"
  15.389 +apply (induct_tac "msg")
  15.390 +apply (simp_all (no_asm_simp) add: exI parts_insert2)
  15.391 +prefer 2 apply (blast elim!: add_leE)
  15.392 +apply (rule_tac x = "N + Suc nat" in exI, auto)
  15.393 +done
  15.394 +
  15.395 +subsection{*Inductive relation "analz"*}
  15.396 +
  15.397 +text{*Inductive definition of "analz" -- what can be broken down from a set of
  15.398 +    messages, including keys.  A form of downward closure.  Pairs can
  15.399 +    be taken apart; messages decrypted with known keys.*}
  15.400 +
  15.401 +inductive_set
  15.402 +  analz :: "msg set => msg set"
  15.403 +  for H :: "msg set"
  15.404 +  where
  15.405 +    Inj [intro,simp] :    "X \<in> H ==> X \<in> analz H"
  15.406 +  | Fst:     "{|X,Y|} \<in> analz H ==> X \<in> analz H"
  15.407 +  | Snd:     "{|X,Y|} \<in> analz H ==> Y \<in> analz H"
  15.408 +  | Decrypt [dest]:
  15.409 +             "[|Crypt K X \<in> analz H; Key(invKey K): analz H|] ==> X \<in> analz H"
  15.410 +
  15.411 +
  15.412 +(*Monotonicity; Lemma 1 of Lowe's paper*)
  15.413 +lemma analz_mono: "G<=H ==> analz(G) <= analz(H)"
  15.414 +apply auto
  15.415 +apply (erule analz.induct)
  15.416 +apply (auto dest: Fst Snd)
  15.417 +done
  15.418 +
  15.419 +text{*Making it safe speeds up proofs*}
  15.420 +lemma MPair_analz [elim!]:
  15.421 +     "[| {|X,Y|} \<in> analz H;
  15.422 +             [| X \<in> analz H; Y \<in> analz H |] ==> P
  15.423 +          |] ==> P"
  15.424 +by (blast dest: analz.Fst analz.Snd)
  15.425 +
  15.426 +lemma analz_increasing: "H \<subseteq> analz(H)"
  15.427 +by blast
  15.428 +
  15.429 +lemma analz_subset_parts: "analz H \<subseteq> parts H"
  15.430 +apply (rule subsetI)
  15.431 +apply (erule analz.induct, blast+)
  15.432 +done
  15.433 +
  15.434 +lemmas analz_into_parts = analz_subset_parts [THEN subsetD, standard]
  15.435 +
  15.436 +lemmas not_parts_not_analz = analz_subset_parts [THEN contra_subsetD, standard]
  15.437 +
  15.438 +
  15.439 +lemma parts_analz [simp]: "parts (analz H) = parts H"
  15.440 +apply (rule equalityI)
  15.441 +apply (rule analz_subset_parts [THEN parts_mono, THEN subset_trans], simp)
  15.442 +apply (blast intro: analz_increasing [THEN parts_mono, THEN subsetD])
  15.443 +done
  15.444 +
  15.445 +lemma analz_parts [simp]: "analz (parts H) = parts H"
  15.446 +apply auto
  15.447 +apply (erule analz.induct, auto)
  15.448 +done
  15.449 +
  15.450 +lemmas analz_insertI = subset_insertI [THEN analz_mono, THEN [2] rev_subsetD, standard]
  15.451 +
  15.452 +subsubsection{*General equational properties*}
  15.453 +
  15.454 +lemma analz_empty [simp]: "analz{} = {}"
  15.455 +apply safe
  15.456 +apply (erule analz.induct, blast+)
  15.457 +done
  15.458 +
  15.459 +(*Converse fails: we can analz more from the union than from the
  15.460 +  separate parts, as a key in one might decrypt a message in the other*)
  15.461 +lemma analz_Un: "analz(G) \<union> analz(H) \<subseteq> analz(G \<union> H)"
  15.462 +by (intro Un_least analz_mono Un_upper1 Un_upper2)
  15.463 +
  15.464 +lemma analz_insert: "insert X (analz H) \<subseteq> analz(insert X H)"
  15.465 +by (blast intro: analz_mono [THEN [2] rev_subsetD])
  15.466 +
  15.467 +subsubsection{*Rewrite rules for pulling out atomic messages*}
  15.468 +
  15.469 +lemmas analz_insert_eq_I = equalityI [OF subsetI analz_insert]
  15.470 +
  15.471 +lemma analz_insert_Agent [simp]:
  15.472 +     "analz (insert (Agent agt) H) = insert (Agent agt) (analz H)"
  15.473 +apply (rule analz_insert_eq_I)
  15.474 +apply (erule analz.induct, auto)
  15.475 +done
  15.476 +
  15.477 +lemma analz_insert_Nonce [simp]:
  15.478 +     "analz (insert (Nonce N) H) = insert (Nonce N) (analz H)"
  15.479 +apply (rule analz_insert_eq_I)
  15.480 +apply (erule analz.induct, auto)
  15.481 +done
  15.482 +
  15.483 +lemma analz_insert_Number [simp]:
  15.484 +     "analz (insert (Number N) H) = insert (Number N) (analz H)"
  15.485 +apply (rule analz_insert_eq_I)
  15.486 +apply (erule analz.induct, auto)
  15.487 +done
  15.488 +
  15.489 +lemma analz_insert_Hash [simp]:
  15.490 +     "analz (insert (Hash X) H) = insert (Hash X) (analz H)"
  15.491 +apply (rule analz_insert_eq_I)
  15.492 +apply (erule analz.induct, auto)
  15.493 +done
  15.494 +
  15.495 +(*Can only pull out Keys if they are not needed to decrypt the rest*)
  15.496 +lemma analz_insert_Key [simp]:
  15.497 +    "K \<notin> keysFor (analz H) ==>
  15.498 +          analz (insert (Key K) H) = insert (Key K) (analz H)"
  15.499 +apply (unfold keysFor_def)
  15.500 +apply (rule analz_insert_eq_I)
  15.501 +apply (erule analz.induct, auto)
  15.502 +done
  15.503 +
  15.504 +lemma analz_insert_MPair [simp]:
  15.505 +     "analz (insert {|X,Y|} H) =
  15.506 +          insert {|X,Y|} (analz (insert X (insert Y H)))"
  15.507 +apply (rule equalityI)
  15.508 +apply (rule subsetI)
  15.509 +apply (erule analz.induct, auto)
  15.510 +apply (erule analz.induct)
  15.511 +apply (blast intro: analz.Fst analz.Snd)+
  15.512 +done
  15.513 +
  15.514 +(*Can pull out enCrypted message if the Key is not known*)
  15.515 +lemma analz_insert_Crypt:
  15.516 +     "Key (invKey K) \<notin> analz H
  15.517 +      ==> analz (insert (Crypt K X) H) = insert (Crypt K X) (analz H)"
  15.518 +apply (rule analz_insert_eq_I)
  15.519 +apply (erule analz.induct, auto)
  15.520 +done
  15.521 +
  15.522 +lemma analz_insert_Pan [simp]:
  15.523 +     "analz (insert (Pan A) H) = insert (Pan A) (analz H)"
  15.524 +apply (rule analz_insert_eq_I)
  15.525 +apply (erule analz.induct, auto)
  15.526 +done
  15.527 +
  15.528 +lemma lemma1: "Key (invKey K) \<in> analz H ==>
  15.529 +               analz (insert (Crypt K X) H) \<subseteq>
  15.530 +               insert (Crypt K X) (analz (insert X H))"
  15.531 +apply (rule subsetI)
  15.532 +apply (erule_tac x = x in analz.induct, auto)
  15.533 +done
  15.534 +
  15.535 +lemma lemma2: "Key (invKey K) \<in> analz H ==>
  15.536 +               insert (Crypt K X) (analz (insert X H)) \<subseteq>
  15.537 +               analz (insert (Crypt K X) H)"
  15.538 +apply auto
  15.539 +apply (erule_tac x = x in analz.induct, auto)
  15.540 +apply (blast intro: analz_insertI analz.Decrypt)
  15.541 +done
  15.542 +
  15.543 +lemma analz_insert_Decrypt:
  15.544 +     "Key (invKey K) \<in> analz H ==>
  15.545 +               analz (insert (Crypt K X) H) =
  15.546 +               insert (Crypt K X) (analz (insert X H))"
  15.547 +by (intro equalityI lemma1 lemma2)
  15.548 +
  15.549 +(*Case analysis: either the message is secure, or it is not!
  15.550 +  Effective, but can cause subgoals to blow up!
  15.551 +  Use with split_if;  apparently split_tac does not cope with patterns
  15.552 +  such as "analz (insert (Crypt K X) H)" *)
  15.553 +lemma analz_Crypt_if [simp]:
  15.554 +     "analz (insert (Crypt K X) H) =
  15.555 +          (if (Key (invKey K) \<in> analz H)
  15.556 +           then insert (Crypt K X) (analz (insert X H))
  15.557 +           else insert (Crypt K X) (analz H))"
  15.558 +by (simp add: analz_insert_Crypt analz_insert_Decrypt)
  15.559 +
  15.560 +
  15.561 +(*This rule supposes "for the sake of argument" that we have the key.*)
  15.562 +lemma analz_insert_Crypt_subset:
  15.563 +     "analz (insert (Crypt K X) H) \<subseteq>
  15.564 +           insert (Crypt K X) (analz (insert X H))"
  15.565 +apply (rule subsetI)
  15.566 +apply (erule analz.induct, auto)
  15.567 +done
  15.568 +
  15.569 +lemma analz_image_Key [simp]: "analz (Key`N) = Key`N"
  15.570 +apply auto
  15.571 +apply (erule analz.induct, auto)
  15.572 +done
  15.573 +
  15.574 +lemma analz_image_Pan [simp]: "analz (Pan`A) = Pan`A"
  15.575 +apply auto
  15.576 +apply (erule analz.induct, auto)
  15.577 +done
  15.578 +
  15.579 +
  15.580 +subsubsection{*Idempotence and transitivity*}
  15.581 +
  15.582 +lemma analz_analzD [dest!]: "X\<in> analz (analz H) ==> X\<in> analz H"
  15.583 +by (erule analz.induct, blast+)
  15.584 +
  15.585 +lemma analz_idem [simp]: "analz (analz H) = analz H"
  15.586 +by blast
  15.587 +
  15.588 +lemma analz_trans: "[| X\<in> analz G;  G \<subseteq> analz H |] ==> X\<in> analz H"
  15.589 +by (drule analz_mono, blast)
  15.590 +
  15.591 +(*Cut; Lemma 2 of Lowe*)
  15.592 +lemma analz_cut: "[| Y\<in> analz (insert X H);  X\<in> analz H |] ==> Y\<in> analz H"
  15.593 +by (erule analz_trans, blast)
  15.594 +
  15.595 +(*Cut can be proved easily by induction on
  15.596 +   "Y: analz (insert X H) ==> X: analz H --> Y: analz H"
  15.597 +*)
  15.598 +
  15.599 +(*This rewrite rule helps in the simplification of messages that involve
  15.600 +  the forwarding of unknown components (X).  Without it, removing occurrences
  15.601 +  of X can be very complicated. *)
  15.602 +lemma analz_insert_eq: "X\<in> analz H ==> analz (insert X H) = analz H"
  15.603 +by (blast intro: analz_cut analz_insertI)
  15.604 +
  15.605 +
  15.606 +text{*A congruence rule for "analz"*}
  15.607 +
  15.608 +lemma analz_subset_cong:
  15.609 +     "[| analz G \<subseteq> analz G'; analz H \<subseteq> analz H'
  15.610 +               |] ==> analz (G \<union> H) \<subseteq> analz (G' \<union> H')"
  15.611 +apply clarify
  15.612 +apply (erule analz.induct)
  15.613 +apply (best intro: analz_mono [THEN subsetD])+
  15.614 +done
  15.615 +
  15.616 +lemma analz_cong:
  15.617 +     "[| analz G = analz G'; analz H = analz H'
  15.618 +               |] ==> analz (G \<union> H) = analz (G' \<union> H')"
  15.619 +by (intro equalityI analz_subset_cong, simp_all)
  15.620 +
  15.621 +lemma analz_insert_cong:
  15.622 +     "analz H = analz H' ==> analz(insert X H) = analz(insert X H')"
  15.623 +by (force simp only: insert_def intro!: analz_cong)
  15.624 +
  15.625 +(*If there are no pairs or encryptions then analz does nothing*)
  15.626 +lemma analz_trivial:
  15.627 +     "[| \<forall>X Y. {|X,Y|} \<notin> H;  \<forall>X K. Crypt K X \<notin> H |] ==> analz H = H"
  15.628 +apply safe
  15.629 +apply (erule analz.induct, blast+)
  15.630 +done
  15.631 +
  15.632 +(*These two are obsolete (with a single Spy) but cost little to prove...*)
  15.633 +lemma analz_UN_analz_lemma:
  15.634 +     "X\<in> analz (\<Union>i\<in>A. analz (H i)) ==> X\<in> analz (\<Union>i\<in>A. H i)"
  15.635 +apply (erule analz.induct)
  15.636 +apply (blast intro: analz_mono [THEN [2] rev_subsetD])+
  15.637 +done
  15.638 +
  15.639 +lemma analz_UN_analz [simp]: "analz (\<Union>i\<in>A. analz (H i)) = analz (\<Union>i\<in>A. H i)"
  15.640 +by (blast intro: analz_UN_analz_lemma analz_mono [THEN [2] rev_subsetD])
  15.641 +
  15.642 +
  15.643 +subsection{*Inductive relation "synth"*}
  15.644 +
  15.645 +text{*Inductive definition of "synth" -- what can be built up from a set of
  15.646 +    messages.  A form of upward closure.  Pairs can be built, messages
  15.647 +    encrypted with known keys.  Agent names are public domain.
  15.648 +    Numbers can be guessed, but Nonces cannot be.*}
  15.649 +
  15.650 +inductive_set
  15.651 +  synth :: "msg set => msg set"
  15.652 +  for H :: "msg set"
  15.653 +  where
  15.654 +    Inj    [intro]:   "X \<in> H ==> X \<in> synth H"
  15.655 +  | Agent  [intro]:   "Agent agt \<in> synth H"
  15.656 +  | Number [intro]:   "Number n  \<in> synth H"
  15.657 +  | Hash   [intro]:   "X \<in> synth H ==> Hash X \<in> synth H"
  15.658 +  | MPair  [intro]:   "[|X \<in> synth H;  Y \<in> synth H|] ==> {|X,Y|} \<in> synth H"
  15.659 +  | Crypt  [intro]:   "[|X \<in> synth H;  Key(K) \<in> H|] ==> Crypt K X \<in> synth H"
  15.660 +
  15.661 +(*Monotonicity*)
  15.662 +lemma synth_mono: "G<=H ==> synth(G) <= synth(H)"
  15.663 +apply auto
  15.664 +apply (erule synth.induct)
  15.665 +apply (auto dest: Fst Snd Body)
  15.666 +done
  15.667 +
  15.668 +(*NO Agent_synth, as any Agent name can be synthesized.  Ditto for Number*)
  15.669 +inductive_cases Nonce_synth [elim!]: "Nonce n \<in> synth H"
  15.670 +inductive_cases Key_synth   [elim!]: "Key K \<in> synth H"
  15.671 +inductive_cases Hash_synth  [elim!]: "Hash X \<in> synth H"
  15.672 +inductive_cases MPair_synth [elim!]: "{|X,Y|} \<in> synth H"
  15.673 +inductive_cases Crypt_synth [elim!]: "Crypt K X \<in> synth H"
  15.674 +inductive_cases Pan_synth   [elim!]: "Pan A \<in> synth H"
  15.675 +
  15.676 +
  15.677 +lemma synth_increasing: "H \<subseteq> synth(H)"
  15.678 +by blast
  15.679 +
  15.680 +subsubsection{*Unions*}
  15.681 +
  15.682 +(*Converse fails: we can synth more from the union than from the
  15.683 +  separate parts, building a compound message using elements of each.*)
  15.684 +lemma synth_Un: "synth(G) \<union> synth(H) \<subseteq> synth(G \<union> H)"
  15.685 +by (intro Un_least synth_mono Un_upper1 Un_upper2)
  15.686 +
  15.687 +lemma synth_insert: "insert X (synth H) \<subseteq> synth(insert X H)"
  15.688 +by (blast intro: synth_mono [THEN [2] rev_subsetD])
  15.689 +
  15.690 +subsubsection{*Idempotence and transitivity*}
  15.691 +
  15.692 +lemma synth_synthD [dest!]: "X\<in> synth (synth H) ==> X\<in> synth H"
  15.693 +by (erule synth.induct, blast+)
  15.694 +
  15.695 +lemma synth_idem: "synth (synth H) = synth H"
  15.696 +by blast
  15.697 +
  15.698 +lemma synth_trans: "[| X\<in> synth G;  G \<subseteq> synth H |] ==> X\<in> synth H"
  15.699 +by (drule synth_mono, blast)
  15.700 +
  15.701 +(*Cut; Lemma 2 of Lowe*)
  15.702 +lemma synth_cut: "[| Y\<in> synth (insert X H);  X\<in> synth H |] ==> Y\<in> synth H"
  15.703 +by (erule synth_trans, blast)
  15.704 +
  15.705 +lemma Agent_synth [simp]: "Agent A \<in> synth H"
  15.706 +by blast
  15.707 +
  15.708 +lemma Number_synth [simp]: "Number n \<in> synth H"
  15.709 +by blast
  15.710 +
  15.711 +lemma Nonce_synth_eq [simp]: "(Nonce N \<in> synth H) = (Nonce N \<in> H)"
  15.712 +by blast
  15.713 +
  15.714 +lemma Key_synth_eq [simp]: "(Key K \<in> synth H) = (Key K \<in> H)"
  15.715 +by blast
  15.716 +
  15.717 +lemma Crypt_synth_eq [simp]: "Key K \<notin> H ==> (Crypt K X \<in> synth H) = (Crypt K X \<in> H)"
  15.718 +by blast
  15.719 +
  15.720 +lemma Pan_synth_eq [simp]: "(Pan A \<in> synth H) = (Pan A \<in> H)"
  15.721 +by blast
  15.722 +
  15.723 +lemma keysFor_synth [simp]:
  15.724 +    "keysFor (synth H) = keysFor H \<union> invKey`{K. Key K \<in> H}"
  15.725 +by (unfold keysFor_def, blast)
  15.726 +
  15.727 +
  15.728 +subsubsection{*Combinations of parts, analz and synth*}
  15.729 +
  15.730 +lemma parts_synth [simp]: "parts (synth H) = parts H \<union> synth H"
  15.731 +apply (rule equalityI)
  15.732 +apply (rule subsetI)
  15.733 +apply (erule parts.induct)
  15.734 +apply (blast intro: synth_increasing [THEN parts_mono, THEN subsetD]
  15.735 +                    parts.Fst parts.Snd parts.Body)+
  15.736 +done
  15.737 +
  15.738 +lemma analz_analz_Un [simp]: "analz (analz G \<union> H) = analz (G \<union> H)"
  15.739 +apply (intro equalityI analz_subset_cong)+
  15.740 +apply simp_all
  15.741 +done
  15.742 +
  15.743 +lemma analz_synth_Un [simp]: "analz (synth G \<union> H) = analz (G \<union> H) \<union> synth G"
  15.744 +apply (rule equalityI)
  15.745 +apply (rule subsetI)
  15.746 +apply (erule analz.induct)
  15.747 +prefer 5 apply (blast intro: analz_mono [THEN [2] rev_subsetD])
  15.748 +apply (blast intro: analz.Fst analz.Snd analz.Decrypt)+
  15.749 +done
  15.750 +
  15.751 +lemma analz_synth [simp]: "analz (synth H) = analz H \<union> synth H"
  15.752 +apply (cut_tac H = "{}" in analz_synth_Un)
  15.753 +apply (simp (no_asm_use))
  15.754 +done
  15.755 +
  15.756 +
  15.757 +subsubsection{*For reasoning about the Fake rule in traces*}
  15.758 +
  15.759 +lemma parts_insert_subset_Un: "X\<in> G ==> parts(insert X H) \<subseteq> parts G \<union> parts H"
  15.760 +by (rule subset_trans [OF parts_mono parts_Un_subset2], blast)
  15.761 +
  15.762 +(*More specifically for Fake.  Very occasionally we could do with a version
  15.763 +  of the form  parts{X} \<subseteq> synth (analz H) \<union> parts H *)
  15.764 +lemma Fake_parts_insert: "X \<in> synth (analz H) ==>
  15.765 +      parts (insert X H) \<subseteq> synth (analz H) \<union> parts H"
  15.766 +apply (drule parts_insert_subset_Un)
  15.767 +apply (simp (no_asm_use))
  15.768 +apply blast
  15.769 +done
  15.770 +
  15.771 +lemma Fake_parts_insert_in_Un:
  15.772 +     "[|Z \<in> parts (insert X H);  X: synth (analz H)|] 
  15.773 +      ==> Z \<in>  synth (analz H) \<union> parts H";
  15.774 +by (blast dest: Fake_parts_insert [THEN subsetD, dest])
  15.775 +
  15.776 +(*H is sometimes (Key ` KK \<union> spies evs), so can't put G=H*)
  15.777 +lemma Fake_analz_insert:
  15.778 +     "X\<in> synth (analz G) ==>
  15.779 +      analz (insert X H) \<subseteq> synth (analz G) \<union> analz (G \<union> H)"
  15.780 +apply (rule subsetI)
  15.781 +apply (subgoal_tac "x \<in> analz (synth (analz G) \<union> H) ")
  15.782 +prefer 2 apply (blast intro: analz_mono [THEN [2] rev_subsetD] analz_mono [THEN synth_mono, THEN [2] rev_subsetD])
  15.783 +apply (simp (no_asm_use))
  15.784 +apply blast
  15.785 +done
  15.786 +
  15.787 +lemma analz_conj_parts [simp]:
  15.788 +     "(X \<in> analz H & X \<in> parts H) = (X \<in> analz H)"
  15.789 +by (blast intro: analz_subset_parts [THEN subsetD])
  15.790 +
  15.791 +lemma analz_disj_parts [simp]:
  15.792 +     "(X \<in> analz H | X \<in> parts H) = (X \<in> parts H)"
  15.793 +by (blast intro: analz_subset_parts [THEN subsetD])
  15.794 +
  15.795 +(*Without this equation, other rules for synth and analz would yield
  15.796 +  redundant cases*)
  15.797 +lemma MPair_synth_analz [iff]:
  15.798 +     "({|X,Y|} \<in> synth (analz H)) =
  15.799 +      (X \<in> synth (analz H) & Y \<in> synth (analz H))"
  15.800 +by blast
  15.801 +
  15.802 +lemma Crypt_synth_analz:
  15.803 +     "[| Key K \<in> analz H;  Key (invKey K) \<in> analz H |]
  15.804 +       ==> (Crypt K X \<in> synth (analz H)) = (X \<in> synth (analz H))"
  15.805 +by blast
  15.806 +
  15.807 +
  15.808 +lemma Hash_synth_analz [simp]:
  15.809 +     "X \<notin> synth (analz H)
  15.810 +      ==> (Hash{|X,Y|} \<in> synth (analz H)) = (Hash{|X,Y|} \<in> analz H)"
  15.811 +by blast
  15.812 +
  15.813 +
  15.814 +(*We do NOT want Crypt... messages broken up in protocols!!*)
  15.815 +declare parts.Body [rule del]
  15.816 +
  15.817 +
  15.818 +text{*Rewrites to push in Key and Crypt messages, so that other messages can
  15.819 +    be pulled out using the @{text analz_insert} rules*}
  15.820 +
  15.821 +lemmas pushKeys [standard] =
  15.822 +  insert_commute [of "Key K" "Agent C"]
  15.823 +  insert_commute [of "Key K" "Nonce N"]
  15.824 +  insert_commute [of "Key K" "Number N"]
  15.825 +  insert_commute [of "Key K" "Pan PAN"]
  15.826 +  insert_commute [of "Key K" "Hash X"]
  15.827 +  insert_commute [of "Key K" "MPair X Y"]
  15.828 +  insert_commute [of "Key K" "Crypt X K'"]
  15.829 +
  15.830 +lemmas pushCrypts [standard] =
  15.831 +  insert_commute [of "Crypt X K" "Agent C"]
  15.832 +  insert_commute [of "Crypt X K" "Nonce N"]
  15.833 +  insert_commute [of "Crypt X K" "Number N"]
  15.834 +  insert_commute [of "Crypt X K" "Pan PAN"]
  15.835 +  insert_commute [of "Crypt X K" "Hash X'"]
  15.836 +  insert_commute [of "Crypt X K" "MPair X' Y"]
  15.837 +
  15.838 +text{*Cannot be added with @{text "[simp]"} -- messages should not always be
  15.839 +  re-ordered.*}
  15.840 +lemmas pushes = pushKeys pushCrypts
  15.841 +
  15.842 +
  15.843 +subsection{*Tactics useful for many protocol proofs*}
  15.844 +(*<*)
  15.845 +ML
  15.846 +{*
  15.847 +structure MessageSET =
  15.848 +struct
  15.849 +
  15.850 +(*Prove base case (subgoal i) and simplify others.  A typical base case
  15.851 +  concerns  Crypt K X \<notin> Key`shrK`bad  and cannot be proved by rewriting
  15.852 +  alone.*)
  15.853 +fun prove_simple_subgoals_tac (cs, ss) i =
  15.854 +    force_tac (cs, ss addsimps [@{thm image_eq_UN}]) i THEN
  15.855 +    ALLGOALS (asm_simp_tac ss)
  15.856 +
  15.857 +(*Analysis of Fake cases.  Also works for messages that forward unknown parts,
  15.858 +  but this application is no longer necessary if analz_insert_eq is used.
  15.859 +  Abstraction over i is ESSENTIAL: it delays the dereferencing of claset
  15.860 +  DEPENDS UPON "X" REFERRING TO THE FRADULENT MESSAGE *)
  15.861 +
  15.862 +fun impOfSubs th = th RSN (2, @{thm rev_subsetD})
  15.863 +
  15.864 +(*Apply rules to break down assumptions of the form
  15.865 +  Y \<in> parts(insert X H)  and  Y \<in> analz(insert X H)
  15.866 +*)
  15.867 +val Fake_insert_tac =
  15.868 +    dresolve_tac [impOfSubs @{thm Fake_analz_insert},
  15.869 +                  impOfSubs @{thm Fake_parts_insert}] THEN'
  15.870 +    eresolve_tac [asm_rl, @{thm synth.Inj}];
  15.871 +
  15.872 +fun Fake_insert_simp_tac ss i =
  15.873 +    REPEAT (Fake_insert_tac i) THEN asm_full_simp_tac ss i;
  15.874 +
  15.875 +fun atomic_spy_analz_tac (cs,ss) = SELECT_GOAL
  15.876 +    (Fake_insert_simp_tac ss 1
  15.877 +     THEN
  15.878 +     IF_UNSOLVED (Blast.depth_tac
  15.879 +                  (cs addIs [@{thm analz_insertI},
  15.880 +                                   impOfSubs @{thm analz_subset_parts}]) 4 1))
  15.881 +
  15.882 +fun spy_analz_tac (cs,ss) i =
  15.883 +  DETERM
  15.884 +   (SELECT_GOAL
  15.885 +     (EVERY
  15.886 +      [  (*push in occurrences of X...*)
  15.887 +       (REPEAT o CHANGED)
  15.888 +           (res_inst_tac (Simplifier.the_context ss)
  15.889 +             [(("x", 1), "X")] (insert_commute RS ssubst) 1),
  15.890 +       (*...allowing further simplifications*)
  15.891 +       simp_tac ss 1,
  15.892 +       REPEAT (FIRSTGOAL (resolve_tac [allI,impI,notI,conjI,iffI])),
  15.893 +       DEPTH_SOLVE (atomic_spy_analz_tac (cs,ss) 1)]) i)
  15.894 +
  15.895 +end
  15.896 +*}
  15.897 +(*>*)
  15.898 +
  15.899 +
  15.900 +(*By default only o_apply is built-in.  But in the presence of eta-expansion
  15.901 +  this means that some terms displayed as (f o g) will be rewritten, and others
  15.902 +  will not!*)
  15.903 +declare o_def [simp]
  15.904 +
  15.905 +
  15.906 +lemma Crypt_notin_image_Key [simp]: "Crypt K X \<notin> Key ` A"
  15.907 +by auto
  15.908 +
  15.909 +lemma Hash_notin_image_Key [simp] :"Hash X \<notin> Key ` A"
  15.910 +by auto
  15.911 +
  15.912 +lemma synth_analz_mono: "G<=H ==> synth (analz(G)) <= synth (analz(H))"
  15.913 +by (simp add: synth_mono analz_mono)
  15.914 +
  15.915 +lemma Fake_analz_eq [simp]:
  15.916 +     "X \<in> synth(analz H) ==> synth (analz (insert X H)) = synth (analz H)"
  15.917 +apply (drule Fake_analz_insert[of _ _ "H"])
  15.918 +apply (simp add: synth_increasing[THEN Un_absorb2])
  15.919 +apply (drule synth_mono)
  15.920 +apply (simp add: synth_idem)
  15.921 +apply (blast intro: synth_analz_mono [THEN [2] rev_subsetD])
  15.922 +done
  15.923 +
  15.924 +text{*Two generalizations of @{text analz_insert_eq}*}
  15.925 +lemma gen_analz_insert_eq [rule_format]:
  15.926 +     "X \<in> analz H ==> ALL G. H \<subseteq> G --> analz (insert X G) = analz G";
  15.927 +by (blast intro: analz_cut analz_insertI analz_mono [THEN [2] rev_subsetD])
  15.928 +
  15.929 +lemma synth_analz_insert_eq [rule_format]:
  15.930 +     "X \<in> synth (analz H)
  15.931 +      ==> ALL G. H \<subseteq> G --> (Key K \<in> analz (insert X G)) = (Key K \<in> analz G)";
  15.932 +apply (erule synth.induct)
  15.933 +apply (simp_all add: gen_analz_insert_eq subset_trans [OF _ subset_insertI])
  15.934 +done
  15.935 +
  15.936 +lemma Fake_parts_sing:
  15.937 +     "X \<in> synth (analz H) ==> parts{X} \<subseteq> synth (analz H) \<union> parts H";
  15.938 +apply (rule subset_trans)
  15.939 + apply (erule_tac [2] Fake_parts_insert)
  15.940 +apply (simp add: parts_mono)
  15.941 +done
  15.942 +
  15.943 +lemmas Fake_parts_sing_imp_Un = Fake_parts_sing [THEN [2] rev_subsetD]
  15.944 +
  15.945 +method_setup spy_analz = {*
  15.946 +    Scan.succeed (fn ctxt =>
  15.947 +        SIMPLE_METHOD' (MessageSET.spy_analz_tac (clasimpset_of ctxt))) *}
  15.948 +    "for proving the Fake case when analz is involved"
  15.949 +
  15.950 +method_setup atomic_spy_analz = {*
  15.951 +    Scan.succeed (fn ctxt =>
  15.952 +        SIMPLE_METHOD' (MessageSET.atomic_spy_analz_tac (clasimpset_of ctxt))) *}
  15.953 +    "for debugging spy_analz"
  15.954 +
  15.955 +method_setup Fake_insert_simp = {*
  15.956 +    Scan.succeed (fn ctxt =>
  15.957 +        SIMPLE_METHOD' (MessageSET.Fake_insert_simp_tac (simpset_of ctxt))) *}
  15.958 +    "for debugging spy_analz"
  15.959 +
  15.960 +end
    16.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    16.2 +++ b/src/HOL/SET_Protocol/Public_SET.thy	Tue Oct 20 20:03:23 2009 +0200
    16.3 @@ -0,0 +1,529 @@
    16.4 +(*  Title:      HOL/SET_Protocol/Public_SET.thy
    16.5 +    Author:     Giampaolo Bella
    16.6 +    Author:     Fabio Massacci
    16.7 +    Author:     Lawrence C Paulson
    16.8 +*)
    16.9 +
   16.10 +header{*The Public-Key Theory, Modified for SET*}
   16.11 +
   16.12 +theory Public_SET
   16.13 +imports Event_SET
   16.14 +begin
   16.15 +
   16.16 +subsection{*Symmetric and Asymmetric Keys*}
   16.17 +
   16.18 +text{*definitions influenced by the wish to assign asymmetric keys 
   16.19 +  - since the beginning - only to RCA and CAs, namely we need a partial 
   16.20 +  function on type Agent*}
   16.21 +
   16.22 +
   16.23 +text{*The SET specs mention two signature keys for CAs - we only have one*}
   16.24 +
   16.25 +consts
   16.26 +  publicKey :: "[bool, agent] => key"
   16.27 +    --{*the boolean is TRUE if a signing key*}
   16.28 +
   16.29 +syntax
   16.30 +  pubEK :: "agent => key"
   16.31 +  pubSK :: "agent => key"
   16.32 +  priEK :: "agent => key"
   16.33 +  priSK :: "agent => key"
   16.34 +
   16.35 +translations
   16.36 +  "pubEK"  == "publicKey False"
   16.37 +  "pubSK"  == "publicKey True"
   16.38 +
   16.39 +  (*BEWARE!! priEK, priSK DON'T WORK with inj, range, image, etc.*)
   16.40 +  "priEK A"  == "invKey (pubEK A)"
   16.41 +  "priSK A"  == "invKey (pubSK A)"
   16.42 +
   16.43 +text{*By freeness of agents, no two agents have the same key. Since
   16.44 + @{term "True\<noteq>False"}, no agent has the same signing and encryption keys.*}
   16.45 +
   16.46 +specification (publicKey)
   16.47 +  injective_publicKey:
   16.48 +    "publicKey b A = publicKey c A' ==> b=c & A=A'"
   16.49 +(*<*)
   16.50 +   apply (rule exI [of _ "%b A. 2 * nat_of_agent A + (if b then 1 else 0)"]) 
   16.51 +   apply (auto simp add: inj_on_def inj_nat_of_agent [THEN inj_eq] split: agent.split) 
   16.52 +   apply (drule_tac f="%x. x mod 2" in arg_cong, simp add: mod_Suc)+
   16.53 +(*or this, but presburger won't abstract out the function applications
   16.54 +   apply presburger+
   16.55 +*)
   16.56 +   done                       
   16.57 +(*>*)
   16.58 +
   16.59 +axioms
   16.60 +  (*No private key equals any public key (essential to ensure that private
   16.61 +    keys are private!) *)
   16.62 +  privateKey_neq_publicKey [iff]:
   16.63 +      "invKey (publicKey b A) \<noteq> publicKey b' A'"
   16.64 +
   16.65 +declare privateKey_neq_publicKey [THEN not_sym, iff]
   16.66 +
   16.67 +  
   16.68 +subsection{*Initial Knowledge*}
   16.69 +
   16.70 +text{*This information is not necessary.  Each protocol distributes any needed
   16.71 +certificates, and anyway our proofs require a formalization of the Spy's 
   16.72 +knowledge only.  However, the initial knowledge is as follows:
   16.73 +   All agents know RCA's public keys;
   16.74 +   RCA and CAs know their own respective keys;
   16.75 +   RCA (has already certified and therefore) knows all CAs public keys; 
   16.76 +   Spy knows all keys of all bad agents.*}
   16.77 +primrec    
   16.78 +(*<*)
   16.79 +  initState_CA:
   16.80 +    "initState (CA i)  =
   16.81 +       (if i=0 then Key ` ({priEK RCA, priSK RCA} Un
   16.82 +                            pubEK ` (range CA) Un pubSK ` (range CA))
   16.83 +        else {Key (priEK (CA i)), Key (priSK (CA i)),
   16.84 +              Key (pubEK (CA i)), Key (pubSK (CA i)),
   16.85 +              Key (pubEK RCA), Key (pubSK RCA)})"
   16.86 +
   16.87 +  initState_Cardholder:
   16.88 +    "initState (Cardholder i)  =    
   16.89 +       {Key (priEK (Cardholder i)), Key (priSK (Cardholder i)),
   16.90 +        Key (pubEK (Cardholder i)), Key (pubSK (Cardholder i)),
   16.91 +        Key (pubEK RCA), Key (pubSK RCA)}"
   16.92 +
   16.93 +  initState_Merchant:
   16.94 +    "initState (Merchant i)  =    
   16.95 +       {Key (priEK (Merchant i)), Key (priSK (Merchant i)),
   16.96 +        Key (pubEK (Merchant i)), Key (pubSK (Merchant i)),
   16.97 +        Key (pubEK RCA), Key (pubSK RCA)}"
   16.98 +
   16.99 +  initState_PG:
  16.100 +    "initState (PG i)  = 
  16.101 +       {Key (priEK (PG i)), Key (priSK (PG i)),
  16.102 +        Key (pubEK (PG i)), Key (pubSK (PG i)),
  16.103 +        Key (pubEK RCA), Key (pubSK RCA)}"
  16.104 +(*>*)
  16.105 +  initState_Spy:
  16.106 +    "initState Spy = Key ` (invKey ` pubEK ` bad Un
  16.107 +                            invKey ` pubSK ` bad Un
  16.108 +                            range pubEK Un range pubSK)"
  16.109 +
  16.110 +
  16.111 +text{*Injective mapping from agents to PANs: an agent can have only one card*}
  16.112 +
  16.113 +consts  pan :: "agent => nat"
  16.114 +
  16.115 +specification (pan)
  16.116 +  inj_pan: "inj pan"
  16.117 +  --{*No two agents have the same PAN*}
  16.118 +(*<*)
  16.119 +   apply (rule exI [of _ "nat_of_agent"]) 
  16.120 +   apply (simp add: inj_on_def inj_nat_of_agent [THEN inj_eq]) 
  16.121 +   done
  16.122 +(*>*)
  16.123 +
  16.124 +declare inj_pan [THEN inj_eq, iff]
  16.125 +
  16.126 +consts
  16.127 +  XOR :: "nat*nat => nat"  --{*no properties are assumed of exclusive-or*}
  16.128 +
  16.129 +
  16.130 +subsection{*Signature Primitives*}
  16.131 +
  16.132 +constdefs 
  16.133 +
  16.134 + (* Signature = Message + signed Digest *)
  16.135 +  sign :: "[key, msg]=>msg"
  16.136 +    "sign K X == {|X, Crypt K (Hash X) |}"
  16.137 +
  16.138 + (* Signature Only = signed Digest Only *)
  16.139 +  signOnly :: "[key, msg]=>msg"
  16.140 +    "signOnly K X == Crypt K (Hash X)"
  16.141 +
  16.142 + (* Signature for Certificates = Message + signed Message *)
  16.143 +  signCert :: "[key, msg]=>msg"
  16.144 +    "signCert K X == {|X, Crypt K X |}"
  16.145 +
  16.146 + (* Certification Authority's Certificate.
  16.147 +    Contains agent name, a key, a number specifying the key's target use,
  16.148 +              a key to sign the entire certificate.
  16.149 +
  16.150 +    Should prove if signK=priSK RCA and C=CA i,
  16.151 +                  then Ka=pubEK i or pubSK i depending on T  ??
  16.152 + *)
  16.153 +  cert :: "[agent, key, msg, key] => msg"
  16.154 +    "cert A Ka T signK == signCert signK {|Agent A, Key Ka, T|}"
  16.155 +
  16.156 +
  16.157 + (* Cardholder's Certificate.
  16.158 +    Contains a PAN, the certified key Ka, the PANSecret PS,
  16.159 +    a number specifying the target use for Ka, the signing key signK.
  16.160 + *)
  16.161 +  certC :: "[nat, key, nat, msg, key] => msg"
  16.162 +    "certC PAN Ka PS T signK ==
  16.163 +     signCert signK {|Hash {|Nonce PS, Pan PAN|}, Key Ka, T|}"
  16.164 +
  16.165 +  (*cert and certA have no repeated elements, so they could be translations,
  16.166 +    but that's tricky and makes proofs slower*)
  16.167 +
  16.168 +syntax
  16.169 +  "onlyEnc" :: msg      
  16.170 +  "onlySig" :: msg
  16.171 +  "authCode" :: msg
  16.172 +
  16.173 +translations
  16.174 +  "onlyEnc"   == "Number 0"
  16.175 +  "onlySig"  == "Number (Suc 0)"
  16.176 +  "authCode" == "Number (Suc (Suc 0))"
  16.177 +
  16.178 +subsection{*Encryption Primitives*}
  16.179 +
  16.180 +constdefs
  16.181 +
  16.182 +  EXcrypt :: "[key,key,msg,msg] => msg"
  16.183 +  --{*Extra Encryption*}
  16.184 +    (*K: the symmetric key   EK: the public encryption key*)
  16.185 +    "EXcrypt K EK M m ==
  16.186 +       {|Crypt K {|M, Hash m|}, Crypt EK {|Key K, m|}|}"
  16.187 +
  16.188 +  EXHcrypt :: "[key,key,msg,msg] => msg"
  16.189 +  --{*Extra Encryption with Hashing*}
  16.190 +    (*K: the symmetric key   EK: the public encryption key*)
  16.191 +    "EXHcrypt K EK M m ==
  16.192 +       {|Crypt K {|M, Hash m|}, Crypt EK {|Key K, m, Hash M|}|}"
  16.193 +
  16.194 +  Enc :: "[key,key,key,msg] => msg"
  16.195 +  --{*Simple Encapsulation with SIGNATURE*}
  16.196 +    (*SK: the sender's signing key
  16.197 +      K: the symmetric key
  16.198 +      EK: the public encryption key*)
  16.199 +    "Enc SK K EK M ==
  16.200 +       {|Crypt K (sign SK M), Crypt EK (Key K)|}"
  16.201 +
  16.202 +  EncB :: "[key,key,key,msg,msg] => msg"
  16.203 +  --{*Encapsulation with Baggage.  Keys as above, and baggage b.*}
  16.204 +    "EncB SK K EK M b == 
  16.205 +       {|Enc SK K EK {|M, Hash b|}, b|}"
  16.206 +
  16.207 +
  16.208 +subsection{*Basic Properties of pubEK, pubSK, priEK and priSK *}
  16.209 +
  16.210 +lemma publicKey_eq_iff [iff]:
  16.211 +     "(publicKey b A = publicKey b' A') = (b=b' & A=A')"
  16.212 +by (blast dest: injective_publicKey)
  16.213 +
  16.214 +lemma privateKey_eq_iff [iff]:
  16.215 +     "(invKey (publicKey b A) = invKey (publicKey b' A')) = (b=b' & A=A')"
  16.216 +by auto
  16.217 +
  16.218 +lemma not_symKeys_publicKey [iff]: "publicKey b A \<notin> symKeys"
  16.219 +by (simp add: symKeys_def)
  16.220 +
  16.221 +lemma not_symKeys_privateKey [iff]: "invKey (publicKey b A) \<notin> symKeys"
  16.222 +by (simp add: symKeys_def)
  16.223 +
  16.224 +lemma symKeys_invKey_eq [simp]: "K \<in> symKeys ==> invKey K = K"
  16.225 +by (simp add: symKeys_def)
  16.226 +
  16.227 +lemma symKeys_invKey_iff [simp]: "(invKey K \<in> symKeys) = (K \<in> symKeys)"
  16.228 +by (unfold symKeys_def, auto)
  16.229 +
  16.230 +text{*Can be slow (or even loop) as a simprule*}
  16.231 +lemma symKeys_neq_imp_neq: "(K \<in> symKeys) \<noteq> (K' \<in> symKeys) ==> K \<noteq> K'"
  16.232 +by blast
  16.233 +
  16.234 +text{*These alternatives to @{text symKeys_neq_imp_neq} don't seem any better
  16.235 +in practice.*}
  16.236 +lemma publicKey_neq_symKey: "K \<in> symKeys ==> publicKey b A \<noteq> K"
  16.237 +by blast
  16.238 +
  16.239 +lemma symKey_neq_publicKey: "K \<in> symKeys ==> K \<noteq> publicKey b A"
  16.240 +by blast
  16.241 +
  16.242 +lemma privateKey_neq_symKey: "K \<in> symKeys ==> invKey (publicKey b A) \<noteq> K"
  16.243 +by blast
  16.244 +
  16.245 +lemma symKey_neq_privateKey: "K \<in> symKeys ==> K \<noteq> invKey (publicKey b A)"
  16.246 +by blast
  16.247 +
  16.248 +lemma analz_symKeys_Decrypt:
  16.249 +     "[| Crypt K X \<in> analz H;  K \<in> symKeys;  Key K \<in> analz H |]  
  16.250 +      ==> X \<in> analz H"
  16.251 +by auto
  16.252 +
  16.253 +
  16.254 +subsection{*"Image" Equations That Hold for Injective Functions *}
  16.255 +
  16.256 +lemma invKey_image_eq [iff]: "(invKey x \<in> invKey`A) = (x\<in>A)"
  16.257 +by auto
  16.258 +
  16.259 +text{*holds because invKey is injective*}
  16.260 +lemma publicKey_image_eq [iff]:
  16.261 +     "(publicKey b A \<in> publicKey c ` AS) = (b=c & A\<in>AS)"
  16.262 +by auto
  16.263 +
  16.264 +lemma privateKey_image_eq [iff]:
  16.265 +     "(invKey (publicKey b A) \<in> invKey ` publicKey c ` AS) = (b=c & A\<in>AS)"
  16.266 +by auto
  16.267 +
  16.268 +lemma privateKey_notin_image_publicKey [iff]:
  16.269 +     "invKey (publicKey b A) \<notin> publicKey c ` AS"
  16.270 +by auto
  16.271 +
  16.272 +lemma publicKey_notin_image_privateKey [iff]:
  16.273 +     "publicKey b A \<notin> invKey ` publicKey c ` AS"
  16.274 +by auto
  16.275 +
  16.276 +lemma keysFor_parts_initState [simp]: "keysFor (parts (initState C)) = {}"
  16.277 +apply (simp add: keysFor_def)
  16.278 +apply (induct_tac "C")
  16.279 +apply (auto intro: range_eqI)
  16.280 +done
  16.281 +
  16.282 +text{*for proving @{text new_keys_not_used}*}
  16.283 +lemma keysFor_parts_insert:
  16.284 +     "[| K \<in> keysFor (parts (insert X H));  X \<in> synth (analz H) |]  
  16.285 +      ==> K \<in> keysFor (parts H) | Key (invKey K) \<in> parts H"
  16.286 +by (force dest!: 
  16.287 +         parts_insert_subset_Un [THEN keysFor_mono, THEN [2] rev_subsetD]
  16.288 +         analz_subset_parts [THEN keysFor_mono, THEN [2] rev_subsetD] 
  16.289 +            intro: analz_into_parts)
  16.290 +
  16.291 +lemma Crypt_imp_keysFor [intro]:
  16.292 +     "[|K \<in> symKeys; Crypt K X \<in> H|] ==> K \<in> keysFor H"
  16.293 +by (drule Crypt_imp_invKey_keysFor, simp)
  16.294 +
  16.295 +text{*Agents see their own private keys!*}
  16.296 +lemma privateKey_in_initStateCA [iff]:
  16.297 +     "Key (invKey (publicKey b A)) \<in> initState A"
  16.298 +by (case_tac "A", auto)
  16.299 +
  16.300 +text{*Agents see their own public keys!*}
  16.301 +lemma publicKey_in_initStateCA [iff]: "Key (publicKey b A) \<in> initState A"
  16.302 +by (case_tac "A", auto)
  16.303 +
  16.304 +text{*RCA sees CAs' public keys! *}
  16.305 +lemma pubK_CA_in_initState_RCA [iff]:
  16.306 +     "Key (publicKey b (CA i)) \<in> initState RCA"
  16.307 +by auto
  16.308 +
  16.309 +
  16.310 +text{*Spy knows all public keys*}
  16.311 +lemma knows_Spy_pubEK_i [iff]: "Key (publicKey b A) \<in> knows Spy evs"
  16.312 +apply (induct_tac "evs")
  16.313 +apply (simp_all add: imageI knows_Cons split add: event.split)
  16.314 +done
  16.315 +
  16.316 +declare knows_Spy_pubEK_i [THEN analz.Inj, iff]
  16.317 +                            (*needed????*)
  16.318 +
  16.319 +text{*Spy sees private keys of bad agents! [and obviously public keys too]*}
  16.320 +lemma knows_Spy_bad_privateKey [intro!]:
  16.321 +     "A \<in> bad ==> Key (invKey (publicKey b A)) \<in> knows Spy evs"
  16.322 +by (rule initState_subset_knows [THEN subsetD], simp)
  16.323 +
  16.324 +
  16.325 +subsection{*Fresh Nonces for Possibility Theorems*}
  16.326 +
  16.327 +lemma Nonce_notin_initState [iff]: "Nonce N \<notin> parts (initState B)"
  16.328 +by (induct_tac "B", auto)
  16.329 +
  16.330 +lemma Nonce_notin_used_empty [simp]: "Nonce N \<notin> used []"
  16.331 +by (simp add: used_Nil)
  16.332 +
  16.333 +text{*In any trace, there is an upper bound N on the greatest nonce in use.*}
  16.334 +lemma Nonce_supply_lemma: "\<exists>N. \<forall>n. N<=n --> Nonce n \<notin> used evs"
  16.335 +apply (induct_tac "evs")
  16.336 +apply (rule_tac x = 0 in exI)
  16.337 +apply (simp_all add: used_Cons split add: event.split, safe)
  16.338 +apply (rule msg_Nonce_supply [THEN exE], blast elim!: add_leE)+
  16.339 +done
  16.340 +
  16.341 +lemma Nonce_supply1: "\<exists>N. Nonce N \<notin> used evs"
  16.342 +by (rule Nonce_supply_lemma [THEN exE], blast)
  16.343 +
  16.344 +lemma Nonce_supply: "Nonce (@ N. Nonce N \<notin> used evs) \<notin> used evs"
  16.345 +apply (rule Nonce_supply_lemma [THEN exE])
  16.346 +apply (rule someI, fast)
  16.347 +done
  16.348 +
  16.349 +
  16.350 +subsection{*Specialized Methods for Possibility Theorems*}
  16.351 +
  16.352 +ML
  16.353 +{*
  16.354 +(*Tactic for possibility theorems*)
  16.355 +fun possibility_tac ctxt =
  16.356 +    REPEAT (*omit used_Says so that Nonces start from different traces!*)
  16.357 +    (ALLGOALS (simp_tac (simpset_of ctxt delsimps [@{thm used_Says}, @{thm used_Notes}]))
  16.358 +     THEN
  16.359 +     REPEAT_FIRST (eq_assume_tac ORELSE' 
  16.360 +                   resolve_tac [refl, conjI, @{thm Nonce_supply}]))
  16.361 +
  16.362 +(*For harder protocols (such as SET_CR!), where we have to set up some
  16.363 +  nonces and keys initially*)
  16.364 +fun basic_possibility_tac ctxt =
  16.365 +    REPEAT 
  16.366 +    (ALLGOALS (asm_simp_tac (simpset_of ctxt setSolver safe_solver))
  16.367 +     THEN
  16.368 +     REPEAT_FIRST (resolve_tac [refl, conjI]))
  16.369 +*}
  16.370 +
  16.371 +method_setup possibility = {*
  16.372 +    Scan.succeed (SIMPLE_METHOD o possibility_tac) *}
  16.373 +    "for proving possibility theorems"
  16.374 +
  16.375 +method_setup basic_possibility = {*
  16.376 +    Scan.succeed (SIMPLE_METHOD o basic_possibility_tac) *}
  16.377 +    "for proving possibility theorems"
  16.378 +
  16.379 +
  16.380 +subsection{*Specialized Rewriting for Theorems About @{term analz} and Image*}
  16.381 +
  16.382 +lemma insert_Key_singleton: "insert (Key K) H = Key ` {K} Un H"
  16.383 +by blast
  16.384 +
  16.385 +lemma insert_Key_image:
  16.386 +     "insert (Key K) (Key`KK Un C) = Key ` (insert K KK) Un C"
  16.387 +by blast
  16.388 +
  16.389 +text{*Needed for @{text DK_fresh_not_KeyCryptKey}*}
  16.390 +lemma publicKey_in_used [iff]: "Key (publicKey b A) \<in> used evs"
  16.391 +by auto
  16.392 +
  16.393 +lemma privateKey_in_used [iff]: "Key (invKey (publicKey b A)) \<in> used evs"
  16.394 +by (blast intro!: initState_into_used)
  16.395 +
  16.396 +text{*Reverse the normal simplification of "image" to build up (not break down)
  16.397 +  the set of keys.  Based on @{text analz_image_freshK_ss}, but simpler.*}
  16.398 +lemmas analz_image_keys_simps =
  16.399 +       simp_thms mem_simps --{*these two allow its use with @{text "only:"}*}
  16.400 +       image_insert [THEN sym] image_Un [THEN sym] 
  16.401 +       rangeI symKeys_neq_imp_neq
  16.402 +       insert_Key_singleton insert_Key_image Un_assoc [THEN sym]
  16.403 +
  16.404 +
  16.405 +(*General lemmas proved by Larry*)
  16.406 +
  16.407 +subsection{*Controlled Unfolding of Abbreviations*}
  16.408 +
  16.409 +text{*A set is expanded only if a relation is applied to it*}
  16.410 +lemma def_abbrev_simp_relation:
  16.411 +     "A == B ==> (A \<in> X) = (B \<in> X) &  
  16.412 +                 (u = A) = (u = B) &  
  16.413 +                 (A = u) = (B = u)"
  16.414 +by auto
  16.415 +
  16.416 +text{*A set is expanded only if one of the given functions is applied to it*}
  16.417 +lemma def_abbrev_simp_function:
  16.418 +     "A == B  
  16.419 +      ==> parts (insert A X) = parts (insert B X) &  
  16.420 +          analz (insert A X) = analz (insert B X) &  
  16.421 +          keysFor (insert A X) = keysFor (insert B X)"
  16.422 +by auto
  16.423 +
  16.424 +subsubsection{*Special Simplification Rules for @{term signCert}*}
  16.425 +
  16.426 +text{*Avoids duplicating X and its components!*}
  16.427 +lemma parts_insert_signCert:
  16.428 +     "parts (insert (signCert K X) H) =  
  16.429 +      insert {|X, Crypt K X|} (parts (insert (Crypt K X) H))"
  16.430 +by (simp add: signCert_def insert_commute [of X])
  16.431 +
  16.432 +text{*Avoids a case split! [X is always available]*}
  16.433 +lemma analz_insert_signCert:
  16.434 +     "analz (insert (signCert K X) H) =  
  16.435 +      insert {|X, Crypt K X|} (insert (Crypt K X) (analz (insert X H)))"
  16.436 +by (simp add: signCert_def insert_commute [of X])
  16.437 +
  16.438 +lemma keysFor_insert_signCert: "keysFor (insert (signCert K X) H) = keysFor H"
  16.439 +by (simp add: signCert_def)
  16.440 +
  16.441 +text{*Controlled rewrite rules for @{term signCert}, just the definitions
  16.442 +  of the others. Encryption primitives are just expanded, despite their huge
  16.443 +  redundancy!*}
  16.444 +lemmas abbrev_simps [simp] =
  16.445 +    parts_insert_signCert analz_insert_signCert keysFor_insert_signCert
  16.446 +    sign_def     [THEN def_abbrev_simp_relation]
  16.447 +    sign_def     [THEN def_abbrev_simp_function]
  16.448 +    signCert_def [THEN def_abbrev_simp_relation]
  16.449 +    signCert_def [THEN def_abbrev_simp_function]
  16.450 +    certC_def    [THEN def_abbrev_simp_relation]
  16.451 +    certC_def    [THEN def_abbrev_simp_function]
  16.452 +    cert_def     [THEN def_abbrev_simp_relation]
  16.453 +    cert_def     [THEN def_abbrev_simp_function]
  16.454 +    EXcrypt_def  [THEN def_abbrev_simp_relation]
  16.455 +    EXcrypt_def  [THEN def_abbrev_simp_function]
  16.456 +    EXHcrypt_def [THEN def_abbrev_simp_relation]
  16.457 +    EXHcrypt_def [THEN def_abbrev_simp_function]
  16.458 +    Enc_def      [THEN def_abbrev_simp_relation]
  16.459 +    Enc_def      [THEN def_abbrev_simp_function]
  16.460 +    EncB_def     [THEN def_abbrev_simp_relation]
  16.461 +    EncB_def     [THEN def_abbrev_simp_function]
  16.462 +
  16.463 +
  16.464 +subsubsection{*Elimination Rules for Controlled Rewriting *}
  16.465 +
  16.466 +lemma Enc_partsE: 
  16.467 +     "!!R. [|Enc SK K EK M \<in> parts H;  
  16.468 +             [|Crypt K (sign SK M) \<in> parts H;  
  16.469 +               Crypt EK (Key K) \<in> parts H|] ==> R|]  
  16.470 +           ==> R"
  16.471 +
  16.472 +by (unfold Enc_def, blast)
  16.473 +
  16.474 +lemma EncB_partsE: 
  16.475 +     "!!R. [|EncB SK K EK M b \<in> parts H;  
  16.476 +             [|Crypt K (sign SK {|M, Hash b|}) \<in> parts H;  
  16.477 +               Crypt EK (Key K) \<in> parts H;  
  16.478 +               b \<in> parts H|] ==> R|]  
  16.479 +           ==> R"
  16.480 +by (unfold EncB_def Enc_def, blast)
  16.481 +
  16.482 +lemma EXcrypt_partsE: 
  16.483 +     "!!R. [|EXcrypt K EK M m \<in> parts H;  
  16.484 +             [|Crypt K {|M, Hash m|} \<in> parts H;  
  16.485 +               Crypt EK {|Key K, m|} \<in> parts H|] ==> R|]  
  16.486 +           ==> R"
  16.487 +by (unfold EXcrypt_def, blast)
  16.488 +
  16.489 +
  16.490 +subsection{*Lemmas to Simplify Expressions Involving @{term analz} *}
  16.491 +
  16.492 +lemma analz_knows_absorb:
  16.493 +     "Key K \<in> analz (knows Spy evs)  
  16.494 +      ==> analz (Key ` (insert K H) \<union> knows Spy evs) =  
  16.495 +          analz (Key ` H \<union> knows Spy evs)"
  16.496 +by (simp add: analz_insert_eq Un_upper2 [THEN analz_mono, THEN subsetD])
  16.497 +
  16.498 +lemma analz_knows_absorb2:
  16.499 +     "Key K \<in> analz (knows Spy evs)  
  16.500 +      ==> analz (Key ` (insert X (insert K H)) \<union> knows Spy evs) =  
  16.501 +          analz (Key ` (insert X H) \<union> knows Spy evs)"
  16.502 +apply (subst insert_commute)
  16.503 +apply (erule analz_knows_absorb)
  16.504 +done
  16.505 +
  16.506 +lemma analz_insert_subset_eq:
  16.507 +     "[|X \<in> analz (knows Spy evs);  knows Spy evs \<subseteq> H|]  
  16.508 +      ==> analz (insert X H) = analz H"
  16.509 +apply (rule analz_insert_eq)
  16.510 +apply (blast intro: analz_mono [THEN [2] rev_subsetD])
  16.511 +done
  16.512 +
  16.513 +lemmas analz_insert_simps = 
  16.514 +         analz_insert_subset_eq Un_upper2
  16.515 +         subset_insertI [THEN [2] subset_trans] 
  16.516 +
  16.517 +
  16.518 +subsection{*Freshness Lemmas*}
  16.519 +
  16.520 +lemma in_parts_Says_imp_used:
  16.521 +     "[|Key K \<in> parts {X}; Says A B X \<in> set evs|] ==> Key K \<in> used evs"
  16.522 +by (blast intro: parts_trans dest!: Says_imp_knows_Spy [THEN parts.Inj])
  16.523 +
  16.524 +text{*A useful rewrite rule with @{term analz_image_keys_simps}*}
  16.525 +lemma Crypt_notin_image_Key: "Crypt K X \<notin> Key ` KK"
  16.526 +by auto
  16.527 +
  16.528 +lemma fresh_notin_analz_knows_Spy:
  16.529 +     "Key K \<notin> used evs ==> Key K \<notin> analz (knows Spy evs)"
  16.530 +by (auto dest: analz_into_parts)
  16.531 +
  16.532 +end
    17.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    17.2 +++ b/src/HOL/SET_Protocol/Purchase.thy	Tue Oct 20 20:03:23 2009 +0200
    17.3 @@ -0,0 +1,1172 @@
    17.4 +(*  Title:      HOL/SET_Protocol/Purchase.thy
    17.5 +    Author:     Giampaolo Bella
    17.6 +    Author:     Fabio Massacci
    17.7 +    Author:     Lawrence C Paulson
    17.8 +*)
    17.9 +
   17.10 +header{*Purchase Phase of SET*}
   17.11 +
   17.12 +theory Purchase
   17.13 +imports Public_SET
   17.14 +begin
   17.15 +
   17.16 +text{*
   17.17 +Note: nonces seem to consist of 20 bytes.  That includes both freshness
   17.18 +challenges (Chall-EE, etc.) and important secrets (CardSecret, PANsecret)
   17.19 +
   17.20 +This version omits @{text LID_C} but retains @{text LID_M}. At first glance
   17.21 +(Programmer's Guide page 267) it seems that both numbers are just introduced