diff options
Diffstat (limited to 'lib/orber/src')
80 files changed, 0 insertions, 30372 deletions
diff --git a/lib/orber/src/CORBA.idl b/lib/orber/src/CORBA.idl deleted file mode 100644 index 3cd8790f49..0000000000 --- a/lib/orber/src/CORBA.idl +++ /dev/null @@ -1,22 +0,0 @@ -#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 deleted file mode 100644 index 7fec29a000..0000000000 --- a/lib/orber/src/Makefile +++ /dev/null @@ -1,263 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2016. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# -# -include $(ERL_TOP)/make/target.mk - -include $(ERL_TOP)/make/$(TARGET)/otp.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)"}' - -ASN_FLAGS = -bber +der +compact_bit_string +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) IDL-GENERATED - rm -f errs core *~ - -$(APP_TARGET): $(APP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(ORBER_VSN);' $< > $@ - -$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(ORBER_VSN);' $< > $@ - -docs: - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -IDL-GENERATED: $(ERL_TOP)/lib/ic/include/erlang.idl CORBA.idl OrberIFR.idl - $(gen_verbose)erlc $(ERL_IDL_FLAGS) $(ERL_TOP)/lib/ic/include/erlang.idl - $(V_at)erlc $(ERL_IDL_FLAGS) CORBA.idl - $(V_at)erlc $(ERL_IDL_FLAGS) +'{this,"Orber::IFR"}' OrberIFR.idl - $(V_at)>IDL-GENERATED - -$(GEN_ERL_FILES): IDL-GENERATED -$(TARGET_FILES): IDL-GENERATED - -$(GEN_ASN_ERL) $(GEN_ASN_HRL): OrberCSIv2.asn1 OrberCSIv2.set.asn - $(asn_verbose)erlc $(ERL_COMPILE_FLAGS) $(ASN_FLAGS) +'{inline,"OrberCSIv2"}' OrberCSIv2.set.asn - $(V_at)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 deleted file mode 100644 index 069f4ad17a..0000000000 --- a/lib/orber/src/OrberApp_IFR_impl.erl +++ /dev/null @@ -1,102 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index d776ce2b47..0000000000 --- a/lib/orber/src/OrberCSIv2.asn1 +++ /dev/null @@ -1,45 +0,0 @@ -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 deleted file mode 100644 index 11fbcc167f..0000000000 --- a/lib/orber/src/OrberCSIv2.set.asn +++ /dev/null @@ -1,5 +0,0 @@ -OrberCSIv2.asn1 -PKIXAttributeCertificate.asn1 -PKIX1Explicit88.asn1 -PKIX1Algorithms88.asn1 -PKIX1Implicit88.asn1 diff --git a/lib/orber/src/OrberIFR.idl b/lib/orber/src/OrberIFR.idl deleted file mode 100644 index 6d53217658..0000000000 --- a/lib/orber/src/OrberIFR.idl +++ /dev/null @@ -1,12 +0,0 @@ -#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 deleted file mode 100644 index e78de69b0e..0000000000 --- a/lib/orber/src/PKIX1Algorithms88.asn1 +++ /dev/null @@ -1,274 +0,0 @@ - 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 deleted file mode 100644 index 9b8068fed0..0000000000 --- a/lib/orber/src/PKIX1Explicit88.asn1 +++ /dev/null @@ -1,619 +0,0 @@ -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 deleted file mode 100644 index ced270baf6..0000000000 --- a/lib/orber/src/PKIX1Implicit88.asn1 +++ /dev/null @@ -1,349 +0,0 @@ -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 deleted file mode 100644 index 7d93e6b37e..0000000000 --- a/lib/orber/src/PKIXAttributeCertificate.asn1 +++ /dev/null @@ -1,189 +0,0 @@ - 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 deleted file mode 100644 index ec7c3ba83a..0000000000 --- a/lib/orber/src/any.erl +++ /dev/null @@ -1,74 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index fd021988c9..0000000000 --- a/lib/orber/src/cdr_decode.erl +++ /dev/null @@ -1,1536 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2015. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 {Endianness, Rest} where Endianness 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 {Endianness, Rest} where Endianness 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) when is_list(ElementList) -> - - {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}; -dec_sequence_union(Version, Message, N, _DiscrTC, _Default, Module, - Len, ByteOrder, Buff, C, Name) when is_atom(Module) -> - case catch Module:tc() of - {tk_union, _, _, DiscrTC, Default, ElementList} -> - dec_sequence_union(Version, Message, N, DiscrTC, Default, ElementList, - Len, ByteOrder, Buff, C, Name); - What -> - orber:dbg("[~p] ~p:dec_sequence_union(~p). Union module doesn't exist or incorrect.", - [?LINE, ?MODULE, What], ?DEBUG_LEVEL), - corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}) - end. - - - -%% 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) when is_list(ElementList) -> - {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(Version, IFRId, _, _DiscrTC, _Default, Module, Bytes, Len, - ByteOrder, Buff, C) when is_atom(Module) -> - case catch Module:tc() of - {tk_union, _, Name, DiscrTC, Default, ElementList} -> - dec_union(Version, IFRId, Name, DiscrTC, Default, ElementList, Bytes, Len, - ByteOrder, Buff, C); - What -> - orber:dbg("[~p] ~p:dec_union(~p). Union module doesn't exist or incorrect.", - [?LINE, ?MODULE, What], ?DEBUG_LEVEL), - corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}) - end. - - - -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}; -dec_struct1(Version, Module, Message, Len, ByteOrder, Buff, C) -> - case catch Module:tc() of - {tk_struct, _, _, TypeCodeList} -> - dec_struct1(Version, TypeCodeList, Message, Len, ByteOrder, Buff, C); - What -> - orber:dbg("[~p] ~p:dec_struct1(~p). Struct module doesn't exist or incorrect.", - [?LINE, ?MODULE, What], ?DEBUG_LEVEL), - corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}) - end. - -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 -> - L = length(Nodes), - IFR = get_ifr_node(Nodes, rand: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), rand: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 -> - L = length(Nodes), - IFR = get_ifr_node(Nodes, rand: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), - TC = dec_type_code(TypeNo, Version, Message1, Len1, ByteOrder, Buff, NewC), - erase(orber_indirection), - TC. - -%%----------------------------------------------------------------- -%% 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) -> - {Indirection, Message1, Len1, NewC} = - dec_type('tk_long', Version, Message, Len, ByteOrder, Buff, C), - Position = C+Indirection, - case put(orber_indirection, Position) of - Position -> -%% {{'none', Indirection}, Message1, Len1, NewC}; - %% Recursive TypeCode. Break the loop. - orber:dbg("[~p] cdr_decode:dec_type_code(~p); Recursive TC not supported.", - [?LINE,Position], ?DEBUG_LEVEL), - corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO}); - _ -> - <<_:Position/binary, SubBuff/binary>> = Buff, - {TC, _, _, _} = dec_type_code(Version, SubBuff, Position, ByteOrder, Buff, Position), - {TC, Message1, Len1, NewC} - end; -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 deleted file mode 100644 index 2c42d5bd7e..0000000000 --- a/lib/orber/src/cdr_encode.erl +++ /dev/null @@ -1,1172 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 length.", - [?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) when is_list(TypeCodeList) -> - {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_union(Env, Value, _DiscrTC, _Default, Module, Bytes, Len) when is_atom(Module) -> - case catch Module:tc() of - {tk_union, _, _, DiscrTC, Default, ElementList} -> - enc_union(Env, Value, DiscrTC, Default, ElementList, Bytes, Len); - What -> - orber:dbg("[~p] ~p:enc_union(~p). Union module doesn't exist or incorrect.", - [?LINE, ?MODULE, What], ?DEBUG_LEVEL), - corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}) - end. - -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) when is_list(TypeCodeList) -> - [_Name | StructList] = tuple_to_list(Struct), - enc_struct1(Env, StructList, TypeCodeList, Bytes, Len); -enc_struct(Env, Struct, Module, Bytes, Len) -> - [Module | StructList] = tuple_to_list(Struct), - case catch Module:tc() of - {tk_struct, _, _, TypeCodeList} -> - enc_struct1(Env, StructList, TypeCodeList, Bytes, Len); - What -> - orber:dbg("[~p] ~p:enc_struct([], ~p). Struct module doesn't exist or incorrect.", - [?LINE, ?MODULE, What], ?DEBUG_LEVEL), - corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}) - end. - -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 deleted file mode 100644 index a181681382..0000000000 --- a/lib/orber/src/cdrlib.erl +++ /dev/null @@ -1,415 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 23ce01ffc3..0000000000 --- a/lib/orber/src/corba.erl +++ /dev/null @@ -1,2206 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 parse_remote_modifier(RemoteModifier) of - {error, _} -> - resolve_initial_references_remote(ObjectId, Rest, Ctx); - {ok, Host, Port} -> - 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) - 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 parse_remote_modifier(RemoteModifier) of - {error, _} -> - resolve_initial_references_remote(Rest, Ctx); - {ok, Host, Port} -> - 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) - end; -list_initial_services_remote(_, _) -> - raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). - - -parse_remote_modifier("iiop://" ++ Rest) -> - parse_host_version(Rest); -parse_remote_modifier(_RemoteModifier) -> - {error, not_supported}. - -parse_host_version("[" ++ Rest) -> - parse_ipv6(Rest, []); -parse_host_version(Rest) -> - parse_ipv4_or_dnsname(Rest, []). - - -parse_ipv4_or_dnsname([$: |Rest], Acc) -> - {ok, lists:reverse(Acc), Rest}; -parse_ipv4_or_dnsname([C |Rest], Acc) -> - parse_ipv4_or_dnsname(Rest, [C |Acc]). - -parse_ipv6("]:" ++ Rest, Acc) -> - {ok, lists:reverse(Acc), Rest}; -parse_ipv6([C |Rest], Acc) -> - parse_ipv6(Rest, [C |Acc]). - - -%%----------------------------------------------------------------- -%% 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: -%%---------------------------------------------------------------------- -%% To avoid dialyzer warnings due to the use of exit/throw. --spec raise(term()) -> no_return(). -raise(E) -> - throw({'EXCEPTION', E}). - -%%---------------------------------------------------------------------- -%% Function : raise_with_state -%% Arguments : Local exception representation. -%% Returns : Throws the exception. -%% Description: -%%---------------------------------------------------------------------- -%% To avoid dialyzer warnings due to the use of exit/throw. --spec raise_with_state(term(), term()) -> no_return(). -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({{erlang:system_time(), - erlang:unique_integer()}, - 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 deleted file mode 100644 index 12b063a5db..0000000000 --- a/lib/orber/src/corba_boa.erl +++ /dev/null @@ -1,135 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 4a1361842b..0000000000 --- a/lib/orber/src/corba_nvlist.erl +++ /dev/null @@ -1,98 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index bf31226067..0000000000 --- a/lib/orber/src/corba_object.erl +++ /dev/null @@ -1,221 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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/fixed.erl b/lib/orber/src/fixed.erl deleted file mode 100644 index 8d6239991d..0000000000 --- a/lib/orber/src/fixed.erl +++ /dev/null @@ -1,306 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 3feedbc652..0000000000 --- a/lib/orber/src/ifr_objects.hrl +++ /dev/null @@ -1,422 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index a78a6b96e5..0000000000 --- a/lib/orber/src/iop_ior.erl +++ /dev/null @@ -1,1717 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 217c1b247f..0000000000 --- a/lib/orber/src/orber.app.src +++ /dev/null @@ -1,111 +0,0 @@ -{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, mnesia]}, - {env, []}, - {mod, {orber, []}}, - {runtime_dependencies, ["stdlib-2.5","ssl-5.3.4","mnesia-4.12","kernel-3.0", - "inets-5.10","erts-7.0"]} -]}. - - diff --git a/lib/orber/src/orber.appup.src b/lib/orber/src/orber.appup.src deleted file mode 100644 index 6c3b2833b7..0000000000 --- a/lib/orber/src/orber.appup.src +++ /dev/null @@ -1,7 +0,0 @@ -{"%VSN%", - [ - ], - [ - ] -}. - diff --git a/lib/orber/src/orber.erl b/lib/orber/src/orber.erl deleted file mode 100644 index f5e2429f5d..0000000000 --- a/lib/orber/src/orber.erl +++ /dev/null @@ -1,1238 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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, iiop_out_ports_random/0, - iiop_out_ports_attempts/0, - ssl_server_options/0, ssl_client_options/0, set_ssl_client_options/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_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, list_to_atom(integer_to_list(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(). - -iiop_out_ports_random() -> - orber_env:iiop_out_ports_random(). - -iiop_out_ports_attempts() -> - orber_env:iiop_out_ports_attempts(). - -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_options() -> - orber_env:ssl_server_options(). - -ssl_client_options() -> - orber_env:ssl_client_options(). - -set_ssl_client_options(Value) -> - orber_env:set_ssl_client_options(Value). - -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) -> - case remove_tables(Tables, Node, []) of - ok -> - ok; - {error, Node, Failed} -> - ?EFORMAT("orber:remove_node(~p) failed. Unable to remove table(s): ~p", - [Node, Failed]) - end. - -remove_tables([], _, []) -> - ok; -remove_tables([], Node, Failed) -> - {error, 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 deleted file mode 100644 index 55d84afbab..0000000000 --- a/lib/orber/src/orber_acl.erl +++ /dev/null @@ -1,397 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 18d28fcf35..0000000000 --- a/lib/orber/src/orber_diagnostics.erl +++ /dev/null @@ -1,241 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 3000af6cd3..0000000000 --- a/lib/orber/src/orber_env.erl +++ /dev/null @@ -1,1545 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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_out_ports_random/0, - iiop_connection_timeout/0, iiop_setup_connection_timeout/0, iiop_out_ports_attempts/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_options/0, ssl_client_options/0, set_ssl_client_options/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, - ssl_server_options, ssl_client_options]). - -%% 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 is not running ***~n" - "==========================================~n", - [])) - 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(), - {orber, _, OrberVsn} = lists:keyfind(orber, 1, application:loaded_applications()), - [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 ports attempts.......: ~p~n" - "IIOP out ports random.........: ~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", - [OrberVsn, 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(), - iiop_out_ports_attempts(), iiop_out_ports_random(), - 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 options............: ~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 options............: ~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_options(), - 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_options(), - 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. - -iiop_out_ports_random() -> - case application:get_env(orber, iiop_out_ports_random) of - {ok, true} -> - true; - _ -> - false - end. - -iiop_out_ports_attempts() -> - case application:get_env(orber, iiop_out_ports_attempts) of - {ok, No} when is_integer(No) andalso No > 0 -> - No; - _ -> - 1 - 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_options() -> - case application:get_env(orber, ssl_server_options) of - {ok, V1} when is_list(V1) -> - V1; - _ -> - [] - end. - -ssl_client_options() -> - case application:get_env(orber, ssl_client_options) of - {ok, V1} when is_list(V1) -> - V1; - _ -> - [] - end. - -check_ssl_opts(Value) -> - check_ssl_opts(Value, []). -check_ssl_opts([], []) -> - ok; -check_ssl_opts([], Acc) -> - {error, Acc}; -check_ssl_opts([{active, _} |T], Acc) -> - check_ssl_opts(T, [active |Acc]); -check_ssl_opts([{packet, _} |T], Acc) -> - check_ssl_opts(T, [packet |Acc]); -check_ssl_opts([{mode, _} |T], Acc) -> - check_ssl_opts(T, [mode |Acc]); -check_ssl_opts([list |T], Acc) -> - check_ssl_opts(T, [list |Acc]); -check_ssl_opts([binary |T], Acc) -> - check_ssl_opts(T, [binary |Acc]); -check_ssl_opts([_ |T], Acc) -> - check_ssl_opts(T, Acc). - -set_ssl_client_options(Value) when is_list(Value) -> - case check_ssl_opts(Value) of - ok -> - ok; - {error, List} -> - exit(lists:flatten( - io_lib:format("TCP options ~p is not allowed in set_ssl_client_options()", - [List]))) - end, - put(ssl_client_options, Value), ok. - -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); -configure(iiop_out_ports_attempts, Max, Status) when is_integer(Max) andalso Max > 0 -> - do_safe_configure(iiop_out_ports_attempts, Max, Status); -configure(iiop_out_ports_random, true, Status) -> - do_safe_configure(iiop_out_ports_random, true, Status); -configure(iiop_out_ports_random, false, Status) -> - do_safe_configure(iiop_out_ports_random, false, 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); - -%% New SSL options -configure(ssl_server_options, Value, Status) when is_list(Value) -> - do_safe_configure(ssl_server_options, Value, Status); -configure(ssl_client_options, Value, Status) when is_list(Value) -> - do_safe_configure(ssl_client_options, Value, Status); - -%% Old SSL options -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 deleted file mode 100644 index 2519775eb3..0000000000 --- a/lib/orber/src/orber_exceptions.erl +++ /dev/null @@ -1,718 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 70e0cb3fca..0000000000 --- a/lib/orber/src/orber_ifr.erl +++ /dev/null @@ -1,1820 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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, Type, 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). --spec 'Repository_destroy'(_) -> no_return(). -'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). --spec 'ORB_create_recursive_sequence_tc'(_,_) -> no_return(). -'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 deleted file mode 100644 index 10634f58c0..0000000000 --- a/lib/orber/src/orber_ifr.hrl +++ /dev/null @@ -1,35 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 04a92be5e3..0000000000 --- a/lib/orber/src/orber_ifr_aliasdef.erl +++ /dev/null @@ -1,135 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 1513914a08..0000000000 --- a/lib/orber/src/orber_ifr_arraydef.erl +++ /dev/null @@ -1,104 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index bf7d1d2b63..0000000000 --- a/lib/orber/src/orber_ifr_attributedef.erl +++ /dev/null @@ -1,138 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index b9d4393177..0000000000 --- a/lib/orber/src/orber_ifr_constantdef.erl +++ /dev/null @@ -1,148 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 2a67fa98fd..0000000000 --- a/lib/orber/src/orber_ifr_contained.erl +++ /dev/null @@ -1,248 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index e085985bc4..0000000000 --- a/lib/orber/src/orber_ifr_container.erl +++ /dev/null @@ -1,464 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index b1820046bb..0000000000 --- a/lib/orber/src/orber_ifr_enumdef.erl +++ /dev/null @@ -1,130 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index a9e477f01a..0000000000 --- a/lib/orber/src/orber_ifr_exceptiondef.erl +++ /dev/null @@ -1,145 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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}). - -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 deleted file mode 100644 index fc1b354af0..0000000000 --- a/lib/orber/src/orber_ifr_fixeddef.erl +++ /dev/null @@ -1,80 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 44ab86c41a..0000000000 --- a/lib/orber/src/orber_ifr_idltype.erl +++ /dev/null @@ -1,75 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 1195f1eff6..0000000000 --- a/lib/orber/src/orber_ifr_interfacedef.erl +++ /dev/null @@ -1,340 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 1111f00f81..0000000000 --- a/lib/orber/src/orber_ifr_irobject.erl +++ /dev/null @@ -1,73 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index add0feb31a..0000000000 --- a/lib/orber/src/orber_ifr_moduledef.erl +++ /dev/null @@ -1,184 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 4bc368487c..0000000000 --- a/lib/orber/src/orber_ifr_operationdef.erl +++ /dev/null @@ -1,192 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 3969bbf37a..0000000000 --- a/lib/orber/src/orber_ifr_orb.erl +++ /dev/null @@ -1,100 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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}. - --spec create_recursive_sequence_tc(_, _) -> no_return(). -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 deleted file mode 100644 index bf91bc87bb..0000000000 --- a/lib/orber/src/orber_ifr_primitivedef.erl +++ /dev/null @@ -1,70 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 8d52573e53..0000000000 --- a/lib/orber/src/orber_ifr_repository.erl +++ /dev/null @@ -1,288 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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}). - --spec destroy(_) -> no_return(). -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 deleted file mode 100644 index f3a9806828..0000000000 --- a/lib/orber/src/orber_ifr_sequencedef.erl +++ /dev/null @@ -1,104 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index b206a218c1..0000000000 --- a/lib/orber/src/orber_ifr_stringdef.erl +++ /dev/null @@ -1,75 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 3a9cde353e..0000000000 --- a/lib/orber/src/orber_ifr_structdef.erl +++ /dev/null @@ -1,156 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 52263be719..0000000000 --- a/lib/orber/src/orber_ifr_typecode.erl +++ /dev/null @@ -1,108 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 3441d7e7af..0000000000 --- a/lib/orber/src/orber_ifr_typedef.erl +++ /dev/null @@ -1,125 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 64d55ee581..0000000000 --- a/lib/orber/src/orber_ifr_uniondef.erl +++ /dev/null @@ -1,176 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 95a1d504bc..0000000000 --- a/lib/orber/src/orber_ifr_utils.erl +++ /dev/null @@ -1,437 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2015. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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. - -unique() -> term_to_binary({node(), {erlang:system_time(), - erlang:unique_integer()}}). - -%%%---------------------------------------------------------------------- -%%% 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 deleted file mode 100644 index 2ff7d84c7a..0000000000 --- a/lib/orber/src/orber_ifr_wstringdef.erl +++ /dev/null @@ -1,73 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 8cb39c7365..0000000000 --- a/lib/orber/src/orber_iiop.erl +++ /dev/null @@ -1,551 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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. - --dialyzer({no_improper_lists, encode_request/1}). -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 deleted file mode 100644 index ec502b6f09..0000000000 --- a/lib/orber/src/orber_iiop.hrl +++ /dev/null @@ -1,1016 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 address 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 deleted file mode 100644 index b595586f84..0000000000 --- a/lib/orber/src/orber_iiop_inproxy.erl +++ /dev/null @@ -1,399 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 9d84b63398..0000000000 --- a/lib/orber/src/orber_iiop_inrequest.erl +++ /dev/null @@ -1,541 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 -%%----------------------------------------------------------------- --dialyzer({no_improper_lists, call_interceptors/7}). -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 -%%----------------------------------------------------------------- --dialyzer({no_improper_lists, call_interceptors_out/7}). -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 deleted file mode 100644 index 2885cf06c0..0000000000 --- a/lib/orber/src/orber_iiop_insup.erl +++ /dev/null @@ -1,86 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index e7f54891a2..0000000000 --- a/lib/orber/src/orber_iiop_net.erl +++ /dev/null @@ -1,511 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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: get_options/2 -%%----------------------------------------------------------------- -get_options(normal, _Options) -> - []; -get_options(ssl, Options) -> - SSLOpts = - case orber_tb:keysearch(ssl_server_options, Options, - orber_env:ssl_server_options()) of - [] -> - 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()), - KeepAlive = orber_tb:keysearch(ssl_server_cachetimeout, Options, - orber_env:iiop_ssl_in_keepalive()), - [{verify, Verify}, - {depth, Depth}, - {certfile, Cert}, - {cacertfile, CaCert}, - {password, Pwd}, - {keyfile, Key}, - {ciphers, Ciphers}, - {cachetimeout, Timeout}, - {keepalive, KeepAlive}]; - Opts -> - case orber_tb:check_illegal_tcp_options(Opts) of - ok -> - check_old_ssl_server_options(Options), - Opts; - {error, IllegalOpts} -> - error_logger:error_report([{application, orber}, - "TCP options not allowed to set on a connection", - IllegalOpts]), - error("Illegal TCP option") - end - end, - ssl_server_extra_options(SSLOpts, []). - -%%----------------------------------------------------------------- -%% Func: parse_options/2 -%%----------------------------------------------------------------- -parse_options([{port, Type, Port} | Rest], State) -> - Options = get_options(Type, []), - Family = orber_env:ip_version(), - IPFamilyOptions = - case Family of - inet -> [inet]; - inet6 -> [inet6, {ipv6_v6only, true}] - end, - Options2 = - case orber_env:ip_address_variable_defined() of - false -> - IPFamilyOptions ++ Options; - Host -> - {ok, IP} = inet:getaddr(Host, Family), - IPFamilyOptions ++ [{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_tb:keysearch(ip_family, AllOptions, orber_env:ip_version()), - IPFamilyOptions = - case Family of - inet -> [inet]; - inet6 -> [inet6, {ipv6_v6only, true}] - end, - case inet:getaddr(IP, Family) of - {ok, IPTuple} -> - try - Options = IPFamilyOptions ++ [{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 - catch - error:Reason -> - {reply, {error, Reason}, 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), - {ok, NewPid} = orber_iiop_socketsup:start_accept(Type, Listen, - Ref, POpts), - link(NewPid), - ets:insert(?CONNECTION_DB, #listen{pid = NewPid, socket = Listen, - 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}. - -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}. - - -check_old_ssl_server_options(Options) -> - try - 0 = orber_tb:keysearch(ssl_server_verify, Options, - orber_env:ssl_server_verify()), - 1 = orber_tb:keysearch(ssl_server_depth, Options, - orber_env:ssl_server_depth()), - [] = orber_tb:keysearch(ssl_server_certfile, Options, - orber_env:ssl_server_certfile()), - [] = orber_tb:keysearch(ssl_server_cacertfile, Options, - orber_env:ssl_server_cacertfile()), - [] = orber_tb:keysearch(ssl_server_password, Options, - orber_env:ssl_server_password()), - [] = orber_tb:keysearch(ssl_server_keyfile, Options, - orber_env:ssl_server_keyfile()), - [] = orber_tb:keysearch(ssl_server_ciphers, Options, - orber_env:ssl_server_ciphers()), - infinity = orber_tb:keysearch(ssl_server_cachetimeout, Options, - orber_env:ssl_server_cachetimeout()), - false = orber_tb:keysearch(iiop_ssl_in_keepalive, Options, - orber_env:iiop_ssl_in_keepalive()) - catch - _:_ -> - io:format("hej\n",[]), - error_logger:warning_report([{application, orber}, - "Ignoring deprecated ssl server options used together with the ssl_server_options"]) - end. - diff --git a/lib/orber/src/orber_iiop_net_accept.erl b/lib/orber/src/orber_iiop_net_accept.erl deleted file mode 100644 index 2a53d55cea..0000000000 --- a/lib/orber/src/orber_iiop_net_accept.erl +++ /dev/null @@ -1,95 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 1406a1ad56..0000000000 --- a/lib/orber/src/orber_iiop_outproxy.erl +++ /dev/null @@ -1,511 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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, [flush]), - Reply; - {'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, - orber_socket:get_ip_family_opts(Host) ++ 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, [flush]), - 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, [flush]), - corba:raise(E); - {'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, [flush]), - ok; - {'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 deleted file mode 100644 index f3627e01a0..0000000000 --- a/lib/orber/src/orber_iiop_outsup.erl +++ /dev/null @@ -1,88 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 72084227aa..0000000000 --- a/lib/orber/src/orber_iiop_pm.erl +++ /dev/null @@ -1,894 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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([]) -> - SSLOpts = - case orber_env:ssl_client_options() of - [] -> - [{verify, orber_env:ssl_client_verify()}, - {depth, orber_env:ssl_client_depth()}, - {certfile, orber_env:ssl_client_certfile()}, - {cacertfile, orber_env:ssl_client_cacertfile()}, - {password, orber_env:ssl_client_password()}, - {keyfile, orber_env:ssl_client_keyfile()}, - {ciphers, orber_env:ssl_client_ciphers()}, - {cachetimeout, orber_env:ssl_client_cachetimeout()}, - {keepalive, orber_env:iiop_ssl_out_keepalive()}]; - Opts -> - case orber_tb:check_illegal_tcp_options(Opts) of - ok -> - check_old_ssl_client_options([]), - Opts; - {error, IllegalOpts} -> - error_logger:error_report([{application, orber}, - "TCP options not allowed to set on a connection", - IllegalOpts]), - error("Illegal TCP option") - end - end, - ssl_client_extra_options(SSLOpts, []); -get_ssl_socket_options([#'IOP_ServiceContext' - {context_id=?ORBER_GENERIC_CTX_ID, - context_data = {configuration, Options}}|_]) -> - SSLOpts = - case orber_tb:keysearch(ssl_client_options, Options, - orber_env:ssl_client_options()) of - [] -> - 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()), - KeepAlive = orber_tb:keysearch(ssl_server_cachetimeout, Options, - orber_env:iiop_ssl_out_keepalive()), - [{verify, Verify}, - {depth, Depth}, - {certfile, Cert}, - {cacertfile, CaCert}, - {password, Pwd}, - {keyfile, Key}, - {ciphers, Ciphers}, - {cachetimeout, Timeout}, - {keepalive, KeepAlive}]; - Opts -> - case orber_tb:check_illegal_tcp_options(Opts) of - ok -> - check_old_ssl_client_options(Options), - Opts; - {error, IllegalOpts} -> - error_logger:error_report([{application, orber}, - "TCP options not allowed to set on a connection", - IllegalOpts]), - error("Illegal TCP option") - end - end, - ssl_client_extra_options(SSLOpts, []); -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(), - case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_USE_ACL_OUTGOING) of - false when UserInterface == 0 -> - get_local_interface(Type); - false -> - inet:getaddr(UserInterface, get_ip_family(UserInterface)); - true -> - SearchFor = - case Type of - normal -> - tcp_out; - ssl -> - ssl_out - end, - {ok, Ip} = inet:getaddr(Host, get_ip_family(Host)), - case orber_acl:match(Ip, SearchFor, true) of - {true, [], 0} -> - get_local_interface(Type); - {true, [], Port} -> - get_local_interface(Type); - {true, [], {Min, Max}} when Port >= Min, Port =< Max -> - get_local_interface(Type); - {true, [Interface], 0} -> - {ok, NewIp} = inet:getaddr(Interface, get_ip_family(Interface)), - {ok, NewIp, {Host, Port, 0}}; - {true, [Interface], Port} -> - - {ok, NewIp} = inet:getaddr(Interface, get_ip_family(Interface)), - {ok, NewIp, {Host, Port, 0}}; - {true, [Interface], {Min, Max}} when Port >= Min, Port =< Max -> - - {ok, NewIp} = inet:getaddr(Interface, get_ip_family(Interface)), - {ok, NewIp, {Host, Port, 0}}; - _ -> - false - end - end. - -get_local_interface(normal) -> - case orber_env:ip_address_local() of - [] -> - ok; - [Interface] -> - inet:getaddr(Interface, get_ip_family(Interface)) - end; -get_local_interface(ssl) -> - case orber_env:iiop_ssl_ip_address_local() of - [] -> - ok; - [Interface] -> - inet:getaddr(Interface, get_ip_family(Interface)) - end. - -get_ip_family(Addr) -> - [Family] = orber_socket:get_ip_family_opts(Addr), - Family. - -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. - - -check_old_ssl_client_options(Options) -> - try - 0 = orber_tb:keysearch(ssl_client_verify, Options, - orber_env:ssl_client_verify()), - 1 = orber_tb:keysearch(ssl_client_depth, Options, - orber_env:ssl_client_depth()), - [] = orber_tb:keysearch(ssl_client_certfile, Options, - orber_env:ssl_client_certfile()), - [] = orber_tb:keysearch(ssl_client_cacertfile, Options, - orber_env:ssl_client_cacertfile()), - [] = orber_tb:keysearch(ssl_client_password, Options, - orber_env:ssl_client_password()), - [] = orber_tb:keysearch(ssl_client_keyfile, Options, - orber_env:ssl_client_keyfile()), - [] = orber_tb:keysearch(ssl_client_ciphers, Options, - orber_env:ssl_client_ciphers()), - infinity = orber_tb:keysearch(ssl_client_cachetimeout, Options, - orber_env:ssl_client_cachetimeout()), - false = orber_tb:keysearch(iiop_ssl_out_keepalive, Options, - orber_env:iiop_ssl_out_keepalive()) - - catch - _:_ -> - error_logger:warning_report([{application, orber}, - "Ignoring deprecated ssl client options used together with the ssl_client_options"]) - end. - - - - -%%----------------------------------------------------------------- -%% END OF MODULE -%%----------------------------------------------------------------- diff --git a/lib/orber/src/orber_iiop_socketsup.erl b/lib/orber/src/orber_iiop_socketsup.erl deleted file mode 100644 index 43b5444c82..0000000000 --- a/lib/orber/src/orber_iiop_socketsup.erl +++ /dev/null @@ -1,86 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 8d6cd2e8b8..0000000000 --- a/lib/orber/src/orber_iiop_tracer.erl +++ /dev/null @@ -1,232 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 659de0acee..0000000000 --- a/lib/orber/src/orber_iiop_tracer_silent.erl +++ /dev/null @@ -1,191 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 8eaa945d3f..0000000000 --- a/lib/orber/src/orber_iiop_tracer_stealth.erl +++ /dev/null @@ -1,187 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 9140563881..0000000000 --- a/lib/orber/src/orber_initial_references.erl +++ /dev/null @@ -1,328 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 occurred 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 deleted file mode 100644 index 4bfb2ae9a5..0000000000 --- a/lib/orber/src/orber_interceptors.erl +++ /dev/null @@ -1,154 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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, lists:droplast(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])). - diff --git a/lib/orber/src/orber_objectkeys.erl b/lib/orber/src/orber_objectkeys.erl deleted file mode 100644 index 12ed1a2f85..0000000000 --- a/lib/orber/src/orber_objectkeys.erl +++ /dev/null @@ -1,571 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 occurred 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=erlang:monotonic_time(seconds)}); - [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=erlang:monotonic_time(seconds)}); - [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=erlang:monotonic_time(seconds)}); - [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, TimeStamp) -> - TimeStamp+S < erlang:monotonic_time(seconds). - -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 deleted file mode 100644 index 19bb7af6c0..0000000000 --- a/lib/orber/src/orber_pi.erl +++ /dev/null @@ -1,1213 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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'{}} -%%------------------------------------------------------------ --spec get_slot(_, _) -> no_return(). -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'{}} -%%------------------------------------------------------------ --spec set_slot(_, _, _) -> no_return(). -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 deleted file mode 100644 index 755b999c13..0000000000 --- a/lib/orber/src/orber_request_number.erl +++ /dev/null @@ -1,83 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 9b39dad928..0000000000 --- a/lib/orber/src/orber_socket.erl +++ /dev/null @@ -1,530 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2015. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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, sockdata/2, setopts/3, - clear/2, shutdown/3, post_accept/2, post_accept/3, - get_ip_family_opts/1]). - -%%----------------------------------------------------------------- -%% 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]; - _ -> - Options1 - end, - case orber:iiop_out_ports() of - {Min, Max} when Type == normal -> - multi_connect(get_port_sequence(Min, Max), orber_env:iiop_out_ports_attempts(), - Type, Host, Port, [binary, {reuseaddr, true}, - {packet,cdr}| Options2], Timeout); - {Min, Max} when Generation > 2 -> - multi_connect(get_port_sequence(Min, Max), orber_env:iiop_out_ports_attempts(), - Type, Host, Port, [binary, {reuseaddr, true}, - {packet,cdr}| Options2], Timeout); - {Min, Max} -> - %% reuseaddr not available for older SSL versions - multi_connect(get_port_sequence(Min, Max), orber_env:iiop_out_ports_attempts(), - 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([], _Retries, Type, Host, Port, Options, _) -> - 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|Rest], Retries, normal, Host, Port, Options, Timeout) -> - case catch gen_tcp:connect(Host, Port, [{port, CurrentPort}|Options], Timeout) of - {ok, Socket} -> - Socket; - {error, timeout} when Retries =< 1 -> - 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(Rest, Retries - 1, normal, Host, Port, Options, Timeout) - end; -multi_connect([CurrentPort|Rest], Retries, ssl, Host, Port, Options, Timeout) -> - case catch ssl:connect(Host, Port, [{port, CurrentPort}|Options], Timeout) of - {ok, Socket} -> - Socket; - {error, timeout} when Retries =< 1 -> - 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(Rest, Retries - 1, ssl, Host, Port, Options, Timeout) - end. - - -get_port_sequence(Min, Max) -> - case orber_env:iiop_out_ports_random() of - true -> - Seq = lists:seq(Min, Max), - random_sequence((Max - Min) + 1, Seq, []); - _ -> - lists:seq(Min, Max) - end. - -random_sequence(0, _, Acc) -> - Acc; -random_sequence(Length, Seq, Acc) -> - Nth = rand:uniform(Length), - Value = lists:nth(Nth, Seq), - NewSeq = lists:delete(Value, Seq), - random_sequence(Length-1, NewSeq, [Value|Acc]). - -%%----------------------------------------------------------------- -%% 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, - Options4 = [binary, {packet,cdr}, {keepalive, Keepalive}, - {reuseaddr,true}, {backlog, Backlog} | - Options3], - - case catch gen_tcp:listen(Port, Options4) of - {ok, ListenSocket} -> - {ok, ListenSocket, check_port(Port, normal, ListenSocket)}; - {error, Reason} when Exception == false -> - {error, Reason}; - {error, eaddrinuse} -> - 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, Options4], ?DEBUG_LEVEL), - corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO}); - Error -> - orber:dbg("[~p] orber_socket:listen(normal, ~p, ~p);~n" - "Failed with reason: ~p", - [?LINE, Port, Options4, 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} |Options3]; - true -> - Options3 - end, - Options5 = [binary, {packet,cdr}, {backlog, Backlog} | Options4], - case catch ssl:listen(Port, Options5) of - {ok, ListenSocket} -> - {ok, ListenSocket, check_port(Port, ssl, ListenSocket)}; - {error, Reason} when Exception == false -> - {error, Reason}; - {error, eaddrinuse} -> - 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, Options5], ?DEBUG_LEVEL), - corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO}); - Error -> - orber:dbg("[~p] orber_socket:listen(ssl, ~p, ~p);~n" - "Failed with reason: ~p", - [?LINE, Port, Options5, 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}. - -%%----------------------------------------------------------------- -%% 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. -check_options(normal, Options, _Generation) -> - Options; -check_options(ssl, Options, Generation) -> - if - Generation > 2 -> - [{ssl_imp, new}|Options]; - true -> - [{ssl_imp, old}|Options] - end. - - -%%----------------------------------------------------------------- -%% Check IP Family. -get_ip_family_opts(Host) -> - case inet:parse_address(Host) of - {ok, {_,_,_,_}} -> - [inet]; - {ok, {_,_,_,_,_,_,_,_}} -> - [inet6]; - {error, einval} -> - check_family_for_name(Host, orber_env:ip_version()) - end. - -check_family_for_name(Host, inet) -> - case inet:getaddr(Host, inet) of - {ok, _Address} -> - [inet]; - {error, _} -> - case inet:getaddr(Host, inet6) of - {ok, _Address} -> - [inet6]; - {error, _} -> - [inet] - end - end; -check_family_for_name(Host, inet6) -> - case inet:getaddr(Host, inet6) of - {ok, _Address} -> - [inet6]; - {error, _} -> - case inet:getaddr(Host, inet) of - {ok, _Address} -> - [inet]; - {error, _} -> - [inet6] - end - end. - diff --git a/lib/orber/src/orber_tb.erl b/lib/orber/src/orber_tb.erl deleted file mode 100644 index 6a758330cd..0000000000 --- a/lib/orber/src/orber_tb.erl +++ /dev/null @@ -1,222 +0,0 @@ -%%---------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 -%%---------------------------------------------------------------------- -%% Avoid warning for local function error/2 clashing with autoimported BIF. --compile({no_auto_import,[error/2]}). --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, - check_illegal_tcp_options/1]). - -%%---------------------------------------------------------------------- -%% 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). - - - - - -%%---------------------------------------------------------------------- -%% function : check_illegal_tcp_options/1 -%% Arguments: -%% Returns : -%% Exception: -%% Effect : -%%---------------------------------------------------------------------- -check_illegal_tcp_options(Options) -> - check_illegal_tcp_options(Options, []). - -check_illegal_tcp_options([],[]) -> - ok; -check_illegal_tcp_options([],IllegalOpts) -> - {error, IllegalOpts}; -check_illegal_tcp_options([{active, V} |T], IllegalOpts) -> - check_illegal_tcp_options(T,[{active, V} |IllegalOpts]); -check_illegal_tcp_options([{packet, V} |T], IllegalOpts) -> - check_illegal_tcp_options(T,[{packet, V} |IllegalOpts]); -check_illegal_tcp_options([{mode, V} |T], IllegalOpts) -> - check_illegal_tcp_options(T,[{mode, V} |IllegalOpts]); -check_illegal_tcp_options([list |T], IllegalOpts) -> - check_illegal_tcp_options(T,[list |IllegalOpts]); -check_illegal_tcp_options([binary |T], IllegalOpts) -> - check_illegal_tcp_options(T,[binary |IllegalOpts]); -check_illegal_tcp_options([{reuseaddr, V} |T], IllegalOpts) -> - check_illegal_tcp_options(T,[{reuseaddr, V} |IllegalOpts]); -check_illegal_tcp_options([_H|T], IllegalOpts) -> - check_illegal_tcp_options(T, IllegalOpts). - -%%---------------------------------------------------------------------- -%% Internal functions -%%---------------------------------------------------------------------- - -%%---------------------------------------------------------------------- -%%------------- END OF MODULE ------------------------------------------ -%%---------------------------------------------------------------------- diff --git a/lib/orber/src/orber_tc.erl b/lib/orber/src/orber_tc.erl deleted file mode 100644 index 9a8a9259ed..0000000000 --- a/lib/orber/src/orber_tc.erl +++ /dev/null @@ -1,284 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 30c03974c2..0000000000 --- a/lib/orber/src/orber_typedefs.erl +++ /dev/null @@ -1,83 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index cc24b2cb19..0000000000 --- a/lib/orber/src/orber_web.erl +++ /dev/null @@ -1,864 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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 deleted file mode 100644 index 3506894df2..0000000000 --- a/lib/orber/src/orber_web_server.erl +++ /dev/null @@ -1,190 +0,0 @@ -%%---------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2015. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions 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, {}). --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)-> - {ok, #state{}}. - -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 -%%---------------------------------------------------------------------- |