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