network « perl-install - drakx - Mageia Installer and base platform for many utilities

Mageia Installer and base platform for many utilities

Thierry Vignaud [tv]

Mode	Name	Size
-rw-r--r--	adsl.pm	11595	log stats plain
-rw-r--r--	adsl_consts.pm	12695	log stats plain
-rw-r--r--	drakfirewall.pm	5429	log stats plain
-rw-r--r--	ethernet.pm	5193	log stats plain
-rw-r--r--	ipsec.pm	23470	log stats plain
-rw-r--r--	isdn.pm	3963	log stats plain
-rw-r--r--	isdn_consts.pm	8266	log stats plain
-rw-r--r--	modem.pm	6153	log stats plain
-rw-r--r--	netconnect.pm	68866	log stats plain
-rw-r--r--	network.pm	15097	log stats plain
-rw-r--r--	nfs.pm	1664	log stats plain
-rw-r--r--	shorewall.pm	5504	log stats plain
-rw-r--r--	smb.pm	5776	log stats plain
-rw-r--r--	smbnfs.pm	982	log stats plain
-rw-r--r--	tools.pm	6754	log stats plain

s="hl kwc">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>>?$/; my $home; if ($options->{as_user}) { my $user; $user = $ENV{USERHELPER_UID} && getpwuid($ENV{USERHELPER_UID}); $user ||= common::get_parent_uid(); $options->{setuid} = getpwnam($user) if $user; $home = $user->[7] if $user; } local $ENV{HOME} = $home if $home; my $args = $options->{sensitive_arguments} ? '<hidden arguments>' : join(' ', @args); log::explanations("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))) { log::l("program not found: $real_name"); return; } if (my $pid = fork()) { if ($options->{detach}) { $pid; } else { my $ok; add2hash_($options, { timeout => 10 * 60 }); 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 ($@) { 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 { 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);