package run_program; # $Id$ use diagnostics; use strict; use c; use MDK::Common; use log; 1; sub run_or_die { my ($name, @args) = @_; run($name, @args) or die "$name failed\n"; } sub rooted_or_die { my ($root, $name, @args) = @_; rooted($root, $name, @args) or die "$name failed\n"; } sub get_stdout { my ($name, @args) = @_; my @r; run($name, '>', \@r, @args) or return; wantarray() ? @r : join('', @r); } sub rooted_get_stdout { my ($root, $name, @args) = @_; my @r; rooted($root, $name, '>', \@r, @args) or return; wantarray() ? @r : join('', @r); } sub run { raw({}, @_) } sub rooted { my ($root, $name, @args) = @_; raw({ root => $root }, $name, @args); } sub raw { my ($options, $name, @args) = @_; my $root = $options->{root} || ''; my $real_name = ref($name) ? $name->[0] : $name; my ($stdout_raw, $stdout_mode, $stderr_raw, $stderr_mode); ($stdout_mode, $stdout_raw, @args) = @args if $args[0] =~ /^>>?$/; ($stderr_mode, $stderr_raw, @args) = @args if $args[0] =~ /^2>>?$/; log::l("running: $real_name @args" . ($root ? " with root $root" : "")); return 1 if $root && $<; $root ? ($root .= '/') : ($root = ''); $ENV{HOME} || $::isInstall or $ENV{HOME} = '/root'; my $tmpdir = sub { my $dir = "$ENV{HOME}/tmp"; -d $dir or mkdir($dir, 0700); $dir; }; my $stdout = $stdout_raw && (ref($stdout_raw) ? $tmpdir->() . "/.drakx-stdout.$$" : "$root$stdout_raw"); my $stderr = $stderr_raw && (ref($stderr_raw) ? $tmpdir->() . "/.drakx-stderr.$$" : "$root$stderr_raw"); if (my $pid = fork()) { if ($options->{detach}) { $pid; } else { my $ok; eval { local $SIG{ALRM} = sub { die "ALARM" }; alarm($options->{timeout} || 10 * 60); waitpid $pid, 0; $ok = $? == 0; alarm 0; }; if ($@) { log::l("ERROR: killing runaway process (process=$real_name, pid=$pid, args=@args, error=$@)"); kill 9, $pid; return; } if ($stdout_raw && ref($stdout_raw)) { if (ref($stdout_raw) eq 'ARRAY') { @$stdout_raw = cat_($stdout); } else { $$stdout_raw = cat_($stdout); } unlink $stdout; } if ($stderr_raw && ref($stderr_raw)) { if (ref($stderr_raw) eq 'ARRAY') { @$stderr_raw = cat_($stderr); } else { $$stderr_raw = cat_($stderr); } unlink $stderr; } $ok; } } else { sub die_exit { log::l($_[0]); c::_exit(128); } if ($stderr && $stderr eq 'STDERR') { } elsif ($stderr) { $stderr_mode =~ s/2//; open STDERR, "$stderr_mode $stderr" or die_exit("run_program can not output in $stderr (mode `$stderr_mode')"); } elsif ($::isInstall) { open STDERR, ">> /tmp/ddebug.log" or open STDOUT, ">> /dev/tty7" or die_exit("run_program can not log, give me access to /tmp/ddebug.log"); } if ($stdout && $stdout eq 'STDOUT') { } elsif ($stdout) { open STDOUT, "$stdout_mode $stdout" or die_exit("run_program can not output in $stdout (mode `$stdout_mode')"); } elsif ($::isInstall) { open STDOUT, ">> /tmp/ddebug.log" or open STDOUT, ">> /dev/tty7" or die_exit("run_program can not log, give me access to /tmp/ddebug.log"); } $root and chroot $root; chdir "/"; my $ok = ref $name ? do { exec { $name->[0] } $name->[1], @args; } : do { exec $name, @args; }; if (!$ok) { die_exit("exec of $real_name failed: $!"); } } } # run in background a sub that give back data through STDOUT a la run_program::get_stdout but w/ arbitrary perl code instead of external program package bg_command; sub new { my ($class, $sub) = @_; my $o = bless {}, $class; if ($o->{pid} = open(my $fd, "-|")) { $o->{fd} = $fd; $o; } else { $sub->(); c::_exit(0); } } sub DESTROY { my ($o) = @_; close $o->{fd} or warn "kid exited $?"; waitpid $o->{pid}, 0; } 1; on value='user/ennael/mga6'>user/ennael/mga6</option> <option value='user/erwan/bug-13680'>user/erwan/bug-13680</option> <option value='user/jibz/aarch64'>user/jibz/aarch64</option> <option value='user/martinw/mga6'>user/martinw/mga6</option> <option value='user/pterjan/arm64'>user/pterjan/arm64</option> </select> <input type='submit' value='switch'/></form></td></tr> <tr><td class='sub'>Mageia Installer and base platform for many utilities</td><td class='sub right'>Thierry Vignaud [tv]</td></tr></table> <table class='tabs'><tr><td> <a href='/software/drakx/?h=10.29'>summary</a><a href='/software/drakx/refs/?h=10.29&id=2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045'>refs</a><a href='/software/drakx/log/perl-install/share/po/el.po?h=10.29'>log</a><a href='/software/drakx/tree/perl-install/share/po/el.po?h=10.29&id=2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045'>tree</a><a class='active' href='/software/drakx/commit/perl-install/share/po/el.po?h=10.29&id=2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045'>commit</a><a href='/software/drakx/diff/perl-install/share/po/el.po?h=10.29&id=2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045'>diff</a><a href='/software/drakx/stats/perl-install/share/po/el.po?h=10.29'>stats</a></td><td class='form'><form class='right' method='get' action='/software/drakx/log/perl-install/share/po/el.po'> <input type='hidden' name='h' value='10.29'/><input type='hidden' name='id' value='2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045'/><select name='qt'> <option value='grep'>log msg</option> <option value='author'>author</option> <option value='committer'>committer</option> <option value='range'>range</option> </select> <input class='txt' type='search' size='10' name='q' value=''/> <input type='submit' value='search'/> </form> </td></tr></table> <div class='path'>path: <a href='/software/drakx/commit/?h=10.29&id=2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045'>root</a>/<a href='/software/drakx/commit/perl-install?h=10.29&id=2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045'>perl-install</a>/<a href='/software/drakx/commit/perl-install/share?h=10.29&id=2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045'>share</a>/<a href='/software/drakx/commit/perl-install/share/po?h=10.29&id=2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045'>po</a>/<a href='/software/drakx/commit/perl-install/share/po/el.po?h=10.29&id=2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045'>el.po</a></div><div class='content'><div class='cgit-panel'><b>diff options</b><form method='get'><input type='hidden' name='h' value='10.29'/><input type='hidden' name='id' value='2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045'/><table><tr><td colspan='2'/></tr><tr><td class='label'>context:</td><td class='ctrl'><select name='context' onchange='this.form.submit();'><option value='1'>1</option><option value='2'>2</option><option value='3' selected='selected'>3</option><option value='4'>4</option><option value='5'>5</option><option value='6'>6</option><option value='7'>7</option><option value='8'>8</option><option value='9'>9</option><option value='10'>10</option><option value='15'>15</option><option value='20'>20</option><option value='25'>25</option><option value='30'>30</option><option value='35'>35</option><option value='40'>40</option></select></td></tr><tr><td class='label'>space:</td><td class='ctrl'><select name='ignorews' onchange='this.form.submit();'><option value='0' selected='selected'>include</option><option value='1'>ignore</option></select></td></tr><tr><td class='label'>mode:</td><td class='ctrl'><select name='dt' onchange='this.form.submit();'><option value='0' selected='selected'>unified</option><option value='1'>ssdiff</option><option value='2'>stat only</option></select></td></tr><tr><td/><td class='ctrl'><noscript><input type='submit' value='reload'/></noscript></td></tr></table></form></div><table summary='commit info' class='commit-info'> <tr><th>author</th><td>Pablo Saratxaga <pablo@mandriva.com></td><td class='right'>2003-09-18 13:55:45 +0000</td></tr> <tr><th>committer</th><td>Pablo Saratxaga <pablo@mandriva.com></td><td class='right'>2003-09-18 13:55:45 +0000</td></tr> <tr><th>commit</th><td colspan='2' class='sha1'><a href='/software/drakx/commit/perl-install/share/po/el.po?h=10.29&id=2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045'>2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045</a> (<a href='/software/drakx/patch/perl-install/share/po/el.po?id=2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045'>patch</a>)</td></tr> <tr><th>tree</th><td colspan='2' class='sha1'><a href='/software/drakx/tree/?h=10.29&id=2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045'>82bcd02e8729ff2f5ee8137d47062fe9936efde5</a> /<a href='/software/drakx/tree/perl-install/share/po/el.po?h=10.29&id=2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045'>perl-install/share/po/el.po</a></td></tr> <tr><th>parent</th><td colspan='2' class='sha1'><a href='/software/drakx/commit/perl-install/share/po/el.po?h=10.29&id=c05bbc47512c4fffb724bcc7a12a7cdd74e1956c'>c05bbc47512c4fffb724bcc7a12a7cdd74e1956c</a> (<a href='/software/drakx/diff/perl-install/share/po/el.po?h=10.29&id=2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045&id2=c05bbc47512c4fffb724bcc7a12a7cdd74e1956c'>diff</a>)</td></tr><tr><th>download</th><td colspan='2' class='sha1'><a href='/software/drakx/snapshot/drakx-2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045.tar'>drakx-2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045.tar</a><br/><a href='/software/drakx/snapshot/drakx-2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045.tar.gz'>drakx-2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045.tar.gz</a><br/><a href='/software/drakx/snapshot/drakx-2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045.tar.bz2'>drakx-2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045.tar.bz2</a><br/><a href='/software/drakx/snapshot/drakx-2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045.tar.xz'>drakx-2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045.tar.xz</a><br/><a href='/software/drakx/snapshot/drakx-2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045.zip'>drakx-2c6f2907f9a26aa54d9b2b4a12a0d59f330ef045.zip</a><br/></td></tr></table> <div class='commit-subject'>