63
|
1 |
theory Dynamic_static
|
|
2 |
imports Main Flask Static Init_prop Valid_prop Tainted_prop Delete_prop Co2sobj_prop S2ss_prop S2ss_prop2
|
65
|
3 |
Temp
|
63
|
4 |
begin
|
|
5 |
|
|
6 |
context tainting_s begin
|
|
7 |
|
66
|
8 |
fun remove_create_flag :: "t_open_flags \<Rightarrow> t_open_flags"
|
|
9 |
where
|
|
10 |
"remove_create_flag (mflag, oflags) = (mflag, oflags - {OF_CREAT})"
|
63
|
11 |
|
66
|
12 |
fun all_procs :: "t_state \<Rightarrow> t_process set"
|
|
13 |
where
|
|
14 |
"all_procs [] = init_procs"
|
|
15 |
| "all_procs (Clone p p' fds shms # s) = insert p' (all_procs s)"
|
|
16 |
| "all_procs (e # s) = all_procs s"
|
|
17 |
|
|
18 |
definition brandnew_proc :: "t_state \<Rightarrow> t_process"
|
|
19 |
where
|
|
20 |
"brandnew_proc s \<equiv> next_nat (all_procs s)"
|
|
21 |
|
|
22 |
(*
|
|
23 |
definition brandnew_proc :: "t_state \<Rightarrow> t_process"
|
|
24 |
where
|
|
25 |
"brandnew_proc s \<equiv> next_nat ({p | p s'. p \<in> current_procs s' \<and> s' \<preceq> s})"
|
|
26 |
another approach:
|
|
27 |
brandnew_proc = next_nat (all_procs s),
|
|
28 |
where all_procs is a event-trace listener *)
|
|
29 |
|
|
30 |
(*
|
|
31 |
lemma brandnew_proc_prop1:
|
|
32 |
"\<lbrakk>s' \<preceq> s; valid s\<rbrakk> \<Longrightarrow> brandnew_proc s \<notin> current_procs s'"
|
|
33 |
apply (frule vd_preceq, simp)
|
|
34 |
apply (simp add:brandnew_proc_def)
|
|
35 |
apply (auto)
|
|
36 |
sorry
|
|
37 |
|
|
38 |
lemma brandnew_proc_prop2:
|
|
39 |
"\<lbrakk>p \<in> current_procs s'; s' \<preceq> s; valid s\<rbrakk> \<Longrightarrow> brandnew_proc s \<noteq> p"
|
|
40 |
by (auto dest:brandnew_proc_prop1)
|
|
41 |
|
|
42 |
lemma brandnew_proc_prop3:
|
|
43 |
"\<lbrakk>p \<in> current_procs s; valid (e # s)\<rbrakk> \<Longrightarrow> brandnew_proc (e # s) \<noteq> p"
|
|
44 |
apply (rule brandnew_proc_prop2, simp)
|
|
45 |
apply (rule no_juniorI, simp+)
|
|
46 |
done
|
|
47 |
*)
|
|
48 |
|
|
49 |
(* enrich s target_proc duplicated_pro *)
|
|
50 |
fun enrich_proc :: "t_state \<Rightarrow> t_process \<Rightarrow> t_process \<Rightarrow> t_state"
|
|
51 |
where
|
|
52 |
"enrich_proc [] tp dp = []"
|
|
53 |
| "enrich_proc (Execve p f fds # s) tp dp = (
|
|
54 |
if (tp = p)
|
|
55 |
then Execve dp f fds # Execve p f fds # (enrich_proc s tp dp)
|
|
56 |
else Execve p f fds # (enrich_proc s tp dp))"
|
|
57 |
| "enrich_proc (Clone p p' fds shms # s) tp dp = (
|
|
58 |
if (tp = p')
|
|
59 |
then Clone p dp fds shms # Clone p p' fds shms # s
|
|
60 |
else Clone p dp fds shms # (enrich_proc s tp dp))"
|
|
61 |
| "enrich_proc (Open p f flags fd opt # s) tp dp = (
|
|
62 |
if (tp = p)
|
|
63 |
then Open dp f (remove_create_flag flags) fd opt # Open p f flags fd opt # (enrich_proc s tp dp)
|
|
64 |
else Open p f flags fd opt # (enrich_proc s tp dp))"
|
|
65 |
| "enrich_proc (CloseFd p fd # s) tp dp = (
|
|
66 |
if (tp = p)
|
|
67 |
then CloseFd dp fd # CloseFd p fd # (enrich_proc s tp dp)
|
|
68 |
else CloseFd p fd # (enrich_proc s tp dp))"
|
|
69 |
| "enrich_proc (Attach p h flag # s) tp dp = (
|
|
70 |
if (tp = p)
|
|
71 |
then Attach dp h flag # Attach p h flag # (enrich_proc s tp dp)
|
|
72 |
else Attach p h flag # (enrich_proc s tp dp))"
|
|
73 |
| "enrich_proc (Detach p h # s) tp dp = (
|
|
74 |
if (tp = p)
|
|
75 |
then Detach dp h # Detach p h # (enrich_proc s tp dp)
|
|
76 |
else Detach p h # (enrich_proc s tp dp))"
|
|
77 |
| "enrich_proc (Kill p p' # s) tp dp = (
|
|
78 |
if (tp = p) then Kill p p' # s
|
|
79 |
else Kill p p' # (enrich_proc s tp dp))"
|
|
80 |
| "enrich_proc (Exit p # s) tp dp = (
|
|
81 |
if (tp = p) then Exit p # s
|
|
82 |
else Exit p # (enrich_proc s tp dp))"
|
|
83 |
| "enrich_proc (e # s) tp dp = e # (enrich_proc s tp dp)"
|
|
84 |
|
|
85 |
definition is_created_proc:: "t_state \<Rightarrow> t_process \<Rightarrow> bool"
|
|
86 |
where
|
|
87 |
"is_created_proc s p \<equiv> p \<in> init_procs \<longrightarrow> deleted (O_proc p) s"
|
|
88 |
|
|
89 |
lemma enrich_proc_prop:
|
|
90 |
"\<lbrakk>valid s; is_created_proc s p; p' \<notin> all_procs s\<rbrakk>
|
|
91 |
\<Longrightarrow> valid (enrich_proc s p p') \<and>
|
|
92 |
co2sobj (enrich_proc s p p') (O_proc p') = co2sobj (enrich_proc s p p') (O_proc p) \<and>
|
|
93 |
(alive s obj \<longrightarrow> alive (enrich_proc s p p') obj \<and> co2sobj (enrich_proc s p p') obj = co2sobj s obj)"
|
|
94 |
proof (induct s)
|
|
95 |
case Nil
|
|
96 |
thus ?case by (auto simp:is_created_proc_def)
|
|
97 |
next
|
|
98 |
case (Cons e s)
|
|
99 |
hence p1: "\<lbrakk>p \<in> current_procs s; valid s; is_created_proc s p; p' \<notin> current_procs s\<rbrakk>
|
|
100 |
\<Longrightarrow> valid (enrich_proc s p p') \<and>
|
|
101 |
p' \<in> current_procs (enrich_proc s p p') \<and>
|
|
102 |
co2sobj (enrich_proc s p p') (O_proc p') = co2sobj (enrich_proc s p p') (O_proc p) \<and>
|
|
103 |
(alive s obj \<longrightarrow> alive (enrich_proc s p p') obj \<and> co2sobj (enrich_proc s p p') obj = co2sobj s obj)"
|
|
104 |
and p2: "p \<in> current_procs (e # s)" and p3: "valid (e # s)"
|
|
105 |
and p4: "is_created_proc (e # s) p" and p5: "p' \<notin> current_procs (e # s)"
|
|
106 |
by auto
|
|
107 |
from p4 p2 have p4': "is_created_proc s p"
|
|
108 |
by (case_tac e, auto simp:is_created_proc_def)
|
|
109 |
from p3 have vd: "valid s" and os: "os_grant s e" and grant: "grant s e"
|
|
110 |
by (auto dest:vd_cons vt_grant vt_grant_os)
|
|
111 |
from p1 p4' have a1: "\<lbrakk>p \<in> current_procs s; p' \<notin> current_procs s\<rbrakk>
|
|
112 |
\<Longrightarrow> valid (enrich_proc s p p')" by (auto simp:vd)
|
|
113 |
have c1: "valid (enrich_proc (e # s) p p')"
|
|
114 |
apply (case_tac e)
|
|
115 |
using a1 os p5
|
|
116 |
apply (auto)
|
|
117 |
sorry
|
|
118 |
moreover have c2: "p' \<in> current_procs (enrich_proc (e # s) p p')"
|
|
119 |
sorry
|
|
120 |
moreover have c3: "co2sobj (enrich_proc (e # s) p p') (O_proc p') = co2sobj (enrich_proc (e # s) p p') (O_proc p)"
|
|
121 |
sorry
|
|
122 |
moreover have c4: "alive (e # s) obj \<longrightarrow>
|
|
123 |
alive (enrich_proc (e # s) p p') obj \<and> co2sobj (enrich_proc (e # s) p p') obj = co2sobj (e # s) obj"
|
|
124 |
sorry
|
|
125 |
ultimately show ?case by auto
|
|
126 |
qed
|
63
|
127 |
|
|
128 |
|
|
129 |
|
66
|
130 |
lemma "alive s obj \<Longrightarrow> alive (enrich_proc s p p') obj"
|
|
131 |
apply (induct s, simp)
|
|
132 |
apply (case_tac a, case_tac[!] obj)
|
|
133 |
apply (auto simp:is_file_def is_dir_def split:option.splits t_inode_tag.splits)
|
|
134 |
thm is_file_other
|
63
|
135 |
|
66
|
136 |
lemma enrich_proc_valid:
|
|
137 |
"\<lbrakk>p \<in> current_procs s; valid s; p \<in> init_procs \<longrightarrow> deleted (O_proc p) s; p' \<notin> current_procs s\<rbrakk> \<Longrightarrow> valid (enrich_proc s p p')"
|
|
138 |
apply (induct s, simp)
|
|
139 |
apply (frule vd_cons, frule vt_grant, frule vt_grant_os, case_tac a)
|
|
140 |
apply (auto intro!:valid.intros(2))
|
|
141 |
prefer 28
|
|
142 |
|
|
143 |
|
|
144 |
|
|
145 |
end
|
|
146 |
|
|
147 |
(* for any created obj, we can enrich trace with events that create new objs with the same static-properties *)
|
|
148 |
definition enriched:: "t_state \<Rightarrow> t_object set \<Rightarrow> t_state \<Rightarrow> bool"
|
63
|
149 |
where
|
66
|
150 |
"enriched s objs s' \<equiv> \<forall> obj \<in> objs. \<exists> obj'. \<not> alive s obj' \<and> obj' \<notin> objs \<and>
|
|
151 |
alive s' obj' \<and> co2sobj s' obj' = co2sobj s' obj"
|
|
152 |
|
|
153 |
definition reserved:: "t_state \<Rightarrow> t_object set \<Rightarrow> t_state \<Rightarrow> bool"
|
|
154 |
where
|
|
155 |
"reserved s objs s' \<equiv> \<forall> obj. alive s obj \<longrightarrow> alive s' obj \<and> co2sobj s' obj = co2sobj s obj"
|
63
|
156 |
|
|
157 |
definition enrichable :: "t_state \<Rightarrow> t_object set \<Rightarrow> bool"
|
|
158 |
where
|
66
|
159 |
"enrichable s objs \<equiv> \<exists> s'. valid s' \<and> s2ss s' = s2ss s \<and> enriched s objs s' \<and> reserved s objs s'"
|
63
|
160 |
|
66
|
161 |
fun is_created :: "t_state \<Rightarrow> t_object \<Rightarrow> bool"
|
63
|
162 |
where
|
66
|
163 |
"is_created s (O_file f) = (\<forall> f' \<in> same_inode_files s f. init_alive (O_file f') \<longrightarrow> deleted (O_file f') s)"
|
|
164 |
| "is_created s obj = (init_alive obj \<longrightarrow> deleted obj s)"
|
63
|
165 |
|
|
166 |
definition is_inited :: "t_state \<Rightarrow> t_object \<Rightarrow> bool"
|
|
167 |
where
|
|
168 |
"is_inited s obj \<equiv> init_alive obj \<and> \<not> deleted obj s"
|
|
169 |
|
66
|
170 |
(*
|
63
|
171 |
lemma is_inited_eq_not_created:
|
|
172 |
"is_inited s obj = (\<not> is_created s obj)"
|
|
173 |
by (auto simp:is_created_def is_inited_def)
|
66
|
174 |
*)
|
63
|
175 |
|
66
|
176 |
lemma many_sq_imp_sms:
|
|
177 |
"\<lbrakk>S_msgq (Create, sec, sms) \<in> ss; ss \<in> static\<rbrakk> \<Longrightarrow> \<forall> sm \<in> (set sms). is_many_smsg sm"
|
|
178 |
sorry
|
|
179 |
|
|
180 |
(* recorded in our static world *)
|
|
181 |
fun recorded :: "t_object \<Rightarrow> bool"
|
|
182 |
where
|
|
183 |
"recorded (O_proc p) = True"
|
|
184 |
| "recorded (O_file f) = True"
|
|
185 |
| "recorded (O_dir f) = True"
|
|
186 |
| "recorded (O_node n) = False" (* cause socket is temperary not considered *)
|
|
187 |
| "recorded (O_shm h) = True"
|
|
188 |
| "recorded (O_msgq q) = True"
|
|
189 |
| "recorded _ = False"
|
|
190 |
|
|
191 |
lemma cf2sfile_fi_init_file:
|
|
192 |
"\<lbrakk>cf2sfile s f = Some (Init f', sec, psec, asecs); is_file s f; valid s\<rbrakk>
|
|
193 |
\<Longrightarrow> is_init_file f \<and> \<not> deleted (O_file f) s"
|
|
194 |
apply (simp add:cf2sfile_def sroot_def split:option.splits if_splits)
|
|
195 |
apply (case_tac f, simp, drule root_is_dir', simp+)
|
|
196 |
done
|
|
197 |
|
|
198 |
lemma root_not_deleted:
|
|
199 |
"valid s \<Longrightarrow> \<not> deleted (O_dir []) s"
|
|
200 |
apply (induct s, simp)
|
|
201 |
apply (frule vd_cons, frule vt_grant_os, case_tac a)
|
|
202 |
by auto
|
|
203 |
|
|
204 |
lemma cf2sfile_fi_init_dir:
|
|
205 |
"\<lbrakk>cf2sfile s f = Some (Init f', sec, psec, asecs); is_dir s f; valid s\<rbrakk>
|
|
206 |
\<Longrightarrow> is_init_dir f \<and> \<not> deleted (O_dir f) s"
|
|
207 |
apply (simp add:cf2sfile_def sroot_def split:option.splits if_splits)
|
|
208 |
apply (case_tac f, simp add:root_is_init_dir root_not_deleted, simp)
|
|
209 |
apply (drule file_dir_conflict, simp+)
|
|
210 |
done
|
|
211 |
|
|
212 |
lemma is_created_imp_many:
|
|
213 |
"\<lbrakk>is_created s obj; co2sobj s obj = Some sobj; alive s obj; valid s\<rbrakk> \<Longrightarrow> is_many sobj"
|
|
214 |
apply (case_tac obj, auto simp:co2sobj.simps split:option.splits)
|
|
215 |
apply (case_tac [!] a)
|
|
216 |
apply (auto simp:cp2sproc_def ch2sshm_def cq2smsgq_def cf2sfiles_def same_inode_files_def
|
|
217 |
split:option.splits if_splits)
|
|
218 |
apply (frule cf2sfile_fi_init_file, simp add:is_file_def, simp)
|
|
219 |
apply (erule_tac x = f' in allE, simp)
|
|
220 |
apply (frule cf2sfile_fi_init_dir, simp+)+
|
|
221 |
done
|
|
222 |
|
|
223 |
lemma anotherp_imp_manysp:
|
|
224 |
"\<lbrakk>cp2sproc s p = Some sp; co2sobj s (O_proc p') = co2sobj s (O_proc p); p' \<noteq> p;
|
|
225 |
p' \<in> current_procs s; p \<in> current_procs s\<rbrakk>
|
|
226 |
\<Longrightarrow> is_many_sproc sp"
|
|
227 |
by (case_tac sp, auto simp:cp2sproc_def co2sobj.simps split:option.splits if_splits)
|
|
228 |
|
|
229 |
lemma is_file_has_sfs:
|
|
230 |
"\<lbrakk>is_file s f; valid s; cf2sfile s f = Some sf\<rbrakk>
|
|
231 |
\<Longrightarrow> \<exists> sfs. co2sobj s (O_file f) = Some (S_file sfs (O_file f \<in> Tainted s)) \<and> sf \<in> sfs"
|
|
232 |
apply (rule_tac x = "{sf' | f' sf'. cf2sfile s f' = Some sf' \<and> f' \<in> same_inode_files s f}" in exI)
|
|
233 |
apply (auto simp:co2sobj.simps cf2sfiles_def tainted_eq_Tainted)
|
|
234 |
apply (rule_tac x = f in exI, simp add:same_inode_files_prop9)
|
|
235 |
done
|
|
236 |
|
|
237 |
declare Product_Type.split_paired_Ex Product_Type.split_paired_All [simp del]
|
|
238 |
|
|
239 |
lemma current_proc_in_s2ss:
|
|
240 |
"\<lbrakk>cp2sproc s p = Some sp; p \<in> current_procs s; valid s\<rbrakk>
|
|
241 |
\<Longrightarrow> S_proc sp (O_proc p \<in> Tainted s) \<in> s2ss s"
|
|
242 |
apply (simp add:s2ss_def, rule_tac x = "O_proc p" in exI)
|
|
243 |
apply (auto simp:co2sobj.simps tainted_eq_Tainted)
|
|
244 |
done
|
|
245 |
|
|
246 |
lemma current_file_in_s2ss:
|
|
247 |
"\<lbrakk>co2sobj s (O_file f) = Some (S_file sfs tagf); is_file s f; valid s\<rbrakk>
|
|
248 |
\<Longrightarrow> S_file sfs tagf \<in> s2ss s"
|
|
249 |
by (simp add:s2ss_def, rule_tac x = "O_file f" in exI, simp)
|
|
250 |
|
|
251 |
declare npctxt_execve.simps grant_execve.simps search_check.simps [simp del]
|
|
252 |
|
|
253 |
|
|
254 |
lemma npctxt_execve_eq_sec:
|
|
255 |
"\<lbrakk>sectxt_of_obj (Execve p f fds # s) (O_proc p) = Some sec'; sectxt_of_obj s (O_proc p) = Some sec;
|
|
256 |
sectxt_of_obj s (O_file f) = Some fsec; valid (Execve p f fds # s)\<rbrakk>
|
|
257 |
\<Longrightarrow> npctxt_execve sec fsec = Some sec'"
|
|
258 |
by (case_tac sec, case_tac fsec, auto simp:npctxt_execve.simps sectxt_of_obj_simps split:option.splits)
|
|
259 |
|
|
260 |
lemma npctxt_execve_eq_cp2sproc:
|
|
261 |
"\<lbrakk>cp2sproc (Execve p f fds # s) p = Some (pi', sec', sfds', shms'); valid (Execve p f fds # s);
|
|
262 |
cp2sproc s p = Some (pi, sec, sfds, shms); cf2sfile s f = Some (fi, fsec, psec, asecs)\<rbrakk>
|
|
263 |
\<Longrightarrow> npctxt_execve sec fsec = Some sec'"
|
|
264 |
apply (frule vt_grant_os, frule vd_cons)
|
|
265 |
apply (rule npctxt_execve_eq_sec, auto simp:cp2sproc_def cf2sfile_def split:option.splits)
|
|
266 |
apply (case_tac f, auto dest:root_is_dir')
|
|
267 |
done
|
|
268 |
|
|
269 |
lemma seach_check_eq_static:
|
|
270 |
"\<lbrakk>cf2sfile s f = Some sf; valid s; is_dir s f \<or> is_file s f\<rbrakk>
|
|
271 |
\<Longrightarrow> search_check_s sec sf (is_file s f) = search_check s sec f"
|
|
272 |
apply (case_tac sf)
|
|
273 |
apply (induct f)
|
|
274 |
apply (auto simp:search_check_s_def search_check.simps cf2sfile_def sroot_def
|
|
275 |
root_sec_remains init_sectxt_prop sec_of_root_valid
|
|
276 |
dest!:root_is_dir' current_has_sec' split:option.splits)
|
|
277 |
apply (simp add:search_check_allp_def)
|
|
278 |
done
|
|
279 |
|
|
280 |
lemma grant_execve_intro_execve:
|
|
281 |
"\<lbrakk>cp2sproc (Execve p f fds # s) p = Some (pi', sec', sfds', shms'); valid (Execve p f fds # s);
|
|
282 |
cp2sproc s p = Some (pi, sec, sfds, shms); cf2sfile s f = Some (fi, fsec, psec, asecs)\<rbrakk>
|
|
283 |
\<Longrightarrow> grant_execve sec fsec sec'"
|
|
284 |
apply (frule vt_grant_os, frule vd_cons, frule vt_grant)
|
|
285 |
apply (auto split:option.splits dest!:current_has_sec' simp del:grant_execve.simps simp add:cp2sproc_execve)
|
|
286 |
apply (erule_tac x = aba in allE, erule_tac x = aca in allE, erule_tac x = bb in allE)
|
|
287 |
apply (auto simp del:grant_execve.simps simp add:cp2sproc_def cf2sfile_def split:option.splits)
|
|
288 |
apply (case_tac f, simp, drule root_is_dir', simp, simp, simp)
|
|
289 |
apply (simp add:sectxt_of_obj_simps)
|
|
290 |
done
|
|
291 |
|
|
292 |
lemma search_check_intro_execve:
|
|
293 |
"\<lbrakk>cp2sproc s p = Some (pi, sec, sfds, shms); valid (Execve p f fds # s)\<rbrakk>
|
|
294 |
\<Longrightarrow> search_check s sec f"
|
|
295 |
apply (frule vt_grant_os, frule vd_cons, frule vt_grant)
|
|
296 |
apply (auto split:option.splits dest!:current_has_sec' simp del:grant_execve.simps simp add:cp2sproc_execve)
|
|
297 |
apply (erule_tac x = aaa in allE, erule_tac x = ab in allE, erule_tac x = ba in allE)
|
|
298 |
apply (auto simp add:cp2sproc_def cf2sfile_def split:option.splits)
|
|
299 |
done
|
|
300 |
|
|
301 |
lemma inherit_fds_check_intro_execve:
|
|
302 |
"\<lbrakk>cp2sproc (Execve p f fds # s) p = Some (pi', sec', sfds', shms'); valid (Execve p f fds # s)\<rbrakk>
|
|
303 |
\<Longrightarrow> inherit_fds_check s sec' p fds"
|
|
304 |
apply (frule vt_grant_os, frule vd_cons, frule vt_grant)
|
|
305 |
apply (auto split:option.splits dest!:current_has_sec' simp add:cp2sproc_execve)
|
|
306 |
apply (erule_tac x = aba in allE, erule_tac x = aca in allE, erule_tac x = bb in allE)
|
|
307 |
apply (auto simp add:cp2sproc_def cf2sfile_def split:option.splits)
|
|
308 |
apply (simp add:sectxt_of_obj_simps)
|
|
309 |
done
|
|
310 |
|
|
311 |
lemma execve_sfds_subset:
|
|
312 |
"\<lbrakk>cp2sproc (Execve p f fds # s) p = Some (pi', sec', sfds', shms'); valid (Execve p f fds # s);
|
|
313 |
cp2sproc s p = Some (pi, sec, sfds, shms)\<rbrakk>
|
|
314 |
\<Longrightarrow> sfds' \<subseteq> sfds"
|
|
315 |
apply (frule vt_grant_os)
|
|
316 |
apply (auto simp:cp2sproc_def cpfd2sfds_execve split:option.splits dest!:current_has_sec')
|
|
317 |
apply (simp add:cpfd2sfds_def)
|
|
318 |
apply (rule_tac x = fd in bexI, auto simp:proc_file_fds_def)
|
|
319 |
done
|
|
320 |
|
|
321 |
lemma inherit_fds_check_imp_static:
|
|
322 |
"\<lbrakk>cp2sproc (Execve p f fds # s) p = Some (pi', sec', sfds', shms');
|
|
323 |
inherit_fds_check s sec' p fds; valid (Execve p f fds # s)\<rbrakk>
|
|
324 |
\<Longrightarrow> inherit_fds_check_s sec' sfds'"
|
|
325 |
apply (frule vt_grant_os, frule vd_cons, frule vt_grant)
|
|
326 |
apply (auto simp:cp2sproc_def cpfd2sfds_execve inherit_fds_check_def inherit_fds_check_s_def split:option.splits)
|
|
327 |
apply (erule_tac x = "(ad, ae, bc)" in ballE, auto simp:sectxts_of_sfds_def sectxts_of_fds_def)
|
|
328 |
apply (erule_tac x = fd in ballE, auto simp:cfd2sfd_def split:option.splits)
|
|
329 |
done
|
|
330 |
|
|
331 |
lemma d2s_main_execve_grant_aux:
|
|
332 |
"\<lbrakk>cp2sproc (Execve p f fds # s) p = Some (pi', sec', sfds', shms'); valid (Execve p f fds # s);
|
|
333 |
cp2sproc s p = Some (pi, sec, sfds, shms); cf2sfile s f = Some (fi, fsec, psec, asecs)\<rbrakk>
|
|
334 |
\<Longrightarrow> (npctxt_execve sec fsec = Some sec') \<and> grant_execve sec fsec sec' \<and>
|
|
335 |
search_check_s sec (fi, fsec, psec, asecs) (is_file s f) \<and>
|
|
336 |
inherit_fds_check_s sec' sfds' \<and> sfds' \<subseteq> sfds"
|
|
337 |
apply (rule conjI, erule_tac pi = pi and sec = sec and sfds = sfds and
|
|
338 |
shms = shms and fi = fi and fsec = fsec and psec = psec and
|
|
339 |
asecs = asecs in npctxt_execve_eq_cp2sproc, simp, simp, simp)
|
|
340 |
apply (rule conjI, erule_tac pi = pi and sec = sec and sfds = sfds and
|
|
341 |
shms = shms and fi = fi and fsec = fsec and psec = psec and
|
|
342 |
asecs = asecs in grant_execve_intro_execve, simp, simp, simp)
|
|
343 |
apply (rule conjI, drule_tac sec = sec in search_check_intro_execve, simp)
|
|
344 |
apply (frule vd_cons, frule vt_grant_os)
|
|
345 |
apply (drule_tac sec = sec in seach_check_eq_static, simp, simp, simp)
|
|
346 |
apply (rule conjI, rule inherit_fds_check_imp_static, simp)
|
|
347 |
apply (erule inherit_fds_check_intro_execve, simp, simp)
|
|
348 |
apply (erule_tac pi = pi and sfds = sfds and shms = shms in execve_sfds_subset, simp+)
|
|
349 |
done
|
|
350 |
|
|
351 |
lemma d2s_main_execve:
|
|
352 |
"\<lbrakk>valid (Execve p f fds # s); s2ss s \<propto> static\<rbrakk> \<Longrightarrow> s2ss (Execve p f fds # s) \<propto> static"
|
|
353 |
apply (frule vd_cons, frule vt_grant_os, clarsimp)
|
|
354 |
apply (frule is_file_has_sfile', simp, erule exE, frule is_file_has_sfs, simp+, erule exE, erule conjE)
|
|
355 |
apply (auto simp:s2ss_execve split:if_splits option.splits dest:current_proc_has_sp')
|
|
356 |
apply (clarsimp simp add:init_ss_in_def init_ss_eq_def)
|
|
357 |
apply (rule_tac x = "update_ss ss' (S_proc (ah, (ai, aj, bd), ak, be) (O_proc p \<in> Tainted s))
|
|
358 |
(S_proc (ad, (ae, af, bb), ag, bc) (O_proc p \<in> Tainted s \<or> O_file f \<in> Tainted s))" in bexI)
|
|
359 |
apply (auto simp:update_ss_def elim:Set.subset_insertI2 simp:anotherp_imp_manysp)[1]
|
|
360 |
apply (case_tac "ah = ad", case_tac "bc = {}", simp)
|
|
361 |
apply (erule_tac sfs = sfs and fi = a and fsec = "(aa, ab,b)" and pfsec = ac and asecs = ba in s_execve,
|
|
362 |
auto intro:current_proc_in_s2ss current_file_in_s2ss split:option.splits dest:d2s_main_execve_grant_aux)[1]
|
|
363 |
apply (simp add:cp2sproc_execve split:option.splits)
|
|
364 |
apply (simp add:cp2sproc_def split:option.splits if_splits)
|
|
365 |
|
|
366 |
apply (clarsimp simp add:init_ss_in_def init_ss_eq_def)
|
|
367 |
apply (rule_tac x = "update_ss ss' (S_proc (ah, (ai, aj, bd), ak, be) (O_proc p \<in> Tainted s))
|
|
368 |
(S_proc (ad, (ae, af, bb), ag, bc) (O_proc p \<in> Tainted s \<or> O_file f \<in> Tainted s))" in bexI)
|
|
369 |
apply (rule conjI, simp add:update_ss_def)
|
|
370 |
apply (rule conjI, simp add:update_ss_def)
|
|
371 |
apply (auto)[1]
|
|
372 |
apply (simp add:update_ss_def)
|
|
373 |
apply (rule conjI, rule impI)
|
|
374 |
apply (rule subsetI, clarsimp)
|
|
375 |
apply (erule impE)
|
|
376 |
apply (erule set_mp, simp)
|
|
377 |
apply (case_tac ah, simp+)
|
|
378 |
apply (rule impI, rule subsetI, clarsimp)
|
|
379 |
apply (erule set_mp, simp)
|
|
380 |
|
|
381 |
apply (case_tac "ah = ad", case_tac "bc = {}", simp)
|
|
382 |
apply (erule_tac sfs = sfs and fi = a and fsec = "(aa, ab,b)" and pfsec = ac and asecs = ba in s_execve,
|
|
383 |
auto intro:current_proc_in_s2ss current_file_in_s2ss split:option.splits dest:d2s_main_execve_grant_aux)[1]
|
|
384 |
apply (simp add:cp2sproc_execve split:option.splits)
|
|
385 |
apply (simp add:cp2sproc_def split:option.splits if_splits)
|
|
386 |
done
|
|
387 |
|
|
388 |
lemma co2sobj_eq_alive_proc_imp:
|
|
389 |
"\<lbrakk>co2sobj s obj = co2sobj s (O_proc p); alive s (O_proc p); valid s\<rbrakk>
|
|
390 |
\<Longrightarrow> \<exists> p'. obj = O_proc p'"
|
|
391 |
by (auto simp add:co2sobj.simps split:option.splits dest:current_proc_has_sp' intro:co2sobj_sproc_imp)
|
|
392 |
|
|
393 |
|
|
394 |
lemma enrichable_execve:
|
|
395 |
assumes p1: "\<And> objs. \<forall> obj \<in> objs. alive s obj \<and> is_created s obj \<and> recorded obj
|
|
396 |
\<Longrightarrow> \<exists> s'. valid s' \<and> s2ss s' = s2ss s \<and> enriched s objs s' \<and> reserved s objs s'"
|
|
397 |
and p2: "valid (e # s)" and p3: "\<forall>obj\<in>objs. alive (e # s) obj \<and> is_created (e # s) obj \<and> recorded obj"
|
|
398 |
and p4: "e = Execve p f fds"
|
|
399 |
shows "enrichable (e # s) objs"
|
|
400 |
proof-
|
|
401 |
from p2 have os: "os_grant s e" and se: "grant s e" and vd: "valid s"
|
|
402 |
by (auto dest:vt_grant_os vd_cons vt_grant)
|
|
403 |
from p3 have recorded: "\<forall> obj \<in> objs. recorded obj" by auto
|
|
404 |
from p3 p4 p2 have p1': "\<forall> obj \<in> objs. alive s obj \<and> is_created s obj"
|
|
405 |
apply clarify
|
|
406 |
apply (erule_tac x = obj in ballE, simp add:alive_simps)
|
|
407 |
apply (case_tac obj, auto simp:same_inode_files_simps)
|
|
408 |
done
|
|
409 |
then obtain s' where a1: "valid s'" and a2: "s2ss s' = s2ss s" and a3: "enriched s objs s'"
|
|
410 |
and a4: "reserved s objs s'"
|
|
411 |
using p1 recorded by metis
|
|
412 |
show ?thesis
|
|
413 |
proof (cases "O_proc p \<in> objs")
|
|
414 |
case True
|
|
415 |
hence p_in: "p \<in> current_procs s'" using a4 os p4
|
|
416 |
by (auto simp:reserved_def elim:allE[where x = "O_proc p"])
|
|
417 |
with a1 a3 True obtain p' where b1: "\<not> alive s (O_proc p')" and b2: "O_proc p' \<notin> objs"
|
|
418 |
and b3: "alive s' (O_proc p')" and b4: "co2sobj s' (O_proc p') = co2sobj s' (O_proc p)"
|
|
419 |
apply (simp only:enriched_def)
|
|
420 |
apply (erule_tac x = "O_proc p" in ballE)
|
|
421 |
apply (erule exE|erule conjE)+
|
|
422 |
apply (frule co2sobj_eq_alive_proc_imp, auto)
|
|
423 |
done
|
|
424 |
have "valid (Execve p' f fds # e # s')"
|
|
425 |
sorry
|
|
426 |
moreover have "s2ss (Execve p' f fds # e # s') = s2ss (e # s)"
|
|
427 |
sorry
|
|
428 |
moreover have "enriched (e # s) objs (Execve p' f fds # e # s')"
|
|
429 |
sorry
|
|
430 |
moreover have "reserved (e # s) objs (Execve p' f fds # e # s')"
|
|
431 |
sorry
|
|
432 |
ultimately show ?thesis
|
|
433 |
apply (simp add:enrichable_def)
|
|
434 |
apply (rule_tac x = "Execve p' f fds # e # s'" in exI)
|
|
435 |
by auto
|
|
436 |
next
|
|
437 |
case False
|
|
438 |
from a4 os p4 have "p \<in> current_procs s'"
|
|
439 |
apply (simp add:reserved_def)
|
|
440 |
by (erule_tac x = "O_proc p" in allE, auto)
|
|
441 |
moreover from a4 os p4 have "is_file s' f"
|
|
442 |
apply (simp add:reserved_def)
|
|
443 |
by (erule_tac x = "O_file f" in allE, auto)
|
|
444 |
moreover from a4 os p4 have "fds \<subseteq> current_proc_fds s' p"
|
|
445 |
apply (rule_tac subsetI, clarsimp simp:reserved_def current_proc_fds.simps)
|
|
446 |
apply (erule_tac x = "O_fd p x" in allE, erule impE)
|
|
447 |
apply (simp, erule set_mp, simp+)
|
|
448 |
done
|
|
449 |
ultimately have "os_grant s' e"
|
|
450 |
by (simp add:p4)
|
|
451 |
moreover have "grant s' e"
|
|
452 |
sorry
|
|
453 |
ultimately have "valid (e # s')"
|
|
454 |
using a1 by (erule_tac valid.intros(2), simp+)
|
|
455 |
thus ?thesis
|
|
456 |
apply (simp add:enrichable_def)
|
|
457 |
apply (rule_tac x = "e # s'" in exI)
|
|
458 |
apply (simp)
|
|
459 |
sorry
|
|
460 |
qed
|
|
461 |
|
|
462 |
lemma s2d_main_execve:
|
|
463 |
"\<lbrakk>grant_execve pctxt fsec pctxt'; ss \<in> static; S_proc (pi, pctxt, fds, shms) tagp \<in> ss; S_file sfs tagf \<in> ss;
|
|
464 |
(fi, fsec, pfsec, asecs) \<in> sfs; npctxt_execve pctxt fsec = Some pctxt';
|
|
465 |
search_check_s pctxt (fi, fsec, pfsec, asecs) True; inherit_fds_check_s pctxt' fds'; fds' \<subseteq> fds; valid s;
|
|
466 |
s2ss s = ss\<rbrakk> \<Longrightarrow> \<exists>s. valid s \<and>
|
|
467 |
s2ss s = update_ss ss (S_proc (pi, pctxt, fds, shms) tagp) (S_proc (pi, pctxt', fds', {}) (tagp \<or> tagf))"
|
|
468 |
apply (simp add:update_ss_def)
|
|
469 |
thm update_ss_def
|
|
470 |
sorry
|
|
471 |
|
|
472 |
|
|
473 |
lemma s2d_main_execve:
|
|
474 |
"ss \<in> static \<Longrightarrow> \<exists> s. valid s \<and> s2ss s = ss"
|
|
475 |
apply (erule static.induct)
|
|
476 |
apply (rule_tac x = "[]" in exI, simp add:s2ss_nil_prop valid.intros)
|
|
477 |
apply (erule exE|erule conjE)+
|
|
478 |
apply (rule s2d_main_execve, simp+)
|
|
479 |
|
|
480 |
apply (erule exE|erule conjE)+
|
|
481 |
|
|
482 |
apply (simp add:update_ss_def)
|
|
483 |
|
|
484 |
sorry
|
63
|
485 |
|
|
486 |
|
|
487 |
|
66
|
488 |
(*********************** uppest-level 3 theorems ***********************)
|
|
489 |
|
|
490 |
lemma enrichability:
|
|
491 |
"\<lbrakk>valid s; \<forall> obj \<in> objs. alive s obj \<and> is_created s obj \<and> recorded obj\<rbrakk>
|
|
492 |
\<Longrightarrow> enrichable s objs"
|
|
493 |
proof (induct s arbitrary:objs)
|
|
494 |
case Nil
|
|
495 |
hence "objs = {}"
|
|
496 |
apply (auto simp:is_created_def)
|
|
497 |
apply (erule_tac x = x in ballE)
|
|
498 |
apply (auto simp:init_alive_prop)
|
|
499 |
done
|
|
500 |
thus ?case using Nil unfolding enrichable_def enriched_def reserved_def
|
|
501 |
by (rule_tac x = "[]" in exI, auto)
|
|
502 |
next
|
|
503 |
case (Cons e s)
|
|
504 |
hence p1: "\<And> objs. \<forall> obj \<in> objs. alive s obj \<and> is_created s obj \<and> recorded obj
|
|
505 |
\<Longrightarrow> \<exists> s'. valid s' \<and> s2ss s' = s2ss s \<and> enriched s objs s' \<and> reserved s objs s'"
|
|
506 |
and p2: "valid (e # s)" and p3: "\<forall>obj\<in>objs. alive (e # s) obj \<and> is_created (e # s) obj \<and> recorded obj"
|
|
507 |
and os: "os_grant s e" and se: "grant s e" and vd: "valid s"
|
|
508 |
by (auto dest:vt_grant_os vd_cons vt_grant simp:enrichable_def)
|
|
509 |
show ?case
|
|
510 |
proof (cases e)
|
|
511 |
case (Execve p f fds)
|
|
512 |
hence p4: "e = Execve p f fds" by simp
|
|
513 |
from p3 have p5: "is_inited s (O_proc p) \<Longrightarrow> (O_proc p) \<notin> objs"
|
|
514 |
by (auto simp:is_created_def is_inited_def p4 elim!:ballE[where x = "O_proc p"])
|
|
515 |
show "enrichable (e # s) objs"
|
|
516 |
proof (cases "is_inited s (O_proc p)")
|
|
517 |
case True
|
|
518 |
with p5 have a1: "(O_proc p) \<notin> objs" by simp
|
|
519 |
with p3 p4 p2 have a2: "\<forall> obj \<in> objs. alive s obj \<and> is_created s obj" and a2': "\<forall> obj \<in> objs. recorded obj"
|
|
520 |
apply (auto simp:is_created_def alive_simps is_inited_def)
|
|
521 |
apply (erule_tac x = obj in ballE, auto simp:alive_simps split:t_object.splits)
|
|
522 |
done
|
|
523 |
then obtain s' where a3: "valid s'" and a4: "s2ss s' = s2ss s"
|
|
524 |
and a5: "enriched s objs s'" and a6: "reserved s objs s'"
|
|
525 |
using p1 apply (simp add:enrichable_def) sorry
|
|
526 |
from a5 p4 p2 a2' have a7: "enriched s objs (e # s')"
|
|
527 |
apply (clarsimp simp add:enriched_def co2sobj_execve)
|
|
528 |
apply (erule_tac x = obj in ballE, clarsimp)
|
|
529 |
apply (rule_tac x = obj' in exI, auto simp:co2sobj_execve alive_simps)
|
|
530 |
thm enriched_def
|
63
|
531 |
|
|
532 |
|
66
|
533 |
|
|
534 |
obtain s' where p6:"enriched s objs s'"
|
|
535 |
apply (simp add: alive_simps enrichable_def)
|
|
536 |
apply auto apply (rule ballI, rule_tac x = obj in exI)
|
|
537 |
|
|
538 |
have p6:"enriched (e # s) objs (e # s)"
|
|
539 |
apply (simp add:enriched_def alive_simps)
|
|
540 |
apply auto apply (rule ballI, rule_tac x = obj in exI)
|
|
541 |
|
|
542 |
have "enrich (e # s) objs (e # s)"
|
|
543 |
apply (simp add:enrich_def p4)
|
|
544 |
sorry
|
|
545 |
moreover have "reserve (e # s) objs (e # s)"
|
|
546 |
sorry
|
|
547 |
ultimately show ?thesis using p2
|
|
548 |
apply (simp add:enrichable_def)
|
|
549 |
by (rule_tac x = "e # s" in exI, simp)
|
|
550 |
next
|
|
551 |
|
|
552 |
|
|
553 |
thm enrichable_def
|
|
554 |
apply (simp add:enrichable_def p4)
|
|
555 |
|
|
556 |
|
|
557 |
|
|
558 |
apply auto
|
|
559 |
apply (auto simp:enrichable_def)
|
|
560 |
apply (induct s)
|
|
561 |
|
|
562 |
|
|
563 |
|
|
564 |
done
|
|
565 |
|
|
566 |
qed
|
63
|
567 |
|
|
568 |
lemma d2s_main:
|
|
569 |
"valid s \<Longrightarrow> s2ss s \<propto> static"
|
|
570 |
apply (induct s, simp add:s2ss_nil_prop init_ss_in_def)
|
|
571 |
apply (rule_tac x = "init_static_state" in bexI, simp, simp add:s_init)
|
|
572 |
apply (frule vd_cons, frule vt_grant_os, simp)
|
|
573 |
apply (case_tac a)
|
|
574 |
apply (clarsimp simp add:s2ss_execve)
|
|
575 |
apply (rule conjI, rule impI)
|
|
576 |
|
|
577 |
|
|
578 |
|
|
579 |
sorry
|
|
580 |
|
|
581 |
lemma s2d_main:
|
|
582 |
"ss \<in> static \<Longrightarrow> \<exists> s. valid s \<and> s2ss s = ss"
|
|
583 |
apply (erule static.induct)
|
|
584 |
apply (rule_tac x = "[]" in exI, simp add:s2ss_nil_prop valid.intros)
|
|
585 |
|
|
586 |
apply (erule exE|erule conjE)+
|
|
587 |
|
|
588 |
apply (simp add:update_ss_def)
|
|
589 |
|
|
590 |
sorry
|
|
591 |
|
|
592 |
|
|
593 |
end
|
|
594 |
|
|
595 |
end |