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::DBUpgrade2;
  36 use SL::DB::AuthClient;
  37 use SL::DB::BackgroundJob;
  38 use SL::BackgroundJob::ALL;
  39 use SL::Form;
  40 use SL::Helper::DateTime;
  41 use SL::InstanceConfiguration;
  42 use SL::LXDebug;
  43 use SL::LxOfficeConf;
  44 use SL::Locale;
  45 use SL::Mailer;
  46 use SL::System::TaskServer;
  47 use Template;
  48
  49 our %lx_office_conf;
  50
  51 sub debug {
  52   return if !$lx_office_conf{task_server}->{debug};
  53   $::lxdebug->message(LXDebug::DEBUG1(), join(' ', "task server:", @_));
  54 }
  55
  56 sub enabled_clients {
  57   return SL::DB::Manager::AuthClient->get_all(where => [ '!task_server_user_id' => undef ]);
  58 }
  59
  60 sub initialize_kivitendo {
  61   my ($client) = @_;
  62
  63   chdir $exe_dir;
  64
  65   package main;
  66
  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->client->dbh->rollback; };
  97
  98   $::auth->save_session;
  99   $::auth->expire_sessions;
 100   $::auth->reset;
 101
 102   $::form     = undef;
 103   $::myconfig = ();
 104   $::request  = undef;
 105   $::auth     = undef;
 106 }
 107
 108 sub clean_before_sleeping {
 109   SL::DBConnect::Cache->disconnect_all_and_clear;
 110   SL::DB->db_cache->clear;
 111
 112   File::Temp::cleanup();
 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   initialize_kivitendo();
 214
 215   my $dbupdater_auth = SL::DBUpgrade2->new(form => $::form, auth => 1)->parse_dbupdate_controls;
 216   if ($dbupdater_auth->unapplied_upgrade_scripts($::auth->dbconnect)) {
 217     print STDERR <<EOT;
 218 The authentication database requires an upgrade. Please login to
 219 kivitendo's administration interface in order to apply it. The task
 220 server cannot start until the upgrade has been applied.
 221 EOT
 222     exit 2;
 223   }
 224
 225   drop_privileges();
 226
 227   return ();
 228 }
 229
 230 sub run_once_for_all_clients {
 231   initialize_kivitendo();
 232
 233   my $clients = enabled_clients();
 234
 235   foreach my $client (@{ $clients }) {
 236     debug("Running for client ID " . $client->id . " (" . $client->name . ")");
 237
 238     my $ok = eval {
 239       initialize_kivitendo($client);
 240
 241       my $jobs = SL::DB::Manager::BackgroundJob->get_all_need_to_run;
 242
 243       if (@{ $jobs }) {
 244         debug(" Executing the following jobs: " . join(' ', map { $_->package_name } @{ $jobs }));
 245       } else {
 246         debug(" No jobs to execute found");
 247       }
 248
 249       foreach my $job (@{ $jobs }) {
 250         # Provide fresh global variables in case legacy code modifies
 251         # them somehow.
 252         initialize_kivitendo($client);
 253
 254         my $history = $job->run;
 255
 256         notify_on_failure(history => $history) if $history && $history->has_failed;
 257       }
 258
 259       1;
 260     };
 261
 262     if (!$ok) {
 263       my $error = $EVAL_ERROR;
 264       debug("Exception during execution: ${error}");
 265       notify_on_failure(exception => $error);
 266     }
 267
 268     cleanup_kivitendo();
 269   }
 270 }
 271
 272 sub gd_run {
 273   while (1) {
 274     $SIG{'ALRM'} = 'IGNORE';
 275
 276     run_once_for_all_clients();
 277
 278     debug("Sleeping");
 279
 280     clean_before_sleeping();
 281
 282     my $seconds = 60 - (localtime)[0];
 283     if (!eval {
 284       $SIG{'ALRM'} = sub {
 285         $SIG{'ALRM'} = 'IGNORE';
 286         debug("Got woken up by SIGALRM");
 287         die "Alarm!\n"
 288       };
 289       sleep($seconds < 30 ? $seconds + 60 : $seconds);
 290       1;
 291     }) {
 292       die $@ unless $@ eq "Alarm!\n";
 293     }
 294   }
 295 }
 296
 297 chdir $exe_dir;
 298
 299 mkdir SL::System::TaskServer::PID_BASE() if !-d SL::System::TaskServer::PID_BASE();
 300
 301 my $file = first { -f } ("${exe_dir}/config/kivitendo.conf", "${exe_dir}/config/lx_office.conf", "${exe_dir}/config/kivitendo.conf.default");
 302
 303 die "No configuration file found." unless $file;
 304
 305 $file = File::Spec->abs2rel(Cwd::abs_path($file), Cwd::abs_path($exe_dir));
 306
 307 newdaemon(configfile => $file,
 308           progname   => 'kivitendo-background-jobs',
 309           pidbase    => SL::System::TaskServer::PID_BASE() . '/',
 310           );
 311
 312 1;