diff options
Diffstat (limited to 'lib/orber/src')
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> <INPUT type=\"radio\" name=\"bind\" value=\"bind\" CHECKED=\"true\">Bind</B> + <B> <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 +%%---------------------------------------------------------------------- |