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::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 our $run_single_job;
  43
  44 sub debug {
  45   return if !$lx_office_conf{task_server}->{debug};
  46   $::lxdebug->message(LXDebug::DEBUG1(), join(' ', "task server:", @_));
  47 }
  48
  49 sub enabled_clients {
  50   return SL::DB::Manager::AuthClient->get_all(where => [ '!task_server_user_id' => undef ]);
  51 }
  52
  53 sub initialize_kivitendo {
  54   my ($client) = @_;
  55
  56   chdir $exe_dir;
  57
  58   package main;
  59
  60   $::lxdebug       = LXDebug->new;
  61   $::locale        = Locale->new($::lx_office_conf{system}->{language});
  62   $::form          = Form->new;
  63   $::auth          = SL::Auth->new;
  64
  65   return if !$client;
  66
  67   $::auth->set_client($client->id);
  68
  69   $::form->{__ERROR_HANDLER} = sub { die @_ };
  70
  71   $::instance_conf = SL::InstanceConfiguration->new;
  72   $::request       = SL::Request->new(
  73     cgi            => CGI->new({}),
  74     layout         => SL::Layout::None->new,
  75   );
  76
  77   die 'cannot reach auth db'               unless $::auth->session_tables_present;
  78
  79   $::auth->restore_session;
  80   $::auth->create_or_refresh_session;
  81
  82   my $login = $client->task_server_user->login;
  83
  84   die "cannot find user $login"            unless %::myconfig = $::auth->read_user(login => $login);
  85   die "cannot find locale for user $login" unless $::locale   = Locale->new($::myconfig{countrycode} || $::lx_office_conf{system}->{language});
  86 }
  87
  88 sub cleanup_kivitendo {
  89   eval { SL::DB->client->dbh->rollback; };
  90
  91   $::auth->save_session;
  92   $::auth->expire_sessions;
  93   $::auth->reset;
  94
  95   $::form     = undef;
  96   $::myconfig = ();
  97   $::request  = undef;
  98   $::auth     = undef;
  99 }
 100
 101 sub clean_before_sleeping {
 102   SL::DBConnect::Cache->disconnect_all_and_clear;
 103   SL::DB->db_cache->clear;
 104
 105   File::Temp::cleanup();
 106 }
 107
 108 sub drop_privileges {
 109   my $user = $lx_office_conf{task_server}->{run_as};
 110   return unless $user;
 111
 112   my ($uid, $gid);
 113   while (my @details = getpwent()) {
 114     next unless $details[0] eq $user;
 115     ($uid, $gid) = @details[2, 3];
 116     last;
 117   }
 118   endpwent();
 119
 120   if (!$uid) {
 121     print "Error: Cannot drop privileges to ${user}: user does not exist\n";
 122     exit 1;
 123   }
 124
 125   if (!setgid($gid)) {
 126     print "Error: Cannot drop group privileges to ${user} (group ID $gid): $!\n";
 127     exit 1;
 128   }
 129
 130   if (!setuid($uid)) {
 131     print "Error: Cannot drop user privileges to ${user} (user ID $uid): $!\n";
 132     exit 1;
 133   }
 134 }
 135
 136 sub notify_on_failure {
 137   my (%params) = @_;
 138
 139   my $cfg = $lx_office_conf{'task_server/notify_on_failure'} || {};
 140
 141   return if any { !$cfg->{$_} } qw(send_email_to email_from email_subject email_template);
 142
 143   chdir $exe_dir;
 144
 145   return debug("Template " . $cfg->{email_template} . " missing!") unless -f $cfg->{email_template};
 146
 147   my $email_to = $cfg->{send_email_to};
 148   if ($email_to !~ m{\@}) {
 149     my %user = $::auth->read_user(login => $email_to);
 150     return debug("cannot find user for notification $email_to") unless %user;
 151
 152     $email_to = $user{email};
 153     return debug("user for notification " . $user{login} . " doesn't have a valid email address") unless $email_to =~ m{\@};
 154   }
 155
 156   my $template  = Template->new({
 157     INTERPOLATE => 0,
 158     EVAL_PERL   => 0,
 159     ABSOLUTE    => 1,
 160     CACHE_SIZE  => 0,
 161     ENCODING    => 'utf8',
 162   });
 163
 164   return debug("Could not create Template instance") unless $template;
 165
 166   $params{client} = $::auth->client;
 167
 168   eval {
 169     my $body;
 170     $template->process($cfg->{email_template}, \%params, \$body);
 171
 172     Mailer->new(
 173       from         => $cfg->{email_from},
 174       to           => $email_to,
 175       subject      => $cfg->{email_subject},
 176       content_type => 'text/plain',
 177       charset      => 'utf-8',
 178       message      => $body,
 179     )->send;
 180
 181     1;
 182   } or do {
 183     debug("Sending a failure notification failed with an exception: $@");
 184   };
 185 }
 186
 187 sub gd_preconfig {
 188   my $self = shift;
 189
 190   # Initialize character type locale to be UTF-8 instead of C:
 191   foreach my $locale (qw(de_DE.UTF-8 en_US.UTF-8)) {
 192     last if setlocale('LC_CTYPE', $locale);
 193   }
 194
 195   SL::LxOfficeConf->read($self->{configfile});
 196
 197   die "Missing section [task_server] in config file" unless $lx_office_conf{task_server};
 198
 199   if ($lx_office_conf{task_server}->{login} || $lx_office_conf{task_server}->{client}) {
 200     print STDERR <<EOT;
 201 ERROR: The keys 'login' and/or 'client' are still present in the
 202 section [task_server] in the configuration file. These keys are
 203 deprecated. You have to configure the clients for which to run the
 204 task server in the web admin interface.
 205
 206 The task server will refuse to start until the keys have been removed from
 207 the configuration file.
 208 EOT
 209     exit 2;
 210   }
 211
 212   initialize_kivitendo();
 213
 214   my $dbupdater_auth = SL::DBUpgrade2->new(form => $::form, auth => 1)->parse_dbupdate_controls;
 215   if ($dbupdater_auth->unapplied_upgrade_scripts($::auth->dbconnect)) {
 216     print STDERR <<EOT;
 217 The authentication database requires an upgrade. Please login to
 218 kivitendo's administration interface in order to apply it. The task
 219 server cannot start until the upgrade has been applied.
 220 EOT
 221     exit 2;
 222   }
 223
 224   drop_privileges();
 225
 226   return ();
 227 }
 228
 229 sub run_single_job_for_all_clients {
 230   initialize_kivitendo();
 231
 232   my $clients = enabled_clients();
 233
 234   foreach my $client (@{ $clients }) {
 235     debug("Running single job ID $run_single_job for client ID " . $client->id . " (" . $client->name . ")");
 236
 237     my $ok = eval {
 238       initialize_kivitendo($client);
 239
 240       my $job = SL::DB::Manager::BackgroundJob->find_by(id => $run_single_job);
 241
 242       if ($job) {
 243         debug(" Executing the following job: " . $job->package_name);
 244       } else {
 245         debug(" No jobs to execute found");
 246         next;
 247       }
 248
 249       # Provide fresh global variables in case legacy code modifies
 250       # them somehow.
 251       initialize_kivitendo($client);
 252
 253       my $history = $job->run;
 254
 255       debug("   Executed job " . $job->package_name .
 256             "; result: " . (!$history ? "no return value" : $history->has_failed ? "failed" : "succeeded") .
 257             ($history && $history->has_failed ? "; error: " . $history->error_col : ""));
 258
 259       notify_on_failure(history => $history) if $history && $history->has_failed;
 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 run_once_for_all_clients {
 275   initialize_kivitendo();
 276
 277   my $clients = enabled_clients();
 278
 279   foreach my $client (@{ $clients }) {
 280     debug("Running for client ID " . $client->id . " (" . $client->name . ")");
 281
 282     my $ok = eval {
 283       initialize_kivitendo($client);
 284
 285       my $jobs = SL::DB::Manager::BackgroundJob->get_all_need_to_run;
 286
 287       if (@{ $jobs }) {
 288         debug(" Executing the following jobs: " . join(' ', map { $_->package_name } @{ $jobs }));
 289       } else {
 290         debug(" No jobs to execute found");
 291       }
 292
 293       foreach my $job (@{ $jobs }) {
 294         # Provide fresh global variables in case legacy code modifies
 295         # them somehow.
 296         initialize_kivitendo($client);
 297
 298         my $history = $job->run;
 299
 300         debug("   Executed job " . $job->package_name .
 301               "; result: " . (!$history ? "no return value" : $history->has_failed ? "failed" : "succeeded") .
 302               ($history && $history->has_failed ? "; error: " . $history->error_col : ""));
 303
 304         notify_on_failure(history => $history) if $history && $history->has_failed;
 305       }
 306
 307       1;
 308     };
 309
 310     if (!$ok) {
 311       my $error = $EVAL_ERROR;
 312       debug("Exception during execution: ${error}");
 313       notify_on_failure(exception => $error);
 314     }
 315
 316     cleanup_kivitendo();
 317   }
 318 }
 319
 320 sub gd_run {
 321   if ($run_single_job) {
 322     run_single_job_for_all_clients();
 323     return;
 324   }
 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       return;
 337     }
 338
 339     my $seconds = 60 - (localtime)[0];
 340     if (!eval {
 341       $SIG{'ALRM'} = sub {
 342         $SIG{'ALRM'} = 'IGNORE';
 343         debug("Got woken up by SIGALRM");
 344         die "Alarm!\n"
 345       };
 346       sleep($seconds < 30 ? $seconds + 60 : $seconds);
 347       1;
 348     }) {
 349       die $@ unless $@ eq "Alarm!\n";
 350     }
 351   }
 352 }
 353
 354 sub gd_flags_more {
 355   return (
 356     '--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',
 357   );
 358 }
 359
 360 $exe_dir = SL::System::Process->exe_dir;
 361 chdir($exe_dir) || die "Cannot change directory to ${exe_dir}\n";
 362
 363 mkdir SL::System::TaskServer::PID_BASE() if !-d SL::System::TaskServer::PID_BASE();
 364
 365 my $file = first { -f } ("${exe_dir}/config/kivitendo.conf", "${exe_dir}/config/lx_office.conf", "${exe_dir}/config/kivitendo.conf.default");
 366
 367 die "No configuration file found." unless $file;
 368
 369 $file = File::Spec->abs2rel(Cwd::abs_path($file), Cwd::abs_path($exe_dir));
 370
 371 newdaemon(configfile => $file,
 372           progname   => 'kivitendo-background-jobs',
 373           pidbase    => SL::System::TaskServer::PID_BASE() . '/',
 374           options    => {
 375             'run-job=i' => \$run_single_job,
 376           },
 377           );
 378
 379 1;