|
1 header{*Theory of Events for Security Protocols that use smartcards*} |
|
2 |
|
3 theory EventSC imports "../Message" begin |
|
4 |
|
5 consts (*Initial states of agents -- parameter of the construction*) |
|
6 initState :: "agent => msg set" |
|
7 |
|
8 datatype card = Card agent |
|
9 |
|
10 text{*Four new events express the traffic between an agent and his card*} |
|
11 datatype |
|
12 event = Says agent agent msg |
|
13 | Notes agent msg |
|
14 | Gets agent msg |
|
15 | Inputs agent card msg (*Agent sends to card and\<dots>*) |
|
16 | C_Gets card msg (*\<dots> card receives it*) |
|
17 | Outpts card agent msg (*Card sends to agent and\<dots>*) |
|
18 | A_Gets agent msg (*agent receives it*) |
|
19 |
|
20 consts |
|
21 bad :: "agent set" (*compromised agents*) |
|
22 knows :: "agent => event list => msg set" (*agents' knowledge*) |
|
23 stolen :: "card set" (* stolen smart cards *) |
|
24 cloned :: "card set" (* cloned smart cards*) |
|
25 secureM :: "bool"(*assumption of secure means between agents and their cards*) |
|
26 |
|
27 syntax |
|
28 insecureM :: bool (*certain protocols make no assumption of secure means*) |
|
29 translations |
|
30 "insecureM" == "\<not>secureM" |
|
31 |
|
32 |
|
33 text{*Spy has access to his own key for spoof messages, but Server is secure*} |
|
34 specification (bad) |
|
35 Spy_in_bad [iff]: "Spy \<in> bad" |
|
36 Server_not_bad [iff]: "Server \<notin> bad" |
|
37 apply (rule exI [of _ "{Spy}"], simp) done |
|
38 |
|
39 specification (stolen) |
|
40 (*The server's card is secure by assumption\<dots>*) |
|
41 Card_Server_not_stolen [iff]: "Card Server \<notin> stolen" |
|
42 Card_Spy_not_stolen [iff]: "Card Spy \<notin> stolen" |
|
43 apply blast done |
|
44 |
|
45 specification (cloned) |
|
46 (*\<dots> the spy's card is secure because she already can use it freely*) |
|
47 Card_Server_not_cloned [iff]: "Card Server \<notin> cloned" |
|
48 Card_Spy_not_cloned [iff]: "Card Spy \<notin> cloned" |
|
49 apply blast done |
|
50 |
|
51 |
|
52 primrec (*This definition is extended over the new events, subject to the |
|
53 assumption of secure means*) |
|
54 knows_Nil: "knows A [] = initState A" |
|
55 knows_Cons: "knows A (ev # evs) = |
|
56 (case ev of |
|
57 Says A' B X => |
|
58 if (A=A' | A=Spy) then insert X (knows A evs) else knows A evs |
|
59 | Notes A' X => |
|
60 if (A=A' | (A=Spy & A'\<in>bad)) then insert X (knows A evs) |
|
61 else knows A evs |
|
62 | Gets A' X => |
|
63 if (A=A' & A \<noteq> Spy) then insert X (knows A evs) |
|
64 else knows A evs |
|
65 | Inputs A' C X => |
|
66 if secureM then |
|
67 if A=A' then insert X (knows A evs) else knows A evs |
|
68 else |
|
69 if (A=A' | A=Spy) then insert X (knows A evs) else knows A evs |
|
70 | C_Gets C X => knows A evs |
|
71 | Outpts C A' X => |
|
72 if secureM then |
|
73 if A=A' then insert X (knows A evs) else knows A evs |
|
74 else |
|
75 if A=Spy then insert X (knows A evs) else knows A evs |
|
76 | A_Gets A' X => |
|
77 if (A=A' & A \<noteq> Spy) then insert X (knows A evs) |
|
78 else knows A evs)" |
|
79 |
|
80 |
|
81 |
|
82 consts |
|
83 (*The set of items that might be visible to someone is easily extended |
|
84 over the new events*) |
|
85 used :: "event list => msg set" |
|
86 |
|
87 primrec |
|
88 used_Nil: "used [] = (UN B. parts (initState B))" |
|
89 used_Cons: "used (ev # evs) = |
|
90 (case ev of |
|
91 Says A B X => parts {X} \<union> (used evs) |
|
92 | Notes A X => parts {X} \<union> (used evs) |
|
93 | Gets A X => used evs |
|
94 | Inputs A C X => parts{X} \<union> (used evs) |
|
95 | C_Gets C X => used evs |
|
96 | Outpts C A X => parts{X} \<union> (used evs) |
|
97 | A_Gets A X => used evs)" |
|
98 --{*@{term Gets} always follows @{term Says} in real protocols. |
|
99 Likewise, @{term C_Gets} will always have to follow @{term Inputs} |
|
100 and @{term A_Gets} will always have to follow @{term Outpts}*} |
|
101 |
|
102 |
|
103 lemma Notes_imp_used [rule_format]: "Notes A X \<in> set evs \<longrightarrow> X \<in> used evs" |
|
104 apply (induct_tac evs) |
|
105 apply (auto split: event.split) |
|
106 done |
|
107 |
|
108 lemma Says_imp_used [rule_format]: "Says A B X \<in> set evs \<longrightarrow> X \<in> used evs" |
|
109 apply (induct_tac evs) |
|
110 apply (auto split: event.split) |
|
111 done |
|
112 |
|
113 lemma MPair_used [rule_format]: |
|
114 "MPair X Y \<in> used evs \<longrightarrow> X \<in> used evs & Y \<in> used evs" |
|
115 apply (induct_tac evs) |
|
116 apply (auto split: event.split) |
|
117 done |
|
118 |
|
119 |
|
120 subsection{*Function @{term knows}*} |
|
121 |
|
122 (*Simplifying |
|
123 parts(insert X (knows Spy evs)) = parts{X} \<union> parts(knows Spy evs). |
|
124 This version won't loop with the simplifier.*) |
|
125 lemmas parts_insert_knows_A = parts_insert [of _ "knows A evs", standard] |
|
126 |
|
127 lemma knows_Spy_Says [simp]: |
|
128 "knows Spy (Says A B X # evs) = insert X (knows Spy evs)" |
|
129 by simp |
|
130 |
|
131 text{*Letting the Spy see "bad" agents' notes avoids redundant case-splits |
|
132 on whether @{term "A=Spy"} and whether @{term "A\<in>bad"}*} |
|
133 lemma knows_Spy_Notes [simp]: |
|
134 "knows Spy (Notes A X # evs) = |
|
135 (if A\<in>bad then insert X (knows Spy evs) else knows Spy evs)" |
|
136 by simp |
|
137 |
|
138 lemma knows_Spy_Gets [simp]: "knows Spy (Gets A X # evs) = knows Spy evs" |
|
139 by simp |
|
140 |
|
141 lemma knows_Spy_Inputs_secureM [simp]: |
|
142 "secureM \<Longrightarrow> knows Spy (Inputs A C X # evs) = |
|
143 (if A=Spy then insert X (knows Spy evs) else knows Spy evs)" |
|
144 by simp |
|
145 |
|
146 lemma knows_Spy_Inputs_insecureM [simp]: |
|
147 "insecureM \<Longrightarrow> knows Spy (Inputs A C X # evs) = insert X (knows Spy evs)" |
|
148 by simp |
|
149 |
|
150 lemma knows_Spy_C_Gets [simp]: "knows Spy (C_Gets C X # evs) = knows Spy evs" |
|
151 by simp |
|
152 |
|
153 lemma knows_Spy_Outpts_secureM [simp]: |
|
154 "secureM \<Longrightarrow> knows Spy (Outpts C A X # evs) = |
|
155 (if A=Spy then insert X (knows Spy evs) else knows Spy evs)" |
|
156 by simp |
|
157 |
|
158 lemma knows_Spy_Outpts_insecureM [simp]: |
|
159 "insecureM \<Longrightarrow> knows Spy (Outpts C A X # evs) = insert X (knows Spy evs)" |
|
160 by simp |
|
161 |
|
162 lemma knows_Spy_A_Gets [simp]: "knows Spy (A_Gets A X # evs) = knows Spy evs" |
|
163 by simp |
|
164 |
|
165 |
|
166 |
|
167 |
|
168 lemma knows_Spy_subset_knows_Spy_Says: |
|
169 "knows Spy evs \<subseteq> knows Spy (Says A B X # evs)" |
|
170 by (simp add: subset_insertI) |
|
171 |
|
172 lemma knows_Spy_subset_knows_Spy_Notes: |
|
173 "knows Spy evs \<subseteq> knows Spy (Notes A X # evs)" |
|
174 by force |
|
175 |
|
176 lemma knows_Spy_subset_knows_Spy_Gets: |
|
177 "knows Spy evs \<subseteq> knows Spy (Gets A X # evs)" |
|
178 by (simp add: subset_insertI) |
|
179 |
|
180 lemma knows_Spy_subset_knows_Spy_Inputs: |
|
181 "knows Spy evs \<subseteq> knows Spy (Inputs A C X # evs)" |
|
182 by auto |
|
183 |
|
184 lemma knows_Spy_equals_knows_Spy_Gets: |
|
185 "knows Spy evs = knows Spy (C_Gets C X # evs)" |
|
186 by (simp add: subset_insertI) |
|
187 |
|
188 lemma knows_Spy_subset_knows_Spy_Outpts: "knows Spy evs \<subseteq> knows Spy (Outpts C A X # evs)" |
|
189 by auto |
|
190 |
|
191 lemma knows_Spy_subset_knows_Spy_A_Gets: "knows Spy evs \<subseteq> knows Spy (A_Gets A X # evs)" |
|
192 by (simp add: subset_insertI) |
|
193 |
|
194 |
|
195 |
|
196 text{*Spy sees what is sent on the traffic*} |
|
197 lemma Says_imp_knows_Spy [rule_format]: |
|
198 "Says A B X \<in> set evs \<longrightarrow> X \<in> knows Spy evs" |
|
199 apply (induct_tac "evs") |
|
200 apply (simp_all (no_asm_simp) split add: event.split) |
|
201 done |
|
202 |
|
203 lemma Notes_imp_knows_Spy [rule_format]: |
|
204 "Notes A X \<in> set evs \<longrightarrow> A\<in> bad \<longrightarrow> X \<in> knows Spy evs" |
|
205 apply (induct_tac "evs") |
|
206 apply (simp_all (no_asm_simp) split add: event.split) |
|
207 done |
|
208 |
|
209 (*Nothing can be stated on a Gets event*) |
|
210 |
|
211 lemma Inputs_imp_knows_Spy_secureM [rule_format (no_asm)]: |
|
212 "Inputs Spy C X \<in> set evs \<longrightarrow> secureM \<longrightarrow> X \<in> knows Spy evs" |
|
213 apply (induct_tac "evs") |
|
214 apply (simp_all (no_asm_simp) split add: event.split) |
|
215 done |
|
216 |
|
217 lemma Inputs_imp_knows_Spy_insecureM [rule_format (no_asm)]: |
|
218 "Inputs A C X \<in> set evs \<longrightarrow> insecureM \<longrightarrow> X \<in> knows Spy evs" |
|
219 apply (induct_tac "evs") |
|
220 apply (simp_all (no_asm_simp) split add: event.split) |
|
221 done |
|
222 |
|
223 (*Nothing can be stated on a C_Gets event*) |
|
224 |
|
225 lemma Outpts_imp_knows_Spy_secureM [rule_format (no_asm)]: |
|
226 "Outpts C Spy X \<in> set evs \<longrightarrow> secureM \<longrightarrow> X \<in> knows Spy evs" |
|
227 apply (induct_tac "evs") |
|
228 apply (simp_all (no_asm_simp) split add: event.split) |
|
229 done |
|
230 |
|
231 lemma Outpts_imp_knows_Spy_insecureM [rule_format (no_asm)]: |
|
232 "Outpts C A X \<in> set evs \<longrightarrow> insecureM \<longrightarrow> X \<in> knows Spy evs" |
|
233 apply (induct_tac "evs") |
|
234 apply (simp_all (no_asm_simp) split add: event.split) |
|
235 done |
|
236 |
|
237 (*Nothing can be stated on an A_Gets event*) |
|
238 |
|
239 |
|
240 |
|
241 text{*Elimination rules: derive contradictions from old Says events containing |
|
242 items known to be fresh*} |
|
243 lemmas knows_Spy_partsEs = |
|
244 Says_imp_knows_Spy [THEN parts.Inj, THEN revcut_rl, standard] |
|
245 parts.Body [THEN revcut_rl, standard] |
|
246 |
|
247 |
|
248 |
|
249 subsection{*Knowledge of Agents*} |
|
250 |
|
251 lemma knows_Says: "knows A (Says A B X # evs) = insert X (knows A evs)" |
|
252 by simp |
|
253 |
|
254 lemma knows_Notes: "knows A (Notes A X # evs) = insert X (knows A evs)" |
|
255 by simp |
|
256 |
|
257 lemma knows_Gets: |
|
258 "A \<noteq> Spy \<longrightarrow> knows A (Gets A X # evs) = insert X (knows A evs)" |
|
259 by simp |
|
260 |
|
261 lemma knows_Inputs: "knows A (Inputs A C X # evs) = insert X (knows A evs)" |
|
262 by simp |
|
263 |
|
264 lemma knows_C_Gets: "knows A (C_Gets C X # evs) = knows A evs" |
|
265 by simp |
|
266 |
|
267 lemma knows_Outpts_secureM: |
|
268 "secureM \<longrightarrow> knows A (Outpts C A X # evs) = insert X (knows A evs)" |
|
269 by simp |
|
270 |
|
271 lemma knows_Outpts_secureM: |
|
272 "insecureM \<longrightarrow> knows Spy (Outpts C A X # evs) = insert X (knows Spy evs)" |
|
273 by simp |
|
274 (*somewhat equivalent to knows_Spy_Outpts_insecureM*) |
|
275 |
|
276 |
|
277 |
|
278 |
|
279 lemma knows_subset_knows_Says: "knows A evs \<subseteq> knows A (Says A' B X # evs)" |
|
280 by (simp add: subset_insertI) |
|
281 |
|
282 lemma knows_subset_knows_Notes: "knows A evs \<subseteq> knows A (Notes A' X # evs)" |
|
283 by (simp add: subset_insertI) |
|
284 |
|
285 lemma knows_subset_knows_Gets: "knows A evs \<subseteq> knows A (Gets A' X # evs)" |
|
286 by (simp add: subset_insertI) |
|
287 |
|
288 lemma knows_subset_knows_Inputs: "knows A evs \<subseteq> knows A (Inputs A' C X # evs)" |
|
289 by (simp add: subset_insertI) |
|
290 |
|
291 lemma knows_subset_knows_C_Gets: "knows A evs \<subseteq> knows A (C_Gets C X # evs)" |
|
292 by (simp add: subset_insertI) |
|
293 |
|
294 lemma knows_subset_knows_Outpts: "knows A evs \<subseteq> knows A (Outpts C A' X # evs)" |
|
295 by (simp add: subset_insertI) |
|
296 |
|
297 lemma knows_subset_knows_Gets: "knows A evs \<subseteq> knows A (A_Gets A' X # evs)" |
|
298 by (simp add: subset_insertI) |
|
299 |
|
300 |
|
301 |
|
302 text{*Agents know what they say*} |
|
303 lemma Says_imp_knows [rule_format]: "Says A B X \<in> set evs \<longrightarrow> X \<in> knows A evs" |
|
304 apply (induct_tac "evs") |
|
305 apply (simp_all (no_asm_simp) split add: event.split) |
|
306 apply blast |
|
307 done |
|
308 |
|
309 text{*Agents know what they note*} |
|
310 lemma Notes_imp_knows [rule_format]: "Notes A X \<in> set evs \<longrightarrow> X \<in> knows A evs" |
|
311 apply (induct_tac "evs") |
|
312 apply (simp_all (no_asm_simp) split add: event.split) |
|
313 apply blast |
|
314 done |
|
315 |
|
316 text{*Agents know what they receive*} |
|
317 lemma Gets_imp_knows_agents [rule_format]: |
|
318 "A \<noteq> Spy \<longrightarrow> Gets A X \<in> set evs \<longrightarrow> X \<in> knows A evs" |
|
319 apply (induct_tac "evs") |
|
320 apply (simp_all (no_asm_simp) split add: event.split) |
|
321 done |
|
322 |
|
323 (*Agents know what they input to their smart card*) |
|
324 lemma Inputs_imp_knows_agents [rule_format (no_asm)]: |
|
325 "Inputs A (Card A) X \<in> set evs \<longrightarrow> X \<in> knows A evs" |
|
326 apply (induct_tac "evs") |
|
327 apply (simp_all (no_asm_simp) split add: event.split) |
|
328 apply blast |
|
329 done |
|
330 |
|
331 (*Nothing to prove about C_Gets*) |
|
332 |
|
333 (*Agents know what they obtain as output of their smart card, |
|
334 if the means is secure...*) |
|
335 lemma Outpts_imp_knows_agents_secureM [rule_format (no_asm)]: |
|
336 "secureM \<longrightarrow> Outpts (Card A) A X \<in> set evs \<longrightarrow> X \<in> knows A evs" |
|
337 apply (induct_tac "evs") |
|
338 apply (simp_all (no_asm_simp) split add: event.split) |
|
339 done |
|
340 |
|
341 (*otherwise only the spy knows the outputs*) |
|
342 lemma Outpts_imp_knows_agents_insecureM [rule_format (no_asm)]: |
|
343 "insecureM \<longrightarrow> Outpts (Card A) A X \<in> set evs \<longrightarrow> X \<in> knows Spy evs" |
|
344 apply (induct_tac "evs") |
|
345 apply (simp_all (no_asm_simp) split add: event.split) |
|
346 done |
|
347 |
|
348 (*end lemmas about agents' knowledge*) |
|
349 |
|
350 |
|
351 |
|
352 lemma parts_knows_Spy_subset_used: "parts (knows Spy evs) \<subseteq> used evs" |
|
353 apply (induct_tac "evs", force) |
|
354 apply (simp add: parts_insert_knows_A knows_Cons add: event.split, blast) |
|
355 done |
|
356 |
|
357 lemmas usedI = parts_knows_Spy_subset_used [THEN subsetD, intro] |
|
358 |
|
359 lemma initState_into_used: "X \<in> parts (initState B) \<Longrightarrow> X \<in> used evs" |
|
360 apply (induct_tac "evs") |
|
361 apply (simp_all add: parts_insert_knows_A split add: event.split, blast) |
|
362 done |
|
363 |
|
364 lemma used_Says [simp]: "used (Says A B X # evs) = parts{X} \<union> used evs" |
|
365 by simp |
|
366 |
|
367 lemma used_Notes [simp]: "used (Notes A X # evs) = parts{X} \<union> used evs" |
|
368 by simp |
|
369 |
|
370 lemma used_Gets [simp]: "used (Gets A X # evs) = used evs" |
|
371 by simp |
|
372 |
|
373 lemma used_Inputs [simp]: "used (Inputs A C X # evs) = parts{X} \<union> used evs" |
|
374 by simp |
|
375 |
|
376 lemma used_C_Gets [simp]: "used (C_Gets C X # evs) = used evs" |
|
377 by simp |
|
378 |
|
379 lemma used_Outpts [simp]: "used (Outpts C A X # evs) = parts{X} \<union> used evs" |
|
380 by simp |
|
381 |
|
382 lemma used_A_Gets [simp]: "used (A_Gets A X # evs) = used evs" |
|
383 by simp |
|
384 |
|
385 lemma used_nil_subset: "used [] \<subseteq> used evs" |
|
386 apply simp |
|
387 apply (blast intro: initState_into_used) |
|
388 done |
|
389 |
|
390 |
|
391 |
|
392 (*Novel lemmas*) |
|
393 lemma Says_parts_used [rule_format (no_asm)]: |
|
394 "Says A B X \<in> set evs \<longrightarrow> (parts {X}) \<subseteq> used evs" |
|
395 apply (induct_tac "evs") |
|
396 apply (simp_all (no_asm_simp) split add: event.split) |
|
397 apply blast |
|
398 done |
|
399 |
|
400 lemma Notes_parts_used [rule_format (no_asm)]: |
|
401 "Notes A X \<in> set evs \<longrightarrow> (parts {X}) \<subseteq> used evs" |
|
402 apply (induct_tac "evs") |
|
403 apply (simp_all (no_asm_simp) split add: event.split) |
|
404 apply blast |
|
405 done |
|
406 |
|
407 lemma Outpts_parts_used [rule_format (no_asm)]: |
|
408 "Outpts C A X \<in> set evs \<longrightarrow> (parts {X}) \<subseteq> used evs" |
|
409 apply (induct_tac "evs") |
|
410 apply (simp_all (no_asm_simp) split add: event.split) |
|
411 apply blast |
|
412 done |
|
413 |
|
414 lemma Inputs_parts_used [rule_format (no_asm)]: |
|
415 "Inputs A C X \<in> set evs \<longrightarrow> (parts {X}) \<subseteq> used evs" |
|
416 apply (induct_tac "evs") |
|
417 apply (simp_all (no_asm_simp) split add: event.split) |
|
418 apply blast |
|
419 done |
|
420 |
|
421 |
|
422 |
|
423 |
|
424 text{*NOTE REMOVAL--laws above are cleaner, as they don't involve "case"*} |
|
425 declare knows_Cons [simp del] |
|
426 used_Nil [simp del] used_Cons [simp del] |
|
427 |
|
428 |
|
429 lemma knows_subset_knows_Cons: "knows A evs \<subseteq> knows A (e # evs)" |
|
430 by (induct e, auto simp: knows_Cons) |
|
431 |
|
432 lemma initState_subset_knows: "initState A \<subseteq> knows A evs" |
|
433 apply (induct_tac evs, simp) |
|
434 apply (blast intro: knows_subset_knows_Cons [THEN subsetD]) |
|
435 done |
|
436 |
|
437 |
|
438 text{*For proving @{text new_keys_not_used}*} |
|
439 lemma keysFor_parts_insert: |
|
440 "\<lbrakk> K \<in> keysFor (parts (insert X G)); X \<in> synth (analz H) \<rbrakk> |
|
441 \<Longrightarrow> K \<in> keysFor (parts (G \<union> H)) \<or> Key (invKey K) \<in> parts H"; |
|
442 by (force |
|
443 dest!: parts_insert_subset_Un [THEN keysFor_mono, THEN [2] rev_subsetD] |
|
444 analz_subset_parts [THEN keysFor_mono, THEN [2] rev_subsetD] |
|
445 intro: analz_subset_parts [THEN subsetD] parts_mono [THEN [2] rev_subsetD]) |
|
446 |
|
447 end |