source: ProjectBuilder/devel/pb/lib/ProjectBuilder/Distribution.pm@ 108

Last change on this file since 108 was 108, checked in by Bruno Cornec, 17 years ago

Lots of changes to prepare the dev of the VMs support.
No more global variables
Support $ENV{'HOME'} in pbrc for pbrc keyword (allows portability across accounts and share of .pbrc)
Fixes on pb_cms_export for SVN in order to be called externally
pn_env_init retunrs now a lot of params in a list
pb_get_pkg needs params and is simplified by consequence
pbinit is called with a simple system. pb_system has isues with cascading stdout/stderr redirections
pb_send2ssh now supports sending to VM + launch of a pbscript if it exists and it should bring back packages from VM in the future and it now supports more parameters.

  • 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 pb_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) = pb_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 pb_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=pb_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=pb_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
223# get content of a file in a variable
224sub pb_get_content {
225
226my $file=shift;
227
228my $bkp = $/;
229undef $/;
230open(R,$file) || die "Unable to open $file: $!";
231my $content=<R>;
232close(R);
233chomp($content);
234$/ = $bkp;
235return($content);
236}
2371;
Note: See TracBrowser for help on using the repository browser.