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: cdr_encode.erl 24%% 25%% Description: 26%% This file contains all encoding functions for the CDR 27%% format. 28%% 29%%----------------------------------------------------------------- 30-module(cdr_encode). 31 32-include_lib("orber/include/corba.hrl"). 33-include_lib("orber/src/orber_iiop.hrl"). 34 35%%----------------------------------------------------------------- 36%% External exports 37%%----------------------------------------------------------------- 38-export([enc_giop_msg_type/1, 39 enc_request/1, enc_request_split/1, 40 enc_reply/1, enc_reply_split/1, 41 enc_type/3, enc_type/5, 42 enc_cancel_request/1, 43 enc_locate_request/1, 44 enc_locate_reply/1, 45 enc_close_connection/1, 46 enc_message_error/1, 47 enc_fragment/1, 48 enc_giop_message_header/5, 49 validate_request_body/1, 50 validate_reply_body/2]). 51 52%%----------------------------------------------------------------- 53%% Internal exports 54%%----------------------------------------------------------------- 55-export([]). 56 57%%----------------------------------------------------------------- 58%% Macros 59%%----------------------------------------------------------------- 60-define(DEBUG_LEVEL, 9). 61 62-define(ODD(N), (N rem 2) == 1). 63 64%%----------------------------------------------------------------- 65%% External functions 66%%----------------------------------------------------------------- 67%%----------------------------------------------------------------- 68%% Func: enc_giop_message_header/5 69%%----------------------------------------------------------------- 70%% The header size is known so we know that the size will be aligned. 71%% MessSize already includes the header length. 72%%----------------------------------------------------------------- 73enc_giop_message_header(#giop_env{version = {Major,Minor}}, MessType, 74 _Flags, MessSize, Message) -> 75 Type = enc_giop_msg_type(MessType), 76 %% The Flag handling must be fixed, i.e., it's not correct to only use '0'. 77 %% If IIOP-1.0 a boolean (FALSE == 0), otherwise, IIOP-1.1 or 1.2, 78 %% an octet. The octet bits represents: 79 %% * The least significant the byteorder (0 eq. big-endian) 80 %% * The second least significant indicates if the message is fragmented. 81 %% If set to 0 it's not fragmented. 82 %% * The most significant 6 bits are reserved. Hence, must be set to 0. 83 %% Since we currently don't support fragmented messages and we always 84 %% encode using big-endian it's ok to use '0' for now. 85 list_to_binary([ <<"GIOP",Major:8,Minor:8,0:8, 86 Type:8,MessSize:32/big-unsigned-integer>> | Message]). 87 88enc_byte_order(Env, Message) -> 89 enc_type('tk_boolean', Env, 'false', Message, 0). 90 91%%----------------------------------------------------------------- 92%% Func: enc_parameters/2 93%%----------------------------------------------------------------- 94enc_parameters(_, [], [], Message, Len) -> 95 {Message, Len}; 96enc_parameters(_, [], P, _, _) -> 97 orber:dbg("[~p] cdr_encode:encode_parameters(~p); to many parameters.", 98 [?LINE, P], ?DEBUG_LEVEL), 99 corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 17), completion_status=?COMPLETED_MAYBE}); 100enc_parameters(_, _, [], TC, _) -> 101 orber:dbg("[~p] cdr_encode:encode_parameters(~p); to few parameters.", 102 [?LINE, TC], ?DEBUG_LEVEL), 103 corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 17), completion_status=?COMPLETED_MAYBE}); 104enc_parameters(Env, [PT1 |TypeList], [ P1 | Parameters], Message, Len) -> 105 {Message1, Len1} = enc_type(PT1, Env, P1, Message, Len), 106 enc_parameters(Env, TypeList, Parameters, Message1, Len1). 107 108%%----------------------------------------------------------------- 109%% Func: enc_request/8 110%%----------------------------------------------------------------- 111%% ## NEW IIOP 1.2 ## 112enc_request(#giop_env{version = {1,2}} = Env) -> 113 Flags = 1, %% LTH Not correct, just placeholder 114 {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE), 115 {Message1, Len1} = enc_response_flags(Env, Message, Len), 116 {Message2, Len2} = enc_reserved(Env, {0,0,0}, Message1, Len1), 117 {Message3, Len3} = enc_target_address(Env, Message2, Len2), 118 {Message4, Len4} = enc_operation(Env, Message3, Len3), 119 {Message5, Len5} = enc_service_context(Env, Message4, Len4), 120 {Message6, Len6} = enc_request_body(Env, Message5, Len5), 121 enc_giop_message_header(Env, 'request', Flags, Len6 - ?GIOP_HEADER_SIZE, 122 lists:reverse(Message6)); 123enc_request(#giop_env{version = Version} = Env) -> 124 Flags = 1, %% LTH Not correct, just placeholder 125 {Message0, Len0} = enc_service_context(Env, [], ?GIOP_HEADER_SIZE), 126 {Message, Len} = enc_request_id(Env, Message0, Len0), 127 {Message1, Len1} = enc_response(Env, Message, Len), 128 {Message1b, Len1b} = 129 if 130 Version /= {1,0} -> 131 enc_reserved(Env, {0,0,0}, Message1, Len1); 132 true -> 133 {Message1, Len1} 134 end, 135 {Message2, Len2} = enc_object_key(Env, Message1b, Len1b), 136 {Message3, Len3} = enc_operation(Env, Message2, Len2), 137 {Message4, Len4} = enc_principal(Env, Message3, Len3), 138 {Message5, Len5} = enc_request_body(Env, Message4, Len4), 139 enc_giop_message_header(Env, 'request', Flags, Len5 - ?GIOP_HEADER_SIZE, 140 lists:reverse(Message5)). 141 142%% ## NEW IIOP 1.2 ## 143enc_request_split(#giop_env{version = {1,2}} = Env) -> 144 Flags = 1, %% LTH Not correct, just placeholder 145 {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE), 146 {Message1, Len1} = enc_response_flags(Env, Message, Len), 147 {Message2, Len2} = enc_reserved(Env, {0,0,0}, Message1, Len1), 148 {Message3, Len3} = enc_target_address(Env, Message2, Len2), 149 {Message4, Len4} = enc_operation(Env, Message3, Len3), 150 {Message5, Len5} = enc_service_context(Env, Message4, Len4), 151 {Body, Len6} = enc_request_body(Env, [], Len5), 152 {lists:reverse(Message5), list_to_binary(lists:reverse(Body)), 153 Len5 - ?GIOP_HEADER_SIZE, Len6-Len5, Flags}; 154enc_request_split(#giop_env{version = Version} = Env) -> 155 Flags = 1, %% LTH Not correct, just placeholder 156 {Message0, Len0} = enc_service_context(Env, [], ?GIOP_HEADER_SIZE), 157 {Message, Len} = enc_request_id(Env, Message0, Len0), 158 {Message1, Len1} = enc_response(Env, Message, Len), 159 {Message1b, Len1b} = 160 if 161 Version /= {1,0} -> 162 enc_reserved(Env, {0,0,0}, Message1, Len1); 163 true -> 164 {Message1, Len1} 165 end, 166 {Message2, Len2} = enc_object_key(Env, Message1b, Len1b), 167 {Message3, Len3} = enc_operation(Env, Message2, Len2), 168 {Message4, Len4} = enc_principal(Env, Message3, Len3), 169 {Body, Len5} = enc_request_body(Env, [], Len4), 170 {lists:reverse(Message4), list_to_binary(lists:reverse(Body)), 171 Len4 - ?GIOP_HEADER_SIZE, Len5-Len4, Flags}. 172 173enc_principal(Env, Mess, Len) -> 174 enc_type({'tk_string', 0}, Env, atom_to_list(node()), Mess, Len). 175 176enc_operation(Env, Mess, Len) -> 177 enc_type({'tk_string', 0}, Env, atom_to_list(Env#giop_env.op), Mess, Len). 178 179enc_object_key(Env, Mess, Len) -> 180 enc_type({'tk_sequence', 'tk_octet', 0}, Env, Env#giop_env.objkey, Mess, Len). 181 182enc_reserved(Env, Reserved, Mess, Len) -> 183 enc_type({'tk_array', 'tk_octet', 3}, Env, Reserved, Mess, Len). 184 185enc_response(Env, Mess, Len) -> 186 enc_type('tk_boolean', Env, Env#giop_env.response_expected, Mess, Len). 187 188enc_request_id(Env, Mess, Len) -> 189 enc_type('tk_ulong', Env, Env#giop_env.request_id, Mess, Len). 190 191enc_service_context(Env, Message, Len) -> 192 Ctxs = enc_used_contexts(Env, Env#giop_env.ctx, []), 193 enc_type(?IOP_SERVICECONTEXT, Env, Ctxs, Message, Len). 194 195enc_used_contexts(_Env, [], Message) -> 196 Message; 197enc_used_contexts(#giop_env{version = {1, 0}} = Env, 198 [#'IOP_ServiceContext'{context_id=?IOP_CodeSets}|T], Ctxs) -> 199 %% Not supported by 1.0, drop it. 200 enc_used_contexts(Env, T, Ctxs); 201enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?IOP_CodeSets, 202 context_data = CodeSetCtx}|T], 203 Ctxs) -> 204 %% Encode ByteOrder 205 {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0), 206 {Bytes1, _Len1} = enc_type(?CONV_FRAME_CODESETCONTEXT, Env, CodeSetCtx, 207 Bytes0, Len0), 208 Bytes = list_to_binary(lists:reverse(Bytes1)), 209 enc_used_contexts(Env, T, 210 [#'IOP_ServiceContext'{context_id=?IOP_CodeSets, 211 context_data = Bytes}|Ctxs]); 212enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?IOP_BI_DIR_IIOP, 213 context_data = BiDirCtx}|T], 214 Ctxs) -> 215 %% Encode ByteOrder 216 {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0), 217 {Bytes1, _Len1} = enc_type(?IIOP_BIDIRIIOPSERVICECONTEXT, Env, BiDirCtx, 218 Bytes0, Len0), 219 Bytes = list_to_binary(lists:reverse(Bytes1)), 220 enc_used_contexts(Env, T, 221 [#'IOP_ServiceContext'{context_id=?IOP_BI_DIR_IIOP, 222 context_data = Bytes}|Ctxs]); 223enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?IOP_FT_REQUEST, 224 context_data = Ctx}|T], 225 Ctxs) -> 226 %% Encode ByteOrder 227 {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0), 228 {Bytes1, _Len1} = enc_type(?FT_FTRequestServiceContext, Env, Ctx, 229 Bytes0, Len0), 230 Bytes = list_to_binary(lists:reverse(Bytes1)), 231 enc_used_contexts(Env, T, 232 [#'IOP_ServiceContext'{context_id=?IOP_FT_REQUEST, 233 context_data = Bytes}|Ctxs]); 234enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?IOP_FT_GROUP_VERSION, 235 context_data = Ctx}|T], 236 Ctxs) -> 237 %% Encode ByteOrder 238 {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0), 239 {Bytes1, _Len1} = enc_type(?FT_FTGroupVersionServiceContext, Env, Ctx, 240 Bytes0, Len0), 241 Bytes = list_to_binary(lists:reverse(Bytes1)), 242 enc_used_contexts(Env, T, 243 [#'IOP_ServiceContext'{context_id=?IOP_FT_GROUP_VERSION, 244 context_data = Bytes}|Ctxs]); 245enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, 246 context_data = Ctx}|T], 247 Ctxs) -> 248 %% Encode ByteOrder 249 {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0), 250 {Bytes1, _Len1} = enc_type(?CSI_SASContextBody, Env, Ctx, 251 Bytes0, Len0), 252 Bytes = list_to_binary(lists:reverse(Bytes1)), 253 enc_used_contexts(Env, T, 254 [#'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService, 255 context_data = Bytes}|Ctxs]); 256enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, 257 context_data = {interface, _I}}|T], 258 Ctxs) -> 259 %% This shall not be forwarded. 260 enc_used_contexts(Env, T, Ctxs); 261enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, 262 context_data = {configuration, _O}}|T], 263 Ctxs) -> 264 %% This shall not be forwarded. 265 enc_used_contexts(Env, T, Ctxs); 266enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, 267 context_data = Ctx}|T], 268 Ctxs) -> 269 %% Encode ByteOrder 270 {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0), 271 {Bytes1, _Len1} = enc_type(?ORBER_GENERIC_CTX, Env, 272 binary_to_list(term_to_binary(Ctx)), 273 Bytes0, Len0), 274 Bytes = list_to_binary(lists:reverse(Bytes1)), 275 enc_used_contexts(Env, T, 276 [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID, 277 context_data = Bytes}|Ctxs]); 278enc_used_contexts(Env, [H|T], Ctxs) -> 279 enc_used_contexts(Env, T, [H|Ctxs]). 280 281%% ## NEW IIOP 1.2 ## 282enc_target_address(#giop_env{objkey = TargetAddr} = Env, Mess, Len) 283 when is_record(TargetAddr, 'GIOP_TargetAddress') -> 284 enc_type(?TARGETADDRESS, Env, TargetAddr, Mess, Len); 285enc_target_address(#giop_env{objkey = IORInfo} = Env, Mess, Len) 286 when is_record(IORInfo, 'GIOP_IORAddressingInfo') -> 287 enc_type(?TARGETADDRESS, Env, #'GIOP_TargetAddress'{label = ?GIOP_ReferenceAddr, 288 value = IORInfo}, 289 Mess, Len); 290enc_target_address(#giop_env{objkey = TP} = Env, Mess, Len) 291 when is_record(TP, 'IOP_TaggedProfile') -> 292 enc_type(?TARGETADDRESS, Env, #'GIOP_TargetAddress'{label = ?GIOP_ProfileAddr, 293 value = TP}, 294 Mess, Len); 295enc_target_address(#giop_env{objkey = ObjKey} = Env, Mess, Len) -> 296 enc_type(?TARGETADDRESS, Env, #'GIOP_TargetAddress'{label = ?GIOP_KeyAddr, 297 value = ObjKey}, 298 Mess, Len). 299 300%% FIX ME!! This is temporary, not proper flag handling. 301enc_response_flags(#giop_env{response_expected = true} = Env, Mess, Len) -> 302 enc_type('tk_octet', Env, 3, Mess, Len); 303enc_response_flags(#giop_env{response_expected = false} = Env, Mess, Len) -> 304 enc_type('tk_octet', Env, 0, Mess, Len). 305 306%%----------------------------------------------------------------- 307%% Func: enc_request_body/5 308%%----------------------------------------------------------------- 309enc_request_body(#giop_env{tc = {_, [], _}}, Message, Len) -> 310 %% This case is used to avoid adding alignment even though no body will be added. 311 {Message, Len}; 312enc_request_body(#giop_env{version = {1,2}, 313 tc = {_RetType, InParameters, _OutParameters}, 314 parameters = Parameters} = Env, 315 Message, Len) -> 316 {Message1, Len1} = enc_align(Message, Len, 8), 317 enc_parameters(Env, InParameters, Parameters, Message1, Len1); 318enc_request_body(#giop_env{tc = {_RetType, InParameters, _OutParameters}, 319 parameters = Parameters} = Env, 320 Message, Len) -> 321 enc_parameters(Env, InParameters, Parameters, Message, Len). 322 323%%----------------------------------------------------------------- 324%% Func: validate_request_body/1 325%%----------------------------------------------------------------- 326validate_request_body(#giop_env{tc = {_RetType, InParameters, _OutParameters}, 327 parameters = Parameters} = Env) -> 328 enc_parameters(Env, InParameters, Parameters, [], 0). 329 330%%----------------------------------------------------------------- 331%% Func: enc_reply/6 332%%----------------------------------------------------------------- 333%% ## NEW IIOP 1.2 ## 334enc_reply(#giop_env{version = {1,2}} = Env) -> 335 Flags = 1, %% LTH Not correct, just placeholder 336 {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE), 337 {Message1, Len1} = enc_reply_status(Env, Message, Len), 338 {Message2, Len2} = enc_service_context(Env, Message1, Len1), 339 {Message3, Len3} = enc_reply_body(Env, Message2, Len2), 340 enc_giop_message_header(Env, 'reply', Flags, Len3 - ?GIOP_HEADER_SIZE, 341 lists:reverse(Message3)); 342enc_reply(Env) -> 343 Flags = 1, %% LTH Not correct, just placeholder 344 {Message, Len} = enc_service_context(Env, [], ?GIOP_HEADER_SIZE), 345 {Message1, Len1} = enc_request_id(Env, Message, Len), 346 {Message2, Len2} = enc_reply_status(Env, Message1, Len1), 347 {Message3, Len3} = enc_reply_body(Env, Message2, Len2), 348 enc_giop_message_header(Env, 'reply', Flags, Len3 - ?GIOP_HEADER_SIZE, 349 lists:reverse(Message3)). 350 351%% ## NEW IIOP 1.2 ## 352enc_reply_split(#giop_env{version = {1,2}} = Env) -> 353 Flags = 1, %% LTH Not correct, just placeholder 354 {Message, Len0} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE), 355 {Message1, Len1} = enc_reply_status(Env, Message, Len0), 356 {Message2, Len2} = enc_service_context(Env, Message1, Len1), 357 {Body, Len} = enc_reply_body(Env, [], Len2), 358 {lists:reverse(Message2), list_to_binary(lists:reverse(Body)), 359 Len2 - ?GIOP_HEADER_SIZE, Len-Len2, Flags}; 360enc_reply_split(Env) -> 361 Flags = 1, %% LTH Not correct, just placeholder 362 {Message, Len0} = enc_service_context(Env, [], ?GIOP_HEADER_SIZE), 363 {Message1, Len1} = enc_request_id(Env, Message, Len0), 364 {Message2, Len2} = enc_reply_status(Env, Message1, Len1), 365 {Body, Len} = enc_reply_body(Env, [], Len2), 366 {lists:reverse(Message2), list_to_binary(lists:reverse(Body)), 367 Len2 - ?GIOP_HEADER_SIZE, Len-Len2, Flags}. 368 369enc_reply_status(Env, Mess, Len) -> 370 L = enc_giop_reply_status_type(Env#giop_env.reply_status), 371 enc_type('tk_ulong', Env, L, Mess, Len). 372 373%%----------------------------------------------------------------- 374%% Func: enc_reply_body/6 375%%----------------------------------------------------------------- 376enc_reply_body(#giop_env{tc = {'tk_void', _, []}, result = ok, 377 parameters = []}, Message, Len) -> 378 %% This case is mainly to be able to avoid adding alignment for 379 %% IIOP-1.2 messages if the body should be empty, i.e., void return value and 380 %% no out parameters. 381 {Message, Len}; 382enc_reply_body(#giop_env{version = {1,2}, 383 tc = {RetType, _InParameters, OutParameters}, 384 parameters = Parameters, result = Result} = Env, 385 Message, Len) -> 386 {Message1, Len1} = enc_align(Message, Len, 8), 387 {Message2, Len2} = enc_type(RetType, Env, Result, Message1, Len1), 388 enc_parameters(Env, OutParameters, Parameters, Message2, Len2); 389enc_reply_body(#giop_env{tc = {RetType, _InParameters, OutParameters}, 390 parameters = Parameters, result = Result} = Env, 391 Message, Len) -> 392 {Message1, Len1} = enc_type(RetType, Env, Result, Message, Len), 393 enc_parameters(Env, OutParameters, Parameters, Message1, Len1). 394 395 396%%----------------------------------------------------------------- 397%% Func: validate_reply_body/3 398%%----------------------------------------------------------------- 399validate_reply_body(Env, {'EXCEPTION', Exception}) -> 400 {TypeOfException, ExceptionTypeCode, NewExc} = 401 orber_exceptions:get_def(Exception), 402 {'tk_except', TypeOfException, ExceptionTypeCode, 403 (catch enc_reply_body(Env#giop_env{tc = {ExceptionTypeCode, [], []}, 404 result = NewExc, parameters = []}, [], 0))}; 405validate_reply_body(#giop_env{tc = {_RetType, _InParameters, []}} = Env, Reply) -> 406 enc_reply_body(Env#giop_env{result = Reply}, [], 0); 407validate_reply_body(Env, Reply) when is_tuple(Reply) -> 408 [Result|Parameters] = tuple_to_list(Reply), 409 enc_reply_body(Env#giop_env{result = Result, parameters = Parameters}, [], 0); 410validate_reply_body(Env, Reply) -> 411 enc_reply_body(Env#giop_env{result = Reply}, [], 0). 412 413%%----------------------------------------------------------------- 414%% Func: enc_cancel_request/2 415%%----------------------------------------------------------------- 416enc_cancel_request(Env) -> 417 Flags = 1, %% LTH Not correct, just placeholder 418 {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE), 419 enc_giop_message_header(Env, 'cancel_request', Flags, Len - ?GIOP_HEADER_SIZE, 420 lists:reverse(Message)). 421 422%%----------------------------------------------------------------- 423%% Func: enc_locate_request/3 424%%----------------------------------------------------------------- 425%% ## NEW IIOP 1.2 ## 426enc_locate_request(#giop_env{version = {1,2}} = Env) -> 427 Flags = 1, %% LTH Not correct, just placeholder 428 {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE), 429 {Message1, Len1} = enc_target_address(Env, Message, Len), 430 enc_giop_message_header(Env, 'locate_request', Flags, Len1-?GIOP_HEADER_SIZE, 431 lists:reverse(Message1)); 432enc_locate_request(Env) -> 433 Flags = 1, %% LTH Not correct, just placeholder 434 {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE), 435 {Message1, Len1} = enc_object_key(Env, Message, Len), 436 enc_giop_message_header(Env, 'locate_request', Flags, Len1-?GIOP_HEADER_SIZE, 437 lists:reverse(Message1)). 438 439%%----------------------------------------------------------------- 440%% Func: enc_locate_reply 441%%----------------------------------------------------------------- 442%% No forward etc. Just encode the status. 443enc_locate_reply(#giop_env{tc = undefined} = Env) -> 444 Flags = 1, %% LTH Not correct, just placeholder 445 {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE), 446 {Message1, Len1} = enc_locate_status(Env, Message, Len), 447 enc_giop_message_header(Env, 'locate_reply', Flags, Len1 - ?GIOP_HEADER_SIZE, 448 lists:reverse(Message1)); 449enc_locate_reply(Env) -> 450 Flags = 1, %% LTH Not correct, just placeholder 451 {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE), 452 {Message1, Len1} = enc_locate_status(Env, Message, Len), 453 {Message2, Len2} = enc_locate_reply_body(Env, Message1, Len1), 454 enc_giop_message_header(Env, 'locate_reply', Flags, Len2 - ?GIOP_HEADER_SIZE, 455 lists:reverse(Message2)). 456 457enc_locate_reply_body(#giop_env{tc = TC, result = Data} = Env, Message, Len) -> 458 %% In CORBA-2.3.1 the LocateReply body didn't align the body (8-octet 459 %% boundry) for IIOP-1.2. This have been changed in later specs. 460 %% Un-comment the line below when we want to be CORBA-2.4 compliant. 461 %% But in CORB-2.6 this was changed once again (i.e. no alignment). 462 %% The best solution is to keep it as is. 463 enc_type(TC, Env, Data, Message, Len). 464 465enc_locate_status(Env, Mess, Len) -> 466 L = enc_giop_locate_status_type(Env#giop_env.reply_status), 467 enc_type('tk_ulong', Env, L, Mess, Len). 468%%----------------------------------------------------------------- 469%% Func: enc_close_connection/1 470%%----------------------------------------------------------------- 471enc_close_connection(Env) -> 472 Flags = 1, %% LTH Not correct, just placeholder 473 enc_giop_message_header(Env, 'close_connection', Flags, 0, []). 474 475%%----------------------------------------------------------------- 476%% Func: enc_message_error/1 477%%----------------------------------------------------------------- 478enc_message_error(Env) -> 479 Flags = 1, %% LTH Not correct, just placeholder 480 enc_giop_message_header(Env, 'message_error', Flags, 0, []). 481 482%%----------------------------------------------------------------- 483%% Func: enc_fragment/1 484%%----------------------------------------------------------------- 485enc_fragment(Env) -> 486 Flags = 1, %% LTH Not correct, just placeholder 487 enc_giop_message_header(Env, 'fragment', Flags, 0, []). 488 489%%----------------------------------------------------------------- 490%% Func: enc_giop_msg_type 491%% Args: An integer message type code 492%% Returns: An atom which is the message type code name 493%%----------------------------------------------------------------- 494enc_giop_msg_type('request') -> 495 0; 496enc_giop_msg_type('reply') -> 497 1; 498enc_giop_msg_type('cancel_request') -> 499 2; 500enc_giop_msg_type('locate_request') -> 501 3; 502enc_giop_msg_type('locate_reply') -> 503 4; 504enc_giop_msg_type('close_connection') -> 505 5; 506enc_giop_msg_type('message_error') -> 507 6; 508enc_giop_msg_type('fragment') -> 509 7. 510 511 512%%----------------------------------------------------------------- 513%% Func: enc_giop_reply_status_type 514%% Args: An atom which is the reply status 515%% Returns: An integer status code 516%%----------------------------------------------------------------- 517enc_giop_reply_status_type(?NO_EXCEPTION) -> 518 0; 519enc_giop_reply_status_type(?USER_EXCEPTION) -> 520 1; 521enc_giop_reply_status_type(?SYSTEM_EXCEPTION) -> 522 2; 523enc_giop_reply_status_type('location_forward') -> 524 3; 525%% ## NEW IIOP 1.2 ## 526enc_giop_reply_status_type('location_forward_perm') -> 527 4; 528enc_giop_reply_status_type('needs_addressing_mode') -> 529 5. 530 531%%----------------------------------------------------------------- 532%% Func: enc_giop_locate_status_type 533%% Args: An integer status code 534%% Returns: An atom which is the reply status 535%%----------------------------------------------------------------- 536enc_giop_locate_status_type('unknown_object') -> 537 0; 538enc_giop_locate_status_type('object_here') -> 539 1; 540enc_giop_locate_status_type('object_forward') -> 541 2; 542%% ## NEW IIOP 1.2 ## 543enc_giop_locate_status_type('object_forward_perm') -> 544 3; 545enc_giop_locate_status_type('loc_system_exception') -> 546 4; 547enc_giop_locate_status_type('loc_needs_addressing_mode') -> 548 5. 549 550%%----------------------------------------------------------------- 551%% Func: enc_type/3 552%%----------------------------------------------------------------- 553enc_type(Env, TypeCode, Value) -> 554 {Bytes, _Len} = enc_type(TypeCode, Env, Value, [], 0), 555 list_to_binary(lists:reverse(Bytes)). 556 557%%----------------------------------------------------------------- 558%% Func: enc_type/5 559%%----------------------------------------------------------------- 560enc_type('tk_null', _Env, null, Bytes, Len) -> 561 {Bytes, Len}; 562enc_type('tk_void', _Env, ok, Bytes, Len) -> 563 {Bytes, Len}; 564enc_type('tk_short', _Env, Value, Bytes, Len) -> 565 {Rest, Len1} = enc_align(Bytes, Len, 2), 566 {cdrlib:enc_short(Value, Rest), Len1 + 2}; 567enc_type('tk_long', _Env, Value, Bytes, Len) -> 568 {Rest, Len1} = enc_align(Bytes, Len, 4), 569 {cdrlib:enc_long(Value, Rest ), Len1 + 4}; 570enc_type('tk_longlong', _Env, Value, Bytes, Len) -> 571 {Rest, Len1} = enc_align(Bytes, Len, 8), 572 {cdrlib:enc_longlong(Value, Rest ), Len1 + 8}; 573enc_type('tk_ushort', _Env, Value, Bytes, Len) -> 574 {Rest, Len1} = enc_align(Bytes, Len, 2), 575 {cdrlib:enc_unsigned_short(Value, Rest), Len1 + 2}; 576enc_type('tk_ulong', _Env, Value, Bytes, Len) -> 577 {Rest, Len1} = enc_align(Bytes, Len, 4), 578 {cdrlib:enc_unsigned_long(Value, Rest), Len1 + 4}; 579enc_type('tk_ulonglong', _Env, Value, Bytes, Len) -> 580 {Rest, Len1} = enc_align(Bytes, Len, 8), 581 {cdrlib:enc_unsigned_longlong(Value, Rest), Len1 + 8}; 582enc_type('tk_float', _Env, Value, Bytes, Len) -> 583 {Rest, Len1} = enc_align(Bytes, Len, 4), 584 {cdrlib:enc_float(Value, Rest), Len1 + 4}; 585enc_type('tk_double', _Env, Value, Bytes, Len) -> 586 {Rest, Len1} = enc_align(Bytes, Len, 8), 587 {cdrlib:enc_double(Value, Rest), Len1 + 8}; 588enc_type('tk_boolean', _Env, Value, Bytes, Len) -> 589 {cdrlib:enc_bool(Value, Bytes), Len + 1}; 590enc_type('tk_char', _Env, Value, Bytes, Len) -> 591 {cdrlib:enc_char(Value, Bytes), Len + 1}; 592%% The wchar decoding can be 1, 2 or 4 bytes but for now we only accept 2. 593enc_type('tk_wchar', #giop_env{version = {1,2}}, Value, Bytes, Len) -> 594 Bytes1 = cdrlib:enc_octet(2, Bytes), 595 {cdrlib:enc_unsigned_short(Value, Bytes1), Len + 3}; 596enc_type('tk_wchar', _Env, Value, Bytes, Len) -> 597 {Rest, Len1} = enc_align(Bytes, Len, 2), 598 {cdrlib:enc_unsigned_short(Value, Rest), Len1 + 2}; 599enc_type('tk_octet', _Env, Value, Bytes, Len) -> 600 {cdrlib:enc_octet(Value, Bytes), Len + 1}; 601enc_type('tk_any', Env, Any, Bytes, Len) when is_record(Any, any) -> 602 {Rest, Len1} = enc_type('tk_TypeCode', Env, Any#any.typecode, Bytes, Len), 603 enc_type(Any#any.typecode, Env, Any#any.value, Rest, Len1); 604enc_type('tk_TypeCode', Env, Value, Bytes, Len) -> 605 enc_type_code(Value, Env, Bytes, Len); 606enc_type('tk_Principal', Env, Value, Bytes, Len) -> 607 %% Set MaxLength no 0 (i.e. unlimited). 608 enc_sequence(Env, Value, 0, 'tk_octet', Bytes, Len); 609enc_type({'tk_objref', _IFRId, Name}, Env, Value, Bytes, Len) -> 610 enc_objref(Env, Name,Value, Bytes, Len); 611enc_type({'tk_struct', _IFRId, _Name, ElementList}, Env, Value, Bytes, Len) -> 612 enc_struct(Env, Value, ElementList, Bytes, Len); 613enc_type({'tk_union', _IFRId, _Name, DiscrTC, Default, ElementList}, 614 Env, Value, Bytes, Len) -> 615 enc_union(Env, Value, DiscrTC, Default, ElementList, Bytes, Len); 616enc_type({'tk_enum', _IFRId, _Name, ElementList}, _Env, Value, Bytes, Len) -> 617 {Rest, Len1} = enc_align(Bytes, Len, 4), 618 {cdrlib:enc_enum(atom_to_list(Value), ElementList, Rest), Len1 + 4}; 619enc_type({'tk_string', MaxLength}, Env, Value, Bytes, Len) -> 620 enc_string(Env, Value, MaxLength, Bytes, Len); 621enc_type({'tk_wstring', MaxLength}, Env, Value, Bytes, Len) -> 622 enc_wstring(Env, Value, MaxLength, Bytes, Len); 623enc_type({'tk_sequence', ElemTC, MaxLength}, Env, Value, Bytes, Len) -> 624 enc_sequence(Env, Value, MaxLength, ElemTC, Bytes, Len); 625enc_type({'tk_array', ElemTC, Size}, Env, Value, Bytes, Len) -> 626 enc_array(Env, Value, Size, ElemTC, Bytes, Len); 627enc_type({'tk_alias', _IFRId, _Name, TC}, Env, Value, Bytes, Len) -> 628 enc_type(TC, Env, Value, Bytes, Len); 629enc_type({'tk_except', IFRId, Name, ElementList}, Env, Value, Bytes, Len) -> 630 enc_exception(Env, Name, IFRId, Value, ElementList, Bytes, Len); 631enc_type({'tk_fixed', Digits, Scale}, Env, Value, Bytes, Len) -> 632 enc_fixed(Env, Digits, Scale, Value, Bytes, Len); 633enc_type(Type, _, Value, _, _) -> 634 orber:dbg("[~p] cdr_encode:type(~p, ~p)~n" 635 "Incorrect TypeCode or unsupported type.", 636 [?LINE, Type, Value], ?DEBUG_LEVEL), 637 corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 13), completion_status=?COMPLETED_MAYBE}). 638 639 640 641 642%%----------------------------------------------------------------- 643%% Func: enc_fixed 644%%----------------------------------------------------------------- 645%% Digits eq. total number of digits. 646%% Scale eq. position of the decimal point. 647%% E.g. fixed<5,2> - "123.45" eq. #fixed{digits = 5, scale = 2, value = 12345} 648%% E.g. fixed<4,2> - "12.34" eq. #fixed{digits = 4, scale = 2, value = 1234} 649%% These are encoded as: 650%% ## <5,2> ## ## <4,2> ## 651%% 1,2 0,1 eq. 1 octet 652%% 3,4 2,3 653%% 5,0xC 4,0xC 654%% 655%% Each number is encoded as a half-octet. Note, for <4,2> a zero is 656%% added first to to be able to create "even" octets. 657enc_fixed(Env, Digits, Scale, 658 #fixed{digits = Digits, scale = Scale, value = Value}, Bytes, Len) 659 when is_integer(Value) andalso is_integer(Digits) andalso is_integer(Scale) 660 andalso Digits < 32 andalso Digits >= Scale -> 661 %% This isn't very efficient and we should improve it before supporting it 662 %% officially. 663 Odd = ?ODD(Digits), 664 case integer_to_list(Value) of 665 [$-|ValueList] when Odd == true -> 666 Padded = lists:duplicate((Digits-length(ValueList)), 0) ++ ValueList, 667 enc_fixed_2(Env, Digits, Scale, Padded, 668 Bytes, Len, ?FIXED_NEGATIVE); 669 [$-|ValueList] -> 670 Padded = lists:duplicate((Digits-length(ValueList)), 0) ++ ValueList, 671 enc_fixed_2(Env, Digits, Scale, [0|Padded], 672 Bytes, Len, ?FIXED_NEGATIVE); 673 ValueList when Odd == true -> 674 Padded = lists:duplicate((Digits-length(ValueList)), 0) ++ ValueList, 675 enc_fixed_2(Env, Digits, Scale, Padded, 676 Bytes, Len, ?FIXED_POSITIVE); 677 ValueList -> 678 Padded = lists:duplicate((Digits-length(ValueList)), 0) ++ ValueList, 679 enc_fixed_2(Env, Digits, Scale, [0|Padded], 680 Bytes, Len, ?FIXED_POSITIVE) 681 end; 682enc_fixed(_Env, Digits, Scale, Fixed, _Bytes, _Len) -> 683 orber:dbg("[~p] cdr_encode:enc_fixed(~p, ~p, ~p)~n" 684 "The supplied fixed type incorrect. Check that the 'digits' and 'scale' field~n" 685 "match the definition in the IDL-specification. The value field must be~n" 686 "a list of Digits length.", 687 [?LINE, Digits, Scale, Fixed], ?DEBUG_LEVEL), 688 corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}). 689 690enc_fixed_2(_Env, _Digits, _Scale, [D1], Bytes, Len, Sign) -> 691 {[<<D1:4,Sign:4>>|Bytes], Len+1}; 692enc_fixed_2(Env, Digits, Scale, [D1, D2|Ds], Bytes, Len, Sign) -> 693 %% We could convert the ASCII-value to digit values but the bit-syntax will 694 %% truncate it correctly. 695 enc_fixed_2(Env, Digits, Scale, Ds, [<<D1:4,D2:4>> | Bytes], Len+1, Sign); 696enc_fixed_2(_Env, Digits, Scale, Value, _Bytes, _Len, Sign) -> 697 orber:dbg("[~p] cdr_encode:enc_fixed_2(~p, ~p, ~p, ~p)~n" 698 "The supplied fixed type incorrect. Most likely the 'digits' field don't match the~n" 699 "supplied value. Hence, check that the value is correct.", 700 [?LINE, Digits, Scale, Value, Sign], ?DEBUG_LEVEL), 701 corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}). 702 703 704 705%%----------------------------------------------------------------- 706%% Func: enc_sequence/5 707%%----------------------------------------------------------------- 708%% This is a special case used when encoding encapsualted data, i.e., contained 709%% in an octet-sequence. 710enc_sequence(_Env, Sequence, MaxLength, 'tk_octet', Bytes, Len) 711 when is_binary(Sequence) -> 712 {ByteSequence, Len1} = enc_align(Bytes, Len, 4), 713 Size = size(Sequence), 714 if 715 Size > MaxLength, MaxLength > 0 -> 716 orber:dbg("[~p] cdr_encode:enc_sequnce(~p, ~p). Sequence exceeds max.", 717 [?LINE, Sequence, MaxLength], ?DEBUG_LEVEL), 718 corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 19), 719 completion_status=?COMPLETED_MAYBE}); 720 true -> 721 ByteSequence1 = cdrlib:enc_unsigned_long(Size, ByteSequence), 722 {[Sequence |ByteSequence1], Len1 + 4 + Size} 723 end; 724enc_sequence(Env, Sequence, MaxLength, TypeCode, Bytes, Len) -> 725 Length = length(Sequence), 726 if 727 Length > MaxLength, MaxLength > 0 -> 728 orber:dbg("[~p] cdr_encode:enc_sequnce(~p, ~p). Sequence exceeds max.", 729 [?LINE, Sequence, MaxLength], ?DEBUG_LEVEL), 730 corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 19), 731 completion_status=?COMPLETED_MAYBE}); 732 true -> 733 {ByteSequence, Len1} = enc_align(Bytes, Len, 4), 734 ByteSequence1 = cdrlib:enc_unsigned_long(Length, ByteSequence), 735 enc_sequence1(Env, Sequence, TypeCode, ByteSequence1, Len1 + 4) 736 end. 737 738%%----------------------------------------------------------------- 739%% Func: enc_sequence1/4 740%%----------------------------------------------------------------- 741enc_sequence1(_Env, [], _TypeCode, Bytes, Len) -> 742 {Bytes, Len}; 743enc_sequence1(_Env, CharSeq, 'tk_char', Bytes, Len) -> 744 {[list_to_binary(CharSeq) |Bytes], Len + length(CharSeq)}; 745enc_sequence1(_Env, OctetSeq, 'tk_octet', Bytes, Len) -> 746 {[list_to_binary(OctetSeq) |Bytes], Len + length(OctetSeq)}; 747enc_sequence1(Env, [Object| Rest], TypeCode, Bytes, Len) -> 748 {ByteSequence, Len1} = enc_type(TypeCode, Env, Object, Bytes, Len), 749 enc_sequence1(Env, Rest, TypeCode, ByteSequence, Len1). 750 751%%----------------------------------------------------------------- 752%% Func: enc_array/4 753%%----------------------------------------------------------------- 754enc_array(Env, Array, Size, TypeCode, Bytes, Len) when size(Array) == Size -> 755 Sequence = tuple_to_list(Array), 756 enc_sequence1(Env, Sequence, TypeCode, Bytes, Len); 757enc_array(_,Array, Size, _, _, _) -> 758 orber:dbg("[~p] cdr_encode:enc_array(~p, ~p). Incorrect size.", 759 [?LINE, Array, Size], ?DEBUG_LEVEL), 760 corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 15), completion_status=?COMPLETED_MAYBE}). 761 762%%----------------------------------------------------------------- 763%% Func: enc_string/4 764%%----------------------------------------------------------------- 765enc_string(_Env, String, MaxLength, Bytes, Len) -> 766 StrLen = length(String), 767 if 768 StrLen > MaxLength, MaxLength > 0 -> 769 orber:dbg("[~p] cdr_encode:enc_string(~p, ~p). String exceeds max.", 770 [?LINE, String, MaxLength], ?DEBUG_LEVEL), 771 corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 16), 772 completion_status=?COMPLETED_MAYBE}); 773 true -> 774 {ByteSequence, Len1} = enc_align(Bytes, Len, 4), 775 ByteSequence1 = cdrlib:enc_unsigned_long(StrLen + 1, ByteSequence), 776 {cdrlib:enc_octet(0, [String | ByteSequence1]), Len1 + StrLen + 5} 777 end. 778 779 780%%----------------------------------------------------------------- 781%% Func: enc_wstring/4 782%%----------------------------------------------------------------- 783enc_wstring(#giop_env{version = {1,2}} = Env, String, MaxLength, Bytes, Len) -> 784 %% Encode the length of the string (ulong). 785 {Bytes1, Len1} = enc_align(Bytes, Len, 4), 786 %% For IIOP-1.2 the length is the total number of octets. Hence, since the wchar's 787 %% we accepts is encoded as <<255, 255>> the total size is 2*length of the list. 788 ListLen = length(String), 789 if 790 ListLen > MaxLength, MaxLength > 0 -> 791 corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 16), 792 completion_status=?COMPLETED_MAYBE}); 793 true -> 794 StrLen = ListLen * 2, 795 Bytes2 = cdrlib:enc_unsigned_long(StrLen, Bytes1), 796 %% For IIOP-1.2 no terminating null character is used. 797 enc_sequence1(Env, String, 'tk_ushort', Bytes2, Len1+4) 798 end; 799enc_wstring(Env, String, MaxLength, Bytes, Len) -> 800 %% Encode the length of the string (ulong). 801 {Bytes1, Len1} = enc_align(Bytes, Len, 4), 802 ListLen = length(String), 803 if 804 ListLen > MaxLength, MaxLength > 0 -> 805 corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 16), 806 completion_status=?COMPLETED_MAYBE}); 807 true -> 808 StrLen = ListLen + 1, 809 Bytes2 = cdrlib:enc_unsigned_long(StrLen, Bytes1), 810 {Bytes3, Len3} = enc_sequence1(Env, String, 'tk_wchar', Bytes2, Len1+4), 811 %% The terminating null character is also a wchar. 812 {cdrlib:enc_unsigned_short(0, Bytes3), Len3+2} 813 end. 814 815 816%%----------------------------------------------------------------- 817%% Func: enc_union/5 818%%----------------------------------------------------------------- 819enc_union(Env, {_, Label, Value}, DiscrTC, Default, TypeCodeList, 820 Bytes, Len) when is_list(TypeCodeList) -> 821 {ByteSequence, Len1} = enc_type(DiscrTC, Env, Label, Bytes, Len), 822 Label2 = stringify_enum(DiscrTC,Label), 823 enc_union2(Env, {Label2, Value},TypeCodeList, Default, 824 ByteSequence, Len1, undefined); 825enc_union(Env, Value, _DiscrTC, _Default, Module, Bytes, Len) when is_atom(Module) -> 826 case catch Module:tc() of 827 {tk_union, _, _, DiscrTC, Default, ElementList} -> 828 enc_union(Env, Value, DiscrTC, Default, ElementList, Bytes, Len); 829 What -> 830 orber:dbg("[~p] ~p:enc_union(~p). Union module doesn't exist or incorrect.", 831 [?LINE, ?MODULE, What], ?DEBUG_LEVEL), 832 corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}) 833 end. 834 835enc_union2(_Env, _What, [], Default, Bytes, Len, _) when Default < 0 -> 836 {Bytes, Len}; 837enc_union2(Env, {_, Value}, [], _Default, Bytes, Len, Type) -> 838 enc_type(Type, Env, Value, Bytes, Len); 839enc_union2(Env, {Label,Value} ,[{Label, _Name, Type} |_List], 840 _Default, Bytes, Len, _) -> 841 enc_type(Type, Env, Value, Bytes, Len); 842enc_union2(Env, Union ,[{default, _Name, Type} |List], Default, Bytes, Len, _) -> 843 enc_union2(Env, Union, List, Default, Bytes, Len, Type); 844enc_union2(Env, Union,[_ | List], Default, Bytes, Len, DefaultType) -> 845 enc_union2(Env, Union, List, Default, Bytes, Len, DefaultType). 846 847stringify_enum({tk_enum, _,_,_}, Label) -> 848 atom_to_list(Label); 849stringify_enum(_, Label) -> 850 Label. 851%%----------------------------------------------------------------- 852%% Func: enc_struct/4 853%%----------------------------------------------------------------- 854enc_struct(Env, Struct, TypeCodeList, Bytes, Len) when is_list(TypeCodeList) -> 855 [_Name | StructList] = tuple_to_list(Struct), 856 enc_struct1(Env, StructList, TypeCodeList, Bytes, Len); 857enc_struct(Env, Struct, Module, Bytes, Len) -> 858 [Module | StructList] = tuple_to_list(Struct), 859 case catch Module:tc() of 860 {tk_struct, _, _, TypeCodeList} -> 861 enc_struct1(Env, StructList, TypeCodeList, Bytes, Len); 862 What -> 863 orber:dbg("[~p] ~p:enc_struct([], ~p). Struct module doesn't exist or incorrect.", 864 [?LINE, ?MODULE, What], ?DEBUG_LEVEL), 865 corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}) 866 end. 867 868enc_struct1(_Env, [], [], Bytes, Len) -> 869 {Bytes, Len}; 870enc_struct1(Env, [Object | Rest], [{_ElemName, ElemType} | TypeCodeList], Bytes, 871 Len) -> 872 {ByteSequence, Len1} = enc_type(ElemType, Env, Object, Bytes, Len), 873 enc_struct1(Env, Rest, TypeCodeList, ByteSequence, Len1). 874 875%%----------------------------------------------------------------- 876%% Func: enc_objref/4 877%%----------------------------------------------------------------- 878enc_objref(Env, _Name, Value, Bytes, Len) -> 879 iop_ior:code(Env, Value, Bytes, Len). 880 881%%----------------------------------------------------------------- 882%% Func: enc_exception/5 883%%----------------------------------------------------------------- 884enc_exception(Env, _Name, IFRId, Value, ElementList, Bytes, Len) -> 885 [_Name1, _TypeId | Args] = tuple_to_list(Value), 886 {Bytes1, Len1} = enc_type({'tk_string', 0}, Env, IFRId , Bytes, Len), 887 enc_exception_1(Env, Args, ElementList, Bytes1, Len1). 888 889enc_exception_1(_Env, [], [], Bytes, Len) -> 890 {Bytes, Len}; 891enc_exception_1(Env, [Arg |Args], [{_ElemName, ElemType} |ElementList], 892 Bytes, Len) -> 893 {Bytes1, Len1} = enc_type(ElemType, Env, Arg, Bytes, Len), 894 enc_exception_1(Env, Args, ElementList, Bytes1, Len1). 895 896 897%%----------------------------------------------------------------- 898%% Func: enc_type_code/3 899%%----------------------------------------------------------------- 900enc_type_code('tk_null', Env, Message, Len) -> 901 enc_type('tk_ulong', Env, 0, Message, Len); 902enc_type_code('tk_void', Env, Message, Len) -> 903 enc_type('tk_ulong', Env, 1, Message, Len); 904enc_type_code('tk_short', Env, Message, Len) -> 905 enc_type('tk_ulong', Env, 2, Message, Len); 906enc_type_code('tk_long', Env, Message, Len) -> 907 enc_type('tk_ulong', Env, 3, Message, Len); 908enc_type_code('tk_longlong', Env, Message, Len) -> 909 enc_type('tk_ulong', Env, 23, Message, Len); 910enc_type_code('tk_longdouble', Env, Message, Len) -> 911 enc_type('tk_ulong', Env, 25, Message, Len); 912enc_type_code('tk_ushort', Env, Message, Len) -> 913 enc_type('tk_ulong', Env, 4, Message, Len); 914enc_type_code('tk_ulong', Env, Message, Len) -> 915 enc_type('tk_ulong', Env, 5, Message, Len); 916enc_type_code('tk_ulonglong', Env, Message, Len) -> 917 enc_type('tk_ulong', Env, 24, Message, Len); 918enc_type_code('tk_float', Env, Message, Len) -> 919 enc_type('tk_ulong', Env, 6, Message, Len); 920enc_type_code('tk_double', Env, Message, Len) -> 921 enc_type('tk_ulong', Env, 7, Message, Len); 922enc_type_code('tk_boolean', Env, Message, Len) -> 923 enc_type('tk_ulong', Env, 8, Message, Len); 924enc_type_code('tk_char', Env, Message, Len) -> 925 enc_type('tk_ulong', Env, 9, Message, Len); 926enc_type_code('tk_wchar', Env, Message, Len) -> 927 enc_type('tk_ulong', Env, 26, Message, Len); 928enc_type_code('tk_octet', Env, Message, Len) -> 929 enc_type('tk_ulong', Env, 10, Message, Len); 930enc_type_code('tk_any', Env, Message, Len) -> 931 enc_type('tk_ulong', Env, 11, Message, Len); 932enc_type_code('tk_TypeCode', Env, Message, Len) -> 933 enc_type('tk_ulong', Env, 12, Message, Len); 934enc_type_code('tk_Principal', Env, Message, Len) -> 935 enc_type('tk_ulong', Env, 13, Message, Len); 936enc_type_code({'tk_objref', RepId, Name}, Env, Message, Len) -> 937 {Message1, Len1} = enc_type('tk_ulong', Env, 14, Message, Len), 938 {Message2, _} = enc_byte_order(Env, []), 939 {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}}, 940 {"name", {'tk_string', 0}}]}, 941 Env, 942 {"", RepId, Name}, 943 Message2, 1), 944 encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1); 945enc_type_code({'tk_struct', RepId, SimpleName, ElementList}, Env, Message, Len) -> 946 %% Using SimpleName should be enough (and we avoid some overhead). 947 %% Name = ifrid_to_name(RepId), 948 {Message1, Len1} = enc_type('tk_ulong', Env, 15, Message, Len), 949 {Message2, _} = enc_byte_order(Env, []), 950 {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}}, 951 {"name", {'tk_string', 0}}, 952 {"element list", 953 {'tk_sequence', {'tk_struct', "","", 954 [{"member name", {'tk_string', 0}}, 955 {"member type", 'tk_TypeCode'}]}, 956 0}}]}, 957 Env, 958 {"", RepId, SimpleName, 959 lists:map(fun({N,T}) -> {"",N,T} end, ElementList)}, 960 Message2, 1), 961 encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1); 962enc_type_code({'tk_union', RepId, Name, DiscrTC, Default, ElementList}, 963 Env, Message, Len) -> 964 NewElementList = 965 case check_enum(DiscrTC) of 966 true -> 967 lists:map(fun({L,N,T}) -> {"",list_to_atom(L),N,T} end, ElementList); 968 false -> 969 lists:map(fun({L,N,T}) -> {"",L,N,T} end, ElementList) 970 end, 971 {Message1, Len1} = enc_type('tk_ulong', Env, 16, Message, Len), 972 {Message2, _} = enc_byte_order(Env, []), 973 {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}}, 974 {"name", {'tk_string', 0}}, 975 {"discriminant type", 'tk_TypeCode'}, 976 {"default used", 'tk_long'}, 977 {"element list", 978 {'tk_sequence', {'tk_struct', "","", 979 [{"label value", DiscrTC}, 980 {"member name", {'tk_string', 0}}, 981 {"member type", 'tk_TypeCode'}]}, 982 0}}]}, 983 Env, 984 {"", RepId, Name, DiscrTC, Default, NewElementList}, 985 Message2, 1), 986 encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1); 987enc_type_code({'tk_enum', RepId, Name, ElementList}, Env, Message, Len) -> 988 {Message1, Len1} = enc_type('tk_ulong', Env, 17, Message, Len), 989 {Message2, _} = enc_byte_order(Env, []), 990 {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}}, 991 {"name", {'tk_string', 0}}, 992 {"element list", 993 {'tk_sequence', {'tk_string', 0}, 0}}]}, 994 Env, 995 {"", RepId, Name, ElementList}, 996 Message2, 1), 997 encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1); 998enc_type_code({'tk_string', MaxLength}, Env, Message, Len) -> 999 enc_type({'tk_struct', "", "", [{"TCKind", 'tk_ulong'}, 1000 {"max length", 'tk_ulong'}]}, 1001 Env, 1002 {"", 18, MaxLength}, 1003 Message, Len); 1004enc_type_code({'tk_wstring', MaxLength}, Env, Message, Len) -> 1005 enc_type({'tk_struct', "", "", [{"TCKind", 'tk_ulong'}, 1006 {"max length", 'tk_ulong'}]}, 1007 Env, 1008 {"", 27, MaxLength}, 1009 Message, Len); 1010enc_type_code({'tk_sequence', ElemTC, MaxLength}, Env, Message, Len) -> 1011 {Message1, Len1} = enc_type('tk_ulong', Env, 19, Message, Len), 1012 {Message2, _} = enc_byte_order(Env, []), 1013 {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"element type", 'tk_TypeCode'}, 1014 {"max length", 'tk_ulong'}]}, 1015 Env, 1016 {"", ElemTC, MaxLength}, 1017 Message2, 1), 1018 encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1); 1019enc_type_code({'tk_array', ElemTC, Length}, Env, Message, Len) -> 1020 {Message1, Len1} = enc_type('tk_ulong', Env, 20, Message, Len), 1021 {Message2, _} = enc_byte_order(Env, []), 1022 {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"element type", 'tk_TypeCode'}, 1023 {"length", 'tk_ulong'}]}, 1024 Env, 1025 {"", ElemTC, Length}, 1026 Message2, 1), 1027 encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1); 1028enc_type_code({'tk_alias', RepId, Name, TC}, Env, Message, Len) -> 1029 {Message1, Len1} = enc_type('tk_ulong', Env, 21, Message, Len), 1030 {Message2, _} = enc_byte_order(Env, []), 1031 {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}}, 1032 {"name", {'tk_string', 0}}, 1033 {"TypeCode", 'tk_TypeCode'}]}, 1034 Env, 1035 {"", RepId, Name, TC}, 1036 Message2, 1), 1037 encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1); 1038enc_type_code({'tk_except', RepId, Name, ElementList}, Env, Message, Len) -> 1039 {Message1, Len1} = enc_type('tk_ulong', Env, 22, Message, Len), 1040 {Message2, _} = enc_byte_order(Env, []), 1041 {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}}, 1042 {"name", {'tk_string', 0}}, 1043 {"element list", 1044 {'tk_sequence', 1045 {'tk_struct', "", "", 1046 [{"member name", {'tk_string', 0}}, 1047 {"member type", 'tk_TypeCode'}]}, 0}}]}, 1048 Env, 1049 {"", RepId, Name, 1050 lists:map(fun({N,T}) -> {"",N,T} end, ElementList)}, 1051 Message2, 1), 1052 encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1); 1053enc_type_code({'tk_fixed', Digits, Scale}, Env, Message, Len) -> 1054 enc_type({'tk_struct', "", "", [{"TCKind", 'tk_ulong'}, 1055 {"digits", 'tk_ushort'}, 1056 {"scale", 'tk_short'}]}, 1057 Env, 1058 {"", 28, Digits, Scale}, 1059 Message, Len); 1060enc_type_code({'tk_value', RepId, Name, ValueModifier, TC, ElementList}, Env, Message, Len) -> 1061 {Message1, Len1} = enc_type('tk_ulong', Env, 29, Message, Len), 1062 {Message2, _} = enc_byte_order(Env, []), 1063 {ComplexParams, Len2} = enc_type({'tk_struct', "", "", 1064 [{"repository ID", {'tk_string', 0}}, 1065 {"name", {'tk_string', 0}}, 1066 {"ValueModifier", 'tk_short'}, 1067 {"TypeCode", 'tk_TypeCode'}, 1068 {"element list", 1069 {'tk_sequence', 1070 {'tk_struct', "","", 1071 [{"member name", {'tk_string', 0}}, 1072 {"member type", 'tk_TypeCode'}, 1073 {"Visibility", 'tk_short'}]}, 1074 0}}]}, 1075 Env, 1076 {"", RepId, Name, ValueModifier, TC, 1077 lists:map(fun({N,T,V}) -> {"",N,T,V} end, ElementList)}, 1078 Message2, 1), 1079 encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1); 1080enc_type_code({'tk_value_box', RepId, Name, TC}, Env, Message, Len) -> 1081 {Message1, Len1} = enc_type('tk_ulong', Env, 30, Message, Len), 1082 {Message2, _} = enc_byte_order(Env, []), 1083 {ComplexParams, Len2} = enc_type({'tk_struct', "", "", 1084 [{"repository ID", {'tk_string', 0}}, 1085 {"name", {'tk_string', 0}}, 1086 {"TypeCode", 'tk_TypeCode'}]}, 1087 Env, 1088 {"", RepId, Name, TC}, 1089 Message2, 1), 1090 encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1); 1091enc_type_code({'tk_native', RepId, Name}, Env, Message, Len) -> 1092 {Message1, Len1} = enc_type('tk_ulong', Env, 31, Message, Len), 1093 {Message2, _} = enc_byte_order(Env, []), 1094 {ComplexParams, Len2} = enc_type({'tk_struct', "", "", 1095 [{"repository ID", {'tk_string', 0}}, 1096 {"name", {'tk_string', 0}}]}, 1097 Env, 1098 {"", RepId, Name}, 1099 Message2, 1), 1100 encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1); 1101enc_type_code({'tk_abstract_interface', RepId, Name}, Env, Message, Len) -> 1102 {Message1, Len1} = enc_type('tk_ulong', Env, 32, Message, Len), 1103 {Message2, _} = enc_byte_order(Env, []), 1104 {ComplexParams, Len2} = enc_type({'tk_struct', "", "", 1105 [{"RepositoryId", {'tk_string', 0}}, 1106 {"name", {'tk_string', 0}}]}, 1107 Env, 1108 {"", RepId, Name}, 1109 Message2, 1), 1110 encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1); 1111enc_type_code({'tk_local_interface', RepId, Name}, Env, Message, Len) -> 1112 {Message1, Len1} = enc_type('tk_ulong', Env, 33, Message, Len), 1113 {Message2, _} = enc_byte_order(Env, []), 1114 {ComplexParams, Len2} = enc_type({'tk_struct', "", "", 1115 [{"RepositoryId", {'tk_string', 0}}, 1116 {"name", {'tk_string', 0}}]}, 1117 Env, 1118 {"", RepId, Name}, 1119 Message2, 1), 1120 encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1); 1121enc_type_code({'none', Indirection}, Env, Message, Len) -> %% placeholder 1122 enc_type({'tk_struct', "", "", [{"TCKind", 'tk_ulong'}, 1123 {"indirection", 'tk_long'}]}, 1124 Env, 1125 {"", 16#ffffffff, Indirection}, 1126 Message, Len); 1127enc_type_code(Type, _, _, _) -> 1128 orber:dbg("[~p] cdr_encode:enc_type_code(~p); No match.", 1129 [?LINE, Type], ?DEBUG_LEVEL), 1130 corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 7), completion_status=?COMPLETED_MAYBE}). 1131 1132check_enum({'tk_enum', _, _, _}) -> 1133 true; 1134check_enum(_) -> 1135 false. 1136 1137encode_complex_tc_paramters(Value, ValueLength, Message, Len) -> 1138 {Message1, _Len1} = enc_align(Message, Len, 4), 1139 Message2 = cdrlib:enc_unsigned_long(ValueLength, Message1), 1140 {[Value |Message2], Len+ValueLength+4}. 1141 1142%%----------------------------------------------------------------- 1143%% Func: enc_align/1 1144%%----------------------------------------------------------------- 1145enc_align(R, Len, Alignment) -> 1146 Rem = Len rem Alignment, 1147 if Rem == 0 -> 1148 {R, Len}; 1149 true -> 1150 Diff = Alignment - Rem, 1151 {add_bytes(R, Diff), Len + Diff} 1152 end. 1153 1154add_bytes(R, 0) -> 1155 R; 1156add_bytes(R, 1) -> 1157 [<<16#01:8>> | R]; 1158add_bytes(R, 2) -> 1159 [<<16#02:8, 16#02:8>> | R]; 1160add_bytes(R, 3) -> 1161 [<<16#03:8, 16#03:8, 16#03:8>> | R]; 1162add_bytes(R, 4) -> 1163 [<<16#04:8, 16#04:8, 16#04:8, 16#04:8>> | R]; 1164add_bytes(R, 5) -> 1165 [<<16#05:8, 16#05:8, 16#05:8, 16#05:8, 16#05:8>> | R]; 1166add_bytes(R, 6) -> 1167 [<<16#06:8, 16#06:8, 16#06:8, 16#06:8, 16#06:8, 16#06:8>> | R]; 1168add_bytes(R, 7) -> 1169 [<<16#07:8, 16#07:8, 16#07:8, 16#07:8, 16#07:8, 16#07:8, 16#07:8>> | R]; 1170add_bytes(R,N) -> 1171 add_bytes([<<16#08:8>> | R], N - 1). 1172 1173