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 }
  13
  14 use CGI qw( -no_xhtml);
  15 use Cwd;
  16 use Daemon::Generic;
  17 use Data::Dumper;
  18 use DateTime;
  19 use English qw(-no_match_vars);
  20 use File::Spec;
  21 use List::MoreUtils qw(any);
  22 use List::Util qw(first);
  23 use POSIX qw(setlocale setuid setgid);
  24 use SL::Auth;
  25 use SL::DBUpgrade2;
  26 use SL::DB::AuthClient;
  27 use SL::DB::BackgroundJob;
  28 use SL::System::Process;
  29 use SL::Form;
  30 use SL::Helper::DateTime;
  31 use SL::InstanceConfiguration;
  32 use SL::LXDebug;
  33 use SL::LxOfficeConf;
  34 use SL::Locale;
  35 use SL::Mailer;
  36 use SL::System::Process;
  37 use SL::System::TaskServer;
  38 use Template;
  39
  40 our %lx_office_conf;
  41 our $run_single_job;
  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_single_job_for_all_clients {
 229   initialize_kivitendo();
 230
 231   my $clients = enabled_clients();
 232
 233   foreach my $client (@{ $clients }) {
 234     debug("Running single job ID $run_single_job for client ID " . $client->id . " (" . $client->name . ")");
 235
 236     my $ok = eval {
 237       initialize_kivitendo($client);
 238
 239       my $job = SL::DB::Manager::BackgroundJob->find_by(id => $run_single_job);
 240
 241       if ($job) {
 242         debug(" Executing the following job: " . $job->package_name);
 243       } else {
 244         debug(" No jobs to execute found");
 245         next;
 246       }
 247
 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       1;
 261     };
 262
 263     if (!$ok) {
 264       my $error = $EVAL_ERROR;
 265       $::lxdebug->message(LXDebug::WARN(), "Exception during execution: ${error}");
 266       notify_on_failure(exception => $error);
 267     }
 268
 269     cleanup_kivitendo();
 270   }
 271 }
 272
 273 sub run_once_for_all_clients {
 274   initialize_kivitendo();
 275
 276   my $clients = enabled_clients();
 277
 278   foreach my $client (@{ $clients }) {
 279     debug("Running for client ID " . $client->id . " (" . $client->name . ")");
 280
 281     my $ok = eval {
 282       initialize_kivitendo($client);
 283
 284       my $jobs = SL::DB::Manager::BackgroundJob->get_all_need_to_run;
 285
 286       if (@{ $jobs }) {
 287         debug(" Executing the following jobs: " . join(' ', map { $_->package_name } @{ $jobs }));
 288       } else {
 289         debug(" No jobs to execute found");
 290       }
 291
 292       foreach my $job (@{ $jobs }) {
 293         # Provide fresh global variables in case legacy code modifies
 294         # them somehow.
 295         initialize_kivitendo($client);
 296
 297         my $history = $job->run;
 298
 299         debug("   Executed job " . $job->package_name .
 300               "; result: " . (!$history ? "no return value" : $history->has_failed ? "failed" : "succeeded") .
 301               ($history && $history->has_failed ? "; error: " . $history->error_col : ""));
 302
 303         notify_on_failure(history => $history) if $history && $history->has_failed;
 304       }
 305
 306       1;
 307     };
 308
 309     if (!$ok) {
 310       my $error = $EVAL_ERROR;
 311       $::lxdebug->message(LXDebug::WARN(), "Exception during execution: ${error}");
 312       notify_on_failure(exception => $error);
 313     }
 314
 315     cleanup_kivitendo();
 316   }
 317 }
 318
 319 sub gd_run {
 320   if ($run_single_job) {
 321     run_single_job_for_all_clients();
 322     return;
 323   }
 324   $::lxdebug->message(LXDebug::INFO(), "The task server for node " . SL::System::TaskServer::node_id() . " is up and running.");
 325
 326   while (1) {
 327     $SIG{'ALRM'} = 'IGNORE';
 328
 329     run_once_for_all_clients();
 330
 331     debug("Sleeping");
 332
 333     clean_before_sleeping();
 334
 335     if (SL::System::Process::memory_usage_is_too_high()) {
 336       debug("Memory usage too high - exiting.");
 337       return;
 338     }
 339
 340     my $seconds = 60 - (localtime)[0];
 341     if (!eval {
 342       $SIG{'ALRM'} = sub {
 343         $SIG{'ALRM'} = 'IGNORE';
 344         debug("Got woken up by SIGALRM");
 345         die "Alarm!\n"
 346       };
 347       sleep($seconds < 30 ? $seconds + 60 : $seconds);
 348       1;
 349     }) {
 350       die $@ unless $@ eq "Alarm!\n";
 351     }
 352   }
 353 }
 354
 355 sub gd_flags_more {
 356   return (
 357     '--run-job=<id>' => 'Run the single job with the database ID <id> no matter if it is active or when its next execution is supposed to be; the daemon will exit afterwards',
 358   );
 359 }
 360
 361 $exe_dir = SL::System::Process->exe_dir;
 362 chdir($exe_dir) || die "Cannot change directory to ${exe_dir}\n";
 363
 364 mkdir SL::System::TaskServer::PID_BASE() if !-d SL::System::TaskServer::PID_BASE();
 365
 366 my $file = first { -f } ("${exe_dir}/config/kivitendo.conf", "${exe_dir}/config/lx_office.conf", "${exe_dir}/config/kivitendo.conf.default");
 367
 368 die "No configuration file found." unless $file;
 369
 370 $file = File::Spec->abs2rel(Cwd::abs_path($file), Cwd::abs_path($exe_dir));
 371
 372 newdaemon(configfile => $file,
 373           progname   => 'kivitendo-background-jobs',
 374           pidbase    => SL::System::TaskServer::PID_BASE() . '/',
 375           options    => {
 376             'run-job=i' => \$run_single_job,
 377           },
 378           );
 379
 380 1;