| author | huffman | 
| Thu, 08 Jan 2009 09:58:36 -0800 | |
| changeset 29406 | 54bac26089bd | 
| parent 26809 | da662ff93503 | 
| child 32695 | 66ae4e8b1309 | 
| permissions | -rw-r--r-- | 
| 13508 | 1 | (****************************************************************************** | 
| 2 | date: november 2001 | |
| 3 | author: Frederic Blanqui | |
| 4 | email: blanqui@lri.fr | |
| 5 | webpage: http://www.lri.fr/~blanqui/ | |
| 6 | ||
| 7 | University of Cambridge, Computer Laboratory | |
| 8 | William Gates Building, JJ Thomson Avenue | |
| 9 | Cambridge CB3 0FD, United Kingdom | |
| 10 | ******************************************************************************) | |
| 11 | ||
| 12 | header {*Extensions to Standard Theories*}
 | |
| 13 | ||
| 18557 
60a0f9caa0a2
Provers/classical: stricter checks to ensure that supplied intro, dest and
 paulson parents: 
17689diff
changeset | 14 | theory Extensions imports "../Event" begin | 
| 13508 | 15 | |
| 16 | subsection{*Extensions to Theory @{text Set}*}
 | |
| 17 | ||
| 18 | lemma eq: "[| !!x. x:A ==> x:B; !!x. x:B ==> x:A |] ==> A=B" | |
| 19 | by auto | |
| 20 | ||
| 21 | lemma insert_Un: "P ({x} Un A) ==> P (insert x A)"
 | |
| 22 | by simp | |
| 23 | ||
| 24 | lemma in_sub: "x:A ==> {x}<=A"
 | |
| 25 | by auto | |
| 26 | ||
| 27 | ||
| 28 | subsection{*Extensions to Theory @{text List}*}
 | |
| 29 | ||
| 19233 
77ca20b0ed77
renamed HOL + - * etc. to HOL.plus HOL.minus HOL.times etc.
 haftmann parents: 
18557diff
changeset | 30 | subsubsection{*"remove l x" erase the first element of "l" equal to "x"*}
 | 
| 13508 | 31 | |
| 19233 
77ca20b0ed77
renamed HOL + - * etc. to HOL.plus HOL.minus HOL.times etc.
 haftmann parents: 
18557diff
changeset | 32 | consts remove :: "'a list => 'a => 'a list" | 
| 13508 | 33 | |
| 34 | primrec | |
| 19233 
77ca20b0ed77
renamed HOL + - * etc. to HOL.plus HOL.minus HOL.times etc.
 haftmann parents: 
18557diff
changeset | 35 | "remove [] y = []" | 
| 
77ca20b0ed77
renamed HOL + - * etc. to HOL.plus HOL.minus HOL.times etc.
 haftmann parents: 
18557diff
changeset | 36 | "remove (x#xs) y = (if x=y then xs else x # remove xs y)" | 
| 13508 | 37 | |
| 19233 
77ca20b0ed77
renamed HOL + - * etc. to HOL.plus HOL.minus HOL.times etc.
 haftmann parents: 
18557diff
changeset | 38 | lemma set_remove: "set (remove l x) <= set l" | 
| 13508 | 39 | by (induct l, auto) | 
| 40 | ||
| 41 | subsection{*Extensions to Theory @{text Message}*}
 | |
| 42 | ||
| 43 | subsubsection{*declarations for tactics*}
 | |
| 44 | ||
| 45 | declare analz_subset_parts [THEN subsetD, dest] | |
| 46 | declare image_eq_UN [simp] | |
| 47 | declare parts_insert2 [simp] | |
| 48 | declare analz_cut [dest] | |
| 49 | declare split_if_asm [split] | |
| 50 | declare analz_insertI [intro] | |
| 51 | declare Un_Diff [simp] | |
| 52 | ||
| 53 | subsubsection{*extract the agent number of an Agent message*}
 | |
| 54 | ||
| 55 | consts agt_nb :: "msg => agent" | |
| 56 | ||
| 57 | recdef agt_nb "measure size" | |
| 58 | "agt_nb (Agent A) = A" | |
| 59 | ||
| 60 | subsubsection{*messages that are pairs*}
 | |
| 61 | ||
| 62 | constdefs is_MPair :: "msg => bool" | |
| 63 | "is_MPair X == EX Y Z. X = {|Y,Z|}"
 | |
| 64 | ||
| 65 | declare is_MPair_def [simp] | |
| 66 | ||
| 67 | lemma MPair_is_MPair [iff]: "is_MPair {|X,Y|}"
 | |
| 68 | by simp | |
| 69 | ||
| 70 | lemma Agent_isnt_MPair [iff]: "~ is_MPair (Agent A)" | |
| 71 | by simp | |
| 72 | ||
| 73 | lemma Number_isnt_MPair [iff]: "~ is_MPair (Number n)" | |
| 74 | by simp | |
| 75 | ||
| 76 | lemma Key_isnt_MPair [iff]: "~ is_MPair (Key K)" | |
| 77 | by simp | |
| 78 | ||
| 79 | lemma Nonce_isnt_MPair [iff]: "~ is_MPair (Nonce n)" | |
| 80 | by simp | |
| 81 | ||
| 82 | lemma Hash_isnt_MPair [iff]: "~ is_MPair (Hash X)" | |
| 83 | by simp | |
| 84 | ||
| 85 | lemma Crypt_isnt_MPair [iff]: "~ is_MPair (Crypt K X)" | |
| 86 | by simp | |
| 87 | ||
| 20768 | 88 | abbreviation | 
| 21404 
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
 wenzelm parents: 
20768diff
changeset | 89 | not_MPair :: "msg => bool" where | 
| 20768 | 90 | "not_MPair X == ~ is_MPair X" | 
| 13508 | 91 | |
| 92 | lemma is_MPairE: "[| is_MPair X ==> P; not_MPair X ==> P |] ==> P" | |
| 93 | by auto | |
| 94 | ||
| 95 | declare is_MPair_def [simp del] | |
| 96 | ||
| 97 | constdefs has_no_pair :: "msg set => bool" | |
| 98 | "has_no_pair H == ALL X Y. {|X,Y|} ~:H"
 | |
| 99 | ||
| 100 | declare has_no_pair_def [simp] | |
| 101 | ||
| 102 | subsubsection{*well-foundedness of messages*}
 | |
| 103 | ||
| 104 | lemma wf_Crypt1 [iff]: "Crypt K X ~= X" | |
| 105 | by (induct X, auto) | |
| 106 | ||
| 107 | lemma wf_Crypt2 [iff]: "X ~= Crypt K X" | |
| 108 | by (induct X, auto) | |
| 109 | ||
| 110 | lemma parts_size: "X:parts {Y} ==> X=Y | size X < size Y"
 | |
| 111 | by (erule parts.induct, auto) | |
| 112 | ||
| 113 | lemma wf_Crypt_parts [iff]: "Crypt K X ~:parts {X}"
 | |
| 114 | by (auto dest: parts_size) | |
| 115 | ||
| 116 | subsubsection{*lemmas on keysFor*}
 | |
| 117 | ||
| 118 | constdefs usekeys :: "msg set => key set" | |
| 119 | "usekeys G == {K. EX Y. Crypt K Y:G}"
 | |
| 120 | ||
| 121 | lemma finite_keysFor [intro]: "finite G ==> finite (keysFor G)" | |
| 122 | apply (simp add: keysFor_def) | |
| 123 | apply (rule finite_UN_I, auto) | |
| 124 | apply (erule finite_induct, auto) | |
| 125 | apply (case_tac "EX K X. x = Crypt K X", clarsimp) | |
| 126 | apply (subgoal_tac "{Ka. EX Xa. (Ka=K & Xa=X) | Crypt Ka Xa:F}
 | |
| 127 | = insert K (usekeys F)", auto simp: usekeys_def) | |
| 128 | by (subgoal_tac "{K. EX X. Crypt K X = x | Crypt K X:F} = usekeys F",
 | |
| 129 | auto simp: usekeys_def) | |
| 130 | ||
| 131 | subsubsection{*lemmas on parts*}
 | |
| 132 | ||
| 133 | lemma parts_sub: "[| X:parts G; G<=H |] ==> X:parts H" | |
| 134 | by (auto dest: parts_mono) | |
| 135 | ||
| 136 | lemma parts_Diff [dest]: "X:parts (G - H) ==> X:parts G" | |
| 137 | by (erule parts_sub, auto) | |
| 138 | ||
| 139 | lemma parts_Diff_notin: "[| Y ~:H; Nonce n ~:parts (H - {Y}) |]
 | |
| 140 | ==> Nonce n ~:parts H" | |
| 141 | by simp | |
| 142 | ||
| 143 | lemmas parts_insert_substI = parts_insert [THEN ssubst] | |
| 144 | lemmas parts_insert_substD = parts_insert [THEN sym, THEN ssubst] | |
| 145 | ||
| 146 | lemma finite_parts_msg [iff]: "finite (parts {X})"
 | |
| 147 | by (induct X, auto) | |
| 148 | ||
| 149 | lemma finite_parts [intro]: "finite H ==> finite (parts H)" | |
| 150 | apply (erule finite_induct, simp) | |
| 151 | by (rule parts_insert_substI, simp) | |
| 152 | ||
| 153 | lemma parts_parts: "[| X:parts {Y}; Y:parts G |] ==> X:parts G"
 | |
| 17689 
a04b5b43625e
streamlined theory; conformance to recent publication
 paulson parents: 
16417diff
changeset | 154 | by (frule parts_cut, auto) | 
| 
a04b5b43625e
streamlined theory; conformance to recent publication
 paulson parents: 
16417diff
changeset | 155 | |
| 13508 | 156 | |
| 157 | lemma parts_parts_parts: "[| X:parts {Y}; Y:parts {Z}; Z:parts G |] ==> X:parts G"
 | |
| 158 | by (auto dest: parts_parts) | |
| 159 | ||
| 160 | lemma parts_parts_Crypt: "[| Crypt K X:parts G; Nonce n:parts {X} |]
 | |
| 161 | ==> Nonce n:parts G" | |
| 162 | by (blast intro: parts.Body dest: parts_parts) | |
| 163 | ||
| 164 | subsubsection{*lemmas on synth*}
 | |
| 165 | ||
| 166 | lemma synth_sub: "[| X:synth G; G<=H |] ==> X:synth H" | |
| 167 | by (auto dest: synth_mono) | |
| 168 | ||
| 169 | lemma Crypt_synth [rule_format]: "[| X:synth G; Key K ~:G |] ==> | |
| 170 | Crypt K Y:parts {X} --> Crypt K Y:parts G"
 | |
| 171 | by (erule synth.induct, auto dest: parts_sub) | |
| 172 | ||
| 173 | subsubsection{*lemmas on analz*}
 | |
| 174 | ||
| 175 | lemma analz_UnI1 [intro]: "X:analz G ==> X:analz (G Un H)" | |
| 176 | by (subgoal_tac "G <= G Un H", auto dest: analz_mono) | |
| 177 | ||
| 178 | lemma analz_sub: "[| X:analz G; G <= H |] ==> X:analz H" | |
| 179 | by (auto dest: analz_mono) | |
| 180 | ||
| 181 | lemma analz_Diff [dest]: "X:analz (G - H) ==> X:analz G" | |
| 182 | by (erule analz.induct, auto) | |
| 183 | ||
| 184 | lemmas in_analz_subset_cong = analz_subset_cong [THEN subsetD] | |
| 185 | ||
| 186 | lemma analz_eq: "A=A' ==> analz A = analz A'" | |
| 187 | by auto | |
| 188 | ||
| 189 | lemmas insert_commute_substI = insert_commute [THEN ssubst] | |
| 190 | ||
| 14307 | 191 | lemma analz_insertD: | 
| 192 | "[| Crypt K Y:H; Key (invKey K):H |] ==> analz (insert Y H) = analz H" | |
| 193 | by (blast intro: analz.Decrypt analz_insert_eq) | |
| 13508 | 194 | |
| 195 | lemma must_decrypt [rule_format,dest]: "[| X:analz H; has_no_pair H |] ==> | |
| 196 | X ~:H --> (EX K Y. Crypt K Y:H & Key (invKey K):H)" | |
| 197 | by (erule analz.induct, auto) | |
| 198 | ||
| 199 | lemma analz_needs_only_finite: "X:analz H ==> EX G. G <= H & finite G" | |
| 200 | by (erule analz.induct, auto) | |
| 201 | ||
| 202 | lemma notin_analz_insert: "X ~:analz (insert Y G) ==> X ~:analz G" | |
| 203 | by auto | |
| 204 | ||
| 205 | subsubsection{*lemmas on parts, synth and analz*}
 | |
| 206 | ||
| 207 | lemma parts_invKey [rule_format,dest]:"X:parts {Y} ==>
 | |
| 208 | X:analz (insert (Crypt K Y) H) --> X ~:analz H --> Key (invKey K):analz H" | |
| 26809 
da662ff93503
- Instantiated parts_insert_substD to avoid problems with HO unification
 berghofe parents: 
21404diff
changeset | 209 | by (erule parts.induct, (fastsimp dest: parts.Fst parts.Snd parts.Body)+) | 
| 13508 | 210 | |
| 211 | lemma in_analz: "Y:analz H ==> EX X. X:H & Y:parts {X}"
 | |
| 212 | by (erule analz.induct, auto intro: parts.Fst parts.Snd parts.Body) | |
| 213 | ||
| 214 | lemmas in_analz_subset_parts = analz_subset_parts [THEN subsetD] | |
| 215 | ||
| 216 | lemma Crypt_synth_insert: "[| Crypt K X:parts (insert Y H); | |
| 217 | Y:synth (analz H); Key K ~:analz H |] ==> Crypt K X:parts H" | |
| 26809 
da662ff93503
- Instantiated parts_insert_substD to avoid problems with HO unification
 berghofe parents: 
21404diff
changeset | 218 | apply (drule parts_insert_substD [where P="%S. Crypt K X : S"], clarify) | 
| 13508 | 219 | apply (frule in_sub) | 
| 220 | apply (frule parts_mono) | |
| 221 | by auto | |
| 222 | ||
| 223 | subsubsection{*greatest nonce used in a message*}
 | |
| 224 | ||
| 225 | consts greatest_msg :: "msg => nat" | |
| 226 | ||
| 227 | recdef greatest_msg "measure size" | |
| 228 | "greatest_msg (Nonce n) = n" | |
| 229 | "greatest_msg {|X,Y|} = max (greatest_msg X) (greatest_msg Y)"
 | |
| 230 | "greatest_msg (Crypt K X) = greatest_msg X" | |
| 231 | "greatest_msg other = 0" | |
| 232 | ||
| 233 | lemma greatest_msg_is_greatest: "Nonce n:parts {X} ==> n <= greatest_msg X"
 | |
| 20217 
25b068a99d2b
linear arithmetic splits certain operators (e.g. min, max, abs)
 webertj parents: 
19233diff
changeset | 234 | by (induct X, auto) | 
| 13508 | 235 | |
| 236 | subsubsection{*sets of keys*}
 | |
| 237 | ||
| 238 | constdefs keyset :: "msg set => bool" | |
| 239 | "keyset G == ALL X. X:G --> (EX K. X = Key K)" | |
| 240 | ||
| 241 | lemma keyset_in [dest]: "[| keyset G; X:G |] ==> EX K. X = Key K" | |
| 242 | by (auto simp: keyset_def) | |
| 243 | ||
| 244 | lemma MPair_notin_keyset [simp]: "keyset G ==> {|X,Y|} ~:G"
 | |
| 245 | by auto | |
| 246 | ||
| 247 | lemma Crypt_notin_keyset [simp]: "keyset G ==> Crypt K X ~:G" | |
| 248 | by auto | |
| 249 | ||
| 250 | lemma Nonce_notin_keyset [simp]: "keyset G ==> Nonce n ~:G" | |
| 251 | by auto | |
| 252 | ||
| 253 | lemma parts_keyset [simp]: "keyset G ==> parts G = G" | |
| 254 | by (auto, erule parts.induct, auto) | |
| 255 | ||
| 256 | subsubsection{*keys a priori necessary for decrypting the messages of G*}
 | |
| 257 | ||
| 258 | constdefs keysfor :: "msg set => msg set" | |
| 259 | "keysfor G == Key ` keysFor (parts G)" | |
| 260 | ||
| 261 | lemma keyset_keysfor [iff]: "keyset (keysfor G)" | |
| 262 | by (simp add: keyset_def keysfor_def, blast) | |
| 263 | ||
| 264 | lemma keyset_Diff_keysfor [simp]: "keyset H ==> keyset (H - keysfor G)" | |
| 265 | by (auto simp: keyset_def) | |
| 266 | ||
| 267 | lemma keysfor_Crypt: "Crypt K X:parts G ==> Key (invKey K):keysfor G" | |
| 268 | by (auto simp: keysfor_def Crypt_imp_invKey_keysFor) | |
| 269 | ||
| 270 | lemma no_key_no_Crypt: "Key K ~:keysfor G ==> Crypt (invKey K) X ~:parts G" | |
| 271 | by (auto dest: keysfor_Crypt) | |
| 272 | ||
| 273 | lemma finite_keysfor [intro]: "finite G ==> finite (keysfor G)" | |
| 274 | by (auto simp: keysfor_def intro: finite_UN_I) | |
| 275 | ||
| 276 | subsubsection{*only the keys necessary for G are useful in analz*}
 | |
| 277 | ||
| 278 | lemma analz_keyset: "keyset H ==> | |
| 279 | analz (G Un H) = H - keysfor G Un (analz (G Un (H Int keysfor G)))" | |
| 280 | apply (rule eq) | |
| 281 | apply (erule analz.induct, blast) | |
| 18557 
60a0f9caa0a2
Provers/classical: stricter checks to ensure that supplied intro, dest and
 paulson parents: 
17689diff
changeset | 282 | apply (simp, blast) | 
| 
60a0f9caa0a2
Provers/classical: stricter checks to ensure that supplied intro, dest and
 paulson parents: 
17689diff
changeset | 283 | apply (simp, blast) | 
| 13508 | 284 | apply (case_tac "Key (invKey K):H - keysfor G", clarsimp) | 
| 285 | apply (drule_tac X=X in no_key_no_Crypt) | |
| 286 | by (auto intro: analz_sub) | |
| 287 | ||
| 288 | lemmas analz_keyset_substD = analz_keyset [THEN sym, THEN ssubst] | |
| 289 | ||
| 290 | ||
| 291 | subsection{*Extensions to Theory @{text Event}*}
 | |
| 292 | ||
| 293 | ||
| 294 | subsubsection{*general protocol properties*}
 | |
| 295 | ||
| 296 | constdefs is_Says :: "event => bool" | |
| 297 | "is_Says ev == (EX A B X. ev = Says A B X)" | |
| 298 | ||
| 299 | lemma is_Says_Says [iff]: "is_Says (Says A B X)" | |
| 300 | by (simp add: is_Says_def) | |
| 301 | ||
| 302 | (* one could also require that Gets occurs after Says | |
| 303 | but this is sufficient for our purpose *) | |
| 304 | constdefs Gets_correct :: "event list set => bool" | |
| 305 | "Gets_correct p == ALL evs B X. evs:p --> Gets B X:set evs | |
| 306 | --> (EX A. Says A B X:set evs)" | |
| 307 | ||
| 308 | lemma Gets_correct_Says: "[| Gets_correct p; Gets B X # evs:p |] | |
| 309 | ==> EX A. Says A B X:set evs" | |
| 310 | apply (simp add: Gets_correct_def) | |
| 311 | by (drule_tac x="Gets B X # evs" in spec, auto) | |
| 312 | ||
| 313 | constdefs one_step :: "event list set => bool" | |
| 314 | "one_step p == ALL evs ev. ev#evs:p --> evs:p" | |
| 315 | ||
| 316 | lemma one_step_Cons [dest]: "[| one_step p; ev#evs:p |] ==> evs:p" | |
| 317 | by (unfold one_step_def, blast) | |
| 318 | ||
| 319 | lemma one_step_app: "[| evs@evs':p; one_step p; []:p |] ==> evs':p" | |
| 320 | by (induct evs, auto) | |
| 321 | ||
| 322 | lemma trunc: "[| evs @ evs':p; one_step p |] ==> evs':p" | |
| 323 | by (induct evs, auto) | |
| 324 | ||
| 325 | constdefs has_only_Says :: "event list set => bool" | |
| 326 | "has_only_Says p == ALL evs ev. evs:p --> ev:set evs | |
| 327 | --> (EX A B X. ev = Says A B X)" | |
| 328 | ||
| 329 | lemma has_only_SaysD: "[| ev:set evs; evs:p; has_only_Says p |] | |
| 330 | ==> EX A B X. ev = Says A B X" | |
| 331 | by (unfold has_only_Says_def, blast) | |
| 332 | ||
| 333 | lemma in_has_only_Says [dest]: "[| has_only_Says p; evs:p; ev:set evs |] | |
| 334 | ==> EX A B X. ev = Says A B X" | |
| 335 | by (auto simp: has_only_Says_def) | |
| 336 | ||
| 337 | lemma has_only_Says_imp_Gets_correct [simp]: "has_only_Says p | |
| 338 | ==> Gets_correct p" | |
| 339 | by (auto simp: has_only_Says_def Gets_correct_def) | |
| 340 | ||
| 341 | subsubsection{*lemma on knows*}
 | |
| 342 | ||
| 343 | lemma Says_imp_spies2: "Says A B {|X,Y|}:set evs ==> Y:parts (spies evs)"
 | |
| 344 | by (drule Says_imp_spies, drule parts.Inj, drule parts.Snd, simp) | |
| 345 | ||
| 346 | lemma Says_not_parts: "[| Says A B X:set evs; Y ~:parts (spies evs) |] | |
| 347 | ==> Y ~:parts {X}"
 | |
| 348 | by (auto dest: Says_imp_spies parts_parts) | |
| 349 | ||
| 350 | subsubsection{*knows without initState*}
 | |
| 351 | ||
| 352 | consts knows' :: "agent => event list => msg set" | |
| 353 | ||
| 354 | primrec | |
| 14307 | 355 | knows'_Nil: | 
| 356 |  "knows' A [] = {}"
 | |
| 357 | ||
| 358 | knows'_Cons0: | |
| 359 | "knows' A (ev # evs) = ( | |
| 360 | if A = Spy then ( | |
| 361 | case ev of | |
| 362 | Says A' B X => insert X (knows' A evs) | |
| 363 | | Gets A' X => knows' A evs | |
| 364 | | Notes A' X => if A':bad then insert X (knows' A evs) else knows' A evs | |
| 365 | ) else ( | |
| 366 | case ev of | |
| 367 | Says A' B X => if A=A' then insert X (knows' A evs) else knows' A evs | |
| 368 | | Gets A' X => if A=A' then insert X (knows' A evs) else knows' A evs | |
| 369 | | Notes A' X => if A=A' then insert X (knows' A evs) else knows' A evs | |
| 370 | ))" | |
| 13508 | 371 | |
| 20768 | 372 | abbreviation | 
| 21404 
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
 wenzelm parents: 
20768diff
changeset | 373 | spies' :: "event list => msg set" where | 
| 20768 | 374 | "spies' == knows' Spy" | 
| 13508 | 375 | |
| 376 | subsubsection{*decomposition of knows into knows' and initState*}
 | |
| 377 | ||
| 378 | lemma knows_decomp: "knows A evs = knows' A evs Un (initState A)" | |
| 379 | by (induct evs, auto split: event.split simp: knows.simps) | |
| 380 | ||
| 381 | lemmas knows_decomp_substI = knows_decomp [THEN ssubst] | |
| 382 | lemmas knows_decomp_substD = knows_decomp [THEN sym, THEN ssubst] | |
| 383 | ||
| 384 | lemma knows'_sub_knows: "knows' A evs <= knows A evs" | |
| 385 | by (auto simp: knows_decomp) | |
| 386 | ||
| 387 | lemma knows'_Cons: "knows' A (ev#evs) = knows' A [ev] Un knows' A evs" | |
| 388 | by (induct ev, auto) | |
| 389 | ||
| 390 | lemmas knows'_Cons_substI = knows'_Cons [THEN ssubst] | |
| 391 | lemmas knows'_Cons_substD = knows'_Cons [THEN sym, THEN ssubst] | |
| 392 | ||
| 393 | lemma knows_Cons: "knows A (ev#evs) = initState A Un knows' A [ev] | |
| 394 | Un knows A evs" | |
| 395 | apply (simp only: knows_decomp) | |
| 396 | apply (rule_tac s="(knows' A [ev] Un knows' A evs) Un initState A" in trans) | |
| 14307 | 397 | apply (simp only: knows'_Cons [of A ev evs] Un_ac) | 
| 398 | apply blast | |
| 399 | done | |
| 400 | ||
| 13508 | 401 | |
| 402 | lemmas knows_Cons_substI = knows_Cons [THEN ssubst] | |
| 403 | lemmas knows_Cons_substD = knows_Cons [THEN sym, THEN ssubst] | |
| 404 | ||
| 405 | lemma knows'_sub_spies': "[| evs:p; has_only_Says p; one_step p |] | |
| 406 | ==> knows' A evs <= spies' evs" | |
| 407 | by (induct evs, auto split: event.splits) | |
| 408 | ||
| 409 | subsubsection{*knows' is finite*}
 | |
| 410 | ||
| 411 | lemma finite_knows' [iff]: "finite (knows' A evs)" | |
| 412 | by (induct evs, auto split: event.split simp: knows.simps) | |
| 413 | ||
| 414 | subsubsection{*monotonicity of knows*}
 | |
| 415 | ||
| 416 | lemma knows_sub_Cons: "knows A evs <= knows A (ev#evs)" | |
| 13596 | 417 | by(cases A, induct evs, auto simp: knows.simps split:event.split) | 
| 13508 | 418 | |
| 419 | lemma knows_ConsI: "X:knows A evs ==> X:knows A (ev#evs)" | |
| 420 | by (auto dest: knows_sub_Cons [THEN subsetD]) | |
| 421 | ||
| 422 | lemma knows_sub_app: "knows A evs <= knows A (evs @ evs')" | |
| 423 | apply (induct evs, auto) | |
| 424 | apply (simp add: knows_decomp) | |
| 425 | by (case_tac a, auto simp: knows.simps) | |
| 426 | ||
| 427 | subsubsection{*maximum knowledge an agent can have
 | |
| 428 | includes messages sent to the agent*} | |
| 429 | ||
| 430 | consts knows_max' :: "agent => event list => msg set" | |
| 431 | ||
| 432 | primrec | |
| 433 | knows_max'_def_Nil: "knows_max' A [] = {}"
 | |
| 434 | knows_max'_def_Cons: "knows_max' A (ev # evs) = ( | |
| 435 | if A=Spy then ( | |
| 436 | case ev of | |
| 437 | Says A' B X => insert X (knows_max' A evs) | |
| 438 | | Gets A' X => knows_max' A evs | |
| 439 | | Notes A' X => | |
| 440 | if A':bad then insert X (knows_max' A evs) else knows_max' A evs | |
| 441 | ) else ( | |
| 442 | case ev of | |
| 443 | Says A' B X => | |
| 444 | if A=A' | A=B then insert X (knows_max' A evs) else knows_max' A evs | |
| 445 | | Gets A' X => | |
| 446 | if A=A' then insert X (knows_max' A evs) else knows_max' A evs | |
| 447 | | Notes A' X => | |
| 448 | if A=A' then insert X (knows_max' A evs) else knows_max' A evs | |
| 449 | ))" | |
| 450 | ||
| 451 | constdefs knows_max :: "agent => event list => msg set" | |
| 452 | "knows_max A evs == knows_max' A evs Un initState A" | |
| 453 | ||
| 20768 | 454 | abbreviation | 
| 21404 
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
 wenzelm parents: 
20768diff
changeset | 455 | spies_max :: "event list => msg set" where | 
| 20768 | 456 | "spies_max evs == knows_max Spy evs" | 
| 13508 | 457 | |
| 458 | subsubsection{*basic facts about @{term knows_max}*}
 | |
| 459 | ||
| 460 | lemma spies_max_spies [iff]: "spies_max evs = spies evs" | |
| 461 | by (induct evs, auto simp: knows_max_def split: event.splits) | |
| 462 | ||
| 463 | lemma knows_max'_Cons: "knows_max' A (ev#evs) | |
| 464 | = knows_max' A [ev] Un knows_max' A evs" | |
| 465 | by (auto split: event.splits) | |
| 466 | ||
| 467 | lemmas knows_max'_Cons_substI = knows_max'_Cons [THEN ssubst] | |
| 468 | lemmas knows_max'_Cons_substD = knows_max'_Cons [THEN sym, THEN ssubst] | |
| 469 | ||
| 470 | lemma knows_max_Cons: "knows_max A (ev#evs) | |
| 471 | = knows_max' A [ev] Un knows_max A evs" | |
| 472 | apply (simp add: knows_max_def del: knows_max'_def_Cons) | |
| 473 | apply (rule_tac evs1=evs in knows_max'_Cons_substI) | |
| 474 | by blast | |
| 475 | ||
| 476 | lemmas knows_max_Cons_substI = knows_max_Cons [THEN ssubst] | |
| 477 | lemmas knows_max_Cons_substD = knows_max_Cons [THEN sym, THEN ssubst] | |
| 478 | ||
| 479 | lemma finite_knows_max' [iff]: "finite (knows_max' A evs)" | |
| 480 | by (induct evs, auto split: event.split) | |
| 481 | ||
| 482 | lemma knows_max'_sub_spies': "[| evs:p; has_only_Says p; one_step p |] | |
| 483 | ==> knows_max' A evs <= spies' evs" | |
| 484 | by (induct evs, auto split: event.splits) | |
| 485 | ||
| 486 | lemma knows_max'_in_spies' [dest]: "[| evs:p; X:knows_max' A evs; | |
| 487 | has_only_Says p; one_step p |] ==> X:spies' evs" | |
| 488 | by (rule knows_max'_sub_spies' [THEN subsetD], auto) | |
| 489 | ||
| 490 | lemma knows_max'_app: "knows_max' A (evs @ evs') | |
| 491 | = knows_max' A evs Un knows_max' A evs'" | |
| 492 | by (induct evs, auto split: event.splits) | |
| 493 | ||
| 494 | lemma Says_to_knows_max': "Says A B X:set evs ==> X:knows_max' B evs" | |
| 495 | by (simp add: in_set_conv_decomp, clarify, simp add: knows_max'_app) | |
| 496 | ||
| 497 | lemma Says_from_knows_max': "Says A B X:set evs ==> X:knows_max' A evs" | |
| 498 | by (simp add: in_set_conv_decomp, clarify, simp add: knows_max'_app) | |
| 499 | ||
| 500 | subsubsection{*used without initState*}
 | |
| 501 | ||
| 502 | consts used' :: "event list => msg set" | |
| 503 | ||
| 504 | primrec | |
| 505 | "used' [] = {}"
 | |
| 506 | "used' (ev # evs) = ( | |
| 507 | case ev of | |
| 508 |     Says A B X => parts {X} Un used' evs
 | |
| 509 | | Gets A X => used' evs | |
| 510 |     | Notes A X => parts {X} Un used' evs
 | |
| 511 | )" | |
| 512 | ||
| 513 | constdefs init :: "msg set" | |
| 514 | "init == used []" | |
| 515 | ||
| 516 | lemma used_decomp: "used evs = init Un used' evs" | |
| 517 | by (induct evs, auto simp: init_def split: event.split) | |
| 518 | ||
| 519 | lemma used'_sub_app: "used' evs <= used' (evs@evs')" | |
| 520 | by (induct evs, auto split: event.split) | |
| 521 | ||
| 522 | lemma used'_parts [rule_format]: "X:used' evs ==> Y:parts {X} --> Y:used' evs"
 | |
| 523 | apply (induct evs, simp) | |
| 524 | apply (case_tac a, simp_all) | |
| 525 | apply (blast dest: parts_trans)+; | |
| 526 | done | |
| 527 | ||
| 528 | subsubsection{*monotonicity of used*}
 | |
| 529 | ||
| 530 | lemma used_sub_Cons: "used evs <= used (ev#evs)" | |
| 531 | by (induct evs, (induct ev, auto)+) | |
| 532 | ||
| 533 | lemma used_ConsI: "X:used evs ==> X:used (ev#evs)" | |
| 534 | by (auto dest: used_sub_Cons [THEN subsetD]) | |
| 535 | ||
| 536 | lemma notin_used_ConsD: "X ~:used (ev#evs) ==> X ~:used evs" | |
| 537 | by (auto dest: used_sub_Cons [THEN subsetD]) | |
| 538 | ||
| 539 | lemma used_appD [dest]: "X:used (evs @ evs') ==> X:used evs | X:used evs'" | |
| 540 | by (induct evs, auto, case_tac a, auto) | |
| 541 | ||
| 542 | lemma used_ConsD: "X:used (ev#evs) ==> X:used [ev] | X:used evs" | |
| 543 | by (case_tac ev, auto) | |
| 544 | ||
| 545 | lemma used_sub_app: "used evs <= used (evs@evs')" | |
| 546 | by (auto simp: used_decomp dest: used'_sub_app [THEN subsetD]) | |
| 547 | ||
| 548 | lemma used_appIL: "X:used evs ==> X:used (evs' @ evs)" | |
| 549 | by (induct evs', auto intro: used_ConsI) | |
| 550 | ||
| 551 | lemma used_appIR: "X:used evs ==> X:used (evs @ evs')" | |
| 552 | by (erule used_sub_app [THEN subsetD]) | |
| 553 | ||
| 554 | lemma used_parts: "[| X:parts {Y}; Y:used evs |] ==> X:used evs"
 | |
| 555 | apply (auto simp: used_decomp dest: used'_parts) | |
| 556 | by (auto simp: init_def used_Nil dest: parts_trans) | |
| 557 | ||
| 558 | lemma parts_Says_used: "[| Says A B X:set evs; Y:parts {X} |] ==> Y:used evs"
 | |
| 559 | by (induct evs, simp_all, safe, auto intro: used_ConsI) | |
| 560 | ||
| 561 | lemma parts_used_app: "X:parts {Y} ==> X:used (evs @ Says A B Y # evs')"
 | |
| 562 | apply (drule_tac evs="[Says A B Y]" in used_parts, simp, blast) | |
| 563 | apply (drule_tac evs'=evs' in used_appIR) | |
| 564 | apply (drule_tac evs'=evs in used_appIL) | |
| 565 | by simp | |
| 566 | ||
| 567 | subsubsection{*lemmas on used and knows*}
 | |
| 568 | ||
| 569 | lemma initState_used: "X:parts (initState A) ==> X:used evs" | |
| 570 | by (induct evs, auto simp: used.simps split: event.split) | |
| 571 | ||
| 572 | lemma Says_imp_used: "Says A B X:set evs ==> parts {X} <= used evs"
 | |
| 573 | by (induct evs, auto intro: used_ConsI) | |
| 574 | ||
| 575 | lemma not_used_not_spied: "X ~:used evs ==> X ~:parts (spies evs)" | |
| 576 | by (induct evs, auto simp: used_Nil) | |
| 577 | ||
| 578 | lemma not_used_not_parts: "[| Y ~:used evs; Says A B X:set evs |] | |
| 579 | ==> Y ~:parts {X}"
 | |
| 580 | by (induct evs, auto intro: used_ConsI) | |
| 581 | ||
| 582 | lemma not_used_parts_false: "[| X ~:used evs; Y:parts (spies evs) |] | |
| 583 | ==> X ~:parts {Y}"
 | |
| 584 | by (auto dest: parts_parts) | |
| 585 | ||
| 586 | lemma known_used [rule_format]: "[| evs:p; Gets_correct p; one_step p |] | |
| 587 | ==> X:parts (knows A evs) --> X:used evs" | |
| 18557 
60a0f9caa0a2
Provers/classical: stricter checks to ensure that supplied intro, dest and
 paulson parents: 
17689diff
changeset | 588 | apply (case_tac "A=Spy", blast) | 
| 13508 | 589 | apply (induct evs) | 
| 590 | apply (simp add: used.simps, blast) | |
| 15236 
f289e8ba2bb3
Proofs needed to be updated because induction now preserves name of
 nipkow parents: 
14307diff
changeset | 591 | apply (frule_tac ev=a and evs=evs in one_step_Cons, simp, clarify) | 
| 13508 | 592 | apply (drule_tac P="%G. X:parts G" in knows_Cons_substD, safe) | 
| 593 | apply (erule initState_used) | |
| 594 | apply (case_tac a, auto) | |
| 15236 
f289e8ba2bb3
Proofs needed to be updated because induction now preserves name of
 nipkow parents: 
14307diff
changeset | 595 | apply (drule_tac B=A and X=msg and evs=evs in Gets_correct_Says) | 
| 13508 | 596 | by (auto dest: Says_imp_used intro: used_ConsI) | 
| 597 | ||
| 598 | lemma known_max_used [rule_format]: "[| evs:p; Gets_correct p; one_step p |] | |
| 599 | ==> X:parts (knows_max A evs) --> X:used evs" | |
| 600 | apply (case_tac "A=Spy") | |
| 18557 
60a0f9caa0a2
Provers/classical: stricter checks to ensure that supplied intro, dest and
 paulson parents: 
17689diff
changeset | 601 | apply force | 
| 13508 | 602 | apply (induct evs) | 
| 603 | apply (simp add: knows_max_def used.simps, blast) | |
| 15236 
f289e8ba2bb3
Proofs needed to be updated because induction now preserves name of
 nipkow parents: 
14307diff
changeset | 604 | apply (frule_tac ev=a and evs=evs in one_step_Cons, simp, clarify) | 
| 13508 | 605 | apply (drule_tac P="%G. X:parts G" in knows_max_Cons_substD, safe) | 
| 606 | apply (case_tac a, auto) | |
| 15236 
f289e8ba2bb3
Proofs needed to be updated because induction now preserves name of
 nipkow parents: 
14307diff
changeset | 607 | apply (drule_tac B=A and X=msg and evs=evs in Gets_correct_Says) | 
| 13508 | 608 | by (auto simp: knows_max'_Cons dest: Says_imp_used intro: used_ConsI) | 
| 609 | ||
| 610 | lemma not_used_not_known: "[| evs:p; X ~:used evs; | |
| 611 | Gets_correct p; one_step p |] ==> X ~:parts (knows A evs)" | |
| 612 | by (case_tac "A=Spy", auto dest: not_used_not_spied known_used) | |
| 613 | ||
| 614 | lemma not_used_not_known_max: "[| evs:p; X ~:used evs; | |
| 615 | Gets_correct p; one_step p |] ==> X ~:parts (knows_max A evs)" | |
| 616 | by (case_tac "A=Spy", auto dest: not_used_not_spied known_max_used) | |
| 617 | ||
| 618 | subsubsection{*a nonce or key in a message cannot equal a fresh nonce or key*}
 | |
| 619 | ||
| 620 | lemma Nonce_neq [dest]: "[| Nonce n' ~:used evs; | |
| 621 | Says A B X:set evs; Nonce n:parts {X} |] ==> n ~= n'"
 | |
| 622 | by (drule not_used_not_spied, auto dest: Says_imp_knows_Spy parts_sub) | |
| 623 | ||
| 624 | lemma Key_neq [dest]: "[| Key n' ~:used evs; | |
| 625 | Says A B X:set evs; Key n:parts {X} |] ==> n ~= n'"
 | |
| 626 | by (drule not_used_not_spied, auto dest: Says_imp_knows_Spy parts_sub) | |
| 627 | ||
| 628 | subsubsection{*message of an event*}
 | |
| 629 | ||
| 630 | consts msg :: "event => msg" | |
| 631 | ||
| 632 | recdef msg "measure size" | |
| 633 | "msg (Says A B X) = X" | |
| 634 | "msg (Gets A X) = X" | |
| 635 | "msg (Notes A X) = X" | |
| 636 | ||
| 637 | lemma used_sub_parts_used: "X:used (ev # evs) ==> X:parts {msg ev} Un used evs"
 | |
| 638 | by (induct ev, auto) | |
| 639 | ||
| 640 | ||
| 641 | ||
| 642 | end |