source: devel/pb-modules/lib/ProjectBuilder/Distribution.pm @ 622

Last change on this file since 622 was 622, checked in by Bruno Cornec, 11 years ago
  • pb now uses pb_distro_installdeps in VM/VE setup
  • pb_get_distro => pb_distro_get for homogeneity
  • before installing packages, call the update of the pkg db before (may create issues, but is generally better)
  • Adds pb_distro_only_deps_needed to compute the packages in a list whose installation is really needed
File size: 13.5 KB
Line 
1#!/usr/bin/perl -w
2#
3# Creates common environment for distributions
4#
5# $Id$
6#
7
8package ProjectBuilder::Distribution;
9
10use strict;
11use Data::Dumper;
12use ProjectBuilder::Base;
13
14# Inherit from the "Exporter" module which handles exporting functions.
15 
16use Exporter;
17 
18# Export, by default, all the functions into the namespace of
19# any code which uses this module.
20 
21our @ISA = qw(Exporter);
22our @EXPORT = qw(pb_distro_init pb_distro_get pb_distro_installdeps pb_distro_getdeps pb_distro_only_deps_needed);
23
24=pod
25
26=head1 NAME
27
28ProjectBuilder::Distribution, part of the project-builder.org - module dealing with distribution detection
29
30=head1 DESCRIPTION
31
32This modules provides functions to allow detection of Linux distributions, and giving back some attributes concerning them.
33
34=head1 SYNOPSIS
35
36  use ProjectBuilder::Distribution;
37
38  #
39  # Return information on the running distro
40  #
41  my ($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd) = pb_distro_init();
42  print "distro tuple: ".Dumper($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd)."\n";
43  #
44  # Return information on the requested distro
45  #
46  my ($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd) = pb_distro_init("ubuntu","7.10");
47  print "distro tuple: ".Dumper($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd)."\n";
48  #
49  # Return information on the running distro
50  #
51  my ($ddir,$dver) = pb_distro_get();
52  my ($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd) = pb_distro_init($ddir,$dver);
53  print "distro tuple: ".Dumper($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd)."\n";
54
55=head1 USAGE
56
57=over 4
58
59
60=item B<pb_distro_get>
61
62This function returns a list of 2 parameters indicating the distribution name and version of the underlying Linux distribution. The value of those 2 fields may be "unknown" in case the function was unable to recognize on which distribution it is running.
63
64On my home machine it would currently report ("mandriva","2008.0").
65
66=cut
67
68sub pb_distro_init {
69
70my $ddir = shift || undef;
71my $dver = shift || undef;
72my $dfam = "unknown";
73my $dtype = "unknown";
74my $dsuf = "unknown";
75my $dupd = "unknown";
76
77# If we don't know which distribution we're on, then guess it
78($ddir,$dver) = pb_distro_get() if ((not defined $ddir) || (not defined $dver));
79
80# There should be unicity of names between ddir dfam and dtype
81# In case of duplicate, bad things can happen
82if (($ddir =~ /debian/) ||
83    ($ddir =~ /ubuntu/)) {
84    $dfam="du";
85    $dtype="deb";
86    $dsuf=".$ddir$dver";
87    # Chaining the commands allow to only test for what is able o be installed,
88    # not the update of the repo which may well be unaccessible if too old
89    $dupd="sudo apt-get update ; sudo apt-get -y install ";
90} elsif ($ddir =~ /gentoo/) {
91    $dfam="gen";
92    $dtype="ebuild";
93    $dver="nover";
94    $dsuf=".$ddir";
95    $dupd="sudo emerge ";
96} elsif ($ddir =~ /slackware/) {
97    $dfam="slack";
98    $dtype="tgz";
99    $dsuf=".$dfam$dver";
100} elsif (($ddir =~ /suse/) ||
101        ($ddir =~ /sles/)) {
102    if ($ddir =~ /opensuse/) {
103        $ddir = "suse";
104    }
105    $dfam="novell";
106    $dtype="rpm";
107    $dsuf=".$ddir$dver";
108    $dupd="export TERM=linux ; sudo yast2 -y ";
109} elsif (($ddir =~ /redhat/) ||
110        ($ddir =~ /rhel/) ||
111        ($ddir =~ /fedora/) ||
112        ($ddir =~ /vmware/) ||
113        ($ddir =~ /centos/)) {
114    $dfam="rh";
115    $dtype="rpm";
116    my $dver1 = $dver;
117    $dver1 =~ s/\.//;
118
119    # By defaut propose yum
120    my $arch=`uname -m`;
121    my $opt = "";
122    chomp($arch);
123    if ($arch eq "x86_64") {
124        $opt="--exclude=*.i?86";
125    }
126    $dupd="sudo yum clean all; sudo yum update ; sudo yum -y $opt install ";
127    if ($ddir =~ /fedora/) {
128        $dsuf=".fc$dver1";
129    } elsif ($ddir =~ /redhat/) {
130        $dsuf=".rh$dver1";
131        $dupd="unknown";
132    } elsif ($ddir =~ /vmware/) {
133        $dsuf=".vwm$dver1";
134        $dupd="unknown";
135    } else {
136        # older versions of rhel and centos ran up2date
137        if (($dver eq "2.1") || ($dver eq "3") || ($dver eq "4")) {
138            $dupd="sudo up2date -y ";
139        }
140        $dsuf=".$ddir$dver1";
141    }
142} elsif (($ddir =~ /mandrake/) ||
143        ($ddir =~ /mandrakelinux/) ||
144        ($ddir =~ /mandriva/)) {
145    $dfam="md";
146    $dtype="rpm";
147    if ($ddir =~ /mandrakelinux/) {
148        $ddir = "mandrake";
149    }
150    if ($ddir =~ /mandrake/) {
151        my $dver1 = $dver;
152        $dver1 =~ s/\.//;
153        $dsuf=".mdk$dver1";
154    } else {
155        $dsuf=".mdv$dver";
156    }
157    # Chaining the commands allow to only test for what is able o be installed,
158    # not the update of the repo which may well be unaccessible if too old
159    $dupd="sudo urpmi.update -a ; sudo urpmi --auto ";
160} elsif ($ddir =~ /freebsd/) {
161    $dfam="bsd";
162    $dtype="port";
163    my $dver1 = $dver;
164    $dver1 =~ s/\.//;
165    $dsuf=".$dfam$dver1";
166} else {
167    $dfam="unknown";
168}
169
170return($ddir, $dver, $dfam, $dtype, $dsuf, $dupd);
171}
172
173=item B<pb_distro_init>
174
175This function returns a list of 5 parameters indicating the distribution name, version, family, type of build system and suffix of packages of the underlying Linux distribution. The value of the 5 fields may be "unknown" in case the function was unable to recognize on which distribution it is running.
176
177As an example, Ubuntu and Debian are in the same "du" family. As well as RedHat, RHEL, CentOS, fedora are on the same "rh" family.
178Mandriva, Open SuSE and Fedora have all the same "rpm" type of build system. Ubuntu ad Debian have the same "deb" type of build system.
179And "fc" is the extension generated for all Fedora packages (Version will be added by pb).
180
181When passing the distribution name and version as parameters, the B<pb_distro_init> function returns the parameter of that distribution instead of the underlying one.
182
183Cf: http://linuxmafia.com/faq/Admin/release-files.html
184Ideas taken from http://search.cpan.org/~kerberus/Linux-Distribution-0.14/lib/Linux/Distribution.pm
185
186=cut
187
188sub pb_distro_get {
189
190my $base="/etc";
191
192# List of files that unambiguously indicates what distro we have
193my %single_rel_files = (
194# Tested
195    'gentoo'            =>  'gentoo-release',       # >= 1.6
196    'slackware'         =>  'slackware-version',    # >= 10.2
197    'mandriva'          =>  'mandriva-release',     # >=2006.0
198    'mandrakelinux'     =>  'mandrakelinux-release',# = 10.2
199    'fedora'            =>  'fedora-release',       # >= 4
200    'vmware'            =>  'vmware-release',       # >= 3
201    'sles'              =>  'sles-release',         # Doesn't exist as of 10
202# Untested
203    'knoppix'           =>  'knoppix_version',      #
204    'yellowdog'         =>  'yellowdog-release',    #
205    'esmith'            =>  'e-smith-release',      #
206    'turbolinux'        =>  'turbolinux-release',   #
207    'blackcat'          =>  'blackcat-release',     #
208    'aurox'             =>  'aurox-release',        #
209    'annvix'            =>  'annvix-release',       #
210    'cobalt'            =>  'cobalt-release',       #
211    'redflag'           =>  'redflag-release',      #
212    'ark'               =>  'ark-release',          #
213    'pld'               =>  'pld-release',          #
214    'nld'               =>  'nld-release',          #
215    'lfs'               =>  'lfs-release',          #
216    'mk'                =>  'mk-release',           #
217    'conectiva'         =>  'conectiva-release',    #
218    'immunix'           =>  'immunix-release',      #
219    'tinysofa'          =>  'tinysofa-release',     #
220    'trustix'           =>  'trustix-release',      #
221    'adamantix'         =>  'adamantix_version',    #
222    'yoper'             =>  'yoper-release',        #
223    'arch'              =>  'arch-release',         #
224    'libranet'          =>  'libranet_version',     #
225    'valinux'           =>  'va-release',           #
226    'yellowdog'         =>  'yellowdog-release',    #
227    'ultrapenguin'      =>  'ultrapenguin-release', #
228    );
229
230# List of files that ambiguously indicates what distro we have
231my %ambiguous_rel_files = (
232    'mandrake'          =>  'mandrake-release',     # <= 10.1
233    'debian'            =>  'debian_version',       # >= 3.1
234    'suse'              =>  'SuSE-release',         # >= 10.0
235    'redhat'            =>  'redhat-release',       # >= 7.3
236    'lsb'               =>  'lsb-release',          # ???
237    );
238
239# Should have the same keys as the previous one.
240# If ambiguity, which other distributions should be checked
241my %distro_similar = (
242    'mandrake'          => ['mandrake', 'mandrakelinux'],
243    'debian'            => ['debian', 'ubuntu'],
244    'suse'              => ['suse', 'sles', 'opensuse'],
245    'redhat'            => ['redhat', 'rhel', 'centos', 'mandrake', 'vmware'],
246    'lsb'               => ['ubuntu', 'lsb'],
247    );
248
249my %distro_match = (
250# Tested
251    'gentoo'                => '.* version (.+)',
252    'slackware'             => 'S[^ ]* (.+)$',
253# There should be no ambiguity between potential ambiguous distro
254    'mandrakelinux'         => 'Mandrakelinux release (.+) \(',
255    'mandrake'              => 'Mandr[^ ]* release (.+) \(',
256    'mandriva'              => 'Mandr[^ ]* [^ ]* release (.+) \(',
257    'fedora'                => 'Fedora .*release (\d+) \(',
258    'vmware'                => 'VMware ESX Server (\d+) \(',
259    'rhel'                  => 'Red Hat (?:Enterprise Linux|Linux Advanced Server) .*release ([0-9.]+).* \(',
260    'centos'                => '.*CentOS .*release (.+) ',
261    'redhat'                => 'Red Hat Linux release (.+) \(',
262    'sles'                  => 'SUSE .* Enterprise Server (\d+) \(',
263    'suse'                  => 'SUSE LINUX (\d.+) \(',
264    'opensuse'              => 'openSUSE (\d.+) \(',
265    'lsb'                   => '.*[^Ubunt].*\nDISTRIB_RELEASE=(.+)',
266# Ubuntu includes a /etc/debian_version file that cretaes an ambiguity with debian
267# So we need to look at distros in reverse alphabetic order to treat ubuntu always first
268    'ubuntu'                => '.*Ubuntu.*\nDISTRIB_RELEASE=(.+)',
269    'debian'                => '(.+)',
270# Not tested
271    'arch'                  => '.* ([0-9.]+) .*',
272    'redflag'               => 'Red Flag (?:Desktop|Linux) (?:release |\()(.*?)(?: \(.+)?\)',
273);
274
275my $release;
276my $distro;
277
278# Begin to test presence of non-ambiguous files
279# that way we reduce the choice
280my ($d,$r);
281while (($d,$r) = each %single_rel_files) {
282    if (-f "$base/$r" && ! -l "$base/$r") {
283        my $tmp=pb_get_content("$base/$r");
284        # Found the only possibility.
285        # Try to get version and return
286        if (defined ($distro_match{$d})) {
287            ($release) = $tmp =~ m/$distro_match{$d}/m;
288        } else {
289            print STDERR "Unable to find $d version in $r\n";
290            print STDERR "Please report to the maintainer bruno_at_project-builder.org\n";
291            $release = "unknown";
292        }
293        return($d,$release);
294    }
295}
296
297# Now look at ambiguous files
298# Ubuntu includes a /etc/debian_version file that creates an ambiguity with debian
299# So we need to look at distros in reverse alphabetic order to treat ubuntu always first via lsb
300foreach $d (reverse keys %ambiguous_rel_files) {
301    $r = $ambiguous_rel_files{$d};
302    if (-f "$base/$r" && !-l "$base/$r") {
303        # Found one possibility.
304        # Get all distros concerned by that file
305        my $tmp=pb_get_content("$base/$r");
306        my $found = 0;
307        my $ptr = $distro_similar{$d};
308        pb_log(2,"amb: ".Dumper($ptr)."\n");
309        $release = "unknown";
310        foreach my $dd (@$ptr) {
311            pb_log(2,"check $dd\n");
312            # Try to check pattern
313            if (defined $distro_match{$dd}) {
314                pb_log(2,"cmp: $distro_match{$dd} - vs - $tmp\n");
315                ($release) = $tmp =~ m/$distro_match{$dd}/m;
316                if ((defined $release) && ($release ne "unknown")) {
317                    $distro = $dd;
318                    $found = 1;
319                    last;
320                }
321            }
322        }
323        if ($found == 0) {
324            print STDERR "Unable to find $d version in $r\n";
325            print STDERR "Please report to the maintainer bruno_at_project-builder.org\n";
326            $release = "unknown";
327        } else {
328            return($distro,$release);
329        }
330    }
331}
332return("unknown","unknown");
333}
334
335
336=over 4
337
338=item B<pb_distro_installdeps>
339
340This function install the dependencies required to build the package on an RPM based distro
341dependencies can be passed as a prameter in which case they are not computed
342
343=cut
344
345sub pb_distro_installdeps {
346
347# SPEC file
348my $f = shift || undef;
349my $dtype = shift || undef;
350my $dupd = shift || undef;
351my $deps = shift || undef;
352
353# Protection
354return if (not defined $dupd);
355
356# Get dependecies in the build file if not forced
357$deps = pb_distro_getdeps("$f", $dtype) if (not defined $deps);
358pb_log(2,"deps: $deps\n");
359return if (not defined $deps);
360if ($deps !~ /^[    ]*$/) {
361    pb_system("$dupd $deps","Installing dependencies ($deps)");
362    }
363}
364
365=over 4
366
367=item B<pb_distro_getdeps>
368
369This function computes the dependencies indicated in the build file and return them as a string of packages to install
370
371=cut
372
373sub pb_distro_getdeps {
374
375my $f = shift || undef;
376my $dtype = shift || undef;
377
378my $regexp = "";
379my $deps = "";
380my $sep = $/;
381
382pb_log(3,"entering pb_distro_getdeps: $dtype - $f\n");
383# Protection
384return("") if (not defined $dtype);
385if ($dtype eq  "rpm") {
386    # In RPM this could include files, but we do not handle them atm.
387    $regexp = '^BuildRequires:(.*)$';
388} elsif ($dtype eq "du") {
389    $regexp = '^Build-Depends:(.*)$';
390} elsif ($dtype eq "ebuild") {
391    $sep = '"'.$/;
392    $regexp = '^DEPEND="(.*)"\n'
393} else {
394    # No idea
395    return("");
396}
397pb_log(2,"regexp: $regexp\n");
398
399
400# Protection
401return("") if (not defined $f);
402
403# Preserve separator before using the one we need
404my $oldsep = $/;
405$/ = $sep;
406open(DESC,"$f") || die "Unable to open $f";
407while (<DESC>) {
408    pb_log(4,"read: $_\n");
409    next if (! /$regexp/);
410    chomp();
411    # What we found with the regexp is the list of deps.
412    pb_log(2,"found deps: $_\n");
413    s/$regexp/$1/;
414    # Remove conditions
415    s/>[=]*.*,//g;
416    # Improve string format (remove , and spaces at start, end and in double
417    s/,//g;
418    s/^\s*//;
419    s/\s*$//;
420    s/\s+/ /g;
421    $deps .= " ".$_;
422}
423close(DESC);
424$/ = $oldsep;
425pb_log(2,"now deps: $deps\n");
426my $deps2 = pb_distro_only_deps_needed($dtype,$deps);
427return($deps2);
428}
429
430
431=over 4
432
433=item B<pb_distro_only_deps_needed>
434
435This function returns only the dependencies not yet installed
436
437=cut
438
439sub pb_distro_only_deps_needed {
440
441my $deps = shift || undef;
442my $dtype = shift || undef;
443
444my $deps2 = "";
445# Avoid to install what is already there
446foreach my $p (split(/ /,$deps)) {
447    if ($dtype eq  "rpm") {
448        my $res = pb_system("rpm -q --whatprovides --quiet $p","","quiet");
449        next if ($res eq 0);
450    } elsif ($dtype eq "du") {
451        my $res = pb_system("dpkg -L $p","","quiet");
452        next if ($res eq 0);
453    } elsif ($dtype eq "ebuild") {
454    } else {
455        # Not reached
456    }
457    pb_log(2,"found deps2: $p\n");
458    $deps2 .= " $p";
459}
460
461$deps2 =~ s/^\s*//;
462pb_log(2,"now deps2: $deps2\n");
463return($deps2);
464}
465
466=back
467
468=head1 WEB SITES
469
470The main Web site of the project is available at L<http://www.project-builder.org/>. Bug reports should be filled using the trac instance of the project at L<http://trac.project-builder.org/>.
471
472=head1 USER MAILING LIST
473
474None exists for the moment.
475
476=head1 AUTHORS
477
478The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
479
480=head1 COPYRIGHT
481
482Project-Builder.org is distributed under the GPL v2.0 license
483described in the file C<COPYING> included with the distribution.
484
485=cut
486
487
4881;
Note: See TracBrowser for help on using the repository browser.