gbootroot/gbootroot

#!/usr/bin/perl -w

#    gBootRoot Copyright (C) 2000, 2001, 2002, 2003 
#
#
#    AUTHOR
#    ------
#
#    [ Lead Developer and Project Coordinator ]
#    Jonathan Rosenbaum <freesource@users.sourceforge.net>
#
#
#
#    PATRONS
#    -------
#
#    Shirley Rosenbaum
#    - My mother who provides food and shelter, and who without
#      this project never would have existed, and even though she says she 
#      doesn't understand what it is all about .. I know she does.
#
#    CONTRIBUTORS
#    ------------
#
#    [ Developers ]
#    Cristian Ionescu-Idbohrn <cii@axis.com>
#    - Submitted gdkbirdaao() "Guess Default Kernel Boot Image Root Device 
#      And Append Options", mount directory suggestion, bug reports, lots of 
#      good conversations.
#
#    [ Testers ]
#    Magnus Holmberg <pucko@lysator.liu.se>
#    - Suggestions, BootRoot (predecessor of gBootRoot) FAQ question, 
#      discovered a sizing discrepancy in boot_root.   
#
#    Zas <zas@metaconcept.com>
#    - Discovered a Gtk versioning problem, and unnecessary defined variable.
#
#    Cameron Caffee <Cameron_C_Caffee@AtlanticMutual.com>
#    - Bug reports and data submission which lead to important solutions for 
#      the Boot.
#
#    Liav Asseraf <liav_a@yahoo.com>
#    - Important 1.3.1 bug report and several good questions now incorporated
#      in the FAQ.  Noted an erroneous explanation for a FAQ question in 1.3.2.
#
#    Stian Skjelstad <stian@nixia.no>
#    - Observed that @INC wasn't working properly with rpm based dists with 
#      1.4.0.
#
#    [ Supporters and Users ]
#    Ben Carrell <ben@xmission.com>
#    - Great compliments.
#
#    Wim Vinckier <WimPunk@linuxfan.com>
#    - Sent alert about bad BootRoot site link.
#
#    Linus Gasser <ineiti@gmx.net>
#    - Pointed out lack of mailto in email address, and strange behavior
#      for file download links.
#
#    [ Helper ]
#    Yahshua Mashiyach
#
#    FREE SOFTWARE (partial list only)
#    --------------------------------
#
#    User-Mode-Linux
#    Jeff Dike <jdike@karaya.com>
#
#    Yard
#    Tom Fawcett <fawcett@croftj.net>
#
#    Genext2fs
#    Xavier Bestel <xavier.bestel@free.fr>
#    Erik Andersen <andersen@codepoet.org>   
#
#    Expect Modules
#    Austin Schutz <ASchutz@users.sourceforge.net>
#    Roland Giersig <RGiersig@cpan.org>
#
#    Perl
#    Larry Wall <larry@wall.org>
#
#    Gtk-Perl 
#    Kenneth Albanowski <kjahds@kjahds.com>
#    Paolo Molaro <lupus@debian.org>
#
#    GNU/Linux
#    Linus Torvalds <torvalds@transmeta.com>
#
#    E2fsprogs
#    Theodore Ts'o <tytso@mit.edu>
#
#    lsMode
#    M-J. Dominus <mjd-perl-lsmode-id-i0k+gzzokd+@plover.com>
#
#    http://gbootroot.sourceforge.net

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


# Perhaps you are wondering where to learn 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.   A good reference can be found at 
# http://projects.prosa.it/gtkperl/reference.html

# CHANGES
#       1.3.0  - 12/07/2001
#               * Moved Changes to a /usr/share/doc/gbootroot/Changes
#                 from this version onwards.
#
#######################################################################

# How the Boot/Root set is constructed for the 2 disk compression method:
#
# 1. submit() start the process.
# 2. kernel_modules() sets the $kernel_version.
# 3. lilo() is called.
# 4. $ok determines what functions should be called for creating the
#    Boot disk.
# 5. If initrd hasn't been created yet then initrd is called, and then
#    mtab(0=Boot) .. otherwise only mtab is called.  If initrd is called,
#    then it in turn calls initrd_size to check the size of everything going
#    into the initrd, so that the initrd can be made as small as possible.
# 6. mtab determines which dialog to present to the user and then calls 
#    mtab_window with the numeric value determing whether to make a Boot or 
#    Root disk.  0=Boot 1=Root
# 7. mtab_window (prompts the user) and then calls mtab_check.
# 8. mtab_check checks whether the device is already mounted or not, and will 
#    keep prompting the user until either the device is umounted or a disk is 
#    inserted.  Then it will mke2fs the block device and then it will call
#    lilo_put_it_together if 0, or device2() if 1.
# 9. lilo_put_it_together puts together the initrd and necessary things to get
#    lilo to work properly, and then runs lilo if the device is bootable.
#    If the devel device is not the same as the boot device lilo will be 
#    skipped.  Then mtab(1) is called.
#10. The filesystem for the Root device is made, and then device2 is called
#    to copy over the root filesystem.


# While on the subject of error output:
#
# info($verbosity setting can be {0=blue,1=red}, "text") writes to verbosity
# box and to the LOGFILE $tmp/verbosity.   Realative to the slider 1 == 2 and 
# 0 == 1.
# 
# warning("text") produces 0=blue output with "Warning: " prepended and keeps
# count of warning via the $Warnings variable.
#
# warning_test("text") is like warning except that it doesnt prepend any
# text, and doesn't keep count of anything.
#
# error("text") returns ERROR, writes to verbosity box (Error: "text"), and 
# produces "gBootRoot: ERROR: "text" in error_window(), and writes to the
# LOGFILE $tmp/verbosity .. used to report an error
#
# sys("command action",TESTING) is like system(), if the command fails to open 
# it calls error() and returns ERROR, if the command succeeds it writes the
# output from the action to info(1,$) if $_[1] doesn't equal TESTING, otherwise
# info(3,$_) which is really info(0,"text").  If the command fails it returns
# the error code $? or 0 on success.
# 
# error_window("text") pop-ups an error dialog box with the text, but doesn't
# write to the verbosity box.
#
# The next commands are wrapped around sys() and produce pre-defined text for
# the error_window if an error occurs which returns 2, ofcourse because sys
# is called the output is sent to the verbosity box if the command succeeds.
# function(sys())
#
# errmk() "gBootRoot: ERROR: Could not make important directories" if $? != 0;
#
# errcp() "gBootRoot: ERROR: Could not copy over important stuff" if $? != 0;
#
# errum() "gBootRoot: ERROR: Could not umount the device" if $? != 0;
#
# errm()  "gBootRoot: ERROR: Could not mount device" if $? != 0;
#
# errrm() "gBootRoot: ERROR: Could not remove a directory or file" if $? != 0;
#
# err() "gBootRoot: ERROR: Not enough space after all" if $? > 0
#
# The next commands are both wrapped around sys() and are given customized 
# text to write to the error_window if an error occurs which returns 2.
# Ofcourse because sys is called the output is sent to the verbosity box if 
# the command succeeds.
#
# err_custom("command action","error text","value")  A defined third value will
# cause a normal system("$_[0] > /dev/null 2>&1") othewise 
# BootRoot::Yard::sys("$_[0]") Is used.
#
# err_custom_perl("command action", "error text")  Right now this is just for
# the command "mkdir."  If mkdir is the command mkdir("directory",0755) is 
# called.

# Here's the program:

# For distributions that don't adhere to the most recent FHS.
# I always thought the BEGIN statements were executed before everything else,
# but I have discovered that in this case it has to be placed before the
# use statements if exec /usr/bin/gbootroot is done via $PATH .. I guess
# that makes sense because $PATH is established in the BEGIN.
BEGIN {

    my $fhs = grep(/\/usr\/share\/perl5/,@INC);

    if ($fhs == 0) {
	unshift(@INC,"/usr/share/perl5");
	unshift(@INC,".");  # better make sure we mean . when we mean .
    }


    my $sbin = grep(/\/sbin/,$ENV{'PATH'});
    if ($sbin == 0) {
	$ENV{'PATH'} = "/sbin:" . $ENV{'PATH'};
    }

    $sbin = grep(/\/usr\/sbin/,$ENV{'PATH'});
    if ($sbin == 0) {
	$ENV{'PATH'} = "/usr/sbin:" . $ENV{'PATH'};
    }


    my $pwd = `pwd`; chomp $pwd;

    my $tools = grep(/$pwd\/user-mode-linux\/usr\/bin/,$ENV{'PATH'});
    if ($tools == 0) {
	$ENV{'PATH'} = "$pwd/user-mode-linux/usr/bin:" . $ENV{'PATH'};
    }

    $tools = grep(/$pwd\/user-mode-linux\/usr\/lib\/uml/,$ENV{'PATH'});
    if ($tools == 0) {
	$ENV{'PATH'} = "$pwd/user-mode-linux/usr/lib\/uml:" . $ENV{'PATH'};
    }

}


use strict;
use BootRoot::BootRoot;
use BootRoot::Options;
option();

if ( $Getopt::Long::error > 0 ) {
	
    exit;

}


if ( !%option || $option{gui_mode} ) {
    if ( !$::commandline  ) {
	
	use Gtk;
	init Gtk;
	set_locale Gtk; 
	
    }	

}


$main::editor = "emacs --font 6x13";
$main::makefs = "mke2fs -F -m0 -i8192"; # Root Disk
$main::sudo = "sudo";

start();

if ( !%option || $option{gui_mode} ) {
    if ( !$::commandline  ) {

	main Gtk;
	exit( 0 );
 
    }
}