LP#1739044: fix lock file detection in eg-pbx-allocator.pl
[Evergreen.git] / 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;