do not allow user names including slash
[pve-access-control.git] / PVE / RPCEnvironment.pm
CommitLineData
2c3a6c0a
DM
1package PVE::RPCEnvironment;
2
3use strict;
4use warnings;
8d6e045f 5use POSIX qw(:sys_wait_h EINTR);
b28410fc 6use IO::Handle;
2c3a6c0a 7use IO::File;
b28410fc 8use IO::Select;
2c3a6c0a 9use Fcntl qw(:flock);
37d45deb 10use PVE::Exception qw(raise raise_perm_exc);
2c3a6c0a
DM
11use PVE::SafeSyslog;
12use PVE::Tools;
13use PVE::INotify;
14use PVE::Cluster;
15use PVE::ProcFSTools;
16use PVE::AccessControl;
3eac4e35 17use Cwd 'abs_path';
7b24102d 18use CGI;
2c3a6c0a
DM
19
20# we use this singleton class to pass RPC related environment values
21
22my $pve_env;
23
24# save $SIG{CHLD} handler implementation.
25# simply set $SIG{CHLD} = $worker_reaper;
26# and register forked processes with &$register_worker(pid)
27# Note: using $SIG{CHLD} = 'IGNORE' or $SIG{CHLD} = sub { wait (); } or ...
28# has serious side effects, because perls built in system() and open()
29# functions can't get the correct exit status of a child. So we cant use
30# that (also see perlipc)
31
32my $WORKER_PIDS;
33
34my $log_task_result = sub {
35 my ($upid, $user, $status) = @_;
36
37 my $msg = 'successful';
38 my $pri = 'info';
39 if ($status != 0) {
40 my $ec = $status >> 8;
41 my $ic = $status & 255;
42 $msg = $ec ? "failed ($ec)" : "interrupted ($ic)";
43 $pri = 'err';
44 }
45 my $tlist = active_workers($upid);
46 PVE::Cluster::broadcast_tasklist($tlist);
47 my $task;
48 foreach my $t (@$tlist) {
49 if ($t->{upid} eq $upid) {
50 $task = $t;
51 last;
52 }
53 }
54 if ($task && $task->{status}) {
55 $msg = $task->{status};
56 }
57 PVE::Cluster::log_msg($pri, $user, "end task $upid $msg");
58};
59
60my $worker_reaper = sub {
61 local $!; local $?;
62 foreach my $pid (keys %$WORKER_PIDS) {
63 my $waitpid = waitpid ($pid, WNOHANG);
64 if (defined($waitpid) && ($waitpid == $pid)) {
65 my $info = $WORKER_PIDS->{$pid};
66 if ($info && $info->{upid} && $info->{user}) {
67 &$log_task_result($info->{upid}, $info->{user}, $?);
68 }
69 delete ($WORKER_PIDS->{$pid});
70 }
71 }
72};
73
74my $register_worker = sub {
75 my ($pid, $user, $upid) = @_;
76
77 return if !$pid;
78
79 # do not register if already finished
80 my $waitpid = waitpid ($pid, WNOHANG);
81 if (defined($waitpid) && ($waitpid == $pid)) {
82 delete ($WORKER_PIDS->{$pid});
83 return;
84 }
85
86 $WORKER_PIDS->{$pid} = {
87 user => $user,
88 upid => $upid,
89 };
90};
91
92# ACL cache
93
4bc17477
DM
94my $compile_acl_path = sub {
95 my ($self, $user, $path) = @_;
2c3a6c0a 96
2c3a6c0a
DM
97 my $cfg = $self->{user_cfg};
98
99 return undef if !$cfg->{roles};
100
4bc17477 101 die "internal error" if $user eq 'root@pam';
2c3a6c0a 102
4bc17477
DM
103 my $cache = $self->{aclcache};
104 $cache->{$user} = {} if !$cache->{$user};
105 my $data = $cache->{$user};
2c3a6c0a 106
4bc17477
DM
107 if (!$data->{poolroles}) {
108 $data->{poolroles} = {};
109
39c85db8
DM
110 foreach my $pool (keys %{$cfg->{pools}}) {
111 my $d = $cfg->{pools}->{$pool};
112 my @ra = PVE::AccessControl::roles($cfg, $user, "/pool/$pool"); # pool roles
4bc17477
DM
113 next if !scalar(@ra);
114 foreach my $vmid (keys %{$d->{vms}}) {
115 for my $role (@ra) {
116 $data->{poolroles}->{"/vms/$vmid"}->{$role} = 1;
2c3a6c0a
DM
117 }
118 }
4bc17477
DM
119 foreach my $storeid (keys %{$d->{storage}}) {
120 for my $role (@ra) {
121 $data->{poolroles}->{"/storage/$storeid"}->{$role} = 1;
122 }
123 }
124 }
125 }
126
127 my @ra = PVE::AccessControl::roles($cfg, $user, $path);
128
129 # apply roles inherited from pools
130 # Note: assume we do not want to propagate those privs
131 if ($data->{poolroles}->{$path}) {
132 if (!($ra[0] && $ra[0] eq 'NoAccess')) {
8ade28e6
DM
133 if ($data->{poolroles}->{$path}->{NoAccess}) {
134 @ra = ('NoAccess');
135 } else {
136 foreach my $role (keys %{$data->{poolroles}->{$path}}) {
137 push @ra, $role;
138 }
4bc17477 139 }
2c3a6c0a 140 }
4bc17477 141 }
2c3a6c0a 142
4bc17477
DM
143 $data->{roles}->{$path} = [ @ra ];
144
145 my $privs = {};
146 foreach my $role (@ra) {
147 if (my $privset = $cfg->{roles}->{$role}) {
148 foreach my $p (keys %$privset) {
149 $privs->{$p} = 1;
150 }
151 }
2c3a6c0a 152 }
4bc17477 153 $data->{privs}->{$path} = $privs;
2c3a6c0a 154
4bc17477 155 return $privs;
2c3a6c0a
DM
156};
157
4bc17477
DM
158sub roles {
159 my ($self, $user, $path) = @_;
160
161 if ($user eq 'root@pam') { # root can do anything
162 return ('Administrator');
163 }
164
165 $user = PVE::AccessControl::verify_username($user, 1);
166 return () if !$user;
167
168 my $cache = $self->{aclcache};
169 $cache->{$user} = {} if !$cache->{$user};
170
171 my $acl = $cache->{$user};
172
173 my $roles = $acl->{roles}->{$path};
174 return @$roles if $roles;
175
176 &$compile_acl_path($self, $user, $path);
177 $roles = $acl->{roles}->{$path} || [];
178 return @$roles;
179}
180
2c3a6c0a
DM
181sub permissions {
182 my ($self, $user, $path) = @_;
183
4bc17477
DM
184 if ($user eq 'root@pam') { # root can do anything
185 my $cfg = $self->{user_cfg};
186 return $cfg->{roles}->{'Administrator'};
187 }
188
2c3a6c0a
DM
189 $user = PVE::AccessControl::verify_username($user, 1);
190 return {} if !$user;
191
192 my $cache = $self->{aclcache};
4bc17477 193 $cache->{$user} = {} if !$cache->{$user};
2c3a6c0a
DM
194
195 my $acl = $cache->{$user};
196
4bc17477
DM
197 my $perm = $acl->{privs}->{$path};
198 return $perm if $perm;
2c3a6c0a 199
4bc17477 200 return &$compile_acl_path($self, $user, $path);
2c3a6c0a
DM
201}
202
203sub check {
37d45deb 204 my ($self, $user, $path, $privs, $noerr) = @_;
2c3a6c0a
DM
205
206 my $perm = $self->permissions($user, $path);
207
208 foreach my $priv (@$privs) {
37d45deb
DM
209 PVE::AccessControl::verify_privname($priv);
210 if (!$perm->{$priv}) {
211 return undef if $noerr;
212 raise_perm_exc("$path, $priv");
213 }
2c3a6c0a
DM
214 };
215
216 return 1;
217};
218
37d45deb
DM
219sub check_any {
220 my ($self, $user, $path, $privs, $noerr) = @_;
221
222 my $perm = $self->permissions($user, $path);
efce1d57 223
37d45deb
DM
224 my $found = 0;
225 foreach my $priv (@$privs) {
226 PVE::AccessControl::verify_privname($priv);
227 if ($perm->{$priv}) {
228 $found = 1;
229 last;
230 }
231 };
232
233 return 1 if $found;
234
235 return undef if $noerr;
236
237 raise_perm_exc("$path, " . join("|", @$privs));
238};
239
c4a776a6
DM
240sub check_full {
241 my ($self, $username, $path, $privs, $any, $noerr) = @_;
242 if ($any) {
243 return $self->check_any($username, $path, $privs, $noerr);
244 } else {
245 return $self->check($username, $path, $privs, $noerr);
246 }
247}
248
7070c1ae
DM
249sub check_user_enabled {
250 my ($self, $user, $noerr) = @_;
2c3a6c0a
DM
251
252 my $cfg = $self->{user_cfg};
7070c1ae 253 return PVE::AccessControl::check_user_enabled($cfg, $user, $noerr);
2c3a6c0a
DM
254}
255
37d45deb
DM
256sub check_user_exist {
257 my ($self, $user, $noerr) = @_;
258
259 my $cfg = $self->{user_cfg};
260 return PVE::AccessControl::check_user_exist($cfg, $user, $noerr);
261}
262
a23cec1f
DM
263sub check_pool_exist {
264 my ($self, $pool, $noerr) = @_;
265
266 my $cfg = $self->{user_cfg};
267
268 return 1 if $cfg->{pools}->{$pool};
269
270 return undef if $noerr;
271
272 raise_perm_exc("pool '$pool' does not exist");
273}
274
275sub check_vm_perm {
276 my ($self, $user, $vmid, $pool, $privs, $any, $noerr) = @_;
277
278 my $cfg = $self->{user_cfg};
279
280 if ($pool) {
281 return if $self->check_full($user, "/pool/$pool", $privs, $any, 1);
282 }
283 return $self->check_full($user, "/vms/$vmid", $privs, $any, $noerr);
284};
285
17ecec71 286sub check_volume_access {
fef1bc17
DM
287 my ($self, $user, $storecfg, $vmid, $volid) = @_;
288
289 # test if we have read access to volid
290
291 my $path;
3eac4e35
DM
292 my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
293 if ($sid) {
fef1bc17
DM
294 my ($ownervm, $vtype);
295 ($path, $ownervm, $vtype) = PVE::Storage::path($storecfg, $volid);
296 if ($vtype eq 'iso' || $vtype eq 'vztmpl') {
297 # we simply allow access
298 } elsif (!$ownervm || ($ownervm != $vmid)) {
299 # allow if we are Datastore administrator
300 $self->check($user, "/storage/$sid", ['Datastore.Allocate']);
301 }
302 } else {
303 die "Only root can pass arbitrary filesystem paths."
304 if $user ne 'root@pam';
305
306 $path = abs_path($volid);
307 }
308 return $path;
309}
310
37d45deb
DM
311sub is_group_member {
312 my ($self, $group, $user) = @_;
313
314 my $cfg = $self->{user_cfg};
315
316 return 0 if !$cfg->{groups}->{$group};
317
318 return defined($cfg->{groups}->{$group}->{users}->{$user});
319}
320
321sub filter_groups {
b9180ed2 322 my ($self, $user, $privs, $any) = @_;
37d45deb
DM
323
324 my $cfg = $self->{user_cfg};
325
326 my $groups = {};
327 foreach my $group (keys %{$cfg->{groups}}) {
b9180ed2 328 my $path = "/access/groups/$group";
c4a776a6
DM
329 if ($self->check_full($user, $path, $privs, $any, 1)) {
330 $groups->{$group} = $cfg->{groups}->{$group};
37d45deb
DM
331 }
332 }
333
334 return $groups;
335}
336
337sub group_member_join {
338 my ($self, $grouplist) = @_;
339
340 my $users = {};
341
342 my $cfg = $self->{user_cfg};
343 foreach my $group (@$grouplist) {
344 my $data = $cfg->{groups}->{$group};
345 next if !$data;
346 foreach my $user (keys %{$data->{users}}) {
347 $users->{$user} = 1;
348 }
349 }
350
351 return $users;
352}
353
e3a3a0d7
DM
354sub check_perm_modify {
355 my ($self, $username, $path, $noerr) = @_;
356
357 return $self->check($username, '/access', [ 'Permissions.Modify' ], $noerr) if !$path;
358
359 my $testperms = [ 'Permissions.Modify' ];
360 if ($path =~ m|^/storage/.+$|) {
361 push @$testperms, 'Datastore.Allocate';
362 } elsif ($path =~ m|^/vms/.+$|) {
363 push @$testperms, 'VM.Allocate';
7a7a517a
DM
364 } elsif ($path =~ m|^/pool/.+$|) {
365 push @$testperms, 'Pool.Allocate';
e3a3a0d7
DM
366 }
367
368 return $self->check_any($username, $path, $testperms, $noerr);
369}
370
f8cc5a5f
DM
371sub exec_api2_perm_check {
372 my ($self, $check, $username, $param, $noerr) = @_;
373
374 # syslog("info", "CHECK " . join(', ', @$check));
375
376 my $ind = 0;
377 my $test = $check->[$ind++];
378 die "no permission test specified" if !$test;
379
380 if ($test eq 'and') {
381 while (my $subcheck = $check->[$ind++]) {
382 $self->exec_api2_perm_check($subcheck, $username, $param);
383 }
384 return 1;
385 } elsif ($test eq 'or') {
386 while (my $subcheck = $check->[$ind++]) {
387 return 1 if $self->exec_api2_perm_check($subcheck, $username, $param, 1);
388 }
389 return 0 if $noerr;
390 raise_perm_exc();
391 } elsif ($test eq 'perm') {
392 my ($t, $tmplpath, $privs, %options) = @$check;
393 my $any = $options{any};
394 die "missing parameters" if !($tmplpath && $privs);
c4a776a6
DM
395 my $require_param = $options{require_param};
396 if ($require_param && !defined($param->{$require_param})) {
397 return 0 if $noerr;
398 raise_perm_exc();
399 }
f8cc5a5f 400 my $path = PVE::Tools::template_replace($tmplpath, $param);
e3a3a0d7 401 $path = PVE::AccessControl::normalize_path($path);
c4a776a6 402 return $self->check_full($username, $path, $privs, $any, $noerr);
f8cc5a5f
DM
403 } elsif ($test eq 'userid-group') {
404 my $userid = $param->{userid};
405 my ($t, $privs, %options) = @$check;
82b63965
DM
406 return 0 if !$options{groups_param} && !$self->check_user_exist($userid, $noerr);
407 if (!$self->check_any($username, "/access/groups", $privs, 1)) {
f8cc5a5f
DM
408 my $groups = $self->filter_groups($username, $privs, 1);
409 if ($options{groups_param}) {
410 my @group_param = PVE::Tools::split_list($param->{groups});
82b63965 411 raise_perm_exc("/access/groups, " . join("|", @$privs)) if !scalar(@group_param);
f8cc5a5f
DM
412 foreach my $pg (@group_param) {
413 raise_perm_exc("/access/groups/$pg, " . join("|", @$privs))
414 if !$groups->{$pg};
415 }
416 } else {
417 my $allowed_users = $self->group_member_join([keys %$groups]);
418 if (!$allowed_users->{$userid}) {
419 return 0 if $noerr;
420 raise_perm_exc();
421 }
422 }
423 }
424 return 1;
425 } elsif ($test eq 'userid-param') {
09d27058 426 my ($userid, undef, $realm) = PVE::AccessControl::verify_username($param->{userid});
f8cc5a5f
DM
427 my ($t, $subtest) = @$check;
428 die "missing parameters" if !$subtest;
429 if ($subtest eq 'self') {
a69bbe2e 430 return 0 if !$self->check_user_exist($userid, $noerr);
1cf154b7 431 return 1 if $username eq $userid;
f8cc5a5f
DM
432 return 0 if $noerr;
433 raise_perm_exc();
82b63965
DM
434 } elsif ($subtest eq 'Realm.AllocateUser') {
435 my $path = "/access/realm/$realm";
436 return $self->check($username, $path, ['Realm.AllocateUser'], $noerr);
f8cc5a5f
DM
437 } else {
438 die "unknown userid-param test";
439 }
82b63965 440 } elsif ($test eq 'perm-modify') {
e3a3a0d7
DM
441 my ($t, $tmplpath) = @$check;
442 my $path = PVE::Tools::template_replace($tmplpath, $param);
443 $path = PVE::AccessControl::normalize_path($path);
444 return $self->check_perm_modify($username, $path, $noerr);
445 } else {
f8cc5a5f
DM
446 die "unknown permission test";
447 }
448};
449
450sub check_api2_permissions {
451 my ($self, $perm, $username, $param) = @_;
452
453 return 1 if !$username && $perm->{user} eq 'world';
454
455 raise_perm_exc("user != null") if !$username;
456
457 return 1 if $username eq 'root@pam';
458
459 raise_perm_exc('user != root@pam') if !$perm;
460
461 return 1 if $perm->{user} && $perm->{user} eq 'all';
462
463 return $self->exec_api2_perm_check($perm->{check}, $username, $param)
464 if $perm->{check};
465
466 raise_perm_exc();
467}
468
2c3a6c0a
DM
469# initialize environment - must be called once at program startup
470sub init {
471 my ($class, $type, %params) = @_;
472
473 $class = ref($class) || $class;
474
475 die "already initialized" if $pve_env;
476
e42eedbc 477 die "unknown environment type" if !$type || $type !~ m/^(cli|pub|priv|ha)$/;
2c3a6c0a
DM
478
479 $SIG{CHLD} = $worker_reaper;
480
481 # environment types
482 # cli ... command started fron command line
483 # pub ... access from public server (apache)
484 # priv ... access from private server (pvedaemon)
e42eedbc 485 # ha ... access from HA resource manager agent (rgmanager)
2c3a6c0a
DM
486
487 my $self = {
488 user_cfg => {},
489 aclcache => {},
490 aclversion => undef,
491 type => $type,
492 };
493
494 bless $self, $class;
495
496 foreach my $p (keys %params) {
497 if ($p eq 'atfork') {
498 $self->{$p} = $params{$p};
499 } else {
500 die "unknown option '$p'";
501 }
502 }
503
504 $pve_env = $self;
505
506 my ($sysname, $nodename) = POSIX::uname();
507
508 $nodename =~ s/\..*$//; # strip domain part, if any
509
510 $self->{nodename} = $nodename;
511
512 return $self;
513};
514
515# get the singleton
516sub get {
517
518 die "not initialized" if !$pve_env;
519
520 return $pve_env;
521}
522
7b24102d
DM
523sub parse_params {
524 my ($self, $enable_upload) = @_;
525
526 if ($self->{request_rec}) {
527 my $cgi;
528 if ($enable_upload) {
529 $cgi = CGI->new($self->{request_rec});
530 } else {
531 # disable upload using empty upload_hook
532 $cgi = CGI->new($self->{request_rec}, sub {}, undef, 0);
533 }
534 $self->{cgi} = $cgi;
535 my $params = $cgi->Vars();
76c377c1 536 return PVE::Tools::decode_utf8_parameters($params);
7b24102d
DM
537 } elsif ($self->{params}) {
538 return $self->{params};
539 } else {
540 die "no parameters registered";
541 }
542}
543
544sub get_upload_info {
545 my ($self, $param) = @_;
546
547 my $cgi = $self->{cgi};
548 die "CGI not initialized" if !$cgi;
549
550 my $pd = $cgi->param($param);
551 die "unable to get cgi parameter info\n" if !$pd;
552 my $info = $cgi->uploadInfo($pd);
553 die "unable to get cgi upload info\n" if !$info;
554
555 my $res = { %$info };
556
557 my $tmpfilename = $cgi->tmpFileName($pd);
558 die "unable to get cgi upload file name\n" if !$tmpfilename;
559 $res->{tmpfilename} = $tmpfilename;
560
561 #my $hndl = $cgi->upload($param);
562 #die "unable to get cgi upload handle\n" if !$hndl;
563 #$res->{handle} = $hndl->handle;
564
565 return $res;
566}
567
2c3a6c0a
DM
568# init_request - must be called before each RPC request
569sub init_request {
570 my ($self, %params) = @_;
571
572 PVE::Cluster::cfs_update();
573
be6ea723 574 $self->{result_attributes} = {};
272fe9ff 575
2c3a6c0a
DM
576 my $userconfig; # we use this for regression tests
577 foreach my $p (keys %params) {
578 if ($p eq 'userconfig') {
579 $userconfig = $params{$p};
7b24102d
DM
580 } elsif ($p eq 'request_rec') {
581 # pass Apache2::RequestRec
582 $self->{request_rec} = $params{$p};
583 } elsif ($p eq 'params') {
584 $self->{params} = $params{$p};
2c3a6c0a
DM
585 } else {
586 die "unknown parameter '$p'";
587 }
588 }
589
590 eval {
591 $self->{aclcache} = {};
592 if ($userconfig) {
593 my $ucdata = PVE::Tools::file_get_contents($userconfig);
594 my $cfg = PVE::AccessControl::parse_user_config($userconfig, $ucdata);
595 $self->{user_cfg} = $cfg;
4bc17477 596 #print Dumper($cfg);
2c3a6c0a
DM
597 } else {
598 my $ucvers = PVE::Cluster::cfs_file_version('user.cfg');
599 if (!$self->{aclcache} || !defined($self->{aclversion}) ||
600 !defined($ucvers) || ($ucvers ne $self->{aclversion})) {
601 $self->{aclversion} = $ucvers;
602 my $cfg = PVE::Cluster::cfs_read_file('user.cfg');
603 $self->{user_cfg} = $cfg;
604 }
605 }
606 };
607 if (my $err = $@) {
608 $self->{user_cfg} = {};
609 die "Unable to load access control list: $err";
610 }
611}
612
613sub set_client_ip {
614 my ($self, $ip) = @_;
615
616 $self->{client_ip} = $ip;
617}
618
619sub get_client_ip {
620 my ($self) = @_;
621
622 return $self->{client_ip};
623}
624
be6ea723
DM
625sub set_result_attrib {
626 my ($self, $key, $value) = @_;
2c3a6c0a 627
be6ea723 628 $self->{result_attributes}->{$key} = $value;
2c3a6c0a
DM
629}
630
be6ea723
DM
631sub get_result_attrib {
632 my ($self, $key) = @_;
272fe9ff 633
be6ea723 634 return $self->{result_attributes}->{$key};
272fe9ff
DM
635}
636
2c3a6c0a
DM
637sub set_language {
638 my ($self, $lang) = @_;
639
640 # fixme: initialize I18N
641
642 $self->{language} = $lang;
643}
644
645sub get_language {
646 my ($self) = @_;
647
648 return $self->{language};
649}
650
651sub set_user {
652 my ($self, $user) = @_;
653
654 # fixme: get ACLs
655
656 $self->{user} = $user;
657}
658
659sub get_user {
660 my ($self) = @_;
661
662 die "user name not set\n" if !$self->{user};
663
664 return $self->{user};
665}
666
667# read/update list of active workers
668# we move all finished tasks to the archive index,
669# but keep aktive and most recent task in the active file.
5bf71a96
DM
670# $nocheck ... consider $new_upid still running (avoid that
671# we try to read the reult to early.
2c3a6c0a 672sub active_workers {
5bf71a96 673 my ($new_upid, $nocheck) = @_;
2c3a6c0a
DM
674
675 my $lkfn = "/var/log/pve/tasks/.active.lock";
676
677 my $timeout = 10;
678
679 my $code = sub {
680
681 my $tasklist = PVE::INotify::read_file('active');
682
683 my @ta;
684 my $tlist = [];
685 my $thash = {}; # only list task once
686
687 my $check_task = sub {
d33d0735 688 my ($task, $running) = @_;
2c3a6c0a 689
d33d0735 690 if ($running || PVE::ProcFSTools::check_process_running($task->{pid}, $task->{pstart})) {
2c3a6c0a
DM
691 push @$tlist, $task;
692 } else {
693 delete $task->{pid};
694 push @ta, $task;
695 }
696 delete $task->{pstart};
697 };
698
699 foreach my $task (@$tasklist) {
700 my $upid = $task->{upid};
701 next if $thash->{$upid};
702 $thash->{$upid} = $task;
703 &$check_task($task);
704 }
705
706 if ($new_upid && !(my $task = $thash->{$new_upid})) {
707 $task = PVE::Tools::upid_decode($new_upid);
708 $task->{upid} = $new_upid;
709 $thash->{$new_upid} = $task;
d33d0735 710 &$check_task($task, $nocheck);
2c3a6c0a
DM
711 }
712
713
714 @ta = sort { $b->{starttime} cmp $a->{starttime} } @ta;
715
716 my $save = defined($new_upid);
717
718 foreach my $task (@ta) {
719 next if $task->{endtime};
720 $task->{endtime} = time();
721 $task->{status} = PVE::Tools::upid_read_status($task->{upid});
722 $save = 1;
723 }
724
725 my $archive = '';
726 my @arlist = ();
727 foreach my $task (@ta) {
728 if (!$task->{saved}) {
729 $archive .= sprintf("$task->{upid} %08X $task->{status}\n", $task->{endtime});
730 $save = 1;
731 push @arlist, $task;
732 $task->{saved} = 1;
733 }
734 }
735
736 if ($archive) {
737 my $size = 0;
738 my $filename = "/var/log/pve/tasks/index";
739 eval {
740 my $fh = IO::File->new($filename, '>>', 0644) ||
741 die "unable to open file '$filename' - $!\n";
742 PVE::Tools::safe_print($filename, $fh, $archive);
743 $size = -s $fh;
744 close($fh) ||
745 die "unable to close file '$filename' - $!\n";
746 };
747 my $err = $@;
748 if ($err) {
749 syslog('err', $err);
750 foreach my $task (@arlist) { # mark as not saved
751 $task->{saved} = 0;
752 }
753 }
754 my $maxsize = 50000; # about 1000 entries
755 if ($size > $maxsize) {
756 rename($filename, "$filename.1");
757 }
758 }
759
760 # we try to reduce the amount of data
761 # list all running tasks and task and a few others
762 # try to limit to 25 tasks
763 my $ctime = time();
764 my $max = 25 - scalar(@$tlist);
765 foreach my $task (@ta) {
766 last if $max <= 0;
767 push @$tlist, $task;
768 $max--;
769 }
770
771 PVE::INotify::write_file('active', $tlist) if $save;
772
773 return $tlist;
774 };
775
776 my $res = PVE::Tools::lock_file($lkfn, $timeout, $code);
777 die $@ if $@;
778
779 return $res;
780}
781
b9e47e57
DM
782my $kill_process_group = sub {
783 my ($pid, $pstart) = @_;
784
785 # send kill to process group (negative pid)
786 my $kpid = -$pid;
787
788 # always send signal to all pgrp members
789 kill(15, $kpid); # send TERM signal
790
791 # give max 5 seconds to shut down
792 for (my $i = 0; $i < 5; $i++) {
793 return if !PVE::ProcFSTools::check_process_running($pid, $pstart);
794 sleep (1);
795 }
796
797 # to be sure
798 kill(9, $kpid);
799};
800
801sub check_worker {
802 my ($upid, $killit) = @_;
803
804 my $task = PVE::Tools::upid_decode($upid);
805
806 my $running = PVE::ProcFSTools::check_process_running($task->{pid}, $task->{pstart});
807
808 return 0 if !$running;
809
810 if ($killit) {
811 &$kill_process_group($task->{pid});
812 return 0;
813 }
814
815 return 1;
816}
817
2c3a6c0a
DM
818# start long running workers
819# STDIN is redirected to /dev/null
820# STDOUT,STDERR are redirected to the filename returned by upid_decode
821# NOTE: we simulate running in foreground if ($self->{type} eq 'cli')
822sub fork_worker {
3036e8b1 823 my ($self, $dtype, $id, $user, $function, $background) = @_;
2c3a6c0a
DM
824
825 $dtype = 'unknown' if !defined ($dtype);
826 $id = '' if !defined ($id);
827
828 $user = 'root@pve' if !defined ($user);
829
3036e8b1 830 my $sync = ($self->{type} eq 'cli' && !$background) ? 1 : 0;
2c3a6c0a
DM
831
832 local $SIG{INT} =
833 local $SIG{QUIT} =
834 local $SIG{PIPE} =
835 local $SIG{TERM} = 'IGNORE';
836
837 my $starttime = time ();
838
839 my @psync = POSIX::pipe();
840 my @csync = POSIX::pipe();
841
842 my $node = $self->{nodename};
843
844 my $cpid = fork();
845 die "unable to fork worker - $!" if !defined($cpid);
846
847 my $workerpuid = $cpid ? $cpid : $$;
848
849 my $pstart = PVE::ProcFSTools::read_proc_starttime($workerpuid) ||
850 die "unable to read process start time";
851
852 my $upid = PVE::Tools::upid_encode ({
853 node => $node, pid => $workerpuid, pstart => $pstart,
854 starttime => $starttime, type => $dtype, id => $id, user => $user });
855
856 my $outfh;
857
858 if (!$cpid) { # child
859
860 $0 = "task $upid";
861
862 $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub { die "received interrupt\n"; };
863
864 $SIG{CHLD} = $SIG{PIPE} = 'DEFAULT';
865
866 # set sess/process group - we want to be able to kill the
867 # whole process group
868 POSIX::setsid();
869
870 POSIX::close ($psync[0]);
871 POSIX::close ($csync[1]);
872
873 $outfh = $sync ? $psync[1] : undef;
874
875 eval {
876 PVE::INotify::inotify_close();
877
878 if (my $atfork = $self->{atfork}) {
879 &$atfork();
880 }
881
882 # same algorythm as used inside SA
883 # STDIN = /dev/null
884 my $fd = fileno (STDIN);
2c3a6c0a 885
5a941ebe
DM
886 if (!$sync) {
887 close STDIN;
888 POSIX::close(0) if $fd != 0;
889
890 die "unable to redirect STDIN - $!"
891 if !open(STDIN, "</dev/null");
892
893 $outfh = PVE::Tools::upid_open($upid);
894 }
2c3a6c0a 895
2c3a6c0a
DM
896
897 # redirect STDOUT
898 $fd = fileno(STDOUT);
899 close STDOUT;
900 POSIX::close (1) if $fd != 1;
901
902 die "unable to redirect STDOUT - $!"
903 if !open(STDOUT, ">&", $outfh);
904
905 STDOUT->autoflush (1);
906
907 # redirect STDERR to STDOUT
908 $fd = fileno (STDERR);
909 close STDERR;
910 POSIX::close(2) if $fd != 2;
911
912 die "unable to redirect STDERR - $!"
913 if !open(STDERR, ">&1");
914
915 STDERR->autoflush(1);
916 };
917 if (my $err = $@) {
918 my $msg = "ERROR: $err";
919 POSIX::write($psync[1], $msg, length ($msg));
920 POSIX::close($psync[1]);
921 POSIX::_exit(1);
b9e47e57 922 kill(-9, $$);
2c3a6c0a
DM
923 }
924
f6f2d51f 925 # sync with parent (signal that we are ready)
2c3a6c0a
DM
926 if ($sync) {
927 print "$upid\n";
928 } else {
929 POSIX::write($psync[1], $upid, length ($upid));
930 POSIX::close($psync[1]);
931 }
932
933 my $readbuf = '';
934 # sync with parent (wait until parent is ready)
935 POSIX::read($csync[0], $readbuf, 4096);
936 die "parent setup error\n" if $readbuf ne 'OK';
937
e42eedbc
DM
938 if ($self->{type} eq 'ha') {
939 print "task started by HA resource agent\n";
940 }
2c3a6c0a
DM
941 eval { &$function($upid); };
942 my $err = $@;
943 if ($err) {
944 chomp $err;
945 $err =~ s/\n/ /mg;
946 syslog('err', $err);
947 print STDERR "TASK ERROR: $err\n";
948 POSIX::_exit(-1);
949 } else {
950 print STDERR "TASK OK\n";
b9e47e57 951 POSIX::_exit(0);
2c3a6c0a 952 }
b9e47e57 953 kill(-9, $$);
2c3a6c0a
DM
954 }
955
956 # parent
957
958 POSIX::close ($psync[1]);
959 POSIX::close ($csync[0]);
960
961 my $readbuf = '';
962 # sync with child (wait until child starts)
963 POSIX::read($psync[0], $readbuf, 4096);
964
965 if (!$sync) {
966 POSIX::close($psync[0]);
967 &$register_worker($cpid, $user, $upid);
968 } else {
969 chomp $readbuf;
970 }
971
972 eval {
973 die "got no worker upid - start worker failed\n" if !$readbuf;
974
975 if ($readbuf =~ m/^ERROR:\s*(.+)$/m) {
976 die "starting worker failed: $1\n";
977 }
978
979 if ($readbuf ne $upid) {
980 die "got strange worker upid ('$readbuf' != '$upid') - start worker failed\n";
981 }
982
983 if ($sync) {
984 $outfh = PVE::Tools::upid_open($upid);
985 }
986 };
987 my $err = $@;
988
989 if (!$err) {
990 my $msg = 'OK';
991 POSIX::write($csync[1], $msg, length ($msg));
992 POSIX::close($csync[1]);
993
994 } else {
995 POSIX::close($csync[1]);
b9e47e57 996 kill(-9, $cpid); # make sure it gets killed
2c3a6c0a
DM
997 die $err;
998 }
999
1000 PVE::Cluster::log_msg('info', $user, "starting task $upid");
1001
5bf71a96 1002 my $tlist = active_workers($upid, $sync);
2c3a6c0a
DM
1003 PVE::Cluster::broadcast_tasklist($tlist);
1004
1005 my $res = 0;
1006
1007 if ($sync) {
1008 my $count;
1009 my $outbuf = '';
8d6e045f 1010 my $int_count = 0;
2c3a6c0a 1011 eval {
8d6e045f 1012 local $SIG{INT} = local $SIG{QUIT} = local $SIG{TERM} = sub {
527b2e7a
DM
1013 # always send signal to all pgrp members
1014 my $kpid = -$cpid;
8d6e045f 1015 if ($int_count < 3) {
527b2e7a 1016 kill(15, $kpid); # send TERM signal
8d6e045f 1017 } else {
527b2e7a 1018 kill(9, $kpid); # send KILL signal
8d6e045f
DM
1019 }
1020 $int_count++;
1021 };
2c3a6c0a 1022 local $SIG{PIPE} = sub { die "broken pipe\n"; };
b28410fc
DM
1023
1024 my $select = new IO::Select;
1025 my $fh = IO::Handle->new_from_fd($psync[0], 'r');
1026 $select->add($fh);
1027
1028 while ($select->count) {
1029 my @handles = $select->can_read(1);
1030 if (scalar(@handles)) {
1031 my $count = sysread ($handles[0], $readbuf, 4096);
1032 if (!defined ($count)) {
1033 my $err = $!;
1034 die "sync pipe read error: $err\n";
2c3a6c0a 1035 }
b28410fc
DM
1036 last if $count == 0; # eof
1037
1038 $outbuf .= $readbuf;
1039 while ($outbuf =~ s/^(([^\010\r\n]*)(\r|\n|(\010)+|\r\n))//s) {
1040 my $line = $1;
1041 my $data = $2;
1042 if ($data =~ m/^TASK OK$/) {
1043 # skip
1044 } elsif ($data =~ m/^TASK ERROR: (.+)$/) {
1045 print STDERR "$1\n";
1046 } else {
1047 print $line;
1048 }
1049 if ($outfh) {
1050 print $outfh $line;
1051 $outfh->flush();
1052 }
2c3a6c0a 1053 }
b28410fc
DM
1054 } else {
1055 # some commands daemonize without closing stdout
1056 last if !PVE::ProcFSTools::check_process_running($cpid);
2c3a6c0a
DM
1057 }
1058 }
1059 };
1060 my $err = $@;
1061
1062 POSIX::close($psync[0]);
1063
1064 if ($outbuf) { # just to be sure
1065 print $outbuf;
1066 if ($outfh) {
1067 print $outfh $outbuf;
1068 }
1069 }
1070
1071 if ($err) {
1072 $err =~ s/\n/ /mg;
1073 print STDERR "$err\n";
1074 if ($outfh) {
1075 print $outfh "TASK ERROR: $err\n";
1076 }
2c3a6c0a
DM
1077 }
1078
b9e47e57
DM
1079 &$kill_process_group($cpid, $pstart); # make sure it gets killed
1080
2c3a6c0a
DM
1081 close($outfh);
1082
b9e47e57 1083 waitpid($cpid, 0);
2c3a6c0a
DM
1084 $res = $?;
1085 &$log_task_result($upid, $user, $res);
1086 }
1087
1088 return wantarray ? ($upid, $res) : $upid;
1089}
1090
10911;