path: root/network-conf.in

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

# Network configurator. Designed to be architecture and distribution independent.
#
# Copyright (C) 2000-2001 Ximian, Inc.
#
# Authors: Hans Petter Jansson <hpj@ximian.com>
#          Michael Vogt <mvo@debian.org> (Debian Support)
#          Arturo Espinosa <arturo@ximian.com>
#          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.

# Configuration files affected:
#
# /etc/resolv.conf
# /etc/host.conf
# /etc/hosts
# /etc/sysconfig/network
# /etc/rc.config
# /etc/smb.conf

# Running programs affected:
#
# smbd
# nmbd
# ifconfig: check current interfaces and activate/deactivate.


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


# Debug stuff
#$gst_prefix = "/tmp/y";
#open STDERR, ">/tmp/err";

# --- Tool information --- #

$name = "network";
$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-8.0", "redhat-9",
              
              "mandrake-7.1", "mandrake-7.2", "mandrake-9.0", "mandrake-9.1", 
              
              "debian-2.2", "debian-woody", "debian-sarge",
              
              "suse-7.0", "turbolinux-7.0", "pld-1.0");

$description =<<"end_of_description;";
       Configures all network parameters and interfaces.
end_of_description;

$progress_max = 10;

$profile_file = "profiles.xml";


# --- XML parsing ---

# Scan XML from standard input to an internal tree.
sub xml_parse
{
  my ($tree, %hash, $elem);
  # Scan XML to tree.

  $tree = &gst_xml_scan ();

  # Walk the tree recursively and extract configuration parameters.
  # This is the top level - find and enter the "network" tag.

  while ($elem = shift @$tree)
  {
    if ($elem eq "network") { &xml_parse_network (shift @$tree, \%hash); }
    else { &gst_report ("xml_unexp_tag", $elem); shift @$tree; }
  }

  return(\%hash);
}

# <network>...</network>

sub push_unique
{
  my ($arr, $val) = @_;
  my $i;

  foreach $i (@$arr)
  {
    return if $i eq $val;
  }

  push @$arr, $val;
}

sub xml_parse_network
{
  my ($tree, $hash) = @_;
  my ($elem);
  my (@searchdomain, @nameserver, @order, %statichost, %interface, %dialing);

  shift @$tree;  # Skip attributes.

  while ($elem = shift @$tree)
  {
    if    ($elem eq "auto")          { $$hash{"auto"} =        &gst_xml_get_pcdata (shift @$tree); }
    elsif ($elem eq "hostname")      { $$hash{"hostname"} =    &gst_xml_get_pcdata (shift @$tree); }
    elsif ($elem eq "gateway")       { $$hash{"gateway"} =     &gst_xml_get_pcdata (shift @$tree); }
    elsif ($elem eq "gatewaydev")    { $$hash{"gatewaydev"} =  &gst_xml_get_pcdata (shift @$tree); }
    elsif ($elem eq "domain")        { $$hash{"domain"} =      &gst_xml_get_pcdata (shift @$tree); }
    elsif ($elem eq "workgroup")     { $$hash{"workgroup"} =   &gst_xml_get_pcdata (shift @$tree); }
    elsif ($elem eq "smbdesc")       { $$hash{"smbdesc"} =     &gst_xml_get_pcdata (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 "winsserver")    { $$hash{"winsserver"} =  &gst_xml_get_pcdata (shift @$tree); }
    elsif ($elem eq "winsuse")       { $$hash{"winsuse"} =     &gst_xml_get_pcdata (shift @$tree); }
    elsif ($elem eq "smbuse")        { $$hash{"smbuse"} =      &gst_xml_get_pcdata (shift @$tree); }
    elsif ($elem eq "hostmatch")     { $$hash{"hostmatch"} =   &gst_xml_get_pcdata (shift @$tree); }
    elsif ($elem eq "nameserver")    { &push_unique (\@nameserver, &gst_xml_get_pcdata (shift @$tree)); }
    elsif ($elem eq "searchdomain")  { &push_unique (\@searchdomain, &gst_xml_get_pcdata (shift @$tree)); }
    elsif ($elem eq "order")         { push (@order, &gst_xml_get_pcdata (shift @$tree)); }
    elsif ($elem eq "statichost")    { &xml_parse_statichost (shift @$tree, \%statichost); }
    elsif ($elem eq "interface")     { &gst_network_xml_parse_interface (shift @$tree, \%interface); }
    elsif ($elem eq "dialing")       { &xml_parse_dialing (shift @$tree, \%dialing); }
    elsif ($elem eq "dialinstalled") { shift @$tree; }
    elsif ($elem eq "smbinstalled")  { shift @$tree; }
    elsif ($elem eq "smartdhcpcd")   { shift @$tree; }
    elsif ($elem eq "gwdevunsup")    { shift @$tree; }
    elsif ($elem eq "profiledb")     { &xml_parse_profiledb (shift @$tree, $hash); }
    else                             { &gst_report ("xml_unexp_tag", $elem); shift @$tree; }
  }

  $$hash{"order"} = \@order unless $#order < 0;
  $$hash{"searchdomain"} = \@searchdomain unless $#searchdomain < 0;
  $$hash{"nameserver"} = \@nameserver unless $#nameserver < 0;
  $$hash{"statichost"} = \%statichost unless scalar keys %statichost == 0;
  $$hash{"interface"} = \%interface unless scalar keys %interface == 0;
  $$hash{"dialing"} = \%dialing unless scalar keys %dialing == 0;
}

# <network><statichost>...</statichost></network>
sub xml_parse_statichost
{
  my ($tree, $statichost) = @_;
  my ($ip, @alias, $elem);

  shift @$tree;

  while ($elem = shift @$tree)
  {
    if    ($elem eq "ip")    { $ip = &gst_xml_get_pcdata (shift @$tree); }
    elsif ($elem eq "alias") { push(@alias, &gst_xml_get_pcdata (shift @$tree)); }
    else                     { &gst_report ("xml_unexp_tag", $elem); shift @$tree; }
  }

  # common regexp for IPv4 and IPv6
  if ($ip =~ /([0-9]+[\.:])+/)
  {
    $$statichost{$ip} = \@alias;
  }
}

sub xml_parse_dialing
{
  my ($tree, $dialing) = @_;
  my (%hash, $name, $elem);

  shift @$tree;
  
  while ($elem = shift @$tree)
  {
    $hash{$elem} = &gst_xml_get_pcdata (shift @$tree);
  }

  $name = $hash{"name"};
  $$dialing{$name} = \%hash;
}

sub xml_parse_profile
{
  my ($tree, $hash) = @_;
  my (%profile);

  &xml_parse_network ($tree, \%profile);

  push @{$hash->{"profiledb"}{"profile"}}, \%profile;
}

sub xml_parse_profiledb
{
  my ($tree, $hash) = @_;

  shift @$tree; # Skip attributes.

  while (@$tree)
  {
    if ($$tree[0] eq "profile") { &xml_parse_profile ($$tree[1], $hash); }
    else
    {
		  &gst_report ("xml_unexp_tag", $$tree[0]);
    }

    shift @$tree;
    shift @$tree;
  }
}

# --- XML printing --- #

sub xml_print_statichost
{
  my ($h) = $_[0];
  my ($statichost, $i, $j, $val);
  
  &gst_xml_print_vspace ();
  foreach $i (keys %{$$h{"statichost"}})
  {
    $statichost = $ {$$h{"statichost"}}{$i};
    &gst_xml_print_line ("<statichost>\n");
    &gst_xml_enter ();
    $val = &gst_xml_quote ($i);
    &gst_xml_print_line ("<ip>$val</ip>\n");
    foreach $j (@$statichost)
    {
      $val = &gst_xml_quote ($j);
      &gst_xml_print_line ("<alias>$val</alias>\n");
    }
    &gst_xml_leave ();
    &gst_xml_print_line ("</statichost>\n");
  }
}

sub xml_print_profiledb
{
  my ($h) = @_;
  my @scalar_keys =
      qw(auto hostname gateway gatewaydev gwdevunsup domain 
         hostmatch workgroup description smbdesc winsserver winsuse smbuse
         smartdhcpcd smbinstalled dialinstalled name);
  my @array_keys =
      qw(nameserver searchdomain order);


  &gst_xml_print_vspace ();

  &gst_xml_print_line ("<profiledb>\n");
  &gst_xml_enter ();
  foreach $i (@{$$h{"profiledb"}{"profile"}})
  {
    gst_xml_print_line ("<profile>\n");
    gst_xml_enter ();

    #print profile contents
    &gst_xml_print_scalars ($i, @scalar_keys);
    &gst_xml_print_arrays ($i, @array_keys);
    &xml_print_statichost ($i);

    &gst_xml_print_hash_hash ($$i{"interface"}, "interface");
    &gst_xml_print_hash_hash ($$i{"dialing"}, "dialing");

    gst_xml_leave ();
    gst_xml_print_line ("</profile>\n");
  }
  gst_xml_leave ();
  gst_xml_print_line ("</profiledb>\n");
}

sub xml_print
{
  my ($h) = @_;
  my @scalar_keys =
      qw(auto hostname gateway gatewaydev gwdevunsup domain 
         hostmatch workgroup smbdesc winsserver winsuse smbuse
         smartdhcpcd smbinstalled dialinstalled);
  my @array_keys =
      qw(nameserver searchdomain order);

  &gst_xml_print_begin ();

  # Hostname, domain, search domains, nameservers.

  &gst_xml_print_scalars ($h, @scalar_keys);
  &gst_xml_print_arrays ($h, @array_keys);
  &xml_print_statichost ($h);

  &gst_xml_print_hash_hash ($$h{"interface"}, "interface");
  &gst_xml_print_hash_hash ($$h{"dialing"}, "dialing");
  &xml_print_profiledb ($h);

  &gst_xml_print_end ();
}


# Reading profiles
sub read_profiledb
{
  my ($hash) = @_;
  my ($path);
  my ($tree);

  $path = gst_file_get_data_path () . "/" . $main::tool->{"name"} . "/" . $profile_file;
  $tree = &gst_xml_scan ($path, $tool);
  if ($tree && scalar @$tree)
  {
    if ($$tree[0] eq 'profiledb')
    {
      xml_parse_profiledb ($$tree[1], $hash);
    }
    else
    {
      gst_report ('xml_unexp_tag', $$tree[0]);
    }
  }
}

# Writing profiles
sub write_profiledb
{
  my ($hash) = @_;
  my $profiledb = $hash->{'profiledb'};
  my $path = &gst_file_get_data_path () . "/" . $main::tool->{'name'} . "/" . $profile_file;

  if ($profiledb) {
    # Write our profiles.
    my $fh = &gst_file_open_write_from_names ($path);
    if ($fh)
    {
      local *STDOUT = $fh;
      &xml_print_profiledb ($hash);
      close ($fh);

      delete $hash->{'profiledb'};
    }
  }
  else
  {
    gst_file_remove ($path);
  }
}


# Top-level actions.
sub get
{
  my $hash;

  # network interface stuff
  $hash = &gst_network_conf_get ();
  &read_profiledb (\%$hash);
  &gst_network_ensure_loopback ($hash);

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


sub set
{
  my $hash;
  
  $hash = &xml_parse ();
  &write_profiledb ($hash);
  &gst_network_conf_set ($hash);
  &gst_report_end ();
}


# --- Filter config: XML in, XML out --- #


sub filter
{
  my $hash;
  
  $hash = &xml_parse ();
  &gst_report_end ();
  &xml_print ($hash);
}


sub enable_iface
{
  my ($tool, $iface, $enabled) = @_;
  my (%dist_attrib, $iface_set);
  my %hash = ("file" => $iface);
  
  %dist_attrib = &gst_network_get_interface_replace_table ();
  $iface_set = $dist_attrib{"iface_set"};
  &$iface_set (\%hash, undef, $enabled, 1);
  # Don't forget to do gst_end when the reports are over!
  &gst_report_end ();
  # XML output would come here, but this directive returns no XML.
}


sub list_ifaces
{
  my ($tool) = @_;
  my ($ifaces, $iface, @arr);

  $ifaces = &gst_network_interfaces_get_info ();
  
  foreach $iface (keys %$ifaces)
  {
    push @arr, $$ifaces{$iface};
  }
  
  &gst_report_end ();
  &gst_xml_print_begin ("network-ifaces");
  &gst_xml_print_structure (\@arr, "interface");
  &gst_xml_print_end ("network-ifaces");
}

sub detect_modem
{
  my ($tool) = @_;
  my (%hash);

  $$hash {"device"} = &gst_network_autodetect_modem ();
  &gst_report_end ();
  
  &gst_xml_print_begin ("network-modem-device");
  &gst_xml_print_hash ($hash);
  &gst_xml_print_end ("network-modem-device");
}


# --- 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,       [], "" ],
  "list_ifaces"  => [ \&list_ifaces,  [],
                      "List interfaces and active/inactive status." ],
  "enable_iface" => [ \&enable_iface, [ "interface", "enabled" ],
                      "Immediatly enable or disable a given interface. " .
                      "interface is the file tag value, enabled is 1 or 0." ],
  "detect_modem" => [ \&detect_modem, [], "Detects the modem device." ]
};

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