diff -r b992684e9ff6 -r dcde836219bc rc_theory.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/rc_theory.thy Fri Apr 12 10:43:11 2013 +0100 @@ -0,0 +1,990 @@ +theory rc_theory +imports Main my_list_prefix +begin + + +(****************** rc policy (role, type, ... ) type definitions *****************) +(*** normal: user-defined values for policy ***) +(*** others: RC special values for RC internal control ***) + +datatype t_client = + Client1 +| Client2 + +datatype t_normal_role = + WebServer +| WS "t_client" +| UpLoad "t_client" +| CGI "t_client" + +datatype t_role = + InheritParentRole +| UseForcedRole +| InheritUpMixed +| InheritUserRole +| InheritProcessRole +| NormalRole "t_normal_role" + +datatype t_normal_file_type = + Root_file_type (* special value, as 0 for root-file in the NordSec paper*) +| WebServerLog_file +| WebData_file "t_client" +| CGI_P_file "t_client" +| PrivateD_file "t_client" +| Executable_file (* basic protection of RC *) + +datatype t_rc_file_type = + InheritParent_file_type +| NormalFile_type t_normal_file_type + +datatype t_normal_proc_type = + WebServer_proc +| CGI_P_proc "t_client" + +datatype t_rc_proc_type = + InheritParent_proc_type +| NormalProc_type t_normal_proc_type +| UseNewRoleType + +datatype t_normal_ipc_type = + WebIPC + +datatype t_normal_rc_type = + File_type t_normal_file_type +| Proc_type t_normal_proc_type +| IPC_type t_normal_ipc_type + + + +(******* Operating System type definitions ********) + +type_synonym t_process = nat + +type_synonym t_user = nat + +type_synonym t_fname = string + +type_synonym t_file = "t_fname list" + +type_synonym t_ipc = nat + + + +(****** Access Control related type definitions *********) + +datatype t_event = + ChangeOwner "t_process" "t_user" +| Clone "t_process" "t_process" +| Execute "t_process" "t_file" +| CreateFile "t_process" "t_file" +| CreateIPC "t_process" "t_ipc" +| ChangeRole "t_process" "t_normal_role" (* A process should change to normal role, which not specified in paper! *) + +(* below are events added for tainting modelling *) +| ReadFile "t_process" "t_file" +| WriteFile "t_process" "t_file" +| Send "t_process" "t_ipc" +| Recv "t_process" "t_ipc" + +| Kill "t_process" "t_process" +| DeleteFile "t_process" "t_file" +| DeleteIPC "t_process" "t_ipc" + +type_synonym t_state = "t_event list" + +datatype t_access_type = (*changed by wch, original: "types access_type = nat" *) + READ +| WRITE +| EXECUTE +| CHANGE_OWNER +| CREATE +| SEND +| RECEIVE + +| DELETE + + +(****** Some global functions' definition *****) + +fun parent :: "'a list \ ('a list) option" +where + "parent [] = None" + | "parent (n#ns) = Some ns" + +definition some_in_set :: "'a set \ 'a" +where + "some_in_set S \ SOME x. x \ S" + +lemma nonempty_set_has_ele: "S \ {} \ \ e. e \ S" by auto + +lemma some_in_set_prop: "S \ {} \ some_in_set S \ S" +by (drule nonempty_set_has_ele, auto simp:some_in_set_def intro:someI) + + +(*********** locale for RC+OS definitions **********) + +definition bidirect_in_init :: "'a set \ ('a \ 'b option) \ bool" +where + "bidirect_in_init S f \ (\ a. a \ S \ (\ b. f a = Some b)) \ + (\ a b. f a = Some b \ a \ S)" + +locale init = + fixes + init_files :: "t_file set" + and init_file_type :: "t_file \ t_normal_file_type" + and init_initialrole :: "t_file \ t_role" + and init_forcedrole :: "t_file \ t_role" + + and init_processes :: "t_process set " + and init_process_type :: "t_process \ t_normal_proc_type" + and init_currentrole :: "t_process \ t_normal_role" + and init_proc_forcedrole:: "t_process \ t_role" + + and init_ipcs :: "t_ipc set" + and init_ipc_type:: "t_ipc \ t_normal_ipc_type" + + and init_users :: "t_user set" + and init_owner :: "t_process \ t_user" + and defrole :: "t_user \ t_normal_role" (* defrole should return normalrole, which is not +specified in NordSec paper *) + + and default_fd_create_type :: "t_normal_role \ t_rc_file_type" (* this func should only +return type for normal role, for RC special role, error ! NordSec paper*) + and default_ipc_create_type :: "t_normal_role \ t_normal_ipc_type" (* like above, NordSec paper +does not specify the domain is normal roles *) + and default_process_create_type :: "t_normal_role \ t_rc_proc_type" + and default_process_execute_type :: "t_normal_role \ t_rc_proc_type" + and default_process_chown_type :: "t_normal_role \ t_rc_proc_type" + + and comproles :: "t_normal_role \ t_normal_role set" (* NordSec paper do not specify all roles +here are normal *) + + and compatible :: "(t_normal_role \ t_normal_rc_type \ t_access_type) set" (* NordSec paper do not specify all roles and all types here are normal ! *) + + assumes + parent_file_in_init: "\ f pf. \parent f = Some pf; f \ init_files\ \ pf \ init_files" + and root_in_filesystem: "[] \ init_files" + and init_irole_has_file: "\ f r. init_initialrole f = Some r \ f \ init_files" + and init_frole_has_file: "\ f r. init_forcedrole f = Some r \ f \ init_files" + and init_ftype_has_file: "\ f t. init_file_type f = Some t \ f \ init_files" + and + init_proc_has_role: "bidirect_in_init init_processes init_currentrole" + and init_proc_has_frole: "bidirect_in_init init_processes init_proc_forcedrole" + and init_proc_has_type: "bidirect_in_init init_processes init_process_type" + and + init_ipc_has_type: "bidirect_in_init init_ipcs init_ipc_type" + and + init_user_has_role: "bidirect_in_init init_users defrole" + and init_proc_has_owner: "bidirect_in_init init_processes init_owner" + and init_owner_valid: "\ p u. init_owner p = Some u \ u \ init_users" + and + init_finite: "finite init_files \ finite init_processes \ finite init_ipcs \ finite init_users" +begin + +(***** Operating System Listeners *****) + +fun current_files :: "t_state \ t_file set" +where + "current_files [] = init_files" +| "current_files (CreateFile p f # s) = insert f (current_files s)" +| "current_files (DeleteFile p f # s) = current_files s - {f}" +| "current_files (_ # s) = current_files s" + +fun current_procs :: "t_state \ t_process set" +where + "current_procs [] = init_processes" +| "current_procs (Clone p p' # s) = insert p' (current_procs s)" +| "current_procs (Kill p p' # s) = current_procs s - {p'} " +| "current_procs (_ # s) = current_procs s" + +fun current_ipcs :: "t_state \ t_ipc set" +where + "current_ipcs [] = init_ipcs" +| "current_ipcs (CreateIPC p i # s) = insert i (current_ipcs s)" +| "current_ipcs (DeleteIPC p i # s) = current_ipcs s - {i}" +| "current_ipcs (_ # s) = current_ipcs s" + +fun owner :: "t_state \ t_process \ t_user" +where + "owner [] = init_owner" +| "owner (Clone p p' # \) = (owner \) (p' := owner \ p)" +| "owner (ChangeOwner p u # \) = (owner \) (p := Some u)" +| "owner (_ # \) = owner \" + +(***** functions for rc internal *****) + +(*** Roles Functions ***) + +(* comments: +We have fix init_initialrole already in locale, why need this function? + Cause, users may be lazy to specify every file in the initial state to some InheritParent as +initialrole, they can just specify all the important files with special initial role, leaving +all other None, it is init_file_initialrole's job to fill default value(InheritParent) for +other files. Accutally, this has the point of "Functional default settings" in the 2 section of +the NordSec paper. +init_file_forcedrole, and init_file_type_aux are of the same meaning. +*) +fun init_file_initialrole :: "t_file \ t_role" +where + "init_file_initialrole [] = (case (init_initialrole []) of + None \ Some UseForcedRole + | Some r \ Some r)" +| "init_file_initialrole f = (case (init_initialrole f) of + None \ Some InheritParentRole + | Some r \ Some r)" + +fun initialrole :: "t_state \ (t_file \ t_role)" +where + "initialrole [] = init_file_initialrole" +| "initialrole (CreateFile p f # s) = (initialrole s) (f:= Some InheritParentRole)" +| "initialrole (_ # s) = initialrole s" + +fun erole_functor :: "(t_file \ t_role) \ t_role \ (t_file \ t_role)" +where + "erole_functor rfunc r [] = ( + if (rfunc [] = Some InheritParentRole) + then Some r + else rfunc [] )" +| "erole_functor rfunc r (n#ns) = ( + if (rfunc (n#ns) = Some InheritParentRole) + then erole_functor rfunc r ns + else rfunc (n#ns) )" + +definition effinitialrole :: "t_state \ (t_file \ t_role)" +where + "effinitialrole s \ erole_functor (initialrole s) UseForcedRole" + +fun init_file_forcedrole :: "t_file \ t_role" +where + "init_file_forcedrole [] = ( case (init_forcedrole []) of + None \ Some InheritUpMixed + | Some r \ Some r )" +| "init_file_forcedrole f = ( case (init_forcedrole f) of + None \ Some InheritParentRole + | Some r \ Some r )" + +fun forcedrole :: "t_state \ (t_file \ t_role)" +where + "forcedrole [] = init_file_forcedrole" +| "forcedrole (CreateFile p f # s) = (forcedrole s) (f:= Some InheritParentRole)" +| "forcedrole (_ # s) = forcedrole s" + +definition effforcedrole :: "t_state \ (t_file \ t_role)" +where + "effforcedrole s \ erole_functor (forcedrole s) InheritUpMixed" + +fun proc_forcedrole :: "t_state \ (t_process \ t_role)" (* $6.7$ *) +where + "proc_forcedrole [] = init_proc_forcedrole" +| "proc_forcedrole (Execute p f # s) = (proc_forcedrole s) (p := effforcedrole s f)" +| "proc_forcedrole (Clone p p' # s) = (proc_forcedrole s) (p' := proc_forcedrole s p)" +| "proc_forcedrole (e # s) = proc_forcedrole s" + +fun currentrole :: "t_state \ (t_process \ t_normal_role)" +where + "currentrole [] = init_currentrole" +| "currentrole (Clone p p' # \) = (currentrole \) (p' := currentrole \ p)" +| "currentrole (Execute p f # \) = (currentrole \) (p := + case (effinitialrole \ f) of + Some ir \ (case ir of + NormalRole r \ Some r + | UseForcedRole \ ( + case (effforcedrole \ f) of + Some fr \ (case fr of + NormalRole r \ Some r + | InheritUserRole \ (defrole \\<^sub>m (owner \)) p + | InheritProcessRole \ currentrole \ p + | InheritUpMixed \ currentrole \ p + | _ \ None ) + | _ \ None ) + | _ \ None ) + | _ \ None )" +| "currentrole (ChangeOwner p u # \) = (currentrole \) (p := + case (proc_forcedrole \ p) of + Some fr \ (case fr of + NormalRole r \ Some r + | InheritProcessRole \ currentrole \ p + | InheritUserRole \ defrole u + | InheritUpMixed \ defrole u + | _ \ None) + | _ \ None )" +| "currentrole (ChangeRole p r # \) = (currentrole \) (p := Some r)" +| "currentrole (_ # \) = currentrole \" + +(*** Types Functions ***) + +fun init_file_type_aux :: "t_file \ t_rc_file_type" +where + "init_file_type_aux f = (if (f \ init_files) + then (case (init_file_type f) of + Some t \ Some (NormalFile_type t) + | _ \ Some InheritParent_file_type) + else None)" + +fun type_of_file :: "t_state \ (t_file \ t_rc_file_type)" (* (6) *) +where + "type_of_file [] = init_file_type_aux" +| "type_of_file (CreateFile p f # s) = ( + case (currentrole s p) of + Some r \ (type_of_file s) (f := Some (default_fd_create_type r)) + | _ \ (type_of_file s) (f := None))" +| "type_of_file (_ # s) = type_of_file s" (* add by wch *) + +fun etype_aux:: "(t_file \ t_rc_file_type) \ (t_file \ t_normal_file_type)" +where + "etype_aux typf [] = ( + case (typf []) of + Some InheritParent_file_type \ Some Root_file_type + | Some (NormalFile_type t) \ Some t + | None \ None )" +| "etype_aux typf (n#ns) = ( + case (typf (n#ns)) of + Some InheritParent_file_type \ etype_aux typf ns + | Some (NormalFile_type t) \ Some t + | None \ None )" + +definition etype_of_file :: "t_state \ (t_file \ t_normal_file_type)" + (* etype is always normal *) +where + "etype_of_file s \ etype_aux (type_of_file s)" + +definition pct :: "t_state \ (t_process \ t_rc_proc_type)" +where + "pct s p \ (case (currentrole s p) of + Some r \ Some (default_process_create_type r) + | _ \ None)" + +definition pet :: "t_state \ (t_process \ t_rc_proc_type)" +where + "pet s p \ (case (currentrole s p) of + Some r \ Some (default_process_execute_type r) + | _ \ None)" + +definition pot :: "t_state \ (t_process \ t_rc_proc_type)" +where + "pot s p \ (case (currentrole s p) of + Some r \ Some (default_process_chown_type r) + | _ \ None)" + +fun type_of_process :: "t_state \ (t_process \ t_normal_proc_type)" +where + "type_of_process [] = init_process_type" +| "type_of_process (Clone p p' # \) = (type_of_process \) (p' := + case (pct \ p) of + Some InheritParent_proc_type \ type_of_process \ p + | Some (NormalProc_type tp) \ Some tp + | _ \ None )" (*6.80*) +| "type_of_process (Execute p f # \) = (type_of_process \) (p := + case (pet \ p) of + Some InheritParent_proc_type \ type_of_process \ p + | Some (NormalProc_type tp) \ Some tp + | _ \ None )" (*6.82*) +| "type_of_process (ChangeOwner p u # \) = (type_of_process \) (p := + case (pot \ p) of + Some InheritParent_proc_type \ type_of_process \ p + | Some UseNewRoleType \ (case (pct (ChangeOwner p u # \) p) of + Some InheritParent_proc_type \ type_of_process \ p + | Some (NormalProc_type tp) \ Some tp + | _ \ None) + | Some (NormalProc_type tp) \ Some tp + | _ \ None )" (* the UseNewRoleType case is refered with Nordsec paper 4 (11), and it is not right??! of just +use "pct" *) +| "type_of_process (_ # \) = type_of_process \" + +fun type_of_ipc :: "t_state \ (t_ipc \ t_normal_ipc_type)" (* (14) *) +where + "type_of_ipc [] = init_ipc_type" +| "type_of_ipc (CreateIPC p i # s) = (type_of_ipc s) (i := + case (currentrole s p) of + Some r \ Some (default_ipc_create_type r) + | _ \ None )" +| "type_of_ipc (_ # s) = type_of_ipc s" (* add by wch *) + +(*** RC access control ***) +fun rc_grant :: "t_state \ t_event \ bool" +where + "rc_grant \ (CreateFile p f) = ( + case (parent f) of + Some pf \ ( + case (currentrole \ p, etype_of_file \ pf) of + (Some r, Some t) \ ( + case (default_fd_create_type r) of + InheritParent_file_type \ (r, File_type t, WRITE) \ compatible + | NormalFile_type t' \ (r, File_type t, WRITE) \ compatible \ (r, File_type t', CREATE) \ compatible + ) + | _ \ False ) + | _ \ False )" +| "rc_grant \ (ReadFile p f) = ( + case (currentrole \ p, etype_of_file \ f) of + (Some r, Some t) \ (r, File_type t, READ) \ compatible + | _ \ False )" +| "rc_grant \ (WriteFile p f) = ( + case (currentrole \ p, etype_of_file \ f) of + (Some r, Some t) \ (r, File_type t, WRITE) \ compatible + | _ \ False )" +| "rc_grant \ (Execute p f) = ( + case (currentrole \ p, etype_of_file \ f) of + (Some r, Some t) \ (r, File_type t, EXECUTE) \ compatible + | _ \ False )" +| "rc_grant \ (ChangeOwner p u) = ( + case (currentrole \ p, type_of_process \ p) of + (Some r, Some t) \ (r, Proc_type t, CHANGE_OWNER) \ compatible + | _ \ False )" +| "rc_grant \ (Clone p newproc) = ( + case (currentrole \ p, type_of_process \ p) of + (Some r, Some t) \ (r, Proc_type t, CREATE) \ compatible + | _ \ False )" (* premiss of no limit to clone is removed to locale assumptions *) +| "rc_grant \ (ChangeRole p r) = ( + case (currentrole \ p) of + Some cr \ r \ comproles cr + | _ \ False )" +| "rc_grant \ (Send p i) = ( + case (currentrole \ p, type_of_ipc \ i) of + (Some r, Some t) \ (r, IPC_type t, SEND) \ compatible + | _ \ False )" +| "rc_grant \ (Recv p i) = ( + case (currentrole \ p, type_of_ipc \ i) of + (Some r, Some t) \ (r, IPC_type t, RECEIVE) \ compatible + | _ \ False )" +| "rc_grant \ (CreateIPC p i) = ( + case (currentrole \ p) of + Some r \ (r, IPC_type (default_ipc_create_type r), CREATE) \ compatible + | _ \ False )" +| "rc_grant \ (DeleteFile p f) = ( + case (currentrole \ p, etype_of_file \ f) of + (Some r, Some t) \ (r, File_type t, DELETE) \ compatible + | _ \ False )" +| "rc_grant \ (DeleteIPC p i) = ( + case (currentrole \ p, type_of_ipc \ i) of + (Some r, Some t) \ (r, IPC_type t, DELETE) \ compatible + | _ \ False )" +| "rc_grant \ (Kill p p') = ( + case (currentrole \ p, type_of_process \ p') of + (Some r, Some t) \ (r, Proc_type t, DELETE) \ compatible + | _ \ False )" + + +(**** OS' job: checking resources existence & grant new resource ****) + +definition next_nat :: "nat set \ nat" +where + "next_nat ps = (Max ps) + 1" + +definition new_proc :: "t_state \ t_process" +where + "new_proc \ = next_nat (current_procs \)" + +definition new_ipc :: "t_state \ t_ipc" +where + "new_ipc \ = next_nat (current_ipcs \)" + +(* new file pathname is user-defined, so os just check if its unexistence *) +fun os_grant :: "t_state \ t_event \ bool" +where + "os_grant \ (Execute p f) = (p \ current_procs \ \ f \ current_files \)" +| "os_grant \ (CreateFile p f) = (p \ current_procs \ \ f \ current_files \ \ (\ pf. (parent f = Some pf) \ pf \ current_files \))" (*cannot create disk, ?? or f = [] ??*) +| "os_grant \ (ChangeRole p r) = (p \ current_procs \)" +| "os_grant \ (ReadFile p f) = (p \ current_procs \ \ f \ current_files \)" +| "os_grant \ (WriteFile p f) = (p \ current_procs \ \ f \ current_files \)" +| "os_grant \ (ChangeOwner p u)= (p \ current_procs \ \ u \ init_users)" +| "os_grant \ (CreateIPC p i) = (p \ current_procs \ \ i = new_ipc \)" +| "os_grant \ (Send p i) = (p \ current_procs \ \ i \ current_ipcs \)" +| "os_grant \ (Recv p i) = (p \ current_procs \ \ i \ current_ipcs \)" +| "os_grant \ (Clone p p') = (p \ current_procs \ \ p' = new_proc \)" +| "os_grant \ (Kill p p') = (p \ current_procs \ \ p' \ current_procs \)" +| "os_grant \ (DeleteFile p f) = (p \ current_procs \ \ f \ current_files \ \ \ (\fn. fn # f \ current_files \))" +| "os_grant \ (DeleteIPC p i) = (p \ current_procs \ \ i \ current_ipcs \)" + +(**** system valid state ****) + +inductive valid :: "t_state \ bool" +where + vs_nil: "valid []" +| vs_step: "\valid s; os_grant s e; rc_grant s e\ \ valid (e # s)" + +end + +(*** more RC constrains of type system in formalisation ***) + +locale rc_basic = init + + assumes + init_initialrole_valid: "\ f r. init_initialrole f = Some r \ r = InheritParentRole \ r = UseForcedRole \ (\ nr. r = NormalRole nr)" (* 6.10 *) + and init_forcedrole_valid: "\ f r. init_forcedrole f = Some r \ r = InheritUserRole \ r = InheritProcessRole \ r = InheritParentRole \ r = InheritUpMixed \ (\ nr. r = NormalRole nr)" (* 6.11 *) + and init_proc_forcedrole_valid: "\ p r. init_proc_forcedrole p = Some r \ r = InheritUserRole \ r = InheritProcessRole \ r = InheritUpMixed \ (\ nr. r = NormalRole nr)" (* 6.7 *) + and default_fd_create_type_valid: "\ nr t. default_fd_create_type nr = t \ t = InheritParent_file_type \ (\ nt. t = NormalFile_type nt)" (*6.16*) + and default_process_create_type_valid: "\ nr t. default_process_create_type nr = t \ t = InheritParent_proc_type \ (\ nt. t = NormalProc_type nt)" (*6.18*) + and default_process_chown_type_valid: "\ nr t. default_process_chown_type nr = t \ t = InheritParent_proc_type \ t = UseNewRoleType \ (\ nt. t = NormalProc_type nt)" (*6.19*) + and default_process_execute_type_valid: "\ nr t. default_process_execute_type nr = t \ t = InheritParent_proc_type \ (\ nt. t = NormalProc_type nt)" (*6.20*) + +begin + +lemma init_file_initialrole_valid: "init_file_initialrole f = Some r \ r = InheritParentRole \ r = UseForcedRole \ (\ nr. r = NormalRole nr)" +apply (induct f) +by (auto simp:init_file_initialrole.simps dest:init_initialrole_valid split:option.splits) + +lemma initialrole_valid: "initialrole \ f = Some r \ r = InheritParentRole \ r = UseForcedRole \ (\ nr. r = NormalRole nr)" (* 6.10 *) +apply (induct \ arbitrary:f) defer +apply (case_tac a) +apply (auto simp:initialrole.simps dest:init_file_initialrole_valid + split:option.splits if_splits) +done + +lemma effinitialrole_valid: "effinitialrole \ f = Some r \ r = UseForcedRole \ (\ nr. r = NormalRole nr)" +apply (induct f) +apply (auto simp:effinitialrole_def dest:initialrole_valid split:option.splits if_splits) +done + +lemma init_file_forcedrole_valid: + "init_file_forcedrole f = Some r \ r = InheritUserRole \ r = InheritProcessRole \ r = InheritParentRole \ r = InheritUpMixed \ (\ nr. r = NormalRole nr)" +apply (induct f) +by (auto simp:init_file_forcedrole.simps dest:init_forcedrole_valid split:option.splits) + +lemma forcedrole_valid: "forcedrole \ f = Some r \ r = InheritUserRole \ r = InheritProcessRole \ r = InheritParentRole \ r = InheritUpMixed \ (\ nr. r = NormalRole nr)" (* 6.10 *) +apply (induct \ arbitrary:f) defer +apply (case_tac a) +apply (auto simp:forcedrole.simps dest:init_file_forcedrole_valid + split:option.splits if_splits) +done + +lemma effforcedrole_valid: "effforcedrole \ f = Some r \ r = InheritUserRole \ r = InheritProcessRole \ r = InheritUpMixed \ (\ nr. r = NormalRole nr)" +apply (induct f) +apply (auto simp:effforcedrole_def dest:forcedrole_valid split:option.splits if_splits) +done + +lemma proc_forcedrole_valid: "proc_forcedrole \ p = Some r \ r = InheritUserRole \ r = InheritProcessRole \ r = InheritUpMixed \ (\ nr. r = NormalRole nr)" (* 6.7 *) +apply (induct \ arbitrary:p) defer +apply (case_tac a) +apply (auto simp:proc_forcedrole.simps dest:init_proc_forcedrole_valid effforcedrole_valid + split:option.splits if_splits) +done + +lemma pct_valid: "pct \ p = Some t \ t = InheritParent_proc_type \ (\ nt. t = NormalProc_type nt)" +by (auto simp:pct_def default_process_create_type_valid split:option.splits) + +lemma pot_valid: "pot \ p = Some t \ t = InheritParent_proc_type \ t = UseNewRoleType \ (\ nt. t = NormalProc_type nt)" +by (auto simp:pot_def default_process_chown_type_valid split:option.splits) + +lemma pet_valid: "pet \ p = Some t \ t = InheritParent_proc_type \ (\ nt. t = NormalProc_type nt)" +by (simp add:pet_def default_process_execute_type_valid map_comp_def split:option.splits) + +end + +(******* Reachable/tainting related type definitions ********) + +datatype t_object = + Proc "t_process" +| File "t_file" +| IPC "t_ipc" + +fun object_in_init :: "t_object \ t_file set \ t_process set \ t_ipc set \ bool" +where + "object_in_init (Proc p) init_files init_procs init_ipcs = (p \ init_procs)" +| "object_in_init (File f) init_files init_procs init_ipcs = (f \ init_files)" +| "object_in_init (IPC i) init_files init_procs init_ipcs = (i \ init_ipcs)" + +(*** locale for dynamic tainting ***) + +locale tainting = rc_basic + + +fixes seeds :: "t_object set" + +assumes + seeds_in_init: "\ obj. obj \ seeds \ object_in_init obj init_files init_processes init_ipcs" +begin + +lemma finite_seeds: "finite seeds" +proof- + have "finite {obj. object_in_init obj init_files init_processes init_ipcs}" + proof- + have "finite {File f| f. f \ init_files}" + using init_finite by auto + moreover have "finite {Proc p| p. p \ init_processes}" + using init_finite by auto + moreover have "finite {IPC i| i. i \ init_ipcs}" + using init_finite by auto + ultimately have "finite ({File f| f. f \ init_files} \ {Proc p| p. p \ init_processes} \ {IPC i| i. i \ init_ipcs})" + by auto + thus ?thesis + apply (rule_tac B = "({File f| f. f \ init_files} \ {Proc p| p. p \ init_processes} \ {IPC i| i. i \ init_ipcs})" in finite_subset) + by (auto, case_tac x, simp+) + qed + with seeds_in_init + show ?thesis + by (rule_tac finite_subset, auto) +qed + +fun exists :: "t_state \ t_object \ bool" +where + "exists s (File f) = (f \ current_files s)" +| "exists s (Proc p) = (p \ current_procs s)" +| "exists s (IPC i) = (i \ current_ipcs s)" + +inductive tainted :: "t_object \ t_state \ bool" ("_ \ tainted _" [100, 100] 100) +where + t_init: "obj \ seeds \ obj \ tainted []" +| t_clone: "\Proc p \ tainted s; valid (Clone p p' # s)\ \ Proc p' \ tainted (Clone p p' # s)" +| t_exec: "\File f \ tainted s; valid (Execute p f # s)\ \ Proc p \ tainted (Execute p f # s)" +| t_cfile: "\Proc p \ tainted s; valid (CreateFile p f # s)\ \ File f \ tainted (CreateFile p f # s)" +| t_cipc: "\Proc p \ tainted s; valid (CreateIPC p i # s)\ \ IPC i \ tainted (CreateIPC p i # s)" +| t_read: "\File f \ tainted s; valid (ReadFile p f # s)\ \ Proc p \ tainted (ReadFile p f # s)" +| t_write: "\Proc p \ tainted s; valid (WriteFile p f # s)\ \ File f \ tainted (WriteFile p f # s)" +| t_send: "\Proc p \ tainted s; valid (Send p i # s)\ \ IPC i \ tainted (Send p i # s)" +| t_recv: "\IPC i \ tainted s; valid (Recv p i # s)\ \ Proc p \ tainted (Recv p i # s)" +| t_remain:"\obj \ tainted s; valid (e # s); exists (e # s) obj\ \ obj \ tainted (e # s)" + +definition taintable:: "t_object \ bool" +where + "taintable obj \ \ s. obj \ tainted s" + +fun deleted :: "t_object \ t_event list \ bool" +where + "deleted obj [] = False" +| "deleted obj (Kill p p' # \) = ((obj = Proc p') \ deleted obj \)" +| "deleted obj (DeleteFile p f # \) = ((obj = File f) \ deleted obj \)" +| "deleted obj (DeleteIPC p i # \) = ((obj = IPC i) \ deleted obj \)" +| "deleted obj (_ # \) = deleted obj \" + +definition undeletable :: "t_object \ bool" +where + "undeletable obj \ exists [] obj \ \ (\ s. valid s \ deleted obj s)" + +fun no_del_event:: "t_event list \ bool" +where + "no_del_event [] = True" +| "no_del_event (Kill p p' # \) = False" +| "no_del_event (DeleteFile p f # \) = False" +| "no_del_event (DeleteIPC p i # \) = False" +| "no_del_event (_ # \) = no_del_event \" + +end + + +(***** locale for statical world *****) + +type_synonym t_sprocess = "t_normal_role \ t_role \ t_normal_proc_type \ t_user" + +type_synonym t_sfile = "t_normal_file_type \ t_file" + +type_synonym t_sipc = "t_normal_ipc_type" + +datatype t_sobject = + SProc "t_sprocess" "t_process option" +| SFile "t_sfile" "t_file option" +| SIPC "t_sipc" "t_ipc option" +| Unknown + +locale tainting_s_complete = tainting + +begin + +definition chown_role_aux:: "t_normal_role \ t_role \ t_user \ t_normal_role option" +where + "chown_role_aux cr fr u \ ( + case fr of + NormalRole r \ Some r + | InheritProcessRole \ Some cr + | _ \ defrole u )" + +definition chown_type_aux:: "t_normal_role \ t_normal_role \ t_normal_proc_type \ t_normal_proc_type" +where + "chown_type_aux cr nr t \ ( + case (default_process_chown_type cr) of + InheritParent_proc_type \ t + | UseNewRoleType \ (case (default_process_create_type nr) of + InheritParent_proc_type \ t + | NormalProc_type tp \ tp) + | NormalProc_type tp \ tp )" + +definition exec_type_aux :: "t_normal_role \ t_normal_proc_type \ t_normal_proc_type" +where + "exec_type_aux cr t \ (case (default_process_execute_type cr) of + InheritParent_proc_type \ t + | NormalProc_type tp \tp)" + +definition exec_role_aux :: "t_normal_role \ t_file \ t_user \ t_normal_role option" +where + "exec_role_aux cr sd u \ ( + case (erole_functor init_file_initialrole UseForcedRole sd) of + Some ir \ (case ir of + NormalRole r \ Some r + | UseForcedRole \ ( + case (erole_functor init_file_forcedrole InheritUpMixed sd) of + Some fr \ (case fr of + NormalRole r \ Some r + | InheritUserRole \ defrole u + | _ \ Some cr ) + | None \ None ) + | _ \ None ) + | _ \ None )" + +definition clone_type_aux :: "t_normal_role \ t_normal_proc_type \ t_normal_proc_type" +where + "clone_type_aux r t \ (case (default_process_create_type r) of + InheritParent_proc_type \ t + | NormalProc_type tp \ tp)" + +(* all the static objects that dynamic objects referring to *) +(* they should all be in a finite set ? *) +(* besides, they're no clone case for all_sobjs, we have no "SProc ... None" case, Clone p p', p' statically viewed as p too, so the many2many mapping becomes to many2one, which makes all succeeded*) +inductive_set all_sobjs :: "t_sobject set" +where + af_init: "\f \ init_files; etype_aux init_file_type_aux f = Some t\ \ SFile (t, f) (Some f) \ all_sobjs" +| af_cfd: "\SFile (t, sd) sf \ all_sobjs; SProc (r, fr, pt, u) sp \ all_sobjs; default_fd_create_type r = NormalFile_type t'; (r, File_type t, WRITE) \ compatible; (r, File_type t', CREATE) \ compatible\ \ SFile (t', sd) None \ all_sobjs" +| af_cfd': "\SFile (t, sd) sf \ all_sobjs; SProc (r, fr, pt, u) sp \ all_sobjs; default_fd_create_type r = InheritParent_file_type; (r, File_type t, WRITE) \ compatible\ \ SFile (t, sd) None \ all_sobjs" + +| ai_init: "init_ipc_type i = Some t \ SIPC t (Some i) \ all_sobjs" +| ai_cipc: "\SProc (r, fr, pt, u) sp \ all_sobjs; (r, IPC_type (default_ipc_create_type r), CREATE) \ compatible\ \ SIPC (default_ipc_create_type r) None \ all_sobjs" + +| ap_init: "\init_currentrole p = Some r; init_proc_forcedrole p = Some fr; init_process_type p = Some t; init_owner p = Some u\ \ SProc (r, fr, t, u) (Some p) \ all_sobjs" +| ap_crole: "\SProc (r, fr, t, u) sp \ all_sobjs; r' \ comproles r\ \ SProc (r', fr, t, u) sp \ all_sobjs" +| ap_chown: "\SProc (r, fr, t, u') sp \ all_sobjs; u \ init_users; chown_role_aux r fr u = Some nr; (r, Proc_type t, CHANGE_OWNER) \ compatible\ \ SProc (nr, fr, chown_type_aux r nr t, u) sp \ all_sobjs" +| ap_exec: "\SProc (r, fr, pt, u) sp \ all_sobjs; SFile (t, sd) sf \ all_sobjs; (r, File_type t, EXECUTE) \ compatible; exec_role_aux r sd u = Some r'; erole_functor init_file_forcedrole InheritUpMixed sd = Some fr'\ \ SProc (r', fr', exec_type_aux r pt, u) sp \ all_sobjs" +| ap_clone: "SProc (r, fr, pt, u) sp \ all_sobjs \ SProc (r, fr, clone_type_aux r pt, u) sp \ all_sobjs" + +fun init_obj2sobj :: "t_object \ t_sobject" +where + "init_obj2sobj (File f) = ( + case (etype_aux init_file_type_aux f) of + Some t \ SFile (t, f) (Some f) + | _ \ Unknown )" +| "init_obj2sobj (Proc p) = ( + case (init_currentrole p, init_proc_forcedrole p, init_process_type p, init_owner p) of + (Some r, Some fr, Some t, Some u) \ SProc (r, fr, t, u) (Some p) + | _ \ Unknown )" +| "init_obj2sobj (IPC i) = ( + case (init_ipc_type i) of + Some t \ SIPC t (Some i) + | _ \ Unknown )" + +inductive_set tainted_s :: "t_sobject set" +where + ts_init: "obj \ seeds \ init_obj2sobj obj \ tainted_s" +| ts_exec1: "\SFile (t, sd) sf \ tainted_s; SProc (r, fr, pt, u) sp \ all_sobjs; (r, File_type t, EXECUTE) \ compatible; exec_role_aux r sd u = Some r'; erole_functor init_file_forcedrole InheritUpMixed sd = Some fr'\ \ SProc (r', fr', exec_type_aux r pt, u) sp \ tainted_s" +| ts_exec2: "\SProc (r, fr, pt, u) sp \ tainted_s; SFile (t, sd) sf \ all_sobjs; (r, File_type t, EXECUTE) \ compatible; exec_role_aux r sd u = Some r'; erole_functor init_file_forcedrole InheritUpMixed sd = Some fr'\ \ SProc (r', fr', exec_type_aux r pt, u) sp \ tainted_s" +| ts_cfd: "\SProc (r, fr, pt, u) sp \ tainted_s; SFile (t, sd) sf \ all_sobjs; default_fd_create_type r = NormalFile_type t'; (r, File_type t, WRITE) \ compatible; (r, File_type t', CREATE) \ compatible\ \ SFile (t', sd) None \ tainted_s" +| ts_cfd': "\SProc (r, fr, pt, u) sp \ tainted_s; SFile (t, sd) sf \ all_sobjs; default_fd_create_type r = InheritParent_file_type; (r, File_type t, WRITE) \ compatible\ \ SFile (t, sd) None \ tainted_s" +| ts_cipc: "\SProc (r, fr, pt, u) sp \ tainted_s; (r, IPC_type (default_ipc_create_type r), CREATE) \ compatible\ \ SIPC (default_ipc_create_type r) None \ tainted_s" +| ts_read: "\SFile (t, sd) sf \ tainted_s; SProc (r, fr, pt, u) sp \ all_sobjs; (r, File_type t, READ) \ compatible\ \ SProc (r, fr, pt, u) sp \ tainted_s" +| ts_write: "\SProc (r, fr, pt, u) sp \ tainted_s; SFile (t, sd) sf \ all_sobjs; (r, File_type t, WRITE) \ compatible\ \ SFile (t, sd) sf \ tainted_s" +| ts_recv: "\SIPC t si \ tainted_s; SProc (r, fr, pt, u) sp \ all_sobjs; (r, IPC_type t, RECEIVE) \ compatible\ \ SProc (r, fr, pt, u) sp \ tainted_s" +| ts_send: "\SProc (r, fr, pt, u) sp \ tainted_s; SIPC t si \ all_sobjs; (r, IPC_type t, SEND) \ compatible\ \ SIPC t si \ tainted_s" +| ts_crole: "\SProc (r, fr, pt, u) sp \ tainted_s; r' \ comproles r\ \ SProc (r', fr, pt, u) sp \ tainted_s" +| ts_chown: "\SProc (r, fr, t, u') sp \ tainted_s; u \ init_users; chown_role_aux r fr u = Some nr; (r, Proc_type t, CHANGE_OWNER) \ compatible\ \ SProc (nr, fr, chown_type_aux r nr t, u) sp \ tainted_s" +| ts_clone: "\SProc (r, fr, pt, u) sp \ tainted_s; (r, Proc_type pt, CREATE) \ compatible\ \ SProc (r, fr, clone_type_aux r pt, u) sp \ tainted_s" + +(*** mapping function from dynamic 2 statical ****) + +fun source_dir:: "t_state \ t_file \ t_file option" +where + "source_dir s [] = (if ([] \ init_files \ \ (deleted (File []) s)) + then Some [] + else None + )" + | "source_dir s (f#pf) = (if ((f#pf) \ init_files \ \ (deleted (File (f#pf)) s)) + then Some (f#pf) + else source_dir s pf + )" + +(* cf2sfile's properities should all be under condition: f is not deleted in \*) +fun cf2sfile:: "t_state \ t_file \ t_sfile option" +where + "cf2sfile s f = (case (etype_of_file s f, source_dir s f) of + (Some t, Some sd) \ Some (t, sd) + | _ \ None)" + +fun cp2sproc:: "t_state \ t_process \ t_sprocess option" +where + "cp2sproc s p = (case (currentrole s p, proc_forcedrole s p, type_of_process s p, owner s p) of + (Some r, Some fr, Some t, Some u) \ Some (r, fr, t, u) + | _ \ None)" + +fun ci2sipc:: "t_state \ t_ipc \ t_sipc option" +where + "ci2sipc s i = (type_of_ipc s i)" + +(*** in statical view, clone event is process to try different runs(different sprocess:role/type...), +so statically these sprocesses should have the same source: the process in the initial state *********) +fun source_proc :: "t_state \ t_process \ t_process option" +where + "source_proc [] p = (if (p \ init_processes) then Some p else None)" +| "source_proc (Clone p p' # s) p'' = (if (p'' = p') then source_proc s p else source_proc s p'')" +| "source_proc (e # s) p = source_proc s p" + +fun obj2sobj :: "t_state \ t_object \ t_sobject" +where + "obj2sobj s (File f) = ( + case (cf2sfile s f) of + Some sf \ (if (f \ init_files \ (\ deleted (File f) s)) + then SFile sf (Some f) + else SFile sf None) + | _ \ Unknown )" +| "obj2sobj s (Proc p) = ( + case (cp2sproc s p) of + Some sp \ SProc sp (source_proc s p) + | _ \ Unknown )" +| "obj2sobj s (IPC i) = ( + case (ci2sipc s i) of + Some si \ (if (i \ init_ipcs \ (\ deleted (IPC i) s)) + then SIPC si (Some i) + else SIPC si None) + | _ \ Unknown )" + +fun role_of_sproc :: "t_sprocess \ t_normal_role" +where + "role_of_sproc (r, fr, pt, u) = r" + +fun source_of_sobj :: "t_sobject \ t_object option" +where + "source_of_sobj (SFile sf tag) = (case tag of + Some f \ Some (File f) + | _ \ None)" +| "source_of_sobj (SProc sp tag) = (case tag of + Some p \ Some (Proc p) + | _ \ None)" +| "source_of_sobj (SIPC si tag) = (case tag of + Some i \ Some (IPC i) + | _ \ None)" +| "source_of_sobj Unknown = None" + +definition taintable_s :: "t_object \ bool" +where + "taintable_s obj \ \sobj. sobj \ tainted_s \ source_of_sobj sobj = Some obj" + +(* +definition file_deletable_s:: "t_file \ bool" +where + "file_deletable_s f \ \ t sd srf. (SFile (t,sd) srf \ all_sobjs \ f \ sd \ (\ sp srp. SProc sp srp \ all_sobjs \ (role_of_sproc sp, File_type t, DELETE) \ compatible))" +*) +(* +definition file_deletable_s:: "t_file \ bool" +where + "file_deletable_s sd \ \ f. (f \ init_files \ sd \ f \ (\ t sp srp. SProc sp srp \ all_sobjs \ etype_of_file [] f = Some t \ (role_of_sproc sp, File_type t, DELETE) \ compatible))"*) + +definition file_deletable_s:: "t_file \ bool" +where + "file_deletable_s f \ \ t sp srp. SProc sp srp \ all_sobjs \ etype_of_file [] f = Some t \ (role_of_sproc sp, File_type t, DELETE) \ compatible" + +definition proc_deletable_s:: "t_process \ bool" +where + "proc_deletable_s p \ \ r fr pt u sp' srp'. SProc (r,fr,pt,u) (Some p) \ all_sobjs \ SProc sp' srp' \ all_sobjs \ (role_of_sproc sp', Proc_type pt, DELETE) \ compatible" + +definition ipc_deletable_s:: "t_ipc \ bool" +where + "ipc_deletable_s i \ \ t sp srp. SProc sp srp \ all_sobjs \ type_of_ipc [] i = Some t \ (role_of_sproc sp, IPC_type t, DELETE) \ compatible" + +fun deletable_s :: "t_object \ bool" +where + "deletable_s (Proc p) = (p \ init_processes \ proc_deletable_s p)" +| "deletable_s (File f) = (f \ init_files \ file_deletable_s f)" +| "deletable_s (IPC i) = (i \ init_ipcs \ ipc_deletable_s i)" + +definition undeletable_s:: "t_object \ bool" +where + "undeletable_s obj \ exists [] obj \ \ deletable_s obj" + +end + +locale tainting_s_sound = tainting_s_complete + + +assumes + clone_type_unchange: "\ r. default_process_create_type r = InheritParent_proc_type" +(* this is for statically clone do not change anything ! ! so that, there're no rule for +clone in all_sobjs and tainted_s *) +and clone_no_limit: "\ r t. (r, Proc_type t, CREATE) \ compatible" + +begin + +(* the all_sobjs': the soundness view of all_sobjs, just remove the clone case, cause +in this locale, clone doesn't change any information of such a sprocess*) +inductive_set all_sobjs' :: "t_sobject set" +where + af'_init: "\f \ init_files; etype_aux init_file_type_aux f = Some t\ \ SFile (t, f) (Some f) \ all_sobjs'" +| af'_cfd: "\SFile (t, sd) sf \ all_sobjs'; SProc (r, fr, pt, u) sp \ all_sobjs'; default_fd_create_type r = NormalFile_type t'; (r, File_type t, WRITE) \ compatible; (r, File_type t', CREATE) \ compatible\ \ SFile (t', sd) None \ all_sobjs'" +| af'_cfd': "\SFile (t, sd) sf \ all_sobjs'; SProc (r, fr, pt, u) sp \ all_sobjs'; default_fd_create_type r = InheritParent_file_type; (r, File_type t, WRITE) \ compatible\ \ SFile (t, sd) None \ all_sobjs'" + +| ai'_init: "init_ipc_type i = Some t \ SIPC t (Some i) \ all_sobjs'" +| ai'_cipc: "\SProc (r, fr, pt, u) sp \ all_sobjs'; (r, IPC_type (default_ipc_create_type r), CREATE) \ compatible\ \ SIPC (default_ipc_create_type r) None \ all_sobjs'" + +| ap'_init: "\init_currentrole p = Some r; init_proc_forcedrole p = Some fr; init_process_type p = Some t; init_owner p = Some u\ \ SProc (r, fr, t, u) (Some p) \ all_sobjs'" +| ap'_crole: "\SProc (r, fr, t, u) sp \ all_sobjs'; r' \ comproles r\ \ SProc (r', fr, t, u) sp \ all_sobjs'" +| ap'_chown: "\SProc (r, fr, t, u') sp \ all_sobjs'; u \ init_users; chown_role_aux r fr u = Some nr; (r, Proc_type t, CHANGE_OWNER) \ compatible\ \ SProc (nr, fr, chown_type_aux r nr t, u) sp \ all_sobjs'" +| ap'_exec: "\SProc (r, fr, pt, u) sp \ all_sobjs'; SFile (t, sd) sf \ all_sobjs'; (r, File_type t, EXECUTE) \ compatible; exec_role_aux r sd u = Some r'; erole_functor init_file_forcedrole InheritUpMixed sd = Some fr'\ \ SProc (r', fr', exec_type_aux r pt, u) sp \ all_sobjs'" + +(* the tainted_s': the soundness view of all_sobjs, just remove the clone case, cause +in this locale, clone doesn't change any information of such a sprocess*) +inductive_set tainted_s' :: "t_sobject set" +where + ts'_init: "obj \ seeds \ init_obj2sobj obj \ tainted_s'" +| ts'_exec1: "\SFile (t, sd) sf \ tainted_s'; SProc (r, fr, pt, u) sp \ all_sobjs'; (r, File_type t, EXECUTE) \ compatible; exec_role_aux r sd u = Some r'; erole_functor init_file_forcedrole InheritUpMixed sd = Some fr'\ \ SProc (r', fr', exec_type_aux r pt, u) sp \ tainted_s'" +| ts'_exec2: "\SProc (r, fr, pt, u) sp \ tainted_s'; SFile (t, sd) sf \ all_sobjs'; (r, File_type t, EXECUTE) \ compatible; exec_role_aux r sd u = Some r'; erole_functor init_file_forcedrole InheritUpMixed sd = Some fr'\ \ SProc (r', fr', exec_type_aux r pt, u) sp \ tainted_s'" +| ts'_cfd: "\SProc (r, fr, pt, u) sp \ tainted_s'; SFile (t, sd) sf \ all_sobjs'; default_fd_create_type r = NormalFile_type t'; (r, File_type t, WRITE) \ compatible; (r, File_type t', CREATE) \ compatible\ \ SFile (t', sd) None \ tainted_s'" +| ts'_cfd': "\SProc (r, fr, pt, u) sp \ tainted_s'; SFile (t, sd) sf \ all_sobjs'; default_fd_create_type r = InheritParent_file_type; (r, File_type t, WRITE) \ compatible\ \ SFile (t, sd) None \ tainted_s'" +| ts'_cipc: "\SProc (r, fr, pt, u) sp \ tainted_s'; (r, IPC_type (default_ipc_create_type r), CREATE) \ compatible\ \ SIPC (default_ipc_create_type r) None \ tainted_s'" +| ts'_read: "\SFile (t, sd) sf \ tainted_s'; SProc (r, fr, pt, u) sp \ all_sobjs'; (r, File_type t, READ) \ compatible\ \ SProc (r, fr, pt, u) sp \ tainted_s'" +| ts'_write: "\SProc (r, fr, pt, u) sp \ tainted_s'; SFile (t, sd) sf \ all_sobjs'; (r, File_type t, WRITE) \ compatible\ \ SFile (t, sd) sf \ tainted_s'" +| ts'_recv: "\SIPC t si \ tainted_s'; SProc (r, fr, pt, u) sp \ all_sobjs'; (r, IPC_type t, RECEIVE) \ compatible\ \ SProc (r, fr, pt, u) sp \ tainted_s'" +| ts'_send: "\SProc (r, fr, pt, u) sp \ tainted_s'; SIPC t si \ all_sobjs'; (r, IPC_type t, SEND) \ compatible\ \ SIPC t si \ tainted_s'" +| ts'_crole: "\SProc (r, fr, pt, u) sp \ tainted_s'; r' \ comproles r\ \ SProc (r', fr, pt, u) sp \ tainted_s'" +| ts'_chown: "\SProc (r, fr, t, u') sp \ tainted_s'; u \ init_users; chown_role_aux r fr u = Some nr; (r, Proc_type t, CHANGE_OWNER) \ compatible\ \ SProc (nr, fr, chown_type_aux r nr t, u) sp \ tainted_s'" + +fun sobj_source_eq_obj :: "t_sobject \ t_object \ bool" +where + "sobj_source_eq_obj (SFile sf None) (File f) = True" +| "sobj_source_eq_obj (SFile sf (Some f')) (File f) = (f' = f)" +| "sobj_source_eq_obj (SProc sp None) (Proc p) = True" +| "sobj_source_eq_obj (SProc sp (Some p')) (Proc p) = (p' = p)" +| "sobj_source_eq_obj (SIPC si None) (IPC i) = True" +| "sobj_source_eq_obj (SIPC si (Some i')) (IPC i) = (i' = i)" +| "sobj_source_eq_obj _ _ = False" + +fun not_both_sproc:: "t_sobject \ t_sobject \ bool" +where + "not_both_sproc (SProc sp srp) (SProc sp' srp') = False" +| "not_both_sproc _ _ = True" + +(*** definitions for init processes statical informations reservation ***) + +definition initp_intact :: "t_state => bool" +where + "initp_intact s \ \ p. p \ init_processes --> p \ current_procs s \ obj2sobj s (Proc p) = init_obj2sobj (Proc p)" + +definition initp_alter :: "t_state \ t_process \ bool" +where + "initp_alter s p \ \ p'. p' \ current_procs s \ obj2sobj s (Proc p') = init_obj2sobj (Proc p)" + +definition initp_intact_butp :: "t_state \ t_process \ bool" +where + "initp_intact_butp s proc \ (\ p. p \ init_processes \ p \ proc \ p \ current_procs s \ obj2sobj s (Proc p) = init_obj2sobj (Proc p)) \ initp_alter s proc" + +fun initp_intact_but :: "t_state \ t_sobject \ bool" +where + "initp_intact_but s (SProc sp (Some p)) = initp_intact_butp s p" +| "initp_intact_but s _ = initp_intact s" + +(*** how to generating new valid pathname for examples of CreateFile ***) + +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 +