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(setlocale 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   # Initialize character type locale to be UTF-8 instead of C:
 190   foreach my $locale (qw(de_DE.UTF-8 en_US.UTF-8)) {
 191     last if setlocale('LC_CTYPE', $locale);
 192   }
 193
 194   SL::LxOfficeConf->read($self->{configfile});
 195
 196   die "Missing section [task_server] in config file" unless $lx_office_conf{task_server};
 197
 198   if ($lx_office_conf{task_server}->{login} || $lx_office_conf{task_server}->{client}) {
 199     print STDERR <<EOT;
 200 ERROR: The keys 'login' and/or 'client' are still present in the
 201 section [task_server] in the configuration file. These keys are
 202 deprecated. You have to configure the clients for which to run the
 203 task server in the web admin interface.
 204
 205 The task server will refuse to start until the keys have been removed from
 206 the configuration file.
 207 EOT
 208     exit 2;
 209   }
 210
 211   initialize_kivitendo();
 212
 213   my $dbupdater_auth = SL::DBUpgrade2->new(form => $::form, auth => 1)->parse_dbupdate_controls;
 214   if ($dbupdater_auth->unapplied_upgrade_scripts($::auth->dbconnect)) {
 215     print STDERR <<EOT;
 216 The authentication database requires an upgrade. Please login to
 217 kivitendo's administration interface in order to apply it. The task
 218 server cannot start until the upgrade has been applied.
 219 EOT
 220     exit 2;
 221   }
 222
 223   drop_privileges();
 224
 225   return ();
 226 }
 227
 228 sub run_once_for_all_clients {
 229   initialize_kivitendo();
 230
 231   my $clients = enabled_clients();
 232
 233   foreach my $client (@{ $clients }) {
 234     debug("Running for client ID " . $client->id . " (" . $client->name . ")");
 235
 236     my $ok = eval {
 237       initialize_kivitendo($client);
 238
 239       my $jobs = SL::DB::Manager::BackgroundJob->get_all_need_to_run;
 240
 241       if (@{ $jobs }) {
 242         debug(" Executing the following jobs: " . join(' ', map { $_->package_name } @{ $jobs }));
 243       } else {
 244         debug(" No jobs to execute found");
 245       }
 246
 247       foreach my $job (@{ $jobs }) {
 248         # Provide fresh global variables in case legacy code modifies
 249         # them somehow.
 250         initialize_kivitendo($client);
 251
 252         my $history = $job->run;
 253
 254         debug("   Executed job " . $job->package_name .
 255               "; result: " . (!$history ? "no return value" : $history->has_failed ? "failed" : "succeeded") .
 256               ($history && $history->has_failed ? "; error: " . $history->error_col : ""));
 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 $exe_dir = SL::System::Process->exe_dir;
 300 chdir($exe_dir) || die "Cannot change directory to ${exe_dir}\n";
 301
 302 mkdir SL::System::TaskServer::PID_BASE() if !-d SL::System::TaskServer::PID_BASE();
 303
 304 my $file = first { -f } ("${exe_dir}/config/kivitendo.conf", "${exe_dir}/config/lx_office.conf", "${exe_dir}/config/kivitendo.conf.default");
 305
 306 die "No configuration file found." unless $file;
 307
 308 $file = File::Spec->abs2rel(Cwd::abs_path($file), Cwd::abs_path($exe_dir));
 309
 310 newdaemon(configfile => $file,
 311           progname   => 'kivitendo-background-jobs',
 312           pidbase    => SL::System::TaskServer::PID_BASE() . '/',
 313           );
 314
 315 1;