build/macosx/universal/unify

Wed, 31 Dec 2014 07:16:47 +0100

author
Michael Schloh von Bennewitz <michael@schloh.com>
date
Wed, 31 Dec 2014 07:16:47 +0100
branch
TOR_BUG_9701
changeset 3
141e0f1194b1
permissions
-rwxr-xr-x

Revert simplistic fix pending revisit of Mozilla integration attempt.

michael@0 1 #!/usr/bin/perl
michael@0 2 # This Source Code Form is subject to the terms of the Mozilla Public
michael@0 3 # License, v. 2.0. If a copy of the MPL was not distributed with this
michael@0 4 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
michael@0 5
michael@0 6 use strict;
michael@0 7 use warnings;
michael@0 8
michael@0 9 =pod
michael@0 10
michael@0 11 =head1 NAME
michael@0 12
michael@0 13 B<unify> - Mac OS X universal binary packager
michael@0 14
michael@0 15 =head1 SYNOPSIS
michael@0 16
michael@0 17 B<unify>
michael@0 18 I<ppc-path>
michael@0 19 I<x86-path>
michael@0 20 I<universal-path>
michael@0 21 [B<--dry-run>]
michael@0 22 [B<--only-one> I<action>]
michael@0 23 [B<--verbosity> I<level>]
michael@0 24 [B<--unify-with-sort> I<regex>]
michael@0 25
michael@0 26 =head1 DESCRIPTION
michael@0 27
michael@0 28 I<unify> merges any two architecture-specific files or directory trees
michael@0 29 into a single file or tree suitable for use on either architecture as a
michael@0 30 "fat" or "universal binary."
michael@0 31
michael@0 32 Architecture-specific Mach-O files will be merged into fat Mach-O files
michael@0 33 using L<lipo(1)>. Non-Mach-O files in the architecture-specific trees
michael@0 34 are compared to ensure that they are equivalent before copying. Symbolic
michael@0 35 links are permitted in the architecture-specific trees and will cause
michael@0 36 identical links to be created in the merged tree, provided that the source
michael@0 37 links have identical targets. Directories are processed recursively.
michael@0 38
michael@0 39 If the architecture-specific source trees contain zip archives (including
michael@0 40 jar files) that are not identical according to a byte-for-byte check, they
michael@0 41 are still assumed to be equivalent if both archives contain exactly the
michael@0 42 same members with identical checksums and sizes.
michael@0 43
michael@0 44 Behavior when one architecture-specific tree contains files that the other
michael@0 45 does not is controlled by the B<--only-one> option.
michael@0 46
michael@0 47 If Mach-O files cannot be merged using L<lipo(1)>, zip archives are not
michael@0 48 equivalent, regular files are not identical, or any other error occurs,
michael@0 49 B<unify> will fail with an exit status of 1. Diagnostic messages are
michael@0 50 typically printed to stderr; this behavior can be controlled with the
michael@0 51 B<--verbosity> option.
michael@0 52
michael@0 53 =head1 OPTIONS
michael@0 54
michael@0 55 =over 5
michael@0 56
michael@0 57 =item I<ppc-path>
michael@0 58
michael@0 59 =item I<x86-path>
michael@0 60
michael@0 61 The paths to directory trees containing PowerPC and x86 builds,
michael@0 62 respectively. I<ppc-path> and I<x86-path> are permitted to contain files
michael@0 63 that are already "fat," and only the appropriate architecture's images will
michael@0 64 be used.
michael@0 65
michael@0 66 I<ppc-path> and I<x86-path> are also permitted to both be files, in which
michael@0 67 case B<unify> operates solely on those files, and produces an appropriate
michael@0 68 merged file at I<target-path>.
michael@0 69
michael@0 70 =item I<target-path>
michael@0 71
michael@0 72 The path to the merged file or directory tree. This path will be created,
michael@0 73 and it must not exist prior to running B<unify>.
michael@0 74
michael@0 75 =item B<--dry-run>
michael@0 76
michael@0 77 When specified, the commands that would be executed are printed, without
michael@0 78 actually executing them. Note that B<--dry-run> and the equivalent
michael@0 79 B<--verbosity> level during "wet" runs may print equivalent commands when
michael@0 80 no commands are in fact executed: certain operations are handled internally
michael@0 81 within B<unify>, and an approximation of a command that performs a similar
michael@0 82 task is printed.
michael@0 83
michael@0 84 =item B<--only-one> I<action>
michael@0 85
michael@0 86 Controls handling of files that are only present in one of the two source
michael@0 87 trees. I<action> may be:
michael@0 88 skip - These files are skipped.
michael@0 89 copy - These files are copied from the tree in which they exist.
michael@0 90 fail - When this condition occurs, it is treated as an error.
michael@0 91
michael@0 92 The default I<action> is copy.
michael@0 93
michael@0 94 =item B<--verbosity> I<level>
michael@0 95
michael@0 96 Adjusts the level of loudness of B<unify>. The possible values for
michael@0 97 I<level> are:
michael@0 98 0 - B<unify> never prints anything.
michael@0 99 (Other programs that B<unify> calls may still print messages.)
michael@0 100 1 - Fatal error messages are printed to stderr.
michael@0 101 2 - Nonfatal warnings are printed to stderr.
michael@0 102 3 - Commands are printed to stdout as they are executed.
michael@0 103
michael@0 104 The default I<level> is 2.
michael@0 105
michael@0 106 =item B<--unify-with-sort> I<regex>
michael@0 107
michael@0 108 Allows merging files matching I<regex> that differ only by the ordering
michael@0 109 of the lines contained within them. The unified file will have its contents
michael@0 110 sorted. This option may be given multiple times to specify multiple
michael@0 111 regexes for matching files.
michael@0 112
michael@0 113 =back
michael@0 114
michael@0 115 =head1 EXAMPLES
michael@0 116
michael@0 117 =over 5
michael@0 118
michael@0 119 =item Create a universal .app bundle from two architecture-specific .app
michael@0 120 bundles:
michael@0 121
michael@0 122 unify --only-one copy ppc/dist/firefox/Firefox.app
michael@0 123 x86/dist/firefox/Firefox.app universal/Firefox.app
michael@0 124 --verbosity 3
michael@0 125
michael@0 126 =item Merge two identical architecture-specific trees:
michael@0 127
michael@0 128 unify --only-one fail /usr/local /nfs/x86/usr/local
michael@0 129 /tmp/usrlocal.fat
michael@0 130
michael@0 131 =back
michael@0 132
michael@0 133 =head1 REQUIREMENTS
michael@0 134
michael@0 135 The only esoteric requirement of B<unify> is that the L<lipo(1)> command
michael@0 136 be available. It is present on Mac OS X systems at least as early as
michael@0 137 10.3.9, and probably earlier. Mac OS X 10.4 ("Tiger") or later are
michael@0 138 recommended.
michael@0 139
michael@0 140 =head1 LICENSE
michael@0 141
michael@0 142 MPL 2.
michael@0 143
michael@0 144 =head1 AUTHOR
michael@0 145
michael@0 146 The software was initially written by Mark Mentovai; copyright 2006
michael@0 147 Google Inc.
michael@0 148
michael@0 149 =head1 SEE ALSO
michael@0 150
michael@0 151 L<cmp(1)>, L<ditto(1)>, L<lipo(1)>
michael@0 152
michael@0 153 =cut
michael@0 154
michael@0 155 use Archive::Zip(':ERROR_CODES');
michael@0 156 use Errno;
michael@0 157 use Fcntl;
michael@0 158 use File::Compare;
michael@0 159 use File::Copy;
michael@0 160 use Getopt::Long;
michael@0 161
michael@0 162 my (%gConfig, $gDryRun, $gOnlyOne, $gVerbosity, @gSortMatches);
michael@0 163
michael@0 164 sub argumentEscape(@);
michael@0 165 sub command(@);
michael@0 166 sub compareZipArchives($$);
michael@0 167 sub complain($$@);
michael@0 168 sub copyIfIdentical($$$);
michael@0 169 sub slurp($);
michael@0 170 sub get_sorted($);
michael@0 171 sub compare_sorted($$);
michael@0 172 sub copyIfIdenticalWhenSorted($$$);
michael@0 173 sub createUniqueFile($$);
michael@0 174 sub makeUniversal($$$);
michael@0 175 sub makeUniversalDirectory($$$);
michael@0 176 sub makeUniversalInternal($$$$);
michael@0 177 sub makeUniversalFile($$$);
michael@0 178 sub usage();
michael@0 179 sub readZipCRCs($);
michael@0 180
michael@0 181 {
michael@0 182 package FileAttrCache;
michael@0 183
michael@0 184 sub new($$);
michael@0 185
michael@0 186 sub isFat($);
michael@0 187 sub isMachO($);
michael@0 188 sub isZip($);
michael@0 189 sub lIsDir($);
michael@0 190 sub lIsExecutable($);
michael@0 191 sub lIsRegularFile($);
michael@0 192 sub lIsSymLink($);
michael@0 193 sub lstat($);
michael@0 194 sub lstatMode($);
michael@0 195 sub lstatType($);
michael@0 196 sub magic($);
michael@0 197 sub magic2($);
michael@0 198 sub path($);
michael@0 199 sub stat($);
michael@0 200 sub statSize($);
michael@0 201 }
michael@0 202
michael@0 203 %gConfig = (
michael@0 204 'cmd_lipo' => 'lipo',
michael@0 205 'cmd_rm' => 'rm',
michael@0 206 );
michael@0 207
michael@0 208 $gDryRun = 0;
michael@0 209 $gOnlyOne = 'copy';
michael@0 210 $gVerbosity = 2;
michael@0 211 @gSortMatches = ();
michael@0 212
michael@0 213 Getopt::Long::Configure('pass_through');
michael@0 214 GetOptions('dry-run' => \$gDryRun,
michael@0 215 'only-one=s' => \$gOnlyOne,
michael@0 216 'verbosity=i' => \$gVerbosity,
michael@0 217 'unify-with-sort=s' => \@gSortMatches,
michael@0 218 'config=s' => \%gConfig); # "hidden" option not in usage()
michael@0 219
michael@0 220 if (scalar(@ARGV) != 3 || $gVerbosity < 0 || $gVerbosity > 3 ||
michael@0 221 ($gOnlyOne ne 'skip' && $gOnlyOne ne 'copy' && $gOnlyOne ne 'fail')) {
michael@0 222 usage();
michael@0 223 exit(1);
michael@0 224 }
michael@0 225
michael@0 226 if (!makeUniversal($ARGV[0],$ARGV[1],$ARGV[2])) {
michael@0 227 # makeUniversal or something it called will have printed an error.
michael@0 228 exit(1);
michael@0 229 }
michael@0 230
michael@0 231 exit(0);
michael@0 232
michael@0 233 # argumentEscape(@arguments)
michael@0 234 #
michael@0 235 # Takes a list of @arguments and makes them shell-safe.
michael@0 236 sub argumentEscape(@) {
michael@0 237 my (@arguments);
michael@0 238 @arguments = @_;
michael@0 239
michael@0 240 my ($argument, @argumentsOut);
michael@0 241 foreach $argument (@arguments) {
michael@0 242 $argument =~ s%([^A-Za-z0-9_\-/.=+,])%\\$1%g;
michael@0 243 push(@argumentsOut, $argument);
michael@0 244 }
michael@0 245
michael@0 246 return @argumentsOut;
michael@0 247 }
michael@0 248
michael@0 249 # command(@arguments)
michael@0 250 #
michael@0 251 # Runs the specified command by calling system(@arguments). If $gDryRun
michael@0 252 # is true, the command is printed but not executed, and 0 is returned.
michael@0 253 # if $gVerbosity is greater than 1, the command is printed before being
michael@0 254 # executed. When the command is executed, the system() return value will
michael@0 255 # be returned. stdout and stderr are left connected for command output.
michael@0 256 sub command(@) {
michael@0 257 my (@arguments);
michael@0 258 @arguments = @_;
michael@0 259 if ($gVerbosity >= 3 || $gDryRun) {
michael@0 260 print(join(' ', argumentEscape(@arguments))."\n");
michael@0 261 }
michael@0 262 if ($gDryRun) {
michael@0 263 return 0;
michael@0 264 }
michael@0 265 return system(@arguments);
michael@0 266 }
michael@0 267
michael@0 268 # compareZipArchives($zip1, $zip2)
michael@0 269 #
michael@0 270 # Given two pathnames to zip archives, determines whether or not they are
michael@0 271 # functionally identical. Returns true if they are, false if they differ in
michael@0 272 # some substantial way, and undef if an error occurs. If the zip files
michael@0 273 # differ, diagnostic messages are printed indicating how they differ.
michael@0 274 #
michael@0 275 # Zip files will differ if any of the members are different as defined by
michael@0 276 # readZipCRCs, which consider CRCs, sizes, and file types as stored in the
michael@0 277 # file header. Timestamps are not considered. Zip files also differ if one
michael@0 278 # file contains members that the other one does not. $gOnlyOne has no
michael@0 279 # effect on this behavior.
michael@0 280 sub compareZipArchives($$) {
michael@0 281 my ($zip1, $zip2);
michael@0 282 ($zip1, $zip2) = @_;
michael@0 283
michael@0 284 my ($CRCHash1, $CRCHash2);
michael@0 285 if (!defined($CRCHash1 = readZipCRCs($zip1))) {
michael@0 286 # readZipCRCs printed an error.
michael@0 287 return undef;
michael@0 288 }
michael@0 289 if (!defined($CRCHash2 = readZipCRCs($zip2))) {
michael@0 290 # readZipCRCs printed an error.
michael@0 291 return undef;
michael@0 292 }
michael@0 293
michael@0 294 my (@diffCRCs, @onlyInZip1);
michael@0 295 @diffCRCs = ();
michael@0 296 @onlyInZip1 = ();
michael@0 297
michael@0 298 my ($memberName);
michael@0 299 foreach $memberName (keys(%$CRCHash1)) {
michael@0 300 if (!exists($$CRCHash2{$memberName})) {
michael@0 301 # The member is present in $zip1 but not $zip2.
michael@0 302 push(@onlyInZip1, $memberName);
michael@0 303 }
michael@0 304 elsif ($$CRCHash1{$memberName} ne $$CRCHash2{$memberName}) {
michael@0 305 # The member is present in both archives but its CRC or some other
michael@0 306 # other critical attribute isn't identical.
michael@0 307 push(@diffCRCs, $memberName);
michael@0 308 }
michael@0 309 delete($$CRCHash2{$memberName});
michael@0 310 }
michael@0 311
michael@0 312 # If any members remain in %CRCHash2, it's because they're not present
michael@0 313 # in $zip1.
michael@0 314 my (@onlyInZip2);
michael@0 315 @onlyInZip2 = keys(%$CRCHash2);
michael@0 316
michael@0 317 if (scalar(@onlyInZip1) + scalar(@onlyInZip2) + scalar(@diffCRCs)) {
michael@0 318 complain(1, 'compareZipArchives: zip archives differ:',
michael@0 319 $zip1,
michael@0 320 $zip2);
michael@0 321 if (scalar(@onlyInZip1)) {
michael@0 322 complain(1, 'compareZipArchives: members only in former:',
michael@0 323 @onlyInZip1);
michael@0 324 }
michael@0 325 if (scalar(@onlyInZip2)) {
michael@0 326 complain(1, 'compareZipArchives: members only in latter:',
michael@0 327 @onlyInZip2);
michael@0 328 }
michael@0 329 if (scalar(@diffCRCs)) {
michael@0 330 complain(1, 'compareZipArchives: members differ:',
michael@0 331 @diffCRCs);
michael@0 332 }
michael@0 333 return 0;
michael@0 334 }
michael@0 335
michael@0 336 return 1;
michael@0 337 }
michael@0 338
michael@0 339 # complain($severity, $message, @list)
michael@0 340 #
michael@0 341 # Prints $message to stderr if $gVerbosity allows it for severity level
michael@0 342 # $severity. @list is a list of words that will be shell-escaped and printed
michael@0 343 # after $message, one per line, intended to be used, for example, to list
michael@0 344 # arguments to a call that failed.
michael@0 345 #
michael@0 346 # Expected severity levels are 1 for hard errors and 2 for non-fatal warnings.
michael@0 347 #
michael@0 348 # Always returns false as a convenience, so callers can return complain's
michael@0 349 # return value when it is used to signal errors.
michael@0 350 sub complain($$@) {
michael@0 351 my ($severity, $message, @list);
michael@0 352 ($severity, $message, @list) = @_;
michael@0 353
michael@0 354 if ($gVerbosity >= $severity) {
michael@0 355 print STDERR ($0.': '.$message."\n");
michael@0 356
michael@0 357 my ($item);
michael@0 358 while ($item = shift(@list)) {
michael@0 359 print STDERR (' '.(argumentEscape($item))[0].
michael@0 360 (scalar(@list)?',':'')."\n");
michael@0 361 }
michael@0 362 }
michael@0 363
michael@0 364 return 0;
michael@0 365 }
michael@0 366
michael@0 367 # copyIfIdentical($source1, $source2, $target)
michael@0 368 #
michael@0 369 # $source1 and $source2 are FileAttrCache objects that are compared, and if
michael@0 370 # identical, copied to path string $target. The comparison is initially
michael@0 371 # done as a byte-for-byte comparison, but if the files differ and appear to
michael@0 372 # be zip archives, compareZipArchives is called to determine whether
michael@0 373 # files that are not byte-for-byte identical are equivalent archives.
michael@0 374 #
michael@0 375 # Returns true on success, false for files that are not identical or
michael@0 376 # equivalent archives, and undef if an error occurs.
michael@0 377 #
michael@0 378 # One of $source1 and $source2 is permitted to be undef. In this event,
michael@0 379 # whichever source is defined is copied directly to $target without performing
michael@0 380 # any comparisons. This enables the $gOnlyOne = 'copy' mode, which is
michael@0 381 # driven by makeUniversalDirectory and makeUniversalInternal.
michael@0 382 sub copyIfIdentical($$$) {
michael@0 383 my ($source1, $source2, $target);
michael@0 384 ($source1, $source2, $target) = @_;
michael@0 385
michael@0 386 if (!defined($source1)) {
michael@0 387 # If there's only one source file, make it the first file. Order
michael@0 388 # isn't important here, and this makes it possible to use
michael@0 389 # defined($source2) as the switch, and to always copy from $source1.
michael@0 390 $source1 = $source2;
michael@0 391 $source2 = undef;
michael@0 392 }
michael@0 393
michael@0 394 if (defined($source2)) {
michael@0 395 # Only do the comparisons if there are two source files. If there's
michael@0 396 # only one source file, skip the comparisons and go straight to the
michael@0 397 # copy operation.
michael@0 398 if ($gVerbosity >= 3 || $gDryRun) {
michael@0 399 print('cmp -s '.
michael@0 400 join(' ',argumentEscape($source1->path(), $source2->path()))."\n");
michael@0 401 }
michael@0 402 my ($comparison);
michael@0 403 if (!defined($comparison = compare($source1->path(), $source2->path())) ||
michael@0 404 $comparison == -1) {
michael@0 405 return complain(1, 'copyIfIdentical: compare: '.$!.' while comparing:',
michael@0 406 $source1->path(),
michael@0 407 $source2->path());
michael@0 408 }
michael@0 409 elsif ($comparison != 0) {
michael@0 410 my ($zip1, $zip2);
michael@0 411 if (defined($zip1 = $source1->isZip()) &&
michael@0 412 defined($zip2 = $source2->isZip()) &&
michael@0 413 $zip1 && $zip2) {
michael@0 414 my ($zipComparison);
michael@0 415 if (!defined($zipComparison = compareZipArchives($source1->path(),
michael@0 416 $source2->path)) ||
michael@0 417 !$zipComparison) {
michael@0 418 # An error occurred or the zip files aren't sufficiently identical.
michael@0 419 # compareZipArchives will have printed an error message.
michael@0 420 return 0;
michael@0 421 }
michael@0 422 # The zip files were compared successfully, and they both contain
michael@0 423 # all of the same members, and all of their members' CRCs are
michael@0 424 # identical. For the purposes of this script, the zip files can be
michael@0 425 # treated as identical, so reset $comparison.
michael@0 426 $comparison = 0;
michael@0 427 }
michael@0 428 }
michael@0 429 if ($comparison != 0) {
michael@0 430 return complain(1, 'copyIfIdentical: files differ:',
michael@0 431 $source1->path(),
michael@0 432 $source2->path());
michael@0 433 }
michael@0 434 }
michael@0 435
michael@0 436 if ($gVerbosity >= 3 || $gDryRun) {
michael@0 437 print('cp '.
michael@0 438 join(' ',argumentEscape($source1->path(), $target))."\n");
michael@0 439 }
michael@0 440
michael@0 441 if (!$gDryRun) {
michael@0 442 my ($isExecutable);
michael@0 443
michael@0 444 # Set the execute bits (as allowed by the umask) on the new file if any
michael@0 445 # execute bit is set on either old file.
michael@0 446 $isExecutable = $source1->lIsExecutable() ||
michael@0 447 (defined($source2) && $source2->lIsExecutable());
michael@0 448
michael@0 449 if (!createUniqueFile($target, $isExecutable ? 0777 : 0666)) {
michael@0 450 # createUniqueFile printed an error.
michael@0 451 return 0;
michael@0 452 }
michael@0 453
michael@0 454 if (!copy($source1->path(), $target)) {
michael@0 455 complain(1, 'copyIfIdentical: copy: '.$!.' while copying',
michael@0 456 $source1->path(),
michael@0 457 $target);
michael@0 458 unlink($target);
michael@0 459 return 0;
michael@0 460 }
michael@0 461 }
michael@0 462
michael@0 463 return 1;
michael@0 464 }
michael@0 465
michael@0 466 # slurp($file)
michael@0 467 #
michael@0 468 # Read the contents of $file into an array and return it.
michael@0 469 # Returns undef on error.
michael@0 470 sub slurp($) {
michael@0 471 my $file = $_[0];
michael@0 472 open FILE, $file or return undef;
michael@0 473 my @lines = <FILE>;
michael@0 474 close FILE;
michael@0 475 return @lines;
michael@0 476 }
michael@0 477
michael@0 478 # get_sorted($file)
michael@0 479 # Get the sorted lines of a file as a list, normalizing a newline on the last line if necessary.
michael@0 480 sub get_sorted($) {
michael@0 481 my ($file) = @_;
michael@0 482 my @lines = slurp($file);
michael@0 483 my $lastline = $lines[-1];
michael@0 484 if (!($lastline =~ /\n/)) {
michael@0 485 $lines[-1] = $lastline . "\n";
michael@0 486 }
michael@0 487 return sort(@lines);
michael@0 488 }
michael@0 489
michael@0 490 # compare_sorted($file1, $file2)
michael@0 491 #
michael@0 492 # Read the contents of both files into arrays, sort the arrays,
michael@0 493 # and then compare the two arrays for equality.
michael@0 494 #
michael@0 495 # Returns 0 if the sorted array contents are equal, or 1 if not.
michael@0 496 # Returns undef on error.
michael@0 497 sub compare_sorted($$) {
michael@0 498 my ($file1, $file2) = @_;
michael@0 499 my @lines1 = get_sorted($file1);
michael@0 500 my @lines2 = get_sorted($file2);
michael@0 501
michael@0 502 return undef if !@lines1 || !@lines2;
michael@0 503 return 1 unless scalar @lines1 == scalar @lines2;
michael@0 504
michael@0 505 for (my $i = 0; $i < scalar @lines1; $i++) {
michael@0 506 return 1 if $lines1[$i] ne $lines2[$i];
michael@0 507 }
michael@0 508 return 0;
michael@0 509 }
michael@0 510
michael@0 511 # copyIfIdenticalWhenSorted($source1, $source2, $target)
michael@0 512 #
michael@0 513 # $source1 and $source2 are FileAttrCache objects that are compared, and if
michael@0 514 # identical, copied to path string $target. The comparison is done by
michael@0 515 # sorting the individual lines within the two files and comparing the results.
michael@0 516 #
michael@0 517 # Returns true on success, false for files that are not equivalent,
michael@0 518 # and undef if an error occurs.
michael@0 519 sub copyIfIdenticalWhenSorted($$$) {
michael@0 520 my ($source1, $source2, $target);
michael@0 521 ($source1, $source2, $target) = @_;
michael@0 522
michael@0 523 if ($gVerbosity >= 3 || $gDryRun) {
michael@0 524 print('cmp -s '.
michael@0 525 join(' ',argumentEscape($source1->path(), $source2->path()))."\n");
michael@0 526 }
michael@0 527 my ($comparison);
michael@0 528 if (!defined($comparison = compare_sorted($source1->path(),
michael@0 529 $source2->path())) ||
michael@0 530 $comparison == -1) {
michael@0 531 return complain(1, 'copyIfIdenticalWhenSorted: compare: '.$!
michael@0 532 .' while comparing:',
michael@0 533 $source1->path(),
michael@0 534 $source2->path());
michael@0 535 }
michael@0 536 if ($comparison != 0) {
michael@0 537 return complain(1, 'copyIfIdenticalWhenSorted: files differ:',
michael@0 538 $source1->path(),
michael@0 539 $source2->path());
michael@0 540 }
michael@0 541
michael@0 542 if ($gVerbosity >= 3 || $gDryRun) {
michael@0 543 print('cp '.
michael@0 544 join(' ',argumentEscape($source1->path(), $target))."\n");
michael@0 545 }
michael@0 546
michael@0 547 if (!$gDryRun) {
michael@0 548 my ($isExecutable);
michael@0 549
michael@0 550 # Set the execute bits (as allowed by the umask) on the new file if any
michael@0 551 # execute bit is set on either old file.
michael@0 552 $isExecutable = $source1->lIsExecutable() ||
michael@0 553 (defined($source2) && $source2->lIsExecutable());
michael@0 554
michael@0 555 if (!createUniqueFile($target, $isExecutable ? 0777 : 0666)) {
michael@0 556 # createUniqueFile printed an error.
michael@0 557 return 0;
michael@0 558 }
michael@0 559
michael@0 560 if (!copy($source1->path(), $target)) {
michael@0 561 complain(1, 'copyIfIdenticalWhenSorted: copy: '.$!
michael@0 562 .' while copying',
michael@0 563 $source1->path(),
michael@0 564 $target);
michael@0 565 unlink($target);
michael@0 566 return 0;
michael@0 567 }
michael@0 568 }
michael@0 569
michael@0 570 return 1;
michael@0 571 }
michael@0 572
michael@0 573 # createUniqueFile($path, $mode)
michael@0 574 #
michael@0 575 # Creates a new plain empty file at pathname $path, provided it does not
michael@0 576 # yet exist. $mode is used as the file mode. The actual file's mode will
michael@0 577 # be modified by the effective umask. Returns false if the file could
michael@0 578 # not be created, setting $! to the error. An error message is printed
michael@0 579 # in the event of failure.
michael@0 580 sub createUniqueFile($$) {
michael@0 581 my ($path, $mode);
michael@0 582 ($path, $mode) = @_;
michael@0 583
michael@0 584 my ($fh);
michael@0 585 if (!sysopen($fh, $path, O_WRONLY | O_CREAT | O_EXCL, $mode)) {
michael@0 586 return complain(1, 'createUniqueFile: open: '.$!.' for:',
michael@0 587 $path);
michael@0 588 }
michael@0 589 close($fh);
michael@0 590
michael@0 591 return 1;
michael@0 592 }
michael@0 593
michael@0 594 # makeUniversal($pathPPC, $pathX86, $pathTarget)
michael@0 595 #
michael@0 596 # The top-level call. $pathPPC, $pathX86, and $pathTarget are strings
michael@0 597 # identifying the ppc and x86 files or directories to merge and the location
michael@0 598 # to merge them to. Returns false on failure and true on success.
michael@0 599 sub makeUniversal($$$) {
michael@0 600 my ($pathTarget, $pathPPC, $pathX86);
michael@0 601 ($pathPPC, $pathX86, $pathTarget) = @_;
michael@0 602
michael@0 603 my ($filePPC, $fileX86);
michael@0 604 $filePPC = FileAttrCache->new($pathPPC);
michael@0 605 $fileX86 = FileAttrCache->new($pathX86);
michael@0 606
michael@0 607 return makeUniversalInternal(1, $filePPC, $fileX86, $pathTarget);
michael@0 608 }
michael@0 609
michael@0 610 # makeUniversalDirectory($dirPPC, $dirX86, $dirTarget)
michael@0 611 #
michael@0 612 # This is part of the heart of recursion. $dirPPC and $dirX86 are
michael@0 613 # FileAttrCache objects designating the source ppc and x86 directories to
michael@0 614 # merge into a universal directory at $dirTarget, a string. For each file
michael@0 615 # in $dirPPC and $dirX86, makeUniversalInternal is called.
michael@0 616 # makeUniversalInternal will call back into makeUniversalDirectory for
michael@0 617 # directories, thus completing the recursion. If a failure is encountered
michael@0 618 # in ths function or in makeUniversalInternal or anything that it calls,
michael@0 619 # false is returned, otherwise, true is returned.
michael@0 620 #
michael@0 621 # If there are files present in one source directory but not both, the
michael@0 622 # value of $gOnlyOne controls the behavior. If $gOnlyOne is 'copy', the
michael@0 623 # single source file is copied into $pathTarget. If it is 'skip', it is
michael@0 624 # skipped. If it is 'fail', such files will trigger makeUniversalDirectory
michael@0 625 # to fail.
michael@0 626 #
michael@0 627 # If either source directory is undef, it is treated as having no files.
michael@0 628 # This facilitates deep recursion when entire directories are only present
michael@0 629 # in one source when $gOnlyOne = 'copy'.
michael@0 630 sub makeUniversalDirectory($$$) {
michael@0 631 my ($dirPPC, $dirX86, $dirTarget);
michael@0 632 ($dirPPC, $dirX86, $dirTarget) = @_;
michael@0 633
michael@0 634 my ($dh, @filesPPC, @filesX86);
michael@0 635
michael@0 636 @filesPPC = ();
michael@0 637 if (defined($dirPPC)) {
michael@0 638 if (!opendir($dh, $dirPPC->path())) {
michael@0 639 return complain(1, 'makeUniversalDirectory: opendir ppc: '.$!.' for:',
michael@0 640 $dirPPC->path());
michael@0 641 }
michael@0 642 @filesPPC = readdir($dh);
michael@0 643 closedir($dh);
michael@0 644 }
michael@0 645
michael@0 646 @filesX86 = ();
michael@0 647 if (defined($dirX86)) {
michael@0 648 if (!opendir($dh, $dirX86->path())) {
michael@0 649 return complain(1, 'makeUniversalDirectory: opendir x86: '.$!.' for:',
michael@0 650 $dirX86->path());
michael@0 651 }
michael@0 652 @filesX86 = readdir($dh);
michael@0 653 closedir($dh);
michael@0 654 }
michael@0 655
michael@0 656 my (%common, $file, %onlyPPC, %onlyX86);
michael@0 657
michael@0 658 %onlyPPC = ();
michael@0 659 foreach $file (@filesPPC) {
michael@0 660 if ($file eq '.' || $file eq '..') {
michael@0 661 next;
michael@0 662 }
michael@0 663 $onlyPPC{$file}=1;
michael@0 664 }
michael@0 665
michael@0 666 %common = ();
michael@0 667 %onlyX86 = ();
michael@0 668 foreach $file (@filesX86) {
michael@0 669 if ($file eq '.' || $file eq '..') {
michael@0 670 next;
michael@0 671 }
michael@0 672 if ($onlyPPC{$file}) {
michael@0 673 delete $onlyPPC{$file};
michael@0 674 $common{$file}=1;
michael@0 675 }
michael@0 676 else {
michael@0 677 $onlyX86{$file}=1;
michael@0 678 }
michael@0 679 }
michael@0 680
michael@0 681 # First, handle files common to both.
michael@0 682 foreach $file (sort(keys(%common))) {
michael@0 683 if (!makeUniversalInternal(0,
michael@0 684 FileAttrCache->new($dirPPC->path().'/'.$file),
michael@0 685 FileAttrCache->new($dirX86->path().'/'.$file),
michael@0 686 $dirTarget.'/'.$file)) {
michael@0 687 # makeUniversalInternal will have printed an error.
michael@0 688 return 0;
michael@0 689 }
michael@0 690 }
michael@0 691
michael@0 692 # Handle files found only in a single directory here. There are three
michael@0 693 # options, dictated by $gOnlyOne: fail if files are only present in
michael@0 694 # one directory, skip any files only present in one directory, or copy
michael@0 695 # these files straight over to the target directory. In any event,
michael@0 696 # a message will be printed indicating that the file trees don't match
michael@0 697 # exactly.
michael@0 698 if (keys(%onlyPPC)) {
michael@0 699 complain(($gOnlyOne eq 'fail' ? 1 : 2),
michael@0 700 ($gOnlyOne ne 'fail' ? 'warning: ' : '').
michael@0 701 'makeUniversalDirectory: only in ppc '.
michael@0 702 (argumentEscape($dirPPC->path()))[0].':',
michael@0 703 argumentEscape(keys(%onlyPPC)));
michael@0 704 }
michael@0 705
michael@0 706 if (keys(%onlyX86)) {
michael@0 707 complain(($gOnlyOne eq 'fail' ? 1 : 2),
michael@0 708 ($gOnlyOne ne 'fail' ? 'warning: ' : '').
michael@0 709 'makeUniversalDirectory: only in x86 '.
michael@0 710 (argumentEscape($dirX86->path()))[0].':',
michael@0 711 argumentEscape(keys(%onlyX86)));
michael@0 712 }
michael@0 713
michael@0 714 if ($gOnlyOne eq 'fail' && (keys(%onlyPPC) || keys(%onlyX86))) {
michael@0 715 # Error message(s) printed above.
michael@0 716 return 0;
michael@0 717 }
michael@0 718
michael@0 719 if ($gOnlyOne eq 'copy') {
michael@0 720 foreach $file (sort(keys(%onlyPPC))) {
michael@0 721 if (!makeUniversalInternal(0,
michael@0 722 FileAttrCache->new($dirPPC->path().'/'.$file),
michael@0 723 undef,
michael@0 724 $dirTarget.'/'.$file)) {
michael@0 725 # makeUniversalInternal will have printed an error.
michael@0 726 return 0;
michael@0 727 }
michael@0 728 }
michael@0 729
michael@0 730 foreach $file (sort(keys(%onlyX86))) {
michael@0 731 if (!makeUniversalInternal(0,
michael@0 732 undef,
michael@0 733 FileAttrCache->new($dirX86->path().'/'.$file),
michael@0 734 $dirTarget.'/'.$file)) {
michael@0 735 # makeUniversalInternal will have printed an error.
michael@0 736 return 0;
michael@0 737 }
michael@0 738 }
michael@0 739 }
michael@0 740
michael@0 741 return 1;
michael@0 742 }
michael@0 743
michael@0 744 # makeUniversalFile($sourcePPC, $sourceX86, $targetPath)
michael@0 745 #
michael@0 746 # Creates a universal file at pathname $targetPath based on a ppc image at
michael@0 747 # $sourcePPC and an x86 image at $sourceX86. $sourcePPC and $sourceX86 are
michael@0 748 # both FileAttrCache objects. Returns true on success and false on failure.
michael@0 749 # On failure, diagnostics will be printed to stderr.
michael@0 750 #
michael@0 751 # The source files may be either thin Mach-O images of the appropriate
michael@0 752 # architecture, or fat Mach-O files that contain images of the appropriate
michael@0 753 # architecture.
michael@0 754 #
michael@0 755 # This function wraps the lipo utility, see lipo(1).
michael@0 756 sub makeUniversalFile($$$) {
michael@0 757 my ($sourcePPC, $sourceX86, $targetPath, @tempThinFiles, $thinPPC, $thinX86);
michael@0 758 ($sourcePPC, $sourceX86, $targetPath) = @_;
michael@0 759 $thinPPC = $sourcePPC;
michael@0 760 $thinX86 = $sourceX86;
michael@0 761
michael@0 762 @tempThinFiles = ();
michael@0 763
michael@0 764 # The source files might already be fat. They should be thinned out to only
michael@0 765 # contain a single architecture.
michael@0 766
michael@0 767 my ($isFatPPC, $isFatX86);
michael@0 768
michael@0 769 if(!defined($isFatPPC = $sourcePPC->isFat())) {
michael@0 770 # isFat printed its own error
michael@0 771 return 0;
michael@0 772 }
michael@0 773 elsif($isFatPPC) {
michael@0 774 $thinPPC = FileAttrCache->new($targetPath.'.ppc');
michael@0 775 push(@tempThinFiles, $thinPPC->path());
michael@0 776 if (command($gConfig{'cmd_lipo'}, '-thin', 'ppc',
michael@0 777 $sourcePPC->path(), '-output', $thinPPC->path()) != 0) {
michael@0 778 unlink(@tempThinFiles);
michael@0 779 return complain(1, 'lipo thin ppc failed for:',
michael@0 780 $sourcePPC->path(),
michael@0 781 $thinPPC->path());
michael@0 782 }
michael@0 783 }
michael@0 784
michael@0 785 if(!defined($isFatX86 = $sourceX86->isFat())) {
michael@0 786 # isFat printed its own error
michael@0 787 unlink(@tempThinFiles);
michael@0 788 return 0;
michael@0 789 }
michael@0 790 elsif($isFatX86) {
michael@0 791 $thinX86 = FileAttrCache->new($targetPath.'.x86');
michael@0 792 push(@tempThinFiles, $thinX86->path());
michael@0 793 if (command($gConfig{'cmd_lipo'}, '-thin', 'i386',
michael@0 794 $sourceX86->path(), '-output', $thinX86->path()) != 0) {
michael@0 795 unlink(@tempThinFiles);
michael@0 796 return complain(1, 'lipo thin x86 failed for:',
michael@0 797 $sourceX86->path(),
michael@0 798 $thinX86->path());
michael@0 799 }
michael@0 800 }
michael@0 801
michael@0 802 # The image for each architecture in the fat file will be aligned on
michael@0 803 # a specific boundary, default 4096 bytes, see lipo(1) -segalign.
michael@0 804 # Since there's no tail-padding, the fat file will consume the least
michael@0 805 # space on disk if the image that comes last exceeds the segment size
michael@0 806 # by the smallest amount.
michael@0 807 #
michael@0 808 # This saves an average of 1kB per fat file over the naive approach of
michael@0 809 # always putting one architecture first: average savings is 2kB per
michael@0 810 # file, but the naive approach would have gotten it right half of the
michael@0 811 # time.
michael@0 812
michael@0 813 my ($sizePPC, $sizeX86, $thinPPCForStat, $thinX86ForStat);
michael@0 814
michael@0 815 if (!$gDryRun) {
michael@0 816 $thinPPCForStat = $thinPPC;
michael@0 817 $thinX86ForStat = $thinX86;
michael@0 818 }
michael@0 819 else {
michael@0 820 # Normally, fat source files will have been converted into temporary
michael@0 821 # thin files. During a dry run, that doesn't happen, so fake it up
michael@0 822 # a little bit by always using the source file, fat or thin, for the
michael@0 823 # stat.
michael@0 824 $thinPPCForStat = $sourcePPC;
michael@0 825 $thinX86ForStat = $sourceX86;
michael@0 826 }
michael@0 827
michael@0 828 if (!defined($sizePPC = $thinPPCForStat->statSize())) {
michael@0 829 unlink(@tempThinFiles);
michael@0 830 return complain(1, 'stat ppc: '.$!.' for:',
michael@0 831 $thinPPCForStat->path());
michael@0 832 }
michael@0 833 if (!defined($sizeX86 = $thinX86ForStat->statSize())) {
michael@0 834 unlink(@tempThinFiles);
michael@0 835 return complain(1, 'stat x86: '.$!.' for:',
michael@0 836 $thinX86ForStat->path());
michael@0 837 }
michael@0 838
michael@0 839 $sizePPC = $sizePPC % 4096;
michael@0 840 $sizeX86 = $sizeX86 % 4096;
michael@0 841
michael@0 842 my (@thinFiles);
michael@0 843
michael@0 844 if ($sizePPC == 0) {
michael@0 845 # PPC image ends on an alignment boundary, there will be no padding before
michael@0 846 # starting the x86 image.
michael@0 847 @thinFiles = ($thinPPC->path(), $thinX86->path());
michael@0 848 }
michael@0 849 elsif ($sizeX86 == 0 || $sizeX86 > $sizePPC) {
michael@0 850 # x86 image ends on an alignment boundary, there will be no padding before
michael@0 851 # starting the PPC image, or the x86 image exceeds its alignment boundary
michael@0 852 # by more than the PPC image, so there will be less padding if the x86
michael@0 853 # comes first.
michael@0 854 @thinFiles = ($thinX86->path(), $thinPPC->path());
michael@0 855 }
michael@0 856 else {
michael@0 857 # PPC image exceeds its alignment boundary by more than the x86 image, so
michael@0 858 # there will be less padding if the PPC comes first.
michael@0 859 @thinFiles = ($thinPPC->path(), $thinX86->path());
michael@0 860 }
michael@0 861
michael@0 862 my ($isExecutable);
michael@0 863 $isExecutable = $sourcePPC->lIsExecutable() ||
michael@0 864 $sourceX86->lIsExecutable();
michael@0 865
michael@0 866 if (!$gDryRun) {
michael@0 867 # Ensure that the file does not yet exist.
michael@0 868
michael@0 869 # Set the execute bits (as allowed by the umask) on the new file if any
michael@0 870 # execute bit is set on either old file. Yes, it is possible to have
michael@0 871 # proper Mach-O files without x-bits: think object files (.o) and static
michael@0 872 # archives (.a).
michael@0 873 if (!createUniqueFile($targetPath, $isExecutable ? 0777 : 0666)) {
michael@0 874 # createUniqueFile printed an error.
michael@0 875 unlink(@tempThinFiles);
michael@0 876 return 0;
michael@0 877 }
michael@0 878 }
michael@0 879
michael@0 880 # Create the fat file.
michael@0 881 if (command($gConfig{'cmd_lipo'}, '-create', @thinFiles,
michael@0 882 '-output', $targetPath) != 0) {
michael@0 883 unlink(@tempThinFiles, $targetPath);
michael@0 884 return complain(1, 'lipo create fat failed for:',
michael@0 885 @thinFiles,
michael@0 886 $targetPath);
michael@0 887 }
michael@0 888
michael@0 889 unlink(@tempThinFiles);
michael@0 890
michael@0 891 if (!$gDryRun) {
michael@0 892 # lipo seems to think that it's free to set its own file modes that
michael@0 893 # ignore the umask, which is bogus when the rest of this script
michael@0 894 # respects the umask.
michael@0 895 if (!chmod(($isExecutable ? 0777 : 0666) & ~umask(), $targetPath)) {
michael@0 896 complain(1, 'makeUniversalFile: chmod: '.$!.' for',
michael@0 897 $targetPath);
michael@0 898 unlink($targetPath);
michael@0 899 return 0;
michael@0 900 }
michael@0 901 }
michael@0 902
michael@0 903 return 1;
michael@0 904 }
michael@0 905
michael@0 906 # makeUniversalInternal($isToplevel, $filePPC, $fileX86, $fileTargetPath)
michael@0 907 #
michael@0 908 # Given FileAttrCache objects $filePPC and $fileX86, compares filetypes
michael@0 909 # and performs the appropriate action to produce a universal file at
michael@0 910 # path string $fileTargetPath. $isToplevel should be true if this is
michael@0 911 # the recursive base and false otherwise; this controls cleanup behavior
michael@0 912 # (cleanup is only performed at the base, because cleanup itself is
michael@0 913 # recursive).
michael@0 914 #
michael@0 915 # This handles regular files by determining whether they are Mach-O files
michael@0 916 # and calling makeUniversalFile if so and copyIfIdentical otherwise. Symbolic
michael@0 917 # links are handled directly in this function by ensuring that the source link
michael@0 918 # targets are identical and creating a new link with the same target
michael@0 919 # at $fileTargetPath. Directories are handled by calling
michael@0 920 # makeUniversalDirectory.
michael@0 921 #
michael@0 922 # One of $filePPC and $fileX86 is permitted to be undef. In that case,
michael@0 923 # the defined source file is copied directly to the target if a regular
michael@0 924 # file, and symlinked appropriately if a symbolic link. This facilitates
michael@0 925 # use of $gOnlyOne = 'copy', although no $gOnlyOne checks are made in this
michael@0 926 # function, they are all handled in makeUniversalDirectory.
michael@0 927 #
michael@0 928 # Returns true on success. Returns false on failure, including failures
michael@0 929 # in other functions called.
michael@0 930 sub makeUniversalInternal($$$$) {
michael@0 931 my ($filePPC, $fileTargetPath, $fileX86, $isToplevel);
michael@0 932 ($isToplevel, $filePPC, $fileX86, $fileTargetPath) = @_;
michael@0 933
michael@0 934 my ($typePPC, $typeX86);
michael@0 935 if (defined($filePPC) && !defined($typePPC = $filePPC->lstatType())) {
michael@0 936 return complain(1, 'makeUniversal: lstat ppc: '.$!.' for:',
michael@0 937 $filePPC->path());
michael@0 938 }
michael@0 939 if (defined($fileX86) && !defined($typeX86 = $fileX86->lstatType())) {
michael@0 940 return complain(1, 'makeUniversal: lstat x86: '.$!.' for:',
michael@0 941 $fileX86->path());
michael@0 942 }
michael@0 943
michael@0 944 if (defined($filePPC) && defined($fileX86) && $typePPC != $typeX86) {
michael@0 945 return complain(1, 'makeUniversal: incompatible types:',
michael@0 946 $filePPC->path(),
michael@0 947 $fileX86->path());
michael@0 948 }
michael@0 949
michael@0 950 # $aSourceFile will contain a FileAttrCache object that will return
michael@0 951 # the correct type data. It's used because it's possible for one of
michael@0 952 # the two source files to be undefined (indicating a straight copy).
michael@0 953 my ($aSourceFile);
michael@0 954 if (defined($filePPC)) {
michael@0 955 $aSourceFile = $filePPC;
michael@0 956 }
michael@0 957 else {
michael@0 958 $aSourceFile = $fileX86;
michael@0 959 }
michael@0 960
michael@0 961 if ($aSourceFile->lIsDir()) {
michael@0 962 if ($gVerbosity >= 3 || $gDryRun) {
michael@0 963 print('mkdir '.(argumentEscape($fileTargetPath))[0]."\n");
michael@0 964 }
michael@0 965 if (!$gDryRun && !mkdir($fileTargetPath)) {
michael@0 966 return complain(1, 'makeUniversal: mkdir: '.$!.' for:',
michael@0 967 $fileTargetPath);
michael@0 968 }
michael@0 969
michael@0 970 my ($rv);
michael@0 971
michael@0 972 if (!($rv = makeUniversalDirectory($filePPC, $fileX86, $fileTargetPath))) {
michael@0 973 # makeUniversalDirectory printed an error.
michael@0 974 if ($isToplevel) {
michael@0 975 command($gConfig{'cmd_rm'},'-rf','--',$fileTargetPath);
michael@0 976 }
michael@0 977 }
michael@0 978 else {
michael@0 979 # Touch the directory when leaving it. If unify is being run on an
michael@0 980 # .app bundle, the .app might show up without an icon because the
michael@0 981 # system might have found the .app before it was completely built.
michael@0 982 # Touching it dirties it in LaunchServices' mind.
michael@0 983 if ($gVerbosity >= 3) {
michael@0 984 print('touch '.(argumentEscape($fileTargetPath))[0]."\n");
michael@0 985 }
michael@0 986 utime(undef, undef, $fileTargetPath);
michael@0 987 }
michael@0 988
michael@0 989 return $rv;
michael@0 990 }
michael@0 991 elsif ($aSourceFile->lIsSymLink()) {
michael@0 992 my ($linkPPC, $linkX86);
michael@0 993 if (defined($filePPC) && !defined($linkPPC=readlink($filePPC->path()))) {
michael@0 994 return complain(1, 'makeUniversal: readlink ppc: '.$!.' for:',
michael@0 995 $filePPC->path());
michael@0 996 }
michael@0 997 if (defined($fileX86) && !defined($linkX86=readlink($fileX86->path()))) {
michael@0 998 return complain(1, 'makeUniversal: readlink x86: '.$!.' for:',
michael@0 999 $fileX86->path());
michael@0 1000 }
michael@0 1001 if (defined($filePPC) && defined($fileX86) && $linkPPC ne $linkX86) {
michael@0 1002 return complain(1, 'makeUniversal: symbolic links differ:',
michael@0 1003 $filePPC->path(),
michael@0 1004 $fileX86->path());
michael@0 1005 }
michael@0 1006
michael@0 1007 # $aLink here serves the same purpose as $aSourceFile in the enclosing
michael@0 1008 # block: it refers to the target of the symbolic link, whether there
michael@0 1009 # is one valid source or two.
michael@0 1010 my ($aLink);
michael@0 1011 if (defined($linkPPC)) {
michael@0 1012 $aLink = $linkPPC;
michael@0 1013 }
michael@0 1014 else {
michael@0 1015 $aLink = $linkX86;
michael@0 1016 }
michael@0 1017
michael@0 1018 if ($gVerbosity >= 3 || $gDryRun) {
michael@0 1019 print('ln -s '.
michael@0 1020 join(' ',argumentEscape($aLink, $fileTargetPath))."\n");
michael@0 1021 }
michael@0 1022 if (!$gDryRun && !symlink($aLink, $fileTargetPath)) {
michael@0 1023 return complain(1, 'makeUniversal: symlink: '.$!.' for:',
michael@0 1024 $aLink,
michael@0 1025 $fileTargetPath);
michael@0 1026 }
michael@0 1027
michael@0 1028 return 1;
michael@0 1029 }
michael@0 1030 elsif($aSourceFile->lIsRegularFile()) {
michael@0 1031 my ($machPPC, $machX86, $fileName);
michael@0 1032 if (!defined($filePPC) || !defined($fileX86)) {
michael@0 1033 # One of the source files isn't present. The right thing to do is
michael@0 1034 # to just copy what does exist straight over, so skip Mach-O checks.
michael@0 1035 $machPPC = 0;
michael@0 1036 $machX86 = 0;
michael@0 1037 if (defined($filePPC)) {
michael@0 1038 $fileName = $filePPC;
michael@0 1039 } elsif (defined($fileX86)) {
michael@0 1040 $fileName = $fileX86;
michael@0 1041 } else {
michael@0 1042 complain(1, "The file must exist in at least one directory");
michael@0 1043 exit(1);
michael@0 1044 }
michael@0 1045 }
michael@0 1046 else {
michael@0 1047 # both files exist, pick the name of one.
michael@0 1048 $fileName = $fileX86;
michael@0 1049 if (!defined($machPPC=$filePPC->isMachO())) {
michael@0 1050 return complain(1, 'makeUniversal: isFileMachO ppc failed for:',
michael@0 1051 $filePPC->path());
michael@0 1052 }
michael@0 1053 if (!defined($machX86=$fileX86->isMachO())) {
michael@0 1054 return complain(1, 'makeUniversal: isFileMachO x86 failed for:',
michael@0 1055 $fileX86->path());
michael@0 1056 }
michael@0 1057 }
michael@0 1058
michael@0 1059 if ($machPPC != $machX86) {
michael@0 1060 return complain(1, 'makeUniversal: variant Mach-O attributes:',
michael@0 1061 $filePPC->path(),
michael@0 1062 $fileX86->path());
michael@0 1063 }
michael@0 1064
michael@0 1065 if ($machPPC) {
michael@0 1066 # makeUniversalFile will print an error if it fails.
michael@0 1067 return makeUniversalFile($filePPC, $fileX86, $fileTargetPath);
michael@0 1068 }
michael@0 1069
michael@0 1070 if (grep { $fileName->path() =~ m/$_/; } @gSortMatches) {
michael@0 1071 # Regular files, but should be compared with sorting first.
michael@0 1072 # copyIfIdenticalWhenSorted will print an error if it fails.
michael@0 1073 return copyIfIdenticalWhenSorted($filePPC, $fileX86, $fileTargetPath);
michael@0 1074 }
michael@0 1075
michael@0 1076 # Regular file. copyIfIdentical will print an error if it fails.
michael@0 1077 return copyIfIdentical($filePPC, $fileX86, $fileTargetPath);
michael@0 1078 }
michael@0 1079
michael@0 1080 # Special file, don't know how to handle.
michael@0 1081 return complain(1, 'makeUniversal: cannot handle special file:',
michael@0 1082 $filePPC->path(),
michael@0 1083 $fileX86->path());
michael@0 1084 }
michael@0 1085
michael@0 1086 # usage()
michael@0 1087 #
michael@0 1088 # Give the user a hand.
michael@0 1089 sub usage() {
michael@0 1090 print STDERR (
michael@0 1091 "usage: unify <ppc-path> <x86-path> <universal-path>\n".
michael@0 1092 " [--dry-run] (print what would be done)\n".
michael@0 1093 " [--only-one <action>] (skip, copy, fail; default=copy)\n".
michael@0 1094 " [--verbosity <level>] (0, 1, 2, 3; default=2)\n");
michael@0 1095 return;
michael@0 1096 }
michael@0 1097
michael@0 1098 # readZipCRCs($zipFile)
michael@0 1099 #
michael@0 1100 # $zipFile is the pathname to a zip file whose directory will be read.
michael@0 1101 # A reference to a hash is returned, with the member pathnames from the
michael@0 1102 # zip file as keys, and reasonably unique identifiers as values. The
michael@0 1103 # format of the values is not specified exactly, but does include the
michael@0 1104 # member CRCs and sizes and differentiates between files and directories.
michael@0 1105 # It specifically does not distinguish between modification times. On
michael@0 1106 # failure, prints a message and returns undef.
michael@0 1107 sub readZipCRCs($) {
michael@0 1108 my ($zipFile);
michael@0 1109 ($zipFile) = @_;
michael@0 1110
michael@0 1111 my ($ze, $zip);
michael@0 1112 $zip = Archive::Zip->new();
michael@0 1113
michael@0 1114 if (($ze = $zip->read($zipFile)) != AZ_OK) {
michael@0 1115 complain(1, 'readZipCRCs: read error '.$ze.' for:',
michael@0 1116 $zipFile);
michael@0 1117 return undef;
michael@0 1118 }
michael@0 1119
michael@0 1120 my ($member, %memberCRCs, @memberList);
michael@0 1121 %memberCRCs = ();
michael@0 1122 @memberList = $zip->members();
michael@0 1123
michael@0 1124 foreach $member (@memberList) {
michael@0 1125 # Take a few of the attributes that identify the file and stuff them into
michael@0 1126 # the members hash. Directories will show up with size 0 and crc32 0,
michael@0 1127 # so isDirectory() is used to distinguish them from empty files.
michael@0 1128 $memberCRCs{$member->fileName()} = join(',', $member->isDirectory() ? 1 : 0,
michael@0 1129 $member->uncompressedSize(),
michael@0 1130 $member->crc32String());
michael@0 1131 }
michael@0 1132
michael@0 1133 return {%memberCRCs};
michael@0 1134 }
michael@0 1135
michael@0 1136 {
michael@0 1137 # FileAttrCache allows various attributes about a file to be cached
michael@0 1138 # so that if they are needed again after first use, no system calls
michael@0 1139 # will be made and the program won't need to hit the disk.
michael@0 1140
michael@0 1141 package FileAttrCache;
michael@0 1142
michael@0 1143 # from /usr/include/mach-o/loader.h
michael@0 1144 use constant MH_MAGIC => 0xfeedface;
michael@0 1145 use constant MH_CIGAM => 0xcefaedfe;
michael@0 1146 use constant MH_MAGIC_64 => 0xfeedfacf;
michael@0 1147 use constant MH_CIGAM_64 => 0xcffaedfe;
michael@0 1148
michael@0 1149 use Fcntl(':DEFAULT', ':mode');
michael@0 1150
michael@0 1151 # FileAttrCache->new($path)
michael@0 1152 #
michael@0 1153 # Creates a new FileAttrCache object for the file at path $path and
michael@0 1154 # returns it. The cache is not primed at creation time, values are
michael@0 1155 # fetched lazily as they are needed.
michael@0 1156 sub new($$) {
michael@0 1157 my ($class, $path, $proto, $this);
michael@0 1158 ($proto, $path) = @_;
michael@0 1159 if (!($class = ref($proto))) {
michael@0 1160 $class = $proto;
michael@0 1161 }
michael@0 1162 $this = {
michael@0 1163 'path' => $path,
michael@0 1164 'lstat' => undef,
michael@0 1165 'lstatErrno' => 0,
michael@0 1166 'lstatInit' => 0,
michael@0 1167 'magic' => undef,
michael@0 1168 'magic2' => undef,
michael@0 1169 'magicErrno' => 0,
michael@0 1170 'magicErrMsg' => undef,
michael@0 1171 'magicInit' => 0,
michael@0 1172 'stat' => undef,
michael@0 1173 'statErrno' => 0,
michael@0 1174 'statInit' => 0,
michael@0 1175 };
michael@0 1176 bless($this, $class);
michael@0 1177 return($this);
michael@0 1178 }
michael@0 1179
michael@0 1180 # $FileAttrCache->isFat()
michael@0 1181 #
michael@0 1182 # Returns true if the file is a fat Mach-O file, false if it's not, and
michael@0 1183 # undef if an error occurs. See /usr/include/mach-o/fat.h.
michael@0 1184 sub isFat($) {
michael@0 1185 my ($magic, $magic2, $this);
michael@0 1186 ($this) = @_;
michael@0 1187
michael@0 1188 # magic() caches, there's no separate cache because isFat() doesn't hit
michael@0 1189 # the disk other than by calling magic().
michael@0 1190
michael@0 1191 if (!defined($magic = $this->magic())) {
michael@0 1192 return undef;
michael@0 1193 }
michael@0 1194 $magic2 = $this->magic2();
michael@0 1195
michael@0 1196 # We have to sanity check the second four bytes, because Java class
michael@0 1197 # files use the same magic number as Mach-O fat binaries.
michael@0 1198 # This logic is adapted from file(1), which says that Mach-O uses
michael@0 1199 # these bytes to count the number of architectures within, while
michael@0 1200 # Java uses it for a version number. Conveniently, there are only
michael@0 1201 # 18 labelled Mach-O architectures, and Java's first released
michael@0 1202 # class format used the version 43.0.
michael@0 1203 if ($magic == 0xcafebabe && $magic2 < 20) {
michael@0 1204 return 1;
michael@0 1205 }
michael@0 1206
michael@0 1207 return 0;
michael@0 1208 }
michael@0 1209
michael@0 1210 # $FileAttrCache->isMachO()
michael@0 1211 #
michael@0 1212 # Returns true if the file is a Mach-O image (including a fat file), false
michael@0 1213 # if it's not, and undef if an error occurs. See
michael@0 1214 # /usr/include/mach-o/loader.h and /usr/include/mach-o/fat.h.
michael@0 1215 sub isMachO($) {
michael@0 1216 my ($magic, $this);
michael@0 1217 ($this) = @_;
michael@0 1218
michael@0 1219 # magic() caches, there's no separate cache because isMachO() doesn't hit
michael@0 1220 # the disk other than by calling magic().
michael@0 1221
michael@0 1222 if (!defined($magic = $this->magic())) {
michael@0 1223 return undef;
michael@0 1224 }
michael@0 1225
michael@0 1226 # Accept Mach-O fat files or Mach-O thin files of either endianness.
michael@0 1227 if ($magic == MH_MAGIC ||
michael@0 1228 $magic == MH_CIGAM ||
michael@0 1229 $magic == MH_MAGIC_64 ||
michael@0 1230 $magic == MH_CIGAM_64 ||
michael@0 1231 $this->isFat()) {
michael@0 1232 return 1;
michael@0 1233 }
michael@0 1234
michael@0 1235 return 0;
michael@0 1236 }
michael@0 1237
michael@0 1238 # $FileAttrCache->isZip()
michael@0 1239 #
michael@0 1240 # Returns true if the file is a zip file, false if it's not, and undef if
michael@0 1241 # an error occurs. See http://www.pkware.com/business_and_developers/developer/popups/appnote.txt .
michael@0 1242 sub isZip($) {
michael@0 1243 my ($magic, $this);
michael@0 1244 ($this) = @_;
michael@0 1245
michael@0 1246 # magic() caches, there's no separate cache because isFat() doesn't hit
michael@0 1247 # the disk other than by calling magic().
michael@0 1248
michael@0 1249 if (!defined($magic = $this->magic())) {
michael@0 1250 return undef;
michael@0 1251 }
michael@0 1252
michael@0 1253 if ($magic == 0x504b0304) {
michael@0 1254 return 1;
michael@0 1255 }
michael@0 1256
michael@0 1257 return 0;
michael@0 1258 }
michael@0 1259
michael@0 1260 # $FileAttrCache->lIsExecutable()
michael@0 1261 #
michael@0 1262 # Wraps $FileAttrCache->lstat(), returning true if the file is has any,
michael@0 1263 # execute bit set, false if none are set, or undef if an error occurs.
michael@0 1264 # On error, $! is set to lstat's errno.
michael@0 1265 sub lIsExecutable($) {
michael@0 1266 my ($mode, $this);
michael@0 1267 ($this) = @_;
michael@0 1268
michael@0 1269 if (!defined($mode = $this->lstatMode())) {
michael@0 1270 return undef;
michael@0 1271 }
michael@0 1272
michael@0 1273 return $mode & (S_IXUSR | S_IXGRP | S_IXOTH);
michael@0 1274 }
michael@0 1275
michael@0 1276 # $FileAttrCache->lIsDir()
michael@0 1277 #
michael@0 1278 # Wraps $FileAttrCache->lstat(), returning true if the file is a directory,
michael@0 1279 # false if it isn't, or undef if an error occurs. Because lstat is used,
michael@0 1280 # this will return false even if the file is a symlink pointing to a
michael@0 1281 # directory. On error, $! is set to lstat's errno.
michael@0 1282 sub lIsDir($) {
michael@0 1283 my ($type, $this);
michael@0 1284 ($this) = @_;
michael@0 1285
michael@0 1286 if (!defined($type = $this->lstatType())) {
michael@0 1287 return undef;
michael@0 1288 }
michael@0 1289
michael@0 1290 return S_ISDIR($type);
michael@0 1291 }
michael@0 1292
michael@0 1293 # $FileAttrCache->lIsRegularFile()
michael@0 1294 #
michael@0 1295 # Wraps $FileAttrCache->lstat(), returning true if the file is a regular,
michael@0 1296 # file, false if it isn't, or undef if an error occurs. Because lstat is
michael@0 1297 # used, this will return false even if the file is a symlink pointing to a
michael@0 1298 # regular file. On error, $! is set to lstat's errno.
michael@0 1299 sub lIsRegularFile($) {
michael@0 1300 my ($type, $this);
michael@0 1301 ($this) = @_;
michael@0 1302
michael@0 1303 if (!defined($type = $this->lstatType())) {
michael@0 1304 return undef;
michael@0 1305 }
michael@0 1306
michael@0 1307 return S_ISREG($type);
michael@0 1308 }
michael@0 1309
michael@0 1310 # $FileAttrCache->lIsSymLink()
michael@0 1311 #
michael@0 1312 # Wraps $FileAttrCache->lstat(), returning true if the file is a symbolic,
michael@0 1313 # link, false if it isn't, or undef if an error occurs. On error, $! is
michael@0 1314 # set to lstat's errno.
michael@0 1315 sub lIsSymLink($) {
michael@0 1316 my ($type, $this);
michael@0 1317 ($this) = @_;
michael@0 1318
michael@0 1319 if (!defined($type = $this->lstatType())) {
michael@0 1320 return undef;
michael@0 1321 }
michael@0 1322
michael@0 1323 return S_ISLNK($type);
michael@0 1324 }
michael@0 1325
michael@0 1326 # $FileAttrCache->lstat()
michael@0 1327 #
michael@0 1328 # Wraps the lstat system call, providing a cache to speed up multiple
michael@0 1329 # lstat calls for the same file. See lstat(2) and lstat in perlfunc(1).
michael@0 1330 sub lstat($) {
michael@0 1331 my (@stat, $this);
michael@0 1332 ($this) = @_;
michael@0 1333
michael@0 1334 # Use the cached lstat result.
michael@0 1335 if ($$this{'lstatInit'}) {
michael@0 1336 if (defined($$this{'lstatErrno'})) {
michael@0 1337 $! = $$this{'lstatErrno'};
michael@0 1338 }
michael@0 1339 return @{$$this{'lstat'}};
michael@0 1340 }
michael@0 1341 $$this{'lstatInit'} = 1;
michael@0 1342
michael@0 1343 if (!(@stat = CORE::lstat($$this{'path'}))) {
michael@0 1344 $$this{'lstatErrno'} = $!;
michael@0 1345 }
michael@0 1346
michael@0 1347 $$this{'lstat'} = [@stat];
michael@0 1348 return @stat;
michael@0 1349 }
michael@0 1350
michael@0 1351 # $FileAttrCache->lstatMode()
michael@0 1352 #
michael@0 1353 # Wraps $FileAttrCache->lstat(), returning the mode bits from the st_mode
michael@0 1354 # field, or undef if an error occurs. On error, $! is set to lstat's
michael@0 1355 # errno.
michael@0 1356 sub lstatMode($) {
michael@0 1357 my (@stat, $this);
michael@0 1358 ($this) = @_;
michael@0 1359
michael@0 1360 if (!(@stat = $this->lstat())) {
michael@0 1361 return undef;
michael@0 1362 }
michael@0 1363
michael@0 1364 return S_IMODE($stat[2]);
michael@0 1365 }
michael@0 1366
michael@0 1367 # $FileAttrCache->lstatType()
michael@0 1368 #
michael@0 1369 # Wraps $FileAttrCache->lstat(), returning the type bits from the st_mode
michael@0 1370 # field, or undef if an error occurs. On error, $! is set to lstat's
michael@0 1371 # errno.
michael@0 1372 sub lstatType($) {
michael@0 1373 my (@stat, $this);
michael@0 1374 ($this) = @_;
michael@0 1375
michael@0 1376 if (!(@stat = $this->lstat())) {
michael@0 1377 return undef;
michael@0 1378 }
michael@0 1379
michael@0 1380 return S_IFMT($stat[2]);
michael@0 1381 }
michael@0 1382
michael@0 1383 # $FileAttrCache->magic()
michael@0 1384 #
michael@0 1385 # Returns the "magic number" for the file by reading its first four bytes
michael@0 1386 # as a big-endian unsigned 32-bit integer and returning the result. If an
michael@0 1387 # error occurs, returns undef and prints diagnostic messages to stderr. If
michael@0 1388 # the file is shorter than 32 bits, returns -1. A cache is provided to
michael@0 1389 # speed multiple magic calls for the same file.
michael@0 1390 sub magic($) {
michael@0 1391 my ($this);
michael@0 1392 ($this) = @_;
michael@0 1393
michael@0 1394 # Use the cached magic result.
michael@0 1395 if ($$this{'magicInit'}) {
michael@0 1396 if (defined($$this{'magicErrno'})) {
michael@0 1397 if (defined($$this{'magicErrMsg'})) {
michael@0 1398 complain(1, 'FileAttrCache::magic: '.$$this{'magicErrMsg'}.' for:',
michael@0 1399 $$this{'path'});
michael@0 1400 }
michael@0 1401 $! = $$this{'magicErrno'};
michael@0 1402 }
michael@0 1403 return $$this{'magic'};
michael@0 1404 }
michael@0 1405
michael@0 1406 $$this{'magicInit'} = 1;
michael@0 1407
michael@0 1408 my ($fh);
michael@0 1409 if (!sysopen($fh, $$this{'path'}, O_RDONLY)) {
michael@0 1410 $$this{'magicErrno'} = $!;
michael@0 1411 $$this{'magicErrMsg'} = 'open "'.$$this{'path'}.'": '.$!;
michael@0 1412 complain(1, 'FileAttrCache::magic: '.$$this{'magicErrMsg'}.' for:',
michael@0 1413 $$this{'path'});
michael@0 1414 return undef;
michael@0 1415 }
michael@0 1416
michael@0 1417 $! = 0;
michael@0 1418 my ($bytes, $magic, $bytes2, $magic2);
michael@0 1419 if (!defined($bytes = sysread($fh, $magic, 4))) {
michael@0 1420 $$this{'magicErrno'} = $!;
michael@0 1421 $$this{'magicErrMsg'} = 'read "'.$$this{'path'}.'": '.$!;
michael@0 1422 complain(1, 'FileAttrCache::magic: '.$$this{'magicErrMsg'}.' for:',
michael@0 1423 $$this{'path'});
michael@0 1424 close($fh);
michael@0 1425 return undef;
michael@0 1426 }
michael@0 1427 else {
michael@0 1428 $bytes2 = sysread($fh, $magic2, 4);
michael@0 1429 }
michael@0 1430
michael@0 1431 close($fh);
michael@0 1432
michael@0 1433 if ($bytes != 4) {
michael@0 1434 # The file is too short, didn't read a magic number. This isn't really
michael@0 1435 # an error. Return an unlikely value.
michael@0 1436 $$this{'magic'} = -1;
michael@0 1437 $$this{'magic2'} = -1;
michael@0 1438 return -1;
michael@0 1439 }
michael@0 1440 if ($bytes2 != 4) {
michael@0 1441 # File is too short to read a second 4 bytes.
michael@0 1442 $magic2 = -1;
michael@0 1443 }
michael@0 1444
michael@0 1445 $$this{'magic'} = unpack('N', $magic);
michael@0 1446 $$this{'magic2'} = unpack('N', $magic2);
michael@0 1447 return $$this{'magic'};
michael@0 1448 }
michael@0 1449
michael@0 1450 # $FileAttrCache->magic2()
michael@0 1451 #
michael@0 1452 # Returns the second four bytes of the file as a 32-bit little endian number.
michael@0 1453 # See magic(), above for more info.
michael@0 1454 sub magic2($) {
michael@0 1455 my ($this);
michael@0 1456 ($this) = @_;
michael@0 1457
michael@0 1458 # we do the actual work (and cache it) in magic().
michael@0 1459 if (!$$this{'magicInit'}) {
michael@0 1460 my $magic = $$this->magic();
michael@0 1461 }
michael@0 1462
michael@0 1463 return $$this{'magic2'};
michael@0 1464 }
michael@0 1465
michael@0 1466 # $FileAttrCache->path()
michael@0 1467 #
michael@0 1468 # Returns the file's pathname.
michael@0 1469 sub path($) {
michael@0 1470 my ($this);
michael@0 1471 ($this) = @_;
michael@0 1472 return $$this{'path'};
michael@0 1473 }
michael@0 1474
michael@0 1475 # $FileAttrCache->stat()
michael@0 1476 #
michael@0 1477 # Wraps the stat system call, providing a cache to speed up multiple
michael@0 1478 # stat calls for the same file. If lstat() has already been called and
michael@0 1479 # the file is not a symbolic link, the cached lstat() result will be used.
michael@0 1480 # See stat(2) and lstat in perlfunc(1).
michael@0 1481 sub stat($) {
michael@0 1482 my (@stat, $this);
michael@0 1483 ($this) = @_;
michael@0 1484
michael@0 1485 # Use the cached stat result.
michael@0 1486 if ($$this{'statInit'}) {
michael@0 1487 if (defined($$this{'statErrno'})) {
michael@0 1488 $! = $$this{'statErrno'};
michael@0 1489 }
michael@0 1490 return @{$$this{'stat'}};
michael@0 1491 }
michael@0 1492
michael@0 1493 $$this{'statInit'} = 1;
michael@0 1494
michael@0 1495 # If lstat has already been called, and the file isn't a symbolic link,
michael@0 1496 # use the cached lstat result.
michael@0 1497 if ($$this{'lstatInit'} && !$$this{'lstatErrno'} &&
michael@0 1498 !S_ISLNK(${$$this{'lstat'}}[2])) {
michael@0 1499 $$this{'stat'} = $$this{'lstat'};
michael@0 1500 return @{$$this{'stat'}};
michael@0 1501 }
michael@0 1502
michael@0 1503 if (!(@stat = CORE::stat($$this{'path'}))) {
michael@0 1504 $$this{'statErrno'} = $!;
michael@0 1505 }
michael@0 1506
michael@0 1507 $$this{'stat'} = [@stat];
michael@0 1508 return @stat;
michael@0 1509 }
michael@0 1510
michael@0 1511 # $FileAttrCache->statSize()
michael@0 1512 #
michael@0 1513 # Wraps $FileAttrCache->stat(), returning the st_size field, or undef
michael@0 1514 # undef if an error occurs. On error, $! is set to stat's errno.
michael@0 1515 sub statSize($) {
michael@0 1516 my (@stat, $this);
michael@0 1517 ($this) = @_;
michael@0 1518
michael@0 1519 if (!(@stat = $this->lstat())) {
michael@0 1520 return undef;
michael@0 1521 }
michael@0 1522
michael@0 1523 return $stat[7];
michael@0 1524 }
michael@0 1525 }

mercurial