#!/usr/bin/perl -w

#    gBootRoot Copyright (C) 2000
#    Jonathan Rosenbaum - mttrader@access.mountain.net
#    http://the.netpedia.net/gBootRoot.html
                                                                                
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU 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 General Public License for more details.
                                                                                
#    You should have received a copy of the GNU 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.


use Gtk;
use strict;

init Gtk;

# Perhaps you are wondering where I learned how to program with Gtk-Perl?
# There is an excellent tutorial by Stephen Wilhelm at
# http://personal.riverusers.com/~swilhelm/perlgtk/.  Please
# help support his development of this tutorial.  Another good place
# to learn from is test.pl in the Gtk/samples directory included with 
# Gtk-Perl.

# If you want gBootRoot to do it's stuff somewhere else, change the 
# value for $tmp1.
my $tmp1 = "/tmp"; # tmp should be default - Cristian

# CHANGES
#           1.0.3 - 08.09.2000
#                     * Tmp and mnt are now created on the fly,
#                       along with a new error function for mkdir(),
#                       Gtk clean-up for this, and clean-up by signal handler 
#                       which should please Perlish and helpful Cristian.  
#            
#           1.0.2 - 08.06.2000
#                     * Changed logic slightly in submit() with returns rather
#                       than a scalar to resolve a minor bug caused by some
#                       changes in the previous version.
#
#           1.0.1 - 08.05.2000
#                     * Zas provided a correction for a Perl 5.6 error complaint.
#                     * Zas found some unecessary GDK lines causing some Gtk 
#                       warnings; these were commented out.
#                     * Cristian Ionescu-Idbohrn found a bug caused by putting
#                       the Kernel or RootImage below the mount point.  An error
#                       check and error dialog were added. 
#
#           1.0.0 - 08.02.2000
#                     * First public release
#        

#######################################################################
# Don't edit from here, but you can if you want to change the HERE docs
# and/or the contents of initrd (in which case you need to make sure the
# right libraries are copied over to initrd and the size is checked).

# I need to remember to edit this
my $version = "v1.0.3";
my $date = "08.09.2000";
my $pwd = `pwd`; chomp $pwd;
use File::Basename;

my $initrd;
my $compress;
my $false = 0;
my $true = 1;
my $ok;
my $box2;
my $label;
my $order;
my $text_window;
my @container;
my @original_container;
my $file_dialog;
my $error_window;
my ($kernel,$root_image,$device,$size);
my $mtab;
my ($tmp,$mnt);

# My own creation - the roots touch the ground if three lines are added.
       my @xpm_data = (
"32 45 3 1",
" 	c None",
".	c SaddleBrown",
"X	c black",
"   ...    ...                   ",
"   ...    ...                   ",
"   ...    ...                   ",
"   ...    ...                   ",
"   ...    ...                   ",
"   ...    ...                   ",
"   ...    ...                   ",
"   ...    ...                   ",
"   ...    ...                   ",
"   ...     ..                   ",
"  ...      ...                  ",
"  ...       ...                 ",
" ....        ...                ",
" ....         ...               ",
" ....          ...              ",
" ....           .............   ",
" .....           .............  ",
" ......           ............. ",
" .......                     ...",
".........                     ..",
"................................",
"................................",
"............................... ",
"......... XXXXX   ............  ",
"........   XXX      ..........  ",
"........   XXX      ........    ",
"         XXXXXX                 ",
"    XXX  XXX   X XX XX          ",
"   X  XXXXX     X   X X         ",
"  XX  XXX       X       XX      ",
" X    XX        X         X     ",
" X    XX        X      XX X     ",
" XX   XX         X    XXXXX     ",
"  X   XXXX XXX    XXXXX   X     ",
" XX   XX      XX    X     XX    ",
" X     X       X    X      X    ",
" X     XX       X   XX     X    ",
" X      XX      XX         X    ",
" X      XX       XXXXXXX XXX    ",
" XX    XX               XXX     ",
"  XX  XX      XXXX     XX XX    ",
"  XX XXX      X  XXXXXXX   X    ",
"  X   XXX     X            XX   ",
"        XX    XXXXXXX       XXX ",
"         X          XX        X ",
"          X          X          "
                        );

$SIG{INT} = \&signal;
$SIG{ABRT} = \&signal;
$SIG{TERM} = \&signal;
$SIG{QUIT} = \&signal;
$SIG{KILL} = \&signal;

if (!-d $tmp1) {
    if (-e $tmp1) {
       error_window(
          "gBootRoot: ERROR: A file exists where $tmp1 should be");
    }
    else {
        my @directory_parts = split(m,/,,$tmp1);
        my $placement = "/";
          for (1 .. $#directory_parts) { 
              $_ == 1 ? ($placement = "/$directory_parts[$_]")
              : ($placement = $placement . "/" . $directory_parts[$_]);  
              -d $placement or err_custom_perl(
              "mkdir $placement","gBootRoot: ERROR: Could not make $tmp1");
           } 
    }
}

if (!-d "$tmp1/gbootroot_tmp$$") {
  $tmp = "$tmp1/gbootroot_tmp$$" if err_custom_perl(
         "mkdir $tmp1/gbootroot_tmp$$",
         "gBootRoot: ERROR: Could not make temporary directory") != 2;
}
if (!-d "$tmp1/gbootroot_mnt$$") {
 $mnt = "$tmp1/gbootroot_mnt$$" if err_custom_perl(
        "mkdir $tmp1/gbootroot_mnt$$",
        "gBootRoot: ERROR: Could not make mount directory") != 2;
}

my $window = new Gtk::Window("toplevel");
$window->set_title("gBootRoot");
$window->set_position('center');
$window->signal_connect( "destroy", sub {
                 unlink "$tmp/verbose", "$tmp/initrd_image.gz";
                 rmdir "$tmp/initrd_mnt"; rmdir "$tmp", rmdir "$mnt"; 
                 Gtk->exit(0); } );
$window->border_width(1);
$window->realize;

# Do the iconizing thing
# "xpm/circles.xpm" can be @pixmap within file if not create_from_xpm.
my ($circles,$mask) = Gtk::Gdk::Pixmap->create_from_xpm_d($window->window, 
                                                        $window->style->white,
                                                        @xpm_data);
$window->window->set_icon(undef, $circles, $mask);      
$window->window->set_icon_name("gBootRoot");    
#$window->window->set_decorations(['all', 'menu']); # Zas
#$window->window->set_functions(['all', 'resize']); # Zas

my $tooltips = new Gtk::Tooltips();

my $box1 = new Gtk::VBox($false,0);
$window->add($box1);
$box1->show();

# First row
hbox();
my $entry = entry($false);

# Menu - later this may be improved if new methods are added.
my $opt = new Gtk::OptionMenu();
$tooltips->set_tip( $opt, "Choose the Boot method.", "" );
my $menu = new Gtk::Menu();
my $item = new Gtk::MenuItem("Method -> lilo" );
$item->show();
$item->signal_connect( 'activate',sub { $entry->set_text("lilo");
                                        $container[0] = "lilo"});
$menu->append( $item );
$opt->set_menu( $menu );
$box2->pack_start( $opt, $true, $true, 0 );
$opt->show();
$box2->show();

# Second row
hbox();
my $entry2 = entry($true,1);
button("Kernel Selection",$entry2,"Kernel Selection",1);

# Third row
hbox();
my $entry3 = entry($true,2);
button("Compressed Filesystem",$entry3,"Compressed Filesystem",2);

# In the future, if experimenters send in data, there will be two 
# different devices.
# Fourth row
hbox();
my $entry4 = entry($true,3);
$entry4->set_text("/dev/fd0");
$container[3] = "/dev/fd0";
button("Device Selection",$entry4,"Device Selection",3,$true);

# Fifth row
hbox("what");
my $adj = new Gtk::Adjustment( 1440.0, 0.0, 360000000.0, 360.0, 360.0, 0.0 );
my $spinner = new Gtk::SpinButton( $adj, 0, 0 );
$tooltips->set_tip( $spinner, "Choose the Device Size.", "" );
$spinner->set_wrap( $true );
$spinner->set_numeric( $true );
$spinner->set_shadow_type( 'in' );
$spinner->show();
$container[4] = 1440;
$adj->signal_connect( "value_changed", sub {
    $container[4] = $spinner->get_value_as_int();});
$box2->pack_start( $spinner, $true, $true, 0 );
label("Device Size");

# gz and bz2 radio buttons
my $rbutton = new Gtk::RadioButton( "gz" );
$tooltips->set_tip( $rbutton, "Choose Compression used on the Filesystem.", "" );
my $gz_toggle = $rbutton;
$rbutton->set_active( $true );
$box2->pack_start( $rbutton, $false, $false, 0 );
$rbutton->show();
$rbutton = new Gtk::RadioButton( "bz2", $rbutton );
$rbutton->set_usize(1,1);
$tooltips->set_tip( $rbutton, "Choose Compression used on the Filesystem.", "" );
my $bz2_toggle = $rbutton;
$box2->pack_start( $rbutton, $true, $true, 0);
$rbutton->show();

# Size status entry 
my $entry5 = new Gtk::Entry();
$entry5->set_editable( $false );
$tooltips->set_tip( $entry5, "This shows room remaining on the Device.", "" );
$entry5->set_usize(15,20);
$box2->pack_start( $entry5, $true, $true, 0 );
$entry5->show();

# Separator
my $separator = new Gtk::HSeparator();
$box1->pack_start( $separator, $false, $true, 0 );
$separator->show();

# Status bar
my $align = new Gtk::Alignment( 0.5, 0.5, 0, 0 );
$box1->pack_start( $align, $false, $false, 5);
$align->show();
my $pbar = new Gtk::ProgressBar();
$pbar->set_usize(321,10); # 321 10 
$align->add($pbar);
$pbar->show();

# Separator
$separator = new Gtk::HSeparator();
$box1->pack_start( $separator, $false, $true, 0 );
$separator->show();

# Submit button 
hbox(); 
my $sbutton = new Gtk::Button("Submit");
$sbutton->signal_connect( "clicked", \&submit);
$tooltips->set_tip( $sbutton, "Generate the Boot/Root set.", "" );
$sbutton->show();
$box2->pack_start( $sbutton, $true, $true, 0 );
$box2->show();

# Close button
my $cbutton = new Gtk::Button("Close");
$cbutton->signal_connect( "clicked", sub { 
                 unlink "$tmp/verbose", "$tmp/initrd_image.gz";
                 rmdir "$tmp/initrd_mnt"; rmdir "$tmp", rmdir "$mnt"; 
                 Gtk->exit(0); });

$tooltips->set_tip( $cbutton, "Exit gBootRoot.", "" );
$cbutton->show();
$box2->pack_start( $cbutton, $true, $true, 0 );
$box2->show();

# Help button
my $hbutton = new Gtk::Button("Help");
$hbutton->signal_connect( "clicked", \&create_text);
$tooltips->set_tip( $hbutton, "Help about gBootRoot.", "" );
$hbutton->show();
$box2->pack_start( $hbutton, $true, $true, 0 );
$box2->show();

$window->show();
main Gtk;
exit( 0 );

#----------------------------

# This works on GNU/Linux
sub signal {
   $SIG{INT} = \&signal; 
   $SIG{ABRT} = \&signal;
   $SIG{TERM} = \&signal;
   $SIG{QUIT} = \&signal;
   $SIG{KILL} = \&signal;
   unlink "$tmp/verbose", "$tmp/initrd_image.gz";
   rmdir "$tmp/initrd_mnt"; rmdir "$tmp", rmdir "$mnt"; 
   Gtk->exit(0);
}

sub create_text {

      if (not defined $text_window) {
       $text_window = new Gtk::Window "toplevel";
       $text_window->signal_connect("destroy", \&destroy_window,
                                    \$text_window);
       $text_window->signal_connect("delete_event", \&destroy_window,
                                    \$text_window);
       $text_window->set_title("Help");
       $text_window->set_usize( 500, 600 );
       $text_window->set_policy( $true, $true, $false );
       $text_window->set_title( "gBootRoot Help" );
       $text_window->border_width(0);

       my $main_vbox = new Gtk::VBox( $false, 0 );
       $text_window->add( $main_vbox );
       $main_vbox->show();

       my $vbox = new Gtk::VBox( $false, 10 );
       $vbox->border_width( 10 );
       $main_vbox->pack_start( $vbox, $true, $true, 0 );
       $vbox->show();

       my $table = new Gtk::Table( 2, 2, $false );
       $table->set_row_spacing( 0, 2 );
       $table->set_col_spacing( 0, 2 );
       $vbox->pack_start( $table, $true, $true, 0 );
       $table->show();

       # Create the GtkText widget
       my $text = new Gtk::Text( undef, undef );
       $text->set_editable($false);
       $table->attach( $text, 0, 1, 0, 1,
                       [ 'expand', 'shrink', 'fill' ],
                       [ 'expand', 'shrink', 'fill' ],
                       0, 0 );
       $text->show();

       # Add a vertical scrollbar to the GtkText widget
       my $vscrollbar = new Gtk::VScrollbar( $text->vadj );
       $table->attach( $vscrollbar, 1, 2, 0, 1, 'fill',
                       [ 'expand', 'shrink', 'fill' ], 0, 0 );
       $vscrollbar->show();

       $text->freeze();
       $text->insert( undef, undef, undef, help() );
       $text->thaw();

       my $separator = new Gtk::HSeparator();
       $main_vbox->pack_start( $separator, $false, $true, 0 );
       $separator->show();

       $vbox = new Gtk::VBox( $false, 10 );
       $vbox->border_width( 10 );
       $main_vbox->pack_start( $vbox, $false, $true, 0 );
       $vbox->show();

       my $button = new Gtk::Button( "Close" );
       $button->signal_connect( 'clicked', sub { destroy $text_window; } );
       $vbox->pack_start( $button, $true, $true, 0 );
       $button->can_default( $true );
       $button->grab_default();
       $button->show();
       }
       if (!visible $text_window) {
		show $text_window;
       } else {
		destroy $text_window;
       }
} # end sub create_text

sub make_menu_item {
    my( $name, $callback, $data ) = @_;
    my $item;
           
    $item = new Gtk::MenuItem( $name );
    $item->signal_connect( "activate", $callback, $data );
    $item->show();
           
    return $item;
}

sub fileselect {

    my ($widget,$ent,$name,$order,$device) = @_;

    if (not defined $file_dialog) {
        # Create a new file selection widget
	$file_dialog = new Gtk::FileSelection( "$name" );
	$file_dialog->signal_connect( "destroy", 
                                     \&destroy_window, \$file_dialog);
	$file_dialog->signal_connect( "delete_event", 
                                     \&destroy_window, \$file_dialog);

        # Connect the ok_button to file_ok_sel function
	$file_dialog->ok_button->signal_connect( "clicked",
					 \&file_ok_sel,
					 $file_dialog,$ent,$order);

        # Connect the cancel_button to destroy the widget
        $file_dialog->cancel_button->signal_connect( "clicked", 
                                              sub { destroy $file_dialog } );
         $file_dialog->set_filename( "/dev/fd0" ) if defined $device; 
         $file_dialog->set_position('mouse');

     }
     if (!visible $file_dialog) {
         show $file_dialog;
     }
     else {
        destroy $file_dialog;
     }
    
} # end sub fileselect


# Get the selected filename and print it to the text widget
sub file_ok_sel {
  
    my( $widget, $file_selection,$entry,$order) = @_;
    my $file = $file_selection->get_filename();
    $entry->set_text($file); 
    $container[$order] = $file;

    # auto-detect compression if system has file
    if ($container[2]) {
        my $file = system "which file > /dev/null 2>&1";
	if ($file == 0) {
	   open(F,"file $container[2]|"); # no error check here
             while (<F>) {
                if (/gzip/) {
                  $gz_toggle->set_active( $true );
                }
                elsif (/bzip2/) {
                  $bz2_toggle->set_active( $true );
                }
             }
        }
    }

    destroy $file_dialog;
   
}

# pulled from test.pl
sub destroy_window {                                                        
        my($widget, $windowref, $w2) = @_;   
        $$windowref = undef;   
        $w2 = undef if defined $w2;
        0;                  
}


sub hbox {
    my $homogeneous;
    defined $_[0] ? ($homogeneous = 0) : ($homogeneous = 1);
    $box2 = new Gtk::HBox( $homogeneous, 5 );
    $box2->border_width( 2 ); # was 10
    $box1->pack_start( $box2, $true, $true, 0 );
    #$box1->pack_start( $box2, $false, $true, 0 );
    $box2->show();
}

sub label {
 
    my($text) = @_;
    
    $label = new Gtk::Label( $text );
    $label->set_justify( "fill" );
    $box2->pack_start( $label, $false, $false, 5 );
    $label->show();

}

sub entry {

    my($edit,$num) = @_;

    my $entry = new Gtk::Entry();
    $entry->set_editable( $edit );
    # enter will have to be pressed, tried other solutions with a mess
    $entry->signal_connect( "activate", sub { 
            $container[$num] = $entry->get_text();});
    if (defined $num) {
     my $todo; 
     if ($num == 1) { 
	 $todo = "the Kernel";
     }
     elsif ($num == 2) {
         $todo = "the Compressed Filesystem";
     }
     else {
         $todo = "the Device to use";
     }
     $tooltips->set_tip( $entry, 
       "Type in the location of $todo and press [Enter].", "" );
    } 
    $box2->pack_start( $entry, $true, $true, 0 );
    $entry->show();
    
    return $entry;

}

sub button {

    my ($text,$ent,$name,$order,$device) = @_;

    my $button = new Gtk::Button($text);
    if ($order == 1) {
      $tooltips->set_tip( $button, "Select the Kernel.", "" );
    }
    elsif ($order == 2) {
      $tooltips->set_tip( $button, "Select the Compressed Filesystem.", "" );
    }
    else {
      $tooltips->set_tip( $button, "Select the Device.", "" );
    } 
    $button->signal_connect( "clicked",\&fileselect,$ent,$name,$order,$device);
    $button->show();
    $box2->pack_start( $button, $true, $true, 0 );
    $box2->show();

}

sub submit {

      my($kernel,$root_image);    
      # comment this out for testing
      unlink("$tmp/verbose");
      open (MTAB, "/etc/mtab") or die "no mtab!\n";
      while (<MTAB>) {
         if (m,$mnt,) {
           system "umount $mnt >> $tmp/verbose 2>&1"; 
         }
      }
      close(MTAB);
      $entry5->set_text("");
      pb("boot",0);

    if ($gz_toggle->active) {
        $compress = "gzip";
    }
    elsif ($bz2_toggle->active) {
        $compress = "bzip2";
    }

# Run some checks
if (!defined $container[0]) {
    error_window("gBootRoot: ERROR: No method supplied");
    return;
}
if (defined $container[1] && -e $container[1] && !-d $container[1]) {
    $kernel = $container[1];
    # Better be sure it isn't in the mount directory
    if ($kernel =~ m,^$mnt,) {
      error_window("gBootRoot: ERROR: Kernel found below Device mount point: $mnt");
      return;
    }

}
elsif (defined $container[0])  {
    error_window("gBootRoot: ERROR: Kernel not found");
    return;
}
if (defined $container[2] && -e $container[2] && !-d $container[2] ) {
    $root_image = $container[2];
    if ($root_image =~ m,^$mnt,) {
      # Bug revealed by Cristian Ionescu-Idbohrn <cii@axis.com>
      error_window("gBootRoot: ERROR: Rootimage found below Device mount point: $mnt");
      return;
    }
}
elsif (defined $container[0] && defined $container[1]) {
    error_window("gBootRoot: ERROR: Rootimage not found");
    return;
}
# we need to check for this, too.
if (defined $container[3] && -e $container[3] && !-d $container[3] ) {
         $device = $container[3];
}
elsif (defined $container[0] && defined $container[1] 
       && defined $container[2]) {
    error_window("gBootRoot: ERROR: Device not found");
    return;
}
if (defined $container[4]) {
	  $size = $container[4];
}

# pretty unlikely
elsif (defined $container[0] && defined $container[1] &&
       defined $container[2] && defined $container[3]) {
    error_window("gBootRoot: ERROR: No size specified");
    return;
}

 # kernel value can change without effecting initrd
 # no sense doing this until important stuff is filled in
 if (defined $kernel && defined $root_image && 
     defined $device && defined $size) {
     $container[5] = $compress;
     if (@original_container) { # defined array deprecate Perl 5.6 -  zas@metaconcept.com
         # a hash check isn't perfect for two values which are the same
         # no need to check all the values
         my @temp_container = @container;
         splice(@temp_container,1,1);
         my %diff;
         grep($diff{$_}++,@temp_container);         
	 my @diff = grep(!$diff{$_},@original_container);
         if ($#diff >= 0) {
         # unlink initrd_image.gz, do initrd()
	     $ok = 1;
	     $initrd = "initrd_image";
         }
         else {
             $ok = 0; 
         }         
     }
     else {
	 $ok = 2; # this is actually first (1 = diff, 0 = same)
	 $initrd = "initrd_image";
     }
     # reset
     @original_container = ($container[0],$root_image,$device,$size,$compress);

     lilo();
 }

} # end sub submit

sub error_window {
    my ($error) = @_;

    if (not defined $error_window) {
    $error_window = new Gtk::Dialog;                
    $error_window->signal_connect("destroy", \&destroy_window, \$error_window);
    $error_window->signal_connect("delete_event", \&destroy_window, \$error_window);                                                           
    $error_window->set_title("gBootRoot ERROR");
    $error_window->border_width(15);                                
    my $label = new Gtk::Label($error);
    $error_window->vbox->pack_start( $label, $true, $true, 15 );
    $label->show();
    my $button = new Gtk::Button("OK");
    $button->signal_connect("clicked", sub {destroy $error_window});
    $button->can_default(1);
    $error_window->action_area->pack_start($button, $false, $false,0);
    $button->grab_default;
    $button->show;
   }
     if (!visible $error_window) {
         show $error_window;
     }
     else {
        destroy $error_window;
     }

} # end sub error_window

sub errmk {
   error_window("gBootRoot: ERROR: Could not make important directories") if $? != 0;
   if (defined $error_window) {
       if ($error_window->visible) {
          return 2;
       }
   }
}

sub errcp {
   error_window("gBootRoot: ERROR: Could not copy over important stuff") if $? != 0; 
   if (defined $error_window) {
       if ($error_window->visible) {
          return 2;
       }
   }
}

sub errum {
   error_window("gBootRoot: ERROR: Could not umount the device") if $? != 0; 
   if (defined $error_window) {
       if ($error_window->visible) {
          return 2;
       }
   }
}

sub errm {
   error_window("gBootRoot: ERROR: Could not mount device") if $? != 0;
   if (defined $error_window) {
       if ($error_window->visible) {
          return 2;
       }
   }
}

sub errrm {
   error_window("gBootRoot: ERROR: Could not remove a directory or file") 
                if $? != 0;
   if (defined $error_window) {
       if ($error_window->visible) {
          return 2;
       }
   }
}

sub err { 
   error_window("gBootRoot: ERROR: Not enough space after all") if ($? > 0); 
   if (defined $error_window) {
       if ($error_window->visible) {
          return 2;
       }
   }
}

sub err_custom { 
 
    if (defined $_[2]) {
         system("$_[0] > /dev/null 2>&1");
    }
    else {
     system("$_[0] >> $tmp/verbose 2>&1");
    }
    error_window($_[1]) if ($? != 0); 
    if (defined $error_window) {
        if ($error_window->visible) {
           return 2;
        }
    }
}

sub err_custom_perl { 

   if ((split(/ /, $_[0]))[0] eq "mkdir") {
      my $two = (split(/ /, $_[0]))[1];
      mkdir($two,0755); # Anyone allowed in
    }
    error_window($_[1]) if ($? != 0); 
    if (defined $error_window) {
        if ($error_window->visible) {
           return 2;
        }
    }
}

sub lilo {

  # Do a little cleanup just in case
  system "rm $tmp/initrd_image.gz 2> /dev/null" if $ok == 1; 
  system "umount $tmp/initrd_mnt 2> /dev/null"; 

  $kernel = $container[1];
  $root_image = $container[2];
  $device = $container[3];
  $size = $container[4];

  if ($ok == 1 || $ok == 2) {
    my $value = initrd($kernel,$root_image,$device,$size);
    mtab(0) if defined $value;
  }
  elsif ($ok == 0) {
    mtab(0);
  }

} # end sub lilo
  
sub lilo_put_it_together {

  my $B = "boot";
  # Time to do a little calculations 
  my $device_size = (split(/\s+/,`df $mnt`))[8]; 
  my $boot_size = (stat($kernel))[12]/2 + (stat("$tmp/$initrd"))[12]/2; 
  my $remain_boot = $device_size - $boot_size;
  pb($B,1);

  # A little output
  if ($remain_boot  =~ /^-+\d+$/) { 
      error_window("gBootRoot: ERROR: Not enough room: boot stuff = $boot_size k, device = $device_size k");
      return;
  }
  else {
      $entry5->set_text("$remain_boot k");
  }

   # Better do this first
  #V#print "Copy over initrd ramdisk\n";
  return if err_custom("cp $tmp/$initrd $mnt/$initrd","gBootRoot: ERROR: Could not copy over initrd") == 2;
  pb($B,2);

  #V#print "Copying over kernel\n";
  return if
  err_custom("rm -rf $mnt/lost+found; cp $kernel $mnt/kernel",
               "gBootRoot: ERROR: Could not copy over the kernel") == 2;
  pb($B,3);

  #V#print "Making stuff for lilo\n";
  return if err(system "mkdir $mnt/{boot,dev} >> $tmp/verbose 2>&1; cp -a /dev/{null,fd?,hda1} $mnt/dev >> $tmp/verbose 2>&1") == 2;
  # Hopefully, this works, but have never tested it
  if ($device !~ m,/dev/fd\d{1}$,) {
     return if err(
     system "cp -a $device $mnt/dev >> $tmp/verbose 2>&1") == 2;
  }
  
  #pb($B,3);
  #V#print "Copy over important lilo stuff\n";
  return if 
  err_custom("cp /boot/boot.b $mnt/boot",
  "gBootRoot: ERROR: Not enough space or can't find /boot/boot.b") == 2;
  pb($B,4);
  # 3k sort of accounts for dev & dirs assuming dev is reasonable
  $remain_boot = $remain_boot - (stat("/boot/boot.b"))[12]/2  - 3;
  $entry5->set_text("$remain_boot k");

    # Write out the HEREDOCS
    open(LC, ">$mnt/brlilo.conf") or die "Couldn't write $mnt/brlilo.conf\n";
    print LC brlilo($device); close(LC);
    open(M, ">$mnt/message") or die "Couldn't write $mnt/message\n";
    print M message(); close(M);
    pb($B,5);
    $remain_boot = $remain_boot - ( (stat("$mnt/brlilo.conf"))[12]/2 + 
                (stat("$mnt/message"))[12]/2 );
    $entry5->set_text("$remain_boot k");

  # Got to umount,mount, and umount again to make sure everything is
  # copied over before doing lilo
  return if errum(system "umount $mnt >> $tmp/verbose 2>&1") == 2;
  #V#print "Umount device\n";
  #V#print "Remount device\n";
  pb($B,6);
  return if errm(system "mount -t ext2 $device $mnt >> $tmp/verbose 2>&1") == 2;  
  #V#print "Configuring lilo\n";
  pb($B,7);
  chdir("$mnt"); #"boot_root: ERROR: Could not change directories\n";
  if (err_custom("lilo -v -C brlilo.conf -r $mnt", 
		 "gBootRoot: ERROR: lilo failed") == 2) {
      chdir($pwd); return; 
  }
  $remain_boot = $remain_boot - (stat("$mnt/boot/map"))[12]/2;
  $entry5->set_text("$remain_boot k");
  pb($B,8);

  chdir($pwd); # or die "boot_root: ERROR: Could not change directories\n";

  #V#print "Umounting $mnt\n";
  my $um = errum(system "umount $mnt >> $tmp/verbose 2>&1");
  pb($B,10);

  if ($ok == 1 || $ok == 2) {
   return if
   errrm(system "rmdir $tmp/initrd_mnt >> $tmp/verbose 2>&1") == 2; 
  }

# Here's where we copy over that compressed filesystem
# We could separate $device = boot,root allowing two 
# different devices to be used.
if ($um == 0 ) {
    mtab(1); 
}
else {
    error_window("gBootRoot: ERROR: Boot disk was never umounted");
}  # copy over the compressed

} # end sub lilo_put_it_together 

sub device2 {
 
  my $device_size = (split(/\s+/,`df $mnt`))[8]; 
  my $root_image_size = (stat($root_image))[12]/2;
  my $remain_root = $device_size - $root_image_size;

  if ($remain_root  =~ /^-+\d+$/) { 
      error_window("gBootRoot: ERROR: Not enough room: root stuff = $root_image_size k, device = $device_size k");
  }
  else {
      $entry5->set_text("$remain_root k");
  }


     #V#print "Copy over the compressed filesystem\n"; 
     return if errrm(system "rmdir $mnt/lost+found >> $tmp/verbose 2>&1") == 2;
     my $broot_image = basename($root_image);

     my $FS = "filesystem";
     my $line_count = `wc -l < $root_image`; chomp $line_count;
     my $half_line_count = $line_count/2;
     my $count = 1;
     open(CF, ">$mnt/$broot_image") or error_window(
     "gBootRoot: ERROR: Could not copy over the root filesystem") and return;
     open(CR, "$root_image") or error_window(
     "gBootRoot: ERROR: Could not copy over the root filesystem") and return; 
     while (<CR>) {
	 print CF $_;
         pb($FS,$count,$line_count) if $count < $half_line_count;
         $count++;
     }
     close(CF); close(CR);

     return if 
     err_custom("umount $mnt", 
      "gBootRoot: ERROR: Root disk did not properly umount") == 2;   
     pb($FS,$count,$line_count);
     #V#print "Finished!\n";

} # end sub device 2

sub initrd_size {

  my ($linuxrc_size) = @_;
  my ($what,$lib);
  #V#print "Checking size needed for initrd\n";

  # the size of the loop device should be at least 1.63% larger than what
  # it will contain (i.e. 8192 inode), but to keep on the safe size it will
  #  be 2.00% larger.
  # 9 dirs  = 1024 each (increase if modified)
  # {ash,gzip,mount,umount} (required executables)
  # bzip2 if $compress eq bzip2 (optional)
  # 1 for ld.so.cache

  # change dir size if needed
  my $dir_size = 9 + 1;
  my $initrd_size = $dir_size + $linuxrc_size;

  # add other executables here
  my @initrd_stuff = qw(ash gzip mount umount);
  foreach (@initrd_stuff) {
     $initrd_size =  $initrd_size + ((stat("/bin/$_"))[12]/2);
  }

  if ($compress eq "bzip2" && -e "/usr/bin/$compress") {
     $initrd_size = $initrd_size + ((stat("/usr/bin/$compress"))[12]/2); 
  }

  # lib sizes
  open(L,"ldd /sbin/init|") or die "Oops, no init could be found :)\n"; # safe to use ldd
   while (<L>) { 
      $lib = (split(/=>/,$_))[0]; 
      $lib =~ s/\s+//;  
      $lib = basename($lib); 
      $lib =~ s/\s+$//; 
      open (SL,"ls -l /lib/$lib|") or die "humm: $!\n"; 
        while (<SL>) { 
          # symbolic link
          if (-l "/lib/$lib") {
            $what = (split(/\s+/,$_))[10]; 
            $initrd_size = $initrd_size + 1;
            $initrd_size = $initrd_size + ((stat("/lib/$what"))[12]/2);
          } 
          # no symbolic link
          else { 
           $initrd_size = $initrd_size + ((stat("/lib/$lib"))[12]/2);
          } 
        }
   }

  $initrd_size = $initrd_size + ($initrd_size * 0.02);
  # For perfection 1 (rounded up) is o.k., but for safety 10 would be 
  # better  
  $initrd_size = sprintf("%.f",$initrd_size) + 10;
  return $initrd_size;

} # end sub initrd_size

sub pb {

    # Will have to count by hand
    if ($_[0] eq "initrd") {
	$pbar->configure( 10, 0, 10 );
    }
    elsif ($_[0] eq "boot") {
	$pbar->configure( 10, 0, 10 );
    }
    elsif ($_[0] eq "filesystem") {
        $pbar->configure($_[2], 0, $_[2]);
    }

    $pbar->set_value($_[1]); 
    # Found this at Gnome .. 
    # http://www.uk.gnome.org/mailing-lists/archives/gtk-list/
    # 1999-October/0401.shtml
    # Also, http://www.gtk.org/faq/  5.14
    while (Gtk->events_pending) { Gtk->main_iteration; } 

}

sub initrd {

    my($kernel,$root_image,$device,$size) = @_;
    my($lib,$what);
    my $I = "initrd";      
    
  my $broot_image = basename($root_image);   
  open(LC, ">$tmp/linuxrc") or die "Couldn't write linuxrc to loop device\n";
  print LC initrd_heredoc($broot_image); close(LC); 
  pb($I,1);
  my $size_needed = initrd_size((stat("$tmp/linuxrc"))[12]/2);
  unlink("$tmp/linuxrc");

  #print V "Using loop device to make initrd\n";
  #V#print V "Make sure you have loop device capability in your running kernel\n";
  system "dd if=/dev/zero of=$tmp/$initrd bs=1024 count=$size_needed >> $tmp/verbose 2>&1";
  pb($I,2);
  # no need to enter y every time
  open(T,"|mke2fs -m0 -i8192 $tmp/$initrd >> $tmp/verbose 2>&1") or die "Problem here: $!\n";  print T "y\n"; close(T);
  pb($I,3);
  #V#print V "Mounting initrd in tmp\n";

return if errmk(system "mkdir $tmp/initrd_mnt >> $tmp/verbose 2>&1; mount -o loop -t ext2 $tmp/$initrd $tmp/initrd_mnt >> $tmp/verbose 2>&1") == 2;
  pb($I,4);

  #V#print "Putting everything together\n";
  open(LC, ">$tmp/initrd_mnt/linuxrc") or die "Couldn't write linuxrc to loop device\n";
  print LC initrd_heredoc($broot_image); close(LC); 
  # I could test this but somebody's system may do permissions differently
  system "chmod 755 $tmp/initrd_mnt/linuxrc >> $tmp/verbose 2>&1";
  system "rmdir $tmp/initrd_mnt/lost+found >> $tmp/verbose 2>&1";
  pb($I,5);

  #V#print "... the dirs\n";
  return if errmk(system "mkdir $tmp/initrd_mnt/{bin,dev,etc,lib,mnt,proc,sbin,usr} >> $tmp/verbose 2>&1; mkdir $tmp/initrd_mnt/usr/lib >> $tmp/verbose 2>&1") == 2; 
  pb($I,6);

  return if errcp(system "cp -a /dev/{console,fd0,null,ram0,ram1,tty0} $tmp/initrd_mnt/dev >> $tmp/verbose 2>&1") == 2;
  # future implementation
  #errcp(system "cp -a $device $tmp/initrd_mnt/dev");
  pb($I,7);

  #V#print ".. the bins\n";
  return if errcp(system "cp -a /bin/{ash,gzip,mount,umount} $tmp/initrd_mnt/bin >> $tmp/verbose 2>&1") == 2;
  if ($compress eq "bzip2") {
      if (-e "/usr/bin/$compress") {
    return if errcp(system "cp -a /usr/bin/$compress $tmp/initrd_mnt/bin >> $tmp/verbose 2>&1") == 2;
      }
  }

  # Testing init is sufficient for grabbing the correct libraries for the
  # executables immediately above.  This could be modified to test a
  # list of executables.  
  #V#print ".. the libs\n";
  open(L,"ldd /sbin/init|") or die "Oops, no init could be found :)\n"; # safe to use ldd
   while (<L>) { 
      $lib = (split(/=>/,$_))[0]; 
      $lib =~ s/\s+//;  
      $lib = basename($lib); 
      $lib =~ s/\s+$//; 
      open (SL,"ls -l /lib/$lib|") or die "humm: $!\n"; 
        while (<SL>) { 
          # symbolic link
          if (-l "/lib/$lib") {
            $what = (split(/\s+/,$_))[10]; 
            return if errcp(system "cp -a /lib/$lib $tmp/initrd_mnt/lib >> $tmp/verbose 2>&1") == 2;
            return if errcp(system "cp -a /lib/$what $tmp/initrd_mnt/lib >> $tmp/verbose 2>&1") == 2;
          } 
          # no symbolic link
          else { 
            return if errcp(system "cp -a /lib/$lib $tmp/initrd_mnt/lib >> $tmp/verbose 2>&1") == 2;
          } 
        }
   }

  #V#print "Determine run-time link bindings\n";
  # Has a return code of 0 regardless
  system "ldconfig -r $tmp/initrd_mnt";
  #V#print "Umounting loop device, and compressing initrd";
  return if errum(system "umount $tmp/initrd_mnt >> $tmp/verbose 2>&1") == 2;
  system "gzip -f9 $tmp/$initrd >> $tmp/verbose 2>&1";
  pb($I,10); # This takes the longest.
  
  $initrd = $initrd . ".gz";


} # end sub initrd

sub mtab_window {
# Will just use a dialog box.
    my ($dialog,$error,$count,$pattern) = @_;

    if (not defined $mtab) {
    $mtab = new Gtk::Dialog;                
    $mtab->signal_connect("destroy", \&destroy_window, \$mtab);
    $mtab->signal_connect("delete_event", \&destroy_window, \$mtab);                                                           
    $mtab->set_title("gBootRoot: Device check");
    $mtab->border_width(15);                                
    $mtab->set_position('center');
    my $label = new Gtk::Label($dialog);
    $label->set_justify( 'left' );
    $label->set_pattern("_________") if defined $pattern;
    $mtab->vbox->pack_start( $label, $true, $true, 15 );
    $label->show();
    my $button = new Gtk::Button("OK");
    $button->signal_connect("clicked", \&mtab_check, $count);
    $button->can_default(1);
    $mtab->action_area->pack_start($button, $false, $false,0);
    $button->grab_default;
    $button->show;
    $button = new Gtk::Button("Cancel"); 
    $button->signal_connect("clicked", sub { destroy $mtab} );
    $mtab->action_area->pack_start($button, $false, $false,0);
    $button->show;
    }
     if (!visible $mtab) {
         show $mtab;
     }
     else {
        destroy $mtab;
        mtab_window($dialog,$error,$count) if $error == 0;
     }

} # end sub mtab_window

sub mtab{
    
# /proc/mount could be used, but maybe there is no /proc
# Press OK when drive and storage medium are ready.  The drive should not
# be mounted. 

  if ($_[0] == 0) {
    my $dialog = "BOOTDISK:\n"
             ."Press OK when the drive and its storage medium are ready.\n"
             ."The Boot Disk will now be made.  All data already on\n"
		 ."the storage medium will be erased.";
    mtab_window($dialog,1,$_[0],1);
  }
  elsif ($_[0] == 1) {
    my $dialog = "ROOTDISK:\n" 
	     ."Press OK when the drive and its storage medium are ready.\n"
             ."The Root Disk will now be made.  All data already on\n"
		 ."the storage medium will be erased.";
    mtab_window($dialog,1,$_[0],1);
  }


} # end sub mtab


sub mtab_check {

    my($widget,$count) = @_;

    my $dialog;
    my $error = 1;

# Check to see if $device is mounted
open (MTAB, "/etc/mtab") or die "no mtab!\n";
while (<MTAB>) {
    if (m,$device,) {
        # Safety Check:
       $dialog = "Please umount the device first.\nPress OK when you are ready.";
       $error = 0;
    }
}
close(MTAB);

mtab_window($dialog,$error,$count) if $error == 0;

  # Make sure the drive and storage medium are accessible 
  # Keep asking until they are.
  if ($error == 1) {
   destroy $mtab;
   system "mke2fs -m0 -i8192 $device $size >> $tmp/verbose 2>&1"; 
   if ($? != 0) {
    $dialog = "gBootRoot: ERROR: You need to insert a disk\n";
     mtab_window($dialog,$error,$count);
     return;
   }
   return if errm(system "mount -t ext2  $device $mnt >> $tmp/verbose 2>&1") == 2;
   lilo_put_it_together() if $count == 0;
   device2() if $count == 1;
  }

} # end sub mtab_check


sub initrd_heredoc {

    my($broot_image) = @_;

# Here's where the initrd is put together using a loop device
# HEREDOC
my $initrd_exec = << "INITRD";
#!/bin/ash

export PATH=/bin:/sbin:/usr/bin:

echo Preparing to setup ramdisk.

mount -o remount,rw / 2>/dev/null

echo Mounting proc...
mount -t proc none /proc

echo -n 'Please insert the root floppy, and press [Enter]: '
read ENTER

echo Mounting floppy drive readonly ...
mount -o ro -t ext2 /dev/fd0 $mnt

echo -n Copying new root to ramdisk .. please wait ...
$compress -cd $mnt/$broot_image > /dev/ram1
echo done.

echo -n Unmounting floppy ...
umount $mnt
echo done.

echo Changing to the new root.
echo 257 >/proc/sys/kernel/real-root-dev

echo -n Unmounting proc ...
umount /proc
echo done.

echo Continuing normal boot procedure from ramdisk.
INITRD

    return $initrd_exec;

} # end sub initrd_heredoc


sub brlilo {

    my ($device) = @_;

# HEREDOC
my $brlilo = << "LILOCONF";
boot = $device
message = message
delay = 50
vga = normal
install = /boot/boot.b
map = /boot/map
backup = /dev/null
compact

# bootdisk
image = kernel 
append = "load_ramdisk = 1 debug"
initrd = $initrd
root = $device
label = bootdisk
read-write

# normalboot
image = kernel 
root = /dev/hda1
label = normalboot
read-only
LILOCONF

    return $brlilo;

} # end sub brlilo


sub message {
# HEREDOC
my $message = << "MESSAGE";

gBootRoot $version written by Jonathan Rosenbaum $date GNU GPL 
mailto:mttrader\@access.mountain.net

Press [Ctrl] to see the lilo prompt.

Press [Tab] to see a list of boot options.

bootdisk   = This will boot a compressed root filesystem
             on another floppy.
normalboot = This will boot up a specified filesystem. 
             default: /dev/hda1  a = 1st drive 
                                 1 = 1st partition
             Use root=/dev/(h or s)dXX
                                 h = IDE Drive
                                 s = SCSI Drive

Trouble:  Do not forget boot: option single
Fix a filesystem:  e2fsck /dev/(h or s)dXX  
Bad superblock:    e2fsck -b 8192 /dev/(h or s)dXX

MESSAGE

    return $message;

} # end sub message

sub help {

<< "HELP";

gBootRoot $version written by Jonathan Rosenbaum $date GNU GPL 
email:mttrader\@access.mountain.net
site -> http://the.netpedia.net/gBootRoot.html

gBootRoot is a Gtk+/Perl program useful for both beginners and advanced 
GNU/Linux users.  It makes the construction/development of emergency and 
mini distributions simple.  

- A GNU/Linux user can easily create an emergency Boot/Root set.  There 
are a multitude of pre-existing compressed filesystems readily available.  
Please check the gBootRoot FAQ at the gBootRoot site listed above.  
** If you are a developer please send me links to Kernel/Filesystems which 
I can share with users of gBootRoot. 

- A developer creating a mini distribution can concentrate his efforts on 
perfecting the filesystem, and then he can use gBootRoot to quickly create a 
Boot/Root set to run tests.  

- Disk sets allow for more space to include interesting and necessary things.
The size of the Kernel is increasing every day making sets advantageous.

How to Use gBootRoot:

gBootRoot is similar to BootRoot, but it is more efficient
and powerful.  The most important button to familiarize yourself 
with is the Submit button which starts the whole process, dialogs are
presented as the process continues asking you if you want to continue "OK" or
stop "Cancel". 

There are 5 rows.  The boot method column has only one choice "lilo."  
Clicking on the menu on the right selects the method.

The second row allows you to select the kernel for the Boot/Root set.  You 
may either use the file selector button on the right hand side, or you may 
type in the location on the left hand side.  

NOTE:
Presently you need to press [Enter] on your keyboard to select what you
typed in, but one advantage of this is that gBootRoot understands shell 
notation like ../twobelow/kernel.  The only disadvantage of this is that my 
program may be written up as an example in a GUI blooper book. :)

The third row allows you to select the compressed filesystem you are 
providing, using either of the two ways mentioned before.

The fourth row allows you to select the device you want to use.  The default
device is the first floppy disk (/dev/fd0).

The fifth row allows you to choose the size of the device being used.
If you choose the compressed filesystem with the file selector the program 
should automatically detect the compression used, otherwise, click on the 
appropriate radio button to choose either gzip or bzip2 compression.

Little things you may want to know:

* gBootRoot requires ash for initrd.  Ash is a feather weight version of Bash.

HELP

}