src/perlmods/OpenSRF/DomainObject/oilsMessage.pm

   1 package OpenSRF::DomainObject::oilsMessage;
   2 use base 'OpenSRF::DomainObject';
   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 =head1 NAME
  10
  11 OpenSRF::DomainObject::oilsMessage
  12
  13 =head1
  14
  15 use OpenSRF::DomainObject::oilsMessage;
  16
  17 my $msg = OpenSRF::DomainObject::oilsMessage->new( type => 'CONNECT' );
  18
  19 $msg->payload( $domain_object );
  20
  21 =head1 ABSTRACT
  22
  23 OpenSRF::DomainObject::oilsMessage is used internally to wrap data sent
  24 between client and server.  It provides the structure needed to authenticate
  25 session data, and also provides the logic needed to unwrap session data and
  26 pass this information along to the Application Layer.
  27
  28 =cut
  29
  30 my $log = 'OpenSRF::Utils::Logger';
  31
  32 =head1 METHODS
  33
  34 =head2 OpenSRF::DomainObject::oilsMessage->type( [$new_type] )
  35
  36 =over 4
  37
  38 Used to specify the type of message.  One of
  39 B<CONNECT, REQUEST, RESULT, STATUS, ERROR, or DISCONNECT>.
  40
  41 =back
  42
  43 =cut
  44
  45 sub type {
  46         my $self = shift;
  47         return $self->_attr_get_set( type => shift );
  48 }
  49
  50 =head2 OpenSRF::DomainObject::oilsMessage->api_level( [$new_api_level] )
  51
  52 =over 4
  53
  54 Used to specify the api_level of message.  Currently, only api_level C<1> is
  55 supported.  This will be used to check that messages are well-formed, and as
  56 a hint to the Application as to which version of a method should fulfill a
  57 REQUEST message.
  58
  59 =back
  60
  61 =cut
  62
  63 sub api_level {
  64         my $self = shift;
  65         return $self->_attr_get_set( api_level => shift );
  66 }
  67
  68 =head2 OpenSRF::DomainObject::oilsMessage->threadTrace( [$new_threadTrace] );
  69
  70 =over 4
  71
  72 Sets or gets the current message sequence identifier, or thread trace number,
  73 for a message.  Useful as a debugging aid, but that's about it.
  74
  75 =back
  76
  77 =cut
  78
  79 sub threadTrace {
  80         my $self = shift;
  81         return $self->_attr_get_set( threadTrace => shift );
  82 }
  83
  84 =head2 OpenSRF::DomainObject::oilsMessage->update_threadTrace
  85
  86 =over 4
  87
  88 Increments the threadTrace component of a message.  This is automatic when
  89 using the normal session processing stack.
  90
  91 =back
  92
  93 =cut
  94
  95 sub update_threadTrace {
  96         my $self = shift;
  97         my $tT = $self->threadTrace;
  98
  99         $tT ||= 0;
 100         $tT++;
 101
 102         $log->debug("Setting threadTrace to $tT",DEBUG);
 103
 104         $self->threadTrace($tT);
 105
 106         return $tT;
 107 }
 108
 109 =head2 OpenSRF::DomainObject::oilsMessage->payload( [$new_payload] )
 110
 111 =over 4
 112
 113 Sets or gets the payload of a message.  This should be exactly one object
 114 of (sub)type domainObject or domainObjectCollection.
 115
 116 =back
 117
 118 =cut
 119
 120 sub payload {
 121         my $self = shift;
 122         my $new_pl = shift;
 123
 124         my ($payload) = $self->getChildrenByTagName('oils:domainObjectCollection') ||
 125                                 $self->getChildrenByTagName('oils:domainObject');
 126         if ($new_pl) {
 127                 $payload = $self->removeChild($payload) if ($payload);
 128                 $self->appendChild($new_pl);
 129                 return $new_pl unless ($payload);
 130         }
 131
 132         return OpenSRF::DOM::upcast($payload)->upcast if ($payload);
 133 }
 134
 135 =head2 OpenSRF::DomainObject::oilsMessage->handler( $session_id )
 136
 137 =over 4
 138
 139 Used by the message processing stack to set session state information from the current
 140 message, and then sends control (via the payload) to the Application layer.
 141
 142 =back
 143
 144 =cut
 145
 146 sub handler {
 147         my $self = shift;
 148         my $session = shift;
 149
 150         my $mtype = $self->type;
 151         my $api_level = $self->api_level || 1;;
 152         my $tT = $self->threadTrace;
 153
 154         $session->last_message_type($mtype);
 155         $session->last_message_api_level($api_level);
 156         $session->last_threadTrace($tT);
 157
 158         $log->debug(" Received api_level => [$api_level], MType => [$mtype], ".
 159                         "from [".$session->remote_id."], threadTrace[".$self->threadTrace."]", INFO);
 160         $log->debug("endpoint => [".$session->endpoint."]", DEBUG);
 161         $log->debug("OpenSRF::AppSession->SERVER => [".$session->SERVER()."]", DEBUG);
 162
 163
 164         my $val;
 165         if ( $session->endpoint == $session->SERVER() ) {
 166                 $val = $self->do_server( $session, $mtype, $api_level, $tT );
 167
 168         } elsif ($session->endpoint == $session->CLIENT()) {
 169                 $val = $self->do_client( $session, $mtype, $api_level, $tT );
 170         }
 171
 172         if( $val ) {
 173                 $log->debug("Passing request up to OpenSRF::Application", DEBUG);
 174                 return OpenSRF::Application->handler($session, $self->payload);
 175         } else {
 176                 $log->debug("Request was handled internally", DEBUG);
 177         }
 178
 179         return 1;
 180
 181 }
 182
 183
 184
 185 # handle server side message processing
 186
 187 # !!! Returning 0 means that we don't want to pass ourselves up to the message layer !!!
 188 sub do_server {
 189         my( $self, $session, $mtype, $api_level, $tT ) = @_;
 190
 191         # A Server should never receive STATUS messages.  If so, we drop them.
 192         # This is to keep STATUS's from dead client sessions from creating new server
 193         # sessions which send mangled session exceptions to backends for messages
 194         # that they are not aware of any more.
 195         if( $mtype eq 'STATUS' ) { return 0; }
 196
 197
 198         if ($mtype eq 'DISCONNECT') {
 199                 $session->disconnect;
 200                 $session->kill_me;
 201                 return 0;
 202         }
 203
 204         if ($session->state == $session->CONNECTING()) {
 205
 206                 if($mtype ne "CONNECT" and $session->stateless) {
 207                         $log->debug("Got message Stateless", DEBUG);
 208                         return 1; #pass the message up the stack
 209                 }
 210
 211                 # the transport layer thinks this is a new connection. is it?
 212                 unless ($mtype eq 'CONNECT') {
 213                         $log->error("Connection seems to be mangled: Got $mtype instead of CONNECT");
 214
 215                         my $res = OpenSRF::DomainObject::oilsBrokenSession->new(
 216                                         status => "Connection seems to be mangled: Got $mtype instead of CONNECT",
 217                         );
 218
 219                         $session->status($res);
 220                         $session->kill_me;
 221                         return 0;
 222
 223                 }
 224
 225                 my $res = OpenSRF::DomainObject::oilsConnectStatus->new;
 226                 $session->status($res);
 227                 $session->state( $session->CONNECTED );
 228
 229                 return 0;
 230         }
 231
 232
 233         $log->debug("Passing to Application::handler()", INFO);
 234         $log->debug($self->toString(1), DEBUG);
 235
 236         return 1;
 237
 238 }
 239
 240
 241 # Handle client side message processing. Return 1 when the the message should be pushed
 242 # up to the application layer.  return 0 otherwise.
 243 sub do_client {
 244
 245         my( $self, $session , $mtype, $api_level, $tT) = @_;
 246
 247
 248         if ($mtype eq 'STATUS') {
 249
 250                 if ($self->payload->statusCode == STATUS_OK) {
 251                         $session->state($session->CONNECTED);
 252                         $log->debug("We connected successfully to ".$session->app, INFO);
 253                         return 0;
 254                 }
 255
 256                 if ($self->payload->statusCode == STATUS_TIMEOUT) {
 257                         $session->state( $session->DISCONNECTED );
 258                         $session->reset;
 259                         $session->connect;
 260                         $session->push_resend( $session->app_request($self->threadTrace) );
 261                         $log->debug("Disconnected because of timeout", WARN);
 262                         return 0;
 263
 264                 } elsif ($self->payload->statusCode == STATUS_REDIRECTED) {
 265                         $session->state( $session->DISCONNECTED );
 266                         $session->reset;
 267                         $session->connect;
 268                         $session->push_resend( $session->app_request($self->threadTrace) );
 269                         $log->debug("Disconnected because of redirect", WARN);
 270                         return 0;
 271
 272                 } elsif ($self->payload->statusCode == STATUS_EXPFAILED) {
 273                         $session->state( $session->DISCONNECTED );
 274                         $log->debug("Disconnected because of mangled session", WARN);
 275                         $session->reset;
 276                         $session->push_resend( $session->app_request($self->threadTrace) );
 277                         return 0;
 278
 279                 } elsif ($self->payload->statusCode == STATUS_CONTINUE) {
 280                         $session->reset_request_timeout($self->threadTrace);
 281                         return 0;
 282
 283                 } elsif ($self->payload->statusCode == STATUS_COMPLETE) {
 284                         my $req = $session->app_request($self->threadTrace);
 285                         $req->complete(1) if ($req);
 286                         return 0;
 287                 }
 288
 289                 # add more STATUS handling code here (as 'elsif's), for Message layer status stuff
 290
 291         } elsif ($session->state == $session->CONNECTING()) {
 292                 # This should be changed to check the type of response (is it a connectException?, etc.)
 293         }
 294
 295         if( $self->payload and $self->payload->class->isa( "OpenSRF::EX" ) ) {
 296                 $self->payload->throw();
 297         }
 298
 299         if( $self->payload ) {
 300                 $log->debug("Passing to OpenSRF::Application::handler()\n" . $self->payload->toString(1), INTERNAL);
 301         }
 302         $log->debug("oilsMessage passing to Application: " . $self->type." : ".$session->remote_id, INFO );
 303
 304         return 1;
 305
 306 }
 307
 308 1;