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

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

Try to better organize the tree to be perl compliant

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