DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦030d0bc34⟧ Ada Source

    Length: 30720 (0x7800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package Cmvc_Access_Control, pragma Module_Name 4 3727, pragma Subsystem Cmvc, seg_002742

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

E3 Source Code



package Cmvc_Access_Control is


    -- Control over access to objects in views and subsystems,
    -- and control over the execution of Cmvc and related commands
    -- when they reference specific views or subsystems.
    --
    -- "Access classes" define the kind of access that a group
    -- may have to the objects in a view or subsystem.
    --
    -- "Execution rights" determine the Cmvc and related commands
    -- that a group may execute within a view or subsystem.
    -- Each execution right requires some mimimum access to all
    -- referenced views and subsystems.


    ------------------------------------------------------------------------
    --                          Access Classes                            --
    ------------------------------------------------------------------------


    type Access_Class is (Reader, Client, Developer, Owner);

    -- The kind of access that groups may have to subsystems or views.
    -- The access class of a group determines the settings of the
    -- ACLs for the objects within the subsystem or view.
    -- A group may have only one kind of access at a given time.
    -- Higher access classes imply all the rights of lower access classes.


    procedure Add_Group (The_Group : String := "NETWORK_PUBLIC";
                         In_Class : Access_Class := Cmvc_Access_Control.Reader;
                         View_Or_Subsystem : String := "<SELECTION>";  
                         Add_Execution_Rights : Boolean := True;
                         Response : String := "<PROFILE>");

    -- Add the group to the list of groups that has access to the
    -- designated view or subsystem.  If the group is already on
    -- the list then change the access to the designated value.
    -- The ACLs for objects in the view or subsystem are
    -- adjusted appropriately.  If Add_Execution_Rights is set then
    -- the group is also granted all execution rights that are
    -- appropriate to the specified access class.  Whether or not
    -- Add_Execution_Rights is set, all inappropriate execution rights
    -- are removed when the access class for a group is changed.
    -- There is a limit of 7 groups that may have access to a subsystem
    -- or view at any one time.


    procedure Remove_Group (The_Group         : String := "<ALL>";
                            View_Or_Subsystem : String := "<SELECTION>";
                            Response          : String := "<PROFILE>");

    -- Clear the access for the group from the specified view or subsystem.
    -- If the group is <ALL> then access is restricted for all groups
    -- with current access.  All execution rights are also cleared.


    procedure Display (For_Group         : String  := "<ALL>";
                       View_Or_Subsystem : String  := "<CURSOR>";
                       Execution_Rights  : Boolean := False;
                       Response          : String  := "<PROFILE>");

    -- Display the current access control information for the specified
    -- group.  The symbol <ALL> specifies that all groups with access
    -- are to be displayed.  Execution rights are displayed if requested.


    function Has_Access (User_Or_Group : String := "<USER>";
                         In_Class : Access_Class := Cmvc_Access_Control.Reader;
                         View_Or_Subsystem : String := "<CURSOR>";
                         Group_Only : Boolean := False;
                         Response : String := "<WARN>") return Boolean;

    -- Determine if the user or group has the specified access to the
    -- view or subsystem.  If a user is named then all groups which
    -- include the user are checked for the access.  If a group is specified
    -- then the group is checked for the specified access.  If Group_Only
    -- is specified then, group access is checked even if there exists
    -- a user with the same name.  The special symbol <USER> denotes
    -- the current user.


    ------------------------------------------------------------------------
    --                          Execution Rights                          --
    ------------------------------------------------------------------------


    type Execution_Right is new Natural range 0 .. 127;

    -- Each command in Cmvc, Cmvc_Maintenance, or Cmvc_Hierarchy is
    -- composed of "primitive operations" that correspond to the part
    -- of the command that is applied to the different parameters.
    -- An execution right is the capability to execute a primitive
    -- operation on a view or a subsystem.  There is an execution right
    -- for each primitive operation.  When a command is executed
    -- the execution rights are checked for each primitive operation
    -- involved in the command.
    --
    -- For example, when Cmvc.Accept_Changes is executed to move
    -- changes from one view to another, the execution right
    -- "Accept_Changes_Source" is checked on the source view and
    -- the execution right "Accept_Changes_Destination" is checked on
    -- the destination view.
    --
    -- Below are listed the various execution rights.  The name of
    -- each execution right is formed from  the command it is primarily
    -- associated with, as the first part of the name, and the
    -- parameter (if more than one) as the second part of the name.


    -- All appropriate rights, depending on the context
    All_Rights : constant Execution_Right := 0;

    -- Cmvc operations for views.
    Check_Out                  : constant Execution_Right := 1;
    Check_In                   : constant Execution_Right := 2;
    Accept_Changes_Destination : constant Execution_Right := 3;
    Accept_Changes_Source      : constant Execution_Right := 4;
    Abandon_Reservation        : constant Execution_Right := 5;
    Revert                     : constant Execution_Right := 6;
    Modify_Notes               : constant Execution_Right := 7;  
    Make_Controlled            : constant Execution_Right := 8;
    Make_Uncontrolled          : constant Execution_Right := 9;
    Sever                      : constant Execution_Right := 10;
    Join_What                  : constant Execution_Right := 11;
    Join_To                    : constant Execution_Right := 12;  
    Merge_Changes_Destination  : constant Execution_Right := 13;
    Merge_Changes_Source       : constant Execution_Right := 14;  
    Release                    : constant Execution_Right := 15;
    Copy                       : constant Execution_Right := 16;
    Make_Path                  : constant Execution_Right := 17;
    Make_Subpath               : constant Execution_Right := 18;
    Make_Spec_View             : constant Execution_Right := 19;
    Import_From                : constant Execution_Right := 20;  
    Import_Into                : constant Execution_Right := 21;  
    Remove_Import              : constant Execution_Right := 22;
    Replace_Model              : constant Execution_Right := 23;
    Destroy_View               : constant Execution_Right := 24;
    Make_Code_View             : constant Execution_Right := 25;
    Query_View                 : constant Execution_Right := 26;

    -- Cmvc_Maintenance operations for views.
    Check_Consistency : constant Execution_Right := 27;

    -- Cmvc_Hierarchy operations for views
    Build_Activity_In   : constant Execution_Right := 28;
    Build_Activity_From : constant Execution_Right := 29;
    Expand_Activity     : constant Execution_Right := 30;

    -- Cmvc operations for subsystem.
    Initial           : constant Execution_Right := 31;  
    Destroy_Config    : constant Execution_Right := 32;  
    Destroy_Subsystem : constant Execution_Right := 33;
    Build             : constant Execution_Right := 34;
    Query_Subsystem   : constant Execution_Right := 35;
    Edit_Notes        : constant Execution_Right := 36;

    -- Cmvc_Maintenance operations for subsystems.
    Expunge_Database            : constant Execution_Right := 37;
    Subsystem_Check_Consistency : constant Execution_Right := 38;
    Update_Cdb                  : constant Execution_Right := 39;
    Make_Primary                : constant Execution_Right := 40;
    Make_Secondary              : constant Execution_Right := 41;
    Destroy_Cdb                 : constant Execution_Right := 42;

    -- Cmvc_Hierarchy operations for systems and subsystems
    Add_Child_Parent : constant Execution_Right := 43;  
    Add_Child_Child  : constant Execution_Right := 44;  
    Remove_Child     : constant Execution_Right := 45;


    procedure Add_Right (For_Group         : String := "NETWORK_PUBLIC";
                         The_Right         : Execution_Right :=
                            Cmvc_Access_Control.All_Rights;
                         View_Or_Subsystem : String := "<SELECTION>";
                         Response          : String := "<PROFILE>");

    -- Add the execution right for the group in the designated subsystem.
    -- An execution right can only be added if it is appropriate to
    -- the current access class for that group in the view or subsystem.
    -- If the right is All_Rights then all rights which appropriate to
    -- the group's access class are added.


    procedure Remove_Right (For_Group         : String := "<ALL>";
                            The_Right         : Execution_Right :=
                               Cmvc_Access_Control.All_Rights;
                            View_Or_Subsystem : String := "<SELECTION>";
                            Response          : String := "<PROFILE>");

    -- Remove the designated execution right.  If <ALL> is specified
    -- for the group then the execution right is removed for all
    -- groups with current rights.


    function Has_Right (User_Or_Group     : String := "<USER>";
                        The_Right         : Execution_Right :=
                           Cmvc_Access_Control.All_Rights;
                        View_Or_Subsystem : String := "<CURSOR>";
                        Group_Only        : Boolean := False;
                        Response          : String := "<WARN>") return Boolean;

    -- Determine if the user or group has the specifed execution right.
    -- If The_Right is All_Rights or if Group_Only is set then the
    -- name is interpreted as a group name.  Also, if The_Right is All_Rights
    -- then true is returned only if all rights appropriate to the current
    -- access class are set.


    ------------------------------------------------------------------------
    --                  Miscellaneous Operations                          --
    ------------------------------------------------------------------------


    procedure Check (View_Or_Subsystem      : String  := "<SELECTION>";
                     Repair_Inconsistencies : Boolean := False;
                     Response               : String  := "<PROFILE>");

    -- Check that the current access classes for the view or subsystem
    -- are compatible with ACLs on the objects in the views and/or subsystems.
    -- If the ACLs on subobjects are not compatible with the access classes
    -- and the current user has owner access to the view or subsystem and
    -- Repair_Inconsistencies is set then the ACLs on the subobjects
    -- will be reset.
    --
    -- Incompatible ACLs are either 1) ACL entries lacking access indicated
    -- by the access of the view or subsystem, or 2) ACL entries for groups
    -- without access to the view or subsystem.
    -- Repair_Inconsistencies will repair both types.  If Repair_Inconsistencies
    -- is false then an error occurs if groups having access to the
    -- view or subsystem are not correctly represented on an ACL lists.
    -- A warning is issued if groups not having access to the view
    -- or subsystem are found to be on the ACL of a subobject.
    --
    -- This procedure will also check that there are no entries for
    -- groups that have been deleted.  If there is such an entry and
    -- Repair_Inconsistencies is false then an error occurs.  If there
    -- is an entry for a delete group and Repair_Inconsistencies is true
    -- then the deleted entry will be removed from all ACL lists as
    -- specified.  This is the only way in which obsolete entries can
    -- be deleted from access control state.


    function Is_Consistent (View_Or_Subsystem : String := "<CURSOR>";
                            Response : String := "<WARN>") return Boolean;

    -- Perform same consistency check as procedure above, does not
    -- put out any warnings nor will it make any changes.  Will also return
    -- false if access control information does not exist or if the
    -- current user does not have sufficient access to determine if
    -- the information is consistent.


    procedure Initialize (View_Or_Subsystem : String := "<SELECTION>";
                          Response          : String := "<PROFILE>");

    -- Initialize the access control information for a view or subsystem.
    -- All groups that have owner access in the ACL of the view or
    -- subsystem world are put into the owner access class.  All groups
    -- that have read access in the ACL, but not owner access, are
    -- put into the reader access class.  All appropriate execution rights
    -- are set.
    --
    -- This operation is primarily useful for setting up access control
    -- in subsystems or views that were created by previous environment
    -- releases.  It can also be applied to views or subsystems with
    -- access control information in which case the view or subsystem
    -- is reset to its just initialized state with only owners and
    -- readers having access.
    --
    -- All commands in this package will fail (unless otherwise noted)
    -- if access control information is not initialized or if the current
    -- user does not have read access to the view or subsystem the
    -- command is being applied to.


    No_Access : exception;
    -- Raised by Get_Access and Get_Rights if the group has no access.


    function Get_Access (The_Group : String := "NETWORK_PUBLIC";
                         View_Or_Subsystem : String := "<CURSOR>";
                         Response : String := "<WARN>") return Access_Class;

    -- Return the access class of a group with access to the view or
    -- subsystem.  If the group has no access then No_Access is raised.


    type Group_Index is range 0 .. 6;
    -- Index of a group that has access to a view or subsystem.  Since,
    -- there can be at most 7 groups with access to a view or subsystem
    -- the groups are indexed from 0 to 6.


    function Group_Name (The_Index         : Group_Index := 0;
                         View_Or_Subsystem : String := "<CURSOR>";
                         Response          : String := "<WARN>") return String;

    -- Get the name of the group at the specified index.  If no group
    -- is at the index then returns "".  Note that if index N is empty
    -- then index N+1 is also empty.


    ------------------------------------------------------------------------
    --                       Execution Right Tables                       --
    ------------------------------------------------------------------------


    -- In many instances, especially in building additional tools, it will
    -- be useful to treat execution rights as a composite object.  An
    -- "execution table" is a table of all execution rights.  The execution
    -- rights for a particular group can set by providing a complete
    -- execution table.  Constant execution tables, corresponding to
    -- rights appropriate for various access classes, are also provided.


    type Execution_Table is array (Execution_Right) of Boolean;
    -- Table of all possible execution rights.


    Nil_Rights : constant Execution_Table := (others => False);
    -- Setting execution rights to this prevents execution of any commands.


    procedure Set_Rights (For_Group         : String := "NETWORK_PUBLIC";
                          The_Rights        : Execution_Table :=
                             Cmvc_Access_Control.Nil_Rights;
                          View_Or_Subsystem : String := "<SELECTION>";
                          Response          : String := "<PROFILE>");

    -- Set all the execution rights for the specified group in the view
    -- or subsystem.  Only rights appropriate to the groups access class
    -- are actually set.  Warnings are produced for inappropriate rights.


    function Get_Rights (For_Group : String := "NETWORK_PUBLIC";
                         View_Or_Subsystem : String := "<CURSOR>";
                         Response : String := "<WARN>") return Execution_Table;

    -- Return the execution rights for a group.  If the group does not
    -- have access to the view or subsystem then No_Access is raised.


    ------------------------------------------------------------------------
    --                  Constant Execution Right Tables                   --
    ------------------------------------------------------------------------


    -- Below are constants describing the execution rights that appropriate
    -- to various access classes.


    -- Rights for a view that only require READER access to the view
    View_Reader_Rights : constant Execution_Table :=
       Execution_Table'(Accept_Changes_Source => True,
                        Join_To               => True,
                        Merge_Changes_Source  => True,
                        Query_View            => True,
                        Expand_Activity       => True,
                        others                => False);

    -- Rights for a view that only require CLIENT access to the view
    View_Client_Rights : constant Execution_Table :=
       Execution_Table'
          (Import_From => True, Build_Activity_From => True, others => False)  
        or View_Reader_Rights;

    -- Rights for a view that only require DEVELOPER access to the view
    View_Developer_Rights : constant Execution_Table :=
       Execution_Table'(Check_Out                  => True,
                        Check_In                   => True,
                        Accept_Changes_Destination => True,
                        Abandon_Reservation        => True,
                        Revert                     => True,
                        Modify_Notes               => True,
                        Make_Controlled            => True,
                        Make_Uncontrolled          => True,
                        Sever                      => True,
                        Join_What                  => True,
                        Release                    => True,
                        Make_Path                  => True,
                        Make_Subpath               => True,
                        Make_Code_View             => True,
                        Copy                       => True,
                        Make_Spec_View             => True,
                        Merge_Changes_Destination  => True,
                        Build_Activity_In          => True,
                        others                     => False)  
        or View_Client_Rights;

    -- Rights for a view that require OWNER access to the view
    View_Owner_Rights : constant Execution_Table :=
       Execution_Table'(Import_Into       => True,
                        Remove_Import     => True,
                        Replace_Model     => True,
                        Destroy_View      => True,
                        Check_Consistency => True,
                        others            => False)  
        or View_Developer_Rights;

    -- Rights for a subsystem that only require READER access to the subsystem
    Subsystem_Reader_Rights : constant Execution_Table :=
       Execution_Table'(Query_Subsystem => True, others => False);

    -- Rights for a subsystem that only require CLIENT access to the subsystem
    Subsystem_Client_Rights : constant Execution_Table :=
       Execution_Table'(Add_Child_Child => True, others => False) or
          Subsystem_Reader_Rights;

    -- Rights for a subsystem that only require DEVELOPER access to the subsystem
    Subsystem_Developer_Rights : constant Execution_Table :=
       Execution_Table'(Edit_Notes       => True,
                        Add_Child_Parent => True,
                        Remove_Child     => True,
                        Update_Cdb       => True,
                        others           => False)  
        or Subsystem_Client_Rights;

    -- Rights for a subsystem that require OWNER access to the subsystem
    Subsystem_Owner_Rights : constant Execution_Table :=
       Execution_Table'(Initial                     => True,
                        Destroy_Config              => True,
                        Destroy_Subsystem           => True,
                        Build                       => True,
                        Subsystem_Check_Consistency => True,                       Expunge_Database            => True,
                        Make_Primary                => True,
                        Make_Secondary              => True,
                        Destroy_Cdb                 => True,
                        others                      => False)  
        or Subsystem_Developer_Rights;

    -- Rights for a view that only require READER access
    -- to the enclosing subsystem
    Subsystem_Reader_View_Rights : constant Execution_Table :=
       Execution_Table'(Import_From         => True,
                        Import_Into         => True,
                        Remove_Import       => True,
                        Replace_Model       => True,  
                        Query_View          => True,
                        Build_Activity_In   => True,
                        Build_Activity_From => True,
                        Expand_Activity     => True,
                        others              => False);

    -- Rights for a view that only require CLIENT access
    -- to the enclosing subsystem
    Subsystem_Client_View_Rights : constant Execution_Table :=
       Subsystem_Reader_View_Rights;

    -- Rights for a view that only require DEVELOPER access
    -- to the enclosing subsystem
    Subsystem_Developer_View_Rights : constant Execution_Table :=
       Execution_Table'(Check_Out                  => True,
                        Check_In                   => True,
                        Accept_Changes_Source      => True,
                        Accept_Changes_Destination => True,
                        Abandon_Reservation        => True,
                        Revert                     => True,
                        Modify_Notes               => True,
                        Make_Controlled            => True,
                        Make_Uncontrolled          => True,
                        Sever                      => True,
                        Join_What                  => True,
                        Join_To                    => True,
                        Merge_Changes_Destination  => True,
                        Merge_Changes_Source       => True,
                        others                     => False)  
        or Subsystem_Client_View_Rights;

    -- Rights for a view that require OWNER access
    -- to the enclosing subsystem
    Subsystem_Owner_View_Rights : constant Execution_Table :=
       Execution_Table'(Release           => True,
                        Copy              => True,
                        Make_Path         => True,
                        Make_Subpath      => True,
                        Make_Spec_View    => True,
                        Make_Code_View    => True,
                        Destroy_View      => True,
                        Check_Consistency => True,
                        others            => False)  
        or Subsystem_Developer_View_Rights;


    ------------------------------------------------------------------------

    pragma Subsystem (Cmvc);
    pragma Module_Name (4, 3727);
    pragma Bias_Key (12);

end Cmvc_Access_Control;

E3 Meta Data

    nblk1=1d
    nid=0
    hdr6=3a
        [0x00] rec0=1a rec1=00 rec2=01 rec3=020
        [0x01] rec0=12 rec1=00 rec2=02 rec3=00a
        [0x02] rec0=13 rec1=00 rec2=03 rec3=072
        [0x03] rec0=12 rec1=00 rec2=04 rec3=06c
        [0x04] rec0=15 rec1=00 rec2=05 rec3=078
        [0x05] rec0=15 rec1=00 rec2=06 rec3=016
        [0x06] rec0=01 rec1=00 rec2=1d rec3=046
        [0x07] rec0=0f rec1=00 rec2=07 rec3=052
        [0x08] rec0=05 rec1=00 rec2=1c rec3=032
        [0x09] rec0=14 rec1=00 rec2=08 rec3=06a
        [0x0a] rec0=02 rec1=00 rec2=1b rec3=01a
        [0x0b] rec0=15 rec1=00 rec2=09 rec3=02c
        [0x0c] rec0=00 rec1=00 rec2=1a rec3=02a
        [0x0d] rec0=13 rec1=00 rec2=0a rec3=052
        [0x0e] rec0=13 rec1=00 rec2=0b rec3=038
        [0x0f] rec0=11 rec1=00 rec2=0c rec3=00c
        [0x10] rec0=14 rec1=00 rec2=0d rec3=05c
        [0x11] rec0=16 rec1=00 rec2=0e rec3=068
        [0x12] rec0=17 rec1=00 rec2=0f rec3=050
        [0x13] rec0=16 rec1=00 rec2=10 rec3=03a
        [0x14] rec0=13 rec1=00 rec2=11 rec3=094
        [0x15] rec0=18 rec1=00 rec2=12 rec3=016
        [0x16] rec0=10 rec1=00 rec2=13 rec3=048
        [0x17] rec0=14 rec1=00 rec2=14 rec3=06e
        [0x18] rec0=14 rec1=00 rec2=15 rec3=002
        [0x19] rec0=12 rec1=00 rec2=16 rec3=06c
        [0x1a] rec0=14 rec1=00 rec2=17 rec3=034
        [0x1b] rec0=15 rec1=00 rec2=18 rec3=000
        [0x1c] rec0=08 rec1=00 rec2=19 rec3=000
    tail 0x20d001372800687a42812 0x42a00088462065003