#!/usr/bin/perl -w
#
# Copyright (c) 2004 by James A. McQuillan (McQuillan Systems, LLC)
#
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the "Software"),
# to deal in the Software without restriction, including without limitation
# the rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
# MCQUILLAN SYSTEMS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
# OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.
#
# 05/08/2004 -Jim McQuillan - Wrote new installer for LTSP.
#
# packagedb data file:
#
#    rectype|pkg|arch|ver|rel|date-time
#
#    S|ltsp-zlib|i386|1.1.4|0|Sun May 30 01:24:36 2004
#    C|ltsp-zlib|i386|1.1.4|0|Sun May 30 01:24:37 2004
#
# Two records are written.  the 'S' record shows that we started
# installing the package, and the 'C' record shows the installation
# was completed successfully.  This way, we can keep track of the fact
# that a package install was attempted and hopefully completed.
#
##############################################################################

use strict;
use POSIX;

eval {
  require LWP;
};
if($@) {
  print("\n");
  print("It appears as though you don't have the LWP perl module installed.\n");
  print("The package is usually called 'libwww-perl', and it needs\n");
  print("to be installed, before you can use this utility\n");
  print("\n");
  exit(1);
}

eval {
  require URI;
};
if($@) {
  print("\n");
  print("It appears as though you don't have the URI perl module installed.\n");
  print("The package is typically called 'liburi-perl' or 'perl-URI' \n");
  print("and it needs to be installed, before you can use this utility\n");
  print("\n");
  exit(1);
}

eval {
  require Digest::MD5;
};
if($@) {
  print("\n");
  print("It appears as though you don't have the Digest perl module ");
  print("installed.\n");
  print("This package needs to be installed, before you can use this ");
  print("utility\n");
  print("\n");
  exit(1);
}

eval {
  require Term::Cap;
};
if($@) {
  print("\n");
  print("It appears as though you don't have the Term perl module ");
  print("installed.\n");
  print("This package needs to be installed, before you can use this ");
  print("utility\n");
  print("\n");
  exit(1);
}

#
# Set these environment variables, because we need to
# make sure that system utilities, like 'ifconfig' return
# output in English. This is important, because we are looking
# for certain strings in the output. If the utility doesn't
# spit out english, we'll never get a match.
#
# Thanks to Francis Giraldeau for submitting the patch.
#
$ENV{LANG}        = "en_US";
$ENV{LANGUAGE}    = "en_US";
$ENV{LC_COLLATE}  = "en_US";
$ENV{LC_CTYPE}    = "en_US";
$ENV{LC_MESSAGES} = "en_US";
$ENV{LC_MONETARY} = "en_US";
$ENV{LC_NUMERIC}  = "en_US";
$ENV{LC_TIME}     = "en_US";

my $browser = LWP::UserAgent->new();

my @aComponents;
my @aPackages;
my %components;

my $default_pkg_source = "http://www.ltsp.org/ltsp-4.1/";

my $version            = "0.12";
my $pkgformat          = 0.4;
my $req_pkgformat      = 0.0;
my $progname           = "ltspadmin";

my $configfile         = "/etc/ltsp.conf";
my $default_installdir = "/opt/ltsp";

my $ltsp_dir;
my $cachedir;
my $datadir;
my $packagedb;
my $http_proxy;
my $ftp_proxy;
my $pkg_source;
my $pkgcnt = 0;

my $global_size     = 0;
my $global_progress = 0;

my @ltspcfg_locs = ( "/usr/local/sbin/ltspcfg",
                     "/usr/sbin/ltspcfg",
                     "/sbin/ltspcfg" );

my $screen        = Screen->new();

my $http_status   = "";

$| = 1;       # Automatically flush stdout

################################################################################
package Screen;
################################################################################
{
  sub new {
    my $pkg = shift;
    my $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => 9600 };

    my $attributes = {
      lines    => `tput lines`,
      cols     => `tput cols`,
      cl       => $terminal->Tputs('cl', 1),
      mr       => $terminal->Tputs('mr', 1),
      me       => $terminal->Tputs('me', 1),
      us       => $terminal->Tputs('us', 1),
      vi       => $terminal->Tputs('vi', 1),
      ve       => $terminal->Tputs('ve', 1),
      terminal => $terminal,
    };
    return ( bless $attributes, $pkg );
  }

  sub clear {
    my $self = shift;
    print $self->{cl};
  }
  sub lines {
    my $self = shift;
    return $self->{lines};
  }
  sub mr {
    my $self = shift;
    return $self->{mr};
  }
  sub me {
    my $self = shift;
    return $self->{me};
  }
  sub us {
    my $self = shift;
    return $self->{us};
  }
  sub vi {
    my $self = shift;
    return $self->{vi};
  }
  sub ve {
    my $self = shift;
    return $self->{ve};
  }
  sub cursor_on {
    my $self = shift;
    print $self->{ve};
  }
  sub cursor_off {
    my $self = shift;
    print $self->{vi};
  }
  sub curpos {
    my $self = shift;
    my $row  = shift;
    my $col  = shift;
    print $self->{terminal}->Tgoto( 'cm', $col-1, $row-1 );
  }
}

################################################################################
package GetKey;
################################################################################
{
  sub new {
    my $pkg = shift;
    my %seqs;
    for my $item ( @_ ){
      for my $key ( split /,/, $item->{keys} ){
        $seqs{$key} = $item->{action};
      }
    }
    return( bless \%seqs, $pkg );
  }

  sub getkey {
    my $self     = shift;
    my $keyfound = 0;
    my $action   = "";
    my $str      = "";

    while( ! $keyfound ){
      $str  = "";
      open(FH,"</dev/tty");
      system("stty -icanon min 1 time 0");    # Wait forever for first char
      while(1){
        my $ch = getc(FH);
        last if( ! $ch );
        $str .= $ch;
        system("stty -icanon -echo min 0 time 1");  # timeout waiting for addtl chars
        if(exists($self->{$str})){
          $keyfound = 1;
          $action   = $self->{$str};
          last;
        }
      }
      close(FH);
    }
    system("stty -icanon eol ^@ min 1 time 0");  # Reset kbd to normal
    return( $str, $action );
  }
}

################################################################################
package ScrollDisp;
################################################################################
{
  sub new {
    my $pkg  = shift;
    my $hash = shift;

    my $attributes = {
      entries_on_screen => 0,
      starting_line     => 1,
      lines_per_entry   => 1,
      hash              => $hash,
    };
    return ( bless $attributes, $pkg );
  }

  sub display_list {
    my  $self = shift;

    initscreen();

    $self->header();

    my $max_ent = 0;

    if( ( ref $self->{hash} ) eq "HASH" ){
      $max_ent   = keys(%{$self->{hash}});
    }
    else{
      $max_ent   = scalar(@{$self->{hash}});
    }

    my $cur_ent   = 1;
    my $cur_top   = 1;
    my $cur_bot   = $self->{entries_on_screen};
    my $prev_ent  = 0;
    my $prev_top  = 0;
    my $prev_bot  = 0;
    my $lineno;
    my $curentry;
    my $debug     = 0;
    my $done      = 0;

    while( ! $done ){
      if( $cur_top == $prev_top ){
        if( $prev_ent ){
          $lineno = ( $prev_ent - $cur_top ) + $self->{starting_line};
          $self->printat( $lineno, 1, $self->fmtline($prev_ent) );
        }
      }
      else{
        for( my $ent = $cur_top; $ent <= $cur_bot && $ent <= $max_ent; $ent++ ){
          $lineno = ( ( $ent - $cur_top ) * $self->{lines_per_entry} )
                  + $self->{starting_line};
          $self->printat( $lineno, 1, $self->fmtline($ent) );
        }
      }

      if( $debug ){
        $self->printfat( 1, 1, "cur_top=%d, cur_bot=%d, cur_ent=%d, "
                             . "max_ent=%d, req_pkgformat=%s, pkgformat=%s",
                 $cur_top, $cur_bot, $cur_ent, $max_ent,
                 $req_pkgformat, $pkgformat );
      }

      #
      # Hang on to the previous values
      #
      ( $prev_top, $prev_bot, $prev_ent ) = ( $cur_top, $cur_bot, $cur_ent );

      $lineno = ( ( $cur_ent - $cur_top ) * $self->{lines_per_entry} )
              + $self->{starting_line};

      $self->printat( $lineno, 1, (  $screen->mr()
                            . $self->fmtline($cur_ent)
                            . $screen->me() ) );

      my $curentry = $self->getentry($cur_ent);

      $screen->curpos( 2, 1 );

      my ( $keystr, $action ) = $self->{kbd}->getkey();

      #
      # See which key the user pressed
      #

      if( $action eq "dn" ){
        $cur_ent++;
      }
      elsif( $action eq "up" ){
        $cur_ent--;
      }
      elsif( $action eq "install" ){
        if( main::need_new_installer() ){
          $self->header();
          $prev_top = 0;
        }
        else{
          $self->select_packages($curentry);
          $cur_ent++;
        }
      }
      elsif( $action eq "toggle" ){
        $self->toggle_packages($curentry);
      }
      elsif( $action eq "uninstall" ){
        $self->un_select_packages($curentry);
        $cur_ent++;
      }
      elsif( $action eq "all" ){
        if( main::need_new_installer() ){
          $self->header();
          $prev_top = 0;
        }
        else{
          map { $self->select_packages($components{$_}) } keys %components;
          $prev_top = 0;
        }
      }
      elsif( $action eq "quit" ){
        $done = 1;
      }
      elsif( $action eq "debug" ){
        $debug = 1;
      }
      else{
        my $response = $self->addtl_key_test( $action, $cur_ent );
        if( $response > 0 ){
          $self->header();
          $prev_top = 0;
        }
        elsif( $response < 0 ){
          $done = 1;
        }
      }

      #
      # Make sure the row stuff is within range
      #
      if( $cur_ent <  1       ){ $cur_ent = 1        }
      if( $cur_ent > $max_ent ){ $cur_ent = $max_ent }
      if( $cur_ent > $cur_bot ){ $cur_bot = $cur_ent }

      $cur_top = ( $cur_bot - $self->{entries_on_screen} ) + 1;
      if( $cur_top < 1 || $cur_top > $cur_ent ){ $cur_top = $cur_ent }
      $cur_bot = ( $cur_top + $self->{entries_on_screen} ) - 1;
    }
    termscreen();
  }

  sub addtl_key_test {
    #
    # Stub function.  Anything useful should be added to sub classes
    #
    return(0);
  }

  sub select_packages {
    my $self  = shift;
    my $rComp = shift;          # Reference to a component

    #
    # mark the component as being selected
    #
    $rComp->{selected} = "*";

    my $rPkg = $rComp->{packages};

    for my $key ( keys %$rPkg ){
      my $pkg  = $rPkg->{$key};
      my $ver  = $pkg->{version} || 0;
      my $rel  = $pkg->{release} || 0;
      my $over = $pkg->{oversion} || 0;
      my $orel = $pkg->{orelease} || 0;

      if( $ver > $over
      ||( ($ver == $over) && ($rel > $orel) )){
        $pkg->{selected} = 1;
      }
      else{
        $pkg->{selected} = 0;
      }
    }
  }

  sub toggle_packages {
    my $self  = shift;
    my $rComp = shift;          # Reference to a component

    #
    # mark the component as being selected
    #
    if( $rComp->{selected} eq "*" ){
      $rComp->{selected} = " ";
      my $rPkg = $rComp->{packages};
      for my $key ( keys %$rPkg ){
        my $pkg  = $rPkg->{$key};
        $pkg->{selected} = 0;
      }
    }
    else{
      $rComp->{selected} = "*";
      my $rPkg = $rComp->{packages};
      for my $key ( keys %$rPkg ){
        my $pkg  = $rPkg->{$key};
        my $ver  = $pkg->{version}  || 0;
        my $rel  = $pkg->{release}  || 0;
        my $over = $pkg->{oversion} || 0;
        my $orel = $pkg->{orelease} || 0;
  
        if( $ver > $over
        ||( ($ver == $over) && ($rel > $orel) )){
          $pkg->{selected} = 1;
        }
        else{
          $pkg->{selected} = 0;
        }
      }
    }
  }

  sub un_select_packages {
    my $self  = shift;
    my $rComp = shift;          # Reference to a component

    $rComp->{selected} = " ";

    my $rPkg = $rComp->{packages};

    for my $key ( keys %$rPkg ){
      my $pkg  = $rPkg->{$key};
      $pkg->{selected} = 0;
    }
  }

  sub header {
    my $self  = shift;
    ::header();
  }
  sub printat {
    my $self  = shift;
    my $row   = shift;
    my $col   = shift;
    my $str   = shift;
    $screen->curpos( $row, $col );
    print( $str );
  }

  sub printfat {
    my $shift = shift;
    my $row   = shift;
    my $col   = shift;
    my $fmt   = shift;
    $screen->curpos( $row, $col );
    printf( $fmt, @_ );
  }

  sub initscreen {
    system "stty", '-icanon', '-echo', 'eol', "\001";
    $screen->cursor_off();
    $screen->clear();
  }

  sub termscreen {
    $screen->clear();
    $screen->cursor_on();
    system "stty", 'icanon', 'echo', 'eol', '^@', 'min', '1', 'time', '0';
  }

  sub getkey {
    return(getc(STDIN));
  }
}

################################################################################
package ScrollMainMenuDisp;
our @ISA = ("ScrollDisp");               # Inherits from ScrollDisp
################################################################################

{
  sub new {
    my $self  = shift;
    my $items = shift;
    my $obj   = $self->SUPER::new( $items );
    $obj->{entries_on_screen} = $screen->lines() - 4;
    $obj->{starting_line}     = 5;

    $obj->{kbd} = GetKey->new(
               ( { keys => "p,P,k,K,\x1b0A,\x1b[A", action => 'up'        },
                 { keys => "n,N,j,J,\x1b0B,\x1b[B", action => 'dn'        },
                 { keys => "q,Q",                   action => 'quit'      },
#                { keys => "d,D",                   action => 'debug'     },
                 { keys => " ,\x0a",                action => 'select'    },
               )
             );

    return $obj;
  }

  sub getentry {
    my $self = shift;
    my $idx  = shift; 
    return( $self->{hash}->[$idx-1] );
  }

  sub fmtline {
    my $self = shift;
    my $idx  = shift; 
    my $item = $self->getentry($idx);
    my $str  = sprintf("  %s", $item->{item} );
    return( sprintf( "%-80s", $str ) );
  }

  sub addtl_key_test {
    my $self = shift;
    my $cmd  = shift;
    my $idx  = shift;
    my $scrn_changed = 0;
    if( $cmd eq "select" ){
      $self->termscreen();
      my $action = $self->getentry($idx)->{action};
      if( $action eq "install" ){
        ::install_update();
        $scrn_changed = 1;
      }
      elsif( $action eq "config_installer" ){
        ::configure_installer();
        $scrn_changed = 1;
      }
      elsif( $action eq "config_ltsp" ){
        ::configure_ltsp();
        $scrn_changed = 1;
      }
      elsif( $action eq "quit" ){
        $scrn_changed = -1;
      }
      elsif( $action eq "nop" ){
        $scrn_changed = 1;
      }
      $self->initscreen();
    }
    return($scrn_changed);
  }

  sub header {
    my $self = shift;
    $self->SUPER::header();
    my $hdr  = sprintf( "LTSP Administration Utility" );
    $self->printat( 3, 1, $hdr );
    $self->printat( $screen->lines(), 1, "Press <Enter> to Select"
                                       . "   "
                                       . "N-Next"
                                       . "   "
                                       . "P-Prev"
                                       . "   "
                                       . "Q-Quit" );
  }
}

################################################################################
package ScrollCompDisp;
our @ISA = ("ScrollDisp");               # Inherits from ScrollDisp
################################################################################
{
  sub new {
    my $self = shift;
    my $components = shift;
    my $obj  = $self->SUPER::new( $components );

    $obj->{entries_on_screen} = $screen->lines() - 6;
    $obj->{starting_line}     = 4;
    $obj->{kbd} = GetKey->new(
               ( { keys => "p,P,k,K,\x1b0A,\x1b[A", action => 'up'        },
                 { keys => "n,N,j,J,\x1b0B,\x1b[B", action => 'dn'        },
                 { keys => "q,Q",                   action => 'quit'      },
                 { keys => "i,I",                   action => 'install'   },
                 { keys => " ",                     action => 'toggle'    },
                 { keys => "u,U",                   action => 'uninstall' },
                 { keys => "a,A",                   action => 'all'       },
#                { keys => "d,D",                   action => 'debug'     },
                 { keys => "s,S",                   action => 'show'      },
                 { keys => "h,H",                   action => 'help'      },
                 { keys => "\x0a",                  action => 'select'    },
               )
             );

    return $obj;
  }

  sub getentry {
    my $self = shift;
    my $idx  = shift; 
    return($self->{hash}->{$aComponents[$idx-1]});
  }

  sub fmtline {
    my $self = shift;
    my $idx  = shift; 

    my $comp = $self->getentry($idx);

    my $fmt  = " [%1.1s] %-25.25s  %7d   %-38s";
    my $sel  = $comp->{selected} || "";
    my $status = "";
    if( ! $comp->{installed } ){
      $status = "Not installed";
    }
    elsif( $comp->{updates_avail} ){
      $status = "Updates available";
    }
    else{
      $status = "Installed - Up to date";
    }
    return(sprintf($fmt, $sel, $comp->{name},
                     $comp->{size} / 1024 , $status ));
  }
  sub show_packages {
    my $self = shift;
    my $idx  = shift;

    my $comp = $self->getentry($idx);
    my $pkgs = $comp->{packages};

    @aPackages = sort( keys %$pkgs );
    my $disppkgobj = ScrollPkgDisp->new($pkgs);
    $self->termscreen();
    $disppkgobj->display_list();
    $self->initscreen();
  }

  sub show_component_help {
    my $self = shift;
    $self->termscreen();

     print "LTSP Installer - Component Installation Help Screen\n"
         . "\n"
         . "  Keys            Action\n"
         . "\n"
         . "  Up or P         Move up 1 line\n"
         . "  Down or N       Move down 1 line\n"
         . "\n"
         . "  A               Select ALL components to install\n"
         . "  I               Select a component to install\n"
         . "  U               Un-select a component to install\n"
         . "  S               Show the packages in current component\n"
         . "  Q               Leave the component selection screen\n"
         . "\n"
         . "Select the components you want to install, and when you\n"
         . "exit the selection screen, the components will be installed\n"
         . "\n"
         . "Press <enter> to continue ";
         <STDIN>;

    $self->initscreen();
  }

  sub addtl_key_test {
    my $self    = shift;
    my $cmd     = shift;
    my $cur_ent = shift;
    my $scrn_changed;
    if( $cmd eq "show" ){
      $self->show_packages( $cur_ent );
      $scrn_changed = 1;
    }
    elsif( $cmd eq "help" ){
      $self->show_component_help( $self->{helpscreen} );
      $scrn_changed = 1;
    }
    else{
      $scrn_changed = 0;
    }
    return($scrn_changed);
  }

  sub header {
    my $self = shift;
    $self->SUPER::header();
    $self->printat( 3,
                    1,
                    "     Component                Size (kb)   Status" );

    my $us = $screen->us();
    my $me = $screen->me();

    my $line1 = "Use '"
              . $us . "A" . $me
              . "' to select ALL components, '"
              . $us . "I" . $me
              . "' to select individual components. When you";

    my $line2 = "leave this screen by pressing '"
              . $us . "Q" . $me
              . "', the components will be installed.   '"
              . $us . "H" . $me
              . "'-Help";

    $self->printat( $screen->lines() - 1, 1, $line1 ); 
    $self->printat( $screen->lines(),     1, $line2 ); 
  }
}

################################################################################
package ScrollPkgDisp;
our @ISA = ("ScrollDisp");               # Inherits from ScrollDisp
################################################################################

{
  sub new {
    my $self = shift;
    my $pkgs = shift;
    my $obj  = $self->SUPER::new( $pkgs );
    $obj->{entries_on_screen} = $screen->lines() - 5;
    $obj->{starting_line}     = 4;
    $obj->{kbd} = GetKey->new(
               ( { keys => "p,P,k,K,\x1b0A,\x1b[A", action => 'up'        },
                 { keys => "n,N,j,J,\x1b0B,\x1b[B", action => 'dn'        },
                 { keys => "q,Q",                   action => 'quit'      },
#                { keys => "d,D",                   action => 'debug'     },
               )
             );

    return $obj;
  }

  sub getentry {
    my $self = shift;
    my $idx  = shift; 
    return($self->{hash}->{$aPackages[$idx-1]});
  }

  sub fmtline {
    my $self = shift;
    my $idx  = shift; 

    my $pkg  = $self->getentry($idx);

    my $fmt     = " %-24s %-15s %-15s %s";
    my $verrel  = $pkg->{verrel};   $verrel =~ s/\^/-/;
    my $overrel = $pkg->{overrel}; $overrel =~ s/\^/-/;

    if( $overrel eq "-" ){
      $overrel = "None";
    }

    my $status = "";

    my $ver  = $pkg->{version} || 0;
    my $rel  = $pkg->{release} || 0;
    my $over = $pkg->{oversion} || 0;
    my $orel = $pkg->{orelease} || 0;

    if( ! $over ){
      $status = "New package available";
    }
    elsif( $ver > $over
    ||( ($ver == $over) && ($rel > $orel) )){
      $status = "Update available";
    }

    $status = "SELECTED" if( $pkg->{selected});

    my $str = sprintf( $fmt,
                       $pkg->{name},
                       $overrel,
                       $verrel,
                       $status );

    return(sprintf("%-80s",$str));
  }

  sub header {
    my $self = shift;
    $self->SUPER::header();
    my $hdr  = sprintf( " %-24s %-15s %-15s",
                        "Package",
                        "Installed ver",
                        "Available ver" );
    $self->printat( 3, 1, $hdr );
    $self->printat( $screen->lines(), 1, "N-Next   P-Prev   Q-Quit");
  }
}

################################################################################
package main;
################################################################################

check_root_user();

load_config();

#
# Main menu
#

my @aItems = ( { item   => "Install/Update LTSP Packages",
                 action => "install",
               },
               { item   => "Configure the installer options",
                 action => "config_installer",
               },
               { item   => "Configure LTSP",
                 action => "config_ltsp",
               },
               { item   => "",
                 action => "nop",
               },
               { item   => "Quit the administration program",
                 action => "quit",
               },
             );

my $menuobj = ScrollMainMenuDisp->new(\@aItems);
$menuobj->display_list();

exit 0;

################################################################################

sub check_root_user {
  #
  # Make sure this utility is being run by root.  Also, make sure the
  # root environment is setup properly.
  #
  if( $ENV{LOGNAME} ne "root" ){
    if( $> == 0 ){                        # $EUID
      die( "\n$0: Must be run as root\n\n"
         . "   If you used 'su' to become the SuperUser, make sure\n"
         . "   you include the hyphen '-' as an argument to su.\n"
         . "   that is:\n\n"
         . "       su -\n\n"
         . "   That will ensure that the proper environment is setup.\n\n" );
    }
    else{
      die( "\n$0: Must be run as root\n\n" );
    }
  }
}

sub install_update {

  if( ! -f $configfile ){
    printf(  "\n"
           . "\n"
           . "This is the first time installing LTSP packages, the\n"
           . "Installation utility must first be configured.\n"
           . "\n"
           . "press <center> to begin the configuration... ");

    <STDIN>;
    configure_installer();
  }

  my $ltsp_dir   = get_conf_value( "LTSP_DIR", $default_installdir );

  system("mkdir -p $cachedir") if ! -d $cachedir;
  system("mkdir -p $datadir")  if ! -d $datadir;

  $screen->cursor_off();
  my $rs = get_pkg_list();
  $screen->cursor_on();
  if( ! $rs ){
    printf("Unable to retrieve list of packages!\n\n");
    printf("Press <enter> to return to main menu ");
    <STDIN>;
    return;
  }

  my $dispobj = ScrollCompDisp->new(\%components);

  $dispobj->display_list();
  process_job();
}

sub load_config {

  $ltsp_dir   = get_conf_value( "LTSP_DIR",   $default_installdir );
  $pkg_source = get_conf_value( "PKG_SOURCE", $default_pkg_source );
  $http_proxy = get_conf_value( "HTTP_PROXY", "none" );
  $ftp_proxy  = get_conf_value( "FTP_PROXY",  "none" );

  set_paths();
}

sub set_paths {

  $cachedir  = $ltsp_dir
             . "/"
             . "pkg_cache";

  $datadir   = $ltsp_dir
             . "/data";

  $packagedb = "$datadir"
             . "/"
             . "package.db";

  #
  # Make sure the source url ends in exactly 1 slash
  #
  $pkg_source =~ s/\/*$//;
  $pkg_source .= "/";
}

sub configure_installer {
  #
  # Things to configure:
  #
  #    LTSP_DIR
  #    PKG_SOURCE
  #    HTTP_PROXY
  #    FTP_PROXY
  #

  $screen->clear();
  printf("LTSP Installer configuration\n");
  printf("\n");


  while( 1 ){
    printf("\n");

    print "Where to retrieve packages from?\n"
        . "[$pkg_source] ";
    my $new_pkg_source = <STDIN>;
    chomp $new_pkg_source;
    if( $new_pkg_source ){
      $pkg_source = $new_pkg_source;
    }

    print "\n"
        . "In which directory would you like to place the LTSP client tree?\n"
        . "[$ltsp_dir] ";
    my $new_dir = <STDIN>;
    chomp $new_dir;
    if( $new_dir ){
      $ltsp_dir = $new_dir;
    }

    print "\n"
        . "If you want to use an HTTP proxy, enter it here\n"
        . "Use 'none' if you don't want a proxy\n"
        . "Example:  http://proxy.yourdomain.com:3128\n"
        . "\n"
        . "[$http_proxy] ";
    my $new_http_proxy = <STDIN>;
    chomp $new_http_proxy;
    if( $new_http_proxy ){
      $http_proxy = $new_http_proxy;
    }

    print "\n"
        . "If you want to use an FTP proxy, enter it here\n"
        . "(Use 'none' if you don't want a proxy)\n"
        . "\n"
        . "[$ftp_proxy] ";
    my $new_ftp_proxy = <STDIN>;
    chomp $new_ftp_proxy;
    if( $new_ftp_proxy ){
      $ftp_proxy = $new_ftp_proxy;
    }

    my $answer = "";
    printf("\n");
    while( 1 ){
      printf("Correct? (y/n/c) ");     # Y=yes, N=no, C=cancel
      $answer = <STDIN>;
      chomp $answer;
      next if ! $answer;
      if( $answer =~ /^y/i ){
        $answer = "y";
        last;
      }
      elsif( $answer =~ /^n/i ){
        $answer = "n";
        last;
      }
      elsif( $answer =~ /^c/i ){
        $answer = "c";
        last;
      }
      invalid_answer();
    }

    if( $answer eq "y" ){
      set_conf_value( "LTSP_DIR",   $ltsp_dir   );
      set_conf_value( "PKG_SOURCE", $pkg_source );
      set_conf_value( "HTTP_PROXY", $http_proxy );
      set_conf_value( "FTP_PROXY",  $ftp_proxy  );
      set_paths();
      last;
    }
    elsif( $answer eq "n" ){
      next;
    }
    elsif( $answer eq "c" ){
      last;
    }
  }
}

sub invalid_answer {
  print( "\a\nInvalid Answer!\n" );
  sleep( 1 );
}

sub get_enter_key {
  my $prompt = shift;
  $prompt =~ s/\s*$/ /;   # Make sure exactly 1 space before the cursor
  print($prompt);
  $screen->cursor_on();
  <STDIN>; 
  $screen->cursor_off();
}

sub configure_ltsp {
  my $ltspcfg = "";
  for( my $i = 0; $i < @ltspcfg_locs; $i++ ){
    if( -x $ltspcfg_locs[$i] ){
      $ltspcfg = $ltspcfg_locs[$i];
      last;
    }
  }
  if( $ltspcfg ){
    system($ltspcfg);
  }
  else{
    printf( "\n\n"
          . "ltspcfg utility couldn't be found!\n"
          . "\n"
          . "Make sure you have the ltspcfg package installed\n"
          . "\n\n"
          . "Press <enter> to continue... " );
    <STDIN>;
  }
}

sub header {
  $screen->clear();
  my $progname_ver = "$progname - v$version";
  my $inst_dir     = "LTSP dir: $ltsp_dir";
  printf( "%-40s%40s", $progname_ver, $inst_dir );
}

my $tick = 0;

sub progress_meter {
  my $cur = shift;
  my $str = sprintf("%d/%d",$cur,$pkgcnt);
  printf("%7s",$str);
  print "\010" x 7;
}

sub get_pkg_list {

  my $oversions = check_current_versions();

  header();

  printf("\n\nRetrieving list of packages from $pkg_source...");

  #
  # Go get the list of packages from the URL
  #
  my $document = get_doc($pkg_source);
  if( ! $document ){
    printf("\n\n");
    printf("Status: $http_status\n");
    return undef;
  }

  for my $key (keys %components){
    $components{$key}->{updates_avail} = 0;
    $components{$key}->{size}          = 0;
  }

  my @aPkgList;

  while( $document =~ m/href\s*=\s*"([^"\s]+)"/gi ){
    my $url = $1;
    if( $url =~ m/.*\.ltsp$/ ){
      push @aPkgList, $url;
    }
  }

  $pkgcnt = scalar(@aPkgList);

  #
  # Now, we have a list of all of the packages at that location.
  # We need to loop through the list and look for the filenames
  # ending in '.ltsp'.  Those are the package header files.
  #
  my $curpkg = 0;

  for( my $curpkg = 0; $curpkg < $pkgcnt; $curpkg++ ){
    my $url = $aPkgList[$curpkg];
    if( $url =~ m/.*\.ltsp$/ ){
      my $absolute_url = URI->new_abs($url,$pkg_source)->canonical;

      my $content = get_doc($absolute_url);
      if( ! $content ){
        print("\nCould not get info from source!\n");
        return undef;
      }
      progress_meter( $curpkg );
      my $pkg = parse_content($content);

      my $base_url        = $pkg_source;
      $base_url           =~ s/\/$//;            # Remove trailing slash

      #
      # Ok, at this point, we have all the information we need about
      # an available package.  We can add that into the components hash
      #

      my $h;
      my $new_pkg = 0;

      my $package         = $pkg->{package};
      my $component       = $pkg->{component};

      if( exists( $components{$component}->{packages}->{$package} ) ){
        $h = $components{$component}->{packages}->{$package};
      }
      else{
        $h = {};
        $new_pkg = 1;
      }

      $h->{version}         = $pkg->{version};
      $h->{release}         = $pkg->{release};
      $h->{verrel}          = $pkg->{version} . "^" . $pkg->{release};
      $h->{architecture}    = $pkg->{architecture};
      $h->{overrel}         = $oversions->{$package} || "^";
      ( $h->{oversion}, $h->{orelease} ) = split /\^/, $h->{overrel};
      $h->{download_size}   = $pkg->{pkgsize};
      $h->{install_size}    = $pkg->{size};
      $h->{md5sum}          = $pkg->{md5sum};
      $h->{filename}        = $pkg->{filename};
      $h->{base_url}        = $base_url;
      $h->{url}             = $base_url
                            . "/"
                            . $pkg->{filename};

      my @depends           = split /,\s*/, $pkg->{depends};
      $h->{name}            = $package;
      $h->{depends}         = \@depends;
      $h->{pkgformat}       = $pkg->{pkgformat};
      $h->{selected}        = 0;
      $h->{pkgtype}         = $pkg->{pkgtype};

      #
      # For each package that we encounter, see which version of
      # the installer is needed.  We may need this later, to tell the
      # user that they need to upgrade their installer.
      #
      if( $pkg->{pkgformat} > $req_pkgformat ){
        $req_pkgformat = $pkg->{pkgformat};
      }

      #
      # Store the hash in our components tree
      #

      if( $new_pkg ){
        $components{$component}->{packages}->{$package} = $h;
      }

      $components{$component}->{name}     = $component;
      $components{$component}->{selected} = "";
      $components{$component}->{size}     += $pkg->{size};

      if( $h->{oversion} ){
        $components{$component}->{installed} = 1;
      }

      my $ver  = $h->{version}  || 0;
      my $rel  = $h->{release}  || 0;
      my $over = $h->{oversion} || 0;
      my $orel = $h->{orelease} || 0;

      if( $ver > $over
      ||( ($ver == $over) && ($rel > $orel) )){
        $components{$component}->{updates_avail} = 1;
      }
    }
  }

  #
  # We have a hash called %components that contains all of the components
  # that are available for download.
  #
  # We now put the names of the components into an array, so that
  # we can display them on the screen in a scrollable list.
  #
  @aComponents = sort( keys %components );
  return(\@aComponents);
}

sub check_current_versions {
  return if( ! -f $packagedb );
  my %oversions;
  open( PF, "<$packagedb" ) or die "Unable to open $packagedb: $!";
  while(<PF>){
    my $rec = $_;
    chomp($rec);
    if( $rec =~ m/^C/ ){
      my ( $cmd, $pkgname, $arch, $ver, $rel, $timestamp ) = split /\|/, $rec;
      $oversions{$pkgname} = $ver . "^" . $rel;
    }
  }
  close(PF);
  return(\%oversions);
}

sub need_new_installer {
  if( $req_pkgformat > $pkgformat ){
    ::header();
    print( "Sorry, one or more of the packages requires a newer version\n"
          . "of the installer.\n"
          . "\n"
          . "You currently have version $version of $progname installed, which\n"
          . "supports package format version $pkgformat.  You need to install \n"
          . "a newer version that supports at least package format version $req_pkgformat.\n"
          . "\n"
          . "Check the LTSP.org website for the latest version of $progname.\n"
          . "\n" );
    main::get_enter_key( "Press <enter> to return" );
    return( 1 );
  }
  else{
    return( 0 );
  }
}

sub get_doc {
  my $url = shift;

  $browser->timeout(180);

  $browser->env_proxy();       # Check for proxy env variables

  if( $http_proxy ne "none" ){
    $browser->proxy( "http", $http_proxy );
  }
  if( $ftp_proxy ne "none" ){
    $browser->proxy( "ftp", $ftp_proxy );
  }

  my $request  = HTTP::Request->new('GET', $url );
  my $response = $browser->request($request);

  if($response->is_success()){
    $http_status = "";
    return( $response->content() );
  }
  else{
    $http_status = $response->status_line();
    printf("\n$http_status\n");
    return( undef );
  }
}

sub parse_content {
  my $content = shift;
  my %h;
  for my $line ( split /\n/, $content ){
    my ( $key, $val ) = split /:\s*/, $line;
    $key     = tolower($key);
    $h{$key} = $val;
  }
  return(\%h);
}

sub process_job {

  header();

  print("\n\n");

  my @aInstall;

  #
  # Loop through all of the components, and for each one that has
  # been selected to be installed, loop through its packages, and
  # add those package names to the array of packages to install.
  #
  for my $key ( keys %components ){
    if( $components{$key}->{selected} ){
      my $pkgs = $components{$key}->{packages};
      for my $pkg ( keys %$pkgs ){
        if( $pkgs->{$pkg}->{selected} ){
          push @aInstall, $pkgs->{$pkg};     # Store the ref to this pkg
        }
      }
    }
  }

  if( @aInstall == 0 ){
    return;
  }

  while( 1 ){
    printf("Ready to install/update the selected LTSP packages? (y/n) ");
    my $answer = <STDIN>;
    next if ! $answer;
    if( $answer =~/^y/i ){
      last;
    }
    elsif( $answer =~ /^n/i ){
      printf("\nCancelling install/update! ");
      sleep(1);
      return;
    }
    print( "\a\nInvalid Answer!\n" );
    sleep( 1 );
  }

  printf("Calculating package dependencies...\n");

  #
  # Ok, now we have an array of the packages to install.  We need
  # to sort the array, based on dependencies, to make sure the
  # packages get installed in the correct order.
  #

  my $sorted      = 0;
  my $runaway_cnt = 0;
  while( ! $sorted && ! ($runaway_cnt > 100) ){
    $sorted = 1;
    $runaway_cnt++;
    for( my $i = 0; $i < @aInstall; $i++ ){

      for( my $j = $i+1; $j < @aInstall; $j++ ){
        if( $j != $i ){
          #
          # We have 2 packages. We need to see if the 2nd package
          # satisfies any of the 1st packages dependencies.  if it
          # does, then swap their positions in the array and mark
          # the sorted flag as false.
          #
          my $a = $aInstall[$i];
          my $b = $aInstall[$j];

          my $provides_dep = 0;
          for( my $k = 0; $k < @{$a->{depends}}; $k++ ){
            if( $a->{depends}[$k] eq $b->{name} ){
              $provides_dep = 1;
            }
          }
          if( $provides_dep ){
            $aInstall[$i] = $b;
            $aInstall[$j] = $a;
            $sorted       = 0;
          }
        }
      }
    }
  }

  if( $runaway_cnt > 100 ){
    die("Dependency loop, bailing out :(\n");
  }

  printf("Downloading packages from: $pkg_source ...\n");

  for( my $i = 0; $i < @aInstall; $i++ ){

    my $pkg = $aInstall[$i];
    my $pkgsize    = $pkg->{download_size};

    printf("   %-60s %6.2fmb  ", $pkg->{filename}, ($pkgsize/(1024*1024) ) );
    my $url        = $pkg->{url};
    my $fullpath   = $cachedir . "/" . $pkg->{filename};
    my $md5sum     = $pkg->{md5sum};

    my $PkgHdrUrl  = $url;
    $PkgHdrUrl     =~ s/\.tgz/.ltsp/;
    my $PkgHdrFile = $fullpath;
    $PkgHdrFile    =~ s/\.tgz/.ltsp/;

    $global_progress = 0;

    if( -f $fullpath ){
      if( test_checksum( $fullpath, $md5sum ) != 0 ){
        unlink($fullpath);
        download_file( $url, $pkgsize );
        if( test_checksum( $fullpath, $md5sum ) != 0 ){
          die( "File $fullpath failed the checksum test\n");
        }
      }
    }
    else{
      download_file( $url, $pkgsize );
      if( test_checksum( $fullpath, $md5sum ) != 0 ){
        die( "File $fullpath failed the checksum test\n");
      }
    }
    printf("\n");
    download_file( $PkgHdrUrl, 0 );    # Download and save the package header
  }

  printf("Installing the packages...\n");
  for( my $i = 0; $i < @aInstall; $i++ ){

    my $pkg = $aInstall[$i];
    my $url      = $pkg->{url};
    my $fullpath = $cachedir . "/" . $pkg->{filename};
    my $pkgtype  = $pkg->{pkgtype} || "";
    if( -f $fullpath ){
      install_pkg( $fullpath, $pkg, $pkgtype );
    }
    else{
      die("Internal error, $fullpath not found!\n");
    }
  }

  printf("\nPress <enter> to continue... ");
  <STDIN>;
}

sub install_pkg {
  my $pkgfile = shift;
  my $pkg     = shift;
  my $pkgtype = shift;

  my $cmd     = "";

  if( $pkgtype eq "kernel" ){
    my $tftpdir="/tftpboot/lts";
    if( ! -d $tftpdir ){
      system("mkdir -p $tftpdir");
    }
    $cmd     = "cd $tftpdir; tar xzf $pkgfile";
  }
  else{
    $cmd     = "cd $ltsp_dir; tar xzf $pkgfile";
  }

  #
  # record log entry showing install started
  #
  log_it( "S", $pkg );

  printf( "   %s\n", $pkg->{filename} );
  my $rs = system($cmd);

  #
  # If there are any POST-install scripts to run, then
  # go ahead and run them
  #

  #
  # record log entry showing install finished
  #
  log_it( "C", $pkg );

}

sub log_it {
  my $cmd = shift;
  my $pkg = shift;
  if( ! -f $packagedb ){
    open( PF, ">$packagedb" )
      or die "Unable to create $packagedb: $!";
    printf PF "#\n"
            . "# packagedb\n"
            . "#\n"
            . "# DO NOT DELETE THIS FILE !!!!\n"
            . "#\n"
            . "# This file is used to maintain package information\n"
            . "# for the Linux Terminal Server Project (http://www.LTSP.org)\n"
            . "#\n"
            . "#    S = Started package install\n"
            . "#    C = Completed package install\n"
            . "#\n";
    close(PF);
  }

  open( PF, ">>$packagedb" )
    or die "Unable to open $packagedb: $!";
  printf PF "%s|%s|%s|%s|%s|%s\n",
            $cmd,
            $pkg->{name},
            $pkg->{architecture},
            $pkg->{version},
            $pkg->{release},
            scalar(localtime(time()));
  close(PF);
}

sub download_file {
  my $url         = shift;
  $global_size    = shift;
  my $localfile   = $url;
  $localfile      =~ s/^.*\///;
  my $path        = $cachedir . "/" . $localfile;
  my $request     = HTTP::Request->new( 'GET', $url );

  open( DOWNLOAD, ">$path" ) or die "Unable to open $path: $!\n";
  binmode DOWNLOAD;
  my $response    = $browser->request( $request, \&download_cb );
  close( DOWNLOAD );

}

sub download_cb {
   my $data = shift;
   print( DOWNLOAD $data );     # Save the chunk of data to the file
   if( $global_size ){
       print("    ") if ! $global_progress;
       $global_progress += length($data);
       my $perc = ( $global_progress / $global_size ) * 100;
       printf( "%s%3d%%",  "\010" x 4, $perc );
   }
}

sub test_checksum {
  my $file        = shift;
  my $checksum    = shift;

  open(FH, $file)
    or die "Can't open $file to calculate the md5sum: $!";
  binmode(FH);
  my $md5hexsum = Digest::MD5->new->addfile(*FH)->hexdigest();
  close(FH);

  return ( $md5hexsum eq $checksum ) ? 0 : 1;
}

sub get_conf_value {
  my $var = shift;
  my $val = shift || "";
  if ( -f "$configfile" ){
    open FH, "<$configfile" or die "Couldn't open $configfile: $!";
    while(<FH>){
      if( /^\s*${var}\s*=/ ){
        s/^\s*${var}\s*=\s*//;
        my @fields = split /\s+/;
        $val = $fields[0];
      }
    }
    close(FH);
  }
  return($val);
}

sub set_conf_value {
  my $var = shift;
  my $val = shift;

  my $match = 0;

  if( -f "$configfile" ){
    #
    # If the file already exists, we open it for updating
    #
    open( FH, "+<$configfile") or die "Unable to open $configfile: $!";
    my @lines = <FH>;              # Suck the entire file into an array
    truncate( FH, 0 );             # Truncate the file, to empty it
    seek( FH, 0, 0 );              # Position file pointer to the beginning

    for( my $i = 0; $i < @lines; $i++ ){
      if( $lines[$i] =~ /^\s*${var}/ ){
        printf FH "%s=%s\n", ${var}, ${val};
        $match = 1;
      }
      else{
        print FH $lines[$i];
      }
    }
  }
  else{
    #
    # If the file didn't already exist, we open it to create it
    #
    open( FH, ">$configfile" ) or die "Unable to create $configfile: $!";
    print FH
              ":\n"
            . "#\n"
            . "# Configuration variables for LTSP\n"
            . "#\n"
            . "# This file is for server configuration entries.\n"
            . "# This is NOT where the configuration entries for the\n"
            . "# workstations belong.  If you want to set configuration\n"
            . "# entries for a workstation, "
            . "do that in \${LTSP_DIR}/i386/etc/lts.conf\n"
            . "#\n";
  }
  if( ! $match ){
    printf FH "%s=%s\n", ${var}, ${val};
  }
  close(FH);
}
