michael@0: #!/usr/bin/perl
michael@0: # This Source Code Form is subject to the terms of the Mozilla Public
michael@0: # License, v. 2.0. If a copy of the MPL was not distributed with this
michael@0: # file, You can obtain one at http://mozilla.org/MPL/2.0/.
michael@0: 
michael@0: use strict;
michael@0: use warnings;
michael@0: 
michael@0: =pod
michael@0: 
michael@0: =head1 NAME
michael@0: 
michael@0: B<pkg-dmg> - Mac OS X disk image (.dmg) packager
michael@0: 
michael@0: =head1 SYNOPSIS
michael@0: 
michael@0: B<pkg-dmg>
michael@0: B<--source> I<source-folder>
michael@0: B<--target> I<target-image>
michael@0: [B<--format> I<format>]
michael@0: [B<--volname> I<volume-name>]
michael@0: [B<--tempdir> I<temp-dir>]
michael@0: [B<--mkdir> I<directory>]
michael@0: [B<--copy> I<source>[:I<dest>]]
michael@0: [B<--symlink> I<source>[:I<dest>]]
michael@0: [B<--license> I<file>]
michael@0: [B<--resource> I<file>]
michael@0: [B<--icon> I<icns-file>]
michael@0: [B<--attribute> I<a>:I<file>[:I<file>...]
michael@0: [B<--idme>]
michael@0: [B<--sourcefile>]
michael@0: [B<--verbosity> I<level>]
michael@0: [B<--dry-run>]
michael@0: 
michael@0: =head1 DESCRIPTION
michael@0: 
michael@0: I<pkg-dmg> takes a directory identified by I<source-folder> and transforms
michael@0: it into a disk image stored as I<target-image>.  The disk image will
michael@0: occupy the least space possible for its format, or the least space that the
michael@0: authors have been able to figure out how to achieve.
michael@0: 
michael@0: =head1 OPTIONS
michael@0: 
michael@0: =over 5
michael@0: 
michael@0: ==item B<--source> I<source-folder>
michael@0: 
michael@0: Identifies the directory that will be packaged up.  This directory is not
michael@0: touched, a copy will be made in a temporary directory for staging purposes.
michael@0: See B<--tempdir>.
michael@0: 
michael@0: ==item B<--target> I<target-image>
michael@0: 
michael@0: The disk image to create.  If it exists and is not in use, it will be
michael@0: overwritten.  If I<target-image> already contains a suitable extension,
michael@0: it will be used unmodified.  If no extension is present, or the extension
michael@0: is incorrect for the selected format, the proper extension will be added.
michael@0: See B<--format>.
michael@0: 
michael@0: ==item B<--format> I<format>
michael@0: 
michael@0: The format to create the disk image in.  Valid values for I<format> are:
michael@0:      - UDZO - zlib-compressed, read-only; extension I<.dmg>
michael@0:      - UDBZ - bzip2-compressed, read-only; extension I<.dmg>;
michael@0:               create and use on 10.4 ("Tiger") and later only
michael@0:      - UDRW - read-write; extension I<.dmg>
michael@0:      - UDSP - read-write, sparse; extension I<.sparseimage>
michael@0: 
michael@0: UDBZ is the default format.
michael@0: 
michael@0: See L<hdiutil(1)> for a description of these formats.
michael@0: 
michael@0: =item B<--volname> I<volume-name>
michael@0: 
michael@0: The name of the volume in the disk image.  If not specified, I<volume-name>
michael@0: defaults to the name of the source directory from B<--source>.
michael@0: 
michael@0: =item B<--tempdir> I<temp-dir>
michael@0: 
michael@0: A temporary directory to stage intermediate files in.  I<temp-dir> must
michael@0: have enough space available to accommodate twice the size of the files
michael@0: being packaged.  If not specified, defaults to the same directory that
michael@0: the I<target-image> is to be placed in.  B<pkg-dmg> will remove any
michael@0: temporary files it places in I<temp-dir>.
michael@0: 
michael@0: =item B<--mkdir> I<directory>
michael@0: 
michael@0: Specifies a directory that should be created in the disk image.
michael@0: I<directory> and any ancestor directories will be created.  This is
michael@0: useful in conjunction with B<--copy>, when copying files to directories
michael@0: that may not exist in I<source-folder>.  B<--mkdir> may appear multiple
michael@0: times.
michael@0: 
michael@0: =item B<--copy> I<source>[:I<dest>]
michael@0: 
michael@0: Additional files to copy into the disk image.  If I<dest> is
michael@0: specified, I<source> is copied to the location I<dest> identifies,
michael@0: otherwise, I<source> is copied to the root of the new volume.  B<--copy>
michael@0: provides a way to package up a I<source-folder> by adding files to it
michael@0: without modifying the original I<source-folder>.  B<--copy> may appear
michael@0: multiple times.
michael@0: 
michael@0: This option is useful for adding .DS_Store files and window backgrounds
michael@0: to disk images.
michael@0: 
michael@0: =item B<--symlink> I<source>[:I<dest>]
michael@0: 
michael@0: Like B<--copy>, but allows symlinks to point out of the volume. Empty symlink
michael@0: destinations are interpreted as "like the source path, but inside the dmg"
michael@0: 
michael@0: This option is useful for adding symlinks to external resources,
michael@0: e.g. to /Applications.
michael@0: 
michael@0: =item B<--license> I<file>
michael@0: 
michael@0: A plain text file containing a license agreement to be displayed before
michael@0: the disk image is mounted.  English is the only supported language.  To
michael@0: include license agreements in other languages, in multiple languages,
michael@0: or to use formatted text, prepare a resource and use L<--resource>.
michael@0: 
michael@0: =item B<--resource> I<file>
michael@0: 
michael@0: A resource file to merge into I<target-image>.  If I<format> is UDZO or
michael@0: UDBZ, the disk image will be flattened to a single-fork file that contains
michael@0: the resource but may be freely transferred without any special encodings.
michael@0: I<file> must be in a format suitable for L<Rez(1)>.  See L<Rez(1)> for a
michael@0: description of the format, and L<hdiutil(1)> for a discussion on flattened
michael@0: disk images.  B<--resource> may appear multiple times.
michael@0: 
michael@0: This option is useful for adding license agreements and other messages
michael@0: to disk images.
michael@0: 
michael@0: =item B<--icon> I<icns-file>
michael@0: 
michael@0: Specifies an I<icns> file that will be used as the icon for the root of
michael@0: the volume.  This file will be copied to the new volume and the custom
michael@0: icon attribute will be set on the root folder.
michael@0: 
michael@0: =item B<--attribute> I<a>:I<file>[:I<file>...]
michael@0: 
michael@0: Sets the attributes of I<file> to the attribute list in I<a>.  See
michael@0: L<SetFile(1)>
michael@0: 
michael@0: =item B<--idme>
michael@0: 
michael@0: Enable IDME to make the disk image "Internet-enabled."  The first time
michael@0: the image is mounted, if IDME processing is enabled on the system, the
michael@0: contents of the image will be copied out of the image and the image will
michael@0: be placed in the trash with IDME disabled.
michael@0: 
michael@0: =item B<--sourcefile>
michael@0: 
michael@0: If this option is present, I<source-folder> is treated as a file, and is
michael@0: placed as a file within the volume's root folder.  Without this option,
michael@0: I<source-folder> is treated as the volume root itself.
michael@0: 
michael@0: =item B<--verbosity> I<level>
michael@0: 
michael@0: Adjusts the level of loudness of B<pkg-dmg>.  The possible values for
michael@0: I<level> are:
michael@0:      0 - Only error messages are displayed.
michael@0:      1 - Print error messages and command invocations.
michael@0:      2 - Print everything, including command output.
michael@0: 
michael@0: The default I<level> is 2.
michael@0: 
michael@0: =item B<--dry-run>
michael@0: 
michael@0: When specified, the commands that would be executed are printed, without
michael@0: actually executing them.  When commands depend on the output of previous
michael@0: commands, dummy values are displayed.
michael@0: 
michael@0: =back
michael@0: 
michael@0: =head1 NON-OPTIONS
michael@0: 
michael@0: =over 5
michael@0: 
michael@0: =item
michael@0: 
michael@0: Resource forks aren't copied.
michael@0: 
michael@0: =item
michael@0: 
michael@0: The root folder of the created volume is designated as the folder
michael@0: to open when the volume is mounted.  See L<bless(8)>.
michael@0: 
michael@0: =item
michael@0: 
michael@0: All files in the volume are set to be world-readable, only writable
michael@0: by the owner, and world-executable when appropriate.  All other
michael@0: permissions bits are cleared.
michael@0: 
michael@0: =item
michael@0: 
michael@0: When possible, disk images are created without any partition tables.  This
michael@0: is what L<hdiutil(1)> refers to as I<-layout NONE>, and saves a handful of
michael@0: kilobytes.  The alternative, I<SPUD>, contains a partition table that
michael@0: is not terribly handy on disk images that are not intended to represent any
michael@0: physical disk.
michael@0: 
michael@0: =item
michael@0: 
michael@0: Read-write images are created with journaling off.  Any read-write image
michael@0: created by this tool is expected to be transient, and the goal of this tool
michael@0: is to create images which consume a minimum of space.
michael@0: 
michael@0: =back
michael@0: 
michael@0: =head1 EXAMPLE
michael@0: 
michael@0: pkg-dmg --source /Applications/DeerPark.app --target ~/DeerPark.dmg
michael@0:   --sourcefile --volname DeerPark --icon ~/DeerPark.icns
michael@0:   --mkdir /.background
michael@0:   --copy DeerParkBackground.png:/.background/background.png
michael@0:   --copy DeerParkDSStore:/.DS_Store
michael@0:   --symlink /Applications:"/Drag to here"
michael@0: 
michael@0: =head1 REQUIREMENTS
michael@0: 
michael@0: I<pkg-dmg> has been tested with Mac OS X releases 10.2 ("Jaguar")
michael@0: through 10.4 ("Tiger").  Certain adjustments to behavior are made
michael@0: depending on the host system's release.  Mac OS X 10.3 ("Panther") or
michael@0: later are recommended.
michael@0: 
michael@0: =head1 LICENSE
michael@0: 
michael@0: MPL 2.
michael@0: 
michael@0: =head1 AUTHOR
michael@0: 
michael@0: Mark Mentovai
michael@0: 
michael@0: =head1 SEE ALSO
michael@0: 
michael@0: L<bless(8)>, L<diskutil(8)>, L<hdid(8)>, L<hdiutil(1)>, L<Rez(1)>,
michael@0: L<rsync(1)>, L<SetFile(1)>
michael@0: 
michael@0: =cut
michael@0: 
michael@0: use Fcntl;
michael@0: use POSIX;
michael@0: use Getopt::Long;
michael@0: 
michael@0: sub argumentEscape(@);
michael@0: sub cleanupDie($);
michael@0: sub command(@);
michael@0: sub commandInternal($@);
michael@0: sub commandInternalVerbosity($$@);
michael@0: sub commandOutput(@);
michael@0: sub commandOutputVerbosity($@);
michael@0: sub commandVerbosity($@);
michael@0: sub copyFiles($@);
michael@0: sub diskImageMaker($$$$$$$$);
michael@0: sub giveExtension($$);
michael@0: sub hdidMountImage($@);
michael@0: sub isFormatCompressed($);
michael@0: sub licenseMaker($$);
michael@0: sub pathSplit($);
michael@0: sub setAttributes($@);
michael@0: sub trapSignal($);
michael@0: sub usage();
michael@0: 
michael@0: # Variables used as globals
michael@0: my(@gCleanup, %gConfig, $gDarwinMajor, $gDryRun, $gVerbosity);
michael@0: 
michael@0: # Use the commands by name if they're expected to be in the user's
michael@0: # $PATH (/bin:/sbin:/usr/bin:/usr/sbin).  Otherwise, go by absolute
michael@0: # path.  These may be overridden with --config.
michael@0: %gConfig = ('cmd_bless'          => 'bless',
michael@0:             'cmd_chmod'          => 'chmod',
michael@0:             'cmd_diskutil'       => 'diskutil',
michael@0:             'cmd_du'             => 'du',
michael@0:             'cmd_hdid'           => 'hdid',
michael@0:             'cmd_hdiutil'        => 'hdiutil',
michael@0:             'cmd_mkdir'          => 'mkdir',
michael@0:             'cmd_mktemp'         => 'mktemp',
michael@0:             'cmd_Rez'            => 'Rez',
michael@0:             'cmd_rm'             => 'rm',
michael@0:             'cmd_rsync'          => 'rsync',
michael@0:             'cmd_SetFile'        => 'SetFile',
michael@0: 
michael@0:             # create_directly indicates whether hdiutil create supports
michael@0:             # -srcfolder and -srcdevice.  It does on >= 10.3 (Panther).
michael@0:             # This is fixed up for earlier systems below.  If false,
michael@0:             # hdiutil create is used to create empty disk images that
michael@0:             # are manually filled.
michael@0:             'create_directly'    => 1,
michael@0: 
michael@0:             # If hdiutil attach -mountpoint exists, use it to avoid
michael@0:             # mounting disk images in the default /Volumes.  This reduces
michael@0:             # the likelihood that someone will notice a mounted image and
michael@0:             # interfere with it.  Only available on >= 10.3 (Panther),
michael@0:             # fixed up for earlier systems below.
michael@0:             #
michael@0:             # This is presently turned off for all systems, because there
michael@0:             # is an infrequent synchronization problem during ejection.
michael@0:             # diskutil eject might return before the image is actually
michael@0:             # unmounted.  If pkg-dmg then attempts to clean up its
michael@0:             # temporary directory, it could remove items from a read-write
michael@0:             # disk image or attempt to remove items from a read-only disk
michael@0:             # image (or a read-only item from a read-write image) and fail,
michael@0:             # causing pkg-dmg to abort.  This problem is experienced
michael@0:             # under Tiger, which appears to eject asynchronously where
michael@0:             # previous systems treated it as a synchronous operation.
michael@0:             # Using hdiutil attach -mountpoint didn't always keep images
michael@0:             # from showing up on the desktop anyway.
michael@0:             'hdiutil_mountpoint' => 0,
michael@0: 
michael@0:             # hdiutil makehybrid results in optimized disk images that
michael@0:             # consume less space and mount more quickly.  Use it when
michael@0:             # it's available, but that's only on >= 10.3 (Panther).
michael@0:             # If false, hdiutil create is used instead.  Fixed up for
michael@0:             # earlier systems below.
michael@0:             'makehybrid'         => 1,
michael@0: 
michael@0:             # hdiutil create doesn't allow specifying a folder to open
michael@0:             # at volume mount time, so those images are mounted and
michael@0:             # their root folders made holy with bless -openfolder.  But
michael@0:             # only on >= 10.3 (Panther).  Earlier systems are out of luck.
michael@0:             # Even on Panther, bless refuses to run unless root.
michael@0:             # Fixed up below.
michael@0:             'openfolder_bless'   => 1,
michael@0: 
michael@0:             # It's possible to save a few more kilobytes by including the
michael@0:             # partition only without any partition table in the image.
michael@0:             # This is a good idea on any system, so turn this option off.
michael@0:             #
michael@0:             # Except it's buggy.  "-layout NONE" seems to be creating
michael@0:             # disk images with more data than just the partition table
michael@0:             # stripped out.  You might wind up losing the end of the
michael@0:             # filesystem - the last file (or several) might be incomplete.
michael@0:             'partition_table'    => 1,
michael@0: 
michael@0:             # To create a partition table-less image from something
michael@0:             # created by makehybrid, the hybrid image needs to be
michael@0:             # mounted and a new image made from the device associated
michael@0:             # with the relevant partition.  This requires >= 10.4
michael@0:             # (Tiger), presumably because earlier systems have
michael@0:             # problems creating images from devices themselves attached
michael@0:             # to images.  If this is false, makehybrid images will
michael@0:             # have partition tables, regardless of the partition_table
michael@0:             # setting.  Fixed up for earlier systems below.
michael@0:             'recursive_access'   => 1);
michael@0: 
michael@0: # --verbosity
michael@0: $gVerbosity = 2;
michael@0: 
michael@0: # --dry-run
michael@0: $gDryRun = 0;
michael@0: 
michael@0: # %gConfig fix-ups based on features and bugs present in certain releases.
michael@0: my($ignore, $uname_r, $uname_s);
michael@0: ($uname_s, $ignore, $uname_r, $ignore, $ignore) = POSIX::uname();
michael@0: if($uname_s eq 'Darwin') {
michael@0:   ($gDarwinMajor, $ignore) = split(/\./, $uname_r, 2);
michael@0: 
michael@0:   # $major is the Darwin major release, which for our purposes, is 4 higher
michael@0:   # than the interesting digit in a Mac OS X release.
michael@0:   if($gDarwinMajor <= 6) {
michael@0:     # <= 10.2 (Jaguar)
michael@0:     # hdiutil create does not support -srcfolder or -srcdevice
michael@0:     $gConfig{'create_directly'} = 0;
michael@0:     # hdiutil attach does not support -mountpoint
michael@0:     $gConfig{'hdiutil_mountpoint'} = 0;
michael@0:     # hdiutil mkhybrid does not exist
michael@0:     $gConfig{'makehybrid'} = 0;
michael@0:   }
michael@0:   if($gDarwinMajor <= 7) {
michael@0:     # <= 10.3 (Panther)
michael@0:     # Can't mount a disk image and then make a disk image from the device
michael@0:     $gConfig{'recursive_access'} = 0;
michael@0:     # bless does not support -openfolder on 10.2 (Jaguar) and must run
michael@0:     # as root under 10.3 (Panther)
michael@0:     $gConfig{'openfolder_bless'} = 0;
michael@0:   }
michael@0: }
michael@0: else {
michael@0:   # If it's not Mac OS X, just assume all of those good features are
michael@0:   # available.  They're not, but things will fail long before they
michael@0:   # have a chance to make a difference.
michael@0:   #
michael@0:   # Now, if someone wanted to document some of these private formats...
michael@0:   print STDERR ($0.": warning, not running on Mac OS X, ".
michael@0:    "this could be interesting.\n");
michael@0: }
michael@0: 
michael@0: # Non-global variables used in Getopt
michael@0: my(@attributes, @copyFiles, @createSymlinks, $iconFile, $idme, $licenseFile,
michael@0:  @makeDirs, $outputFormat, @resourceFiles, $sourceFile, $sourceFolder,
michael@0:  $targetImage, $tempDir, $volumeName);
michael@0: 
michael@0: # --format
michael@0: $outputFormat = 'UDBZ';
michael@0: 
michael@0: # --idme
michael@0: $idme = 0;
michael@0: 
michael@0: # --sourcefile
michael@0: $sourceFile = 0;
michael@0: 
michael@0: # Leaving this might screw up the Apple tools.
michael@0: delete $ENV{'NEXT_ROOT'};
michael@0: 
michael@0: # This script can get pretty messy, so trap a few signals.
michael@0: $SIG{'INT'} = \&trapSignal;
michael@0: $SIG{'HUP'} = \&trapSignal;
michael@0: $SIG{'TERM'} = \&trapSignal;
michael@0: 
michael@0: Getopt::Long::Configure('pass_through');
michael@0: GetOptions('source=s'    => \$sourceFolder,
michael@0:            'target=s'    => \$targetImage,
michael@0:            'volname=s'   => \$volumeName,
michael@0:            'format=s'    => \$outputFormat,
michael@0:            'tempdir=s'   => \$tempDir,
michael@0:            'mkdir=s'     => \@makeDirs,
michael@0:            'copy=s'      => \@copyFiles,
michael@0:            'symlink=s'   => \@createSymlinks,
michael@0:            'license=s'   => \$licenseFile,
michael@0:            'resource=s'  => \@resourceFiles,
michael@0:            'icon=s'      => \$iconFile,
michael@0:            'attribute=s' => \@attributes,
michael@0:            'idme'        => \$idme,
michael@0:            'sourcefile'  => \$sourceFile,
michael@0:            'verbosity=i' => \$gVerbosity,
michael@0:            'dry-run'     => \$gDryRun,
michael@0:            'config=s'    => \%gConfig); # "hidden" option not in usage()
michael@0: 
michael@0: if(@ARGV) {
michael@0:   # All arguments are parsed by Getopt
michael@0:   usage();
michael@0:   exit(1);
michael@0: }
michael@0: 
michael@0: if($gVerbosity<0 || $gVerbosity>2) {
michael@0:   usage();
michael@0:   exit(1);
michael@0: }
michael@0: 
michael@0: if(!defined($sourceFolder) || $sourceFolder eq '' ||
michael@0:  !defined($targetImage) || $targetImage eq '') {
michael@0:   # --source and --target are required arguments
michael@0:   usage();
michael@0:   exit(1);
michael@0: }
michael@0: 
michael@0: # Make sure $sourceFolder doesn't contain trailing slashes.  It messes with
michael@0: # rsync.
michael@0: while(substr($sourceFolder, -1) eq '/') {
michael@0:   chop($sourceFolder);
michael@0: }
michael@0: 
michael@0: if(!defined($volumeName)) {
michael@0:   # Default volumeName is the name of the source directory.
michael@0:   my(@components);
michael@0:   @components = pathSplit($sourceFolder);
michael@0:   $volumeName = pop(@components);
michael@0: }
michael@0: 
michael@0: my(@tempDirComponents, $targetImageFilename);
michael@0: @tempDirComponents = pathSplit($targetImage);
michael@0: $targetImageFilename = pop(@tempDirComponents);
michael@0: 
michael@0: if(defined($tempDir)) {
michael@0:   @tempDirComponents = pathSplit($tempDir);
michael@0: }
michael@0: else {
michael@0:   # Default tempDir is the same directory as what is specified for
michael@0:   # targetImage
michael@0:   $tempDir = join('/', @tempDirComponents);
michael@0: }
michael@0: 
michael@0: # Ensure that the path of the target image has a suitable extension.  If
michael@0: # it didn't, hdiutil would add one, and we wouldn't be able to find the
michael@0: # file.
michael@0: #
michael@0: # Note that $targetImageFilename is not being reset.  This is because it's
michael@0: # used to build other names below, and we don't need to be adding all sorts
michael@0: # of extra unnecessary extensions to the name.
michael@0: my($originalTargetImage, $requiredExtension);
michael@0: $originalTargetImage = $targetImage;
michael@0: if($outputFormat eq 'UDSP') {
michael@0:   $requiredExtension = '.sparseimage';
michael@0: }
michael@0: else {
michael@0:   $requiredExtension = '.dmg';
michael@0: }
michael@0: $targetImage = giveExtension($originalTargetImage, $requiredExtension);
michael@0: 
michael@0: if($targetImage ne $originalTargetImage) {
michael@0:   print STDERR ($0.": warning: target image extension is being added\n");
michael@0:   print STDERR ('  The new filename is '.
michael@0:    giveExtension($targetImageFilename,$requiredExtension)."\n");
michael@0: }
michael@0: 
michael@0: # Make a temporary directory in $tempDir for our own nefarious purposes.
michael@0: my(@output, $tempSubdir, $tempSubdirTemplate);
michael@0: $tempSubdirTemplate=join('/', @tempDirComponents,
michael@0:  'pkg-dmg.'.$$.'.XXXXXXXX');
michael@0: if(!(@output = commandOutput($gConfig{'cmd_mktemp'}, '-d',
michael@0:  $tempSubdirTemplate)) || $#output != 0) {
michael@0:   cleanupDie('mktemp failed');
michael@0: }
michael@0: 
michael@0: if($gDryRun) {
michael@0:   (@output)=($tempSubdirTemplate);
michael@0: }
michael@0: 
michael@0: ($tempSubdir) = @output;
michael@0: 
michael@0: push(@gCleanup,
michael@0:  sub {commandVerbosity(0, $gConfig{'cmd_rm'}, '-rf', $tempSubdir);});
michael@0: 
michael@0: my($tempMount, $tempRoot, @tempsToMake);
michael@0: $tempRoot = $tempSubdir.'/stage';
michael@0: $tempMount = $tempSubdir.'/mount';
michael@0: push(@tempsToMake, $tempRoot);
michael@0: if($gConfig{'hdiutil_mountpoint'}) {
michael@0:   push(@tempsToMake, $tempMount);
michael@0: }
michael@0: 
michael@0: if(command($gConfig{'cmd_mkdir'}, @tempsToMake) != 0) {
michael@0:   cleanupDie('mkdir tempRoot/tempMount failed');
michael@0: }
michael@0: 
michael@0: # This cleanup object is not strictly necessary, because $tempRoot is inside
michael@0: # of $tempSubdir, but the rest of the script relies on this object being
michael@0: # on the cleanup stack and expects to remove it.
michael@0: push(@gCleanup,
michael@0:  sub {commandVerbosity(0, $gConfig{'cmd_rm'}, '-rf', $tempRoot);});
michael@0: 
michael@0: # If $sourceFile is true, it means that $sourceFolder is to be treated as
michael@0: # a file and placed as a file within the volume root, as opposed to being
michael@0: # treated as the volume root itself.  rsync will do this by default, if no
michael@0: # trailing '/' is present.  With a trailing '/', $sourceFolder becomes
michael@0: # $tempRoot, instead of becoming an entry in $tempRoot.
michael@0: if(command($gConfig{'cmd_rsync'}, '-a', '--copy-unsafe-links',
michael@0:  $sourceFolder.($sourceFile?'':'/'),$tempRoot) != 0) {
michael@0:   cleanupDie('rsync failed');
michael@0: }
michael@0: 
michael@0: if(@makeDirs) {
michael@0:   my($makeDir, @tempDirsToMake);
michael@0:   foreach $makeDir (@makeDirs) {
michael@0:     if($makeDir =~ /^\//) {
michael@0:       push(@tempDirsToMake, $tempRoot.$makeDir);
michael@0:     }
michael@0:     else {
michael@0:       push(@tempDirsToMake, $tempRoot.'/'.$makeDir);
michael@0:     }
michael@0:   }
michael@0:   if(command($gConfig{'cmd_mkdir'}, '-p', @tempDirsToMake) != 0) {
michael@0:     cleanupDie('mkdir failed');
michael@0:   }
michael@0: }
michael@0: 
michael@0: # copy files and/or create symlinks
michael@0: copyFiles($tempRoot, 'copy', @copyFiles);
michael@0: copyFiles($tempRoot, 'symlink', @createSymlinks);
michael@0: 
michael@0: if($gConfig{'create_directly'}) {
michael@0:   # If create_directly is false, the contents will be rsynced into a
michael@0:   # disk image and they would lose their attributes.
michael@0:   setAttributes($tempRoot, @attributes);
michael@0: }
michael@0: 
michael@0: if(defined($iconFile)) {
michael@0:   if(command($gConfig{'cmd_rsync'}, '-a', '--copy-unsafe-links', $iconFile,
michael@0:    $tempRoot.'/.VolumeIcon.icns') != 0) {
michael@0:     cleanupDie('rsync failed for volume icon');
michael@0:   }
michael@0: 
michael@0:   # It's pointless to set the attributes of the root when diskutil create
michael@0:   # -srcfolder is being used.  In that case, the attributes will be set
michael@0:   # later, after the image is already created.
michael@0:   if(isFormatCompressed($outputFormat) &&
michael@0:    (command($gConfig{'cmd_SetFile'}, '-a', 'C', $tempRoot) != 0)) {
michael@0:     cleanupDie('SetFile failed');
michael@0:   }
michael@0: }
michael@0: 
michael@0: if(command($gConfig{'cmd_chmod'}, '-R', 'a+rX,a-st,u+w,go-w',
michael@0:  $tempRoot) != 0) {
michael@0:   cleanupDie('chmod failed');
michael@0: }
michael@0: 
michael@0: my($unflattenable);
michael@0: if(isFormatCompressed($outputFormat)) {
michael@0:   $unflattenable = 1;
michael@0: }
michael@0: else {
michael@0:   $unflattenable = 0;
michael@0: }
michael@0: 
michael@0: diskImageMaker($tempRoot, $targetImage, $outputFormat, $volumeName,
michael@0:  $tempSubdir, $tempMount, $targetImageFilename, defined($iconFile));
michael@0: 
michael@0: if(defined($licenseFile) && $licenseFile ne '') {
michael@0:   my($licenseResource);
michael@0:   $licenseResource = $tempSubdir.'/license.r';
michael@0:   if(!licenseMaker($licenseFile, $licenseResource)) {
michael@0:     cleanupDie('licenseMaker failed');
michael@0:   }
michael@0:   push(@resourceFiles, $licenseResource);
michael@0:   # Don't add a cleanup object because licenseResource is in tempSubdir.
michael@0: }
michael@0: 
michael@0: if(@resourceFiles) {
michael@0:   # Add resources, such as a license agreement.
michael@0: 
michael@0:   # Only unflatten read-only and compressed images.  It's not supported
michael@0:   # on other image times.
michael@0:   if($unflattenable &&
michael@0:    (command($gConfig{'cmd_hdiutil'}, 'unflatten', $targetImage)) != 0) {
michael@0:     cleanupDie('hdiutil unflatten failed');
michael@0:   }
michael@0:   # Don't push flatten onto the cleanup stack.  If we fail now, we'll be
michael@0:   # removing $targetImage anyway.
michael@0: 
michael@0:   # Type definitions come from Carbon.r.
michael@0:   if(command($gConfig{'cmd_Rez'}, 'Carbon.r', @resourceFiles, '-a', '-o',
michael@0:    $targetImage) != 0) {
michael@0:     cleanupDie('Rez failed');
michael@0:   }
michael@0: 
michael@0:   # Flatten.  This merges the resource fork into the data fork, so no
michael@0:   # special encoding is needed to transfer the file.
michael@0:   if($unflattenable &&
michael@0:    (command($gConfig{'cmd_hdiutil'}, 'flatten', $targetImage)) != 0) {
michael@0:     cleanupDie('hdiutil flatten failed');
michael@0:   }
michael@0: }
michael@0: 
michael@0: # $tempSubdir is no longer needed.  It's buried on the stack below the
michael@0: # rm of the fresh image file.  Splice in this fashion is equivalent to
michael@0: # pop-save, pop, push-save.
michael@0: splice(@gCleanup, -2, 1);
michael@0: # No need to remove licenseResource separately, it's in tempSubdir.
michael@0: if(command($gConfig{'cmd_rm'}, '-rf', $tempSubdir) != 0) {
michael@0:   cleanupDie('rm -rf tempSubdir failed');
michael@0: }
michael@0: 
michael@0: if($idme) {
michael@0:   if(command($gConfig{'cmd_hdiutil'}, 'internet-enable', '-yes',
michael@0:    $targetImage) != 0) {
michael@0:     cleanupDie('hdiutil internet-enable failed');
michael@0:   }
michael@0: }
michael@0: 
michael@0: # Done.
michael@0: 
michael@0: exit(0);
michael@0: 
michael@0: # argumentEscape(@arguments)
michael@0: #
michael@0: # Takes a list of @arguments and makes them shell-safe.
michael@0: sub argumentEscape(@) {
michael@0:   my(@arguments);
michael@0:   @arguments = @_;
michael@0:   my($argument, @argumentsOut);
michael@0:   foreach $argument (@arguments) {
michael@0:     $argument =~ s%([^A-Za-z0-9_\-/.=+,])%\\$1%g;
michael@0:     push(@argumentsOut, $argument);
michael@0:   }
michael@0:   return @argumentsOut;
michael@0: }
michael@0: 
michael@0: # cleanupDie($message)
michael@0: #
michael@0: # Displays $message as an error message, and then runs through the
michael@0: # @gCleanup stack, performing any cleanup operations needed before
michael@0: # exiting.  Does not return, exits with exit status 1.
michael@0: sub cleanupDie($) {
michael@0:   my($message);
michael@0:   ($message) = @_;
michael@0:   print STDERR ($0.': '.$message.(@gCleanup?' (cleaning up)':'')."\n");
michael@0:   while(@gCleanup) {
michael@0:     my($subroutine);
michael@0:     $subroutine = pop(@gCleanup);
michael@0:     &$subroutine;
michael@0:   }
michael@0:   exit(1);
michael@0: }
michael@0: 
michael@0: # command(@arguments)
michael@0: #
michael@0: # Runs the specified command at the verbosity level defined by $gVerbosity.
michael@0: # Returns nonzero on failure, returning the exit status if appropriate.
michael@0: # Discards command output.
michael@0: sub command(@) {
michael@0:   my(@arguments);
michael@0:   @arguments = @_;
michael@0:   return commandVerbosity($gVerbosity,@arguments);
michael@0: }
michael@0: 
michael@0: # commandInternal($command, @arguments)
michael@0: #
michael@0: # Runs the specified internal command at the verbosity level defined by
michael@0: # $gVerbosity.
michael@0: # Returns zero(!) on failure, because commandInternal is supposed to be a
michael@0: # direct replacement for the Perl system call wrappers, which, unlike shell
michael@0: # commands and C equivalent system calls, return true (instead of 0) to
michael@0: # indicate success.
michael@0: sub commandInternal($@) {
michael@0:   my(@arguments, $command);
michael@0:   ($command, @arguments) = @_;
michael@0:   return commandInternalVerbosity($gVerbosity, $command, @arguments);
michael@0: }
michael@0: 
michael@0: # commandInternalVerbosity($verbosity, $command, @arguments)
michael@0: #
michael@0: # Run an internal command, printing a bogus command invocation message if
michael@0: # $verbosity is true.
michael@0: #
michael@0: # If $command is unlink:
michael@0: # Removes the files specified by @arguments.  Wraps unlink.
michael@0: #
michael@0: # If $command is symlink:
michael@0: # Creates the symlink specified by @arguments. Wraps symlink.
michael@0: sub commandInternalVerbosity($$@) {
michael@0:   my(@arguments, $command, $verbosity);
michael@0:   ($verbosity, $command, @arguments) = @_;
michael@0:   if($command eq 'unlink') {
michael@0:     if($verbosity || $gDryRun) {
michael@0:       print(join(' ', 'rm', '-f', argumentEscape(@arguments))."\n");
michael@0:     }
michael@0:     if($gDryRun) {
michael@0:       return $#arguments+1;
michael@0:     }
michael@0:     return unlink(@arguments);
michael@0:   }
michael@0:   elsif($command eq 'symlink') {
michael@0:     if($verbosity || $gDryRun) {
michael@0:       print(join(' ', 'ln', '-s', argumentEscape(@arguments))."\n");
michael@0:     }
michael@0:     if($gDryRun) {
michael@0:       return 1;
michael@0:     }
michael@0:     my($source, $target);
michael@0:     ($source, $target) = @arguments;
michael@0:     return symlink($source, $target);
michael@0:   }
michael@0: }
michael@0: 
michael@0: # commandOutput(@arguments)
michael@0: #
michael@0: # Runs the specified command at the verbosity level defined by $gVerbosity.
michael@0: # Output is returned in an array of lines.  undef is returned on failure.
michael@0: # The exit status is available in $?.
michael@0: sub commandOutput(@) {
michael@0:   my(@arguments);
michael@0:   @arguments = @_;
michael@0:   return commandOutputVerbosity($gVerbosity, @arguments);
michael@0: }
michael@0: 
michael@0: # commandOutputVerbosity($verbosity, @arguments)
michael@0: #
michael@0: # Runs the specified command at the verbosity level defined by the
michael@0: # $verbosity argument.  Output is returned in an array of lines.  undef is
michael@0: # returned on failure.  The exit status is available in $?.
michael@0: #
michael@0: # If an error occurs in fork or exec, an error message is printed to
michael@0: # stderr and undef is returned.
michael@0: #
michael@0: # If $verbosity is 0, the command invocation is not printed, and its
michael@0: # stdout is not echoed back to stdout.
michael@0: #
michael@0: # If $verbosity is 1, the command invocation is printed.
michael@0: #
michael@0: # If $verbosity is 2, the command invocation is printed and the output
michael@0: # from stdout is echoed back to stdout.
michael@0: #
michael@0: # Regardless of $verbosity, stderr is left connected.
michael@0: sub commandOutputVerbosity($@) {
michael@0:   my(@arguments, $verbosity);
michael@0:   ($verbosity, @arguments) = @_;
michael@0:   my($pid);
michael@0:   if($verbosity || $gDryRun) {
michael@0:     print(join(' ', argumentEscape(@arguments))."\n");
michael@0:   }
michael@0:   if($gDryRun) {
michael@0:     return(1);
michael@0:   }
michael@0:   if (!defined($pid = open(*COMMAND, '-|'))) {
michael@0:     printf STDERR ($0.': fork: '.$!."\n");
michael@0:     return undef;
michael@0:   }
michael@0:   elsif ($pid) {
michael@0:     # parent
michael@0:     my(@lines);
michael@0:     while(!eof(*COMMAND)) {
michael@0:       my($line);
michael@0:       chop($line = <COMMAND>);
michael@0:       if($verbosity > 1) {
michael@0:         print($line."\n");
michael@0:       }
michael@0:       push(@lines, $line);
michael@0:     }
michael@0:     close(*COMMAND);
michael@0:     if ($? == -1) {
michael@0:       printf STDERR ($0.': fork: '.$!."\n");
michael@0:       return undef;
michael@0:     }
michael@0:     elsif ($? & 127) {
michael@0:       printf STDERR ($0.': exited on signal '.($? & 127).
michael@0:        ($? & 128 ? ', core dumped' : '')."\n");
michael@0:       return undef;
michael@0:     }
michael@0:     return @lines;
michael@0:   }
michael@0:   else {
michael@0:     # child; this form of exec is immune to shell games
michael@0:     if(!exec {$arguments[0]} (@arguments)) {
michael@0:       printf STDERR ($0.': exec: '.$!."\n");
michael@0:       exit(-1);
michael@0:     }
michael@0:   }
michael@0: }
michael@0: 
michael@0: # commandVerbosity($verbosity, @arguments)
michael@0: #
michael@0: # Runs the specified command at the verbosity level defined by the
michael@0: # $verbosity argument.  Returns nonzero on failure, returning the exit
michael@0: # status if appropriate.  Discards command output.
michael@0: sub commandVerbosity($@) {
michael@0:   my(@arguments, $verbosity);
michael@0:   ($verbosity, @arguments) = @_;
michael@0:   if(!defined(commandOutputVerbosity($verbosity, @arguments))) {
michael@0:     return -1;
michael@0:   }
michael@0:   return $?;
michael@0: }
michael@0: 
michael@0: # copyFiles($tempRoot, $method, @arguments)
michael@0: #
michael@0: # Copies files or create symlinks in the disk image.
michael@0: # See --copy and --symlink descriptions for details.
michael@0: # If $method is 'copy', @arguments are interpreted as source:target, if $method
michael@0: # is 'symlink', @arguments are interpreted as symlink:target.
michael@0: sub copyFiles($@) {
michael@0:   my(@fileList, $method, $tempRoot);
michael@0:   ($tempRoot, $method, @fileList) = @_;
michael@0:   my($file, $isSymlink);
michael@0:   $isSymlink = ($method eq 'symlink');
michael@0:   foreach $file (@fileList) {
michael@0:     my($source, $target);
michael@0:     ($source, $target) = split(/:/, $file);
michael@0:     if(!defined($target) and $isSymlink) {
michael@0:       # empty symlink targets would result in an invalid target and fail,
michael@0:       # but they shall be interpreted as "like source path, but inside dmg"
michael@0:       $target = $source;
michael@0:     }
michael@0:     if(!defined($target)) {
michael@0:       $target = $tempRoot;
michael@0:     }
michael@0:     elsif($target =~ /^\//) {
michael@0:       $target = $tempRoot.$target;
michael@0:     }
michael@0:     else {
michael@0:       $target = $tempRoot.'/'.$target;
michael@0:     }
michael@0: 
michael@0:     my($success);
michael@0:     if($isSymlink) {
michael@0:       $success = commandInternal('symlink', $source, $target);
michael@0:     }
michael@0:     else {
michael@0:       $success = !command($gConfig{'cmd_rsync'}, '-a', '--copy-unsafe-links',
michael@0:                           $source, $target);
michael@0:     }
michael@0:     if(!$success) {
michael@0:       cleanupDie('copyFiles failed for method '.$method);
michael@0:     }
michael@0:   }
michael@0: }
michael@0: 
michael@0: # diskImageMaker($source, $destination, $format, $name, $tempDir, $tempMount,
michael@0: #  $baseName, $setRootIcon)
michael@0: #
michael@0: # Creates a disk image in $destination of format $format corresponding to the
michael@0: # source directory $source.  $name is the volume name.  $tempDir is a good
michael@0: # place to write temporary files, which should be empty (aside from the other
michael@0: # things that this script might create there, like stage and mount).
michael@0: # $tempMount is a mount point for temporary disk images.  $baseName is the
michael@0: # name of the disk image, and is presently unused.  $setRootIcon is true if
michael@0: # a volume icon was added to the staged $source and indicates that the
michael@0: # custom volume icon bit on the volume root needs to be set.
michael@0: sub diskImageMaker($$$$$$$$) {
michael@0:   my($baseName, $destination, $format, $name, $setRootIcon, $source,
michael@0:    $tempDir, $tempMount);
michael@0:   ($source, $destination, $format, $name, $tempDir, $tempMount,
michael@0:    $baseName, $setRootIcon) = @_;
michael@0:   if(isFormatCompressed($format)) {
michael@0:     my($uncompressedImage);
michael@0: 
michael@0:     if($gConfig{'makehybrid'}) {
michael@0:       my($hybridImage);
michael@0:       $hybridImage = giveExtension($tempDir.'/hybrid', '.dmg');
michael@0: 
michael@0:       if(command($gConfig{'cmd_hdiutil'}, 'makehybrid', '-hfs',
michael@0:        '-hfs-volume-name', $name, '-hfs-openfolder', $source, '-ov',
michael@0:        $source, '-o', $hybridImage) != 0) {
michael@0:         cleanupDie('hdiutil makehybrid failed');
michael@0:       }
michael@0: 
michael@0:       $uncompressedImage = $hybridImage;
michael@0: 
michael@0:       # $source is no longer needed and will be removed before anything
michael@0:       # else can fail.  splice in this form is the same as pop/push.
michael@0:       splice(@gCleanup, -1, 1,
michael@0:        sub {commandInternalVerbosity(0, 'unlink', $hybridImage);});
michael@0: 
michael@0:       if(command($gConfig{'cmd_rm'}, '-rf', $source) != 0) {
michael@0:         cleanupDie('rm -rf failed');
michael@0:       }
michael@0: 
michael@0:       if(!$gConfig{'partition_table'} && $gConfig{'recursive_access'}) {
michael@0:         # Even if we do want to create disk images without partition tables,
michael@0:         # it's impossible unless recursive_access is set.
michael@0:         my($rootDevice, $partitionDevice, $partitionMountPoint);
michael@0: 
michael@0:         if(!(($rootDevice, $partitionDevice, $partitionMountPoint) =
michael@0:          hdidMountImage($tempMount, '-readonly', $hybridImage))) {
michael@0:           cleanupDie('hdid mount failed');
michael@0:         }
michael@0: 
michael@0:         push(@gCleanup, sub {commandVerbosity(0,
michael@0:          $gConfig{'cmd_diskutil'}, 'eject', $rootDevice);});
michael@0: 
michael@0:         my($udrwImage);
michael@0:         $udrwImage = giveExtension($tempDir.'/udrw', '.dmg');
michael@0: 
michael@0:         if(command($gConfig{'cmd_hdiutil'}, 'create', '-format', 'UDRW',
michael@0:          '-ov', '-srcdevice', $partitionDevice, $udrwImage) != 0) {
michael@0:           cleanupDie('hdiutil create failed');
michael@0:         }
michael@0: 
michael@0:         $uncompressedImage = $udrwImage;
michael@0: 
michael@0:         # Going to eject before anything else can fail.  Get the eject off
michael@0:         # the stack.
michael@0:         pop(@gCleanup);
michael@0: 
michael@0:         # $hybridImage will be removed soon, but until then, it needs to
michael@0:         # stay on the cleanup stack.  It needs to wait until after
michael@0:         # ejection.  $udrwImage is staying around.  Make it appear as
michael@0:         # though it's been done before $hybridImage.
michael@0:         #
michael@0:         # splice in this form is the same as popping one element to
michael@0:         # @tempCleanup and pushing the subroutine.
michael@0:         my(@tempCleanup);
michael@0:         @tempCleanup = splice(@gCleanup, -1, 1,
michael@0:          sub {commandInternalVerbosity(0, 'unlink', $udrwImage);});
michael@0:         push(@gCleanup, @tempCleanup);
michael@0: 
michael@0:         if(command($gConfig{'cmd_diskutil'}, 'eject', $rootDevice) != 0) {
michael@0:           cleanupDie('diskutil eject failed');
michael@0:         }
michael@0: 
michael@0:         # Pop unlink of $uncompressedImage
michael@0:         pop(@gCleanup);
michael@0: 
michael@0:         if(commandInternal('unlink', $hybridImage) != 1) {
michael@0:           cleanupDie('unlink hybridImage failed: '.$!);
michael@0:         }
michael@0:       }
michael@0:     }
michael@0:     else {
michael@0:       # makehybrid is not available, fall back to making a UDRW and
michael@0:       # converting to a compressed image.  It ought to be possible to
michael@0:       # create a compressed image directly, but those come out far too
michael@0:       # large (journaling?) and need to be read-write to fix up the
michael@0:       # volume icon anyway.  Luckily, we can take advantage of a single
michael@0:       # call back into this function.
michael@0:       my($udrwImage);
michael@0:       $udrwImage = giveExtension($tempDir.'/udrw', '.dmg');
michael@0: 
michael@0:       diskImageMaker($source, $udrwImage, 'UDRW', $name, $tempDir,
michael@0:        $tempMount, $baseName, $setRootIcon);
michael@0: 
michael@0:       # The call back into diskImageMaker already removed $source.
michael@0: 
michael@0:       $uncompressedImage = $udrwImage;
michael@0:     }
michael@0: 
michael@0:     # The uncompressed disk image is now in its final form.  Compress it.
michael@0:     # Jaguar doesn't support hdiutil convert -ov, but it always allows
michael@0:     # overwriting.
michael@0:     # bzip2-compressed UDBZ images can only be created and mounted on 10.4
michael@0:     # and later.  The bzip2-level imagekey is only effective when creating
michael@0:     # images in 10.5.  In 10.4, bzip2-level is harmlessly ignored, and the
michael@0:     # default value of 1 is always used.
michael@0:     if(command($gConfig{'cmd_hdiutil'}, 'convert', '-format', $format,
michael@0:      '-imagekey', ($format eq 'UDBZ' ? 'bzip2-level=9' : 'zlib-level=9'),
michael@0:      (defined($gDarwinMajor) && $gDarwinMajor <= 6 ? () : ('-ov')),
michael@0:      $uncompressedImage, '-o', $destination) != 0) {
michael@0:       cleanupDie('hdiutil convert failed');
michael@0:     }
michael@0: 
michael@0:     # $uncompressedImage is going to be unlinked before anything else can
michael@0:     # fail.  splice in this form is the same as pop/push.
michael@0:     splice(@gCleanup, -1, 1,
michael@0:      sub {commandInternalVerbosity(0, 'unlink', $destination);});
michael@0: 
michael@0:     if(commandInternal('unlink', $uncompressedImage) != 1) {
michael@0:       cleanupDie('unlink uncompressedImage failed: '.$!);
michael@0:     }
michael@0: 
michael@0:     # At this point, the only thing that the compressed block has added to
michael@0:     # the cleanup stack is the removal of $destination.  $source has already
michael@0:     # been removed, and its cleanup entry has been removed as well.
michael@0:   }
michael@0:   elsif($format eq 'UDRW' || $format eq 'UDSP') {
michael@0:     my(@extraArguments);
michael@0:     if(!$gConfig{'partition_table'}) {
michael@0:       @extraArguments = ('-layout', 'NONE');
michael@0:     }
michael@0: 
michael@0:     if($gConfig{'create_directly'}) {
michael@0:       # Use -fs HFS+ to suppress the journal.
michael@0:       if(command($gConfig{'cmd_hdiutil'}, 'create', '-format', $format,
michael@0:        @extraArguments, '-fs', 'HFS+', '-volname', $name,
michael@0:        '-ov', '-srcfolder', $source, $destination) != 0) {
michael@0:         cleanupDie('hdiutil create failed');
michael@0:       }
michael@0: 
michael@0:       # $source is no longer needed and will be removed before anything
michael@0:       # else can fail.  splice in this form is the same as pop/push.
michael@0:       splice(@gCleanup, -1, 1,
michael@0:        sub {commandInternalVerbosity(0, 'unlink', $destination);});
michael@0: 
michael@0:       if(command($gConfig{'cmd_rm'}, '-rf', $source) != 0) {
michael@0:         cleanupDie('rm -rf failed');
michael@0:       }
michael@0:     }
michael@0:     else {
michael@0:       # hdiutil create does not support -srcfolder or -srcdevice, it only
michael@0:       # knows how to create blank images.  Figure out how large an image
michael@0:       # is needed, create it, and fill it.  This is needed for Jaguar.
michael@0: 
michael@0:       # Use native block size for hdiutil create -sectors.
michael@0:       delete $ENV{'BLOCKSIZE'};
michael@0: 
michael@0:       my(@duOutput, $ignore, $sizeBlocks, $sizeOverhead, $sizeTotal, $type);
michael@0:       if(!(@output = commandOutput($gConfig{'cmd_du'}, '-s', $tempRoot)) ||
michael@0:        $? != 0) {
michael@0:         cleanupDie('du failed');
michael@0:       }
michael@0:       ($sizeBlocks, $ignore) = split(' ', $output[0], 2);
michael@0: 
michael@0:       # The filesystem itself takes up 152 blocks of its own blocks for the
michael@0:       # filesystem up to 8192 blocks, plus 64 blocks for every additional
michael@0:       # 4096 blocks or portion thereof.
michael@0:       $sizeOverhead = 152 + 64 * POSIX::ceil(
michael@0:        (($sizeBlocks - 8192) > 0) ? (($sizeBlocks - 8192) / (4096 - 64)) : 0);
michael@0: 
michael@0:       # The number of blocks must be divisible by 8.
michael@0:       my($mod);
michael@0:       if($mod = ($sizeOverhead % 8)) {
michael@0:         $sizeOverhead += 8 - $mod;
michael@0:       }
michael@0: 
michael@0:       # sectors is taken as the size of a disk, not a filesystem, so the
michael@0:       # partition table eats into it.
michael@0:       if($gConfig{'partition_table'}) {
michael@0:         $sizeOverhead += 80;
michael@0:       }
michael@0: 
michael@0:       # That was hard.  Leave some breathing room anyway.  Use 1024 sectors
michael@0:       # (512kB).  These read-write images wouldn't be useful if they didn't
michael@0:       # have at least a little free space.
michael@0:       $sizeTotal = $sizeBlocks + $sizeOverhead + 1024;
michael@0: 
michael@0:       # Minimum sizes - these numbers are larger on Jaguar than on later
michael@0:       # systems.  Just use the Jaguar numbers, since it's unlikely to wind
michael@0:       # up here on any other release.
michael@0:       if($gConfig{'partition_table'} && $sizeTotal < 8272) {
michael@0:         $sizeTotal = 8272;
michael@0:       }
michael@0:       if(!$gConfig{'partition_table'} && $sizeTotal < 8192) {
michael@0:         $sizeTotal = 8192;
michael@0:       }
michael@0: 
michael@0:       # hdiutil create without -srcfolder or -srcdevice will not accept
michael@0:       # -format.  It uses -type.  Fortunately, the two supported formats
michael@0:       # here map directly to the only two supported types.
michael@0:       if ($format eq 'UDSP') {
michael@0:         $type = 'SPARSE';
michael@0:       }
michael@0:       else {
michael@0:         $type = 'UDIF';
michael@0:       }
michael@0: 
michael@0:       if(command($gConfig{'cmd_hdiutil'}, 'create', '-type', $type,
michael@0:        @extraArguments, '-fs', 'HFS+', '-volname', $name,
michael@0:        '-ov', '-sectors', $sizeTotal, $destination) != 0) {
michael@0:         cleanupDie('hdiutil create failed');
michael@0:       }
michael@0: 
michael@0:       push(@gCleanup,
michael@0:        sub {commandInternalVerbosity(0, 'unlink', $destination);});
michael@0: 
michael@0:       # The rsync will occur shortly.
michael@0:     }
michael@0: 
michael@0:     my($mounted, $rootDevice, $partitionDevice, $partitionMountPoint);
michael@0: 
michael@0:     $mounted=0;
michael@0:     if(!$gConfig{'create_directly'} || $gConfig{'openfolder_bless'} ||
michael@0:      $setRootIcon) {
michael@0:       # The disk image only needs to be mounted if:
michael@0:       #  create_directly is false, because the content needs to be copied
michael@0:       #  openfolder_bless is true, because bless -openfolder needs to run
michael@0:       #  setRootIcon is true, because the root needs its attributes set.
michael@0:       if(!(($rootDevice, $partitionDevice, $partitionMountPoint) =
michael@0:        hdidMountImage($tempMount, $destination))) {
michael@0:         cleanupDie('hdid mount failed');
michael@0:       }
michael@0: 
michael@0:       $mounted=1;
michael@0: 
michael@0:       push(@gCleanup, sub {commandVerbosity(0,
michael@0:        $gConfig{'cmd_diskutil'}, 'eject', $rootDevice);});
michael@0:     }
michael@0: 
michael@0:     if(!$gConfig{'create_directly'}) {
michael@0:       # Couldn't create and copy directly in one fell swoop.  Now that
michael@0:       # the volume is mounted, copy the files.  --copy-unsafe-links is
michael@0:       # unnecessary since it was used to copy everything to the staging
michael@0:       # area.  There can be no more unsafe links.
michael@0:       if(command($gConfig{'cmd_rsync'}, '-a',
michael@0:        $source.'/',$partitionMountPoint) != 0) {
michael@0:         cleanupDie('rsync to new volume failed');
michael@0:       }
michael@0: 
michael@0:       # We need to get the rm -rf of $source off the stack, because it's
michael@0:       # being cleaned up here.  There are two items now on top of it:
michael@0:       # removing the target image and, above that, ejecting it.  Splice it
michael@0:       # out.
michael@0:       my(@tempCleanup);
michael@0:       @tempCleanup = splice(@gCleanup, -2);
michael@0:       # The next splice is the same as popping once and pushing @tempCleanup.
michael@0:       splice(@gCleanup, -1, 1, @tempCleanup);
michael@0: 
michael@0:       if(command($gConfig{'cmd_rm'}, '-rf', $source) != 0) {
michael@0:         cleanupDie('rm -rf failed');
michael@0:       }
michael@0:     }
michael@0: 
michael@0:     if($gConfig{'openfolder_bless'}) {
michael@0:       # On Tiger, the bless docs say to use --openfolder, but only
michael@0:       # --openfolder is accepted on Panther.  Tiger takes it with a single
michael@0:       # dash too.  Jaguar is out of luck.
michael@0:       if(command($gConfig{'cmd_bless'}, '-openfolder',
michael@0:        $partitionMountPoint) != 0) {
michael@0:         cleanupDie('bless failed');
michael@0:       }
michael@0:     }
michael@0: 
michael@0:     setAttributes($partitionMountPoint, @attributes);
michael@0: 
michael@0:     if($setRootIcon) {
michael@0:       # When "hdiutil create -srcfolder" is used, the root folder's
michael@0:       # attributes are not copied to the new volume.  Fix up.
michael@0: 
michael@0:       if(command($gConfig{'cmd_SetFile'}, '-a', 'C',
michael@0:        $partitionMountPoint) != 0) {
michael@0:         cleanupDie('SetFile failed');
michael@0:       }
michael@0:     }
michael@0: 
michael@0:     if($mounted) {
michael@0:       # Pop diskutil eject
michael@0:       pop(@gCleanup);
michael@0: 
michael@0:       if(command($gConfig{'cmd_diskutil'}, 'eject', $rootDevice) != 0) {
michael@0:         cleanupDie('diskutil eject failed');
michael@0:       }
michael@0:     }
michael@0: 
michael@0:     # End of UDRW/UDSP section.  At this point, $source has been removed
michael@0:     # and its cleanup entry has been removed from the stack.
michael@0:   }
michael@0:   else {
michael@0:     cleanupDie('unrecognized format');
michael@0:     print STDERR ($0.": unrecognized format\n");
michael@0:     exit(1);
michael@0:   }
michael@0: }
michael@0: 
michael@0: # giveExtension($file, $extension)
michael@0: #
michael@0: # If $file does not end in $extension, $extension is added.  The new
michael@0: # filename is returned.
michael@0: sub giveExtension($$) {
michael@0:   my($extension, $file);
michael@0:   ($file, $extension) = @_;
michael@0:   if(substr($file, -length($extension)) ne $extension) {
michael@0:     return $file.$extension;
michael@0:   }
michael@0:   return $file;
michael@0: }
michael@0: 
michael@0: # hdidMountImage($mountPoint, @arguments)
michael@0: #
michael@0: # Runs the hdid command with arguments specified by @arguments.
michael@0: # @arguments may be a single-element array containing the name of the
michael@0: # disk image to mount.  Returns a three-element array, with elements
michael@0: # corresponding to:
michael@0: #  - The root device of the mounted image, suitable for ejection
michael@0: #  - The device corresponding to the mounted partition
michael@0: #  - The mounted partition's mount point
michael@0: #
michael@0: # If running on a system that supports easy mounting at points outside
michael@0: # of the default /Volumes with hdiutil attach, it is used instead of hdid,
michael@0: # and $mountPoint is used as the mount point.
michael@0: #
michael@0: # The root device will differ from the partition device when the disk
michael@0: # image contains a partition table, otherwise, they will be identical.
michael@0: #
michael@0: # If hdid fails, undef is returned.
michael@0: sub hdidMountImage($@) {
michael@0:   my(@arguments, @command, $mountPoint);
michael@0:   ($mountPoint, @arguments) = @_;
michael@0:   my(@output);
michael@0: 
michael@0:   if($gConfig{'hdiutil_mountpoint'}) {
michael@0:     @command=($gConfig{'cmd_hdiutil'}, 'attach', @arguments,
michael@0:      '-mountpoint', $mountPoint);
michael@0:   }
michael@0:   else {
michael@0:     @command=($gConfig{'cmd_hdid'}, @arguments);
michael@0:   }
michael@0: 
michael@0:   if(!(@output = commandOutput(@command)) ||
michael@0:    $? != 0) {
michael@0:     return undef;
michael@0:   }
michael@0: 
michael@0:   if($gDryRun) {
michael@0:     return('/dev/diskX','/dev/diskXsY','/Volumes/'.$volumeName);
michael@0:   }
michael@0: 
michael@0:   my($line, $restOfLine, $rootDevice);
michael@0: 
michael@0:   foreach $line (@output) {
michael@0:     my($device, $mountpoint);
michael@0:     if($line !~ /^\/dev\//) {
michael@0:       # Consider only lines that correspond to /dev entries
michael@0:       next;
michael@0:     }
michael@0:     ($device, $restOfLine) = split(' ', $line, 2);
michael@0: 
michael@0:     if(!defined($rootDevice) || $rootDevice eq '') {
michael@0:       # If this is the first device seen, it's the root device to be
michael@0:       # used for ejection.  Keep it.
michael@0:       $rootDevice = $device;
michael@0:     }
michael@0: 
michael@0:     if($restOfLine =~ /(\/.*)/) {
michael@0:       # The first partition with a mount point is the interesting one.  It's
michael@0:       # usually Apple_HFS and usually the last one in the list, but beware of
michael@0:       # the possibility of other filesystem types and the Apple_Free partition.
michael@0:       # If the disk image contains no partition table, the partition will not
michael@0:       # have a type, so look for the mount point by looking for a slash.
michael@0:       $mountpoint = $1;
michael@0:       return($rootDevice, $device, $mountpoint);
michael@0:     }
michael@0:   }
michael@0: 
michael@0:   # No mount point?  This is bad.  If there's a root device, eject it.
michael@0:   if(defined($rootDevice) && $rootDevice ne '') {
michael@0:     # Failing anyway, so don't care about failure
michael@0:     commandVerbosity(0, $gConfig{'cmd_diskutil'}, 'eject', $rootDevice);
michael@0:   }
michael@0: 
michael@0:   return undef;
michael@0: }
michael@0: 
michael@0: # isFormatCompressed($format)
michael@0: #
michael@0: # Returns true if $format corresponds to a compressed disk image format.
michael@0: # Returns false otherwise.
michael@0: sub isFormatCompressed($) {
michael@0:   my($format);
michael@0:   ($format) = @_;
michael@0:   return $format eq 'UDZO' || $format eq 'UDBZ';
michael@0: }
michael@0: 
michael@0: # licenseMaker($text, $resource)
michael@0: #
michael@0: # Takes a plain text file at path $text and creates a license agreement
michael@0: # resource containing the text at path $license.  English-only, and
michael@0: # no special formatting.  This is the bare-bones stuff.  For more
michael@0: # intricate license agreements, create your own resource.
michael@0: #
michael@0: # ftp://ftp.apple.com/developer/Development_Kits/SLAs_for_UDIFs_1.0.dmg
michael@0: sub licenseMaker($$) {
michael@0:   my($resource, $text);
michael@0:   ($text, $resource) = @_;
michael@0:   if(!sysopen(*TEXT, $text, O_RDONLY)) {
michael@0:     print STDERR ($0.': licenseMaker: sysopen text: '.$!."\n");
michael@0:     return 0;
michael@0:   }
michael@0:   if(!sysopen(*RESOURCE, $resource, O_WRONLY|O_CREAT|O_EXCL)) {
michael@0:     print STDERR ($0.': licenseMaker: sysopen resource: '.$!."\n");
michael@0:     return 0;
michael@0:   }
michael@0:   print RESOURCE << '__EOT__';
michael@0: // See /System/Library/Frameworks/CoreServices.framework/Frameworks/CarbonCore.framework/Headers/Script.h for language IDs.
michael@0: data 'LPic' (5000) {
michael@0:   // Default language ID, 0 = English
michael@0:   $"0000"
michael@0:   // Number of entries in list
michael@0:   $"0001"
michael@0: 
michael@0:   // Entry 1
michael@0:   // Language ID, 0 = English
michael@0:   $"0000"
michael@0:   // Resource ID, 0 = STR#/TEXT/styl 5000
michael@0:   $"0000"
michael@0:   // Multibyte language, 0 = no
michael@0:   $"0000"
michael@0: };
michael@0: 
michael@0: resource 'STR#' (5000, "English") {
michael@0:   {
michael@0:     // Language (unused?) = English
michael@0:     "English",
michael@0:     // Agree
michael@0:     "Agree",
michael@0:     // Disagree
michael@0:     "Disagree",
michael@0: __EOT__
michael@0:     # This stuff needs double-quotes for interpolations to work.
michael@0:     print RESOURCE ("    // Print, ellipsis is 0xC9\n");
michael@0:     print RESOURCE ("    \"Print\xc9\",\n");
michael@0:     print RESOURCE ("    // Save As, ellipsis is 0xC9\n");
michael@0:     print RESOURCE ("    \"Save As\xc9\",\n");
michael@0:     print RESOURCE ('    // Descriptive text, curly quotes are 0xD2 and 0xD3'.
michael@0:      "\n");
michael@0:     print RESOURCE ('    "If you agree to the terms of this license '.
michael@0:      "agreement, click \xd2Agree\xd3 to access the software.  If you ".
michael@0:      "do not agree, press \xd2Disagree.\xd3\"\n");
michael@0: print RESOURCE << '__EOT__';
michael@0:   };
michael@0: };
michael@0: 
michael@0: // Beware of 1024(?) byte (character?) line length limitation.  Split up long
michael@0: // lines.
michael@0: // If straight quotes are used ("), remember to escape them (\").
michael@0: // Newline is \n, to leave a blank line, use two of them.
michael@0: // 0xD2 and 0xD3 are curly double-quotes ("), 0xD4 and 0xD5 are curly
michael@0: //   single quotes ('), 0xD5 is also the apostrophe.
michael@0: data 'TEXT' (5000, "English") {
michael@0: __EOT__
michael@0: 
michael@0:   while(!eof(*TEXT)) {
michael@0:     my($line);
michael@0:     chop($line = <TEXT>);
michael@0: 
michael@0:     while(defined($line)) {
michael@0:       my($chunk);
michael@0: 
michael@0:       # Rez doesn't care for lines longer than (1024?) characters.  Split
michael@0:       # at less than half of that limit, in case everything needs to be
michael@0:       # backwhacked.
michael@0:       if(length($line)>500) {
michael@0:         $chunk = substr($line, 0, 500);
michael@0:         $line = substr($line, 500);
michael@0:       }
michael@0:       else {
michael@0:         $chunk = $line;
michael@0:         $line = undef;
michael@0:       }
michael@0: 
michael@0:       if(length($chunk) > 0) {
michael@0:         # Unsafe characters are the double-quote (") and backslash (\), escape
michael@0:         # them with backslashes.
michael@0:         $chunk =~ s/(["\\])/\\$1/g;
michael@0: 
michael@0:         print RESOURCE '  "'.$chunk.'"'."\n";
michael@0:       }
michael@0:     }
michael@0:     print RESOURCE '  "\n"'."\n";
michael@0:   }
michael@0:   close(*TEXT);
michael@0: 
michael@0:   print RESOURCE << '__EOT__';
michael@0: };
michael@0: 
michael@0: data 'styl' (5000, "English") {
michael@0:   // Number of styles following = 1
michael@0:   $"0001"
michael@0: 
michael@0:   // Style 1.  This is used to display the first two lines in bold text.
michael@0:   // Start character = 0
michael@0:   $"0000 0000"
michael@0:   // Height = 16
michael@0:   $"0010"
michael@0:   // Ascent = 12
michael@0:   $"000C"
michael@0:   // Font family = 1024 (Lucida Grande)
michael@0:   $"0400"
michael@0:   // Style bitfield, 0x1=bold 0x2=italic 0x4=underline 0x8=outline
michael@0:   // 0x10=shadow 0x20=condensed 0x40=extended
michael@0:   $"00"
michael@0:   // Style, unused?
michael@0:   $"02"
michael@0:   // Size = 12 point
michael@0:   $"000C"
michael@0:   // Color, RGB
michael@0:   $"0000 0000 0000"
michael@0: };
michael@0: __EOT__
michael@0:   close(*RESOURCE);
michael@0: 
michael@0:   return 1;
michael@0: }
michael@0: 
michael@0: # pathSplit($pathname)
michael@0: #
michael@0: # Splits $pathname into an array of path components.
michael@0: sub pathSplit($) {
michael@0:   my($pathname);
michael@0:   ($pathname) = @_;
michael@0:   return split(/\//, $pathname);
michael@0: }
michael@0: 
michael@0: # setAttributes($root, @attributeList)
michael@0: #
michael@0: # @attributeList is an array, each element of which must be in the form
michael@0: # <a>:<file>.  <a> is a list of attributes, per SetFile.  <file> is a file
michael@0: # which is taken as relative to $root (even if it appears as an absolute
michael@0: # path.)  SetFile is called to set the attributes on each file in
michael@0: # @attributeList.
michael@0: sub setAttributes($@) {
michael@0:   my(@attributes, $root);
michael@0:   ($root, @attributes) = @_;
michael@0:   my($attribute);
michael@0:   foreach $attribute (@attributes) {
michael@0:     my($attrList, $file, @fileList, @fixedFileList);
michael@0:     ($attrList, @fileList) = split(/:/, $attribute);
michael@0:     if(!defined($attrList) || !@fileList) {
michael@0:       cleanupDie('--attribute requires <attributes>:<file>');
michael@0:     }
michael@0:     @fixedFileList=();
michael@0:     foreach $file (@fileList) {
michael@0:       if($file =~ /^\//) {
michael@0:         push(@fixedFileList, $root.$file);
michael@0:       }
michael@0:       else {
michael@0:         push(@fixedFileList, $root.'/'.$file);
michael@0:       }
michael@0:     }
michael@0:     if(command($gConfig{'cmd_SetFile'}, '-a', $attrList, @fixedFileList)) {
michael@0:       cleanupDie('SetFile failed to set attributes');
michael@0:     }
michael@0:   }
michael@0:   return;
michael@0: }
michael@0: 
michael@0: sub trapSignal($) {
michael@0:   my($signalName);
michael@0:   ($signalName) = @_;
michael@0:   cleanupDie('exiting on SIG'.$signalName);
michael@0: }
michael@0: 
michael@0: sub usage() {
michael@0:   print STDERR (
michael@0: "usage: pkg-dmg --source <source-folder>\n".
michael@0: "               --target <target-image>\n".
michael@0: "              [--format <format>]           (default: UDZO)\n".
michael@0: "              [--volname <volume-name>]     (default: same name as source)\n".
michael@0: "              [--tempdir <temp-dir>]        (default: same dir as target)\n".
michael@0: "              [--mkdir <directory>]         (make directory in image)\n".
michael@0: "              [--copy <source>[:<dest>]]    (extra files to add)\n".
michael@0: "              [--symlink <source>[:<dest>]] (extra symlinks to add)\n".
michael@0: "              [--license <file>]            (plain text license agreement)\n".
michael@0: "              [--resource <file>]           (flat .r files to merge)\n".
michael@0: "              [--icon <icns-file>]          (volume icon)\n".
michael@0: "              [--attribute <a>:<file>]      (set file attributes)\n".
michael@0: "              [--idme]                      (make Internet-enabled image)\n".
michael@0: "              [--sourcefile]                (treat --source as a file)\n".
michael@0: "              [--verbosity <level>]         (0, 1, 2; default=2)\n".
michael@0: "              [--dry-run]                   (print what would be done)\n");
michael@0:   return;
michael@0: }