#!/usr/bin/env perl
#-*- Mode: perl; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*-
# Determine the platform we're running on.
#
# Copyright (C) 2000-2001 Ximian, Inc.
#
# Authors: Arturo Espinosa <arturo@ximian.com>
# Hans Petter Jansson <hpj@ximian.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU Library General Public License as published
# by the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
package Utils::Platform;
use Utils::Parse;
use Utils::Backend;
use Utils::File;
use Utils::Replace;
# --- System guessing --- #
my $PLATFORM_INFO = {
"debian-3.0" => [ "Debian GNU/Linux", "3.0", "Woody" ],
"debian-3.1" => [ "Debian GNU/Linux", "3.1", "Sarge" ],
"ubuntu-5.04" => [ "Ubuntu Linux", "5.04", "Hoary" ],
"ubuntu-5.10" => [ "Ubuntu Linux", "5.10", "Breezy" ],
"ubuntu-6.06" => [ "Ubuntu Linux", "6.06", "Dapper" ],
"ubuntu-6.10" => [ "Ubuntu Linux", "6.10", "Edgy" ],
"ubuntu-7.04" => [ "Ubuntu Linux", "7.04", "Feisty" ],
"ubuntu-7.10" => [ "Ubuntu Linux", "7.10", "Gutsy" ],
"redhat-5.2" => [ "Red Hat Linux", "5.2", "Apollo" ],
"redhat-6.0" => [ "Red Hat Linux", "6.0", "Hedwig" ],
"redhat-6.1" => [ "Red Hat Linux", "6.1", "Cartman" ],
"redhat-6.2" => [ "Red Hat Linux", "6.2", "Zoot" ],
"redhat-7.0" => [ "Red Hat Linux", "7.0", "Guinness" ],
"redhat-7.1" => [ "Red Hat Linux", "7.1", "Seawolf" ],
"redhat-7.2" => [ "Red Hat Linux", "7.2", "Enigma" ],
"redhat-7.3" => [ "Red Hat Linux", "7.3", "Valhalla" ],
"redhat-8.0" => [ "Red Hat Linux", "8.0", "Psyche" ],
"redhat-9" => [ "Red Hat Linux", "9.0", "Shrike" ],
"openna-1.0" => [ "OpenNA Linux", "1.0", "VSLC" ],
"mandrake-7.1" => [ "Linux Mandrake", "7.1" ],
"mandrake-7.2" => [ "Linux Mandrake", "7.2", "Odyssey" ],
"mandrake-8.0" => [ "Linux Mandrake", "8.0", "Traktopel" ],
"mandrake-9.0" => [ "Linux Mandrake", "9.0", "Dolphin" ],
"mandrake-9.1" => [ "Linux Mandrake", "9.1", "Bamboo" ],
"mandrake-9.2" => [ "Linux Mandrake", "9.2", "FiveStar" ],
"mandrake-10.0" => [ "Linux Mandrake", "10.0" ],
"mandrake-10.1" => [ "Linux Mandrake", "10.1" ],
"mandrake-10.2" => [ "Linux Mandrake", "2005" ],
"mandriva-2006.0" => [ "Mandriva Linux", "2006.0" ],
"mandriva-2006.1" => [ "Mandriva Linux", "2006.1" ],
"yoper-2.2" => [ "Yoper Linux", "2.2" ],
"blackpanther-4.0" => [ "Black Panther OS", "4.0", "" ],
"conectiva-9" => [ "Conectiva Linux", "9", "" ],
"conectiva-10" => [ "Conectiva Linux", "10", "" ],
"suse-9.0" => [ "SuSE Linux", "9.0", "" ],
"suse-9.1" => [ "SuSE Linux", "9.1", "" ],
"slackware-9.1.0" => [ "Slackware", "9.1.0", "" ],
"slackware-10.0.0" => [ "Slackware", "10.0.0", "" ],
"slackware-10.1.0" => [ "Slackware", "10.1.0", "" ],
"slackware-10.2.0" => [ "Slackware", "10.2.0", "" ],
"slackware-11.0.0" => [ "Slackware", "11.0.0", "" ],
"slackware-12.0.0" => [ "Slackware", "12.0.0", "" ],
"bluewhite64-12.0.0" => [ "Bluewhite64", "12.0.0", "" ],
"freebsd-4" => [ "FreeBSD", "4", "" ],
"freebsd-5" => [ "FreeBSD", "5", "" ],
"freebsd-6" => [ "FreeBSD", "6", "" ],
"freebsd-7" => [ "FreeBSD", "7", "" ],
"gentoo" => [ "Gentoo Linux", "", "" ],
"vlos-1.2" => [ "Vida Linux OS", "1.2" ],
"archlinux" => [ "Arch Linux", "", "" ],
"pld-1.0" => [ "PLD", "1.0", "Ra" ],
"pld-1.1" => [ "PLD", "1.1", "Ra" ],
"pld-1.99" => [ "PLD", "1.99", "Ac-pre" ],
"pld-2.99" => [ "PLD", "1.99", "Th-pre" ],
"vine-3.0" => [ "Vine Linux", "3.0", "" ],
"vine-3.1" => [ "Vine Linux", "3.1", "" ],
"fedora-1" => [ "Fedora Core", "1", "Yarrow" ],
"fedora-2" => [ "Fedora Core", "2", "Tettnang" ],
"fedora-3" => [ "Fedora Core", "3", "Heidelberg" ],
"fedora-4" => [ "Fedora Core", "4", "Stentz" ],
"rpath" => [ "rPath Linux" ],
"ark" => [ "Ark Linux" ],
"solaris-2.11" => [ "Solaris / OpenSolaris", "2.11", "Nevada" ],
"nexenta-1.0" => [ "Nexenta GNU/Solaris", "1.0", "Ellate" ],
"yellowdog-4.1" => [ "Yellow Dog Linux", "4.1", "Sagitta" ],
"guadalinex-v4" => [ "Guadalinex", "v4", "Toro" ],
};
sub get_platform_info
{
return $PLATFORM_INFO;
}
sub ensure_distro_map
{
my ($distro) = @_;
# This is a distro metamap, if one distro
# behaves *exactly* like another, just specify it here
my %metamap =
(
"blackpanther-4.0" => "mandrake-9.0",
"conectiva-10" => "conectiva-9",
"debian-3.1" => "debian-3.0",
"mandrake-7.1" => "redhat-6.2",
"mandrake-7.2" => "redhat-6.2",
"mandrake-9.1" => "mandrake-9.0",
"mandrake-9.2" => "mandrake-9.0",
"mandrake-10.0" => "mandrake-9.0",
"mandrake-10.1" => "mandrake-9.0",
"mandrake-10.2" => "mandrake-9.0",
"mandriva-2006.0" => "mandrake-9.0",
"mandriva-2006.1" => "mandrake-9.0",
"fedora-1" => "redhat-7.2",
"fedora-2" => "redhat-7.2",
"fedora-3" => "redhat-7.2",
"fedora-4" => "redhat-7.2",
"fedora-5" => "redhat-7.2",
"freebsd-6" => "freebsd-5",
"freebsd-7" => "freebsd-5",
"openna-1.0" => "redhat-6.2",
"pld-1.1" => "pld-1.0",
"pld-1.99" => "pld-1.0",
"pld-2.99" => "pld-1.0",
"redhat-9" => "redhat-8.0",
"rpath" => "redhat-7.2",
"yellowdog-4.1" => "redhat-7.2",
"slackware-10.0.0" => "slackware-9.1.0",
"slackware-10.1.0" => "slackware-9.1.0",
"slackware-10.2.0" => "slackware-9.1.0",
"slackware-11.0.0" => "slackware-9.1.0",
"slackware-12.0.0" => "slackware-9.1.0",
"bluewhite64-12.0.0" => "slackware-9.1.0",
"suse-9.1" => "suse-9.0",
"ubuntu-5.04" => "debian-3.0",
"ubuntu-5.10" => "debian-3.0",
"ubuntu-6.06" => "debian-3.0",
"ubuntu-6.10" => "debian-3.0",
"ubuntu-7.10" => "ubuntu-7.04",
"vine-3.1" => "vine-3.0",
"vlos-1.2" => "gentoo",
"nexenta-1.0" => "solaris-2.11",
"guadalinex-v4" => "debian-3.0",
);
return $metamap{$distro} if ($metamap{$distro});
return $distro;
}
sub check_lsb
{
my ($ver, $dist, %distmap);
%distmap = {
"gnu_solaris" => "nexenta"
};
$dist = lc (&Utils::Parse::get_sh ("/etc/lsb-release", "DISTRIB_ID"));
$ver = lc (&Utils::Parse::get_sh ("/etc/lsb-release", "DISTRIB_RELEASE"));
$dist = $$distmap{$dist} if exists $$distmap{$dist};
return -1 if ($dist eq "") || ($ver eq "");
return "$dist-$ver";
}
sub check_yoper
{
open YOPER, "$gst_prefix/etc/yoper-release" or return -1;
while (<YOPER>)
{
$ver = $_;
chomp ($ver);
if ($ver =~ m/Yoper (\S+)/)
{
close YOPER;
# find the first digit of our release
$mystring= ~m/(\d)/;
#store it in $fdigit
$fdigit= $1;
# the end of the release is marked with -2 so find the -
$end = index($ver,"-");
$start = index($ver,$fdigit);
# extract the substring into $newver
$newver= substr($ver,$start,$end-$start);
print $newver;
return "yoper-$newver";
}
}
close YOPER;
return -1;
}
sub check_rpath
{
open RPATH, "$gst_prefix/etc/distro-release" or return -1;
while (<RPATH>)
{
$ver = $_;
chomp ($ver);
if ($ver =~ /^rPath Linux/)
{
close RPATH;
return "rpath";
}
elsif ($ver =~ /Foresight/)
{
close RPATH;
return "rpath";
}
}
close RPATH;
return -1;
}
sub check_ark
{
open ARK, "$gst_prefix/etc/ark-release" or return -1;
while (<ARK>)
{
$ver = $_;
chomp ($ver);
if ($ver =~ /^Ark Linux/)
{
close ARK;
return "ark";
}
}
close ARK;
return -1;
}
sub check_freebsd
{
my ($sysctl_cmd, @output);
$sysctl_cmd = &Utils::File::locate_tool ("sysctl");
@output = (readpipe("$sysctl_cmd -n kern.version"));
foreach (@output)
{
chomp;
if (/^FreeBSD\s([0-9]+)\.\S+.*/)
{
return "freebsd-$1";
}
}
return -1;
}
sub check_solaris
{
my ($fd, $dist);
$fd = &Utils::File::run_pipe_read ("uname -r");
return -1 if $fd eq undef;
chomp ($dist = <$fd>);
&Utils::File::close_file ($fd);
if ($dist =~ /^5\.(\d+)/) { return "solaris-2.$1" }
return -1;
}
sub check_distro_file
{
my ($file, $dist, $re, $map) = @_;
my ($ver);
local *FILE;
open FILE, "$gst_prefix/$file" or return -1;
while (<FILE>)
{
chomp;
if ($_ =~ "$re")
{
$ver = $1;
$ver = $$map{$ver} if ($$map{$ver});
close FILE;
return "$dist-$ver";
}
}
close FILE;
return -1;
}
sub check_file_exists
{
my ($file, $distro) = @_;
return $distro if stat ("$gst_prefix/$file");
return -1;
}
sub get_system
{
# get the output of 'uname -s', it returns the system we are running
$Utils::Backend::tool{"system"} = &Utils::File::run_backtick ("uname -s");
chomp ($Utils::Backend::tool{"system"});
}
sub set_platform
{
my ($platform) = @_;
my ($p);
if (&ensure_platform ($platform))
{
$platform = &ensure_distro_map ($platform);
$Utils::Backend::tool{"platform"} = $gst_dist = $platform;
&Utils::Report::do_report ("platform_success", $platform);
&Utils::Report::end ();
return;
}
&set_platform_unsupported ($object);
&Utils::Report::do_report ("platform_unsup", $platform);
&Utils::Report::end ();
}
sub set_platform_unsupported
{
my ($object) = @_;
$Utils::Backend::tool{"platform"} = $gst_dist = undef;
#&Net::DBus::Object::emit_signal ($object, "noPlatformDetected");
}
sub ensure_platform
{
my ($platform) = @_;
return $platform if ($$PLATFORM_INFO{$platform} ne undef);
return undef;
}
sub guess
{
my ($object) = @_;
my ($distro, $func);
my ($checks, $check);
my %platform_checks = (
"Linux" => [[ \&check_lsb ],
[ \&check_distro_file, "/etc/debian_version", "debian", "(.*)", { "testing/unstable" => "sarge" } ],
[ \&check_distro_file, "/etc/SuSE-release", "suse", "VERSION\\s*=\\s*(\\S+)" ],
[ \&check_distro_file, "/etc/blackPanther-release", "blackpanther", "^Linux Black Panther release (\\S+)" ],
[ \&check_distro_file, "/etc/blackPanther-release", "blackpanther", "^Black Panther ( L|l)inux release ([\\d\\.]+)" ],
[ \&check_distro_file, "/etc/vine-release", "vine", "^Vine Linux (\\S+)" ],
[ \&check_distro_file, "/etc/fedora-release", "fedora", "^Fedora Core release (\\S+)" ],
[ \&check_distro_file, "/etc/mandrake-release", "mandrake", "^Linux Mandrake release (\\S+)" ],
[ \&check_distro_file, "/etc/mandrake-release", "mandrake", "^Mandrake( L|l)inux release (\\S+)" ],
[ \&check_distro_file, "/etc/mandriva-release", "mandriva", "^Linux Mandriva release (\\S+)" ],
[ \&check_distro_file, "/etc/mandriva-release", "mandriva", "^Mandriva( L|l)inux release (\\S+)" ],
[ \&check_distro_file, "/etc/conectiva-release", "conectiva", "^Conectiva Linux (\\S+)" ],
[ \&check_distro_file, "/etc/redhat-release", "redhat", "^Red Hat Linux.*\\s+(\\S+)" ],
[ \&check_distro_file, "/etc/openna-release", "openna", "^OpenNA (\\S+)" ],
[ \&check_distro_file, "/etc/slackware-version", "slackware", "^Slackware (\\S+)" ],
[ \&check_distro_file, "/etc/bluewhite64-version", "bluewhite64", "^Bluewhite64 (\\S+)" ],
[ \&check_distro_file, "/etc/vlos-release", "vlos", "^VLOS.*\\s+(\\S+)" ],
[ \&check_file_exists, "/usr/portage", "gentoo" ],
[ \&check_distro_file, "/etc/pld-release", "pld", "^(\\S+) PLD Linux" ],
[ \&check_rpath ],
[ \&check_file_exists, "/etc/arch-release", "archlinux" ],
[ \&check_ark ],
[ \&check_yoper ],
[ \&check_distro_file, "/etc/yellowdog-release", "yellowdog", "^Yellow Dog Linux release (\\S+)" ],
],
"FreeBSD" => [[ \&check_freebsd ]],
"SunOS" => [[ \&check_solaris ]]
);
$distro = $Utils::Backend::tool{"system"};
$checks = $platform_checks{$distro};
foreach $check (@$checks) {
$func = shift (@$check);
$dist = &$func (@$check);
if ($dist != -1 && &ensure_platform ($dist))
{
$dist = &ensure_distro_map ($dist);
$Utils::Backend::tool{"platform"} = $gst_dist = $dist;
&Utils::Report::do_report ("platform_success", $dist);
return;
}
}
&set_platform_unsupported ($tool, $object);
&Utils::Report::do_report ("platform_unsup", $platform);
&Utils::Report::end ();
}
sub get_cached_platform
{
my ($file, $platform);
$file = &Utils::File::get_base_path() . "/detected-platform";
$platform = &Utils::Parse::get_first_line ($file);
if (&ensure_platform ($platform))
{
$Utils::Backend::tool{"platform"} = $gst_dist = $platform;
&Utils::Report::do_report ("platform_success", $platform);
return 1;
}
return 0;
}
sub cache_platform
{
my ($file, $platform);
$file = &Utils::File::get_base_path() . "/detected-platform";
&Utils::Replace::set_first_line ($file, $gst_dist);
}
sub init
{
&get_system ();
# FIXME: need to figure out whether the underlying platform has
# been updated or changed, until now it's safer to ignore the cache,
# this function is called just once in all the executable lifecicle,
# so I don't expect any noticeable performance decrease.
#if (!&get_cached_platform ())
#{
&guess ($self) if !$Utils::Backend::tool{"platform"};
&cache_platform ();
#}
}
1;
syntax highlighted by Code2HTML, v. 0.9.1