77
|
1 |
theory Final_theorem
|
|
2 |
imports Main Flask Static Init_prop Valid_prop Tainted_prop Delete_prop Co2sobj_prop S2ss_prop S2ss_prop2 Dynamic_static
|
|
3 |
begin
|
|
4 |
|
|
5 |
context tainting_s begin
|
|
6 |
|
|
7 |
lemma t2ts:
|
|
8 |
"obj \<in> tainted s \<Longrightarrow> co2sobj s obj = Some sobj \<Longrightarrow> tainted_s (s2ss s) sobj"
|
|
9 |
apply (frule tainted_in_current, frule tainted_is_valid)
|
|
10 |
apply (frule s2ss_included_sobj, simp)
|
|
11 |
apply (case_tac sobj, simp_all)
|
|
12 |
apply (case_tac [!] obj, simp_all add:co2sobj.simps split:option.splits if_splits)
|
|
13 |
apply (drule dir_not_tainted, simp)
|
|
14 |
apply (drule msgq_not_tainted, simp)
|
|
15 |
apply (drule shm_not_tainted, simp)
|
|
16 |
done
|
|
17 |
|
|
18 |
lemma delq_imp_delqm:
|
|
19 |
"deleted (O_msgq q) s \<Longrightarrow> deleted (O_msg q m) s"
|
|
20 |
apply (induct s, simp)
|
|
21 |
by (case_tac a, auto)
|
|
22 |
|
|
23 |
lemma tainted_s_subset_prop:
|
|
24 |
"\<lbrakk>tainted_s ss sobj; ss \<subseteq> ss'\<rbrakk> \<Longrightarrow> tainted_s ss' sobj"
|
|
25 |
apply (case_tac sobj)
|
|
26 |
apply auto
|
|
27 |
done
|
|
28 |
|
|
29 |
theorem static_complete:
|
|
30 |
assumes undel: "undeletable obj" and tbl: "taintable obj"
|
|
31 |
shows "taintable_s obj"
|
|
32 |
proof-
|
|
33 |
from tbl obtain s where tainted: "obj \<in> tainted s"
|
|
34 |
by (auto simp:taintable_def)
|
|
35 |
hence vs: "valid s" by (simp add:tainted_is_valid)
|
|
36 |
hence static: "s2ss s \<propto> static" using d2s_main by auto
|
|
37 |
from tainted tbl vs obtain sobj where sobj: "co2sobj s obj = Some sobj"
|
|
38 |
apply (clarsimp simp add:taintable_def)
|
|
39 |
apply (frule tainted_in_current)
|
|
40 |
apply (case_tac obj, simp_all add:co2sobj.simps)
|
|
41 |
apply (frule current_proc_has_sp, simp, auto)
|
|
42 |
done
|
|
43 |
from undel vs have "\<not> deleted obj s" and init_alive: "init_alive obj"
|
|
44 |
by (auto simp:undeletable_def)
|
|
45 |
with vs sobj have "init_obj_related sobj obj"
|
|
46 |
apply (case_tac obj, case_tac [!] sobj)
|
|
47 |
apply (auto split:option.splits if_splits simp:co2sobj.simps cp2sproc_def ch2sshm_def cq2smsgq_def cm2smsg_def delq_imp_delqm)
|
|
48 |
apply (frule not_deleted_init_file, simp+)
|
|
49 |
apply (drule is_file_has_sfile', simp, erule exE)
|
|
50 |
apply (rule_tac x = sf in bexI)
|
|
51 |
apply (case_tac list, auto split:option.splits simp:is_init_file_props)[1]
|
|
52 |
apply (drule root_is_init_dir', simp)
|
|
53 |
apply (frule not_deleted_init_file, simp, simp)
|
|
54 |
apply (simp add:cf2sfile_def split:option.splits if_splits)
|
|
55 |
apply (simp add:cf2sfiles_def)
|
|
56 |
apply (rule_tac x = list in bexI, simp, simp add:same_inode_files_def not_deleted_init_file)
|
|
57 |
|
|
58 |
apply (frule not_deleted_init_dir, simp+)
|
|
59 |
apply (simp add:cf2sfile_def split:option.splits if_splits)
|
|
60 |
apply (case_tac list, simp add:sroot_def, simp)
|
|
61 |
apply (drule file_dir_conflict, simp+)
|
|
62 |
done
|
|
63 |
with tainted t2ts init_alive sobj static
|
|
64 |
show ?thesis unfolding taintable_s_def
|
|
65 |
apply (simp add:init_ss_in_def)
|
|
66 |
apply (erule bexE)
|
|
67 |
apply (simp add:init_ss_eq_def)
|
|
68 |
apply (rule_tac x = "ss'" in bexI)
|
|
69 |
apply (rule_tac x = "sobj" in exI)
|
|
70 |
thm tainted_s_subset_prop
|
|
71 |
by (auto intro:tainted_s_subset_prop)
|
|
72 |
qed
|
|
73 |
|
|
74 |
lemma cp2sproc_pi:
|
|
75 |
"\<lbrakk>cp2sproc s p = Some (Init p', sec, fds, shms); valid s\<rbrakk> \<Longrightarrow> p = p' \<and> \<not> deleted (O_proc p) s \<and> p \<in> init_procs"
|
|
76 |
by (simp add:cp2sproc_def split:option.splits if_splits)
|
|
77 |
|
|
78 |
lemma cq2smsgq_qi:
|
|
79 |
"\<lbrakk>cq2smsgq s q = Some (Init q', sec, sms); valid s\<rbrakk> \<Longrightarrow> q = q' \<and> \<not> deleted (O_msgq q) s \<and> q \<in> init_msgqs"
|
|
80 |
by (simp add:cq2smsgq_def split:option.splits if_splits)
|
|
81 |
|
|
82 |
lemma cm2smsg_mi:
|
|
83 |
"\<lbrakk>cm2smsg s q m = Some (Init m', sec, ttag); q \<in> init_msgqs; valid s\<rbrakk>
|
|
84 |
\<Longrightarrow> m = m' \<and> \<not> deleted (O_msg q m) s \<and> m \<in> set (init_msgs_of_queue q) \<and> q \<in> init_msgqs"
|
|
85 |
by (clarsimp simp add:cm2smsg_def split:if_splits option.splits)
|
|
86 |
|
|
87 |
lemma ch2sshm_hi:
|
|
88 |
"\<lbrakk>ch2sshm s h = Some (Init h', sec); valid s\<rbrakk> \<Longrightarrow> h = h' \<and> \<not> deleted (O_shm h) s \<and> h \<in> init_shms"
|
|
89 |
by (clarsimp simp:ch2sshm_def split:if_splits option.splits)
|
|
90 |
|
|
91 |
lemma root_not_deleted:
|
|
92 |
"\<lbrakk>deleted (O_dir []) s; valid s\<rbrakk> \<Longrightarrow> False"
|
|
93 |
apply (induct s, simp)
|
|
94 |
apply (frule vd_cons, frule vt_grant_os, case_tac a, auto)
|
|
95 |
done
|
|
96 |
|
|
97 |
lemma cf2sfile_fi:
|
|
98 |
"\<lbrakk>cf2sfile s f = Some (Init f', sec, psecopt, asecs); valid s\<rbrakk> \<Longrightarrow> f = f' \<and>
|
|
99 |
(if (is_file s f) then \<not> deleted (O_file f) s \<and> is_init_file f
|
|
100 |
else \<not> deleted (O_dir f) s \<and> is_init_dir f)"
|
|
101 |
apply (case_tac f)
|
|
102 |
by (auto simp:sroot_def cf2sfile_def root_is_init_dir dest!:root_is_dir' root_not_deleted
|
|
103 |
split:if_splits option.splits)
|
|
104 |
|
|
105 |
lemma init_deled_imp_deled_s:
|
|
106 |
"\<lbrakk>deleted obj s; init_alive obj; sobj \<in> (s2ss s); valid s\<rbrakk> \<Longrightarrow> \<not> init_obj_related sobj obj"
|
|
107 |
apply (rule notI)
|
|
108 |
apply (clarsimp simp:s2ss_def)
|
|
109 |
apply (case_tac obj, case_tac [!] obja, case_tac sobj)
|
|
110 |
apply (auto split:option.splits if_splits dest!:cp2sproc_pi cq2smsgq_qi ch2sshm_hi cm2smsg_mi cf2sfile_fi simp:co2sobj.simps)
|
|
111 |
apply (auto simp:cf2sfiles_def same_inode_files_def has_same_inode_prop1' is_file_def is_dir_def co2sobj.simps
|
|
112 |
split:option.splits t_inode_tag.splits dest!:cf2sfile_fi)
|
|
113 |
done
|
|
114 |
|
|
115 |
lemma deleted_imp_deletable_s:
|
|
116 |
"\<lbrakk>deleted obj s; init_alive obj; valid s\<rbrakk> \<Longrightarrow> deletable_s obj"
|
|
117 |
apply (simp add:deletable_s_def)
|
|
118 |
apply (frule d2s_main)
|
|
119 |
apply (simp add:init_ss_in_def)
|
|
120 |
apply (erule bexE)
|
|
121 |
apply (rule_tac x = ss' in bexI)
|
|
122 |
apply (auto simp add: init_ss_eq_def dest!:init_deled_imp_deled_s)
|
|
123 |
apply (case_tac obj, case_tac [!] sobj)
|
|
124 |
apply auto
|
|
125 |
apply (erule set_mp)
|
|
126 |
apply (simp)
|
|
127 |
apply auto
|
|
128 |
apply (rule_tac x = "(Init list, (aa, ab, b), ac, ba)" in bexI)
|
|
129 |
apply auto
|
|
130 |
done
|
|
131 |
|
|
132 |
lemma init_related_imp_init_sobj:
|
|
133 |
"init_obj_related sobj obj \<Longrightarrow> is_init_sobj sobj"
|
|
134 |
apply (case_tac sobj, case_tac [!] obj, auto)
|
|
135 |
apply (rule_tac x = "(Init list, (aa, ab, b), ac, ba)" in bexI, auto)
|
|
136 |
done
|
|
137 |
|
|
138 |
theorem undeletable_s_complete:
|
|
139 |
assumes undel_s: "undeletable_s obj"
|
|
140 |
shows "undeletable obj"
|
|
141 |
proof-
|
|
142 |
from undel_s have init_alive: "init_alive obj"
|
|
143 |
and alive_s: "\<forall> ss \<in> static. \<exists> sobj \<in> ss. init_obj_related sobj obj"
|
|
144 |
using undeletable_s_def by auto
|
|
145 |
have "\<not> (\<exists> s. valid s \<and> deleted obj s)"
|
|
146 |
proof
|
|
147 |
assume "\<exists> s. valid s \<and> deleted obj s"
|
|
148 |
then obtain s where vs: "valid s" and del: "deleted obj s" by auto
|
|
149 |
from vs have vss: "s2ss s \<propto> static" by (rule d2s_main)
|
|
150 |
with alive_s obtain sobj where in_ss: "sobj \<in> (s2ss s)"
|
|
151 |
and related: "init_obj_related sobj obj"
|
|
152 |
apply (simp add:init_ss_in_def init_ss_eq_def)
|
|
153 |
apply (erule bexE, erule_tac x= ss' in ballE)
|
|
154 |
apply (auto dest:init_related_imp_init_sobj)
|
|
155 |
done
|
|
156 |
from init_alive del vs have "deletable_s obj"
|
|
157 |
by (auto elim:deleted_imp_deletable_s)
|
|
158 |
with alive_s
|
|
159 |
show False by (auto simp:deletable_s_def)
|
|
160 |
qed
|
|
161 |
with init_alive show ?thesis
|
|
162 |
by (simp add:undeletable_def)
|
|
163 |
qed
|
|
164 |
|
|
165 |
theorem final_offer:
|
|
166 |
"\<lbrakk>undeletable_s obj; \<not> taintable_s obj; init_alive obj\<rbrakk> \<Longrightarrow> \<not> taintable obj"
|
|
167 |
apply (erule swap)
|
|
168 |
by (simp add:static_complete undeletable_s_complete)
|
|
169 |
|
|
170 |
(************** static \<rightarrow> dynamic ***************)
|
|
171 |
|
|
172 |
|
|
173 |
lemma set_eq_D:
|
|
174 |
"\<lbrakk>x \<in> S; {x. P x} = S\<rbrakk> \<Longrightarrow> P x"
|
|
175 |
by auto
|
|
176 |
|
|
177 |
lemma cqm2sms_prop1:
|
|
178 |
"\<lbrakk>cqm2sms s q queue = Some sms; sm \<in> set sms\<rbrakk> \<Longrightarrow> \<exists> m. cm2smsg s q m = Some sm"
|
|
179 |
apply (induct queue arbitrary:sms)
|
|
180 |
apply (auto simp:cqm2sms.simps split:option.splits)
|
|
181 |
done
|
|
182 |
|
|
183 |
lemma sq_sm_prop:
|
|
184 |
"\<lbrakk>sm \<in> set sms; cq2smsgq s q = Some (qi, qsec, sms); valid s\<rbrakk>
|
|
185 |
\<Longrightarrow> \<exists> m. cm2smsg s q m = Some sm"
|
|
186 |
by (auto simp:cq2smsgq_def split: option.splits intro:cqm2sms_prop1)
|
|
187 |
|
|
188 |
declare co2sobj.simps [simp add]
|
|
189 |
|
|
190 |
lemma subseteq_D:
|
|
191 |
"\<lbrakk> S \<subseteq> {x. P x}; x \<in> S\<rbrakk> \<Longrightarrow> P x"
|
|
192 |
by auto
|
|
193 |
|
|
194 |
lemma "\<lbrakk>tainted_s ss sobj; ss \<in> static; is_init_sobj sobj\<rbrakk>
|
|
195 |
\<Longrightarrow> \<exists> s. valid s \<and> co2sobj s obj = Some sobj \<and> obj \<in> tainted s"
|
|
196 |
apply (drule s2d_main')
|
|
197 |
apply (erule exE, erule conjE, simp add:s2ss_def init_ss_eq_def, erule conjE)
|
|
198 |
apply (rule_tac x = s in exI, simp)
|
|
199 |
apply (case_tac sobj, simp_all only:tainted_s.simps)
|
|
200 |
thm set_eq_D
|
|
201 |
apply (simp split:option.splits)
|
|
202 |
apply (erule conjE, drule_tac S = ss in set_eq_D, simp, (erule exE|erule conjE)+)
|
|
203 |
apply (rule_tac x = obj in exI, simp)
|
|
204 |
apply (case_tac obj, (simp split:option.splits if_splits)+)
|
|
205 |
|
|
206 |
lemma tainted_s_imp_tainted:
|
|
207 |
"\<lbrakk>tainted_s ss sobj; ss \<in> static; init_obj_related sobj obj\<rbrakk>
|
|
208 |
\<Longrightarrow> \<exists> s. valid s \<and> co2sobj s obj = Some sobj \<and> obj \<in> tainted s"
|
|
209 |
apply (drule s2d_main')
|
|
210 |
apply (erule exE, erule conjE, simp add:s2ss_def init_ss_eq_def, erule conjE)
|
|
211 |
apply (rule_tac x = s in exI, simp)
|
|
212 |
apply (case_tac sobj, simp_all)
|
|
213 |
apply (case_tac[!] obj, simp_all del:co2sobj.simps)
|
|
214 |
apply (simp split:option.splits)
|
|
215 |
apply (erule conjE, drule_tac S = ss in set_eq_D, simp, (erule exE|erule conjE)+)
|
|
216 |
apply (rule_tac x = obj in exI, simp)
|
|
217 |
apply (case_tac obj, (simp split:option.splits if_splits)+)
|
|
218 |
|
|
219 |
apply (erule conjE, drule_tac S = ss in set_eq_D, simp, (erule exE|erule conjE)+)
|
|
220 |
apply (rule_tac x = obj in exI, simp)
|
|
221 |
apply (case_tac obj, (simp split:option.splits if_splits)+)
|
|
222 |
sorry
|
|
223 |
|
|
224 |
|
|
225 |
|
|
226 |
|
|
227 |
lemma tainted_s_imp_tainted:
|
|
228 |
"\<lbrakk>tainted_s ss sobj; ss \<in> static\<rbrakk> \<Longrightarrow> \<exists> s obj. valid s \<and> co2sobj s obj = Some sobj \<and> obj \<in> tainted s"
|
|
229 |
apply (drule s2d_main)
|
|
230 |
apply (erule exE, erule conjE, simp add:s2ss_def)
|
|
231 |
apply (rule_tac x = s in exI, simp)
|
|
232 |
apply (case_tac sobj, simp_all)
|
|
233 |
apply (erule conjE, drule_tac S = ss in set_eq_D, simp, (erule exE|erule conjE)+)
|
|
234 |
apply (rule_tac x = obj in exI, simp)
|
|
235 |
apply (case_tac obj, (simp split:option.splits if_splits)+)
|
|
236 |
|
|
237 |
apply (erule conjE, drule_tac S = ss in set_eq_D, simp, (erule exE|erule conjE)+)
|
|
238 |
apply (rule_tac x = obj in exI, simp)
|
|
239 |
apply (case_tac obj, (simp split:option.splits if_splits)+)
|
|
240 |
done
|
|
241 |
|
|
242 |
lemma has_same_inode_prop3:
|
|
243 |
"has_same_inode s f f' \<Longrightarrow> has_same_inode s f' f"
|
|
244 |
by (auto simp:has_same_inode_def)
|
|
245 |
|
|
246 |
theorem static_sound:
|
|
247 |
assumes tbl_s: "taintable_s obj"
|
|
248 |
shows "taintable obj"
|
|
249 |
proof-
|
|
250 |
from tbl_s obtain ss sobj where static: "ss \<in> static"
|
|
251 |
and sobj: "tainted_s ss sobj" and related: "init_obj_related sobj obj"
|
|
252 |
and init_alive: "init_alive obj" by (auto simp:taintable_s_def)
|
|
253 |
from static sobj tainted_s_imp_tainted
|
|
254 |
obtain s obj' where co2sobj: "co2sobj s obj' = Some sobj"
|
|
255 |
and tainted': "obj' \<in> tainted s" and vs: "valid s" by blast
|
|
256 |
|
|
257 |
from co2sobj related vs
|
|
258 |
have eq:"obj = obj' \<or> (\<exists> f f'. obj = O_file f \<and> obj' = O_file f' \<and> has_same_inode s f f')"
|
|
259 |
apply (case_tac obj', case_tac [!] obj)
|
|
260 |
apply (auto split:option.splits if_splits dest!:cp2sproc_pi cq2smsgq_qi ch2sshm_hi cm2smsg_mi cf2sfile_fi)
|
|
261 |
apply (auto simp:cf2sfiles_def same_inode_files_def has_same_inode_def is_file_def is_dir_def
|
|
262 |
split:option.splits t_inode_tag.splits dest!:cf2sfile_fi)
|
|
263 |
done
|
|
264 |
with tainted' vs have tainted: "obj \<in> tainted s"
|
|
265 |
by (auto dest:has_same_inode_prop3 intro:has_same_inode_tainted)
|
|
266 |
from sobj related init_alive have "appropriate obj"
|
|
267 |
by (case_tac obj, case_tac [!] sobj, auto)
|
|
268 |
with vs init_alive tainted
|
|
269 |
show ?thesis by (auto simp:taintable_def)
|
|
270 |
qed
|
|
271 |
|
|
272 |
end
|
|
273 |
|
|
274 |
end |