Changeset 23 for devel/pb/lib/distro.pm

Timestamp:

07/31/07 19:24:50 (6 years ago)

Author:

bruno

Message:

Take ideas from LinuxDistribution?.pm, but does not use it, as it desn't work correctly.
redo a get_distro function in distro.pm

File:

• devel/pb/lib/distro.pm (modified) (3 diffs)

devel/pb/lib/distro.pm

@@ -7 +7 @@
 
 use strict;
-use LinuxDistribution qw (distribution_name distribution_version);
 
 sub distro_init {
 
-my $ddir = shift;
-my $dver = shift;
+my $ddir = shift || undef;
+my $dver = shift || undef;
 my $dfam = "unknown";
 my $dtype = "unknown";
@@ -18 +17 @@
 
 # If we don't know which distribution we're on, then guess it
-$ddir = distribution_name() if (not defined $ddir);
-$dver = distribution_version() if (not defined $dver);
+($ddir,$dver) = get_distro() if ((not defined $ddir) || (not defined $dver));
 
 # There shold be unicity of names between ddir dfam and dtype
@@ -83 +81 @@
 return($ddir, $dver, $dfam, $dtype, $dsuf);
 }
+
+sub get_distro {
+
+# Cf: http://linuxmafia.com/faq/Admin/release-files.html
+# Ideas taken from 
+# http://search.cpan.org/~kerberus/Linux-Distribution-0.14/lib/Linux/Distribution.pm
+
+my $base="/etc";
+
+# List of files that unambiguously indicates what distro we have
+my %single_rel_files = (
+# Tested
+    'gentoo'            =>  'gentoo-release',       # >= 1.6
+    'debian'            =>  'debian_version',       # >= 3.1
+    'slackware'         =>  'slackware-version',    # >= 10.2
+    'mandriva'          =>  'mandriva-release',     # >=2006.0
+    'fedora'            =>  'fedora-release',       # >= 4
+    'sles'              =>  'sles-release',         # ???
+# Untested
+    'knoppix'           =>  'knoppix_version',      #
+    'yellowdog'         =>  'yellowdog-release',    #
+    'esmith'            =>  'e-smith-release',      #
+    'turbolinux'        =>  'turbolinux-release',   #
+    'blackcat'          =>  'blackcat-release',     #
+    'aurox'             =>  'aurox-release',        #
+    'annvix'            =>  'annvix-release',       #
+    'cobalt'            =>  'cobalt-release',       #
+    'redflag'           =>  'redflag-release',      #
+    'ark'               =>  'ark-release',          #
+    'pld'               =>  'pld-release',          #
+    'nld'               =>  'nld-release',          #
+    'lfs'               =>  'lfs-release',          #
+    'mk'                =>  'mk-release',           #
+    'conectiva'         =>  'conectiva-release',    #
+    'immunix'           =>  'immunix-release',      #
+    'tinysofa'          =>  'tinysofa-release',     #
+    'trustix'           =>  'trustix-release',      #
+    'adamantix'         =>  'adamantix_version',    #
+    'yoper'             =>  'yoper-release',        #
+    'arch'              =>  'arch-release',         #
+    'libranet'          =>  'libranet_version',     #
+    'valinux'           =>  'va-release',           #
+    'yellowdog'         =>  'yellowdog-release',    #
+    'ultrapenguin'      =>  'ultrapenguin-release', #
+    );
+
+# List of files that ambiguously indicates what distro we have
+my %ambiguous_rel_files = (
+    'mandrake'          =>  'mandrake-release',     # >= 10.1
+    'suse'              =>  'SuSE-release',         # >= 10.0
+    'redhat'            =>  'redhat-release',       # >= 7.3
+    'lsb'               =>  'lsb-release',          # ???
+    );
+
+# Should have the same keys as the previous one.
+# If ambiguity, which other distributions should be checked
+my %distro_similar = (
+    'mandrake'          => ('mandrake'),
+    'suse'              => ('suse', 'sles'),
+    'redhat'            => ('redhat', 'rhel', 'centos', 'mandrake'),
+    'lsb'               => ('ubuntu', 'debian', 'lsb')
+    )
+
+my %distro_match = (
+# Tested
+    'gentoo'                => '.* version (.+)',
+    'debian'                => '([^/]+)[/]*.*',
+    'slackware'             => '[^ ]* (.+) [^ ]*',
+# There should be no ambiguity between potential ambiguous distro
+    'mandrake'              => 'Mandr[^ ]* release (.+) .*',
+    'mandriva'              => 'Mandr[^ ]* [^ ]* release (.+) .*',
+    'fedora'                => 'Fedora .*release (\d+) .*',
+    'rhel'                  => '.* Enterprise .*release (.+) \(',
+    'centos'                => '.*CentOS .*release (.+) .*',
+    'redhat'                => 'Red Hat Linux release (.+) .*',
+    'sles'                  => '.* Enterprise .*\nVERSION = (.+)',
+    'suse'                  => '.* [^Enterpis] .*\nVERSION = (.+)',
+    'lsb'                   => '.*[^Ubunt].*\nDISTRIB_RELEASE=(.+)',
+    'ubuntu'                => '.*Ubuntu.*\nDISTRIB_RELEASE=(.+)',
+# Not tested
+    'arch'                  => '.* ([0-9.]+) .*',
+    'redflag'               => 'Red Flag (?:Desktop|Linux) (?:release |\()(.*?)(?: \(.+)?\)',
+);
+
+my $release;
+my $distro;
+
+# Begin to test presence of non-amiguous files
+# that way we reduce the choice
+while (my ($d,$r) each %single_rel_files) {
+    if (-f "$base/$r" && !-l "$base/$r"){
+        $release=get_content("$base/$r");
+        # Found the only possibility. 
+        # Try to get version and return
+        if (defined ($distro_match{$d}) {
+            $release =~ m/$distro_match{$d}/m;
+        } else {
+            print STDERR "Unable to find $d's version in $r\n";
+            print STDERR "Please report to the maintainer bruno_at_project-builder.org\n";
+            $release = "unknown";
+        }
+        return($d,$release);
+    }
+}
+
+while (my ($d,$r) each %ambiguous_rel_files) {
+    if (-f "$base/$r" && !-l "$base/$r"){
+        # Found one possibility. 
+        # Get all distros concerned by that file
+        $release=get_content("$base/$r");
+        $found = 0;
+        foreach $dd (@$distro_similar{$d}) {
+            # Try to check pattern
+            if ((defined ($distro_match{$dd}) && ($release =~ /$distro_match{$dd}/m) {
+                $release =~ m/$distro_match{$dd}/m;
+                $distro = $dd;
+                $found = 1;
+            }
+        }
+        if ($found == 0) {
+            print STDERR "Unable to find $d's version in $r\n";
+            print STDERR "Please report to the maintainer bruno_at_project-builder.org\n";
+            $release = "unknown";
+        } else {
+            return($distro,$release);
+        }
+    }
+}
+return("unknown","unknown");
+
+sub get_content {
+
+my $file=shift;
+
+my $bkp = $/;
+undef $/;
+open(R,$file) || die "Unable to open $file: $!";
+my $content=<R>;
+close(R);
+$/ = $bkp;
+return($content);
+}
 1;