summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/run_program.pm151
1 files changed, 150 insertions, 1 deletions
diff --git a/perl-install/run_program.pm b/perl-install/run_program.pm
index a45b5b79b..20ae3c65f 100644
--- a/perl-install/run_program.pm
+++ b/perl-install/run_program.pm
@@ -8,24 +8,97 @@ use MDK::Common;
use common; # for get_parent_uid()
use log;
+=head1 SYNOPSYS
+
+B<run_program> enables to:
+
+=over 4
+
+=item * run programs in foreground or in background,
+
+=item * to retrieve their stdout or stderr
+
+=item * ...
+
+=back
+
+Most functions exits in a normal form & a rooted one. e.g.:
+
+=over 4
+
+=item * C<run()> & C<rooted()>
+
+=item * C<get_stdout()> & C<rooted_get_stdout()>
+
+=back
+
+Most functions exits in a normal form & one that die. e.g.:
+
+=over 4
+
+=item * C<run()> & C<run_or_die()>
+
+=item * C<rooted()> & C<rooted_or_die()>
+
+=back
+
+=head1 Functions
+
+=over
+
+=cut
+
1;
my $default_timeout = 10 * 60;
+=item set_default_timeout($seconds)
+
+Alters defaults timeout (eg for harddrake service)
+
+=cut
+
sub set_default_timeout {
my ($seconds) = @_;
$default_timeout = $seconds;
}
+=item run_or_die($name, @args)
+
+Runs $name with @args parameterXs. Dies if it exit code is not 0.
+
+=cut
+
sub run_or_die {
my ($name, @args) = @_;
run($name, @args) or die "$name failed\n";
}
+
+=item rooted_or_die($root, $name, @args)
+
+Similar to run_or_die() but runs in chroot in $root
+
+=cut
+
sub rooted_or_die {
my ($root, $name, @args) = @_;
rooted($root, $name, @args) or die "$name failed\n";
}
+=item get_stdout($name, @args)
+
+Similar to run_or_die() but return stdout of program:
+
+=over 4
+
+=item * a list of lines in list context
+
+=item * a string of concatenated lines in scalar context
+
+=back
+
+=cut
+
sub get_stdout {
my ($name, @args) = @_;
my @r;
@@ -33,6 +106,12 @@ sub get_stdout {
wantarray() ? @r : join('', @r);
}
+=item get_stdout_raw($options, $name, @args)
+
+Similar to get_stdout() but allow to pass options to raw()
+
+=cut
+
sub get_stdout_raw {
my ($options, $name, @args) = @_;
my @r;
@@ -40,6 +119,12 @@ sub get_stdout_raw {
wantarray() ? @r : join('', @r);
}
+=item rooted_get_stdout($root, $name, @args)
+
+Similar to get_stdout() but runs in chroot in $root
+
+=cut
+
sub rooted_get_stdout {
my ($root, $name, @args) = @_;
my @r;
@@ -47,13 +132,61 @@ sub rooted_get_stdout {
wantarray() ? @r : join('', @r);
}
+=item run($name, @args)
+
+Runs $name with @args parameters.
+
+=cut
+
sub run { raw({}, @_) }
+=item rooted($root, $name, @args)
+
+Similar to run() but runs in chroot in $root
+
+=cut
+
sub rooted {
my ($root, $name, @args) = @_;
raw({ root => $root }, $name, @args);
}
+=item raw($options, $name, @args)
+
+The function used by all the other, making every combination possible.
+Runs $name with @args parameters. $options is a hash ref that can contains:
+
+=over 4
+
+=item * B<root>: $name will be chrooted in $root prior to run
+
+=item * B<as_user>: $name will be run as $ENV{USERHELPER_UID} or with the UID of parent process. Implies I<setuid>
+
+=item * B<sensitive_arguments>: parameters will be hidden in logs (b/c eg there's a password)
+
+=item * B<detach>: $name will be run in the background. Default is foreground
+
+=item * B<chdir>: $name will be run in a different default directory
+
+=item * B<setuid>: contains a getpwnam(3) struct ; $name will be with droped privileges ;
+make sure environment is set right and keep a copy of the X11 cookie
+
+=item * B<timeout>: execution of $name will be aborted after C<timeout> seconds
+
+=back
+
+eg:
+
+=over 4
+
+=item * C<< run_program::raw({ root => $::prefix, sensitive_arguments => 1 }, "echo -e $user->{password} | cryptsetup luksFormat $device"); >>
+
+=item * C<< run_program::raw({ detach => 1 }, '/etc/rc.d/init.d/dm', '>', '/dev/null', '2>', '/dev/null', 'restart'); >>
+
+=back
+
+=cut
+
sub raw {
my ($options, $name, @args) = @_;
my $root = $options->{root} || '';
@@ -187,9 +320,15 @@ sub raw {
}
-# 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;
+=item bg_command::new($class, $sub)
+
+Runs 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
+
+=cut
+
sub new {
my ($class, $sub) = @_;
my $o = bless {}, $class;
@@ -202,12 +341,22 @@ sub new {
}
}
+=item bg_command::DESTROY($o)
+
+When undefined (either explicitly or at end of lexical scope), close the fd and wait for the child process.
+
+=cut
+
sub DESTROY {
my ($o) = @_;
close $o->{fd} or warn "kid exited $?";
waitpid $o->{pid}, 0;
}
+=back
+
+=cut
+
1;
#- Local Variables: