| R9_0-AMD64 | drakx-backup-do-not-use-R9_0-AMD64.tar drakx-backup-do-not-use-R9_0-AMD64.tar.gz drakx-backup-do-not-use-R9_0-AMD64.tar.bz2 drakx-backup-do-not-use-R9_0-AMD64.tar.xz drakx-backup-do-not-use-R9_0-AMD64.zipuptime) = split ' ', first(cat_("/proc/uptime"));
my $hertz = 100;
require c;
my $page = c::getpagesize() / 1024;
open PS, ">&STDOUT"; #- PS must be not be localised otherwise the "format PS" fails
format PS_TOP =
PID RSS %CPU CMD
.
format PS =
@>>>> @>>>> @>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$pid, $rss, $cpu, $cmd
.
foreach (sort { $a <=> $b } grep { /\d+/ } all('/proc')) {
$pid = $_;
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] [-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: cannot open file $h{if}\n";
ref($h{of}) eq 'GLOB' ? (*OF = $h{of}) : sysopen(OF, $h{of}, c::O_CREAT()|c::O_WRONLY()) || die "error: cannot 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: cannot read block $nb\n" : last);
syswrite(OF, $tmp) or die "error: cannot 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 || @_ < to_bool($n) and die "usage: $0 [-h] [-n lines] [<file>]\n";
$n = $n ? shift : 10;
my $fh = @_ ? common::open_file($_[0]) || die "error: cannot open file $_[0]\n" : *STDIN;
if ($0 eq 'head') {
local $_;
while (<$fh>) { $n-- or return; print }
} else {
@_ = ();
local $_;
while (<$fh>) { 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;
local $_;
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 = @_;
local $_;
while (<>) {
printf "%08lX ", $i; $i += 16;
print join(" ", (map { sprintf "%02X", $_ } unpack("C*", $_)),
(s/[^$printable_chars]/./og, $_)[1]), "\n";
}
}
sub more {
@ARGV = @_;
require devices;
my $tty = '/dev/tty';
my $n = 0;
open(my $IN, $tty) or die "cannot open $tty\n";
local $_;
while (<>) {
if (++$n == 25) {
my $v = <$IN>;
$v =~ /^q/ and exit 0;
$n = 0;
}
print;
}
}
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"; #- ROUTE must be not be localised otherwise the "format ROUTE" fails
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"; #- DF must be not be localised otherwise the "format DF" fails
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 (sort keys %h) {
$dev = $_;
($size, $free) = MDK::Common::System::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 lssbus { &lspci }
sub lspci { &lspcidrake }
sub lspcidrake {
require detect_devices;
print join "\n", detect_devices::stringlist($_[0] eq '-v'), '';
}
sub dmesg() { print cat_("/tmp/syslog") }
sub sort {
my ($n, $h) = getopts(\@_, qw(nh));
$h and die "usage: sort [-n] [<file>]\n";
my $fh = @_ ? common::open_file($_[0]) || die "error: cannot open file $_[0]\n" : *STDIN;
if ($n) {
print(sort { $a <=> $b } <$fh>);
} else {
print(sort <$fh>);
}
}
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 _ && -d _;
$s;
};
print &$f($_) >> 1, "\t$_\n" foreach @_ ? @_ : glob_("*");
}
sub bug {
my ($h) = getopts(\@_, "h");
my ($o_part_device) = @_;
$h and die "usage: bug [device]\nput file report.bug on a floppy or usb key\n";
require any;
require modules;
list_modules::load_default_moddeps();
my $part;
if ($o_part_device) {
$part = { device => $o_part_device };
} else {
require interactive::stdio;
my $in = interactive::stdio->new;
require install::any;
my @devs = install::any::removable_media__early_in_install();
@devs or die "You need to plug a removable medium (USB key, floppy, ...)\n";
$part = $in->ask_from_listf('', "Which device?", \&partition_table::description,
\@devs) or return;
}
warn "putting file report.bug on $part->{device}\n";
my $fs_type = fs::type::fs_type_from_magic($part) or die "unknown fs type\n";
fs::mount::mount(devices::make($part->{device}), '/fd', $fs_type);
require install::any;
output('/fd/report.bug', install::any::report_bug());
fs::mount::umount('/fd');
common::sync();
}
sub loadkeys {
my ($h) = getopts(\@_, "h");
$h || @_ != 1 and die "usage: loadkeys <keyboard>\n";
require keyboard;
keyboard::setup_install({ KEYBOARD => $_[0] });
}
sub sync() { common::sync() }
1;
|
