source: devel/pb/lib/ProjectBuilder/distro.pm @ 50

Last change on this file since 50 was 50, checked in by Bruno Cornec, 13 years ago

Try to better organize the tree to be perl compliant

  • Property svn:executable set to *
File size: 6.2 KB
Line 
1#!/usr/bin/perl -w
2#
3# Creates common environment for distributions
4#
5# $Id$
6#
7
8use strict;
9
10sub distro_init {
11
12my $ddir = shift || undef;
13my $dver = shift || undef;
14my $dfam = "unknown";
15my $dtype = "unknown";
16my $dsuf = "unknown";
17
18# If we don't know which distribution we're on, then guess it
19($ddir,$dver) = get_distro() if ((not defined $ddir) || (not defined $dver));
20
21# There shold be unicity of names between ddir dfam and dtype
22# In case of duplicate, bad things can happen
23if (($ddir =~ /debian/) ||
24    ($ddir =~ /ubuntu/)) {
25    $dfam="du";
26    $dtype="deb";
27    $dsuf=".$ddir$dver";
28} elsif ($ddir =~ /gentoo/) {
29    $dfam="gen";
30    $dtype="ebuild";
31    my $dver1 = $dver;
32    $dver1 =~ s/\.//;
33    $dsuf=".$ddir$dver1";
34} elsif ($ddir =~ /slackware/) {
35    $dfam="slack";
36    $dtype="tgz";
37    $dsuf=".$dfam$dver";
38} elsif (($ddir =~ /suse/) ||
39        ($ddir =~ /sles/)) {
40    $dfam="novell";
41    $dtype="rpm";
42    $dsuf=".$ddir$dver";
43} elsif (($ddir =~ /redhat/) ||
44        ($ddir =~ /rhel/) ||
45        ($ddir =~ /fedora/) ||
46        ($ddir =~ /centos/)) {
47    $dfam="rh";
48    $dtype="rpm";
49    my $dver1 = $dver;
50    $dver1 =~ s/\.//;
51    if ($ddir =~ /fedora/) {
52        $dsuf=".fc$dver1";
53    } elsif ($ddir =~ /redhat/) {
54        $dsuf=".rh$dver1";
55    } else {
56        $dsuf=".$ddir$dver1";
57    }
58} elsif (($ddir =~ /mandrake/) ||
59        ($ddir =~ /mandriva/)) {
60    $dfam="md";
61    $dtype="rpm";
62    if ($ddir =~ /mandrake/) {
63        my $dver1 = $dver;
64        $dver1 =~ s/\.//;
65        $dsuf=".mdk$dver1";
66    } else {
67        $dsuf=".mdv$dver";
68    }
69} elsif ($ddir =~ /freebsd/) {
70    $dfam="bsd";
71    $dtype="port";
72    my $dver1 = $dver;
73    $dver1 =~ s/\.//;
74    $dsuf=".$dfam$dver1";
75} else {
76    $dfam="unknown";
77    $dtype="unknown";
78    $dsuf="unknown";
79}
80
81return($ddir, $dver, $dfam, $dtype, $dsuf);
82}
83
84sub get_distro {
85
86# Cf: http://linuxmafia.com/faq/Admin/release-files.html
87# Ideas taken from
88# http://search.cpan.org/~kerberus/Linux-Distribution-0.14/lib/Linux/Distribution.pm
89
90my $base="/etc";
91
92# List of files that unambiguously indicates what distro we have
93my %single_rel_files = (
94# Tested
95    'gentoo'            =>  'gentoo-release',       # >= 1.6
96    'debian'            =>  'debian_version',       # >= 3.1
97    'slackware'         =>  'slackware-version',    # >= 10.2
98    'mandriva'          =>  'mandriva-release',     # >=2006.0
99    'fedora'            =>  'fedora-release',       # >= 4
100    'sles'              =>  'sles-release',         # ???
101# Untested
102    'knoppix'           =>  'knoppix_version',      #
103    'yellowdog'         =>  'yellowdog-release',    #
104    'esmith'            =>  'e-smith-release',      #
105    'turbolinux'        =>  'turbolinux-release',   #
106    'blackcat'          =>  'blackcat-release',     #
107    'aurox'             =>  'aurox-release',        #
108    'annvix'            =>  'annvix-release',       #
109    'cobalt'            =>  'cobalt-release',       #
110    'redflag'           =>  'redflag-release',      #
111    'ark'               =>  'ark-release',          #
112    'pld'               =>  'pld-release',          #
113    'nld'               =>  'nld-release',          #
114    'lfs'               =>  'lfs-release',          #
115    'mk'                =>  'mk-release',           #
116    'conectiva'         =>  'conectiva-release',    #
117    'immunix'           =>  'immunix-release',      #
118    'tinysofa'          =>  'tinysofa-release',     #
119    'trustix'           =>  'trustix-release',      #
120    'adamantix'         =>  'adamantix_version',    #
121    'yoper'             =>  'yoper-release',        #
122    'arch'              =>  'arch-release',         #
123    'libranet'          =>  'libranet_version',     #
124    'valinux'           =>  'va-release',           #
125    'yellowdog'         =>  'yellowdog-release',    #
126    'ultrapenguin'      =>  'ultrapenguin-release', #
127    );
128
129# List of files that ambiguously indicates what distro we have
130my %ambiguous_rel_files = (
131    'mandrake'          =>  'mandrake-release',     # >= 10.1
132    'suse'              =>  'SuSE-release',         # >= 10.0
133    'redhat'            =>  'redhat-release',       # >= 7.3
134    'lsb'               =>  'lsb-release',          # ???
135    );
136
137# Should have the same keys as the previous one.
138# If ambiguity, which other distributions should be checked
139my %distro_similar = (
140    'mandrake'          => ['mandrake'],
141    'suse'              => ['suse', 'sles'],
142    'redhat'            => ['redhat', 'rhel', 'centos', 'mandrake'],
143    'lsb'               => ['ubuntu', 'debian', 'lsb'],
144    );
145
146my %distro_match = (
147# Tested
148    'gentoo'                => '.* version (.+)',
149    'debian'                => '([^/]+)[/]*.*',
150    'slackware'             => 'S[^ ]* (.+)$',
151# There should be no ambiguity between potential ambiguous distro
152    'mandrake'              => 'Mandr[^ ]* release (.+) \(',
153    'mandriva'              => 'Mandr[^ ]* [^ ]* release (.+) \(',
154    'fedora'                => 'Fedora .*release (\d+) \(',
155    'rhel'                  => 'Red Hat Enterprise Linux .*release (.+) \(',
156    'centos'                => '.*CentOS .*release (.+) ',
157    'redhat'                => 'Red Hat Linux release (.+) \(',
158    'sles'                  => '.* Enterprise .*\nVERSION = (.+)',
159    'suse'                  => '.* [^Enterpis] .*\nVERSION = (.+)',
160    'lsb'                   => '.*[^Ubunt].*\nDISTRIB_RELEASE=(.+)',
161    'ubuntu'                => '.*Ubuntu.*\nDISTRIB_RELEASE=(.+)',
162# Not tested
163    'arch'                  => '.* ([0-9.]+) .*',
164    'redflag'               => 'Red Flag (?:Desktop|Linux) (?:release |\()(.*?)(?: \(.+)?\)',
165);
166
167my $release;
168my $distro;
169
170# Begin to test presence of non-amiguous files
171# that way we reduce the choice
172my ($d,$r);
173while (($d,$r) = each %single_rel_files) {
174    if (-f "$base/$r" && !-l "$base/$r") {
175        my $tmp=get_content("$base/$r");
176        # Found the only possibility.
177        # Try to get version and return
178        if (defined ($distro_match{$d})) {
179            ($release) = $tmp =~ m/$distro_match{$d}/m;
180        } else {
181            print STDERR "Unable to find $d version in $r\n";
182            print STDERR "Please report to the maintainer bruno_at_project-builder.org\n";
183            $release = "unknown";
184        }
185        return($d,$release);
186    }
187}
188
189while (($d,$r) = each %ambiguous_rel_files) {
190    if (-f "$base/$r" && !-l "$base/$r"){
191        # Found one possibility.
192        # Get all distros concerned by that file
193        my $tmp=get_content("$base/$r");
194        my $found = 0;
195        my $ptr = $distro_similar{$d};
196        print $LOG "amb: ".Dumper($ptr)."\n" if ($debug >= 1);
197        $release = "unknown";
198        foreach my $dd (@$ptr) {
199            print $LOG "check $dd\n" if ($debug >= 1);
200            # Try to check pattern
201            if (defined $distro_match{$dd}) {
202                print $LOG "cmp: $distro_match{$dd} - vs - $tmp\n" if ($debug >= 1);
203                ($release) = $tmp =~ m/$distro_match{$dd}/m;
204                if ((defined $release) && ($release ne "unknown")) {
205                    $distro = $dd;
206                    $found = 1;
207                    last;
208                }
209            }
210        }
211        if ($found == 0) {
212            print STDERR "Unable to find $d version in $r\n";
213            print STDERR "Please report to the maintainer bruno_at_project-builder.org\n";
214            $release = "unknown";
215        } else {
216            return($distro,$release);
217        }
218    }
219}
220return("unknown","unknown");
221}
222
223sub get_content {
224
225my $file=shift;
226
227my $bkp = $/;
228undef $/;
229open(R,$file) || die "Unable to open $file: $!";
230my $content=<R>;
231close(R);
232chomp($content);
233$/ = $bkp;
234return($content);
235}
2361;
Note: See TracBrowser for help on using the repository browser.