bike
/
gbootroot
mirror of https://github.com/fspc/gbootroot.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
Browse Source

Namespace cleaning, 5 subs are now exported.

master
freesource 24 years ago
parent
3f0483a604
commit
596ac8224f
1 changed files with 599 additions and 592 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 451
      Yard.pm

451
Yard.pm
View File

@ -31,7 +31,9 @@ package Yard;
use vars qw(@ISA @EXPORT %EXPORT_TAGS);
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT = qw(kernel_version_check read_contents_file extra_links
library_dependencies hard_links space_check
create_filesytem);
use strict;
use File::Basename;
@ -39,75 +41,23 @@ use File::Path;
use FileHandle;
use Cwd; # I am not even sure if this is being used here now
use English; # I think this can be ditched for portability
#use lib "@config_dest@", "@lib_dest@";
#use yardconfig;# this exports these things $scripts_dest
# $lib_dest $config_dest %_path
use File::Find; # used by check_root_fs
# YARDCONFIG.PM
##########################################
##########################################
#$scripts_dest = "@scripts_dest@";
#$lib_dest = "@lib_dest@";
#$config_dest = "@config_dest@";
#unshift(@::INC, $config_dest);
# Ironically this is only used once for objcopy.
#%_path =( 'perl' => '@PERL@',
# 'ldd' => '@LDD@',
# 'ldconfig' => '@LDCONFIG@',
# 'chroot' => '@CHROOT@',
# 'sync' => '@SYNC@',
# 'mount' => '@MOUNT@',
# 'umount' => '@UMOUNT@',
# 'rm' => '@RM@',
# 'dd' => '@DD@',
# 'mke2fs' => '@MKE2FS@',
# 'rdev' => '@RDEV@',
# 'gzip' => '@GZIP@',
# 'uname' => '@UNAME@',
# 'objcopy' => '@OBJCOPY@'
# );
############################################
############################################
# Probably will make this local .. actually don't need them
# FROM YARD_UTILS.PL
# constant.pm not introduced until 5.003_96, so these are
# just global variables.
# Constants from /usr/src/linux/arch/i386/kernel/setup.c:
#$::RAMDISK_IMAGE_START_MASK = 0x07FF;
#$::RAMDISK_PROMPT_FLAG = 0x8000;
#$::RAMDISK_LOAD_FLAG = 0x4000;
# ioctls from /usr/include/linux/fs.h:
#$::BLKGETSIZE_ioctl = 4704;
#$::BLKFLSBUF_ioctl = 4705;
# ext2 fs constants, both in bytes
#$::EXT2_BLOCK_SIZE = 1024;
#$::INODE_SIZE = 1024;
##########################
###########################
# BEGIN { require "yard_utils.pl"; }
# Supplied by gBootroot
#require "Config.pl";
my (%Included, %replaced_by, %links_to, %is_module, %hardlinked,
%strippable, %lib_needed_by, @Libs);
my $cf_line = 0;
my $BLKGETSIZE_ioctl = 4704;
my $BLKFLSBUF_ioctl = 4705;
my $EXT2_BLOCK_SIZE = 1024;
my $INODE_SIZE = 1024;
my $objcopy = "objcopy";
STDOUT->autoflush(1);
start_logging_output();
info(0, "root_fs\n");
info(1, "(running under Perl $PERL_VERSION)\n");
#@@ start_logging_output();
#my($objcopy) = $_path{'objcopy'}; # Define objcopy path if executable exists
my $objcopy = "objcopy";
#@@ info(0, "root_fs\n");
#@@ info(1, "(running under Perl $PERL_VERSION)\n");
my($Warnings) = 0;
sub warning {
@ -144,47 +94,74 @@ sub warning {
# gBootRoot, but it may be restrictive since sometimes it is a
# good thing to mount a whole device .. cdroms for instance.
# Check for sane device choice before we start using it.
check_device();
#@@ check_device();
# Make sure $::device isn't already mounted and $::mount_point is free
load_mount_info();
if (defined($::mounted{$::device})) {
if ($::mounted{$::device} eq $::mount_point) {
#info(1, "Device $::device is already mounted on $::mount_point\n");
info(1, "Unmounting it automatically.\n");
sys("umount $::mount_point");
#@@ load_mount_info();
## This is put here for reference, and is from Config.pl
## loopback is the standard for building a filesytem in gBootRoot.
## No choice here.
# $device: string (device name)
#
# The device for building the filesystem. This can be /dev/ram0 or a
# spare partition. You can turn off swapping temporarily and use the
# swap partition on your hard disk. You can use a loopback device if
# your kernel supports them -- see the section "Using a Loopback
# Device" in the Yard documentation for instructions.
# It should not be a symbolic link.
#
#$device = "/dev/ram0";
#if (defined($::mounted{$::device})) {
# if ($::mounted{$::device} eq $::mount_point) {
# #info(1, "Device $::device is already mounted on $::mount_point\n");
# info(1, "Unmounting it automatically.\n");
# sys("umount $::mount_point");
# } else {
# error("$::device is already mounted elsewhere (on $::mounted{$::device})\n",
# "Unmount it first.\n");
# }
} else {
error("$::device is already mounted elsewhere (on $::mounted{$::device})\n",
"Unmount it first.\n");
}
#} elsif (defined($::mounted{$::mount_point})) {
# error("Some other device is already mounted on $::mount_point\n");
#}
} elsif (defined($::mounted{$::mount_point})) {
error("Some other device is already mounted on $::mount_point\n");
}
# Have to test this every time so we can work around.
test_glob();
## This will get replaced with a readdir loop, no sense relying on people's
## shells. Anotherwards, yard_glob get changed.
#@@ test_glob();
##### Determine release of $::kernel for modules.
##### Set RELEASE environment variable for use in contents.
if (defined($::kernel_version)) {
## Still need an option for this, may become part of beginners section.
## uses kernel_version .. will probably just run these in relation to
## gBootRoots checks.
## 'use Yard; $kernel = "/root/HDB/vmlinuz-2.2.14-ncr"; $kernel_version = "1.2"; kernel_version_check();
## requires $kernel && $kernel_version
sub kernel_version_check {
if (defined($::kernel_version)) {
# Check to see if it agrees
my($version_guess) = kernel_version($::kernel);
if ($version_guess ne $::kernel_version) {
# info(0,
# "You declared kernel ($::kernel) to be version $::kernel_version\n",
# "\teven though a probe says $version_guess.",
# "\tI'll assume you're right.\n";)
## Is this really necessary, it can be assumed a person knows
## what they are doing.
info(0,
"You declared kernel $::kernel to be version $::kernel_version\n",
"even though a probe says $version_guess.",
" I'll assume you're right.\n")
}
$ENV{'RELEASE'} = $::kernel_version;
} elsif (defined($ENV{'RELEASE'} = kernel_version($::kernel))) {
} elsif (defined($ENV{'RELEASE'} = kernel_version($::kernel))) {
info(0, "Version probe of $::kernel returns: $ENV{'RELEASE'}\n");
} else {
} else {
warning "Can't determine kernel version of $::kernel\n";
my($release) = `uname -r`;
if ($release) {
@ -195,34 +172,46 @@ if (defined($::kernel_version)) {
} else {
error("And can't determine running kernel's version either!\n");
}
}
}
warn_about_module_dependencies($ENV{'RELEASE'});
} # end sub kernel_version
if ($::disk_set !~ /^(single|double|base\+extra)$/) {
error("Config variable disk_set is set to \"$::disk_set\"\n",
"which is not a valid value.\n");
}
## This checks lib/modules/$version for rd.o, ext2.o, floppy.o
## Perhaps just extra stuff, this could be made real fancy, too.
#@@warn_about_module_dependencies($ENV{'RELEASE'});
##############################################################################
##### READ IN CONTENTS FILE #####
##############################################################################
my($contents_file) = resolve_file($::contents_file);
info(0, "\n\nPASS 1: Reading $::contents_file");
#info 0, " ($contents_file)" if $contents_file ne $::contents_file;
info(0, "\n");
## gBootRoot does this as a separate process
#if ($::disk_set !~ /^(single|double|base\+extra)$/) {
# error("Config variable disk_set is set to \"$::disk_set\"\n",
# "which is not a valid value.\n");
#}
############################
##### READ IN CONTENTS FILE
############################
## uses info, resolve_file, error, cf_warn, make_link_absolute,
## make_link_relative, cf_die, must_be_abs, replaced_by, yard_glob,
## include_file
## requires $contents_file
sub read_contents_file {
my($contents_file) = resolve_file($::contents_file);
info(0, "\n\nPASS 1: Reading $::contents_file");
#info 0, " ($contents_file)" if $contents_file ne $::contents_file;
info(0, "\n");
my(%Included);
my(%replaced_by);
my(%links_to);
my(%is_module);
#my(%Included);
#my(%replaced_by);
#my(%links_to);
#my(%is_module);
open(CONTENTS, "<$contents_file") or error("$contents_file: $!");
open(CONTENTS, "<$contents_file") or error("$contents_file: $!");
my($cf_line) = 0;
my($line);
my($line);
LINE: while (defined($line = <CONTENTS>)) {
LINE: while (defined($line = <CONTENTS>)) {
my(@files);
$cf_line++;
chomp $line;
@ -232,11 +221,6 @@ LINE: while (defined($line = <CONTENTS>)) {
$line =~ s/^\s+//; # Delete leading/trailing whitespace
$line =~ s/\s+$//;
# if ($line =~ /\$RELEASE/) {
# cf_warn($line, "Make sure \$RELEASE ($ENV{'RELEASE'}) is correct " .
# "for $::kernel");
# }
if ($line =~ /->/) { ##### EXPLICIT LINK
if ($line =~ /[\*\?\[]/) {
cf_warn($line, "Can't use wildcards in link specification!");
@ -342,40 +326,47 @@ LINE: while (defined($line = <CONTENTS>)) {
}
}
} # End of FILE loop
} # End of LINE loop
} # End of LINE loop
info(0, "\nDone with $contents_file\n\n");
info(0, "\nDone with $contents_file\n\n");
if ($::disk_set eq "base+extra") {
include_file(find_file_in_path("tar"))
}
##if ($::disk_set eq "base+extra") {
## include_file(find_file_in_path("tar"))
##}
close(CONTENTS) or error("close on $contents_file: $!");
close(CONTENTS) or error("close on $contents_file: $!");
## may or may not include this in read_contents_file
##############################################################################
info(0, "\n\nPASS 2: Picking up extra files from links...\n");
} # end read_contents_file
#####################################
for (keys %Included) {
sub extra_links {
info(0, "\n\nPASS 2: Picking up extra files from links...\n");
for (keys %Included) {
include_file($_);
}
info(0, "Done.\n\n");
}
info(0, "Done.\n\n");
##############################################################################
#####################################
info(0, "PASS 3: Checking library dependencies...\n");
info(1, "(Ignore any 'statically linked' messages.)\n");
sub library_dependencies {
# Normal file X: X in %Included.
# X -> Y: X in %links_to, Y in %Included
# X <= Y: X in %Included and %replaced_by
info(0, "PASS 3: Checking library dependencies...\n");
info(1, "(Ignore any 'statically linked' messages.)\n");
my(%strippable);
my(%lib_needed_by);
# Normal file X: X in %Included.
# X -> Y: X in %links_to, Y in %Included
# X <= Y: X in %Included and %replaced_by
my($file);
foreach $file (keys %Included) {
my($file);
foreach $file (keys %Included) {
##### Use replacement file if specified
$file = $replaced_by{$file} if defined($replaced_by{$file});
@ -408,6 +399,7 @@ foreach $file (keys %Included) {
##### EXECUTABLE LOADABLE BINARY
##### Run ldd to get library dependencies.
my $line;
foreach $line (`ldd $file`) {
my($lib) = $line =~ / => (\S+)/;
next unless $lib;
@ -444,17 +436,17 @@ foreach $file (keys %Included) {
push(@{$lib_needed_by{$abs_lib}}, $file);
}
}
}
}
##############################################################################
##### Check libraries and loader(s) #####
##############################################################################
my(@Libs) = keys %lib_needed_by;
####################################
##### Check libraries and loader(s)
####################################
(@Libs) = keys %lib_needed_by;
my($seen_ELF_lib, $seen_AOUT_lib);
my(%full_name);
my($seen_ELF_lib, $seen_AOUT_lib);
my(%full_name);
if (@Libs) {
if (@Libs) {
info(1, "\nYou need these libraries:\n");
my($lib);
@ -484,7 +476,7 @@ if (@Libs) {
}
$line .= $binary . " ";
}
#info(1, $line, "\n" if $line);
##info(1, $line, "\n" if $line);
if (!($seen_ELF_lib and $seen_AOUT_lib)) {
@ -517,10 +509,10 @@ if (@Libs) {
$full_name{$lib_stem} = $lib;
}
}
}
}
info(1, "\n");
if ($seen_ELF_lib) {
info(1, "\n");
if ($seen_ELF_lib) {
# There's no official way to get the loader file, AFAIK.
# This expression should get the latest version, and Yard will grab any
# hard-linked file.
@ -531,8 +523,8 @@ if ($seen_ELF_lib) {
} else {
info(0, "Can't find ELF loader /lib/ld-linux.so.?");
}
}
if ($seen_AOUT_lib) {
}
if ($seen_AOUT_lib) {
# Was: yard_glob("/lib/ld.so*")
# Same as above, but ld.so seems to have no version number appended.
my($ld_file);
@ -540,15 +532,20 @@ if ($seen_AOUT_lib) {
info(1, "Adding loader $ld_file for a.out libraries\n");
include_file($ld_file);
}
}
}
info(0, "Done\n\n");
info(0, "Done\n\n");
} # end sub library_dependencies
info(0, "PASS 4: Recording hard links...\n");
sub hard_links {
##### Finally, scan all files for hard links.
my(%hardlinked);
foreach $file (keys %Included) {
info(0, "PASS 4: Recording hard links...\n");
##### Finally, scan all files for hard links.
my($file);
foreach $file (keys %Included) {
next if $links_to{$file} or $replaced_by{$file};
##### $file is guaranteed to be absolute and not symbolically linked.
@ -560,16 +557,22 @@ foreach $file (keys %Included) {
$hardlinked{$file} = "$dev/$inode";
}
}
}
}
info(0, "Done.\n\n");
info(0, "Done.\n\n");
##############################################################################
info(0, "Checking space needed.\n");
my($total_bytes) = 0;
my(%counted);
} # end sub hard_links
foreach $file (keys %Included) {
##########################
sub space_check {
info(0, "Checking space needed.\n");
my($total_bytes) = 0;
my(%counted);
my ($file);
foreach $file (keys %Included) {
my($replacement, $devino);
if ($replacement = $replaced_by{$file}) {
@ -600,8 +603,8 @@ foreach $file (keys %Included) {
}
} elsif (-d $file) {
$total_bytes += $::INODE_SIZE;
info(1, "Directory $file = ", $::INODE_SIZE, " bytes\n");
$total_bytes += $INODE_SIZE;
info(1, "Directory $file = ", $INODE_SIZE, " bytes\n");
} elsif ($file =~ m|^/proc/|) {
##### /proc files screw us up (eg, /proc/kcore), and there's no
@ -613,13 +616,13 @@ foreach $file (keys %Included) {
info(1, "$file size ", -s _, "\n");
$total_bytes += bytes_allocated($file);
}
}
}
# Libraries are already included in the count
# Libraries are already included in the count
info(0, "Total space needed is ", bytes_to_K($total_bytes), " Kbytes\n");
info(0, "Total space needed is ", bytes_to_K($total_bytes), " Kbytes\n");
if (bytes_to_K($total_bytes) > $::fs_size) {
if (bytes_to_K($total_bytes) > $::fs_size) {
info(0, "This is more than $::fs_size Kbytes allowed.\n");
if ($::strip_objfiles) {
info(0, "But since object files will be stripped, more space\n",
@ -627,45 +630,52 @@ if (bytes_to_K($total_bytes) > $::fs_size) {
} else {
error("You need to trim some files out and try again.\n");
}
}
}
info(0, "\n");
info(0, "\n");
##############################################################################
} # end sub space_check
#######################
##### Create filesystem
##############################################################################
sync();
sys("dd if=/dev/zero of=$::device bs=1k count=$::fs_size");
sync();
########################
#@@sync();
#@@sys("dd if=/dev/zero of=$::device bs=1k count=$::fs_size");
#@@sync();
#info(0, "Creating ${::fs_size}K ext2 file system on $::device\n");
if (-f $::device) {
# This could be broken up into a lot of functions
sub create_filesystem {
my $file;
##info(0, "Creating ${::fs_size}K ext2 file system on $::device\n");
if (-f $::device) {
##### If device is a plain file, it means we're using some loopback
##### device. Use -F switch in mke2fs so it won't complain.
sys("mke2fs -F -m 0 -b 1024 $::device $::fs_size");
} else {
} else {
sys("mke2fs -m 0 -b 1024 $::device $::fs_size");
}
&mount_device;
##### lost+found on a ramdisk is pointless
sys("rm -rf $::mount_point/lost+found");
}
sync();
&mount_device;
##### lost+found on a ramdisk is pointless
sys("rm -rf $::mount_point/lost+found");
sync();
##### Setting up the file structure is tricky. Given a tangled set
##### of symbolic links and directories, we have to create the
##### directories, symlinks and files in the right order so that no
##### dependencies are missed.
##### Setting up the file structure is tricky. Given a tangled set
##### of symbolic links and directories, we have to create the
##### directories, symlinks and files in the right order so that no
##### dependencies are missed.
##### First, create directories for symlink targets that are supposed
##### to be directories. Symlink targets can't be superseded so
##### sorting them by path length should give us a linear ordering.
info(0, "Creating directories for symlink targets\n");
##### First, create directories for symlink targets that are supposed
##### to be directories. Symlink targets can't be superseded so
##### sorting them by path length should give us a linear ordering.
info(0, "Creating directories for symlink targets\n");
for $file (sort { path_length($a) <=> path_length($b) }
for $file (sort { path_length($a) <=> path_length($b) }
keys %links_to) {
my($link_target) = $links_to{$file};
my($abs_file) = make_link_absolute($file, $link_target);
@ -676,14 +686,14 @@ for $file (sort { path_length($a) <=> path_length($b) }
info(1, "\tCreating $newdir as a link target for $file\n");
}
}
}
}
##### Next, set up actual symlinks, plus any directories that weren't
##### created in the first pass. Sorting by path length ensures that
##### parent symlinks get set up before child traversals.
info(0, "Creating symlinks and remaining directories.\n");
for $file (sort { path_length($a) <=> path_length($b) }
##### Next, set up actual symlinks, plus any directories that weren't
##### created in the first pass. Sorting by path length ensures that
##### parent symlinks get set up before child traversals.
info(0, "Creating symlinks and remaining directories.\n");
for $file (sort { path_length($a) <=> path_length($b) }
keys %Included) {
my($target);
@ -703,17 +713,16 @@ for $file (sort { path_length($a) <=> path_length($b) }
}
delete $Included{$file}; # Get rid of it so next pass doesn't copy it
}
}
}
##### Tricky stuff is over with, now copy the remaining files.
##### Tricky stuff is over with, now copy the remaining files.
info(0, "\nCopying files to $::device\n");
info(0, "\nCopying files to $::device\n");
my(%copied);
my(%copied);
my($file);
while (($file) = each %Included) {
while (($file) = each %Included) {
my($floppy_file) = $::mount_point . $file;
my($replacement);
@ -766,27 +775,26 @@ while (($file) = each %Included) {
# The 'R' flag here allows cp command to handle devices and FIFOs.
sys("cp -dpR $file $floppy_file");
}
}
}
##############################################################################
info(0, "\nFinished creating root filesystem.\n");
info(0, "\nFinished creating root filesystem.\n");
if (@Libs) {
if (@Libs) {
info(0, "Re-generating /etc/ld.so.cache on root fs.\n");
info(1, "Ignore warnings about missing directories\n");
sys("ldconfig -v -r $::mount_point");
}
}
info(0, "\nDone with $PROGRAM_NAME. $Warnings warnings.\n",
info(0, "\nDone with $PROGRAM_NAME. $Warnings warnings.\n",
"$::device is still mounted on $::mount_point\n");
exit( $Warnings>0 ? -1 : 0);
exit( $Warnings>0 ? -1 : 0);
} # end sub create_filesystem
#############################################################################
##### Utility subs for make_root_fs.pl
#############################################################################
@ -900,15 +908,14 @@ sub copy_strip_file {
##############################################################
##############################################################
##############################################################
###############################################################
###############################################################
##############################################################################
########################################################
##
## YARD_UTILS.PL -- Utilities for the Yard scripts.
##
##############################################################################
########################################################
# Get device number of /proc filesystem
@ -1124,7 +1131,7 @@ sub get_device_size_K {
my($result) = pack("L", 0);
open(FD, $device) or die "open($device): $!";
my($return) = ioctl(FD, $::BLKGETSIZE_ioctl, $result);
my($return) = ioctl(FD, $BLKGETSIZE_ioctl, $result);
close(FD);
if ($return) {
my($bytes) = unpack("L", $result) * $DEV_BSIZE;
@ -1147,7 +1154,7 @@ sub flush_device_buffer_cache {
my($device) = @_;
my($junk) = "stuff";
open(FD, $device) && ioctl(FD, $::BLKFLSBUF_ioctl, $junk);
open(FD, $device) && ioctl(FD, $BLKFLSBUF_ioctl, $junk);
close(FD);
}
@ -1243,7 +1250,7 @@ sub kernel_version {
# it can also be something like 2.2.15-27mdk. Don't make any assumptions
# except that beginning must be dotted triple and it's space delimited.
my($version) = $str =~ /^(\d+\.\d+\.\d+\S*)\s/;
$version
return $version
}
}
@ -1378,10 +1385,10 @@ sub bytes_allocated {
my($size) = -s $file;
if ($size % $::EXT2_BLOCK_SIZE == 0) {
if ($size % $EXT2_BLOCK_SIZE == 0) {
$size
} else {
(int($size / $::EXT2_BLOCK_SIZE) + 1) * $::EXT2_BLOCK_SIZE
(int($size / $EXT2_BLOCK_SIZE) + 1) * $EXT2_BLOCK_SIZE
}
}
@ -1976,4 +1983,4 @@ sub check_termcap {
}
##### END OF CHECK_ROOT_FS
=end
=cut

Write Preview
Loading…
Cancel
Save