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 Encode qw();
  21 use English qw(-no_match_vars);
  22 use File::Spec;
  23 use List::MoreUtils qw(any);
  24 use List::Util qw(first);
  25 use POSIX qw(setuid setgid);
  26 use SL::Auth;
  27 use SL::DBUpgrade2;
  28 use SL::DB::AuthClient;
  29 use SL::DB::BackgroundJob;
  30 use SL::BackgroundJob::ALL;
  31 use SL::Form;
  32 use SL::Helper::DateTime;
  33 use SL::InstanceConfiguration;
  34 use SL::LXDebug;
  35 use SL::LxOfficeConf;
  36 use SL::Locale;
  37 use SL::Mailer;
  38 use SL::System::Process;
  39 use SL::System::TaskServer;
  40 use Template;
  41
  42 our %lx_office_conf;
  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   });
 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      => Encode::decode('utf-8', $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   SL::LxOfficeConf->read($self->{configfile});
 190
 191   die "Missing section [task_server] in config file" unless $lx_office_conf{task_server};
 192
 193   if ($lx_office_conf{task_server}->{login} || $lx_office_conf{task_server}->{client}) {
 194     print STDERR <<EOT;
 195 ERROR: The keys 'login' and/or 'client' are still present in the
 196 section [task_server] in the configuration file. These keys are
 197 deprecated. You have to configure the clients for which to run the
 198 task server in the web admin interface.
 199
 200 The task server will refuse to start until the keys have been removed from
 201 the configuration file.
 202 EOT
 203     exit 2;
 204   }
 205
 206   initialize_kivitendo();
 207
 208   my $dbupdater_auth = SL::DBUpgrade2->new(form => $::form, auth => 1)->parse_dbupdate_controls;
 209   if ($dbupdater_auth->unapplied_upgrade_scripts($::auth->dbconnect)) {
 210     print STDERR <<EOT;
 211 The authentication database requires an upgrade. Please login to
 212 kivitendo's administration interface in order to apply it. The task
 213 server cannot start until the upgrade has been applied.
 214 EOT
 215     exit 2;
 216   }
 217
 218   drop_privileges();
 219
 220   return ();
 221 }
 222
 223 sub run_once_for_all_clients {
 224   initialize_kivitendo();
 225
 226   my $clients = enabled_clients();
 227
 228   foreach my $client (@{ $clients }) {
 229     debug("Running for client ID " . $client->id . " (" . $client->name . ")");
 230
 231     my $ok = eval {
 232       initialize_kivitendo($client);
 233
 234       my $jobs = SL::DB::Manager::BackgroundJob->get_all_need_to_run;
 235
 236       if (@{ $jobs }) {
 237         debug(" Executing the following jobs: " . join(' ', map { $_->package_name } @{ $jobs }));
 238       } else {
 239         debug(" No jobs to execute found");
 240       }
 241
 242       foreach my $job (@{ $jobs }) {
 243         # Provide fresh global variables in case legacy code modifies
 244         # them somehow.
 245         initialize_kivitendo($client);
 246
 247         my $history = $job->run;
 248
 249         notify_on_failure(history => $history) if $history && $history->has_failed;
 250       }
 251
 252       1;
 253     };
 254
 255     if (!$ok) {
 256       my $error = $EVAL_ERROR;
 257       debug("Exception during execution: ${error}");
 258       notify_on_failure(exception => $error);
 259     }
 260
 261     cleanup_kivitendo();
 262   }
 263 }
 264
 265 sub gd_run {
 266   while (1) {
 267     $SIG{'ALRM'} = 'IGNORE';
 268
 269     run_once_for_all_clients();
 270
 271     debug("Sleeping");
 272
 273     clean_before_sleeping();
 274
 275     my $seconds = 60 - (localtime)[0];
 276     if (!eval {
 277       $SIG{'ALRM'} = sub {
 278         $SIG{'ALRM'} = 'IGNORE';
 279         debug("Got woken up by SIGALRM");
 280         die "Alarm!\n"
 281       };
 282       sleep($seconds < 30 ? $seconds + 60 : $seconds);
 283       1;
 284     }) {
 285       die $@ unless $@ eq "Alarm!\n";
 286     }
 287   }
 288 }
 289
 290 $exe_dir = SL::System::Process->exe_dir;
 291 chdir($exe_dir) || die "Cannot change directory to ${exe_dir}\n";
 292
 293 mkdir SL::System::TaskServer::PID_BASE() if !-d SL::System::TaskServer::PID_BASE();
 294
 295 my $file = first { -f } ("${exe_dir}/config/kivitendo.conf", "${exe_dir}/config/lx_office.conf", "${exe_dir}/config/kivitendo.conf.default");
 296
 297 die "No configuration file found." unless $file;
 298
 299 $file = File::Spec->abs2rel(Cwd::abs_path($file), Cwd::abs_path($exe_dir));
 300
 301 newdaemon(configfile => $file,
 302           progname   => 'kivitendo-background-jobs',
 303           pidbase    => SL::System::TaskServer::PID_BASE() . '/',
 304           );
 305
 306 1;