diff -r f27ba31b7e96 -r 6f7b9039715f no_shm_selinux/Static.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/no_shm_selinux/Static.thy Tue Dec 17 13:30:21 2013 +0800 @@ -0,0 +1,716 @@ +theory Static +imports Static_type OS_type_def Flask_type Flask +begin + +locale tainting_s = tainting + +begin + +(* +definition init_sectxt_of_file:: "t_file \ security_context_t option" +where + "init_sectxt_of_file f \ + if (is_init_file f) then init_sectxt_of_obj (O_file f) + else if (is_init_dir f) then init_sectxt_of_obj (O_dir f) + else None" +*) + +definition sroot :: "t_sfile" +where + "sroot \ (Init [], sec_of_root, None, {})" + +definition init_cf2sfile :: "t_file \ t_sfile option" +where + "init_cf2sfile f \ + case (parent f) of + None \ Some sroot + | Some pf \ if (is_init_file f) then + (case (init_sectxt_of_obj (O_file f), init_sectxt_of_obj (O_dir pf), get_parentfs_ctxts [] pf) of + (Some sec, Some psec, Some aseclist) \ Some (Init f, sec, Some psec, set aseclist) + | _ \ None) else + (case (init_sectxt_of_obj (O_dir f), init_sectxt_of_obj (O_dir pf), get_parentfs_ctxts [] pf) of + (Some sec, Some psec, Some aseclist) \ Some (Init f, sec, Some psec, set aseclist) + | _ \ None)" + +definition init_cf2sfiles :: "t_file \ t_sfile set" +where + "init_cf2sfiles f \ {sf. \f' \ init_same_inode_files f. init_cf2sfile f' = Some sf}" + +definition init_cfd2sfd :: "t_process \ t_fd \ (security_context_t \ t_open_flags \ t_sfile) option" +where + "init_cfd2sfd p fd = + (case (init_file_of_proc_fd p fd, init_oflags_of_proc_fd p fd, init_sectxt_of_obj (O_fd p fd)) of + (Some f, Some flags, Some sec) \ (case (init_cf2sfile f) of + Some sf \ Some (sec, flags, sf) + | _ \ None) + | _ \ None)" + +definition init_cfds2sfds :: "t_process \ (security_context_t \ t_open_flags \ t_sfile) set" +where + "init_cfds2sfds p \ { sfd. \ fd \ init_proc_file_fds p. init_cfd2sfd p fd = Some sfd}" + +(* +definition init_ch2sshm :: "t_shm \ t_sshm option" +where + "init_ch2sshm h \ (case (init_sectxt_of_obj (O_shm h)) of + Some sec \ Some (Init h, sec) + | _ \ None)" + +definition init_cph2spshs + :: "t_process \ (t_sshm \ t_shm_attach_flag) set" +where + "init_cph2spshs p \ {(sh, flag)| sh flag h. (p, flag) \ init_procs_of_shm h \ + init_ch2sshm h = Some sh}" +*) +definition init_cp2sproc :: "t_process \ t_sproc option" +where + "init_cp2sproc p \ (case (init_sectxt_of_obj (O_proc p)) of + Some sec \ Some (Init p, sec, (init_cfds2sfds p)) + | None \ None)" + +(* acient files of init-file +definition init_o2s_afs :: "t_file \ security_context_t set" +where + "init_o2s_afs f \ {sec. \ f'. f' \ f \ init_sectxt_of_obj (O_dir f') = Some sec}" *) + +definition init_cm2smsg :: "t_msgq \ t_msg \ t_smsg option" +where + "init_cm2smsg q m \ (case (init_sectxt_of_obj (O_msg q m)) of + Some sec \ Some (Init m, sec, (O_msg q m) \ seeds) + | _ \ None)" + +fun init_cqm2sms :: "t_msgq \ t_msg list \ (t_smsg list) option" +where + "init_cqm2sms q [] = Some []" +| "init_cqm2sms q (m#ms) = + (case (init_cqm2sms q ms, init_cm2smsg q m) of + (Some sms, Some sm) \ Some (sm # sms) + | _ \ None)" + +definition init_cq2smsgq :: "t_msgq \ t_smsgq option" +where + "init_cq2smsgq q \ (case (init_sectxt_of_obj (O_msgq q), init_cqm2sms q (init_msgs_of_queue q)) of + (Some sec, Some sms) \ Some (Init q, sec, sms) + | _ \ None)" + +fun init_obj2sobj :: "t_object \ t_sobject option" +where + "init_obj2sobj (O_proc p) = + (case (init_cp2sproc p) of + Some sp \ Some (S_proc sp (O_proc p \ seeds)) + | _ \ None)" +| "init_obj2sobj (O_file f) = + Some (S_file (init_cf2sfiles f) + (\ f'. f' \ (init_same_inode_files f) \ O_file f \ seeds))" +| "init_obj2sobj (O_dir f) = + (case (init_cf2sfile f) of + Some sf \ Some (S_dir sf) + | _ \ None)" +| "init_obj2sobj (O_msgq q) = + (case (init_cq2smsgq q) of + Some sq \ Some (S_msgq sq) + | _ \ None)" +(* +| "init_obj2sobj (O_shm h) = + (case (init_ch2sshm h) of + Some sh \ Some (S_shm sh) + | _ \ None)" +| "init_obj2sobj (O_msg q m) = + (case (init_cq2smsgq q, init_cm2smsg q m) of + (Some sq, Some sm) \ Some (S_msg sq sm) + | _ \ None)" *) +| "init_obj2sobj _ = None" + +definition + "init_static_state \ {sobj. \ obj. init_alive obj \ init_obj2sobj obj = Some sobj}" + +(**************** translation from dynamic to static *******************) + +definition cf2sfile :: "t_state \ t_file \ t_sfile option" +where + "cf2sfile s f \ + case (parent f) of + None \ Some sroot + | Some pf \ if (is_file s f) + then (case (sectxt_of_obj s (O_file f), sectxt_of_obj s (O_dir pf), get_parentfs_ctxts s pf) of + (Some sec, Some psec, Some asecs) \ + Some (if (\ died (O_file f) s \ is_init_file f) then Init f else Created, sec, Some psec, set asecs) + | _ \ None) + else (case (sectxt_of_obj s (O_dir f), sectxt_of_obj s (O_dir pf), get_parentfs_ctxts s pf) of + (Some sec, Some psec, Some asecs) \ + Some (if (\ died (O_dir f) s \ is_init_dir f) then Init f else Created, sec, Some psec, set asecs) + | _ \ None)" + +definition cf2sfiles :: "t_state \ t_file \ t_sfile set" +where + "cf2sfiles s f \ {sf. \ f' \ (same_inode_files s f). cf2sfile s f' = Some sf}" + +(* here cf2sfile is passed with True, because, process' fds are only for files not dirs *) +definition cfd2sfd :: "t_state \ t_process \ t_fd \ t_sfd option" +where + "cfd2sfd s p fd \ + (case (file_of_proc_fd s p fd, flags_of_proc_fd s p fd, sectxt_of_obj s (O_fd p fd)) of + (Some f, Some flags, Some sec) \ (case (cf2sfile s f) of + Some sf \ Some (sec, flags, sf) + | _ \ None) + | _ \ None)" + + +definition cpfd2sfds :: "t_state \ t_process \ t_sfd set" +where + "cpfd2sfds s p \ {sfd. \ fd \ proc_file_fds s p. cfd2sfd s p fd = Some sfd}" + +(* +definition ch2sshm :: "t_state \ t_shm \ t_sshm option" +where + "ch2sshm s h \ (case (sectxt_of_obj s (O_shm h)) of + Some sec \ + Some (if (\ died (O_shm h) s \ h \ init_shms) then Init h else Created, sec) + | _ \ None)" + +definition cph2spshs :: "t_state \ t_process \ t_sproc_sshm set" +where + "cph2spshs s p \ {(sh, flag)| sh flag h. (p, flag) \ procs_of_shm s h \ ch2sshm s h = Some sh}" +*) +definition cp2sproc :: "t_state \ t_process \ t_sproc option" +where + "cp2sproc s p \ (case (sectxt_of_obj s (O_proc p)) of + Some sec \ + Some (if (\ died (O_proc p) s \ p \ init_procs) then Init p else Created, sec, + cpfd2sfds s p) + | _ \ None)" + +definition cm2smsg :: "t_state \ t_msgq \ t_msg \ t_smsg option" +where + "cm2smsg s q m \ (case (sectxt_of_obj s (O_msg q m)) of + Some sec \ + Some (if (\ died (O_msg q m) s \ m \ set (init_msgs_of_queue q)) then Init m else Created, + sec, O_msg q m \ tainted s) + | _ \ None)" + +fun cqm2sms:: "t_state \ t_msgq \ t_msg list \ (t_smsg list) option" +where + "cqm2sms s q [] = Some []" +| "cqm2sms s q (m#ms) = + (case (cqm2sms s q ms, cm2smsg s q m) of + (Some sms, Some sm) \ Some (sm#sms) + | _ \ None)" + +definition cq2smsgq :: "t_state \ t_msgq \ t_smsgq option" +where + "cq2smsgq s q \ (case (sectxt_of_obj s (O_msgq q), cqm2sms s q (msgs_of_queue s q)) of + (Some sec, Some sms) \ + Some (if (\ died (O_msgq q) s \ q \ init_msgqs) then Init q else Created, + sec, sms) + | _ \ None)" + +fun co2sobj :: "t_state \ t_object \ t_sobject option" +where + "co2sobj s (O_proc p) = + (case (cp2sproc s p) of + Some sp \ Some (S_proc sp (O_proc p \ tainted s)) + | _ \ None)" +| "co2sobj s (O_file f) = + Some (S_file (cf2sfiles s f) (O_file f \ tainted s))" +| "co2sobj s (O_dir f) = + (case (cf2sfile s f) of + Some sf \ Some (S_dir sf) + | _ \ None)" +| "co2sobj s (O_msgq q) = + (case (cq2smsgq s q) of + Some sq \ Some (S_msgq sq) + | _ \ None)" +(* +| "co2sobj s (O_shm h) = + (case (ch2sshm s h) of + Some sh \ Some (S_shm sh) + | _ \ None)" + +| "co2sobj s (O_msg q m) = + (case (cq2smsgq s q, cm2smsg s q m) of + (Some sq, Some sm) \ Some (S_msg sq sm) + | _ \ None)" +*) +| "co2sobj s _ = None" + + +definition s2ss :: "t_state \ t_static_state" +where + "s2ss s \ {sobj. \ obj. alive s obj \ co2sobj s obj = Some sobj}" + + +(* ******************************************************** *) + + +fun is_init_sfile :: "t_sfile \ bool" +where + "is_init_sfile (Init _, sec, psec,asec) = True" +| "is_init_sfile _ = False" + +fun is_many_sfile :: "t_sfile \ bool" +where + "is_many_sfile (Created, sec, psec, asec) = True" +| "is_many_sfile _ = False" + +fun is_init_sproc :: "t_sproc \ bool" +where + "is_init_sproc (Init p, sec, fds) = True" +| "is_init_sproc _ = False" + +fun is_many_sproc :: "t_sproc \ bool" +where + "is_many_sproc (Created, sec,fds) = True" +| "is_many_sproc _ = False" + +fun is_many_smsg :: "t_smsg \ bool" +where + "is_many_smsg (Created,sec,tag) = True" +| "is_many_smsg _ = False" + +(* wrong def +fun is_many_smsgq :: "t_smsgq \ bool" +where + "is_many_smsgq (Created,sec,sms) = (True \ (\ sm \ (set sms). is_many_smsg sm))" +| "is_many_smsgq _ = False" +*) + +fun is_many_smsgq :: "t_smsgq \ bool" +where + "is_many_smsgq (Created,sec,sms) = True" +| "is_many_smsgq _ = False" +(* +fun is_many_sshm :: "t_sshm \ bool" +where + "is_many_sshm (Created, sec) = True" +| "is_many_sshm _ = False" +*) +fun is_many :: "t_sobject \ bool" +where + "is_many (S_proc sp tag) = is_many_sproc sp" +| "is_many (S_file sfs tag) = (\ sf \ sfs. is_many_sfile sf)" +| "is_many (S_dir sf ) = is_many_sfile sf" +| "is_many (S_msgq sq ) = is_many_smsgq sq" +(* +| "is_many (S_shm sh ) = is_many_sshm sh" +*) + +fun is_init_smsgq :: "t_smsgq \ bool" +where + "is_init_smsgq (Init q,sec,sms) = True" +| "is_init_smsgq _ = False" + +(* +fun is_init_sshm :: "t_sshm \ bool" +where + "is_init_sshm (Init h,sec) = True" +| "is_init_sshm _ = False" +*) +fun is_init_sobj :: "t_sobject \ bool" +where + "is_init_sobj (S_proc sp tag ) = is_init_sproc sp" +| "is_init_sobj (S_file sfs tag) = (\ sf \ sfs. is_init_sfile sf)" +| "is_init_sobj (S_dir sf ) = is_init_sfile sf" +| "is_init_sobj (S_msgq sq ) = is_init_smsgq sq" +(* +| "is_init_sobj (S_shm sh ) = is_init_sshm sh" +*) +(* +fun update_ss_sp:: "t_static_state \ t_sobject \ t_sobject \ t_static_state" +where + "update_ss_sp ss (S_proc sp tag) (S_proc sp' tag') = + (if (is_many_sproc sp) then ss \ {S_proc sp' tag'} + else (ss - {S_proc sp tag}) \ {S_proc sp' tag'})" + +fun update_ss_sd:: "t_static_state \ t_sobject \ t_sobject \ t_static_state" +where + "update_ss_sd ss (S_dir sf tag) (S_dir sf' tag') = + (if (is_many_sfile sf) then ss \ {S_dir sf' tag'} + else (ss - {S_dir sf tag}) \ {S_dir sf' tag'})" +*) + +(* +fun sparent :: "t_sfile \ t_sfile option" +where + "sparent (Sroot si sec) = None" +| "sparent (Sfile si sec spf) = Some spf" + +inductive is_ancesf :: "t_sfile \ t_sfile \ bool" +where + "is_ancesf sf sf" +| "sparent sf = Some spf \ is_ancesf spf sf" +| "\sparent sf = Some spf; is_ancesf saf spf\ \ is_ancesf saf sf" + +definition sfile_reparent :: "t_sfile \ t_sfile \ t_sfile" +where + "sfile_reparent (Sroot)" +*) + +(* +(* sfds rename aux definitions *) +definition sfds_rename_notrelated + :: "t_sfd set \ t_sfile \ t_sfile \ t_sfd set \ bool" +where + "sfds_rename_notrelated sfds from to sfds' \ + (\ sec flag sf. (sec,flag,sf) \ sfds \ (\ from \ sf) \ (sec,flag,sf) \ sfds')" + +definition sfds_rename_renamed + :: "t_sfd set \ t_sfile \ t_sfile \ t_sfile \ t_sfd set \ bool" +where + "sfds_rename_renamed sfds sf from to sfds' \ + (\ sec flag sf'. (sec,flag,sf) \ sfds \ (sf \ sf') \ + (sec, flag, file_after_rename sf' from to) \ sfds' \ (sec,flag,sf) \ sfds')" + +definition sfds_rename_remain + :: "t_sfd set \ t_sfile \ t_sfile \ t_sfile \ t_sfd set \ bool" +where + "sfds_rename_remain sfds sf from to sfds' \ + (\ sec flag sf'. (sec,flag,sf') \ sfds \ (sf \ sf') \ + (sec, flag, sf') \ sfds' \ (sec,flag, file_after_rename sf' from to) \ sfds')" + + (* for not many, choose on renamed or not *) +definition sfds_rename_choices + :: "t_sfd set \ t_sfile \ t_sfile \ t_sfile \ t_sfd set \ bool" +where + "sfds_rename_choices sfds sf from to sfds' \ + sfds_rename_remain sfds sf from to sfds' \ sfds_rename_renamed sfds sf from to sfds'" + +(* for many, merge renamed with not renamed *) +definition sfds_rename_both + :: "t_sfd set \ t_sfile \ t_sfile \ t_sfile \ t_sfd set \ bool" +where + "sfds_rename_both sfds sf from to sfds' \ + (\ sec flag sf'. (sec,flag,sf') \ sfds \ (sf \ sf') \ + (sec, flag, sf') \ sfds' \ (sec,flag, file_after_rename sf' from to) \ sfds')" + +(* added to the new sfds, are those only under the new sfile *) +definition sfds_rename_added + :: "t_sfd set \ t_sfile \ t_sfile \ t_sfd set \ bool" +where + "sfds_rename_added sfds from to sfds' \ + (\ sec' flag' sf' sec flag. (sec',flag',sf') \ sfds' \ (sec,flag,sf') \ sfds \ + (\ sf. (sec,flag,sf) \ sfds \ sf' = file_after_rename from to sf))" + +definition sproc_sfds_renamed + :: "t_static_state \ t_sfile \ t_sfile \ t_sfile \ t_static_state \ bool" +where + "sproc_sfds_renamed ss sf from to ss' \ + (\ pi sec sfds sshms tagp. S_proc (pi,sec,sfds,sshms) tagp \ ss \ + (\ sfds'. S_proc (pi,sec,sfds',sshms) tagp \ ss \ sfds_rename_renamed sfds sf from to sfds'))" + +definition sproc_sfds_remain + :: "t_static_state \ t_sfile \ t_sfile \ t_sfile \ t_static_state \ bool" +where + "sproc_sfds_remain ss sf from to ss' \ + (\ pi sec sfds sshms tagp. S_proc (pi,sec,sfds,sshms) tagp \ ss \ + (\ sfds'. S_proc (pi,sec,sfds',sshms) tagp \ ss \ sfds_rename_remain sfds sf from to sfds'))" + +(* for not many, choose on renamed or not *) +definition sproc_sfds_choices + :: "t_static_state \ t_sfile \ t_sfile \ t_sfile \ t_static_state \ bool" +where + "sproc_sfds_choices ss sf from to ss' \ + (\ pi sec sfds sshms tagp. S_proc (pi,sec,sfds,sshms) tagp \ ss \ + (\ sfds'. S_proc (pi,sec,sfds',sshms) tagp \ ss \ sfds_rename_choices sfds sf from to sfds'))" + +(* for many, merge renamed with not renamed *) +definition sproc_sfds_both + :: "t_static_state \ t_sfile \ t_sfile \ t_sfile \ t_static_state \ bool" +where + "sproc_sfds_both ss sf from to ss' \ + (\ pi sec sfds sshms tagp. S_proc (pi,sec,sfds,sshms) tagp \ ss \ + (\ sfds'. S_proc (pi,sec,sfds',sshms) tagp \ ss \ sfds_rename_both sfds sf from to sfds'))" + +(* remove (\ sp tag. S_proc sp tag \ ss \ S_proc sp tag \ ss'), + * cause sfds contains sfs informations *) +definition ss_rename_notrelated + :: "t_static_state \ t_sfile \ t_sfile \ t_static_state \ bool" +where + "ss_rename_notrelated ss sf sf' ss' \ + (\ sq. S_msgq sq \ ss \ S_msgq sq \ ss') \ + (\ pi sec sfds sshms tagp. S_proc (pi,sec,sfds,sshms) tagp \ ss \ (\ sfds'. + S_proc (pi,sec,sfds',sshms) tagp \ ss'\ sfds_rename_notrelated sfds sf sf' sfds')) \ + (\ sfs sf'' tag. S_file sfs tag \ ss \ sf'' \ sfs \ (\ sf \ sf'') \ (\ sfs'. + S_file sfs tag \ ss' \ sf'' \ sfs')) \ + (\ sf'' tag. S_dir sf'' tag \ ss \ (\ sf \ sf'') \ S_dir sf'' tag \ ss')" + +(* rename from to, from should definited renamed if not many *) +definition all_descendant_sf_renamed + :: "t_static_state \ t_sfile \ t_sfile \ t_sfile \ t_static_state \ bool" +where + "all_descendant_sf_renamed ss sf from to ss' \ + (\ sfs sf' tagf. sf \ sf' \ S_file sfs tagf \ ss \ sf' \ sfs \ (\ sfs'. + S_file sfs' tagf \ ss' \ file_after_rename from to sf' \ sfs' \ sf' \ sfs')) \ + (\ sf' tagf. sf \ sf' \ S_dir sf' tagf \ ss \ S_dir (file_after_rename from to sf') tagf \ ss' \ S_dir sf' tagf \ ss') \ + sproc_sfds_renamed ss sf from to ss'" + +(* not renamed *) +definition all_descendant_sf_remain + :: "t_static_state \ t_sfile \ t_sfile \ t_sfile \ t_static_state \ bool" +where + "all_descendant_sf_remain ss sf from to ss' \ + (\ sfs sf' tag'. sf \ sf' \ S_file sfs tag' \ ss \ sf' \ sfs \ (\ sfs'. + S_file sfs' tag' \ ss \ file_after_rename from to sf' \ sfs' \ sf' \ sfs')) \ + (\ sf' tag'. sf \ sf' \ S_dir sf' tag' \ ss \ S_dir (file_after_rename from to sf') tag' \ ss' \ S_dir sf' tag' \ ss') \ + sproc_sfds_remain ss sf from to ss'" + +definition all_descendant_sf_choices + :: "t_static_state \ t_sfile \ t_sfile \ t_sfile \ t_static_state \ bool" +where + "all_descendant_sf_choices ss sf from to ss' \ + all_descendant_sf_renamed ss sf from to ss' \ all_descendant_sf_remain ss sf from to ss'" + +definition all_descendant_sf_both + :: "t_static_state \ t_sfile \ t_sfile \ t_sfile \ t_static_state \ bool" +where + "all_descendant_sf_both ss sf from to ss' \ + (\ sfs sf' tag'. sf \ sf' \ S_file sfs tag' \ ss \ sf' \ sfs \ (\ sfs'. + S_file sfs' tag' \ ss \ file_after_rename from to sf' \ sfs' \ sf' \ sfs')) \ + (\ sf' tag'. sf \ sf' \ S_dir sf' tag' \ ss \ + S_dir (file_after_rename from to sf') tag' \ ss' \ S_dir sf' tag' \ ss') \ + sproc_sfds_both ss sf from to ss'" + +definition ss_renamed_file + :: "t_static_state \ t_sfile \ t_sfile \ t_static_state \ bool" +where + "ss_renamed_file ss sf sf' ss' \ + (if (is_many_sfile sf) + then all_descendant_sf_choices ss sf sf sf' ss' + else all_descendant_sf_renamed ss sf sf sf' ss')" + +(* added to the new sfs, are those only under the new sfile *) +definition sfs_rename_added + :: "t_sfile set \ t_sfile \ t_sfile \ t_sfile set \ bool" +where + "sfs_rename_added sfs from to sfs' \ + (\ sf'. sf' \ sfs' \ sf' \ sfs \ (\ sf. sf \ sfs \ sf' = file_after_rename from to sf))" + +(* added to the new sfile, are those only under the new sfile *) +definition ss_rename_added + :: "t_static_state \ t_sfile \ t_sfile \ t_static_state \ bool" +where + "ss_rename_added ss from to ss' \ + (\ pi sec fds fds' shms tagp. S_proc (pi, sec, fds,shms) tagp \ ss \ + S_proc (pi,sec,fds',shms) tagp \ ss' \ sfds_rename_added fds from to fds') \ + (\ sq. S_msgq sq \ ss' \ S_msgq sq \ ss) \ + (\ sfs sfs' tagf. S_file sfs' tagf \ ss' \ S_file sfs tagf \ ss \ + sfs_rename_added sfs from to sfs') \ + (\ sf' tagf. S_dir sf' tagf \ ss' \ S_dir sf' tagf \ ss \ + (\ sf. S_dir sf tagf \ ss \ sf' = file_after_rename from to sf))" + +definition sfile_alive :: "t_static_state \ t_sfile \ bool" +where + "sfile_alive ss sf \ (\ sfs tagf. sf \ sfs \ S_file sfs tagf \ ss)" + +definition sf_alive :: "t_static_state \ t_sfile \ bool" +where + "sf_alive ss sf \ (\ tagd. S_dir sf tagd \ ss) \ sfile_alive ss sf" + +(* constrains that the new static state should satisfy *) +definition ss_rename:: "t_static_state \ t_sfile \ t_sfile \ t_static_state \ bool" +where + "ss_rename ss sf sf' ss' \ + ss_rename_notrelated ss sf sf' ss' \ + ss_renamed_file ss sf sf' ss' \ ss_rename_added ss sf sf' ss' \ + (\ sf''. sf_alive ss sf'' \ sf \ sf'' \ + (if (is_many_sfile sf'') + then all_descendant_sf_choices ss sf'' sf sf' ss' + else all_descendant_sf_both ss sf'' sf sf' ss'))" + +(* two sfile, the last fname should not be equal *) +fun sfile_same_fname:: "t_sfile \ t_sfile \ bool" +where + "sfile_same_fname ((Init n, sec)#spf) ((Init n', sec')#spf') = (n = n')" +| "sfile_same_fname _ _ = False" + +(* no same init sfile/only sfile in the target-to spf, should be in static_state addmissble check *) +definition ss_rename_no_same_fname:: "t_static_state \ t_sfile \ t_sfile \ bool" +where + "ss_rename_no_same_fname ss from spf \ + \ (\ to. sfile_same_fname from to \ parent to = Some spf \ sf_alive ss to)" + +(* is not a function, is a relation (one 2 many) +definition update_ss_rename :: "t_static_state \ t_sfile \ t_sfile \ t_static_state" +where + "update_ss_rename ss sf sf' \ if (is_many_sfile sf) + then (ss \ {S_file (file_after_rename sf sf' sf'') tag | sf'' tag. sf \ sf'' \ S_file sf'' tag \ ss} + \ {S_dir (file_after_rename sf sf' sf'') tag | sf'' tag. sf \ sf'' \ S_dir sf'' tag \ ss}) + else (ss - {S_file sf'' tag | sf'' tag. sf \ sf'' \ S_file sf'' tag \ ss} + - {S_dir sf'' tag | sf'' tag. sf \ sf'' \ S_dir sf'' tag \ ss}) + \ {S_file (file_after_rename sf sf' sf'') tag | sf'' tag. sf \ sf'' \ S_file sf'' tag \ ss} + \ {S_dir (file_after_rename sf sf' sf'') tag | sf'' tag. sf \ sf'' \ S_dir sf'' tag \ ss}" +*) +*) + +fun sectxt_of_sproc :: "t_sproc \ security_context_t" +where + "sectxt_of_sproc (pi,sec,fds) = sec" + +fun sectxt_of_sfile :: "t_sfile \ security_context_t" +where + "sectxt_of_sfile (fi,sec,psec,asecs) = sec" + +fun asecs_of_sfile :: "t_sfile \ security_context_t set" +where + "asecs_of_sfile (fi,sec,psec,asecs) = asecs" + +definition search_check_s :: "security_context_t \ t_sfile \ bool \ bool" +where + "search_check_s pctxt sf if_file = + (if if_file + then search_check_ctxt pctxt (sectxt_of_sfile sf) (asecs_of_sfile sf) True + else search_check_ctxt pctxt (sectxt_of_sfile sf) (asecs_of_sfile sf) False)" + +definition sectxts_of_sfds :: "t_sfd set \ security_context_t set" +where + "sectxts_of_sfds sfds \ {ctxt. \ flag sf. (ctxt, flag, sf) \ sfds}" + +definition inherit_fds_check_s :: "security_context_t \ t_sfd set \ bool" +where + "inherit_fds_check_s pctxt sfds \ inherit_fds_check_ctxt pctxt (sectxts_of_sfds sfds)" + +(* +definition sectxts_of_sproc_sshms :: "t_sproc_sshm set \ security_context_t set" +where + "sectxts_of_sproc_sshms sshms \ {ctxt. \ hi flag. ((hi, ctxt),flag) \ sshms}" + +definition inherit_shms_check_s :: "security_context_t \ t_sproc_sshm set \ bool" +where + "inherit_shms_check_s pctxt sshms \ inherit_shms_check_ctxt pctxt (sectxts_of_sproc_sshms sshms)" + +fun info_flow_sshm :: "t_sproc \ t_sproc \ bool" +where + "info_flow_sshm (pi,sec,fds,shms) (pi',sec',fds',shms') = + (\ sh flag'. (sh, SHM_RDWR) \ shms \ (sh, flag') \ shms')" + +definition info_flow_sproc_sshms :: "t_sproc_sshm set \ t_sproc_sshm set \ bool" +where + "info_flow_sproc_sshms shms shms' \ (\ sh flag'. (sh, SHM_RDWR) \ shms \ (sh, flag') \ shms')" + + +fun info_flow_sshm :: "t_sproc \ t_sproc \ bool" +where + "info_flow_sshm (pi,sec,fds,shms) (pi',sec',fds',shms') = info_flow_sproc_sshms shms shms'" + +inductive info_flow_sshm :: "t_sproc \ t_sproc \ bool" +where + "info_flow_sshm sp sp" +| "\info_flow_sshm sp (pi,sec,fds,shms); info_flow_sproc_sshms shms shms'\ + \ info_flow_sshm sp (pi',sec',fds',shms')" +*) + +(* +fun smsg_related :: "t_msg \ t_smsg list \ bool" +where + "smsg_related m [] = False" +| "smsg_related m ((mi, sec, tag)#sms) = + (if (mi = Init m) then True else smsg_related m sms)" + +fun smsgq_smsg_related :: "t_msgq \ t_msg \ t_smsgq \ bool" +where + "smsgq_smsg_related q m (qi, sec, smsgslist) = ((qi = Init q) \ (smsg_related m smsgslist))" + +fun smsg_relatainted :: "t_msg \ t_smsg list \ bool" +where + "smsg_relatainted m [] = False" +| "smsg_relatainted m ((mi, sec, tag)#sms) = + (if (mi = Init m \ tag = True) then True else smsg_relatainted m sms)" + +fun smsgq_smsg_relatainted :: "t_msgq \ t_msg \ t_smsgq \ bool" +where + "smsgq_smsg_relatainted q m (qi, sec, smsgslist) = + ((qi = Init q) \ (smsg_relatainted m smsgslist))" +*) + +fun sfile_related :: "t_sfile \ t_file \ bool" +where + "sfile_related (fi,sec,psec,asecs) f = (fi = Init f)" +(* +fun sproc_related :: "t_process \ t_sproc \ bool" +where + "sproc_related p (pi, sec, fds, shms) = (pi = Init p)" +*) +fun init_obj_related :: "t_sobject \ t_object \ bool" +where + "init_obj_related (S_proc (pi, sec, fds) tag) (O_proc p') = (pi = Init p')" +| "init_obj_related (S_file sfs tag) (O_file f) = (\ sf \ sfs. sfile_related sf f)" +| "init_obj_related (S_dir sf) (O_dir f) = (sfile_related sf f)" +| "init_obj_related (S_msgq (qi, sec, sms)) (O_msgq q') = (qi = Init q')" +(* +| "init_obj_related (S_shm (hi, sec)) (O_shm h') = (hi = Init h')" + +| "init_obj_related (S_msg (qi, sec, sms) (mi, secm, tagm)) (O_msg q' m') = (qi = Init q' \ mi = Init m')" +*) +| "init_obj_related _ _ = False" + + + +(***************** for backward proof when Instancing static objects ******************) + +fun all_procs :: "t_state \ t_process set" +where + "all_procs [] = init_procs" +| "all_procs (Clone p p' fds # s) = insert p' (all_procs s)" +| "all_procs (e # s) = all_procs s" + +definition next_nat :: "nat set \ nat" +where + "next_nat nset = (Max nset) + 1" + +definition new_proc :: "t_state \ t_process" +where + "new_proc \ = next_nat (current_procs \)" + +definition brandnew_proc :: "t_state \ t_process" +where + "brandnew_proc s \ next_nat (all_procs s)" + +fun remove_create_flag :: "t_open_flags \ t_open_flags" +where + "remove_create_flag (mflag, oflags) = (mflag, oflags - {OF_CREAT})" + +definition new_inode_num :: "t_state \ nat" +where + "new_inode_num \ = next_nat (current_inode_nums \)" + +definition new_msgq :: "t_state \ t_msgq" +where + "new_msgq s = next_nat (current_msgqs s)" + +definition new_msg :: "t_state \ t_msgq \ nat" +where + "new_msg s q = next_nat (set (msgs_of_queue s q))" + +(* +definition new_shm :: "t_state \ nat" +where + "new_shm \ = next_nat (current_shms \)" +*) + +definition new_proc_fd :: "t_state \ t_process \ t_fd" +where + "new_proc_fd \ p = next_nat (current_proc_fds \ p)" + +definition all_fname_under_dir:: "t_file \ t_state \ t_fname set" +where + "all_fname_under_dir d \ = {fn. \ f. fn # d = f \ f \ current_files \}" + +fun fname_all_a:: "nat \ t_fname" +where + "fname_all_a 0 = []" | + "fname_all_a (Suc n) = ''a''@(fname_all_a n)" + +definition fname_length_set :: "t_fname set \ nat set" +where + "fname_length_set fns = length`fns" + +definition next_fname:: "t_file \ t_state \ t_fname" +where + "next_fname pf \ = fname_all_a ((Max (fname_length_set (all_fname_under_dir pf \))) + 1)" + +definition new_childf:: "t_file \ t_state \ t_file" +where + "new_childf pf \ = next_fname pf \ # pf" + +end + +end \ No newline at end of file