summaryrefslogtreecommitdiffstats
path: root/perl-install/standalone
diff options
context:
space:
mode:
authorGuillaume Cottenceau <gc@mandriva.com>2002-04-09 08:50:36 +0000
committerGuillaume Cottenceau <gc@mandriva.com>2002-04-09 08:50:36 +0000
commit21821ebbb28f714e4f12d71eff0357e498fdb111 (patch)
treefa9ab1959a19e226b38377aaa483628bbc48644f /perl-install/standalone
parentb6ab813177bf359fc0d84c9baa11dcbca769c20f (diff)
downloaddrakx-21821ebbb28f714e4f12d71eff0357e498fdb111.tar
drakx-21821ebbb28f714e4f12d71eff0357e498fdb111.tar.gz
drakx-21821ebbb28f714e4f12d71eff0357e498fdb111.tar.bz2
drakx-21821ebbb28f714e4f12d71eff0357e498fdb111.tar.xz
drakx-21821ebbb28f714e4f12d71eff0357e498fdb111.zip
time to remove ipchains/2.2 stuff since now ipchains and iptables
packages conflict
Diffstat (limited to 'perl-install/standalone')
-rwxr-xr-xperl-install/standalone/drakgw155
1 files changed, 18 insertions, 137 deletions
diff --git a/perl-install/standalone/drakgw b/perl-install/standalone/drakgw
index 5252ef10d..cc35a1dc2 100755
--- a/perl-install/standalone/drakgw
+++ b/perl-install/standalone/drakgw
@@ -48,18 +48,12 @@ my $sysconf_network = "/etc/sysconfig/network";
my $sysconf_dhcpd = "/etc/sysconfig/dhcpd";
my $rc_firewall_generic = "/etc/rc.d/rc.firewall";
my $rc_firewall_drakgw = "/etc/rc.d/rc.firewall.inet_sharing";
-my $rc_firewall_22 = "/etc/rc.d/rc.firewall.inet_sharing-2.2";
my $rc_firewall_24 = "/etc/rc.d/rc.firewall.inet_sharing-2.4";
my $dhcpd_conf = "/etc/dhcpd.conf";
my $cups_conf = "/etc/cups/cupsd.conf";
my $drakgw_setup = "/etc/sysconfig/inet_sharing";
-my ($kernel_version) = c::kernel_version() =~ /(...)/;
-log::l("[drakgw] kernel_version $kernel_version");
-
-$kernel_version eq '2.2' || $kernel_version eq '2.4' or die "Only for 2.2 or 2.4 kernels.\n";
-
my $in = 'interactive'->vnew('su', 'default');
!$::isEmbedded && $in->isa('interactive_gtk') and $::isWizard=1;
@@ -108,11 +102,7 @@ sub stop_daemons ()
standalone::explanations("Stopping daemons");
system("/etc/rc.d/init.d/dhcpd status >/dev/null") == 0 and sys("/etc/rc.d/init.d/dhcpd stop");
system("/etc/rc.d/init.d/named status >/dev/null 2>/dev/null") == 0 and sys("/etc/rc.d/init.d/named stop");
- if ($kernel_version eq "2.2") {
- sys("/sbin/ipchains -F");
- } else {
- sys("/sbin/iptables -t nat -F");
- }
+ sys("/sbin/iptables -t nat -F");
sys("/sbin/chkconfig --level 345 $_ off") foreach 'named', 'dhcpd';
substInFile { s/^INET_SHARING.*\n//; $_ .= "INET_SHARING=disabled\n" if eof } $drakgw_setup;
@@ -126,6 +116,12 @@ sub fatal_quit ($)
quit_global($in, -1);
}
+my ($kernel_version) = c::kernel_version() =~ /(...)/;
+log::l("[drakgw] kernel_version $kernel_version");
+
+$kernel_version eq '2.4' or fatal_quit(_("Sorry, we support only 2.4 kernels."));
+
+
begin:
#- **********************************
@@ -146,7 +142,7 @@ What would you like to do?"),
my $wait_disabl = $in->wait_message('', _("Disabling servers..."));
stop_daemons();
}
- foreach ($dhcpd_conf, $rc_firewall_22, $rc_firewall_24) {
+ foreach ($dhcpd_conf, $rc_firewall_24) {
renamef($_, "$_.drakgwdisable") or die "Could not rename $_ to $_.drakgwdisable"
}
log::l("[drakgw] Disabled");
@@ -167,7 +163,7 @@ It's currently disabled.
What would you like to do?"),
[ __("enable"), __("reconfigure"), __("dismiss") ]);
if ($r eq "enable") {
- foreach ($dhcpd_conf, $rc_firewall_22, $rc_firewall_24) {
+ foreach ($dhcpd_conf, $rc_firewall_24) {
rename($_, "$_.old") if -f $_;
rename("$_.drakgwdisable", $_) or die "Could not find configuration. Please reconfigure.";
}
@@ -320,17 +316,10 @@ foreach (grep { $_ ne $device } @configured_devices)
#- test for potential conflict with previous firewall config
-if ($kernel_version eq '2.2') {
- if (-f '/etc/sysconfig/ipchains' || -x '/sbin/ipchains' && listlength(`/sbin/ipchains -nL`) > 3) {
- $in->ask_okcancel(_("Firewalling configuration detected!"),
- _("Warning! An existing firewalling configuration has been detected. You may need some manual fix after installation.")) or goto step_detectsetup;
- }
-} else {
- system('modprobe iptable_nat');
- if (-f '/etc/sysconfig/iptables' || -x '/sbin/iptables' && listlength(`/sbin/iptables -t nat -nL`) > 8) {
- $in->ask_okcancel(_("Firewalling configuration detected!"),
- _("Warning! An existing firewalling configuration has been detected. You may need some manual fix after installation.")) or goto step_detectsetup;
- }
+system('modprobe iptable_nat');
+if (-f '/etc/sysconfig/iptables' || -x '/sbin/iptables' && listlength(`/sbin/iptables -t nat -nL`) > 8) {
+ $in->ask_okcancel(_("Firewalling configuration detected!"),
+ _("Warning! An existing firewalling configuration has been detected. You may need some manual fix after installation.")) or goto step_detectsetup;
}
@@ -362,8 +351,7 @@ ONBOOT=yes
#- install and setup the RPM packages
my $rpms_to_install;
-my %rpm2file = ( ipchains => '/sbin/ipchains',
- iptables => '/sbin/iptables',
+my %rpm2file = ( iptables => '/sbin/iptables',
'dhcp-server' => '/usr/sbin/dhcpd',
bind => '/usr/sbin/named',
'caching-nameserver' => '/var/named/named.local');
@@ -402,9 +390,6 @@ output($rc_firewall_drakgw, q(#!/bin/sh
KERNELMAJ=`uname -r | sed -e 's,\..*,,'`
KERNELMIN=`uname -r | sed -e 's,[^\.]*\.,,' -e 's,\..*,,'`
-if [ "$KERNELMAJ" -eq 2 -a "$KERNELMIN" -eq 2 ]; then
- [ -x ) . $rc_firewall_22 . ' ] && ' . $rc_firewall_22 . q(
-fi
if [ "$KERNELMAJ" -eq 2 -a "$KERNELMIN" -eq 4 ]; then
[ -x ) . $rc_firewall_24 . ' ] && ' . $rc_firewall_24 . q(
fi
@@ -413,114 +398,6 @@ fi
chmod 0700, $rc_firewall_drakgw;
-output($rc_firewall_22,
-qq(#!/bin/sh
-#
-# rc.firewall - Initial SIMPLE IP Masquerade test for 2.1.x and 2.2.x kernels using IPCHAINS
-#
-# Load all required IP MASQ modules
-#
-# NOTE: Only load the IP MASQ modules you need. All current IP MASQ modules
-# are shown below but are commented out from loading.
-
-# Needed to initially load modules
-#
-/sbin/depmod -a
-
-# Supports the proper masquerading of FTP file transfers using the PORT method
-#
-/sbin/modprobe ip_masq_ftp
-
-# Supports the masquerading of RealAudio over UDP. Without this module,
-# RealAudio WILL function but in TCP mode. This can cause a reduction
-# in sound quality
-#
-/sbin/modprobe ip_masq_raudio
-
-# Supports the masquerading of IRC DCC file transfers
-#
-/sbin/modprobe ip_masq_irc
-
-
-# Supports the masquerading of Quake and QuakeWorld by default. This modules is
-# for for multiple users behind the Linux MASQ server. If you are going to play
-# Quake I, II, and III, use the second example.
-#
-# NOTE: If you get ERRORs loading the QUAKE module, you are running an old
-# ----- kernel that has bugs in it. Please upgrade to the newest kernel.
-#
-#Quake I / QuakeWorld (ports 26000 and 27000)
-#/sbin/modprobe ip_masq_quake
-#
-#Quake I/II/III / QuakeWorld (ports 26000, 27000, 27910, 27960)
-/sbin/modprobe ip_masq_quake 26000,27000,27910,27960
-
-
-# Supports the masquerading of the CuSeeme video conferencing software
-#
-/sbin/modprobe ip_masq_cuseeme
-
-#Supports the masquerading of the VDO-live video conferencing software
-#
-/sbin/modprobe ip_masq_vdolive
-
-
-#CRITICAL: Enable IP forwarding since it is disabled by default since
-#
-# Redhat Users: you may try changing the options in /etc/sysconfig/network from:
-#
-# FORWARD_IPV4=false
-# to
-# FORWARD_IPV4=true
-#
-echo 1 > /proc/sys/net/ipv4/ip_forward
-
-
-# Dynamic IP users:
-#
-# If you get your IP address dynamically from SLIP, PPP, or DHCP, enable this following
-# option. This enables dynamic-ip address hacking in IP MASQ, making the life
-# with Diald and similar programs much easier.
-#
-#echo 1 > /proc/sys/net/ipv4/ip_dynaddr
-
-
-# MASQ timeouts
-#
-# 2 hrs timeout for TCP session timeouts
-# 10 sec timeout for traffic after the TCP/IP "FIN" packet is received
-# 160 sec timeout for UDP traffic (Important for MASQ'ed ICQ users)
-#
-/sbin/ipchains -M -S 7200 10 160
-
-
-# DHCP: For people who receive their external IP address from either DHCP or BOOTP
-# such as ADSL or Cablemodem users, it is necessary to use the following
-# before the deny command. The "bootp_client_net_if_name" should be replaced
-# the name of the link that the DHCP/BOOTP server will put an address on to?
-# This will be something like "eth0", "eth1", etc.
-#
-# This example is currently commented out.
-#
-#
-#/sbin/ipchains -A input -j ACCEPT -i bootp_clients_net_if_name -s 0/0 67 -d 0/0 68 -p udp
-
-# Enable simple IP forwarding and Masquerading
-#
-# NOTE: The following is an example for an internal LAN address in the 192.168.0.x
-# network with a 255.255.255.0 or a "24" bit subnet mask.
-#
-# Please change this network number and subnet mask to match your internal LAN setup
-#
-/sbin/ipchains -P forward DENY
-/sbin/ipchains -A forward -s $lan_address.0/24 -j MASQ
-
-# Let incoming packets arrive to our interface, in case there are some firewall rules to come
-/sbin/ipchains -A input -i $device -j ACCEPT
-));
-chmod 0700, $rc_firewall_22;
-
-
output($rc_firewall_24, qq(#!/bin/sh
# Load the NAT module (this pulls in all the others).
modprobe iptable_nat
@@ -734,6 +611,10 @@ Click on Configure to launch the setup wizard.", $setup_state));
#-------------------------------------------------
#- $Log$
+#- Revision 1.61 2002/04/09 08:50:36 gc
+#- time to remove ipchains/2.2 stuff since now ipchains and iptables
+#- packages conflict
+#-
#- Revision 1.60 2002/03/07 13:10:06 gc
#- - call net_monitor to disable internet
#- connection before network-restart
generated by cgit v1.2.1 (git 2.21.0) at 2025-01-25 00:18:44 +0000
######################################## #- This file implement many common shell commands: #- true, false, cat, which, dirname, basename, rmdir, lsmod, grep, tr, #- mount, umount, mkdir, mknod, ln, rm, chmod, chown, mkswap, swapon, #- swapoff, ls, cp, ps, dd, head, tail, strings, hexdump, more, insmod, #- modprobe, route, df, kill, lspci, dmesg, sort, du, #-######################################################################## package commands; use diagnostics; use strict; use vars qw($printable_chars); #-###################################################################################### #- misc imports #-###################################################################################### use common qw(:common :file :system :constant); #-##################################################################################### #- Globals #-##################################################################################### my $BUFFER_SIZE = 1024; #-###################################################################################### #- Functions #-###################################################################################### sub getopts { my $o = shift; my @r = map { '' } (@_ = split //, $_[0]); while (1) { local $_ = $o->[0]; $_ && /^-/ or return @r; for (my $i = 0; $i < @_; $i++) { /$_[$i]/ and $r[$i] = $_[$i]; } shift @$o; } @r; } sub true { exit 0 } sub false { exit 1 } sub cat { @ARGV = @_; print while <> } sub which { ARG: foreach (@_) { foreach my $c (split /:/, $ENV{PATH}) { -x "$c/$_" and print("$c/$_\n"), next ARG; }}} sub dirname_ { print dirname(@_), "\n" } sub basename_ { print basename(@_), "\n" } sub rmdir_ { foreach (@_) { rmdir $_ or die "rmdir: can't remove $_\n" } } sub lsmod { print "Module Size Used by\n"; cat("/proc/modules"); } sub grep_ { my ($h, $v, $i) = getopts(\@_, qw(hvi)); @_ == 0 || $h and die "usage: grep <regexp> [files...]\n"; my $r = shift; $r = qr/$r/i if $i; @ARGV = @_; (/$r/ ? $v || print : $v && print) while <> } sub tr_ { my ($s, $c, $d) = getopts(\@_, qw(s c d)); @_ >= 1 + (!$d || $s) or die "usage: tr [-c] [-s [-d]] <set1> <set2> [files...]\n or tr [-c] -d <set1> [files...]\n"; my $set1 = shift; my $set2; !$d || $s and $set2 = shift; @ARGV = @_; eval "(tr/$set1/$set2/$s$d$c, print) while <>"; } sub mount { @_ or return cat("/proc/mounts"); my ($t, $r) = getopts(\@_, qw(tr)); my $fs = $t && shift; @_ == 2 or die "usage: mount [-r] [-t <fs>] <device> <dir>\n", " (if /dev/ is left off the device name, a temporary node will be created)\n"; my ($dev, $where) = @_; $fs ||= $where =~ /:/ ? "nfs" : $dev =~ /fd/ ? "vfat" : "ext2"; require fs; require modules; modules::load_deps("/modules/modules.dep"); fs::mount($dev, $where, $fs, $r); } sub umount { @_ == 1 or die "umount expects a single argument\n"; require 'fs.pm'; fs::umount($_[0]); } sub mkdir_ { my ($rec) = getopts(\@_, qw(p)); my $mkdir; $mkdir = sub { my $root = dirname $_[0]; if (-e $root) { -d $root or die "mkdir: error creating directory $_[0]: $root is a file and i won't delete it\n"; } else { $rec or die "mkdir: $root does not exist (try option -p)\n"; &$mkdir($root); } mkdir $_[0], 0755 or die "mkdir: error creating directory $_: $!\n"; }; &$mkdir($_) foreach @_; } sub mknod { if (@_ == 1) { require 'devices.pm'; eval { devices::make($_[0]) }; $@ and die "mknod: failed to create $_[0]\n"; } elsif (@_ == 4) { require 'c.pm'; my $mode = $ {{"b" => c::S_IFBLK(), "c" => c::S_IFCHR()}}{$_[1]} or die "unknown node type $_[1]\n"; syscall_('mknod', my $a = $_[0], $mode | 0600, makedev($_[2], $_[3])) or die "mknod failed: $!\n"; } else { die "usage: mknod <path> [b|c] <major> <minor> or mknod <path>\n"; } } sub ln { my ($force, $soft) = getopts(\@_, qw(fs)); @_ >= 1 or die "usage: ln [-s] [-f] <source> [<dest>]\n"; my ($source, $dest) = @_; $dest ||= basename($source); $force and unlink $dest; ($soft ? symlink($source, $dest) : link($source, $dest)) or die "ln failed: $!\n"; } sub rm { my ($rec, undef) = getopts(\@_, qw(rf)); my $rm; $rm = sub { foreach (@_) { if (!-l $_ && -d $_) { $rec or die "$_ is a directory\n"; &$rm(glob_($_)); rmdir $_ or die "can't remove directory $_: $!\n"; } else { unlink $_ or die "rm of $_ failed: $!\n" } } }; &$rm(@_); } sub chmod_ { @_ >= 2 or die "usage: chmod <mode> <files>\n"; my $mode = shift; $mode =~ /^[0-7]+$/ or die "illegal mode $mode\n"; foreach (@_) { chmod oct($mode), $_ or die "chmod failed $_: $!\n" } } sub chown_ { my ($rec, undef) = getopts(\@_, qw(r)); local $_ = shift or die "usage: chown [-r] name[.group] <files>\n"; my ($name, $group) = (split('\.'), $_); my ($uid, $gid) = (getpwnam($name) || $name, getgrnam($group) || $group); my $chown; $chown = sub { foreach (@_) { chown $uid, $gid, $_ or die "chown of file $_ failed: $!\n"; -d $_ && $rec and &$chown(glob_($_)); } }; &$chown(@_); } sub mkswap { @_ == 1 or die "mkswap <device>\n"; require 'swap.pm'; swap::enable($_[0], 0); } sub swapon { @_ == 1 or die "swapon <file>\n"; require 'swap.pm'; swap::swapon($_[0]); } sub swapoff { @_ == 1 or die "swapoff <file>\n"; require 'swap.pm'; swap::swapoff($_[0]); } sub uncpio { @_ and die "uncpio reads from stdin\n"; # cpioInstallArchive(gzdopen(0, "r"), NULL, 0, NULL, NULL, &fail); } sub rights { my $r = '-' x 9; my @rights = (qw(x w r x w r x w r), ['t', 0], ['s', 3], ['s', 6]); for (my $i = 0; $i < @rights; $i++) { if (vec(pack("S", $_[0]), $i, 1)) { my ($val, $place) = $i >= 9 ? @{$rights[$i]} : ($rights[$i], $i); my $old = \substr($r, 8 - $place, 1); $$old = ($$old eq '-' && $i >= 9) ? uc $val : $val; } } my @types = split //, "_pc_d_b_-_l_s"; $types[$_[0] >> 12 & 0xf] . $r; } sub displaySize { my $m = $_[0] >> 12; $m == 4 || $m == 8 || $m == 10; } sub ls { my ($l , $h) = getopts(\@_, qw(lh)); $h and die "usage: ls [-l] <files...>\n"; @_ or @_ = '.'; @_ == 1 && -d $_[0] and @_ = glob_($_[0]); foreach (sort @_) { if ($l) { my @s = lstat or warn("can't stat file $_\n"), next; formline( "@<<<<<<<<< @<<<<<<< @<<<<<<< @>>>>>>>> @>>>>>>>>>>>>>>> @*\n", rights($s[2]), getpwuid $s[4] || $s[4], getgrgid $s[5] || $s[5], displaySize($s[2]) ? $s[7] : join(", ", unmakedev($s[6])), scalar localtime $s[9], -l $_ ? "$_ -> " . readlink $_ : $_); print $^A; $^A = ''; } else { print "$_\n"; } } } sub cp { my ($force) = getopts(\@_, qw(f)); @_ >= 2 or die "usage: cp [-f] <sources> <dest>\n(this cp does -Rl by default)\n"; my $cp; $cp = sub { my $dest = pop @_; @_ or return; @_ == 1 || -d $dest or die "cp: copying multiple files, but last argument ($dest) is not a directory\n"; foreach my $src (@_) { my $dest = $dest; -d $dest and $dest .= "/" . basename($src); if (-e $dest) { $force ? unlink $dest : die "file $dest already exist\n"; } if (-d $src) { -d $dest or mkdir $dest, mode($src) or die "mkdir: can't create directory $dest: $!\n"; &$cp(glob_($src), $dest); } elsif (-l $src) { unless (symlink((readlink($src) || die "readlink failed: $!"), $dest)) { my $msg = "symlink: can't create symlink $dest: $!\n"; $force ? warn $msg : die $msg; } } else { local (*F, *G); open F, $src or die "can't open $src for reading: $!\n"; open G, "> $dest" or $force or die "can't create $dest : $!\n"; foreach (<F>) { print G $_ } chmod mode($src), $dest; } } }; &$cp(@_); } sub ps { @_ and die "usage: ps\n"; my ($pid, $cpu, $cmd); my ($uptime) = split ' ', first(cat_("/proc/uptime")); my $hertz = 100; open PS, ">&STDOUT"; format PS_TOP = PID %CPU CMD . format PS = @>>>> @>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $pid, $cpu, $cmd . foreach $pid (sort {$a <=> $b} grep { /\d+/ } all('/proc')) { my @l = split(' ', cat_("/proc/$pid/stat")); $cpu = sprintf "%2.1f", max(0, min(99, ($l[13] + $l[14]) * 100 / $hertz / ($uptime - $l[21] / $hertz))); (($cmd) = cat_("/proc/$pid/cmdline")) =~ s/\0/ /g; $cmd ||= (split ' ', (cat_("/proc/$pid/stat"))[0])[1]; write PS; } } sub dd { my $u = "usage: dd [-h] [-p] [if=<file>] [of=<file>] [bs=<number>] [count=<number>]\n"; my ($help, $percent) = getopts(\@_, qw(hp)); die $u if $help; my %h = (if => *STDIN, of => *STDOUT, bs => 512, count => undef); foreach (@_) { /(.*?)=(.*)/ && exists $h{$1} or die $u; $h{$1} = $2; } local (*IF, *OF); my ($tmp, $nb, $read); ref $h{if} eq 'GLOB' ? *IF = $h{if} : sysopen(IF, $h{if}, 0 ) || die "error: can't open file $h{if}\n"; ref $h{of} eq 'GLOB' ? *OF = $h{of} : sysopen(OF, $h{of}, 0x41) || die "error: can't open file $h{of}\n"; $h{bs} = removeXiBSuffix($h{bs}); for ($nb = 0; !$h{count} || $nb < $h{count}; $nb++) { printf "\r%02.1d%%", 100 * $nb / $h{count} if $h{count} && $percent; $read = sysread(IF, $tmp, $h{bs}) or $h{count} ? die "error: can't read block $nb\n" : last; syswrite(OF, $tmp) or die "error: can't write block $nb\n"; $read < $h{bs} and $read = 1, last; } print STDERR "\r$nb+$read records in\n"; print STDERR "$nb+$read records out\n"; } sub head_tail { my ($h, $n) = getopts(\@_, qw(hn)); $h || @_ > 1 + bool($n) and die "usage: $0 [-h] [-n lines] [<file>]\n"; $n = $n ? shift : 10; local *F; @_ ? open(F, $_[0]) || die "error: can't open file $_[0]\n" : (*F = *STDIN); if ($0 eq 'head') { foreach (<F>) { $n-- or return; print } } else { @_ = (); foreach (<F>) { push @_, $_; @_ > $n and shift; } print @_; } } sub head { $0 = 'head'; &head_tail } sub tail { $0 = 'tail'; &head_tail } sub strings { my ($h, $o, $n) = getopts(\@_, qw(hon)); $h and die "usage: strings [-o] [-n min-length] [<files>]\n"; $n = $n ? shift : 4; $/ = "\0"; @ARGV = @_; my $l = 0; while (<>) { while (/[$printable_chars]\{$n,}/og) { printf "%07d ", ($l + length $') if $o; print "$&\n" ; } $l += length; } continue { $l = 0 if eof } } sub hexdump { my $i = 0; $/ = \16; @ARGV = @_; while (<>) { printf "%08lX ", $i; $i += 16; print join(" ", (map { sprintf "%02X", $_ } unpack("C*", $_)), ($_ =~ s/[^$printable_chars]/./og, $_)[1]), "\n"; } } sub more { @ARGV = @_; require 'devices.pm'; my $tty = devices::make('tty'); local *IN; open IN, "<$tty" or die "can't open $tty\n"; my $n = 0; while (<>) { ++$n == 25 and $n = <IN>, $n = 0; print } } sub pack_ { my $t; foreach (@_) { if (-d $_) { pack_(glob_($_)); } else { print -s $_, "\n"; print $_, "\n"; local *F; open F, $_ or die "can't read file $_: $!\n"; while (read F, $t, $BUFFER_SIZE) { print $t; } } } } sub unpack_ { my $t; @_ == 1 or die "give me one and only one file to unpack\n"; local *F; open F, $_[0] or die "can't open file $_: $!\n"; while (1) { my ($size) = chop_(scalar <F>); defined $size or last; $size =~ /^\d+$/ or die "bad format (can't find file size)\n"; my ($filename) = chop_(scalar <F>) or die "expecting filename\n"; print "$filename\n"; my $dir = dirname($filename); -d $dir or mkdir_('-p', $dir); local *G; open G, "> $filename" or die "can't write file $filename: $!\n"; while ($size) { $size -= read(F, $t, min($size, $BUFFER_SIZE)) || die "data for file $filename is missing\n"; print G $t or die "error writing to file $filename: $!\n"; } } } sub insmod { my ($h) = getopts(\@_, qw(h)); $h || @_ == 0 and die "usage: insmod <module> [options]\n"; my $f = local $_ = shift; require 'run_program.pm'; #- try to install the module if it exist else extract it from archive. #- needed for cardmgr. unless (-r $f) { $_ = $1 if m@.*/([^/]*)\.o@; unless (-r ($f = "/lib/modules/$_.o")) { $f = "/tmp/$_.o"; if (-e "/lib/modules.cz2") { run_program::run("extract_archive /lib/modules.cz2 /tmp $_.o"); } elsif (-e "/lib/modules.cpio.bz2") { run_program::run("cd /tmp ; bzip2 -cd /lib/modules.cpio.bz2 | cpio -i $_.o"); } else { die "unable to find an archive for modules"; } } } -r $f or die "can't find module $_"; run_program::run(["insmod_", "insmod"], $f, @_) or die("insmod $_ failed"); unlink $f; } sub modprobe { my ($h) = getopts(\@_, qw(h)); $h || @_ == 0 and die "usage: modprobe <module> [options]\n"; my $name = shift; require 'modules.pm'; modules::load_deps("/modules/modules.dep"); modules::load($name, '', @_); } sub route { @_ == 0 or die "usage: route\nsorry, no modification handled\n"; my ($titles, @l) = cat_("/proc/net/route"); my @titles = split ' ', $titles; my %l; open ROUTE, ">&STDOUT"; format ROUTE_TOP = Destination Gateway Mask Iface . format ROUTE = @<<<<<<<<<<<< @<<<<<<<<<<<< @<<<<<<<<<<<< @<<<<<<< $l{Destination}, $l{Gateway}, $l{Mask}, $l{Iface} . foreach (@l) { /^\s*$/ and next; @l{@titles} = split; $_ = join ".", reverse map { hex } unpack "a2a2a2a2", $_ foreach @l{qw(Destination Gateway Mask)}; $l{Destination} = 'default' if $l{Destination} eq "0.0.0.0"; $l{Gateway} = '*' if $l{Gateway} eq "0.0.0.0"; write ROUTE; } } sub df { my ($h) = getopts(\@_, qw(h)); my ($dev, $blocksize, $size, $free, $used, $use, $mntpoint); open DF, ">&STDOUT"; format DF_TOP = Filesystem Size Used Avail Use Mounted on . format DF = @<<<<<<<<<<<<<<<< @>>>>>>> @>>>>>>> @>>>>>>> @>>>>>% @<<<<<<<<<<<<<<<<<<<<<<<<< $dev, $size, $used, $free, $use, $mntpoint . my %h; foreach (cat_("/proc/mounts"), cat_("/etc/mtab")) { ($dev, $mntpoint) = split; $h{$dev} = $mntpoint; } foreach $dev (sort keys %h) { $mntpoint = $h{$dev}; my $buf = ' ' x 20000; syscall_('statfs', $mntpoint, $buf) or next; (undef, $blocksize, $size, undef, $free, undef) = unpack "L2L4", $buf; $_ *= $blocksize / 1024 foreach $size, $free; $size or next; $use = int (100 * ($size - $free) / $size); $used = $size - $free; if ($h) { $used = int ($used / 1024) . "M"; $size = int ($size / 1024) . "M"; $free = int ($free / 1024) . "M"; } write DF if $size; } } sub kill { my $signal = 15; @_ or die "usage: kill [-<signal>] pids\n"; $signal = (shift, $1)[1] if $_[0] =~ /^-(.*)/; kill $signal, @_ or die "kill failed: $!\n"; } sub lspci { require 'pci_probing/main.pm'; print join "\n", pci_probing::main::list (), ''; } sub dmesg { print cat_("/tmp/syslog"); } sub sort { my ($n, $h) = getopts(\@_, qw(nh)); $h and die "usage: sort [-n] [<file>]\n"; local *F; @_ ? open(F, $_[0]) || die "error: can't open file $_[0]\n" : (*F = *STDIN); if ($n) { print sort { $a <=> $b } <F>; } else { print sort <F>; } } sub du { my ($s, $h) = getopts(\@_, qw(sh)); $h || !$s and die "usage: du -s [<directories>]\n"; my $f; $f = sub { my ($e) = @_; my $s = (lstat($e))[12]; $s += sum map { &$f($_) } glob_("$e/*") if !-l $e && -d $e; $s; }; print &$f($_) >> 1, "\t$_\n" foreach @_ ? @_ : glob_("*"); } sub install_cpio($$;@) { my ($dir, $name, @more) = @_; return "$dir/$name" if -e "$dir/$name"; my $cpio = "$dir.cpio.bz2"; -e $cpio or return; eval { rm("-r", $dir) }; mkdir $dir, 0755; require 'run_program.pm'; my $more = join " ", map { $_ && "$_ $_/*" } @more; run_program::run("cd $dir ; bzip2 -cd $cpio | cpio -id $name $name/* $more"); "$dir/$name"; } #-###################################################################################### #- Wonderful perl :( #-###################################################################################### 1; #
generated by cgit v1.2.1 (git 2.21.0) at 2025-01-25 00:18:44 +0000