package/pkg-dmg

   1 #!/usr/bin/perl
   2 # ***** BEGIN LICENSE BLOCK *****
   3 # Version: MPL 1.1/GPL 2.0/LGPL 2.1
   4 #
   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/
   9 #
  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
  13 # License.
  14 #
  15 # The Original Code is pkg-dmg, a Mac OS X disk image (.dmg) packager
  16 #
  17 # The Initial Developer of the Original Code is
  18 # Mark Mentovai <mark@moxienet.com>.
  19 # Portions created by the Initial Developer are Copyright (C) 2005
  20 # the Initial Developer. All Rights Reserved.
  21 #
  22 # Contributor(s):
  23 #
  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.
  35 #
  36 # ***** END LICENSE BLOCK *****
  37
  38 use strict;
  39 use warnings;
  40
  41 =pod
  42
  43 =head1 NAME
  44
  45 B<pkg-dmg> - Mac OS X disk image (.dmg) packager
  46
  47 =head1 SYNOPSIS
  48
  49 B<pkg-dmg>
  50 B<--source> I<source-folder>
  51 B<--target> I<target-image>
  52 [B<--format> I<format>]
  53 [B<--volname> I<volume-name>]
  54 [B<--tempdir> I<temp-dir>]
  55 [B<--mkdir> I<directory>]
  56 [B<--copy> I<source>[:I<dest>]]
  57 [B<--symlink> I<source>[:I<dest>]]
  58 [B<--license> I<file>]
  59 [B<--resource> I<file>]
  60 [B<--icon> I<icns-file>]
  61 [B<--attribute> I<a>:I<file>[:I<file>...]
  62 [B<--idme>]
  63 [B<--sourcefile>]
  64 [B<--verbosity> I<level>]
  65 [B<--dry-run>]
  66
  67 =head1 DESCRIPTION
  68
  69 I<pkg-dmg> takes a directory identified by I<source-folder> and transforms
  70 it into a disk image stored as I<target-image>.  The disk image will
  71 occupy the least space possible for its format, or the least space that the
  72 authors have been able to figure out how to achieve.
  73
  74 =head1 OPTIONS
  75
  76 =over 5
  77
  78 ==item B<--source> I<source-folder>
  79
  80 Identifies the directory that will be packaged up.  This directory is not
  81 touched, a copy will be made in a temporary directory for staging purposes.
  82 See B<--tempdir>.
  83
  84 ==item B<--target> I<target-image>
  85
  86 The disk image to create.  If it exists and is not in use, it will be
  87 overwritten.  If I<target-image> already contains a suitable extension,
  88 it will be used unmodified.  If no extension is present, or the extension
  89 is incorrect for the selected format, the proper extension will be added.
  90 See B<--format>.
  91
  92 ==item B<--format> I<format>
  93
  94 The format to create the disk image in.  Valid values for I<format> are:
  95      - UDZO - zlib-compressed, read-only; extension I<.dmg>
  96      - UDBZ - bzip2-compressed, read-only; extension I<.dmg>;
  97               create and use on 10.4 ("Tiger") and later only
  98      - UDRW - read-write; extension I<.dmg>
  99      - UDSP - read-write, sparse; extension I<.sparseimage>
 100
 101 UDZO is the default format.
 102
 103 See L<hdiutil(1)> for a description of these formats.
 104
 105 =item B<--volname> I<volume-name>
 106
 107 The name of the volume in the disk image.  If not specified, I<volume-name>
 108 defaults to the name of the source directory from B<--source>.
 109
 110 =item B<--tempdir> I<temp-dir>
 111
 112 A temporary directory to stage intermediate files in.  I<temp-dir> must
 113 have enough space available to accommodate twice the size of the files
 114 being packaged.  If not specified, defaults to the same directory that
 115 the I<target-image> is to be placed in.  B<pkg-dmg> will remove any
 116 temporary files it places in I<temp-dir>.
 117
 118 =item B<--mkdir> I<directory>
 119
 120 Specifies a directory that should be created in the disk image.
 121 I<directory> and any ancestor directories will be created.  This is
 122 useful in conjunction with B<--copy>, when copying files to directories
 123 that may not exist in I<source-folder>.  B<--mkdir> may appear multiple
 124 times.
 125
 126 =item B<--copy> I<source>[:I<dest>]
 127
 128 Additional files to copy into the disk image.  If I<dest> is
 129 specified, I<source> is copied to the location I<dest> identifies,
 130 otherwise, I<source> is copied to the root of the new volume.  B<--copy>
 131 provides a way to package up a I<source-folder> by adding files to it
 132 without modifying the original I<source-folder>.  B<--copy> may appear
 133 multiple times.
 134
 135 This option is useful for adding .DS_Store files and window backgrounds
 136 to disk images.
 137
 138 =item B<--symlink> I<source>[:I<dest>]
 139
 140 Like B<--copy>, but allows symlinks to point out of the volume. Empty symlink
 141 destinations are interpreted as "like the source path, but inside the dmg"
 142
 143 This option is useful for adding symlinks to external resources,
 144 e.g. to /Applications.
 145
 146 =item B<--license> I<file>
 147
 148 A plain text file containing a license agreement to be displayed before
 149 the disk image is mounted.  English is the only supported language.  To
 150 include license agreements in other languages, in multiple languages,
 151 or to use formatted text, prepare a resource and use L<--resource>.
 152
 153 =item B<--resource> I<file>
 154
 155 A resource file to merge into I<target-image>.  If I<format> is UDZO or
 156 UDBZ, the disk image will be flattened to a single-fork file that contains
 157 the resource but may be freely transferred without any special encodings.
 158 I<file> must be in a format suitable for L<Rez(1)>.  See L<Rez(1)> for a
 159 description of the format, and L<hdiutil(1)> for a discussion on flattened
 160 disk images.  B<--resource> may appear multiple times.
 161
 162 This option is useful for adding license agreements and other messages
 163 to disk images.
 164
 165 =item B<--icon> I<icns-file>
 166
 167 Specifies an I<icns> file that will be used as the icon for the root of
 168 the volume.  This file will be copied to the new volume and the custom
 169 icon attribute will be set on the root folder.
 170
 171 =item B<--attribute> I<a>:I<file>[:I<file>...]
 172
 173 Sets the attributes of I<file> to the attribute list in I<a>.  See
 174 L<SetFile(1)>
 175
 176 =item B<--idme>
 177
 178 Enable IDME to make the disk image "Internet-enabled."  The first time
 179 the image is mounted, if IDME processing is enabled on the system, the
 180 contents of the image will be copied out of the image and the image will
 181 be placed in the trash with IDME disabled.
 182
 183 =item B<--sourcefile>
 184
 185 If this option is present, I<source-folder> is treated as a file, and is
 186 placed as a file within the volume's root folder.  Without this option,
 187 I<source-folder> is treated as the volume root itself.
 188
 189 =item B<--verbosity> I<level>
 190
 191 Adjusts the level of loudness of B<pkg-dmg>.  The possible values for
 192 I<level> are:
 193      0 - Only error messages are displayed.
 194      1 - Print error messages and command invocations.
 195      2 - Print everything, including command output.
 196
 197 The default I<level> is 2.
 198
 199 =item B<--dry-run>
 200
 201 When specified, the commands that would be executed are printed, without
 202 actually executing them.  When commands depend on the output of previous
 203 commands, dummy values are displayed.
 204
 205 =back
 206
 207 =head1 NON-OPTIONS
 208
 209 =over 5
 210
 211 =item
 212
 213 Resource forks aren't copied.
 214
 215 =item
 216
 217 The root folder of the created volume is designated as the folder
 218 to open when the volume is mounted.  See L<bless(8)>.
 219
 220 =item
 221
 222 All files in the volume are set to be world-readable, only writable
 223 by the owner, and world-executable when appropriate.  All other
 224 permissions bits are cleared.
 225
 226 =item
 227
 228 When possible, disk images are created without any partition tables.  This
 229 is what L<hdiutil(1)> refers to as I<-layout NONE>, and saves a handful of
 230 kilobytes.  The alternative, I<SPUD>, contains a partition table that
 231 is not terribly handy on disk images that are not intended to represent any
 232 physical disk.
 233
 234 =item
 235
 236 Read-write images are created with journaling off.  Any read-write image
 237 created by this tool is expected to be transient, and the goal of this tool
 238 is to create images which consume a minimum of space.
 239
 240 =back
 241
 242 =head1 EXAMPLE
 243
 244 pkg-dmg --source /Applications/DeerPark.app --target ~/DeerPark.dmg
 245   --sourcefile --volname DeerPark --icon ~/DeerPark.icns
 246   --mkdir /.background
 247   --copy DeerParkBackground.png:/.background/background.png
 248   --copy DeerParkDSStore:/.DS_Store
 249   --symlink /Applications:"/Drag to here"
 250
 251 =head1 REQUIREMENTS
 252
 253 I<pkg-dmg> has been tested with Mac OS X releases 10.2 ("Jaguar")
 254 through 10.4 ("Tiger").  Certain adjustments to behavior are made
 255 depending on the host system's release.  Mac OS X 10.3 ("Panther") or
 256 later are recommended.
 257
 258 =head1 LICENSE
 259
 260 MPL 1.1/GPL 2.0/LGPL 2.1.  Your choice.
 261
 262 =head1 AUTHOR
 263
 264 Mark Mentovai
 265
 266 =head1 SEE ALSO
 267
 268 L<bless(8)>, L<diskutil(8)>, L<hdid(8)>, L<hdiutil(1)>, L<Rez(1)>,
 269 L<rsync(1)>, L<SetFile(1)>
 270
 271 =cut
 272
 273 use Fcntl;
 274 use POSIX;
 275 use Getopt::Long;
 276
 277 sub argumentEscape(@);
 278 sub cleanupDie($);
 279 sub command(@);
 280 sub commandInternal($@);
 281 sub commandInternalVerbosity($$@);
 282 sub commandOutput(@);
 283 sub commandOutputVerbosity($@);
 284 sub commandVerbosity($@);
 285 sub copyFiles($@);
 286 sub diskImageMaker($$$$$$$$);
 287 sub giveExtension($$);
 288 sub hdidMountImage($@);
 289 sub isFormatCompressed($);
 290 sub licenseMaker($$);
 291 sub pathSplit($);
 292 sub setAttributes($@);
 293 sub trapSignal($);
 294 sub usage();
 295
 296 # Variables used as globals
 297 my(@gCleanup, %gConfig, $gDarwinMajor, $gDryRun, $gVerbosity);
 298
 299 # Use the commands by name if they're expected to be in the user's
 300 # $PATH (/bin:/sbin:/usr/bin:/usr/sbin).  Otherwise, go by absolute
 301 # path.  These may be overridden with --config.
 302 %gConfig = ('cmd_bless'          => 'bless',
 303             'cmd_chmod'          => 'chmod',
 304             'cmd_diskutil'       => 'diskutil',
 305             'cmd_du'             => 'du',
 306             'cmd_hdid'           => 'hdid',
 307             'cmd_hdiutil'        => 'hdiutil',
 308             'cmd_mkdir'          => 'mkdir',
 309             'cmd_mktemp'         => 'mktemp',
 310             'cmd_Rez'            => '/Developer/Tools/Rez',
 311             'cmd_rm'             => 'rm',
 312             'cmd_rsync'          => 'rsync',
 313             'cmd_SetFile'        => '/Developer/Tools/SetFile',
 314
 315             # create_directly indicates whether hdiutil create supports
 316             # -srcfolder and -srcdevice.  It does on >= 10.3 (Panther).
 317             # This is fixed up for earlier systems below.  If false,
 318             # hdiutil create is used to create empty disk images that
 319             # are manually filled.
 320             'create_directly'    => 1,
 321
 322             # If hdiutil attach -mountpoint exists, use it to avoid
 323             # mounting disk images in the default /Volumes.  This reduces
 324             # the likelihood that someone will notice a mounted image and
 325             # interfere with it.  Only available on >= 10.3 (Panther),
 326             # fixed up for earlier systems below.
 327             #
 328             # This is presently turned off for all systems, because there
 329             # is an infrequent synchronization problem during ejection.
 330             # diskutil eject might return before the image is actually
 331             # unmounted.  If pkg-dmg then attempts to clean up its
 332             # temporary directory, it could remove items from a read-write
 333             # disk image or attempt to remove items from a read-only disk
 334             # image (or a read-only item from a read-write image) and fail,
 335             # causing pkg-dmg to abort.  This problem is experienced
 336             # under Tiger, which appears to eject asynchronously where
 337             # previous systems treated it as a synchronous operation.
 338             # Using hdiutil attach -mountpoint didn't always keep images
 339             # from showing up on the desktop anyway.
 340             'hdiutil_mountpoint' => 0,
 341
 342             # hdiutil makehybrid results in optimized disk images that
 343             # consume less space and mount more quickly.  Use it when
 344             # it's available, but that's only on >= 10.3 (Panther).
 345             # If false, hdiutil create is used instead.  Fixed up for
 346             # earlier systems below.
 347             'makehybrid'         => 1,
 348
 349             # hdiutil create doesn't allow specifying a folder to open
 350             # at volume mount time, so those images are mounted and
 351             # their root folders made holy with bless -openfolder.  But
 352             # only on >= 10.3 (Panther).  Earlier systems are out of luck.
 353             # Even on Panther, bless refuses to run unless root.
 354             # Fixed up below.
 355             'openfolder_bless'   => 1,
 356
 357             # It's possible to save a few more kilobytes by including the
 358             # partition only without any partition table in the image.
 359             # This is a good idea on any system, so turn this option off.
 360             #
 361             # Except it's buggy.  "-layout NONE" seems to be creating
 362             # disk images with more data than just the partition table
 363             # stripped out.  You might wind up losing the end of the
 364             # filesystem - the last file (or several) might be incomplete.
 365             'partition_table'    => 1,
 366
 367             # To create a partition table-less image from something
 368             # created by makehybrid, the hybrid image needs to be
 369             # mounted and a new image made from the device associated
 370             # with the relevant partition.  This requires >= 10.4
 371             # (Tiger), presumably because earlier systems have
 372             # problems creating images from devices themselves attached
 373             # to images.  If this is false, makehybrid images will
 374             # have partition tables, regardless of the partition_table
 375             # setting.  Fixed up for earlier systems below.
 376             'recursive_access'   => 1);
 377
 378 # --verbosity
 379 $gVerbosity = 2;
 380
 381 # --dry-run
 382 $gDryRun = 0;
 383
 384 # %gConfig fix-ups based on features and bugs present in certain releases.
 385 my($ignore, $uname_r, $uname_s);
 386 ($uname_s, $ignore, $uname_r, $ignore, $ignore) = POSIX::uname();
 387 if($uname_s eq 'Darwin') {
 388   ($gDarwinMajor, $ignore) = split(/\./, $uname_r, 2);
 389
 390   # $major is the Darwin major release, which for our purposes, is 4 higher
 391   # than the interesting digit in a Mac OS X release.
 392   if($gDarwinMajor <= 6) {
 393     # <= 10.2 (Jaguar)
 394     # hdiutil create does not support -srcfolder or -srcdevice
 395     $gConfig{'create_directly'} = 0;
 396     # hdiutil attach does not support -mountpoint
 397     $gConfig{'hdiutil_mountpoint'} = 0;
 398     # hdiutil mkhybrid does not exist
 399     $gConfig{'makehybrid'} = 0;
 400   }
 401   if($gDarwinMajor <= 7) {
 402     # <= 10.3 (Panther)
 403     # Can't mount a disk image and then make a disk image from the device
 404     $gConfig{'recursive_access'} = 0;
 405     # bless does not support -openfolder on 10.2 (Jaguar) and must run
 406     # as root under 10.3 (Panther)
 407     $gConfig{'openfolder_bless'} = 0;
 408   }
 409 }
 410 else {
 411   # If it's not Mac OS X, just assume all of those good features are
 412   # available.  They're not, but things will fail long before they
 413   # have a chance to make a difference.
 414   #
 415   # Now, if someone wanted to document some of these private formats...
 416   print STDERR ($0.": warning, not running on Mac OS X, ".
 417    "this could be interesting.\n");
 418 }
 419
 420 # Non-global variables used in Getopt
 421 my(@attributes, @copyFiles, @createSymlinks, $iconFile, $idme, $licenseFile,
 422  @makeDirs, $outputFormat, @resourceFiles, $sourceFile, $sourceFolder,
 423  $targetImage, $tempDir, $volumeName);
 424
 425 # --format
 426 $outputFormat = 'UDZO';
 427
 428 # --idme
 429 $idme = 0;
 430
 431 # --sourcefile
 432 $sourceFile = 0;
 433
 434 # Leaving this might screw up the Apple tools.
 435 delete $ENV{'NEXT_ROOT'};
 436
 437 # This script can get pretty messy, so trap a few signals.
 438 $SIG{'INT'} = \&trapSignal;
 439 $SIG{'HUP'} = \&trapSignal;
 440 $SIG{'TERM'} = \&trapSignal;
 441
 442 Getopt::Long::Configure('pass_through');
 443 GetOptions('source=s'    => \$sourceFolder,
 444            'target=s'    => \$targetImage,
 445            'volname=s'   => \$volumeName,
 446            'format=s'    => \$outputFormat,
 447            'tempdir=s'   => \$tempDir,
 448            'mkdir=s'     => \@makeDirs,
 449            'copy=s'      => \@copyFiles,
 450            'symlink=s'   => \@createSymlinks,
 451            'license=s'   => \$licenseFile,
 452            'resource=s'  => \@resourceFiles,
 453            'icon=s'      => \$iconFile,
 454            'attribute=s' => \@attributes,
 455            'idme'        => \$idme,
 456            'sourcefile'  => \$sourceFile,
 457            'verbosity=i' => \$gVerbosity,
 458            'dry-run'     => \$gDryRun,
 459            'config=s'    => \%gConfig); # "hidden" option not in usage()
 460
 461 if(@ARGV) {
 462   # All arguments are parsed by Getopt
 463   usage();
 464   exit(1);
 465 }
 466
 467 if($gVerbosity<0 || $gVerbosity>2) {
 468   usage();
 469   exit(1);
 470 }
 471
 472 if(!defined($sourceFolder) || $sourceFolder eq '' ||
 473  !defined($targetImage) || $targetImage eq '') {
 474   # --source and --target are required arguments
 475   usage();
 476   exit(1);
 477 }
 478
 479 # Make sure $sourceFolder doesn't contain trailing slashes.  It messes with
 480 # rsync.
 481 while(substr($sourceFolder, -1) eq '/') {
 482   chop($sourceFolder);
 483 }
 484
 485 if(!defined($volumeName)) {
 486   # Default volumeName is the name of the source directory.
 487   my(@components);
 488   @components = pathSplit($sourceFolder);
 489   $volumeName = pop(@components);
 490 }
 491
 492 my(@tempDirComponents, $targetImageFilename);
 493 @tempDirComponents = pathSplit($targetImage);
 494 $targetImageFilename = pop(@tempDirComponents);
 495
 496 if(defined($tempDir)) {
 497   @tempDirComponents = pathSplit($tempDir);
 498 }
 499 else {
 500   # Default tempDir is the same directory as what is specified for
 501   # targetImage
 502   $tempDir = join('/', @tempDirComponents);
 503 }
 504
 505 # Ensure that the path of the target image has a suitable extension.  If
 506 # it didn't, hdiutil would add one, and we wouldn't be able to find the
 507 # file.
 508 #
 509 # Note that $targetImageFilename is not being reset.  This is because it's
 510 # used to build other names below, and we don't need to be adding all sorts
 511 # of extra unnecessary extensions to the name.
 512 my($originalTargetImage, $requiredExtension);
 513 $originalTargetImage = $targetImage;
 514 if($outputFormat eq 'UDSP') {
 515   $requiredExtension = '.sparseimage';
 516 }
 517 else {
 518   $requiredExtension = '.dmg';
 519 }
 520 $targetImage = giveExtension($originalTargetImage, $requiredExtension);
 521
 522 if($targetImage ne $originalTargetImage) {
 523   print STDERR ($0.": warning: target image extension is being added\n");
 524   print STDERR ('  The new filename is '.
 525    giveExtension($targetImageFilename,$requiredExtension)."\n");
 526 }
 527
 528 # Make a temporary directory in $tempDir for our own nefarious purposes.
 529 my(@output, $tempSubdir, $tempSubdirTemplate);
 530 $tempSubdirTemplate=join('/', @tempDirComponents,
 531  'pkg-dmg.'.$$.'.XXXXXXXX');
 532 if(!(@output = commandOutput($gConfig{'cmd_mktemp'}, '-d',
 533  $tempSubdirTemplate)) || $#output != 0) {
 534   cleanupDie('mktemp failed');
 535 }
 536
 537 if($gDryRun) {
 538   (@output)=($tempSubdirTemplate);
 539 }
 540
 541 ($tempSubdir) = @output;
 542
 543 push(@gCleanup,
 544  sub {commandVerbosity(0, $gConfig{'cmd_rm'}, '-rf', $tempSubdir);});
 545
 546 my($tempMount, $tempRoot, @tempsToMake);
 547 $tempRoot = $tempSubdir.'/stage';
 548 $tempMount = $tempSubdir.'/mount';
 549 push(@tempsToMake, $tempRoot);
 550 if($gConfig{'hdiutil_mountpoint'}) {
 551   push(@tempsToMake, $tempMount);
 552 }
 553
 554 if(command($gConfig{'cmd_mkdir'}, @tempsToMake) != 0) {
 555   cleanupDie('mkdir tempRoot/tempMount failed');
 556 }
 557
 558 # This cleanup object is not strictly necessary, because $tempRoot is inside
 559 # of $tempSubdir, but the rest of the script relies on this object being
 560 # on the cleanup stack and expects to remove it.
 561 push(@gCleanup,
 562  sub {commandVerbosity(0, $gConfig{'cmd_rm'}, '-rf', $tempRoot);});
 563
 564 # If $sourceFile is true, it means that $sourceFolder is to be treated as
 565 # a file and placed as a file within the volume root, as opposed to being
 566 # treated as the volume root itself.  rsync will do this by default, if no
 567 # trailing '/' is present.  With a trailing '/', $sourceFolder becomes
 568 # $tempRoot, instead of becoming an entry in $tempRoot.
 569 if(command($gConfig{'cmd_rsync'}, '-a', '--copy-unsafe-links',
 570  $sourceFolder.($sourceFile?'':'/'),$tempRoot) != 0) {
 571   cleanupDie('rsync failed');
 572 }
 573
 574 if(@makeDirs) {
 575   my($makeDir, @tempDirsToMake);
 576   foreach $makeDir (@makeDirs) {
 577     if($makeDir =~ /^\//) {
 578       push(@tempDirsToMake, $tempRoot.$makeDir);
 579     }
 580     else {
 581       push(@tempDirsToMake, $tempRoot.'/'.$makeDir);
 582     }
 583   }
 584   if(command($gConfig{'cmd_mkdir'}, '-p', @tempDirsToMake) != 0) {
 585     cleanupDie('mkdir failed');
 586   }
 587 }
 588
 589 # copy files and/or create symlinks
 590 copyFiles($tempRoot, 'copy', @copyFiles);
 591 copyFiles($tempRoot, 'symlink', @createSymlinks);
 592
 593 if($gConfig{'create_directly'}) {
 594   # If create_directly is false, the contents will be rsynced into a
 595   # disk image and they would lose their attributes.
 596   setAttributes($tempRoot, @attributes);
 597 }
 598
 599 if(defined($iconFile)) {
 600   if(command($gConfig{'cmd_rsync'}, '-a', '--copy-unsafe-links', $iconFile,
 601    $tempRoot.'/.VolumeIcon.icns') != 0) {
 602     cleanupDie('rsync failed for volume icon');
 603   }
 604
 605   # It's pointless to set the attributes of the root when diskutil create
 606   # -srcfolder is being used.  In that case, the attributes will be set
 607   # later, after the image is already created.
 608   if(isFormatCompressed($outputFormat) &&
 609    (command($gConfig{'cmd_SetFile'}, '-a', 'C', $tempRoot) != 0)) {
 610     cleanupDie('SetFile failed');
 611   }
 612 }
 613
 614 if(command($gConfig{'cmd_chmod'}, '-R', 'a+rX,a-st,u+w,go-w',
 615  $tempRoot) != 0) {
 616   cleanupDie('chmod failed');
 617 }
 618
 619 my($unflattenable);
 620 if(isFormatCompressed($outputFormat)) {
 621   $unflattenable = 1;
 622 }
 623 else {
 624   $unflattenable = 0;
 625 }
 626
 627 diskImageMaker($tempRoot, $targetImage, $outputFormat, $volumeName,
 628  $tempSubdir, $tempMount, $targetImageFilename, defined($iconFile));
 629
 630 if(defined($licenseFile) && $licenseFile ne '') {
 631   my($licenseResource);
 632   $licenseResource = $tempSubdir.'/license.r';
 633   if(!licenseMaker($licenseFile, $licenseResource)) {
 634     cleanupDie('licenseMaker failed');
 635   }
 636   push(@resourceFiles, $licenseResource);
 637   # Don't add a cleanup object because licenseResource is in tempSubdir.
 638 }
 639
 640 if(@resourceFiles) {
 641   # Add resources, such as a license agreement.
 642
 643   # Only unflatten read-only and compressed images.  It's not supported
 644   # on other image times.
 645   if($unflattenable &&
 646    (command($gConfig{'cmd_hdiutil'}, 'unflatten', $targetImage)) != 0) {
 647     cleanupDie('hdiutil unflatten failed');
 648   }
 649   # Don't push flatten onto the cleanup stack.  If we fail now, we'll be
 650   # removing $targetImage anyway.
 651
 652   # Type definitions come from Carbon.r.
 653   if(command($gConfig{'cmd_Rez'}, 'Carbon.r', @resourceFiles, '-a', '-o',
 654    $targetImage) != 0) {
 655     cleanupDie('Rez failed');
 656   }
 657
 658   # Flatten.  This merges the resource fork into the data fork, so no
 659   # special encoding is needed to transfer the file.
 660   if($unflattenable &&
 661    (command($gConfig{'cmd_hdiutil'}, 'flatten', $targetImage)) != 0) {
 662     cleanupDie('hdiutil flatten failed');
 663   }
 664 }
 665
 666 # $tempSubdir is no longer needed.  It's buried on the stack below the
 667 # rm of the fresh image file.  Splice in this fashion is equivalent to
 668 # pop-save, pop, push-save.
 669 splice(@gCleanup, -2, 1);
 670 # No need to remove licenseResource separately, it's in tempSubdir.
 671 if(command($gConfig{'cmd_rm'}, '-rf', $tempSubdir) != 0) {
 672   cleanupDie('rm -rf tempSubdir failed');
 673 }
 674
 675 if($idme) {
 676   if(command($gConfig{'cmd_hdiutil'}, 'internet-enable', '-yes',
 677    $targetImage) != 0) {
 678     cleanupDie('hdiutil internet-enable failed');
 679   }
 680 }
 681
 682 # Done.
 683
 684 exit(0);
 685
 686 # argumentEscape(@arguments)
 687 #
 688 # Takes a list of @arguments and makes them shell-safe.
 689 sub argumentEscape(@) {
 690   my(@arguments);
 691   @arguments = @_;
 692   my($argument, @argumentsOut);
 693   foreach $argument (@arguments) {
 694     $argument =~ s%([^A-Za-z0-9_\-/.=+,])%\\$1%g;
 695     push(@argumentsOut, $argument);
 696   }
 697   return @argumentsOut;
 698 }
 699
 700 # cleanupDie($message)
 701 #
 702 # Displays $message as an error message, and then runs through the
 703 # @gCleanup stack, performing any cleanup operations needed before
 704 # exiting.  Does not return, exits with exit status 1.
 705 sub cleanupDie($) {
 706   my($message);
 707   ($message) = @_;
 708   print STDERR ($0.': '.$message.(@gCleanup?' (cleaning up)':'')."\n");
 709   while(@gCleanup) {
 710     my($subroutine);
 711     $subroutine = pop(@gCleanup);
 712     &$subroutine;
 713   }
 714   exit(1);
 715 }
 716
 717 # command(@arguments)
 718 #
 719 # Runs the specified command at the verbosity level defined by $gVerbosity.
 720 # Returns nonzero on failure, returning the exit status if appropriate.
 721 # Discards command output.
 722 sub command(@) {
 723   my(@arguments);
 724   @arguments = @_;
 725   return commandVerbosity($gVerbosity,@arguments);
 726 }
 727
 728 # commandInternal($command, @arguments)
 729 #
 730 # Runs the specified internal command at the verbosity level defined by
 731 # $gVerbosity.
 732 # Returns zero(!) on failure, because commandInternal is supposed to be a
 733 # direct replacement for the Perl system call wrappers, which, unlike shell
 734 # commands and C equivalent system calls, return true (instead of 0) to
 735 # indicate success.
 736 sub commandInternal($@) {
 737   my(@arguments, $command);
 738   ($command, @arguments) = @_;
 739   return commandInternalVerbosity($gVerbosity, $command, @arguments);
 740 }
 741
 742 # commandInternalVerbosity($verbosity, $command, @arguments)
 743 #
 744 # Run an internal command, printing a bogus command invocation message if
 745 # $verbosity is true.
 746 #
 747 # If $command is unlink:
 748 # Removes the files specified by @arguments.  Wraps unlink.
 749 #
 750 # If $command is symlink:
 751 # Creates the symlink specified by @arguments. Wraps symlink.
 752 sub commandInternalVerbosity($$@) {
 753   my(@arguments, $command, $verbosity);
 754   ($verbosity, $command, @arguments) = @_;
 755   if($command eq 'unlink') {
 756     if($verbosity || $gDryRun) {
 757       print(join(' ', 'rm', '-f', argumentEscape(@arguments))."\n");
 758     }
 759     if($gDryRun) {
 760       return $#arguments+1;
 761     }
 762     return unlink(@arguments);
 763   }
 764   elsif($command eq 'symlink') {
 765     if($verbosity || $gDryRun) {
 766       print(join(' ', 'ln', '-s', argumentEscape(@arguments))."\n");
 767     }
 768     if($gDryRun) {
 769       return 1;
 770     }
 771     my($source, $target);
 772     ($source, $target) = @arguments;
 773     return symlink($source, $target);
 774   }
 775 }
 776
 777 # commandOutput(@arguments)
 778 #
 779 # Runs the specified command at the verbosity level defined by $gVerbosity.
 780 # Output is returned in an array of lines.  undef is returned on failure.
 781 # The exit status is available in $?.
 782 sub commandOutput(@) {
 783   my(@arguments);
 784   @arguments = @_;
 785   return commandOutputVerbosity($gVerbosity, @arguments);
 786 }
 787
 788 # commandOutputVerbosity($verbosity, @arguments)
 789 #
 790 # Runs the specified command at the verbosity level defined by the
 791 # $verbosity argument.  Output is returned in an array of lines.  undef is
 792 # returned on failure.  The exit status is available in $?.
 793 #
 794 # If an error occurs in fork or exec, an error message is printed to
 795 # stderr and undef is returned.
 796 #
 797 # If $verbosity is 0, the command invocation is not printed, and its
 798 # stdout is not echoed back to stdout.
 799 #
 800 # If $verbosity is 1, the command invocation is printed.
 801 #
 802 # If $verbosity is 2, the command invocation is printed and the output
 803 # from stdout is echoed back to stdout.
 804 #
 805 # Regardless of $verbosity, stderr is left connected.
 806 sub commandOutputVerbosity($@) {
 807   my(@arguments, $verbosity);
 808   ($verbosity, @arguments) = @_;
 809   my($pid);
 810   if($verbosity || $gDryRun) {
 811     print(join(' ', argumentEscape(@arguments))."\n");
 812   }
 813   if($gDryRun) {
 814     return(1);
 815   }
 816   if (!defined($pid = open(*COMMAND, '-|'))) {
 817     printf STDERR ($0.': fork: '.$!."\n");
 818     return undef;
 819   }
 820   elsif ($pid) {
 821     # parent
 822     my(@lines);
 823     while(!eof(*COMMAND)) {
 824       my($line);
 825       chop($line = <COMMAND>);
 826       if($verbosity > 1) {
 827         print($line."\n");
 828       }
 829       push(@lines, $line);
 830     }
 831     close(*COMMAND);
 832     if ($? == -1) {
 833       printf STDERR ($0.': fork: '.$!."\n");
 834       return undef;
 835     }
 836     elsif ($? & 127) {
 837       printf STDERR ($0.': exited on signal '.($? & 127).
 838        ($? & 128 ? ', core dumped' : '')."\n");
 839       return undef;
 840     }
 841     return @lines;
 842   }
 843   else {
 844     # child; this form of exec is immune to shell games
 845     if(!exec {$arguments[0]} (@arguments)) {
 846       printf STDERR ($0.': exec: '.$!."\n");
 847       exit(-1);
 848     }
 849   }
 850 }
 851
 852 # commandVerbosity($verbosity, @arguments)
 853 #
 854 # Runs the specified command at the verbosity level defined by the
 855 # $verbosity argument.  Returns nonzero on failure, returning the exit
 856 # status if appropriate.  Discards command output.
 857 sub commandVerbosity($@) {
 858   my(@arguments, $verbosity);
 859   ($verbosity, @arguments) = @_;
 860   if(!defined(commandOutputVerbosity($verbosity, @arguments))) {
 861     return -1;
 862   }
 863   return $?;
 864 }
 865
 866 # copyFiles($tempRoot, $method, @arguments)
 867 #
 868 # Copies files or create symlinks in the disk image.
 869 # See --copy and --symlink descriptions for details.
 870 # If $method is 'copy', @arguments are interpreted as source:target, if $method
 871 # is 'symlink', @arguments are interpreted as symlink:target.
 872 sub copyFiles($@) {
 873   my(@fileList, $method, $tempRoot);
 874   ($tempRoot, $method, @fileList) = @_;
 875   my($file, $isSymlink);
 876   $isSymlink = ($method eq 'symlink');
 877   foreach $file (@fileList) {
 878     my($source, $target);
 879     ($source, $target) = split(/:/, $file);
 880     if(!defined($target) and $isSymlink) {
 881       # empty symlink targets would result in an invalid target and fail,
 882       # but they shall be interpreted as "like source path, but inside dmg"
 883       $target = $source;
 884     }
 885     if(!defined($target)) {
 886       $target = $tempRoot;
 887     }
 888     elsif($target =~ /^\//) {
 889       $target = $tempRoot.$target;
 890     }
 891     else {
 892       $target = $tempRoot.'/'.$target;
 893     }
 894
 895     my($success);
 896     if($isSymlink) {
 897       $success = commandInternal('symlink', $source, $target);
 898     }
 899     else {
 900       $success = !command($gConfig{'cmd_rsync'}, '-a', '--copy-unsafe-links',
 901                           $source, $target);
 902     }
 903     if(!$success) {
 904       cleanupDie('copyFiles failed for method '.$method);
 905     }
 906   }
 907 }
 908
 909 # diskImageMaker($source, $destination, $format, $name, $tempDir, $tempMount,
 910 #  $baseName, $setRootIcon)
 911 #
 912 # Creates a disk image in $destination of format $format corresponding to the
 913 # source directory $source.  $name is the volume name.  $tempDir is a good
 914 # place to write temporary files, which should be empty (aside from the other
 915 # things that this script might create there, like stage and mount).
 916 # $tempMount is a mount point for temporary disk images.  $baseName is the
 917 # name of the disk image, and is presently unused.  $setRootIcon is true if
 918 # a volume icon was added to the staged $source and indicates that the
 919 # custom volume icon bit on the volume root needs to be set.
 920 sub diskImageMaker($$$$$$$$) {
 921   my($baseName, $destination, $format, $name, $setRootIcon, $source,
 922    $tempDir, $tempMount);
 923   ($source, $destination, $format, $name, $tempDir, $tempMount,
 924    $baseName, $setRootIcon) = @_;
 925   if(isFormatCompressed($format)) {
 926     my($uncompressedImage);
 927
 928     if($gConfig{'makehybrid'}) {
 929       my($hybridImage);
 930       $hybridImage = giveExtension($tempDir.'/hybrid', '.dmg');
 931
 932       if(command($gConfig{'cmd_hdiutil'}, 'makehybrid', '-hfs',
 933        '-hfs-volume-name', $name, '-hfs-openfolder', $source, '-ov',
 934        $source, '-o', $hybridImage) != 0) {
 935         cleanupDie('hdiutil makehybrid failed');
 936       }
 937
 938       $uncompressedImage = $hybridImage;
 939
 940       # $source is no longer needed and will be removed before anything
 941       # else can fail.  splice in this form is the same as pop/push.
 942       splice(@gCleanup, -1, 1,
 943        sub {commandInternalVerbosity(0, 'unlink', $hybridImage);});
 944
 945       if(command($gConfig{'cmd_rm'}, '-rf', $source) != 0) {
 946         cleanupDie('rm -rf failed');
 947       }
 948
 949       if(!$gConfig{'partition_table'} && $gConfig{'recursive_access'}) {
 950         # Even if we do want to create disk images without partition tables,
 951         # it's impossible unless recursive_access is set.
 952         my($rootDevice, $partitionDevice, $partitionMountPoint);
 953
 954         if(!(($rootDevice, $partitionDevice, $partitionMountPoint) =
 955          hdidMountImage($tempMount, '-readonly', $hybridImage))) {
 956           cleanupDie('hdid mount failed');
 957         }
 958
 959         push(@gCleanup, sub {commandVerbosity(0,
 960          $gConfig{'cmd_diskutil'}, 'eject', $rootDevice);});
 961
 962         my($udrwImage);
 963         $udrwImage = giveExtension($tempDir.'/udrw', '.dmg');
 964
 965         if(command($gConfig{'cmd_hdiutil'}, 'create', '-format', 'UDRW',
 966          '-ov', '-srcdevice', $partitionDevice, $udrwImage) != 0) {
 967           cleanupDie('hdiutil create failed');
 968         }
 969
 970         $uncompressedImage = $udrwImage;
 971
 972         # Going to eject before anything else can fail.  Get the eject off
 973         # the stack.
 974         pop(@gCleanup);
 975
 976         # $hybridImage will be removed soon, but until then, it needs to
 977         # stay on the cleanup stack.  It needs to wait until after
 978         # ejection.  $udrwImage is staying around.  Make it appear as
 979         # though it's been done before $hybridImage.
 980         #
 981         # splice in this form is the same as popping one element to
 982         # @tempCleanup and pushing the subroutine.
 983         my(@tempCleanup);
 984         @tempCleanup = splice(@gCleanup, -1, 1,
 985          sub {commandInternalVerbosity(0, 'unlink', $udrwImage);});
 986         push(@gCleanup, @tempCleanup);
 987
 988         if(command($gConfig{'cmd_diskutil'}, 'eject', $rootDevice) != 0) {
 989           cleanupDie('diskutil eject failed');
 990         }
 991
 992         # Pop unlink of $uncompressedImage
 993         pop(@gCleanup);
 994
 995         if(commandInternal('unlink', $hybridImage) != 1) {
 996           cleanupDie('unlink hybridImage failed: '.$!);
 997         }
 998       }
 999     }
1000     else {
1001       # makehybrid is not available, fall back to making a UDRW and
1002       # converting to a compressed image.  It ought to be possible to
1003       # create a compressed image directly, but those come out far too
1004       # large (journaling?) and need to be read-write to fix up the
1005       # volume icon anyway.  Luckily, we can take advantage of a single
1006       # call back into this function.
1007       my($udrwImage);
1008       $udrwImage = giveExtension($tempDir.'/udrw', '.dmg');
1009
1010       diskImageMaker($source, $udrwImage, 'UDRW', $name, $tempDir,
1011        $tempMount, $baseName, $setRootIcon);
1012
1013       # The call back into diskImageMaker already removed $source.
1014
1015       $uncompressedImage = $udrwImage;
1016     }
1017
1018     # The uncompressed disk image is now in its final form.  Compress it.
1019     # Jaguar doesn't support hdiutil convert -ov, but it always allows
1020     # overwriting.
1021     # bzip2-compressed UDBZ images can only be created and mounted on 10.4
1022     # and later.  The bzip2-level imagekey is only effective when creating
1023     # images in 10.5.  In 10.4, bzip2-level is harmlessly ignored, and the
1024     # default value of 1 is always used.
1025     if(command($gConfig{'cmd_hdiutil'}, 'convert', '-format', $format,
1026      '-imagekey', ($format eq 'UDBZ' ? 'bzip2-level=9' : 'zlib-level=9'),
1027      (defined($gDarwinMajor) && $gDarwinMajor <= 6 ? () : ('-ov')),
1028      $uncompressedImage, '-o', $destination) != 0) {
1029       cleanupDie('hdiutil convert failed');
1030     }
1031
1032     # $uncompressedImage is going to be unlinked before anything else can
1033     # fail.  splice in this form is the same as pop/push.
1034     splice(@gCleanup, -1, 1,
1035      sub {commandInternalVerbosity(0, 'unlink', $destination);});
1036
1037     if(commandInternal('unlink', $uncompressedImage) != 1) {
1038       cleanupDie('unlink uncompressedImage failed: '.$!);
1039     }
1040
1041     # At this point, the only thing that the compressed block has added to
1042     # the cleanup stack is the removal of $destination.  $source has already
1043     # been removed, and its cleanup entry has been removed as well.
1044   }
1045   elsif($format eq 'UDRW' || $format eq 'UDSP') {
1046     my(@extraArguments);
1047     if(!$gConfig{'partition_table'}) {
1048       @extraArguments = ('-layout', 'NONE');
1049     }
1050
1051     if($gConfig{'create_directly'}) {
1052       # Use -fs HFS+ to suppress the journal.
1053       if(command($gConfig{'cmd_hdiutil'}, 'create', '-format', $format,
1054        @extraArguments, '-fs', 'HFS+', '-volname', $name,
1055        '-ov', '-srcfolder', $source, $destination) != 0) {
1056         cleanupDie('hdiutil create failed');
1057       }
1058
1059       # $source is no longer needed and will be removed before anything
1060       # else can fail.  splice in this form is the same as pop/push.
1061       splice(@gCleanup, -1, 1,
1062        sub {commandInternalVerbosity(0, 'unlink', $destination);});
1063
1064       if(command($gConfig{'cmd_rm'}, '-rf', $source) != 0) {
1065         cleanupDie('rm -rf failed');
1066       }
1067     }
1068     else {
1069       # hdiutil create does not support -srcfolder or -srcdevice, it only
1070       # knows how to create blank images.  Figure out how large an image
1071       # is needed, create it, and fill it.  This is needed for Jaguar.
1072
1073       # Use native block size for hdiutil create -sectors.
1074       delete $ENV{'BLOCKSIZE'};
1075
1076       my(@duOutput, $ignore, $sizeBlocks, $sizeOverhead, $sizeTotal, $type);
1077       if(!(@output = commandOutput($gConfig{'cmd_du'}, '-s', $tempRoot)) ||
1078        $? != 0) {
1079         cleanupDie('du failed');
1080       }
1081       ($sizeBlocks, $ignore) = split(' ', $output[0], 2);
1082
1083       # The filesystem itself takes up 152 blocks of its own blocks for the
1084       # filesystem up to 8192 blocks, plus 64 blocks for every additional
1085       # 4096 blocks or portion thereof.
1086       $sizeOverhead = 152 + 64 * POSIX::ceil(
1087        (($sizeBlocks - 8192) > 0) ? (($sizeBlocks - 8192) / (4096 - 64)) : 0);
1088
1089       # The number of blocks must be divisible by 8.
1090       my($mod);
1091       if($mod = ($sizeOverhead % 8)) {
1092         $sizeOverhead += 8 - $mod;
1093       }
1094
1095       # sectors is taken as the size of a disk, not a filesystem, so the
1096       # partition table eats into it.
1097       if($gConfig{'partition_table'}) {
1098         $sizeOverhead += 80;
1099       }
1100
1101       # That was hard.  Leave some breathing room anyway.  Use 1024 sectors
1102       # (512kB).  These read-write images wouldn't be useful if they didn't
1103       # have at least a little free space.
1104       $sizeTotal = $sizeBlocks + $sizeOverhead + 1024;
1105
1106       # Minimum sizes - these numbers are larger on Jaguar than on later
1107       # systems.  Just use the Jaguar numbers, since it's unlikely to wind
1108       # up here on any other release.
1109       if($gConfig{'partition_table'} && $sizeTotal < 8272) {
1110         $sizeTotal = 8272;
1111       }
1112       if(!$gConfig{'partition_table'} && $sizeTotal < 8192) {
1113         $sizeTotal = 8192;
1114       }
1115
1116       # hdiutil create without -srcfolder or -srcdevice will not accept
1117       # -format.  It uses -type.  Fortunately, the two supported formats
1118       # here map directly to the only two supported types.
1119       if ($format eq 'UDSP') {
1120         $type = 'SPARSE';
1121       }
1122       else {
1123         $type = 'UDIF';
1124       }
1125
1126       if(command($gConfig{'cmd_hdiutil'}, 'create', '-type', $type,
1127        @extraArguments, '-fs', 'HFS+', '-volname', $name,
1128        '-ov', '-sectors', $sizeTotal, $destination) != 0) {
1129         cleanupDie('hdiutil create failed');
1130       }
1131
1132       push(@gCleanup,
1133        sub {commandInternalVerbosity(0, 'unlink', $destination);});
1134
1135       # The rsync will occur shortly.
1136     }
1137
1138     my($mounted, $rootDevice, $partitionDevice, $partitionMountPoint);
1139
1140     $mounted=0;
1141     if(!$gConfig{'create_directly'} || $gConfig{'openfolder_bless'} ||
1142      $setRootIcon) {
1143       # The disk image only needs to be mounted if:
1144       #  create_directly is false, because the content needs to be copied
1145       #  openfolder_bless is true, because bless -openfolder needs to run
1146       #  setRootIcon is true, because the root needs its attributes set.
1147       if(!(($rootDevice, $partitionDevice, $partitionMountPoint) =
1148        hdidMountImage($tempMount, $destination))) {
1149         cleanupDie('hdid mount failed');
1150       }
1151
1152       $mounted=1;
1153
1154       push(@gCleanup, sub {commandVerbosity(0,
1155        $gConfig{'cmd_diskutil'}, 'eject', $rootDevice);});
1156     }
1157
1158     if(!$gConfig{'create_directly'}) {
1159       # Couldn't create and copy directly in one fell swoop.  Now that
1160       # the volume is mounted, copy the files.  --copy-unsafe-links is
1161       # unnecessary since it was used to copy everything to the staging
1162       # area.  There can be no more unsafe links.
1163       if(command($gConfig{'cmd_rsync'}, '-a',
1164        $source.'/',$partitionMountPoint) != 0) {
1165         cleanupDie('rsync to new volume failed');
1166       }
1167
1168       # We need to get the rm -rf of $source off the stack, because it's
1169       # being cleaned up here.  There are two items now on top of it:
1170       # removing the target image and, above that, ejecting it.  Splice it
1171       # out.
1172       my(@tempCleanup);
1173       @tempCleanup = splice(@gCleanup, -2);
1174       # The next splice is the same as popping once and pushing @tempCleanup.
1175       splice(@gCleanup, -1, 1, @tempCleanup);
1176
1177       if(command($gConfig{'cmd_rm'}, '-rf', $source) != 0) {
1178         cleanupDie('rm -rf failed');
1179       }
1180     }
1181
1182     if($gConfig{'openfolder_bless'}) {
1183       # On Tiger, the bless docs say to use --openfolder, but only
1184       # --openfolder is accepted on Panther.  Tiger takes it with a single
1185       # dash too.  Jaguar is out of luck.
1186       if(command($gConfig{'cmd_bless'}, '-openfolder',
1187        $partitionMountPoint) != 0) {
1188         cleanupDie('bless failed');
1189       }
1190     }
1191
1192     setAttributes($partitionMountPoint, @attributes);
1193
1194     if($setRootIcon) {
1195       # When "hdiutil create -srcfolder" is used, the root folder's
1196       # attributes are not copied to the new volume.  Fix up.
1197
1198       if(command($gConfig{'cmd_SetFile'}, '-a', 'C',
1199        $partitionMountPoint) != 0) {
1200         cleanupDie('SetFile failed');
1201       }
1202     }
1203
1204     if($mounted) {
1205       # Pop diskutil eject
1206       pop(@gCleanup);
1207
1208       if(command($gConfig{'cmd_diskutil'}, 'eject', $rootDevice) != 0) {
1209         cleanupDie('diskutil eject failed');
1210       }
1211     }
1212
1213     # End of UDRW/UDSP section.  At this point, $source has been removed
1214     # and its cleanup entry has been removed from the stack.
1215   }
1216   else {
1217     cleanupDie('unrecognized format');
1218     print STDERR ($0.": unrecognized format\n");
1219     exit(1);
1220   }
1221 }
1222
1223 # giveExtension($file, $extension)
1224 #
1225 # If $file does not end in $extension, $extension is added.  The new
1226 # filename is returned.
1227 sub giveExtension($$) {
1228   my($extension, $file);
1229   ($file, $extension) = @_;
1230   if(substr($file, -length($extension)) ne $extension) {
1231     return $file.$extension;
1232   }
1233   return $file;
1234 }
1235
1236 # hdidMountImage($mountPoint, @arguments)
1237 #
1238 # Runs the hdid command with arguments specified by @arguments.
1239 # @arguments may be a single-element array containing the name of the
1240 # disk image to mount.  Returns a three-element array, with elements
1241 # corresponding to:
1242 #  - The root device of the mounted image, suitable for ejection
1243 #  - The device corresponding to the mounted partition
1244 #  - The mounted partition's mount point
1245 #
1246 # If running on a system that supports easy mounting at points outside
1247 # of the default /Volumes with hdiutil attach, it is used instead of hdid,
1248 # and $mountPoint is used as the mount point.
1249 #
1250 # The root device will differ from the partition device when the disk
1251 # image contains a partition table, otherwise, they will be identical.
1252 #
1253 # If hdid fails, undef is returned.
1254 sub hdidMountImage($@) {
1255   my(@arguments, @command, $mountPoint);
1256   ($mountPoint, @arguments) = @_;
1257   my(@output);
1258
1259   if($gConfig{'hdiutil_mountpoint'}) {
1260     @command=($gConfig{'cmd_hdiutil'}, 'attach', @arguments,
1261      '-mountpoint', $mountPoint);
1262   }
1263   else {
1264     @command=($gConfig{'cmd_hdid'}, @arguments);
1265   }
1266
1267   if(!(@output = commandOutput(@command)) ||
1268    $? != 0) {
1269     return undef;
1270   }
1271
1272   if($gDryRun) {
1273     return('/dev/diskX','/dev/diskXsY','/Volumes/'.$volumeName);
1274   }
1275
1276   my($line, $restOfLine, $rootDevice);
1277
1278   foreach $line (@output) {
1279     my($device, $mountpoint);
1280     if($line !~ /^\/dev\//) {
1281       # Consider only lines that correspond to /dev entries
1282       next;
1283     }
1284     ($device, $restOfLine) = split(' ', $line, 2);
1285
1286     if(!defined($rootDevice) || $rootDevice eq '') {
1287       # If this is the first device seen, it's the root device to be
1288       # used for ejection.  Keep it.
1289       $rootDevice = $device;
1290     }
1291
1292     if($restOfLine =~ /(\/.*)/) {
1293       # The first partition with a mount point is the interesting one.  It's
1294       # usually Apple_HFS and usually the last one in the list, but beware of
1295       # the possibility of other filesystem types and the Apple_Free partition.
1296       # If the disk image contains no partition table, the partition will not
1297       # have a type, so look for the mount point by looking for a slash.
1298       $mountpoint = $1;
1299       return($rootDevice, $device, $mountpoint);
1300     }
1301   }
1302
1303   # No mount point?  This is bad.  If there's a root device, eject it.
1304   if(defined($rootDevice) && $rootDevice ne '') {
1305     # Failing anyway, so don't care about failure
1306     commandVerbosity(0, $gConfig{'cmd_diskutil'}, 'eject', $rootDevice);
1307   }
1308
1309   return undef;
1310 }
1311
1312 # isFormatCompressed($format)
1313 #
1314 # Returns true if $format corresponds to a compressed disk image format.
1315 # Returns false otherwise.
1316 sub isFormatCompressed($) {
1317   my($format);
1318   ($format) = @_;
1319   return $format eq 'UDZO' || $format eq 'UDBZ';
1320 }
1321
1322 # licenseMaker($text, $resource)
1323 #
1324 # Takes a plain text file at path $text and creates a license agreement
1325 # resource containing the text at path $license.  English-only, and
1326 # no special formatting.  This is the bare-bones stuff.  For more
1327 # intricate license agreements, create your own resource.
1328 #
1329 # ftp://ftp.apple.com/developer/Development_Kits/SLAs_for_UDIFs_1.0.dmg
1330 sub licenseMaker($$) {
1331   my($resource, $text);
1332   ($text, $resource) = @_;
1333   if(!sysopen(*TEXT, $text, O_RDONLY)) {
1334     print STDERR ($0.': licenseMaker: sysopen text: '.$!."\n");
1335     return 0;
1336   }
1337   if(!sysopen(*RESOURCE, $resource, O_WRONLY|O_CREAT|O_EXCL)) {
1338     print STDERR ($0.': licenseMaker: sysopen resource: '.$!."\n");
1339     return 0;
1340   }
1341   print RESOURCE << '__EOT__';
1342 // See /System/Library/Frameworks/CoreServices.framework/Frameworks/CarbonCore.framework/Headers/Script.h for language IDs.
1343 data 'LPic' (5000) {
1344   // Default language ID, 0 = English
1345   $"0000"
1346   // Number of entries in list
1347   $"0001"
1348
1349   // Entry 1
1350   // Language ID, 0 = English
1351   $"0000"
1352   // Resource ID, 0 = STR#/TEXT/styl 5000
1353   $"0000"
1354   // Multibyte language, 0 = no
1355   $"0000"
1356 };
1357
1358 resource 'STR#' (5000, "English") {
1359   {
1360     // Language (unused?) = English
1361     "English",
1362     // Agree
1363     "Agree",
1364     // Disagree
1365     "Disagree",
1366 __EOT__
1367     # This stuff needs double-quotes for interpolations to work.
1368     print RESOURCE ("    // Print, ellipsis is 0xC9\n");
1369     print RESOURCE ("    \"Print\xc9\",\n");
1370     print RESOURCE ("    // Save As, ellipsis is 0xC9\n");
1371     print RESOURCE ("    \"Save As\xc9\",\n");
1372     print RESOURCE ('    // Descriptive text, curly quotes are 0xD2 and 0xD3'.
1373      "\n");
1374     print RESOURCE ('    "If you agree to the terms of this license '.
1375      "agreement, click \xd2Agree\xd3 to access the software.  If you ".
1376      "do not agree, press \xd2Disagree.\xd3\"\n");
1377 print RESOURCE << '__EOT__';
1378   };
1379 };
1380
1381 // Beware of 1024(?) byte (character?) line length limitation.  Split up long
1382 // lines.
1383 // If straight quotes are used ("), remember to escape them (\").
1384 // Newline is \n, to leave a blank line, use two of them.
1385 // 0xD2 and 0xD3 are curly double-quotes ("), 0xD4 and 0xD5 are curly
1386 //   single quotes ('), 0xD5 is also the apostrophe.
1387 data 'TEXT' (5000, "English") {
1388 __EOT__
1389
1390   while(!eof(*TEXT)) {
1391     my($line);
1392     chop($line = <TEXT>);
1393
1394     while(defined($line)) {
1395       my($chunk);
1396
1397       # Rez doesn't care for lines longer than (1024?) characters.  Split
1398       # at less than half of that limit, in case everything needs to be
1399       # backwhacked.
1400       if(length($line)>500) {
1401         $chunk = substr($line, 0, 500);
1402         $line = substr($line, 500);
1403       }
1404       else {
1405         $chunk = $line;
1406         $line = undef;
1407       }
1408
1409       if(length($chunk) > 0) {
1410         # Unsafe characters are the double-quote (") and backslash (\), escape
1411         # them with backslashes.
1412         $chunk =~ s/(["\\])/\\$1/g;
1413
1414         print RESOURCE '  "'.$chunk.'"'."\n";
1415       }
1416     }
1417     print RESOURCE '  "\n"'."\n";
1418   }
1419   close(*TEXT);
1420
1421   print RESOURCE << '__EOT__';
1422 };
1423
1424 data 'styl' (5000, "English") {
1425   // Number of styles following = 1
1426   $"0001"
1427
1428   // Style 1.  This is used to display the first two lines in bold text.
1429   // Start character = 0
1430   $"0000 0000"
1431   // Height = 16
1432   $"0010"
1433   // Ascent = 12
1434   $"000C"
1435   // Font family = 1024 (Lucida Grande)
1436   $"0400"
1437   // Style bitfield, 0x1=bold 0x2=italic 0x4=underline 0x8=outline
1438   // 0x10=shadow 0x20=condensed 0x40=extended
1439   $"00"
1440   // Style, unused?
1441   $"02"
1442   // Size = 12 point
1443   $"000C"
1444   // Color, RGB
1445   $"0000 0000 0000"
1446 };
1447 __EOT__
1448   close(*RESOURCE);
1449
1450   return 1;
1451 }
1452
1453 # pathSplit($pathname)
1454 #
1455 # Splits $pathname into an array of path components.
1456 sub pathSplit($) {
1457   my($pathname);
1458   ($pathname) = @_;
1459   return split(/\//, $pathname);
1460 }
1461
1462 # setAttributes($root, @attributeList)
1463 #
1464 # @attributeList is an array, each element of which must be in the form
1465 # <a>:<file>.  <a> is a list of attributes, per SetFile.  <file> is a file
1466 # which is taken as relative to $root (even if it appears as an absolute
1467 # path.)  SetFile is called to set the attributes on each file in
1468 # @attributeList.
1469 sub setAttributes($@) {
1470   my(@attributes, $root);
1471   ($root, @attributes) = @_;
1472   my($attribute);
1473   foreach $attribute (@attributes) {
1474     my($attrList, $file, @fileList, @fixedFileList);
1475     ($attrList, @fileList) = split(/:/, $attribute);
1476     if(!defined($attrList) || !@fileList) {
1477       cleanupDie('--attribute requires <attributes>:<file>');
1478     }
1479     @fixedFileList=();
1480     foreach $file (@fileList) {
1481       if($file =~ /^\//) {
1482         push(@fixedFileList, $root.$file);
1483       }
1484       else {
1485         push(@fixedFileList, $root.'/'.$file);
1486       }
1487     }
1488     if(command($gConfig{'cmd_SetFile'}, '-a', $attrList, @fixedFileList)) {
1489       cleanupDie('SetFile failed to set attributes');
1490     }
1491   }
1492   return;
1493 }
1494
1495 sub trapSignal($) {
1496   my($signalName);
1497   ($signalName) = @_;
1498   cleanupDie('exiting on SIG'.$signalName);
1499 }
1500
1501 sub usage() {
1502   print STDERR (
1503 "usage: pkg-dmg --source <source-folder>\n".
1504 "               --target <target-image>\n".
1505 "              [--format <format>]           (default: UDZO)\n".
1506 "              [--volname <volume-name>]     (default: same name as source)\n".
1507 "              [--tempdir <temp-dir>]        (default: same dir as target)\n".
1508 "              [--mkdir <directory>]         (make directory in image)\n".
1509 "              [--copy <source>[:<dest>]]    (extra files to add)\n".
1510 "              [--symlink <source>[:<dest>]] (extra symlinks to add)\n".
1511 "              [--license <file>]            (plain text license agreement)\n".
1512 "              [--resource <file>]           (flat .r files to merge)\n".
1513 "              [--icon <icns-file>]          (volume icon)\n".
1514 "              [--attribute <a>:<file>]      (set file attributes)\n".
1515 "              [--idme]                      (make Internet-enabled image)\n".
1516 "              [--sourcefile]                (treat --source as a file)\n".
1517 "              [--verbosity <level>]         (0, 1, 2; default=2)\n".
1518 "              [--dry-run]                   (print what would be done)\n");
1519   return;
1520 }