scripts/task_server.pl

   1 #!/usr/bin/perl
   2
   3
   4 use List::MoreUtils qw(any);
   5
   6 use strict;
   7
   8 my $exe_dir;
   9
  10 BEGIN {
  11   use FindBin;
  12   use lib "$FindBin::Bin/..";
  13
  14   use SL::System::Process;
  15   $exe_dir = SL::System::Process::exe_dir;
  16
  17   unshift @INC, "${exe_dir}/modules/override"; # Use our own versions of various modules (e.g. YAML).
  18   push    @INC, "${exe_dir}/modules/fallback"; # Only use our own versions of modules if there's no system version.
  19   unshift @INC, $exe_dir;
  20
  21   chdir($exe_dir) || die "Cannot change directory to ${exe_dir}\n";
  22 }
  23
  24 use CGI qw( -no_xhtml);
  25 use Cwd;
  26 use Daemon::Generic;
  27 use Data::Dumper;
  28 use DateTime;
  29 use Encode qw();
  30 use English qw(-no_match_vars);
  31 use File::Spec;
  32 use List::Util qw(first);
  33 use POSIX qw(setuid setgid);
  34 use SL::Auth;
  35 use SL::DB::BackgroundJob;
  36 use SL::BackgroundJob::ALL;
  37 use SL::Form;
  38 use SL::Helper::DateTime;
  39 use SL::InstanceConfiguration;
  40 use SL::LXDebug;
  41 use SL::LxOfficeConf;
  42 use SL::Locale;
  43 use SL::Mailer;
  44 use SL::System::TaskServer;
  45 use Template;
  46
  47 our %lx_office_conf;
  48
  49 sub debug {
  50   return if !$lx_office_conf{task_server}->{debug};
  51   $::lxdebug->message(0, @_);
  52 }
  53
  54 sub initialize_kivitendo {
  55   chdir $exe_dir;
  56
  57   my $login  = $lx_office_conf{task_server}->{login};
  58   my $client = $lx_office_conf{task_server}->{client};
  59
  60   package main;
  61
  62   Form::disconnect_standard_dbh;
  63   $::lxdebug       = LXDebug->new;
  64   $::locale        = Locale->new($::lx_office_conf{system}->{language});
  65   $::form          = Form->new;
  66   $::auth          = SL::Auth->new;
  67   die "No client configured or no client found with the name/ID '$client'" unless $::auth->set_client($client);
  68   $::instance_conf = SL::InstanceConfiguration->new;
  69   $::request       = SL::Request->new(
  70     cgi            => CGI->new({}),
  71     layout         => SL::Layout::None->new,
  72   );
  73
  74   die 'cannot reach auth db'               unless $::auth->session_tables_present;
  75
  76   $::auth->restore_session;
  77   $::auth->create_or_refresh_session;
  78
  79   die "cannot find user $login"            unless %::myconfig = $::auth->read_user(login => $login);
  80   die "cannot find locale for user $login" unless $::locale   = Locale->new($::myconfig{countrycode} || $::lx_office_conf{system}->{language});
  81
  82   $::form->{__ERROR_HANDLER} = sub { die @_ };
  83 }
  84
  85 sub cleanup_kivitendo {
  86   eval { SL::DB::Auth->new->db->dbh->rollback; };
  87   eval { SL::DB::BackgroundJob->new->db->dbh->rollback; };
  88
  89   $::auth->save_session;
  90   $::auth->expire_sessions;
  91   $::auth->reset;
  92
  93   $::form     = undef;
  94   $::myconfig = ();
  95   $::request  = undef;
  96   Form::disconnect_standard_dbh;
  97 }
  98
  99 sub drop_privileges {
 100   my $user = $lx_office_conf{task_server}->{run_as};
 101   return unless $user;
 102
 103   my ($uid, $gid);
 104   while (my @details = getpwent()) {
 105     next unless $details[0] eq $user;
 106     ($uid, $gid) = @details[2, 3];
 107     last;
 108   }
 109   endpwent();
 110
 111   if (!$uid) {
 112     print "Error: Cannot drop privileges to ${user}: user does not exist\n";
 113     exit 1;
 114   }
 115
 116   if (!setgid($gid)) {
 117     print "Error: Cannot drop group privileges to ${user} (group ID $gid): $!\n";
 118     exit 1;
 119   }
 120
 121   if (!setuid($uid)) {
 122     print "Error: Cannot drop user privileges to ${user} (user ID $uid): $!\n";
 123     exit 1;
 124   }
 125 }
 126
 127 sub notify_on_failure {
 128   my (%params) = @_;
 129
 130   my $cfg = $lx_office_conf{'task_server/notify_on_failure'} || {};
 131
 132   return if any { !$cfg->{$_} } qw(send_email_to email_from email_subject email_template);
 133
 134   chdir $exe_dir;
 135
 136   return debug("Template " . $cfg->{email_template} . " missing!") unless -f $cfg->{email_template};
 137
 138   my $email_to = $cfg->{send_email_to};
 139   if ($email_to !~ m{\@}) {
 140     my %user = $::auth->read_user(login => $email_to);
 141     return debug("cannot find user for notification $email_to") unless %user;
 142
 143     $email_to = $user{email};
 144     return debug("user for notification " . $user{login} . " doesn't have a valid email address") unless $email_to =~ m{\@};
 145   }
 146
 147   my $template  = Template->new({
 148     INTERPOLATE => 0,
 149     EVAL_PERL   => 0,
 150     ABSOLUTE    => 1,
 151     CACHE_SIZE  => 0,
 152   });
 153
 154   return debug("Could not create Template instance") unless $template;
 155
 156   $params{client} = $::auth->client;
 157
 158   my $body;
 159   $template->process($cfg->{email_template}, \%params, \$body);
 160
 161   Mailer->new(
 162     from         => $cfg->{email_from},
 163     to           => $email_to,
 164     subject      => $cfg->{email_subject},
 165     content_type => 'text/plain',
 166     charset      => 'utf-8',
 167     message      => Encode::decode('utf-8', $body),
 168   )->send;
 169 }
 170
 171 sub gd_preconfig {
 172   my $self = shift;
 173
 174   SL::LxOfficeConf->read($self->{configfile});
 175
 176   die "Missing section [task_server] in config file"                 unless $lx_office_conf{task_server};
 177   die "Missing key 'login' in section [task_server] in config file"  unless $lx_office_conf{task_server}->{login};
 178   die "Missing key 'client' in section [task_server] in config file" unless $lx_office_conf{task_server}->{client};
 179
 180   drop_privileges();
 181   initialize_kivitendo();
 182
 183   return ();
 184 }
 185
 186 sub gd_run {
 187   while (1) {
 188     my $ok = eval {
 189       initialize_kivitendo();
 190
 191       debug("Retrieving jobs");
 192
 193       my $jobs = SL::DB::Manager::BackgroundJob->get_all_need_to_run;
 194
 195       debug("  Found: " . join(' ', map { $_->package_name } @{ $jobs })) if @{ $jobs };
 196
 197       foreach my $job (@{ $jobs }) {
 198         # Provide fresh global variables in case legacy code modifies
 199         # them somehow.
 200         initialize_kivitendo();
 201
 202         my $history = $job->run;
 203
 204         notify_on_failure(history => $history) if $history && $history->has_failed;
 205       }
 206
 207       1;
 208     };
 209
 210     if (!$ok) {
 211       my $error = $EVAL_ERROR;
 212       debug("Exception during execution: ${error}");
 213       notify_on_failure(exception => $error);
 214     }
 215
 216     cleanup_kivitendo();
 217
 218     debug("Sleeping");
 219
 220     my $seconds = 60 - (localtime)[0];
 221     if (!eval {
 222       local $SIG{'ALRM'} = sub {
 223         debug("Got woken up by SIGALRM");
 224         die "Alarm!\n"
 225       };
 226       sleep($seconds < 30 ? $seconds + 60 : $seconds);
 227       1;
 228     }) {
 229       die $@ unless $@ eq "Alarm!\n";
 230     }
 231   }
 232 }
 233
 234 sub end_of_request {
 235   $main::lxdebug->show_backtrace();
 236   die <<EOF;
 237 Job called ::end_of_request()!
 238
 239 This usually indicates success but should not be used by background jobs. A
 240 backtrace has been logged. Please tell the job author to have a look at it.
 241 EOF
 242
 243 }
 244
 245 chdir $exe_dir;
 246
 247 mkdir SL::System::TaskServer::PID_BASE() if !-d SL::System::TaskServer::PID_BASE();
 248
 249 my $file = first { -f } ("${exe_dir}/config/kivitendo.conf", "${exe_dir}/config/lx_office.conf", "${exe_dir}/config/kivitendo.conf.default");
 250
 251 die "No configuration file found." unless $file;
 252
 253 $file = File::Spec->abs2rel(Cwd::abs_path($file), Cwd::abs_path($exe_dir));
 254
 255 newdaemon(configfile => $file,
 256           progname   => 'kivitendo-background-jobs',
 257           pidbase    => SL::System::TaskServer::PID_BASE() . '/',
 258           );
 259
 260 1;