scripts/task_server.pl

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