adbrucker
/
lh-l4v
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

infoflow: more minor FinalCaps cleanup

This commit is contained in:
Japheth Lim 2018-11-15 18:33:38 +11:00
parent f49aefd4a4
commit 9eaf630e48
1 changed files with 51 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
proof/infoflow/FinalCaps.thy
View File

@ -96,14 +96,6 @@ text {* We introduce a new label. The name 'silc' here stands for 'safe inter-la
datatype 'a subject_label = OrdinaryLabel 'a | SilcLabel
(* FIXEME MOVE *)
(*abbreviation subject_can_affect_not_silc :: "'a subject_label PAS \<Rightarrow> obj_ref \<Rightarrow> bool"
where
"subject_can_affect_not_silc aag ptr \<equiv>
pasObjectAbs aag ptr \<in> subjectAffects (pasPolicy aag) (pasSubject aag)
\<and> pasObjectAbs aag ptr \<noteq> SilcLabel"*)
abbreviation(input) aag_can_read_not_silc
where
"aag_can_read_not_silc aag ptr \<equiv> aag_can_read aag ptr \<and> pasObjectAbs aag ptr \<noteq> SilcLabel"
@ -1873,7 +1865,7 @@ lemma rec_del_silc_inv':
is_subject aag (obj_ref_of cap))\<rbrace>
rec_del call
\<lbrace>\<lambda>_. silc_inv aag st\<rbrace>,\<lbrace>\<lambda>_. silc_inv aag st\<rbrace>"
proof (induct s arbitrary: rule: rec_del.induct, simp_all only: rec_del_fails hoare_fail_any)
proof (induct s rule: rec_del.induct, simp_all only: rec_del_fails hoare_fail_any)
case (1 slot exposed s) show ?case
apply(simp add: split_def rec_del.simps)
apply(rule hoare_pre_spec_validE)
@ -1897,9 +1889,7 @@ lemma rec_del_silc_inv':
apply(rule drop_spec_validE, (wp preemption_point_inv'| simp)+)[1]
apply simp
apply(rule spec_valid_conj_liftE2)
thm valid_validE_R
thm final_cap_same_objrefs
apply(wp_trace rec_del_ReduceZombie_emptyable preemption_point_inv' rec_del_invs
apply(wp rec_del_ReduceZombie_emptyable preemption_point_inv' rec_del_invs
valid_validE_R[OF rec_del_respects(2)[simplified]] "2.hyps"
drop_spec_validE[OF liftE_wp] set_cap_silc_inv
set_cap_pas_refined replace_cap_invs final_cap_same_objrefs set_cap_cte_cap_wp_to
@ -1931,8 +1921,11 @@ lemma rec_del_silc_inv':
apply (clarsimp simp:cte_wp_at_caps_of_state simp del:split_paired_Ex split_paired_All)
apply (elim disjE;clarsimp simp:cte_wp_at_caps_of_state simp del:split_paired_Ex split_paired_All)
apply (clarsimp simp: is_cap_simps gen_obj_refs_eq replaceable_zombie_not_transferable cap_auth_conferred_def clas_no_asid aag_cap_auth_def
pas_refined_all_auth_is_owns cli_no_irqs simp del:split_paired_Ex split_paired_All dest!:appropriate_Zombie[symmetric, THEN trans, symmetric])
apply (clarsimp simp: is_cap_simps gen_obj_refs_eq replaceable_zombie_not_transferable
cap_auth_conferred_def clas_no_asid aag_cap_auth_def
pas_refined_all_auth_is_owns cli_no_irqs
simp del: split_paired_Ex split_paired_All
dest!: appropriate_Zombie[symmetric, THEN trans, symmetric])
apply (fastforce dest: sym[where s="{_}"])
done
apply(wp finalise_cap_pas_refined finalise_cap_silc_inv finalise_cap_auth' finalise_cap_ret'
@ -1940,11 +1933,11 @@ lemma rec_del_silc_inv':
finalise_cap_invs[where slot=slot]
finalise_cap_replaceable[where sl=slot]
finalise_cap_makes_halted[where slot=slot]
finalise_cap_auth' static_imp_wp)[1]
finalise_cap_auth' static_imp_wp)
apply(wp drop_spec_validE[OF liftE_wp] get_cap_auth_wp[where aag=aag]
| simp add: is_final_cap_def)+
apply (clarsimp simp: conj_comms cong: conj_cong simp: caps_of_state_cteD)
apply (clarsimp simp: conj_comms caps_of_state_cteD)
apply (frule (1) caps_of_state_valid)
apply (frule if_unsafe_then_capD [OF caps_of_state_cteD]; clarsimp)
@ -2038,7 +2031,8 @@ lemma rec_del_silc_inv_CTEDelete_transferable':
del: wp_not_transferable
| wpc)+
apply (rule hoare_post_impErr,rule rec_del_Finalise_transferable)
apply force apply force
apply force
apply force
apply (clarsimp)
apply (frule(3) cca_to_transferable_or_subject[OF invs_valid_objs invs_mdb])
apply (frule(4) cdt_change_allowed_not_silc[OF invs_valid_objs invs_mdb])
@ -2802,43 +2796,6 @@ lemma subject_not_silc: "is_subject aag x \<Longrightarrow> silc_inv aag st s \<
apply (clarsimp simp add: silc_inv_def)
done
lemma cap_insert_silc_inv'':
"\<lbrace>silc_inv aag st and (\<lambda> s. \<not> cap_points_to_label aag cap (pasObjectAbs aag (fst dest)) \<longrightarrow>
(\<exists> lslot. lslot \<in> slots_holding_overlapping_caps cap s \<and>
pasObjectAbs aag (fst lslot) = SilcLabel)) and
K (is_subject aag (fst src) \<and> is_subject aag (fst dest))\<rbrace>
cap_insert cap src dest
\<lbrace>\<lambda>_. silc_inv aag st\<rbrace>"
unfolding cap_insert_def
apply (wp set_cap_silc_inv hoare_vcg_ex_lift
set_untyped_cap_as_full_slots_holding_overlapping_caps_other[where aag=aag]
get_cap_wp update_cdt_silc_inv set_cap_caps_of_state2
set_untyped_cap_as_full_cdt_is_original_cap static_imp_wp
| simp split del: if_split)+
apply (intro impI conjI allI)
apply clarsimp
apply(fastforce simp: silc_inv_def)
apply clarsimp
apply(drule_tac cap=capa in silc_invD)
apply assumption
apply(fastforce simp: intra_label_cap_def)
apply fastforce
apply(fastforce simp: silc_inv_def)
apply (elim conjE)
apply (drule(1) subject_not_silc)+
apply (subgoal_tac "\<forall>b. all_children
(\<lambda>x. pasObjectAbs aag (fst x) = SilcLabel)
(\<lambda>a. if a = dest
then if b
then Some src else cdt s src
else cdt s a)")
apply simp
apply (intro allI)
apply (drule silc_inv_all_children)
apply (simp add: all_children_def del: split_paired_All)
apply fastforce
done
lemma cap_insert_silc_inv''':
"\<lbrace>silc_inv aag st and (\<lambda> s. \<not> cap_points_to_label aag cap (pasObjectAbs aag (fst dest)) \<longrightarrow>
(\<exists> lslot. lslot \<in> slots_holding_overlapping_caps cap s \<and>
@ -2861,19 +2818,23 @@ lemma cap_insert_silc_inv''':
apply(fastforce simp: intra_label_cap_def)
apply fastforce
apply (elim conjE)
apply (subgoal_tac "\<forall>b. all_children
(\<lambda>x. pasObjectAbs aag (fst x) = SilcLabel)
(\<lambda>a. if a = dest
then if b
then Some src else cdt s src
else cdt s a)")
apply simp
apply (intro allI)
apply (drule silc_inv_all_children)
apply (simp add: all_children_def del: split_paired_All)
apply fastforce
done
(* special case of newer cap_insert_silc_inv''' *)
lemma cap_insert_silc_inv'':
"\<lbrace>silc_inv aag st and (\<lambda> s. \<not> cap_points_to_label aag cap (pasObjectAbs aag (fst dest)) \<longrightarrow>
(\<exists> lslot. lslot \<in> slots_holding_overlapping_caps cap s \<and>
pasObjectAbs aag (fst lslot) = SilcLabel)) and
K (is_subject aag (fst src) \<and> is_subject aag (fst dest))\<rbrace>
cap_insert cap src dest
\<lbrace>\<lambda>_. silc_inv aag st\<rbrace>"
apply (rule hoare_pre_imp[rotated])
apply (rule cap_insert_silc_inv''')
apply clarsimp
by (metis subject_not_silc)
lemma cap_delete_one_cte_wp_at_other: