mirror of
				https://github.com/fspc/gbootroot.git
				synced 2025-11-04 00:05:35 -05:00 
			
		
		
		
	
		
			
				
	
	
		
			204 lines
		
	
	
		
			7.2 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			204 lines
		
	
	
		
			7.2 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
#!/usr/bin/perl -w
 | 
						|
 | 
						|
#    gBootRoot Copyright (C) 2000, 2001
 | 
						|
#
 | 
						|
#
 | 
						|
#    AUTHOR
 | 
						|
#    ------
 | 
						|
#
 | 
						|
#    [ Lead Developer and Project Coordinator ]
 | 
						|
#    Jonathan Rosenbaum <freesource@users.sourceforge.net>
 | 
						|
#
 | 
						|
#
 | 
						|
#
 | 
						|
#    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.
 | 
						|
#
 | 
						|
#    [ 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>   
 | 
						|
#
 | 
						|
#    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; 
 | 
						|
 | 
						|
$main::editor = "emacs --font 6x13";
 | 
						|
$main::makefs = "mke2fs -F -m0 -i8192"; # Root Disk
 | 
						|
$main::sudo = "sudo";
 | 
						|
 | 
						|
start();
 | 
						|
 | 
						|
 | 
						|
main Gtk;
 | 
						|
exit( 0 ); |