Subversion Repositories DevTools

########################################################################

# Copyright (C) 1998-2013 Vix Technology, All rights reserved

#

# Module name   : DebianPackager.pl

# Module type   : Makefile system

# Compiler(s)   : Perl

# Environment(s): jats

#

# Description   : This program is invoked by the MakeDebianPackage

#                 directive, that is a part of this package

#

#                 The program will use a user-provided script in order

#                 to create a Debian Package.

#

#                 The user script may call a number of directives in order to

#                 construct an image of the package being installed.

#

#                 The script specifies Debian configuration scaripts that

#                 will be embedded in the package.

#

#                 This program will:

#                   Construct a filesystem image under control of the directives

#                   within the user script

#

#                   Massage the Debian control file

#

#                   Create a Debian Package

#

#                   Transfer it to the users 'BIN' directory, where it is

#                   available to be packaged.

#

#                 Summary of directives available to the user-script:

#                       AddInitScript           - Add an init script

#                       CatFile                 - Append to a file

#                       CopyDir                 - Copy directory tree

#                       CopyFile                - Copy a file

#                       CopyBinFile             - Copy an executable file

#                       CopyLibFile             - Copy a library file

#                       CreateDir               - Create a directory

#                       DebianFiles             - Specify control and script files

#                       EchoFile                - Place text into a file

#                       MakeSymLink             - Create a symbolic link

#                       PackageDescription      - Specify the package description

#                       SetFilePerms            - Set file permissions

#                       SetVerbose              - Control progress display

#                       IsProduct               - Flow control

#                       IsPlatform              - Flow control

#                       IsTarget                - Flow control

#                       IsVariant               - Flow control

#

#                 Thoughts for expansion:

#                       ConvertFile             - Option to convert file(s) to Unix Text

#                       ReplaceTags             - Replace Tags on target file

#                       SrcDir                  - Extend path for resolving local files

#

#                   Less used:

#                        ExpandLinkFiles        - Expand .LINK files

#

#                   Internal Use:

#                        FindFiles              - Find a file

#                        ResolveFile            - Resolve a 'local' source file

#                        

#......................................................................#

require 5.006_001;

use strict;

use warnings;

use Getopt::Long;

use File::Path;

use File::Copy;

use File::Find;

use JatsSystem;

use FileUtils;

use JatsError;

use ReadBuildConfig;

use JatsCopy ();                            # Don't import anything

#

#   Globals

#

my $DebianWorkDirBase;                      # Workspace

my $DebianWorkDir;                          # Dir to create file system image within

#

#   Command line options

#

my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug

my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose

my $opt_vargs;                              # Verbose arg

my $opt_help = 0;

my $opt_manual = 0;

my $opt_clean = 0;

my $opt_platform;

my $opt_type;

my $opt_buildname;

my $opt_buildversion;

my $opt_interfacedir;

my $opt_target;

my $opt_product;

my $opt_package_script;

my $opt_interfaceincdir;

my $opt_interfacelibdir;

my $opt_interfacebindir;

my $opt_libdir;

my $opt_bindir;

my $opt_localincdir;

my $opt_locallibdir;

my $opt_localbindir;

my $opt_pkgdir;

my $opt_pkglibdir;

my $opt_pkgbindir;

my $opt_pkgpkgdir;

my $opt_output;

my $opt_name;

my $opt_variant;

my $opt_pkgarch;

#

#   Options derived from script directives

#

my $opt_control = '';

my $opt_prerm = '';

my $opt_postrm = '';

my $opt_preinst = '';

my $opt_postinst = '';

my $opt_description;

#

#   Globals

#

my @ResolveFileList;                    # Cached Package File List

my @ResolveBinFileList;                 # Cached PackageBin File List

my @ResolveLibFileList;                 # Cached PackageLib File List

#-------------------------------------------------------------------------------

# Function        : Main Entry point

#

# Description     : This function will be called when the package is initialised

#                   Extract arguments from the users environment

#

#                   Done here to greatly simplify the user script

#                   There should be no junk in the user script - keep it simple

#

# Inputs          :

#

# Returns         : 

#

main();

sub main

{

    my $result = GetOptions (

                "verbose:s"         => \$opt_vargs,

                "clean"             => \$opt_clean,

                "Type=s"            => \$opt_type,

                "BuildName=s"       => \$opt_buildname,                     # Raw Jats Package Name (Do not use)

                "Name=s"            => \$opt_name,                          # Massaged Debian Package Name

                "BuildVersion=s"    => \$opt_buildversion,

                "Platform=s"        => \$opt_platform,

                "Target=s"          => \$opt_target,

                "Product=s"         => \$opt_product,

                "DebianPackage=s"   => \$opt_package_script,

                "InterfaceDir=s"    => \$opt_interfacedir,

                "InterfaceIncDir=s" => \$opt_interfaceincdir,

                "InterfaceLibDir=s" => \$opt_interfacelibdir,

                "InterfaceBinDir=s" => \$opt_interfacebindir,

                "LibDir=s"          => \$opt_libdir,

                "BinDir=s"          => \$opt_bindir,

                "LocalIncDir=s"     => \$opt_localincdir,

                "LocalLibDir=s"     => \$opt_locallibdir,

                "LocalBinDir=s"     => \$opt_localbindir,

                "PackageDir=s"      => \$opt_pkgdir,

                "PackageLibDir=s"   => \$opt_pkglibdir,

                "PackageBinDir=s"   => \$opt_pkgbindir,

                "PackagePkgDir=s"   => \$opt_pkgpkgdir,

                "Output=s"          => \$opt_output,

                "Variant:s"         => \$opt_variant,

                "PkgArch:s"         => \$opt_pkgarch,

    );

    $opt_verbose++ unless ( $opt_vargs eq '@' );

    ErrorConfig( 'name'    => 'DebianUtils',

                 'verbose' => $opt_verbose,

                 'debug'   => $opt_debug );

    #

    #   Init the FileSystem Uiltity interface

    #

    InitFileUtils();

    #

    #   Ensure that we have all required options

    #

    Error ("Platform not set")                  unless ( $opt_platform );

    Error ("Type not set")                      unless ( $opt_type );

    Error ("BuildName not set")                 unless ( $opt_buildname );

    Error ("Debian Package Name not set")       unless ( $opt_name );

    Error ("BuildVersion not set")              unless ( $opt_buildversion );

    Error ("InterfaceDir not set")              unless ( $opt_interfacedir );

    Error ("Target not set")                    unless ( $opt_target );

    Error ("Product not set")                   unless ( $opt_product );

    Error ("DebianPackage not set")             unless ( $opt_package_script );

    Error ("Ouput File not set")                unless ( $opt_output );

    #

    #   Read in relevent config information

    #

    ReadBuildConfig ($opt_interfacedir, $opt_platform, '--NoTest' );

    #

    #   Build the package image in a directory based on the target being created

    #

    $DebianWorkDirBase = "$opt_platform$opt_type.image";

    $DebianWorkDir = "$DebianWorkDirBase/$opt_name";

    #

    #   Configure the System command to fail on any error

    #

    SystemConfig ( ExitOnError => 1 );

    #

    #   Extract the 'name' of the package from the output path

    #   Display purposes only

    #

    my $DebianPkgName = StripDirExt($opt_output);

    #

    #   Display variables used

    #

    Message    "=Building Debian Package =============================================";

    Message    "Build $opt_name";

    Message    "       Package: $opt_buildname";

    Message    "       Variant: $opt_variant" if ($opt_variant);

    Message    "       Version: $opt_buildversion";

    Message    "  Building for: $opt_platform, $opt_target";

    Message    "       Product: $opt_product";

    Message    "          Type: $opt_type";

    Message    "      Pkg Arch: $opt_pkgarch" if ($opt_pkgarch);

    Verbose    "       Verbose: $opt_verbose";

    Verbose    "  InterfaceDir: $opt_interfacedir";

    Message    "       Package: $DebianPkgName";

    Message    "======================================================================";

    #

    #   Defaults

    #

    $opt_pkgarch = $opt_platform unless ( $opt_pkgarch );

    #

    #   Perform Clean up

    #   Invoked during "make clean" or "make clobber"

    #

    if ( $opt_clean )

    {

        Message ("Remove packaging directory: $DebianWorkDir");

        #

        #   Remove the directory for this package

        #   Remove the general work dir - if all packages have been cleaned

        #

        rmtree( $DebianWorkDir );

        rmdir( $DebianWorkDirBase );

        rmtree ($opt_output) if ( -f $opt_output );

        exit;

    }

    #

    #   Clean  out the WORK directory

    #   Always start with a clean slate

    #

    #   Ensure that the base of the directory tree does not have 'setgid'

    #       This will upset the debian packager

    #       This may be an artifact from the users directory and not expected

    #

    rmtree( $DebianWorkDir );

    mkpath( $DebianWorkDir );

    my $perm = (stat $DebianWorkDir)[2] & 0777;

    chmod ( $perm & 0777, $DebianWorkDir );

    #

    #   Invoke the user script to do the hard work

    #

    unless (my $return = do $opt_package_script) {

            Error ("Couldn't parse $opt_package_script: $@") if $@;

            Error ("Couldn't do $opt_package_script: $!")    unless defined $return;

        }

    #

    #   Complete the building of the package

    #

    BuildDebianPackage ();

    Message ("Created Debian Package");

}

#-------------------------------------------------------------------------------

# Function        : BuildDebianPackage

#

# Description     : This function will create the Debian Package

#                   and transfer it to the target directory

#

# Inputs          : None

#

# Returns         : Nothing

#

sub BuildDebianPackage

{

    Error ("BuildDebianPackage: No Control File or Package Description")

        unless ( $opt_control || $opt_description );

    #

    #   Convert the FileSystem Image into a Debian Package

    #       Insert Debian control files

    #

    Verbose ("Copy in the Debian Control Files");

    mkdir ( "$DebianWorkDir/DEBIAN" );

    CopyFile ( $opt_prerm,    "/DEBIAN", "prerm" )    if $opt_prerm;

    CopyFile ( $opt_postrm,   "/DEBIAN", "postrm" )   if $opt_postrm;

    CopyFile ( $opt_preinst,  "/DEBIAN", "preinst" )  if $opt_preinst;

    CopyFile ( $opt_postinst, "/DEBIAN", "postinst" ) if $opt_postinst;

    UpdateControlFile ($opt_control );

    System ( 'chmod', '-R', 'a+rx', "$DebianWorkDir/DEBIAN" );

    System ( 'build_dpkg.sh', '-b', $DebianWorkDir);

    System ( 'mv', '-f', "$DebianWorkDir.deb", $opt_output );

    System ("build_dpkg.sh", '-I', $opt_output) if (IsVerbose(1));

}

#-------------------------------------------------------------------------------

# Function        : UpdateControlFile

#

# Description     : Update the Debian 'control' file to fix up varoius fields

#                   within the file.

#

#                   If the files has not been specified, then a basic control

#                   file will be provided.

#

#                   This routine knows where the control file will be placed

#                   within the output work space.

#

# Inputs          : $src            - Path to source file

#                   Uses global variables

#

# Returns         : Nothing

#

sub UpdateControlFile

{

    my($src) = @_;

    my $dst = "$DebianWorkDir/DEBIAN/control";

    unless ( $src )

    {

        CreateControlFile();

        return;

    }

    Verbose ("UpdateControlFile: $dst" );

    $src = ResolveFile( 0, $src );

    open (SF, '<', $src) || Error ("UpdateControlFile: Cannot open $src");

    open (DF, '>', $dst) || Error ("UpdateControlFile: Cannot create:$dst");

    while ( <SF> )

    {

        s~\s*$~~;

        if ( m~^Package:~ ) {

            $_ = "Package: $opt_name";

        } elsif ( m~^Version:~ ) {

            $_ = "Version: $opt_buildversion";

        } elsif ( m~^Architecture:~ ) {

            $_ = "Architecture: $opt_pkgarch";

        } elsif ( $opt_description && m~^Description:~ ) {

            $_ = "Description: $opt_description";

        }

        print DF $_ , "\n";

    }

    close (SF);

    close (DF);

}

#-------------------------------------------------------------------------------

# Function        : CreateControlFile

#

# Description     : Craete a basic debian control file

#

# Inputs          : Uses global variables

#

# Returns         : 

#

sub CreateControlFile

{

    my $dst = "$DebianWorkDir/DEBIAN/control";

    Verbose ("CreateControlFile: $dst" );

    open (DF, '>', $dst) || Error ("CreateControlFile: Cannot create:$dst");

    print DF "Package: $opt_name\n";

    print DF "Version: $opt_buildversion\n";

    print DF "Section: main\n";

    print DF "Priority: standard\n";

    print DF "Architecture: $opt_pkgarch\n";

    print DF "Essential: No\n";

    print DF "Maintainer: Vix Technology\n";

    print DF "Description: $opt_description\n";

    close (DF);

}

#-------------------------------------------------------------------------------

# Function        : SetVerbose

#

# Description     : Set the level of verbosity

#                   Display activity

#

# Inputs          : Verbosity level

#                       0 - Use makefile verbosity (Default)

#                       1..2

#

# Returns         : 

#

sub SetVerbose

{

    my ($level) = @_;

    $level = $opt_verbose unless ( $level );

    $opt_verbose = $level;

    ErrorConfig( 'verbose' => $level);

}

#-------------------------------------------------------------------------------

# Function        : DebianFiles

#

# Description     : Name Debian builder control files

#                   May be called multiple times

#

# Inputs          : Options

#                       --Control=file

#                       --PreRm=file

#                       --PostRm=file

#                       --PreInst=file

#                       --PostInst=file

#

# Returns         : Nothing

#

sub DebianFiles

{

    #

    #   Exctact names

    #

    Verbose ("Specify Debian Control Files and Scripts");

    foreach  ( @_ )

    {

        if ( m/^--Control=(.+)/ ) {

            $opt_control = $1;

        } elsif ( m/^--PreRm=(.+)/ ) {

            $opt_prerm = $1;

        } elsif ( m/^--PostRm=(.+)/ ) {

            $opt_postrm = $1;

        } elsif ( m/^--PreInst=(.+)/ ) {

            $opt_preinst  = $1;

        } elsif ( m/^--PostInst=(.+)/ ) {

            $opt_postinst = $1;

        } else {

            Error ("DebianFiles: Unknown option: $_");

        }

    }

}

#-------------------------------------------------------------------------------

# Function        : PackageDescription

#

# Description     : Specify the Package Description

#                   Keep it short

#

# Inputs          : $description

#

# Returns         : 

#

sub PackageDescription

{

    ($opt_description) = @_;

}

#-------------------------------------------------------------------------------

# Function        : MakeSymLink

#

# Description     : Create a symlink - with error detection

#

# Inputs          : old_file    - Link Target

#                                 Path to the link target

#                                 If an ABS path is provided, the routine will

#                                 attempt to create a relative link.

#                   new_file    - Relative to the output work space

#                                 Path to where the 'link' file will be created

#                   Options     - Must be last

#                                 --NoClean         - Don't play with links

#                                 --NoDotDot        - Don't create symlinks with ..

#

# Returns         : Nothing

#

sub MakeSymLink

{

    my $no_clean;

    my $no_dot;

    my @args;

    #

    #   Extract options

    #

    foreach ( @_ )

    {

        if ( m/^--NoClean/i ) {

            $no_clean = 1;

        } elsif ( m/^--NoDotDot/i ) {

            $no_dot = 1;

        } elsif ( m/^--/ ) {

            Error ("MakeSymLink: Unknown option: $_");

        } else {

            push @args, $_;

        }

    }

    my ($old_file, $new_file) = @args;

    my $tfile = $DebianWorkDir . '/' . $new_file;

    $tfile =~ s~//~/~;

    Verbose ("Symlink $old_file -> $new_file" );

    #

    #   Create the directory in which the link will be placed

    #   Remove any existing file of the same name

    #

    my $dir = StripFileExt( $tfile );

    mkpath( $dir) unless -d $dir;

    unlink $tfile;

    #

    #   Determine a good name of the link

    #   Convert to a relative link in an attempt to prune them

    #

    my $sfile = $old_file;

    unless ( $no_clean )

    {

        $sfile = CalcRelPath( StripFileExt( $new_file ), $old_file );

        $sfile = $old_file if ( $no_dot && $sfile =~ m~^../~ );

    }

    my $result = symlink $sfile, $tfile;

    Error ("Cannot create symlink. $old_file -> $new_file") unless ( $result );

}

#-------------------------------------------------------------------------------

# Function        : CopyFile

#

# Description     : Copy a file to a target dir

#                   Used for text files, or files with fixed names

#

# Inputs          : $src

#                   $dst_dir    - Within the output workspace

#                   $dst_name   - Output Name [Optional]

#                   Options     - Common Copy Options

#

# Returns         : Full path to destination file

#

sub CopyFile

{

    CopyFileCommon( \&ResolveFile, @_ );

}

#-------------------------------------------------------------------------------

# Function        : CopyBinFile

#

# Description     : Copy a file to a target dir

#                   Used for executable programs. Will look in places where

#                   programs are stored.

#

# Inputs          : $src

#                   $dst_dir    - Within the output workspace

#                   $dst_name   - Output Name [Optional]

#

#                   Options:

#                       --FromPackage

#                       --SoftLink=xxxx

#                       --LinkFile=xxxx

#

#

# Returns         : Full path to destination file

#

sub CopyBinFile

{

    CopyFileCommon( \&ResolveBinFile, @_ );

}

#-------------------------------------------------------------------------------

# Function        : CopyLibFile

#

# Description     : Copy a file to a target dir

#                   Used for shared programs. Will look in places where

#                   shared libraries are stored.

#

# Inputs          : $src        - Base for 'realname' (no lib, no extension)

#                   $dst_dir    - Within the output workspace

#                   $dst_name   - Output Name [Optional, but not suggested]

#

# Returns         : Full path to destination file

#

# Notes           : Copying 'lib' files

#                   These are 'shared libaries. There is no provision for copying

#                   static libraries.

#

#                   The tool will attempt to copy a well-formed 'realname' library

#                   The soname of the library should be constructed on the target

#                   platform using ldconfig.

#                   There is no provision to copy the 'linker' name

#

#                   Given a request to copy a library called 'fred', then the

#                   well formed 'realname' will be:

#                           libfred[P|D|]].so.nnnnn

#                   where:

#                           nnnn is the library version

#                           [P|D|] indicates Production, Debug or None

#

#                   The 'soname' is held within the realname form of the library

#                   and will be created by lsconfig.

#

#                   The 'linkername' would be libfred[P|D|].so. This is only

#                   needed when linking against the library.

#

#

#                   The routine will also recognize Windows DLLs

#                   These are of the form fred[P|D|].nnnnn.dll

#

sub CopyLibFile

{

    CopyFileCommon( \&ResolveLibFile, @_ );

}

#-------------------------------------------------------------------------------

# Function        : CopyFileCommon

#

# Description     : Common ( internal File Copy )

#

# Inputs          : $resolver           - Ref to function to resolve source file

#                   $src                - Source File Name

#                   $dst_dir            - Target Dir

#                   $dst_name           - Target Name (optional)

#                   Options

#                   Options:

#                       --FromPackage

#                       --SoftLink=xxxx

#                       --LinkFile=xxxx

#

# Returns         : 

#

sub CopyFileCommon

{

    my $from_package = 0;

    my $isa_linkfile = 0;

    my @llist;

    my @args;

    #

    #   Parse options

    #

    foreach ( @_ )

    {

        if ( m/^--FromPackage/ ) {

            $from_package = 1;

        } elsif ( m/^--LinkFile/ ) {

            $isa_linkfile = 1;

        } elsif ( m/^--SoftLink=(.+)/ ) {

            push @llist, $1;

        } elsif ( m/^--/ ) {

            Error ("FileCopy: Unknown option: $_");

        } else {

            push @args, $_;

        }

    }

    #

    #   Extract non-options.

    #   These are the bits that are left over

    #

    my ($resolver, $src, $dst_dir, $dst_name ) = @args;

    #

    #   Clean up dest_dir. Must start with a / and not end with one

    #

    $dst_dir = "/$dst_dir/";

    $dst_dir =~ s~/+~/~g;

    $dst_dir =~ s~/$~~;

    Verbose ("CopyFile: $src, $dst_dir, " . ($dst_name || ''));

    foreach $src ( &$resolver( $from_package, $src ) )

    {

        my $dst_fname = $dst_name ? $dst_name : StripDir($src);

        my $dst_file = "$dst_dir/$dst_fname";

        Verbose ("CopyFile: Copy $src, $dst_file" );

        #

        #   LinkFiles are special

        #   They get concatenated to any existing LINKS File

        #

        if ( $isa_linkfile )

        {

            CatFile ( $src, "$dst_dir/.LINKS" );

        }

        else

        {

            mkpath( "$DebianWorkDir$dst_dir", 0, 0775);

            unlink ("$DebianWorkDir$dst_file");

            System ('cp','-f', $src, "$DebianWorkDir$dst_file" );

            foreach my $lname ( @llist )

            {

                $lname = $dst_dir . '/' . $lname unless ( $lname =~ m ~^/~ );

                MakeSymLink( $dst_file ,$lname);

            }

        }

    }

}

#-------------------------------------------------------------------------------

# Function        : CopyDir

#

# Description     : Copy a directory to a target dir

#

# Inputs          : $src_dir    - Local to the user

#                                 Symbolic Name

#                   $dst_dir    - Within the output workspace

#                   Options

#                       --Merge             - Don't delete first

#                       --Source=Name       - Source via Symbolic Name

#                       --FromPackage       - Source via package roots

#                       --IgnoreDbgFiles    - Ignore .dbg and .debug files in dir copy

#

# Returns         :

#

sub CopyDir

{

    my ($src_dir, $dst_dir, @opts) = @_;

    my $opt_merge;

    my $opt_base;

    my $from_interface = 0;

    my $ignoreDbg;

    $dst_dir = $DebianWorkDir . '/' . $dst_dir;

    $dst_dir =~ s~//~/~;

    #

    #   Detect and expand Symbolic names in the Source Directory

    #

    foreach  ( @opts )

    {

        if ( m/^--Merge/ ) {

            $opt_merge = 1;

        } elsif ( m/^--Source=(.+)/ ) {

            my $name = $1;

            Verbose2 ("CopyDir: Source: $name");

            Error ("Source directory can only be specified once")

                if ( defined $opt_base );

            $name = lc($name);

            my %CopyDirSymbolic = (

                'interfaceincdir'   => $opt_interfaceincdir,

                'interfacelibdir'   => $opt_interfacelibdir,

                'interfacebindir'   => $opt_interfacebindir,

                'libdir'            => $opt_libdir,

                'bindir'            => $opt_bindir,

                'localincdir'       => $opt_localincdir,

                'locallibdir'       => $opt_locallibdir,

                'localbindir'       => $opt_localbindir,

                'packagebindir'     => $opt_pkgbindir,

                'packagelibdir'     => $opt_pkglibdir,

                'packagepkgdir'     => $opt_pkgpkgdir,

                'packagedir'        => $opt_pkgdir,

            );

            if ( exists $CopyDirSymbolic{$name} )

            {

                $opt_base = $CopyDirSymbolic{$name};

                #

                #   If sourceing from interface, then follow

                #   symlinks in the copy. All files will be links anyway

                #

                $from_interface = 1

                    if ( $name =~ m~^interface~ );

            }

            else

            {

                DebugDumpData ("CopyDirSymbolic", \%CopyDirSymbolic);

                Error ("CopyDir: Unknown Source Name: $name" );

            }

        } elsif ( m/^--FromPackage/ ) {

            Verbose2 ("CopyDir: FromPackage: $src_dir");

            Error ("Source directory can only be specified once")

                if ( defined $opt_base );

            my @path;

            foreach my $entry ( getPackageList() )

            {

                my $base = $entry->getBase(3);

                next unless ( defined $base );

                if ( -d $base . '/' . $src_dir )

                {

                    push @path, $base;

                    $from_interface = 1

                        if ( $entry->{'TYPE'} eq 'interface' );

                }

            }

            Error ("CopyDir: Cannot find source dir in any package: $src_dir")

                if ( $#path < 0 );

            Error ("CopyDir: Requested path found in mutiple packages: $src_dir",

                    @path ) if ( $#path > 0 );

            $opt_base = pop @path;

            #

            #   If sourceing from interface, then follow symlinks in the copy.

            #   All files will be links anyway

            #

            #   This is a very ugly test for 'interface'

            #

            $from_interface = 1

                if ( $opt_base =~ m~/interface/~ );

        } elsif ( m/^--IgnoreDbgFiles/ ) {

            Verbose2 ("CopyDir: Ignore Debug Files");

            $ignoreDbg = 1;

        } else {

            Error ("CopyDir: Unknown option: $_" );

        }

    }

    $src_dir = $opt_base . '/' . $src_dir if ( $opt_base );

    $src_dir =~ s~//~/~g;

    $src_dir =~ s~/$~~;

    Verbose ("CopyDir: $src_dir, $dst_dir");

    Error ("CopyDir: Directory not found: $src_dir") unless ( -d $src_dir );

    #

    #   Setup the copy options

    #

    my %copyOpts;

    $copyOpts{'IgnoreDirs'} = ['.svn', '.git', '.cvs', '.hg'];

    $copyOpts{'Ignore'} = ['.gbedir', '_gbedir'];

    push (@{$copyOpts{'Ignore'}}, '*.debug', '*.dbg') if $ignoreDbg;

    $copyOpts{'EmptyDirs'} = 1;

    $copyOpts{'DeleteFirst'} = 1 unless $opt_merge;

    $copyOpts{'Log'} = 1 if ( $opt_verbose > 1 );

    $copyOpts{'DuplicateLinks'} = 1 unless ( $from_interface );

    #

    #   Transfer the directory

    #

    JatsCopy::CopyDir ( $src_dir, $dst_dir, \%copyOpts );

    #

    #   Expand link files that may have been copied in

    #

    Verbose ("Locate LINKFILES in $DebianWorkDir");

    ExpandLinkFiles();

}

#-------------------------------------------------------------------------------

# Function        : AddInitScript

#

# Description     : Add an Init Script to the target

#                   Optionally create start and stop links

#

# Inputs          : $script     - Name of the init script

#                   $start      - Start Number

#                   $stop       - Stop Number

#                   Options:

#                       --NoCopy        - Don't copy the script, just add links

#                       --Afc           - Place in AFC init area

#                       --FromPackage   - Source is in a package

#

# Returns         : 

#

sub AddInitScript

{

    my $no_copy;

    my $basedir = "";

    my @args;

    my $from_package = 0;

    #

    #   Process and Remove options

    #

    foreach  ( @_ )

    {

        if ( m/^--NoCopy/ ) {

            $no_copy = 1;

        } elsif ( m/^--Afc/ ) {

            $basedir = "/afc";

        } elsif ( m/^--FromPackage/ ) {

            $from_package = 1;

        } elsif ( m/^--/ ) {

            Error ("AddInitScript: Unknown option: $_");

        } else {

            push @args, $_;

        }

    }

    my( $script, $start, $stop ) = @args;

    Error ("No script file specified") unless ( $script );

    Warning("AddInitScript: No start or stop index specified") unless ( $start || $stop );

    Verbose ("AddInitScript: $script, " . ($start || 'No Start') . ", " . ($stop || 'No Stop'));

    $script = ResolveFile($from_package, $script );

    my $tdir = $basedir . "/etc/init.d/init.d";

    my $base = StripDir($script);

    CopyFile( $script, $tdir ) unless $no_copy;

    my $link;

    if ( $start )

    {

        $link = sprintf ("${basedir}/etc/init.d/S%2.2d%s", $start, $base );

        MakeSymLink( "$tdir/$base", $link);

    }

    if ( $stop )

    {

        $link = sprintf ("${basedir}/etc/init.d/K%2.2d%s", $stop, $base );

        MakeSymLink( "$tdir/$base", $link);

    }

}

#-------------------------------------------------------------------------------

# Function        : CatFile

#

# Description     : Copy a file to the end of a file

#

# Inputs          : $src

#                   $dst    - Within the output workspace

#

# Returns         :

#

sub CatFile

{

    my ($src, $dst) = @_;

    $dst = $DebianWorkDir . '/' . $dst;

    $dst =~ s~//~/~;

    Verbose ("CatFile: $src, $dst");

    $src = ResolveFile(0, $src );

    open (SF, '<', $src)  || Error ("CatFile: Cannot open $src");

    open (DF, '>>', $dst) || Error ("CatFile: Cannot create:$dst");

    while ( <SF> )

    {

        print DF $_;

    }

    close (SF);

    close (DF);

}

#-------------------------------------------------------------------------------

# Function        : EchoFile

#

# Description     : Echo simple text to a file