Initial revision
[OpenSRF.git] / src / perlmods / OpenSRF / DomainObject / oilsMessage.pm
1 package OpenILS::DomainObject::oilsMessage;
2 use base 'OpenILS::DomainObject';
3 use OpenILS::AppSession;
4 use OpenILS::DomainObject::oilsResponse qw/:status/;
5 use OpenILS::Utils::Logger qw/:level/;
6 use warnings; use strict;
7 use OpenILS::EX qw/:try/;
8
9 =head1 NAME
10
11 OpenILS::DomainObject::oilsMessage
12
13 =head1
14
15 use OpenILS::DomainObject::oilsMessage;
16
17 my $msg = OpenILS::DomainObject::oilsMessage->new( type => 'CONNECT' );
18
19 $msg->userAuth( $userAuth_element );
20
21 $msg->payload( $domain_object );
22
23 =head1 ABSTRACT
24
25 OpenILS::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 = 'OpenILS::Utils::Logger';
33
34 =head1 METHODS
35
36 =head2 OpenILS::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 OpenILS::DomainObject::oilsMessage->protocol( [$new_protocol_number] )
53
54 =over 4
55
56 Used to specify the protocol of message.  Currently, only protocol 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 protocol {
66         my $self = shift;
67         return $self->_attr_get_set( protocol => shift );
68 }
69
70 =head2 OpenILS::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 OpenILS::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 OpenILS::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 OpenILS::DOM::upcast($payload)->upcast if ($payload);
135 }
136
137 =head2 OpenILS::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 OpenILS::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 $protocol = $self->protocol || 1;;
179         my $tT = $self->threadTrace;
180
181         $session->last_message_type($mtype);
182         $session->last_message_protocol($protocol);
183         $session->last_threadTrace($tT);
184
185         $log->debug(" Received protocol => [$protocol], MType => [$mtype], ".
186                         "from [".$session->remote_id."], threadTrace[".$self->threadTrace."]", INFO);
187         $log->debug("endpoint => [".$session->endpoint."]", DEBUG);
188         $log->debug("OpenILS::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, $protocol, $tT );
195
196         } elsif ($session->endpoint == $session->CLIENT()) {
197                 $val = $self->do_client( $session, $mtype, $protocol, $tT );
198         }
199
200         if( $val ) {
201                 return OpenILS::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, $protocol, $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 = OpenILS::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 = OpenILS::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 = OpenILS::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 = OpenILS::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, $protocol, $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( "OpenILS::EX" ) ) { 
334                 $self->payload->throw();
335         }
336
337         $log->debug("Passing to OpenILS::Application::handler()\n" . $self->payload->toString(1), INTERNAL);
338         $log->debug("oilsMessage passing to Application: " . $self->type." : ".$session->remote_id, INFO );
339
340         return 1;
341
342 }
343
344 1;