#!/usr/bin/env perl
#-*- Mode: perl; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*-

# SysV services configurator. Aims to be designed to be architecture- and distribution independent.
#
# Copyright (C) 2002 Ximian, Inc.
#
# Authors: Carlos Garnacho Parro <garparr@teleline.es>
#          Grzegorz Golawski <grzegol@pld.org.pl> (PLD Support)
#
# 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.

# Best viewed with 100 columns of width.

BEGIN {
  $SCRIPTSDIR = "@scriptsdir@";
  if ($SCRIPTSDIR =~ /^@scriptsdir[@]/)
  {
      $SCRIPTSDIR = ".";
      $DOTIN = ".in";
  }
  
  require "$SCRIPTSDIR/general.pl$DOTIN";
  require "$SCRIPTSDIR/platform.pl$DOTIN";
  require "$SCRIPTSDIR/service.pl$DOTIN";
  require "$SCRIPTSDIR/print.pl$DOTIN";
}

# --- Tool information --- #

$name = "services";
$version = "@VERSION@";
@platforms = ("redhat-5.2", "redhat-6.0", "redhat-6.1", "redhat-6.2", "redhat-7.0", "redhat-7.1",
              "redhat-7.2", "redhat-7.3", "redhat-8.0", "redhat-9",
              "openna-1.0",
              
              "mandrake-7.1", "mandrake-7.2", "mandrake-9.0", "mandrake-9.1",

              "debian-2.2", "debian-3.0", "debian-sarge",

              "suse-7.0", "turbolinux-7.0", "pld-1.0", "fedora-1",
              "slackware-9.1.0");

$description =<<"end_of_description;";
       Configures which services are to be started or stopped at which runlevels
       and with what priority. System V, file-rc and bsd init, in short.
end_of_description;

# --- XML parsing --- #

sub xml_parse
{
  my ($tree, %hash, $elem);
  $tree = &gst_xml_scan ();

  # Walk the tree recursively and extract configuration parameters.
  while ($elem = shift @$tree)
  {
    if   ($elem eq "services") { &xml_parse_services (shift @$tree, \%hash); }
    else {&gst_report ("xml_unexp_tag", $elem); shift @$tree; }
  }

  return (\%hash);
}

sub xml_parse_services
{
  my ($tree, $hash) = @_;
  my ($services, $elem);
  my ($runlevel);
	
  shift @$tree; #skip attributes

  while ($elem = shift @$tree)
  {
    if ($elem eq "runlevels") { $runlevel = &xml_parse_runlevel_list (shift @$tree)}
    elsif ($elem eq "services") { push @$services, &xml_parse_service_list (shift @$tree); }
    else { &gst_report ("xml_unexp_tag", $elem); shift @$tree; }
  }

  $$hash{"services"} = $services;
  $$hash{"runlevel"} = $runlevel;
}

sub xml_parse_runlevel_list
{
  my ($tree) = @_;
  my ($runlevels, $elem, $runlevel);
  my ($rl);

  shift @$tree; #skip attributes

  while ($elem = shift @$tree)
  {
    if ($elem eq "runlevel")
    {
      $rl = &xml_parse_runlevel (shift @$tree);
      if ($rl ne undef)
      {
        $runlevel = $rl;
      }
    }
    else { &gst_report ("xml_unexp_tag", $elem); shift @$tree; }
  }

  return $runlevel;
}

sub xml_parse_runlevel
{
  my ($tree) = @_;
  my ($elem, $default, $runlevel);

  shift @$tree; #skip attributes

  while ($elem = shift @$tree)
  {
    if ($elem eq "default") {  $default = 1; shift @$tree }
    elsif ($elem eq "number") { $runlevel = &gst_xml_get_pcdata (shift @$tree); }
    elsif ($elem eq "description") { shift @$tree; }
    else { &gst_report ("xml_unexp_tag", $elem); shift @$tree; }
  }

  if ($default eq 1)
  {
    return $runlevel;
  }
}

sub xml_parse_service_list
{
  my ($tree) = @_;
  my ($hash, $service, $elem);

  shift @$tree; #skip attributes

  while ($elem = shift @$tree)
  {
    if ($elem eq "service") { push @$service, &xml_parse_service (shift @$tree); }
	else { &gst_report ("xml_unexp_tag", $elem); shift @$tree; }
  }

  $$hash{"service"} = $service unless scalar @$service == 0;
  return ($hash);
}

sub xml_parse_service
{
  my ($tree) = @_;
  my ($hash, $actions, $runlevels, $elem);

  shift @$tree; #skip attributes

  while ($elem = shift @$tree)
  {
    if ($elem eq "actions") { push @$actions, &xml_parse_actions (shift @$tree); }
    elsif ($elem eq "name") { $$hash{"name"} = &gst_xml_get_pcdata (shift @$tree); }
    elsif ($elem eq "description") { $$hash{"description"} = &gst_xml_get_pcdata (shift @$tree); }
    elsif ($elem eq "priority") { $$hash{"priority"} = &gst_xml_get_pcdata (shift @$tree); }
    elsif ($elem eq "runlevels") { push @$runlevels, &xml_parse_runlevels (shift @$tree); }
    elsif ($elem eq "script") { $$hash{"script"} = &gst_xml_get_pcdata (shift @$tree); }
    else { &gst_report ("xml_unexp_tag", $elem); shift @$tree; }
  }
  
  $$hash{"actions"} = $actions unless $actions eq undef;
  $$hash{"runlevels"} = $runlevels unless $runlevels eq undef;
  
  return ($hash);
}

sub xml_parse_actions
{
  my ($tree) = @_;
  my ($hash, $action, $elem);

  shift @$tree; #skip attributes

  while ($elem = shift @$tree)
  {
    if ($elem eq "action") { push @$action, &gst_xml_get_pcdata (shift @$tree); }
	else { &gst_report ("xml_unexp_tag", $elem); shift @$tree; }
  }
  
  if (scalar @$action != 0)
  {
    $$hash{"action"} = $action;
    return ($hash);
  }
}

sub xml_parse_runlevels
{
  my ($tree) = @_;
  my ($hash, $runlevel, $elem);

  shift @$tree; #skip attributes

  while ($elem = shift @$tree)
  {
    if ($elem eq "runlevel") { push @$runlevel, &xml_parse_single_runlevel (shift @$tree); }
	else { &gst_report ("xml_unexp_tag", $elem); shift @$tree; }
  }

  if (scalar @$runlevel != 0)
  {
    $$hash{"runlevel"} = $runlevel;
    return ($hash);
  }
}

sub xml_parse_single_runlevel
{
  my ($tree) = @_;
  my ($number, $action);
  my ($elem);
  
  shift @$tree; #skip attributes
  
  while ($elem = shift @$tree)
  {
    if ($elem eq "number") { $number = &gst_xml_get_pcdata (shift @$tree); }
  	elsif ($elem eq "action") { $action = &gst_xml_get_pcdata (shift @$tree); }
    else { &gst_report ("xml_unexp_tag", $elem); shift @$tree; }
  }
  
  return { "number" => $number,
           "action" => $action };
}

# --- XML printing --- #
sub xml_print_services
{
  my ($h) = @_;

  &gst_xml_print_line ("<services>");
  &gst_xml_enter ();

  &gst_xml_print_hash_hash ($h, "service");

  &gst_xml_leave ();
  &gst_xml_print_line ("</services>");
}

sub xml_print_runlevels
{
  my ($h, $default) = @_;
  &gst_xml_print_line ("<runlevels>");
  &gst_xml_enter ();

  foreach $i (sort keys %$h)
  {
    &gst_xml_print_line ("<runlevel>");
    &gst_xml_enter ();

    &gst_xml_print_pcdata ("number", $i);
    &gst_xml_print_pcdata ("description", $$h{$i});

    if ($i eq $default)
    {
      # It's the default runlevel
      &gst_xml_print_pcdata ("default", "1");
    }
      
    &gst_xml_leave ();
    &gst_xml_print_line ("</runlevel>");
  }
  
  &gst_xml_leave ();
  &gst_xml_print_line ("</runlevels>");
  &gst_xml_print_vspace ();
}

sub xml_print
{
  my ($h) = @_;

  &gst_xml_print_begin ();
  &gst_xml_print_comment ("These are the runlevels available in the system");
  &xml_print_runlevels ($$h{"runlevels"}, $$h{"runlevel"});
  
  &gst_xml_print_comment ("These are the services");
  &xml_print_services ($$h{"services"});
  &gst_xml_print_end ();
}


# Main operations

sub get
{
  my %hash;

  $hash{"runlevels"} = &gst_service_get_verbose_runlevels ();

  $hash{"services"} = &gst_service_get_services ();
  $hash{"runlevel"} = &gst_service_sysv_get_default_runlevel ();

  &gst_report_end ();
  &xml_print (\%hash);
}

sub set
{
  my %hash;
	
  $hash = &xml_parse ();
  &gst_report_end ();
	
  if ($hash)
  {
    &gst_service_set_conf ($hash);
  }
}

# --- Filter config: XML in, XML out --- #
sub filter
{
  my $hash = &xml_parse ();

  &gst_report_end ();
  &xml_print ($hash);
}

# --- throw_service: throws a service with a parameter --- #
sub throw_service
{
  my ($tool, $service, $parameter) = @_;
  my ($rcd_path, $initd_path, $relative_path) = &gst_service_sysv_get_paths ();

  gst_file_run ("$initd_path/$service $parameter >/dev/null 2>/dev/null");
  &gst_report_end ();

  #FIXME: we could return if the call has successed of failed
  &gst_xml_print_begin ("throw_service");
  &gst_xml_print_end ("throw_service");
}

# --- get_status: gets the status of a service --- #
sub get_status
{
  my ($tool, $service) = @_;
  my ($active);

  $active = &gst_service_get_status ($service);

  &gst_report_end ();

  &gst_xml_print_begin ("get_status");
  &gst_xml_print_state_tag ("active", $active) if ($active ne undef);
  &gst_xml_print_end ("get_status");
}

# --- Main --- #

# get, set and filter are special cases that don't need more parameters than a ref to their function.
# Read general.pl.in:gst_run_directive to know about the format of this hash.

$directives = {
  "get"                => [ \&get,    [], "" ],
  "set"                => [ \&set,    [], "" ],
  "filter"             => [ \&filter, [], "" ],
  "throw_service"      => [ \&throw_service, ["service", "parameter"], "Throws a service with a parameter (start, stop...)" ],
  "get_status"         => [ \&get_status, ["service"], "Gets the status of a service"]
  };

$tool = &gst_init ($name, $version, $description, $directives, @ARGV);
&gst_platform_ensure_supported ($tool, @platforms);
&gst_run ($tool);