1%%-------------------------------------------------------------------- 2%% 3%% %CopyrightBegin% 4%% 5%% Copyright Ericsson AB 1997-2017. All Rights Reserved. 6%% 7%% Licensed under the Apache License, Version 2.0 (the "License"); 8%% you may not use this file except in compliance with the License. 9%% You may obtain a copy of the License at 10%% 11%% http://www.apache.org/licenses/LICENSE-2.0 12%% 13%% Unless required by applicable law or agreed to in writing, software 14%% distributed under the License is distributed on an "AS IS" BASIS, 15%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16%% See the License for the specific language governing permissions and 17%% limitations under the License. 18%% 19%% %CopyrightEnd% 20%% 21%% 22%%-------------------------------------------------------------------- 23%% File: corba.erl 24%% 25%% Description: 26%% This file contains the CORBA::ORB interface plus some 27%% Orber specific functions. 28%%----------------------------------------------------------------- 29-module(corba). 30 31-include_lib("orber/include/corba.hrl"). 32-include_lib("orber/src/orber_iiop.hrl"). 33 34%%----------------------------------------------------------------- 35%% Standard interface CORBA 36%%----------------------------------------------------------------- 37-export([orb_init/1, orb_init/2]). 38%%----------------------------------------------------------------- 39%% Standard interface CORBA::ORB 40%%----------------------------------------------------------------- 41-export([%create_list/2, 42 %create_operation_list/2, 43 %% get_default_context/1, 44 %% 'BOA_init/2, 45 resolve_initial_references/1, 46 resolve_initial_references/2, 47 resolve_initial_references_local/1, 48 list_initial_services/0, 49 add_initial_service/2, 50 remove_initial_service/1, 51 resolve_initial_references_remote/2, 52 resolve_initial_references_remote/3, 53 list_initial_services_remote/1, 54 list_initial_services_remote/2, 55 object_to_string/1, object_to_string/2, 56 object_to_string/3, object_to_string/4, 57 string_to_object/1, 58 string_to_object/2]). 59 60%%----------------------------------------------------------------- 61%% External exports 62%%----------------------------------------------------------------- 63-export([create/2, 64 create/3, 65 create/4, 66 create_link/2, 67 create_link/3, 68 create_link/4, 69 create_remote/3, 70 create_remote/5, 71 create_link_remote/3, 72 create_link_remote/5, 73 create_nil_objref/0, 74 dispose/1, 75 create_subobject_key/2, 76 get_subobject_key/1, 77 get_pid/1, 78 raise/1, raise_with_state/2, 79 print_object/1, 80 print_object/2, 81 add_alternate_iiop_address/3, 82 add_FTGroup_component/4, 83 add_FTPrimary_component/1, 84 call_internal/10]). 85 86%%----------------------------------------------------------------- 87%% Internal (inside orber implementation) exports 88%%----------------------------------------------------------------- 89-export([call/4, call/5, reply/2, 90 cast/4, cast/5, locate/1, locate/2, locate/3, 91 request_from_iiop/6, 92 common_create/5, 93 mk_objkey/4, 94 mk_light_objkey/2, 95 objkey_to_string/1, 96 string_to_objkey/1, 97 string_to_objkey_local/1, 98 call_relay/3, 99 cast_relay/2, 100 handle_init/2, 101 handle_terminate/3, 102 handle_info/3, 103 handle_code_change/4, 104 handle_call/7, 105 handle_call/10, 106 handle_cast/9, 107 handle_cast/6, 108 get_implicit_context/1]). 109 110%%----------------------------------------------------------------- 111%% Internal definitions 112%%----------------------------------------------------------------- 113-define(DEBUG_LEVEL, 5). 114 115-record(is, {flags = 0}). 116 117%% Defines possible configuration parameters a user can add when 118%% creating new CORBA objects. 119-record(options, {sup_child = false, 120 persistent = false, 121 regname = [], 122 pseudo = false, 123 object_flags = ?ORB_INIT_FLAGS, 124 object_flags_set = ?ORB_INIT_FLAGS, 125 create_options = [], 126 passive = false, 127 group_id = 0, 128 internal_state}). 129 130-record(extra, {timeout = infinity, 131 context = []}). 132 133 134%%-------------------------------------------------------------------- 135%% FT stuff 136%%-------------------------------------------------------------------- 137-define(IDL_MODULES, [oe_TimeBase, 138 oe_CosEventComm, 139 oe_CosEventChannelAdmin, 140 oe_CosNotification, 141 oe_CosNotifyComm, 142 oe_CosNotifyFilter, 143 oe_GIOP]). 144 145-define(groupid_to_table(Integer), 146 list_to_atom("ft_" ++ integer_to_list(Integer))). 147 148-define(RM_TABLE_SPEC, 149 [{attributes, record_info(fields, ft_replication_manager)}]). 150-define(RO_TABLE_SPEC, 151 [{attributes, record_info(fields, ft_replicated_object)}]). 152-define(RR_TABLE_SPEC, 153 [{attributes, record_info(fields, ft_reply_retention)}]). 154 155%% how long we're allowed to wait for database tables to be available. 156-define(TABLE_TIMEOUT, infinite). 157 158%-record(rm_state, {default_options, type_options, node_port_ips}). 159 160%-record(node_port_ip, {node, port, ip}). 161 162-record(ft_replication_manager, {object_group_id, 163 type_id, 164 primary, 165 iogr, 166 ref_version, 167 options}). 168 169-record(ft_replicated_object, {group_id, state}). 170-record(ft_reply_retention, {retention_id, reply}). 171 172%-record(ft_properties, {replications_style, 173% membership_style, 174% consistency_style, 175% initial_number_replicas, 176% minimum_number_replicas}). 177 178% one should change things work with stdlib:proplist and clean up the mess. 179%-record(ft_criteria, {ft_properties, 180% object_location, 181% object_init, 182% object_impl}). 183 184%%------------------------------------------------------------ 185%% 186%% Implementation of CORBA CORBA::ORB interfaces 187%% 188%%------------------------------------------------------------ 189 190%%create_list(Count) -> 191%% corba_nvlist:create_list(Count). 192 193%%create_operation_list(OpDef) -> 194%% corba_nvlist:create_operation_list(OpDef). 195 196orb_init(KeyValueList) -> 197 orb_init(KeyValueList, "ORBER"). 198 199orb_init([], _Name) -> 200 ok; 201orb_init(KeyValueList, _Name) -> 202 orber:multi_configure(KeyValueList). 203 204%%----------------------------------------------------------------- 205%% Initial reference handling 206%%----------------------------------------------------------------- 207resolve_initial_references(ObjectId) -> 208 resolve_initial_references(ObjectId, []). 209resolve_initial_references(ObjectId, Ctx) -> 210 case use_local_host(ObjectId) of 211 true -> 212 orber_initial_references:get(ObjectId); 213 Ref -> 214 string_to_object(Ref, Ctx) 215 end. 216 217resolve_initial_references_local(ObjectId) -> 218 orber_initial_references:get(ObjectId). 219 220list_initial_services() -> 221 Local = orber_initial_references:list(), 222 case orber:get_ORBInitRef() of 223 undefined -> 224 Local; 225 InitRef -> 226 orber_tb:unique(Local ++ get_prefixes(InitRef, [])) 227 end. 228 229get_prefixes([], Acc) -> 230 Acc; 231%% A list of ORBInitRef's 232get_prefixes([H|T], Acc) when is_list(H) -> 233 [Key|_] = string:tokens(H, "="), 234 get_prefixes(T, [Key|Acc]); 235%% A single ORBInitRef 236get_prefixes(InitRef, _Acc) when is_list(InitRef) -> 237 [Key|_] = string:tokens(InitRef, "="), 238 [Key]; 239get_prefixes(What, _) -> 240 orber:dbg("[~p] corba:get_prefixes(~p);~nMalformed argument?", 241 [?LINE, What], ?DEBUG_LEVEL), 242 raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO}). 243 244 245use_local_host(ObjectId) -> 246 case orber:get_ORBInitRef() of 247 undefined -> 248 case orber:get_ORBDefaultInitRef() of 249 undefined -> 250 true; 251 DefRef -> 252 DefRef++"/"++ObjectId 253 end; 254 InitRef -> 255 case check_prefixes(InitRef, ObjectId) of 256 false -> 257 case orber:get_ORBDefaultInitRef() of 258 undefined -> 259 true; 260 DefRef -> 261 DefRef++"/"++ObjectId 262 end; 263 UseRef -> 264 strip_junk(UseRef) 265 end 266 end. 267 268 269check_prefixes([], _) -> 270 false; 271%% A list of ORBInitRef's 272check_prefixes([H|T], ObjectId) when is_list(H) -> 273 case prefix(ObjectId, H) of 274 false -> 275 check_prefixes(T, ObjectId); 276 UseRef -> 277 UseRef 278 end; 279%% A single ORBInitRef 280check_prefixes(InitRef, ObjectId) when is_list(InitRef) -> 281 case prefix(ObjectId, InitRef) of 282 false -> 283 false; 284 UseRef -> 285 UseRef 286 end; 287check_prefixes(What,_) -> 288 orber:dbg("[~p] corba:check_prefixes(~p);~nMalformed argument?", 289 [?LINE, What], ?DEBUG_LEVEL), 290 raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO}). 291 292 293%% Valid is, for example, "NameService = corbaloc::host/NameService". 294%% Hence, we must remove ' ' and '='. 295strip_junk([32|T]) -> 296 strip_junk(T); 297strip_junk([$=|T]) -> 298 strip_junk(T); 299strip_junk(Ref) -> 300 Ref. 301 302add_initial_service(ObjectId, ObjectRef) -> 303 orber_initial_references:add(ObjectId, ObjectRef). 304 305remove_initial_service(ObjectId) -> 306 orber_initial_references:remove(ObjectId). 307 308resolve_initial_references_remote(ObjectId, Address) -> 309 resolve_initial_references_remote(ObjectId, Address, []). 310 311resolve_initial_references_remote(_ObjectId, [], _Ctx) -> 312 raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}); 313resolve_initial_references_remote(ObjectId, [RemoteModifier| Rest], Ctx) 314 when is_list(RemoteModifier) -> 315 case parse_remote_modifier(RemoteModifier) of 316 {error, _} -> 317 resolve_initial_references_remote(ObjectId, Rest, Ctx); 318 {ok, Host, Port} -> 319 IOR = iop_ior:create_external(orber:giop_version(), "", 320 Host, list_to_integer(Port), "INIT"), 321 %% We know it's an external referens. Hence, no need to check. 322 {_, Key} = iop_ior:get_key(IOR), 323 orber_iiop:request(Key, 'get', [ObjectId], 324 {{'tk_objref', 12, "object"}, 325 [{'tk_string', 0}], 326 []}, 'true', infinity, IOR, Ctx) 327 end. 328 329list_initial_services_remote(Address) -> 330 list_initial_services_remote(Address, []). 331 332list_initial_services_remote([], _Ctx) -> 333 raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}); 334list_initial_services_remote([RemoteModifier| Rest], Ctx) when is_list(RemoteModifier) -> 335 case parse_remote_modifier(RemoteModifier) of 336 {error, _} -> 337 resolve_initial_references_remote(Rest, Ctx); 338 {ok, Host, Port} -> 339 IOR = iop_ior:create_external(orber:giop_version(), "", 340 Host, list_to_integer(Port), "INIT"), 341 %% We know it's an external referens. Hence, no need to check. 342 {_, Key} = iop_ior:get_key(IOR), 343 orber_iiop:request(Key, 'list', [], 344 {{'tk_sequence', {'tk_string',0},0}, 345 [], []}, 'true', infinity, IOR, Ctx) 346 end; 347list_initial_services_remote(_, _) -> 348 raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). 349 350 351parse_remote_modifier("iiop://" ++ Rest) -> 352 parse_host_version(Rest); 353parse_remote_modifier(_RemoteModifier) -> 354 {error, not_supported}. 355 356parse_host_version("[" ++ Rest) -> 357 parse_ipv6(Rest, []); 358parse_host_version(Rest) -> 359 parse_ipv4_or_dnsname(Rest, []). 360 361 362parse_ipv4_or_dnsname([$: |Rest], Acc) -> 363 {ok, lists:reverse(Acc), Rest}; 364parse_ipv4_or_dnsname([C |Rest], Acc) -> 365 parse_ipv4_or_dnsname(Rest, [C |Acc]). 366 367parse_ipv6("]:" ++ Rest, Acc) -> 368 {ok, lists:reverse(Acc), Rest}; 369parse_ipv6([C |Rest], Acc) -> 370 parse_ipv6(Rest, [C |Acc]). 371 372 373%%----------------------------------------------------------------- 374%% Objectreference convertions 375%%----------------------------------------------------------------- 376object_to_string(Object) -> 377 iop_ior:string_code(Object). 378 379object_to_string(Object, [H|_] = Hosts) when is_list(H) -> 380 iop_ior:string_code(Object, Hosts); 381object_to_string(_Object, _Hosts) -> 382 raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). 383 384object_to_string(Object, [H|_] = Hosts, Port) when is_list(H) andalso 385 is_integer(Port) -> 386 iop_ior:string_code(Object, Hosts, Port); 387object_to_string(_Object, _Hosts, _Port) -> 388 raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). 389 390object_to_string(Object, [H|_] = Hosts, Port, SSLPort) when is_list(H) andalso 391 is_integer(Port) andalso 392 is_integer(SSLPort)-> 393 iop_ior:string_code(Object, Hosts, Port, SSLPort); 394object_to_string(_Object, _Hosts, _Port, _SSLPort) -> 395 raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). 396 397 398string_to_object(IORString) -> 399 string_to_object(IORString, []). 400 401string_to_object(IORString, Ctx) when is_list(Ctx) -> 402 case lists:prefix("IOR", IORString) of 403 true -> 404 {ObjRef, _, _} = iop_ior:string_decode(IORString), 405 ObjRef; 406 _ -> 407 %% CORBA-2.4 allows both IOR and ior prefix. 408 case lists:prefix("ior", IORString) of 409 true -> 410 {ObjRef, _, _} = iop_ior:string_decode(IORString), 411 ObjRef; 412 _ -> 413 Data = orber_cosnaming_utils:select_type(IORString), 414 case orber_cosnaming_utils:lookup(Data, Ctx) of 415 String when is_list(String) -> 416 {Obj, _, _} = iop_ior:string_decode(String), 417 Obj; 418 ObjRef -> 419 ObjRef 420 end 421 end 422 end; 423string_to_object(IORString, Ctx) -> 424 orber:dbg("[~p] corba:string_to_object(~p, ~p);~n" 425 "Failed to supply a context list.", 426 [?LINE, IORString, Ctx], ?DEBUG_LEVEL), 427 raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). 428 429%%------------------------------------------------------------ 430%% 431%% Implementation of NON-standard functions 432%% 433%%------------------------------------------------------------ 434create(Module, TypeID) -> 435 create(Module, TypeID, []). 436 437create(Module, TypeID, Env) -> 438 common_create(Module, TypeID, Env, [], 'start'). 439 440create(Module, TypeID, Env, {Type, RegName}) -> 441 common_create(Module, TypeID, Env, [{regname, {Type, RegName}}], 'start'); 442create(Module, TypeID, Env, Options) -> 443 common_create(Module, TypeID, Env, Options, 'start'). 444 445 446create_link(Module, TypeID) -> 447 create_link(Module, TypeID, []). 448 449create_link(Module, TypeID, Env) -> 450 common_create(Module, TypeID, Env, [], 'start_link'). 451 452create_link(Module, TypeID, Env, {Type, RegName}) -> 453 common_create(Module, TypeID, Env, [{regname, {Type, RegName}}], 'start_link'); 454create_link(Module, TypeID, Env, Options) -> 455 common_create(Module, TypeID, Env, Options, 'start_link'). 456 457 458create_remote(Node, Module, TypeID) -> 459 create_remote(Node, Module, TypeID, []). 460 461create_remote(Node, Module, TypeID, Env) -> 462 common_create_remote(Node, Module, TypeID, Env, [], 'start'). 463 464create_remote(Node, Module, TypeID, Env, {Type, RegName}) -> 465 common_create_remote(Node, Module, TypeID, Env, [{regname, {Type, RegName}}], 'start'); 466create_remote(Node, Module, TypeID, Env, Options) -> 467 common_create_remote(Node, Module, TypeID, Env, Options, 'start'). 468 469 470create_link_remote(Node, Module, TypeID) -> 471 create_link_remote(Node, Module, TypeID, []). 472 473create_link_remote(Node, Module, TypeID, Env) -> 474 common_create_remote(Node, Module, TypeID, Env, [], 'start_link'). 475 476create_link_remote(Node, Module, TypeID, Env, {Type, RegName}) -> 477 common_create_remote(Node, Module, TypeID, Env, [{regname, {Type, RegName}}], 'start_link'); 478create_link_remote(Node, Module, TypeID, Env, Options) -> 479 common_create_remote(Node, Module, TypeID, Env, Options, 'start_link'). 480 481common_create_remote(Node, Module, TypeID, Env, {Type, RegName}, StartMethod) -> 482 common_create_remote(Node, Module, TypeID, Env, [{regname, {Type, RegName}}], StartMethod); 483common_create_remote(Node, Module, TypeID, Env, Options, StartMethod) -> 484 case node_check(Node) of 485 true -> 486 rpc:call(Node, corba, common_create, [Module, TypeID, Env, Options, StartMethod]); 487 _ -> 488 orber:dbg("[~p] corba:common_create_remote(~p);~n" 489 "Node not in current domain.", [?LINE, Node], ?DEBUG_LEVEL), 490 raise(#'OBJ_ADAPTER'{completion_status=?COMPLETED_NO}) 491 end. 492 493node_check(Node) -> 494 lists:member(Node,orber:orber_nodes()). 495 496common_create(Module, _TypeID, Env, Options, StartMethod) when is_list(Options) -> 497 Opt = evaluate_options(Options, #options{}), 498 case Opt#options.regname of 499 [] -> 500 ok; 501 {'local', Atom} when is_atom(Atom) andalso Opt#options.persistent == false -> 502 ok; 503 {'global', _} -> 504 ok; 505 Why -> 506 orber:dbg("[~p] corba:common_create(~p, ~p);~n" 507 "Bad name type or combination(~p).", 508 [?LINE, Module, Options, Why], ?DEBUG_LEVEL), 509 raise(#'BAD_PARAM'{minor=(?ORBER_VMCID bor 1), 510 completion_status=?COMPLETED_NO}) 511 end, 512 case Opt of 513 #options{pseudo = false, passive = false} -> 514 case gen_server:StartMethod(Module, {Opt#options.object_flags, Env}, 515 Opt#options.create_options) of 516 {ok, Pid} -> 517 case catch mk_objkey(Module, Pid, Opt#options.regname, 518 Opt#options.persistent, 519 Opt#options.object_flags) of 520 {'EXCEPTION', E} -> 521 %% This branch is only used if we couldn't register 522 %% our new objectkey due to an internal error in orber. 523 gen_server:call(Pid, stop), 524 raise(E); 525 {'EXIT', _} -> 526 %% This branch takes care of exit values 527 %% which aren't expected (due to bug). 528 gen_server:call(Pid, stop), 529 raise(#'BAD_PARAM'{minor=(?ORBER_VMCID bor 1), 530 completion_status=?COMPLETED_NO}); 531 Objkey when Opt#options.sup_child == true -> 532 {ok, Pid, Objkey}; 533 Objkey -> 534 Objkey 535 end; 536 X -> 537 X 538 end; 539 #options{pseudo = true, passive = false} -> 540 ModuleImpl = list_to_atom(lists:concat([Module, '_impl'])), 541 case ModuleImpl:init(Env) of 542 {ok, State} -> 543 create_subobject_key(mk_pseudo_objkey(Module, ModuleImpl, 544 Opt#options.object_flags), 545 State); 546 {ok, State,_} -> 547 create_subobject_key(mk_pseudo_objkey(Module, ModuleImpl, 548 Opt#options.object_flags), 549 State); 550 Reason -> 551 orber:dbg("[~p] corba:common_create(~p);~n" 552 "'init' function incorrect(~p).", 553 [?LINE, ModuleImpl, Reason], ?DEBUG_LEVEL), 554 raise(#'BAD_PARAM'{minor=(?ORBER_VMCID bor 1), 555 completion_status=?COMPLETED_NO}) 556 end; 557 #options{pseudo = false, passive = true} -> 558 ModuleImpl = list_to_atom(lists:concat([Module, '_impl'])), 559 create_subobject_key(mk_passive_objkey(Module, ModuleImpl, 560 Opt#options.object_flags), 561 ?groupid_to_table(Opt#options.group_id)); 562 What -> 563 orber:dbg("[~p] corba:common_create(~p, ~p);~n" 564 "not a boolean(~p).", 565 [?LINE, Module, Options, What], ?DEBUG_LEVEL), 566 raise(#'BAD_PARAM'{minor=(?ORBER_VMCID bor 1), 567 completion_status=?COMPLETED_NO}) 568 end. 569 570%%---------------------------------------------------------------------- 571%% Function : dispose 572%% Arguments : Object 573%% Returns : 574%% Description: Terminate the object represented by the supplied reference. 575%%---------------------------------------------------------------------- 576dispose(?ORBER_NIL_OBJREF) -> 577 ok; 578dispose(Obj) -> 579 corba_boa:dispose(Obj). 580 581%%---------------------------------------------------------------------- 582%% Function : create_nil_objref 583%% Arguments : - 584%% Returns : A NIL object reference 585%% Description: 586%%---------------------------------------------------------------------- 587create_nil_objref() -> 588 ?ORBER_NIL_OBJREF. 589 590%%---------------------------------------------------------------------- 591%% Function : create_subobject_key 592%% Arguments : A local object reference and an Erlang term(). 593%% Returns : A new instance of the supplied reference with the 594%% sub-object field changed to the given value. 595%% Description: Initially, this field is set to 'undefined' 596%%---------------------------------------------------------------------- 597create_subobject_key(Objkey, B) when is_binary(B) -> 598 iop_ior:set_privfield(Objkey, B); 599create_subobject_key(Objkey, T) -> 600 create_subobject_key(Objkey, term_to_binary(T)). 601 602%%---------------------------------------------------------------------- 603%% Function : get_subobject_key 604%% Arguments : A local object reference 605%% Returns : Erlang term(). 606%% Description: Return the value set by using create_subobject_key/2 607%%---------------------------------------------------------------------- 608get_subobject_key(Objkey) -> 609 iop_ior:get_privfield(Objkey). 610 611%%---------------------------------------------------------------------- 612%% Function : get_pid 613%% Arguments : A local object reference 614%% Returns : If the object is local and is associated with a pid, this 615%% pid is returned. Otherwise, external- or pseudo-object, 616%% an exception is raised. 617%% Description: 618%%---------------------------------------------------------------------- 619get_pid(Objkey) -> 620 case iop_ior:get_key(Objkey) of 621 {'internal', Key, _, _, _} -> 622 orber_objectkeys:get_pid(Key); 623 {'internal_registered', Key, _, _, _} when is_atom(Key) -> 624 case whereis(Key) of 625 undefined -> 626 raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO}); 627 Pid -> 628 Pid 629 end; 630 R -> 631 orber:dbg("[~p] corba:get_pid(~p);~n" 632 "Probably a pseudo- or external object(~p).", 633 [?LINE, Objkey, R], ?DEBUG_LEVEL), 634 raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}) 635 end. 636 637%%---------------------------------------------------------------------- 638%% Function : raise 639%% Arguments : Local exception representation. 640%% Returns : Throws the exception. 641%% Description: 642%%---------------------------------------------------------------------- 643%% To avoid dialyzer warnings due to the use of exit/throw. 644-spec raise(term()) -> no_return(). 645raise(E) -> 646 throw({'EXCEPTION', E}). 647 648%%---------------------------------------------------------------------- 649%% Function : raise_with_state 650%% Arguments : Local exception representation. 651%% Returns : Throws the exception. 652%% Description: 653%%---------------------------------------------------------------------- 654%% To avoid dialyzer warnings due to the use of exit/throw. 655-spec raise_with_state(term(), term()) -> no_return(). 656raise_with_state(E, State) -> 657 throw({reply, {'EXCEPTION', E}, State}). 658 659%%---------------------------------------------------------------------- 660%% Function : reply 661%% Arguments : To - pid 662%% Reply - Erlang term(). 663%% Returns : 664%% Description: Used to reply to the invoker but still be able 665%% to do some more work in the callback module. 666%%---------------------------------------------------------------------- 667reply(To, Reply) -> 668 gen_server:reply(To, Reply). 669 670%%---------------------------------------------------------------------- 671%% Function : print_object 672%% Arguments : An object represented as one of the following: 673%% - local (tuple) 674%% - IOR 675%% - stringified IOR 676%% - corbaloc- or corbaname-schema 677%% IoDevice - the same as the io-module defines. 678%% Returns : 679%% Description: Prints the object's components and profiles. 680%%---------------------------------------------------------------------- 681print_object(Object) -> 682 iop_ior:print(Object). 683print_object(Object, IoDevice) -> 684 iop_ior:print(IoDevice, Object). 685 686%%---------------------------------------------------------------------- 687%% Function : add_alternate_iiop_address 688%% Arguments : Local object (tuple or IOR). 689%% IP - IP-string 690%% Port - integer(). 691%% Returns : A local IOR with a TAG_ALTERNATE_IIOP_ADDRESS component. 692%% Description: 693%%---------------------------------------------------------------------- 694add_alternate_iiop_address(Obj, Host, Port) when is_list(Host) andalso is_integer(Port) -> 695 TC = #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS, 696 component_data = #'ALTERNATE_IIOP_ADDRESS'{ 697 'HostID' = Host, 698 'Port' = Port}}, 699 iop_ior:add_component(Obj, TC); 700add_alternate_iiop_address(_, Host, Port) -> 701 orber:dbg("[~p] corba:add_alternate_iiop_address(~p, ~p);~n" 702 "Incorrect argument(s). Host must be IP-string and Port an integer.", 703 [?LINE, Host, Port], ?DEBUG_LEVEL), 704 raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO}). 705 706 707%%---------------------------------------------------------------------- 708%% Function : add_FTGroup_component 709%% Arguments : Local object (tuple or IOR). 710%% FTDomain - FT Domain. String(). 711%% GroupID - Replicated object group's id. Integer(). (ulonglong) 712%% GroupVer - Object group's version number. Integer(). (ulong) 713%% Returns : A local IOR with one TAG_FT_GROUP component. 714%% Description: 715%%---------------------------------------------------------------------- 716add_FTGroup_component(Obj, FTDomain, GroupID, GroupVer) 717 when is_list(FTDomain) andalso is_integer(GroupID) andalso is_integer(GroupVer) andalso 718 GroupID >= ?ULONGLONGMIN andalso GroupID =< ?ULONGLONGMAX andalso 719 GroupVer >= ?ULONGMIN andalso GroupVer =< ?ULONGMAX -> 720 TC = #'IOP_TaggedComponent'{tag = ?TAG_FT_GROUP, 721 component_data = #'FT_TagFTGroupTaggedComponent'{ 722 version = #'GIOP_Version'{major = 1, minor = 0}, 723 ft_domain_id = FTDomain, 724 object_group_id = GroupID, 725 object_group_ref_version = GroupVer}}, 726 iop_ior:add_component(Obj, TC); 727add_FTGroup_component(_Obj, FTDomain, GroupID, GroupVer) -> 728 orber:dbg("[~p] corba:add_FTGroup_component(~p, ~p, ~p);~n" 729 "Incorrect argument(s).", 730 [?LINE, FTDomain, GroupID, GroupVer], ?DEBUG_LEVEL), 731 raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO}). 732 733 734%%---------------------------------------------------------------------- 735%% Function : add_FTPrimary_component 736%% Arguments : Local object (tuple or IOR). 737%% Returns : A local IOR with one TAG_FT_PRIMARY component. 738%% Description: 739%%---------------------------------------------------------------------- 740add_FTPrimary_component(Obj) -> 741 TC = #'IOP_TaggedComponent'{ 742 tag=?TAG_FT_PRIMARY, 743 component_data=#'FT_TagFTPrimaryTaggedComponent'{primary = true}}, 744 iop_ior:add_component(Obj, TC). 745 746 747%%----------------------------------------------------------------- 748%% Generic functions for accessing the call-back modules (i.e. X_impl.erl). 749%% These functions are invoked by the generated stubs. 750%%----------------------------------------------------------------- 751handle_init(M, {Flags, Env}) -> 752 case M:init(Env) of 753 {ok, State} -> 754 {ok, {#is{flags = Flags}, State}}; 755 {ok,State,Timeout} -> 756 {ok, {#is{flags = Flags}, State}, Timeout}; 757 Other -> 758 %% E.g. ignore | {stop, Reason} 759 Other 760 end. 761 762 763handle_terminate(M, Reason, {_InternalState, State}) -> 764 catch (M:terminate(Reason, State)). 765 766handle_info(M, Info, {InternalState, State}) -> 767 case catch M:handle_info(Info, State) of 768 {noreply,NewState} -> 769 {noreply, {InternalState, NewState}}; 770 {noreply, NewState, Timeout} -> 771 {noreply, {InternalState, NewState}, Timeout}; 772 {stop, Reason, NewState} -> 773 {stop, Reason, {InternalState, NewState}}; 774 {'EXIT', Why} -> 775 handle_exit(InternalState, State, Why, true, 776 {M, handle_info}, [Info, State]) 777 end. 778 779handle_code_change(M, OldVsn, {InternalState, State}, Extra) -> 780 {ok, NewState} = M:code_change(OldVsn, State, Extra), 781 {ok, {InternalState, NewState}}. 782 783 784%% This function handles call Pre- & Post-conditions. 785handle_call(M, F, A, {InternalState, State}, Ctx, This, From, 786 PreData, PostData, Stub) -> 787 CArgs = call_state(A, State, This, From), 788 case catch invoke_precond(PreData, Stub, F, CArgs) of 789 {'EXIT', Why} -> 790 handle_exit(InternalState, State, Why, false, PreData, [Stub, F, CArgs]); 791 {'EXCEPTION', E} -> 792 {reply, {'EXCEPTION', E}, {InternalState, State}}; 793 ok -> 794 Result = handle_call2(M, F, CArgs, InternalState, State, Ctx), 795 case catch invoke_postcond(PostData, Stub, F, CArgs, Result) of 796 {'EXIT', Why} -> 797 handle_exit(InternalState, State, Why, false, PostData, A); 798 {'EXCEPTION', E} -> 799 {reply, {'EXCEPTION', E}, {InternalState, State}}; 800 ok -> 801 Result 802 end 803 end. 804 805 806invoke_precond(false, _, _, _) -> 807 ok; 808invoke_precond({CondM, CondF}, Stub, F, CArgs) -> 809 CondM:CondF(Stub, F, CArgs). 810 811%% We must remove the Internal State before invoking post-cond. 812invoke_postcond(false, _, _, _, _) -> 813 ok; 814invoke_postcond({CondM, CondF}, Stub, F, CArgs, {reply, Reply, {_, NS}}) -> 815 CondM:CondF(Stub, F, CArgs, {reply, Reply, NS}); 816invoke_postcond({CondM, CondF}, Stub, F, CArgs, {reply, Reply, {_, NS}, Timeout}) -> 817 CondM:CondF(Stub, F, CArgs, {reply, Reply, NS, Timeout}); 818invoke_postcond({CondM, CondF}, Stub, F, CArgs, {stop, Reason, Reply, {_, NS}}) -> 819 CondM:CondF(Stub, F, CArgs, {stop, Reason, Reply, NS}); 820invoke_postcond({CondM, CondF}, Stub, F, CArgs, {stop, Reason, {_, NS}}) -> 821 CondM:CondF(Stub, F, CArgs, {stop, Reason, NS}); 822invoke_postcond({CondM, CondF}, Stub, F, CArgs, {noreply,{_, NS}}) -> 823 CondM:CondF(Stub, F, CArgs, {noreply,NS}); 824invoke_postcond({CondM, CondF}, Stub, F, CArgs, {noreply,{_, NS}, Timeout}) -> 825 CondM:CondF(Stub, F, CArgs, {noreply, NS, Timeout}); 826invoke_postcond({CondM, CondF}, Stub, F, CArgs, Result) -> 827 CondM:CondF(Stub, F, CArgs, Result). 828 829 830handle_call(M, F, A, {InternalState, State}, Ctx, This, From) -> 831 handle_call2(M, F, call_state(A, State, This, From), InternalState, State, Ctx). 832 833handle_call2(M, F, A, InternalState, State, []) -> 834 case catch apply(M, F, A) of 835 {reply, Reply, NewState} -> 836 {reply, add_context(Reply), {InternalState, NewState}}; 837 {reply, Reply, NewState, Timeout} -> 838 {reply, add_context(Reply), {InternalState, NewState}, Timeout}; 839 {stop, Reason, Reply, NewState} -> 840 {stop, Reason, add_context(Reply), {InternalState, NewState}}; 841 {stop, Reason, NewState} -> 842 {stop, Reason, {InternalState, NewState}}; 843 {noreply,NewState} -> 844 {noreply,{InternalState, NewState}}; 845 {noreply,NewState,Timeout} -> 846 {noreply,{InternalState, NewState},Timeout}; 847 {'EXIT', Reason} -> 848 handle_exit(InternalState, State, Reason, false, {M, F}, A); 849 {'EXCEPTION', E} -> 850 {reply, add_context({'EXCEPTION', E}), {InternalState, State}}; 851 {Reply, NewState} -> 852 {reply, add_context(Reply), {InternalState, NewState}} 853 end; 854handle_call2(M, F, A, InternalState, State, Ctx) -> 855 %% Set the new Context. 856 put(oe_server_in_context, Ctx), 857 case catch apply(M, F, A) of 858 {reply, Reply, NewState} -> 859 put(oe_server_in_context, undefined), 860 {reply, add_context(Reply), {InternalState, NewState}}; 861 {reply, Reply, NewState, Timeout} -> 862 put(oe_server_in_context, undefined), 863 {reply, add_context(Reply), {InternalState, NewState}, Timeout}; 864 {stop, Reason, Reply, NewState} -> 865 {stop, Reason, add_context(Reply), {InternalState, NewState}}; 866 {stop, Reason, NewState} -> 867 {stop, Reason, {InternalState, NewState}}; 868 {noreply,NewState} -> 869 put(oe_server_in_context, undefined), 870 {noreply, {InternalState, NewState}}; 871 {noreply, {InternalState, NewState}, Timeout} -> 872 put(oe_server_in_context, undefined), 873 {noreply, {InternalState, NewState},Timeout}; 874 {'EXIT', Reason} -> 875 handle_exit(InternalState, State, Reason, false, {M, F}, A); 876 {'EXCEPTION', E} -> 877 put(oe_server_in_context, undefined), 878 {reply, add_context({'EXCEPTION', E}), {InternalState, State}}; 879 {Reply, NewState} -> 880 put(oe_server_in_context, undefined), 881 {reply, add_context(Reply), {InternalState, NewState}} 882 end. 883 884call_state(A, State, false, false) -> 885 [State|A]; 886call_state(A, State, false, From) -> 887 [From, State|A]; 888call_state(A, State, This, false) -> 889 [This, State|A]; 890call_state(A, State, This, From) -> 891 [This, From, State|A]. 892 893cast_state(A, State, false) -> 894 [State|A]; 895cast_state(A, State, This) -> 896 [This, State|A]. 897 898add_context(Reply) -> 899 %% Reset oe_server_out_context 900 case put(oe_server_out_context, undefined) of 901 undefined -> 902 Reply; 903 _OutCtx -> 904 %% The previous value wasn't 'undefined', which means that 905 %% the server supplied a return context. 906 Reply 907 end. 908 909 910%% This function handles call Pre- & Post-conditions. 911handle_cast(M, F, A, {InternalState, State}, Ctx, This, PreData, PostData, Stub) -> 912 CArgs = cast_state(A, State, This), 913 case catch invoke_precond(PreData, Stub, F, CArgs) of 914 {'EXIT', Why} -> 915 handle_exit(InternalState, State, Why, true, PreData, [Stub, F, CArgs]); 916 {'EXCEPTION', _} -> 917 {noreply, {InternalState, State}}; 918 ok -> 919 Result = handle_cast2(M, F, CArgs, InternalState, State, Ctx), 920 case catch invoke_postcond(PostData, Stub, F, CArgs, Result) of 921 {'EXIT', Why} -> 922 handle_exit(InternalState, State, Why, true, PostData, A); 923 {'EXCEPTION', _} -> 924 {noreply, {InternalState, State}}; 925 ok -> 926 Result 927 end 928 end. 929 930 931handle_cast(M, F, A, {InternalState, State}, Ctx, This) -> 932 handle_cast2(M, F, cast_state(A, State, This), InternalState, State, Ctx). 933 934handle_cast2(M, F, A, InternalState, State, []) -> 935 case catch apply(M, F, A) of 936 {noreply, NewState} -> 937 {noreply, {InternalState, NewState}}; 938 {noreply, NewState, Timeout} -> 939 {noreply, {InternalState, NewState}, Timeout}; 940 {stop, Reason, NewState} -> 941 {stop, Reason, {InternalState, NewState}}; 942 {'EXCEPTION', _} -> 943 {noreply, {InternalState, State}}; 944 {'EXIT', Reason} -> 945 handle_exit(InternalState, State, Reason, true, {M, F}, A); 946 NewState -> 947 {noreply, {InternalState, NewState}} 948 end; 949handle_cast2(M, F, A, InternalState, State, Ctx) -> 950 put(oe_server_in_context, Ctx), 951 case catch apply(M, F, A) of 952 {noreply, NewState} -> 953 put(oe_server_in_context, undefined), 954 {noreply, {InternalState, NewState}}; 955 {noreply, NewState, Timeout} -> 956 put(oe_server_in_context, undefined), 957 {noreply, {InternalState, NewState}, Timeout}; 958 {stop, Reason, NewState} -> 959 {stop, Reason, {InternalState, NewState}}; 960 {'EXCEPTION', _} -> 961 put(oe_server_in_context, undefined), 962 {noreply, {InternalState, State}}; 963 {'EXIT', Reason} -> 964 handle_exit(InternalState, State, Reason, true, {M, F}, A); 965 NewState -> 966 put(oe_server_in_context, undefined), 967 {noreply, {InternalState, NewState}} 968 end. 969 970handle_exit(InternalState, State, {undef, [{M, F, _, _}|_]} = Reason, 971 OnewayOp, {M, F}, A) -> 972 case catch check_exports(M:module_info(exports), F) of 973 {'EXIT',{undef,_}} -> 974 %% No such module. 975 orber:dbg("~p.beam doesn't exist.~n" 976 "Check IC compile options (e.g. 'impl') and that the~n" 977 "beam-file is load-able.", 978 [M], ?DEBUG_LEVEL), 979 reply_after_exit(InternalState, State, Reason, OnewayOp, 980 #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 1), 981 completion_status=?COMPLETED_MAYBE}); 982 "" -> 983 orber:dbg("~p:~p/~p doesn't exist.~n" 984 "Check spelling, export-attributes etc", 985 [M, F, length(A)], ?DEBUG_LEVEL), 986 reply_after_exit(InternalState, State, Reason, OnewayOp, 987 #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 2), 988 completion_status=?COMPLETED_MAYBE}); 989 Exports when is_list(Exports) -> 990 orber:dbg("~p:~p/~p doesn't exist.~n" 991 "~p:~p~s do exists.~nCheck export-attributes etc", 992 [M, F, length(A), M, F, Exports], ?DEBUG_LEVEL), 993 reply_after_exit(InternalState, State, Reason, OnewayOp, 994 #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 3), 995 completion_status=?COMPLETED_MAYBE}); 996 _ -> 997 %% Should never happen 998 reply_after_exit(InternalState, State, Reason, OnewayOp, 999 #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 4), 1000 completion_status=?COMPLETED_MAYBE}) 1001 end; 1002handle_exit(InternalState, State, {undef, [{M2, F2, A2, _}|_]} = Reason, 1003 OnewayOp, {M, F}, A) -> 1004 case catch check_exports(M2:module_info(exports), F2) of 1005 {'EXIT',{undef,_}} -> 1006 %% No such module. 1007 orber:dbg("~p.beam doesn't exist.~n" 1008 "~p:~p/~p invoked an operation on the module above.~n" 1009 "Check IC compile options and that the beam-file is load-able.", 1010 [M2, M, F, length(A)], ?DEBUG_LEVEL), 1011 reply_after_exit(InternalState, State, Reason, OnewayOp, 1012 #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 5), 1013 completion_status=?COMPLETED_MAYBE}); 1014 "" -> 1015 orber:dbg("~p:~p/~p doesn't exist.~n" 1016 "~p:~p/~p invoked the operation above~n" 1017 "Check spelling, export-attributes etc", 1018 [M2, F2, length(A2), M, F, length(A)], ?DEBUG_LEVEL), 1019 reply_after_exit(InternalState, State, Reason, OnewayOp, 1020 #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 6), 1021 completion_status=?COMPLETED_MAYBE}); 1022 Exports when is_list(Exports) -> 1023 orber:dbg("~p:~p/~p doesn't exist.~n" 1024 "~p:~p~s do exist(s).~nCheck export-attributes etc~n" 1025 "~p:~p/~p invoked the operation above~n", 1026 [M2, F2, length(A2), M2, F2, Exports, M, F, length(A)], ?DEBUG_LEVEL), 1027 reply_after_exit(InternalState, State, Reason, OnewayOp, 1028 #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 7), 1029 completion_status=?COMPLETED_MAYBE}); 1030 _ -> 1031 %% Should never happen 1032 reply_after_exit(InternalState, State, Reason, OnewayOp, 1033 #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 4), 1034 completion_status=?COMPLETED_MAYBE}) 1035 end; 1036%% Misc errors. We separate between direct and in-direct errors. Due to different 1037%% notation we must separate between different cases. 1038handle_exit(InternalState, State, {{case_clause,_}, [{M, F, _}|_]} = Reason, 1039 OnewayOp, {M, F}, A) -> 1040 orber:dbg("~p:~p/~p contains a 'case_clause' error.", 1041 [M, F, length(A)], ?DEBUG_LEVEL), 1042 reply_after_exit(InternalState, State, Reason, OnewayOp, 1043 #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 8), 1044 completion_status=?COMPLETED_MAYBE}); 1045handle_exit(InternalState, State, {Reason, [{M, F, _}|_]}, OnewayOp, {M, F}, A) -> 1046 orber:dbg("~p:~p/~p contains a '~p' error.", 1047 [M, F, length(A), Reason], ?DEBUG_LEVEL), 1048 reply_after_exit(InternalState, State, Reason, OnewayOp, 1049 #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 8), 1050 completion_status=?COMPLETED_MAYBE}); 1051handle_exit(InternalState, State, {function_clause, [{M2, F2, A2}|_]} = Reason, 1052 OnewayOp, {M, F}, A) -> 1053 orber:dbg("~p:~p/~p contains a 'function_clause' error.~n" 1054 "Invoked via the operation:~n" 1055 "~p:~p/~p", 1056 [M2, F2, length(A2), M, F, length(A)], ?DEBUG_LEVEL), 1057 reply_after_exit(InternalState, State, Reason, OnewayOp, 1058 #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 9), 1059 completion_status=?COMPLETED_MAYBE}); 1060handle_exit(InternalState, State, {{case_clause,_}, [{M2, F2, A2}|_]} = Reason, 1061 OnewayOp, {M, F}, A) -> 1062 orber:dbg("~p:~p/~p contains a 'case_clause' error.~n" 1063 "Invoked via the operation:~n" 1064 "~p:~p/~p", 1065 [M2, F2, A2, M, F, length(A)], ?DEBUG_LEVEL), 1066 reply_after_exit(InternalState, State, Reason, OnewayOp, 1067 #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 9), 1068 completion_status=?COMPLETED_MAYBE}); 1069handle_exit(InternalState, State, {Reason, [{M2, F2, A2}|_]} = Reason, 1070 OnewayOp, {M, F}, A) -> 1071 orber:dbg("~p:~p/~p contains a '~p' error.~n" 1072 "Invoked via the operation:~n" 1073 "~p:~p/~p", 1074 [M2, F2, A2, Reason, M, F, length(A)], ?DEBUG_LEVEL), 1075 reply_after_exit(InternalState, State, Reason, OnewayOp, 1076 #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 9), 1077 completion_status=?COMPLETED_MAYBE}); 1078handle_exit(InternalState, State, Reason, OnewayOp, {M, F}, A) -> 1079 orber:dbg("~p:~p(~p) ->~n" 1080 " {EXIT, ~p}~n", 1081 [M, F, A, Reason], ?DEBUG_LEVEL), 1082 reply_after_exit(InternalState, State, Reason, OnewayOp, 1083 #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 10), 1084 completion_status=?COMPLETED_MAYBE}). 1085 1086 1087reply_after_exit(#is{flags = Flags} = InternalState, State, 1088 Reason, OnewayOp, Exc) -> 1089 case ?ORB_FLAG_TEST(Flags, ?ORB_SURVIVE_EXIT) of 1090 false -> 1091 exit(Reason); 1092 true when OnewayOp == false -> 1093 put(oe_server_in_context, undefined), 1094 {reply, {'EXCEPTION', Exc}, {InternalState, State}}; 1095 true -> 1096 %% One-way operation. Cannot return exception. 1097 put(oe_server_in_context, undefined), 1098 {noreply, {InternalState, State}} 1099 end. 1100 1101 1102check_exports(Exports, Op) -> 1103 check_exports(Exports, Op, []). 1104 1105check_exports([], _, Acc) -> 1106 Acc; 1107check_exports([{Op, Arity}|Rest], Op, Acc) -> 1108 check_exports(Rest, Op, Acc ++ "/" ++ integer_to_list(Arity)); 1109check_exports([_|Rest], Op, Acc) -> 1110 check_exports(Rest, Op, Acc). 1111 1112 1113%%----------------------------------------------------------------- 1114%% Corba:call - the function for reqests 1115%%----------------------------------------------------------------- 1116call(Obj, Func, Args, TypesOrMod) -> 1117 call_helper(Obj, Func, Args, TypesOrMod, infinity, []). 1118 1119call(Obj, Func, Args, TypesOrMod, [{context, Ctx}]) -> 1120 call_helper(Obj, Func, Args, TypesOrMod, infinity, Ctx); 1121call(Obj, Func, Args, TypesOrMod, [{timeout, Timeout}]) -> 1122 call_helper(Obj, Func, Args, TypesOrMod, Timeout, []); 1123call(Obj, Func, Args, TypesOrMod, Extra) when is_list(Extra) -> 1124 ExtraData = extract_extra_data(Extra, #extra{}), 1125 call_helper(Obj, Func, Args, TypesOrMod, ExtraData#extra.timeout, 1126 ExtraData#extra.context); 1127call(Obj, Func, Args, TypesOrMod, Timeout) -> 1128 call_helper(Obj, Func, Args, TypesOrMod, Timeout, []). 1129 1130call_helper(Obj, Func, Args, TypesOrMod, Timeout, InCtx) -> 1131 Ctx = get_implicit_context(InCtx), 1132 case iop_ior:get_key(Obj) of 1133 {'internal', Key, _, Flags, Mod} -> 1134 Pid = orber_objectkeys:get_pid(Key), 1135 call_internal(Pid, Obj, Func, Args, TypesOrMod, 1136 ?ORB_FLAG_TEST(Flags, ?ORB_TYPECHECK), 1137 ?ORB_FLAG_TEST(Flags, ?ORB_USE_PI), Mod, Timeout, Ctx); 1138 {'internal_registered', Key, _, Flags, Mod} -> 1139 call_internal(Key, Obj, Func, Args, TypesOrMod, 1140 ?ORB_FLAG_TEST(Flags, ?ORB_TYPECHECK), 1141 ?ORB_FLAG_TEST(Flags, ?ORB_USE_PI), Mod, Timeout, Ctx); 1142 {'external', Key} when is_atom(TypesOrMod) -> 1143 case catch TypesOrMod:oe_tc(Func) of 1144 {'EXIT', What} -> 1145 orber:dbg("[~p] corba:call_helper(~p);~n" 1146 "The call-back module does not exist or" 1147 " incorrect IC-version used.~nReason: ~p", 1148 [?LINE, TypesOrMod, What], ?DEBUG_LEVEL), 1149 raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7), 1150 completion_status=?COMPLETED_NO}); 1151 undefined -> 1152 raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4), 1153 completion_status=?COMPLETED_NO}); 1154 Types -> 1155 orber_iiop:request(Key, Func, Args, Types, 'true', Timeout, Obj, Ctx) 1156 end; 1157 {'external', Key} -> 1158 orber_iiop:request(Key, Func, Args, TypesOrMod, 'true', Timeout, Obj, Ctx) 1159 end. 1160 1161get_implicit_context([]) -> 1162 case get(oe_server_in_context) of 1163 undefined -> 1164 []; 1165 ImplCtx -> 1166 ImplCtx 1167 end; 1168get_implicit_context(Ctx) -> 1169 case get(oe_server_in_context) of 1170 undefined -> 1171 Ctx; 1172 ImplCtx -> 1173 %% Both defined. An explicit interface context overrides 1174 %% an implicit. 1175 case check_for_interface_ctx(Ctx) of 1176 false -> 1177 ImplCtx; 1178 true -> 1179 remove_interface_ctx(ImplCtx, Ctx) 1180 end 1181 end. 1182 1183check_for_interface_ctx([]) -> 1184 false; 1185check_for_interface_ctx([#'IOP_ServiceContext' 1186 {context_id=?ORBER_GENERIC_CTX_ID, 1187 context_data = {interface, _I}}|_]) -> 1188 true; 1189check_for_interface_ctx([_|T]) -> 1190 check_for_interface_ctx(T). 1191 1192remove_interface_ctx([], Acc) -> 1193 Acc; 1194remove_interface_ctx([#'IOP_ServiceContext' 1195 {context_id=?ORBER_GENERIC_CTX_ID, 1196 context_data = {interface, _I}}|T], Acc) -> 1197 remove_interface_ctx(T, Acc); 1198remove_interface_ctx([H|T], Acc) -> 1199 remove_interface_ctx(T, [H|Acc]). 1200 1201 1202extract_extra_data([], ED) -> 1203 ED; 1204extract_extra_data([{context, Ctx}|T], ED) -> 1205 extract_extra_data(T, ED#extra{context = Ctx}); 1206extract_extra_data([{timeout, Timeout}|T], ED) -> 1207 extract_extra_data(T, ED#extra{timeout = Timeout}). 1208 1209call_internal(Pid, Obj, Func, Args, Types, Check, PI, Mod, Timeout, Ctx) 1210 when is_pid(Pid) andalso node(Pid) == node() -> 1211 invoke_pi_request(PI, Obj, Ctx, Func, Args), 1212 typecheck_request(Check, Args, Types, Func), 1213 case catch gen_server:call(Pid, {Obj, Ctx, Func, Args}, Timeout) of 1214 {'EXCEPTION', E} -> 1215 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}), 1216 typecheck_reply(Check, {'EXCEPTION', E}, Mod, Func), 1217 raise(E); 1218 {'EXIT',{timeout, _}} -> 1219 Exc = #'TIMEOUT'{completion_status=?COMPLETED_MAYBE}, 1220 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}), 1221 raise(Exc); 1222 {'EXIT',R} -> 1223 orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~ncall exit(~p).", 1224 [?LINE, Func, Args, Types, R], ?DEBUG_LEVEL), 1225 Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 4), 1226 completion_status=?COMPLETED_NO}, 1227 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}), 1228 raise(Exc); 1229 Res -> 1230 invoke_pi_reply(PI, Obj, Ctx, Func, Res), 1231 typecheck_reply(Check, Res, Types, Func), 1232 Res 1233 end; 1234call_internal(Pid, Obj, Func, Args, Types, Check, PI, 1235 _Mod, Timeout, Ctx) when is_pid(Pid) -> 1236 typecheck_request(Check, Args, Types, Func), 1237 case catch rpc:call(node(Pid), corba, call_relay, 1238 [Pid, {Obj, Ctx, Func, Args}, Timeout]) of 1239 {'EXCEPTION', E} -> 1240 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}), 1241 typecheck_reply(Check, {'EXCEPTION', E}, Types, Func), 1242 raise(E); 1243 {badrpc, {'EXIT',R}} -> 1244 orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~ncall exit(~p).", 1245 [?LINE, Func, Args, Types, R], ?DEBUG_LEVEL), 1246 Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 3), 1247 completion_status=?COMPLETED_MAYBE}, 1248 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}), 1249 raise(Exc); 1250 {badrpc,nodedown} -> 1251 orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~nNode ~p down.", 1252 [?LINE, Func, Args, Types, node(Pid)], ?DEBUG_LEVEL), 1253 Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 2), 1254 completion_status=?COMPLETED_NO}, 1255 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}), 1256 raise(Exc); 1257 {badrpc, Reason} -> 1258 orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~n" 1259 "Unable to invoke operation due to: ~p", 1260 [?LINE, Func, Args, Types, Reason], ?DEBUG_LEVEL), 1261 Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 5), 1262 completion_status=?COMPLETED_MAYBE}, 1263 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}), 1264 raise(Exc); 1265 Res -> 1266 invoke_pi_reply(PI, Obj, Ctx, Func, Res), 1267 typecheck_reply(Check, Res, Types, Func), 1268 Res 1269 end; 1270 1271%% This case handles if the reference is created as a Pseudo object. 1272%% Just call apply/3. 1273call_internal({pseudo, Module}, Obj, Func, Args, Types, Check, PI, 1274 _Mod, _Timeout, Ctx) -> 1275 OldCtx = put(oe_server_in_context, Ctx), 1276 invoke_pi_request(PI, Obj, Ctx, Func, Args), 1277 typecheck_request(Check, Args, Types, Func), 1278 State = binary_to_term(get_subobject_key(Obj)), 1279 case catch apply(Module, Func, [Obj, State|Args]) of 1280 {noreply, _} -> 1281 put(oe_server_in_context, OldCtx), 1282 ok; 1283 {noreply, _, _} -> 1284 put(oe_server_in_context, OldCtx), 1285 ok; 1286 {reply, Reply, _} -> 1287 put(oe_server_in_context, OldCtx), 1288 invoke_pi_reply(PI, Obj, Ctx, Func, Reply), 1289 typecheck_reply(Check, Reply, Types, Func), 1290 Reply; 1291 {reply, Reply, _, _} -> 1292 put(oe_server_in_context, OldCtx), 1293 invoke_pi_reply(PI, Obj, Ctx, Func, Reply), 1294 typecheck_reply(Check, Reply, Types, Func), 1295 Reply; 1296 {stop, _, Reply, _} -> 1297 put(oe_server_in_context, OldCtx), 1298 invoke_pi_reply(PI, Obj, Ctx, Func, Reply), 1299 typecheck_reply(Check, Reply, Types, Func), 1300 Reply; 1301 {stop, _, _} -> 1302 put(oe_server_in_context, OldCtx), 1303 ok; 1304 {'EXCEPTION', E} -> 1305 put(oe_server_in_context, OldCtx), 1306 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}), 1307 typecheck_reply(Check, {'EXCEPTION', E}, Types, Func), 1308 raise(E); 1309 {'EXIT', What} -> 1310 put(oe_server_in_context, OldCtx), 1311 orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~n" 1312 "Pseudo object exit(~p).", 1313 [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL), 1314 Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 4), 1315 completion_status=?COMPLETED_MAYBE}, 1316 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}), 1317 raise(Exc); 1318 Unknown -> 1319 put(oe_server_in_context, OldCtx), 1320 orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~n" 1321 "Pseudo object failed due to bad return value (~p).", 1322 [?LINE, Func, Args, Types, Unknown], ?DEBUG_LEVEL), 1323 Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 6), 1324 completion_status=?COMPLETED_MAYBE}, 1325 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}), 1326 raise(Exc) 1327 end; 1328call_internal({passive, Module}, Obj, Func, Args, Types, Check, PI, 1329 Mod, Timeout, Ctx) -> 1330 invoke_pi_request(PI, Obj, Ctx, Func, Args), 1331 typecheck_request(Check, Args, Types, Func), 1332 GroupID = binary_to_term(get_subobject_key(Obj)), 1333 Transaction = 1334 fun() -> 1335 ObjectGroup = read_object_group(GroupID), 1336 call_primary_protected(ObjectGroup, Module, Obj, 1337 Func, Args, GroupID, 1338 get_FTRequestCtx(Ctx)) 1339 end, 1340 case mnesia:transaction(Transaction) of 1341 {atomic, Reply} -> 1342 %% this check should be inside transaction so that 1343 %% failing typecheck_reply would result in transaction 1344 %% abortion. Or not. call_internal(Registered...) does not 1345 %% cancel the state transition even if the result isn't type compliant. 1346 %% So, we do likewise. 1347 typecheck_reply(Check, Reply, Mod, Func), 1348 Reply; 1349 {aborted, {not_primary, Primary, _}} -> 1350 FTRequestCtx = mk_FTRequestCtx(10000000), 1351 case rpc:call(Primary, corba, call_internal, 1352 [{passive, Module}, Obj, Func, Args, 1353 Types, Check, PI, Mod, Timeout, 1354 [FTRequestCtx|Ctx]]) of 1355 {badrpc, Reason} -> 1356 orber:dbg("[~p] corba:call_passive(~p, ~p, ~p); ~n" 1357 " badrpc(~p).", 1358 [?LINE, Func, Args, Types, Reason],?DEBUG_LEVEL), 1359 raise(#'TRANSIENT'{minor=0, 1360 completion_status=?COMPLETED_MAYBE}); 1361 %% one should keep trying request_duration_policy_value -time. 1362 {'EXCEPTION', E} -> 1363 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}), 1364 raise(E); 1365 Reply -> 1366 %% is this typecheck_reply neccessary? The check is made 1367 %% on the remote node... 1368 invoke_pi_reply(PI, Obj, Ctx, Func, Reply), 1369 typecheck_reply(Check, Reply, Mod, Func), 1370 Reply 1371 %% generate RetentionID's and call Primary node with flag that tells 1372 %% the node not to escalate rpc call's to next node if the primary 1373 %% has changed again. 1374 %% raise({not_primary, Primary}); 1375 end; 1376 {aborted, {throw, {'EXCEPTION', E}}} -> 1377 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}), 1378 typecheck_reply(Check, {'EXCEPTION', E}, Mod, Func), 1379 raise(E); 1380 {aborted, {'EXIT', What}} -> 1381 orber:dbg("[~p] corba:call_passive(~p, ~p, ~p); " ++ 1382 "Passive object exit(~p).", 1383 [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL), 1384 Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 4), 1385 completion_status=?COMPLETED_MAYBE}, 1386 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}), 1387 raise(Exc); 1388 {aborted, Unknown} -> 1389 orber:dbg("[~p] corba:call_passive(~p, ~p, ~p); " ++ 1390 "Passive object failed due to bad return value (~p).", 1391 [?LINE, Func, Args, Types, Unknown], ?DEBUG_LEVEL), 1392 Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 6), 1393 completion_status=?COMPLETED_MAYBE}, 1394 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}), 1395 raise(Exc) 1396 end; 1397call_internal(Registered, Obj, Func, Args, Types, Check, PI, 1398 _Mod, Timeout, Ctx) when is_atom(Registered)-> 1399 invoke_pi_request(PI, Obj, Ctx, Func, Args), 1400 typecheck_request(Check, Args, Types, Func), 1401 case whereis(Registered) of 1402 undefined -> 1403 Exc = #'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO}, 1404 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}), 1405 raise(Exc); 1406 P -> 1407 case catch gen_server:call(P, {Obj, Ctx, Func, Args}, Timeout) of 1408 {'EXCEPTION', E} -> 1409 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}), 1410 typecheck_reply(Check, {'EXCEPTION', E}, Types, Func), 1411 raise(E); 1412 {'EXIT',{timeout, _}} -> 1413 Exc = #'TIMEOUT'{completion_status=?COMPLETED_MAYBE}, 1414 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}), 1415 raise(Exc); 1416 {'EXIT',R} -> 1417 orber:dbg("[~p] corba:call_internal(~p, ~p, ~p).~n" 1418 "call exit(~p).", 1419 [?LINE, Func, Args, Types, R], ?DEBUG_LEVEL), 1420 Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 5), 1421 completion_status=?COMPLETED_MAYBE}, 1422 invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}), 1423 raise(Exc); 1424 Res -> 1425 invoke_pi_reply(PI, Obj, Ctx, Func, Res), 1426 typecheck_reply(Check, Res, Types, Func), 1427 Res 1428 end 1429 end. 1430 1431invoke_pi_request(false, _Obj, _Ctx, _Func, _Args) -> 1432 ok; 1433invoke_pi_request(_, Obj, Ctx, Func, Args) -> 1434 case orber:get_cached_interceptors() of 1435 {native, PIs} -> 1436 orber_pi:out_request(PIs, Obj, Ctx, Func, "localhost", Args); 1437 _ -> 1438 ok 1439 end. 1440 1441invoke_pi_reply(false, _Obj, _Ctx, _Func, _Res) -> 1442 ok; 1443invoke_pi_reply(_, Obj, Ctx, Func, Res) -> 1444 case orber:get_cached_interceptors() of 1445 {native, PIs} -> 1446 orber_pi:in_reply(PIs, Obj, Ctx, Func, "localhost", Res); 1447 _ -> 1448 ok 1449 end. 1450 1451typecheck_request(false, _, _, _) -> 1452 ok; 1453typecheck_request(true, Args, Mod, Func) when is_atom(Mod) -> 1454 case catch Mod:oe_tc(Func) of 1455 undefined -> 1456 raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4), 1457 completion_status=?COMPLETED_NO}); 1458 {'EXIT', What} -> 1459 orber:dbg("[~p] corba:typecheck_request(~p, ~p, ~p);~n" 1460 "The call-back module does not exist or incorrect" 1461 "IC-version used.~nReason: ~p", 1462 [?LINE, Mod, Func, Args, What], ?DEBUG_LEVEL), 1463 raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7), 1464 completion_status=?COMPLETED_NO}); 1465 Types -> 1466 typecheck_request_helper(Types, Args, Mod, Func) 1467 end; 1468typecheck_request(true, Args, Types, Func) -> 1469 typecheck_request_helper(Types, Args, Types, Func). 1470 1471typecheck_request_helper(Types, Args, Mod, Func) -> 1472 case catch cdr_encode:validate_request_body( 1473 #giop_env{version = {1,2}, tc = Types, parameters = Args, 1474 host = orber:host(), iiop_port = orber:iiop_port(), 1475 iiop_ssl_port = orber:iiop_ssl_port(), 1476 domain = orber:domain(), 1477 partial_security = orber:partial_security(), 1478 flags = orber:get_flags()}) of 1479 {'EXCEPTION', E} -> 1480 {_, TC, _} = Types, 1481 error_logger:error_msg("========= Orber Typecheck Request =========~n" 1482 "Invoked......: ~p:~p/~p~n" 1483 "Typecode.....: ~p~n" 1484 "Arguments....: ~p~n" 1485 "Result.......: ~p~n" 1486 "===========================================~n", 1487 [Mod, Func, length(TC), TC, Args, {'EXCEPTION', E}]), 1488 raise(E); 1489 {'EXIT',R} -> 1490 {_, TC, _} = Types, 1491 error_logger:error_msg("========= Orber Typecheck Request =========~n" 1492 "Invoked......: ~p:~p/~p~n" 1493 "Typecode.....: ~p~n" 1494 "Arguments....: ~p~n" 1495 "Result.......: ~p~n" 1496 "===========================================~n", 1497 [Mod, Func, length(TC), TC, Args, {'EXIT',R}]), 1498 raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}); 1499 _ -> 1500 ok 1501 end. 1502 1503typecheck_reply(true, Args, Mod, Func) when is_atom(Mod) -> 1504 case catch Mod:oe_tc(Func) of 1505 undefined -> 1506 raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4), 1507 completion_status=?COMPLETED_NO}); 1508 {'EXIT', What} -> 1509 orber:dbg("[~p] corba:typecheck_reply(~p, ~p, ~p);~n" 1510 "The call-back module does not exist or incorrect" 1511 " IC-version used.~nReason: ~p", 1512 [?LINE, Mod, Func, Args, What], ?DEBUG_LEVEL), 1513 raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7), 1514 completion_status=?COMPLETED_NO}); 1515 Types -> 1516 typecheck_reply_helper(Types, Args, Mod, Func) 1517 end; 1518typecheck_reply(true, Args, Types, Func) -> 1519 typecheck_reply_helper(Types, Args, Types, Func); 1520typecheck_reply(_, _, _, _) -> 1521 ok. 1522 1523typecheck_reply_helper(Types, Args, Mod, Func) -> 1524 case catch cdr_encode:validate_reply_body( 1525 #giop_env{version = {1,2}, tc = Types, 1526 host = orber:host(), iiop_port = orber:iiop_port(), 1527 iiop_ssl_port = orber:iiop_ssl_port(), 1528 domain = orber:domain(), 1529 partial_security = orber:partial_security(), 1530 flags = orber:get_flags()}, Args) of 1531 {'tk_except', ExcType, ExcTC, {'EXCEPTION', E}} -> 1532 {_, TC, _} = Types, 1533 error_logger:error_msg("========== Orber Typecheck Reply ==========~n" 1534 "Invoked........: ~p:~p/~p~n" 1535 "Exception Type.: ~p~n" 1536 "Typecode.......: ~p~n" 1537 "Raised.........: ~p~n" 1538 "Result.........: ~p~n" 1539 "===========================================~n", 1540 [Mod, Func, length(TC), ExcType, ExcTC, Args, {'EXCEPTION', E}]), 1541 raise(E); 1542 {'EXCEPTION', E} -> 1543 {RetType, TC, OutParams} = Types, 1544 error_logger:error_msg("========== Orber Typecheck Reply ==========~n" 1545 "Invoked......: ~p:~p/~p~n" 1546 "Typecode.....: ~p~n" 1547 "Reply........: ~p~n" 1548 "Result.......: ~p~n" 1549 "===========================================~n", 1550 [Mod, Func, length(TC), [RetType | OutParams], Args, {'EXCEPTION', E}]), 1551 raise(E); 1552 {'tk_except', ExcType, ExcTC, {'EXIT',R}} -> 1553 {_, TC, _} = Types, 1554 error_logger:error_msg("========== Orber Typecheck Reply ==========~n" 1555 "Invoked........: ~p:~p/~p~n" 1556 "Exception Type.: ~p~n" 1557 "Typecode.......: ~p~n" 1558 "Raised.........: ~p~n" 1559 "Result.........: ~p~n" 1560 "===========================================~n", 1561 [Mod, Func, length(TC), ExcType, ExcTC, Args, {'EXIT',R}]), 1562 raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}); 1563 {'EXIT',R} -> 1564 {RetType, TC, OutParams} = Types, 1565 error_logger:error_msg("========== Orber Typecheck Reply ==========~n" 1566 "Invoked........: ~p:~p/~p~n" 1567 "Typecode.......: ~p~n" 1568 "Reply..........: ~p~n" 1569 "Result.........: ~p~n" 1570 "===========================================~n", 1571 [Mod, Func, length(TC), [RetType | OutParams], Args, {'EXIT',R}]), 1572 raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}); 1573 _ -> 1574 ok 1575 end. 1576 1577call_relay(Pid, Data, Timeout) -> 1578 case whereis(orber_objkeyserver) of 1579 undefined -> 1580 raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_MAYBE}); 1581 _ -> 1582 case catch gen_server:call(Pid, Data, Timeout) of 1583 {'EXCEPTION', E} -> 1584 raise(E); 1585 {'EXIT',{timeout, _}} -> 1586 raise(#'TIMEOUT'{completion_status=?COMPLETED_MAYBE}); 1587 {'EXIT',R} -> 1588 orber:dbg("[~p] corba:call_internal(~p);~n" 1589 "call exit(~p).", [?LINE, Data, R], ?DEBUG_LEVEL), 1590 exit(R); 1591 Res -> 1592 Res 1593 end 1594 end. 1595 1596%%----------------------------------------------------------------- 1597%% Corba:cast - the function for ONEWAY requests 1598%%----------------------------------------------------------------- 1599cast(Obj, Func, Args, TypesOrMod) -> 1600 cast_helper(Obj, Func, Args, TypesOrMod, []). 1601 1602cast(Obj, Func, Args, TypesOrMod, [{context, Ctx}]) -> 1603 cast_helper(Obj, Func, Args, TypesOrMod, Ctx). 1604 1605cast_helper(Obj, Func, Args, TypesOrMod, InCtx) -> 1606 Ctx = get_implicit_context(InCtx), 1607 case iop_ior:get_key(Obj) of 1608 {'internal', Key, _, Flags, Mod} -> 1609 Pid = orber_objectkeys:get_pid(Key), 1610 cast_internal(Pid, Obj, Func, Args, TypesOrMod, 1611 ?ORB_FLAG_TEST(Flags, ?ORB_TYPECHECK), 1612 ?ORB_FLAG_TEST(Flags, ?ORB_USE_PI), Mod, Ctx); 1613 {'internal_registered', Key, _, Flags, Mod} -> 1614 cast_internal(Key, Obj, Func, Args, TypesOrMod, 1615 ?ORB_FLAG_TEST(Flags, ?ORB_TYPECHECK), 1616 ?ORB_FLAG_TEST(Flags, ?ORB_USE_PI), Mod, Ctx); 1617 {'external', Key} when is_atom(TypesOrMod) -> 1618 case catch TypesOrMod:oe_tc(Func) of 1619 {'EXIT', What} -> 1620 orber:dbg("[~p] corba:cast_helper(~p);~n" 1621 "The call-back module does not exist or incorrect" 1622 " IC-version used.~nReason: ~p", 1623 [?LINE, TypesOrMod, What], ?DEBUG_LEVEL), 1624 raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7), 1625 completion_status=?COMPLETED_NO}); 1626 undefined -> 1627 raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4), 1628 completion_status=?COMPLETED_NO}); 1629 Types -> 1630 orber_iiop:request(Key, Func, Args, Types, 'false', infinity, 1631 Obj, Ctx) 1632 end; 1633 {'external', Key} -> 1634 orber_iiop:request(Key, Func, Args, TypesOrMod, 'false', infinity, 1635 Obj, Ctx) 1636 end. 1637 1638cast_internal(Pid, Obj, Func, Args, Types, Check, PI, _Mod, Ctx) 1639 when is_pid(Pid) andalso node(Pid) == node() -> 1640 invoke_pi_request(PI, Obj, Ctx, Func, Args), 1641 typecheck_request(Check, Args, Types, Func), 1642 catch gen_server:cast(Pid, {Obj, Ctx, Func, Args}), 1643 ok; 1644cast_internal(Pid, Obj, Func, Args, Types, Check, PI, Mod, Ctx) when is_pid(Pid) -> 1645 invoke_pi_request(PI, Obj, Ctx, Func, Args), 1646 typecheck_request(Check, Args, Types, Func), 1647 case catch rpc:call(node(Pid), corba, cast_relay, [Pid, {Obj, Ctx, Func, Args}]) of 1648 {'EXCEPTION', E} -> 1649 typecheck_reply(Check, {'EXCEPTION', E}, Mod, Func), 1650 raise(E); 1651 {badrpc, {'EXIT', _R}} -> 1652 raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 3), 1653 completion_status=?COMPLETED_MAYBE}); 1654 {badrpc,nodedown} -> 1655 orber:dbg("[~p] corba:cast_internal(~p, ~p, ~p);~nNode ~p down.", 1656 [?LINE, Func, Args, Types, node(Pid)], ?DEBUG_LEVEL), 1657 raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 2), 1658 completion_status=?COMPLETED_NO}); 1659 Other -> 1660 orber:dbg("[~p] corba:cast_internal(~p, ~p, ~p);~n" 1661 "Communication with node: ~p failed with reason: ~p.", 1662 [?LINE, Func, Args, Types, node(Pid), Other], ?DEBUG_LEVEL), 1663 raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 5), 1664 completion_status=?COMPLETED_MAYBE}) 1665 end; 1666 1667%% This case handles if the reference is created as a Pseudo object. 1668%% Just call apply/3. 1669cast_internal({pseudo, Module}, Obj, Func, Args, Types, Check, PI, _Mod, Ctx) -> 1670 OldCtx = put(oe_server_in_context, Ctx), 1671 invoke_pi_request(PI, Obj, Ctx, Func, Args), 1672 typecheck_request(Check, Args, Types, Func), 1673 State = binary_to_term(get_subobject_key(Obj)), 1674 catch apply(Module, Func, [Obj, State|Args]), 1675 put(oe_server_in_context, OldCtx), 1676 ok; 1677cast_internal(Registered, Obj, Func, Args, Types, Check, PI, _Mod, Ctx) -> 1678 invoke_pi_request(PI, Obj, Ctx, Func, Args), 1679 typecheck_request(Check, Args, Types, Func), 1680 case whereis(Registered) of 1681 undefined -> 1682 raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO}); 1683 P -> 1684 gen_server:cast(P, {Obj, Ctx, Func, Args}) 1685 end. 1686 1687cast_relay(Pid, Data) -> 1688 case whereis(orber_objkeyserver) of 1689 undefined -> 1690 raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 1), 1691 completion_status=?COMPLETED_NO}); 1692 _ -> 1693 gen_server:cast(Pid, Data) 1694 end. 1695 1696%%----------------------------------------------------------------- 1697%% Corba:locate - this function is for the moment just used for tests 1698%%----------------------------------------------------------------- 1699locate(Obj) -> 1700 locate(Obj, infinity, []). 1701 1702locate(Obj, Timeout) -> 1703 locate(Obj, Timeout, []). 1704 1705locate(Obj, Timeout, Ctx) -> 1706 case iop_ior:get_key(Obj) of 1707 {'external', Key} -> 1708 orber_iiop:locate(Key, Timeout, Obj, Ctx); 1709 _ -> 1710 orber_objectkeys:check(iop_ior:get_objkey(Obj)) 1711 end. 1712 1713%%----------------------------------------------------------------- 1714%% Incomming request from iiop 1715%%----------------------------------------------------------------- 1716%% Operations which do not allow object invokation. 1717request_from_iiop(Obj, '_is_a', [Args], _, _, _) -> 1718 catch corba_object:is_a(Obj, Args); 1719%% First the OMG specified this operation to be '_not_existent' and then 1720%% changed it to '_non_existent' without suggesting that both must be supported. 1721%% See CORBA2.3.1 page 15-34, Minor revision 2.3.1: October 1999 1722request_from_iiop(Obj, '_not_existent', _, _, _, _) -> 1723 catch corba_object:non_existent(Obj); 1724request_from_iiop(Obj, '_non_existent', _, _, _, _) -> 1725 catch corba_object:non_existent(Obj); 1726request_from_iiop(_, '_FT_HB', _, _, _, _) -> 1727 ok; 1728 1729%% "Ordinary" operations. 1730request_from_iiop({Mod, _, _, _, _, _}, oe_get_interface, 1731 _, _, _, _ServiceCtx) when is_atom(Mod) -> 1732 case catch Mod:oe_get_interface() of 1733 {'EXIT', What} -> 1734 orber:dbg("[~p] corba:request_from_iiop(~p);~n" 1735 "The call-back module does not exist or" 1736 " incorrect IC-version used.~nReason: ~p", 1737 [?LINE, Mod, What], ?DEBUG_LEVEL), 1738 {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 7), 1739 completion_status=?COMPLETED_NO}}; 1740 undefined -> 1741 {'EXCEPTION', #'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4), 1742 completion_status='COMPLETED_NO'}}; 1743 Interface -> 1744 Interface 1745 end; 1746request_from_iiop({_Mod, pseudo, Module, _UserDef, _OrberDef, _Flags} = ObjRef, 1747 Func, Args, Types, ResponseExpected, _ServiceCtx) -> 1748 State = binary_to_term(get_subobject_key(ObjRef)), 1749 case ResponseExpected of 1750 true -> 1751 case catch apply(Module, Func, [ObjRef, State|Args]) of 1752 {noreply, _} -> 1753 ok; 1754 {noreply, _, _} -> 1755 ok; 1756 {reply, Reply, _} -> 1757 Reply; 1758 {reply, Reply, _, _} -> 1759 Reply; 1760 {stop, _, Reply, _} -> 1761 Reply; 1762 {stop, _, _} -> 1763 ok; 1764 {'EXCEPTION', E} -> 1765 {'EXCEPTION', E}; 1766 {'EXIT', {undef, _}} -> 1767 orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n" 1768 "The call-back module does not exist.", 1769 [?LINE, Func, Args, Types], ?DEBUG_LEVEL), 1770 {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 4), 1771 completion_status=?COMPLETED_NO}}; 1772 {'EXIT', What} -> 1773 orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n" 1774 "Pseudo object exit(~p).~n" 1775 "The call-back module probably contain an error.", 1776 [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL), 1777 {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 4), 1778 completion_status=?COMPLETED_MAYBE}}; 1779 Unknown -> 1780 orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n" 1781 "Pseudo object failed(~p);~n" 1782 "Confirm that the return value is correct" 1783 " (e.g. {reply, Reply, State})", 1784 [?LINE, Func, Args, Types, Unknown], ?DEBUG_LEVEL), 1785 {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 6), 1786 completion_status=?COMPLETED_MAYBE}} 1787 end; 1788 false -> 1789 catch apply(Module, Func, [ObjRef, State|Args]), 1790 ok; 1791 true_oneway -> 1792 catch apply(Module, Func, [ObjRef, State|Args]), 1793 ok 1794 end; 1795% FOR PASSIVE REPLICATION! (Response IS expected --- one way semantics doesn't 1796% really mix with intentions to be consistent & fault tolerant.) 1797request_from_iiop({_Mod, passive, Module, _UserDef, _OrberDef, _Flags} = ObjRef, 1798 Func, Args, Types, true, Ctx) -> 1799 GroupID = binary_to_term(get_subobject_key(ObjRef)), 1800 FTGroupVersionCtx = get_FTGroupVersionCtx(Ctx), 1801 Transaction = 1802 fun() -> 1803 ObjectGroup = read_object_group(GroupID), 1804 check_version_context(ObjectGroup, 1805 FTGroupVersionCtx), 1806 call_primary_protected(ObjectGroup, 1807 Module, 1808 ObjRef, 1809 Func, 1810 Args, 1811 GroupID, 1812 get_FTRequestCtx(Ctx)) 1813 end, 1814 case mnesia:transaction(Transaction) of 1815 {atomic, Reply} -> 1816 Reply; 1817 {aborted, {too_old_reference, IOGR}} -> 1818 {oe_location_forward_perm, IOGR}; 1819 {aborted, {not_primary, _Primary, IOGR}} -> 1820 case FTGroupVersionCtx of 1821 [] -> 1822 {oe_location_forward_perm, IOGR}; 1823 _ -> 1824 {'EXCEPTION', #'TRANSIENT'{minor = 0, 1825 completion_status = ?COMPLETED_NO}} 1826 end; 1827 {aborted, {throw, {'EXCEPTION', E}}} -> 1828 {'EXCEPTION', E}; 1829 {aborted, {'EXIT', What}} -> 1830 orber:dbg("[~p] corba:call_passive(~p, ~p, ~p);~n" 1831 "Passive object exit(~p).", 1832 [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL), 1833 {'EXCEPTION', #'TRANSIENT'{minor = 0, 1834 completion_status=?COMPLETED_MAYBE}}; 1835 {aborted, Unknown} -> 1836 orber:dbg("[~p] corba:call_passive(~p, ~p, ~p);~n" 1837 "Passive object failed due to bad return value (~p).", 1838 [?LINE, Func, Args, Types, Unknown], ?DEBUG_LEVEL), 1839 {'EXCEPTION', #'TRANSIENT'{minor = 0, 1840 completion_status=?COMPLETED_MAYBE}} 1841 end; 1842request_from_iiop({_Mod, _Type, Key, _UserDef, _OrberDef, _Flags} = ObjRef, 1843 Func, Args, Types, true, _ServiceCtx) -> 1844 case catch gen_server:call(convert_key_to_pid(Key), 1845 {ObjRef, [], Func, Args}, infinity) of 1846 {'EXIT', What} -> 1847 orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n" 1848 "gen_server:call exit: ~p", 1849 [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL), 1850 {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 4), 1851 completion_status=?COMPLETED_MAYBE}}; 1852 Result -> 1853 Result 1854 end; 1855request_from_iiop({_Mod, _Type, Key, _UserDef, _OrberDef, _Flags} = ObjRef, 1856 Func, Args, Types, _, _ServiceCtx) -> 1857 case catch gen_server:cast(convert_key_to_pid(Key), 1858 {ObjRef, [], Func, Args}) of 1859 {'EXIT', What} -> 1860 orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n" 1861 "gen_server:cast exit: ~p", 1862 [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL), 1863 {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 4), 1864 completion_status=?COMPLETED_MAYBE}}; 1865 Result -> 1866 Result 1867 end. 1868 1869%%------------------------------------------------------------ 1870%% Internal stuff 1871%%------------------------------------------------------------ 1872 1873convert_key_to_pid(Key) when is_binary(Key) -> 1874 orber_objectkeys:get_pid(Key); 1875convert_key_to_pid(Name) when is_atom(Name) -> 1876 Name. 1877 1878mk_objkey(Mod, Pid, RegName, Persistent) -> 1879 mk_objkey(Mod, Pid, RegName, Persistent, 0). 1880 1881mk_objkey(Mod, Pid, [], _, Flags) when is_pid(Pid) -> 1882 Key = make_objkey(), 1883 case orber_objectkeys:register(Key, Pid, false) of 1884 ok -> 1885 {Mod, 'key', Key, term_to_binary(undefined), 0, Flags}; 1886 R -> 1887 orber:dbg("[~p] corba:mk_objkey(~p);~n" 1888 "unable to store key(~p).", [?LINE, Mod, R], ?DEBUG_LEVEL), 1889 raise(#'INTERNAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO}) 1890 end; 1891mk_objkey(Mod, Pid, {'global', RegName}, Persitent, Flags) when is_pid(Pid) -> 1892 Key = term_to_binary(RegName), 1893 case orber_objectkeys:register(Key, Pid, Persitent) of 1894 ok -> 1895 {Mod, 'key', Key, term_to_binary(undefined), 0, Flags}; 1896 R -> 1897 orber:dbg("[~p] corba:mk_objkey(~p, ~p);~n" 1898 "unable to store key(~p).", 1899 [?LINE, Mod, RegName, R], ?DEBUG_LEVEL), 1900 raise(#'INTERNAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO}) 1901 end; 1902mk_objkey(Mod, Pid, {'local', RegName}, Persistent, Flags) when is_pid(Pid) andalso is_atom(RegName) -> 1903 register(RegName, Pid), 1904 Key = make_objkey(), 1905 case orber_objectkeys:register(Key, Pid, Persistent) of 1906 ok -> 1907 {Mod, 'registered', RegName, term_to_binary(undefined), 0, Flags}; 1908 R -> 1909 orber:dbg("[~p] corba:mk_objkey(~p, ~p);~n" 1910 "unable to store key(~p).", 1911 [?LINE, Mod, RegName, R], ?DEBUG_LEVEL), 1912 raise(#'INTERNAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO}) 1913 end. 1914 1915 1916mk_light_objkey(Mod, RegName) -> 1917 {Mod, 'registered', RegName, term_to_binary(undefined), 0, 0}. 1918 1919mk_pseudo_objkey(Mod, Module, Flags) -> 1920 {Mod, 'pseudo', Module, term_to_binary(undefined), 0, Flags}. 1921 1922mk_passive_objkey(Mod, Module, Flags) -> 1923 {Mod, 'passive', Module, term_to_binary(undefined), 0, Flags}. 1924 1925make_objkey() -> 1926 term_to_binary({{erlang:system_time(), 1927 erlang:unique_integer()}, 1928 node()}). 1929 1930objkey_to_string({_Mod, 'registered', 'orber_init', _UserDef, _OrberDef, _Flags}) -> 1931 "INIT"; 1932objkey_to_string({Mod, Type, Key, UserDef, OrberDef, Flags}) -> 1933 orber:domain() ++ [ 7 | binary_to_list(term_to_binary({Mod, Type, Key, UserDef, OrberDef, Flags}))]; 1934objkey_to_string(External_object_key) -> 1935 External_object_key. 1936 1937string_to_objkey("INIT") -> 1938 {orber_initial_references, 'registered', 'orber_init', term_to_binary(undefined), 0, 0}; 1939string_to_objkey(String) -> 1940 case prefix(orber:domain(), String) of 1941 [7 | Rest] -> 1942 binary_to_term(list_to_binary(Rest)); 1943 _ -> 1944 String 1945 end. 1946%% This function may only be used when we know it's a local reference (i.e. target 1947%% key in a request; IOR's passed as argument or reply doesn't qualify)! 1948string_to_objkey_local("INIT") -> 1949 {orber_initial_references, 'registered', 'orber_init', term_to_binary(undefined), 0, 0}; 1950string_to_objkey_local(String) -> 1951 case prefix(orber:domain(), String) of 1952 [7 | Rest] -> 1953 binary_to_term(list_to_binary(Rest)); 1954 _ -> 1955 case resolve_initial_references(String) of 1956 ?ORBER_NIL_OBJREF -> 1957 orber:dbg("[~p] corba:string_to_objkey_local(~p);~n" 1958 "Invalid ObjektKey.", [?LINE, String], ?DEBUG_LEVEL), 1959 ?ORBER_NIL_OBJREF; 1960 Object -> 1961 {location_forward, Object} 1962 end 1963 end. 1964 1965prefix([], L2) -> 1966 L2; 1967prefix([E |L1], [E | L2]) -> 1968 prefix(L1, L2); 1969prefix(_, _) -> 1970 false. 1971 1972 1973evaluate_options([], Options) -> 1974 GlobalFlags = orber:get_flags(), 1975 Options2 = check_flag(Options, ?ORB_TYPECHECK, 1976 ?ORB_ENV_LOCAL_TYPECHECKING, GlobalFlags), 1977 Options3 = check_flag(Options2, ?ORB_USE_PI, ?ORB_ENV_USE_PI, GlobalFlags), 1978 check_flag(Options3, ?ORB_SURVIVE_EXIT, ?ORB_ENV_SURVIVE_EXIT, GlobalFlags); 1979%% Pseudo or not. 1980evaluate_options([{pseudo, false}|Rest], Options) -> 1981 evaluate_options(Rest, Options); 1982evaluate_options([{pseudo, true}|Rest], #options{passive = false} = Options) -> 1983 evaluate_options(Rest, Options#options{pseudo = true}); 1984%% FT stuff 1985evaluate_options([{passive, true}|Rest], #options{pseudo = false} = Options) -> 1986 evaluate_options(Rest, Options#options{passive = true}); 1987evaluate_options([{group_id, ID}|Rest], Options) when is_integer(ID) -> 1988 evaluate_options(Rest, Options#options{group_id = ID}); 1989%% Options accepted by gen_server (e.g. dbg). 1990evaluate_options([{create_options, COpt}|Rest], Options) when is_list(COpt) -> 1991 evaluate_options(Rest, Options#options{create_options = COpt}); 1992%% When starting object as supervisor child. 1993evaluate_options([{sup_child, false}|Rest], Options) -> 1994 evaluate_options(Rest, Options); 1995evaluate_options([{sup_child, true}|Rest], Options) -> 1996 evaluate_options(Rest, Options#options{sup_child = true}); 1997%% Persistent object-key 1998evaluate_options([{persistent, false}|Rest], Options) -> 1999 evaluate_options(Rest, Options); 2000evaluate_options([{persistent, true}|Rest], Options) -> 2001 evaluate_options(Rest, Options#options{persistent = true}); 2002evaluate_options([{regname, []}|Rest], Options) -> 2003 evaluate_options(Rest, Options); 2004evaluate_options([{regname, Name}|Rest], Options) -> 2005 evaluate_options(Rest, Options#options{regname = Name}); 2006evaluate_options([{survive_exit, false}|Rest], 2007 #options{object_flags_set = FlagsSet} = Options) -> 2008 %% This option overrides a global setting. 2009 evaluate_options(Rest, Options#options{object_flags_set = 2010 (?ORB_SURVIVE_EXIT bor FlagsSet)}); 2011evaluate_options([{survive_exit, true}|Rest], 2012 #options{object_flags = Flags, 2013 object_flags_set = FlagsSet} = Options) -> 2014 evaluate_options(Rest, Options#options{object_flags = 2015 (?ORB_SURVIVE_EXIT bor Flags), 2016 object_flags_set = 2017 (?ORB_SURVIVE_EXIT bor FlagsSet)}); 2018evaluate_options([{local_typecheck, false}|Rest], 2019 #options{object_flags_set = FlagsSet} = Options) -> 2020 %% This option overrides a global setting. 2021 evaluate_options(Rest, Options#options{object_flags_set = 2022 (?ORB_TYPECHECK bor FlagsSet)}); 2023evaluate_options([{local_typecheck, true}|Rest], 2024 #options{object_flags = Flags, 2025 object_flags_set = FlagsSet} = Options) -> 2026 evaluate_options(Rest, Options#options{object_flags = (?ORB_TYPECHECK bor Flags), 2027 object_flags_set = 2028 (?ORB_TYPECHECK bor FlagsSet)}); 2029evaluate_options([{local_interceptors, false}|Rest], 2030 #options{object_flags_set = FlagsSet} = Options) -> 2031 %% This option overrides a global setting. 2032 evaluate_options(Rest, Options#options{object_flags_set = 2033 (?ORB_USE_PI bor FlagsSet)}); 2034evaluate_options([{local_interceptors, true}|Rest], 2035 #options{object_flags = Flags, 2036 object_flags_set = FlagsSet} = Options) -> 2037 evaluate_options(Rest, Options#options{object_flags = (?ORB_USE_PI bor Flags), 2038 object_flags_set = 2039 (?ORB_USE_PI bor FlagsSet)}); 2040%% Temporary option. 2041evaluate_options([{no_security, true}|Rest], 2042 #options{object_flags = Flags} = Options) -> 2043 %% We do not allow this option to be set globally. 2044 evaluate_options(Rest, Options#options{object_flags = (?ORB_NO_SECURITY bor Flags)}); 2045evaluate_options([{no_security, false}|Rest], Options) -> 2046 %% We do not allow this option to be set globally. 2047 evaluate_options(Rest, Options); 2048evaluate_options([{Key, Value}|_], _) -> 2049 orber:dbg("[~p] corba:evaluate_options(~p, ~p);~n" 2050 "Option not recognized, illegal value or combination.~n" 2051 "Allowed settings:~n" 2052 "survive_exit.......: boolean()~n" 2053 "sup_child..........: boolean()~n" 2054 "persistent.........: boolean()~n" 2055 "pseudo.............: boolean()~n" 2056 "local_typecheck....: boolean()~n" 2057 "local_interceptors.: boolean()~n" 2058 "regname............: {local, atom()} | {global, term()}", 2059 [?LINE, Key, Value], ?DEBUG_LEVEL), 2060 raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). 2061 2062check_flag(#options{object_flags = Flags, 2063 object_flags_set = FlagsSet} = Options, Flag, 2064 FlagConstant, GlobalFlags) -> 2065 %% Option activated/deactived by a supplied option. 2066 case ?ORB_FLAG_TEST(FlagsSet, Flag) of 2067 true -> 2068 Options; 2069 false -> 2070 %% Not the above. Globally defined? 2071 case ?ORB_FLAG_TEST(GlobalFlags, FlagConstant) of 2072 true -> 2073 Options#options{object_flags = (Flag bor Flags)}; 2074 false -> 2075 Options 2076 end 2077 end. 2078 2079%%%%%%%%%%%%%%%%% FOR PASSIVE REPLICATION! 2080% Note should be called inside transaction. Does not catch exceptions. 2081% let's not allow corba:reply from transaction... (no {noreply, ...} messages) 2082% should the object be able to stop itself by returning {stop, ...}? 2083% how about corba:dispose then? Deleting table representing object group and 2084% corresponding entry in ft_replication_manager -table might just do the job? 2085% No {stop, ...} messages for now 2086% Exceptions falls through. They are expected to be caught by transaction in a 2087% form of {aborted, {throw, {'EXCEPTION', ...}}} 2088call_passive(Module, Obj, Func, Args, GroupID) -> 2089 [Record] = mnesia:read(ft_replicated_object, GroupID, sticky_write), 2090 State = Record#ft_replicated_object.state, 2091 2092 case apply(Module, Func, [Obj, State|Args]) of 2093 {reply, Reply, NewState} -> 2094 {Reply, NewState}; 2095 {reply, Reply, NewState, _} -> 2096 {Reply, NewState} 2097 end, 2098 mnesia:write(ft_replicated_object, 2099 #ft_replicated_object{group_id = GroupID, state = NewState}, 2100 sticky_write), 2101 Reply. 2102 2103 2104 2105% FTRequestCtx protected object call 2106% One should protect agains aged reply. If expirations_time is reached and 2107% request is retransmitted, one might return BAD_CONTEXT -exception! 2108call_RQprotected(Module, Obj, Func, Args, GroupID, RQCtx) -> 2109 case mnesia:read(ft_reply_retention, RQCtx, sticky_write) of 2110 % fresh request 2111 [] -> 2112 Reply = call_passive(Module, Obj, Func, Args, GroupID), 2113 mnesia:write(ft_reply_retention, 2114 #ft_reply_retention{retention_id= RQCtx,reply= Reply}, 2115 sticky_write), 2116 Reply; 2117 % retransmitted request 2118 [#ft_reply_retention{reply = Reply}] -> 2119 Reply 2120 end. 2121 2122 2123 2124% call_primary_protected. Protects agains calling non-primary node. 2125% normal case, without FTRequest Service Context 2126call_primary_protected(#ft_replication_manager{primary = Primary}, 2127 Module, 2128 Obj, 2129 Func, 2130 Args, 2131 GroupID, 2132 []) when Primary == node() -> 2133 call_passive(Module, Obj, Func, Args, GroupID); 2134% normal case, with FTRequest Service Context 2135call_primary_protected(#ft_replication_manager{primary = Primary}, 2136 Module, 2137 Obj, 2138 Func, 2139 Args, 2140 GroupID, 2141 RetentionID) when Primary == node() -> 2142 call_RQprotected(Module, Obj, Func, Args, GroupID, RetentionID); 2143% case where primary resides in another node 2144call_primary_protected(#ft_replication_manager{primary = Primary, 2145 iogr = IOGR}, 2146 _Module, _Obj, _Func, _Args, _GroupID, _) -> 2147 mnesia:abort({not_primary, Primary, IOGR}). 2148 2149 2150 2151% no context 2152check_version_context(_, []) -> 2153 ok; 2154% client's IOGR is current. 2155check_version_context(#ft_replication_manager{ref_version = CurrentVer}, 2156 GroupVer) when CurrentVer == GroupVer -> 2157 ok; 2158% client's IOGR is old. 2159check_version_context(#ft_replication_manager{ref_version = CurrentVer, 2160 iogr = IOGR}, 2161 GroupVer) when CurrentVer > GroupVer -> 2162 mnesia:abort({too_old_reference, IOGR}); 2163% client's IOGR is too new! 2164check_version_context(#ft_replication_manager{ref_version = CurrentVer}, 2165 GroupVer) when CurrentVer < GroupVer -> 2166 raise(#'INV_OBJREF'{completion_status = ?COMPLETED_NO}). 2167 2168 2169 2170read_object_group(GroupID) -> 2171 case mnesia:read({ft_replication_manager, GroupID}) of 2172 [] -> 2173 raise(#'OBJECT_NOT_EXIST'{completion_status = ?COMPLETED_NO}); 2174 [ObjectGroup] -> 2175 ObjectGroup 2176 end. 2177 2178 2179 2180mk_FTRequestCtx(Expiration_time) -> 2181 #'FT_FTRequestServiceContext'{ 2182 client_id = atom_to_list(node()), 2183 retention_id = orber_request_number:get(), 2184 expiration_time = Expiration_time}. 2185 2186 2187 2188get_FTRequestCtx([#'FT_FTRequestServiceContext' 2189 {client_id = Client_ID, retention_id = Retention_ID, 2190 expiration_time = Expiration_time}|_Ctxs]) -> 2191 {Client_ID, Retention_ID, Expiration_time}; 2192get_FTRequestCtx([]) -> 2193 []; 2194get_FTRequestCtx([_Ctx|Ctxs]) -> 2195 get_FTRequestCtx(Ctxs). 2196 2197 2198 2199get_FTGroupVersionCtx([#'FT_FTGroupVersionServiceContext' 2200 {object_group_ref_version = Version}|_Ctxs]) -> 2201 Version; 2202get_FTGroupVersionCtx([]) -> 2203 []; 2204get_FTGroupVersionCtx([_Ctx|Ctxs]) -> 2205 get_FTGroupVersionCtx(Ctxs). 2206 2207