home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / system-tools-backends-2.0 / scripts / Utils / Platform.pm < prev    next >
Encoding:
Perl POD Document  |  2006-08-14  |  13.6 KB  |  459 lines
  1. #!/usr/bin/env perl
  2. #-*- Mode: perl; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*-
  3.  
  4. # Determine the platform we're running on.
  5. #
  6. # Copyright (C) 2000-2001 Ximian, Inc.
  7. #
  8. # Authors: Arturo Espinosa <arturo@ximian.com>
  9. #          Hans Petter Jansson <hpj@ximian.com>
  10. #
  11. # This program is free software; you can redistribute it and/or modify
  12. # it under the terms of the GNU Library General Public License as published
  13. # by the Free Software Foundation; either version 2 of the License, or
  14. # (at your option) any later version.
  15. #
  16. # This program is distributed in the hope that it will be useful,
  17. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. # GNU Library General Public License for more details.
  20. #
  21. # You should have received a copy of the GNU Library General Public License
  22. # along with this program; if not, write to the Free Software
  23. # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
  24.  
  25. package Utils::Platform;
  26.  
  27. use Utils::XML;
  28. use Utils::Parse;
  29. use Utils::Backend;
  30.  
  31. use base qw(Net::DBus::Object);
  32. use Net::DBus::Exporter ($Utils::Backend::DBUS_PREFIX . ".Platform");
  33.  
  34. my $OBJECT_NAME = "Platform";
  35. my $OBJECT_PATH = "$Utils::Backend::DBUS_PATH/$OBJECT_NAME";
  36.  
  37. dbus_method ("getPlatformList", [], [[ "array", [ "struct", "string", "string", "string", "string" ]]]);
  38. dbus_method ("getPlatform", [], [ "string" ]);
  39. dbus_method ("setPlatform", [ "string" ], []);
  40. dbus_signal ("noPlatformDetected", []);
  41.  
  42. # --- System guessing --- #
  43.  
  44. my $PLATFORM_INFO = {
  45.   "debian-3.0"      => [ "Debian GNU/Linux", "3.0", "Woody" ],
  46.   "debian-3.1"      => [ "Debian GNU/Linux", "3.1", "Sarge" ],
  47.   "ubuntu-5.04"     => [ "Ubuntu Linux", "5.04", "Hoary" ],
  48.   "ubuntu-5.10"     => [ "Ubuntu Linux", "5.10", "Breezy" ],
  49.   "ubuntu-6.06"     => [ "Ubuntu Linux", "6.06", "Dapper" ],
  50.   "ubuntu-6.10"     => [ "Ubuntu Linux", "6.10", "Edgy" ],
  51.   "redhat-5.2"      => [ "Red Hat Linux", "5.2", "Apollo" ],
  52.   "redhat-6.0"      => [ "Red Hat Linux", "6.0", "Hedwig" ],
  53.   "redhat-6.1"      => [ "Red Hat Linux", "6.1", "Cartman" ],
  54.   "redhat-6.2"      => [ "Red Hat Linux", "6.2", "Zoot" ],
  55.   "redhat-7.0"      => [ "Red Hat Linux", "7.0", "Guinness" ],
  56.   "redhat-7.1"      => [ "Red Hat Linux", "7.1", "Seawolf" ],
  57.   "redhat-7.2"      => [ "Red Hat Linux", "7.2", "Enigma" ],
  58.   "redhat-7.3"      => [ "Red Hat Linux", "7.3", "Valhalla" ],
  59.   "redhat-8.0"      => [ "Red Hat Linux", "8.0", "Psyche" ],
  60.   "redhat-9"        => [ "Red Hat Linux", "9.0", "Shrike" ],
  61.   "openna-1.0"      => [ "OpenNA Linux", "1.0", "VSLC" ],
  62.   "mandrake-7.1"    => [ "Linux Mandrake", "7.1" ],
  63.   "mandrake-7.2"    => [ "Linux Mandrake", "7.2", "Odyssey" ],
  64.   "mandrake-8.0"    => [ "Linux Mandrake", "8.0", "Traktopel" ],
  65.   "mandrake-9.0"    => [ "Linux Mandrake", "9.0", "Dolphin" ],
  66.   "mandrake-9.1"    => [ "Linux Mandrake", "9.1", "Bamboo" ],
  67.   "mandrake-9.2"    => [ "Linux Mandrake", "9.2", "FiveStar" ],
  68.   "mandrake-10.0"   => [ "Linux Mandrake", "10.0" ],
  69.   "mandrake-10.1"   => [ "Linux Mandrake", "10.1" ],
  70.   "mandrake-10.2"   => [ "Linux Mandrake", "2005" ],
  71.   "mandriva-2006.0" => [ "Mandriva Linux", "2006.0" ],
  72.   "mandriva-2006.1" => [ "Mandriva Linux", "2006.1" ],
  73.   "yoper-2.2"       => [ "Yoper Linux", "2.2" ],
  74.   "blackpanther-4.0" => [ "Black Panther OS", "4.0", "" ],
  75.   "conectiva-9"     => [ "Conectiva Linux", "9", "" ],
  76.   "conectiva-10"    => [ "Conectiva Linux", "10", "" ],
  77.   "suse-9.0"        => [ "SuSE Linux", "9.0", "" ],
  78.   "suse-9.1"        => [ "SuSE Linux", "9.1", "" ],
  79.   "slackware-9.1.0" => [ "Slackware", "9.1.0", "" ],
  80.   "slackware-10.0.0" => [ "Slackware", "10.0.0", "" ],
  81.   "slackware-10.1.0" => [ "Slackware", "10.1.0", "" ],
  82.   "slackware-10.2.0" => [ "Slackware", "10.2.0", "" ],
  83.   "freebsd-4"       => [ "FreeBSD", "4", "" ],
  84.   "freebsd-5"       => [ "FreeBSD", "5", "" ],
  85.   "freebsd-6"       => [ "FreeBSD", "6", "" ],
  86.   "freebsd-7"       => [ "FreeBSD", "7", "" ],
  87.   "gentoo"          => [ "Gentoo Linux", "", "" ],
  88.   "vlos-1.2"        => [ "Vida Linux OS", "1.2" ],
  89.   "archlinux"       => [ "Arch Linux", "", "" ],
  90.   "pld-1.0"         => [ "PLD", "1.0", "Ra" ],
  91.   "pld-1.1"         => [ "PLD", "1.1", "Ra" ],
  92.   "pld-1.99"        => [ "PLD", "1.99", "Ac-pre" ],
  93.   "pld-2.99"        => [ "PLD", "1.99", "Th-pre" ],
  94.   "vine-3.0"        => [ "Vine Linux", "3.0", "" ],
  95.   "vine-3.1"        => [ "Vine Linux", "3.1", "" ],
  96.   "fedora-1"        => [ "Fedora Core", "1", "Yarrow" ],
  97.   "fedora-2"        => [ "Fedora Core", "2", "Tettnang" ],
  98.   "fedora-3"        => [ "Fedora Core", "3", "Heidelberg" ],
  99.   "fedora-4"        => [ "Fedora Core", "4", "Stentz" ],
  100.   "rpath"           => [ "rPath Linux" ],
  101.   "ark"             => [ "Ark Linux" ]
  102. };
  103.  
  104. sub ensure_distro_map
  105. {
  106.   my ($distro) = @_;
  107.  
  108.   # This is a distro metamap, if one distro
  109.   # behaves *exactly* like another, just specify it here
  110.   my %metamap =
  111.     (
  112.      "blackpanther-4.0" => "mandrake-9.0",
  113.      "conectiva-10"     => "conectiva-9",
  114.      "debian-3.1"       => "debian-3.0",
  115.      "mandrake-7.1"     => "redhat-6.2",
  116.      "mandrake-7.2"     => "redhat-6.2",
  117.      "mandrake-9.1"     => "mandrake-9.0",
  118.      "mandrake-9.2"     => "mandrake-9.0",
  119.      "mandrake-10.0"    => "mandrake-9.0",
  120.      "mandrake-10.1"    => "mandrake-9.0",
  121.      "mandrake-10.2"    => "mandrake-9.0",
  122.      "mandriva-2006.0"  => "mandrake-9.0",
  123.      "mandriva-2006.1"  => "mandrake-9.0",
  124.      "fedora-1"         => "redhat-7.2",
  125.      "fedora-2"         => "redhat-7.2",
  126.      "fedora-3"         => "redhat-7.2",
  127.      "fedora-4"         => "redhat-7.2",
  128.      "fedora-5"         => "redhat-7.2",
  129.      "freebsd-6"        => "freebsd-5",
  130.      "freebsd-7"        => "freebsd-5",
  131.      "openna-1.0"       => "redhat-6.2",
  132.      "pld-1.1"          => "pld-1.0",
  133.      "pld-1.99"         => "pld-1.0",
  134.      "pld-2.99"         => "pld-1.0",
  135.      "redhat-9"         => "redhat-8.0",
  136.      "rpath"            => "redhat-7.2",
  137.      "slackware-10.0.0" => "slackware-9.1.0",
  138.      "slackware-10.1.0" => "slackware-9.1.0",
  139.      "slackware-10.2.0" => "slackware-9.1.0",
  140.      "suse-9.1"         => "suse-9.0",
  141.      "ubuntu-5.04"      => "debian-3.0",
  142.      "ubuntu-5.10"      => "debian-3.0",
  143.      "ubuntu-6.06"      => "debian-3.0",
  144.      "ubuntu-6.10"      => "debian-3.0",
  145.      "vine-3.1"         => "vine-3.0",
  146.      "vlos-1.2"         => "gentoo"
  147.      );
  148.  
  149.   return $metamap{$distro} if ($metamap{$distro});
  150.   return $distro;
  151. }
  152.   
  153. sub check_lsb
  154. {
  155.   my ($ver, $dist);
  156.  
  157.   $dist = lc (&Utils::Parse::get_sh ("/etc/lsb-release", "DISTRIB_ID"));
  158.   $ver = lc (&Utils::Parse::get_sh ("/etc/lsb-release", "DISTRIB_RELEASE"));
  159.   
  160.   return -1 if ($dist eq "") || ($ver eq "");
  161.   return "$dist-$ver";
  162. }
  163.  
  164. sub check_yoper
  165. {
  166.    open YOPER, "$gst_prefix/etc/yoper-release" or return -1;
  167.    while (<YOPER>)
  168.    {
  169.      $ver = $_;
  170.      chomp ($ver);
  171.      if ($ver =~ m/Yoper (\S+)/)
  172.      {
  173.        close YOPER;
  174.        # find the first digit of our release
  175.        $mystring= ~m/(\d)/;
  176.        #store it in $fdigit
  177.        $fdigit= $1;
  178.        # the end of the release is marked with -2 so find the -
  179.        $end = index($ver,"-");
  180.        $start = index($ver,$fdigit);
  181.        # extract the substring into $newver
  182.        $newver= substr($ver,$start,$end-$start);
  183.        print $newver;
  184.        return "yoper-$newver";
  185.      }
  186.    }
  187.    close YOPER;
  188.    return -1;
  189. }
  190.  
  191. sub check_rpath
  192. {
  193.   open RPATH, "$gst_prefix/etc/distro-release" or return -1;
  194.  
  195.   while (<RPATH>)
  196.   {
  197.     $ver = $_;
  198.     chomp ($ver);
  199.  
  200.     if ($ver =~ /^rPath Linux/)
  201.     {
  202.       close RPATH;
  203.       return "rpath";
  204.     }
  205.     elsif ($ver =~ /Foresight/)
  206.     {
  207.       close RPATH;
  208.       return "rpath";
  209.     }
  210.   }
  211.  
  212.   close RPATH;
  213.   return -1;
  214. }
  215.  
  216. sub check_ark
  217. {
  218.   open ARK, "$gst_prefix/etc/ark-release" or return -1;
  219.   while (<ARK>)
  220.   {
  221.     $ver = $_;
  222.     chomp ($ver);
  223.  
  224.     if ($ver =~ /^Ark Linux/)
  225.     {
  226.       close ARK;
  227.       return "ark";
  228.     }
  229.   }
  230.  
  231.   close ARK;
  232.   return -1;
  233. }
  234.  
  235. sub check_freebsd
  236. {
  237.   my ($sysctl_cmd, @output);
  238.  
  239.   $sysctl_cmd = &Utils::File::locate_tool ("sysctl");
  240.   @output = (readpipe("$sysctl_cmd -n kern.version"));
  241.   foreach (@output)
  242.   {
  243.     chomp;
  244.     if (/^FreeBSD\s([0-9]+)\.\S+.*/)
  245.     {
  246.       return "freebsd-$1";
  247.     }
  248.   }
  249.   return -1;
  250. }
  251.  
  252. sub check_solaris
  253. {
  254.   my ($fd, $dist);
  255.  
  256.   #
  257.   # The file /etc/release is present for solaris-2.6
  258.   # solaris 2.5 does not have the file.  Solaris-7.0 and 8.0 have not
  259.   # been checked
  260.   #
  261.   # uname output
  262.   # Solaris 2.5: 5.5(.1)
  263.   # Solaris 2.6: 5.6
  264.   # Solaris 7:   unknown, assume 7.0
  265.   # Solaris 8:   unknown, assume 8.0
  266.   #
  267.   $fd = &Utils::File::run_pipe_read ("uname -r");
  268.   return -1 if $fd eq undef;
  269.   chomp ($dist = <$fd>);
  270.   &Utils::File::close_file ($fd);
  271.  
  272.   if ($dist =~ /^5\.(\d)/) { return "solaris-2.$1" }
  273.   else { if ($dist =~ /^([78])\.\d/) { return "solaris-$1.0" } }
  274.   return -1;
  275. }
  276.  
  277. sub check_distro_file
  278. {
  279.   my ($file, $dist, $re, $map) = @_;
  280.   my ($ver);
  281.   local *FILE;
  282.  
  283.   open FILE, "$gst_prefix/$file" or return -1;
  284.  
  285.   while (<FILE>)
  286.   {
  287.     chomp;
  288.  
  289.     if ($_ =~ "$re")
  290.     {
  291.       $ver = $1;
  292.       $ver = $$map{$ver} if ($$map{$ver});
  293.  
  294.       close FILE;
  295.       return "$dist-$ver";
  296.     }
  297.   }
  298.  
  299.   close FILE;
  300.   return -1;
  301. }
  302.  
  303. sub check_file_exists
  304. {
  305.   my ($file, $distro) = @_;
  306.  
  307.   return $distro if &Utils::File::exists ($file);
  308.   return -1;
  309. }
  310.  
  311. sub get_system
  312. {
  313.   # get the output of 'uname -s', it returns the system we are running
  314.   $Utils::Backend::tool{"system"} = &Utils::File::run_backtick ("uname -s");
  315.   chomp ($Utils::Backend::tool{"system"});
  316. }
  317.  
  318. sub set_platform
  319. {
  320.   my ($platform) = @_;
  321.   my ($p);
  322.  
  323.   foreach $p (keys %$PLATFORM_INFO)
  324.   {
  325.     if ($p eq $platform)
  326.     {
  327.       $platform = &ensure_distro_map ($platform);
  328.  
  329.       $Utils::Backend::tool{"platform"} = $gst_dist = $platform;
  330.       &Utils::Report::do_report ("platform_success", $platform);
  331.       &Utils::Report::end ();
  332.       return;
  333.     }
  334.   }
  335.  
  336.   &set_platform_unsupported ($object);
  337.   &Utils::Report::do_report ("platform_unsup", $platform);
  338.   &Utils::Report::end ();
  339. }
  340.  
  341. sub set_platform_unsupported
  342. {
  343.   my ($object) = @_;
  344.  
  345.   $Utils::Backend::tool{"platform"} = $gst_dist = undef;
  346.   #&Net::DBus::Object::emit_signal ($object, "noPlatformDetected");
  347. }
  348.  
  349. sub ensure_platform
  350. {
  351.   my ($platform) = @_;
  352.   my ($p);
  353.  
  354.   foreach $p (keys %$PLATFORM_INFO)
  355.   {
  356.     return $platform if ($p eq $platform);
  357.   }
  358.  
  359.   return undef;
  360. }
  361.  
  362. sub guess
  363. {
  364.   my ($object) = @_;
  365.   my ($distro, $func);
  366.   my ($checks, $check);
  367.  
  368.   my %platform_checks = (
  369.     "Linux"   => [[ \&check_lsb ],
  370.                   [ \&check_distro_file, "/etc/debian_version", "debian", "(.*)", { "testing/unstable" => "sarge" } ],
  371.                   [ \&check_distro_file, "/etc/SuSE-release", "suse", "VERSION\s*=\s*(\S+)" ],
  372.                   [ \&check_distro_file, "/etc/blackPanther-release", "blackpanther", "^Linux Black Panther release (\S+)" ],
  373.                   [ \&check_distro_file, "/etc/blackPanther-release", "blackpanther", "^Black Panther ( L|l)inux release ([\d\.]+)" ],
  374.                   [ \&check_distro_file, "/etc/vine-release", "vine", "^Vine Linux ([0-9.]+)" ],
  375.                   [ \&check_distro_file, "/etc/fedora-release", "fedora", "^Fedora Core release (\S+)" ],
  376.                   [ \&check_distro_file, "/etc/mandrake-release", "mandrake", "^Linux Mandrake release (\S+)" ],
  377.                   [ \&check_distro_file, "/etc/mandrake-release", "mandrake", "^Mandrake( L|l)inux release ([\d\.]+)" ],
  378.                   [ \&check_distro_file, "/etc/mandriva-release", "mandriva", "^Linux Mandriva release (\S+)" ],
  379.                   [ \&check_distro_file, "/etc/mandriva-release", "mandriva", "^Mandriva( L|l)inux release ([\d\.]+)" ],
  380.                   [ \&check_distro_file, "/etc/conectiva-release", "conectiva", "^Conectiva Linux (\S+)" ],
  381.                   [ \&check_distro_file, "/etc/redhat-release", "redhat", "^Red Hat Linux.*\s+([0-9.]+)" ],
  382.                   [ \&check_distro_file, "/etc/openna-release", "openna", "^OpenNA (\S+)" ],
  383.                   [ \&check_distro_file, "/etc/slackware-version", "slackware", "^Slackware ([0-9.]+)" ],
  384.                   [ \&check_distro_file, "/etc/vlos-release", "vlos", "^VLOS.*\s+([0-9.]+)" ],
  385.                   [ \&check_file_exists, "/usr/portage", "gentoo" ],
  386.                   [ \&check_distro_file, "/etc/pld-release", "pld", "^([0-9.]+) PLD Linux" ],
  387.                   [ \&check_rpath ],
  388.                   [ \&check_file_exists, "/etc/arch-release", "archlinux" ],
  389.                   [ \&check_ark ],
  390.                   [ \&check_yoper ],
  391.                  ],
  392.     "FreeBSD" => [[ \&check_freebsd ]],
  393.     "SunOS"   => [[ \&check_solaris ]]
  394.   );
  395.  
  396.   $distro = $Utils::Backend::tool{"system"};
  397.   $checks = $platform_checks{$distro};
  398.  
  399.   foreach $check (@$checks) {
  400.     $func = shift (@$check);
  401.     $dist = &$func (@$check);
  402.  
  403.     # FIXME: is necessary ensure_platform?
  404.     if ($dist != -1 && &ensure_platform ($dist))
  405.     {
  406.       $dist = &ensure_distro_map ($dist);
  407.       $Utils::Backend::tool{"platform"} = $gst_dist = $dist;
  408.       &Utils::Report::do_report ("platform_success", $dist);
  409.       return;
  410.     }
  411.   }
  412.  
  413.   &set_platform_unsupported ($tool, $object);
  414.   &Utils::Report::do_report ("platform_unsup", $platform);
  415.   &Utils::Report::end ();
  416. }
  417.  
  418. sub new
  419. {
  420.   my $class   = shift;
  421.   my $service = shift;
  422.   my $self    = $class->SUPER::new ($service, $OBJECT_PATH);
  423.  
  424.   bless $self, $class;
  425.   &get_system ();
  426.   &guess ($self) if !$Utils::Backend::tool{"platform"};
  427.  
  428.   return $self;
  429. }
  430.  
  431. sub getPlatformList
  432. {
  433.   my ($self) = @_;
  434.   my ($arr, $key);
  435.  
  436.   foreach $key (keys %$PLATFORM_INFO)
  437.   {
  438.       push @$arr, [ $$PLATFORM_INFO{$key}[0],
  439.                     $$PLATFORM_INFO{$key}[1],
  440.                     $$PLATFORM_INFO{$key}[2],
  441.                     $key ];
  442.   }
  443.  
  444.   return $arr;
  445. }
  446.  
  447. sub getPlatform
  448. {
  449.   return $Utils::Backend::tool{"platform"};
  450. }
  451.  
  452. # A directive handler that sets the currently selected platform.
  453. sub setPlatform
  454. {
  455.   my ($self, $platform) = @_;
  456.  
  457.   &set_platform ($platform);
  458. }
  459.