Implementation of the CORBA::Object::get_policy,

get_client_policy, set_policy_overrides, get_policy_overrides,
and get_domain_managers operations.

Patch submitted by Vadim Godunko, reviewed by Jerome Hugues.

[Imported from Perforce change 9172 at 2006-12-01 21:16:18]

Subversion-branch: /trunk/polyorb
Subversion-revision: 36690
This commit is contained in:
Jérôme Hugues
2005-03-03 17:46:32 +00:00
parent 0abfbd1f11
commit eedfb3ef7e
12 changed files with 542 additions and 25 deletions

View File

@@ -586,6 +586,8 @@ src/corba/corba-nvlist.adb
src/corba/corba-nvlist.ads
src/corba/corba-object-helper.adb
src/corba/corba-object-helper.ads
src/corba/corba-object-policies.adb
src/corba/corba-object-policies.ads
src/corba/corba-object.adb
src/corba/corba-object.ads
src/corba/corba-orb.adb

View File

@@ -15,6 +15,6 @@
//PolyORB:NI: in boolean constr_policy
//PolyORB:NI: );
//PolyORB:NI: };
//PolyORB:NI:
//PolyORB:NI: typedef sequence <DomainManager> DomainManagersList;
typedef sequence <DomainManager> DomainManagersList;

View File

@@ -12,6 +12,12 @@
typedef sequence <Policy> PolicyList;
typedef sequence <PolicyType> PolicyTypeSeq;
//PolyORB:WACORBA: InvalidPolicies defined in CORBA 3.0.3 specification
//but not defined in OMG IDL files
exception InvalidPolicies {
sequence <unsigned short> indices;
};
//PolyORB:WACORBA:
typedef short PolicyErrorCode;
exception PolicyError {PolicyErrorCode reason;};

View File

@@ -44,28 +44,28 @@
in Flags req_flag
);
//PolyORB:NI: Policy get_policy (
//PolyORB:NI: in PolicyType policy_type
//PolyORB:NI: );
//PolyORB:NI:
//PolyORB:NI: DomainManagersList get_domain_managers ();
//PolyORB:NI:
//PolyORB:NI: Object set_policy_overrides(
//PolyORB:NI: in PolicyList policies,
//PolyORB:NI: in SetOverrideType set_add
//PolyORB:NI: ) raises(InvalidPolicies);
//PolyORB:NI:
//PolyORB:NI: Policy get_client_policy(
//PolyORB:NI: in PolicyType type
//PolyORB:NI: );
//PolyORB:NI:
//PolyORB:NI: PolicyList get_policy_overrides(
//PolyORB:NI: in PolicyTypeSeq types
//PolyORB:NI: );
//PolyORB:NI:
Policy get_policy (
in PolicyType policy_type
);
DomainManagersList get_domain_managers ();
Object set_policy_overrides(
in PolicyList policies,
in SetOverrideType set_add
) raises(InvalidPolicies);
Policy get_client_policy(
in PolicyType type
);
PolicyList get_policy_overrides(
in PolicyTypeSeq types
);
//PolyORB:NI: boolean validate_connection(
//PolyORB:NI: out PolicyList inconsistent_policies
//PolyORB:NI: );
//PolyORB:NI:
//PolyORB:NI: Object get_component ();
};

View File

@@ -17,6 +17,7 @@ ADA_SPECS_WITH_BODY = \
corba-impl.ads \
corba-nvlist.ads \
corba-object-helper.ads \
corba-object-policies.ads \
corba-object.ads \
corba-orb.ads \
corba-policy-helper.ads \

View File

@@ -35,12 +35,20 @@ with PolyORB.Initialization;
with PolyORB.Utils.Strings;
with CORBA.Object.Helper;
with PolyORB.Sequences.Unbounded.CORBA_Helper;
package body CORBA.DomainManager.Helper is
package IDL_Sequence_CORBA_DomainManager_Helper is
new IDL_Sequence_CORBA_DomainManager.CORBA_Helper
(Element_To_Any => To_Any,
Element_From_Any => From_Any);
procedure Deferred_Initialization;
TC_DomainManager_Cache : TypeCode.Object;
TC_DomainManager_Cache : TypeCode.Object;
TC_IDL_Sequence_CORBA_DomainManager_Cache : TypeCode.Object;
TC_DomainManagersList_Cache : TypeCode.Object;
-----------------------------
-- Deferred_Initialization --
@@ -54,12 +62,39 @@ package body CORBA.DomainManager.Helper is
(TC_DomainManager_Cache, To_Any (To_CORBA_String ("DomainManager")));
TypeCode.Internals.Add_Parameter
(TC_DomainManager_Cache, To_Any (To_CORBA_String (Repository_Id)));
IDL_Sequence_CORBA_DomainManager_Helper.Initialize (TC_DomainManager);
TC_IDL_Sequence_CORBA_DomainManager_Cache :=
IDL_Sequence_CORBA_DomainManager_Helper.Sequence_TC;
TC_DomainManagersList_Cache :=
TypeCode.Internals.To_CORBA_Object (PolyORB.Any.TypeCode.TC_Alias);
TypeCode.Internals.Add_Parameter
(TC_DomainManagersList_Cache,
To_Any (To_CORBA_String ("DomainManagersList")));
TypeCode.Internals.Add_Parameter
(TC_DomainManagersList_Cache,
To_Any (To_CORBA_String ("IDL:CORBA_A/DomainManagersList:1.0")));
TypeCode.Internals.Add_Parameter
(TC_DomainManagersList_Cache,
To_Any (TC_IDL_Sequence_CORBA_DomainManager));
end Deferred_Initialization;
--------------
-- From_Any --
--------------
function From_Any (Item : in Any)
return IDL_Sequence_CORBA_DomainManager.Sequence
renames IDL_Sequence_CORBA_DomainManager_Helper.From_Any;
function From_Any (Item : in Any) return DomainManagersList is
Result : constant IDL_Sequence_CORBA_DomainManager.Sequence
:= From_Any (Item);
begin
return DomainManagersList (Result);
end From_Any;
function From_Any (Item : in Any) return Ref is
begin
return To_Ref (Object.Helper.From_Any (Item));
@@ -74,10 +109,40 @@ package body CORBA.DomainManager.Helper is
return TC_DomainManager_Cache;
end TC_DomainManager;
---------------------------
-- TC_DomainManagersList --
---------------------------
function TC_DomainManagersList return TypeCode.Object is
begin
return TC_DomainManagersList_Cache;
end TC_DomainManagersList;
-----------------------------------------
-- TC_IDL_Sequence_CORBA_DomainManager --
-----------------------------------------
function TC_IDL_Sequence_CORBA_DomainManager return TypeCode.Object is
begin
return TC_IDL_Sequence_CORBA_DomainManager_Cache;
end TC_IDL_Sequence_CORBA_DomainManager;
------------
-- To_Any --
------------
function To_Any (Item : in IDL_Sequence_CORBA_DomainManager.Sequence)
return Any
renames IDL_Sequence_CORBA_DomainManager_Helper.To_Any;
function To_Any (Item : in DomainManagersList) return Any is
Result : Any
:= To_Any (IDL_Sequence_CORBA_DomainManager.Sequence (Item));
begin
CORBA.Set_Type (Result, TC_DomainManagersList);
return Result;
end To_Any;
function To_Any (Item : in Ref) return Any is
Result : Any := Object.Helper.To_Any (Object.Ref (Item));
begin

View File

@@ -50,4 +50,21 @@ package CORBA.DomainManager.Helper is
function To_Any (Item : in Ref) return Any;
-- DomainManager sequence
function TC_IDL_Sequence_CORBA_DomainManager return TypeCode.Object;
function From_Any (Item : in Any)
return IDL_Sequence_CORBA_DomainManager.Sequence;
function To_Any
(Item : in IDL_Sequence_CORBA_DomainManager.Sequence)
return Any;
function TC_DomainManagersList return TypeCode.Object;
function From_Any (Item : in Any) return DomainManagersList;
function To_Any (Item : in DomainManagersList) return Any;
end CORBA.DomainManager.Helper;

View File

@@ -38,6 +38,7 @@
with CORBA.Object;
with CORBA.Policy;
with CORBA.Sequences.Unbounded;
package CORBA.DomainManager is
@@ -51,7 +52,16 @@ package CORBA.DomainManager is
function Is_A
(Self : in Ref;
Logical_Type_Id : in Standard.String)
return CORBA.Boolean;
return CORBA.Boolean;
-- Implementation note: this Sequence type should be defined in
-- package CORBA. Yet, this would create circular dependencies
-- between CORBA and CORBA.Sequences.
package IDL_Sequence_CORBA_DomainManager is
new CORBA.Sequences.Unbounded (Ref);
type DomainManagersList is new IDL_Sequence_CORBA_DomainManager.Sequence;
private

View File

@@ -0,0 +1,297 @@
------------------------------------------------------------------------------
-- --
-- POLYORB COMPONENTS --
-- --
-- C O R B A . O B J E C T . P O L I C I E S --
-- --
-- B o d y --
-- --
-- Copyright (C) 2005 Free Software Foundation, Inc. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 2, or (at your option) any later --
-- version. PolyORB is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
-- License for more details. You should have received a copy of the GNU --
-- General Public License distributed with PolyORB; see file COPYING. If --
-- not, write to the Free Software Foundation, 59 Temple Place - Suite 330, --
-- Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- PolyORB is maintained by AdaCore --
-- (email: sales@adacore.com) --
-- --
------------------------------------------------------------------------------
with PolyORB.Annotations;
with PolyORB.Any.NVList;
with PolyORB.ORB;
with PolyORB.Requests;
with PolyORB.Setup;
with PolyORB.Tasking.Threads.Annotations;
with CORBA.DomainManager.Helper;
with PolyORB.CORBA_P.Exceptions;
with PolyORB.CORBA_P.Interceptors_Hooks;
with PolyORB.CORBA_P.Local;
with PolyORB.CORBA_P.Policy_Management;
package body CORBA.Object.Policies is
use PolyORB.Annotations;
use PolyORB.CORBA_P.Policy_Management;
-----------------------
-- Get_Client_Policy --
-----------------------
function Get_Client_Policy
(Self : in Ref'Class;
The_Type : in PolicyType)
return CORBA.Policy.Ref
is
Npad : Notepad_Access;
Note : Policy_Manager_Note;
Result : CORBA.Policy.Ref;
begin
if Is_Nil (Self) then
Raise_Inv_Objref (CORBA.Default_Sys_Member);
end if;
if PolyORB.CORBA_P.Local.Is_Local (Self) then
Raise_No_Implement (No_Implement_Members'(Minor => 3,
Completed => Completed_No));
end if;
-- First, checking reference overrides
Npad :=
PolyORB.References.Notepad_Of (Internals.To_PolyORB_Ref (Ref (Self)));
Get_Note (Npad.all, Note, Empty_Policy_Manager_Note);
Result := Note.Overrides (The_Type);
if not CORBA.Policy.Is_Null (Result) then
return Result;
end if;
-- Second, checking thread overrides
Npad := PolyORB.Tasking.Threads.Annotations.Get_Current_Thread_Notepad;
Get_Note (Npad.all, Note, Empty_Policy_Manager_Note);
Result := Note.Overrides (The_Type);
if not CORBA.Policy.Is_Null (Result) then
return Result;
end if;
-- Third, checking ORB overrides
Npad := PolyORB.ORB.Notepad_Of (PolyORB.Setup.The_ORB);
Get_Note (Npad.all, Note, Empty_Policy_Manager_Note);
Result := Note.Overrides (The_Type);
if not CORBA.Policy.Is_Null (Result) then
return Result;
end if;
-- Last, try to find default value
return Policy_System_Default_Value (The_Type);
end Get_Client_Policy;
-------------------------
-- Get_Domain_Managers --
-------------------------
function Get_Domain_Managers
(Self : in Ref'Class)
return CORBA.DomainManager.DomainManagersList
is
Operation_Name : constant Standard.String := "get_domain_managers";
Request : PolyORB.Requests.Request_Access;
Arg_List : PolyORB.Any.NVList.Ref;
Result : PolyORB.Any.NamedValue;
Result_Name : CORBA.String := To_CORBA_String ("Result");
begin
if CORBA.Object.Is_Nil (Self) then
CORBA.Raise_Inv_Objref (Default_Sys_Member);
end if;
PolyORB.Any.NVList.Create (Arg_List);
Result :=
(Name => PolyORB.Types.Identifier (Result_Name),
Argument => CORBA.Internals.To_PolyORB_Any
(Get_Empty_Any
(CORBA.DomainManager.Helper.TC_IDL_Sequence_CORBA_DomainManager)),
Arg_Modes => 0);
PolyORB.Requests.Create_Request
(Target => Internals.To_PolyORB_Ref (Ref (Self)),
Operation => Operation_Name,
Arg_List => Arg_List,
Result => Result,
Req => Request);
PolyORB.CORBA_P.Interceptors_Hooks.Client_Invoke
(Request, PolyORB.Requests.Flags (0));
if not PolyORB.Any.Is_Empty (Request.Exception_Info) then
Result.Argument := Request.Exception_Info;
PolyORB.Requests.Destroy_Request (Request);
PolyORB.CORBA_P.Exceptions.Raise_From_Any (Result.Argument);
end if;
PolyORB.Requests.Destroy_Request (Request);
return CORBA.DomainManager.Helper.From_Any
(CORBA.Internals.To_CORBA_Any (Result.Argument));
end Get_Domain_Managers;
----------------
-- Get_Policy --
----------------
function Get_Policy
(Self : in Ref;
Policy_Type : in PolicyType)
return CORBA.Policy.Ref
is
Result : CORBA.Policy.Ref;
begin
Result := Get_Client_Policy (Self, Policy_Type);
if not Policy.Is_Nil (Result) then
-- XXX Client policy should be reconcilied with value
-- defined in IOR. Not supported for now.
return Result;
end if;
if not Is_Domain_Policy (Policy_Type) then
return Result;
end if;
-- Obtain domain list from Object
declare
use CORBA.DomainManager;
Managers : constant DomainManagersList := Get_Domain_Managers (Self);
begin
-- XXX For now we simply find the first domain manager which
-- hold information about the requested policy and return
-- policy value. This is not conformant with CORBA
-- specifications which require to resolve policy
-- overlapping conflicts but not define any way to do this
-- (CORBA 3.0.3 par. 4.10.1.4 Object Membership of Policy
-- Domains).
for J in 1 .. Length (Managers) loop
begin
Result :=
Get_Domain_Policy (Element_Of (Managers, J), Policy_Type);
if not Policy.Is_Nil (Result) then
return Result;
end if;
exception
when CORBA.Inv_Policy =>
null;
end;
end loop;
end;
Raise_Inv_Policy (Default_Sys_Member);
end Get_Policy;
--------------------------
-- Get_Policy_Overrides --
--------------------------
function Get_Policy_Overrides
(Self : in Ref'Class;
Types : in CORBA.Policy.PolicyTypeSeq)
return CORBA.Policy.PolicyList
is
Npad : Notepad_Access;
Note : Policy_Manager_Note;
begin
if Is_Nil (Self) then
Raise_Inv_Objref (CORBA.Default_Sys_Member);
end if;
if PolyORB.CORBA_P.Local.Is_Local (Self) then
Raise_No_Implement (No_Implement_Members'(Minor => 3,
Completed => Completed_No));
end if;
Npad :=
PolyORB.References.Notepad_Of (Internals.To_PolyORB_Ref (Ref (Self)));
Get_Note (Npad.all, Note, Empty_Policy_Manager_Note);
return Get_Policy_Overrides (Note.Overrides, Types);
end Get_Policy_Overrides;
--------------------------
-- Set_Policy_Overrides --
--------------------------
procedure Set_Policy_Overrides
(Self : in Ref'Class;
Policies : in CORBA.Policy.PolicyList;
Set_Add : in SetOverrideType)
is
Npad : Notepad_Access;
Note : Policy_Manager_Note;
Indexes : CORBA.Short;
begin
if Is_Nil (Self) then
Raise_Inv_Objref (CORBA.Default_Sys_Member);
end if;
if PolyORB.CORBA_P.Local.Is_Local (Self) then
Raise_No_Implement (No_Implement_Members'(Minor => 3,
Completed => Completed_No));
end if;
Npad :=
PolyORB.References.Notepad_Of (Internals.To_PolyORB_Ref (Ref (Self)));
if Set_Add = ADD_OVERRIDE then
Get_Note (Npad.all, Note, Empty_Policy_Manager_Note);
end if;
Add_Policy_Overrides (Note.Overrides, Policies, Reference_Level);
Check_Compatibility (Note.Overrides, Indexes);
if Indexes /= 0 then
raise Program_Error;
-- XXX should raise the CORBA.InvalidPolicies exception
end if;
Set_Note (Npad.all, Note);
end Set_Policy_Overrides;
-- procedure Validate_Connection
-- (Self : in Ref;
-- Inconsistent_Policies : out CORBA.Policy.PolicyList;
-- Result : out Boolean);
end CORBA.Object.Policies;

View File

@@ -0,0 +1,73 @@
------------------------------------------------------------------------------
-- --
-- POLYORB COMPONENTS --
-- --
-- C O R B A . O B J E C T . P O L I C I E S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2005 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the CORBA Specification, and adapted --
-- for use with PolyORB. The copyright notice above, and the license --
-- provisions that follow apply solely to the contents neither explicitely --
-- nor implicitely specified by the CORBA Specification defined by the OMG. --
-- --
-- PolyORB is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 2, or (at your option) any later --
-- version. PolyORB is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
-- License for more details. You should have received a copy of the GNU --
-- General Public License distributed with PolyORB; see file COPYING. If --
-- not, write to the Free Software Foundation, 59 Temple Place - Suite 330, --
-- Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- PolyORB is maintained by AdaCore --
-- (email: sales@adacore.com) --
-- --
------------------------------------------------------------------------------
with CORBA.DomainManager;
with CORBA.Policy;
package CORBA.Object.Policies is
function Get_Policy
(Self : in Ref;
Policy_Type : in PolicyType)
return CORBA.Policy.Ref;
function Get_Domain_Managers
(Self : in Ref'Class)
return CORBA.DomainManager.DomainManagersList;
procedure Set_Policy_Overrides
(Self : in Ref'Class;
Policies : in CORBA.Policy.PolicyList;
Set_Add : in SetOverrideType);
function Get_Client_Policy
(Self : in Ref'Class;
The_Type : in PolicyType)
return CORBA.Policy.Ref;
function Get_Policy_Overrides
(Self : in Ref'Class;
Types : in CORBA.Policy.PolicyTypeSeq)
return CORBA.Policy.PolicyList;
-- procedure Validate_Connection
-- (Self : in Ref;
-- Inconsistent_Policies : out CORBA.Policy.PolicyList;
-- Result : out Boolean);
end CORBA.Object.Policies;

View File

@@ -38,6 +38,7 @@ package body PolyORB.CORBA_P.Policy_Management is
type Policy_Info is record
Registered : Boolean := False;
POA_Level : Boolean;
Domain_Level : Boolean;
ORB_Level : Boolean;
Thread_Level : Boolean;
Reference_Level : Boolean;
@@ -97,6 +98,9 @@ package body PolyORB.CORBA_P.Policy_Management is
CORBA.Raise_No_Permission (CORBA.Default_Sys_Member);
end if;
when Domain_Level =>
raise Program_Error;
end case;
To (The_Type) := Element_Of (Policies, J);
@@ -179,6 +183,20 @@ package body PolyORB.CORBA_P.Policy_Management is
return Result;
end Get_Policy_Overrides;
----------------------
-- Is_Domain_Policy --
----------------------
function Is_Domain_Policy
(The_Type : in CORBA.PolicyType)
return Boolean
is
begin
pragma Assert (Policy_Registry (The_Type).Registered);
return Policy_Registry (The_Type).Domain_Level;
end Is_Domain_Policy;
-------------------
-- Is_ORB_Policy --
-------------------
@@ -244,6 +262,20 @@ package body PolyORB.CORBA_P.Policy_Management is
return Policy_Registry (The_Type).Thread_Level;
end Is_Thread_Policy;
---------------------------------
-- Policy_System_Default_Value --
---------------------------------
function Policy_System_Default_Value
(The_Type : in CORBA.PolicyType)
return CORBA.Policy.Ref
is
begin
pragma Assert (Policy_Registry (The_Type).Registered);
return Policy_Registry (The_Type).System_Default;
end Policy_System_Default_Value;
-----------------------
-- Raise_PolicyError --
-----------------------
@@ -267,6 +299,7 @@ package body PolyORB.CORBA_P.Policy_Management is
ORB_Level : in Boolean := False;
Thread_Level : in Boolean := False;
Reference_Level : in Boolean := False;
Domain_Level : in Boolean := False;
Factory : in Policy_Factory := null;
Compatibility_Check : in Compatibility_Check_Proc := null;
Reconciliation : in Reconciliation_Proc := null;
@@ -276,6 +309,7 @@ package body PolyORB.CORBA_P.Policy_Management is
Policy_Registry (The_Type) :=
(Registered => True,
POA_Level => POA_Level,
Domain_Level => Domain_Level,
ORB_Level => ORB_Level,
Thread_Level => Thread_Level,
Reference_Level => Reference_Level,

View File

@@ -50,7 +50,7 @@ package PolyORB.CORBA_P.Policy_Management is
Null_Policy : CORBA.Policy.Ref;
type Policy_Override_Level is
(POA_Level, ORB_Level, Thread_Level, Reference_Level);
(POA_Level, Domain_Level, ORB_Level, Thread_Level, Reference_Level);
-- Level of policy overrides
type Policy_Factory is
@@ -74,6 +74,11 @@ package PolyORB.CORBA_P.Policy_Management is
return Boolean;
-- Return True iff The_Type is a POA level policy
function Is_Domain_Policy
(The_Type : in CORBA.PolicyType)
return Boolean;
-- Return True iff The_Type is a Domain level policy
function Is_ORB_Policy
(The_Type : in CORBA.PolicyType)
return Boolean;
@@ -89,6 +94,11 @@ package PolyORB.CORBA_P.Policy_Management is
return Boolean;
-- Return True iff The_Type is an object reference policy
function Policy_System_Default_Value
(The_Type : in CORBA.PolicyType)
return CORBA.Policy.Ref;
-- Return system default value for given policy type
procedure Add_Policy_Overrides
(To : in out Policy_List;
Policies : in CORBA.Policy.PolicyList;
@@ -137,6 +147,7 @@ package PolyORB.CORBA_P.Policy_Management is
ORB_Level : in Boolean := False;
Thread_Level : in Boolean := False;
Reference_Level : in Boolean := False;
Domain_Level : in Boolean := False;
Factory : in Policy_Factory := null;
Compatibility_Check : in Compatibility_Check_Proc := null;
Reconciliation : in Reconciliation_Proc := null;
@@ -144,6 +155,7 @@ package PolyORB.CORBA_P.Policy_Management is
-- Register CORBA Policy and define allowed policy usage.
-- - The_Type : policy id
-- - POA_Level : policy is allowed at POA level
-- - Domain_Level : policy is allowed at Domain level
-- - ORB_Level : policy is allowed at ORB level
-- - Thread_Level : policy is allowed at thread level
-- - Reference_Level : policy is allowed at object reference level