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
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 285
      Yard.pm

285
Yard.pm
View File

@ -31,7 +31,9 @@ package Yard;
use vars qw(@ISA @EXPORT %EXPORT_TAGS); use vars qw(@ISA @EXPORT %EXPORT_TAGS);
use Exporter; use Exporter;
@ISA = qw(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 strict;
use File::Basename; use File::Basename;
@ -39,75 +41,23 @@ use File::Path;
use FileHandle; use FileHandle;
use Cwd; # I am not even sure if this is being used here now 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 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 use File::Find; # used by check_root_fs
# YARDCONFIG.PM my (%Included, %replaced_by, %links_to, %is_module, %hardlinked,
########################################## %strippable, %lib_needed_by, @Libs);
########################################## my $cf_line = 0;
my $BLKGETSIZE_ioctl = 4704;
#$scripts_dest = "@scripts_dest@"; my $BLKFLSBUF_ioctl = 4705;
#$lib_dest = "@lib_dest@"; my $EXT2_BLOCK_SIZE = 1024;
#$config_dest = "@config_dest@"; my $INODE_SIZE = 1024;
my $objcopy = "objcopy";
#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";
STDOUT->autoflush(1); STDOUT->autoflush(1);
start_logging_output(); #@@ start_logging_output();
info(0, "root_fs\n");
info(1, "(running under Perl $PERL_VERSION)\n");
#my($objcopy) = $_path{'objcopy'}; # Define objcopy path if executable exists #@@ info(0, "root_fs\n");
my $objcopy = "objcopy"; #@@ info(1, "(running under Perl $PERL_VERSION)\n");
my($Warnings) = 0; my($Warnings) = 0;
sub warning { sub warning {
@ -144,40 +94,67 @@ sub warning {
# gBootRoot, but it may be restrictive since sometimes it is a # gBootRoot, but it may be restrictive since sometimes it is a
# good thing to mount a whole device .. cdroms for instance. # good thing to mount a whole device .. cdroms for instance.
# Check for sane device choice before we start using it. # 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 # Make sure $::device isn't already mounted and $::mount_point is free
load_mount_info(); #@@ 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");
if (defined($::mounted{$::device})) { # } else {
# error("$::device is already mounted elsewhere (on $::mounted{$::device})\n",
if ($::mounted{$::device} eq $::mount_point) { # "Unmount it first.\n");
#info(1, "Device $::device is already mounted on $::mount_point\n"); # }
info(1, "Unmounting it automatically.\n");
sys("umount $::mount_point");
} else { #} elsif (defined($::mounted{$::mount_point})) {
error("$::device is already mounted elsewhere (on $::mounted{$::device})\n", # error("Some other device is already mounted on $::mount_point\n");
"Unmount it first.\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. # 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. ##### Determine release of $::kernel for modules.
##### Set RELEASE environment variable for use in contents. ##### Set RELEASE environment variable for use in contents.
## 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)) { if (defined($::kernel_version)) {
# Check to see if it agrees # Check to see if it agrees
my($version_guess) = kernel_version($::kernel); my($version_guess) = kernel_version($::kernel);
if ($version_guess ne $::kernel_version) { if ($version_guess ne $::kernel_version) {
# info(0, ## Is this really necessary, it can be assumed a person knows
# "You declared kernel ($::kernel) to be version $::kernel_version\n", ## what they are doing.
# "\teven though a probe says $version_guess.", info(0,
# "\tI'll assume you're right.\n";) "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; $ENV{'RELEASE'} = $::kernel_version;
@ -197,29 +174,41 @@ if (defined($::kernel_version)) {
} }
} }
warn_about_module_dependencies($ENV{'RELEASE'}); } # end sub kernel_version
if ($::disk_set !~ /^(single|double|base\+extra)$/) { ## This checks lib/modules/$version for rd.o, ext2.o, floppy.o
error("Config variable disk_set is set to \"$::disk_set\"\n", ## Perhaps just extra stuff, this could be made real fancy, too.
"which is not a valid value.\n"); #@@warn_about_module_dependencies($ENV{'RELEASE'});
}
## 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 {
##############################################################################
##### READ IN CONTENTS FILE #####
##############################################################################
my($contents_file) = resolve_file($::contents_file); my($contents_file) = resolve_file($::contents_file);
info(0, "\n\nPASS 1: Reading $::contents_file"); info(0, "\n\nPASS 1: Reading $::contents_file");
#info 0, " ($contents_file)" if $contents_file ne $::contents_file; #info 0, " ($contents_file)" if $contents_file ne $::contents_file;
info(0, "\n"); info(0, "\n");
my(%Included); #my(%Included);
my(%replaced_by); #my(%replaced_by);
my(%links_to); #my(%links_to);
my(%is_module); #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>)) {
@ -232,11 +221,6 @@ LINE: while (defined($line = <CONTENTS>)) {
$line =~ s/^\s+//; # Delete leading/trailing whitespace $line =~ s/^\s+//; # Delete leading/trailing whitespace
$line =~ s/\s+$//; $line =~ s/\s+$//;
# if ($line =~ /\$RELEASE/) {
# cf_warn($line, "Make sure \$RELEASE ($ENV{'RELEASE'}) is correct " .
# "for $::kernel");
# }
if ($line =~ /->/) { ##### EXPLICIT LINK if ($line =~ /->/) { ##### EXPLICIT LINK
if ($line =~ /[\*\?\[]/) { if ($line =~ /[\*\?\[]/) {
cf_warn($line, "Can't use wildcards in link specification!"); cf_warn($line, "Can't use wildcards in link specification!");
@ -346,14 +330,20 @@ LINE: while (defined($line = <CONTENTS>)) {
info(0, "\nDone with $contents_file\n\n"); info(0, "\nDone with $contents_file\n\n");
if ($::disk_set eq "base+extra") { ##if ($::disk_set eq "base+extra") {
include_file(find_file_in_path("tar")) ## 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
} # end read_contents_file
#####################################
sub extra_links {
##############################################################################
info(0, "\n\nPASS 2: Picking up extra files from links...\n"); info(0, "\n\nPASS 2: Picking up extra files from links...\n");
for (keys %Included) { for (keys %Included) {
@ -361,8 +351,12 @@ for (keys %Included) {
} }
info(0, "Done.\n\n"); info(0, "Done.\n\n");
}
##############################################################################
#####################################
sub library_dependencies {
info(0, "PASS 3: Checking library dependencies...\n"); info(0, "PASS 3: Checking library dependencies...\n");
info(1, "(Ignore any 'statically linked' messages.)\n"); info(1, "(Ignore any 'statically linked' messages.)\n");
@ -371,9 +365,6 @@ info(1, "(Ignore any 'statically linked' messages.)\n");
# X -> Y: X in %links_to, Y in %Included # X -> Y: X in %links_to, Y in %Included
# X <= Y: X in %Included and %replaced_by # X <= Y: X in %Included and %replaced_by
my(%strippable);
my(%lib_needed_by);
my($file); my($file);
foreach $file (keys %Included) { foreach $file (keys %Included) {
@ -408,6 +399,7 @@ foreach $file (keys %Included) {
##### EXECUTABLE LOADABLE BINARY ##### EXECUTABLE LOADABLE BINARY
##### Run ldd to get library dependencies. ##### Run ldd to get library dependencies.
my $line;
foreach $line (`ldd $file`) { foreach $line (`ldd $file`) {
my($lib) = $line =~ / => (\S+)/; my($lib) = $line =~ / => (\S+)/;
next unless $lib; next unless $lib;
@ -446,10 +438,10 @@ foreach $file (keys %Included) {
} }
} }
############################################################################## ####################################
##### Check libraries and loader(s) ##### ##### Check libraries and loader(s)
############################################################################## ####################################
my(@Libs) = keys %lib_needed_by; (@Libs) = keys %lib_needed_by;
my($seen_ELF_lib, $seen_AOUT_lib); my($seen_ELF_lib, $seen_AOUT_lib);
my(%full_name); my(%full_name);
@ -484,7 +476,7 @@ if (@Libs) {
} }
$line .= $binary . " "; $line .= $binary . " ";
} }
#info(1, $line, "\n" if $line); ##info(1, $line, "\n" if $line);
if (!($seen_ELF_lib and $seen_AOUT_lib)) { if (!($seen_ELF_lib and $seen_AOUT_lib)) {
@ -544,10 +536,15 @@ if ($seen_AOUT_lib) {
info(0, "Done\n\n"); info(0, "Done\n\n");
} # end sub library_dependencies
sub hard_links {
info(0, "PASS 4: Recording hard links...\n"); info(0, "PASS 4: Recording hard links...\n");
##### Finally, scan all files for hard links. ##### Finally, scan all files for hard links.
my(%hardlinked);
my($file);
foreach $file (keys %Included) { foreach $file (keys %Included) {
next if $links_to{$file} or $replaced_by{$file}; next if $links_to{$file} or $replaced_by{$file};
@ -564,11 +561,17 @@ foreach $file (keys %Included) {
info(0, "Done.\n\n"); info(0, "Done.\n\n");
############################################################################## } # end sub hard_links
##########################
sub space_check {
info(0, "Checking space needed.\n"); info(0, "Checking space needed.\n");
my($total_bytes) = 0; my($total_bytes) = 0;
my(%counted); my(%counted);
my ($file);
foreach $file (keys %Included) { foreach $file (keys %Included) {
my($replacement, $devino); my($replacement, $devino);
@ -600,8 +603,8 @@ foreach $file (keys %Included) {
} }
} elsif (-d $file) { } elsif (-d $file) {
$total_bytes += $::INODE_SIZE; $total_bytes += $INODE_SIZE;
info(1, "Directory $file = ", $::INODE_SIZE, " bytes\n"); info(1, "Directory $file = ", $INODE_SIZE, " bytes\n");
} elsif ($file =~ m|^/proc/|) { } elsif ($file =~ m|^/proc/|) {
##### /proc files screw us up (eg, /proc/kcore), and there's no ##### /proc files screw us up (eg, /proc/kcore), and there's no
@ -631,14 +634,22 @@ if (bytes_to_K($total_bytes) > $::fs_size) {
info(0, "\n"); info(0, "\n");
############################################################################## } # end sub space_check
#######################
##### Create filesystem ##### Create filesystem
############################################################################## ########################
sync(); #@@sync();
sys("dd if=/dev/zero of=$::device bs=1k count=$::fs_size"); #@@sys("dd if=/dev/zero of=$::device bs=1k count=$::fs_size");
sync(); #@@sync();
#info(0, "Creating ${::fs_size}K ext2 file system on $::device\n");
# 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 (-f $::device) {
##### If device is a plain file, it means we're using some loopback ##### If device is a plain file, it means we're using some loopback
@ -654,7 +665,6 @@ sys("rm -rf $::mount_point/lost+found");
sync(); sync();
##### Setting up the file structure is tricky. Given a tangled set ##### Setting up the file structure is tricky. Given a tangled set
##### of symbolic links and directories, we have to create the ##### of symbolic links and directories, we have to create the
##### directories, symlinks and files in the right order so that no ##### directories, symlinks and files in the right order so that no
@ -712,7 +722,6 @@ 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($floppy_file) = $::mount_point . $file;
@ -769,8 +778,6 @@ while (($file) = each %Included) {
} }
##############################################################################
info(0, "\nFinished creating root filesystem.\n"); info(0, "\nFinished creating root filesystem.\n");
if (@Libs) { if (@Libs) {
@ -786,7 +793,8 @@ info(0, "\nDone with $PROGRAM_NAME. $Warnings warnings.\n",
exit( $Warnings>0 ? -1 : 0); exit( $Warnings>0 ? -1 : 0);
} # end sub create_filesystem
############################################################################# #############################################################################
##### Utility subs for make_root_fs.pl ##### Utility subs for make_root_fs.pl
############################################################################# #############################################################################
@ -900,15 +908,14 @@ sub copy_strip_file {
############################################################## ##############################################################
############################################################## ##############################################################
############################################################## ##############################################################
############################################################### ###############################################################
############################################################### ###############################################################
############################################################################## ########################################################
## ##
## YARD_UTILS.PL -- Utilities for the Yard scripts. ## YARD_UTILS.PL -- Utilities for the Yard scripts.
## ##
############################################################################## ########################################################
# Get device number of /proc filesystem # Get device number of /proc filesystem
@ -1124,7 +1131,7 @@ sub get_device_size_K {
my($result) = pack("L", 0); my($result) = pack("L", 0);
open(FD, $device) or die "open($device): $!"; open(FD, $device) or die "open($device): $!";
my($return) = ioctl(FD, $::BLKGETSIZE_ioctl, $result); my($return) = ioctl(FD, $BLKGETSIZE_ioctl, $result);
close(FD); close(FD);
if ($return) { if ($return) {
my($bytes) = unpack("L", $result) * $DEV_BSIZE; my($bytes) = unpack("L", $result) * $DEV_BSIZE;
@ -1147,7 +1154,7 @@ sub flush_device_buffer_cache {
my($device) = @_; my($device) = @_;
my($junk) = "stuff"; my($junk) = "stuff";
open(FD, $device) && ioctl(FD, $::BLKFLSBUF_ioctl, $junk); open(FD, $device) && ioctl(FD, $BLKFLSBUF_ioctl, $junk);
close(FD); close(FD);
} }
@ -1243,7 +1250,7 @@ sub kernel_version {
# it can also be something like 2.2.15-27mdk. Don't make any assumptions # 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. # except that beginning must be dotted triple and it's space delimited.
my($version) = $str =~ /^(\d+\.\d+\.\d+\S*)\s/; my($version) = $str =~ /^(\d+\.\d+\.\d+\S*)\s/;
$version return $version
} }
} }
@ -1378,10 +1385,10 @@ sub bytes_allocated {
my($size) = -s $file; my($size) = -s $file;
if ($size % $::EXT2_BLOCK_SIZE == 0) { if ($size % $EXT2_BLOCK_SIZE == 0) {
$size $size
} else { } 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 OF CHECK_ROOT_FS
=end =cut

Write Preview
Loading…
Cancel
Save