re-sync after the big svn loss

1 files changed, 478 insertions, 0 deletions

diff --git a/lib/MDK/Common/System.pm b/lib/MDK/Common/System.pm
new file mode 100644
index 0000000..a947523
--- /dev/null
+++ b/lib/MDK/Common/System.pm
@@ -0,0 +1,478 @@
+package MDK::Common::System;
+
+=head1 NAME
+
+MDK::Common::System - system-related useful functions
+
+=head1 SYNOPSIS
+
+    use MDK::Common::System qw(:all);
+
+=head1 EXPORTS
+
+=over
+
+=item %compat_arch
+
+architecture compatibility mapping (eg: k6 => i586, k7 => k6 ...)
+
+=item %printable_chars
+
+7 bit ascii characters
+
+=item $sizeof_int
+
+sizeof(int)
+
+=item $bitof_int
+
+$sizeof_int * 8
+
+=item arch()
+
+return the architecture (eg: i686, ppc, ia64, k7...)
+
+=item typeFromMagic(FILENAME, LIST)
+
+find the first corresponding magic in FILENAME. eg of LIST:
+
+    [ 'empty', 0, "\0\0\0\0" ],
+    [ 'grub', 0, "\xEBG", 0x17d, "stage1 \0" ],
+    [ 'lilo', 0x2,  "LILO" ],
+
+where each entry is [ magic_name, offset, string, offset, string, ... ].
+
+=item list_passwd()
+
+return the list of users as given by C<getpwent> (see perlfunc)
+
+=item list_home()
+
+return the list of home (eg: /home/foo, /home/pixel, ...)
+
+=item list_skels()
+
+return the directories where we can find dot files: homes, /root and /etc/skel
+
+=item list_users()
+
+return the list of unprivilegied users (aka those whose uid is greater
+than 500 and who are not "nobody").
+
+=item syscall_(NAME, PARA)
+
+calls the syscall NAME
+
+=item psizeof(STRING)
+
+useful to know the length of a C<pack> format string. 
+
+    psizeof("I I I C C S") = 4 + 4 + 4 + 1 + 1 + 2 = 16
+
+=item availableMemory()
+
+size of swap + memory
+
+=item availableRamMB()
+
+size of RAM as reported by the BIOS (it is a round number that can be
+displayed or given as "mem=128M" to the kernel)
+
+!! "mem=..." is dangerous in 2.4 kernels
+
+=item gettimeofday()
+
+returns the epoch in microseconds
+
+=item unix2dos(STRING)
+
+takes care of CR/LF translation
+
+=item whereis_binary(STRING)
+
+return the first absolute file in $PATH (similar to which(1) and whereis(1))
+
+=item getVarsFromSh(FILENAME)
+
+returns a hash associating shell variables to their value. useful for config
+files such as /etc/sysconfig files
+
+=item setVarsInSh(FILENAME, HASH REF)
+
+write file in shell format association a shell variable + value for each
+key/value
+
+=item setVarsInSh(FILENAME, HASH REF, LIST)
+
+restrict the fields that will be printed to LIST
+
+=item setVarsInShMode(FILENAME, INT, HASH REF, LIST)
+
+like setVarsInSh with INT being the chmod value for the config file
+
+=item addVarsInSh(FILENAME, HASH REF)
+
+like setVarsInSh but keeping the entries in the file
+
+=item addVarsInSh(FILENAME, HASH REF, LIST)
+
+like setVarsInSh but keeping the entries in the file
+
+=item addVarsInShMode(FILENAME, INT, HASH REF, LIST)
+
+like addVarsInShMode but keeping the entries in the file
+
+=item setExportedVarsInCsh(FILENAME, HASH REF, LIST)
+
+same as C<setExportedVarsInSh> for csh format
+
+=item template2file(FILENAME_IN, FILENAME_OUT, HASH)
+
+read in a template file, replace keys @@@key@@@ with value, save it in out
+file
+
+=item template2userfile(PREFIX, FILENAME_IN, FILENAME_OUT, BOOL, HASH)
+
+read in a template file, replace keys @@@key@@@ with value, save it in every homes.
+If BOOL is true, overwrite existing files. FILENAME_OUT must be a relative filename
+
+=item read_gnomekderc(FILENAME, STRING)
+
+reads GNOME-like and KDE-like config files (aka windows-like).
+You must give a category. eg:
+
+    read_gnomekderc("/etc/skels/.kderc", 'KDE')
+
+=item update_gnomekderc(FILENAME, STRING, HASH)
+
+modifies GNOME-like and KDE-like config files (aka windows-like).
+If the category doesn't exist, it creates it. eg:
+
+    update_gnomekderc("/etc/skels/.kderc", 'KDE', 
+		      kfmIconStyle => "Large")
+
+=item fuzzy_pidofs(REGEXP)
+
+return the list of process ids matching the regexp
+
+=back
+
+=head1 OTHER
+
+=over
+
+=item better_arch(ARCH1, ARCH2)
+
+is ARCH1 compatible with ARCH2?
+
+better_arch('i386', 'ia64') and better_arch('ia64', 'i386') are false
+
+better_arch('k7', 'k6') is true and better_arch('k6', 'k7') is false
+
+=item compat_arch(STRING)
+
+test the architecture compatibility. eg: 
+
+compat_arch('i386') is false on a ia64
+
+compat_arch('k6') is true on a k6 and k7 but false on a i386 and i686
+
+=back
+
+=head1 SEE ALSO
+
+L<MDK::Common>
+
+=cut
+
+
+use MDK::Common::Math;
+use MDK::Common::File;
+
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(%compat_arch $printable_chars $sizeof_int $bitof_int arch distrib typeFromMagic list_passwd list_home list_skels list_users syscall_ psizeof availableMemory availableRamMB gettimeofday unix2dos whereis_binary getVarsFromSh setVarsInSh setVarsInShMode addVarsInSh addVarsInShMode setExportedVarsInSh setExportedVarsInCsh template2file template2userfile read_gnomekderc update_gnomekderc fuzzy_pidofs); #);
+our %EXPORT_TAGS = (all => [ @EXPORT_OK ]);
+
+
+our %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',
+		     'x86_64'  => 'i686',
+		     'amd64'   => 'x86_64',
+		     'ia64'    => 'noarch',
+		     'ppc'     => 'noarch',
+		     'alpha'   => 'noarch',
+		     'sparc'   => 'noarch',
+		     'sparc32' => 'sparc',
+		     'sparc64' => 'sparc32',
+		     'ia64'    => 'noarch',
+		   );
+
+our $printable_chars = "\x20-\x7E";
+our $sizeof_int      = psizeof("i");
+our $bitof_int       = $sizeof_int * 8;
+
+
+sub arch() {
+    my $SYS_NMLN = 65;
+    my $format = "Z$SYS_NMLN" x 6;
+    my $t = pack $format;
+    syscall_('uname', $t);
+    (unpack($format, $t))[4];
+}
+sub better_arch {
+    my ($new, $old) = @_;
+    while ($new && $new ne $old) { $new = $compat_arch{$new} }
+    $new;
+}
+sub compat_arch { better_arch(arch(), $_[0]) }
+
+sub distrib() {
+    my $release = MDK::Common::File::cat_('/etc/release');
+    my ($real_system, $real_product) = $release =~ /(.*) release ([\d.]+)/;
+    my $oem_config = '/etc/sysconfig/oem';
+    my %oem = -f $oem_config && getVarsFromSh($oem_config);
+    my $company = $oem{COMPANY} || 'Mandriva';
+    my $system = $oem{SYSTEM} || $real_system;
+    my $product = $oem{PRODUCT} || $real_product;
+    (company => $company, system => $system, product => $product, real_system => $real_system, real_product => $real_product);
+}
+
+sub typeFromMagic {
+    my $f = shift;
+    sysopen(my $F, $f, 0) or return;
+
+    my $tmp;
+  M: foreach (@_) {
+	if (ref($_) eq 'CODE') {
+	    my $name = $_->($F) or next M;
+	    return $name;
+	} else {
+	    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 list_users() {
+    map { 500 <= $_->[2] && $_->[0] ne "nobody" ? $_->[0] : () } list_passwd();
+}
+
+
+
+sub syscall_ {
+    my $f = shift;
+
+    #- load syscall.ph in package "main". If every use of syscall.ph do the same, all will be nice
+    package main;
+    require 'syscall.ph';
+
+    syscall(&{"main::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 whereis_binary {
+    my ($prog, $o_prefix) = @_;
+    if ($prog =~ m!/!) {
+	warn qq(don't call whereis_binary with a name containing a "/" (the culprit is: $prog)\n);
+	return;
+    }
+    foreach (split(':', $ENV{PATH})) {
+	my $f = "$_/$prog";
+	-x "$o_prefix$f" and return $f; 
+    }
+}
+
+sub getVarsFromSh {
+    my %l;
+    open(my $F, $_[0]) or return;
+    local $_;
+    while (<$F>) {
+	s/#.*//; # remove comments
+	s/^\s*//; # leading space
+	my ($v, $val) = /^(\w+)=(.*)/ or next;
+	$val = $1 if $val =~ /^"(.*)"$/ || $val =~ /^'(.*)'$/;
+	$l{$v} = $val;
+    }
+    %l;
+}
+
+sub addVarsInSh {
+    my ($file, $l, @fields) = @_;
+    addVarsInShMode($file, 0777 ^ umask(), $l, @fields);
+}
+
+sub addVarsInShMode {
+    my ($file, $mod, $l, @fields) = @_;
+    my %l = @fields ? map { $_ => $l->{$_} } @fields : %$l;
+    my %l2 = getVarsFromSh($file);
+
+    # below is add2hash_(\%l, \%l2);
+    exists $l{$_} or $l{$_} = $l2{$_} foreach keys %l2; 
+
+    setVarsInShMode($file, $mod, \%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;
+    my $string = join('',
+	map { 
+	    my $val = $l->{$_};
+	    if ($val =~ /["`\$]/) {
+		$val =~ s/(')/\\$1/g;
+		$val = qq('$val');
+	    } elsif ($val =~ /['|\s\\]/) {
+		$val =~ s/(["\\])/\\$1/g;
+		$val = qq("$val");
+	    }
+	    "$_=$val\n";
+	} grep { $l->{$_} } @fields
+    );
+    if ($file =~ m!^/home/!) {
+        MDK::Common::File::secured_output($file, $string);
+    } else {
+        MDK::Common::File::output($file, $string);
+    }
+
+    chmod $mod, $file;
+}
+
+sub setExportedVarsInSh {
+    my ($file, $l, @fields) = @_;
+    @fields = keys %$l unless @fields;
+
+    MDK::Common::File::output($file, 
+	(map { $l->{$_} ? "$_=$l->{$_}\n" : () } @fields), 
+	@fields ? "export " . join(" ", @fields) . "\n" : (),
+    );
+}
+
+sub setExportedVarsInCsh {
+    my ($file, $l, @fields) = @_;
+    @fields = keys %$l unless @fields;
+
+    MDK::Common::File::output($file, map { $l->{$_} ? "setenv $_ $l->{$_}\n" : () } @fields);
+}
+
+sub template2file {
+    my ($in, $out, %toreplace) = @_;
+    MDK::Common::File::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 read_gnomekderc {
+    my ($file, $category) = @_;
+    my %h;
+    foreach (MDK::Common::File::cat_($file), "[NOCATEGORY]\n") {
+	if (/^\s*\[\Q$category\E\]/i ... /^\[/) {
+	    $h{$1} = $2 if /^\s*([^=]*?)=(.*)/;
+	}
+    }
+    %h;
+}
+
+sub update_gnomekderc {
+    my ($file, $category, %subst_) = @_;
+
+    my %subst = map { lc($_) => [ $_, $subst_{$_} ] } keys %subst_;
+
+    my $s;
+    defined($category) or $category = "DEFAULTCATEGORY";
+    foreach ("[DEFAULTCATEGORY]\n", MDK::Common::File::cat_($file), "[NOCATEGORY]\n") {
+	if (my $i = /^\s*\[\Q$category\E\]/i ... /^\[/) {
+	    if ($i =~ /E/) { #- for last line of category
+		chomp $s; $s .= "\n";
+		$s .= "$_->[0]=$_->[1]\n" foreach values %subst;
+		%subst = ();
+	    } elsif (/^\s*([^=]*?)=/) {
+		if (my $e = delete $subst{lc($1)}) {
+		    $_ = "$1=$e->[1]\n";
+		}
+	      }
+	}
+	$s .= $_ if !/^\[(NO|DEFAULT)CATEGORY\]/;
+    }
+
+    #- if category has not been found above (DEFAULTCATEGORY is always found).
+    if (keys %subst) {
+	chomp $s;
+	$s .= "\n[$category]\n";
+	$s .= "$_->[0]=$_->[1]\n" foreach values %subst;
+    }
+
+    MDK::Common::File::output_p($file, $s);
+
+}
+
+sub fuzzy_pidofs {
+    my ($regexp) = @_;
+    grep { 
+	/^(\d+)$/ && (MDK::Common::File::cat_("/proc/$_/cmdline") || readlink("/proc/$_/exe") || '') =~ /$regexp/;	
+    } MDK::Common::File::all('/proc');
+}
+
+1;