Merge branch 'master' of github.com:kivitendo/kivitendo-erp
[kivitendo-erp.git] / 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::BackgroundJob;
36 use SL::BackgroundJob::ALL;
37 use SL::Form;
38 use SL::Helper::DateTime;
39 use SL::InstanceConfiguration;
40 use SL::LXDebug;
41 use SL::LxOfficeConf;
42 use SL::Locale;
43 use SL::Mailer;
44 use SL::System::TaskServer;
45 use Template;
46
47 our %lx_office_conf;
48
49 sub debug {
50   return if !$lx_office_conf{task_server}->{debug};
51   $::lxdebug->message(0, @_);
52 }
53
54 sub lxinit {
55   my $login  = $lx_office_conf{task_server}->{login};
56   my $client = $lx_office_conf{task_server}->{client};
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   die "No client configured or no client found with the name/ID '$client'" unless $::auth->set_client($client);
65   $::instance_conf = SL::InstanceConfiguration->new;
66   $::request       = { cgi => CGI->new({}) };
67
68   die 'cannot reach auth db'               unless $::auth->session_tables_present;
69
70   $::auth->restore_session;
71
72   require "bin/mozilla/common.pl";
73
74   die "cannot find user $login"            unless %::myconfig = $::auth->read_user(login => $login);
75   die "cannot find locale for user $login" unless $::locale   = Locale->new('de');
76 }
77
78 sub per_job_initialization {
79   $::locale        = Locale->new($::myconfig{countrycode} || $::lx_office_conf{system}->{language});
80   $::form          = Form->new;
81   $::instance_conf = SL::InstanceConfiguration->new;
82   $::request       = SL::Request->new(
83     cgi            => CGI->new({}),
84     layout         => SL::Layout::None->new,
85   );
86
87   $::auth->restore_session;
88
89   $::instance_conf->init;
90
91   $::form->{__ERROR_HANDLER} = sub { die @_ };
92 }
93
94 sub drop_privileges {
95   my $user = $lx_office_conf{task_server}->{run_as};
96   return unless $user;
97
98   my ($uid, $gid);
99   while (my @details = getpwent()) {
100     next unless $details[0] eq $user;
101     ($uid, $gid) = @details[2, 3];
102     last;
103   }
104   endpwent();
105
106   if (!$uid) {
107     print "Error: Cannot drop privileges to ${user}: user does not exist\n";
108     exit 1;
109   }
110
111   if (!setgid($gid)) {
112     print "Error: Cannot drop group privileges to ${user} (group ID $gid): $!\n";
113     exit 1;
114   }
115
116   if (!setuid($uid)) {
117     print "Error: Cannot drop user privileges to ${user} (user ID $uid): $!\n";
118     exit 1;
119   }
120 }
121
122 sub notify_on_failure {
123   my (%params) = @_;
124
125   my $cfg = $lx_office_conf{'task_server/notify_on_failure'} || {};
126
127   return if any { !$cfg->{$_} } qw(send_email_to email_from email_subject email_template);
128
129   chdir $exe_dir;
130
131   return debug("Template " . $cfg->{email_template} . " missing!") unless -f $cfg->{email_template};
132
133   my $email_to = $cfg->{send_email_to};
134   if ($email_to !~ m{\@}) {
135     my %user = $::auth->read_user(login => $email_to);
136     return debug("cannot find user for notification $email_to") unless %user;
137
138     $email_to = $user{email};
139     return debug("user for notification " . $user{login} . " doesn't have a valid email address") unless $email_to =~ m{\@};
140   }
141
142   my $template  = Template->new({
143     INTERPOLATE => 0,
144     EVAL_PERL   => 0,
145     ABSOLUTE    => 1,
146     CACHE_SIZE  => 0,
147   });
148
149   return debug("Could not create Template instance") unless $template;
150
151   $params{client} = $::auth->client;
152
153   my $body;
154   $template->process($cfg->{email_template}, \%params, \$body);
155
156   Mailer->new(
157     from         => $cfg->{email_from},
158     to           => $email_to,
159     subject      => $cfg->{email_subject},
160     content_type => 'text/plain',
161     charset      => 'utf-8',
162     message      => Encode::decode('utf-8', $body),
163   )->send;
164 }
165
166 sub gd_preconfig {
167   my $self = shift;
168
169   SL::LxOfficeConf->read($self->{configfile});
170
171   die "Missing section [task_server] in config file"                 unless $lx_office_conf{task_server};
172   die "Missing key 'login' in section [task_server] in config file"  unless $lx_office_conf{task_server}->{login};
173   die "Missing key 'client' in section [task_server] in config file" unless $lx_office_conf{task_server}->{client};
174
175   drop_privileges();
176   lxinit();
177
178   return ();
179 }
180
181 sub gd_run {
182   while (1) {
183     my $ok = eval {
184       debug("Retrieving jobs");
185
186       my $jobs = SL::DB::Manager::BackgroundJob->get_all_need_to_run;
187
188       debug("  Found: " . join(' ', map { $_->package_name } @{ $jobs })) if @{ $jobs };
189
190       foreach my $job (@{ $jobs }) {
191         # Provide fresh global variables in case legacy code modifies
192         # them somehow.
193         per_job_initialization();
194
195         chdir $exe_dir;
196
197         my $history = $job->run;
198
199         notify_on_failure(history => $history) if $history && $history->has_failed;
200       }
201
202       1;
203     };
204
205     if (!$ok) {
206       my $error = $EVAL_ERROR;
207       debug("Exception during execution: ${error}");
208       notify_on_failure(exception => $error);
209     }
210
211     debug("Sleeping");
212
213     my $seconds = 60 - (localtime)[0];
214     if (!eval {
215       local $SIG{'ALRM'} = sub {
216         debug("Got woken up by SIGALRM");
217         die "Alarm!\n"
218       };
219       sleep($seconds < 30 ? $seconds + 60 : $seconds);
220       1;
221     }) {
222       die $@ unless $@ eq "Alarm!\n";
223     }
224   }
225 }
226
227 sub end_of_request {
228   $main::lxdebug->show_backtrace();
229   die <<EOF;
230 Job called ::end_of_request()!
231
232 This usually indicates success but should not be used by background jobs. A
233 backtrace has been logged. Please tell the job author to have a look at it.
234 EOF
235
236 }
237
238 chdir $exe_dir;
239
240 mkdir SL::System::TaskServer::PID_BASE() if !-d SL::System::TaskServer::PID_BASE();
241
242 my $file = first { -f } ("${exe_dir}/config/kivitendo.conf", "${exe_dir}/config/lx_office.conf", "${exe_dir}/config/kivitendo.conf.default");
243
244 die "No configuration file found." unless $file;
245
246 $file = File::Spec->abs2rel(Cwd::abs_path($file), Cwd::abs_path($exe_dir));
247
248 newdaemon(configfile => $file,
249           progname   => 'kivitendo-background-jobs',
250           pidbase    => SL::System::TaskServer::PID_BASE() . '/',
251           );
252
253 1;