Task-Server: Debug-Meldung, falls Beendigung wg. Memory-Limit.
[kivitendo-erp.git] / 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       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;