blob: 39faa716e567b6111cd794492a72abb93f272df4 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
package network::nfs; # $Id$
use strict;
use diagnostics;
use common;
use network::network;
use network::smbnfs;
use log;
our @ISA = 'network::smbnfs';
sub to_fstab_entry {
my ($class, $e) = @_;
$class->to_fstab_entry_raw($e, 'nfs');
}
sub comment_to_string {
my ($_class, $comment) = @_;
member($comment, qw(* 0.0.0.0/0.0.0.0 (everyone))) ? '' : $comment;
}
sub from_dev {
my ($_class, $dev) = @_;
$dev =~ m|(.*?):(.*)|;
}
sub to_dev_raw {
my ($_class, $server, $name) = @_;
$server . ':' . $name;
}
sub check {
my ($_class, $in) = @_;
$in->do_pkgs->ensure_is_installed('nfs-utils-clients', '/usr/sbin/showmount') or return;
system('/etc/init.d/portmap start') if system('/etc/init.d/portmap status') != 0;
1;
}
sub find_servers {
open(my $F2, "rpcinfo-flushed -b mountd 2 |");
open(my $F3, "rpcinfo-flushed -b mountd 3 |");
common::nonblock($F2);
common::nonblock($F3);
my $domain = chomp_(`domainname`);
my ($s, %servers);
my $quit;
while (!$quit) {
$quit = 1;
sleep 1;
while ($s = <$F2> || <$F3>) {
$quit = 0;
my ($ip, $name) = $s =~ /(\S+)\s+(\S+)/ or log::explanations("bad line in rpcinfo output"), next;
$name =~ s/\.$//;
$name =~ s/\Q.$domain\E$//;
$servers{$ip} ||= { ip => $ip, if_($name ne '(unknown)', name => $name) };
}
}
values %servers;
}
sub find_exports {
my ($_class, $server) = @_;
my @l;
run_program::raw({ timeout => 1 }, "showmount", '>', \@l, "--no-headers", "-e", $server->{ip} || $server->{name});
map { if_(/(\S+(\s*\S+)*)\s+(\S+)/, { name => $1, comment => $3, server => $server }) } @l;
}
1;
|
href='#n364'>364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
package commands; # $Id$
#-########################################################################
#- 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, swapon,
#- swapoff, ls, cp, ps, dd, head, tail, strings, hexdump, more, insmod,
#- modprobe, route, df, kill, lspci, lssbus, dmesg, sort, du,
#-########################################################################
use diagnostics;
use strict;
use vars qw($printable_chars *ROUTE *DF *PS);
#-######################################################################################
#- misc imports
#-######################################################################################
use MDK::Common::System;
use common;
#-######################################################################################
#- 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 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 which {
ARG: foreach (@_) { foreach my $c (split /:/, $ENV{PATH}) { -x "$c/$_" and print("$c/$_\n"), next ARG } }
}
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/ xor $v) and 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",
" (use -r for readonly)\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_dependencies("/modules/modules.dep");
fs::mount($dev, $where, $fs, $r);
}
sub umount {
@_ == 1 or die "umount expects a single argument\n";
require fs;
fs::umount($_[0]);
}
sub mkdir_ {
my ($_rec) = getopts(\@_, qw(p));
mkdir_p($_) foreach @_;
}
sub mknod {
if (@_ == 1) {
require devices;
eval { devices::make($_[0]) }; $@ and die "mknod: failed to create $_[0]\n";
} elsif (@_ == 4) {
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) = 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 swapon {
@_ == 1 or die "swapon <file>\n";
require swap;
swap::swapon($_[0]);
}
sub swapoff {
@_ == 1 or die "swapoff <file>\n";
require swap;
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 {
@_ >= 2 or die "usage: cp <sources> <dest>\n(this cp does -Rfl by default)\n";
cp_af(@_);
}
sub ps {
@_ and die "usage: ps\n";
my ($pid, $rss, $cpu, $cmd);
my ($uptime) = 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: 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 || @_ < to_bool($n) and die "usage: $0 [-h] [-n lines] [<file>]\n";
$n = $n ? shift : 10;
my $fh; @_ ? open($fh, $_[0]) || die "error: can't open file $_[0]\n" : ($fh = *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 = devices::make('tty');
my $n = 0;
open(my $IN, $tty) or die "can't open $tty\n";
local $_;
while (<>) {
if (++$n == 25) {
my $v = <$IN>;
$v =~ /^q/ and exit 0;
$n = 0;
}
print
}
}
sub insmod {
my ($h) = getopts(\@_, qw(h));
$h || @_ == 0 and die "usage: insmod <module> [options]\n";
my $f = shift;
require run_program;
require modules;
if (! -r $f) {
my $name = basename($f);
$name =~ s/\.k?o$//;
($f) = modules::extract_modules('/tmp', $name);
}
if (! -r $f) {
die "can't find module $f\n";
}
run_program::run(["/usr/bin/insmod_", "insmod"], "-f", $f, @_) or die("insmod $f 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_dependencies("/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"; #- 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 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";
my $fh; @_ ? open($fh, $_[0]) || die "error: can't open file $_[0]\n" : ($fh = *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 $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 ; $ENV{LD_LOADER} bzip2 -cd $cpio | $ENV{LD_LOADER} cpio -id $name $name/* $more");
"$dir/$name";
}
sub bug {