diff options
Diffstat (limited to 'MDK/Common/System.pm')
| -rw-r--r-- | MDK/Common/System.pm | 181 |
1 files changed, 181 insertions, 0 deletions
diff --git a/MDK/Common/System.pm b/MDK/Common/System.pm new file mode 100644 index 0000000..c8c4535 --- /dev/null +++ b/MDK/Common/System.pm @@ -0,0 +1,181 @@ +package MDK::Common::System; + +use MDK::Common::Math; +use MDK::Common::File; + + +use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK %compat_arch $printable_chars $sizeof_int $bitof_int); #); +@ISA = qw(Exporter); +@EXPORT_OK = qw(%compat_arch $printable_chars $sizeof_int $bitof_int typeFromMagic list_passwd list_home list_skels syscall_ df sync psizeof availableMemory availableRamMB gettimeofday unix2dos getVarsFromSh setVarsInSh setVarsInShMode setVarsInCsh template2file template2userfile update_userkderc); #); +%EXPORT_TAGS = (all => [ @EXPORT_OK ]); + + +%compat_arch = ( #- compatibilty arch mapping. + 'noarch' => undef, + 'ia32' => 'noarch', + 'i386' => 'ia32', + 'i486' => 'i386', + 'i586' => 'i486', + 'i686' => 'i586', + 'i786' => 'i686', + 'k6' => 'i586', + 'k7' => 'k6', + 'k8' => 'k7', + 'ia64' => 'noarch', + 'ppc' => 'noarch', + 'alpha' => 'noarch', + 'sparc' => 'noarch', + 'sparc32' => 'sparc', + 'sparc64' => 'sparc32', + 'ia64' => 'noarch', + ); + +$printable_chars = "\x20-\x7E"; +$sizeof_int = psizeof("i"); +$bitof_int = $sizeof_int * 8; + +sub typeFromMagic { + my $f = shift; + local *F; sysopen F, $f, 0 or return; + + my $tmp; + M: foreach (@_) { + my ($name, @l) = @$_; + while (@l) { + my ($offset, $signature) = splice(@l, 0, 2); + sysseek(F, $offset, 0) or next M; + sysread(F, $tmp, length $signature); + $tmp eq $signature or next M; + } + return $name; + } + undef; +} + + +sub list_passwd() { + my (@l, @e); + setpwent(); + while (@e = getpwent()) { push @l, [ @e ] } + endpwent(); + @l; +} +sub list_home() { + map { $_->[7] } grep { $_->[2] >= 500 } list_passwd(); +} +sub list_skels { + my ($prefix, $suffix) = @_; + grep { -d $_ && -w $_ } map { "$prefix$_/$suffix" } '/etc/skel', '/root', list_home(); +} + + + +sub syscall_ { + my $f = shift; + + require 'syscall.ph'; + syscall(&{$common::{"SYS_$f"}}, @_) == 0; +} + + +#- return the size of the partition and its free space in KiB +sub df { + my ($mntpoint) = @_; + my ($blocksize, $size, $free); + my $buf = ' ' x 20000; + syscall_('statfs', $mntpoint, $buf) or return; + (undef, $blocksize, $size, $free, undef, undef) = unpack "L!6", $buf; + map { $_ * ($blocksize / 1024) } $size, $free; +} + +sub sync { syscall_('sync') } +sub psizeof { length pack $_[0] } +sub availableMemory() { MDK::Common::Math::sum(map { /(\d+)/ } grep { /^(MemTotal|SwapTotal):/ } MDK::Common::File::cat_("/proc/meminfo")); } +sub availableRamMB() { 4 * MDK::Common::Math::round((-s '/proc/kcore') / 1024 / 1024 / 4); } +sub gettimeofday { my $t = pack "LL"; syscall_('gettimeofday', $t, 0) or die "gettimeofday failed: $!\n"; unpack("LL", $t) } +sub unix2dos { local $_ = $_[0]; s/\015$//mg; s/$/\015/mg; $_ } + + + +sub getVarsFromSh { + my %l; + local *F; open F, $_[0] or return; + local $_; + while (<F>) { + s/#.*//; # remove comments + my ($v, $val, $val2) = + /^\s* # leading space + (\w+) = # variable + ( + "([^"]*)" # double-quoted text + | '([^']*)' # single-quoted text + | [^'"\s]+ # normal text + ) + \s*$ # end of line + /x or next; + $l{$v} = defined $val2 ? $val2 : $val; + } + %l; +} + +sub setVarsInSh { + my ($file, $l, @fields) = @_; + setVarsInShMode($file, 0777 ^ umask(), $l, @fields); +} + +sub setVarsInShMode { + my ($file, $mod, $l, @fields) = @_; + @fields = keys %$l unless @fields; + + local *F; + open F, "> $file" or die "cannot create config file $file"; + chmod $mod, $file; + $l->{$_} and print F "$_=$l->{$_}\n" foreach @fields; +} + +sub setVarsInCsh { + my ($file, $l, @fields) = @_; + @fields = keys %$l unless @fields; + + local *F; + open F, "> $_[0]" or die "cannot create config file $file"; + $l->{$_} and print F "setenv $_ $l->{$_}\n" foreach @fields; +} + +sub template2file { + my ($in, $out, %toreplace) = @_; + output $out, map { s/@@@(.*?)@@@/$toreplace{$1}/g; $_ } MDK::Common::File::cat_($in); +} +sub template2userfile { + my ($prefix, $in, $out_rel, $force, %toreplace) = @_; + + foreach (list_skels($prefix, $out_rel)) { + -d MDK::Common::File::dirname($_) or !-e $_ or $force or next; + + template2file($in, $_, %toreplace); + m|/home/(.+?)/| and chown(getpwnam($1), getgrnam($1), $_); + } +} +sub update_userkderc { + my ($file, $category, %subst) = @_; + + output $file, + (map { + my $l = $_; + s/^\s*//; + if (my $i = /^\[$category\]/i ... /^\[/) { + if ($i =~ /E/) { #- for last line of category + $l = join('', map_each { "$::a=$::b\n" } %subst) . $l; + %subst = (); + } elsif (/^(\w*?)=/) { + if (my $e = delete $subst{lc($1)}) { + $l = "$1=$e\n"; + } + } + } + $l; + } MDK::Common::File::cat_($file)), + (%subst && "[$category]\n", map_each { "$::a=$::b\n" } %subst); #- if category has not been found above. +} + +1; |