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