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. 451
      Yard.pm

451
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,47 +94,74 @@ 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();
if (defined($::mounted{$::device})) { ## This is put here for reference, and is from Config.pl
## loopback is the standard for building a filesytem in gBootRoot.
if ($::mounted{$::device} eq $::mount_point) { ## No choice here.
#info(1, "Device $::device is already mounted on $::mount_point\n"); # $device: string (device name)
info(1, "Unmounting it automatically.\n"); #
sys("umount $::mount_point"); # 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 { #} 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.
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 # 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;
} elsif (defined($ENV{'RELEASE'} = kernel_version($::kernel))) { } elsif (defined($ENV{'RELEASE'} = kernel_version($::kernel))) {
info(0, "Version probe of $::kernel returns: $ENV{'RELEASE'}\n"); info(0, "Version probe of $::kernel returns: $ENV{'RELEASE'}\n");
} else { } else {
warning "Can't determine kernel version of $::kernel\n"; warning "Can't determine kernel version of $::kernel\n";
my($release) = `uname -r`; my($release) = `uname -r`;
if ($release) { if ($release) {
@ -195,34 +172,46 @@ if (defined($::kernel_version)) {
} else { } else {
error("And can't determine running kernel's version either!\n"); 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)$/) { ## 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
##### READ IN CONTENTS FILE ##### #if ($::disk_set !~ /^(single|double|base\+extra)$/) {
############################################################################## # error("Config variable disk_set is set to \"$::disk_set\"\n",
my($contents_file) = resolve_file($::contents_file); # "which is not a valid value.\n");
info(0, "\n\nPASS 1: Reading $::contents_file"); #}
#info 0, " ($contents_file)" if $contents_file ne $::contents_file;
info(0, "\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(%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>)) {
my(@files); my(@files);
$cf_line++; $cf_line++;
chomp $line; chomp $line;
@ -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!");
@ -342,40 +326,47 @@ LINE: while (defined($line = <CONTENTS>)) {
} }
} }
} # End of FILE loop } # 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") { ##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
info(0, "\n\nPASS 2: Picking up extra files from links...\n");
#####################################
for (keys %Included) { sub extra_links {
info(0, "\n\nPASS 2: Picking up extra files from links...\n");
for (keys %Included) {
include_file($_); include_file($_);
}
info(0, "Done.\n\n");
} }
info(0, "Done.\n\n");
############################################################################## #####################################
info(0, "PASS 3: Checking library dependencies...\n"); sub library_dependencies {
info(1, "(Ignore any 'statically linked' messages.)\n");
# Normal file X: X in %Included. info(0, "PASS 3: Checking library dependencies...\n");
# X -> Y: X in %links_to, Y in %Included info(1, "(Ignore any 'statically linked' messages.)\n");
# X <= Y: X in %Included and %replaced_by
my(%strippable); # Normal file X: X in %Included.
my(%lib_needed_by); # X -> Y: X in %links_to, Y in %Included
# X <= Y: X in %Included and %replaced_by
my($file); my($file);
foreach $file (keys %Included) { foreach $file (keys %Included) {
##### Use replacement file if specified ##### Use replacement file if specified
$file = $replaced_by{$file} if defined($replaced_by{$file}); $file = $replaced_by{$file} if defined($replaced_by{$file});
@ -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;
@ -444,17 +436,17 @@ foreach $file (keys %Included) {
push(@{$lib_needed_by{$abs_lib}}, $file); push(@{$lib_needed_by{$abs_lib}}, $file);
} }
} }
} }
############################################################################## ####################################
##### 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);
if (@Libs) { if (@Libs) {
info(1, "\nYou need these libraries:\n"); info(1, "\nYou need these libraries:\n");
my($lib); my($lib);
@ -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)) {
@ -517,10 +509,10 @@ if (@Libs) {
$full_name{$lib_stem} = $lib; $full_name{$lib_stem} = $lib;
} }
} }
} }
info(1, "\n"); info(1, "\n");
if ($seen_ELF_lib) { if ($seen_ELF_lib) {
# There's no official way to get the loader file, AFAIK. # There's no official way to get the loader file, AFAIK.
# This expression should get the latest version, and Yard will grab any # This expression should get the latest version, and Yard will grab any
# hard-linked file. # hard-linked file.
@ -531,8 +523,8 @@ if ($seen_ELF_lib) {
} else { } else {
info(0, "Can't find ELF loader /lib/ld-linux.so.?"); 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*") # Was: yard_glob("/lib/ld.so*")
# Same as above, but ld.so seems to have no version number appended. # Same as above, but ld.so seems to have no version number appended.
my($ld_file); my($ld_file);
@ -540,15 +532,20 @@ if ($seen_AOUT_lib) {
info(1, "Adding loader $ld_file for a.out libraries\n"); info(1, "Adding loader $ld_file for a.out libraries\n");
include_file($ld_file); 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. info(0, "PASS 4: Recording hard links...\n");
my(%hardlinked);
foreach $file (keys %Included) { ##### Finally, scan all files for hard links.
my($file);
foreach $file (keys %Included) {
next if $links_to{$file} or $replaced_by{$file}; next if $links_to{$file} or $replaced_by{$file};
##### $file is guaranteed to be absolute and not symbolically linked. ##### $file is guaranteed to be absolute and not symbolically linked.
@ -560,16 +557,22 @@ foreach $file (keys %Included) {
$hardlinked{$file} = "$dev/$inode"; $hardlinked{$file} = "$dev/$inode";
} }
} }
} }
info(0, "Done.\n\n"); info(0, "Done.\n\n");
############################################################################## } # end sub hard_links
info(0, "Checking space needed.\n");
my($total_bytes) = 0;
my(%counted);
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); my($replacement, $devino);
if ($replacement = $replaced_by{$file}) { if ($replacement = $replaced_by{$file}) {
@ -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
@ -613,13 +616,13 @@ foreach $file (keys %Included) {
info(1, "$file size ", -s _, "\n"); info(1, "$file size ", -s _, "\n");
$total_bytes += bytes_allocated($file); $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"); info(0, "This is more than $::fs_size Kbytes allowed.\n");
if ($::strip_objfiles) { if ($::strip_objfiles) {
info(0, "But since object files will be stripped, more space\n", 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 { } else {
error("You need to trim some files out and try again.\n"); error("You need to trim some files out and try again.\n");
} }
} }
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");
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 ##### If device is a plain file, it means we're using some loopback
##### device. Use -F switch in mke2fs so it won't complain. ##### device. Use -F switch in mke2fs so it won't complain.
sys("mke2fs -F -m 0 -b 1024 $::device $::fs_size"); sys("mke2fs -F -m 0 -b 1024 $::device $::fs_size");
} else { } else {
sys("mke2fs -m 0 -b 1024 $::device $::fs_size"); 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 ##### 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
##### dependencies are missed. ##### dependencies are missed.
##### First, create directories for symlink targets that are supposed ##### First, create directories for symlink targets that are supposed
##### to be directories. Symlink targets can't be superseded so ##### to be directories. Symlink targets can't be superseded so
##### sorting them by path length should give us a linear ordering. ##### sorting them by path length should give us a linear ordering.
info(0, "Creating directories for symlink targets\n"); 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) { keys %links_to) {
my($link_target) = $links_to{$file}; my($link_target) = $links_to{$file};
my($abs_file) = make_link_absolute($file, $link_target); 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"); info(1, "\tCreating $newdir as a link target for $file\n");
} }
} }
} }
##### Next, set up actual symlinks, plus any directories that weren't ##### Next, set up actual symlinks, plus any directories that weren't
##### created in the first pass. Sorting by path length ensures that ##### created in the first pass. Sorting by path length ensures that
##### parent symlinks get set up before child traversals. ##### parent symlinks get set up before child traversals.
info(0, "Creating symlinks and remaining directories.\n"); info(0, "Creating symlinks and remaining directories.\n");
for $file (sort { path_length($a) <=> path_length($b) } for $file (sort { path_length($a) <=> path_length($b) }
keys %Included) { keys %Included) {
my($target); 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 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($floppy_file) = $::mount_point . $file;
my($replacement); my($replacement);
@ -766,27 +775,26 @@ while (($file) = each %Included) {
# The 'R' flag here allows cp command to handle devices and FIFOs. # The 'R' flag here allows cp command to handle devices and FIFOs.
sys("cp -dpR $file $floppy_file"); 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(0, "Re-generating /etc/ld.so.cache on root fs.\n");
info(1, "Ignore warnings about missing directories\n"); info(1, "Ignore warnings about missing directories\n");
sys("ldconfig -v -r $::mount_point"); 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"); "$::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 ##### 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