diff options
Diffstat (limited to 'build/macosx/universal')
| -rw-r--r-- | build/macosx/universal/mozconfig | 11 | ||||
| -rw-r--r-- | build/macosx/universal/mozconfig.common | 55 | ||||
| -rwxr-xr-x | build/macosx/universal/unify | 1525 |
3 files changed, 1591 insertions, 0 deletions
diff --git a/build/macosx/universal/mozconfig b/build/macosx/universal/mozconfig new file mode 100644 index 000000000..32ab66f2d --- /dev/null +++ b/build/macosx/universal/mozconfig @@ -0,0 +1,11 @@ +# This Source Code Form is subject to the terms of the Mozilla Public +# License, v. 2.0. If a copy of the MPL was not distributed with this +# file, You can obtain one at http://mozilla.org/MPL/2.0/. + +# i386/x86-64 Universal Build mozconfig + +# As used here, arguments in $MOZ_BUILD_PROJECTS are suitable as arguments +# to gcc's -arch parameter. +mk_add_options MOZ_BUILD_PROJECTS="x86_64 i386" + +. $topsrcdir/build/macosx/universal/mozconfig.common diff --git a/build/macosx/universal/mozconfig.common b/build/macosx/universal/mozconfig.common new file mode 100644 index 000000000..bb54bc6c4 --- /dev/null +++ b/build/macosx/universal/mozconfig.common @@ -0,0 +1,55 @@ +# This Source Code Form is subject to the terms of the Mozilla Public +# License, v. 2.0. If a copy of the MPL was not distributed with this +# file, You can obtain one at http://mozilla.org/MPL/2.0/. + +mk_add_options MOZ_UNIFY_BDATE=1 + +DARWIN_VERSION=10 +ac_add_app_options i386 --target=i386-apple-darwin$DARWIN_VERSION +ac_add_app_options x86_64 --target=x86_64-apple-darwin$DARWIN_VERSION +ac_add_app_options i386 --with-unify-dist=../x86_64/dist +ac_add_app_options x86_64 --with-unify-dist=../i386/dist + +if ! test `uname -s` = Linux; then + # Cross-universal builds already do the equivalent of this by setting -isysroot directly + ac_add_options --with-macos-sdk=/Developer/SDKs/MacOSX10.7.sdk +fi + +. $topsrcdir/build/macosx/mozconfig.common + +# $MOZ_BUILD_APP is only defined when sourced by configure. That's not a +# problem, because the variables it affects only need to be set for +# configure. +if test -n "$MOZ_BUILD_APP" ; then +if test "$MOZ_BUILD_APP" = "i386" -o "$MOZ_BUILD_APP" = "x86_64"; then + TARGET_CPU=$MOZ_BUILD_APP + + # $HOST_CXX is presently unused. $HOST_CC will only be used during a cross + # compile. + HOST_CC=$CC + HOST_CXX=$CXX + + NATIVE_CPU=`$topsrcdir/build/autoconf/config.guess | cut -f1 -d-` + + # It's not strictly necessary to specify -arch during native builds, but it + # makes the merged about:buildconfig easier to follow, and it reduces + # conditionalized differences between builds. + CC="$CC -arch $TARGET_CPU" + CXX="$CXX -arch $TARGET_CPU" + + # These must be set for cross builds, and don't hurt straight builds. + RANLIB="${TOOLCHAIN_PREFIX}ranlib" + AR="${TOOLCHAIN_PREFIX}ar" + AS=$CC + LD=ld + STRIP="${TOOLCHAIN_PREFIX}strip" + OTOOL="${TOOLCHAIN_PREFIX}otool" + + # Each per-CPU build should be entirely oblivious to the fact that a + # universal binary will be produced. The exception is packager.mk, which + # needs to know to look for universal bits when building the .dmg. + UNIVERSAL_BINARY=1 + + export CC CXX HOST_CC HOST_CXX RANLIB AR AS LD STRIP OTOOL +fi +fi diff --git a/build/macosx/universal/unify b/build/macosx/universal/unify new file mode 100755 index 000000000..38dd35414 --- /dev/null +++ b/build/macosx/universal/unify @@ -0,0 +1,1525 @@ +#!/usr/bin/perl +# This Source Code Form is subject to the terms of the Mozilla Public +# License, v. 2.0. If a copy of the MPL was not distributed with this +# file, You can obtain one at http://mozilla.org/MPL/2.0/. + +use strict; +use warnings; + +=pod + +=head1 NAME + +B<unify> - Mac OS X universal binary packager + +=head1 SYNOPSIS + +B<unify> +I<ppc-path> +I<x86-path> +I<universal-path> +[B<--dry-run>] +[B<--only-one> I<action>] +[B<--verbosity> I<level>] +[B<--unify-with-sort> I<regex>] + +=head1 DESCRIPTION + +I<unify> merges any two architecture-specific files or directory trees +into a single file or tree suitable for use on either architecture as a +"fat" or "universal binary." + +Architecture-specific Mach-O files will be merged into fat Mach-O files +using L<lipo(1)>. Non-Mach-O files in the architecture-specific trees +are compared to ensure that they are equivalent before copying. Symbolic +links are permitted in the architecture-specific trees and will cause +identical links to be created in the merged tree, provided that the source +links have identical targets. Directories are processed recursively. + +If the architecture-specific source trees contain zip archives (including +jar files) that are not identical according to a byte-for-byte check, they +are still assumed to be equivalent if both archives contain exactly the +same members with identical checksums and sizes. + +Behavior when one architecture-specific tree contains files that the other +does not is controlled by the B<--only-one> option. + +If Mach-O files cannot be merged using L<lipo(1)>, zip archives are not +equivalent, regular files are not identical, or any other error occurs, +B<unify> will fail with an exit status of 1. Diagnostic messages are +typically printed to stderr; this behavior can be controlled with the +B<--verbosity> option. + +=head1 OPTIONS + +=over 5 + +=item I<ppc-path> + +=item I<x86-path> + +The paths to directory trees containing PowerPC and x86 builds, +respectively. I<ppc-path> and I<x86-path> are permitted to contain files +that are already "fat," and only the appropriate architecture's images will +be used. + +I<ppc-path> and I<x86-path> are also permitted to both be files, in which +case B<unify> operates solely on those files, and produces an appropriate +merged file at I<target-path>. + +=item I<target-path> + +The path to the merged file or directory tree. This path will be created, +and it must not exist prior to running B<unify>. + +=item B<--dry-run> + +When specified, the commands that would be executed are printed, without +actually executing them. Note that B<--dry-run> and the equivalent +B<--verbosity> level during "wet" runs may print equivalent commands when +no commands are in fact executed: certain operations are handled internally +within B<unify>, and an approximation of a command that performs a similar +task is printed. + +=item B<--only-one> I<action> + +Controls handling of files that are only present in one of the two source +trees. I<action> may be: + skip - These files are skipped. + copy - These files are copied from the tree in which they exist. + fail - When this condition occurs, it is treated as an error. + +The default I<action> is copy. + +=item B<--verbosity> I<level> + +Adjusts the level of loudness of B<unify>. The possible values for +I<level> are: + 0 - B<unify> never prints anything. + (Other programs that B<unify> calls may still print messages.) + 1 - Fatal error messages are printed to stderr. + 2 - Nonfatal warnings are printed to stderr. + 3 - Commands are printed to stdout as they are executed. + +The default I<level> is 2. + +=item B<--unify-with-sort> I<regex> + +Allows merging files matching I<regex> that differ only by the ordering +of the lines contained within them. The unified file will have its contents +sorted. This option may be given multiple times to specify multiple +regexes for matching files. + +=back + +=head1 EXAMPLES + +=over 5 + +=item Create a universal .app bundle from two architecture-specific .app +bundles: + +unify --only-one copy ppc/dist/firefox/Firefox.app + x86/dist/firefox/Firefox.app universal/Firefox.app + --verbosity 3 + +=item Merge two identical architecture-specific trees: + +unify --only-one fail /usr/local /nfs/x86/usr/local + /tmp/usrlocal.fat + +=back + +=head1 REQUIREMENTS + +The only esoteric requirement of B<unify> is that the L<lipo(1)> command +be available. It is present on Mac OS X systems at least as early as +10.3.9, and probably earlier. Mac OS X 10.4 ("Tiger") or later are +recommended. + +=head1 LICENSE + +MPL 2. + +=head1 AUTHOR + +The software was initially written by Mark Mentovai; copyright 2006 +Google Inc. + +=head1 SEE ALSO + +L<cmp(1)>, L<ditto(1)>, L<lipo(1)> + +=cut + +use Archive::Zip(':ERROR_CODES'); +use Errno; +use Fcntl; +use File::Compare; +use File::Copy; +use Getopt::Long; + +my (%gConfig, $gDryRun, $gOnlyOne, $gVerbosity, @gSortMatches); + +sub argumentEscape(@); +sub command(@); +sub compareZipArchives($$); +sub complain($$@); +sub copyIfIdentical($$$); +sub slurp($); +sub get_sorted($); +sub compare_sorted($$); +sub copyIfIdenticalWhenSorted($$$); +sub createUniqueFile($$); +sub makeUniversal($$$); +sub makeUniversalDirectory($$$); +sub makeUniversalInternal($$$$); +sub makeUniversalFile($$$); +sub usage(); +sub readZipCRCs($); + +{ + package FileAttrCache; + + sub new($$); + + sub isFat($); + sub isMachO($); + sub isZip($); + sub lIsDir($); + sub lIsExecutable($); + sub lIsRegularFile($); + sub lIsSymLink($); + sub lstat($); + sub lstatMode($); + sub lstatType($); + sub magic($); + sub magic2($); + sub path($); + sub stat($); + sub statSize($); +} + +%gConfig = ( + 'cmd_lipo' => 'lipo', + 'cmd_rm' => 'rm', +); + +$gDryRun = 0; +$gOnlyOne = 'copy'; +$gVerbosity = 2; +@gSortMatches = (); + +Getopt::Long::Configure('pass_through'); +GetOptions('dry-run' => \$gDryRun, + 'only-one=s' => \$gOnlyOne, + 'verbosity=i' => \$gVerbosity, + 'unify-with-sort=s' => \@gSortMatches, + 'config=s' => \%gConfig); # "hidden" option not in usage() + +if (scalar(@ARGV) != 3 || $gVerbosity < 0 || $gVerbosity > 3 || + ($gOnlyOne ne 'skip' && $gOnlyOne ne 'copy' && $gOnlyOne ne 'fail')) { + usage(); + exit(1); +} + +if (!makeUniversal($ARGV[0],$ARGV[1],$ARGV[2])) { + # makeUniversal or something it called will have printed an error. + exit(1); +} + +exit(0); + +# argumentEscape(@arguments) +# +# Takes a list of @arguments and makes them shell-safe. +sub argumentEscape(@) { + my (@arguments); + @arguments = @_; + + my ($argument, @argumentsOut); + foreach $argument (@arguments) { + $argument =~ s%([^A-Za-z0-9_\-/.=+,])%\\$1%g; + push(@argumentsOut, $argument); + } + + return @argumentsOut; +} + +# command(@arguments) +# +# Runs the specified command by calling system(@arguments). If $gDryRun +# is true, the command is printed but not executed, and 0 is returned. +# if $gVerbosity is greater than 1, the command is printed before being +# executed. When the command is executed, the system() return value will +# be returned. stdout and stderr are left connected for command output. +sub command(@) { + my (@arguments); + @arguments = @_; + if ($gVerbosity >= 3 || $gDryRun) { + print(join(' ', argumentEscape(@arguments))."\n"); + } + if ($gDryRun) { + return 0; + } + return system(@arguments); +} + +# compareZipArchives($zip1, $zip2) +# +# Given two pathnames to zip archives, determines whether or not they are +# functionally identical. Returns true if they are, false if they differ in +# some substantial way, and undef if an error occurs. If the zip files +# differ, diagnostic messages are printed indicating how they differ. +# +# Zip files will differ if any of the members are different as defined by +# readZipCRCs, which consider CRCs, sizes, and file types as stored in the +# file header. Timestamps are not considered. Zip files also differ if one +# file contains members that the other one does not. $gOnlyOne has no +# effect on this behavior. +sub compareZipArchives($$) { + my ($zip1, $zip2); + ($zip1, $zip2) = @_; + + my ($CRCHash1, $CRCHash2); + if (!defined($CRCHash1 = readZipCRCs($zip1))) { + # readZipCRCs printed an error. + return undef; + } + if (!defined($CRCHash2 = readZipCRCs($zip2))) { + # readZipCRCs printed an error. + return undef; + } + + my (@diffCRCs, @onlyInZip1); + @diffCRCs = (); + @onlyInZip1 = (); + + my ($memberName); + foreach $memberName (keys(%$CRCHash1)) { + if (!exists($$CRCHash2{$memberName})) { + # The member is present in $zip1 but not $zip2. + push(@onlyInZip1, $memberName); + } + elsif ($$CRCHash1{$memberName} ne $$CRCHash2{$memberName}) { + # The member is present in both archives but its CRC or some other + # other critical attribute isn't identical. + push(@diffCRCs, $memberName); + } + delete($$CRCHash2{$memberName}); + } + + # If any members remain in %CRCHash2, it's because they're not present + # in $zip1. + my (@onlyInZip2); + @onlyInZip2 = keys(%$CRCHash2); + + if (scalar(@onlyInZip1) + scalar(@onlyInZip2) + scalar(@diffCRCs)) { + complain(1, 'compareZipArchives: zip archives differ:', + $zip1, + $zip2); + if (scalar(@onlyInZip1)) { + complain(1, 'compareZipArchives: members only in former:', + @onlyInZip1); + } + if (scalar(@onlyInZip2)) { + complain(1, 'compareZipArchives: members only in latter:', + @onlyInZip2); + } + if (scalar(@diffCRCs)) { + complain(1, 'compareZipArchives: members differ:', + @diffCRCs); + } + return 0; + } + + return 1; +} + +# complain($severity, $message, @list) +# +# Prints $message to stderr if $gVerbosity allows it for severity level +# $severity. @list is a list of words that will be shell-escaped and printed +# after $message, one per line, intended to be used, for example, to list +# arguments to a call that failed. +# +# Expected severity levels are 1 for hard errors and 2 for non-fatal warnings. +# +# Always returns false as a convenience, so callers can return complain's +# return value when it is used to signal errors. +sub complain($$@) { + my ($severity, $message, @list); + ($severity, $message, @list) = @_; + + if ($gVerbosity >= $severity) { + print STDERR ($0.': '.$message."\n"); + + my ($item); + while ($item = shift(@list)) { + print STDERR (' '.(argumentEscape($item))[0]. + (scalar(@list)?',':'')."\n"); + } + } + + return 0; +} + +# copyIfIdentical($source1, $source2, $target) +# +# $source1 and $source2 are FileAttrCache objects that are compared, and if +# identical, copied to path string $target. The comparison is initially +# done as a byte-for-byte comparison, but if the files differ and appear to +# be zip archives, compareZipArchives is called to determine whether +# files that are not byte-for-byte identical are equivalent archives. +# +# Returns true on success, false for files that are not identical or +# equivalent archives, and undef if an error occurs. +# +# One of $source1 and $source2 is permitted to be undef. In this event, +# whichever source is defined is copied directly to $target without performing +# any comparisons. This enables the $gOnlyOne = 'copy' mode, which is +# driven by makeUniversalDirectory and makeUniversalInternal. +sub copyIfIdentical($$$) { + my ($source1, $source2, $target); + ($source1, $source2, $target) = @_; + + if (!defined($source1)) { + # If there's only one source file, make it the first file. Order + # isn't important here, and this makes it possible to use + # defined($source2) as the switch, and to always copy from $source1. + $source1 = $source2; + $source2 = undef; + } + + if (defined($source2)) { + # Only do the comparisons if there are two source files. If there's + # only one source file, skip the comparisons and go straight to the + # copy operation. + if ($gVerbosity >= 3 || $gDryRun) { + print('cmp -s '. + join(' ',argumentEscape($source1->path(), $source2->path()))."\n"); + } + my ($comparison); + if (!defined($comparison = compare($source1->path(), $source2->path())) || + $comparison == -1) { + return complain(1, 'copyIfIdentical: compare: '.$!.' while comparing:', + $source1->path(), + $source2->path()); + } + elsif ($comparison != 0) { + my ($zip1, $zip2); + if (defined($zip1 = $source1->isZip()) && + defined($zip2 = $source2->isZip()) && + $zip1 && $zip2) { + my ($zipComparison); + if (!defined($zipComparison = compareZipArchives($source1->path(), + $source2->path)) || + !$zipComparison) { + # An error occurred or the zip files aren't sufficiently identical. + # compareZipArchives will have printed an error message. + return 0; + } + # The zip files were compared successfully, and they both contain + # all of the same members, and all of their members' CRCs are + # identical. For the purposes of this script, the zip files can be + # treated as identical, so reset $comparison. + $comparison = 0; + } + } + if ($comparison != 0) { + return complain(1, 'copyIfIdentical: files differ:', + $source1->path(), + $source2->path()); + } + } + + if ($gVerbosity >= 3 || $gDryRun) { + print('cp '. + join(' ',argumentEscape($source1->path(), $target))."\n"); + } + + if (!$gDryRun) { + my ($isExecutable); + + # Set the execute bits (as allowed by the umask) on the new file if any + # execute bit is set on either old file. + $isExecutable = $source1->lIsExecutable() || + (defined($source2) && $source2->lIsExecutable()); + + if (!createUniqueFile($target, $isExecutable ? 0777 : 0666)) { + # createUniqueFile printed an error. + return 0; + } + + if (!copy($source1->path(), $target)) { + complain(1, 'copyIfIdentical: copy: '.$!.' while copying', + $source1->path(), + $target); + unlink($target); + return 0; + } + } + + return 1; +} + +# slurp($file) +# +# Read the contents of $file into an array and return it. +# Returns undef on error. +sub slurp($) { + my $file = $_[0]; + open FILE, $file or return undef; + my @lines = <FILE>; + close FILE; + return @lines; +} + +# get_sorted($file) +# Get the sorted lines of a file as a list, normalizing a newline on the last line if necessary. +sub get_sorted($) { + my ($file) = @_; + my @lines = slurp($file); + my $lastline = $lines[-1]; + if (!($lastline =~ /\n/)) { + $lines[-1] = $lastline . "\n"; + } + return sort(@lines); +} + +# compare_sorted($file1, $file2) +# +# Read the contents of both files into arrays, sort the arrays, +# and then compare the two arrays for equality. +# +# Returns 0 if the sorted array contents are equal, or 1 if not. +# Returns undef on error. +sub compare_sorted($$) { + my ($file1, $file2) = @_; + my @lines1 = get_sorted($file1); + my @lines2 = get_sorted($file2); + + return undef if !@lines1 || !@lines2; + return 1 unless scalar @lines1 == scalar @lines2; + + for (my $i = 0; $i < scalar @lines1; $i++) { + return 1 if $lines1[$i] ne $lines2[$i]; + } + return 0; +} + +# copyIfIdenticalWhenSorted($source1, $source2, $target) +# +# $source1 and $source2 are FileAttrCache objects that are compared, and if +# identical, copied to path string $target. The comparison is done by +# sorting the individual lines within the two files and comparing the results. +# +# Returns true on success, false for files that are not equivalent, +# and undef if an error occurs. +sub copyIfIdenticalWhenSorted($$$) { + my ($source1, $source2, $target); + ($source1, $source2, $target) = @_; + + if ($gVerbosity >= 3 || $gDryRun) { + print('cmp -s '. + join(' ',argumentEscape($source1->path(), $source2->path()))."\n"); + } + my ($comparison); + if (!defined($comparison = compare_sorted($source1->path(), + $source2->path())) || + $comparison == -1) { + return complain(1, 'copyIfIdenticalWhenSorted: compare: '.$! + .' while comparing:', + $source1->path(), + $source2->path()); + } + if ($comparison != 0) { + return complain(1, 'copyIfIdenticalWhenSorted: files differ:', + $source1->path(), + $source2->path()); + } + + if ($gVerbosity >= 3 || $gDryRun) { + print('cp '. + join(' ',argumentEscape($source1->path(), $target))."\n"); + } + + if (!$gDryRun) { + my ($isExecutable); + + # Set the execute bits (as allowed by the umask) on the new file if any + # execute bit is set on either old file. + $isExecutable = $source1->lIsExecutable() || + (defined($source2) && $source2->lIsExecutable()); + + if (!createUniqueFile($target, $isExecutable ? 0777 : 0666)) { + # createUniqueFile printed an error. + return 0; + } + + if (!copy($source1->path(), $target)) { + complain(1, 'copyIfIdenticalWhenSorted: copy: '.$! + .' while copying', + $source1->path(), + $target); + unlink($target); + return 0; + } + } + + return 1; +} + +# createUniqueFile($path, $mode) +# +# Creates a new plain empty file at pathname $path, provided it does not +# yet exist. $mode is used as the file mode. The actual file's mode will +# be modified by the effective umask. Returns false if the file could +# not be created, setting $! to the error. An error message is printed +# in the event of failure. +sub createUniqueFile($$) { + my ($path, $mode); + ($path, $mode) = @_; + + my ($fh); + if (!sysopen($fh, $path, O_WRONLY | O_CREAT | O_EXCL, $mode)) { + return complain(1, 'createUniqueFile: open: '.$!.' for:', + $path); + } + close($fh); + + return 1; +} + +# makeUniversal($pathPPC, $pathX86, $pathTarget) +# +# The top-level call. $pathPPC, $pathX86, and $pathTarget are strings +# identifying the ppc and x86 files or directories to merge and the location +# to merge them to. Returns false on failure and true on success. +sub makeUniversal($$$) { + my ($pathTarget, $pathPPC, $pathX86); + ($pathPPC, $pathX86, $pathTarget) = @_; + + my ($filePPC, $fileX86); + $filePPC = FileAttrCache->new($pathPPC); + $fileX86 = FileAttrCache->new($pathX86); + + return makeUniversalInternal(1, $filePPC, $fileX86, $pathTarget); +} + +# makeUniversalDirectory($dirPPC, $dirX86, $dirTarget) +# +# This is part of the heart of recursion. $dirPPC and $dirX86 are +# FileAttrCache objects designating the source ppc and x86 directories to +# merge into a universal directory at $dirTarget, a string. For each file +# in $dirPPC and $dirX86, makeUniversalInternal is called. +# makeUniversalInternal will call back into makeUniversalDirectory for +# directories, thus completing the recursion. If a failure is encountered +# in ths function or in makeUniversalInternal or anything that it calls, +# false is returned, otherwise, true is returned. +# +# If there are files present in one source directory but not both, the +# value of $gOnlyOne controls the behavior. If $gOnlyOne is 'copy', the +# single source file is copied into $pathTarget. If it is 'skip', it is +# skipped. If it is 'fail', such files will trigger makeUniversalDirectory +# to fail. +# +# If either source directory is undef, it is treated as having no files. +# This facilitates deep recursion when entire directories are only present +# in one source when $gOnlyOne = 'copy'. +sub makeUniversalDirectory($$$) { + my ($dirPPC, $dirX86, $dirTarget); + ($dirPPC, $dirX86, $dirTarget) = @_; + + my ($dh, @filesPPC, @filesX86); + + @filesPPC = (); + if (defined($dirPPC)) { + if (!opendir($dh, $dirPPC->path())) { + return complain(1, 'makeUniversalDirectory: opendir ppc: '.$!.' for:', + $dirPPC->path()); + } + @filesPPC = readdir($dh); + closedir($dh); + } + + @filesX86 = (); + if (defined($dirX86)) { + if (!opendir($dh, $dirX86->path())) { + return complain(1, 'makeUniversalDirectory: opendir x86: '.$!.' for:', + $dirX86->path()); + } + @filesX86 = readdir($dh); + closedir($dh); + } + + my (%common, $file, %onlyPPC, %onlyX86); + + %onlyPPC = (); + foreach $file (@filesPPC) { + if ($file eq '.' || $file eq '..') { + next; + } + $onlyPPC{$file}=1; + } + + %common = (); + %onlyX86 = (); + foreach $file (@filesX86) { + if ($file eq '.' || $file eq '..') { + next; + } + if ($onlyPPC{$file}) { + delete $onlyPPC{$file}; + $common{$file}=1; + } + else { + $onlyX86{$file}=1; + } + } + + # First, handle files common to both. + foreach $file (sort(keys(%common))) { + if (!makeUniversalInternal(0, + FileAttrCache->new($dirPPC->path().'/'.$file), + FileAttrCache->new($dirX86->path().'/'.$file), + $dirTarget.'/'.$file)) { + # makeUniversalInternal will have printed an error. + return 0; + } + } + + # Handle files found only in a single directory here. There are three + # options, dictated by $gOnlyOne: fail if files are only present in + # one directory, skip any files only present in one directory, or copy + # these files straight over to the target directory. In any event, + # a message will be printed indicating that the file trees don't match + # exactly. + if (keys(%onlyPPC)) { + complain(($gOnlyOne eq 'fail' ? 1 : 2), + ($gOnlyOne ne 'fail' ? 'warning: ' : ''). + 'makeUniversalDirectory: only in ppc '. + (argumentEscape($dirPPC->path()))[0].':', + argumentEscape(keys(%onlyPPC))); + } + + if (keys(%onlyX86)) { + complain(($gOnlyOne eq 'fail' ? 1 : 2), + ($gOnlyOne ne 'fail' ? 'warning: ' : ''). + 'makeUniversalDirectory: only in x86 '. + (argumentEscape($dirX86->path()))[0].':', + argumentEscape(keys(%onlyX86))); + } + + if ($gOnlyOne eq 'fail' && (keys(%onlyPPC) || keys(%onlyX86))) { + # Error message(s) printed above. + return 0; + } + + if ($gOnlyOne eq 'copy') { + foreach $file (sort(keys(%onlyPPC))) { + if (!makeUniversalInternal(0, + FileAttrCache->new($dirPPC->path().'/'.$file), + undef, + $dirTarget.'/'.$file)) { + # makeUniversalInternal will have printed an error. + return 0; + } + } + + foreach $file (sort(keys(%onlyX86))) { + if (!makeUniversalInternal(0, + undef, + FileAttrCache->new($dirX86->path().'/'.$file), + $dirTarget.'/'.$file)) { + # makeUniversalInternal will have printed an error. + return 0; + } + } + } + + return 1; +} + +# makeUniversalFile($sourcePPC, $sourceX86, $targetPath) +# +# Creates a universal file at pathname $targetPath based on a ppc image at +# $sourcePPC and an x86 image at $sourceX86. $sourcePPC and $sourceX86 are +# both FileAttrCache objects. Returns true on success and false on failure. +# On failure, diagnostics will be printed to stderr. +# +# The source files may be either thin Mach-O images of the appropriate +# architecture, or fat Mach-O files that contain images of the appropriate +# architecture. +# +# This function wraps the lipo utility, see lipo(1). +sub makeUniversalFile($$$) { + my ($sourcePPC, $sourceX86, $targetPath, @tempThinFiles, $thinPPC, $thinX86); + ($sourcePPC, $sourceX86, $targetPath) = @_; + $thinPPC = $sourcePPC; + $thinX86 = $sourceX86; + + @tempThinFiles = (); + + # The source files might already be fat. They should be thinned out to only + # contain a single architecture. + + my ($isFatPPC, $isFatX86); + + if(!defined($isFatPPC = $sourcePPC->isFat())) { + # isFat printed its own error + return 0; + } + elsif($isFatPPC) { + $thinPPC = FileAttrCache->new($targetPath.'.ppc'); + push(@tempThinFiles, $thinPPC->path()); + if (command($gConfig{'cmd_lipo'}, '-thin', 'ppc', + $sourcePPC->path(), '-output', $thinPPC->path()) != 0) { + unlink(@tempThinFiles); + return complain(1, 'lipo thin ppc failed for:', + $sourcePPC->path(), + $thinPPC->path()); + } + } + + if(!defined($isFatX86 = $sourceX86->isFat())) { + # isFat printed its own error + unlink(@tempThinFiles); + return 0; + } + elsif($isFatX86) { + $thinX86 = FileAttrCache->new($targetPath.'.x86'); + push(@tempThinFiles, $thinX86->path()); + if (command($gConfig{'cmd_lipo'}, '-thin', 'i386', + $sourceX86->path(), '-output', $thinX86->path()) != 0) { + unlink(@tempThinFiles); + return complain(1, 'lipo thin x86 failed for:', + $sourceX86->path(), + $thinX86->path()); + } + } + + # The image for each architecture in the fat file will be aligned on + # a specific boundary, default 4096 bytes, see lipo(1) -segalign. + # Since there's no tail-padding, the fat file will consume the least + # space on disk if the image that comes last exceeds the segment size + # by the smallest amount. + # + # This saves an average of 1kB per fat file over the naive approach of + # always putting one architecture first: average savings is 2kB per + # file, but the naive approach would have gotten it right half of the + # time. + + my ($sizePPC, $sizeX86, $thinPPCForStat, $thinX86ForStat); + + if (!$gDryRun) { + $thinPPCForStat = $thinPPC; + $thinX86ForStat = $thinX86; + } + else { + # Normally, fat source files will have been converted into temporary + # thin files. During a dry run, that doesn't happen, so fake it up + # a little bit by always using the source file, fat or thin, for the + # stat. + $thinPPCForStat = $sourcePPC; + $thinX86ForStat = $sourceX86; + } + + if (!defined($sizePPC = $thinPPCForStat->statSize())) { + unlink(@tempThinFiles); + return complain(1, 'stat ppc: '.$!.' for:', + $thinPPCForStat->path()); + } + if (!defined($sizeX86 = $thinX86ForStat->statSize())) { + unlink(@tempThinFiles); + return complain(1, 'stat x86: '.$!.' for:', + $thinX86ForStat->path()); + } + + $sizePPC = $sizePPC % 4096; + $sizeX86 = $sizeX86 % 4096; + + my (@thinFiles); + + if ($sizePPC == 0) { + # PPC image ends on an alignment boundary, there will be no padding before + # starting the x86 image. + @thinFiles = ($thinPPC->path(), $thinX86->path()); + } + elsif ($sizeX86 == 0 || $sizeX86 > $sizePPC) { + # x86 image ends on an alignment boundary, there will be no padding before + # starting the PPC image, or the x86 image exceeds its alignment boundary + # by more than the PPC image, so there will be less padding if the x86 + # comes first. + @thinFiles = ($thinX86->path(), $thinPPC->path()); + } + else { + # PPC image exceeds its alignment boundary by more than the x86 image, so + # there will be less padding if the PPC comes first. + @thinFiles = ($thinPPC->path(), $thinX86->path()); + } + + my ($isExecutable); + $isExecutable = $sourcePPC->lIsExecutable() || + $sourceX86->lIsExecutable(); + + if (!$gDryRun) { + # Ensure that the file does not yet exist. + + # Set the execute bits (as allowed by the umask) on the new file if any + # execute bit is set on either old file. Yes, it is possible to have + # proper Mach-O files without x-bits: think object files (.o) and static + # archives (.a). + if (!createUniqueFile($targetPath, $isExecutable ? 0777 : 0666)) { + # createUniqueFile printed an error. + unlink(@tempThinFiles); + return 0; + } + } + + # Create the fat file. + if (command($gConfig{'cmd_lipo'}, '-create', @thinFiles, + '-output', $targetPath) != 0) { + unlink(@tempThinFiles, $targetPath); + return complain(1, 'lipo create fat failed for:', + @thinFiles, + $targetPath); + } + + unlink(@tempThinFiles); + + if (!$gDryRun) { + # lipo seems to think that it's free to set its own file modes that + # ignore the umask, which is bogus when the rest of this script + # respects the umask. + if (!chmod(($isExecutable ? 0777 : 0666) & ~umask(), $targetPath)) { + complain(1, 'makeUniversalFile: chmod: '.$!.' for', + $targetPath); + unlink($targetPath); + return 0; + } + } + + return 1; +} + +# makeUniversalInternal($isToplevel, $filePPC, $fileX86, $fileTargetPath) +# +# Given FileAttrCache objects $filePPC and $fileX86, compares filetypes +# and performs the appropriate action to produce a universal file at +# path string $fileTargetPath. $isToplevel should be true if this is +# the recursive base and false otherwise; this controls cleanup behavior +# (cleanup is only performed at the base, because cleanup itself is +# recursive). +# +# This handles regular files by determining whether they are Mach-O files +# and calling makeUniversalFile if so and copyIfIdentical otherwise. Symbolic +# links are handled directly in this function by ensuring that the source link +# targets are identical and creating a new link with the same target +# at $fileTargetPath. Directories are handled by calling +# makeUniversalDirectory. +# +# One of $filePPC and $fileX86 is permitted to be undef. In that case, +# the defined source file is copied directly to the target if a regular +# file, and symlinked appropriately if a symbolic link. This facilitates +# use of $gOnlyOne = 'copy', although no $gOnlyOne checks are made in this +# function, they are all handled in makeUniversalDirectory. +# +# Returns true on success. Returns false on failure, including failures +# in other functions called. +sub makeUniversalInternal($$$$) { + my ($filePPC, $fileTargetPath, $fileX86, $isToplevel); + ($isToplevel, $filePPC, $fileX86, $fileTargetPath) = @_; + + my ($typePPC, $typeX86); + if (defined($filePPC) && !defined($typePPC = $filePPC->lstatType())) { + return complain(1, 'makeUniversal: lstat ppc: '.$!.' for:', + $filePPC->path()); + } + if (defined($fileX86) && !defined($typeX86 = $fileX86->lstatType())) { + return complain(1, 'makeUniversal: lstat x86: '.$!.' for:', + $fileX86->path()); + } + + if (defined($filePPC) && defined($fileX86) && $typePPC != $typeX86) { + return complain(1, 'makeUniversal: incompatible types:', + $filePPC->path(), + $fileX86->path()); + } + + # $aSourceFile will contain a FileAttrCache object that will return + # the correct type data. It's used because it's possible for one of + # the two source files to be undefined (indicating a straight copy). + my ($aSourceFile); + if (defined($filePPC)) { + $aSourceFile = $filePPC; + } + else { + $aSourceFile = $fileX86; + } + + if ($aSourceFile->lIsDir()) { + if ($gVerbosity >= 3 || $gDryRun) { + print('mkdir '.(argumentEscape($fileTargetPath))[0]."\n"); + } + if (!$gDryRun && !mkdir($fileTargetPath)) { + return complain(1, 'makeUniversal: mkdir: '.$!.' for:', + $fileTargetPath); + } + + my ($rv); + + if (!($rv = makeUniversalDirectory($filePPC, $fileX86, $fileTargetPath))) { + # makeUniversalDirectory printed an error. + if ($isToplevel) { + command($gConfig{'cmd_rm'},'-rf','--',$fileTargetPath); + } + } + else { + # Touch the directory when leaving it. If unify is being run on an + # .app bundle, the .app might show up without an icon because the + # system might have found the .app before it was completely built. + # Touching it dirties it in LaunchServices' mind. + if ($gVerbosity >= 3) { + print('touch '.(argumentEscape($fileTargetPath))[0]."\n"); + } + utime(undef, undef, $fileTargetPath); + } + + return $rv; + } + elsif ($aSourceFile->lIsSymLink()) { + my ($linkPPC, $linkX86); + if (defined($filePPC) && !defined($linkPPC=readlink($filePPC->path()))) { + return complain(1, 'makeUniversal: readlink ppc: '.$!.' for:', + $filePPC->path()); + } + if (defined($fileX86) && !defined($linkX86=readlink($fileX86->path()))) { + return complain(1, 'makeUniversal: readlink x86: '.$!.' for:', + $fileX86->path()); + } + if (defined($filePPC) && defined($fileX86) && $linkPPC ne $linkX86) { + return complain(1, 'makeUniversal: symbolic links differ:', + $filePPC->path(), + $fileX86->path()); + } + + # $aLink here serves the same purpose as $aSourceFile in the enclosing + # block: it refers to the target of the symbolic link, whether there + # is one valid source or two. + my ($aLink); + if (defined($linkPPC)) { + $aLink = $linkPPC; + } + else { + $aLink = $linkX86; + } + + if ($gVerbosity >= 3 || $gDryRun) { + print('ln -s '. + join(' ',argumentEscape($aLink, $fileTargetPath))."\n"); + } + if (!$gDryRun && !symlink($aLink, $fileTargetPath)) { + return complain(1, 'makeUniversal: symlink: '.$!.' for:', + $aLink, + $fileTargetPath); + } + + return 1; + } + elsif($aSourceFile->lIsRegularFile()) { + my ($machPPC, $machX86, $fileName); + if (!defined($filePPC) || !defined($fileX86)) { + # One of the source files isn't present. The right thing to do is + # to just copy what does exist straight over, so skip Mach-O checks. + $machPPC = 0; + $machX86 = 0; + if (defined($filePPC)) { + $fileName = $filePPC; + } elsif (defined($fileX86)) { + $fileName = $fileX86; + } else { + complain(1, "The file must exist in at least one directory"); + exit(1); + } + } + else { + # both files exist, pick the name of one. + $fileName = $fileX86; + if (!defined($machPPC=$filePPC->isMachO())) { + return complain(1, 'makeUniversal: isFileMachO ppc failed for:', + $filePPC->path()); + } + if (!defined($machX86=$fileX86->isMachO())) { + return complain(1, 'makeUniversal: isFileMachO x86 failed for:', + $fileX86->path()); + } + } + + if ($machPPC != $machX86) { + return complain(1, 'makeUniversal: variant Mach-O attributes:', + $filePPC->path(), + $fileX86->path()); + } + + if ($machPPC) { + # makeUniversalFile will print an error if it fails. + return makeUniversalFile($filePPC, $fileX86, $fileTargetPath); + } + + if (grep { $fileName->path() =~ m/$_/; } @gSortMatches) { + # Regular files, but should be compared with sorting first. + # copyIfIdenticalWhenSorted will print an error if it fails. + return copyIfIdenticalWhenSorted($filePPC, $fileX86, $fileTargetPath); + } + + # Regular file. copyIfIdentical will print an error if it fails. + return copyIfIdentical($filePPC, $fileX86, $fileTargetPath); + } + + # Special file, don't know how to handle. + return complain(1, 'makeUniversal: cannot handle special file:', + $filePPC->path(), + $fileX86->path()); +} + +# usage() +# +# Give the user a hand. +sub usage() { + print STDERR ( +"usage: unify <ppc-path> <x86-path> <universal-path>\n". +" [--dry-run] (print what would be done)\n". +" [--only-one <action>] (skip, copy, fail; default=copy)\n". +" [--verbosity <level>] (0, 1, 2, 3; default=2)\n"); + return; +} + +# readZipCRCs($zipFile) +# +# $zipFile is the pathname to a zip file whose directory will be read. +# A reference to a hash is returned, with the member pathnames from the +# zip file as keys, and reasonably unique identifiers as values. The +# format of the values is not specified exactly, but does include the +# member CRCs and sizes and differentiates between files and directories. +# It specifically does not distinguish between modification times. On +# failure, prints a message and returns undef. +sub readZipCRCs($) { + my ($zipFile); + ($zipFile) = @_; + + my ($ze, $zip); + $zip = Archive::Zip->new(); + + if (($ze = $zip->read($zipFile)) != AZ_OK) { + complain(1, 'readZipCRCs: read error '.$ze.' for:', + $zipFile); + return undef; + } + + my ($member, %memberCRCs, @memberList); + %memberCRCs = (); + @memberList = $zip->members(); + + foreach $member (@memberList) { + # Take a few of the attributes that identify the file and stuff them into + # the members hash. Directories will show up with size 0 and crc32 0, + # so isDirectory() is used to distinguish them from empty files. + $memberCRCs{$member->fileName()} = join(',', $member->isDirectory() ? 1 : 0, + $member->uncompressedSize(), + $member->crc32String()); + } + + return {%memberCRCs}; +} + +{ + # FileAttrCache allows various attributes about a file to be cached + # so that if they are needed again after first use, no system calls + # will be made and the program won't need to hit the disk. + + package FileAttrCache; + + # from /usr/include/mach-o/loader.h + use constant MH_MAGIC => 0xfeedface; + use constant MH_CIGAM => 0xcefaedfe; + use constant MH_MAGIC_64 => 0xfeedfacf; + use constant MH_CIGAM_64 => 0xcffaedfe; + + use Fcntl(':DEFAULT', ':mode'); + + # FileAttrCache->new($path) + # + # Creates a new FileAttrCache object for the file at path $path and + # returns it. The cache is not primed at creation time, values are + # fetched lazily as they are needed. + sub new($$) { + my ($class, $path, $proto, $this); + ($proto, $path) = @_; + if (!($class = ref($proto))) { + $class = $proto; + } + $this = { + 'path' => $path, + 'lstat' => undef, + 'lstatErrno' => 0, + 'lstatInit' => 0, + 'magic' => undef, + 'magic2' => undef, + 'magicErrno' => 0, + 'magicErrMsg' => undef, + 'magicInit' => 0, + 'stat' => undef, + 'statErrno' => 0, + 'statInit' => 0, + }; + bless($this, $class); + return($this); + } + + # $FileAttrCache->isFat() + # + # Returns true if the file is a fat Mach-O file, false if it's not, and + # undef if an error occurs. See /usr/include/mach-o/fat.h. + sub isFat($) { + my ($magic, $magic2, $this); + ($this) = @_; + + # magic() caches, there's no separate cache because isFat() doesn't hit + # the disk other than by calling magic(). + + if (!defined($magic = $this->magic())) { + return undef; + } + $magic2 = $this->magic2(); + + # We have to sanity check the second four bytes, because Java class + # files use the same magic number as Mach-O fat binaries. + # This logic is adapted from file(1), which says that Mach-O uses + # these bytes to count the number of architectures within, while + # Java uses it for a version number. Conveniently, there are only + # 18 labelled Mach-O architectures, and Java's first released + # class format used the version 43.0. + if ($magic == 0xcafebabe && $magic2 < 20) { + return 1; + } + + return 0; + } + + # $FileAttrCache->isMachO() + # + # Returns true if the file is a Mach-O image (including a fat file), false + # if it's not, and undef if an error occurs. See + # /usr/include/mach-o/loader.h and /usr/include/mach-o/fat.h. + sub isMachO($) { + my ($magic, $this); + ($this) = @_; + + # magic() caches, there's no separate cache because isMachO() doesn't hit + # the disk other than by calling magic(). + + if (!defined($magic = $this->magic())) { + return undef; + } + + # Accept Mach-O fat files or Mach-O thin files of either endianness. + if ($magic == MH_MAGIC || + $magic == MH_CIGAM || + $magic == MH_MAGIC_64 || + $magic == MH_CIGAM_64 || + $this->isFat()) { + return 1; + } + + return 0; + } + + # $FileAttrCache->isZip() + # + # Returns true if the file is a zip file, false if it's not, and undef if + # an error occurs. See http://www.pkware.com/business_and_developers/developer/popups/appnote.txt . + sub isZip($) { + my ($magic, $this); + ($this) = @_; + + # magic() caches, there's no separate cache because isFat() doesn't hit + # the disk other than by calling magic(). + + if (!defined($magic = $this->magic())) { + return undef; + } + + if ($magic == 0x504b0304) { + return 1; + } + + return 0; + } + + # $FileAttrCache->lIsExecutable() + # + # Wraps $FileAttrCache->lstat(), returning true if the file is has any, + # execute bit set, false if none are set, or undef if an error occurs. + # On error, $! is set to lstat's errno. + sub lIsExecutable($) { + my ($mode, $this); + ($this) = @_; + + if (!defined($mode = $this->lstatMode())) { + return undef; + } + + return $mode & (S_IXUSR | S_IXGRP | S_IXOTH); + } + + # $FileAttrCache->lIsDir() + # + # Wraps $FileAttrCache->lstat(), returning true if the file is a directory, + # false if it isn't, or undef if an error occurs. Because lstat is used, + # this will return false even if the file is a symlink pointing to a + # directory. On error, $! is set to lstat's errno. + sub lIsDir($) { + my ($type, $this); + ($this) = @_; + + if (!defined($type = $this->lstatType())) { + return undef; + } + + return S_ISDIR($type); + } + + # $FileAttrCache->lIsRegularFile() + # + # Wraps $FileAttrCache->lstat(), returning true if the file is a regular, + # file, false if it isn't, or undef if an error occurs. Because lstat is + # used, this will return false even if the file is a symlink pointing to a + # regular file. On error, $! is set to lstat's errno. + sub lIsRegularFile($) { + my ($type, $this); + ($this) = @_; + + if (!defined($type = $this->lstatType())) { + return undef; + } + + return S_ISREG($type); + } + + # $FileAttrCache->lIsSymLink() + # + # Wraps $FileAttrCache->lstat(), returning true if the file is a symbolic, + # link, false if it isn't, or undef if an error occurs. On error, $! is + # set to lstat's errno. + sub lIsSymLink($) { + my ($type, $this); + ($this) = @_; + + if (!defined($type = $this->lstatType())) { + return undef; + } + + return S_ISLNK($type); + } + + # $FileAttrCache->lstat() + # + # Wraps the lstat system call, providing a cache to speed up multiple + # lstat calls for the same file. See lstat(2) and lstat in perlfunc(1). + sub lstat($) { + my (@stat, $this); + ($this) = @_; + + # Use the cached lstat result. + if ($$this{'lstatInit'}) { + if (defined($$this{'lstatErrno'})) { + $! = $$this{'lstatErrno'}; + } + return @{$$this{'lstat'}}; + } + $$this{'lstatInit'} = 1; + + if (!(@stat = CORE::lstat($$this{'path'}))) { + $$this{'lstatErrno'} = $!; + } + + $$this{'lstat'} = [@stat]; + return @stat; + } + + # $FileAttrCache->lstatMode() + # + # Wraps $FileAttrCache->lstat(), returning the mode bits from the st_mode + # field, or undef if an error occurs. On error, $! is set to lstat's + # errno. + sub lstatMode($) { + my (@stat, $this); + ($this) = @_; + + if (!(@stat = $this->lstat())) { + return undef; + } + + return S_IMODE($stat[2]); + } + + # $FileAttrCache->lstatType() + # + # Wraps $FileAttrCache->lstat(), returning the type bits from the st_mode + # field, or undef if an error occurs. On error, $! is set to lstat's + # errno. + sub lstatType($) { + my (@stat, $this); + ($this) = @_; + + if (!(@stat = $this->lstat())) { + return undef; + } + + return S_IFMT($stat[2]); + } + + # $FileAttrCache->magic() + # + # Returns the "magic number" for the file by reading its first four bytes + # as a big-endian unsigned 32-bit integer and returning the result. If an + # error occurs, returns undef and prints diagnostic messages to stderr. If + # the file is shorter than 32 bits, returns -1. A cache is provided to + # speed multiple magic calls for the same file. + sub magic($) { + my ($this); + ($this) = @_; + + # Use the cached magic result. + if ($$this{'magicInit'}) { + if (defined($$this{'magicErrno'})) { + if (defined($$this{'magicErrMsg'})) { + main::complain(1, 'FileAttrCache::magic: '.$$this{'magicErrMsg'}.' for:', + $$this{'path'}); + } + $! = $$this{'magicErrno'}; + } + return $$this{'magic'}; + } + + $$this{'magicInit'} = 1; + + my ($fh); + if (!sysopen($fh, $$this{'path'}, O_RDONLY)) { + $$this{'magicErrno'} = $!; + $$this{'magicErrMsg'} = 'open "'.$$this{'path'}.'": '.$!; + main::complain(1, 'FileAttrCache::magic: '.$$this{'magicErrMsg'}.' for:', + $$this{'path'}); + return undef; + } + + $! = 0; + my ($bytes, $magic, $bytes2, $magic2); + if (!defined($bytes = sysread($fh, $magic, 4))) { + $$this{'magicErrno'} = $!; + $$this{'magicErrMsg'} = 'read "'.$$this{'path'}.'": '.$!; + main::complain(1, 'FileAttrCache::magic: '.$$this{'magicErrMsg'}.' for:', + $$this{'path'}); + close($fh); + return undef; + } + else { + $bytes2 = sysread($fh, $magic2, 4); + } + + close($fh); + + if ($bytes != 4) { + # The file is too short, didn't read a magic number. This isn't really + # an error. Return an unlikely value. + $$this{'magic'} = -1; + $$this{'magic2'} = -1; + return -1; + } + if ($bytes2 != 4) { + # File is too short to read a second 4 bytes. + $magic2 = -1; + } + + $$this{'magic'} = unpack('N', $magic); + $$this{'magic2'} = unpack('N', $magic2); + return $$this{'magic'}; + } + + # $FileAttrCache->magic2() + # + # Returns the second four bytes of the file as a 32-bit little endian number. + # See magic(), above for more info. + sub magic2($) { + my ($this); + ($this) = @_; + + # we do the actual work (and cache it) in magic(). + if (!$$this{'magicInit'}) { + my $magic = $$this->magic(); + } + + return $$this{'magic2'}; + } + + # $FileAttrCache->path() + # + # Returns the file's pathname. + sub path($) { + my ($this); + ($this) = @_; + return $$this{'path'}; + } + + # $FileAttrCache->stat() + # + # Wraps the stat system call, providing a cache to speed up multiple + # stat calls for the same file. If lstat() has already been called and + # the file is not a symbolic link, the cached lstat() result will be used. + # See stat(2) and lstat in perlfunc(1). + sub stat($) { + my (@stat, $this); + ($this) = @_; + + # Use the cached stat result. + if ($$this{'statInit'}) { + if (defined($$this{'statErrno'})) { + $! = $$this{'statErrno'}; + } + return @{$$this{'stat'}}; + } + + $$this{'statInit'} = 1; + + # If lstat has already been called, and the file isn't a symbolic link, + # use the cached lstat result. + if ($$this{'lstatInit'} && !$$this{'lstatErrno'} && + !S_ISLNK(${$$this{'lstat'}}[2])) { + $$this{'stat'} = $$this{'lstat'}; + return @{$$this{'stat'}}; + } + + if (!(@stat = CORE::stat($$this{'path'}))) { + $$this{'statErrno'} = $!; + } + + $$this{'stat'} = [@stat]; + return @stat; + } + + # $FileAttrCache->statSize() + # + # Wraps $FileAttrCache->stat(), returning the st_size field, or undef + # undef if an error occurs. On error, $! is set to stat's errno. + sub statSize($) { + my (@stat, $this); + ($this) = @_; + + if (!(@stat = $this->lstat())) { + return undef; + } + + return $stat[7]; + } +} |