diff -r b6333712cb02 -r fc749f19b894 Current_prop.thy --- a/Current_prop.thy Mon Jun 24 15:22:37 2013 +0800 +++ b/Current_prop.thy Tue Jul 09 14:43:51 2013 +0800 @@ -55,15 +55,332 @@ "\info_flow_shm s p p'; valid s\ \ p \ current_procs s \ p' \ current_procs s" by (auto intro:procs_of_shm_prop2 simp:info_flow_shm_def one_flow_shm_def) -(*********** simpset for info_flow_shm **************) +lemma flag_of_proc_shm_prop1: + "\flag_of_proc_shm s p h = Some flag; valid s\ \ (p, flag) \ procs_of_shm s h" +apply (induct s arbitrary:p flag) +apply (simp, drule init_shmflag_has_proc, simp) +apply (frule vd_cons, frule vt_grant_os) +apply (case_tac a, auto split:if_splits option.splits dest:procs_of_shm_prop2) +done + +(*********** simpset for one_flow_shm **************) + +lemma one_flow_not_self: + "one_flow_shm s h p p \ False" +by (simp add:one_flow_shm_def) + +lemma one_flow_shm_attach: + "valid (Attach p h flag # s) \ one_flow_shm (Attach p h flag # s) = (\ h' pa pb. + if (h' = h) + then (pa = p \ pb \ p \ flag = SHM_RDWR \ (\ flagb. (pb, flagb) \ procs_of_shm s h)) \ + (pb = p \ pa \ p \ (pa, SHM_RDWR) \ procs_of_shm s h) \ + (one_flow_shm s h pa pb) + else one_flow_shm s h' pa pb )" +apply (rule ext, rule ext, rule ext, frule vd_cons, frule vt_grant_os) +by (auto simp add: one_flow_shm_def) + +lemma one_flow_shm_detach: + "valid (Detach p h # s) \ one_flow_shm (Detach p h # s) = (\ h' pa pb. + if (h' = h) + then (pa \ p \ pb \ p \ one_flow_shm s h' pa pb) + else one_flow_shm s h' pa pb)" +apply (rule ext, rule ext, rule ext, frule vt_grant_os) +by (auto simp:one_flow_shm_def) + +lemma one_flow_shm_deleteshm: + "valid (DeleteShM p h # s) \ one_flow_shm (DeleteShM p h # s) = (\ h' pa pb. + if (h' = h) + then False + else one_flow_shm s h' pa pb)" +apply (rule ext, rule ext, rule ext, frule vt_grant_os) +by (auto simp: one_flow_shm_def) + +lemma one_flow_shm_clone: + "valid (Clone p p' fds shms # s) \ one_flow_shm (Clone p p' fds shms # s) = (\ h pa pb. + if (pa = p' \ pb \ p' \ h \ shms) + then (if (pb = p) then (flag_of_proc_shm s p h = Some SHM_RDWR) else one_flow_shm s h p pb) + else if (pb = p' \ pa \ p' \ h \ shms) + then (if (pa = p) then (flag_of_proc_shm s p h = Some SHM_RDWR) else one_flow_shm s h pa p) + else one_flow_shm s h pa pb)" +apply (rule ext, rule ext, rule ext, frule vt_grant_os, frule vd_cons, clarsimp) +apply (frule_tac p = p' in procs_of_shm_prop2', simp) +apply (auto simp:one_flow_shm_def intro:procs_of_shm_prop4 flag_of_proc_shm_prop1) +done + +lemma one_flow_shm_execve: + "valid (Execve p f fds # s) \ one_flow_shm (Execve p f fds # s) = (\ h pa pb. + pa \ p \ pb \ p \ one_flow_shm s h pa pb )" +apply (rule ext, rule ext, rule ext, frule vt_grant_os, frule vd_cons) +by (auto simp:one_flow_shm_def) + +lemma one_flow_shm_kill: + "valid (Kill p p' # s) \ one_flow_shm (Kill p p' # s) = (\ h pa pb. + pa \ p' \ pb \ p' \ one_flow_shm s h pa pb )" +apply (rule ext, rule ext, rule ext, frule vt_grant_os, frule vd_cons) +by (auto simp:one_flow_shm_def) + +lemma one_flow_shm_exit: + "valid (Exit p # s) \ one_flow_shm (Exit p # s) = (\ h pa pb. + pa \ p \ pb \ p \ one_flow_shm s h pa pb )" +apply (rule ext, rule ext, rule ext, frule vt_grant_os, frule vd_cons) +by (auto simp:one_flow_shm_def) + +lemma one_flow_shm_other: + "\valid (e # s); + \ p h flag. e \ Attach p h flag; + \ p h. e \ Detach p h; + \ p h. e \ DeleteShM p h; + \ p p' fds shms. e \ Clone p p' fds shms; + \ p f fds. e \ Execve p f fds; + \ p p'. e \ Kill p p'; + \ p. e \ Exit p + \ \ one_flow_shm (e # s) = one_flow_shm s" +apply (rule ext, rule ext, rule ext, frule vt_grant_os, frule vd_cons) +apply (case_tac e, auto simp:one_flow_shm_def dest:procs_of_shm_prop2) +apply (drule procs_of_shm_prop1, auto) +done + +lemmas one_flow_shm_simps = one_flow_shm_other one_flow_shm_attach one_flow_shm_detach one_flow_shm_deleteshm + one_flow_shm_clone one_flow_shm_execve one_flow_shm_kill one_flow_shm_exit + + +inductive Info_flow_shm :: "t_state \ t_process \ t_process \ bool" +where + ifs_self: "p \ current_procs s \ Info_flow_shm s p p" +| ifs_flow:"\Info_flow_shm s p p'; one_flow_shm s h p' p''\ \ Info_flow_shm s p p''" + +lemma Info_flow_trans_aux: + "Info_flow_shm s p' p'' \ \p. Info_flow_shm s p p' \ Info_flow_shm s p p''" +apply (erule Info_flow_shm.induct) +by (auto intro:Info_flow_shm.intros) + +lemma Info_flow_trans: + "\Info_flow_shm s p p'; Info_flow_shm s p' p''\ \ Info_flow_shm s p p''" +by (auto dest:Info_flow_trans_aux) + +lemma one_flow_flows: + "\one_flow_shm s h p p'; valid s\ \ Info_flow_shm s p p'" +apply (rule Info_flow_shm.intros(2), simp_all) +apply (rule Info_flow_shm.intros(1)) +apply (auto intro:procs_of_shm_prop2 simp:one_flow_shm_def) +done + +lemma ifs_flow': "\one_flow_shm s h p p'; Info_flow_shm s p' p''; valid s\ \ Info_flow_shm s p p''" +apply (drule one_flow_flows, simp+) +apply (erule Info_flow_trans, simp+) +done + +lemma Info_flow_shm_cases1: + "\Info_flow_shm s pa pb; + \p \. \\ = s; pa = p; pb = p; p \ current_procs \\ \ P; + \\ p p' h p''. \\ = s; pa = p; pb = p''; Info_flow_shm \ p p'; one_flow_shm \ h p' p''\ \ P\ + \ P" +by (erule Info_flow_shm.cases, auto) + + +lemma Info_flow_shm_prop1: + "\ Info_flow_shm s p p \ p \ current_procs s" +by (rule notI, drule Info_flow_shm.intros(1), simp) + +lemma Info_flow_shm_intro4: + "\(p, flagb) \ procs_of_shm s h; valid s\ \ Info_flow_shm s p p" +by (drule procs_of_shm_prop2, simp, simp add:Info_flow_shm.intros) + +(********* simpset for inductive Info_flow_shm **********) -lemma info_flow_shm_attach: - "valid (Attach p h flag # s) \ info_flow_shm (Attach p h flag # s) = (\ pa pb. - (pa = p \ flag = SHM_RDWR \ (\ flagb. (pb, flagb) \ procs_of_shm s h)) \ - (pb = p \ (pa, SHM_RDWR) \ procs_of_shm s h) \ - (info_flow_shm s pa pb) )" -apply (rule ext, rule ext, frule vt_grant_os) -by (auto simp add:info_flow_shm_def one_flow_shm_def) +lemma Info_flow_shm_attach1: + "Info_flow_shm s' pa pb \ valid s' \ (s' = Attach p h flag # s) \ + ((Info_flow_shm s pa pb) \ + (\ Info_flow_shm s pa pb \ pa = p \ pb \ p \ flag = SHM_RDWR \ + (\ p' flagb. (p', flagb) \ procs_of_shm s h \ Info_flow_shm s p' pb)) \ + (\ Info_flow_shm s pa pb \ pb = p \ pa \ p \ + (\ p'. (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s pa p')))" +proof (induct rule:Info_flow_shm.induct) + case (ifs_self proc \) + show ?case + proof (rule impI) + assume pre: "valid \ \ \ = Attach p h flag # s" + hence p1: "p \ current_procs s" and p2: "valid s" by (auto intro:vd_cons dest:vt_grant_os) + hence p3: "Info_flow_shm s p p" by (auto intro:Info_flow_shm.intros) + from ifs_self pre have "proc \ current_procs s" by simp + hence p4: "Info_flow_shm s proc proc" by (auto intro:Info_flow_shm.intros) + show "Info_flow_shm s proc proc \ + (\ Info_flow_shm s proc proc \ proc = p \ proc \ p \ flag = SHM_RDWR \ + (\p' flagb. (p', flagb) \ procs_of_shm s h \ Info_flow_shm s p' proc)) \ + (\ Info_flow_shm s proc proc \ proc = p \ proc \ p \ + (\p'. (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s proc p'))" + using p4 p3 by auto + qed +next + case (ifs_flow \ pa pb h' pc) + thus ?case + proof (rule_tac impI) + assume p1:"Info_flow_shm \ pa pb" and p2: "valid \ \ (\ = Attach p h flag # s) \ Info_flow_shm s pa pb \ + \ Info_flow_shm s pa pb \ pa = p \ + pb \ p \ flag = SHM_RDWR \ (\p' flagb. (p', flagb) \ procs_of_shm s h \ Info_flow_shm s p' pb) \ + \ Info_flow_shm s pa pb \ pb = p \ pa \ p \ (\p'. (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s pa p')" + and p3: "one_flow_shm \ h' pb pc" and p4: "valid \ \ \ = Attach p h flag # s" + from p2 and p4 have p2': "Info_flow_shm s pa pb \ + (\ Info_flow_shm s pa pb \ pa = p \ pb \ p \ flag = SHM_RDWR \ + (\p' flagb. (p', flagb) \ procs_of_shm s h \ Info_flow_shm s p' pb)) \ + (\ Info_flow_shm s pa pb \ pb = p \ pa \ p \ + (\p'. (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s pa p'))" + by (erule_tac impE, simp) + from p4 have p5: "valid s" and p6: "os_grant s (Attach p h flag)" by (auto intro:vd_cons dest:vt_grant_os) + from p6 have "p \ current_procs s" by simp hence p7:"Info_flow_shm s p p" by (erule_tac Info_flow_shm.intros) + from p3 p4 have p8: "if (h' = h) + then (pb = p \ pc \ p \ flag = SHM_RDWR \ (\ flagb. (pc, flagb) \ procs_of_shm s h)) \ + (pc = p \ pb \ p \ (pb, SHM_RDWR) \ procs_of_shm s h) \ + (one_flow_shm s h pb pc) + else one_flow_shm s h' pb pc " by (auto simp add:one_flow_shm_attach) + + have "\pa = p; pc = p\ \ Info_flow_shm s pa pc " using p7 by simp + moreover have "\pa = p; pc \ p; flag = SHM_RDWR; \ Info_flow_shm s pa pc\ + \ \p' flagb. (p', flagb) \ procs_of_shm s h \ Info_flow_shm s p' pc" + sorry + moreover have "\pa = p; pc \ p; flag \ SHM_RDWR; \ Info_flow_shm s pa pc\ + \ Info_flow_shm s pa pc" + sorry + moreover have "\pc = p; pa \ p; \ Info_flow_shm s pa pc\ + \ \p'. (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s pa p'" + sorry + ultimately + + + + show "Info_flow_shm s pa pc \ + (\ Info_flow_shm s pa pc \ pa = p \ pc \ p \ flag = SHM_RDWR \ + (\p' flagb. (p', flagb) \ procs_of_shm s h \ Info_flow_shm s p' pc)) \ + (\ Info_flow_shm s pa pc \ pc = p \ pa \ p \ + (\p'. (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s pa p'))" + apply auto + sorry + qed +qed + +lemma Info_flow_shm_intro3: + "\Info_flow_shm s p from; (from, SHM_RDWR) \ procs_of_shm s h; (to, flag) \ procs_of_shm s h\ + \ Info_flow_shm s p to" +apply (case_tac "from = to", simp) +apply (erule_tac h = h in Info_flow_shm.intros(2), simp add:one_flow_shm_def) +by (rule_tac x = flag in exI, simp) + +lemma Info_flow_shm_attach1: + "Info_flow_shm s' pa pb \ valid s' \ (s' = Attach p h flag # s) \ + (if Info_flow_shm s pa pb then True else + (if (pa = p \ flag = SHM_RDWR) + then (\ p' flagb. (p', flagb) \ procs_of_shm s h \ Info_flow_shm s p' pb) + else if (pb = p) + then (\ p'. (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s pa p') + else (\ p' flag'. Info_flow_shm s pa p \ flag = SHM_RDWR \ (p', flag') \ procs_of_shm s h \ + Info_flow_shm s p' pb) \ + (\ p'. Info_flow_shm s pa p' \ (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s p pb) + ) )" +proof (induct rule:Info_flow_shm.induct) + case (ifs_self proc \) + show ?case + proof (rule impI) + assume pre: "valid \ \ \ = Attach p h flag # s" + hence p1: "p \ current_procs s" and p2: "valid s" by (auto intro:vd_cons dest:vt_grant_os) + hence p3: "Info_flow_shm s p p" by (auto intro:Info_flow_shm.intros) + from ifs_self pre have "proc \ current_procs s" by simp + hence p4: "Info_flow_shm s proc proc" by (auto intro:Info_flow_shm.intros) + show "if Info_flow_shm s proc proc then True + else if proc = p \ flag = SHM_RDWR then \p' flagb. (p', flagb) \ procs_of_shm s h \ Info_flow_shm s p' proc + else if proc = p then \p'. (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s proc p' + else (\p' flag'. Info_flow_shm s proc p \ + flag = SHM_RDWR \ (p', flag') \ procs_of_shm s h \ Info_flow_shm s p' proc) \ + (\p'. Info_flow_shm s proc p' \ (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s p proc)" using p4 p3 by auto + qed +next + case (ifs_flow \ pa pb h' pc) + thus ?case + proof (rule_tac impI) + assume p1:"Info_flow_shm \ pa pb" and p2: "valid \ \ \ = Attach p h flag # s \ + (if Info_flow_shm s pa pb then True + else if pa = p \ flag = SHM_RDWR then \p' flagb. (p', flagb) \ procs_of_shm s h \ Info_flow_shm s p' pb + else if pb = p then \p'. (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s pa p' + else (\p' flag'. Info_flow_shm s pa p \ + flag = SHM_RDWR \ (p', flag') \ procs_of_shm s h \ Info_flow_shm s p' pb) \ + (\p'. Info_flow_shm s pa p' \ (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s p pb))" + and p3: "one_flow_shm \ h' pb pc" and p4: "valid \ \ \ = Attach p h flag # s" + + from p2 and p4 have p2': "(if Info_flow_shm s pa pb then True + else if pa = p \ flag = SHM_RDWR then \p' flagb. (p', flagb) \ procs_of_shm s h \ Info_flow_shm s p' pb + else if pb = p then \p'. (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s pa p' + else (\p' flag'. Info_flow_shm s pa p \ + flag = SHM_RDWR \ (p', flag') \ procs_of_shm s h \ Info_flow_shm s p' pb) \ + (\p'. Info_flow_shm s pa p' \ (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s p pb))" + by (erule_tac impE, simp) + from p4 have p5: "valid s" and p6: "os_grant s (Attach p h flag)" by (auto intro:vd_cons dest:vt_grant_os) + from p6 have "p \ current_procs s" by simp hence p7:"Info_flow_shm s p p" by (erule_tac Info_flow_shm.intros) + from p3 p4 have p8: "if (h' = h) + then (pb = p \ pc \ p \ flag = SHM_RDWR \ (\ flagb. (pc, flagb) \ procs_of_shm s h)) \ + (pc = p \ pb \ p \ (pb, SHM_RDWR) \ procs_of_shm s h) \ + (one_flow_shm s h pb pc) + else one_flow_shm s h' pb pc " by (auto simp add:one_flow_shm_attach) + + have "\ flagb. (pc, flagb) \ procs_of_shm s h + \ \ p' flagb. (p', flagb) \ procs_of_shm s h \ Info_flow_shm s p' pc" + apply (rule_tac x= pc in exI, rule_tac x = flagb in exI, frule procs_of_shm_prop2) + by (simp add:p5, simp add:Info_flow_shm.intros(1)) + hence p10: "\ Info_flow_shm s p pc \ (\p' flagb. (p', flagb) \ procs_of_shm s h \ Info_flow_shm s p' pc) \ + Info_flow_shm s pa pc" + using p2' p7 p8 p5 + by (auto split:if_splits dest:Info_flow_shm.intros(2)) + (* apply (rule_tac x = pb in exI, simp add:one_flow_flows, rule_tac x = flagb in exI, simp)+ *) + moreover have "pc = p \ (\ p'. (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s pa p') + \ Info_flow_shm s pa pc" + using p2' p7 p8 p5 + by (auto split:if_splits intro:Info_flow_shm_intro3 simp:one_flow_shm_def) + moreover have "\pc \ p; pa \ p \ flag \ SHM_RDWR\ \ (\p' flag'. Info_flow_shm s pa p \ + flag = SHM_RDWR \ (p', flag') \ procs_of_shm s h \ Info_flow_shm s p' pc) \ + (\p'. Info_flow_shm s pa p' \ (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s p pc) \ + Info_flow_shm s pa pc" + using p2' p7 p8 p5 + apply (auto split:if_splits intro:Info_flow_shm_intro3 simp:one_flow_shm_def) + apply (rule_tac x = pc in exI, simp add:Info_flow_shm_intro4) + apply (rule_tac x = flagb in exI, simp) + done + ultimately show "if Info_flow_shm s pa pc then True + else if pa = p \ flag = SHM_RDWR then \p' flagb. (p', flagb) \ procs_of_shm s h \ Info_flow_shm s p' pc + else if pc = p then \p'. (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s pa p' + else (\p' flag'. Info_flow_shm s pa p \ + flag = SHM_RDWR \ (p', flag') \ procs_of_shm s h \ Info_flow_shm s p' pc) \ + (\p'. Info_flow_shm s pa p' \ (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s p pc)" + using p7 by auto + qed +qed + + + + + + + + + + +lemma Info_flow_shm_attach: + "valid (Attach p h flag # s) \ Info_flow_shm (Attach p h flag # s) = (\ pa pb. + (Info_flow_shm s pa pb) \ + (pa = p \ flag = SHM_RDWR \ (\ flagb. (p', flagb) \ procs_of_shm s h \ Info_flow_shm s p' pb)) \ + (pb = p \ (\ p'. (p', SHM_RDWR) \ procs_of_shm s h \ Info_flow_shm s p' pa)) )" +apply (rule ext, rule ext, rule iffI) +apply (case_tac "Info_flow_shm s pa pb", simp) +apply (case_tac "pa = p \ flag = SHM_RDWR \ (\flagb. (p', flagb) \ procs_of_shm s h \ Info_flow_shm s p' pb)", simp) + +apply (erule Info_flow_shm_cases1, simp, drule_tac p = pc in Info_flow_shm.intros(1), simp) +apply (simp add:one_flow_shm_simps split:if_splits, erule disjE, simp) + + + +apply (simp split:if_splits, (rule impI|rule allI|rule conjI|erule conjE|erule exE)+, simp) +apply (simp) +apply (simp, erule Info_flow_shm_cases', simp, simp) +apply (rule_tac x = +apply (auto dest:Info_flow_shm.cases) +apply (auto simp add:one_flow_shm_simps) lemma info_flow_shm_detach: "valid (Detach p h # s) \ info_flow_shm (Detach p h # s) = (\ pa pb.