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