Open-ILS/src/perlmods/lib/OpenILS/Application/Trigger/Reactor/AstCall.pm

   1 package OpenILS::Application::Trigger::Reactor::AstCall;
   2 use base 'OpenILS::Application::Trigger::Reactor';
   3 use OpenSRF::Utils::Logger qw($logger);
   4 # use OpenILS::Application::AppUtils;
   5 use OpenILS::Utils::CStoreEditor qw/:funcs/;
   6
   7 use strict; use warnings;
   8 use Error qw/:try/;
   9 use Data::Dumper;
  10
  11 use OpenSRF::Utils::SettingsClient;
  12 use RPC::XML::Client;
  13 $Data::Dumper::Indent = 0;
  14
  15 my $U = 'OpenILS::Application::AppUtils';
  16
  17 # %last_channel_used is, per event def with params or the config file:
  18 # ~ index (not literal value) of last channel used in a callfile
  19 # ~ index is of position in the array of channels (zero-based)
  20 # ~ cached at package level
  21 # ~ typically for Zap (PSTN), not VOIP
  22
  23 our %last_channel_used = ();
  24 our $telephony;
  25
  26 sub ABOUT {
  27     return <<'ABOUT';
  28
  29     The AstCall reactor module creates a callfile for Asterisk, given a
  30     template describing the message and an environment defining
  31     necessary information for contacting the Asterisk server and scheduling
  32     a call with it.
  33
  34     If you have only one SIP server, you can set it up like this in the
  35     opensrf.xml configuration file:
  36
  37         <telephony>
  38             <!-- replace all values below when telephony server is configured -->
  39             <enabled>0</enabled>
  40             <driver>SIP</driver>    <!-- SIP (default) or multi -->
  41             <channels>              <!-- explicit list of channels used if multi -->
  42                                     <!-- A channel specifies technology/resource -->
  43                 <channel>Zap/1</channel>
  44                 <channel>Zap/2</channel>
  45                 <channel>IAX/user:secret@widgets.biz</channel>
  46             </channels>
  47             <host>localhost</host>
  48             <port>10080</port>
  49             <user>evergreen</user>
  50             <pw>evergreen</pw>
  51             <!--
  52                 The overall composition of callfiles is determined by the
  53                 relevant template, but this section can be invoked for callfile
  54                 configs common to all outbound calls.
  55                 callfile_lines will be inserted into ALL generated callfiles
  56                 after the Channel line.  This content mat be overridden
  57                 (in whole) by the org unit setting callfile_lines.
  58                 Warning: Invalid syntax may break ALL outbound calls.
  59             -->
  60             <!-- <callfile_lines>
  61                 MaxRetries: 3
  62                 RetryTime: 60
  63                 WaitTime: 30
  64                 Archive: 1
  65                 Extension: 10
  66             </callfile_lines> -->
  67         </telephony>
  68
  69     To support more than one SIP server, say, per library, you can use
  70     Action/Trigger parameters like these, which model the same information
  71     as above:
  72
  73             enabled = 0
  74             driver = "SIP"
  75             channels = ["Zap/1", "Zap/2", "IAX/user:secret@widgets.biz"]
  76             host = "localhost"
  77             port = "10080"
  78             user = "evergreen"
  79             pw = "evergreen"
  80             callfile_lines = ["MaxRetries: 3", "RetryTime: 60", "WaitTime: 30", "Archive: 1", "Extension: 10"]
  81
  82 ABOUT
  83 }
  84
  85 sub get_conf {
  86     my $part = shift;
  87     my $env = shift;
  88
  89     # get the part they want from the environment, if we have it
  90     return $env->{params}{$part} if ( $part && $env && exists $env->{params}{$part});
  91    # $logger->info(__PACKAGE__ . ": get_conf()");
  92
  93     # failing all of that, just fetch the config file if we don't have it
  94     if (!$telephony) {
  95         my $config = OpenSRF::Utils::SettingsClient->new;
  96         # config object cached by package
  97         $telephony = $config->config_value('notifications', 'telephony');
  98     }
  99
 100     # if they want a part, and we have the config file data, return that
 101     return $$telephony{$part} if ( $part && $telephony && exists $$telephony{$part});
 102
 103     # but if they don't want a part, and we have the whole config file thing, return it
 104     return $telephony;
 105 }
 106
 107 sub channels_from {
 108     my $env = shift;
 109
 110     # report the event def id if we get the channels from params
 111     return $env->{EventProcessor}{event}->event_def->id
 112         if ( exists $env->{params}{channels});
 113
 114     # else just say '*'
 115     return '*';
 116 }
 117
 118 sub get_channels {
 119     my $env = shift;
 120     @{ get_conf( channels => $env ) };
 121 }
 122
 123 sub next_channel {
 124     my $env = shift;
 125     # Increments $last_channel_used, or resets it to zero, as necessary.
 126     # Returns appropriate value from channels array.
 127     my $source = channels_from($env);
 128     my @chans = get_channels($env);
 129     unless(@chans) {
 130         $logger->error(__PACKAGE__ . ": Cannot build call using " .
 131             (shift ||'driver') .
 132             ", no notifications.telephony.channels found in config!");
 133         return;
 134     }
 135     if (++$last_channel_used{$source} > $#chans) {
 136         $last_channel_used{$source} = 0;
 137     }
 138     return $chans[$last_channel_used{$source}];     # say, 'Zap/1' or 'Zap/12'
 139 }
 140
 141 sub channel {
 142     my $env = shift;
 143     my $tech = get_conf( driver => $env ) || 'SIP';
 144     if ($tech !~ /^SIP/) {
 145         return next_channel($env, $tech);
 146     }
 147     return $tech;                          #  say, 'SIP' or 'SIP/ubab33'
 148 }
 149
 150 sub get_extra_lines {
 151     my $env = shift;
 152     my $lines = get_conf( callfile_lines => $env ) or return '';
 153     return '' if (ref($lines) && (ref($lines) !~ /ARRAY/));
 154     $lines = [ split "\n", $lines ] unless (ref($lines));
 155
 156     my @fixed;
 157     foreach (@$lines) {
 158         s/^\s*//g;      # strip leading spaces
 159         /\S/ or next;   # skip empty lines
 160         push @fixed, $_;
 161     }
 162     (scalar @fixed) or return '';
 163     return join("\n", @fixed) . "\n";
 164 }
 165
 166 sub host_string {
 167     my $env = shift;
 168     my $host = get_conf( host => $env );
 169     my $port = get_conf( port => $env );
 170
 171     unless ($host) {
 172         $logger->error(__PACKAGE__ . ": No telephony/host in config.");
 173         return;
 174     }
 175     $logger->info(__PACKAGE__ . ": host [$host], port [$port]");
 176
 177     # prepend http:// if no protocol specified
 178     if ($host !~ /^\S+:\/\//) {
 179         $host  = 'http://' . $host;
 180     }
 181     # append port number if specified
 182     if ($port) {
 183         $host .= ":" . $port;
 184     }
 185
 186     $logger->info(__PACKAGE__ . ": final host string [$host]");
 187     return $host;
 188 }
 189 sub rpc_client {
 190     # TODO: caching? (would take testing to ensure memory and
 191     # connections are clean/stable)
 192     my $host = (@_ ? shift : host_string()) or return;
 193     return new RPC::XML::Client($host);
 194 }
 195
 196 sub handler {
 197     my ($self, $env) = @_;
 198
 199     my $e = new_editor(xact => 1);
 200
 201     $logger->info(__PACKAGE__ . ": entered handler");
 202
 203     # assignment, not comparison
 204     unless ($env->{channel_prefix} = channel($env)) {
 205         $logger->error(__PACKAGE__ . ": Cannot find tech/resource in config");
 206         return 0;
 207     }
 208
 209     $env->{extra_lines} = get_extra_lines($env) || '';
 210     my $tmpl_output = $self->run_TT($env);
 211     if (not $tmpl_output) {
 212         $logger->error(__PACKAGE__ . ": no template input");
 213         return 0;
 214     }
 215
 216     my @eventids = map {$_->id} @{$env->{event}};
 217     @eventids or push @eventids, '';
 218
 219     my $eo = Fieldmapper::action_trigger::event_output->new;
 220
 221     # XXX we have to actually create this in the DB now if we expect to use the
 222     # ID later
 223     $eo->data("");
 224     $eo = $e->create_action_trigger_event_output($eo) or return $e->die_event;
 225     if ($env->{"extra_lines"}) {
 226         $tmpl_output .= ";; added by handler:\n";
 227         $tmpl_output .= $env->{"extra_lines"};
 228     }
 229
 230     my $eventids_str = join(",", @eventids);
 231
 232     # Stuff the call file with data about A/T event IDs and related things,
 233     # for other processes to pick up on later.
 234
 235     $tmpl_output =~ s/^(Account:.+)$/$1 . "," . $eventids_str/gem;
 236     $tmpl_output .= "; event_ids = " . $eventids_str . "\n";
 237     $tmpl_output .= "; event_output = " . $eo->id . "\n";
 238
 239     #my $filename_fragment = $userid . '_' . $eventids[0] . 'uniq' . time;
 240     # not $noticetype,
 241     # the event_output.id tells us all we need to know
 242     # XXX why is id in here twice?
 243     my $filename_fragment = $eo->id . '_' . $eo->id;
 244
 245     # TODO: add scheduling intelligence and use it here... or not if
 246     # relying only on crontab
 247     my $client = rpc_client(host_string($env));
 248     my $resp = $client->send_request(
 249         'inject', $tmpl_output, $filename_fragment, 0
 250     ); # FIXME: 0 could be seconds-from-epoch UTC if deferred call needed
 251
 252     $logger->debug(
 253         ref $resp ? ("Response: " . Dumper($resp->value)) : "Error: $resp"
 254     );
 255
 256     if ($resp->{code} and $resp->{code}->value == 200) {
 257         $eo->is_error('f');
 258         $eo->data('filename: ' . $resp->{spooled_filename}->value);
 259         # could look for the file that replaced it
 260     } else {
 261         $eo->is_error('t');
 262         my $msg = $resp->{faultcode} ? $resp->{faultcode}->value :
 263                     $resp->{     code} ? $resp->{     code}->value :
 264                         " -- UNKNOWN response '$resp'";
 265         $msg .= " for $filename_fragment";
 266         $eo->data("Error " . $msg);
 267         $logger->error(__PACKAGE__ . ": Mediator Error " . $msg);
 268     }
 269
 270     # Now point all our events' async_output to the newly made row
 271 #    $eo = $env->{EventProcessor}->editor->
 272 #        create_action_trigger_event_output( $eo );
 273     $e->update_action_trigger_event_output($eo) or return $e->die_event;
 274     foreach (@eventids) {
 275         my $event = $e->retrieve_action_trigger_event($_);
 276         $event->async_output($eo->id);
 277         $e->update_action_trigger_event($event);
 278     }
 279     $e->commit;    # defer till after loop?
 280
 281     # TODO: a sub for saving async_output might belong in Trigger.pm
 282     1;
 283 }
 284
 285 sub _files {
 286     my $response = shift or return;
 287     return map {$response->{$_}} sort grep {/^file_\d*/} keys %$response;
 288 }
 289
 290 =head1 EXAMPLE CALFILES
 291
 292 Note: all lines start flush left (no leading whitespace)
 293
 294 =head2 Example callfile (successful)
 295
 296     Channel: SIP/ubab33/17707775555
 297     Context: overdue-test
 298     MaxRetries: 1
 299     RetryTime: 60
 300     WaitTime: 30
 301     Extension: 10
 302     Archive: 1
 303     Set: items=1
 304     Set: titlestring=chez nos gens;; added by OpenILS::Application::Trigger::Reactor::AstCall handler:
 305     ; event_ids = 123,145
 306     ; event_output = 14;; added by inject() in the mediator
 307     Set: callfilename=EG_1258060382_6.call
 308
 309     StartRetry: 2139 1 (1258060442)
 310     Status: Completed
 311     Channel: SIP/ubab33/17707775555
 312
 313 =head2 Example callfile (FAILED)
 314
 315     CallerID: "Jack Jackson" <17707775555>
 316     Context: overdue-test
 317     MaxRetries: 1
 318     RetryTime: 60
 319     WaitTime: 30
 320     Extension: 10
 321     Archive: 1
 322     Set: items=1
 323     Set: titlestring=Land Before Time;; added by OpenILS::Application::Trigger::Reactor::AstCall handler:
 324     Set: LOOP=1
 325     Set: callfilename=EG_joe_20091109145355.call
 326
 327     StartRetry: 2139 1 (1257907526)
 328     ; FAILED: 0
 329
 330     EndRetry: 2139 1 (1257907496)
 331
 332     StartRetry: 2139 2 (1257907617)
 333     ; FAILED: 0
 334     Status: Expired
 335
 336 =head2 Possible data structure:
 337
 338  $feedback = {
 339      status => val,
 340      attempts => [ $attempt1, $attempt2 ... $attemptN ],
 341      anything_else => scalar,
 342  }
 343  ...
 344  $attempt = {
 345      time => secs from epoch (UTC) for the BEGINNING of the call,
 346      duration => secs,
 347      failed => code,
 348  }
 349
 350 =cut
 351
 352 sub feedback_hash {
 353     # parses the done callfile comments from Mediator
 354     # return ref to hash
 355     my $content  = shift or return;
 356     my %hash     = ();
 357     # my @attempts = ();
 358     my @lines    = split "\n", $content;
 359     foreach (shift @lines) {
 360         s/^\s*(Set:\s*)?//i;   # strip leading whitespace, and possible "Set:"
 361         if (/^StartRetry: \d+ (\d+) \((\d+)\)/) {
 362             # go parse  an attempt;
 363             # go record an attempt;
 364         }
 365         if (/^(Status):\s*(\S+)/i or /^;+\s*(FAILED):\s*(\S*)/i) {
 366             $hash{lc $1} = $2;
 367             next;
 368         }
 369
 370         /^;+\s*(\S+)\s*[=:]\s*([^;]*)$/ and $hash{lc $1} = $2;
 371     }
 372     if (exists $hash{failed}) {
 373         $hash{failcode} = $hash{failed};
 374         # b/c "0" is a common failcode and we want a more binary indicator
 375         $hash{failed}   = 1;
 376     }
 377     return \%hash;
 378 }
 379
 380 sub cleanup {
 381     my $self   = shift or return;
 382     my $files  = join(',',@_) or return;
 383     my $client = rpc_client();
 384     return $client->send_request('cleanup', $files);
 385     # TODO: more error checking
 386 }
 387
 388 sub retrieve {
 389         $logger->info("retrieve() not implemented. how'd we get here?"); # XXX
 390         return;
 391 }
 392
 393 #sub retrieve {
 394 #    my $self   = shift or return;
 395 #    my $client = rpc_client();
 396 #    my $resp   = $client->send_request('retrieve');
 397 #    unless ($resp and ref $resp) {
 398 #         $logger->error(
 399 #             __PACKAGE__ . ": Mediator Error: " .
 400 #             ($resp ? 'Bad' : 'No') . " response to retrieve request"
 401 #         );
 402 #         return;
 403 #    }
 404 #
 405 #    # my $count   = $resp{match_count}; # how many files we should have
 406 #    # my @rm_list = ();
 407 #    my @files   = _files($resp);
 408 #    foreach (@files) {
 409 #        my $content  = $resp->{$_}->content;
 410 #        my $filename = $resp->{$_}->filename;
 411 #        unless ($content) {
 412 #            $logger->error(__PACKAGE__ .
 413 #                ": Mediator sent incomplete/unintelligible message for " .
 414 #                "filename " . ($filename || 'UNKNOWN'));
 415 #            next;
 416 #        }
 417 #        my $feedback = feedback_hash($content);
 418 #        my $output   = $e->retrieve_action_trigger_event_output(
 419 #            $feedback->{event_output}
 420 #        );
 421 #        if ($content == $output->data) {
 422 #            $logger->error(
 423 #                __PACKAGE__ . ": Mediator sent duplicate file "
 424 #                . $resp->{$_}->filename . " for event_output " .
 425 #                $feedback->{event_output}
 426 #            );
 427 #        } else {
 428 #            $output->data($content);
 429 #        }
 430 #        $e->commit;     # defer until after loop? probably not
 431 #        my $clean = $client->send_request('cleanup', $filename);
 432 #        # TODO: deletion by (comma-separated) filenames in chunks
 433 #        # instead of individually?
 434 #        # push @rm_list, $_; $client->send_request('cleanup', join(',',@rm_list));
 435 #        unless ($clean and ref $clean) {
 436 #            $logger->error(
 437 #                __PACKAGE__ . ": Mediator Error: " .
 438 #                ($clean ? 'Bad' : 'No') .
 439 #                " response to cleanup $filename request");
 440 #            next;
 441 #        }
 442 #        unless ($clean->{code}->value == 200 and $clean->{delete_count}) {
 443 #            $logger->error(__PACKAGE__ . ": cleanup $filename returned " . (
 444 #                $resp->{faultcode} ? $resp->{faultcode}->value :
 445 #                    $resp->{     code} ? $resp->{     code}->value :
 446 #                        " -- UNKNOWN response '$resp'"
 447 #            ) . " with delete_count " .
 448 #            (defined $clean->{delete_count} ? $clean->{delete_count} : 'UNDEF'));
 449 #        }
 450 #    }
 451 #    return @files;
 452 #}
 453
 454 1;