~x2go/x2go/x2goclient_build-main

#!/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

# https://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

     - UDRO - uncompressed, read-only; extension I<.dmg>

     - UDRW - uncompressed, read-write; extension I<.dmg>

     - UDSP - uncompressed, read-write, sparse; extension I<.sparseimage>

UDZO 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, UDBZ,

or UDRO, 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 isFormatReadOnly($);

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'            => '/usr/bin/Rez',

            'cmd_rm'             => 'rm',

            'cmd_rsync'          => 'rsync',

            'cmd_SetFile'        => '/usr/bin/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 = 'UDZO';

# --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'}, '-aC', '--include', '*.so',

 '--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'}, '-aC', '--include', '*.so',

   '--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(isFormatReadOnly($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(isFormatReadOnly($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'}, '-aC', '--include', '*.so',

                          '--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,