drakx - Mageia Installer and base platform for many utilities

diff options

Diffstat (limited to 'perl-install/mouse.pm')

0 files changed, 0 insertions, 0 deletions

package ManaTools::Shared::RunProgram; use strict; use MDK::Common; use Sys::Syslog; use MDK::Common::File qw(cat_); use Exporter; our @ISA = qw(Exporter); our @EXPORT_OK = qw( set_default_timeout run_or_die rooted_or_die get_stdout get_stdout_raw rooted_get_stdout run raw rooted ); =head1 SYNOPSYS B<rManaTools::Shared::RunProgram> 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; run($name, '>', \@r, @args) or return; 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; raw($options, $name, '>', \@r, @args) or return; 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; rooted($root, $name, '>', \@r, @args) or return; 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<< ManaTools::Shared::RunProgram::raw({ root => $::prefix, sensitive_arguments => 1 }, "echo -e $user->{password} | cryptsetup luksFormat $device"); >> =item * C<< ManaTools::Shared::RunProgram::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} || ''; 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>>?$/; my $home; if ($options->{as_user}) { my $uid; $uid = $ENV{USERHELPER_UID} && getpwuid($ENV{USERHELPER_UID}); $uid ||= _get_parent_uid(); $options->{setuid} = getpwnam($uid) if $uid; my ($full_user) = grep { $_->[2] eq $uid } list_passwd(); $home = $full_user->[7] if $full_user; } local $ENV{HOME} = $home if $home; my $args = $options->{sensitive_arguments} ? '<hidden arguments>' : join(' ', @args); Sys::Syslog::syslog('info|local1', "running: $real_name $args" . ($root ? " with root $root" : "")); return if $root && $<; $root ? ($root .= '/') : ($root = ''); my $tmpdir = sub { my $dir = $< != 0 ? "$ENV{HOME}/tmp" : -d '/root' ? '/root/tmp' : '/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"); #- checking if binary exist to avoid clobbering stdout file my $rname = $real_name =~ /(.*?)[\s\|]/ ? $1 : $real_name; if (! ($rname =~ m!^/! ? -x "$root$rname" || $root && -l "$root$rname" #- handle non-relative symlink which can be broken when non-rooted : whereis_binary($rname, $root))) { Sys::Syslog::syslog('warning', "program not found: $real_name"); return; } if (my $pid = fork()) { if ($options->{detach}) { $pid; } else { my $ok; add2hash_($options, { timeout => $default_timeout }); eval { local $SIG{ALRM} = sub { die "ALARM" }; my $remaining = $options->{timeout} && $options->{timeout} ne 'never' && alarm($options->{timeout}); waitpid $pid, 0; $ok = $? == -1 || ($? >> 8) == 0; alarm $remaining; }; if ($@) { Sys::Syslog::syslog('warning', "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 { if ($options->{setuid}) { require POSIX; my ($logname, $home) = (getpwuid($options->{setuid}))[0,7]; $ENV{LOGNAME} = $logname if $logname; # if we were root and are going to drop privilege, keep a copy of the X11 cookie: if (!$> && $home) { # FIXME: it would be better to remove this but most callers are using 'detach => 1'... my $xauth = chomp_(`mktemp $home/.Xauthority.XXXXX`); system('cp', '-a', $ENV{XAUTHORITY}, $xauth); system('chown', $logname, $xauth); $ENV{XAUTHORITY} = $xauth; } # drop privileges: POSIX::setuid($options->{setuid}); } sub _die_exit { Sys::Syslog::syslog('warning', $_[0]); POSIX::_exit(128); } if ($stderr && $stderr eq 'STDERR') { } elsif ($stderr) { $stderr_mode =~ s/2//; open STDERR, "$stderr_mode $stderr" or _die_exit("ManaTools::Shared::RunProgram cannot output in $stderr (mode `$stderr_mode')"); } elsif ($::isInstall) { open STDERR, ">> /tmp/ddebug.log" or open STDOUT, ">> /dev/tty7" or _die_exit("ManaTools::Shared::RunProgram cannot log, give me access to /tmp/ddebug.log"); } if ($stdout && $stdout eq 'STDOUT') { } elsif ($stdout) { open STDOUT, "$stdout_mode $stdout" or _die_exit("ManaTools::Shared::RunProgram cannot output in $stdout (mode `$stdout_mode')"); } elsif ($::isInstall) { open STDOUT, ">> /tmp/ddebug.log" or open STDOUT, ">> /dev/tty7" or _die_exit("ManaTools::Shared::RunProgram cannot log, give me access to /tmp/ddebug.log"); } $root and chroot $root; chdir($options->{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: $!"); } } } =item get_parent_uid() Returns UID of the parent process. =cut sub _get_parent_uid() { cat_('/proc/' . getppid() . '/status') =~ /Uid:\s*(\d+)/ ? $1 : undef; } #- Local Variables: #- mode:cperl #- tab-width:8 #- End:


context:
space:
mode: