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         $log->debug("Before ALL", DEBUG);
 164
 165         my $val;
 166         if ( $session->endpoint == $session->SERVER() ) {
 167                 $val = $self->do_server( $session, $mtype, $api_level, $tT );
 168
 169         } elsif ($session->endpoint == $session->CLIENT()) {
 170                 $val = $self->do_client( $session, $mtype, $api_level, $tT );
 171         }
 172
 173         if( $val ) {
 174                 return OpenSRF::Application->handler($session, $self->payload);
 175         }
 176
 177         return 1;
 178
 179 }
 180
 181
 182
 183 # handle server side message processing
 184
 185 # !!! Returning 0 means that we don't want to pass ourselves up to the message layer !!!
 186 sub do_server {
 187         my( $self, $session, $mtype, $api_level, $tT ) = @_;
 188
 189         # A Server should never receive STATUS messages.  If so, we drop them.
 190         # This is to keep STATUS's from dead client sessions from creating new server
 191         # sessions which send mangled session exceptions to backends for messages
 192         # that they are not aware of any more.
 193         if( $mtype eq 'STATUS' ) { return 0; }
 194
 195
 196         if ($mtype eq 'DISCONNECT') {
 197                 $session->disconnect;
 198                 $session->kill_me;
 199                 return 0;
 200         }
 201
 202         if ($session->state == $session->CONNECTING()) {
 203
 204                 # the transport layer thinks this is a new connection. is it?
 205                 unless ($mtype eq 'CONNECT') {
 206                         $log->error("Connection seems to be mangled: Got $mtype instead of CONNECT");
 207
 208                         my $res = OpenSRF::DomainObject::oilsBrokenSession->new(
 209                                         status => "Connection seems to be mangled: Got $mtype instead of CONNECT",
 210                         );
 211
 212                         $session->status($res);
 213                         $session->kill_me;
 214                         return 0;
 215
 216                 }
 217
 218                 my $res = OpenSRF::DomainObject::oilsConnectStatus->new;
 219                 $session->status($res);
 220                 $session->state( $session->CONNECTED );
 221
 222                 return 0;
 223         }
 224
 225
 226         $log->debug("Passing to Application::handler()", INFO);
 227         $log->debug($self->toString(1), DEBUG);
 228
 229         return 1;
 230
 231 }
 232
 233
 234 # Handle client side message processing. Return 1 when the the message should be pushed
 235 # up to the application layer.  return 0 otherwise.
 236 sub do_client {
 237
 238         my( $self, $session , $mtype, $api_level, $tT) = @_;
 239
 240
 241         if ($mtype eq 'STATUS') {
 242
 243                 if ($self->payload->statusCode == STATUS_OK) {
 244                         $session->state($session->CONNECTED);
 245                         $log->debug("We connected successfully to ".$session->app, INFO);
 246                         return 0;
 247                 }
 248
 249                 if ($self->payload->statusCode == STATUS_TIMEOUT) {
 250                         $session->state( $session->DISCONNECTED );
 251                         $session->reset;
 252                         $session->push_resend( $session->app_request($self->threadTrace) );
 253                         $log->debug("Disconnected because of timeout", WARN);
 254                         return 0;
 255
 256                 } elsif ($self->payload->statusCode == STATUS_REDIRECTED) {
 257                         $session->state( $session->DISCONNECTED );
 258                         $session->reset;
 259                         $session->push_resend( $session->app_request($self->threadTrace) );
 260                         $log->debug("Disconnected because of redirect", WARN);
 261                         return 0;
 262
 263                 } elsif ($self->payload->statusCode == STATUS_EXPFAILED) {
 264                         $session->state( $session->DISCONNECTED );
 265                         $log->debug("Disconnected because of mangled session", WARN);
 266                         $session->reset;
 267                         $session->push_resend( $session->app_request($self->threadTrace) );
 268                         return 0;
 269
 270                 } elsif ($self->payload->statusCode == STATUS_CONTINUE) {
 271                         return 0;
 272
 273                 } elsif ($self->payload->statusCode == STATUS_COMPLETE) {
 274                         my $req = $session->app_request($self->threadTrace);
 275                         $req->complete(1) if ($req);
 276                         return 0;
 277                 }
 278
 279                 # add more STATUS handling code here (as 'elsif's), for Message layer status stuff
 280
 281         } elsif ($session->state == $session->CONNECTING()) {
 282                 # This should be changed to check the type of response (is it a connectException?, etc.)
 283         }
 284
 285         if( $self->payload and $self->payload->class->isa( "OpenSRF::EX" ) ) {
 286                 $self->payload->throw();
 287         }
 288
 289         if( $self->payload ) {
 290                 $log->debug("Passing to OpenSRF::Application::handler()\n" . $self->payload->toString(1), INTERNAL);
 291         }
 292         $log->debug("oilsMessage passing to Application: " . $self->type." : ".$session->remote_id, INFO );
 293
 294         return 1;
 295
 296 }
 297
 298 1;