| 1 | package PVE::RPCEnvironment; |
| 2 | |
| 3 | use strict; |
| 4 | use warnings; |
| 5 | use POSIX ":sys_wait_h"; |
| 6 | use IO::File; |
| 7 | use Fcntl qw(:flock); |
| 8 | use PVE::SafeSyslog; |
| 9 | use PVE::Tools; |
| 10 | use PVE::INotify; |
| 11 | use PVE::Cluster; |
| 12 | use PVE::ProcFSTools; |
| 13 | use PVE::AccessControl; |
| 14 | |
| 15 | # we use this singleton class to pass RPC related environment values |
| 16 | |
| 17 | my $pve_env; |
| 18 | |
| 19 | # save $SIG{CHLD} handler implementation. |
| 20 | # simply set $SIG{CHLD} = $worker_reaper; |
| 21 | # and register forked processes with &$register_worker(pid) |
| 22 | # Note: using $SIG{CHLD} = 'IGNORE' or $SIG{CHLD} = sub { wait (); } or ... |
| 23 | # has serious side effects, because perls built in system() and open() |
| 24 | # functions can't get the correct exit status of a child. So we cant use |
| 25 | # that (also see perlipc) |
| 26 | |
| 27 | my $WORKER_PIDS; |
| 28 | |
| 29 | my $log_task_result = sub { |
| 30 | my ($upid, $user, $status) = @_; |
| 31 | |
| 32 | my $msg = 'successful'; |
| 33 | my $pri = 'info'; |
| 34 | if ($status != 0) { |
| 35 | my $ec = $status >> 8; |
| 36 | my $ic = $status & 255; |
| 37 | $msg = $ec ? "failed ($ec)" : "interrupted ($ic)"; |
| 38 | $pri = 'err'; |
| 39 | } |
| 40 | my $tlist = active_workers($upid); |
| 41 | PVE::Cluster::broadcast_tasklist($tlist); |
| 42 | my $task; |
| 43 | foreach my $t (@$tlist) { |
| 44 | if ($t->{upid} eq $upid) { |
| 45 | $task = $t; |
| 46 | last; |
| 47 | } |
| 48 | } |
| 49 | if ($task && $task->{status}) { |
| 50 | $msg = $task->{status}; |
| 51 | } |
| 52 | PVE::Cluster::log_msg($pri, $user, "end task $upid $msg"); |
| 53 | }; |
| 54 | |
| 55 | my $worker_reaper = sub { |
| 56 | local $!; local $?; |
| 57 | foreach my $pid (keys %$WORKER_PIDS) { |
| 58 | my $waitpid = waitpid ($pid, WNOHANG); |
| 59 | if (defined($waitpid) && ($waitpid == $pid)) { |
| 60 | my $info = $WORKER_PIDS->{$pid}; |
| 61 | if ($info && $info->{upid} && $info->{user}) { |
| 62 | &$log_task_result($info->{upid}, $info->{user}, $?); |
| 63 | } |
| 64 | delete ($WORKER_PIDS->{$pid}); |
| 65 | } |
| 66 | } |
| 67 | }; |
| 68 | |
| 69 | my $register_worker = sub { |
| 70 | my ($pid, $user, $upid) = @_; |
| 71 | |
| 72 | return if !$pid; |
| 73 | |
| 74 | # do not register if already finished |
| 75 | my $waitpid = waitpid ($pid, WNOHANG); |
| 76 | if (defined($waitpid) && ($waitpid == $pid)) { |
| 77 | delete ($WORKER_PIDS->{$pid}); |
| 78 | return; |
| 79 | } |
| 80 | |
| 81 | $WORKER_PIDS->{$pid} = { |
| 82 | user => $user, |
| 83 | upid => $upid, |
| 84 | }; |
| 85 | }; |
| 86 | |
| 87 | # ACL cache |
| 88 | |
| 89 | my $compile_acl = sub { |
| 90 | my ($self, $user) = @_; |
| 91 | |
| 92 | my $res = {}; |
| 93 | my $cfg = $self->{user_cfg}; |
| 94 | |
| 95 | return undef if !$cfg->{roles}; |
| 96 | |
| 97 | if ($user eq 'root@pam') { # root can do anything |
| 98 | return {'/' => $cfg->{roles}->{'Administrator'}}; |
| 99 | } |
| 100 | |
| 101 | foreach my $path (sort keys %{$cfg->{acl}}) { |
| 102 | my @ra = PVE::AccessControl::roles($cfg, $user, $path); |
| 103 | |
| 104 | my $privs = {}; |
| 105 | foreach my $role (@ra) { |
| 106 | if (my $privset = $cfg->{roles}->{$role}) { |
| 107 | foreach my $p (keys %$privset) { |
| 108 | $privs->{$p} = 1; |
| 109 | } |
| 110 | } |
| 111 | } |
| 112 | |
| 113 | $res->{$path} = $privs; |
| 114 | } |
| 115 | |
| 116 | return $res; |
| 117 | }; |
| 118 | |
| 119 | sub permissions { |
| 120 | my ($self, $user, $path) = @_; |
| 121 | |
| 122 | $user = PVE::AccessControl::verify_username($user, 1); |
| 123 | return {} if !$user; |
| 124 | |
| 125 | my $cache = $self->{aclcache}; |
| 126 | |
| 127 | my $acl = $cache->{$user}; |
| 128 | |
| 129 | if (!$acl) { |
| 130 | if (!($acl = &$compile_acl($self, $user))) { |
| 131 | return {}; |
| 132 | } |
| 133 | $cache->{$user} = $acl; |
| 134 | } |
| 135 | |
| 136 | my $perm; |
| 137 | |
| 138 | if (!($perm = $acl->{$path})) { |
| 139 | $perm = {}; |
| 140 | foreach my $p (sort keys %$acl) { |
| 141 | my $final = ($path eq $p); |
| 142 | |
| 143 | next if !(($p eq '/') || $final || ($path =~ m|^$p/|)); |
| 144 | |
| 145 | $perm = $acl->{$p}; |
| 146 | } |
| 147 | $acl->{$path} = $perm; |
| 148 | } |
| 149 | |
| 150 | return $perm; |
| 151 | } |
| 152 | |
| 153 | sub check { |
| 154 | my ($self, $user, $path, $privs) = @_; |
| 155 | |
| 156 | my $perm = $self->permissions($user, $path); |
| 157 | |
| 158 | foreach my $priv (@$privs) { |
| 159 | return undef if !$perm->{$priv}; |
| 160 | }; |
| 161 | |
| 162 | return 1; |
| 163 | }; |
| 164 | |
| 165 | sub user_enabled { |
| 166 | my ($self, $user) = @_; |
| 167 | |
| 168 | my $cfg = $self->{user_cfg}; |
| 169 | return PVE::AccessControl::user_enabled($cfg, $user); |
| 170 | } |
| 171 | |
| 172 | # initialize environment - must be called once at program startup |
| 173 | sub init { |
| 174 | my ($class, $type, %params) = @_; |
| 175 | |
| 176 | $class = ref($class) || $class; |
| 177 | |
| 178 | die "already initialized" if $pve_env; |
| 179 | |
| 180 | die "unknown environment type" if !$type || $type !~ m/^(cli|pub|priv)$/; |
| 181 | |
| 182 | $SIG{CHLD} = $worker_reaper; |
| 183 | |
| 184 | # environment types |
| 185 | # cli ... command started fron command line |
| 186 | # pub ... access from public server (apache) |
| 187 | # priv ... access from private server (pvedaemon) |
| 188 | |
| 189 | my $self = { |
| 190 | user_cfg => {}, |
| 191 | aclcache => {}, |
| 192 | aclversion => undef, |
| 193 | type => $type, |
| 194 | }; |
| 195 | |
| 196 | bless $self, $class; |
| 197 | |
| 198 | foreach my $p (keys %params) { |
| 199 | if ($p eq 'atfork') { |
| 200 | $self->{$p} = $params{$p}; |
| 201 | } else { |
| 202 | die "unknown option '$p'"; |
| 203 | } |
| 204 | } |
| 205 | |
| 206 | $pve_env = $self; |
| 207 | |
| 208 | my ($sysname, $nodename) = POSIX::uname(); |
| 209 | |
| 210 | $nodename =~ s/\..*$//; # strip domain part, if any |
| 211 | |
| 212 | $self->{nodename} = $nodename; |
| 213 | |
| 214 | return $self; |
| 215 | }; |
| 216 | |
| 217 | # get the singleton |
| 218 | sub get { |
| 219 | |
| 220 | die "not initialized" if !$pve_env; |
| 221 | |
| 222 | return $pve_env; |
| 223 | } |
| 224 | |
| 225 | # init_request - must be called before each RPC request |
| 226 | sub init_request { |
| 227 | my ($self, %params) = @_; |
| 228 | |
| 229 | PVE::Cluster::cfs_update(); |
| 230 | |
| 231 | my $userconfig; # we use this for regression tests |
| 232 | foreach my $p (keys %params) { |
| 233 | if ($p eq 'userconfig') { |
| 234 | $userconfig = $params{$p}; |
| 235 | } else { |
| 236 | die "unknown parameter '$p'"; |
| 237 | } |
| 238 | } |
| 239 | |
| 240 | eval { |
| 241 | $self->{aclcache} = {}; |
| 242 | if ($userconfig) { |
| 243 | my $ucdata = PVE::Tools::file_get_contents($userconfig); |
| 244 | my $cfg = PVE::AccessControl::parse_user_config($userconfig, $ucdata); |
| 245 | $self->{user_cfg} = $cfg; |
| 246 | } else { |
| 247 | my $ucvers = PVE::Cluster::cfs_file_version('user.cfg'); |
| 248 | if (!$self->{aclcache} || !defined($self->{aclversion}) || |
| 249 | !defined($ucvers) || ($ucvers ne $self->{aclversion})) { |
| 250 | $self->{aclversion} = $ucvers; |
| 251 | my $cfg = PVE::Cluster::cfs_read_file('user.cfg'); |
| 252 | $self->{user_cfg} = $cfg; |
| 253 | } |
| 254 | } |
| 255 | }; |
| 256 | if (my $err = $@) { |
| 257 | $self->{user_cfg} = {}; |
| 258 | die "Unable to load access control list: $err"; |
| 259 | } |
| 260 | } |
| 261 | |
| 262 | sub set_client_ip { |
| 263 | my ($self, $ip) = @_; |
| 264 | |
| 265 | $self->{client_ip} = $ip; |
| 266 | } |
| 267 | |
| 268 | sub get_client_ip { |
| 269 | my ($self) = @_; |
| 270 | |
| 271 | return $self->{client_ip}; |
| 272 | } |
| 273 | |
| 274 | sub set_result_count { |
| 275 | my ($self, $count) = @_; |
| 276 | |
| 277 | $self->{result_count} = $count; |
| 278 | } |
| 279 | |
| 280 | sub get_result_count { |
| 281 | my ($self) = @_; |
| 282 | |
| 283 | return $self->{result_count}; |
| 284 | } |
| 285 | |
| 286 | sub set_language { |
| 287 | my ($self, $lang) = @_; |
| 288 | |
| 289 | # fixme: initialize I18N |
| 290 | |
| 291 | $self->{language} = $lang; |
| 292 | } |
| 293 | |
| 294 | sub get_language { |
| 295 | my ($self) = @_; |
| 296 | |
| 297 | return $self->{language}; |
| 298 | } |
| 299 | |
| 300 | sub set_user { |
| 301 | my ($self, $user) = @_; |
| 302 | |
| 303 | # fixme: get ACLs |
| 304 | |
| 305 | $self->{user} = $user; |
| 306 | } |
| 307 | |
| 308 | sub get_user { |
| 309 | my ($self) = @_; |
| 310 | |
| 311 | die "user name not set\n" if !$self->{user}; |
| 312 | |
| 313 | return $self->{user}; |
| 314 | } |
| 315 | |
| 316 | # read/update list of active workers |
| 317 | # we move all finished tasks to the archive index, |
| 318 | # but keep aktive and most recent task in the active file. |
| 319 | sub active_workers { |
| 320 | my ($new_upid) = @_; |
| 321 | |
| 322 | my $lkfn = "/var/log/pve/tasks/.active.lock"; |
| 323 | |
| 324 | my $timeout = 10; |
| 325 | |
| 326 | my $code = sub { |
| 327 | |
| 328 | my $tasklist = PVE::INotify::read_file('active'); |
| 329 | |
| 330 | my @ta; |
| 331 | my $tlist = []; |
| 332 | my $thash = {}; # only list task once |
| 333 | |
| 334 | my $check_task = sub { |
| 335 | my ($task) = @_; |
| 336 | |
| 337 | my $pstart = PVE::ProcFSTools::read_proc_starttime($task->{pid}); |
| 338 | if ($pstart && ($pstart == $task->{pstart})) { |
| 339 | push @$tlist, $task; |
| 340 | } else { |
| 341 | delete $task->{pid}; |
| 342 | push @ta, $task; |
| 343 | } |
| 344 | delete $task->{pstart}; |
| 345 | }; |
| 346 | |
| 347 | foreach my $task (@$tasklist) { |
| 348 | my $upid = $task->{upid}; |
| 349 | next if $thash->{$upid}; |
| 350 | $thash->{$upid} = $task; |
| 351 | &$check_task($task); |
| 352 | } |
| 353 | |
| 354 | if ($new_upid && !(my $task = $thash->{$new_upid})) { |
| 355 | $task = PVE::Tools::upid_decode($new_upid); |
| 356 | $task->{upid} = $new_upid; |
| 357 | $thash->{$new_upid} = $task; |
| 358 | &$check_task($task); |
| 359 | } |
| 360 | |
| 361 | |
| 362 | @ta = sort { $b->{starttime} cmp $a->{starttime} } @ta; |
| 363 | |
| 364 | my $save = defined($new_upid); |
| 365 | |
| 366 | foreach my $task (@ta) { |
| 367 | next if $task->{endtime}; |
| 368 | $task->{endtime} = time(); |
| 369 | $task->{status} = PVE::Tools::upid_read_status($task->{upid}); |
| 370 | $save = 1; |
| 371 | } |
| 372 | |
| 373 | my $archive = ''; |
| 374 | my @arlist = (); |
| 375 | foreach my $task (@ta) { |
| 376 | if (!$task->{saved}) { |
| 377 | $archive .= sprintf("$task->{upid} %08X $task->{status}\n", $task->{endtime}); |
| 378 | $save = 1; |
| 379 | push @arlist, $task; |
| 380 | $task->{saved} = 1; |
| 381 | } |
| 382 | } |
| 383 | |
| 384 | if ($archive) { |
| 385 | my $size = 0; |
| 386 | my $filename = "/var/log/pve/tasks/index"; |
| 387 | eval { |
| 388 | my $fh = IO::File->new($filename, '>>', 0644) || |
| 389 | die "unable to open file '$filename' - $!\n"; |
| 390 | PVE::Tools::safe_print($filename, $fh, $archive); |
| 391 | $size = -s $fh; |
| 392 | close($fh) || |
| 393 | die "unable to close file '$filename' - $!\n"; |
| 394 | }; |
| 395 | my $err = $@; |
| 396 | if ($err) { |
| 397 | syslog('err', $err); |
| 398 | foreach my $task (@arlist) { # mark as not saved |
| 399 | $task->{saved} = 0; |
| 400 | } |
| 401 | } |
| 402 | my $maxsize = 50000; # about 1000 entries |
| 403 | if ($size > $maxsize) { |
| 404 | rename($filename, "$filename.1"); |
| 405 | } |
| 406 | } |
| 407 | |
| 408 | # we try to reduce the amount of data |
| 409 | # list all running tasks and task and a few others |
| 410 | # try to limit to 25 tasks |
| 411 | my $ctime = time(); |
| 412 | my $max = 25 - scalar(@$tlist); |
| 413 | foreach my $task (@ta) { |
| 414 | last if $max <= 0; |
| 415 | push @$tlist, $task; |
| 416 | $max--; |
| 417 | } |
| 418 | |
| 419 | PVE::INotify::write_file('active', $tlist) if $save; |
| 420 | |
| 421 | return $tlist; |
| 422 | }; |
| 423 | |
| 424 | my $res = PVE::Tools::lock_file($lkfn, $timeout, $code); |
| 425 | die $@ if $@; |
| 426 | |
| 427 | return $res; |
| 428 | } |
| 429 | |
| 430 | # start long running workers |
| 431 | # STDIN is redirected to /dev/null |
| 432 | # STDOUT,STDERR are redirected to the filename returned by upid_decode |
| 433 | # NOTE: we simulate running in foreground if ($self->{type} eq 'cli') |
| 434 | sub fork_worker { |
| 435 | my ($self, $dtype, $id, $user, $function) = @_; |
| 436 | |
| 437 | $dtype = 'unknown' if !defined ($dtype); |
| 438 | $id = '' if !defined ($id); |
| 439 | |
| 440 | $user = 'root@pve' if !defined ($user); |
| 441 | |
| 442 | my $sync = $self->{type} eq 'cli' ? 1 : 0; |
| 443 | |
| 444 | local $SIG{INT} = |
| 445 | local $SIG{QUIT} = |
| 446 | local $SIG{PIPE} = |
| 447 | local $SIG{TERM} = 'IGNORE'; |
| 448 | |
| 449 | my $starttime = time (); |
| 450 | |
| 451 | my @psync = POSIX::pipe(); |
| 452 | my @csync = POSIX::pipe(); |
| 453 | |
| 454 | my $node = $self->{nodename}; |
| 455 | |
| 456 | my $cpid = fork(); |
| 457 | die "unable to fork worker - $!" if !defined($cpid); |
| 458 | |
| 459 | my $workerpuid = $cpid ? $cpid : $$; |
| 460 | |
| 461 | my $pstart = PVE::ProcFSTools::read_proc_starttime($workerpuid) || |
| 462 | die "unable to read process start time"; |
| 463 | |
| 464 | my $upid = PVE::Tools::upid_encode ({ |
| 465 | node => $node, pid => $workerpuid, pstart => $pstart, |
| 466 | starttime => $starttime, type => $dtype, id => $id, user => $user }); |
| 467 | |
| 468 | my $outfh; |
| 469 | |
| 470 | if (!$cpid) { # child |
| 471 | |
| 472 | $0 = "task $upid"; |
| 473 | |
| 474 | $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub { die "received interrupt\n"; }; |
| 475 | |
| 476 | $SIG{CHLD} = $SIG{PIPE} = 'DEFAULT'; |
| 477 | |
| 478 | # set sess/process group - we want to be able to kill the |
| 479 | # whole process group |
| 480 | POSIX::setsid(); |
| 481 | |
| 482 | POSIX::close ($psync[0]); |
| 483 | POSIX::close ($csync[1]); |
| 484 | |
| 485 | $outfh = $sync ? $psync[1] : undef; |
| 486 | |
| 487 | eval { |
| 488 | PVE::INotify::inotify_close(); |
| 489 | |
| 490 | if (my $atfork = $self->{atfork}) { |
| 491 | &$atfork(); |
| 492 | } |
| 493 | |
| 494 | # same algorythm as used inside SA |
| 495 | # STDIN = /dev/null |
| 496 | my $fd = fileno (STDIN); |
| 497 | close STDIN; |
| 498 | POSIX::close(0) if $fd != 0; |
| 499 | |
| 500 | die "unable to redirect STDIN - $!" |
| 501 | if !open(STDIN, "</dev/null"); |
| 502 | |
| 503 | $outfh = PVE::Tools::upid_open($upid) if !$sync; |
| 504 | |
| 505 | # redirect STDOUT |
| 506 | $fd = fileno(STDOUT); |
| 507 | close STDOUT; |
| 508 | POSIX::close (1) if $fd != 1; |
| 509 | |
| 510 | die "unable to redirect STDOUT - $!" |
| 511 | if !open(STDOUT, ">&", $outfh); |
| 512 | |
| 513 | STDOUT->autoflush (1); |
| 514 | |
| 515 | # redirect STDERR to STDOUT |
| 516 | $fd = fileno (STDERR); |
| 517 | close STDERR; |
| 518 | POSIX::close(2) if $fd != 2; |
| 519 | |
| 520 | die "unable to redirect STDERR - $!" |
| 521 | if !open(STDERR, ">&1"); |
| 522 | |
| 523 | STDERR->autoflush(1); |
| 524 | }; |
| 525 | if (my $err = $@) { |
| 526 | my $msg = "ERROR: $err"; |
| 527 | POSIX::write($psync[1], $msg, length ($msg)); |
| 528 | POSIX::close($psync[1]); |
| 529 | POSIX::_exit(1); |
| 530 | kill('KILL', $$); |
| 531 | } |
| 532 | |
| 533 | # sync with parent (signal that we are ready) |
| 534 | if ($sync) { |
| 535 | print "$upid\n"; |
| 536 | } else { |
| 537 | POSIX::write($psync[1], $upid, length ($upid)); |
| 538 | POSIX::close($psync[1]); |
| 539 | } |
| 540 | |
| 541 | my $readbuf = ''; |
| 542 | # sync with parent (wait until parent is ready) |
| 543 | POSIX::read($csync[0], $readbuf, 4096); |
| 544 | die "parent setup error\n" if $readbuf ne 'OK'; |
| 545 | |
| 546 | eval { &$function($upid); }; |
| 547 | my $err = $@; |
| 548 | if ($err) { |
| 549 | chomp $err; |
| 550 | $err =~ s/\n/ /mg; |
| 551 | syslog('err', $err); |
| 552 | print STDERR "TASK ERROR: $err\n"; |
| 553 | POSIX::_exit(-1); |
| 554 | } else { |
| 555 | print STDERR "TASK OK\n"; |
| 556 | POSIX::_exit (0); |
| 557 | } |
| 558 | kill('KILL', $$); |
| 559 | } |
| 560 | |
| 561 | # parent |
| 562 | |
| 563 | POSIX::close ($psync[1]); |
| 564 | POSIX::close ($csync[0]); |
| 565 | |
| 566 | my $readbuf = ''; |
| 567 | # sync with child (wait until child starts) |
| 568 | POSIX::read($psync[0], $readbuf, 4096); |
| 569 | |
| 570 | if (!$sync) { |
| 571 | POSIX::close($psync[0]); |
| 572 | &$register_worker($cpid, $user, $upid); |
| 573 | } else { |
| 574 | chomp $readbuf; |
| 575 | } |
| 576 | |
| 577 | eval { |
| 578 | die "got no worker upid - start worker failed\n" if !$readbuf; |
| 579 | |
| 580 | if ($readbuf =~ m/^ERROR:\s*(.+)$/m) { |
| 581 | die "starting worker failed: $1\n"; |
| 582 | } |
| 583 | |
| 584 | if ($readbuf ne $upid) { |
| 585 | die "got strange worker upid ('$readbuf' != '$upid') - start worker failed\n"; |
| 586 | } |
| 587 | |
| 588 | if ($sync) { |
| 589 | $outfh = PVE::Tools::upid_open($upid); |
| 590 | } |
| 591 | }; |
| 592 | my $err = $@; |
| 593 | |
| 594 | if (!$err) { |
| 595 | my $msg = 'OK'; |
| 596 | POSIX::write($csync[1], $msg, length ($msg)); |
| 597 | POSIX::close($csync[1]); |
| 598 | |
| 599 | } else { |
| 600 | POSIX::close($csync[1]); |
| 601 | kill (9, $cpid); # make sure it gets killed |
| 602 | die $err; |
| 603 | } |
| 604 | |
| 605 | PVE::Cluster::log_msg('info', $user, "starting task $upid"); |
| 606 | |
| 607 | my $tlist = active_workers($upid); |
| 608 | PVE::Cluster::broadcast_tasklist($tlist); |
| 609 | |
| 610 | my $res = 0; |
| 611 | |
| 612 | if ($sync) { |
| 613 | my $count; |
| 614 | my $outbuf = ''; |
| 615 | eval { |
| 616 | local $SIG{INT} = |
| 617 | local $SIG{QUIT} = |
| 618 | local $SIG{TERM} = sub { die "got interrupt\n"; }; |
| 619 | local $SIG{PIPE} = sub { die "broken pipe\n"; }; |
| 620 | |
| 621 | while (($count = POSIX::read($psync[0], $readbuf, 4096)) && ($count > 0)) { |
| 622 | $outbuf .= $readbuf; |
| 623 | while ($outbuf =~ s/^(([^\010\r\n]*)(\r|\n|(\010)+|\r\n))//s) { |
| 624 | my $line = $1; |
| 625 | my $data = $2; |
| 626 | if ($data =~ m/^TASK OK$/) { |
| 627 | # skip |
| 628 | } elsif ($data =~ m/^TASK ERROR: (.+)$/) { |
| 629 | print STDERR "$1\n"; |
| 630 | } else { |
| 631 | print $line; |
| 632 | } |
| 633 | if ($outfh) { |
| 634 | print $outfh $line; |
| 635 | $outfh->flush(); |
| 636 | } |
| 637 | } |
| 638 | } |
| 639 | }; |
| 640 | my $err = $@; |
| 641 | |
| 642 | POSIX::close($psync[0]); |
| 643 | |
| 644 | if ($outbuf) { # just to be sure |
| 645 | print $outbuf; |
| 646 | if ($outfh) { |
| 647 | print $outfh $outbuf; |
| 648 | } |
| 649 | } |
| 650 | |
| 651 | if ($err) { |
| 652 | $err =~ s/\n/ /mg; |
| 653 | print STDERR "$err\n"; |
| 654 | if ($outfh) { |
| 655 | print $outfh "TASK ERROR: $err\n"; |
| 656 | } |
| 657 | kill (-15, $cpid); |
| 658 | |
| 659 | } else { |
| 660 | kill (-9, $cpid); # make sure it gets killed |
| 661 | } |
| 662 | |
| 663 | close($outfh); |
| 664 | |
| 665 | waitpid ($cpid, 0); |
| 666 | $res = $?; |
| 667 | &$log_task_result($upid, $user, $res); |
| 668 | } |
| 669 | |
| 670 | return wantarray ? ($upid, $res) : $upid; |
| 671 | } |
| 672 | |
| 673 | 1; |