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 / Backend.pm next >
Encoding:
Perl POD Document  |  2006-08-14  |  8.6 KB  |  332 lines
  1. #!/usr/bin/env perl
  2. #-*- Mode: perl; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*-
  3.  
  4. # Common stuff for the ximian-setup-tools backends.
  5. #
  6. # Copyright (C) 2000-2001 Ximian, Inc.
  7. #
  8. # Authors: Hans Petter Jansson <hpj@ximian.com>
  9. #
  10. # This program is free software; you can redistribute it and/or modify
  11. # it under the terms of the GNU Library General Public License as published
  12. # by the Free Software Foundation; either version 2 of the License, or
  13. # (at your option) any later version.
  14. #
  15. # This program is distributed in the hope that it will be useful,
  16. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. # GNU Library General Public License for more details.
  19. #
  20. # You should have received a copy of the GNU Library General Public License
  21. # along with this program; if not, write to the Free Software
  22. # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
  23.  
  24. package Utils::Backend;
  25.  
  26. use Utils::Report;
  27. use Utils::XML;
  28.  
  29. our $DBUS_PREFIX = "org.freedesktop.SystemToolsBackends";
  30. our $DBUS_PATH   = "/org/freedesktop/SystemToolsBackends";
  31. our $tool;
  32.  
  33. eval "use Locale::gettext";
  34. $eval_gettext = $@;
  35. eval "use POSIX";
  36. $eval_posix = $@;
  37. eval "use Encode";
  38. $eval_encode = $@;
  39.  
  40. $has_i18n = (($eval_gettext eq "") && ($eval_posix eq "") && ($eval_encode eq ""));
  41.  
  42. if ($has_i18n)
  43. {
  44.   # set up i18n stuff
  45.   &setlocale (LC_MESSAGES, "");
  46.   &bindtextdomain ("@GETTEXT_PACKAGE@", "@localedir@");
  47.  
  48.   # Big stupid hack, but it's the best I can do until
  49.   # distros switch to perl's gettext 1.04...
  50.   eval "&bind_textdomain_codeset (\"@GETTEXT_PACKAGE@\", \"UTF-8\")";
  51.   &textdomain ("@GETTEXT_PACKAGE@");
  52.  
  53.   eval "sub _ { return gettext (shift); }";
  54. }
  55. else
  56. {
  57.   # fake the gettext calls
  58.   eval "sub _ { return shift; }";
  59. }
  60.  
  61. # --- Operation modifying variables --- #
  62.  
  63.  
  64. # Variables are set to their default value, which may be overridden by user. Note
  65. # that a $prefix of "" will cause the configurator to use '/' as the base path,
  66. # and disables creation of directories and writing of previously non-existent
  67. # files.
  68.  
  69. # We should get rid of all these globals.
  70.  
  71. our $no_daemon = 0;
  72. our $prefix = "";
  73. our $do_verbose = 0;
  74. our $do_report = 0;
  75. our $session_bus = 0;
  76.  
  77. sub print_usage_synopsis
  78. {
  79.   my ($tool) = @_;
  80.   my ($ops_syn, $i);
  81.   my @ops = qw (get set filter);
  82.  
  83.   foreach $i (@ops)
  84.   {
  85.     $ops_syn .= "--$i | " if exists $ {$$tool{"directives"}}{$i};
  86.   }
  87.   
  88.   print STDERR "Usage: $$tool{name}-conf <${ops_syn}--interface | --directive | --help | --version>\n";
  89.  
  90.   print STDERR " " x length $$tool{"name"};
  91.   print STDERR "             [--disable-immediate] [--prefix <location>]\n";
  92.  
  93.   print STDERR " " x length $$tool{"name"};
  94.   print STDERR "             [--report] [--verbose]\n\n";
  95. }
  96.  
  97. sub print_usage_generic
  98. {
  99.   my ($tool) = @_;
  100.   my (%usage, $i);
  101.   my @ops = qw (get set filter);
  102.  
  103.   my $usage_generic_head =<< "end_of_usage_generic;";
  104.        Major operations (specify one of these):
  105.  
  106. end_of_usage_generic;
  107.  
  108.   my $usage_generic_tail =<< "end_of_usage_generic;";
  109.            -h --help  Prints this page to standard error.
  110.  
  111.            --version  Prints version information to standard output.
  112.  
  113.        Modifiers (specify any combination of these):
  114.  
  115.           -no-daemon  Does not daemonize the backend
  116.  
  117.           --platform  <name-ver>  Overrides the detection of your platform\'s
  118.                       name and version, e.g. redhat-6.2. Use with care. See the
  119.                       documentation for a full list of supported platforms.
  120.  
  121.        -p --prefix <location>  Specifies a directory prefix where the
  122.                       configuration is looked for or stored. When storing
  123.                       (with --set), directories and files may be created.
  124.  
  125.           --report    Prints machine-readable diagnostic messages to standard
  126.                       output, before any XML. Each message has a unique
  127.                       three-digit ID. The report ends in a blank line.
  128.  
  129.        -v --verbose   Prints human-readable diagnostic messages to standard
  130.                       error.
  131.  
  132.       --session-bus   Makes the backends to use the session bus.
  133.  
  134. end_of_usage_generic;
  135.  
  136.   $usage{"get"} =<< "end_of_usage_generic;";
  137.        -g --get       Prints the current configuration to standard output, as
  138.                       a standalone XML document. The configuration is read from
  139.                       the host\'s system config files.
  140.  
  141. end_of_usage_generic;
  142.   $usage{"set"} =<< "end_of_usage_generic;";
  143.        -s --set       Updates the current configuration from a standalone XML
  144.                       document read from standard input. The format is the same 
  145.                       as for the document generated with --get.
  146.  
  147. end_of_usage_generic;
  148.   $usage{"filter"} =<< "end_of_usage_generic;";
  149.        -f --filter    Reads XML configuration from standard input, parses it,
  150.                       and writes the configurator\'s impression of it back to
  151.                       standard output. Good for debugging and parsing tests.
  152.  
  153. end_of_usage_generic;
  154.  
  155.   print STDERR $usage_generic_head;
  156.  
  157.   foreach $i (@ops)
  158.   {
  159.     print STDERR $usage{$i} if exists $ {$$tool{"directives"}}{$i};
  160.   }
  161.  
  162.   print STDERR $usage_generic_tail;
  163. }
  164.  
  165. # if $exit_code is provided (ne undef), exit with that code at the end.
  166. sub print_usage
  167. {
  168.   my ($tool, $exit_code) = @_;
  169.  
  170.   &print_usage_synopsis ($tool);
  171.   print STDERR $$tool{"description"} . "\n";
  172.   &print_usage_generic ($tool);
  173.  
  174.   exit $exit_code if $exit_code ne undef;
  175. }
  176.  
  177. sub print_version
  178. {
  179.   my ($tool, $exit_code) = @_;
  180.  
  181.   exit $exit_code if $exit_code ne undef;
  182. }
  183.  
  184. # --- Initialization and finalization --- #
  185.  
  186.  
  187. sub set_with_param
  188. {
  189.   my ($tool, $arg_name, $value) = @_;
  190.   
  191.   if ($$tool{$arg_name} ne "")
  192.   {
  193.     print STDERR "Error: You may specify --$arg_name only once.\n\n";
  194.     &print_usage ($tool, 1);
  195.   }
  196.   
  197.   if ($value eq "")
  198.   {
  199.     print STDERR "Error: You must specify an argument to the --$arg_name option.\n\n";
  200.     &print_usage ($tool, 1);
  201.   }
  202.   
  203.   $$tool{$arg_name} = $value;
  204. }
  205.  
  206. sub set_no_daemon
  207. {
  208.   my ($tool) = @_;
  209.  
  210.   &set_with_param ($tool, "no-daemon", 1);
  211.   $no_daemon = 1;
  212. }
  213.  
  214. sub set_prefix
  215. {
  216.   my ($tool, $prefix) = @_;
  217.   
  218.   &set_with_param ($tool, "prefix", $prefix);
  219.   $gst_prefix = $prefix;
  220. }
  221.  
  222. sub set_dist
  223. {
  224.   my ($tool, $dist) = @_;
  225.  
  226.   &Utils::Platform::set_platform ($dist);
  227. }
  228.  
  229. sub set_session_bus
  230. {
  231.   my ($tool) = @_;
  232.  
  233.   &set_with_param ($tool, "session-bus", 1);
  234.   $session_bus = 1;
  235. }
  236.  
  237. sub is_backend
  238. {
  239.   my ($tool) = @_;
  240.  
  241.   if ((ref $tool eq "HASH") &&
  242.       (exists $$tool{"is_tool"}) &&
  243.       ($$tool{"is_tool"} == 1))
  244.   {
  245.     return 1;
  246.   }
  247.  
  248.   return 0;
  249. }
  250.  
  251. sub init
  252. {
  253.   my ($name, $version, $description, $directives, @args) = @_;
  254.   my ($arg);
  255.  
  256.   # Set the output autoflush.
  257.   $old_fh = select (STDOUT); $| = 1; select ($old_fh);
  258.   $old_fh = select (STDERR); $| = 1; select ($old_fh);
  259.  
  260.   $tool{"is_tool"} = 1;
  261.  
  262.   # Set backend descriptors.
  263.  
  264.   $tool{"name"} = $gst_name = $name;
  265.   $tool{"version"} = $version;
  266.   $tool{"description"} = $description;
  267.   $tool{"directives"} = $directives;
  268.  
  269.   # Parse arguments.
  270.   while ($arg = shift (@args))
  271.   {
  272.     if    ($arg eq "--help"      || $arg eq "-h") { &print_usage   (\%tool, 0); }
  273.     elsif ($arg eq "--no-daemon" || $arg eq "-n") { &set_no_daemon (\%tool);    }
  274.     elsif ($arg eq "--version")                   { &print_version (\%tool, 0); }
  275.     elsif ($arg eq "--prefix"    || $arg eq "-p") { &set_prefix    (\%tool, shift @args); }
  276.     elsif ($arg eq "--platform")                  { &set_dist      (\%tool, shift @args); }
  277.     elsif ($arg eq "--session-bus")               { &set_session_bus (\%tool); }
  278.     elsif ($arg eq "--verbose"   || $arg eq "-v")
  279.     {
  280.       $tool{"do_verbose"} = $do_verbose = 1;
  281.       &Utils::Report::set_threshold (99);
  282.     }
  283.     elsif ($arg eq "--report")
  284.     {
  285.       $tool{"do_report"} = $do_report = 1;
  286.       &Utils::Report::set_threshold (99);
  287.     }
  288.     else
  289.     {
  290.       print STDERR "Error: Unrecognized option '$arg'.\n\n";
  291.       &print_usage (\%tool, 1);
  292.     }
  293.   }
  294.  
  295.   if (!$no_daemon)
  296.   {
  297.     &daemonize ();
  298.   }
  299.  
  300.   # Set up subsystems.
  301.   &Utils::Report::begin ();
  302.  
  303.   return \%tool;
  304. }
  305.  
  306. sub daemonize
  307. {
  308.   chdir '/'                  or die "Can't chdir to /: $!";
  309.   umask 0;
  310.   open STDIN, '/dev/null'    or die "Can't read /dev/null: $!";
  311.   open STDOUT, '>/dev/null'  or die "Can't write to /dev/null: $!";
  312.   open STDERR, '>/dev/null'  or die "Can't write to /dev/null: $!";
  313.  
  314.   defined (my $pid = fork)   or die "Can't fork: $!";
  315.   exit (0) if $pid;
  316.  
  317.   setsid                     or die "Can't start a new session: $!";
  318.  
  319.   # write pid file
  320.   open (PIDFILE, ">/var/run/system-tools-backends.pid") or die "Can't open pidfile";
  321.   print PIDFILE $$;
  322.   close (PIDFILE);
  323. }
  324.  
  325. sub get_bus
  326. {
  327.   return Net::DBus->session if ($session_bus);
  328.   return Net::DBus->system;
  329. }
  330.  
  331. 1;
  332.