225 lines
11 KiB
Standard ML
225 lines
11 KiB
Standard ML
(*****************************************************************************
|
|
* su4sml --- an SML repository for managing (Secure)UML/OCL models
|
|
* http://projects.brucker.ch/su4sml/
|
|
*
|
|
* component_uml.sml --- a design language implementing mds.sig for
|
|
* component-based systems
|
|
* This file is part of su4sml.
|
|
*
|
|
* Copyright (c) 2005-2007, ETH Zurich, Switzerland
|
|
*
|
|
* All rights reserved.
|
|
*
|
|
* Redistribution and use in source and binary forms, with or without
|
|
* modification, are permitted provided that the following conditions are
|
|
* met:
|
|
*
|
|
* * Redistributions of source code must retain the above copyright
|
|
* notice, this list of conditions and the following disclaimer.
|
|
*
|
|
* * Redistributions in binary form must reproduce the above
|
|
* copyright notice, this list of conditions and the following
|
|
* disclaimer in the documentation and/or other materials provided
|
|
* with the distribution.
|
|
*
|
|
* * Neither the name of the copyright holders nor the names of its
|
|
* contributors may be used to endorse or promote products derived
|
|
* from this software without specific prior written permission.
|
|
*
|
|
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
|
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
|
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
|
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
|
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
|
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
|
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
|
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
|
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
|
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
|
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
******************************************************************************)
|
|
(* $Id$ *)
|
|
|
|
(** 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
|
|
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 action_stereotypes = ["dialect.entityaction",
|
|
"dialect.entitymethodaction",
|
|
"dialect.entityattributeaction"]
|
|
|
|
val root_stereotypes = ["compuml.entity"]
|
|
|
|
(** The list of all attributes of an entity. *)
|
|
fun entity_contained_attributes (Entity c) = map EntityAttribute (Rep.attributes_of c)
|
|
| entity_contained_attributes _ = Logger.error "in entity_contained_attributes: \
|
|
\argument is not an entity"
|
|
|
|
(** the list of all methods of an entity *)
|
|
fun entity_contained_methods (Entity c) = map EntityMethod (Rep.operations_of c)
|
|
| entity_contained_methods _ = Logger.error "in entity_contained_methods: \
|
|
\argument is not an entity"
|
|
|
|
(** 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 _ = Logger.error "in entity_contained_read_methods: \
|
|
\argument is not an entity"
|
|
|
|
(** The list of all methods with side-effects of an entity *)
|
|
fun entity_contained_update_methods (Entity c) =
|
|
map EntityMethod (List.filter (not o #isQuery) (Rep.operations_of c))
|
|
| entity_contained_update_methods _ = Logger.error
|
|
"in entity_contained_update_methods: \
|
|
\argument is not an entity"
|
|
|
|
(** 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
|
|
|
|
|
|
(** 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))
|
|
| parse_entity_action root att_name s = Logger.error ("in parse_entity_action: \
|
|
\unknown action type "^s)
|
|
|
|
(** 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))))
|
|
handle Empty => Logger.error ("in parse_attribute_action: \
|
|
\did not find attribute "^name))
|
|
| parse_attribute_action root name "update" =
|
|
( SimpleAction ("update",
|
|
(EntityAttribute ((hd o List.filter (fn x => #name x = name))
|
|
(Rep.attributes_of root))))
|
|
handle Empty => Logger.error ("in parse_attribute_action: \
|
|
\did not find attribute "^name))
|
|
| parse_attribute_action root name "fullaccess" =
|
|
( CompositeAction ("fullaccess",
|
|
(EntityAttribute ((hd o List.filter (fn x => #name x = name))
|
|
(Rep.attributes_of root))))
|
|
handle Empty => Logger.error ("in parse_attribute_action: \
|
|
\did not find attribute "^name))
|
|
| parse_attribute_action root name s = Logger.error ("in parse_attribute_action: \
|
|
\unknown action type "^s^
|
|
"for attribute action "^name)
|
|
|
|
(** 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))))
|
|
handle Empty => Logger.error ("in parse_method_action: did not find method "^name))
|
|
| parse_method_action roor name s = Logger.error ("unknown action type "^s^
|
|
"for method action "^name)
|
|
|
|
(**
|
|
* 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 cls_path = case att_type of Rep_OclType.Classifier x => x
|
|
| _ => Logger.error "type of permission attribute \
|
|
\is not a classifier"
|
|
val action_name = hd (rev cls_path)
|
|
fun resource_path name = (hd o List.tl) (String.tokens (fn x => x= #".") name)
|
|
in case hd (#stereotypes att)
|
|
of "dialect.entityaction" =>
|
|
parse_entity_action root att_name action_name
|
|
| "dialect.entitymethodaction" =>
|
|
parse_method_action root (resource_path att_name) action_name
|
|
| "dialect.entityattributeaction" =>
|
|
parse_attribute_action root (resource_path att_name) action_name
|
|
| s => Logger.error ("in ComponentUML.parse_action: "^
|
|
"permission attribute "^att_name^"has unexpected stereotype "^s)
|
|
end
|
|
handle ex => (Logger.warn "in ComponentUML.parse_action: \
|
|
\could not parse permission attribute"; raise ex)
|
|
|
|
fun action_type_of (SimpleAction (t,_)) = t
|
|
| action_type_of (CompositeAction (t,_)) = t
|
|
|
|
(* val action_names = ["create","read","update","delete","full_access","execute"] *)
|
|
|
|
(** The actions possible on the given resource. *)
|
|
fun actions_of (e as (Entity c)) = [SimpleAction ("create", e),
|
|
CompositeAction ("read", e),
|
|
CompositeAction ("update", e),
|
|
SimpleAction ("delete", e),
|
|
CompositeAction ("full_access",e)]
|
|
| actions_of (m as (EntityMethod p)) = [SimpleAction ("execute", m)]
|
|
| actions_of (a as (EntityAttribute p)) = [SimpleAction ("read", a),
|
|
SimpleAction ("update", a),
|
|
CompositeAction ("full_access", a)]
|
|
|
|
(** The resource an action acts on. *)
|
|
fun resource_of (SimpleAction x) = #2 x
|
|
| resource_of (CompositeAction x) = #2 x
|
|
|
|
(** The list of actions a composite actions consists of. *)
|
|
fun subordinated_actions (SimpleAction _) = nil
|
|
| subordinated_actions (CompositeAction ("read", e as (Entity c))) =
|
|
let val read_attributes = List.map (fn x => SimpleAction ("read", x))
|
|
(entity_contained_attributes e)
|
|
val read_methods = List.map (fn x => SimpleAction ("execute",x))
|
|
(entity_contained_read_methods e)
|
|
in
|
|
List.concat [read_attributes,read_methods]
|
|
end
|
|
| subordinated_actions (CompositeAction ("full_access", e as (Entity c)))
|
|
= [SimpleAction ("create",e),
|
|
CompositeAction ("read", e),
|
|
CompositeAction ("update",e),
|
|
SimpleAction ("delete",e)]
|
|
| subordinated_actions (CompositeAction ("update", e as (Entity c))) =
|
|
let val update_attributes = List.map (fn x => SimpleAction ("update", x))
|
|
(entity_contained_attributes e)
|
|
val update_methods = List.map (fn x => SimpleAction ("execute",x))
|
|
(entity_contained_update_methods e)
|
|
in
|
|
List.concat [update_attributes,update_methods]
|
|
end
|
|
| subordinated_actions (CompositeAction ("full_access", a as (EntityAttribute ae)))
|
|
= [SimpleAction ("read", a),
|
|
SimpleAction ("update", a)]
|
|
| subordinated_actions (CompositeAction (s,_)) = Logger.error ("in subordinated_actions: \
|
|
\unsupported composite action \
|
|
\type "^s)
|
|
end
|