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