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

started to parse SecureUML stereotypes 

git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@4485 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Jürgen Doser 2006-05-03 17:29:43 +00:00
parent dfb52793e3
commit fa80539581
9 changed files with 109 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/component_uml.sml
View File

@ -36,13 +36,21 @@ sig
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
@ -61,6 +69,8 @@ datatype Resource = Entity of Rep.Classifier
(* 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
@ -81,6 +91,12 @@ fun entity_contained_update_methods (Entity c) = nil
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))
fun actionType_of (SimpleAction (t,_)) = t
| actionType_of (CompositeAction (t,_)) = t

8
src/mds.sig
View File

@ -41,12 +41,20 @@ sig
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

1
src/rep.sml
View File

@ -29,6 +29,7 @@ include REP_CORE
include REP_ACTIVITY_GRAPH
type Model = Classifier list
end
structure Rep : REP =

11
src/rep_core.sml
View File

@ -49,6 +49,7 @@ type attribute = {
attr_type : Rep_OclType.OclType,
visibility : Visibility,
scope: Scope,
stereotypes: string list,
init : Rep_OclTerm.OclTerm option
}
@ -112,6 +113,7 @@ val update_thyname : string -> Classifier -> Classifier
val attributes_of : Classifier -> attribute list
val operations_of : Classifier -> operation list
val invariant_of : Classifier -> (string option * Rep_OclTerm.OclTerm) list
val stereotypes_of : Classifier -> string list
val string_of_path : string list -> string
val arguments_of_op : operation -> (string * Rep_OclType.OclType) list
@ -158,6 +160,7 @@ type attribute = {
attr_type : Rep_OclType.OclType,
visibility : Visibility,
scope: Scope,
stereotypes: string list,
init : Rep_OclTerm.OclTerm option
}
@ -220,6 +223,7 @@ fun assoc_to_attr (assoc:associationend) = {name = #name assoc,
attr_type = assoc_to_attr_type assoc,
visibility = #visibility assoc,
scope = XMI.InstanceScope,
stereotypes = nil,
init = #init assoc}
(* convert a multiplicity range into an invariant of the form *)
@ -326,6 +330,7 @@ fun rm_init_attr (attr:attribute) = {
attr_type = #attr_type attr,
visibility = #visibility attr,
scope = #scope attr,
stereotypes = #stereotypes attr,
init = NONE
}:attribute
@ -418,6 +423,12 @@ fun short_name_of (Class{name,...}) = (hd o rev) name
| short_name_of (Enumeration{name,...}) = (hd o rev) name
| short_name_of (Primitive{name,...}) = (hd o rev) name
fun stereotypes_of (Class{stereotypes,...}) = stereotypes
| stereotypes_of (Interface{stereotypes,...}) = stereotypes
| stereotypes_of (Enumeration{stereotypes,...}) = stereotypes
| stereotypes_of (Primitive{stereotypes,...}) = stereotypes
fun package_of (Class{name,...}) = if (length name) > 1

18
src/rep_state_machines.sml
View File

@ -28,22 +28,22 @@ sig
type StateVertex_Id
type Transition_Id
datatype Procedure = Proc_mk of {proc_id : string,
language : string,
body : string,
expression : string }
language : string,
body : string,
expression : string }
(* perhaps this type has to be changes according to what we can expect *)
(* from CASE tools *)
type Guard = Rep_OclTerm.OclTerm
type Parameter = string * Rep_OclType.OclType
type Parameter = string * Rep_OclType.OclType
datatype Event = SignalEvent of Parameter list
| CallEvent of Rep_OclType.Path * Parameter list
(* | TimeEvent of Parameter list *)
(* | ChangeEvent of Parameter list *)
| CallEvent of Rep_OclType.Path * Parameter list
(* | TimeEvent of Parameter list *)
(* | ChangeEvent of Parameter list *)
datatype Transition = T_mk of {trans_id: Transition_Id,

67
src/secure_uml.sml
View File

@ -99,32 +99,63 @@ fun filter_permission cs = List.filter (has_stereotype "Permission") cs
fun filter_subject cs = List.filter (has_stereotype "User") cs
fun filter_role cs = List.filter (has_stereotype "Role") cs
fun mkRole (Rep.Class c) = Rep.string_of_path (#name c)
(* FIXME: handle groups also *)
fun mkSubject (Rep.Class c) = User (Rep.string_of_path (#name c))
fun mkPermission (Rep.Class c) = {name=(Rep.string_of_path (#name c)),
(* FIXME: find attributes/aends with a type with stereotype "Role" *)
roles=nil,
(* 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= nil}
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)
(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 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)
end }
(* FIXME *)
fun mkPartialOrder xs = ListPair.zip (xs,xs)
fun parse (cs:Rep_Core.Classifier list) = (List.filter (has_no_stereotype ["Permission","Role","Subject"]) cs,
{config_type = "SecureUML",
permissions = map mkPermission (filter_permission cs),
subjects = map mkSubject (filter_subject cs),
roles = mkPartialOrder (map mkRole (filter_role cs)),
(* FIXME: find associations between Users and Roles. *)
sa = nil})
fun parse (cs:Rep_Core.Classifier list) =
(List.filter (has_no_stereotype ["Permission","Role","Subject"]) cs,
{ config_type = "SecureUML",
permissions = map (mkPermission cs) (filter_permission cs),
subjects = map mkSubject (filter_subject cs),
roles = mkPartialOrder (map mkRole (filter_role cs)),
(* FIXME: find associations between Users and Roles. *)
sa = nil})
end

3
src/xmi2rep.sml
View File

@ -187,7 +187,7 @@ fun transform_operation t {xmiid,name,isQuery,parameter,visibility,
fun transform_attribute t ({xmiid,name,type_id,changeability,visibility,ordering,
multiplicity,taggedValue,ownerScope,targetScope,initialValue}) =
multiplicity,taggedValue,ownerScope,targetScope,stereotype,initialValue}) =
let val cls_type = find_classifier_type t type_id
in
{name= name,
@ -197,6 +197,7 @@ fun transform_attribute t ({xmiid,name,type_id,changeability,visibility,ordering
else Rep_OclType.Set cls_type,
visibility = visibility,
scope = ownerScope,
stereotypes = map (find_stereotype t) stereotype,
init = Option.map (transform_expression t) initialValue
}
end

3
src/xmi_core.sml
View File

@ -99,7 +99,8 @@ type Attribute = { xmiid : string,
ownerScope : ScopeKind,
targetScope : ScopeKind,
visibility : VisibilityKind,
taggedValue : TaggedValue list
taggedValue : TaggedValue list,
stereotype : string list
}

19
src/xml2xmi.sml
View File

@ -35,8 +35,6 @@ exception NotYetImplemented
exception IllFormed of string
exception OCLIllFormed of string
fun getStringAtt string atts = valOf (XmlTree.attvalue_of string atts)
handle Option => raise IllFormed ("in getStringAtt: did not find attribute "^string)
@ -68,14 +66,14 @@ fun getMaybeEmptyName atts = Option.getOpt(XmlTree.attvalue_of "name" atts,"")
fun getVisibility atts =
let val att = XmlTree.attvalue_of "visibility" atts
in
case att of SOME "public" => XMI.public
| SOME "private" => XMI.private
| SOME "protected" => XMI.protected
| SOME "package" => XMI.package
| NONE => XMI.public
| SOME string => raise IllFormed ("in getVisibility: found unexpected attribute value "^string)
case att of SOME "public" => XMI.public
| SOME "private" => XMI.private
| SOME "protected" => XMI.protected
| SOME "package" => XMI.package
| NONE => XMI.public
| SOME string => raise IllFormed ("in getVisibility: found unexpected attribute value "^string)
end
fun getOrdering atts =
let val att = getStringAtt "ordering" atts
in
@ -569,6 +567,9 @@ fun mkAttribute tree =
handle _ => [(1,1)],
targetScope = getTargetScopeMaybe atts,
ownerScope = getOwnerScopeMaybe atts,
stereotype = (map (getXmiIdref o XmlTree.attributes_of)
(XmlTree.follow "UML:ModelElement.stereotype"
trees)),
taggedValue = (map mkTaggedValue
(XmlTree.follow "UML:ModelElement.taggedValue" trees)) }
in XmlTree.apply_on "UML:Attribute" f tree