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