aboutsummaryrefslogtreecommitdiffstats
path: root/lib/orber/src
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/orber/src
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/orber/src')
-rw-r--r--lib/orber/src/CORBA.idl22
-rw-r--r--lib/orber/src/Makefile268
-rw-r--r--lib/orber/src/OrberApp_IFR_impl.erl101
-rw-r--r--lib/orber/src/OrberCSIv2.asn145
-rw-r--r--lib/orber/src/OrberCSIv2.set.asn5
-rw-r--r--lib/orber/src/OrberIFR.idl12
-rw-r--r--lib/orber/src/PKIX1Algorithms88.asn1274
-rw-r--r--lib/orber/src/PKIX1Explicit88.asn1619
-rw-r--r--lib/orber/src/PKIX1Implicit88.asn1349
-rw-r--r--lib/orber/src/PKIXAttributeCertificate.asn1189
-rw-r--r--lib/orber/src/any.erl73
-rw-r--r--lib/orber/src/cdr_decode.erl1487
-rw-r--r--lib/orber/src/cdr_encode.erl1151
-rw-r--r--lib/orber/src/cdrlib.erl414
-rw-r--r--lib/orber/src/corba.erl2180
-rw-r--r--lib/orber/src/corba_boa.erl134
-rw-r--r--lib/orber/src/corba_nvlist.erl97
-rw-r--r--lib/orber/src/corba_object.erl220
-rw-r--r--lib/orber/src/corba_request.erl384
-rw-r--r--lib/orber/src/fixed.erl305
-rw-r--r--lib/orber/src/ifr_objects.hrl421
-rw-r--r--lib/orber/src/iop_ior.erl1716
-rw-r--r--lib/orber/src/orber.app.src109
-rw-r--r--lib/orber/src/orber.appup.src7
-rw-r--r--lib/orber/src/orber.erl1216
-rw-r--r--lib/orber/src/orber_acl.erl396
-rw-r--r--lib/orber/src/orber_diagnostics.erl240
-rw-r--r--lib/orber/src/orber_env.erl1456
-rw-r--r--lib/orber/src/orber_exceptions.erl717
-rw-r--r--lib/orber/src/orber_ifr.erl1817
-rw-r--r--lib/orber/src/orber_ifr.hrl34
-rw-r--r--lib/orber/src/orber_ifr_aliasdef.erl134
-rw-r--r--lib/orber/src/orber_ifr_arraydef.erl103
-rw-r--r--lib/orber/src/orber_ifr_attributedef.erl137
-rw-r--r--lib/orber/src/orber_ifr_constantdef.erl147
-rw-r--r--lib/orber/src/orber_ifr_contained.erl247
-rw-r--r--lib/orber/src/orber_ifr_container.erl463
-rw-r--r--lib/orber/src/orber_ifr_enumdef.erl129
-rw-r--r--lib/orber/src/orber_ifr_exceptiondef.erl164
-rw-r--r--lib/orber/src/orber_ifr_fixeddef.erl79
-rw-r--r--lib/orber/src/orber_ifr_idltype.erl74
-rw-r--r--lib/orber/src/orber_ifr_interfacedef.erl339
-rw-r--r--lib/orber/src/orber_ifr_irobject.erl72
-rw-r--r--lib/orber/src/orber_ifr_moduledef.erl183
-rw-r--r--lib/orber/src/orber_ifr_operationdef.erl191
-rw-r--r--lib/orber/src/orber_ifr_orb.erl98
-rw-r--r--lib/orber/src/orber_ifr_primitivedef.erl69
-rw-r--r--lib/orber/src/orber_ifr_repository.erl286
-rw-r--r--lib/orber/src/orber_ifr_sequencedef.erl103
-rw-r--r--lib/orber/src/orber_ifr_stringdef.erl74
-rw-r--r--lib/orber/src/orber_ifr_structdef.erl155
-rw-r--r--lib/orber/src/orber_ifr_typecode.erl107
-rw-r--r--lib/orber/src/orber_ifr_typedef.erl124
-rw-r--r--lib/orber/src/orber_ifr_uniondef.erl175
-rw-r--r--lib/orber/src/orber_ifr_utils.erl437
-rw-r--r--lib/orber/src/orber_ifr_wstringdef.erl72
-rw-r--r--lib/orber/src/orber_iiop.erl550
-rw-r--r--lib/orber/src/orber_iiop.hrl1015
-rw-r--r--lib/orber/src/orber_iiop_inproxy.erl398
-rw-r--r--lib/orber/src/orber_iiop_inrequest.erl538
-rw-r--r--lib/orber/src/orber_iiop_insup.erl85
-rw-r--r--lib/orber/src/orber_iiop_net.erl463
-rw-r--r--lib/orber/src/orber_iiop_net_accept.erl94
-rw-r--r--lib/orber/src/orber_iiop_outproxy.erl530
-rw-r--r--lib/orber/src/orber_iiop_outsup.erl87
-rw-r--r--lib/orber/src/orber_iiop_pm.erl821
-rw-r--r--lib/orber/src/orber_iiop_socketsup.erl85
-rw-r--r--lib/orber/src/orber_iiop_tracer.erl231
-rw-r--r--lib/orber/src/orber_iiop_tracer_silent.erl190
-rw-r--r--lib/orber/src/orber_iiop_tracer_stealth.erl186
-rw-r--r--lib/orber/src/orber_initial_references.erl327
-rw-r--r--lib/orber/src/orber_interceptors.erl162
-rw-r--r--lib/orber/src/orber_objectkeys.erl570
-rw-r--r--lib/orber/src/orber_pi.erl1210
-rw-r--r--lib/orber/src/orber_request_number.erl82
-rw-r--r--lib/orber/src/orber_socket.erl504
-rw-r--r--lib/orber/src/orber_tb.erl186
-rw-r--r--lib/orber/src/orber_tc.erl283
-rw-r--r--lib/orber/src/orber_typedefs.erl82
-rw-r--r--lib/orber/src/orber_web.erl863
-rw-r--r--lib/orber/src/orber_web_server.erl191
81 files changed, 30353 insertions, 0 deletions
diff --git a/lib/orber/src/CORBA.idl b/lib/orber/src/CORBA.idl
new file mode 100644
index 0000000000..3cd8790f49
--- /dev/null
+++ b/lib/orber/src/CORBA.idl
@@ -0,0 +1,22 @@
+#ifndef _CORBA_IDL
+#define _CORBA_IDL
+
+#pragma prefix "omg.org"
+
+//******************************************************************
+//
+//Policy Object:
+//
+//******************************************************************
+
+module CORBA {
+
+ // Policy typedefs
+ typedef unsigned long PolicyType;
+ typedef string Identifier;
+ typedef string ScopedName;
+ typedef string RepositoryId;
+
+};
+
+#endif
diff --git a/lib/orber/src/Makefile b/lib/orber/src/Makefile
new file mode 100644
index 0000000000..ccc449333c
--- /dev/null
+++ b/lib/orber/src/Makefile
@@ -0,0 +1,268 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1997-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+#
+include $(ERL_TOP)/make/target.mk
+
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# To get hold of SYSTEM_VSN (e.g. R9C).
+#include $(ERL_TOP)/erts/vsn.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/orber-$(ORBER_VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+
+MODULES= \
+ orber \
+ corba \
+ corba_boa \
+ corba_object \
+ any \
+ iop_ior \
+ orber_tc \
+ orber_typedefs \
+ orber_request_number \
+ orber_objectkeys \
+ orber_initial_references \
+ cdrlib \
+ cdr_encode \
+ cdr_decode \
+ orber_iiop \
+ orber_iiop_net \
+ orber_iiop_net_accept \
+ orber_iiop_insup \
+ orber_iiop_inproxy \
+ orber_iiop_inrequest \
+ orber_iiop_pm \
+ orber_iiop_outsup \
+ orber_iiop_outproxy \
+ orber_iiop_socketsup \
+ orber_socket \
+ orber_ifr \
+ orber_ifr_aliasdef \
+ orber_ifr_arraydef \
+ orber_ifr_attributedef \
+ orber_ifr_constantdef \
+ orber_ifr_contained \
+ orber_ifr_container \
+ orber_ifr_enumdef \
+ orber_ifr_exceptiondef \
+ orber_ifr_idltype \
+ orber_ifr_interfacedef \
+ orber_ifr_irobject \
+ orber_ifr_moduledef \
+ orber_ifr_operationdef \
+ orber_ifr_orb \
+ orber_ifr_primitivedef \
+ orber_ifr_repository \
+ orber_ifr_sequencedef \
+ orber_ifr_stringdef \
+ orber_ifr_wstringdef \
+ orber_ifr_structdef \
+ orber_ifr_typecode \
+ orber_ifr_typedef \
+ orber_ifr_uniondef \
+ orber_ifr_fixeddef \
+ orber_ifr_utils \
+ OrberApp_IFR_impl \
+ orber_pi \
+ orber_web \
+ orber_web_server \
+ orber_iiop_tracer \
+ orber_iiop_tracer_silent \
+ orber_iiop_tracer_stealth \
+ fixed \
+ orber_exceptions \
+ orber_diagnostics \
+ orber_acl \
+ orber_env \
+ orber_tb
+
+ASN_MODULES = OrberCSIv2
+ASN_SET = $(ASN_MODULES:%=%.set.asn)
+ASN_ASNS = $(ASN_MODULES:%=%.asn1)
+GEN_ASN_ERL = $(ASN_MODULES:%=%.erl)
+GEN_ASN_HRL = $(ASN_MODULES:%=%.hrl)
+GEN_ASN_DBS = $(ASN_MODULES:%=%.asn1db)
+GEN_ASN_TABLES = $(ASN_MODULES:%=%.table)
+
+PKIX_FILES = \
+ OrberCSIv2.asn1 \
+ PKIXAttributeCertificate.asn1 \
+ PKIX1Explicit88.asn1 \
+ PKIX1Algorithms88.asn1 \
+ PKIX1Implicit88.asn1 \
+ OrberCSIv2.set.asn
+
+EXTERNAL_HRL_FILES= ../include/corba.hrl \
+ ../include/ifr_types.hrl \
+ ../include/orber_pi.hrl
+
+INTERNAL_HRL_FILES = \
+ orber_iiop.hrl \
+ ifr_objects.hrl \
+ orber_ifr.hrl
+
+ERL_FILES= $(MODULES:%=%.erl)
+
+GEN_ERL_FILES1 = \
+ oe_erlang.erl \
+ erlang_pid.erl \
+ erlang_port.erl \
+ erlang_ref.erl \
+ erlang_binary.erl
+
+GEN_ERL_FILES2 = \
+ oe_CORBA.erl
+
+GEN_ERL_FILES3 = \
+ oe_OrberIFR.erl \
+ OrberApp_IFR.erl
+
+GEN_ERL_FILES = $(GEN_ERL_FILES1) $(GEN_ERL_FILES2) \
+ $(GEN_ERL_FILES3) \
+# $(GEN_ASN_ERL)
+
+GEN_HRL_FILES1 = \
+ oe_erlang.hrl \
+ erlang.hrl
+
+GEN_HRL_FILES2 = \
+ CORBA.hrl \
+ oe_CORBA.hrl
+
+GEN_HRL_FILES3 = \
+ OrberApp_IFR.hrl \
+ oe_OrberIFR.hrl \
+ OrberApp.hrl
+
+GEN_HRL_FILES_EXT = $(GEN_HRL_FILES1)
+
+GEN_HRL_FILES_LOC = $(GEN_HRL_FILES2) $(GEN_HRL_FILES3) \
+# $(GEN_ASN_HRL)
+
+
+GEN_FILES = \
+ $(GEN_ERL_FILES) \
+ $(GEN_HRL_FILES_LOC) \
+ $(GEN_HRL_FILES_EXT) \
+# $(GEN_ASN_DBS) \
+# $(GEN_ASN_TABLES)
+
+TARGET_FILES = \
+ $(GEN_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \
+ $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+APPUP_FILE = orber.appup
+APPUP_SRC = $(APPUP_FILE).src
+APPUP_TARGET = $(EBIN)/$(APPUP_FILE)
+
+APP_FILE = orber.app
+APP_SRC = $(APP_FILE).src
+APP_TARGET = $(EBIN)/$(APP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin
+# The -pa option is just used temporary until erlc can handle
+# includes from other directories than ../include .
+ERL_COMPILE_FLAGS += $(ERL_IDL_FLAGS) \
+ -I$(ERL_TOP)/lib/orber/include \
+ +'{parse_transform,sys_pre_attributes}' \
+ +'{attribute,insert,app_vsn,"orber_$(ORBER_VSN)"}' \
+ -D'ORBVSN="$(ORBER_VSN)"'
+
+ASN_FLAGS = -bber_bin +der +compact_bit_string +optimize \
+ +nowarn_unused_record
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+debug:
+ @${MAKE} TYPE=debug opt
+
+opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
+
+clean:
+ rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET)
+ rm -f errs core *~
+
+$(APP_TARGET): $(APP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(ORBER_VSN);' $< > $@
+
+$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(ORBER_VSN);' $< > $@
+
+docs:
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+$(GEN_ERL_FILES1) $(GEN_HRL_FILES1): $(ERL_TOP)/lib/ic/include/erlang.idl
+ erlc $(ERL_IDL_FLAGS) $(ERL_TOP)/lib/ic/include/erlang.idl
+
+$(GEN_ERL_FILES2) $(GEN_HRL_FILES2): CORBA.idl
+ erlc $(ERL_IDL_FLAGS) CORBA.idl
+
+$(GEN_ERL_FILES3) $(GEN_HRL_FILES3): OrberIFR.idl
+ erlc $(ERL_IDL_FLAGS) +'{this,"Orber::IFR"}' \
+ OrberIFR.idl
+
+$(GEN_ASN_ERL) $(GEN_ASN_HRL): OrberCSIv2.asn1 OrberCSIv2.set.asn
+ erlc $(ERL_COMPILE_FLAGS) $(ASN_FLAGS) +'{inline,"OrberCSIv2"}' OrberCSIv2.set.asn
+ rm -f $(GEN_ASN_ERL:%.erl=%.beam)
+
+# erlc $(ERL_COMPILE_FLAGS) $(ASN_FLAGS) OrberCSIv2.asn1 ;\
+# erlc $(GEN_ASN_ERL)
+# Use the following when we safely can inline the ASN1 runtime code.
+# Requires igor (part of syntax_tools (introduced in R10B
+# erlc $(ERL_COMPILE_FLAGS) $(ASN_FLAGS) +'{inline,"OrberCSIv2"}' OrberCSIv2.set.asn ; \
+
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) $(RELSYSDIR)/ebin
+ $(INSTALL_DIR) $(RELSYSDIR)/src
+ $(INSTALL_DATA) $(ERL_FILES) $(YRL_FILE) $(GEN_HRL_FILES_LOC) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src
+ $(INSTALL_DIR) $(RELSYSDIR)/include
+ $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(GEN_HRL_FILES_EXT) $(RELSYSDIR)/include
+
+
+release_docs_spec:
+
+
diff --git a/lib/orber/src/OrberApp_IFR_impl.erl b/lib/orber/src/OrberApp_IFR_impl.erl
new file mode 100644
index 0000000000..c0c6eb4704
--- /dev/null
+++ b/lib/orber/src/OrberApp_IFR_impl.erl
@@ -0,0 +1,101 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File : OrberApp_IFR_impl.erl
+%% Purpose :
+%%-----------------------------------------------------------------
+
+-module('OrberApp_IFR_impl').
+
+%%--------------- INCLUDES -----------------------------------
+-include_lib("orber/src/orber_iiop.hrl").
+-include_lib("orber/include/ifr_types.hrl").
+-include_lib("orber/include/corba.hrl").
+
+%%--------------- IMPORTS ------------------------------------
+
+%%--------------- EXPORTS ------------------------------------
+%% External
+-export([get_absolute_name/3, get_user_exception_type/3]).
+
+%%--------------- gen_server specific exports ----------------
+-export([init/1, terminate/2, code_change/3]).
+
+%%--------------- LOCAL DEFINITIONS --------------------------
+-define(DEBUG_LEVEL, 6).
+
+
+init(State) ->
+ {ok, State}.
+terminate(_Reason, _State) ->
+ ok.
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%-----------------------------------------------------------
+%%------- Exported external functions -----------------------
+%%-----------------------------------------------------------
+%%----------------------------------------------------------%
+%% function : get_absolute_name
+%% Arguments: TypeID - string()
+%% Returns : Fully scooped name - string()
+%%-----------------------------------------------------------
+
+get_absolute_name(_OE_THIS, _State, []) ->
+ orber:dbg("[~p] OrberApp_IFR_impl:get_absolute_name(); no TypeID supplied.",
+ [?LINE], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 11), completion_status=?COMPLETED_MAYBE});
+
+get_absolute_name(_OE_THIS, State, TypeID) ->
+ Rep = orber_ifr:find_repository(),
+ Key = orber_ifr:'Repository_lookup_id'(Rep, TypeID),
+ [$:, $: |N] = orber_ifr:'Contained__get_absolute_name'(Key),
+ {reply, change_colons_to_underscore(N, []), State}.
+
+change_colons_to_underscore([$:, $: | T], Acc) ->
+ change_colons_to_underscore(T, [$_ |Acc]);
+change_colons_to_underscore([H |T], Acc) ->
+ change_colons_to_underscore(T, [H |Acc]);
+change_colons_to_underscore([], Acc) ->
+ lists:reverse(Acc).
+
+%%----------------------------------------------------------%
+%% function : get_user_exception_type
+%% Arguments: TypeID - string()
+%% Returns : Fully scooped name - string()
+%%-----------------------------------------------------------
+
+get_user_exception_type(_OE_THIS, _State, []) ->
+ orber:dbg("[~p] OrberApp_IFR_impl:get_user_exception_type(); no TypeID supplied.",
+ [?LINE], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 11), completion_status=?COMPLETED_MAYBE});
+
+get_user_exception_type(_OE_THIS, State, TypeId) ->
+ Rep = orber_ifr:find_repository(),
+ ExceptionDef = orber_ifr:'Repository_lookup_id'(Rep, TypeId),
+ ContainedDescr = orber_ifr_exceptiondef:describe(ExceptionDef),
+ ExceptionDescr = ContainedDescr#contained_description.value,
+ {reply, ExceptionDescr#exceptiondescription.type, State}.
+
+
+%%--------------- LOCAL FUNCTIONS ----------------------------
+%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
+%%--------------- END OF MODULE ------------------------------
diff --git a/lib/orber/src/OrberCSIv2.asn1 b/lib/orber/src/OrberCSIv2.asn1
new file mode 100644
index 0000000000..d776ce2b47
--- /dev/null
+++ b/lib/orber/src/OrberCSIv2.asn1
@@ -0,0 +1,45 @@
+OrberCSIv2 DEFINITIONS ::=
+
+BEGIN
+
+ IMPORTS
+
+ -- IMPORTed module OIDs MAY change if [PKIXPROF] changes
+ -- PKIX1Explicit88 Certificate Extensions
+ Certificate
+ FROM PKIX1Explicit88 {iso(1) identified-organization(3)
+ dod(6) internet(1) security(5) mechanisms(5)
+ pkix(7) id-mod(0) id-pkix1-explicit-88(1)}
+ -- PKIXAttributeCertificate
+ AttributeCertificate
+ FROM PKIXAttributeCertificate {iso(1) identified-organization(3) dod(6)
+ internet(1) security(5) mechanisms(5) pkix(7) id-mod(0)
+ id-mod-attribute-cert(12)};
+
+
+
+ -- Authorization Token
+ -- AttributeCertificate - [IETF ID PKIXAC].
+ -- Certificate - [IETF RFC 2459].
+
+ VerifyingCertChain ::= SEQUENCE OF Certificate
+
+ AttributeCertChain ::= SEQUENCE {
+ attributeCert AttributeCertificate,
+ certificateChain VerifyingCertChain
+ }
+
+
+ -- The ASN.1 encoding of identity tokens of this type is defined
+ -- as follows (ITTX509CertChain):
+ CertificateChain ::= SEQUENCE SIZE (1..MAX) OF Certificate
+
+
+ -- The object identifier allocated for the GSSUP mechanism is defined as follows:
+ -- GSS Exported Name Object Form for GSSUP Mechanism
+ gssup-mechanism OBJECT IDENTIFIER ::= { iso-itu-t (2) international-organization (23) omg (130) security (1) authentication (1) gssup-mechanism (1) }
+
+ -- Scoped-Username GSS Name Form
+ scoped-username OBJECT IDENTIFIER ::= { iso-itu-t (2) international-organization (23) omg (130) security (1) naming (2) scoped-username(1) }
+
+END
diff --git a/lib/orber/src/OrberCSIv2.set.asn b/lib/orber/src/OrberCSIv2.set.asn
new file mode 100644
index 0000000000..11fbcc167f
--- /dev/null
+++ b/lib/orber/src/OrberCSIv2.set.asn
@@ -0,0 +1,5 @@
+OrberCSIv2.asn1
+PKIXAttributeCertificate.asn1
+PKIX1Explicit88.asn1
+PKIX1Algorithms88.asn1
+PKIX1Implicit88.asn1
diff --git a/lib/orber/src/OrberIFR.idl b/lib/orber/src/OrberIFR.idl
new file mode 100644
index 0000000000..6d53217658
--- /dev/null
+++ b/lib/orber/src/OrberIFR.idl
@@ -0,0 +1,12 @@
+#ifndef _ORBER_IFR_IDL
+#define _ORBER_IFR_IDL
+
+module OrberApp
+{
+ interface IFR {
+ string get_absolute_name(in string TypeID);
+ CORBA::TypeCode get_user_exception_type(in string TypeID);
+ };
+};
+
+#endif
diff --git a/lib/orber/src/PKIX1Algorithms88.asn1 b/lib/orber/src/PKIX1Algorithms88.asn1
new file mode 100644
index 0000000000..e78de69b0e
--- /dev/null
+++ b/lib/orber/src/PKIX1Algorithms88.asn1
@@ -0,0 +1,274 @@
+ PKIX1Algorithms88 { iso(1) identified-organization(3) dod(6)
+ internet(1) security(5) mechanisms(5) pkix(7) id-mod(0)
+ id-mod-pkix1-algorithms(17) }
+
+ DEFINITIONS EXPLICIT TAGS ::= BEGIN
+
+ -- EXPORTS All;
+
+ -- IMPORTS NONE;
+
+ --
+ -- One-way Hash Functions
+ --
+
+ md2 OBJECT IDENTIFIER ::= {
+ iso(1) member-body(2) us(840) rsadsi(113549)
+ digestAlgorithm(2) 2 }
+
+ md5 OBJECT IDENTIFIER ::= {
+ iso(1) member-body(2) us(840) rsadsi(113549)
+ digestAlgorithm(2) 5 }
+
+ id-sha1 OBJECT IDENTIFIER ::= {
+ iso(1) identified-organization(3) oiw(14) secsig(3)
+ algorithms(2) 26 }
+
+ --
+ -- DSA Keys and Signatures
+ --
+
+ -- OID for DSA public key
+
+ id-dsa OBJECT IDENTIFIER ::= {
+ iso(1) member-body(2) us(840) x9-57(10040) x9algorithm(4) 1 }
+
+ -- encoding for DSA public key
+
+ DSAPublicKey ::= INTEGER -- public key, y
+
+ Dss-Parms ::= SEQUENCE {
+ p INTEGER,
+ q INTEGER,
+ g INTEGER }
+
+ -- OID for DSA signature generated with SHA-1 hash
+
+ id-dsa-with-sha1 OBJECT IDENTIFIER ::= {
+ iso(1) member-body(2) us(840) x9-57 (10040) x9algorithm(4) 3 }
+
+ -- encoding for DSA signature generated with SHA-1 hash
+
+ Dss-Sig-Value ::= SEQUENCE {
+ r INTEGER,
+ s INTEGER }
+
+ --
+ -- RSA Keys and Signatures
+ --
+
+ -- arc for RSA public key and RSA signature OIDs
+
+ pkcs-1 OBJECT IDENTIFIER ::= {
+ iso(1) member-body(2) us(840) rsadsi(113549) pkcs(1) 1 }
+
+ -- OID for RSA public keys
+
+ rsaEncryption OBJECT IDENTIFIER ::= { pkcs-1 1 }
+
+ -- OID for RSA signature generated with MD2 hash
+
+ md2WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 2 }
+
+ -- OID for RSA signature generated with MD5 hash
+
+ md5WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 4 }
+
+ -- OID for RSA signature generated with SHA-1 hash
+
+ sha1WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 5 }
+
+ -- encoding for RSA public key
+
+ RSAPublicKey ::= SEQUENCE {
+ modulus INTEGER, -- n
+ publicExponent INTEGER } -- e
+
+ --
+ -- Diffie-Hellman Keys
+ --
+
+ dhpublicnumber OBJECT IDENTIFIER ::= {
+ iso(1) member-body(2) us(840) ansi-x942(10046)
+ number-type(2) 1 }
+
+ -- encoding for DSA public key
+
+ DHPublicKey ::= INTEGER -- public key, y = g^x mod p
+
+ DomainParameters ::= SEQUENCE {
+ p INTEGER, -- odd prime, p=jq +1
+ g INTEGER, -- generator, g
+ q INTEGER, -- factor of p-1
+ j INTEGER OPTIONAL, -- subgroup factor, j>= 2
+ validationParms ValidationParms OPTIONAL }
+
+ ValidationParms ::= SEQUENCE {
+ seed BIT STRING,
+ pgenCounter INTEGER }
+
+ --
+ -- KEA Keys
+ --
+
+ id-keyExchangeAlgorithm OBJECT IDENTIFIER ::=
+ { 2 16 840 1 101 2 1 1 22 }
+
+ KEA-Parms-Id ::= OCTET STRING
+
+ --
+ -- Elliptic Curve Keys, Signatures, and Curves
+ --
+
+ ansi-X9-62 OBJECT IDENTIFIER ::= {
+ iso(1) member-body(2) us(840) 10045 }
+
+ FieldID ::= SEQUENCE { -- Finite field
+ fieldType OBJECT IDENTIFIER,
+ parameters ANY DEFINED BY fieldType }
+
+ -- Arc for ECDSA signature OIDS
+
+ id-ecSigType OBJECT IDENTIFIER ::= { ansi-X9-62 signatures(4) }
+
+ -- OID for ECDSA signatures with SHA-1
+
+ ecdsa-with-SHA1 OBJECT IDENTIFIER ::= { id-ecSigType 1 }
+
+ -- OID for an elliptic curve signature
+ -- format for the value of an ECDSA signature value
+
+ ECDSA-Sig-Value ::= SEQUENCE {
+ r INTEGER,
+ s INTEGER }
+
+ -- recognized field type OIDs are defined in the following arc
+
+ id-fieldType OBJECT IDENTIFIER ::= { ansi-X9-62 fieldType(1) }
+
+ -- where fieldType is prime-field, the parameters are of type Prime-p
+
+ prime-field OBJECT IDENTIFIER ::= { id-fieldType 1 }
+
+ Prime-p ::= INTEGER -- Finite field F(p), where p is an odd prime
+
+ -- where fieldType is characteristic-two-field, the parameters are
+ -- of type Characteristic-two
+
+ characteristic-two-field OBJECT IDENTIFIER ::= { id-fieldType 2 }
+
+ Characteristic-two ::= SEQUENCE {
+ m INTEGER, -- Field size 2^m
+ basis OBJECT IDENTIFIER,
+ parameters ANY DEFINED BY basis }
+
+ -- recognized basis type OIDs are defined in the following arc
+
+ id-characteristic-two-basis OBJECT IDENTIFIER ::= {
+ characteristic-two-field basisType(3) }
+
+ -- gnbasis is identified by OID gnBasis and indicates
+ -- parameters are NULL
+
+ gnBasis OBJECT IDENTIFIER ::= { id-characteristic-two-basis 1 }
+
+ -- parameters for this basis are NULL
+
+ -- trinomial basis is identified by OID tpBasis and indicates
+ -- parameters of type Pentanomial
+
+ tpBasis OBJECT IDENTIFIER ::= { id-characteristic-two-basis 2 }
+
+ -- Trinomial basis representation of F2^m
+ -- Integer k for reduction polynomial xm + xk + 1
+
+ Trinomial ::= INTEGER
+
+ -- for pentanomial basis is identified by OID ppBasis and indicates
+ -- parameters of type Pentanomial
+
+ ppBasis OBJECT IDENTIFIER ::= { id-characteristic-two-basis 3 }
+
+ -- Pentanomial basis representation of F2^m
+ -- reduction polynomial integers k1, k2, k3
+ -- f(x) = x**m + x**k3 + x**k2 + x**k1 + 1
+
+ Pentanomial ::= SEQUENCE {
+ k1 INTEGER,
+ k2 INTEGER,
+ k3 INTEGER }
+
+ -- The object identifiers gnBasis, tpBasis and ppBasis name
+ -- three kinds of basis for characteristic-two finite fields
+
+ FieldElement ::= OCTET STRING -- Finite field element
+
+ ECPoint ::= OCTET STRING -- Elliptic curve point
+
+ -- Elliptic Curve parameters may be specified explicitly,
+ -- specified implicitly through a "named curve", or
+ -- inherited from the CA
+
+ EcpkParameters ::= CHOICE {
+ ecParameters ECParameters,
+ namedCurve OBJECT IDENTIFIER,
+ implicitlyCA NULL }
+
+ ECParameters ::= SEQUENCE { -- Elliptic curve parameters
+ version ECPVer,
+ fieldID FieldID,
+ curve Curve,
+ base ECPoint, -- Base point G
+ order INTEGER, -- Order n of the base point
+ cofactor INTEGER OPTIONAL } -- The integer h = #E(Fq)/n
+
+ ECPVer ::= INTEGER {ecpVer1(1)}
+
+ Curve ::= SEQUENCE {
+ a FieldElement, -- Elliptic curve coefficient a
+ b FieldElement, -- Elliptic curve coefficient b
+ seed BIT STRING OPTIONAL }
+
+ id-publicKeyType OBJECT IDENTIFIER ::= { ansi-X9-62 keyType(2) }
+
+ id-ecPublicKey OBJECT IDENTIFIER ::= { id-publicKeyType 1 }
+
+ -- Named Elliptic Curves in ANSI X9.62.
+
+ ellipticCurve OBJECT IDENTIFIER ::= { ansi-X9-62 curves(3) }
+
+ c-TwoCurve OBJECT IDENTIFIER ::= {
+ ellipticCurve characteristicTwo(0) }
+
+ c2pnb163v1 OBJECT IDENTIFIER ::= { c-TwoCurve 1 }
+ c2pnb163v2 OBJECT IDENTIFIER ::= { c-TwoCurve 2 }
+ c2pnb163v3 OBJECT IDENTIFIER ::= { c-TwoCurve 3 }
+ c2pnb176w1 OBJECT IDENTIFIER ::= { c-TwoCurve 4 }
+ c2tnb191v1 OBJECT IDENTIFIER ::= { c-TwoCurve 5 }
+ c2tnb191v2 OBJECT IDENTIFIER ::= { c-TwoCurve 6 }
+ c2tnb191v3 OBJECT IDENTIFIER ::= { c-TwoCurve 7 }
+ c2onb191v4 OBJECT IDENTIFIER ::= { c-TwoCurve 8 }
+ c2onb191v5 OBJECT IDENTIFIER ::= { c-TwoCurve 9 }
+ c2pnb208w1 OBJECT IDENTIFIER ::= { c-TwoCurve 10 }
+ c2tnb239v1 OBJECT IDENTIFIER ::= { c-TwoCurve 11 }
+ c2tnb239v2 OBJECT IDENTIFIER ::= { c-TwoCurve 12 }
+ c2tnb239v3 OBJECT IDENTIFIER ::= { c-TwoCurve 13 }
+ c2onb239v4 OBJECT IDENTIFIER ::= { c-TwoCurve 14 }
+ c2onb239v5 OBJECT IDENTIFIER ::= { c-TwoCurve 15 }
+ c2pnb272w1 OBJECT IDENTIFIER ::= { c-TwoCurve 16 }
+ c2pnb304w1 OBJECT IDENTIFIER ::= { c-TwoCurve 17 }
+ c2tnb359v1 OBJECT IDENTIFIER ::= { c-TwoCurve 18 }
+ c2pnb368w1 OBJECT IDENTIFIER ::= { c-TwoCurve 19 }
+ c2tnb431r1 OBJECT IDENTIFIER ::= { c-TwoCurve 20 }
+
+ primeCurve OBJECT IDENTIFIER ::= { ellipticCurve prime(1) }
+
+ prime192v1 OBJECT IDENTIFIER ::= { primeCurve 1 }
+ prime192v2 OBJECT IDENTIFIER ::= { primeCurve 2 }
+ prime192v3 OBJECT IDENTIFIER ::= { primeCurve 3 }
+ prime239v1 OBJECT IDENTIFIER ::= { primeCurve 4 }
+ prime239v2 OBJECT IDENTIFIER ::= { primeCurve 5 }
+ prime239v3 OBJECT IDENTIFIER ::= { primeCurve 6 }
+ prime256v1 OBJECT IDENTIFIER ::= { primeCurve 7 }
+
+ END
diff --git a/lib/orber/src/PKIX1Explicit88.asn1 b/lib/orber/src/PKIX1Explicit88.asn1
new file mode 100644
index 0000000000..9b8068fed0
--- /dev/null
+++ b/lib/orber/src/PKIX1Explicit88.asn1
@@ -0,0 +1,619 @@
+PKIX1Explicit88 { iso(1) identified-organization(3) dod(6) internet(1)
+ security(5) mechanisms(5) pkix(7) id-mod(0) id-pkix1-explicit(18) }
+
+DEFINITIONS EXPLICIT TAGS ::=
+
+BEGIN
+
+-- EXPORTS ALL --
+
+-- IMPORTS NONE --
+
+-- UNIVERSAL Types defined in 1993 and 1998 ASN.1
+-- and required by this specification
+
+-- UniversalString ::= [UNIVERSAL 28] IMPLICIT OCTET STRING
+ -- UniversalString is defined in ASN.1:1993
+
+-- BMPString ::= [UNIVERSAL 30] IMPLICIT OCTET STRING
+ -- BMPString is the subtype of UniversalString and models
+ -- the Basic Multilingual Plane of ISO/IEC/ITU 10646-1
+
+-- UTF8String ::= [UNIVERSAL 12] IMPLICIT OCTET STRING
+ -- The content of this type conforms to RFC 2279.
+
+-- PKIX specific OIDs
+
+id-pkix OBJECT IDENTIFIER ::=
+ { iso(1) identified-organization(3) dod(6) internet(1)
+ security(5) mechanisms(5) pkix(7) }
+
+-- PKIX arcs
+
+id-pe OBJECT IDENTIFIER ::= { id-pkix 1 }
+ -- arc for private certificate extensions
+id-qt OBJECT IDENTIFIER ::= { id-pkix 2 }
+ -- arc for policy qualifier types
+id-kp OBJECT IDENTIFIER ::= { id-pkix 3 }
+ -- arc for extended key purpose OIDS
+id-ad OBJECT IDENTIFIER ::= { id-pkix 48 }
+ -- arc for access descriptors
+
+-- policyQualifierIds for Internet policy qualifiers
+
+id-qt-cps OBJECT IDENTIFIER ::= { id-qt 1 }
+ -- OID for CPS qualifier
+id-qt-unotice OBJECT IDENTIFIER ::= { id-qt 2 }
+ -- OID for user notice qualifier
+
+-- access descriptor definitions
+
+id-ad-ocsp OBJECT IDENTIFIER ::= { id-ad 1 }
+id-ad-caIssuers OBJECT IDENTIFIER ::= { id-ad 2 }
+id-ad-timeStamping OBJECT IDENTIFIER ::= { id-ad 3 }
+id-ad-caRepository OBJECT IDENTIFIER ::= { id-ad 5 }
+
+-- attribute data types
+
+Attribute ::= SEQUENCE {
+ type AttributeType,
+ values SET OF AttributeValue }
+ -- at least one value is required
+
+AttributeType ::= OBJECT IDENTIFIER
+
+AttributeValue ::= ANY
+
+AttributeTypeAndValue ::= SEQUENCE {
+ type AttributeType,
+ value AttributeValue }
+
+-- suggested naming attributes: Definition of the following
+-- information object set may be augmented to meet local
+-- requirements. Note that deleting members of the set may
+-- prevent interoperability with conforming implementations.
+-- presented in pairs: the AttributeType followed by the
+-- type definition for the corresponding AttributeValue
+--Arc for standard naming attributes
+id-at OBJECT IDENTIFIER ::= { joint-iso-ccitt(2) ds(5) 4 }
+
+-- Naming attributes of type X520name
+
+id-at-name AttributeType ::= { id-at 41 }
+id-at-surname AttributeType ::= { id-at 4 }
+id-at-givenName AttributeType ::= { id-at 42 }
+id-at-initials AttributeType ::= { id-at 43 }
+id-at-generationQualifier AttributeType ::= { id-at 44 }
+
+X520name ::= CHOICE {
+ teletexString TeletexString (SIZE (1..ub-name)),
+ printableString PrintableString (SIZE (1..ub-name)),
+ universalString UniversalString (SIZE (1..ub-name)),
+ utf8String UTF8String (SIZE (1..ub-name)),
+ bmpString BMPString (SIZE (1..ub-name)) }
+
+-- Naming attributes of type X520CommonName
+
+id-at-commonName AttributeType ::= { id-at 3 }
+
+X520CommonName ::= CHOICE {
+ teletexString TeletexString (SIZE (1..ub-common-name)),
+ printableString PrintableString (SIZE (1..ub-common-name)),
+ universalString UniversalString (SIZE (1..ub-common-name)),
+ utf8String UTF8String (SIZE (1..ub-common-name)),
+ bmpString BMPString (SIZE (1..ub-common-name)) }
+
+-- Naming attributes of type X520LocalityName
+
+id-at-localityName AttributeType ::= { id-at 7 }
+
+X520LocalityName ::= CHOICE {
+ teletexString TeletexString (SIZE (1..ub-locality-name)),
+ printableString PrintableString (SIZE (1..ub-locality-name)),
+ universalString UniversalString (SIZE (1..ub-locality-name)),
+ utf8String UTF8String (SIZE (1..ub-locality-name)),
+ bmpString BMPString (SIZE (1..ub-locality-name)) }
+
+-- Naming attributes of type X520StateOrProvinceName
+
+id-at-stateOrProvinceName AttributeType ::= { id-at 8 }
+
+X520StateOrProvinceName ::= CHOICE {
+ teletexString TeletexString (SIZE (1..ub-state-name)),
+ printableString PrintableString (SIZE (1..ub-state-name)),
+ universalString UniversalString (SIZE (1..ub-state-name)),
+ utf8String UTF8String (SIZE (1..ub-state-name)),
+ bmpString BMPString (SIZE(1..ub-state-name)) }
+
+-- Naming attributes of type X520OrganizationName
+
+id-at-organizationName AttributeType ::= { id-at 10 }
+
+X520OrganizationName ::= CHOICE {
+ teletexString TeletexString
+ (SIZE (1..ub-organization-name)),
+ printableString PrintableString
+ (SIZE (1..ub-organization-name)),
+ universalString UniversalString
+ (SIZE (1..ub-organization-name)),
+ utf8String UTF8String
+ (SIZE (1..ub-organization-name)),
+ bmpString BMPString
+ (SIZE (1..ub-organization-name)) }
+
+-- Naming attributes of type X520OrganizationalUnitName
+
+id-at-organizationalUnitName AttributeType ::= { id-at 11 }
+
+X520OrganizationalUnitName ::= CHOICE {
+ teletexString TeletexString
+ (SIZE (1..ub-organizational-unit-name)),
+ printableString PrintableString
+ (SIZE (1..ub-organizational-unit-name)),
+ universalString UniversalString
+ (SIZE (1..ub-organizational-unit-name)),
+ utf8String UTF8String
+ (SIZE (1..ub-organizational-unit-name)),
+ bmpString BMPString
+ (SIZE (1..ub-organizational-unit-name)) }
+
+-- Naming attributes of type X520Title
+
+id-at-title AttributeType ::= { id-at 12 }
+
+X520Title ::= CHOICE {
+ teletexString TeletexString (SIZE (1..ub-title)),
+ printableString PrintableString (SIZE (1..ub-title)),
+ universalString UniversalString (SIZE (1..ub-title)),
+ utf8String UTF8String (SIZE (1..ub-title)),
+ bmpString BMPString (SIZE (1..ub-title)) }
+
+-- Naming attributes of type X520dnQualifier
+
+id-at-dnQualifier AttributeType ::= { id-at 46 }
+
+X520dnQualifier ::= PrintableString
+
+-- Naming attributes of type X520countryName (digraph from IS 3166)
+
+id-at-countryName AttributeType ::= { id-at 6 }
+
+X520countryName ::= PrintableString (SIZE (2))
+
+-- Naming attributes of type X520SerialNumber
+
+id-at-serialNumber AttributeType ::= { id-at 5 }
+
+X520SerialNumber ::= PrintableString (SIZE (1..ub-serial-number))
+
+-- Naming attributes of type X520Pseudonym
+
+id-at-pseudonym AttributeType ::= { id-at 65 }
+
+X520Pseudonym ::= CHOICE {
+ teletexString TeletexString (SIZE (1..ub-pseudonym)),
+ printableString PrintableString (SIZE (1..ub-pseudonym)),
+ universalString UniversalString (SIZE (1..ub-pseudonym)),
+ utf8String UTF8String (SIZE (1..ub-pseudonym)),
+ bmpString BMPString (SIZE (1..ub-pseudonym)) }
+
+-- Naming attributes of type DomainComponent (from RFC 2247)
+
+id-domainComponent AttributeType ::=
+ { 0 9 2342 19200300 100 1 25 }
+
+DomainComponent ::= IA5String
+
+-- Legacy attributes
+
+pkcs-9 OBJECT IDENTIFIER ::=
+ { iso(1) member-body(2) us(840) rsadsi(113549) pkcs(1) 9 }
+
+id-emailAddress AttributeType ::= { pkcs-9 1 }
+
+EmailAddress ::= IA5String (SIZE (1..ub-emailaddress-length))
+
+-- naming data types --
+
+Name ::= CHOICE { -- only one possibility for now --
+ rdnSequence RDNSequence }
+
+RDNSequence ::= SEQUENCE OF RelativeDistinguishedName
+
+DistinguishedName ::= RDNSequence
+
+RelativeDistinguishedName ::=
+ SET SIZE (1 .. MAX) OF AttributeTypeAndValue
+
+-- Directory string type --
+
+DirectoryString ::= CHOICE {
+ teletexString TeletexString (SIZE (1..MAX)),
+ printableString PrintableString (SIZE (1..MAX)),
+ universalString UniversalString (SIZE (1..MAX)),
+ utf8String UTF8String (SIZE (1..MAX)),
+ bmpString BMPString (SIZE (1..MAX)) }
+
+-- certificate and CRL specific structures begin here
+
+Certificate ::= SEQUENCE {
+ tbsCertificate TBSCertificate,
+ signatureAlgorithm AlgorithmIdentifier,
+ signature BIT STRING }
+
+TBSCertificate ::= SEQUENCE {
+ version [0] Version DEFAULT v1,
+ serialNumber CertificateSerialNumber,
+ signature AlgorithmIdentifier,
+ issuer Name,
+ validity Validity,
+ subject Name,
+ subjectPublicKeyInfo SubjectPublicKeyInfo,
+ issuerUniqueID [1] IMPLICIT UniqueIdentifier OPTIONAL,
+ -- If present, version MUST be v2 or v3
+ subjectUniqueID [2] IMPLICIT UniqueIdentifier OPTIONAL,
+ -- If present, version MUST be v2 or v3
+ extensions [3] Extensions OPTIONAL
+ -- If present, version MUST be v3 -- }
+
+Version ::= INTEGER { v1(0), v2(1), v3(2) }
+
+CertificateSerialNumber ::= INTEGER
+
+Validity ::= SEQUENCE {
+ notBefore Time,
+ notAfter Time }
+
+Time ::= CHOICE {
+ utcTime UTCTime,
+ generalTime GeneralizedTime }
+
+UniqueIdentifier ::= BIT STRING
+
+SubjectPublicKeyInfo ::= SEQUENCE {
+ algorithm AlgorithmIdentifier,
+ subjectPublicKey BIT STRING }
+
+Extensions ::= SEQUENCE SIZE (1..MAX) OF Extension
+
+Extension ::= SEQUENCE {
+ extnID OBJECT IDENTIFIER,
+ critical BOOLEAN DEFAULT FALSE,
+ extnValue OCTET STRING }
+
+-- CRL structures
+
+CertificateList ::= SEQUENCE {
+ tbsCertList TBSCertList,
+ signatureAlgorithm AlgorithmIdentifier,
+ signature BIT STRING }
+
+TBSCertList ::= SEQUENCE {
+ version Version OPTIONAL,
+ -- if present, MUST be v2
+ signature AlgorithmIdentifier,
+ issuer Name,
+ thisUpdate Time,
+ nextUpdate Time OPTIONAL,
+ revokedCertificates SEQUENCE OF SEQUENCE {
+ userCertificate CertificateSerialNumber,
+ revocationDate Time,
+ crlEntryExtensions Extensions OPTIONAL
+ -- if present, MUST be v2
+ } OPTIONAL,
+ crlExtensions [0] Extensions OPTIONAL }
+ -- if present, MUST be v2
+
+-- Version, Time, CertificateSerialNumber, and Extensions were
+-- defined earlier for use in the certificate structure
+
+AlgorithmIdentifier ::= SEQUENCE {
+ algorithm OBJECT IDENTIFIER,
+ parameters ANY DEFINED BY algorithm OPTIONAL }
+ -- contains a value of the type
+ -- registered for use with the
+ -- algorithm object identifier value
+
+-- X.400 address syntax starts here
+
+ORAddress ::= SEQUENCE {
+ built-in-standard-attributes BuiltInStandardAttributes,
+ built-in-domain-defined-attributes
+ BuiltInDomainDefinedAttributes OPTIONAL,
+ -- see also teletex-domain-defined-attributes
+ extension-attributes ExtensionAttributes OPTIONAL }
+
+-- Built-in Standard Attributes
+
+BuiltInStandardAttributes ::= SEQUENCE {
+ country-name CountryName OPTIONAL,
+ administration-domain-name AdministrationDomainName OPTIONAL,
+ network-address [0] IMPLICIT NetworkAddress OPTIONAL,
+ -- see also extended-network-address
+ terminal-identifier [1] IMPLICIT TerminalIdentifier OPTIONAL,
+ private-domain-name [2] PrivateDomainName OPTIONAL,
+ organization-name [3] IMPLICIT OrganizationName OPTIONAL,
+ -- see also teletex-organization-name
+ numeric-user-identifier [4] IMPLICIT NumericUserIdentifier
+ OPTIONAL,
+ personal-name [5] IMPLICIT PersonalName OPTIONAL,
+ -- see also teletex-personal-name
+ organizational-unit-names [6] IMPLICIT OrganizationalUnitNames
+ OPTIONAL }
+ -- see also teletex-organizational-unit-names
+
+CountryName ::= [APPLICATION 1] CHOICE {
+ x121-dcc-code NumericString
+ (SIZE (ub-country-name-numeric-length)),
+ iso-3166-alpha2-code PrintableString
+ (SIZE (ub-country-name-alpha-length)) }
+
+AdministrationDomainName ::= [APPLICATION 2] CHOICE {
+ numeric NumericString (SIZE (0..ub-domain-name-length)),
+ printable PrintableString (SIZE (0..ub-domain-name-length)) }
+
+NetworkAddress ::= X121Address -- see also extended-network-address
+
+X121Address ::= NumericString (SIZE (1..ub-x121-address-length))
+
+TerminalIdentifier ::= PrintableString (SIZE
+(1..ub-terminal-id-length))
+
+PrivateDomainName ::= CHOICE {
+ numeric NumericString (SIZE (1..ub-domain-name-length)),
+ printable PrintableString (SIZE (1..ub-domain-name-length)) }
+
+OrganizationName ::= PrintableString
+ (SIZE (1..ub-organization-name-length))
+ -- see also teletex-organization-name
+
+NumericUserIdentifier ::= NumericString
+ (SIZE (1..ub-numeric-user-id-length))
+
+PersonalName ::= SET {
+ surname [0] IMPLICIT PrintableString
+ (SIZE (1..ub-surname-length)),
+ given-name [1] IMPLICIT PrintableString
+ (SIZE (1..ub-given-name-length)) OPTIONAL,
+ initials [2] IMPLICIT PrintableString
+ (SIZE (1..ub-initials-length)) OPTIONAL,
+ generation-qualifier [3] IMPLICIT PrintableString
+ (SIZE (1..ub-generation-qualifier-length))
+ OPTIONAL }
+ -- see also teletex-personal-name
+
+OrganizationalUnitNames ::= SEQUENCE SIZE (1..ub-organizational-units)
+ OF OrganizationalUnitName
+ -- see also teletex-organizational-unit-names
+
+OrganizationalUnitName ::= PrintableString (SIZE
+ (1..ub-organizational-unit-name-length))
+
+-- Built-in Domain-defined Attributes
+
+BuiltInDomainDefinedAttributes ::= SEQUENCE SIZE
+ (1..ub-domain-defined-attributes) OF
+ BuiltInDomainDefinedAttribute
+
+BuiltInDomainDefinedAttribute ::= SEQUENCE {
+ type PrintableString (SIZE
+ (1..ub-domain-defined-attribute-type-length)),
+ value PrintableString (SIZE
+ (1..ub-domain-defined-attribute-value-length)) }
+
+-- Extension Attributes
+
+ExtensionAttributes ::= SET SIZE (1..ub-extension-attributes) OF
+ ExtensionAttribute
+
+ExtensionAttribute ::= SEQUENCE {
+ extension-attribute-type [0] IMPLICIT INTEGER
+ (0..ub-extension-attributes),
+ extension-attribute-value [1]
+ ANY DEFINED BY extension-attribute-type }
+
+-- Extension types and attribute values
+
+common-name INTEGER ::= 1
+
+CommonName ::= PrintableString (SIZE (1..ub-common-name-length))
+
+teletex-common-name INTEGER ::= 2
+
+TeletexCommonName ::= TeletexString (SIZE (1..ub-common-name-length))
+
+teletex-organization-name INTEGER ::= 3
+
+TeletexOrganizationName ::=
+ TeletexString (SIZE (1..ub-organization-name-length))
+
+teletex-personal-name INTEGER ::= 4
+
+TeletexPersonalName ::= SET {
+ surname [0] IMPLICIT TeletexString
+ (SIZE (1..ub-surname-length)),
+ given-name [1] IMPLICIT TeletexString
+ (SIZE (1..ub-given-name-length)) OPTIONAL,
+ initials [2] IMPLICIT TeletexString
+ (SIZE (1..ub-initials-length)) OPTIONAL,
+ generation-qualifier [3] IMPLICIT TeletexString
+ (SIZE (1..ub-generation-qualifier-length))
+ OPTIONAL }
+
+teletex-organizational-unit-names INTEGER ::= 5
+
+TeletexOrganizationalUnitNames ::= SEQUENCE SIZE
+ (1..ub-organizational-units) OF TeletexOrganizationalUnitName
+
+TeletexOrganizationalUnitName ::= TeletexString
+ (SIZE (1..ub-organizational-unit-name-length))
+
+pds-name INTEGER ::= 7
+
+PDSName ::= PrintableString (SIZE (1..ub-pds-name-length))
+
+physical-delivery-country-name INTEGER ::= 8
+
+PhysicalDeliveryCountryName ::= CHOICE {
+ x121-dcc-code NumericString (SIZE
+(ub-country-name-numeric-length)),
+ iso-3166-alpha2-code PrintableString
+ (SIZE (ub-country-name-alpha-length)) }
+
+postal-code INTEGER ::= 9
+
+PostalCode ::= CHOICE {
+ numeric-code NumericString (SIZE (1..ub-postal-code-length)),
+ printable-code PrintableString (SIZE (1..ub-postal-code-length)) }
+
+physical-delivery-office-name INTEGER ::= 10
+
+PhysicalDeliveryOfficeName ::= PDSParameter
+
+physical-delivery-office-number INTEGER ::= 11
+
+PhysicalDeliveryOfficeNumber ::= PDSParameter
+
+extension-OR-address-components INTEGER ::= 12
+
+ExtensionORAddressComponents ::= PDSParameter
+
+physical-delivery-personal-name INTEGER ::= 13
+
+PhysicalDeliveryPersonalName ::= PDSParameter
+
+physical-delivery-organization-name INTEGER ::= 14
+
+PhysicalDeliveryOrganizationName ::= PDSParameter
+
+extension-physical-delivery-address-components INTEGER ::= 15
+
+ExtensionPhysicalDeliveryAddressComponents ::= PDSParameter
+
+unformatted-postal-address INTEGER ::= 16
+
+UnformattedPostalAddress ::= SET {
+ printable-address SEQUENCE SIZE (1..ub-pds-physical-address-lines)
+ OF PrintableString (SIZE (1..ub-pds-parameter-length))
+ OPTIONAL,
+ teletex-string TeletexString
+ (SIZE (1..ub-unformatted-address-length)) OPTIONAL }
+
+street-address INTEGER ::= 17
+
+StreetAddress ::= PDSParameter
+
+post-office-box-address INTEGER ::= 18
+
+PostOfficeBoxAddress ::= PDSParameter
+
+poste-restante-address INTEGER ::= 19
+
+PosteRestanteAddress ::= PDSParameter
+
+unique-postal-name INTEGER ::= 20
+
+UniquePostalName ::= PDSParameter
+
+local-postal-attributes INTEGER ::= 21
+
+LocalPostalAttributes ::= PDSParameter
+
+PDSParameter ::= SET {
+ printable-string PrintableString
+ (SIZE(1..ub-pds-parameter-length)) OPTIONAL,
+ teletex-string TeletexString
+ (SIZE(1..ub-pds-parameter-length)) OPTIONAL }
+
+extended-network-address INTEGER ::= 22
+
+ExtendedNetworkAddress ::= CHOICE {
+ e163-4-address SEQUENCE {
+ number [0] IMPLICIT NumericString
+ (SIZE (1..ub-e163-4-number-length)),
+ sub-address [1] IMPLICIT NumericString
+ (SIZE (1..ub-e163-4-sub-address-length))
+ OPTIONAL },
+ psap-address [0] IMPLICIT PresentationAddress }
+
+PresentationAddress ::= SEQUENCE {
+ pSelector [0] EXPLICIT OCTET STRING OPTIONAL,
+ sSelector [1] EXPLICIT OCTET STRING OPTIONAL,
+ tSelector [2] EXPLICIT OCTET STRING OPTIONAL,
+ nAddresses [3] EXPLICIT SET SIZE (1..MAX) OF OCTET STRING }
+
+terminal-type INTEGER ::= 23
+
+TerminalType ::= INTEGER {
+ telex (3),
+ teletex (4),
+ g3-facsimile (5),
+ g4-facsimile (6),
+ ia5-terminal (7),
+ videotex (8) } (0..ub-integer-options)
+
+-- Extension Domain-defined Attributes
+
+teletex-domain-defined-attributes INTEGER ::= 6
+
+TeletexDomainDefinedAttributes ::= SEQUENCE SIZE
+ (1..ub-domain-defined-attributes) OF TeletexDomainDefinedAttribute
+
+TeletexDomainDefinedAttribute ::= SEQUENCE {
+ type TeletexString
+ (SIZE (1..ub-domain-defined-attribute-type-length)),
+ value TeletexString
+ (SIZE (1..ub-domain-defined-attribute-value-length)) }
+
+-- specifications of Upper Bounds MUST be regarded as mandatory
+-- from Annex B of ITU-T X.411 Reference Definition of MTS Parameter
+-- Upper Bounds
+
+-- Upper Bounds
+ub-name INTEGER ::= 32768
+ub-common-name INTEGER ::= 64
+ub-locality-name INTEGER ::= 128
+ub-state-name INTEGER ::= 128
+ub-organization-name INTEGER ::= 64
+ub-organizational-unit-name INTEGER ::= 64
+ub-title INTEGER ::= 64
+ub-serial-number INTEGER ::= 64
+ub-match INTEGER ::= 128
+ub-emailaddress-length INTEGER ::= 128
+ub-common-name-length INTEGER ::= 64
+ub-country-name-alpha-length INTEGER ::= 2
+ub-country-name-numeric-length INTEGER ::= 3
+ub-domain-defined-attributes INTEGER ::= 4
+ub-domain-defined-attribute-type-length INTEGER ::= 8
+ub-domain-defined-attribute-value-length INTEGER ::= 128
+ub-domain-name-length INTEGER ::= 16
+ub-extension-attributes INTEGER ::= 256
+ub-e163-4-number-length INTEGER ::= 15
+ub-e163-4-sub-address-length INTEGER ::= 40
+ub-generation-qualifier-length INTEGER ::= 3
+ub-given-name-length INTEGER ::= 16
+ub-initials-length INTEGER ::= 5
+ub-integer-options INTEGER ::= 256
+ub-numeric-user-id-length INTEGER ::= 32
+ub-organization-name-length INTEGER ::= 64
+ub-organizational-unit-name-length INTEGER ::= 32
+ub-organizational-units INTEGER ::= 4
+ub-pds-name-length INTEGER ::= 16
+ub-pds-parameter-length INTEGER ::= 30
+ub-pds-physical-address-lines INTEGER ::= 6
+ub-postal-code-length INTEGER ::= 16
+ub-pseudonym INTEGER ::= 128
+ub-surname-length INTEGER ::= 40
+ub-terminal-id-length INTEGER ::= 24
+ub-unformatted-address-length INTEGER ::= 180
+ub-x121-address-length INTEGER ::= 16
+
+-- Note - upper bounds on string types, such as TeletexString, are
+-- measured in characters. Excepting PrintableString or IA5String, a
+-- significantly greater number of octets will be required to hold
+-- such a value. As a minimum, 16 octets, or twice the specified
+-- upper bound, whichever is the larger, should be allowed for
+-- TeletexString. For UTF8String or UniversalString at least four
+-- times the upper bound should be allowed.
+
+END
diff --git a/lib/orber/src/PKIX1Implicit88.asn1 b/lib/orber/src/PKIX1Implicit88.asn1
new file mode 100644
index 0000000000..ced270baf6
--- /dev/null
+++ b/lib/orber/src/PKIX1Implicit88.asn1
@@ -0,0 +1,349 @@
+PKIX1Implicit88 { iso(1) identified-organization(3) dod(6) internet(1)
+ security(5) mechanisms(5) pkix(7) id-mod(0) id-pkix1-implicit(19) }
+
+DEFINITIONS IMPLICIT TAGS ::=
+
+BEGIN
+
+-- EXPORTS ALL --
+
+IMPORTS
+ id-pe, id-kp, id-qt-unotice, id-qt-cps,
+ -- delete following line if "new" types are supported --
+ -- BMPString,
+ -- UTF8String, end "new" types --
+ ORAddress, Name, RelativeDistinguishedName,
+ CertificateSerialNumber, Attribute, DirectoryString
+ FROM PKIX1Explicit88 { iso(1) identified-organization(3)
+ dod(6) internet(1) security(5) mechanisms(5) pkix(7)
+ id-mod(0) id-pkix1-explicit(18) };
+
+
+-- ISO arc for standard certificate and CRL extensions
+
+id-ce OBJECT IDENTIFIER ::= {joint-iso-ccitt(2) ds(5) 29}
+
+-- authority key identifier OID and syntax
+
+id-ce-authorityKeyIdentifier OBJECT IDENTIFIER ::= { id-ce 35 }
+
+AuthorityKeyIdentifier ::= SEQUENCE {
+ keyIdentifier [0] KeyIdentifier OPTIONAL,
+ authorityCertIssuer [1] GeneralNames OPTIONAL,
+ authorityCertSerialNumber [2] CertificateSerialNumber OPTIONAL }
+ -- authorityCertIssuer and authorityCertSerialNumber MUST both
+ -- be present or both be absent
+
+KeyIdentifier ::= OCTET STRING
+
+-- subject key identifier OID and syntax
+
+id-ce-subjectKeyIdentifier OBJECT IDENTIFIER ::= { id-ce 14 }
+
+SubjectKeyIdentifier ::= KeyIdentifier
+
+-- key usage extension OID and syntax
+
+id-ce-keyUsage OBJECT IDENTIFIER ::= { id-ce 15 }
+
+KeyUsage ::= BIT STRING {
+ digitalSignature (0),
+ nonRepudiation (1),
+ keyEncipherment (2),
+ dataEncipherment (3),
+ keyAgreement (4),
+ keyCertSign (5),
+ cRLSign (6),
+ encipherOnly (7),
+ decipherOnly (8) }
+
+-- private key usage period extension OID and syntax
+
+id-ce-privateKeyUsagePeriod OBJECT IDENTIFIER ::= { id-ce 16 }
+
+PrivateKeyUsagePeriod ::= SEQUENCE {
+ notBefore [0] GeneralizedTime OPTIONAL,
+ notAfter [1] GeneralizedTime OPTIONAL }
+ -- either notBefore or notAfter MUST be present
+
+-- certificate policies extension OID and syntax
+
+id-ce-certificatePolicies OBJECT IDENTIFIER ::= { id-ce 32 }
+
+anyPolicy OBJECT IDENTIFIER ::= { id-ce-certificatePolicies 0 }
+
+CertificatePolicies ::= SEQUENCE SIZE (1..MAX) OF PolicyInformation
+
+PolicyInformation ::= SEQUENCE {
+ policyIdentifier CertPolicyId,
+ policyQualifiers SEQUENCE SIZE (1..MAX) OF
+ PolicyQualifierInfo OPTIONAL }
+
+CertPolicyId ::= OBJECT IDENTIFIER
+
+PolicyQualifierInfo ::= SEQUENCE {
+ policyQualifierId PolicyQualifierId,
+ qualifier ANY DEFINED BY policyQualifierId }
+
+-- Implementations that recognize additional policy qualifiers MUST
+-- augment the following definition for PolicyQualifierId
+
+PolicyQualifierId ::=
+ OBJECT IDENTIFIER ( id-qt-cps | id-qt-unotice )
+
+-- CPS pointer qualifier
+
+CPSuri ::= IA5String
+
+-- user notice qualifier
+
+UserNotice ::= SEQUENCE {
+ noticeRef NoticeReference OPTIONAL,
+ explicitText DisplayText OPTIONAL}
+
+NoticeReference ::= SEQUENCE {
+ organization DisplayText,
+ noticeNumbers SEQUENCE OF INTEGER }
+
+DisplayText ::= CHOICE {
+ ia5String IA5String (SIZE (1..200)),
+ visibleString VisibleString (SIZE (1..200)),
+ bmpString BMPString (SIZE (1..200)),
+ utf8String UTF8String (SIZE (1..200)) }
+
+-- policy mapping extension OID and syntax
+
+id-ce-policyMappings OBJECT IDENTIFIER ::= { id-ce 33 }
+
+PolicyMappings ::= SEQUENCE SIZE (1..MAX) OF SEQUENCE {
+ issuerDomainPolicy CertPolicyId,
+ subjectDomainPolicy CertPolicyId }
+
+-- subject alternative name extension OID and syntax
+
+id-ce-subjectAltName OBJECT IDENTIFIER ::= { id-ce 17 }
+
+SubjectAltName ::= GeneralNames
+
+GeneralNames ::= SEQUENCE SIZE (1..MAX) OF GeneralName
+
+GeneralName ::= CHOICE {
+ otherName [0] AnotherName,
+ rfc822Name [1] IA5String,
+ dNSName [2] IA5String,
+ x400Address [3] ORAddress,
+ directoryName [4] Name,
+ ediPartyName [5] EDIPartyName,
+ uniformResourceIdentifier [6] IA5String,
+ iPAddress [7] OCTET STRING,
+ registeredID [8] OBJECT IDENTIFIER }
+
+-- AnotherName replaces OTHER-NAME ::= TYPE-IDENTIFIER, as
+-- TYPE-IDENTIFIER is not supported in the '88 ASN.1 syntax
+
+AnotherName ::= SEQUENCE {
+ type-id OBJECT IDENTIFIER,
+ value [0] EXPLICIT ANY DEFINED BY type-id }
+
+EDIPartyName ::= SEQUENCE {
+ nameAssigner [0] DirectoryString OPTIONAL,
+ partyName [1] DirectoryString }
+
+-- issuer alternative name extension OID and syntax
+
+id-ce-issuerAltName OBJECT IDENTIFIER ::= { id-ce 18 }
+
+IssuerAltName ::= GeneralNames
+
+id-ce-subjectDirectoryAttributes OBJECT IDENTIFIER ::= { id-ce 9 }
+
+SubjectDirectoryAttributes ::= SEQUENCE SIZE (1..MAX) OF Attribute
+
+-- basic constraints extension OID and syntax
+
+id-ce-basicConstraints OBJECT IDENTIFIER ::= { id-ce 19 }
+
+BasicConstraints ::= SEQUENCE {
+ cA BOOLEAN DEFAULT FALSE,
+ pathLenConstraint INTEGER (0..MAX) OPTIONAL }
+
+-- name constraints extension OID and syntax
+
+id-ce-nameConstraints OBJECT IDENTIFIER ::= { id-ce 30 }
+
+NameConstraints ::= SEQUENCE {
+ permittedSubtrees [0] GeneralSubtrees OPTIONAL,
+ excludedSubtrees [1] GeneralSubtrees OPTIONAL }
+
+GeneralSubtrees ::= SEQUENCE SIZE (1..MAX) OF GeneralSubtree
+
+GeneralSubtree ::= SEQUENCE {
+ base GeneralName,
+ minimum [0] BaseDistance DEFAULT 0,
+ maximum [1] BaseDistance OPTIONAL }
+
+BaseDistance ::= INTEGER (0..MAX)
+
+-- policy constraints extension OID and syntax
+
+id-ce-policyConstraints OBJECT IDENTIFIER ::= { id-ce 36 }
+
+PolicyConstraints ::= SEQUENCE {
+ requireExplicitPolicy [0] SkipCerts OPTIONAL,
+ inhibitPolicyMapping [1] SkipCerts OPTIONAL }
+
+SkipCerts ::= INTEGER (0..MAX)
+
+-- CRL distribution points extension OID and syntax
+
+id-ce-cRLDistributionPoints OBJECT IDENTIFIER ::= {id-ce 31}
+
+CRLDistributionPoints ::= SEQUENCE SIZE (1..MAX) OF DistributionPoint
+
+DistributionPoint ::= SEQUENCE {
+ distributionPoint [0] DistributionPointName OPTIONAL,
+ reasons [1] ReasonFlags OPTIONAL,
+ cRLIssuer [2] GeneralNames OPTIONAL }
+
+DistributionPointName ::= CHOICE {
+ fullName [0] GeneralNames,
+ nameRelativeToCRLIssuer [1] RelativeDistinguishedName }
+
+ReasonFlags ::= BIT STRING {
+ unused (0),
+ keyCompromise (1),
+ cACompromise (2),
+ affiliationChanged (3),
+ superseded (4),
+ cessationOfOperation (5),
+ certificateHold (6),
+ privilegeWithdrawn (7),
+ aACompromise (8) }
+
+-- extended key usage extension OID and syntax
+
+id-ce-extKeyUsage OBJECT IDENTIFIER ::= {id-ce 37}
+
+ExtKeyUsageSyntax ::= SEQUENCE SIZE (1..MAX) OF KeyPurposeId
+
+
+KeyPurposeId ::= OBJECT IDENTIFIER
+
+-- permit unspecified key uses
+
+anyExtendedKeyUsage OBJECT IDENTIFIER ::= { id-ce-extKeyUsage 0 }
+
+-- extended key purpose OIDs
+
+id-kp-serverAuth OBJECT IDENTIFIER ::= { id-kp 1 }
+id-kp-clientAuth OBJECT IDENTIFIER ::= { id-kp 2 }
+id-kp-codeSigning OBJECT IDENTIFIER ::= { id-kp 3 }
+id-kp-emailProtection OBJECT IDENTIFIER ::= { id-kp 4 }
+id-kp-timeStamping OBJECT IDENTIFIER ::= { id-kp 8 }
+id-kp-OCSPSigning OBJECT IDENTIFIER ::= { id-kp 9 }
+
+-- inhibit any policy OID and syntax
+
+id-ce-inhibitAnyPolicy OBJECT IDENTIFIER ::= { id-ce 54 }
+
+InhibitAnyPolicy ::= SkipCerts
+
+-- freshest (delta)CRL extension OID and syntax
+
+id-ce-freshestCRL OBJECT IDENTIFIER ::= { id-ce 46 }
+
+FreshestCRL ::= CRLDistributionPoints
+
+-- authority info access
+
+id-pe-authorityInfoAccess OBJECT IDENTIFIER ::= { id-pe 1 }
+
+AuthorityInfoAccessSyntax ::=
+ SEQUENCE SIZE (1..MAX) OF AccessDescription
+
+AccessDescription ::= SEQUENCE {
+ accessMethod OBJECT IDENTIFIER,
+ accessLocation GeneralName }
+
+-- subject info access
+
+id-pe-subjectInfoAccess OBJECT IDENTIFIER ::= { id-pe 11 }
+
+SubjectInfoAccessSyntax ::=
+ SEQUENCE SIZE (1..MAX) OF AccessDescription
+
+-- CRL number extension OID and syntax
+
+id-ce-cRLNumber OBJECT IDENTIFIER ::= { id-ce 20 }
+
+CRLNumber ::= INTEGER (0..MAX)
+
+-- issuing distribution point extension OID and syntax
+
+id-ce-issuingDistributionPoint OBJECT IDENTIFIER ::= { id-ce 28 }
+
+IssuingDistributionPoint ::= SEQUENCE {
+ distributionPoint [0] DistributionPointName OPTIONAL,
+ onlyContainsUserCerts [1] BOOLEAN DEFAULT FALSE,
+ onlyContainsCACerts [2] BOOLEAN DEFAULT FALSE,
+ onlySomeReasons [3] ReasonFlags OPTIONAL,
+ indirectCRL [4] BOOLEAN DEFAULT FALSE,
+ onlyContainsAttributeCerts [5] BOOLEAN DEFAULT FALSE }
+
+id-ce-deltaCRLIndicator OBJECT IDENTIFIER ::= { id-ce 27 }
+
+BaseCRLNumber ::= CRLNumber
+
+-- CRL reasons extension OID and syntax
+
+id-ce-cRLReasons OBJECT IDENTIFIER ::= { id-ce 21 }
+
+CRLReason ::= ENUMERATED {
+ unspecified (0),
+ keyCompromise (1),
+ cACompromise (2),
+ affiliationChanged (3),
+ superseded (4),
+ cessationOfOperation (5),
+ certificateHold (6),
+ removeFromCRL (8),
+ privilegeWithdrawn (9),
+ aACompromise (10) }
+
+-- certificate issuer CRL entry extension OID and syntax
+
+id-ce-certificateIssuer OBJECT IDENTIFIER ::= { id-ce 29 }
+
+CertificateIssuer ::= GeneralNames
+
+-- hold instruction extension OID and syntax
+
+id-ce-holdInstructionCode OBJECT IDENTIFIER ::= { id-ce 23 }
+
+HoldInstructionCode ::= OBJECT IDENTIFIER
+
+-- ANSI x9 holdinstructions
+
+-- ANSI x9 arc holdinstruction arc
+
+holdInstruction OBJECT IDENTIFIER ::=
+ {joint-iso-itu-t(2) member-body(2) us(840) x9cm(10040) 2}
+
+-- ANSI X9 holdinstructions referenced by this standard
+
+id-holdinstruction-none OBJECT IDENTIFIER ::=
+ {holdInstruction 1} -- deprecated
+
+id-holdinstruction-callissuer OBJECT IDENTIFIER ::=
+ {holdInstruction 2}
+
+id-holdinstruction-reject OBJECT IDENTIFIER ::=
+ {holdInstruction 3}
+
+-- invalidity date CRL entry extension OID and syntax
+
+id-ce-invalidityDate OBJECT IDENTIFIER ::= { id-ce 24 }
+
+InvalidityDate ::= GeneralizedTime
+
+END
diff --git a/lib/orber/src/PKIXAttributeCertificate.asn1 b/lib/orber/src/PKIXAttributeCertificate.asn1
new file mode 100644
index 0000000000..7d93e6b37e
--- /dev/null
+++ b/lib/orber/src/PKIXAttributeCertificate.asn1
@@ -0,0 +1,189 @@
+ PKIXAttributeCertificate {iso(1) identified-organization(3) dod(6)
+ internet(1) security(5) mechanisms(5) pkix(7) id-mod(0)
+ id-mod-attribute-cert(12)}
+
+ DEFINITIONS IMPLICIT TAGS ::=
+
+ BEGIN
+
+ -- EXPORTS ALL --
+
+ IMPORTS
+
+ -- IMPORTed module OIDs MAY change if [PKIXPROF] changes
+ -- PKIX Certificate Extensions
+ Attribute, AlgorithmIdentifier, CertificateSerialNumber,
+ Extensions, UniqueIdentifier,
+ id-pkix, id-pe, id-kp, id-ad, id-at
+ FROM PKIX1Explicit88 {iso(1) identified-organization(3)
+ dod(6) internet(1) security(5) mechanisms(5)
+ pkix(7) id-mod(0) id-pkix1-explicit-88(1)}
+
+ GeneralName, GeneralNames, id-ce
+ FROM PKIX1Implicit88 {iso(1) identified-organization(3)
+ dod(6) internet(1) security(5) mechanisms(5)
+ pkix(7) id-mod(0) id-pkix1-implicit-88(2)} ;
+
+ id-pe-ac-auditIdentity OBJECT IDENTIFIER ::= { id-pe 4 }
+ id-pe-aaControls OBJECT IDENTIFIER ::= { id-pe 6 }
+ id-pe-ac-proxying OBJECT IDENTIFIER ::= { id-pe 10 }
+ id-ce-targetInformation OBJECT IDENTIFIER ::= { id-ce 55 }
+
+ id-aca OBJECT IDENTIFIER ::= { id-pkix 10 }
+ id-aca-authenticationInfo OBJECT IDENTIFIER ::= { id-aca 1 }
+ id-aca-accessIdentity OBJECT IDENTIFIER ::= { id-aca 2 }
+ id-aca-chargingIdentity OBJECT IDENTIFIER ::= { id-aca 3 }
+ id-aca-group OBJECT IDENTIFIER ::= { id-aca 4 }
+ -- { id-aca 5 } is reserved
+ id-aca-encAttrs OBJECT IDENTIFIER ::= { id-aca 6 }
+
+ id-at-role OBJECT IDENTIFIER ::= { id-at 72}
+ id-at-clearance OBJECT IDENTIFIER ::=
+ { joint-iso-ccitt(2) ds(5) module(1)
+ selected-attribute-types(5) clearance (55) }
+
+ -- Uncomment this if using a 1988 level ASN.1 compiler
+ -- UTF8String ::= [UNIVERSAL 12] IMPLICIT OCTET STRING
+
+ AttributeCertificate ::= SEQUENCE {
+ acinfo AttributeCertificateInfo,
+ signatureAlgorithm AlgorithmIdentifier,
+ signatureValue BIT STRING
+ }
+
+ AttributeCertificateInfo ::= SEQUENCE {
+ version AttCertVersion, -- version is v2
+ holder Holder,
+ issuer AttCertIssuer,
+ signature AlgorithmIdentifier,
+ serialNumber CertificateSerialNumber,
+ attrCertValidityPeriod AttCertValidityPeriod,
+ attributes SEQUENCE OF Attribute,
+ issuerUniqueID UniqueIdentifier OPTIONAL,
+ extensions Extensions OPTIONAL
+ }
+
+ AttCertVersion ::= INTEGER { v2(1) }
+
+ Holder ::= SEQUENCE {
+ baseCertificateID [0] IssuerSerial OPTIONAL,
+ -- the issuer and serial number of
+ -- the holder's Public Key Certificate
+ entityName [1] GeneralNames OPTIONAL,
+ -- the name of the claimant or role
+ objectDigestInfo [2] ObjectDigestInfo OPTIONAL
+ -- used to directly authenticate the
+ -- holder, for example, an executable
+ }
+
+ ObjectDigestInfo ::= SEQUENCE {
+ digestedObjectType ENUMERATED {
+ publicKey (0),
+ publicKeyCert (1),
+ otherObjectTypes (2) },
+ -- otherObjectTypes MUST NOT
+ -- MUST NOT be used in this profile
+ otherObjectTypeID OBJECT IDENTIFIER OPTIONAL,
+ digestAlgorithm AlgorithmIdentifier,
+ objectDigest BIT STRING
+ }
+
+ AttCertIssuer ::= CHOICE {
+ v1Form GeneralNames, -- MUST NOT be used in this
+ -- profile
+ v2Form [0] V2Form -- v2 only
+ }
+
+ V2Form ::= SEQUENCE {
+ issuerName GeneralNames OPTIONAL,
+ baseCertificateID [0] IssuerSerial OPTIONAL,
+ objectDigestInfo [1] ObjectDigestInfo OPTIONAL
+ -- issuerName MUST be present in this profile
+ -- baseCertificateID and objectDigestInfo MUST
+ -- NOT be present in this profile
+ }
+
+ IssuerSerial ::= SEQUENCE {
+ issuer GeneralNames,
+ serial CertificateSerialNumber,
+ issuerUID UniqueIdentifier OPTIONAL
+ }
+
+ AttCertValidityPeriod ::= SEQUENCE {
+ notBeforeTime GeneralizedTime,
+ notAfterTime GeneralizedTime
+ }
+
+ Targets ::= SEQUENCE OF Target
+
+ Target ::= CHOICE {
+ targetName [0] GeneralName,
+ targetGroup [1] GeneralName,
+ targetCert [2] TargetCert
+ }
+
+ TargetCert ::= SEQUENCE {
+ targetCertificate IssuerSerial,
+ targetName GeneralName OPTIONAL,
+ certDigestInfo ObjectDigestInfo OPTIONAL
+ }
+
+ IetfAttrSyntax ::= SEQUENCE {
+ policyAuthority[0] GeneralNames OPTIONAL,
+ values SEQUENCE OF CHOICE {
+ octets OCTET STRING,
+ oid OBJECT IDENTIFIER,
+ string UTF8String
+ }
+ }
+
+ SvceAuthInfo ::= SEQUENCE {
+ service GeneralName,
+ ident GeneralName,
+ authInfo OCTET STRING OPTIONAL
+ }
+
+ RoleSyntax ::= SEQUENCE {
+ roleAuthority [0] GeneralNames OPTIONAL,
+ roleName [1] GeneralName
+ }
+
+ Clearance ::= SEQUENCE {
+ policyId [0] OBJECT IDENTIFIER,
+ classList [1] ClassList DEFAULT {unclassified},
+ securityCategories
+ [2] SET OF SecurityCategory OPTIONAL
+ }
+
+ ClassList ::= BIT STRING {
+ unmarked (0),
+ unclassified (1),
+ restricted (2),
+ confidential (3),
+ secret (4),
+ topSecret (5)
+ }
+
+ SecurityCategory ::= SEQUENCE {
+ type [0] IMPLICIT OBJECT IDENTIFIER,
+ value [1] ANY DEFINED BY type
+ }
+
+ AAControls ::= SEQUENCE {
+ pathLenConstraint INTEGER (0..MAX) OPTIONAL,
+ permittedAttrs [0] AttrSpec OPTIONAL,
+ excludedAttrs [1] AttrSpec OPTIONAL,
+ permitUnSpecified BOOLEAN DEFAULT TRUE
+ }
+
+ AttrSpec::= SEQUENCE OF OBJECT IDENTIFIER
+
+ ACClearAttrs ::= SEQUENCE {
+ acIssuer GeneralName,
+ acSerial INTEGER,
+ attrs SEQUENCE OF Attribute
+ }
+
+ ProxyInfo ::= SEQUENCE OF Targets
+
+ END
diff --git a/lib/orber/src/any.erl b/lib/orber/src/any.erl
new file mode 100644
index 0000000000..b5ad34365b
--- /dev/null
+++ b/lib/orber/src/any.erl
@@ -0,0 +1,73 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: any.erl
+%% Description:
+%% This file conatins the interface for the any type
+%%
+%%-----------------------------------------------------------------
+-module(any).
+
+-include_lib("orber/include/corba.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([create/0, create/2,
+ set_typecode/2, get_typecode/1,
+ set_value/2, get_value/1]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([]).
+
+%%-----------------------------------------------------------------
+%% External functions
+%%-----------------------------------------------------------------
+create() ->
+ #any{}.
+
+create(TC, V) ->
+ case orber_tc:check_tc(TC) of
+ true ->
+ #any{typecode=TC, value=V};
+ false ->
+ corba:raise(#'BAD_TYPECODE'{completion_status=?COMPLETED_NO})
+ end.
+
+set_typecode(Any, TC) ->
+ case orber_tc:check_tc(TC) of
+ true ->
+ Any#any{typecode=TC};
+ false ->
+ corba:raise(#'BAD_TYPECODE'{completion_status=?COMPLETED_NO})
+ end.
+
+get_typecode(Any) ->
+ Any#any.typecode.
+
+set_value(Any, V) ->
+ Any#any{value=V}.
+
+get_value(Any) ->
+ Any#any.value.
+
diff --git a/lib/orber/src/cdr_decode.erl b/lib/orber/src/cdr_decode.erl
new file mode 100644
index 0000000000..9d30098940
--- /dev/null
+++ b/lib/orber/src/cdr_decode.erl
@@ -0,0 +1,1487 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: cdr_decode.erl
+%%
+%% Description:
+%% This file contains all decoding functions for the CDR
+%% format.
+%%
+%%-----------------------------------------------------------------
+-module(cdr_decode).
+
+-include_lib("orber/src/orber_iiop.hrl").
+-include_lib("orber/include/ifr_types.hrl").
+-include_lib("orber/include/corba.hrl").
+
+-include_lib("orber/src/ifr_objects.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([dec_giop_message_header/1, dec_reply_header/4,
+ dec_reply_body/6, dec_locate_reply_header/4,
+ dec_locate_reply_body/5, dec_message_header/3, dec_request_body/6,
+ dec_octet_sequence_bin/6, dec_message/2, peek_request_id/2]).
+
+%%-----------------------------------------------------------------
+%% Functions which only are exported for the testcases.
+%%-----------------------------------------------------------------
+-export([dec_type/5, dec_byte_order/1, dec_system_exception/4, dec_user_exception/4,
+ dec_byte_order_list/1]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+
+%%-----------------------------------------------------------------
+%% Macros
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 9).
+
+-define(ODD(N), (N rem 2) == 1).
+
+%%-----------------------------------------------------------------
+%% Func: dec_message/3
+%% Args:
+%% TypeCodes - is the type_codes of the return value and out parameters
+%% when one decodes a reply.
+%% Bytes - is the the message as a byte sequence.
+%% Returns:
+%% A tupple which contains the decoded message,
+%% {ok, Header, Parameters, TypeCodes}.
+%%-----------------------------------------------------------------
+dec_message(TypeCodes, Bytes) ->
+ Message = dec_giop_message_header(Bytes),
+ case Message#giop_message.message_type of
+ ?GIOP_MSG_REQUEST ->
+ {Version, ReqHdr, Rest, Len, ByteOrder} =
+ dec_request_header(Message#giop_message.giop_version,
+ Message#giop_message.message, ?GIOP_HEADER_SIZE,
+ Message#giop_message.byte_order, Bytes),
+ dec_request_body(Version, ReqHdr, Rest, Len, ByteOrder, Bytes);
+ ?GIOP_MSG_REPLY ->
+ dec_reply(Message#giop_message.giop_version,
+ TypeCodes, Message#giop_message.message, ?GIOP_HEADER_SIZE,
+ Message#giop_message.byte_order);
+ ?GIOP_MSG_CANCEL_REQUEST ->
+ dec_cancel_request(Message#giop_message.giop_version,
+ Message#giop_message.message, ?GIOP_HEADER_SIZE,
+ Message#giop_message.byte_order);
+ ?GIOP_MSG_LOCATE_REQUEST ->
+ dec_locate_request(Message#giop_message.giop_version,
+ Message#giop_message.message, ?GIOP_HEADER_SIZE,
+ Message#giop_message.byte_order);
+ ?GIOP_MSG_LOCATE_REPLY ->
+ dec_locate_reply(Message#giop_message.giop_version,
+ Message#giop_message.message, ?GIOP_HEADER_SIZE,
+ Message#giop_message.byte_order);
+ ?GIOP_MSG_CLOSE_CONNECTION ->
+ 'close_connection';
+ ?GIOP_MSG_MESSAGE_ERROR ->
+ 'message_error';
+ ?GIOP_MSG_FRAGMENT ->
+ dec_fragment_header(Message#giop_message.giop_version,
+ Message#giop_message.message, ?GIOP_HEADER_SIZE,
+ Message#giop_message.byte_order, Bytes)
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: dec_giop_message_header/1
+%% Args:
+%% Bytes - is the the message as a byte sequence.
+%% Returns:
+%% A giop_message record.
+%%-----------------------------------------------------------------
+%% Magic|Version|BO| Type | Size | Body
+dec_giop_message_header(<<"GIOP",1:8,0:8,1:8,MessType:8,
+ MessSize:32/little-unsigned-integer,Message/binary>>) ->
+ #giop_message{magic = "GIOP", giop_version = {1,0},
+ byte_order = little, message_type = MessType,
+ message_size = MessSize, message = Message};
+dec_giop_message_header(<<"GIOP",1:8,0:8,0:8,MessType:8,
+ MessSize:32/big-unsigned-integer,Message/binary>>) ->
+ #giop_message{magic = "GIOP", giop_version = {1,0},
+ byte_order = big, message_type = MessType,
+ message_size = MessSize, message = Message};
+dec_giop_message_header(<<"GIOP",1:8,Minor:8,Flags:8,MessType:8,
+ MessSize:32/little-unsigned-integer,Message/binary>>) when
+ ((Flags band 16#01) == 16#01) ->
+ #giop_message{magic = "GIOP", giop_version = {1,Minor},
+ byte_order = little, fragments = ((Flags band 16#02) == 16#02),
+ message_type = MessType, message_size = MessSize, message = Message};
+dec_giop_message_header(<<"GIOP",1:8,Minor:8,Flags:8,MessType:8,
+ MessSize:32/big-unsigned-integer,Message/binary>>) ->
+ #giop_message{magic = "GIOP", giop_version = {1,Minor},
+ byte_order = big, fragments = ((Flags band 16#02) == 16#02),
+ message_type = MessType, message_size = MessSize, message = Message};
+dec_giop_message_header(<<Hdr:?GIOP_HEADER_SIZE/binary, _Body/binary>>) ->
+ orber:dbg("[~p] cdr_decode:dec_giop_message_header(~p);~n"
+ "Orber cannot decode the GIOP-header.", [?LINE, Hdr], ?DEBUG_LEVEL),
+ exit(message_error);
+dec_giop_message_header(Other) ->
+ orber:dbg("[~p] cdr_decode:dec_giop_message_header(~p);~n"
+ "Orber cannot decode the GIOP-header.", [?LINE, Other], ?DEBUG_LEVEL),
+ exit(message_error).
+
+
+peek_request_id(big, <<ReqId:32/big-unsigned-integer,_/binary>>) ->
+ ReqId;
+peek_request_id(little, <<ReqId:32/little-unsigned-integer,_/binary>>) ->
+ ReqId.
+
+%%-----------------------------------------------------------------
+%% Func: dec_message_header/2
+%% Args:
+%% Header - #giop_message{}
+%% Bytes - is the the message body as a byte sequence.
+%% Returns:
+%%-----------------------------------------------------------------
+dec_message_header(TypeCodes, Message, Bytes) ->
+ case Message#giop_message.message_type of
+ ?GIOP_MSG_REQUEST ->
+ dec_request_header(Message#giop_message.giop_version,
+ Message#giop_message.message, ?GIOP_HEADER_SIZE,
+ Message#giop_message.byte_order, Bytes);
+ ?GIOP_MSG_REPLY ->
+ dec_reply(Message#giop_message.giop_version,
+ TypeCodes, Message#giop_message.message, ?GIOP_HEADER_SIZE,
+ Message#giop_message.byte_order);
+ ?GIOP_MSG_CANCEL_REQUEST ->
+ dec_cancel_request(Message#giop_message.giop_version,
+ Message#giop_message.message, ?GIOP_HEADER_SIZE,
+ Message#giop_message.byte_order);
+ ?GIOP_MSG_LOCATE_REQUEST ->
+ dec_locate_request(Message#giop_message.giop_version,
+ Message#giop_message.message, ?GIOP_HEADER_SIZE,
+ Message#giop_message.byte_order);
+ ?GIOP_MSG_LOCATE_REPLY ->
+ dec_locate_reply(Message#giop_message.giop_version,
+ Message#giop_message.message, ?GIOP_HEADER_SIZE,
+ Message#giop_message.byte_order);
+ ?GIOP_MSG_CLOSE_CONNECTION ->
+ 'close_connection';
+ ?GIOP_MSG_MESSAGE_ERROR ->
+ 'message_error';
+ ?GIOP_MSG_FRAGMENT ->
+ dec_fragment_header(Message#giop_message.giop_version,
+ Message#giop_message.message, ?GIOP_HEADER_SIZE,
+ Message#giop_message.byte_order, Bytes)
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Func: dec_byte_order/1
+%% Args:
+%% The message as a byte sequence.
+%% Returns:
+%% A tuple {Endianess, Rest} where Endianess is big or little.
+%% Rest is the remaining message byte sequence.
+%%-----------------------------------------------------------------
+dec_byte_order(<<0:8,T/binary>>) ->
+ {big, T};
+dec_byte_order(<<1:8,T/binary>>) ->
+ {little, T}.
+
+%%-----------------------------------------------------------------
+%% Func: dec_byte_order_list/1
+%% Args:
+%% The message as a byte sequence.
+%% Returns:
+%% A tuple {Endianess, Rest} where Endianess is big or little.
+%% Rest is the remaining message byte sequence.
+%%-----------------------------------------------------------------
+dec_byte_order_list([0|T]) ->
+ {big, T};
+dec_byte_order_list([1|T]) ->
+ {little, T}.
+
+%%-----------------------------------------------------------------
+%% Func : dec_response_flags
+%% Args :
+%% Returns : boolean
+%%-----------------------------------------------------------------
+%% FIX ME!! Not correct flag handling.
+dec_response_flags(_Version, <<0:8, Rest/binary>>, Len) ->
+ {false, Rest, Len+1};
+dec_response_flags(_Version, <<1:8, Rest/binary>>, Len) ->
+ {true_oneway, Rest, Len+1};
+dec_response_flags(_Version, <<3:8, Rest/binary>>, Len) ->
+ {true, Rest, Len+1};
+dec_response_flags(_Version, <<X:8, Rest/binary>>, Len) ->
+ %% Not only the Response flag is set, test which.
+ if
+ %% Since the 6 most significant bits are unused we'll accept this for now.
+ ((X band 16#03) == 16#03) ->
+ {true, Rest, Len+1};
+ ((X band 16#01) == 16#01) ->
+ {true_oneway, Rest, Len+1};
+ true ->
+ {false, Rest, Len+1}
+ end.
+
+%%-----------------------------------------------------------------
+%% Func : dec_target_addr
+%% Args : Octet
+%% Returns : boolean
+%%-----------------------------------------------------------------
+dec_target_addr(Version, Message, Len, ByteOrder, RequestId, Type) ->
+ case dec_type(?TARGETADDRESS, Version, Message, Len, ByteOrder, [], 0) of
+ {#'GIOP_TargetAddress'{label = ?GIOP_KeyAddr, value = KeyAddr}, Rest3, Len3, C} ->
+ {dec_target_key(KeyAddr, RequestId, Version, Type), Rest3, Len3, C};
+ {#'GIOP_TargetAddress'{label = ?GIOP_ProfileAddr,
+ value = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
+ profile_data=PA}},
+ Rest3, Len3, C} ->
+ {dec_target_key(PA, RequestId, Version, Type), Rest3, Len3, C};
+ {#'GIOP_TargetAddress'{label = ?GIOP_ReferenceAddr,
+ value = #'GIOP_IORAddressingInfo'{
+ selected_profile_index = _PI,
+ ior = IOR}}, Rest3, Len3, C} ->
+ {dec_target_key(iop_ior:get_objkey(IOR), RequestId, Version, Type),
+ Rest3, Len3, C};
+ Other ->
+ orber:dbg("[~p] cdr_decode:dec_target_addr(~p);~n"
+ "Unsupported TargetAddress.", [?LINE, Other], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 12), completion_status=?COMPLETED_MAYBE})
+ end.
+
+%%-----------------------------------------------------------------
+%% Func : dec_target_key
+%% Args : Octet
+%% Returns : boolean
+%%-----------------------------------------------------------------
+dec_target_key(Key, RequestId, Version, Type) ->
+ %% The Type argument is used as an identifier of which operation it is.
+ %% We need it to be able to tell the difference if it's, for example,
+ %% a request or locate-request.
+ case corba:string_to_objkey_local(Key) of
+ {location_forward, Object} ->
+ throw({Type, Object, RequestId, Version, Key});
+ ObjRef ->
+ ObjRef
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: dec_request_header/3
+%% Args:
+%% Message - The message
+%% Len0 - Number of bytes already read.
+%% ByteOrder - little or big
+%% Returns:
+%%-----------------------------------------------------------------
+dec_request_header(Version, Message, Len0, ByteOrder, _Buffer) when Version == {1,2} ->
+ {Request_id, Rest1, Len1, _} = dec_type('tk_ulong', Version, Message, Len0,
+ ByteOrder, [], 0),
+ {ResponseFlags, Rest2, Len2} = dec_response_flags(Version, Rest1, Len1),
+ {_, Rest2b, Len2b, _} = dec_type({'tk_array', 'tk_octet', 3}, Version, Rest2, Len2, ByteOrder, [], 0),
+ {Object_key, Rest3, Len3, _} = dec_target_addr(Version, Rest2b, Len2b, ByteOrder, Request_id,
+ 'location_forward'),
+ {Operation, Rest4, Len4, _} = dec_type({'tk_string', 0}, Version, Rest3, Len3, ByteOrder, [], 0),
+ {Context, Rest5, Len5} = dec_service_context(Version, Rest4, Len4, ByteOrder),
+ {Version, #request_header{service_context=Context,
+ request_id=Request_id,
+ response_expected=ResponseFlags,
+ object_key=Object_key,
+ operation=list_to_atom(Operation),
+ requesting_principal=""}, Rest5, Len5, ByteOrder};
+dec_request_header(Version, Message, Len0, ByteOrder, _Buffer) ->
+ {Context, Rest1, Len1} = dec_service_context(Version, Message, Len0, ByteOrder),
+ {Request_id, Rest2, Len2, _} = dec_type('tk_ulong', Version, Rest1, Len1, ByteOrder, [], 0),
+ {Response_expected, Rest3, Len3, _} = dec_type('tk_boolean', Version, Rest2, Len2,
+ ByteOrder, [], 0),
+ {ObjKey, Rest4, Len4, _} = dec_type({'tk_sequence', 'tk_octet', 0}, Version, Rest3,
+ Len3, ByteOrder, [], 0),
+ Object_key = dec_target_key(ObjKey, Request_id, Version, 'location_forward'),
+ {Operation, Rest5, Len5, _} = dec_type({'tk_string', 0}, Version, Rest4, Len4, ByteOrder, [], 0),
+ {Principal, Rest, Len, _} = dec_type({'tk_string', 0}, Version, Rest5,Len5, ByteOrder, [], 0),
+ {Version, #request_header{service_context=Context,
+ request_id=Request_id,
+ response_expected=Response_expected,
+ object_key=Object_key,
+ operation=list_to_atom(Operation),
+ requesting_principal=Principal}, Rest, Len, ByteOrder}.
+
+
+%%-----------------------------------------------------------------
+%% Func: dec_service_context/4
+%% Args: Version - e.g. 1.2
+%% Message - The message
+%% Len - Number of bytes already read.
+%% ByteOrder - little or big
+%% Returns:
+%%-----------------------------------------------------------------
+dec_service_context(Version, Message, Len, ByteOrder) ->
+ {Context, Rest, Len1} = dec_type(?IOP_SERVICECONTEXT, Version, Message,
+ Len, ByteOrder),
+ {dec_used_contexts(Version, Context, []), Rest, Len1}.
+
+dec_used_contexts(_Version, [], Ctxs) ->
+ Ctxs;
+dec_used_contexts({1,0}, [#'IOP_ServiceContext'{context_id=?IOP_CodeSets}|T], Ctxs) ->
+ %% Not supported by 1.0, drop it.
+ dec_used_contexts({1,0}, T, Ctxs);
+dec_used_contexts(Version, [#'IOP_ServiceContext'{context_id=?IOP_CodeSets,
+ context_data = Bytes}|T], Ctxs) ->
+ {ByteOrder, Rest} = dec_byte_order(list_to_binary(Bytes)),
+ {CodeCtx, _, _} = dec_type(?CONV_FRAME_CODESETCONTEXT, Version,
+ Rest, 1, ByteOrder),
+ dec_used_contexts(Version, T,
+ [#'IOP_ServiceContext'{context_id=?IOP_CodeSets,
+ context_data = CodeCtx}|Ctxs]);
+dec_used_contexts(Version, [#'IOP_ServiceContext'{context_id=?IOP_BI_DIR_IIOP,
+ context_data = Bytes}|T], Ctxs) ->
+ {ByteOrder, Rest} = dec_byte_order(list_to_binary(Bytes)),
+ {BiDirCtx, _, _} = dec_type(?IIOP_BIDIRIIOPSERVICECONTEXT, Version,
+ Rest, 1, ByteOrder),
+ dec_used_contexts(Version, T,
+ [#'IOP_ServiceContext'{context_id=?IOP_BI_DIR_IIOP,
+ context_data = BiDirCtx}|Ctxs]);
+dec_used_contexts(Version, [#'IOP_ServiceContext'{context_id=?IOP_FT_REQUEST,
+ context_data = Bytes}|T], Ctxs) ->
+ {ByteOrder, Rest} = dec_byte_order(list_to_binary(Bytes)),
+ {Ctx, _, _} = dec_type(?FT_FTRequestServiceContext, Version,
+ Rest, 1, ByteOrder),
+ dec_used_contexts(Version, T,
+ [#'IOP_ServiceContext'{context_id=?IOP_FT_REQUEST,
+ context_data = Ctx}|Ctxs]);
+dec_used_contexts(Version, [#'IOP_ServiceContext'{context_id=?IOP_FT_GROUP_VERSION,
+ context_data = Bytes}|T], Ctxs) ->
+ {ByteOrder, Rest} = dec_byte_order(list_to_binary(Bytes)),
+ {Ctx, _, _} = dec_type(?FT_FTGroupVersionServiceContext, Version,
+ Rest, 1, ByteOrder),
+ dec_used_contexts(Version, T,
+ [#'IOP_ServiceContext'{context_id=?IOP_FT_GROUP_VERSION,
+ context_data = Ctx}|Ctxs]);
+dec_used_contexts(Version, [#'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
+ context_data = Bytes}|T], Ctxs) ->
+ {ByteOrder, Rest} = dec_byte_order(list_to_binary(Bytes)),
+ {Ctx, _, _} = dec_type(?CSI_SASContextBody, Version,
+ Rest, 1, ByteOrder),
+ dec_used_contexts(Version, T,
+ [#'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
+ context_data = Ctx}|Ctxs]);
+dec_used_contexts(Version, [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
+ context_data = Bytes}|T], Ctxs) ->
+ {ByteOrder, Rest} = dec_byte_order(list_to_binary(Bytes)),
+ {Ctx, _, _} = dec_type(?ORBER_GENERIC_CTX, Version,
+ Rest, 1, ByteOrder),
+ dec_used_contexts(Version, T,
+ [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
+ context_data = binary_to_term(list_to_binary(Ctx))}|Ctxs]);
+dec_used_contexts(Version, [H|T], Ctxs) ->
+ dec_used_contexts(Version, T, [H|Ctxs]).
+
+%%-----------------------------------------------------------------
+%% Func: dec_request_body
+%% Args: Version - e.g. 1.2
+%% Returns:
+%%-----------------------------------------------------------------
+dec_request_body(Version, ReqHdr, Rest, Len, ByteOrder, Buffer) ->
+ {Parameters, TypeCodes, _} =
+ dec_request_body(Version, ReqHdr#request_header.object_key,
+ ReqHdr#request_header.operation,
+ Rest, Len, ByteOrder, Buffer, Len),
+ {Version, ReqHdr, Parameters, TypeCodes}.
+
+dec_request_body(Version, Object_key, Operation, Body, Len, ByteOrder, Buffer, Counter)
+ when Version == {1,2} ->
+ case orber_typedefs:get_op_def(Object_key, Operation) of
+ {RetType, [], OutParameters} ->
+ {[], {RetType, [], OutParameters}, Len};
+ {RetType, InParameters, OutParameters} ->
+ {Rest, Len1, NewC} = dec_align(Body, Len, 8, Counter),
+ {Parameters, Len2} = dec_parameters(Version, InParameters, Rest, Len1,
+ ByteOrder, Buffer, NewC),
+ {Parameters, {RetType, InParameters, OutParameters}, Len2}
+ end;
+dec_request_body(Version, Object_key, Operation, Body, Len, ByteOrder, Buffer, Counter) ->
+ {RetType, InParameters, OutParameters} =
+ orber_typedefs:get_op_def(Object_key, Operation),
+ {Parameters, Len1} = dec_parameters(Version, InParameters, Body, Len, ByteOrder, Buffer, Counter),
+ {Parameters, {RetType, InParameters, OutParameters}, Len1}.
+
+dec_parameters(_, [], _, Len, _, _, _) ->
+ {[], Len};
+dec_parameters(Version, [P1 |InParList], Body, Len, ByteOrder, Buffer, Counter) ->
+ {Object, Rest, Len1, NewCounter} = dec_type(P1, Version, Body, Len, ByteOrder, Buffer, Counter),
+ {List, Len2} = dec_parameters(Version, InParList, Rest, Len1, ByteOrder, Buffer, NewCounter),
+ {[Object | List], Len2}.
+
+%%-----------------------------------------------------------------
+%% Func: dec_reply/5
+%% Args:
+%% Message - The message
+%% Len0 - Number of bytes already read.
+%% ByteOrder - little or big
+%% Returns:
+%% A tuple {ReplyHeader, Result} where ReplyHeader is a
+%% reply_header record and Result the decode result.
+%%-----------------------------------------------------------------
+dec_reply(Version, TypeCodes, Message, Len0, ByteOrder) ->
+ {ReplyHeader, Rest, Len} = dec_reply_header(Version, Message, Len0, ByteOrder),
+ {Result, Par} =
+ case ReplyHeader#reply_header.reply_status of
+ 'no_exception' ->
+ {R, P, _} = dec_reply_body(Version, TypeCodes, Rest, Len, ByteOrder, Message),
+ {R, P};
+ 'system_exception' ->
+ {R, _} = dec_system_exception(Version, Rest, Len, ByteOrder),
+ {R, []};
+ 'user_exception' ->
+ {R, _} = dec_user_exception(Version, Rest, Len, ByteOrder),
+ {R, []};
+ 'location_forward' ->
+ {R, _, _} = dec_reply_body(Version, {{'tk_objref', "", ""}, [],[]},
+ Rest, Len, ByteOrder, Message),
+ {R, []};
+ %% This is deprecated in later version than CORBA-2.3.1. We'll leave it for
+ %% now.
+ 'location_forward_perm' ->
+ {R, _, _} = dec_reply_body(Version, {{'tk_objref', "", ""}, [],[]},
+ Rest, Len, ByteOrder, Message),
+ {R, []};
+ 'needs_addressing_mode' ->
+ {R, _, _} = dec_reply_body(Version, {'tk_short', [],[]},
+ Rest, Len, ByteOrder, Message),
+ {R, []}
+ end,
+ {ReplyHeader, Result, Par}.
+
+
+%% ## NEW IIOP 1.2 ##
+dec_reply_header(Version, Message, Len0, ByteOrder) when Version == {1,2} ->
+ {Request_id, Rest1, Len1} = dec_type('tk_ulong', Version, Message, Len0, ByteOrder),
+ {ReplyStatus, Rest2, Len2} = dec_reply_status(Version, Rest1, Len1, ByteOrder),
+ {Context, Rest, Len3} = dec_service_context(Version, Rest2, Len2, ByteOrder),
+ {#reply_header{service_context=Context, request_id=Request_id, reply_status=ReplyStatus},
+ Rest, Len3};
+
+dec_reply_header(Version, Message, Len0, ByteOrder) ->
+ {Context, Rest1, Len1} = dec_service_context(Version, Message, Len0, ByteOrder),
+ {Request_id, Rest2, Len2} = dec_type('tk_ulong', Version, Rest1, Len1, ByteOrder),
+ {ReplyStatus, Rest, Len3} = dec_reply_status(Version, Rest2, Len2, ByteOrder),
+ {#reply_header{service_context=Context, request_id=Request_id, reply_status=ReplyStatus},
+ Rest, Len3}.
+
+dec_reply_status(Version, Status, Len, ByteOrder) ->
+ {L, Rest, Len1}= dec_type('tk_ulong', Version, Status, Len, ByteOrder),
+ {dec_giop_reply_status_type(L), Rest, Len1}.
+
+dec_reply_body(_, {'tk_void', _, []}, <<>>, Len, _, _) ->
+ %% This case is mainly to be able to avoid removing non-existent alignment for
+ %% IIOP-1.2 messages if the body should be empty, i.e., void return value and
+ %% no out parameters.
+ {ok, [], Len};
+dec_reply_body(Version, {RetType, _InParameters, OutParameters}, Body, Len,
+ ByteOrder, Bytes) when Version == {1,2} ->
+ {Rest, Len1, Counter} = dec_align(Body, Len, 8, Len),
+ {Result, Rest2, Len2, C} = dec_type(RetType, Version, Rest, Len1, ByteOrder, Bytes, Counter),
+ {Par, Len3} = dec_parameters(Version, OutParameters, Rest2, Len2, ByteOrder, Bytes, C),
+ {Result, Par, Len3};
+dec_reply_body(Version, {RetType, _InParameters, OutParameters}, Body, Len, ByteOrder, Bytes) ->
+ {Result, Rest, Len1, C} = dec_type(RetType, Version, Body, Len, ByteOrder, Bytes, Len),
+ {Par, Len2} = dec_parameters(Version, OutParameters, Rest, Len1, ByteOrder, Bytes, C),
+ {Result, Par, Len2}.
+
+
+%%-----------------------------------------------------------------
+%% Func: dec_cancel_request/3
+%% Args:
+%% Message - The message
+%% Len - Number of bytes already read.
+%% ByteOrder - little or big
+%% Returns:
+%% A cancel_request_header record.
+%%-----------------------------------------------------------------
+dec_cancel_request(Version, Message, Len, ByteOrder) ->
+ {Request_id, _, _} = dec_type('tk_ulong', Version, Message, Len, ByteOrder),
+ #cancel_request_header{request_id=Request_id}.
+
+%%-----------------------------------------------------------------
+%% Func: dec_locate_request/3
+%% Args:
+%% Message - The message
+%% Len - Number of bytes already read.
+%% ByteOrder - little or big
+%% Returns:
+%% A locate_request_header record.
+%%-----------------------------------------------------------------
+%% ## NEW IIOP 1.2 ##
+dec_locate_request(Version, Message, Len, ByteOrder) when Version == {1,2} ->
+ {Request_id, Rest, Len1} = dec_type('tk_ulong', Version, Message, Len, ByteOrder),
+ {Object_key, _, _, _} = dec_target_addr(Version, Rest, Len1, ByteOrder, Request_id,
+ 'object_forward'),
+ {Version, #locate_request_header{request_id=Request_id, object_key=Object_key}};
+dec_locate_request(Version, Message, Len, ByteOrder) ->
+ {Request_id, Rest, Len1} = dec_type('tk_ulong', Version, Message, Len, ByteOrder),
+ {ObjKey, _, _} = dec_type({'tk_sequence', 'tk_octet', 0}, Version, Rest,
+ Len1, ByteOrder),
+ Object_key = dec_target_key(ObjKey, Request_id, Version, 'object_forward'),
+ {Version, #locate_request_header{request_id=Request_id, object_key=Object_key}}.
+
+
+%%-----------------------------------------------------------------
+%% Func: dec_locate_reply/3
+%% Args:
+%% Message - The message
+%% Len - Number of bytes already read.
+%% ByteOrder - little or big
+%% Returns:
+%% A locate_reply_header record.
+%%-----------------------------------------------------------------
+dec_locate_reply(Version, Message, Len, ByteOrder) ->
+ {ReplyHeader, Rest1, Len1} = dec_locate_reply_header(Version, Message, Len, ByteOrder),
+ {ReplyHeader, dec_locate_reply_body(Version, ReplyHeader#locate_reply_header.locate_status, Rest1,
+ Len1, ByteOrder)}.
+
+dec_locate_reply_header(Version, Message, Len, ByteOrder) ->
+ {Request_id, Rest1, Len1} = dec_type('tk_ulong', Version, Message, Len, ByteOrder),
+ {Locate_status, Rest2, Len2} = dec_locate_status(Version, Rest1, Len1, ByteOrder),
+ {#locate_reply_header{request_id=Request_id, locate_status=Locate_status}, Rest2, Len2}.
+
+dec_locate_reply_body(Version, LocateStatus, Rest, Len, ByteOrder) when Version == {1,2} ->
+ %% In CORBA-2.3.1 the LocateReply body didn't align the body (8-octet
+ %% boundry) for IIOP-1.2. This have been changed in CORBA-2.4 and
+ %% changed back in CORBA-2.6. Hence, we should not change this.
+ case LocateStatus of
+ 'object_forward' ->
+ {ObjRef, _, _, _} = dec_objref(Version, Rest, Len, ByteOrder),
+ ObjRef;
+ 'object_forward_perm' ->
+ %% This is deprecated in later version than CORBA-2.3.1. We'll leave it for
+ %% now.
+ {ObjRef, _, _, _} = dec_objref(Version, Rest, Len, ByteOrder),
+ ObjRef;
+ 'loc_system_exception' ->
+ %% This should be updated but since 'dec_system_exception' removes
+ %% alignment, which the LocateReplyBody don't have, for 1.2 we
+ %% pretend it's 1.1 for now.
+ {SysExc, _} = dec_system_exception({1,1}, Rest, Len, ByteOrder),
+ corba:raise(SysExc);
+ 'loc_needs_addressing_mode' ->
+ %% Not supported.
+ [];
+ _ ->
+ []
+ end;
+dec_locate_reply_body(Version, LocateStatus, Rest, Len, ByteOrder) ->
+ case LocateStatus of
+ 'object_forward' ->
+ {ObjRef, _, _, _} = dec_objref(Version, Rest, Len, ByteOrder),
+ ObjRef;
+ _ ->
+ []
+ end.
+
+dec_locate_status(Version, Bytes, Len, ByteOrder) ->
+ {L, Rest, Len1} = dec_type('tk_ulong', Version, Bytes, Len, ByteOrder),
+ {dec_giop_locate_status_type(L), Rest, Len1}.
+
+
+%%-----------------------------------------------------------------
+%% Func: dec_fragment_header/5
+%% Args:
+%% Message - The message
+%% Len0 - Number of bytes already read.
+%% ByteOrder - little or big
+%% Returns:
+%%-----------------------------------------------------------------
+dec_fragment_header(Version, Message, Len0, ByteOrder, _Buffer) when Version == {1,2} ->
+ {RequestId, Rest1, Len1, _} = dec_type('tk_ulong', Version, Message, Len0,
+ ByteOrder, [], 0),
+ {Version, #fragment_header{request_id=RequestId}, Rest1, Len1, ByteOrder};
+dec_fragment_header(Version, _Message, _Len0, _ByteOrder, _Buffer) ->
+ %% The FragmentHeader is IIOP-1.2 specific. Hence, do nothing here.
+ orber:dbg("[~p] cdr_decode:dec_fragment_header(~p)~n"
+ "Orber only supports fragmented messages for IIOP-1.2.",
+ [?LINE, Version], ?DEBUG_LEVEL),
+ exit(message_error).
+% {Version, #fragment_header{}, Message, Len0, ByteOrder}.
+
+%%-----------------------------------------------------------------
+%% Func: dec_giop_reply_status_type
+%% Args:
+%% An integer status code
+%% Returns:
+%% An atom which is the reply status
+%%-----------------------------------------------------------------
+dec_giop_reply_status_type(0) ->
+ 'no_exception';
+dec_giop_reply_status_type(1) ->
+ 'user_exception';
+dec_giop_reply_status_type(2) ->
+ 'system_exception';
+dec_giop_reply_status_type(3) ->
+ 'location_forward';
+%% ## IIOP-1.2 ##
+dec_giop_reply_status_type(4) ->
+ 'location_forward_perm';
+dec_giop_reply_status_type(5) ->
+ 'needs_addressing_mode'.
+
+%%-----------------------------------------------------------------
+%% Func: dec_giop_locate_status_type
+%% Args:
+%% An integer status code
+%% Returns:
+%% An atom which is the reply status
+%%-----------------------------------------------------------------
+dec_giop_locate_status_type(0) ->
+ 'unknown_object';
+dec_giop_locate_status_type(1) ->
+ 'object_here';
+dec_giop_locate_status_type(2) ->
+ 'object_forward';
+%% ## IIOP-1.2 ##
+dec_giop_locate_status_type(3) ->
+ 'object_forward_perm';
+dec_giop_locate_status_type(4) ->
+ 'loc_system_exception';
+dec_giop_locate_status_type(5) ->
+ 'loc_needs_addressing_mode'.
+
+
+%%-----------------------------------------------------------------
+%% Func: dec_type/5
+%%-----------------------------------------------------------------
+dec_type(Type, Version, Bytes, Len, ByteOrder) ->
+ {Val, Rest, Len2, _} =
+ dec_type(Type, Version, Bytes, Len, ByteOrder, [], 0),
+ {Val, Rest, Len2}.
+
+dec_type('tk_null', _Version, Bytes, Len, _, _, C) ->
+ {'null', Bytes, Len, C};
+dec_type('tk_void', _Version, Bytes, Len, _, _, C) ->
+ {'ok', Bytes, Len, C};
+dec_type('tk_short', _Version, Bytes, Len, ByteOrder, _, C) ->
+ {Rest, Len1, NewC} = dec_align(Bytes, Len, 2, C),
+ {Short, Rest1} = cdrlib:dec_short(ByteOrder, Rest),
+ {Short, Rest1, Len1 + 2, NewC+2};
+dec_type('tk_long', _Version, Bytes, Len, ByteOrder, _, C) ->
+ {Rest, Len1, NewC} = dec_align(Bytes, Len, 4, C),
+ {Long, Rest1} = cdrlib:dec_long(ByteOrder, Rest),
+ {Long, Rest1, Len1 + 4, NewC+4};
+dec_type('tk_longlong', _Version, Bytes, Len, ByteOrder, _, C) ->
+ {Rest, Len1, NewC} = dec_align(Bytes, Len, 8, C),
+ {Long, Rest1} = cdrlib:dec_longlong(ByteOrder, Rest),
+ {Long, Rest1, Len1 + 8, NewC+8};
+dec_type('tk_ushort', _Version, Bytes, Len, ByteOrder, _, C) ->
+ {Rest, Len1, NewC} = dec_align(Bytes, Len, 2, C),
+ {Short, Rest1} = cdrlib:dec_unsigned_short(ByteOrder, Rest),
+ {Short, Rest1, Len1 + 2, NewC+2};
+dec_type('tk_ulong', _Version, Bytes, Len, ByteOrder, _, C) ->
+ {Rest, Len1, NewC} = dec_align(Bytes, Len, 4, C),
+ {Long, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
+ {Long, Rest1, Len1 + 4, NewC+4};
+dec_type('tk_ulonglong', _Version, Bytes, Len, ByteOrder, _, C) ->
+ {Rest, Len1, NewC} = dec_align(Bytes, Len, 8, C),
+ {Long, Rest1} = cdrlib:dec_unsigned_longlong(ByteOrder, Rest),
+ {Long, Rest1, Len1 + 8, NewC+8};
+dec_type('tk_float', _Version, Bytes, Len, ByteOrder, _, C) ->
+ {Rest, Len1, NewC} = dec_align(Bytes, Len, 4, C),
+ {Float, Rest1} = cdrlib:dec_float(ByteOrder, Rest),
+ {Float, Rest1, Len1 + 4, NewC+4};
+dec_type('tk_double', _Version, Bytes, Len, ByteOrder, _, C) ->
+ {Rest, Len1, NewC} = dec_align(Bytes, Len, 8, C),
+ {Double, Rest1} = cdrlib:dec_double(ByteOrder, Rest),
+ {Double, Rest1, Len1 + 8, NewC+8};
+dec_type('tk_boolean', _Version, Bytes, Len, _, _, C) ->
+ {Bool, Rest} = cdrlib:dec_bool(Bytes),
+ {Bool, Rest, Len + 1, C+1};
+dec_type('tk_char', _Version, Bytes, Len, _, _, C) ->
+ {Char, Rest} = cdrlib:dec_char(Bytes),
+ {Char, Rest, Len + 1, C+1};
+dec_type('tk_wchar', {1,2}, Bytes, Len, _ByteOrder, _, C) ->
+ %% For IIOP-1.2 a wchar is almost encoded the same way as an octet-sequence.
+ %% The only difference is that the length-value is an octet as well.
+ case cdrlib:dec_octet(Bytes) of
+ {2, Rest1} ->
+ %% Currently we only allow 2-bytes wchar.
+ {WChar, Rest2} = cdrlib:dec_unsigned_short(big, Rest1),
+ {WChar, Rest2, Len+3, C+3};
+ {What, _} ->
+ orber:dbg("[~p] cdr_decode:dec_type(~p); unsupported wchar",
+ [?LINE, What], ?DEBUG_LEVEL),
+ corba:raise(#'DATA_CONVERSION'{completion_status=?COMPLETED_NO})
+ end;
+%% For 1.1 the wchar is limited to the use of two-octet fixed-length encoding.
+dec_type('tk_wchar', _Version, Bytes, Len, ByteOrder, _, C) ->
+ {Rest, Len1, NewC} = dec_align(Bytes, Len, 2, C),
+ {WChar, Rest2} = cdrlib:dec_unsigned_short(ByteOrder, Rest),
+ {WChar, Rest2, Len1 + 2, NewC+2};
+dec_type('tk_octet', _Version, Bytes, Len, _, _, C) ->
+ {Octet, Rest} = cdrlib:dec_octet(Bytes),
+ {Octet, Rest, Len + 1, C+1};
+dec_type('tk_any', Version, Bytes, Len, ByteOrder, Buff, C) ->
+ {TypeCode, Rest1, Len1, NewC} = dec_type('tk_TypeCode', Version, Bytes, Len, ByteOrder, Buff, C),
+ {Value, Rest2, Len2, NewC2} = dec_type(TypeCode, Version, Rest1, Len1, ByteOrder, Buff, NewC),
+ {#any{typecode=TypeCode, value=Value}, Rest2, Len2, NewC2};
+dec_type('tk_TypeCode', Version, Bytes, Len, ByteOrder, Buff, C) ->
+ dec_type_code(Version, Bytes, Len, ByteOrder, Buff, C);
+dec_type('tk_Principal', Version, Bytes, Len, ByteOrder, Buff, C) ->
+ dec_sequence(Version, Bytes, 'tk_octet', Len, ByteOrder, Buff, C);
+dec_type({'tk_objref', _IFRId, _Name}, Version, Bytes, Len, ByteOrder, Buff, C) ->
+ dec_objref(Version, Bytes, Len, ByteOrder, Buff, C);
+dec_type({'tk_struct', IFRId, Name, ElementList}, Version, Bytes, Len, ByteOrder, Buff, C) ->
+ dec_struct(Version, IFRId, Name, ElementList, Bytes, Len, ByteOrder, Buff, C);
+dec_type({'tk_union', IFRId, Name, DiscrTC, Default, ElementList},
+ Version, Bytes, Len, ByteOrder, Buff, C) ->
+ dec_union(Version, IFRId, Name, DiscrTC, Default, ElementList, Bytes, Len, ByteOrder, Buff, C);
+dec_type({'tk_enum', _IFRId, _Name, ElementList}, _Version, Bytes, Len, ByteOrder, _, C) ->
+ {Rest, Len1, NewC} = dec_align(Bytes, Len, 4, C),
+ {Enum, Rest1} = cdrlib:dec_enum(ByteOrder, ElementList, Rest),
+ {Enum, Rest1, Len1 + 4, NewC+4};
+dec_type({'tk_string', _MaxLength}, Version, Bytes, Len, ByteOrder, Buff, C) ->
+ dec_string(Version, Bytes, Len, ByteOrder, Buff, C);
+dec_type({'tk_wstring', _MaxLength}, Version, Bytes, Len, ByteOrder, Buff, C) ->
+ dec_wstring(Version, Bytes, Len, ByteOrder, Buff, C);
+dec_type({'tk_sequence', ElemTC, _MaxLength}, Version, Bytes, Len, ByteOrder, Buff, C) ->
+ dec_sequence(Version, Bytes, ElemTC, Len, ByteOrder, Buff, C);
+dec_type({'tk_array', ElemTC, Size}, Version, Bytes, Len, ByteOrder, Buff, C) ->
+ dec_array(Version, Bytes, Size, ElemTC, Len, ByteOrder, Buff, C);
+dec_type({'tk_alias', _IFRId, _Name, TC}, Version, Bytes, Len, ByteOrder, Buff, C) ->
+ dec_type(TC, Version, Bytes, Len, ByteOrder, Buff, C);
+%dec_type({'tk_except', IFRId, Name, ElementList}, Version, Bytes, Len, ByteOrder) ->
+dec_type({'tk_fixed', Digits, Scale}, _Version, Bytes, Len, _ByteOrder, _Buff, C) ->
+ dec_fixed(Digits, Scale, Bytes, Len, C);
+dec_type(Type, _, _, _, _, _, _) ->
+ orber:dbg("[~p] cdr_decode:dec_type(~p)~n"
+ "Incorrect TypeCode or unsupported type.",
+ [?LINE, Type], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 13), completion_status=?COMPLETED_MAYBE}).
+
+stringify_enum({tk_enum,_,_,_}, Label) ->
+ atom_to_list(Label);
+stringify_enum(_, Label) ->
+ Label.
+
+%%-----------------------------------------------------------------
+%% Func: dec_fixed
+%%-----------------------------------------------------------------
+%% Digits eq. total number of digits.
+%% Scale eq. position of the decimal point.
+%% E.g. fixed<5,2> - "123.45"
+%% E.g. fixed<4,2> - "12.34"
+%% These are encoded as:
+%% ## <5,2> ## ## <4,2> ##
+%% 1,2 0,1 eq. 1 octet
+%% 3,4 2,3
+%% 5,0xC 4,0xC
+%%
+%% Each number is encoded as a half-octet. Note, for <4,2> a zero is
+%% added first to to be able to create "even" octets.
+dec_fixed(0, 0, Bytes, Len, C) ->
+ {#fixed{digits = 0, scale = 0, value = ""}, Bytes, Len, C};
+dec_fixed(Digits, Scale, Bytes, Len, C) ->
+ case ?ODD(Digits) of
+ true ->
+ {Fixed, Bytes2, Len2, C2, Sign} = dec_fixed_2(Digits, Scale, Bytes, Len, C),
+ case Sign of
+ ?FIXED_POSITIVE ->
+ {#fixed{digits = Digits, scale = Scale,
+ value = list_to_integer(Fixed)}, Bytes2, Len2, C2};
+ ?FIXED_NEGATIVE ->
+ {#fixed{digits = Digits, scale = Scale,
+ value = -list_to_integer(Fixed)}, Bytes2, Len2, C2}
+ end;
+ false ->
+ %% If the length (of fixed) is even a zero is added first.
+ %% Subtract that we've read 1 digit.
+ <<0:4,D2:4,T/binary>> = Bytes,
+ {Fixed, Bytes2, Len2, C2, Sign} = dec_fixed_2(Digits-1, Scale, T, Len+1, C+1),
+ case Sign of
+ ?FIXED_POSITIVE ->
+ {#fixed{digits = Digits, scale = Scale,
+ value = list_to_integer([D2+48|Fixed])}, Bytes2, Len2, C2};
+ ?FIXED_NEGATIVE ->
+ {#fixed{digits = Digits, scale = Scale,
+ value = -list_to_integer([D2+48|Fixed])}, Bytes2, Len2, C2}
+ end
+ end.
+
+dec_fixed_2(1, _Scale, <<D1:4,?FIXED_POSITIVE:4,T/binary>>, Len, C) ->
+ {[D1+48], T, Len+1, C+1, ?FIXED_POSITIVE};
+dec_fixed_2(1, _Scale, <<D1:4,?FIXED_NEGATIVE:4,T/binary>>, Len, C) ->
+ {[D1+48], T, Len+1, C+1, ?FIXED_NEGATIVE};
+dec_fixed_2(Digits, Scale, _Bytes, _Len, _C) when Digits =< 0 ->
+ orber:dbg("[~p] cdr_decode:dec_fixed_2(~p, ~p)~n"
+ "Malformed fixed type.", [?LINE, Digits, Scale], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 14), completion_status=?COMPLETED_MAYBE});
+dec_fixed_2(Digits, Scale, <<>>, _Len, _C) ->
+ orber:dbg("[~p] cdr_decode:dec_fixed_2(~p, ~p)~n"
+ "The fixed type received was to short.",
+ [?LINE, Digits, Scale], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 14), completion_status=?COMPLETED_MAYBE});
+dec_fixed_2(Digits, Scale, <<D1:4,D2:4,T/binary>>, Len, C) ->
+ {Seq, Rest2, Len2, NewC2, Sign} = dec_fixed_2(Digits-2, Scale, T, Len+1, C+1),
+ {[D1+48, D2+48 | Seq], Rest2, Len2, NewC2, Sign}.
+
+%%-----------------------------------------------------------------
+%% Func: dec_sequence/7 and dec_sequence/8
+%%-----------------------------------------------------------------
+dec_sequence(_Version, Message, 'tk_octet', Len, ByteOrder, _Buff, C) ->
+ {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
+ {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
+ <<OctetSeq:Size/binary, Rest2/binary>> = Rest1,
+ {binary_to_list(OctetSeq), Rest2, Len1+4+Size, NewC+4+Size};
+dec_sequence(_Version, Message, 'tk_char', Len, ByteOrder, _Buff, C) ->
+ {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
+ {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
+ <<OctetSeq:Size/binary, Rest2/binary>> = Rest1,
+ {binary_to_list(OctetSeq), Rest2, Len1+4+Size, NewC+4+Size};
+%% We test if it's a sequence of struct's or unions. By doing this we only
+%% have to look up the IFR-ID once instead of N times (N eq length of sequence).
+dec_sequence(Version, Message, {'tk_struct', IFRId, ShortName, ElementList},
+ Len, ByteOrder, Buff, C) when IFRId /= "", ShortName /= "" ->
+ {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
+ {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
+ case IFRId of
+ ?SYSTEM_TYPE ->
+ dec_sequence_struct(Version, Rest1, Size, ElementList, Len1 + 4,
+ ByteOrder, Buff, NewC+4, ShortName);
+ _ ->
+ Name = ifrid_to_name(IFRId, ?IFR_StructDef),
+ dec_sequence_struct(Version, Rest1, Size, ElementList, Len1 + 4,
+ ByteOrder, Buff, NewC+4, Name)
+ end;
+dec_sequence(Version, Message,
+ {'tk_union', ?SYSTEM_TYPE, TCName, DiscrTC, Default, ElementList},
+ Len, ByteOrder, Buff, C) ->
+ {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
+ {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
+ dec_sequence_union(Version, Rest1, Size, DiscrTC, Default, ElementList, Len1 + 4,
+ ByteOrder, Buff, NewC+4, TCName);
+dec_sequence(Version, Message,
+ {'tk_union', IFRId, _TCName, DiscrTC, Default, ElementList},
+ Len, ByteOrder, Buff, C) ->
+ {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
+ {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
+ Name = ifrid_to_name(IFRId, ?IFR_UnionDef),
+ dec_sequence_union(Version, Rest1, Size, DiscrTC, Default, ElementList, Len1 + 4,
+ ByteOrder, Buff, NewC+4, Name);
+dec_sequence(Version, Message, TypeCode, Len, ByteOrder, Buff, C) ->
+ {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
+ {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
+ dec_sequence(Version, Rest1, Size, TypeCode, Len1 + 4, ByteOrder, Buff, NewC+4).
+
+
+dec_sequence(_, Message, 0, _Type, Len, _ByteOrder, _Buff, C) ->
+ {[], Message, Len, C};
+dec_sequence(Version, Message, N, Type, Len, ByteOrder, Buff, C) ->
+ {Object, Rest1, Len1, NewC} = dec_type(Type, Version, Message, Len, ByteOrder, Buff, C),
+ {Seq, Rest2, Len2, NewC2} = dec_sequence(Version, Rest1, N - 1, Type, Len1, ByteOrder, Buff, NewC),
+ {[Object | Seq], Rest2, Len2, NewC2}.
+
+dec_sequence_struct(_, Message, 0, _Type, Len, _ByteOrder, _Buff, C, _Name) ->
+ {[], Message, Len, C};
+dec_sequence_struct(Version, Message, N, TypeCodeList, Len, ByteOrder, Buff, C, Name) ->
+ {Struct, Rest1, Len1, NewC} = dec_struct1(Version, TypeCodeList, Message, Len, ByteOrder, Buff, C),
+ {Seq, Rest2, Len2, NewC2} = dec_sequence_struct(Version, Rest1, N - 1, TypeCodeList, Len1, ByteOrder,
+ Buff, NewC, Name),
+ {[list_to_tuple([Name |Struct]) | Seq], Rest2, Len2, NewC2}.
+dec_sequence_union(_, Message, 0, _DiscrTC, _Default, _ElementList, Len, _ByteOrder, _Buff, C, _Name) ->
+ {[], Message, Len, C};
+dec_sequence_union(Version, Message, N, DiscrTC, Default, ElementList, Len, ByteOrder, Buff, C, Name) ->
+
+ {Label, Rest1, Len1, NewC} = dec_type(DiscrTC, Version, Message, Len, ByteOrder, Buff, C),
+ Result = dec_union(Version, stringify_enum(DiscrTC, Label), ElementList, Default,
+ Rest1, Len1, ByteOrder, Buff, NewC),
+ {Value, Rest2, Len2, NewC3} = case Result of
+ {default, R, L, NewC2} ->
+ dec_union(Version, default, ElementList, Default,
+ R, L, ByteOrder, Buff, NewC2);
+ X ->
+ X
+ end,
+ {Seq, Rest3, Len3, NewC4} = dec_sequence_union(Version, Rest2, N - 1,
+ DiscrTC, Default, ElementList,
+ Len2, ByteOrder,
+ Buff, NewC3, Name),
+ {[{Name, Label, Value} | Seq], Rest3, Len3, NewC4}.
+
+%% A special case; when something is encapsulated (i.e. sent as octet-sequence)
+%% we sometimes don not want the result to be converted to a list.
+dec_octet_sequence_bin(_Version, Message, Len, ByteOrder, _Buff, C) ->
+ {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
+ {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
+ <<OctetSeq:Size/binary, Rest2/binary>> = Rest1,
+ {OctetSeq, Rest2, Len1+4+Size, NewC+4+Size}.
+
+%%-----------------------------------------------------------------
+%% Func: dec_array/5
+%%-----------------------------------------------------------------
+dec_array(Version, Message, Size, TypeCode, Len, ByteOrder, Buff, C) ->
+ {Seq, Rest1, Len1, NewC} = dec_sequence(Version, Message, Size, TypeCode, Len,
+ ByteOrder, Buff, C),
+ {list_to_tuple(Seq), Rest1, Len1, NewC}.
+
+
+%%-----------------------------------------------------------------
+%% Func: dec_string/4
+%%-----------------------------------------------------------------
+dec_string(_Version, Message, Len, ByteOrder, _Buff, C) ->
+ {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
+ {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
+ if
+ Size > 0 ->
+ DataSize = Size-1,
+ <<String:DataSize/binary, _Null:1/binary, Rest2/binary>> = Rest1,
+ {binary_to_list(String), Rest2, Len1+4+Size, NewC+4+Size};
+ true ->
+ {"", Rest1, Len1 + 4, NewC+4}
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: dec_string/4
+%%-----------------------------------------------------------------
+dec_wstring({1,2}, Message, Len, ByteOrder, Buff, C) ->
+ {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
+ {Octets, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
+ if
+ Octets == 0 ->
+ {"", Rest1, Len1 + 4, NewC+4};
+ Octets > 0 ->
+ Size = round(Octets/2),
+ {String, Rest2, Len2, NewC2} =
+ dec_sequence({1,2}, Rest1, Size, 'tk_ushort',
+ Len1 + 4, big, Buff, NewC+4),
+ {String, Rest2, Len2, NewC2};
+ true ->
+ orber:dbg("[~p] cdr_decode:dec_wstring(~p);",
+ [?LINE, Rest1], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO})
+ end;
+dec_wstring(Version, Message, Len, ByteOrder, Buff, C) ->
+ {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
+ {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
+ if
+ Size > 0 ->
+ {String, Rest2, Len2, NewC2} = dec_sequence(Version, Rest1, Size - 1, 'tk_wchar',
+ Len1 + 4, ByteOrder, Buff, NewC+4),
+ %% Remove the NULL character.
+ {_, Rest3} = cdrlib:dec_unsigned_short(ByteOrder, Rest2),
+ {String, Rest3, Len2 + 2, NewC2+2};
+ Size == 0 ->
+ {"", Rest1, Len1 + 4, NewC+4};
+ true ->
+ orber:dbg("[~p] cdr_decode:dec_wstring(~p);",
+ [?LINE, Rest1], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO})
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Func: dec_union/9
+%%-----------------------------------------------------------------
+%% ## NEW IIOP 1.2 ##
+dec_union(Version, ?SYSTEM_TYPE, Name, DiscrTC, Default, ElementList, Bytes, Len, ByteOrder, Buff, C) ->
+ {Label, Rest1, Len1, NewC} = dec_type(DiscrTC, Version, Bytes, Len, ByteOrder, Buff, C),
+ {Value, Rest2, Len2, NewC3} = dec_union(Version, Label, ElementList, Default,
+ Rest1, Len1, ByteOrder, Buff, NewC),
+ {{Name, Label, Value}, Rest2, Len2, NewC3};
+
+
+dec_union(Version, IFRId, _, DiscrTC, Default, ElementList, Bytes, Len, ByteOrder, Buff, C) ->
+ {Label, Rest1, Len1, NewC} = dec_type(DiscrTC, Version, Bytes, Len, ByteOrder, Buff, C),
+ Result = dec_union(Version, stringify_enum(DiscrTC, Label), ElementList, Default,
+ Rest1, Len1, ByteOrder, Buff, NewC),
+ {Value, Rest2, Len2, NewC3} = case Result of
+ {default, R, L, NewC2} ->
+ dec_union(Version, default, ElementList, Default,
+ R, L, ByteOrder, Buff, NewC2);
+ X ->
+ X
+ end,
+ Name = ifrid_to_name(IFRId, ?IFR_UnionDef),
+ {{Name, Label, Value}, Rest2, Len2, NewC3}.
+
+dec_union(_, _, [], Default, Message, Len, _, _Buff, C) when Default < 0 ->
+ {undefined, Message, Len, C};
+dec_union(_, _, [], _Default, Message, Len, _, _Buff, C) ->
+ {default, Message, Len, C};
+dec_union(Version, Label, [{Label, _Name, Type}|_List], _Default, Message, Len, ByteOrder, Buff, C) ->
+ dec_type(Type, Version, Message, Len, ByteOrder, Buff, C);
+dec_union(Version, Label, [_H|List], Default, Message, Len, ByteOrder, Buff, C) ->
+ dec_union(Version, Label, List, Default, Message, Len, ByteOrder, Buff, C).
+
+%%-----------------------------------------------------------------
+%% Func: dec_struct/7
+%%-----------------------------------------------------------------
+dec_struct(Version, "", "", TypeCodeList, Message, Len, ByteOrder, Buff, C) ->
+ {Struct, Rest, Len1, NewC} = dec_struct1(Version, TypeCodeList, Message, Len, ByteOrder, Buff, C),
+ {list_to_tuple(Struct), Rest, Len1, NewC};
+dec_struct(Version, [], Name, TypeCodeList, Message, Len, ByteOrder, Buff, C) ->
+ %% This case is used when communicating with ORB:s which don't supply the IFRId
+ %% field in struct type codes (used in any)
+ {Struct, Rest, Len1, NewC} = dec_struct1(Version, TypeCodeList, Message, Len, ByteOrder, Buff, C),
+ {list_to_tuple([list_to_atom(Name) |Struct]), Rest, Len1, NewC};
+dec_struct(Version, ?SYSTEM_TYPE, ShortName, TypeCodeList, Message, Len, ByteOrder, Buff, C) ->
+ {Struct, Rest, Len1, NewC} = dec_struct1(Version, TypeCodeList, Message, Len, ByteOrder, Buff, C),
+ {list_to_tuple([ShortName |Struct]), Rest, Len1, NewC};
+dec_struct(Version, IFRId, _ShortName, TypeCodeList, Message, Len, ByteOrder, Buff, C) ->
+ Name = ifrid_to_name(IFRId, ?IFR_StructDef),
+ {Struct, Rest, Len1, NewC} = dec_struct1(Version, TypeCodeList, Message, Len, ByteOrder, Buff, C),
+ {list_to_tuple([Name |Struct]), Rest, Len1, NewC}.
+
+dec_struct1(_, [], Message, Len, _ByteOrder, _, C) ->
+ {[], Message, Len, C};
+dec_struct1(Version, [{_ElemName, ElemType} | TypeCodeList], Message, Len, ByteOrder, Buff, C) ->
+ {Element, Rest, Len1, NewC} = dec_type(ElemType, Version, Message, Len, ByteOrder, Buff, C),
+ {Struct, Rest1, Len2, NewC2} = dec_struct1(Version, TypeCodeList, Rest, Len1, ByteOrder, Buff, NewC),
+ {[Element |Struct], Rest1, Len2, NewC2}.
+
+ifrid_to_name([], Type) ->
+ orber:dbg("[~p] ~p:ifrid_to_name([], ~p). No Id supplied.",
+ [?LINE, ?MODULE, Type], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?CORBA_OMGVMCID bor 11),
+ completion_status=?COMPLETED_MAYBE});
+ifrid_to_name(Id, Type) ->
+ case orber:light_ifr() of
+ true ->
+ orber_ifr:get_module(Id, Type);
+ false ->
+ case catch ifrid_to_name_helper(Id, Type) of
+ {'EXCEPTION', E} ->
+ corba:raise(E);
+ {'EXIT',{aborted,{no_exists,_}}} ->
+ case orber:get_lightweight_nodes() of
+ false ->
+ orber:dbg("[~p] cdr_decode:ifrid_to_name(~p, ~p). IFRid not found.",
+ [?LINE, Id, Type], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ Nodes ->
+ {A,B,C} = now(),
+ random:seed(A,B,C),
+ L = length(Nodes),
+ IFR = get_ifr_node(Nodes, random:uniform(L), L),
+ list_to_atom('OrberApp_IFR':get_absolute_name(IFR, Id))
+ end;
+ {'EXIT', Other} ->
+ orber:dbg("[~p] cdr_decode:ifrid_to_name(~p). Unknown: ~p",
+ [?LINE, Id, Other], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ Name ->
+ list_to_atom(Name)
+ end
+ end.
+
+ifrid_to_name_helper(Id, ?IFR_UnionDef) ->
+ case mnesia:dirty_index_read(ir_UnionDef, Id, #ir_UnionDef.id) of
+ [#ir_UnionDef{absolute_name = [$:,$:|N]}] ->
+ change_colons_to_underscore(N, []);
+ Other ->
+ orber:dbg("[~p] cdr_decode:ifrid_to_name(~p). IFR Id not found: ~p",
+ [?LINE, Id, Other], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 9),
+ completion_status=?COMPLETED_MAYBE})
+ end;
+ifrid_to_name_helper(Id, ?IFR_StructDef) ->
+ case mnesia:dirty_index_read(ir_StructDef, Id, #ir_StructDef.id) of
+ [#ir_StructDef{absolute_name = [$:,$:|N]}] ->
+ change_colons_to_underscore(N, []);
+ Other ->
+ orber:dbg("[~p] cdr_decode:ifrid_to_name(~p). IFR Id not found: ~p",
+ [?LINE, Id, Other], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 10),
+ completion_status=?COMPLETED_MAYBE})
+ end;
+ifrid_to_name_helper(Id, ?IFR_ExceptionDef) ->
+ case mnesia:dirty_index_read(ir_ExceptionDef, Id, #ir_ExceptionDef.id) of
+ [#ir_ExceptionDef{absolute_name = [$:,$:|N]}] ->
+ change_colons_to_underscore(N, []);
+ Other ->
+ orber:dbg("[~p] cdr_decode:ifrid_to_name(~p). IFR Id not found: ~p",
+ [?LINE, Id, Other], ?DEBUG_LEVEL),
+ corba:raise(#'UNKNOWN'{minor=(?CORBA_OMGVMCID bor 1),
+ completion_status=?COMPLETED_MAYBE})
+ end.
+
+change_colons_to_underscore([$:, $: | T], Acc) ->
+ change_colons_to_underscore(T, [$_ |Acc]);
+change_colons_to_underscore([H |T], Acc) ->
+ change_colons_to_underscore(T, [H |Acc]);
+change_colons_to_underscore([], Acc) ->
+ lists:reverse(Acc).
+
+get_ifr_node([], _, _) ->
+ %% Were not able to contact any of the given nodes.
+ orber:dbg("[~p] cdr_decode:get_ifr_node([]). No Node available.",
+ [?LINE], ?DEBUG_LEVEL),
+ corba:raise(#'INTERNAL'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_MAYBE});
+get_ifr_node(Nodes, N, L) ->
+ Node = lists:nth(N, Nodes),
+ case catch corba:resolve_initial_references_remote("OrberIFR", [Node]) of
+ IFR when is_record(IFR, 'IOP_IOR') ->
+ IFR;
+ _ ->
+ %% Not able to commincate with the node. Try next one.
+ NewL = L-1,
+ get_ifr_node(lists:delete(Node, Nodes), random:uniform(NewL), NewL)
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Func: dec_objref/4
+%%-----------------------------------------------------------------
+dec_objref(Version, Message, Len, ByteOrder) ->
+ dec_objref(Version, Message, Len, ByteOrder, [], 0).
+dec_objref(Version, Message, Len, ByteOrder, _Buff, C) ->
+ {IOR, Rest, Length} = iop_ior:decode(Version, Message, Len, ByteOrder),
+ {IOR, Rest, Length, C+Length-Len}.
+
+%%-----------------------------------------------------------------
+%% Func: dec_system_exception/4 and dec_user_exception/4
+%%-----------------------------------------------------------------
+dec_system_exception(Version, Message, Len, ByteOrder) when Version == {1,2} ->
+ {Rest0, Len0, _Counter} = dec_align(Message, Len, 8, Len),
+ {TypeId, Rest1, Len1} = dec_type({'tk_string', 0}, Version, Rest0, Len0, ByteOrder),
+ Name = orber_exceptions:get_name(TypeId, ?SYSTEM_EXCEPTION),
+ {Struct, _Rest2, Len2} =
+ dec_exception_1(Version, [{"minor",'tk_ulong'},
+ {"completed",
+ {'tk_enum', "", "completion_status",
+ ["COMPLETED_YES", "COMPLETED_NO",
+ "COMPLETED_MAYBE"]}}],
+ Rest1, Len1, ByteOrder),
+ {list_to_tuple([Name, "" |Struct]), Len2};
+dec_system_exception(Version, Message, Len, ByteOrder) ->
+ {TypeId, Rest1, Len1} = dec_type({'tk_string', 0}, Version, Message, Len, ByteOrder),
+ Name = orber_exceptions:get_name(TypeId, ?SYSTEM_EXCEPTION),
+ {Struct, _Rest2, Len2} =
+ dec_exception_1(Version, [{"minor",'tk_ulong'},
+ {"completed",
+ {'tk_enum', "", "completion_status",
+ ["COMPLETED_YES", "COMPLETED_NO",
+ "COMPLETED_MAYBE"]}}],
+ Rest1, Len1, ByteOrder),
+ {list_to_tuple([Name, "" |Struct]), Len2}.
+
+dec_user_exception(Version, Message, Len, ByteOrder) when Version == {1,2} ->
+ {Rest0, Len0, _Counter} = dec_align(Message, Len, 8, Len),
+ {TypeId, Rest1, Len1} = dec_type({'tk_string', 0}, Version, Rest0, Len0, ByteOrder),
+ Name = ifrid_to_name(TypeId, ?IFR_ExceptionDef),
+ {'tk_except', _, _, ElementList} = get_user_exception_type(TypeId),
+ {Struct, _Rest2, Len2} = dec_exception_1(Version, ElementList, Rest1, Len1,
+ ByteOrder),
+ {list_to_tuple([Name, TypeId |Struct]), Len2};
+dec_user_exception(Version, Message, Len, ByteOrder) ->
+ {TypeId, Rest1, Len1} = dec_type({'tk_string', 0}, Version, Message, Len, ByteOrder),
+ Name = ifrid_to_name(TypeId, ?IFR_ExceptionDef),
+ {'tk_except', _, _, ElementList} = get_user_exception_type(TypeId),
+ {Struct, _Rest2, Len2} = dec_exception_1(Version, ElementList, Rest1, Len1,
+ ByteOrder),
+ {list_to_tuple([Name, TypeId |Struct]), Len2}.
+
+dec_exception_1(_, [], Message, Len, _ByteOrder) ->
+ {[], Message, Len};
+dec_exception_1(Version, [{_ElemName, ElemType} | ElementList], Message,
+ Len, ByteOrder) ->
+ {Element, Rest, Len1} = dec_type(ElemType, Version, Message, Len, ByteOrder),
+ {Struct, Rest1, Len2} = dec_exception_1(Version, ElementList, Rest, Len1,
+ ByteOrder),
+ {[Element |Struct], Rest1, Len2}.
+
+
+get_user_exception_type(TypeId) ->
+ case orber:light_ifr() of
+ true ->
+ orber_ifr:get_tc(TypeId, ?IFR_ExceptionDef);
+ false ->
+ case orber:get_lightweight_nodes() of
+ false ->
+ case mnesia:dirty_index_read(ir_ExceptionDef, TypeId,
+ #ir_ExceptionDef.id) of
+ [ExcDef] when is_record(ExcDef, ir_ExceptionDef) ->
+ ExcDef#ir_ExceptionDef.type;
+ Other ->
+ orber:dbg("[~p] cdr_decode:get_user_exception_type(~p). IFR Id not found: ~p",
+ [?LINE, TypeId, Other], ?DEBUG_LEVEL),
+ corba:raise(#'UNKNOWN'{minor=(?CORBA_OMGVMCID bor 1),
+ completion_status=?COMPLETED_MAYBE})
+ end;
+ Nodes ->
+ {A,B,C} = now(),
+ random:seed(A,B,C),
+ L = length(Nodes),
+ IFR = get_ifr_node(Nodes, random:uniform(L), L),
+ 'OrberApp_IFR':get_user_exception_type(IFR, TypeId)
+ end
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: dec_type_code/4
+%%-----------------------------------------------------------------
+dec_type_code(Version, Message, Len, ByteOrder, Buff, C) ->
+ {TypeNo, Message1, Len1, NewC} = dec_type('tk_ulong', Version, Message, Len, ByteOrder, Buff, C),
+ dec_type_code(TypeNo, Version, Message1, Len1, ByteOrder, Buff, NewC).
+
+%%-----------------------------------------------------------------
+%% Func: dec_type_code/5
+%%-----------------------------------------------------------------
+dec_type_code(0, _, Message, Len, _, _, C) ->
+ {'tk_null', Message, Len, C};
+dec_type_code(1, _, Message, Len, _, _, C) ->
+ {'tk_void', Message, Len, C};
+dec_type_code(2, _, Message, Len, _, _, C) ->
+ {'tk_short', Message, Len, C};
+dec_type_code(3, _, Message, Len, _, _, C) ->
+ {'tk_long', Message, Len, C};
+dec_type_code(23, _, Message, Len, _, _, C) ->
+ {'tk_longlong', Message, Len, C};
+dec_type_code(25, _, Message, Len, _, _, C) ->
+ {'tk_longdouble', Message, Len, C};
+dec_type_code(4, _, Message, Len, _, _, C) ->
+ {'tk_ushort', Message, Len, C};
+dec_type_code(5, _, Message, Len, _, _, C) ->
+ {'tk_ulong', Message, Len, C};
+dec_type_code(24, _, Message, Len, _, _, C) ->
+ {'tk_ulonglong', Message, Len, C};
+dec_type_code(6, _, Message, Len, _, _, C) ->
+ {'tk_float', Message, Len, C};
+dec_type_code(7, _, Message, Len, _, _, C) ->
+ {'tk_double', Message, Len, C};
+dec_type_code(8, _, Message, Len, _, _, C) ->
+ {'tk_boolean', Message, Len, C};
+dec_type_code(9, _, Message, Len, _, _, C) ->
+ {'tk_char', Message, Len, C};
+dec_type_code(26, _, Message, Len, _, _, C) ->
+ {'tk_wchar', Message, Len, C};
+dec_type_code(10, _, Message, Len, _, _, C) ->
+ {'tk_octet', Message, Len, C};
+dec_type_code(11, _, Message, Len, _, _, C) ->
+ {'tk_any', Message, Len, C};
+dec_type_code(12, _, Message, Len, _, _, C) ->
+ {'tk_TypeCode', Message, Len, C};
+dec_type_code(13, _, Message, Len, _, _, C) ->
+ {'tk_Principal', Message, Len, C};
+dec_type_code(14, Version, Message, Len, ByteOrder, Buff, C) ->
+ {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
+ %% Decode marshalled parameters, eg get the byteorder first
+ {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
+ {{RepId, Name}, <<>>, _Len2, NewC} =
+ dec_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}}]},
+ Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
+ {{'tk_objref', RepId, Name}, Message1, Len1, NewC};
+dec_type_code(15, Version, Message, Len, ByteOrder, Buff, C) ->
+ {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
+ %% Decode marshalled parameters, eg get the byteorder first
+ {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
+ {{RepId, Name, ElementList}, <<>>, _Len2, NewC} =
+ dec_type({'tk_struct', "", "",
+ [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}},
+ {"element list",
+ {'tk_sequence', {'tk_struct', "","",
+ [{"member name", {'tk_string', 0}},
+ {"member type", 'tk_TypeCode'}]},
+ 0}}]},
+ Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
+ {{'tk_struct', RepId, Name, ElementList}, Message1, Len1, NewC};
+dec_type_code(16, Version, Message, Len, ByteOrder, Buff, C) ->
+ {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
+ %% Decode marshalled parameters, eg get the byteorder first
+ {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
+ {{RepId, Name, DiscrTC, Default}, Rest2, RestLen2, NewC} =
+ dec_type({'tk_struct', "", "",
+ [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}},
+ {"discriminant type", 'tk_TypeCode'},
+ {"default used", 'tk_long'}]},
+ Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
+ {ElementList, <<>>, _RestLen3, NewC2} =
+ dec_type({'tk_sequence', {'tk_struct', "","",
+ [{"label value", DiscrTC},
+ {"member name", {'tk_string', 0}},
+ {"member type", 'tk_TypeCode'}]}, 0},
+ Version, Rest2, RestLen2, ByteOrder1, Buff, NewC),
+ NewElementList =
+ case check_enum(DiscrTC) of
+ true ->
+ lists:map(fun({L,N,T}) -> {atom_to_list(L),N,T} end, ElementList);
+ false ->
+ ElementList
+ end,
+ {{'tk_union', RepId, Name, DiscrTC, Default, NewElementList}, Message1, Len1, NewC2};
+dec_type_code(17, Version, Message, Len, ByteOrder, Buff, C) ->
+ {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
+ %% Decode marshalled parameters, eg get the byteorder first
+ {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
+ {{RepId, Name, ElementList}, <<>>, _Len2, NewC} =
+ dec_type({'tk_struct', "", "",
+ [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}},
+ {"element list",
+ {'tk_sequence', {'tk_string', 0}, 0}}]},
+ Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
+ {{'tk_enum', RepId, Name, ElementList}, Message1, Len1, NewC};
+dec_type_code(18, Version, Message, Len, ByteOrder, Buff, C) ->
+ {MaxLength, Message1, Len1, NewC} =
+ dec_type('tk_ulong', Version, Message, Len, ByteOrder, Buff, C),
+ {{'tk_string', MaxLength}, Message1, Len1, NewC};
+dec_type_code(19, Version, Message, Len, ByteOrder, Buff, C) ->
+ {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
+ %% Decode marshalled parameters, eg get the byteorder first
+ {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
+ {{ElemTC, MaxLength}, <<>>, _Len2, NewC} =
+ dec_type({'tk_struct', "", "", [{"element type", 'tk_TypeCode'},
+ {"max length", 'tk_ulong'}]},
+ Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
+ {{'tk_sequence', ElemTC, MaxLength}, Message1, Len1, NewC};
+dec_type_code(20, Version, Message, Len, ByteOrder, Buff, C) ->
+ {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
+ %% Decode marshalled parameters, eg get the byteorder first
+ {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
+ {{ElemTC, Length}, <<>>, _Len2, NewC} =
+ dec_type({'tk_struct', "", "", [{"element type", 'tk_TypeCode'},
+ {"length", 'tk_ulong'}]},
+ Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
+ {{'tk_array', ElemTC, Length}, Message1, Len1, NewC};
+dec_type_code(21, Version, Message, Len, ByteOrder, Buff, C) ->
+ {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
+ %% Decode marshalled parameters, eg ge a byteorder first
+ {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
+ {{RepId, Name, TC}, <<>>, _Len2, NewC} =
+ dec_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}},
+ {"TypeCode", 'tk_TypeCode'}]},
+ Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
+ {{'tk_alias', RepId, Name, TC}, Message1, Len1, NewC};
+dec_type_code(22, Version, Message, Len, ByteOrder, Buff, C) ->
+ {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
+ %% Decode marshalled parameters, eg get the byteorder first
+ {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
+ {{RepId, Name, ElementList}, <<>>, _Len2, NewC} =
+ dec_type({'tk_struct', "", "",
+ [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}},
+ {"element list",
+ {'tk_sequence', {'tk_struct', "","",
+ [{"member name", {'tk_string', 0}},
+ {"member type", 'tk_TypeCode'}]},
+ 0}}]},
+ Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
+ {{'tk_except', RepId, Name, ElementList}, Message1, Len1, NewC};
+dec_type_code(27, Version, Message, Len, ByteOrder, Buff, C) ->
+ {MaxLength, Message1, Len1, NewC} =
+ dec_type('tk_ulong', Version, Message, Len, ByteOrder, Buff, C),
+ {{'tk_wstring', MaxLength}, Message1, Len1, NewC};
+dec_type_code(28, Version, Message, Len, ByteOrder, Buff, C) ->
+ {Digits, Message1, Len1, C1} =
+ dec_type('tk_ushort', Version, Message, Len, ByteOrder, Buff, C),
+ {Scale, Message2, Len2, C2} =
+ dec_type('tk_short', Version, Message1, Len1, ByteOrder, Buff, C1),
+ {{'tk_fixed', Digits, Scale}, Message2, Len2, C2};
+dec_type_code(29, Version, Message, Len, ByteOrder, Buff, C) ->
+ {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
+ {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
+ {{RepId, Name, ValueModifier, TC, ElementList}, <<>>, _Len2, NewC} =
+ dec_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}},
+ {"ValueModifier", 'tk_short'},
+ {"TypeCode", 'tk_TypeCode'},
+ {"element list",
+ {'tk_sequence',
+ {'tk_struct', "","",
+ [{"member name", {'tk_string', 0}},
+ {"member type", 'tk_TypeCode'},
+ {"Visibility", 'tk_short'}]},
+ 0}}]},
+ Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
+ {{'tk_value', RepId, Name, ValueModifier, TC, ElementList}, Message1, Len1, NewC};
+dec_type_code(30, Version, Message, Len, ByteOrder, Buff, C) ->
+ {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
+ {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
+ {{RepId, Name, TC}, <<>>, _Len2, NewC} =
+ dec_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}},
+ {"TypeCode", 'tk_TypeCode'}]},
+ Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
+ {{'tk_value_box', RepId, Name, TC}, Message1, Len1, NewC};
+dec_type_code(31, Version, Message, Len, ByteOrder, Buff, C) ->
+ {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
+ {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
+ {{RepId, Name}, <<>>, _Len2, NewC} =
+ dec_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}}]},
+ Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
+ {{'tk_native', RepId, Name}, Message1, Len1, NewC};
+dec_type_code(32, Version, Message, Len, ByteOrder, Buff, C) ->
+ {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
+ {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
+ {{RepId, Name}, <<>>, _Len2, NewC} =
+ dec_type({'tk_struct', "", "", [{"RepositoryId", {'tk_string', 0}},
+ {"name", {'tk_string', 0}}]},
+ Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
+ {{'tk_abstract_interface', RepId, Name}, Message1, Len1, NewC};
+dec_type_code(33, Version, Message, Len, ByteOrder, Buff, C) ->
+ {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
+ {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
+ {{RepId, Name}, <<>>, _Len2, NewC} =
+ dec_type({'tk_struct', "", "", [{"RepositoryId", {'tk_string', 0}},
+ {"name", {'tk_string', 0}}]},
+ Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
+ {{'tk_local_interface', RepId, Name}, Message1, Len1, NewC};
+dec_type_code(16#ffffffff, Version, Message, Len, ByteOrder, Buff, C) -> %% placeholder
+ {Indirection, Message1, Len1, NewC} =
+ dec_type('tk_long', Version, Message, Len, ByteOrder, Buff, C),
+ Position = C+Indirection,
+ <<_:Position/binary, SubBuff/binary>> = Buff,
+ {TC, _, _, _} = dec_type_code(Version, SubBuff, Position, ByteOrder, Buff, Position),
+ {TC, Message1, Len1, NewC};
+dec_type_code(Type, _, _, _, _, _, _) ->
+ orber:dbg("[~p] cdr_decode:dec_type_code(~p); No match.",
+ [?LINE, Type], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 8), completion_status=?COMPLETED_MAYBE}).
+
+check_enum({'tk_enum', _, _, _}) ->
+ true;
+check_enum(_) ->
+ false.
+
+
+decode_complex_tc_parameters(_Version, Message, Len, ByteOrder) ->
+ {Rest, Len1, NewC} = dec_align(Message, Len, 4, 0),
+ {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
+ <<OctetSeq:Size/binary, Rest2/binary>> = Rest1,
+ {OctetSeq, Rest2, Len1+4+Size, NewC+4}.
+
+%%-----------------------------------------------------------------
+%% Func: dec_align/3
+%% Args:
+%% R - The byte sequence that shall be aligned.
+%% Len - The number of bytes read so far.
+%% Alignment - The alignment as an integer (for example: 2,4,8).
+%% Returns:
+%% An aligned byte sequence.
+%%-----------------------------------------------------------------
+dec_align(R, Len, Alignment, C) ->
+ Rem = Len rem Alignment,
+ if Rem == 0 ->
+ {R, Len, C};
+ true ->
+ Diff = Alignment - Rem,
+ <<_:Diff/binary,Rest/binary>> = R,
+ {Rest, Len + Diff, C + Diff}
+ end.
+
+%%---------------- EOF MODULE ----------------------------------------
diff --git a/lib/orber/src/cdr_encode.erl b/lib/orber/src/cdr_encode.erl
new file mode 100644
index 0000000000..3ecb8833f5
--- /dev/null
+++ b/lib/orber/src/cdr_encode.erl
@@ -0,0 +1,1151 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: cdr_encode.erl
+%%
+%% Description:
+%% This file contains all encoding functions for the CDR
+%% format.
+%%
+%%-----------------------------------------------------------------
+-module(cdr_encode).
+
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/src/orber_iiop.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([enc_giop_msg_type/1,
+ enc_request/1, enc_request_split/1,
+ enc_reply/1, enc_reply_split/1,
+ enc_type/3, enc_type/5,
+ enc_cancel_request/1,
+ enc_locate_request/1,
+ enc_locate_reply/1,
+ enc_close_connection/1,
+ enc_message_error/1,
+ enc_fragment/1,
+ enc_giop_message_header/5,
+ validate_request_body/1,
+ validate_reply_body/2]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([]).
+
+%%-----------------------------------------------------------------
+%% Macros
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 9).
+
+-define(ODD(N), (N rem 2) == 1).
+
+%%-----------------------------------------------------------------
+%% External functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: enc_giop_message_header/5
+%%-----------------------------------------------------------------
+%% The header size is known so we know that the size will be aligned.
+%% MessSize already includes the header length.
+%%-----------------------------------------------------------------
+enc_giop_message_header(#giop_env{version = {Major,Minor}}, MessType,
+ _Flags, MessSize, Message) ->
+ Type = enc_giop_msg_type(MessType),
+ %% The Flag handling must be fixed, i.e., it's not correct to only use '0'.
+ %% If IIOP-1.0 a boolean (FALSE == 0), otherwise, IIOP-1.1 or 1.2,
+ %% an octet. The octet bits represents:
+ %% * The least significant the byteorder (0 eq. big-endian)
+ %% * The second least significant indicates if the message is fragmented.
+ %% If set to 0 it's not fragmented.
+ %% * The most significant 6 bits are reserved. Hence, must be set to 0.
+ %% Since we currently don't support fragmented messages and we always
+ %% encode using big-endian it's ok to use '0' for now.
+ list_to_binary([ <<"GIOP",Major:8,Minor:8,0:8,
+ Type:8,MessSize:32/big-unsigned-integer>> | Message]).
+
+enc_byte_order(Env, Message) ->
+ enc_type('tk_boolean', Env, 'false', Message, 0).
+
+%%-----------------------------------------------------------------
+%% Func: enc_parameters/2
+%%-----------------------------------------------------------------
+enc_parameters(_, [], [], Message, Len) ->
+ {Message, Len};
+enc_parameters(_, [], P, _, _) ->
+ orber:dbg("[~p] cdr_encode:encode_parameters(~p); to many parameters.",
+ [?LINE, P], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 17), completion_status=?COMPLETED_MAYBE});
+enc_parameters(_, _, [], TC, _) ->
+ orber:dbg("[~p] cdr_encode:encode_parameters(~p); to few parameters.",
+ [?LINE, TC], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 17), completion_status=?COMPLETED_MAYBE});
+enc_parameters(Env, [PT1 |TypeList], [ P1 | Parameters], Message, Len) ->
+ {Message1, Len1} = enc_type(PT1, Env, P1, Message, Len),
+ enc_parameters(Env, TypeList, Parameters, Message1, Len1).
+
+%%-----------------------------------------------------------------
+%% Func: enc_request/8
+%%-----------------------------------------------------------------
+%% ## NEW IIOP 1.2 ##
+enc_request(#giop_env{version = {1,2}} = Env) ->
+ Flags = 1, %% LTH Not correct, just placeholder
+ {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
+ {Message1, Len1} = enc_response_flags(Env, Message, Len),
+ {Message2, Len2} = enc_reserved(Env, {0,0,0}, Message1, Len1),
+ {Message3, Len3} = enc_target_address(Env, Message2, Len2),
+ {Message4, Len4} = enc_operation(Env, Message3, Len3),
+ {Message5, Len5} = enc_service_context(Env, Message4, Len4),
+ {Message6, Len6} = enc_request_body(Env, Message5, Len5),
+ enc_giop_message_header(Env, 'request', Flags, Len6 - ?GIOP_HEADER_SIZE,
+ lists:reverse(Message6));
+enc_request(#giop_env{version = Version} = Env) ->
+ Flags = 1, %% LTH Not correct, just placeholder
+ {Message0, Len0} = enc_service_context(Env, [], ?GIOP_HEADER_SIZE),
+ {Message, Len} = enc_request_id(Env, Message0, Len0),
+ {Message1, Len1} = enc_response(Env, Message, Len),
+ {Message1b, Len1b} =
+ if
+ Version /= {1,0} ->
+ enc_reserved(Env, {0,0,0}, Message1, Len1);
+ true ->
+ {Message1, Len1}
+ end,
+ {Message2, Len2} = enc_object_key(Env, Message1b, Len1b),
+ {Message3, Len3} = enc_operation(Env, Message2, Len2),
+ {Message4, Len4} = enc_principal(Env, Message3, Len3),
+ {Message5, Len5} = enc_request_body(Env, Message4, Len4),
+ enc_giop_message_header(Env, 'request', Flags, Len5 - ?GIOP_HEADER_SIZE,
+ lists:reverse(Message5)).
+
+%% ## NEW IIOP 1.2 ##
+enc_request_split(#giop_env{version = {1,2}} = Env) ->
+ Flags = 1, %% LTH Not correct, just placeholder
+ {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
+ {Message1, Len1} = enc_response_flags(Env, Message, Len),
+ {Message2, Len2} = enc_reserved(Env, {0,0,0}, Message1, Len1),
+ {Message3, Len3} = enc_target_address(Env, Message2, Len2),
+ {Message4, Len4} = enc_operation(Env, Message3, Len3),
+ {Message5, Len5} = enc_service_context(Env, Message4, Len4),
+ {Body, Len6} = enc_request_body(Env, [], Len5),
+ {lists:reverse(Message5), list_to_binary(lists:reverse(Body)),
+ Len5 - ?GIOP_HEADER_SIZE, Len6-Len5, Flags};
+enc_request_split(#giop_env{version = Version} = Env) ->
+ Flags = 1, %% LTH Not correct, just placeholder
+ {Message0, Len0} = enc_service_context(Env, [], ?GIOP_HEADER_SIZE),
+ {Message, Len} = enc_request_id(Env, Message0, Len0),
+ {Message1, Len1} = enc_response(Env, Message, Len),
+ {Message1b, Len1b} =
+ if
+ Version /= {1,0} ->
+ enc_reserved(Env, {0,0,0}, Message1, Len1);
+ true ->
+ {Message1, Len1}
+ end,
+ {Message2, Len2} = enc_object_key(Env, Message1b, Len1b),
+ {Message3, Len3} = enc_operation(Env, Message2, Len2),
+ {Message4, Len4} = enc_principal(Env, Message3, Len3),
+ {Body, Len5} = enc_request_body(Env, [], Len4),
+ {lists:reverse(Message4), list_to_binary(lists:reverse(Body)),
+ Len4 - ?GIOP_HEADER_SIZE, Len5-Len4, Flags}.
+
+enc_principal(Env, Mess, Len) ->
+ enc_type({'tk_string', 0}, Env, atom_to_list(node()), Mess, Len).
+
+enc_operation(Env, Mess, Len) ->
+ enc_type({'tk_string', 0}, Env, atom_to_list(Env#giop_env.op), Mess, Len).
+
+enc_object_key(Env, Mess, Len) ->
+ enc_type({'tk_sequence', 'tk_octet', 0}, Env, Env#giop_env.objkey, Mess, Len).
+
+enc_reserved(Env, Reserved, Mess, Len) ->
+ enc_type({'tk_array', 'tk_octet', 3}, Env, Reserved, Mess, Len).
+
+enc_response(Env, Mess, Len) ->
+ enc_type('tk_boolean', Env, Env#giop_env.response_expected, Mess, Len).
+
+enc_request_id(Env, Mess, Len) ->
+ enc_type('tk_ulong', Env, Env#giop_env.request_id, Mess, Len).
+
+enc_service_context(Env, Message, Len) ->
+ Ctxs = enc_used_contexts(Env, Env#giop_env.ctx, []),
+ enc_type(?IOP_SERVICECONTEXT, Env, Ctxs, Message, Len).
+
+enc_used_contexts(_Env, [], Message) ->
+ Message;
+enc_used_contexts(#giop_env{version = {1, 0}} = Env,
+ [#'IOP_ServiceContext'{context_id=?IOP_CodeSets}|T], Ctxs) ->
+ %% Not supported by 1.0, drop it.
+ enc_used_contexts(Env, T, Ctxs);
+enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?IOP_CodeSets,
+ context_data = CodeSetCtx}|T],
+ Ctxs) ->
+ %% Encode ByteOrder
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0),
+ {Bytes1, _Len1} = enc_type(?CONV_FRAME_CODESETCONTEXT, Env, CodeSetCtx,
+ Bytes0, Len0),
+ Bytes = list_to_binary(lists:reverse(Bytes1)),
+ enc_used_contexts(Env, T,
+ [#'IOP_ServiceContext'{context_id=?IOP_CodeSets,
+ context_data = Bytes}|Ctxs]);
+enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?IOP_BI_DIR_IIOP,
+ context_data = BiDirCtx}|T],
+ Ctxs) ->
+ %% Encode ByteOrder
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0),
+ {Bytes1, _Len1} = enc_type(?IIOP_BIDIRIIOPSERVICECONTEXT, Env, BiDirCtx,
+ Bytes0, Len0),
+ Bytes = list_to_binary(lists:reverse(Bytes1)),
+ enc_used_contexts(Env, T,
+ [#'IOP_ServiceContext'{context_id=?IOP_BI_DIR_IIOP,
+ context_data = Bytes}|Ctxs]);
+enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?IOP_FT_REQUEST,
+ context_data = Ctx}|T],
+ Ctxs) ->
+ %% Encode ByteOrder
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0),
+ {Bytes1, _Len1} = enc_type(?FT_FTRequestServiceContext, Env, Ctx,
+ Bytes0, Len0),
+ Bytes = list_to_binary(lists:reverse(Bytes1)),
+ enc_used_contexts(Env, T,
+ [#'IOP_ServiceContext'{context_id=?IOP_FT_REQUEST,
+ context_data = Bytes}|Ctxs]);
+enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?IOP_FT_GROUP_VERSION,
+ context_data = Ctx}|T],
+ Ctxs) ->
+ %% Encode ByteOrder
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0),
+ {Bytes1, _Len1} = enc_type(?FT_FTGroupVersionServiceContext, Env, Ctx,
+ Bytes0, Len0),
+ Bytes = list_to_binary(lists:reverse(Bytes1)),
+ enc_used_contexts(Env, T,
+ [#'IOP_ServiceContext'{context_id=?IOP_FT_GROUP_VERSION,
+ context_data = Bytes}|Ctxs]);
+enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
+ context_data = Ctx}|T],
+ Ctxs) ->
+ %% Encode ByteOrder
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0),
+ {Bytes1, _Len1} = enc_type(?CSI_SASContextBody, Env, Ctx,
+ Bytes0, Len0),
+ Bytes = list_to_binary(lists:reverse(Bytes1)),
+ enc_used_contexts(Env, T,
+ [#'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
+ context_data = Bytes}|Ctxs]);
+enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
+ context_data = {interface, _I}}|T],
+ Ctxs) ->
+ %% This shall not be forwarded.
+ enc_used_contexts(Env, T, Ctxs);
+enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
+ context_data = {configuration, _O}}|T],
+ Ctxs) ->
+ %% This shall not be forwarded.
+ enc_used_contexts(Env, T, Ctxs);
+enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
+ context_data = Ctx}|T],
+ Ctxs) ->
+ %% Encode ByteOrder
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0),
+ {Bytes1, _Len1} = enc_type(?ORBER_GENERIC_CTX, Env,
+ binary_to_list(term_to_binary(Ctx)),
+ Bytes0, Len0),
+ Bytes = list_to_binary(lists:reverse(Bytes1)),
+ enc_used_contexts(Env, T,
+ [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
+ context_data = Bytes}|Ctxs]);
+enc_used_contexts(Env, [H|T], Ctxs) ->
+ enc_used_contexts(Env, T, [H|Ctxs]).
+
+%% ## NEW IIOP 1.2 ##
+enc_target_address(#giop_env{objkey = TargetAddr} = Env, Mess, Len)
+ when is_record(TargetAddr, 'GIOP_TargetAddress') ->
+ enc_type(?TARGETADDRESS, Env, TargetAddr, Mess, Len);
+enc_target_address(#giop_env{objkey = IORInfo} = Env, Mess, Len)
+ when is_record(IORInfo, 'GIOP_IORAddressingInfo') ->
+ enc_type(?TARGETADDRESS, Env, #'GIOP_TargetAddress'{label = ?GIOP_ReferenceAddr,
+ value = IORInfo},
+ Mess, Len);
+enc_target_address(#giop_env{objkey = TP} = Env, Mess, Len)
+ when is_record(TP, 'IOP_TaggedProfile') ->
+ enc_type(?TARGETADDRESS, Env, #'GIOP_TargetAddress'{label = ?GIOP_ProfileAddr,
+ value = TP},
+ Mess, Len);
+enc_target_address(#giop_env{objkey = ObjKey} = Env, Mess, Len) ->
+ enc_type(?TARGETADDRESS, Env, #'GIOP_TargetAddress'{label = ?GIOP_KeyAddr,
+ value = ObjKey},
+ Mess, Len).
+
+%% FIX ME!! This is temporary, not proper flag handling.
+enc_response_flags(#giop_env{response_expected = true} = Env, Mess, Len) ->
+ enc_type('tk_octet', Env, 3, Mess, Len);
+enc_response_flags(#giop_env{response_expected = false} = Env, Mess, Len) ->
+ enc_type('tk_octet', Env, 0, Mess, Len).
+
+%%-----------------------------------------------------------------
+%% Func: enc_request_body/5
+%%-----------------------------------------------------------------
+enc_request_body(#giop_env{tc = {_, [], _}}, Message, Len) ->
+ %% This case is used to avoid adding alignment even though no body will be added.
+ {Message, Len};
+enc_request_body(#giop_env{version = {1,2},
+ tc = {_RetType, InParameters, _OutParameters},
+ parameters = Parameters} = Env,
+ Message, Len) ->
+ {Message1, Len1} = enc_align(Message, Len, 8),
+ enc_parameters(Env, InParameters, Parameters, Message1, Len1);
+enc_request_body(#giop_env{tc = {_RetType, InParameters, _OutParameters},
+ parameters = Parameters} = Env,
+ Message, Len) ->
+ enc_parameters(Env, InParameters, Parameters, Message, Len).
+
+%%-----------------------------------------------------------------
+%% Func: validate_request_body/1
+%%-----------------------------------------------------------------
+validate_request_body(#giop_env{tc = {_RetType, InParameters, _OutParameters},
+ parameters = Parameters} = Env) ->
+ enc_parameters(Env, InParameters, Parameters, [], 0).
+
+%%-----------------------------------------------------------------
+%% Func: enc_reply/6
+%%-----------------------------------------------------------------
+%% ## NEW IIOP 1.2 ##
+enc_reply(#giop_env{version = {1,2}} = Env) ->
+ Flags = 1, %% LTH Not correct, just placeholder
+ {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
+ {Message1, Len1} = enc_reply_status(Env, Message, Len),
+ {Message2, Len2} = enc_service_context(Env, Message1, Len1),
+ {Message3, Len3} = enc_reply_body(Env, Message2, Len2),
+ enc_giop_message_header(Env, 'reply', Flags, Len3 - ?GIOP_HEADER_SIZE,
+ lists:reverse(Message3));
+enc_reply(Env) ->
+ Flags = 1, %% LTH Not correct, just placeholder
+ {Message, Len} = enc_service_context(Env, [], ?GIOP_HEADER_SIZE),
+ {Message1, Len1} = enc_request_id(Env, Message, Len),
+ {Message2, Len2} = enc_reply_status(Env, Message1, Len1),
+ {Message3, Len3} = enc_reply_body(Env, Message2, Len2),
+ enc_giop_message_header(Env, 'reply', Flags, Len3 - ?GIOP_HEADER_SIZE,
+ lists:reverse(Message3)).
+
+%% ## NEW IIOP 1.2 ##
+enc_reply_split(#giop_env{version = {1,2}} = Env) ->
+ Flags = 1, %% LTH Not correct, just placeholder
+ {Message, Len0} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
+ {Message1, Len1} = enc_reply_status(Env, Message, Len0),
+ {Message2, Len2} = enc_service_context(Env, Message1, Len1),
+ {Body, Len} = enc_reply_body(Env, [], Len2),
+ {lists:reverse(Message2), list_to_binary(lists:reverse(Body)),
+ Len2 - ?GIOP_HEADER_SIZE, Len-Len2, Flags};
+enc_reply_split(Env) ->
+ Flags = 1, %% LTH Not correct, just placeholder
+ {Message, Len0} = enc_service_context(Env, [], ?GIOP_HEADER_SIZE),
+ {Message1, Len1} = enc_request_id(Env, Message, Len0),
+ {Message2, Len2} = enc_reply_status(Env, Message1, Len1),
+ {Body, Len} = enc_reply_body(Env, [], Len2),
+ {lists:reverse(Message2), list_to_binary(lists:reverse(Body)),
+ Len2 - ?GIOP_HEADER_SIZE, Len-Len2, Flags}.
+
+enc_reply_status(Env, Mess, Len) ->
+ L = enc_giop_reply_status_type(Env#giop_env.reply_status),
+ enc_type('tk_ulong', Env, L, Mess, Len).
+
+%%-----------------------------------------------------------------
+%% Func: enc_reply_body/6
+%%-----------------------------------------------------------------
+enc_reply_body(#giop_env{tc = {'tk_void', _, []}, result = ok,
+ parameters = []}, Message, Len) ->
+ %% This case is mainly to be able to avoid adding alignment for
+ %% IIOP-1.2 messages if the body should be empty, i.e., void return value and
+ %% no out parameters.
+ {Message, Len};
+enc_reply_body(#giop_env{version = {1,2},
+ tc = {RetType, _InParameters, OutParameters},
+ parameters = Parameters, result = Result} = Env,
+ Message, Len) ->
+ {Message1, Len1} = enc_align(Message, Len, 8),
+ {Message2, Len2} = enc_type(RetType, Env, Result, Message1, Len1),
+ enc_parameters(Env, OutParameters, Parameters, Message2, Len2);
+enc_reply_body(#giop_env{tc = {RetType, _InParameters, OutParameters},
+ parameters = Parameters, result = Result} = Env,
+ Message, Len) ->
+ {Message1, Len1} = enc_type(RetType, Env, Result, Message, Len),
+ enc_parameters(Env, OutParameters, Parameters, Message1, Len1).
+
+
+%%-----------------------------------------------------------------
+%% Func: validate_reply_body/3
+%%-----------------------------------------------------------------
+validate_reply_body(Env, {'EXCEPTION', Exception}) ->
+ {TypeOfException, ExceptionTypeCode, NewExc} =
+ orber_exceptions:get_def(Exception),
+ {'tk_except', TypeOfException, ExceptionTypeCode,
+ (catch enc_reply_body(Env#giop_env{tc = {ExceptionTypeCode, [], []},
+ result = NewExc, parameters = []}, [], 0))};
+validate_reply_body(#giop_env{tc = {_RetType, _InParameters, []}} = Env, Reply) ->
+ enc_reply_body(Env#giop_env{result = Reply}, [], 0);
+validate_reply_body(Env, Reply) when is_tuple(Reply) ->
+ [Result|Parameters] = tuple_to_list(Reply),
+ enc_reply_body(Env#giop_env{result = Result, parameters = Parameters}, [], 0);
+validate_reply_body(Env, Reply) ->
+ enc_reply_body(Env#giop_env{result = Reply}, [], 0).
+
+%%-----------------------------------------------------------------
+%% Func: enc_cancel_request/2
+%%-----------------------------------------------------------------
+enc_cancel_request(Env) ->
+ Flags = 1, %% LTH Not correct, just placeholder
+ {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
+ enc_giop_message_header(Env, 'cancel_request', Flags, Len - ?GIOP_HEADER_SIZE,
+ lists:reverse(Message)).
+
+%%-----------------------------------------------------------------
+%% Func: enc_locate_request/3
+%%-----------------------------------------------------------------
+%% ## NEW IIOP 1.2 ##
+enc_locate_request(#giop_env{version = {1,2}} = Env) ->
+ Flags = 1, %% LTH Not correct, just placeholder
+ {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
+ {Message1, Len1} = enc_target_address(Env, Message, Len),
+ enc_giop_message_header(Env, 'locate_request', Flags, Len1-?GIOP_HEADER_SIZE,
+ lists:reverse(Message1));
+enc_locate_request(Env) ->
+ Flags = 1, %% LTH Not correct, just placeholder
+ {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
+ {Message1, Len1} = enc_object_key(Env, Message, Len),
+ enc_giop_message_header(Env, 'locate_request', Flags, Len1-?GIOP_HEADER_SIZE,
+ lists:reverse(Message1)).
+
+%%-----------------------------------------------------------------
+%% Func: enc_locate_reply
+%%-----------------------------------------------------------------
+%% No forward etc. Just encode the status.
+enc_locate_reply(#giop_env{tc = undefined} = Env) ->
+ Flags = 1, %% LTH Not correct, just placeholder
+ {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
+ {Message1, Len1} = enc_locate_status(Env, Message, Len),
+ enc_giop_message_header(Env, 'locate_reply', Flags, Len1 - ?GIOP_HEADER_SIZE,
+ lists:reverse(Message1));
+enc_locate_reply(Env) ->
+ Flags = 1, %% LTH Not correct, just placeholder
+ {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
+ {Message1, Len1} = enc_locate_status(Env, Message, Len),
+ {Message2, Len2} = enc_locate_reply_body(Env, Message1, Len1),
+ enc_giop_message_header(Env, 'locate_reply', Flags, Len2 - ?GIOP_HEADER_SIZE,
+ lists:reverse(Message2)).
+
+enc_locate_reply_body(#giop_env{tc = TC, result = Data} = Env, Message, Len) ->
+ %% In CORBA-2.3.1 the LocateReply body didn't align the body (8-octet
+ %% boundry) for IIOP-1.2. This have been changed in later specs.
+ %% Un-comment the line below when we want to be CORBA-2.4 compliant.
+ %% But in CORB-2.6 this was changed once again (i.e. no alignment).
+ %% The best solution is to keep it as is.
+ enc_type(TC, Env, Data, Message, Len).
+
+enc_locate_status(Env, Mess, Len) ->
+ L = enc_giop_locate_status_type(Env#giop_env.reply_status),
+ enc_type('tk_ulong', Env, L, Mess, Len).
+%%-----------------------------------------------------------------
+%% Func: enc_close_connection/1
+%%-----------------------------------------------------------------
+enc_close_connection(Env) ->
+ Flags = 1, %% LTH Not correct, just placeholder
+ enc_giop_message_header(Env, 'close_connection', Flags, 0, []).
+
+%%-----------------------------------------------------------------
+%% Func: enc_message_error/1
+%%-----------------------------------------------------------------
+enc_message_error(Env) ->
+ Flags = 1, %% LTH Not correct, just placeholder
+ enc_giop_message_header(Env, 'message_error', Flags, 0, []).
+
+%%-----------------------------------------------------------------
+%% Func: enc_fragment/1
+%%-----------------------------------------------------------------
+enc_fragment(Env) ->
+ Flags = 1, %% LTH Not correct, just placeholder
+ enc_giop_message_header(Env, 'fragment', Flags, 0, []).
+
+%%-----------------------------------------------------------------
+%% Func: enc_giop_msg_type
+%% Args: An integer message type code
+%% Returns: An atom which is the message type code name
+%%-----------------------------------------------------------------
+enc_giop_msg_type('request') ->
+ 0;
+enc_giop_msg_type('reply') ->
+ 1;
+enc_giop_msg_type('cancel_request') ->
+ 2;
+enc_giop_msg_type('locate_request') ->
+ 3;
+enc_giop_msg_type('locate_reply') ->
+ 4;
+enc_giop_msg_type('close_connection') ->
+ 5;
+enc_giop_msg_type('message_error') ->
+ 6;
+enc_giop_msg_type('fragment') ->
+ 7.
+
+
+%%-----------------------------------------------------------------
+%% Func: enc_giop_reply_status_type
+%% Args: An atom which is the reply status
+%% Returns: An integer status code
+%%-----------------------------------------------------------------
+enc_giop_reply_status_type(?NO_EXCEPTION) ->
+ 0;
+enc_giop_reply_status_type(?USER_EXCEPTION) ->
+ 1;
+enc_giop_reply_status_type(?SYSTEM_EXCEPTION) ->
+ 2;
+enc_giop_reply_status_type('location_forward') ->
+ 3;
+%% ## NEW IIOP 1.2 ##
+enc_giop_reply_status_type('location_forward_perm') ->
+ 4;
+enc_giop_reply_status_type('needs_addressing_mode') ->
+ 5.
+
+%%-----------------------------------------------------------------
+%% Func: enc_giop_locate_status_type
+%% Args: An integer status code
+%% Returns: An atom which is the reply status
+%%-----------------------------------------------------------------
+enc_giop_locate_status_type('unknown_object') ->
+ 0;
+enc_giop_locate_status_type('object_here') ->
+ 1;
+enc_giop_locate_status_type('object_forward') ->
+ 2;
+%% ## NEW IIOP 1.2 ##
+enc_giop_locate_status_type('object_forward_perm') ->
+ 3;
+enc_giop_locate_status_type('loc_system_exception') ->
+ 4;
+enc_giop_locate_status_type('loc_needs_addressing_mode') ->
+ 5.
+
+%%-----------------------------------------------------------------
+%% Func: enc_type/3
+%%-----------------------------------------------------------------
+enc_type(Env, TypeCode, Value) ->
+ {Bytes, _Len} = enc_type(TypeCode, Env, Value, [], 0),
+ list_to_binary(lists:reverse(Bytes)).
+
+%%-----------------------------------------------------------------
+%% Func: enc_type/5
+%%-----------------------------------------------------------------
+enc_type('tk_null', _Env, null, Bytes, Len) ->
+ {Bytes, Len};
+enc_type('tk_void', _Env, ok, Bytes, Len) ->
+ {Bytes, Len};
+enc_type('tk_short', _Env, Value, Bytes, Len) ->
+ {Rest, Len1} = enc_align(Bytes, Len, 2),
+ {cdrlib:enc_short(Value, Rest), Len1 + 2};
+enc_type('tk_long', _Env, Value, Bytes, Len) ->
+ {Rest, Len1} = enc_align(Bytes, Len, 4),
+ {cdrlib:enc_long(Value, Rest ), Len1 + 4};
+enc_type('tk_longlong', _Env, Value, Bytes, Len) ->
+ {Rest, Len1} = enc_align(Bytes, Len, 8),
+ {cdrlib:enc_longlong(Value, Rest ), Len1 + 8};
+enc_type('tk_ushort', _Env, Value, Bytes, Len) ->
+ {Rest, Len1} = enc_align(Bytes, Len, 2),
+ {cdrlib:enc_unsigned_short(Value, Rest), Len1 + 2};
+enc_type('tk_ulong', _Env, Value, Bytes, Len) ->
+ {Rest, Len1} = enc_align(Bytes, Len, 4),
+ {cdrlib:enc_unsigned_long(Value, Rest), Len1 + 4};
+enc_type('tk_ulonglong', _Env, Value, Bytes, Len) ->
+ {Rest, Len1} = enc_align(Bytes, Len, 8),
+ {cdrlib:enc_unsigned_longlong(Value, Rest), Len1 + 8};
+enc_type('tk_float', _Env, Value, Bytes, Len) ->
+ {Rest, Len1} = enc_align(Bytes, Len, 4),
+ {cdrlib:enc_float(Value, Rest), Len1 + 4};
+enc_type('tk_double', _Env, Value, Bytes, Len) ->
+ {Rest, Len1} = enc_align(Bytes, Len, 8),
+ {cdrlib:enc_double(Value, Rest), Len1 + 8};
+enc_type('tk_boolean', _Env, Value, Bytes, Len) ->
+ {cdrlib:enc_bool(Value, Bytes), Len + 1};
+enc_type('tk_char', _Env, Value, Bytes, Len) ->
+ {cdrlib:enc_char(Value, Bytes), Len + 1};
+%% The wchar decoding can be 1, 2 or 4 bytes but for now we only accept 2.
+enc_type('tk_wchar', #giop_env{version = {1,2}}, Value, Bytes, Len) ->
+ Bytes1 = cdrlib:enc_octet(2, Bytes),
+ {cdrlib:enc_unsigned_short(Value, Bytes1), Len + 3};
+enc_type('tk_wchar', _Env, Value, Bytes, Len) ->
+ {Rest, Len1} = enc_align(Bytes, Len, 2),
+ {cdrlib:enc_unsigned_short(Value, Rest), Len1 + 2};
+enc_type('tk_octet', _Env, Value, Bytes, Len) ->
+ {cdrlib:enc_octet(Value, Bytes), Len + 1};
+enc_type('tk_any', Env, Any, Bytes, Len) when is_record(Any, any) ->
+ {Rest, Len1} = enc_type('tk_TypeCode', Env, Any#any.typecode, Bytes, Len),
+ enc_type(Any#any.typecode, Env, Any#any.value, Rest, Len1);
+enc_type('tk_TypeCode', Env, Value, Bytes, Len) ->
+ enc_type_code(Value, Env, Bytes, Len);
+enc_type('tk_Principal', Env, Value, Bytes, Len) ->
+ %% Set MaxLength no 0 (i.e. unlimited).
+ enc_sequence(Env, Value, 0, 'tk_octet', Bytes, Len);
+enc_type({'tk_objref', _IFRId, Name}, Env, Value, Bytes, Len) ->
+ enc_objref(Env, Name,Value, Bytes, Len);
+enc_type({'tk_struct', _IFRId, _Name, ElementList}, Env, Value, Bytes, Len) ->
+ enc_struct(Env, Value, ElementList, Bytes, Len);
+enc_type({'tk_union', _IFRId, _Name, DiscrTC, Default, ElementList},
+ Env, Value, Bytes, Len) ->
+ enc_union(Env, Value, DiscrTC, Default, ElementList, Bytes, Len);
+enc_type({'tk_enum', _IFRId, _Name, ElementList}, _Env, Value, Bytes, Len) ->
+ {Rest, Len1} = enc_align(Bytes, Len, 4),
+ {cdrlib:enc_enum(atom_to_list(Value), ElementList, Rest), Len1 + 4};
+enc_type({'tk_string', MaxLength}, Env, Value, Bytes, Len) ->
+ enc_string(Env, Value, MaxLength, Bytes, Len);
+enc_type({'tk_wstring', MaxLength}, Env, Value, Bytes, Len) ->
+ enc_wstring(Env, Value, MaxLength, Bytes, Len);
+enc_type({'tk_sequence', ElemTC, MaxLength}, Env, Value, Bytes, Len) ->
+ enc_sequence(Env, Value, MaxLength, ElemTC, Bytes, Len);
+enc_type({'tk_array', ElemTC, Size}, Env, Value, Bytes, Len) ->
+ enc_array(Env, Value, Size, ElemTC, Bytes, Len);
+enc_type({'tk_alias', _IFRId, _Name, TC}, Env, Value, Bytes, Len) ->
+ enc_type(TC, Env, Value, Bytes, Len);
+enc_type({'tk_except', IFRId, Name, ElementList}, Env, Value, Bytes, Len) ->
+ enc_exception(Env, Name, IFRId, Value, ElementList, Bytes, Len);
+enc_type({'tk_fixed', Digits, Scale}, Env, Value, Bytes, Len) ->
+ enc_fixed(Env, Digits, Scale, Value, Bytes, Len);
+enc_type(Type, _, Value, _, _) ->
+ orber:dbg("[~p] cdr_encode:type(~p, ~p)~n"
+ "Incorrect TypeCode or unsupported type.",
+ [?LINE, Type, Value], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 13), completion_status=?COMPLETED_MAYBE}).
+
+
+
+
+%%-----------------------------------------------------------------
+%% Func: enc_fixed
+%%-----------------------------------------------------------------
+%% Digits eq. total number of digits.
+%% Scale eq. position of the decimal point.
+%% E.g. fixed<5,2> - "123.45" eq. #fixed{digits = 5, scale = 2, value = 12345}
+%% E.g. fixed<4,2> - "12.34" eq. #fixed{digits = 4, scale = 2, value = 1234}
+%% These are encoded as:
+%% ## <5,2> ## ## <4,2> ##
+%% 1,2 0,1 eq. 1 octet
+%% 3,4 2,3
+%% 5,0xC 4,0xC
+%%
+%% Each number is encoded as a half-octet. Note, for <4,2> a zero is
+%% added first to to be able to create "even" octets.
+enc_fixed(Env, Digits, Scale,
+ #fixed{digits = Digits, scale = Scale, value = Value}, Bytes, Len)
+ when is_integer(Value) andalso is_integer(Digits) andalso is_integer(Scale)
+ andalso Digits < 32 andalso Digits >= Scale ->
+ %% This isn't very efficient and we should improve it before supporting it
+ %% officially.
+ Odd = ?ODD(Digits),
+ case integer_to_list(Value) of
+ [$-|ValueList] when Odd == true ->
+ Padded = lists:duplicate((Digits-length(ValueList)), 0) ++ ValueList,
+ enc_fixed_2(Env, Digits, Scale, Padded,
+ Bytes, Len, ?FIXED_NEGATIVE);
+ [$-|ValueList] ->
+ Padded = lists:duplicate((Digits-length(ValueList)), 0) ++ ValueList,
+ enc_fixed_2(Env, Digits, Scale, [0|Padded],
+ Bytes, Len, ?FIXED_NEGATIVE);
+ ValueList when Odd == true ->
+ Padded = lists:duplicate((Digits-length(ValueList)), 0) ++ ValueList,
+ enc_fixed_2(Env, Digits, Scale, Padded,
+ Bytes, Len, ?FIXED_POSITIVE);
+ ValueList ->
+ Padded = lists:duplicate((Digits-length(ValueList)), 0) ++ ValueList,
+ enc_fixed_2(Env, Digits, Scale, [0|Padded],
+ Bytes, Len, ?FIXED_POSITIVE)
+ end;
+enc_fixed(_Env, Digits, Scale, Fixed, _Bytes, _Len) ->
+ orber:dbg("[~p] cdr_encode:enc_fixed(~p, ~p, ~p)~n"
+ "The supplied fixed type incorrect. Check that the 'digits' and 'scale' field~n"
+ "match the definition in the IDL-specification. The value field must be~n"
+ "a list of Digits lenght.",
+ [?LINE, Digits, Scale, Fixed], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}).
+
+enc_fixed_2(_Env, _Digits, _Scale, [D1], Bytes, Len, Sign) ->
+ {[<<D1:4,Sign:4>>|Bytes], Len+1};
+enc_fixed_2(Env, Digits, Scale, [D1, D2|Ds], Bytes, Len, Sign) ->
+ %% We could convert the ASCII-value to digit values but the bit-syntax will
+ %% truncate it correctly.
+ enc_fixed_2(Env, Digits, Scale, Ds, [<<D1:4,D2:4>> | Bytes], Len+1, Sign);
+enc_fixed_2(_Env, Digits, Scale, Value, _Bytes, _Len, Sign) ->
+ orber:dbg("[~p] cdr_encode:enc_fixed_2(~p, ~p, ~p, ~p)~n"
+ "The supplied fixed type incorrect. Most likely the 'digits' field don't match the~n"
+ "supplied value. Hence, check that the value is correct.",
+ [?LINE, Digits, Scale, Value, Sign], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}).
+
+
+
+%%-----------------------------------------------------------------
+%% Func: enc_sequence/5
+%%-----------------------------------------------------------------
+%% This is a special case used when encoding encapsualted data, i.e., contained
+%% in an octet-sequence.
+enc_sequence(_Env, Sequence, MaxLength, 'tk_octet', Bytes, Len)
+ when is_binary(Sequence) ->
+ {ByteSequence, Len1} = enc_align(Bytes, Len, 4),
+ Size = size(Sequence),
+ if
+ Size > MaxLength, MaxLength > 0 ->
+ orber:dbg("[~p] cdr_encode:enc_sequnce(~p, ~p). Sequence exceeds max.",
+ [?LINE, Sequence, MaxLength], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 19),
+ completion_status=?COMPLETED_MAYBE});
+ true ->
+ ByteSequence1 = cdrlib:enc_unsigned_long(Size, ByteSequence),
+ {[Sequence |ByteSequence1], Len1 + 4 + Size}
+ end;
+enc_sequence(Env, Sequence, MaxLength, TypeCode, Bytes, Len) ->
+ Length = length(Sequence),
+ if
+ Length > MaxLength, MaxLength > 0 ->
+ orber:dbg("[~p] cdr_encode:enc_sequnce(~p, ~p). Sequence exceeds max.",
+ [?LINE, Sequence, MaxLength], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 19),
+ completion_status=?COMPLETED_MAYBE});
+ true ->
+ {ByteSequence, Len1} = enc_align(Bytes, Len, 4),
+ ByteSequence1 = cdrlib:enc_unsigned_long(Length, ByteSequence),
+ enc_sequence1(Env, Sequence, TypeCode, ByteSequence1, Len1 + 4)
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: enc_sequence1/4
+%%-----------------------------------------------------------------
+enc_sequence1(_Env, [], _TypeCode, Bytes, Len) ->
+ {Bytes, Len};
+enc_sequence1(_Env, CharSeq, 'tk_char', Bytes, Len) ->
+ {[list_to_binary(CharSeq) |Bytes], Len + length(CharSeq)};
+enc_sequence1(_Env, OctetSeq, 'tk_octet', Bytes, Len) ->
+ {[list_to_binary(OctetSeq) |Bytes], Len + length(OctetSeq)};
+enc_sequence1(Env, [Object| Rest], TypeCode, Bytes, Len) ->
+ {ByteSequence, Len1} = enc_type(TypeCode, Env, Object, Bytes, Len),
+ enc_sequence1(Env, Rest, TypeCode, ByteSequence, Len1).
+
+%%-----------------------------------------------------------------
+%% Func: enc_array/4
+%%-----------------------------------------------------------------
+enc_array(Env, Array, Size, TypeCode, Bytes, Len) when size(Array) == Size ->
+ Sequence = tuple_to_list(Array),
+ enc_sequence1(Env, Sequence, TypeCode, Bytes, Len);
+enc_array(_,Array, Size, _, _, _) ->
+ orber:dbg("[~p] cdr_encode:enc_array(~p, ~p). Incorrect size.",
+ [?LINE, Array, Size], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 15), completion_status=?COMPLETED_MAYBE}).
+
+%%-----------------------------------------------------------------
+%% Func: enc_string/4
+%%-----------------------------------------------------------------
+enc_string(_Env, String, MaxLength, Bytes, Len) ->
+ StrLen = length(String),
+ if
+ StrLen > MaxLength, MaxLength > 0 ->
+ orber:dbg("[~p] cdr_encode:enc_string(~p, ~p). String exceeds max.",
+ [?LINE, String, MaxLength], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 16),
+ completion_status=?COMPLETED_MAYBE});
+ true ->
+ {ByteSequence, Len1} = enc_align(Bytes, Len, 4),
+ ByteSequence1 = cdrlib:enc_unsigned_long(StrLen + 1, ByteSequence),
+ {cdrlib:enc_octet(0, [String | ByteSequence1]), Len1 + StrLen + 5}
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Func: enc_wstring/4
+%%-----------------------------------------------------------------
+enc_wstring(#giop_env{version = {1,2}} = Env, String, MaxLength, Bytes, Len) ->
+ %% Encode the length of the string (ulong).
+ {Bytes1, Len1} = enc_align(Bytes, Len, 4),
+ %% For IIOP-1.2 the length is the total number of octets. Hence, since the wchar's
+ %% we accepts is encoded as <<255, 255>> the total size is 2*length of the list.
+ ListLen = length(String),
+ if
+ ListLen > MaxLength, MaxLength > 0 ->
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 16),
+ completion_status=?COMPLETED_MAYBE});
+ true ->
+ StrLen = ListLen * 2,
+ Bytes2 = cdrlib:enc_unsigned_long(StrLen, Bytes1),
+ %% For IIOP-1.2 no terminating null character is used.
+ enc_sequence1(Env, String, 'tk_ushort', Bytes2, Len1+4)
+ end;
+enc_wstring(Env, String, MaxLength, Bytes, Len) ->
+ %% Encode the length of the string (ulong).
+ {Bytes1, Len1} = enc_align(Bytes, Len, 4),
+ ListLen = length(String),
+ if
+ ListLen > MaxLength, MaxLength > 0 ->
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 16),
+ completion_status=?COMPLETED_MAYBE});
+ true ->
+ StrLen = ListLen + 1,
+ Bytes2 = cdrlib:enc_unsigned_long(StrLen, Bytes1),
+ {Bytes3, Len3} = enc_sequence1(Env, String, 'tk_wchar', Bytes2, Len1+4),
+ %% The terminating null character is also a wchar.
+ {cdrlib:enc_unsigned_short(0, Bytes3), Len3+2}
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Func: enc_union/5
+%%-----------------------------------------------------------------
+enc_union(Env, {_, Label, Value}, DiscrTC, Default, TypeCodeList, Bytes, Len) ->
+ {ByteSequence, Len1} = enc_type(DiscrTC, Env, Label, Bytes, Len),
+ Label2 = stringify_enum(DiscrTC,Label),
+ enc_union2(Env, {Label2, Value},TypeCodeList, Default,
+ ByteSequence, Len1, undefined).
+
+enc_union2(_Env, _What, [], Default, Bytes, Len, _) when Default < 0 ->
+ {Bytes, Len};
+enc_union2(Env, {_, Value}, [], _Default, Bytes, Len, Type) ->
+ enc_type(Type, Env, Value, Bytes, Len);
+enc_union2(Env, {Label,Value} ,[{Label, _Name, Type} |_List],
+ _Default, Bytes, Len, _) ->
+ enc_type(Type, Env, Value, Bytes, Len);
+enc_union2(Env, Union ,[{default, _Name, Type} |List], Default, Bytes, Len, _) ->
+ enc_union2(Env, Union, List, Default, Bytes, Len, Type);
+enc_union2(Env, Union,[_ | List], Default, Bytes, Len, DefaultType) ->
+ enc_union2(Env, Union, List, Default, Bytes, Len, DefaultType).
+
+stringify_enum({tk_enum, _,_,_}, Label) ->
+ atom_to_list(Label);
+stringify_enum(_, Label) ->
+ Label.
+%%-----------------------------------------------------------------
+%% Func: enc_struct/4
+%%-----------------------------------------------------------------
+enc_struct(Env, Struct, TypeCodeList, Bytes, Len) ->
+ [_Name | StructList] = tuple_to_list(Struct),
+ enc_struct1(Env, StructList, TypeCodeList, Bytes, Len).
+
+enc_struct1(_Env, [], [], Bytes, Len) ->
+ {Bytes, Len};
+enc_struct1(Env, [Object | Rest], [{_ElemName, ElemType} | TypeCodeList], Bytes,
+ Len) ->
+ {ByteSequence, Len1} = enc_type(ElemType, Env, Object, Bytes, Len),
+ enc_struct1(Env, Rest, TypeCodeList, ByteSequence, Len1).
+
+%%-----------------------------------------------------------------
+%% Func: enc_objref/4
+%%-----------------------------------------------------------------
+enc_objref(Env, _Name, Value, Bytes, Len) ->
+ iop_ior:code(Env, Value, Bytes, Len).
+
+%%-----------------------------------------------------------------
+%% Func: enc_exception/5
+%%-----------------------------------------------------------------
+enc_exception(Env, _Name, IFRId, Value, ElementList, Bytes, Len) ->
+ [_Name1, _TypeId | Args] = tuple_to_list(Value),
+ {Bytes1, Len1} = enc_type({'tk_string', 0}, Env, IFRId , Bytes, Len),
+ enc_exception_1(Env, Args, ElementList, Bytes1, Len1).
+
+enc_exception_1(_Env, [], [], Bytes, Len) ->
+ {Bytes, Len};
+enc_exception_1(Env, [Arg |Args], [{_ElemName, ElemType} |ElementList],
+ Bytes, Len) ->
+ {Bytes1, Len1} = enc_type(ElemType, Env, Arg, Bytes, Len),
+ enc_exception_1(Env, Args, ElementList, Bytes1, Len1).
+
+
+%%-----------------------------------------------------------------
+%% Func: enc_type_code/3
+%%-----------------------------------------------------------------
+enc_type_code('tk_null', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 0, Message, Len);
+enc_type_code('tk_void', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 1, Message, Len);
+enc_type_code('tk_short', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 2, Message, Len);
+enc_type_code('tk_long', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 3, Message, Len);
+enc_type_code('tk_longlong', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 23, Message, Len);
+enc_type_code('tk_longdouble', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 25, Message, Len);
+enc_type_code('tk_ushort', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 4, Message, Len);
+enc_type_code('tk_ulong', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 5, Message, Len);
+enc_type_code('tk_ulonglong', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 24, Message, Len);
+enc_type_code('tk_float', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 6, Message, Len);
+enc_type_code('tk_double', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 7, Message, Len);
+enc_type_code('tk_boolean', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 8, Message, Len);
+enc_type_code('tk_char', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 9, Message, Len);
+enc_type_code('tk_wchar', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 26, Message, Len);
+enc_type_code('tk_octet', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 10, Message, Len);
+enc_type_code('tk_any', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 11, Message, Len);
+enc_type_code('tk_TypeCode', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 12, Message, Len);
+enc_type_code('tk_Principal', Env, Message, Len) ->
+ enc_type('tk_ulong', Env, 13, Message, Len);
+enc_type_code({'tk_objref', RepId, Name}, Env, Message, Len) ->
+ {Message1, Len1} = enc_type('tk_ulong', Env, 14, Message, Len),
+ {Message2, _} = enc_byte_order(Env, []),
+ {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}}]},
+ Env,
+ {"", RepId, Name},
+ Message2, 1),
+ encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
+enc_type_code({'tk_struct', RepId, SimpleName, ElementList}, Env, Message, Len) ->
+ %% Using SimpleName should be enough (and we avoid some overhead).
+ %% Name = ifrid_to_name(RepId),
+ {Message1, Len1} = enc_type('tk_ulong', Env, 15, Message, Len),
+ {Message2, _} = enc_byte_order(Env, []),
+ {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}},
+ {"element list",
+ {'tk_sequence', {'tk_struct', "","",
+ [{"member name", {'tk_string', 0}},
+ {"member type", 'tk_TypeCode'}]},
+ 0}}]},
+ Env,
+ {"", RepId, SimpleName,
+ lists:map(fun({N,T}) -> {"",N,T} end, ElementList)},
+ Message2, 1),
+ encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
+enc_type_code({'tk_union', RepId, Name, DiscrTC, Default, ElementList},
+ Env, Message, Len) ->
+ NewElementList =
+ case check_enum(DiscrTC) of
+ true ->
+ lists:map(fun({L,N,T}) -> {"",list_to_atom(L),N,T} end, ElementList);
+ false ->
+ lists:map(fun({L,N,T}) -> {"",L,N,T} end, ElementList)
+ end,
+ {Message1, Len1} = enc_type('tk_ulong', Env, 16, Message, Len),
+ {Message2, _} = enc_byte_order(Env, []),
+ {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}},
+ {"discriminant type", 'tk_TypeCode'},
+ {"default used", 'tk_long'},
+ {"element list",
+ {'tk_sequence', {'tk_struct', "","",
+ [{"label value", DiscrTC},
+ {"member name", {'tk_string', 0}},
+ {"member type", 'tk_TypeCode'}]},
+ 0}}]},
+ Env,
+ {"", RepId, Name, DiscrTC, Default, NewElementList},
+ Message2, 1),
+ encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
+enc_type_code({'tk_enum', RepId, Name, ElementList}, Env, Message, Len) ->
+ {Message1, Len1} = enc_type('tk_ulong', Env, 17, Message, Len),
+ {Message2, _} = enc_byte_order(Env, []),
+ {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}},
+ {"element list",
+ {'tk_sequence', {'tk_string', 0}, 0}}]},
+ Env,
+ {"", RepId, Name, ElementList},
+ Message2, 1),
+ encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
+enc_type_code({'tk_string', MaxLength}, Env, Message, Len) ->
+ enc_type({'tk_struct', "", "", [{"TCKind", 'tk_ulong'},
+ {"max length", 'tk_ulong'}]},
+ Env,
+ {"", 18, MaxLength},
+ Message, Len);
+enc_type_code({'tk_wstring', MaxLength}, Env, Message, Len) ->
+ enc_type({'tk_struct', "", "", [{"TCKind", 'tk_ulong'},
+ {"max length", 'tk_ulong'}]},
+ Env,
+ {"", 27, MaxLength},
+ Message, Len);
+enc_type_code({'tk_sequence', ElemTC, MaxLength}, Env, Message, Len) ->
+ {Message1, Len1} = enc_type('tk_ulong', Env, 19, Message, Len),
+ {Message2, _} = enc_byte_order(Env, []),
+ {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"element type", 'tk_TypeCode'},
+ {"max length", 'tk_ulong'}]},
+ Env,
+ {"", ElemTC, MaxLength},
+ Message2, 1),
+ encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
+enc_type_code({'tk_array', ElemTC, Length}, Env, Message, Len) ->
+ {Message1, Len1} = enc_type('tk_ulong', Env, 20, Message, Len),
+ {Message2, _} = enc_byte_order(Env, []),
+ {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"element type", 'tk_TypeCode'},
+ {"length", 'tk_ulong'}]},
+ Env,
+ {"", ElemTC, Length},
+ Message2, 1),
+ encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
+enc_type_code({'tk_alias', RepId, Name, TC}, Env, Message, Len) ->
+ {Message1, Len1} = enc_type('tk_ulong', Env, 21, Message, Len),
+ {Message2, _} = enc_byte_order(Env, []),
+ {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}},
+ {"TypeCode", 'tk_TypeCode'}]},
+ Env,
+ {"", RepId, Name, TC},
+ Message2, 1),
+ encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
+enc_type_code({'tk_except', RepId, Name, ElementList}, Env, Message, Len) ->
+ {Message1, Len1} = enc_type('tk_ulong', Env, 22, Message, Len),
+ {Message2, _} = enc_byte_order(Env, []),
+ {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}},
+ {"element list",
+ {'tk_sequence',
+ {'tk_struct', "", "",
+ [{"member name", {'tk_string', 0}},
+ {"member type", 'tk_TypeCode'}]}, 0}}]},
+ Env,
+ {"", RepId, Name,
+ lists:map(fun({N,T}) -> {"",N,T} end, ElementList)},
+ Message2, 1),
+ encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
+enc_type_code({'tk_fixed', Digits, Scale}, Env, Message, Len) ->
+ enc_type({'tk_struct', "", "", [{"TCKind", 'tk_ulong'},
+ {"digits", 'tk_ushort'},
+ {"scale", 'tk_short'}]},
+ Env,
+ {"", 28, Digits, Scale},
+ Message, Len);
+enc_type_code({'tk_value', RepId, Name, ValueModifier, TC, ElementList}, Env, Message, Len) ->
+ {Message1, Len1} = enc_type('tk_ulong', Env, 29, Message, Len),
+ {Message2, _} = enc_byte_order(Env, []),
+ {ComplexParams, Len2} = enc_type({'tk_struct', "", "",
+ [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}},
+ {"ValueModifier", 'tk_short'},
+ {"TypeCode", 'tk_TypeCode'},
+ {"element list",
+ {'tk_sequence',
+ {'tk_struct', "","",
+ [{"member name", {'tk_string', 0}},
+ {"member type", 'tk_TypeCode'},
+ {"Visibility", 'tk_short'}]},
+ 0}}]},
+ Env,
+ {"", RepId, Name, ValueModifier, TC,
+ lists:map(fun({N,T,V}) -> {"",N,T,V} end, ElementList)},
+ Message2, 1),
+ encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
+enc_type_code({'tk_value_box', RepId, Name, TC}, Env, Message, Len) ->
+ {Message1, Len1} = enc_type('tk_ulong', Env, 30, Message, Len),
+ {Message2, _} = enc_byte_order(Env, []),
+ {ComplexParams, Len2} = enc_type({'tk_struct', "", "",
+ [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}},
+ {"TypeCode", 'tk_TypeCode'}]},
+ Env,
+ {"", RepId, Name, TC},
+ Message2, 1),
+ encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
+enc_type_code({'tk_native', RepId, Name}, Env, Message, Len) ->
+ {Message1, Len1} = enc_type('tk_ulong', Env, 31, Message, Len),
+ {Message2, _} = enc_byte_order(Env, []),
+ {ComplexParams, Len2} = enc_type({'tk_struct', "", "",
+ [{"repository ID", {'tk_string', 0}},
+ {"name", {'tk_string', 0}}]},
+ Env,
+ {"", RepId, Name},
+ Message2, 1),
+ encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
+enc_type_code({'tk_abstract_interface', RepId, Name}, Env, Message, Len) ->
+ {Message1, Len1} = enc_type('tk_ulong', Env, 32, Message, Len),
+ {Message2, _} = enc_byte_order(Env, []),
+ {ComplexParams, Len2} = enc_type({'tk_struct', "", "",
+ [{"RepositoryId", {'tk_string', 0}},
+ {"name", {'tk_string', 0}}]},
+ Env,
+ {"", RepId, Name},
+ Message2, 1),
+ encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
+enc_type_code({'tk_local_interface', RepId, Name}, Env, Message, Len) ->
+ {Message1, Len1} = enc_type('tk_ulong', Env, 33, Message, Len),
+ {Message2, _} = enc_byte_order(Env, []),
+ {ComplexParams, Len2} = enc_type({'tk_struct', "", "",
+ [{"RepositoryId", {'tk_string', 0}},
+ {"name", {'tk_string', 0}}]},
+ Env,
+ {"", RepId, Name},
+ Message2, 1),
+ encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
+enc_type_code({'none', Indirection}, Env, Message, Len) -> %% placeholder
+ enc_type({'tk_struct', "", "", [{"TCKind", 'tk_ulong'},
+ {"indirection", 'tk_long'}]},
+ Env,
+ {"", 16#ffffffff, Indirection},
+ Message, Len);
+enc_type_code(Type, _, _, _) ->
+ orber:dbg("[~p] cdr_encode:enc_type_code(~p); No match.",
+ [?LINE, Type], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 7), completion_status=?COMPLETED_MAYBE}).
+
+check_enum({'tk_enum', _, _, _}) ->
+ true;
+check_enum(_) ->
+ false.
+
+encode_complex_tc_paramters(Value, ValueLength, Message, Len) ->
+ {Message1, _Len1} = enc_align(Message, Len, 4),
+ Message2 = cdrlib:enc_unsigned_long(ValueLength, Message1),
+ {[Value |Message2], Len+ValueLength+4}.
+
+%%-----------------------------------------------------------------
+%% Func: enc_align/1
+%%-----------------------------------------------------------------
+enc_align(R, Len, Alignment) ->
+ Rem = Len rem Alignment,
+ if Rem == 0 ->
+ {R, Len};
+ true ->
+ Diff = Alignment - Rem,
+ {add_bytes(R, Diff), Len + Diff}
+ end.
+
+add_bytes(R, 0) ->
+ R;
+add_bytes(R, 1) ->
+ [<<16#01:8>> | R];
+add_bytes(R, 2) ->
+ [<<16#02:8, 16#02:8>> | R];
+add_bytes(R, 3) ->
+ [<<16#03:8, 16#03:8, 16#03:8>> | R];
+add_bytes(R, 4) ->
+ [<<16#04:8, 16#04:8, 16#04:8, 16#04:8>> | R];
+add_bytes(R, 5) ->
+ [<<16#05:8, 16#05:8, 16#05:8, 16#05:8, 16#05:8>> | R];
+add_bytes(R, 6) ->
+ [<<16#06:8, 16#06:8, 16#06:8, 16#06:8, 16#06:8, 16#06:8>> | R];
+add_bytes(R, 7) ->
+ [<<16#07:8, 16#07:8, 16#07:8, 16#07:8, 16#07:8, 16#07:8, 16#07:8>> | R];
+add_bytes(R,N) ->
+ add_bytes([<<16#08:8>> | R], N - 1).
+
diff --git a/lib/orber/src/cdrlib.erl b/lib/orber/src/cdrlib.erl
new file mode 100644
index 0000000000..8fd032e968
--- /dev/null
+++ b/lib/orber/src/cdrlib.erl
@@ -0,0 +1,414 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: cdrlib.erl
+%%
+%% Description:
+%% CDR basic type encode/decode functions
+%%
+%%-----------------------------------------------------------------
+-module(cdrlib).
+
+-include_lib("orber/include/corba.hrl").
+-include("orber_iiop.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([ %% IIOP 1.0 -
+ enc_short/2, dec_short/2,
+ enc_unsigned_short/2, dec_unsigned_short/2,
+ enc_long/2, dec_long/2,
+ enc_unsigned_long/2, dec_unsigned_long/2,
+ enc_bool/2, dec_bool/1,
+ enc_float/2, dec_float/2,
+ enc_double/2, dec_double/2,
+ enc_char/2, dec_char/1,
+ enc_octet/2, dec_octet/1,
+ enc_enum/3, dec_enum/3,
+ %% IIOP 1.1 -
+ enc_longlong/2, dec_longlong/2,
+ enc_unsigned_longlong/2, dec_unsigned_longlong/2
+ %%enc_longdouble/2, dec_longdouble/2
+ %%enc_fixed/4, dec_fixed/2
+ ]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([]).
+
+%%-----------------------------------------------------------------
+%% Macros
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 10).
+
+%%-----------------------------------------------------------------
+%% short
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: enc_short/2
+%%-----------------------------------------------------------------
+enc_short(X, Message) when is_integer(X) andalso X >= ?SHORTMIN andalso X =< ?SHORTMAX ->
+ [<<X:16/big-signed-integer>> | Message];
+enc_short(X, _Message) when is_integer(X) ->
+ orber:dbg("[~p] cdrlib:enc_short(~p); Out of range.", [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_NO});
+enc_short(X, _Message) ->
+ orber:dbg("[~p] cdrlib:enc_short(~p); not integer.", [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO}).
+
+%%-----------------------------------------------------------------
+%% Func: dec_short/2
+%%-----------------------------------------------------------------
+dec_short(big, <<Short:16/big-signed-integer,Rest/binary>>) ->
+ {Short, Rest};
+dec_short(little, <<Short:16/little-signed-integer,Rest/binary>>) ->
+ {Short, Rest}.
+
+%%-----------------------------------------------------------------
+%% unsigned short
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: enc_unsigned_short/2
+%%-----------------------------------------------------------------
+enc_unsigned_short(X, Message) when is_integer(X) andalso X >= ?USHORTMIN andalso X =< ?USHORTMAX ->
+ [<<X:16/big-unsigned-integer>> | Message];
+enc_unsigned_short(X, _Message) when is_integer(X) ->
+ orber:dbg("[~p] cdrlib:enc_unsigned_short(~p); Out of range.",
+ [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_NO});
+enc_unsigned_short(X, _Message) ->
+ orber:dbg("[~p] cdrlib:enc_unsigned_short(~p); not integer >= 0",
+ [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO}).
+
+%%-----------------------------------------------------------------
+%% Func: dec_unsigned_short/2
+%%-----------------------------------------------------------------
+dec_unsigned_short(big, <<UShort:16/big-unsigned-integer,Rest/binary>>) ->
+ {UShort, Rest};
+dec_unsigned_short(little, <<UShort:16/little-unsigned-integer,Rest/binary>>) ->
+ {UShort, Rest}.
+
+%%-----------------------------------------------------------------
+%% long
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: enc_long/2
+%%-----------------------------------------------------------------
+enc_long(X, Message) when is_integer(X) andalso X >= ?LONGMIN andalso X =< ?LONGMAX ->
+ [<<X:32/big-signed-integer>> | Message];
+enc_long(X, _Message) when is_integer(X) ->
+ orber:dbg("[~p] cdrlib:enc_long(~p); Out of range.",[?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_NO});
+enc_long(X, _Message) ->
+ orber:dbg("[~p] cdrlib:enc_long(~p); not integer.",
+ [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO}).
+
+%%-----------------------------------------------------------------
+%% Func: dec_long/2
+%%-----------------------------------------------------------------
+dec_long(big, <<Long:32/big-signed-integer,Rest/binary>>) ->
+ {Long, Rest};
+dec_long(little, <<Long:32/little-signed-integer,Rest/binary>>) ->
+ {Long, Rest}.
+
+%%-----------------------------------------------------------------
+%% unsigned_long
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: enc_unsigned_long/2
+%%-----------------------------------------------------------------
+enc_unsigned_long(X, Message) when is_integer(X) andalso X >= ?ULONGMIN andalso X =< ?ULONGMAX ->
+ [<<X:32/big-unsigned-integer>> | Message];
+enc_unsigned_long(X, _Message) when is_integer(X) ->
+ orber:dbg("[~p] cdrlib:enc_unsigned_long(~p); Out of range.",
+ [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_NO});
+enc_unsigned_long(X, _Message) ->
+ orber:dbg("[~p] cdrlib:enc_unsigned_long(~p); not integer >=0 ",
+ [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO}).
+
+%%-----------------------------------------------------------------
+%% Func: dec_unsigned_long/2
+%%-----------------------------------------------------------------
+dec_unsigned_long(big, <<ULong:32/big-unsigned-integer,Rest/binary>>) ->
+ {ULong, Rest};
+dec_unsigned_long(little, <<ULong:32/little-unsigned-integer,Rest/binary>>) ->
+ {ULong, Rest}.
+
+%%-----------------------------------------------------------------
+%% boolean
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: enc_bool/2
+%%-----------------------------------------------------------------
+enc_bool(true, Message) -> [<<1:8>>| Message];
+enc_bool(false, Message) -> [<<0:8>>| Message];
+enc_bool(X, _Message) ->
+ orber:dbg("[~p] cdrlib:enc_bool(~p); Must be 'true' or 'false'",
+ [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 3), completion_status=?COMPLETED_NO}).
+
+%%-----------------------------------------------------------------
+%% Func: dec_bool/1
+%%-----------------------------------------------------------------
+dec_bool(<<1:8,Rest/binary>>) -> {true, Rest};
+dec_bool(<<0:8,Rest/binary>>) -> {false, Rest};
+dec_bool(<<X:8,_Rest/binary>>) ->
+ orber:dbg("[~p] cdrlib:dec_bool(~p); Not a boolean (1 or 0).",
+ [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 3), completion_status=?COMPLETED_NO}).
+
+
+%%-----------------------------------------------------------------
+%% Func: enc_float/2
+%%-----------------------------------------------------------------
+enc_float(X, Message) when is_number(X) ->
+ [<<X:32/big-float>> | Message];
+enc_float(X, _Message) ->
+ orber:dbg("[~p] cdrlib:enc_float(~p); not a number.", [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 4), completion_status=?COMPLETED_NO}).
+
+%%-----------------------------------------------------------------
+%% Func: dec_float/2
+%%-----------------------------------------------------------------
+dec_float(big, <<Float:32/big-float,Rest/binary>>) ->
+ {Float, Rest};
+dec_float(little, <<Float:32/little-float,Rest/binary>>) ->
+ {Float, Rest}.
+
+%%-----------------------------------------------------------------
+%% Func: enc_double/2
+%%-----------------------------------------------------------------
+enc_double(X, Message) when is_number(X) ->
+ [<<X:64/big-float>> | Message];
+enc_double(X, _Message) ->
+ orber:dbg("[~p] cdrlib:enc_double(~p); not a number.", [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 4), completion_status=?COMPLETED_NO}).
+
+%%-----------------------------------------------------------------
+%% Func: dec_double/2
+%%-----------------------------------------------------------------
+dec_double(big, <<Double:64/big-float,Rest/binary>>) ->
+ {Double, Rest};
+dec_double(little, <<Double:64/little-float,Rest/binary>>) ->
+ {Double, Rest}.
+
+%%-----------------------------------------------------------------
+%% char
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: enc_char/2
+%%-----------------------------------------------------------------
+enc_char(X, Message) when is_integer(X) andalso X =< 255, X >= 0 ->
+ [<<X:8>> | Message];
+enc_char(X,_) ->
+ orber:dbg("[~p] cdrlib:enc_char(~p); not a char.", [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 6),completion_status=?COMPLETED_NO}).
+
+%%-----------------------------------------------------------------
+%% Func: dec_char/1
+%%-----------------------------------------------------------------
+dec_char(<<Char:8,Rest/binary>>) ->
+ {Char, Rest}.
+
+%%-----------------------------------------------------------------
+%% octet
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: enc_octet/2
+%%-----------------------------------------------------------------
+enc_octet(X, Message) when is_integer(X) andalso X =< 255, X >= 0 ->
+ [<<X:8/big-unsigned-integer>> | Message];
+enc_octet(X, _Message) ->
+ orber:dbg("[~p] cdrlib:enc_octet(~p); not an octet.", [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 6),completion_status=?COMPLETED_NO}).
+
+%%-----------------------------------------------------------------
+%% Func: dec_octet/1
+%%-----------------------------------------------------------------
+dec_octet(<<Octet:8/big-unsigned-integer,Rest/binary>>) ->
+ {Octet, Rest}.
+
+%%-----------------------------------------------------------------
+%% enum
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: enc_enum/3
+%%-----------------------------------------------------------------
+enc_enum(Enum, ElemList, Message) ->
+ Val = getEnumValue(ElemList,Enum, 0),
+ enc_unsigned_long(Val, Message).
+
+getEnumValue([],Enum, _) ->
+ orber:dbg("[~p] cdrlib:enc_enum/enc_r_enum(~p); not exist.",
+ [?LINE, Enum], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 5),
+ completion_status=?COMPLETED_NO});
+getEnumValue([Enum|_List], Enum, N) ->
+ N;
+getEnumValue([_ |List], Enum, N) ->
+ getEnumValue(List, Enum, N + 1).
+
+%%-----------------------------------------------------------------
+%% Func: dec_enum/2
+%%-----------------------------------------------------------------
+dec_enum(ByteOrder, ElemList, Message) ->
+ {N, Rest} = dec_unsigned_long(ByteOrder, Message),
+ case catch lists:nth(N + 1, ElemList) of
+ {'EXIT', _} ->
+ orber:dbg("[~p] cdrlib:dec_enum(~p, ~p); not defined.",
+ [?LINE, N, ElemList], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 5),
+ completion_status=?COMPLETED_NO});
+ X ->
+ {list_to_atom(X), Rest}
+ end.
+
+
+%%-----------------------------------------------------------------
+%% IIOP 1.1 -
+%%-----------------------------------------------------------------
+
+%%-----------------------------------------------------------------
+%% longlong
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: enc_longlong/2
+%%-----------------------------------------------------------------
+enc_longlong(X, Message) when is_integer(X) andalso X >= ?LONGLONGMIN andalso X =< ?LONGLONGMAX ->
+ [<<X:64/big-signed-integer>> | Message];
+enc_longlong(X, _Message) when is_integer(X) ->
+ orber:dbg("[~p] cdrlib:enc_longlong(~p); Out of range.",
+ [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_NO});
+enc_longlong(X, _Message) ->
+ orber:dbg("[~p] cdrlib:enc_longlong(~p); not integer.",
+ [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO}).
+
+%%-----------------------------------------------------------------
+%% Func: dec_longlong/2
+%%-----------------------------------------------------------------
+dec_longlong(big, <<LongLong:64/big-signed-integer,Rest/binary>>) ->
+ {LongLong, Rest};
+dec_longlong(little, <<LongLong:64/little-signed-integer,Rest/binary>>) ->
+ {LongLong, Rest}.
+
+%%-----------------------------------------------------------------
+%% Func: enc_unsigned_longlong/2
+%%-----------------------------------------------------------------
+enc_unsigned_longlong(X, Message) when is_integer(X) andalso X >= ?ULONGLONGMIN andalso X =< ?ULONGLONGMAX ->
+ [<<X:64/big-unsigned-integer>> | Message];
+enc_unsigned_longlong(X, _Message) when is_integer(X) ->
+ orber:dbg("[~p] cdrlib:enc_unsigned_longlong(~p); Out of range.",
+ [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_NO});
+enc_unsigned_longlong(X, _Message) ->
+ orber:dbg("[~p] cdrlib:enc_unsigned_longlong(~p); not integer >= 0.",
+ [?LINE, X], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO}).
+
+%%-----------------------------------------------------------------
+%% Func: dec_unsigned_longlong/2
+%%-----------------------------------------------------------------
+dec_unsigned_longlong(big, <<ULongLong:64/big-unsigned-integer,Rest/binary>>) ->
+ {ULongLong, Rest};
+dec_unsigned_longlong(little, <<ULongLong:64/little-unsigned-integer,Rest/binary>>) ->
+ {ULongLong, Rest}.
+
+%%%-----------------------------------------------------------------
+%%% long double [S=1 | E=15 | F=112]
+%%% X = (-1)^S * 2^(E-16383) * 1.F
+%%%-----------------------------------------------------------------
+%-define(LONGDOUBLE_BASE, 16#10000000000000000000000000000).
+%-define(LONGDOUBLE_BIAS, 16383).
+%%%-----------------------------------------------------------------
+%%% Func: enc_longdouble/2
+%%%-----------------------------------------------------------------
+%enc_longdouble(X, Message) when number(X) ->
+% {S, E, F} = enc_ieee(X, ?LONGDOUBLE_BASE, ?LONGDOUBLE_BIAS),
+% [ (S bsl 7) bor ((E bsr 8) band 16#7f),
+% E band 16#ff,
+% (F bsr 104) band 16#ff,
+% (F bsr 96) band 16#ff,
+% (F bsr 88) band 16#ff,
+% (F bsr 80) band 16#ff,
+% (F bsr 72) band 16#ff,
+% (F bsr 64) band 16#ff,
+% (F bsr 56) band 16#ff,
+% (F bsr 48) band 16#ff,
+% (F bsr 40) band 16#ff,
+% (F bsr 32) band 16#ff,
+% (F bsr 24) band 16#ff,
+% (F bsr 16) band 16#ff,
+% (F bsr 8) band 16#ff,
+% F band 16#ff | Message];
+%enc_longdouble(X, Message) ->
+% corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 4), completion_status=?COMPLETED_NO}).
+
+%%%-----------------------------------------------------------------
+%%% Func: dec_longdouble/2
+%%%-----------------------------------------------------------------
+%dec_longdouble([X15,X14,X13,X12,X11,X10,X9,X8,X7,X6,X5,X4,X3,X2,X1,X0 | R], big) ->
+
+% E = (X15 band 16#7f) bsl 8 + X14,
+
+% F = (X13 bsl 104) + (X12 bsl 96) +
+% (X11 bsl 88) + (X10 bsl 80) + (X9 bsl 72) +
+% (X8 bsl 64) + (X7 bsl 56) + (X6 bsl 48) +
+% (X5 bsl 40) + (X4 bsl 32) + (X3 bsl 24) +
+% (X2 bsl 16) + (X1 bsl 8) + X0,
+
+% if
+% E == 0, F == 0 ->
+% { 0.0, R};
+% X15 >= 16#80 ->
+% { - math:pow(2, E-?LONGDOUBLE_BIAS) * (1 + F / ?LONGDOUBLE_BASE), R};
+% true ->
+% { math:pow(2, E-?LONGDOUBLE_BIAS) * (1 + F / ?LONGDOUBLE_BASE), R}
+% end;
+%dec_longdouble([X15,X14,X13,X12,X11,X10,X9,X8,X7,X6,X5,X4,X3,X2,X1,X0 | R], little) ->
+
+% E = (X0 band 16#7f) bsl 8 + X1,
+
+% F =
+% (X2 bsl 104) + (X3 bsl 96) +
+% (X4 bsl 88) + (X5 bsl 80) + (X6 bsl 72) +
+% (X7 bsl 64) + (X8 bsl 56) + (X9 bsl 48) +
+% (X10 bsl 40) + (X11 bsl 32) + (X12 bsl 24) +
+% (X13 bsl 16) + (X14 bsl 8) + X15,
+
+% if
+% E == 0, F == 0 ->
+% { 0.0, R};
+% X0 >= 16#80 ->
+% { - math:pow(2, E-?DOUBLE_BIAS) * (1 + F / ?DOUBLE_BASE), R};
+% true ->
+% { math:pow(2, E-?DOUBLE_BIAS) * (1 + F / ?DOUBLE_BASE), R}
+% end.
+
+%%------------------ END OF MODULE -----------------------------------
+
diff --git a/lib/orber/src/corba.erl b/lib/orber/src/corba.erl
new file mode 100644
index 0000000000..ea1363742c
--- /dev/null
+++ b/lib/orber/src/corba.erl
@@ -0,0 +1,2180 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%--------------------------------------------------------------------
+%% File: corba.erl
+%%
+%% Description:
+%% This file contains the CORBA::ORB interface plus some
+%% Orber specific functions.
+%%-----------------------------------------------------------------
+-module(corba).
+
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/src/orber_iiop.hrl").
+
+%%-----------------------------------------------------------------
+%% Standard interface CORBA
+%%-----------------------------------------------------------------
+-export([orb_init/1, orb_init/2]).
+%%-----------------------------------------------------------------
+%% Standard interface CORBA::ORB
+%%-----------------------------------------------------------------
+-export([%create_list/2,
+ %create_operation_list/2,
+ %% get_default_context/1,
+ %% 'BOA_init/2,
+ resolve_initial_references/1,
+ resolve_initial_references/2,
+ resolve_initial_references_local/1,
+ list_initial_services/0,
+ add_initial_service/2,
+ remove_initial_service/1,
+ resolve_initial_references_remote/2,
+ resolve_initial_references_remote/3,
+ list_initial_services_remote/1,
+ list_initial_services_remote/2,
+ object_to_string/1, object_to_string/2,
+ object_to_string/3, object_to_string/4,
+ string_to_object/1,
+ string_to_object/2]).
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([create/2,
+ create/3,
+ create/4,
+ create_link/2,
+ create_link/3,
+ create_link/4,
+ create_remote/3,
+ create_remote/5,
+ create_link_remote/3,
+ create_link_remote/5,
+ create_nil_objref/0,
+ dispose/1,
+ create_subobject_key/2,
+ get_subobject_key/1,
+ get_pid/1,
+ raise/1, raise_with_state/2,
+ print_object/1,
+ print_object/2,
+ add_alternate_iiop_address/3,
+ add_FTGroup_component/4,
+ add_FTPrimary_component/1,
+ call_internal/10]).
+
+%%-----------------------------------------------------------------
+%% Internal (inside orber implementation) exports
+%%-----------------------------------------------------------------
+-export([call/4, call/5, reply/2,
+ cast/4, cast/5, locate/1, locate/2, locate/3,
+ request_from_iiop/6,
+ common_create/5,
+ mk_objkey/4,
+ mk_light_objkey/2,
+ objkey_to_string/1,
+ string_to_objkey/1,
+ string_to_objkey_local/1,
+ call_relay/3,
+ cast_relay/2,
+ handle_init/2,
+ handle_terminate/3,
+ handle_info/3,
+ handle_code_change/4,
+ handle_call/7,
+ handle_call/10,
+ handle_cast/9,
+ handle_cast/6,
+ get_implicit_context/1]).
+
+%%-----------------------------------------------------------------
+%% Internal definitions
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 5).
+
+-record(is, {flags = 0}).
+
+%% Defines possible configuration parameters a user can add when
+%% creating new CORBA objects.
+-record(options, {sup_child = false,
+ persistent = false,
+ regname = [],
+ pseudo = false,
+ object_flags = ?ORB_INIT_FLAGS,
+ object_flags_set = ?ORB_INIT_FLAGS,
+ create_options = [],
+ passive = false,
+ group_id = 0,
+ internal_state}).
+
+-record(extra, {timeout = infinity,
+ context = []}).
+
+
+%%--------------------------------------------------------------------
+%% FT stuff
+%%--------------------------------------------------------------------
+-define(IDL_MODULES, [oe_TimeBase,
+ oe_CosEventComm,
+ oe_CosEventChannelAdmin,
+ oe_CosNotification,
+ oe_CosNotifyComm,
+ oe_CosNotifyFilter,
+ oe_GIOP]).
+
+-define(groupid_to_table(Integer),
+ list_to_atom("ft_" ++ integer_to_list(Integer))).
+
+-define(RM_TABLE_SPEC,
+ [{attributes, record_info(fields, ft_replication_manager)}]).
+-define(RO_TABLE_SPEC,
+ [{attributes, record_info(fields, ft_replicated_object)}]).
+-define(RR_TABLE_SPEC,
+ [{attributes, record_info(fields, ft_reply_retention)}]).
+
+%% how long we're allowed to wait for database tables to be available.
+-define(TABLE_TIMEOUT, infinite).
+
+%-record(rm_state, {default_options, type_options, node_port_ips}).
+
+%-record(node_port_ip, {node, port, ip}).
+
+-record(ft_replication_manager, {object_group_id,
+ type_id,
+ primary,
+ iogr,
+ ref_version,
+ options}).
+
+-record(ft_replicated_object, {group_id, state}).
+-record(ft_reply_retention, {retention_id, reply}).
+
+%-record(ft_properties, {replications_style,
+% membership_style,
+% consistency_style,
+% initial_number_replicas,
+% minimum_number_replicas}).
+
+% one should change things work with stdlib:proplist and clean up the mess.
+%-record(ft_criteria, {ft_properties,
+% object_location,
+% object_init,
+% object_impl}).
+
+%%------------------------------------------------------------
+%%
+%% Implementation of CORBA CORBA::ORB interfaces
+%%
+%%------------------------------------------------------------
+
+%%create_list(Count) ->
+%% corba_nvlist:create_list(Count).
+
+%%create_operation_list(OpDef) ->
+%% corba_nvlist:create_operation_list(OpDef).
+
+orb_init(KeyValueList) ->
+ orb_init(KeyValueList, "ORBER").
+
+orb_init([], _Name) ->
+ ok;
+orb_init(KeyValueList, _Name) ->
+ orber:multi_configure(KeyValueList).
+
+%%-----------------------------------------------------------------
+%% Initial reference handling
+%%-----------------------------------------------------------------
+resolve_initial_references(ObjectId) ->
+ resolve_initial_references(ObjectId, []).
+resolve_initial_references(ObjectId, Ctx) ->
+ case use_local_host(ObjectId) of
+ true ->
+ orber_initial_references:get(ObjectId);
+ Ref ->
+ string_to_object(Ref, Ctx)
+ end.
+
+resolve_initial_references_local(ObjectId) ->
+ orber_initial_references:get(ObjectId).
+
+list_initial_services() ->
+ Local = orber_initial_references:list(),
+ case orber:get_ORBInitRef() of
+ undefined ->
+ Local;
+ InitRef ->
+ orber_tb:unique(Local ++ get_prefixes(InitRef, []))
+ end.
+
+get_prefixes([], Acc) ->
+ Acc;
+%% A list of ORBInitRef's
+get_prefixes([H|T], Acc) when is_list(H) ->
+ [Key|_] = string:tokens(H, "="),
+ get_prefixes(T, [Key|Acc]);
+%% A single ORBInitRef
+get_prefixes(InitRef, _Acc) when is_list(InitRef) ->
+ [Key|_] = string:tokens(InitRef, "="),
+ [Key];
+get_prefixes(What, _) ->
+ orber:dbg("[~p] corba:get_prefixes(~p);~nMalformed argument?",
+ [?LINE, What], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO}).
+
+
+use_local_host(ObjectId) ->
+ case orber:get_ORBInitRef() of
+ undefined ->
+ case orber:get_ORBDefaultInitRef() of
+ undefined ->
+ true;
+ DefRef ->
+ DefRef++"/"++ObjectId
+ end;
+ InitRef ->
+ case check_prefixes(InitRef, ObjectId) of
+ false ->
+ case orber:get_ORBDefaultInitRef() of
+ undefined ->
+ true;
+ DefRef ->
+ DefRef++"/"++ObjectId
+ end;
+ UseRef ->
+ strip_junk(UseRef)
+ end
+ end.
+
+
+check_prefixes([], _) ->
+ false;
+%% A list of ORBInitRef's
+check_prefixes([H|T], ObjectId) when is_list(H) ->
+ case prefix(ObjectId, H) of
+ false ->
+ check_prefixes(T, ObjectId);
+ UseRef ->
+ UseRef
+ end;
+%% A single ORBInitRef
+check_prefixes(InitRef, ObjectId) when is_list(InitRef) ->
+ case prefix(ObjectId, InitRef) of
+ false ->
+ false;
+ UseRef ->
+ UseRef
+ end;
+check_prefixes(What,_) ->
+ orber:dbg("[~p] corba:check_prefixes(~p);~nMalformed argument?",
+ [?LINE, What], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO}).
+
+
+%% Valid is, for example, "NameService = corbaloc::host/NameService".
+%% Hence, we must remove ' ' and '='.
+strip_junk([32|T]) ->
+ strip_junk(T);
+strip_junk([$=|T]) ->
+ strip_junk(T);
+strip_junk(Ref) ->
+ Ref.
+
+add_initial_service(ObjectId, ObjectRef) ->
+ orber_initial_references:add(ObjectId, ObjectRef).
+
+remove_initial_service(ObjectId) ->
+ orber_initial_references:remove(ObjectId).
+
+resolve_initial_references_remote(ObjectId, Address) ->
+ resolve_initial_references_remote(ObjectId, Address, []).
+
+resolve_initial_references_remote(_ObjectId, [], _Ctx) ->
+ raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO});
+resolve_initial_references_remote(ObjectId, [RemoteModifier| Rest], Ctx)
+ when is_list(RemoteModifier) ->
+ case lists:prefix("iiop://", RemoteModifier) of
+ true ->
+ [_, Host, Port] = string:tokens(RemoteModifier, ":/"),
+ IOR = iop_ior:create_external(orber:giop_version(), "",
+ Host, list_to_integer(Port), "INIT"),
+ %% We know it's an external referens. Hence, no need to check.
+ {_, Key} = iop_ior:get_key(IOR),
+ orber_iiop:request(Key, 'get', [ObjectId],
+ {{'tk_objref', 12, "object"},
+ [{'tk_string', 0}],
+ []}, 'true', infinity, IOR, Ctx);
+ false ->
+ resolve_initial_references_remote(ObjectId, Rest, Ctx)
+ end.
+
+list_initial_services_remote(Address) ->
+ list_initial_services_remote(Address, []).
+
+list_initial_services_remote([], _Ctx) ->
+ raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO});
+list_initial_services_remote([RemoteModifier| Rest], Ctx) when is_list(RemoteModifier) ->
+ case lists:prefix("iiop://", RemoteModifier) of
+ true ->
+ [_, Host, Port] = string:tokens(RemoteModifier, ":/"),
+ IOR = iop_ior:create_external(orber:giop_version(), "",
+ Host, list_to_integer(Port), "INIT"),
+ %% We know it's an external referens. Hence, no need to check.
+ {_, Key} = iop_ior:get_key(IOR),
+ orber_iiop:request(Key, 'list', [],
+ {{'tk_sequence', {'tk_string',0},0},
+ [], []}, 'true', infinity, IOR, Ctx);
+ false ->
+ list_initial_services_remote(Rest, Ctx)
+ end;
+list_initial_services_remote(_, _) ->
+ raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+
+
+%%-----------------------------------------------------------------
+%% Objectreference convertions
+%%-----------------------------------------------------------------
+object_to_string(Object) ->
+ iop_ior:string_code(Object).
+
+object_to_string(Object, [H|_] = Hosts) when is_list(H) ->
+ iop_ior:string_code(Object, Hosts);
+object_to_string(_Object, _Hosts) ->
+ raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+object_to_string(Object, [H|_] = Hosts, Port) when is_list(H) andalso
+ is_integer(Port) ->
+ iop_ior:string_code(Object, Hosts, Port);
+object_to_string(_Object, _Hosts, _Port) ->
+ raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+object_to_string(Object, [H|_] = Hosts, Port, SSLPort) when is_list(H) andalso
+ is_integer(Port) andalso
+ is_integer(SSLPort)->
+ iop_ior:string_code(Object, Hosts, Port, SSLPort);
+object_to_string(_Object, _Hosts, _Port, _SSLPort) ->
+ raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+
+string_to_object(IORString) ->
+ string_to_object(IORString, []).
+
+string_to_object(IORString, Ctx) when is_list(Ctx) ->
+ case lists:prefix("IOR", IORString) of
+ true ->
+ {ObjRef, _, _} = iop_ior:string_decode(IORString),
+ ObjRef;
+ _ ->
+ %% CORBA-2.4 allows both IOR and ior prefix.
+ case lists:prefix("ior", IORString) of
+ true ->
+ {ObjRef, _, _} = iop_ior:string_decode(IORString),
+ ObjRef;
+ _ ->
+ Data = orber_cosnaming_utils:select_type(IORString),
+ case orber_cosnaming_utils:lookup(Data, Ctx) of
+ String when is_list(String) ->
+ {Obj, _, _} = iop_ior:string_decode(String),
+ Obj;
+ ObjRef ->
+ ObjRef
+ end
+ end
+ end;
+string_to_object(IORString, Ctx) ->
+ orber:dbg("[~p] corba:string_to_object(~p, ~p);~n"
+ "Failed to supply a context list.",
+ [?LINE, IORString, Ctx], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+%%------------------------------------------------------------
+%%
+%% Implementation of NON-standard functions
+%%
+%%------------------------------------------------------------
+create(Module, TypeID) ->
+ create(Module, TypeID, []).
+
+create(Module, TypeID, Env) ->
+ common_create(Module, TypeID, Env, [], 'start').
+
+create(Module, TypeID, Env, {Type, RegName}) ->
+ common_create(Module, TypeID, Env, [{regname, {Type, RegName}}], 'start');
+create(Module, TypeID, Env, Options) ->
+ common_create(Module, TypeID, Env, Options, 'start').
+
+
+create_link(Module, TypeID) ->
+ create_link(Module, TypeID, []).
+
+create_link(Module, TypeID, Env) ->
+ common_create(Module, TypeID, Env, [], 'start_link').
+
+create_link(Module, TypeID, Env, {Type, RegName}) ->
+ common_create(Module, TypeID, Env, [{regname, {Type, RegName}}], 'start_link');
+create_link(Module, TypeID, Env, Options) ->
+ common_create(Module, TypeID, Env, Options, 'start_link').
+
+
+create_remote(Node, Module, TypeID) ->
+ create_remote(Node, Module, TypeID, []).
+
+create_remote(Node, Module, TypeID, Env) ->
+ common_create_remote(Node, Module, TypeID, Env, [], 'start').
+
+create_remote(Node, Module, TypeID, Env, {Type, RegName}) ->
+ common_create_remote(Node, Module, TypeID, Env, [{regname, {Type, RegName}}], 'start');
+create_remote(Node, Module, TypeID, Env, Options) ->
+ common_create_remote(Node, Module, TypeID, Env, Options, 'start').
+
+
+create_link_remote(Node, Module, TypeID) ->
+ create_link_remote(Node, Module, TypeID, []).
+
+create_link_remote(Node, Module, TypeID, Env) ->
+ common_create_remote(Node, Module, TypeID, Env, [], 'start_link').
+
+create_link_remote(Node, Module, TypeID, Env, {Type, RegName}) ->
+ common_create_remote(Node, Module, TypeID, Env, [{regname, {Type, RegName}}], 'start_link');
+create_link_remote(Node, Module, TypeID, Env, Options) ->
+ common_create_remote(Node, Module, TypeID, Env, Options, 'start_link').
+
+common_create_remote(Node, Module, TypeID, Env, {Type, RegName}, StartMethod) ->
+ common_create_remote(Node, Module, TypeID, Env, [{regname, {Type, RegName}}], StartMethod);
+common_create_remote(Node, Module, TypeID, Env, Options, StartMethod) ->
+ case node_check(Node) of
+ true ->
+ rpc:call(Node, corba, common_create, [Module, TypeID, Env, Options, StartMethod]);
+ _ ->
+ orber:dbg("[~p] corba:common_create_remote(~p);~n"
+ "Node not in current domain.", [?LINE, Node], ?DEBUG_LEVEL),
+ raise(#'OBJ_ADAPTER'{completion_status=?COMPLETED_NO})
+ end.
+
+node_check(Node) ->
+ lists:member(Node,orber:orber_nodes()).
+
+common_create(Module, _TypeID, Env, Options, StartMethod) when is_list(Options) ->
+ Opt = evaluate_options(Options, #options{}),
+ case Opt#options.regname of
+ [] ->
+ ok;
+ {'local', Atom} when is_atom(Atom) andalso Opt#options.persistent == false ->
+ ok;
+ {'global', _} ->
+ ok;
+ Why ->
+ orber:dbg("[~p] corba:common_create(~p, ~p);~n"
+ "Bad name type or combination(~p).",
+ [?LINE, Module, Options, Why], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{minor=(?ORBER_VMCID bor 1),
+ completion_status=?COMPLETED_NO})
+ end,
+ case Opt of
+ #options{pseudo = false, passive = false} ->
+ case gen_server:StartMethod(Module, {Opt#options.object_flags, Env},
+ Opt#options.create_options) of
+ {ok, Pid} ->
+ case catch mk_objkey(Module, Pid, Opt#options.regname,
+ Opt#options.persistent,
+ Opt#options.object_flags) of
+ {'EXCEPTION', E} ->
+ %% This branch is only used if we couldn't register
+ %% our new objectkey due to an internal error in orber.
+ gen_server:call(Pid, stop),
+ raise(E);
+ {'EXIT', _} ->
+ %% This branch takes care of exit values
+ %% which aren't expected (due to bug).
+ gen_server:call(Pid, stop),
+ raise(#'BAD_PARAM'{minor=(?ORBER_VMCID bor 1),
+ completion_status=?COMPLETED_NO});
+ Objkey when Opt#options.sup_child == true ->
+ {ok, Pid, Objkey};
+ Objkey ->
+ Objkey
+ end;
+ X ->
+ X
+ end;
+ #options{pseudo = true, passive = false} ->
+ ModuleImpl = list_to_atom(lists:concat([Module, '_impl'])),
+ case ModuleImpl:init(Env) of
+ {ok, State} ->
+ create_subobject_key(mk_pseudo_objkey(Module, ModuleImpl,
+ Opt#options.object_flags),
+ State);
+ {ok, State,_} ->
+ create_subobject_key(mk_pseudo_objkey(Module, ModuleImpl,
+ Opt#options.object_flags),
+ State);
+ Reason ->
+ orber:dbg("[~p] corba:common_create(~p);~n"
+ "'init' function incorrect(~p).",
+ [?LINE, ModuleImpl, Reason], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{minor=(?ORBER_VMCID bor 1),
+ completion_status=?COMPLETED_NO})
+ end;
+ #options{pseudo = false, passive = true} ->
+ ModuleImpl = list_to_atom(lists:concat([Module, '_impl'])),
+ create_subobject_key(mk_passive_objkey(Module, ModuleImpl,
+ Opt#options.object_flags),
+ ?groupid_to_table(Opt#options.group_id));
+ What ->
+ orber:dbg("[~p] corba:common_create(~p, ~p);~n"
+ "not a boolean(~p).",
+ [?LINE, Module, Options, What], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{minor=(?ORBER_VMCID bor 1),
+ completion_status=?COMPLETED_NO})
+ end.
+
+%%----------------------------------------------------------------------
+%% Function : dispose
+%% Arguments : Object
+%% Returns :
+%% Description: Terminate the object represented by the supplied reference.
+%%----------------------------------------------------------------------
+dispose(?ORBER_NIL_OBJREF) ->
+ ok;
+dispose(Obj) ->
+ corba_boa:dispose(Obj).
+
+%%----------------------------------------------------------------------
+%% Function : create_nil_objref
+%% Arguments : -
+%% Returns : A NIL object reference
+%% Description:
+%%----------------------------------------------------------------------
+create_nil_objref() ->
+ ?ORBER_NIL_OBJREF.
+
+%%----------------------------------------------------------------------
+%% Function : create_subobject_key
+%% Arguments : A local object reference and an Erlang term().
+%% Returns : A new instance of the supplied reference with the
+%% sub-object field changed to the given value.
+%% Description: Initially, this field is set to 'undefined'
+%%----------------------------------------------------------------------
+create_subobject_key(Objkey, B) when is_binary(B) ->
+ iop_ior:set_privfield(Objkey, B);
+create_subobject_key(Objkey, T) ->
+ create_subobject_key(Objkey, term_to_binary(T)).
+
+%%----------------------------------------------------------------------
+%% Function : get_subobject_key
+%% Arguments : A local object reference
+%% Returns : Erlang term().
+%% Description: Return the value set by using create_subobject_key/2
+%%----------------------------------------------------------------------
+get_subobject_key(Objkey) ->
+ iop_ior:get_privfield(Objkey).
+
+%%----------------------------------------------------------------------
+%% Function : get_pid
+%% Arguments : A local object reference
+%% Returns : If the object is local and is associated with a pid, this
+%% pid is returned. Otherwise, external- or pseudo-object,
+%% an exception is raised.
+%% Description:
+%%----------------------------------------------------------------------
+get_pid(Objkey) ->
+ case iop_ior:get_key(Objkey) of
+ {'internal', Key, _, _, _} ->
+ orber_objectkeys:get_pid(Key);
+ {'internal_registered', Key, _, _, _} when is_atom(Key) ->
+ case whereis(Key) of
+ undefined ->
+ raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO});
+ Pid ->
+ Pid
+ end;
+ R ->
+ orber:dbg("[~p] corba:get_pid(~p);~n"
+ "Probably a pseudo- or external object(~p).",
+ [?LINE, Objkey, R], ?DEBUG_LEVEL),
+ raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
+ end.
+
+%%----------------------------------------------------------------------
+%% Function : raise
+%% Arguments : Local exception representation.
+%% Returns : Throws the exception.
+%% Description:
+%%----------------------------------------------------------------------
+raise(E) ->
+ throw({'EXCEPTION', E}).
+
+%%----------------------------------------------------------------------
+%% Function : raise_with_state
+%% Arguments : Local exception representation.
+%% Returns : Throws the exception.
+%% Description:
+%%----------------------------------------------------------------------
+raise_with_state(E, State) ->
+ throw({reply, {'EXCEPTION', E}, State}).
+
+%%----------------------------------------------------------------------
+%% Function : reply
+%% Arguments : To - pid
+%% Reply - Erlang term().
+%% Returns :
+%% Description: Used to reply to the invoker but still be able
+%% to do some more work in the callback module.
+%%----------------------------------------------------------------------
+reply(To, Reply) ->
+ gen_server:reply(To, Reply).
+
+%%----------------------------------------------------------------------
+%% Function : print_object
+%% Arguments : An object represented as one of the following:
+%% - local (tuple)
+%% - IOR
+%% - stringified IOR
+%% - corbaloc- or corbaname-schema
+%% IoDevice - the same as the io-module defines.
+%% Returns :
+%% Description: Prints the object's components and profiles.
+%%----------------------------------------------------------------------
+print_object(Object) ->
+ iop_ior:print(Object).
+print_object(Object, IoDevice) ->
+ iop_ior:print(IoDevice, Object).
+
+%%----------------------------------------------------------------------
+%% Function : add_alternate_iiop_address
+%% Arguments : Local object (tuple or IOR).
+%% IP - IP-string
+%% Port - integer().
+%% Returns : A local IOR with a TAG_ALTERNATE_IIOP_ADDRESS component.
+%% Description:
+%%----------------------------------------------------------------------
+add_alternate_iiop_address(Obj, Host, Port) when is_list(Host) andalso is_integer(Port) ->
+ TC = #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS,
+ component_data = #'ALTERNATE_IIOP_ADDRESS'{
+ 'HostID' = Host,
+ 'Port' = Port}},
+ iop_ior:add_component(Obj, TC);
+add_alternate_iiop_address(_, Host, Port) ->
+ orber:dbg("[~p] corba:add_alternate_iiop_address(~p, ~p);~n"
+ "Incorrect argument(s). Host must be IP-string and Port an integer.",
+ [?LINE, Host, Port], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO}).
+
+
+%%----------------------------------------------------------------------
+%% Function : add_FTGroup_component
+%% Arguments : Local object (tuple or IOR).
+%% FTDomain - FT Domain. String().
+%% GroupID - Replicated object group's id. Integer(). (ulonglong)
+%% GroupVer - Object group's version number. Integer(). (ulong)
+%% Returns : A local IOR with one TAG_FT_GROUP component.
+%% Description:
+%%----------------------------------------------------------------------
+add_FTGroup_component(Obj, FTDomain, GroupID, GroupVer)
+ when is_list(FTDomain) andalso is_integer(GroupID) andalso is_integer(GroupVer) andalso
+ GroupID >= ?ULONGLONGMIN andalso GroupID =< ?ULONGLONGMAX andalso
+ GroupVer >= ?ULONGMIN andalso GroupVer =< ?ULONGMAX ->
+ TC = #'IOP_TaggedComponent'{tag = ?TAG_FT_GROUP,
+ component_data = #'FT_TagFTGroupTaggedComponent'{
+ version = #'GIOP_Version'{major = 1, minor = 0},
+ ft_domain_id = FTDomain,
+ object_group_id = GroupID,
+ object_group_ref_version = GroupVer}},
+ iop_ior:add_component(Obj, TC);
+add_FTGroup_component(_Obj, FTDomain, GroupID, GroupVer) ->
+ orber:dbg("[~p] corba:add_FTGroup_component(~p, ~p, ~p);~n"
+ "Incorrect argument(s).",
+ [?LINE, FTDomain, GroupID, GroupVer], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO}).
+
+
+%%----------------------------------------------------------------------
+%% Function : add_FTPrimary_component
+%% Arguments : Local object (tuple or IOR).
+%% Returns : A local IOR with one TAG_FT_PRIMARY component.
+%% Description:
+%%----------------------------------------------------------------------
+add_FTPrimary_component(Obj) ->
+ TC = #'IOP_TaggedComponent'{
+ tag=?TAG_FT_PRIMARY,
+ component_data=#'FT_TagFTPrimaryTaggedComponent'{primary = true}},
+ iop_ior:add_component(Obj, TC).
+
+
+%%-----------------------------------------------------------------
+%% Generic functions for accessing the call-back modules (i.e. X_impl.erl).
+%% These functions are invoked by the generated stubs.
+%%-----------------------------------------------------------------
+handle_init(M, {Flags, Env}) ->
+ case M:init(Env) of
+ {ok, State} ->
+ {ok, {#is{flags = Flags}, State}};
+ {ok,State,Timeout} ->
+ {ok, {#is{flags = Flags}, State}, Timeout};
+ Other ->
+ %% E.g. ignore | {stop, Reason}
+ Other
+ end.
+
+
+handle_terminate(M, Reason, {_InternalState, State}) ->
+ catch (M:terminate(Reason, State)).
+
+handle_info(M, Info, {InternalState, State}) ->
+ case catch M:handle_info(Info, State) of
+ {noreply,NewState} ->
+ {noreply, {InternalState, NewState}};
+ {noreply, NewState, Timeout} ->
+ {noreply, {InternalState, NewState}, Timeout};
+ {stop, Reason, NewState} ->
+ {stop, Reason, {InternalState, NewState}};
+ {'EXIT', Why} ->
+ handle_exit(InternalState, State, Why, true,
+ {M, handle_info}, [Info, State])
+ end.
+
+handle_code_change(M, OldVsn, {InternalState, State}, Extra) ->
+ {ok, NewState} = M:code_change(OldVsn, State, Extra),
+ {ok, {InternalState, NewState}}.
+
+
+%% This function handles call Pre- & Post-conditions.
+handle_call(M, F, A, {InternalState, State}, Ctx, This, From,
+ PreData, PostData, Stub) ->
+ CArgs = call_state(A, State, This, From),
+ case catch invoke_precond(PreData, Stub, F, CArgs) of
+ {'EXIT', Why} ->
+ handle_exit(InternalState, State, Why, false, PreData, [Stub, F, CArgs]);
+ {'EXCEPTION', E} ->
+ {reply, {'EXCEPTION', E}, {InternalState, State}};
+ ok ->
+ Result = handle_call2(M, F, CArgs, InternalState, State, Ctx),
+ case catch invoke_postcond(PostData, Stub, F, CArgs, Result) of
+ {'EXIT', Why} ->
+ handle_exit(InternalState, State, Why, false, PostData, A);
+ {'EXCEPTION', E} ->
+ {reply, {'EXCEPTION', E}, {InternalState, State}};
+ ok ->
+ Result
+ end
+ end.
+
+
+invoke_precond(false, _, _, _) ->
+ ok;
+invoke_precond({CondM, CondF}, Stub, F, CArgs) ->
+ CondM:CondF(Stub, F, CArgs).
+
+%% We must remove the Internal State before invoking post-cond.
+invoke_postcond(false, _, _, _, _) ->
+ ok;
+invoke_postcond({CondM, CondF}, Stub, F, CArgs, {reply, Reply, {_, NS}}) ->
+ CondM:CondF(Stub, F, CArgs, {reply, Reply, NS});
+invoke_postcond({CondM, CondF}, Stub, F, CArgs, {reply, Reply, {_, NS}, Timeout}) ->
+ CondM:CondF(Stub, F, CArgs, {reply, Reply, NS, Timeout});
+invoke_postcond({CondM, CondF}, Stub, F, CArgs, {stop, Reason, Reply, {_, NS}}) ->
+ CondM:CondF(Stub, F, CArgs, {stop, Reason, Reply, NS});
+invoke_postcond({CondM, CondF}, Stub, F, CArgs, {stop, Reason, {_, NS}}) ->
+ CondM:CondF(Stub, F, CArgs, {stop, Reason, NS});
+invoke_postcond({CondM, CondF}, Stub, F, CArgs, {noreply,{_, NS}}) ->
+ CondM:CondF(Stub, F, CArgs, {noreply,NS});
+invoke_postcond({CondM, CondF}, Stub, F, CArgs, {noreply,{_, NS}, Timeout}) ->
+ CondM:CondF(Stub, F, CArgs, {noreply, NS, Timeout});
+invoke_postcond({CondM, CondF}, Stub, F, CArgs, Result) ->
+ CondM:CondF(Stub, F, CArgs, Result).
+
+
+handle_call(M, F, A, {InternalState, State}, Ctx, This, From) ->
+ handle_call2(M, F, call_state(A, State, This, From), InternalState, State, Ctx).
+
+handle_call2(M, F, A, InternalState, State, []) ->
+ case catch apply(M, F, A) of
+ {reply, Reply, NewState} ->
+ {reply, add_context(Reply), {InternalState, NewState}};
+ {reply, Reply, NewState, Timeout} ->
+ {reply, add_context(Reply), {InternalState, NewState}, Timeout};
+ {stop, Reason, Reply, NewState} ->
+ {stop, Reason, add_context(Reply), {InternalState, NewState}};
+ {stop, Reason, NewState} ->
+ {stop, Reason, {InternalState, NewState}};
+ {noreply,NewState} ->
+ {noreply,{InternalState, NewState}};
+ {noreply,NewState,Timeout} ->
+ {noreply,{InternalState, NewState},Timeout};
+ {'EXIT', Reason} ->
+ handle_exit(InternalState, State, Reason, false, {M, F}, A);
+ {'EXCEPTION', E} ->
+ {reply, add_context({'EXCEPTION', E}), {InternalState, State}};
+ {Reply, NewState} ->
+ {reply, add_context(Reply), {InternalState, NewState}}
+ end;
+handle_call2(M, F, A, InternalState, State, Ctx) ->
+ %% Set the new Context.
+ put(oe_server_in_context, Ctx),
+ case catch apply(M, F, A) of
+ {reply, Reply, NewState} ->
+ put(oe_server_in_context, undefined),
+ {reply, add_context(Reply), {InternalState, NewState}};
+ {reply, Reply, NewState, Timeout} ->
+ put(oe_server_in_context, undefined),
+ {reply, add_context(Reply), {InternalState, NewState}, Timeout};
+ {stop, Reason, Reply, NewState} ->
+ {stop, Reason, add_context(Reply), {InternalState, NewState}};
+ {stop, Reason, NewState} ->
+ {stop, Reason, {InternalState, NewState}};
+ {noreply,NewState} ->
+ put(oe_server_in_context, undefined),
+ {noreply, {InternalState, NewState}};
+ {noreply, {InternalState, NewState}, Timeout} ->
+ put(oe_server_in_context, undefined),
+ {noreply, {InternalState, NewState},Timeout};
+ {'EXIT', Reason} ->
+ handle_exit(InternalState, State, Reason, false, {M, F}, A);
+ {'EXCEPTION', E} ->
+ put(oe_server_in_context, undefined),
+ {reply, add_context({'EXCEPTION', E}), {InternalState, State}};
+ {Reply, NewState} ->
+ put(oe_server_in_context, undefined),
+ {reply, add_context(Reply), {InternalState, NewState}}
+ end.
+
+call_state(A, State, false, false) ->
+ [State|A];
+call_state(A, State, false, From) ->
+ [From, State|A];
+call_state(A, State, This, false) ->
+ [This, State|A];
+call_state(A, State, This, From) ->
+ [This, From, State|A].
+
+cast_state(A, State, false) ->
+ [State|A];
+cast_state(A, State, This) ->
+ [This, State|A].
+
+add_context(Reply) ->
+ %% Reset oe_server_out_context
+ case put(oe_server_out_context, undefined) of
+ undefined ->
+ Reply;
+ _OutCtx ->
+ %% The previous value wasn't 'undefined', which means that
+ %% the server supplied a return context.
+ Reply
+ end.
+
+
+%% This function handles call Pre- & Post-conditions.
+handle_cast(M, F, A, {InternalState, State}, Ctx, This, PreData, PostData, Stub) ->
+ CArgs = cast_state(A, State, This),
+ case catch invoke_precond(PreData, Stub, F, CArgs) of
+ {'EXIT', Why} ->
+ handle_exit(InternalState, State, Why, true, PreData, [Stub, F, CArgs]);
+ {'EXCEPTION', _} ->
+ {noreply, {InternalState, State}};
+ ok ->
+ Result = handle_cast2(M, F, CArgs, InternalState, State, Ctx),
+ case catch invoke_postcond(PostData, Stub, F, CArgs, Result) of
+ {'EXIT', Why} ->
+ handle_exit(InternalState, State, Why, true, PostData, A);
+ {'EXCEPTION', _} ->
+ {noreply, {InternalState, State}};
+ ok ->
+ Result
+ end
+ end.
+
+
+handle_cast(M, F, A, {InternalState, State}, Ctx, This) ->
+ handle_cast2(M, F, cast_state(A, State, This), InternalState, State, Ctx).
+
+handle_cast2(M, F, A, InternalState, State, []) ->
+ case catch apply(M, F, A) of
+ {noreply, NewState} ->
+ {noreply, {InternalState, NewState}};
+ {noreply, NewState, Timeout} ->
+ {noreply, {InternalState, NewState}, Timeout};
+ {stop, Reason, NewState} ->
+ {stop, Reason, {InternalState, NewState}};
+ {'EXCEPTION', _} ->
+ {noreply, {InternalState, State}};
+ {'EXIT', Reason} ->
+ handle_exit(InternalState, State, Reason, true, {M, F}, A);
+ NewState ->
+ {noreply, {InternalState, NewState}}
+ end;
+handle_cast2(M, F, A, InternalState, State, Ctx) ->
+ put(oe_server_in_context, Ctx),
+ case catch apply(M, F, A) of
+ {noreply, NewState} ->
+ put(oe_server_in_context, undefined),
+ {noreply, {InternalState, NewState}};
+ {noreply, NewState, Timeout} ->
+ put(oe_server_in_context, undefined),
+ {noreply, {InternalState, NewState}, Timeout};
+ {stop, Reason, NewState} ->
+ {stop, Reason, {InternalState, NewState}};
+ {'EXCEPTION', _} ->
+ put(oe_server_in_context, undefined),
+ {noreply, {InternalState, State}};
+ {'EXIT', Reason} ->
+ handle_exit(InternalState, State, Reason, true, {M, F}, A);
+ NewState ->
+ put(oe_server_in_context, undefined),
+ {noreply, {InternalState, NewState}}
+ end.
+
+handle_exit(InternalState, State, {undef, [{M, F, _}|_]} = Reason,
+ OnewayOp, {M, F}, A) ->
+ case catch check_exports(M:module_info(exports), F) of
+ {'EXIT',{undef,_}} ->
+ %% No such module.
+ orber:dbg("~p.beam doesn't exist.~n"
+ "Check IC compile options (e.g. 'impl') and that the~n"
+ "beam-file is load-able.",
+ [M], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 1),
+ completion_status=?COMPLETED_MAYBE});
+ "" ->
+ orber:dbg("~p:~p/~p doesn't exist.~n"
+ "Check spelling, export-attributes etc",
+ [M, F, length(A)], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 2),
+ completion_status=?COMPLETED_MAYBE});
+ Exports when is_list(Exports) ->
+ orber:dbg("~p:~p/~p doesn't exist.~n"
+ "~p:~p~s do exists.~nCheck export-attributes etc",
+ [M, F, length(A), M, F, Exports], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 3),
+ completion_status=?COMPLETED_MAYBE});
+ _ ->
+ %% Should never happen
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_MAYBE})
+ end;
+handle_exit(InternalState, State, {undef, [{M2, F2, A2}|_]} = Reason,
+ OnewayOp, {M, F}, A) ->
+ case catch check_exports(M2:module_info(exports), F2) of
+ {'EXIT',{undef,_}} ->
+ %% No such module.
+ orber:dbg("~p.beam doesn't exist.~n"
+ "~p:~p/~p invoked an operation on the module above.~n"
+ "Check IC compile options and that the beam-file is load-able.",
+ [M2, M, F, length(A)], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 5),
+ completion_status=?COMPLETED_MAYBE});
+ "" ->
+ orber:dbg("~p:~p/~p doesn't exist.~n"
+ "~p:~p/~p invoked the operation above~n"
+ "Check spelling, export-attributes etc",
+ [M2, F2, length(A2), M, F, length(A)], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 6),
+ completion_status=?COMPLETED_MAYBE});
+ Exports when is_list(Exports) ->
+ orber:dbg("~p:~p/~p doesn't exist.~n"
+ "~p:~p~s do exist(s).~nCheck export-attributes etc~n"
+ "~p:~p/~p invoked the operation above~n",
+ [M2, F2, length(A2), M2, F2, Exports, M, F, length(A)], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 7),
+ completion_status=?COMPLETED_MAYBE});
+ _ ->
+ %% Should never happen
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_MAYBE})
+ end;
+%% Misc errors. We separate between direct and in-direct errors. Due to different
+%% notation we must separate between different cases.
+handle_exit(InternalState, State, {{case_clause,_}, [{M, F, _}|_]} = Reason,
+ OnewayOp, {M, F}, A) ->
+ orber:dbg("~p:~p/~p contains a 'case_clause' error.",
+ [M, F, length(A)], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 8),
+ completion_status=?COMPLETED_MAYBE});
+handle_exit(InternalState, State, {Reason, [{M, F, _}|_]}, OnewayOp, {M, F}, A) ->
+ orber:dbg("~p:~p/~p contains a '~p' error.",
+ [M, F, length(A), Reason], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 8),
+ completion_status=?COMPLETED_MAYBE});
+handle_exit(InternalState, State, {function_clause, [{M2, F2, A2}|_]} = Reason,
+ OnewayOp, {M, F}, A) ->
+ orber:dbg("~p:~p/~p contains a 'function_clause' error.~n"
+ "Invoked via the operation:~n"
+ "~p:~p/~p",
+ [M2, F2, length(A2), M, F, length(A)], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 9),
+ completion_status=?COMPLETED_MAYBE});
+handle_exit(InternalState, State, {{case_clause,_}, [{M2, F2, A2}|_]} = Reason,
+ OnewayOp, {M, F}, A) ->
+ orber:dbg("~p:~p/~p contains a 'case_clause' error.~n"
+ "Invoked via the operation:~n"
+ "~p:~p/~p",
+ [M2, F2, A2, M, F, length(A)], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 9),
+ completion_status=?COMPLETED_MAYBE});
+handle_exit(InternalState, State, {Reason, [{M2, F2, A2}|_]} = Reason,
+ OnewayOp, {M, F}, A) ->
+ orber:dbg("~p:~p/~p contains a '~p' error.~n"
+ "Invoked via the operation:~n"
+ "~p:~p/~p",
+ [M2, F2, A2, Reason, M, F, length(A)], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 9),
+ completion_status=?COMPLETED_MAYBE});
+handle_exit(InternalState, State, Reason, OnewayOp, {M, F}, A) ->
+ orber:dbg("~p:~p(~p) ->~n"
+ " {EXIT, ~p}~n",
+ [M, F, A, Reason], ?DEBUG_LEVEL),
+ reply_after_exit(InternalState, State, Reason, OnewayOp,
+ #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 10),
+ completion_status=?COMPLETED_MAYBE}).
+
+
+reply_after_exit(#is{flags = Flags} = InternalState, State,
+ Reason, OnewayOp, Exc) ->
+ case ?ORB_FLAG_TEST(Flags, ?ORB_SURVIVE_EXIT) of
+ false ->
+ exit(Reason);
+ true when OnewayOp == false ->
+ put(oe_server_in_context, undefined),
+ {reply, {'EXCEPTION', Exc}, {InternalState, State}};
+ true ->
+ %% One-way operation. Cannot return exception.
+ put(oe_server_in_context, undefined),
+ {noreply, {InternalState, State}}
+ end.
+
+
+check_exports(Exports, Op) ->
+ check_exports(Exports, Op, []).
+
+check_exports([], _, Acc) ->
+ Acc;
+check_exports([{Op, Arity}|Rest], Op, Acc) ->
+ check_exports(Rest, Op, Acc ++ "/" ++ integer_to_list(Arity));
+check_exports([_|Rest], Op, Acc) ->
+ check_exports(Rest, Op, Acc).
+
+
+%%-----------------------------------------------------------------
+%% Corba:call - the function for reqests
+%%-----------------------------------------------------------------
+call(Obj, Func, Args, TypesOrMod) ->
+ call_helper(Obj, Func, Args, TypesOrMod, infinity, []).
+
+call(Obj, Func, Args, TypesOrMod, [{context, Ctx}]) ->
+ call_helper(Obj, Func, Args, TypesOrMod, infinity, Ctx);
+call(Obj, Func, Args, TypesOrMod, [{timeout, Timeout}]) ->
+ call_helper(Obj, Func, Args, TypesOrMod, Timeout, []);
+call(Obj, Func, Args, TypesOrMod, Extra) when is_list(Extra) ->
+ ExtraData = extract_extra_data(Extra, #extra{}),
+ call_helper(Obj, Func, Args, TypesOrMod, ExtraData#extra.timeout,
+ ExtraData#extra.context);
+call(Obj, Func, Args, TypesOrMod, Timeout) ->
+ call_helper(Obj, Func, Args, TypesOrMod, Timeout, []).
+
+call_helper(Obj, Func, Args, TypesOrMod, Timeout, InCtx) ->
+ Ctx = get_implicit_context(InCtx),
+ case iop_ior:get_key(Obj) of
+ {'internal', Key, _, Flags, Mod} ->
+ Pid = orber_objectkeys:get_pid(Key),
+ call_internal(Pid, Obj, Func, Args, TypesOrMod,
+ ?ORB_FLAG_TEST(Flags, ?ORB_TYPECHECK),
+ ?ORB_FLAG_TEST(Flags, ?ORB_USE_PI), Mod, Timeout, Ctx);
+ {'internal_registered', Key, _, Flags, Mod} ->
+ call_internal(Key, Obj, Func, Args, TypesOrMod,
+ ?ORB_FLAG_TEST(Flags, ?ORB_TYPECHECK),
+ ?ORB_FLAG_TEST(Flags, ?ORB_USE_PI), Mod, Timeout, Ctx);
+ {'external', Key} when is_atom(TypesOrMod) ->
+ case catch TypesOrMod:oe_tc(Func) of
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba:call_helper(~p);~n"
+ "The call-back module does not exist or"
+ " incorrect IC-version used.~nReason: ~p",
+ [?LINE, TypesOrMod, What], ?DEBUG_LEVEL),
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
+ completion_status=?COMPLETED_NO});
+ undefined ->
+ raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO});
+ Types ->
+ orber_iiop:request(Key, Func, Args, Types, 'true', Timeout, Obj, Ctx)
+ end;
+ {'external', Key} ->
+ orber_iiop:request(Key, Func, Args, TypesOrMod, 'true', Timeout, Obj, Ctx)
+ end.
+
+get_implicit_context([]) ->
+ case get(oe_server_in_context) of
+ undefined ->
+ [];
+ ImplCtx ->
+ ImplCtx
+ end;
+get_implicit_context(Ctx) ->
+ case get(oe_server_in_context) of
+ undefined ->
+ Ctx;
+ ImplCtx ->
+ %% Both defined. An explicit interface context overrides
+ %% an implicit.
+ case check_for_interface_ctx(Ctx) of
+ false ->
+ ImplCtx;
+ true ->
+ remove_interface_ctx(ImplCtx, Ctx)
+ end
+ end.
+
+check_for_interface_ctx([]) ->
+ false;
+check_for_interface_ctx([#'IOP_ServiceContext'
+ {context_id=?ORBER_GENERIC_CTX_ID,
+ context_data = {interface, _I}}|_]) ->
+ true;
+check_for_interface_ctx([_|T]) ->
+ check_for_interface_ctx(T).
+
+remove_interface_ctx([], Acc) ->
+ Acc;
+remove_interface_ctx([#'IOP_ServiceContext'
+ {context_id=?ORBER_GENERIC_CTX_ID,
+ context_data = {interface, _I}}|T], Acc) ->
+ remove_interface_ctx(T, Acc);
+remove_interface_ctx([H|T], Acc) ->
+ remove_interface_ctx(T, [H|Acc]).
+
+
+extract_extra_data([], ED) ->
+ ED;
+extract_extra_data([{context, Ctx}|T], ED) ->
+ extract_extra_data(T, ED#extra{context = Ctx});
+extract_extra_data([{timeout, Timeout}|T], ED) ->
+ extract_extra_data(T, ED#extra{timeout = Timeout}).
+
+call_internal(Pid, Obj, Func, Args, Types, Check, PI, Mod, Timeout, Ctx)
+ when is_pid(Pid) andalso node(Pid) == node() ->
+ invoke_pi_request(PI, Obj, Ctx, Func, Args),
+ typecheck_request(Check, Args, Types, Func),
+ case catch gen_server:call(Pid, {Obj, Ctx, Func, Args}, Timeout) of
+ {'EXCEPTION', E} ->
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
+ typecheck_reply(Check, {'EXCEPTION', E}, Mod, Func),
+ raise(E);
+ {'EXIT',{timeout, _}} ->
+ Exc = #'TIMEOUT'{completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ {'EXIT',R} ->
+ orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~ncall exit(~p).",
+ [?LINE, Func, Args, Types, R], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ Res ->
+ invoke_pi_reply(PI, Obj, Ctx, Func, Res),
+ typecheck_reply(Check, Res, Types, Func),
+ Res
+ end;
+call_internal(Pid, Obj, Func, Args, Types, Check, PI,
+ _Mod, Timeout, Ctx) when is_pid(Pid) ->
+ typecheck_request(Check, Args, Types, Func),
+ case catch rpc:call(node(Pid), corba, call_relay,
+ [Pid, {Obj, Ctx, Func, Args}, Timeout]) of
+ {'EXCEPTION', E} ->
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
+ typecheck_reply(Check, {'EXCEPTION', E}, Types, Func),
+ raise(E);
+ {badrpc, {'EXIT',R}} ->
+ orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~ncall exit(~p).",
+ [?LINE, Func, Args, Types, R], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 3),
+ completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ {badrpc,nodedown} ->
+ orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~nNode ~p down.",
+ [?LINE, Func, Args, Types, node(Pid)], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 2),
+ completion_status=?COMPLETED_NO},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ {badrpc, Reason} ->
+ orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~n"
+ "Unable to invoke operation due to: ~p",
+ [?LINE, Func, Args, Types, Reason], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 5),
+ completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ Res ->
+ invoke_pi_reply(PI, Obj, Ctx, Func, Res),
+ typecheck_reply(Check, Res, Types, Func),
+ Res
+ end;
+
+%% This case handles if the reference is created as a Pseudo object.
+%% Just call apply/3.
+call_internal({pseudo, Module}, Obj, Func, Args, Types, Check, PI,
+ _Mod, _Timeout, Ctx) ->
+ OldCtx = put(oe_server_in_context, Ctx),
+ invoke_pi_request(PI, Obj, Ctx, Func, Args),
+ typecheck_request(Check, Args, Types, Func),
+ State = binary_to_term(get_subobject_key(Obj)),
+ case catch apply(Module, Func, [Obj, State|Args]) of
+ {noreply, _} ->
+ put(oe_server_in_context, OldCtx),
+ ok;
+ {noreply, _, _} ->
+ put(oe_server_in_context, OldCtx),
+ ok;
+ {reply, Reply, _} ->
+ put(oe_server_in_context, OldCtx),
+ invoke_pi_reply(PI, Obj, Ctx, Func, Reply),
+ typecheck_reply(Check, Reply, Types, Func),
+ Reply;
+ {reply, Reply, _, _} ->
+ put(oe_server_in_context, OldCtx),
+ invoke_pi_reply(PI, Obj, Ctx, Func, Reply),
+ typecheck_reply(Check, Reply, Types, Func),
+ Reply;
+ {stop, _, Reply, _} ->
+ put(oe_server_in_context, OldCtx),
+ invoke_pi_reply(PI, Obj, Ctx, Func, Reply),
+ typecheck_reply(Check, Reply, Types, Func),
+ Reply;
+ {stop, _, _} ->
+ put(oe_server_in_context, OldCtx),
+ ok;
+ {'EXCEPTION', E} ->
+ put(oe_server_in_context, OldCtx),
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
+ typecheck_reply(Check, {'EXCEPTION', E}, Types, Func),
+ raise(E);
+ {'EXIT', What} ->
+ put(oe_server_in_context, OldCtx),
+ orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~n"
+ "Pseudo object exit(~p).",
+ [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ Unknown ->
+ put(oe_server_in_context, OldCtx),
+ orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~n"
+ "Pseudo object failed due to bad return value (~p).",
+ [?LINE, Func, Args, Types, Unknown], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 6),
+ completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc)
+ end;
+call_internal({passive, Module}, Obj, Func, Args, Types, Check, PI,
+ Mod, Timeout, Ctx) ->
+ invoke_pi_request(PI, Obj, Ctx, Func, Args),
+ typecheck_request(Check, Args, Types, Func),
+ GroupID = binary_to_term(get_subobject_key(Obj)),
+ Transaction =
+ fun() ->
+ ObjectGroup = read_object_group(GroupID),
+ call_primary_protected(ObjectGroup, Module, Obj,
+ Func, Args, GroupID,
+ get_FTRequestCtx(Ctx))
+ end,
+ case mnesia:transaction(Transaction) of
+ {atomic, Reply} ->
+ %% this check should be inside transaction so that
+ %% failing typecheck_reply would result in transaction
+ %% abortion. Or not. call_internal(Registered...) does not
+ %% cancel the state transition even if the result isn't type compliant.
+ %% So, we do likewise.
+ typecheck_reply(Check, Reply, Mod, Func),
+ Reply;
+ {aborted, {not_primary, Primary, _}} ->
+ FTRequestCtx = mk_FTRequestCtx(10000000),
+ case rpc:call(Primary, corba, call_internal,
+ [{passive, Module}, Obj, Func, Args,
+ Types, Check, PI, Mod, Timeout,
+ [FTRequestCtx|Ctx]]) of
+ {badrpc, Reason} ->
+ orber:dbg("[~p] corba:call_passive(~p, ~p, ~p); ~n"
+ " badrpc(~p).",
+ [?LINE, Func, Args, Types, Reason],?DEBUG_LEVEL),
+ raise(#'TRANSIENT'{minor=0,
+ completion_status=?COMPLETED_MAYBE});
+ %% one should keep trying request_duration_policy_value -time.
+ {'EXCEPTION', E} ->
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
+ raise(E);
+ Reply ->
+ %% is this typecheck_reply neccessary? The check is made
+ %% on the remote node...
+ invoke_pi_reply(PI, Obj, Ctx, Func, Reply),
+ typecheck_reply(Check, Reply, Mod, Func),
+ Reply
+ %% generate RetentionID's and call Primary node with flag that tells
+ %% the node not to escalate rpc call's to next node if the primary
+ %% has changed again.
+ %% raise({not_primary, Primary});
+ end;
+ {aborted, {throw, {'EXCEPTION', E}}} ->
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
+ typecheck_reply(Check, {'EXCEPTION', E}, Mod, Func),
+ raise(E);
+ {aborted, {'EXIT', What}} ->
+ orber:dbg("[~p] corba:call_passive(~p, ~p, ~p); " ++
+ "Passive object exit(~p).",
+ [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ {aborted, Unknown} ->
+ orber:dbg("[~p] corba:call_passive(~p, ~p, ~p); " ++
+ "Passive object failed due to bad return value (~p).",
+ [?LINE, Func, Args, Types, Unknown], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 6),
+ completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc)
+ end;
+call_internal(Registered, Obj, Func, Args, Types, Check, PI,
+ _Mod, Timeout, Ctx) when is_atom(Registered)->
+ invoke_pi_request(PI, Obj, Ctx, Func, Args),
+ typecheck_request(Check, Args, Types, Func),
+ case whereis(Registered) of
+ undefined ->
+ Exc = #'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ P ->
+ case catch gen_server:call(P, {Obj, Ctx, Func, Args}, Timeout) of
+ {'EXCEPTION', E} ->
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
+ typecheck_reply(Check, {'EXCEPTION', E}, Types, Func),
+ raise(E);
+ {'EXIT',{timeout, _}} ->
+ Exc = #'TIMEOUT'{completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ {'EXIT',R} ->
+ orber:dbg("[~p] corba:call_internal(~p, ~p, ~p).~n"
+ "call exit(~p).",
+ [?LINE, Func, Args, Types, R], ?DEBUG_LEVEL),
+ Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 5),
+ completion_status=?COMPLETED_MAYBE},
+ invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
+ raise(Exc);
+ Res ->
+ invoke_pi_reply(PI, Obj, Ctx, Func, Res),
+ typecheck_reply(Check, Res, Types, Func),
+ Res
+ end
+ end.
+
+invoke_pi_request(false, _Obj, _Ctx, _Func, _Args) ->
+ ok;
+invoke_pi_request(_, Obj, Ctx, Func, Args) ->
+ case orber:get_cached_interceptors() of
+ {native, PIs} ->
+ orber_pi:out_request(PIs, Obj, Ctx, Func, "localhost", Args);
+ _ ->
+ ok
+ end.
+
+invoke_pi_reply(false, _Obj, _Ctx, _Func, _Res) ->
+ ok;
+invoke_pi_reply(_, Obj, Ctx, Func, Res) ->
+ case orber:get_cached_interceptors() of
+ {native, PIs} ->
+ orber_pi:in_reply(PIs, Obj, Ctx, Func, "localhost", Res);
+ _ ->
+ ok
+ end.
+
+typecheck_request(false, _, _, _) ->
+ ok;
+typecheck_request(true, Args, Mod, Func) when is_atom(Mod) ->
+ case catch Mod:oe_tc(Func) of
+ undefined ->
+ raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO});
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba:typecheck_request(~p, ~p, ~p);~n"
+ "The call-back module does not exist or incorrect"
+ "IC-version used.~nReason: ~p",
+ [?LINE, Mod, Func, Args, What], ?DEBUG_LEVEL),
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
+ completion_status=?COMPLETED_NO});
+ Types ->
+ typecheck_request_helper(Types, Args, Mod, Func)
+ end;
+typecheck_request(true, Args, Types, Func) ->
+ typecheck_request_helper(Types, Args, Types, Func).
+
+typecheck_request_helper(Types, Args, Mod, Func) ->
+ case catch cdr_encode:validate_request_body(
+ #giop_env{version = {1,2}, tc = Types, parameters = Args,
+ host = orber:host(), iiop_port = orber:iiop_port(),
+ iiop_ssl_port = orber:iiop_ssl_port(),
+ domain = orber:domain(),
+ partial_security = orber:partial_security(),
+ flags = orber:get_flags()}) of
+ {'EXCEPTION', E} ->
+ {_, TC, _} = Types,
+ error_logger:error_msg("========= Orber Typecheck Request =========~n"
+ "Invoked......: ~p:~p/~p~n"
+ "Typecode.....: ~p~n"
+ "Arguments....: ~p~n"
+ "Result.......: ~p~n"
+ "===========================================~n",
+ [Mod, Func, length(TC), TC, Args, {'EXCEPTION', E}]),
+ raise(E);
+ {'EXIT',R} ->
+ {_, TC, _} = Types,
+ error_logger:error_msg("========= Orber Typecheck Request =========~n"
+ "Invoked......: ~p:~p/~p~n"
+ "Typecode.....: ~p~n"
+ "Arguments....: ~p~n"
+ "Result.......: ~p~n"
+ "===========================================~n",
+ [Mod, Func, length(TC), TC, Args, {'EXIT',R}]),
+ raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ _ ->
+ ok
+ end.
+
+typecheck_reply(true, Args, Mod, Func) when is_atom(Mod) ->
+ case catch Mod:oe_tc(Func) of
+ undefined ->
+ raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO});
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba:typecheck_reply(~p, ~p, ~p);~n"
+ "The call-back module does not exist or incorrect"
+ " IC-version used.~nReason: ~p",
+ [?LINE, Mod, Func, Args, What], ?DEBUG_LEVEL),
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
+ completion_status=?COMPLETED_NO});
+ Types ->
+ typecheck_reply_helper(Types, Args, Mod, Func)
+ end;
+typecheck_reply(true, Args, Types, Func) ->
+ typecheck_reply_helper(Types, Args, Types, Func);
+typecheck_reply(_, _, _, _) ->
+ ok.
+
+typecheck_reply_helper(Types, Args, Mod, Func) ->
+ case catch cdr_encode:validate_reply_body(
+ #giop_env{version = {1,2}, tc = Types,
+ host = orber:host(), iiop_port = orber:iiop_port(),
+ iiop_ssl_port = orber:iiop_ssl_port(),
+ domain = orber:domain(),
+ partial_security = orber:partial_security(),
+ flags = orber:get_flags()}, Args) of
+ {'tk_except', ExcType, ExcTC, {'EXCEPTION', E}} ->
+ {_, TC, _} = Types,
+ error_logger:error_msg("========== Orber Typecheck Reply ==========~n"
+ "Invoked........: ~p:~p/~p~n"
+ "Exception Type.: ~p~n"
+ "Typecode.......: ~p~n"
+ "Raised.........: ~p~n"
+ "Result.........: ~p~n"
+ "===========================================~n",
+ [Mod, Func, length(TC), ExcType, ExcTC, Args, {'EXCEPTION', E}]),
+ raise(E);
+ {'EXCEPTION', E} ->
+ {RetType, TC, OutParams} = Types,
+ error_logger:error_msg("========== Orber Typecheck Reply ==========~n"
+ "Invoked......: ~p:~p/~p~n"
+ "Typecode.....: ~p~n"
+ "Reply........: ~p~n"
+ "Result.......: ~p~n"
+ "===========================================~n",
+ [Mod, Func, length(TC), [RetType | OutParams], Args, {'EXCEPTION', E}]),
+ raise(E);
+ {'tk_except', ExcType, ExcTC, {'EXIT',R}} ->
+ {_, TC, _} = Types,
+ error_logger:error_msg("========== Orber Typecheck Reply ==========~n"
+ "Invoked........: ~p:~p/~p~n"
+ "Exception Type.: ~p~n"
+ "Typecode.......: ~p~n"
+ "Raised.........: ~p~n"
+ "Result.........: ~p~n"
+ "===========================================~n",
+ [Mod, Func, length(TC), ExcType, ExcTC, Args, {'EXIT',R}]),
+ raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ {'EXIT',R} ->
+ {RetType, TC, OutParams} = Types,
+ error_logger:error_msg("========== Orber Typecheck Reply ==========~n"
+ "Invoked........: ~p:~p/~p~n"
+ "Typecode.......: ~p~n"
+ "Reply..........: ~p~n"
+ "Result.........: ~p~n"
+ "===========================================~n",
+ [Mod, Func, length(TC), [RetType | OutParams], Args, {'EXIT',R}]),
+ raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ _ ->
+ ok
+ end.
+
+call_relay(Pid, Data, Timeout) ->
+ case whereis(orber_objkeyserver) of
+ undefined ->
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_MAYBE});
+ _ ->
+ case catch gen_server:call(Pid, Data, Timeout) of
+ {'EXCEPTION', E} ->
+ raise(E);
+ {'EXIT',{timeout, _}} ->
+ raise(#'TIMEOUT'{completion_status=?COMPLETED_MAYBE});
+ {'EXIT',R} ->
+ orber:dbg("[~p] corba:call_internal(~p);~n"
+ "call exit(~p).", [?LINE, Data, R], ?DEBUG_LEVEL),
+ exit(R);
+ Res ->
+ Res
+ end
+ end.
+
+%%-----------------------------------------------------------------
+%% Corba:cast - the function for ONEWAY requests
+%%-----------------------------------------------------------------
+cast(Obj, Func, Args, TypesOrMod) ->
+ cast_helper(Obj, Func, Args, TypesOrMod, []).
+
+cast(Obj, Func, Args, TypesOrMod, [{context, Ctx}]) ->
+ cast_helper(Obj, Func, Args, TypesOrMod, Ctx).
+
+cast_helper(Obj, Func, Args, TypesOrMod, InCtx) ->
+ Ctx = get_implicit_context(InCtx),
+ case iop_ior:get_key(Obj) of
+ {'internal', Key, _, Flags, Mod} ->
+ Pid = orber_objectkeys:get_pid(Key),
+ cast_internal(Pid, Obj, Func, Args, TypesOrMod,
+ ?ORB_FLAG_TEST(Flags, ?ORB_TYPECHECK),
+ ?ORB_FLAG_TEST(Flags, ?ORB_USE_PI), Mod, Ctx);
+ {'internal_registered', Key, _, Flags, Mod} ->
+ cast_internal(Key, Obj, Func, Args, TypesOrMod,
+ ?ORB_FLAG_TEST(Flags, ?ORB_TYPECHECK),
+ ?ORB_FLAG_TEST(Flags, ?ORB_USE_PI), Mod, Ctx);
+ {'external', Key} when is_atom(TypesOrMod) ->
+ case catch TypesOrMod:oe_tc(Func) of
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba:cast_helper(~p);~n"
+ "The call-back module does not exist or incorrect"
+ " IC-version used.~nReason: ~p",
+ [?LINE, TypesOrMod, What], ?DEBUG_LEVEL),
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
+ completion_status=?COMPLETED_NO});
+ undefined ->
+ raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO});
+ Types ->
+ orber_iiop:request(Key, Func, Args, Types, 'false', infinity,
+ Obj, Ctx)
+ end;
+ {'external', Key} ->
+ orber_iiop:request(Key, Func, Args, TypesOrMod, 'false', infinity,
+ Obj, Ctx)
+ end.
+
+cast_internal(Pid, Obj, Func, Args, Types, Check, PI, _Mod, Ctx)
+ when is_pid(Pid) andalso node(Pid) == node() ->
+ invoke_pi_request(PI, Obj, Ctx, Func, Args),
+ typecheck_request(Check, Args, Types, Func),
+ catch gen_server:cast(Pid, {Obj, Ctx, Func, Args}),
+ ok;
+cast_internal(Pid, Obj, Func, Args, Types, Check, PI, Mod, Ctx) when is_pid(Pid) ->
+ invoke_pi_request(PI, Obj, Ctx, Func, Args),
+ typecheck_request(Check, Args, Types, Func),
+ case catch rpc:call(node(Pid), corba, cast_relay, [Pid, {Obj, Ctx, Func, Args}]) of
+ {'EXCEPTION', E} ->
+ typecheck_reply(Check, {'EXCEPTION', E}, Mod, Func),
+ raise(E);
+ {badrpc, {'EXIT', _R}} ->
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 3),
+ completion_status=?COMPLETED_MAYBE});
+ {badrpc,nodedown} ->
+ orber:dbg("[~p] corba:cast_internal(~p, ~p, ~p);~nNode ~p down.",
+ [?LINE, Func, Args, Types, node(Pid)], ?DEBUG_LEVEL),
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 2),
+ completion_status=?COMPLETED_NO});
+ Other ->
+ orber:dbg("[~p] corba:cast_internal(~p, ~p, ~p);~n"
+ "Communication with node: ~p failed with reason: ~p.",
+ [?LINE, Func, Args, Types, node(Pid), Other], ?DEBUG_LEVEL),
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 5),
+ completion_status=?COMPLETED_MAYBE})
+ end;
+
+%% This case handles if the reference is created as a Pseudo object.
+%% Just call apply/3.
+cast_internal({pseudo, Module}, Obj, Func, Args, Types, Check, PI, _Mod, Ctx) ->
+ OldCtx = put(oe_server_in_context, Ctx),
+ invoke_pi_request(PI, Obj, Ctx, Func, Args),
+ typecheck_request(Check, Args, Types, Func),
+ State = binary_to_term(get_subobject_key(Obj)),
+ catch apply(Module, Func, [Obj, State|Args]),
+ put(oe_server_in_context, OldCtx),
+ ok;
+cast_internal(Registered, Obj, Func, Args, Types, Check, PI, _Mod, Ctx) ->
+ invoke_pi_request(PI, Obj, Ctx, Func, Args),
+ typecheck_request(Check, Args, Types, Func),
+ case whereis(Registered) of
+ undefined ->
+ raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO});
+ P ->
+ gen_server:cast(P, {Obj, Ctx, Func, Args})
+ end.
+
+cast_relay(Pid, Data) ->
+ case whereis(orber_objkeyserver) of
+ undefined ->
+ raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 1),
+ completion_status=?COMPLETED_NO});
+ _ ->
+ gen_server:cast(Pid, Data)
+ end.
+
+%%-----------------------------------------------------------------
+%% Corba:locate - this function is for the moment just used for tests
+%%-----------------------------------------------------------------
+locate(Obj) ->
+ locate(Obj, infinity, []).
+
+locate(Obj, Timeout) ->
+ locate(Obj, Timeout, []).
+
+locate(Obj, Timeout, Ctx) ->
+ case iop_ior:get_key(Obj) of
+ {'external', Key} ->
+ orber_iiop:locate(Key, Timeout, Obj, Ctx);
+ _ ->
+ orber_objectkeys:check(iop_ior:get_objkey(Obj))
+ end.
+
+%%-----------------------------------------------------------------
+%% Incomming request from iiop
+%%-----------------------------------------------------------------
+%% Operations which do not allow object invokation.
+request_from_iiop(Obj, '_is_a', [Args], _, _, _) ->
+ catch corba_object:is_a(Obj, Args);
+%% First the OMG specified this operation to be '_not_existent' and then
+%% changed it to '_non_existent' without suggesting that both must be supported.
+%% See CORBA2.3.1 page 15-34, Minor revision 2.3.1: October 1999
+request_from_iiop(Obj, '_not_existent', _, _, _, _) ->
+ catch corba_object:non_existent(Obj);
+request_from_iiop(Obj, '_non_existent', _, _, _, _) ->
+ catch corba_object:non_existent(Obj);
+request_from_iiop(_, '_FT_HB', _, _, _, _) ->
+ ok;
+
+%% "Ordinary" operations.
+request_from_iiop({Mod, _, _, _, _, _}, oe_get_interface,
+ _, _, _, _ServiceCtx) when is_atom(Mod) ->
+ case catch Mod:oe_get_interface() of
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba:request_from_iiop(~p);~n"
+ "The call-back module does not exist or"
+ " incorrect IC-version used.~nReason: ~p",
+ [?LINE, Mod, What], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
+ completion_status=?COMPLETED_NO}};
+ undefined ->
+ {'EXCEPTION', #'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
+ completion_status='COMPLETED_NO'}};
+ Interface ->
+ Interface
+ end;
+request_from_iiop({_Mod, pseudo, Module, _UserDef, _OrberDef, _Flags} = ObjRef,
+ Func, Args, Types, ResponseExpected, _ServiceCtx) ->
+ State = binary_to_term(get_subobject_key(ObjRef)),
+ case ResponseExpected of
+ true ->
+ case catch apply(Module, Func, [ObjRef, State|Args]) of
+ {noreply, _} ->
+ ok;
+ {noreply, _, _} ->
+ ok;
+ {reply, Reply, _} ->
+ Reply;
+ {reply, Reply, _, _} ->
+ Reply;
+ {stop, _, Reply, _} ->
+ Reply;
+ {stop, _, _} ->
+ ok;
+ {'EXCEPTION', E} ->
+ {'EXCEPTION', E};
+ {'EXIT', {undef, _}} ->
+ orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n"
+ "The call-back module does not exist.",
+ [?LINE, Func, Args, Types], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO}};
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n"
+ "Pseudo object exit(~p).~n"
+ "The call-back module probably contain an error.",
+ [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_MAYBE}};
+ Unknown ->
+ orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n"
+ "Pseudo object failed(~p);~n"
+ "Confirm that the return value is correct"
+ " (e.g. {reply, Reply, State})",
+ [?LINE, Func, Args, Types, Unknown], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 6),
+ completion_status=?COMPLETED_MAYBE}}
+ end;
+ false ->
+ catch apply(Module, Func, [ObjRef, State|Args]),
+ ok;
+ true_oneway ->
+ catch apply(Module, Func, [ObjRef, State|Args]),
+ ok
+ end;
+% FOR PASSIVE REPLICATION! (Response IS expected --- one way semantics doesn't
+% really mix with intentions to be consistent & fault tolerant.)
+request_from_iiop({_Mod, passive, Module, _UserDef, _OrberDef, _Flags} = ObjRef,
+ Func, Args, Types, true, Ctx) ->
+ GroupID = binary_to_term(get_subobject_key(ObjRef)),
+ FTGroupVersionCtx = get_FTGroupVersionCtx(Ctx),
+ Transaction =
+ fun() ->
+ ObjectGroup = read_object_group(GroupID),
+ check_version_context(ObjectGroup,
+ FTGroupVersionCtx),
+ call_primary_protected(ObjectGroup,
+ Module,
+ ObjRef,
+ Func,
+ Args,
+ GroupID,
+ get_FTRequestCtx(Ctx))
+ end,
+ case mnesia:transaction(Transaction) of
+ {atomic, Reply} ->
+ Reply;
+ {aborted, {too_old_reference, IOGR}} ->
+ {oe_location_forward_perm, IOGR};
+ {aborted, {not_primary, _Primary, IOGR}} ->
+ case FTGroupVersionCtx of
+ [] ->
+ {oe_location_forward_perm, IOGR};
+ _ ->
+ {'EXCEPTION', #'TRANSIENT'{minor = 0,
+ completion_status = ?COMPLETED_NO}}
+ end;
+ {aborted, {throw, {'EXCEPTION', E}}} ->
+ {'EXCEPTION', E};
+ {aborted, {'EXIT', What}} ->
+ orber:dbg("[~p] corba:call_passive(~p, ~p, ~p);~n"
+ "Passive object exit(~p).",
+ [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'TRANSIENT'{minor = 0,
+ completion_status=?COMPLETED_MAYBE}};
+ {aborted, Unknown} ->
+ orber:dbg("[~p] corba:call_passive(~p, ~p, ~p);~n"
+ "Passive object failed due to bad return value (~p).",
+ [?LINE, Func, Args, Types, Unknown], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'TRANSIENT'{minor = 0,
+ completion_status=?COMPLETED_MAYBE}}
+ end;
+request_from_iiop({_Mod, _Type, Key, _UserDef, _OrberDef, _Flags} = ObjRef,
+ Func, Args, Types, true, _ServiceCtx) ->
+ case catch gen_server:call(convert_key_to_pid(Key),
+ {ObjRef, [], Func, Args}, infinity) of
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n"
+ "gen_server:call exit: ~p",
+ [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_MAYBE}};
+ Result ->
+ Result
+ end;
+request_from_iiop({_Mod, _Type, Key, _UserDef, _OrberDef, _Flags} = ObjRef,
+ Func, Args, Types, _, _ServiceCtx) ->
+ case catch gen_server:cast(convert_key_to_pid(Key),
+ {ObjRef, [], Func, Args}) of
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n"
+ "gen_server:cast exit: ~p",
+ [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_MAYBE}};
+ Result ->
+ Result
+ end.
+
+%%------------------------------------------------------------
+%% Internal stuff
+%%------------------------------------------------------------
+
+convert_key_to_pid(Key) when is_binary(Key) ->
+ orber_objectkeys:get_pid(Key);
+convert_key_to_pid(Name) when is_atom(Name) ->
+ Name.
+
+mk_objkey(Mod, Pid, RegName, Persistent) ->
+ mk_objkey(Mod, Pid, RegName, Persistent, 0).
+
+mk_objkey(Mod, Pid, [], _, Flags) when is_pid(Pid) ->
+ Key = make_objkey(),
+ case orber_objectkeys:register(Key, Pid, false) of
+ ok ->
+ {Mod, 'key', Key, term_to_binary(undefined), 0, Flags};
+ R ->
+ orber:dbg("[~p] corba:mk_objkey(~p);~n"
+ "unable to store key(~p).", [?LINE, Mod, R], ?DEBUG_LEVEL),
+ raise(#'INTERNAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO})
+ end;
+mk_objkey(Mod, Pid, {'global', RegName}, Persitent, Flags) when is_pid(Pid) ->
+ Key = term_to_binary(RegName),
+ case orber_objectkeys:register(Key, Pid, Persitent) of
+ ok ->
+ {Mod, 'key', Key, term_to_binary(undefined), 0, Flags};
+ R ->
+ orber:dbg("[~p] corba:mk_objkey(~p, ~p);~n"
+ "unable to store key(~p).",
+ [?LINE, Mod, RegName, R], ?DEBUG_LEVEL),
+ raise(#'INTERNAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO})
+ end;
+mk_objkey(Mod, Pid, {'local', RegName}, Persistent, Flags) when is_pid(Pid) andalso is_atom(RegName) ->
+ register(RegName, Pid),
+ Key = make_objkey(),
+ case orber_objectkeys:register(Key, Pid, Persistent) of
+ ok ->
+ {Mod, 'registered', RegName, term_to_binary(undefined), 0, Flags};
+ R ->
+ orber:dbg("[~p] corba:mk_objkey(~p, ~p);~n"
+ "unable to store key(~p).",
+ [?LINE, Mod, RegName, R], ?DEBUG_LEVEL),
+ raise(#'INTERNAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO})
+ end.
+
+
+mk_light_objkey(Mod, RegName) ->
+ {Mod, 'registered', RegName, term_to_binary(undefined), 0, 0}.
+
+mk_pseudo_objkey(Mod, Module, Flags) ->
+ {Mod, 'pseudo', Module, term_to_binary(undefined), 0, Flags}.
+
+mk_passive_objkey(Mod, Module, Flags) ->
+ {Mod, 'passive', Module, term_to_binary(undefined), 0, Flags}.
+
+make_objkey() ->
+ term_to_binary({now(), node()}).
+
+objkey_to_string({_Mod, 'registered', 'orber_init', _UserDef, _OrberDef, _Flags}) ->
+ "INIT";
+objkey_to_string({Mod, Type, Key, UserDef, OrberDef, Flags}) ->
+ orber:domain() ++ [ 7 | binary_to_list(term_to_binary({Mod, Type, Key, UserDef, OrberDef, Flags}))];
+objkey_to_string(External_object_key) ->
+ External_object_key.
+
+string_to_objkey("INIT") ->
+ {orber_initial_references, 'registered', 'orber_init', term_to_binary(undefined), 0, 0};
+string_to_objkey(String) ->
+ case prefix(orber:domain(), String) of
+ [7 | Rest] ->
+ binary_to_term(list_to_binary(Rest));
+ _ ->
+ String
+ end.
+%% This function may only be used when we know it's a local reference (i.e. target
+%% key in a request; IOR's passed as argument or reply doesn't qualify)!
+string_to_objkey_local("INIT") ->
+ {orber_initial_references, 'registered', 'orber_init', term_to_binary(undefined), 0, 0};
+string_to_objkey_local(String) ->
+ case prefix(orber:domain(), String) of
+ [7 | Rest] ->
+ binary_to_term(list_to_binary(Rest));
+ _ ->
+ case resolve_initial_references(String) of
+ ?ORBER_NIL_OBJREF ->
+ orber:dbg("[~p] corba:string_to_objkey_local(~p);~n"
+ "Invalid ObjektKey.", [?LINE, String], ?DEBUG_LEVEL),
+ ?ORBER_NIL_OBJREF;
+ Object ->
+ {location_forward, Object}
+ end
+ end.
+
+prefix([], L2) ->
+ L2;
+prefix([E |L1], [E | L2]) ->
+ prefix(L1, L2);
+prefix(_, _) ->
+ false.
+
+
+evaluate_options([], Options) ->
+ GlobalFlags = orber:get_flags(),
+ Options2 = check_flag(Options, ?ORB_TYPECHECK,
+ ?ORB_ENV_LOCAL_TYPECHECKING, GlobalFlags),
+ Options3 = check_flag(Options2, ?ORB_USE_PI, ?ORB_ENV_USE_PI, GlobalFlags),
+ check_flag(Options3, ?ORB_SURVIVE_EXIT, ?ORB_ENV_SURVIVE_EXIT, GlobalFlags);
+%% Pseudo or not.
+evaluate_options([{pseudo, false}|Rest], Options) ->
+ evaluate_options(Rest, Options);
+evaluate_options([{pseudo, true}|Rest], #options{passive = false} = Options) ->
+ evaluate_options(Rest, Options#options{pseudo = true});
+%% FT stuff
+evaluate_options([{passive, true}|Rest], #options{pseudo = false} = Options) ->
+ evaluate_options(Rest, Options#options{passive = true});
+evaluate_options([{group_id, ID}|Rest], Options) when is_integer(ID) ->
+ evaluate_options(Rest, Options#options{group_id = ID});
+%% Options accepted by gen_server (e.g. dbg).
+evaluate_options([{create_options, COpt}|Rest], Options) when is_list(COpt) ->
+ evaluate_options(Rest, Options#options{create_options = COpt});
+%% When starting object as supervisor child.
+evaluate_options([{sup_child, false}|Rest], Options) ->
+ evaluate_options(Rest, Options);
+evaluate_options([{sup_child, true}|Rest], Options) ->
+ evaluate_options(Rest, Options#options{sup_child = true});
+%% Persistent object-key
+evaluate_options([{persistent, false}|Rest], Options) ->
+ evaluate_options(Rest, Options);
+evaluate_options([{persistent, true}|Rest], Options) ->
+ evaluate_options(Rest, Options#options{persistent = true});
+evaluate_options([{regname, []}|Rest], Options) ->
+ evaluate_options(Rest, Options);
+evaluate_options([{regname, Name}|Rest], Options) ->
+ evaluate_options(Rest, Options#options{regname = Name});
+evaluate_options([{survive_exit, false}|Rest],
+ #options{object_flags_set = FlagsSet} = Options) ->
+ %% This option overrides a global setting.
+ evaluate_options(Rest, Options#options{object_flags_set =
+ (?ORB_SURVIVE_EXIT bor FlagsSet)});
+evaluate_options([{survive_exit, true}|Rest],
+ #options{object_flags = Flags,
+ object_flags_set = FlagsSet} = Options) ->
+ evaluate_options(Rest, Options#options{object_flags =
+ (?ORB_SURVIVE_EXIT bor Flags),
+ object_flags_set =
+ (?ORB_SURVIVE_EXIT bor FlagsSet)});
+evaluate_options([{local_typecheck, false}|Rest],
+ #options{object_flags_set = FlagsSet} = Options) ->
+ %% This option overrides a global setting.
+ evaluate_options(Rest, Options#options{object_flags_set =
+ (?ORB_TYPECHECK bor FlagsSet)});
+evaluate_options([{local_typecheck, true}|Rest],
+ #options{object_flags = Flags,
+ object_flags_set = FlagsSet} = Options) ->
+ evaluate_options(Rest, Options#options{object_flags = (?ORB_TYPECHECK bor Flags),
+ object_flags_set =
+ (?ORB_TYPECHECK bor FlagsSet)});
+evaluate_options([{local_interceptors, false}|Rest],
+ #options{object_flags_set = FlagsSet} = Options) ->
+ %% This option overrides a global setting.
+ evaluate_options(Rest, Options#options{object_flags_set =
+ (?ORB_USE_PI bor FlagsSet)});
+evaluate_options([{local_interceptors, true}|Rest],
+ #options{object_flags = Flags,
+ object_flags_set = FlagsSet} = Options) ->
+ evaluate_options(Rest, Options#options{object_flags = (?ORB_USE_PI bor Flags),
+ object_flags_set =
+ (?ORB_USE_PI bor FlagsSet)});
+%% Temporary option.
+evaluate_options([{no_security, true}|Rest],
+ #options{object_flags = Flags} = Options) ->
+ %% We do not allow this option to be set globally.
+ evaluate_options(Rest, Options#options{object_flags = (?ORB_NO_SECURITY bor Flags)});
+evaluate_options([{no_security, false}|Rest], Options) ->
+ %% We do not allow this option to be set globally.
+ evaluate_options(Rest, Options);
+evaluate_options([{Key, Value}|_], _) ->
+ orber:dbg("[~p] corba:evaluate_options(~p, ~p);~n"
+ "Option not recognized, illegal value or combination.~n"
+ "Allowed settings:~n"
+ "survive_exit.......: boolean()~n"
+ "sup_child..........: boolean()~n"
+ "persistent.........: boolean()~n"
+ "pseudo.............: boolean()~n"
+ "local_typecheck....: boolean()~n"
+ "local_interceptors.: boolean()~n"
+ "regname............: {local, atom()} | {global, term()}",
+ [?LINE, Key, Value], ?DEBUG_LEVEL),
+ raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+check_flag(#options{object_flags = Flags,
+ object_flags_set = FlagsSet} = Options, Flag,
+ FlagConstant, GlobalFlags) ->
+ %% Option activated/deactived by a supplied option.
+ case ?ORB_FLAG_TEST(FlagsSet, Flag) of
+ true ->
+ Options;
+ false ->
+ %% Not the above. Globally defined?
+ case ?ORB_FLAG_TEST(GlobalFlags, FlagConstant) of
+ true ->
+ Options#options{object_flags = (Flag bor Flags)};
+ false ->
+ Options
+ end
+ end.
+
+%%%%%%%%%%%%%%%%% FOR PASSIVE REPLICATION!
+% Note should be called inside transaction. Does not catch exceptions.
+% let's not allow corba:reply from transaction... (no {noreply, ...} messages)
+% should the object be able to stop itself by returning {stop, ...}?
+% how about corba:dispose then? Deleting table representing object group and
+% corresponding entry in ft_replication_manager -table might just do the job?
+% No {stop, ...} messages for now
+% Exceptions falls through. They are expected to be caught by transaction in a
+% form of {aborted, {throw, {'EXCEPTION', ...}}}
+call_passive(Module, Obj, Func, Args, GroupID) ->
+ [Record] = mnesia:read(ft_replicated_object, GroupID, sticky_write),
+ State = Record#ft_replicated_object.state,
+
+ case apply(Module, Func, [Obj, State|Args]) of
+ {reply, Reply, NewState} ->
+ {Reply, NewState};
+ {reply, Reply, NewState, _} ->
+ {Reply, NewState}
+ end,
+ mnesia:write(ft_replicated_object,
+ #ft_replicated_object{group_id = GroupID, state = NewState},
+ sticky_write),
+ Reply.
+
+
+
+% FTRequestCtx protected object call
+% One should protect agains aged reply. If expirations_time is reached and
+% request is retransmitted, one might return BAD_CONTEXT -exception!
+call_RQprotected(Module, Obj, Func, Args, GroupID, RQCtx) ->
+ case mnesia:read(ft_reply_retention, RQCtx, sticky_write) of
+ % fresh request
+ [] ->
+ Reply = call_passive(Module, Obj, Func, Args, GroupID),
+ mnesia:write(ft_reply_retention,
+ #ft_reply_retention{retention_id= RQCtx,reply= Reply},
+ sticky_write),
+ Reply;
+ % retransmitted request
+ #ft_reply_retention{reply = Reply} ->
+ Reply
+ end.
+
+
+
+% call_primary_protected. Protects agains calling non-primary node.
+% normal case, without FTRequest Service Context
+call_primary_protected(#ft_replication_manager{primary = Primary},
+ Module,
+ Obj,
+ Func,
+ Args,
+ GroupID,
+ []) when Primary == node() ->
+ call_passive(Module, Obj, Func, Args, GroupID);
+% normal case, with FTRequest Service Context
+call_primary_protected(#ft_replication_manager{primary = Primary},
+ Module,
+ Obj,
+ Func,
+ Args,
+ GroupID,
+ RetentionID) when Primary == node() ->
+ call_RQprotected(Module, Obj, Func, Args, GroupID, RetentionID);
+% case where primary resides in another node
+call_primary_protected(#ft_replication_manager{primary = Primary,
+ iogr = IOGR},
+ _Module, _Obj, _Func, _Args, _GroupID, _) ->
+ mnesia:abort({not_primary, Primary, IOGR}).
+
+
+
+% no context
+check_version_context(_, []) ->
+ ok;
+% client's IOGR is current.
+check_version_context(#ft_replication_manager{ref_version = CurrentVer},
+ GroupVer) when CurrentVer == GroupVer ->
+ ok;
+% client's IOGR is old.
+check_version_context(#ft_replication_manager{ref_version = CurrentVer,
+ iogr = IOGR},
+ GroupVer) when CurrentVer > GroupVer ->
+ mnesia:abort({too_old_reference, IOGR});
+% client's IOGR is too new!
+check_version_context(#ft_replication_manager{ref_version = CurrentVer},
+ GroupVer) when CurrentVer < GroupVer ->
+ raise(#'INV_OBJREF'{completion_status = ?COMPLETED_NO}).
+
+
+
+read_object_group(GroupID) ->
+ case mnesia:read({ft_replication_manager, GroupID}) of
+ [] ->
+ raise(#'OBJECT_NOT_EXIST'{completion_status = ?COMPLETED_NO});
+ [ObjectGroup] ->
+ ObjectGroup
+ end.
+
+
+
+mk_FTRequestCtx(Expiration_time) ->
+ #'FT_FTRequestServiceContext'{
+ client_id = atom_to_list(node()),
+ retention_id = orber_request_number:get(),
+ expiration_time = Expiration_time}.
+
+
+
+get_FTRequestCtx([#'FT_FTRequestServiceContext'
+ {client_id = Client_ID, retention_id = Retention_ID,
+ expiration_time = Expiration_time}|_Ctxs]) ->
+ {Client_ID, Retention_ID, Expiration_time};
+get_FTRequestCtx([]) ->
+ [];
+get_FTRequestCtx([_Ctx|Ctxs]) ->
+ get_FTRequestCtx(Ctxs).
+
+
+
+get_FTGroupVersionCtx([#'FT_FTGroupVersionServiceContext'
+ {object_group_ref_version = Version}|_Ctxs]) ->
+ Version;
+get_FTGroupVersionCtx([]) ->
+ [];
+get_FTGroupVersionCtx([_Ctx|Ctxs]) ->
+ get_FTGroupVersionCtx(Ctxs).
+
diff --git a/lib/orber/src/corba_boa.erl b/lib/orber/src/corba_boa.erl
new file mode 100644
index 0000000000..52f2aa791c
--- /dev/null
+++ b/lib/orber/src/corba_boa.erl
@@ -0,0 +1,134 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: corba_boa.erl
+%%
+%% Description:
+%% This file contains the CORBA::BOA interface
+%%
+%%-----------------------------------------------------------------
+-module(corba_boa).
+
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/include/ifr_types.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([%create/3,
+ dispose/1,
+ get_id/1]).
+% change_implementation/2,
+% set_exception/3,
+% impl_is_ready/1,
+% deactivate_impl/1,
+% obj_is_ready/2,
+% deactivate_obj/1,
+% get_principal/2]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([]).
+
+%%-----------------------------------------------------------------
+%% Macros
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 5).
+
+%%-----------------------------------------------------------------
+%% External functions
+%%-----------------------------------------------------------------
+%create(Id, Interface, Implementation) ->
+% corba:create(Implementation#orb_ImplDef.module,
+% Interface#fullinterfacedescription.id).
+
+dispose(Object) ->
+ case binary_to_term(iop_ior:get_privfield(Object)) of
+ undefined ->
+ case catch iop_ior:get_key(Object) of
+ {'internal', Key, _, _, _} ->
+ case orber_objectkeys:get_pid(Key) of
+ {error, Reason} ->
+ orber:dbg("[~p] corba_boa:dispose(~p); object not found(~p)",
+ [?LINE, Object, Reason], ?DEBUG_LEVEL),
+ corba:raise(#'TRANSIENT'{completion_status=?COMPLETED_NO});
+ Pid ->
+ gen_server:call(Pid, stop)
+ end;
+ {'internal_registered', Key, _, _, _} ->
+ case Key of
+ {pseudo, Module} ->
+ Module:terminate(normal, undefined),
+ ok;
+ _ ->
+ case whereis(Key) of
+ undefined ->
+ corba:raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO});
+ Pid ->
+ gen_server:call(Pid, stop)
+ end
+ end;
+ {'external', _} ->
+ orber:dbg("[~p] corba_boa:dispose(~p); external object.",
+ [?LINE, Object], ?DEBUG_LEVEL),
+ %% Must be fixed !!!!!!!!
+ corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO})
+ end;
+ Other ->
+ case iop_ior:get_key(Object) of
+ {_, {pseudo, Module}, _, _, _} ->
+ Module:terminate(normal, Other),
+ ok;
+ Why ->
+ orber:dbg("[~p] corba_boa:dispose(~p); probably subobject key set(~p)",
+ [?LINE, Object, Why], ?DEBUG_LEVEL),
+ corba:raise(#'NO_PERMISSION'{completion_status=?COMPLETED_NO})
+ end
+ end.
+
+get_id(Object) ->
+ iop_ior:get_objkey(Object).
+
+%change_implementation(Object, ImplementationDef) ->
+% ok.
+
+%get_principal(Object, Env) ->
+% ok.
+
+%set_exception(Major, Id, Param) ->
+% ok.
+
+%impl_is_ready(ImplementationDef) ->
+% ok.
+
+%deactivate_impl(ImplementationDef) ->
+% ok.
+
+%obj_is_ready(Object, ImplementationDef) ->
+% ok.
+
+%deactivate_obj(Object) ->
+% ok.
+
+%%-----------------------------------------------------------------
+%% Internal functions
+%%-----------------------------------------------------------------
diff --git a/lib/orber/src/corba_nvlist.erl b/lib/orber/src/corba_nvlist.erl
new file mode 100644
index 0000000000..d4bb8bff6a
--- /dev/null
+++ b/lib/orber/src/corba_nvlist.erl
@@ -0,0 +1,97 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: corba_nvlist.erl
+%% Description:
+%% This file contains the CORBA::NVList handling
+%%
+%%-----------------------------------------------------------------
+-module(corba_nvlist).
+
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/src/orber_iiop.hrl").
+
+%%-----------------------------------------------------------------
+%% Standard interface CORBA::NVList
+%%-----------------------------------------------------------------
+-export([add_item/6,
+ free/1,
+ free_memory/1,
+ get_count/1]).
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([create_list/1,
+ create_operation_list/1]).
+
+%%------------------------------------------------------------
+%% Implementation of standard interface CORBA::NVList
+%%------------------------------------------------------------
+add_item(List, Id, TC, Value, Len, ArgFlags) ->
+ {ok, List}.
+
+free(List) ->
+ ok.
+
+free_memory(List) ->
+ ok.
+
+get_count(List) ->
+ {ok, 0}.
+
+%%------------------------------------------------------------
+%% Implementation of extra functions which creates NVList:s
+%% theese ae used by the standard functions with the same name
+%% in the CORBA::ORB interface
+%%------------------------------------------------------------
+
+create_list(Count) ->
+ {ok, create_list_2(Count, [])}.
+
+create_list_2(0, Acc) ->
+ Acc;
+create_list_2(N, Acc) ->
+ create_list_2(N-1, [[] | Acc]).
+
+create_operation_list(OpDef) ->
+ OpArgList = OpDef,
+ {ok, create_operation_list_2(OpArgList, [])}.
+
+create_operation_list_2([], Acc) ->
+ Acc;
+create_operation_list_2([OpArg | OpArgList], Acc) ->
+ Rec = parse_oparg_def(OpArg),
+ create_operation_list_2(OpArgList, [Rec | Acc]).
+
+parse_oparg_def(OpArg) ->
+ OpArg.
+
+
+
+
+
+
+
+
+
+
+
diff --git a/lib/orber/src/corba_object.erl b/lib/orber/src/corba_object.erl
new file mode 100644
index 0000000000..49e388b25f
--- /dev/null
+++ b/lib/orber/src/corba_object.erl
@@ -0,0 +1,220 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: corba_object.erl
+%%
+%% Description:
+%% This file contains the CORBA::Object interface
+%%
+%%-----------------------------------------------------------------
+-module(corba_object).
+
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/src/orber_iiop.hrl").
+-include_lib("orber/src/ifr_objects.hrl").
+
+%%-----------------------------------------------------------------
+%% Standard interface CORBA::Object
+%%-----------------------------------------------------------------
+-export([get_interface/1,
+ is_nil/1,
+ is_a/2,
+ is_a/3,
+ is_remote/1,
+ non_existent/1,
+ non_existent/2,
+ not_existent/1,
+ not_existent/2,
+ is_equivalent/2,
+ hash/2,
+ create_request/6]).
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([]).
+
+%%-----------------------------------------------------------------
+%% Macros
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 5).
+
+%%------------------------------------------------------------
+%% Implementation of standard interface
+%%------------------------------------------------------------
+get_interface(Obj) ->
+ case orber_env:light_ifr() of
+ false ->
+ TypeId = iop_ior:get_typeID(Obj),
+ case mnesia:dirty_index_read(ir_InterfaceDef, TypeId, #ir_InterfaceDef.id) of
+ %% If all we get is an empty list there are no such
+ %% object registered in the IFR.
+ [] ->
+ orber:dbg("[~p] corba_object:get_interface(~p); TypeID ~p not found in IFR.",
+ [?LINE, Obj, TypeId], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
+ [#ir_InterfaceDef{ir_Internal_ID=Ref}] ->
+ orber_ifr_interfacedef:describe_interface({ir_InterfaceDef, Ref})
+ end;
+ true ->
+ case catch iop_ior:get_key(Obj) of
+ {'external', _Key} ->
+ orber:dbg("[~p] corba_object:get_interface(~p); Invalid object reference.",
+ [?LINE, Obj], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
+ {_Local, _Key, _, _, Module} ->
+ case catch Module:oe_get_interface() of
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba_object:get_interface(~p);~n"
+ "The call-back module does not exist or incorrect IC-version used.~n"
+ "Reason: ~p", [?LINE, Module, What], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
+ InterfaceDesc ->
+ InterfaceDesc
+ end
+ end
+ end.
+
+
+is_nil(Object) when is_record(Object, 'IOP_IOR') ->
+ iop_ior:check_nil(Object);
+is_nil({I,T,K,P,O,F}) ->
+ iop_ior:check_nil({I,T,K,P,O,F});
+is_nil(Obj) ->
+ orber:dbg("[~p] corba_object:is_nil(~p); Invalid object reference.",
+ [?LINE, Obj], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
+
+is_a(Obj, Logical_type_id) ->
+ is_a(Obj, Logical_type_id, []).
+
+is_a(?ORBER_NIL_OBJREF, _, _Ctx) ->
+ false;
+is_a(#'IOP_IOR'{type_id = Logical_type_id}, Logical_type_id, _Ctx) ->
+ true;
+is_a(Obj, Logical_type_id, Ctx) when is_list(Ctx) ->
+ case catch iop_ior:get_key(Obj) of
+ {'external', Key} ->
+ orber_iiop:request(Key, '_is_a', [Logical_type_id],
+ {orber_tc:boolean(),[orber_tc:string(0)],[]},
+ true, infinity, Obj, corba:get_implicit_context(Ctx));
+ {_Local, _Key, _, _, Module} ->
+ case catch Module:oe_is_a(Logical_type_id) of
+ {'EXIT', What} ->
+ orber:dbg("[~p] corba_object:is_a(~p);~n"
+ "The call-back module does not exist or incorrect IC-version used.~n"
+ "Reason: ~p", [?LINE, Module, What], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
+ Boolean ->
+ Boolean
+ end;
+ _ ->
+ orber:dbg("[~p] corba_object:is_a(~p, ~p); Invalid object reference.",
+ [?LINE, Obj, Logical_type_id], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
+ end;
+is_a(Obj, Logical_type_id, Ctx) ->
+ orber:dbg("[~p] corba_object:is_a(~p, ~p, ~p);~n"
+ "Failed to supply a context list.",
+ [?LINE, Obj, Logical_type_id, Ctx], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+
+non_existent(Obj) ->
+ non_existent(Obj, []).
+
+non_existent(?ORBER_NIL_OBJREF, _Ctx) ->
+ true;
+non_existent(Obj, Ctx) ->
+ existent_helper(Obj, '_non_existent', Ctx).
+
+not_existent(Obj) ->
+ not_existent(Obj, []).
+
+not_existent(?ORBER_NIL_OBJREF, _Ctx) ->
+ true;
+not_existent(Obj, Ctx) ->
+ existent_helper(Obj, '_not_existent', Ctx).
+
+
+existent_helper(Obj, Op, Ctx) when is_list(Ctx) ->
+ case catch iop_ior:get_key(Obj) of
+ {'internal', Key, _, _, _} ->
+ case catch orber_objectkeys:get_pid(Key) of
+ {'EXCEPTION', E} when is_record(E,'OBJECT_NOT_EXIST') ->
+ true;
+ {'EXCEPTION', X} ->
+ corba:raise(X);
+ {'EXIT', R} ->
+ orber:dbg("[~p] corba_object:non_existent(~p); exit(~p).",
+ [?LINE, Obj, R], ?DEBUG_LEVEL),
+ corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO});
+ _ ->
+ false
+ end;
+ {'internal_registered', Key, _, _, _} ->
+ case Key of
+ {pseudo, _} ->
+ false;
+ _->
+ case whereis(Key) of
+ undefined ->
+ true;
+ _P ->
+ false
+ end
+ end;
+ {'external', Key} ->
+ orber_iiop:request(Key, Op, [],
+ {orber_tc:boolean(), [],[]}, 'true',
+ infinity, Obj, corba:get_implicit_context(Ctx));
+ true ->
+ false
+ end;
+existent_helper(Obj, Op, Ctx) ->
+ orber:dbg("[~p] corba_object:existent_helper(~p, ~p, ~p);~n"
+ "Failed to supply a context list.",
+ [?LINE, Obj, Op, Ctx], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+
+is_remote(Obj) ->
+ case catch iop_ior:get_key(Obj) of
+ {'external', _} ->
+ true;
+ _ ->
+ false
+ end.
+
+
+is_equivalent(Obj, Obj) ->
+ true;
+is_equivalent({I,T,K,P,_,_}, {I,T,K,P,_,_}) ->
+ true;
+is_equivalent(_, _) ->
+ false.
+
+hash(Obj, Maximum) ->
+ erlang:phash(iop_ior:get_key(Obj), Maximum).
+
+
+create_request(_Obj, _Ctx, _Op, _ArgList, NamedValueResult, _ReqFlags) ->
+ {ok, NamedValueResult, []}.
diff --git a/lib/orber/src/corba_request.erl b/lib/orber/src/corba_request.erl
new file mode 100644
index 0000000000..c4226739a9
--- /dev/null
+++ b/lib/orber/src/corba_request.erl
@@ -0,0 +1,384 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: corba_request.erl
+%% Description:
+%% This file contains an corba request server for Orber
+%%
+%%-----------------------------------------------------------------
+-module(corba_request).
+
+-behaviour(gen_server).
+
+-include_lib("orber/include/corba.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start/1, stop/0, stop_all/0, create/1,
+ create_schema/1]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([init/1, terminate/2, install/2, handle_call/3, handle_info/2]).
+-export([handle_cast/2, dump/0, get_key_from_pid/1]).
+
+%%-----------------------------------------------------------------
+%% Standard interface CORBA::Request
+%%-----------------------------------------------------------------
+-export([add_arg/6,
+ invoke/2,
+ delete/1,
+ send/2,
+ get_response/2]).
+
+%%-----------------------------------------------------------------
+%% Mnesia table definition
+%%-----------------------------------------------------------------
+-record('corba_request', {reqid, ctx, operation, arg_list, result, req_flags, pid}).
+
+
+%%-----------------------------------------------------------------
+%% Macros
+%%-----------------------------------------------------------------
+-define(dirty_query_context, true).
+
+%% This macro returns a read fun suitable for evaluation in a transaction
+-define(read_function(ReqId),
+ fun() ->
+ mnesia:dirty_read(ReqId)
+ end).
+
+%% This macro returns a write fun suitable for evaluation in a transaction
+-define(write_function(R),
+ fun() ->
+ mnesia:dirty_write(R)
+ end).
+
+%% This macro returns a write fun suitable for evaluation in a transaction
+-define(update(R),
+ fun() ->
+ mnesia:dirty_write(R)
+ end).
+
+%% This macro returns a delete fun suitable for evaluation in a transaction
+-define(delete_function(R),
+ fun() ->
+ mnesia:delete(R)
+ end).
+
+-ifdef(dirty_query_context).
+-define(query_check(Q_res), Q_res).
+-else.
+-define(query_check(Q_res), {atomic, Q_res}).
+-endif.
+
+
+-define(CHECK_EXCEPTION(Res), case Res of
+ {'EXCEPTION', E} ->
+ corba:raise(E);
+ R ->
+ R
+ end).
+
+%%-----------------------------------------------------------------
+%% Debugging function
+%%-----------------------------------------------------------------
+dump() ->
+ case catch mnesia:dirty_first('orber_request') of
+ {'EXIT', R} ->
+ io:format("Exited with ~p\n",[R]);
+ Key ->
+ dump_print(Key),
+ dump_loop(Key)
+ end.
+
+dump_loop(PreviousKey) ->
+ case catch mnesia:dirty_next('orber_request', PreviousKey) of
+ {'EXIT', R} ->
+ io:format("Exited with ~p\n",[R]);
+ '$end_of_table' ->
+ ok;
+ Key ->
+ dump_print(Key),
+ dump_loop(Key)
+ end.
+
+dump_print(Key) ->
+ case catch mnesia:dirty_read({'orber_request', Key}) of
+ {'EXIT', R} ->
+ io:format("Exited with ~p\n",[R]);
+ [X] ->
+ io:format("Req Id: ~p, op: ~p\n",[binary_to_term(X#orber_request.object_key),
+ X#orber_request.pid]);
+ _ ->
+ ok
+ end.
+
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+start(Opts) ->
+ gen_server:start_link({local, orber_requestserver}, orber_request, Opts, []).
+
+stop() ->
+ gen_server:call(orber_requestserver, stop, infinity).
+
+
+stop_all() ->
+ Fun = fun() ->
+ mnesia:match_object({orber_request, '_', '_', '_', '_', '_', '_', '_'})
+ end,
+ case catch mnesia:transaction(Fun) of
+ {atomic, Objects} ->
+ lists:foreach(fun({orber_request, _, _, _, _, _, _, _ }) ->
+ ok %gen_server:call(Pid, stop, infinity)
+ end,
+ Objects);
+ R ->
+ R
+ end.
+
+create() ->
+ ?CHECK_EXCEPTION(gen_server:call(orber_requestserver,
+ create, infinity)).
+
+create(Ctx, OP, Args, Flags) ->
+ ?CHECK_EXCEPTION(gen_server:call(orber_requestserver,
+ {create, Ctx, OP, Args, Flags}, infinity)).
+
+delete(ReqId) ->
+ ?CHECK_EXCEPTION(gen_server:call(orber_requestserver,
+ {delete, ReqId}, infinity)).
+
+%%------------------------------------------------------------
+%% Implementation of standard interface
+%%------------------------------------------------------------
+add_arg(ReqId, ArgumentName, TC, Value, Len, ArgFlags) ->
+ Request = ets:lookup_element(orber_request, ReqId),
+ case Request of
+ [] ->
+ ok;
+ R ->
+ Args = Request#orber_request.arg_list,
+ NewArgs = lists:append(Args, []),
+ ets:insert(orber_request, NewArgs),
+ ok
+ end.
+
+invoke(ReqId, InvokeFlags) ->
+ ok.
+
+
+
+send(ReqId, InvokeFlags) ->
+ ok.
+
+get_response(ReqId, ResponseFlags) ->
+ [{_, Val}] = ets:lookup_element(orber_request, ReqId),
+ Val#'orber_request'.result.
+
+%%-----------------------------------------------------------------
+%% Server functions
+%%-----------------------------------------------------------------
+init(Env) ->
+ case mnesia:wait_for_tables(['orber_request'], infinity) of
+ ok ->
+ process_flag(trap_exit, true),
+ {ok, []};
+ StopReason ->
+ {stop, StopReason}
+ end.
+
+terminate(From, Reason) ->
+ ok.
+
+
+
+install(Timeout, Options) ->
+ %% check if there already exists a database. If not, create one.
+ %% DB_initialized = perhaps_create_schema(Nodelist),
+ %% check if mnesia is running. If not, start mnesia.
+ DB_started = perhaps_start_mnesia(),
+
+ %% Do we have a complete set of IFR tables? If not, create them.
+ AllTabs = mnesia:system_info(tables),
+
+ DB_Result = case lists:member(orber_request, AllTabs) of
+ true ->
+ case lists:member({local_content, true},
+ Options) of
+ true->
+ mnesia:add_table_copy(orber_request,
+ node(),
+ ram_copies);
+ _ ->
+ mnesia:create_table(orber_request,
+ [{attributes,
+ record_info(fields,
+ orber_objkeys)}
+ |Options])
+ end;
+ _ ->
+ mnesia:create_table(orber_request,
+ [{attributes,
+ record_info(fields,
+ orber_objkeys)}
+ |Options])
+ end,
+
+ Wait = mnesia:wait_for_tables([orber_request], Timeout),
+ %% Check if any error has occured yet. If there are errors, return them.
+ if
+ DB_Result == {atomic, ok},
+ Wait == ok ->
+ ok;
+ true ->
+ {error, {DB_Result, Wait}}
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: handle_call/3
+%%
+%% Comment:
+%% In objectkey gen_server all exceptions are tupples and corba:raise
+%% may not be used. It is too time consuming to add catches in every
+%% function before returning. On the client side there is a case which
+%% maps every tupple on the format {'exception', E} to corba:raise(E).
+%%-----------------------------------------------------------------
+handle_call(stop, From, State) ->
+ {stop, normal, [], State};
+handle_call(create, From, State) ->
+ ReqId = term_to_binary({node(), now()}),
+ _F = ?write_function(#'corba_request'{reqid=ReqId}),
+ R = write_result(mnesia:transaction(_F)),
+
+ ReqId
+
+ ?query_check(Qres) = mnesia:dirty_read({orber_request, Objkey}),
+ case Qres of
+ [] ->
+ _F = ?write_function(#orber_requests{object_key=Objkey, pid=Pid}),
+ R = write_result(mnesia:transaction(_F)),
+ if
+ R == ok, pid(Pid) ->
+ link(Pid);
+ true ->
+ true
+ end,
+ {reply, R, State};
+ X ->
+ {reply, {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}},
+ State}
+ end;
+handle_call({delete, ReqId}, From, State) ->
+ ?query_check(Qres) = mnesia:dirty_read({orber_request, ReqId}),
+ case Qres of
+ [] ->
+ true;
+ [X] when pid(X#orber_request.pid) ->
+ unlink(X#orber_request.pid);
+ _ ->
+ true
+ end,
+ _F = ?delete_function({orber_request, ReqId}),
+ R = write_result(mnesia:transaction(_F)),
+ {reply, R, State}.
+
+handle_info({'EXIT', Pid, Reason}, State) when pid(Pid) ->
+ _MF = fun() ->
+ mnesia:match_object({orber_request, '_', '_', '_', '_', '_', '_', Pid})
+ end,
+ ?query_check(Qres) = mnesia:ets(_MF),
+ case Qres of
+ [] ->
+ true;
+ X ->
+ remove_requests(X),
+ unlink(Pid);
+ _ ->
+ true
+ end,
+ {noreply, State}.
+
+%%-----------------------------------------------------------------
+%% Internal Functions
+%%-----------------------------------------------------------------
+get_reqids_from_pid(Pid) ->
+ case mnesia:dirty_match_object({orber_request, '_', '_', '_', '_', '_', '_', Pid}) of
+ Keys ->
+ [Keys]
+ _ ->
+ corba:raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO})
+ end.
+
+remove_requests([]) ->
+ ok;
+remove_requests([H|T]) ->
+ _F = ?delete_function({orber_request, H#orber_request.reqid}),
+ write_result(mnesia:transaction(_F)),
+ remove_requests(T).
+
+%%-----------------------------------------------------------------
+%% Check a read transaction
+query_result(?query_check(Qres)) ->
+ case Qres of
+ [Hres] ->
+ Hres#orber_request.pid;
+ [] ->
+ {'excpetion', #'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO}};
+ Other ->
+ {'excpetion', #'INTERNAL'{completion_status=?COMPLETED_NO}}
+ end.
+
+%%-----------------------------------------------------------------
+%% Check a write transaction
+write_result({atomic,ok}) -> ok;
+write_result(Foo) ->
+ {'excpetion', #'INTERNAL'{completion_status=?COMPLETED_NO}}.
+
+
+create_schema(Nodes) ->
+ case mnesia:system_info(use_dir) of
+ false ->
+ mnesia:create_schema(Nodes);
+ _ ->
+ ok
+ end.
+
+perhaps_start_mnesia() ->
+ case mnesia:system_info(is_running) of
+ no ->
+ mnesia:start();
+ _ ->
+ ok
+ end.
+
+
+%%------------------------------------------------------------
+%% Standard gen_server cast handle
+%%
+handle_cast(_, State) ->
+ {noreply, State}.
+
+
diff --git a/lib/orber/src/fixed.erl b/lib/orber/src/fixed.erl
new file mode 100644
index 0000000000..255c86c22a
--- /dev/null
+++ b/lib/orber/src/fixed.erl
@@ -0,0 +1,305 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%--------------------------------------------------------------------
+%% File : fixed.erl
+%% Purpose :
+%%--------------------------------------------------------------------
+
+-module(fixed).
+
+-include_lib("orber/include/corba.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([create/3, add/2, subtract/2, divide/2, multiply/2, unary_minus/1,
+ get_typecode/1]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([]).
+
+%%-----------------------------------------------------------------
+%% Definitions
+%%-----------------------------------------------------------------
+-define(get_max(__X, __Y), if __X > __Y -> __X; true -> __Y end).
+-define(get_min(__X, __Y), if __X > __Y -> __Y; true -> __X end).
+
+-define(BASE, 100000000000000000000000000000000).
+-define(FIXED_MAX, 9999999999999999999999999999999).
+-define(FIXED_MIN, -9999999999999999999999999999999).
+
+-define(DEBUG_LEVEL, 5).
+
+%%-----------------------------------------------------------------
+%% External functions
+%%-----------------------------------------------------------------
+create(Digits, Scale, Value) when is_integer(Digits) andalso Digits >= 0 andalso Digits < 32 andalso
+ is_integer(Scale) andalso Scale >= 0 andalso Digits >= Scale andalso
+ is_integer(Value) andalso Value =< ?FIXED_MAX andalso
+ Value >= ?FIXED_MIN ->
+ case count_digits(abs(Value)) of
+ Dig when Dig =< Digits ->
+ #fixed{digits = Digits, scale = Scale, value = Value};
+ Overflow ->
+ orber:dbg("[~p] fixed:create(~p, ~p, ~p).~n"
+ "The Value exceeds the Digits limit: ~p, ~p",
+ [?LINE, Digits, Scale, Value, Digits, Overflow], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
+ end;
+create(Digits, Scale, Value) ->
+ orber:dbg("[~p] fixed:add(~p, ~p, ~p).~n"
+ "At least one of the supplied arguments is incorrect.~n"
+ "Digits and Scale must be a positive integer with the following~n"
+ "limits:~n"
+ " * 0 =< Digits < 32~n"
+ " * Digits >= Scale~n"
+ " * Value range +/- 9999999999999999999999999999999",
+ [?LINE, Digits, Scale, Value], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+
+get_typecode(#fixed{digits = Digits, scale = Scale}) ->
+ {tk_fixed, Digits, Scale};
+get_typecode(Other) ->
+ orber:dbg("[~p] fixed:get_typecode(~p).
+The supplied argument is not a Fixed Type.", [?LINE, Other], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+add(#fixed{digits = D1, scale = S1, value = V1},
+ #fixed{digits = D2, scale = S2, value = V2}) ->
+ Scale = ?get_max(S1, S2),
+ Digits = ?get_max((D1-S1), (D2-S2)) + Scale +1,
+ %% We must normalize the values before adding. Why?
+ %% 4.23 and 5.2 are represented as 423 and 52. To be able to get the
+ %% correct result we must add 4230 and 5200 == 9430.
+ {PV1, PV2} = normalize(S1, V1, S2, V2),
+ check_fixed_overflow(#fixed{digits = Digits,
+ scale = Scale,
+ value = (PV1 + PV2)});
+add(F1, F2) ->
+ orber:dbg("[~p] fixed:add(~p, ~p).~n"
+ "At least one of the supplied arguments is not a Fixed Type.",
+ [?LINE, F1, F2], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+
+subtract(#fixed{digits = D1, scale = S1, value = V1},
+ #fixed{digits = D2, scale = S2, value = V2}) ->
+ Scale = ?get_max(S1, S2),
+ Digits = ?get_max((D1-S1), (D2-S2)) + Scale +1,
+ {PV1, PV2} = normalize(S1, V1, S2, V2),
+ check_fixed_overflow(#fixed{digits = Digits,
+ scale = Scale,
+ value = (PV1 - PV2)});
+subtract(F1, F2) ->
+ orber:dbg("[~p] fixed:subtract(~p, ~p).~n"
+ "At least one of the supplied arguments is not a Fixed Type.",
+ [?LINE, F1, F2], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+divide(#fixed{digits = D1, scale = S1, value = V1},
+ #fixed{digits = _D2, scale = S2, value = V2}) ->
+ {PV1, PV2} = normalize(S1, V1, S2, V2),
+ DigitsMin = (D1-S1+S2),
+ R1 = (PV1 div PV2),
+ R2 = (R1*?BASE + (PV1 rem PV2) * (?BASE div PV2)),
+ {Result2, Sinf} = delete_zeros_value(R2, 0, R1),
+ check_fixed_overflow(#fixed{digits = DigitsMin + Sinf, scale = Sinf,
+ value = Result2});
+divide(F1, F2) ->
+ orber:dbg("[~p] fixed:divide(~p, ~p).~n"
+ "At least one of the supplied arguments is not a Fixed Type.",
+ [?LINE, F1, F2], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+
+multiply(#fixed{digits = D1, scale = S1, value = V1},
+ #fixed{digits = D2, scale = S2, value = V2}) ->
+ check_fixed_overflow(#fixed{digits = (D1+D2),
+ scale = (S1+S2),
+ value = V1*V2});
+multiply(F1, F2) ->
+ orber:dbg("[~p] fixed:multiply(~p, ~p).~n"
+ "At least one of the supplied arguments is not a Fixed Type.",
+ [?LINE, F1, F2], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+unary_minus(Fixed) when is_record(Fixed, fixed) ->
+ Fixed#fixed{value = -(Fixed#fixed.value)};
+unary_minus(Fixed) ->
+ orber:dbg("[~p] fixed:unary_minus(~p).~n"
+ "The supplied argument is not a Fixed Type.",
+ [?LINE, Fixed], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+
+
+%%-----------------------------------------------------------------
+%% Internal functions
+%%-----------------------------------------------------------------
+%% Pretty?! No, but since we now the upper-limit this is the fastest way
+%% to calculate 10^x
+power(0) -> 1;
+power(1) -> 10;
+power(2) -> 100;
+power(3) -> 1000;
+power(4) -> 10000;
+power(5) -> 100000;
+power(6) -> 1000000;
+power(7) -> 10000000;
+power(8) -> 100000000;
+power(9) -> 1000000000;
+power(10) -> 10000000000;
+power(11) -> 100000000000;
+power(12) -> 1000000000000;
+power(13) -> 10000000000000;
+power(14) -> 100000000000000;
+power(15) -> 1000000000000000;
+power(16) -> 10000000000000000;
+power(17) -> 100000000000000000;
+power(18) -> 1000000000000000000;
+power(19) -> 10000000000000000000;
+power(20) -> 100000000000000000000;
+power(21) -> 1000000000000000000000;
+power(22) -> 10000000000000000000000;
+power(23) -> 100000000000000000000000;
+power(24) -> 1000000000000000000000000;
+power(25) -> 10000000000000000000000000;
+power(26) -> 100000000000000000000000000;
+power(27) -> 1000000000000000000000000000;
+power(28) -> 10000000000000000000000000000;
+power(29) -> 100000000000000000000000000000;
+power(30) -> 1000000000000000000000000000000;
+power(31) -> 10000000000000000000000000000000;
+power(_) -> 10000000000000000000000000000000.
+
+
+
+%% If the result of an operation (+, -, * or /) causes overflow we use this
+%% operation. However, since these calculations are performed during compiletime,
+%% shouldn't the IDL-specification be changed to not cause overflow?! But, since
+%% the OMG standard allows this we must support it.
+check_fixed_overflow(#fixed{digits = Digits, scale = Scale, value = Value}) ->
+ case count_digits(abs(Value)) of
+ overflow ->
+ {N, NewVal} = cut_overflow(0, Value),
+ if
+ N > Scale ->
+ #fixed{digits = 31, scale = 0, value = NewVal};
+ true ->
+ NewScale = Scale - N,
+ {NewVal2, Removed} = delete_zeros(NewVal, NewScale),
+ #fixed{digits = 31, scale = NewScale-Removed, value = NewVal2}
+ end;
+ Count when Count > Digits ->
+ Diff = Count-Digits,
+ if
+ Diff > Scale ->
+ #fixed{digits = Digits, scale = 0,
+ value = (Value div power(Diff))};
+ true ->
+ NewScale = Scale-Diff,
+ {NewVal, Removed} = delete_zeros((Value div power(Diff)), NewScale),
+ #fixed{digits = Digits-Removed,
+ scale = NewScale-Removed,
+ value = NewVal}
+ end;
+ Count ->
+ {NewVal, Removed} = delete_zeros(Value, Scale),
+ #fixed{digits = Count-Removed, scale = Scale-Removed, value = NewVal}
+ end.
+
+%% This function see to that the values are of the same baase.
+normalize(S, V1, S, V2) ->
+ {V1, V2};
+normalize(S1, V1, S2, V2) when S1 > S2 ->
+ {V1, V2*power(S1-S2)};
+normalize(S1, V1, S2, V2) ->
+ {V1*power(S2-S1), V2}.
+
+%% If we have access to the integer part of the fixed type we use this
+%% operation to remove all trailing zeros. If we know the scale, length of
+%% fraction part, we can use delete_zeros as well. But, after a division
+%% it's hard to know the scale and we don't need to calcluate the integer part.
+delete_zeros_value(0, N, _) ->
+ {0, 32-N};
+delete_zeros_value(X, N, M) when X > M, (X rem 10) == 0 ->
+ delete_zeros_value((X div 10), N+1, M);
+delete_zeros_value(X, N, _) ->
+ {X, 32-N}.
+
+%% If we know the exact scale of a fixed type we can use this operation to
+%% remove all trailing zeros.
+delete_zeros(0, _) ->
+ {0,0};
+delete_zeros(X, Max) ->
+ delete_zeros(X, 0, Max).
+delete_zeros(X, Max, Max) ->
+ {X, Max};
+delete_zeros(X, N, Max) when (X rem 10) == 0 ->
+ delete_zeros((X div 10), N+1, Max);
+delete_zeros(X, N, _) ->
+ {X, N}.
+
+cut_overflow(N, X) when X > ?FIXED_MAX ->
+ cut_overflow(N+1, (X div 10));
+cut_overflow(N, X) ->
+ {N, X}.
+
+%% A fast way to check the size of a fixed data type.
+count_digits(X) when X > ?FIXED_MAX -> overflow;
+count_digits(X) when X >= 1000000000000000000000000000000 -> 31;
+count_digits(X) when X >= 100000000000000000000000000000 -> 30;
+count_digits(X) when X >= 10000000000000000000000000000 -> 29;
+count_digits(X) when X >= 1000000000000000000000000000 -> 28;
+count_digits(X) when X >= 100000000000000000000000000 -> 27;
+count_digits(X) when X >= 10000000000000000000000000 -> 26;
+count_digits(X) when X >= 1000000000000000000000000 -> 25;
+count_digits(X) when X >= 100000000000000000000000 -> 24;
+count_digits(X) when X >= 10000000000000000000000 -> 23;
+count_digits(X) when X >= 1000000000000000000000 -> 22;
+count_digits(X) when X >= 100000000000000000000 -> 21;
+count_digits(X) when X >= 10000000000000000000 -> 20;
+count_digits(X) when X >= 1000000000000000000 -> 19;
+count_digits(X) when X >= 100000000000000000 -> 18;
+count_digits(X) when X >= 10000000000000000 -> 17;
+count_digits(X) when X >= 1000000000000000 -> 16;
+count_digits(X) when X >= 100000000000000 -> 15;
+count_digits(X) when X >= 10000000000000 -> 14;
+count_digits(X) when X >= 1000000000000 -> 13;
+count_digits(X) when X >= 100000000000 -> 12;
+count_digits(X) when X >= 10000000000 -> 11;
+count_digits(X) when X >= 1000000000 -> 10;
+count_digits(X) when X >= 100000000 -> 9;
+count_digits(X) when X >= 10000000 -> 8;
+count_digits(X) when X >= 1000000 -> 7;
+count_digits(X) when X >= 100000 -> 6;
+count_digits(X) when X >= 10000 -> 5;
+count_digits(X) when X >= 1000 -> 4;
+count_digits(X) when X >= 100 -> 3;
+count_digits(X) when X >= 10 -> 2;
+count_digits(_X) -> 1.
+
+%%-----------------------------------------------------------------
+%%------------- END OF MODULE -------------------------------------
+%%-----------------------------------------------------------------
diff --git a/lib/orber/src/ifr_objects.hrl b/lib/orber/src/ifr_objects.hrl
new file mode 100644
index 0000000000..0d7c30a86c
--- /dev/null
+++ b/lib/orber/src/ifr_objects.hrl
@@ -0,0 +1,421 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%%----------------------------------------------------------------------
+%%% File : ir_objects.hrl
+%%% Purpose : Record definitions for the IR DB
+%%%----------------------------------------------------------------------
+
+%%%----------------------------------------------------------------------
+%%% *********************************************************************
+%%% * *
+%%% * PLEASE NOTE *
+%%% * *
+%%% * If a record is removed or added in this file, the corresponding *
+%%% * database initialization code _MUST_ be updated accordingly. *
+%%% * *
+%%% * The initialization code is defined in a macro in this file. *
+%%% * *
+%%% * Also remember to update select/2 in orber_ifr.erl when adding *
+%%% * or deleting a record in this file. *
+%%% * *
+%%% *********************************************************************
+%%%----------------------------------------------------------------------
+
+%% Interface objects
+
+%% There are eight interface objects in an interface repository:
+%% Repository, ModuleDef, InterfaceDef, AttributeDef, OperationDef,
+%% TypedefDef, ConstantDef and ExceptionDef (CORBA V2.0, page 6-5/6).
+
+% The other objects defined here are used to build the above objects
+% (CORBA V2.0, page 6-7).
+
+% Object references are stored as mnesia object IDs, i.e. a tuple with
+% the table name and the ir_Internal_ID.
+
+% Inheritance strategy. We incorporate the inherited object into the
+% inheriting object. The record element 'inherited_objects' is a list
+% of objects that "this" object inherits from (i.e. full object
+% records and not object references).
+
+% The record element 'ir_Internal_ID' is a tag that uniquely
+% identifies a record. See the function orber_ifr:unique().
+
+ % IRObject, page 6-9
+-record(ir_IRObject, {ir_Internal_ID,def_kind}).
+
+ % Contained, page 6-9
+-record(ir_Contained, {ir_Internal_ID, %[IRObject]
+ def_kind, %from IRObject
+ id,
+ name,
+ version,
+ defined_in,
+ absolute_name,
+ containing_repository}).
+
+ % Container, page 6-10
+-record(ir_Container, {ir_Internal_ID, %[IRObject]
+ def_kind, %from IRObject
+ contents}).
+
+ % IDLType, page 6-15
+-record(ir_IDLType, {ir_Internal_ID, %[IRObject]
+ def_kind, %from IRObject
+ type}).
+
+ % Repository, page 6-16
+-record(ir_Repository, {ir_Internal_ID, %[Container]
+ def_kind, %from IRObject
+ contents, %from Container
+ primitivedefs}).
+
+ % ModuleDef, page 6-17
+-record(ir_ModuleDef, {ir_Internal_ID, %[Container,Contained]
+ def_kind, %from IRObject
+ contents, %from Container
+ id, %from Contained
+ name, %from Contained
+ version, %from Contained
+ defined_in, %from Contained
+ absolute_name, %from Contained
+ containing_repository %from Contained
+ }).
+
+ % ConstantDef, page 6-17
+-record(ir_ConstantDef, {ir_Internal_ID, %[Contained]
+ def_kind, %from IRObject
+ id, %from Contained
+ name, %from Contained
+ version, %from Contained
+ defined_in, %from Contained
+ absolute_name, %from Contained
+ containing_repository, %from Contained
+ type,
+ type_def,
+ value}).
+
+ % TypedefDef, page 6-18
+-record(ir_TypedefDef, {ir_Internal_ID, %[Contained,IDLType]
+ def_kind, %from IRObject
+ id, %from Contained
+ name, %from Contained
+ version, %from Contained
+ defined_in, %from Contained
+ absolute_name, %from Contained
+ containing_repository, %from Contained
+ type %from IDLType
+ }).
+
+ % StructDef, page 6-19
+-record(ir_StructDef, {ir_Internal_ID, %[TypedefDef]
+ def_kind, %from IRObject
+ id, %from Contained
+ name, %from Contained
+ version, %from Contained
+ defined_in, %from Contained
+ absolute_name, %from Contained
+ containing_repository, %from Contained
+ type, %from IDLType
+ members}).
+
+ % UnionDef, page 6-19
+-record(ir_UnionDef, {ir_Internal_ID, %[TypedefDef]
+ def_kind, %from IRObject
+ id, %from Contained
+ name, %from Contained
+ version, %from Contained
+ defined_in, %from Contained
+ absolute_name, %from Contained
+ containing_repository, %from Contained
+ type, %from IDLType
+ discriminator_type,
+ discriminator_type_def,
+ members}).
+
+ % EnumDef, page 6-20
+-record(ir_EnumDef, {ir_Internal_ID, %[TypedefDef]
+ def_kind, %from IRObject
+ id, %from Contained
+ name, %from Contained
+ version, %from Contained
+ defined_in, %from Contained
+ absolute_name, %from Contained
+ containing_repository, %from Contained
+ type, %from IDLType
+ members}).
+
+ % AliasDef, page 6-21
+-record(ir_AliasDef, {ir_Internal_ID, %[TypedefDef]
+ def_kind, %from IRObject
+ id, %from Contained
+ name, %from Contained
+ version, %from Contained
+ defined_in, %from Contained
+ absolute_name, %from Contained
+ containing_repository, %from Contained
+ type, %from IDLType
+ original_type_def}).
+
+ % PrimitiveDef, page 6-21
+-record(ir_PrimitiveDef, {ir_Internal_ID, %[IDLType]
+ def_kind, %from IRObject
+ type, %from IDLType
+ kind}).
+
+ % StringDef, page 6-22
+-record(ir_StringDef, {ir_Internal_ID, %[IDLType]
+ def_kind, %from IRObject
+ type, %from IDLType
+ bound}).
+
+-record(ir_WstringDef, {ir_Internal_ID, %[IDLType]
+ def_kind, %from IRObject
+ type, %from IDLType
+ bound}).
+
+ % SequenceDef, page 6-22
+-record(ir_SequenceDef, {ir_Internal_ID, %[IDLType]
+ def_kind, %from IRObject
+ type, %from IDLType
+ bound,
+ element_type,
+ element_type_def}).
+
+ % ArrayDef, page 6-23
+-record(ir_ArrayDef, {ir_Internal_ID, %[IDLType]
+ def_kind, %from IRObject
+ type, %from IDLType
+ length,
+ element_type,
+ element_type_def}).
+
+ % ExceptionDef, page 6-23
+-record(ir_ExceptionDef, {ir_Internal_ID, %[Contained]
+ def_kind, %from IRObject
+ id, %from Contained
+ name, %from Contained
+ version, %from Contained
+ defined_in, %from Contained
+ absolute_name, %from Contained
+ containing_repository, %from Contained
+ type,
+ members}).
+
+ % AttributeDef, page 6-24
+-record(ir_AttributeDef, {ir_Internal_ID, %[Contained]
+ def_kind, %from IRObject
+ id, %from Contained
+ name, %from Contained
+ version, %from Contained
+ defined_in, %from Contained
+ absolute_name, %from Contained
+ containing_repository, %from Contained
+ type,
+ type_def,
+ mode}).
+
+ % OperationDef, page 6-25
+-record(ir_OperationDef, {ir_Internal_ID, %[Contained]
+ def_kind, %from IRObject
+ id, %from Contained
+ name, %from Contained
+ version, %from Contained
+ defined_in, %from Contained
+ absolute_name, %from Contained
+ containing_repository, %from Contained
+ result,
+ result_def,
+ params,
+ mode,
+ contexts,
+ exceptions}).
+
+ % InterfaceDef, page 6-27
+-record(ir_InterfaceDef, {ir_Internal_ID, %[Container,Contained,IDLType]
+ def_kind, %from IRObject
+ contents, %from Container
+ id, %from Contained
+ name, %from Contained
+ version, %from Contained
+ defined_in, %from Contained
+ absolute_name, %from Contained
+ containing_repository, %from Contained
+ type, %from IDLType
+ base_interfaces}).
+
+ % TypeCode, page 6-33
+
+-record(ir_FixedDef, {ir_Internal_ID, %[IDLType]
+ def_kind, %from IRObject
+ type, %from IDLType
+ digits,
+ scale}).
+
+
+% TypeCodes cannot be defined as records, since each type code has a
+% quite unique structure depending on the type. The old TypeCode
+% record definition is left here as a comment in case we want to
+% change back to the old style.
+
+%% ir_TypeCode does not have a field ir_Internal_ID. TypeCodes are
+%% never explicitly written to the database as separate DB-records.
+%% TypeCodes are stored as full records whenever they are used in an
+%% IFR-object.
+%%-record(ir_TypeCode, {kind,
+%% parameter_list}).
+
+ % ORB, page 6-39
+-record(ir_ORB, {ir_Internal_ID, % *** Do we need any attributes
+ dummy}). % for this table? ORB is a pseudo-
+ % object so perhaps the table is
+ % unnecessary?
+
+-record(orber_light_ifr, {id, %% IFR-id
+ module,
+ type,
+ base_id}).
+
+-define(IFR_ModuleDef, 0).
+-define(IFR_ConstantDef, 1).
+-define(IFR_StructDef, 2).
+-define(IFR_UnionDef, 3).
+-define(IFR_EnumDef, 4).
+-define(IFR_AliasDef, 5).
+-define(IFR_InterfaceDef, 6).
+-define(IFR_ExceptionDef, 7).
+
+
+%%%----------------------------------------------------------------------
+%%% 'ifr_object_list' is used by other modules. Do NOT remove or rename
+%%% this list!
+%%% An addition or deletion of a record above must be duplicated here in
+%%% this list and in the macro 'ifr_record_tuple_list' below.
+-define(ifr_object_list, [ir_ModuleDef,
+ ir_Contained,
+ ir_AttributeDef,
+ ir_Repository,
+ ir_OperationDef,
+ ir_InterfaceDef,
+ ir_TypedefDef,
+ ir_Container,
+ ir_EnumDef,
+ ir_UnionDef,
+ ir_StringDef,
+ ir_WstringDef,
+ ir_ORB,
+ ir_IDLType,
+ ir_ExceptionDef,
+ ir_IRObject,
+ ir_PrimitiveDef,
+ ir_ArrayDef,
+ ir_AliasDef,
+ ir_ConstantDef,
+ ir_StructDef,
+ ir_SequenceDef,
+ ir_FixedDef]).
+
+-define(ifr_light_object_list, [orber_light_ifr]).
+
+-define(cr_fun_tuple(Table, Options),
+ {Table,
+ fun() ->
+ case mnesia:create_table(Table,[{attributes,
+ record_info(fields,
+ Table)}]++Options)of
+ {atomic,ok} ->
+ ok;
+ R ->
+ R
+ end
+ end}
+ ).
+
+-define(cr_fun_tuple_local(Table, IFR_storage_type),
+ {Table,
+ fun() ->
+ case mnesia:add_table_copy(Table,node(), IFR_storage_type)of
+ {atomic,ok} ->
+ ok;
+ R ->
+ R
+ end
+ end}
+ ).
+
+-define(ifr_record_tuple_list(Options),
+ [?cr_fun_tuple(ir_IRObject, Options),
+ ?cr_fun_tuple(ir_Contained, [{index, [#ir_Contained.id]}|Options]),
+ ?cr_fun_tuple(ir_Container, Options),
+ ?cr_fun_tuple(ir_IDLType, Options),
+ ?cr_fun_tuple(ir_Repository, Options),
+ ?cr_fun_tuple(ir_ModuleDef, [{index, [#ir_ModuleDef.id]}|Options]),
+ ?cr_fun_tuple(ir_ConstantDef, [{index, [#ir_ConstantDef.id]}|Options]),
+ ?cr_fun_tuple(ir_TypedefDef, [{index, [#ir_TypedefDef.id]}|Options]),
+ ?cr_fun_tuple(ir_StructDef, [{index, [#ir_StructDef.id]}|Options]),
+ ?cr_fun_tuple(ir_UnionDef, [{index, [#ir_UnionDef.id]}|Options]),
+ ?cr_fun_tuple(ir_EnumDef, [{index, [#ir_EnumDef.id]}|Options]),
+ ?cr_fun_tuple(ir_AliasDef, [{index, [#ir_AliasDef.id]}|Options]),
+ ?cr_fun_tuple(ir_PrimitiveDef, Options),
+ ?cr_fun_tuple(ir_StringDef, Options),
+ ?cr_fun_tuple(ir_WstringDef, Options),
+ ?cr_fun_tuple(ir_SequenceDef, Options),
+ ?cr_fun_tuple(ir_ArrayDef, Options),
+ ?cr_fun_tuple(ir_ExceptionDef, [{index, [#ir_ExceptionDef.id]}|Options]),
+ ?cr_fun_tuple(ir_AttributeDef, [{index, [#ir_AttributeDef.id]}|Options]),
+ ?cr_fun_tuple(ir_OperationDef, [{index, [#ir_OperationDef.id]}|Options]),
+ ?cr_fun_tuple(ir_InterfaceDef, [{index, [#ir_InterfaceDef.id]}| Options]),
+% ?cr_fun_tuple(ir_TypeCode, Options),
+ ?cr_fun_tuple(ir_ORB, Options),
+ ?cr_fun_tuple(ir_FixedDef, Options)]).
+
+-define(ifr_light_record_tuple_list(Options),
+ [?cr_fun_tuple(orber_light_ifr, Options)]).
+
+
+-define(ifr_record_tuple_list_local(IFR_storage_type),
+ [?cr_fun_tuple_local(ir_IRObject, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_Contained, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_Container, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_IDLType, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_Repository, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_ModuleDef, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_ConstantDef, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_TypedefDef, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_StructDef, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_UnionDef, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_EnumDef, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_AliasDef, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_PrimitiveDef, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_StringDef, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_WstringDef, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_SequenceDef, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_ArrayDef, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_ExceptionDef, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_AttributeDef, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_OperationDef, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_InterfaceDef, IFR_storage_type),
+% ?cr_fun_tuple_local(ir_TypeCode, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_ORB, IFR_storage_type),
+ ?cr_fun_tuple_local(ir_FixedDef, IFR_storage_type)]).
+
+-define(ifr_light_record_tuple_list_local(IFR_storage_type),
+ [?cr_fun_tuple_local(orber_light_ifr, IFR_storage_type)]).
diff --git a/lib/orber/src/iop_ior.erl b/lib/orber/src/iop_ior.erl
new file mode 100644
index 0000000000..5bfc31e0e4
--- /dev/null
+++ b/lib/orber/src/iop_ior.erl
@@ -0,0 +1,1716 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: iop_ior.erl
+%% Description:
+%% This file contains the IOP::IOR handling
+%%
+%%-----------------------------------------------------------------
+-module(iop_ior).
+
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/src/orber_iiop.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([code/4, decode/4, string_decode/1,
+ string_code/1, string_code/2, string_code/3, string_code/4,
+ get_key/1, get_key/2, get_typeID/1, create/9,
+ get_objkey/1, check_nil/1, get_privfield/1, set_privfield/2,
+ get_orbfield/1, set_orbfield/2,
+ get_flagfield/1, set_flagfield/2,
+ create_external/5, create_external/6, print/1, print/2,
+ get_alt_addr/1, add_component/2, get_peerdata/1]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+
+%%-----------------------------------------------------------------
+%% Macros
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 6).
+
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: create/5/6
+%%-----------------------------------------------------------------
+%% There are a few restrictions if a certain IIOP-version may contain certain components
+%% and contexts The ones we currently, and the ones we perhaps will, support is:
+%%
+%% Feature 1.0 1.1 1.2
+%% TransactionService Service Context yes yes yes
+%% CodeSets Service Context yes yes
+%% Object by Value Service Context yes
+%% Bi-Directional IIOP Service Context yes
+%% IOR components in IIOP profile yes yes
+%% TAG_ORB_TYPE yes yes
+%% TAG_CODE_SETS yes yes
+%% TAG_ALTERNATE_IIOP_ADDRESS yes
+%% TAG_SSL_SEC_TRANS yes yes
+%% Extended IDL data types yes yes
+%% Bi-Directional GIOP Features yes
+%% Value types and Abstract Interfaces yes
+%%
+%% CSIv2:
+%% A target that supports unprotected IIOP invocations shall specify in the
+%% corresponding TAG_INTERNET_IOP profile a nonzero port number at which the
+%% target will accept unprotected invocations.9 A target that supports only
+%% protected IIOP invocations shall specify a port number of 0 (zero) in the
+%% corresponding TAG_INTERNET_IOP profile.
+%%-----------------------------------------------------------------
+create({1, 0}, TypeID, Hosts, IIOPPort, _, Objkey, _, _, _) ->
+ Template = #'IIOP_ProfileBody_1_0'{iiop_version =
+ #'IIOP_Version'{major=1, minor=0},
+ port = IIOPPort,
+ object_key = Objkey},
+ #'IOP_IOR'{type_id=TypeID,
+ profiles=duplicate_1_0_profiles(Hosts, Template, [])};
+create({1, Minor}, TypeID, Hosts, IIOPPort, -1, Objkey, MC, _, _) ->
+ Template = #'IIOP_ProfileBody_1_1'{iiop_version =
+ #'IIOP_Version'{major=1, minor=Minor},
+ port = IIOPPort,
+ object_key = Objkey,
+ components = MC},
+ #'IOP_IOR'{type_id=TypeID,
+ profiles=duplicate_1_1_profiles(Hosts, Template, [])};
+
+create({1, Minor}, TypeID, Hosts, IIOPPort, SSLPort, Objkey, MC, Flags, EnvFlags) ->
+ V=#'IIOP_Version'{major=1, minor=Minor},
+ UseCSIv2 = ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_USE_CSIV2),
+ Template =
+ case ?ORB_FLAG_TEST(Flags, ?ORB_NO_SECURITY) of
+ true ->
+ #'IIOP_ProfileBody_1_1'{iiop_version = V,
+ port = IIOPPort,
+ object_key = Objkey,
+ components = MC};
+ false when UseCSIv2 == false ->
+ #'IIOP_ProfileBody_1_1'{iiop_version=V,
+ port=IIOPPort,
+ object_key=Objkey,
+ components= [#'IOP_TaggedComponent'
+ {tag=?TAG_SSL_SEC_TRANS,
+ component_data=#'SSLIOP_SSL'{target_supports = 2,
+ target_requires = 2,
+ port = SSLPort}}|MC]};
+ false when UseCSIv2 == true ->
+ #'IIOP_ProfileBody_1_1'
+ {iiop_version=V,
+ port=0,
+ object_key=Objkey,
+ components= [#'IOP_TaggedComponent'
+ {tag = ?TAG_CSI_SEC_MECH_LIST,
+ component_data =
+ #'CSIIOP_CompoundSecMechList'
+ {stateful = false,
+ mechanism_list =
+ [#'CSIIOP_CompoundSecMech'
+ {target_requires = 6,
+ transport_mech =
+ #'IOP_TaggedComponent'
+ {tag=?TAG_TLS_SEC_TRANS,
+ component_data=#'CSIIOP_TLS_SEC_TRANS'
+ {target_supports = 7,
+ target_requires = 8,
+ addresses =
+ [#'CSIIOP_TransportAddress'{host_name = "Host",
+ port = SSLPort}]}},
+ as_context_mech =
+ #'CSIIOP_AS_ContextSec'
+ {target_supports = 9, target_requires = 10,
+ client_authentication_mech = [1, 255],
+ target_name = [2,255]},
+ sas_context_mech =
+ #'CSIIOP_SAS_ContextSec'
+ {target_supports = 11, target_requires = 12,
+ privilege_authorities =
+ [#'CSIIOP_ServiceConfiguration'
+ {syntax = ?ULONGMAX,
+ name = [3,255]}],
+ supported_naming_mechanisms = [[4,255],[5,255]],
+ supported_identity_types = ?ULONGMAX}}]}}|MC]}
+ end,
+ #'IOP_IOR'{type_id=TypeID,
+ profiles=duplicate_1_1_profiles(Hosts, Template, [])};
+create(Version, TypeID, Host, IIOPPort, SSLPort, Objkey, MC, _, _) ->
+ orber:dbg("[~p] iop_ior:create(~p, ~p, ~p, ~p, ~p, ~p, ~p);~n"
+ "Unsupported IIOP-version.",
+ [?LINE, Version, TypeID, Host, IIOPPort, SSLPort, Objkey, MC],
+ ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
+
+
+
+
+duplicate_1_1_profiles([], _, Profiles) ->
+ Profiles;
+duplicate_1_1_profiles([H|T], Template, Profiles) ->
+ duplicate_1_1_profiles(T, Template,
+ [#'IOP_TaggedProfile'
+ {tag=?TAG_INTERNET_IOP,
+ profile_data =
+ Template#'IIOP_ProfileBody_1_1'{host = H}}|Profiles]).
+
+duplicate_1_0_profiles([], _, Profiles) ->
+ Profiles;
+duplicate_1_0_profiles([H|T], Template, Profiles) ->
+ duplicate_1_0_profiles(T, Template,
+ [#'IOP_TaggedProfile'
+ {tag=?TAG_INTERNET_IOP,
+ profile_data =
+ Template#'IIOP_ProfileBody_1_0'{host = H}}|Profiles]).
+
+
+%%-----------------------------------------------------------------
+%% Func: create_external/5/6
+%%-----------------------------------------------------------------
+create_external(Version, TypeID, Host, IIOP_port, Objkey) ->
+ create_external(Version, TypeID, Host, IIOP_port, Objkey, []).
+create_external({1, 0}, TypeID, Host, IIOP_port, Objkey, _MC) ->
+ V=#'IIOP_Version'{major=1,
+ minor=0},
+ PB=#'IIOP_ProfileBody_1_0'{iiop_version=V,
+ host=Host,
+ port=IIOP_port,
+ object_key=Objkey},
+ #'IOP_IOR'{type_id=TypeID, profiles=[#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
+ profile_data=PB}]};
+create_external({1, 1}, TypeID, Host, IIOP_port, Objkey, Components) ->
+ V=#'IIOP_Version'{major=1,
+ minor=1},
+ PB=#'IIOP_ProfileBody_1_1'{iiop_version=V,
+ host=Host,
+ port=IIOP_port,
+ object_key=Objkey,
+ components=Components},
+ #'IOP_IOR'{type_id=TypeID,
+ profiles=[#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
+ profile_data=PB}]};
+create_external({1, 2}, TypeID, Host, IIOP_port, Objkey, Components) ->
+ V=#'IIOP_Version'{major=1,
+ minor=2},
+ PB=#'IIOP_ProfileBody_1_1'{iiop_version=V,
+ host=Host,
+ port=IIOP_port,
+ object_key=Objkey,
+ components=Components},
+ #'IOP_IOR'{type_id=TypeID,
+ profiles=[#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
+ profile_data=PB}]};
+create_external(Version, TypeID, Host, IIOP_port, Objkey, MC) ->
+ orber:dbg("[~p] iop_ior:create_external(~p, ~p, ~p, ~p, ~p, ~p);~n"
+ "Unsupported IIOP-version.",
+ [?LINE, Version, TypeID, Host, IIOP_port, Objkey, MC], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
+
+%%-----------------------------------------------------------------
+%% Func: get_peerdata/1
+%%-----------------------------------------------------------------
+%% Probably an external IOR.
+get_peerdata(#'IOP_IOR'{} = IOR) ->
+ get_peerdata(get_key(IOR), IOR, [], []);
+%% Local object reference.
+get_peerdata(_) ->
+ [].
+
+%% "Plain" TCP/IP.
+get_peerdata({'external', {Host, Port, _InitObjkey, Index, TaggedProfile,
+ #host_data{protocol = normal,
+ csiv2_mech = undefined}}},
+ IOR, Acc, Indexes) ->
+ Alts = get_alt_addr(TaggedProfile),
+ get_peerdata(get_key(IOR, [Index|Indexes]), IOR, [{Host, Port}|Alts] ++ Acc,
+ [Index|Indexes]);
+%% "Plain" SSL
+get_peerdata({'external', {Host, _Port, _InitObjkey, Index, TaggedProfile,
+ #host_data{protocol = ssl,
+ ssl_data = #'SSLIOP_SSL'{port = Port},
+ csiv2_mech = undefined}}},
+ IOR, Acc, Indexes) ->
+ Alts = get_alt_addr(TaggedProfile),
+ get_peerdata(get_key(IOR, [Index|Indexes]), IOR, [{Host, Port}|Alts] ++ Acc,
+ [Index|Indexes]);
+%% TEMPORARY FIX TO SKIP CSIv2 DATA.
+get_peerdata({'external', {Host, _Port, _InitObjkey, Index, TaggedProfile,
+ #host_data{protocol = ssl,
+ ssl_data = #'SSLIOP_SSL'{port = Port}}}},
+ IOR, Acc, Indexes) ->
+ Alts = get_alt_addr(TaggedProfile),
+ get_peerdata(get_key(IOR, [Index|Indexes]), IOR, [{Host, Port}|Alts] ++ Acc,
+ [Index|Indexes]);
+%% CSIv2 over SSL (TAG_TLS_SEC_TRANS) using the SAS protocol. Note port must equal 0.
+get_peerdata({'external',
+ {_Host, 0, _InitObjkey, Index, TaggedProfile,
+ #host_data{protocol = ssl,
+ csiv2_mech =
+ #'CSIIOP_CompoundSecMech'{target_requires = _TR} = _Mech,
+ csiv2_addresses = Addresses}}},
+ IOR, Acc, Indexes) ->
+ Alts = get_alt_addr(TaggedProfile),
+ get_peerdata(get_key(IOR, [Index|Indexes]), IOR, Addresses ++ Alts ++ Acc,
+ [Index|Indexes]);
+%% CSIv2 over SSL (TAG_NULL_TAG) using the SAS protocol.
+get_peerdata({'external',
+ {Host, _Port, _InitObjkey, Index, TaggedProfile,
+ #host_data{protocol = ssl,
+ ssl_data = #'SSLIOP_SSL'{port = Port},
+ csiv2_mech = Mech}}},
+ IOR, Acc, Indexes) when is_record(Mech, 'CSIIOP_CompoundSecMech') ->
+ Alts = get_alt_addr(TaggedProfile),
+ get_peerdata(get_key(IOR, [Index|Indexes]), IOR, [{Host, Port}|Alts] ++ Acc,
+ [Index|Indexes]);
+%% CSIv2 over TCP (TAG_NULL_TAG) using the SAS protocol.
+get_peerdata({'external',
+ {Host, Port, _InitObjkey, Index, TaggedProfile,
+ #host_data{protocol = normal,
+ csiv2_mech = Mech}}},
+ IOR, Acc, Indexes) when is_record(Mech, 'CSIIOP_CompoundSecMech') ->
+ Alts = get_alt_addr(TaggedProfile),
+ get_peerdata(get_key(IOR, [Index|Indexes]), IOR, [{Host, Port}|Alts] ++ Acc,
+ [Index|Indexes]);
+get_peerdata(undefined, _IOR, Acc, _Indexes) ->
+ Acc;
+%% Local object reference.
+get_peerdata(_, _, _, _) ->
+ [].
+
+%%-----------------------------------------------------------------
+%% Func: get_key/1
+%%-----------------------------------------------------------------
+get_key(#'IOP_IOR'{profiles=P}) ->
+ get_key_1(P, false, 0, undefined, #host_data{});
+get_key({Module, Type, Key, _UserDef, OrberDef, Flags}) ->
+ if
+ is_binary(Key) ->
+ {'internal', Key, OrberDef, Flags, Module};
+ Type == pseudo ->
+ {'internal_registered', {pseudo, Key}, OrberDef, Flags, Module};
+ is_atom(Key) ->
+ {'internal_registered', Key, OrberDef, Flags, Module}
+ end;
+get_key(What) ->
+ orber:dbg("[~p] iop_ior:get_key(~p); Invalid IOR",
+ [?LINE, What], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
+
+
+get_key(#'IOP_IOR'{profiles=P}, Exclude) ->
+ get_key_1(P, true, 0, Exclude, #host_data{});
+get_key(What, _Exclude) ->
+ orber:dbg("[~p] iop_ior:get_key(~p); Invalid IOR",
+ [?LINE, What], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
+
+
+get_key_1([], false, _, _, _) ->
+ orber:dbg("[~p] iop_ior:get_key_1([]); bad object reference, profile not found.",
+ [?LINE], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
+get_key_1([], true, _, _, _) ->
+ undefined;
+%%--------- Local IIOP-1.0 Profile ---------
+get_key_1([#'IOP_TaggedProfile'
+ {tag=?TAG_INTERNET_IOP,
+ profile_data=#'IIOP_ProfileBody_1_0'
+ {object_key={Module, Type, Key, _UserDef, OrberDef, Flags}}}|_],
+ _Retry, _Counter, _Exclude, _HD) ->
+ if
+ is_binary(Key) ->
+ {'internal', Key, OrberDef, Flags, Module};
+ Type == pseudo ->
+ {'internal_registered', {pseudo, Key}, OrberDef, Flags, Module};
+ is_atom(Key) ->
+ {'internal_registered', Key, OrberDef, Flags, Module}
+ end;
+%%--------- Local IIOP-1.1 & IIOP-1.2 Profiles ---------
+get_key_1([#'IOP_TaggedProfile'
+ {tag=?TAG_INTERNET_IOP,
+ profile_data=#'IIOP_ProfileBody_1_1'
+ {object_key={Module, Type, Key, _UserDef, OrberDef, Flags}}}|_],
+ _Retry, _Counter, _Exclude, _HD) ->
+ if
+ is_binary(Key) ->
+ {'internal', Key, OrberDef, Flags, Module};
+ Type == pseudo ->
+ {'internal_registered', {pseudo, Key}, OrberDef, Flags, Module};
+ Type == passive ->
+ %% CHECK FOR PRIMARY COMPONENT & GROUPID! Better yet, do not.
+ %% This is internal key and is supposed to be well formed.
+ %% Also, internal keys are not searched for primary member or
+ %% groupid in the component-section of IOR. ObjectKey will tell
+ %% GroupID and database read transaction will tell primary member.
+ {'internal_registered', {passive, Key}, OrberDef, Flags, Module};
+ is_atom(Key) ->
+ {'internal_registered', Key, OrberDef, Flags, Module}
+ end;
+%%--------- External IIOP-1.0 Profile ---------
+get_key_1([#'IOP_TaggedProfile'
+ {tag=?TAG_INTERNET_IOP,
+ profile_data=#'IIOP_ProfileBody_1_0'
+ {host = Host, port = Port, object_key= ObjectKey}} = TP|P],
+ _Retry, Counter, Exclude, HD) when Exclude == undefined ->
+ %% This case is "necessary" if an ORB adds several IIOP-profiles since,
+ %% for example, wchar isn't supported for 1.0.
+ case get_key_1(P, true, Counter+1, Exclude, HD) of
+ undefined ->
+ %% We now it's IIOP-1.0 and it doesn't contain any
+ %% components. Hence, no need to check for it.
+ {'external', {Host, Port, ObjectKey, Counter, TP,
+ HD#host_data{version = {1,0}}}};
+ LaterVersion ->
+ LaterVersion
+ end;
+get_key_1([#'IOP_TaggedProfile'
+ {tag=?TAG_INTERNET_IOP,
+ profile_data=#'IIOP_ProfileBody_1_0'
+ {host = Host, port = Port, object_key= ObjectKey}} = TP|P],
+ Retry, Counter, Exclude, HD) ->
+ case lists:member(Counter, Exclude) of
+ true ->
+ get_key_1(P, Retry, Counter+1, Exclude, HD);
+ false ->
+ %% This case is "necessary" if an ORB adds several IIOP-profiles since,
+ %% for example, wchar isn't supported for 1.0.
+ case get_key_1(P, true, Counter+1, Exclude, HD) of
+ undefined ->
+ {'external', {Host, Port, ObjectKey, Counter, TP,
+ HD#host_data{version = {1,0}}}};
+ LaterVersion ->
+ LaterVersion
+ end
+ end;
+%%--------- External IIOP-1.1 & IIOP-1.2 Profiles ---------
+get_key_1([#'IOP_TaggedProfile'
+ {tag=?TAG_INTERNET_IOP,
+ profile_data=#'IIOP_ProfileBody_1_1'
+ {iiop_version = #'IIOP_Version'{major=Major, minor=Minor},
+ host = Host, port = Port, object_key= ObjectKey,
+ components = Components}} = TP|P],
+ Retry, Counter, Exclude, HD) when Exclude == undefined ->
+ case check_components(Components, Port, HD#host_data{version = {Major,Minor}}) of
+ #host_data{csiv2_mech = undefined} when Port == 0 ->
+ get_key_1(P, Retry, Counter+1, Exclude, HD);
+ NewHD ->
+ {'external', {Host, Port, ObjectKey, Counter, TP, NewHD}}
+ end;
+get_key_1([#'IOP_TaggedProfile'
+ {tag=?TAG_INTERNET_IOP,
+ profile_data=#'IIOP_ProfileBody_1_1'
+ {iiop_version = #'IIOP_Version'{major=Major, minor=Minor},
+ host = Host, port = Port, object_key= ObjectKey,
+ components = Components}} = TP|P],
+ Retry, Counter, Exclude, HD) ->
+ case lists:member(Counter, Exclude) of
+ true ->
+ get_key_1(P, Retry, Counter+1, Exclude, HD);
+ false ->
+ case check_components(Components, Port,
+ HD#host_data{version = {Major,Minor}}) of
+ #host_data{csiv2_mech = undefined} when Port == 0 ->
+ get_key_1(P, Retry, Counter+1, Exclude, HD);
+ NewHD ->
+ {'external', {Host, Port, ObjectKey, Counter, TP, NewHD}}
+ end
+ end;
+get_key_1([_ | P], Retry, Counter, Exclude, HD) ->
+ get_key_1(P, Retry, Counter+1, Exclude, HD).
+
+check_components([], _, HostData) ->
+ HostData;
+check_components([#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
+ component_data=SSLStruct}|Rest],
+ Port, HostData) when is_record(SSLStruct, 'SSLIOP_SSL') ->
+ check_components(Rest, Port, HostData#host_data{protocol = ssl,
+ ssl_data = SSLStruct});
+%% CSIv2 Components
+check_components([#'IOP_TaggedComponent'{tag=?TAG_CSI_SEC_MECH_LIST,
+ component_data=Data}|Rest],
+ Port, HostData) when is_record(Data, 'CSIIOP_CompoundSecMechList') ->
+ case check_sec_mech(Data#'CSIIOP_CompoundSecMechList'.mechanism_list, Port) of
+ undefined ->
+ check_components(Rest, Port, HostData);
+ {ok, Protocol, Mech, Addresses} ->
+ check_components(Rest, Port,
+ HostData#host_data
+ {protocol = Protocol,
+ csiv2_mech = Mech,
+ csiv2_statefull = Data#'CSIIOP_CompoundSecMechList'.stateful,
+ csiv2_addresses = Addresses});
+ {ok, Mech} ->
+ check_components(Rest, Port,
+ HostData#host_data
+ {csiv2_mech = Mech,
+ csiv2_statefull = Data#'CSIIOP_CompoundSecMechList'.stateful})
+ end;
+%% FT Components
+check_components([#'IOP_TaggedComponent'
+ {tag=?TAG_FT_HEARTBEAT_ENABLED,
+ component_data=
+ #'FT_TagFTHeartbeatEnabledTaggedComponent'
+ {heartbeat_enabled = Boolean}}|Rest],
+ Port, HostData) ->
+ check_components(Rest, Port, HostData#host_data{ft_heartbeat = Boolean});
+check_components([#'IOP_TaggedComponent'
+ {tag=?TAG_FT_PRIMARY,
+ component_data=
+ #'FT_TagFTPrimaryTaggedComponent'{primary = Boolean}}|Rest],
+ Port, HostData) ->
+ check_components(Rest, Port, HostData#host_data{ft_primary = Boolean});
+check_components([#'IOP_TaggedComponent'
+ {tag=?TAG_FT_GROUP,
+ component_data=#'FT_TagFTGroupTaggedComponent'
+ {version = #'GIOP_Version'{major = 1, minor = 0},
+ ft_domain_id = FTDomain,
+ object_group_id = GroupID,
+ object_group_ref_version = GroupVer}}|Rest],
+ Port, HostData) ->
+ check_components(Rest, Port, HostData#host_data{ft_domain = FTDomain,
+ ft_group = GroupID,
+ ft_ref_version = GroupVer});
+%% CodeSets Component
+check_components([#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
+ component_data=#'CONV_FRAME_CodeSetComponentInfo'
+ {'ForCharData' = Char,
+ 'ForWcharData' = Wchar}}|Rest],
+ Port, HostData) ->
+ CharData = check_char_codeset(Char),
+ WcharData = check_wchar_codeset(Wchar),
+ check_components(Rest, Port, HostData#host_data{charset = CharData,
+ wcharset = WcharData});
+%% Not used
+check_components([_ | Rest], Port, HostData) ->
+ check_components(Rest, Port, HostData).
+
+check_sec_mech([], _) ->
+ undefined;
+%% Not supported yet.
+%check_sec_mech([#'CSIIOP_CompoundSecMech'
+% {target_requires = TR,
+% transport_mech=
+% #'IOP_TaggedComponent'{tag=?TAG_SECIOP_SEC_TRANS}} = Mech|_],
+% Port) ->
+% {ok, seciop, Mech};
+check_sec_mech([#'CSIIOP_CompoundSecMech'
+ {target_requires = TR,
+ transport_mech=
+ #'IOP_TaggedComponent'{tag = ?TAG_TLS_SEC_TRANS,
+ component_data = CD}} = Mech|_], _Port)
+ when TR =< ?CSIv2_MAX_TARGET_REQUIRES ->
+ {ok, ssl, Mech, extract_host_port(CD#'CSIIOP_TLS_SEC_TRANS'.addresses, [])};
+%% The TAG_NULL_TAG component shall be used in the 'transport_mech' field to
+%% indicate that a mechanism does not implement security functionality at the
+%% transport layer.
+%% If the port field in TAG_INTERNET_IOP equals 0 we must find a TAG_TLS_SEC_TRANS
+%% or TAG_SECIOP_SEC_TRANS mechanism.
+check_sec_mech([#'CSIIOP_CompoundSecMech'
+ {transport_mech=
+ #'IOP_TaggedComponent'{tag = ?TAG_NULL_TAG}}|Rest], 0) ->
+ check_sec_mech(Rest, 0);
+check_sec_mech([#'CSIIOP_CompoundSecMech'
+ {target_requires = TR,
+ transport_mech=
+ #'IOP_TaggedComponent'{tag = ?TAG_NULL_TAG}} = Mech|_], _Port)
+ when TR =< ?CSIv2_MAX_TARGET_REQUIRES ->
+ {ok, Mech};
+%% Unrecognized or the peer requires more than we support.
+check_sec_mech([_ | Rest], Port) ->
+ check_sec_mech(Rest, Port).
+
+extract_host_port([], Acc) ->
+ Acc;
+extract_host_port([#'CSIIOP_TransportAddress'{host_name = Host,
+ port = Port}|Rest], Acc) ->
+ extract_host_port(Rest, [{Host, Port}|Acc]).
+
+
+check_char_codeset(#'CONV_FRAME_CodeSetComponent'{native_code_set=?ISO8859_1_ID}) ->
+ ?ISO8859_1_ID;
+check_char_codeset(#'CONV_FRAME_CodeSetComponent'{native_code_set=?ISO646_IRV_ID}) ->
+ ?ISO646_IRV_ID;
+check_char_codeset(#'CONV_FRAME_CodeSetComponent'{conversion_code_sets=Converters}) ->
+ %% Since the list of Converters usually is very short (0 or 1 element) we
+ %% can use lists:member.
+ case lists:member(?ISO8859_1_ID, Converters) of
+ true ->
+ ?ISO8859_1_ID;
+ false ->
+ %% Since we are 100% sure strings will be (e.g. IFR-ids) used we
+ %% can raise an exception at this point.
+ orber:dbg("[~p] iop_ior:check_char_codeset(~p);~n"
+ "Orber cannot communicate with this ORB.~n"
+ "It doesn't support a Char CodeSet known to Orber.",
+ [?LINE, Converters], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status = ?COMPLETED_NO})
+ end.
+
+check_wchar_codeset(#'CONV_FRAME_CodeSetComponent'{native_code_set=?UTF_16_ID}) ->
+ ?UTF_16_ID;
+check_wchar_codeset(#'CONV_FRAME_CodeSetComponent'{native_code_set=?UCS_2_ID}) ->
+ ?UCS_2_ID;
+check_wchar_codeset(#'CONV_FRAME_CodeSetComponent'{conversion_code_sets=Converters}) ->
+ case lists:member(?UTF_16_ID, Converters) of
+ true ->
+ ?UTF_16_ID;
+ false ->
+ %% We should not raise an exception here since we do not know if
+ %% wchar/wstring is used.
+ ?UTF_16_ID
+% ?UNSUPPORTED_WCHAR
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Func: add_component/2
+%%-----------------------------------------------------------------
+add_component(Objref, Component) when is_record(Objref, 'IOP_IOR') ->
+ add_component_ior(Objref, Component);
+add_component(Objref, Component) ->
+ add_component_local(Objref, Component, orber:giop_version()).
+
+add_component_local(_, Component, {1,0}) ->
+ orber:dbg("[~p] iop_ior:add_component(~p);~n"
+ "IIOP-1.0 objects cannot contain any components.",
+ [?LINE, Component], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO});
+add_component_local(_, #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS}
+ = Component, {1,1}) ->
+ orber:dbg("[~p] iop_ior:add_component(~p);~n"
+ "IIOP-1.1 objects may not contain ALTERNATE_IIOP_ADDRESS components.",
+ [?LINE, Component], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO});
+add_component_local({Mod, Type, Key, UserDef, OrberDef, Flags}, Component, Version) ->
+ EnvFlags = orber:get_flags(),
+ MC = case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_EXCLUDE_CODESET_COMPONENT) of
+ true ->
+ [Component];
+ false ->
+ [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
+ component_data=?DEFAULT_CODESETS},
+ Component]
+ end,
+ case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_ENABLE_NAT) of
+ false ->
+ create(Version, Mod:typeID(), orber:host(), orber:iiop_port(),
+ orber:iiop_ssl_port(),
+ {Mod, Type, Key, UserDef, OrberDef, Flags},
+ MC, Flags, EnvFlags);
+ true ->
+ create(Version, Mod:typeID(), orber:nat_host(),
+ orber:nat_iiop_port(), orber:nat_iiop_ssl_port(),
+ {Mod, Type, Key, UserDef, OrberDef, Flags},
+ MC, Flags, EnvFlags)
+
+ end.
+
+add_component_ior(#'IOP_IOR'{profiles=P} = IOR, Component) ->
+ case add_component_ior_helper(P, Component, false, []) of
+ {false, _} ->
+ orber:dbg("[~p] iop_ior:add_component_ior(~p);~n"
+ "The IOR do not contain a valid IIOP-version for the supplied component.",
+ [?LINE, Component], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO});
+ {_, NewProfiles} ->
+ IOR#'IOP_IOR'{profiles=NewProfiles}
+ end.
+
+add_component_ior_helper([], _Component, Status, Acc) ->
+ {Status, Acc};
+add_component_ior_helper([#'IOP_TaggedProfile'
+ {tag=?TAG_INTERNET_IOP,
+ profile_data=#'IIOP_ProfileBody_1_1'
+ {iiop_version= #'IIOP_Version'{minor=1}}}|T],
+ #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS}
+ = Component, Status, Acc) ->
+ %% 'ALTERNATE_IIOP_ADDRESS' may only be added to IIOP-1.2 IOR's.
+ add_component_ior_helper(T, Component, Status, Acc);
+add_component_ior_helper([#'IOP_TaggedProfile'
+ {tag=?TAG_INTERNET_IOP,
+ profile_data=#'IIOP_ProfileBody_1_1'
+ {object_key=Objkey,
+ components=Components} = PB} = H|T],
+ Component, _Status, Acc) when is_tuple(Objkey) ->
+ %% The objectkey must be a tuple if it's a local object. We cannot(!!) add components
+ %% to an external IOR.
+ add_component_ior_helper(T, Component, true,
+ [H#'IOP_TaggedProfile'
+ {profile_data=PB#'IIOP_ProfileBody_1_1'
+ {components = [Component|Components]}}|Acc]);
+add_component_ior_helper([_|T], Component, Status, Acc) ->
+ add_component_ior_helper(T, Component, Status, Acc).
+
+%%-----------------------------------------------------------------
+%% Func: get_alt_addr/1
+%%-----------------------------------------------------------------
+%% TAG_ALTERNATE_IIOP_ADDRESS may only occur in IIOP-1.2 IOR's.
+get_alt_addr(#'IOP_TaggedProfile'
+ {tag=?TAG_INTERNET_IOP,
+ profile_data=#'IIOP_ProfileBody_1_1'{iiop_version=
+ #'IIOP_Version'{minor=2},
+ components=Components}}) ->
+ get_alt_addr_helper(Components, []);
+get_alt_addr(_) ->
+ [].
+
+get_alt_addr_helper([], Acc) -> Acc;
+get_alt_addr_helper([#'IOP_TaggedComponent'{tag=?TAG_ALTERNATE_IIOP_ADDRESS,
+ component_data=#'ALTERNATE_IIOP_ADDRESS'
+ {'HostID'=Host, 'Port'=Port}}|T], Acc) ->
+ get_alt_addr_helper(T, [{Host, Port}|Acc]);
+get_alt_addr_helper([_|T], Acc) ->
+ get_alt_addr_helper(T, Acc).
+
+%%-----------------------------------------------------------------
+%% Func: get_typeID/1
+%%-----------------------------------------------------------------
+get_typeID(#'IOP_IOR'{type_id=TypeID}) ->
+ TypeID;
+get_typeID({Mod, _Type, _Key, _UserDef, _OrberDef, _Flags}) ->
+ Mod:typeID().
+
+%%-----------------------------------------------------------------
+%% Func: get_objkey/1
+%%-----------------------------------------------------------------
+get_objkey(#'IOP_IOR'{profiles=P}) ->
+ get_objkey_1(P);
+get_objkey({Id, Type, Key, UserDef, OrberDef, Flags}) ->
+ {Id, Type, Key, UserDef, OrberDef, Flags}.
+
+get_objkey_1([]) ->
+ orber:dbg("[~p] iop_ior:get_objkey_1([]); bad object key, profile not found.",
+ [?LINE], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
+get_objkey_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB} |_]) ->
+ [_, _, _, _, ObjectKey | _] = tuple_to_list(PB),
+ ObjectKey;
+get_objkey_1([_ | P]) ->
+ get_objkey_1(P).
+
+%%-----------------------------------------------------------------
+%% Func: get_privfield/1
+%%-----------------------------------------------------------------
+get_privfield(#'IOP_IOR'{profiles=P}) ->
+ get_privfield_1(P);
+get_privfield({_Id, _Type, _Key, UserDef, _OrberDef, _Flags}) ->
+ UserDef.
+
+get_privfield_1([]) ->
+ orber:dbg("[~p] iop_ior:get_privfield_1([]); bad object key, profile not found.",
+ [?LINE], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
+get_privfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}|_]) ->
+ [_, _, _, _, ObjectKey | _] = tuple_to_list(PB),
+ case ObjectKey of
+ {_Id, _Type, _Key, UserDef, _OrberDef, _Flags} ->
+ UserDef;
+ _ ->
+ orber:dbg("[~p] iop_ior:get_privfield_1(~p); bad object key.",
+ [?LINE, ObjectKey], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
+ end;
+get_privfield_1([_| P]) ->
+ get_privfield_1(P).
+
+%%-----------------------------------------------------------------
+%% Func: set_privfield/2
+%%-----------------------------------------------------------------
+set_privfield(#'IOP_IOR'{type_id=Id, profiles=P}, UserData) ->
+ #'IOP_IOR'{type_id=Id, profiles=set_privfield_1(P, UserData)};
+set_privfield({Id, Type, Key, _, OrberDef, Flags}, UserData) ->
+ {Id, Type, Key, UserData, OrberDef, Flags}.
+
+set_privfield_1([], _) ->
+ orber:dbg("[~p] iop_ior:set_privfield_1([]); bad object key, profile not found or external object.",
+ [?LINE], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
+set_privfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}|P], UserData) ->
+ [RecName, Version, Host, IIOP_port, ObjectKey | Rest] = tuple_to_list(PB),
+ case ObjectKey of
+ {Id, Type, Key, _, OrberDef, Flags} ->
+ [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
+ profile_data=list_to_tuple([RecName,
+ Version, Host,
+ IIOP_port,
+ {Id, Type, Key, UserData, OrberDef, Flags}|
+ Rest])} |
+ set_privfield_1(P, UserData)];
+ _ ->
+ [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB} | set_privfield_1(P, UserData)]
+ end;
+set_privfield_1([PB| P], UserData) ->
+ [PB | set_privfield_1(P, UserData)].
+
+%%-----------------------------------------------------------------
+%% Func: get_orbfield/1
+%%-----------------------------------------------------------------
+get_orbfield(#'IOP_IOR'{profiles=P}) ->
+ get_orbfield_1(P);
+get_orbfield({_Id, _Type, _Key, _UserDef, OrberDef, _Flags}) ->
+ OrberDef.
+
+get_orbfield_1([]) ->
+ orber:dbg("[~p] iop_ior:get_orbfield_1([]);~n"
+ "bad object key, profile not found.", [?LINE], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
+get_orbfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}|_]) ->
+ [_, _, _, _, ObjectKey | _] = tuple_to_list(PB),
+ case ObjectKey of
+ {_Id, _Type, _Key, _UserDef, OrberDef, _Flags} ->
+ OrberDef;
+ _ ->
+ orber:dbg("[~p] iop_ior:get_orbfield_1(~p);~n"
+ "bad object key.", [?LINE, ObjectKey], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
+ end;
+get_orbfield_1([_| P]) ->
+ get_orbfield_1(P).
+
+%%-----------------------------------------------------------------
+%% Func: set_orbfield/2
+%%-----------------------------------------------------------------
+set_orbfield(#'IOP_IOR'{type_id=Id, profiles=P}, OrberDef) ->
+ #'IOP_IOR'{type_id=Id, profiles=set_orbfield_1(P, OrberDef)};
+set_orbfield({Id, Type, Key, Priv, _, Flags}, OrberDef) ->
+ {Id, Type, Key, Priv, OrberDef, Flags}.
+
+set_orbfield_1([], _) ->
+ orber:dbg("[~p] iop_ior:set_orbfield_1([]);~n"
+ "bad object key, profile not found or external object.",
+ [?LINE], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
+set_orbfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}| P], OrberDef) ->
+ [RecName, Version, Host, IIOP_port, ObjectKey | Rest] = tuple_to_list(PB),
+ case ObjectKey of
+ {Id, Type, Key, Priv, _, Flags} ->
+ [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
+ profile_data=list_to_tuple([RecName,
+ Version, Host,
+ IIOP_port,
+ {Id, Type, Key, Priv, OrberDef, Flags}|
+ Rest])} |
+ set_orbfield_1(P, OrberDef)];
+ _ ->
+ [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB} | set_orbfield_1(P, OrberDef)]
+ end;
+set_orbfield_1([PB| P], OrberDef) ->
+ [PB | set_orbfield_1(P, OrberDef)].
+
+%%-----------------------------------------------------------------
+%% Func: get_flagfield/1
+%%-----------------------------------------------------------------
+get_flagfield(#'IOP_IOR'{profiles=P}) ->
+ get_flagfield_1(P);
+get_flagfield({_Id, _Type, _Key, _UserDef, _OrberDef, Flags}) ->
+ Flags.
+
+get_flagfield_1([]) ->
+ orber:dbg("[~p] iop_ior:get_flagfield_1([]); bad object key, profile not found.",
+ [?LINE], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
+get_flagfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}|_]) ->
+ [_, _, _, _, ObjectKey | _] = tuple_to_list(PB),
+ case ObjectKey of
+ {_Id, _Type, _Key, _UserDef, _OrberDef, Flags} ->
+ Flags;
+ _ ->
+ orber:dbg("[~p] iop_ior:get_flagfield_1(~p); bad object key.",
+ [?LINE, ObjectKey], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
+ end;
+get_flagfield_1([_| P]) ->
+ get_flagfield_1(P).
+
+%%-----------------------------------------------------------------
+%% Func: set_flagfield/2
+%%-----------------------------------------------------------------
+set_flagfield(#'IOP_IOR'{type_id=Id, profiles=P}, Flags) ->
+ #'IOP_IOR'{type_id=Id, profiles=set_flagfield_1(P, Flags)};
+set_flagfield({Id, Type, Key, Priv, OrberDef, _}, Flags) ->
+ {Id, Type, Key, Priv, OrberDef, Flags}.
+
+set_flagfield_1([], _) ->
+ orber:dbg("[~p] iop_ior:set_flagfield_1([]); bad object key, profile not found or external object.",
+ [?LINE], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
+set_flagfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}| P], Flags) ->
+ [RecName, Version, Host, IIOP_port, ObjectKey | Rest] = tuple_to_list(PB),
+ case ObjectKey of
+ {Id, Type, Key, Priv, OrberDef, _} ->
+ [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
+ profile_data=list_to_tuple([RecName,
+ Version, Host,
+ IIOP_port,
+ {Id, Type, Key, Priv, OrberDef, Flags}|
+ Rest])} |
+ set_flagfield_1(P, Flags)];
+ _ ->
+ [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB} | set_flagfield_1(P, Flags)]
+ end;
+set_flagfield_1([PB| P], Flags) ->
+ [PB | set_flagfield_1(P, Flags)].
+
+%%-----------------------------------------------------------------
+%% Func: check_nil/1
+%%-----------------------------------------------------------------
+check_nil(#'IOP_IOR'{type_id="", profiles=[]}) ->
+ true;
+check_nil({Id, _, _, _, _, _}) when is_atom(Id) ->
+ false;
+check_nil({Id, _, _, _, _, _}) ->
+ case binary_to_list(Id) of
+ "" ->
+ true;
+ _ ->
+ false
+ end;
+check_nil(_) ->
+ false.
+
+
+
+%%----------------------------------------------------------------------
+%% Function : print
+%% Arguments : An object represented as one of the following:
+%% - local (tuple)
+%% - IOR
+%% - stringified IOR
+%% - corbaloc- or corbaname-schema
+%% IoDevice - the same as the io-module defines.
+%% Returns :
+%% Description: Prints the object's components.
+%%----------------------------------------------------------------------
+print(Object) ->
+ print(undefined, Object).
+print(IoDevice, #'IOP_IOR'{type_id="", profiles=[]}) ->
+ print_it(IoDevice,
+ "================== IOR ====================~n"
+ "NIL Object Reference.~n"
+ "================== END ====================~n");
+print(IoDevice, IORStr) when is_list(IORStr) ->
+ IOR = corba:string_to_object(IORStr),
+ print_helper(IoDevice, IOR);
+print(IoDevice, IOR) when is_record(IOR, 'IOP_IOR') ->
+ print_helper(IoDevice, IOR);
+print(IoDevice, {Mod, Type, Key, UserDef, OrberDef, Flags}) ->
+ EnvFlags = orber:get_flags(),
+ MC = case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_EXCLUDE_CODESET_COMPONENT) of
+ true ->
+ [];
+ false ->
+ [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
+ component_data=?DEFAULT_CODESETS}]
+ end,
+ IOR = case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_ENABLE_NAT) of
+ false ->
+ create(orber:giop_version(), Mod:typeID(), orber:host(),
+ orber:iiop_port(), orber:iiop_ssl_port(),
+ {Mod, Type, Key, UserDef, OrberDef, Flags},
+ MC, Flags, EnvFlags);
+ true ->
+ create(orber:giop_version(), Mod:typeID(), orber:nat_host(),
+ orber:nat_iiop_port(), orber:nat_iiop_ssl_port(),
+ {Mod, Type, Key, UserDef, OrberDef, Flags},
+ MC, Flags, EnvFlags)
+
+ end,
+ print_helper(IoDevice, IOR);
+print(_, _) ->
+ exit("Bad parameter").
+
+print_helper(IoDevice, #'IOP_IOR'{type_id=TypeID, profiles=Profs}) ->
+ Data = io_lib:format("================== IOR ====================~n"
+ "------------------ IFR ID -----------------~n~s~n",
+ [TypeID]),
+ NewData = print_profiles(Profs, []),
+ print_it(IoDevice, lists:flatten([Data|NewData])).
+
+print_profiles([], Acc) ->
+ lists:flatten([Acc | io_lib:format("================== END ====================~n", [])]);
+print_profiles([#'IOP_TaggedProfile'
+ {tag=?TAG_INTERNET_IOP,
+ profile_data = #'IIOP_ProfileBody_1_0'{iiop_version=
+ #'IIOP_Version'{major=Major,
+ minor=Minor},
+ host=Host, port=Port,
+ object_key=Objkey}}|T], Acc) ->
+ Profile = io_lib:format("~n------------------ IIOP Profile -----------~n"
+ "Version.............: ~p.~p~n"
+ "Host................: ~s~n"
+ "Port................: ~p~n",
+ [Major, Minor, Host, Port]),
+ ObjKeyStr = print_objkey(Objkey),
+ print_profiles(T, [Profile, ObjKeyStr | Acc]);
+print_profiles([#'IOP_TaggedProfile'
+ {tag=?TAG_INTERNET_IOP,
+ profile_data = #'IIOP_ProfileBody_1_1'{iiop_version=
+ #'IIOP_Version'{major=Major,
+ minor=Minor},
+ host=Host,
+ port=Port,
+ object_key=Objkey,
+ components=Components}}|T], Acc) ->
+ Profile = io_lib:format("~n------------------ IIOP Profile -----------~n"
+ "Version.............: ~p.~p~n"
+ "Host................: ~s~n"
+ "Port................: ~p~n",
+ [Major, Minor, Host, Port]),
+ ComponentsStr = print_components(Components, []),
+ ObjKeyStr = print_objkey(Objkey),
+ print_profiles(T, [Profile, ObjKeyStr, ComponentsStr |Acc]);
+print_profiles([#'IOP_TaggedProfile'{tag=?TAG_MULTIPLE_COMPONENTS,
+ profile_data = Components}|T], Acc) ->
+ MComp = io_lib:format("~n------------------ Multiple Components ----~n", []),
+ ComponentsStr = print_components(Components, []),
+ print_profiles(T, [MComp, ComponentsStr | Acc]);
+print_profiles([#'IOP_TaggedProfile'{tag=?TAG_SCCP_IOP,
+ profile_data = _Data}|T], Acc) ->
+ SCCP = io_lib:format("~n------------------ SCCP IOP ---------------~n", []),
+ print_profiles(T, [SCCP | Acc]);
+print_profiles([#'IOP_TaggedProfile'{tag=Tag,
+ profile_data = Data}|T], Acc) ->
+ TAG = io_lib:format("~n------------------ TAG ~p -----------------~n"
+ "Data................: ~p~n", [Tag, Data]),
+ print_profiles(T, [TAG|Acc]).
+
+print_components([], Data) -> lists:flatten(lists:reverse(Data));
+print_components([#'IOP_TaggedComponent'{tag=?TAG_ORB_TYPE,
+ component_data=ORB}|T], Data) ->
+ OType = io_lib:format(" TAG_ORB_TYPE~n"
+ "ORB Type............: ~p~n", [ORB]),
+ print_components(T, [OType | Data]);
+print_components([#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
+ component_data=
+ #'CONV_FRAME_CodeSetComponentInfo'
+ {'ForCharData' = Char,
+ 'ForWcharData' = Wchar}}|T], Data) ->
+ CharSet = io_lib:format(" TAG_CODE_SETS~n"
+ "Native Char.........: ~p~n"
+ "Char Conversion.....: ~p~n"
+ "Native Wchar........: ~p~n"
+ "Wchar Conversion....: ~p~n",
+ [Char#'CONV_FRAME_CodeSetComponent'.native_code_set,
+ Char#'CONV_FRAME_CodeSetComponent'.conversion_code_sets,
+ Wchar#'CONV_FRAME_CodeSetComponent'.native_code_set,
+ Wchar#'CONV_FRAME_CodeSetComponent'.conversion_code_sets]),
+ print_components(T, [CharSet | Data]);
+print_components([#'IOP_TaggedComponent'{tag=?TAG_ALTERNATE_IIOP_ADDRESS,
+ component_data=#'ALTERNATE_IIOP_ADDRESS'
+ {'HostID'=Host, 'Port'=Port}}|T], Data) ->
+ AltAddr = io_lib:format(" TAG_ALTERNATE_IIOP_ADDRESS~n"
+ "Alternate Address...: ~s:~p~n", [Host, Port]),
+ print_components(T, [AltAddr | Data]);
+print_components([#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
+ component_data=#'SSLIOP_SSL'
+ {target_supports=Supports,
+ target_requires=Requires,
+ port=Port}}|T], Data) ->
+ SSL = io_lib:format(" TAG_SSL_SEC_TRANS~n"
+ "SSL Port............: ~p~n"
+ "SSL Requires........: ~p~n"
+ "SSL Supports........: ~p~n", [Port, Requires, Supports]),
+ print_components(T, [SSL | Data]);
+%% Fault Tolerant Components
+print_components([#'IOP_TaggedComponent'{tag=?TAG_FT_GROUP,
+ component_data=#'FT_TagFTGroupTaggedComponent'
+ {version = Version,
+ ft_domain_id = DomainId,
+ object_group_id = ObjectGroupId,
+ object_group_ref_version = ObjGrRefVer}}|T], Data) ->
+ Comp = io_lib:format(" TAG_FT_GROUP~n"
+ "Version.............: ~p~n"
+ "Domain Id...........: ~p~n"
+ "Obj Group Id........: ~p~n"
+ "Obj Group Ref Ver...: ~p~n",
+ [Version, DomainId, ObjectGroupId, ObjGrRefVer]),
+ print_components(T, [Comp | Data]);
+print_components([#'IOP_TaggedComponent'{tag=?TAG_FT_PRIMARY,
+ component_data=#'FT_TagFTPrimaryTaggedComponent'
+ {primary = Primary}}|T], Data) ->
+ Comp = io_lib:format(" TAG_FT_PRIMARY~n"
+ "Primary.............: ~p~n", [Primary]),
+ print_components(T, [Comp | Data]);
+print_components([#'IOP_TaggedComponent'{tag=?TAG_FT_HEARTBEAT_ENABLED,
+ component_data=#'FT_TagFTHeartbeatEnabledTaggedComponent'
+ {heartbeat_enabled = HBE}}|T], Data) ->
+ Comp = io_lib:format(" TAG_FT_HEARTBEAT_ENABLED~n"
+ "Heart Beat Enabled..: ~p~n", [HBE]),
+ print_components(T, [Comp | Data]);
+%% Security - CSIIOP
+print_components([#'IOP_TaggedComponent'{tag=?TAG_CSI_SEC_MECH_LIST,
+ component_data=#'CSIIOP_CompoundSecMechList'
+ {stateful=Stateful,
+ mechanism_list = MechList}}|T], Data) ->
+ Comp = io_lib:format(" TAG_CSI_SEC_MECH_LIST~n"
+ "Stateful............: ~p~n"
+ "Mechanisms..........: ~p~n", [Stateful, MechList]),
+ print_components(T, [Comp | Data]);
+print_components([#'IOP_TaggedComponent'{tag=?TAG_TLS_SEC_TRANS,
+ component_data=#'CSIIOP_TLS_SEC_TRANS'
+ {target_supports = TargetS,
+ target_requires = TargetR,
+ addresses = Addresses}}|T], Data) ->
+ Comp = io_lib:format(" TAG_TLS_SEC_TRANS~n"
+ "Target Supports.....: ~p~n"
+ "Target Requires.....: ~p~n"
+ "Addresses...........: ~p~n",
+ [TargetS, TargetR, Addresses]),
+ print_components(T, [Comp | Data]);
+print_components([#'IOP_TaggedComponent'{tag=?TAG_SECIOP_SEC_TRANS,
+ component_data=#'CSIIOP_SECIOP_SEC_TRANS'
+ {target_supports = TargetS,
+ target_requires = TargetR,
+ mech_oid = MechOID,
+ target_name = TargetName,
+ addresses = Addresses}}|T], Data) ->
+ Comp = io_lib:format(" TAG_SECIOP_SEC_TRANS~n"
+ "Target Supports.....: ~p~n"
+ "Target Requires.....: ~p~n"
+ "Mechanism OID.......: ~p~n"
+ "Target Name.........: ~p~n"
+ "Addresses...........: ~p~n",
+ [TargetS, TargetR, MechOID, TargetName, Addresses]),
+ print_components(T, [Comp | Data]);
+%% Unused components.
+print_components([#'IOP_TaggedComponent'{tag=TAG,
+ component_data=CData}|T], Data) ->
+ Unused = io_lib:format("Unused Component....: ~s~n", [match_tag(TAG)]),
+ Octets = print_octets(CData, [], 1, []),
+ print_components(T, [lists:flatten([Unused | Octets])| Data]).
+
+
+print_objkey(Objkey) when is_tuple(Objkey) ->
+ io_lib:format("Local Object........:~n~p~n", [Objkey]);
+print_objkey(Objkey) ->
+ Hdr = io_lib:format("External Object.....: ~n", []),
+ Octets = print_octets(Objkey, [], 1, []),
+ lists:flatten([Hdr | Octets]).
+
+print_octets([], [], _, Data) ->
+ lists:reverse(Data);
+print_octets([], Acc, C, Data) ->
+ Filling = lists:duplicate((4*(9-C)), 32),
+ FData = io_lib:format("~s", [Filling]),
+ Rest = io_lib:format(" ~p~n", [lists:reverse(Acc)]),
+ [lists:reverse(Data), FData | Rest];
+print_octets([H|T], Acc, 8, Data) when H > 31 , H < 127 ->
+ D1 = io_lib:format("~4w", [H]),
+ D2 = io_lib:format(" ~p~n", [lists:reverse([H|Acc])]),
+ print_octets(T, [], 1, [D2, D1 | Data]);
+print_octets([H|T], Acc, 1, Data) when H > 31 , H < 127 ->
+ D1 = io_lib:format("~3w", [H]),
+ print_octets(T, [H|Acc], 2, [D1 | Data]);
+print_octets([H|T], Acc, C, Data) when H > 31 , H < 127 ->
+ D1 = io_lib:format("~4w", [H]),
+ print_octets(T, [H|Acc], C+1, [D1 | Data]);
+print_octets([H|T], Acc, 8, Data) ->
+ D1 = io_lib:format("~4w", [H]),
+ D2 = io_lib:format(" ~p~n", [lists:reverse([$.|Acc])]),
+ print_octets(T, [], 1, [D2, D1 | Data]);
+print_octets([H|T], Acc, 1, Data) ->
+ D1 = io_lib:format("~3w", [H]),
+ print_octets(T, [$.|Acc], 2, [D1|Data]);
+print_octets([H|T], Acc, C, Data) ->
+ D1 = io_lib:format("~4w", [H]),
+ print_octets(T, [$.|Acc], C+1, [D1|Data]).
+
+print_it(undefined, Data) ->
+ io:format(Data);
+print_it(error_report, Data) ->
+ error_logger:error_report(Data);
+print_it(info_msg, Data) ->
+ error_logger:info_msg(Data);
+print_it(string, Data) ->
+ lists:flatten(Data);
+print_it({error_report, Msg}, Data) ->
+ error_logger:error_report(io_lib:format("================== Reason =================~n~s~n~s",
+ [Msg, Data]));
+print_it({info_msg, Msg}, Data) ->
+ error_logger:info_msg(io_lib:format("================== Comment ================~n~s~n~s",
+ [Msg, Data]));
+print_it(IoDevice, Data) ->
+ io:format(IoDevice, Data, []).
+
+match_tag(?TAG_ORB_TYPE) -> ?TAG_ORB_TYPE_STR;
+match_tag(?TAG_CODE_SETS) -> ?TAG_CODE_SETS_STR;
+match_tag(?TAG_POLICIES) -> ?TAG_POLICIES_STR;
+match_tag(?TAG_ALTERNATE_IIOP_ADDRESS) -> ?TAG_ALTERNATE_IIOP_ADDRESS_STR;
+match_tag(?TAG_COMPLETE_OBJECT_KEY) -> ?TAG_COMPLETE_OBJECT_KEY_STR;
+match_tag(?TAG_ENDPOINT_ID_POSITION) -> ?TAG_ENDPOINT_ID_POSITION_STR;
+match_tag(?TAG_LOCATION_POLICY) -> ?TAG_LOCATION_POLICY_STR;
+match_tag(?TAG_ASSOCIATION_OPTIONS) -> ?TAG_ASSOCIATION_OPTIONS_STR;
+match_tag(?TAG_SEC_NAME) -> ?TAG_SEC_NAME_STR;
+match_tag(?TAG_SPKM_1_SEC_MECH) -> ?TAG_SPKM_1_SEC_MECH_STR;
+match_tag(?TAG_SPKM_2_SEC_MECH) -> ?TAG_SPKM_2_SEC_MECH_STR;
+match_tag(?TAG_KerberosV5_SEC_MECH) -> ?TAG_KerberosV5_SEC_MECH_STR;
+match_tag(?TAG_CSI_ECMA_Secret_SEC_MECH) -> ?TAG_CSI_ECMA_Secret_SEC_MECH_STR;
+match_tag(?TAG_CSI_ECMA_Hybrid_SEC_MECH) -> ?TAG_CSI_ECMA_Hybrid_SEC_MECH_STR;
+match_tag(?TAG_SSL_SEC_TRANS) -> ?TAG_SSL_SEC_TRANS_STR;
+match_tag(?TAG_CSI_ECMA_Public_SEC_MECH) -> ?TAG_CSI_ECMA_Public_SEC_MECH_STR;
+match_tag(?TAG_GENERIC_SEC_MECH) -> ?TAG_GENERIC_SEC_MECH_STR;
+match_tag(?TAG_FIREWALL_TRANS) -> ?TAG_FIREWALL_TRANS_STR;
+match_tag(?TAG_SCCP_CONTACT_INFO) -> ?TAG_SCCP_CONTACT_INFO_STR;
+match_tag(?TAG_JAVA_CODEBASE) -> ?TAG_JAVA_CODEBASE_STR;
+match_tag(?TAG_TRANSACTION_POLICY) -> ?TAG_TRANSACTION_POLICY_STR;
+match_tag(?TAG_FT_GROUP) -> ?TAG_FT_GROUP_STR;
+match_tag(?TAG_FT_PRIMARY) -> ?TAG_FT_PRIMARY_STR;
+match_tag(?TAG_FT_HEARTBEAT_ENABLED) -> ?TAG_FT_HEARTBEAT_ENABLED_STR;
+match_tag(?TAG_MESSAGE_ROUTERS) -> ?TAG_MESSAGE_ROUTERS_STR;
+match_tag(?TAG_OTS_POLICY) -> ?TAG_OTS_POLICY_STR;
+match_tag(?TAG_INV_POLICY) -> ?TAG_INV_POLICY_STR;
+match_tag(?TAG_CSI_SEC_MECH_LIST) -> ?TAG_CSI_SEC_MECH_LIST_STR;
+match_tag(?TAG_NULL_TAG) -> ?TAG_NULL_TAG_STR;
+match_tag(?TAG_SECIOP_SEC_TRANS) -> ?TAG_SECIOP_SEC_TRANS_STR;
+match_tag(?TAG_TLS_SEC_TRANS) -> ?TAG_TLS_SEC_TRANS_STR;
+match_tag(?TAG_DCE_STRING_BINDING) -> ?TAG_DCE_STRING_BINDING_STR;
+match_tag(?TAG_DCE_BINDING_NAME) -> ?TAG_DCE_BINDING_NAME_STR;
+match_tag(?TAG_DCE_NO_PIPES) -> ?TAG_DCE_NO_PIPES_STR;
+match_tag(?TAG_DCE_SEC_MECH) -> ?TAG_DCE_SEC_MECH_STR;
+match_tag(?TAG_INET_SEC_TRANS) -> ?TAG_INET_SEC_TRANS_STR;
+match_tag(Tag) -> integer_to_list(Tag).
+
+%%-----------------------------------------------------------------
+%% Func: string_code/1
+%%-----------------------------------------------------------------
+string_code(IOR) ->
+ Flags = orber:get_flags(),
+ case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_ENABLE_NAT) of
+ false ->
+ string_code(IOR, Flags, orber:host(),
+ orber:iiop_port(), orber:iiop_ssl_port());
+ true ->
+ string_code(IOR, Flags, orber:nat_host(),
+ orber:nat_iiop_port(), orber:nat_iiop_ssl_port())
+ end.
+
+string_code(IOR, Host) ->
+ Flags = orber:get_flags(),
+ case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_ENABLE_NAT) of
+ false ->
+ string_code(IOR, Flags, Host,
+ orber:iiop_port(), orber:iiop_ssl_port());
+ true ->
+ string_code(IOR, Flags, Host,
+ orber:nat_iiop_port(), orber:nat_iiop_ssl_port())
+ end.
+
+string_code(IOR, Host, Port) ->
+ Flags = orber:get_flags(),
+ case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_ENABLE_NAT) of
+ false ->
+ string_code(IOR, Flags, Host, Port, orber:iiop_ssl_port());
+ true ->
+ string_code(IOR, Flags, Host, Port, orber:nat_iiop_ssl_port())
+ end.
+
+string_code(IOR, Host, Port, SSLPort) ->
+ string_code(IOR, orber:get_flags(), Host, Port, SSLPort).
+
+string_code(IOR, Flags, IP, Port, SSLPort) ->
+ Env = #giop_env{version = orber:giop_version(),
+ flags = Flags, host = IP, iiop_port = Port,
+ iiop_ssl_port = SSLPort, domain = orber:domain(),
+ partial_security = orber:partial_security()},
+ {IorByteSeq0, Length0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0),
+ {IorByteSeq, _} = code(Env, IOR, IorByteSeq0, Length0),
+ IorByteSeq1 = binary_to_list(list_to_binary(lists:reverse(IorByteSeq))),
+ IorHexSeq = bytestring_to_hexstring(IorByteSeq1),
+ [$I,$O,$R,$: | IorHexSeq].
+
+%%-----------------------------------------------------------------
+%% Func: code/3
+%%-----------------------------------------------------------------
+code(#giop_env{version = Version} = Env, #'IOP_IOR'{type_id=TypeId, profiles=Profiles}, Bytes, Len) ->
+ ProfileSeq =code_profile_datas(Version, Profiles),
+ %% Byte order
+ cdr_encode:enc_type(?IOR_TYPEDEF,
+ Env,
+ #'IOP_IOR'{type_id=TypeId, profiles=ProfileSeq},
+ Bytes, Len);
+%% No Local Interface supplied. Use configuration parameters.
+code(#giop_env{version = Version, host = 0, flags = EnvFlags} = Env,
+ {Mod, Type, Key, UserDef, OrberDef, Flags}, Bytes, Len) ->
+ MC = case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_EXCLUDE_CODESET_COMPONENT) of
+ true ->
+ [];
+ false ->
+ [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
+ component_data=?DEFAULT_CODESETS}]
+ end,
+ IOR = case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_ENABLE_NAT) of
+ false ->
+ create(Version, Mod:typeID(), orber_env:host(),
+ orber_env:iiop_port(), orber_env:iiop_ssl_port(),
+ {Mod, Type, Key, UserDef, OrberDef, Flags},
+ MC, Flags, EnvFlags);
+ true ->
+ create(Version, Mod:typeID(), orber_env:nat_host(),
+ orber_env:nat_iiop_port(), orber_env:nat_iiop_ssl_port(),
+ {Mod, Type, Key, UserDef, OrberDef, Flags},
+ MC, Flags, EnvFlags)
+
+ end,
+ code(Env, IOR, Bytes, Len);
+code(#giop_env{version = Version, host = Host, iiop_port = IIOPort,
+ iiop_ssl_port = SSLPort, flags = EnvFlags} = Env,
+ {Mod, Type, Key, UserDef, OrberDef, Flags}, Bytes, Len) ->
+ MC = case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_EXCLUDE_CODESET_COMPONENT) of
+ true ->
+ [];
+ false ->
+ [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
+ component_data=?DEFAULT_CODESETS}]
+ end,
+ IOR = case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_ENABLE_NAT) of
+ false ->
+ create(Version, Mod:typeID(), Host, check_port(IIOPort, normal),
+ check_port(SSLPort, ssl),
+ {Mod, Type, Key, UserDef, OrberDef, Flags},
+ MC, Flags, EnvFlags);
+ true ->
+ create(Version, Mod:typeID(), orber_env:nat_host(Host),
+ orber_env:nat_iiop_port(check_port(IIOPort, normal)),
+ orber_env:nat_iiop_ssl_port(check_port(SSLPort, ssl)),
+ {Mod, Type, Key, UserDef, OrberDef, Flags},
+ MC, Flags, EnvFlags)
+ end,
+ code(Env, IOR, Bytes, Len).
+
+check_port(Port, _Type) when is_integer(Port) ->
+ Port;
+check_port(_, normal) ->
+ orber:iiop_port();
+check_port(_, ssl) ->
+ orber:iiop_ssl_port().
+
+code_profile_datas(_, []) ->
+ [];
+code_profile_datas(Version, [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=P} | Profiles]) ->
+ NewBytes = list_to_binary(code_profile_data(Version, P)),
+ [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=NewBytes} |
+ code_profile_datas(Version, Profiles)];
+%% Multiple Components
+code_profile_datas(Version, [#'IOP_TaggedProfile'{tag=?TAG_MULTIPLE_COMPONENTS,
+ profile_data=P} | Profiles]) ->
+ Comps= code_comp(Version, P, []),
+ {Bytes, Length} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
+ {Bytes1, _Length1} = cdr_encode:enc_type(?IOP_TAGGEDCOMPONENT_SEQ, Version, Comps, Bytes, Length),
+ Profs = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
+ [#'IOP_TaggedProfile'{tag=?TAG_MULTIPLE_COMPONENTS,
+ profile_data=Profs}| code_profile_datas(Version, Profiles)];
+code_profile_datas(Version, [#'IOP_TaggedProfile'{tag=N, profile_data=P} | Profiles]) ->
+ [#'IOP_TaggedProfile'{tag=N, profile_data=P} | code_profile_datas(Version, Profiles)];
+code_profile_datas(_, Data) ->
+ orber:dbg("[~p] iop_ior:code_profile_datas(~p); unsupported TaggedProfile.",
+ [?LINE, Data], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
+
+code_profile_data(Version, ProfileData) ->
+ [RecTag, V, H, P, O |Rest] = tuple_to_list(ProfileData),
+ {Bytes, Length} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
+ {Bytes1, Length1} = cdr_encode:enc_type(?IIOP_VERSION, Version, V, Bytes, Length),
+ {Bytes2, Length2} = cdr_encode:enc_type({'tk_string', 0}, Version,
+ H, Bytes1, Length1),
+ {Bytes3, Length3} = cdr_encode:enc_type('tk_ushort', Version, P, Bytes2, Length2),
+ {Bytes4, Length4} = cdr_encode:enc_type({'tk_sequence', 'tk_octet', 0}, Version,
+ corba:objkey_to_string(O), Bytes3, Length3),
+ {Bytes5, _Length5} = code_profile_data_1(Version, RecTag, Rest, Bytes4, Length4),
+ Bytes6 = lists:reverse(Bytes5),
+ lists:flatten(Bytes6).
+
+code_profile_data_1(_Version, 'IIOP_ProfileBody_1_0', [], Bytes, Length) ->
+ {Bytes, Length};
+code_profile_data_1(Version, 'IIOP_ProfileBody_1_1', [TaggedComponentSeq], Bytes, Length) ->
+ Comps = code_comp(Version, TaggedComponentSeq, []),
+ cdr_encode:enc_type(?IOP_TAGGEDCOMPONENT_SEQ, Version, Comps, Bytes, Length);
+code_profile_data_1(_,V,S,_,_) ->
+ orber:dbg("[~p] iop_ior:code_profile_datas(~p, ~p); probably unsupported IIOP-version",
+ [?LINE, V, S], ?DEBUG_LEVEL),
+ corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO}).
+
+code_comp(_Version, [], CompData) ->
+ CompData;
+code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
+ component_data=CodeSet}|Comps], CompData) ->
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
+ {Bytes1, _Len1} = cdr_encode:enc_type(?CONV_FRAME_CODESETCOMPONENTINFO, Version,
+ CodeSet, Bytes0, Len0),
+ Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
+ code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
+ component_data=Bytes}|CompData]);
+code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_ORB_TYPE,
+ component_data=ORBType}|Comps], CompData) ->
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
+ {Bytes1, _Len1} = cdr_encode:enc_type(?ORB_TYPE, Version,
+ ORBType, Bytes0, Len0),
+ Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
+ code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_ORB_TYPE,
+ component_data=Bytes}|CompData]);
+code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_ALTERNATE_IIOP_ADDRESS,
+ component_data=AltAddr}|Comps], CompData) ->
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
+ {Bytes1, _Len1} = cdr_encode:enc_type(?ALTERNATE_IIOP_ADDRESS, Version,
+ AltAddr, Bytes0, Len0),
+ Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
+ code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_ALTERNATE_IIOP_ADDRESS,
+ component_data=Bytes}|CompData]);
+code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
+ component_data=SSLStruct}|Comps], CompData) ->
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
+ {Bytes1, _Len1} = cdr_encode:enc_type(?SSLIOP_SSL, Version,
+ SSLStruct, Bytes0, Len0),
+ Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
+ code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
+ component_data=Bytes}|CompData]);
+%% Fault Tolerant Components
+code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_FT_GROUP,
+ component_data=Data}|Comps], CompData) ->
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
+ {Bytes1, _Len1} = cdr_encode:enc_type(?FT_TagFTGroupTaggedComponent, Version,
+ Data, Bytes0, Len0),
+ Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
+ code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_FT_GROUP,
+ component_data=Bytes}|CompData]);
+code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_FT_PRIMARY,
+ component_data=Data}|Comps], CompData) ->
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
+ {Bytes1, _Len1} = cdr_encode:enc_type(?FT_TagFTPrimaryTaggedComponent, Version,
+ Data, Bytes0, Len0),
+ Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
+ code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_FT_PRIMARY,
+ component_data=Bytes}|CompData]);
+code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_FT_HEARTBEAT_ENABLED,
+ component_data=Data}|Comps], CompData) ->
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
+ {Bytes1, _Len1} = cdr_encode:enc_type(?FT_TagFTHeartbeatEnabledTaggedComponent, Version,
+ Data, Bytes0, Len0),
+ Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
+ code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_FT_HEARTBEAT_ENABLED,
+ component_data=Bytes}|CompData]);
+%% Security - CSIIOP
+code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_CSI_SEC_MECH_LIST,
+ component_data=Data}|Comps], CompData) ->
+ NewData = Data#'CSIIOP_CompoundSecMechList'
+ {mechanism_list = code_sec_mech(Version,
+ Data#'CSIIOP_CompoundSecMechList'.mechanism_list,
+ [])},
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
+ {Bytes1, _Len1} = cdr_encode:enc_type(?CSIIOP_CompoundSecMechList, Version,
+ NewData, Bytes0, Len0),
+ Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
+ code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_CSI_SEC_MECH_LIST,
+ component_data=Bytes}|CompData]);
+code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_TLS_SEC_TRANS,
+ component_data=Data}|Comps],
+ CompData) ->
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
+ {Bytes1, _Len1} = cdr_encode:enc_type(?CSIIOP_TLS_SEC_TRANS, Version,
+ Data, Bytes0, Len0),
+ Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
+ code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_TLS_SEC_TRANS,
+ component_data=Bytes}|CompData]);
+code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_SECIOP_SEC_TRANS,
+ component_data=Data}|Comps], CompData) ->
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
+ {Bytes1, _Len1} = cdr_encode:enc_type(?CSIIOP_SECIOP_SEC_TRANS, Version,
+ Data, Bytes0, Len0),
+ Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
+ code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_SECIOP_SEC_TRANS,
+ component_data=Bytes}|CompData]);
+code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_NULL_TAG}|Comps], CompData) ->
+ %% The body of the TAG_NULL_TAG component is a sequence of octets of
+ %% length 0.
+ {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
+ {Bytes1, _Len1} = cdr_encode:enc_type({'tk_sequence', 'tk_octet', 0}, Version,
+ [], Bytes0, Len0),
+ Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
+ code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_NULL_TAG,
+ component_data=Bytes}|CompData]);
+%% Unsupported/not used component.
+code_comp(Version, [C|Comps], CompData) ->
+ code_comp(Version, Comps, [C|CompData]).
+
+
+code_sec_mech(_, [], Acc) ->
+ %% We must preserver the order!!
+ lists:reverse(Acc);
+code_sec_mech(Version, [#'CSIIOP_CompoundSecMech'{transport_mech = TagComp} = CSM|T],
+ Acc) ->
+ [EncTagComp] = code_comp(Version, [TagComp], []),
+ code_sec_mech(Version, T, [CSM#'CSIIOP_CompoundSecMech'
+ {transport_mech = EncTagComp}|Acc]).
+
+
+%%-----------------------------------------------------------------
+%% Func: string_decode/1
+%%-----------------------------------------------------------------
+string_decode([$I,$O,$R,$: | IorHexSeq]) ->
+ Version = orber:giop_version(),
+ IorByteSeq = list_to_binary(hexstring_to_bytestring(IorHexSeq)),
+ {ByteOrder, IorRest} = cdr_decode:dec_byte_order(IorByteSeq),
+ decode(Version, IorRest, 1, ByteOrder);
+string_decode([$i,$o,$r,$: | IorHexSeq]) ->
+ Version = orber:giop_version(),
+ IorByteSeq = list_to_binary(hexstring_to_bytestring(IorHexSeq)),
+ {ByteOrder, IorRest} = cdr_decode:dec_byte_order(IorByteSeq),
+ decode(Version, IorRest, 1, ByteOrder);
+string_decode(What) ->
+ orber:dbg("[~p] iop_ior:string_decode(~p); Should be IOR:.. or ior:..",
+ [?LINE, What], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+%%-----------------------------------------------------------------
+%% Func: decode/3
+%%-----------------------------------------------------------------
+decode(Version, IorByteSeq, Len, ByteOrder) ->
+ {#'IOP_IOR'{type_id=TypeId, profiles=Profiles}, Rest, Length} =
+ cdr_decode:dec_type(?IOR_TYPEDEF, Version, IorByteSeq, Len, ByteOrder),
+ L = decode_profiles(Version, Profiles),
+ {#'IOP_IOR'{type_id=TypeId, profiles=L}, Rest, Length}.
+
+decode_profiles(_, []) ->
+ [];
+decode_profiles(Version, [P | Profiles]) ->
+ Struct = decode_profile(Version, P),
+ L = decode_profiles(Version, Profiles),
+ [Struct | L].
+
+decode_profile(Version, #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=ProfileData}) ->
+ {ByteOrder, Rest} = cdr_decode:dec_byte_order(list_to_binary(ProfileData)),
+ Length = 1,
+ {V, Rest1, Length1} = cdr_decode:dec_type(?IIOP_VERSION, Version, Rest, Length,
+ ByteOrder),
+ {H, Rest2, Length2} = cdr_decode:dec_type({'tk_string', 0}, Version, Rest1, Length1,
+ ByteOrder),
+ {P, Rest3, Length3} = cdr_decode:dec_type('tk_ushort', Version, Rest2, Length2,
+ ByteOrder),
+ {ObjKey, Rest4, Length4} = cdr_decode:dec_type({'tk_sequence', 'tk_octet', 0},
+ Version, Rest3, Length3,
+ ByteOrder),
+ Struct = decode_profile_1(V, H, P, ObjKey, Version, Rest4, Length4, ByteOrder),
+ #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=Struct};
+%% Multiple Components
+decode_profile(Version, #'IOP_TaggedProfile'{tag=?TAG_MULTIPLE_COMPONENTS,
+ profile_data=ProfileData}) ->
+ {ByteOrder, Rest} = cdr_decode:dec_byte_order(list_to_binary(ProfileData)),
+ {Components, <<>>, _Length1} =cdr_decode:dec_type(?IOP_TAGGEDCOMPONENT_SEQ, Version, Rest, 1, ByteOrder),
+ CompData = decode_comp(Version, Components, []),
+ #'IOP_TaggedProfile'{tag=?TAG_MULTIPLE_COMPONENTS, profile_data=CompData};
+decode_profile(_, #'IOP_TaggedProfile'{tag=N, profile_data=ProfileData}) ->
+ #'IOP_TaggedProfile'{tag=N, profile_data=ProfileData};
+decode_profile(_, Data) ->
+ orber:dbg("[~p] iop_ior:decode_profile(~p); unsupported TaggedProfile.",
+ [?LINE, Data], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
+
+decode_profile_1(#'IIOP_Version'{major=1, minor=0}, H, P, ObjKey, _Version, _Rest, _Length, _ByteOrder) ->
+ #'IIOP_ProfileBody_1_0'{iiop_version=#'IIOP_Version'{major=1,
+ minor=0},
+ host=H, port=P,
+ object_key=corba:string_to_objkey(ObjKey)};
+decode_profile_1(#'IIOP_Version'{major=1, minor=1}, H, P, ObjKey, Version, Rest, Length, ByteOrder) ->
+ {Components, <<>>, _Length1} =cdr_decode:dec_type(?IOP_TAGGEDCOMPONENT_SEQ, Version, Rest, Length, ByteOrder),
+ CompData = decode_comp(Version, Components, []),
+ #'IIOP_ProfileBody_1_1'{iiop_version=#'IIOP_Version'{major=1,
+ minor=1},
+ host=H, port=P,
+ object_key=corba:string_to_objkey(ObjKey),
+ components=CompData};
+decode_profile_1(#'IIOP_Version'{major=1, minor=2}, H, P, ObjKey, Version, Rest, Length, ByteOrder) ->
+ {Components, <<>>, _Length1} =cdr_decode:dec_type(?IOP_TAGGEDCOMPONENT_SEQ, Version, Rest, Length, ByteOrder),
+ CompData = decode_comp(Version, Components, []),
+ #'IIOP_ProfileBody_1_1'{iiop_version=#'IIOP_Version'{major=1,
+ minor=2},
+ host=H, port=P,
+ object_key=corba:string_to_objkey(ObjKey),
+ components=CompData};
+decode_profile_1(V, _, _, _, _, _, _,_) ->
+ orber:dbg("[~p] iop_ior:decode_profile_1(~p); probably unsupported IIOP-version.",
+ [?LINE, V], ?DEBUG_LEVEL),
+ corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO}).
+
+decode_comp(_Version, [], Components) ->
+ Components;
+decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
+ component_data=Bytes}|Comps],
+ Components) ->
+ {ByteOrder, Rest} = cdr_decode:dec_byte_order(list_to_binary(Bytes)),
+ {CodeSet, _, _} = cdr_decode:dec_type(?CONV_FRAME_CODESETCOMPONENTINFO,
+ Version, Rest, 1, ByteOrder),
+ decode_comp(Version, Comps,
+ [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
+ component_data=CodeSet}|Components]);
+decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_ORB_TYPE,
+ component_data=Bytes}|Comps],
+ Components) ->
+ {ByteOrder, Rest} = cdr_decode:dec_byte_order(list_to_binary(Bytes)),
+ {ORBType, _, _} = cdr_decode:dec_type(?ORB_TYPE,
+ Version, Rest, 1, ByteOrder),
+ decode_comp(Version, Comps,
+ [#'IOP_TaggedComponent'{tag=?TAG_ORB_TYPE,
+ component_data=ORBType}|Components]);
+decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_ALTERNATE_IIOP_ADDRESS,
+ component_data=Bytes}|Comps],
+ Components) ->
+ {ByteOrder, Rest} = cdr_decode:dec_byte_order(list_to_binary(Bytes)),
+ {AltIIOP, _, _} = cdr_decode:dec_type(?ALTERNATE_IIOP_ADDRESS,
+ Version, Rest, 1, ByteOrder),
+ decode_comp(Version, Comps,
+ [#'IOP_TaggedComponent'{tag=?TAG_ALTERNATE_IIOP_ADDRESS,
+ component_data=AltIIOP}|Components]);
+decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
+ component_data=Data}|Comps], Components) ->
+ {ByteOrder, R} = cdr_decode:dec_byte_order(list_to_binary(Data)),
+ {SSLStruct, _Rest1, _Length1} = cdr_decode:dec_type(?SSLIOP_SSL, Version, R, 1,
+ ByteOrder),
+ decode_comp(Version, Comps,
+ [#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
+ component_data=SSLStruct}|Components]);
+%% Fault Tolerant Components
+decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_FT_GROUP,
+ component_data=Data}|Comps], Components) ->
+ {ByteOrder, R} = cdr_decode:dec_byte_order(list_to_binary(Data)),
+ {DecodedData, _Rest1, _Length1} = cdr_decode:dec_type(?FT_TagFTGroupTaggedComponent, Version, R, 1,
+ ByteOrder),
+ decode_comp(Version, Comps,
+ [#'IOP_TaggedComponent'{tag=?TAG_FT_GROUP,
+ component_data=DecodedData}|Components]);
+decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_FT_PRIMARY,
+ component_data=Data}|Comps], Components) ->
+ {ByteOrder, R} = cdr_decode:dec_byte_order(list_to_binary(Data)),
+ {DecodedData, _Rest1, _Length1} = cdr_decode:dec_type(?FT_TagFTPrimaryTaggedComponent, Version, R, 1,
+ ByteOrder),
+ decode_comp(Version, Comps,
+ [#'IOP_TaggedComponent'{tag=?TAG_FT_PRIMARY,
+ component_data=DecodedData}|Components]);
+decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_FT_HEARTBEAT_ENABLED,
+ component_data=Data}|Comps], Components) ->
+ {ByteOrder, R} = cdr_decode:dec_byte_order(list_to_binary(Data)),
+ {DecodedData, _Rest1, _Length1} = cdr_decode:dec_type(?FT_TagFTHeartbeatEnabledTaggedComponent, Version, R, 1,
+ ByteOrder),
+ decode_comp(Version, Comps,
+ [#'IOP_TaggedComponent'{tag=?TAG_FT_HEARTBEAT_ENABLED,
+ component_data=DecodedData}|Components]);
+%% Security - CSIIOP
+decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_CSI_SEC_MECH_LIST,
+ component_data=Data}|Comps], Components) ->
+ {ByteOrder, R} = cdr_decode:dec_byte_order(list_to_binary(Data)),
+ {DecodedData, _Rest1, _Length1} = cdr_decode:dec_type(?CSIIOP_CompoundSecMechList, Version, R, 1,
+ ByteOrder),
+ NewDecodedData = DecodedData#'CSIIOP_CompoundSecMechList'
+ {mechanism_list = decode_sec_mech(Version,
+ DecodedData#'CSIIOP_CompoundSecMechList'.mechanism_list,
+ [])},
+ decode_comp(Version, Comps,
+ [#'IOP_TaggedComponent'{tag=?TAG_CSI_SEC_MECH_LIST,
+ component_data=NewDecodedData}|Components]);
+decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_TLS_SEC_TRANS,
+ component_data=Data}|Comps], Components) ->
+ {ByteOrder, R} = cdr_decode:dec_byte_order(list_to_binary(Data)),
+ {DecodedData, _Rest1, _Length1} = cdr_decode:dec_type(?CSIIOP_TLS_SEC_TRANS, Version, R, 1,
+ ByteOrder),
+ decode_comp(Version, Comps,
+ [#'IOP_TaggedComponent'{tag=?TAG_TLS_SEC_TRANS,
+ component_data=DecodedData}|Components]);
+decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_SECIOP_SEC_TRANS,
+ component_data=Data}|Comps], Components) ->
+ {ByteOrder, R} = cdr_decode:dec_byte_order(list_to_binary(Data)),
+ {DecodedData, _Rest1, _Length1} = cdr_decode:dec_type(?CSIIOP_SECIOP_SEC_TRANS, Version, R, 1,
+ ByteOrder),
+ decode_comp(Version, Comps,
+ [#'IOP_TaggedComponent'{tag=?TAG_SECIOP_SEC_TRANS,
+ component_data=DecodedData}|Components]);
+decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_NULL_TAG,
+ component_data=_Data}|Comps], Components) ->
+ %% The body of the TAG_NULL_TAG component is a sequence of octets of
+ %% length 0.
+ decode_comp(Version, Comps,
+ [#'IOP_TaggedComponent'{tag=?TAG_NULL_TAG,
+ component_data=[]}|Components]);
+
+decode_comp(Version, [C|Comps], Components) ->
+ %% Not used but we cannot discard it.
+ decode_comp(Version, Comps, [C|Components]).
+
+
+decode_sec_mech(_Version, [], Acc) ->
+ %% We must preserver the order!!
+ lists:reverse(Acc);
+decode_sec_mech(Version, [#'CSIIOP_CompoundSecMech'{transport_mech = TagComp} = CSM|T],
+ Acc) ->
+ [DecTagComp] = decode_comp(Version, [TagComp], []),
+ decode_sec_mech(Version, T, [CSM#'CSIIOP_CompoundSecMech'
+ {transport_mech = DecTagComp}|Acc]).
+
+
+%%-----------------------------------------------------------------
+%% Func: hexstring_to_bytestring/1
+%%-----------------------------------------------------------------
+hexstring_to_bytestring(HexString) ->
+ ByteString = hexstring_to_bytestring(HexString, []),
+ lists:reverse(ByteString).
+
+hexstring_to_bytestring([], Acc) ->
+ Acc;
+hexstring_to_bytestring([H1, H2 |Rest], Acc) ->
+ I1 = hex_to_int(H1),
+ I2 = hex_to_int(H2),
+ I = I1 * 16 + I2,
+ Acc2 = cdrlib:enc_octet(I, Acc),
+ hexstring_to_bytestring(Rest, Acc2).
+
+
+hex_to_int(H) when H >= $a ->
+ 10 + H - $a;
+hex_to_int(H) when H >= $A ->
+ 10 + H -$A;
+hex_to_int(H) ->
+ H - $0.
+%%-----------------------------------------------------------------
+%% Func: bytestring_to_hexstring/1
+%% Args: A byte string
+%% Returns: A list of hexadecimal digits (onebyte will be represented as
+%% two hexadecimal digits).
+%%-----------------------------------------------------------------
+bytestring_to_hexstring(ByteString) ->
+ HexString = bytestring_to_hexstring(ByteString, []),
+ lists:reverse(HexString).
+
+bytestring_to_hexstring([], Acc) ->
+ Acc;
+bytestring_to_hexstring([B |Rest], Acc) ->
+ [C1, C2] = int_to_hex(B),
+ bytestring_to_hexstring(Rest,[C2, C1| Acc]).
+
+int_to_hex(B) when B < 256, B >= 0 ->
+ N1 = B div 16,
+ N2 = B rem 16,
+ [code_character(N1),
+ code_character(N2)].
+
+code_character(N) when N < 10 ->
+ $0 + N;
+code_character(N) ->
+ $a + (N - 10).
+
diff --git a/lib/orber/src/orber.app.src b/lib/orber/src/orber.app.src
new file mode 100644
index 0000000000..fe911d65a4
--- /dev/null
+++ b/lib/orber/src/orber.app.src
@@ -0,0 +1,109 @@
+{application, orber,
+ [{description, "The Erlang ORB application"},
+ {vsn, "%VSN%"},
+ {modules,
+ [
+ 'CosNaming_Binding',
+ 'CosNaming_BindingIterator',
+ 'CosNaming_BindingList',
+ 'CosNaming_BindingIterator_impl',
+ 'CosNaming_Name',
+ 'CosNaming_NameComponent',
+ 'CosNaming_NamingContext',
+ 'CosNaming_NamingContext_AlreadyBound',
+ 'CosNaming_NamingContext_CannotProceed',
+ 'CosNaming_NamingContext_InvalidName',
+ 'CosNaming_NamingContext_NotEmpty',
+ 'CosNaming_NamingContext_NotFound',
+ 'CosNaming_NamingContextExt',
+ 'CosNaming_NamingContextExt_impl',
+ 'CosNaming_NamingContextExt_InvalidAddress',
+ 'OrberApp_IFR',
+ 'OrberApp_IFR_impl',
+ 'oe_OrberIFR',
+ 'any',
+ 'cdr_decode',
+ 'cdr_encode',
+ 'cdrlib',
+ 'corba',
+ 'corba_boa',
+ 'corba_object',
+ 'erlang_pid',
+ 'erlang_port',
+ 'erlang_ref',
+ 'erlang_binary',
+ 'iop_ior',
+ 'lname',
+ 'lname_component',
+ 'oe_CORBA',
+ 'oe_cos_naming',
+ 'oe_cos_naming_ext',
+ 'oe_erlang',
+ 'orber',
+ 'orber_cosnaming_utils',
+ 'orber_ifr',
+ 'orber_ifr_aliasdef',
+ 'orber_ifr_arraydef',
+ 'orber_ifr_attributedef',
+ 'orber_ifr_constantdef',
+ 'orber_ifr_contained',
+ 'orber_ifr_container',
+ 'orber_ifr_enumdef',
+ 'orber_ifr_exceptiondef',
+ 'orber_ifr_idltype',
+ 'orber_ifr_interfacedef',
+ 'orber_ifr_irobject',
+ 'orber_ifr_moduledef',
+ 'orber_ifr_operationdef',
+ 'orber_ifr_orb',
+ 'orber_ifr_primitivedef',
+ 'orber_ifr_repository',
+ 'orber_ifr_sequencedef',
+ 'orber_ifr_stringdef',
+ 'orber_ifr_wstringdef',
+ 'orber_ifr_structdef',
+ 'orber_ifr_typecode',
+ 'orber_ifr_typedef',
+ 'orber_ifr_uniondef',
+ 'orber_ifr_fixeddef',
+ 'orber_ifr_utils',
+ 'orber_iiop',
+ 'orber_iiop_inproxy',
+ 'orber_iiop_inrequest',
+ 'orber_iiop_insup',
+ 'orber_iiop_net',
+ 'orber_iiop_net_accept',
+ 'orber_iiop_outproxy',
+ 'orber_iiop_outsup',
+ 'orber_iiop_pm',
+ 'orber_iiop_socketsup',
+ 'orber_initial_references',
+ 'orber_pi',
+ 'orber_objectkeys',
+ 'orber_request_number',
+ 'orber_socket',
+ 'orber_tc',
+ 'orber_typedefs',
+ 'orber_web',
+ 'orber_web_server',
+ 'orber_iiop_tracer',
+ 'orber_iiop_tracer_silent',
+ 'orber_iiop_tracer_stealth',
+ 'fixed',
+ 'orber_exceptions',
+ 'orber_diagnostics',
+ 'orber_acl',
+ 'orber_tb',
+ 'orber_env'
+ ]
+ },
+ {registered, [orber_sup, orber_iiop_sup, orber_iiop_net, orber_iiop_outsup,
+ orber_iiop_insup, orber_init, orber_reqno,
+ orber_objkeyserver, orber_iiop_socketsup,
+ orber_iiop_pm, orber_env]},
+ {applications, [stdlib, kernel]},
+ {env, []},
+ {mod, {orber, []}}
+]}.
+
+
diff --git a/lib/orber/src/orber.appup.src b/lib/orber/src/orber.appup.src
new file mode 100644
index 0000000000..6c3b2833b7
--- /dev/null
+++ b/lib/orber/src/orber.appup.src
@@ -0,0 +1,7 @@
+{"%VSN%",
+ [
+ ],
+ [
+ ]
+}.
+
diff --git a/lib/orber/src/orber.erl b/lib/orber/src/orber.erl
new file mode 100644
index 0000000000..e9c6822551
--- /dev/null
+++ b/lib/orber/src/orber.erl
@@ -0,0 +1,1216 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber.erl
+%%
+%% Description:
+%% This file contains the Orber application interface
+%%
+%%-----------------------------------------------------------------
+-module(orber).
+
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/src/orber_iiop.hrl").
+-include_lib("orber/src/ifr_objects.hrl").
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start/0, start/1, stop/0, install/1, install/2, orber_nodes/0, iiop_port/0,
+ domain/0, iiop_ssl_port/0, iiop_out_ports/0,
+ ssl_server_certfile/0, ssl_client_certfile/0, set_ssl_client_certfile/1,
+ ssl_server_verify/0, ssl_client_verify/0, set_ssl_client_verify/1,
+ ssl_server_depth/0, ssl_client_depth/0, set_ssl_client_depth/1,
+ ssl_server_cacertfile/0,ssl_client_cacertfile/0, set_ssl_client_cacertfile/1,
+ ssl_client_keyfile/0, ssl_client_password/0, ssl_server_keyfile/0, ssl_server_password/0,
+ ssl_client_ciphers/0, ssl_server_ciphers/0, ssl_client_cachetimeout/0, ssl_server_cachetimeout/0,
+ uninstall/0, giop_version/0, info/0, info/1, is_running/0, add_node/2,
+ remove_node/1, iiop_timeout/0, iiop_connection_timeout/0,
+ iiop_setup_connection_timeout/0, objectkeys_gc_time/0,
+ is_lightweight/0, get_lightweight_nodes/0,
+ start_lightweight/0, start_lightweight/1,
+ get_ORBDefaultInitRef/0, get_ORBInitRef/0,
+ get_interceptors/0, get_local_interceptors/0,
+ get_cached_interceptors/0, set_interceptors/1,
+ jump_start/0, jump_start/1, jump_stop/0,
+ iiop_connections/0, iiop_connections/1, iiop_connections_pending/0,
+ typechecking/0,
+ exclude_codeset_ctx/0, exclude_codeset_component/0, bidir_context/0, use_FT/0,
+ use_CSIv2/0, get_flags/0, secure/0, multi_jump_start/1, multi_jump_start/2,
+ multi_jump_start/3, get_tables/0, iiop_in_connection_timeout/0,
+ partial_security/0, nat_iiop_ssl_port/0, nat_iiop_port/0, ip_version/0,
+ light_ifr/0, iiop_max_in_requests/0, iiop_max_in_connections/0,
+ iiop_max_fragments/0, iiop_backlog/0, iiop_ssl_backlog/0,
+ find_sockname_by_peername/2, find_peername_by_sockname/2, iiop_acl/0,
+ add_listen_interface/2, add_listen_interface/3, remove_listen_interface/1,
+ reconfigure_out_connections/1,
+ reconfigure_out_connection/3, reconfigure_out_connection/4,
+ reconfigure_in_connections/1, reconfigure_in_connection/2,
+ activate_audit_trail/0, activate_audit_trail/1, deactivate_audit_trail/0,
+ iiop_ssl_ip_address_local/0, ip_address_local/0,
+ close_connection/1, close_connection/2, is_system_exception/1,
+ exception_info/1]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([nat_host/0, host/0, ip_address_variable_defined/0, start/2, init/1,
+ get_debug_level/0, debug_level_print/3, dbg/3, error/3,
+ configure/2, configure_override/2, multi_configure/1,
+ mjs/1, mjs/2, js/0, js/1]).
+
+%%-----------------------------------------------------------------
+%% Internal definitions
+%%-----------------------------------------------------------------
+%% Defines possible configuration parameters a user can add when,
+%% for example, installing Orber.
+-record(options, {ifr_storage_type = disc_copies,
+ install_timeout = infinity,
+ local_content = false,
+ nameservice_storage_type = ram_copies,
+ initialreferences_storage_type = ram_copies,
+ type = temporary,
+ load_order = 0}).
+
+-define(ORBER_TABS, [orber_CosNaming, orber_objkeys, orber_references]).
+
+-define(DEBUG_LEVEL, 5).
+
+-define(FORMAT(_F, _A), lists:flatten(io_lib:format(_F, _A))).
+-define(EFORMAT(_F, _A), exit(lists:flatten(io_lib:format(_F, _A)))).
+
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+
+jump_stop() ->
+ stop(),
+ uninstall(),
+ mnesia:stop().
+
+js() ->
+ application:load(orber),
+ jump_start([{iiop_port, iiop_port()},
+ {interceptors, {native, [orber_iiop_tracer_silent]}},
+ {orber_debug_level, 10},
+ {flags, (?ORB_ENV_LOCAL_TYPECHECKING bor get_flags())}]).
+
+js(Port) when is_integer(Port) ->
+ application:load(orber),
+ jump_start([{iiop_port, Port},
+ {interceptors, {native, [orber_iiop_tracer_silent]}},
+ {orber_debug_level, 10},
+ {flags, (?ORB_ENV_LOCAL_TYPECHECKING bor get_flags())}]).
+
+jump_start() ->
+ application:load(orber),
+ jump_start([{iiop_port, iiop_port()}]).
+
+
+jump_start(Port) when is_integer(Port) ->
+ application:load(orber),
+ jump_start([{iiop_port, Port}]);
+jump_start(Options) when is_list(Options) ->
+ application:load(orber),
+ mnesia:start(),
+ Port = case lists:keysearch(iiop_port, 1, Options) of
+ {value, {iiop_port, Value}} ->
+ Value;
+ _ ->
+ iiop_port()
+ end,
+ corba:orb_init([{iiop_port, Port}|Options]),
+ install([node()], [{ifr_storage_type, ram_copies}]),
+ start(),
+ %% We need to use this operation if Port == 0 to see what the OS
+ %% assigned.
+ NewPort = orber_env:iiop_port(),
+ Domain = orber_env:ip_address() ++ [$:|integer_to_list(NewPort)],
+ orber_env:configure_override(domain, Domain),
+ info();
+jump_start(Options) ->
+ exit({error, Options}).
+
+
+mjs(Nodes) ->
+ application:load(orber),
+ multi_js_helper(Nodes, iiop_port(),
+ [{interceptors, {native, [orber_iiop_tracer_silent]}},
+ {orber_debug_level, 10},
+ {flags, (?ORB_ENV_LOCAL_TYPECHECKING bor get_flags())}]).
+
+mjs(Nodes, Port) ->
+ application:load(orber),
+ multi_js_helper(Nodes, Port,
+ [{interceptors, {native, [orber_iiop_tracer_silent]}},
+ {orber_debug_level, 10},
+ {flags, (?ORB_ENV_LOCAL_TYPECHECKING bor get_flags())}]).
+
+
+multi_jump_start(Nodes) ->
+ application:load(orber),
+ multi_js_helper(Nodes, iiop_port(), []).
+
+multi_jump_start(Nodes, Port) ->
+ multi_js_helper(Nodes, Port, []).
+
+multi_jump_start(Nodes, Port, Options) ->
+ multi_js_helper(Nodes, Port, Options).
+
+multi_js_helper(Nodes, Port, InitOptions) when is_list(Nodes) andalso
+ is_integer(Port) andalso
+ is_list(InitOptions) ->
+ %% We MUST delete the option iiop_port.
+ Options = lists:keydelete(iiop_port, 1, InitOptions),
+ case node() of
+ nonode@nohost ->
+ {error, "The distribution is not started"};
+ _ ->
+ mnesia:start(),
+ corba:orb_init([{iiop_port, Port}|Options]),
+ install([node()], [{ifr_storage_type, ram_copies}]),
+ start(),
+ NewPort = orber_env:iiop_port(),
+ Domain = orber_env:ip_address() ++ [$:|integer_to_list(NewPort)],
+ orber_env:configure_override(domain, Domain),
+ case jump_start_slaves(Nodes, NewPort,
+ [{domain, Domain}|Options], [], []) of
+ {ok, NodeData} ->
+ info(),
+ {ok, [{node(), NewPort}|NodeData]};
+ Other ->
+ Other
+ end
+ end.
+
+jump_start_slaves([], _, _, [], NodeData) ->
+ rpc:multicall([node() | nodes()], global, sync, []),
+ {ok, NodeData};
+jump_start_slaves([], _, _, Errors, _) ->
+ {error, Errors};
+jump_start_slaves([{Host, N}|T], Port, Options, Errors, NodeData) ->
+ case create_nodes(Host, N, Port, Options, Errors, NodeData) of
+ {ok, NewNodeData} ->
+ jump_start_slaves(T, Port, Options, Errors, NewNodeData);
+ {error, NewErrors} ->
+ jump_start_slaves(T, Port, Options, NewErrors, NodeData)
+ end;
+jump_start_slaves([Host|T], Port, Options, Errors, NodeData) ->
+ case catch create_node(Host, Port+1, Options) of
+ {ok, NewNode} ->
+ jump_start_slaves(T, Port, Options, Errors, [{NewNode, Port+1}|NodeData]);
+ {error, Reason} ->
+ jump_start_slaves(T, Port, Options, [{Host, Port, Reason}|Errors],
+ NodeData);
+ Other ->
+ jump_start_slaves(T, Port, Options, [{Host, Port, Other}|Errors],
+ NodeData)
+ end.
+
+create_nodes(_, 0, _, _, [], NodeData) ->
+ {ok, NodeData};
+create_nodes(_, 0, _, _, Errors, _) ->
+ {error, Errors};
+create_nodes(Host, N, Port, Options, Errors, NodeData) ->
+ case catch create_node(Host, Port+N, Options) of
+ {ok, NewNode} ->
+ create_nodes(Host, N-1, Port, Options, Errors,
+ [{NewNode, Port+N}|NodeData]);
+ {error, Reason} ->
+ create_nodes(Host, N-1, Port, Options,
+ [{Host, Port+N, Reason}|Errors], NodeData);
+ Other ->
+ create_nodes(Host, N-1, Port, Options,
+ [{Host, Port+N, Other}|Errors], NodeData)
+ end.
+
+
+create_node(Host, Port, Options) ->
+ case slave:start_link(Host, Port) of
+ {ok, NewNode} ->
+ case net_adm:ping(NewNode) of
+ pong ->
+ ok = rpc:call(NewNode, mnesia, start, []),
+ {ok,_} = rpc:call(NewNode, mnesia, change_config, [extra_db_nodes, [node()]]),
+ ok = rpc:call(NewNode, corba, orb_init, [[{iiop_port, Port}|Options]]),
+ ok = rpc:call(NewNode, orber, add_node, [NewNode, ram_copies]),
+ {ok, NewNode};
+ _ ->
+ {error, "net_adm:ping(Node) failed"}
+ end;
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+
+start() ->
+ start(temporary).
+
+start(Type) when Type == permanent; Type == temporary ->
+ application:start(mnesia),
+ TableTest = test_tables(),
+ case lists:member(not_member, TableTest) of
+ true ->
+ exit({error,"Orber Mnesia Table(s) missing. Orber not properly installed."});
+ _->
+ try_starting(Type)
+ end.
+
+start_lightweight() ->
+ application:start(orber).
+
+start_lightweight(Nodes) when is_list(Nodes) ->
+ configure(lightweight, Nodes),
+ application:set_env(orber, lightweight, Nodes),
+ application:start(orber);
+start_lightweight(_) ->
+ exit({error,"Argument not correct; must be a list of nodes."}).
+
+stop() ->
+ application:stop(orber).
+
+
+get_tables() ->
+ case light_ifr() of
+ false ->
+ ?ifr_object_list++?ORBER_TABS;
+ true ->
+ ?ifr_light_object_list ++?ORBER_TABS
+ end.
+
+iiop_port() ->
+ orber_env:iiop_port().
+
+nat_iiop_port() ->
+ orber_env:nat_iiop_port().
+
+iiop_out_ports() ->
+ orber_env:iiop_out_ports().
+
+orber_nodes() ->
+ case catch mnesia:table_info(orber_objkeys,ram_copies) of
+ Nodes when is_list(Nodes) ->
+ Nodes;
+ _ ->
+ [node()]
+ end.
+
+domain() ->
+ orber_env:domain().
+
+
+ip_address_variable_defined() ->
+ orber_env:ip_address_variable_defined().
+
+
+nat_host() ->
+ orber_env:nat_host().
+
+host() ->
+ orber_env:host().
+
+giop_version() ->
+ orber_env:giop_version().
+
+iiop_timeout() ->
+ orber_env:iiop_timeout().
+
+iiop_connection_timeout() ->
+ orber_env:iiop_connection_timeout().
+
+iiop_setup_connection_timeout() ->
+ orber_env:iiop_setup_connection_timeout().
+
+iiop_in_connection_timeout() ->
+ orber_env:iiop_in_connection_timeout().
+
+find_peername_by_sockname(Host, Port) ->
+ orber_iiop_net:sockname2peername(Host, Port) ++
+ orber_iiop_pm:sockname2peername(Host, Port).
+
+find_sockname_by_peername(Host, Port) ->
+ orber_iiop_net:peername2sockname(Host, Port) ++
+ orber_iiop_pm:peername2sockname(Host, Port).
+
+%%----------------------------------------------------------------------
+%% Function : iiop_connections
+%% Arguments : Direction - in | out | inout
+%% Returns : Connections - [{Host, Port}] | [{Host, Port, Interface}]
+%% Host - string
+%% Port - integer
+%% Interface - string
+%% Raises :
+%% Description: List existing in- and/or out-bound connections.
+%%----------------------------------------------------------------------
+iiop_connections() ->
+ iiop_connections(inout).
+
+iiop_connections(inout) ->
+ orber_iiop_pm:list_existing_connections() ++ orber_iiop_net:connections();
+iiop_connections(in) ->
+ orber_iiop_net:connections();
+iiop_connections(out) ->
+ orber_iiop_pm:list_existing_connections().
+
+%%----------------------------------------------------------------------
+%% Function : close_connection
+%% Arguments : ObjRef - #'IOP_IOR'{} | [{Host, Port}] |
+%% Interface - string (optional)
+%% Host - string
+%% Port - integer
+%% Returns : ok | {'EXCEPTION', #'BAD_PARAM'{}}
+%% Raises :
+%% Description: Close outgoing connections.
+%%----------------------------------------------------------------------
+close_connection(ObjRef) ->
+ close_connection(ObjRef, 0).
+
+close_connection(ObjRef, Interface) when is_record(ObjRef, 'IOP_IOR') ->
+ case iop_ior:get_peerdata(ObjRef) of
+ [] ->
+ ok;
+ PeerData ->
+ orber_iiop_pm:close_connection(PeerData, Interface)
+ end;
+close_connection(PeerData, Interface) when is_list(PeerData) ->
+ orber_iiop_pm:close_connection(PeerData, Interface);
+close_connection(What, Interface) ->
+ orber:dbg("[~p] orber:close_connection(~p, ~p);~n"
+ "Incorrect type of arguments.",
+ [?LINE, What, Interface], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+%%----------------------------------------------------------------------
+%% Function : iiop_connections_pending
+%% Arguments : -
+%% Returns : Connections - [{Host, Port}]
+%% Host - string
+%% Port - integer
+%% Raises :
+%% Description: List outbound connections that are being setup. Usefull
+%% when suspecting firewall problems.
+%%----------------------------------------------------------------------
+iiop_connections_pending() ->
+ orber_iiop_pm:list_setup_connections().
+
+
+iiop_max_fragments() ->
+ orber_env:iiop_max_fragments().
+
+iiop_max_in_requests() ->
+ orber_env:iiop_max_in_requests().
+
+iiop_max_in_connections() ->
+ orber_env:iiop_max_in_connections().
+
+iiop_backlog() ->
+ orber_env:iiop_backlog().
+
+iiop_acl() ->
+ orber_env:iiop_acl().
+
+ip_address_local() ->
+ orber_env:ip_address_local().
+
+get_flags() ->
+ orber_env:get_flags().
+
+typechecking() ->
+ orber_env:typechecking().
+
+exclude_codeset_ctx() ->
+ orber_env:exclude_codeset_ctx().
+
+exclude_codeset_component() ->
+ orber_env:exclude_codeset_component().
+
+partial_security() ->
+ orber_env:partial_security().
+
+use_CSIv2() ->
+ orber_env:use_CSIv2().
+
+use_FT() ->
+ orber_env:use_FT().
+
+ip_version() ->
+ orber_env:ip_version().
+
+light_ifr() ->
+ orber_env:light_ifr().
+
+bidir_context() ->
+ orber_env:bidir_context().
+
+objectkeys_gc_time() ->
+ orber_env:objectkeys_gc_time().
+
+
+%%-----------------------------------------------------------------
+%% CosNaming::NamingContextExt operations
+%%-----------------------------------------------------------------
+get_ORBInitRef() ->
+ orber_env:get_ORBInitRef().
+
+get_ORBDefaultInitRef() ->
+ orber_env:get_ORBDefaultInitRef().
+
+
+%%-----------------------------------------------------------------
+%% Interceptor opertaions (see orber_pi.erl)
+%%-----------------------------------------------------------------
+get_interceptors() ->
+ orber_env:get_interceptors().
+
+get_local_interceptors() ->
+ orber_env:get_local_interceptors().
+
+get_cached_interceptors() ->
+ orber_env:get_cached_interceptors().
+
+set_interceptors(Val) ->
+ orber_env:set_interceptors(Val).
+
+
+%%-----------------------------------------------------------------
+%% Light weight Orber operations
+%%-----------------------------------------------------------------
+is_lightweight() ->
+ orber_env:is_lightweight().
+
+get_lightweight_nodes() ->
+ orber_env:get_lightweight_nodes().
+
+%%-----------------------------------------------------------------
+%% Security access operations (SSL)
+%%-----------------------------------------------------------------
+secure() ->
+ orber_env:secure().
+
+iiop_ssl_backlog() ->
+ orber_env:iiop_ssl_backlog().
+
+iiop_ssl_ip_address_local() ->
+ orber_env:iiop_ssl_ip_address_local().
+
+iiop_ssl_port() ->
+ orber_env:iiop_ssl_port().
+
+nat_iiop_ssl_port() ->
+ orber_env:nat_iiop_ssl_port().
+
+ssl_server_certfile() ->
+ orber_env:ssl_server_certfile().
+
+ssl_client_certfile() ->
+ orber_env:ssl_client_certfile().
+
+set_ssl_client_certfile(Value) ->
+ orber_env:set_ssl_client_certfile(Value).
+
+ssl_server_verify() ->
+ orber_env:ssl_server_verify().
+
+ssl_client_verify() ->
+ orber_env:ssl_client_verify().
+
+set_ssl_client_verify(Value) ->
+ orber_env:set_ssl_client_verify(Value).
+
+ssl_server_depth() ->
+ orber_env:ssl_server_depth().
+
+ssl_client_depth() ->
+ orber_env:ssl_client_depth().
+
+set_ssl_client_depth(Value) ->
+ orber_env:set_ssl_client_depth(Value).
+
+ssl_server_cacertfile() ->
+ orber_env:ssl_server_cacertfile().
+
+ssl_client_cacertfile() ->
+ orber_env:ssl_client_cacertfile().
+
+set_ssl_client_cacertfile(Value) ->
+ orber_env:set_ssl_client_cacertfile(Value).
+
+ssl_client_password() ->
+ orber_env:ssl_client_password().
+
+ssl_server_password() ->
+ orber_env:ssl_server_password().
+
+ssl_client_keyfile() ->
+ orber_env:ssl_client_keyfile().
+
+ssl_server_keyfile() ->
+ orber_env:ssl_server_keyfile().
+
+ssl_client_ciphers() ->
+ orber_env:ssl_client_ciphers().
+
+ssl_server_ciphers() ->
+ orber_env:ssl_server_ciphers().
+
+ssl_client_cachetimeout() ->
+ orber_env:ssl_client_cachetimeout().
+
+ssl_server_cachetimeout() ->
+ orber_env:ssl_server_cachetimeout().
+
+%%----------------------------------------------------------------------
+%% Function : activate_audit_trail
+%% Arguments : Verbosity - stealth | normal | verbose
+%% Returns : -
+%% Raises :
+%% Description: Activate the appropriate interceptor for the requested direction(s).
+%%----------------------------------------------------------------------
+activate_audit_trail() ->
+ activate_audit_trail(normal).
+
+activate_audit_trail(stealth) ->
+ do_activate(orber_iiop_tracer_stealth);
+activate_audit_trail(verbose) ->
+ do_activate(orber_iiop_tracer);
+activate_audit_trail(_) ->
+ do_activate(orber_iiop_tracer_silent).
+
+do_activate(Interceptor) ->
+ Options =
+ case orber_env:get_interceptors() of
+ {native, PIs} ->
+ [{interceptors,
+ {native, [Interceptor|remove_built_in_interceptors(PIs, [])]}}];
+ _ ->
+ [{interceptors, {native, [Interceptor]}}]
+ end,
+ reconfigure_in_connections(Options),
+ reconfigure_out_connections(Options).
+
+remove_built_in_interceptors([orber_iiop_tracer_stealth|T], Acc) ->
+ remove_built_in_interceptors(T, Acc);
+remove_built_in_interceptors([orber_iiop_tracer|T], Acc) ->
+ remove_built_in_interceptors(T, Acc);
+remove_built_in_interceptors([orber_iiop_tracer_silent|T], Acc) ->
+ remove_built_in_interceptors(T, Acc);
+remove_built_in_interceptors([H|T], Acc) ->
+ remove_built_in_interceptors(T, [H|Acc]);
+remove_built_in_interceptors([], Acc) ->
+ %% We must use the same order as defined by the interceptors parameter
+ lists:reverse(Acc).
+
+%%----------------------------------------------------------------------
+%% Function : deactivate_audit_trail
+%% Arguments : -
+%% Returns : -
+%% Raises :
+%% Description: Dectivate interceptors for the requested direction(s).
+%%----------------------------------------------------------------------
+deactivate_audit_trail() ->
+ Options
+ = case orber_env:get_interceptors() of
+ {native, PIs} ->
+ [{interceptors, {native, PIs}}];
+ _ ->
+ [{interceptors, false}]
+ end,
+ reconfigure_in_connections(Options),
+ reconfigure_out_connections(Options).
+
+%%----------------------------------------------------------------------
+%% Function : add_listen_interface
+%% Arguments : IP - string
+%% Type - normal | ssl
+%% Port - integer > 0
+%% Options - [{Key, Value}]
+%% Key - atom() valid configuration parameter
+%% Value - a valid value for the given Key
+%% Returns : #Ref
+%% Raises :
+%% Description: Add a new listen process, which will accept new incoming
+%% connections.
+%%----------------------------------------------------------------------
+add_listen_interface(IP, normal) ->
+ orber_iiop_net:add(IP, normal, [{iiop_port, orber_env:iiop_port()}]);
+add_listen_interface(IP, ssl) ->
+ orber_iiop_net:add(IP, ssl, [{iiop_ssl_port, orber_env:iiop_ssl_port()}]).
+
+add_listen_interface(IP, normal, Port) when is_integer(Port) andalso Port > 0 ->
+ orber_iiop_net:add(IP, normal, [{iiop_port, Port}]);
+add_listen_interface(IP, ssl, Port) when is_integer(Port) andalso Port > 0 ->
+ orber_iiop_net:add(IP, ssl, [{iiop_ssl_port, Port}]);
+add_listen_interface(IP, Type, Options) when is_list(Options) ->
+ orber_iiop_net:add(IP, Type, Options);
+add_listen_interface(IP, Type, Port) when is_integer(Port) ->
+ orber:dbg("[~p] orber:add_listen_interface(~p, ~p, ~p);~n"
+ "The port number must be greater than 0.",
+ [?LINE, IP, Type, Port], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO});
+add_listen_interface(IP, Type, Extra) ->
+ orber:dbg("[~p] orber:add_listen_interface(~p, ~p, ~p);~n"
+ "Incorrect argument(s).",
+ [?LINE, IP, Type, Extra], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+%%----------------------------------------------------------------------
+%% Function : remove_listen_interface
+%% Arguments : Ref - #Ref
+%% Returns : #Ref
+%% Raises :
+%% Description: Terminate the listen process and all related inproxies
+%% associated with the supplied reference.
+%%----------------------------------------------------------------------
+remove_listen_interface(Ref) ->
+ orber_iiop_net:remove(Ref).
+
+%%----------------------------------------------------------------------
+%% Function : reconfigure_out_connections
+%% Arguments : Options - see corba:orb_init
+%% Returns : ok | {error, Reason}
+%% Raises :
+%% Description: Reconfigure the behavior of all outgoing IIOP connections.
+%%----------------------------------------------------------------------
+reconfigure_out_connections(Options) ->
+ orber_iiop_pm:reconfigure(Options).
+
+%%----------------------------------------------------------------------
+%% Function : reconfigure_out_connections
+%% Arguments : Options - see corba:orb_init
+%% Host - string()
+%% Port - integer()
+%% Interface - string
+%% Returns : ok | {error, Reason}
+%% Raises :
+%% Description: Reconfigure the behavior of all outgoing connections.
+%%----------------------------------------------------------------------
+reconfigure_out_connection(Options, Host, Port) ->
+ orber_iiop_pm:reconfigure(Options, Host, Port).
+reconfigure_out_connection(Options, Host, Port, Interface) ->
+ orber_iiop_pm:reconfigure(Options, Host, Port, Interface).
+
+%%----------------------------------------------------------------------
+%% Function : reconfigure_in_connections
+%% Arguments : Options - see corba:orb_init
+%% Returns : ok | {error, Reason}
+%% Raises :
+%% Description: Reconfigure the behavior of all incoming IIOP connections.
+%%----------------------------------------------------------------------
+reconfigure_in_connections(Options) ->
+ orber_iiop_net:reconfigure(Options).
+
+%%----------------------------------------------------------------------
+%% Function : reconfigure_in_connections
+%% Arguments : Options - see corba:orb_init
+%% Ref - The #Ref returned by add_listen_interface/2/3
+%% Returns : ok | {error, Reason}
+%% Raises :
+%% Description: Reconfigure the behavior of all incoming IIOP connections.
+%%----------------------------------------------------------------------
+reconfigure_in_connection(Options, Ref) ->
+ orber_iiop_net:reconfigure(Options, Ref).
+
+
+%%-----------------------------------------------------------------
+%% Configuration settings
+%%-----------------------------------------------------------------
+info() ->
+ orber_env:info().
+
+info(IoDevice) ->
+ orber_env:info(IoDevice).
+
+%%-----------------------------------------------------------------
+%% EXCEPTION mapping
+%%-----------------------------------------------------------------
+exception_info(Exc) ->
+ orber_exceptions:dissect(Exc).
+
+is_system_exception(Exc) ->
+ orber_exceptions:is_system_exception(Exc).
+
+%%-----------------------------------------------------------------
+%% Installation interface functions
+%%-----------------------------------------------------------------
+install(Nodes) ->
+ install(Nodes, []).
+
+install([], Options) ->
+ install([node()], Options);
+install(Nodes, Options) when is_list(Nodes) andalso is_list(Options)->
+ case orber_tb:is_running() of
+ false ->
+ application:load(orber),
+ case mnesia:system_info(is_running) of
+ no ->
+ application:start(mnesia),
+ Outcome = install_orber(Nodes, Options),
+ application:stop(mnesia),
+ Outcome;
+ yes ->
+ install_orber(Nodes, Options)
+ end;
+ _ ->
+ exit({error, "Orber is already running on this node."})
+ end.
+
+
+
+install_orber(Nodes, Options) ->
+ #options{ifr_storage_type = IFRType, install_timeout = Timeout,
+ local_content = LocalContent, nameservice_storage_type = NSType,
+ initialreferences_storage_type = InitType,
+ load_order = LoadOrder}
+ = check_options(Options, #options{}),
+ MnesiaOptions = [{local_content, LocalContent},
+ {load_order, LoadOrder}],
+ TableTest = test_tables(),
+ case lists:member(is_member, TableTest) of
+ true ->
+ case LocalContent of
+ true ->
+ orber_ifr:initialize(Timeout, {localCopy,IFRType},
+ light_ifr());
+ _->
+ exit("Orber Mnesia Table(s) already exist. Cannot install Orber.")
+ end;
+ _ ->
+ orber_ifr:initialize(Timeout, [{IFRType, Nodes} |MnesiaOptions],
+ light_ifr())
+ end,
+ orber_objectkeys:install(Timeout, [{ram_copies, Nodes} |MnesiaOptions]),
+ 'CosNaming_NamingContextExt_impl':install(Timeout, [{NSType, Nodes} |MnesiaOptions]),
+ orber_initial_references:install(Timeout, [{InitType, Nodes} |MnesiaOptions]),
+ oe_cos_naming:oe_register(),
+ oe_cos_naming_ext:oe_register(),
+ oe_erlang:oe_register(),
+ oe_OrberIFR:oe_register(),
+ oe_CORBA:oe_register(),
+ case NSType of
+ ram_copies ->
+ case mnesia:dump_tables(['orber_CosNaming']) of
+ {atomic, ok} ->
+ ok;
+ {aborted, {has_no_disc,_}} ->
+ ok;
+ {aborted, Reason} ->
+ ?EFORMAT("Unable to dump mnesia tables: ~p", [Reason])
+ end;
+ _ ->
+ ok
+ end.
+
+check_options([], Options) ->
+ Options;
+check_options([{ifr_storage_type, Type}|T], Options)
+ when Type == disc_copies; Type == ram_copies ->
+ check_options(T, Options#options{ifr_storage_type = Type});
+check_options([{nameservice_storage_type, Type}|T], Options)
+ when Type == disc_copies; Type == ram_copies ->
+ check_options(T, Options#options{nameservice_storage_type = Type});
+check_options([{initialreferences_storage_type, Type}|T], Options)
+ when Type == disc_copies; Type == ram_copies ->
+ check_options(T, Options#options{initialreferences_storage_type = Type});
+check_options([{install_timeout, Timeout}|T], Options)
+ when Timeout == infinity orelse is_integer(Timeout) ->
+ check_options(T, Options#options{install_timeout = Timeout});
+check_options([{local_content, Bool}|T], Options)
+ when Bool == true; Bool == false ->
+ check_options(T, Options#options{local_content = Bool});
+check_options([{type, Type}|T], Options)
+ when Type == temporary; Type == permanent ->
+ check_options(T, Options#options{type = Type});
+check_options([{load_order, LoadOrder}|T], Options)
+ when is_integer(LoadOrder) ->
+ check_options(T, Options#options{load_order = LoadOrder});
+check_options([H|_], _) ->
+ ?EFORMAT("Option unknown or incorrect value: ~w", [H]).
+
+
+
+try_starting(Type) ->
+ case application:start(orber, Type) of
+ ok ->
+ case partial_security() of
+ true ->
+ error_logger:warning_msg(
+ "=================== Orber =================~n"
+ "*******************************************~n"
+ "**** WARNING - WARNING - WARNING **********~n"
+ "**** WARNING - WARNING - WARNING **********~n"
+ "**** WARNING - WARNING - WARNING **********~n"
+ "**** WARNING - WARNING - WARNING **********~n"
+ "*******************************************~n"
+ " ORBER STARTED WITH AN INSECURE OPTION:~n"
+ " ~n"
+ " {flags, ~p}~n"
+ " ~n"
+ " THIS OPTION MAY ONLY BE USED DURING TESTS~n"
+ " ~n"
+ "===========================================~n",
+ [?ORB_ENV_PARTIAL_SECURITY]),
+ ok;
+ false ->
+ ok
+ end;
+ {error,{already_started,orber}} ->
+ {error,{already_started,orber}};
+ Reason ->
+ dbg("[~p] orber:try_starting(~p) failed: ~n~p",
+ [?LINE, Type, Reason], ?DEBUG_LEVEL),
+ {error, "Unable to start Orber. Is the listen port vacant?"}
+ end.
+
+test_tables() ->
+ AllTabs = mnesia:system_info(tables),
+ lists:map(fun(Tab) ->
+ case lists:member(Tab,AllTabs) of
+ false ->
+ not_member;
+ _ ->
+ is_member
+ end
+ end,
+ get_tables()).
+
+%%-----------------------------------------------------------------
+%% UnInstallation interface functions
+%%-----------------------------------------------------------------
+uninstall() ->
+ orber_objectkeys:stop_all(),
+ application:stop(orber),
+ delete_orber_tables(get_tables()).
+
+delete_orber_tables([]) -> ok;
+delete_orber_tables([Tab1|Rest]) ->
+ mnesia:delete_table(Tab1),
+ delete_orber_tables(Rest).
+
+%%-----------------------------------------------------------------
+%% Add and remove node interface functions
+%%-----------------------------------------------------------------
+add_node(Node, StorageType) when is_atom(Node) andalso is_atom(StorageType) ->
+ add_node(Node, [{ifr_storage_type, StorageType}]);
+add_node(Node, OptionList) when is_atom(Node) andalso is_list(OptionList) ->
+ case rpc:call(Node, mnesia, system_info, [is_running]) of
+ {badrpc, Reason} ->
+ ?EFORMAT("Node ~p do not respond. add_node/2 failed: ~p",
+ [Node, Reason]);
+ yes ->
+ case rpc:call(Node, orber, is_running, []) of
+ false ->
+ %% We need to "load" orber to make sure that
+ %% application environment variables is loaded.
+ rpc:call(Node, application, load, [orber]),
+ Options = check_options(OptionList, #options{}),
+ case rpc:call(Node, orber, light_ifr, []) of
+ false ->
+ copy_tables(?ifr_object_list, Node, Options);
+ true ->
+ copy_tables(?ifr_light_object_list, Node, Options)
+ end;
+ true ->
+ ?EFORMAT("Orber is already running on ~p. add_node failed.",
+ [Node]);
+ Reason ->
+ ?EFORMAT("Unable to reach node ~p. add_node/1 failed: ~p",
+ [Node, Reason])
+ end;
+ no ->
+ ?EFORMAT("Mnesia not running on node ~p. add_node/2 failed.",
+ [Node]);
+ starting ->
+ ?EFORMAT("Mnesia not fully started on node ~p. add_node/2 failed.",
+ [Node]);
+ stopping ->
+ ?EFORMAT("Mnesia stopping on node ~p. add_node/2 failed.", [Node])
+ end.
+
+%% We have to copy the tables in two steps, i.e., orber tables should be ram_copies
+%% while the user may choose to install the rest as disc_copies.
+copy_tables([], Node, Options) ->
+ copy_orber_tables(?ORBER_TABS, Node, Options);
+copy_tables([T1|Trest], Node, Options) ->
+ case mnesia:add_table_copy(T1, Node, Options#options.ifr_storage_type) of
+ {atomic, ok} ->
+ copy_tables(Trest, Node, Options);
+ {aborted, Reason} ->
+ ?EFORMAT("orber:add_node/2 failed: ~p. Unable to copy IFR table(s): ~p",
+ [mnesia:error_description(Reason), [T1|Trest]])
+ end.
+
+copy_orber_tables([], Node, Options) ->
+ case rpc:call(Node, application, start, [orber, Options#options.type]) of
+ ok ->
+ ok;
+ Reason ->
+ ?EFORMAT("All tables installed but failed to start orber on node ~p: ~p",
+ [Node, Reason])
+ end;
+copy_orber_tables([orber_CosNaming|TTail], Node, Options) ->
+ case mnesia:add_table_copy(orber_CosNaming, Node,
+ Options#options.nameservice_storage_type) of
+ {atomic, ok} ->
+ copy_orber_tables(TTail, Node, Options);
+ {aborted, Reason} ->
+ ?EFORMAT("orber:add_node/2 failed: ~p. Unable to copy system table(s): ~p",
+ [mnesia:error_description(Reason), [orber_CosNaming|TTail]])
+ end;
+copy_orber_tables([orber_references|TTail], Node, Options) ->
+ case mnesia:add_table_copy(orber_references, Node,
+ Options#options.initialreferences_storage_type) of
+ {atomic, ok} ->
+ copy_orber_tables(TTail, Node, Options);
+ {aborted, Reason} ->
+ ?EFORMAT("orber:add_node/2 failed: ~p. Unable to copy system table(s): ~p",
+ [mnesia:error_description(Reason), [orber_references|TTail]])
+ end;
+copy_orber_tables([THead|TTail], Node, Options) ->
+ case mnesia:add_table_copy(THead, Node, ram_copies) of
+ {atomic, ok} ->
+ copy_orber_tables(TTail, Node, Options);
+ {aborted, Reason} ->
+ ?EFORMAT("orber:add_node/2 failed: ~p. Unable to copy system table(s): ~p",
+ [mnesia:error_description(Reason), [THead|TTail]])
+ end.
+
+remove_node(Node) when is_atom(Node) ->
+ case rpc:call(Node, mnesia, system_info, [is_running]) of
+ yes ->
+ case rpc:call(Node, orber, is_running, []) of
+ true ->
+ rpc:call(Node, orber, stop, []),
+ remove_tables(get_tables(), Node);
+ false ->
+ remove_tables(get_tables(), Node);
+ Reason ->
+ ?EFORMAT("Unable to reach node: ~p. remove_node/1 failed: ~p",
+ [Node, Reason])
+ end;
+ no ->
+ case rpc:call(Node, mnesia, start, []) of
+ ok ->
+ remove_tables(get_tables(), Node),
+ rpc:call(Node, mnesia, stop, []);
+ Reason ->
+ ?EFORMAT("Unable to reach node: ~p. remove_node/1 failed: ~p",
+ [Node, Reason])
+ end;
+ Reason ->
+ ?EFORMAT("Problem with ~p. remove_node/1 failed: ~p", [Node, Reason])
+ end.
+
+
+remove_tables(Tables, Node) ->
+ remove_tables(Tables, Node, []).
+
+remove_tables([], _, []) -> ok;
+remove_tables([], Node, Failed) ->
+ ?EFORMAT("orber:remove_node(~p) failed. Unable to remove table(s): ~p",
+ [Node, Failed]);
+remove_tables([T1|Trest], Node, Failed) ->
+ case mnesia:del_table_copy(T1, Node) of
+ {atomic, ok} ->
+ remove_tables(Trest, Node, Failed);
+ {aborted, Reason} ->
+ remove_tables(Trest, Node, [{T1, Reason}|Failed])
+ end.
+
+
+
+%%-----------------------------------------------------------------
+%% Internal interface functions
+%%-----------------------------------------------------------------
+%%----------------------------------------------------------------------
+%% Function : is_running
+%% Arguments :
+%% Returns :
+%% Raises :
+%% Description:
+%%----------------------------------------------------------------------
+is_running() ->
+ orber_tb:is_running().
+
+%%----------------------------------------------------------------------
+%% Function : check_giop
+%% Arguments :
+%% Returns :
+%% Raises :
+%% Description:
+%%----------------------------------------------------------------------
+check_giop_version() ->
+ case giop_version() of
+ {1,0} ->
+ ok;
+ {1,1} ->
+ ok;
+ {1,2} ->
+ ok;
+ X ->
+ X
+ end.
+
+%%----------------------------------------------------------------------
+%% Function : dbg
+%% Arguments :
+%% Returns :
+%% Raises :
+%% Description: Note, dbg replaces debug_level_print.
+%%
+%% The following levels are used (0-10):
+%% 10: cdrlib.erl
+%% 9: cdr_encode.erl cdr_decode.erl orber_ifr.erl orber_pi.erl
+%% 8: orber_iiop_outrequest.erl orber_iiop_inrequest.erl
+%% 7: orber_iiop_outproxy.erl orber_iiop_inproxy.erl
+%% 6: iop_ior.erl, orber_objectkeys.erl, Orber_IFR_impl.erl orber_socket.erl
+%% 5: corba.erl, corba_boa.erl, corba_object.erl
+%% 4: Reserved for Cos-services!
+%% 3: Reserved for Cos-services!
+%% 2: Reserved for client applications!
+%% 1: Reserved for client applications!
+%% 0: No logging!
+%%
+%% A higher value will result in a finer granularity.
+%%----------------------------------------------------------------------
+get_debug_level() ->
+ orber_env:get_debug_level().
+
+debug_level_print(Format, Data, RequestedLevel) ->
+ dbg(Format, Data, RequestedLevel).
+
+dbg(Format, Data, RequestedLevel) ->
+ case orber_env:get_debug_level() of
+ 0 ->
+ ok;
+ Level when is_integer(Level) andalso Level >= RequestedLevel ->
+ if
+ RequestedLevel > 4 ->
+ %% Use catch if incorrect format used somewhere.
+ catch error_logger:error_msg("=================== Orber =================~n"++
+ Format++
+ "~n===========================================~n",
+ Data);
+ RequestedLevel > 2 ->
+ %% Use catch if incorrect format used somewhere.
+ catch error_logger:error_msg("=========== Orber COS Application =========~n"++
+ Format++
+ "~n===========================================~n",
+ Data);
+ true ->
+ %% Use catch if incorrect format used somewhere.
+ catch error_logger:error_msg("========== Orber Client Application =======~n"++
+ Format++
+ "~n===========================================~n",
+ Data)
+ end,
+ ok;
+ _ ->
+ ok
+ end.
+
+error(Format, Data, RequestedLevel) ->
+ if
+ RequestedLevel > 4 ->
+ %% Use catch if incorrect format used somewhere.
+ catch error_logger:error_msg("=================== Orber =================~n"++
+ Format++
+ "~n===========================================~n",
+ Data);
+ RequestedLevel > 2 ->
+ %% Use catch if incorrect format used somewhere.
+ catch error_logger:error_msg("=========== Orber COS Application =========~n"++
+ Format++
+ "~n===========================================~n",
+ Data);
+ true ->
+ %% Use catch if incorrect format used somewhere.
+ catch error_logger:error_msg("========== Orber Client Application =======~n"++
+ Format++
+ "~n===========================================~n",
+ Data)
+ end,
+ ok.
+
+configure(Key, Value) ->
+ orber_env:configure(Key, Value, check).
+
+configure_override(Key, Value) ->
+ orber_env:configure(Key, Value, loaded).
+
+multi_configure(KeyValueList) ->
+ orber_env:multi_configure(KeyValueList).
+
+
+%%-----------------------------------------------------------------
+%% Server functions
+%%-----------------------------------------------------------------
+start(_, _) ->
+ supervisor:start_link({local, orber_sup}, orber, orb_init).
+
+init(orb_init) ->
+ case check_giop_version() of
+ ok ->
+ case is_lightweight() of
+ true ->
+ SupFlags = {one_for_one, 5, 1000},
+ ChildSpec = [
+ {orber_iiop_sup, {orber_iiop, start_sup, [[]]},
+ permanent,
+ 10000, supervisor, [orber_iiop]},
+ {orber_reqno, {orber_request_number, start,
+ [[]]},
+ permanent,
+ 10000, worker, [orber_request_number]}
+ ],
+ {ok, {SupFlags, ChildSpec}};
+ false ->
+ case orber_tb:wait_for_tables(get_tables()) of
+ ok ->
+ orber_objectkeys:remove_old_keys(),
+ SupFlags = {one_for_one, 5, 1000},
+ ChildSpec = [
+ {orber_iiop_sup, {orber_iiop, start_sup, [[]]},
+ permanent,
+ 10000, supervisor, [orber_iiop]},
+ {orber_init, {orber_initial_references, start,
+ [[]]},
+ permanent,
+ 10000, worker, [orber_initial_references]},
+ {orber_reqno, {orber_request_number, start,
+ [[]]},
+ permanent,
+ 10000, worker, [orber_request_number]},
+ {orber_objkeyserver, {orber_objectkeys, start,
+ [[orber_nodes(), 0]]},
+ permanent,
+ 10000, worker, [orber_objectkeys]},
+ {orber_env, {orber_env, start, [[]]},
+ permanent, 10000, worker, [orber_env]}
+ ],
+ {ok, {SupFlags, ChildSpec}};
+ StopReason ->
+ {stop, StopReason}
+ end
+ end;
+ X ->
+ {stop, ?FORMAT("GIOP ~p not an implemeted version", [X])}
+ end.
+
diff --git a/lib/orber/src/orber_acl.erl b/lib/orber/src/orber_acl.erl
new file mode 100644
index 0000000000..5c696a9b2a
--- /dev/null
+++ b/lib/orber/src/orber_acl.erl
@@ -0,0 +1,396 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_acl.erl
+%%
+%% Description:
+%% Handling ACL's (Access Control Lists).
+%%
+%% Creation date: 040723
+%%
+%%-----------------------------------------------------------------
+-module(orber_acl).
+
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/src/orber_iiop.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([init_acl/1, init_acl/2, clear_acl/0,
+ match/2, match/3, verify/3, range/1, range/2]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-define(ACL_DB, orber_acl_db).
+
+-define(DEBUG_LEVEL, 5).
+-define(CONTINUE, -1).
+-define(STOP, -2).
+
+-define(FORMAT(_F, _A), {error, lists:flatten(io_lib:format(_F, _A))}).
+-define(EFORMAT(_F, _A), exit(lists:flatten(io_lib:format(_F, _A)))).
+
+%%-----------------------------------------------------------------
+%% Record Definitions
+%%-----------------------------------------------------------------
+-record(acl, {key, bits = ?CONTINUE, mask, interfaces = [],
+ ports = 0, flags = 0}).
+
+%%-----------------------------------------------------------------
+%% External functions
+%%-----------------------------------------------------------------
+
+%%-----------------------------------------------------------------
+%% function : verify/1
+%% Arguments: IP - string()
+%% Filter - string() see init_acl
+%% Family - inet | inet6
+%% Returns : boolean()
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+verify(IP, Filter, Family) ->
+ DB = ets:new(orber_temporary_acl_table_created_by_user,
+ [set, public, {keypos, 2}]),
+ Result =
+ case catch verify_helper(IP, Filter, Family, DB) of
+ true ->
+ true;
+ {ok, Low, High} ->
+ {false, Low, High};
+ What ->
+ {error, ?FORMAT("Uknown Error: ~p\n", [What])}
+ end,
+ ets:delete(DB),
+ Result.
+
+verify_helper(IP, Filter, Family, DB) ->
+ init_acl([{tcp_in, Filter}], Family, DB),
+ {ok, IPTuple} = inet:getaddr(IP, Family),
+ case match_helper(tuple_to_list(IPTuple), tcp_in, DB, false, tcp_in) of
+ true ->
+ true;
+ false ->
+ range(Filter, Family)
+ end.
+
+%%-----------------------------------------------------------------
+%% function : range/1/2
+%% Arguments: Filter - string(). See init_acl
+%% Family - inet | inet6
+%% Returns : {ok, From, To}
+%% From - To - string()
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+range(Filter) ->
+ range(Filter, inet).
+
+range(Filter, inet) ->
+ range_safe(Filter, inet, ".", 16#FF, "255", 8, "~p.", "~p", 3);
+range(Filter, Family) ->
+ range_safe(Filter, Family, ":", 16#FFFF, "FFFF", 16, "~.16B:", "~.16B", 7).
+
+range_safe(Filter, Family, Separator, Max, MaxStr, N, F1, F2, X) ->
+ case catch range_helper(Filter, Family, Separator, Max, MaxStr, N, F1, F2, X) of
+ {ok, Low, High} ->
+ {ok, Low, High};
+ {'EXIT',{format,Why}} ->
+ {error, ?FORMAT("Unable to format string: ~p\n", [Why])};
+ {'EXIT', E} ->
+ {error, ?FORMAT("Exit: ~p\n", [E])};
+ What ->
+ {error, ?FORMAT("Unknown Error: ~p\n", [What])}
+ end.
+
+range_helper(Filter, Family, Separator, Max, MaxStr, N, F1, F2, X) ->
+ {MaskStr, Bits, _Ports} = tokenize(Filter, Family),
+ {ok, MaskTuple} = inet:getaddr(MaskStr, Family),
+ NoOfFull = Bits div N,
+ Mask = get_mask(N, (Bits rem N)),
+ case split(NoOfFull, tuple_to_list(MaskTuple)) of
+ {Full, [Partial|_DontCare]} ->
+ Beginning = pp(Full, [], F1),
+ MiddleLow = io_lib:format(F2, [(Mask band Partial) + ((Mask bxor Max) band 0)]),
+ MiddleHigh = io_lib:format(F2, [(Mask band Partial) + ((Mask bxor Max) band Max)]),
+ EndLow = lists:duplicate((X-NoOfFull), Separator ++ "0"),
+ EndHigh = lists:duplicate((X-NoOfFull), Separator ++ MaxStr),
+ Low = lists:flatten([Beginning, MiddleLow, EndLow]),
+ High = lists:flatten([Beginning, MiddleHigh, EndHigh]),
+ {ok, Low, High};
+ {Full, []} ->
+ Address = lists:flatten(pp(Full, [], F1)),
+ {ok, Address, Address}
+ end.
+
+pp([], Acc, _) ->
+ Acc;
+pp([H|T], Acc, Format) ->
+ pp(T, Acc ++ io_lib:format(Format, [H]), Format).
+
+split(N, List) when is_integer(N) andalso N >= 0 andalso is_list(List) ->
+ case split(N, List, []) of
+ Fault when is_atom(Fault) ->
+ erlang:error(Fault, [N,List]);
+ Result ->
+ Result
+ end;
+split(N, List) ->
+ erlang:error(badarg, [N,List]).
+
+split(0, L, R) ->
+ {lists:reverse(R, []), L};
+split(N, [H|T], R) ->
+ split(N-1, T, [H|R]);
+split(_, [], _) ->
+ badarg.
+
+
+%%-----------------------------------------------------------------
+%% function : clear_acl/0
+%% Arguments: -
+%% Returns :
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+clear_acl() ->
+ clear_acl(?ACL_DB).
+clear_acl(DB) ->
+ (catch ets:delete(DB)),
+ ok.
+
+%%-----------------------------------------------------------------
+%% function : init_acl/1/2
+%% Arguments: Filters - [{Direction, Filter}] | [{Direction, Filter, [Interfaces]}]
+%% Direction - tcp_in | ssl_in | tcp_out | ssl_out
+%% Filter - string(). Examples:
+%% * "123.456.789.10" - match against all bits.
+%% * "123.456.789.10/17" - match against the 17 most significant bits.
+%% * "123.456.789.10/17#4001" - as above but only allow port 4001
+%% * "123.456.789.10/17#4001/5001" - as above but only allow port 4001-5001
+%% Family - inet | inet6
+%% Returns : ok | {'EXCEPTION', E}
+%% Exception: 'BAD_PARAM'
+%% Effect :
+%%-----------------------------------------------------------------
+init_acl(Filters) ->
+ DB = ets:new(?ACL_DB, [set, public, named_table, {keypos, 2}]),
+ case ?ORB_FLAG_TEST(orber:get_flags(), ?ORB_ENV_USE_IPV6) of
+ false ->
+ init_acl(Filters, inet, DB);
+ true ->
+ init_acl(Filters, inet6, DB)
+ end.
+
+init_acl(Filters, Family) ->
+ DB = ets:new(?ACL_DB, [set, public, named_table, {keypos, 2}]),
+ init_acl(Filters, Family, DB).
+
+init_acl([], _, DB) ->
+ {ok, DB};
+init_acl([Data|T], Family, DB) ->
+ {Direction, Filter, Interfaces} =
+ case Data of
+ {D, F, I} ->
+ {D, F, I};
+ {D, F} ->
+ {D, F, []}
+ end,
+ {MaskStr, Bits, Ports} = tokenize(Filter, Family),
+ case inet:getaddr(MaskStr, Family) of
+ {ok, Addr} when size(Addr) == 4 ->
+ create_mask(tuple_to_list(Addr), Bits div 8,
+ get_mask8((Bits rem 8)), DB, Direction, Interfaces, Ports),
+ init_acl(T, Family, DB);
+ {ok, Addr} ->
+ create_mask(tuple_to_list(Addr), Bits div 16,
+ get_mask16((Bits rem 16)), DB, Direction, Interfaces, Ports),
+ init_acl(T, Family, DB)
+ end.
+
+create_mask(List, Div, Mask, DB, Direction, Interfaces, Ports) ->
+ case split(Div, List) of
+ {[], [Partial|_DontCare]} ->
+ %% Less than 8/16 bits (depends on family).
+ add_parts([], Direction, (Partial band Mask), Mask, DB,
+ Interfaces, Ports);
+ {Full, [Partial|_DontCare]} ->
+ add_parts(Full, Direction, (Partial band Mask), Mask, DB,
+ Interfaces, Ports);
+ {Full, []} ->
+ %% 32 bits.
+ add_parts(Full, Direction, ?STOP, Mask, DB, Interfaces, Ports)
+ end.
+
+add_parts([], Parent, Bits, Mask, DB, Interfaces, Ports) ->
+ ets:insert(DB, #acl{key = Parent, bits = Bits,
+ mask = Mask, interfaces = Interfaces, ports = Ports});
+add_parts([H|T], Parent, Bits, Mask, DB, Interfaces, Ports) ->
+ Key = {Parent, H},
+ ets:insert(DB, #acl{key = Key}),
+ add_parts(T, Key, Bits, Mask, DB, Interfaces, Ports).
+
+
+%%-----------------------------------------------------------------
+%% function : match/1/2
+%% Arguments: IP - tuple() | [integer()]
+%% Direction - tcp_in | ssl_in | tcp_out | ssl_out
+%% All - boolean()
+%% Returns :
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+match(IPTuple, Direction) when is_tuple(IPTuple) ->
+ match_helper(tuple_to_list(IPTuple), Direction, ?ACL_DB, false, Direction);
+match(IPList, Direction) ->
+ match_helper(IPList, Direction, ?ACL_DB, false, Direction).
+
+match(IPTuple, Direction, All) when is_tuple(IPTuple) ->
+ match_helper(tuple_to_list(IPTuple), Direction, ?ACL_DB, All, Direction);
+match(IPList, Direction, All) ->
+ match_helper(IPList, Direction, ?ACL_DB, All, Direction).
+
+match_helper([], _, _, false, _) -> false;
+match_helper([], _, _, true, _) -> {false, [], 0};
+match_helper([H|T], Parent, DB, All, Direction) ->
+ case ets:lookup(DB, {Parent, H}) of
+ [#acl{bits = ?CONTINUE}] ->
+ match_helper(T, {Parent, H}, DB, All, Direction);
+ [#acl{bits = ?STOP}] when All == false ->
+ true;
+ [#acl{bits = ?STOP, interfaces = I, ports = Ports}] ->
+ {true, I, Ports};
+ [#acl{bits = Bits, mask = Mask}] when All == false ->
+ Bits == (hd(T) band Mask);
+ [#acl{bits = Bits, mask = Mask, interfaces = I, ports = Ports}] ->
+ {Bits == (hd(T) band Mask), I, Ports};
+ _ ->
+ %% Less than 8/16 significant bits (depends on family).
+ %% Should we even allow this?
+ case ets:lookup(DB, Direction) of
+ [#acl{bits = Bits, mask = Mask}] when is_integer(Bits) andalso
+ All == false ->
+ Bits == (H band Mask);
+ [#acl{bits = Bits, mask = Mask,
+ interfaces = I, ports = Ports}] when is_integer(Bits) ->
+ {Bits == (H band Mask), I, Ports};
+ _ when All == false ->
+ false;
+ _ ->
+ {false, [], 0}
+ end
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Internal functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% function : tokenize/1
+%% Arguments: Filter - string(). Examples:
+%% * "123.456.789.10" - match against all.
+%% * "123.456.789.10/17" - match against the 17 most significant bits.
+%% * "123.456.789.10/17#4001" - as above but only allow port 4001
+%% * "123.456.789.10/17#4001/5001" - as above but only allow port 4001-5001
+%% Family - inet | inet6
+%% Returns : {MaskStr, Bits, Ports}
+%% MaskStr - string()
+%% Bits - integer()
+%% Ports - integer() | {integer(), integer()}
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+tokenize(Filter, Family) ->
+ case string:tokens(Filter, "/#") of
+ [MaskStr] when Family == inet ->
+ {MaskStr, 32, 0};
+ [MaskStr] when Family == inet6 ->
+ {MaskStr, 128, 0};
+ [MaskStr, BitString] ->
+ {MaskStr, list_to_integer(BitString), 0};
+ [MaskStr, BitString, Port] ->
+ {MaskStr, list_to_integer(BitString), list_to_integer(Port)};
+ [MaskStr, BitString, MinPort, MaxPort] ->
+ {MaskStr, list_to_integer(BitString),
+ {list_to_integer(MinPort), list_to_integer(MaxPort)}};
+ What ->
+ ?EFORMAT("Invalid Filter: ~p\nReason: ~p\n", [Filter, What])
+ end.
+
+
+%%-----------------------------------------------------------------
+%% function : get_mask/2
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+get_mask(8, Bits) ->
+ get_mask8(Bits);
+get_mask(16, Bits) ->
+ get_mask16(Bits).
+
+%%-----------------------------------------------------------------
+%% function : get_mask8/1
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+get_mask8(0) -> 2#00000000;
+get_mask8(1) -> 2#10000000;
+get_mask8(2) -> 2#11000000;
+get_mask8(3) -> 2#11100000;
+get_mask8(4) -> 2#11110000;
+get_mask8(5) -> 2#11111000;
+get_mask8(6) -> 2#11111100;
+get_mask8(7) -> 2#11111110.
+
+%%-----------------------------------------------------------------
+%% function : get_mask16/1
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+get_mask16(0) -> 2#0000000000000000;
+get_mask16(1) -> 2#1000000000000000;
+get_mask16(2) -> 2#1100000000000000;
+get_mask16(3) -> 2#1110000000000000;
+get_mask16(4) -> 2#1111000000000000;
+get_mask16(5) -> 2#1111100000000000;
+get_mask16(6) -> 2#1111110000000000;
+get_mask16(7) -> 2#1111111000000000;
+get_mask16(8) -> 2#1111111100000000;
+get_mask16(9) -> 2#1111111110000000;
+get_mask16(10) -> 2#1111111111000000;
+get_mask16(11) -> 2#1111111111100000;
+get_mask16(12) -> 2#1111111111110000;
+get_mask16(13) -> 2#1111111111111000;
+get_mask16(14) -> 2#1111111111111100;
+get_mask16(15) -> 2#1111111111111110.
+
+
+%%-----------------------------------------------------------------
+%%------------- END OF MODULE -------------------------------------
+%%-----------------------------------------------------------------
diff --git a/lib/orber/src/orber_diagnostics.erl b/lib/orber/src/orber_diagnostics.erl
new file mode 100644
index 0000000000..c12dbfa896
--- /dev/null
+++ b/lib/orber/src/orber_diagnostics.erl
@@ -0,0 +1,240 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_diagnostics.erl
+%%
+%% Description:
+%%
+%%-----------------------------------------------------------------
+
+-module(orber_diagnostics).
+
+
+%%-----------------------------------------------------------------
+%% Includes
+%%-----------------------------------------------------------------
+-include_lib("orber/src/orber_iiop.hrl").
+-include_lib("orber/src/ifr_objects.hrl").
+-include_lib("orber/COSS/CosNaming/CosNaming.hrl").
+-include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl").
+-include_lib("orber/COSS/CosNaming/orber_cosnaming.hrl").
+
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([nameservice/0, nameservice/1,
+ objectkeys/0,
+ missing_modules/0]).
+
+%%-----------------------------------------------------------------
+%% Internal Exports
+%%-----------------------------------------------------------------
+-export([]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+
+%%-----------------------------------------------------------------
+%% Macros
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 5).
+
+-define(DIAGNOSTICS_PING_EXTERNAL, 16#01).
+
+%%-----------------------------------------------------------------
+%% Function : missing_modules
+%% Args : -
+%% Returns :
+%%-----------------------------------------------------------------
+missing_modules() ->
+ List =
+ case orber:light_ifr() of
+ false ->
+ Unions = mnesia:dirty_select(ir_UnionDef,
+ [{#ir_UnionDef{absolute_name='$1',
+ _='_'},
+ [], ['$1']}]),
+ Structs = mnesia:dirty_select(ir_StructDef,
+ [{#ir_StructDef{absolute_name='$1',
+ _='_'},
+ [], ['$1']}]),
+ Exc = mnesia:dirty_select(ir_ExceptionDef,
+ [{#ir_ExceptionDef{absolute_name='$1',
+ _='_'},
+ [], ['$1']}]),
+ Interface = mnesia:dirty_select(ir_InterfaceDef,
+ [{#ir_InterfaceDef{absolute_name='$1',
+ _='_'},
+ [], ['$1']}]),
+ Acc1 = create_module_names(Unions, [], ?IFR_UnionDef),
+ Acc2 = create_module_names(Structs, Acc1, ?IFR_StructDef),
+ Acc3 = create_module_names(Exc, Acc2, ?IFR_ExceptionDef),
+ create_module_names(Interface, Acc3, ?IFR_InterfaceDef);
+ true ->
+ mnesia:dirty_select(orber_light_ifr,
+ [{#orber_light_ifr{module='$1',
+ type='$2', _='_'},
+ [{'=/=', '$2', ?IFR_ModuleDef},
+ {'=/=', '$2', ?IFR_ConstantDef},
+ {'=/=', '$2', ?IFR_AliasDef},
+ {'=/=', '$2', ?IFR_EnumDef}], ['$$']}])
+ end,
+ io:format("Need to check for ~p modules.~n", [length(List)]),
+ Count = missing_modules_helper(List, 0),
+ io:format("Check completed. ~p missing modules.~n", [Count]),
+ Count.
+
+create_module_names([], Acc, _) ->
+ Acc;
+create_module_names([[$:,$:|N]|T], Acc, Type) ->
+ create_module_names(T, [[change_colons_to_underscore(N, []), Type]|Acc], Type).
+
+change_colons_to_underscore([$:, $: | T], Acc) ->
+ change_colons_to_underscore(T, [$_ |Acc]);
+change_colons_to_underscore([H |T], Acc) ->
+ change_colons_to_underscore(T, [H |Acc]);
+change_colons_to_underscore([], Acc) ->
+ list_to_atom(lists:reverse(Acc)).
+
+missing_modules_helper([], ErrorsFound) ->
+ ErrorsFound;
+missing_modules_helper([[Mod, Type]|T], ErrorsFound) when Type == ?IFR_StructDef;
+ Type == ?IFR_UnionDef;
+ Type == ?IFR_ExceptionDef ->
+ case catch Mod:tc() of
+ {'EXIT', _} ->
+ io:format("Missing (~s): ~p~n", [type2str(Type), Mod]),
+ missing_modules_helper(T, ErrorsFound + 1);
+ _ ->
+ missing_modules_helper(T, ErrorsFound)
+ end;
+missing_modules_helper([[Mod, Type]|T], ErrorsFound) when Type == ?IFR_InterfaceDef ->
+ case catch Mod:oe_get_interface() of
+ {'EXIT', {undef,[{Mod, _, _}|_]}} ->
+ io:format("Missing (Interface): ~p~n", [Mod]),
+ missing_modules_helper(T, ErrorsFound + 1);
+ {'EXIT', {undef,[{OtherMod, _, _}|_]}} ->
+ io:format("Missing (Inherited by the ~p Interface): ~p~n",
+ [Mod, OtherMod]),
+ missing_modules_helper(T, ErrorsFound + 1);
+ _ ->
+ missing_modules_helper(T, ErrorsFound)
+ end;
+missing_modules_helper([_|T], ErrorsFound) ->
+ missing_modules_helper(T, ErrorsFound).
+
+type2str(?IFR_StructDef) ->
+ "Struct";
+type2str(?IFR_UnionDef) ->
+ "Union";
+type2str(?IFR_ExceptionDef) ->
+ "Exception".
+
+
+%%-----------------------------------------------------------------
+%% Function : nameservice
+%% Args : - | integer()
+%% Returns :
+%%-----------------------------------------------------------------
+nameservice() ->
+ nameservice(0).
+
+nameservice(Flags) ->
+ case catch ns(?ORB_FLAG_TEST(Flags, ?DIAGNOSTICS_PING_EXTERNAL)) of
+ ok ->
+ ok;
+ {'EXCEPTION', E} ->
+ orber:dbg("[~p] orber_diagnostics:nameservice(~p);~n"
+ "Reason: ~p", [?LINE, Flags, E], ?DEBUG_LEVEL),
+ corba:raise(E);
+ What ->
+ orber:dbg("[~p] orber_diagnostics:nameservice(~p);~n"
+ "Reason: ~p", [?LINE, Flags, What], ?DEBUG_LEVEL),
+ corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
+ end.
+
+ns(Ping) ->
+ NS = corba:resolve_initial_references("NameService"),
+ display_names(NS, "", Ping).
+
+
+display_names(NS, Prefix, Ping) ->
+ {ok, [], Iter} = 'CosNaming_NamingContextExt':list(NS, 0),
+ More = not corba_object:is_nil(Iter),
+ iter_names(NS, Prefix, Iter, More, Ping).
+
+iter_names(_NS, _Prefix, Iter, false, _) ->
+ destroy_iter(Iter);
+iter_names(NS, Prefix, Iter, true, Ping) ->
+ {More, #'CosNaming_Binding'{binding_name = Name, binding_type = Type}} =
+ 'CosNaming_BindingIterator':next_one(Iter),
+ Fun = fun(#'CosNaming_NameComponent'{id = Id, kind = Kind}, Acc) ->
+ case Kind of
+ "" -> Acc ++ Id ++ "/";
+ _ -> Acc ++ Id ++ "." ++ Kind ++ "/"
+ end
+ end,
+ Prefix2 = lists:foldl(Fun, Prefix, Name),
+ if
+ More == false ->
+ ignore;
+ Type == nobject ->
+ Object = 'CosNaming_NamingContext':resolve(NS, Name),
+ Status =
+ case corba_object:is_remote(Object) of
+ false ->
+ corba_object:non_existent(Object);
+ _ when Ping == true ->
+ case catch corba_object:non_existent(Object) of
+ Boolean when is_atom(Boolean) ->
+ Boolean;
+ _Other ->
+ undefined
+ end;
+ _ ->
+ external
+ end,
+ io:format("~s [~p] ~s\n",
+ [Prefix2, Status, iop_ior:get_typeID(Object)]);
+ Type == ncontext ->
+ Context = 'CosNaming_NamingContext':resolve(NS, Name),
+ io:format("~s\n", [Prefix2]),
+ display_names(Context, Prefix2, Ping)
+ end,
+ iter_names(NS, Prefix, Iter, More, Ping).
+
+destroy_iter(Iter) ->
+ case corba_object:is_nil(Iter) of
+ false ->
+ 'CosNaming_BindingIterator':destroy(Iter),
+ ok;
+ true ->
+ ok
+ end.
+
+objectkeys() ->
+ ok.
+
+
+
+%%---------------- END OF MODULE ----------------------------------
diff --git a/lib/orber/src/orber_env.erl b/lib/orber/src/orber_env.erl
new file mode 100644
index 0000000000..79f852eee0
--- /dev/null
+++ b/lib/orber/src/orber_env.erl
@@ -0,0 +1,1456 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_env.erl
+%%
+%% Description:
+%% Handling environment parameters for Orber.
+%%
+%% Creation date: 040723
+%%
+%%-----------------------------------------------------------------
+-module(orber_env).
+
+-behaviour(gen_server).
+
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/src/orber_iiop.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start/1, configure/2, configure/3, configure_override/2,
+ multi_configure/1, get_env/1, set_env/2, get_keys/0, env/1,
+ info/0, info/1]).
+
+-export([iiop_acl/0, iiop_port/0, nat_iiop_port/0, nat_iiop_port/1, iiop_out_ports/0,
+ domain/0, ip_address_variable_defined/0, nat_host/0, nat_host/1, host/0,
+ ip_address/0, ip_address/1, giop_version/0, iiop_timeout/0,
+ iiop_connection_timeout/0, iiop_setup_connection_timeout/0,
+ iiop_in_connection_timeout/0, iiop_max_fragments/0, iiop_max_in_requests/0,
+ iiop_max_in_connections/0, iiop_backlog/0, objectkeys_gc_time/0,
+ get_ORBInitRef/0, get_ORBDefaultInitRef/0, get_interceptors/0,
+ get_local_interceptors/0, get_cached_interceptors/0,
+ set_interceptors/1, is_lightweight/0, get_lightweight_nodes/0, secure/0,
+ iiop_ssl_backlog/0, iiop_ssl_port/0, nat_iiop_ssl_port/0, nat_iiop_ssl_port/1,
+ ssl_server_certfile/0, ssl_client_certfile/0, set_ssl_client_certfile/1,
+ ssl_server_verify/0, ssl_client_verify/0, set_ssl_client_verify/1,
+ ssl_server_depth/0, ssl_client_depth/0, set_ssl_client_depth/1,
+ ssl_server_cacertfile/0, ssl_client_cacertfile/0,
+ set_ssl_client_cacertfile/1, ssl_client_password/0,
+ ssl_server_password/0, ssl_client_keyfile/0, ssl_server_keyfile/0,
+ ssl_client_ciphers/0, ssl_server_ciphers/0, ssl_client_cachetimeout/0,
+ ssl_server_cachetimeout/0, get_flags/0, typechecking/0,
+ exclude_codeset_ctx/0, exclude_codeset_component/0, partial_security/0,
+ use_CSIv2/0, use_FT/0, ip_version/0, light_ifr/0, bidir_context/0,
+ get_debug_level/0, getaddrstr/2, addr2str/1, iiop_packet_size/0,
+ iiop_ssl_ip_address_local/0, ip_address_local/0, iiop_in_keepalive/0,
+ iiop_out_keepalive/0, iiop_ssl_in_keepalive/0, iiop_ssl_out_keepalive/0,
+ iiop_ssl_accept_timeout/0, ssl_generation/0]).
+
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([init/1, terminate/2, handle_call/3]).
+-export([handle_cast/2, handle_info/2, code_change/3]).
+
+%%-----------------------------------------------------------------
+%% Record Definitions Etc.
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 5).
+
+-define(FORMAT(_F, _A), {error, lists:flatten(io_lib:format(_F, _A))}).
+-define(EFORMAT(_F, _A), exit(lists:flatten(io_lib:format(_F, _A)))).
+
+-define(ENV_DB, orber_env_db).
+
+-define(ENV_KEYS,
+ [flags, iiop_port, nat_iiop_port, iiop_out_ports, domain, ip_address,
+ nat_ip_address, giop_version, iiop_timeout, iiop_connection_timeout,
+ iiop_setup_connection_timeout, iiop_in_connection_timeout, iiop_acl,
+ iiop_max_fragments, iiop_max_in_requests, iiop_max_in_connections,
+ iiop_backlog, objectkeys_gc_time, orbInitRef, orbDefaultInitRef,
+ interceptors, local_interceptors, lightweight, ip_address_local,
+ secure, iiop_ssl_ip_address_local, iiop_ssl_backlog,
+ iiop_ssl_port, nat_iiop_ssl_port, ssl_server_certfile,
+ ssl_client_certfile, ssl_server_verify, ssl_client_verify, ssl_server_depth,
+ ssl_client_depth, ssl_server_cacertfile, ssl_client_cacertfile,
+ ssl_client_password, ssl_server_password, ssl_client_keyfile,
+ ssl_server_keyfile, ssl_client_ciphers, ssl_server_ciphers,
+ ssl_client_cachetimeout, ssl_server_cachetimeout, orber_debug_level,
+ iiop_packet_size, iiop_in_keepalive, iiop_out_keepalive,
+ iiop_ssl_in_keepalive, iiop_ssl_out_keepalive, iiop_ssl_accept_timeout]).
+
+%% The 'flags' parameter must be first in the list.
+%-define(ENV_KEYS,
+% [{flags, ?ORB_ENV_INIT_FLAGS}, {iiop_port, 4001}, nat_iiop_port,
+% {iiop_out_ports, 0}, {domain, "ORBER"}, ip_address, nat_ip_address,
+% {giop_version, {1, 1}}, {iiop_timeout, infinity},
+% {iiop_connection_timeout, infinity}, {iiop_setup_connection_timeout, infinity},
+% {iiop_in_connection_timeout, infinity}, {iiop_acl, []},
+% {iiop_max_fragments, infinity}, {iiop_max_in_requests, infinity},
+% {iiop_max_in_connections, infinity}, {iiop_backlog, 5},
+% {objectkeys_gc_time, infinity},
+% {orbInitRef, undefined}, {orbDefaultInitRef, undefined},
+% {interceptors, false}, {local_interceptors, false}, {lightweight, false},
+% {secure, no}, {iiop_ssl_backlog, 5}, {iiop_ssl_port, 4002},
+% nat_iiop_ssl_port, {ssl_server_certfile, []}, {ssl_client_certfile, []},
+% {ssl_server_verify, 0}, {ssl_client_verify, 0}, {ssl_server_depth, 1},
+% {ssl_client_depth, 1}, {ssl_server_cacertfile, []},
+% {ssl_client_cacertfile, []}, {ssl_client_password, []},
+% {ssl_server_password, []}, {ssl_client_keyfile, []},
+% {ssl_server_keyfile, []}, {ssl_client_ciphers, []},
+% {ssl_server_ciphers, []}, {ssl_client_cachetimeout, infinity},
+% {ssl_server_cachetimeout, infinity}, {orber_debug_level, 0}]).
+
+-record(parameters, {key, value, flags = 0}).
+
+-record(env, {acl, parameters, flags = 0}).
+
+
+%%-----------------------------------------------------------------
+%% External functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% function :
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+start(Opts) ->
+ gen_server:start_link({local, orber_env}, ?MODULE, Opts, []).
+
+%%-----------------------------------------------------------------
+%% function : get_keys
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+get_keys() ->
+ ?ENV_KEYS.
+
+%%-----------------------------------------------------------------
+%% function : get_env
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+get_env(Key) when is_atom(Key) ->
+ case catch ets:lookup(?ENV_DB, Key) of
+ [#parameters{value = Val}] ->
+ {ok, Val};
+ _ ->
+ undefined
+ end.
+
+%%-----------------------------------------------------------------
+%% function : get_env
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+set_env(Key, Value) when is_atom(Key) ->
+ case catch ets:insert(?ENV_DB, #parameters{key = Key, value = Value}) of
+ true ->
+ ok;
+ _ ->
+ undefined
+ end.
+
+
+%%-----------------------------------------------------------------
+%% function : info
+%% Arguments: IoDervice - info_msg | string | io | {io, Dev}
+%% Returns :
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+info() ->
+ info(info_msg).
+
+info(IoDevice) ->
+ Info =
+ case orber_tb:is_running() of
+ true ->
+ Info1 = create_main_info(),
+ Info2 = create_flag_info(Info1),
+ create_security_info(secure(), Info2);
+ _ ->
+ lists:flatten(
+ io_lib:format("======= Orber Execution Environment ======~n"
+ " *** Orber-~s is not running ***~n"
+ "==========================================~n",
+ [?ORBVSN]))
+ end,
+ case IoDevice of
+ info_msg ->
+ error_logger:info_msg(Info);
+ string ->
+ Info;
+ io ->
+ io:format("~s", [Info]);
+ {io, Dev} ->
+ io:format(Dev, "~s", [Info]);
+ _ ->
+ exit("Bad parameter")
+ end.
+
+create_main_info() ->
+ {Major, Minor} = giop_version(),
+ [io_lib:format("======= Orber Execution Environment ======~n"
+ "Orber version.................: ~s~n"
+ "Orber domain..................: ~s~n"
+ "IIOP port number..............: ~p~n"
+ "IIOP NAT port number..........: ~p~n"
+ "Interface(s)..................: ~p~n"
+ "Interface(s) NAT..............: ~p~n"
+ "Local Interface (default).....: ~p~n"
+ "Nodes in domain...............: ~p~n"
+ "GIOP version (default)........: ~p.~p~n"
+ "IIOP out timeout..............: ~p msec~n"
+ "IIOP out connection timeout...: ~p msec~n"
+ "IIOP setup connection timeout.: ~p msec~n"
+ "IIOP out ports................: ~p~n"
+ "IIOP out connections..........: ~p~n"
+ "IIOP out connections (pending): ~p~n"
+ "IIOP out keepalive............: ~p~n"
+ "IIOP in connections...........: ~p~n"
+ "IIOP in connection timeout....: ~p msec~n"
+ "IIOP in keepalive.............: ~p~n"
+ "IIOP max fragments............: ~p~n"
+ "IIOP max in requests..........: ~p~n"
+ "IIOP max in connections.......: ~p~n"
+ "IIOP backlog..................: ~p~n"
+ "IIOP ACL......................: ~p~n"
+ "IIOP maximum packet size......: ~p~n"
+ "Object Keys GC interval.......: ~p~n"
+ "Using Interceptors............: ~p~n"
+ "Using Local Interceptors......: ~p~n"
+ "Debug Level...................: ~p~n"
+ "orbInitRef....................: ~p~n"
+ "orbDefaultInitRef.............: ~p~n",
+ [?ORBVSN, domain(), iiop_port(), nat_iiop_port(), host(),
+ nat_host(), ip_address_local(),
+ orber:orber_nodes(), Major, Minor,
+ iiop_timeout(), iiop_connection_timeout(),
+ iiop_setup_connection_timeout(), iiop_out_ports(),
+ orber:iiop_connections(out), orber:iiop_connections_pending(),
+ iiop_out_keepalive(), orber:iiop_connections(in),
+ iiop_in_connection_timeout(), iiop_in_keepalive(),
+ iiop_max_fragments(), iiop_max_in_requests(),
+ iiop_max_in_connections(), iiop_backlog(), iiop_acl(),
+ iiop_packet_size(), objectkeys_gc_time(), get_interceptors(),
+ get_local_interceptors(), get_debug_level(), get_ORBInitRef(),
+ get_ORBDefaultInitRef()])].
+
+create_flag_info(Info) ->
+ case get_flags() of
+ ?ORB_ENV_INIT_FLAGS ->
+ [Info, "System Flags Set..............: -\n"];
+ Flags ->
+ FlagData = check_flags(?ORB_ENV_FLAGS, Flags, []),
+ [Info, "System Flags Set..............: \n", FlagData, "\n"]
+ end.
+
+check_flags([], _, Acc) ->
+ Acc;
+check_flags([{Flag, Txt}|T], Flags, Acc) when ?ORB_FLAG_TEST(Flags, Flag) ->
+ check_flags(T, Flags, [" - ", Txt, "\n"|Acc]);
+check_flags([_|T], Flags, Acc) ->
+ check_flags(T, Flags, Acc).
+
+
+create_security_info(no, Info) ->
+ lists:flatten([Info, "=========================================\n"]);
+create_security_info(ssl, Info) ->
+ lists:flatten([Info,
+ io_lib:format("ORB security..................: ssl~n"
+ "SSL generation................: ~p~n"
+ "SSL IIOP in keepalive.........: ~p~n"
+ "SSL IIOP out keepalive........: ~p~n"
+ "SSL IIOP port number..........: ~p~n"
+ "SSL IIOP NAT port number......: ~p~n"
+ "SSL IIOP accept timeout.......: ~p~n"
+ "SSL IIOP backlog..............: ~p~n"
+ "SSL IIOP Local Interface......: ~p~n"
+ "SSL server certfile...........: ~p~n"
+ "SSL server verification type..: ~p~n"
+ "SSL server verification depth.: ~p~n"
+ "SSL server cacertfile.........: ~p~n"
+ "SSL server keyfile............: ~p~n"
+ "SSL server password...........: ~p~n"
+ "SSL server ciphers............: ~p~n"
+ "SSL server cachetimeout.......: ~p~n"
+ "SSL client certfile...........: ~p~n"
+ "SSL client verification type..: ~p~n"
+ "SSL client verification depth.: ~p~n"
+ "SSL client cacertfile.........: ~p~n"
+ "SSL client keyfile............: ~p~n"
+ "SSL client password...........: ~p~n"
+ "SSL client ciphers............: ~p~n"
+ "SSL client cachetimeout.......: ~p~n"
+ "=========================================~n",
+ [ssl_generation(), iiop_ssl_port(),
+ iiop_ssl_in_keepalive(), iiop_ssl_out_keepalive(),
+ nat_iiop_ssl_port(), iiop_ssl_accept_timeout(),
+ iiop_ssl_backlog(), iiop_ssl_ip_address_local(),
+ ssl_server_certfile(), ssl_server_verify(),
+ ssl_server_depth(), ssl_server_cacertfile(),
+ ssl_server_keyfile(), ssl_server_password(),
+ ssl_server_ciphers(), ssl_server_cachetimeout(),
+ ssl_client_certfile(), ssl_client_verify(),
+ ssl_client_depth(), ssl_client_cacertfile(),
+ ssl_client_keyfile(), ssl_client_password(),
+ ssl_client_ciphers(), ssl_client_cachetimeout()])]).
+
+
+%%-----------------------------------------------------------------
+%% function : iiop_acl
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+iiop_acl() ->
+ case application:get_env(orber, iiop_acl) of
+ {ok, ACL} when is_list(ACL) ->
+ ACL;
+ _ ->
+ []
+ end.
+
+iiop_packet_size() ->
+ case application:get_env(orber, iiop_packet_size) of
+ {ok, Max} when is_integer(Max) andalso Max > 0 ->
+ Max;
+ _ ->
+ infinity
+ end.
+
+
+iiop_port() ->
+ case application:get_env(orber, iiop_port) of
+ {ok, Port} when is_integer(Port) andalso Port >= 0 ->
+ Port;
+ _ ->
+ 4001
+ end.
+
+nat_iiop_port() ->
+ case application:get_env(orber, nat_iiop_port) of
+ {ok, Port} when is_integer(Port) andalso Port > 0 ->
+ Port;
+ {ok, {local, Default, _NATList}} ->
+ Default;
+ _ ->
+ iiop_port()
+ end.
+
+nat_iiop_port(LocalPort) ->
+ case application:get_env(orber, nat_iiop_port) of
+ {ok, Port} when is_integer(Port) andalso Port > 0 ->
+ Port;
+ {ok, {local, Default, NATList}} ->
+ orber_tb:keysearch(LocalPort, NATList, Default);
+ _ ->
+ iiop_port()
+ end.
+
+iiop_out_ports() ->
+ case application:get_env(orber, iiop_out_ports) of
+ {ok, {Min, Max}} when is_integer(Min) andalso is_integer(Max) andalso Min =< Max ->
+ {Min, Max};
+ {ok, {Max, Min}} when is_integer(Min) andalso is_integer(Max) andalso Min < Max ->
+ {Min, Max};
+ _ ->
+ 0
+ end.
+
+domain() ->
+ case application:get_env(orber, domain) of
+ {ok, Domain} when is_list(Domain) ->
+ Domain;
+ {ok, Domain} when is_atom(Domain) ->
+ atom_to_list(Domain);
+ _ ->
+ "ORBER"
+ end.
+
+ip_address_variable_defined() ->
+ case application:get_env(orber, ip_address) of
+ undefined ->
+ false;
+ {ok,{multiple, _}} ->
+ false;
+ _ ->
+ [Host] = host(),
+ Host
+ end.
+
+nat_host() ->
+ case application:get_env(orber, nat_ip_address) of
+ {ok,I} when is_list(I) ->
+ [I];
+ {ok,{multiple, [I|_] = IList}} when is_list(I) ->
+ IList;
+ {ok,{local, Default, _NATList}} ->
+ [Default];
+ _ ->
+ host()
+ end.
+
+nat_host([Host]) ->
+ case application:get_env(orber, nat_ip_address) of
+ {ok,I} when is_list(I) ->
+ [I];
+ {ok,{multiple, [I|_] = IList}} when is_list(I) ->
+ IList;
+ {ok,{local, Default, NATList}} ->
+ [orber_tb:keysearch(Host, NATList, Default)];
+ _ ->
+ host()
+ end.
+
+
+host() ->
+ case application:get_env(orber, ip_address) of
+ {ok,I} when is_list(I) ->
+ [I];
+ {ok,{multiple, [I|_] = IList}} when is_list(I) ->
+ IList;
+ %% IPv4. For IPv6 we only accept a string, but we must support this format
+ %% for IPv4
+ {ok, {A1, A2, A3, A4}} when is_integer(A1+A2+A3+A4) ->
+ [integer_to_list(A1) ++ "." ++ integer_to_list(A2) ++ "." ++ integer_to_list(A3)
+ ++ "." ++ integer_to_list(A4)];
+ _ ->
+ Flags = get_flags(),
+ case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_HOSTNAME_IN_IOR) of
+ true ->
+ {ok, Hostname} = inet:gethostname(),
+ [Hostname];
+ _ ->
+ case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_USE_IPV6) of
+ false ->
+ [ip_address(inet)];
+ true ->
+ [ip_address(inet6)]
+ end
+ end
+ end.
+
+ip_address_local() ->
+ case application:get_env(orber, ip_address_local) of
+ {ok,I} when is_list(I) ->
+ [I];
+ _ ->
+ []
+ end.
+
+
+ip_address() ->
+ ip_address(ip_version()).
+
+ip_address(inet) ->
+ {ok, Hostname} = inet:gethostname(),
+ {ok, {A1, A2, A3, A4}} = inet:getaddr(Hostname, inet),
+ integer_to_list(A1) ++ "." ++ integer_to_list(A2) ++ "." ++ integer_to_list(A3)
+ ++ "." ++ integer_to_list(A4);
+ip_address(inet6) ->
+ {ok, Hostname} = inet:gethostname(),
+ {ok, {A1, A2, A3, A4, A5, A6, A7, A8}} = inet:getaddr(Hostname, inet6),
+ int16_to_hex(A1) ++ ":" ++int16_to_hex(A2) ++ ":" ++
+ int16_to_hex(A3) ++ ":" ++ int16_to_hex(A4) ++ ":" ++
+ int16_to_hex(A5) ++ ":" ++ int16_to_hex(A6) ++ ":" ++
+ int16_to_hex(A7) ++ ":" ++ int16_to_hex(A8).
+
+getaddrstr(Hostname, inet) ->
+ {ok, {A1, A2, A3, A4}} = inet:getaddr(Hostname, inet),
+ integer_to_list(A1) ++ "." ++ integer_to_list(A2) ++ "." ++ integer_to_list(A3)
+ ++ "." ++ integer_to_list(A4);
+getaddrstr(Hostname, inet6) ->
+ {ok, {A1, A2, A3, A4, A5, A6, A7, A8}} = inet:getaddr(Hostname, inet6),
+ int16_to_hex(A1) ++ ":" ++int16_to_hex(A2) ++ ":" ++
+ int16_to_hex(A3) ++ ":" ++ int16_to_hex(A4) ++ ":" ++
+ int16_to_hex(A5) ++ ":" ++ int16_to_hex(A6) ++ ":" ++
+ int16_to_hex(A7) ++ ":" ++ int16_to_hex(A8).
+
+addr2str({A1, A2, A3, A4}) ->
+ integer_to_list(A1) ++ "." ++ integer_to_list(A2) ++ "." ++ integer_to_list(A3)
+ ++ "." ++ integer_to_list(A4);
+addr2str({A1, A2, A3, A4, A5, A6, A7, A8}) ->
+ int16_to_hex(A1) ++ ":" ++int16_to_hex(A2) ++ ":" ++
+ int16_to_hex(A3) ++ ":" ++ int16_to_hex(A4) ++ ":" ++
+ int16_to_hex(A5) ++ ":" ++ int16_to_hex(A6) ++ ":" ++
+ int16_to_hex(A7) ++ ":" ++ int16_to_hex(A8).
+
+
+int16_to_hex(0) ->
+ [$0];
+int16_to_hex(I) ->
+ N1 = ((I bsr 8) band 16#ff),
+ N2 = (I band 16#ff),
+ [code_character(N1 div 16), code_character(N1 rem 16),
+ code_character(N2 div 16), code_character(N2 rem 16)].
+
+code_character(N) when N < 10 ->
+ $0 + N;
+code_character(N) ->
+ $A + (N - 10).
+
+giop_version() ->
+ case application:get_env(orber, giop_version) of
+ {ok, {Major, Minor}} ->
+ {Major, Minor};
+ _ ->
+ {1, 1}
+ end.
+
+iiop_timeout() ->
+ case application:get_env(orber, iiop_timeout) of
+ {ok, Int} when is_integer(Int) ->
+ if
+ Int > 1000000 ->
+ error_logger:error_msg("Orber 'iiop_timeout' badly configured.~n"
+ "Time to large (>1000000 sec), swithed to 'infinity'~n"),
+ infinity;
+ true ->
+ %% Convert to msec.
+ Int*1000
+ end;
+ _ ->
+ infinity
+ end.
+
+iiop_connection_timeout() ->
+ case application:get_env(orber, iiop_connection_timeout) of
+ {ok, Int} when is_integer(Int) ->
+ if
+ Int > 1000000 ->
+ error_logger:error_msg("Orber 'iiop_connection_timeout' badly configured.~n"
+ "Time to large (>1000000 sec), swithed to 'infinity'~n"),
+ infinity;
+ true ->
+ %% Convert to msec.
+ Int*1000
+ end;
+ _ ->
+ infinity
+ end.
+
+iiop_setup_connection_timeout() ->
+ case application:get_env(orber, iiop_setup_connection_timeout) of
+ {ok, Int} when is_integer(Int) ->
+ %% Convert to msec.
+ Int*1000;
+ _ ->
+ infinity
+ end.
+
+iiop_in_connection_timeout() ->
+ case application:get_env(orber, iiop_in_connection_timeout) of
+ {ok, Int} when is_integer(Int) ->
+ if
+ Int > 1000000 ->
+ error_logger:error_msg("Orber 'iiop_connection_timeout' badly configured.~n"
+ "Time to large (>1000000 sec), swithed to 'infinity'~n"),
+ infinity;
+ true ->
+ %% Convert to msec.
+ Int*1000
+ end;
+ _ ->
+ infinity
+ end.
+
+iiop_max_fragments() ->
+ case application:get_env(orber, iiop_max_fragments) of
+ {ok, Max} when is_integer(Max) andalso Max > 0 ->
+ Max;
+ _ ->
+ infinity
+ end.
+
+iiop_max_in_requests() ->
+ case application:get_env(orber, iiop_max_in_requests) of
+ {ok, Max} when is_integer(Max) andalso Max > 0 ->
+ Max;
+ _ ->
+ infinity
+ end.
+
+iiop_max_in_connections() ->
+ case application:get_env(orber, iiop_max_in_connections) of
+ {ok, Max} when is_integer(Max) andalso Max > 0 ->
+ Max;
+ _ ->
+ infinity
+ end.
+
+iiop_backlog() ->
+ case application:get_env(orber, iiop_backlog) of
+ {ok, Int} when is_integer(Int) andalso Int >= 0 ->
+ Int;
+ _ ->
+ 5
+ end.
+
+iiop_in_keepalive() ->
+ case application:get_env(orber, iiop_in_keepalive) of
+ {ok, true} ->
+ true;
+ _ ->
+ false
+ end.
+
+iiop_out_keepalive() ->
+ case application:get_env(orber, iiop_out_keepalive) of
+ {ok, true} ->
+ true;
+ _ ->
+ false
+ end.
+
+
+
+get_flags() ->
+ case get(oe_orber_flags) of
+ undefined ->
+ case application:get_env(orber, flags) of
+ undefined ->
+ put(oe_orber_flags, ?ORB_ENV_INIT_FLAGS),
+ ?ORB_ENV_INIT_FLAGS;
+ {ok, Flags} ->
+ put(oe_orber_flags, Flags),
+ Flags
+ end;
+ Flags when is_integer(Flags) ->
+ Flags
+ end.
+
+typechecking() ->
+ ?ORB_FLAG_TEST(get_flags(), ?ORB_ENV_LOCAL_TYPECHECKING).
+
+exclude_codeset_ctx() ->
+ ?ORB_FLAG_TEST(get_flags(), ?ORB_ENV_EXCLUDE_CODESET_CTX).
+
+exclude_codeset_component() ->
+ ?ORB_FLAG_TEST(get_flags(), ?ORB_ENV_EXCLUDE_CODESET_COMPONENT).
+
+partial_security() ->
+ ?ORB_FLAG_TEST(get_flags(), ?ORB_ENV_PARTIAL_SECURITY).
+
+use_CSIv2() ->
+ ?ORB_FLAG_TEST(get_flags(), ?ORB_ENV_USE_CSIV2).
+
+use_FT() ->
+ ?ORB_FLAG_TEST(get_flags(), ?ORB_ENV_USE_FT).
+
+ip_version() ->
+ case ?ORB_FLAG_TEST(get_flags(), ?ORB_ENV_USE_IPV6) of
+ false ->
+ inet;
+ true ->
+ inet6
+ end.
+
+light_ifr() ->
+ ?ORB_FLAG_TEST(get_flags(), ?ORB_ENV_LIGHT_IFR).
+
+bidir_context() ->
+ Flags = get_flags(),
+ if
+ ?ORB_FLAG_TEST(Flags, ?ORB_ENV_USE_BI_DIR_IIOP) ->
+ [#'IOP_ServiceContext'
+ {context_id=?IOP_BI_DIR_IIOP,
+ context_data =
+ #'IIOP_BiDirIIOPServiceContext'{listen_points =
+ [#'IIOP_ListenPoint'{host=host(),
+ port=iiop_port()}]}}];
+ true ->
+ []
+ end.
+
+objectkeys_gc_time() ->
+ case application:get_env(orber, objectkeys_gc_time) of
+ {ok, Int} when is_integer(Int) ->
+ if
+ Int > 1000000 ->
+ error_logger:error_msg("Orber 'objectkeys_gc_time' badly configured.~n"
+ "Time to large (>1000000 sec), swithed to 'infinity'~n"),
+ infinity;
+ true ->
+ Int
+ end;
+ _ ->
+ infinity
+ end.
+
+get_ORBInitRef() ->
+ case application:get_env(orber, orbInitRef) of
+ {ok, Ref} when is_list(Ref) ->
+ Ref;
+ _ ->
+ undefined
+ end.
+
+get_ORBDefaultInitRef() ->
+ case application:get_env(orber, orbDefaultInitRef) of
+ {ok, Ref} when is_list(Ref) ->
+ Ref;
+ _ ->
+ undefined
+ end.
+
+get_debug_level() ->
+ case application:get_env(orber, orber_debug_level) of
+ {ok, Level} when is_integer(Level) ->
+ Level;
+ _ ->
+ 0
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Interceptor opertaions (see orber_pi.erl)
+%%-----------------------------------------------------------------
+get_interceptors() ->
+ case application:get_env(orber, interceptors) of
+ {ok, {native, PIs}} when is_list(PIs) ->
+ {native, PIs};
+ {ok, {portable, PIs}} when is_list(PIs) ->
+ {portable, PIs};
+ _ ->
+ false
+ end.
+
+get_local_interceptors() ->
+ case application:get_env(orber, local_interceptors) of
+ {ok, {native, PIs}} when is_list(PIs) ->
+ {native, PIs};
+ {ok, {portable, PIs}} when is_list(PIs) ->
+ {portable, PIs};
+ _ ->
+ false
+ end.
+
+
+get_cached_interceptors() ->
+ case get(oe_orber_interceptor_cache) of
+ undefined ->
+ PIs = case application:get_env(orber, local_interceptors) of
+ {ok, {native, LPIs}} when is_list(LPIs) ->
+ {native, LPIs};
+ {ok, {portable, LPIs}} when is_list(LPIs) ->
+ {portable, LPIs};
+ _ ->
+ get_interceptors()
+ end,
+ put(oe_orber_interceptor_cache, PIs),
+ PIs;
+ PIs ->
+ PIs
+ end.
+
+
+set_interceptors({Type, InterceptorList}) when is_list(InterceptorList) ->
+ configure(interceptors, {Type, InterceptorList});
+set_interceptors(_) ->
+ exit({error, "Usage: {Type, ModuleList}"}).
+
+
+%%-----------------------------------------------------------------
+%% Light weight Orber operations
+%%-----------------------------------------------------------------
+is_lightweight() ->
+ case application:get_env(orber, lightweight) of
+ {ok, L} when is_list(L) ->
+ true;
+ _ ->
+ false
+ end.
+get_lightweight_nodes() ->
+ case application:get_env(orber, lightweight) of
+ {ok, L} when is_list(L) ->
+ L;
+ _ ->
+ false
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Security access operations (SSL)
+%%-----------------------------------------------------------------
+secure() ->
+ case application:get_env(orber, secure) of
+ {ok, V} ->
+ V;
+ _ ->
+ no
+ end.
+
+ssl_generation() ->
+ case application:get_env(orber, ssl_generation) of
+ {ok, V} ->
+ V;
+ _ ->
+ 2
+ end.
+
+iiop_ssl_ip_address_local() ->
+ case application:get_env(orber, iiop_ssl_ip_address_local) of
+ {ok,I} when is_list(I) ->
+ [I];
+ _ ->
+ []
+ end.
+
+iiop_ssl_backlog() ->
+ case application:get_env(orber, iiop_ssl_backlog) of
+ {ok, Int} when is_integer(Int), Int >= 0 ->
+ Int;
+ _ ->
+ 5
+ end.
+
+iiop_ssl_in_keepalive() ->
+ case application:get_env(orber, iiop_ssl_in_keepalive) of
+ {ok, true} ->
+ true;
+ _ ->
+ false
+ end.
+
+iiop_ssl_out_keepalive() ->
+ case application:get_env(orber, iiop_ssl_out_keepalive) of
+ {ok, true} ->
+ true;
+ _ ->
+ false
+ end.
+
+iiop_ssl_accept_timeout() ->
+ case application:get_env(orber, iiop_ssl_accept_timeout) of
+ {ok, N} when is_integer(N) ->
+ N * 1000;
+ _ ->
+ infinity
+ end.
+
+iiop_ssl_port() ->
+ case application:get_env(orber, secure) of
+ {ok, ssl} ->
+ case application:get_env(orber, iiop_ssl_port) of
+ {ok, Port} when is_integer(Port) ->
+ Port;
+ _ ->
+ 4002
+ end;
+ _ ->
+ -1
+ end.
+
+nat_iiop_ssl_port() ->
+ case application:get_env(orber, secure) of
+ {ok, ssl} ->
+ case application:get_env(orber, nat_iiop_ssl_port) of
+ {ok, Port} when is_integer(Port) andalso Port > 0 ->
+ Port;
+ {ok, {local, Default, _NATList}} ->
+ Default;
+ _ ->
+ iiop_ssl_port()
+ end;
+ _ ->
+ -1
+ end.
+
+nat_iiop_ssl_port(LocalPort) ->
+ case application:get_env(orber, secure) of
+ {ok, ssl} ->
+ case application:get_env(orber, nat_iiop_ssl_port) of
+ {ok, Port} when is_integer(Port) andalso Port > 0 ->
+ Port;
+ {ok, {local, Default, NATList}} ->
+ orber_tb:keysearch(LocalPort, NATList, Default);
+ _ ->
+ iiop_ssl_port()
+ end;
+ _ ->
+ -1
+ end.
+
+ssl_server_certfile() ->
+ case application:get_env(orber, ssl_server_certfile) of
+ {ok, V1} when is_list(V1) ->
+ V1;
+ {ok, V2} when is_atom(V2) ->
+ atom_to_list(V2);
+ _ ->
+ []
+ end.
+
+ssl_client_certfile() ->
+ case get(ssl_client_certfile) of
+ undefined ->
+ case application:get_env(orber, ssl_client_certfile) of
+ {ok, V1} when is_list(V1) ->
+ V1;
+ {ok, V2} when is_atom(V2) ->
+ atom_to_list(V2);
+ _ ->
+ []
+ end;
+ V ->
+ V
+ end.
+
+set_ssl_client_certfile(Value) when is_list(Value) ->
+ put(ssl_client_certfile, Value).
+
+ssl_server_verify() ->
+ Verify = case application:get_env(orber, ssl_server_verify) of
+ {ok, V} when is_integer(V) ->
+ V;
+ _ ->
+ 0
+ end,
+ if
+ Verify =< 2, Verify >= 0 ->
+ Verify;
+ true ->
+ 0
+ end.
+
+ssl_client_verify() ->
+ Verify = case get(ssl_client_verify) of
+ undefined ->
+ case application:get_env(orber, ssl_client_verify) of
+ {ok, V1} when is_integer(V1) ->
+ V1;
+ _ ->
+ 0
+ end;
+ V2 ->
+ V2
+ end,
+ if
+ Verify =< 2, Verify >= 0 ->
+ Verify;
+ true ->
+ 0
+ end.
+
+set_ssl_client_verify(Value) when is_integer(Value) andalso Value =< 2 andalso Value >= 0 ->
+ put(ssl_client_verify, Value), ok.
+
+ssl_server_depth() ->
+ case application:get_env(orber, ssl_server_depth) of
+ {ok, V1} when is_integer(V1) ->
+ V1;
+ _ ->
+ 1
+ end.
+
+ssl_client_depth() ->
+ case get(ssl_client_depth) of
+ undefined ->
+ case application:get_env(orber, ssl_client_depth) of
+ {ok, V1} when is_integer(V1) ->
+ V1;
+ _ ->
+ 1
+ end;
+ V2 ->
+ V2
+ end.
+
+set_ssl_client_depth(Value) when is_integer(Value) ->
+ put(ssl_client_depth, Value), ok.
+
+
+
+ssl_server_cacertfile() ->
+ case application:get_env(orber, ssl_server_cacertfile) of
+ {ok, V1} when is_list(V1) ->
+ V1;
+ {ok, V2} when is_atom(V2) ->
+ atom_to_list(V2);
+ _ ->
+ []
+ end.
+
+ssl_client_cacertfile() ->
+ case get(ssl_client_cacertfile) of
+ undefined ->
+ case application:get_env(orber, ssl_client_cacertfile) of
+ {ok, V1} when is_list(V1) ->
+ V1;
+ {ok, V2} when is_atom(V2) ->
+ atom_to_list(V2);
+ _ ->
+ []
+ end;
+ V3 ->
+ V3
+ end.
+
+set_ssl_client_cacertfile(Value) when is_list(Value) ->
+ put(ssl_client_cacertfile, Value), ok.
+
+
+ssl_client_password() ->
+ case application:get_env(orber, ssl_client_password) of
+ {ok, V1} when is_list(V1) ->
+ V1;
+ _ ->
+ []
+ end.
+
+ssl_server_password() ->
+ case application:get_env(orber, ssl_server_password) of
+ {ok, V1} when is_list(V1) ->
+ V1;
+ _ ->
+ []
+ end.
+
+ssl_client_keyfile() ->
+ case application:get_env(orber, ssl_client_keyfile) of
+ {ok, V1} when is_list(V1) ->
+ V1;
+ _ ->
+ []
+ end.
+
+ssl_server_keyfile() ->
+ case application:get_env(orber, ssl_server_keyfile) of
+ {ok, V1} when is_list(V1) ->
+ V1;
+ _ ->
+ []
+ end.
+
+ssl_client_ciphers() ->
+ case application:get_env(orber, ssl_client_ciphers) of
+ {ok, V1} when is_list(V1) ->
+ V1;
+ _ ->
+ []
+ end.
+
+ssl_server_ciphers() ->
+ case application:get_env(orber, ssl_server_ciphers) of
+ {ok, V1} when is_list(V1) ->
+ V1;
+ _ ->
+ []
+ end.
+
+ssl_client_cachetimeout() ->
+ case application:get_env(orber, ssl_client_cachetimeout) of
+ {ok, V1} when is_integer(V1) ->
+ V1;
+ _ ->
+ infinity
+ end.
+
+ssl_server_cachetimeout() ->
+ case application:get_env(orber, ssl_server_cachetimeout) of
+ {ok, V1} when is_integer(V1) ->
+ V1;
+ _ ->
+ infinity
+ end.
+
+%%-----------------------------------------------------------------
+%% function : configure
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+configure(Key, Value) when is_atom(Key) ->
+ configure(Key, Value, check);
+configure(Key, _) ->
+ ?EFORMAT("Given key (~p) not an atom.", [Key]).
+
+configure_override(Key, Value) when is_atom(Key) ->
+ configure(Key, Value, loaded);
+configure_override(Key, _) ->
+ ?EFORMAT("Given key (~p) not an atom.", [Key]).
+
+%%-----------------------------------------------------------------
+%% function : multi_configure
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+multi_configure(KeyValueList) when is_list(KeyValueList) ->
+ case orber_tb:is_loaded() of
+ false ->
+ application:load(orber),
+ multi_configure_helper(KeyValueList, loaded);
+ true ->
+ case orber_tb:is_running() of
+ false ->
+ multi_configure_helper(KeyValueList, loaded);
+ true ->
+ multi_configure_helper(KeyValueList, running)
+ end
+ end;
+multi_configure(KeyValueList) ->
+ ?EFORMAT("Given configuration parameters not a Key-Value-pair list: ~p",
+ [KeyValueList]).
+
+multi_configure_helper([], _) ->
+ ok;
+multi_configure_helper([{Key, Value}|T], Status) ->
+ configure(Key, Value, Status),
+ multi_configure_helper(T, Status);
+multi_configure_helper([What|_], _) ->
+ ?EFORMAT("Incorrect configuration parameters supplied: ~p", [What]).
+
+
+%%------ Keys we can update at any time -----
+%% Initial Services References
+configure(orbDefaultInitRef, String, Status) when is_list(String) ->
+ do_configure(orbDefaultInitRef, String, Status);
+configure(orbDefaultInitRef, undefined, Status) ->
+ do_configure(orbDefaultInitRef, undefined, Status);
+configure(orbInitRef, String, Status) when is_list(String) ->
+ do_configure(orbInitRef, String, Status);
+configure(orbInitRef, undefined, Status) ->
+ do_configure(orbInitRef, undefined, Status);
+%% IIOP-version
+configure(giop_version, {1, 0}, Status) ->
+ do_configure(giop_version, {1, 0}, Status);
+configure(giop_version, {1, 1}, Status) ->
+ do_configure(giop_version, {1, 1}, Status);
+configure(giop_version, {1, 2}, Status) ->
+ do_configure(giop_version, {1, 2}, Status);
+%% configure 'iiop_timout' will only have effect on new requests.
+configure(iiop_timeout, infinity, Status) ->
+ do_configure(iiop_timeout, infinity, Status);
+configure(iiop_timeout, Value, Status) when is_integer(Value) andalso Value =< 1000000 ->
+ do_configure(iiop_timeout, Value, Status);
+%% Backlog
+configure(iiop_backlog, Value, Status) when is_integer(Value) andalso Value >= 0 ->
+ do_configure(iiop_backlog, Value, Status);
+%% configure 'iiop_in_keepalive' will only have effect on new connections.
+configure(iiop_in_keepalive, true, Status) ->
+ do_configure(iiop_in_keepalive, true, Status);
+configure(iiop_in_keepalive, false, Status) ->
+ do_configure(iiop_in_keepalive, false, Status);
+%% configure 'iiop_out_keepalive' will only have effect on new connections.
+configure(iiop_out_keepalive, true, Status) ->
+ do_configure(iiop_out_keepalive, true, Status);
+configure(iiop_out_keepalive, false, Status) ->
+ do_configure(iiop_out_keepalive, false, Status);
+%% configure 'iiop_connection_timout' will only have effect on new connections.
+configure(iiop_connection_timeout, infinity, Status) ->
+ do_configure(iiop_connection_timeout, infinity, Status);
+configure(iiop_connection_timeout, Value, Status) when is_integer(Value) andalso Value =< 1000000 ->
+ do_configure(iiop_connection_timeout, Value, Status);
+%% configure 'iiop_in_connection_timout' will only have effect on new connections.
+configure(iiop_in_connection_timeout, infinity, Status) ->
+ do_configure(iiop_in_connection_timeout, infinity, Status);
+configure(iiop_in_connection_timeout, Value, Status) when is_integer(Value) andalso Value =< 1000000 ->
+ do_configure(iiop_in_connection_timeout, Value, Status);
+%% configure 'iiop_setup_connection_timeout' will only have effect on new connections.
+configure(iiop_setup_connection_timeout, infinity, Status) ->
+ do_configure(iiop_setup_connection_timeout, infinity, Status);
+configure(iiop_setup_connection_timeout, Value, Status) when is_integer(Value) ->
+ do_configure(iiop_setup_connection_timeout, Value, Status);
+%% configure 'iiop_max_fragments' will only have effect on new connections.
+configure(iiop_max_fragments, infinity, Status) ->
+ do_configure(iiop_max_fragments, infinity, Status);
+configure(iiop_max_fragments, Value, Status) when is_integer(Value) andalso Value > 0 ->
+ do_configure(iiop_max_fragments, Value, Status);
+%% configure 'iiop_max_in_requests' will only have effect on new connections.
+configure(iiop_max_in_requests, infinity, Status) ->
+ do_configure(iiop_max_in_requests, infinity, Status);
+configure(iiop_max_in_requests, Value, Status) when is_integer(Value) andalso Value > 0 ->
+ do_configure(iiop_max_in_requests, Value, Status);
+%% configure 'iiop_max_in_connections' will only have effect on new connections.
+configure(iiop_max_in_connections, infinity, Status) ->
+ do_configure(iiop_max_in_connections, infinity, Status);
+configure(iiop_max_in_connections, Value, Status) when is_integer(Value) andalso Value > 0 ->
+ do_configure(iiop_max_in_connections, Value, Status);
+%% Garbage Collect the object keys DB.
+configure(objectkeys_gc_time, infinity, Status) ->
+ do_configure(objectkeys_gc_time, infinity, Status);
+configure(objectkeys_gc_time, Value, Status) when is_integer(Value) andalso Value =< 1000000 ->
+ do_configure(objectkeys_gc_time, Value, Status);
+%% Orber debug printouts
+configure(orber_debug_level, Value, Status) when is_integer(Value) ->
+ do_configure(orber_debug_level, Value, Status);
+
+%%------ Keys we cannot change if Orber is running -----
+%% Set the listen port
+configure(iiop_port, Value, Status) when is_integer(Value) ->
+ do_safe_configure(iiop_port, Value, Status);
+%% Set the NAT listen port
+configure(nat_iiop_port, Value, Status) when is_integer(Value) andalso Value > 0 ->
+ do_safe_configure(nat_iiop_port, Value, Status);
+configure(nat_iiop_port, {local, Value1, Value2}, Status) when is_integer(Value1) andalso
+ Value1 > 0 andalso
+ is_list(Value2) ->
+ do_safe_configure(nat_iiop_port, {local, Value1, Value2}, Status);
+%% Set Maximum Packet Size
+configure(iiop_packet_size, Max, Status) when is_integer(Max) andalso Max > 0 ->
+ do_safe_configure(iiop_packet_size, Max, Status);
+%% IIOP interceptors
+configure(interceptors, Value, Status) when is_tuple(Value) ->
+ do_safe_configure(interceptors, Value, Status);
+%% Local interceptors
+configure(local_interceptors, Value, Status) when is_tuple(Value) ->
+ do_safe_configure(local_interceptors, Value, Status);
+%% Orber Domain
+configure(domain, Value, Status) when is_list(Value) ->
+ do_safe_configure(domain, Value, Status);
+%% Set the IP-address we should use
+configure(ip_address, Value, Status) when is_list(Value) ->
+ do_safe_configure(ip_address, Value, Status);
+configure(ip_address, {multiple, Value}, Status) when is_list(Value) ->
+ do_safe_configure(ip_address, {multiple, Value}, Status);
+configure(ip_address_local, Value, Status) when is_list(Value) ->
+ do_safe_configure(ip_address_local, Value, Status);
+%% Set the NAT IP-address we should use
+configure(nat_ip_address, Value, Status) when is_list(Value) ->
+ do_safe_configure(nat_ip_address, Value, Status);
+configure(nat_ip_address, {multiple, Value}, Status) when is_list(Value) ->
+ do_safe_configure(nat_ip_address, {multiple, Value}, Status);
+configure(nat_ip_address, {local, Value1, Value2}, Status) when is_list(Value1) andalso
+ is_list(Value2) ->
+ do_safe_configure(nat_ip_address, {local, Value1, Value2}, Status);
+%% Set the range of ports we may use on this machine when connecting to a server.
+configure(iiop_out_ports, {Min, Max}, Status) when is_integer(Min) andalso is_integer(Max) ->
+ do_safe_configure(iiop_out_ports, {Min, Max}, Status);
+%% Set the lightweight option.
+configure(lightweight, Value, Status) when is_list(Value) ->
+ do_safe_configure(lightweight, Value, Status);
+%% Configre the System Flags
+configure(flags, Value, Status) when is_integer(Value) ->
+ do_safe_configure(flags, Value, Status);
+%% Configre the ACL
+configure(iiop_acl, Value, Status) when is_list(Value) ->
+ do_safe_configure(iiop_acl, Value, Status);
+
+%% SSL settings
+%% configure 'iiop_in_keepalive' will only have effect on new connections.
+configure(iiop_ssl_in_keepalive, true, Status) ->
+ do_configure(iiop_ssl_in_keepalive, true, Status);
+configure(iiop_ssl_in_keepalive, false, Status) ->
+ do_configure(iiop_ssl_in_keepalive, false, Status);
+%% configure 'iiop_ssl_out_keepalive' will only have effect on new connections.
+configure(iiop_ssl_out_keepalive, true, Status) ->
+ do_configure(iiop_ssl_out_keepalive, true, Status);
+configure(iiop_ssl_out_keepalive, false, Status) ->
+ do_configure(iiop_ssl_out_keepalive, false, Status);
+configure(iiop_ssl_accept_timeout, infinity, Status) ->
+ do_configure(iiop_ssl_accept_timeout, infinity, Status);
+configure(iiop_ssl_accept_timeout, Value, Status) when is_integer(Value) andalso Value >= 0 ->
+ do_configure(iiop_ssl_accept_timeout, Value, Status);
+configure(ssl_generation, Generation, Status) when is_integer(Generation) andalso Generation >= 2 ->
+ do_safe_configure(ssl_generation, Generation, Status);
+configure(secure, ssl, Status) ->
+ do_safe_configure(secure, ssl, Status);
+configure(iiop_ssl_ip_address_local, Value, Status) when is_list(Value) ->
+ do_safe_configure(iiop_ssl_ip_address_local, Value, Status);
+configure(iiop_ssl_backlog, Value, Status) when is_integer(Value) andalso Value >= 0 ->
+ do_safe_configure(iiop_ssl_backlog, Value, Status);
+configure(nat_iiop_ssl_port, Value, Status) when is_integer(Value) andalso Value > 0 ->
+ do_safe_configure(nat_iiop_ssl_port, Value, Status);
+configure(nat_iiop_ssl_port, {local, Value1, Value2}, Status) when is_integer(Value1) andalso
+ Value1 > 0 andalso
+ is_list(Value2) ->
+ do_safe_configure(nat_iiop_ssl_port, {local, Value1, Value2}, Status);
+configure(iiop_ssl_port, Value, Status) when is_integer(Value) ->
+ do_safe_configure(iiop_ssl_port, Value, Status);
+configure(ssl_server_certfile, Value, Status) when is_list(Value) ->
+ do_safe_configure(ssl_server_certfile, Value, Status);
+configure(ssl_server_certfile, Value, Status) when is_atom(Value) ->
+ do_safe_configure(ssl_server_certfile, atom_to_list(Value), Status);
+configure(ssl_client_certfile, Value, Status) when is_list(Value) ->
+ do_safe_configure(ssl_client_certfile, Value, Status);
+configure(ssl_client_certfile, Value, Status) when is_atom(Value) ->
+ do_safe_configure(ssl_client_certfile, atom_to_list(Value), Status);
+configure(ssl_server_verify, Value, Status) when is_integer(Value) ->
+ do_safe_configure(ssl_server_verify, Value, Status);
+configure(ssl_client_verify, Value, Status) when is_integer(Value) ->
+ do_safe_configure(ssl_client_verify, Value, Status);
+configure(ssl_server_depth, Value, Status) when is_integer(Value) ->
+ do_safe_configure(ssl_server_depth, Value, Status);
+configure(ssl_client_depth, Value, Status) when is_integer(Value) ->
+ do_safe_configure(ssl_client_depth, Value, Status);
+configure(ssl_server_cacertfile, Value, Status) when is_list(Value) ->
+ do_safe_configure(ssl_server_cacertfile, Value, Status);
+configure(ssl_server_cacertfile, Value, Status) when is_atom(Value) ->
+ do_safe_configure(ssl_server_cacertfile, atom_to_list(Value), Status);
+configure(ssl_client_cacertfile, Value, Status) when is_list(Value) ->
+ do_safe_configure(ssl_client_cacertfile, Value, Status);
+configure(ssl_client_cacertfile, Value, Status) when is_atom(Value) ->
+ do_safe_configure(ssl_client_cacertfile, atom_to_list(Value), Status);
+configure(ssl_client_password, Value, Status) when is_list(Value) ->
+ do_safe_configure(ssl_client_password, Value, Status);
+configure(ssl_client_password, Value, Status) when is_atom(Value) ->
+ do_safe_configure(ssl_client_password, atom_to_list(Value), Status);
+configure(ssl_client_keyfile, Value, Status) when is_list(Value) ->
+ do_safe_configure(ssl_client_keyfile, Value, Status);
+configure(ssl_client_keyfile, Value, Status) when is_atom(Value) ->
+ do_safe_configure(ssl_client_keyfile, atom_to_list(Value), Status);
+configure(ssl_server_password, Value, Status) when is_list(Value) ->
+ do_safe_configure(ssl_server_password, Value, Status);
+configure(ssl_client_password, Value, Status) when is_atom(Value) ->
+ do_safe_configure(ssl_server_password, atom_to_list(Value), Status);
+configure(ssl_server_keyfile, Value, Status) when is_list(Value) ->
+ do_safe_configure(ssl_server_keyfile, Value, Status);
+configure(ssl_server_keyfile, Value, Status) when is_atom(Value) ->
+ do_safe_configure(ssl_server_keyfile, atom_to_list(Value), Status);
+configure(ssl_server_ciphers, Value, Status) when is_list(Value) ->
+ do_safe_configure(ssl_server_ciphers, Value, Status);
+configure(ssl_server_ciphers, Value, Status) when is_atom(Value) ->
+ do_safe_configure(ssl_server_ciphers, atom_to_list(Value), Status);
+configure(ssl_client_ciphers, Value, Status) when is_list(Value) ->
+ do_safe_configure(ssl_client_ciphers, Value, Status);
+configure(ssl_client_ciphers, Value, Status) when is_atom(Value) ->
+ do_safe_configure(ssl_client_ciphers, atom_to_list(Value), Status);
+configure(ssl_client_cachetimeout, Value, Status) when is_integer(Value) andalso Value > 0 ->
+ do_safe_configure(ssl_client_cachetimeout, Value, Status);
+configure(ssl_server_cachetimeout, Value, Status) when is_integer(Value) andalso Value > 0 ->
+ do_safe_configure(ssl_server_cachetimeout, Value, Status);
+
+configure(Key, Value, _) ->
+ ?EFORMAT("Bad configuration parameter: {~p, ~p}", [Key, Value]).
+
+%% This function may be used as long as it is safe to change a value at any time.
+do_configure(Key, Value, check) ->
+ case orber_tb:is_loaded() of
+ false ->
+ application:load(orber),
+ application:set_env(orber, Key, Value);
+ true ->
+ application:set_env(orber, Key, Value)
+ end;
+do_configure(Key, Value, _) ->
+ application:set_env(orber, Key, Value).
+
+%% This function MUST(!!) be used when we cannot change a value if Orber is running.
+do_safe_configure(_, _, running) ->
+ exit("Orber already running, the given key may not be updated!");
+do_safe_configure(Key, Value, check) ->
+ case orber_tb:is_loaded() of
+ false ->
+ application:load(orber),
+ application:set_env(orber, Key, Value);
+ true ->
+ case orber_tb:is_running() of
+ false ->
+ application:set_env(orber, Key, Value);
+ true ->
+ ?EFORMAT("Orber already running. {~p, ~p} may not be updated!",
+ [Key, Value])
+ end
+ end;
+do_safe_configure(Key, Value, loaded) ->
+ application:set_env(orber, Key, Value).
+
+
+%%-----------------------------------------------------------------
+%% Internal functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Server functions
+%%-----------------------------------------------------------------
+init(_Opts) ->
+ {ok, #env{acl = orber_acl:init_acl(iiop_acl()),
+ parameters = init_env()}}.
+
+terminate(_Reason, _State) ->
+ ok.
+
+handle_call(_, _From, State) ->
+ {reply, ok, State}.
+
+handle_cast(_, State) ->
+ {noreply, State}.
+
+handle_info(_, State) ->
+ {noreply, State}.
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%-----------------------------------------------------------------
+%% function : env
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect : Used when Key always exists (Default Value)
+%%-----------------------------------------------------------------
+env(Key) ->
+ [#parameters{value = Val}] = ets:lookup(?ENV_DB, Key),
+ Val.
+
+%%-----------------------------------------------------------------
+%% function : init_env
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%-----------------------------------------------------------------
+init_env() ->
+ application:load(orber),
+ DB = ets:new(?ENV_DB, [set, public, named_table, {keypos, 2}]),
+% init_env(?ENV_KEYS),
+ DB.
+
+%init_env([{H,D}|T]) ->
+% case application:get_env(orber, H) of
+% {ok, V} ->
+% ets:insert(?ENV_DB, #parameters{key = H, value = V, flags = 0}),
+% init_env(T);
+% _ ->
+% ets:insert(?ENV_DB, #parameters{key = H, value = D, flags = 0}),
+% init_env(T)
+% end;
+%init_env([H|T]) ->
+% case application:get_env(orber, H) of
+% {ok, V} ->
+% ets:insert(?ENV_DB, #parameters{key = H, value = V, flags = 0}),
+% init_env(T);
+% _ ->
+% ets:insert(?ENV_DB, #parameters{key = H, value = undefined, flags = 0}),
+% init_env(T)
+% end;
+%init_env([]) ->
+% ok.
+
+%%-----------------------------------------------------------------
+%%------------- END OF MODULE -------------------------------------
+%%-----------------------------------------------------------------
diff --git a/lib/orber/src/orber_exceptions.erl b/lib/orber/src/orber_exceptions.erl
new file mode 100644
index 0000000000..9ee6e31aeb
--- /dev/null
+++ b/lib/orber/src/orber_exceptions.erl
@@ -0,0 +1,717 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_exceptions.erl
+%%
+%% Description:
+%%
+%%-----------------------------------------------------------------
+
+-module(orber_exceptions).
+
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/src/orber_iiop.hrl").
+-include_lib("orber/src/ifr_objects.hrl").
+-include_lib("orber/include/ifr_types.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([dissect/1,
+ get_def/1,
+ get_name/2,
+ type/1,
+ is_system_exception/1]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export(['UNKNOWN'/1,
+ 'BAD_PARAM'/1,
+ 'NO_MEMORY'/1,
+ 'IMP_LIMIT'/1,
+ 'COMM_FAILURE'/1,
+ 'INV_OBJREF'/1,
+ 'NO_PERMISSION'/1,
+ 'INTERNAL'/1,
+ 'MARSHAL'/1,
+ 'INITIALIZE'/1,
+ 'NO_IMPLEMENT'/1,
+ 'BAD_TYPECODE'/1,
+ 'BAD_OPERATION'/1,
+ 'NO_RESOURCES'/1,
+ 'NO_RESPONSE'/1,
+ 'PERSIST_STORE'/1,
+ 'BAD_INV_ORDER'/1,
+ 'TRANSIENT'/1,
+ 'FREE_MEM'/1,
+ 'INV_IDENT'/1,
+ 'INV_FLAG'/1,
+ 'INTF_REPOS'/1,
+ 'BAD_CONTEXT'/1,
+ 'OBJ_ADAPTER'/1,
+ 'DATA_CONVERSION'/1,
+ 'OBJECT_NOT_EXIST'/1,
+ 'TRANSACTION_REQUIRED'/1,
+ 'TRANSACTION_ROLLEDBACK'/1,
+ 'INVALID_TRANSACTION'/1,
+ 'INV_POLICY'/1,
+ 'CODESET_INCOMPATIBLE'/1,
+ 'REBIND'/1,
+ 'TIMEOUT'/1,
+ 'TRANSACTION_UNAVAILABLE'/1,
+ 'TRANSACTION_MODE'/1,
+ 'BAD_QOS'/1]).
+
+
+-define(DEBUG_LEVEL, 5).
+
+%%-----------------------------------------------------------------
+%% Function : is_system_exception
+%% Arguments : Exception - record()
+%% Returns : true | false
+%% Raises :
+%% Description: Check if CORBA system exception or user defined
+%%-----------------------------------------------------------------
+is_system_exception({'EXCEPTION', E}) ->
+ is_system_exception(E);
+is_system_exception(E) when is_tuple(E) ->
+ ?SYSTEM_EXCEPTION == type(element(1, E));
+is_system_exception(_E) ->
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+%%-----------------------------------------------------------------
+%% Function : type
+%% Arguments : ExceptionName - atom()
+%% Returns : ?SYSTEM_EXCEPTION | ?USER_EXCEPTION
+%% Raises :
+%% Description: Check if CORBA system exception or user defined
+%%-----------------------------------------------------------------
+type('UNKNOWN') -> ?SYSTEM_EXCEPTION;
+type('BAD_PARAM') -> ?SYSTEM_EXCEPTION;
+type('NO_MEMORY') -> ?SYSTEM_EXCEPTION;
+type('IMP_LIMIT') -> ?SYSTEM_EXCEPTION;
+type('COMM_FAILURE') -> ?SYSTEM_EXCEPTION;
+type('INV_OBJREF') -> ?SYSTEM_EXCEPTION;
+type('NO_PERMISSION') -> ?SYSTEM_EXCEPTION;
+type('INTERNAL') -> ?SYSTEM_EXCEPTION;
+type('MARSHAL') -> ?SYSTEM_EXCEPTION;
+type('INITIALIZE') -> ?SYSTEM_EXCEPTION;
+type('NO_IMPLEMENT') -> ?SYSTEM_EXCEPTION;
+type('BAD_TYPECODE') -> ?SYSTEM_EXCEPTION;
+type('BAD_OPERATION') -> ?SYSTEM_EXCEPTION;
+type('NO_RESOURCES') -> ?SYSTEM_EXCEPTION;
+type('NO_RESPONSE') -> ?SYSTEM_EXCEPTION;
+type('PERSIST_STORE') -> ?SYSTEM_EXCEPTION;
+type('BAD_INV_ORDER') -> ?SYSTEM_EXCEPTION;
+type('TRANSIENT') -> ?SYSTEM_EXCEPTION;
+type('FREE_MEM') -> ?SYSTEM_EXCEPTION;
+type('INV_IDENT') -> ?SYSTEM_EXCEPTION;
+type('INV_FLAG') -> ?SYSTEM_EXCEPTION;
+type('INTF_REPOS') -> ?SYSTEM_EXCEPTION;
+type('BAD_CONTEXT') -> ?SYSTEM_EXCEPTION;
+type('OBJ_ADAPTER') -> ?SYSTEM_EXCEPTION;
+type('DATA_CONVERSION') -> ?SYSTEM_EXCEPTION;
+type('OBJECT_NOT_EXIST') -> ?SYSTEM_EXCEPTION;
+type('TRANSACTION_REQUIRED') -> ?SYSTEM_EXCEPTION;
+type('TRANSACTION_ROLLEDBACK') -> ?SYSTEM_EXCEPTION;
+type('INVALID_TRANSACTION') -> ?SYSTEM_EXCEPTION;
+type('INV_POLICY') -> ?SYSTEM_EXCEPTION;
+type('CODESET_INCOMPATIBLE') -> ?SYSTEM_EXCEPTION;
+type('REBIND') -> ?SYSTEM_EXCEPTION;
+type('TIMEOUT') -> ?SYSTEM_EXCEPTION;
+type('TRANSACTION_UNAVAILABLE') -> ?SYSTEM_EXCEPTION;
+type('TRANSACTION_MODE') -> ?SYSTEM_EXCEPTION;
+type('BAD_QOS') -> ?SYSTEM_EXCEPTION;
+type(_) -> ?USER_EXCEPTION.
+
+%%-----------------------------------------------------------------
+%% Function : get_def
+%% Arguments : Exception - record()
+%% Returns : {Type, TypeCode, Exc}
+%% Raises :
+%% Description: Returns the TC for the supplied exception
+%%-----------------------------------------------------------------
+get_def(Exception) ->
+ [Exc, TypeId | _] = tuple_to_list(Exception),
+ case type(Exc) of
+ ?SYSTEM_EXCEPTION ->
+ {?SYSTEM_EXCEPTION, get_system_exception_def(Exc), Exception};
+ ?USER_EXCEPTION ->
+ case orber:light_ifr() of
+ true ->
+ case catch orber_ifr:get_tc(TypeId, ?IFR_ExceptionDef) of
+ {'EXCEPTION', NewExc} ->
+ {?SYSTEM_EXCEPTION,
+ get_system_exception_def(NewExc),
+ NewExc};
+ TC ->
+ {?USER_EXCEPTION, TC, Exception}
+ end;
+ false ->
+ case mnesia:dirty_index_read(ir_ExceptionDef, TypeId,
+ #ir_ExceptionDef.id) of
+ [ExcDef] when is_record(ExcDef, ir_ExceptionDef) ->
+ {?USER_EXCEPTION,
+ ExcDef#ir_ExceptionDef.type,
+ Exception};
+ Other ->
+ orber:dbg("[~p] ~p:get_user_exception_type(~p).~n"
+ "IFR Id not found: ~p",
+ [?LINE, ?MODULE, TypeId, Other], ?DEBUG_LEVEL),
+ NewExc = #'UNKNOWN'{minor=(?CORBA_OMGVMCID bor 1),
+ completion_status=?COMPLETED_MAYBE},
+ {?SYSTEM_EXCEPTION,
+ get_system_exception_def(NewExc),
+ NewExc}
+ end
+ end
+ end.
+
+%%-----------------------------------------------------------------
+%% Function : get_name
+%% Arguments : TypeId - string()
+%% Type - ?SYSTEM_EXCEPTION ( | ?USER_EXCEPTION)
+%% Returns : ExceptionName - atom()
+%% Raises : #'UNKNOWN'{}
+%% Description: Extract exception name
+%%-----------------------------------------------------------------
+get_name(TypeId, ?SYSTEM_EXCEPTION) ->
+ ExcName =
+ case string:tokens(TypeId, ":/") of
+ [_IDL, _OMGORG, _CORBA, Name, _Version] when is_list(Name) ->
+ list_to_atom(Name);
+ [_IDL, _CORBA, Name, _Version] when is_list(Name) ->
+ %% We should remove this case but we keep it for now due to backward
+ %% compatible reasons.
+ list_to_atom(Name);
+ Other ->
+ %% The CORBA-spec states that this exception should be raised if
+ %% it's a system exception we do not support.
+ orber:dbg("[~p] ~p:get_system_exception_name(~p).~n"
+ "Unknown System Exception: ~p",
+ [?LINE, ?MODULE, TypeId, Other], ?DEBUG_LEVEL),
+ corba:raise(#'UNKNOWN'{minor=(?CORBA_OMGVMCID bor 2),
+ completion_status=?COMPLETED_MAYBE})
+ end,
+ case type(ExcName) of
+ ?SYSTEM_EXCEPTION ->
+ ExcName;
+ What ->
+ orber:dbg("[~p] ~p:get_system_exception_name(~p).~n"
+ "Unknown System Exception: ~p",
+ [?LINE, ?MODULE, TypeId, What], ?DEBUG_LEVEL),
+ corba:raise(#'UNKNOWN'{minor=(?CORBA_OMGVMCID bor 2),
+ completion_status=?COMPLETED_MAYBE})
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Generate system exception TypeCode
+%%-----------------------------------------------------------------
+get_system_exception_def(ExcName) when is_atom(ExcName) ->
+ Name = atom_to_list(ExcName),
+ {'tk_except', "IDL:omg.org/CORBA/" ++ Name ++ ":1.0", Name,
+ [{"minor",'tk_ulong'},
+ {"completed",
+ {'tk_enum', "", "completion_status",
+ ["COMPLETED_YES", "COMPLETED_NO",
+ "COMPLETED_MAYBE"]}}]};
+get_system_exception_def(Exc) ->
+ get_system_exception_def(element(1, Exc)).
+
+
+%%-----------------------------------------------------------------
+%% Mapping minor codes to a printable string.
+%%-----------------------------------------------------------------
+dissect({'EXCEPTION', Exc}) ->
+ dissect(Exc);
+dissect(Exception) when is_tuple(Exception) ->
+ [Exc, TypeId | _] = tuple_to_list(Exception),
+ case type(Exc) of
+ ?USER_EXCEPTION ->
+ {ok, lists:flatten(io_lib:format("~n------------- EXCEPTION INFO --------------
+User Defined Exception.: ~p
+IFR Id.................: ~s
+-------------------------------------------~n", [Exc, TypeId]))};
+ ?SYSTEM_EXCEPTION ->
+ case map_exc(Exception) of
+ {ok, String} ->
+ {ok, lists:flatten(String)};
+ {error, Reason} ->
+ {error, Reason}
+ end
+ end;
+dissect(_What) ->
+ {error, "Not a correct exception supplied to orber_exceptions:dissect/1"}.
+
+map_exc({Name, _, Minor, Status}) when is_integer(Minor) ->
+ case lookup_vendor(Minor) of
+ {true, Vendor, VMCID} ->
+ case catch ?MODULE:Name(Minor) of
+ MinorInfo when is_list(MinorInfo) ->
+ {ok, io_lib:format("~n------------- EXCEPTION INFO --------------
+Vendor.....: ~s
+VMCID......: ~s
+Exception..: ~p
+Status.....: ~p
+Minor Code.: ~p
+Info.......: ~s
+-------------------------------------------~n",
+ [Vendor, VMCID, Name, Status, (Minor band 16#fff), MinorInfo])};
+ _ ->
+ {ok, io_lib:format("~n------------- EXCEPTION INFO --------------
+Vendor.....: ~s
+VMCID......: ~s
+Exception..: ~p
+Status.....: ~p
+Minor Code.: ~p
+Info.......: -
+------------------------------------~n", [Vendor, VMCID, Name, Status, (Minor band 16#fff)])}
+ end;
+ {false, Vendor, VMCID} ->
+ {ok, io_lib:format("~n------------- EXCEPTION INFO --------------
+Vendor.....: ~s
+VMCID......: ~s
+Exception..: ~p
+Status.....: ~p
+Minor Code.: ~p
+Info.......: -
+-------------------------------------------~n", [Vendor, VMCID, Name, Status, (Minor band 16#fff)])}
+ end;
+map_exc(_) ->
+ {error, "Not a correct exception supplied to orber_exceptions:map_exc/1"}.
+
+lookup_vendor(Minor) when (?ORBER_VMCID bxor Minor) < 16#0fff ->
+ {true, "Orber", "0x45520000"};
+lookup_vendor(Minor) when (?CORBA_OMGVMCID bxor Minor) < 16#0fff ->
+ {true, "OMG", "0x4f4d0000"};
+lookup_vendor(Minor) when (?IONA_VMCID_1 bxor Minor) < 16#0fff ->
+ {false, "IONA", "0x4f4f0000"};
+lookup_vendor(Minor) when (?IONA_VMCID_2 bxor Minor) < 16#0fff ->
+ {false, "IONA", "0x49540000"};
+lookup_vendor(Minor) when (?SUN_VMCID bxor Minor) < 16#0fff ->
+ {false, "SUN", "0x53550000"};
+lookup_vendor(Minor) when (?BORLAND_VMCID bxor Minor) < 16#0fff ->
+ {false, "Borland", "0x56420000"};
+lookup_vendor(Minor) when (?TAO_VMCID bxor Minor) < 16#0fff ->
+ {false, "TAO", "0x54410000"};
+lookup_vendor(Minor) when (?PRISMTECH_VMCID bxor Minor) < 16#0fff ->
+ {false, "PrismTech", "0x50540000"};
+lookup_vendor(Minor) when is_integer(Minor), Minor =< ?ULONGMAX ->
+ {false, "undefined", extract_VMCID(Minor)};
+lookup_vendor(Minor) when is_integer(Minor), Minor =< ?ULONGMAX ->
+ {false, "Unknown", "Unable to extract it"}.
+
+extract_VMCID(Int) ->
+ int_to_hex_str(3, ((Int bsr 8) band 16#fffff0), ["00"]).
+
+int_to_hex_str(0, _, Acc) ->
+ lists:flatten(["0x" | Acc]);
+int_to_hex_str(N, Int, Acc) ->
+ int_to_hex_str(N-1, (Int bsr 8), [int_to_hex((16#ff band Int))|Acc]).
+
+int_to_hex(B) when B < 256, B >= 0 ->
+ N1 = B div 16,
+ N2 = B rem 16,
+ [code_character(N1),
+ code_character(N2)].
+code_character(N) when N < 10 ->
+ $0 + N;
+code_character(N) ->
+ $a + (N - 10).
+
+
+%% The following functions all maps to a system exception.
+%% UNKNOWN - OMG
+'UNKNOWN'(?CORBA_OMGVMCID bor 1) -> "Unlisted user exception received
+by client";
+'UNKNOWN'(?CORBA_OMGVMCID bor 2) -> "Non-standard System Exception
+not supported";
+%% UNKNOWN - Orber
+'UNKNOWN'(?ORBER_VMCID bor 1) -> "Missing beam-file. Unable to extract TC.";
+'UNKNOWN'(_) -> "-".
+
+
+%% BAD_PARAM - OMG
+'BAD_PARAM'(?CORBA_OMGVMCID bor 1) -> "Failure to register, unregister, or
+lookup value factory";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 2) -> "RID already defined in IFR";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 3) -> "Name already used in the context in IFR";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 4) -> "Target is not a valid container";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 5) -> "Name clash in inherited context";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 6) -> "Incorrect type for abstract interface";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 7) -> "string_to_object conversion failed
+due to bad scheme name";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 8) -> "string_to_object conversion failed
+due to bad address";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 9) -> "string_to_object conversion failed
+due to bad bad schema specific part";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 10) -> "string_to_object conversion failed
+due to non specific reason";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 11) -> "Attempt to derive abstract interface
+from non-abstract base interface
+in the Interface Repository";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 12) -> "Attempt to let a ValueDef support
+more than one non-abstract interface
+in the Interface Repository";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 13) -> "Attempt to use an incomplete
+TypeCode as a parameter";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 14) -> "Invalid object id passed to
+POA::create_reference_by_id";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 15) -> "Bad name argument in TypeCode operation";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 16) -> "Bad RepositoryId argument in TypeCode
+operation";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 17) -> "Invalid member name in TypeCode operation";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 18) -> "Duplicate label value in create_union_tc";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 19) -> "Incompatible TypeCode of label and
+discriminator in create_union_tc";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 20) -> "Supplied discriminator type illegitimate
+in create_union_tc";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 21) -> "Any passed to ServerRequest::set_exception
+does not contain an exception";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 22) -> "Unlisted user exception passed to
+ServerRequest::set_exception";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 23) -> "wchar transmission code set not
+in service context";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 24) -> "Service context is not in OMG-defined range";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 25) -> "Enum value out of range";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 26) -> "Invalid service context Id in portable
+interceptor";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 27) -> "Attempt to call register_initial_reference
+with a null Object";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 28) -> "Invalid component Id in
+portable interceptor";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 29) -> "Invalid profile Id in portable
+interceptor";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 30) -> "Two or more Policy objects with the
+same PolicyType value supplied to
+Object::set_policy_overrides or
+PolicyManager::set_policy_overrides";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 31) -> "Attempt to define a oneway
+operation with non-void result,
+out or inout parameters or user
+exceptions";
+'BAD_PARAM'(?CORBA_OMGVMCID bor 32) -> "DII asked to create request
+for an implicit operation";
+%% BAD_PARAM - Orber
+'BAD_PARAM'(?ORBER_VMCID bor 1) -> "Bad return value from the objects
+init-function (create phase) or invalid
+options suuplied";
+'BAD_PARAM'(_) -> "-".
+
+%% NO_MEMORY - OMG
+'NO_MEMORY'(_) -> "-".
+
+%% IMP_LIMIT - OMG
+'IMP_LIMIT'(?CORBA_OMGVMCID bor 1) -> "Unable to use any profile in IOR";
+%% IMP_LIMIT - Orber
+'IMP_LIMIT'(?ORBER_VMCID bor 1) -> "All ports assigned to the configuration
+parameter 'iiop_out_ports' are in use";
+'IMP_LIMIT'(_) -> "-".
+
+%% COMM_FAILURE - OMG
+%% COMM_FAILURE - Orber
+'COMM_FAILURE'(?ORBER_VMCID bor 1) -> "Unable to connect to another ORB -
+probably inactive";
+'COMM_FAILURE'(?ORBER_VMCID bor 2) -> "Unable to connect to another ORB -
+interceptor(s) rejected it or behaves
+badly";
+'COMM_FAILURE'(?ORBER_VMCID bor 3) -> "Request terminated by another process";
+'COMM_FAILURE'(?ORBER_VMCID bor 4) -> "Unable to connect to another ORB - timed out";
+'COMM_FAILURE'(_) -> "-".
+
+%% INV_OBJREF - OMG
+'INV_OBJREF'(?CORBA_OMGVMCID bor 1) -> "wchar Code Set support not specified";
+'INV_OBJREF'(?CORBA_OMGVMCID bor 2) -> "Codeset component required for type using wchar or wstring data";
+'INV_OBJREF'(_) -> "-".
+
+%% NO_PERMISSION - OMG
+'NO_PERMISSION'(_) -> "-".
+
+%% INTERNAL - OMG
+%% INTERNAL - Orber
+'INTERNAL'(?ORBER_VMCID bor 1) -> "Unable to connect to an Orber installation";
+'INTERNAL'(?ORBER_VMCID bor 2) -> "Failed to register internal objectkey in the database";
+'INTERNAL'(_) -> "-".
+
+%% MARSHAL - OMG
+'MARSHAL'(?CORBA_OMGVMCID bor 1) -> "Unable to locate value factory";
+'MARSHAL'(?CORBA_OMGVMCID bor 2) -> "ServerRequest::set_result called
+before ServerRequest::ctx when the
+operation IDL contains a context
+clause";
+'MARSHAL'(?CORBA_OMGVMCID bor 3) -> "NVList passed to
+ServerRequest::arguments does not
+describe all parameters passed
+by client";
+'MARSHAL'(?CORBA_OMGVMCID bor 4) -> "Attempt to marshal Local object";
+'MARSHAL'(?CORBA_OMGVMCID bor 5) -> "wchar or wstring data erroneosly
+sent by client over GIOP 1.0
+connection";
+'MARSHAL'(?CORBA_OMGVMCID bor 6) -> "wchar or wstring data erroneously
+returned by server over GIOP 1.0
+connection";
+%% MARSHAL - Orber
+'MARSHAL'(?ORBER_VMCID bor 1) -> "Integer overflow";
+'MARSHAL'(?ORBER_VMCID bor 2) -> "Passed a non-integer,
+when it must be an integer";
+'MARSHAL'(?ORBER_VMCID bor 3) -> "Incorrect boolean";
+'MARSHAL'(?ORBER_VMCID bor 4) -> "Passed a non-number,
+when it must be a float, double
+or long double";
+'MARSHAL'(?ORBER_VMCID bor 5) -> "Bad enumerant - does not exist";
+'MARSHAL'(?ORBER_VMCID bor 6) -> "Passed something else but character
+or octet";
+'MARSHAL'(?ORBER_VMCID bor 7) -> "Unable to marshal the supplied
+typecode";
+'MARSHAL'(?ORBER_VMCID bor 8) -> "Unable to un-marshal the supplied
+typecode";
+'MARSHAL'(?ORBER_VMCID bor 9) -> "Union IFR-id does not exist";
+'MARSHAL'(?ORBER_VMCID bor 10) -> "Struct IFR-id does not exist";
+'MARSHAL'(?ORBER_VMCID bor 11) -> "Empty string supplied as IFR-id";
+'MARSHAL'(?ORBER_VMCID bor 12) -> "Unable to decode target address";
+'MARSHAL'(?ORBER_VMCID bor 13) -> "Incorrect TypeCode or unsupported
+data type";
+'MARSHAL'(?ORBER_VMCID bor 14) -> "The Fixed type does not match the
+defined digits/scale parameters";
+'MARSHAL'(?ORBER_VMCID bor 15) -> "The supplied array is to long or to short";
+'MARSHAL'(?ORBER_VMCID bor 16) -> "String/Wstring exceeds maximum length";
+'MARSHAL'(?ORBER_VMCID bor 17) -> "To few or to many parameters supplied";
+'MARSHAL'(?ORBER_VMCID bor 18) -> "Unable to decode message header";
+'MARSHAL'(?ORBER_VMCID bor 19) -> "Sequnce exceeds maximum length";
+'MARSHAL'(_) -> "-".
+
+%% INITIALIZE - OMG
+'INITIALIZE'(_) -> "-".
+
+%% NO_IMPLEMENT - OMG
+'NO_IMPLEMENT'(?CORBA_OMGVMCID bor 1) -> "Missing local value implementation";
+'NO_IMPLEMENT'(?CORBA_OMGVMCID bor 2) -> "Incompatible value implementation version";
+'NO_IMPLEMENT'(?CORBA_OMGVMCID bor 3) -> "Unable to use any profile in IOR";
+'NO_IMPLEMENT'(?CORBA_OMGVMCID bor 4) -> "Attempt to use DII on Local object";
+'NO_IMPLEMENT'(_) -> "-".
+
+
+%% BAD_TYPECODE - OMG
+'BAD_TYPECODE'(?CORBA_OMGVMCID bor 1) -> "Attempt to marshal incomplete
+TypeCode";
+'BAD_TYPECODE'(?CORBA_OMGVMCID bor 2) -> "Member type code illegitimate
+in TypeCode operation";
+'BAD_TYPECODE'(_) -> "-".
+
+%% BAD_OPERATION - OMG
+'BAD_OPERATION'(?CORBA_OMGVMCID bor 1) -> "ServantManager returned wrong
+servant type";
+%% BAD_OPERATION - Orber
+'BAD_OPERATION'(?ORBER_VMCID bor 1) -> "Incorrect instance type for this
+operation";
+'BAD_OPERATION'(?ORBER_VMCID bor 2) -> "Incorrect instance type for this
+operation (one-way)";
+'BAD_OPERATION'(?ORBER_VMCID bor 3) -> "The IC option 'handle_info' was
+not used when compiling the stub";
+'BAD_OPERATION'(?ORBER_VMCID bor 4) -> "Incorrect instance type for the
+invoked operation (two- or one-way)";
+'BAD_OPERATION'(_) -> "-".
+
+%% NO_RESOURCES - OMG
+'NO_RESOURCES'(?CORBA_OMGVMCID bor 1) -> "Portable Interceptor operation
+not supported in this binding";
+'NO_RESOURCES'(_) -> "-".
+
+%% NO_RESPONSE - OMG
+'NO_RESPONSE'(_) -> "-".
+
+%% PERSIST_STORE - OMG
+'PERSIST_STORE'(_) -> "-".
+
+%% BAD_INV_ORDER - OMG
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 1) -> "Dependency exists in IFR preventing
+destruction of this object";
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 2) -> "Attempt to destroy indestructible
+objects in IFR";
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 3) -> "Operation would deadlock";
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 4) -> "ORB has shutdown";
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 5) -> "Attempt to invoke send or invoke
+operation of the same Request object
+more than once";
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 6) -> "Attempt to set a servant manager
+after one has already been set";
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 7) -> "ServerRequest::arguments called more
+than once or after a call to
+ServerRequest:: set_exception";
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 8) -> "ServerRequest::ctx called more than
+once or before ServerRequest::arguments or
+after ServerRequest::ctx, ServerRequest::set_result
+or ServerRequest::set_exception";
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 9) -> "ServerRequest::set_result called more
+than once or before ServerRequest::arguments
+or after ServerRequest::set_result or
+ServerRequest::set_exception";
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 10) -> "Attempt to send a DII request after
+it was sent previously";
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 11) -> "Attempt to poll a DII request or to
+retrieve its result before the request
+was sent";
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 12) -> "Attempt to poll a DII request or to
+retrieve its result after the result
+was retrieved previously";
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 13) -> "Attempt to poll a synchronous DII
+request or to retrieve results from
+a synchronous DII request";
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 14) -> "Invalid portable interceptor call";
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 15) -> "Service context add failed in portable
+interceptor because a service context
+with the given id already exists";
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 16) -> "Registration of PolicyFactory failed
+because a factory already exists for
+the given PolicyType";
+'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 17) -> "POA cannot create POAs while undergoing
+destruction";
+'BAD_INV_ORDER'(_) -> "-".
+
+%% TRANSIENT - OMG
+'TRANSIENT'(?CORBA_OMGVMCID bor 1) -> "Request discarded because of resource
+exhaustion in POA, or because POA
+is in discarding state";
+'TRANSIENT'(?CORBA_OMGVMCID bor 2) -> "No usable profile in IOR";
+'TRANSIENT'(?CORBA_OMGVMCID bor 3) -> "Request cancelled";
+'TRANSIENT'(?CORBA_OMGVMCID bor 4) -> "POA destroyed";
+%% TRANSIENT - Orber
+'TRANSIENT'(?ORBER_VMCID bor 1) -> "Orber is being restarted, or should be,
+on one node in the multi-node Orber
+installation";
+'TRANSIENT'(?ORBER_VMCID bor 2) -> "The node the target object resides on
+is down (multi-node Orber installation)";
+'TRANSIENT'(?ORBER_VMCID bor 3) -> "Received EXIT when invoking an operation
+on an object residing on another
+node in a multi-node Orber installation";
+'TRANSIENT'(?ORBER_VMCID bor 4) -> "Received EXIT when invoking an operation
+on a local object";
+'TRANSIENT'(?ORBER_VMCID bor 5) -> "Received unknown reply when invoking an
+operation on an object residing on
+another node in a multi-node Orber
+installation";
+'TRANSIENT'(?ORBER_VMCID bor 6) -> "Received unknown reply when invoking an
+operation on a local object";
+'TRANSIENT'(?ORBER_VMCID bor 7) -> "Either the stub/skeleton does not exist or an
+incorrect IC-version was used, which does not generate
+the oe_tc/1 or oe_get_interface/1 functions";
+'TRANSIENT'(_) -> "-".
+
+%% FREE_MEM - OMG
+'FREE_MEM'(_) -> "-".
+
+%% INV_IDENT - OMG
+'INV_IDENT'(_) -> "-".
+
+%% INV_FLAG - OMG
+'INV_FLAG'(_) -> "-".
+
+%% INTF_REPOS - OMG
+'INTF_REPOS'(?CORBA_OMGVMCID bor 1) -> "Interface Repository not available";
+'INTF_REPOS'(?CORBA_OMGVMCID bor 2) -> "No entry for requested interface in
+Interface Repository";
+'INTF_REPOS'(_) -> "-".
+
+%% BAD_CONTEXT - OMG
+'BAD_CONTEXT'(_) -> "-".
+
+%% OBJ_ADAPTER - OMG
+'OBJ_ADAPTER'(?CORBA_OMGVMCID bor 1) -> "System exception in
+AdapterActivator::unknown_adapter";
+'OBJ_ADAPTER'(?CORBA_OMGVMCID bor 2) -> "Servant not found [ServantManager]";
+'OBJ_ADAPTER'(?CORBA_OMGVMCID bor 3) -> "No default servant available [POA policy]";
+'OBJ_ADAPTER'(?CORBA_OMGVMCID bor 4) -> "No servant manager available [POA Policy]";
+'OBJ_ADAPTER'(?CORBA_OMGVMCID bor 5) -> "Violation of POA policy by
+ServantActivator::incarnate";
+'OBJ_ADAPTER'(?CORBA_OMGVMCID bor 6) -> "Exception in
+PortableInterceptor::IORInterceptor.components_established";
+%% OBJ_ADAPTER - Orber
+'OBJ_ADAPTER'(?ORBER_VMCID bor 1) -> "Call-back module does not exist";
+'OBJ_ADAPTER'(?ORBER_VMCID bor 2) -> "Missing function or incorrect arity in
+call-back module";
+'OBJ_ADAPTER'(?ORBER_VMCID bor 3) -> "Function exported but arity incorrect";
+'OBJ_ADAPTER'(?ORBER_VMCID bor 4) -> "Unknown error. Call-back module generated
+EXIT";
+'OBJ_ADAPTER'(?ORBER_VMCID bor 5) -> "Call-back module invoked operation on a
+non-existing module";
+'OBJ_ADAPTER'(?ORBER_VMCID bor 6) -> "Missing function or incorrect arity in
+a module invoked via the call-back module";
+'OBJ_ADAPTER'(?ORBER_VMCID bor 7) -> "Function exported but arity incorrect in
+a module invoked via the call-back module";
+'OBJ_ADAPTER'(?ORBER_VMCID bor 8) -> "Call-back module contains a function_clause,
+case_clause or badarith error";
+'OBJ_ADAPTER'(?ORBER_VMCID bor 9) -> "Call-back module invoked operation exported
+by another module which contains a function_clause, case_clause or badarith error";
+'OBJ_ADAPTER'(?ORBER_VMCID bor 10) -> "Unknown EXIT returned by call-back module";
+'OBJ_ADAPTER'(_) -> "-".
+
+%% DATA_CONVERSION - OMG
+'DATA_CONVERSION'(?CORBA_OMGVMCID bor 1) -> "Character does not map to negotiated
+transmission code set";
+'DATA_CONVERSION'(_) -> "-".
+
+%% OBJECT_NOT_EXIST - OMG
+'OBJECT_NOT_EXIST'(?CORBA_OMGVMCID bor 1) -> "Attempt to pass an unactivated
+(unregistered) value as an object reference";
+'OBJECT_NOT_EXIST'(?CORBA_OMGVMCID bor 2) -> "Failed to create or locate Object
+Adapter";
+'OBJECT_NOT_EXIST'(?CORBA_OMGVMCID bor 3) -> "Biomolecular Sequence Analysis
+Service is no longer available";
+'OBJECT_NOT_EXIST'(?CORBA_OMGVMCID bor 4) -> "Object Adapter inactive";
+'OBJECT_NOT_EXIST'(_) -> "-".
+
+%% TRANSACTION_REQUIRED - OMG
+'TRANSACTION_REQUIRED'(_) -> "-".
+
+%% TRANSACTION_ROLLEDBACK - OMG
+'TRANSACTION_ROLLEDBACK'(_) -> "-".
+
+%% INVALID_TRANSACTION - OMG
+'INVALID_TRANSACTION'(_) -> "-".
+
+%% INV_POLICY - OMG
+'INV_POLICY'(?CORBA_OMGVMCID bor 1) -> "Unable to reconcile IOR specified
+policy with effective policy override";
+'INV_POLICY'(?CORBA_OMGVMCID bor 2) -> "Invalid PolicyType";
+'INV_POLICY'(?CORBA_OMGVMCID bor 3) -> "No PolicyFactory has been registered
+for the given PolicyType";
+'INV_POLICY'(_) -> "-".
+
+%% CODESET_INCOMPATIBLE - OMG
+'CODESET_INCOMPATIBLE'(_) -> "-".
+
+%% REBIND - OMG
+'REBIND'(_) -> "-".
+
+%% TIMEOUT - OMG
+'TIMEOUT'(_) -> "-".
+
+%% TRANSACTION_UNAVAILABLE - OMG
+'TRANSACTION_UNAVAILABLE'(_) -> "-".
+
+%% TRANSACTION_MODE - OMG
+'TRANSACTION_MODE'(_) -> "-".
+
+%% BAD_QOS - OMG
+'BAD_QOS'(_) -> "-".
+
diff --git a/lib/orber/src/orber_ifr.erl b/lib/orber/src/orber_ifr.erl
new file mode 100644
index 0000000000..e56672be93
--- /dev/null
+++ b/lib/orber/src/orber_ifr.erl
@@ -0,0 +1,1817 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : corba_ir_impl.erl
+%% Purpose : Interface Repository for CORBA
+%%----------------------------------------------------------------------
+
+%%% NOTES:
+%%%
+%%% For details about known deficiencies in this CORBA IFR
+%%% implementation, see the file ../doc/src/notes.txt.
+%%%
+
+-module(orber_ifr).
+
+-export([
+%%% Public interfaces:
+ init/2,
+ find_repository/0,
+ 'IRObject__get_def_kind'/1,
+ %%'IRObject_destroy'/1,
+ 'Contained__get_def_kind'/1,
+ %%'Contained_destroy'/1,
+ 'Contained__get_id'/1,
+ 'Contained__set_id'/2,
+ 'Contained__get_name'/1,
+ 'Contained__set_name'/2,
+ 'Contained__get_version'/1,
+ 'Contained__set_version'/2,
+ 'Contained__get_defined_in'/1,
+ 'Contained__get_absolute_name'/1,
+ 'Contained__get_containing_repository'/1,
+ 'Contained_describe'/1,
+ 'Contained_move'/4,
+ 'Container__get_def_kind'/1,
+ 'Container_destroy'/1,
+ 'Container_lookup'/2,
+ 'Container_contents'/3,
+ 'Container_lookup_name'/5,
+ 'Container_describe_contents'/4,
+ 'Container_create_module'/4,
+ 'Container_create_constant'/6,
+ 'Container_create_struct'/5,
+ 'Container_create_union'/6,
+ 'Container_create_enum'/5,
+ 'Container_create_alias'/5,
+ 'Container_create_interface'/5,
+ 'Container_create_exception'/5,
+ 'IDLType__get_def_kind'/1,
+ 'IDLType_destroy'/1,
+ 'IDLType__get_type'/1,
+ 'Repository__get_def_kind'/1,
+ 'Repository_destroy'/1,
+ 'Repository_lookup'/2,
+ 'Repository_contents'/3,
+ 'Repository_lookup_name'/5,
+ 'Repository_describe_contents'/4,
+ 'Repository_create_module'/4,
+ 'Repository_create_constant'/6,
+ 'Repository_create_struct'/5,
+ 'Repository_create_union'/6,
+ 'Repository_create_enum'/5,
+ 'Repository_create_alias'/5,
+ 'Repository_create_interface'/5,
+ 'Repository_create_exception'/5,
+ 'Repository_lookup_id'/2,
+ 'Repository_get_primitive'/2,
+ 'Repository_create_string'/2,
+ 'Repository_create_wstring'/2,
+ 'Repository_create_sequence'/3,
+ 'Repository_create_array'/3,
+ 'Repository_create_idltype'/2, %not in CORBA 2.0
+ 'ModuleDef__get_def_kind'/1,
+ 'ModuleDef_destroy'/1,
+ 'ModuleDef_lookup'/2,
+ 'ModuleDef_contents'/3,
+ 'ModuleDef_lookup_name'/5,
+ 'ModuleDef_describe_contents'/4,
+ 'ModuleDef_create_module'/4,
+ 'ModuleDef_create_constant'/6,
+ 'ModuleDef_create_struct'/5,
+ 'ModuleDef_create_union'/6,
+ 'ModuleDef_create_enum'/5,
+ 'ModuleDef_create_alias'/5,
+ 'ModuleDef_create_interface'/5,
+ 'ModuleDef_create_exception'/5,
+ 'ModuleDef__get_id'/1,
+ 'ModuleDef__set_id'/2,
+ 'ModuleDef__get_name'/1,
+ 'ModuleDef__set_name'/2,
+ 'ModuleDef__get_version'/1,
+ 'ModuleDef__set_version'/2,
+ 'ModuleDef__get_defined_in'/1,
+ 'ModuleDef__get_absolute_name'/1,
+ 'ModuleDef__get_containing_repository'/1,
+ 'ModuleDef_describe'/1,
+ 'ModuleDef_move'/4,
+ 'ConstantDef__get_def_kind'/1,
+ 'ConstantDef_destroy'/1,
+ 'ConstantDef__get_id'/1,
+ 'ConstantDef__set_id'/2,
+ 'ConstantDef__get_name'/1,
+ 'ConstantDef__set_name'/2,
+ 'ConstantDef__get_version'/1,
+ 'ConstantDef__set_version'/2,
+ 'ConstantDef__get_defined_in'/1,
+ 'ConstantDef__get_absolute_name'/1,
+ 'ConstantDef__get_containing_repository'/1,
+ 'ConstantDef_describe'/1,
+ 'ConstantDef_move'/4,
+ 'ConstantDef__get_type'/1,
+ 'ConstantDef__get_type_def'/1,
+ 'ConstantDef__set_type_def'/2,
+ 'ConstantDef__get_value'/1,
+ 'ConstantDef__set_value'/2,
+ 'TypedefDef__get_def_kind'/1,
+ 'TypedefDef_destroy'/1,
+ 'TypedefDef__get_id'/1,
+ 'TypedefDef__set_id'/2,
+ 'TypedefDef__get_name'/1,
+ 'TypedefDef__set_name'/2,
+ 'TypedefDef__get_version'/1,
+ 'TypedefDef__set_version'/2,
+ 'TypedefDef__get_defined_in'/1,
+ 'TypedefDef__get_absolute_name'/1,
+ 'TypedefDef__get_containing_repository'/1,
+ 'TypedefDef_describe'/1,
+ 'TypedefDef_move'/4,
+ 'TypedefDef__get_type'/1,
+ 'StructDef__get_def_kind'/1,
+ 'StructDef_destroy'/1,
+ 'StructDef__get_id'/1,
+ 'StructDef__set_id'/2,
+ 'StructDef__get_name'/1,
+ 'StructDef__set_name'/2,
+ 'StructDef__get_version'/1,
+ 'StructDef__set_version'/2,
+ 'StructDef__get_defined_in'/1,
+ 'StructDef__get_absolute_name'/1,
+ 'StructDef__get_containing_repository'/1,
+ 'StructDef_describe'/1,
+ 'StructDef_move'/4,
+ 'StructDef__get_type'/1,
+ 'StructDef__get_members'/1,
+ 'StructDef__set_members'/2,
+ 'UnionDef__get_def_kind'/1,
+ 'UnionDef_destroy'/1,
+ 'UnionDef__get_id'/1,
+ 'UnionDef__set_id'/2,
+ 'UnionDef__get_name'/1,
+ 'UnionDef__set_name'/2,
+ 'UnionDef__get_version'/1,
+ 'UnionDef__set_version'/2,
+ 'UnionDef__get_defined_in'/1,
+ 'UnionDef__get_absolute_name'/1,
+ 'UnionDef__get_containing_repository'/1,
+ 'UnionDef_describe'/1,
+ 'UnionDef_move'/4,
+ 'UnionDef__get_type'/1,
+ 'UnionDef__get_discriminator_type'/1,
+ 'UnionDef__get_discriminator_type_def'/1,
+ 'UnionDef__set_discriminator_type_def'/2,
+ 'UnionDef__get_members'/1,
+ 'UnionDef__set_members'/2,
+ 'EnumDef__get_def_kind'/1,
+ 'EnumDef_destroy'/1,
+ 'EnumDef__get_id'/1,
+ 'EnumDef__set_id'/2,
+ 'EnumDef__get_name'/1,
+ 'EnumDef__set_name'/2,
+ 'EnumDef__get_version'/1,
+ 'EnumDef__set_version'/2,
+ 'EnumDef__get_defined_in'/1,
+ 'EnumDef__get_absolute_name'/1,
+ 'EnumDef__get_containing_repository'/1,
+ 'EnumDef_describe'/1,
+ 'EnumDef_move'/4,
+ 'EnumDef__get_type'/1,
+ 'EnumDef__get_members'/1,
+ 'EnumDef__set_members'/2,
+ 'AliasDef__get_def_kind'/1,
+ 'AliasDef_destroy'/1,
+ 'AliasDef__get_id'/1,
+ 'AliasDef__set_id'/2,
+ 'AliasDef__get_name'/1,
+ 'AliasDef__set_name'/2,
+ 'AliasDef__get_version'/1,
+ 'AliasDef__set_version'/2,
+ 'AliasDef__get_defined_in'/1,
+ 'AliasDef__get_absolute_name'/1,
+ 'AliasDef__get_containing_repository'/1,
+ 'AliasDef_describe'/1,
+ 'AliasDef_move'/4,
+ 'AliasDef__get_type'/1,
+ 'AliasDef__get_original_type_def'/1,
+ 'AliasDef__set_original_type_def'/2,
+ 'PrimitiveDef__get_def_kind'/1,
+ 'PrimitiveDef_destroy'/1,
+ 'PrimitiveDef__get_type'/1,
+ 'PrimitiveDef__get_kind'/1,
+ 'StringDef__get_def_kind'/1,
+ 'StringDef_destroy'/1,
+ 'StringDef__get_type'/1,
+ 'StringDef__get_bound'/1,
+ 'StringDef__set_bound'/2,
+ 'WstringDef__get_def_kind'/1,
+ 'WstringDef_destroy'/1,
+ 'WstringDef__get_type'/1,
+ 'WstringDef__get_bound'/1,
+ 'WstringDef__set_bound'/2,
+ 'FixedDef__get_def_kind'/1,
+ 'FixedDef_destroy'/1,
+ 'FixedDef__get_type'/1,
+ 'FixedDef__get_digits'/1,
+ 'FixedDef__set_digits'/2,
+ 'FixedDef__get_scale'/1,
+ 'FixedDef__set_scale'/2,
+ 'SequenceDef__get_def_kind'/1,
+ 'SequenceDef_destroy'/1,
+ 'SequenceDef__get_type'/1,
+ 'SequenceDef__get_bound'/1,
+ 'SequenceDef__set_bound'/2,
+ 'SequenceDef__get_element_type'/1,
+ 'SequenceDef__get_element_type_def'/1,
+ 'SequenceDef__set_element_type_def'/2,
+ 'ArrayDef__get_def_kind'/1,
+ 'ArrayDef_destroy'/1,
+ 'ArrayDef__get_type'/1,
+ 'ArrayDef__get_length'/1,
+ 'ArrayDef__set_length'/2,
+ 'ArrayDef__get_element_type'/1,
+ 'ArrayDef__get_element_type_def'/1,
+ 'ArrayDef__set_element_type_def'/2,
+ 'ExceptionDef__get_def_kind'/1,
+ 'ExceptionDef_destroy'/1,
+ 'ExceptionDef__get_id'/1,
+ 'ExceptionDef__set_id'/2,
+ 'ExceptionDef__get_name'/1,
+ 'ExceptionDef__set_name'/2,
+ 'ExceptionDef__get_version'/1,
+ 'ExceptionDef__set_version'/2,
+ 'ExceptionDef__get_defined_in'/1,
+ 'ExceptionDef__get_absolute_name'/1,
+ 'ExceptionDef__get_containing_repository'/1,
+ 'ExceptionDef_describe'/1,
+ 'ExceptionDef_move'/4,
+ 'ExceptionDef__get_type'/1,
+ 'ExceptionDef__get_members'/1,
+ 'ExceptionDef__set_members'/2,
+ 'AttributeDef__get_def_kind'/1,
+ 'AttributeDef_destroy'/1,
+ 'AttributeDef__get_id'/1,
+ 'AttributeDef__set_id'/2,
+ 'AttributeDef__get_name'/1,
+ 'AttributeDef__set_name'/2,
+ 'AttributeDef__get_version'/1,
+ 'AttributeDef__set_version'/2,
+ 'AttributeDef__get_defined_in'/1,
+ 'AttributeDef__get_absolute_name'/1,
+ 'AttributeDef__get_containing_repository'/1,
+ 'AttributeDef_describe'/1,
+ 'AttributeDef_move'/4,
+ 'AttributeDef__get_type'/1,
+ 'AttributeDef__get_type_def'/1,
+ 'AttributeDef__set_type_def'/2,
+ 'AttributeDef__get_mode'/1,
+ 'AttributeDef__set_mode'/2,
+ 'OperationDef__get_def_kind'/1,
+ 'OperationDef_destroy'/1,
+ 'OperationDef__get_id'/1,
+ 'OperationDef__set_id'/2,
+ 'OperationDef__get_name'/1,
+ 'OperationDef__set_name'/2,
+ 'OperationDef__get_version'/1,
+ 'OperationDef__set_version'/2,
+ 'OperationDef__get_defined_in'/1,
+ 'OperationDef__get_absolute_name'/1,
+ 'OperationDef__get_containing_repository'/1,
+ 'OperationDef_describe'/1,
+ 'OperationDef_move'/4,
+ 'OperationDef__get_result'/1,
+ 'OperationDef__get_result_def'/1,
+ 'OperationDef__set_result_def'/2,
+ 'OperationDef__get_params'/1,
+ 'OperationDef__set_params'/2,
+ 'OperationDef__get_mode'/1,
+ 'OperationDef__set_mode'/2,
+ 'OperationDef__get_contexts'/1,
+ 'OperationDef__set_contexts'/2,
+ 'OperationDef__get_exceptions'/1,
+ 'OperationDef__set_exceptions'/2,
+ 'InterfaceDef__get_def_kind'/1,
+ 'InterfaceDef_destroy'/1,
+ 'InterfaceDef_lookup'/2,
+ 'InterfaceDef_contents'/3,
+ 'InterfaceDef_lookup_name'/5,
+ 'InterfaceDef_describe_contents'/4,
+ 'InterfaceDef_create_module'/4,
+ 'InterfaceDef_create_constant'/6,
+ 'InterfaceDef_create_struct'/5,
+ 'InterfaceDef_create_union'/6,
+ 'InterfaceDef_create_enum'/5,
+ 'InterfaceDef_create_alias'/5,
+ 'InterfaceDef_create_interface'/5,
+ 'InterfaceDef_create_exception'/5,
+ 'InterfaceDef__get_id'/1,
+ 'InterfaceDef__set_id'/2,
+ 'InterfaceDef__get_name'/1,
+ 'InterfaceDef__set_name'/2,
+ 'InterfaceDef__get_version'/1,
+ 'InterfaceDef__set_version'/2,
+ 'InterfaceDef__get_defined_in'/1,
+ 'InterfaceDef__get_absolute_name'/1,
+ 'InterfaceDef__get_containing_repository'/1,
+ 'InterfaceDef_describe'/1,
+ 'InterfaceDef_move'/4,
+ 'InterfaceDef__get_type'/1,
+ 'InterfaceDef__get_base_interfaces'/1,
+ 'InterfaceDef__set_base_interfaces'/2,
+ 'InterfaceDef_is_a'/2,
+ 'InterfaceDef_describe_interface'/1,
+ 'InterfaceDef_create_attribute'/6,
+ 'InterfaceDef_create_operation'/9,
+ %%'TypeCode_equal'/2,
+ %%'TypeCode_kind'/1,
+ %%'TypeCode_id'/1,
+ %%'TypeCode_name'/1,
+ %%'TypeCode_member_count'/1,
+ %%'TypeCode_member_name'/2,
+ %%'TypeCode_member_type'/2,
+ %%'TypeCode_member_label'/2,
+ %%'TypeCode_discriminator_type'/1,
+ %%'TypeCode_default_index'/1,
+ %%'TypeCode_length'/1,
+ %%'TypeCode_content_type'/1,
+ %%'TypeCode_param_count'/1,
+ %%'TypeCode_parameter'/2,
+ 'ORB_create_struct_tc'/3,
+ 'ORB_create_union_tc'/4,
+ 'ORB_create_enum_tc'/3,
+ 'ORB_create_alias_tc'/3,
+ 'ORB_create_exception_tc'/3,
+ 'ORB_create_interface_tc'/2,
+ 'ORB_create_string_tc'/1,
+ 'ORB_create_wstring_tc'/1,
+ 'ORB_create_sequence_tc'/2,
+ 'ORB_create_recursive_sequence_tc'/2,
+ 'ORB_create_array_tc'/2,
+%%% "Methods" of the IFR "objects"
+ get_def_kind/1,
+ destroy/1,
+ get_id/1,
+ set_id/2,
+ get_name/1,
+ set_name/2,
+ get_version/1,
+ set_version/2,
+ get_defined_in/1,
+ get_absolute_name/1,
+ get_containing_repository/1,
+ describe/1,
+ move/4,
+ lookup/2,
+ contents/3,
+ lookup_name/5,
+ describe_contents/4,
+ create_module/4,
+ create_constant/6,
+ create_struct/5,
+ create_union/6,
+ create_enum/5,
+ create_alias/5,
+ create_interface/5,
+ create_exception/5,
+ get_type/1,
+ lookup_id/2,
+ get_primitive/2,
+ create_string/2,
+ create_wstring/2,
+ create_sequence/3,
+ create_array/3,
+ create_idltype/2, %not in CORBA 2.0
+ create_fixed/3,
+ get_type_def/1,
+ set_type_def/2,
+ get_value/1,
+ set_value/2,
+ get_members/1,
+ set_members/2,
+ get_discriminator_type/1,
+ get_discriminator_type_def/1,
+ set_discriminator_type_def/2,
+ get_original_type_def/1,
+ set_original_type_def/2,
+ get_kind/1,
+ get_bound/1,
+ set_bound/2,
+ get_element_type/1,
+ get_element_type_def/1,
+ set_element_type_def/2,
+ get_length/1,
+ set_length/2,
+ get_mode/1,
+ set_mode/2,
+ get_result/1,
+ get_result_def/1,
+ set_result_def/2,
+ get_params/1,
+ set_params/2,
+ get_contexts/1,
+ set_contexts/2,
+ get_exceptions/1,
+ set_exceptions/2,
+ get_base_interfaces/1,
+ set_base_interfaces/2,
+ is_a/2,
+ describe_interface/1,
+ create_attribute/6,
+ create_operation/9
+ ]).
+
+%% Light IFR operations
+-export([initialize/3,
+ get_module/2,
+ get_tc/2,
+ add_module/3, add_module/4,
+ add_constant/3, add_constant/4,
+ add_struct/3, add_struct/4,
+ add_union/3, add_union/4,
+ add_enum/3, add_enum/4,
+ add_alias/3, add_alias/4,
+ add_interface/3, add_interface/4,
+ add_exception/3, add_exception/4,
+ remove/2,
+ add_items/3]).
+
+
+-include_lib("orber/include/corba.hrl").
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+
+%%======================================================================
+%% Public interfaces to the IFR
+%%======================================================================
+%%=================== Light IFR operations =============================
+%%----------------------------------------------------------------------
+%% Function : get_module
+%% Arguments : Id - string()
+%% Type - ?IFR_ModuleDef | ?IFR_ConstantDef | ?IFR_StructDef |
+%% ?IFR_UnionDef | ?IFR_EnumDef | ?IFR_AliasDef |
+%% ?IFR_InterfaceDef | ?IFR_ExceptionDef
+%% Returns : Module - atom() | {'EXCEPTION', E}
+%% Raises : #'MARSHAL'{}
+%% Description:
+%%----------------------------------------------------------------------
+get_module(Id, Type) ->
+ case mnesia:dirty_read(orber_light_ifr, Id) of
+ [#orber_light_ifr{module = Module, type = Type}] ->
+ Module;
+ What ->
+ orber:dbg("[~p] ~p:get_module(~p, ~p).~n"
+ "Id doesn't exist, mismatch Id vs Type or DB error: ~p",
+ [?LINE, ?MODULE, Id, What], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE})
+ end.
+
+
+%%----------------------------------------------------------------------
+%% Function : get_tc
+%% Arguments : Id - string()
+%% Type - ?IFR_ModuleDef | ?IFR_ConstantDef | ?IFR_StructDef |
+%% ?IFR_UnionDef | ?IFR_EnumDef | ?IFR_AliasDef |
+%% ?IFR_InterfaceDef | ?IFR_ExceptionDef
+%% Returns : Module - atom() | {'EXCEPTION', E}
+%% Raises : #'MARSHAL'{}
+%% Description: This function may *only* return correct TypeCode or raise
+%% a system exception!!
+%%----------------------------------------------------------------------
+get_tc(Id, Type) ->
+ case catch mnesia:dirty_read(orber_light_ifr, Id) of
+ [#orber_light_ifr{module = Module, type = Type}] ->
+ case catch Module:tc() of
+ {'EXIT', Reason} ->
+ case Reason of
+ {undef,[{Module, tc,[]}|_]} ->
+ orber:dbg("[~p] ~p:get_tc(~p);~nMissing ~p:tc()~n",
+ [?LINE, ?MODULE, Id, Module], ?DEBUG_LEVEL),
+ corba:raise(#'UNKNOWN'{minor=(?ORBER_VMCID bor 1),
+ completion_status=?COMPLETED_MAYBE});
+ _ ->
+ orber:dbg("[~p] ~p:get_tc(~p, ~p);~nEXIT reason: ~p~n",
+ [?LINE, ?MODULE, Id, Module, Reason],
+ ?DEBUG_LEVEL),
+ corba:raise(#'UNKNOWN'{minor=(?CORBA_OMGVMCID bor 1),
+ completion_status=?COMPLETED_MAYBE})
+ end;
+ TC ->
+ TC
+ end;
+ What when Type == ?IFR_ExceptionDef ->
+ orber:dbg("[~p] ~p:get_tc(~p, ExceptionDef);~nUnknown: ~p~n",
+ [?LINE, ?MODULE, Id, What], ?DEBUG_LEVEL),
+ corba:raise(#'UNKNOWN'{completion_status=?COMPLETED_MAYBE});
+ What ->
+ orber:dbg("[~p] ~p:get_tc(~p, ~p);~nUnknown: ~p~n",
+ [?LINE, ?MODULE, Id, Type, What], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE})
+ end.
+
+%%----------------------------------------------------------------------
+%% Function : initialize
+%% Arguments : Timeout - integer() | infinity
+%% Options - [{Key, Value}]
+%% LightIFR - true | false
+%% Returns : ok | {'EXCEPTION', E}
+%% Raises : #'INTF_REPOS'{}
+%% Description:
+%%----------------------------------------------------------------------
+initialize(Timeout, Options, LightIFR) ->
+ orber_ifr_utils:init_DB(Timeout, Options, LightIFR).
+
+%%----------------------------------------------------------------------
+%% Function : add_X
+%% Arguments : Id - string()
+%% Module - atom()
+%% BaseId - string()
+%% Returns :
+%% Raises :
+%% Description:
+%%----------------------------------------------------------------------
+add_module(Id, Module, BaseId) ->
+ add_it(Id, Module, BaseId, ?IFR_ModuleDef, false).
+add_module(Id, Module, BaseId, Transaction) ->
+ add_it(Id, Module, BaseId, ?IFR_ModuleDef, Transaction).
+
+add_constant(Id, Module, BaseId) ->
+ add_it(Id, Module, BaseId, ?IFR_ConstantDef, false).
+add_constant(Id, Module, BaseId, Transaction) ->
+ add_it(Id, Module, BaseId, ?IFR_ConstantDef, Transaction).
+
+add_struct(Id, Module, BaseId) ->
+ add_it(Id, Module, BaseId, ?IFR_StructDef, false).
+add_struct(Id, Module, BaseId, Transaction) ->
+ add_it(Id, Module, BaseId, ?IFR_StructDef, Transaction).
+
+add_union(Id, Module, BaseId) ->
+ add_it(Id, Module, BaseId, ?IFR_UnionDef, false).
+add_union(Id, Module, BaseId, Transaction) ->
+ add_it(Id, Module, BaseId, ?IFR_UnionDef, Transaction).
+
+add_enum(Id, Module, BaseId) ->
+ add_it(Id, Module, BaseId, ?IFR_EnumDef, false).
+add_enum(Id, Module, BaseId, Transaction) ->
+ add_it(Id, Module, BaseId, ?IFR_EnumDef, Transaction).
+
+add_alias(Id, Module, BaseId) ->
+ add_it(Id, Module, BaseId, ?IFR_AliasDef, false).
+add_alias(Id, Module, BaseId, Transaction) ->
+ add_it(Id, Module, BaseId, ?IFR_AliasDef, Transaction).
+
+add_interface(Id, Module, BaseId) ->
+ add_it(Id, Module, BaseId, ?IFR_InterfaceDef, false).
+add_interface(Id, Module, BaseId, Transaction) ->
+ add_it(Id, Module, BaseId, ?IFR_InterfaceDef, Transaction).
+
+add_exception(Id, Module, BaseId) ->
+ add_it(Id, Module, BaseId, ?IFR_ExceptionDef, false).
+add_exception(Id, Module, BaseId, Transaction) ->
+ add_it(Id, Module, BaseId, ?IFR_ExceptionDef, Transaction).
+
+
+%%----------------------------------------------------------------------
+%% Function : add_it
+%% Arguments : Id - string()
+%% Module - atom()
+%% BaseId - string()
+%% Type - ?IFR_ModuleDef | ?IFR_ConstantDef | ?IFR_StructDef |
+%% ?IFR_UnionDef | ?IFR_EnumDef | ?IFR_AliasDef |
+%% ?IFR_InterfaceDef | ?IFR_ExceptionDef
+%% Transaction - true | false
+%% Returns :
+%% Raises :
+%% Description:
+%%----------------------------------------------------------------------
+add_it(Id, Module, BaseId, Type, true) ->
+ F = fun() ->
+ D = #orber_light_ifr{id = Id, module = Module,
+ type = Type, base_id = BaseId},
+ mnesia:write(D)
+ end,
+ case mnesia:transaction(F) of
+ {aborted, Reason} ->
+ orber:dbg("[~p] orber_ifr:add_it(~p). aborted:~n~p~n",
+ [?LINE, Id, Reason], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO});
+ {atomic, _} ->
+ ok
+ end;
+add_it(Id, Module, BaseId, Type, false) ->
+ D = #orber_light_ifr{id = Id, module = Module,
+ type = Type, base_id = BaseId},
+ mnesia:write(D).
+
+%%----------------------------------------------------------------------
+%% Function : remove
+%% Arguments : BaseId - atom()
+%% Options - [KeyValue]
+%% KeyValue - {storage, mnesia | ets}
+%% Returns :
+%% Raises :
+%% Description:
+%%----------------------------------------------------------------------
+remove(ContainerId, _Options) ->
+ F = fun() ->
+ MatchHead = #orber_light_ifr{id = '$1', base_id = ContainerId, _='_'},
+ Result = '$1',
+ IdList = mnesia:select(orber_light_ifr,
+ [{MatchHead, [], [Result]}],
+ write),
+ lists:foreach(fun(RefId) ->
+ mnesia:delete({orber_light_ifr, RefId})
+ end, IdList)
+ end,
+ case mnesia:transaction(F) of
+ {aborted, Reason} ->
+ orber:dbg("[~p] orber_ifr:remove(~p). aborted:~n~p~n",
+ [?LINE, ContainerId, Reason], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO});
+ {atomic, _} ->
+ ok
+ end.
+
+%%----------------------------------------------------------------------
+%% Function : add_items
+%% Arguments : ContainerId - atom()
+%% Options - [KeyValue]
+%% KeyValue - {storage, mnesia | ets}
+%% Items - [{Id, Module, Type}]
+%% Id - string()
+%% Module - atom()
+%% Type - struct | except | union | interface
+%% Returns :
+%% Raises :
+%% Description:
+%%----------------------------------------------------------------------
+add_items(ContainerId, _Options, Items) ->
+ F = fun() ->
+ mnesia:write_lock_table(orber_light_ifr),
+ add_items_helper(Items, ContainerId)
+ end,
+ case mnesia:transaction(F) of
+ {aborted, Reason} ->
+ orber:dbg("[~p] orber_ifr:add_items(~p). aborted:~n~p~n",
+ [?LINE, ContainerId, Reason], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO});
+ {atomic, _} ->
+ ok
+ end.
+
+add_items_helper([{Id, Module, struct}|T], ContainerId) ->
+ add_it(Id, Module, ContainerId, ?IFR_StructDef, false),
+ add_items_helper(T, ContainerId);
+add_items_helper([{Id, Module, interface}|T], ContainerId) ->
+ add_it(Id, Module, ContainerId, ?IFR_InterfaceDef, false),
+ add_items_helper(T, ContainerId);
+add_items_helper([{Id, Module, except}|T], ContainerId) ->
+ add_it(Id, Module, ContainerId, ?IFR_ExceptionDef, false),
+ add_items_helper(T, ContainerId);
+add_items_helper([{Id, Module, union}|T], ContainerId) ->
+ add_it(Id, Module, ContainerId, ?IFR_UnionDef, false),
+ add_items_helper(T, ContainerId);
+add_items_helper([ok], _) ->
+ ok.
+
+
+%%=================== End Light IFR operations =========================
+
+%% Initialize the database
+init(Nodes, Timeout) when is_atom(Timeout) orelse is_integer(Timeout) ->
+ orber_ifr_utils:init_DB(Timeout, [{disc_copies, Nodes}]);
+init(Timeout, Nodes) ->
+ orber_ifr_utils:init_DB(Timeout, [{disc_copies, Nodes}]).
+
+
+%%% Find the repository
+find_repository() ->
+ orber_ifr_utils:create_repository().
+
+'IRObject__get_def_kind'(Objref) ->
+ orber_ifr_irobject:'_get_def_kind'(Objref).
+%%'IRObject_destroy'(Objref) ->
+%% orber_ifr_irobject:destroy(Objref).
+
+'Contained__get_def_kind'(Objref) ->
+ orber_ifr_contained:'_get_def_kind'(Objref).
+%%'Contained_destroy'(Objref) ->
+%% orber_ifr_contained:destroy(Objref).
+'Contained__get_id'(Objref) ->
+ orber_ifr_contained:'_get_id'(Objref).
+'Contained__set_id'(Objref,Id) ->
+ orber_ifr_contained:'_set_id'(Objref,Id).
+'Contained__get_name'(Objref) ->
+ orber_ifr_contained:'_get_name'(Objref).
+'Contained__set_name'(Objref,Name) ->
+ orber_ifr_contained:'_set_name'(Objref,Name).
+'Contained__get_version'(Objref) ->
+ orber_ifr_contained:'_get_version'(Objref).
+'Contained__set_version'(Objref,Version) ->
+ orber_ifr_contained:'_set_version'(Objref,Version).
+'Contained__get_defined_in'(Objref) ->
+ orber_ifr_contained:'_get_defined_in'(Objref).
+'Contained__get_absolute_name'(Objref) ->
+ orber_ifr_contained:'_get_absolute_name'(Objref).
+'Contained__get_containing_repository'(Objref) ->
+ orber_ifr_contained:'_get_containing_repository'(Objref).
+'Contained_describe'(Objref) ->
+ orber_ifr_contained:describe(Objref).
+'Contained_move'(Objref,New_container,New_name,New_version) ->
+ orber_ifr_contained:move(Objref,New_container,New_name,New_version).
+
+'Container__get_def_kind'(Objref) ->
+ orber_ifr_container:'_get_def_kind'(Objref).
+'Container_destroy'(Objref) ->
+ orber_ifr_container:destroy(Objref).
+'Container_lookup'(Objref,Search_name) ->
+ orber_ifr_container:lookup(Objref,Search_name).
+'Container_contents'(Objref,Limit_type,Exclude_inherited) ->
+ orber_ifr_container:contents(Objref,Limit_type,Exclude_inherited).
+'Container_lookup_name'(Objref,Search_name,Levels_to_search,Limit_type,
+ Exclude_inherited) ->
+ orber_ifr_container:lookup_name(Objref,Search_name,Levels_to_search,Limit_type,
+ Exclude_inherited).
+'Container_describe_contents'(Objref,Limit_type,Exclude_inherited,
+ Max_returned_objs) ->
+ orber_ifr_container:describe_contents(Objref,Limit_type,Exclude_inherited,
+ Max_returned_objs).
+'Container_create_module'(Objref,Id,Name,Version) ->
+ orber_ifr_container:create_module(Objref,Id,Name,Version).
+'Container_create_constant'(Objref,Id,Name,Version,Type,Value) ->
+ orber_ifr_container:create_constant(Objref,Id,Name,Version,Type,Value).
+'Container_create_struct'(Objref,Id,Name,Version,Members) ->
+ orber_ifr_container:create_struct(Objref,Id,Name,Version,Members).
+'Container_create_union'(Objref,Id,Name,Version,Discriminator_type,Members) ->
+ orber_ifr_container:create_union(Objref,Id,Name,Version,Discriminator_type,
+ Members).
+'Container_create_enum'(Objref,Id,Name,Version,Members) ->
+ orber_ifr_container:create_enum(Objref,Id,Name,Version,Members).
+'Container_create_alias'(Objref,Id,Name,Version,Original_type) ->
+ orber_ifr_container:create_alias(Objref,Id,Name,Version,Original_type).
+'Container_create_interface'(Objref,Id,Name,Version,Base_interfaces) ->
+ orber_ifr_container:create_interface(Objref,Id,Name,Version,Base_interfaces).
+'Container_create_exception'(Objref,Id,Name,Version,Members) ->
+ orber_ifr_container:create_exception(Objref,Id,Name,Version,Members).
+
+'IDLType__get_def_kind'(Objref) ->
+ orber_ifr_idltype:'_get_def_kind'(Objref).
+'IDLType_destroy'(Objref) ->
+ orber_ifr_idltype:destroy(Objref).
+'IDLType__get_type'(Objref) ->
+ orber_ifr_idltype:'_get_type'(Objref).
+
+'Repository__get_def_kind'(Objref) ->
+ orber_ifr_repository:'_get_def_kind'(Objref).
+'Repository_destroy'(Objref) ->
+ orber_ifr_repository:destroy(Objref).
+'Repository_lookup'(Objref,Search_name) ->
+ orber_ifr_repository:lookup(Objref,Search_name).
+'Repository_contents'(Objref,Limit_type,Exclude_inherited) ->
+ orber_ifr_repository:contents(Objref,Limit_type,Exclude_inherited).
+'Repository_lookup_name'(Objref,Search_name,Levels_to_search,Limit_type,
+ Exclude_inherited) ->
+ orber_ifr_repository:lookup_name(Objref,Search_name,Levels_to_search,Limit_type,
+ Exclude_inherited).
+'Repository_describe_contents'(Objref,Limit_type,Exclude_inherited,
+ Max_returned_objs) ->
+ orber_ifr_repository:describe_contents(Objref,Limit_type,Exclude_inherited,
+ Max_returned_objs).
+'Repository_create_module'(Objref,Id,Name,Version) ->
+ orber_ifr_repository:create_module(Objref,Id,Name,Version).
+'Repository_create_constant'(Objref,Id,Name,Version,Type,Value) ->
+ orber_ifr_repository:create_constant(Objref,Id,Name,Version,Type,Value).
+'Repository_create_struct'(Objref,Id,Name,Version,Members) ->
+ orber_ifr_repository:create_struct(Objref,Id,Name,Version,Members).
+'Repository_create_union'(Objref,Id,Name,Version,Discriminator_type,Members) ->
+ orber_ifr_repository:create_union(Objref,Id,Name,Version,Discriminator_type,
+ Members).
+'Repository_create_enum'(Objref,Id,Name,Version,Members) ->
+ orber_ifr_repository:create_enum(Objref,Id,Name,Version,Members).
+'Repository_create_alias'(Objref,Id,Name,Version,Original_type) ->
+ orber_ifr_repository:create_alias(Objref,Id,Name,Version,Original_type).
+'Repository_create_interface'(Objref,Id,Name,Version,Base_interfaces) ->
+ orber_ifr_repository:create_interface(Objref,Id,Name,Version,Base_interfaces).
+'Repository_create_exception'(Objref,Id,Name,Version,Members) ->
+ orber_ifr_repository:create_exception(Objref,Id,Name,Version,Members).
+'Repository_lookup_id'(Objref,Search_id) ->
+ lookup_id(Objref,Search_id).
+'Repository_get_primitive'(Objref,Kind) ->
+ orber_ifr_repository:get_primitive(Objref,Kind).
+'Repository_create_string'(Objref,Bound) ->
+ orber_ifr_repository:create_string(Objref,Bound).
+'Repository_create_wstring'(Objref,Bound) ->
+ orber_ifr_repository:create_wstring(Objref,Bound).
+'Repository_create_sequence'(Objref,Bound,Element_type) ->
+ orber_ifr_repository:create_sequence(Objref,Bound,Element_type).
+'Repository_create_array'(Objref,Length,Element_type) ->
+ orber_ifr_repository:create_array(Objref,Length,Element_type).
+'Repository_create_idltype'(Objref,Typecode) ->
+ orber_ifr_repository:create_idltype(Objref,Typecode).
+
+'ModuleDef__get_def_kind'(Objref) ->
+ orber_ifr_moduledef:'_get_def_kind'(Objref).
+'ModuleDef_destroy'(Objref) ->
+ orber_ifr_moduledef:destroy(Objref).
+'ModuleDef_lookup'(Objref,Search_name) ->
+ orber_ifr_moduledef:lookup(Objref,Search_name).
+'ModuleDef_contents'(Objref,Limit_type,Exclude_inherited) ->
+ orber_ifr_moduledef:contents(Objref,Limit_type,Exclude_inherited).
+'ModuleDef_lookup_name'(Objref,Search_name,Levels_to_search,Limit_type,
+ Exclude_inherited) ->
+ orber_ifr_moduledef:lookup_name(Objref,Search_name,Levels_to_search,Limit_type,
+ Exclude_inherited).
+'ModuleDef_describe_contents'(Objref,Limit_type,Exclude_inherited,
+ Max_returned_objs) ->
+ orber_ifr_moduledef:describe_contents(Objref,Limit_type,Exclude_inherited,
+ Max_returned_objs).
+'ModuleDef_create_module'(Objref,Id,Name,Version) ->
+ orber_ifr_moduledef:create_module(Objref,Id,Name,Version).
+'ModuleDef_create_constant'(Objref,Id,Name,Version,Type,Value) ->
+ orber_ifr_moduledef:create_constant(Objref,Id,Name,Version,Type,Value).
+'ModuleDef_create_struct'(Objref,Id,Name,Version,Members) ->
+ orber_ifr_moduledef:create_struct(Objref,Id,Name,Version,Members).
+'ModuleDef_create_union'(Objref,Id,Name,Version,Discriminator_type,Members) ->
+ orber_ifr_moduledef:create_union(Objref,Id,Name,Version,Discriminator_type,
+ Members).
+'ModuleDef_create_enum'(Objref,Id,Name,Version,Members) ->
+ orber_ifr_moduledef:create_enum(Objref,Id,Name,Version,Members).
+'ModuleDef_create_alias'(Objref,Id,Name,Version,Original_type) ->
+ orber_ifr_moduledef:create_alias(Objref,Id,Name,Version,Original_type).
+'ModuleDef_create_interface'(Objref,Id,Name,Version,Base_interfaces) ->
+ orber_ifr_moduledef:create_interface(Objref,Id,Name,Version,Base_interfaces).
+'ModuleDef_create_exception'(Objref,Id,Name,Version,Members) ->
+ orber_ifr_moduledef:create_exception(Objref,Id,Name,Version,Members).
+'ModuleDef__get_id'(Objref) ->
+ orber_ifr_moduledef:'_get_id'(Objref).
+'ModuleDef__set_id'(Objref,Id) ->
+ orber_ifr_moduledef:'_set_id'(Objref,Id).
+'ModuleDef__get_name'(Objref) ->
+ orber_ifr_moduledef:'_get_name'(Objref).
+'ModuleDef__set_name'(Objref,Name) ->
+ orber_ifr_moduledef:'_set_name'(Objref,Name).
+'ModuleDef__get_version'(Objref) ->
+ orber_ifr_moduledef:'_get_version'(Objref).
+'ModuleDef__set_version'(Objref,Version) ->
+ orber_ifr_moduledef:'_set_version'(Objref,Version).
+'ModuleDef__get_defined_in'(Objref) ->
+ orber_ifr_moduledef:'_get_defined_in'(Objref).
+'ModuleDef__get_absolute_name'(Objref) ->
+ orber_ifr_moduledef:'_get_absolute_name'(Objref).
+'ModuleDef__get_containing_repository'(Objref) ->
+ orber_ifr_moduledef:'_get_containing_repository'(Objref).
+'ModuleDef_describe'(Objref) ->
+ orber_ifr_moduledef:describe(Objref).
+'ModuleDef_move'(Objref,New_container,New_name,New_version) ->
+ orber_ifr_moduledef:move(Objref,New_container,New_name,New_version).
+
+'ConstantDef__get_def_kind'(Objref) ->
+ orber_ifr_constantdef:'_get_def_kind'(Objref).
+'ConstantDef_destroy'(Objref) ->
+ orber_ifr_constantdef:destroy(Objref).
+'ConstantDef__get_id'(Objref) ->
+ orber_ifr_constantdef:'_get_id'(Objref).
+'ConstantDef__set_id'(Objref,Id) ->
+ orber_ifr_constantdef:'_set_id'(Objref,Id).
+'ConstantDef__get_name'(Objref) ->
+ orber_ifr_constantdef:'_get_name'(Objref).
+'ConstantDef__set_name'(Objref,Name) ->
+ orber_ifr_constantdef:'_set_name'(Objref,Name).
+'ConstantDef__get_version'(Objref) ->
+ orber_ifr_constantdef:'_get_version'(Objref).
+'ConstantDef__set_version'(Objref,Version) ->
+ orber_ifr_constantdef:'_set_version'(Objref,Version).
+'ConstantDef__get_defined_in'(Objref) ->
+ orber_ifr_constantdef:'_get_defined_in'(Objref).
+'ConstantDef__get_absolute_name'(Objref) ->
+ orber_ifr_constantdef:'_get_absolute_name'(Objref).
+'ConstantDef__get_containing_repository'(Objref) ->
+ orber_ifr_constantdef:'_get_containing_repository'(Objref).
+'ConstantDef_describe'(Objref) ->
+ orber_ifr_constantdef:describe(Objref).
+'ConstantDef_move'(Objref,New_container,New_name,New_version) ->
+ orber_ifr_constantdef:move(Objref,New_container,New_name,New_version).
+'ConstantDef__get_type'(Objref) ->
+ orber_ifr_constantdef:'_get_type'(Objref).
+'ConstantDef__get_type_def'(Objref) ->
+ orber_ifr_constantdef:'_get_type_def'(Objref).
+'ConstantDef__set_type_def'(Objref,TypeDef) ->
+ orber_ifr_constantdef:'_set_type_def'(Objref,TypeDef).
+'ConstantDef__get_value'(Objref) ->
+ orber_ifr_constantdef:'_get_value'(Objref).
+'ConstantDef__set_value'(Objref,Value) ->
+ orber_ifr_constantdef:'_set_value'(Objref,Value).
+
+'TypedefDef__get_def_kind'(Objref) ->
+ orber_ifr_typedef:'_get_def_kind'(Objref).
+'TypedefDef_destroy'(Objref) ->
+ orber_ifr_typedef:destroy(Objref).
+'TypedefDef__get_id'(Objref) ->
+ orber_ifr_typedef:'_get_id'(Objref).
+'TypedefDef__set_id'(Objref,Id) ->
+ orber_ifr_typedef:'_set_id'(Objref,Id).
+'TypedefDef__get_name'(Objref) ->
+ orber_ifr_typedef:'_get_name'(Objref).
+'TypedefDef__set_name'(Objref,Name) ->
+ orber_ifr_typedef:'_set_name'(Objref,Name).
+'TypedefDef__get_version'(Objref) ->
+ orber_ifr_typedef:'_get_version'(Objref).
+'TypedefDef__set_version'(Objref,Version) ->
+ orber_ifr_typedef:'_set_version'(Objref,Version).
+'TypedefDef__get_defined_in'(Objref) ->
+ orber_ifr_typedef:'_get_defined_in'(Objref).
+'TypedefDef__get_absolute_name'(Objref) ->
+ orber_ifr_typedef:'_get_absolute_name'(Objref).
+'TypedefDef__get_containing_repository'(Objref) ->
+ orber_ifr_typedef:'_get_containing_repository'(Objref).
+'TypedefDef_describe'(Objref) ->
+ orber_ifr_typedef:describe(Objref).
+'TypedefDef_move'(Objref,New_container,New_name,New_version) ->
+ orber_ifr_typedef:move(Objref,New_container,New_name,New_version).
+'TypedefDef__get_type'(Objref) ->
+ orber_ifr_typedef:'_get_type'(Objref).
+
+'StructDef__get_def_kind'(Objref) ->
+ orber_ifr_structdef:'_get_def_kind'(Objref).
+'StructDef_destroy'(Objref) ->
+ orber_ifr_structdef:destroy(Objref).
+'StructDef__get_id'(Objref) ->
+ orber_ifr_structdef:'_get_id'(Objref).
+'StructDef__set_id'(Objref,Id) ->
+ orber_ifr_structdef:'_set_id'(Objref,Id).
+'StructDef__get_name'(Objref) ->
+ orber_ifr_structdef:'_get_name'(Objref).
+'StructDef__set_name'(Objref,Name) ->
+ orber_ifr_structdef:'_set_name'(Objref,Name).
+'StructDef__get_version'(Objref) ->
+ orber_ifr_structdef:'_get_version'(Objref).
+'StructDef__set_version'(Objref,Version) ->
+ orber_ifr_structdef:'_set_version'(Objref,Version).
+'StructDef__get_defined_in'(Objref) ->
+ orber_ifr_structdef:'_get_defined_in'(Objref).
+'StructDef__get_absolute_name'(Objref) ->
+ orber_ifr_structdef:'_get_absolute_name'(Objref).
+'StructDef__get_containing_repository'(Objref) ->
+ orber_ifr_structdef:'_get_containing_repository'(Objref).
+'StructDef_describe'(Objref) ->
+ orber_ifr_structdef:describe(Objref).
+'StructDef_move'(Objref,New_container,New_name,New_version) ->
+ orber_ifr_structdef:move(Objref,New_container,New_name,New_version).
+'StructDef__get_type'(Objref) ->
+ orber_ifr_structdef:'_get_type'(Objref).
+'StructDef__get_members'(Objref) ->
+ orber_ifr_structdef:'_get_members'(Objref).
+'StructDef__set_members'(Objref,Members) ->
+ orber_ifr_structdef:'_set_members'(Objref,Members).
+
+'UnionDef__get_def_kind'(Objref) ->
+ orber_ifr_uniondef:'_get_def_kind'(Objref).
+'UnionDef_destroy'(Objref) ->
+ orber_ifr_uniondef:destroy(Objref).
+'UnionDef__get_id'(Objref) ->
+ orber_ifr_uniondef:'_get_id'(Objref).
+'UnionDef__set_id'(Objref,Id) ->
+ orber_ifr_uniondef:'_set_id'(Objref,Id).
+'UnionDef__get_name'(Objref) ->
+ orber_ifr_uniondef:'_get_name'(Objref).
+'UnionDef__set_name'(Objref,Name) ->
+ orber_ifr_uniondef:'_set_name'(Objref,Name).
+'UnionDef__get_version'(Objref) ->
+ orber_ifr_uniondef:'_get_version'(Objref).
+'UnionDef__set_version'(Objref,Version) ->
+ orber_ifr_uniondef:'_set_version'(Objref,Version).
+'UnionDef__get_defined_in'(Objref) ->
+ orber_ifr_uniondef:'_get_defined_in'(Objref).
+'UnionDef__get_absolute_name'(Objref) ->
+ orber_ifr_uniondef:'_get_absolute_name'(Objref).
+'UnionDef__get_containing_repository'(Objref) ->
+ orber_ifr_uniondef:'_get_containing_repository'(Objref).
+'UnionDef_describe'(Objref) ->
+ orber_ifr_uniondef:describe(Objref).
+'UnionDef_move'(Objref,New_container,New_name,New_version) ->
+ orber_ifr_uniondef:move(Objref,New_container,New_name,New_version).
+'UnionDef__get_type'(Objref) ->
+ orber_ifr_uniondef:'_get_type'(Objref).
+'UnionDef__get_discriminator_type'(Objref) ->
+ orber_ifr_uniondef:'_get_discriminator_type'(Objref).
+'UnionDef__get_discriminator_type_def'(Objref) ->
+ orber_ifr_uniondef:'_get_discriminator_type_def'(Objref).
+'UnionDef__set_discriminator_type_def'(Objref,TypeDef) ->
+ orber_ifr_uniondef:'_set_discriminator_type_def'(Objref,TypeDef).
+'UnionDef__get_members'(Objref) ->
+ orber_ifr_uniondef:'_get_members'(Objref).
+'UnionDef__set_members'(Objref,Members) ->
+ orber_ifr_uniondef:'_set_members'(Objref,Members).
+
+'EnumDef__get_def_kind'(Objref) ->
+ orber_ifr_enumdef:'_get_def_kind'(Objref).
+'EnumDef_destroy'(Objref) ->
+ orber_ifr_enumdef:destroy(Objref).
+'EnumDef__get_id'(Objref) ->
+ orber_ifr_enumdef:'_get_id'(Objref).
+'EnumDef__set_id'(Objref,Id) ->
+ orber_ifr_enumdef:'_set_id'(Objref,Id).
+'EnumDef__get_name'(Objref) ->
+ orber_ifr_enumdef:'_get_name'(Objref).
+'EnumDef__set_name'(Objref,Name) ->
+ orber_ifr_enumdef:'_set_name'(Objref,Name).
+'EnumDef__get_version'(Objref) ->
+ orber_ifr_enumdef:'_get_version'(Objref).
+'EnumDef__set_version'(Objref,Version) ->
+ orber_ifr_enumdef:'_set_version'(Objref,Version).
+'EnumDef__get_defined_in'(Objref) ->
+ orber_ifr_enumdef:'_get_defined_in'(Objref).
+'EnumDef__get_absolute_name'(Objref) ->
+ orber_ifr_enumdef:'_get_absolute_name'(Objref).
+'EnumDef__get_containing_repository'(Objref) ->
+ orber_ifr_enumdef:'_get_containing_repository'(Objref).
+'EnumDef_describe'(Objref) ->
+ orber_ifr_enumdef:describe(Objref).
+'EnumDef_move'(Objref,New_container,New_name,New_version) ->
+ orber_ifr_enumdef:move(Objref,New_container,New_name,New_version).
+'EnumDef__get_type'(Objref) ->
+ orber_ifr_enumdef:'_get_type'(Objref).
+'EnumDef__get_members'(Objref) ->
+ orber_ifr_enumdef:'_get_members'(Objref).
+'EnumDef__set_members'(Objref,Members) ->
+ orber_ifr_enumdef:'_set_members'(Objref,Members).
+
+'AliasDef__get_def_kind'(Objref) ->
+ orber_ifr_aliasdef:'_get_def_kind'(Objref).
+'AliasDef_destroy'(Objref) ->
+ orber_ifr_aliasdef:destroy(Objref).
+'AliasDef__get_id'(Objref) ->
+ orber_ifr_aliasdef:'_get_id'(Objref).
+'AliasDef__set_id'(Objref,Id) ->
+ orber_ifr_aliasdef:'_set_id'(Objref,Id).
+'AliasDef__get_name'(Objref) ->
+ orber_ifr_aliasdef:'_get_name'(Objref).
+'AliasDef__set_name'(Objref,Name) ->
+ orber_ifr_aliasdef:'_set_name'(Objref,Name).
+'AliasDef__get_version'(Objref) ->
+ orber_ifr_aliasdef:'_get_version'(Objref).
+'AliasDef__set_version'(Objref,Version) ->
+ orber_ifr_aliasdef:'_set_version'(Objref,Version).
+'AliasDef__get_defined_in'(Objref) ->
+ orber_ifr_aliasdef:'_get_defined_in'(Objref).
+'AliasDef__get_absolute_name'(Objref) ->
+ orber_ifr_aliasdef:'_get_absolute_name'(Objref).
+'AliasDef__get_containing_repository'(Objref) ->
+ orber_ifr_aliasdef:'_get_containing_repository'(Objref).
+'AliasDef_describe'(Objref) ->
+ orber_ifr_aliasdef:describe(Objref).
+'AliasDef_move'(Objref,New_container,New_name,New_version) ->
+ orber_ifr_aliasdef:move(Objref,New_container,New_name,New_version).
+'AliasDef__get_type'(Objref) ->
+ orber_ifr_aliasdef:'_get_type'(Objref).
+'AliasDef__get_original_type_def'(Objref) ->
+ orber_ifr_aliasdef:'_get_original_type_def'(Objref).
+'AliasDef__set_original_type_def'(Objref,TypeDef) ->
+ orber_ifr_aliasdef:'_set_original_type_def'(Objref,TypeDef).
+
+'PrimitiveDef__get_def_kind'(Objref) ->
+ orber_ifr_primitivedef:'_get_def_kind'(Objref).
+'PrimitiveDef_destroy'(Objref) ->
+ orber_ifr_primitivedef:destroy(Objref).
+'PrimitiveDef__get_type'(Objref) ->
+ orber_ifr_primitivedef:'_get_type'(Objref).
+'PrimitiveDef__get_kind'(Objref) ->
+ orber_ifr_primitivedef:'_get_kind'(Objref).
+
+'StringDef__get_def_kind'(Objref) ->
+ orber_ifr_stringdef:'_get_def_kind'(Objref).
+'StringDef_destroy'(Objref) ->
+ orber_ifr_stringdef:destroy(Objref).
+'StringDef__get_type'(Objref) ->
+ orber_ifr_stringdef:'_get_type'(Objref).
+'StringDef__get_bound'(Objref) ->
+ orber_ifr_stringdef:'_get_bound'(Objref).
+'StringDef__set_bound'(Objref,Bound) ->
+ orber_ifr_stringdef:'_set_bound'(Objref,Bound).
+
+'WstringDef__get_def_kind'(Objref) ->
+ orber_ifr_wstringdef:'_get_def_kind'(Objref).
+'WstringDef_destroy'(Objref) ->
+ orber_ifr_wstringdef:destroy(Objref).
+'WstringDef__get_type'(Objref) ->
+ orber_ifr_wstringdef:'_get_type'(Objref).
+'WstringDef__get_bound'(Objref) ->
+ orber_ifr_wstringdef:'_get_bound'(Objref).
+'WstringDef__set_bound'(Objref,Bound) ->
+ orber_ifr_wstringdef:'_set_bound'(Objref,Bound).
+
+'FixedDef__get_def_kind'(Objref) ->
+ orber_ifr_fixeddef:'_get_def_kind'(Objref).
+'FixedDef_destroy'(Objref) ->
+ orber_ifr_fixeddef:destroy(Objref).
+'FixedDef__get_type'(Objref) ->
+ orber_ifr_fixeddef:'_get_type'(Objref).
+'FixedDef__get_digits'(Objref) ->
+ orber_ifr_fixeddef:'_get_digits'(Objref).
+'FixedDef__set_digits'(Objref,Digits) ->
+ orber_ifr_fixeddef:'_set_digits'(Objref,Digits).
+'FixedDef__get_scale'(Objref) ->
+ orber_ifr_fixeddef:'_get_scale'(Objref).
+'FixedDef__set_scale'(Objref,Scale) ->
+ orber_ifr_fixeddef:'_set_scale'(Objref,Scale).
+
+'SequenceDef__get_def_kind'(Objref) ->
+ orber_ifr_sequencedef:'_get_def_kind'(Objref).
+'SequenceDef_destroy'(Objref) ->
+ orber_ifr_sequencedef:destroy(Objref).
+'SequenceDef__get_type'(Objref) ->
+ orber_ifr_sequencedef:'_get_type'(Objref).
+'SequenceDef__get_bound'(Objref) ->
+ orber_ifr_sequencedef:'_get_bound'(Objref).
+'SequenceDef__set_bound'(Objref,Bound) ->
+ orber_ifr_sequencedef:'_set_bound'(Objref,Bound).
+'SequenceDef__get_element_type'(Objref) ->
+ orber_ifr_sequencedef:'_get_element_type'(Objref).
+'SequenceDef__get_element_type_def'(Objref) ->
+ orber_ifr_sequencedef:'_get_element_type_def'(Objref).
+'SequenceDef__set_element_type_def'(Objref,TypeDef) ->
+ orber_ifr_sequencedef:'_set_element_type_def'(Objref,TypeDef).
+
+'ArrayDef__get_def_kind'(Objref) ->
+ orber_ifr_arraydef:'_get_def_kind'(Objref).
+'ArrayDef_destroy'(Objref) ->
+ orber_ifr_arraydef:destroy(Objref).
+'ArrayDef__get_type'(Objref) ->
+ orber_ifr_arraydef:'_get_type'(Objref).
+'ArrayDef__get_length'(Objref) ->
+ orber_ifr_arraydef:'_get_length'(Objref).
+'ArrayDef__set_length'(Objref,Length) ->
+ orber_ifr_arraydef:'_set_length'(Objref,Length).
+'ArrayDef__get_element_type'(Objref) ->
+ orber_ifr_arraydef:'_get_element_type'(Objref).
+'ArrayDef__get_element_type_def'(Objref) ->
+ orber_ifr_arraydef:'_get_element_type_def'(Objref).
+'ArrayDef__set_element_type_def'(Objref,TypeDef) ->
+ orber_ifr_arraydef:'_set_element_type_def'(Objref,TypeDef).
+
+'ExceptionDef__get_def_kind'(Objref) ->
+ orber_ifr_exceptiondef:'_get_def_kind'(Objref).
+'ExceptionDef_destroy'(Objref) ->
+ orber_ifr_exceptiondef:destroy(Objref).
+'ExceptionDef__get_id'(Objref) ->
+ orber_ifr_exceptiondef:'_get_id'(Objref).
+'ExceptionDef__set_id'(Objref,Id) ->
+ orber_ifr_exceptiondef:'_set_id'(Objref,Id).
+'ExceptionDef__get_name'(Objref) ->
+ orber_ifr_exceptiondef:'_get_name'(Objref).
+'ExceptionDef__set_name'(Objref,Name) ->
+ orber_ifr_exceptiondef:'_set_name'(Objref,Name).
+'ExceptionDef__get_version'(Objref) ->
+ orber_ifr_exceptiondef:'_get_version'(Objref).
+'ExceptionDef__set_version'(Objref,Version) ->
+ orber_ifr_exceptiondef:'_set_version'(Objref,Version).
+'ExceptionDef__get_defined_in'(Objref) ->
+ orber_ifr_exceptiondef:'_get_defined_in'(Objref).
+'ExceptionDef__get_absolute_name'(Objref) ->
+ orber_ifr_exceptiondef:'_get_absolute_name'(Objref).
+'ExceptionDef__get_containing_repository'(Objref) ->
+ orber_ifr_exceptiondef:'_get_containing_repository'(Objref).
+'ExceptionDef_describe'(Objref) ->
+ orber_ifr_exceptiondef:describe(Objref).
+'ExceptionDef_move'(Objref,New_container,New_name,New_version) ->
+ orber_ifr_exceptiondef:move(Objref,New_container,New_name,New_version).
+'ExceptionDef__get_type'(Objref) ->
+ orber_ifr_exceptiondef:'_get_type'(Objref).
+'ExceptionDef__get_members'(Objref) ->
+ orber_ifr_exceptiondef:'_get_members'(Objref).
+'ExceptionDef__set_members'(Objref,Members) ->
+ orber_ifr_exceptiondef:'_set_members'(Objref,Members).
+
+'AttributeDef__get_def_kind'(Objref) ->
+ orber_ifr_attributedef:'_get_def_kind'(Objref).
+'AttributeDef_destroy'(Objref) ->
+ orber_ifr_attributedef:destroy(Objref).
+'AttributeDef__get_id'(Objref) ->
+ orber_ifr_attributedef:'_get_id'(Objref).
+'AttributeDef__set_id'(Objref,Id) ->
+ orber_ifr_attributedef:'_set_id'(Objref,Id).
+'AttributeDef__get_name'(Objref) ->
+ orber_ifr_attributedef:'_get_name'(Objref).
+'AttributeDef__set_name'(Objref,Name) ->
+ orber_ifr_attributedef:'_set_name'(Objref,Name).
+'AttributeDef__get_version'(Objref) ->
+ orber_ifr_attributedef:'_get_version'(Objref).
+'AttributeDef__set_version'(Objref,Version) ->
+ orber_ifr_attributedef:'_set_version'(Objref,Version).
+'AttributeDef__get_defined_in'(Objref) ->
+ orber_ifr_attributedef:'_get_defined_in'(Objref).
+'AttributeDef__get_absolute_name'(Objref) ->
+ orber_ifr_attributedef:'_get_absolute_name'(Objref).
+'AttributeDef__get_containing_repository'(Objref) ->
+ orber_ifr_attributedef:'_get_containing_repository'(Objref).
+'AttributeDef_describe'(Objref) ->
+ orber_ifr_attributedef:describe(Objref).
+'AttributeDef_move'(Objref,New_container,New_name,New_version) ->
+ orber_ifr_attributedef:move(Objref,New_container,New_name,New_version).
+'AttributeDef__get_type'(Objref) ->
+ orber_ifr_attributedef:'_get_type'(Objref).
+'AttributeDef__get_type_def'(Objref) ->
+ orber_ifr_attributedef:'_get_type_def'(Objref).
+'AttributeDef__set_type_def'(Objref,TypeDef) ->
+ orber_ifr_attributedef:'_set_type_def'(Objref,TypeDef).
+'AttributeDef__get_mode'(Objref) ->
+ orber_ifr_attributedef:'_get_mode'(Objref).
+'AttributeDef__set_mode'(Objref,Mode) ->
+ orber_ifr_attributedef:'_set_mode'(Objref,Mode).
+
+'OperationDef__get_def_kind'(Objref) ->
+ orber_ifr_operationdef:'_get_def_kind'(Objref).
+'OperationDef_destroy'(Objref) ->
+ orber_ifr_operationdef:destroy(Objref).
+'OperationDef__get_id'(Objref) ->
+ orber_ifr_operationdef:'_get_id'(Objref).
+'OperationDef__set_id'(Objref,Id) ->
+ orber_ifr_operationdef:'_set_id'(Objref,Id).
+'OperationDef__get_name'(Objref) ->
+ orber_ifr_operationdef:'_get_name'(Objref).
+'OperationDef__set_name'(Objref,Name) ->
+ orber_ifr_operationdef:'_set_name'(Objref,Name).
+'OperationDef__get_version'(Objref) ->
+ orber_ifr_operationdef:'_get_version'(Objref).
+'OperationDef__set_version'(Objref,Version) ->
+ orber_ifr_operationdef:'_set_version'(Objref,Version).
+'OperationDef__get_defined_in'(Objref) ->
+ orber_ifr_operationdef:'_get_defined_in'(Objref).
+'OperationDef__get_absolute_name'(Objref) ->
+ orber_ifr_operationdef:'_get_absolute_name'(Objref).
+'OperationDef__get_containing_repository'(Objref) ->
+ orber_ifr_operationdef:'_get_containing_repository'(Objref).
+'OperationDef_describe'(Objref) ->
+ orber_ifr_operationdef:describe(Objref).
+'OperationDef_move'(Objref,New_container,New_name,New_version) ->
+ orber_ifr_operationdef:move(Objref,New_container,New_name,New_version).
+'OperationDef__get_result'(Objref) ->
+ orber_ifr_operationdef:'_get_result'(Objref).
+'OperationDef__get_result_def'(Objref) ->
+ orber_ifr_operationdef:'_get_result_def'(Objref).
+'OperationDef__set_result_def'(Objref,ResultDef) ->
+ orber_ifr_operationdef:'_set_result_def'(Objref,ResultDef).
+'OperationDef__get_params'(Objref) ->
+ orber_ifr_operationdef:'_get_params'(Objref).
+'OperationDef__set_params'(Objref,Params) ->
+ orber_ifr_operationdef:'_set_params'(Objref,Params).
+'OperationDef__get_mode'(Objref) ->
+ orber_ifr_operationdef:'_get_mode'(Objref).
+'OperationDef__set_mode'(Objref,Mode) ->
+ orber_ifr_operationdef:'_set_mode'(Objref,Mode).
+'OperationDef__get_contexts'(Objref) ->
+ orber_ifr_operationdef:'_get_contexts'(Objref).
+'OperationDef__set_contexts'(Objref,Contexts) ->
+ orber_ifr_operationdef:'_set_contexts'(Objref,Contexts).
+'OperationDef__get_exceptions'(Objref) ->
+ orber_ifr_operationdef:'_get_exceptions'(Objref).
+'OperationDef__set_exceptions'(Objref,Exceptions) ->
+ orber_ifr_operationdef:'_set_exceptions'(Objref,Exceptions).
+
+'InterfaceDef__get_def_kind'(Objref) ->
+ orber_ifr_interfacedef:'_get_def_kind'(Objref).
+'InterfaceDef_destroy'(Objref) ->
+ orber_ifr_interfacedef:destroy(Objref).
+'InterfaceDef_lookup'(Objref,Search_name) ->
+ orber_ifr_interfacedef:lookup(Objref,Search_name).
+'InterfaceDef_contents'(Objref,Limit_type,Exclude_inherited) ->
+ orber_ifr_interfacedef:contents(Objref,Limit_type,Exclude_inherited).
+'InterfaceDef_lookup_name'(Objref,Search_name,Levels_to_search,Limit_type,
+ Exclude_inherited) ->
+ orber_ifr_interfacedef:lookup_name(Objref,Search_name,Levels_to_search,Limit_type,
+ Exclude_inherited).
+'InterfaceDef_describe_contents'(Objref,Limit_type,Exclude_inherited,
+ Max_returned_objs) ->
+ orber_ifr_interfacedef:describe_contents(Objref,Limit_type,Exclude_inherited,
+ Max_returned_objs).
+'InterfaceDef_create_module'(Objref,Id,Name,Version) ->
+ orber_ifr_interfacedef:create_module(Objref,Id,Name,Version).
+'InterfaceDef_create_constant'(Objref,Id,Name,Version,Type,Value) ->
+ orber_ifr_interfacedef:create_constant(Objref,Id,Name,Version,Type,Value).
+'InterfaceDef_create_struct'(Objref,Id,Name,Version,Members) ->
+ orber_ifr_interfacedef:create_struct(Objref,Id,Name,Version,Members).
+'InterfaceDef_create_union'(Objref,Id,Name,Version,Discriminator_type,
+ Members) ->
+ orber_ifr_interfacedef:create_union(Objref,Id,Name,Version,Discriminator_type,
+ Members).
+'InterfaceDef_create_enum'(Objref,Id,Name,Version,Members) ->
+ orber_ifr_interfacedef:create_enum(Objref,Id,Name,Version,Members).
+'InterfaceDef_create_alias'(Objref,Id,Name,Version,Original_type) ->
+ orber_ifr_interfacedef:create_alias(Objref,Id,Name,Version,Original_type).
+'InterfaceDef_create_interface'(Objref,Id,Name,Version,Base_interfaces) ->
+ orber_ifr_interfacedef:create_interface(Objref,Id,Name,Version,Base_interfaces).
+'InterfaceDef_create_exception'(Objref,Id,Name,Version,Members) ->
+ orber_ifr_interfacedef:create_exception(Objref,Id,Name,Version,Members).
+'InterfaceDef__get_id'(Objref) ->
+ orber_ifr_interfacedef:'_get_id'(Objref).
+'InterfaceDef__set_id'(Objref,Id) ->
+ orber_ifr_interfacedef:'_set_id'(Objref,Id).
+'InterfaceDef__get_name'(Objref) ->
+ orber_ifr_interfacedef:'_get_name'(Objref).
+'InterfaceDef__set_name'(Objref,Name) ->
+ orber_ifr_interfacedef:'_set_name'(Objref,Name).
+'InterfaceDef__get_version'(Objref) ->
+ orber_ifr_interfacedef:'_get_version'(Objref).
+'InterfaceDef__set_version'(Objref,Version) ->
+ orber_ifr_interfacedef:'_set_version'(Objref,Version).
+'InterfaceDef__get_defined_in'(Objref) ->
+ orber_ifr_interfacedef:'_get_defined_in'(Objref).
+'InterfaceDef__get_absolute_name'(Objref) ->
+ orber_ifr_interfacedef:'_get_absolute_name'(Objref).
+'InterfaceDef__get_containing_repository'(Objref) ->
+ orber_ifr_interfacedef:'_get_containing_repository'(Objref).
+'InterfaceDef_describe'(Objref) ->
+ orber_ifr_interfacedef:describe(Objref).
+'InterfaceDef_move'(Objref,New_container,New_name,New_version) ->
+ orber_ifr_interfacedef:move(Objref,New_container,New_name,New_version).
+'InterfaceDef__get_type'(Objref) ->
+ orber_ifr_interfacedef:'_get_type'(Objref).
+'InterfaceDef__get_base_interfaces'(Objref) ->
+ orber_ifr_interfacedef:'_get_base_interfaces'(Objref).
+'InterfaceDef__set_base_interfaces'(Objref,BaseInterfaces) ->
+ orber_ifr_interfacedef:'_set_base_interfaces'(Objref,BaseInterfaces).
+'InterfaceDef_is_a'(Objref,Interface_id) ->
+ orber_ifr_interfacedef:is_a(Objref,Interface_id).
+'InterfaceDef_describe_interface'(Objref) ->
+ orber_ifr_interfacedef:describe_interface(Objref).
+'InterfaceDef_create_attribute'(Objref,Id,Name,Version,Type,Mode) ->
+ orber_ifr_interfacedef:create_attribute(Objref,Id,Name,Version,Type,Mode).
+'InterfaceDef_create_operation'(Objref,Id,Name,Version,Result,Mode,Params,
+ Exceptions,Contexts) ->
+ orber_ifr_interfacedef:create_operation(Objref,Id,Name,Version,Result,Mode,
+ Params,Exceptions,Contexts).
+
+%%'TypeCode_equal'(Objref,Tc) ->
+%% orber_ifr_typecode:equal(Objref,Tc).
+%%'TypeCode_kind'(Objref) ->
+%% orber_ifr_typecode:kind(Objref).
+%%'TypeCode_id'(Objref) ->
+%% orber_ifr_typecode:id(Objref).
+%%'TypeCode_name'(Objref) ->
+%% orber_ifr_typecode:name(Objref).
+%%'TypeCode_member_count'(Objref) ->
+%% orber_ifr_typecode:member_count(Objref).
+%%'TypeCode_member_name'(Objref,Index) ->
+%% orber_ifr_typecode:member_name(Objref,Index).
+%%'TypeCode_member_type'(Objref,Index) ->
+%% orber_ifr_typecode:member_type(Objref,Index).
+%%'TypeCode_member_label'(Objref,Index) ->
+%% orber_ifr_typecode:member_label(Objref,Index).
+%%'TypeCode_discriminator_type'(Objref) ->
+%% orber_ifr_typecode:discriminator_type(Objref).
+%%'TypeCode_default_index'(Objref) ->
+%% orber_ifr_typecode:default_index(Objref).
+%%'TypeCode_length'(Objref) ->
+%% orber_ifr_typecode:length(Objref).
+%%'TypeCode_content_type'(Objref) ->
+%% orber_ifr_typecode:content_type(Objref).
+%%'TypeCode_param_count'(Objref) ->
+%% orber_ifr_typecode:param_count(Objref).
+%%'TypeCode_parameter'(Objref,Index) ->
+%% orber_ifr_typecode:parameter(Objref,Index).
+
+'ORB_create_struct_tc'(Id,Name,Members) ->
+ orber_ifr_orb:create_struct_tc(Id,Name,Members).
+'ORB_create_union_tc'(Id,Name,Discriminator_type,Members) ->
+ orber_ifr_orb:create_union_tc(Id,Name,Discriminator_type,Members).
+'ORB_create_enum_tc'(Id,Name,Members) ->
+ orber_ifr_orb:create_enum_tc(Id,Name,Members).
+'ORB_create_alias_tc'(Id,Name,Original_type) ->
+ orber_ifr_orb:create_alias_tc(Id,Name,Original_type).
+'ORB_create_exception_tc'(Id,Name,Members) ->
+ orber_ifr_orb:create_exception_tc(Id,Name,Members).
+'ORB_create_interface_tc'(Id,Name) ->
+ orber_ifr_orb:create_interface_tc(Id,Name).
+'ORB_create_string_tc'(Bound) ->
+ orber_ifr_orb:create_string_tc(Bound).
+'ORB_create_wstring_tc'(Bound) ->
+ orber_ifr_orb:create_wstring_tc(Bound).
+'ORB_create_sequence_tc'(Bound,Element_type) ->
+ orber_ifr_orb:create_sequence_tc(Bound,Element_type).
+'ORB_create_recursive_sequence_tc'(Bound,Offset) ->
+ orber_ifr_orb:create_recursive_sequence_tc(Bound,Offset).
+'ORB_create_array_tc'(Length,Element_type) ->
+ orber_ifr_orb:create_array_tc(Length,Element_type).
+
+%%%---------------------------------------------------------------
+%%% "Methods" of the IFR "objects"
+
+get_def_kind(Objref) ->
+ Mod = obj2mod(Objref),
+ Mod:'_get_def_kind'(Objref).
+
+%% Light IFR Operations
+destroy(#orber_light_ifr_ref{data = #lightdata{id = Id}}) ->
+ F = fun() ->
+ MatchHead = #orber_light_ifr{id = '$1', base_id = Id, _='_'},
+ Result = '$1',
+ IdList = mnesia:select(orber_light_ifr,
+ [{MatchHead, [], [Result]}],
+ write),
+ lists:foreach(fun(RefId) ->
+ mnesia:delete({orber_light_ifr, RefId})
+ end, IdList)
+ end,
+ case mnesia:transaction(F) of
+ {aborted, _} ->
+ exit({"FAILED TO DELETE:", Id});
+ {atomic, _} ->
+ ok
+ end;
+destroy(Objref) ->
+ %% Destroying an ir_IRObject, ir_Contained or ir_Container directly
+ %% is not allowed
+ Mod = obj2mod(Objref),
+ Mod:destroy(Objref).
+
+%%%---------------------------------------------------------------
+%%%
+
+get_id(Objref) ->
+ Mod = obj2mod(Objref),
+ Mod:'_get_id'(Objref).
+
+set_id(Objref,Id) ->
+ Mod = obj2mod(Objref),
+ Mod:'_set_id'(Objref,Id).
+
+get_name(Objref) ->
+ Mod = obj2mod(Objref),
+ Mod:'_get_name'(Objref).
+
+set_name(Objref,Name) ->
+ Mod = obj2mod(Objref),
+ Mod:'_set_name'(Objref,Name).
+
+get_version(Objref) ->
+ Mod = obj2mod(Objref),
+ Mod:'_get_version'(Objref).
+
+set_version(Objref,Version) ->
+ Mod = obj2mod(Objref),
+ Mod:'_set_version'(Objref,Version).
+
+get_defined_in(Objref) ->
+ Mod = obj2mod(Objref),
+ Mod:'_get_defined_in'(Objref).
+
+get_absolute_name(Objref) ->
+ Mod = obj2mod(Objref),
+ Mod: '_get_absolute_name'(Objref).
+
+get_containing_repository(Objref) ->
+ Mod = obj2mod(Objref),
+ Mod:'_get_containing_repository'(Objref).
+
+describe(Objref) ->
+ Mod = obj2mod(Objref),
+ Mod:describe(Objref).
+
+move(Objref,New_container,New_name,New_version) ->
+ Mod = obj2mod(Objref),
+ Mod:move(Objref,New_container,New_name,New_version).
+
+%%%---------------------------------------------------------------
+%%%
+
+lookup(Objref,Search_name) ->
+ Mod = obj2mod(Objref),
+ Mod:lookup(Objref,Search_name).
+
+%% Light IFR Operation
+contents(#orber_light_ifr_ref{data = #lightdata{id = _Id}},
+ _Limit_type, _Exclude_inherited) ->
+ [];
+contents(Objref,Limit_type,Exclude_inherited) ->
+ Mod = obj2mod(Objref),
+ Mod:contents(Objref,Limit_type,Exclude_inherited).
+
+lookup_name(Objref,Search_name,Levels_to_search,Limit_type,Exclude_inherited) ->
+ Mod = obj2mod(Objref),
+ Mod:lookup_name(Objref,Search_name,Levels_to_search,Limit_type,Exclude_inherited).
+
+
+describe_contents(Objref,Limit_type,Exclude_inherited,Max_returned_objs) ->
+ Mod = obj2mod(Objref),
+ Mod:describe_contents(Objref,Limit_type,Exclude_inherited,Max_returned_objs).
+
+create_module(Objref,Id,Name,Version) ->
+ Mod = obj2mod(Objref),
+ Mod:create_module(Objref,Id,Name,Version).
+
+create_constant(Objref,Id,Name,Version,Type,Value) ->
+ Mod = obj2mod(Objref),
+ Mod:create_constant(Objref,Id,Name,Version,Type,Value).
+
+create_struct(Objref,Id,Name,Version,Members) ->
+ Mod = obj2mod(Objref),
+ Mod:create_struct(Objref,Id,Name,Version,Members).
+
+create_union(Objref,Id,Name,Version,Discriminator_type,Members) ->
+ Mod = obj2mod(Objref),
+ Mod:create_union(Objref,Id,Name,Version,Discriminator_type,Members).
+
+create_enum(Objref,Id,Name,Version,Members) ->
+ Mod = obj2mod(Objref),
+ Mod:create_enum(Objref,Id,Name,Version,Members).
+
+create_alias(Objref,Id,Name,Version,Original_type) ->
+ Mod = obj2mod(Objref),
+ Mod:create_alias(Objref,Id,Name,Version,Original_type).
+
+create_interface(Objref,Id,Name,Version,Base_interfaces) ->
+ Mod = obj2mod(Objref),
+ Mod:create_interface(Objref,Id,Name,Version,Base_interfaces).
+
+create_exception(Objref,Id,Name,Version,Members) ->
+ Mod = obj2mod(Objref),
+ Mod:create_exception(Objref,Id,Name,Version,Members).
+
+%%%---------------------------------------------------------------
+%%%
+
+get_type(Objref) ->
+ Mod = obj2mod(Objref),
+ Mod:'_get_type'(Objref).
+
+%%%---------------------------------------------------------------
+%%%
+
+%% This list should contain the data in most-likely-to-be-accessed-order.
+-define(INDEXED_TABLE_LIST, [{ir_ExceptionDef, #ir_ExceptionDef.id},
+ {ir_InterfaceDef, #ir_InterfaceDef.id},
+ {ir_ModuleDef, #ir_ModuleDef.id},
+ {ir_StructDef, #ir_StructDef.id},
+ {ir_UnionDef, #ir_UnionDef.id},
+ {ir_AliasDef, #ir_AliasDef.id},
+ {ir_TypedefDef, #ir_TypedefDef.id},
+ {ir_ConstantDef, #ir_ConstantDef.id},
+ {ir_EnumDef, #ir_EnumDef.id},
+ {ir_AttributeDef, #ir_AttributeDef.id},
+ {ir_Contained, #ir_Contained.id},
+ {ir_OperationDef, #ir_OperationDef.id}]).
+
+
+lookup_id(#orber_light_ifr_ref{}, Id) ->
+ case mnesia:dirty_read(orber_light_ifr, Id) of
+ [] ->
+ [];
+ [#orber_light_ifr{module = Mod}] ->
+ #orber_light_ifr_ref{data = #lightdata{scope = atom_to_list(Mod),
+ id = Id}}
+ end;
+lookup_id(_Objref,Id) ->
+ %% We used the operation below before but it's very expensive.
+ %% orber_ifr_repository:lookup_id(Objref,Id)
+ lookup_id_helper(?INDEXED_TABLE_LIST, Id).
+
+lookup_id_helper([], _) ->
+ [];
+lookup_id_helper([{Tab, IdNum}|T], Id) ->
+ case mnesia:dirty_index_read(Tab, Id, IdNum) of
+ [] ->
+ lookup_id_helper(T, Id);
+ [FoundIt] ->
+ {Tab, element(2, FoundIt)}
+ end.
+
+get_primitive(Objref,Kind) ->
+ orber_ifr_repository:get_primitive(Objref,Kind).
+
+create_string(Objref,Bound) ->
+ orber_ifr_repository:create_string(Objref,Bound).
+
+create_wstring(Objref,Bound) ->
+ orber_ifr_repository:create_wstring(Objref,Bound).
+
+create_sequence(Objref,Bound,Element_type) ->
+ orber_ifr_repository:create_sequence(Objref,Bound,Element_type).
+
+create_array(Objref,Length,Element_type) ->
+ orber_ifr_repository:create_array(Objref,Length,Element_type).
+
+create_idltype(Objref,Typecode) -> %not in CORBA 2.0
+ orber_ifr_repository:create_idltype(Objref,Typecode).
+
+create_fixed(Objref, Digits, Scale) ->
+ orber_ifr_repository:create_fixed(Objref, Digits, Scale).
+
+%%%---------------------------------------------------------------
+%%%
+
+get_type_def(Objref) ->
+ Mod = obj2mod(Objref),
+ Mod:'_get_type_def'(Objref).
+
+set_type_def(Objref,TypeDef) ->
+ Mod = obj2mod(Objref),
+ Mod:'_set_type_def'(Objref,TypeDef).
+
+get_value(Objref) ->
+ orber_ifr_constantdef:'_get_value'(Objref).
+
+set_value(Objref,Value) ->
+ orber_ifr_constantdef: '_set_value'(Objref,Value).
+
+%%%---------------------------------------------------------------
+%%%
+
+get_members(Objref) ->
+ Mod = obj2mod(Objref),
+ Mod:'_get_members'(Objref).
+
+set_members(Objref,Members) ->
+ Mod = obj2mod(Objref),
+ Mod:'_set_members'(Objref,Members).
+
+%%%---------------------------------------------------------------
+%%%
+
+get_discriminator_type(Objref) ->
+ orber_ifr_uniondef:'_get_discriminator_type'(Objref).
+
+get_discriminator_type_def(Objref) ->
+ orber_ifr_uniondef:'_get_discriminator_type_def'(Objref).
+
+set_discriminator_type_def(Objref,TypeDef) ->
+ orber_ifr_uniondef:'_set_discriminator_type_def'(Objref,TypeDef).
+
+%%%---------------------------------------------------------------
+%%%
+
+get_original_type_def(Objref) ->
+ orber_ifr_aliasdef:'_get_original_type_def'(Objref).
+
+set_original_type_def(Objref,TypeDef) ->
+ orber_ifr_aliasdef:'_set_original_type_def'(Objref,TypeDef).
+
+%%%---------------------------------------------------------------
+%%%
+
+get_kind(Objref) ->
+ orber_ifr_primitivedef:'_get_kind'(Objref).
+
+%%%---------------------------------------------------------------
+%%%
+
+get_bound(Objref) ->
+ Mod = obj2mod(Objref),
+ Mod:'_get_bound'(Objref).
+
+set_bound(Objref,Bound) ->
+ Mod = obj2mod(Objref),
+ Mod:'_set_bound'(Objref,Bound).
+
+%%%---------------------------------------------------------------
+%%%
+
+get_element_type(Objref) ->
+ Mod = obj2mod(Objref),
+ Mod:'_get_element_type'(Objref).
+
+get_element_type_def(Objref) ->
+ Mod = obj2mod(Objref),
+ Mod:'_get_element_type_def'(Objref).
+
+set_element_type_def(Objref,TypeDef) ->
+ Mod = obj2mod(Objref),
+ Mod:'_set_element_type_def'(Objref,TypeDef).
+
+%%%---------------------------------------------------------------
+%%%
+
+get_length(Objref) ->
+ orber_ifr_arraydef:'_get_length'(Objref).
+
+set_length(Objref,Length) ->
+ orber_ifr_arraydef:'_set_length'(Objref,Length).
+
+%%%---------------------------------------------------------------
+%%%
+
+get_mode(Objref) ->
+ Mod = obj2mod(Objref),
+ Mod:'_get_mode'(Objref).
+
+set_mode(Objref,Mode) ->
+ Mod = obj2mod(Objref),
+ Mod:'_set_mode'(Objref,Mode).
+
+%%%---------------------------------------------------------------
+%%%
+
+get_result(Objref) ->
+ orber_ifr_operationdef:'_get_result'(Objref).
+
+get_result_def(Objref) ->
+ orber_ifr_operationdef:'_get_result_def'(Objref).
+
+set_result_def(Objref,ResultDef) ->
+ orber_ifr_operationdef:'_set_result_def'(Objref,ResultDef).
+
+get_params(Objref) ->
+ orber_ifr_operationdef:'_get_params'(Objref).
+
+set_params(Objref,Params) ->
+ orber_ifr_operationdef:'_set_params'(Objref,Params).
+
+get_contexts(Objref) ->
+ orber_ifr_operationdef:'_get_contexts'(Objref).
+
+set_contexts(Objref,Contexts) ->
+ orber_ifr_operationdef:'_set_contexts'(Objref,Contexts).
+
+get_exceptions(Objref) ->
+ orber_ifr_operationdef:'_get_exceptions'(Objref).
+
+set_exceptions(Objref,Exceptions) ->
+ orber_ifr_operationdef:'_set_exceptions'(Objref,Exceptions).
+
+%%%---------------------------------------------------------------
+%%%
+
+get_base_interfaces(Objref) ->
+ orber_ifr_interfacedef:'_get_base_interfaces'(Objref).
+
+set_base_interfaces(Objref,BaseInterfaces) ->
+ orber_ifr_interfacedef:'_set_base_interfaces'(Objref,BaseInterfaces).
+
+is_a(Objref,Interface_id) ->
+ orber_ifr_interfacedef:is_a(Objref,Interface_id).
+
+describe_interface(Objref) ->
+ orber_ifr_interfacedef:describe_interface(Objref).
+
+create_attribute(Objref,Id,Name,Version,Type,Mode) ->
+ orber_ifr_interfacedef:create_attribute(Objref,Id,Name,Version,Type,Mode).
+
+create_operation(Objref,Id,Name,Version,Result,Mode,Params,Exceptions,Contexts) ->
+ orber_ifr_interfacedef:create_operation(Objref,Id,Name,Version,Result,Mode,
+ Params,Exceptions,Contexts).
+
+obj2mod({ir_IRObject, _}) ->
+ orber_ifr_irobject;
+obj2mod({ir_Contained, _}) ->
+ orber_ifr_contained;
+obj2mod({ir_Container, _}) ->
+ orber_ifr_container;
+obj2mod({ir_IDLType, _}) ->
+ orber_ifr_idltype;
+obj2mod({ir_Repository, _}) ->
+ orber_ifr_repository;
+obj2mod({ir_ModuleDef, _}) ->
+ orber_ifr_moduledef;
+obj2mod({ir_ConstantDef, _}) ->
+ orber_ifr_constantdef;
+obj2mod({ir_TypedefDef, _}) ->
+ orber_ifr_typedef;
+obj2mod({ir_StructDef, _}) ->
+ orber_ifr_structdef;
+obj2mod({ir_UnionDef, _}) ->
+ orber_ifr_uniondef;
+obj2mod({ir_EnumDef, _}) ->
+ orber_ifr_enumdef;
+obj2mod({ir_AliasDef, _}) ->
+ orber_ifr_aliasdef;
+obj2mod({ir_PrimitiveDef, _}) ->
+ orber_ifr_primitivedef;
+obj2mod({ir_StringDef, _}) ->
+ orber_ifr_stringdef;
+obj2mod({ir_WstringDef, _}) ->
+ orber_ifr_wstringdef;
+obj2mod({ir_SequenceDef, _}) ->
+ orber_ifr_sequencedef;
+obj2mod({ir_ArrayDef, _}) ->
+ orber_ifr_arraydef;
+obj2mod({ir_ExceptionDef, _}) ->
+ orber_ifr_exceptiondef;
+obj2mod({ir_AttributeDef, _}) ->
+ orber_ifr_attributedef;
+obj2mod({ir_OperationDef, _}) ->
+ orber_ifr_operationdef;
+obj2mod({ir_InterfaceDef, _}) ->
+ orber_ifr_interfacedef;
+obj2mod({ir_FixedDef, _}) ->
+ orber_ifr_fidxeddef;
+obj2mod(Obj) ->
+ orber:dbg("[~p] orber_ifr:obj2mod(~p); unknown.",
+ [?LINE, Obj], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
+
+
diff --git a/lib/orber/src/orber_ifr.hrl b/lib/orber/src/orber_ifr.hrl
new file mode 100644
index 0000000000..a9b791cc97
--- /dev/null
+++ b/lib/orber/src/orber_ifr.hrl
@@ -0,0 +1,34 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr.hrl
+%% Purpose : Macros for the Interface Repository
+%%----------------------------------------------------------------------
+
+
+-record(lightdata, {scope, id}).
+-record(orber_light_ifr_ref, {data}).
+
+%% "Type" checking
+-define(tcheck(Type, Thing), when Type == Thing ; Thing == orber_light_ifr_ref).
+
+-define(DEBUG_LEVEL, 9).
+
diff --git a/lib/orber/src/orber_ifr_aliasdef.erl b/lib/orber/src/orber_ifr_aliasdef.erl
new file mode 100644
index 0000000000..ab25c73f47
--- /dev/null
+++ b/lib/orber/src/orber_ifr_aliasdef.erl
@@ -0,0 +1,134 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_aliasdef.erl
+%% Purpose : Code for Aliasdef
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_aliasdef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_id'/1,
+ '_set_id'/2,
+ '_get_name'/1,
+ '_set_name'/2,
+ '_get_version'/1,
+ '_set_version'/2,
+ '_get_defined_in'/1,
+ '_get_absolute_name'/1,
+ '_get_containing_repository'/1,
+ describe/1,
+ move/4,
+ '_get_type'/1,
+ '_get_original_type_def'/1,
+ '_set_original_type_def'/2
+ ]).
+
+-import(orber_ifr_utils,[get_field/2,
+ get_object/1,
+ set_object/1
+ ]).
+
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+
+%%%======================================================================
+%%% AliasDef (TypedefDef(Contained(IRObject), IDLType(IRObject)))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
+ F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
+ orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
+ orber_ifr_idltype:cleanup_for_destroy(
+ '_get_original_type_def'({ObjType,ObjID})) ++
+ orber_ifr_typedef:cleanup_for_destroy({ObjType,ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from Contained
+
+'_get_id'({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
+ orber_ifr_contained:'_get_id'({ObjType,ObjID}).
+
+'_set_id'({ObjType, ObjID}, EO_Value) ?tcheck(ir_AliasDef, ObjType) ->
+ orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
+
+'_get_name'({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
+ orber_ifr_contained:'_get_name'({ObjType,ObjID}).
+
+'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_AliasDef, ObjType) ->
+ orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
+
+'_get_version'({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
+ orber_ifr_contained:'_get_version'({ObjType,ObjID}).
+
+'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_AliasDef, ObjType) ->
+ orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
+
+'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
+ orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
+
+'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_AliasDef,ObjType) ->
+ orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
+
+'_get_containing_repository'({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
+ orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
+
+describe({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
+ orber_ifr_contained:describe({ObjType,ObjID}).
+
+move({ObjType, ObjID}, New_container, New_name, New_version)
+ ?tcheck(ir_AliasDef, ObjType) ->
+ orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,
+ New_version).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IDLType
+
+'_get_type'({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
+ orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+'_get_original_type_def'({ObjType, ObjID})
+ ?tcheck(ir_AliasDef, ObjType) ->
+ get_field({ObjType,ObjID},original_type_def).
+
+'_set_original_type_def'({ObjType, ObjID}, EO_Value)
+ ?tcheck(ir_AliasDef, ObjType) ->
+ AliasDef = get_object({ObjType, ObjID}),
+ New_AliasDef = AliasDef#ir_AliasDef{type = {tk_alias,
+ AliasDef#ir_AliasDef.id,
+ AliasDef#ir_AliasDef.name,
+ EO_Value#ir_IDLType.type},
+ original_type_def = EO_Value},
+ set_object(New_AliasDef).
diff --git a/lib/orber/src/orber_ifr_arraydef.erl b/lib/orber/src/orber_ifr_arraydef.erl
new file mode 100644
index 0000000000..5b55f2da86
--- /dev/null
+++ b/lib/orber/src/orber_ifr_arraydef.erl
@@ -0,0 +1,103 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_arraydef.erl
+%% Purpose : Code for Arraydef
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_arraydef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_type'/1,
+ '_get_length'/1,
+ '_set_length'/2,
+ '_get_element_type'/1,
+ '_get_element_type_def'/1,
+ '_set_element_type_def'/2
+ ]).
+
+-import(orber_ifr_utils,[get_field/2,
+ get_object/1,
+ set_object/1
+ ]).
+
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+
+%%%======================================================================
+%%% ArrayDef (IDLType(IRObject))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_ArrayDef, ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_ArrayDef, ObjType) ->
+ F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
+ orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_ArrayDef, ObjType) ->
+ orber_ifr_idltype:cleanup_for_destroy(
+ '_get_element_type_def'({ObjType,ObjID})) ++
+ orber_ifr_idltype:cleanup_for_destroy({ObjType,ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IDLType
+
+'_get_type'({ObjType, ObjID}) ?tcheck(ir_ArrayDef, ObjType) ->
+ orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+'_get_length'({ObjType, ObjID}) ?tcheck(ir_ArrayDef, ObjType) ->
+ get_field({ObjType,ObjID},length).
+
+'_set_length'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ArrayDef, ObjType) ->
+ ArrayDef = get_object({ObjType, ObjID}),
+ New_ArrayDef =
+ ArrayDef#ir_ArrayDef{type = {tk_array,
+ ArrayDef#ir_ArrayDef.type,
+ ArrayDef#ir_ArrayDef.length},
+ length = EO_Value},
+ set_object(New_ArrayDef).
+
+'_get_element_type'({ObjType, ObjID}) ?tcheck(ir_ArrayDef, ObjType) ->
+ get_field({ObjType,ObjID},element_type).
+
+'_get_element_type_def'({ObjType, ObjID}) ?tcheck(ir_ArrayDef, ObjType) ->
+ get_field({ObjType,ObjID},element_type_def).
+
+'_set_element_type_def'({ObjType, ObjID}, EO_Value)
+ ?tcheck(ir_ArrayDef, ObjType) ->
+ ArrayDef = get_object({ObjType, ObjID}),
+ New_type = {tk_array,
+ EO_Value#ir_IDLType.type,
+ ArrayDef#ir_ArrayDef.length},
+ New_ArrayDef = ArrayDef#ir_ArrayDef{type = New_type,
+ element_type = New_type,
+ element_type_def = EO_Value},
+ set_object(New_ArrayDef).
diff --git a/lib/orber/src/orber_ifr_attributedef.erl b/lib/orber/src/orber_ifr_attributedef.erl
new file mode 100644
index 0000000000..866ac3ae26
--- /dev/null
+++ b/lib/orber/src/orber_ifr_attributedef.erl
@@ -0,0 +1,137 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_attributedef.erl
+%% Purpose : Code for Attributedef
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_attributedef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_id'/1,
+ '_set_id'/2,
+ '_get_name'/1,
+ '_set_name'/2,
+ '_get_version'/1,
+ '_set_version'/2,
+ '_get_defined_in'/1,
+ '_get_absolute_name'/1,
+ '_get_containing_repository'/1,
+ describe/1,
+ move/4,
+ '_get_type'/1,
+ '_get_type_def'/1,
+ '_set_type_def'/2,
+ '_get_mode'/1,
+ '_set_mode'/2
+ ]).
+
+-import(orber_ifr_utils,[get_field/2,
+ set_field/3,
+ get_object/1,
+ set_object/1
+ ]).
+
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+
+%%%----------------------------------------------------------------------
+%% AttributeDef (Contained(IRObject))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
+ F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
+ orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
+ orber_ifr_idltype:cleanup_for_destroy(
+ orber_ifr_idltype:'_get_type_def'({ObjType,ObjID})) ++
+ orber_ifr_contained:cleanup_for_destroy({ObjType,ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from Contained
+
+'_get_id'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
+ orber_ifr_contained:'_get_id'({ObjType,ObjID}).
+
+'_set_id'({ObjType, ObjID}, EO_Value) ?tcheck(ir_AttributeDef, ObjType) ->
+ orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
+
+'_get_name'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
+ orber_ifr_contained:'_get_name'({ObjType,ObjID}).
+
+'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_AttributeDef, ObjType) ->
+ orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
+
+'_get_version'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
+ orber_ifr_contained:'_get_version'({ObjType,ObjID}).
+
+'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_AttributeDef, ObjType) ->
+ orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
+
+'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
+ orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
+
+'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
+ orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
+
+'_get_containing_repository'({ObjType, ObjID})
+ ?tcheck(ir_AttributeDef, ObjType) ->
+ orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
+
+describe({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
+ orber_ifr_contained:describe({ObjType,ObjID}).
+
+move({ObjType, ObjID}, New_container, New_name, New_version)
+ ?tcheck(ir_AttributeDef, ObjType) ->
+ orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,
+ New_version).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+'_get_type'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
+ get_field({ObjType,ObjID},type).
+
+'_get_type_def'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
+ get_field({ObjType,ObjID},type_def).
+
+'_set_type_def'({ObjType, ObjID},EO_Value) ?tcheck(ir_AttributeDef, ObjType) ->
+ AttributeDef = get_object({ObjType, ObjID}),
+ New_AttributeDef =
+ AttributeDef#ir_AttributeDef{type = EO_Value#ir_IDLType.type,
+ type_def = EO_Value},
+ set_object(New_AttributeDef).
+
+'_get_mode'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
+ get_field({ObjType,ObjID},mode).
+
+'_set_mode'({ObjType, ObjID}, EO_Value) ?tcheck(ir_AttributeDef, ObjType) ->
+ set_field({ObjType,ObjID}, mode, EO_Value).
diff --git a/lib/orber/src/orber_ifr_constantdef.erl b/lib/orber/src/orber_ifr_constantdef.erl
new file mode 100644
index 0000000000..c966e8ed48
--- /dev/null
+++ b/lib/orber/src/orber_ifr_constantdef.erl
@@ -0,0 +1,147 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_constantdef.erl
+%% Purpose : Code for Constantdef
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_constantdef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_id'/1,
+ '_set_id'/2,
+ '_get_name'/1,
+ '_set_name'/2,
+ '_get_version'/1,
+ '_set_version'/2,
+ '_get_defined_in'/1,
+ '_get_absolute_name'/1,
+ '_get_containing_repository'/1,
+ describe/1,
+ move/4,
+ '_get_type'/1,
+ '_get_type_def'/1,
+ '_set_type_def'/2,
+ '_get_value'/1,
+ '_set_value'/2
+ ]).
+
+-import(orber_ifr_utils,[get_field/2,
+ set_field/3,
+ get_object/1,
+ set_object/1
+ ]).
+
+-include_lib("orber/include/corba.hrl").
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+
+%%%======================================================================
+%%% ConstantDef (Contained(IRObject))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType,ObjID}) ?tcheck(ir_ConstantDef,ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType, ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
+ F = fun() -> ObjList = cleanup_for_destroy({ObjType,ObjID}),
+ orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
+ orber_ifr_idltype:cleanup_for_destroy(
+ '_get_type_def'({ObjType,ObjID})) ++
+ orber_ifr_contained:cleanup_for_destroy({ObjType,ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from Contained
+
+'_get_id'({ObjType, ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
+ orber_ifr_contained:'_get_id'({ObjType,ObjID}).
+
+'_set_id'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ConstantDef, ObjType) ->
+ orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
+
+'_get_name'({ObjType, ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
+ orber_ifr_contained:'_get_name'({ObjType,ObjID}).
+
+'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ConstantDef, ObjType) ->
+ orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
+
+'_get_version'({ObjType, ObjID}) ?tcheck(ir_ConstantDef,ObjType) ->
+ orber_ifr_contained:'_get_version'({ObjType,ObjID}).
+
+'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ConstantDef, ObjType) ->
+ orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
+
+'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
+ orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
+
+'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
+ orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
+
+'_get_containing_repository'({ObjType, ObjID})
+ ?tcheck(ir_ConstantDef, ObjType) ->
+ orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
+
+describe({ObjType, ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
+ orber_ifr_contained:describe({ObjType,ObjID}).
+ %
+move({ObjType, ObjID}, New_container, New_name, New_version)
+ ?tcheck(ir_ConstantDef, ObjType) ->
+ orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,
+ New_version).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+'_get_type'({ObjType, ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
+ get_field({ObjType,ObjID},type).
+
+'_get_type_def'({ObjType,ObjID}) ?tcheck(ir_ConstantDef,ObjType) ->
+ get_field({ObjType,ObjID},type_def).
+
+'_set_type_def'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ConstantDef, ObjType) ->
+ ConstantDef = get_object({ObjType, ObjID}),
+ New_ConstantDef = ConstantDef#ir_ConstantDef{type=EO_Value#ir_IDLType.type,
+ type_def = EO_Value},
+ set_object(New_ConstantDef).
+
+'_get_value'({ObjType, ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
+ get_field({ObjType,ObjID},value).
+
+'_set_value'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ConstantDef, ObjType) ->
+ Typecode = get_field({ObjType,ObjID},type),
+ {Value_typecode, _} = EO_Value,
+ case Value_typecode == Typecode of
+ true ->
+ set_field({ObjType, ObjID}, value, EO_Value);
+ false ->
+ orber:dbg("[~p] ~p:destroy(~p, ~p, ~p);~n"
+ "Wrong typecode in set_value.~n",
+ [?LINE, ?MODULE, ObjType, ObjID, EO_Value], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO})
+ end.
diff --git a/lib/orber/src/orber_ifr_contained.erl b/lib/orber/src/orber_ifr_contained.erl
new file mode 100644
index 0000000000..21c72e3b72
--- /dev/null
+++ b/lib/orber/src/orber_ifr_contained.erl
@@ -0,0 +1,247 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_contained.erl
+%% Purpose : Code for Contained
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_contained).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_id'/1,
+ '_set_id'/2,
+ '_get_name'/1,
+ '_set_name'/2,
+ '_get_version'/1,
+ '_set_version'/2,
+ '_get_defined_in'/1,
+ '_get_absolute_name'/1,
+ '_get_containing_repository'/1,
+ describe/1,
+ describe/2, %not in CORBA 2.0
+ move/4
+ ]).
+
+-import(orber_ifr_utils,[get_object/1,
+ get_field/2,
+ set_field/3,
+ construct/3,
+ select/2,
+ write_result/1,
+ ifr_transaction_read_write/1
+ ]).
+
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+-include_lib("orber/include/ifr_types.hrl").
+-include_lib("orber/include/corba.hrl").
+
+%%%======================================================================
+%%% Contained (IRObject)
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType,ObjID}) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
+
+%%% Note, that the destroy function is meant to be called within a
+%%% transaction called in the destroy function of an object which
+%%% inherits from Contained. A Contained should only be destroyed by
+%%% destroying the object that inherits from a Contained. An attempt
+%%% to call this function in user code will result in unpredictable
+%%% results.
+
+%%% Don't type check the object reference. We need to be able to
+%%% handle several types of objects that inherit from Contained.
+
+destroy(Contained_objref) ->
+ ObjList = cleanup_for_destroy(Contained_objref),
+ orber_ifr_irobject:destroy([Contained_objref | ObjList]).
+
+cleanup_for_destroy(Contained_objref) ->
+ Defined_in = '_get_defined_in'(Contained_objref),
+ [Container_obj] = mnesia:read(Defined_in),
+ New_container_obj =
+ construct(Container_obj,contents,
+ lists:filter(fun(X) -> X /= Contained_objref end,
+ select(Container_obj,contents))),
+ [fun() -> mnesia:write(New_container_obj) end].
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+'_get_id'({ObjType,ObjID}) ->
+ get_field({ObjType,ObjID},id).
+
+'_set_id'({ObjType,ObjID}, EO_Value) ->
+ set_field({ObjType, ObjID}, id, EO_Value).
+
+'_get_name'({ObjType,ObjID}) ->
+ get_field({ObjType,ObjID},name).
+
+'_set_name'({ObjType,ObjID}, EO_Value) ->
+ set_field({ObjType, ObjID}, name, EO_Value).
+
+'_get_version'({ObjType,ObjID}) ->
+ get_field({ObjType,ObjID},version).
+
+'_set_version'({ObjType,ObjID}, EO_Value) ->
+ set_field({ObjType, ObjID}, version, EO_Value).
+
+'_get_defined_in'({ObjType,ObjID}) ->
+ get_field({ObjType,ObjID},defined_in).
+
+'_get_absolute_name'({ObjType,ObjID}) ->
+ get_field({ObjType,ObjID},absolute_name).
+
+'_get_containing_repository'({ObjType,ObjID}) ->
+ get_field({ObjType,ObjID},containing_repository).
+
+describe(ObjRef) ->
+ Def_kind = '_get_def_kind'(ObjRef),
+ Object = get_object(ObjRef),
+ describe(Object,Def_kind).
+
+describe(Object,Def_kind) ->
+ Value =
+ case Def_kind of
+ dk_Module ->
+ #moduledescription{name = Object#ir_ModuleDef.name,
+ id = Object#ir_ModuleDef.id,
+ defined_in = Object#ir_ModuleDef.defined_in,
+ version = Object#ir_ModuleDef.version};
+ dk_Constant ->
+ #constantdescription{name = Object#ir_ConstantDef.name,
+ id = Object#ir_ConstantDef.id,
+ defined_in =
+ Object#ir_ConstantDef.defined_in,
+ version = Object#ir_ConstantDef.version,
+ type = Object#ir_ConstantDef.type,
+ value = Object#ir_ConstantDef.value};
+ dk_Typedef ->
+ #typedescription{name = Object#ir_TypedefDef.name,
+ id = Object#ir_TypedefDef.id,
+ defined_in = Object#ir_TypedefDef.defined_in,
+ version = Object#ir_TypedefDef.version,
+ type = Object#ir_TypedefDef.type};
+ dk_Struct ->
+ ?make_typedescription(Object,ir_StructDef);
+ dk_Union ->
+ ?make_typedescription(Object,ir_UnionDef);
+ dk_Enum ->
+ ?make_typedescription(Object,ir_EnumDef);
+ dk_Alias ->
+ ?make_typedescription(Object,ir_AliasDef);
+ dk_Exception ->
+ #exceptiondescription{name = Object#ir_ExceptionDef.name,
+ id = Object#ir_ExceptionDef.id,
+ defined_in =
+ Object#ir_ExceptionDef.defined_in,
+ version = Object#ir_ExceptionDef.version,
+ type = Object#ir_ExceptionDef.type};
+ dk_Attribute ->
+ #attributedescription{name = Object#ir_AttributeDef.name,
+ id = Object#ir_AttributeDef.id,
+ defined_in =
+ Object#ir_AttributeDef.defined_in,
+ version = Object#ir_AttributeDef.version,
+ type = Object#ir_AttributeDef.type,
+ mode = Object#ir_AttributeDef.mode};
+ dk_Operation ->
+ #operationdescription{name = Object#ir_OperationDef.name,
+ id = Object#ir_OperationDef.id,
+ defined_in =
+ Object#ir_OperationDef.defined_in,
+ version = Object#ir_OperationDef.version,
+ result = Object#ir_OperationDef.result,
+ mode = Object#ir_OperationDef.mode,
+ contexts =
+ Object#ir_OperationDef.contexts,
+ parameters =
+ Object#ir_OperationDef.params,
+ exceptions =
+ Object#ir_OperationDef.exceptions};
+ dk_Interface ->
+ #interfacedescription{name = Object#ir_InterfaceDef.name,
+ id = Object#ir_InterfaceDef.id,
+ defined_in =
+ Object#ir_InterfaceDef.defined_in,
+ version = Object#ir_InterfaceDef.version,
+ base_interfaces =
+ Object#ir_InterfaceDef.base_interfaces};
+ _ ->
+ undefined
+ end,
+ #contained_description{kind=Def_kind, value=Value}.
+
+move({ObjType,ObjID},{NewContainerType,NewContainerID},New_name,New_version) ->
+ Move_OK =
+ ('_get_containing_repository'({NewContainerType,NewContainerID}) ==
+ '_get_containing_repository'({ObjType,ObjID}))
+ and
+ case NewContainerType of
+ ir_Repository ->
+ lists:member(ObjType,[ir_ConstantDef,ir_TypedefDef,
+ ir_ExceptionDef,ir_InterfaceDef,
+ ir_ModuleDef]);
+ ir_ModuleDef ->
+ lists:member(ObjType,[ir_ConstantDef,ir_TypedefDef,
+ ir_ExceptionDef,ir_ModuleDef,
+ ir_InterfaceDef]);
+ ir_InterfaceDef ->
+ lists:member(ObjType,[ir_ConstantDef,ir_TypedefDef,
+ ir_ExceptionDef,ir_AttributeDef,
+ ir_OperationDef]);
+ _ ->
+ false
+ end
+ and
+ (orber_ifr_container:lookup_name({NewContainerType,NewContainerID},
+ New_name, -1, % *** -1?
+ dk_All, false) == []),
+ move(Move_OK,{ObjType,ObjID},{NewContainerType,NewContainerID},New_name,
+ New_version).
+
+move(true, Contained_objref, New_container, New_name, New_version) ->
+ F = fun() -> Defined_in = '_get_defined_in'(Contained_objref),
+ [Old_container_obj] = mnesia:read(Defined_in),
+ New_old_container_obj =
+ construct(Old_container_obj,contents,
+ lists:filter(fun(X) -> X /= Contained_objref
+ end, select(Old_container_obj,
+ contents))),
+ New_container_obj = mnesia:read(New_container),
+ Contents = orber_ifr_container:contents(New_container, dk_All,
+ true),
+ New_new_container_obj =
+ construct(construct(construct(New_container_obj, contents,
+ [Contained_objref | Contents]),
+ name,New_name),version,New_version),
+ mnesia:write(New_old_container_obj),
+ mnesia:write(New_new_container_obj)
+ end,
+ write_result(ifr_transaction_read_write(F));
+
+move(false, _Contained_objref, _New_container, _New_name, _New_version) ->
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
diff --git a/lib/orber/src/orber_ifr_container.erl b/lib/orber/src/orber_ifr_container.erl
new file mode 100644
index 0000000000..85ae36bfa2
--- /dev/null
+++ b/lib/orber/src/orber_ifr_container.erl
@@ -0,0 +1,463 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_container.erl
+%% Purpose : Code for Container
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_container).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ lookup/2,
+ contents/3,
+ lookup_name/5,
+ describe_contents/4,
+ make_absolute_name/2, %not in CORBA 2.0
+ make_containing_repository/1, %not in CORBA 2.0
+ add_to_container/5, %not in CORBA 2.0
+ create_module/4,
+ create_constant/6,
+ create_struct/5,
+ create_union/6,
+ create_enum/5,
+ create_alias/5,
+ create_interface/5,
+ create_exception/5
+ ]).
+
+-import(orber_ifr_utils,[get_field/2,select/2,construct/3,makeref/1,unique/0]).
+-import(lists,[map/2,filter/2,flatten/1,sublist/2]).
+
+-include_lib("orber/include/corba.hrl").
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+-include_lib("orber/include/ifr_types.hrl").
+
+%%%======================================================================
+%%% Container (IRObject)
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'(ObjRef) ->
+ orber_ifr_irobject:'_get_def_kind'(ObjRef).
+
+%%% Note, that the destroy function is meant to be called within a
+%%% transaction called in the destroy function of an object which
+%%% inherits from Container. A Container should only be destroyed by
+%%% destroying the object that inherits from a Container. An attempt
+%%% to call this function in user code will result in unpredictable
+%%% results.
+
+%%% Don't type check the object reference. We need to be able to handle several
+%%% types of objects that inherit from Container.
+
+destroy(Container_objref) ->
+ ObjList = cleanup_for_destroy(Container_objref),
+ orber_ifr_irobject:destroy([Container_objref | ObjList]).
+
+cleanup_for_destroy(Container_objref) ->
+ Contents = get_field(Container_objref, contents),
+ map(fun destroy_thing/1, Contents) ++ Contents.
+
+%%% Destroy objects which inherit from Contained, i.e. objects that populate
+%%% the contents list of a Container.
+
+destroy_thing({ObjType,ObjID}) when ObjType == ir_ModuleDef ->
+ orber_ifr_moduledef:cleanup_for_destroy({ObjType,ObjID});
+destroy_thing({ObjType,ObjID}) when ObjType == ir_ConstantDef ->
+ orber_ifr_constantdef:cleanup_for_destroy({ObjType,ObjID});
+destroy_thing({ObjType,ObjID}) when ObjType == ir_TypedefDef ->
+ orber_ifr_typedef:cleanup_for_destroy({ObjType,ObjID});
+destroy_thing({ObjType,ObjID}) when ObjType == ir_StructDef ->
+ orber_ifr_structdef:cleanup_for_destroy({ObjType,ObjID});
+destroy_thing({ObjType,ObjID}) when ObjType == ir_UnionDef ->
+ orber_ifr_uniondef:cleanup_for_destroy({ObjType,ObjID});
+destroy_thing({ObjType,ObjID}) when ObjType == ir_EnumDef ->
+ orber_ifr_enumdef:cleanup_for_destroy({ObjType,ObjID});
+destroy_thing({ObjType,ObjID}) when ObjType == ir_AliasDef ->
+ orber_ifr_aliasdef:cleanup_for_destroy({ObjType,ObjID});
+destroy_thing({ObjType,ObjID}) when ObjType == ir_ExceptionDef ->
+ orber_ifr_exceptiondef:cleanup_for_destroy({ObjType,ObjID});
+destroy_thing({ObjType,ObjID}) when ObjType == ir_AttributeDef ->
+ orber_ifr_attributedef:cleanup_for_destroy({ObjType,ObjID});
+destroy_thing({ObjType,ObjID}) when ObjType == ir_OperationDef ->
+ orber_ifr_operationdef:cleanup_for_destroy({ObjType,ObjID});
+destroy_thing({ObjType,ObjID}) when ObjType == ir_InterfaceDef ->
+ orber_ifr_interfacedef:cleanup_for_destroy({ObjType,ObjID});
+destroy_thing({_ObjType,_ObjID}) ->
+ %% Unknown object in Container contents.
+ true.
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+lookup(ObjRef, Search_name) ->
+ Contents = contents(ObjRef, dk_All, false),
+
+ %% We now have the contents (a list of object references).
+ %% Let's find all objects with the correct name.
+
+ case filter(fun({Type,ID}) ->
+ orber_ifr_contained:'_get_absolute_name'({Type,ID}) ==
+ Search_name
+ end,
+ Contents) of
+ [Obj] ->
+ Obj;
+ X ->
+ X
+ end.
+
+
+contents(ObjRef, Limit_type, Exclude_inherited) ->
+ Contents =
+ flatten(get_field(ObjRef, contents) ++
+ inherited_contents(ObjRef,Exclude_inherited)),
+ AllContents =
+ Contents ++
+ flatten(subcontents(Limit_type,Contents)),
+ limit_contents(Limit_type,AllContents).
+
+
+subcontents(_,[]) -> [];
+subcontents(Limit_type,Contents) ->
+ map(fun(ObjRef) -> contents(ObjRef,Limit_type) end, Contents).
+
+contents({ir_Repository,ObjID},Limit_type) ->
+ orber_ifr_repository:contents({ir_Repository,ObjID},Limit_type,false);
+contents({ir_ModuleDef,ObjID},Limit_type) ->
+ orber_ifr_moduledef:contents({ir_ModuleDef,ObjID},Limit_type,false);
+contents({ir_InterfaceDef,ObjID},Limit_type) ->
+ orber_ifr_interfacedef:contents({ir_InterfaceDef,ObjID},Limit_type,false);
+contents(_,_) -> [].
+
+limit_contents(dk_All,Contents) -> Contents;
+limit_contents(Limit_type,Contents) ->
+ filter(fun(Obj_Ref) -> '_get_def_kind'(Obj_Ref) == Limit_type end,
+ Contents).
+
+
+lookup_name(ObjRef, Search_name, Levels_to_search,
+ Limit_type, Exclude_inherited) ->
+ Contents = get_field(ObjRef, contents),
+ AllContents = Contents ++ inherited_contents(ObjRef, Exclude_inherited),
+ lookup_name(AllContents, Search_name, Levels_to_search, Limit_type).
+
+inherited_contents({ir_InterfaceDef,ObjID}, false) ->
+ map(fun(ObjRef) -> get_field(ObjRef,contents) end,
+ orber_ifr_interfacedef:'_get_base_interfaces'({ir_InterfaceDef,ObjID}));
+inherited_contents(_, false) -> [];
+inherited_contents(_, true) -> [].
+
+lookup_name(Contents, Search_name, Level, Limit_type) ->
+ filter(fun(X) ->
+ (orber_ifr_contained:'_get_id'(X) == Search_name)
+ and
+ ('_get_def_kind'(X) == Limit_type)
+ end, Contents) ++
+ sublookup_name(Contents, Search_name, Level - 1, Limit_type).
+
+sublookup_name([],_,_,_) -> [];
+sublookup_name(_,_,0,_) -> [];
+sublookup_name(Contents, Search_name, Level, Limit_type) ->
+ map(fun(X) ->
+ Conts = subcontents(X),
+ lookup_name(Conts, Search_name, Level - 1, Limit_type)
+ end, Contents).
+
+subcontents({ir_Repository,ObjID}) ->
+ get_field({ir_Repository,ObjID}, contents);
+subcontents({ir_ModuleDefObjType,ObjID}) ->
+ get_field({ir_ModuleDef,ObjID}, contents);
+subcontents({ir_InterfaceDef,ObjID}) ->
+ get_field({ir_InterfaceDef,ObjID}, contents);
+subcontents(_) -> [].
+
+describe_contents(ObjRef, Limit_type, Exclude_inherited,
+ Max_returned_objs) ->
+ Limited_contents = contents(ObjRef,Limit_type,Exclude_inherited),
+ describe_contents(Limited_contents, Max_returned_objs, []).
+
+describe_contents(_, 0, Acc) ->
+ Acc;
+describe_contents([], _Max_returned_objs, Acc) ->
+ Acc;
+describe_contents([H|T], Max_returned_objs, Acc) ->
+ Desc = orber_ifr_contained:describe(H),
+ describe_contents(T, Max_returned_objs-1, [Desc|Acc]).
+
+
+%% This is a kludge. Se p. 6-11 in CORBA 2.0.
+make_absolute_name({ObjType,ObjID}, Name) ->
+ case ObjType of
+ ir_Repository ->
+ "::" ++ Name;
+ _ ->
+ orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}) ++
+ "::" ++ Name
+ end.
+
+%% This is a kludge. Se p. 6-15 in CORBA 2.0.
+make_containing_repository({ObjType,ObjID}) ->
+ case ObjType of
+ ir_Repository ->
+ {ir_Repository,ObjID};
+ _ ->
+ orber_ifr_contained:'_get_containing_repository'({ObjType, ObjID})
+ end.
+
+add_to_container(ContainerRef,Object, Id, Table, Index) ->
+ F = fun() ->
+ [Container_obj] = mnesia:wread(ContainerRef),
+ case mnesia:index_read(Table, Id, Index) of
+ [] ->
+ ObjectRef = makeref(Object),
+ New_container_obj =
+ construct(Container_obj,contents,
+ [ObjectRef | select(Container_obj,contents)]),
+ mnesia:write(New_container_obj),
+ mnesia:write(Object);
+ _ ->
+ mnesia:abort("duplicate")
+ end
+ end,
+ case mnesia:transaction(F) of
+ {aborted, "duplicate"} ->
+ %% Must keep the misspelled word (must match IC generated code).
+ exit({allready_registered, Id});
+ {aborted, Reason} ->
+ orber:dbg("[~p] orber_ifr_container:add_to_container(~p). aborted:~n~p~n",
+ [?LINE, Id, Reason], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO});
+ {atomic, _} ->
+ ok
+ end.
+
+add_to_light(#orber_light_ifr_ref{data = Data} = LRef, Id, Type, Name) ->
+ BaseId = get_base_id(Data#lightdata.id, Id),
+ NewScope = scoped_name(Data#lightdata.scope, Name, Type),
+ F = fun() ->
+ D = #orber_light_ifr{id = Id,
+ module = list_to_atom(NewScope),
+ type = Type, base_id = BaseId},
+ mnesia:write(D)
+ end,
+ case mnesia:transaction(F) of
+ {aborted, Reason} ->
+ orber:dbg("[~p] orber_ifr_container:add_to_light(~p). aborted:~n~p~n",
+ [?LINE, Id, Reason], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO});
+ {atomic, _} ->
+ LRef#orber_light_ifr_ref{data = Data#lightdata{scope = NewScope,
+ id = BaseId}}
+ end.
+
+get_base_id("", Id) ->
+ Id;
+get_base_id(Id, _) ->
+ Id.
+
+scoped_name("", Name, _) ->
+ Name;
+scoped_name(Scope, _, ?IFR_ConstantDef) ->
+ Scope;
+scoped_name(Scope, Name, _) ->
+ Scope ++ "_" ++ Name.
+
+create_module(#orber_light_ifr_ref{} = LRef, Id, Name, _Version) ->
+ add_to_light(LRef, Id, ?IFR_ModuleDef, Name);
+create_module(ObjRef, Id, Name, Version) ->
+ New_module = #ir_ModuleDef{ir_Internal_ID = unique(),
+ def_kind = dk_Module,
+ contents = [],
+ id = Id,
+ name = Name,
+ version = Version,
+ defined_in = ObjRef,
+ absolute_name =
+ make_absolute_name(ObjRef, Name),
+ containing_repository =
+ make_containing_repository(ObjRef)},
+ add_to_container(ObjRef,New_module, Id, ir_ModuleDef, #ir_ModuleDef.id),
+ makeref(New_module).
+
+create_constant(#orber_light_ifr_ref{} = LRef, Id, Name, _Version, _Type, _Value) ->
+ add_to_light(LRef, Id, ?IFR_ConstantDef, Name);
+create_constant(ObjRef, Id, Name, Version, Type, Value) ->
+ IDL_typecode = get_field(Type,type),
+ {Typecode, _} = Value,
+ case IDL_typecode == Typecode of
+ false ->
+ orber:dbg("[~p] ~p:create_constant(~p, ~p, ~p, ~p, ~p, ~p);~n"
+ "Wrong type.~n",
+ [?LINE, ?MODULE, ObjRef, Id, Name, Version, Type, Value],
+ ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO});
+ true ->
+ New_constant = #ir_ConstantDef{ir_Internal_ID = unique(),
+ def_kind = dk_Constant,
+ id = Id,
+ name = Name,
+ version = Version,
+ defined_in = ObjRef,
+ absolute_name =
+ make_absolute_name(ObjRef, Name),
+ containing_repository =
+ make_containing_repository(ObjRef),
+ type = get_field(Type,type),
+ type_def = Type,
+ value = Value},
+ add_to_container(ObjRef,New_constant,
+ Id, ir_ConstantDef, #ir_ConstantDef.id),
+ makeref(New_constant)
+ end.
+
+create_struct(#orber_light_ifr_ref{} = LRef, Id, Name, _Version, _Members) ->
+ add_to_light(LRef, Id, ?IFR_StructDef, Name);
+create_struct(ObjRef, Id, Name, Version, Members) ->
+ New_struct = #ir_StructDef{ir_Internal_ID = unique(),
+ def_kind = dk_Struct,
+ id = Id,
+ name = Name,
+ version = Version,
+ defined_in = ObjRef,
+ absolute_name =
+ make_absolute_name(ObjRef, Name),
+ containing_repository =
+ make_containing_repository(ObjRef),
+ type = {tk_struct, Id, Name,
+ map(fun(#structmember{name=MemName,
+ type=Type}) ->
+ {MemName,Type} end,
+ Members)},
+ members = Members},
+ add_to_container(ObjRef, New_struct, Id, ir_StructDef, #ir_StructDef.id),
+ makeref(New_struct).
+
+create_union(#orber_light_ifr_ref{} = LRef, Id, Name, _Version,
+ _Discriminator_type, _Members) ->
+ add_to_light(LRef, Id, ?IFR_UnionDef, Name);
+create_union(ObjRef, Id, Name, Version,
+ Discriminator_type, Members) ->
+ Discriminator_type_code = get_field(Discriminator_type, type),
+ New_union = #ir_UnionDef{ir_Internal_ID = unique(),
+ def_kind = dk_Union,
+ id = Id,
+ name = Name,
+ version = Version,
+ defined_in = ObjRef,
+ absolute_name =
+ make_absolute_name(ObjRef, Name),
+ containing_repository =
+ make_containing_repository(ObjRef),
+ type = {tk_union, Id, Name,
+ Discriminator_type_code, -1,
+ map(fun(#unionmember{name=MemName,
+ label=Label,
+ type=Type}) ->
+ {Label,MemName,Type} end,
+ Members)},
+ discriminator_type = Discriminator_type_code,
+ discriminator_type_def = Discriminator_type,
+ members = Members},
+ add_to_container(ObjRef, New_union, Id, ir_UnionDef, #ir_UnionDef.id),
+ makeref(New_union).
+
+create_enum(#orber_light_ifr_ref{} = LRef, Id, Name, _Version, _Members) ->
+ add_to_light(LRef, Id, ?IFR_EnumDef, Name);
+create_enum(ObjRef, Id, Name, Version, Members) ->
+ New_enum = #ir_EnumDef{ir_Internal_ID = unique(),
+ def_kind = dk_Enum,
+ id = Id,
+ name = Name,
+ version = Version,
+ defined_in = ObjRef,
+ absolute_name =
+ make_absolute_name(ObjRef, Name),
+ containing_repository =
+ make_containing_repository(ObjRef),
+ type = {tk_enum, Id, Name, Members},
+ members = Members},
+ add_to_container(ObjRef, New_enum, Id, ir_EnumDef, #ir_EnumDef.id),
+ makeref(New_enum).
+
+create_alias(#orber_light_ifr_ref{} = LRef, Id, Name, _Version, _Original_type) ->
+ add_to_light(LRef, Id, ?IFR_AliasDef, Name);
+create_alias(ObjRef, Id, Name, Version, Original_type) ->
+ New_alias = #ir_AliasDef{ir_Internal_ID = unique(),
+ def_kind = dk_Alias,
+ id = Id,
+ name = Name,
+ version = Version,
+ defined_in = ObjRef,
+ absolute_name =
+ make_absolute_name(ObjRef, Name),
+ containing_repository =
+ make_containing_repository(ObjRef),
+ type = {tk_alias, Id, Name,
+ get_field(Original_type,type)},
+ original_type_def = Original_type},
+ add_to_container(ObjRef, New_alias, Id, ir_AliasDef, #ir_AliasDef.id),
+ makeref(New_alias).
+
+create_interface(#orber_light_ifr_ref{} = LRef, Id, Name, _Version, _Base_interfaces) ->
+ add_to_light(LRef, Id, ?IFR_InterfaceDef, Name);
+create_interface(ObjRef, Id, Name, Version, Base_interfaces) ->
+ New_interface = #ir_InterfaceDef{ir_Internal_ID = unique(),
+ def_kind = dk_Interface,
+ contents = [],
+ id = Id,
+ name = Name,
+ version = Version,
+ defined_in = ObjRef,
+ absolute_name =
+ make_absolute_name(ObjRef,Name),
+ containing_repository =
+ make_containing_repository(ObjRef),
+ type = {tk_objref, Id, Name},
+ base_interfaces = Base_interfaces},
+ add_to_container(ObjRef, New_interface, Id, ir_InterfaceDef, #ir_InterfaceDef.id),
+ makeref(New_interface).
+
+create_exception(#orber_light_ifr_ref{} = LRef, Id, Name, _Version, _Members) ->
+ add_to_light(LRef, Id, ?IFR_ExceptionDef, Name);
+create_exception(ObjRef, Id, Name, Version, Members) ->
+ New_exception = #ir_ExceptionDef{ir_Internal_ID = unique(),
+ def_kind = dk_Exception,
+ id = Id,
+ name = Name,
+ version = Version,
+ defined_in = ObjRef,
+ absolute_name =
+ make_absolute_name(ObjRef,Name),
+ containing_repository =
+ make_containing_repository(ObjRef),
+ type = {tk_except, Id, Name,
+ map(fun(#structmember{name=MemName,
+ type=Type})
+ ->
+ {MemName,Type} end,
+ Members)},
+ members = Members},
+ add_to_container(ObjRef, New_exception, Id, ir_ExceptionDef, #ir_ExceptionDef.id),
+ makeref(New_exception).
diff --git a/lib/orber/src/orber_ifr_enumdef.erl b/lib/orber/src/orber_ifr_enumdef.erl
new file mode 100644
index 0000000000..035dcdd644
--- /dev/null
+++ b/lib/orber/src/orber_ifr_enumdef.erl
@@ -0,0 +1,129 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_enumdef.erl
+%% Purpose : Code for Enumdef
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_enumdef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_id'/1,
+ '_set_id'/2,
+ '_get_name'/1,
+ '_set_name'/2,
+ '_get_version'/1,
+ '_set_version'/2,
+ '_get_defined_in'/1,
+ '_get_absolute_name'/1,
+ '_get_containing_repository'/1,
+ describe/1,
+ move/4,
+ '_get_type'/1,
+ '_get_members'/1,
+ '_set_members'/2
+ ]).
+
+-import(orber_ifr_utils,[get_field/2,
+ get_object/1,
+ set_object/1
+ ]).
+
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+
+%%%======================================================================
+%%% EnumDef (TypedefDef(Contained(IRObject), IDLType(IRObject)))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
+ F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
+ orber_ifr_irobject:destroy([{ObjType, ObjID} | ObjList])
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
+ orber_ifr_typedef:cleanup_for_destroy({ObjType,ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from Contained
+
+'_get_id'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
+ orber_ifr_contained:'_get_id'({ObjType,ObjID}).
+
+'_set_id'({ObjType, ObjID}, EO_Value) ?tcheck(ir_EnumDef, ObjType) ->
+ orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
+
+'_get_name'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
+ orber_ifr_contained:'_get_name'({ObjType,ObjID}).
+
+'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_EnumDef, ObjType) ->
+ orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
+
+'_get_version'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
+ orber_ifr_contained:'_get_version'({ObjType,ObjID}).
+
+'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_EnumDef, ObjType) ->
+ orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
+
+'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
+ orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
+
+'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
+ orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
+
+'_get_containing_repository'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
+ orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
+
+describe({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
+ orber_ifr_contained:describe({ObjType,ObjID}).
+
+move({ObjType, ObjID}, New_container, New_name, New_version)
+ ?tcheck(ir_EnumDef, ObjType) ->
+ orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,New_version).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IDLType
+
+'_get_type'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
+ orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+'_get_members'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
+ get_field({ObjType,ObjID},members).
+
+'_set_members'({ObjType, ObjID}, EO_Value) ?tcheck(ir_EnumDef, ObjType) ->
+ EnumDef = get_object({ObjType, ObjID}),
+ New_EnumDef = EnumDef#ir_EnumDef{type = {tk_enum,
+ EnumDef#ir_EnumDef.id,
+ EnumDef#ir_EnumDef.name,
+ EO_Value},
+ members = EO_Value},
+ set_object(New_EnumDef).
diff --git a/lib/orber/src/orber_ifr_exceptiondef.erl b/lib/orber/src/orber_ifr_exceptiondef.erl
new file mode 100644
index 0000000000..7665d3d1bc
--- /dev/null
+++ b/lib/orber/src/orber_ifr_exceptiondef.erl
@@ -0,0 +1,164 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_exceptiondef.erl
+%% Purpose : Code for Exceptiondef
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_exceptiondef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_id'/1,
+ '_set_id'/2,
+ '_get_name'/1,
+ '_set_name'/2,
+ '_get_version'/1,
+ '_set_version'/2,
+ '_get_defined_in'/1,
+ '_get_absolute_name'/1,
+ '_get_containing_repository'/1,
+ describe/1,
+ %%lookup_id/1, %not in CORBA 2.0
+ move/4,
+ '_get_type'/1,
+ '_get_members'/1,
+ '_set_members'/2
+ ]).
+
+-import(orber_ifr_utils,[get_field/2,
+ get_object/1,
+ set_object/1
+ ]).
+-import(lists,[map/2]).
+
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+-include_lib("orber/include/ifr_types.hrl").
+
+%%%======================================================================
+%%% ExceptionDef (Contained(IRObject))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
+ F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
+ orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
+ lists:map(fun(X) -> orber_ifr_idltype:cleanup_for_destroy(
+ X#structmember.type_def)
+ end,
+ '_get_members'({ObjType, ObjID})) ++
+ orber_ifr_contained:cleanup_for_destroy({ObjType,ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from Contained
+
+'_get_id'({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
+ orber_ifr_contained:'_get_id'({ObjType,ObjID}).
+
+'_set_id'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ExceptionDef, ObjType) ->
+ orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
+
+'_get_name'({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
+ orber_ifr_contained:'_get_name'({ObjType,ObjID}).
+
+'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ExceptionDef, ObjType) ->
+ orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
+
+'_get_version'({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
+ orber_ifr_contained:'_get_version'({ObjType,ObjID}).
+
+'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ExceptionDef, ObjType) ->
+ orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
+
+'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
+ orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
+
+'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
+ orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
+
+'_get_containing_repository'({ObjType, ObjID})
+ ?tcheck(ir_ExceptionDef, ObjType) ->
+ orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
+
+describe({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
+ orber_ifr_contained:describe({ObjType,ObjID}).
+
+%%% *** This function should be removed. Use
+%%% orber_ifr_repository:lookup_id/2 instead.
+
+%%lookup_id(SearchId) ->
+%% _F = fun() ->
+%% Q = query [X.ir_Internal_ID || X <- table(ir_ExceptionDef)]
+%% end,
+%% mnemosyne:eval(Q)
+%% end,
+%% case orber_ifr_utils:ifr_transaction_read(_F) of
+%% ?read_check_2() ->
+%% {ok, []};
+%% ?read_check_1(Rep_IDs) ->
+%% ExceptionDefs = lists:map(fun(X) -> {ir_ExceptionDef, X} end,
+%% Rep_IDs),
+%% {ok, lists:filter(fun(X) -> orber_ifr_exceptiondef:'_get_id'(X) ==
+%% SearchId end,
+%% ExceptionDefs)}
+%% end.
+
+move({ObjType, ObjID}, New_container, New_name, New_version)
+ ?tcheck(ir_ExceptionDef, ObjType) ->
+ orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,
+ New_version).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+'_get_type'({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
+ get_field({ObjType,ObjID},type).
+
+'_get_members'({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
+ get_field({ObjType,ObjID},members).
+
+'_set_members'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ExceptionDef, ObjType) ->
+ ExceptionDef = get_object({ObjType, ObjID}),
+ Members=map(fun(Exceptionmember) ->
+ Exceptionmember#structmember{type=tk_void}
+ end, EO_Value),
+ New_ExceptionDef =
+ ExceptionDef#ir_ExceptionDef{type =
+ {tk_except,
+ ExceptionDef#ir_ExceptionDef.id,
+ ExceptionDef#ir_ExceptionDef.name,
+ map(fun(#structmember{name=Name,
+ type=Type}) ->
+ {Name,Type}
+ end,
+ EO_Value)},
+ members=Members},
+ set_object(New_ExceptionDef).
diff --git a/lib/orber/src/orber_ifr_fixeddef.erl b/lib/orber/src/orber_ifr_fixeddef.erl
new file mode 100644
index 0000000000..815eb77ea3
--- /dev/null
+++ b/lib/orber/src/orber_ifr_fixeddef.erl
@@ -0,0 +1,79 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_fixeddef.erl
+%% Description :
+%%
+%%----------------------------------------------------------------------
+-module(orber_ifr_fixeddef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_type'/1,
+ '_get_digits'/1,
+ '_set_digits'/2,
+ '_get_scale'/1,
+ '_set_scale'/2]).
+
+-import(orber_ifr_utils, [get_field/2,
+ set_field/3]).
+
+-include("orber_ifr.hrl").
+
+%%%======================================================================
+%%% FixedDef (IDLType(IRObject))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType,ObjID}) ?tcheck(ir_FixedDef, ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_FixedDef, ObjType) ->
+ F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
+ orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_FixedDef, ObjType) ->
+ orber_ifr_idltype:cleanup_for_destroy({ObjType,ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IDLType
+
+'_get_type'({ObjType, ObjID}) ?tcheck(ir_FixedDef, ObjType) ->
+ orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+'_get_digits'({ObjType, ObjID}) ?tcheck(ir_FixedDef, ObjType) ->
+ get_field({ObjType,ObjID},digits).
+'_get_scale'({ObjType, ObjID}) ?tcheck(ir_FixedDef, ObjType) ->
+ get_field({ObjType,ObjID},scale).
+
+'_set_digits'({ObjType, ObjID}, EO_Value)
+ ?tcheck(ir_FixedDef, ObjType) ->
+ set_field({ObjType, ObjID}, digits, EO_Value).
+'_set_scale'({ObjType, ObjID}, EO_Value)
+ ?tcheck(ir_FixedDef, ObjType) ->
+ set_field({ObjType, ObjID}, scale, EO_Value).
diff --git a/lib/orber/src/orber_ifr_idltype.erl b/lib/orber/src/orber_ifr_idltype.erl
new file mode 100644
index 0000000000..6bebaab150
--- /dev/null
+++ b/lib/orber/src/orber_ifr_idltype.erl
@@ -0,0 +1,74 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_idltype.erl
+%% Purpose : Code for Idltype
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_idltype).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_type'/1,
+ '_get_type_def'/1
+ ]).
+
+-import(orber_ifr_utils,[get_field/2]).
+
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+
+%%%======================================================================
+%%% IDLType (IRObject)
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_IDLType, ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType, ObjID}).
+
+%%% Don't type check the object reference. We need to be able to
+%%% handle several types of objects that inherit from IDLType.
+
+destroy(IDLType_objref) ->
+ F = fun() -> ObjList = cleanup_for_destroy(IDLType_objref),
+ orber_ifr_irobject:destroy(ObjList)
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy(IDLType_objref) ->
+ [IDLType_objref].
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+%% What is this ? You cannot check this for ir_IDLType here !
+%% ( an object type cannot be both .... )
+%%'_get_type'({ObjType,ObjID}) ?tcheck(ir_IDLType, ObjType) ->
+%% get_field({ObjType,ObjID},type).
+
+
+'_get_type'({ObjType,ObjID}) ->
+ get_field({ObjType,ObjID},type).
+
+'_get_type_def'({ObjType,ObjID}) ->
+ get_field({ObjType,ObjID},type_def).
diff --git a/lib/orber/src/orber_ifr_interfacedef.erl b/lib/orber/src/orber_ifr_interfacedef.erl
new file mode 100644
index 0000000000..d8dc4f7802
--- /dev/null
+++ b/lib/orber/src/orber_ifr_interfacedef.erl
@@ -0,0 +1,339 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_interfacedef.erl
+%% Purpose : Code for Interfacedef
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_interfacedef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ lookup/2,
+ contents/3,
+ lookup_name/5,
+ describe_contents/4,
+ create_module/4,
+ create_constant/6,
+ create_struct/5,
+ create_union/6,
+ create_enum/5,
+ create_alias/5,
+ create_interface/5,
+ create_exception/5,
+ '_get_id'/1,
+ '_set_id'/2,
+ '_get_name'/1,
+ '_set_name'/2,
+ '_get_version'/1,
+ '_set_version'/2,
+ '_get_defined_in'/1,
+ '_get_absolute_name'/1,
+ '_get_containing_repository'/1,
+ describe/1,
+ move/4,
+ '_get_type'/1,
+ '_get_base_interfaces'/1,
+ '_set_base_interfaces'/2,
+ is_a/2,
+ describe_interface/1,
+ create_attribute/6,
+ create_operation/9
+ ]).
+
+-import(orber_ifr_utils,[get_object/1,
+ get_field/2,
+ set_field/3,
+ select/2,
+ makeref/1,
+ unique/0
+ ]).
+-import(orber_ifr_container,[make_absolute_name/2,
+ make_containing_repository/1
+ ]).
+
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+-include_lib("orber/include/ifr_types.hrl").
+
+
+%%%======================================================================
+%%% InterfaceDef (Container(IRObject), Contained(IRObject), IDLType(IRObject))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
+ F = fun() -> ObjList = cleanup_for_destroy({ObjType,ObjID}),
+ orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_contained:cleanup_for_destroy({ObjType,ObjID}) ++
+ orber_ifr_container:cleanup_for_destroy({ObjType,ObjID}) ++
+ orber_ifr_idltype:cleanup_for_destroy({ObjType,ObjID}).
+
+
+%% BUG ! You can't remove inherited !!!!!
+%%cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
+%% lists:map(fun(X) -> cleanup_for_destroy(X) end,
+%% '_get_base_interfaces'({ObjType,ObjID})) ++ <<<<<<<<<< Here
+%% orber_ifr_contained:cleanup_for_destroy({ObjType,ObjID}) ++
+%% orber_ifr_container:cleanup_for_destroy({ObjType,ObjID}) ++
+%% orber_ifr_idltype:cleanup_for_destroy({ObjType,ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from Container
+
+lookup({ObjType, ObjID}, Search_name) ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_container:lookup({ObjType,ObjID}, Search_name).
+
+contents({ObjType, ObjID}, Limit_type, Exclude_inherited)
+ ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_container:contents({ObjType,ObjID},Limit_type,Exclude_inherited).
+
+lookup_name({ObjType, ObjID}, Search_name, Levels_to_search, Limit_type,
+ Exclude_inherited) ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_container:lookup_name({ObjType,ObjID}, Search_name,
+ Levels_to_search, Limit_type,
+ Exclude_inherited).
+
+describe_contents({ObjType, ObjID}, Limit_type, Exclude_inherited,
+ Max_returned_objs) ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_container:describe_contents({ObjType,ObjID}, Limit_type,
+ Exclude_inherited,
+ Max_returned_objs).
+
+create_module({ObjType, ObjID}, Id, Name, Version)
+ ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_container:create_module({ObjType, ObjID}, Id, Name, Version).
+
+create_constant({ObjType, ObjID}, Id, Name, Version, Type, Value)
+ ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_container:create_constant({ObjType, ObjID}, Id, Name, Version,
+ Type, Value).
+
+create_struct({ObjType, ObjID}, Id, Name, Version, Members)
+ ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_container:create_struct({ObjType,ObjID},Id,Name,Version,Members).
+
+create_union({ObjType, ObjID}, Id, Name, Version, Discriminator_type, Members)
+ ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_container:create_union({ObjType, ObjID}, Id, Name, Version,
+ Discriminator_type, Members).
+
+create_enum({ObjType, ObjID}, Id, Name, Version, Members)
+ ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_container:create_enum({ObjType, ObjID},Id,Name,Version,Members).
+
+create_alias({ObjType, ObjID}, Id, Name, Version, Original_type)
+ ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_container:create_alias({ObjType, ObjID}, Id, Name, Version,
+ Original_type).
+
+create_interface({ObjType, ObjID}, Id, Name, Version, Base_interfaces)
+ ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_container:create_interface({ObjType, ObjID}, Id, Name, Version,
+ Base_interfaces).
+
+create_exception({ObjType, ObjID}, Id, Name, Version, Members)
+ ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_container:create_exception({ObjType, ObjID}, Id, Name, Version,
+ Members).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from Contained
+
+'_get_id'({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_contained:'_get_id'({ObjType,ObjID}).
+
+'_set_id'({ObjType, ObjID}, EO_Value) ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
+
+'_get_name'({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_contained:'_get_name'({ObjType,ObjID}).
+
+'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
+
+'_get_version'({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_contained:'_get_version'({ObjType,ObjID}).
+
+'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
+
+'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
+
+'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
+
+'_get_containing_repository'({ObjType, ObjID})
+ ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
+
+describe({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_contained:describe({ObjType,ObjID}).
+
+move({ObjType, ObjID}, New_container, New_name, New_version)
+ ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,
+ New_version).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IDLType
+
+'_get_type'({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
+ orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+'_get_base_interfaces'({ObjType,ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
+ get_field({ObjType,ObjID},base_interfaces).
+
+'_set_base_interfaces'({ObjType, ObjID}, EO_Value)
+ ?tcheck(ir_InterfaceDef, ObjType) ->
+ set_field({ObjType,ObjID}, base_interfaces, EO_Value).
+
+
+
+is_a({ObjType, ObjID}, Interface_id) ?tcheck(ir_InterfaceDef, ObjType) ->
+ Base_interfaces = '_get_base_interfaces'({ObjType, ObjID}),
+ lists:any(fun(X) ->
+ case catch orber_ifr_contained:'_get_id'(X) of
+ Interface_id ->
+ 'true';
+ _ ->
+ 'false'
+ end
+ end,
+ Base_interfaces).
+
+describe_interface({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
+
+%%% *** Should we exclude the inherited operations here? Probably not,
+%%% but I'm not sure at all.
+
+%%% OpContents = orber_ifr_container:contents({ObjType,ObjID}, dk_Operation,
+%%% true),
+
+ %% If it is OK to set Exclude_inherited to true (as in the above
+ %% code which is commented out), the following code is faster than
+ %% calling the contents/3 above. Otherwise we have to rethink
+ %% this.
+
+ Object = get_object({ObjType, ObjID}),
+
+%%% Contents = select(Object, contents),
+ %% This is faster:
+ Contents = Object#ir_InterfaceDef.contents,
+
+ ContentsObjects = lists:map(fun(ObjRef) ->
+ get_object(ObjRef)
+ end,
+ Contents),
+ OpContents = lists:filter(fun(Obj) ->
+ select(Obj,def_kind) == dk_Operation
+ end,
+ ContentsObjects),
+
+ Ops = lists:map(fun(Obj) ->
+ orber_ifr_contained:describe(Obj,dk_Operation)
+ end, OpContents),
+
+%%% *** See the comment above on the Exclude_inherited parameter, and
+%%% the circumstances when not to use contents/3.
+
+%%% AttrContents = orber_ifr_container:contents({ObjType,ObjID}, dk_Attribute,
+%%% true),
+
+ AttrContents = lists:filter(fun(Obj) ->
+ select(Obj,def_kind) == dk_Attribute
+ end,
+ ContentsObjects),
+ Attrs = lists:map(fun(Obj) ->
+ orber_ifr_contained:describe(Obj,dk_Attribute)
+ end, AttrContents),
+
+ #fullinterfacedescription{name = Object#ir_InterfaceDef.name,
+ id = Object#ir_InterfaceDef.id,
+ defined_in = Object#ir_InterfaceDef.defined_in,
+ version = Object#ir_InterfaceDef.version,
+ operations = Ops,
+ attributes = Attrs,
+ base_interfaces =
+ Object#ir_InterfaceDef.base_interfaces,
+ type = Object#ir_InterfaceDef.type
+ }.
+
+create_attribute(#orber_light_ifr_ref{} = LRef, _Id, _Name, _Version, _Type, _Mode) ->
+ LRef;
+create_attribute({ObjType, ObjID}, Id, Name, Version, Type, Mode)
+ ?tcheck(ir_InterfaceDef, ObjType) ->
+ New_attribute = #ir_AttributeDef{ir_Internal_ID = unique(),
+ def_kind = dk_Attribute,
+ id = Id,
+ name = Name,
+ version = Version,
+ defined_in = {ObjType, ObjID},
+ absolute_name =
+ make_absolute_name({ObjType,ObjID}, Name),
+ containing_repository =
+ make_containing_repository({ObjType,ObjID}),
+ type = get_field(Type,type),
+ type_def = Type,
+ mode = Mode},
+ orber_ifr_container:add_to_container({ObjType,ObjID}, New_attribute,
+ Id, ir_AttributeDef,
+ #ir_AttributeDef.id),
+ makeref(New_attribute).
+
+create_operation(#orber_light_ifr_ref{} = LRef, _Id, _Name, _Version, _Result,
+ _Mode, _Params, _Exceptions, _Contexts) ->
+ LRef;
+create_operation({ObjType, ObjID}, Id, Name, Version, Result, Mode, Params,
+ Exceptions, Contexts) ?tcheck(ir_InterfaceDef, ObjType) ->
+ New_operation = #ir_OperationDef{ir_Internal_ID = unique(),
+ def_kind = dk_Operation,
+ id = Id,
+ name = Name,
+ version = Version,
+ defined_in = {ObjType, ObjID},
+ absolute_name =
+ make_absolute_name({ObjType,ObjID}, Name),
+ containing_repository =
+ make_containing_repository({ObjType,ObjID}),
+ result = get_field(Result,type),
+ result_def = Result,
+ mode = Mode,
+ params = Params,
+ exceptions = Exceptions,
+ contexts = Contexts},
+ orber_ifr_container:add_to_container({ObjType,ObjID}, New_operation,
+ Id, ir_OperationDef,
+ #ir_OperationDef.id),
+ makeref(New_operation).
diff --git a/lib/orber/src/orber_ifr_irobject.erl b/lib/orber/src/orber_ifr_irobject.erl
new file mode 100644
index 0000000000..56eab57e36
--- /dev/null
+++ b/lib/orber/src/orber_ifr_irobject.erl
@@ -0,0 +1,72 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_irobject.erl
+%% Purpose : Code for IRObject
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_irobject).
+
+-export(['_get_def_kind'/1,
+ destroy/1
+ ]).
+
+-import(orber_ifr_utils,[get_field/2]).
+
+-include("orber_ifr.hrl").
+-include_lib("orber/include/corba.hrl").
+
+%%%======================================================================
+%%% IRObject
+
+'_get_def_kind'({ObjType,ObjID}) ->
+ get_field({ObjType,ObjID},def_kind).
+
+%%% Note, that the destroy function is meant to be called within a
+%%% transaction called in the destroy function of an object which
+%%% inherits from IRObject. An IRObject should only be destroyed by
+%%% destroying the object that inherits from an IRObject. An attempt
+%%% to call this function in user code will result in unpredictable
+%%% results.
+
+%%% Don't type check the object reference. We need to be able to
+%%% handle several types of objects that inherit from IRObject.
+
+destroy(L) when is_list(L) ->
+ destroy2(lists:reverse(L)).
+
+destroy2([Things_HD | Things_TL]) ->
+ destroy2(Things_HD),
+ destroy2(Things_TL);
+
+destroy2([]) ->
+ ok;
+destroy2(F) when is_function(F) ->
+ F();
+destroy2(Thing) when is_tuple(Thing) ->
+ mnesia:delete(Thing),
+ ok;
+destroy2(Thing) ->
+ orber:dbg("[~p] ~p:destroy2(~p);~n"
+ "Strange argument for destroy.~n",
+ [?LINE, ?MODULE, Thing], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
+
diff --git a/lib/orber/src/orber_ifr_moduledef.erl b/lib/orber/src/orber_ifr_moduledef.erl
new file mode 100644
index 0000000000..51229661ed
--- /dev/null
+++ b/lib/orber/src/orber_ifr_moduledef.erl
@@ -0,0 +1,183 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_moduledef.erl
+%% Purpose : Code for Moduledef
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_moduledef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ lookup/2,
+ contents/3,
+ lookup_name/5,
+ describe_contents/4,
+ create_module/4,
+ create_constant/6,
+ create_struct/5,
+ create_union/6,
+ create_enum/5,
+ create_alias/5,
+ create_interface/5,
+ create_exception/5,
+ '_get_id'/1,
+ '_set_id'/2,
+ '_get_name'/1,
+ '_set_name'/2,
+ '_get_version'/1,
+ '_set_version'/2,
+ '_get_defined_in'/1,
+ '_get_absolute_name'/1,
+ '_get_containing_repository'/1,
+ describe/1,
+ move/4
+ ]).
+
+-include("orber_ifr.hrl").
+
+%%%======================================================================
+%%% ModuleDef (Container(IRObject), Contained(IRObject))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType, ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
+ F = fun() -> '_clean'({ObjType, ObjID}) end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+'_clean'(ObjRef) ->
+ ObjList = cleanup_for_destroy(ObjRef),
+ orber_ifr_irobject:destroy([ObjRef | ObjList]).
+
+
+cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_container:cleanup_for_destroy({ObjType,ObjID}) ++
+ orber_ifr_contained:cleanup_for_destroy({ObjType,ObjID}).
+
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from Container
+
+lookup({ObjType, ObjID}, Search_name) ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_container:lookup({ObjType, ObjID}, Search_name).
+
+contents({ObjType, ObjID}, Limit_type, Exclude_inherited)
+ ?tcheck(ir_ModuleDef, ObjType)->
+ orber_ifr_container:contents({ObjType, ObjID},Limit_type,
+ Exclude_inherited).
+
+lookup_name({ObjType, ObjID}, Search_name, Levels_to_search, Limit_type,
+ Exclude_inherited)
+ ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_container:lookup_name({ObjType,ObjID}, Search_name,
+ Levels_to_search, Limit_type,
+ Exclude_inherited).
+
+describe_contents({ObjType, ObjID}, Limit_type, Exclude_inherited,
+ Max_returned_objs)
+ ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_container:describe_contents({ObjType, ObjID}, Limit_type,
+ Exclude_inherited,Max_returned_objs).
+
+create_module({ObjType, ObjID}, Id, Name, Version)
+ ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_container:create_module({ObjType, ObjID}, Id, Name, Version).
+
+create_constant({ObjType, ObjID}, Id, Name, Version, Type, Value)
+ ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_container:create_constant({ObjType, ObjID}, Id, Name, Version,
+ Type, Value).
+
+create_struct({ObjType, ObjID}, Id, Name, Version, Members)
+ ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_container:create_struct({ObjType,ObjID},Id,Name,Version,Members).
+
+create_union({ObjType, ObjID}, Id, Name, Version, Discriminator_type, Members)
+ ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_container:create_union({ObjType, ObjID}, Id, Name, Version,
+ Discriminator_type, Members).
+
+create_enum({ObjType, ObjID}, Id, Name, Version, Members)
+ ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_container:create_enum({ObjType, ObjID},Id,Name,Version,Members).
+
+create_alias({ObjType, ObjID}, Id, Name, Version, Original_type)
+ ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_container:create_alias({ObjType, ObjID}, Id, Name, Version,
+ Original_type).
+
+create_interface({ObjType, ObjID}, Id, Name, Version, Base_interfaces)
+ ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_container:create_interface({ObjType, ObjID}, Id, Name, Version,
+ Base_interfaces).
+
+create_exception({ObjType, ObjID}, Id, Name, Version, Members)
+ ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_container:create_exception({ObjType, ObjID}, Id, Name, Version,
+ Members).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from Contained
+
+'_get_id'({ObjType, ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_contained:'_get_id'({ObjType,ObjID}).
+
+'_set_id'({ObjType,ObjID},EO_Value) ?tcheck(ir_ModuleDef,ObjType) ->
+ orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
+
+'_get_name'({ObjType, ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_contained:'_get_name'({ObjType,ObjID}).
+
+'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
+
+'_get_version'({ObjType, ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_contained:'_get_version'({ObjType,ObjID}).
+
+'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
+
+'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
+
+'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
+
+'_get_containing_repository'({ObjType, ObjID}) ?tcheck(ir_ModuleDef,ObjType) ->
+ orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
+
+describe({ObjType, ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_contained:describe({ObjType,ObjID}).
+
+move({ObjType, ObjID}, New_container, New_name, New_version)
+ ?tcheck(ir_ModuleDef, ObjType) ->
+ orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,
+ New_version).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+%%% none %%
diff --git a/lib/orber/src/orber_ifr_operationdef.erl b/lib/orber/src/orber_ifr_operationdef.erl
new file mode 100644
index 0000000000..1d957e17d9
--- /dev/null
+++ b/lib/orber/src/orber_ifr_operationdef.erl
@@ -0,0 +1,191 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_operationdef.erl
+%% Purpose : Code for Operationdef
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_operationdef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_id'/1,
+ '_set_id'/2,
+ '_get_name'/1,
+ '_set_name'/2,
+ '_get_version'/1,
+ '_set_version'/2,
+ '_get_defined_in'/1,
+ '_get_absolute_name'/1,
+ '_get_containing_repository'/1,
+ describe/1,
+ move/4,
+ '_get_result'/1,
+ '_get_result_def'/1,
+ '_set_result_def'/2,
+ '_get_params'/1,
+ '_set_params'/2,
+ '_get_mode'/1,
+ '_set_mode'/2,
+ '_get_contexts'/1,
+ '_set_contexts'/2,
+ '_get_exceptions'/1,
+ '_set_exceptions'/2
+ ]).
+
+-import(orber_ifr_utils,[get_field/2,
+ set_field/3,
+ get_object/1,
+ set_object/1
+ ]).
+
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+-include_lib("orber/include/ifr_types.hrl").
+-include_lib("orber/include/corba.hrl").
+
+%%%======================================================================
+%%% OperationDef (Contained(IRObject))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
+ F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
+ orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
+ lists:map(fun(X) -> Idl = X#parameterdescription.type_def,
+ orber_ifr_idltype:cleanup_for_destroy(Idl)
+ end,
+ '_get_params'({ObjType,ObjID})) ++
+ orber_ifr_idltype:cleanup_for_destroy('_get_result_def'({ObjType,
+ ObjID})) ++
+ orber_ifr_contained:cleanup_for_destroy({ObjType,ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from Contained
+
+'_get_id'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
+ orber_ifr_contained:'_get_id'({ObjType,ObjID}).
+
+'_set_id'({ObjType, ObjID}, EO_Value) ?tcheck(ir_OperationDef, ObjType) ->
+ orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
+
+'_get_name'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
+ orber_ifr_contained:'_get_name'({ObjType,ObjID}).
+
+'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_OperationDef, ObjType) ->
+ orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
+
+'_get_version'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
+ orber_ifr_contained:'_get_version'({ObjType,ObjID}).
+
+'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_OperationDef, ObjType) ->
+ orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
+
+'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
+ orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
+
+'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
+ orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
+
+'_get_containing_repository'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
+ orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
+
+describe({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
+ orber_ifr_contained:describe({ObjType,ObjID}).
+
+move({ObjType, ObjID}, New_container, New_name, New_version)
+ ?tcheck(ir_OperationDef, ObjType) ->
+ orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,New_version).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+'_get_result'({ObjType, ObjID})
+ ?tcheck(ir_OperationDef, ObjType) ->
+ get_field({ObjType,ObjID},result).
+
+'_get_result_def'({ObjType, ObjID})
+ ?tcheck(ir_OperationDef, ObjType) ->
+ get_field({ObjType,ObjID},result_def).
+
+'_set_result_def'({ObjType, ObjID}, EO_Value)
+ ?tcheck(ir_OperationDef, ObjType) ->
+ OperationDef = get_object({ObjType, ObjID}),
+ New_OperationDef =
+ OperationDef#ir_OperationDef{result = EO_Value#ir_IDLType.type,
+ result_def = EO_Value},
+ set_object(New_OperationDef).
+
+'_get_params'({ObjType,ObjID}) ?tcheck(ir_OperationDef,ObjType) ->
+ get_field({ObjType,ObjID},params).
+
+'_set_params'({ObjType, ObjID}, EO_Value)
+ ?tcheck(ir_OperationDef, ObjType) ->
+ set_field({ObjType,ObjID}, params, EO_Value).
+
+'_get_mode'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
+ get_field({ObjType,ObjID},mode).
+
+'_set_mode'({ObjType, ObjID}, EO_Value) ?tcheck(ir_OperationDef, ObjType) ->
+ OperationDef = get_object({ObjType, ObjID}),
+ Set_OK = case EO_Value of
+ 'OP_ONEWAY' ->
+ (OperationDef#ir_OperationDef.result == tk_void)
+ and
+ lists:foldl(fun(#parameterdescription{mode=Mode},AccIn) ->
+ (Mode == 'PARAM_IN') and AccIn
+ end,
+ true,OperationDef#ir_OperationDef.params);
+ _ ->
+ true
+ end,
+ set_mode(Set_OK,{ObjType,ObjID},EO_Value).
+
+set_mode(true,Objref,EO_Value) ->
+ set_field(Objref,mode,EO_Value);
+set_mode(false, Objref, EO_Value) ->
+ orber:dbg("[~p] ~p:destroy(~p, ~p);~n"
+ "Illegal '_set_mode'.~n",
+ [?LINE, ?MODULE, Objref, EO_Value], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
+
+'_get_contexts'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
+ get_field({ObjType,ObjID},contexts).
+
+'_set_contexts'({ObjType, ObjID}, EO_Value)
+ ?tcheck(ir_OperationDef, ObjType) ->
+ set_field({ObjType,ObjID}, contexts, EO_Value).
+
+'_get_exceptions'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
+ get_field({ObjType,ObjID},exceptions).
+
+'_set_exceptions'({ObjType, ObjID}, EO_Value)
+ ?tcheck(ir_OperationDef, ObjType) ->
+ set_field({ObjType,ObjID}, exceptions, EO_Value).
diff --git a/lib/orber/src/orber_ifr_orb.erl b/lib/orber/src/orber_ifr_orb.erl
new file mode 100644
index 0000000000..f536ae887a
--- /dev/null
+++ b/lib/orber/src/orber_ifr_orb.erl
@@ -0,0 +1,98 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_orb.erl
+%% Purpose : Code for Orb
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_orb).
+
+-export([create_struct_tc/3,
+ create_union_tc/4,
+ create_enum_tc/3,
+ create_alias_tc/3,
+ create_exception_tc/3,
+ create_interface_tc/2,
+ create_string_tc/1,
+ create_wstring_tc/1,
+ create_sequence_tc/2,
+ create_recursive_sequence_tc/2,
+ create_array_tc/2
+ ]).
+
+
+-include("orber_ifr.hrl").
+-include_lib("orber/include/ifr_types.hrl").
+-include_lib("orber/include/corba.hrl").
+
+%%%======================================================================
+%%% ORB
+
+%%%----------------------------------------------------------------------
+%%% Inherited interfaces
+
+%% none %%
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+create_struct_tc(Id, Name, Members) ->
+ {tk_struct,Id,Name,lists:map(fun(#structmember{name=MemName,type=Type}) ->
+ {MemName,Type} end,
+ Members)}.
+
+create_union_tc(Id, Name, Discriminator_type, Members) ->
+ {tk_union, Id, Name, Discriminator_type, -1, % *** is -1 correct???
+ lists:map(fun(#unionmember{name=MemName, label=Label, type=Type}) ->
+ {Label,MemName,Type} end,
+ Members)}.
+
+create_enum_tc(Id, Name, Members) ->
+ {tk_enum, Id, Name, Members}.
+
+create_alias_tc(Id, Name, Original_type) ->
+ {tk_alias, Id, Name, orber_ifr_utils:get_field(Original_type,type)}.
+
+create_exception_tc(Id, Name, Members) ->
+ {tk_except,Id,Name,lists:map(fun(#structmember{name=MemName,type=Type}) ->
+ {MemName,Type} end,
+ Members)}.
+
+create_interface_tc(Id, Name) ->
+ {tk_objref, Id, Name}.
+
+create_string_tc(Bound) ->
+ {tk_string, Bound}.
+
+create_wstring_tc(Bound) ->
+ {tk_wstring, Bound}.
+
+create_sequence_tc(Bound, Element_type) ->
+ {tk_sequence,Element_type,Bound}.
+
+create_recursive_sequence_tc(Bound, Offset) ->
+ orber:dbg("[~p] ~p:create_recursive_sequence_tc(~p, ~p);~n"
+ "Create_recursive_sequence is not implemented.~n",
+ [?LINE, ?MODULE, Bound, Offset], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
+
+create_array_tc(Length, Element_type) ->
+ {tk_array, Element_type, Length}.
diff --git a/lib/orber/src/orber_ifr_primitivedef.erl b/lib/orber/src/orber_ifr_primitivedef.erl
new file mode 100644
index 0000000000..a73fd09fd1
--- /dev/null
+++ b/lib/orber/src/orber_ifr_primitivedef.erl
@@ -0,0 +1,69 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_primitivedef.erl
+%% Purpose : Code for Primitivedef
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_primitivedef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_type'/1,
+ '_get_kind'/1
+ ]).
+
+-import(orber_ifr_utils,[get_field/2
+ ]).
+
+-include("orber_ifr.hrl").
+
+%%%======================================================================
+%%% PrimitiveDef (IDLType(IRObject))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_PrimitiveDef, ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_PrimitiveDef, ObjType) ->
+ F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
+ orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_PrimitiveDef, ObjType) ->
+ orber_ifr_idltype:cleanup_for_destroy({ObjType,ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IDLType
+
+'_get_type'({ObjType, ObjID}) ?tcheck(ir_PrimitiveDef, ObjType) ->
+ orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+'_get_kind'({ObjType, ObjID}) ?tcheck(ir_PrimitiveDef, ObjType) ->
+ get_field({ObjType,ObjID},kind).
+
diff --git a/lib/orber/src/orber_ifr_repository.erl b/lib/orber/src/orber_ifr_repository.erl
new file mode 100644
index 0000000000..dde4d62562
--- /dev/null
+++ b/lib/orber/src/orber_ifr_repository.erl
@@ -0,0 +1,286 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_repository.erl
+%% Purpose : Code for Repository
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_repository).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ lookup/2,
+ contents/3,
+ lookup_name/5,
+ describe_contents/4,
+ create_module/4,
+ create_constant/6,
+ create_struct/5,
+ create_union/6,
+ create_enum/5,
+ create_alias/5,
+ create_interface/5,
+ create_exception/5,
+ lookup_id/2,
+ get_primitive/2,
+ create_string/2,
+ create_wstring/2,
+ create_fixed/3,
+ create_sequence/3,
+ create_array/3,
+ create_idltype/2, %not in CORBA 2.0
+ create_primitivedef/1, %not in CORBA 2.0
+ create_primitivedef/2 %not in CORBA 2.0
+ ]).
+
+
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+-include_lib("orber/include/corba.hrl").
+
+%%%======================================================================
+%%% Repository (Container (IRObject))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_Repository, ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType, ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_Repository, ObjType) ->
+ orber:dbg("[~p] ~p:destroy(~p, ~p);~n"
+ "Destroying a repository is an error.~n",
+ [?LINE, ?MODULE, ObjType, ObjID], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from Container
+
+lookup({ObjType,ObjID}, Search_name) ?tcheck(ir_Repository, ObjType) ->
+ orber_ifr_container:lookup({ObjType, ObjID}, Search_name).
+
+contents({ObjType,ObjID}, Limit_type, Exclude_inherited)
+ ?tcheck(ir_Repository, ObjType) ->
+ orber_ifr_container:contents({ObjType,ObjID},Limit_type,Exclude_inherited).
+
+lookup_name({ObjType,ObjID}, Search_name, Levels_to_search, Limit_type,
+ Exclude_inherited) ?tcheck(ir_Repository, ObjType) ->
+ orber_ifr_container:lookup_name({ObjType, ObjID}, Search_name,
+ Levels_to_search, Limit_type,
+ Exclude_inherited).
+
+describe_contents({ObjType,ObjID}, Limit_type, Exclude_inherited,
+ Max_returned_objs) ?tcheck(ir_Repository, ObjType) ->
+ orber_ifr_container:describe_contents({ObjType, ObjID}, Limit_type,
+ Exclude_inherited,Max_returned_objs).
+
+create_module({ObjType,ObjID}, Id, Name, Version)
+ ?tcheck(ir_Repository, ObjType) ->
+ orber_ifr_container:create_module({ObjType,ObjID}, Id, Name, Version).
+
+create_constant({ObjType,ObjID}, Id, Name, Version, Type, Value)
+ ?tcheck(ir_Repository, ObjType) ->
+ orber_ifr_container:create_constant({ObjType,ObjID}, Id, Name, Version,
+ Type, Value).
+
+create_struct({ObjType,ObjID}, Id, Name, Version, Members)
+ ?tcheck(ir_Repository, ObjType) ->
+ orber_ifr_container:create_struct({ObjType,ObjID}, Id, Name, Version,
+ Members).
+
+create_union({ObjType,ObjID}, Id, Name, Version, Discriminator_type, Members)
+ ?tcheck(ir_Repository, ObjType) ->
+ orber_ifr_container:create_union({ObjType,ObjID}, Id, Name, Version,
+ Discriminator_type, Members).
+
+create_enum({ObjType,ObjID}, Id, Name, Version, Members)
+ ?tcheck(ir_Repository, ObjType) ->
+ orber_ifr_container:create_enum({ObjType,ObjID},Id,Name,Version,Members).
+
+create_alias({ObjType,ObjID}, Id, Name, Version, Original_type)
+ ?tcheck(ir_Repository, ObjType) ->
+ orber_ifr_container:create_alias({ObjType,ObjID}, Id, Name, Version,
+ Original_type).
+
+create_interface({ObjType,ObjID}, Id, Name, Version, Base_interfaces)
+ ?tcheck(ir_Repository, ObjType) ->
+ orber_ifr_container:create_interface({ObjType,ObjID}, Id, Name, Version,
+ Base_interfaces).
+
+create_exception({ObjType, ObjID}, Id, Name, Version, Members)
+ ?tcheck(ir_Repository, ObjType) ->
+ orber_ifr_container:create_exception({ObjType, ObjID}, Id, Name, Version,
+ Members).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+lookup_id({ObjType,ObjID}, Search_id) ?tcheck(ir_Repository, ObjType) ->
+ Contents = orber_ifr_container:contents({ObjType, ObjID}, dk_All, false),
+ case lists:filter(fun(X) -> orber_ifr_contained:'_get_id'(X) == Search_id
+ end, Contents) of
+ [] ->
+ [];
+ [ObjRef] ->
+ ObjRef;
+ [H|T] ->
+ %% This case is just a safety-guard; orber_ifr_container:contents
+ %% sometimes return duplicates due to inheritance.
+ case lists:any(fun(X) -> X =/= H end, T) of
+ false ->
+ H;
+ true ->
+ corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
+ end
+ end.
+
+get_primitive({ObjType,ObjID}, Kind) ?tcheck(ir_Repository, ObjType) ->
+ Primitivedefs = orber_ifr_utils:get_field({ObjType,ObjID}, primitivedefs),
+ lists:filter(fun(X) -> orber_ifr_primitivedef:'_get_kind'(X) == Kind end,
+ Primitivedefs).
+
+%% It is probably incorrect to add the anonymous typedefs (string,
+%% sequence and array) to the field primitivdefs in the Repository.
+%% It is probably also not correct to add them to the contents field.
+%% Perhaps it is necessary to add another field in the ir_Repository
+%% record for anonymous typedefs? Then again, perhaps it is not
+%% necessary to keep the anonymous typedefs anywhere? According to
+%% the specification it is the callers responsibility to destroy the
+%% anonymous typedef if it is not successfully used.
+
+create_string({ObjType,_ObjID}, Bound) ?tcheck(ir_Repository, ObjType) ->
+ New_string = #ir_StringDef{ir_Internal_ID = orber_ifr_utils:unique(),
+ def_kind = dk_String,
+ type = {tk_string, Bound},
+ bound = Bound},
+ orber_ifr_utils:makeref(New_string).
+
+create_wstring({ObjType,_ObjID}, Bound) ?tcheck(ir_Repository, ObjType) ->
+ NewWstring = #ir_WstringDef{ir_Internal_ID = orber_ifr_utils:unique(),
+ def_kind = dk_Wstring,
+ type = {tk_wstring, Bound},
+ bound = Bound},
+ orber_ifr_utils:makeref(NewWstring).
+
+create_fixed({ObjType,_ObjID}, Digits, Scale) ?tcheck(ir_Repository, ObjType) ->
+ NewFixed = #ir_FixedDef{ir_Internal_ID = orber_ifr_utils:unique(),
+ def_kind = dk_Fixed,
+ type = {tk_fixed, Digits, Scale},
+ digits = Digits,
+ scale = Scale},
+ orber_ifr_utils:makeref(NewFixed).
+
+create_sequence({ObjType,_ObjID}, Bound, Element_type)
+ ?tcheck(ir_Repository, ObjType) ->
+ Element_typecode = orber_ifr_utils:get_field(Element_type, type),
+ New_sequence = #ir_SequenceDef{ir_Internal_ID = orber_ifr_utils:unique(),
+ def_kind = dk_Sequence,
+ type = {tk_sequence,Element_typecode,Bound},
+ bound = Bound,
+ element_type = Element_typecode,
+ element_type_def = Element_type},
+ orber_ifr_utils:makeref(New_sequence).
+
+create_array({ObjType,_ObjID}, Length, Element_type)
+ ?tcheck(ir_Repository, ObjType) ->
+ Element_typecode = orber_ifr_utils:get_field(Element_type, type),
+ New_array = #ir_ArrayDef{ir_Internal_ID = orber_ifr_utils:unique(),
+ def_kind = dk_Array,
+ type = {tk_array, Element_typecode, Length},
+ length = Length,
+ element_type = Element_typecode,
+ element_type_def = Element_type},
+ orber_ifr_utils:makeref(New_array).
+
+%%%----------------------------------------------------------------------
+%%% Extra interfaces (not in the IDL-spec for the IFR).
+
+create_idltype(#orber_light_ifr_ref{} = LRef, _Typecode) ->
+ LRef;
+create_idltype({ObjType,_ObjID}, Typecode) ?tcheck(ir_Repository, ObjType) ->
+ New_idltype = #ir_IDLType{ir_Internal_ID = orber_ifr_utils:unique(),
+ def_kind = dk_none,
+ type=Typecode},
+ orber_ifr_utils:set_object(New_idltype),
+ orber_ifr_utils:makeref(New_idltype).
+
+create_primitivedef(Pkind) ->
+ create_primitivedef(Pkind, true).
+create_primitivedef(Pkind, Transaction) ->
+ Typecode = case Pkind of
+ pk_void ->
+ tk_void;
+ pk_short ->
+ tk_short;
+ pk_long ->
+ tk_long;
+ pk_longlong ->
+ tk_longlong;
+ pk_ushort ->
+ tk_ushort;
+ pk_ulong ->
+ tk_ulong;
+ pk_ulonglong ->
+ tk_ulonglong;
+ pk_float ->
+ tk_float;
+ pk_double ->
+ tk_double;
+ pk_boolean ->
+ tk_boolean;
+ pk_char ->
+ tk_char;
+ pk_wchar ->
+ tk_wchar;
+ pk_fixed ->
+ tk_fixed;
+ pk_octet ->
+ tk_octet;
+ pk_any ->
+ tk_any;
+ pk_TypeCode ->
+ tk_TypeCode;
+ pk_Principal ->
+ tk_Principal;
+ pk_string ->
+ orber_ifr_orb:create_string_tc(0);
+ pk_wstring ->
+ orber_ifr_orb:create_wstring_tc(0);
+ pk_objref ->
+ %%*** what should the Id and Name be here?
+ orber_ifr_orb:create_interface_tc("", "");
+ _ ->
+ orber:dbg("[~p] ~p:destroy(~p);~n"
+ "Illegal primitivekin.~n",
+ [?LINE, ?MODULE, Pkind], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO})
+ end,
+ New_primitivedef = #ir_PrimitiveDef{ir_Internal_ID = orber_ifr_utils:unique(),
+ def_kind = dk_Primitive,
+ type = Typecode,
+ kind = Pkind},
+ case Transaction of
+ true ->
+ orber_ifr_utils:set_object(New_primitivedef);
+ false ->
+ mnesia:write(New_primitivedef)
+ end,
+ orber_ifr_utils:makeref(New_primitivedef).
diff --git a/lib/orber/src/orber_ifr_sequencedef.erl b/lib/orber/src/orber_ifr_sequencedef.erl
new file mode 100644
index 0000000000..8a1fee6ac6
--- /dev/null
+++ b/lib/orber/src/orber_ifr_sequencedef.erl
@@ -0,0 +1,103 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_sequencedef.erl
+%% Purpose : Code for Sequencedef
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_sequencedef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_type'/1,
+ '_get_bound'/1,
+ '_set_bound'/2,
+ '_get_element_type'/1,
+ '_get_element_type_def'/1,
+ '_set_element_type_def'/2
+ ]).
+
+-import(orber_ifr_utils,[get_field/2,
+ get_object/1,
+ set_object/1
+ ]).
+
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+
+%%%======================================================================
+%%% SequenceDef (IDLType(IRObject))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType,ObjID}) ?tcheck(ir_SequenceDef,ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_SequenceDef, ObjType) ->
+ F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
+ orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_SequenceDef, ObjType) ->
+ orber_ifr_idltype:cleanup_for_destroy(
+ '_get_element_type_def'({ObjType,ObjID})) ++
+ orber_ifr_idltype:cleanup_for_destroy({ObjType,ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IDLType
+
+'_get_type'({ObjType, ObjID}) ?tcheck(ir_SequenceDef, ObjType) ->
+ orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+'_get_bound'({ObjType, ObjID}) ?tcheck(ir_SequenceDef, ObjType) ->
+ get_field({ObjType,ObjID},bound).
+
+'_set_bound'({ObjType, ObjID}, EO_Value) ?tcheck(ir_SequenceDef, ObjType) ->
+ SequenceDef = get_object({ObjType, ObjID}),
+ New_SequenceDef =
+ SequenceDef#ir_SequenceDef{type = {tk_sequence,
+ SequenceDef#ir_SequenceDef.type,
+ SequenceDef#ir_SequenceDef.bound},
+ bound = EO_Value},
+ set_object(New_SequenceDef).
+
+'_get_element_type'({ObjType, ObjID}) ?tcheck(ir_SequenceDef, ObjType) ->
+ get_field({ObjType,ObjID},element_type).
+
+'_get_element_type_def'({ObjType, ObjID}) ?tcheck(ir_SequenceDef, ObjType) ->
+ get_field({ObjType,ObjID},element_type_def).
+
+'_set_element_type_def'({ObjType, ObjID}, EO_Value)
+ ?tcheck(ir_SequenceDef, ObjType) ->
+ SequenceDef = get_object({ObjType, ObjID}),
+ New_type = {tk_sequence,
+ EO_Value#ir_IDLType.type,
+ SequenceDef#ir_SequenceDef.bound},
+ New_SequenceDef = SequenceDef#ir_SequenceDef{type = New_type,
+ element_type = New_type,
+ element_type_def = EO_Value},
+ set_object(New_SequenceDef).
diff --git a/lib/orber/src/orber_ifr_stringdef.erl b/lib/orber/src/orber_ifr_stringdef.erl
new file mode 100644
index 0000000000..10f3f2116e
--- /dev/null
+++ b/lib/orber/src/orber_ifr_stringdef.erl
@@ -0,0 +1,74 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_stringdef.erl
+%% Purpose : Code for Stringdef
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_stringdef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_type'/1,
+ '_get_bound'/1,
+ '_set_bound'/2
+ ]).
+
+-import(orber_ifr_utils,[get_field/2,
+ set_field/3
+ ]).
+
+-include("orber_ifr.hrl").
+
+%%%======================================================================
+%%% StringDef (IDLType(IRObject))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType,ObjID}) ?tcheck(ir_StringDef, ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_StringDef, ObjType) ->
+ F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
+ orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_StringDef, ObjType) ->
+ orber_ifr_idltype:cleanup_for_destroy({ObjType,ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IDLType
+
+'_get_type'({ObjType, ObjID}) ?tcheck(ir_StringDef, ObjType) ->
+ orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+'_get_bound'({ObjType, ObjID}) ?tcheck(ir_StringDef, ObjType) ->
+ get_field({ObjType,ObjID},bound).
+
+'_set_bound'({ObjType, ObjID}, EO_Value)
+ ?tcheck(ir_StringDef, ObjType) ->
+ set_field({ObjType, ObjID}, bound, EO_Value).
diff --git a/lib/orber/src/orber_ifr_structdef.erl b/lib/orber/src/orber_ifr_structdef.erl
new file mode 100644
index 0000000000..c5139ee5a8
--- /dev/null
+++ b/lib/orber/src/orber_ifr_structdef.erl
@@ -0,0 +1,155 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_structdef.erl
+%% Purpose : Code for Structdef
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_structdef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_id'/1,
+ '_set_id'/2,
+ '_get_name'/1,
+ '_set_name'/2,
+ '_get_version'/1,
+ '_set_version'/2,
+ '_get_defined_in'/1,
+ '_get_absolute_name'/1,
+ '_get_containing_repository'/1,
+ describe/1,
+ move/4,
+ '_get_type'/1,
+ '_get_members'/1,
+ '_set_members'/2
+ ]).
+
+-import(orber_ifr_utils,[get_field/2,get_object/1,set_object/1]).
+-import(lists,[map/2]).
+
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+-include_lib("orber/include/ifr_types.hrl").
+
+%%%======================================================================
+%%% StructDef (TypedefDef(Contained(IRObject), IDLType(IRObject)))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
+ F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
+ orber_ifr_irobject:destroy([{ObjType, ObjID} | ObjList])
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_StructDef, ObjType) ->
+ map(fun(X) -> orber_ifr_idltype:cleanup_for_destroy(
+ X#structmember.type_def)
+ end,
+ '_get_members'({ObjType, ObjID})
+ ) ++
+ orber_ifr_typedef:cleanup_for_destroy({ObjType,ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from Contained
+
+'_get_id'({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
+ orber_ifr_contained:'_get_id'({ObjType,ObjID}).
+
+'_set_id'({ObjType, ObjID},EO_Value) ?tcheck(ir_StructDef,ObjType) ->
+ orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
+
+'_get_name'({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
+ orber_ifr_contained:'_get_name'({ObjType,ObjID}).
+
+'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_StructDef, ObjType) ->
+ orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
+
+'_get_version'({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
+ orber_ifr_contained:'_get_version'({ObjType,ObjID}).
+
+'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_StructDef, ObjType) ->
+ orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
+
+'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
+ orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
+
+'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
+ orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
+
+'_get_containing_repository'({ObjType, ObjID}) ?tcheck(ir_StructDef,ObjType) ->
+ orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
+
+describe({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
+ orber_ifr_contained:describe({ObjType,ObjID}).
+
+move({ObjType, ObjID}, New_container, New_name, New_version)
+ ?tcheck(ir_StructDef, ObjType) ->
+ orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,
+ New_version).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IDLType
+
+'_get_type'({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
+ orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+'_get_members'({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
+ get_field({ObjType,ObjID},members).
+
+'_set_members'({ObjType, ObjID}, EO_Value) ?tcheck(ir_StructDef, ObjType) ->
+ StructDef = get_object({ObjType, ObjID}),
+ Members = map(fun(Structmember) -> Structmember#structmember{type=tk_void}
+ end, EO_Value),
+ New_StructDef =
+ StructDef#ir_StructDef{type =
+ {tk_struct,
+ StructDef#ir_StructDef.id,
+ StructDef#ir_StructDef.name,
+ map(fun(#structmember{name=Name,type=Type}) ->
+ {Name,Type}
+ end,
+ EO_Value)},
+ members=Members},
+ set_object(New_StructDef).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/lib/orber/src/orber_ifr_typecode.erl b/lib/orber/src/orber_ifr_typecode.erl
new file mode 100644
index 0000000000..1fac75b2af
--- /dev/null
+++ b/lib/orber/src/orber_ifr_typecode.erl
@@ -0,0 +1,107 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_typecode.erl
+%% Purpose : Code for Typecode
+%%----------------------------------------------------------------------
+
+%%% NOTE:
+%%% Only make_typcode is for real here. All of the TypeCode interfaces
+%%% specified in the IDL specification needs to be implemented.
+%%%
+
+-module(orber_ifr_typecode).
+
+-export([
+ equal/2,
+ kind/1,
+ id/1,
+ name/1,
+ member_count/1,
+ member_name/2,
+ member_type/2,
+ member_label/2,
+ discriminator_type/1,
+ default_index/1,
+ '_length'/1,
+ content_type/1,
+ param_count/1,
+ parameter/2
+ ]).
+
+-import(orber_ifr_utils,[get_field/2]).
+
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+-include_lib("orber/include/corba.hrl").
+
+
+
+%%%----------------------------------------------------------------------
+%%% Inherited interfaces
+
+%% none %%
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+equal({ObjType, ObjID}, {Tc_ObjType, Tc_ObjID})
+?tcheck(ir_TypeCode, ObjType) ->
+ get_field({ObjType,ObjID},kind) == get_field({Tc_ObjType,Tc_ObjID},kind).
+
+kind({ObjType, ObjID}) ->
+ {ok, {ObjType, ObjID}}.
+
+id({ObjType, ObjID}) ->
+ {ok, {ObjType, ObjID}}.
+
+name({ObjType, ObjID}) ->
+ {ok, {ObjType, ObjID}}.
+
+member_count({ObjType, ObjID}) ->
+ {ok, {ObjType, ObjID}}.
+
+member_name({ObjType, ObjID}, _Index) ->
+ {ok, {ObjType, ObjID}}.
+
+member_type({ObjType, ObjID}, _Index) ->
+ {ok, {ObjType, ObjID}}.
+
+member_label({ObjType, ObjID}, _Index) ->
+ {ok, {ObjType, ObjID}}.
+
+discriminator_type({ObjType, ObjID}) ->
+ {ok, {ObjType, ObjID}}.
+
+default_index({ObjType, ObjID}) ->
+ {ok, {ObjType, ObjID}}.
+
+'_length'({ObjType, ObjID}) ->
+ {ok, {ObjType, ObjID}}.
+
+content_type({ObjType, ObjID}) ->
+ {ok, {ObjType, ObjID}}.
+
+param_count({ObjType, ObjID}) ->
+ {ok, {ObjType, ObjID}}.
+
+parameter({ObjType, ObjID}, _Index) ->
+ {ok, {ObjType, ObjID}}.
diff --git a/lib/orber/src/orber_ifr_typedef.erl b/lib/orber/src/orber_ifr_typedef.erl
new file mode 100644
index 0000000000..1b4bacba77
--- /dev/null
+++ b/lib/orber/src/orber_ifr_typedef.erl
@@ -0,0 +1,124 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_typedef.erl
+%% Purpose : Code for Typedef
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_typedef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_id'/1,
+ '_set_id'/2,
+ '_get_name'/1,
+ '_set_name'/2,
+ '_get_version'/1,
+ '_set_version'/2,
+ '_get_defined_in'/1,
+ '_get_absolute_name'/1,
+ '_get_containing_repository'/1,
+ describe/1,
+ move/4,
+ '_get_type'/1
+ ]).
+
+
+-include("orber_ifr.hrl").
+
+%%%======================================================================
+%%% TypedefDef (Contained(IRObject), IDLType(IRObject))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType, ObjID}) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType, ObjID}).
+
+%%% Note, that the destroy function is meant to be called within a
+%%% transaction called in the destroy function of an object which
+%%% inherits from TypedefDef. A TypedefDef should only be destroyed by
+%%% destroying the object that inherits from a TypedefDef. An attempt
+%%% to call this function in user code will result in unpredictable
+%%% results.
+
+%%% Don't type check the object reference. We need to be able to
+%%% handle several types of objects that inherit from TypedefDef.
+
+destroy(TypedefDef_objref) ->
+ F = fun() -> ObjList = cleanup_for_destroy(TypedefDef_objref),
+ orber_ifr_irobject:destroy([TypedefDef_objref | ObjList])
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy(TypedefDef_objref) ->
+ orber_ifr_contained:cleanup_for_destroy(TypedefDef_objref) ++
+ orber_ifr_idltype:cleanup_for_destroy(TypedefDef_objref).
+
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from Contained
+
+'_get_id'({ObjType, ObjID}) ->
+ orber_ifr_contained:'_get_id'({ObjType,ObjID}).
+
+'_set_id'({ObjType, ObjID}, EO_Value) ->
+ orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
+
+'_get_name'({ObjType, ObjID}) ->
+ orber_ifr_contained:'_get_name'({ObjType,ObjID}).
+
+'_set_name'({ObjType, ObjID}, EO_Value) ->
+ orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
+
+'_get_version'({ObjType, ObjID}) ->
+ orber_ifr_contained:'_get_version'({ObjType,ObjID}).
+
+'_set_version'({ObjType, ObjID}, EO_Value) ->
+ orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
+
+'_get_defined_in'({ObjType,ObjID}) ->
+ orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
+
+'_get_absolute_name'({ObjType, ObjID}) ->
+ orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
+
+'_get_containing_repository'({ObjType,ObjID}) ->
+ orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
+
+describe({ObjType, ObjID}) ->
+ orber_ifr_contained:describe({ObjType,ObjID}).
+
+move({ObjType, ObjID}, New_container, New_name, New_version) ->
+ orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,
+ New_version).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IDLType
+
+'_get_type'({ObjType, ObjID}) ->
+ orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+%%% none %%
diff --git a/lib/orber/src/orber_ifr_uniondef.erl b/lib/orber/src/orber_ifr_uniondef.erl
new file mode 100644
index 0000000000..eafa03c465
--- /dev/null
+++ b/lib/orber/src/orber_ifr_uniondef.erl
@@ -0,0 +1,175 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_uniondef.erl
+%% Purpose : Code for Uniondef
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_uniondef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_id'/1,
+ '_set_id'/2,
+ '_get_name'/1,
+ '_set_name'/2,
+ '_get_version'/1,
+ '_set_version'/2,
+ '_get_defined_in'/1,
+ '_get_absolute_name'/1,
+ '_get_containing_repository'/1,
+ describe/1,
+ move/4,
+ '_get_type'/1,
+ '_get_discriminator_type'/1,
+ '_get_discriminator_type_def'/1,
+ '_set_discriminator_type_def'/2,
+ '_get_members'/1,
+ '_set_members'/2
+ ]).
+
+-import(orber_ifr_utils,[get_field/2,
+ get_object/1,
+ set_object/1
+ ]).
+
+-import(lists,[map/2]).
+
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+-include_lib("orber/include/ifr_types.hrl").
+
+%%%======================================================================
+%%% UnionDef (TypedefDef(Contained(IRObject), IDLType(IRObject)))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType, ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
+ F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
+ orber_ifr_irobject:destroy([{ObjType, ObjID} | ObjList])
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
+ map(fun(X) -> orber_ifr_idltype:cleanup_for_destroy(
+ X#unionmember.type_def)
+ end,
+ '_get_members'({ObjType, ObjID})
+ ) ++
+ orber_ifr_idltype:cleanup_for_destroy(
+ '_get_discriminator_type_def'({ObjType,ObjID})) ++
+ orber_ifr_typedef:cleanup_for_destroy({ObjType,ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from Contained
+
+'_get_id'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
+ orber_ifr_contained:'_get_id'({ObjType,ObjID}).
+
+'_set_id'({ObjType, ObjID}, EO_Value) ?tcheck(ir_UnionDef, ObjType) ->
+ orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
+
+'_get_name'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
+ orber_ifr_contained:'_get_name'({ObjType,ObjID}).
+
+'_set_name'({ObjType,ObjID},EO_Value) ?tcheck(ir_UnionDef,ObjType) ->
+ orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
+
+'_get_version'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
+ orber_ifr_contained:'_get_version'({ObjType,ObjID}).
+
+'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_UnionDef, ObjType) ->
+ orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
+
+'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
+ orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
+
+'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_UnionDef,ObjType) ->
+ orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
+
+'_get_containing_repository'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
+ orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
+
+describe({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
+ orber_ifr_contained:describe({ObjType,ObjID}).
+
+move({ObjType, ObjID}, New_container, New_name, New_version)
+ ?tcheck(ir_UnionDef, ObjType) ->
+ orber_ifr_contained:move({ObjType,ObjID}, New_container, New_name,
+ New_version).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IDLType
+
+'_get_type'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
+ orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+'_get_discriminator_type'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
+ get_field({ObjType,ObjID},discriminator_type).
+
+'_get_discriminator_type_def'({ObjType, ObjID}) ?tcheck(ir_UnionDef,ObjType) ->
+ get_field({ObjType,ObjID},discriminator_type_def).
+
+'_set_discriminator_type_def'({ObjType, ObjID}, EO_Value)
+ ?tcheck(ir_UnionDef, ObjType) ->
+ UnionDef = get_object({ObjType, ObjID}),
+ NewUnionDef = UnionDef#ir_UnionDef{type = EO_Value#ir_IDLType.type,
+ discriminator_type =
+ EO_Value#ir_IDLType.type,
+ discriminator_type_def = EO_Value},
+ set_object(NewUnionDef).
+
+'_get_members'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
+ get_field({ObjType,ObjID},members).
+
+%%% *** What should the value of the discriminator-typecode be when
+%%% updating the type attribute? (CORBA 2.0, p 6-20). For now we just
+%%% leave it unchanged, but this is perhaps not the right thing to do.
+
+-define(discr_tc(TC),element(4,TC)).
+-define(default(TC),element(5,TC)).
+
+'_set_members'({ObjType, ObjID}, EO_Value) ?tcheck(ir_UnionDef, ObjType) ->
+ UnionDef = get_object({ObjType, ObjID}),
+ Members=map(fun(Unionmember) -> Unionmember#unionmember{type=tk_void} end,
+ EO_Value),
+ NewUnionDef = UnionDef#ir_UnionDef{type =
+ {tk_union,
+ UnionDef#ir_UnionDef.id,
+ UnionDef#ir_UnionDef.name,
+ ?discr_tc(UnionDef#ir_UnionDef.type),
+ ?default(UnionDef#ir_UnionDef.type),
+ map(fun(#unionmember{name=Name,
+ label=Label,
+ type=Type}) ->
+ {Label,Name,Type}
+ end,
+ EO_Value)},
+ members = Members},
+ set_object(NewUnionDef).
diff --git a/lib/orber/src/orber_ifr_utils.erl b/lib/orber/src/orber_ifr_utils.erl
new file mode 100644
index 0000000000..11e3d1cd3b
--- /dev/null
+++ b/lib/orber/src/orber_ifr_utils.erl
@@ -0,0 +1,437 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_utils.erl
+%% Purpose : Common function for the Interface Repository
+%%----------------------------------------------------------------------
+
+-module(orber_ifr_utils).
+
+-export([
+ select/2,
+ index/2,
+ construct/3,
+ get_object/1,
+ set_object/1,
+ get_field/2,
+ set_field/3,
+ write_result/1,
+ read_result/1,
+ ifr_transaction_read/1,
+ ifr_transaction_write/1,
+ ifr_transaction_read_write/1,
+ makeref/1,
+ unique/0,
+ existence_check/2,
+ existence_check/3,
+ create_repository/0,
+ init_DB/2, init_DB/3
+ ]).
+
+-include_lib("orber/include/corba.hrl").
+-include("orber_ifr.hrl").
+-include("ifr_objects.hrl").
+
+
+%%======================================================================
+%% Internal stuff
+
+%%----------------------------------------------------------------------
+%% Make a record selection.
+%%
+%% This code *must* be amended whenever a new record is added in the
+%% files ifr_objects.hrl or ../include/ifr_types.hrl
+
+select(Record,Field) when is_record(Record,ir_IRObject) ->
+ select(Record,record_info(fields,ir_IRObject),Field);
+select(Record,Field) when is_record(Record,ir_Contained) ->
+ select(Record,record_info(fields,ir_Contained),Field);
+select(Record,Field) when is_record(Record,ir_Container) ->
+ select(Record,record_info(fields,ir_Container),Field);
+select(Record,Field) when is_record(Record,ir_IDLType) ->
+ select(Record,record_info(fields,ir_IDLType),Field);
+select(Record,Field) when is_record(Record,ir_Repository) ->
+ select(Record,record_info(fields,ir_Repository),Field);
+select(Record,Field) when is_record(Record,ir_ModuleDef) ->
+ select(Record,record_info(fields,ir_ModuleDef),Field);
+select(Record,Field) when is_record(Record,ir_ConstantDef) ->
+ select(Record,record_info(fields,ir_ConstantDef),Field);
+select(Record,Field) when is_record(Record,ir_TypedefDef) ->
+ select(Record,record_info(fields,ir_TypedefDef),Field);
+select(Record,Field) when is_record(Record,ir_StructDef) ->
+ select(Record,record_info(fields,ir_StructDef),Field);
+select(Record,Field) when is_record(Record,ir_UnionDef) ->
+ select(Record,record_info(fields,ir_UnionDef),Field);
+select(Record,Field) when is_record(Record,ir_EnumDef) ->
+ select(Record,record_info(fields,ir_EnumDef),Field);
+select(Record,Field) when is_record(Record,ir_AliasDef) ->
+ select(Record,record_info(fields,ir_AliasDef),Field);
+select(Record,Field) when is_record(Record,ir_PrimitiveDef) ->
+ select(Record,record_info(fields,ir_PrimitiveDef),Field);
+select(Record,Field) when is_record(Record,ir_StringDef) ->
+ select(Record,record_info(fields,ir_StringDef),Field);
+select(Record,Field) when is_record(Record,ir_WstringDef) ->
+ select(Record,record_info(fields,ir_WstringDef),Field);
+select(Record,Field) when is_record(Record,ir_SequenceDef) ->
+ select(Record,record_info(fields,ir_SequenceDef),Field);
+select(Record,Field) when is_record(Record,ir_ArrayDef) ->
+ select(Record,record_info(fields,ir_ArrayDef),Field);
+select(Record,Field) when is_record(Record,ir_ExceptionDef) ->
+ select(Record,record_info(fields,ir_ExceptionDef),Field);
+select(Record,Field) when is_record(Record,ir_AttributeDef) ->
+ select(Record,record_info(fields,ir_AttributeDef),Field);
+select(Record,Field) when is_record(Record,ir_OperationDef) ->
+ select(Record,record_info(fields,ir_OperationDef),Field);
+select(Record,Field) when is_record(Record,ir_InterfaceDef) ->
+ select(Record,record_info(fields,ir_InterfaceDef),Field);
+select(Record,Field) when is_record(Record,ir_FixedDef) ->
+ select(Record,record_info(fields,ir_FixedDef),Field);
+select([],_) -> [];
+select(Record,Field) ->
+ orber:dbg("[~p] orber_ifr_utils:select(~p, ~p);~n"
+ "Unknown Record Type~n", [?LINE, Record,Field], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
+
+-define(ELEMENT_OFFSET, 2).
+
+select(Record,Fields,Field) ->
+ Index = index(Fields,Field),
+ element(?ELEMENT_OFFSET + Index, Record).
+
+index(List,Element) ->
+ index(List,Element,0).
+
+index([H|_T],Element,Index) when H == Element ->
+ Index;
+index([_H|T],Element,Index) ->
+ index(T,Element,Index+1);
+index([],Element,Index) ->
+ orber:dbg("[~p] orber_ifr_utils:index(~p, ~p);~n"
+ "Index error.~n", [?LINE, Element, Index], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
+
+%%%----------------------------------------------------------------------
+%%% Construct a record.
+%%%
+%%% This code *must* be amended whenever a new record is added in the
+%%% files ifr_objects.hrl or ../include/ifr_types.hrl
+
+construct(Record,Field,Value) when is_record(Record,ir_IRObject) ->
+ construct(Record,record_info(fields,ir_IRObject),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_Contained) ->
+ construct(Record,record_info(fields,ir_Contained),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_Container) ->
+ construct(Record,record_info(fields,ir_Container),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_IDLType) ->
+ construct(Record,record_info(fields,ir_IDLType),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_Repository) ->
+ construct(Record,record_info(fields,ir_Repository),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_ModuleDef) ->
+ construct(Record,record_info(fields,ir_ModuleDef),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_ConstantDef) ->
+ construct(Record,record_info(fields,ir_ConstantDef),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_TypedefDef) ->
+ construct(Record,record_info(fields,ir_TypedefDef),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_StructDef) ->
+ construct(Record,record_info(fields,ir_StructDef),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_UnionDef) ->
+ construct(Record,record_info(fields,ir_UnionDef),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_EnumDef) ->
+ construct(Record,record_info(fields,ir_EnumDef),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_AliasDef) ->
+ construct(Record,record_info(fields,ir_AliasDef),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_PrimitiveDef) ->
+ construct(Record,record_info(fields,ir_PrimitiveDef),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_StringDef) ->
+ construct(Record,record_info(fields,ir_StringDef),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_WstringDef) ->
+ construct(Record,record_info(fields,ir_WstringDef),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_SequenceDef) ->
+ construct(Record,record_info(fields,ir_SequenceDef),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_ArrayDef) ->
+ construct(Record,record_info(fields,ir_ArrayDef),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_ExceptionDef) ->
+ construct(Record,record_info(fields,ir_ExceptionDef),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_AttributeDef) ->
+ construct(Record,record_info(fields,ir_AttributeDef),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_OperationDef) ->
+ construct(Record,record_info(fields,ir_OperationDef),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_InterfaceDef) ->
+ construct(Record,record_info(fields,ir_InterfaceDef),Field,Value);
+construct(Record,Field,Value) when is_record(Record,ir_FixedDef) ->
+ construct(Record,record_info(fields,ir_FixedDef),Field,Value);
+construct(Record,Field,Value) ->
+ orber:dbg("[~p] orber_ifr_utils:construct(~p, ~p, ~p);~n"
+ "Unknown Record Type~n",
+ [?LINE, Record,Field,Value], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
+
+construct(Record,Fields,Field,Value) ->
+ Index = index(Fields,Field),
+ setelement(?ELEMENT_OFFSET + Index,Record,Value).
+
+%%%----------------------------------------------------------------------
+%%% Read an object from the database
+
+get_object(Objref) ->
+%%% Use mnesia:dirty_read/1. It is much faster than doing a transaction.
+ case mnesia:dirty_read(Objref) of
+ [Res] ->
+ Res;
+ [] ->
+ [];
+ Other ->
+ orber:dbg("[~p] orber_ifr_utils:get_object(~p);~n",
+ [?LINE, Other], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO})
+ end.
+%%% This is the old code, with a transaction. We might have to revert back
+%%% to this at some future time...
+%% _F = ?read_function(Objref),
+%% read_result(ifr_transaction_read(_F)).
+
+%%%----------------------------------------------------------------------
+%%% Write an object to the database
+
+set_object(Object) ->
+ _F = fun() -> mnesia:write(Object) end,
+ write_result(ifr_transaction_write(_F)).
+
+%%%----------------------------------------------------------------------
+%%% Get the value of a field in a record in the DB
+
+get_field(Objref,FieldName) ->
+ Object = get_object(Objref),
+ select(Object,FieldName).
+
+%%%----------------------------------------------------------------------
+%%% Atomically set the value of a field in a record in the DB
+
+set_field(Objref,FieldName,Value) ->
+ _F = fun() -> Object = get_object(Objref),
+ New_object = construct(Object,FieldName,Value),
+ mnesia:write(New_object)
+ end,
+ write_result(ifr_transaction_write(_F)).
+
+
+%%%----------------------------------------------------------------------
+%%% Check a write transaction
+
+write_result({atomic,ok}) -> ok;
+write_result(Wres) ->
+ orber:dbg("[~p] orber_ifr_utils:write_result(~p);~n",
+ [?LINE, Wres], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
+
+%%%----------------------------------------------------------------------
+%%% Extract the data from a read
+
+read_result({atomic,[Qres]}) -> Qres;
+read_result({atomic,[]}) -> [];
+read_result(Qres) ->
+ orber:dbg("[~p] orber_ifr_utils:read_result(~p);~n",
+ [?LINE, Qres], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
+
+%%%----------------------------------------------------------------------
+%%% Execute a transaction or a dirty read/write.
+%%%
+%%% Since nested transctions will upgrade the inner activity to the
+%%% same kind as the outer, we cannot use the check the result in the
+%%% above simplistic manner. Therefore we will not mix transaction
+%%% with async_dirty (or any of the other transaction-like
+%%% activities). A rather extensive rewrite of the query extraction
+%%% code must be done first.
+
+ifr_transaction_read(Fun) -> % read synchronously
+ Tr = mnesia:transaction(Fun),
+ {atomic, _} = Tr,
+ Tr.
+ifr_transaction_write(Fun) -> % write synchronously
+ Tr = mnesia:transaction(Fun),
+ {atomic, _} = Tr,
+ Tr.
+ifr_transaction_read_write(Fun) -> % write synchronously
+ Tr = mnesia:transaction(Fun),
+ {atomic, _} = Tr,
+ Tr.
+
+%%%----------------------------------------------------------------------
+%%% Make an object reference from an object
+
+makeref(Obj) ->
+ [ObjType, ObjID | _] = tuple_to_list(Obj),
+ {ObjType, ObjID}.
+
+%%%----------------------------------------------------------------------
+%%% Make a unique tag.
+%%%
+%%% The call to term_to_binary is made to hide the representation of the
+%%% unique tag. I do this because the tuple generated takes a lot of space
+%%% when I dump the database. A binary is simply printed as #Bin, which
+%%% is much less obtrusive.
+%%% The code has been moved to a macro defined in orber_ifr.hrl, so we
+%%% can use a simpler uniqification code when debugging.
+
+unique() -> term_to_binary({node(), now()}).
+
+%%%----------------------------------------------------------------------
+%%% Check for an existing object with the Id of the object which is
+%%% about to be created.
+
+existence_check({ObjType, ObjID}, Id) ->
+ Rep = case ObjType of
+ ir_Repository ->
+ {ObjType, ObjID};
+ _ ->
+ orber_ifr_contained:'_get_containing_repository'({ObjType,
+ ObjID})
+ end,
+ case orber_ifr_repository:lookup_id(Rep, Id) of
+ [] ->
+ ok;
+ What ->
+ orber:dbg("[~p] orber_ifr_utils:existence_check(~p, ~p, ~p);~n"
+ "Name clash(?): ~p",
+ [?LINE, ObjType, ObjID, Id, What], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO})
+ end.
+
+existence_check(Id, Tab, FieldNum) ->
+ case mnesia:dirty_index_read(Tab, Id, FieldNum) of
+ [] ->
+ ok;
+ What ->
+ orber:dbg("[~p] orber_ifr_utils:existence_check(~p, ~p, ~p);~n"
+ "Name clash(?): ~p",
+ [?LINE, Id, Tab, FieldNum, What], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO})
+ end.
+
+%%======================================================================
+%% Database initialization
+
+init_DB(Timeout, Options) ->
+ init_DB(Timeout, Options, false).
+
+init_DB(Timeout, Options, LightIFR) ->
+ Func = case Options of
+ {localCopy, IFR_storage_type} when LightIFR == true ->
+ ?ifr_light_record_tuple_list_local(IFR_storage_type);
+ {localCopy, IFR_storage_type} ->
+ ?ifr_record_tuple_list_local(IFR_storage_type);
+ _ when LightIFR == true ->
+ ?ifr_light_record_tuple_list(Options);
+ _ ->
+ ?ifr_record_tuple_list(Options)
+ end,
+ create_tables(Func),
+ Wait = wait_for_tables(LightIFR, Timeout),
+ db_error_check([Wait],"Database table waiting failed.").
+
+wait_for_tables(true, Timeout) ->
+ mnesia:wait_for_tables(?ifr_light_object_list, Timeout);
+wait_for_tables(_, Timeout) ->
+ mnesia:wait_for_tables(?ifr_object_list, Timeout).
+
+db_error_check(Checkval,_Message) ->
+ case lists:any(fun(X) -> X/= ok end, Checkval) of
+ true ->
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO});
+ false ->
+ ok
+ end.
+
+create_tables([{T,F}|Rest]) ->
+ case F() of
+ ok ->
+ create_tables2(Rest);
+ {aborted,{already_exists,_}} ->
+ exit({error, "Orber Mnesia Table(s) already exist. Cannot install Orber."});
+ Reason ->
+ orber:dbg("[~p] orber_ifr_utils:create_tables(~p);~n"
+ "Failed to create the Mnesia table.~n"
+ "Reason: ~p", [?LINE, T, Reason], ?DEBUG_LEVEL),
+ exit({error, "Unable to create Mnesia Table"})
+ end.
+
+create_tables2([]) ->
+ ok;
+create_tables2([{T,F}|Rest]) ->
+ case F() of
+ ok ->
+ create_tables2(Rest);
+ Reason ->
+ orber:dbg("[~p] orber_ifr_utils:create_tables2(~p);~n"
+ "Failed to create the Mnesia table.~n"
+ "Reason: ~p", [?LINE, T, Reason], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO})
+ end.
+
+
+%%%----------------------------------------------------------------------
+%%% Create an interface repository. This function should only be called
+%%% once, after the database has been set up and initialized.
+
+create_repository() ->
+ case orber:light_ifr() of
+ true ->
+ #orber_light_ifr_ref{data = #lightdata{scope = "",
+ id = ""}};
+ false ->
+ _R = fun() ->
+ Pat = mnesia:table_info(ir_Repository, wild_pattern),
+ case [X#ir_Repository.ir_Internal_ID ||
+ X <- mnesia:match_object(Pat)] of
+ [] ->
+ PrimitiveDefs = create_primitivedefs(),
+ New = #ir_Repository{ir_Internal_ID = unique(),
+ def_kind = dk_Repository,
+ contents = [],
+ primitivedefs = PrimitiveDefs},
+ mnesia:write(New),
+ {ir_Repository,New#ir_Repository.ir_Internal_ID};
+ [Rep_ID] ->
+ {ir_Repository,Rep_ID};
+ Error ->
+ mnesia:abort(Error)
+ end
+ end,
+ case mnesia:transaction(_R) of
+ {atomic, RepRef} ->
+ RepRef;
+ {aborted, Error} ->
+ orber:dbg("[~p] orber_ifr_utils:create_repository() failed;~n"
+ "Reason: ~p", [?LINE, Error], ?DEBUG_LEVEL),
+ corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO})
+ end
+ end.
+
+create_primitivedefs() ->
+ lists:map(fun(Pk) ->
+ orber_ifr_repository:create_primitivedef(Pk, false)
+ end,
+ [pk_void,pk_short,pk_long,pk_longlong,pk_ulonglong,pk_ushort,pk_ulong,
+ pk_float,pk_double,pk_boolean,pk_char,pk_wchar,pk_octet,pk_any,
+ pk_TypeCode,pk_Principal,pk_string,pk_wstring,pk_objref]).
+
+
diff --git a/lib/orber/src/orber_ifr_wstringdef.erl b/lib/orber/src/orber_ifr_wstringdef.erl
new file mode 100644
index 0000000000..da80c0c27d
--- /dev/null
+++ b/lib/orber/src/orber_ifr_wstringdef.erl
@@ -0,0 +1,72 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_ifr_wstringdef.erl
+%% Description :
+%%
+%%----------------------------------------------------------------------
+-module(orber_ifr_wstringdef).
+
+-export(['_get_def_kind'/1,
+ destroy/1,
+ cleanup_for_destroy/1, %not in CORBA 2.0
+ '_get_type'/1,
+ '_get_bound'/1,
+ '_set_bound'/2]).
+
+-import(orber_ifr_utils, [get_field/2,
+ set_field/3]).
+
+-include("orber_ifr.hrl").
+
+%%%======================================================================
+%%% WstringDef (IDLType(IRObject))
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IRObject
+
+'_get_def_kind'({ObjType,ObjID}) ?tcheck(ir_WstringDef, ObjType) ->
+ orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
+
+destroy({ObjType, ObjID}) ?tcheck(ir_WstringDef, ObjType) ->
+ F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
+ orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
+ end,
+ orber_ifr_utils:ifr_transaction_write(F).
+
+cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_WstringDef, ObjType) ->
+ orber_ifr_idltype:cleanup_for_destroy({ObjType,ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Interfaces inherited from IDLType
+
+'_get_type'({ObjType, ObjID}) ?tcheck(ir_WstringDef, ObjType) ->
+ orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
+
+%%%----------------------------------------------------------------------
+%%% Non-inherited interfaces
+
+'_get_bound'({ObjType, ObjID}) ?tcheck(ir_WstringDef, ObjType) ->
+ get_field({ObjType,ObjID},bound).
+
+'_set_bound'({ObjType, ObjID}, EO_Value)
+ ?tcheck(ir_WstringDef, ObjType) ->
+ set_field({ObjType, ObjID}, bound, EO_Value).
diff --git a/lib/orber/src/orber_iiop.erl b/lib/orber/src/orber_iiop.erl
new file mode 100644
index 0000000000..0e11f7d244
--- /dev/null
+++ b/lib/orber/src/orber_iiop.erl
@@ -0,0 +1,550 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_iiop.erl
+%% Description:
+%% This file contains the interface to the iiop operations
+%%
+%%-----------------------------------------------------------------
+-module(orber_iiop).
+
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/src/orber_iiop.hrl").
+
+-behaviour(supervisor).
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start_sup/1, request/8, locate/4]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([init/1, terminate/2, handle_call/3]).
+
+%%-----------------------------------------------------------------
+%% Internal defines
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 7).
+
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: start_sup/1
+%%-----------------------------------------------------------------
+start_sup(Opts) ->
+ supervisor:start_link({local, orber_iiop_sup}, ?MODULE,
+ {orber_iiop_sup, Opts}).
+
+%%%-----------------------------------------------------------------
+%%% Func: connect/1
+%%%-----------------------------------------------------------------
+%connect(OrbName) ->
+% orber_iiop_net:connect(OrbName).
+
+%%%-----------------------------------------------------------------
+%%% Func: request/5
+%%%-----------------------------------------------------------------
+request({Host, Port, InitObjkey, Index, TaggedProfile, HostData},
+ Op, Parameters, TypeCodes, ResponseExpected, Timeout, IOR, UserCtx) ->
+ {{Proxy, SysCtx, Interceptors, LocalInterface}, ObjKey, Version} =
+ connect(Host, Port, InitObjkey, Timeout, [Index], HostData,
+ TaggedProfile, IOR, UserCtx),
+ Ctx = add_user_context(SysCtx, UserCtx),
+ RequestId = orber_request_number:get(),
+ Env = #giop_env{interceptors = Interceptors, type = out,
+ flags = orber_env:get_flags(), host = LocalInterface,
+ version = Version, ctx = Ctx, request_id = RequestId, op = Op,
+ parameters = Parameters, tc = TypeCodes, objkey = ObjKey,
+ response_expected = ResponseExpected},
+ Message = encode_request(Env),
+ case catch orber_iiop_outproxy:request(Proxy, ResponseExpected, Timeout,
+ Message, RequestId) of
+ {'EXCEPTION', MsgExc} ->
+ corba:raise(MsgExc);
+ _ when ResponseExpected == false ->
+ ok;
+ {reply, ReplyHeader, Rest, Len, ByteOrder, Bytes} ->
+ case catch decode_reply_body(Interceptors, ObjKey, Op, ReplyHeader,
+ Version, TypeCodes, Rest, Len, ByteOrder,
+ Bytes) of
+ {'EXCEPTION', DecodeException} ->
+ %% We cannot log this exception since it may be a correct exception.
+ corba:raise(DecodeException);
+ {'EXIT', message_error} ->
+ orber:dbg("[~p] orber_iiop:request(reply, ~p, ~p, ~p)~n"
+ "Got exit(message_error)",
+ [?LINE, Rest, Version, TypeCodes], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ {'EXIT', Why} ->
+ orber:dbg("[~p] orber_iiop:request(reply, ~p, ~p, ~p)~n"
+ "Got exit(~p)",
+ [?LINE, Rest, Version, TypeCodes, Why], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ 'message_error' ->
+ orber:dbg("[~p] orber_iiop:request(reply, ~p, ~p, ~p);~n"
+ "Got message_error",
+ [?LINE, Rest, Version, TypeCodes], ?DEBUG_LEVEL),
+ %% Perhaps a resend should be done when a message error occurs
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ {Result, Par} ->
+ %% Check request id
+ case ReplyHeader#reply_header.reply_status of
+ 'no_exception' ->
+ case Par of
+ [] ->
+ Result;
+ _ ->
+ list_to_tuple([Result | Par])
+ end;
+ 'system_exception' ->
+ corba:raise(Result);
+ 'user_exception' ->
+ corba:raise(Result);
+ 'location_forward' ->
+ case get(orber_forward_notify) of
+ true ->
+ {location_forward, Result};
+ _ ->
+ case catch corba:call(Result, Op, Parameters,
+ TypeCodes,
+ [{timeout, Timeout},
+ {context, UserCtx}]) of
+ {'EXCEPTION', E} ->
+ corba:raise(E);
+ {'EXIT', Reason} ->
+ orber:dbg("[~p] orber_iiop:request(reply, ~p, ~p, ~p)~n"
+ "location_forward resulted in exit(~p)",
+ [?LINE, Rest, Version, TypeCodes, Reason], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO});
+ NewResult ->
+ NewResult
+ end
+ end;
+ 'location_forward_perm' ->
+ %% We should notify the client in this case.
+ case get(orber_forward_notify) of
+ true ->
+ {location_forward, Result};
+ _ ->
+ case catch corba:call(Result, Op, Parameters,
+ TypeCodes,
+ [{timeout, Timeout},
+ {context, UserCtx}]) of
+ {'EXCEPTION', E} ->
+ corba:raise(E);
+ {'EXIT', Reason} ->
+ orber:dbg("[~p] orber_iiop:request(reply, ~p, ~p, ~p)~n"
+ "location_forward_perm resulted in exit(~p)",
+ [?LINE, Rest, Version, TypeCodes, Reason], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO});
+ NewResult ->
+ NewResult
+ end
+ end;
+ 'needs_addressing_mode' ->
+ orber:dbg("[~p] orber_iiop:request(reply, ~p, ~p, ~p)~n"
+ "needs_addressing_mode not supported.",
+ [?LINE, Rest, Version, TypeCodes], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
+ end
+ end;
+ What ->
+ orber:dbg("[~p] orber_iiop:request(reply, ~p, ~p, ~p)~n"
+ "outproxy-request: ~p", [?LINE, Message, Version, TypeCodes, What], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
+ end.
+
+
+encode_request(#giop_env{interceptors = false} = Env) ->
+ case catch cdr_encode:enc_request(Env) of
+ {'EXCEPTION', Exc} ->
+ orber:dbg("[~p] orber_iiop:request(~p)~n"
+ "Got exception(~p)",
+ [?LINE, Env, Exc], ?DEBUG_LEVEL),
+ corba:raise(Exc);
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_iiop:request:( ~p )~n"
+ "Got exit(~p)",
+ [?LINE, Env, R], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
+ Msg ->
+ Msg
+ end;
+encode_request(#giop_env{interceptors = {native, Ref, PIs},
+ objkey = ObjKey, ctx = Ctx, op = Op,
+ parameters = Params} = Env) ->
+ Parameters = orber_pi:out_request(PIs, ObjKey, Ctx, Op, Ref, Params),
+ case catch cdr_encode:enc_request_split(Env) of
+ {'EXCEPTION', Exc} ->
+ orber:dbg("[~p] orber_iiop:request( ~p, ~p); exception(~p)",
+ [?LINE, Env, Parameters, Exc], ?DEBUG_LEVEL),
+ corba:raise(Exc);
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_iiop:request:( ~p, ~p); got exit(~p)",
+ [?LINE, Env, Parameters, R], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
+ {Hdr, Body, HdrLen, _, Flags} ->
+ NewBody = orber_pi:out_request_enc(PIs, ObjKey, Ctx, Op, Ref, Body),
+ cdr_encode:enc_giop_message_header(Env, 'request', Flags,
+ HdrLen+size(NewBody),
+ [Hdr|NewBody])
+ end;
+encode_request(Env) ->
+ case catch cdr_encode:enc_request(Env) of
+ {'EXCEPTION', Exc} ->
+ orber:dbg("[~p] orber_iiop:request( ~p ); exception(~p)",
+ [?LINE, Env, Exc], ?DEBUG_LEVEL),
+ corba:raise(Exc);
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_iiop:request:( ~p ); got exit(~p)",
+ [?LINE, Env, R], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
+ Msg ->
+ Msg
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: locate/1
+%%-----------------------------------------------------------------
+locate({Host, Port, InitObjkey, Index, TaggedProfile, HostData},
+ Timeout, IOR, UserCtx) ->
+ {{Proxy, _Ctx, _Interceptors, LocalInterface}, ObjKey, Version} =
+ connect(Host, Port, InitObjkey, Timeout, [Index], HostData,
+ TaggedProfile, IOR, UserCtx),
+ RequestId = orber_request_number:get(),
+ Env = #giop_env{version = Version, objkey = ObjKey, request_id = RequestId,
+ flags = orber_env:get_flags(), host = LocalInterface},
+ Result =
+ case catch cdr_encode:enc_locate_request(Env) of
+ {'EXCEPTION', EncE} ->
+ orber:dbg("[~p] orber_iiop:locate(~p); exception(~p)",
+ [?LINE, ObjKey, EncE], ?DEBUG_LEVEL),
+ corba:raise(EncE);
+ {'EXIT', EncR} ->
+ orber:dbg("[~p] orber_iiop:locate(~p); exit(~p)",
+ [?LINE, ObjKey, EncR], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
+ Request ->
+ (catch orber_iiop_outproxy:request(Proxy, true, Timeout,
+ Request, RequestId))
+ end,
+ case Result of
+ {'EXCEPTION', MsgExc} ->
+ corba:raise(MsgExc);
+ {locate_reply, ReplyHeader, Rest, Len, ByteOrder} ->
+ case catch cdr_decode:dec_locate_reply_body(Version,
+ ReplyHeader#locate_reply_header.locate_status,
+ Rest, Len, ByteOrder) of
+ {'EXCEPTION', DecodeException} ->
+ orber:dbg("[~p] orber_iiop:locate(locate_reply, ~p, ~p); exception(~p)",
+ [?LINE, Rest, Version, DecodeException], ?DEBUG_LEVEL),
+ corba:raise(DecodeException);
+ {'EXIT', message_error} ->
+ orber:dbg("[~p] orber_iiop:locate(locate_reply, ~p, ~p); exit(message_error)",
+ [?LINE, Rest, Version], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_iiop:locate(locate_reply, ~p, ~p); exit(~p)",
+ [?LINE, Rest, Version, R], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ [] ->
+ ReplyHeader#locate_reply_header.locate_status;
+ ObjRef ->
+ {ReplyHeader#locate_reply_header.locate_status, ObjRef}
+ end;
+ Other ->
+ orber:dbg("[~p] orber_iiop:locate(~p); exit(~p)",
+ [?LINE, ObjKey, Other], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO})
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Func: cancel/1
+%%%-----------------------------------------------------------------
+%cancel(X) ->
+% ok.
+
+%%%-----------------------------------------------------------------
+%%% Func: message_error/1
+%%%-----------------------------------------------------------------
+%message_error(X) ->
+% ok.
+
+%%-----------------------------------------------------------------
+%% Server functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: init/1
+%%-----------------------------------------------------------------
+init({orber_iiop_sup, Opts}) ->
+ IIOP_port = orber:iiop_port(),
+ SSL_port = orber:iiop_ssl_port(),
+ SupFlags = {one_for_one, 5, 1000}, %Max 5 restarts in 1 second
+ PortList = if
+ SSL_port > -1 ->
+ [{port, ssl, SSL_port}];
+ true ->
+ []
+ end,
+ ChildSpec =
+ case orber:is_lightweight() of
+ true ->
+ [
+ {orber_iiop_outsup, {orber_iiop_outsup, start,
+ [sup, Opts]},
+ permanent, 10000, supervisor, [orber_iiop_outsup]},
+ {orber_iiop_pm, {orber_iiop_pm, start,
+ [Opts]},
+ permanent, 10000, worker, [orber_iiop_pm]}
+ ];
+ false ->
+ [{orber_iiop_outsup, {orber_iiop_outsup, start,
+ [sup, Opts]},
+ permanent, 10000, supervisor, [orber_iiop_outsup]},
+ {orber_iiop_pm, {orber_iiop_pm, start,
+ [Opts]},
+ permanent, 10000, worker, [orber_iiop_pm]},
+ {orber_iiop_insup, {orber_iiop_insup, start,
+ [sup, Opts]},
+ permanent, 10000, supervisor, [orber_iiop_insup]},
+ {orber_iiop_socketsup, {orber_iiop_socketsup, start,
+ [sup, Opts]},
+ permanent, 10000, supervisor, [orber_iiop_socketsup]},
+ {orber_iiop_net, {orber_iiop_net, start,
+ [[{port, normal, IIOP_port} | PortList]]},
+ permanent, 10000, worker, [orber_iiop_net]}]
+ end,
+ {ok, {SupFlags, ChildSpec}}.
+
+
+
+
+
+%%-----------------------------------------------------------------
+%% Func: terminate/2
+%%-----------------------------------------------------------------
+terminate(_Reason, _State) ->
+ ok.
+
+%%-----------------------------------------------------------------
+%% Func: handle_call/3
+%%-----------------------------------------------------------------
+handle_call(_Req, _From, State) ->
+ {reply, ok, State}.
+
+
+%%-----------------------------------------------------------------
+%% Internal functions
+%%-----------------------------------------------------------------
+add_user_context([], UserCtx) -> UserCtx;
+add_user_context(SysCtx, []) -> SysCtx;
+add_user_context(SysCtx, UserCtx) -> SysCtx ++ UserCtx.
+
+decode_reply_body(false, _ObjKey, _Op, ReplyHeader, Version, TypeCodes,
+ Rest, Len, ByteOrder, Bytes) ->
+ case ReplyHeader#reply_header.reply_status of
+ 'no_exception' ->
+ {R, P, _} = cdr_decode:dec_reply_body(Version, TypeCodes, Rest, Len, ByteOrder, Bytes),
+ {R, P};
+ 'system_exception' ->
+ {R, _} = cdr_decode:dec_system_exception(Version, Rest, Len, ByteOrder),
+ {R, []};
+ 'user_exception' ->
+ {R, _} = cdr_decode:dec_user_exception(Version, Rest, Len, ByteOrder),
+ {R, []};
+ 'location_forward' ->
+ {R, _, _} = cdr_decode:dec_reply_body(Version, {{'tk_objref', "", ""}, [],[]},
+ Rest, Len, ByteOrder, Bytes),
+ {R, []};
+ 'location_forward_perm' ->
+ {R, _, _} = cdr_decode:dec_reply_body(Version, {{'tk_objref', "", ""}, [],[]},
+ Rest, Len, ByteOrder, Bytes),
+ {R, []};
+ 'needs_addressing_mode' ->
+ {R, _, _} = cdr_decode:dec_reply_body(Version, {'tk_short', [],[]},
+ Rest, Len, ByteOrder, Bytes),
+ {R, []}
+ end;
+decode_reply_body(Interceptors, ObjKey, Op, ReplyHeader, Version, TypeCodes,
+ RestIn, Len, ByteOrder, Bytes) ->
+ Rest =
+ case Interceptors of
+ {portable, _PIs} ->
+ RestIn;
+ {native, Ref, PIs} ->
+ orber_pi:in_reply_enc(PIs, ObjKey,
+ ReplyHeader#reply_header.service_context,
+ Op, Ref, RestIn)
+ end,
+ Reply =
+ case ReplyHeader#reply_header.reply_status of
+ 'no_exception' ->
+ {R, P, _} = cdr_decode:dec_reply_body(Version, TypeCodes, Rest, Len, ByteOrder, Bytes),
+ {R, P};
+ 'system_exception' ->
+ {R, _} = cdr_decode:dec_system_exception(Version, Rest, Len, ByteOrder),
+ {R, []};
+ 'user_exception' ->
+ {R, _} = cdr_decode:dec_user_exception(Version, Rest, Len, ByteOrder),
+ {R, []};
+ 'location_forward' ->
+ {R, _, _} = cdr_decode:dec_reply_body(Version, {{'tk_objref', "", ""}, [],[]},
+ Rest, Len, ByteOrder, Bytes),
+ {R, []};
+ 'location_forward_perm' ->
+ {R, _, _} = cdr_decode:dec_reply_body(Version, {{'tk_objref', "", ""}, [],[]},
+ Rest, Len, ByteOrder, Bytes),
+ {R, []};
+ 'needs_addressing_mode' ->
+ {R, _, _} = cdr_decode:dec_reply_body(Version, {'tk_short', [],[]},
+ Rest, Len, ByteOrder, Bytes),
+ {R, []}
+ end,
+ case Interceptors of
+ {portable, _PI} ->
+ Reply;
+ {native, Refs, PI} ->
+ orber_pi:in_reply(PI, ObjKey,
+ ReplyHeader#reply_header.service_context,
+ Op, Refs, Reply)
+ end.
+
+%% "Plain" TCP/IP.
+connect(Host, Port, Objkey, Timeout, Index,
+ #host_data{protocol = normal, csiv2_mech = undefined} = HostData,
+ TaggedProfile, IOR, Ctx) ->
+ connect2([{Host, Port}], Objkey, Timeout, Index, HostData,
+ TaggedProfile, IOR, Ctx);
+%% "Plain" SSL
+connect(Host, _, Objkey, Timeout, Index,
+ #host_data{protocol = ssl,
+ ssl_data = #'SSLIOP_SSL'{port = Port},
+ csiv2_mech = undefined} = HostData,
+ TaggedProfile, IOR, Ctx) ->
+ connect2([{Host, Port}], Objkey, Timeout, Index, HostData,
+ TaggedProfile, IOR, Ctx);
+%% TEMPORARY FIX TO AVOID RUNNING CSIv2.
+connect(Host, _, Objkey, Timeout, Index,
+ #host_data{protocol = ssl,
+ ssl_data = #'SSLIOP_SSL'{port = Port}} = HostData,
+ TaggedProfile, IOR, Ctx) ->
+ connect2([{Host, Port}], Objkey, Timeout, Index, HostData,
+ TaggedProfile, IOR, Ctx);
+%% CSIv2 over SSL (TAG_TLS_SEC_TRANS) using the SAS protocol. Note port must equal 0.
+connect(_Host, 0, Objkey, Timeout, Index,
+ #host_data{protocol = ssl,
+ csiv2_mech =
+ #'CSIIOP_CompoundSecMech'{target_requires = _TR} = _Mech,
+ csiv2_addresses = Addresses} = HostData,
+ TaggedProfile, IOR, Ctx) ->
+ NewCtx = [#'IOP_ServiceContext'
+ {context_id=?IOP_SecurityAttributeService,
+ context_data = #'CSI_SASContextBody'
+ {label = ?CSI_MsgType_MTEstablishContext,
+ value = #'CSI_EstablishContext'
+ {client_context_id = 0, %% Always 0 when stateless.
+ authorization_token =
+ [#'CSI_AuthorizationElement'{the_element = []}],
+ identity_token =
+ #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTAbsent,
+ value = true},
+ client_authentication_token = []}}}|Ctx],
+ connect2(Addresses, Objkey, Timeout, Index, HostData,
+ TaggedProfile, IOR, NewCtx);
+%% CSIv2 over SSL (TAG_NULL_TAG) using the SAS protocol.
+connect(Host, _, Objkey, Timeout, Index,
+ #host_data{protocol = ssl,
+ ssl_data = #'SSLIOP_SSL'{port = Port},
+ csiv2_mech = Mech} = HostData,
+ TaggedProfile, IOR, Ctx) when is_record(Mech, 'CSIIOP_CompoundSecMech') ->
+ connect2([{Host, Port}], Objkey, Timeout, Index, HostData,
+ TaggedProfile, IOR, Ctx);
+%% CSIv2 over TCP (TAG_NULL_TAG) using the SAS protocol.
+connect(Host, Port, Objkey, Timeout, Index,
+ #host_data{protocol = normal,
+ csiv2_mech = Mech} = HostData,
+ TaggedProfile, IOR, Ctx) when is_record(Mech, 'CSIIOP_CompoundSecMech') ->
+ connect2([{Host, Port}], Objkey, Timeout, Index, HostData,
+ TaggedProfile, IOR, Ctx);
+connect(_Host, _Port, _Objkey, _Timeout, _Index, HostData, _TaggedProfile,
+ IOR, _Ctx) ->
+ orber:dbg("[~p] orber_iiop:connect(~p)~n"
+ "Unable to use the supplied IOR.~n"
+ "Connection Data: ~p", [?LINE, IOR, HostData], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
+
+
+
+connect2(HostPort, Objkey, Timeout, Index, HostData, TaggedProfile, IOR, Ctx) ->
+ case try_connect(HostPort, HostData#host_data.protocol, Timeout, HostData, Ctx) of
+ error ->
+ Alts = iop_ior:get_alt_addr(TaggedProfile),
+ case try_connect(Alts, HostData#host_data.protocol, Timeout, HostData, Ctx) of
+ error ->
+ case iop_ior:get_key(IOR, Index) of
+ undefined ->
+ corba:raise(#'COMM_FAILURE'{completion_status = ?COMPLETED_NO});
+ {'external', {NewHost, NewPort, NewObjkey, NewIndex,
+ NewTaggedProfile, NewHostData}} ->
+ connect(NewHost, NewPort, NewObjkey, Timeout, [NewIndex|Index],
+ NewHostData, NewTaggedProfile, IOR, Ctx);
+ _What ->
+ orber:dbg("[~p] orber_iiop:connect2(~p)~n"
+ "Illegal IOR; contains a mixture of local and external profiles.",
+ [?LINE, IOR], ?DEBUG_LEVEL),
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
+ end;
+ X ->
+ {X, Objkey, HostData#host_data.version}
+ end;
+ X ->
+ {X, Objkey, HostData#host_data.version}
+ end.
+
+try_connect([], _, _, _, _) ->
+ error;
+try_connect([{Host, Port}|T], SocketType, Timeout, HostData, Ctx) ->
+ case catch orber_iiop_pm:connect(Host, Port, SocketType, Timeout,
+ HostData#host_data.charset,
+ HostData#host_data.wcharset, Ctx) of
+ {ok, P, Ctx2, Int, Interface} ->
+ {P, Ctx2, Int, Interface};
+ {'EXCEPTION', #'BAD_CONTEXT'{} = CtxExc} ->
+ orber:dbg("[~p] orber_iiop:try_connect(~p, ~p) failed~n",
+ [?LINE, Host, Port], ?DEBUG_LEVEL),
+ corba:raise(CtxExc);
+ {'EXCEPTION', _PMExc} ->
+ try_connect(T, SocketType, Timeout, HostData, Ctx);
+ {'EXIT',{timeout,_}} ->
+ orber:dbg("[~p] orber_iiop:try_connect(~p, ~p, ~p)~n"
+ "Connect attempt timed out",
+ [?LINE, Host, Port, Timeout], ?DEBUG_LEVEL),
+ try_connect(T, SocketType, Timeout, HostData, Ctx);
+ {'EXIT', What} ->
+ orber:dbg("[~p] orber_iiop:try_connect(~p, ~p, ~p)~n"
+ "Connect attempt resulted in: ~p",
+ [?LINE, Host, Port, Timeout, What], ?DEBUG_LEVEL),
+ try_connect(T, SocketType, Timeout, HostData, Ctx)
+ end.
+
diff --git a/lib/orber/src/orber_iiop.hrl b/lib/orber/src/orber_iiop.hrl
new file mode 100644
index 0000000000..7a30af63e4
--- /dev/null
+++ b/lib/orber/src/orber_iiop.hrl
@@ -0,0 +1,1015 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File: orber_iiop.hrl
+%%
+%%----------------------------------------------------------------------
+-ifndef(orber_iiop_hrl).
+-define(orber_iiop_hrl, true).
+
+-include_lib("orber/include/corba.hrl").
+
+%% The identifiers which indicates if a fixed value has a negative or
+%% positive scale.
+-define(FIXED_NEGATIVE, 13).
+-define(FIXED_POSITIVE, 12).
+
+%% Used instead of IFR-id's in TypeCode definitions for internal data types.
+-define(SYSTEM_TYPE, 0).
+
+%% Major version of GIOP protocol which are supported
+-define(GIOP_MAJOR, 1).
+
+%% Minor version of GIOP protocol which are supported
+-define(GIOP_MINOR, 0).
+
+%% Major version of IIOP protocol which are supported
+-define(IIOP_MAJOR, 1).
+
+%% Minor version of IIOP protocol which are supported
+-define(IIOP_MINOR, 0).
+
+%% Fragment flags for the flags bitfield in GIOP message headers
+-define(GIOP_BYTE_ORDER_MSB, 0).
+-define(GIOP_BYTE_ORDER_LSB, 1).
+
+%% Fragment flags for the flags bitfield in GIOP message headers
+-define(GIOP_MORE_FRAGMENTS_FALSE, 0).
+-define(GIOP_MORE_FRAGMENTS_TRUE, 1).
+
+%% GIOP Message Types
+-define(GIOP_MSG_REQUEST, 0).
+-define(GIOP_MSG_REPLY, 1).
+-define(GIOP_MSG_CANCEL_REQUEST, 2).
+-define(GIOP_MSG_LOCATE_REQUEST, 3).
+-define(GIOP_MSG_LOCATE_REPLY, 4).
+-define(GIOP_MSG_CLOSE_CONNECTION, 5).
+-define(GIOP_MSG_MESSAGE_ERROR, 6).
+-define(GIOP_MSG_FRAGMENT, 7).
+
+%% PROFILE_ID's
+-define(TAG_INTERNET_IOP, 0).
+-define(TAG_MULTIPLE_COMPONENTS, 1).
+-define(TAG_SCCP_IOP, 2).
+
+
+%% COMPONENT_ID's
+-define(TAG_ORB_TYPE, 0).
+-define(TAG_CODE_SETS, 1).
+-define(TAG_POLICIES, 2).
+-define(TAG_ALTERNATE_IIOP_ADDRESS, 3).
+-define(TAG_COMPLETE_OBJECT_KEY, 5).
+-define(TAG_ENDPOINT_ID_POSITION, 6).
+-define(TAG_LOCATION_POLICY, 12).
+-define(TAG_ASSOCIATION_OPTIONS, 13).
+-define(TAG_SEC_NAME, 14).
+-define(TAG_SPKM_1_SEC_MECH, 15).
+-define(TAG_SPKM_2_SEC_MECH, 16).
+-define(TAG_KerberosV5_SEC_MECH, 17).
+-define(TAG_CSI_ECMA_Secret_SEC_MECH, 18).
+-define(TAG_CSI_ECMA_Hybrid_SEC_MECH, 19).
+-define(TAG_SSL_SEC_TRANS, 20).
+-define(TAG_CSI_ECMA_Public_SEC_MECH, 21).
+-define(TAG_GENERIC_SEC_MECH, 22).
+-define(TAG_FIREWALL_TRANS, 23).
+-define(TAG_SCCP_CONTACT_INFO, 24).
+-define(TAG_JAVA_CODEBASE, 25).
+-define(TAG_TRANSACTION_POLICY, 26).
+-define(TAG_FT_GROUP, 27).
+-define(TAG_FT_PRIMARY, 28).
+-define(TAG_FT_HEARTBEAT_ENABLED, 29).
+-define(TAG_MESSAGE_ROUTERS, 30).
+-define(TAG_OTS_POLICY, 31).
+-define(TAG_INV_POLICY, 32).
+-define(TAG_CSI_SEC_MECH_LIST, 33).
+-define(TAG_NULL_TAG, 34).
+-define(TAG_SECIOP_SEC_TRANS, 35).
+-define(TAG_TLS_SEC_TRANS, 36).
+-define(TAG_DCE_STRING_BINDING, 100).
+-define(TAG_DCE_BINDING_NAME, 101).
+-define(TAG_DCE_NO_PIPES, 102).
+-define(TAG_DCE_SEC_MECH, 103).
+-define(TAG_INET_SEC_TRANS, 123).
+
+%% COMPONENT_ID strings
+-define(TAG_ORB_TYPE_STR, "TAG_ORB_TYPE").
+-define(TAG_CODE_SETS_STR, "TAG_CODE_SETS").
+-define(TAG_POLICIES_STR, "TAG_POLICIES").
+-define(TAG_ALTERNATE_IIOP_ADDRESS_STR, "TAG_ALTERNATE_IIOP_ADDRESS").
+-define(TAG_COMPLETE_OBJECT_KEY_STR, "TAG_COMPLETE_OBJECT_KEY").
+-define(TAG_ENDPOINT_ID_POSITION_STR, "TAG_ENDPOINT_ID_POSITION").
+-define(TAG_LOCATION_POLICY_STR, "TAG_LOCATION_POLICY").
+-define(TAG_ASSOCIATION_OPTIONS_STR, "TAG_ASSOCIATION_OPTIONS").
+-define(TAG_SEC_NAME_STR, "TAG_SEC_NAME").
+-define(TAG_SPKM_1_SEC_MECH_STR, "TAG_SPKM_1_SEC_MECH").
+-define(TAG_SPKM_2_SEC_MECH_STR, "TAG_SPKM_2_SEC_MECH").
+-define(TAG_KerberosV5_SEC_MECH_STR, "TAG_KerberosV5_SEC_MECH").
+-define(TAG_CSI_ECMA_Secret_SEC_MECH_STR, "TAG_CSI_ECMA_Secret_SEC_MECH").
+-define(TAG_CSI_ECMA_Hybrid_SEC_MECH_STR, "TAG_CSI_ECMA_Hybrid_SEC_MECH").
+-define(TAG_SSL_SEC_TRANS_STR, "TAG_SSL_SEC_TRANS").
+-define(TAG_CSI_ECMA_Public_SEC_MECH_STR, "(TAG_CSI_ECMA_Public_SEC_MECH").
+-define(TAG_GENERIC_SEC_MECH_STR, "TAG_GENERIC_SEC_MECH").
+-define(TAG_FIREWALL_TRANS_STR, "TAG_FIREWALL_TRANS").
+-define(TAG_SCCP_CONTACT_INFO_STR, "TAG_SCCP_CONTACT_INFO").
+-define(TAG_JAVA_CODEBASE_STR, "TAG_JAVA_CODEBASE").
+-define(TAG_TRANSACTION_POLICY_STR, "TAG_TRANSACTION_POLICY").
+-define(TAG_FT_GROUP_STR, "TAG_FT_GROUP").
+-define(TAG_FT_PRIMARY_STR, "TAG_FT_PRIMARY").
+-define(TAG_FT_HEARTBEAT_ENABLED_STR, "TAG_FT_HEARTBEAT_ENABLED").
+-define(TAG_MESSAGE_ROUTERS_STR, "TAG_MESSAGE_ROUTERS").
+-define(TAG_OTS_POLICY_STR, "TAG_OTS_POLICY").
+-define(TAG_INV_POLICY_STR, "TAG_INV_POLICY").
+-define(TAG_CSI_SEC_MECH_LIST_STR, "TAG_CSI_SEC_MECH_LIST").
+-define(TAG_NULL_TAG_STR, "TAG_NULL_TAG").
+-define(TAG_SECIOP_SEC_TRANS_STR, "TAG_SECIOP_SEC_TRANS").
+-define(TAG_TLS_SEC_TRANS_STR, "TAG_TLS_SEC_TRANS").
+-define(TAG_DCE_STRING_BINDING_STR, "TAG_DCE_STRING_BINDING").
+-define(TAG_DCE_BINDING_NAME_STR, "TAG_DCE_BINDING_NAME").
+-define(TAG_DCE_NO_PIPES_STR, "TAG_DCE_NO_PIPES").
+-define(TAG_DCE_SEC_MECH_STR, "TAG_DCE_SEC_MECH").
+-define(TAG_INET_SEC_TRANS_STR, "TAG_INET_SEC_TRANS").
+
+%% GIOP header size
+-define(GIOP_HEADER_SIZE, 12).
+
+%% CODESET's we support.
+%% Latin-1. This CodeSet is default if no information exists in the IOR.
+-define(ISO8859_1_ID, 16#00010001).
+
+%% UTF-16, UCS Transformation Format 16-bit form
+-define(UTF_16_ID, 16#00010109).
+
+%% X/Open UTF-8; UCS Transformation Format 8 (UTF-8)
+-define(UTF_8_ID, 16#05010001).
+
+%% The limited UTF-16 without the surrogate mechanism is called UCS-2.
+%% The two-byte subset which is identical with the original Unicode.
+%% UCS-2, Level 1. Used by JDK-1.3 as native wchar.
+-define(UCS_2_ID, 16#00010100).
+
+%% ISO 646:1991 IRV (International Reference Version).
+%% Used by JavaIDL as Native Char (JDK-1.3). A.k.a PCS.
+-define(ISO646_IRV_ID, 16#00010020).
+
+%% Fallback is *not* the same thing as default!!
+-define(FALLBACK_CHAR, 16#05010001).
+-define(FALLBACK_WCHAR, 16#00010109).
+
+%% This is used when the wchar codeset is unknown.
+-define(UNSUPPORTED_WCHAR, 0).
+
+%% Integer limits
+-define(SHORTMIN, -32768).
+-define(SHORTMAX, 32767).
+-define(USHORTMIN, 0).
+-define(USHORTMAX, 65535).
+-define(LONGMIN, -2147483648).
+-define(LONGMAX, 2147483647).
+-define(ULONGMIN, 0).
+-define(ULONGMAX, 4294967295).
+-define(LONGLONGMIN, -9223372036854775808).
+-define(LONGLONGMAX, 9223372036854775807).
+-define(ULONGLONGMIN, 0).
+-define(ULONGLONGMAX, 18446744073709551615).
+
+
+-define(ORBER_GENERIC_CTX, {'tk_sequence', 'tk_octet', 0}).
+
+
+%%----------------------------------------------------------------------
+%% GIOP Message Header
+%%
+%% magic: identifies the GIOP message headers, array of four characters.
+%% giop_version: contains the version number of the giop protocol being
+%% used in the message.
+%% byte_order: indicating the byte order being used in subsequent
+%% elements of the message.
+%% 0 - big-endian byte ordering, 1 - little-endian byte ordering
+%% fragments: true if more fragments follow, otherwise false.
+%% message_type: indicating the type of the message
+%% message_size: gives the length of the message following the message
+%% headerin octets.
+%%----------------------------------------------------------------------
+-record(giop_message, {magic,
+ giop_version,
+ byte_order,
+ fragments = false,
+ message_type,
+ message_size,
+ message}).
+
+
+
+%%----------------------------------------------------------------------
+%% Request Message Header
+%%
+%% service_context: contains ORB service data being passed from client to server.
+%% (IOP::ServiceContextList)
+%% request_id: id used to assosciate reply messages with request messages.
+%% response_expected: true if the request is expected to have a reply message.
+%% object_key: identifies the object wich is the target of the invocation.
+%% operation: contains the name of the operation being invoked.
+%% requesting_principal: contains a value that identifying the requesting
+%% principal.
+%%----------------------------------------------------------------------
+-record(request_header, {service_context, request_id, response_expected, object_key, operation, requesting_principal}).
+
+
+
+%%----------------------------------------------------------------------
+%% Reply Message Header
+%%
+%% service_context: contains ORB service data being passed from client to server.
+%% (IOP::ServiceContextList)
+%% request_id: id used to assosciate reply messages with request messages.
+%% reply_status: indicates the completion status of the request
+%%----------------------------------------------------------------------
+-record(reply_header, {service_context, request_id, reply_status}).
+
+
+
+%%----------------------------------------------------------------------
+%% Cancel Request Message Header
+%%
+%% request_id: id used to assosciate reply messages with request messages.
+%%----------------------------------------------------------------------
+-record(cancel_request_header, {request_id}).
+
+
+
+%%----------------------------------------------------------------------
+%% Locate Request Message Header
+%%
+%% request_id: id used to assosciate reply messages with request messages.
+%% object_key: identifies the object being located (octet sequence).
+%%----------------------------------------------------------------------
+-record(locate_request_header, {request_id, object_key}).
+
+
+
+%%----------------------------------------------------------------------
+%% Locate Reply Message Header
+%%
+%% request_id: id used to assosciate reply messages with request messages.
+%% locate_status: indicates the completion status of the locate request
+%%----------------------------------------------------------------------
+-record(locate_reply_header, {request_id, locate_status}).
+
+
+
+%%----------------------------------------------------------------------
+%% Profile Body
+%%
+%% iiop_version: describes the version of IIOP that the agent at the
+%% specified adress is prepared to receive.
+%% host: identifies the internet host to which the GIOP messages
+%% for the specified object may be sent.
+%% port: contains the TCP?IP port number where the target agnet is listening
+%% for connection requests.
+%% object_key: is an opaque value supplied by the agent producing the IOR.
+%%----------------------------------------------------------------------
+-record(profile_body, {iiop_version,host,port,object_key}).
+
+%%----------------------------------------------------------------------
+%% Version
+%%
+%% major: major version number of iiop protocol
+%% minor: minor version number of iiop protocol.
+%%
+%% When an agnet generates profiles specifying a particular version,
+%% it must be able to accept messages complying with the specified
+%% version or any porevious minor version.
+%%----------------------------------------------------------------------
+-record(version, {major,minor}).
+
+%%----------------------------------------------------------------------
+%% Fragment Message Header
+%%
+%% request_id:
+%%----------------------------------------------------------------------
+-record(fragment_header, {request_id}).
+
+
+%%----------------------------------------------------------------------
+%% ORB_FLAGS macros. Used in the local object references {_,_,_,_,_,Flags}.
+%%
+%%----------------------------------------------------------------------
+
+%% Definition of flag positions:
+-define(ORB_SEC_ATTRIBUTES, 16#01).
+-define(ORB_CONTEXT, 16#02).
+-define(ORB_TYPECHECK, 16#04).
+-define(ORB_NO_SECURITY, 16#08).
+-define(ORB_SURVIVE_EXIT, 16#10).
+-define(ORB_USE_PI, 16#20).
+
+-define(ORB_INIT_FLAGS, 16#00).
+
+%%----------------------------------------------------------------------
+%% Flags used as configuration parameters (application env).
+%%
+%%----------------------------------------------------------------------
+-define(ORB_ENV_EXCLUDE_CODESET_COMPONENT, 16#01). %% FIXED!!
+-define(ORB_ENV_LOCAL_TYPECHECKING, 16#02). %% FIXED!!
+-define(ORB_ENV_HOSTNAME_IN_IOR, 16#04). %% FIXED!!
+-define(ORB_ENV_ENABLE_NAT, 16#08). %% FIXED!!
+-define(ORB_ENV_PARTIAL_SECURITY, 16#10). %% FIXED FOR NOW!! INTERNAL
+-define(ORB_ENV_USE_PI, 16#20). %% FIXED!!
+-define(ORB_ENV_USE_FT, 16#40). %% WILL PROBABLY BE FIXED!!
+-define(ORB_ENV_LIGHT_IFR, 16#80). %% FIXED!!
+-define(ORB_ENV_USE_IPV6, 16#100). %% FIXED!!
+-define(ORB_ENV_SURVIVE_EXIT, 16#200). %% FIXED!!
+-define(ORB_ENV_USE_ACL_INCOMING, 16#400). %% FIXED!!
+-define(ORB_ENV_USE_ACL_OUTGOING, 16#800). %% FIXED!!
+-define(ORB_ENV_LOCAL_INTERFACE, 16#1000). %% FIXED!!
+
+-define(ORB_ENV_USE_BI_DIR_IIOP, 16#2000). %% CAN BE CHANGED
+-define(ORB_ENV_USE_CSIV2, 16#4000). %% CAN BE CHANGED
+-define(ORB_ENV_EXCLUDE_CODESET_CTX, 16#8000). %% CAN BE CHANGED
+
+
+-define(ORB_ENV_INIT_FLAGS, 16#00).
+
+-define(ORB_ENV_FLAGS,
+ [{?ORB_ENV_EXCLUDE_CODESET_CTX, "Exclude CodeSet Ctx"},
+ {?ORB_ENV_LOCAL_TYPECHECKING, "Local Typechecking"},
+ {?ORB_ENV_HOSTNAME_IN_IOR, "Use Hostname in IOR"},
+ {?ORB_ENV_EXCLUDE_CODESET_COMPONENT, "Exclude CodeSet Component"},
+ {?ORB_ENV_ENABLE_NAT, "NAT Enabled"},
+ {?ORB_ENV_USE_CSIV2, "CSIv2 Activated"},
+ {?ORB_ENV_USE_FT, "Fault Tolerance Activated"},
+ {?ORB_ENV_USE_IPV6, "IPv6 Activated"},
+ {?ORB_ENV_SURVIVE_EXIT, "EXIT Tolerance Activated"},
+ {?ORB_ENV_USE_PI, "Local Interceptors"},
+ {?ORB_ENV_LIGHT_IFR, "Light IFR"},
+ {?ORB_ENV_USE_BI_DIR_IIOP, "Use BiDirIIOP"},
+ {?ORB_ENV_USE_ACL_INCOMING, "Use ACL for Incoming Connections"},
+ {?ORB_ENV_USE_ACL_OUTGOING, "Use ACL for Outgoing Connections"},
+ {?ORB_ENV_LOCAL_INTERFACE, "Use the Proxy Interface in Exported IOR:s"}]).
+
+
+%%----------------------------------------------------------------------
+%% Definition of flag operations
+%%
+%%----------------------------------------------------------------------
+%% USAGE: Boolean = ?ORB_FLAG_TEST(Flags, ?ORB_SEC_ATTRIBUTES)
+-define(ORB_FLAG_TEST(_F1, _I1), ((_F1 band _I1) == _I1)).
+
+%% USAGE: NewFlags = ?ORB_SET_TRUE(Flags, ?ORB_CONTEXT)
+-define(ORB_SET_TRUE(_F2, _I2), (_I2 bor _F2)).
+
+%% USAGE: NewFlags = ?ORB_SET_FALSE(Flags, ?ORB_CONTEXT)
+-define(ORB_SET_FALSE(_F3, _I3), ((_I3 bxor 16#ff) band _F3)).
+
+%% USAGE: NewFlags = ?ORB_SET_FALSE_LIST(Flags, [?ORB_SEC_ATTRIBUTES, ?ORB_SOME])
+-define(ORB_SET_FALSE_LIST(_F4, _IList1),
+ lists:foldl(fun(_I4, _F5) ->
+ ((_I4 bxor 16#ff) band _F5)
+ end,
+ _F4, _IList1)).
+
+%% USAGE: NewFlags = ?ORB_SET_TRUE_LIST(Flags, [?ORB_SEC_ATTRIBUTES, ?ORB_SOME])
+-define(ORB_SET_TRUE_LIST(_F6, _IList2),
+ lists:foldl(fun(_I6, _F7) ->
+ (_I6 bor _F7)
+ end,
+ _F6, _IList2)).
+
+%% USAGE: Boolean = ?ORB_FLAG_TEST_LIST(Flags, [?ORB_CONTEXT, ?ORB_THING])
+-define(ORB_FLAG_TEST_LIST(_F8, _IList3),
+ lists:all(fun(_I7) ->
+ ((_F8 band _I7) == _I7)
+ end,
+ _IList3)).
+
+%%----------------------------------------------------------------------
+%% IOR
+%%
+%%----------------------------------------------------------------------
+-record('IOP_IOR', {type_id, profiles}).
+-record('IOP_TaggedProfile', {tag, profile_data}).
+-record('IIOP_ProfileBody_1_0', {iiop_version,
+ host,
+ port,
+ object_key}).
+-record('IIOP_ProfileBody_1_1', {iiop_version,
+ host,
+ port,
+ object_key,
+ components}).
+
+-record('GIOP_Version', {major, minor}).
+
+-record('IIOP_Version', {major, minor}).
+
+-record('SSLIOP_SSL', {target_supports, target_requires, port}).
+
+-record('IOP_TaggedComponent', {tag, component_data}).
+
+-record('GIOP_TargetAddress', {label, value}).
+
+-record('GIOP_IORAddressingInfo', {selected_profile_index, ior}).
+
+
+%%
+%% Nil object reference
+%%
+-define(ORBER_NIL_OBJREF, #'IOP_IOR' {type_id = "", profiles = []}).
+
+-define(IOR_TYPEDEF, {'tk_struct', ?SYSTEM_TYPE, 'IOP_IOR',
+ [{"type_id", {'tk_string', 0}},
+ {"profiles", {'tk_sequence', {'tk_struct', ?SYSTEM_TYPE,
+ 'IOP_TaggedProfile',
+ [{"tag", 'tk_ulong'},
+ {"profile_data",
+ {'tk_sequence', 'tk_octet', 0}}]}, 0}}]}).
+
+-define(GIOP_VERSION, {'tk_struct', ?SYSTEM_TYPE, 'GIOP_Version',
+ [{"major", 'tk_octet'},
+ {"minor", 'tk_octet'}]}).
+
+-define(IIOP_VERSION, {'tk_struct', ?SYSTEM_TYPE, 'IIOP_Version',
+ [{"major vsn", 'tk_octet'},
+ {"minor vsn", 'tk_octet'}]}).
+-define(IOP_TAGGEDCOMPONENT, {'tk_struct', ?SYSTEM_TYPE,
+ 'IOP_TaggedComponent',
+ [{"tag", 'tk_ulong'},
+ {"component_data",
+ {'tk_sequence',
+ 'tk_octet', 0}}]}).
+-define(IOP_TAGGEDCOMPONENT_SEQ, {'tk_sequence', ?IOP_TAGGEDCOMPONENT, 0}).
+
+-define(PROFILEBODY_1_0_TYPEDEF, {'tk_struct', ?SYSTEM_TYPE, 'IIOP_ProfileBody_1_0',
+ [{"iiop_version", ?IIOP_VERSION },
+ {"host", {'tk_string', 0}},
+ {"port", 'tk_ushort'},
+ {"object_key", {'tk_sequence', 'tk_octet', 0}}]}).
+
+-define(PROFILEBODY_1_1_TYPEDEF, {'tk_struct', ?SYSTEM_TYPE, 'IIOP_ProfileBody_1_1',
+ [{"iiop_version",?IIOP_VERSION },
+ {"host", {'tk_string', 0}},
+ {"port", 'tk_ushort'},
+ {"object_key", {'tk_sequence', 'tk_octet', 0}}
+ {"components", ?IOP_TAGGEDCOMPONENT_SEQ}]}).
+
+-define(PROFILEBODY_1_2_TYPEDEF, {'tk_struct', ?SYSTEM_TYPE, 'IIOP_ProfileBody_1_1',
+ [{"iiop_version",?IIOP_VERSION },
+ {"host", {'tk_string', 0}},
+ {"port", 'tk_ushort'},
+ {"object_key", {'tk_sequence', 'tk_octet', 0}}
+ {"components", ?IOP_TAGGEDCOMPONENT_SEQ}]}).
+
+-define(SSLIOP_SSL, {'tk_struct', ?SYSTEM_TYPE, 'SSLIOP_SSL',
+ [{"target_supports", 'tk_ushort'},
+ {"target_requires", 'tk_ushort'},
+ {"port", 'tk_ushort'}]}).
+
+-define(GIOP_KeyAddr, 0).
+-define(GIOP_ProfileAddr, 1).
+-define(GIOP_ReferenceAddr, 2).
+
+-define(TARGETADDRESS, {'tk_union', ?SYSTEM_TYPE, 'GIOP_TargetAddress', 'tk_short', -1,
+ [{?GIOP_KeyAddr, "object_key", {'tk_sequence', 'tk_octet', 0}},
+ {?GIOP_ProfileAddr, "profile", {'tk_struct', ?SYSTEM_TYPE,
+ 'IOP_TaggedProfile',
+ [{"tag", 'tk_ulong'},
+ {"profile_data",
+ {'tk_sequence', 'tk_octet', 0}}]}},
+ {?GIOP_ReferenceAddr, "ior", {'tk_struct', ?SYSTEM_TYPE,
+ 'GIOP_IORAddressingInfo',
+ [{"selected_profile_index", 'tk_ulong'},
+ {"ior", ?IOR_TYPEDEF}]}}]}).
+
+% Zero or more instances of the TAG_ALTERNATE_IIOP_ADDRESS component type
+% may be included in a version 1.2 TAG_INTERNET_IOP Profile.
+-record('ALTERNATE_IIOP_ADDRESS', {'HostID', 'Port'}).
+-define(ALTERNATE_IIOP_ADDRESS, {'tk_struct', ?SYSTEM_TYPE,
+ 'ALTERNATE_IIOP_ADDRESS',
+ [{"HostID", {'tk_string', 0}},
+ {"Port", 'tk_ushort'}]}).
+% The TAG_ORB_TYPE component can appear at most once in any IOR profile. For
+% profiles supporting IIOP 1.1 or greater, it is optionally present.
+-define(ORB_TYPE, 'tk_ulong').
+
+-record('CONV_FRAME_CodeSetComponent', {native_code_set, conversion_code_sets}).
+-record('CONV_FRAME_CodeSetComponentInfo', {'ForCharData', 'ForWcharData'}).
+-define(CONV_FRAME_CODESETCOMPONENT, {'tk_struct', ?SYSTEM_TYPE,
+ 'CONV_FRAME_CodeSetComponent',
+ [{"native_code_set", 'tk_ulong'},
+ {"conversion_code_sets",
+ {'tk_sequence', 'tk_ulong', 0}}]}).
+-define(CONV_FRAME_CODESETCOMPONENTINFO, {'tk_struct', ?SYSTEM_TYPE,
+ 'CONV_FRAME_CodeSetComponentInfo',
+ [{"ForCharData",
+ ?CONV_FRAME_CODESETCOMPONENT},
+ {"ForWcharData",
+ ?CONV_FRAME_CODESETCOMPONENT}]}).
+
+
+
+
+-define(DEFAULT_FOR_CHAR, #'CONV_FRAME_CodeSetComponent'{native_code_set=?ISO8859_1_ID,
+ conversion_code_sets=[]}).
+-define(DEFAULT_FOR_WCHAR, #'CONV_FRAME_CodeSetComponent'{native_code_set=?UTF_16_ID,
+ conversion_code_sets=[]}).
+-define(DEFAULT_CODESETS,
+ #'CONV_FRAME_CodeSetComponentInfo'{'ForCharData' = ?DEFAULT_FOR_CHAR,
+ 'ForWcharData' = ?DEFAULT_FOR_WCHAR}).
+
+%% Fragmentation - IIOP-1.1 & 1.2
+-record('GIOP_FragmentHeader_1_2', {request_id}).
+
+-define(GIOP_FragmentHeader_1_2, {'tk_struct', ?SYSTEM_TYPE,
+ 'GIOP_FragmentHeader_1_2',
+ [{"request_id", 'tk_ulong'}]}).
+
+%%------ MISC Definitions -------
+%% TimeBase::TimeT (TimeBase.idl) is defined as
+%% typedef unsigned long long TimeT;
+-define(TimeBase_TimeT, 'tk_ulonglong').
+
+%%------ Fault Tolerant Definitions -------
+
+%% Specification for Interoperable Object Group References
+-define(FT_FTDomainId, {'tk_string', 0}).
+-define(FT_ObjectGroupId, 'tk_ulonglong').
+-define(FT_ObjectGroupRefVersion, 'tk_ulong').
+%% A GIOP::Version of 1.0 indicates that the implementation is compliant
+%% with the CORBA-2.6 specification.
+%% tag = TAG_FT_GROUP
+-record('FT_TagFTGroupTaggedComponent', {version = #'GIOP_Version'{major = 1,
+ minor = 0},
+ ft_domain_id, object_group_id,
+ object_group_ref_version}).
+-define(FT_TagFTGroupTaggedComponent, {'tk_struct', ?SYSTEM_TYPE, 'FT_TagFTGroupTaggedComponent',
+ [{"version", ?GIOP_VERSION},
+ {"ft_domain_id", ?FT_FTDomainId},
+ {"object_group_id", ?FT_ObjectGroupId},
+ {"object_group_ref_version", ?FT_ObjectGroupRefVersion}]}).
+
+%% tag = TAG_FT_PRIMARY;
+-record('FT_TagFTPrimaryTaggedComponent', {primary}).
+-define(FT_TagFTPrimaryTaggedComponent, {'tk_struct', ?SYSTEM_TYPE, 'FT_TagFTPrimaryTaggedComponent',
+ [{"primary", 'tk_boolean'}]}).
+
+
+%% Specification for Most Recent Object Group Reference
+%% context_id = FT_GROUP_VERSION;
+-record('FT_FTGroupVersionServiceContext', {object_group_ref_version}).
+-define(FT_FTGroupVersionServiceContext, {'tk_struct', ?SYSTEM_TYPE, 'FT_FTGroupVersionServiceContext',
+ [{"object_group_ref_version", ?FT_ObjectGroupRefVersion}]}).
+
+%% Specification for Transparent Reinvocation
+-define(FT_PolicyType_REQUEST_DURATION_POLICY, 47).
+
+%% context_id = FT_REQUEST
+-record('FT_FTRequestServiceContext', {client_id, retention_id, expiration_time}).
+-define(FT_FTRequestServiceContext, {'tk_struct', ?SYSTEM_TYPE, 'FT_FTRequestServiceContext',
+ [{"client_id", {'tk_string', 0}},
+ {"retention_id", 'tk_long'},
+ {"expiration_time", ?TimeBase_TimeT}]}).
+
+%% Specification for Transport Heartbeats
+-define(FT_PolicyType_HEARTBEAT_POLICY, 48).
+-define(FT_PolicyType_HEARTBEAT_ENABLED_POLICY, 49).
+
+%% tag = TAG_FT_HEARTBEAT_ENABLED;
+-record('FT_TagFTHeartbeatEnabledTaggedComponent', {heartbeat_enabled}).
+-define(FT_TagFTHeartbeatEnabledTaggedComponent, {'tk_struct', ?SYSTEM_TYPE, 'FT_TagFTHeartbeatEnabledTaggedComponent',
+ [{"heartbeat_enabled", 'tk_boolean'}]}).
+
+
+%%------ CSI stuff - required by the SAS protocol. -------
+%% This constant defines the current level we support.
+-define(CSIv2_MAX_TARGET_REQUIRES, 16#488).
+
+%% NOTE! The OMG VMCID is incorrect in the SAS specification, should be
+%% OMGVMCID = 0x4f4d0000;
+-define(CSI_OMGVMCID, ?CORBA_OMGVMCID).
+
+%% ASN.1 Encoding of an OBJECT IDENTIFIER
+-define(CSI_OID, {'tk_sequence', 'tk_octet', 0}).
+-define(CSI_OIDList, {'tk_sequence', ?CSI_OID, 0}).
+
+%% An X509CertificateChain contains an ASN.1 BER encoded SEQUENCE
+%% [1..MAX] OF X.509 certificates encapsulated in a sequence of octets. The
+%% subject:s certificate shall come first in the list. Each following
+%% certificate shall directly certify the one preceding it. The ASN.1
+%% representation of Certificate is as defined in [IETF RFC 2459].
+-define(CSI_X509CertificateChain, {'tk_sequence', 'tk_octet', 0}).
+
+%% an X.501 type name or Distinguished Name encapsulated in a sequence of
+%% octets containing the ASN.1 encoding.
+-define(CSI_X501DistinguishedName, {'tk_sequence', 'tk_octet', 0}).
+
+%% UTF-8 Encoding of String
+-define(CSI_UTF8String, {'tk_sequence', 'tk_octet', 0}).
+
+%% A sequence of octets containing a GSStoken. Initial context tokens are
+%% ASN.1 encoded as defined in [IETF RFC 2743] Section 3.1,
+%% "Mechanism-Independent token Format", pp. 81-82. Initial context tokens
+%% contain an ASN.1 tag followed by a token length, a mechanism identifier,
+%% and a mechanism-specific token (i.e. a GSSUP::InitialContextToken). The
+%% encoding of all other GSS tokens (e.g. error tokens and final context
+%% tokens) is mechanism dependent.
+-define(CSI_GSSToken, {'tk_sequence', 'tk_octet', 0}).
+
+%% An encoding of a GSS Mechanism-Independent Exported Name Object as
+%% defined in [IETF RFC 2743] Section 3.2, "GSS Mechanism-Independent
+%% Exported Name Object Format," p. 84.
+-define(CSI_GSS_NT_ExportedName, {'tk_sequence', 'tk_octet', 0}).
+-define(CSI_GSS_NT_ExportedNameList, {'tk_sequence', ?CSI_GSS_NT_ExportedName, 0}).
+
+%% The MsgType enumeration defines the complete set of service context
+%% message types used by the CSI context management protocols, including
+%% those message types pertaining only to the stateful application of the
+%% protocols (to insure proper alignment of the identifiers between
+%% stateless and stateful implementations). Specifically, the
+%% MTMessageInContext is not sent by stateless clients (although it may
+%% be received by stateless targets).
+-define(CSI_MsgType, 'tk_short').
+-define(CSI_MsgType_MTEstablishContext, 0).
+-define(CSI_MsgType_MTCompleteEstablishContext, 1).
+-define(CSI_MsgType_MTContextError, 4).
+-define(CSI_MsgType_MTMessageInContext, 5).
+
+%% The ContextId type is used carry session identifiers. A stateless
+%% application of the service context protocol is indicated by a session
+%% identifier value of 0.
+-define(CSI_ContextId, 'tk_ulonglong').
+
+%% The AuthorizationElementType defines the contents and encoding of
+%% the_element field of the AuthorizationElement.
+%% The high order 20-bits of each AuthorizationElementType constant
+%% shall contain the Vendor Minor Codeset ID (VMCID) of the
+%% organization that defined the element type. The low order 12 bits
+%% shall contain the organization-scoped element type identifier. The
+%% high-order 20 bits of all element types defined by the OMG shall
+%% contain the VMCID allocated to the OMG (that is, 0x4F4D0).
+-define(CSI_AuthorizationElementType, 'tk_ulong').
+
+%% An AuthorizationElementType of X509AttributeCertChain indicates that
+%% the_element field of the AuthorizationElement contains an ASN.1 BER
+%% SEQUENCE composed of an (X.509) AttributeCertificate followed by a
+%% SEQUENCE OF (X.509) Certificate. The two-part SEQUENCE is encapsulated
+%% in an octet stream. The chain of identity certificates is provided
+%% to certify the attribute certificate. Each certificate in the chain
+%% shall directly certify the one preceding it. The first certificate
+%% in the chain shall certify the attribute certificate. The ASN.1
+%% representation of (X.509) Certificate is as defined in [IETF RFC 2459].
+%% The ASN.1 representation of (X.509) AtributeCertificate is as defined
+%% in [IETF ID PKIXAC].
+-define(CSI_X509AttributeCertChain, (?CSI_OMGVMCID bor 1)).
+-define(CSI_AuthorizationElementContents, {'tk_sequence', 'tk_octet', 0}).
+
+%% The AuthorizationElement contains one element of an authorization token.
+%% Each element of an authorization token is logically a PAC.
+%% The AuthorizationToken is made up of a sequence of AuthorizationElements
+%% --- NOTE ---
+%% OMG only defines 'CSI_X509AttributeCertChain' so we use it as default value.
+-record('CSI_AuthorizationElement', {the_type = ?CSI_X509AttributeCertChain,
+ the_element = []}).
+-define(CSIIOP_AuthorizationElement, {'tk_struct', ?SYSTEM_TYPE, 'CSI_AuthorizationElement',
+ [{"the_type", ?CSI_AuthorizationElementType},
+ {"the_element", ?CSI_AuthorizationElementContents}]}).
+-define(CSI_AuthorizationToken, {'tk_sequence', ?CSIIOP_AuthorizationElement, 0}).
+
+%% Additional standard identity token types shall only be defined by the
+%% OMG. All IdentityTokenType constants shall be a power of 2.
+-define(CSI_IdentityTokenType, 'tk_ulong').
+-define(CSI_IdentityTokenType_ITTAbsent, 0).
+-define(CSI_IdentityTokenType_ITTAnonymous, 1).
+-define(CSI_IdentityTokenType_ITTPrincipalName, 2).
+-define(CSI_IdentityTokenType_ITTX509CertChain, 4).
+-define(CSI_IdentityTokenType_ITTDistinguishedName, 8).
+
+-define(CSI_IdentityExtension, {'tk_sequence', 'tk_octet', 0}).
+-record('CSI_IdentityToken', {label, value}).
+-define(CSI_IdentityToken,
+ {'tk_union', ?SYSTEM_TYPE, 'CSI_IdentityToken',
+ ?CSI_IdentityTokenType, 5,
+ [{?CSI_IdentityTokenType_ITTAbsent, "absent", 'tk_boolean'},
+ {?CSI_IdentityTokenType_ITTAnonymous, "anonymous", 'tk_boolean'},
+ {?CSI_IdentityTokenType_ITTPrincipalName, "principal_name", ?CSI_GSS_NT_ExportedName},
+ {?CSI_IdentityTokenType_ITTX509CertChain, "certificate_chain", ?CSI_X509CertificateChain},
+ {?CSI_IdentityTokenType_ITTDistinguishedName, "dn", ?CSI_X501DistinguishedName},
+ {default, "id", ?CSI_IdentityExtension}]}).
+
+-record('CSI_EstablishContext', {client_context_id, authorization_token,
+ identity_token, client_authentication_token}).
+-define(CSI_EstablishContext, {'tk_struct', ?SYSTEM_TYPE, 'CSI_EstablishContext',
+ [{"client_context_id", ?CSI_ContextId},
+ {"authorization_token", ?CSI_AuthorizationToken},
+ {"identity_token", ?CSI_IdentityToken},
+ {"client_authentication_token", ?CSI_GSSToken}]}).
+
+-record('CSI_CompleteEstablishContext', {client_context_id, context_stateful,
+ final_context_token}).
+-define(CSI_CompleteEstablishContext, {'tk_struct', ?SYSTEM_TYPE, 'CSI_CompleteEstablishContext',
+ [{"client_context_id", ?CSI_ContextId},
+ {"context_stateful", 'tk_boolean'},
+ {"final_context_token", ?CSI_GSSToken}]}).
+
+-record('CSI_ContextError', {client_context_id, major_status,
+ minor_status, error_token}).
+-define(CSI_ContextError, {'tk_struct', ?SYSTEM_TYPE, 'CSI_ContextError',
+ [{"client_context_id", ?CSI_ContextId},
+ {"major_status", 'tk_long'},
+ {"minor_status", 'tk_long'},
+ {"error_token", ?CSI_GSSToken}]}).
+
+% Not sent by stateless clients. If received by a stateless server, a
+% ContextError message should be returned, indicating the session does
+% not exist.
+-record('CSI_MessageInContext', {client_context_id, discard_context}).
+-define(CSI_MessageInContext, {'tk_struct', ?SYSTEM_TYPE, 'CSI_MessageInContext',
+ [{"client_context_id", ?CSI_ContextId},
+ {"discard_context", 'tk_boolean'}]}).
+
+-record('CSI_SASContextBody', {label, value}).
+-define(CSI_SASContextBody,
+ {'tk_union', ?SYSTEM_TYPE, 'CSI_SASContextBody', ?CSI_MsgType, -1,
+ [{?CSI_MsgType_MTEstablishContext, "establish_msg", ?CSI_EstablishContext},
+ {?CSI_MsgType_MTCompleteEstablishContext, "complete_msg", ?CSI_CompleteEstablishContext},
+ {?CSI_MsgType_MTContextError, "error_msg", ?CSI_ContextError},
+ {?CSI_MsgType_MTMessageInContext, "in_context_msg", ?CSI_MessageInContext}]}).
+
+%% The following type represents the string representation of an ASN.1
+%% OBJECT IDENTIFIER (OID). OIDs are represented by the string "oid:"
+%% followed by the integer base 10 representation of the OID separated
+%% by dots. For example, the OID corresponding to the OMG is represented
+%% as: "oid:2.23.130"
+-define(CSI_StringOID, {'tk_string', 0}).
+
+
+%% The GSS Object Identifier for the KRB5 mechanism is:
+%% { iso(1) member-body(2) United States(840) mit(113554) infosys(1)
+%% gssapi(2) krb5(2) }
+%% Type ?CSI_StringOID
+-define(CSI_KRB5MechOID, "oid:1.2.840.113554.1.2.2").
+
+%% The GSS Object Identifier for name objects of the Mechanism-independent
+%% Exported Name Object type is:
+%% { iso(1) org(3) dod(6) internet(1) security(5) nametypes(6)
+%% gss-api-exported-name(4) }
+%% Type ?CSI_StringOID
+-define(CSI_GSS_NT_Export_Name_OID, "oid:1.3.6.1.5.6.4").
+
+%% The GSS Object Identifier for the scoped-username name form is:
+%% { iso-itu-t (2) international-organization (23) omg (130) security (1)
+%% naming (2) scoped-username(1) }
+%% Type ?CSI_StringOID
+-define(CSI_GSS_NT_Scoped_Username_OID, "oid:2.23.130.1.2.1").
+
+%%------ GSSUP stuff - required by the SAS protocol. -------
+%% The GSS Object Identifier allocated for the username/password mechanism is defined
+%% below.
+%% { iso-itu-t (2) international-organization (23) omg (130)
+%% security (1) authentication (1) gssup-mechanism (1) }
+%% Type ?CSI_StringOID
+-define(GSSUP_GSSUPMechOID, "oid:2.23.130.1.1.1").
+
+%% The following structure defines the inner contents of the
+%% username password initial context token. This structure is
+%% CDR encapsulated and appended at the end of the
+%% username/password GSS (initial context) Token.
+-record('GSSUP_InitialContextToken', {username, password, target_name}).
+-define(GSSUP_InitialContextToken, {'tk_struct', ?SYSTEM_TYPE, 'GSSUP_InitialContextToken',
+ [{"username", ?CSI_UTF8String},
+ {"password", ?CSI_UTF8String},
+ {"target_name", ?CSI_GSS_NT_ExportedName}]}).
+
+-define(GSSUP_ErrorCode, 'tk_ulong').
+
+%% GSSUP Mechanism-Specific Error Token
+-record('GSSUP_ErrorToken', {error_code}).
+-define(GSSUP_ErrorToken, {'tk_struct', ?SYSTEM_TYPE, 'GSSUP_ErrorToken',
+ [{"error_code", ?GSSUP_ErrorCode}]}).
+
+%% The context validator has chosen not to reveal the GSSUP
+%% specific cause of the failure.
+%% Type ?GSSUP_ErrorCode
+-define(GSSUP_GSS_UP_S_G_UNSPECIFIED, 1).
+
+%% The user identified in the username field of the
+%% GSSUP::InitialContextToken is unknown to the target.
+%% Type ?GSSUP_ErrorCode
+-define(GSSUP_GSS_UP_S_G_NOUSER, 2).
+
+%% The password supplied in the GSSUP::InitialContextToken was
+%% incorrect.
+%% Type ?GSSUP_ErrorCode
+-define(GSSUP_GSS_UP_S_G_BAD_PASSWORD, 3).
+
+%% The target_name supplied in the GSSUP::InitialContextToken does
+%% not match a target_name in a mechanism definition of the target.
+%% Type ?GSSUP_ErrorCode
+-define(GSSUP_GSS_UP_S_G_BAD_TARGET, 4).
+
+
+%%----- CSIIOP stuff - required by the SAS protocol. -----
+
+% AssociationOptions
+-define(CSIIOP_AssociationOptions, 'tk_ushort').
+%% AssociationOptions - constant definitions
+-define(CSIIOP_AssociationOptions_NoProtection, 1).
+-define(CSIIOP_AssociationOptions_Integrity, 2).
+-define(CSIIOP_AssociationOptions_Confidentiality, 4).
+-define(CSIIOP_AssociationOptions_DetectReplay, 8).
+-define(CSIIOP_AssociationOptions_DetectMisordering, 16).
+-define(CSIIOP_AssociationOptions_EstablishTrustInTarget, 32).
+-define(CSIIOP_AssociationOptions_EstablishTrustInClient, 64).
+-define(CSIIOP_AssociationOptions_NoDelegation, 128).
+-define(CSIIOP_AssociationOptions_SimpleDelegation, 256).
+-define(CSIIOP_AssociationOptions_CompositeDelegation, 512).
+-define(CSIIOP_AssociationOptions_IdentityAssertion, 1024).
+-define(CSIIOP_AssociationOptions_DelegationByClient, 2048).
+
+%% The high order 20-bits of each ServiceConfigurationSyntax constant
+%% shall contain the Vendor Minor Codeset ID (VMCID) of the
+%% organization that defined the syntax. The low order 12 bits shall
+%% contain the organization-scoped syntax identifier. The high-order 20
+%% bits of all syntaxes defined by the OMG shall contain the VMCID
+%% allocated to the OMG (that is, 0x4F4D0).
+%% NOTE! The OMG VMCID is incorrect in the SAS specification, should be
+%% OMGVMCID = 0x4f4d0000;
+-define(CSIIOP_ServiceConfigurationSyntax, 'tk_ulong').
+-define(CSIIOP_ServiceConfigurationSyntax_SCS_GeneralNames, (?CSI_OMGVMCID bor 0)).
+-define(CSIIOP_ServiceConfigurationSyntax_SCS_GSSExportedName, (?CSI_OMGVMCID bor 1)).
+
+-define(CSIIOP_ServiceSpecificName, {'tk_sequence', 'tk_octet', 0}).
+
+%% The name field of the ServiceConfiguration structure identifies a
+%% privilege authority in the format identified in the syntax field. If the
+%% syntax is SCS_GeneralNames, the name field contains an ASN.1 (BER)
+%% SEQUENCE [1..MAX] OF GeneralName, as defined by the type GeneralNames in
+%% [IETF RFC 2459]. If the syntax is SCS_GSSExportedName, the name field
+%% contains a GSS exported name encoded according to the rules in
+%% [IETF RFC 2743] Section 3.2, "Mechanism-Independent Exported Name
+%% Object Format," p. 84 (CORBA-2.6)
+-record('CSIIOP_ServiceConfiguration', {syntax, name}).
+-define(CSIIOP_ServiceConfiguration, {'tk_struct', ?SYSTEM_TYPE, 'CSIIOP_ServiceConfiguration',
+ [{"syntax", ?CSIIOP_ServiceConfigurationSyntax},
+ {"name", ?CSIIOP_ServiceSpecificName}]}).
+-define(CSIIOP_ServiceConfigurationList, {'tk_sequence', ?CSIIOP_ServiceConfiguration, 0}).
+
+%% The body of the TAG_NULL_TAG component is a sequence of octets of
+%% length 0.
+
+%% type used to define AS layer functionality within a compound mechanism
+%% definition
+-record('CSIIOP_AS_ContextSec', {target_supports = 0, target_requires = 0,
+ client_authentication_mech, target_name}).
+-define(CSIIOP_AS_ContextSec, {'tk_struct', ?SYSTEM_TYPE, 'CSIIOP_AS_ContextSec',
+ [{"target_supports", ?CSIIOP_AssociationOptions},
+ {"target_requires", ?CSIIOP_AssociationOptions},
+ {"client_authentication_mech", ?CSI_OID},
+ {"target_name", ?CSI_GSS_NT_ExportedName}]}).
+
+%% type used to define SAS layer functionality within a compound mechanism
+%% definition
+-record('CSIIOP_SAS_ContextSec', {target_supports = 0, target_requires = 0,
+ privilege_authorities,
+ supported_naming_mechanisms,
+ supported_identity_types}).
+-define(CSIIOP_SAS_ContextSec, {'tk_struct', ?SYSTEM_TYPE, 'CSIIOP_SAS_ContextSec',
+ [{"target_supports", ?CSIIOP_AssociationOptions},
+ {"target_requires", ?CSIIOP_AssociationOptions},
+ {"privilege_authorities", ?CSIIOP_ServiceConfigurationList},
+ {"supported_naming_mechanisms", ?CSI_OIDList},
+ {"supported_identity_types", ?CSI_IdentityTokenType}]}).
+
+%% Type used in the body of a TAG_CSI_SEC_MECH_LIST component to describe a
+%% compound mechanism
+-record('CSIIOP_CompoundSecMech', {target_requires = 0, transport_mech,
+ as_context_mech, sas_context_mech}).
+-define(CSIIOP_CompoundSecMech, {'tk_struct', ?SYSTEM_TYPE, 'CSIIOP_CompoundSecMech',
+ [{"target_requires", ?CSIIOP_AssociationOptions},
+ {"transport_mech", ?IOP_TAGGEDCOMPONENT},
+ {"as_context_mech", ?CSIIOP_AS_ContextSec},
+ {"sas_context_mech", ?CSIIOP_SAS_ContextSec}]}).
+-define(CSIIOP_CompoundSecMechanisms, {'tk_sequence', ?CSIIOP_CompoundSecMech, 0}).
+
+%% type corresponding to the body of a TAG_CSI_SEC_MECH_LIST component
+-record('CSIIOP_CompoundSecMechList', {stateful = false, mechanism_list}).
+-define(CSIIOP_CompoundSecMechList, {'tk_struct', ?SYSTEM_TYPE, 'CSIIOP_CompoundSecMechList',
+ [{"stateful", 'tk_boolean'},
+ {"mechanism_list", ?CSIIOP_CompoundSecMechanisms}]}).
+%% CSIIOP::TransportAddress
+-record('CSIIOP_TransportAddress', {host_name, port}).
+-define(CSIIOP_TransportAddress, {'tk_struct', ?SYSTEM_TYPE, 'CSIIOP_TransportAddress',
+ [{"host_name", {'tk_string', 0}},
+ {"port", 'tk_ushort'}]}).
+-define(CSIIOP_TransportAddressList, {'tk_sequence', ?CSIIOP_TransportAddress, 0}).
+
+%% Tagged component (TAG_TLS_SEC_TRANS) for configuring TLS/SSL as a CSIv2
+%% transport mechanism.
+-record('CSIIOP_TLS_SEC_TRANS', {target_supports, target_requires, addresses}).
+-define(CSIIOP_TLS_SEC_TRANS, {'tk_struct', ?SYSTEM_TYPE, 'CSIIOP_TLS_SEC_TRANS',
+ [{"target_supports", ?CSIIOP_AssociationOptions},
+ {"target_requires", ?CSIIOP_AssociationOptions},
+ {"addresses", ?CSIIOP_TransportAddressList}]}).
+
+%% Tagged component (TAG_SECIOP_SEC_TRANS) for configuring SECIOP as a CSIv2
+%% transport mechanism
+-record('CSIIOP_SECIOP_SEC_TRANS', {target_supports = 0, target_requires = 0, mech_oid,
+ target_name, addresses}).
+-define(CSIIOP_SECIOP_SEC_TRANS, {'tk_struct', ?SYSTEM_TYPE, 'CSIIOP_SECIOP_SEC_TRANS',
+ [{"target_supports", ?CSIIOP_AssociationOptions},
+ {"target_requires", ?CSIIOP_AssociationOptions},
+ {"mech_oid", ?CSI_OID},
+ {"target_name", ?CSI_GSS_NT_ExportedName},
+ {"addresses", ?CSIIOP_TransportAddressList}]}).
+
+
+%%-- ServiceContext ID's ------------
+%% Describes what type of context included, i.e.,
+%% typedef unsigned long ServiceId;
+%% struct ServiceContext {
+%% ServiceId context_id;
+%% sequence <octet> context_data;
+%% };
+
+%% The record is defined in include/corba.hrl.
+%%-record('IOP_ServiceContext', {context_id, context_data}).
+-define(IOP_SERVICECONTEXT, {'tk_sequence',
+ {'tk_struct', ?SYSTEM_TYPE, 'IOP_ServiceContext',
+ [{"context_id", 'tk_ulong'},
+ {"context_data",
+ {'tk_sequence', 'tk_octet', 0}}]}, 0}).
+
+-record('CONV_FRAME_CodeSetContext', {char_data, wchar_data}).
+-define(CONV_FRAME_CODESETCONTEXT, {'tk_struct', ?SYSTEM_TYPE, 'CONV_FRAME_CodeSetContext',
+ [{"char_data", 'tk_ulong'},
+ {"wchar_data", 'tk_ulong'}]}).
+
+
+-record('IIOP_ListenPoint', {host, port}).
+-define(IIOP_LISTENPOINT, {'tk_struct', ?SYSTEM_TYPE, 'IIOP_ListenPoint',
+ [{"host", {'tk_string', 0}},
+ {"port", 'tk_ushort'}]}).
+
+-record('IIOP_BiDirIIOPServiceContext', {listen_points}).
+-define(IIOP_BIDIRIIOPSERVICECONTEXT,
+ {'tk_struct', ?SYSTEM_TYPE, 'IIOP_BiDirIIOPServiceContext',
+ [{"listen_points", {'tk_sequence', ?IIOP_LISTENPOINT, 0}}]}).
+
+-define(IOP_TransactionService, 0).
+-define(IOP_CodeSets, 1).
+-define(IOP_ChainBypassCheck, 2).
+-define(IOP_ChainBypassInfo, 3).
+-define(IOP_LogicalThreadId, 4).
+-define(IOP_BI_DIR_IIOP, 5).
+-define(IOP_SendingContextRunTime, 6).
+-define(IOP_INVOCATION_POLICIES, 7).
+-define(IOP_FORWARDED_IDENTITY, 8).
+-define(IOP_UnknownExceptionInfo, 9).
+-define(IOP_RTCorbaPriority, 10).
+-define(IOP_RTCorbaPriorityRange, 11).
+-define(IOP_FT_GROUP_VERSION, 12).
+-define(IOP_FT_REQUEST, 13).
+-define(IOP_ExceptionDetailMessage, 14).
+-define(IOP_SecurityAttributeService, 15).
+
+
+
+%%----------------------------------------------------------------------
+%% host_data
+%%----------------------------------------------------------------------
+-record(host_data, {protocol = normal, ssl_data, version, csiv2_mech,
+ csiv2_statefull = false, csiv2_addresses = [],
+ charset = ?ISO8859_1_ID, wcharset = ?UTF_16_ID,
+ ft_heartbeat = false, ft_primary = false, ft_domain,
+ ft_group, ft_ref_version}).
+
+%%----------------------------------------------------------------------
+%% giop_env
+%%----------------------------------------------------------------------
+-record(giop_env, {interceptors, type, version, bytes, ctx = [],
+ request_id, op, parameters = [], tc, response_expected,
+ objkey, reply_status, result, flags, host, iiop_port,
+ iiop_ssl_port, domain, partial_security}).
+
+-endif.
+
+%%----------------------------------------------------------------------
+%% END OF MODULE
+%%----------------------------------------------------------------------
diff --git a/lib/orber/src/orber_iiop_inproxy.erl b/lib/orber/src/orber_iiop_inproxy.erl
new file mode 100644
index 0000000000..ede1e0749f
--- /dev/null
+++ b/lib/orber/src/orber_iiop_inproxy.erl
@@ -0,0 +1,398 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_iiop_inproxy.erl
+%%
+%% Description:
+%% This file contains the IIOP "proxy" for incomming connections
+%%
+%%-----------------------------------------------------------------
+-module(orber_iiop_inproxy).
+
+-behaviour(gen_server).
+
+-include_lib("orber/src/orber_iiop.hrl").
+-include_lib("orber/include/corba.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start/0, start/1]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ code_change/3, terminate/2, post_accept/3, stop/1]).
+
+%%-----------------------------------------------------------------
+%% Macros
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 7).
+
+-record(state, {stype, socket, db, timeout, max_fragments,
+ max_requests, request_counter = 1, giop_env, peer}).
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: start/0
+%%-----------------------------------------------------------------
+start() ->
+ ignore.
+
+%%-----------------------------------------------------------------
+%% Func: start/1
+%%-----------------------------------------------------------------
+start(Opts) ->
+ gen_server:start_link(orber_iiop_inproxy, Opts, []).
+
+post_accept(Pid, ssl, Socket) ->
+ (catch gen_server:cast(Pid, {post_accept, ssl, Socket})),
+ ok;
+post_accept(_, _, _) ->
+ ok.
+
+%%-----------------------------------------------------------------
+%% Internal interface functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: stop/1
+%%-----------------------------------------------------------------
+stop(Pid) ->
+ gen_server:cast(Pid, stop).
+
+%%-----------------------------------------------------------------
+%% Server functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: init/1
+%%-----------------------------------------------------------------
+init({connect, Type, Socket, Ref, Options}) ->
+ process_flag(trap_exit, true),
+ Flags = orber_tb:keysearch(flags, Options, orber_env:get_flags()),
+ {Address, Port} = PeerData = orber_socket:peerdata(Type, Socket),
+ {LAddress, LPort} = LocalData = orber_socket:sockdata(Type, Socket),
+ case {?ORB_FLAG_TEST(Flags, ?ORB_ENV_LOCAL_INTERFACE), LPort} of
+ {true, 0} ->
+ orber_tb:info("Unable to lookup the local address and port number.~n"
+ "Closing the incoming connection.", []),
+ ignore;
+ _ ->
+ orber_iiop_net:add_connection(Socket, Type, PeerData, LocalData, Ref),
+ Interceptors =
+ case orber_tb:keysearch(interceptors, Options,
+ orber_env:get_interceptors()) of
+ {native, PIs} ->
+ {native, orber_pi:new_in_connection(PIs, Address, Port,
+ LAddress, LPort), PIs};
+ Other ->
+ Other
+ end,
+ Env =
+ case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_LOCAL_INTERFACE) of
+ true when Type == ssl ->
+ #giop_env{interceptors = Interceptors,
+ flags = Flags, host = [LAddress],
+ iiop_port =
+ orber_tb:keysearch(iiop_port, Options,
+ orber_env:iiop_port()),
+ iiop_ssl_port = LPort,
+ domain = orber:domain(),
+ partial_security = orber:partial_security()};
+ true ->
+ #giop_env{interceptors = Interceptors,
+ flags = Flags, host = [LAddress],
+ iiop_port = LPort,
+ iiop_ssl_port =
+ orber_tb:keysearch(iiop_ssl_port, Options,
+ orber_env:iiop_ssl_port()),
+ domain = orber:domain(),
+ partial_security = orber:partial_security()};
+ false ->
+ case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_ENABLE_NAT) of
+ false ->
+ #giop_env{interceptors = Interceptors,
+ flags = Flags, host = orber:host(),
+ iiop_port = orber:iiop_port(),
+ iiop_ssl_port = orber:iiop_ssl_port(),
+ domain = orber:domain(),
+ partial_security = orber:partial_security()};
+ true ->
+ #giop_env{interceptors = Interceptors,
+ flags = Flags,
+ host =
+ orber_tb:keysearch(nat_ip_address, Options,
+ orber_env:nat_host()),
+ iiop_port =
+ orber_tb:keysearch(nat_iiop_port, Options,
+ orber_env:nat_iiop_port()),
+ iiop_ssl_port =
+ orber_tb:keysearch(nat_iiop_ssl_port, Options,
+ orber_env:nat_iiop_ssl_port()),
+ domain = orber:domain(),
+ partial_security = orber:partial_security()}
+ end
+ end,
+ Timeout = orber_tb:keysearch(iiop_in_connection_timeout, Options,
+ orber_env:iiop_in_connection_timeout()),
+ MaxFrags = orber_tb:keysearch(iiop_max_fragments, Options,
+ orber_env:iiop_max_fragments()),
+ MaxRequests = orber_tb:keysearch(iiop_max_in_requests, Options,
+ orber_env:iiop_max_in_requests()),
+ {ok, #state{stype = Type,
+ socket = Socket,
+ db = ets:new(orber_incoming_requests, [set]),
+ timeout = Timeout,
+ max_fragments = MaxFrags,
+ max_requests = MaxRequests,
+ giop_env = Env, peer = PeerData}, Timeout}
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Func: terminate/2
+%%-----------------------------------------------------------------
+%% We may want to kill all proxies before terminating, but the best
+%% option should be to let the requests complete (especially for one-way
+%% functions it's a better alternative.
+terminate(_Reason, #state{db = IncRequests, giop_env = Env}) ->
+ ets:delete(IncRequests),
+ case Env#giop_env.interceptors of
+ false ->
+ ok;
+ {native, Ref, PIs} ->
+ orber_pi:closed_in_connection(PIs, Ref);
+ {_Type, _PIs} ->
+ ok
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: handle_call/3
+%%-----------------------------------------------------------------
+handle_call(stop, _From, State) ->
+ {stop, normal, ok, State};
+handle_call(_, _, State) ->
+ {noreply, State, State#state.timeout}.
+
+%%-----------------------------------------------------------------
+%% Func: handle_cast/2
+%%-----------------------------------------------------------------
+handle_cast({post_accept, Type, Socket}, State) ->
+ Timeout = orber_env:iiop_ssl_accept_timeout(),
+ case catch orber_socket:post_accept(Type, Socket, Timeout) of
+ ok ->
+ {noreply, State};
+ _Failed ->
+ orber_socket:close(Type, Socket),
+ {stop, normal, State}
+ end;
+handle_cast(stop, State) ->
+ {stop, normal, State};
+handle_cast(_, State) ->
+ {noreply, State, State#state.timeout}.
+
+%%-----------------------------------------------------------------
+%% Func: handle_info/2
+%%-----------------------------------------------------------------
+%% Normal invocation
+handle_info({tcp, Socket, Bytes}, State) ->
+ handle_msg(normal, Socket, Bytes, State);
+handle_info({ssl, Socket, Bytes}, State) ->
+ handle_msg(ssl, Socket, Bytes, State);
+%% Errors, closed connection
+handle_info({tcp_closed, _Socket}, State) ->
+ {stop, normal, State};
+handle_info({tcp_error, _Socket, _Reason}, State) ->
+ {stop, normal, State};
+handle_info({ssl_closed, _Socket}, State) ->
+ {stop, normal, State};
+handle_info({ssl_error, _Socket, _Reason}, State) ->
+ {stop, normal, State};
+%% Servant termination.
+handle_info({'EXIT', Pid, normal}, State) ->
+ ets:delete(State#state.db, Pid),
+ {noreply, decrease_counter(State), State#state.timeout};
+handle_info({message_error, _Pid, ReqId}, State) ->
+ ets:delete(State#state.db, ReqId),
+ {noreply, State, State#state.timeout};
+handle_info(timeout, State) ->
+ case ets:info(State#state.db, size) of
+ 0 ->
+ %% No pending requests, close the connection.
+ {stop, normal, State};
+ _Amount ->
+ %% Still pending request, cannot close the connection.
+ {noreply, State, State#state.timeout}
+ end;
+handle_info({reconfigure, Options}, State) ->
+ {noreply, update_state(State, Options), State#state.timeout};
+handle_info(_X,State) ->
+ {noreply, State, State#state.timeout}.
+
+handle_msg(Type, Socket, Bytes, #state{stype = Type, socket = Socket,
+ giop_env = Env} = State) ->
+ case catch cdr_decode:dec_giop_message_header(Bytes) of
+ %% Only when using IIOP-1.2 may the client send this message.
+ %% Introduced in CORBA-2.6
+ #giop_message{message_type = ?GIOP_MSG_CLOSE_CONNECTION,
+ giop_version = {1,2}} ->
+ {stop, normal, State};
+ #giop_message{message_type = ?GIOP_MSG_CLOSE_CONNECTION} ->
+ {noreply, State, State#state.timeout};
+ #giop_message{message_type = ?GIOP_MSG_CANCEL_REQUEST} = GIOPHdr ->
+ ReqId = cdr_decode:peek_request_id(GIOPHdr#giop_message.byte_order,
+ GIOPHdr#giop_message.message),
+ case ets:lookup(State#state.db, ReqId) of
+ [{RId, PPid}] ->
+ ets:delete(State#state.db, RId),
+ PPid ! {self(), cancel_request_header};
+ [] ->
+ send_msg_error(Type, Socket, Bytes,
+ Env#giop_env{version =
+ GIOPHdr#giop_message.giop_version},
+ "No such request id")
+ end,
+ {noreply, State, State#state.timeout};
+ %% A fragment; we must have received a Request or LocateRequest
+ %% with fragment-flag set to true.
+ %% We need to decode the header to get the request-id.
+ #giop_message{message_type = ?GIOP_MSG_FRAGMENT,
+ giop_version = {1,2}} = GIOPHdr ->
+ ReqId = cdr_decode:peek_request_id(GIOPHdr#giop_message.byte_order,
+ GIOPHdr#giop_message.message),
+ case ets:lookup(State#state.db, ReqId) of
+ [{_RId, PPid}] when GIOPHdr#giop_message.fragments == true ->
+ PPid ! {self(), GIOPHdr};
+ [{RId, PPid}] ->
+ ets:delete(State#state.db, RId),
+ PPid ! {self(), GIOPHdr};
+ [] ->
+ send_msg_error(Type, Socket, Bytes,
+ Env#giop_env{version =
+ GIOPHdr#giop_message.giop_version},
+ "No such fragment id")
+ end,
+ {noreply, State, State#state.timeout};
+ %% Must be a Request or LocateRequest which have been fragmented.
+ %% We need to decode the header to get the request-id.
+ #giop_message{fragments = true,
+ giop_version = {1,2}} = GIOPHdr ->
+ ReqId = cdr_decode:peek_request_id(GIOPHdr#giop_message.byte_order,
+ GIOPHdr#giop_message.message),
+ Pid =
+ orber_iiop_inrequest:
+ start_fragment_collector(GIOPHdr, Bytes,
+ Type, Socket,
+ ReqId, self(),
+ State#state.max_fragments,
+ Env#giop_env{version = {1,2},
+ request_id = ReqId}),
+ ets:insert(State#state.db, {Pid, ReqId}),
+ ets:insert(State#state.db, {ReqId, Pid}),
+ {noreply, increase_counter(State), State#state.timeout};
+ GIOPHdr when is_record(GIOPHdr, giop_message) ->
+ Pid = orber_iiop_inrequest:start(GIOPHdr, Bytes, Type, Socket,
+ Env#giop_env{version =
+ GIOPHdr#giop_message.giop_version}),
+ ets:insert(State#state.db, {Pid, undefined}),
+ {noreply, increase_counter(State), State#state.timeout};
+ {'EXIT', message_error} ->
+ send_msg_error(Type, Socket, Bytes,
+ Env#giop_env{version = orber_env:giop_version()},
+ "Unable to decode the GIOP-header"),
+ {noreply, State, State#state.timeout}
+ end;
+handle_msg(Type, _, Bytes, State) ->
+ orber:dbg("[~p] orber_iiop_inproxy:handle_msg(~p);~n"
+ "Received a message from a socket of a different type.~n"
+ "Should be ~p but was ~p.",
+ [?LINE, Bytes, State#state.stype, Type], ?DEBUG_LEVEL),
+ {noreply, State, State#state.timeout}.
+
+send_msg_error(Type, Socket, Data, Env, Msg) ->
+ orber:dbg("[~p] orber_iiop_inproxy:handle_msg(~p); ~p.",
+ [?LINE, Data, Msg], ?DEBUG_LEVEL),
+ Reply = cdr_encode:enc_message_error(Env),
+ orber_socket:write(Type, Socket, Reply).
+
+increase_counter(#state{max_requests = infinity} = State) ->
+ State;
+increase_counter(#state{max_requests = Max,
+ request_counter = Counter} = State) when Max > Counter ->
+ orber_socket:setopts(State#state.stype, State#state.socket, [{active, once}]),
+ State#state{request_counter = Counter + 1};
+increase_counter(State) ->
+ State#state{request_counter = State#state.request_counter + 1}.
+
+decrease_counter(#state{max_requests = infinity} = State) ->
+ State;
+decrease_counter(#state{max_requests = Max,
+ request_counter = Counter} = State) when Max =< Counter ->
+ orber_socket:setopts(State#state.stype, State#state.socket, [{active, once}]),
+ State#state{request_counter = Counter - 1};
+decrease_counter(State) ->
+ State#state{request_counter = State#state.request_counter - 1}.
+
+update_state(#state{giop_env = Env} = State,
+ [{interceptors, false}|Options]) ->
+ update_state(State#state{giop_env =
+ Env#giop_env{interceptors = false}}, Options);
+update_state(#state{giop_env = #giop_env{interceptors = false, host = [SH],
+ iiop_port = SP} = Env,
+ peer = {PH, PP}, stype = normal} = State,
+ [{interceptors, {native, LPIs}}|Options]) ->
+ %% No Interceptor(s). Add the same Ref used by the built in interceptors.
+ update_state(State#state{giop_env =
+ Env#giop_env{interceptors =
+ {native, {PH, PP, SH, SP}, LPIs}}},
+ Options);
+update_state(#state{giop_env = #giop_env{interceptors = false, host = [SH],
+ iiop_ssl_port = SP} = Env,
+ peer = {PH, PP}, stype = ssl} = State,
+ [{interceptors, {native, LPIs}}|Options]) ->
+ %% No Interceptor(s). Add the same Ref used by the built in interceptors.
+ update_state(State#state{giop_env =
+ Env#giop_env{interceptors =
+ {native, {PH, PP, SH, SP}, LPIs}}},
+ Options);
+update_state(#state{giop_env = #giop_env{interceptors = {native, Ref, _}} = Env} =
+ State,
+ [{interceptors, {native, LPIs}}|Options]) ->
+ %% Interceptor(s) already in use. We must use the same Ref as before.
+ update_state(State#state{giop_env =
+ Env#giop_env{interceptors = {native, Ref, LPIs}}},
+ Options);
+update_state(State, [H|T]) ->
+ orber:dbg("[~p] orber_iiop_inproxy:update_state(~p, ~p)~n"
+ "Couldn't change the state.",
+ [?LINE, H, State], ?DEBUG_LEVEL),
+ update_state(State, T);
+update_state(State, []) ->
+ State.
+
+%%-----------------------------------------------------------------
+%% Func: code_change/3
+%%-----------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
diff --git a/lib/orber/src/orber_iiop_inrequest.erl b/lib/orber/src/orber_iiop_inrequest.erl
new file mode 100644
index 0000000000..42d48cfe92
--- /dev/null
+++ b/lib/orber/src/orber_iiop_inrequest.erl
@@ -0,0 +1,538 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%--------------------------------------------------------------------
+%% File: orber_iiop_inrequest.erl
+%%
+%% Description:
+%% This file contains the handling of incomming requests
+%%
+%%-----------------------------------------------------------------
+-module(orber_iiop_inrequest).
+
+-include_lib("orber/src/orber_iiop.hrl").
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/include/orber_pi.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start/5, start_fragment_collector/8]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([handle_message/5, fragment_collector/8]).
+
+%%-----------------------------------------------------------------
+%% Macros
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 8).
+
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+start(GIOPHdr, Message, Type, Socket, Env) ->
+ spawn_link(orber_iiop_inrequest, handle_message,
+ [GIOPHdr, Message, Type, Socket, Env]).
+
+start_fragment_collector(GIOPHdr, Message, Type, Socket, ReqId, Proxy, MaxFrags, Env) ->
+ spawn_link(orber_iiop_inrequest, fragment_collector,
+ [GIOPHdr, Message, Type, Socket, ReqId, Proxy, MaxFrags, Env]).
+
+%%-----------------------------------------------------------------
+%% Internal functions
+%%-----------------------------------------------------------------
+
+%%-----------------------------------------------------------------
+%% Func: fragment_collector/4
+%%-----------------------------------------------------------------
+fragment_collector(GIOPHdr, Bytes, SocketType, Socket, ReqId, Proxy, MaxFrags, Env) ->
+ case catch collect(Proxy, [], GIOPHdr#giop_message.byte_order, ReqId,
+ MaxFrags, 0) of
+ {ok, Buffer} ->
+ NewGIOP = GIOPHdr#giop_message
+ {message = list_to_binary([GIOPHdr#giop_message.message|Buffer])},
+ %% NOTE, the third argument to dec_message_header must be complete
+ %% message (i.e. AllBytes), otherwise we cannot handle indirection.
+ case handle_message(NewGIOP, list_to_binary([Bytes| Buffer]),
+ SocketType, Socket, Env) of
+ message_error ->
+ Proxy ! {message_error, self(), ReqId},
+ ok;
+ _ ->
+ ok
+ end;
+ ok ->
+ ok;
+ {'EXCEPTION', E} ->
+ Proxy ! {message_error, self(), ReqId},
+ Reply = marshal_exception(Env, ReqId, E, enc_reply),
+ orber_socket:write(SocketType, Socket, Reply)
+ end.
+
+
+
+collect(_Proxy, _Buffer, _ByteOrder, _ReqId, MaxFrags, MaxFrags) ->
+ orber:dbg("[~p] ~p:collect(~p)~nMax fragments limit reached.",
+ [?LINE, ?MODULE, MaxFrags], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'IMP_LIMIT'{completion_status=?COMPLETED_NO}};
+collect(Proxy, Buffer, ByteOrder, ReqId, MaxFrags, FragCounter) ->
+ receive
+ {Proxy, #giop_message{byte_order = ByteOrder,
+ message = Message,
+ fragments = true} = GIOPHdr} ->
+ {_, #fragment_header{request_id=ReqId}, FragBody, _, _} =
+ cdr_decode:dec_message_header(null, GIOPHdr, Message),
+ collect(Proxy, [FragBody | Buffer], ByteOrder, ReqId,
+ MaxFrags, FragCounter+1);
+ {Proxy, #giop_message{byte_order = ByteOrder,
+ message = Message,
+ fragments = false} = GIOPHdr} ->
+ {_, #fragment_header{request_id=ReqId}, FragBody, _, _} =
+ cdr_decode:dec_message_header(null, GIOPHdr, Message),
+ {ok, lists:reverse([FragBody | Buffer])};
+ {Proxy, GIOPHdr, _Data, _} ->
+ orber:dbg("[~p] orber_iiop_inrequest:collect(~p, ~p)~n"
+ "Incorrect Fragment. Might be different byteorder.",
+ [?LINE, ByteOrder, GIOPHdr], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'MARSHAL'{completion_status=?COMPLETED_NO}};
+ {Proxy, cancel_request_header} ->
+ ok;
+ Other ->
+ orber:dbg("[~p] ~p:collect(~p)~n"
+ "Unable to collect all fragments: ~p",
+ [?LINE, ?MODULE, Buffer, Other], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'MARSHAL'{completion_status=?COMPLETED_NO}}
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Func: handle_message/4
+%%-----------------------------------------------------------------
+handle_message(GIOPHdr, Message, SocketType, Socket, Env) ->
+ %% Warning. We shouldn't set the flags like this here. But, for now, we'll
+ %% do it due to performance reasons.
+ put(oe_orber_flags, Env#giop_env.flags),
+ case catch cdr_decode:dec_message_header(null, GIOPHdr, Message) of
+ Hdr when is_record(Hdr, cancel_request_header) ->
+ %% We just skips this message for the moment, the standard require that
+ %% the client handles the reply anyway.
+ message_error;
+ {location_forward, Object, ReqId, Version, OldObj} ->
+ Reply = call_interceptors_out(Env#giop_env{version = Version},
+ ReqId, [Object], OldObj,
+ 'location_forward',
+ "location_forward",
+ {{'tk_objref', "", ""}, [],[]}),
+ orber_socket:write(SocketType, Socket, Reply);
+ {object_forward, Object, ReqId, Version, _OldObj} ->
+ Reply = handle_locate_request(Env#giop_env{version = Version},
+ {object_forward, Object, ReqId}),
+ orber_socket:write(SocketType, Socket, Reply);
+ {Version, Hdr} when is_record(Hdr, locate_request_header) ->
+ Reply = handle_locate_request(Env#giop_env{version = Version}, Hdr),
+ orber_socket:write(SocketType, Socket, Reply);
+ {Version, ReqHdr, Rest, Len, ByteOrder} when is_record(ReqHdr, request_header) ->
+ handle_request(Env#giop_env{version = Version}, ReqHdr, Rest, Len,
+ ByteOrder, SocketType, Socket, Message);
+ Other ->
+ %% This cluase takes care of all erranous messages.
+ orber:dbg("[~p] orber_iiop_inrequest:handle_message(~p)~n"
+ "Decoding Msg Header failed: ~p",
+ [?LINE, Message, Other], ?DEBUG_LEVEL),
+ Reply = cdr_encode:enc_message_error(Env),
+ orber_socket:write(SocketType, Socket, Reply),
+ message_error
+ end.
+
+
+send_reply(oneway, _SocketType, _Socket) ->
+ ok;
+send_reply(Reply, SocketType, Socket) ->
+ orber_socket:write(SocketType, Socket, Reply).
+
+%%-----------------------------------------------------------------
+%% Func: handle_request
+%%-----------------------------------------------------------------
+handle_request(#giop_env{interceptors = false} = Env, ReqHdr, Rest, Len, ByteOrder,
+ SocketType, Socket, Message) ->
+ NewEnv = check_context(ReqHdr#request_header.service_context, [], Env),
+ case decode_body(NewEnv, ReqHdr, Rest, Len, ByteOrder, Message, enc_reply) of
+ {error, E} ->
+ orber_socket:write(SocketType, Socket, E);
+ {NewEnv2, Hdr, Par, TypeCodes} ->
+ Result = invoke_request(Hdr, Par, SocketType, TypeCodes, Env),
+ Reply = evaluate(NewEnv2, Hdr, Result, TypeCodes,
+ enc_reply, 'no_exception'),
+ send_reply(Reply, SocketType, Socket)
+ end;
+handle_request(Env, ReqHdr, Rest, Len, ByteOrder, SocketType, Socket, Message) ->
+ NewEnv = check_context(ReqHdr#request_header.service_context, [], Env),
+ case catch call_interceptors(SocketType, NewEnv, ReqHdr,
+ Rest, Len, ByteOrder, Message) of
+ {error, E} ->
+ %% Failed to decode body.
+ orber_socket:write(SocketType, Socket, E);
+ {'EXCEPTION', Exc} ->
+ orber:dbg("[~p] orber_iiop_inrequest:handle_message(~p)~n"
+ "Invoking the interceptors resulted in: ~p",
+ [?LINE, Message, Exc], ?DEBUG_LEVEL),
+ Reply = marshal_exception(NewEnv,
+ ReqHdr#request_header.request_id,
+ Exc, enc_reply),
+ orber_socket:write(SocketType, Socket, Reply);
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_iiop_inrequest:handle_message(~p)~n"
+ "Invoking the interceptors resulted in: ~p",
+ [?LINE, ReqHdr, R], ?DEBUG_LEVEL),
+ Reply = marshal_exception(NewEnv,
+ ReqHdr#request_header.request_id,
+ #'MARSHAL'{completion_status=?COMPLETED_MAYBE},
+ enc_reply),
+ orber_socket:write(SocketType, Socket, Reply);
+ Reply ->
+ send_reply(Reply, SocketType, Socket)
+ end.
+
+check_context([], [], Env) ->
+ Env;
+check_context([], Acc, Env) ->
+ Env#giop_env{ctx = Acc};
+check_context([#'CSI_SASContextBody'
+ {label = ?CSI_MsgType_MTEstablishContext,
+ value = #'CSI_EstablishContext'
+ {client_context_id = _Id,
+ authorization_token = _AuthToken,
+ identity_token = _IdToken,
+ client_authentication_token = _CAuthToken}}|Rest], Acc, Env) ->
+ check_context(Rest, [#'IOP_ServiceContext'
+ {context_id=?IOP_SecurityAttributeService,
+ context_data = #'CSI_SASContextBody'
+ {label = ?CSI_MsgType_MTCompleteEstablishContext,
+ value = #'CSI_CompleteEstablishContext'
+ {client_context_id = 0,
+ context_stateful = false,
+ final_context_token = [0,255]}}}|Acc], Env);
+check_context([_|Rest], Acc, Env) ->
+ check_context(Rest, Acc, Env).
+
+
+%%-----------------------------------------------------------------
+%% Func: call_interceptors
+%%-----------------------------------------------------------------
+call_interceptors(SocketType, #giop_env{interceptors = {native, Ref, PIs},
+ ctx = Ctx} = Env,
+ ReqHdr, Rest, Len, ByteOrder, Msg) ->
+ NewRest = orber_pi:in_request_enc(PIs, ReqHdr, Ref, Rest),
+ case decode_body(Env, ReqHdr, NewRest, Len, ByteOrder, Msg, enc_reply) of
+ {NewEnv, Hdr, Par, TypeCodes} ->
+ NewPar = orber_pi:in_request(PIs, ReqHdr, Ref, Par),
+ ResultInv = invoke_request(Hdr, NewPar, SocketType, TypeCodes, NewEnv),
+ Result = orber_pi:out_reply(PIs, ReqHdr, Ref, ResultInv, Ctx),
+
+ case evaluate(NewEnv, ReqHdr, Result, TypeCodes, enc_reply_split,
+ 'no_exception') of
+ {ReplyHdr, Reply, HdrL, _BodyL, Flags} ->
+ NewReply = orber_pi:out_reply_enc(PIs, ReqHdr, Ref, Reply, Ctx),
+ MessSize = HdrL+size(NewReply),
+ cdr_encode:enc_giop_message_header(NewEnv, 'reply', Flags,
+ MessSize, [ReplyHdr|NewReply]);
+ Other ->
+ Other
+ end;
+ Other ->
+ Other
+ end;
+call_interceptors(SocketType, #giop_env{interceptors = {portable, _PIs}} = Env,
+ ReqHdr, Rest, Len, ByteOrder, Msg) ->
+ case decode_body(Env, ReqHdr, Rest, Len, ByteOrder, Msg, enc_reply) of
+ {NewEnv, Hdr, Par, TypeCodes} ->
+ Result = invoke_request(Hdr, Par, SocketType, TypeCodes, NewEnv),
+ evaluate(NewEnv, ReqHdr, Result, TypeCodes, enc_reply, 'no_exception');
+ Other ->
+ Other
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: call_interceptors_out
+%%-----------------------------------------------------------------
+call_interceptors_out(#giop_env{interceptors = {native, Ref, PIs}, ctx = Ctx} = Env,
+ ReqId, Result, Obj, Type, Operation, TypeCodes) ->
+ ReqHdr = #request_header{object_key = Obj,
+ service_context = Ctx,
+ response_expected = true,
+ request_id = ReqId,
+ operation = Operation},
+ NewResult = (catch orber_pi:out_reply(PIs, ReqHdr, Ref, Result, Ctx)),
+ {ReplyHdr, Reply, HdrL, _BodyL, Flags} =
+ evaluate(Env, ReqHdr, NewResult, TypeCodes, enc_reply_split, Type),
+ NewReply =
+ case catch orber_pi:out_reply_enc(PIs, ReqHdr, Ref, Reply, Ctx) of
+ {'EXCEPTION', Exception} ->
+ %% Since evaluate don't need TypeCodes or Status no need to supply
+ %% them.
+ evaluate(Env, ReqHdr, {'EXCEPTION', Exception}, undefined,
+ enc_reply_split, undefined);
+ {'EXIT', E} ->
+ orber:dbg("[~p] orber_iiop_inrequest:handle_location_forward(~p)~n"
+ "Resulted in exit: ~p", [?LINE, PIs, E], ?DEBUG_LEVEL),
+ marshal_exception(Env, ReqId,
+ #'MARSHAL'{completion_status=?COMPLETED_NO},
+ enc_reply);
+ R ->
+ R
+ end,
+ MessSize = HdrL+size(NewReply),
+ cdr_encode:enc_giop_message_header(Env, 'reply', Flags, MessSize,
+ [ReplyHdr|NewReply]);
+call_interceptors_out(#giop_env{interceptors = {portable, _PIs}} = Env,
+ ReqId, Result, _Obj, Type, _, TypeCodes) ->
+ Hdr = #request_header{response_expected = true,
+ request_id = ReqId},
+ evaluate(Env, Hdr, Result, TypeCodes, enc_reply, Type);
+call_interceptors_out(Env, ReqId, Result, _Obj, Type, _, TypeCodes) ->
+ Hdr = #request_header{response_expected = true,
+ request_id = ReqId},
+ evaluate(Env, Hdr, Result, TypeCodes, enc_reply, Type).
+
+
+%%-----------------------------------------------------------------
+%% Func: decode_body/2
+%%-----------------------------------------------------------------
+decode_body(#giop_env{version = Version} = Env, ReqHdr, Rest, Len,
+ ByteOrder, Message, Func) ->
+ case catch cdr_decode:dec_request_body(Version, ReqHdr, Rest, Len,
+ ByteOrder, Message) of
+ {NewVersion, ReqHdr, Par, TypeCodes} ->
+ {Env#giop_env{version = NewVersion}, ReqHdr, Par, TypeCodes};
+ {'EXCEPTION', E} ->
+ orber:dbg("[~p] orber_iiop_inrequest:decode_body(~p, ~p)~n"
+ "Failed decoding request body: ~p",
+ [?LINE, ReqHdr, Message, E], ?DEBUG_LEVEL),
+ {error, marshal_exception(Env, ReqHdr#request_header.request_id,
+ E, Func)};
+ Other ->
+ %% This cluase takes care of all erranous messages.
+ orber:dbg("[~p] orber_iiop_inrequest:decode_body(~p, ~p)~n"
+ "Failed decoding request body: ~p",
+ [?LINE, ReqHdr, Message, Other], ?DEBUG_LEVEL),
+ {error, marshal_exception(Env, ReqHdr#request_header.request_id,
+ #'MARSHAL'{completion_status=?COMPLETED_NO},
+ Func)}
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Func: handle_locate_request/2
+%%-----------------------------------------------------------------
+handle_locate_request(Env, {object_forward, Object, ReqId}) ->
+ case catch cdr_encode:enc_locate_reply(
+ Env#giop_env{request_id = ReqId,
+ tc = {'tk_objref', "", ""},
+ result = Object,
+ reply_status = 'object_forward'}) of
+ {'EXCEPTION', Exception} ->
+ orber:dbg("[~p] orber_iiop_inrequest:handle_locate_request(object_forward)~n"
+ "Raised the exception: ~p", [?LINE, Exception], ?DEBUG_LEVEL),
+ marshal_locate_exception(Env, ReqId, Exception);
+ {'EXIT', E} ->
+ orber:dbg("[~p] orber_iiop_inrequest:handle_locate_request(object_forward)~n"
+ "Resulted in exit: ~p", [?LINE, E], ?DEBUG_LEVEL),
+ marshal_locate_exception(Env, ReqId,
+ #'MARSHAL'{completion_status=?COMPLETED_NO});
+ R ->
+ R
+ end;
+handle_locate_request(Env, Hdr) ->
+ Location = orber_objectkeys:check(Hdr#locate_request_header.object_key),
+ case catch cdr_encode:enc_locate_reply(
+ Env#giop_env{request_id = Hdr#locate_request_header.request_id,
+ reply_status = Location}) of
+ {'EXCEPTION', Exception} ->
+ orber:dbg("[~p] orber_iiop_inrequest:handle_locate_request(~p)~n"
+ "Raised the exception: ~p",
+ [?LINE, Location, Exception], ?DEBUG_LEVEL),
+ marshal_locate_exception(Env, Hdr#locate_request_header.request_id, Exception);
+ {'EXIT', E} ->
+ orber:dbg("[~p] orber_iiop_inrequest:handle_locate_request(~p)~n"
+ "Resulted in exit: ~p", [?LINE, Location, E], ?DEBUG_LEVEL),
+ marshal_locate_exception(Env, Hdr#locate_request_header.request_id,
+ #'MARSHAL'{completion_status=?COMPLETED_NO});
+ R ->
+ R
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: invoke_request/2
+%%-----------------------------------------------------------------
+invoke_request(Hdr, Par, normal, TypeCodes, #giop_env{iiop_ssl_port = SSLPort,
+ partial_security = PartialSec}) ->
+ Result =
+ case SSLPort of
+ -1 ->
+ corba:request_from_iiop(Hdr#request_header.object_key,
+ Hdr#request_header.operation,
+ Par, [], Hdr#request_header.response_expected,
+ Hdr#request_header.service_context);
+ _ ->
+ case Hdr#request_header.object_key of
+ {_,registered,orber_init,_,_,_} ->
+ corba:request_from_iiop(Hdr#request_header.object_key,
+ Hdr#request_header.operation,
+ Par, [],
+ Hdr#request_header.response_expected,
+ Hdr#request_header.service_context);
+ {_,_,_,_,_,Flags} when PartialSec == true,
+ ?ORB_FLAG_TEST(Flags, ?ORB_NO_SECURITY) == true ->
+ corba:request_from_iiop(Hdr#request_header.object_key,
+ Hdr#request_header.operation,
+ Par, [],
+ Hdr#request_header.response_expected,
+ Hdr#request_header.service_context);
+ _ ->
+ orber:dbg("[~p] orber_iiop_inrequest:invoke_request(~p)~n"
+ "SSL do not permit",
+ [?LINE, Hdr#request_header.object_key], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'NO_PERMISSION'{completion_status=?COMPLETED_NO}}
+ end
+ end,
+ result_to_list(Result, TypeCodes);
+invoke_request(Hdr, Par, ssl, TypeCodes, _) ->
+ Result = corba:request_from_iiop(Hdr#request_header.object_key,
+ Hdr#request_header.operation,
+ Par, [], Hdr#request_header.response_expected,
+ Hdr#request_header.service_context),
+ result_to_list(Result, TypeCodes).
+
+%%-----------------------------------------------------------------
+%% Func: evaluate/4
+%%-----------------------------------------------------------------
+evaluate(_, Hdr,_,_,_,_) when Hdr#request_header.response_expected == 'false' ->
+ oneway;
+evaluate(Env, Hdr, _, _, Func, _)
+ when Hdr#request_header.response_expected == 'true_oneway' ->
+ %% Special case which only occurs when using IIOP-1.2
+ cdr_encode:Func(Env#giop_env{request_id = Hdr#request_header.request_id,
+ reply_status = 'no_exception',
+ tc = {tk_null,[],[]}, result = null});
+evaluate(Env, Hdr, {'EXCEPTION', Exc}, _, Func, _) ->
+ %% The exception can be user defined. Hence, we must check the result.
+ case catch marshal_exception(Env, Hdr#request_header.request_id, Exc, Func) of
+ {'EXCEPTION', Exception} ->
+ orber:dbg("[~p] orber_iiop_inrequest:evaluate(~p)~n"
+ "Encoding (reply) exception: ~p",
+ [?LINE, Hdr, Exception], ?DEBUG_LEVEL),
+ marshal_exception(Env, Hdr#request_header.request_id, Exception, Func);
+ {'EXIT', E} ->
+ orber:dbg("[~p] orber_iiop_inrequest:evaluate(~p)~n"
+ "Encode (reply) resulted in: ~p",
+ [?LINE, Hdr, E], ?DEBUG_LEVEL),
+ marshal_exception(Env, Hdr#request_header.request_id,
+ #'MARSHAL'{completion_status=?COMPLETED_YES}, Func);
+ R ->
+ R
+ end;
+evaluate(#giop_env{version = {1,2}} = Env, Hdr, {'location_forward_perm', NewIOR}, _,
+ Func, _)->
+ case catch cdr_encode:Func(#giop_env{version = {1,2},
+ request_id = Hdr#request_header.request_id,
+ reply_status = 'location_forward_perm',
+ tc = {{'tk_objref', "", ""}, [],[]},
+ result = NewIOR}) of
+ {'EXCEPTION', Exception} ->
+ orber:dbg("[~p] orber_iiop_inrequest:evaluate(~p) " ++
+ "Encoding (reply) exception: ~p",
+ [?LINE, Hdr, Exception], ?DEBUG_LEVEL),
+ marshal_exception(Env, Hdr#request_header.request_id, Exception, Func);
+ {'EXIT', E} ->
+ orber:dbg("[~p] orber_iiop_inrequest:evaluate(~p) " ++
+ "Encode (reply) resulted in: ~p",
+ [?LINE, Hdr, E], ?DEBUG_LEVEL),
+ marshal_exception(Env, Hdr#request_header.request_id,
+ #'MARSHAL'{completion_status=?COMPLETED_YES}, Func);
+ R ->
+ R
+ end;
+evaluate(Env, Hdr, [Res |OutPar], TypeCodes, Func, Type) ->
+ case catch cdr_encode:Func(Env#giop_env{request_id = Hdr#request_header.request_id,
+ reply_status = Type,
+ tc = TypeCodes, result = Res,
+ parameters = OutPar}) of
+ {'EXCEPTION', Exception} ->
+ orber:dbg("[~p] orber_iiop_inrequest:evaluate(~p, ~p, ~p)~n"
+ "Encode exception: ~p",
+ [?LINE, Hdr, Res, OutPar, Exception], ?DEBUG_LEVEL),
+ marshal_exception(Env, Hdr#request_header.request_id, Exception, Func);
+ {'EXIT', E} ->
+ orber:dbg("[~p] orber_iiop_inrequest:evaluate(~p, ~p, ~p)~n"
+ "Encode exit: ~p",
+ [?LINE, Hdr, Res, OutPar, E], ?DEBUG_LEVEL),
+ marshal_exception(Env, Hdr#request_header.request_id,
+ #'MARSHAL'{completion_status=?COMPLETED_YES}, Func);
+ R ->
+ R
+ end;
+evaluate(Env, Hdr, What, TypeCodes, Func, _) ->
+ orber:dbg("[~p] orber_iiop_inrequest:evaluate(~p)~n"
+ "Bad reply: ~p~n"
+ "Should be: ~p~n"
+ "GIOP Env : ~p", [?LINE, Hdr, What, TypeCodes, Env], ?DEBUG_LEVEL),
+ marshal_exception(Env, Hdr#request_header.request_id,
+ #'INTERNAL'{completion_status=?COMPLETED_MAYBE}, Func).
+
+%%-----------------------------------------------------------------
+%% Utility Functions
+%%-----------------------------------------------------------------
+result_to_list({'oe_location_forward_perm', NewIOR}, _) ->
+ {'location_forward_perm', NewIOR};
+result_to_list({'EXCEPTION', E}, _) ->
+ {'EXCEPTION', E};
+result_to_list(Result, {_TkRes, _, []}) ->
+ [Result];
+result_to_list(Result, {_TkRes, _, _TkOut}) ->
+ tuple_to_list(Result).
+
+marshal_exception(Env, Id, Exception, Func) ->
+ {TypeOfException, ExceptionTypeCode, NewExc} =
+ orber_exceptions:get_def(Exception),
+ cdr_encode:Func(Env#giop_env{request_id = Id,
+ reply_status = TypeOfException,
+ tc = {ExceptionTypeCode, [], []},
+ result = NewExc}).
+
+marshal_locate_exception(#giop_env{version = {1,2}} = Env, Id, Exception) ->
+ case orber_exceptions:get_def(Exception) of
+ {?SYSTEM_EXCEPTION, ExceptionTypeCode, NewExc} ->
+ cdr_encode:enc_locate_reply(
+ Env#giop_env{request_id = Id,
+ reply_status = 'loc_system_exception',
+ tc = ExceptionTypeCode, result = NewExc});
+ _ ->
+ %% This case is impossible (i.e. Orber only throws system
+ %% exceptions). But to be on the safe side...
+ marshal_locate_exception(Env, Id, #'MARSHAL'
+ {completion_status=?COMPLETED_YES})
+ end;
+marshal_locate_exception(Env, _Id, _Exception) ->
+ %% There is no way to define an exception for IIOP-1.0/1.1 in a
+ %% locate_reply.
+ cdr_encode:enc_message_error(Env).
diff --git a/lib/orber/src/orber_iiop_insup.erl b/lib/orber/src/orber_iiop_insup.erl
new file mode 100644
index 0000000000..713e1433e3
--- /dev/null
+++ b/lib/orber/src/orber_iiop_insup.erl
@@ -0,0 +1,85 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_iiop_insup.erl
+%%
+%% Description:
+%% This file contains the IIOP communication supervisor which
+%% holds all active "in proxies"
+%%
+%%-----------------------------------------------------------------
+-module(orber_iiop_insup).
+
+-behaviour(supervisor).
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start/2, start_connection/4]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([init/1, terminate/2]).
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: start/2
+%%-----------------------------------------------------------------
+start(sup, Opts) ->
+ supervisor:start_link({local, orber_iiop_insup}, orber_iiop_insup,
+ {sup, Opts});
+start(_A1, _A2) ->
+ ok.
+
+
+%%-----------------------------------------------------------------
+%% Server functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: init/1
+%%-----------------------------------------------------------------
+init({sup, _Opts}) ->
+ SupFlags = {simple_one_for_one, 500, 100},
+ ChildSpec = [
+ {name1, {orber_iiop_inproxy, start, []}, temporary,
+ 10000, worker, [orber_iiop_inproxy]}
+ ],
+ {ok, {SupFlags, ChildSpec}};
+init(_Opts) ->
+ {ok, []}.
+
+
+%%-----------------------------------------------------------------
+%% Func: terminate/1
+%%-----------------------------------------------------------------
+terminate(_Reason, _State) ->
+ ok.
+
+%%-----------------------------------------------------------------
+%% Func: start_connection/2
+%%-----------------------------------------------------------------
+start_connection(Type, Socket, Ref, ProxyOptions) ->
+ supervisor:start_child(orber_iiop_insup, [{connect, Type, Socket,
+ Ref, ProxyOptions}]).
+
diff --git a/lib/orber/src/orber_iiop_net.erl b/lib/orber/src/orber_iiop_net.erl
new file mode 100644
index 0000000000..58eba9f039
--- /dev/null
+++ b/lib/orber/src/orber_iiop_net.erl
@@ -0,0 +1,463 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_iiop_net.erl
+%%
+%% Description:
+%% This file contains the IIOP communication server
+%%
+%%-----------------------------------------------------------------
+-module(orber_iiop_net).
+
+-behaviour(gen_server).
+
+-include_lib("orber/src/orber_iiop.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start/1, connect/5, connections/0,
+ sockname2peername/2, peername2sockname/2,
+ add_connection/5,
+ add/3, remove/1, reconfigure/1, reconfigure/2]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([init/1, terminate/2, handle_call/3,
+ handle_cast/2, handle_info/2, code_change/3]).
+
+%%-----------------------------------------------------------------
+%% Server state record and definitions
+%%-----------------------------------------------------------------
+-define(CONNECTION_DB, orber_iiop_net_db).
+
+-record(state, {ports=[], max_connections, db, counter = 1, queue}).
+
+-record(connection, {pid, socket, type, peerdata, localdata, ref = 0}).
+
+-record(listen, {pid, socket, port, type, ref = 0, options, proxy_options = []}).
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: start/1
+%%-----------------------------------------------------------------
+start(Opts) ->
+ gen_server:start_link({local, orber_iiop_net}, orber_iiop_net, Opts, []).
+
+add(IP, normal, Options) ->
+ Port = orber_tb:keysearch(iiop_port, Options, orber_env:iiop_port()),
+ gen_server:call(orber_iiop_net, {add, IP, normal, Port, Options}, infinity);
+add(IP, ssl, Options) ->
+ Port = orber_tb:keysearch(iiop_ssl_port, Options, orber_env:iiop_ssl_port()),
+ gen_server:call(orber_iiop_net, {add, IP, ssl, Port, Options}, infinity).
+
+remove(Ref) ->
+ gen_server:call(orber_iiop_net, {remove, Ref}, infinity).
+
+reconfigure(Options) ->
+ lists:foreach(fun(P) ->
+ P ! {reconfigure, Options}
+ end,
+ do_select([{#connection{pid = '$1', _='_'},
+ [], ['$1']}])).
+
+reconfigure(Options, Ref) ->
+ case do_select([{#connection{ref = Ref, pid = '$1', _='_'},
+ [], ['$1']}]) of
+ [Pid] when is_pid(Pid) ->
+ Pid ! {reconfigure, Options},
+ ok;
+ _ ->
+ {error, "No proxy matched the supplied reference"}
+ end.
+
+connect(Type, S, AcceptPid, Ref, ProxyOptions) ->
+ gen_server:call(orber_iiop_net, {connect, Type, S, AcceptPid,
+ Ref, ProxyOptions}, infinity).
+
+connections() ->
+ do_select([{#connection{peerdata = '$1', _='_'}, [], ['$1']}]).
+
+sockname2peername(SockHost, SockPort) ->
+ do_select([{#connection{peerdata = '$1',
+ localdata = {match_type(SockHost),
+ match_type(SockPort)},
+ _='_'}, [], ['$1']}]).
+
+
+peername2sockname(PeerHost, PeerPort) ->
+ do_select([{#connection{peerdata = {match_type(PeerHost),
+ match_type(PeerPort)},
+ localdata = '$1',
+ _='_'}, [], ['$1']}]).
+
+do_select(Pattern) ->
+ case catch ets:select(?CONNECTION_DB, Pattern) of
+ {'EXIT', _What} ->
+ [];
+ Result ->
+ Result
+ end.
+
+match_type(0) ->
+ %% Wildcard port number
+ '_';
+match_type("") ->
+ %% Wildcard host
+ '_';
+match_type(Key) ->
+ %% Wildcard not used.
+ Key.
+
+add_connection(Socket, Type, PeerData, LocalData, Ref) ->
+ ets:insert(?CONNECTION_DB, #connection{pid = self(), socket = Socket,
+ type = Type, peerdata = PeerData,
+ localdata = LocalData, ref = Ref}).
+
+%%-----------------------------------------------------------------
+%% Server functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: init/1
+%%-----------------------------------------------------------------
+init(Options) ->
+ process_flag(trap_exit, true),
+ {ok, parse_options(Options,
+ #state{max_connections = orber:iiop_max_in_connections(),
+ db = ets:new(?CONNECTION_DB, [set, public,
+ named_table,
+ {keypos, 2}]),
+ queue = queue:new()})}.
+
+%%-----------------------------------------------------------------
+%% Func: terminate/1
+%%-----------------------------------------------------------------
+terminate(_Reason, _State) ->
+ ok.
+
+%%-----------------------------------------------------------------
+%% Func: parse_options/2
+%%-----------------------------------------------------------------
+get_options(normal, _Options) ->
+ [];
+get_options(ssl, Options) ->
+ Verify = orber_tb:keysearch(ssl_server_verify, Options,
+ orber_env:ssl_server_verify()),
+ Depth = orber_tb:keysearch(ssl_server_depth, Options,
+ orber_env:ssl_server_depth()),
+ Cert = orber_tb:keysearch(ssl_server_certfile, Options,
+ orber_env:ssl_server_certfile()),
+ CaCert = orber_tb:keysearch(ssl_server_cacertfile, Options,
+ orber_env:ssl_server_cacertfile()),
+ Pwd = orber_tb:keysearch(ssl_server_password, Options,
+ orber_env:ssl_server_password()),
+ Key = orber_tb:keysearch(ssl_server_keyfile, Options,
+ orber_env:ssl_server_keyfile()),
+ Ciphers = orber_tb:keysearch(ssl_server_ciphers, Options,
+ orber_env:ssl_server_ciphers()),
+ Timeout = orber_tb:keysearch(ssl_server_cachetimeout, Options,
+ orber_env:ssl_server_cachetimeout()),
+ [{verify, Verify},
+ {depth, Depth} |
+ ssl_server_extra_options([{certfile, Cert},
+ {cacertfile, CaCert},
+ {password, Pwd},
+ {keyfile, Key},
+ {ciphers, Ciphers},
+ {cachetimeout, Timeout}], [])].
+
+%%-----------------------------------------------------------------
+%% Func: parse_options/2
+%%-----------------------------------------------------------------
+parse_options([{port, Type, Port} | Rest], State) ->
+ Options = get_options(Type, []),
+ Options2 = case orber_env:ip_address_variable_defined() of
+ false ->
+ Options;
+ Host ->
+ IPVersion = orber:ip_version(),
+ {ok, IP} = inet:getaddr(Host, IPVersion),
+ [{ip, IP} | Options]
+ end,
+ {ok, Listen, NewPort} = orber_socket:listen(Type, Port, Options2, true),
+ {ok, Pid} = orber_iiop_socketsup:start_accept(Type, Listen, 0),
+ link(Pid),
+ ets:insert(?CONNECTION_DB, #listen{pid = Pid, socket = Listen,
+ port = NewPort, type = Type,
+ options = Options2}),
+ parse_options(Rest, State);
+parse_options([], State) ->
+ State.
+
+ssl_server_extra_options([], Acc) ->
+ Acc;
+ssl_server_extra_options([{_Type, []}|T], Acc) ->
+ ssl_server_extra_options(T, Acc);
+ssl_server_extra_options([{_Type, infinity}|T], Acc) ->
+ ssl_server_extra_options(T, Acc);
+ssl_server_extra_options([{Type, Value}|T], Acc) ->
+ ssl_server_extra_options(T, [{Type, Value}|Acc]).
+
+filter_options([], Acc) ->
+ Acc;
+filter_options([{verify, _}|T], Acc) ->
+ filter_options(T, Acc);
+filter_options([{depth, _}|T], Acc) ->
+ filter_options(T, Acc);
+filter_options([{certfile, _}|T], Acc) ->
+ filter_options(T, Acc);
+filter_options([{cacertfile, _}|T], Acc) ->
+ filter_options(T, Acc);
+filter_options([{password, _}|T], Acc) ->
+ filter_options(T, Acc);
+filter_options([{keyfile, _}|T], Acc) ->
+ filter_options(T, Acc);
+filter_options([{ciphers, _}|T], Acc) ->
+ filter_options(T, Acc);
+filter_options([{cachetimeout, _}|T], Acc) ->
+ filter_options(T, Acc);
+filter_options([H|T], Acc) ->
+ filter_options(T, [H|Acc]).
+
+%%-----------------------------------------------------------------
+%% Func: handle_call/3
+%%-----------------------------------------------------------------
+handle_call({remove, Ref}, _From, State) ->
+ case do_select([{#listen{ref = Ref, pid = '$1', socket = '$2',
+ type = '$3', _='_'}, [], [{{'$1', '$2', '$3'}}]}]) of
+ [{Pid, Listen, Type}|_] when is_pid(Pid) ->
+ unlink(Pid),
+ ets:delete(?CONNECTION_DB, Pid),
+ %% Just close the listen socket. Will cause the accept processs
+ %% to terminate.
+ orber_socket:close(Type, Listen),
+ stop_proxies(do_select([{#connection{ref = Ref, pid = '$1', _='_'},
+ [], ['$1']}])),
+ {reply, ok,
+ State#state{queue =
+ from_list(
+ lists:keydelete(Pid, 1,
+ queue:to_list(State#state.queue)))}};
+ _ ->
+ {reply, ok, State}
+ end;
+handle_call({add, IP, Type, Port, AllOptions}, _From, State) ->
+ Family = orber_env:ip_version(),
+ case inet:getaddr(IP, Family) of
+ {ok, IPTuple} ->
+ Options = [{ip, IPTuple}|get_options(Type, AllOptions)],
+ Ref = make_ref(),
+ ProxyOptions = filter_options(AllOptions, []),
+ case orber_socket:listen(Type, Port, Options, false) of
+ {ok, Listen, NewPort} ->
+ {ok, Pid} = orber_iiop_socketsup:start_accept(Type, Listen, Ref,
+ ProxyOptions),
+ link(Pid),
+ ets:insert(?CONNECTION_DB, #listen{pid = Pid,
+ socket = Listen,
+ port = NewPort,
+ type = Type, ref = Ref,
+ options = Options,
+ proxy_options = ProxyOptions}),
+ {reply, {ok, Ref}, State};
+ Error ->
+ {reply, Error, State}
+ end;
+ Other ->
+ {reply, Other, State}
+ end;
+handle_call({connect, Type, Socket, _AcceptPid, AccepRef, ProxyOptions}, _From, State)
+ when State#state.max_connections == infinity;
+ State#state.max_connections > State#state.counter ->
+ case catch access_allowed(Type, Socket, Type) of
+ true ->
+ case orber_iiop_insup:start_connection(Type, Socket,
+ AccepRef, ProxyOptions) of
+ {ok, Pid} when is_pid(Pid) ->
+ link(Pid),
+ {reply, {ok, Pid, true}, update_counter(State, 1)};
+ Other ->
+ {reply, Other, State}
+ end;
+ _ ->
+ {H, P} = orber_socket:peerdata(Type, Socket),
+ orber_tb:info("Blocked connect attempt from ~s - ~p", [H, P]),
+ {reply, denied, State}
+ end;
+handle_call({connect, Type, Socket, AcceptPid, AccepRef, ProxyOptions}, _From,
+ #state{queue = Q} = State) ->
+ case catch access_allowed(Type, Socket, Type) of
+ true ->
+ case orber_iiop_insup:start_connection(Type, Socket,
+ AccepRef, ProxyOptions) of
+ {ok, Pid} when is_pid(Pid) ->
+ link(Pid),
+ Ref = erlang:make_ref(),
+ {reply, {ok, Pid, Ref},
+ update_counter(State#state{queue =
+ queue:in({AcceptPid, Ref}, Q)}, 1)};
+ Other ->
+ {reply, Other, State}
+ end;
+ _ ->
+ {H, P} = orber_socket:peerdata(Type, Socket),
+ orber_tb:info("Blocked connect attempt from ~s - ~p", [H, P]),
+ {reply, denied, State}
+ end;
+handle_call(_, _, State) ->
+ {noreply, State}.
+
+stop_proxies([H|T]) ->
+ catch orber_iiop_inproxy:stop(H),
+ stop_proxies(T);
+stop_proxies([]) ->
+ ok.
+
+access_allowed(Type, Socket, Type) ->
+ Flags = orber:get_flags(),
+ case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_USE_ACL_INCOMING) of
+ false ->
+ true;
+ true ->
+ SearchFor =
+ case Type of
+ normal ->
+ tcp_in;
+ ssl ->
+ ssl_in
+ end,
+ {ok, {Host, Port}} = orber_socket:peername(Type, Socket),
+ case orber_acl:match(Host, SearchFor, true) of
+ {true, [], 0} ->
+ true;
+ {true, [], Port} ->
+ true;
+ {true, [], {Min, Max}} when Port >= Min, Port =< Max ->
+ true;
+ {true, Interfaces, 0} ->
+ get_sockethost(Type, Socket),
+ lists:member(get_sockethost(Type, Socket), Interfaces);
+ {true, Interfaces, Port} ->
+ lists:member(get_sockethost(Type, Socket), Interfaces);
+ {true, Interfaces, {Min, Max}} when Port >= Min, Port =< Max ->
+ lists:member(get_sockethost(Type, Socket), Interfaces);
+ _ ->
+ false
+ end
+ end.
+
+get_sockethost(Type, Socket) ->
+ case orber_socket:peername(Type, Socket) of
+ {ok, {Addr, _Port}} ->
+ orber_env:addr2str(Addr);
+ _ ->
+ false
+ end.
+
+%%------------------------------------------------------------
+%% Standard gen_server cast handle
+%%------------------------------------------------------------
+handle_cast(_, State) ->
+ {noreply, State}.
+
+%%------------------------------------------------------------
+%% Standard gen_server handles
+%%------------------------------------------------------------
+handle_info({'EXIT', Pid, _Reason}, State) when is_pid(Pid) ->
+ case ets:lookup(?CONNECTION_DB, Pid) of
+ [#listen{pid = Pid, socket = Listen, port = Port, type = Type,
+ ref = Ref, options = Options, proxy_options = POpts}] ->
+ ets:delete(?CONNECTION_DB, Pid),
+ unlink(Pid),
+ NewListen = new_listen_socket(Type, Listen, Port, Options),
+ {ok, NewPid} = orber_iiop_socketsup:start_accept(Type, NewListen,
+ Ref, POpts),
+ link(NewPid),
+ ets:insert(?CONNECTION_DB, #listen{pid = NewPid, socket = NewListen,
+ port = Port, type = Type,
+ ref = Ref, options = Options,
+ proxy_options = POpts}),
+ %% Remove the connection if it's in the queue.
+ {noreply,
+ State#state{queue =
+ from_list(
+ lists:keydelete(Pid, 1,
+ queue:to_list(State#state.queue)))}};
+ [#connection{pid = Pid}] ->
+ ets:delete(?CONNECTION_DB, Pid),
+ unlink(Pid),
+ case queue:out(State#state.queue) of
+ {empty, _} ->
+ {noreply, update_counter(State, -1)};
+ {{value, {AcceptPid, Ref}}, Q} ->
+ AcceptPid ! {Ref, ok},
+ {noreply, update_counter(State#state{queue = Q}, -1)}
+ end;
+ [] ->
+ {noreply, State}
+ end;
+handle_info(_, State) ->
+ {noreply, State}.
+
+new_listen_socket(normal, ListenFd, _Port, _Options) ->
+ ListenFd;
+new_listen_socket(ssl, ListenFd, Port, Options) ->
+ Generation = orber_env:ssl_generation(),
+ if
+ Generation > 2 ->
+ ListenFd;
+ true ->
+ case is_process_alive(ssl:pid(ListenFd)) of
+ true ->
+ ListenFd;
+ _ ->
+ {ok, Listen, _NP} = orber_socket:listen(ssl, Port, Options, true),
+ Listen
+ end
+ end.
+
+from_list(List) ->
+ from_list(List, queue:new()).
+
+from_list([], Q) ->
+ Q;
+from_list([H|T], Q) ->
+ NewQ = queue:in(H, Q),
+ from_list(T, NewQ).
+
+
+%%-----------------------------------------------------------------
+%% Func: code_change/3
+%%-----------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%-----------------------------------------------------------------
+%% Internal Functions
+%%-----------------------------------------------------------------
+update_counter(#state{max_connections = infinity} = State, _) ->
+ State;
+update_counter(State, Value) ->
+ State#state{counter = State#state.counter + Value}.
+
diff --git a/lib/orber/src/orber_iiop_net_accept.erl b/lib/orber/src/orber_iiop_net_accept.erl
new file mode 100644
index 0000000000..03443e3d5c
--- /dev/null
+++ b/lib/orber/src/orber_iiop_net_accept.erl
@@ -0,0 +1,94 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_iiop_net_accept.erl
+%%
+%% Description:
+%% This file contains the process which are waiting in accept for new
+%% connections.
+%%
+%%
+%%-----------------------------------------------------------------
+-module(orber_iiop_net_accept).
+
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start/4]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([net_accept/5]).
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: start/2
+%%-----------------------------------------------------------------
+start(Type, Listen, Ref, ProxyOptions) ->
+ Pid = proc_lib:spawn_link(?MODULE, net_accept,
+ [Type, Listen, self(), Ref, ProxyOptions]),
+ {ok, Pid}.
+
+%%-----------------------------------------------------------------
+%% Internal Functions
+%%-----------------------------------------------------------------
+
+%%-----------------------------------------------------------------
+%% Func: net_accept/3
+%%-----------------------------------------------------------------
+net_accept(Type, ListenFd, Parent, Ref, ProxyOptions) ->
+ case catch orber_socket:accept(Type, ListenFd) of
+ {'EXCEPTION', _E} ->
+ ok;
+ S ->
+ case orber_iiop_net:connect(Type, S, self(), Ref, ProxyOptions) of
+ {ok, Pid, ReadyToGo} ->
+ case orber_socket:controlling_process(Type, S, Pid) of
+ ok ->
+ orber_iiop_inproxy:post_accept(Pid, Type, S);
+ _Reason ->
+ orber_socket:close(Type, S),
+ gen_server:cast(Pid, stop),
+ orber_socket:clear(Type, S)
+ end,
+ ready_to_go(ReadyToGo);
+ denied ->
+ orber_socket:close(Type, S),
+ orber_socket:clear(Type, S);
+ _ ->
+ orber_socket:close(Type, S),
+ orber_socket:clear(Type, S)
+ end,
+ net_accept(Type, ListenFd, Parent, Ref, ProxyOptions)
+ end.
+
+ready_to_go(true) ->
+ ok;
+ready_to_go(Ref) ->
+ receive
+ {Ref, ok} ->
+ ok
+ end.
+
diff --git a/lib/orber/src/orber_iiop_outproxy.erl b/lib/orber/src/orber_iiop_outproxy.erl
new file mode 100644
index 0000000000..879af8222d
--- /dev/null
+++ b/lib/orber/src/orber_iiop_outproxy.erl
@@ -0,0 +1,530 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_iiop_outproxy.erl
+%%
+%% Description:
+%% This file contains the IIOP "proxy" for outgoing connections
+%%
+%%
+%%-----------------------------------------------------------------
+-module(orber_iiop_outproxy).
+
+-behaviour(gen_server).
+
+-include_lib("orber/src/orber_iiop.hrl").
+-include_lib("orber/include/corba.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start/0, start/1, request/5, cancel/2, cancel/3]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ code_change/3, terminate/2, stop/2, stop/1, checkheaders/1]).
+
+%%-----------------------------------------------------------------
+%% Macros/Defines
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 7).
+
+-record(state, {stype, socket, db, timeout, client_timeout, host, port, parent,
+ error_reason = {'EXCEPTION', #'COMM_FAILURE'
+ {completion_status=?COMPLETED_MAYBE}}}).
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+start() ->
+ ignore.
+
+start(Opts) ->
+ gen_server:start_link(orber_iiop_outproxy, Opts, []).
+
+request(Pid, true, Timeout, Msg, RequestId) ->
+ %% Why not simply use gen_server:call? We must be able to receive
+ %% more than one reply (i.e. fragmented messages).
+ MRef = erlang:monitor(process, Pid),
+ gen_server:cast(Pid, {request, Timeout, Msg, RequestId, self(), MRef}),
+ receive
+ {MRef, Reply} ->
+ erlang:demonitor(MRef),
+ receive
+ {'DOWN', MRef, _, _, _} ->
+ Reply
+ after 0 ->
+ Reply
+ end;
+ {'DOWN', MRef, _, Pid, _Reason} when is_pid(Pid) ->
+ receive
+ %% Clear EXIT message from queue
+ {'EXIT', _Pid, _What} ->
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_MAYBE})
+ after 0 ->
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_MAYBE})
+ end;
+ {fragmented, GIOPHdr, Bytes, RequestId, MRef} ->
+ collect_fragments(GIOPHdr, [], Bytes, Pid, RequestId, MRef)
+ end;
+request(Pid, _, _, Msg, _RequestId) ->
+ %% No response expected
+ gen_server:cast(Pid, {oneway_request, Msg}).
+
+cancel(Pid, RequestId) ->
+ gen_server:cast(Pid, {cancel, RequestId}).
+
+cancel(Pid, RequestId, MRef) ->
+ gen_server:cast(Pid, {cancel, RequestId, MRef, self()}).
+
+%%-----------------------------------------------------------------
+%% Internal interface functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: stop/2
+%%-----------------------------------------------------------------
+stop(Pid, Timeout) ->
+ gen_server:call(Pid, stop, Timeout).
+stop(Pid) ->
+ gen_server:cast(Pid, stop).
+
+
+%%-----------------------------------------------------------------
+%% Server functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: init/1
+%%-----------------------------------------------------------------
+init({connect, Host, Port, SocketType, SocketOptions, Parent, Key, NewKey}) ->
+ process_flag(trap_exit, true),
+ case catch orber_socket:connect(SocketType, Host, Port, SocketOptions) of
+ {'EXCEPTION', _E} ->
+ ignore;
+ %% We used to reply the below but since this would generate a CRASH REPORT
+ %% if '-boot start_sasl' used. Due to a request to change this behaviour
+ %% we did.
+ %% {stop, {'EXCEPTION', E}};
+ Socket ->
+ SockData = orber_socket:sockdata(SocketType, Socket),
+ orber_iiop_pm:add_connection(Key, NewKey, SockData),
+ Timeout = orber:iiop_connection_timeout(),
+ {ok, #state{stype = SocketType, socket = Socket,
+ db = ets:new(orber_outgoing_requests, [set]),
+ timeout = Timeout, client_timeout = orber:iiop_timeout(),
+ host = Host, port = Port, parent = Parent}, Timeout}
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: terminate/2
+%%-----------------------------------------------------------------
+terminate(_Reason, #state{db = OutRequests, error_reason = ER}) ->
+ %% Kill all proxies and delete table before terminating
+ notify_clients(OutRequests, ets:first(OutRequests), ER),
+ ets:delete(OutRequests),
+ ok.
+
+notify_clients(_, '$end_of_table', _ER) ->
+ ok;
+notify_clients(OutRequests, Key, ER) ->
+ case ets:lookup(OutRequests, Key) of
+ [{_, Pid, TRef, MRef}] ->
+ cancel_timer(TRef),
+ Pid ! {MRef, ER},
+ notify_clients(OutRequests, ets:next(OutRequests, Key), ER)
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: handle_call/3
+%%-----------------------------------------------------------------
+handle_call(stop, _From, State) ->
+ {stop, normal, ok, State};
+handle_call(X, From, State) ->
+ orber:dbg("[~p] orber_iiop_outproxy:handle_call(~p);~n"
+ "Un-recognized call from ~p", [?LINE, X, From], ?DEBUG_LEVEL),
+ {noreply, State, State#state.timeout}.
+
+%%-----------------------------------------------------------------
+%% Func: handle_cast/2
+%%-----------------------------------------------------------------
+handle_cast({request, Timeout, Msg, RequestId, From, MRef},
+ #state{client_timeout = DefaultTimeout} = State) ->
+ orber_socket:write(State#state.stype, State#state.socket, Msg),
+ true = ets:insert(State#state.db, {RequestId, From,
+ start_timer(Timeout, DefaultTimeout, RequestId),
+ MRef}),
+ {noreply, State, State#state.timeout};
+handle_cast({oneway_request, Msg}, State) ->
+ orber_socket:write(State#state.stype, State#state.socket, Msg),
+ {noreply, State, State#state.timeout};
+handle_cast({cancel, ReqId}, State) ->
+ case ets:lookup(State#state.db, ReqId) of
+ [{ReqId, _From, TRef, _MRef}] ->
+ cancel_timer(TRef),
+ ets:delete(State#state.db, ReqId),
+ orber:dbg("[~p] orber_iiop_outproxy:handle_info(~p);~n"
+ "Request cancelled", [?LINE, State], ?DEBUG_LEVEL),
+ {noreply, State, State#state.timeout};
+ _ ->
+ {noreply, State, State#state.timeout}
+ end;
+handle_cast({cancel, ReqId, MRef, From}, State) ->
+ case ets:lookup(State#state.db, ReqId) of
+ [{ReqId, From, TRef, MRef}] ->
+ cancel_timer(TRef),
+ ets:delete(State#state.db, ReqId),
+ From ! {MRef, ReqId, cancelled},
+ orber:dbg("[~p] orber_iiop_outproxy:handle_info(~p);
+Request cancelled", [?LINE, State], ?DEBUG_LEVEL),
+ {noreply, State, State#state.timeout};
+ _ ->
+ From ! {MRef, ReqId, cancelled},
+ {noreply, State, State#state.timeout}
+ end;
+handle_cast(stop, State) ->
+ {stop, normal, State};
+handle_cast(X, State) ->
+ orber:dbg("[~p] orber_iiop_outproxy:handle_cast(~p);
+Un-recognized cast.", [?LINE, X], ?DEBUG_LEVEL),
+ {noreply, State, State#state.timeout}.
+
+%%-----------------------------------------------------------------
+%% Func: handle_info/2
+%%-----------------------------------------------------------------
+handle_info({tcp, _Socket, Bytes}, State) ->
+ handle_reply(Bytes, State);
+handle_info({ssl, _Socket, Bytes}, State) ->
+ handle_reply(Bytes, State);
+handle_info({tcp_closed, _Socket}, State) ->
+ {stop, normal, State};
+handle_info({ssl_closed, _Socket}, State) ->
+ {stop, normal, State};
+handle_info({tcp_error, Socket, Reason}, #state{socket = Socket, host = Host,
+ port = Port} = State) ->
+ orber:error("[~p] IIOP proxy received the TCP error message: ~p~n"
+ "The server-side ORB is located at '~p:~p'~n"
+ "See the gen_tcp/inet documentation for more information.",
+ [?LINE, Reason, Host, Port], ?DEBUG_LEVEL),
+ {stop, normal, State};
+handle_info({ssl_error, Socket, Reason}, #state{socket = Socket, host = Host,
+ port = Port} = State) ->
+ orber:error("[~p] IIOP proxy received the SSL error message: ~p~n"
+ "The server-side ORB is located at '~p:~p'~n"
+ "See the SSL-application documentation for more information.",
+ [?LINE, Reason, Host, Port], ?DEBUG_LEVEL),
+ {stop, normal, State};
+handle_info({timeout, _TRef, ReqId}, State) ->
+ case ets:lookup(State#state.db, ReqId) of
+ [{ReqId, Pid, _, MRef}] ->
+ ets:delete(State#state.db, ReqId),
+ Pid ! {MRef, {'EXCEPTION', #'TIMEOUT'{completion_status=?COMPLETED_MAYBE}}},
+ orber:dbg("[~p] orber_iiop_outproxy:handle_info(~p, ~p);~n"
+ "Request timed out",
+ [?LINE, State#state.host, State#state.port], ?DEBUG_LEVEL),
+ {noreply, State, State#state.timeout};
+ _ ->
+ {noreply, State, State#state.timeout}
+ end;
+handle_info(stop, State) ->
+ {stop, normal, State};
+handle_info(timeout, State) ->
+ case ets:info(State#state.db, size) of
+ 0 ->
+ orber:dbg("[~p] orber_iiop_outproxy:handle_info(~p, ~p);~n"
+ "Outgoing connection timed out after ~p msec",
+ [?LINE, State#state.host, State#state.port,
+ State#state.timeout], ?DEBUG_LEVEL),
+ {stop, normal, State};
+ _Amount ->
+ %% Still pending request, cannot close the connection.
+ {noreply, State, State#state.timeout}
+ end;
+handle_info({'EXIT', Parent, Reason}, #state{parent = Parent} = State) ->
+ orber:dbg("[~p] orber_iiop_outproxy:handle_info(~p);~nParent terminated.",
+ [?LINE, Reason], ?DEBUG_LEVEL),
+ {stop, normal, State};
+handle_info({reconfigure, _Options}, State) ->
+ %% Currently there are no parameters that can be changed.
+ {noreply, State, State#state.timeout};
+handle_info(X, State) ->
+ orber:dbg("[~p] orber_iiop_outproxy:handle_info(~p);~nUn-recognized info.",
+ [?LINE, X], ?DEBUG_LEVEL),
+ {noreply, State, State#state.timeout}.
+
+
+handle_reply(Bytes, State) ->
+ %% Check IIOP headers and fetch request id
+ case catch checkheaders(cdr_decode:dec_giop_message_header(Bytes)) of
+ {'reply', ReplyHeader, Rest, Len, ByteOrder} ->
+ case ets:lookup(State#state.db, ReplyHeader#reply_header.request_id) of
+ [{_, Pid, TRef, MRef}] ->
+ %% Send reply to the correct request process
+ cancel_timer(TRef),
+ Pid ! {MRef, {reply, ReplyHeader, Rest, Len, ByteOrder, Bytes}},
+ ets:delete(State#state.db, ReplyHeader#reply_header.request_id),
+ {noreply, State, State#state.timeout};
+ _ ->
+ {noreply, State, State#state.timeout}
+ end;
+ {'locate_reply', LocateReplyHeader, LocateRest, LocateLen, LocateByteOrder} ->
+ case ets:lookup(State#state.db,
+ LocateReplyHeader#locate_reply_header.request_id) of
+ [{_, Pid, TRef, MRef}] ->
+ %% Send reply to the correct request process
+ cancel_timer(TRef),
+ Pid ! {MRef, {locate_reply, LocateReplyHeader,
+ LocateRest, LocateLen, LocateByteOrder}},
+ ets:delete(State#state.db,
+ LocateReplyHeader#locate_reply_header.request_id),
+ {noreply, State, State#state.timeout};
+ _ ->
+ {noreply, State, State#state.timeout}
+ end;
+ {fragment, GIOPHdr, ReqId, false} ->
+ %% Last fragment, cancel timer and remove from DB.
+ case ets:lookup(State#state.db, ReqId) of
+ [{_, Pid, TRef, MRef}] ->
+ cancel_timer(TRef),
+ Pid ! {fragment, GIOPHdr, ReqId, MRef},
+ ets:delete(State#state.db, ReqId),
+ {noreply, State, State#state.timeout};
+ _ ->
+ %% Probably cancelled
+ {noreply, State, State#state.timeout}
+ end;
+ {fragment, GIOPHdr, ReqId, _} ->
+ %% More fragments expected
+ case ets:lookup(State#state.db, ReqId) of
+ [{_, Pid, _, MRef}] ->
+ Pid ! {fragment, GIOPHdr, ReqId, MRef},
+ {noreply, State, State#state.timeout};
+ _ ->
+ %% Probably cancelled
+ {noreply, State, State#state.timeout}
+ end;
+ {fragmented, GIOPHdr, ReqId} ->
+ %% This the initial message (i.e. a LocateReply or Reply).
+ case ets:lookup(State#state.db, ReqId) of
+ [{_, Pid, _TRef, MRef}] ->
+ Pid ! {fragmented, GIOPHdr, Bytes, ReqId, MRef},
+ {noreply, State, State#state.timeout};
+ _ ->
+ {noreply, State, State#state.timeout}
+ end;
+ {'EXCEPTION', DecodeException} ->
+ orber:dbg("[~p] orber_iiop_outproxy:handle_reply(~p); decode exception(~p).",
+ [?LINE, Bytes, DecodeException], ?DEBUG_LEVEL),
+ {noreply, State, State#state.timeout};
+ {'EXIT', message_error} ->
+ orber:dbg("[~p] orber_iiop_outproxy:handle_reply(~p); message error.",
+ [?LINE, Bytes], ?DEBUG_LEVEL),
+ ME = cdr_encode:enc_message_error(#giop_env{version =
+ orber:giop_version()}),
+ orber_socket:write(State#state.stype, State#state.socket, ME),
+ {noreply, State, State#state.timeout};
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_iiop_outproxy:handle_reply(~p); got exit(~p)",
+ [?LINE, Bytes, R], ?DEBUG_LEVEL),
+ {noreply, State, State#state.timeout};
+ close_connection ->
+ orber:dbg("[~p] orber_iiop_outproxy:handle_reply();
+The Server-side ORB closed the connection.", [?LINE], ?DEBUG_LEVEL),
+ {stop, normal, State};
+ {error, no_reply} ->
+ {noreply, State, State#state.timeout};
+ X ->
+ orber:dbg("[~p] orber_iiop_outproxy:handle_reply(~p); message error(~p).",
+ [?LINE, Bytes, X], ?DEBUG_LEVEL),
+ {noreply, State, State#state.timeout}
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Func: code_change/3
+%%-----------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%-----------------------------------------------------------------
+%% Internal functions
+%%-----------------------------------------------------------------
+checkheaders(#giop_message{message_type = ?GIOP_MSG_CLOSE_CONNECTION}) ->
+ close_connection;
+checkheaders(#giop_message{message_type = ?GIOP_MSG_FRAGMENT,
+ giop_version = {1,2},
+ fragments = MoreFrag} = GIOPHdr) ->
+ %% A fragment; we must have received a Request or LocateRequest
+ %% with fragment-flag set to true.
+ %% We need to decode the header to get the request-id.
+ ReqId = cdr_decode:peek_request_id(GIOPHdr#giop_message.byte_order,
+ GIOPHdr#giop_message.message),
+ {fragment, GIOPHdr, ReqId, MoreFrag};
+checkheaders(#giop_message{fragments = true,
+ giop_version = {1,2}} = GIOPHdr) ->
+ %% Must be a Reply or LocateReply which have been fragmented.
+ %% We need to decode the header to get the request-id.
+ ReqId = cdr_decode:peek_request_id(GIOPHdr#giop_message.byte_order,
+ GIOPHdr#giop_message.message),
+ {fragmented, GIOPHdr, ReqId};
+checkheaders(#giop_message{fragments = false,
+ message_type = ?GIOP_MSG_REPLY} = GIOPHdr) ->
+ {ReplyHeader, Rest, Len} =
+ cdr_decode:dec_reply_header(GIOPHdr#giop_message.giop_version,
+ GIOPHdr#giop_message.message,
+ ?GIOP_HEADER_SIZE,
+ GIOPHdr#giop_message.byte_order),
+ {'reply', ReplyHeader, Rest, Len, GIOPHdr#giop_message.byte_order};
+checkheaders(#giop_message{fragments = false,
+ message_type = ?GIOP_MSG_LOCATE_REPLY} = GIOPHdr) ->
+ {LocateReplyHeader, Rest, Len} =
+ cdr_decode:dec_locate_reply_header(GIOPHdr#giop_message.giop_version,
+ GIOPHdr#giop_message.message,
+ ?GIOP_HEADER_SIZE,
+ GIOPHdr#giop_message.byte_order),
+ {'locate_reply', LocateReplyHeader, Rest, Len, GIOPHdr#giop_message.byte_order};
+checkheaders(What) ->
+ orber:dbg("[~p] orber_iiop_outproxy:checkheaders(~p)
+Un-recognized GIOP header.", [?LINE, What], ?DEBUG_LEVEL),
+ {error, no_reply}.
+
+
+cancel_timer(infinity) ->
+ ok;
+cancel_timer(TRef) ->
+ erlang:cancel_timer(TRef).
+
+start_timer(infinity, infinity, _) ->
+ infinity;
+start_timer(infinity, Timeout, RequestId) ->
+ erlang:start_timer(Timeout, self(), RequestId);
+start_timer(Timeout, _, RequestId) ->
+ erlang:start_timer(Timeout, self(), RequestId).
+
+
+
+collect_fragments(GIOPHdr1, InBuffer, Bytes, Proxy, RequestId, MRef) ->
+ receive
+ %% There are more framents to come; just collect this message and wait for
+ %% the rest.
+ {fragment, #giop_message{byte_order = _ByteOrder,
+ message = Message,
+ fragments = true} = GIOPHdr2, RequestId, MRef} ->
+ case catch cdr_decode:dec_message_header(null, GIOPHdr2, Message) of
+ {_, #fragment_header{}, FragBody, _, _} ->
+ collect_fragments(GIOPHdr1, [FragBody|InBuffer],
+ Bytes, Proxy, RequestId, MRef);
+ Other ->
+ cancel(Proxy, RequestId, MRef),
+ clear_queue(Proxy, RequestId, MRef),
+ orber:dbg("[~p] orber_iiop:collect_fragments(~p)",
+ [?LINE, Other], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 18),
+ completion_status=?COMPLETED_YES})
+ end;
+ %% This is the last fragment. Now we can but together the fragments, decode
+ %% the reply and send it to the client.
+ {fragment, #giop_message{byte_order = ByteOrder,
+ message = Message} = GIOPHdr2, RequestId, MRef} ->
+ erlang:demonitor(MRef),
+ receive
+ {'DOWN', MRef, _, _, _} ->
+ ok
+ after 0 ->
+ ok
+ end,
+ case catch cdr_decode:dec_message_header(null, GIOPHdr2, Message) of
+ {_, #fragment_header{}, FragBody, _, _} ->
+ %% This buffer is all the fragments concatenated.
+ Buffer = lists:reverse([FragBody|InBuffer]),
+
+ %% Create a GIOP-message which is exactly as if hadn't been fragmented.
+ NewGIOP = GIOPHdr1#giop_message
+ {message = list_to_binary([GIOPHdr1#giop_message.message|Buffer]),
+ fragments = false},
+ case checkheaders(NewGIOP) of
+ {'reply', ReplyHeader, Rest, Len, ByteOrder} ->
+ %% We must keep create a copy of all bytes, as if the
+ %% message wasn't fragmented, to be able handle TypeCode
+ %% indirection.
+ {'reply', ReplyHeader, Rest, Len, ByteOrder,
+ list_to_binary([Bytes|Buffer])};
+ {'locate_reply', ReplyHdr, Rest, Len, ByteOrder} ->
+ {'locate_reply', ReplyHdr, Rest, Len, ByteOrder};
+ Error ->
+ orber:dbg("[~p] orber_iiop:collect_fragments(~p, ~p);
+Unable to decode Reply or LocateReply header",[?LINE, NewGIOP, Error], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 18),
+ completion_status=?COMPLETED_YES})
+ end;
+ Other ->
+ orber:dbg("[~p] orber_iiop:collect_fragments(~p);",
+ [?LINE, Other], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 18),
+ completion_status=?COMPLETED_YES})
+ end;
+ {MRef, {'EXCEPTION', E}} ->
+ orber:dbg("[~p] orber_iiop:collect_fragments(~p);",
+ [?LINE, E], ?DEBUG_LEVEL),
+ erlang:demonitor(MRef),
+ receive
+ {'DOWN', MRef, _, _, _} ->
+ corba:raise(E)
+ after 0 ->
+ corba:raise(E)
+ end;
+ {'DOWN', MRef, _, Proxy, Reason} when is_pid(Proxy) ->
+ orber:dbg("[~p] orber_iiop:collect_fragments(~p);~n"
+ "Monitor generated a DOWN message.",
+ [?LINE, Reason], ?DEBUG_LEVEL),
+ receive
+ %% Clear EXIT message from queue
+ {'EXIT', _Proxy, _What} ->
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_MAYBE})
+ after 0 ->
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_MAYBE})
+ end
+ end.
+
+clear_queue(Proxy, RequestId, MRef) ->
+ receive
+ {fragment, _, RequestId, MRef} ->
+ clear_queue(Proxy, RequestId, MRef);
+ {MRef, RequestId, cancelled} ->
+ %% This is the last message that the proxy will send
+ %% after we've cancelled the request.
+ erlang:demonitor(MRef),
+ receive
+ {'DOWN', MRef, _, _, _} ->
+ ok
+ after 0 ->
+ ok
+ end;
+ {'DOWN', MRef, _, Proxy, _Reason} ->
+ %% The proxy terminated. Clear EXIT message from queue
+ receive
+ {'EXIT', Proxy, _What} ->
+ ok
+ after 0 ->
+ ok
+ end
+ end.
+
diff --git a/lib/orber/src/orber_iiop_outsup.erl b/lib/orber/src/orber_iiop_outsup.erl
new file mode 100644
index 0000000000..24432b3a82
--- /dev/null
+++ b/lib/orber/src/orber_iiop_outsup.erl
@@ -0,0 +1,87 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_iiop_outsup.erl
+%%
+%% Description:
+%% This file contains the outgoing IIOP communication supervisor which
+%% holds all active "proxies"
+%%
+%%-----------------------------------------------------------------
+-module(orber_iiop_outsup).
+
+-behaviour(supervisor).
+
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start/2, connect/7]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([init/1, terminate/2]).
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: start/2
+%%-----------------------------------------------------------------
+start(sup, Opts) ->
+ supervisor:start_link({local, orber_iiop_outsup}, orber_iiop_outsup,
+ {sup, Opts});
+start(_A1, _A2) ->
+ ok.
+
+
+%%-----------------------------------------------------------------
+%% Server functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: init/1
+%%-----------------------------------------------------------------
+init({sup, _Opts}) ->
+ SupFlags = {simple_one_for_one, 500, 100},
+ ChildSpec = [
+ {name2, {orber_iiop_outproxy, start, []}, temporary,
+ 10000, worker, [orber_iiop_outproxy]}
+ ],
+ {ok, {SupFlags, ChildSpec}};
+init(_Opts) ->
+ {ok, []}.
+
+
+%%-----------------------------------------------------------------
+%% Func: terminate/1
+%%-----------------------------------------------------------------
+terminate(_Reason, _State) ->
+ ok.
+
+%%-----------------------------------------------------------------
+%% Func: connect/6
+%%-----------------------------------------------------------------
+connect(Host, Port, SocketType, SocketOptions, Parent, Key, NewKey) ->
+ supervisor:start_child(orber_iiop_outsup,
+ [{connect, Host, Port, SocketType,
+ SocketOptions, Parent, Key, NewKey}]).
+
diff --git a/lib/orber/src/orber_iiop_pm.erl b/lib/orber/src/orber_iiop_pm.erl
new file mode 100644
index 0000000000..bf36b353bc
--- /dev/null
+++ b/lib/orber/src/orber_iiop_pm.erl
@@ -0,0 +1,821 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_iiop_pm.erl
+%% Description:
+%% This file contains the mapping of addresses on the format {Host, Port}
+%% to a proxy pid.
+%%
+%%-----------------------------------------------------------------
+-module(orber_iiop_pm).
+
+-behaviour(gen_server).
+
+-include_lib("orber/src/orber_iiop.hrl").
+-include_lib("orber/include/corba.hrl").
+-include_lib("kernel/include/inet.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start/0, start/1]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([connect/7,
+ close_connection/1, close_connection/2,
+ list_existing_connections/0,
+ list_setup_connections/0,
+ list_all_connections/0,
+ init/1, handle_call/3, handle_cast/2, handle_info/2,
+ code_change/3, terminate/2, stop/0, setup_connection/8,
+ reconfigure/1, reconfigure/3, reconfigure/4, add_connection/3,
+ sockname2peername/2, peername2sockname/2]).
+
+%%-----------------------------------------------------------------
+%% Macros/Defines
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 7).
+
+-define(PM_CONNECTION_DB, orber_iiop_pm_db).
+
+-record(state, {connections, queue}).
+
+-record(connection, {hp, child, interceptors, slave,
+ flags = 0, alias = 0, socketdata = {"Unavailable", 0}}).
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+start() ->
+ ignore.
+start(Opts) ->
+ gen_server:start_link({local, 'orber_iiop_pm'}, ?MODULE, Opts, []).
+
+
+connect(Host, Port, SocketType, Timeout, Chars, Wchars, Ctx)
+ when SocketType == normal ->
+ Key = create_key(Host, Port, Ctx),
+ case ets:lookup(?PM_CONNECTION_DB, Key) of
+ [#connection{child = connecting}] ->
+ gen_server:call(orber_iiop_pm, {connect, Host, Port, SocketType,
+ [], Chars, Wchars, Key}, Timeout);
+ [] ->
+ gen_server:call(orber_iiop_pm, {connect, Host, Port, SocketType,
+ [], Chars, Wchars, Key}, Timeout);
+ [#connection{hp = {_, _, 0}, child = P, interceptors = I}] ->
+ {ok, P, [], I, 0};
+ [#connection{hp = {_, _, Interface}, child = P, interceptors = I}] ->
+ {ok, P, [], I, [Interface]}
+ end;
+connect(Host, Port, SocketType, Timeout, Chars, Wchars, Ctx)
+ when SocketType == ssl ->
+ Key = create_key(Host, Port, Ctx),
+ case ets:lookup(?PM_CONNECTION_DB, Key) of
+ [#connection{child = connecting}] ->
+ SocketOptions = get_ssl_socket_options(Ctx),
+ gen_server:call(orber_iiop_pm, {connect, Host, Port, SocketType,
+ SocketOptions, Chars, Wchars, Key},
+ Timeout);
+ [] ->
+ SocketOptions = get_ssl_socket_options(Ctx),
+ gen_server:call(orber_iiop_pm, {connect, Host, Port, SocketType,
+ SocketOptions, Chars, Wchars, Key},
+ Timeout);
+ [#connection{hp = {_, _, 0}, child = P, interceptors = I}] ->
+ {ok, P, [], I, 0};
+ [#connection{hp = {_, _, Interface}, child = P, interceptors = I}] ->
+ {ok, P, [], I, [Interface]}
+ end.
+
+get_ssl_socket_options([]) ->
+ [{verify, orber:ssl_client_verify()},
+ {depth, orber:ssl_client_depth()} |
+ ssl_client_extra_options([{certfile, orber:ssl_client_certfile()},
+ {cacertfile, orber:ssl_client_cacertfile()},
+ {password, orber:ssl_client_password()},
+ {keyfile, orber:ssl_client_keyfile()},
+ {ciphers, orber:ssl_client_ciphers()},
+ {cachetimeout, orber:ssl_client_cachetimeout()}], [])];
+get_ssl_socket_options([#'IOP_ServiceContext'
+ {context_id=?ORBER_GENERIC_CTX_ID,
+ context_data = {configuration, Options}}|_]) ->
+ Verify = orber_tb:keysearch(ssl_client_verify, Options,
+ orber_env:ssl_client_verify()),
+ Depth = orber_tb:keysearch(ssl_client_depth, Options,
+ orber_env:ssl_client_depth()),
+ Cert = orber_tb:keysearch(ssl_client_certfile, Options,
+ orber_env:ssl_client_certfile()),
+ CaCert = orber_tb:keysearch(ssl_client_cacertfile, Options,
+ orber_env:ssl_client_cacertfile()),
+ Pwd = orber_tb:keysearch(ssl_client_password, Options,
+ orber_env:ssl_client_password()),
+ Key = orber_tb:keysearch(ssl_client_keyfile, Options,
+ orber_env:ssl_client_keyfile()),
+ Ciphers = orber_tb:keysearch(ssl_client_ciphers, Options,
+ orber_env:ssl_client_ciphers()),
+ Timeout = orber_tb:keysearch(ssl_client_cachetimeout, Options,
+ orber_env:ssl_client_cachetimeout()),
+ [{verify, Verify},
+ {depth, Depth} |
+ ssl_client_extra_options([{certfile, Cert},
+ {cacertfile, CaCert},
+ {password, Pwd},
+ {keyfile, Key},
+ {ciphers, Ciphers},
+ {cachetimeout, Timeout}], [])];
+get_ssl_socket_options([_|T]) ->
+ get_ssl_socket_options(T).
+
+ssl_client_extra_options([], Acc) ->
+ Acc;
+ssl_client_extra_options([{_Type, []}|T], Acc) ->
+ ssl_client_extra_options(T, Acc);
+ssl_client_extra_options([{_Type, infinity}|T], Acc) ->
+ ssl_client_extra_options(T, Acc);
+ssl_client_extra_options([{Type, Value}|T], Acc) ->
+ ssl_client_extra_options(T, [{Type, Value}|Acc]).
+
+add_connection(Key, Key, SockData) ->
+ case ets:lookup(?PM_CONNECTION_DB, Key) of
+ [Connection] ->
+ ets:insert(?PM_CONNECTION_DB,
+ Connection#connection{socketdata = SockData});
+ [] ->
+ ets:insert(?PM_CONNECTION_DB,
+ #connection{hp= Key, child = connecting,
+ socketdata = SockData})
+ end;
+add_connection(Key, NewKey, SockData) ->
+ add_connection(Key, Key, SockData),
+ add_connection(NewKey, NewKey, SockData).
+
+get_socket_data(Key) ->
+ case ets:lookup(?PM_CONNECTION_DB, Key) of
+ [#connection{socketdata = SockData}] ->
+ SockData;
+ _ ->
+ {"Unable to extract socket information", 0}
+ end.
+
+sockname2peername(SockHost, SockPort) ->
+ orber_tb:unique(
+ do_select([{#connection{hp = {'$1', '$2', '_'},
+ socketdata = {match_type(SockHost),
+ match_type(SockPort)},
+ _='_'}, [], [{{'$1', '$2'}}]}])).
+
+
+peername2sockname(PeerHost, PeerPort) ->
+ orber_tb:unique(
+ do_select([{#connection{hp = {match_type(PeerHost),
+ match_type(PeerPort),
+ '_'},
+ socketdata = '$1',
+ _='_'}, [], ['$1']}])).
+
+match_type(0) ->
+ %% Wildcard port number
+ '_';
+match_type("") ->
+ %% Wildcard host
+ '_';
+match_type(Key) ->
+ %% Wildcard not used.
+ Key.
+
+create_key(Host, Port, []) ->
+ {Host, Port, 0};
+create_key(Host, Port,
+ [#'IOP_ServiceContext'
+ {context_id=?ORBER_GENERIC_CTX_ID,
+ context_data = {interface, Interface}}|_]) when is_list(Interface) ->
+ {Host, Port, Interface};
+create_key(Host, Port,
+ [#'IOP_ServiceContext'
+ {context_id=?ORBER_GENERIC_CTX_ID,
+ context_data = {interface, Interface}}|_]) ->
+ orber:dbg("[~p] orber_iiop_pm:create_key(~p, ~p);~n"
+ "The supplied interface must be a string.",
+ [?LINE, Host, Port, Interface], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_CONTEXT'{completion_status=?COMPLETED_NO});
+create_key(Host, Port, [_|T]) ->
+ create_key(Host, Port, T).
+
+reconfigure(Options) ->
+ {Local, Proxy} = check_options(Options, [], []),
+ reconfigure_local(Local),
+ reconfigure_proxy(Proxy).
+
+
+reconfigure(Options, Host, Port) ->
+ reconfigure(Options, Host, Port, 0).
+reconfigure(Options, Host, Port, Interface) ->
+ case ets:lookup(?PM_CONNECTION_DB, {Host, Port, Interface}) of
+ [#connection{child = P}] when is_pid(P) ->
+ case check_options(Options, [], []) of
+ {[], Proxy} ->
+ reconfigure_proxy(Proxy, [P]);
+ {Local, Proxy} ->
+ reconfigure_proxy(Proxy, [P]),
+ gen_server:call(orber_iiop_pm, {reconfigure, Local,
+ Host, Port, Interface}, infinity)
+ end;
+ _ ->
+ {error, "No proxy matched the supplied reference"}
+ end.
+
+reconfigure_local([]) ->
+ ok;
+reconfigure_local(Options) ->
+ gen_server:call(orber_iiop_pm, {reconfigure, Options}, infinity).
+
+reconfigure_proxy([]) ->
+ ok;
+reconfigure_proxy(Options) ->
+ reconfigure_proxy(Options, do_select([{#connection{child = '$1', _='_'},
+ [], ['$1']}])).
+
+reconfigure_proxy(Options, [Pid|T]) ->
+ Pid ! {reconfigure, Options},
+ reconfigure_proxy(Options, T);
+reconfigure_proxy(_Options, []) ->
+ ok.
+
+
+check_options([{interceptors, false}|Options], Local, Proxy) ->
+ check_options(Options, [{interceptors, false}|Local], Proxy);
+check_options([{interceptors, {native, LPIs}}|Options], Local, Proxy) ->
+ check_options(Options, [{interceptors, {native, LPIs}}|Local], Proxy);
+check_options([{fake, option}|Options], Local, Proxy) ->
+ check_options(Options, Local, [{fake, option}|Proxy]);
+check_options([_|Options], Local, Proxy) ->
+ check_options(Options, Local, Proxy);
+check_options([], Local, Proxy) ->
+ {Local, Proxy}.
+
+
+close_connection(PeerData) ->
+ close_connection(PeerData, 0).
+
+close_connection(PeerData, Interface) ->
+ gen_server:call(orber_iiop_pm, {disconnect, PeerData, Interface}, infinity).
+
+
+list_existing_connections() ->
+ transform(
+ lists:sort(
+ do_select([{#connection{hp = {'$2','$3','$4'}, child = '$1', _='_'},
+ [{is_pid, '$1'}], [{{'$1', '$2','$3','$4'}}]}])), []).
+
+list_setup_connections() ->
+ transform(
+ lists:sort(
+ do_select([{#connection{hp = {'$1','$2','$3'}, child = connecting, _='_'}, [],
+ [{{'$1','$2','$3'}}]}])), []).
+
+list_all_connections() ->
+ transform(
+ lists:sort(
+ do_select([{#connection{hp = {'$2','$3','$4'}, child = '$1', _='_'}, [],
+ [{{'$1','$2','$3', '$4'}}]}])), []).
+
+%% Since the connections interface can be 0 or an ip-address we want to
+%% transform those containing 0.
+transform([{C, H, P, 0}, {C, H, P, I}|T], Acc) ->
+ %% ACL defined interface. Drop the anonymous one.
+ transform(T, [{H, P, I}|Acc]);
+transform([{_C, H, P, 0}|T], Acc) ->
+ %% No interface supplied. Drop the 0.
+ transform(T, [{H, P}|Acc]);
+transform([{_C, H, P, I}|T], Acc) ->
+ %% Interface supplied. Keep it.
+ transform(T, [{H, P, I}|Acc]);
+transform([{H,P,0}|T], Acc) ->
+ transform(T, [{H,P}|Acc]);
+transform([{H,P,I}|T], Acc) ->
+ transform(T, [{H,P,I}|Acc]);
+transform([H|T], Acc) ->
+ transform(T, [H|Acc]);
+transform([], Acc) ->
+ Acc.
+
+do_select(Pattern) ->
+ case catch ets:select(?PM_CONNECTION_DB, Pattern) of
+ {'EXIT', _What} ->
+ [];
+ Result ->
+ Result
+ end.
+
+%%-----------------------------------------------------------------
+%% Internal interface functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: stop/0 (Only used for test purpose !!!!!!)
+%%-----------------------------------------------------------------
+stop() ->
+ gen_server:call(orber_iiop_pm, stop).
+
+%%-----------------------------------------------------------------
+%% Server functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: init/1
+%%-----------------------------------------------------------------
+init(_Opts) ->
+ process_flag(trap_exit, true),
+ {ok, #state{connections = ets:new(orber_iiop_pm_db,
+ [{keypos, 2}, set, public, named_table]),
+ queue = ets:new(orber_iiop_pm_queue, [bag])}}.
+
+%%-----------------------------------------------------------------
+%% Func: terminate/2
+%%-----------------------------------------------------------------
+terminate(_Reason, #state{queue = Q}) ->
+ %% Kill all proxies and close table before terminating
+ stop_all_proxies(ets:first(?PM_CONNECTION_DB)),
+ ets:delete(?PM_CONNECTION_DB),
+ ets:delete(Q),
+ ok.
+
+stop_all_proxies('$end_of_table') ->
+ ok;
+stop_all_proxies(Key) ->
+ case ets:lookup(?PM_CONNECTION_DB, Key) of
+ [] ->
+ ok;
+ [#connection{child = connecting, interceptors = I}] ->
+ invoke_connection_closed(I);
+ [#connection{child = P, interceptors = I}] ->
+ invoke_connection_closed(I),
+ catch orber_iiop_outproxy:stop(P)
+ end,
+ stop_all_proxies(ets:next(?PM_CONNECTION_DB, Key)).
+
+%%-----------------------------------------------------------------
+%% Func: handle_call/3
+%%-----------------------------------------------------------------
+handle_call({connect, Host, Port, SocketType, SocketOptions, Chars, Wchars, Key},
+ From, State) ->
+ case ets:lookup(?PM_CONNECTION_DB, Key) of
+ [#connection{child = connecting}] ->
+ %% Another client already requested a connection to the given host/port.
+ %% Just add this client to the queue.
+ ets:insert(State#state.queue, {Key, From}),
+ {noreply, State};
+ [#connection{hp = {_,_,0}, child = P, interceptors = I}] ->
+ %% This case will occur if the PortMapper completed a connection
+ %% between the client's ets:lookup and receiving this request.
+ {reply, {ok, P, [], I, 0}, State};
+ [#connection{hp = {_,_,Intf}, child = P, interceptors = I}] ->
+ %% This case will occur if the PortMapper completed a connection
+ %% between the client's ets:lookup and receiving this request.
+ {reply, {ok, P, [], I, [Intf]}, State};
+ [] ->
+ %% The first time a connection is requested to the given host/port.
+ case catch spawn_link(?MODULE, setup_connection,
+ [self(), Host, Port, SocketType,
+ SocketOptions, Chars, Wchars, Key]) of
+ Slave when is_pid(Slave) ->
+ ets:insert(?PM_CONNECTION_DB,
+ #connection{hp = Key, child = connecting,
+ interceptors = false, slave = Slave}),
+ ets:insert(State#state.queue, {Key, From}),
+ {noreply, State};
+ What ->
+ orber:dbg("[~p] orber_iiop_pm:handle_call(connect);~n"
+ "Unable to invoke setup_connection due to: ~n~p~n",
+ [?LINE, What], ?DEBUG_LEVEL),
+ {reply,
+ {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}},
+ State}
+ end
+ end;
+handle_call({disconnect, PeerData, Interface}, _From, State) ->
+ {reply, do_disconnect(PeerData, Interface, State), State};
+handle_call({reconfigure, Options, Host, Port, Interface},
+ _From, State) ->
+ case ets:lookup(?PM_CONNECTION_DB, {Host, Port, Interface}) of
+ [] ->
+ {reply, {error, "No proxy matched the supplied reference"}, State};
+ [Connection] ->
+ NewConnection = update_connection(Connection, Options),
+ ets:insert(?PM_CONNECTION_DB, NewConnection),
+ {reply, ok, State}
+ end;
+handle_call({reconfigure, Options}, _From, State) ->
+ case catch update_db(ets:first(?PM_CONNECTION_DB), Options) of
+ ok ->
+ {reply, ok, State};
+ _What ->
+ {reply, {error, "Unable to change configuration"}, State}
+ end;
+handle_call(stop, _From, State) ->
+ {stop, normal, ok, State};
+handle_call(_, _, State) ->
+ {noreply, State}.
+
+update_db('$end_of_table', _) ->
+ ok;
+update_db(Key, Options) ->
+ [Connection] = ets:lookup(?PM_CONNECTION_DB, Key),
+ NewConnection = update_connection(Connection, Options),
+ ets:insert(?PM_CONNECTION_DB, NewConnection),
+ update_db(ets:next(?PM_CONNECTION_DB, Key), Options).
+
+
+update_connection(Connection, [{interceptors, false}|Options]) ->
+ update_connection(Connection#connection{interceptors = false}, Options);
+update_connection(#connection{interceptors = false,
+ hp = {PH, PP, _},
+ socketdata = {SH, SP}} = Connection,
+ [{interceptors, {native, LPIs}}|Options]) ->
+ %% No Interceptor(s). Add the same Ref used by the built in interceptors.
+ update_connection(Connection#connection{interceptors =
+ {native, {PH, PP, SH, SP}, LPIs}},
+ Options);
+update_connection(#connection{interceptors = {native, Ref, _}} = Connection,
+ [{interceptors, {native, LPIs}}|Options]) ->
+ %% Interceptor(s) already in use. We must use the same Ref as before.
+ update_connection(Connection#connection{interceptors =
+ {native, Ref, LPIs}},
+ Options);
+update_connection(Connection, [H|T]) ->
+ orber:dbg("[~p] orber_iiop_pm:update_connection(~p, ~p)~n"
+ "Unable to update the connection.~n",
+ [?LINE, Connection, H], ?DEBUG_LEVEL),
+ update_connection(Connection, T);
+update_connection(Connection, []) ->
+ Connection.
+
+do_disconnect([], _Interface, _State) ->
+ ok;
+do_disconnect([{Host, Port}|T], Interface, State) ->
+ case ets:lookup(?PM_CONNECTION_DB, {Host, Port, Interface}) of
+ [] ->
+ ok;
+ [#connection{child = connecting, interceptors = I}] ->
+ ets:delete(?PM_CONNECTION_DB, {Host, Port, Interface}),
+ Exc = {'EXCEPTION',#'INTERNAL'{completion_status = ?COMPLETED_NO}},
+ send_reply_to_queue(ets:lookup(State#state.queue,
+ {Host, Port, Interface}), Exc),
+ ets:delete(State#state.queue, {Host, Port, Interface}),
+ invoke_connection_closed(I);
+ [#connection{child = P, interceptors = I}] ->
+ unlink(P),
+ catch orber_iiop_outproxy:stop(P),
+ ets:delete(?PM_CONNECTION_DB, {Host, Port, Interface}),
+ invoke_connection_closed(I)
+ end,
+ do_disconnect(T, Interface, State).
+
+%%-----------------------------------------------------------------
+%% Func: handle_cast/2
+%%-----------------------------------------------------------------
+handle_cast(stop, State) ->
+ {stop, normal, State};
+handle_cast(_, State) ->
+ {noreply, State}.
+
+%%-----------------------------------------------------------------
+%% Func: handle_info/2
+%%-----------------------------------------------------------------
+%% Trapping exits
+handle_info({'EXIT', Pid, Reason}, State) ->
+ %% Check the most common scenario first, i.e., a proxy terminates.
+ case ets:match_object(?PM_CONNECTION_DB, #connection{child = Pid, _='_'}) of
+ [#connection{hp = K, interceptors = I}] ->
+ ets:delete(?PM_CONNECTION_DB, K),
+ invoke_connection_closed(I),
+ {noreply, State};
+ [#connection{hp = K, interceptors = I}, #connection{hp = K2}] ->
+ ets:delete(?PM_CONNECTION_DB, K),
+ ets:delete(?PM_CONNECTION_DB, K2),
+ invoke_connection_closed(I),
+ {noreply, State};
+ [] when Reason == normal ->
+ %% This might have been a spawned 'setup_connection' which terminated
+ %% after sucessfully setting up a new connection.
+ {noreply, State};
+ [] ->
+ %% Wasn't a proxy. Hence, we must test if it was a spawned
+ %% 'setup_connection' that failed.
+ case ets:match_object(?PM_CONNECTION_DB, #connection{slave = Pid, _='_'}) of
+ [#connection{hp = K, child = connecting, interceptors = I}] ->
+ ets:delete(?PM_CONNECTION_DB, K),
+ invoke_connection_closed(I),
+ Exc = {'EXCEPTION',#'INTERNAL'{completion_status = ?COMPLETED_NO}},
+ send_reply_to_queue(ets:lookup(State#state.queue, K), Exc),
+ ets:delete(State#state.queue, K),
+ orber:dbg("[~p] orber_iiop_pm:handle_info(setup_failed ~p);~n"
+ "It was not possible to create a connection to the"
+ " given host/port.",
+ [?LINE, K], ?DEBUG_LEVEL),
+ {noreply, State};
+ [#connection{hp = K, child = connecting, interceptors = I},
+ #connection{hp = K2}] ->
+ ets:delete(?PM_CONNECTION_DB, K),
+ ets:delete(?PM_CONNECTION_DB, K2),
+ invoke_connection_closed(I),
+ Exc = {'EXCEPTION',#'INTERNAL'{completion_status = ?COMPLETED_NO}},
+ send_reply_to_queue(ets:lookup(State#state.queue, K), Exc),
+ ets:delete(State#state.queue, K),
+ orber:dbg("[~p] orber_iiop_pm:handle_info(setup_failed ~p);~n"
+ "It was not possible to create a connection to the"
+ " given host/port.",
+ [?LINE, K], ?DEBUG_LEVEL),
+ {noreply, State};
+ _ ->
+ {noreply, State}
+ end
+ end;
+handle_info({setup_failed, {Host, Port, _} = Key, Key, Exc}, State) ->
+ %% Deletet the data from the connection DB first to avoid clients from
+ %% trying to access it again.
+ ets:delete(?PM_CONNECTION_DB, Key),
+ %% Now we can send whatever exception received.
+ send_reply_to_queue(ets:lookup(State#state.queue, Key), Exc),
+ ets:delete(State#state.queue, Key),
+ orber:dbg("[~p] orber_iiop_pm:handle_info(setup_failed ~p ~p);~n"
+ "It was not possible to create a connection to the given host/port.",
+ [?LINE, Host, Port], ?DEBUG_LEVEL),
+ {noreply, State};
+handle_info({setup_failed, {Host, Port, _} = Key, NewKey, Exc}, State) ->
+ %% Deletet the data from the connection DB first to avoid clients from
+ %% trying to access it again.
+ ets:delete(?PM_CONNECTION_DB, Key),
+ ets:delete(?PM_CONNECTION_DB, NewKey),
+ %% Now we can send whatever exception received.
+ send_reply_to_queue(ets:lookup(State#state.queue, Key), Exc),
+ ets:delete(State#state.queue, Key),
+ orber:dbg("[~p] orber_iiop_pm:handle_info(setup_failed ~p ~p);~n"
+ "It was not possible to create a connection to the given host/port.",
+ [?LINE, Host, Port], ?DEBUG_LEVEL),
+ {noreply, State};
+handle_info({setup_successfull, Key, Key, {Child, Ctx, Int}}, State) ->
+ %% Create a link to the proxy and store it in the connection DB.
+ link(Child),
+ case ets:lookup(?PM_CONNECTION_DB, Key) of
+ [Connection] ->
+ ets:insert(?PM_CONNECTION_DB,
+ Connection#connection{hp = Key, child = Child,
+ interceptors = Int,
+ slave = undefined});
+ [] ->
+ ets:insert(?PM_CONNECTION_DB,
+ #connection{hp = Key, child = Child,
+ interceptors = Int,
+ slave = undefined})
+ end,
+ %% Send the Proxy reference to all waiting clients.
+ case Key of
+ {_, _, 0} ->
+ send_reply_to_queue(ets:lookup(State#state.queue, Key),
+ {ok, Child, Ctx, Int, 0});
+ {_, _, Interface} ->
+ send_reply_to_queue(ets:lookup(State#state.queue, Key),
+ {ok, Child, Ctx, Int, [Interface]})
+ end,
+ %% Reset the queue.
+ ets:delete(State#state.queue, Key),
+ {noreply, State};
+handle_info({setup_successfull, Key, NewKey, {Child, Ctx, Int}}, State) ->
+ %% Create a link to the proxy and store it in the connection DB.
+ link(Child),
+ case ets:lookup(?PM_CONNECTION_DB, NewKey) of
+ [Connection] ->
+ ets:insert(?PM_CONNECTION_DB,
+ Connection#connection{hp = NewKey, child = Child,
+ interceptors = Int,
+ slave = undefined});
+ [] ->
+ ets:insert(?PM_CONNECTION_DB,
+ #connection{hp = NewKey, child = Child,
+ interceptors = Int,
+ slave = undefined})
+ end,
+ case ets:lookup(?PM_CONNECTION_DB, Key) of
+ [Connection2] ->
+ ets:insert(?PM_CONNECTION_DB,
+ Connection2#connection{hp = Key, child = Child,
+ interceptors = Int,
+ slave = undefined});
+ [] ->
+ ets:insert(?PM_CONNECTION_DB,
+ #connection{hp = Key, child = Child,
+ interceptors = Int,
+ slave = undefined})
+ end,
+ %% Send the Proxy reference to all waiting clients.
+ case NewKey of
+ {_, _, 0} ->
+ send_reply_to_queue(ets:lookup(State#state.queue, Key),
+ {ok, Child, Ctx, Int, 0});
+ {_, _, Interface} ->
+ send_reply_to_queue(ets:lookup(State#state.queue, Key),
+ {ok, Child, Ctx, Int, [Interface]})
+ end,
+ %% Reset the queue.
+ ets:delete(State#state.queue, Key),
+ {noreply, State};
+handle_info(_, State) ->
+ {noreply, State}.
+
+
+send_reply_to_queue([], _) ->
+ ok;
+send_reply_to_queue([{_, Client}|T], Reply) ->
+ gen_server:reply(Client, Reply),
+ send_reply_to_queue(T, Reply).
+
+%%-----------------------------------------------------------------
+%% Func: code_change/3
+%%-----------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%-----------------------------------------------------------------
+%% Internal functions
+%%-----------------------------------------------------------------
+setup_connection(PMPid, Host, Port, SocketType, SocketOptions, Chars, Wchars, Key) ->
+ case catch access_allowed(Host, Port, SocketType, Key) of
+ ok ->
+ do_setup_connection(PMPid, Host, Port, SocketType, SocketOptions,
+ Chars, Wchars, Key, Key);
+ {ok, Interface} ->
+ do_setup_connection(PMPid, Host, Port, SocketType,
+ [{ip, Interface}|SocketOptions],
+ Chars, Wchars, Key, Key);
+ {ok, Interface, NewKey} ->
+ do_setup_connection(PMPid, Host, Port, SocketType,
+ [{ip, Interface}|SocketOptions],
+ Chars, Wchars, Key, NewKey);
+ false ->
+ orber_tb:info("Blocked connect attempt to ~s - ~p", [Host, Port]),
+ PMPid ! {setup_failed, Key, Key,
+ {'EXCEPTION', #'NO_PERMISSION'{completion_status=?COMPLETED_NO}}},
+ ok;
+ Reason ->
+ orber:dbg("[~p] orber_iiop_pm:handle_call(connect ~p ~p); failed~n"
+ "Reason: ~p",
+ [?LINE, Host, Port, Reason], ?DEBUG_LEVEL),
+ PMPid ! {setup_failed, Key, Key,
+ {'EXCEPTION', #'COMM_FAILURE'{completion_status=?COMPLETED_NO}}},
+ ok
+ end.
+
+
+do_setup_connection(PMPid, Host, Port, SocketType, SocketOptions, Chars,
+ Wchars, Key, NewKey) ->
+ case catch orber_iiop_outsup:connect(Host, Port, SocketType,
+ SocketOptions, PMPid, Key, NewKey) of
+ {error, {'EXCEPTION', E}} ->
+ orber:dbg("[~p] orber_iiop_pm:handle_call(connect ~p ~p);~n"
+ "Raised Exc: ~p",
+ [?LINE, Host, Port, E], ?DEBUG_LEVEL),
+ PMPid ! {setup_failed, Key, NewKey, {'EXCEPTION', E}},
+ ok;
+ {error, Reason} ->
+ orber:dbg("[~p] orber_iiop_pm:handle_call(connect ~p ~p);~n"
+ "Got EXIT: ~p",
+ [?LINE, Host, Port, Reason], ?DEBUG_LEVEL),
+ PMPid ! {setup_failed, Key, NewKey,
+ {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}}},
+ ok;
+ {ok, undefined} ->
+ orber:dbg("[~p] orber_iiop_pm:handle_call(connect ~p ~p);~n"
+ "Probably no listener on the given Node/Port or timedout.",
+ [?LINE, Host, Port], ?DEBUG_LEVEL),
+ PMPid ! {setup_failed, Key, NewKey,
+ {'EXCEPTION', #'COMM_FAILURE'{minor=(?ORBER_VMCID bor 1),
+ completion_status=?COMPLETED_NO}}},
+ ok;
+ {ok, Child} ->
+ case init_interceptors(Host, Port, get_socket_data(Key)) of
+ {'EXCEPTION', E} ->
+ PMPid ! {setup_failed, Key, NewKey, {'EXCEPTION', E}},
+ ok;
+ Interceptors ->
+ BiDirCtx = orber:bidir_context(),
+ Ctx = case orber:exclude_codeset_ctx() of
+ true ->
+ BiDirCtx;
+ _ ->
+ CodeSetCtx =
+ #'CONV_FRAME_CodeSetContext'
+ {char_data = Chars,
+ wchar_data = Wchars},
+ [#'IOP_ServiceContext'
+ {context_id=?IOP_CodeSets,
+ context_data = CodeSetCtx} | BiDirCtx]
+ end,
+ PMPid ! {setup_successfull, Key, NewKey,
+ {Child, Ctx, Interceptors}},
+ ok
+ end
+ end.
+
+access_allowed(Host, Port, Type, {_,_,UserInterface}) ->
+ Flags = orber:get_flags(),
+ Family = orber_env:ip_version(),
+ case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_USE_ACL_OUTGOING) of
+ false when UserInterface == 0 ->
+ get_local_interface(Type, Family);
+ false ->
+ inet:getaddr(UserInterface, Family);
+ true ->
+ SearchFor =
+ case Type of
+ normal ->
+ tcp_out;
+ ssl ->
+ ssl_out
+ end,
+ {ok, Ip} = inet:getaddr(Host, Family),
+ case orber_acl:match(Ip, SearchFor, true) of
+ {true, [], 0} ->
+ get_local_interface(Type, Family);
+ {true, [], Port} ->
+ get_local_interface(Type, Family);
+ {true, [], {Min, Max}} when Port >= Min, Port =< Max ->
+ get_local_interface(Type, Family);
+ {true, [Interface], 0} ->
+ {ok, NewIp} = inet:getaddr(Interface, Family),
+ {ok, NewIp, {Host, Port, 0}};
+ {true, [Interface], Port} ->
+ {ok, NewIp} = inet:getaddr(Interface, Family),
+ {ok, NewIp, {Host, Port, 0}};
+ {true, [Interface], {Min, Max}} when Port >= Min, Port =< Max ->
+ {ok, NewIp} = inet:getaddr(Interface, Family),
+ {ok, NewIp, {Host, Port, 0}};
+ _ ->
+ false
+ end
+ end.
+
+get_local_interface(normal, Family) ->
+ case orber_env:ip_address_local() of
+ [] ->
+ ok;
+ [Interface] ->
+ inet:getaddr(Interface, Family)
+ end;
+get_local_interface(ssl, Family) ->
+ case orber_env:iiop_ssl_ip_address_local() of
+ [] ->
+ ok;
+ [Interface] ->
+ inet:getaddr(Interface, Family)
+ end.
+
+
+invoke_connection_closed(false) ->
+ ok;
+invoke_connection_closed({native, Ref, PIs}) ->
+ (catch orber_pi:closed_out_connection(PIs, Ref));
+invoke_connection_closed({_Type, _PIs}) ->
+ ok.
+
+
+init_interceptors(Host, Port, {SHost, SPort}) ->
+ case orber:get_interceptors() of
+ {native, PIs} ->
+ case catch orber_pi:new_out_connection(PIs, Host, Port, SHost, SPort) of
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_iiop_pm:init_interceptors(~p); Got Exit: ~p.~n"
+ "One or more Interceptor incorrect or undefined?",
+ [?LINE, PIs, R], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'COMM_FAILURE'{minor=(?ORBER_VMCID bor 2),
+ completion_status=?COMPLETED_NO}};
+ IntRef ->
+ {native, IntRef, PIs}
+ end;
+ Other ->
+ %% Either 'false' or {Type, PIs}.
+ Other
+ end.
+
+
+%%-----------------------------------------------------------------
+%% END OF MODULE
+%%-----------------------------------------------------------------
diff --git a/lib/orber/src/orber_iiop_socketsup.erl b/lib/orber/src/orber_iiop_socketsup.erl
new file mode 100644
index 0000000000..4e9b6de2ad
--- /dev/null
+++ b/lib/orber/src/orber_iiop_socketsup.erl
@@ -0,0 +1,85 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_iiop_socketsup.erl
+%% Description:
+%% This file contains the supervisor for the socket accept processes.
+%%
+%%-----------------------------------------------------------------
+-module(orber_iiop_socketsup).
+
+-behaviour(supervisor).
+
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start/2, start_accept/3, start_accept/4]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([init/1, terminate/2]).
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: start/2
+%%-----------------------------------------------------------------
+start(sup, Opts) ->
+ supervisor:start_link({local, orber_iiop_socketsup}, orber_iiop_socketsup,
+ {sup, Opts});
+start(_A1, _A2) ->
+ ok.
+
+
+%%-----------------------------------------------------------------
+%% Server functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: init/1
+%%-----------------------------------------------------------------
+init({sup, _Opts}) ->
+ SupFlags = {simple_one_for_one, 500, 100},
+ ChildSpec = [
+ {name3, {orber_iiop_net_accept, start, []}, temporary,
+ 10000, worker, [orber_iiop_net_accept]}
+ ],
+ {ok, {SupFlags, ChildSpec}};
+init(_Opts) ->
+ {ok, []}.
+
+
+%%-----------------------------------------------------------------
+%% Func: terminate/2
+%%-----------------------------------------------------------------
+terminate(_Reason, _State) ->
+ ok.
+
+%%-----------------------------------------------------------------
+%% Func: start_connection/1
+%%-----------------------------------------------------------------
+start_accept(Type, Listen, Ref) ->
+ start_accept(Type, Listen, Ref, []).
+start_accept(Type, Listen, Ref, ProxyOptions) ->
+ supervisor:start_child(orber_iiop_socketsup, [Type, Listen, Ref, ProxyOptions]).
+
diff --git a/lib/orber/src/orber_iiop_tracer.erl b/lib/orber/src/orber_iiop_tracer.erl
new file mode 100644
index 0000000000..7658066eae
--- /dev/null
+++ b/lib/orber/src/orber_iiop_tracer.erl
@@ -0,0 +1,231 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%--------------------------------------------------------------------
+%% File : orber_iiop_tracer.erl
+%% Purpose : Use for debugging only.
+%%--------------------------------------------------------------------
+
+-module(orber_iiop_tracer).
+
+
+
+
+
+%% Interceptor functions.
+-export([new_out_connection/5,
+ new_in_connection/5,
+ closed_in_connection/1,
+ closed_out_connection/1,
+ in_request_encoded/6,
+ in_reply_encoded/6,
+ out_reply_encoded/6,
+ out_request_encoded/6,
+ in_request/6,
+ in_reply/6,
+ out_reply/6,
+ out_request/6]).
+
+
+%%--------------- INTERCEPTOR FUNCTIONS ----------------------
+%%------------------------------------------------------------
+%% function : new_in_connection
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+new_in_connection(_Arg, PHost, PPort, SHost, SPort) ->
+ error_logger:info_msg("=============== new_in_connection ========~n"
+ "Node : ~p~n"
+ "From : ~s:~p~n"
+ "To : ~s:~p~n"
+ "==========================================~n",
+ [node(), PHost, PPort, SHost, SPort]),
+ {PHost, PPort, SHost, SPort}.
+
+%%------------------------------------------------------------
+%% function : new_out_connection
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+new_out_connection(_Arg, PHost, PPort, SHost, SPort) ->
+ error_logger:info_msg("=============== new_out_connection =======~n"
+ "Node : ~p~n"
+ "From : ~s:~p~n"
+ "To : ~s:~p~n"
+ "==========================================~n",
+ [node(), SHost, SPort, PHost, PPort]),
+ {PHost, PPort, SHost, SPort}.
+
+%%------------------------------------------------------------
+%% function : closed_in_connection
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+closed_in_connection(Arg) ->
+ error_logger:info_msg("=============== closed_in_connection =====~n"
+ "Node : ~p~n"
+ "Connection: ~p~n"
+ "==========================================~n",
+ [node(), Arg]),
+ Arg.
+
+%%------------------------------------------------------------
+%% function : closed_out_connection
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+closed_out_connection(Arg) ->
+ error_logger:info_msg("=============== closed_out_connection ====~n"
+ "Node : ~p~n"
+ "Connection: ~p~n"
+ "==========================================~n",
+ [node(), Arg]),
+ Arg.
+
+%%------------------------------------------------------------
+%% function : in_request_encoded
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+in_request_encoded(Ref, _ObjKey, Ctx, Op, Bin, Args) ->
+ error_logger:info_msg("=============== in_request_encoded =======~n"
+ "Connection: ~p~n"
+ "Operation : ~p~n"
+ "Body : ~p~n"
+ "Context : ~p~n"
+ "==========================================~n",
+ [Ref, Op, Bin, Ctx]),
+ {Bin, Args}.
+
+%%------------------------------------------------------------
+%% function : in_reply_encoded
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+in_reply_encoded(Ref, _ObjKey, Ctx, Op, Bin, Args) ->
+ error_logger:info_msg("============== in_reply_encoded ==========~n"
+ "Connection: ~p~n"
+ "Operation : ~p~n"
+ "Body : ~p~n"
+ "Context : ~p~n"
+ "==========================================~n",
+ [Ref, Op, Bin, Ctx]),
+ {Bin, Args}.
+
+%%------------------------------------------------------------
+%% function : out_reply_encoded
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+out_reply_encoded(Ref, ObjKey, Ctx, Op, Bin, Args) ->
+ error_logger:info_msg("============== out_reply_encoded =========~n"
+ "Connection: ~p~n"
+ "Operation : ~p~n"
+ "Body : ~p~n"
+ "Context : ~p~n"
+ "Object : ~p~n"
+ "==========================================~n",
+ [Ref, Op, Bin, Ctx, ObjKey]),
+ {Bin, Args}.
+
+%%------------------------------------------------------------
+%% function : out_request_encoded
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+out_request_encoded(Ref, _ObjKey, Ctx, Op, Bin, Args) ->
+ error_logger:info_msg("============== out_request_encoded =======~n"
+ "Connection: ~p~n"
+ "Operation : ~p~n"
+ "Body : ~p~n"
+ "Context : ~p~n"
+ "==========================================~n",
+ [Ref, Op, Bin, Ctx]),
+ {Bin, Args}.
+
+%%------------------------------------------------------------
+%% function : in_request
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+in_request(Ref, ObjKey, Ctx, Op, Params, Args) ->
+ error_logger:info_msg("=============== in_request ===============~n"
+ "Connection: ~p~n"
+ "Operation : ~p~n"
+ "Parameters: ~p~n"
+ "Context : ~p~n"
+ "Object : ~p~n"
+ "==========================================~n",
+ [Ref, Op, Params, Ctx, ObjKey]),
+ {Params, Args}.
+
+%%------------------------------------------------------------
+%% function : in_reply
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+in_reply(Ref, _ObjKey, Ctx, Op, Reply, Args) ->
+ error_logger:info_msg("=============== in_reply =================~n"
+ "Connection: ~p~n"
+ "Operation : ~p~n"
+ "Reply : ~p~n"
+ "Context : ~p~n"
+ "==========================================~n",
+ [Ref, Op, Reply, Ctx]),
+ {Reply, Args}.
+
+%%------------------------------------------------------------
+%% function : out_reply
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+out_reply(Ref, ObjKey, Ctx, Op, Reply, Args) ->
+ error_logger:info_msg("=============== out_reply ================~n"
+ "Connection: ~p~n"
+ "Operation : ~p~n"
+ "Reply : ~p~n"
+ "Context : ~p~n"
+ "Object : ~p~n"
+ "==========================================~n",
+ [Ref, Op, Reply, Ctx, ObjKey]),
+ {Reply, Args}.
+
+%%------------------------------------------------------------
+%% function : out_request
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+out_request(Ref, _ObjKey, Ctx, Op, Params, Args) ->
+ error_logger:info_msg("=============== out_request ==============~n"
+ "Connection: ~p~n"
+ "Operation : ~p~n"
+ "Parameters: ~p~n"
+ "Context : ~p~n"
+ "==========================================~n",
+ [Ref, Op, Params, Ctx]),
+ {Params, Args}.
+
+
+
+
+%%======================================================================
+%% END OF MODULE
+%%======================================================================
+
diff --git a/lib/orber/src/orber_iiop_tracer_silent.erl b/lib/orber/src/orber_iiop_tracer_silent.erl
new file mode 100644
index 0000000000..663d5d5a8e
--- /dev/null
+++ b/lib/orber/src/orber_iiop_tracer_silent.erl
@@ -0,0 +1,190 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%--------------------------------------------------------------------
+%% File : orber_iiop_tracer_silent.erl
+%% Purpose : Use for debugging only.
+%%--------------------------------------------------------------------
+
+-module(orber_iiop_tracer_silent).
+
+
+%% Interceptor functions.
+-export([new_out_connection/5,
+ new_in_connection/5,
+ closed_in_connection/1,
+ closed_out_connection/1,
+ in_request_encoded/6,
+ in_reply_encoded/6,
+ out_reply_encoded/6,
+ out_request_encoded/6,
+ in_request/6,
+ in_reply/6,
+ out_reply/6,
+ out_request/6]).
+
+
+%%--------------- INTERCEPTOR FUNCTIONS ----------------------
+%%------------------------------------------------------------
+%% function : new_in_connection
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+new_in_connection(_Arg, PHost, PPort, SHost, SPort) ->
+ error_logger:info_msg("=============== new_in_connection ========~n"
+ "Node : ~p~n"
+ "From : ~s:~p~n"
+ "To : ~s:~p~n"
+ "==========================================~n",
+ [node(), PHost, PPort, SHost, SPort]),
+ {PHost, PPort, SHost, SPort}.
+
+%%------------------------------------------------------------
+%% function : new_out_connection
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+new_out_connection(_Arg, PHost, PPort, SHost, SPort) ->
+ error_logger:info_msg("=============== new_out_connection =======~n"
+ "Node : ~p~n"
+ "From : ~s:~p~n"
+ "To : ~s:~p~n"
+ "==========================================~n",
+ [node(), SHost, SPort, PHost, PPort]),
+ {PHost, PPort, SHost, SPort}.
+
+%%------------------------------------------------------------
+%% function : closed_in_connection
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+closed_in_connection(Arg) ->
+ error_logger:info_msg("=============== closed_in_connection =====~n"
+ "Node : ~p~n"
+ "Connection: ~p~n"
+ "==========================================~n",
+ [node(), Arg]),
+ Arg.
+
+%%------------------------------------------------------------
+%% function : closed_out_connection
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+closed_out_connection(Arg) ->
+ error_logger:info_msg("=============== closed_out_connection ====~n"
+ "Node : ~p~n"
+ "Connection: ~p~n"
+ "==========================================~n",
+ [node(), Arg]),
+ Arg.
+
+%%------------------------------------------------------------
+%% function : in_request_encoded
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+in_request_encoded(_Ref, _ObjKey, _Ctx, _Op, Bin, Args) ->
+ {Bin, Args}.
+
+%%------------------------------------------------------------
+%% function : in_reply_encoded
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+in_reply_encoded(_Ref, _ObjKey, _Ctx, _Op, Bin, Args) ->
+ {Bin, Args}.
+
+%%------------------------------------------------------------
+%% function : out_reply_encoded
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+out_reply_encoded(_Ref, _ObjKey, _Ctx, _Op, Bin, Args) ->
+ {Bin, Args}.
+
+%%------------------------------------------------------------
+%% function : out_request_encoded
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+out_request_encoded(_Ref, _ObjKey, _Ctx, _Op, Bin, Args) ->
+ {Bin, Args}.
+
+%%------------------------------------------------------------
+%% function : in_request
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+in_request(Ref, _ObjKey, _Ctx, Op, Params, Args) ->
+ error_logger:info_msg("=============== in_request ===============~n"
+ "Connection: ~p~n"
+ "Operation : ~p~n"
+ "Parameters: ~p~n"
+ "==========================================~n",
+ [Ref, Op, Params]),
+ {Params, Args}.
+
+%%------------------------------------------------------------
+%% function : in_reply
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+in_reply(Ref, _ObjKey, _Ctx, Op, Reply, Args) ->
+ error_logger:info_msg("=============== in_reply =================~n"
+ "Connection: ~p~n"
+ "Operation : ~p~n"
+ "Reply : ~p~n"
+ "==========================================~n",
+ [Ref, Op, Reply]),
+ {Reply, Args}.
+
+%%------------------------------------------------------------
+%% function : out_reply
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+out_reply(Ref, _ObjKey, _Ctx, Op, Reply, Args) ->
+ error_logger:info_msg("=============== out_reply ================~n"
+ "Connection: ~p~n"
+ "Operation : ~p~n"
+ "Reply : ~p~n"
+ "==========================================~n",
+ [Ref, Op, Reply]),
+ {Reply, Args}.
+
+%%------------------------------------------------------------
+%% function : out_request
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+out_request(Ref, _ObjKey, _Ctx, Op, Params, Args) ->
+ error_logger:info_msg("=============== out_request ==============~n"
+ "Connection: ~p~n"
+ "Operation : ~p~n"
+ "Parameters: ~p~n"
+ "==========================================~n",
+ [Ref, Op, Params]),
+ {Params, Args}.
+
+%%======================================================================
+%% END OF MODULE
+%%======================================================================
+
diff --git a/lib/orber/src/orber_iiop_tracer_stealth.erl b/lib/orber/src/orber_iiop_tracer_stealth.erl
new file mode 100644
index 0000000000..494c93e694
--- /dev/null
+++ b/lib/orber/src/orber_iiop_tracer_stealth.erl
@@ -0,0 +1,186 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%--------------------------------------------------------------------
+%% File : orber_iiop_tracer_stealth.erl
+%% Purpose : Use for debugging only.
+%%--------------------------------------------------------------------
+
+-module(orber_iiop_tracer_stealth).
+
+
+%% Interceptor functions.
+-export([new_out_connection/5,
+ new_in_connection/5,
+ closed_in_connection/1,
+ closed_out_connection/1,
+ in_request_encoded/6,
+ in_reply_encoded/6,
+ out_reply_encoded/6,
+ out_request_encoded/6,
+ in_request/6,
+ in_reply/6,
+ out_reply/6,
+ out_request/6]).
+
+
+%%--------------- INTERCEPTOR FUNCTIONS ----------------------
+%%------------------------------------------------------------
+%% function : new_in_connection
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+new_in_connection(_Arg, PHost, PPort, SHost, SPort) ->
+ error_logger:info_msg("=============== new_in_connection ========~n"
+ "Node : ~p~n"
+ "From : ~s:~p~n"
+ "To : ~s:~p~n"
+ "==========================================~n",
+ [node(), PHost, PPort, SHost, SPort]),
+ {PHost, PPort, SHost, SPort}.
+
+%%------------------------------------------------------------
+%% function : new_out_connection
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+new_out_connection(_Arg, PHost, PPort, SHost, SPort) ->
+ error_logger:info_msg("=============== new_out_connection =======~n"
+ "Node : ~p~n"
+ "From : ~s:~p~n"
+ "To : ~s:~p~n"
+ "==========================================~n",
+ [node(), SHost, SPort, PHost, PPort]),
+ {PHost, PPort, SHost, SPort}.
+
+%%------------------------------------------------------------
+%% function : closed_in_connection
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+closed_in_connection(Arg) ->
+ error_logger:info_msg("=============== closed_in_connection =====~n"
+ "Node : ~p~n"
+ "Connection: ~p~n"
+ "==========================================~n",
+ [node(), Arg]),
+ Arg.
+
+%%------------------------------------------------------------
+%% function : closed_out_connection
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+closed_out_connection(Arg) ->
+ error_logger:info_msg("=============== closed_out_connection ====~n"
+ "Node : ~p~n"
+ "Connection: ~p~n"
+ "==========================================~n",
+ [node(), Arg]),
+ Arg.
+
+%%------------------------------------------------------------
+%% function : in_request_encoded
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+in_request_encoded(_Ref, _ObjKey, _Ctx, _Op, Bin, Args) ->
+ {Bin, Args}.
+
+%%------------------------------------------------------------
+%% function : in_reply_encoded
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+in_reply_encoded(_Ref, _ObjKey, _Ctx, _Op, Bin, Args) ->
+ {Bin, Args}.
+
+%%------------------------------------------------------------
+%% function : out_reply_encoded
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+out_reply_encoded(_Ref, _ObjKey, _Ctx, _Op, Bin, Args) ->
+ {Bin, Args}.
+
+%%------------------------------------------------------------
+%% function : out_request_encoded
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+out_request_encoded(_Ref, _ObjKey, _Ctx, _Op, Bin, Args) ->
+ {Bin, Args}.
+
+%%------------------------------------------------------------
+%% function : in_request
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+in_request(Ref, _ObjKey, _Ctx, Op, Params, Args) ->
+ error_logger:info_msg("=============== in_request ===============~n"
+ "Connection: ~p~n"
+ "Operation : ~p~n"
+ "==========================================~n",
+ [Ref, Op]),
+ {Params, Args}.
+
+%%------------------------------------------------------------
+%% function : in_reply
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+in_reply(Ref, _ObjKey, _Ctx, Op, Reply, Args) ->
+ error_logger:info_msg("=============== in_reply =================~n"
+ "Connection: ~p~n"
+ "Operation : ~p~n"
+ "==========================================~n",
+ [Ref, Op]),
+ {Reply, Args}.
+
+%%------------------------------------------------------------
+%% function : out_reply
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+out_reply(Ref, _ObjKey, _Ctx, Op, Reply, Args) ->
+ error_logger:info_msg("=============== out_reply ================~n"
+ "Connection: ~p~n"
+ "Operation : ~p~n"
+ "==========================================~n",
+ [Ref, Op]),
+ {Reply, Args}.
+
+%%------------------------------------------------------------
+%% function : out_request
+%% Arguments:
+%% Returns :
+%%------------------------------------------------------------
+out_request(Ref, _ObjKey, _Ctx, Op, Params, Args) ->
+ error_logger:info_msg("=============== out_request ==============~n"
+ "Connection: ~p~n"
+ "Operation : ~p~n"
+ "==========================================~n",
+ [Ref, Op]),
+ {Params, Args}.
+
+%%======================================================================
+%% END OF MODULE
+%%======================================================================
+
diff --git a/lib/orber/src/orber_initial_references.erl b/lib/orber/src/orber_initial_references.erl
new file mode 100644
index 0000000000..21a807c4e1
--- /dev/null
+++ b/lib/orber/src/orber_initial_references.erl
@@ -0,0 +1,327 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_initial_references.erl
+%%
+%% Description:
+%% This file contains the CORBA::InitialReferences interface
+%%
+%%-----------------------------------------------------------------
+-module(orber_initial_references).
+
+-behaviour(gen_server).
+
+-include_lib("orber/include/corba.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start/1, shutdown/1, init/1,
+ terminate/2, handle_call/3, code_change/3,
+ get/2, list/1, add/3, remove/2,
+ get/1, list/0, add/2, remove/1,
+ typeID/0, install/2, oe_is_a/1, oe_tc/1, oe_get_interface/0]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([handle_cast/2, handle_info/2]).
+
+%%-----------------------------------------------------------------
+%% Mnesia Table definition record
+%%-----------------------------------------------------------------
+-record(orber_references, {key, objref, type}).
+
+-define(DEBUG_LEVEL, 6).
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+start(Env) ->
+ gen_server:start_link({local, 'orber_init'}, ?MODULE, Env, []).
+
+shutdown(EO_this) ->
+ gen_server:call(EO_this, stop).
+
+
+install(Timeout, Options) ->
+ AllTabs = mnesia:system_info(tables),
+ DB_Result = case lists:member(orber_references, AllTabs) of
+ true ->
+ case lists:member({local_content, true},
+ Options) of
+ true->
+ mnesia:add_table_copy(orber_references,
+ node(),
+ ram_copies);
+ _ ->
+ mnesia:create_table(orber_references,
+ [{attributes,
+ record_info(fields,
+ orber_references)}
+ |Options])
+ end;
+ _ ->
+ mnesia:create_table(orber_references,
+ [{attributes,
+ record_info(fields,
+ orber_references)}
+ |Options])
+ end,
+
+ Wait = mnesia:wait_for_tables([orber_references], Timeout),
+ %% Check if any error has occured yet. If there are errors, return them.
+ if
+ DB_Result == {atomic, ok},
+ Wait == ok ->
+ ok;
+ true ->
+ {error, {DB_Result, Wait}}
+ end.
+
+
+%%-----------------------------------------------------------------
+%% InitialReferences Interface
+%%-----------------------------------------------------------------
+'get'(Id) ->
+ case read(Id) of
+ {'EXCEPTION', E} ->
+ corba:raise(E);
+ Result ->
+ Result
+ end.
+
+list() ->
+ case list_keys() of
+ {'EXCEPTION', E} ->
+ corba:raise(E);
+ Result ->
+ Result
+ end.
+
+
+add(Id, ObjRef) ->
+ case write(Id, ObjRef, external) of
+ {'EXCEPTION', E} ->
+ corba:raise(E);
+ Result ->
+ Result
+ end.
+
+
+remove(Id) ->
+ case delete(Id) of
+ {'EXCEPTION', E} ->
+ corba:raise(E);
+ Result ->
+ Result
+ end.
+
+
+'get'(EO_this, Id) ->
+ corba:call(EO_this, 'get', [Id], ?MODULE).
+
+list(EO_this) ->
+ corba:call(EO_this, 'list', [], ?MODULE).
+
+add(EO_this, Id, ObjRef) ->
+ corba:call(EO_this, 'add', [Id, ObjRef], ?MODULE).
+
+remove(EO_this, Id) ->
+ corba:call(EO_this, 'remove', [Id], ?MODULE).
+
+typeID() ->
+ "IDL:Orber/InitialReferences:1.0".
+
+oe_is_a("IDL:Orber/InitialReferences:1.0") ->
+ true;
+oe_is_a(_) ->
+ false.
+
+%%-----------------------------------------------------------------
+%% Internal interface functions
+%%-----------------------------------------------------------------
+init([]) ->
+ case mnesia:wait_for_tables(['orber_references'], infinity) of
+ ok ->
+ NSObjKey = 'CosNaming_NamingContextExt':oe_create([], [{pseudo, true},
+ {no_security, orber:partial_security()}]),
+ rewrite("NameService", NSObjKey),
+ ErlIfr = 'OrberApp_IFR':oe_create([], [{pseudo, true}]),
+ rewrite("OrberIFR", ErlIfr),
+ {ok, []};
+ StopReason ->
+ {stop, StopReason}
+ end.
+
+terminate(_Reason, _State) ->
+ ok.
+
+
+%%-----------------------------------------------------------------
+%% Handle incomming calls
+handle_call({_EO_this, _OE_Context, 'get', [Id]}, _From, State) ->
+ {'reply', read(Id), State};
+handle_call({_EO_this, _OE_Context, 'list', []}, _From, State) ->
+ {'reply', list_keys(), State};
+
+handle_call({_EO_this, _OE_Context, 'add', [Id, ObjectRef]}, _From, State) ->
+ {'reply', write(Id, ObjectRef, external), State};
+
+handle_call({_EO_this, _OE_Context, 'remove', [Id]}, _From, State) ->
+ {'reply', delete(Id), State};
+handle_call('stop', _From, State) ->
+ {'stop', normal, 'ok', State};
+handle_call(_Req, _From,State) ->
+ {'reply', {'ok', 'nil', 'nil'}, State}.
+
+oe_tc(get) ->
+ {{'tk_objref', 12, "object"}, [{'tk_string', 0}], []};
+oe_tc(list) ->
+ {{'tk_sequence',{'tk_string', 0}, 0}, [], []};
+oe_tc(add) ->
+ {'tk_boolean', [{'tk_string', 0}, {'tk_objref', 12, "object"}], []};
+oe_tc(remove) ->
+ {'tk_boolean', [{'tk_string', 0}], []};
+oe_tc(_) ->
+ undefined.
+
+oe_get_interface() ->
+ [{"get", oe_tc(get)},
+ {"list", oe_tc(list)},
+ {"add", oe_tc(add)}].
+
+
+%%-----------------------------------------------------------------
+%% Standard gen_server cast handle
+%%-----------------------------------------------------------------
+handle_cast(_, State) ->
+ {noreply, State}.
+
+
+%%-----------------------------------------------------------------
+%% Standard gen_server handles
+%%-----------------------------------------------------------------
+handle_info(_, State) ->
+ {noreply, State}.
+
+%%-----------------------------------------------------------------
+%% Func: code_change/3
+%%-----------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+read(Key) ->
+ case mnesia:dirty_read({orber_references, Key}) of
+ [] ->
+ corba:create_nil_objref();
+ [#orber_references{objref = ObjRef}] ->
+ ObjRef;
+ What ->
+ orber:dbg("[~p] orber_initial_references:lookup(~p);~n"
+ "Failed to read from DB: ~p",
+ [?LINE, Key, What], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}}
+ end.
+
+write(Key, ObjRef, Type) ->
+ _WF = fun() ->
+ case mnesia:wread({orber_references, Key}) of
+ [] ->
+ %% No key exists. Ok to register.
+ mnesia:write(#orber_references{key=Key, objref = ObjRef,
+ type=Type});
+ [X] ->
+ orber:dbg("[~p] orber_initial_references:write(~p);~n"
+ "Already bound to: ~p",
+ [?LINE, Key, X], ?DEBUG_LEVEL),
+ false;
+ Why ->
+ %% Something else occured.
+ orber:dbg("[~p] orber_initial_references:write(~p);~n"
+ "Error reading from DB (~p)", [?LINE, Key, Why], ?DEBUG_LEVEL),
+ mnesia:abort({'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}})
+ end
+ end,
+ case mnesia:transaction(_WF) of
+ {atomic, ok} ->
+ true;
+ {atomic, Result} ->
+ Result;
+ {aborted, Reason} ->
+ Reason
+ end.
+
+rewrite(Key, ObjRef) ->
+ rewrite(Key, ObjRef, internal).
+rewrite(Key, ObjRef, Type) ->
+ _WF = fun() ->
+ mnesia:write(#orber_references{key=Key, objref = ObjRef, type=Type})
+ end,
+ case mnesia:transaction(_WF) of
+ {atomic, ok} ->
+ true;
+ {aborted, Reason} ->
+ orber:dbg("[~p] orber_initial_references:rewrite(~p);~n"
+ "Error over writing in DB (~p)",
+ [?LINE, Key, Reason], ?DEBUG_LEVEL),
+ corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
+ end.
+
+
+delete(Key) ->
+ _DF = fun() ->
+ case mnesia:read({orber_references, Key}) of
+ [] ->
+ %% No key exists.
+ orber:dbg("[~p] orber_initial_references:delete(~p);~n"
+ "Does not exist.", [?LINE, Key], ?DEBUG_LEVEL),
+ false;
+ [_X] ->
+ mnesia:delete({orber_references, Key});
+ Why ->
+ %% Something else occured.
+ orber:dbg("[~p] orber_initial_references:delete(~p);~n"
+ "Error reading from DB (~p)",
+ [?LINE, Key, Why], ?DEBUG_LEVEL),
+ mnesia:abort({'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}})
+ end
+ end,
+ case mnesia:transaction(_DF) of
+ {atomic, ok} ->
+ true;
+ {atomic, Result} ->
+ Result;
+ {aborted, Reason} ->
+ Reason
+ end.
+
+list_keys() ->
+ _LF = fun() -> mnesia:all_keys(orber_references) end,
+ case mnesia:transaction(_LF) of
+ {atomic, Result} ->
+ %% We do not want OrberIFR to exported, remove it.
+ lists:delete("OrberIFR", Result);
+ {aborted, Reason} ->
+ orber:dbg("[~p] orber_initial_references:list_keys();~n"
+ "Error reading from DB (~p)", [?LINE, Reason], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}}
+ end.
diff --git a/lib/orber/src/orber_interceptors.erl b/lib/orber/src/orber_interceptors.erl
new file mode 100644
index 0000000000..407823ea79
--- /dev/null
+++ b/lib/orber/src/orber_interceptors.erl
@@ -0,0 +1,162 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_interceptors.erl
+%%
+%% Description:
+%% This file contains the code for calling interceptors
+%%
+%%-----------------------------------------------------------------
+-module(orber_interceptors).
+
+-include_lib("orber/include/corba.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([call_send_message_interceptors/2, call_receive_message_interceptors/1,
+ call_request_interceptors/2]).
+-export([push_system_message_interceptor/2, pop_system_message_interceptor/1,
+ create_interceptor_table/0]).
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([]).
+
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+call_receive_message_interceptors(Bytes) ->
+ case getInMessageInterceptors() of
+ [] ->
+ Bytes;
+ Interceptors ->
+ apply_message_interceptors(Interceptors, receive_message, corba:create_nil_objref(),
+ lists:flatten(Bytes))
+ end.
+call_send_message_interceptors(ObjRef, Bytes) ->
+ case getOutMessageInterceptors() of
+ [] ->
+ Bytes;
+ Interceptors ->
+ apply_message_interceptors(Interceptors, send_message, ObjRef, lists:flatten(Bytes))
+ end.
+
+
+call_request_interceptors(in, Bytes) ->
+ case getInRequestInterceptors() of
+ [] ->
+ Bytes;
+ Interceptors ->
+ Bytes
+ end;
+call_request_interceptors(out, Bytes) ->
+ case getOutRequestInterceptors() of
+ [] ->
+ Bytes;
+ Interceptors ->
+ Bytes
+ end.
+
+create_interceptor_table() ->
+ %% Should be replicated mnesia
+ ets:new(orber_interceptors, [protected, named_table, set]),
+ ets:insert(orber_interceptors, {message_in_interceptors, []}),
+ ets:insert(orber_interceptors, {message_out_interceptors, []}).
+
+push_system_message_interceptor(in, Mod) ->
+ case ets:lookup(orber_interceptors, message_in_interceptors) of
+ [{_, Interceptors}] ->
+ ets:insert(orber_interceptors, {message_in_interceptors, [Mod | Interceptors]});
+ _ ->
+ corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
+ end;
+push_system_message_interceptor(out, Mod) ->
+ case ets:lookup(orber_interceptors, message_out_interceptors) of
+ [{_, Interceptors}] ->
+ ets:insert(orber_interceptors, {message_out_interceptors, Interceptors ++ [Mod]});
+ _ ->
+ corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
+ end.
+
+pop_system_message_interceptor(in) ->
+ case ets:lookup(orber_interceptors, message_in_interceptors) of
+ [{_, []}] ->
+ ok;
+ [{_, [_ | Interceptors]}] ->
+ ets:insert(orber_interceptors, {message_in_interceptors, Interceptors});
+ _ ->
+ corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
+ end;
+pop_system_message_interceptor(out) ->
+ case ets:lookup(orber_interceptors, message_out_interceptors) of
+ [{_, []}] ->
+ ok;
+ [{_, Interceptors}] ->
+ ets:insert(orber_interceptors, {message_out_interceptors, remove_last_element(Interceptors)});
+ _ ->
+ corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
+ end.
+
+
+
+%%-----------------------------------------------------------------
+%% Internal functions
+%%-----------------------------------------------------------------
+getInMessageInterceptors() ->
+ case ets:lookup(orber_interceptors, message_in_interceptors) of
+ [{_, Interceptors}] ->
+ Interceptors;
+ _ ->
+ corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
+ end.
+
+getOutMessageInterceptors() ->
+ case ets:lookup(orber_interceptors, message_out_interceptors) of
+ [{_, Interceptors}] ->
+ Interceptors;
+ _ ->
+ corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
+ end.
+
+
+getInRequestInterceptors() ->
+ [].
+
+getOutRequestInterceptors() ->
+ [].
+
+
+apply_message_interceptors([], F, ObjRef, Bytes) ->
+ Bytes;
+apply_message_interceptors([M | Rest], F, ObjRef, Bytes) ->
+ apply_message_interceptors(Rest, F, ObjRef, apply(M, F, [ObjRef, Bytes])).
+
+
+remove_last_element([]) ->
+ [];
+remove_last_element([M]) ->
+ [];
+remove_last_element([M |Tail]) ->
+ remove_last_element([Tail]).
+
+
diff --git a/lib/orber/src/orber_objectkeys.erl b/lib/orber/src/orber_objectkeys.erl
new file mode 100644
index 0000000000..b0e759187b
--- /dev/null
+++ b/lib/orber/src/orber_objectkeys.erl
@@ -0,0 +1,570 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_objectkeys.erl
+%%
+%% Description:
+%% This file contains the object keyserver in Orber
+%%
+%%-----------------------------------------------------------------
+-module(orber_objectkeys).
+
+-behaviour(gen_server).
+
+-include_lib("orber/include/corba.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start/1, stop/0, stop_all/0, get_pid/1, is_persistent/1,
+ register/2, register/3, delete/1, create_schema/1, check/1,
+ remove_old_keys/0]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([init/1, terminate/2, install/2, handle_call/3, handle_info/2, code_change/3]).
+-export([handle_cast/2, dump/0, get_key_from_pid/1, gc/1]).
+
+%%-----------------------------------------------------------------
+%% Mnesia Table definition record
+%%-----------------------------------------------------------------
+-record(orber_objkeys, {object_key, pid, persistent=false, timestamp}).
+
+%%-----------------------------------------------------------------
+%% Macros
+%%-----------------------------------------------------------------
+-define(dirty_query_context, true).
+
+%% This macro returns a read fun suitable for evaluation in a transaction
+-define(read_function(Objkey),
+ fun() ->
+ mnesia:dirty_read(Objkey)
+ end).
+
+%% This macro returns a write fun suitable for evaluation in a transaction
+-define(write_function(R),
+ fun() ->
+ mnesia:dirty_write(R)
+ end).
+
+%% This macro returns a delete fun suitable for evaluation in a transaction
+-define(delete_function(R),
+ fun() ->
+ mnesia:delete(R)
+ end).
+
+%% Use this fun inside a transaction to get a list of all keys.
+-define(match_function(),
+ fun() ->
+ mnesia:match_object({orber_objkeys, '_', '_','_','_'})
+ end).
+
+-ifdef(dirty_query_context).
+-define(query_check(Q_res), Q_res).
+-else.
+-define(query_check(Q_res), {atomic, Q_res}).
+-endif.
+
+
+-define(CHECK_EXCEPTION(Res), case Res of
+ {'EXCEPTION', E} ->
+ corba:raise(E);
+ R ->
+ R
+ end).
+
+-define(DEBUG_LEVEL, 6).
+
+
+
+%%-----------------------------------------------------------------
+%% Debugging function
+%%-----------------------------------------------------------------
+dump() ->
+ case catch mnesia:dirty_first('orber_objkeys') of
+ {'EXIT', R} ->
+ io:format("Exited with ~p\n",[R]);
+ Key ->
+ dump_print(Key),
+ dump_loop(Key)
+ end.
+
+dump_loop(PreviousKey) ->
+ case catch mnesia:dirty_next('orber_objkeys', PreviousKey) of
+ {'EXIT', R} ->
+ io:format("Exited with ~p\n",[R]);
+ '$end_of_table' ->
+ ok;
+ Key ->
+ dump_print(Key),
+ dump_loop(Key)
+ end.
+
+dump_print(Key) ->
+ case catch mnesia:dirty_read({'orber_objkeys', Key}) of
+ {'EXIT', R} ->
+ io:format("Exited with ~p\n",[R]);
+ [X] ->
+ io:format("object_key: ~p, pid: ~p, persistent: ~p, timestamp: ~p\n",
+ [binary_to_term(X#orber_objkeys.object_key),
+ X#orber_objkeys.pid,
+ X#orber_objkeys.persistent,
+ X#orber_objkeys.timestamp]);
+ _ ->
+ ok
+ end.
+
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+start(Opts) ->
+ gen_server:start_link({local, orber_objkeyserver}, orber_objectkeys, Opts, []).
+
+stop() ->
+ gen_server:call(orber_objkeyserver, stop, infinity).
+
+remove_old_keys() ->
+ %% This function may ONLY be used when restarting a crashed node.
+ %% We must remove all objects started with {global, "name"} otherwise
+ %% we cannot restart the node using the same name.
+ Fun = fun() ->
+ Node = node(),
+ mnesia:write_lock_table(orber_objkeys),
+ Objects = mnesia:match_object(orber_objkeys,
+ mnesia:table_info(orber_objkeys,
+ wild_pattern),
+ read),
+ lists:foreach(fun(Obj) ->
+ case node(Obj#orber_objkeys.pid) of
+ Node ->
+ mnesia:delete({orber_objkeys,
+ Obj#orber_objkeys.object_key});
+ _->
+ ok
+ end
+ end,
+ Objects),
+ ok
+ end,
+ write_result(mnesia:transaction(Fun)).
+
+stop_and_remove_local(Reason) ->
+ %% This function may ONLY be used when this server terminates with reason
+ %% normal or shutdown.
+ Fun = fun() ->
+ Node = node(),
+ mnesia:write_lock_table(orber_objkeys),
+ Objects = mnesia:match_object(orber_objkeys,
+ mnesia:table_info(orber_objkeys,
+ wild_pattern),
+ read),
+ lists:foreach(fun(Obj) ->
+ case node(Obj#orber_objkeys.pid) of
+ Node ->
+ exit(Obj#orber_objkeys.pid, Reason),
+ mnesia:delete({orber_objkeys,
+ Obj#orber_objkeys.object_key});
+ _->
+ ok
+ end
+ end,
+ Objects),
+ ok
+ end,
+ write_result(mnesia:transaction(Fun)).
+
+stop_all() ->
+ Fun = ?match_function(),
+ case mnesia:transaction(Fun) of
+ {atomic, Objects} ->
+ lists:foreach(fun(Obj) ->
+ gen_server:call(Obj#orber_objkeys.pid,
+ stop, infinity)
+ end,
+ Objects);
+ R ->
+ R
+ end.
+
+get_pid(Objkey) ->
+ case catch ets:lookup_element(orber_objkeys, Objkey, 3) of
+ Pid when is_pid(Pid) ->
+ Pid;
+ dead ->
+ {error, "unable to contact object"};
+ _ ->
+ %% This call is necessary if a persistent object have died
+ %% and the objectkey server is currently updating the Pid
+ %% to equal 'dead'. Without this case 'OBJECT_NOT_EXIST'
+ %% would be raised which is uncorrect if the object is
+ %% persistent.
+ ?CHECK_EXCEPTION(gen_server:call(orber_objkeyserver,
+ {get_pid, Objkey},
+ infinity))
+ end.
+
+is_persistent(Pid) when is_pid(Pid) ->
+ case catch get_key_from_pid(Pid) of
+ {'EXCEPTION', _} ->
+ corba:raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO});
+ Key ->
+ is_persistent(Key)
+ end;
+is_persistent(Objkey) ->
+ case catch ets:lookup_element(orber_objkeys, Objkey, 4) of
+ {'EXIT', _R} ->
+ corba:raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO});
+ Boolean ->
+ Boolean
+ end.
+
+
+gc(Sec) when is_integer(Sec) ->
+ Fun = fun() ->
+ mnesia:write_lock_table(orber_objkeys),
+ Objects = mnesia:match_object({orber_objkeys, '_', dead, true,'_'}),
+ lists:foreach(fun(Obj) ->
+ case timetest(Sec, Obj#orber_objkeys.timestamp) of
+ true ->
+ mnesia:delete({orber_objkeys,
+ Obj#orber_objkeys.object_key});
+ _->
+ ok
+ end
+ end,
+ Objects),
+ ok
+ end,
+ write_result(mnesia:transaction(Fun)).
+
+register(Objkey, Pid) ->
+ 'register'(Objkey, Pid, false).
+
+register(Objkey, Pid, Type) when is_pid(Pid) ->
+ ?CHECK_EXCEPTION(gen_server:call(orber_objkeyserver,
+ {register, Objkey, Pid, Type},
+ infinity));
+register(Objkey, Pid, Type) ->
+ orber:dbg("[~p] orber_objectkeys:register(~p, ~p); Not a Pid ~p",
+ [?LINE, Objkey, Type, Pid], ?DEBUG_LEVEL),
+ corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}).
+
+delete(Objkey) ->
+ ?CHECK_EXCEPTION(gen_server:call(orber_objkeyserver,
+ {delete, Objkey}, infinity)).
+
+check(Objkey) ->
+ ?CHECK_EXCEPTION(gen_server:call(orber_objkeyserver,
+ {check, Objkey}, infinity)).
+
+%%-----------------------------------------------------------------
+%% Server functions
+%%-----------------------------------------------------------------
+init(_Env) ->
+ case mnesia:wait_for_tables(['orber_objkeys'], infinity) of
+ ok ->
+ process_flag(trap_exit, true),
+ start_gc_timer(orber:objectkeys_gc_time());
+ StopReason ->
+ {stop, StopReason}
+ end.
+
+terminate(shutdown, _State) ->
+ stop_and_remove_local(shutdown),
+ ok;
+terminate(normal, _State) ->
+ stop_and_remove_local(normal),
+ ok;
+terminate(_Reason, _State) ->
+ ok.
+
+start_gc_timer(infinity) ->
+ {ok, []};
+start_gc_timer(Time) ->
+ timer:start(),
+ case timer:send_after(timer:seconds(Time),
+ orber_objkeyserver, {oe_gc, Time}) of
+ {ok, _} ->
+ {ok, []};
+ StopReason ->
+ {stop, StopReason}
+ end.
+
+install(Timeout, Options) ->
+ %% check if there already exists a database. If not, create one.
+ %% DB_initialized = perhaps_create_schema(Nodelist),
+ %% check if mnesia is running. If not, start mnesia.
+ perhaps_start_mnesia(),
+
+ %% Do we have a complete set of IFR tables? If not, create them.
+ AllTabs = mnesia:system_info(tables),
+
+ DB_Result = case lists:member(orber_objkeys, AllTabs) of
+ true ->
+ case lists:member({local_content, true},
+ Options) of
+ true->
+ mnesia:add_table_copy(orber_objkeys,
+ node(),
+ ram_copies);
+ _ ->
+ mnesia:create_table(orber_objkeys,
+ [{attributes,
+ record_info(fields,
+ orber_objkeys)}
+ |Options])
+ end;
+ _ ->
+ mnesia:create_table(orber_objkeys,
+ [{attributes,
+ record_info(fields,
+ orber_objkeys)}
+ |Options])
+ end,
+
+ Wait = mnesia:wait_for_tables([orber_objkeys], Timeout),
+ %% Check if any error has occured yet. If there are errors, return them.
+ if
+ DB_Result == {atomic, ok},
+ Wait == ok ->
+ ok;
+ true ->
+ {error, {DB_Result, Wait}}
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: handle_call/3
+%%
+%% Comment:
+%% In objectkey gen_server all exceptions are tupples and corba:raise
+%% may not be used. It is too time consuming to add catches in every
+%% function before returning. On the client side there is a case which
+%% maps every tupple on the format {'exception', E} to corba:raise(E).
+%%-----------------------------------------------------------------
+handle_call(stop, _From, State) ->
+ {stop, normal, [], State};
+handle_call({get, Objkey}, _From, State) ->
+ R = query_result(mnesia:dirty_read({orber_objkeys, Objkey})),
+ {reply, R, State};
+
+handle_call({register, Objkey, Pid, Type}, _From, State) ->
+ _WF = fun() ->
+ case mnesia:wread({orber_objkeys, Objkey}) of
+ [] ->
+ %% No key exists. Ok to register.
+ mnesia:write(#orber_objkeys{object_key=Objkey, pid=Pid,
+ persistent=Type,
+ timestamp=now()});
+ [X] when X#orber_objkeys.persistent==true,
+ X#orber_objkeys.pid == dead ->
+ %% A persistent object is being restarted. Update Pid & time.
+ mnesia:write(X#orber_objkeys{pid=Pid, timestamp=now()});
+ [X] when is_pid(X#orber_objkeys.pid) ->
+ %% Object exists, i.e., trying to create an object with
+ %% the same name.
+ orber:dbg("[~p] orber_objectkeys:register(~p, ~p); Object already exists.",
+ [?LINE, Objkey, Type], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'BAD_PARAM'{completion_status=?COMPLETED_NO}};
+ Why ->
+ %% Something else occured.
+ orber:dbg("[~p] orber_objectkeys:register(~p, ~p); error reading from DB(~p)",
+ [?LINE, Objkey, Type, Why], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}}
+ end
+ end,
+ R = write_result(mnesia:transaction(_WF)),
+ if
+ R == ok andalso is_pid(Pid) ->
+ link(Pid);
+ true ->
+ true
+ end,
+ {reply, R, State};
+
+handle_call({delete, Objkey}, _From, State) ->
+ ?query_check(Qres) = mnesia:dirty_read({orber_objkeys, Objkey}),
+ case Qres of
+ [] ->
+ true;
+ [X] when is_pid(X#orber_objkeys.pid) ->
+ unlink(X#orber_objkeys.pid);
+ _ ->
+ true
+ end,
+ _F = ?delete_function({orber_objkeys, Objkey}),
+ R = write_result(mnesia:transaction(_F)),
+ {reply, R, State};
+
+handle_call({get_pid, Objkey}, _From, State) ->
+ _F = fun() ->
+ mnesia:read({orber_objkeys, Objkey})
+ end,
+ case mnesia:transaction(_F) of
+ {atomic, [X]} when is_pid(X#orber_objkeys.pid) ->
+ {reply, X#orber_objkeys.pid, State};
+ {atomic, [X]} when X#orber_objkeys.pid == dead ->
+ {reply,
+ {'EXCEPTION', #'TRANSIENT'{completion_status=?COMPLETED_NO}},
+ State};
+ _Res ->
+ {reply,
+ {'EXCEPTION', #'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO}},
+ State}
+ end;
+handle_call({check, {_, 'key', Objkey, _, _, _}}, _From, State) ->
+ ?query_check(Qres) = mnesia:dirty_read({orber_objkeys, Objkey}),
+ case Qres of
+ [_X] ->
+ {reply, 'object_here', State};
+ _ ->
+ {reply, 'unknown_object', State}
+ end;
+handle_call({check, {_, 'registered', Objkey, _, _, _}}, _From, State) ->
+ case whereis(Objkey) of
+ undefined ->
+ case catch ets:lookup_element(orber_objkeys, Objkey, 4) of
+ true ->
+ {reply, 'object_here', State};
+ _->
+ {reply, 'unknown_object', State}
+ end;
+ _ ->
+ {reply, 'object_here', State}
+ end;
+handle_call({check, {_, 'pseudo', Module, _, _, _}}, _From, State) ->
+ case code:is_loaded(Module) of
+ false ->
+ {reply, 'unknown_object', State};
+ _ ->
+ {reply, 'object_here', State}
+ end;
+
+handle_call({check, "INIT"}, _From, State) ->
+ {reply, 'object_here', State};
+handle_call({check, _}, _From, State) ->
+ {reply, 'unknown_object', State}.
+
+
+handle_info({'EXIT', Pid, Reason}, State) when is_pid(Pid) ->
+ _WF = fun() ->
+ case mnesia:match_object({orber_objkeys, '_', Pid,'_','_'}) of
+ [] ->
+ ok;
+ [X] when X#orber_objkeys.persistent==false ->
+ mnesia:delete({orber_objkeys, X#orber_objkeys.object_key});
+ [X] when is_pid(X#orber_objkeys.pid) andalso
+ X#orber_objkeys.persistent==true andalso
+ Reason /= normal andalso
+ Reason /= shutdown ->
+ mnesia:write(X#orber_objkeys{pid=dead,
+ timestamp=now()});
+ [X] when X#orber_objkeys.persistent==true ->
+ mnesia:delete({orber_objkeys, X#orber_objkeys.object_key});
+ _->
+ ok
+ end
+ end,
+ case write_result(mnesia:transaction(_WF)) of
+ ok ->
+ unlink(Pid);
+ _->
+ true
+ end,
+ {noreply, State};
+
+handle_info({oe_gc, Secs}, State) ->
+ catch gc(Secs),
+ {noreply, State}.
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%-----------------------------------------------------------------
+%% Internal Functions
+%%-----------------------------------------------------------------
+
+timetest(S, {MeSec, Sec, USec}) ->
+ {MeSec, Sec+S, USec} < now().
+
+get_key_from_pid(Pid) ->
+ case mnesia:dirty_match_object({orber_objkeys, '_', Pid,'_','_'}) of
+ [Keys] ->
+ Keys#orber_objkeys.object_key;
+ _ ->
+ corba:raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO})
+ end.
+
+%remove_keys([], _) ->
+% ok;
+%remove_keys([H|T], R) when H#orber_objkeys.persistent==false ->
+% _F = ?delete_function({orber_objkeys, H#orber_objkeys.object_key}),
+% write_result(mnesia:transaction(_F)),
+% remove_keys(T, R).
+
+%%-----------------------------------------------------------------
+%% Check a read transaction
+query_result(?query_check(Qres)) ->
+ case Qres of
+ [Hres] ->
+ Hres#orber_objkeys.pid;
+ [] ->
+ {'EXCEPTION', #'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO}};
+ Other ->
+ orber:dbg("[~p] orber_objectkeys:query_result(); DB lookup failed(~p)",
+ [?LINE, Other], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}}
+ end.
+
+%%-----------------------------------------------------------------
+%% Check a write transaction
+write_result({atomic,ok}) -> ok;
+write_result(Foo) ->
+ orber:dbg("[~p] orber_objectkeys:query_result(); DB write failed(~p)",
+ [?LINE, Foo], ?DEBUG_LEVEL),
+ {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}}.
+
+
+create_schema(Nodes) ->
+ case mnesia:system_info(use_dir) of
+ false ->
+ mnesia:create_schema(Nodes);
+ _ ->
+ ok
+ end.
+
+perhaps_start_mnesia() ->
+ case mnesia:system_info(is_running) of
+ no ->
+ mnesia:start();
+ _ ->
+ ok
+ end.
+
+
+%%------------------------------------------------------------
+%% Standard gen_server cast handle
+%%
+handle_cast(_, State) ->
+ {noreply, State}.
+
+
diff --git a/lib/orber/src/orber_pi.erl b/lib/orber/src/orber_pi.erl
new file mode 100644
index 0000000000..887c3924e1
--- /dev/null
+++ b/lib/orber/src/orber_pi.erl
@@ -0,0 +1,1210 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_pi.erl
+%% Purpose :
+%% Comments:
+%% * Each Interceptor is represented by Module where
+%% Module - refers to a module which must export the functions:
+%% (1) receive_request
+%% (2) send_other
+%% (3) receive_service_contexts
+%% (4) send_reply
+%% (5) send_exception
+%% (6) send_request
+%% (7) send_poll
+%% (8) receive_reply
+%% (9) receive_exception
+%% (10) receive_other
+%% or
+%% (11) new_out_connection
+%% (12) new_in_connection
+%% (13) in_request
+%% (14) out_reply
+%% (15) out_request
+%% (16) in_reply
+%%
+%% Functions (1) - (10) for Portable and (11) - (16) for
+%% Native Interceptors.
+%%
+%%----------------------------------------------------------------------
+
+-module(orber_pi).
+
+%%--------------- INCLUDES -----------------------------------
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/include/ifr_types.hrl").
+-include_lib("orber/include/orber_pi.hrl").
+-include_lib("orber/src/orber_iiop.hrl").
+
+%%--------------- EXPORTS-------------------------------------
+%% API external
+-export([%% Native Intercepotors API
+ new_out_connection/5,
+ new_in_connection/5,
+ closed_in_connection/2,
+ closed_out_connection/2,
+ in_request_enc/4,
+ out_reply_enc/5,
+ out_request_enc/6,
+ in_reply_enc/6,
+ in_request/4,
+ out_reply/5,
+ out_request/6,
+ in_reply/6,
+ %% Portable Interceptors
+ server_start_receive/7,
+ server_start_send/2,
+ client_receive/2,
+ client_send/2,
+ codefactory_create_codec/1,
+ codec_encode/2,
+ codec_encode_value/2,
+ codec_decode/2,
+ codec_decode_value/3,
+ %% RequestInfo
+ '_get_request_id'/1,
+ '_get_operation'/1,
+ '_get_arguments'/1,
+ '_get_exceptions'/1,
+ '_get_contexts'/1,
+ '_get_operation_context'/1,
+ '_get_result'/1,
+ '_get_response_expected'/1,
+ '_get_sync_scope'/1,
+ '_get_reply_status'/1,
+ '_get_forward_reference'/1,
+ get_slot/2,
+ get_request_service_context/2,
+ get_reply_service_context/2,
+ %% ClientRequestInfo (inherrits RequestInfo)
+ '_get_target'/1,
+ '_get_effective_target'/1,
+ '_get_effective_profile'/1,
+ '_get_received_exception'/1,
+ '_get_received_exception_id'/1,
+ get_effective_component/2,
+ get_effective_components/2,
+ get_request_policy/2,
+ add_request_service_policy/3,
+ %% ServerRequestInfo (inherrits RequestInfo)
+ '_get_sending_exception'/1,
+ '_get_object_id'/1,
+ '_get_adapter_id'/1,
+ '_get_target_most_derived_interface'/1,
+ get_server_policy/2,
+ set_slot/3,
+ target_is_a/2,
+ add_reply_service_context/3]).
+
+%%=============== DATA STRUCTURES ============================
+%%--------------- ClientRequestInfo --------------------------
+-record('ClientRequestInfo',
+ {request_id,
+ operation,
+ arguments,
+ exceptions,
+ contexts,
+ operation_context,
+ result,
+ response_expected,
+ sync_scope = 'SYNC_NONE',
+ reply_status,
+ forward_reference,
+ endian,
+ target,
+ effective_target,
+ effective_profile,
+ received_exception,
+ received_exception_id}).
+
+-define(createInitCRI(_ReqID, _Op, _Args, _Ctxs, _OpCtx, _RespExp, _Target,
+ _ETarget, _EProf),
+ #'ClientRequestInfo'{request_id = _ReqID,
+ operation = _Op,
+ arguments = _Args,
+ contexts = _Ctxs,
+ operation_context = _OpCtx,
+ response_expected = _RespExp,
+ target = _Target,
+ effective_target = _ETarget,
+ effective_profile = _EProf}).
+
+
+%%--------------- ServerRequestInfo --------------------------
+-record('ServerRequestInfo',
+ {request_id,
+ operation,
+ arguments,
+ exceptions,
+ contexts,
+ operation_context,
+ result,
+ response_expected,
+ sync_scope = 'SYNC_NONE',
+ reply_status,
+ forward_reference,
+ endian,
+ sending_exception,
+ object_id,
+ adapter_id,
+ target_most_derived_interface}).
+
+-define(createInitSRI(_ReqID, _Op, _RespExp),
+ #'ServerRequestInfo'{request_id = _ReqID,
+ operation = _Op,
+ response_expected = _RespExp}).
+
+
+%%--------------- DEFINES ------------------------------------
+-define(DEBUG_LEVEL, 9).
+
+-define(EFORMAT(_F, _A), exit(lists:flatten(io_lib:format(_F, _A)))).
+
+%%------------------------------------------------------------
+%%------------- NATIVE INTERCEPTOR FUNCTIONS------------------
+%%------------------------------------------------------------
+%% function : new_in_connection
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%------------------------------------------------------------
+new_in_connection(PIs, Host, Port, SHost, SPort) ->
+ case catch new_in_connection(PIs, undefined, Host, Port, SHost, SPort) of
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_pi:new_in_connection(~p); exit(~p)",
+ [?LINE, PIs, R], ?DEBUG_LEVEL),
+ ?EFORMAT("Supplied Interceptors unable to create a valid new_in_connection"
+ "Reason: ~p", [{'EXIT', R}]);
+ {'EXCEPTION', E} ->
+ orber:dbg("[~p] orber_pi:new_in_connection(~p); exception(~p)",
+ [?LINE, PIs, E], ?DEBUG_LEVEL),
+ ?EFORMAT("Supplied Interceptors unable to create a valid new_in_connection"
+ "Reason: ~p", [{'EXCEPTION', E}]);
+ Ref ->
+ Ref
+ end.
+
+new_in_connection([], Ref, _, _, _, _) ->
+ Ref;
+new_in_connection([Mod|T], Ref, Host, Port, SHost, SPort) ->
+ case get_arity(Mod, new_in_connection) of
+ 5 ->
+ NewRef = Mod:new_in_connection(Ref, Host, Port, SHost, SPort),
+ new_in_connection(T, NewRef, Host, Port, SHost, SPort);
+ 3 ->
+ NewRef = Mod:new_in_connection(Ref, Host, Port),
+ new_in_connection(T, NewRef, Host, Port, SHost, SPort)
+ end.
+
+get_arity(Mod, Func) ->
+ get_arity(Mod, Func, true).
+get_arity(Mod, Func, Retry) ->
+ case erlang:function_exported(Mod, Func, 5) of
+ true ->
+ 5;
+ false ->
+ case erlang:function_exported(Mod, Func, 3) of
+ true ->
+ 3;
+ false when Retry == true ->
+ {module, _} = code:ensure_loaded(Mod),
+ get_arity(Mod, Func, false);
+ false ->
+ exit("Unable to load interceptor")
+ end
+ end.
+
+%%------------------------------------------------------------
+%% function : closed_in_connection
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%------------------------------------------------------------
+closed_in_connection(PIs, Ref) ->
+ case catch closed_in_connection_helper(PIs, Ref) of
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_pi:closed_in_connection(~p, ~p); exit(~p)",
+ [?LINE, PIs, Ref, R], ?DEBUG_LEVEL),
+ ok;
+ {'EXCEPTION', E} ->
+ orber:dbg("[~p] orber_pi:closed_in_connection(~p, ~p); exception(~p)",
+ [?LINE, PIs, Ref, E], ?DEBUG_LEVEL),
+ ok;
+ _ ->
+ ok
+ end.
+
+closed_in_connection_helper([], _Ref) ->
+ ok;
+closed_in_connection_helper([Mod|T], Ref) ->
+ NewRef = Mod:closed_in_connection(Ref),
+ closed_in_connection_helper(T, NewRef).
+
+
+%%------------------------------------------------------------
+%% function : new_out_connection
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%------------------------------------------------------------
+new_out_connection(PIs, Host, Port, SHost, SPort) ->
+ case catch new_out_connection(PIs, undefined, Host, Port, SHost, SPort) of
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_pi:new_out_connection(~p); exit(~p)",
+ [?LINE, PIs, R], ?DEBUG_LEVEL),
+ ?EFORMAT("Supplied Interceptors unable to create a valid new_out_connection"
+ "Reason: ~p", [{'EXIT', R}]);
+ {'EXCEPTION', E} ->
+ orber:dbg("[~p] orber_pi:new_out_connection(~p); exception(~p)",
+ [?LINE, PIs, E], ?DEBUG_LEVEL),
+ ?EFORMAT("Supplied Interceptors unable to create a valid new_out_connection"
+ "Reason: ~p", [{'EXCEPTION', E}]);
+ Ref ->
+ Ref
+ end.
+
+new_out_connection([], Ref, _, _, _, _) ->
+ Ref;
+new_out_connection([Mod|T], Ref, Host, Port, SHost, SPort) ->
+ case get_arity(Mod, new_out_connection) of
+ 5 ->
+ NewRef = Mod:new_out_connection(Ref, Host, Port, SHost, SPort),
+ new_out_connection(T, NewRef, Host, Port, SHost, SPort);
+ 3 ->
+ NewRef = Mod:new_out_connection(Ref, Host, Port),
+ new_out_connection(T, NewRef, Host, Port, SHost, SPort)
+ end.
+
+%%------------------------------------------------------------
+%% function : closed_out_connection
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%------------------------------------------------------------
+closed_out_connection(PIs, Ref) ->
+ case catch closed_out_connection_helper(PIs, Ref) of
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_pi:closed_out_connection(~p); exit(~p)",
+ [?LINE, PIs, R], ?DEBUG_LEVEL),
+ ok;
+ {'EXCEPTION', E} ->
+ orber:dbg("[~p] orber_pi:closed_out_connection(~p); exception(~p)",
+ [?LINE, PIs, E], ?DEBUG_LEVEL),
+ ok;
+ _ ->
+ ok
+ end.
+
+closed_out_connection_helper([], _Ref) ->
+ ok;
+closed_out_connection_helper([Mod|T], Ref) ->
+ NewRef = Mod:closed_out_connection(Ref),
+ closed_out_connection_helper(T, NewRef).
+
+%%------------------------------------------------------------
+%% function : in_request_enc
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect : Intercepts an incoming request (server-side).
+%%------------------------------------------------------------
+in_request_enc(PIs, ReqHdr, Ref, Msg) ->
+ case catch in_request_enc(PIs, ReqHdr, Ref, Msg, undefined) of
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_pi:in_request_enc(~p, ~p, ~p); exit(~p)",
+ [?LINE, PIs, Ref, Msg, R], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
+ {'EXCEPTION', E} ->
+ orber:dbg("[~p] orber_pi:in_request_enc(~p, ~p, ~p); exception(~p)",
+ [?LINE, PIs, Ref, Msg, E], ?DEBUG_LEVEL),
+ corba:raise(E);
+ NewMsg ->
+ NewMsg
+ end.
+
+in_request_enc([], _, _, Msg, _) ->
+ Msg;
+in_request_enc([Mod|T], ReqHdr, Ref, Msg, Args) ->
+ {NewMsg, NewArgs} = Mod:in_request_encoded(Ref, ReqHdr#request_header.object_key,
+ ReqHdr#request_header.service_context,
+ ReqHdr#request_header.operation,
+ Msg, Args),
+ in_request_enc(T, ReqHdr, Ref, NewMsg, NewArgs).
+
+%%------------------------------------------------------------
+%% function : in_request
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect : Intercepts an incoming request (server-side).
+%%------------------------------------------------------------
+in_request(PIs, ReqHdr, Ref, Msg) ->
+ case catch in_request(PIs, ReqHdr, Ref, Msg, undefined) of
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_pi:in_request(~p, ~p, ~p); exit(~p)",
+ [?LINE, PIs, Ref, Msg, R], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
+ {'EXCEPTION', E} ->
+ orber:dbg("[~p] orber_pi:in_request(~p, ~p, ~p); exception(~p)",
+ [?LINE, PIs, Ref, Msg, E], ?DEBUG_LEVEL),
+ corba:raise(E);
+ NewMsg ->
+ NewMsg
+ end.
+
+in_request([], _, _, Msg, _) ->
+ Msg;
+in_request([Mod|T], ReqHdr, Ref, Msg, Args) ->
+ {NewMsg, NewArgs} = Mod:in_request(Ref, ReqHdr#request_header.object_key,
+ ReqHdr#request_header.service_context,
+ ReqHdr#request_header.operation,
+ Msg, Args),
+ in_request(T, ReqHdr, Ref, NewMsg, NewArgs).
+
+%%------------------------------------------------------------
+%% function : out_reply_enc
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect : Intercept an outgoing reply (server-side).
+%%------------------------------------------------------------
+out_reply_enc(PIs, ReqHdr, Ref, Msg, Ctx) ->
+ case catch out_reply_enc(PIs, ReqHdr, Ref, Msg, undefined, Ctx) of
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_pi:out_reply_enc(~p, ~p, ~p); exit(~p)",
+ [?LINE, PIs, Ref, Msg, R], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ {'EXCEPTION', E} ->
+ orber:dbg("[~p] orber_pi:out_reply_enc(~p, ~p, ~p); exception(~p)",
+ [?LINE, PIs, Ref, Msg, E], ?DEBUG_LEVEL),
+ corba:raise(E);
+ NewMsg ->
+ NewMsg
+ end.
+out_reply_enc([], _, _, Msg, _, _) ->
+ Msg;
+out_reply_enc([Mod|T], ReqHdr, Ref, Msg, Args, Ctx) ->
+ {NewMsg, NewArgs} = Mod:out_reply_encoded(Ref, ReqHdr#request_header.object_key,
+ Ctx, %% Out Context.
+ ReqHdr#request_header.operation,
+ Msg, Args),
+ out_reply_enc(T, ReqHdr, Ref, NewMsg, NewArgs, Ctx).
+
+
+%%------------------------------------------------------------
+%% function : out_reply
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect : Intercept an outgoing reply (server-side).
+%%------------------------------------------------------------
+out_reply(PIs, ReqHdr, Ref, Msg, Ctx) ->
+ case catch out_reply(PIs, ReqHdr, Ref, Msg, undefined, Ctx) of
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_pi:out_reply(~p, ~p, ~p); exit(~p)",
+ [?LINE, PIs, Ref, Msg, R], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ NewMsg ->
+ NewMsg
+ end.
+out_reply([], _, _, Msg, _, _) ->
+ Msg;
+out_reply([Mod|T], ReqHdr, Ref, Msg, Args, Ctx) ->
+ {NewMsg, NewArgs} = Mod:out_reply(Ref, ReqHdr#request_header.object_key,
+ Ctx, %% Out Context.
+ ReqHdr#request_header.operation,
+ Msg, Args),
+ out_reply(T, ReqHdr, Ref, NewMsg, NewArgs, Ctx).
+
+
+%%------------------------------------------------------------
+%% function : out_request_enc
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect : Intercept an outgoing request (client-side).
+%%------------------------------------------------------------
+out_request_enc(PIs, ObjKey, Ctx, Op, Ref, Msg) ->
+ case catch out_request_enc(PIs, ObjKey, Ctx, Op, Ref, Msg, undefined) of
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_pi:out_request_enc(~p, ~p, ~p); exit(~p)",
+ [?LINE, PIs, Ref, Msg, R], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
+ {'EXCEPTION', E} ->
+ orber:dbg("[~p] orber_pi:out_request_enc(~p, ~p, ~p); exception(~p)",
+ [?LINE, PIs, Ref, Msg, E], ?DEBUG_LEVEL),
+ corba:raise(E);
+ NewMsg ->
+ NewMsg
+ end.
+
+out_request_enc([], _, _, _, _, Msg, _) ->
+ Msg;
+out_request_enc([Mod|T], ObjKey, Ctx, Op, Ref, Msg, Args) ->
+ {NewMsg, NewArgs} = Mod:out_request_encoded(Ref, ObjKey, Ctx, Op, Msg, Args),
+ out_request_enc(T, ObjKey, Ctx, Op, Ref, NewMsg, NewArgs).
+
+
+%%------------------------------------------------------------
+%% function : out_request
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect : Intercept an outgoing request (client-side).
+%%------------------------------------------------------------
+out_request(PIs, ObjKey, Ctx, Op, Ref, Msg) ->
+ case catch out_request(PIs, ObjKey, Ctx, Op, Ref, Msg, undefined) of
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_pi:out_request(~p, ~p, ~p); exit(~p)",
+ [?LINE, PIs, Ref, Msg, R], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
+ {'EXCEPTION', E} ->
+ orber:dbg("[~p] orber_pi:out_request(~p, ~p, ~p); exception(~p)",
+ [?LINE, PIs, Ref, Msg, E], ?DEBUG_LEVEL),
+ corba:raise(E);
+ NewMsg ->
+ NewMsg
+ end.
+
+out_request([], _, _, _, _, Msg, _) ->
+ Msg;
+out_request([Mod|T], ObjKey, Ctx, Op, Ref, Msg, Args) ->
+ {NewMsg, NewArgs} = Mod:out_request(Ref, ObjKey, Ctx, Op, Msg, Args),
+ out_request(T, ObjKey, Ctx, Op, Ref, NewMsg, NewArgs).
+
+
+%%------------------------------------------------------------
+%% function :in_reply_enc
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect : Intercept an incoming reply (client-side)
+%%------------------------------------------------------------
+in_reply_enc(PIs, ObjKey, Ctx, Op, Ref, Msg) ->
+ case catch in_reply_enc(PIs, ObjKey, Ctx, Op, Ref, Msg, undefined) of
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_pi:in_reply_enc(~p, ~p, ~p); exit(~p)",
+ [?LINE, PIs, Ref, Msg, R], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ {'EXCEPTION', E} ->
+ orber:dbg("[~p] orber_pi:in_reply_enc(~p, ~p, ~p); exception(~p)",
+ [?LINE, PIs, Ref, Msg, E], ?DEBUG_LEVEL),
+ corba:raise(E);
+ NewMsg ->
+ NewMsg
+ end.
+
+in_reply_enc([], _, _, _, _, Msg, _) ->
+ Msg;
+in_reply_enc([Mod|T], ObjKey, Ctx, Op, Ref, Msg, Args) ->
+ {NewMsg, NewArgs} = Mod:in_reply_encoded(Ref, ObjKey, Ctx, Op, Msg, Args),
+ in_reply_enc(T, ObjKey, Ctx, Op, Ref, NewMsg, NewArgs).
+
+%%------------------------------------------------------------
+%% function :in_reply
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect : Intercept an incoming reply (client-side)
+%%------------------------------------------------------------
+in_reply(PIs, ObjKey, Ctx, Op, Ref, Msg) ->
+ case catch in_reply(PIs, ObjKey, Ctx, Op, Ref, Msg, undefined) of
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_pi:in_reply(~p, ~p, ~p); exit(~p)",
+ [?LINE, PIs, Ref, Msg, R], ?DEBUG_LEVEL),
+ corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
+ NewMsg ->
+ NewMsg
+ end.
+
+in_reply([], _, _, _, _, Msg, _) ->
+ Msg;
+in_reply([Mod|T], ObjKey, Ctx, Op, Ref, Msg, Args) ->
+ {NewMsg, NewArgs} = Mod:in_reply(Ref, ObjKey, Ctx, Op, Msg, Args),
+ in_reply(T, ObjKey, Ctx, Op, Ref, NewMsg, NewArgs).
+
+
+
+
+%%------------------------------------------------------------
+%%------------- CODEC FUNCTIONS ------------------------------
+%%------------------------------------------------------------
+%% function : codefactory_create_codec
+%% Arguments: #IOP_N_Encoding{}
+%% Returns : CodecRef
+%% Exception:
+%% Effect :
+%%------------------------------------------------------------
+codefactory_create_codec(#'IOP_N_Encoding'{format = 'IOP_N_ENCODING_CDR_ENCAPS',
+ major_version = Major,
+ minor_version = Minor})
+ when is_integer(Major) andalso is_integer(Minor) ->
+ {Major, Minor};
+codefactory_create_codec(_) ->
+ corba:raise(#'IOP_N_CodecFactory_UnknownEncoding'{}).
+
+%%------------------------------------------------------------
+%% function : codec_encode
+%% Arguments: Version - GIOP version
+%% Any - #any{}
+%% Returns : CORBA::OctetSeq
+%% Exception:
+%% Effect :
+%%------------------------------------------------------------
+codec_encode(Version, Any) when is_record(Any, any) ->
+ %% Encode ByteOrder
+ {Bytes, Len} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
+ {Bytes2, _Len2} = cdr_encode:enc_type('tk_any', Version, Any, Bytes, Len),
+ list_to_binary(lists:reverse(Bytes2));
+codec_encode(_Version, _Any) ->
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+%%------------------------------------------------------------
+%% function : codec_encode_value
+%% Arguments: Version - GIOP version
+%% Any - #any{}
+%% Returns : CORBA::OctetSeq
+%% Exception:
+%% Effect : Encode the Any#any.value only.
+%%------------------------------------------------------------
+codec_encode_value(Version, #any{typecode = TC, value = Val}) ->
+ %% Encode ByteOrder
+ {Bytes, Len} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
+ {Bytes2, _Len2} = cdr_encode:enc_type(TC, Version, Val, Bytes, Len),
+ list_to_binary(lists:reverse(Bytes2));
+codec_encode_value(_Version, _NotAnAny) ->
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+%%------------------------------------------------------------
+%% function : codec_decode
+%% Arguments: Version - GIOP version
+%% Bytes - CORBA::OctetSeq
+%% Returns : Any - #any{}
+%% Exception:
+%% Effect :
+%%------------------------------------------------------------
+codec_decode(Version, Bytes) when is_binary(Bytes) ->
+ {ByteOrder, Rest} = cdr_decode:dec_byte_order(Bytes),
+ case catch cdr_decode:dec_type('tk_any', Version, Rest, 0, ByteOrder) of
+ {Any, [], _} ->
+ Any;
+ _->
+ corba:raise(#'IOP_N_Codec_FormatMismatch'{})
+ end;
+codec_decode(_Version, _Any) ->
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+%%------------------------------------------------------------
+%% function : codec_decode_value
+%% Arguments: Version - GIOP version
+%% Bytes - CORBA::OctetSeq
+%% TypeCode - CORBA::TypeCode
+%% Returns : Any - #any{}
+%% Exception:
+%% Effect :
+%%------------------------------------------------------------
+codec_decode_value(Version, Bytes, TypeCode) when is_binary(Bytes) ->
+ {ByteOrder, Rest} = cdr_decode:dec_byte_order(Bytes),
+ case catch cdr_decode:dec_type(TypeCode, Version, Rest, 0, ByteOrder) of
+ {Val, [], _} ->
+ #any{typecode = TypeCode, value = Val};
+ _->
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
+ end;
+codec_decode_value(_Version, _Bytes, _TypeCode) ->
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
+
+
+%%------------------------------------------------------------
+%%------------- SERVER SIDE FUNCTIONS ------------------------
+%%------------------------------------------------------------
+%% To make a long story short, you find an conceptual description
+%% of how, and in which order, the different functions is
+%% supposed to be invoked.
+%%
+%%request_from_iiop(Bytes) ->
+%% Reply =
+%% case receive_service_contexts(ServerRequestInfo) of
+%% SYSTEM EXC ->
+%% send_exception(..);
+%% ForwardRequest EXC ->
+%% send_other(..);
+%% NoEXC ->
+%% case receive_request(..) of
+%% SYSTEM EXC ->
+%% send_exception(..);
+%% ForwardRequest EXC ->
+%% send_other(..);
+%% No EXC ->
+%% InvokeServer
+%% end
+%% end,
+%% case Reply of
+%% EXC ->
+%% send_exception(..);
+%% No EXC, Normal Reply ->
+%% case send_reply(..) of
+%% SYSTEM EXC ->
+%% send_exception(..);
+%% ForwardRequest EXC ->
+%% send_other(..);
+%% No Exc ->
+%% Done
+%% end;
+%% No EXC, LOCATION_FORWARD ->
+%% send_other(..)
+%% end.
+%%
+%%
+%%------------------------------------------------------------
+%% function : server_start_receive
+%% Arguments: Msg - #giop_message{}
+%% PIs - a list of Interceptors (see 'Comments' in the module header)
+%% Returns :
+%% Exception:
+%% Effect :
+%%------------------------------------------------------------
+server_start_receive(PIs, Version, ReqHdr, Rest, Len, ByteOrder, Msg) ->
+ cdr_decode:dec_request_body(Version, ReqHdr, Rest, Len, ByteOrder, Msg),
+ SRI = ?createInitSRI(ReqHdr#request_header.request_id,
+ ReqHdr#request_header.operation,
+ ReqHdr#request_header.response_expected),
+ server_receive(receive_service_contexts, SRI, PIs, [], PIs).
+
+server_receive(receive_service_contexts, SRI, [], _Acc, PIs) ->
+ server_receive(receive_request, SRI, PIs, [], PIs);
+server_receive(receive_service_contexts, SRI, [H|T], Acc, PIs) ->
+ case catch receive_service_contexts(SRI, H) of
+ {'EXCEPTION', #'PortableInterceptor_ForwardRequest'{forward=_Obj,
+ permanent=_Bool}} ->
+ server_send(send_other, SRI, Acc, [], PIs);
+ {'EXCEPTION', _E} ->
+ server_send(send_exception, SRI, Acc, [], PIs);
+ _ ->
+ server_receive(receive_service_contexts, SRI, T, Acc, PIs)
+ end;
+server_receive(receive_request, SRI, [], _Acc, _PIs) ->
+ %% Done with receive interceptors, now we can call the server.
+ SRI;
+server_receive(receive_request, SRI, [H|T], Acc, PIs) ->
+ case catch receive_request(SRI, H) of
+ {'EXCEPTION', #'PortableInterceptor_ForwardRequest'{forward=_Obj,
+ permanent=_Bool}} ->
+ server_send(send_other, SRI, Acc, [], PIs);
+ {'EXCEPTION', _E} ->
+ server_send(send_exception, SRI, Acc, [], PIs);
+ _ ->
+ server_receive(receive_request, SRI, T, Acc, PIs)
+ end.
+
+
+%%------------------------------------------------------------
+%% function : server_start_send
+%% Arguments: SRI - ServerRequestInfo
+%% PIs - a list of Interceptors (see 'Comments' in the module header)
+%% Returns :
+%% Exception:
+%% Effect :
+%%------------------------------------------------------------
+server_start_send(PIs, SRI) ->
+ case SRI#'ServerRequestInfo'.reply_status of
+ 'PortableInterceptor_SUCCESSFUL' ->
+ server_send(send_reply, SRI, PIs, [], PIs);
+ 'PortableInterceptor_SYSTEM_EXCEPTION' ->
+ server_send(send_exception, SRI, PIs, [], PIs);
+ 'PortableInterceptor_USER_EXCEPTION' ->
+ server_send(send_exception, SRI, PIs, [], PIs);
+ _ ->
+ server_send(send_other, SRI, PIs, [], PIs)
+ end.
+
+server_send(_, SRI, [], _Acc, _PIs) ->
+ %% Done
+ SRI;
+server_send(send_exception, SRI, [H|T], Acc, PIs) ->
+ case catch send_exception(SRI, H) of
+ {'EXCEPTION', #'PortableInterceptor_ForwardRequest'{forward=_Obj,
+ permanent=_Bool}} ->
+ server_send(send_other, SRI, Acc, [], PIs);
+ {'EXCEPTION', _E} ->
+ server_send(send_exception, SRI, Acc, [], PIs);
+ _ ->
+ server_send(send_exception, SRI, T, Acc, PIs)
+ end;
+server_send(send_other, SRI, [H|T], Acc, PIs) ->
+ case catch send_other(SRI, H) of
+ {'EXCEPTION', #'PortableInterceptor_ForwardRequest'{forward=_Obj,
+ permanent=_Bool}} ->
+ server_send(send_other, SRI, T, Acc, PIs);
+ {'EXCEPTION', _E} ->
+ server_send(send_exception, SRI, T, Acc, PIs);
+ _ ->
+ server_send(send_other, SRI, T, Acc, PIs)
+ end;
+server_send(send_reply, SRI, [H|T], Acc, PIs) ->
+ case catch send_reply(SRI, H) of
+ {'EXCEPTION', _E} ->
+ server_send(send_exception, SRI, T, Acc, PIs);
+ _ ->
+ server_send(send_reply, SRI, T, Acc, PIs)
+ end.
+
+receive_request(SRI, Mod) ->
+ apply(Mod, receive_request, [SRI]).
+
+send_other(SRI, Mod) ->
+ apply(Mod, send_other, [SRI]).
+
+receive_service_contexts(SRI, Mod) ->
+ apply(Mod, receive_service_contexts, [SRI]).
+
+send_reply(SRI, Mod) ->
+ apply(Mod, send_reply, [SRI]).
+
+send_exception(SRI, Mod) ->
+ apply(Mod, send_exception, [SRI]).
+
+
+%%------------------------------------------------------------
+%%------------- CLIENT SIDE FUNCTIONS ------------------------
+%%------------------------------------------------------------
+%% To make a long story short, you find an conceptual description
+%% of how, and in which order, the different functions is
+%% supposed to be invoked.
+%%
+%%request(Data) ->
+%% Reply =
+%% case send_request(CRI) of
+%% SYSTEM EXC ->
+%% receive_exception(..);
+%% ForwardRequest EXC ->
+%% receive_other(..);
+%% NoEXC ->
+%% IIOP-send
+%% end,
+%% case Reply of
+%% EXC ->
+%% receive_exception(..); May raise system exc => receive_other(..);
+%% No EXC, Normal Reply ->
+%% receive_reply(..) May raise system exc => receive_exception(..);
+%% Non-normal reply (e.g. LOCATION_FORWARD) ->
+%% receive_other(..) May raise system exc => receive_exception(..);
+%% end.
+%%------------------------------------------------------------
+%% function : client_send
+%% Arguments: CRI - ClientRequestInfo
+%% PIs - a list of Interceptors (see 'Comments' in the module header)
+%% Returns :
+%% Exception:
+%% Effect :
+%%------------------------------------------------------------
+
+client_send(CRI, PIs) ->
+ client_send(send_request, CRI, PIs, [], PIs).
+
+client_send(send_request, CRI, [], _, _) ->
+ CRI;
+client_send(send_request, CRI, [H|T], Acc, PIs) ->
+ case catch send_request(CRI, H) of
+ {'EXCEPTION', #'PortableInterceptor_ForwardRequest'{forward=_Obj,
+ permanent=_Bool}} ->
+ client_receive(receive_other, CRI, T, [], PIs);
+ {'EXCEPTION', _E} ->
+ client_receive(receive_exception, CRI, Acc, [], PIs);
+ _ ->
+ client_send(send_request, CRI, T, Acc, PIs)
+ end.
+
+
+
+%%------------------------------------------------------------
+%% function : client_receive
+%% Arguments: CRI - ClientRequestInfo
+%% PIs - a list of Interceptors (see 'Comments' in the module header)
+%% Returns :
+%% Exception:
+%% Effect :
+%%------------------------------------------------------------
+
+client_receive(CRI, PIs) ->
+ case CRI#'ClientRequestInfo'.reply_status of
+ 'PortableInterceptor_SUCCESSFUL' ->
+ client_receive(receive_reply, CRI, PIs, [], PIs);
+ 'PortableInterceptor_SYSTEM_EXCEPTION' ->
+ client_receive(receive_exception, CRI, PIs, [], PIs);
+ 'PortableInterceptor_USER_EXCEPTION' ->
+ client_receive(receive_exception, CRI, PIs, [], PIs);
+ _ ->
+ client_receive(receive_other, CRI, PIs, [], PIs)
+ end.
+
+client_receive(_, CRI, [], _, _) ->
+ %% Done
+ CRI;
+client_receive(receive_reply, CRI, [H|T], Acc, PIs) ->
+ case catch receive_reply(CRI, H) of
+ {'EXCEPTION', _E} ->
+ client_receive(receive_exception, CRI, T, [H|Acc], PIs);
+ _ ->
+ client_receive(receive_reply, CRI, T, [H|Acc], PIs)
+ end;
+client_receive(receive_exception, CRI, [H|T], Acc, PIs) ->
+ case catch receive_exception(CRI, H) of
+ {'EXCEPTION', #'PortableInterceptor_ForwardRequest'{forward=_Obj,
+ permanent=_Bool}} ->
+ client_receive(receive_other, CRI, T, [], PIs);
+ {'EXCEPTION', _E} ->
+ client_receive(receive_exception, CRI, T, [H|Acc], PIs);
+ _ ->
+ client_receive(receive_exception, CRI, T, [H|Acc], PIs)
+ end;
+client_receive(receive_other, CRI, [H|T], Acc, PIs) ->
+ case catch receive_other(CRI, H) of
+ {'EXCEPTION', #'PortableInterceptor_ForwardRequest'{forward=_Obj,
+ permanent=_Bool}} ->
+ client_receive(receive_other, CRI, T, [], PIs);
+ {'EXCEPTION', _E} ->
+ client_receive(receive_exception, CRI, T, [H|Acc], PIs);
+ _ ->
+ client_receive(receive_other, CRI, T, [H|Acc], PIs)
+ end.
+
+
+
+send_request(CRI, Mod) ->
+ apply(Mod, send_request, [CRI]).
+
+receive_reply(CRI, Mod) ->
+ apply(Mod, receive_reply, [CRI]).
+
+receive_other(CRI, Mod) ->
+ apply(Mod, receive_other, [CRI]).
+
+receive_exception(CRI, Mod) ->
+ apply(Mod, receive_exception, [CRI]).
+
+%%------------------------------------------------------------
+%% Functions for retrieving info from RequestInfo
+%% ServerRequestInfo and ClientRequestInfo. The ones matching
+%% both ServerRequestInfo and ClientRequestInfo eq. RequestInfo.
+%% Note, RequestInfo is inherrited by the others.
+%%------------------------------------------------------------
+%%-----------------------------------------------------------%
+%% function : _get_request_id
+%% Arguments: ClientRequestInfo or ServerRequestInfo
+%% Returns : ulong()
+%%------------------------------------------------------------
+'_get_request_id'(#'ClientRequestInfo'{request_id = ID}) ->
+ ID;
+'_get_request_id'(#'ServerRequestInfo'{request_id = ID}) ->
+ ID.
+
+%%-----------------------------------------------------------%
+%% function : _get_operation
+%% Arguments: ClientRequestInfo or ServerRequestInfo
+%% Returns : string()
+%%------------------------------------------------------------
+'_get_operation'(#'ClientRequestInfo'{operation = Op}) ->
+ Op;
+'_get_operation'(#'ServerRequestInfo'{operation = Op}) ->
+ Op.
+
+%%-----------------------------------------------------------%
+%% function : _get_arguments
+%% Arguments: ClientRequestInfo or ServerRequestInfo
+%% Returns : A list of #'Dynamic_Parameter'{}
+%%------------------------------------------------------------
+'_get_arguments'(#'ClientRequestInfo'{arguments = Args}) ->
+ Args;
+'_get_arguments'(#'ServerRequestInfo'{arguments = Args}) ->
+ Args.
+
+%%-----------------------------------------------------------%
+%% function : _get_exceptions
+%% Arguments: ClientRequestInfo or ServerRequestInfo
+%% Returns : A list of CORBA::TypeCode
+%%------------------------------------------------------------
+'_get_exceptions'(#'ClientRequestInfo'{exceptions = Exc}) ->
+ Exc;
+'_get_exceptions'(#'ServerRequestInfo'{exceptions = Exc}) ->
+ Exc.
+
+%%-----------------------------------------------------------%
+%% function : _get_contexts
+%% Arguments: ClientRequestInfo or ServerRequestInfo
+%% Returns : A list of CORBA::StringSeq
+%%------------------------------------------------------------
+'_get_contexts'(#'ClientRequestInfo'{contexts = Ctx}) ->
+ Ctx;
+'_get_contexts'(#'ServerRequestInfo'{contexts = Ctx}) ->
+ Ctx.
+
+%%-----------------------------------------------------------%
+%% function : _get_operation_context
+%% Arguments: ClientRequestInfo or ServerRequestInfo
+%% Returns : A list of CORBA::StringSeq
+%%------------------------------------------------------------
+'_get_operation_context'(#'ClientRequestInfo'{operation_context = OpCtx}) ->
+ OpCtx;
+'_get_operation_context'(#'ServerRequestInfo'{operation_context = OpCtx}) ->
+ OpCtx.
+
+%%-----------------------------------------------------------%
+%% function : _get_result
+%% Arguments: ClientRequestInfo or ServerRequestInfo
+%% Returns : #any{}
+%%------------------------------------------------------------
+'_get_result'(#'ClientRequestInfo'{result = Res}) ->
+ Res;
+'_get_result'(#'ServerRequestInfo'{result = Res}) ->
+ Res.
+
+%%-----------------------------------------------------------%
+%% function : _get_response_expected
+%% Arguments: ClientRequestInfo or ServerRequestInfo
+%% Returns : boolean()
+%%------------------------------------------------------------
+'_get_response_expected'(#'ClientRequestInfo'{response_expected = Bool}) ->
+ Bool;
+'_get_response_expected'(#'ServerRequestInfo'{response_expected = Bool}) ->
+ Bool.
+
+%%-----------------------------------------------------------%
+%% function : _get_sync_scope
+%% Arguments: ClientRequestInfo or ServerRequestInfo
+%% Returns : Messaging::SyncScoope ('SYNC_NONE', 'SYNC_WITH_TRANSPORT',
+%% 'SYNC_WITH_SERVER', 'SYNC_WITH_TARGET')
+%%------------------------------------------------------------
+'_get_sync_scope'(#'ClientRequestInfo'{sync_scope = SS}) ->
+ SS;
+'_get_sync_scope'(#'ServerRequestInfo'{sync_scope = SS}) ->
+ SS.
+
+%%-----------------------------------------------------------%
+%% function : _get_reply_status
+%% Arguments: ClientRequestInfo or ServerRequestInfo
+%% Returns : ReplyStatus (short), defined in orber_pi.hrl
+%%------------------------------------------------------------
+'_get_reply_status'(#'ClientRequestInfo'{reply_status = RS}) ->
+ RS;
+'_get_reply_status'(#'ServerRequestInfo'{reply_status = RS}) ->
+ RS.
+
+%%-----------------------------------------------------------%
+%% function : _get_forward_reference
+%% Arguments: ClientRequestInfo or ServerRequestInfo
+%% Returns : Object
+%%------------------------------------------------------------
+'_get_forward_reference'(#'ClientRequestInfo'{forward_reference = FR}) ->
+ FR;
+'_get_forward_reference'(#'ServerRequestInfo'{forward_reference = FR}) ->
+ FR.
+
+%%------------------------------------------------------------
+%% function : get_slot
+%% Arguments: ClientRequestInfo or ServerRequestInfo
+%% SlotId - ulong()
+%% Returns : {'EXCEPTION', #'PortableInterceptor_InvalidSlot'{}}
+%%------------------------------------------------------------
+get_slot(_XRI, _SlotId) ->
+ corba:raise(#'PortableInterceptor_InvalidSlot'{}).
+
+%%------------------------------------------------------------
+%% function : get_request_service_context
+%% Arguments: ClientRequestInfo or ServerRequestInfo
+%% ServiceId - IOP::ServiceId (defined in orber_iiop.hrl)
+%% Returns : IOP::ServiceContext
+%%------------------------------------------------------------
+get_request_service_context(#'ClientRequestInfo'{contexts = Ctx}, _ServiceId) ->
+ Ctx;
+get_request_service_context(#'ServerRequestInfo'{contexts = Ctx}, _ServiceId) ->
+ Ctx.
+
+%%------------------------------------------------------------
+%% function : get_reply_service_context
+%% Arguments: ClientRequestInfo or ServerRequestInfo
+%% ServiceId - IOP::ServiceId (defined in orber_iiop.hrl)
+%% Returns : IOP::ServiceContext
+%%------------------------------------------------------------
+get_reply_service_context(#'ClientRequestInfo'{contexts = Ctx}, _ServiceId) ->
+ Ctx;
+get_reply_service_context(#'ServerRequestInfo'{contexts = Ctx}, _ServiceId) ->
+ Ctx.
+
+%%------------------------------------------------------------
+%%-------------- ClientRequestInfo only ----------------------
+%%-----------------------------------------------------------%
+%% function : _get_target
+%% Arguments: ClientRequestInfo
+%% Returns : Object
+%%------------------------------------------------------------
+'_get_target'(#'ClientRequestInfo'{target = Target}) ->
+ Target.
+
+%%-----------------------------------------------------------%
+%% function : _get_effective_target
+%% Arguments: ClientRequestInfo
+%% Returns : Object
+%%------------------------------------------------------------
+'_get_effective_target'(#'ClientRequestInfo'{effective_target = ET}) ->
+ ET.
+
+%%-----------------------------------------------------------%
+%% function : _get_effective_profile
+%% Arguments: ClientRequestInfo
+%% Returns : IOP:TaggedProfile
+%%------------------------------------------------------------
+'_get_effective_profile'(#'ClientRequestInfo'{effective_profile = EP}) ->
+ EP.
+
+%%-----------------------------------------------------------%
+%% function : _get_received_exception
+%% Arguments: ClientRequestInfo
+%% Returns : #any{}
+%%------------------------------------------------------------
+'_get_received_exception'(#'ClientRequestInfo'{received_exception = RE}) ->
+ RE.
+
+%%-----------------------------------------------------------%
+%% function : _get_received_exception
+%% Arguments: ClientRequestInfo
+%% Returns : CORBA::RepositoryId
+%%------------------------------------------------------------
+'_get_received_exception_id'(#'ClientRequestInfo'{received_exception_id = REId}) ->
+ REId.
+
+%%------------------------------------------------------------
+%% function : get_effective_component
+%% Arguments: ClientRequestInfo
+%% Returns : IOR::TaggedComponent
+%%------------------------------------------------------------
+get_effective_component(#'ClientRequestInfo'{target = Target}, _Id) ->
+ Target.
+
+%%------------------------------------------------------------
+%% function : get_effective_components
+%% Arguments: ClientRequestInfo
+%% Id -IOP::ComponentId (ulong())
+%% Returns : IOP_N::TaggedComponentSeq
+%%------------------------------------------------------------
+get_effective_components(#'ClientRequestInfo'{target = Target}, _Id) ->
+ Target.
+
+%%------------------------------------------------------------
+%% function : get_request_policy
+%% Arguments: ClientRequestInfo
+%% Type - CORBA::PolicyType
+%% Returns : IOP_N::TaggedComponentSeq
+%%------------------------------------------------------------
+get_request_policy(#'ClientRequestInfo'{target = Target}, _Type) ->
+ Target.
+
+%%------------------------------------------------------------
+%% function : add_request_service_context
+%% Arguments: ClientRequestInfo
+%% Ctx - IOP::ServiceContext
+%% Replace - boolean()
+%% Returns : -
+%%------------------------------------------------------------
+add_request_service_policy(#'ClientRequestInfo'{target = _Target},
+ _Ctx, _Replace) ->
+ ok.
+
+%%------------------------------------------------------------
+%%-------------- ServerRequestInfo only ----------------------
+%%-----------------------------------------------------------%
+%% function : _get_sending_exception
+%% Arguments: ServerRequestInfo
+%% Returns : #any{}
+%%------------------------------------------------------------
+'_get_sending_exception'(#'ServerRequestInfo'{sending_exception = Exc}) ->
+ Exc.
+
+%%-----------------------------------------------------------%
+%% function : _get_object_id
+%% Arguments: ServerRequestInfo
+%% Returns : CORBA::OctetSeq
+%%------------------------------------------------------------
+'_get_object_id'(#'ServerRequestInfo'{object_id = OI}) ->
+ OI.
+
+%%-----------------------------------------------------------%
+%% function : _get_adapter_id
+%% Arguments: ServerRequestInfo
+%% Returns : CORBA::OctetSeq
+%%------------------------------------------------------------
+'_get_adapter_id'(#'ServerRequestInfo'{adapter_id = AI}) ->
+ AI.
+
+%%-----------------------------------------------------------%
+%% function : _get_target_most_derived_interface
+%% Arguments: ServerRequestInfo
+%% Returns : CORBA::RepositoryId
+%%------------------------------------------------------------
+'_get_target_most_derived_interface'(#'ServerRequestInfo'
+ {target_most_derived_interface = TMDI}) ->
+ TMDI.
+
+%%------------------------------------------------------------
+%% function : get_server_policy
+%% Arguments: ServerRequestInfo
+%% PolicyType - CORBA::PolicyType
+%% Returns : CORBA::Policy
+%%------------------------------------------------------------
+get_server_policy(#'ServerRequestInfo'{contexts = Ctxs}, _PolicyType) ->
+ Ctxs.
+
+%%------------------------------------------------------------
+%% function : set_slot
+%% Arguments: ServerRequestInfo
+%% SlotId - ulong()
+%% Data - #any{}
+%% Returns : {'EXCEPTION', #'PortableInterceptor_InvalidSlot'{}}
+%%------------------------------------------------------------
+set_slot(_SRI, _SlotId, _Data) ->
+ corba:raise(#'PortableInterceptor_InvalidSlot'{}).
+
+%%-----------------------------------------------------------%
+%% function : target_is_a
+%% Arguments: ServerRequestInfo
+%% IFRId - CORBA::RepositoryId
+%% Returns : boolean()
+%%------------------------------------------------------------
+target_is_a(#'ServerRequestInfo'{object_id = ObjId}, IFRId) ->
+ corba_object:is_a(ObjId, IFRId).
+
+%%------------------------------------------------------------
+%% function : add_reply_service_context
+%% Arguments: ServerRequestInfo
+%% Ctx - IOP::ServiceContext
+%% Replace - boolean()
+%% Returns : -
+%%------------------------------------------------------------
+add_reply_service_context(#'ServerRequestInfo'{contexts = Ctxs}, _Ctx, _Replace) ->
+ Ctxs.
+
+
+%%--------------- END OF MODULE ------------------------------
diff --git a/lib/orber/src/orber_request_number.erl b/lib/orber/src/orber_request_number.erl
new file mode 100644
index 0000000000..77ca9e083a
--- /dev/null
+++ b/lib/orber/src/orber_request_number.erl
@@ -0,0 +1,82 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_request_number.erl
+%%
+%% Description:
+%% This file contains the request number server in Orber
+%%
+%%-----------------------------------------------------------------
+-module(orber_request_number).
+
+-behaviour(gen_server).
+
+-include_lib("orber/src/orber_iiop.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start/1, get/0, reset/0]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([init/1, terminate/2, handle_call/3]).
+-export([handle_cast/2, handle_info/2, code_change/3]).
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+start(Opts) ->
+ gen_server:start_link({local, orber_reqno}, orber_request_number, Opts, []).
+
+get() ->
+ gen_server:call(orber_reqno, get, infinity).
+
+reset() ->
+ gen_server:call(orber_reqno, reset, infinity).
+
+%%-----------------------------------------------------------------
+%% Server functions
+%%-----------------------------------------------------------------
+init(_Opts) ->
+ {ok, 0}.
+
+terminate(_Reason, _State) ->
+ ok.
+%% Max is ulong 0 .. 2^32-1
+handle_call(get, _From, State) when State < ?ULONGMAX ->
+ {reply, State, State+1};
+handle_call(get, _From, _State) ->
+ {reply, ?ULONGMAX, 0};
+handle_call(reset, _From, _State) ->
+ {reply, ok, 0}.
+
+handle_cast(_, State) ->
+ {noreply, State}.
+
+handle_info(_, State) ->
+ {noreply, State}.
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+
diff --git a/lib/orber/src/orber_socket.erl b/lib/orber/src/orber_socket.erl
new file mode 100644
index 0000000000..2a64bd4e75
--- /dev/null
+++ b/lib/orber/src/orber_socket.erl
@@ -0,0 +1,504 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_socket.erl
+%%
+%% Description:
+%% This file contains a standard interface to the sockets to handle the differences
+%% between the implementations used.
+%%
+%%-----------------------------------------------------------------
+-module(orber_socket).
+
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/src/orber_iiop.hrl").
+
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([start/0, connect/4, listen/3, listen/4, accept/2, accept/3, write/3,
+ controlling_process/3, close/2, peername/2, sockname/2,
+ peerdata/2, peercert/2, peercert/3, sockdata/2, setopts/3,
+ clear/2, shutdown/3, post_accept/2, post_accept/3]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([]).
+
+%%-----------------------------------------------------------------
+%% Internal defines
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 6).
+
+%%-----------------------------------------------------------------
+%% External functions
+%%-----------------------------------------------------------------
+start() ->
+ inet_db:start().
+
+%%-----------------------------------------------------------------
+%% Invoke the required setopts (i.e., inet or ssl)
+setopts(normal, Socket, Opts) ->
+ inet:setopts(Socket, Opts);
+setopts(ssl, Socket, Opts) ->
+ ssl:setopts(Socket, Opts).
+
+%%-----------------------------------------------------------------
+%% Connect to IIOP Port at Host in CDR mode, in order to
+%% establish a connection.
+%%
+connect(Type, Host, Port, Options) ->
+ Timeout = orber:iiop_setup_connection_timeout(),
+ Generation = orber_env:ssl_generation(),
+ Options1 = check_options(Type, Options, Generation),
+ Options2 =
+ case Type of
+ normal ->
+ [{keepalive, orber_env:iiop_out_keepalive()}|Options1];
+ _ when Generation > 2 ->
+ [{keepalive, orber_env:iiop_ssl_out_keepalive()}|Options1];
+ _ ->
+ Options1
+ end,
+ case orber:iiop_out_ports() of
+ {Min, Max} when Type == normal ->
+ multi_connect(Min, Max, Type, Host, Port,
+ [binary, {reuseaddr, true},
+ {packet,cdr}| Options2], Timeout);
+ {Min, Max} when Generation > 2 ->
+ multi_connect(Min, Max, Type, Host, Port,
+ [binary, {reuseaddr, true},
+ {packet,cdr}| Options2], Timeout);
+ {Min, Max} ->
+ %% reuseaddr not available for older SSL versions
+ multi_connect(Min, Max, Type, Host, Port,
+ [binary, {packet,cdr}| Options2], Timeout);
+ _ ->
+ connect(Type, Host, Port, [binary, {packet,cdr}| Options2], Timeout)
+ end.
+
+connect(normal, Host, Port, Options, Timeout) ->
+ case catch gen_tcp:connect(Host, Port, Options, Timeout) of
+ {ok, Socket} ->
+ Socket;
+ {error, timeout} ->
+ orber:dbg("[~p] orber_socket:connect(normal, ~p, ~p, ~p);~n"
+ "Timeout after ~p msec.",
+ [?LINE, Host, Port, Options, Timeout], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO});
+ Error ->
+ orber:dbg("[~p] orber_socket:connect(normal, ~p, ~p, ~p);~n"
+ "Failed with reason: ~p",
+ [?LINE, Host, Port, Options, Error], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
+ end;
+connect(ssl, Host, Port, Options, Timeout) ->
+ case catch ssl:connect(Host, Port, Options, Timeout) of
+ {ok, Socket} ->
+ Socket;
+ {error, timeout} ->
+ orber:dbg("[~p] orber_socket:connect(ssl, ~p, ~p, ~p);~n"
+ "Timeout after ~p msec.",
+ [?LINE, Host, Port, Options, Timeout], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO});
+ Error ->
+ orber:dbg("[~p] orber_socket:connect(ssl, ~p, ~p, ~p);~n"
+ "Failed with reason: ~p",
+ [?LINE, Host, Port, Options, Error], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
+ end.
+
+multi_connect(CurrentPort, Max, Type, Host, Port, Options, _) when CurrentPort > Max ->
+ orber:dbg("[~p] orber_socket:multi_connect(~p, ~p, ~p, ~p);~n"
+ "Unable to use any of the sockets defined by 'iiop_out_ports'.~n"
+ "Either all ports are in use or to many connections already exists.",
+ [?LINE, Type, Host, Port, Options], ?DEBUG_LEVEL),
+ corba:raise(#'IMP_LIMIT'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_NO});
+multi_connect(CurrentPort, Max, normal, Host, Port, Options, Timeout) ->
+ case catch gen_tcp:connect(Host, Port, [{port, CurrentPort}|Options], Timeout) of
+ {ok, Socket} ->
+ Socket;
+ {error, timeout} ->
+ orber:dbg("[~p] orber_socket:multi_connect(normal, ~p, ~p, ~p);~n"
+ "Timeout after ~p msec.",
+ [?LINE, Host, Port, [{port, CurrentPort}|Options],
+ Timeout], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO});
+ _ ->
+ multi_connect(CurrentPort+1, Max, normal, Host, Port, Options, Timeout)
+ end;
+multi_connect(CurrentPort, Max, ssl, Host, Port, Options, Timeout) ->
+ case catch ssl:connect(Host, Port, [{port, CurrentPort}|Options], Timeout) of
+ {ok, Socket} ->
+ Socket;
+ {error, timeout} ->
+ orber:dbg("[~p] orber_socket:multi_connect(ssl, ~p, ~p, ~p);~n"
+ "Timeout after ~p msec.",
+ [?LINE, Host, Port, [{port, CurrentPort}|Options],
+ Timeout], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{minor=(?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO});
+ _ ->
+ multi_connect(CurrentPort+1, Max, ssl, Host, Port, Options, Timeout)
+ end.
+
+
+
+%%-----------------------------------------------------------------
+%% Create a listen socket at Port in CDR mode for
+%% data connection.
+%%
+listen(Type, Port, Options) ->
+ listen(Type, Port, Options, true).
+
+listen(normal, Port, Options, Exception) ->
+ Options1 = check_options(normal, Options, 0),
+ Backlog = orber:iiop_backlog(),
+ Keepalive = orber_env:iiop_in_keepalive(),
+ Options2 = case orber:iiop_max_in_requests() of
+ infinity ->
+ Options1;
+ _MaxRequests ->
+ [{active, once}|Options1]
+ end,
+ Options3 = case orber_env:iiop_packet_size() of
+ infinity ->
+ Options2;
+ MaxSize ->
+ [{packet_size, MaxSize}|Options2]
+ end,
+ case catch gen_tcp:listen(Port, [binary, {packet,cdr}, {keepalive, Keepalive},
+ {reuseaddr,true}, {backlog, Backlog} |
+ Options3]) of
+ {ok, ListenSocket} ->
+ {ok, ListenSocket, check_port(Port, normal, ListenSocket)};
+ {error, Reason} when Exception == false ->
+ {error, Reason};
+ {error, eaddrinuse} ->
+ AllOpts = [binary, {packet,cdr},
+ {reuseaddr,true} | Options3],
+ orber:dbg("[~p] orber_socket:listen(normal, ~p, ~p);~n"
+ "Looks like the listen port is already in use.~n"
+ "Check if another Orber is started~n"
+ "on the same node and uses the same listen port (iiop_port). But it may also~n"
+ "be used by any other application; confirm with 'netstat'.",
+ [?LINE, Port, AllOpts], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO});
+ Error ->
+ AllOpts = [binary, {packet,cdr},
+ {reuseaddr,true} | Options3],
+ orber:dbg("[~p] orber_socket:listen(normal, ~p, ~p);~n"
+ "Failed with reason: ~p",
+ [?LINE, Port, AllOpts, Error], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
+ end;
+listen(ssl, Port, Options, Exception) ->
+ Backlog = orber:iiop_ssl_backlog(),
+ Generation = orber_env:ssl_generation(),
+ Options1 = check_options(ssl, Options, Generation),
+ Options2 = case orber:iiop_max_in_requests() of
+ infinity ->
+ Options1;
+ _MaxRequests ->
+ [{active, once}|Options1]
+ end,
+ Options3 = case orber_env:iiop_packet_size() of
+ infinity ->
+ Options2;
+ MaxSize ->
+ [{packet_size, MaxSize}|Options2]
+ end,
+ Options4 = if
+ Generation > 2 ->
+ [{reuseaddr, true},
+ {keepalive, orber_env:iiop_ssl_in_keepalive()}|Options3];
+ true ->
+ Options3
+ end,
+ case catch ssl:listen(Port, [binary, {packet,cdr},
+ {backlog, Backlog} | Options4]) of
+ {ok, ListenSocket} ->
+ {ok, ListenSocket, check_port(Port, ssl, ListenSocket)};
+ {error, Reason} when Exception == false ->
+ {error, Reason};
+ {error, eaddrinuse} ->
+ AllOpts = [binary, {packet,cdr} | Options4],
+ orber:dbg("[~p] orber_socket:listen(ssl, ~p, ~p);~n"
+ "Looks like the listen port is already in use. Check if~n"
+ "another Orber is started on the same node and uses the~n"
+ "same listen port (iiop_port). But it may also~n"
+ "be used by any other application; confirm with 'netstat'.",
+ [?LINE, Port, AllOpts], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO});
+ Error ->
+ AllOpts = [binary, {packet,cdr} | Options4],
+ orber:dbg("[~p] orber_socket:listen(ssl, ~p, ~p);~n"
+ "Failed with reason: ~p",
+ [?LINE, Port, AllOpts, Error], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
+ end.
+
+%%-----------------------------------------------------------------
+%% Wait in accept on the socket
+%%
+accept(Type, ListenSocket) ->
+ accept(Type, ListenSocket, infinity).
+
+accept(normal, ListenSocket, _Timeout) ->
+ case catch gen_tcp:accept(ListenSocket) of
+ {ok, S} ->
+ S;
+ Error ->
+ orber:dbg("[~p] orber_socket:accept(normal, ~p);~n"
+ "Failed with reason: ~p",
+ [?LINE, ListenSocket, Error], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
+ end;
+accept(ssl, ListenSocket, Timeout) ->
+ case catch ssl:transport_accept(ListenSocket, Timeout) of
+ {ok, S} ->
+ S;
+ Error ->
+ orber:dbg("[~p] orber_socket:accept(ssl, ~p);~n"
+ "Failed with reason: ~p",
+ [?LINE, ListenSocket, Error], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
+ end.
+
+post_accept(Type, Socket) ->
+ post_accept(Type, Socket, infinity).
+
+post_accept(normal, _Socket, _Timeout) ->
+ ok;
+post_accept(ssl, Socket, Timeout) ->
+ case catch ssl:ssl_accept(Socket, Timeout) of
+ ok ->
+ ok;
+ Error ->
+ orber:dbg("[~p] orber_socket:post_accept(ssl, ~p);~n"
+ "Failed with reason: ~p",
+ [?LINE, Socket, Error], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Close the socket
+%%
+close(normal, Socket) ->
+ (catch gen_tcp:close(Socket));
+close(ssl, Socket) ->
+ (catch ssl:close(Socket)).
+
+%%-----------------------------------------------------------------
+%% Write to socket
+%%
+write(normal, Socket, Bytes) ->
+ gen_tcp:send(Socket, Bytes);
+write(ssl, Socket, Bytes) ->
+ ssl:send(Socket, Bytes).
+
+%%-----------------------------------------------------------------
+%% Change the controlling process for the socket
+%%
+controlling_process(normal, Socket, Pid) ->
+ gen_tcp:controlling_process(Socket, Pid);
+controlling_process(ssl, Socket, Pid) ->
+ ssl:controlling_process(Socket, Pid).
+
+%%-----------------------------------------------------------------
+%% Get peername
+%%
+peername(normal, Socket) ->
+ inet:peername(Socket);
+peername(ssl, Socket) ->
+ ssl:peername(Socket).
+
+%%-----------------------------------------------------------------
+%% Get peercert
+%%
+peercert(ssl, Socket) ->
+ ssl:peercert(Socket);
+peercert(Type, _Socket) ->
+ orber:dbg("[~p] orber_socket:peercert(~p);~n"
+ "Only available for SSL sockets.",
+ [?LINE, Type], ?DEBUG_LEVEL),
+ {error, ebadsocket}.
+
+peercert(ssl, Socket, Opts) ->
+ ssl:peercert(Socket, Opts);
+peercert(Type, _Socket, Opts) ->
+ orber:dbg("[~p] orber_socket:peercert(~p, ~p);~n"
+ "Only available for SSL sockets.",
+ [?LINE, Type, Opts], ?DEBUG_LEVEL),
+ {error, ebadsocket}.
+
+%%-----------------------------------------------------------------
+%% Get peerdata
+%%
+peerdata(normal, Socket) ->
+ create_data(inet:peername(Socket));
+peerdata(ssl, Socket) ->
+ create_data(ssl:peername(Socket)).
+
+%%-----------------------------------------------------------------
+%% Get sockname
+%%
+sockname(normal, Socket) ->
+ inet:sockname(Socket);
+sockname(ssl, Socket) ->
+ ssl:sockname(Socket).
+
+%%-----------------------------------------------------------------
+%% Get sockdata
+%%
+sockdata(normal, Socket) ->
+ create_data(inet:sockname(Socket));
+sockdata(ssl, Socket) ->
+ create_data(ssl:sockname(Socket)).
+
+
+create_data({ok, {Addr, Port}}) ->
+ {orber_env:addr2str(Addr), Port};
+create_data(What) ->
+ orber:dbg("[~p] orber_socket:peername() or orber_socket:sockname();~n"
+ "Failed with reason: ~p", [?LINE, What], ?DEBUG_LEVEL),
+ {"Unable to lookup peer- or sockname", 0}.
+
+
+%%-----------------------------------------------------------------
+%% Shutdown Connection
+%% How = read | write | read_write
+shutdown(normal, Socket, How) ->
+ gen_tcp:shutdown(Socket, How);
+shutdown(ssl, Socket, How) ->
+ Generation = orber_env:ssl_generation(),
+ if
+ Generation > 2 ->
+ ssl:shutdown(Socket, How);
+ How == read_write ->
+ %% Older versions of SSL do no support shutdown.
+ %% For now we'll use this solution instead.
+ close(ssl, Socket);
+ true ->
+ {error, undefined}
+ end.
+
+%%-----------------------------------------------------------------
+%% Remove Messages from queue
+%%
+clear(normal, Socket) ->
+ tcp_clear(Socket);
+clear(ssl, Socket) ->
+ ssl_clear(Socket).
+
+
+
+%% Inet also checks for the following messages:
+%% * {S, {data, Data}}
+%% * {inet_async, S, Ref, Status},
+%% * {inet_reply, S, Status}
+%% SSL doesn't.
+tcp_clear(Socket) ->
+ receive
+ {tcp, Socket, _Data} ->
+ tcp_clear(Socket);
+ {tcp_closed, Socket} ->
+ tcp_clear(Socket);
+ {tcp_error, Socket, _Reason} ->
+ tcp_clear(Socket)
+ after 0 ->
+ ok
+ end.
+
+ssl_clear(Socket) ->
+ receive
+ {ssl, Socket, _Data} ->
+ ssl_clear(Socket);
+ {ssl_closed, Socket} ->
+ ssl_clear(Socket);
+ {ssl_error, Socket, _Reason} ->
+ ssl_clear(Socket)
+ after 0 ->
+ ok
+ end.
+
+
+
+%%-----------------------------------------------------------------
+%% Check Port. If the user supplies 0 we pick any vacant port. But then
+%% we must change the associated environment variable
+check_port(0, normal, Socket) ->
+ case inet:port(Socket) of
+ {ok, Port} ->
+ orber:configure_override(iiop_port, Port),
+ Port;
+ What ->
+ orber:dbg("[~p] orber_socket:check_port(~p);~n"
+ "Unable to extract the port number via inet:port/1~n",
+ [?LINE, What], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
+ end;
+check_port(0, ssl, Socket) ->
+ case ssl:sockname(Socket) of
+ {ok, {_Address, Port}} ->
+ orber:configure_override(iiop_ssl_port, Port),
+ Port;
+ What ->
+ orber:dbg("[~p] orber_socket:check_port(~p);~n"
+ "Unable to extract the port number via ssl:sockname/1~n",
+ [?LINE, What], ?DEBUG_LEVEL),
+ corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
+ end;
+check_port(Port, _, _) ->
+ Port.
+
+%%-----------------------------------------------------------------
+%% Check Options.
+%% We need this as a work-around since the SSL-app doesn't allow us
+%% to pass 'inet' as an option. Also needed for R9B :-(
+check_options(normal, Options, _Generation) ->
+ case orber:ip_version() of
+ inet ->
+ Options;
+ inet6 ->
+ %% Necessary for R9B. Should be [orber:ip_version()|Options];
+ [inet6|Options]
+ end;
+check_options(ssl, Options, Generation) ->
+ case orber:ip_version() of
+ inet when Generation > 2 ->
+ [{ssl_imp, new}|Options];
+ inet ->
+ Options;
+ inet6 when Generation > 2 ->
+ [{ssl_imp, new}, inet6|Options];
+ inet6 ->
+ %% Will fail until SSL supports this option.
+ %% Note, we want this happen!
+ [inet6|Options]
+ end.
+
diff --git a/lib/orber/src/orber_tb.erl b/lib/orber/src/orber_tb.erl
new file mode 100644
index 0000000000..0dd2d95bc8
--- /dev/null
+++ b/lib/orber/src/orber_tb.erl
@@ -0,0 +1,186 @@
+%%----------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File: orber_tb.erl
+%%
+%% Description:
+%% Handling MISC functions.
+%%
+%% Creation date: 040723
+%%
+%%----------------------------------------------------------------------
+-module(orber_tb).
+
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/src/orber_iiop.hrl").
+
+%%----------------------------------------------------------------------
+%% External exports
+%%----------------------------------------------------------------------
+-export([wait_for_tables/1, wait_for_tables/2, wait_for_tables/3,
+ is_loaded/0, is_loaded/1, is_running/0, is_running/1,
+ info/2, error/2, unique/1, keysearch/2, keysearch/3]).
+
+%%----------------------------------------------------------------------
+%% Internal exports
+%%----------------------------------------------------------------------
+-define(DEBUG_LEVEL, 5).
+
+-define(FORMAT(_F, _A), {error, lists:flatten(io_lib:format(_F, _A))}).
+-define(EFORMAT(_F, _A), exit(lists:flatten(io_lib:format(_F, _A)))).
+
+%%----------------------------------------------------------------------
+%% Record Definitions
+%%----------------------------------------------------------------------
+
+%%----------------------------------------------------------------------
+%% External functions
+%%----------------------------------------------------------------------
+%%----------------------------------------------------------------------
+%% Function : is_loaded/is_running
+%% Arguments :
+%% Returns :
+%% Raises :
+%% Description:
+%%----------------------------------------------------------------------
+is_loaded() ->
+ is_loaded(orber).
+is_loaded(Appl) ->
+ find_application(application:loaded_applications(), Appl).
+
+is_running() ->
+ is_running(orber).
+is_running(Appl) ->
+ find_application(application:which_applications(), Appl).
+
+find_application([], _) ->
+ false;
+find_application([{Appl, _, _} |_], Appl) ->
+ true;
+find_application([_ |As], Appl) ->
+ find_application(As, Appl).
+
+%%----------------------------------------------------------------------
+%% function : keysearch/2/3
+%% Arguments: KeyValue - [{Key, Value}]
+%% Key - term()
+%% Value - term()
+%% Default - term()
+%% Returns : Value | Default
+%% Exception:
+%% Effect :
+%%----------------------------------------------------------------------
+keysearch(Key, KeyValue) ->
+ keysearch(Key, KeyValue, undefined).
+keysearch(Key, KeyValue, Default) ->
+ case lists:keysearch(Key, 1, KeyValue) of
+ {value, {Key, Value}} ->
+ Value;
+ _ ->
+ Default
+ end.
+
+%%----------------------------------------------------------------------
+%% function : wait_for_tables/1
+%% Arguments: Tables - list of mnesia tables
+%% Timeout - integer (no point in allowing infinity)
+%% Attempts - integer > 0 How many times should we try
+%% Returns :
+%% Exception:
+%% Effect :
+%%----------------------------------------------------------------------
+wait_for_tables(Tables) ->
+ wait_for_tables(Tables, 30000, -1).
+wait_for_tables(Tables, Timeout) ->
+ wait_for_tables(Tables, Timeout, -1).
+wait_for_tables(Tables, _Timeout, 0) ->
+ error("Mnesia failed to load the some or all of the following"
+ "tables:~n~p", [Tables]),
+ {error, "The requested Mnesia tables not yet available."};
+wait_for_tables(Tables, Timeout, Attempts) ->
+ case mnesia:wait_for_tables(Tables, Timeout) of
+ ok ->
+ ok;
+ {timeout, BadTabList} ->
+ info("Mnesia hasn't loaded the following tables (~p msec):~n~p",
+ [Timeout, BadTabList]),
+ wait_for_tables(BadTabList, Timeout, Attempts-1);
+ {error, Reason} ->
+ error("Mnesia failed to load the some or all of the following"
+ "tables:~n~p", [Tables]),
+ {error, Reason}
+ end.
+
+%%----------------------------------------------------------------------
+%% function : unique/1
+%% Arguments: List - [term()]
+%% Returns : [term()]
+%% Exception:
+%% Effect : Remove all duplicates from the list.
+%%----------------------------------------------------------------------
+unique([]) -> [];
+unique(List) ->
+ Sorted = lists:sort(List),
+ unique(hd(Sorted),
+ tl(Sorted), []).
+
+unique(A, [A|R], Acc) ->
+ unique(A, R, Acc);
+unique(A, [B|R], Acc) ->
+ unique(B, R, [A|Acc]);
+unique(A, [], Acc) ->
+ lists:reverse([A|Acc]).
+
+
+%%----------------------------------------------------------------------
+%% function : info/2
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%----------------------------------------------------------------------
+info(Format, Args) ->
+ catch error_logger:info_msg("=================== Orber =================~n"++
+ Format++
+ "~n===========================================~n",
+ Args).
+
+%%----------------------------------------------------------------------
+%% function : error/2
+%% Arguments:
+%% Returns :
+%% Exception:
+%% Effect :
+%%----------------------------------------------------------------------
+error(Format, Args) ->
+ catch error_logger:error_msg("=================== Orber =================~n"++
+ Format++
+ "~n===========================================~n",
+ Args).
+
+
+%%----------------------------------------------------------------------
+%% Internal functions
+%%----------------------------------------------------------------------
+
+%%----------------------------------------------------------------------
+%%------------- END OF MODULE ------------------------------------------
+%%----------------------------------------------------------------------
diff --git a/lib/orber/src/orber_tc.erl b/lib/orber/src/orber_tc.erl
new file mode 100644
index 0000000000..7c2172b565
--- /dev/null
+++ b/lib/orber/src/orber_tc.erl
@@ -0,0 +1,283 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_tc.erl
+%% Description:
+%% This file contains utility functions to create TypeCodes
+%%
+%%-----------------------------------------------------------------
+-module(orber_tc).
+
+-include_lib("orber/include/ifr_types.hrl").
+-include_lib("orber/include/corba.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([null/0, void/0, short/0, unsigned_short/0,
+ long/0, longdouble/0, unsigned_long/0, long_long/0,
+ unsigned_long_long/0, float/0, double/0,
+ boolean/0, char/0, wchar/0, octet/0, any/0,
+ typecode/0, principal/0,
+ object_reference/2, struct/3,
+ union/5, enum/3,
+ string/1, wstring/1, sequence/2, array/2, alias/3,
+ exception/3, fixed/2, value/5, value_box/3, native/2, abstract_interface/2,
+ get_tc/1, check_tc/1]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([]).
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+
+%%-----------------------------------------------------------------
+%% Macros
+%%-----------------------------------------------------------------
+-define(DEBUG_LEVEL, 5).
+
+%%-----------------------------------------------------------------
+%% A number of function which can be used to create TypeCodes
+null() ->
+ tk_null.
+void() ->
+ tk_void.
+short() ->
+ tk_short.
+unsigned_short() ->
+ tk_ushort.
+long() ->
+ tk_long.
+unsigned_long() ->
+ tk_ulong.
+long_long() ->
+ tk_longlong.
+unsigned_long_long() ->
+ tk_ulonglong.
+float() ->
+ tk_float.
+double() ->
+ tk_double.
+longdouble() ->
+ tk_longdouble.
+
+boolean() ->
+ tk_boolean.
+char() ->
+ tk_char.
+wchar() ->
+ tk_wchar.
+octet() ->
+ tk_octet.
+any() ->
+ tk_any.
+typecode() ->
+ tk_TypeCode.
+principal() ->
+ tk_Principal.
+
+object_reference(Id, Name) ->
+ {tk_objref, Id, Name}.
+
+struct(Id, Name, ElementList) ->
+ {tk_struct, Id, Name, ElementList}.
+
+union(Id, Name, DiscrTC, Default, ElementList) ->
+ {tk_union, Id, Name, DiscrTC, Default, ElementList}.
+
+enum(Id, Name, ElementList) ->
+ {tk_enum, Id, Name, ElementList}.
+
+string(Length) ->
+ {tk_string, Length}.
+
+wstring(Length) ->
+ {tk_wstring, Length}.
+
+sequence(ElemTC, Length) ->
+ {tk_sequence, ElemTC, Length}.
+
+array(ElemTC, Length) ->
+ {tk_array, ElemTC, Length}.
+
+alias(Id, Name, TC) ->
+ {tk_alias, Id, Name, TC}.
+
+exception(Id, Name, ElementList) ->
+ {tk_except, Id, Name, ElementList}.
+
+fixed(Digits, Scale) ->
+ {tk_fixed, Digits, Scale}.
+
+value(RepId, Name, ValueModifier, TC, ElementList) ->
+ {tk_value, RepId, Name, ValueModifier, TC, ElementList}.
+
+value_box(RepId, Name, TC) ->
+ {tk_value_box, RepId, Name, TC}.
+
+native(RepId, Name) ->
+ {tk_native, RepId, Name}.
+
+abstract_interface(RepId, Name) ->
+ {tk_abstract_interface, RepId, Name}.
+
+
+%%-----------------------------------------------------------------
+%% Get TypeCode (can be used for constructed types like structs,
+%% unions and exceptions)
+%%
+get_tc(T) when is_tuple(T) ->
+ Type = element(1, T),
+ case catch Type:tc() of
+ {'EXIT', R} ->
+ orber:dbg("[~p] ~p:get_tc(~p); Exit: ~p",
+ [?LINE, ?MODULE, T, R], ?DEBUG_LEVEL),
+ corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO});
+ X ->
+ X
+ end;
+%% This call can be used if one have the IFR id and wants a typecode.
+get_tc(IFRId) when is_list(IFRId) ->
+ Rep = orber_ifr:find_repository(),
+ Def = orber_ifr:lookup_id(Rep, IFRId),
+ Descr = orber_ifr:describe(Def),
+ TypeDescr = Descr#contained_description.value,
+ TypeDescr#typedescription.type.
+
+
+%%-----------------------------------------------------------------
+%% Check TypeCode format
+%%
+check_tc('tk_null') -> true;
+check_tc('tk_void') -> true;
+check_tc('tk_short') -> true;
+check_tc('tk_ushort') -> true;
+check_tc('tk_long') -> true;
+check_tc('tk_ulong') -> true;
+check_tc('tk_longlong') -> true;
+check_tc('tk_ulonglong') -> true;
+check_tc('tk_float') -> true;
+check_tc('tk_double') -> true;
+check_tc('tk_longdouble') -> true;
+check_tc('tk_boolean') -> true;
+check_tc('tk_char') -> true;
+check_tc('tk_wchar') -> true;
+check_tc('tk_octet') -> true;
+check_tc('tk_any') -> true;
+check_tc('tk_TypeCode') -> true;
+check_tc('tk_Principal') -> true;
+check_tc({'tk_objref', RepId, Name}) when is_list(RepId) andalso
+ is_list(Name) -> true;
+check_tc({'tk_struct', RepId, Name, ElementList}) when is_list(RepId) andalso
+ is_list(Name) ->
+ Fun = fun(X) ->
+ case X of
+ {MemberName, MemberTC} when is_list(MemberName) ->
+ check_tc(MemberTC);
+ _ ->
+ false
+ end
+ end,
+ lists:all(Fun, ElementList);
+check_tc({'tk_union', RepId, Name, DiscrTC,
+ Default, ElementList}) when is_list(RepId) andalso
+ is_list(Name) andalso
+ is_integer(Default) ->
+ case check_tc(DiscrTC) of
+ false ->
+ false;
+ true ->
+ Fun = fun(X) ->
+ case X of
+ {_, MemberName, MemberTC} when
+ is_list(MemberName) ->
+ check_tc(MemberTC);
+ _ ->
+ false
+ end
+ end,
+ lists:all(Fun, ElementList)
+ end;
+check_tc({'tk_enum', RepId, Name, ElementList}) when is_list(RepId) andalso
+ is_list(Name) ->
+ Fun = fun(X) ->
+ if
+ is_list(X) ->
+ true;
+ true ->
+ false
+ end
+ end,
+ lists:all(Fun, ElementList);
+check_tc({'tk_string', MaxLength}) when is_integer(MaxLength) -> true;
+check_tc({'tk_wstring', MaxLength}) when is_integer(MaxLength) -> true;
+check_tc({'tk_fixed', Digits, Scale}) when is_integer(Digits) andalso
+ is_integer(Scale) -> true;
+check_tc({'tk_sequence', ElemTC, MaxLength}) when is_integer(MaxLength) ->
+ check_tc(ElemTC);
+check_tc({'tk_array', ElemTC, Length}) when is_integer(Length) ->
+ check_tc(ElemTC);
+check_tc({'tk_alias', RepId, Name, TC}) when is_list(RepId) andalso
+ is_list(Name) ->
+ check_tc(TC);
+check_tc({'tk_except', RepId, Name, ElementList}) when is_list(RepId) andalso
+ is_list(Name) ->
+ Fun = fun(X) ->
+ case X of
+ {MemberName, TC} when is_list(MemberName) ->
+ check_tc(TC);
+ _ ->
+ false
+ end
+ end,
+ lists:all(Fun, ElementList);
+check_tc({'tk_value', RepId, Name, ValueModifier,
+ TC, ElementList}) when is_list(RepId) andalso
+ is_list(Name) andalso
+ is_integer(ValueModifier) ->
+ case check_tc(TC) of
+ false ->
+ false;
+ true ->
+ Fun = fun(X) ->
+ case X of
+ {MemberName, MemberTC, Visibility} when
+ is_list(MemberName) andalso is_integer(Visibility) ->
+ check_tc(MemberTC);
+ _ ->
+ false
+ end
+ end,
+ lists:all(Fun, ElementList)
+ end;
+check_tc({'tk_value_box', RepId, Name, TC}) when is_list(RepId) andalso
+ is_list(Name) ->
+ check_tc(TC);
+check_tc({'tk_native', RepId, Name}) when is_list(RepId) andalso
+ is_list(Name) -> true;
+check_tc({'tk_abstract_interface', RepId, Name}) when is_list(RepId) andalso
+ is_list(Name) -> true;
+check_tc({'none', Indirection}) when is_integer(Indirection) -> true;
+check_tc(_) -> false.
+
diff --git a/lib/orber/src/orber_typedefs.erl b/lib/orber/src/orber_typedefs.erl
new file mode 100644
index 0000000000..239546961f
--- /dev/null
+++ b/lib/orber/src/orber_typedefs.erl
@@ -0,0 +1,82 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%-----------------------------------------------------------------
+%% File: orber_typedefs.erl
+%% Description:
+%% This file contains some functions for internal typedef checking
+%%
+%%-----------------------------------------------------------------
+-module(orber_typedefs).
+
+-include("orber_iiop.hrl").
+-include_lib("orber/include/corba.hrl").
+
+%%-----------------------------------------------------------------
+%% External exports
+%%-----------------------------------------------------------------
+-export([get_op_def/2]).
+
+%%-----------------------------------------------------------------
+%% Internal exports
+%%-----------------------------------------------------------------
+-export([]).
+
+-define(DEBUG_LEVEL, 5).
+
+%%-----------------------------------------------------------------
+%% External interface functions
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Func: get_op_def/2
+%%
+get_op_def(_Objkey, '_is_a') ->
+ {orber_tc:boolean(),[orber_tc:string(0)],[]};
+%% First the OMG specified this operation to be '_not_existent' and then
+%% changed it to '_non_existent' without suggesting that both must be supported.
+%% See CORBA2.3.1 page 15-34, Minor revision 2.3.1: October 1999
+get_op_def(_Objkey, '_not_existent') ->
+ {orber_tc:boolean(),[],[]};
+get_op_def(_Objkey, '_non_existent') ->
+ {orber_tc:boolean(),[],[]};
+%% Defined in the Fault Tolerant section of the CORBA specification.
+get_op_def(_Objkey, '_FT_HB') ->
+ {orber_tc:void(),[],[]};
+get_op_def(Objkey, Op) ->
+ case catch iop_ior:get_key(Objkey) of
+ {_Local, _Key, _, _, Module} ->
+ case catch Module:oe_tc(Op) of
+ {'EXIT', What} ->
+ orber:dbg("[~p] orber_typedefs:get_op_def(~p);~n"
+ "The call-back module does not exist or incorrect~n"
+ "IC-version used. Reason:~n~p",
+ [?LINE, Module, What], ?DEBUG_LEVEL),
+ corba:raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
+ completion_status=?COMPLETED_NO});
+ undefined ->
+ corba:raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
+ completion_status=?COMPLETED_NO});
+ TC ->
+ TC
+ end;
+ _ ->
+ corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
+ end.
+
diff --git a/lib/orber/src/orber_web.erl b/lib/orber/src/orber_web.erl
new file mode 100644
index 0000000000..04bf65fd40
--- /dev/null
+++ b/lib/orber/src/orber_web.erl
@@ -0,0 +1,863 @@
+%%--------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_web.erl
+%% Purpose :
+%%----------------------------------------------------------------------
+
+-module(orber_web).
+
+-export([menu/2,
+ configure/2,
+ info/2,
+ nameservice/2,
+ ifr_select/2,
+ ifr_data/2,
+ create/2,
+ delete_ctx/2,
+ add_ctx/2,
+ delete_obj/2]).
+
+%%----------------------------------------------------------------------
+%%-------------- Defines & Includes ------------------------------------
+%%----------------------------------------------------------------------
+
+-include("ifr_objects.hrl").
+-include_lib("orber/COSS/CosNaming/CosNaming.hrl").
+-include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl").
+-include_lib("orber/include/corba.hrl").
+-include_lib("orber/src/orber_iiop.hrl").
+
+-define(DEBUG_LEVEL, 5).
+
+-define(INFO_DATA,
+ [{iiop_timeout, "IIOP Request Timeout"},
+ {iiop_connection_timeout, "IIOP Connection Timeout"},
+ {iiop_setup_connection_timeout, "IIOP Setup Connection Timeout"},
+ {iiop_port, "IIOP Port"},
+ {domain, "Orber Domain"},
+ {orber_nodes, "Nodes in Domain"},
+ {giop_version, "Default GIOP Version"},
+ {objectkeys_gc_time, "Objectkeys GC"},
+ {get_interceptors, "Using Interceptors"},
+ {get_debug_level, "Debug Level"},
+ {get_ORBInitRef, "ORBInitRef"},
+ {get_ORBDefaultInitRef, "ORBDefaultInitRef"}]).
+
+-define(IFR_DATA, [{"ir_ModuleDef", "Modules"},
+ {"ir_InterfaceDef", "Interfaces"},
+ {"ir_StructDef", "Structs"},
+ {"ir_UnionDef", "Unions"},
+ {"ir_ExceptionDef", "Exceptions"},
+ {"ir_ConstantDef", "Constants"},
+ {"ir_EnumDef", "Enumerants"},
+ {"ir_AliasDef", "Aliases"},
+ {"ir_AttributeDef", "Attributes"},
+ {"ir_OperationDef", "Operations"},
+ {"ir_Contained", "Contained"},
+ {"ir_TypedefDef", "Typedef"}]).
+
+
+%%----------------------------------------------------------------------
+%%-------------- External API ------------------------------------------
+%%----------------------------------------------------------------------
+%% Function : create
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+create(_Env, [{"node",NodeStr}]) ->
+ Node = list_to_atom(NodeStr),
+ is_running(Node, NodeStr),
+ ["<BODY BGCOLOR=\"#FFFFFF\">
+ <TABLE border=0 BGCOLOR=\"#FFFFFF\">
+ <TD ALIGN=\"center\" COLSPAN=2><FONT SIZE=6>Create a New Object</FONT></TD></TR>
+ <TR><TD><FORM METHOD=\"POST\" ACTION=\"./create\">
+ <TR><TD><INPUT TYPE=\"HIDDEN\" NAME=\"node\" VALUE=\"", NodeStr, "\">
+ <TR><TD><B>Module</B></TD><TD><INPUT TYPE=\"TEXT\" SIZE=\"50\" NAME=\"module\" VALUE=\"\"></TD></TR>
+ <TR><TD><B>Arguments</B></TD><TD><INPUT TYPE=\"TEXT\" SIZE=\"50\" NAME=\"arguments\"></TD></TR>
+ <TR><TD><B>Options</B></TD><TD><INPUT TYPE=\"TEXT\" SIZE=\"50\" NAME=\"options\"></TD></TR>
+ <TR><TD><B>Name String</B></TD><TD><INPUT TYPE=\"TEXT\" SIZE=\"50\" NAME=\"namestr\"></TD></TR>
+ <TR><TD><B>Operation to use</B></TD>
+ <TD><B>&nbsp;&nbsp;&nbsp;<INPUT type=\"radio\" name=\"bind\" value=\"bind\" CHECKED=\"true\">Bind</B>
+ <B>&nbsp;&nbsp;&nbsp;<INPUT type=\"radio\" name=\"bind\" value=\"rebind\">Rebind</B></TD></TR>
+ <TR><TD ALIGN=\"center\" COLSPAN=2><INPUT TYPE=\"SUBMIT\" VALUE=\"Create it\"></FORM></TD></TR></TABLE>"];
+create(_Env, [{"node",NodeStr}, {"module", ModStr}, {"arguments",ArgsStr},
+ {"options",OptionsStr}, {"namestr", Name}, {"bind", How}]) ->
+ Node = list_to_atom(NodeStr),
+ Mod = list_to_atom(ModStr),
+ Args = parse_data(ArgsStr),
+ Options = parse_data(OptionsStr),
+ case catch rpc:call(Node, Mod, oe_create, [Args, [{sup_child, true}|Options]]) of
+ {ok, Pid, Object} ->
+ case catch bind(Node, Object, Name, How) of
+ {ok, IOR} ->
+ ["<BODY BGCOLOR=\"#FFFFFF\"><BR><B>Successfully created the object:</B><BR><BR>", IOR];
+ {ok, IOR, Path} ->
+ ["<BODY BGCOLOR=\"#FFFFFF\"><BR><B>Successfully created and stored the object as: \"",
+ Path, "\" (", pid_to_list(Pid), ")</B><BR><BR>", IOR];
+ What ->
+ rpc:call(Node, corba, dispose, [Object]),
+ orber:dbg("[~p] orber_web:create(~p, ~p, ~p, ~p, ~p);
+Unable to bind object: ~p", [?LINE, Node, Mod, Args, Options, Name, What], ?DEBUG_LEVEL),
+ ["<BODY BGCOLOR=\"#FFFFFF\">Unable to bind object in the NameService using: ", Name]
+ end;
+ Object when element(2, Object) == pseudo ->
+ case catch bind(Node, Object, Name, How) of
+ {ok, IOR} ->
+ ["<BODY BGCOLOR=\"#FFFFFF\"><BR><B>Successfully created the object:</B><BR><BR>", IOR];
+ {ok, IOR, _} ->
+ ["<BODY BGCOLOR=\"#FFFFFF\"><BR><B>Successfully created and stored the object as :\"", Name, "\"</B><BR><BR>", IOR];
+ What ->
+ rpc:call(Node, corba, dispose, [Object]),
+ orber:dbg("[~p] orber_web:create(~p, ~p, ~p, ~p, ~p);
+Unable to bind object: ~p", [?LINE, Node, Mod, Args, Options, Name, What], ?DEBUG_LEVEL),
+ ["<BODY BGCOLOR=\"#FFFFFF\">Unable to bind object in the NameService using: ", Name]
+ end;
+ What->
+ orber:dbg("[~p] orber_web:create(~p, ~p, ~p, ~p, ~p);
+Unable to create object: ~p", [?LINE, Node, Mod, Args, Options, Name, What], ?DEBUG_LEVEL),
+ ["<BODY BGCOLOR=\"#FFFFFF\">Unable to create the object."]
+ end.
+
+bind(Node, Obj, "", _) ->
+ IOR = rpc:call(Node, corba, object_to_string, [Obj]),
+ {ok, IOR};
+bind(Node, Obj, NameStr, How) ->
+ NS = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"])),
+ Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, NameStr])),
+ case How of
+ "bind" ->
+ check(rpc:call(Node, 'CosNaming_NamingContext', bind, [NS, Name, Obj])),
+ IOR = rpc:call(Node, corba, object_to_string, [Obj]),
+ {ok, IOR, NameStr};
+ "rebind" ->
+ check(rpc:call(Node, 'CosNaming_NamingContext', rebind, [NS, Name, Obj])),
+ IOR = rpc:call(Node, corba, object_to_string, [Obj]),
+ {ok, IOR, NameStr}
+ end.
+
+
+%%----------------------------------------------------------------------
+%% Function : delete_ctx
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+delete_ctx(_Env, [{"node",NodeStr}, {"context", Ref}]) ->
+ Node = list_to_atom(NodeStr),
+ {Ctx, NS} = remote_resolve(Node, Ref),
+ Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, Ref])),
+ check(rpc:call(Node, 'CosNaming_NamingContextExt', unbind, [NS, Name])),
+ check(rpc:call(Node, 'CosNaming_NamingContextExt', destroy, [Ctx])),
+ ["<BODY BGCOLOR=\"#FFFFFF\">
+ <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
+ <FONT SIZE=6>Successfully deleted the Context: ", Ref, "</FONT>\n
+ </TD></TR></TABLE>
+ <FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-2) VALUE=\"Go Back\">\n</FORM>"].
+
+%%----------------------------------------------------------------------
+%% Function : add_ctx
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+add_ctx(_Env, [{"node",_NodeStr}, {"context", "root"}, {"id", ""}]) ->
+ ["<BODY BGCOLOR=\"#FFFFFF\">
+ <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
+ <FONT SIZE=4>You must supply a NameString such as:<BR>
+ See also 'Interoperable Naming Service' in the User's Guide.</FONT>\n
+ </TD></TR></TABLE>
+ <FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-1) VALUE=\"Go Back\">\n</FORM>"];
+add_ctx(_Env, [{"node",NodeStr}, {"context", "root"}, {"id", Id}]) ->
+ Node = list_to_atom(NodeStr),
+ NS = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"])),
+ Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, Id])),
+ check(rpc:call(Node, 'CosNaming_NamingContextExt', bind_new_context, [NS, Name])),
+ ["<BODY BGCOLOR=\"#FFFFFF\">
+ <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
+ <FONT SIZE=6>Successfully bound the new Context: ", Id, "</FONT>\n
+ </TD></TR></TABLE>
+ <FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-1) VALUE=\"Go Back\">\n</FORM>"];
+add_ctx(_Env, [{"node",NodeStr}, {"context", Ref}, {"id", Id}]) ->
+ NameStr = Ref ++ "/" ++ Id,
+ Node = list_to_atom(NodeStr),
+ NS = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"])),
+ Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, NameStr])),
+ check(rpc:call(Node, 'CosNaming_NamingContextExt', bind_new_context, [NS, Name])),
+ ["<BODY BGCOLOR=\"#FFFFFF\">
+ <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
+ <FONT SIZE=6>Successfully bound the new Context: ", NameStr, "</FONT>\n
+ </TD></TR></TABLE>
+ <FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-1) VALUE=\"Go Back\">\n</FORM>"].
+
+%%----------------------------------------------------------------------
+%% Function : delete_obj
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+delete_obj(_Env, [{"node",NodeStr}, {"context", Ref}, {"action", "unbind"}]) ->
+ Node = list_to_atom(NodeStr),
+ NS = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"])),
+ Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, Ref])),
+ check(rpc:call(Node, 'CosNaming_NamingContextExt', unbind, [NS, Name])),
+ ["<BODY BGCOLOR=\"#FFFFFF\">
+ <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
+ <FONT SIZE=6>Successfully unbound the Object: ", Ref, "</FONT>\n
+ </TD></TR></TABLE>
+ <FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-2) VALUE=\"Go Back\">\n</FORM>"];
+delete_obj(_Env, [{"node",NodeStr}, {"context", Ref}, {"action", "both"}]) ->
+ Node = list_to_atom(NodeStr),
+ {Obj, NS} = remote_resolve(Node, Ref),
+ check(rpc:call(Node, corba, dispose, [Obj])),
+ Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, Ref])),
+ check(rpc:call(Node, 'CosNaming_NamingContextExt', unbind, [NS, Name])),
+ ["<BODY BGCOLOR=\"#FFFFFF\">
+ <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
+ <FONT SIZE=6>Successfully disposed an unbound the Object: ", Ref, "</FONT>\n
+ </TD></TR></TABLE>
+ <FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-2) VALUE=\"Go Back\">\n</FORM>"].
+
+
+
+%%----------------------------------------------------------------------
+%% Function : nameservice
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+nameservice(_Env, [{"node",NodeStr}, {"context", "root"}]) ->
+ Node = list_to_atom(NodeStr),
+ is_running(Node, NodeStr),
+ Object = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"])),
+ Prefix = "<TR><TD><A HREF=\"./nameservice?node=" ++ NodeStr ++ "&context=",
+ case catch create_context_list(Node, NodeStr, Prefix, Object, "root") of
+ {ok, Data} ->
+ ["<BODY BGCOLOR=\"#FFFFFF\">
+ <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=2>
+ <FONT SIZE=6>NameService</FONT>\n
+ </TD></TR><TR BGCOLOR=\"#FFFF00\"><TD ALIGN=\"center\" COLSPAN=2>
+ <FONT SIZE=4>Root Context</FONT>\n
+ </TD></TR>", Data,
+ "<TR><TD><FORM Name=addctx METHOD=\"POST\" ACTION=\"./add_ctx\">
+ <INPUT TYPE=\"HIDDEN\" NAME=\"node\" VALUE=\"", NodeStr, "\">
+ <INPUT TYPE=\"HIDDEN\" NAME=\"context\" VALUE=\"root\">
+ <INPUT TYPE=\"TEXT\" SIZE=\"20\" NAME=\"id\"></TD>
+ <TD><INPUT TYPE=\"SUBMIT\" VALUE=\"New Context\"></TD></FORM></TR></TABLE>"];
+ Why ->
+ orber:dbg("[~p] orber_web:nameservice(~p, root);
+Unable to create context list: ~p", [?LINE, NodeStr, Why], ?DEBUG_LEVEL),
+ throw({error, "<BODY BGCOLOR=\"#FFFFFF\">Unable to create a look up the Root Context data"})
+ end;
+nameservice(_Env, [{"node",NodeStr}, {"context", Ref}]) ->
+ Node = list_to_atom(NodeStr),
+ {Object, _NS} = remote_resolve(Node, Ref),
+ Prefix = "<TR><TD><A HREF=\"./nameservice?node=" ++ NodeStr ++ "&context="++Ref++"/",
+ case catch create_context_list(Node, NodeStr, Prefix, Object, Ref) of
+ {ok, Data} ->
+ ["<BODY BGCOLOR=\"#FFFFFF\">
+ <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=2>
+ <FONT SIZE=6>NameService</FONT></TD></TR>
+ <TR BGCOLOR=\"#FFFF00\"><TD ALIGN=\"center\" COLSPAN=2>
+ <FONT SIZE=4>", Ref, "</FONT></TD></TR>", Data,
+ "<TR><TD><FORM Name=addctx METHOD=\"POST\" ACTION=\"./add_ctx\">
+ <INPUT TYPE=\"HIDDEN\" NAME=\"node\" VALUE=\"", NodeStr, "\">
+ <INPUT TYPE=\"HIDDEN\" NAME=\"context\" VALUE=\"", Ref, "\">
+ <INPUT TYPE=\"TEXT\" SIZE=\"20\" NAME=\"id\"></TD>
+ <TD><INPUT TYPE=\"SUBMIT\" VALUE=\"New Context\"></TD></FORM></TR>
+ </TABLE>
+ <FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-1) VALUE=\"Go Back\"></FORM></TD>"];
+ Why ->
+ orber:dbg("[~p] orber_web:nameservice(~p, ~p);
+Unable to create context list: ~p", [?LINE, NodeStr, Ref, Why], ?DEBUG_LEVEL),
+ throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Unable to look up the Context: ", Ref,
+ "<BR><BR>If You just deleted it, use the 'Go Back' button next time."]})
+ end;
+nameservice(_Env, [{"node",NodeStr}, {"context", Ref}, {"object", Obj}]) ->
+ case catch create_object_data(NodeStr, Ref, Obj) of
+ {ok, Data} ->
+ Data;
+ Why ->
+ orber:dbg("[~p] orber_web:nameservice(~p, ~p, ~p);
+Unable to create data for object: ~p", [?LINE, NodeStr, Ref, Obj, Why], ?DEBUG_LEVEL),
+ throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Unable to look up the Object stored as: ", Ref,
+ "<BR><BR>If You just unbound it, use the 'Go Back' button next time."]})
+ end.
+
+create_context_list(Node, NodeStr, Prefix, Object, Ref) ->
+ case check(rpc:call(Node, 'CosNaming_NamingContext', list, [Object, 100])) of
+ {ok, [], BI} when Ref == "root" ->
+ catch rpc:call(Node, 'CosNaming_BindingIterator', destroy, [BI]),
+ {ok, "<TR><TD ALIGN=\"center\" COLSPAN=2><FONT SIZE=3><B>EMPTY<B></FONT></TD></TR>"};
+ {ok, [], BI} ->
+ catch rpc:call(Node, 'CosNaming_BindingIterator', destroy, [BI]),
+ {ok, "<TR><TD ALIGN=\"center\"><FONT SIZE=3><B>EMPTY<B></FONT></TD>
+ <TD ALIGN=\"center\"><FORM Name=deletectx METHOD=\"POST\" ACTION=\"./delete_ctx\">
+ <INPUT TYPE=\"HIDDEN\" NAME=\"node\" VALUE=\"" ++ NodeStr ++ "\">
+ <INPUT TYPE=\"HIDDEN\" NAME=\"context\" VALUE=\"" ++ Ref ++ "\">
+ <INPUT TYPE=\"SUBMIT\" VALUE=\"Delete Context\"></FORM></TD></TR>"};
+ {ok, BL, BI} when length(BL) < 100 ->
+ catch rpc:call(Node, 'CosNaming_BindingIterator', destroy, [BI]),
+ {ok, convert_contexts(BL, [], Prefix, Object, Node)};
+ {ok, BL, BI} ->
+ Data = convert_contexts(BL, [], Prefix, Object, Node),
+ {ok, create_context_list_helper(Node, BI, Data, Object, Prefix)}
+ end.
+
+create_context_list_helper(Node, BI, Acc, Ctx, Prefix) ->
+ case check(rpc:call(Node, 'CosNaming_BindingIterator', next_n, [BI, 100])) of
+ {true, BL} ->
+ NewAcc = convert_contexts(BL, Acc, Prefix, Ctx, Node),
+ create_context_list_helper(Node, BI, NewAcc, Ctx, Prefix);
+ {false, BL} ->
+ catch rpc:call(Node, 'CosNaming_BindingIterator', destroy, [BI]),
+ convert_contexts(BL, Acc, Prefix, Ctx, Node)
+ end.
+
+convert_contexts([], Acc, _Prefix, _Ctx, _Node) ->
+ Acc;
+convert_contexts([#'CosNaming_Binding'{binding_name = Name,
+ binding_type = ncontext}|T],
+ Acc, Prefix, Ctx, Node) ->
+ NameStr = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_string, [Ctx, Name])),
+ convert_contexts(T, [Prefix, NameStr, "\" TARGET=main><B>", NameStr, "</B></A></TD><TD><B>ncontext</B></TD></TR>"|Acc],
+ Prefix, Ctx, Node);
+convert_contexts([#'CosNaming_Binding'{binding_name = Name,
+ binding_type = nobject}|T],
+ Acc, Prefix, Ctx, Node) ->
+ NameStr = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_string, [Ctx, Name])),
+ convert_contexts(T, [Prefix, NameStr, "&object=o \" TARGET=main><B>", NameStr, "</B></A></TD><TD><B>nobject</B></A></TD></TR>"|Acc],
+ Prefix, Ctx, Node).
+
+
+create_object_data(NodeStr, Ref, _Obj) ->
+ Node = list_to_atom(NodeStr),
+ {Object, _NS} = remote_resolve(Node, Ref),
+ LongIORStr = check(rpc:call(Node, corba, object_to_string, [Object])),
+ IFRId = check(rpc:call(Node, iop_ior, get_typeID, [Object])),
+ Exists = check(rpc:call(Node, corba_object, non_existent, [Object])),
+ IORStr = split_IOR(1, LongIORStr, []),
+ {Data, External}
+ = case rpc:call(Node, iop_ior, get_key, [Object]) of
+ {external, {Host, Port, _OK, _, _, #host_data{version = {Ma, Mi}}}} ->
+ {[{"IFR Id", IFRId},
+ {"Stored As", Ref},
+ {"External Object", "true"},
+ {"Non Existent", atom_to_list(Exists)},
+ {"Host", Host},
+ {"Port", integer_to_list(Port)},
+ {"IIOP Version", integer_to_list(Ma) ++"."++ integer_to_list(Mi)},
+ {"IOR String", IORStr}], true};
+ {'internal', _Key, _, _, _} ->
+ Pid = check(rpc:call(Node, corba, get_pid, [Object])),
+ Interface = check(rpc:call(Node, corba, request_from_iiop,
+ [Object, oe_get_interface, false, false, false, []])),
+ InterfaceData = parse_interface(Interface, []),
+ {[{"IFR Id", IFRId},
+ {"Stored As", Ref},
+ {"External Object", "false"},
+ {"Non Existent", atom_to_list(Exists)},
+ {"Pid", pid_to_list(Pid)},
+ {"IOR String", IORStr}|InterfaceData], false};
+ {'internal_registered', {pseudo, Key}, _, _, _} ->
+ Interface = check(rpc:call(Node, corba, request_from_iiop,
+ [Object, oe_get_interface, false, false, false, []])),
+ InterfaceData = parse_interface(Interface, []),
+ {[{"IFR Id", IFRId},
+ {"Stored As", Ref},
+ {"External Object", "false"},
+ {"Non Existent", atom_to_list(Exists)},
+ {"Pseudo Object", atom_to_list(Key)},
+ {"IOR", IORStr}|InterfaceData], false};
+ {'internal_registered', Key, _, _, _} ->
+ Pid = check(rpc:call(Node, corba, get_pid, [Object])),
+ Interface = check(rpc:call(Node, corba, request_from_iiop,
+ [Object, oe_get_interface, false, false, false, []])),
+ InterfaceData = parse_interface(Interface, []),
+ {[{"IFR Id", IFRId},
+ {"Stored As", Ref},
+ {"External Object", "false"},
+ {"Non Existent", atom_to_list(Exists)},
+ {"Locally Registered", atom_to_list(Key)},
+ {"Pid", pid_to_list(Pid)},
+ {"IOR String", IORStr}|InterfaceData], false}
+ end,
+ Buttons = case {Exists, External} of
+ {false, false} ->
+ ["<TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\">
+ <TD><FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-1) VALUE=\"Go Back\"></FORM></TD>
+
+ <TD ALIGN=\"center\"><FORM Name=unbindobj METHOD=\"POST\" ACTION=\"./delete_obj\">
+ <INPUT TYPE=\"HIDDEN\" NAME=\"node\" VALUE=\"", NodeStr, "\">
+ <INPUT TYPE=\"HIDDEN\" NAME=\"context\" VALUE=\"", Ref, "\">
+ <INPUT TYPE=\"HIDDEN\" NAME=\"action\" VALUE=\"unbind\">
+ <INPUT TYPE=\"SUBMIT\" VALUE=\"Unbind\"></FORM></TD>
+ <TD ALIGN=\"center\"><FORM Name=unbinddeletobj METHOD=\"POST\" ACTION=\"./delete_obj\">
+ <INPUT TYPE=\"HIDDEN\" NAME=\"node\" VALUE=\"", NodeStr, "\">
+ <INPUT TYPE=\"HIDDEN\" NAME=\"context\" VALUE=\"", Ref, "\">
+ <INPUT TYPE=\"HIDDEN\" NAME=\"action\" VALUE=\"both\">
+ <INPUT TYPE=\"SUBMIT\" VALUE=\"Unbind & Dispose\"></FORM></TD></TR></TABLE>"];
+ _ ->
+ ["<TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\">
+ <TD><FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-1) VALUE=\"Go Back\"></FORM></TD>
+ <TD ALIGN=\"center\"><FORM Name=unbindobj METHOD=\"POST\" ACTION=\"./delete_obj\">
+ <INPUT TYPE=\"HIDDEN\" NAME=\"node\" VALUE=\"", NodeStr, "\">
+ <INPUT TYPE=\"HIDDEN\" NAME=\"context\" VALUE=\"", Ref, "\">
+ <INPUT TYPE=\"HIDDEN\" NAME=\"action\" VALUE=\"unbind\">
+ <INPUT TYPE=\"SUBMIT\" VALUE=\"Unbind\"></FORM></TD></TR></TABLE>"]
+ end,
+ {ok, ["<BODY BGCOLOR=\"#FFFFFF\">",
+ simple_table("2", "NameService", [{"Key", "Value"}|Data]),
+ Buttons]}.
+
+parse_interface([], [{_, Op}|Acc]) ->
+ [{"Operations", Op}|Acc];
+parse_interface([], []) ->
+ [{"Operations", "-"}];
+parse_interface([{Operation,{_,Args,_}}|T], Acc) ->
+ parse_interface(T, [{"", Operation ++ "/" ++ integer_to_list(length(Args))}|Acc]).
+
+
+split_IOR(_, [], Acc) ->
+ lists:reverse(Acc);
+split_IOR(50, Str, Acc) ->
+ split_IOR(1, Str, ["<BR>"|Acc]);
+split_IOR(N, [H|T], Acc) ->
+ split_IOR(N+1, T, [H|Acc]).
+
+
+
+%%----------------------------------------------------------------------
+%% Function : configure
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+configure(_Env, [{"node",NodeStr}, {"data", DataStr}]) ->
+ Node = list_to_atom(NodeStr),
+ Data = parse_data(DataStr),
+ case catch rpc:call(Node, orber, multi_configure, [Data]) of
+ ok ->
+ "<BODY BGCOLOR=\"#FFFFFF\">Configuration successfull.";
+ Why ->
+ orber:dbg("[~p] orber_web:configure(~p, ~p);
+Unable to change configuration due to: ~p", [?LINE, NodeStr, DataStr, Why], ?DEBUG_LEVEL),
+ "<BODY BGCOLOR=\"#FFFFFF\">Unable to change the configuration.<BR>
+ Check the spelling and/or if it is possible to update all the keys if Orber is started."
+ end.
+
+
+%%----------------------------------------------------------------------
+%% Function : ifr_select
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+ifr_select(_Env, [{"node",NodeStr}]) ->
+ Node = list_to_atom(NodeStr),
+ is_running(Node, NodeStr),
+ ["<BODY BGCOLOR=\"#FFFFFF\">
+ <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
+ <FONT SIZE=6>Interface Repository</FONT>
+ </TD></TR>", create_ifr_table(?IFR_DATA, NodeStr, []), "</TABLE>"].
+
+%%----------------------------------------------------------------------
+%% Function : ifr_data
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+ifr_data(_Env, [{"node",NodeStr}, {"table", TableStr}]) ->
+ Node = list_to_atom(NodeStr),
+ Table = list_to_atom(TableStr),
+ WildPattern = get_wild_pattern(Table, Node),
+ Records = check(rpc:call(Node, mnesia, dirty_match_object, [WildPattern])),
+ Data = extract_ids(Records, []),
+ ["<BODY BGCOLOR=\"#FFFFFF\">",
+ simple_table("1", "Interface Repository", [TableStr|Data]),
+ "<FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-1) VALUE=\"Go Back\"></FORM>"].
+
+extract_ids([], Acc) ->
+ lists:sort(Acc);
+extract_ids([#ir_ModuleDef{id=Id}|T], Acc) ->
+ extract_ids(T, [Id|Acc]);
+extract_ids([#ir_InterfaceDef{id=Id}|T], Acc) ->
+ extract_ids(T, [Id|Acc]);
+extract_ids([#ir_StructDef{id=Id}|T], Acc) ->
+ extract_ids(T, [Id|Acc]);
+extract_ids([#ir_UnionDef{id=Id}|T], Acc) ->
+ extract_ids(T, [Id|Acc]);
+extract_ids([#ir_ExceptionDef{id=Id}|T], Acc) ->
+ extract_ids(T, [Id|Acc]);
+extract_ids([#ir_ConstantDef{id=Id}|T], Acc) ->
+ extract_ids(T, [Id|Acc]);
+extract_ids([#ir_EnumDef{id=Id}|T], Acc) ->
+ extract_ids(T, [Id|Acc]);
+extract_ids([#ir_AliasDef{id=Id}|T], Acc) ->
+ extract_ids(T, [Id|Acc]);
+extract_ids([#ir_AttributeDef{id=Id}|T], Acc) ->
+ extract_ids(T, [Id|Acc]);
+extract_ids([#ir_OperationDef{id=Id}|T], Acc) ->
+ extract_ids(T, [Id|Acc]);
+extract_ids([#ir_Contained{id=Id}|T], Acc) ->
+ extract_ids(T, [Id|Acc]);
+extract_ids([#ir_TypedefDef{id=Id}|T], Acc) ->
+ extract_ids(T, [Id|Acc]).
+
+get_wild_pattern(ir_ModuleDef, Node) ->
+ P = check(rpc:call(Node, mnesia, table_info, [ir_ModuleDef, wild_pattern])),
+ P#ir_ModuleDef{id='$1'};
+get_wild_pattern(ir_InterfaceDef, Node) ->
+ P = check(rpc:call(Node, mnesia, table_info, [ir_InterfaceDef, wild_pattern])),
+ P#ir_InterfaceDef{id='$1'};
+get_wild_pattern(ir_StructDef, Node) ->
+ P = check(rpc:call(Node, mnesia, table_info, [ir_StructDef, wild_pattern])),
+ P#ir_StructDef{id='$1'};
+get_wild_pattern(ir_UnionDef, Node) ->
+ P = check(rpc:call(Node, mnesia, table_info, [ir_UnionDef, wild_pattern])),
+ P#ir_UnionDef{id='$1'};
+get_wild_pattern(ir_ExceptionDef, Node) ->
+ P = check(rpc:call(Node, mnesia, table_info, [ir_ExceptionDef, wild_pattern])),
+ P#ir_ExceptionDef{id='$1'};
+get_wild_pattern(ir_ConstantDef, Node) ->
+ P = check(rpc:call(Node, mnesia, table_info, [ir_ConstantDef, wild_pattern])),
+ P#ir_ConstantDef{id='$1'};
+get_wild_pattern(ir_EnumDef, Node) ->
+ P = check(rpc:call(Node, mnesia, table_info, [ir_EnumDef, wild_pattern])),
+ P#ir_EnumDef{id='$1'};
+get_wild_pattern(ir_AliasDef, Node) ->
+ P = check(rpc:call(Node, mnesia, table_info, [ir_AliasDef, wild_pattern])),
+ P#ir_AliasDef{id='$1'};
+get_wild_pattern(ir_AttributeDef, Node) ->
+ P = check(rpc:call(Node, mnesia, table_info, [ir_AttributeDef, wild_pattern])),
+ P#ir_AttributeDef{id='$1'};
+get_wild_pattern(ir_OperationDef, Node) ->
+ P = check(rpc:call(Node, mnesia, table_info, [ir_OperationDef, wild_pattern])),
+ P#ir_OperationDef{id='$1'};
+get_wild_pattern(ir_Contained, Node) ->
+ P = check(rpc:call(Node, mnesia, table_info, [ir_Contained, wild_pattern])),
+ P#ir_Contained{id='$1'};
+get_wild_pattern(ir_TypedefDef, Node) ->
+ P = check(rpc:call(Node, mnesia, table_info, [ir_TypedefDef, wild_pattern])),
+ P#ir_TypedefDef{id='$1'}.
+
+create_ifr_table([], _Node, Result) ->
+ lists:append(lists:reverse(Result));
+create_ifr_table([{Table,Desc}|Rest], Node, Result) ->
+ create_ifr_table(Rest, Node,
+ ["<TR><TD><A HREF=\"./ifr_data?node=" ++ Node ++
+ "&table="++Table++"\" TARGET=main><B>" ++ Desc ++"</B></A></TD></TR>"|Result]).
+
+
+%%----------------------------------------------------------------------
+%% Function : info
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+info(_Env, [{"node",NodeStr}]) ->
+ Node = list_to_atom(NodeStr),
+ is_running(Node, NodeStr),
+ Data = create_info_data(?INFO_DATA, Node, []),
+ ["<BODY BGCOLOR=\"#FFFFFF\">",
+ simple_table("2", "Configuration", [{"Key", "Value"}|Data],
+ ["<TR><TD><FORM METHOD=\"POST\" ACTION=\"./configure\">
+ <INPUT TYPE=\"HIDDEN\" NAME=\"node\" VALUE=\"", NodeStr, "\">
+ <INPUT TYPE=\"TEXT\" SIZE=\"35\" NAME=\"data\" VALUE=\"[{Key, Value}]\">
+ </TD><TD><INPUT TYPE=\"SUBMIT\" VALUE=\"Change it\"></TD></FORM></TR>"])].
+
+
+create_info_data([], _Node, Result) ->
+ lists:reverse(Result);
+create_info_data([{Func,Desc}|Rest], Node, Result) ->
+ Data = convert_type(check(rpc:call(Node, orber, Func, []))),
+ create_info_data(Rest, Node, [{Desc, Data}|Result]).
+
+convert_type(Data) when is_integer(Data) ->
+ integer_to_list(Data);
+convert_type(Data) when is_atom(Data) ->
+ atom_to_list(Data);
+convert_type(Data) when is_float(Data) ->
+ float_to_list(Data);
+convert_type(Data) when is_pid(Data) ->
+ pid_to_list(Data);
+convert_type(Data) when is_port(Data) ->
+ erlang:port_to_list(Data);
+convert_type(Data) when is_tuple(Data) ->
+ io_lib:write(Data);
+convert_type([]) ->
+ [];
+convert_type(Data) when is_list(Data) ->
+ case io_lib:printable_list(Data) of
+ true->
+ Data;
+ _->
+ io_lib:write(Data)
+ end;
+convert_type(_Data) ->
+ [].
+
+
+%%----------------------------------------------------------------------
+%% Function : menu
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+menu(_Env, Args)->
+ ["<BODY BGCOLOR=\"#FFFFFF\">", node_selections_javascripts(), node_body(Args, [node()|nodes()])].
+
+menu_title()->
+ " <TABLE WIDTH=\"100%\" BORDER=\"0\">
+ <TR><TD ALIGN=\"center\"><FONT SIZE=5>Menu</FONT></TD></TR>
+ </TABLE>\n".
+
+
+node_body([], Nodes)->
+ Node = node(),
+ [node_selections_javascripts(), node_selection(Node, Nodes), menu_title(),
+ menu_options(atom_to_list(Node))];
+node_body([{"node",Node}|_], Nodes)->
+ [node_selections_javascripts(), node_selection(list_to_atom(Node), Nodes), menu_title(),
+ menu_options(Node)];
+node_body([_|Rest], Nodes) ->
+ node_body(Rest, Nodes).
+
+
+
+%%----------------------------------------------------------------------
+%% Function : node_selections_javascripts
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+node_selections_javascripts()->
+ "<SCRIPT>
+ function node_selected()
+ {
+ parent.frames.main.location=\"/orber/start_info.html\"
+ window.location =\"./menu?node=\" + " ++
+ "document.node_selection.nodes[document.node_selection.nodes.selectedIndex].value;
+ }
+ </SCRIPT>".
+
+
+
+%%----------------------------------------------------------------------
+%% Function : node_selection
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+node_selection(Node, Nodes)->
+ ["<FORM ACTION=\"./node_info\" NAME=node_selection>\n
+ <TABLE WIDTH=\"100%\" BORDER=\"0\">\n
+ <TR><TD ALIGN=\"center\">\n
+ <SELECT NAME=nodes onChange=\"node_selected()\">\n",
+ print_nodes(Node, Nodes),
+ "</SELECT>\n
+ </TD></TR>\n
+ </TABLE>\n
+ </FORM>"].
+
+%%----------------------------------------------------------------------
+%% Function : print_nodes
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+print_nodes(Node,Nodes)->
+ print_nodes_helper([Node|lists:delete(Node,Nodes)]).
+
+print_nodes_helper([])->
+ [];
+print_nodes_helper([Node|Rest])->
+ NodeStr = atom_to_list(Node),
+ ["<OPTION value=\"", NodeStr, "\">", NodeStr, "\n" | print_nodes_helper(Rest)].
+
+%%----------------------------------------------------------------------
+%% Function : print_nodes
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+menu_options(Node)->
+ ["<UL><LI><A HREF=\"./info?node=", Node, "\" TARGET=main><B>Configuration</B></A></UL>",
+ "<UL><LI><A HREF=\"./nameservice?node=", Node, "&context=root\" TARGET=main><B>Name Service</B></A></UL>",
+ "<UL><LI><A HREF=\"./ifr_select?node=", Node, "\" TARGET=main><B>IFR Types</B></A></UL>",
+ "<UL><LI><A HREF=\"./create?node=", Node, "\" TARGET=main><B>Create Object</B></A></UL>",
+ "<FORM Name=reload><INPUT TYPE=\"button\" onClick=\"node_selected()\" VALUE=\"Reload\">\n</FORM>",
+ "<!--<A HREF=\"../../orber/application_help.html\" TARGET=main>Help</A>-->"].
+
+%%----------------------------------------------------------------------
+%%----------------- MISC Functions -------------------------------------
+%%----------------------------------------------------------------------
+%% Function : simple_table
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+simple_table(Cols, Title, Data) ->
+ ["<TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=",
+ Cols, "><FONT SIZE=6>", Title, "</FONT>\n</TD></TR>", add_data(Data), "</TABLE>"].
+
+simple_table(Cols, Title, Data, Extra) ->
+ ["<TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=",
+ Cols, "><FONT SIZE=6>", Title, "</FONT>\n</TD></TR>", add_data(Data),
+ Extra, "</TABLE>"].
+
+
+% Temporarily removed to avoid a silly dialyzer warning
+%add_data([]) ->
+% "";
+add_data([{C1, C2, C3, C4}|T]) ->
+ add_data(T, ["<TR BGCOLOR=\"#FFFF00\"><TD><B>" ++ C1 ++ "</B></TD><TD><B>"
+ ++ C2 ++ "</B></TD><TD><B>" ++ C3 ++ "</B></TD><TD><B>"
+ ++ C4 ++ "</B></TD></TR>"]);
+add_data([{C1, C2, C3}|T]) ->
+ add_data(T, ["<TR BGCOLOR=\"#FFFF00\"><TD><B>" ++ C1 ++ "</B></TD><TD><B>"
+ ++ C2 ++ "</B></TD><TD><B>" ++ C3 ++ "</B></TD></TR>"]);
+add_data([{C1, C2}|T]) ->
+ add_data(T, ["<TR BGCOLOR=\"#FFFF00\"><TD><B>" ++ C1 ++ "</B></TD><TD><B>"
+ ++ C2 ++ "</B></TD></TR>"]);
+add_data([C1|T]) ->
+ add_data(T, ["<TR BGCOLOR=\"#FFFF00\"><TD><B>" ++ C1 ++ "</B></TD></TR>"]).
+
+
+add_data([], Acc) ->
+ lists:reverse(Acc);
+add_data([{C1, C2, C3, C4}|T], Acc) ->
+ add_data(T, ["<TR><TD><B>"++C1++"</B></TD><TD>"++C2++"</TD><TD>"
+ ++C3++"</TD><TD>"++C4++"</TD></TR>"|Acc]);
+add_data([{C1, C2, C3}|T], Acc) ->
+ add_data(T, ["<TR><TD><B>"++C1++"</B></TD><TD>"++C2++"</TD><TD>"
+ ++C3++"</TD></TR>"|Acc]);
+add_data([{C1, C2}|T], Acc) ->
+ add_data(T, ["<TR><TD><B>"++C1++"</B></TD><TD>"++C2++"</TD></TR>"|Acc]);
+add_data([C1|T], Acc) ->
+ add_data(T, ["<TR><TD>"++C1++"</TD></TR>"|Acc]).
+
+%%----------------------------------------------------------------------
+%% Function : check
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+check(Data) ->
+ check(Data, "").
+
+check({badrpc, {'EXCEPTION', E}}, Comment) ->
+ EList = atom_to_list(element(1, E)),
+ throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Got the exception: ", EList, "<BR><BR>", Comment]});
+check({badrpc,{'EXIT',{undef,_}}}, Comment) ->
+ throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Tried to invoke undefined module or operation.<BR><BR>", Comment]});
+check({badrpc,nodedown}, Comment) ->
+ throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Node down - unable to complete the requested operation.<BR><BR>", Comment]});
+check({badrpc, {'EXIT', _R}}, Comment) ->
+ throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Invoking the requested operation resulted in an EXIT.<BR><BR>", Comment]});
+check({badrpc, {'EXIT', _R1, _R2}}, Comment) ->
+ throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Invoking the requested operation resulted in an EXIT.<BR><BR>", Comment]});
+check({'EXCEPTION', E}, Comment) ->
+ EList = atom_to_list(element(1, E)),
+ throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Got the exception: ", EList, "<BR><BR>", Comment]});
+check({'EXIT',{undef,_}}, Comment) ->
+ throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Tried to invoke operation using undefined module or operation.<BR><BR>", Comment]});
+check({'EXIT', _R}, Comment) ->
+ throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Invoking the requested operation resulted in an EXIT.<BR><BR>", Comment]});
+check({'EXIT', _R1, _R2}, Comment) ->
+ throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Invoking the requested operation resulted in an EXIT.<BR><BR>", Comment]});
+check(Reply, _) ->
+ Reply.
+
+
+%%----------------------------------------------------------------------
+%% Function : is_running
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+is_running(Node, NodeStr) ->
+ case rpc:call(Node, application, which_applications, []) of
+ {badrpc, _} ->
+ throw(["<BODY BGCOLOR=\"#FFFFFF\">
+ <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
+ <FONT SIZE=6>Orber not started on node: ", NodeStr, "</FONT>
+ </TD></TR></TABLE>"]);
+ Apps ->
+ is_running2(Apps, NodeStr)
+ end.
+
+is_running2([], NodeStr) ->
+ throw(["<BODY BGCOLOR=\"#FFFFFF\">
+ <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
+ <FONT SIZE=6>Orber not started on node: ", NodeStr, "</FONT>
+ </TD></TR></TABLE>"]);
+is_running2([{orber, _, _} |_], _) ->
+ true;
+is_running2([_ |As], NodeStr) ->
+ is_running2(As, NodeStr).
+
+
+%%----------------------------------------------------------------------
+%% Function : parse_data
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+parse_data([])->
+ [];
+parse_data(Options)->
+ case erl_scan:string(Options ++ ".") of
+ {ok,Tokens,_Line} ->
+ case erl_parse:parse_term(Tokens) of
+ {ok,X}->
+ X;
+ Why ->
+ orber:dbg("[~p] orber_web:parse_data(~p);
+erl_parse:parse_term failed.
+Malformed data: ~p", [?LINE, Options, Why], ?DEBUG_LEVEL),
+ throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Unable to parse supplied data: ",
+ Options]})
+ end;
+ Why ->
+ orber:dbg("[~p] orber_web:parse_data(~p);
+erl_scan:string failed.
+Malformed data: ~p", [?LINE, Options, Why], ?DEBUG_LEVEL),
+ throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Unable to parse supplied data: ", Options]})
+ end.
+
+%%----------------------------------------------------------------------
+%% Function : remote_resolve
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+remote_resolve(Node, Ref) ->
+ NS = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"]),
+ "Failed to resolve initial refrence (NameService)"),
+ case rpc:call(Node, 'CosNaming_NamingContextExt', resolve_str, [NS, Ref]) of
+ {'EXCEPTION', E} when is_record(E, 'CosNaming_NamingContext_NotFound') ->
+ throw({ok, ["<BODY BGCOLOR=\"#FFFFFF\">Unable to look up the Object: ", Ref,
+ "<BR><BR>Reason: CosNaming_NamingContext_NotFound",
+ "<BR><BR>If You just deleted it, use the 'Go Back' button next time."]});
+ {'EXCEPTION', E} when is_record(E, 'CosNaming_NamingContext_CannotProceed') ->
+ throw({ok, ["<BODY BGCOLOR=\"#FFFFFF\">Unable to look up the Object: ", Ref,
+ "<BR><BR>Reason: CosNaming_NamingContext_CannotProceed",
+ "<BR><BR>If You just deleted it, use the 'Go Back' button next time."]});
+ {badrpc, {'EXCEPTION', E}} when is_record(E, 'CosNaming_NamingContext_NotFound') ->
+ throw({ok, ["<BODY BGCOLOR=\"#FFFFFF\">Unable to look up the Object: ", Ref,
+ "<BR><BR>Reason: CosNaming_NamingContext_NotFound",
+ "<BR><BR>If You just deleted it, use the 'Go Back' button next time."]});
+ {badrpc, {'EXCEPTION', E}} when is_record(E, 'CosNaming_NamingContext_CannotProceed') ->
+ throw({ok, ["<BODY BGCOLOR=\"#FFFFFF\">Unable to look up the Object: ", Ref,
+ "<BR><BR>Reason: CosNaming_NamingContext_CannotProceed",
+ "<BR><BR>If You just deleted it, use the 'Go Back' button next time."]});
+ FoundObj ->
+ {FoundObj, NS}
+ end.
+
+
+
+%%----------------------------------------------------------------------
+%% END OF MODULE
+%%----------------------------------------------------------------------
diff --git a/lib/orber/src/orber_web_server.erl b/lib/orber/src/orber_web_server.erl
new file mode 100644
index 0000000000..9d2a063a69
--- /dev/null
+++ b/lib/orber/src/orber_web_server.erl
@@ -0,0 +1,191 @@
+%%----------------------------------------------------------------------
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% File : orber_web_server.erl
+%% Purpose :
+%%----------------------------------------------------------------------
+
+-module(orber_web_server).
+
+-behaviour(gen_server).
+
+-export([init/1,handle_call/3,handle_cast/2,handle_info/2]).
+-export([terminate/2,code_change/3]).
+-export([start/0,stop/0,start_link/0]).
+
+-export([config_data/0, menu/2, configure/2, info/2, nameservice/2,
+ default_selection/2, ifr_select/2, ifr_data/2, create/2,
+ delete_ctx/2, add_ctx/2, delete_obj/2, flash_msg/2]).
+
+%%----------------------------------------------------------------------
+%%-------------- Defines & Includes ------------------------------------
+%%----------------------------------------------------------------------
+-define(HTML_HEADER,
+ "Cache-Control:no-cache\r\nPragma:no-cache\r\nExpires:Thu, 01 Dec 1994 16:00:00 GMT\r\nContent-type: text/html\r\n\r\n<HTML BGCOLOR=\"#FFFFFF\">\n<HEAD>\n<TITLE>Orber O&D</TITLE>\n</HEAD>\n").
+
+
+-define(HTML_END, "</BODY></HTML>").
+
+-define(DEBUG_LEVEL, 5).
+
+-record(state, {ts}).
+-include("ifr_objects.hrl").
+
+%%----------------------------------------------------------------------
+%%-------------- External API ------------------------------------------
+%%----------------------------------------------------------------------
+%% Function : start/start_link/stop
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+start_link()->
+ gen_server:start_link({local,?MODULE},?MODULE,[],[]).
+start()->
+ gen_server:start({local,?MODULE},?MODULE,[],[]).
+stop()->
+ gen_server:call(?MODULE,stop,1000).
+
+%%----------------------------------------------------------------------
+%% Function : config_data
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+config_data()->
+ {orber,[{web_data,{"OrberWeb","/orber/main_frame.html"}},
+ {alias,{"/orber", code:priv_dir(orber)}},
+ {start,{child,{{local,?MODULE},{?MODULE,start_link,[]},
+ permanent,100,worker,[?MODULE]}}},
+ {alias,{erl_alias,"/orber_erl",[orber_web_server]}}
+ ]}.
+
+
+menu(Env,Input) ->
+ Args = httpd:parse_query(Input),
+ [?HTML_HEADER, gen_server:call(?MODULE, {menu, Env, Args}), ?HTML_END].
+
+configure(Env,Input) ->
+ Args = httpd:parse_query(Input),
+ [?HTML_HEADER, gen_server:call(?MODULE, {configure, Env, Args}), ?HTML_END].
+
+nameservice(Env,Input) ->
+ Args = httpd:parse_query(Input),
+ [?HTML_HEADER, gen_server:call(?MODULE, {nameservice, Env, Args}), ?HTML_END].
+
+info(Env,Input) ->
+ Args = httpd:parse_query(Input),
+ [?HTML_HEADER, gen_server:call(?MODULE, {info, Env, Args}), ?HTML_END].
+
+default_selection(Env,Input) ->
+ Args = httpd:parse_query(Input),
+ [?HTML_HEADER, gen_server:call(?MODULE, {default_selection, Env, Args}), ?HTML_END].
+
+flash_msg(Env, Input) ->
+ Args = httpd:parse_query(Input),
+ [?HTML_HEADER, gen_server:call(?MODULE, {nameservice, Env, Args}), ?HTML_END].
+
+ifr_select(Env, Input) ->
+ Args = httpd:parse_query(Input),
+ [?HTML_HEADER, gen_server:call(?MODULE, {ifr_select, Env, Args}), ?HTML_END].
+
+ifr_data(Env, Input) ->
+ Args = httpd:parse_query(Input),
+ [?HTML_HEADER, gen_server:call(?MODULE, {ifr_data, Env, Args}), ?HTML_END].
+
+create(Env, Input) ->
+ Args = httpd:parse_query(Input),
+ [?HTML_HEADER, gen_server:call(?MODULE, {create, Env, Args}), ?HTML_END].
+
+delete_ctx(Env, Input) ->
+ Args = httpd:parse_query(Input),
+ [?HTML_HEADER, gen_server:call(?MODULE, {delete_ctx, Env, Args}), ?HTML_END].
+
+add_ctx(Env, Input) ->
+ Args = httpd:parse_query(Input),
+ [?HTML_HEADER, gen_server:call(?MODULE, {add_ctx, Env, Args}), ?HTML_END].
+
+delete_obj(Env, Input) ->
+ Args = httpd:parse_query(Input),
+ [?HTML_HEADER, gen_server:call(?MODULE, {delete_obj, Env, Args}), ?HTML_END].
+
+%%----------------------------------------------------------------------
+%%-------------- Callback Functions ------------------------------------
+%%----------------------------------------------------------------------
+%% Function : MISC gen_server specific callback functions
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+init(_Arg)->
+ {M, S, U} = now(),
+ TS = M*1000000000000 + S*1000000 + U,
+ {ok, #state{ts = TS}}.
+
+terminate(_,_State)->
+ ok.
+
+handle_cast(_,State)->
+ {noreply,State}.
+
+handle_info(_,State)->
+ {noreply,State}.
+
+code_change(_Old_vsn,State,_Extra)->
+ {ok,State}.
+
+%%----------------------------------------------------------------------
+%% Function : handle_call
+%% Returns :
+%% Description:
+%%----------------------------------------------------------------------
+handle_call({Function, Env, Args}, _From, State)->
+ case catch orber_web:Function(Env, Args) of
+ {'EXIT', R} ->
+ orber:dbg("[~p] orber_web:~p(~p);~nEXIT: ~p",
+ [?LINE, Function, Args, R], ?DEBUG_LEVEL),
+ {reply, "<BODY BGCOLOR=\"#FFFFFF\">Internal Error", State};
+ {'EXIT', R1, R2} ->
+ orber:dbg("[~p] orber_web:~p(~p);~nEXIT: ~p~n~p",
+ [?LINE, Function, Args, R1, R2], ?DEBUG_LEVEL),
+ {reply, "<BODY BGCOLOR=\"#FFFFFF\">Internal Error", State};
+ {badrpc, Why} ->
+ orber:dbg("[~p] orber_web:~p(~p);~nbadrpc: ~p",
+ [?LINE, Function, Args, Why], ?DEBUG_LEVEL),
+ {reply, "<BODY BGCOLOR=\"#FFFFFF\">Internal Error", State};
+ {'EXCEPTION', E} ->
+ orber:dbg("[~p] orber_web:~p(~p);~nEXCEPTION: ~p",
+ [?LINE, Function, Args, E], ?DEBUG_LEVEL),
+ {reply, "<BODY BGCOLOR=\"#FFFFFF\">Internal Error", State};
+ {error, Data} ->
+ orber:dbg("[~p] orber_web:~p(~p); ~nReason: ~p",
+ [?LINE, Function, Args, Data], ?DEBUG_LEVEL),
+ {reply, Data, State};
+ Reply ->
+ {reply, Reply, State}
+ end;
+handle_call(stop, _From, State)->
+ {stop, normal, ok, State};
+handle_call(What, _From, State)->
+ orber:dbg("[~p] orber_web_server:handle_call(~p);",
+ [?LINE, What], ?DEBUG_LEVEL),
+ {reply, "<BODY BGCOLOR=\"#FFFFFF\"><FONT SIZE=6>Unknown Request</FONT>", State}.
+
+%%----------------------------------------------------------------------
+%% END OF MODULE
+%%----------------------------------------------------------------------