podify run_program

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: