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::DB::AuthClient;
  36 use SL::DB::BackgroundJob;
  37 use SL::BackgroundJob::ALL;
  38 use SL::Form;
  39 use SL::Helper::DateTime;
  40 use SL::InstanceConfiguration;
  41 use SL::LXDebug;
  42 use SL::LxOfficeConf;
  43 use SL::Locale;
  44 use SL::Mailer;
  45 use SL::System::TaskServer;
  46 use Template;
  47
  48 our %lx_office_conf;
  49
  50 sub debug {
  51   return if !$lx_office_conf{task_server}->{debug};
  52   $::lxdebug->message(LXDebug::DEBUG1(), join(' ', "task server:", @_));
  53 }
  54
  55 sub enabled_clients {
  56   return SL::DB::Manager::AuthClient->get_all(where => [ '!task_server_user_id' => undef ]);
  57 }
  58
  59 sub initialize_kivitendo {
  60   my ($client) = @_;
  61
  62   chdir $exe_dir;
  63
  64   package main;
  65
  66   Form::disconnect_standard_dbh;
  67   $::lxdebug       = LXDebug->new;
  68   $::locale        = Locale->new($::lx_office_conf{system}->{language});
  69   $::form          = Form->new;
  70   $::auth          = SL::Auth->new;
  71
  72   return if !$client;
  73
  74   $::auth->set_client($client->id);
  75
  76   $::form->{__ERROR_HANDLER} = sub { die @_ };
  77
  78   $::instance_conf = SL::InstanceConfiguration->new;
  79   $::request       = SL::Request->new(
  80     cgi            => CGI->new({}),
  81     layout         => SL::Layout::None->new,
  82   );
  83
  84   die 'cannot reach auth db'               unless $::auth->session_tables_present;
  85
  86   $::auth->restore_session;
  87   $::auth->create_or_refresh_session;
  88
  89   my $login = $client->task_server_user->login;
  90
  91   die "cannot find user $login"            unless %::myconfig = $::auth->read_user(login => $login);
  92   die "cannot find locale for user $login" unless $::locale   = Locale->new($::myconfig{countrycode} || $::lx_office_conf{system}->{language});
  93 }
  94
  95 sub cleanup_kivitendo {
  96   eval { SL::DB::Auth->new->db->dbh->rollback; };
  97   eval { SL::DB::BackgroundJob->new->db->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
 115 sub drop_privileges {
 116   my $user = $lx_office_conf{task_server}->{run_as};
 117   return unless $user;
 118
 119   my ($uid, $gid);
 120   while (my @details = getpwent()) {
 121     next unless $details[0] eq $user;
 122     ($uid, $gid) = @details[2, 3];
 123     last;
 124   }
 125   endpwent();
 126
 127   if (!$uid) {
 128     print "Error: Cannot drop privileges to ${user}: user does not exist\n";
 129     exit 1;
 130   }
 131
 132   if (!setgid($gid)) {
 133     print "Error: Cannot drop group privileges to ${user} (group ID $gid): $!\n";
 134     exit 1;
 135   }
 136
 137   if (!setuid($uid)) {
 138     print "Error: Cannot drop user privileges to ${user} (user ID $uid): $!\n";
 139     exit 1;
 140   }
 141 }
 142
 143 sub notify_on_failure {
 144   my (%params) = @_;
 145
 146   my $cfg = $lx_office_conf{'task_server/notify_on_failure'} || {};
 147
 148   return if any { !$cfg->{$_} } qw(send_email_to email_from email_subject email_template);
 149
 150   chdir $exe_dir;
 151
 152   return debug("Template " . $cfg->{email_template} . " missing!") unless -f $cfg->{email_template};
 153
 154   my $email_to = $cfg->{send_email_to};
 155   if ($email_to !~ m{\@}) {
 156     my %user = $::auth->read_user(login => $email_to);
 157     return debug("cannot find user for notification $email_to") unless %user;
 158
 159     $email_to = $user{email};
 160     return debug("user for notification " . $user{login} . " doesn't have a valid email address") unless $email_to =~ m{\@};
 161   }
 162
 163   my $template  = Template->new({
 164     INTERPOLATE => 0,
 165     EVAL_PERL   => 0,
 166     ABSOLUTE    => 1,
 167     CACHE_SIZE  => 0,
 168   });
 169
 170   return debug("Could not create Template instance") unless $template;
 171
 172   $params{client} = $::auth->client;
 173
 174   eval {
 175     my $body;
 176     $template->process($cfg->{email_template}, \%params, \$body);
 177
 178     Mailer->new(
 179       from         => $cfg->{email_from},
 180       to           => $email_to,
 181       subject      => $cfg->{email_subject},
 182       content_type => 'text/plain',
 183       charset      => 'utf-8',
 184       message      => Encode::decode('utf-8', $body),
 185     )->send;
 186
 187     1;
 188   } or do {
 189     debug("Sending a failure notification failed with an exception: $@");
 190   };
 191 }
 192
 193 sub gd_preconfig {
 194   my $self = shift;
 195
 196   SL::LxOfficeConf->read($self->{configfile});
 197
 198   die "Missing section [task_server] in config file" unless $lx_office_conf{task_server};
 199
 200   if ($lx_office_conf{task_server}->{login} || $lx_office_conf{task_server}->{client}) {
 201     print STDERR <<EOT;
 202 ERROR: The keys 'login' and/or 'client' are still present in the
 203 section [task_server] in the configuration file. These keys are
 204 deprecated. You have to configure the clients for which to run the
 205 task server in the web admin interface.
 206
 207 The task server will refuse to start until the keys have been removed from
 208 the configuration file.
 209 EOT
 210     exit 2;
 211   }
 212
 213   drop_privileges();
 214
 215   return ();
 216 }
 217
 218 sub run_once_for_all_clients {
 219   initialize_kivitendo();
 220
 221   my $clients = enabled_clients();
 222
 223   foreach my $client (@{ $clients }) {
 224     debug("Running for client ID " . $client->id . " (" . $client->name . ")");
 225
 226     my $ok = eval {
 227       initialize_kivitendo($client);
 228
 229       my $jobs = SL::DB::Manager::BackgroundJob->get_all_need_to_run;
 230
 231       if (@{ $jobs }) {
 232         debug(" Executing the following jobs: " . join(' ', map { $_->package_name } @{ $jobs }));
 233       } else {
 234         debug(" No jobs to execute found");
 235       }
 236
 237       foreach my $job (@{ $jobs }) {
 238         # Provide fresh global variables in case legacy code modifies
 239         # them somehow.
 240         initialize_kivitendo($client);
 241
 242         my $history = $job->run;
 243
 244         notify_on_failure(history => $history) if $history && $history->has_failed;
 245       }
 246
 247       1;
 248     };
 249
 250     if (!$ok) {
 251       my $error = $EVAL_ERROR;
 252       debug("Exception during execution: ${error}");
 253       notify_on_failure(exception => $error);
 254     }
 255
 256     cleanup_kivitendo();
 257   }
 258 }
 259
 260 sub gd_run {
 261   while (1) {
 262     run_once_for_all_clients();
 263
 264     debug("Sleeping");
 265
 266     clean_before_sleeping();
 267
 268     my $seconds = 60 - (localtime)[0];
 269     if (!eval {
 270       local $SIG{'ALRM'} = sub {
 271         debug("Got woken up by SIGALRM");
 272         die "Alarm!\n"
 273       };
 274       sleep($seconds < 30 ? $seconds + 60 : $seconds);
 275       1;
 276     }) {
 277       die $@ unless $@ eq "Alarm!\n";
 278     }
 279   }
 280 }
 281
 282 sub end_of_request {
 283   $main::lxdebug->show_backtrace();
 284   die <<EOF;
 285 Job called ::end_of_request()!
 286
 287 This usually indicates success but should not be used by background jobs. A
 288 backtrace has been logged. Please tell the job author to have a look at it.
 289 EOF
 290
 291 }
 292
 293 chdir $exe_dir;
 294
 295 mkdir SL::System::TaskServer::PID_BASE() if !-d SL::System::TaskServer::PID_BASE();
 296
 297 my $file = first { -f } ("${exe_dir}/config/kivitendo.conf", "${exe_dir}/config/lx_office.conf", "${exe_dir}/config/kivitendo.conf.default");
 298
 299 die "No configuration file found." unless $file;
 300
 301 $file = File::Spec->abs2rel(Cwd::abs_path($file), Cwd::abs_path($exe_dir));
 302
 303 newdaemon(configfile => $file,
 304           progname   => 'kivitendo-background-jobs',
 305           pidbase    => SL::System::TaskServer::PID_BASE() . '/',
 306           );
 307
 308 1;