Namespace cleaning, 5 subs are now exported.

24 years ago · 596ac8224f
1 changed files with 599 additions and 592 deletions
--- a/Yard.pm
+++ b/Yard.pm
@ -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,40 +94,67 @@ 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();
+#@@ 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})) {
-
-  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.
+## 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;

@ -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)$/) {
-  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'});
+
+## 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);
    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: $!");

-my($cf_line) = 0;
    my($line);

  LINE: while (defined($line = <CONTENTS>)) {
@ -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!");
@ -346,14 +330,20 @@ LINE: while (defined($line = <CONTENTS>)) {

    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: $!");

+## 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");

    for (keys %Included) {
@ -361,8 +351,12 @@ for (keys %Included) {
    }

    info(0, "Done.\n\n");
+}

-##############################################################################
+
+#####################################
+
+sub library_dependencies {

    info(0, "PASS 3:  Checking library dependencies...\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 %Included and %replaced_by

-my(%strippable);
-my(%lib_needed_by);
-
    my($file);
    foreach $file (keys %Included) {

@ -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;
@ -446,10 +438,10 @@ foreach $file (keys %Included) {
 	}
    }

-##############################################################################
-#####  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);
@ -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)) {

@ -544,10 +536,15 @@ if ($seen_AOUT_lib) {

    info(0, "Done\n\n");

+} # end sub library_dependencies
+
+sub hard_links {
+
    info(0, "PASS 4:  Recording hard links...\n");

    #####  Finally, scan all files for hard links.
-my(%hardlinked);
+
+    my($file);
    foreach $file (keys %Included) {

 	next if $links_to{$file} or $replaced_by{$file};
@ -564,11 +561,17 @@ foreach $file (keys %Included) {

    info(0, "Done.\n\n");

-##############################################################################
+} # end sub hard_links
+
+##########################
+
+sub space_check {
+
    info(0, "Checking space needed.\n");
    my($total_bytes) = 0;
    my(%counted);

+    my ($file);
    foreach $file (keys %Included) {

 	my($replacement, $devino);
@ -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
@ -631,14 +634,22 @@ if (bytes_to_K($total_bytes) > $::fs_size) {

    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");
+
+# 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
@ -654,7 +665,6 @@ 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
@ -712,7 +722,6 @@ info(0, "\nCopying files to $::device\n");

    my(%copied);

-my($file);
    while (($file) = each %Included) {
 	my($floppy_file) = $::mount_point . $file;

@ -769,8 +778,6 @@ while (($file) = each %Included) {
    }


-##############################################################################
-
    info(0, "\nFinished creating root filesystem.\n");

    if (@Libs) {
@ -786,7 +793,8 @@ info(0, "\nDone with $PROGRAM_NAME.  $Warnings warnings.\n",

    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