Open-ILS/src/asterisk/pbx-daemon/eg-pbx-smart-retry.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3
   4 # Even though this program looks like a daemon, you don't actually want to
   5 # run it as one.  It's meant to be called (with -d option) from an Asterisk
   6 # dialplan and return immediately, doing its work in the background.
   7 #
   8 # That's why it *looks* like a daemon, but you don't run this from your
   9 # system init scripts or anything.
  10 #
  11 # This script's purpose is to remove callfiles from the spool after each
  12 # attempt Asterisk makes with it.  If the callfile dictates, say, 5 attempts
  13 # and the first attempt results in a busy signal or something, Asterisk will
  14 # update the callfile (within smart_retry_delay seconds) to reduce the number
  15 # of remaining attempts, and then we take this callfile out of the spool
  16 # and put it back in the staging path so that we can use Asterisk to make
  17 # some other phone calls while we wait for the retry timeout on this call
  18 # to expire.
  19
  20 use Getopt::Std;
  21 use File::Basename;
  22 use Config::General qw/ParseConfig/;
  23 use POSIX 'setsid';
  24
  25 sub daemonize {
  26    chdir '/'               or die "Can't chdir to /: $!";
  27    open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
  28    open STDOUT, '>/dev/null'
  29                            or die "Can't write to /dev/null: $!";
  30    defined(my $pid = fork) or die "Can't fork: $!";
  31    exit if $pid;
  32    setsid                  or die "Can't start a new session: $!";
  33    open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
  34 }
  35
  36 sub smart_retry {
  37     my ($config, $filename) = @_;
  38
  39     my $delay = $config->{smart_retry_delay} || 5;
  40     my $padding = $config->{smart_retry_padding} || 5;
  41
  42     my $src = $config->{spool_path} . '/' . $filename;
  43     my $dest = $config->{staging_path} . '/' . $filename;
  44
  45     return 3 unless -r $src;
  46
  47     sleep($delay);
  48
  49     my $src_mtime = (stat($src))[9];
  50
  51     # next retry is about to happen, no need to remove from spool
  52     return 2 unless $src_mtime > (time + $padding);
  53
  54     print STDERR "rename($src, $dest)\n";
  55     rename($src, $dest) or return 1;
  56     return 0;
  57 }
  58
  59 sub main {
  60     my %opts = (
  61         'c' => '/etc/eg-pbx-daemon.conf',   # config file
  62         'd' => 0    # daemon?
  63     );
  64     getopts('dc:f:', \%opts);
  65
  66     my $usage = "usage: $0 -c config_filename -f spooled_filename";
  67     die $usage unless $opts{f};
  68     die "$opts{c}: $!\n$usage" unless -r $opts{c};
  69
  70     my %config = ParseConfig($opts{c});
  71
  72     daemonize if $opts{d};
  73     return smart_retry(\%config, $opts{f});
  74 }
  75
  76 exit main;