HOL-OCL
/
su4sml
1
0
Fork 0
Code Issues Pull Requests Releases Activity

more work and cleanup 

git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@4495 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Jürgen Doser 2006-05-04 15:22:13 +00:00
parent fa80539581
commit bc2aea45c4
6 changed files with 129 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/codegen/componentuml_cartridge.sml
View File

@ -29,11 +29,11 @@ fun permissionsForAction env _ = nil
* FIX: move to ComponentUML cartridge...*)
fun computePermissionContext (env : environment)=
let
fun getAction "set" = ComponentUML.SimpleAction ("update", (ComponentUML.EntityAttribute (Option.valOf(curAttribute env))))
| getAction "get" = ComponentUML.SimpleAction ("read", (ComponentUML.EntityAttribute (Option.valOf(curAttribute env))))
| getAction "execute" = ComponentUML.SimpleAction ("execute", (ComponentUML.EntityMethod (Option.valOf(curOperation env))))
| getAction "create" = ComponentUML.SimpleAction ("create", (ComponentUML.Entity (Option.valOf(curClassifier env))))
| getAction "delete" = ComponentUML.SimpleAction ("delete", (ComponentUML.Entity (Option.valOf (curClassifier env))))
fun getAction "set" = ComponentUML.SimpleAction ("update", (ComponentUMLResource.EntityAttribute (Option.valOf(curAttribute env))))
| getAction "get" = ComponentUML.SimpleAction ("read", (ComponentUMLResource.EntityAttribute (Option.valOf(curAttribute env))))
| getAction "execute" = ComponentUML.SimpleAction ("execute", (ComponentUMLResource.EntityMethod (Option.valOf(curOperation env))))
| getAction "create" = ComponentUML.SimpleAction ("create", (ComponentUMLResource.Entity (Option.valOf(curClassifier env))))
| getAction "delete" = ComponentUML.SimpleAction ("delete", (ComponentUMLResource.Entity (Option.valOf (curClassifier env))))
| getAction s = Gcg_Helper.gcg_error ("invalid action_type \""^s^"\" in secureUML_cartridge.computePermissionContext:getAction.")
in
if Option.isSome(curAttribute env) then

38
src/codegen/secureuml_cartridge.sml
View File

@ -59,15 +59,10 @@ type environment = { model : Model,
curConstraint : Rep_OclTerm.OclTerm option,
extension : SuperCart.environment }
(* service functions for other cartridges to have access to the current
* list items
* FIX: check for NONE's
*)
fun curPermissionSet (env : environment) = (#curPermissionSet env)
fun curPermission (env : environment) = (#curPermission env)
fun curRole (env : environment) = (#curRole env)
fun curConstraint (env : environment) = (#curConstraint env)
fun curPermission (env : environment) = (#curPermission env)
fun curRole (env : environment) = (#curRole env)
fun curConstraint (env : environment) = (#curConstraint env)
fun curPermissionSet' (env : environment) = Option.valOf (#curPermissionSet env)
fun curPermission' (env : environment) = Option.valOf (#curPermission env)
@ -123,12 +118,18 @@ fun lookup (env : environment) "permission_name" = #name (curPermission' env)
| lookup (env : environment) s = SuperCart.lookup (unpack env) s
(********** ADDING IF-CONDITION TYPE *****************************************)
fun evalCondition (env : environment) "first_permission" = (curPermission' env = hd (curPermissionSet' env))
| evalCondition (env : environment) "first_role" = (curRole' env = hd (#roles (curPermission' env)))
| evalCondition (env : environment) "first_constraint" = (curConstraint' env = hd (#constraints (curPermission' env)))
| evalCondition (env : environment) "last_permission" = (curPermission' env = List.last (curPermissionSet' env))
| evalCondition (env : environment) "last_role" = (curRole' env = List.last (#roles (curPermission' env)))
| evalCondition (env : environment) "last_constraint" = (curConstraint' env = List.last (#constraints (curPermission' env)))
fun evalCondition (env : environment) "first_permission" =
(curPermission' env = hd (curPermissionSet' env))
| evalCondition (env : environment) "first_role" =
(curRole' env = hd (#roles (curPermission' env)))
| evalCondition (env : environment) "first_constraint" =
(curConstraint' env = hd (#constraints (curPermission' env)))
| evalCondition (env : environment) "last_permission" =
(curPermission' env = List.last (curPermissionSet' env))
| evalCondition (env : environment) "last_role" =
(curRole' env = List.last (#roles (curPermission' env)))
| evalCondition (env : environment) "last_constraint" =
(curConstraint' env = List.last (#constraints (curPermission' env)))
(* pass unknown condition types to Superior Cartridge *)
| evalCondition (env : environment) s = SuperCart.evalCondition (unpack env) s
@ -161,11 +162,10 @@ fun foreach_constraint (env : environment)
end
fun foreach "role_list" env = foreach_role env
| foreach "constraint_list" env = foreach_constraint env
(* pass unknown list types to superior cartridge by unpacking environments,
* having SuperCart compute environment list, pack into native environment again*)
| foreach listType env = map (pack env) (SuperCart.foreach listType (unpack env))
fun foreach "role_list" env = foreach_role env
| foreach "constraint_list" env = foreach_constraint env
| foreach listType env = map (pack env)
(SuperCart.foreach listType (unpack env))
end

137
src/component_uml.sml
View File

@ -24,78 +24,107 @@
* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
******************************************************************************)
signature COMPONENTUML =
sig
datatype Resource = Entity of Rep.Classifier
| EntityMethod of Rep.operation
| EntityAttribute of Rep.attribute
val contained_resources : Resource -> Resource list
datatype Action = SimpleAction of string * Resource
| CompositeAction of string * Resource
val action_stereotypes : string list
(* val action_names: string list *)
val subordinated_actions: Action -> Action list
val actions_of : Resource -> Action list
val resource_of: Action -> Resource
(**
* parse a permission attribute into an action.
* Takes the root resource, the attribute's stereotype,
* the attribute's name and the attribute's type as argument
*)
val parse_action: Rep.Classifier -> string -> string -> string -> Action
end
(** ComponentUML is a simple language for component-based modeling. *)
structure ComponentUML : COMPONENTUML =
struct
(** Auxiliary structure to specialize the resource type for ComponentUML. *)
structure ComponentUMLResource = struct
(** The type of resource, plus a path name specifiying the resource.
* Resource types can be entities, methods, and attributes.
* FIX: using Path for methods is unsafe, there can be severable
* methods with the same name, but different signature.
*)
datatype Resource = Entity of Rep.Classifier
| EntityMethod of Rep.operation
| EntityAttribute of Rep.attribute
datatype Resource = Entity of Rep.Classifier
| EntityMethod of Rep.operation
| EntityAttribute of Rep.attribute
end
(** The signature for ComponentUML. *)
signature COMPONENTUML = DESIGN_LANGUAGE where
type Resource = ComponentUMLResource.Resource
(** ComponentUML is a simple language for component-based modeling. *)
structure ComponentUML : COMPONENTUML =
struct
open ComponentUMLResource
(* val resource_types = ["Entity","EntityMethod","EntityAttribute"] *)
val action_stereotypes = ["EntityAction","EntityMethodAction","EntityAttributeAction"]
(** The resources that are contained in the given resource.
* does nothing sensible yet, but perhaps you get the idea...
* FIXME: do something sensible
*)
fun contained_resources (Entity (Rep.Class c)) = List.concat [map EntityMethod (#operations c),
map EntityAttribute (#attributes c)]
(** The list of all attributes of an entity.
*)
fun entity_contained_attributes (Entity c) = nil
(** The list of all side-effect free methods of an entity.
*)
fun entity_contained_read_methods (Entity c) = nil
(** The list of all attributes of an entity. *)
fun entity_contained_attributes (Entity c)
= map EntityAttribute (Rep.attributes_of c)
| entity_contained_attributes _ = nil
(** the list of all methods of an entity *)
fun entity_contained_methods (Entity c) = map EntityMethod (Rep.operations_of c)
| entity_contained_methods _ = nil
(** The list of all side-effect free methods of an entity. *)
fun entity_contained_read_methods (Entity c)
= map EntityMethod (List.filter #isQuery (Rep.operations_of c))
| entity_contained_read_methods _ = nil
(** The list of all methods with side-effects of an entity *)
fun entity_contained_update_methods (Entity c) = nil
fun entity_contained_update_methods (Entity c)
= map EntityMethod (List.filter (not o #isQuery) (Rep.operations_of c))
| entity_contained_update_methods _ = nil
(** The resources that are contained in the given resource. *)
fun contained_resources x =
List.concat [entity_contained_attributes x, entity_contained_methods x]
datatype Action = SimpleAction of string * Resource
| CompositeAction of string * Resource
(* FIX: also parse method and attribute actions. *)
fun parse_action root "EntityAction" name "read" = CompositeAction ("read", (Entity root))
| parse_action root "EntityAction" name "update" = CompositeAction ("update", (Entity root))
| parse_action root "EntityAction" name "create" = SimpleAction ("create", (Entity root))
| parse_action root "EntityAction" name "delete" = SimpleAction ("delete", (Entity root))
(** parses an entity action permission attribute. *)
fun parse_entity_action root att_name "create" =
SimpleAction ("create", (Entity root))
| parse_entity_action root att_name "read" =
CompositeAction ("read", (Entity root))
| parse_entity_action root att_name "update" =
CompositeAction ("update", (Entity root))
| parse_entity_action root att_name "delete" =
SimpleAction ("delete", (Entity root))
| parse_entity_action root att_name "fullaccess" =
CompositeAction ("fullaccess", (Entity root))
(** parses an entity attribute action permission attribute. *)
fun parse_attribute_action root name "read" =
SimpleAction ("read",
(EntityAttribute ((hd o List.filter (fn x => #name x = name))
(Rep.attributes_of root))))
| parse_attribute_action root name "update" =
SimpleAction ("update",
(EntityAttribute ((hd o List.filter (fn x => #name x = name))
(Rep.attributes_of root))))
| parse_attribute_action root name "fullaccess" =
CompositeAction ("fullaccess",
(EntityAttribute ((hd o List.filter (fn x => #name x = name))
(Rep.attributes_of root))))
(** parses an entity method action permission attribute. *)
fun parse_method_action root name "execute"
= SimpleAction ("execute",
(EntityMethod ((hd o List.filter (fn x => #name x = name))
(Rep.operations_of root))))
(**
* parses a permission attribute according to the ComponentUML
* dialect for SecureUML.
*)
fun parse_action root (att:Rep.attribute) =
let val att_name = #name att
val att_type = #attr_type att
val action_name = (hd o rev o (fn Rep_OclType.Classifier x => x)) att_type
in case hd (#stereotypes att)
of "EntityAction" => parse_entity_action root att_name action_name
| "EntityMethodAction" => parse_method_action root att_name action_name
| "EntityAttributeAction" => parse_attribute_action root att_name action_name
end
fun actionType_of (SimpleAction (t,_)) = t
| actionType_of (CompositeAction (t,_)) = t

5
src/mds.sig
View File

@ -51,10 +51,9 @@ sig
(**
* parse a permission attribute into an action.
* Takes the root resource, the attribute's stereotype,
* the attribute's name and the attribute's type as argument
* Takes the root resource, and the attribute as argument
*)
val parse_action: Rep.Classifier -> string -> string -> string -> Action
val parse_action: Rep.Classifier -> Rep.attribute -> Action
end

12
src/rep_ocl.sml
View File

@ -34,7 +34,8 @@ sig
| Classifier of Path | OclVoid | DummyT
val string_of_OclType : OclType -> string
val string_of_path : Path -> string
val is_Classifier : OclType -> bool
val is_Collection : OclType -> bool
end
@ -114,6 +115,15 @@ fun string_of_OclType Integer = "Integer"
| string_of_OclType (Classifier p) = (string_of_path p)
| string_of_OclType DummyT = "DummyT"
fun is_Classifier (Classifier p) = true
| is_Classifier _ = false
fun is_Collection (Set _) = true
| is_Collection (Sequence _) = true
| is_Collection (OrderedSet _) = true
| is_Collection (Bag _) = true
| is_Collection (Collection _) = true
| is_Collection _ = false
end

28
src/secure_uml.sml
View File

@ -109,39 +109,29 @@ fun classifier_has_stereotype s c = List.exists (fn x => x = s)
(Rep.stereotypes_of c)
fun mkPermission cs (Rep.Class c) =
{ name = (Rep.string_of_path (#name c)),
(* FIXME: find attributes/aends with a type with stereotype "Role" *)
roles = (map (Rep.string_of_path o Rep.name_of)
(List.filter (classifier_has_stereotype "Role")
(map (fn (Rep_OclType.Classifier p) => Rep.class_of p cs)
(List.filter (fn (Rep_OclType.Classifier p) => true
| _ => false)
(List.filter Rep_OclType.is_Classifier
(map #attr_type
(Rep.attributes_of (Rep.Class c))))))),
(* FIXME: find attached constraints *)
constraints = nil,
(* FIXME: root resource is attribute/aend withh stereotype "Entity" *)
(* resources are given by the name of the attributes *)
(* actiontypes are given by the type of the attributes *)
actions = let
val atts = Rep.attributes_of (Rep.Class c)
(* val attr_stereotypes = map (hd o #stereotypes) atts *)
val root_resource = hd (List.filter (classifier_has_stereotype "Entity")
(map (fn (Rep_OclType.Classifier p) => Rep.class_of p cs)
(List.filter (fn (Rep_OclType.Classifier p) => true
| _ => false)
(map #attr_type
atts))))
val root_resource =
hd (List.filter (classifier_has_stereotype "Entity")
(map (fn (Rep_OclType.Classifier p) =>
Rep.class_of p cs)
(List.filter Rep_OclType.is_Classifier
(map #attr_type
atts))))
val action_attributes =
List.filter (fn x => List.exists (fn y => y= hd (#stereotypes x))
Design.action_stereotypes) atts
val resource_names = map #name action_attributes
val action_names = map (hd o rev) (map (fn Rep_OclType.Classifier x => x) (map #attr_type action_attributes))
val stereos = map (hd o #stereotypes) action_attributes
fun zipWith3 f (x::xs,y::ys,z::zs) = (f (x, y, z))::(zipWith3 f (xs,ys,zs))
| zipWith3 f _ = nil
in
zipWith3 (fn (x, y, z) => Design.parse_action root_resource x y z)
(stereos, resource_names, action_names)
map (Design.parse_action root_resource) action_attributes
end }
(* FIXME *)