(***************************************************************************** * su4sml --- an SML repository for managing (Secure)UML/OCL models * http://projects.brucker.ch/su4sml/ * * secureuml_cartridge.sml --- A cartridge for Access Control features of SecureUML * transcribes a su4sml model according to a template * tree into code specific to a target language * cartridge * 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$ *) (** * A Cartridge that supports the basic SecureUML concepts: * Permissions, Roles, and Constraints. *) signature SECUREUML_CARTRIDGE = sig (** the particular secureuml dialect used *) structure Security:SECUREUML include BASE_CARTRIDGE where (*type Model = Rep.Classifier list * Security.Configuration*) type Model = Rep.Model * Security.Configuration val PermissionSet : environment -> Security.Permission list val curPermission : environment -> Security.Permission option val curRole : environment -> string option val curSubject : environment -> Security.Subject option val curSuperrole : environment -> string option val curConstraint : environment -> Rep_OclTerm.OclTerm option end (** * A Cartridge that supports the basic SecureUML concepts: * Permissions, Roles, and Constraints. *) functor SecureUML_Cartridge(structure SuperCart : BASE_CARTRIDGE; structure D: DESIGN_LANGUAGE) : SECUREUML_CARTRIDGE = struct structure Security = SecureUML(structure Design = D) (*type Model = Rep.Classifier list * Security.Configuration*) type Model = Rep.Model * Security.Configuration type environment = { model : Model, PermissionSet : Security.Permission list, curPermission : Security.Permission option, curSubject : Security.Subject option, curRole : string option, curSuperrole : string option, curConstraint : Rep_OclTerm.OclTerm option, extension : SuperCart.environment } fun PermissionSet (env : environment) = (#PermissionSet env) fun curPermission (env : environment) = (#curPermission env) fun curRole (env : environment) = (#curRole env) fun curSuperrole (env : environment) = (#curSuperrole env) fun curConstraint (env : environment) = (#curConstraint env) fun curSubject (env : environment) = (#curSubject env) fun curPermission' (env : environment) = Option.valOf (#curPermission env) fun curRole' (env : environment) = Option.valOf (#curRole env) fun curConstraint' (env : environment) = Option.valOf (#curConstraint env) fun security_conf (env: environment) = #2 (#model env) fun initEnv model = let val m = Security.parse model in { model = m, PermissionSet = (#permissions (#2 m)), curPermission = NONE, curSubject = NONE, curRole = NONE, curSuperrole = NONE, curConstraint = NONE, extension = SuperCart.initEnv (#1 m) } : environment end (* unpack : environment -> SuperCart.environment *) fun unpack (env : environment) = #extension env (* pack : environment -> SuperCart.environment -> environment *) fun pack (env: environment) (new_env : SuperCart.environment) = { model = #model env, PermissionSet = #PermissionSet env, curSubject = #curSubject env, curPermission = #curPermission env, curRole = #curRole env, curSuperrole = #curSuperrole env, curConstraint = #curConstraint env, extension = new_env} (* Helper functions that get the SuperCartridge's needed environment values *) fun getModel (env : environment) = #model env fun curClassifier (env : environment) = SuperCart.curClassifier (unpack env) fun curAttribute (env : environment) = SuperCart.curAttribute (unpack env) fun curOperation (env : environment) = SuperCart.curOperation (unpack env) fun curArgument (env : environment) = SuperCart.curArgument (unpack env) fun curAssociationEnd env = SuperCart.curAssociationEnd (unpack env) fun name_of_role r = r (********** ADDING/MODIFYING VARIABLE SUBSTITUTIONS *************************) (* lookup environment -> string -> string * might override some lookup entries of the base cartridge *) fun lookup env "permission_name" = #name (curPermission' env) | lookup env "role_name" = name_of_role (curRole' env) | lookup env "constraint" = Ocl2String.ocl2string false (curConstraint' env) | lookup env "subject_name" = (Security.subject_name_of o valOf o curSubject) env | lookup env "superrole_name" = (name_of_role o valOf o curSuperrole) env | lookup env s = SuperCart.lookup (unpack env) s handle Option => Logger.error "variable outside of context" (********** ADDING IF-CONDITION TYPE *****************************************) fun test env "first_permission" = (curPermission' env = hd (PermissionSet env)) | test env "first_role" = (curRole' env = hd (#roles (curPermission' env))) | test env "first_constraint" = (curConstraint' env = hd (#constraints (curPermission' env))) | test env "last_permission" = (curPermission' env = List.last (PermissionSet env)) | test env "last_role" = (curRole' env = List.last (#roles (curPermission' env))) | test env "last_constraint" = (curConstraint' env = List.last (#constraints (curPermission' env))) | test env s = SuperCart.test (unpack env) s (********** ADDING FOREACH TYPE **********************************************) (** iterates over roles, depending on the context. * in the context of a permission, iterate over all roles which have this permission. * in the context of a subject, iterate over all roles of that subject. * outside of these contextes, iterate over all roles. *) fun foreach_role (env:environment) = let val roles = case #curPermission env of SOME p => #roles p | NONE => case #curSubject env of SOME s => (Security.subject_roles_of s o #2 o #model) env | NONE => (Security.all_roles o #2 o #model) env fun env_from_list_item r ={ model = #model env, PermissionSet = #PermissionSet env, curPermission = #curPermission env, curSubject = #curSubject env, curRole = SOME r , curSuperrole = NONE, curConstraint = NONE, extension = #extension env } : environment in List.map env_from_list_item roles end (** iterate over all superroles in the context of a role *) fun foreach_superrole (env:environment) = let val cur = valOf (curRole env ) handle Option => Logger.error ("no current role") val superroles = List.mapPartial (fn (r,s) => if r=cur then SOME s else NONE) (#rh (security_conf env)) fun env_from_list_item s = { model = #model env, PermissionSet = #PermissionSet env, curPermission = #curPermission env, curSubject = #curSubject env, curRole = #curRole env, curSuperrole = SOME s, curConstraint = NONE, extension = #extension env } : environment in List.map env_from_list_item superroles end (* FIXME: in the context of a permission, return the constraints of this permission. * outside of such a context, return all constraints. *) fun foreach_constraint (env:environment) = let val cons = case #curPermission env of SOME p => #constraints p | NONE => Security.all_constraints (#2 (#model env)) fun env_from_list_item c ={ model = #model env, PermissionSet = #PermissionSet env, curPermission = #curPermission env, curSubject = NONE, curRole = #curRole env , curSuperrole = NONE, curConstraint = SOME c, extension = #extension env } : environment in List.map env_from_list_item cons end (* FIXME (when possible): in the context of a role, return the permissions of this role. * outside of such a context, return all permissions.*) fun foreach_permission env = let val perms = PermissionSet env fun env_from_list_item p ={ model = #model env, PermissionSet = #PermissionSet env, curPermission = SOME p, curSubject = NONE, curRole = NONE , curSuperrole = NONE, curConstraint = NONE , extension = #extension env } : environment in List.map env_from_list_item perms end fun foreach_subject (env:environment) = let val subjects = (Security.all_subjects o #2 o #model) env fun env_from_list_item s = { model = #model env, PermissionSet = #PermissionSet env, curPermission = NONE, curSubject = SOME s, curSuperrole = NONE, curRole = NONE, curConstraint = NONE, extension = #extension env } : environment in List.map env_from_list_item subjects end fun foreach "role_list" env = foreach_role env | foreach "superrole_list" env = foreach_superrole env | foreach "constraint_list" env = foreach_constraint env | foreach "permission_list" env = foreach_permission env | foreach "subject_list" env = foreach_subject env | foreach listType env = map (pack env) (SuperCart.foreach listType (unpack env)) end