|
|
|
#!/usr/bin/perl -w
|
|
|
|
|
|
|
|
# gBootRoot Copyright (C) 2000, 2001, 2002
|
|
|
|
#
|
|
|
|
#
|
|
|
|
# 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.
|
|
|
|
#
|
|
|
|
# [ Supporters and Users ]
|
|
|
|
# Ben Carrell <ben@xmission.com>
|
|
|
|
# - Great compliments.
|
|
|
|
#
|
|
|
|
# Wim Vinckier <WimPunk@linuxfan.com>
|
|
|
|
# - Sent alert about bad BootRoot site link.
|
|
|
|
#
|
|
|
|
# [ 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:
|
|
|
|
|
|
|
|
use Gtk;
|
|
|
|
use strict;
|
|
|
|
use BootRoot::BootRoot;
|
|
|
|
init Gtk;
|
|
|
|
set_locale Gtk;
|
|
|
|
|
|
|
|
# For distributions that don't adhere to the most recent FHS.
|
|
|
|
BEGIN {
|
|
|
|
|
|
|
|
my $fhs = grep(/\/usr\/share\/perl5/,@INC);
|
|
|
|
|
|
|
|
if ($fhs == 0) {
|
|
|
|
unshift(@INC,"/usr/share/perl5");
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
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'};
|
|
|
|
}
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
$main::editor = "emacs --font 6x13";
|
|
|
|
$main::makefs = "mke2fs -F -m0 -i8192"; # Root Disk
|
|
|
|
$main::sudo = "sudo";
|
|
|
|
|
|
|
|
start();
|
|
|
|
|
|
|
|
|
|
|
|
main Gtk;
|
|
|
|
exit( 0 );
|
|
|
|
|