src/perl/lib/OpenSRF/DomainObject/oilsMessage.pm

   1 package OpenSRF::DomainObject::oilsMessage;
   2 use OpenSRF::Utils::JSON;
   3 use OpenSRF::AppSession;
   4 use OpenSRF::DomainObject::oilsResponse qw/:status/;
   5 use OpenSRF::Utils::Logger qw/:level/;
   6 use warnings; use strict;
   7 use OpenSRF::EX qw/:try/;
   8 use POSIX qw/tzset/;
   9
  10 OpenSRF::Utils::JSON->register_class_hint(hint => 'osrfMessage', name => 'OpenSRF::DomainObject::oilsMessage', type => 'hash');
  11
  12 sub toString {
  13         my $self = shift;
  14         return OpenSRF::Utils::JSON->perl2JSON($self);
  15 }
  16
  17 sub new {
  18         my $self = shift;
  19         my $class = ref($self) || $self;
  20         my %args = @_;
  21         $args{tz} = $ENV{TZ};
  22         return bless \%args => $class;
  23 }
  24
  25
  26 =head1 NAME
  27
  28 OpenSRF::DomainObject::oilsMessage
  29
  30 =head1
  31
  32 use OpenSRF::DomainObject::oilsMessage;
  33
  34 my $msg = OpenSRF::DomainObject::oilsMessage->new( type => 'CONNECT' );
  35
  36 $msg->payload( $domain_object );
  37
  38 =head1 ABSTRACT
  39
  40 OpenSRF::DomainObject::oilsMessage is used internally to wrap data sent
  41 between client and server.  It provides the structure needed to authenticate
  42 session data, and also provides the logic needed to unwrap session data and
  43 pass this information along to the Application Layer.
  44
  45 =cut
  46
  47 my $log = 'OpenSRF::Utils::Logger';
  48
  49 =head1 METHODS
  50
  51 =head2 OpenSRF::DomainObject::oilsMessage->type( [$new_type] )
  52
  53 =over 4
  54
  55 Used to specify the type of message.  One of
  56 B<CONNECT, REQUEST, RESULT, STATUS, ERROR, or DISCONNECT>.
  57
  58 =back
  59
  60 =cut
  61
  62 sub type {
  63         my $self = shift;
  64         my $val = shift;
  65         $self->{type} = $val if (defined $val);
  66         return $self->{type};
  67 }
  68
  69 =head2 OpenSRF::DomainObject::oilsMessage->api_level( [$new_api_level] )
  70
  71 =over 4
  72
  73 Used to specify the api_level of message.  Currently, only api_level C<1> is
  74 supported.  This will be used to check that messages are well-formed, and as
  75 a hint to the Application as to which version of a method should fulfill a
  76 REQUEST message.
  77
  78 =back
  79
  80 =cut
  81
  82 sub api_level {
  83         my $self = shift;
  84         my $val = shift;
  85         $self->{api_level} = $val if (defined $val);
  86         return $self->{api_level};
  87 }
  88
  89 =head2 OpenSRF::DomainObject::oilsMessage->sender_locale( [$locale] );
  90
  91 =over 4
  92
  93 Sets or gets the current message locale hint.  Useful for telling the
  94 server how you see the world.
  95
  96 =back
  97
  98 =cut
  99
 100 sub sender_locale {
 101         my $self = shift;
 102         my $val = shift;
 103         $self->{locale} = $val if (defined $val);
 104         return $self->{locale};
 105 }
 106
 107 =head2 OpenSRF::DomainObject::oilsMessage->sender_tz( [$tz] );
 108
 109 =over 4
 110
 111 Sets or gets the current message tz.  Useful for telling the
 112 server how you see the world.
 113
 114 =back
 115
 116 =cut
 117
 118 sub sender_tz {
 119         my $self = shift;
 120         my $val = shift;
 121         $self->{tz} = $val if (defined $val);
 122         return $self->{tz};
 123 }
 124
 125 =head2 OpenSRF::DomainObject::oilsMessage->sender_ingress( [$ingress] );
 126
 127 =over 4
 128
 129 Sets or gets the current message ingress.  Useful for telling the
 130 server how you entered the opensrf network.
 131
 132 =back
 133
 134 =cut
 135
 136 sub sender_ingress {
 137         my $self = shift;
 138         my $val = shift;
 139         $self->{ingress} = $val if $val;
 140         return $self->{ingress};
 141 }
 142
 143 =head2 OpenSRF::DomainObject::oilsMessage->threadTrace( [$new_threadTrace] );
 144
 145 =over 4
 146
 147 Sets or gets the current message sequence identifier, or thread trace number,
 148 for a message.  Useful as a debugging aid, but that's about it.
 149
 150 =back
 151
 152 =cut
 153
 154 sub threadTrace {
 155         my $self = shift;
 156         my $val = shift;
 157         $self->{threadTrace} = $val if (defined $val);
 158         return $self->{threadTrace};
 159 }
 160
 161 =head2 OpenSRF::DomainObject::oilsMessage->update_threadTrace
 162
 163 =over 4
 164
 165 Increments the threadTrace component of a message.  This is automatic when
 166 using the normal session processing stack.
 167
 168 =back
 169
 170 =cut
 171
 172 sub update_threadTrace {
 173         my $self = shift;
 174         my $tT = $self->threadTrace;
 175
 176         $tT ||= 0;
 177         $tT++;
 178
 179         $log->debug("Setting threadTrace to $tT",DEBUG);
 180
 181         $self->threadTrace($tT);
 182
 183         return $tT;
 184 }
 185
 186 =head2 OpenSRF::DomainObject::oilsMessage->payload( [$new_payload] )
 187
 188 =over 4
 189
 190 Sets or gets the payload of a message.  This should be exactly one object
 191 of (sub)type domainObject or domainObjectCollection.
 192
 193 =back
 194
 195 =cut
 196
 197 sub payload {
 198         my $self = shift;
 199         my $val = shift;
 200         $self->{payload} = $val if (defined $val);
 201         return $self->{payload};
 202 }
 203
 204 =head2 OpenSRF::DomainObject::oilsMessage->handler( $session_id )
 205
 206 =over 4
 207
 208 Used by the message processing stack to set session state information from the current
 209 message, and then sends control (via the payload) to the Application layer.
 210
 211 =back
 212
 213 =cut
 214
 215 sub handler {
 216         my $self = shift;
 217         my $session = shift;
 218
 219         my $mtype = $self->type;
 220         my $tz = $self->sender_tz || '';
 221         my $locale = $self->sender_locale || '';
 222         my $ingress = $self->sender_ingress || '';
 223         my $api_level = $self->api_level || 1;
 224         my $tT = $self->threadTrace;
 225
 226     $log->debug("Message locale is $locale; ingress = $ingress; tz = $tz", DEBUG);
 227
 228         $session->last_message_type($mtype);
 229         $session->last_message_api_level($api_level);
 230         $session->last_threadTrace($tT);
 231         $session->session_locale($locale);
 232
 233         $log->debug(sub{return " Received api_level => [$api_level], MType => [$mtype], ".
 234                         "from [".$session->remote_id."], threadTrace[".$self->threadTrace."]" });
 235
 236         my $val;
 237         if ( $session->endpoint == $session->SERVER() ) {
 238                 $val = $self->do_server( $session, $mtype, $api_level, $tT );
 239
 240         } elsif ($session->endpoint == $session->CLIENT()) {
 241                 $tz = undef; # Client should not adopt the TZ of the server
 242                 $val = $self->do_client( $session, $mtype, $api_level, $tT );
 243         }
 244
 245         if( $val ) {
 246                 local $ENV{TZ} = $tz || $ENV{TZ}; # automatic revert at the end of this scope
 247                 delete $ENV{TZ} unless $ENV{TZ}; # avoid UTC fall-back
 248                 tzset();
 249                 return OpenSRF::Application->handler($session, $self->payload);
 250         } else {
 251                 $log->debug("Request was handled internally", DEBUG);
 252         }
 253
 254         return 1;
 255
 256 }
 257
 258
 259
 260 # handle server side message processing
 261
 262 # !!! Returning 0 means that we don't want to pass ourselves up to the message layer !!!
 263 sub do_server {
 264         my( $self, $session, $mtype, $api_level, $tT ) = @_;
 265
 266         # A Server should never receive STATUS or RESULT messages.  If so, we drop them.
 267         # This is to keep STATUS/RESULT's from dead client sessions from creating new server
 268         # sessions which send mangled session exceptions to backends for messages
 269         # that they are not aware of any more.
 270     if( $mtype eq 'STATUS' or $mtype eq 'RESULT' ) { return 0; }
 271
 272
 273         if ($mtype eq 'DISCONNECT') {
 274                 $session->disconnect;
 275                 $session->kill_me;
 276                 return 0;
 277         }
 278
 279         if ($session->state == $session->CONNECTING()) {
 280
 281                 if($mtype ne "CONNECT" and $session->stateless) {
 282                         return 1; #pass the message up the stack
 283                 }
 284
 285                 # the transport layer thinks this is a new connection. is it?
 286                 unless ($mtype eq 'CONNECT') {
 287                         $log->error("Connection seems to be mangled: Got $mtype instead of CONNECT");
 288
 289                         my $res = OpenSRF::DomainObject::oilsBrokenSession->new(
 290                                         status => "Connection seems to be mangled: Got $mtype instead of CONNECT",
 291                         );
 292
 293                         $session->status($res);
 294                         $session->kill_me;
 295                         return 0;
 296
 297                 }
 298
 299                 my $res = OpenSRF::DomainObject::oilsConnectStatus->new;
 300                 $session->status($res);
 301                 $session->state( $session->CONNECTED );
 302
 303                 return 0;
 304         }
 305
 306
 307         return 1;
 308
 309 }
 310
 311
 312 # Handle client side message processing. Return 1 when the the message should be pushed
 313 # up to the application layer.  return 0 otherwise.
 314 sub do_client {
 315
 316         my( $self, $session , $mtype, $api_level, $tT) = @_;
 317
 318
 319         if ($mtype eq 'STATUS') {
 320
 321                 if ($self->payload->statusCode == STATUS_OK) {
 322                         $session->state($session->CONNECTED);
 323                         $log->debug(sub{return "We connected successfully to ".$session->app });
 324                         return 0;
 325                 }
 326
 327                 if ($self->payload->statusCode == STATUS_TIMEOUT) {
 328                         $session->state( $session->DISCONNECTED );
 329                         $session->reset;
 330                         $session->connect;
 331                         $session->push_resend( $session->app_request($self->threadTrace) );
 332                         $log->debug("Disconnected because of timeout");
 333                         return 0;
 334
 335                 } elsif ($self->payload->statusCode == STATUS_REDIRECTED) {
 336                         $session->state( $session->DISCONNECTED );
 337                         $session->reset;
 338                         $session->connect;
 339                         $session->push_resend( $session->app_request($self->threadTrace) );
 340                         $log->debug("Disconnected because of redirect", WARN);
 341                         return 0;
 342
 343                 } elsif ($self->payload->statusCode == STATUS_EXPFAILED) {
 344                         $session->state( $session->DISCONNECTED );
 345                         $log->debug("Disconnected because of mangled session", WARN);
 346                         $session->reset;
 347                         $session->push_resend( $session->app_request($self->threadTrace) );
 348                         return 0;
 349
 350                 } elsif ($self->payload->statusCode == STATUS_CONTINUE) {
 351                         $session->reset_request_timeout($self->threadTrace);
 352                         return 0;
 353
 354                 } elsif ($self->payload->statusCode == STATUS_COMPLETE) {
 355                         my $req = $session->app_request($self->threadTrace);
 356                         $req->complete(1) if ($req);
 357                         return 0;
 358                 }
 359
 360                 # add more STATUS handling code here (as 'elsif's), for Message layer status stuff
 361
 362                 #$session->state( $session->DISCONNECTED() );
 363                 #$session->reset;
 364
 365         } elsif ($session->state == $session->CONNECTING()) {
 366                 # This should be changed to check the type of response (is it a connectException?, etc.)
 367         }
 368
 369         if( $self->payload and $self->payload->isa( "ERROR" ) ) {
 370                 if ($session->raise_remote_errors) {
 371                         $self->payload->throw();
 372                 }
 373         }
 374
 375         $log->debug(sub{return "oilsMessage passing to Application: " . $self->type." : ".$session->remote_id });
 376
 377         return 1;
 378
 379 }
 380
 381 1;