[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Ltib] Command debug output patch
|
From: |
Svein Seldal |
|
Subject: |
[Ltib] Command debug output patch |
|
Date: |
Sun, 05 Jul 2009 22:42:27 +0200 |
|
User-agent: |
Thunderbird 2.0.0.22 (X11/20090608) |
Hello
In my attempt to get overview of the ltib build system, I have made a
patch that dumps all file system operations when ltib is running. By
patching the current CVS HEAD with the attached patch, the feature can
be enabled by using the --logcmd command line option.
For me this was particularly important since ltib were requesting sudo
root access all the time, yet did not tell properly what was going on
(opposite to a Makefile or a shellscript with set -x). My paranoia turns
on and I wrote this patch.
There are two patches attached:
* logcmd.patch
Enable "--logcmd" command logging. It logs every command, open, rename
and so on.
* logfiletest.patch
Logs all file test operations. E.g. code like "if -e" and such will be
logged. Genererates a lot of output, but can be great to see what the
ltib is test and probing for.
The latter needs to be applied after the logcmd.patch has been applied.
But you don't need the latter for the first to work.
The patches are not elegant nor perfect, so you'll have to take it for
what it is. The latter is especially considered "dirty" as it limits the
way and freedom of the perl language.
I hope it can be useful (to some).
Best regards,
- Svein
diff -ur ltib.orig/bin/Ltibutils.pm ltib/bin/Ltibutils.pm
--- ltib.orig/bin/Ltibutils.pm 2009-07-05 01:36:09.000000000 +0200
+++ ltib/bin/Ltibutils.pm 2009-07-05 21:27:02.000000000 +0200
@@ -64,7 +64,7 @@
use strict 'vars';
use vars qw(@ISA @EXPORT $have_request_common $have_useragent $have_md5
$proxy_tested $pp_list_tested $app_checks $verbose
- $hl $cf);
+ $hl $cf $logcmd);
@ISA = qw(Exporter);
@EXPORT = qw( parse_dotconfig gm_yyyymmdd parse_config
parse_spec get_file touch g2larch
@@ -72,11 +72,14 @@
cmd_w_to system_nb caller_stack test_remote_file
md5sum write_file write_config try_lock_file release_lock_file
src_tree_is_clean export_repository get_scm_tags
- get_scm_tag get_scm_branch check_scm_id_is_remote);
+ get_scm_tag get_scm_branch check_scm_id_is_remote
+ qx_log mkdir_log unlink_log symlink_log rename_log
+ open_log opendir_log glob_log chmod_log);
# import verbose, cf from the main package
*verbose = \$main::verbose;
*cf = \$main::cf;
+*logcmd = \$main::logcmd;
my $scmtags = {};
@@ -85,6 +88,7 @@
my($f) = @_;
my $hr = {};
warn("parsing $f\n") if $verbose;
+ open_log($f);
open(my $fh, $f) or warn("parse_dotconfig: line ", (caller())[2],
", open $f: $!\n"), return;
while(<$fh>) {
@@ -119,6 +123,7 @@
my ($hr, $tok, $tok_name, $ld, $fh) = ({}, "", "", 0);
local $_;
+ open_log($args->{fn});
open($fh, $args->{fn}) or warn("open $args->{fn}: $!"), return;
while(<$fh>) {
if( eof || /^%([\w-]+)/ ) {
@@ -178,6 +183,7 @@
# Read in the whole file in one go. Okay as spec files are small
local $/ = undef;
+ open_log($specname);
open(SPEC, $specname) or warn("can't open $specname : $!"), return;
local $_ = <SPEC>;
close SPEC;
@@ -406,6 +412,7 @@
{
my($dest, $pxys, $wget_opts, $pxmode, $url) = @_;
return system_nb(<<TXT) == 0;
+set -x
cd $dest
$pxys wget $wget_opts --proxy=$pxmode $url 2>&1
cd - >/dev/null
@@ -449,7 +456,7 @@
foreach my $dir ( @dirs ) {
if(-f "$dir/$md5name") {
if($cf->{force_md5get}) {
- unlink "$dir/$md5name";
+ unlink_log("$dir/$md5name");
next;
}
$md5path = "$dir/$md5name";
@@ -461,6 +468,7 @@
return if $cf->{dry};
# if the md5 file exists, look for the file's md5sum in there
+ open_log($md5path);
open(MD5, $md5path) or warn("open $md5path: $!"), return;
while(<MD5>) {
($md5, $fn) = split(/\s+/);
@@ -471,8 +479,8 @@
}
close MD5;
if(! $refmd5 ) {
- unlink("$md5path.bad");
- rename($md5path, "$md5path.bad");
+ unlink_log("$md5path.bad");
+ rename_log($md5path, "$md5path.bad");
warn("Error: corrupt md5 file: $md5path, renamed to $md5path.bad\n");
return;
}
@@ -492,7 +500,7 @@
}
warn "ERROR: md5sum mismatch, re-naming $path to $path.bad, ",
"please re-try\n";
- rename($path, "$path.bad");
+ rename_log($path, "$path.bad");
return;
}
@@ -500,9 +508,10 @@
{
my ($path) = @_;
if(! $have_md5 ) {
- my ($md5) = split(/\s+/, `md5sum $path`);
+ my ($md5) = split(/\s+/, qx_log("md5sum $path"));
return $md5;
}
+ open_log($path);
open(F, $path) or warn("can't open $path: $!"), return;
binmode(F);
return Digest::MD5->new->addfile(*F)->hexdigest;
@@ -614,7 +623,7 @@
print "making vmlinux.gz.uboot\n";
my $x = $verbose ? '-x' : '';
system_nb(<<TXT) == 0 or return;
-set -e
+set -ex
if [ -n "$x" ]; then set $x ; fi
rm -f vmlinux.gz.uboot
@@ -669,7 +678,7 @@
my $cmd;
system_nb(<<TXT);
-set -e
+set -xe
if [ -n "$x" ]; then set $x ; fi
rm -rf $stage
if [ "$pcf->{DEPLOYMENT_RAMDISK}" = "y" ]
@@ -702,6 +711,7 @@
# should be, but check just to make sure.
$stage =~ m,^/, or die "Stage directory '$stage' must use absolute path";
system_nb(<<TXT) == 0 or return;
+set -x
cd $rootfs
find . -perm -444 ! -type b ! -type c -print0 | cpio -p0d --quiet $stage
TXT
@@ -720,16 +730,16 @@
$src =~ s,$stage,,;
for(my $i = 1 ; $i < @{$hl->{$ino}} ; $i++) {
my $tgt = @{$hl->{$ino}}[$i];
- unlink($tgt) or warn("cannot remove: $tgt: $!");
+ unlink_log($tgt) or warn("cannot remove: $tgt: $!");
warn("symlink $src, $tgt\n") if $verbose;
- symlink($src, $tgt) or warn("symlink src, $tgt: $!")
+ symlink_log($src, $tgt) or warn("symlink src, $tgt: $!")
}
}
}
# cleanup the staging area
system_nb(<<TXT) == 0 or return;
-set -e
+set -ex
if [ -n "$x" ]; then set $x ; fi
if [ "$pcf->{DEPLOYMENT_RM_BOOT}" = "y" ]
then
@@ -813,7 +823,7 @@
# calculate the size of the rootfs (based on calcs in buildroot)
my $fs_count = 0;
find( sub { $fs_count++ }, $stage);
- my ($fs_size) = split(/\s+/, `LANG=C du -slk $stage`);
+ my ($fs_size) = split(/\s+/, qx_log("LANG=C du -slk $stage"));
$fs_size += $fs_size >= 20000 ? 16384 : 2400;
$fs_size += $pcf->{DEPLOYMENT_PADDING_KB} if $pcf->{DEPLOYMENT_PADDING_KB};
print <<TXT;
@@ -854,7 +864,7 @@
system_nb(<<TXT) == 0 or return;
if [ -n "$x" ]; then set $x ; fi
-set -e
+set -ex
if [ "$pcf->{DEPLOYMENT_RAMDISK}" = "y" ]
then
echo "creating an ext2 compressed filesystem image: rootfs.ext2.gz"
@@ -950,7 +960,7 @@
local $SIG{ALRM} = sub { die "timeout" };
eval {
alarm($timeout);
- $cmd_op = address@hidden;
+ $cmd_op = qx_log("@cmd");
alarm(0);
};
return $cmd_op unless $@;
@@ -963,8 +973,10 @@
sub system_nb
{
my (@cmd) = @_;
+ print ">>> exec \"@cmd\"\n" if $logcmd;
if(my $pid = fork) {
waitpid($pid, 0);
+ print " = $?\n" if $logcmd;
return $?;
} else {
die "cannot fork: $!" unless defined $pid;
@@ -986,7 +998,7 @@
my $branch;
if(-d "$cf->{top}/.git") {
- ($branch) = `git branch` =~ m,\* (.+),;
+ ($branch) = qx_log("git branch") =~ m,\* (.+),;
return $branch;
}
@@ -994,6 +1006,7 @@
# T : branch, N : nonbranch, D : date
my $tagfile = 'CVS/Tag';
return unless -f $tagfile;
+ open_log($tagfile);
open(TAG, $tagfile) or die("Can't open $tagfile : $!");
chomp($branch = <TAG>);
close TAG;
@@ -1007,6 +1020,7 @@
my $tags;
if(-d "$cf->{top}/.git") {
+ open_log("git tag -l |");
open(GIT, "git tag -l |") or die;
while(<GIT>) {
chomp;
@@ -1017,6 +1031,7 @@
}
if(-d "$cf->{top}/CVS") {
+ open_log("cvs log 2>/dev/null |");
open(CVSLOG, "cvs log 2>/dev/null |") or die;
while(<CVSLOG>) {
if( m,^\s+([^\s]+):\s+\d,) {
@@ -1034,11 +1049,11 @@
{
my $tag;
if(-d "$cf->{top}/.git") {
- chomp($tag = `bin/setlocalversion`);
+ chomp($tag = qx_log("bin/setlocalversion"));
return $tag;
}
if(-f "$cf->{top}/CVS/Entries") {
- ($tag) = `cat CVS/Entries` =~ m,/ltib/([^/]+),;
+ ($tag) = qx_log("cat CVS/Entries") =~ m,/ltib/([^/]+),;
return $tag;
}
return;
@@ -1051,7 +1066,7 @@
}
if(-d "$cf->{top}/CVS") {
- return `cvs -nq up 2>&1` =~ m,^(?:C|M|U|A|R),m ? 0 : 1;
+ return qx_log("cvs -nq up 2>&1") =~ m,^(?:C|M|U|A|R),m ? 0 : 1;
}
}
@@ -1079,8 +1094,8 @@
# don't assume we have -o pipefail or $PIPESTATUS
my $cmd = "git archive --prefix=$dir/ $tag 2>git_errors| tar xf -";
system_nb($cmd);
- my $git_errors = `cat git_errors` if -s 'git_errors';
- unlink('git_errors');
+ my $git_errors = qx_log("cat git_errors") if -s 'git_errors';
+ unlink_log('git_errors');
warn("$cmd\n $git_errors"), return if $git_errors;
}
@@ -1112,6 +1127,7 @@
sub write_file
{
my ($path, $buf) = @_;
+ open_log(">$path");
open(F, ">$path") or die("open >$path : $!");
print F $buf;
close F;
@@ -1121,6 +1137,7 @@
sub try_lock_file
{
my ($lf, $lockinfo) = @_;
+ open_log("sysopen($lf)");
sysopen($lf, $lf, O_RDWR|O_CREAT) or die("can't open $lf: $!\n");
chmod(0666, $lf) or die("chmod 0666 : $!");
@@ -1139,8 +1156,74 @@
{
my($lf) = @_;
close($lf);
- unlink($lf);
+ unlink_log($lf);
}
+sub qx_log
+{
+ my($cmd) = @_;
+ print ">>> \`$cmd\`\n" if $logcmd;
+ my $result=`$cmd`;
+ print "$result" if $logcmd;
+ return $result;
+}
+
+sub mkdir_log
+{
+ print ">>> mkdir(@_)" if $logcmd;
+ my $result=mkdir(@_);
+ print " = $result\n" if $logcmd;
+ return $result;
+}
+
+sub unlink_log
+{
+ print ">>> unlink(@_)" if $logcmd;
+ my $result=unlink(@_);
+ print " = $result\n" if $logcmd;
+ return $result;
+}
+
+sub symlink_log
+{
+ print ">>> symlink(@_)" if $logcmd;
+ my $result=symlink($_[0],$_[1]);
+ print " = $result\n" if $logcmd;
+ return $result;
+}
+
+sub rename_log
+{
+ print ">>> rename(@_)" if $logcmd;
+ my $result=rename($_[0],$_[1]);
+ print " = $result\n" if $logcmd;
+ return $result;
+}
+
+sub open_log
+{
+ print ">>> open(@_)\n" if $logcmd;
+}
+
+sub opendir_log
+{
+ print ">>> opendir(@_)\n" if $logcmd;
+}
+
+sub glob_log
+{
+ print ">>> glob(@_)" if $logcmd;
+ my @result=glob($_[0]);
+ print " = " . scalar(@result) ." matches \n" if $logcmd;
+ return @result;
+}
+
+sub chmod_log
+{
+ print ">>> chmod(@_)" if $logcmd;
+ my $result=chmod @_;
+ print " = $result\n" if $logcmd;
+ return $result;
+}
1;
diff -ur ltib.orig/ltib ltib/ltib
--- ltib.orig/ltib 2009-07-05 01:36:09.000000000 +0200
+++ ltib/ltib 2009-07-05 21:24:39.000000000 +0200
@@ -45,6 +45,7 @@
$top = $FindBin::Bin;
$bdir = "/opt";
$verbose = 0;
+$logcmd = 0;
# $cf (globals), these can be set/overridden in the resource file .ltibrc
# This can be in the same directory as the script, or in the user's
@@ -200,7 +201,7 @@
use strict 'vars';
use vars qw($cf $config_deps $build_deps $install_deps $tspec
- $echo $pcf $ppcf $rev_install_deps $pcac $verbose);
+ $echo $pcf $ppcf $rev_install_deps $pcac $verbose $logcmd);
# package config dependencies
# re-build the key (lhs) if any of the dependents (rhs) in the list have
changed
@@ -361,6 +362,7 @@
--ignorelock : use if you really want to ignore any locks (careful!)
--fullbsp : used with -m release to copy additional content
--no-sudo : don't check sudo, work around for broken sudo (fc9)
+ --logcmd : Log file system commands
--help|h : help on usage
TXT
@@ -414,6 +416,7 @@
"ignorelock" => \$cf->{ignorelock},
"fullbsp" => \$cf->{fullbsp},
"no-sudo" => \$cf->{no_sudo_check},
+ "logcmd" => \$logcmd,
"help|h" => \$cf->{help},
) or die $usage;
@@ -486,7 +489,7 @@
if( defined($cf->{sticky}) ) {
$cf->{sticky} ?
write_config($cf->{root_cf}, { rootn => $cf->{rootn} || 0
})
- : unlink($cf->{root_cf});
+ : unlink_log($cf->{root_cf});
}
if( defined($cf->{rootn}) ) {
$cf->{oneroot} = 1;
@@ -609,9 +612,9 @@
foreach my $pkg (reverse @pkg_list) {
my $cmd = "$cf->{rpm} --root $cf->{rpmroot} --dbpath $cf->{rpmdb} "
. "-q $pkg";
- $_ = qx($cmd);
+ $_ = qx_log($cmd);
print("$pkg is not installed\n"), next unless m,^\Q$pkg\E,;
- $_ = qx($cmd-devel);
+ $_ = qx_log($cmd-devel);
$pkg .= " $pkg-devel" if m,^\Q$pkg\E,;
die $cmd if $? && ! m,is not installed,;
@@ -619,7 +622,7 @@
. "--dbpath $cf->{rpmdb} -e --allmatches $cf->{noscripts} "
. "--define '_tmppath $cf->{tmppath}' $pkg";
$cmd .= " --nodeps" if $cf->{nodeps};
- print "$cmd\n";
+ #print "$cmd\n";
system_nb($cmd) unless $echo;
return if $?
}
@@ -748,7 +751,7 @@
}
my $tok = parse_spec($spec) or die();
- my @rpms =
glob("$cf->{_rpmdir}/$pcf->{RPMTARCH}/$tok->{name}-$tok->{version}-$tok->{release}*");
+ my @rpms =
glob_log("$cf->{_rpmdir}/$pcf->{RPMTARCH}/$tok->{name}-$tok->{version}-$tok->{release}*");
my $pkgfail = 0;
# check for rebuild conditions
@@ -769,7 +772,7 @@
# don't do this clause if running in short-circuited mode
if( $unpack eq 'yes' ) {
# commit to installing a new rpm (enforced if build fails)
- unlink(@rpms) if $cf->{force} || $$key->{build} || $spec_upd;
+ unlink_log(@rpms) if $cf->{force} || $$key->{build} || $spec_upd;
foreach my $url ( split(/\s*\n/, $tok->{sources}),
split(/\s*\n/, $tok->{patches}) ) {
@@ -791,9 +794,9 @@
next if $cf->{dltest};
# needed if the lpp moves and links break
- unlink($tgt);
+ unlink_log($tgt);
- symlink($src, $tgt)
+ symlink_log($src, $tgt)
or die("symlink $cf->{lpp}/$file, $tgt: $!");
}
}
@@ -821,7 +824,7 @@
$cmd = "$cf->{rpmbuild} --nobuild "
. "--define '_topdir $cf->{rpmdir}' "
. "--define 'showsrcpath 1' $spec";
- $src_dir= `$cmd 2>&1`;
+ $src_dir= qx_log("$cmd 2>&1");
die unless $? == 0;
if(substr($src_dir, 0, 1) ne '/') {
$src_dir = "$cf->{rpmdir}/BUILD/$src_dir";
@@ -831,7 +834,7 @@
# See if the source tree has been touched
$cmd = "find $src_dir -newer $rpms[0] -print";
print "checking if sources have been updated: ";
- if(`$cmd`) {
+ if(qx_log("$cmd")) {
print "yes\n";
} else {
print "no\n";
@@ -871,7 +874,7 @@
. "--define '_sysconfdir $cf->{sysconfdir}' "
. "--define '_localstatedir $cf->{localstatedir}' "
. "$rpmopts $rpmclean $spec";
- print "\n$cmd\n";
+ #print "\n$cmd\n";
my $stime = time();
my $ec = system_nb("$echo $cf->{fakeroot} $cmd");
print "Build time for $sn: ${\( time() - $stime )} seconds\n\n";
@@ -890,7 +893,7 @@
|| (! $cf->{hostinst} &&
( $rebuilt || $cf->{reinstall}
|| (exists $$key->{install} && $$key->{install})
- || `$cf->{rpm} --root $cf->{rpmroot} --dbpath $cf->{rpmdb}
-q $tok->{name}-$tok->{version}-$tok->{release} 2>/dev/null` =~ m,is not
installed,) ) ) {
+ || qx_log("$cf->{rpm} --root $cf->{rpmroot} --dbpath
$cf->{rpmdb} -q $tok->{name}-$tok->{version}-$tok->{release} 2>/dev/null") =~
m,is not installed,) ) ) {
# make a note that something got built
$cf->{something_got_built} = 1;
@@ -899,7 +902,7 @@
# seh: 20070312: sub-packages have not ever really worked.
# seh: 20071030: remove rpm -e as using Uvh, not ivh
# seh: 20071119: put it back otherwise orphaned files left behind
- foreach my $rpm (
glob("$cf->{_rpmdir}/$pcf->{RPMTARCH}/$tok->{name}-$tok->{version}-$tok->{release}*")
) {
+ foreach my $rpm (
glob_log("$cf->{_rpmdir}/$pcf->{RPMTARCH}/$tok->{name}-$tok->{version}-$tok->{release}*")
) {
# make sure we're not going to clobber host files
check_host_clobber($rpm);
@@ -917,7 +920,7 @@
$cmd .= "-e --allmatches --nodeps $cf->{noscripts} ";
$cmd .= "--define '_tmppath $cf->{tmppath}' ";
$cmd .= "$subpkg 2>/dev/null";
- print "$cmd\n";
+ #print "$cmd\n";
system_nb($cmd);
# install the new package
@@ -932,7 +935,7 @@
$cmd .= "--excludedocs $cf->{noscripts} ";
$cmd .= "--define '_tmppath $cf->{tmppath}' ";
$cmd .= "$rpm";
- print "$cmd\n";
+ #print "$cmd\n";
# in dry-run mode (echo), don't actually install
unless($echo) {
@@ -1027,7 +1030,7 @@
$key = get_key_by_sn($sn);
}
$tspec = "$cf->{rpmdir}/SPECS/$sn.spec";
- unlink($tspec) if -f $tspec;
+ unlink_log($tspec) if -f $tspec;
# we expect the user to have run these before
# f_scbuild($key) or die();
@@ -1035,6 +1038,7 @@
my $spec = get_spec($sn) or die("can't find spec file for $sn");
my $tok = parse_spec($spec, 1) or die();
+ open_log(">$tspec");
open(SPEC, ">$tspec") or die("can't open $tspec for write: $!");
print SPEC <<TXT;
${\( exists $tok->{base} ? "%define base $tok->{base}" : '' )}
@@ -1077,7 +1081,7 @@
my $ret = build_rpm( key => $key,
unpack => 'no',
rpmopts => '-bb');
- unlink($tspec);
+ unlink_log($tspec);
return $ret;
}
@@ -1131,6 +1135,7 @@
# read in the spec file and work out the next patch number to use
my ($num, @p);
local $/ = undef;
+ open_log($spec);
open(SPEC, $spec) or die("can't open $spec : $!");
local $_ = <SPEC>;
close(SPEC);
@@ -1154,12 +1159,14 @@
rm -rf $cf->{rpmdir}/BUILD/$pkg_dir_name
TXT
+ open_log(">$spec.bak");
open(SPEC, ">$spec.bak") or die("can't open $spec.bak for writing: $!");
print SPEC $_;
close SPEC;
s,^(BuildRoot\s*:.*),Patch$num : $pname\n$1,mi;
s,^(%[Pp]rep.+?)(?=\s*(^%[Bb]uild|\Z)),$1\n%patch$num -p1,sm;
+ open_log(">$spec");
open(SPEC, ">$spec") or die("can't open $spec for writing : $!");
print SPEC $_;
close SPEC;
@@ -1211,6 +1218,7 @@
$rel ||= 'none';
my $wtag = get_scm_branch() || 'none';
+ open_log(">$file");
open(RI, ">$file") or warn("open: >$file : $!"), return;
print RI <<TXT;
Release date = $cf->{gmsdate} UTC
@@ -1308,7 +1316,7 @@
# gcc, you get the aliased cross compiler. So that's why
# I'm jumping through these loops to get the actual buildcc
if(! $cf->{gccpath} ) {
- chomp($_ = `which gcc`);
+ chomp($_ = qx_log("which gcc"));
my ($gccpath) = m,(.+)/,;
$gccpath = '/usr/bin' if $gccpath =~ m,ccache,;
$cf->{gccpath} = $gccpath;
@@ -1424,7 +1432,7 @@
TXT
# remove the previous logfile
- unlink($cf->{logfile});
+ unlink_log($cf->{logfile});
# redirect output to logfile
redirect(">> $cf->{logfile}");
@@ -1462,8 +1470,8 @@
check_spoofing();
check_toolchain_setup($pcf);
check_merge_updates($pcf);
- system("rm -f $cf->{tmppath}/rpm-tmp.*");
- chmod(0777, $cf->{projtmp});
+ qx_log("rm -f $cf->{tmppath}/rpm-tmp.*");
+ chmod_log(0777, $cf->{projtmp});
return 1;
}
@@ -1614,9 +1622,10 @@
if(-f "$dir/$cfn") {
my $lcf = parse_dotconfig("$dir/$cfn");
$oldarch = g2larch($lcf->{LINTARCH});
- unlink("$dir/$cfn"), die("old LINTARCH not in $dir/$cfn, removing\n")
+ unlink_log("$dir/$cfn"), die("old LINTARCH not in $dir/$cfn,
removing\n")
unless $oldarch;
local $/ = undef;
+ open_log("$dir/$cfn");
open(F, "$dir/$cfn") or die("open $dir/$cfn : $!");
$oset = <F> || '';
close F;
@@ -1638,13 +1647,13 @@
# we need to switch to a new set of rpms (or remove)
if($pcf->{FEAT_CACHE_RPMS} || ! defined($pcf->{FEAT_CACHE_RPMS}) ) {
- if(glob("$dir/$oldarch/*.rpm")) {
+ if(glob_log("$dir/$oldarch/*.rpm")) {
if(! -f "$dir/$oldarch/$cfn") {
write_file("$dir/$oldarch/$cfn", $oset);
}
while(-d "$dir/$ts") { $ts += 0.01; }
print("Saving rpms from $oldarch to $dir/$ts\n") if $pon;
- rename("$dir/$oldarch", "$dir/$ts")
+ rename_log("$dir/$oldarch", "$dir/$ts")
or die("rename $dir/$oldarch", "$dir/$ts : $!");
} else {
print "No binary rpms to save\n" if $pon;
@@ -1652,14 +1661,16 @@
}
# look for an existing set of binary rpms matching the new settings
+ opendir_log($dir);
opendir(DIR, $dir) or die("opendir: $dir: $!");
while( defined(my $ent = readdir(DIR)) ) {
next unless -d "$dir/$ent";
next if $ent eq '.' || $ent eq '..' || $ent eq $newarch;
next unless -f "$dir/$ent/$cfn";
system_nb("rm -rf $dir/$ent"), next
- unless glob("$dir/$ent/*.rpm");
+ unless
glob_log("$dir/$ent/*.rpm");
local $/ = undef;
+ open_log("$dir/$ent/$cfn");
open(F, "$dir/$ent/$cfn") or die("open $dir/$ent/$cfn : $!");
my $ck = <F> || '';
close F;
@@ -1667,13 +1678,13 @@
print "Using cached pre-built packages for $pcf->{PLATFORM} ",
"from rpm/$ent\n" if $pon;
die "$dir/$newarch already exists" if -d "$dir/$newarch";
- rename("$dir/$ent", "$dir/$newarch")
+ rename_log("$dir/$ent", "$dir/$newarch")
or die "rename: $dir/$ent, $dir/$newarch : $!";
last;
}
}
closedir DIR;
- mkdir("$dir/$newarch", 0755);
+ mkdir_log("$dir/$newarch", 0755);
write_file("$dir/$newarch/$cfn", $nset);
} else {
@@ -1828,6 +1839,7 @@
# load up the main map
my $map = "$cf->{config_dir}/userspace/pkg_map";
+ open_log($map);
open(MAP, $map) or die("open($map): $!");
while(<MAP>) {
chomp;
@@ -1857,6 +1869,7 @@
my ($fn) = shift;
return if $seen->{$fn};
$seen->{$fn} = 1;
+ open_log("IO::File->new($fn)");
my $FH = IO::File->new($fn) or die("open $fn : $!");
while(<$FH>) {
proc_pkg_map($_)
@@ -1994,7 +2007,7 @@
local $_;
my $cmd = "$cf->{rpm} --root $cf->{rpmroot} --dbpath $cf->{rpmdb} -qa "
. "--queryformat '%{name} '";
- $_ = qx($cmd);
+ $_ = qx_log($cmd);
die $cmd if $?;
my @installed = split(/[\s\n]+/);
my @drop_list = ();
@@ -2034,7 +2047,7 @@
. "-e --allmatches --nodeps $cf->{noscripts} "
. "--define '_tmppath $cf->{tmppath}' "
. "$rpmname";
- print "$cmd\n";
+ #print "$cmd\n";
system_nb($cmd) == 0 or die unless $echo;
process_pkg_rev_triggers($pkg2key->{$rpmname});
}
@@ -2070,8 +2083,8 @@
$defdist = "$cf->{top}/$cf->{defdist}";
$plat_specs = $cf->{plat_dir};
- @dirs = ($rpm_specs, $plat_specs, glob("$pcf_distro/*") );
- push(@dirs, glob("$defdist/*")) unless $defdist eq $pcf_distro;
+ @dirs = ($rpm_specs, $plat_specs, glob_log("$pcf_distro/*") );
+ push(@dirs, glob_log("$defdist/*")) unless $defdist eq $pcf_distro;
$cache = {};
}
if(exists $cache->{$sn} && -e $cache->{$sn}) {
@@ -2086,6 +2099,7 @@
if(-e "$specpath.in") {
$specinpath = "$specpath.in";
$specpath = "$cf->{projtmp}/$spec";
+ open_log($specinpath);
open(SPECIN, $specinpath) or die("can't open $specinpath: $!");
local $_ = <SPECIN>;
close(SPECIN);
@@ -2106,11 +2120,11 @@
} elsif( -f $specpath ) {
expand_spec("$specpath.new", $specinpath, $tmplpath);
if( md5sum("$specpath.new") ne md5sum($specpath) ) {
- unlink($specpath) or die("unlink $specpath : $!");
- rename("$specpath.new", $specpath)
+ unlink_log($specpath) or die("unlink $specpath : $!");
+ rename_log("$specpath.new", $specpath)
or die("rename $specpath.new, $specpath: $!");
} else {
- unlink("$specpath.new") or die("unlink $specpath.new :
$!");
+ unlink_log("$specpath.new") or die("unlink $specpath.new :
$!");
}
}
}
@@ -2225,7 +2239,7 @@
# this is to catch mangled databases before we had a known rpm
# once this has rippled through all users it could come out
die "$cf->{rpm} has gone missing" unless -f $cf->{rpm};
- my $qo = `$cf->{rpm} --root $cf->{rpmroot} --dbpath -q $cf->{rpmdb}
bogus-package 2>&1`;
+ my $qo = qx_log("$cf->{rpm} --root $cf->{rpmroot} --dbpath -q $cf->{rpmdb}
bogus-package 2>&1");
if($qo =~ m,unsupported hash version:,m) {
system_nb("rm -rf $cf->{rpmdb}/*") == 0 or die;
}
@@ -2287,6 +2301,7 @@
# make the basic rpm directory structure
system_nb(<<TXT) == 0 or die;
+set -x
for i in BUILD SOURCES SPECS SRPMS
do
mkdir -p $cf->{rpmdir}/\$i
@@ -2337,12 +2352,12 @@
if(! -e "$cf->{rpmroot}/$cf->{rpmdb}/Packages") {
system_nb(<<TXT) == 0 or die;
-set -e
+set -ex
$cf->{sudo} $cf->{rpm} --root $cf->{rpmroot} --dbpath $cf->{rpmdb} --initdb
TXT
} elsif($do_rebuild) {
system_nb(<<TXT) == 0 or die;
-set -e
+set -ex
$cf->{sudo} $cf->{rpm} --root $cf->{rpmroot} --dbpath $cf->{rpmdb} --define
'_tmppath $cf->{tmppath}' --rebuilddb
TXT
}
@@ -2352,7 +2367,7 @@
sub check_rpm_setup
{
- my ($hrpm) = `which rpm`;
+ my ($hrpm) = qx_log("which rpm");
return 1 if $hrpm =~ m,$cf->{defpfx},;
# use the host's rpm to build and install a known version
@@ -2384,7 +2399,7 @@
$cf->{dodrop} = 'no';
$cf->{prefix} = "$cf->{defpfx}/usr";
$cf->{sysconfdir} = "$cf->{defpfx}/etc";
- chomp($cf->{rpmbuild} = `which rpmbuild 2>/dev/null` || "rpm\n");
+ chomp($cf->{rpmbuild} = qx_log("which rpmbuild 2>/dev/null") || "rpm\n");
$cf->{rpm} = "rpm";
$cf->{lpp} = "/tmp";
$cf->{ldirs} = $cf->{lpp};
@@ -2402,7 +2417,7 @@
$cf->{sudo} = $sav->{sudo};
f_buildrpms();
# put back the database information
- my @rpms = glob("$cf->{_rpmdir}/$pcf->{RPMTARCH}/$cf->{sn}-*");
+ my @rpms = glob_log("$cf->{_rpmdir}/$pcf->{RPMTARCH}/$cf->{sn}-*");
my $rpm = $rpms[0] or die "could not glob rpm in: "
. "$cf->{_rpmdir}/$pcf->{RPMTARCH}/$cf->{sn}-*";
my $cmd = "$cf->{sudo} $sav->{rpm} ";
@@ -2410,7 +2425,7 @@
$cmd .= "--dbpath $cf->{defpfx}/var/lib/rpm ";
$cmd .= "-Uv --justdb --notriggers $cf->{noscripts} --nodeps ";
$cmd .= "$rpm";
- print "$cmd\n";
+ #print "$cmd\n";
system_nb($cmd);
system_nb("rm -rf $cf->{rpmdir}") == 0 or die;
@@ -2433,9 +2448,9 @@
#
sub check_sudo_setup
{
- my ($hostrpm) = `PATH=$cf->{path_std} ; which rpm`;
+ my ($hostrpm) = qx_log("PATH=$cf->{path_std} ; which rpm");
chomp($hostrpm);
- my $s = `yes "" | sudo -S -l 2>&1`;
+ my $s = qx_log('yes "" | sudo -S -l 2>&1');
my $bre = '(?:\(root\)|\(ALL\))\s+(?:ROLE=\s+)?NOPASSWD:';
my $hostrpm_ok = $s =~ /$bre.*[\s,]$hostrpm/m;
my $fsrpm_ok = $s =~ /$bre.*[\s,]$cf->{rpm}/m;
@@ -2480,7 +2495,7 @@
}
my $lpp_mode = (stat("$cf->{lpp}"))[2];
unless( ($lpp_mode & 040777) == 040777 ) {
- chmod(0777, $cf->{lpp}) == 1 or die <<TXT;
+ chmod_log(0777, $cf->{lpp}) == 1 or die <<TXT;
Build script aborting as the lpp directory is not configured properly.
Directory: $cf->{lpp} must exist with read, write, and search
@@ -2491,7 +2506,7 @@
if( -d "$cf->{top}/pkgs" ) {
print "Updating lpp from local packages\n";
my ($path, $fn);
- foreach $path ( glob("$cf->{top}/pkgs/*") ) {
+ foreach $path ( glob_log("$cf->{top}/pkgs/*") ) {
($fn) = $path =~ m,([^/]+)$,;
next if -f "$cf->{lpp}/$fn";
system_nb("set -x; cp -dp $path $cf->{lpp}/$fn") == 0 or die;
@@ -2528,9 +2543,9 @@
if($pcf->{TOOLCHAIN}) {
my $tc_rpm = tc_name($pcf->{TOOLCHAIN});
$tc_rpm =~ s/\.\w+\.rpm//;
- `$cf->{rpm} -q $tc_rpm 2>/dev/null`;
+ qx_log("$cf->{rpm} -q $tc_rpm 2>/dev/null");
if(! -e "$pcf->{TOOLCHAIN_PATH}/bin/$pcf->{TOOLCHAIN_PREFIX}gcc"
- || `$cf->{rpm} -q $tc_rpm 2>/dev/null` =~ m,is not installed,
+ || qx_log("$cf->{rpm} -q $tc_rpm 2>/dev/null") =~ m,is not
installed,
|| $cf->{dltest}) {
$pcf->{TOOLCHAIN} = tc_name($pcf->{TOOLCHAIN});
print "Installing: $pcf->{TOOLCHAIN}\n" unless $cf->{dltest};
@@ -2541,11 +2556,11 @@
my $cmd = "$cf->{sudo} $cf->{rpm} "
. "--dbpath $cf->{defpfx}/var/lib/rpm "
. "-ivh --force --ignorearch $tc";
- print "$cmd\n";
+ #print "$cmd\n";
return 1 if $echo;
# switch stdout with stderr and run the command to capture stderr
- my $err = `$cmd 3>&1 1>&2 2>&3 3>&-`;
+ my $err = qx_log("$cmd 3>&1 1>&2 2>&3 3>&-");
if($? && $err !~ m,is already installed,) {
die "Failed to install: $pcf->{TOOLCHAIN}:\n$err\n"
}
@@ -2553,7 +2568,7 @@
}
# check that this toolchain can be accessed without the abs path
- my $gcc_path = `which $pcf->{TOOLCHAIN_PREFIX}gcc 2>/dev/null`
+ my $gcc_path = qx_log("which $pcf->{TOOLCHAIN_PREFIX}gcc 2>/dev/null")
or die(<<TXT);
$pcf->{TOOLCHAIN_PREFIX}gcc is not in your PATH environment:
@@ -2623,7 +2638,7 @@
}
foreach my $dir ( $ENV{PLATFORM_PATH}, $ENV{TOP} ) {
next unless -d "$dir/merge";
- local $_ = `find $dir/merge -newer $spec 2>/dev/null`;
+ local $_ = qx_log("find $dir/merge -newer $spec 2>/dev/null");
warn "newer than $spec: $_\n" if $_ && $verbose;
touch($spec), last if $_;
}
@@ -2641,7 +2656,7 @@
my ($rpm) = @_;
my ($len, $cmd, $pkg_prefix, $inst_pfx, $path, $line);
- $pkg_prefix = `$cf->{rpm} -qp --queryformat "%{PREFIXES}\n" $rpm`;
+ $pkg_prefix = qx_log("$cf->{rpm} -qp --queryformat \"%{PREFIXES}\n\"
$rpm");
chomp($pkg_prefix);
$pkg_prefix = '' if $pkg_prefix eq '(none)';
$inst_pfx = "$cf->{rpmroot}/$cf->{rpmipfx}";
@@ -2661,6 +2676,7 @@
# under anything except /opt, /tmp, /home exit in a big hurry.
$len = length($pkg_prefix);
$cmd = "$cf->{rpm} -qlp $rpm";
+ open_log("$cmd |");
open(CMD, "$cmd |") or die("can't fork $cmd: $!");
while(defined($line = <CMD>)) {
chomp($line);
@@ -2678,7 +2694,7 @@
sub summary
{
- unlink($tspec) if $tspec;
+ unlink_log($tspec) if $tspec;
return 1 unless $cf->{mode} eq 'buildrpms';
my $edate = localtime();
@@ -2802,7 +2818,7 @@
# the new defconfig. Note mconf/conf use defconfig if .config
# is missing.
warn("Using updated $plat_dir/defconfig$rootn\n");
- rename($plat_cf, "$plat_cf.$cf->{stime}") if -f $plat_cf;
+ rename_log($plat_cf, "$plat_cf.$cf->{stime}") if -f $plat_cf;
system_nb("cp $plat_dir/defconfig$rootn $plat_cf") == 0 or die;
$cf->{batch} = 1;
}
@@ -2895,7 +2911,7 @@
TXT
$cf->{preconfig} = $plat_cf;
if(-f "$oldconfig.$cf->{stime}") {
- rename("$oldconfig.$cf->{stime}", $oldconfig);
+ rename_log("$oldconfig.$cf->{stime}", $oldconfig);
utime($atime, $mtime, $oldconfig)
or warn "could not reset times on $oldconfig : $!";
}
@@ -2934,6 +2950,7 @@
# set in the platform .config for subsequent runs
my ($platform) = $plat_dir =~ m,([^/]+)\s*$,;
+ open_log(">$cf->{top}/.config");
open(TOPCF, ">$cf->{top}/.config") or die "open $cf->{top}/.config:$!";
print TOPCF "CONFIG_PLATFORM_$platform=y\n";
print TOPCF "CONFIG_PLATFORM_DIR=\"$plat_dir\"\n";
@@ -2954,7 +2971,7 @@
$plat_dir = $hr->{PLATFORM_DIR} || '';
if(! -d $plat_dir) {
warn("Platform choice rejected as: '$plat_dir' doesn't exist\n");
- unlink "$cf->{top}/.config";
+ unlink_log("$cf->{top}/.config");
die if $cf->{batch};
goto CHOOSE_TOP_PLATFORM;
}
@@ -2966,6 +2983,7 @@
{
my ($dir, $ent, $p, $mcf) = ("config/platform", "", {});
my $platforms = ();
+ opendir_log($dir);
opendir(DIR, $dir) or die("can't open $dir: $!");
while( defined($ent = readdir(DIR)) ) {
next unless -d "$dir/$ent";
@@ -2975,6 +2993,7 @@
closedir(DIR);
local $/ = "";
foreach my $mcf (keys %$p) {
+ open_log("$dir/$mcf/main.lkc");
open(CF, "$dir/$mcf/main.lkc")
or warn("mk_main_conf: skipping config dir: $mcf\n"),
next;
while(<CF>) {
@@ -2985,6 +3004,7 @@
}
close CF;
}
+ open_log(">$cf->{mainlkc}");
open(MCF, ">$cf->{mainlkc}") or die "open $cf->{mainlkc} : $!";
print MCF <<TXT;
config CONFIG_TITLE
@@ -3026,6 +3046,7 @@
@rl = $cf->{rootn};
} else {
@rl = (0);
+ opendir_log($cf->{plat_dir});
opendir(DIR, $cf->{plat_dir}) or die("opendir $cf->{plat_dir} : $!");
while(defined(my $ent = readdir(DIR)) ) {
next unless $ent =~ m,defconfig(\d\d?)$,;
@@ -3055,6 +3076,7 @@
check_rpm_ipfx();
print "Entering ltib shell mode, type 'exit' to quit\n";
my $rc = 'ltib_bashrc';
+ open_log(">$rc");
open(RC, ">$rc") or die("can't open $rc for write: $!");
print RC <<TXT;
@@ -3076,7 +3098,7 @@
TXT
close RC;
system_nb("/bin/bash --rcfile $rc");
- unlink $rc;
+ unlink_log($rc);
exit 0;
}
@@ -3121,8 +3143,11 @@
sub expand_spec
{
my ($specpath, $specinpath, $tmplpath) = @_;
+ open_log("$specinpath");
open(SPECIN, "$specinpath") or die("can't open $specpath.in: $!");
+ open_log($tmplpath);
open(TMPL, $tmplpath) or die("can't open $tmplpath: $!");
+ open_log(">$specpath");
open(SPEC, ">$specpath") or die("can't open $specpath for write: $!");
while(<SPECIN>) {
print SPEC;
@@ -3147,7 +3172,7 @@
# the normal version comparision fails (e.g dtc version went
# from 20070307 to 1.0.0) needs to be taken care of as exceptions
# for now it's been left.
- my ($ver) = `$cf->{rpm} --root $cf->{rpmroot} --dbpath $cf->{rpmdb} -q
--queryformat %{VERSION}.%{RELEASE} $tok->{name} 2>&1`;
+ my ($ver) = qx_log("$cf->{rpm} --root $cf->{rpmroot} --dbpath $cf->{rpmdb}
-q --queryformat %{VERSION}.%{RELEASE} $tok->{name} 2>&1");
return 1 if $ver =~ m,is not installed,;
warn "installed version=$ver, "
. "new version = $tok->{version}.$tok->{release}\n" if $verbose;
diff -ur ltib.orig/bin/Ltibutils.pm ltib/bin/Ltibutils.pm
--- ltib.orig/bin/Ltibutils.pm 2009-07-05 21:34:56.000000000 +0200
+++ ltib/bin/Ltibutils.pm 2009-07-05 22:26:01.000000000 +0200
@@ -74,7 +74,7 @@
src_tree_is_clean export_repository get_scm_tags
get_scm_tag get_scm_branch check_scm_id_is_remote
qx_log mkdir_log unlink_log symlink_log rename_log
- open_log opendir_log glob_log chmod_log);
+ open_log opendir_log glob_log chmod_log ift);
# import verbose, cf from the main package
*verbose = \$main::verbose;
@@ -253,7 +253,7 @@
{
my ($url, $cf, $force_md5) = @_;
warn("no url passed"), return unless $url;
- warn("lpp: $cf->{lpp} is not a directory"), return unless -d $cf->{lpp};
+ warn("lpp: $cf->{lpp} is not a directory"), return unless
ift('-d',$cf->{lpp});
my ($path, $refmd5);
my ($file) = $url =~ m-/?([^/]+)$-;
@@ -271,7 +271,7 @@
my @sdirs = ($cf->{lpp}, @ldirs, "$cf->{top}/pkgs");
foreach my $dir ( @sdirs ) {
$path = "$dir/$file";
- if(-f $path) {
+ if(ift('-f', $path)) {
return $path unless $force_md5;
# try to get the reference md5sum for this file
@@ -425,7 +425,7 @@
return test_remote_file($url, $cf) if $cf->{dry};
warn("no url passed"), return unless $url;
$dest ||= $cf->{lpp};
- warn("dest (lpp): $dest is not a directory"), return unless -d $dest;
+ warn("dest (lpp): $dest is not a directory"), return unless ift('-d',
$dest);
my ($file) = $url =~ m-/?([^/]+)$-;
my $path = "$dest/$file";
@@ -440,7 +440,7 @@
my $pxmode = $cf->{$pp . '_proxy'} ? 'on' : 'off';
my $rpath = $cf->{$pp . '_url'} . "/$file";
get_remote($dest, $pxys, $cf->{wget_opts}, $pxmode, $rpath);
- return $path if -f $path;
+ return $path if ift('-f', $path);
}
return;
}
@@ -454,7 +454,7 @@
# look for and check local files first
foreach my $dir ( @dirs ) {
- if(-f "$dir/$md5name") {
+ if(ift('-f', "$dir/$md5name")) {
if($cf->{force_md5get}) {
unlink_log("$dir/$md5name");
next;
@@ -641,7 +641,7 @@
my($rootfs, $pcf) = @_;
return 1 if $pcf->{DEPLOYMENT_NFS};
- die("$rootfs directory missing\n") unless -d $rootfs;
+ die("$rootfs directory missing\n") unless ift('-d', $rootfs);
my ($stage, $dev_tab) = ("$rootfs.tmp", '');
@@ -662,11 +662,11 @@
}
}
- warn("device table: $dev_tab missing"), return unless -e $dev_tab;
+ warn("device table: $dev_tab missing"), return unless ift('-e',$dev_tab);
warn("using device table: $dev_tab\n") if $verbose;
my $tdir = readpipe "echo -n $pcf->{DEPLOYMENT_ROOTFS_DIR}" || ".";
- warn("target dir '$tdir' does not exist\n"), return unless -d $tdir;
+ warn("target dir '$tdir' does not exist\n"), return unless ift('-d',$tdir);
# this turns of Use of uninitialized value in concatenation warnings
local $^W = 0;
@@ -986,7 +986,7 @@
sub check_scm_id_is_remote
{
- return 1 unless -d "$cf->{top}/.git";
+ return 1 unless ift('-d',"$cf->{top}/.git");
my ($id) = @_;
return if `git cherry origin/master $id` =~ m,^\+,m;
@@ -997,7 +997,7 @@
{
my $branch;
- if(-d "$cf->{top}/.git") {
+ if(ift('-d',"$cf->{top}/.git")) {
($branch) = qx_log("git branch") =~ m,\* (.+),;
return $branch;
}
@@ -1005,7 +1005,7 @@
# For CVS, the Tag file's first letter mean:
# T : branch, N : nonbranch, D : date
my $tagfile = 'CVS/Tag';
- return unless -f $tagfile;
+ return unless ift('-f', $tagfile);
open_log($tagfile);
open(TAG, $tagfile) or die("Can't open $tagfile : $!");
chomp($branch = <TAG>);
@@ -1019,7 +1019,7 @@
return $scmtags if %$scmtags;
my $tags;
- if(-d "$cf->{top}/.git") {
+ if(ift('-d',"$cf->{top}/.git")) {
open_log("git tag -l |");
open(GIT, "git tag -l |") or die;
while(<GIT>) {
@@ -1030,7 +1030,7 @@
return $scmtags;
}
- if(-d "$cf->{top}/CVS") {
+ if(ift('-d',"$cf->{top}/CVS")) {
open_log("cvs log 2>/dev/null |");
open(CVSLOG, "cvs log 2>/dev/null |") or die;
while(<CVSLOG>) {
@@ -1048,11 +1048,11 @@
sub get_scm_tag
{
my $tag;
- if(-d "$cf->{top}/.git") {
+ if(ift('-d',"$cf->{top}/.git")) {
chomp($tag = qx_log("bin/setlocalversion"));
return $tag;
}
- if(-f "$cf->{top}/CVS/Entries") {
+ if(ift('-f',"$cf->{top}/CVS/Entries")) {
($tag) = qx_log("cat CVS/Entries") =~ m,/ltib/([^/]+),;
return $tag;
}
@@ -1061,11 +1061,11 @@
sub src_tree_is_clean
{
- if(-d "$cf->{top}/.git") {
+ if(ift('-d',"$cf->{top}/.git")) {
return get_scm_tag() =~ m,-dirty, ? 0 : 1;
}
- if(-d "$cf->{top}/CVS") {
+ if(ift('-d',"$cf->{top}/CVS")) {
return qx_log("cvs -nq up 2>&1") =~ m,^(?:C|M|U|A|R),m ? 0 : 1;
}
@@ -1074,11 +1074,11 @@
sub tag_repository
{
my ($tag) = @_;
- if(-d "$cf->{top}/.git") {
+ if(ift('-d',"$cf->{top}/.git")) {
die("TODO: how do you tag a git repository");
}
- if(-d "$cf->{top}/CVS") {
+ if(ift('-d',"$cf->{top}/CVS")) {
system_nb("cvs tag -c $tag .") == 0 or return;
}
@@ -1088,9 +1088,9 @@
sub export_repository
{
my ($tag, $dir) = @_;
- die("export dir: $dir exists") if -d $dir;
+ die("export dir: $dir exists") if ift('-d',$dir);
- if(-d "$cf->{top}/.git") {
+ if(ift('-d',"$cf->{top}/.git")) {
# don't assume we have -o pipefail or $PIPESTATUS
my $cmd = "git archive --prefix=$dir/ $tag 2>git_errors| tar xf -";
system_nb($cmd);
@@ -1099,7 +1099,7 @@
warn("$cmd\n $git_errors"), return if $git_errors;
}
- if(-d "$cf->{top}/CVS") {
+ if(ift('-d',"$cf->{top}/CVS")) {
system_nb("cvs export -kv -d $dir -r $tag ltib") == 0 or return;
}
@@ -1226,4 +1226,30 @@
return $result;
}
+sub ift
+{
+ print ">>> if @_" if $logcmd;
+
+ my $res = 0;
+ my $t = $_[0];
+ if($t eq '-e') {
+ $res = 1 if(-e $_[1]);
+ }
+ elsif($t eq '-f') {
+ $res = 1 if(-f $_[1]);
+ }
+ elsif($t eq '-d') {
+ $res = 1 if(-d $_[1]);
+ }
+ elsif($t eq '-w') {
+ $res = 1 if(-w $_[1]);
+ }
+ else
+ {
+ die "Uninmplemented test @_";
+ }
+ print " = $res\n" if $logcmd;
+ return $res;
+}
+
1;
diff -ur ltib.orig/ltib ltib/ltib
--- ltib.orig/ltib 2009-07-05 21:24:39.000000000 +0200
+++ ltib/ltib 2009-07-05 22:13:08.000000000 +0200
@@ -455,10 +455,10 @@
die "--leavesrc|l only work on a single package, use -p <pkg>\n";
}
}
-if($cf->{upreconfig} && ! -e $cf->{upreconfig}) {
+if($cf->{upreconfig} && ! ift('-e',$cf->{upreconfig})) {
die "preconfig file: $cf->{upreconfig} does not exist\n";
}
-if($cf->{profile} && ! -e $cf->{profile}) {
+if($cf->{profile} && ! ift('-e',$cf->{profile})) {
die "profile file: $cf->{profile} does not exist\n";
}
$cf->{logfile} ||= "$cf->{top}/host_config.log";
@@ -493,7 +493,7 @@
}
if( defined($cf->{rootn}) ) {
$cf->{oneroot} = 1;
-} elsif(-f $cf->{root_cf}) {
+} elsif(ift('-f', $cf->{root_cf})) {
$cf->{oneroot} = 1;
my $hr = parse_config(fn => $cf->{root_cf}) or die;
$cf->{rootn} = $hr->{rootn} || 0;
@@ -571,7 +571,7 @@
write_release_info($cf->{release_info});
# copy release info to the rootfs
- if(! -w "$cf->{rfsbase}/etc/ltib-release") {
+ if(! ift('-w',"$cf->{rfsbase}/etc/ltib-release")) {
warn("$cf->{rfsbase}/etc/ltib-release is not writable\n");
} else {
system_nb("cp $cf->{release_info} $cf->{rfsbase}/etc/ltib-release")
@@ -689,7 +689,7 @@
print("aborted\n"), return 1 unless /^yes$/;
}
- remove_rfsbase() if -e $cf->{rfsbase};
+ remove_rfsbase() if ift('-e', $cf->{rfsbase});
system_nb(<<TXT);
set -x
@@ -742,9 +742,9 @@
print $msg;
my $spec = get_spec($sn);
- die("can't find spec file for $sn\n") unless $spec && -e $spec;
+ die("can't find spec file for $sn\n") unless $spec && ift('-e', $spec);
- unless( $spec && -e $spec ) {
+ unless( $spec && ift('-e', $spec) ) {
$cf->{pkg_build_failures} .= "$sn ";
warn("specfile not found\n");
return;
@@ -755,7 +755,7 @@
my $pkgfail = 0;
# check for rebuild conditions
- my $dir_bld = -e "$cf->{rpmdir}/BUILD/$tok->{pkg_dir_name}"
+ my $dir_bld = ift('-e', "$cf->{rpmdir}/BUILD/$tok->{pkg_dir_name}")
|| $tok->{version} eq 'local';
my $spec_upd = @rpms && (-M $spec < -M $rpms[0]) && ! $cf->{hostinst};
my $r = '';
@@ -779,7 +779,7 @@
(undef, $url) = split(/:\s*/, $url, 2);
my ($file) = $url =~ m-/?([^/]+)$-;
my $tgt = "$cf->{rpmdir}/SOURCES/$file";
- if(! -e $tgt || $cf->{dltest} || $cf->{download_only}) {
+ if(! ift('-e', $tgt) || $cf->{dltest} || $cf->{download_only})
{
my $src;
unless( $src = get_file($url, $cf, 1) ) {
$cf->{pkg_build_failures} .= "$sn " unless $pkgfail;
@@ -818,7 +818,7 @@
}
# Rebuild something with the source already unpacked
- if( $rpms[0] && -f $rpms[0] ) {
+ if( $rpms[0] && ift('-f', $rpms[0]) ) {
my $src_dir = "$cf->{rpmdir}/BUILD/$tok->{pkg_dir_name}";
if($tok->{version} eq 'local') {
$cmd = "$cf->{rpmbuild} --nobuild "
@@ -829,7 +829,7 @@
if(substr($src_dir, 0, 1) ne '/') {
$src_dir = "$cf->{rpmdir}/BUILD/$src_dir";
}
- die("'$src_dir' doesn't exist\n") unless -e $src_dir;
+ die("'$src_dir' doesn't exist\n") unless ift('-e',
$src_dir);
}
# See if the source tree has been touched
$cmd = "find $src_dir -newer $rpms[0] -print";
@@ -1030,7 +1030,7 @@
$key = get_key_by_sn($sn);
}
$tspec = "$cf->{rpmdir}/SPECS/$sn.spec";
- unlink_log($tspec) if -f $tspec;
+ unlink_log($tspec) if ift('-f',$tspec);
# we expect the user to have run these before
# f_scbuild($key) or die();
@@ -1110,7 +1110,7 @@
my $spec = $specin || $specout;
my $tok = parse_spec($spec) or die();
my $pkg_dir_name = $tok->{pkg_dir_name};
- die(<<TXT) unless -d "$cf->{rpmdir}/BUILD/$pkg_dir_name";
+ die(<<TXT) unless ift('-d', "$cf->{rpmdir}/BUILD/$pkg_dir_name");
Cannot generate a patch for $spec,
the directory: $cf->{rpmdir}/BUILD/$pkg_dir_name
@@ -1121,7 +1121,7 @@
Can't find the prep token to insert the patch unpack command
TXT
- die(<<TXT) if -e "$cf->{rpmdir}/BUILD/$pkg_dir_name.modified";
+ die(<<TXT) if ift('-e', "$cf->{rpmdir}/BUILD/$pkg_dir_name.modified");
The directory '$cf->{rpmdir}/BUILD/$pkg_dir_name.modified'
already exists. You need to move this out the way before running
@@ -1274,7 +1274,7 @@
TXT
}
# ltib should be run from the ltib directory
- if( ! -d "./config/platform" ) {
+ if( ! ift('-d', "./config/platform") ) {
die <<TXT;
Cannot find directory: ./config/platforms
@@ -1300,11 +1300,11 @@
my($cf) = @_;
# if passed, the cfile should exist
- die <<TXT if $cf->{rcfile} && ! -f $cf->{rcfile};
+ die <<TXT if $cf->{rcfile} && ! ift('-f', $cf->{rcfile});
The passed rcfile: $cf->{rcfile} is missing
TXT
foreach my $rc ($cf->{rcfile}, "$cf->{home}/.ltibrc",
"$cf->{top}/.ltibrc"){
- if(-f $rc) {
+ if(ift('-f', $rc)) {
my $hr = parse_config(fn => $rc) or die;
$hr->{rcfile} = $rc;
while( my($k,$v) = each(%$hr) ) {
@@ -1408,7 +1408,7 @@
{
# do not attempt to re-install host packages once
# we have got through here completely once
- return 1 if -f $cf->{host_wait_warning} && (! $cf->{dltest}
+ return 1 if ift('-f', $cf->{host_wait_warning}) && (! $cf->{dltest}
|| $cf->{sn} ||
$cf->{batch});
# check the basic build host package dependencies
@@ -1576,7 +1576,7 @@
# process any toolchain switch
save_binary_rpms();
- return 1 unless -f "$cf->{preconfig}.old";
+ return 1 unless ift('-f', "$cf->{preconfig}.old");
$ppcf = parse_dotconfig("$cf->{preconfig}.old");
if(-M "$cf->{preconfig}.old" <= -M $cf->{preconfig}) {
@@ -1598,7 +1598,7 @@
}
}
if($need_frb && ! $cf->{dry}) {
- f_clean() if -e "$cf->{rpmroot}/$cf->{rpmdb}/Name";
+ f_clean() if ift('-e', "$cf->{rpmroot}/$cf->{rpmdb}/Name");
$ENV{LTIB_FULL_REBUILD} = "y";
}
system_nb("cp -f $cf->{preconfig} $cf->{preconfig}.old") unless $cf->{dry};
@@ -1619,7 +1619,7 @@
my $pon = ! $cf->{dltest};
# figure out if there has been a change that invalidates the current rpms
- if(-f "$dir/$cfn") {
+ if(ift('-f', "$dir/$cfn")) {
my $lcf = parse_dotconfig("$dir/$cfn");
$oldarch = g2larch($lcf->{LINTARCH});
unlink_log("$dir/$cfn"), die("old LINTARCH not in $dir/$cfn,
removing\n")
@@ -1648,25 +1648,25 @@
# we need to switch to a new set of rpms (or remove)
if($pcf->{FEAT_CACHE_RPMS} || ! defined($pcf->{FEAT_CACHE_RPMS}) ) {
if(glob_log("$dir/$oldarch/*.rpm")) {
- if(! -f "$dir/$oldarch/$cfn") {
+ if(! ift('-f', "$dir/$oldarch/$cfn")) {
write_file("$dir/$oldarch/$cfn", $oset);
}
- while(-d "$dir/$ts") { $ts += 0.01; }
+ while(ift('-d', "$dir/$ts")) { $ts += 0.01; }
print("Saving rpms from $oldarch to $dir/$ts\n") if $pon;
rename_log("$dir/$oldarch", "$dir/$ts")
or die("rename $dir/$oldarch", "$dir/$ts : $!");
} else {
print "No binary rpms to save\n" if $pon;
- system_nb("rm -rf $dir/$oldarch") if -e "$dir/$oldarch";
+ system_nb("rm -rf $dir/$oldarch") if ift('-e', "$dir/$oldarch");
}
# look for an existing set of binary rpms matching the new settings
opendir_log($dir);
opendir(DIR, $dir) or die("opendir: $dir: $!");
while( defined(my $ent = readdir(DIR)) ) {
- next unless -d "$dir/$ent";
+ next unless ift('-d', "$dir/$ent");
next if $ent eq '.' || $ent eq '..' || $ent eq $newarch;
- next unless -f "$dir/$ent/$cfn";
+ next unless ift('-f', "$dir/$ent/$cfn");
system_nb("rm -rf $dir/$ent"), next
unless
glob_log("$dir/$ent/*.rpm");
local $/ = undef;
@@ -1677,7 +1677,7 @@
if($ck eq $nset) {
print "Using cached pre-built packages for $pcf->{PLATFORM} ",
"from rpm/$ent\n" if $pon;
- die "$dir/$newarch already exists" if -d "$dir/$newarch";
+ die "$dir/$newarch already exists" if ift('-d',
"$dir/$newarch");
rename_log("$dir/$ent", "$dir/$newarch")
or die "rename: $dir/$ent, $dir/$newarch : $!";
last;
@@ -1862,7 +1862,7 @@
# load up the override map if present.
$map = "$cf->{plat_dir}/pkg_map";
- if( -f $map ) {
+ if( ift('-f', $map) ) {
my $seen = {};
local *read_pkg_map =
sub {
@@ -2087,7 +2087,7 @@
push(@dirs, glob_log("$defdist/*")) unless $defdist eq $pcf_distro;
$cache = {};
}
- if(exists $cache->{$sn} && -e $cache->{$sn}) {
+ if(exists $cache->{$sn} && ift('-e', $cache->{$sn})) {
return wantarray ? @{$cache->{$sn}} : $cache->{$sn}[0];
}
warn("PROFILE:: get_spec ($sn):\n", caller_stack(), "\n") if $cf->{prof};
@@ -2096,7 +2096,7 @@
foreach my $dir ( @dirs ) {
my $specpath = "$dir/$spec";
my $specinpath = "";
- if(-e "$specpath.in") {
+ if(ift('-e', "$specpath.in")) {
$specinpath = "$specpath.in";
$specpath = "$cf->{projtmp}/$spec";
open_log($specinpath);
@@ -2107,17 +2107,17 @@
my $tmplpath;
my ($tmpl) = m,template\s*=\s*([\S]+),i or die("no template");
foreach my $tdir ( $dir, @dirs ) {
- $tmplpath = "$tdir/$tmpl", last if -e "$tdir/$tmpl";
+ $tmplpath = "$tdir/$tmpl", last if ift('-e', "$tdir/$tmpl");
}
die("no template") unless $tmplpath;
warn("template: $tmplpath\n") if $verbose;
my @dlist = sort { -M $a <=> -M $b } ($specinpath, $tmplpath);
- if(! -f $specpath || (-M $dlist[0] < -M $specpath) ) {
+ if(! ift('-f', $specpath) || (-M $dlist[0] < -M $specpath) ) {
expand_spec($specpath, $specinpath, $tmplpath);
my ($atime, $mtime) = (stat($dlist[0]))[8,9];
utime($atime, $mtime, $specpath);
- } elsif( -f $specpath ) {
+ } elsif( ift('-f', $specpath) ) {
expand_spec("$specpath.new", $specinpath, $tmplpath);
if( md5sum("$specpath.new") ne md5sum($specpath) ) {
unlink_log($specpath) or die("unlink $specpath : $!");
@@ -2128,7 +2128,7 @@
}
}
}
- if(-e $specpath) {
+ if(ift('-e', $specpath)) {
warn("spec files: [ $specpath, $specinpath ]\n") if $verbose;
$cache->{$sn} = [ $specpath, $specinpath ];
return wantarray ? @{$cache->{$sn}} : $cache->{$sn}[0];
@@ -2238,14 +2238,14 @@
{
# this is to catch mangled databases before we had a known rpm
# once this has rippled through all users it could come out
- die "$cf->{rpm} has gone missing" unless -f $cf->{rpm};
+ die "$cf->{rpm} has gone missing" unless ift('-f', $cf->{rpm});
my $qo = qx_log("$cf->{rpm} --root $cf->{rpmroot} --dbpath -q $cf->{rpmdb}
bogus-package 2>&1");
if($qo =~ m,unsupported hash version:,m) {
system_nb("rm -rf $cf->{rpmdb}/*") == 0 or die;
}
# auto-migrate old rpmdb
- if(-e "$cf->{top}/rpmdb") {
+ if(ift('-e', "$cf->{top}/rpmdb")) {
print "Updating to new rpm database placement, running a clean\n";
my $sav = {};
my @sav_list = qw/sn force rpmipfx rpmroot rpmdb tmppath enrootn/;
@@ -2318,11 +2318,11 @@
# make sure rootfs is a directory and ipath has write permissions
# by the real user id unless in host/clean mode
- die "rpmroot: $cf->{rpmroot} is not a directory" unless -d $cf->{rpmroot};
+ die "rpmroot: $cf->{rpmroot} is not a directory" unless ift('-d',
$cf->{rpmroot});
die "rpmroot: $cf->{rpmroot} is not writable by $cf->{username}"
- if ! -w $cf->{rpmroot} && $cf->{rpmroot} ne '/';
+ if ! ift('-w', $cf->{rpmroot}) && $cf->{rpmroot}
ne '/';
- if(! -f $cf->{rpmdb_nfs_warning} ) {
+ if(! ift('-f', $cf->{rpmdb_nfs_warning}) ) {
# make sure the rpmdb directory is not an nfs mount
my $fstype = cmd_w_to(5, "df -PT $cf->{rpmroot}/$cf->{rpmdb} |tail
-1") || "fake nfs";
$fstype = (split(/\s+/, $fstype))[1];
@@ -2347,10 +2347,10 @@
# so a rpm database build on an x86 host is not readable on a ppc
# machine until you run rpm --rebuilddb, similarly once that's been
# done you can no longer read it properly on an x86 machine
- my $do_rebuild = 1 unless -e "$cf->{rpmroot}/$cf->{tmppath}";
+ my $do_rebuild = 1 unless ift('-e', "$cf->{rpmroot}/$cf->{tmppath}");
system_nb("mkdir -p $cf->{rpmroot}/$cf->{tmppath}");
- if(! -e "$cf->{rpmroot}/$cf->{rpmdb}/Packages") {
+ if(! ift('-e', "$cf->{rpmroot}/$cf->{rpmdb}/Packages")) {
system_nb(<<TXT) == 0 or die;
set -ex
$cf->{sudo} $cf->{rpm} --root $cf->{rpmroot} --dbpath $cf->{rpmdb} --initdb
@@ -2479,10 +2479,10 @@
sub check_dirs
{
# create the project tmp directory
- system_nb("mkdir -p $cf->{projtmp}") unless -e $cf->{projtmp};
+ system_nb("mkdir -p $cf->{projtmp}") unless ift('-e', $cf->{projtmp});
# we share the download cache area, all must be able to write there
- if(! -e $cf->{lpp} ) {
+ if(! ift('-e', $cf->{lpp}) ) {
system_nb("mkdir -p $cf->{lpp}") == 0 or die(<<TXT);
Cannot create the download directory:
@@ -2503,12 +2503,12 @@
TXT
}
- if( -d "$cf->{top}/pkgs" ) {
+ if( ift('-d', "$cf->{top}/pkgs") ) {
print "Updating lpp from local packages\n";
my ($path, $fn);
foreach $path ( glob_log("$cf->{top}/pkgs/*") ) {
($fn) = $path =~ m,([^/]+)$,;
- next if -f "$cf->{lpp}/$fn";
+ next if ift('-f', "$cf->{lpp}/$fn");
system_nb("set -x; cp -dp $path $cf->{lpp}/$fn") == 0 or die;
}
system_nb("rm -rf $cf->{top}/pkgs 2>/dev/null");
@@ -2518,7 +2518,7 @@
sub check_spoofing
{
- die("spoofing is not set up") unless -e $cf->{spoof_path};
+ die("spoofing is not set up") unless ift('-e', $cf->{spoof_path});
return 1;
}
@@ -2544,7 +2544,7 @@
my $tc_rpm = tc_name($pcf->{TOOLCHAIN});
$tc_rpm =~ s/\.\w+\.rpm//;
qx_log("$cf->{rpm} -q $tc_rpm 2>/dev/null");
- if(! -e "$pcf->{TOOLCHAIN_PATH}/bin/$pcf->{TOOLCHAIN_PREFIX}gcc"
+ if(! ift('-e',
"$pcf->{TOOLCHAIN_PATH}/bin/$pcf->{TOOLCHAIN_PREFIX}gcc")
|| qx_log("$cf->{rpm} -q $tc_rpm 2>/dev/null") =~ m,is not
installed,
|| $cf->{dltest}) {
$pcf->{TOOLCHAIN} = tc_name($pcf->{TOOLCHAIN});
@@ -2610,7 +2610,7 @@
TXT
# If we just installed a toolchain, check that we can compile something
- if($pcf->{TOOLCHAIN} && ! -f ".tc_test_$pcf->{TOOLCHAIN}") {
+ if($pcf->{TOOLCHAIN} && ! ift('-f', ".tc_test_$pcf->{TOOLCHAIN}")) {
my $cmd = <<TXT;
echo '#include <stdio.h>
int main() { printf("hello world"); }' | $gcc_path -x c - -c -o /dev/null
@@ -2632,12 +2632,12 @@
{
my ($pcf) = @_;
my $spec = get_spec("merge");
- if( ! -w "$cf->{rfsbase}/etc/ltib-release") {
+ if( ! ift('-w', "$cf->{rfsbase}/etc/ltib-release")) {
touch($spec);
return 1;
}
foreach my $dir ( $ENV{PLATFORM_PATH}, $ENV{TOP} ) {
- next unless -d "$dir/merge";
+ next unless ift('-d', "$dir/merge");
local $_ = qx_log("find $dir/merge -newer $spec 2>/dev/null");
warn "newer than $spec: $_\n" if $_ && $verbose;
touch($spec), last if $_;
@@ -2785,7 +2785,7 @@
fi
TXT
$cf->{preconfig} = "$hostpath/.config";
- die("No config saved") unless -f $cf->{preconfig};
+ die("No config saved") unless ift('-f', $cf->{preconfig});
return 1;
}
@@ -2804,10 +2804,10 @@
# this is the normal path after a choice for the target has been set
if( ! $cf->{configure} && ! $cf->{upreconfig} && ! $cf->{profile}
- && ! $cf->{selectype} && -f "$cf->{top}/.config" ) {
- if(-f $plat_cf) {
+ && ! $cf->{selectype} && ift('-f', "$cf->{top}/.config") ) {
+ if(ift('-f', $plat_cf)) {
# The normal case where the .config is new than the defconfig
- if( ! -e "$plat_dir/defconfig$rootn"
+ if( ! ift('-e', "$plat_dir/defconfig$rootn")
|| -M $plat_cf <= -M "$plat_dir/defconfig$rootn") {
$cf->{preconfig} = $plat_cf;
return 1;
@@ -2818,7 +2818,7 @@
# the new defconfig. Note mconf/conf use defconfig if .config
# is missing.
warn("Using updated $plat_dir/defconfig$rootn\n");
- rename_log($plat_cf, "$plat_cf.$cf->{stime}") if -f $plat_cf;
+ rename_log($plat_cf, "$plat_cf.$cf->{stime}") if ift('-f',
$plat_cf);
system_nb("cp $plat_dir/defconfig$rootn $plat_cf") == 0 or die;
$cf->{batch} = 1;
}
@@ -2827,9 +2827,9 @@
# In batch mode, we don't want any user interaction
$cf->{conf} = $cf->{batch} ? "yes '' | conf >&2" : "mconf";
- if( -f "$plat_dir/preconfigs.lkc"
+ if( ift('-f', "$plat_dir/preconfigs.lkc")
&& ($cf->{selectype}
- || (! -f $plat_cf && ! -f $conf_cf && ! $cf->{upreconfig})) ) {
+ || (! ift('-f', $plat_cf) && ! ift('-f', $conf_cf) && !
$cf->{upreconfig})) ) {
do {
system_nb(<<TXT) == 0 or die;
set -ex
@@ -2837,21 +2837,21 @@
$cf->{conf} ../$plat_dir/preconfigs.lkc $conf_cf
cd -
TXT
- } while(! -f $conf_cf);
+ } while(! ift('-f', $conf_cf));
}
- if(-f $conf_cf) {
+ if(ift('-f', $conf_cf)) {
my $cf_plat = parse_dotconfig($conf_cf);
$kconfig = $cf_plat->{PCF_KCONFIG} if $cf_plat->{PCF_KCONFIG};
# something changed in selectype or never copied
- if(! -f $plat_cf || (-M $conf_cf < -M $plat_cf) ) {
+ if(! ift('-f', $plat_cf) || (-M $conf_cf < -M $plat_cf) ) {
$cf->{upreconfig} = "$plat_dir/$cf_plat->{PCF_PRECONFIG}"
if $cf_plat->{PCF_PRECONFIG};
if($cf_plat->{PCF_PROFILE}) {
foreach my $dir ($plat_dir, "$cf->{config_dir}/profile",
$cf->{top}){
my $path = "$dir/$cf_plat->{PCF_PROFILE}";
- if(-f $path) {
+ if(ift('-f', $path)) {
$cf->{profile} = $path;
last;
}
@@ -2868,7 +2868,7 @@
my ($atime, $mtime);
# Run the platform specific config
- die "No platform directory set" unless $plat_dir && -d $plat_dir;
+ die "No platform directory set" unless $plat_dir && ift('-d', $plat_dir);
my $rootn = $cf->{rootn} || '';
my $plat_cf = "$plat_dir/.config$rootn";
@@ -2879,7 +2879,7 @@
# from mconf/conf. We save it and restore it later as .config.old
my $oldconfig = "$plat_cf.old";
if(($cf->{selectype} || $cf->{upreconfig} || $cf->{profile})
- && -f $oldconfig ) {
+ && ift('-f', $oldconfig) ) {
($atime, $mtime) = (stat($oldconfig))[8,9];
system_nb("cp $oldconfig $oldconfig.$cf->{stime}");
}
@@ -2910,7 +2910,7 @@
cp .config$rootn defconfig$rootn.dev
TXT
$cf->{preconfig} = $plat_cf;
- if(-f "$oldconfig.$cf->{stime}") {
+ if(ift('-f', "$oldconfig.$cf->{stime}")) {
rename_log("$oldconfig.$cf->{stime}", $oldconfig);
utime($atime, $mtime, $oldconfig)
or warn "could not reset times on $oldconfig : $!";
@@ -2924,7 +2924,7 @@
my $hr;
if($cf->{upreconfig}) {
- if(-d $cf->{upreconfig}) {
+ if(ift('-d', $cf->{upreconfig})) {
if($cf->{upreconfig} =~ m,(config/platform/[^/]+)$,) {
$plat_dir = $1;
$cf->{upreconfig} = '';
@@ -2944,7 +2944,7 @@
die "can't derive a platform directory from $cf->{upreconfig}"
unless $plat_dir;
die "invalid platform directory: $plat_dir in $cf->{upreconfig}"
- unless -d $plat_dir;
+ unless ift('-d',
$plat_dir);
return $plat_dir if $cf->{dltest} || $cf->{mode} =~ m,^listpkgs,;
@@ -2959,17 +2959,17 @@
return $plat_dir;
}
- mk_main_conf() unless -f $cf->{mainlkc};
+ mk_main_conf() unless ift('-f',$cf->{mainlkc});
CHOOSE_TOP_PLATFORM:
- while(! -f "$cf->{top}/.config") {
+ while(! ift('-f',"$cf->{top}/.config")) {
system_nb("$cf->{conf} $cf->{mainlkc}") == 0 or die;
}
# extract the choice
$hr = parse_dotconfig("$cf->{top}/.config");
$plat_dir = $hr->{PLATFORM_DIR} || '';
- if(! -d $plat_dir) {
+ if(! ift('-d',$plat_dir)) {
warn("Platform choice rejected as: '$plat_dir' doesn't exist\n");
unlink_log("$cf->{top}/.config");
die if $cf->{batch};
@@ -2986,7 +2986,7 @@
opendir_log($dir);
opendir(DIR, $dir) or die("can't open $dir: $!");
while( defined($ent = readdir(DIR)) ) {
- next unless -d "$dir/$ent";
+ next unless ift('-d', "$dir/$ent");
next if $ent eq 'CVS' || $ent eq '.' || $ent eq '..' || $ent eq 'host';
$p->{$ent} = 0;
}
- [Ltib] Command debug output patch,
Svein Seldal <=