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