2
# ***** BEGIN LICENSE BLOCK *****
3
# Version: MPL 1.1/GPL 2.0/LGPL 2.1
5
# The contents of this file are subject to the Mozilla Public License Version
6
# 1.1 (the "License"); you may not use this file except in compliance with
7
# the License. You may obtain a copy of the License at
8
# http://www.mozilla.org/MPL/
10
# Software distributed under the License is distributed on an "AS IS" basis,
11
# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
12
# for the specific language governing rights and limitations under the
15
# The Original Code is the Mozilla Mac OS X Universal Binary Packaging System
17
# The Initial Developer of the Original Code is Google Inc.
18
# Portions created by the Initial Developer are Copyright (C) 2006
19
# the Initial Developer. All Rights Reserved.
22
# Mark Mentovai <mark@moxienet.com> (Original Author)
24
# Alternatively, the contents of this file may be used under the terms of
25
# either the GNU General Public License Version 2 or later (the "GPL"), or
26
# the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
27
# in which case the provisions of the GPL or the LGPL are applicable instead
28
# of those above. If you wish to allow use of your version of this file only
29
# under the terms of either the GPL or the LGPL, and not to allow others to
30
# use your version of this file under the terms of the MPL, indicate your
31
# decision by deleting the provisions above and replace them with the notice
32
# and other provisions required by the GPL or the LGPL. If you do not delete
33
# the provisions above, a recipient may use your version of this file under
34
# the terms of any one of the MPL, the GPL or the LGPL.
36
# ***** END LICENSE BLOCK *****
45
B<unify> - Mac OS X universal binary packager
54
[B<--only-one> I<action>]
55
[B<--verbosity> I<level>]
56
[B<--unify-with-sort> I<regex>]
60
I<unify> merges any two architecture-specific files or directory trees
61
into a single file or tree suitable for use on either architecture as a
62
"fat" or "universal binary."
64
Architecture-specific Mach-O files will be merged into fat Mach-O files
65
using L<lipo(1)>. Non-Mach-O files in the architecture-specific trees
66
are compared to ensure that they are equivalent before copying. Symbolic
67
links are permitted in the architecture-specific trees and will cause
68
identical links to be created in the merged tree, provided that the source
69
links have identical targets. Directories are processed recursively.
71
If the architecture-specific source trees contain zip archives (including
72
jar files) that are not identical according to a byte-for-byte check, they
73
are still assumed to be equivalent if both archives contain exactly the
74
same members with identical checksums and sizes.
76
Behavior when one architecture-specific tree contains files that the other
77
does not is controlled by the B<--only-one> option.
79
If Mach-O files cannot be merged using L<lipo(1)>, zip archives are not
80
equivalent, regular files are not identical, or any other error occurs,
81
B<unify> will fail with an exit status of 1. Diagnostic messages are
82
typically printed to stderr; this behavior can be controlled with the
83
B<--verbosity> option.
93
The paths to directory trees containing PowerPC and x86 builds,
94
respectively. I<ppc-path> and I<x86-path> are permitted to contain files
95
that are already "fat," and only the appropriate architecture's images will
98
I<ppc-path> and I<x86-path> are also permitted to both be files, in which
99
case B<unify> operates solely on those files, and produces an appropriate
100
merged file at I<target-path>.
104
The path to the merged file or directory tree. This path will be created,
105
and it must not exist prior to running B<unify>.
109
When specified, the commands that would be executed are printed, without
110
actually executing them. Note that B<--dry-run> and the equivalent
111
B<--verbosity> level during "wet" runs may print equivalent commands when
112
no commands are in fact executed: certain operations are handled internally
113
within B<unify>, and an approximation of a command that performs a similar
116
=item B<--only-one> I<action>
118
Controls handling of files that are only present in one of the two source
119
trees. I<action> may be:
120
skip - These files are skipped.
121
copy - These files are copied from the tree in which they exist.
122
fail - When this condition occurs, it is treated as an error.
124
The default I<action> is copy.
126
=item B<--verbosity> I<level>
128
Adjusts the level of loudness of B<unify>. The possible values for
130
0 - B<unify> never prints anything.
131
(Other programs that B<unify> calls may still print messages.)
132
1 - Fatal error messages are printed to stderr.
133
2 - Nonfatal warnings are printed to stderr.
134
3 - Commands are printed to stdout as they are executed.
136
The default I<level> is 2.
138
=item B<--unify-with-sort> I<regex>
140
Allows merging files matching I<regex> that differ only by the ordering
141
of the lines contained within them. The unified file will have its contents
142
sorted. This option may be given multiple times to specify multiple
143
regexes for matching files.
151
=item Create a universal .app bundle from two architecture-specific .app
154
unify --only-one copy ppc/dist/firefox/Firefox.app
155
x86/dist/firefox/Firefox.app universal/Firefox.app
158
=item Merge two identical architecture-specific trees:
160
unify --only-one fail /usr/local /nfs/x86/usr/local
167
The only esoteric requirement of B<unify> is that the L<lipo(1)> command
168
be available. It is present on Mac OS X systems at least as early as
169
10.3.9, and probably earlier. Mac OS X 10.4 ("Tiger") or later are
174
MPL 1.1/GPL 2.0/LGPL 2.1. Your choice
178
The software was initially written by Mark Mentovai; copyright 2006
183
L<cmp(1)>, L<ditto(1)>, L<lipo(1)>
187
use Archive::Zip(':ERROR_CODES');
194
my (%gConfig, $gDryRun, $gOnlyOne, $gVerbosity, @gSortMatches);
196
sub argumentEscape(@);
198
sub compareZipArchives($$);
200
sub copyIfIdentical($$$);
202
sub compare_sorted($$);
204
sub copyIfIdenticalWhenSorted($$$);
205
sub createUniqueFile($$);
206
sub makeUniversal($$$);
207
sub makeUniversalDirectory($$$);
208
sub makeUniversalInternal($$$$);
209
sub makeUniversalFile($$$);
214
package FileAttrCache;
222
sub lIsExecutable($);
223
sub lIsRegularFile($);
236
'cmd_lipo' => 'lipo',
245
Getopt::Long::Configure('pass_through');
246
GetOptions('dry-run' => \$gDryRun,
247
'only-one=s' => \$gOnlyOne,
248
'verbosity=i' => \$gVerbosity,
249
'unify-with-sort=s' => \@gSortMatches,
250
'config=s' => \%gConfig); # "hidden" option not in usage()
252
if (scalar(@ARGV) != 3 || $gVerbosity < 0 || $gVerbosity > 3 ||
253
($gOnlyOne ne 'skip' && $gOnlyOne ne 'copy' && $gOnlyOne ne 'fail')) {
258
if (!makeUniversal($ARGV[0],$ARGV[1],$ARGV[2])) {
259
# makeUniversal or something it called will have printed an error.
265
# argumentEscape(@arguments)
267
# Takes a list of @arguments and makes them shell-safe.
268
sub argumentEscape(@) {
272
my ($argument, @argumentsOut);
273
foreach $argument (@arguments) {
274
$argument =~ s%([^A-Za-z0-9_\-/.=+,])%\\$1%g;
275
push(@argumentsOut, $argument);
278
return @argumentsOut;
281
# command(@arguments)
283
# Runs the specified command by calling system(@arguments). If $gDryRun
284
# is true, the command is printed but not executed, and 0 is returned.
285
# if $gVerbosity is greater than 1, the command is printed before being
286
# executed. When the command is executed, the system() return value will
287
# be returned. stdout and stderr are left connected for command output.
291
if ($gVerbosity >= 3 || $gDryRun) {
292
print(join(' ', argumentEscape(@arguments))."\n");
297
return system(@arguments);
300
# compareZipArchives($zip1, $zip2)
302
# Given two pathnames to zip archives, determines whether or not they are
303
# functionally identical. Returns true if they are, false if they differ in
304
# some substantial way, and undef if an error occurs. If the zip files
305
# differ, diagnostic messages are printed indicating how they differ.
307
# Zip files will differ if any of the members are different as defined by
308
# readZipCRCs, which consider CRCs, sizes, and file types as stored in the
309
# file header. Timestamps are not considered. Zip files also differ if one
310
# file contains members that the other one does not. $gOnlyOne has no
311
# effect on this behavior.
312
sub compareZipArchives($$) {
316
my ($CRCHash1, $CRCHash2);
317
if (!defined($CRCHash1 = readZipCRCs($zip1))) {
318
# readZipCRCs printed an error.
321
if (!defined($CRCHash2 = readZipCRCs($zip2))) {
322
# readZipCRCs printed an error.
326
my (@diffCRCs, @onlyInZip1);
331
foreach $memberName (keys(%$CRCHash1)) {
332
if (!exists($$CRCHash2{$memberName})) {
333
# The member is present in $zip1 but not $zip2.
334
push(@onlyInZip1, $memberName);
336
elsif ($$CRCHash1{$memberName} ne $$CRCHash2{$memberName}) {
337
# The member is present in both archives but its CRC or some other
338
# other critical attribute isn't identical.
339
push(@diffCRCs, $memberName);
341
delete($$CRCHash2{$memberName});
344
# If any members remain in %CRCHash2, it's because they're not present
347
@onlyInZip2 = keys(%$CRCHash2);
349
if (scalar(@onlyInZip1) + scalar(@onlyInZip2) + scalar(@diffCRCs)) {
350
complain(1, 'compareZipArchives: zip archives differ:',
353
if (scalar(@onlyInZip1)) {
354
complain(1, 'compareZipArchives: members only in former:',
357
if (scalar(@onlyInZip2)) {
358
complain(1, 'compareZipArchives: members only in latter:',
361
if (scalar(@diffCRCs)) {
362
complain(1, 'compareZipArchives: members differ:',
371
# complain($severity, $message, @list)
373
# Prints $message to stderr if $gVerbosity allows it for severity level
374
# $severity. @list is a list of words that will be shell-escaped and printed
375
# after $message, one per line, intended to be used, for example, to list
376
# arguments to a call that failed.
378
# Expected severity levels are 1 for hard errors and 2 for non-fatal warnings.
380
# Always returns false as a convenience, so callers can return complain's
381
# return value when it is used to signal errors.
383
my ($severity, $message, @list);
384
($severity, $message, @list) = @_;
386
if ($gVerbosity >= $severity) {
387
print STDERR ($0.': '.$message."\n");
390
while ($item = shift(@list)) {
391
print STDERR (' '.(argumentEscape($item))[0].
392
(scalar(@list)?',':'')."\n");
399
# copyIfIdentical($source1, $source2, $target)
401
# $source1 and $source2 are FileAttrCache objects that are compared, and if
402
# identical, copied to path string $target. The comparison is initially
403
# done as a byte-for-byte comparison, but if the files differ and appear to
404
# be zip archives, compareZipArchives is called to determine whether
405
# files that are not byte-for-byte identical are equivalent archives.
407
# Returns true on success, false for files that are not identical or
408
# equivalent archives, and undef if an error occurs.
410
# One of $source1 and $source2 is permitted to be undef. In this event,
411
# whichever source is defined is copied directly to $target without performing
412
# any comparisons. This enables the $gOnlyOne = 'copy' mode, which is
413
# driven by makeUniversalDirectory and makeUniversalInternal.
414
sub copyIfIdentical($$$) {
415
my ($source1, $source2, $target);
416
($source1, $source2, $target) = @_;
418
if (!defined($source1)) {
419
# If there's only one source file, make it the first file. Order
420
# isn't important here, and this makes it possible to use
421
# defined($source2) as the switch, and to always copy from $source1.
426
if (defined($source2)) {
427
# Only do the comparisons if there are two source files. If there's
428
# only one source file, skip the comparisons and go straight to the
430
if ($gVerbosity >= 3 || $gDryRun) {
432
join(' ',argumentEscape($source1->path(), $source2->path()))."\n");
435
if (!defined($comparison = compare($source1->path(), $source2->path())) ||
437
return complain(1, 'copyIfIdentical: compare: '.$!.' while comparing:',
441
elsif ($comparison != 0) {
443
if (defined($zip1 = $source1->isZip()) &&
444
defined($zip2 = $source2->isZip()) &&
447
if (!defined($zipComparison = compareZipArchives($source1->path(),
450
# An error occurred or the zip files aren't sufficiently identical.
451
# compareZipArchives will have printed an error message.
454
# The zip files were compared successfully, and they both contain
455
# all of the same members, and all of their members' CRCs are
456
# identical. For the purposes of this script, the zip files can be
457
# treated as identical, so reset $comparison.
461
if ($comparison != 0) {
462
return complain(1, 'copyIfIdentical: files differ:',
468
if ($gVerbosity >= 3 || $gDryRun) {
470
join(' ',argumentEscape($source1->path(), $target))."\n");
476
# Set the execute bits (as allowed by the umask) on the new file if any
477
# execute bit is set on either old file.
478
$isExecutable = $source1->lIsExecutable() ||
479
(defined($source2) && $source2->lIsExecutable());
481
if (!createUniqueFile($target, $isExecutable ? 0777 : 0666)) {
482
# createUniqueFile printed an error.
486
if (!copy($source1->path(), $target)) {
487
complain(1, 'copyIfIdentical: copy: '.$!.' while copying',
500
# Read the contents of $file into an array and return it.
501
# Returns undef on error.
504
open FILE, $file or return undef;
510
# compare_sorted($file1, $file2)
512
# Read the contents of both files into arrays, sort the arrays,
513
# and then compare the two arrays for equality.
515
# Returns 0 if the sorted array contents are equal, or 1 if not.
516
# Returns undef on error.
517
sub compare_sorted($$) {
518
my ($file1, $file2) = @_;
519
my @lines1 = sort(slurp($file1));
520
my @lines2 = sort(slurp($file2));
522
return undef if !@lines1 || !@lines2;
523
return 1 unless scalar @lines1 == scalar @lines2;
525
for (my $i = 0; $i < scalar @lines1; $i++) {
526
return 1 if $lines1[$i] ne $lines2[$i];
531
# copy_sorted($source, $destination)
533
# $source and $destination are filenames. Read the contents of $source
534
# into an array, sort it, and then write the sorted contents to $destination.
535
# Returns 1 on success, and undef on failure.
536
sub copy_sorted($$) {
537
my ($src, $dest) = @_;
538
my @lines = sort(slurp($src));
539
return undef unless @lines;
540
open FILE, "> $dest" or return undef;
546
# copyIfIdenticalWhenSorted($source1, $source2, $target)
548
# $source1 and $source2 are FileAttrCache objects that are compared, and if
549
# identical, copied to path string $target. The comparison is done by
550
# sorting the individual lines within the two files and comparing the results.
552
# Returns true on success, false for files that are not equivalent,
553
# and undef if an error occurs.
554
sub copyIfIdenticalWhenSorted($$$) {
555
my ($source1, $source2, $target);
556
($source1, $source2, $target) = @_;
558
if ($gVerbosity >= 3 || $gDryRun) {
560
join(' ',argumentEscape($source1->path(), $source2->path()))."\n");
563
if (!defined($comparison = compare_sorted($source1->path(),
564
$source2->path())) ||
566
return complain(1, 'copyIfIdenticalWhenSorted: compare: '.$!
567
.' while comparing:',
571
if ($comparison != 0) {
572
return complain(1, 'copyIfIdenticalWhenSorted: files differ:',
577
if ($gVerbosity >= 3 || $gDryRun) {
579
join(' ',argumentEscape($source1->path(), $target))."\n");
585
# Set the execute bits (as allowed by the umask) on the new file if any
586
# execute bit is set on either old file.
587
$isExecutable = $source1->lIsExecutable() ||
588
(defined($source2) && $source2->lIsExecutable());
590
if (!createUniqueFile($target, $isExecutable ? 0777 : 0666)) {
591
# createUniqueFile printed an error.
595
if (!copy_sorted($source1->path(), $target)) {
596
complain(1, 'copyIfIdenticalWhenSorted: copy_sorted: '.$!
608
# createUniqueFile($path, $mode)
610
# Creates a new plain empty file at pathname $path, provided it does not
611
# yet exist. $mode is used as the file mode. The actual file's mode will
612
# be modified by the effective umask. Returns false if the file could
613
# not be created, setting $! to the error. An error message is printed
614
# in the event of failure.
615
sub createUniqueFile($$) {
620
if (!sysopen($fh, $path, O_WRONLY | O_CREAT | O_EXCL, $mode)) {
621
return complain(1, 'createUniqueFile: open: '.$!.' for:',
629
# makeUniversal($pathPPC, $pathX86, $pathTarget)
631
# The top-level call. $pathPPC, $pathX86, and $pathTarget are strings
632
# identifying the ppc and x86 files or directories to merge and the location
633
# to merge them to. Returns false on failure and true on success.
634
sub makeUniversal($$$) {
635
my ($pathTarget, $pathPPC, $pathX86);
636
($pathPPC, $pathX86, $pathTarget) = @_;
638
my ($filePPC, $fileX86);
639
$filePPC = FileAttrCache->new($pathPPC);
640
$fileX86 = FileAttrCache->new($pathX86);
642
return makeUniversalInternal(1, $filePPC, $fileX86, $pathTarget);
645
# makeUniversalDirectory($dirPPC, $dirX86, $dirTarget)
647
# This is part of the heart of recursion. $dirPPC and $dirX86 are
648
# FileAttrCache objects designating the source ppc and x86 directories to
649
# merge into a universal directory at $dirTarget, a string. For each file
650
# in $dirPPC and $dirX86, makeUniversalInternal is called.
651
# makeUniversalInternal will call back into makeUniversalDirectory for
652
# directories, thus completing the recursion. If a failure is encountered
653
# in ths function or in makeUniversalInternal or anything that it calls,
654
# false is returned, otherwise, true is returned.
656
# If there are files present in one source directory but not both, the
657
# value of $gOnlyOne controls the behavior. If $gOnlyOne is 'copy', the
658
# single source file is copied into $pathTarget. If it is 'skip', it is
659
# skipped. If it is 'fail', such files will trigger makeUniversalDirectory
662
# If either source directory is undef, it is treated as having no files.
663
# This facilitates deep recursion when entire directories are only present
664
# in one source when $gOnlyOne = 'copy'.
665
sub makeUniversalDirectory($$$) {
666
my ($dirPPC, $dirX86, $dirTarget);
667
($dirPPC, $dirX86, $dirTarget) = @_;
669
my ($dh, @filesPPC, @filesX86);
672
if (defined($dirPPC)) {
673
if (!opendir($dh, $dirPPC->path())) {
674
return complain(1, 'makeUniversalDirectory: opendir ppc: '.$!.' for:',
677
@filesPPC = readdir($dh);
682
if (defined($dirX86)) {
683
if (!opendir($dh, $dirX86->path())) {
684
return complain(1, 'makeUniversalDirectory: opendir x86: '.$!.' for:',
687
@filesX86 = readdir($dh);
691
my (%common, $file, %onlyPPC, %onlyX86);
694
foreach $file (@filesPPC) {
695
if ($file eq '.' || $file eq '..') {
703
foreach $file (@filesX86) {
704
if ($file eq '.' || $file eq '..') {
707
if ($onlyPPC{$file}) {
708
delete $onlyPPC{$file};
716
# First, handle files common to both.
717
foreach $file (sort(keys(%common))) {
718
if (!makeUniversalInternal(0,
719
FileAttrCache->new($dirPPC->path().'/'.$file),
720
FileAttrCache->new($dirX86->path().'/'.$file),
721
$dirTarget.'/'.$file)) {
722
# makeUniversalInternal will have printed an error.
727
# Handle files found only in a single directory here. There are three
728
# options, dictated by $gOnlyOne: fail if files are only present in
729
# one directory, skip any files only present in one directory, or copy
730
# these files straight over to the target directory. In any event,
731
# a message will be printed indicating that the file trees don't match
733
if (keys(%onlyPPC)) {
734
complain(($gOnlyOne eq 'fail' ? 1 : 2),
735
($gOnlyOne ne 'fail' ? 'warning: ' : '').
736
'makeUniversalDirectory: only in ppc '.
737
(argumentEscape($dirPPC->path()))[0].':',
738
argumentEscape(keys(%onlyPPC)));
741
if (keys(%onlyX86)) {
742
complain(($gOnlyOne eq 'fail' ? 1 : 2),
743
($gOnlyOne ne 'fail' ? 'warning: ' : '').
744
'makeUniversalDirectory: only in x86 '.
745
(argumentEscape($dirX86->path()))[0].':',
746
argumentEscape(keys(%onlyX86)));
749
if ($gOnlyOne eq 'fail' && (keys(%onlyPPC) || keys(%onlyX86))) {
750
# Error message(s) printed above.
754
if ($gOnlyOne eq 'copy') {
755
foreach $file (sort(keys(%onlyPPC))) {
756
if (!makeUniversalInternal(0,
757
FileAttrCache->new($dirPPC->path().'/'.$file),
759
$dirTarget.'/'.$file)) {
760
# makeUniversalInternal will have printed an error.
765
foreach $file (sort(keys(%onlyX86))) {
766
if (!makeUniversalInternal(0,
768
FileAttrCache->new($dirX86->path().'/'.$file),
769
$dirTarget.'/'.$file)) {
770
# makeUniversalInternal will have printed an error.
779
# makeUniversalFile($sourcePPC, $sourceX86, $targetPath)
781
# Creates a universal file at pathname $targetPath based on a ppc image at
782
# $sourcePPC and an x86 image at $sourceX86. $sourcePPC and $sourceX86 are
783
# both FileAttrCache objects. Returns true on success and false on failure.
784
# On failure, diagnostics will be printed to stderr.
786
# The source files may be either thin Mach-O images of the appropriate
787
# architecture, or fat Mach-O files that contain images of the appropriate
790
# This function wraps the lipo utility, see lipo(1).
791
sub makeUniversalFile($$$) {
792
my ($sourcePPC, $sourceX86, $targetPath, @tempThinFiles, $thinPPC, $thinX86);
793
($sourcePPC, $sourceX86, $targetPath) = @_;
794
$thinPPC = $sourcePPC;
795
$thinX86 = $sourceX86;
799
# The source files might already be fat. They should be thinned out to only
800
# contain a single architecture.
802
my ($isFatPPC, $isFatX86);
804
if(!defined($isFatPPC = $sourcePPC->isFat())) {
805
# isFat printed its own error
809
$thinPPC = FileAttrCache->new($targetPath.'.ppc');
810
push(@tempThinFiles, $thinPPC->path());
811
if (command($gConfig{'cmd_lipo'}, '-thin', 'ppc',
812
$sourcePPC->path(), '-output', $thinPPC->path()) != 0) {
813
unlink(@tempThinFiles);
814
return complain(1, 'lipo thin ppc failed for:',
820
if(!defined($isFatX86 = $sourceX86->isFat())) {
821
# isFat printed its own error
822
unlink(@tempThinFiles);
826
$thinX86 = FileAttrCache->new($targetPath.'.x86');
827
push(@tempThinFiles, $thinX86->path());
828
if (command($gConfig{'cmd_lipo'}, '-thin', 'i386',
829
$sourceX86->path(), '-output', $thinX86->path()) != 0) {
830
unlink(@tempThinFiles);
831
return complain(1, 'lipo thin x86 failed for:',
837
# The image for each architecture in the fat file will be aligned on
838
# a specific boundary, default 4096 bytes, see lipo(1) -segalign.
839
# Since there's no tail-padding, the fat file will consume the least
840
# space on disk if the image that comes last exceeds the segment size
841
# by the smallest amount.
843
# This saves an average of 1kB per fat file over the naive approach of
844
# always putting one architecture first: average savings is 2kB per
845
# file, but the naive approach would have gotten it right half of the
848
my ($sizePPC, $sizeX86, $thinPPCForStat, $thinX86ForStat);
851
$thinPPCForStat = $thinPPC;
852
$thinX86ForStat = $thinX86;
855
# Normally, fat source files will have been converted into temporary
856
# thin files. During a dry run, that doesn't happen, so fake it up
857
# a little bit by always using the source file, fat or thin, for the
859
$thinPPCForStat = $sourcePPC;
860
$thinX86ForStat = $sourceX86;
863
if (!defined($sizePPC = $thinPPCForStat->statSize())) {
864
unlink(@tempThinFiles);
865
return complain(1, 'stat ppc: '.$!.' for:',
866
$thinPPCForStat->path());
868
if (!defined($sizeX86 = $thinX86ForStat->statSize())) {
869
unlink(@tempThinFiles);
870
return complain(1, 'stat x86: '.$!.' for:',
871
$thinX86ForStat->path());
874
$sizePPC = $sizePPC % 4096;
875
$sizeX86 = $sizeX86 % 4096;
880
# PPC image ends on an alignment boundary, there will be no padding before
881
# starting the x86 image.
882
@thinFiles = ($thinPPC->path(), $thinX86->path());
884
elsif ($sizeX86 == 0 || $sizeX86 > $sizePPC) {
885
# x86 image ends on an alignment boundary, there will be no padding before
886
# starting the PPC image, or the x86 image exceeds its alignment boundary
887
# by more than the PPC image, so there will be less padding if the x86
889
@thinFiles = ($thinX86->path(), $thinPPC->path());
892
# PPC image exceeds its alignment boundary by more than the x86 image, so
893
# there will be less padding if the PPC comes first.
894
@thinFiles = ($thinPPC->path(), $thinX86->path());
898
$isExecutable = $sourcePPC->lIsExecutable() ||
899
$sourceX86->lIsExecutable();
902
# Ensure that the file does not yet exist.
904
# Set the execute bits (as allowed by the umask) on the new file if any
905
# execute bit is set on either old file. Yes, it is possible to have
906
# proper Mach-O files without x-bits: think object files (.o) and static
908
if (!createUniqueFile($targetPath, $isExecutable ? 0777 : 0666)) {
909
# createUniqueFile printed an error.
910
unlink(@tempThinFiles);
915
# Create the fat file.
916
if (command($gConfig{'cmd_lipo'}, '-create', @thinFiles,
917
'-output', $targetPath) != 0) {
918
unlink(@tempThinFiles, $targetPath);
919
return complain(1, 'lipo create fat failed for:',
924
unlink(@tempThinFiles);
927
# lipo seems to think that it's free to set its own file modes that
928
# ignore the umask, which is bogus when the rest of this script
929
# respects the umask.
930
if (!chmod(($isExecutable ? 0777 : 0666) & ~umask(), $targetPath)) {
931
complain(1, 'makeUniversalFile: chmod: '.$!.' for',
941
# makeUniversalInternal($isToplevel, $filePPC, $fileX86, $fileTargetPath)
943
# Given FileAttrCache objects $filePPC and $fileX86, compares filetypes
944
# and performs the appropriate action to produce a universal file at
945
# path string $fileTargetPath. $isToplevel should be true if this is
946
# the recursive base and false otherwise; this controls cleanup behavior
947
# (cleanup is only performed at the base, because cleanup itself is
950
# This handles regular files by determining whether they are Mach-O files
951
# and calling makeUniversalFile if so and copyIfIdentical otherwise. Symbolic
952
# links are handled directly in this function by ensuring that the source link
953
# targets are identical and creating a new link with the same target
954
# at $fileTargetPath. Directories are handled by calling
955
# makeUniversalDirectory.
957
# One of $filePPC and $fileX86 is permitted to be undef. In that case,
958
# the defined source file is copied directly to the target if a regular
959
# file, and symlinked appropriately if a symbolic link. This facilitates
960
# use of $gOnlyOne = 'copy', although no $gOnlyOne checks are made in this
961
# function, they are all handled in makeUniversalDirectory.
963
# Returns true on success. Returns false on failure, including failures
964
# in other functions called.
965
sub makeUniversalInternal($$$$) {
966
my ($filePPC, $fileTargetPath, $fileX86, $isToplevel);
967
($isToplevel, $filePPC, $fileX86, $fileTargetPath) = @_;
969
my ($typePPC, $typeX86);
970
if (defined($filePPC) && !defined($typePPC = $filePPC->lstatType())) {
971
return complain(1, 'makeUniversal: lstat ppc: '.$!.' for:',
974
if (defined($fileX86) && !defined($typeX86 = $fileX86->lstatType())) {
975
return complain(1, 'makeUniversal: lstat x86: '.$!.' for:',
979
if (defined($filePPC) && defined($fileX86) && $typePPC != $typeX86) {
980
return complain(1, 'makeUniversal: incompatible types:',
985
# $aSourceFile will contain a FileAttrCache object that will return
986
# the correct type data. It's used because it's possible for one of
987
# the two source files to be undefined (indicating a straight copy).
989
if (defined($filePPC)) {
990
$aSourceFile = $filePPC;
993
$aSourceFile = $fileX86;
996
if ($aSourceFile->lIsDir()) {
997
if ($gVerbosity >= 3 || $gDryRun) {
998
print('mkdir '.(argumentEscape($fileTargetPath))[0]."\n");
1000
if (!$gDryRun && !mkdir($fileTargetPath)) {
1001
return complain(1, 'makeUniversal: mkdir: '.$!.' for:',
1007
if (!($rv = makeUniversalDirectory($filePPC, $fileX86, $fileTargetPath))) {
1008
# makeUniversalDirectory printed an error.
1010
command($gConfig{'cmd_rm'},'-rf','--',$fileTargetPath);
1014
# Touch the directory when leaving it. If unify is being run on an
1015
# .app bundle, the .app might show up without an icon because the
1016
# system might have found the .app before it was completely built.
1017
# Touching it dirties it in LaunchServices' mind.
1018
if ($gVerbosity >= 3) {
1019
print('touch '.(argumentEscape($fileTargetPath))[0]."\n");
1021
utime(undef, undef, $fileTargetPath);
1026
elsif ($aSourceFile->lIsSymLink()) {
1027
my ($linkPPC, $linkX86);
1028
if (defined($filePPC) && !defined($linkPPC=readlink($filePPC->path()))) {
1029
return complain(1, 'makeUniversal: readlink ppc: '.$!.' for:',
1032
if (defined($fileX86) && !defined($linkX86=readlink($fileX86->path()))) {
1033
return complain(1, 'makeUniversal: readlink x86: '.$!.' for:',
1036
if (defined($filePPC) && defined($fileX86) && $linkPPC ne $linkX86) {
1037
return complain(1, 'makeUniversal: symbolic links differ:',
1042
# $aLink here serves the same purpose as $aSourceFile in the enclosing
1043
# block: it refers to the target of the symbolic link, whether there
1044
# is one valid source or two.
1046
if (defined($linkPPC)) {
1053
if ($gVerbosity >= 3 || $gDryRun) {
1055
join(' ',argumentEscape($aLink, $fileTargetPath))."\n");
1057
if (!$gDryRun && !symlink($aLink, $fileTargetPath)) {
1058
return complain(1, 'makeUniversal: symlink: '.$!.' for:',
1065
elsif($aSourceFile->lIsRegularFile()) {
1066
my ($machPPC, $machX86);
1067
if (!defined($filePPC) || !defined($fileX86)) {
1068
# One of the source files isn't present. The right thing to do is
1069
# to just copy what does exist straight over, so skip Mach-O checks.
1074
if (!defined($machPPC=$filePPC->isMachO())) {
1075
return complain(1, 'makeUniversal: isFileMachO ppc failed for:',
1078
if (!defined($machX86=$fileX86->isMachO())) {
1079
return complain(1, 'makeUniversal: isFileMachO x86 failed for:',
1084
if ($machPPC != $machX86) {
1085
return complain(1, 'makeUniversal: variant Mach-O attributes:',
1091
# makeUniversalFile will print an error if it fails.
1092
return makeUniversalFile($filePPC, $fileX86, $fileTargetPath);
1095
if (grep { $filePPC->path() =~ m/$_/; } @gSortMatches) {
1096
# Regular files, but should be compared with sorting first.
1097
# copyIfIdenticalWhenSorted will print an error if it fails.
1098
return copyIfIdenticalWhenSorted($filePPC, $fileX86, $fileTargetPath);
1101
# Regular file. copyIfIdentical will print an error if it fails.
1102
return copyIfIdentical($filePPC, $fileX86, $fileTargetPath);
1105
# Special file, don't know how to handle.
1106
return complain(1, 'makeUniversal: cannot handle special file:',
1113
# Give the user a hand.
1116
"usage: unify <ppc-path> <x86-path> <universal-path>\n".
1117
" [--dry-run] (print what would be done)\n".
1118
" [--only-one <action>] (skip, copy, fail; default=copy)\n".
1119
" [--verbosity <level>] (0, 1, 2, 3; default=2)\n");
1123
# readZipCRCs($zipFile)
1125
# $zipFile is the pathname to a zip file whose directory will be read.
1126
# A reference to a hash is returned, with the member pathnames from the
1127
# zip file as keys, and reasonably unique identifiers as values. The
1128
# format of the values is not specified exactly, but does include the
1129
# member CRCs and sizes and differentiates between files and directories.
1130
# It specifically does not distinguish between modification times. On
1131
# failure, prints a message and returns undef.
1132
sub readZipCRCs($) {
1137
$zip = Archive::Zip->new();
1139
if (($ze = $zip->read($zipFile)) != AZ_OK) {
1140
complain(1, 'readZipCRCs: read error '.$ze.' for:',
1145
my ($member, %memberCRCs, @memberList);
1147
@memberList = $zip->members();
1149
foreach $member (@memberList) {
1150
# Take a few of the attributes that identify the file and stuff them into
1151
# the members hash. Directories will show up with size 0 and crc32 0,
1152
# so isDirectory() is used to distinguish them from empty files.
1153
$memberCRCs{$member->fileName()} = join(',', $member->isDirectory() ? 1 : 0,
1154
$member->uncompressedSize(),
1155
$member->crc32String());
1158
return {%memberCRCs};
1162
# FileAttrCache allows various attributes about a file to be cached
1163
# so that if they are needed again after first use, no system calls
1164
# will be made and the program won't need to hit the disk.
1166
package FileAttrCache;
1168
use Fcntl(':DEFAULT', ':mode');
1170
# FileAttrCache->new($path)
1172
# Creates a new FileAttrCache object for the file at path $path and
1173
# returns it. The cache is not primed at creation time, values are
1174
# fetched lazily as they are needed.
1176
my ($class, $path, $proto, $this);
1177
($proto, $path) = @_;
1178
if (!($class = ref($proto))) {
1189
'magicErrMsg' => undef,
1195
bless($this, $class);
1199
# $FileAttrCache->isFat()
1201
# Returns true if the file is a fat Mach-O file, false if it's not, and
1202
# undef if an error occurs. See /usr/include/mach-o/fat.h.
1204
my ($magic, $magic2, $this);
1207
# magic() caches, there's no separate cache because isFat() doesn't hit
1208
# the disk other than by calling magic().
1210
if (!defined($magic = $this->magic())) {
1213
$magic2 = $this->magic2();
1215
# We have to sanity check the second four bytes, because Java class
1216
# files use the same magic number as Mach-O fat binaries.
1217
# This logic is adapted from file(1), which says that Mach-O uses
1218
# these bytes to count the number of architectures within, while
1219
# Java uses it for a version number. Conveniently, there are only
1220
# 18 labelled Mach-O architectures, and Java's first released
1221
# class format used the version 43.0.
1222
if ($magic == 0xcafebabe && $magic2 < 20) {
1229
# $FileAttrCache->isMachO()
1231
# Returns true if the file is a Mach-O image (including a fat file), false
1232
# if it's not, and undef if an error occurs. See
1233
# /usr/include/mach-o/loader.h and /usr/include/mach-o/fat.h.
1238
# magic() caches, there's no separate cache because isMachO() doesn't hit
1239
# the disk other than by calling magic().
1241
if (!defined($magic = $this->magic())) {
1245
# Accept Mach-O fat files or Mach-O thin files of either endianness.
1246
if ($magic == 0xfeedface ||
1247
$magic == 0xcefaedfe ||
1255
# $FileAttrCache->isZip()
1257
# Returns true if the file is a zip file, false if it's not, and undef if
1258
# an error occurs. See http://www.pkware.com/business_and_developers/developer/popups/appnote.txt .
1263
# magic() caches, there's no separate cache because isFat() doesn't hit
1264
# the disk other than by calling magic().
1266
if (!defined($magic = $this->magic())) {
1270
if ($magic == 0x504b0304) {
1277
# $FileAttrCache->lIsExecutable()
1279
# Wraps $FileAttrCache->lstat(), returning true if the file is has any,
1280
# execute bit set, false if none are set, or undef if an error occurs.
1281
# On error, $! is set to lstat's errno.
1282
sub lIsExecutable($) {
1286
if (!defined($mode = $this->lstatMode())) {
1290
return $mode & (S_IXUSR | S_IXGRP | S_IXOTH);
1293
# $FileAttrCache->lIsDir()
1295
# Wraps $FileAttrCache->lstat(), returning true if the file is a directory,
1296
# false if it isn't, or undef if an error occurs. Because lstat is used,
1297
# this will return false even if the file is a symlink pointing to a
1298
# directory. On error, $! is set to lstat's errno.
1303
if (!defined($type = $this->lstatType())) {
1307
return S_ISDIR($type);
1310
# $FileAttrCache->lIsRegularFile()
1312
# Wraps $FileAttrCache->lstat(), returning true if the file is a regular,
1313
# file, false if it isn't, or undef if an error occurs. Because lstat is
1314
# used, this will return false even if the file is a symlink pointing to a
1315
# regular file. On error, $! is set to lstat's errno.
1316
sub lIsRegularFile($) {
1320
if (!defined($type = $this->lstatType())) {
1324
return S_ISREG($type);
1327
# $FileAttrCache->lIsSymLink()
1329
# Wraps $FileAttrCache->lstat(), returning true if the file is a symbolic,
1330
# link, false if it isn't, or undef if an error occurs. On error, $! is
1331
# set to lstat's errno.
1336
if (!defined($type = $this->lstatType())) {
1340
return S_ISLNK($type);
1343
# $FileAttrCache->lstat()
1345
# Wraps the lstat system call, providing a cache to speed up multiple
1346
# lstat calls for the same file. See lstat(2) and lstat in perlfunc(1).
1351
# Use the cached lstat result.
1352
if ($$this{'lstatInit'}) {
1353
if (defined($$this{'lstatErrno'})) {
1354
$! = $$this{'lstatErrno'};
1356
return @{$$this{'lstat'}};
1358
$$this{'lstatInit'} = 1;
1360
if (!(@stat = CORE::lstat($$this{'path'}))) {
1361
$$this{'lstatErrno'} = $!;
1364
$$this{'lstat'} = [@stat];
1368
# $FileAttrCache->lstatMode()
1370
# Wraps $FileAttrCache->lstat(), returning the mode bits from the st_mode
1371
# field, or undef if an error occurs. On error, $! is set to lstat's
1377
if (!(@stat = $this->lstat())) {
1381
return S_IMODE($stat[2]);
1384
# $FileAttrCache->lstatType()
1386
# Wraps $FileAttrCache->lstat(), returning the type bits from the st_mode
1387
# field, or undef if an error occurs. On error, $! is set to lstat's
1393
if (!(@stat = $this->lstat())) {
1397
return S_IFMT($stat[2]);
1400
# $FileAttrCache->magic()
1402
# Returns the "magic number" for the file by reading its first four bytes
1403
# as a big-endian unsigned 32-bit integer and returning the result. If an
1404
# error occurs, returns undef and prints diagnostic messages to stderr. If
1405
# the file is shorter than 32 bits, returns -1. A cache is provided to
1406
# speed multiple magic calls for the same file.
1411
# Use the cached magic result.
1412
if ($$this{'magicInit'}) {
1413
if (defined($$this{'magicErrno'})) {
1414
if (defined($$this{'magicErrMsg'})) {
1415
complain(1, 'FileAttrCache::magic: '.$$this{'magicErrMsg'}.' for:',
1418
$! = $$this{'magicErrno'};
1420
return $$this{'magic'};
1423
$$this{'magicInit'} = 1;
1426
if (!sysopen($fh, $$this{'path'}, O_RDONLY)) {
1427
$$this{'magicErrno'} = $!;
1428
$$this{'magicErrMsg'} = 'open "'.$$this{'path'}.'": '.$!;
1429
complain(1, 'FileAttrCache::magic: '.$$this{'magicErrMsg'}.' for:',
1435
my ($bytes, $magic, $bytes2, $magic2);
1436
if (!defined($bytes = sysread($fh, $magic, 4))) {
1437
$$this{'magicErrno'} = $!;
1438
$$this{'magicErrMsg'} = 'read "'.$$this{'path'}.'": '.$!;
1439
complain(1, 'FileAttrCache::magic: '.$$this{'magicErrMsg'}.' for:',
1445
$bytes2 = sysread($fh, $magic2, 4);
1451
# The file is too short, didn't read a magic number. This isn't really
1452
# an error. Return an unlikely value.
1453
$$this{'magic'} = -1;
1454
$$this{'magic2'} = -1;
1458
# File is too short to read a second 4 bytes.
1462
$$this{'magic'} = unpack('N', $magic);
1463
$$this{'magic2'} = unpack('N', $magic2);
1464
return $$this{'magic'};
1467
# $FileAttrCache->magic2()
1469
# Returns the second four bytes of the file as a 32-bit little endian number.
1470
# See magic(), above for more info.
1475
# we do the actual work (and cache it) in magic().
1476
if (!$$this{'magicInit'}) {
1477
my $magic = $$this->magic();
1480
return $$this{'magic2'};
1483
# $FileAttrCache->path()
1485
# Returns the file's pathname.
1489
return $$this{'path'};
1492
# $FileAttrCache->stat()
1494
# Wraps the stat system call, providing a cache to speed up multiple
1495
# stat calls for the same file. If lstat() has already been called and
1496
# the file is not a symbolic link, the cached lstat() result will be used.
1497
# See stat(2) and lstat in perlfunc(1).
1502
# Use the cached stat result.
1503
if ($$this{'statInit'}) {
1504
if (defined($$this{'statErrno'})) {
1505
$! = $$this{'statErrno'};
1507
return @{$$this{'stat'}};
1510
$$this{'statInit'} = 1;
1512
# If lstat has already been called, and the file isn't a symbolic link,
1513
# use the cached lstat result.
1514
if ($$this{'lstatInit'} && !$$this{'lstatErrno'} &&
1515
!S_ISLNK(${$$this{'lstat'}}[2])) {
1516
$$this{'stat'} = $$this{'lstat'};
1517
return @{$$this{'stat'}};
1520
if (!(@stat = CORE::stat($$this{'path'}))) {
1521
$$this{'statErrno'} = $!;
1524
$$this{'stat'} = [@stat];
1528
# $FileAttrCache->statSize()
1530
# Wraps $FileAttrCache->stat(), returning the st_size field, or undef
1531
# undef if an error occurs. On error, $! is set to stat's errno.
1536
if (!(@stat = $this->lstat())) {
added
removed
build/macosx/universal/unify
