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::DBUpgrade2;
  36 use SL::DB::AuthClient;
  37 use SL::DB::BackgroundJob;
  38 use SL::BackgroundJob::ALL;
  39 use SL::Form;
  40 use SL::Helper::DateTime;
  41 use SL::InstanceConfiguration;
  42 use SL::LXDebug;
  43 use SL::LxOfficeConf;
  44 use SL::Locale;
  45 use SL::Mailer;
  46 use SL::System::TaskServer;
  47 use Template;
  48
  49 our %lx_office_conf;
  50
  51 sub debug {
  52   return if !$lx_office_conf{task_server}->{debug};
  53   $::lxdebug->message(LXDebug::DEBUG1(), join(' ', "task server:", @_));
  54 }
  55
  56 sub enabled_clients {
  57   return SL::DB::Manager::AuthClient->get_all(where => [ '!task_server_user_id' => undef ]);
  58 }
  59
  60 sub initialize_kivitendo {
  61   my ($client) = @_;
  62
  63   chdir $exe_dir;
  64
  65   package main;
  66
  67   Form::disconnect_standard_dbh;
  68   $::lxdebug       = LXDebug->new;
  69   $::locale        = Locale->new($::lx_office_conf{system}->{language});
  70   $::form          = Form->new;
  71   $::auth          = SL::Auth->new;
  72
  73   return if !$client;
  74
  75   $::auth->set_client($client->id);
  76
  77   $::form->{__ERROR_HANDLER} = sub { die @_ };
  78
  79   $::instance_conf = SL::InstanceConfiguration->new;
  80   $::request       = SL::Request->new(
  81     cgi            => CGI->new({}),
  82     layout         => SL::Layout::None->new,
  83   );
  84
  85   die 'cannot reach auth db'               unless $::auth->session_tables_present;
  86
  87   $::auth->restore_session;
  88   $::auth->create_or_refresh_session;
  89
  90   my $login = $client->task_server_user->login;
  91
  92   die "cannot find user $login"            unless %::myconfig = $::auth->read_user(login => $login);
  93   die "cannot find locale for user $login" unless $::locale   = Locale->new($::myconfig{countrycode} || $::lx_office_conf{system}->{language});
  94 }
  95
  96 sub cleanup_kivitendo {
  97   eval { SL::DB::Auth->new->db->dbh->rollback; };
  98   eval { SL::DB::BackgroundJob->new->db->dbh->rollback; };
  99
 100   $::auth->save_session;
 101   $::auth->expire_sessions;
 102   $::auth->reset;
 103
 104   $::form     = undef;
 105   $::myconfig = ();
 106   $::request  = undef;
 107   $::auth     = undef;
 108 }
 109
 110 sub clean_before_sleeping {
 111   Form::disconnect_standard_dbh;
 112   SL::DBConnect::Cache->disconnect_all_and_clear;
 113   SL::DB->db_cache->clear;
 114 }
 115
 116 sub drop_privileges {
 117   my $user = $lx_office_conf{task_server}->{run_as};
 118   return unless $user;
 119
 120   my ($uid, $gid);
 121   while (my @details = getpwent()) {
 122     next unless $details[0] eq $user;
 123     ($uid, $gid) = @details[2, 3];
 124     last;
 125   }
 126   endpwent();
 127
 128   if (!$uid) {
 129     print "Error: Cannot drop privileges to ${user}: user does not exist\n";
 130     exit 1;
 131   }
 132
 133   if (!setgid($gid)) {
 134     print "Error: Cannot drop group privileges to ${user} (group ID $gid): $!\n";
 135     exit 1;
 136   }
 137
 138   if (!setuid($uid)) {
 139     print "Error: Cannot drop user privileges to ${user} (user ID $uid): $!\n";
 140     exit 1;
 141   }
 142 }
 143
 144 sub notify_on_failure {
 145   my (%params) = @_;
 146
 147   my $cfg = $lx_office_conf{'task_server/notify_on_failure'} || {};
 148
 149   return if any { !$cfg->{$_} } qw(send_email_to email_from email_subject email_template);
 150
 151   chdir $exe_dir;
 152
 153   return debug("Template " . $cfg->{email_template} . " missing!") unless -f $cfg->{email_template};
 154
 155   my $email_to = $cfg->{send_email_to};
 156   if ($email_to !~ m{\@}) {
 157     my %user = $::auth->read_user(login => $email_to);
 158     return debug("cannot find user for notification $email_to") unless %user;
 159
 160     $email_to = $user{email};
 161     return debug("user for notification " . $user{login} . " doesn't have a valid email address") unless $email_to =~ m{\@};
 162   }
 163
 164   my $template  = Template->new({
 165     INTERPOLATE => 0,
 166     EVAL_PERL   => 0,
 167     ABSOLUTE    => 1,
 168     CACHE_SIZE  => 0,
 169   });
 170
 171   return debug("Could not create Template instance") unless $template;
 172
 173   $params{client} = $::auth->client;
 174
 175   eval {
 176     my $body;
 177     $template->process($cfg->{email_template}, \%params, \$body);
 178
 179     Mailer->new(
 180       from         => $cfg->{email_from},
 181       to           => $email_to,
 182       subject      => $cfg->{email_subject},
 183       content_type => 'text/plain',
 184       charset      => 'utf-8',
 185       message      => Encode::decode('utf-8', $body),
 186     )->send;
 187
 188     1;
 189   } or do {
 190     debug("Sending a failure notification failed with an exception: $@");
 191   };
 192 }
 193
 194 sub gd_preconfig {
 195   my $self = shift;
 196
 197   SL::LxOfficeConf->read($self->{configfile});
 198
 199   die "Missing section [task_server] in config file" unless $lx_office_conf{task_server};
 200
 201   if ($lx_office_conf{task_server}->{login} || $lx_office_conf{task_server}->{client}) {
 202     print STDERR <<EOT;
 203 ERROR: The keys 'login' and/or 'client' are still present in the
 204 section [task_server] in the configuration file. These keys are
 205 deprecated. You have to configure the clients for which to run the
 206 task server in the web admin interface.
 207
 208 The task server will refuse to start until the keys have been removed from
 209 the configuration file.
 210 EOT
 211     exit 2;
 212   }
 213
 214   initialize_kivitendo();
 215
 216   my $dbupdater_auth = SL::DBUpgrade2->new(form => $::form, auth => 1)->parse_dbupdate_controls;
 217   if ($dbupdater_auth->unapplied_upgrade_scripts($::auth->dbconnect)) {
 218     print STDERR <<EOT;
 219 The authentication database requires an upgrade. Please login to
 220 kivitendo's administration interface in order to apply it. The task
 221 server cannot start until the upgrade has been applied.
 222 EOT
 223     exit 2;
 224   }
 225
 226   drop_privileges();
 227
 228   return ();
 229 }
 230
 231 sub run_once_for_all_clients {
 232   initialize_kivitendo();
 233
 234   my $clients = enabled_clients();
 235
 236   foreach my $client (@{ $clients }) {
 237     debug("Running for client ID " . $client->id . " (" . $client->name . ")");
 238
 239     my $ok = eval {
 240       initialize_kivitendo($client);
 241
 242       my $jobs = SL::DB::Manager::BackgroundJob->get_all_need_to_run;
 243
 244       if (@{ $jobs }) {
 245         debug(" Executing the following jobs: " . join(' ', map { $_->package_name } @{ $jobs }));
 246       } else {
 247         debug(" No jobs to execute found");
 248       }
 249
 250       foreach my $job (@{ $jobs }) {
 251         # Provide fresh global variables in case legacy code modifies
 252         # them somehow.
 253         initialize_kivitendo($client);
 254
 255         my $history = $job->run;
 256
 257         notify_on_failure(history => $history) if $history && $history->has_failed;
 258       }
 259
 260       1;
 261     };
 262
 263     if (!$ok) {
 264       my $error = $EVAL_ERROR;
 265       debug("Exception during execution: ${error}");
 266       notify_on_failure(exception => $error);
 267     }
 268
 269     cleanup_kivitendo();
 270   }
 271 }
 272
 273 sub gd_run {
 274   while (1) {
 275     run_once_for_all_clients();
 276
 277     debug("Sleeping");
 278
 279     clean_before_sleeping();
 280
 281     my $seconds = 60 - (localtime)[0];
 282     if (!eval {
 283       local $SIG{'ALRM'} = sub {
 284         debug("Got woken up by SIGALRM");
 285         die "Alarm!\n"
 286       };
 287       sleep($seconds < 30 ? $seconds + 60 : $seconds);
 288       1;
 289     }) {
 290       die $@ unless $@ eq "Alarm!\n";
 291     }
 292   }
 293 }
 294
 295 sub end_of_request {
 296   $main::lxdebug->show_backtrace();
 297   die <<EOF;
 298 Job called ::end_of_request()!
 299
 300 This usually indicates success but should not be used by background jobs. A
 301 backtrace has been logged. Please tell the job author to have a look at it.
 302 EOF
 303
 304 }
 305
 306 chdir $exe_dir;
 307
 308 mkdir SL::System::TaskServer::PID_BASE() if !-d SL::System::TaskServer::PID_BASE();
 309
 310 my $file = first { -f } ("${exe_dir}/config/kivitendo.conf", "${exe_dir}/config/lx_office.conf", "${exe_dir}/config/kivitendo.conf.default");
 311
 312 die "No configuration file found." unless $file;
 313
 314 $file = File::Spec->abs2rel(Cwd::abs_path($file), Cwd::abs_path($exe_dir));
 315
 316 newdaemon(configfile => $file,
 317           progname   => 'kivitendo-background-jobs',
 318           pidbase    => SL::System::TaskServer::PID_BASE() . '/',
 319           );
 320
 321 1;