Browse Source

* As mentioned in task 22496, cleaned up cf_die and its evil brother error.

* What a mysterious saying. :)
master
freesource 24 years ago
parent
commit
d884211935
  1. 81
      Yard.pm

81
Yard.pm

@ -34,7 +34,7 @@ use Exporter;
@EXPORT = qw(start_logging_output info kernel_version_check verbosity @EXPORT = qw(start_logging_output info kernel_version_check verbosity
read_contents_file extra_links library_dependencies hard_links read_contents_file extra_links library_dependencies hard_links
space_check create_filesystem find_file_in_path sys space_check create_filesystem find_file_in_path sys
text_insert logadj); text_insert logadj error);
use strict; use strict;
use File::Basename; use File::Basename;
@ -108,7 +108,9 @@ sub kernel_version_check {
"Make sure this is OK\n"); "Make sure this is OK\n");
$ENV{'RELEASE'} = $release; $ENV{'RELEASE'} = $release;
} else { } else {
error("And can't determine running kernel's version either!\n"); my $error = error(
"And can't determine running kernel's version either!\n");
return "ERROR" if $error && $error eq "ERROR";
} }
} }
@ -127,11 +129,14 @@ sub kernel_version_check {
sub read_contents_file { sub read_contents_file {
my ($contents_file) = @_; my ($contents_file) = @_;
my $error;
info(0, "\n\nPASS 1: Reading $contents_file"); info(0, "\n\nPASS 1: Reading $contents_file");
info(0, "\n"); info(0, "\n");
open(CONTENTS, "<$contents_file") or error("$contents_file: $!"); open(CONTENTS, "<$contents_file") or
($error = error("$contents_file: $!"));
return "ERROR"if $error && $error eq "ERROR";
my($line); my($line);
@ -171,9 +176,10 @@ sub read_contents_file {
@files = ($abs_link); @files = ($abs_link);
} elsif ($line =~ /<=/) { ##### REPLACEMENT SPEC } elsif ($line =~ /<=/) { ##### REPLACEMENT SPEC
cf_die($contents_file, $line, $error = cf_die($contents_file, $line,
"Can't use wildcard in replacement specification") if "Can't use wildcard in replacement specification") if
$line =~ /[\*\?\[]/; $line =~ /[\*\?\[]/;
return "ERROR" if $error && $error eq "ERROR";
my($file, $replacement) = $line =~ /^(\S+)\s*<=\s*(\S+)\s*$/; my($file, $replacement) = $line =~ /^(\S+)\s*<=\s*(\S+)\s*$/;
@ -264,7 +270,8 @@ sub read_contents_file {
} # End of LINE loop } # End of LINE loop
info(0, "\nDone with $contents_file\n\n"); info(0, "\nDone with $contents_file\n\n");
close(CONTENTS) or error("close on $contents_file: $!"); close(CONTENTS) or ($error = error("close on $contents_file: $!"));
return "ERROR"if $error && $error eq "ERROR";
} # end read_contents_file } # end read_contents_file
@ -288,6 +295,7 @@ sub extra_links {
sub library_dependencies { sub library_dependencies {
my ($contents_file) = @_; my ($contents_file) = @_;
my $error;
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");
@ -359,7 +367,8 @@ sub library_dependencies {
} }
last unless -l $abs_lib; last unless -l $abs_lib;
my($link) = readlink($abs_lib) or my($link) = readlink($abs_lib) or
error("readlink($abs_lib): $!"); ($error = error("readlink($abs_lib): $!"));
return "ERROR"if $error && $error eq "ERROR";
$abs_lib = make_link_absolute($abs_lib, $link); $abs_lib = make_link_absolute($abs_lib, $link);
} }
@ -390,9 +399,11 @@ sub library_dependencies {
my($file_output) = `file $lib`; my($file_output) = `file $lib`;
if ($file_output =~ m/symbolic link/) { if ($file_output =~ m/symbolic link/) {
error("Yiiiiii, library file $lib is a symbolic link!\n", $error = error(
"Yiiiiii, library file $lib is a symbolic link!\n",
"This shouldn't happen!\n", "This shouldn't happen!\n",
"Please report this error(to the Yard author\n"); "Please report this error(to the Yard author\n");
return "ERROR"if $error && $error eq "ERROR";
} }
my($lib_type) = $file_output =~ /:\s*(ELF|Linux)/m; my($lib_type) = $file_output =~ /:\s*(ELF|Linux)/m;
@ -419,8 +430,10 @@ sub library_dependencies {
##### Strings from /usr/lib/magic of file 3.19 ##### Strings from /usr/lib/magic of file 3.19
if (!defined($lib_type)) { if (!defined($lib_type)) {
error("Didn't understand `file` output for $lib:\n", $error = error(
"Didn't understand `file` output for $lib:\n",
`file $lib`, "\n"); `file $lib`, "\n");
return "ERROR"if $error && $error eq "ERROR";
} elsif ($lib_type eq 'ELF') { } elsif ($lib_type eq 'ELF') {
$seen_ELF_lib = 1; $seen_ELF_lib = 1;
@ -729,6 +742,7 @@ sub space_check {
sub create_filesystem { sub create_filesystem {
my $file; my $file;
my $error;
##info(0, "Creating ${::fs_size}K ext2 file system on $::device\n"); ##info(0, "Creating ${::fs_size}K ext2 file system on $::device\n");
@ -784,7 +798,8 @@ sub create_filesystem {
mkpath(dirname($floppy_file)); mkpath(dirname($floppy_file));
info(1, "\tLink\t$floppy_file -> $target\n"); info(1, "\tLink\t$floppy_file -> $target\n");
symlink($target, $floppy_file) or symlink($target, $floppy_file) or
error("symlink($target, $floppy_file): $!\n"); ($error = error("symlink($target, $floppy_file): $!\n"));
return "ERROR"if $error && $error eq "ERROR";
delete $Included{$file}; # Get rid of it so next pass doesn't copit delete $Included{$file}; # Get rid of it so next pass doesn't copit
} elsif (-d $file) { } elsif (-d $file) {
@ -886,6 +901,7 @@ sub create_filesystem {
##### reached. ##### reached.
sub include_file { sub include_file {
my($contents_file, $file) = @_; my($contents_file, $file) = @_;
my $error;
must_be_abs($file); must_be_abs($file);
if (onto_proc_filesystem($file)) { if (onto_proc_filesystem($file)) {
@ -905,7 +921,8 @@ sub include_file {
##### SYMBOLIC LINK on disk, not overridden by explicit link or ##### SYMBOLIC LINK on disk, not overridden by explicit link or
##### replacement. Relativize the link for use later, but also ##### replacement. Relativize the link for use later, but also
##### check and resolve the target so it gets onto the rescue disk. ##### check and resolve the target so it gets onto the rescue disk.
my($link) = readlink($file) or error("readlink($file): $!"); my($link) = readlink($file) or ($error = error("readlink($file): $!"));
return "ERROR"if $error && $error eq "ERROR";
my($rel_link) = make_link_relative($file, $link); my($rel_link) = make_link_relative($file, $link);
$links_to{$file} = $rel_link; $links_to{$file} = $rel_link;
@ -936,7 +953,9 @@ sub cf_die {
my($contents_file, $line, @msgs) = @_; my($contents_file, $line, @msgs) = @_;
info(0, "$contents_file($cf_line): $line\n"); info(0, "$contents_file($cf_line): $line\n");
foreach (@msgs) { info(0, "\t$_\n"); } foreach (@msgs) { info(0, "\t$_\n"); }
exit; my $output = join("\n",@msgs);
&::error_window("gBootRoot: ERROR: ", $output);
return "ERROR";
} }
sub cf_warn { sub cf_warn {
@ -957,6 +976,7 @@ sub copy_strip_file {
# check for off or on, not undef # check for off or on, not undef
my($from, $to, $strip_objfiles, my($from, $to, $strip_objfiles,
$strip_lib, $strip_bin, $strip_module) = @_; $strip_lib, $strip_bin, $strip_module) = @_;
my $error;
if ($strip_objfiles and defined($objcopy) and $strippable{$from}) { if ($strip_objfiles and defined($objcopy) and $strippable{$from}) {
# Copy it stripped # Copy it stripped
@ -978,8 +998,10 @@ sub copy_strip_file {
# Copy file perms and owner # Copy file perms and owner
my($mode, $uid, $gid); my($mode, $uid, $gid);
(undef, undef, $mode, undef, $uid, $gid) = stat $from; (undef, undef, $mode, undef, $uid, $gid) = stat $from;
chown($uid, $gid, $to) or error("chown: $!"); chown($uid, $gid, $to) or ($error = error("chown: $!"));
chmod($mode, $to) or error("chmod: $!"); return "ERROR"if $error && $error eq "ERROR";
chmod($mode, $to) or ($error = error("chmod: $!"));
return "ERROR"if $error && $error eq "ERROR";
} else { } else {
# Normal copy, no strip # Normal copy, no strip
@ -997,6 +1019,7 @@ sub copy_strip_file {
######################################################## ########################################################
# Get device number of /proc filesystem # Get device number of /proc filesystem
## not a sub
my($proc_dev) = (stat("/proc"))[0]; my($proc_dev) = (stat("/proc"))[0];
sub info { sub info {
@ -1016,11 +1039,14 @@ sub info {
} }
## This will produce red.
sub error { sub error {
print STDERR "Error: ", @_;
print LOGFILE "Error: ", @_; print LOGFILE "Error: ", @_;
close(LOGFILE); info(0, "Error: ", @_);
exit(-1); &::error_window("gBootRoot: ERROR: ", @_);
return "ERROR";
} }
sub start_logging_output { sub start_logging_output {
@ -1033,8 +1059,9 @@ sub start_logging_output {
$logfile = $yard_temp; $logfile = $yard_temp;
} }
# ERRORCHECK # ERRORCHECK
## If logfile doesn't open in /tmp there is some type of fatal problem.
open(LOGFILE, ">$logfile") or die "open($logfile): $!\n"; open(LOGFILE, ">$logfile") or die "open($logfile): $!\n";
print "Logging output to $logfile\n"; info(1, "Logging output to $logfile\n")
} }
##### Same as system() but obeys $verbosity setting for both STDOUT ##### Same as system() but obeys $verbosity setting for both STDOUT
@ -1298,21 +1325,26 @@ sub warn_about_module_dependencies {
# Returns undef if it can't determine the version (or bails out with error) # Returns undef if it can't determine the version (or bails out with error)
sub kernel_version { sub kernel_version {
my($image) = @_; my($image) = @_;
my $error;
# check if we have a normal file (-f dereferences symbolic links) # check if we have a normal file (-f dereferences symbolic links)
if (!-f $image) { if (!-f $image) {
error("Kernel image ($image) is not a plain file.\n"); $error = error("Kernel image ($image) is not a plain file.\n");
return "ERROR"if $error && $error eq "ERROR";
} else { } else {
my($str) = ""; my($str) = "";
my($version_start) = ""; my($version_start) = "";
open(DATA, $image) or error("can't open $image.\n"); open(DATA, $image) or ($error = error("can't open $image.\n"));
return "ERROR"if $error && $error eq "ERROR";
# check signature of kernel image # check signature of kernel image
seek(DATA, 514, 0); seek(DATA, 514, 0);
read(DATA, $str, 4); read(DATA, $str, 4);
error("Kernel image file ($image) does not have Linux kernel signature\n") $error = error(
unless $str =~ "HdrS"; "Kernel image file ($image) does not have Linux kernel signature\n")
unless $str =~ "HdrS";
return "ERROR"if $error && $error eq "ERROR";
# setup header version should be 0x201 # setup header version should be 0x201
read(DATA, $str, 2); read(DATA, $str, 2);
$str = unpack("S",$str); $str = unpack("S",$str);
@ -1320,11 +1352,14 @@ sub kernel_version {
sprintf("%04x",$str)." (expected 0x0201).\n" unless $str == 0x201; sprintf("%04x",$str)." (expected 0x0201).\n" unless $str == 0x201;
# get ofset of version string (indirect) and read version string # get ofset of version string (indirect) and read version string
seek(DATA, 526, 0); seek(DATA, 526, 0);
read(DATA, $version_start, 2) or error("can't read from $image.\n"); read(DATA, $version_start, 2) or ($error = error(
"can't read from $image.\n"));
return "ERROR"if $error && $error eq "ERROR";
$version_start = unpack("S",$version_start) + 512; $version_start = unpack("S",$version_start) + 512;
seek(DATA, $version_start, 0); seek(DATA, $version_start, 0);
read(DATA, $str, 30) or read(DATA, $str, 30) or
error("can't read from offset $version_start of $image.\n"); ($error = error("can't read from offset $version_start of $image.\n"));
return "ERROR"if $error && $error eq "ERROR";
close(DATA); close(DATA);
# Extract the version number. # Extract the version number.
# Usually this is something like 2.2.15, but because of kernel packages # Usually this is something like 2.2.15, but because of kernel packages

Loading…
Cancel
Save