FS/FS/Cron/check.pm

   1 package FS::Cron::check;
   2
   3 use strict;
   4 use vars qw( @ISA @EXPORT_OK $DEBUG $FS_RUN $error_msg
   5              $SELFSERVICE_USER $SELFSERVICE_MACHINES @SELFSERVICE_MACHINES
   6            );
   7 use Exporter;
   8 use LWP::UserAgent;
   9 use HTTP::Request;
  10 use URI::Escape;
  11 use Email::Send;
  12 use FS::Conf;
  13 use FS::Record qw(qsearch);
  14 use FS::cust_pay_pending;
  15
  16 @ISA = qw( Exporter );
  17 @EXPORT_OK = qw(
  18   check_queued check_selfservice check_apache check_bop_failures
  19   check_sg check_sg_login check_sgng
  20   alert error_msg
  21 );
  22
  23 $DEBUG = 0;
  24
  25 $FS_RUN = '/var/run';
  26
  27 sub check_queued {
  28   _check_fsproc('queued');
  29 }
  30
  31 $SELFSERVICE_USER = '%%%SELFSERVICE_USER%%%';
  32
  33 $SELFSERVICE_MACHINES = '%%%SELFSERVICE_MACHINES%%%'; #substituted by Makefile
  34 $SELFSERVICE_MACHINES =~ s/^\s+//;
  35 $SELFSERVICE_MACHINES =~ s/\s+$//;
  36 @SELFSERVICE_MACHINES = split(/\s+/, $SELFSERVICE_MACHINES);
  37 @SELFSERVICE_MACHINES = ()
  38   if scalar(@SELFSERVICE_MACHINES) == 1
  39   && $SELFSERVICE_MACHINES[0] eq '%%%'.'SELFSERVICE_MACHINES'.'%%%';
  40
  41 sub check_selfservice {
  42   foreach my $machine ( @SELFSERVICE_MACHINES ) {
  43     unless ( _check_fsproc("selfservice-server.$SELFSERVICE_USER.$machine") ) {
  44       $error_msg = "Self-service daemon not running for $machine";
  45       return 0;
  46     }
  47   }
  48   return 1;
  49 }
  50
  51 sub check_sg {
  52   my $conf = new FS::Conf;
  53   #different trigger if they ever stop using multicustomer_hack ?
  54   return 1 unless $conf->exists('sg-multicustomer_hack');
  55
  56   my $ua = new LWP::UserAgent;
  57   $ua->agent("FreesideCronCheck/0.1 " . $ua->agent);
  58
  59   my $USER = $conf->config('sg-ping_username');
  60   my $PASS = $conf->config('sg-ping_password');
  61   my $req = new HTTP::Request GET=>"https://$USER:$PASS\@localhost/sg/ping.cgi";
  62   my $res = $ua->request($req);
  63
  64   return 1 if $res->is_success
  65            && $res->content =~ /OK/
  66            && $res->content !~ /error/i; #doh, the error message includes "OK"
  67
  68   $error_msg = $res->is_success ? $res->content : $res->status_line;
  69   return 0;
  70 }
  71
  72 sub check_sg_login {
  73   my $conf = new FS::Conf;
  74   #different trigger if they ever stop using multicustomer_hack ?
  75   return 1 unless $conf->exists('sg-multicustomer_hack');
  76
  77   my $ua = new LWP::UserAgent;
  78   $ua->agent("FreesideCronCheck/0.1 " . $ua->agent);
  79
  80   my $USER = $conf->config('sg-ping_username');
  81   my $PASS = $conf->config('sg-ping_password');
  82   my $USERNAME = $conf->config('sg-login_username');
  83   my $req = new HTTP::Request
  84     GET=>"https://$USER:$PASS\@localhost/sg/start.cgi?".
  85          'username='. uri_escape($USERNAME);
  86   my $res = $ua->request($req);
  87
  88   return 1 if $res->is_success
  89            && $res->content =~ /[\da-f]{32}/i #session_id
  90            && $res->content !~ /error/i;
  91
  92   $error_msg = $res->is_success ? $res->content : $res->status_line;
  93   return 0;
  94 }
  95
  96 sub check_sgng {
  97   my $conf = new FS::Conf;
  98   #different trigger if they ever stop using multicustomer_hack ?
  99   return 1 unless $conf->exists('sg-multicustomer_hack');
 100
 101   eval 'use RPC::XML; use RPC::XML::Client;';
 102   if ($@) { $error_msg = $@; return 0; };
 103
 104   my $cli = RPC::XML::Client->new('https://localhost/selfservice/xmlrpc.cgi');
 105   my $resp = $cli->send_request('FS.SelfService.XMLRPC.ping');
 106
 107   return 1 if ref($resp)
 108            && ! $resp->is_fault
 109            && ref($resp->value)
 110            && $resp->value->{'pong'} == 1;
 111
 112   #hua
 113   $error_msg = ref($resp)
 114                  ? ( $resp->is_fault
 115                        ? $resp->string
 116                        : ( ref($resp->value) ? $resp->value->{'error'}
 117                                              : $resp->value
 118                          )
 119                  )
 120                  : $resp;
 121   return 0;
 122 }
 123
 124 sub _check_fsproc {
 125   my $arg = shift;
 126   _check_pidfile( "freeside-$arg.pid" );
 127 }
 128
 129 sub _check_pidfile {
 130   my $pidfile = shift;
 131   open(PID, "$FS_RUN/$pidfile") or return 0;
 132   chomp( my $pid = scalar(<PID>) );
 133   close PID; # or return 0;
 134
 135   $pid && kill 0, $pid;
 136 }
 137
 138 sub check_apache {
 139   my $ua = new LWP::UserAgent;
 140   $ua->agent("FreesideCronCheck/0.1 " . $ua->agent);
 141
 142   my $req = new HTTP::Request GET => 'https://localhost/';
 143   my $res = $ua->request($req);
 144
 145   return 1 if $res->is_success || $res->status_line =~ /^403/;
 146   $error_msg = $res->status_line;
 147   return 0;
 148
 149 }
 150
 151 #and now for something entirely different...
 152 my $num_consecutive_bop_failures = 60;
 153 sub check_bop_failures {
 154
 155   return 1 if grep { $_->statustext eq 'captured' }
 156                    qsearch({
 157                      'table'    => 'cust_pay_pending',
 158                      'hashref'  => { 'status' => 'done' },
 159                      'order_by' => 'ORDER BY paypendingnum DESC'.
 160                                    " LIMIT $num_consecutive_bop_failures",
 161                    });
 162   $error_msg = "Last $num_consecutive_bop_failures real-time payments failed";
 163   return 0;
 164 }
 165
 166 #
 167
 168 sub error_msg {
 169   $error_msg;
 170 }
 171
 172 sub alert {
 173   my( $alert, @emails ) = @_;
 174
 175   my $conf = new FS::Conf;
 176   my $smtpmachine = $conf->config('smtpmachine');
 177   my $company_name = $conf->config('company_name');
 178
 179   foreach my $email (@emails) {
 180     warn "warning $email about $alert\n" if $DEBUG;
 181
 182     my $message = <<"__MESSAGE__";
 183 From: support\@freeside.biz
 184 To: $email
 185 Subject: FREESIDE ALERT for $company_name
 186
 187 FREESIDE ALERT: $alert
 188
 189 __MESSAGE__
 190
 191     my $sender = Email::Send->new({ mailer => 'SMTP' });
 192     $sender->mailer_args([ Host => $smtpmachine ]);
 193     $sender->send($message);
 194
 195   }
 196
 197 }
 198
 199 1;
 200