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   File::Temp::cleanup();
 116 }
 117
 118 sub drop_privileges {
 119   my $user = $lx_office_conf{task_server}->{run_as};
 120   return unless $user;
 121
 122   my ($uid, $gid);
 123   while (my @details = getpwent()) {
 124     next unless $details[0] eq $user;
 125     ($uid, $gid) = @details[2, 3];
 126     last;
 127   }
 128   endpwent();
 129
 130   if (!$uid) {
 131     print "Error: Cannot drop privileges to ${user}: user does not exist\n";
 132     exit 1;
 133   }
 134
 135   if (!setgid($gid)) {
 136     print "Error: Cannot drop group privileges to ${user} (group ID $gid): $!\n";
 137     exit 1;
 138   }
 139
 140   if (!setuid($uid)) {
 141     print "Error: Cannot drop user privileges to ${user} (user ID $uid): $!\n";
 142     exit 1;
 143   }
 144 }
 145
 146 sub notify_on_failure {
 147   my (%params) = @_;
 148
 149   my $cfg = $lx_office_conf{'task_server/notify_on_failure'} || {};
 150
 151   return if any { !$cfg->{$_} } qw(send_email_to email_from email_subject email_template);
 152
 153   chdir $exe_dir;
 154
 155   return debug("Template " . $cfg->{email_template} . " missing!") unless -f $cfg->{email_template};
 156
 157   my $email_to = $cfg->{send_email_to};
 158   if ($email_to !~ m{\@}) {
 159     my %user = $::auth->read_user(login => $email_to);
 160     return debug("cannot find user for notification $email_to") unless %user;
 161
 162     $email_to = $user{email};
 163     return debug("user for notification " . $user{login} . " doesn't have a valid email address") unless $email_to =~ m{\@};
 164   }
 165
 166   my $template  = Template->new({
 167     INTERPOLATE => 0,
 168     EVAL_PERL   => 0,
 169     ABSOLUTE    => 1,
 170     CACHE_SIZE  => 0,
 171   });
 172
 173   return debug("Could not create Template instance") unless $template;
 174
 175   $params{client} = $::auth->client;
 176
 177   eval {
 178     my $body;
 179     $template->process($cfg->{email_template}, \%params, \$body);
 180
 181     Mailer->new(
 182       from         => $cfg->{email_from},
 183       to           => $email_to,
 184       subject      => $cfg->{email_subject},
 185       content_type => 'text/plain',
 186       charset      => 'utf-8',
 187       message      => Encode::decode('utf-8', $body),
 188     )->send;
 189
 190     1;
 191   } or do {
 192     debug("Sending a failure notification failed with an exception: $@");
 193   };
 194 }
 195
 196 sub gd_preconfig {
 197   my $self = shift;
 198
 199   SL::LxOfficeConf->read($self->{configfile});
 200
 201   die "Missing section [task_server] in config file" unless $lx_office_conf{task_server};
 202
 203   if ($lx_office_conf{task_server}->{login} || $lx_office_conf{task_server}->{client}) {
 204     print STDERR <<EOT;
 205 ERROR: The keys 'login' and/or 'client' are still present in the
 206 section [task_server] in the configuration file. These keys are
 207 deprecated. You have to configure the clients for which to run the
 208 task server in the web admin interface.
 209
 210 The task server will refuse to start until the keys have been removed from
 211 the configuration file.
 212 EOT
 213     exit 2;
 214   }
 215
 216   initialize_kivitendo();
 217
 218   my $dbupdater_auth = SL::DBUpgrade2->new(form => $::form, auth => 1)->parse_dbupdate_controls;
 219   if ($dbupdater_auth->unapplied_upgrade_scripts($::auth->dbconnect)) {
 220     print STDERR <<EOT;
 221 The authentication database requires an upgrade. Please login to
 222 kivitendo's administration interface in order to apply it. The task
 223 server cannot start until the upgrade has been applied.
 224 EOT
 225     exit 2;
 226   }
 227
 228   drop_privileges();
 229
 230   return ();
 231 }
 232
 233 sub run_once_for_all_clients {
 234   initialize_kivitendo();
 235
 236   my $clients = enabled_clients();
 237
 238   foreach my $client (@{ $clients }) {
 239     debug("Running for client ID " . $client->id . " (" . $client->name . ")");
 240
 241     my $ok = eval {
 242       initialize_kivitendo($client);
 243
 244       my $jobs = SL::DB::Manager::BackgroundJob->get_all_need_to_run;
 245
 246       if (@{ $jobs }) {
 247         debug(" Executing the following jobs: " . join(' ', map { $_->package_name } @{ $jobs }));
 248       } else {
 249         debug(" No jobs to execute found");
 250       }
 251
 252       foreach my $job (@{ $jobs }) {
 253         # Provide fresh global variables in case legacy code modifies
 254         # them somehow.
 255         initialize_kivitendo($client);
 256
 257         my $history = $job->run;
 258
 259         notify_on_failure(history => $history) if $history && $history->has_failed;
 260       }
 261
 262       1;
 263     };
 264
 265     if (!$ok) {
 266       my $error = $EVAL_ERROR;
 267       debug("Exception during execution: ${error}");
 268       notify_on_failure(exception => $error);
 269     }
 270
 271     cleanup_kivitendo();
 272   }
 273 }
 274
 275 sub gd_run {
 276   while (1) {
 277     $SIG{'ALRM'} = 'IGNORE';
 278
 279     run_once_for_all_clients();
 280
 281     debug("Sleeping");
 282
 283     clean_before_sleeping();
 284
 285     my $seconds = 60 - (localtime)[0];
 286     if (!eval {
 287       $SIG{'ALRM'} = sub {
 288         $SIG{'ALRM'} = 'IGNORE';
 289         debug("Got woken up by SIGALRM");
 290         die "Alarm!\n"
 291       };
 292       sleep($seconds < 30 ? $seconds + 60 : $seconds);
 293       1;
 294     }) {
 295       die $@ unless $@ eq "Alarm!\n";
 296     }
 297   }
 298 }
 299
 300 sub end_of_request {
 301   $main::lxdebug->show_backtrace();
 302   die <<EOF;
 303 Job called ::end_of_request()!
 304
 305 This usually indicates success but should not be used by background jobs. A
 306 backtrace has been logged. Please tell the job author to have a look at it.
 307 EOF
 308
 309 }
 310
 311 chdir $exe_dir;
 312
 313 mkdir SL::System::TaskServer::PID_BASE() if !-d SL::System::TaskServer::PID_BASE();
 314
 315 my $file = first { -f } ("${exe_dir}/config/kivitendo.conf", "${exe_dir}/config/lx_office.conf", "${exe_dir}/config/kivitendo.conf.default");
 316
 317 die "No configuration file found." unless $file;
 318
 319 $file = File::Spec->abs2rel(Cwd::abs_path($file), Cwd::abs_path($exe_dir));
 320
 321 newdaemon(configfile => $file,
 322           progname   => 'kivitendo-background-jobs',
 323           pidbase    => SL::System::TaskServer::PID_BASE() . '/',
 324           );
 325
 326 1;