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

# Memory configurator. 
# Designed to be architecture- and distribution independent.
#
# Copyright (C) 2000-2001 Ximian, Inc.
#
# Authors: Bradford Hovinen <hovinen@ximian.com>, Tambet Ingo <tambet@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/fstab /proc/meminfo

# Running programs affected/used:
#
# swapon swapoff mkswap fdisk dd

# --- Common stuff --- #


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";
}


$DEBUG = 1; # 1 == command; no debug. 2 == no commands, just report. 3 == report and command.

# --- Tool information --- #

$name = "memory";
$version = "@VERSION@";
@platforms = ("redhat-5.2", "redhat-6.0", "redhat-6.1", "redhat-6.2", "redhat-7.0",
              "redhat-7.1", "redhat-7.2",

              "mandrake-7.2",

              "debian-2.2", "debian-woody",
              
              "suse-7.0", "turbolinux-7.0");

$description =<<"end_of_description;";
Configures main and swap memory.
end_of_description;

$progress_max = 3;


# --- 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.

@fstab_names =       ( "/etc/fstab" );
@meminfo_names = ( "/proc/meminfo" );

# Where are the tools?

$cmd_swapon = &gst_file_locate_tool ("swapon");
$cmd_swapoff = &gst_file_locate_tool ("swapoff");
$cmd_mkswap = &gst_file_locate_tool ("mkswap");
$cmd_dd = &gst_file_locate_tool ("dd");


# --- Internal configuration variables --- #

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

@cf_swapinfo = ();
@cf_partition = ();
@cf_memory = ();


# --- XML scanning --- #

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 "memory" 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_size ($$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
{
  &gst_xml_print_begin ();

  foreach $entry (@cf_memory) {
    &gst_xml_print_line ("<memsize>$entry->{MemTotal}</memsize>\n");
    &gst_xml_print_line ("<swapsize>$entry->{SwapTotal}</swapsize>\n");
  }

  &gst_xml_print_vspace ();

  foreach $entry (@cf_partition) {
    &gst_xml_print_line ("<partition>\n");
    &gst_xml_enter;
    &gst_xml_print_line ("<device>$entry->{device}</device>\n");
    &gst_xml_print_line ("<size>$entry->{size}</size>\n");
    &gst_xml_leave;
    &gst_xml_print_line ("</partition>\n");
  }

  &gst_xml_print_vspace ();

  foreach $entry (@cf_swapinfo) {
    &gst_xml_print_line ("<swapdev>\n");
    &gst_xml_enter;
    &gst_xml_print_line ("<device>$entry->{device}</device>\n");
    &gst_xml_print_line ("<enabled state='", 
                         &gst_print_boolean_yesno ($entry->{enabled}), 
                         "'/>\n");
    &gst_xml_print_line ("<priority>$entry->{priority}</priority>\n");
    &gst_xml_print_line ("<isfile state='",
                         &gst_print_boolean_truefalse ($entry->{is_file}),
                         "'/>\n");
    &gst_xml_print_line ("<size>$entry->{size}</size>\n");
    &gst_xml_print_line ("<isnew state='",
                         &gst_print_boolean_truefalse ($entry->{is_new}),
                         "'/>\n");
    &gst_xml_leave;
    &gst_xml_print_line ("</swapdev>\n\n");
  }

  &gst_xml_print_end ();
}


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

sub get_memory
{
  my (@meminfo);
  my ($totmem);
  my ($totswap);
  my $ifh;
  local *FILE;

  $ifh = &gst_file_open_read_from_names(@meminfo_names);
  if (not $ifh) { return; } # We didn't find it.
  *FILE = $ifh;

  @meminfo = <FILE>;
  close FILE;

  foreach $entry (@meminfo)
  {
    if ($entry =~ /^MemTotal:(\s+)(\w+)/)
    {
      $totmem = sprintf ("%.1fMB", $2 / 1024);	# In Mb, integer
    }
    elsif ($entry =~ /^SwapTotal:(\s+)(\w+)/)
    {
      $totswap = sprintf ("%.1fMB", $2 / 1024);
    }
  }

  push @cf_memory, {
		"MemTotal" => $totmem,
		"SwapTotal" => $totswap
      };
}


sub get_fdisk
{
  # Okay, so this is strictly not portable either. Patches welcome.

  my @check_devs = ( "/dev/hda", "/dev/hdb", "/dev/hdc", "/dev/hdd",

                     "/dev/sda", "/dev/sdb", "/dev/sdc", "/dev/sdd",
                     "/dev/sde", "/dev/sdf",
                     
                     "/dev/eda", "/dev/edb", "/dev/edc", "/dev/edd",
                     
                     "/dev/xda", "/dev/xdb" );

  for $dev (@check_devs)
  {
    my ($disk, $device, $point, $fs, $options, $check, $size, $bootable, $fd);
    
    &gst_report ("disks_partition_probe", $dev);

    $fd = &gst_file_run_pipe_read ("fdisk -l $dev");
    while (<$fd>)
    {
      if (/^\/dev/)
      {
        @line = split(/[ \n\r\t]+/, $_);

        $device = $line[0]; shift @line;
        ($disk) = ($device =~ /([a-zA-Z\/]+)/);

        shift @line; shift @line;  # Start and end clusters.

        ($size) = ($line[0] =~ /([0-9]+)/);
        $size = sprintf ("%.1fMB", $size / 1024);
        shift @line;

        if ($line[0] ne "82") { next; }  # Not Swap
        else
        {
          push @cf_partition, {
            "device" => $device,
            "size" => $size
              };
        }


      }
    }
    &gst_file_close ($fd);

    &gst_report ("disks_size_query", $dev);

#    open(FDISK_HD, "$fdisk_tool -s $dev 2>/dev/null |");
#    ($size) = (<FDISK_HD> =~ /([0-9]+)/);
#    if ($size eq "") { next; }
#    close(FDISK_HD);

  }
}



sub get_swap_size
{
  my ($device) = $_[0];
  my ($is_file) = $_[1];
  my ($size) = 0;

  if ($is_file && -f $device)
  {
    # Is file, &get file size.
    my (@stats) = stat($device);
    $size = $stats[7];			# size in stat structure.
    $size = $size /1024 / 1024;		# Size from bytes to Mb.
    $size .= "MB";
  }
  elsif ($is_file == 0)
  {
    my $fd;
    
    # Is partition, &get size.
    $fd = &gst_file_run_pipe_read ("fdisk -s $device");
    while (<$fd>)
    {
      if (/^\w+/)
      {
        $size = sprintf("%.1fMB", $_ / 1024);		#size from Kb to Mb
      }
    }
    &gst_file_close ($fd);
  }

  return $size;
}


sub get_swap_entries
{
  my $fstab_file;
  local *FSTAB_FILE;

  $fstab_file = &gst_file_open_read_from_names (@fstab_names);
  if (!$fstab_file) { return; }
  *FSTAB_FILE = $fstab_file;

  while (<FSTAB_FILE>)
  {
    my ($device, $mount_pt, $type, $options, $fs_freq, $fs_passno) = split;
    my (@option_list) = split /\,/, $options;
    my ($priority) = -1;
    my ($enabled);
    my ($size);
    my ($is_new) = 0;
    my ($is_file) = 1;

    next if $type ne 'swap';

    &gst_report ("memory_swap_found", $device);

    if ($device =~ /^\#(.*)/)
    {
      $device = $1;
      $enabled = 0;
    }
    else 
    {
      $enabled = 1;
    }

    if ($device =~ /^(\#?)\/dev\//)
    {
      $is_file = 0;
    }
    
    $size = &get_swap_size($device, $is_file);

    foreach $item (@option_list)
    {
      my ($key, $value) = split /\=/, $item;

      $priority = $value if $key eq 'pri';
    }

    push @cf_swapinfo, { 
      "device" => $device, 
      "enabled" => $enabled, 
      "priority" => $priority,
      "is_file" => $is_file,
      "size" => $size,
      "is_new" => $is_new
        };
  }
}


sub get
{
  &gst_report ("memory_swap_probe");

  &get_memory; &gst_print_progress();
  &get_fdisk;  &gst_print_progress();
  &get_swap_entries; &gst_print_progress();
  
  &gst_report_end ();
  &xml_print ();
}


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

sub setup_swap_files
{
  my $command;

  $command = "$cmd_swapoff -a";  # To make sure removed swap spaces &get removed
  &gst_file_run ($command);
  
  my $num_done = 0;

  foreach $entry (@cf_swapinfo)
  {
    if ($entry->{is_new})
    {
      if ($entry->{is_file})
      {
        my ($size) = $entry->{size};
        $size =~ tr/MB$//d;	# Remove Mb from the end
        $size *= 1024;		# Make it to Kb

        $command = "$cmd_dd if=/dev/null of=$entry->{device} bs=1024 count=$size";
        &gst_file_run ($command);
      }

      $command = "$cmd_mkswap $entry->{device} >/dev/null 2>/dev/null";
      &gst_file_run ($command);
    }

    elsif ($entry->{is_file})
    {
      my ($size) = $entry->{size};
      $size =~ tr/MB$//d;	# Remove Mb from the end
      $size *= 1024;		# Make it to Kb

      if ($size != $entry->{size})
      {
        $command = "$cmd_dd if=/dev/zero of=$entry->{device} bs=1024 count=$size";
        &gst_file_run ($command);

        $command = "$cmd_mkswap $entry->{device} >/dev/null 2>/dev/null";
        &gst_file_run ($command);
      }
    }

    if ($entry->{priority} == -1)
    {
      $priority = "";
    }
    else
    {
      $priority = "-p $entry->{priority}";
    }

    if ($entry->{enabled})
    {
      $command = "$cmd_swapon $entry->{device} $priority >/dev/null 2>/dev/null";
      &gst_file_run ($command);
    }
    
    $num_done++;
    &gst_progress(90 / ($#cf_swapinfo - $num_done + 2));
  }
}

sub set_swap_entries
{
  my ($fstab_in_file, $fstab_out_file);
  local (*FSTAB_IN_FILE, *FSTAB_OUT_FILE);
  my (@lines);
  my ($priority_str);

  ($fstab_in_file, $fstab_out_file) = 
      &gst_file_open_filter_write_from_names (@fstab_names);
  if (!$fstab_out_file) { return; }
  *FSTAB_IN_FILE = $fstab_in_file; *FSTAB_OUT_FILE = $fstab_out_file;

  while (<FSTAB_IN_FILE>)
  {
    my ($device, $mount_pt, $type, $options, $fs_freq, $fs_passno) = 
        split /\s+/;

    print FSTAB_OUT_FILE if $type ne 'swap';
  }

  foreach $entry (@cf_swapinfo)
  {
    if ($entry->{priority} >= 0) 
	  {
	    $priority_str = sprintf "pri=%-11u", $entry->{priority};
	  }
    else
	  {
	    $priority_str = "defaults       ";
	  }

    print FSTAB_OUT_FILE "#" if !$entry->{enabled};
    printf FSTAB_OUT_FILE 
        "%-23s swap                    swap    %s 0 0\n",
        $entry->{device},
        $priority_str;
  }

  close FSTAB_FILE;
}


sub set
{
  &xml_parse ();
  
  if ($gst_do_immediate)
  {
    &setup_swap_files;
  }

  &set_swap_entries;
  &gst_report_end ();
}


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


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


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

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