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

# Hardware configurator. 
# Designed to be architecture- and distribution independent.
#
# Version 0.0.1 - copyright (C) 2000-2001 Ximian, Inc.
#
# Authors: Bradford Hovinen <hovinen@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.

# Best viewed with 100 columns of width.

# Configuration files affected:
#
# /etc/conf.modules /etc/X11/XF86Config /etc/isapnp.conf /dev/*

# Running programs affected/used:
#
# /sbin/modprobe /sbin/rmmod /sbin/depmod /bin/uname /sbin/mknod
# /bin/&setserial

# Other files used for information:
#
# /proc/devices /proc/cpuinfo /proc/ioports /proc/interrupts /proc/dma
# /proc/modules /proc/bus/pci/* /proc/ide/* /proc/scsi/*


# Note:
#
#   This backend program is just the tip of the iceberg -- there are
#   many, many more parts to this under the hood. We're probably going
#   to have to institute a system whereby there exist multiple
#   configuration scriptlets in a particular directory, one for each
#   class of hardware (e.g., IDE devices, video cards, serial ports),
#   so that the user can install configuration scripts for new
#   hardware types easily.


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


# --- Tool information --- #

$name = "hardware";
$version = "@VERSION@";

$description =<<"end_of_description;";
       Configures hardware.
end_of_description;


# --- System config file locations --- #

# We list each config file type with as many alternate locations as possible.
# They are tried in array order. First found = used.

@conf_modules_names =       ( "/etc/conf.modules", "/etc/modules.conf" );
@XF86Config_names =         ( "/etc/X11/XF86Config" );

# --- Internal configuration variables --- #

# Configuration is parsed/read to, and printed/written from, these
# temporary variables.

# Hash of hardware devices, keyed by kernel identifier
# Each entry is a hash with the following data:
#
#   id - kernel-level identifier (e.g. ide0, psaux, eth0, etc.)
#   type - type of device: `Serial Port', `Video Adaptor', etc.
#   vendor - self-explanatory
#   model - ditto
#   driver - kernel module or XFree86 driver, if any
#   bus - connection - ISA, PCI, IDE, SCSI, USB, etc.
#   {id,target,etc} - identifying characteristics on connection
#   io - I/O port(s) used (array, if any)
#   irq - IRQ(s) used (array, if any)
#   dma - DMA channel(s) used (array, if any)
#   ...and any other defining characteristics, according to the type
#   of device

%cf_hardware = ();

# Hash of modules listed in /etc/conf.modules, indexed by module name
# (or alias). Each entry contains the following data:
#
#   module - module name
#   options - hash of module options as parsed from the options line

%cf_modules = ();

# Hash of items from /etc/isapnp.conf, indexed by something or other

%cf_isapnp = ();

# Array of devices referred to in XF86Config. Each entry is a hash
# that has the device type, the driver, the XF86Config options and the
# XF86Config identifier

%cf_xf86config = ();

# Array of I/O port allocations. Each entry is a hash with the keys
# low, high, and device.

@cf_ioports = ();

# Hash of IRQ allocations. Maps IRQ numbers to arrays of devices

%cf_irq = ();

# Hash of DMA allocations. Maps DMA channel numbers to devices

%cf_dma = ();

# Array of serial ports. Entries are just UARTs

@cf_serial = ();

# Array of parallel ports. Entries are hashes containing the IRQ, DMA,
# and modes

@cf_parallel = ();

# Array of IDE controllers. Entries are just empty arrays for now

@cf_ide = ();

# Array of SCSI controllers. Entries are just empty arrays for now

@cf_scsi = ();

# Array of NICs. Entries are hashes with the id and the MAC address

@cf_nic = ();


# --- XML parsing --- #


# Scan XML from standard input to an internal tree.

sub xml_parse
  {
    # 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 "networking" tag.
    
    while (@$tree)
      {
	if ($$tree[0] eq "memory") { &xml_parse_memory($$tree[1]); }
	
	shift @$tree;
	shift @$tree;
      }
    
    return($tree);
  }


# <memory>...</memory>

sub xml_parse_memory
  {
    my $tree = $_[0];
    
    shift @$tree;		# Skip attributes.
    
    while (@$tree)
      {
	if ($$tree[0] eq "swapdev") 
	  { 
	    push @cf_swapinfo, &xml_parse_swapinfo ($$tree[1]); 
	  }
	
	shift @$tree;
	shift @$tree;
      }
  }


# <swap-device>...</swap-device>

sub xml_parse_swapinfo
  {
    my $tree = $_[0];
    my $node;
    my $entry = {};
    
    shift @$tree;		# Skip attributes.
    
    while (@$tree)
      {
	if ($$tree[0] eq 'device') 
	  { 
	    $entry->{device} = &gst_xml_get_word ($$tree[1]);
	  }
	elsif ($$tree[0] eq 'enabled') 
	  {
	    $node = $$tree[1];
	    $entry->{enabled} = &gst_util_read_boolean ($$node[0]->{state});
	  }
	elsif ($$tree[0] eq 'priority') 
	  { 
	    $entry->{priority} = &gst_xml_get_word ($$tree[1]);
	  }
	elsif ($$tree[0] eq 'size') 
	  { 
	    $entry->{size} = &gst_xml_get_word ($$tree[1]);
	  }
	elsif ($$tree[0] eq 'isfile') 
	  { 
	    $node = $$tree[1];
	    $entry->{is_file} = &gst_util_read_boolean ($$node[0]->{state});
	  }
	elsif ($$tree[0] eq 'isnew') 
	  { 
	    $node = $$tree[1];
	    $entry->{is_new} = &gst_util_read_boolean ($$node[0]->{state});
	  }
	
	shift @$tree;
	shift @$tree;
      }

    return $entry;
  }


# --- XML printing --- #


sub xml_print
  {
    print "<?xml version='1.0' encoding='UTF-8' standalone='yes'?>\n";
    print "<!DOCTYPE memory []>\n\n";
    print "<hardware>\n";
    &gst_xml_enter ();

    &gst_xml_print_vspace ();
    &gst_xml_print_line ("<!-- Configuration starts here -->\n");
    &gst_xml_print_vspace ();

    foreach $entry (@cf_hardware)
      {
	&gst_xml_print_line ("<device id='$entry->{id}'>\n");

      LOOP: while (($key, $value) = each %$entry)
	  {
	    next if $key eq 'id';
	    next if $key eq 'io';

	  SWITCH: 
	    {
	      $_ = $key;
	      /^ports/ && do 
		{
		  &gst_xml_enter;
		  foreach $range (@$value)
		    {
		      &gst_xml_print_line ("<io low='$range->{low}' high='$range->{high}'/>\n");
		    }
		  last SWITCH;
		};
	      /^interrupts/ && do 
		{
		  foreach $number (@$value)
		    {
		      &gst_xml_print_line ("<interrupt number='$number'/>\n");
		    }
		  last SWITCH;
		};
	      /^dma/ && do 
		{
		  foreach $channel (@$value)
		    {
		      &gst_xml_print_line ("<dma channel='$channel'/>\n");
		    }
		  last SWITCH;
		};
	      /^modes/ && do
		{
		  foreach $mode (@$value)
		    {
		      &gst_xml_print_line ("<mode>$mode</mode>\n");
		    }
		  last SWITCH;
		};
	      (/^id/ || /^io/ || /^irq/) && next LOOP;

	      &gst_xml_print_line ("<$key>$value</$key>\n");
				&gst_xml_leave;
	    }
	  }

	&gst_xml_print_line ("</device>\n");
	&gst_xml_print_vspace ();
      }

    &gst_xml_print_line ("<!-- End of configuration -->\n");
    &gst_xml_print_vspace ();

    &gst_xml_leave ();
    print "</hardware>\n";
  }


# --- Get (read) config --- #

###############################################################################
# Reading and parsing configuration files, running programs to &get
# configuration info, etc.
###############################################################################

# This is going to choke when one tries to run it on a conf.modules
# with conditionals. Hopefully no one will try to do that until I
# implement that feature.

sub read_conf_modules
  {
    local (*CONF_MODULES_FILE);
    my (%real_names);

    *CONF_MODULES_FILE = &gst_file_open_read_from_names (@conf_modules_names);

  LINE: while (<CONF_MODULES_FILE>)
      {
	/^alias\s+([^\s]+)\s+([^\s]+)\n$/ && do
	  {
	    next LINE if $cf_modules{$1};   # Already exists????
	    $cf_modules{$1} = 
	      { 'module' => $2, 'options' => $cf_modules{$2}->{options} };
	    $real_names{$2} = $1;
	    delete $cf_modules{$2};
	    next LINE;
	  };
	/^options\s+([^\s]+)\s+(.*)\n$/ && do
	  {
	    $module_name = $1;
	    $module_name = $real_names{$1} if defined $real_names{$1};
	    $cf_modules{$module_name}->{options} = { split /\s+|=/, $2 };
	    next LINE;
	  };
      }

    close CONF_MODULES_FILE;
  }

sub read_isapnp_conf
  {
  }

# Section handlers

sub handle_input_device
  {
    my ($entry);

    $entry->{type} = 'input-device';

    while (<XF86CONFIG_FILE>)
      {
	s/\s*#.*\n$//g;          # Strip out comments
	next if not length;
	last if /EndSection/;

	/Identifier\s+\"([^\"]+)\"/ && do { $entry->{name} = $1; };
	/Driver\s+\"([^\"]+)\"/     && do { $entry->{driver} = $1; };
	/Option\s+\"([^\"]+)\"\s+\"([^\"])\"/ && do 
	  { $entry->{$1} = [ split /\s+/, $2 ]; };
      }

    return $entry;
  }

sub read_XF86Config
  {
    local (*XF86CONFIG_FILE);
    my ($entry);

    my (%section_handler_table) = 
      ( 'InputDevice' => \&handle_input_device );

    *XF86CONFIG_FILE = &gst_file_open_read_from_names (@XF86Config_names);

    while (<XF86CONFIG_FILE>)
      {
	s/\s*#.*\n$//g;          # Strip out comments
	next if not length;
	
	if (/Section\s+\"([^\"]+)\"/)
	  {
	    push @cf_xf86config, &{$section_handler_table{$1}}
	      if exists $section_handler_table{$1};
	  }
      }

    close XF86CONFIG_FILE;
  }

# Read I/O port allocation

sub read_proc_ioports
  {
    local (*IOPORTS_FILE);
    my ($entry);

    open IOPORTS_FILE, "/proc/ioports";

    while (<IOPORTS_FILE>)
      {
	$entry = {};
	($low, $high, $entry->{device}) = 
	  /\A([0-9a-f]{4})-([0-9a-f]{4}) : (.+)\n/;

	$entry->{low} = hex $low;
	$entry->{high} = hex $high;

	push @cf_ioports, $entry;
      }

    close IOPORTS_FILE;
  }

# Read IRQ allocation

sub read_proc_interrupts
  {
    local (*IRQ_FILE);
    my ($irq, $device);

    open IRQ_FILE, "/proc/interrupts";

    while (<IRQ_FILE>)
      {
	($irq, $device) =
	  /^\s+(\d+):\s+\d+\s+[a-zA-Z\-]+\s+(.+)\n/;
	$cf_irq{$irq} = [split /, /, $device]
	  if defined $irq;
      }

    close IRQ_FILE;
  }

# Read DMA allocation

sub read_proc_dma
  {
    local (*DMA_FILE);
    my ($channel, $device);

    open DMA_FILE, "/proc/interrupts";

    while (<DMA_FILE>)
      {
	($channel, $device) =
	  /\A\s+(\d+):\s+(.+)\Z/;
	$cf_dma{$channel} = [split /, /, $device];
      }

    close DMA_FILE;
  }

# Read PCI bus device information

sub read_proc_pci
  {
  }

# Read IDE information

sub read_proc_ide
  {
    local (*CONTROLLER_DIR);

    opendir CONTROLLER_DIR, "/proc/ide";

    if (*CONTROLLER_DIR)
      {
	foreach $i (readdir (CONTROLLER_DIR))
	  {
	    next if not $i =~ /ide(\d+)/;
	    $cf_ide[$1] = { 'id' => "ide$1" };
	  }
      }

    closedir (CONTROLLER_DIR);
  }

# Read SCSI information

sub read_proc_scsi
  {
  }

# Read parallel port information

sub read_proc_parport
  {
    my ($entry, $line);
    local (*PARPORT_DIR);

    opendir PARPORT_DIR, "/proc/parport";
    return if !PARPORT_DIR;

    foreach $i (readdir (PARPORT_DIR))
      {
	next if not $i =~ /\d+/;
	$entry = {'id' => "parport$i"};

	open PARPORT_FILE, "/proc/parport/$i/hardware";

	LINE: while (<PARPORT_FILE>)
	  {
	    /^base:[\s]+(0x[0-9a-f]+)/ && do { $entry->{io} = [$1]; next LINE; };
	    /^irq:[\s]+(none|[0-9]+)/  && do { $entry->{irq} = [$1] if $1 ne 'none'; next LINE; };
	    /^dma:[\s]+(none|[0-9]+)/  && do { $entry->{dma} = [$1] if $1 ne 'none'; next LINE; };
	    /^modes:[\s]+([\d\w,]+)/   && do { $entry->{modes} = [split /,/, $1]; next LINE; };
	  }

	push @cf_parallel, $entry;

	close PARPORT_FILE;
      }

    closedir PARPORT_DIR;
  }

# Find all serial ports by running &setserial -g on /dev/ttyS*

sub get_serial_ports
  {
    my ($entry, $line);

    foreach $i ('/dev/ttyS0', '/dev/ttyS1', '/dev/ttyS2', '/dev/ttyS3')
      {
	$line = `&setserial -g $i`;
	$entry = {};
	($entry->{id}, $entry->{uart}, $port, $irq) =
	  ($line =~ /\/dev\/(ttyS[0-9]+), UART: ([0-9A-Za-z]+), Port: (0x[0-9a-f]+), IRQ: ([0-9]+)/);
	next if $entry->{uart} eq 'unknown';

	$entry->{type} = 'Serial Port';
	$entry->{io} = [hex $port];
	$entry->{irq} = [$irq];
	push @cf_serial, $entry;
      }
  }

# Find all network interfaces by running /sbin/ifconfig

sub get_network_interfaces
{
  my ($fd);

  $fd = &gst_file_run_pipe_read ("ifconfig -a");
  
  while (<$fd>)
  {
    if (/^([\w\d]+)/)
	  {
	    next if $1 eq 'lo';
	    $entry = { 'id' => $1 };
	    /HWaddr (([A-F\d]{2}:){5}[A-F\d]{2})/ && do { $entry->{macaddr} = $1; };
	    /Link encap:(\w+|(\w+\s)+\w+)/ && do { $entry->{type} = $1; };
	    push @cf_nic, $entry;
	  }
  }

  &gst_file_close ($fd);
}

# Find the record in the io ports list that contains a given I/O
# port. Check to make sure it actually matches the given device.

sub find_port_record
  {
    my ($port, $device) = @_;

    foreach $entry (@cf_ioports)
      {
	if ($port >= $entry->{low} and $port <= $entry->{high})
	  {
	    $entry->{error} = 1 if $device && $device ne $entry->{device};
	    return $entry;
	  }
      }

    return undef;
  }

# Combine all the hardware configuration into one `master list',
# finding any descrepencies and reporting them

sub combine
  {
    my (%hardware);
    my ($index);
    my (@words) = ('Primary', 'Secondary', 'Tertiary', 'Quaternary');

    $index = 0;

    foreach $entry (@cf_serial)
      {
	next if not $entry->{id};

	$hardware{$entry->{id}} = 
	  {
	   'type' => "Serial port",
	   'id' => $entry->{id},
	   'ports' => [ &find_port_record ($entry->{io}->[0], $entry->{id}) ],
	   'interrupts' => $entry->{irq},
	   'name' => "$words[$index] serial port"
	  };

	$index++;
      }

    $index = 0;

    foreach $entry (@cf_parallel)
      {
	next if not $entry->{id};

	$hardware{$entry->{id}} =
	  {
	   'type' => "Parallel port",
	   'id' => $entry->{id},
	   'ports' => [ &find_port_record ($entry->{io}->[0], $entry->{id}) ],
	   'interrupts' => $entry->{irq},
	   'name' => "$words[$index] parallel port"
	  };

	$index++;
      }

    $index = 0;

    foreach $controller (@cf_ide)
      {
	next if not $controller->{id};

	$entry = 
	  { 
	   'type' => "Disk controller", 
	   'id' => $controller->{id}, 
	   'ports' => [], 
	   'interrupts' => [],
	   'name' => "$words[$index] IDE disk controller"
	  };

	$hardware{$entry->{id}} = $entry;
	$index++;
      }

    $index = 0;

    foreach $nic (@cf_nic)
      {
	next if not $nic->{id};

	$entry =
	  {
	   'type' => "Network interface card",
	   'id' => $nic->{id},
	   'subtype' => $nic->{type},
	   'macaddr' => $nic->{macaddr},
	   'ports' => [],
	   'interrupts' => [],
	   'dma' => [],
	   'name' => "$words[$index] network interface card",
	  };

	$hardware{$entry->{id}} = $entry;
	$index++;
      }

    $index_kbd = 0;
    $index_mouse = 0;

    foreach $device (@cf_xf86config)
      {
	if ($device->{driver} eq 'keyboard')
	  {
	    $entry =
	      {
	       'type' => "Keyboard",
	       'id' => "XFree86:$device->{name}",
	       'driver' => $device->{driver},
	       'name' => "$words[$index_kbd] keyboard"
	      }
	  }
	elsif ($device->{driver} eq 'mouse')
	  {
	    next;
	  }

	$hardware{$entry->{id}} = $entry;
	$index_kbd++;
	$index_mouse++;
      }

    foreach $entry (@cf_ioports)
      {
	&gst_push_unique ($hardware{$entry->{device}}->{ports}, $entry)
	  if exists $hardware{$entry->{device}};
      }

    while (($irq, $devices) = each %cf_irq)
      {
	foreach $device (@$devices)
	  {
	    &gst_push_unique ($hardware{$device}->{interrupts}, $irq)
	      if exists $hardware{$device};
	  }
      }

    while (($channel, $devices) = each %cf_dma)
      {
	foreach $device (@$devices)
	  {
	    &gst_push_unique ($hardware{$device}->{dma}, $channel)
	      if exists $hardware{$device};
	  }
      }

    @cf_hardware = values %hardware;
  }

sub get
  {
    if ($gst_verbose) 
      { 
	print STDERR "Getting system configuration, generating XML output.\n";
      }
    
    if ($gst_verbose) { print STDERR "Getting swap entries.\n"; }

    # For each basic type of device, read all the information about it
    # from all the different sources. FIXME: Perhaps we should read in
    # some commonly-used files, like conf.modules and /proc/* first.
    
    # We're going to replace this with a more extensible, modular
    # system soon, but for now, we'll just hardcode everything.

    &read_conf_modules;
    &read_isapnp_conf;
    &read_XF86Config;
    &read_proc_ioports;
    &read_proc_interrupts;
    &read_proc_dma;
    &read_proc_pci;
    &read_proc_ide;
    &read_proc_scsi;
    &read_proc_parport;
    &get_serial_ports;
    &get_network_interfaces;

    &combine;

    if ($gst_verbose) { print STDERR "Printing XML.\n"; }
    &xml_print ();
  }


# --- Set (write) config --- #



sub set
  {
    if ($gst_verbose) 
      { 
	print STDERR "Setting system configuration from XML input.\n"; 
      }

    if ($gst_verbose) { print STDERR "Parsing XML.\n"; }
    &xml_parse ();
    
    if ($gst_do_immediate)
      {
	if ($gst_verbose) 
	  { 
	    print STDERR 
	      "Changing running configuration via local utilities.\n"; 
	  }
# Set configuration here
      }
  }


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


sub filter
  {
    &xml_parse ();
    &xml_print ();
  }


# --- Main --- #

# Process options.

while (@ARGV)
  {
    if    ($ARGV[0] eq "--get"    || $ARGV[0] eq "-g") { &gst_set_operation("get"); }
    elsif ($ARGV[0] eq "--set"    || $ARGV[0] eq "-s") { &gst_set_operation("set"); }
    elsif ($ARGV[0] eq "--filter" || $ARGV[0] eq "-f") { &gst_set_operation("filter"); }
    elsif ($ARGV[0] eq "--help"   || $ARGV[0] eq "-h") { print STDERR $Usage; exit(0); }
    elsif ($ARGV[0] eq "--prefix" || $ARGV[0] eq "-p")
      {
	if ($gst_prefix ne "")
	  {
	    print STDERR "Error: You may specify --prefix only once.\n\n";
	    print STDERR $Usage; exit(1);
	  }
	
	$gst_prefix = $ARGV[1];
	
	if ($gst_prefix eq "")
	  {
	    print STDERR "Error: You must specify an argument to the --prefix option.\n\n";
	    print STDERR $Usage; exit(1);
	  }
	
	shift @ARGV;		# For the argument.
      }
    elsif ($ARGV[0] eq "--disable-immediate")           { $gst_do_immediate = 0; }
    elsif ($ARGV[0] eq "--verbose" || $ARGV[0] eq "-v") { $gst_verbose = 1; }
    else
      {
	print STDERR "Error: Unrecognized option '$ARGV[0]'.\n\n";
	print STDERR $Usage; exit(1);
      }

    shift @ARGV;
  }


# Do our thing.

# 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, [], "" ]
    };

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