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

Last change on this file since 2177 was 2177, checked in by Bruno Cornec, 3 years ago

Improved build procedure

build is now calling back prep first in order to speed up the debug of
packages dependencies, so with docker you don't have to prep before (which can
takes a lot of time) before using that result

File size: 24.0 KB
Line 
1#!/usr/bin/perl -w
2#
3# Creates common environment for distributions
4#
5# Copyright B. Cornec 2007-2016
6# Eric Anderson's changes are (c) Copyright 2012 Hewlett Packard
7# Provided under the GPL v2
8#
9# $Id$
10#
11
12package ProjectBuilder::Distribution;
13
14use strict;
15use Data::Dumper;
16use Carp 'confess';
17use ProjectBuilder::Version;
18use ProjectBuilder::Base;
19use ProjectBuilder::Conf;
20use File::Basename;
21use File::Copy;
22# requires perl 5.004 minimum in VM/VE
23use File::Compare;
24
25# Global vars
26# Inherit from the "Exporter" module which handles exporting functions.
27 
28use vars qw($VERSION $REVISION @ISA @EXPORT);
29use Exporter;
30 
31# Export, by default, all the functions into the namespace of
32# any code which uses this module.
33 
34our @ISA = qw(Exporter);
35our @EXPORT = qw(pb_distro_init pb_distro_conffile pb_distro_sysconffile pb_distro_get pb_distro_getlsb pb_distro_installdeps pb_distro_getdeps pb_distro_only_deps_needed pb_distro_setuprepo pb_distro_setuposrepo pb_distro_get_param pb_distro_get_context pb_distro_to_keylist pb_distro_conf_print pb_apply_conf_proxy);
36($VERSION,$REVISION) = pb_version_init();
37
38=pod
39
40=head1 NAME
41
42ProjectBuilder::Distribution, part of the project-builder.org - module dealing with distribution detection
43
44=head1 DESCRIPTION
45
46This modules provides functions to allow detection of Linux distributions, and giving back some attributes concerning them.
47
48=head1 SYNOPSIS
49
50  use ProjectBuilder::Distribution;
51
52  #
53  # Return information on the running distro
54  #
55  my $pbos = pb_distro_get_context();
56  print "distro tuple: ".Dumper($pbos->name, $pbos->ver, $pbos->fam, $pbos->type, $pbos->pbsuf, $pbos->pbupd, $pbos->pbins, $pbos->arch)."\n";
57  #
58  # Return information on the requested distro
59  #
60  my $pbos = pb_distro_get_context("ubuntu-7.10-x86_64");
61  print "distro tuple: ".Dumper($pbos->name, $pbos->ver, $pbos->fam, $pbos->type, $pbos->pbsuf, $pbos->pbupd, $pbos->pbins, $pbos->arch)."\n";
62  #
63  # Return information on the running distro
64  #
65  my ($ddir,$dver) = pb_distro_get();
66
67=head1 USAGE
68
69=over 4
70
71=item B<pb_distro_conffile>
72
73This function returns the mandatory configuration file used for distribution/OS detection
74
75=cut
76
77sub pb_distro_conffile {
78
79return("CCCC/pb.conf");
80}
81
82=item B<pb_distro_sysconffile>
83
84This function returns the optional configuration file used for local customization
85
86=cut
87
88sub pb_distro_sysconffile {
89
90return("SSSS/pb.conf");
91}
92
93
94=item B<pb_distro_init>
95
96This function returns a hash of parameters indicating the distribution name, version, family, type of build system, suffix of packages, update command line, installation command line and architecture of the underlying Linux distribution. The value of the fields may be "unknown" in case the function was unable to recognize on which distribution it is running.
97
98As an example, Ubuntu and Debian are in the same "du" family. As well as RedHat, RHEL, CentOS, fedora are on the same "rh" family.
99Mandriva, Open SuSE and Fedora have all the same "rpm" type of build system. Ubuntu and Debian have the same "deb" type of build system.
100And "fc" is the extension generated for all Fedora packages (Version will be added by pb).
101All this information is stored in an external configuration file typically at /etc/pb/pb.conf
102
103When 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.
104
105Cf: http://linuxmafia.com/faq/Admin/release-files.html
106Ideas taken from http://search.cpan.org/~kerberus/Linux-Distribution-0.14/lib/Linux/Distribution.pm
107
108=cut
109
110
111sub pb_distro_init {
112
113my $pbos = {
114    'name' => undef,
115    'version' => undef,
116    'arch' => undef,
117    'family' => "unknown",
118    'suffix' => "unknown",
119    'update' => "unknown",
120    'install' => "unknown",
121    'type' => "unknown",
122    'os' => "unknown",
123    'nover' => "false",
124    'rmdot' => "false",
125    'useminor' => "false",
126    };
127$pbos->{'name'} = shift;
128$pbos->{'version'} = shift;
129$pbos->{'arch'} = shift;
130
131# Adds conf file for distribution description
132# the location of the conf file is finalyzed at install time
133# depending whether we deal with package install or tar file install
134
135pb_conf_add(pb_distro_sysconffile());
136
137# Similarly for the local file available for sysadmin. After the previous one to allow overwrite to work
138pb_conf_add(pb_distro_conffile());
139
140# If we don't know which distribution we're on, then guess it
141($pbos->{'name'},$pbos->{'version'}) = pb_distro_get() if ((not defined $pbos->{'name'}) || (not defined $pbos->{'version'}));
142
143# For some rare cases, typically nover ones
144$pbos->{'name'} = "unknown" if (not defined $pbos->{'name'});
145$pbos->{'version'} = "unknown" if (not defined $pbos->{'version'});
146
147# Initialize arch
148$pbos->{'arch'} = pb_get_arch() if (not defined $pbos->{'arch'});
149# Solves a bug on Red Hat 6.x where real arch is not detected when using setarch and a chroot
150# As it was only i386 forcing it here.
151$pbos->{'arch'} = "i386" if (($pbos->{'name'} eq "redhat") && ($pbos->{'version'} =~ /^6\./));
152
153# Dig into the tuple to find the best answer
154# Do NOT factorize here, as it won't work as of now for hash creation
155# Do NOT change order without caution
156$pbos->{'useminor'} = pb_distro_get_param($pbos,pb_conf_get("osuseminorrel"));
157$pbos->{'family'} = pb_distro_get_param($pbos,pb_conf_get("osfamily"));
158$pbos->{'type'} = pb_distro_get_param($pbos,pb_conf_get("ostype"));
159($pbos->{'os'},$pbos->{'install'},$pbos->{'suffix'},$pbos->{'nover'},$pbos->{'rmdot'},$pbos->{'update'}) = pb_distro_get_param($pbos,pb_conf_get("os","osins","ossuffix","osnover","osremovedotinver","osupd"));
160#($pbos->{'family'},$pbos->{'type'},$pbos->{'os'},$pbos->{'install'},$pbos->{'suffix'},$pbos->{'nover'},$pbos->{'rmdot'},$pbos->{'update'}) = pb_distro_get_param($pbos,pb_conf_get("osfamily","ostype","os","osins","ossuffix","osnover","osremovedotinver","osupd"));
161
162# Some OS have no interesting version
163$pbos->{'version'} = "nover" if ((defined $pbos->{'nover'}) && ($pbos->{'nover'} eq "true"));
164
165# For some OS remove the . in version name for extension
166my $dver2 = $pbos->{'version'};
167$dver2 =~ s/\.//g if ((defined $pbos->{'rmdot'}) && ($pbos->{'rmdot'} eq "true"));
168
169if ((not defined $pbos->{'suffix'}) || ($pbos->{'suffix'} eq "")) {
170    # By default suffix is a concatenation of name and version
171    $pbos->{'suffix'} = ".$pbos->{'name'}$dver2" 
172} else {
173    # concat just the version to what has been found
174    $pbos->{'suffix'} = ".$pbos->{'suffix'}$dver2";
175}
176
177#   if ($arch eq "x86_64") {
178#   $opt="--exclude=*.i?86";
179#   }
180pb_log(2,"DEBUG: pb_distro_init: ".Dumper($pbos)."\n");
181
182return($pbos);
183}
184
185=item B<pb_distro_get>
186
187This 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.
188
189On my home machine it would currently report ("mandriva","2010.2").
190
191=cut
192
193sub pb_distro_get {
194
195# 1: List of files that unambiguously indicates what distro we have
196# 2: List of files that ambiguously indicates what distro we have
197# 3: Should have the same keys as the previous one. If ambiguity, which other distributions should be checked
198# 4: Matching Rg. Expr to detect distribution and version
199my ($single_rel_files, $ambiguous_rel_files,$distro_similar,$distro_match) = pb_conf_get("osrelfile","osrelambfile","osambiguous","osrelexpr");
200
201my $release;
202my $distro;
203
204# Begin to test presence of non-ambiguous files
205# that way we reduce the choice
206my ($d,$r);
207while (($d,$r) = each %$single_rel_files) {
208    if (defined $ambiguous_rel_files->{$d}) {
209        print STDERR "The key $d is considered as both unambiguous and ambigous.\n";
210        print STDERR "Please fix your configuration file.\n"
211    }
212    if (-f "$r" && ! -l "$r") {
213        my $tmp=pb_get_content("$r");
214        # Found the only possibility.
215        # Try to get version and return
216        if (defined ($distro_match->{$d})) {
217            ($release) = $tmp =~ m/$distro_match->{$d}/m;
218        } else {
219            print STDERR "Unable to find $d version in $r (non-ambiguous)\n";
220            print STDERR "Please report to the maintainer bruno_at_project-builder.org\n";
221            $release = "unknown";
222        }
223        return($d,$release);
224    }
225}
226
227# Now look at ambiguous files
228# Ubuntu before 10.04 includes a /etc/debian_version file that creates an ambiguity with debian
229# So we need to look at distros in reverse alphabetic order to treat ubuntu always first via lsb
230my $found = 0;
231foreach $d (reverse keys %$ambiguous_rel_files) {
232    $r = $ambiguous_rel_files->{$d};
233    if (-f "$r" && !-l "$r") {
234        # Found one possibility.
235        # Get all distros concerned by that file
236        my $tmp=pb_get_content("$r");
237        my $ptr = $distro_similar->{$d};
238        pb_log(2,"amb: ".Dumper($ptr)."\n");
239        $release = "unknown";
240        foreach my $dd (split(/,/,$ptr)) {
241            pb_log(2,"check $dd\n");
242            # Try to check pattern
243            if (defined $distro_match->{$dd}) {
244                pb_log(2,"cmp: $distro_match->{$dd} - vs - $tmp\n");
245                ($release) = $tmp =~ m/$distro_match->{$dd}/m;
246                if ((defined $release) && ($release ne "unknown")) {
247                    $distro = $dd;
248                    $found = 1;
249                    last;
250                }
251            }
252        }
253        last if ($found == 1);
254    }
255}
256if ($found == 0) {
257    print STDERR "Unable to find a version in ".join(' ',keys %$ambiguous_rel_files)." (ambiguous)\n";
258    print STDERR "Please report to the maintainer bruno_at_project-builder.org\n";
259    return("unknown","unknown");
260} else {
261    return($distro,$release);
262}
263}
264
265=item B<pb_distro_getlsb>
266
267This function returns the 5 lsb values LSB version, distribution ID, Description, release and codename.
268As entry it takes an optional parameter to specify whether the output is short or not.
269
270=cut
271
272sub pb_distro_getlsb {
273
274my $s = shift;
275pb_log(3,"Entering pb_distro_getlsb\n");
276
277my ($ambiguous_rel_files) = pb_conf_get("osrelambfile");
278my $lsbf = $ambiguous_rel_files->{"lsb"};
279
280# LSB has not been configured.
281if (not defined $lsbf) {
282    print STDERR "no lsb entry defined for osrelambfile\n";
283    confess "You modified upstream delivery and lost !\n";
284}
285
286if (-r $lsbf) {
287    my $rep = pb_get_content($lsbf);
288    # Create elementary fields
289    my ($c, $r, $d, $i, $l) = ("", "", "", "", "");
290    for my $f (split(/\n/,$rep)) {
291        pb_log(3,"Reading file part ***$f***\n");
292        $c = $f if ($f =~ /^DISTRIB_CODENAME/);
293        $c =~ s/DISTRIB_CODENAME=/Codename:\t/;
294        $r = $f if ($f =~ /^DISTRIB_RELEASE/);
295        $r =~ s/DISTRIB_RELEASE=/Release:\t/;
296        $d = $f if ($f =~ /^DISTRIB_DESCRIPTION/);
297        $d =~ s/DISTRIB_DESCRIPTION=/Description:\t/;
298        $d =~ s/"//g;
299        $i = $f if ($f =~ /^DISTRIB_ID/);
300        $i =~ s/DISTRIB_ID=/Distributor ID:\t/;
301        $l = $f if ($f =~ /^LSB_VERSION/);
302        $l =~ s/LSB_VERSION=/LSB Version:\t/;
303    }
304    my $regexp = "^[A-z ]*:[\t ]*";
305    $c =~ s/$regexp// if (defined $s);
306    $r =~ s/$regexp// if (defined $s);
307    $d =~ s/$regexp// if (defined $s);
308    $i =~ s/$regexp// if (defined $s);
309    $l =~ s/$regexp// if (defined $s);
310    return($l, $i, $d, $r, $c);
311} else {
312    print STDERR "Unable to read $lsbf file\n";
313    confess "Please report to the maintainer bruno_at_project-builder.org\n";
314}
315}
316
317# Internal function
318
319sub pb_apply_conf_proxy {
320my ($pbos) = @_;
321
322my $ftp_proxy = pb_distro_get_param($pbos,pb_conf_get_if("ftp_proxy"));
323my $http_proxy = pb_distro_get_param($pbos,pb_conf_get_if("http_proxy"));
324
325# We do not overwrite shell settings
326$ENV{ftp_proxy} ||= $ftp_proxy if ((defined $ftp_proxy) && ($ftp_proxy ne ""));
327$ENV{http_proxy} ||= $http_proxy if ((defined $http_proxy) && ($http_proxy ne ""));
328}
329
330=item B<pb_distro_installdeps>
331
332This function install the dependencies required to build the package on a distro.
333Dependencies can be passed as a parameter in which case they are not computed
334
335=cut
336
337sub pb_distro_installdeps {
338
339# SPEC file
340my $f = shift;
341my $pbos = shift;
342my $deps = shift;
343
344# Protection
345confess "Missing install command for $pbos->{name}-$pbos->{version}-$pbos->{arch}" unless (defined $pbos->{install} && $pbos->{install} =~ /\w/);
346pb_apply_conf_proxy($pbos);
347
348# Get dependencies in the build file if not forced
349$deps = pb_distro_getdeps($f,$pbos) if (not defined $deps);
350pb_log(1, "ftp_proxy=$ENV{ftp_proxy}\n") if (defined $ENV{ftp_proxy});
351pb_log(1, "http_proxy=$ENV{http_proxy}\n")  if (defined $ENV{http_proxy});
352pb_log(2,"deps: $deps\n");
353return if ((not defined $deps) || ($deps =~ /^\s*$/));
354
355# This may not be // proof. We should test for availability of repo and sleep if not
356my $cmd = "$pbos->{'install'} $deps";
357my $ret = pb_system($cmd, "Installing dependencies ($cmd)","mayfail");
358# Try to accomodate deficient proxies
359if ($ret != 0) {
360    pb_system($cmd, "Re-trying installing dependencies ($cmd)");
361}
362# Check that all deps have been installed correctly
363$deps = pb_distro_getdeps($f, $pbos);
364confess "Some dependencies did not install ($deps)" if ((defined $deps) && ($deps =~ /\S/) && ($Global::pb_stop_on_error));
365}
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;
376my $pbos = shift;
377
378my $regexp = "";
379my $deps = "";
380my $sep = $/;
381
382# Protection
383return("") if (not defined $pbos->{'type'});
384return("") if (not defined $f);
385
386pb_log(3,"entering pb_distro_getdeps: $pbos->{'type'} - $f\n");
387if ($pbos->{'type'} eq  "rpm") {
388    # In RPM this could include files, but we do not handle them atm.
389    $regexp = '^BuildRequires:(.*)$';
390} elsif ($pbos->{'type'} eq "deb") {
391    $regexp = '^Build-Depends:(.*)$';
392} elsif ($pbos->{'type'} eq "ebuild") {
393    $sep = '"'.$/;
394    $regexp = '^DEPEND="(.*)"\n'
395} else {
396    # No idea
397    return("");
398}
399pb_log(2,"regexp: $regexp\n");
400
401# Preserve separator before using the one we need
402my $oldsep = $/;
403$/ = $sep;
404open(DESC,"$f") || confess "Unable to open $f";
405while (<DESC>) {
406    pb_log(4,"read: $_\n");
407    next if (! /$regexp/);
408    chomp();
409
410    my $nextline;
411    # Support multi-lines deps for .deb
412    if ($pbos->{type} eq 'deb') {
413        while ($nextline = <DESC>) {
414            last unless $nextline =~ /^\s+(.+)$/o;
415            $_ .= $1;
416        }
417    }
418
419    # What we found with the regexp is the list of deps.
420    pb_log(2,"found deps: $_\n");
421    s/$regexp/$1/i;
422    pb_log(4,"found deps 1: $_\n");
423    # Remove conditions in the middle and at the end for deb
424    s/\(\s*[><=]+.*\)[^,]*,/,/g;
425    pb_log(4,"found deps 2: $_\n");
426    s/\(\s*[><=]+.*$//g;
427    pb_log(4,"found deps 3: $_\n");
428    # Same for rpm
429    s/[><=]+[^,]*,/,/g;
430    pb_log(4,"found deps 4: $_\n");
431    s/[><=]+.*$//g;
432    pb_log(4,"found deps 5: $_\n");
433    # Improve string format (remove , and spaces at start, end and in double
434    s/,/ /g;
435    pb_log(4,"found deps 6: $_\n");
436    s/^\s*//;
437    pb_log(4,"found deps 7: $_\n");
438    # $ here removes the \n
439    s/\s*$//;
440    pb_log(4,"found deps 8: $_\n");
441    s/\s+/ /g;
442    pb_log(4,"found deps 9: $_\n");
443    $deps .= " ".$_;
444    pb_log(4,"found deps end: $deps\n");
445
446    # Support multi-lines deps for .deb (fwup)
447    if (defined $nextline) {
448        $_ = $nextline;
449        redo;
450    }
451}
452close(DESC);
453$/ = $oldsep;
454pb_log(2,"now deps: $deps\n");
455my $deps2 = pb_distro_only_deps_needed($pbos,$deps);
456return($deps2);
457}
458
459
460=item B<pb_distro_only_deps_needed>
461
462This function returns only the dependencies not yet installed
463
464=cut
465
466sub pb_distro_only_deps_needed {
467
468my $pbos = shift;
469my $deps = shift;
470
471return("") if ((not defined $deps) || ($deps =~ /^\s*$/));
472my $deps2 = "";
473# Avoid to install what is already there
474delete $ENV{COLUMNS};
475foreach my $p (split(/\s+/,$deps)) {
476    next if $p =~ /^\s*$/o;
477    if ($pbos->{'type'} eq  "rpm") {
478        my $rpmcmd = "rpm -q --whatprovides --quiet";
479        # whatprovides doesn't work for RH6.2
480        $rpmcmd = "rpm -q --quiet" if (($pbos->{'name'} eq "redhat") && ($pbos->{'version'} =~ /6/));
481        my $res = pb_system("$rpmcmd $p","Looking for $p","mayfail");
482        next if ($res eq 0);
483        pb_log(1, "INFO: missing dependency $p\n");
484    } elsif ($pbos->{'type'} eq "deb") {
485        my $res = pb_system("dpkg -L $p","Looking for $p","mayfail");
486        next if ($res eq 0);
487        open(CMD,"dpkg -l $p |") or confess "Unable to run dpkg -l $p: $!";
488        my $ok = 0;
489        while (<CMD>) {
490            $ok = 1 if /^ii\s+$p/;
491        }
492        close(CMD);
493        next if $ok;
494        pb_log(1, "INFO: missing dependency $p\n");
495    } elsif ($pbos->{'type'} eq "ebuild") {
496    } else {
497        # Not reached
498    }
499    pb_log(2,"found deps2: $p\n");
500    $deps2 .= " $p";
501}
502
503$deps2 =~ s/^\s*//;
504pb_log(2,"now deps2: $deps2\n");
505return($deps2);
506}
507
508=item B<pb_distro_setuposrepo>
509
510This function sets up potential additional repository for the setup phase
511
512=cut
513
514sub pb_distro_setuposrepo {
515
516my $pbos = shift;
517
518pb_distro_setuprepo_gen($pbos,pb_distro_conffile(),"osrepo");
519}
520
521=item B<pb_distro_setuprepo>
522
523This function sets up potential additional repository to the build environment
524
525=cut
526
527sub pb_distro_setuprepo {
528
529my $pbos = shift;
530
531pb_distro_setuprepo_gen($pbos,"$ENV{'PBDESTDIR'}/pbrc","addrepo");
532}
533
534# Internal
535sub pb_distro_compare_repo {
536
537my $src = shift;
538my $dest = shift;
539
540if (not -f $dest) {
541    pb_log(1, "INFO: Creating new file $dest\n");
542} elsif (-f $dest && -s $dest == 0) {
543    pb_log(1, "INFO: Overwriting empty file $dest\n");
544} elsif (-f $dest && compare("$src", $dest) == 0) {
545    pb_log(1, "INFO: Overwriting identical file $dest\n");
546} else {
547    pb_log(0, "ERROR: destination file $dest exists and is different than source $src\n");
548    pb_system("cat $dest","INFO: Dest...\n");
549    pb_system("cat $src","INFO: New...\n");
550    pb_log("INFO: Returning...\n");
551    return(1);
552}
553return(0);
554}
555
556=item B<pb_distro_setuprepo_gen>
557
558This function sets up in a generic way potential additional repository
559
560=cut
561
562sub pb_distro_setuprepo_gen {
563
564my $pbos = shift;
565my $pbconf = shift;
566my $pbkey = shift;
567
568return if (not defined $pbconf);
569return if (not defined $pbkey);
570my ($addrepo) = pb_conf_read($pbconf,$pbkey);
571return if (not defined $addrepo);
572
573my $param = pb_distro_get_param($pbos,$addrepo);
574return if ($param eq "");
575
576pb_apply_conf_proxy($pbos);
577
578# Loop on the list of additional repo
579foreach my $i (split(/,/,$param)) {
580
581    pb_log(1,"Adding repository defined by $i\n");
582    my ($scheme, $account, $host, $port, $path) = pb_get_uri($i);
583    my $bn = basename($i);
584
585    # The repo file can be local or remote. download or copy at the right place
586    if (($scheme eq "ftp") || ($scheme =~ /http/)) {
587        pb_system("wget -O $ENV{'PBTMP'}/$bn $i","Downloading additional repository file $i");
588    } else {
589        copy($i,"$ENV{'PBTMP'}/$bn");
590    }
591
592    # The repo file can be a real file or a package
593    if ($pbos->{'type'} eq "rpm") {
594        if ($bn =~ /\.rpm$/) {
595            my $pn = $bn;
596            $pn =~ s/\.rpm//;
597            if (pb_system("rpm -q --quiet $pn","","mayfail") != 0) {
598                pb_system("sudo rpm -Uvh $ENV{'PBTMP'}/$bn","Adding package $bn to setup repository");
599            }
600        } elsif ($bn =~ /\.repo$/) {
601            my $dirdest = "";
602            my $reponame = "";
603            # TODO: could go in pb.conf in fact
604            if ($pbos->{install} =~ /\byum\b/) {
605                $reponame="yum";
606                $dirdest = "/etc/yum.repos.d";
607            } elsif ($pbos->{install} =~ /\bdnf\b/) {
608                $reponame="dnf";
609                $dirdest = "/etc/yum.repos.d";
610            } elsif ($pbos->{install} =~ /\bzypper\b/) {
611                $reponame="zypper";
612                $dirdest = "/etc/zypp/repos.d";
613            } else {
614                confess "Unknown location for repository file for '$pbos->{install}' command";
615            }
616            my $dest = "$dirdest/$bn";
617            return if (pb_distro_compare_repo("$ENV{'PBTMP'}/$bn",$dest) == 1);
618            confess "Missing directory $dirdest ($reponame)" unless (-d $dirdest);
619            pb_system("sudo mv $ENV{'PBTMP'}/$bn $dest","Adding $reponame repository") if (not -f "$dest");
620        } elsif ($bn =~ /\.addmedia/) {
621            # URPMI repo
622            # We should test that it's not already a urpmi repo
623            pb_system("chmod 755 $ENV{'PBTMP'}/$bn ; sudo $ENV{'PBTMP'}/$bn 2>&1 > /dev/null","Adding urpmi repository");
624        } else {
625            pb_log(0,"ERROR: Unable to deal with repository file $i on rpm distro ! Please report to dev team\n");
626        }
627    } elsif ($pbos->{'type'} eq "deb") {
628        if ($bn =~ /\.sources.list$/) {
629            my $dest = "/etc/apt/sources.list.d/$bn";
630            return if (pb_distro_compare_repo("$ENV{'PBTMP'}/$bn",$dest) == 1);
631            pb_system("sudo mv $ENV{'PBTMP'}/$bn /etc/apt/sources.list.d","Adding apt repository");
632            pb_system("sudo apt-get update","Updating apt repository");
633        } else {
634            pb_log(0,"ERROR: Unable to deal with repository file $i on deb distro ! Please report to dev team\n");
635        }
636    } else {
637        pb_log(0,"ERROR: Unable to deal with repository file $i on that distro ! Please report to dev team\n");
638    }
639}
640return;
641}
642
643=item B<pb_distro_to_keylist>
644
645Given a pbos object (first param) and the generic key (second param), get the list of possible keys for looking up variable for
646filter names.  The list will be sorted most-specific to least specific.
647
648=cut
649
650sub pb_distro_to_keylist ($$) {
651
652my ($pbos, $generic) = @_;
653
654foreach my $key (qw/name version arch family type os/) {
655    confess "missing pbos key $key" unless (defined $pbos->{$key});
656}
657
658my @keylist = ("$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}", "$pbos->{'name'}-$pbos->{'version'}");
659
660# Loop to include also previous minor versions
661# if configured so
662if ((defined $pbos->{'useminor'}) && ($pbos->{'useminor'} eq "true") && ($pbos->{'version'} =~ /^(\d+)\.(\d+)$/o)) {
663        my ($major, $minor) = ($1, $2);
664        while ($minor > 0) {
665                $minor--;
666                push (@keylist, "$pbos->{'name'}-${major}.$minor");
667        }
668        push (@keylist, "$pbos->{'name'}-$major");
669}
670
671push (@keylist, $pbos->{'name'}, $pbos->{'family'}, $pbos->{'type'}, $pbos->{'os'}, $generic);
672return @keylist;
673}
674
675=item B<pb_distro_get_param>
676
677This function gets the parameter in the conf file from the most precise tuple up to default
678
679=cut
680
681sub pb_distro_get_param {
682
683my @param = ();
684my $pbos = shift;
685
686my @keylist = pb_distro_to_keylist($pbos,"default");
687pb_log(2,"DEBUG: pb_distro_get_param on $pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'} for ".Dumper(@_)."\n");
688foreach my $opt (@_) {
689    my $param = "";
690    foreach my $key (@keylist) {
691        if (defined $opt->{$key}) {
692            $param = $opt->{$key};
693            last;
694        }
695    }
696    # Allow replacement of variables inside the parameter such as name, version, arch for rpmbootstrap
697    # but not shell variable which are backslashed
698    if ($param =~ /[^\\]\$/) {
699        pb_log(3,"Expanding variable on $param\n");
700        eval { $param =~ s/(\$\w+->\{\'\w+\'\})/$1/eeg };
701    }
702    push @param,$param;
703}
704
705pb_log(2,"DEBUG: pb_distro_get_param on $pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'} returns ==".Dumper(@param)."==\n");
706
707# Return one param if user only asked for one lookup, an array if not.
708my $nb = @param;
709if ($nb eq 1) {
710    return($param[0]);
711} else {
712    return(@param);
713}
714}
715
716=item B<pb_distro_get_context>
717
718This function gets the OS context passed as parameter and return the corresponding distribution hash
719If passed undef or "" then auto-detects
720
721=cut
722
723
724sub pb_distro_get_context {
725
726my $os = shift;
727my $pbos;
728
729if ((defined $os) && ($os ne "")) {
730    my ($name,$ver,$darch) = split(/-/,$os);
731    pb_log(0,"Bad format for $os") if ((not defined $name) || (not defined $ver) || (not defined $darch)) ;
732    chomp($darch);
733    $pbos = pb_distro_init($name,$ver,$darch);
734} else {
735    $pbos = pb_distro_init();
736}
737return($pbos);
738}
739
740=item B<pb_distro_conf_print>
741
742This function prints every configuration parameter in order to help debug stacking issues with conf files. If a VM/VE/RM is given, restrict display to this distribution. If parameters are passed, restrict again the display to these values only.
743
744=cut
745
746sub pb_distro_conf_print {
747
748my $pbos = shift;
749my @keys = @_;
750
751if ($#keys == -1) {
752    pb_log(0,"Full pb configuration for project $ENV{'PBPROJ'}\n");
753    pb_log(0,"================================================\n");
754    @keys = pb_conf_get_all();
755}
756if (defined $ENV{'PBV'}) {
757    pb_log(1,"Distribution $ENV{'PBV'}\n");
758    pb_log(1,"========================\n");
759} else {
760    pb_log(1,"Local Distribution\n");
761    pb_log(1,"==================\n");
762}
763
764my %rep;
765my $i = 0;
766# Index on distro
767foreach my $r (pb_distro_get_param($pbos,pb_conf_get(@keys))) {
768    $rep{$keys[$i]} = $r if (defined $keys[$i]);
769    $i++;
770}
771$i = 0;
772# Then Index on prj to overwrite previous value if needed
773foreach my $r (pb_conf_get(@keys)) {
774    $rep{$keys[$i]} = $r->{'default'} if (defined  $r->{'default'});
775    $rep{$keys[$i]} = $r->{$ENV{'PBPROJ'}} if (defined  $r->{$ENV{'PBPROJ'}});
776    $i++;
777}
778foreach my $r (keys %rep) {
779    pb_log(1, "$r => ");
780    pb_log(0, "$rep{$r}\n");
781}
782}
783
784
785=back
786
787=head1 WEB SITES
788
789The 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/>.
790
791=head1 USER MAILING LIST
792
793None exists for the moment.
794
795=head1 AUTHORS
796
797The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
798
799=head1 COPYRIGHT
800
801Project-Builder.org is distributed under the GPL v2.0 license
802described in the file C<COPYING> included with the distribution.
803
804=cut
805
806
8071;
Note: See TracBrowser for help on using the repository browser.