| 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 |
|
|---|
| 12 | package ProjectBuilder::Distribution;
|
|---|
| 13 |
|
|---|
| 14 | use strict;
|
|---|
| 15 | use Data::Dumper;
|
|---|
| 16 | use Carp 'confess';
|
|---|
| 17 | use ProjectBuilder::Version;
|
|---|
| 18 | use ProjectBuilder::Base;
|
|---|
| 19 | use ProjectBuilder::Conf;
|
|---|
| 20 | use File::Basename;
|
|---|
| 21 | use File::Copy;
|
|---|
| 22 | # requires perl 5.004 minimum in VM/VE
|
|---|
| 23 | use File::Compare;
|
|---|
| 24 |
|
|---|
| 25 | # Global vars
|
|---|
| 26 | # Inherit from the "Exporter" module which handles exporting functions.
|
|---|
| 27 |
|
|---|
| 28 | use vars qw($VERSION $REVISION @ISA @EXPORT);
|
|---|
| 29 | use Exporter;
|
|---|
| 30 |
|
|---|
| 31 | # Export, by default, all the functions into the namespace of
|
|---|
| 32 | # any code which uses this module.
|
|---|
| 33 |
|
|---|
| 34 | our @ISA = qw(Exporter);
|
|---|
| 35 | our @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_setuprepo_gen 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 |
|
|---|
| 42 | ProjectBuilder::Distribution, part of the project-builder.org - module dealing with distribution detection
|
|---|
| 43 |
|
|---|
| 44 | =head1 DESCRIPTION
|
|---|
| 45 |
|
|---|
| 46 | This 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 |
|
|---|
| 73 | This function returns the mandatory configuration file used for distribution/OS detection
|
|---|
| 74 |
|
|---|
| 75 | =cut
|
|---|
| 76 |
|
|---|
| 77 | sub pb_distro_conffile {
|
|---|
| 78 |
|
|---|
| 79 | return("CCCC/pb.conf");
|
|---|
| 80 | }
|
|---|
| 81 |
|
|---|
| 82 | =item B<pb_distro_sysconffile>
|
|---|
| 83 |
|
|---|
| 84 | This function returns the optional configuration file used for local customization
|
|---|
| 85 |
|
|---|
| 86 | =cut
|
|---|
| 87 |
|
|---|
| 88 | sub pb_distro_sysconffile {
|
|---|
| 89 |
|
|---|
| 90 | return("SSSS/pb.conf");
|
|---|
| 91 | }
|
|---|
| 92 |
|
|---|
| 93 |
|
|---|
| 94 | =item B<pb_distro_init>
|
|---|
| 95 |
|
|---|
| 96 | This 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 |
|
|---|
| 98 | As an example, Ubuntu and Debian are in the same "du" family. As well as RedHat, RHEL, CentOS, fedora are on the same "rh" family.
|
|---|
| 99 | Mandriva, Open SuSE and Fedora have all the same "rpm" type of build system. Ubuntu and Debian have the same "deb" type of build system.
|
|---|
| 100 | And "fc" is the extension generated for all Fedora packages (Version will be added by pb).
|
|---|
| 101 | All this information is stored in an external configuration file typically at /etc/pb/pb.conf
|
|---|
| 102 |
|
|---|
| 103 | When 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 |
|
|---|
| 105 | Cf: http://linuxmafia.com/faq/Admin/release-files.html
|
|---|
| 106 | Ideas taken from http://search.cpan.org/~kerberus/Linux-Distribution-0.14/lib/Linux/Distribution.pm
|
|---|
| 107 |
|
|---|
| 108 | =cut
|
|---|
| 109 |
|
|---|
| 110 |
|
|---|
| 111 | sub pb_distro_init {
|
|---|
| 112 |
|
|---|
| 113 | my $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 |
|
|---|
| 135 | pb_conf_add(pb_distro_sysconffile());
|
|---|
| 136 |
|
|---|
| 137 | # Similarly for the local file available for sysadmin. After the previous one to allow overwrite to work
|
|---|
| 138 | pb_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
|
|---|
| 166 | my $dver2 = $pbos->{'version'};
|
|---|
| 167 | $dver2 =~ s/\.//g if ((defined $pbos->{'rmdot'}) && ($pbos->{'rmdot'} eq "true"));
|
|---|
| 168 |
|
|---|
| 169 | if ((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 | # }
|
|---|
| 180 | pb_log(2,"DEBUG: pb_distro_init: ".Dumper($pbos)."\n");
|
|---|
| 181 |
|
|---|
| 182 | return($pbos);
|
|---|
| 183 | }
|
|---|
| 184 |
|
|---|
| 185 | =item B<pb_distro_get>
|
|---|
| 186 |
|
|---|
| 187 | This 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 |
|
|---|
| 189 | On my home machine it would currently report ("mandriva","2010.2").
|
|---|
| 190 |
|
|---|
| 191 | =cut
|
|---|
| 192 |
|
|---|
| 193 | sub 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
|
|---|
| 199 | my ($single_rel_files, $ambiguous_rel_files,$distro_similar,$distro_match) = pb_conf_get("osrelfile","osrelambfile","osambiguous","osrelexpr");
|
|---|
| 200 |
|
|---|
| 201 | my $release;
|
|---|
| 202 | my $distro;
|
|---|
| 203 |
|
|---|
| 204 | # Begin to test presence of non-ambiguous files
|
|---|
| 205 | # that way we reduce the choice
|
|---|
| 206 | my ($d,$r);
|
|---|
| 207 | while (($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
|
|---|
| 230 | my $found = 0;
|
|---|
| 231 | foreach $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 | }
|
|---|
| 256 | if ($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 |
|
|---|
| 267 | This function returns the 5 lsb values LSB version, distribution ID, Description, release and codename.
|
|---|
| 268 | As entry it takes an optional parameter to specify whether the output is short or not.
|
|---|
| 269 |
|
|---|
| 270 | =cut
|
|---|
| 271 |
|
|---|
| 272 | sub pb_distro_getlsb {
|
|---|
| 273 |
|
|---|
| 274 | my $s = shift;
|
|---|
| 275 | pb_log(3,"Entering pb_distro_getlsb\n");
|
|---|
| 276 |
|
|---|
| 277 | my ($ambiguous_rel_files) = pb_conf_get("osrelambfile");
|
|---|
| 278 | my $lsbf = $ambiguous_rel_files->{"lsb"};
|
|---|
| 279 |
|
|---|
| 280 | # LSB has not been configured.
|
|---|
| 281 | if (not defined $lsbf) {
|
|---|
| 282 | print STDERR "no lsb entry defined for osrelambfile\n";
|
|---|
| 283 | confess "You modified upstream delivery and lost !\n";
|
|---|
| 284 | }
|
|---|
| 285 |
|
|---|
| 286 | if (-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 |
|
|---|
| 319 | sub pb_apply_conf_proxy {
|
|---|
| 320 | my ($pbos) = @_;
|
|---|
| 321 |
|
|---|
| 322 | my $ftp_proxy = pb_distro_get_param($pbos,pb_conf_get_if("ftp_proxy"));
|
|---|
| 323 | my $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 |
|
|---|
| 332 | This function install the dependencies required to build the package on a distro.
|
|---|
| 333 | If $forcerepo is defined then do not assume packages are alredy installed, but reinstall them
|
|---|
| 334 | (useful if you add a repo which contains more up to date packages that you need)
|
|---|
| 335 | Dependencies can be passed as the 4th parameter in which case they are not computed
|
|---|
| 336 |
|
|---|
| 337 | =cut
|
|---|
| 338 |
|
|---|
| 339 | sub pb_distro_installdeps {
|
|---|
| 340 |
|
|---|
| 341 | # SPEC file
|
|---|
| 342 | my $f = shift;
|
|---|
| 343 | my $pbos = shift;
|
|---|
| 344 | my $forcerepo = shift;
|
|---|
| 345 | my $deps = shift; # optional list of deps to install
|
|---|
| 346 |
|
|---|
| 347 | # Protection
|
|---|
| 348 | confess "Missing install command for $pbos->{name}-$pbos->{version}-$pbos->{arch}" unless (defined $pbos->{install} && $pbos->{install} =~ /\w/);
|
|---|
| 349 | pb_apply_conf_proxy($pbos);
|
|---|
| 350 | pb_log(1, "ftp_proxy=$ENV{ftp_proxy}\n") if (defined $ENV{ftp_proxy});
|
|---|
| 351 | pb_log(1, "http_proxy=$ENV{http_proxy}\n") if (defined $ENV{http_proxy});
|
|---|
| 352 |
|
|---|
| 353 | # Get dependencies in the build file if not forced
|
|---|
| 354 | $deps = pb_distro_getdeps($f,$pbos, $forcerepo) if ((not defined $deps) || (defined $forcerepo));
|
|---|
| 355 | pb_log(2,"deps: $deps\n");
|
|---|
| 356 | return if ((not defined $deps) || ($deps =~ /^\s*$/));
|
|---|
| 357 |
|
|---|
| 358 | # This may not be // proof. We should test for availability of repo and sleep if not
|
|---|
| 359 | my $cmd = "$pbos->{'install'} $deps";
|
|---|
| 360 | my $ret = pb_system($cmd, "Installing dependencies ($cmd)","mayfail");
|
|---|
| 361 | # Try to accomodate deficient proxies
|
|---|
| 362 | if ($ret != 0) {
|
|---|
| 363 | pb_system($cmd, "Re-trying installing dependencies ($cmd)");
|
|---|
| 364 | }
|
|---|
| 365 | # Check that all deps have been installed correctly
|
|---|
| 366 | # This time we don't forcerepo to avoid getting a list as a return as we have
|
|---|
| 367 | # already forced it previously, and this time we just want to check
|
|---|
| 368 | $deps = pb_distro_getdeps($f, $pbos, undef);
|
|---|
| 369 | confess "Some dependencies did not install ($deps)" if ((defined $deps) && ($deps =~ /\S/) && ($Global::pb_stop_on_error));
|
|---|
| 370 | }
|
|---|
| 371 |
|
|---|
| 372 | =item B<pb_distro_getdeps>
|
|---|
| 373 |
|
|---|
| 374 | This function computes the dependencies indicated in the build file and return them as a string of packages to install
|
|---|
| 375 |
|
|---|
| 376 | =cut
|
|---|
| 377 |
|
|---|
| 378 | sub pb_distro_getdeps {
|
|---|
| 379 |
|
|---|
| 380 | my $f = shift;
|
|---|
| 381 | my $pbos = shift;
|
|---|
| 382 | my $forcerepo = shift;
|
|---|
| 383 |
|
|---|
| 384 | my $regexp = "";
|
|---|
| 385 | my $deps = "";
|
|---|
| 386 | my $sep = $/;
|
|---|
| 387 |
|
|---|
| 388 | # Protection
|
|---|
| 389 | return("") if (not defined $pbos->{'type'});
|
|---|
| 390 | return("") if (not defined $f);
|
|---|
| 391 |
|
|---|
| 392 | pb_log(3,"entering pb_distro_getdeps: $pbos->{'type'} - $f\n");
|
|---|
| 393 | if ($pbos->{'type'} eq "rpm") {
|
|---|
| 394 | # In RPM this could include files, but we do not handle them atm.
|
|---|
| 395 | $regexp = '^BuildRequires:(.*)$';
|
|---|
| 396 | } elsif ($pbos->{'type'} eq "deb") {
|
|---|
| 397 | $regexp = '^Build-Depends:(.*)$';
|
|---|
| 398 | } elsif ($pbos->{'type'} eq "ebuild") {
|
|---|
| 399 | $sep = '"'.$/;
|
|---|
| 400 | $regexp = '^DEPEND="(.*)"\n'
|
|---|
| 401 | } else {
|
|---|
| 402 | # No idea
|
|---|
| 403 | return("");
|
|---|
| 404 | }
|
|---|
| 405 | pb_log(2,"regexp: $regexp\n");
|
|---|
| 406 |
|
|---|
| 407 | # Preserve separator before using the one we need
|
|---|
| 408 | my $oldsep = $/;
|
|---|
| 409 | $/ = $sep;
|
|---|
| 410 | open(DESC,"$f") || confess "Unable to open $f";
|
|---|
| 411 | while (<DESC>) {
|
|---|
| 412 | pb_log(4,"read: $_\n");
|
|---|
| 413 | next if (! /$regexp/);
|
|---|
| 414 | chomp();
|
|---|
| 415 |
|
|---|
| 416 | my $nextline;
|
|---|
| 417 | # Support multi-lines deps for .deb
|
|---|
| 418 | if ($pbos->{type} eq 'deb') {
|
|---|
| 419 | while ($nextline = <DESC>) {
|
|---|
| 420 | last unless $nextline =~ /^\s+(.+)$/o;
|
|---|
| 421 | $_ .= $1;
|
|---|
| 422 | }
|
|---|
| 423 | }
|
|---|
| 424 |
|
|---|
| 425 | # What we found with the regexp is the list of deps.
|
|---|
| 426 | pb_log(2,"found deps: $_\n");
|
|---|
| 427 | s/$regexp/$1/i;
|
|---|
| 428 | pb_log(4,"found deps 1: $_\n");
|
|---|
| 429 | # Remove conditions in the middle and at the end for deb
|
|---|
| 430 | s/\([><=]+[^,]*,/,/g;
|
|---|
| 431 | pb_log(4,"found deps 2: $_\n");
|
|---|
| 432 | s/\([><=]+[^,]*$//g;
|
|---|
| 433 | pb_log(4,"found deps 3: $_\n");
|
|---|
| 434 | # Same for rpm
|
|---|
| 435 | s/[><=]+[^,]*,/,/g;
|
|---|
| 436 | pb_log(4,"found deps 4: $_\n");
|
|---|
| 437 | s/[><=]+.*$//g;
|
|---|
| 438 | pb_log(4,"found deps 5: $_\n");
|
|---|
| 439 | # Improve string format (remove , and spaces at start, end and in double
|
|---|
| 440 | s/,/ /g;
|
|---|
| 441 | pb_log(4,"found deps 6: $_\n");
|
|---|
| 442 | s/^\s*//;
|
|---|
| 443 | pb_log(4,"found deps 7: $_\n");
|
|---|
| 444 | # $ here removes the \n
|
|---|
| 445 | s/\s*$//;
|
|---|
| 446 | pb_log(4,"found deps 8: $_\n");
|
|---|
| 447 | s/\s+/ /g;
|
|---|
| 448 | pb_log(4,"found deps 9: $_\n");
|
|---|
| 449 | $deps .= " ".$_;
|
|---|
| 450 | pb_log(4,"found deps end: $deps\n");
|
|---|
| 451 |
|
|---|
| 452 | # Support multi-lines deps for .deb (fwup)
|
|---|
| 453 | if (defined $nextline) {
|
|---|
| 454 | $_ = $nextline;
|
|---|
| 455 | redo;
|
|---|
| 456 | }
|
|---|
| 457 | }
|
|---|
| 458 | close(DESC);
|
|---|
| 459 | $/ = $oldsep;
|
|---|
| 460 | pb_log(2,"now deps: $deps\n");
|
|---|
| 461 | if (defined $forcerepo) {
|
|---|
| 462 | # We want to force installation of all pkgs
|
|---|
| 463 | # because a repo was setup in between, which may contains updated versions
|
|---|
| 464 | pb_log(0,"Forcing installation of all packages due to previous repo setup\n");
|
|---|
| 465 | return($deps);
|
|---|
| 466 | } else {
|
|---|
| 467 | pb_log(0,"Installation of only necessary packages\n");
|
|---|
| 468 | my $deps2 = pb_distro_only_deps_needed($pbos,$deps);
|
|---|
| 469 | return($deps2);
|
|---|
| 470 | }
|
|---|
| 471 | }
|
|---|
| 472 |
|
|---|
| 473 |
|
|---|
| 474 | =item B<pb_distro_only_deps_needed>
|
|---|
| 475 |
|
|---|
| 476 | This function returns only the dependencies not yet installed
|
|---|
| 477 |
|
|---|
| 478 | =cut
|
|---|
| 479 |
|
|---|
| 480 | sub pb_distro_only_deps_needed {
|
|---|
| 481 |
|
|---|
| 482 | my $pbos = shift;
|
|---|
| 483 | my $deps = shift;
|
|---|
| 484 |
|
|---|
| 485 | return("") if ((not defined $deps) || ($deps =~ /^\s*$/));
|
|---|
| 486 | my $deps2 = "";
|
|---|
| 487 | # Avoid to install what is already there
|
|---|
| 488 | delete $ENV{COLUMNS};
|
|---|
| 489 | foreach my $p (split(/\s+/,$deps)) {
|
|---|
| 490 | next if $p =~ /^\s*$/o;
|
|---|
| 491 | if ($pbos->{'type'} eq "rpm") {
|
|---|
| 492 | my $rpmcmd = "rpm -q --whatprovides --quiet";
|
|---|
| 493 | # whatprovides doesn't work for RH6.2
|
|---|
| 494 | $rpmcmd = "rpm -q --quiet" if (($pbos->{'name'} eq "redhat") && ($pbos->{'version'} =~ /6/));
|
|---|
| 495 | my $res = pb_system("$rpmcmd $p","Looking for $p","mayfail");
|
|---|
| 496 | next if ($res eq 0);
|
|---|
| 497 | pb_log(1, "INFO: missing dependency $p\n");
|
|---|
| 498 | } elsif ($pbos->{'type'} eq "deb") {
|
|---|
| 499 | my $res = pb_system("dpkg -L $p","Looking for $p","mayfail");
|
|---|
| 500 | next if ($res eq 0);
|
|---|
| 501 | open(CMD,"dpkg -l $p |") or confess "Unable to run dpkg -l $p: $!";
|
|---|
| 502 | my $ok = 0;
|
|---|
| 503 | while (<CMD>) {
|
|---|
| 504 | $ok = 1 if /^ii\s+$p/;
|
|---|
| 505 | }
|
|---|
| 506 | close(CMD);
|
|---|
| 507 | next if $ok;
|
|---|
| 508 | pb_log(1, "INFO: missing dependency $p\n");
|
|---|
| 509 | } elsif ($pbos->{'type'} eq "ebuild") {
|
|---|
| 510 | } else {
|
|---|
| 511 | # Not reached
|
|---|
| 512 | }
|
|---|
| 513 | pb_log(2,"found deps2: $p\n");
|
|---|
| 514 | $deps2 .= " $p";
|
|---|
| 515 | }
|
|---|
| 516 |
|
|---|
| 517 | $deps2 =~ s/^\s*//;
|
|---|
| 518 | pb_log(2,"now deps2: $deps2\n");
|
|---|
| 519 | return($deps2);
|
|---|
| 520 | }
|
|---|
| 521 |
|
|---|
| 522 | =item B<pb_distro_setuposrepo>
|
|---|
| 523 |
|
|---|
| 524 | This function sets up potential additional repository for the setup phase
|
|---|
| 525 |
|
|---|
| 526 | =cut
|
|---|
| 527 |
|
|---|
| 528 | sub pb_distro_setuposrepo {
|
|---|
| 529 |
|
|---|
| 530 | my $pbos = shift;
|
|---|
| 531 |
|
|---|
| 532 | return(pb_distro_setuprepo_gen_conf($pbos,pb_distro_conffile(),"osrepo"));
|
|---|
| 533 | }
|
|---|
| 534 |
|
|---|
| 535 | =item B<pb_distro_setuprepo>
|
|---|
| 536 |
|
|---|
| 537 | This function sets up potential additional repository to the build environment
|
|---|
| 538 |
|
|---|
| 539 | =cut
|
|---|
| 540 |
|
|---|
| 541 | sub pb_distro_setuprepo {
|
|---|
| 542 |
|
|---|
| 543 | my $pbos = shift;
|
|---|
| 544 |
|
|---|
| 545 | return(pb_distro_setuprepo_gen_conf($pbos,"$ENV{'PBDESTDIR'}/pbrc","addrepo"));
|
|---|
| 546 | }
|
|---|
| 547 |
|
|---|
| 548 | # Internal
|
|---|
| 549 | sub pb_distro_compare_repo {
|
|---|
| 550 |
|
|---|
| 551 | my $src = shift;
|
|---|
| 552 | my $dest = shift;
|
|---|
| 553 |
|
|---|
| 554 | if (not -f $dest) {
|
|---|
| 555 | pb_log(1, "INFO: Creating new file $dest\n");
|
|---|
| 556 | } elsif (-f $dest && -s $dest == 0) {
|
|---|
| 557 | pb_log(1, "INFO: Overwriting empty file $dest\n");
|
|---|
| 558 | } elsif (-f $dest && compare("$src", $dest) == 0) {
|
|---|
| 559 | pb_log(1, "INFO: Overwriting identical file $dest\n");
|
|---|
| 560 | } else {
|
|---|
| 561 | pb_log(0, "ERROR: destination file $dest exists and is different than source $src\n");
|
|---|
| 562 | pb_system("cat $dest","INFO: Dest...\n");
|
|---|
| 563 | pb_system("cat $src","INFO: New...\n");
|
|---|
| 564 | pb_log("INFO: Returning...\n");
|
|---|
| 565 | return(1);
|
|---|
| 566 | }
|
|---|
| 567 | return(0);
|
|---|
| 568 | }
|
|---|
| 569 |
|
|---|
| 570 | =item B<pb_distro_setuprepo_gen_conf>
|
|---|
| 571 |
|
|---|
| 572 | This function sets up in a generic way potential additional repository using conf files
|
|---|
| 573 |
|
|---|
| 574 | =cut
|
|---|
| 575 |
|
|---|
| 576 | sub pb_distro_setuprepo_gen_conf {
|
|---|
| 577 |
|
|---|
| 578 | my $pbos = shift;
|
|---|
| 579 | my $pbconf = shift;
|
|---|
| 580 | my $pbkey = shift;
|
|---|
| 581 |
|
|---|
| 582 | return undef if (not defined $pbconf);
|
|---|
| 583 | return undef if (not defined $pbkey);
|
|---|
| 584 | my ($addrepo) = pb_conf_read($pbconf,$pbkey);
|
|---|
| 585 | return undef if (not defined $addrepo);
|
|---|
| 586 |
|
|---|
| 587 | my $param = pb_distro_get_param($pbos,$addrepo);
|
|---|
| 588 | return undef if ($param eq "");
|
|---|
| 589 |
|
|---|
| 590 | return(pb_distro_setuprepo_gen($pbos,$param));
|
|---|
| 591 | }
|
|---|
| 592 |
|
|---|
| 593 |
|
|---|
| 594 | =item B<pb_distro_setuprepo_gen>
|
|---|
| 595 |
|
|---|
| 596 | This function sets up in a generic way potential additional repository passed as a param
|
|---|
| 597 |
|
|---|
| 598 | =cut
|
|---|
| 599 |
|
|---|
| 600 | sub pb_distro_setuprepo_gen {
|
|---|
| 601 |
|
|---|
| 602 | my $pbos = shift;
|
|---|
| 603 | my $param = shift;
|
|---|
| 604 |
|
|---|
| 605 | return if (not defined $param);
|
|---|
| 606 |
|
|---|
| 607 | pb_apply_conf_proxy($pbos);
|
|---|
| 608 |
|
|---|
| 609 | # Loop on the list of additional repo
|
|---|
| 610 | foreach my $i (split(/,/,$param)) {
|
|---|
| 611 |
|
|---|
| 612 | pb_log(1,"Adding repository defined by $i\n");
|
|---|
| 613 | my ($scheme, $account, $host, $port, $path) = pb_get_uri($i);
|
|---|
| 614 | my $bn = basename($i);
|
|---|
| 615 |
|
|---|
| 616 | # The repo file can be local or remote. download or copy at the right place
|
|---|
| 617 | if (($scheme eq "ftp") || ($scheme =~ /http/)) {
|
|---|
| 618 | pb_system("wget -O $ENV{'PBTMP'}/$bn $i","Downloading additional repository file $i");
|
|---|
| 619 | } else {
|
|---|
| 620 | copy($i,"$ENV{'PBTMP'}/$bn");
|
|---|
| 621 | }
|
|---|
| 622 |
|
|---|
| 623 | # The repo file can be a real file or a package
|
|---|
| 624 | if ($pbos->{'type'} eq "rpm") {
|
|---|
| 625 | if ($bn =~ /\.rpm$/) {
|
|---|
| 626 | my $pn = $bn;
|
|---|
| 627 | $pn =~ s/\.rpm//;
|
|---|
| 628 | if (pb_system("rpm -q --quiet $pn","","mayfail") != 0) {
|
|---|
| 629 | pb_system("sudo rpm -Uvh $ENV{'PBTMP'}/$bn","Adding package $bn to setup repository");
|
|---|
| 630 | }
|
|---|
| 631 | } elsif ($bn =~ /\.repo$/) {
|
|---|
| 632 | my $dirdest = "";
|
|---|
| 633 | my $reponame = "";
|
|---|
| 634 | # TODO: could go in pb.conf in fact
|
|---|
| 635 | if ($pbos->{install} =~ /\byum\b/) {
|
|---|
| 636 | $reponame="yum";
|
|---|
| 637 | $dirdest = "/etc/yum.repos.d";
|
|---|
| 638 | } elsif ($pbos->{install} =~ /\bdnf\b/) {
|
|---|
| 639 | $reponame="dnf";
|
|---|
| 640 | $dirdest = "/etc/yum.repos.d";
|
|---|
| 641 | } elsif ($pbos->{install} =~ /\bzypper\b/) {
|
|---|
| 642 | $reponame="zypper";
|
|---|
| 643 | $dirdest = "/etc/zypp/repos.d";
|
|---|
| 644 | } else {
|
|---|
| 645 | confess "Unknown location for repository file for '$pbos->{install}' command";
|
|---|
| 646 | }
|
|---|
| 647 | my $dest = "$dirdest/$bn";
|
|---|
| 648 | return undef if (pb_distro_compare_repo("$ENV{'PBTMP'}/$bn",$dest) == 1);
|
|---|
| 649 | confess "Missing directory $dirdest ($reponame)" unless (-d $dirdest);
|
|---|
| 650 | pb_system("sudo mv $ENV{'PBTMP'}/$bn $dest","Adding $reponame repository") if (not -f "$dest");
|
|---|
| 651 | # OpenSUSE does't seem to import keys automatically
|
|---|
| 652 | # :-(
|
|---|
| 653 | if ($pbos->{install} =~ /\bzypper\b/) {
|
|---|
| 654 | my $keyfile = undef;
|
|---|
| 655 | open(REPO,"$dest") || confess "Unable to open $dest";
|
|---|
| 656 | while (<REPO>) {
|
|---|
| 657 | $keyfile = $_;
|
|---|
| 658 | if ($keyfile =~ /^gpgkey=/) {
|
|---|
| 659 | $keyfile =~ s/gpgkey=//;
|
|---|
| 660 | last;
|
|---|
| 661 | }
|
|---|
| 662 | }
|
|---|
| 663 | close(REPO);
|
|---|
| 664 | if (defined $keyfile) {
|
|---|
| 665 | pb_system("wget -O $ENV{'PBTMP'}/$bn $keyfile","Downloading GPG key file $keyfile");
|
|---|
| 666 | pb_system("sudo rpm --import $ENV{'PBTMP'}/$bn","Importing GPG key file $keyfile");
|
|---|
| 667 | unlink("$ENV{'PBTMP'}/$bn");
|
|---|
| 668 | }
|
|---|
| 669 | }
|
|---|
| 670 | } elsif ($bn =~ /\.addmedia/) {
|
|---|
| 671 | # URPMI repo
|
|---|
| 672 | # We should test that it's not already a urpmi repo
|
|---|
| 673 | pb_system("chmod 755 $ENV{'PBTMP'}/$bn ; sudo $ENV{'PBTMP'}/$bn 2>&1 > /dev/null","Adding urpmi repository");
|
|---|
| 674 | } else {
|
|---|
| 675 | pb_log(0,"ERROR: Unable to deal with repository file $i on rpm distro ! Please report to dev team\n");
|
|---|
| 676 | }
|
|---|
| 677 | } elsif ($pbos->{'type'} eq "deb") {
|
|---|
| 678 | if ($bn =~ /\.sources.list$/) {
|
|---|
| 679 | my $dest = "/etc/apt/sources.list.d/$bn";
|
|---|
| 680 | return if (pb_distro_compare_repo("$ENV{'PBTMP'}/$bn",$dest) == 1);
|
|---|
| 681 | pb_system("sudo mv $ENV{'PBTMP'}/$bn $dest","Adding apt repository $dest");
|
|---|
| 682 | # Check whether GPG keys for this repo are already known and if
|
|---|
| 683 | # not add them
|
|---|
| 684 | open(REPO,"$dest") || confess "Unable to open $dest";
|
|---|
| 685 | my $debrepo;
|
|---|
| 686 | while (<REPO>) {
|
|---|
| 687 | if (/^deb\s/) {
|
|---|
| 688 | $debrepo = $_;
|
|---|
| 689 | chomp($debrepo);
|
|---|
| 690 | $debrepo =~ s|^deb ([^\s]+)\s([^\s]+)\s([^\s]+)|$1/dists/$2|;
|
|---|
| 691 | last;
|
|---|
| 692 | }
|
|---|
| 693 | }
|
|---|
| 694 | close(REPO);
|
|---|
| 695 | return if (not defined $debrepo);
|
|---|
| 696 |
|
|---|
| 697 | pb_system("wget -O $ENV{'PBTMP'}/Release $debrepo/Release","Downloading $debrepo/Release");
|
|---|
| 698 | pb_system("wget -O $ENV{'PBTMP'}/Release.gpg $debrepo/Release.gpg","Downloading $debrepo/Release.gpg");
|
|---|
| 699 | my $signature;
|
|---|
| 700 | open(SIGN,"LANGUAGE=C LANG=C gpg --verify $ENV{'PBTMP'}/Release.gpg $ENV{'PBTMP'}/Release 2>&1 |") || confess "Unable to verify GPG signature from Release.gpg\n";
|
|---|
| 701 | while(<SIGN>) {
|
|---|
| 702 | chomp();
|
|---|
| 703 | if (/^gpg: .*key ID/) {
|
|---|
| 704 | $signature = $_;
|
|---|
| 705 | $signature =~ s/^gpg: .*key ID ([A-Z0-9]+)/$1/;
|
|---|
| 706 | #TODO: create a pbkeyserver conf var for that
|
|---|
| 707 | pb_system("gpg --recv-keys --keyserver hkp://pgp.mit.edu $signature","Importing GPG signature for $signature");
|
|---|
| 708 | $signature = undef;
|
|---|
| 709 | last;
|
|---|
| 710 | }
|
|---|
| 711 | }
|
|---|
| 712 | close(SIGN);
|
|---|
| 713 | open(SIGN,"LANGUAGE=C LANG=C gpg --verify $ENV{'PBTMP'}/Release.gpg $ENV{'PBTMP'}/Release 2>&1 |") || confess "Unable to verify GPG signature from $debrepo/Release.gpg\n";
|
|---|
| 714 | while(<SIGN>) {
|
|---|
| 715 | chomp();
|
|---|
| 716 | if (/^gpg: Good signature/) {
|
|---|
| 717 | $signature = $_;
|
|---|
| 718 | $signature =~ s/^gpg: Good signature from "([^\"]+)"/$1/;
|
|---|
| 719 | }
|
|---|
| 720 | }
|
|---|
| 721 | close(SIGN);
|
|---|
| 722 |
|
|---|
| 723 | return if (not defined $signature);
|
|---|
| 724 | pb_log(3, "GnuPG repo verify returned: $signature\n");
|
|---|
| 725 | unlink("$ENV{'PBTMP'}/apt.sig");
|
|---|
| 726 | pb_system("gpg -a --export -o $ENV{'PBTMP'}/apt.sig \'$signature\'","Exporting GnuPG signature of $signature");
|
|---|
| 727 | pb_system("sudo apt-key add $ENV{'PBTMP'}/apt.sig","Adding GnuPG signature of $signature to APT key ring");
|
|---|
| 728 | pb_system("sudo apt-get update","Updating apt repository");
|
|---|
| 729 | } else {
|
|---|
| 730 | pb_log(0,"ERROR: Unable to deal with repository file $i on deb distro ! Please report to dev team\n");
|
|---|
| 731 | }
|
|---|
| 732 | } else {
|
|---|
| 733 | pb_log(0,"ERROR: Unable to deal with repository file $i on that distro ! Please report to dev team\n");
|
|---|
| 734 | }
|
|---|
| 735 | }
|
|---|
| 736 | return("forcerepo");
|
|---|
| 737 | }
|
|---|
| 738 |
|
|---|
| 739 | =item B<pb_distro_to_keylist>
|
|---|
| 740 |
|
|---|
| 741 | Given a pbos object (first param) and the generic key (second param), get the list of possible keys for looking up variable for
|
|---|
| 742 | filter names. The list will be sorted most-specific to least specific.
|
|---|
| 743 |
|
|---|
| 744 | =cut
|
|---|
| 745 |
|
|---|
| 746 | sub pb_distro_to_keylist ($$) {
|
|---|
| 747 |
|
|---|
| 748 | my ($pbos, $generic) = @_;
|
|---|
| 749 |
|
|---|
| 750 | foreach my $key (qw/name version arch family type os/) {
|
|---|
| 751 | confess "missing pbos key $key" unless (defined $pbos->{$key});
|
|---|
| 752 | }
|
|---|
| 753 |
|
|---|
| 754 | my @keylist = ("$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}", "$pbos->{'name'}-$pbos->{'version'}");
|
|---|
| 755 |
|
|---|
| 756 | # Loop to include also previous minor versions
|
|---|
| 757 | # if configured so
|
|---|
| 758 | if ((defined $pbos->{'useminor'}) && ($pbos->{'useminor'} eq "true") && ($pbos->{'version'} =~ /^(\d+)\.(\d+)$/o)) {
|
|---|
| 759 | my ($major, $minor) = ($1, $2);
|
|---|
| 760 | while ($minor > 0) {
|
|---|
| 761 | $minor--;
|
|---|
| 762 | push (@keylist, "$pbos->{'name'}-${major}.$minor");
|
|---|
| 763 | }
|
|---|
| 764 | push (@keylist, "$pbos->{'name'}-$major");
|
|---|
| 765 | }
|
|---|
| 766 |
|
|---|
| 767 | push (@keylist, $pbos->{'name'}, $pbos->{'family'}, $pbos->{'type'}, $pbos->{'os'}, $generic);
|
|---|
| 768 | return @keylist;
|
|---|
| 769 | }
|
|---|
| 770 |
|
|---|
| 771 | =item B<pb_distro_get_param>
|
|---|
| 772 |
|
|---|
| 773 | This function gets the parameter in the conf file from the most precise tuple up to default
|
|---|
| 774 |
|
|---|
| 775 | =cut
|
|---|
| 776 |
|
|---|
| 777 | sub pb_distro_get_param {
|
|---|
| 778 |
|
|---|
| 779 | my @param = ();
|
|---|
| 780 | my $pbos = shift;
|
|---|
| 781 |
|
|---|
| 782 | my @keylist = pb_distro_to_keylist($pbos,"default");
|
|---|
| 783 | pb_log(2,"DEBUG: pb_distro_get_param on $pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'} for ".Dumper(@_)."\n");
|
|---|
| 784 | foreach my $opt (@_) {
|
|---|
| 785 | my $param = "";
|
|---|
| 786 | foreach my $key (@keylist) {
|
|---|
| 787 | if (defined $opt->{$key}) {
|
|---|
| 788 | $param = $opt->{$key};
|
|---|
| 789 | last;
|
|---|
| 790 | }
|
|---|
| 791 | }
|
|---|
| 792 | # Allow replacement of variables inside the parameter such as name, version, arch for rpmbootstrap
|
|---|
| 793 | # but not shell variable which are backslashed
|
|---|
| 794 | if ($param =~ /[^\\]\$/) {
|
|---|
| 795 | pb_log(3,"Expanding variable on $param\n");
|
|---|
| 796 | eval { $param =~ s/(\$\w+->\{\'\w+\'\})/$1/eeg };
|
|---|
| 797 | }
|
|---|
| 798 | push @param,$param;
|
|---|
| 799 | }
|
|---|
| 800 |
|
|---|
| 801 | pb_log(2,"DEBUG: pb_distro_get_param on $pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'} returns ==".Dumper(@param)."==\n");
|
|---|
| 802 |
|
|---|
| 803 | # Return one param if user only asked for one lookup, an array if not.
|
|---|
| 804 | my $nb = @param;
|
|---|
| 805 | if ($nb eq 1) {
|
|---|
| 806 | return($param[0]);
|
|---|
| 807 | } else {
|
|---|
| 808 | return(@param);
|
|---|
| 809 | }
|
|---|
| 810 | }
|
|---|
| 811 |
|
|---|
| 812 | =item B<pb_distro_get_context>
|
|---|
| 813 |
|
|---|
| 814 | This function gets the OS context passed as parameter and return the corresponding distribution hash
|
|---|
| 815 | If passed undef or "" then auto-detects
|
|---|
| 816 |
|
|---|
| 817 | =cut
|
|---|
| 818 |
|
|---|
| 819 |
|
|---|
| 820 | sub pb_distro_get_context {
|
|---|
| 821 |
|
|---|
| 822 | my $os = shift;
|
|---|
| 823 | my $pbos;
|
|---|
| 824 |
|
|---|
| 825 | if ((defined $os) && ($os ne "")) {
|
|---|
| 826 | my ($name,$ver,$darch) = split(/-/,$os);
|
|---|
| 827 | pb_log(0,"Bad format for $os") if ((not defined $name) || (not defined $ver) || (not defined $darch)) ;
|
|---|
| 828 | chomp($darch);
|
|---|
| 829 | $pbos = pb_distro_init($name,$ver,$darch);
|
|---|
| 830 | } else {
|
|---|
| 831 | $pbos = pb_distro_init();
|
|---|
| 832 | }
|
|---|
| 833 | return($pbos);
|
|---|
| 834 | }
|
|---|
| 835 |
|
|---|
| 836 | =item B<pb_distro_conf_print>
|
|---|
| 837 |
|
|---|
| 838 | This 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.
|
|---|
| 839 |
|
|---|
| 840 | =cut
|
|---|
| 841 |
|
|---|
| 842 | sub pb_distro_conf_print {
|
|---|
| 843 |
|
|---|
| 844 | my $pbos = shift;
|
|---|
| 845 | my @keys = @_;
|
|---|
| 846 |
|
|---|
| 847 | if ($#keys == -1) {
|
|---|
| 848 | pb_log(0,"Full pb configuration for project $ENV{'PBPROJ'}\n");
|
|---|
| 849 | pb_log(0,"================================================\n");
|
|---|
| 850 | @keys = pb_conf_get_all();
|
|---|
| 851 | }
|
|---|
| 852 | if (defined $ENV{'PBV'}) {
|
|---|
| 853 | pb_log(1,"Distribution $ENV{'PBV'}\n");
|
|---|
| 854 | pb_log(1,"========================\n");
|
|---|
| 855 | } else {
|
|---|
| 856 | pb_log(1,"Local Distribution\n");
|
|---|
| 857 | pb_log(1,"==================\n");
|
|---|
| 858 | }
|
|---|
| 859 |
|
|---|
| 860 | my %rep;
|
|---|
| 861 | my $i = 0;
|
|---|
| 862 | # Index on distro
|
|---|
| 863 | foreach my $r (pb_distro_get_param($pbos,pb_conf_get(@keys))) {
|
|---|
| 864 | $rep{$keys[$i]} = $r if (defined $keys[$i]);
|
|---|
| 865 | $i++;
|
|---|
| 866 | }
|
|---|
| 867 | $i = 0;
|
|---|
| 868 | # Then Index on prj to overwrite previous value if needed
|
|---|
| 869 | foreach my $r (pb_conf_get(@keys)) {
|
|---|
| 870 | $rep{$keys[$i]} = $r->{'default'} if (defined $r->{'default'});
|
|---|
| 871 | $rep{$keys[$i]} = $r->{$ENV{'PBPROJ'}} if (defined $r->{$ENV{'PBPROJ'}});
|
|---|
| 872 | $i++;
|
|---|
| 873 | }
|
|---|
| 874 | foreach my $r (keys %rep) {
|
|---|
| 875 | pb_log(1, "$r => ");
|
|---|
| 876 | pb_log(0, "$rep{$r}\n");
|
|---|
| 877 | }
|
|---|
| 878 | }
|
|---|
| 879 |
|
|---|
| 880 |
|
|---|
| 881 | =back
|
|---|
| 882 |
|
|---|
| 883 | =head1 WEB SITES
|
|---|
| 884 |
|
|---|
| 885 | The 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/>.
|
|---|
| 886 |
|
|---|
| 887 | =head1 USER MAILING LIST
|
|---|
| 888 |
|
|---|
| 889 | None exists for the moment.
|
|---|
| 890 |
|
|---|
| 891 | =head1 AUTHORS
|
|---|
| 892 |
|
|---|
| 893 | The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
|
|---|
| 894 |
|
|---|
| 895 | =head1 COPYRIGHT
|
|---|
| 896 |
|
|---|
| 897 | Project-Builder.org is distributed under the GPL v2.0 license
|
|---|
| 898 | described in the file C<COPYING> included with the distribution.
|
|---|
| 899 |
|
|---|
| 900 | =cut
|
|---|
| 901 |
|
|---|
| 902 |
|
|---|
| 903 | 1;
|
|---|
