OpenSRF/src/perlmods/OpenSRF/DomainObject/oilsMessage.pm

   1 package OpenSRF::DomainObject::oilsMessage;
   2 use 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
   9 JSON->register_class_hint(hint => 'osrfMessage', name => 'OpenSRF::DomainObject::oilsMessage', type => 'hash');
  10
  11 sub toString {
  12         my $self = shift;
  13         my $pretty = shift;
  14         return JSON->perl2prettyJSON($self) if ($pretty);
  15         return JSON->perl2JSON($self);
  16 }
  17
  18 sub new {
  19         my $self = shift;
  20         my $class = ref($self) || $self;
  21         my %args = @_;
  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->threadTrace( [$new_threadTrace] );
  90
  91 =over 4
  92
  93 Sets or gets the current message sequence identifier, or thread trace number,
  94 for a message.  Useful as a debugging aid, but that's about it.
  95
  96 =back
  97
  98 =cut
  99
 100 sub threadTrace {
 101         my $self = shift;
 102         my $val = shift;
 103         $self->{threadTrace} = $val if (defined $val);
 104         return $self->{threadTrace};
 105 }
 106
 107 =head2 OpenSRF::DomainObject::oilsMessage->update_threadTrace
 108
 109 =over 4
 110
 111 Increments the threadTrace component of a message.  This is automatic when
 112 using the normal session processing stack.
 113
 114 =back
 115
 116 =cut
 117
 118 sub update_threadTrace {
 119         my $self = shift;
 120         my $tT = $self->threadTrace;
 121
 122         $tT ||= 0;
 123         $tT++;
 124
 125         $log->debug("Setting threadTrace to $tT",DEBUG);
 126
 127         $self->threadTrace($tT);
 128
 129         return $tT;
 130 }
 131
 132 =head2 OpenSRF::DomainObject::oilsMessage->payload( [$new_payload] )
 133
 134 =over 4
 135
 136 Sets or gets the payload of a message.  This should be exactly one object
 137 of (sub)type domainObject or domainObjectCollection.
 138
 139 =back
 140
 141 =cut
 142
 143 sub payload {
 144         my $self = shift;
 145         my $val = shift;
 146         $self->{payload} = $val if (defined $val);
 147         return $self->{payload};
 148 }
 149
 150 =head2 OpenSRF::DomainObject::oilsMessage->handler( $session_id )
 151
 152 =over 4
 153
 154 Used by the message processing stack to set session state information from the current
 155 message, and then sends control (via the payload) to the Application layer.
 156
 157 =back
 158
 159 =cut
 160
 161 sub handler {
 162         my $self = shift;
 163         my $session = shift;
 164
 165         my $mtype = $self->type;
 166         my $api_level = $self->api_level || 1;;
 167         my $tT = $self->threadTrace;
 168
 169         $session->last_message_type($mtype);
 170         $session->last_message_api_level($api_level);
 171         $session->last_threadTrace($tT);
 172
 173         $log->debug(" Received api_level => [$api_level], MType => [$mtype], ".
 174                         "from [".$session->remote_id."], threadTrace[".$self->threadTrace."]", INFO);
 175         $log->debug("endpoint => [".$session->endpoint."]", DEBUG);
 176         $log->debug("OpenSRF::AppSession->SERVER => [".$session->SERVER()."]", DEBUG);
 177
 178
 179         my $val;
 180         if ( $session->endpoint == $session->SERVER() ) {
 181                 $val = $self->do_server( $session, $mtype, $api_level, $tT );
 182
 183         } elsif ($session->endpoint == $session->CLIENT()) {
 184                 $val = $self->do_client( $session, $mtype, $api_level, $tT );
 185         }
 186
 187         if( $val ) {
 188                 $log->debug("Passing request up to OpenSRF::Application", DEBUG);
 189                 return OpenSRF::Application->handler($session, $self->payload);
 190         } else {
 191                 $log->debug("Request was handled internally", DEBUG);
 192         }
 193
 194         return 1;
 195
 196 }
 197
 198
 199
 200 # handle server side message processing
 201
 202 # !!! Returning 0 means that we don't want to pass ourselves up to the message layer !!!
 203 sub do_server {
 204         my( $self, $session, $mtype, $api_level, $tT ) = @_;
 205
 206         # A Server should never receive STATUS messages.  If so, we drop them.
 207         # This is to keep STATUS's from dead client sessions from creating new server
 208         # sessions which send mangled session exceptions to backends for messages
 209         # that they are not aware of any more.
 210         if( $mtype eq 'STATUS' ) { return 0; }
 211
 212
 213         if ($mtype eq 'DISCONNECT') {
 214                 $session->disconnect;
 215                 $session->kill_me;
 216                 return 0;
 217         }
 218
 219         if ($session->state == $session->CONNECTING()) {
 220
 221                 if($mtype ne "CONNECT" and $session->stateless) {
 222                         $log->debug("Got message Stateless", DEBUG);
 223                         return 1; #pass the message up the stack
 224                 }
 225
 226                 # the transport layer thinks this is a new connection. is it?
 227                 unless ($mtype eq 'CONNECT') {
 228                         $log->error("Connection seems to be mangled: Got $mtype instead of CONNECT");
 229
 230                         my $res = OpenSRF::DomainObject::oilsBrokenSession->new(
 231                                         status => "Connection seems to be mangled: Got $mtype instead of CONNECT",
 232                         );
 233
 234                         $session->status($res);
 235                         $session->kill_me;
 236                         return 0;
 237
 238                 }
 239
 240                 my $res = OpenSRF::DomainObject::oilsConnectStatus->new;
 241                 $session->status($res);
 242                 $session->state( $session->CONNECTED );
 243
 244                 return 0;
 245         }
 246
 247
 248         $log->debug("Passing to Application::handler()", INFO);
 249
 250         return 1;
 251
 252 }
 253
 254
 255 # Handle client side message processing. Return 1 when the the message should be pushed
 256 # up to the application layer.  return 0 otherwise.
 257 sub do_client {
 258
 259         my( $self, $session , $mtype, $api_level, $tT) = @_;
 260
 261
 262         if ($mtype eq 'STATUS') {
 263
 264                 if ($self->payload->statusCode == STATUS_OK) {
 265                         $session->state($session->CONNECTED);
 266                         $log->debug("We connected successfully to ".$session->app, INFO);
 267                         return 0;
 268                 }
 269
 270                 if ($self->payload->statusCode == STATUS_TIMEOUT) {
 271                         $session->state( $session->DISCONNECTED );
 272                         $session->reset;
 273                         $session->connect;
 274                         $session->push_resend( $session->app_request($self->threadTrace) );
 275                         $log->debug("Disconnected because of timeout", WARN);
 276                         return 0;
 277
 278                 } elsif ($self->payload->statusCode == STATUS_REDIRECTED) {
 279                         $session->state( $session->DISCONNECTED );
 280                         $session->reset;
 281                         $session->connect;
 282                         $session->push_resend( $session->app_request($self->threadTrace) );
 283                         $log->debug("Disconnected because of redirect", WARN);
 284                         return 0;
 285
 286                 } elsif ($self->payload->statusCode == STATUS_EXPFAILED) {
 287                         $session->state( $session->DISCONNECTED );
 288                         $log->debug("Disconnected because of mangled session", WARN);
 289                         $session->reset;
 290                         $session->push_resend( $session->app_request($self->threadTrace) );
 291                         return 0;
 292
 293                 } elsif ($self->payload->statusCode == STATUS_CONTINUE) {
 294                         $session->reset_request_timeout($self->threadTrace);
 295                         return 0;
 296
 297                 } elsif ($self->payload->statusCode == STATUS_COMPLETE) {
 298                         my $req = $session->app_request($self->threadTrace);
 299                         $req->complete(1) if ($req);
 300                         return 0;
 301                 }
 302
 303                 # add more STATUS handling code here (as 'elsif's), for Message layer status stuff
 304
 305         } elsif ($session->state == $session->CONNECTING()) {
 306                 # This should be changed to check the type of response (is it a connectException?, etc.)
 307         }
 308
 309         if( $self->payload and $self->payload->isa( "OpenSRF::EX" ) ) {
 310                 $self->payload->throw();
 311         }
 312
 313         $log->debug("oilsMessage passing to Application: " . $self->type." : ".$session->remote_id );
 314
 315         return 1;
 316
 317 }
 318
 319 1;