summaryrefslogtreecommitdiffstats
path: root/perl-install/commands.pm
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install/commands.pm')
-rw-r--r--perl-install/commands.pm385
1 files changed, 303 insertions, 82 deletions
diff --git a/perl-install/commands.pm b/perl-install/commands.pm
index 8448a9f24..e2d0f4c0d 100644
--- a/perl-install/commands.pm
+++ b/perl-install/commands.pm
@@ -1,16 +1,29 @@
-package commands;
+#-########################################################################
+#- 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, lssbus, dmesg, sort, du,
+#-########################################################################
+package commands; # $Id$
use diagnostics;
use strict;
use vars qw($printable_chars);
+#-######################################################################################
+#- misc imports
+#-######################################################################################
use common qw(:common :file :system :constant);
+#-#####################################################################################
+#- Globals
+#-#####################################################################################
my $BUFFER_SIZE = 1024;
-1;
-
-
+#-######################################################################################
+#- Functions
+#-######################################################################################
sub getopts {
my $o = shift;
my @r = map { '' } (@_ = split //, $_[0]);
@@ -23,6 +36,8 @@ sub getopts {
@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" }
@@ -30,13 +45,15 @@ 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) = getopts(\@_, qw(hv));
- my $r = shift and !$h or die "usage: grep <regexp> [files...]\n";
- @ARGV = @_; (/$r/ ? $v || print : $v && print) while <>
+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_ {
+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;
@@ -47,25 +64,32 @@ sub tr_ {
sub mount {
@_ or return cat("/proc/mounts");
- my ($t) = getopts(\@_, qw(t));
- my $fs = $t ? shift : $_[0] =~ /:/ ? "nfs" : "ext2";
+ my ($t, $r) = getopts(\@_, qw(tr));
+ my $fs = $t && shift;
- @_ == 2 or die "usage: mount [-t <fs>] <device> <dir>\n",
+ @_ == 2 or die "usage: mount [-r] [-t <fs>] <device> <dir>\n",
+ " (use -r for readonly)\n",
" (if /dev/ is left off the device name, a temporary node will be created)\n";
- require 'fs.pm';
- fs::mount(@_, $fs, 0, 1);
+ 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';
+ require fs;
fs::umount($_[0]);
}
-sub mkdir_ {
- my $rec; $_[0] eq '-p' and $rec = shift;
+sub mkdir_ {
+ my ($rec) = getopts(\@_, qw(p));
my $mkdir; $mkdir = sub {
my $root = dirname $_[0];
@@ -75,48 +99,42 @@ sub mkdir_ {
$rec or die "mkdir: $root does not exist (try option -p)\n";
&$mkdir($root);
}
+ $rec and -d $_[0] and return;
mkdir $_[0], 0755 or die "mkdir: error creating directory $_: $!\n";
};
- foreach (@_) { &$mkdir($_); }
+ &$mkdir($_) foreach @_;
}
sub mknod {
if (@_ == 1) {
- require 'devices.pm';
+ require devices;
eval { devices::make($_[0]) }; $@ and die "mknod: failed to create $_[0]\n";
} elsif (@_ == 4) {
- require 'c.pm';
+ require c;
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, $i);
-
- while ($i = shift) {
- if ($i eq '-f') { $force = 1; }
- elsif ($i eq '-s') { $soft = 1; }
- elsif ($i eq '-fs' || $i eq '-sf') { $force = $soft = 1; }
- else { last }
- }
+ my ($force, $soft) = getopts(\@_, qw(fs));
+ @_ >= 1 or die "usage: ln [-s] [-f] <source> [<dest>]\n";
- my $source = $i or die "usage: ln [-s] [-f] <source> [<dest>]\n";
- my $dest = shift || basename($source);
+ 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; $_[0] eq '-r' and $rec = shift;
-
+sub rm {
+ my ($rec, undef) = getopts(\@_, qw(rf));
+
my $rm; $rm = sub {
foreach (@_) {
- if (-d $_) {
+ if (!-l $_ && -d $_) {
$rec or die "$_ is a directory\n";
&$rm(glob_($_));
rmdir $_ or die "can't remove directory $_: $!\n";
@@ -126,7 +144,7 @@ sub rm {
&$rm(@_);
}
-sub chmod_ {
+sub chmod_ {
@_ >= 2 or die "usage: chmod <mode> <files>\n";
my $mode = shift;
@@ -136,7 +154,7 @@ sub chmod_ {
}
sub chown_ {
- my $rec; $_[0] eq '-r' and $rec = shift;
+ my ($rec, undef) = getopts(\@_, qw(r));
local $_ = shift or die "usage: chown [-r] name[.group] <files>\n";
my ($name, $group) = (split('\.'), $_);
@@ -154,20 +172,18 @@ sub chown_ {
sub mkswap {
@_ == 1 or die "mkswap <device>\n";
-
- require 'swap.pm';
+ require swap;
swap::enable($_[0], 0);
}
sub swapon {
@_ == 1 or die "swapon <file>\n";
-
- require 'swap.pm';
+ require swap;
swap::swapon($_[0]);
}
sub swapoff {
@_ == 1 or die "swapoff <file>\n";
- require 'swap.pm';
+ require swap;
swap::swapoff($_[0]);
}
@@ -192,25 +208,29 @@ sub rights {
$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 @_) {
+ 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],
- $s[6] ? join ", ", unmakedev($s[6]) : $s[7],
- scalar localtime $s[9], -l $_ ? "$_ -> " . readlink $_ : $_);
+ 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";
@@ -233,12 +253,16 @@ sub cp {
-d $dest or mkdir $dest, mode($src) or die "mkdir: can't create directory $dest: $!\n";
&$cp(glob_($src), $dest);
} elsif (-l $src) {
- symlink((readlink($src) || die "readlink failed: $!"), $dest) or die "symlink: can't create symlink $dest: $!\n";
+ 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 $_ }
+ local $_;
+ while (<F>) { print G $_ }
chmod mode($src), $dest;
}
}
@@ -248,29 +272,37 @@ sub cp {
sub ps {
@_ and die "usage: ps\n";
- my ($pid, $cmd);
+ my ($pid, $rss, $cpu, $cmd);
+ my ($uptime) = split ' ', first(cat_("/proc/uptime"));
+ my $hertz = 100;
- local (*STDOUT_TOP, *STDOUT);
- format STDOUT_TOP =
- PID CMD
+ require c;
+ my $page = c::getpagesize() / 1024;
+
+ open PS, ">&STDOUT";
+ format PS_TOP =
+ PID RSS %CPU CMD
.
- format =
-@>>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$pid, $cmd
+ format PS =
+@>>>> @>>>> @>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+$pid, $rss, $cpu, $cmd
.
-
foreach $pid (sort {$a <=> $b} grep { /\d+/ } all('/proc')) {
- (($cmd) = cat_("/proc/$pid/cmdline")) =~ s/\0/ /g;
- $cmd ||= (split ' ', (cat_("/proc/$pid/stat"))[0])[1];
- write STDOUT
+ 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)));
+ $rss = (split ' ', cat_("/proc/$pid/stat"))[23] * $page;
+ (($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] [if=<file>] [of=<file>] [bs=<number>] [count=<number>]\n";
- (getopts(\@_, qw(h)))[0] and die $u;
- my %h = (if => \*STDIN, of => \*STDOUT, bs => 512, count => undef);
+ 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;
@@ -279,29 +311,29 @@ sub dd {
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} =~ /(\d+)k$/ and $h{bs} = $1 * 1024;
- $h{bs} =~ /(\d+)M$/ and $h{bs} = $1 * 1024 * 1024;
- $h{bs} =~ /(\d+)G$/ and $h{bs} = $1 * 1024 * 1024 * 1024;
+ $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 "$nb+$read records in\n";
- print STDERR "$nb+$read records out\n";
+ 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);
+ local *F; @_ ? open(F, $_[0]) || die "error: can't open file $_[0]\n" : (*F = *STDIN);
+ local $_;
if ($0 eq 'head') {
- foreach (<F>) { $n-- or return; print }
+ while (<F>) { $n-- or return; print }
} else {
- @_ = (); foreach (<F>) { push @_, $_; @_ > $n and shift; }
+ @_ = (); while (<F>) { push @_, $_; @_ > $n and shift; }
print @_;
}
}
@@ -313,7 +345,7 @@ sub strings {
$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) {
+ while (/[$printable_chars]{$n,}/og) {
printf "%07d ", ($l + length $') if $o;
print "$&\n" ;
}
@@ -324,20 +356,20 @@ sub strings {
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";
+ print join(" ", (map { sprintf "%02X", $_ } unpack("C*", $_)),
+ ($_ =~ s/[^$printable_chars]/./og, $_)[1]), "\n";
}
}
-sub more {
+sub more {
@ARGV = @_;
- require 'devices.pm';
+ require devices;
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
- }
+ 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_ {
@@ -351,7 +383,7 @@ sub pack_ {
local *F;
open F, $_ or die "can't read file $_: $!\n";
- while (read F, $t, $BUFFER_SIZE) { print $t; }
+ while (read F, $t, $BUFFER_SIZE) { print $t; }
}
}
}
@@ -370,7 +402,7 @@ sub unpack_ {
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) {
@@ -379,3 +411,192 @@ sub unpack_ {
}
}
}
+
+sub insmod {
+ my ($h) = getopts(\@_, qw(h));
+ $h || @_ == 0 and die "usage: insmod <module> [options]\n";
+ my $f = local $_ = shift;
+
+ require run_program;
+
+ #- 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";
+ my $cz = "/lib/modules" . (arch() eq 'sparc64' && "64") . ".cz"; -e $cz or $cz .= "2";
+ if (-e $cz) {
+ run_program::run("packdrake -x $cz /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", $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;
+ 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, $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) {
+ ($size, $free) = common::df($mntpoint = $h{$dev});
+ $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 detect_devices;
+ print join "\n", detect_devices::stringlist(), '';
+}
+*lssbus = *lspci;
+
+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;
+
+ my $more = join " ", map { $_ && "$_ $_/*" } @more;
+ run_program::run("cd $dir ; bzip2 -cd $cpio | cpio -id $name $name/* $more");
+
+ "$dir/$name";
+}
+
+sub bug {
+ my ($h) = getopts(\@_, "h");
+ $h and die "usage: bug\nput file report.bug on fat formatted floppy\n";
+
+ require detect_devices;
+ mount devices::make(detect_devices::floppy()), "/fd0";
+
+ sub header { "
+********************************************************************************
+* $_[0]
+********************************************************************************";
+ }
+
+ local $\ = "\n";
+ output "/fd0/report.bug", map { chomp; $_ }
+ header("lspci"), detect_devices::stringlist(),
+ header("pci_devices"), cat_("/proc/bus/pci/devices"),
+ header("fdisk"), `fdisk -l`,
+ header("scsi"), cat_("/proc/scsi/scsi"),
+ header("lsmod"), cat_("/proc/modules"),
+ header("cmdline"), cat_("/proc/cmdline"),
+ header("pcmcia: stab"), cat_("/var/run/stab"),
+ header("usb"), cat_("/proc/bus/usb/devices"),
+ header("partitions"), cat_("/proc/partitions"),
+ header("cpuinfo"), cat_("/proc/cpuinfo"),
+ header("syslog"), cat_("/tmp/syslog"),
+ header("ddcxinfos"), `ddcxinfos`,
+ header("ddebug.log"), cat_("/tmp/ddebug.log"),
+ header("install.log"), cat_("/mnt/root/install.log"),
+ ;
+ umount "/fd0";
+ sync;
+}
+
+
+#-######################################################################################
+#- Wonderful perl :(
+#-######################################################################################
+1; #
+
generated by cgit v1.2.1 (git 2.21.0) at 2024-05-15 07:10:53 +0000