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

# Boot manager configurator. Designed to be architecture and distribution independent.
#
# Copyright (C) 2000-2001 Ximian, Inc.
#
# Authors: 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.


require "___scriptsdir___/general.pl";
require "___scriptsdir___/util.pl";
require "___scriptsdir___/file.pl";
require "___scriptsdir___/xml.pl";
require "___scriptsdir___/parse.pl";
require "___scriptsdir___/replace.pl";

use strict;

my @global_vars = qw (default prompt timeout append root);
my @common_image_vars = qw (label);
my @image_vars = (@common_image_vars, qw (image append root));
my @other_vars = (@common_image_vars, qw (other table));


sub xst_boot_known_var
{
  my $key = shift;
  my $list = shift;
  my $from_xml = shift;

  if (ref ($list) ne "ARRAY")
  {
    # TODO: Give warning;
    return 0;
  }

  $key = lc ($key);
  
  # Hard coded know variables which are not standard lilo.conf variables.
  return 1 if ($key eq 'xstimagetype');
  return 1 if ($key eq 'key' && !$from_xml); # 'key' is valid in xml only.
  
  return &xst_item_is_in_list ($key, @$list);
}

sub xst_boot_parse_global_kw
{
  my ($file, $key) = @_;
  my $fd;

  return undef unless &xst_boot_known_var ($key, \@global_vars, 0);
  
  $fd = &xst_file_open_read_from_names ($file);

  while (<$fd>)
  {
    chomp;
    s/^[ \t]+//;
    next if (/^\#/ || /^$/);
    last if (/^(image|other)/);

    if ($key eq $_)
    {
      close $fd;
      return 1;
    }
  }

  close $fd;
  return undef;
}


sub xst_boot_parse_global
{
  my ($file, $key) = @_;
  my ($fd, $line, $re);

  return undef unless &xst_boot_known_var ($key, \@global_vars, 0);
  
  $re = "[ \t]*=[ \t]*";
  $fd = &xst_file_open_read_from_names ($file);

  while (($line = <$fd>))
  {
    chomp $line;
    $line =~ s/^[ \t]+//;
    $line = &xst_parse_process_sh_line ($line);
    
    next if ($line eq "");
    last if ($line =~ /^(image|other)/);
    my @line = split ($re, $line, 2);

    if (shift (@line) eq $key)
    {
      close $fd;
      return $line[0];
    }
  }

  close $fd;
  return undef;
}

    
sub xst_boot_parse_images
{
  my $file = shift;
  my ($fd, $line, @images);
  my ($line, $known_vars);

  my $found = -1;
  $fd = &xst_file_open_read_from_names ($file);

  while (($line = <$fd>))
  {
    chomp $line;
    $line =~ s/^[ \t]+//;

    if ($line =~ /^image/i)
    {
      $found++;
      $known_vars = \@image_vars;
      $images[$found]{'key'} = $found;
    }
    elsif ($line =~ /^other/i)
    {
      $found++;
      $known_vars = \@other_vars;
      $images[$found]{'key'} = $found;
    }
    
    next if $found < 0;
    
    if ($line =~ /^\#[ \t]*(\w+)/)
    {
      next if $1 ne "XstImageType";

      $line =~ s/^\#[ \t]*//;
    }

    $line = &xst_parse_process_sh_line ($line);
    next if ($line =~ /^$/);
    
    my @line = split ("[ \t]*=[ \t]*", $line, 2);    
    my $key = shift @line;

    # Only deal with known variables
    next unless &xst_boot_known_var ($key, $known_vars, 0);
    
    my $val = shift @line;
    $val =~ s/^[ \t]+//;
    $val =~ s/\"//g;    
    $val =~ s/[ \t]+$//;

    $images[$found]{$key} = $val;
  }

  close $fd;
  return \@images;
}


sub xst_boot_set_global_kw
{
  my ($file, $key) = @_;
  my ($buff, $i, $found);
  my $lineno = 0;

  return 0 unless &xst_boot_known_var ($key, \@global_vars, 0);
  
  $buff = &xst_file_buffer_load ($file);
  $found = 0;

  foreach $i (@$buff)
  {
    if (&xst_ignore_line ($i))
    {
      $lineno++;
      next;
    }

    if ($i =~ /^[ \t]*$key/)
    {
      $found++;
      last;
    }

    if ($i =~ /^[ \t]*(image|other)/)
    {
      $lineno--; # "pop" it back
      last;
    }
    $lineno++;
  }

  # Not found, let's add
  if (!$found)
  {
    # pop back empty lines
    while ($lineno > 0 && $$buff[$lineno] =~ /^\s*$/)
    {
      $lineno--;
    }
    
    $$buff[$lineno] .= $key . "\n";
  } 
  
  &xst_file_buffer_clean ($buff);
  return &xst_file_buffer_save ($buff, $file);
}

sub xst_boot_set_global
{
  my ($file, $key, $val) = @_;
  my ($buff, $i, $found);
  my $quote = '"';
  my $lineno = 0;

  return 0 unless &xst_boot_known_var ($key, \@global_vars, 0);

  $val = "\"$val\"" if ($val =~ /[ \t]/ && (! ($val =~ /^\".+\"$/)));
  $val = "\"$val\"" if ($val =~ /\=/ && (!($val =~ /^\".+\"$/)));
  
  $buff = &xst_file_buffer_load ($file);
  $found = 0;

  foreach $i (@$buff)
  {
    if (&xst_ignore_line ($i))
    {
      $lineno++;
      next;
    }

    if ($i =~ /^[ \t]*(image|other)/)
    {
      $lineno--;
      last;
    }
    
    if ($i =~ /^[ \t]*$key([ \t]*=[ \t]*)/)
    {
      $found++;
      my $op = $1;

      chomp $i;
      
      my $pre_space = $1 if $i =~ s/^([ \t]+)//;
      my $post_comment = $1 if $i =~ s/([ \t]*\#.*)//;

      $i = $pre_space . $key . $op . $val . $post_comment . "\n";
      last;
    }
    
    $lineno++;
  }

  if (!$found)
  {
    # pop back empty lines
    while ($lineno > 0 && $$buff[$lineno] =~ /^\s*$/)
    {
      $lineno--;
    }
    
    $$buff[$lineno] .= $key . " = " . $val . "\n";
  }
  
  &xst_file_buffer_clean ($buff);
  return &xst_file_buffer_save ($buff, $file);
}


sub xst_boot_del_global
{
  my ($file, $key) = @_;
  my ($buff, $i);

  return 0 unless &xst_boot_known_var ($key, \@global_vars, 0);
  
  $buff = &xst_file_buffer_load ($file);

  foreach $i (@$buff)
  {
    last if ($i =~ /^[ \t]*(image|other)/);
    
    if ($i =~ /^[ \t]*$key/)
    {
      $i = "";
      last;
    }
  }
  
  &xst_file_buffer_clean ($buff);
  return &xst_file_buffer_save ($buff, $file);
}


# Scans @buff until finds first line which looks like image.
# Returns line number or -1 if no image found.
sub xst_boot_conf_find_image
{
  my ($buff, $lineno) = @_;
  my $i;

  for (; $lineno <= $#$buff; $lineno++)
  {
    $i = $$buff[$lineno];

    return $lineno if ($i =~ /^[ \t]*(image)|(other)[ \t]*=[ \t]*\S+/);
  }

  # Not found.
  return -1;
}


# Deletes lines from $buff starting from $lineno till the next image
# or till end of the file if no more images left.
sub xst_boot_conf_delete_image
{
  my ($buff, $lineno) = @_;
  my ($end, $i);

  $end = &xst_boot_conf_find_image ($buff, $lineno + 1);
  $end = scalar @$buff if ($end < 0);

  for ($i = $lineno; $i < $end; $i++)
  {
    $$buff[$i] = "";
  }

  return $buff;
}


# Edit image in $buff which starts at $lineno. Get changes from $image.
sub xst_boot_conf_edit_image
{
  my ($image, $buff, $lineno) = @_;

  my $known_vars = \@image_vars if (exists $image->{'image'});
  $known_vars = \@other_vars if (!$known_vars && exists $image->{'other'});
  return $buff unless $known_vars;
  
  my $end = &xst_boot_conf_find_image ($buff, $lineno + 1);
  $end = scalar @$buff if ($end < 0);

  for ($lineno; $lineno < $end; $lineno++)
  {
    # Special case:
    if ($$buff[$lineno] =~ /^[ \t]*(\#)[ \t]*XstImageType/i)
    {
      $$buff[$lineno] =~ s/$1//;
    }
    
    # Get the variable.
    my $key = $1 if ($$buff[$lineno] =~ /^[ \t]*([\w\-]+)/);
    next if ($key && (!&xst_boot_known_var ($key, $known_vars, 0)));    
    next unless $key;

    unless (exists ($image->{$key}))
    {
      # Keyword is known, but isn't in image.
      delete $$buff[$lineno];
      next;
    }

    # Read old value
    my $old_val = $$buff[$lineno];
    $old_val =~ s/^[ \t]*$key[ \t]*=[ \t]*//; #everything till value
    $old_val =~ s/[ \t]*\#.*$//;              #post comment;
    chomp $old_val;

    if ($old_val)
    {
      # String.
      my $val = $image->{$key};
      $val = "\"$val\"" if ($val =~ /[ \t]/ && (! ($val =~ /^\".+\"$/)));
      $val = "\"$val\"" if ($val =~ /\=/ && (!($val =~ /^\".+\"$/)));

      $$buff[$lineno] =~ s/$old_val/$val/;
      $$buff[$lineno] = "#" . $$buff[$lineno] if ($key =~ /XstImageType/i);
    }
    
    delete $image->{$key};
  }

  # Add new fields.
  foreach my $key (keys %$image)
  {
    next unless &xst_boot_known_var ($key, $known_vars, 1);
    
    my $val = $image->{$key};
    $val = "\"$val\"" if ($val =~ /[ \t]/ && (! ($val =~ /^\".+\"$/)));
    $val = "\"$val\"" if ($val =~ /\=/ && (!($val =~ /^\".+\"$/)));

    my $line = "\t$key";
    $line .= " = $val" if $val;
    $line .= "\n";
    $line = "#" . $line if ($key =~ /XstImageType/i);
    
    $$buff[$end -1] .= $line;
  }
}


# Add $image to the end of $buff.
sub xst_boot_conf_add_image
{
  my ($image, $buff) = @_;
  my ($line, $key, $value, $known_vars);

  # Image line
  if (exists $image->{'image'})
  {
    $known_vars = \@image_vars;
    $value = 'image';
  }
  elsif (exists $image->{'other'})
  {
    $known_vars = \@other_vars;
    $value = 'other';
  }
  else
  {
    return;
  }

  $line = $value . " = " . $$image{$value} . "\n";
  push @$buff, $line;
  delete $$image{$value};

  # Parameters for image
  foreach $key (keys %$image)
  {
    next unless &xst_boot_known_var ($key, $known_vars, 1);
    
    $value = $$image{$key};
    $value = "\"$value\"" if ($value =~ /[ \t]/ && (!($value =~ /^\".+\"$/)));
    $value = "\"$value\"" if ($value =~ /\=/&& (!($value =~ /^\".+\"$/)));

    $line = "";
    $line = "# " if $key eq "XstImageType";
    $line .= "\t$key";
    
    $line .= " = " . $value if $value;
    $line .= "\n";

    push @$buff, $line;
  }
}

sub xst_boot_conf_set_images
{
  my ($file, $key, $images) = @_;
  my ($buff, $lineno, $found, $image);

  return if (scalar @$images <= 0);
  
  $buff = &xst_file_buffer_load ($file);
  &xst_file_buffer_join_lines ($buff);

  my $image_nr = -1;
  $lineno = &xst_boot_conf_find_image ($buff, 0);
  while ($lineno > 0)
  {
    $image_nr++;
    $found = 0;
    foreach $image (@$images)
    {
      next unless $image;

      if (exists ($image->{'key'}))
      {
        $found++ if $image->{'key'} == $image_nr;
          
        if ($found > 0)
        {
          # Found image, change it if neccecary,
          # remove %image from @images and find new image.
          &xst_boot_conf_edit_image ($image, $buff, $lineno);
          $image = undef;
          last;
        }
      }
    }

    # Found image wasn't in our @images list: delete.
    $buff = &xst_boot_conf_delete_image ($buff, $lineno) if ($found <= 0);

    # Search new image line.
    $lineno = &xst_boot_conf_find_image ($buff, $lineno + 1);
  }

  # At this point @images contains only new images, let's add them.
  foreach $image (@$images)
  {
    &xst_boot_conf_add_image ($image, $buff);
  }

  &xst_file_buffer_clean ($buff);
  return &xst_file_buffer_save ($buff, $file);
}


sub xst_boot_replace_from_table
{
  my ($fn, $table, $values_hash) = @_;
  my ($key, $proc, @param);
  my ($i, @cp, $res, $res2);

  foreach $i (@$table)
  {
    @cp = @$i;
    $key = shift (@cp);
    if (exists $$values_hash{$key})
    {
      $proc = shift (@cp);
      $cp[0] = $$fn{$cp[0]} if $cp[0] ne undef;
      push (@cp, $$values_hash{$key});
      
      $res = -1 if &$proc (@cp);
    }
    else
    {
      &xst_boot_del_global ("/etc/lilo.conf", $key);
    }
  }

  return $res;
}


sub xst_boot_conf_set
{
  my $values_hash = $_[0];

  my %dist_map =
  (
   "redhat-6.0" => "redhat-6.2",
   "redhat-6.1" => "redhat-6.2",
   "redhat-6.2" => "redhat-6.2",
   "redhat-7.0" => "redhat-6.2",
   "redhat-7.1" => "redhat-6.2",

   "mandrake-7.1" => "redhat-6.2",
   "mandrake-7.2" => "redhat-6.2",
   
   "debian-2.2"   => "redhat-6.2",
   "debian-woody" => "redhat-6.2",

   "suse-7.0"     => "redhat-6.2",

   "turbolinux-7.0" => "redhat-6.2"
  );
  
  my %dist_tables =
      (
       "redhat-6.2" => {
         fn => { 'LILO_CONF' => "/etc/lilo.conf"},
         table => [
                   [ 'prompt',   \&xst_boot_set_global_kw,   'LILO_CONF', 'prompt' ],
                   [ 'root',     \&xst_boot_set_global,      'LILO_CONF', 'root' ],
                   [ 'timeout',  \&xst_boot_set_global,      'LILO_CONF', 'timeout' ],
                   [ 'default',  \&xst_boot_set_global,      'LILO_CONF', 'default' ],
                   [ 'append',   \&xst_boot_set_global,      'LILO_CONF', 'append' ],
                   [ 'images',   \&xst_boot_conf_set_images, 'LILO_CONF', 'image' ],
                   ] 
                     }
       );

  my $table = $dist_map{$main::xst_dist};
  if (!$table)
  {
      &xst_report ("platform_no_table", $main::xst_dist);
      return undef;
  }
  
  return &xst_boot_replace_from_table ($ {$dist_tables{$table}}{"fn"},
						  $ {$dist_tables{$table}}{"table"}, $values_hash);

}


sub xst_boot_conf_get
{
  my %dist_map =
  (
   "redhat-6.0" => "redhat-6.2",
   "redhat-6.1" => "redhat-6.2",
   "redhat-6.2" => "redhat-6.2",
   "redhat-7.0" => "redhat-6.2",
   "redhat-7.1" => "redhat-6.2",
   
   "mandrake-7.1" => "redhat-6.2",
   "mandrake-7.2" => "redhat-6.2",
   
   "debian-2.2"   => "redhat-6.2",
   "debian-woody" => "redhat-6.2",

   "suse-7.0"     => "redhat-6.2",

   "turbolinux-7.0" => "redhat-6.2"
   );
  
  my %dist_tables =
      (
       "redhat-6.2" => {
         fn => { 'LILO_CONF' => "/etc/lilo.conf" },
         table => [
                   [ 'prompt',   \&xst_boot_parse_global_kw, 'LILO_CONF', 'prompt' ],
                   [ 'root',     \&xst_boot_parse_global,    'LILO_CONF', 'root' ],
                   [ 'timeout',  \&xst_boot_parse_global,    'LILO_CONF', 'timeout' ],
                   [ 'default',  \&xst_boot_parse_global,    'LILO_CONF', 'default' ],
                   [ 'append',   \&xst_boot_parse_global,    'LILO_CONF', 'append' ],
                   [ 'images',   \&xst_boot_parse_images,    'LILO_CONF' ],
                   ] 
                     }
       );
  
  my $table = $dist_map{$main::xst_dist};
  if (!$table)
  {
      &xst_report ("platform_no_table", $main::xst_dist);
      return undef;
  }
  
  return &xst_parse_from_table ($ {$dist_tables{$table}}{"fn"},
                                $ {$dist_tables{$table}}{"table"});
}

# ----------------------------------------------------------------------------
# Fix functions.
#
# The main reason for these functions is to add default values to xml so the
# frontend doesn't have to know anything about lilo or its defaults.

sub _lilo_fix_default
{
  my $hash = shift;

  my $images = $hash->{'images'};
  return unless $images;
  
  # 'default'
  if (exists ($hash->{'default'}))
  {
    # Check if valid
    my $found;
    foreach my $image (@$images)
    {
      if ($hash->{'default'} eq $image->{'label'})
      {
        $found = 1;
        last;
      }
    }
    delete $hash->{'default'} unless $found;
  }
  
  unless (exists ($hash->{'default'}))
  {
    # No 'default', let's add
    foreach my $image (@$images)
    {
      if ($hash->{'key'} == 0)
      {
        $hash->{'default'} = $image->{'label'};
        last;
      }
    }
  }
}

# Internal. Should be run after _lilo_fix_images.
sub _lilo_fix_globals
{
  my $hash = shift;
  return unless $hash;

  &_lilo_fix_default ($hash);
}

# Internal
sub _lilo_fix_image
{
  my $image = shift;
  return unless $image;

  my $name = $image->{'image'} if exists $image->{'image'};
  $name = $image->{'other'} if (!$name && exists $image->{'other'});
    
  # Remove images without image identifier 'image' or 'other'.
  unless ($name) {
    undef $image;
    return;
  }

  # Add 'label' field which is optional in lilo.conf
  unless (exists $image->{'label'})
  {
    $image->{'label'} = $1 if ($name =~ /\S+\/(\S+)$/);
  }
}

# Internal
sub _lilo_fix_images
{
  my $hash = shift;
  my $func = shift;

  return unless $hash;
  return unless $func;

  my $images = $hash->{'images'};
  return unless $images;

  foreach my $image (@$images)
  {
    &$func ($image);
  }
}

sub xst_boot_conf_fix
{
  my $hash = shift;
  return unless $hash;
  
  &_lilo_fix_images ($hash, \&_lilo_fix_image);
  &_lilo_fix_globals ($hash);
}

# Fix xml functions

# Internal
sub _lilo_fix_globals_xml
{
  my $hash = shift;
  return unless $hash;

  &_lilo_fix_default ($hash);
}

sub xst_boot_conf_fix_xml
{
  my $hash = shift;
  return unless $hash;
  
  &_lilo_fix_images ($hash, \&_lilo_fix_image);
  &_lilo_fix_globals_xml ($hash);
}