FS/bin/freeside-queued

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use vars qw( $DEBUG $kids $max_kids $sleep_time %kids );
   5 use POSIX qw(:sys_wait_h);
   6 use IO::File;
   7 use Getopt::Std;
   8 use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh myconnect);
   9 use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm);
  10 use FS::Conf;
  11 use FS::Record qw(qsearch);
  12 use FS::queue;
  13 use FS::queue_depend;
  14 use FS::queue_stat;
  15 use FS::Log;
  16 use FS::Cron::expire_user_pref qw( expire_user_pref );
  17
  18 # no autoloading for non-FS classes...
  19 use Net::SSH 0.07;
  20
  21 $DEBUG = 0;
  22
  23 $kids = 0;
  24
  25 &untaint_argv;  #what it sounds like  (eww)
  26 use vars qw(%opt);
  27 getopts('sn', \%opt );
  28
  29 my $user = shift or die &usage;
  30
  31 warn "starting daemonization (forking)\n" if $DEBUG;
  32 #daemonize1('freeside-queued',$user); #to keep pid files unique w/multi installs
  33 daemonize1('freeside-queued');
  34
  35 warn "dropping privledges\n" if $DEBUG;
  36 drop_root();
  37
  38 $ENV{HOME} = (getpwuid($>))[7]; #for ssh
  39
  40 warn "connecting to database\n" if $DEBUG;
  41 #$@ = 'not connected';
  42 #while ( $@ ) {
  43 #  eval { adminsuidsetup $user; };
  44 #  if ( $@ ) {
  45 #    warn $@;
  46 #    warn "sleeping for reconnect...\n";
  47 #    sleep 5;
  48 #  }
  49 #}
  50 adminsuidsetup $user;
  51
  52 my $log = FS::Log->new('queue');
  53 logfile( "%%%FREESIDE_LOG%%%/queuelog.". $FS::UID::datasrc );
  54
  55 warn "completing daemonization (detaching))\n" if $DEBUG;
  56 daemonize2();
  57
  58 #--
  59
  60 my $conf = new FS::Conf;
  61 $max_kids = $conf->config('queued-max_kids') || 10;
  62 $sleep_time = $conf->config('queued-sleep_time') || 10;
  63
  64 my $warnkids=0;
  65 while (1) {
  66
  67   &reap_kids;
  68   #prevent runaway forking
  69   if ( $kids >= $max_kids ) {
  70     warn "WARNING: maximum $kids children reached\n" unless $warnkids++;
  71     &reap_kids;
  72     expire_user_pref() unless $warnkids % 10;
  73     sleep 1; #waiting for signals is cheap
  74     next;
  75   }
  76   $warnkids=0;
  77
  78   unless ( dbh && dbh->ping ) {
  79     warn "WARNING: connection to database lost, reconnecting...\n";
  80
  81     eval { $FS::UID::dbh = myconnect; };
  82
  83     unless ( !$@ && dbh && dbh->ping ) {
  84       warn "WARNING: still no connection to database, sleeping for retry...\n";
  85       sleep 10;
  86       next;
  87     } else {
  88       warn "WARNING: reconnected to database\n";
  89     }
  90   }
  91
  92   #my($job, $ljob);
  93   #{
  94   #  my $oldAutoCommit = $FS::UID::AutoCommit;
  95   #  local $FS::UID::AutoCommit = 0;
  96   $FS::UID::AutoCommit = 0;
  97
  98   my $nodepend = 'AND NOT EXISTS( SELECT 1 FROM queue_depend'.
  99                  '           WHERE queue_depend.jobnum = queue.jobnum )';
 100
 101   #anything with a priority goes after stuff without one
 102   my $order_by = ' ORDER BY COALESCE(priority,0) ASC, jobnum ASC ';
 103
 104   my $limit = $max_kids - $kids;
 105
 106   $order_by .= ( driver_name eq 'mysql'
 107                    ? " LIMIT $limit FOR UPDATE "
 108                    : " FOR UPDATE LIMIT $limit " );
 109
 110   my $hashref = { 'status' => 'new' };
 111   if ( $opt{'s'} ) {
 112     $hashref->{'secure'} = 'Y';
 113   } elsif ( $opt{'n'} ) {
 114     $hashref->{'secure'} = '';
 115   }
 116
 117   #qsearch dies when the db goes away
 118   my @jobs = eval {
 119     qsearch({
 120       'table'     => 'queue',
 121       'hashref'   => $hashref,
 122       'extra_sql' => $nodepend,
 123       'order_by'  => $order_by,
 124     });
 125   };
 126   if ( $@ ) {
 127     warn "WARNING: error searching for jobs, closing connection: $@";
 128     undef $FS::UID::dbh;
 129     next;
 130   }
 131
 132   unless ( @jobs ) {
 133     dbh->commit or do {
 134       warn "WARNING: database error, closing connection: ". dbh->errstr;
 135       undef $FS::UID::dbh;
 136       next;
 137     };
 138     expire_user_pref();
 139     sleep $sleep_time;
 140     next;
 141   }
 142
 143   foreach my $job ( @jobs ) {
 144
 145     my $start_date = time;
 146
 147     $log->debug('locking queue job', object => $job);
 148
 149     my %hash = $job->hash;
 150     $hash{'status'} = 'locked';
 151     my $ljob = new FS::queue ( \%hash );
 152     my $error = $ljob->replace($job);
 153     if ( $error ) {
 154       warn "WARNING: database error locking job, closing connection: ".
 155            dbh->errstr;
 156       undef $FS::UID::dbh;
 157       next;
 158     }
 159
 160     dbh->commit or do {
 161       warn "WARNING: database error, closing connection: ". dbh->errstr;
 162       undef $FS::UID::dbh;
 163       next;
 164     };
 165
 166     $FS::UID::AutoCommit = 1;
 167
 168     my @args = eval { $ljob->args; };
 169     if ( $@ ) {
 170       warn "WARNING: error retrieving job arguments, closing connection: $@";
 171       undef $FS::UID::dbh;
 172       next;
 173     }
 174     splice @args, 0, 1, $ljob if $args[0] eq '_JOB';
 175
 176     defined( my $pid = fork ) or do {
 177       warn "WARNING: can't fork: $!\n";
 178       my %hash = $job->hash;
 179       $hash{'status'} = 'failed';
 180       $hash{'statustext'} = "[freeside-queued] can't fork: $!";
 181       my $ljob = new FS::queue ( \%hash );
 182       my $error = $ljob->replace($job);
 183       die $error if $error; #XXX still dying if we can't fork AND we can't connect to the db
 184       next; #don't increment the kid counter
 185     };
 186
 187     if ( $pid ) {
 188       $kids++;
 189       $kids{$pid} = 1;
 190     } else { #kid time
 191
 192       #get new db handle
 193       $FS::UID::dbh->{InactiveDestroy} = 1;
 194
 195       forksuidsetup($user);
 196
 197       dbh->{'private_profile'} = {} if UNIVERSAL::can(dbh, 'sprintProfile');
 198
 199       #auto-use classes...
 200       if (    $ljob->job =~ /(FS::(part_export|cust_main|cust_pkg|part_pkg|Cron)::\w+)::/
 201            || $ljob->job =~ /(FS::\w+)::/
 202          )
 203       {
 204         my $class = $1;
 205         eval "use $class;";
 206         if ( $@ ) {
 207           warn "job use $class failed";
 208           my %hash = $ljob->hash;
 209           $hash{'status'} = 'failed';
 210           $hash{'statustext'} = $@;
 211           my $fjob = new FS::queue( \%hash );
 212           my $error = $fjob->replace($ljob);
 213           die $error if $error;
 214           exit; #end-of-kid
 215         };
 216       }
 217
 218       my $eval = "&". $ljob->job. '(@args);';
 219       # don't put @args in the log, may expose passwords
 220       $log->info('starting job ('.$ljob->job.')');
 221       warn 'running "&'. $ljob->job. '('. join(', ', @args). ")\n" if $DEBUG;
 222       local $FS::UID::AutoCommit = 0; # so that we can clean up failures
 223       eval $eval; #throw away return value?  suppose so
 224       if ( $@ ) {
 225         dbh->rollback;
 226         my %hash = $ljob->hash;
 227         $hash{'statustext'} = $@;
 228         if ( $hash{'statustext'} =~ /\/misc\/queued_report/ ) { #use return?
 229           $hash{'status'} = 'done';
 230         } else {
 231           $hash{'status'} = 'failed';
 232           warn "job $eval failed";
 233         }
 234         my $fjob = new FS::queue( \%hash );
 235         my $error = $fjob->replace($ljob);
 236         die $error if $error;
 237         dbh->commit; # for the status change only
 238       } else {
 239         $ljob->delete;
 240         dbh->commit; # for the job itself
 241       }
 242
 243       if ( $ljob->job eq 'FS::cust_main::queued_bill' ) {
 244         my $queue_stat = new FS::queue_stat {
 245           'jobnum'      => $ljob->jobnum,
 246           'job'         => $ljob->job,
 247           'custnum'     => $ljob->custnum,
 248           'insert_date' => $ljob->_date,
 249           'start_date'  => $start_date,
 250           'end_date'    => time,
 251         };
 252         my $error = $queue_stat->insert;
 253         die $error if $error;
 254         dbh->commit; #for the stat
 255       }
 256
 257       if ( UNIVERSAL::can(dbh, 'sprintProfile') ) {
 258         open(PROFILE,">%%%FREESIDE_LOG%%%/queueprofile.$$.".time)
 259           or die "can't open profile file: $!";
 260         print PROFILE dbh->sprintProfile();
 261         close PROFILE or die "can't close profile file: $!";
 262       }
 263
 264       exit;
 265       #end-of-kid
 266     }
 267
 268   } #foreach my $job
 269
 270 } continue {
 271   if ( sigterm() ) {
 272     warn "received TERM signal; exiting\n";
 273     exit;
 274   }
 275   if ( sigint() ) {
 276     warn "received INT signal; exiting\n";
 277     exit;
 278   }
 279 }
 280
 281 sub untaint_argv {
 282   foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
 283     #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
 284     # Date::Parse
 285     $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
 286     $ARGV[$_]=$1;
 287   }
 288 }
 289
 290 sub usage {
 291   die "Usage:\n\n  freeside-queued user\n";
 292 }
 293
 294 sub reap_kids {
 295   foreach my $pid ( keys %kids ) {
 296     my $kid = waitpid($pid, WNOHANG);
 297     if ( $kid > 0 ) {
 298       $kids--;
 299       delete $kids{$kid};
 300     }
 301   }
 302 }
 303
 304 =head1 NAME
 305
 306 freeside-queued - Job queue daemon
 307
 308 =head1 SYNOPSIS
 309
 310   freeside-queued [ -s | -n ] user
 311
 312 =head1 DESCRIPTION
 313
 314 Job queue daemon.  Should be running at all times.
 315
 316 -s: "secure" jobs only (queued billing jobs)
 317
 318 -n: non-"secure" jobs only (other jobs)
 319
 320 user: Typically "fs_queue"
 321
 322 =head1 VERSION
 323
 324 =head1 BUGS
 325
 326 =head1 SEE ALSO
 327
 328 =cut
 329