git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@6107 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
parent
08d3897b87
commit
54b804076a
|
@ -99,6 +99,7 @@ fun test env "first_permission" =
|
||||||
fun foreach_permission env name =
|
fun foreach_permission env name =
|
||||||
let val action = Option.valOf (List.find (fn x => ComponentUML.action_type_of x = name)
|
let val action = Option.valOf (List.find (fn x => ComponentUML.action_type_of x = name)
|
||||||
(atomic_actions_from_context env))
|
(atomic_actions_from_context env))
|
||||||
|
handle Option => error ("error in finding action "^name)
|
||||||
val permissions = permissions_for_action env action
|
val permissions = permissions_for_action env action
|
||||||
fun env_from_list_item c = { curPermissionList = SOME permissions,
|
fun env_from_list_item c = { curPermissionList = SOME permissions,
|
||||||
curPermission = SOME c,
|
curPermission = SOME c,
|
||||||
|
@ -125,9 +126,6 @@ fun foreach_entity (env:environment) =
|
||||||
List.map env_from_list_item entities
|
List.map env_from_list_item entities
|
||||||
end*)
|
end*)
|
||||||
|
|
||||||
fun foreach_attribute _ = []
|
|
||||||
fun foreach_method _ = []
|
|
||||||
fun foreach_assocend _ = []
|
|
||||||
|
|
||||||
fun foreach "readPermission_list" env = foreach_permission env "read"
|
fun foreach "readPermission_list" env = foreach_permission env "read"
|
||||||
| foreach "updatePermission_list" env = foreach_permission env "update"
|
| foreach "updatePermission_list" env = foreach_permission env "update"
|
||||||
|
|
|
@ -114,7 +114,8 @@ fun write env (Tpl_Parser.RootNode(l)) = List.app (write env)
|
||||||
fun write_children e = List.app (fn tree => write e tree) children
|
fun write_children e = List.app (fn tree => write e tree) children
|
||||||
in
|
in
|
||||||
List.app (fn e => write_children e) list_of_environments
|
List.app (fn e => write_children e) list_of_environments
|
||||||
handle ex => (error_msg ("in GCG_Core.write: error in foreach node "^listType);
|
handle ex => (error_msg ("in GCG_Core.write: error in foreach node "^listType^
|
||||||
|
": "^General.exnMessage ex);
|
||||||
())
|
())
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -44,6 +44,7 @@ open ListEq
|
||||||
(*return the initial state*)
|
(*return the initial state*)
|
||||||
exception MalformedStateMachine
|
exception MalformedStateMachine
|
||||||
|
|
||||||
|
(* TODO: check which functions here are really used... *)
|
||||||
|
|
||||||
(************************************)
|
(************************************)
|
||||||
(* STATE handling functions: *)
|
(* STATE handling functions: *)
|
||||||
|
|
|
@ -53,6 +53,28 @@
|
||||||
(insert-authorization-constraint-assignment $classifier_package$ : $constraint_perm$ : auth$counter$ .) @nl
|
(insert-authorization-constraint-assignment $classifier_package$ : $constraint_perm$ : auth$counter$ .) @nl
|
||||||
@end
|
@end
|
||||||
|
|
||||||
|
@//TODO: also support composite actions (not supported in cartridge yet...
|
||||||
|
@foreach entity_list
|
||||||
|
@foreach createPermission_list
|
||||||
|
(insert-atomic-create $classifier_package$ : $permission_name$ : $entity_name$ .) @nl
|
||||||
|
@end
|
||||||
|
@foreach deletePermission_list
|
||||||
|
(insert-atomic-delete $classifier_package$ : $permission_name$ : $entity_name$ .) @nl
|
||||||
|
@end
|
||||||
|
@foreach attribute_list
|
||||||
|
@foreach readPermission_list
|
||||||
|
(insert-atomic-read $classifier_package$ : $permission_name$ : $entity_name$ : $attribute_name$ .) @nl
|
||||||
|
@end
|
||||||
|
@foreach updatePermission_list
|
||||||
|
(insert-atomic-update $classifier_package$ : $permission_name$ : $entity_name$ : $attribute_name$ .) @nl
|
||||||
|
@end
|
||||||
|
@end
|
||||||
|
@foreach operation_list
|
||||||
|
@foreach executePermission_list
|
||||||
|
(insert-atomic-execute $classifier_package$ : $permission_name$ : $entity_name$ : $operation_name$ .) @nl
|
||||||
|
@end
|
||||||
|
@end
|
||||||
|
@end
|
||||||
|
|
||||||
@// FIXME: insert-entity-update et al.
|
@// FIXME: insert-entity-update et al.
|
||||||
@// FIXME: (insert-entity-update $classifier_package$: $permission_name$ : $entity_name$ .)
|
@// FIXME: (insert-entity-update $classifier_package$: $permission_name$ : $entity_name$ .)
|
||||||
|
|
|
@ -149,11 +149,11 @@ fun filter_subject cs = List.filter (classifier_has_stereotype "secuml.user") cs
|
||||||
fun filter_role cs = List.filter (classifier_has_stereotype "secuml.role") cs
|
fun filter_role cs = List.filter (classifier_has_stereotype "secuml.role") cs
|
||||||
|
|
||||||
|
|
||||||
fun mkRole (C as Rep.Class c) = Rep.string_of_path (Rep.name_of C)
|
fun mkRole (C as Rep.Class c) = Rep.short_name_of C
|
||||||
| mkRole _ = error ("in mkRole: argument is not a class")
|
| mkRole _ = error ("in mkRole: argument is not a class")
|
||||||
|
|
||||||
(* FIXME: handle groups also *)
|
(* FIXME: handle groups also *)
|
||||||
fun mkSubject (C as Rep.Class c) = User (Rep.string_of_path (Rep.name_of C))
|
fun mkSubject (C as Rep.Class c) = User (Rep.short_name_of C)
|
||||||
| mkSubject _ = error ("in mkSubject: argument is not a class")
|
| mkSubject _ = error ("in mkSubject: argument is not a class")
|
||||||
|
|
||||||
fun mkPermission cs (c as Rep.Class _) =
|
fun mkPermission cs (c as Rep.Class _) =
|
||||||
|
|
Loading…
Reference in New Issue