Subversion Repositories DevTools

Rev

Rev 5215 | Rev 6088 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
407 dpurdie 1 
########################################################################
3921 dpurdie 2 
# Copyright (C) 1998-2013 Vix Technology, All rights reserved
407 dpurdie 3 
#
3921 dpurdie 4 
# Module name   : DebianPackager.pl
407 dpurdie 5 
# Module type   : Makefile system
3921 dpurdie 6 
# Compiler(s)   : Perl
407 dpurdie 7 
# Environment(s): jats
8 
#
9 
# Description   : This program is invoked by the MakeDebianPackage
10 
#                 directive, that is a part of this package
11 
#
12 
#                 The program will use a user-provided script in order
13 
#                 to create a Debian Package.
14 
#
15 
#                 The user script may call a number of directives in order to
16 
#                 construct an image of the package being installed.
17 
#
18 
#                 The script specifies Debian configuration scaripts that
19 
#                 will be embedded in the package.
20 
#
21 
#                 This program will:
22 
#                   Construct a filesystem image under control of the directives
23 
#                   within the user script
24 
#
25 
#                   Massage the Debian control file
26 
#
27 
#                   Create a Debian Package
28 
#
29 
#                   Transfer it to the users 'BIN' directory, where it is
30 
#                   available to be packaged.
31 
#
32 
#                 Summary of directives available to the user-script:
33 
#                       AddInitScript           - Add an init script
34 
#                       CatFile                 - Append to a file
4641 dpurdie 35 
#                       ConvertFile             - Convert file(s) to Unix or Dos Text
407 dpurdie 36 
#                       CopyDir                 - Copy directory tree
37 
#                       CopyFile                - Copy a file
38 
#                       CopyBinFile             - Copy an executable file
39 
#                       CopyLibFile             - Copy a library file
40 
#                       CreateDir               - Create a directory
41 
#                       DebianFiles             - Specify control and script files
4636 dpurdie 42 
#                       DebianControlFile       - Specify control and script files
43 
#                       DebianDepends           - Add Depends entry to control file
407 dpurdie 44 
#                       EchoFile                - Place text into a file
45 
#                       MakeSymLink             - Create a symbolic link
46 
#                       PackageDescription      - Specify the package description
4641 dpurdie 47 
#                       ReplaceTags             - Replace Tags on target file
407 dpurdie 48 
#                       SetFilePerms            - Set file permissions
49 
#                       SetVerbose              - Control progress display
50 
#                       IsProduct               - Flow control
51 
#                       IsPlatform              - Flow control
52 
#                       IsTarget                - Flow control
427 dpurdie 53 
#                       IsVariant               - Flow control
407 dpurdie 54 
#
55 
#                 Thoughts for expansion:
56 
#                       SrcDir                  - Extend path for resolving local files
57 
#
58 
#                   Less used:
59 
#                        ExpandLinkFiles        - Expand .LINK files
60 
#
61 
#                   Internal Use:
62 
#                        FindFiles              - Find a file
63 
#                        ResolveFile            - Resolve a 'local' source file
4641 dpurdie 64 
#                        chmodItem              - Set file or directory permissions
407 dpurdie 65 
#
66 
#......................................................................#
67 
 
411 dpurdie 68 
require 5.006_001;
407 dpurdie 69 
use strict;
70 
use warnings;
71 
 
72 
use Getopt::Long;
73 
use File::Path;
74 
use File::Copy;
75 
use File::Find;
76 
use JatsSystem;
77 
use FileUtils;
78 
use JatsError;
4636 dpurdie 79 
use JatsLocateFiles;
407 dpurdie 80 
use ReadBuildConfig;
423 dpurdie 81 
use JatsCopy ();                            # Don't import anything
407 dpurdie 82 
 
83 
#
84 
#   Globals
85 
#
425 dpurdie 86 
my $DebianWorkDirBase;                      # Workspace
407 dpurdie 87 
my $DebianWorkDir;                          # Dir to create file system image within
88 
 
89 
#
90 
#   Command line options
91 
#
92 
my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug
93 
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
94 
my $opt_vargs;                              # Verbose arg
95 
my $opt_help = 0;
96 
my $opt_manual = 0;
97 
my $opt_clean = 0;
98 
my $opt_platform;
99 
my $opt_type;
100 
my $opt_buildname;
101 
my $opt_buildversion;
102 
my $opt_interfacedir;
103 
my $opt_target;
104 
my $opt_product;
105 
my $opt_package_script;
106 
my $opt_interfaceincdir;
107 
my $opt_interfacelibdir;
108 
my $opt_interfacebindir;
109 
my $opt_libdir;
110 
my $opt_bindir;
111 
my $opt_localincdir;
112 
my $opt_locallibdir;
113 
my $opt_localbindir;
114 
my $opt_pkgdir;
115 
my $opt_pkglibdir;
116 
my $opt_pkgbindir;
117 
my $opt_pkgpkgdir;
118 
my $opt_output;
417 dpurdie 119 
my $opt_name;
427 dpurdie 120 
my $opt_variant;
3921 dpurdie 121 
my $opt_pkgarch;
4740 dpurdie 122 
my $opt_tarFile;
5215 dpurdie 123 
my $opt_noarch;
407 dpurdie 124 
 
125 
#
126 
#   Options derived from script directives
127 
#
128 
my $opt_description;
129 
 
415 dpurdie 130 
#
131 
#   Globals
132 
#
133 
my @ResolveFileList;                    # Cached Package File List
134 
my @ResolveBinFileList;                 # Cached PackageBin File List
135 
my @ResolveLibFileList;                 # Cached PackageLib File List
4635 dpurdie 136 
my %DebianControlFiles;                 # Control Files
137 
my %DebianControlFileNames;             # Control Files by name
138 
my @DependencyList;                     # Package Dependencies
4666 dpurdie 139 
my @ConfigList;                         # Config Files
407 dpurdie 140 
 
141 
#-------------------------------------------------------------------------------
142 
# Function        : Main Entry point
143 
#
144 
# Description     : This function will be called when the package is initialised
145 
#                   Extract arguments from the users environment
146 
#
147 
#                   Done here to greatly simplify the user script
148 
#                   There should be no junk in the user script - keep it simple
149 
#
150 
# Inputs          :
151 
#
152 
# Returns         :
153 
#
154 
main();
155 
sub main
156 
{
157 
    my $result = GetOptions (
158 
                "verbose:s"         => \$opt_vargs,
159 
                "clean"             => \$opt_clean,
160 
                "Type=s"            => \$opt_type,
4105 dpurdie 161 
                "BuildName=s"       => \$opt_buildname,                     # Raw Jats Package Name (Do not use)
162 
                "Name=s"            => \$opt_name,                          # Massaged Debian Package Name
407 dpurdie 163 
                "BuildVersion=s"    => \$opt_buildversion,
164 
                "Platform=s"        => \$opt_platform,
165 
                "Target=s"          => \$opt_target,
166 
                "Product=s"         => \$opt_product,
167 
                "DebianPackage=s"   => \$opt_package_script,
168 
                "InterfaceDir=s"    => \$opt_interfacedir,
169 
                "InterfaceIncDir=s" => \$opt_interfaceincdir,
170 
                "InterfaceLibDir=s" => \$opt_interfacelibdir,
171 
                "InterfaceBinDir=s" => \$opt_interfacebindir,
172 
                "LibDir=s"          => \$opt_libdir,
173 
                "BinDir=s"          => \$opt_bindir,
174 
                "LocalIncDir=s"     => \$opt_localincdir,
175 
                "LocalLibDir=s"     => \$opt_locallibdir,
176 
                "LocalBinDir=s"     => \$opt_localbindir,
177 
                "PackageDir=s"      => \$opt_pkgdir,
178 
                "PackageLibDir=s"   => \$opt_pkglibdir,
179 
                "PackageBinDir=s"   => \$opt_pkgbindir,
180 
                "PackagePkgDir=s"   => \$opt_pkgpkgdir,
181 
                "Output=s"          => \$opt_output,
4740 dpurdie 182 
                "tarFile=s"         => \$opt_tarFile,
427 dpurdie 183 
                "Variant:s"         => \$opt_variant,
3921 dpurdie 184 
                "PkgArch:s"         => \$opt_pkgarch,
5215 dpurdie 185 
                "NoArch"            => \$opt_noarch,
407 dpurdie 186 
    );
187 
    $opt_verbose++ unless ( $opt_vargs eq '@' );
188 
 
189 
    ErrorConfig( 'name'    => 'DebianUtils',
190 
                 'verbose' => $opt_verbose,
191 
                 'debug'   => $opt_debug );
192 
 
193 
    #
194 
    #   Init the FileSystem Uiltity interface
195 
    #
196 
    InitFileUtils();
197 
 
198 
    #
199 
    #   Ensure that we have all required options
200 
    #
201 
    Error ("Platform not set")                  unless ( $opt_platform );
202 
    Error ("Type not set")                      unless ( $opt_type );
203 
    Error ("BuildName not set")                 unless ( $opt_buildname );
4105 dpurdie 204 
    Error ("Debian Package Name not set")       unless ( $opt_name );
407 dpurdie 205 
    Error ("BuildVersion not set")              unless ( $opt_buildversion );
206 
    Error ("InterfaceDir not set")              unless ( $opt_interfacedir );
207 
    Error ("Target not set")                    unless ( $opt_target );
208 
    Error ("Product not set")                   unless ( $opt_product );
209 
    Error ("DebianPackage not set")             unless ( $opt_package_script );
210 
    Error ("Ouput File not set")                unless ( $opt_output );
211 
 
212 
    #
213 
    #   Read in relevent config information
214 
    #
215 
    ReadBuildConfig ($opt_interfacedir, $opt_platform, '--NoTest' );
216 
 
217 
    #
218 
    #   Build the package image in a directory based on the target being created
219 
    #
425 dpurdie 220 
    $DebianWorkDirBase = "$opt_platform$opt_type.image";
221 
    $DebianWorkDir = "$DebianWorkDirBase/$opt_name";
407 dpurdie 222 
 
223 
    #
224 
    #   Configure the System command to fail on any error
225 
    #
226 
    SystemConfig ( ExitOnError => 1 );
227 
 
228 
    #
5217 dpurdie 229 
    #   Defaults
230 
    #
231 
    $opt_pkgarch = $opt_platform unless ( $opt_pkgarch );
232 
    $opt_pkgarch = 'all' if ( $opt_noarch );
233 
 
234 
    #
407 dpurdie 235 
    #   Display variables used
236 
    #
4740 dpurdie 237 
    Message    ("=Building Debian Package =============================================");
238 
    Message    ("Build $opt_name");
239 
    Message    ("       Package: $opt_buildname");
240 
    Message    ("       Variant: $opt_variant") if ($opt_variant);
241 
    Message    ("       Version: $opt_buildversion");
242 
    Message    ("  Building for: $opt_platform, $opt_target");
243 
    Message    ("       Product: $opt_product");
244 
    Message    ("          Type: $opt_type");
245 
    Message    ("      Pkg Arch: $opt_pkgarch") if ($opt_pkgarch);
246 
    Verbose    ("       Verbose: $opt_verbose");
247 
    Verbose    ("  InterfaceDir: $opt_interfacedir");
248 
    Message    ("       Package: " . StripDirExt($opt_output));
249 
    Message    ("       TarFile: " . StripDirExt($opt_tarFile)) if ($opt_tarFile);
250 
    Message    ("======================================================================");
407 dpurdie 251 
 
252 
    #
253 
    #   Perform Clean up
254 
    #   Invoked during "make clean" or "make clobber"
255 
    #
256 
    if ( $opt_clean )
257 
    {
258 
        Message ("Remove packaging directory: $DebianWorkDir");
425 dpurdie 259 
 
260 
        #
261 
        #   Remove the directory for this package
262 
        #   Remove the general work dir - if all packages have been cleaned
263 
        #
407 dpurdie 264 
        rmtree( $DebianWorkDir );
425 dpurdie 265 
        rmdir( $DebianWorkDirBase );
407 dpurdie 266 
        rmtree ($opt_output) if ( -f $opt_output );
267 
        exit;
268 
    }
269 
 
270 
    #
5215 dpurdie 271 
    #   NoArch sanity test
272 
    #   MUST only build no-arch for production
273 
    #   User MUST do this in the build.pl file
274 
    #
275 
    if ($opt_noarch && $opt_type ne 'P')
276 
    {
277 
        Error ("Debian Packages marked as NoArch (all) must be built ONLY for production",
278 
               "This must be configured in the build.pl" );
279 
    }
280 
 
281 
    #
407 dpurdie 282 
    #   Clean  out the WORK directory
283 
    #   Always start with a clean slate
284 
    #
285 
    #   Ensure that the base of the directory tree does not have 'setgid'
286 
    #       This will upset the debian packager
287 
    #       This may be an artifact from the users directory and not expected
288 
    #
289 
    rmtree( $DebianWorkDir );
290 
    mkpath( $DebianWorkDir );
291 
 
292 
    my $perm = (stat $DebianWorkDir)[2] & 0777;
293 
    chmod ( $perm & 0777, $DebianWorkDir );
294 
 
295 
    #
296 
    #   Invoke the user script to do the hard work
297 
    #
4139 dpurdie 298 
    unless (my $return = do $opt_package_script) {
299 
            Error ("Couldn't parse $opt_package_script: $@") if $@;
300 
            Error ("Couldn't do $opt_package_script: $!")    unless defined $return;
301 
        }
407 dpurdie 302 
 
303 
    #
304 
    #   Complete the building of the package
305 
    #
4740 dpurdie 306 
    if ($opt_tarFile)
307 
    {
308 
        BuildTarFile();
309 
        Message ("Created TGZ file");
310 
    }
311 
 
312 
 
407 dpurdie 313 
    BuildDebianPackage ();
314 
    Message ("Created Debian Package");
315 
}
316 
 
317 
#-------------------------------------------------------------------------------
318 
# Function        : BuildDebianPackage
319 
#
320 
# Description     : This function will create the Debian Package
321 
#                   and transfer it to the target directory
322 
#
323 
# Inputs          : None
324 
#
325 
# Returns         : Nothing
326 
#
327 
sub BuildDebianPackage
328 
{
329 
    Error ("BuildDebianPackage: No Control File or Package Description")
4635 dpurdie 330 
        unless ( exists($DebianControlFiles{'control'}) || $opt_description );
407 dpurdie 331 
 
332 
    #
333 
    #   Convert the FileSystem Image into a Debian Package
334 
    #       Insert Debian control files
335 
    #
336 
    Verbose ("Copy in the Debian Control Files");
337 
    mkdir ( "$DebianWorkDir/DEBIAN" );
338 
 
4635 dpurdie 339 
    #
340 
    #   Copy in all the named Debian Control files
341 
    #       Ignore any control file. It will be done next
342 
    #
343 
    foreach my $key ( keys %DebianControlFiles )
344 
    {
345 
        next if ($key eq 'control');
4676 dpurdie 346 
        CopyFile ( $DebianControlFiles{$key}, '/DEBIAN', $key  );
4635 dpurdie 347 
    }
4666 dpurdie 348 
 
349 
    #
350 
    #   Create 'conffiles'
351 
    #       Append to any user provided file
352 
    if ( @ConfigList )
353 
    {
354 
        my $conffiles = "$DebianWorkDir/DEBIAN/conffiles";
355 
        Warning("Appending user specified entries to conffiles") if ( -f $conffiles);
356 
        FileAppend( $conffiles, @ConfigList );
357 
    }
4635 dpurdie 358 
 
359 
    #
360 
    #   Massage the 'control' file
361 
    #
362 
    UpdateControlFile ($DebianControlFiles{'control'} );
407 dpurdie 363 
 
4635 dpurdie 364 
    #
365 
    #   Mark all files in the debian folder as read-execute
366 
    #
407 dpurdie 367 
    System ( 'chmod', '-R', 'a+rx', "$DebianWorkDir/DEBIAN" );
368 
    System ( 'build_dpkg.sh', '-b', $DebianWorkDir);
369 
    System ( 'mv', '-f', "$DebianWorkDir.deb", $opt_output );
370 
 
371 
    System ("build_dpkg.sh", '-I', $opt_output) if (IsVerbose(1));
372 
 
373 
}
374 
 
375 
#-------------------------------------------------------------------------------
4740 dpurdie 376 
# Function        : BuildTarFile
377 
#
378 
# Description     : This function will create a TGZ file of the constructed package
379 
#                   Not often used
380 
#
381 
# Inputs          : None
382 
#
383 
# Returns         : Nothing
384 
#
385 
sub BuildTarFile
386 
{
387 
    Verbose ("Create TGZ file containing body of the package");
388 
    System ('tar',
389 
            '--create',
390 
            '--auto-compress',
391 
            '--owner=0' ,
392 
            '--group=0' ,
393 
            '--one-file-system' ,
394 
            '--exclude=./DEBIAN' ,
395 
            '-C', $DebianWorkDir,
396 
            '--file', $opt_tarFile,
397 
            '.'
398 
            );
399 
}
400 
 
401 
 
402 
#-------------------------------------------------------------------------------
407 dpurdie 403 
# Function        : UpdateControlFile
404 
#
4188 dpurdie 405 
# Description     : Update the Debian 'control' file to fix up various fields
407 dpurdie 406 
#                   within the file.
407 
#
408 
#                   If the files has not been specified, then a basic control
409 
#                   file will be provided.
410 
#
411 
#                   This routine knows where the control file will be placed
412 
#                   within the output work space.
413 
#
414 
# Inputs          : $src            - Path to source file
415 
#                   Uses global variables
416 
#
417 
# Returns         : Nothing
418 
#
419 
sub UpdateControlFile
420 
{
421 
    my($src) = @_;
422 
    my $dst = "$DebianWorkDir/DEBIAN/control";
423 
 
424 
    unless ( $src )
425 
    {
426 
        CreateControlFile();
427 
        return;
428 
    }
429 
 
4635 dpurdie 430 
    #
431 
    #   User has provided a control file
432 
    #       Tweak the internals
433 
    #
407 dpurdie 434 
    Verbose ("UpdateControlFile: $dst" );
435 
    $src = ResolveFile( 0, $src );
436 
 
4635 dpurdie 437 
    #   Calc depends line
4636 dpurdie 438 
    my $depData = join (', ', @DependencyList );
4635 dpurdie 439 
 
440 
    open (SF, '<', $src) || Error ("UpdateControlFile: Cannot open:$src, $!");
441 
    open (DF, '>', $dst) || Error ("UpdateControlFile: Cannot create:$dst, $!");
407 dpurdie 442 
    while ( <SF> )
443 
    {
444 
        s~\s*$~~;
445 
        if ( m~^Package:~ ) {
4105 dpurdie 446 
            $_ = "Package: $opt_name";
407 dpurdie 447 
 
448 
        } elsif ( m~^Version:~ ) {
449 
            $_ = "Version: $opt_buildversion";
450 
 
451 
        } elsif ( m~^Architecture:~ ) {
3921 dpurdie 452 
            $_ = "Architecture: $opt_pkgarch";
407 dpurdie 453 
 
454 
        } elsif ( $opt_description && m~^Description:~ ) {
455 
            $_ = "Description: $opt_description";
4635 dpurdie 456 
 
457 
        } elsif ( m~^Depends:~ ) {
458 
            $_ = "Depends: $depData";
459 
            $depData = '';
407 dpurdie 460 
        }
461 
        print DF $_ , "\n";
462 
    }
4635 dpurdie 463 
 
407 dpurdie 464 
    close (SF);
465 
    close (DF);
4635 dpurdie 466 
 
467 
    #
468 
    #   Warn if Depends section is needed
469 
    #
470 
    Error ("No Depends section seen in user control file")
471 
        if ($depData);
407 dpurdie 472 
}
473 
 
474 
#-------------------------------------------------------------------------------
475 
# Function        : CreateControlFile
476 
#
477 
# Description     : Craete a basic debian control file
478 
#
479 
# Inputs          : Uses global variables
480 
#
481 
# Returns         :
482 
#
483 
sub CreateControlFile
484 
{
485 
    my $dst = "$DebianWorkDir/DEBIAN/control";
486 
 
487 
    Verbose ("CreateControlFile: $dst" );
488 
 
4636 dpurdie 489 
    my $depData = join (', ', @DependencyList );
4635 dpurdie 490 
 
407 dpurdie 491 
    open (DF, '>', $dst) || Error ("CreateControlFile: Cannot create:$dst");
4105 dpurdie 492 
    print DF "Package: $opt_name\n";
407 dpurdie 493 
    print DF "Version: $opt_buildversion\n";
494 
    print DF "Section: main\n";
495 
    print DF "Priority: standard\n";
3921 dpurdie 496 
    print DF "Architecture: $opt_pkgarch\n";
497 
    print DF "Essential: No\n";
498 
    print DF "Maintainer: Vix Technology\n";
407 dpurdie 499 
    print DF "Description: $opt_description\n";
4635 dpurdie 500 
    print DF "Depends: $depData\n" if ($depData);
501 
 
407 dpurdie 502 
    close (DF);
503 
}
504 
 
505 
#-------------------------------------------------------------------------------
506 
# Function        : SetVerbose
507 
#
508 
# Description     : Set the level of verbosity
509 
#                   Display activity
510 
#
511 
# Inputs          : Verbosity level
512 
#                       0 - Use makefile verbosity (Default)
513 
#                       1..2
514 
#
515 
# Returns         :
516 
#
517 
sub SetVerbose
518 
{
519 
    my ($level) = @_;
520 
 
521 
    $level = $opt_verbose unless ( $level );
522 
    $opt_verbose = $level;
523 
    ErrorConfig( 'verbose' => $level);
524 
}
525 
 
526 
 
527 
#-------------------------------------------------------------------------------
528 
# Function        : DebianFiles
529 
#
530 
# Description     : Name Debian builder control files
531 
#                   May be called multiple times
532 
#
533 
# Inputs          : Options
534 
#                       --Control=file
535 
#                       --PreRm=file
536 
#                       --PostRm=file
537 
#                       --PreInst=file
538 
#                       --PostInst=file
4635 dpurdie 539 
#
407 dpurdie 540 
#
541 
# Returns         : Nothing
542 
#
543 
sub DebianFiles
544 
{
545 
    #
4635 dpurdie 546 
    #   Extract names
407 dpurdie 547 
    #
548 
    Verbose ("Specify Debian Control Files and Scripts");
549 
    foreach  ( @_ )
550 
    {
4635 dpurdie 551 
        if ( m/^--Control=(.+)/i ) {
552 
            DebianControlFile('control',$1)
407 dpurdie 553 
 
4635 dpurdie 554 
        } elsif ( m/^--PreRm=(.+)/i ) {
555 
            DebianControlFile('prerm',$1)
407 dpurdie 556 
 
4635 dpurdie 557 
        } elsif ( m/^--PostRm=(.+)/i ) {
558 
            DebianControlFile('postrm',$1)
407 dpurdie 559 
 
4635 dpurdie 560 
        } elsif ( m/^--PreInst=(.+)/i ) {
561 
            DebianControlFile('preinst',$1)
407 dpurdie 562 
 
4635 dpurdie 563 
        } elsif ( m/^--PostInst=(.+)/i ) {
564 
            DebianControlFile('postinst',$1)
407 dpurdie 565 
 
566 
        } else {
567 
            Error ("DebianFiles: Unknown option: $_");
568 
        }
569 
    }
570 
}
571 
 
572 
#-------------------------------------------------------------------------------
4635 dpurdie 573 
# Function        : DebianControlFile
574 
#
575 
# Description     : Add special control files to the Debian Installer
576 
#                   Not useful for embedded installers
577 
#
578 
#                   More general than DebianFiles()
579 
#
580 
# Inputs          : name            - Target Name
581 
#                                     If the name starts with 'package.' then it will be replaced
582 
#                                     with the name of the current package
583 
#                   file            - Source File Name
4676 dpurdie 584 
#                   options         - Options include
585 
#                                       --FromPackage
4635 dpurdie 586 
#
587 
# Returns         :
588 
#
589 
sub DebianControlFile
590 
{
4676 dpurdie 591 
    my ($name, $file, @options) = @_;
592 
    my $fromPackage = 0;
4635 dpurdie 593 
 
594 
    #
4676 dpurdie 595 
    #   Process options
596 
    foreach ( @options)
597 
    {
598 
        if (m~^--FromPackage~) {
599 
            $fromPackage = 1;
600 
        }
601 
        else  {
602 
            ReportError(("DebianControlFile: Unknown argument: $_"));
603 
        }
604 
    }
605 
    ErrorDoExit();
606 
 
607 
    #
4635 dpurdie 608 
    #   Some control files need to have the package name prepended
609 
    #
610 
    $name =~ s~^package\.~$opt_name.~;
611 
 
612 
    #
613 
    #   Only allow one file of each type
614 
    #       Try to protect the user by testing for names by lowercase
615 
    #
616 
    my $simpleName = lc($name);
617 
    Error("DebianControlFile: Multiple definitions for '$name' not allowed")
618 
        if (exists $DebianControlFileNames{$simpleName});
619 
 
4676 dpurdie 620 
    my $filePath = ResolveFile($fromPackage, $file);
4635 dpurdie 621 
 
622 
    #
623 
    #   Add info to data structures
624 
    #
4676 dpurdie 625 
    $DebianControlFiles{$name} = $filePath;
4635 dpurdie 626 
    $DebianControlFileNames{$simpleName} = $name;
627 
}
628 
 
629 
#-------------------------------------------------------------------------------
630 
# Function        : DebianDepends
631 
#
632 
# Description     : This directive allows simple dependency information to be
633 
#                   inserted into the control file
634 
#
4636 dpurdie 635 
#                   Not useful in embedded system
4635 dpurdie 636 
#
637 
# Inputs          : Entry             - A dependency entry
638 
#                   ...               - More entries
639 
#
640 
#
641 
# Returns         : Nothing
642 
#
643 
sub DebianDepends
644 
{
645 
    push @DependencyList, @_;
646 
}
647 
 
648 
 
649 
#-------------------------------------------------------------------------------
407 dpurdie 650 
# Function        : PackageDescription
651 
#
652 
# Description     : Specify the Package Description
653 
#                   Keep it short
654 
#
655 
# Inputs          : $description
656 
#
657 
# Returns         :
658 
#
659 
sub PackageDescription
660 
{
661 
    ($opt_description) = @_;
662 
}
663 
 
664 
#-------------------------------------------------------------------------------
665 
# Function        : MakeSymLink
666 
#
667 
# Description     : Create a symlink - with error detection
668 
#
669 
# Inputs          : old_file    - Link Target
670 
#                                 Path to the link target
671 
#                                 If an ABS path is provided, the routine will
672 
#                                 attempt to create a relative link.
673 
#                   new_file    - Relative to the output work space
674 
#                                 Path to where the 'link' file will be created
675 
#                   Options     - Must be last
676 
#                                 --NoClean         - Don't play with links
677 
#                                 --NoDotDot        - Don't create symlinks with ..
678 
#
679 
# Returns         : Nothing
680 
#
681 
sub MakeSymLink
682 
{
683 
    my $no_clean;
684 
    my $no_dot;
685 
    my @args;
686 
 
687 
    #
688 
    #   Extract options
689 
    #
690 
    foreach ( @_ )
691 
    {
692 
        if ( m/^--NoClean/i ) {
693 
            $no_clean = 1;
694 
 
695 
        } elsif ( m/^--NoDotDot/i ) {
696 
            $no_dot = 1;
697 
 
698 
        } elsif ( m/^--/ ) {
699 
            Error ("MakeSymLink: Unknown option: $_");
700 
 
701 
        } else {
702 
            push @args, $_;
703 
        }
704 
    }
705 
 
706 
    my ($old_file, $new_file) = @args;
707 
 
708 
    my $tfile = $DebianWorkDir . '/' . $new_file;
709 
    $tfile =~ s~//~/~;
710 
    Verbose ("Symlink $old_file -> $new_file" );
711 
 
712 
    #
713 
    #   Create the directory in which the link will be placed
714 
    #   Remove any existing file of the same name
715 
    #
716 
    my $dir = StripFileExt( $tfile );
717 
    mkpath( $dir) unless -d $dir;
718 
    unlink $tfile;
719 
 
720 
    #
721 
    #   Determine a good name of the link
722 
    #   Convert to a relative link in an attempt to prune them
723 
    #
724 
    my $sfile = $old_file;
725 
    unless ( $no_clean )
726 
    {
727 
        $sfile = CalcRelPath( StripFileExt( $new_file ), $old_file );
728 
        $sfile = $old_file if ( $no_dot && $sfile =~ m~^../~ );
729 
    }
730 
 
731 
    my $result = symlink $sfile, $tfile;
732 
    Error ("Cannot create symlink. $old_file -> $new_file") unless ( $result );
733 
}
734 
 
735 
#-------------------------------------------------------------------------------
736 
# Function        : CopyFile
737 
#
738 
# Description     : Copy a file to a target dir
739 
#                   Used for text files, or files with fixed names
740 
#
741 
# Inputs          : $src
742 
#                   $dst_dir    - Within the output workspace
743 
#                   $dst_name   - Output Name [Optional]
744 
#                   Options     - Common Copy Options
745 
#
746 
# Returns         : Full path to destination file
747 
#
748 
sub CopyFile
749 
{
750 
    CopyFileCommon( \&ResolveFile, @_ );
751 
}
752 
 
753 
#-------------------------------------------------------------------------------
754 
# Function        : CopyBinFile
755 
#
756 
# Description     : Copy a file to a target dir
757 
#                   Used for executable programs. Will look in places where
758 
#                   programs are stored.
759 
#
760 
# Inputs          : $src
761 
#                   $dst_dir    - Within the output workspace
762 
#                   $dst_name   - Output Name [Optional]
763 
#
764 
#                   Options:
765 
#                       --FromPackage
766 
#                       --SoftLink=xxxx
767 
#                       --LinkFile=xxxx
768 
#
769 
#
770 
# Returns         : Full path to destination file
771 
#
772 
sub CopyBinFile
773 
{
774 
    CopyFileCommon( \&ResolveBinFile, @_ );
775 
}
776 
 
777 
#-------------------------------------------------------------------------------
778 
# Function        : CopyLibFile
779 
#
780 
# Description     : Copy a file to a target dir
781 
#                   Used for shared programs. Will look in places where
782 
#                   shared libraries are stored.
783 
#
784 
# Inputs          : $src        - Base for 'realname' (no lib, no extension)
785 
#                   $dst_dir    - Within the output workspace
786 
#                   $dst_name   - Output Name [Optional, but not suggested]
787 
#
788 
# Returns         : Full path to destination file
789 
#
790 
# Notes           : Copying 'lib' files
791 
#                   These are 'shared libaries. There is no provision for copying
792 
#                   static libraries.
793 
#
794 
#                   The tool will attempt to copy a well-formed 'realname' library
795 
#                   The soname of the library should be constructed on the target
796 
#                   platform using ldconfig.
797 
#                   There is no provision to copy the 'linker' name
798 
#
799 
#                   Given a request to copy a library called 'fred', then the
800 
#                   well formed 'realname' will be:
801 
#                           libfred[P|D|]].so.nnnnn
802 
#                   where:
803 
#                           nnnn is the library version
804 
#                           [P|D|] indicates Production, Debug or None
805 
#
806 
#                   The 'soname' is held within the realname form of the library
807 
#                   and will be created by lsconfig.
808 
#
809 
#                   The 'linkername' would be libfred[P|D|].so. This is only
810 
#                   needed when linking against the library.
811 
#
812 
#
813 
#                   The routine will also recognize Windows DLLs
814 
#                   These are of the form fred[P|D|].nnnnn.dll
815 
#
816 
sub CopyLibFile
817 
{
818 
    CopyFileCommon( \&ResolveLibFile, @_ );
819 
}
820 
 
821 
#-------------------------------------------------------------------------------
822 
# Function        : CopyFileCommon
823 
#
824 
# Description     : Common ( internal File Copy )
825 
#
826 
# Inputs          : $resolver           - Ref to function to resolve source file
827 
#                   $src                - Source File Name
828 
#                   $dst_dir            - Target Dir
829 
#                   $dst_name           - Target Name (optional)
830 
#                   Options
831 
#                   Options:
832 
#                       --FromPackage
833 
#                       --SoftLink=xxxx
834 
#                       --LinkFile=xxxx
4666 dpurdie 835 
#                       --ConfigFile
407 dpurdie 836 
#
837 
# Returns         :
838 
#
839 
sub CopyFileCommon
840 
{
841 
    my $from_package = 0;
842 
    my $isa_linkfile = 0;
4666 dpurdie 843 
    my $isa_configFile = 0;
407 dpurdie 844 
    my @llist;
845 
    my @args;
846 
 
847 
    #
848 
    #   Parse options
849 
    #
850 
    foreach ( @_ )
851 
    {
852 
        if ( m/^--FromPackage/ ) {
853 
            $from_package = 1;
854 
 
855 
        } elsif ( m/^--LinkFile/ ) {
856 
            $isa_linkfile = 1;
857 
 
4666 dpurdie 858 
        } elsif ( m/^--ConfFile/i ) {
859 
            $isa_configFile = 1;
860 
 
407 dpurdie 861 
        } elsif ( m/^--SoftLink=(.+)/ ) {
862 
            push @llist, $1;
863 
 
864 
        } elsif ( m/^--/ ) {
865 
            Error ("FileCopy: Unknown option: $_");
866 
 
867 
        } else {
868 
            push @args, $_;
869 
        }
870 
    }
871 
 
872 
    #
873 
    #   Extract non-options.
874 
    #   These are the bits that are left over
875 
    #
876 
    my ($resolver, $src, $dst_dir, $dst_name ) = @args;
877 
 
878 
    #
879 
    #   Clean up dest_dir. Must start with a / and not end with one
880 
    #
881 
    $dst_dir = "/$dst_dir/";
882 
    $dst_dir =~ s~/+~/~g;
883 
    $dst_dir =~ s~/$~~;
884 
 
885 
    Verbose ("CopyFile: $src, $dst_dir, " . ($dst_name || ''));
886 
    foreach $src ( &$resolver( $from_package, $src ) )
887 
    {
888 
        my $dst_fname = $dst_name ? $dst_name : StripDir($src);
889 
        my $dst_file = "$dst_dir/$dst_fname";
890 
        Verbose ("CopyFile: Copy $src, $dst_file" );
891 
 
892 
 
893 
        #
894 
        #   LinkFiles are special
895 
        #   They get concatenated to any existing LINKS File
896 
        #
897 
        if ( $isa_linkfile )
898 
        {
899 
            CatFile ( $src, "$dst_dir/.LINKS" );
900 
        }
901 
        else
902 
        {
903 
            mkpath( "$DebianWorkDir$dst_dir", 0, 0775);
904 
            unlink ("$DebianWorkDir$dst_file");
905 
            System ('cp','-f', $src, "$DebianWorkDir$dst_file" );
906 
 
907 
            foreach my $lname ( @llist )
908 
            {
909 
                $lname = $dst_dir . '/' . $lname unless ( $lname =~ m ~^/~ );
910 
                MakeSymLink( $dst_file ,$lname);
911 
            }
912 
        }
4666 dpurdie 913 
 
914 
        #
915 
        #   ConfigFiles are marked so that they can be handled by the debain installer
916 
        #
917 
        if ($isa_configFile)
918 
        {
919 
            push @ConfigList, $dst_file;
920 
        }
407 dpurdie 921 
    }
922 
}
923 
 
924 
#-------------------------------------------------------------------------------
925 
# Function        : CopyDir
926 
#
927 
# Description     : Copy a directory to a target dir
928 
#
929 
# Inputs          : $src_dir    - Local to the user
930 
#                                 Symbolic Name
931 
#                   $dst_dir    - Within the output workspace
932 
#                   Options
4714 dpurdie 933 
#                       --Merge                 - Don't delete first
934 
#                       --Source=Name           - Source via Symbolic Name
935 
#                       --FromPackage           - Source via package roots
936 
#                       --NoIgnoreDbgFiles      - Do not ignore .dbg and .debug files in dir copy
937 
#                       --IfPresent             - Not an error if the path cannot be found
938 
#                       --ConfFile              - Mark transferred files as config files
939 
#                       --Flatten               - Copy all to one directory
940 
#                       --FilterOut=xxx         - Ignore files. DOS Wildcard
941 
#                       --FilterOutRe=xxx       - Ignore files. Regular expression name
942 
#                       --FilterOutDir=xxx      - Ignore directories. DOS Wilcard
943 
#                       --FilterOutDirRe=xxx    - Ignore directories. Regular expression name
944 
#                       --SkipTLF               - Ignore files in the Top Level Directory
945 
#                       --NoRecurse             - Only process files in the Top Level Directory
946 
#                       --FilterIn=xxx          - Include files. DOS Wildcard
947 
#                       --FilterInRe=xxx        - Include files. Regular expression name
948 
#                       --FilterInDir=xxx       - Include directories. DOS Wilcard
949 
#                       --FilterInDirRe=xxx     - Include directories. Regular expression name
407 dpurdie 950 
#
951 
# Returns         :
952 
#
953 
sub CopyDir
954 
{
955 
    my ($src_dir, $dst_dir, @opts) = @_;
956 
    my $opt_base;
411 dpurdie 957 
    my $from_interface = 0;
4152 dpurdie 958 
    my $ignoreDbg = 1;
959 
    my $ignoreNoDir;
960 
    my $user_src_dir = $src_dir;
961 
    my $opt_source;
962 
    my $opt_package;
4714 dpurdie 963 
    my @fileList;
964 
    my $isFiltered;
407 dpurdie 965 
 
4714 dpurdie 966 
    #
967 
    #   Setup the basic copy options
968 
    #       May be altered as we parse user options
969 
    #
970 
    my %copyOpts;
971 
    $copyOpts{'IgnoreDirs'} = ['.svn', '.git', '.cvs', '.hg'];
972 
    $copyOpts{'Ignore'} = ['.gbedir', '_gbedir'];
973 
    $copyOpts{'Log'} = 1 if ( $opt_verbose > 1 );
4740 dpurdie 974 
    $copyOpts{'DeleteFirst'} = 1;
4714 dpurdie 975 
 
407 dpurdie 976 
    $dst_dir = $DebianWorkDir . '/' . $dst_dir;
977 
    $dst_dir =~ s~//~/~;
978 
 
979 
    #
4152 dpurdie 980 
    #   Scan and collect user options
407 dpurdie 981 
    #
982 
    foreach  ( @opts )
983 
    {
4152 dpurdie 984 
        Verbose2 ("CopyDir: $_");
407 dpurdie 985 
        if ( m/^--Merge/ ) {
4740 dpurdie 986 
            $copyOpts{'DeleteFirst'} = 0;
4152 dpurdie 987 
 
407 dpurdie 988 
        } elsif ( m/^--Source=(.+)/ ) {
425 dpurdie 989 
            Error ("Source directory can only be specified once")
4152 dpurdie 990 
                if ( defined $opt_source );
991 
            $opt_source = $1;
425 dpurdie 992 
 
4152 dpurdie 993 
        } elsif ( m/^--FromPackage/ ) {
994 
            Error ("FromPackage can only be specified once")
995 
                if ( defined $opt_package );
996 
            $opt_package = 1;
997 
 
998 
        } elsif ( m/^--NoIgnoreDbgFiles/ ) {
999 
            $ignoreDbg = 0;
1000 
 
1001 
        } elsif ( m/^--IfPresent/ ) {
1002 
            $ignoreNoDir = 1;
407 dpurdie 1003 
 
4714 dpurdie 1004 
        } elsif ( m/^--ConfFile/i ) {
1005 
            $copyOpts{'FileList'} = \@fileList;
1006 
 
1007 
        } elsif ( m/^--Flatten/i ) {
1008 
            $copyOpts{'Flatten'} = 1;
1009 
 
1010 
        } elsif ( m/^--FilterOut=(.+)/i ) {
1011 
            push (@{$copyOpts{'Ignore'}}, $1);
1012 
            $isFiltered = 1;
1013 
 
1014 
        } elsif ( m/^--FilterOutRe=(.+)/i ) {
1015 
            push (@{$copyOpts{'IgnoreRE'}}, $1);
1016 
            $isFiltered = 1;
1017 
 
1018 
        } elsif ( m/^--FilterOutDir=(.+)/i ) {
1019 
            push (@{$copyOpts{'IgnoreDirs'}}, $1);
1020 
            $isFiltered = 1;
1021 
 
1022 
        } elsif ( m/^--FilterOutDirRe=(.+)/i ) {
1023 
            push (@{$copyOpts{'IgnoreDirsRE'}}, $1);
1024 
            $isFiltered = 1;
1025 
 
1026 
        } elsif ( m/^--FilterIn=(.+)/i ) {
1027 
            push (@{$copyOpts{'Match'}}, $1);
1028 
            $isFiltered = 1;
1029 
 
1030 
        } elsif ( m/^--FilterInRe=(.+)/i ) {
1031 
            push (@{$copyOpts{'MatchRE'}}, $1);
1032 
            $isFiltered = 1;
1033 
 
1034 
        } elsif ( m/^--FilterInDir=(.+)/i ) {
1035 
            push (@{$copyOpts{'MatchDirs'}}, $1);
1036 
            $isFiltered = 1;
1037 
 
1038 
        } elsif ( m/^--FilterInDirRe=(.+)/i ) {
1039 
            push (@{$copyOpts{'MatchDirsRE'}}, $1);
1040 
            $isFiltered = 1;
1041 
 
1042 
        } elsif ( m/^--SkipTLF$/i ) {
1043 
            $copyOpts{'SkipTLF'} = 1;
1044 
 
1045 
        } elsif ( m/^--NoRecurse$/i ) {
1046 
            $copyOpts{'NoSubDirs'} = 1;
1047 
 
4152 dpurdie 1048 
        } else {
1049 
            Error ("CopyDir: Unknown option: $_" );
1050 
        }
1051 
    }
411 dpurdie 1052 
 
4152 dpurdie 1053 
    #
1054 
    #   All options have been gathered. Now process some of them
1055 
    #
1056 
    Error ("CopyDir: Cannot use both --Source and --FromPackage: $src_dir") if ($opt_source && $opt_package);
425 dpurdie 1057 
 
4152 dpurdie 1058 
    #
1059 
    #   Convert a symbolic path into a physical path
1060 
    #
1061 
    if ($opt_source)
1062 
    {
1063 
        Verbose2 ("CopyDir: Determine Source: $opt_source");
425 dpurdie 1064 
 
4152 dpurdie 1065 
        $opt_source = lc($opt_source);
1066 
        my %CopyDirSymbolic = (
1067 
            'interfaceincdir'   => $opt_interfaceincdir,
1068 
            'interfacelibdir'   => $opt_interfacelibdir,
1069 
            'interfacebindir'   => $opt_interfacebindir,
1070 
            'libdir'            => $opt_libdir,
1071 
            'bindir'            => $opt_bindir,
1072 
            'localincdir'       => $opt_localincdir,
1073 
            'locallibdir'       => $opt_locallibdir,
1074 
            'localbindir'       => $opt_localbindir,
1075 
            'packagebindir'     => $opt_pkgbindir,
1076 
            'packagelibdir'     => $opt_pkglibdir,
1077 
            'packagepkgdir'     => $opt_pkgpkgdir,
1078 
            'packagedir'        => $opt_pkgdir,
1079 
        );
425 dpurdie 1080 
 
4152 dpurdie 1081 
        if ( exists $CopyDirSymbolic{$opt_source} )
1082 
        {
1083 
            $opt_base = $CopyDirSymbolic{$opt_source};
425 dpurdie 1084 
 
1085 
            #
4152 dpurdie 1086 
            #   If sourceing from interface, then follow
1087 
            #   symlinks in the copy. All files will be links anyway
425 dpurdie 1088 
            #
1089 
            $from_interface = 1
4152 dpurdie 1090 
                if ( $opt_source =~ m~^interface~ );
1091 
        }
1092 
        else
1093 
        {
1094 
            DebugDumpData ("CopyDirSymbolic", \%CopyDirSymbolic);
1095 
            Error ("CopyDir: Unknown Source Name: $opt_source" );
1096 
        }
1097 
    }
425 dpurdie 1098 
 
4152 dpurdie 1099 
    #
1100 
    #   Locate the path within an external package
1101 
    #
1102 
    if ($opt_package)
1103 
    {
1104 
        Verbose2 ("CopyDir: FromPackage: $src_dir");
4147 dpurdie 1105 
 
4152 dpurdie 1106 
        my @path;
1107 
        foreach my $entry ( getPackageList() )
1108 
        {
1109 
            my $base = $entry->getBase(3);
1110 
            next unless ( defined $base );
1111 
            if ( -d $base . '/' . $src_dir )
1112 
            {
1113 
                push @path, $base;
1114 
                $from_interface = 1
1115 
                    if ( $entry->{'TYPE'} eq 'interface' );
1116 
            }
407 dpurdie 1117 
        }
4152 dpurdie 1118 
 
1119 
        if ( $#path < 0 )
1120 
        {
1121 
            Error ("CopyDir: Cannot find source dir in any package: $user_src_dir") unless ($ignoreNoDir);
1122 
            Message ("CopyDir: Optional path not found: $user_src_dir");
1123 
            return;
1124 
        }
1125 
 
1126 
        Error ("CopyDir: Requested path found in mutiple packages: $user_src_dir",
1127 
                @path ) if ( $#path > 0 );
1128 
        $opt_base = pop @path;
1129 
 
1130 
        #
1131 
        #   If sourceing from interface, then follow symlinks in the copy.
1132 
        #   All files will be links anyway
1133 
        #
1134 
        #   This is a very ugly test for 'interface'
1135 
        #
1136 
        $from_interface = 1
1137 
            if ( $opt_base =~ m~/interface/~ );
1138 
 
407 dpurdie 1139 
    }
1140 
 
4152 dpurdie 1141 
    #
1142 
    #   Create the full source path
4714 dpurdie 1143 
    #   May be: from a package, from a known directory, from a local directory
4152 dpurdie 1144 
    #
1145 
 
407 dpurdie 1146 
    $src_dir = $opt_base . '/' . $src_dir if ( $opt_base );
1147 
    $src_dir =~ s~//~/~g;
1148 
    $src_dir =~ s~/$~~;
1149 
 
1150 
    Verbose ("CopyDir: $src_dir, $dst_dir");
4152 dpurdie 1151 
    unless ( -d $src_dir )
1152 
    {
1153 
        Error ("CopyDir: Directory not found: $user_src_dir") unless ($ignoreNoDir);
1154 
        Message ("CopyDir: Optional path not found: $user_src_dir");
1155 
        return;
1156 
    }
407 dpurdie 1157 
 
1158 
    #
4714 dpurdie 1159 
    #   Continue to configure the copy options
407 dpurdie 1160 
    #
4147 dpurdie 1161 
    push (@{$copyOpts{'Ignore'}}, '*.debug', '*.dbg') if $ignoreDbg;
423 dpurdie 1162 
    $copyOpts{'DuplicateLinks'} = 1 unless ( $from_interface );
4714 dpurdie 1163 
    $copyOpts{'EmptyDirs'} = 1 unless ($isFiltered);
407 dpurdie 1164 
 
1165 
    #
423 dpurdie 1166 
    #   Transfer the directory
407 dpurdie 1167 
    #
423 dpurdie 1168 
    JatsCopy::CopyDir ( $src_dir, $dst_dir, \%copyOpts );
407 dpurdie 1169 
 
1170 
    #
4714 dpurdie 1171 
    #   If requested, mark files as config files
1172 
    #   Must remove the DebianWorkDir prefix
1173 
    #
1174 
    if(@fileList)
1175 
    {
1176 
        Verbose ("Mark all transfered files as ConfFiles");
1177 
        my $removePrefix = length ($DebianWorkDir);
1178 
        foreach my $file (@fileList)
1179 
        {
1180 
            push @ConfigList, substr($file, $removePrefix);
1181 
        }
1182 
    }
1183 
 
1184 
    #
407 dpurdie 1185 
    #   Expand link files that may have been copied in
1186 
    #
1187 
    Verbose ("Locate LINKFILES in $DebianWorkDir");
1188 
    ExpandLinkFiles();
1189 
}
1190 
 
1191 
#-------------------------------------------------------------------------------
1192 
# Function        : AddInitScript
1193 
#
1194 
# Description     : Add an Init Script to the target
1195 
#                   Optionally create start and stop links
1196 
#
1197 
# Inputs          : $script     - Name of the init script
1198 
#                   $start      - Start Number
1199 
#                   $stop       - Stop Number
1200 
#                   Options:
1201 
#                       --NoCopy        - Don't copy the script, just add links
1202 
#                       --Afc           - Place in AFC init area
1203 
#                       --FromPackage   - Source is in a package
1204 
#
1205 
# Returns         :
1206 
#
1207 
sub AddInitScript
1208 
{
1209 
    my $no_copy;
1210 
    my $basedir = "";
1211 
    my @args;
1212 
    my $from_package = 0;
1213 
 
4302 dpurdie 1214 
    # This directive is only available on the VIX platforms
1215 
    #   Kludgey test - at the moment
407 dpurdie 1216 
    #
4302 dpurdie 1217 
    if ($opt_pkgarch =~ m~i386~)
1218 
    {
1219 
        Error ("AddInitScript is not supported on this platform");
1220 
    }
1221 
 
1222 
    #
407 dpurdie 1223 
    #   Process and Remove options
1224 
    #
1225 
    foreach  ( @_ )
1226 
    {
1227 
        if ( m/^--NoCopy/ ) {
1228 
            $no_copy = 1;
1229 
 
1230 
        } elsif ( m/^--Afc/ ) {
1231 
            $basedir = "/afc";
1232 
 
1233 
        } elsif ( m/^--FromPackage/ ) {
1234 
            $from_package = 1;
1235 
 
1236 
        } elsif ( m/^--/ ) {
1237 
            Error ("AddInitScript: Unknown option: $_");
1238 
 
1239 
        } else {
1240 
            push @args, $_;
1241 
 
1242 
        }
1243 
    }
1244 
 
1245 
    my( $script, $start, $stop ) = @args;
1246 
    Error ("No script file specified") unless ( $script );
1247 
    Warning("AddInitScript: No start or stop index specified") unless ( $start || $stop );
1248 
    Verbose ("AddInitScript: $script, " . ($start || 'No Start') . ", " . ($stop || 'No Stop'));
1249 
    $script = ResolveFile($from_package, $script );
1250 
 
1251 
    my $tdir = $basedir . "/etc/init.d/init.d";
1252 
    my $base = StripDir($script);
1253 
 
1254 
    CopyFile( $script, $tdir ) unless $no_copy;
1255 
 
1256 
    my $link;
1257 
    if ( $start )
1258 
    {
1259 
        $link = sprintf ("${basedir}/etc/init.d/S%2.2d%s", $start, $base );
1260 
        MakeSymLink( "$tdir/$base", $link);
1261 
    }
1262 
 
1263 
    if ( $stop )
1264 
    {
1265 
        $link = sprintf ("${basedir}/etc/init.d/K%2.2d%s", $stop, $base );
1266 
        MakeSymLink( "$tdir/$base", $link);
1267 
    }
1268 
}
1269 
 
1270 
#-------------------------------------------------------------------------------
1271 
# Function        : CatFile
1272 
#
1273 
# Description     : Copy a file to the end of a file
1274 
#
1275 
# Inputs          : $src
1276 
#                   $dst    - Within the output workspace
1277 
#
1278 
# Returns         :
1279 
#
1280 
sub CatFile
1281 
{
1282 
    my ($src, $dst) = @_;
1283 
 
1284 
    $dst = $DebianWorkDir . '/' . $dst;
1285 
    $dst =~ s~//~/~;
1286 
    Verbose ("CatFile: $src, $dst");
1287 
    $src = ResolveFile(0, $src );
1288 
 
1289 
    open (SF, '<', $src)  || Error ("CatFile: Cannot open $src");
1290 
    open (DF, '>>', $dst) || Error ("CatFile: Cannot create:$dst");
1291 
    while ( <SF> )
1292 
    {
1293 
        print DF $_;
1294 
    }
1295 
    close (SF);
1296 
    close (DF);
1297 
}
1298 
 
1299 
#-------------------------------------------------------------------------------
1300 
# Function        : EchoFile
1301 
#
1302 
# Description     : Echo simple text to a file
1303 
#
1304 
# Inputs          : $file   - Within the output workspace
1305 
#                   $text
1306 
#
1307 
# Returns         :
1308 
#
1309 
sub EchoFile
1310 
{
1311 
    my ($file, $text) = @_;
1312 
    Verbose ("EchoFile: $file");
1313 
 
1314 
    $file = $DebianWorkDir . '/' . $file;
1315 
    $file =~ s~//~/~;
1316 
 
1317 
    unlink $file;
1318 
    open (DT, ">", $file ) || Error ("Cannot create $file");
1319 
    print DT  $text || Error ("Cannot print to $file");
1320 
    close DT;
1321 
}
1322 
 
1323 
#-------------------------------------------------------------------------------
4640 dpurdie 1324 
# Function        : ConvertFiles
1325 
#
1326 
# Description     : This sub-routine is used to remove all carrage return\line
1327 
#                   feeds from a line and replace them with the platform
1328 
#                   specific equivalent chars.
1329 
#
1330 
#                   We let PERL determine what characters are written to the
1331 
#                   file base on the  platform you are running on.
1332 
#
1333 
#                   i.e. LF    for unix
1334 
#                        CR\LF for win32
1335 
#
1336 
# Inputs          : outPath                 - Output directory
1337 
#                   flist                   - List of files in that directory
1338 
#                   or
1339 
#                   SearchOptions           - Search options to find files
1340 
#                                           --Recurse
1341 
#                                           --NoRecurse
1342 
#                                           --FilterIn=xxx
1343 
#                                           --FilterInRe=xxx
1344 
#                                           --FilterOut=xxx
1345 
#                                           --FilterOutRe=xxx
1346 
#                   Common options
1347 
#                                           --Dos
1348 
#                                           --Unix
1349 
#
1350 
#
1351 
# Returns         : 1
1352 
#
1353 
sub ConvertFiles
1354 
{
1355 
    my @uargs;
1356 
    my $lineEnding = "\n";
1357 
    my ($dosSet, $unixSet);
1358 
    my $search =  JatsLocateFiles->new( '--NoRecurse' );
1359 
 
1360 
    #
1361 
    #   Process user arguments extracting options
1362 
    #
1363 
    foreach  ( @_ )
1364 
    {
1365 
        if ( m~^--Recurse~ ) {
1366 
            $search->recurse(1);
1367 
 
1368 
        } elsif ( m~^--NoRecurse~) {
1369 
            $search->recurse(0);
1370 
 
1371 
        } elsif ( /^--FilterOut=(.*)/ ) {
1372 
            $search->filter_out($1);
1373 
 
1374 
        } elsif ( /^--FilterOutRe=(.*)/ ) {
1375 
            $search->filter_out_re($1);
1376 
 
1377 
        } elsif ( /^--FilterIn=(.*)/ ) {
1378 
            $search->filter_in($1);
1379 
 
1380 
        } elsif ( /^--FilterInRe=(.*)/ ) {
1381 
            $search->filter_in_re($1);
1382 
 
1383 
        } elsif ( m~^--Dos~) {
1384 
            $lineEnding = "\r\n";
1385 
            $dosSet = 1;
1386 
 
1387 
        } elsif ( m~^--Unix~) {
1388 
            $lineEnding = "\n";
1389 
            $unixSet = 1;
1390 
 
1391 
        } elsif ( m~^--~) {
4641 dpurdie 1392 
            Error ("ConvertFiles: Unknown option: $_");
4640 dpurdie 1393 
 
1394 
        } else {
1395 
            push @uargs, $_;
1396 
        }
1397 
    }
1398 
 
1399 
    #
1400 
    #   Process non-option arguments
1401 
    #       - Base dir
1402 
    #       - List of files
1403 
    #
1404 
    my ($outPath, @flist) = @uargs;
1405 
    Error ("ConvertFiles: Target Dir must be specified" ) unless ( $outPath );
1406 
 
1407 
    #
1408 
    #   Sanity Tests
1409 
    #
1410 
    Error ("ConvertFiles: --Dos and --Unix are mutually exclusive" ) if ( $dosSet && $unixSet );
1411 
 
1412 
 
1413 
    #
1414 
    # Convert output path to physical path
1415 
    #
1416 
    my $topDir = catdir($DebianWorkDir, $outPath);
1417 
    Verbose("ConvertFiles: topDir: $topDir");
1418 
    Error ("ConvertFiles: Path does not exist", $topDir) unless ( -e $topDir );
1419 
    Error ("ConvertFiles: Path is not a directory", $topDir) unless ( -d $topDir );
1420 
 
1421 
    #
1422 
    #   Need to determine if we are searching or simply using a file list
1423 
    #   There are two forms of the functions. If any of the search options have
1424 
    #   been used then we assume that we are searchine
1425 
    #
1426 
    if ( $search->has_filter() )
1427 
    {
1428 
        Error ("ConvertFiles: Cannot mix search options with named files") if ( @flist );
1429 
        @flist = $search->search($topDir);
1430 
    }
1431 
    Error ("ConvertFiles: No files specified") unless ( @flist );
1432 
 
1433 
    #
1434 
    #   Process all named files
1435 
    #
1436 
    foreach my $file ( @flist )
1437 
    {
1438 
 
1439 
        # this is our file that we want to clean.
1440 
        my ($ifileLoc) = "$topDir/$file";
1441 
        my ($tfileLoc) = "$topDir/$file\.tmp";
4641 dpurdie 1442 
        Verbose("ConvertFiles: $file");
4640 dpurdie 1443 
 
1444 
        # we will check to see if the file exists.
1445 
        #
1446 
        my $ifile;
1447 
        my $tfile;
1448 
        if ( -f "$ifileLoc" )
1449 
        {
1450 
            open ($ifile, "< $ifileLoc" ) or
1451 
                Error("Failed to open file [$ifileLoc] : $!");
1452 
 
1453 
            open ($tfile, "> $tfileLoc" ) or
1454 
                Error("Failed to open file [$tfileLoc] : $!");
1455 
            binmode $tfile;
1456 
 
1457 
            while ( <$ifile> )
1458 
            {
1459 
                s~[\n\r]+$~~;               # Chomp
1460 
                print $tfile "$_" . $lineEnding;
1461 
            }
1462 
        }
1463 
        else
1464 
        {
1465 
            Error("ConvertFiles [$ifileLoc] does not exist.");
1466 
        }
1467 
 
1468 
        close $ifile;
1469 
        close $tfile;
1470 
 
1471 
 
1472 
        # lets replace our original file with the new one
1473 
        #
1474 
        if(File::Copy::move("$tfileLoc", "$ifileLoc"))
1475 
        {
1476 
            Verbose2("ConvertFiles: Renamed [$tfileLoc] to [$ifileLoc] ...");
1477 
        }
1478 
        else
1479 
        {
1480 
            Error("ConvertFiles: Failed to rename file [$tfileLoc] to [$ifileLoc]: $!");
1481 
        }
1482 
    }
1483 
 
1484 
    return 1;
1485 
}
1486 
 
4641 dpurdie 1487 
#----------------------------------------------------------------------------
1488 
# Function        : ReplaceTags
1489 
#
1490 
# Description     : This sub-routine is used to replace Tags in one or more files
1491 
#
1492 
# Inputs          : outPath                 - Output directory
1493 
#                   flist                   - List of files in that directory
1494 
#                   or
1495 
#                   SearchOptions           - Search options to find files
1496 
#                                           --Recurse
1497 
#                                           --NoRecurse
1498 
#                                           --FilterIn=xxx
1499 
#                                           --FilterInRe=xxx
1500 
#                                           --FilterOut=xxx
1501 
#                                           --FilterOutRe=xxx
1502 
#                   Common options
1503 
#                                           --Tag=Tag,Replace
1504 
#
1505 
#
1506 
# Returns         : 1
1507 
#
1508 
sub ReplaceTags
1509 
{
1510 
    my @uargs;
1511 
    my $search =  JatsLocateFiles->new( '--NoRecurse' );
1512 
    my @tagsList;
1513 
    my $tagSep = ',';
1514 
    my @tagOrder;
1515 
    my %tagData;
1516 
 
1517 
    #
1518 
    #   Process user arguments extracting options
1519 
    #
1520 
    foreach  ( @_ )
1521 
    {
1522 
        if ( m~^--Recurse~ ) {
1523 
            $search->recurse(1);
1524 
 
1525 
        } elsif ( m~^--NoRecurse~) {
1526 
            $search->recurse(0);
1527 
 
1528 
        } elsif ( /^--FilterOut=(.*)/ ) {
1529 
            $search->filter_out($1);
1530 
 
1531 
        } elsif ( /^--FilterOutRe=(.*)/ ) {
1532 
            $search->filter_out_re($1);
1533 
 
1534 
        } elsif ( /^--FilterIn=(.*)/ ) {
1535 
            $search->filter_in($1);
1536 
 
1537 
        } elsif ( /^--FilterInRe=(.*)/ ) {
1538 
            $search->filter_in_re($1);
1539 
 
1540 
        } elsif ( m~^--Tag=(.*)~) {
1541 
            push @tagsList, $1;
1542 
 
1543 
        } elsif ( m~^--~) {
1544 
            Error ("ReplaceTags: Unknown option: $_");
1545 
 
1546 
        } else {
1547 
            push @uargs, $_;
1548 
        }
1549 
    }
1550 
 
1551 
    #
1552 
    #   Process non-option arguments
1553 
    #       - Base dir
1554 
    #       - List of files
1555 
    #
1556 
    my ($outPath, @flist) = @uargs;
1557 
    Error ("ReplaceTags: Target Dir must be specified" ) unless ( $outPath );
1558 
 
1559 
    #
1560 
    #   Sanity Tests
1561 
    #
1562 
    Error ("ReplaceTags: No tags specified" ) unless ( @tagsList );
1563 
 
1564 
    #
1565 
    # Convert output path to physical path
1566 
    #
1567 
    my $topDir = catdir($DebianWorkDir, $outPath);
1568 
    Verbose("ReplaceTags: topDir: $topDir");
1569 
    Error ("ReplaceTags: Path does not exist", $topDir) unless ( -e $topDir );
1570 
    Error ("ReplaceTags: Path is not a directory", $topDir) unless ( -d $topDir );
1571 
 
1572 
    #
1573 
    #   Convert Tags into pairs for latter use
1574 
    #
1575 
    my $sep = quotemeta ($tagSep );
1576 
    foreach my $tag ( @tagsList )
1577 
    {
4714 dpurdie 1578 
        my ($tname,$tvalue) = split ( $sep, $tag, 2 );
4641 dpurdie 1579 
        Error ("No tag value in: $tag" ) unless ( defined $tvalue );
1580 
        Error ("Duplicate Tag: $tname" ) if ( exists $tagData{$tname} );
1581 
        Verbose ("Tag: $tname :: $tvalue");
1582 
        push @tagOrder, $tname;
1583 
        $tagData{$tname} = $tvalue;
1584 
    }
1585 
 
1586 
    #
1587 
    #   Need to determine if we are searching or simply using a file list
1588 
    #   There are two forms of the functions. If any of the search options have
1589 
    #   been used then we assume that we are searchine
1590 
    #
1591 
    if ( $search->has_filter() )
1592 
    {
1593 
        Error ("ReplaceTags: Cannot mix search options with named files") if ( @flist );
1594 
        @flist = $search->search($topDir);
1595 
    }
1596 
    Error ("ReplaceTags: No files specified") unless ( @flist );
1597 
 
1598 
    #
1599 
    #   Process all named files
1600 
    #
1601 
    foreach my $file ( @flist )
1602 
    {
1603 
 
1604 
        # this is our file that we want to clean.
1605 
        my ($ifileLoc) = "$topDir/$file";
1606 
        my ($tfileLoc) = "$topDir/$file\.tmp";
1607 
        Verbose("ReplaceTags: $file");
1608 
 
1609 
        # we will check to see if the file exists.
1610 
        #
1611 
        my $ifile;
1612 
        my $tfile;
1613 
        if ( -f "$ifileLoc" )
1614 
        {
1615 
            open ($ifile, "< $ifileLoc" ) or
1616 
                Error("Failed to open file [$ifileLoc] : $!");
1617 
 
1618 
            open ($tfile, "> $tfileLoc" ) or
1619 
                Error("Failed to open file [$tfileLoc] : $!");
1620 
 
1621 
            while ( <$ifile> )
1622 
            {
1623 
                s~[\n\r]+$~~;               # Chomp
1624 
 
1625 
                #
1626 
                #   Perform tag replacement
1627 
                #
1628 
                foreach my $tag ( @tagOrder )
1629 
                {
1630 
                    my $value = $tagData{$tag};
1631 
                    if ( s~$tag~$value~g )
1632 
                    {
1633 
                        Verbose2("Replaced: $tag with $value");
1634 
                    }
1635 
                }
1636 
 
1637 
                print $tfile "$_\n";
1638 
            }
1639 
        }
1640 
        else
1641 
        {
1642 
            Error("ReplaceTags [$ifileLoc] does not exist.");
1643 
        }
1644 
 
1645 
        close $ifile;
1646 
        close $tfile;
1647 
 
1648 
 
1649 
        # lets replace our original file with the new one
1650 
        #
1651 
        if(File::Copy::move("$tfileLoc", "$ifileLoc"))
1652 
        {
1653 
            Verbose2("ReplaceTags: Renamed [$tfileLoc] to [$ifileLoc] ...");
1654 
        }
1655 
        else
1656 
        {
1657 
            Error("ReplaceTags: Failed to rename file [$tfileLoc] to [$ifileLoc]: $!");
1658 
        }
1659 
    }
1660 
 
1661 
    return 1;
1662 
}
1663 
 
4640 dpurdie 1664 
#-------------------------------------------------------------------------------
407 dpurdie 1665 
# Function        : SetFilePerms
1666 
#
1667 
# Description     : Set file permissions on one or more files or directories
1668 
#
1669 
# Inputs          : $perm           - Perm Mask
1670 
#                   @paths          - List of paths/files to process
1671 
#                   Options
1672 
#                       --Recurse   - Recurse subdirs
1673 
#
1674 
# Returns         :
1675 
#
1676 
sub SetFilePerms
1677 
{
1678 
 
1679 
    my @args;
1680 
    my $perms;
1681 
    my $recurse = 0;
1682 
 
1683 
    #
1684 
    #   Process and Remove options
1685 
    #
1686 
    foreach  ( @_ )
1687 
    {
1688 
        if ( m/^--Recurse/ ) {
1689 
            $recurse = 1;
1690 
 
1691 
        } elsif ( m/^--/ ) {
1692 
            Error ("SetFilePerms: Unknown option: $_");
1693 
 
1694 
        } else {
1695 
            push @args, $_;
1696 
 
1697 
        }
1698 
    }
1699 
 
1700 
    $perms = shift @args;
1701 
    Error ("SetFilePerms: No Permissions" ) unless ( $perms );
1702 
 
1703 
    foreach my $path ( @args )
1704 
    {
1705 
        Verbose ("Set permissions; $perms, $path");
1706 
        my $full_path = $DebianWorkDir . '/' . $path;
1707 
        if ( -f $full_path )
1708 
        {
1709 
            System ('chmod', $perms, $full_path );
1710 
        }
1711 
        elsif ( -d $full_path )
1712 
        {
1713 
            System ('chmod', '-R', $perms, $full_path ) if ($recurse);
1714 
            System ('chmod', $perms, $full_path ) unless ($recurse);
1715 
        }
1716 
        else
1717 
        {
1718 
            Warning("SetFilePerms: Path not found: $path");
1719 
        }
1720 
    }
1721 
}
1722 
 
1723 
#-------------------------------------------------------------------------------
4636 dpurdie 1724 
# Function        : SetPermissions
1725 
#
1726 
# Description     : Called to set permissions of files/dirs in a directory structure.
1727 
#                   With no options sets DirTag and all files/dirs in it to perms
1728 
#
1729 
# Inputs          : path        - The directory tag to start setting permissions on
1730 
#                   Options     - See below
1731 
#
1732 
#   Required Options:
1733 
#       One or both of
1734 
#               --FilePerms=    Sets the permissions of files to this permission.
1735 
#                               If not supplied then no files have their permissions changed
1736 
#               --DirPerms=     Sets the permissions of directories to this permission
1737 
#                               If not supplied then no directories have their permissions changed
1738 
#       OR
1739 
#               --Perms=        Sets the permissions of both files and directories to this permissions
1740 
#                               Equivalent to supplying both --FilePerms=X && --DirPerms=X
1741 
#
1742 
#   Options:
1743 
#               --RootOnly      Only sets the permissions on the 'path' directory/file,
1744 
#                               all other options ignored
1745 
#               --SkipRoot      Does not set permissions on the 'path' directory/file,
1746 
#                               obviously mutually exlusive with --RootOnly
1747 
#
1748 
#       Any option supported by JatsLocateFiles.
1749 
#       Some of these include:
1750 
#
1751 
#               --Recurse       Recurse the directory tree.  Does a depth first recurse so that all
1752 
#                               dir entries are processed before the dir itself (default)
1753 
#               --NoRecurse     Dont recurse
1754 
#               --FilterIn=     Apply permissions to files/directories that matches this value.
1755 
#               --FilterInRe=   Perl RE's can be used (Not Shell wildcards) and this option
1756 
#                               can be supplied mulitple times
1757 
#               --FilterOut=    Dont apply permissions to any files/directories matching this value
1758 
#               --FilterOutRe=  Perl RE's can be used (Not Shell wildcards) and this option
1759 
#                               can be supplied mulitple times
1760 
#
1761 
#                               FilterIn is applied before FilterOut.  If Recurse is specified
1762 
#                               the directory will be recursed regardless of these filters, however
1763 
#                               the filter will be applied when it comes time to chmod the dir
1764 
#
1765 
#------------------------------------------------------------------------------
1766 
sub SetPermissions
1767 
{
1768 
    my ( $path, $filePerms, $dirPerms, $someDone );
1769 
    my ( $rootOnly, $skipRoot ) = ( 0, 0 );
1770 
 
1771 
    my $search =  JatsLocateFiles->new( '--Recurse', '--DirsToo' );
1772 
 
1773 
    foreach ( @_ )
1774 
    {
1775 
        if ( m/^--Perms=(.*)/ ) {
1776 
            $filePerms = $1;
1777 
            $dirPerms = $1;
1778 
 
1779 
        } elsif (m/^--FilePerms=(.*)/ )  {
1780 
            $filePerms = $1;
1781 
 
1782 
        } elsif ( m/^--DirPerms=(.*)/ )  {
1783 
            $dirPerms = $1;
1784 
 
1785 
        }  elsif ( m/^--RootOnly/ ) {
1786 
            $rootOnly = 1;
1787 
 
1788 
        } elsif ( m/^--SkipRoot/ )  {
1789 
            $skipRoot = 1;
1790 
 
1791 
        } elsif ( m/^--Filter/ && $search->option( $_ ) ) {
1792 
            Verbose2 ("Search Option: $_" );
1793 
 
1794 
        } elsif ( m/^--Recurse|--NoRecurse/ && $search->option( $_ ) ) {
1795 
            Verbose2 ("Search Option: $_" );
1796 
 
1797 
        } elsif (m/^--/ ) {
1798 
            Error ("SetPermissions: Unknown option: $_");
1799 
 
1800 
        } else  {
1801 
            Error("SetPermissions 'path' already set", "Path: $_") if ( $path );
1802 
            $path = $_;
1803 
        }
1804 
    }
1805 
 
1806 
    #
1807 
    #   Sanity test
1808 
    #
1809 
    Error("SetPermissions called with out a 'path' parameter") if ( !defined($path) );
1810 
    Error("SetPermissions called with out any Permissions specified") if ( !defined($filePerms) && !defined($dirPerms) );
1811 
    Error("SetPermissions: Options --RootOnly & --SkipRoot are mutually exclusive" ) if ( $rootOnly && $skipRoot );
1812 
 
1813 
 
1814 
    #   Convert the target directory name into a physical path
1815 
    #   User specifies '/' as the root of the image
1816 
    #   User specifies 'name' as relateve to the root of the image
1817 
    #
1818 
    my $topDir = $DebianWorkDir . '/' . $path;
1819 
    $topDir =~ s~/+$~~;
1820 
 
1821 
    Verbose("SetPermissions: Called with options " . join(", ", @_));
1822 
 
1823 
    #
1824 
    #   Only set perms on the root directory
1825 
    #       This is a trivial operation
1826 
    #
1827 
    if ( $rootOnly )
1828 
    {
1829 
        $someDone += chmodItem( $topDir, $filePerms, $dirPerms );
1830 
    }
1831 
    else
1832 
    {
1833 
        #
1834 
        #   Create a list of files/dirs to process
1835 
        #
1836 
        my @elements = $search->search( $topDir );
1837 
 
1838 
        foreach my $dirEntry ( @elements )
1839 
        {
1840 
            my $fullPath = "$topDir/$dirEntry";
1841 
 
1842 
            # A dir and we dont have dirperms, so skip
1843 
            if ( -d $fullPath && !defined($dirPerms) )
1844 
            {
1845 
                Verbose2("SetPermissions: Skipping dir $fullPath as we have no dir permissions");
1846 
                next;
1847 
            }
1848 
 
1849 
            # A file and we dont have fileperms, so skip
1850 
            if ( -f $fullPath && !defined($filePerms) )
1851 
            {
1852 
                Verbose2("SetPermissions: Skipping file $fullPath as we have no file permissions");
1853 
                next;
1854 
            }
1855 
 
1856 
            # a file or a dir and have the right permissions and we are not recursing
1857 
            if ( -f $fullPath || -d $fullPath )
1858 
            {
1859 
                $someDone += chmodItem( $fullPath, $filePerms, $dirPerms );
1860 
            }
1861 
            else
1862 
            {
1863 
                Warning("SetPermissions: Skipping $fullPath as its not a file or directory");
1864 
            }
1865 
        }
1866 
 
1867 
        #
1868 
        #   Process the topDir
1869 
        #   May not be modified if --SkipRoot has been requested
1870 
        #
1871 
        if ( !$skipRoot && -e $topDir )
1872 
        {
1873 
            $someDone += chmodItem( $topDir, $filePerms, $dirPerms );
1874 
        }
1875 
    }
1876 
 
1877 
    #   Final warning
1878 
    #
1879 
    Warning ("SetPermissions: No files located", "Args: @_") unless ( $someDone );
1880 
}
1881 
 
4676 dpurdie 1882 
#************ INTERNAL USE ONLY  **********************************************
4636 dpurdie 1883 
# Function        : chmodItem
1884 
#
1885 
# Description     : Internal
1886 
#                   chmod a file or a folder
1887 
#
1888 
# Inputs          : item                        - Item to mod
1889 
#                   filePerms                   - File perms
1890 
#                   dirPerms                    - dire perms
1891 
#
1892 
# Returns         : 1   - Item modified
1893 
#                   0   - Item not modified
1894 
#
4676 dpurdie 1895 
#************ INTERNAL USE ONLY  **********************************************
4636 dpurdie 1896 
sub chmodItem
1897 
{
1898 
    my ($item, $filePerms, $dirPerms) = @_;
1899 
 
1900 
    if ( -d $item && defined $dirPerms)
1901 
    {
1902 
        Verbose("SetPermissions: $dirPerms : $item");
1903 
        System ('chmod', $dirPerms, $item );
1904 
        return 1;
1905 
    }
1906 
 
1907 
    if ( -f $item  && defined $filePerms)
1908 
    {
1909 
        Verbose("SetPermissions: $filePerms : $item");
1910 
        System ('chmod', $filePerms, $item );
1911 
        return 1;
1912 
    }
1913 
 
1914 
    return 0;
1915 
}
1916 
 
1917 
 
1918 
#-------------------------------------------------------------------------------
407 dpurdie 1919 
# Function        : CreateDir
1920 
#
1921 
# Description     : Create a directory within the target workspace
1922 
#
1923 
# Inputs          : $path           - Name of the target directory
1924 
#
1925 
# Returns         : Nothing
1926 
#
1927 
sub CreateDir
1928 
{
1929 
    my ($path) = @_;
1930 
 
1931 
    Verbose ("Create Dir: $path");
1932 
    mkpath( $DebianWorkDir . '/' . $path );
1933 
}
1934 
 
1935 
#-------------------------------------------------------------------------------
1936 
# Function        : IsProduct
1937 
#                   IsPlatform
1938 
#                   IsTarget
427 dpurdie 1939 
#                   IsVariant
407 dpurdie 1940 
#
1941 
# Description     : This function allows some level of control in the
1942 
#                   packaging scripts. It will return true if the current
1943 
#                   product is listed.
1944 
#
1945 
#                   Ugly after thought
1946 
#
1947 
#                   Intended use:
1948 
#                       Xxxxxx(...) if (IsProduct( 'aaa',bbb' );
1949 
#
1950 
# Inputs          : products    - a list of products to compare against
1951 
#
1952 
# Returns         : True if the current build is for one of the listed products
1953 
#
1954 
sub IsProduct
1955 
{
1956 
    foreach ( @_ )
1957 
    {
1958 
        return 1 if ( $opt_product eq $_ );
1959 
    }
1960 
    return 0;
1961 
}
1962 
 
1963 
sub IsPlatform
1964 
{
1965 
    foreach ( @_ )
1966 
    {
1967 
        return 1 if ( $opt_platform eq $_ );
1968 
    }
1969 
    return 0;
1970 
}
1971 
 
1972 
sub IsTarget
1973 
{
1974 
    foreach ( @_ )
1975 
    {
1976 
        return 1 if ( $opt_target eq $_ );
1977 
    }
1978 
    return 0;
1979 
}
1980 
 
427 dpurdie 1981 
sub IsVariant
1982 
{
1983 
    foreach ( @_ )
1984 
    {
1985 
        return 1 if ( $opt_variant eq $_ );
1986 
    }
1987 
    return 0;
1988 
}
407 dpurdie 1989 
 
4676 dpurdie 1990 
#************ INTERNAL USE ONLY  **********************************************
407 dpurdie 1991 
# Function        : FindFiles
1992 
#
1993 
# Description     : Locate files within a given dir tree
1994 
#
1995 
# Inputs          : $root           - Base of the search
1996 
#                   $match          - Re to match
1997 
#
1998 
# Returns         : A list of files that match
1999 
#
4676 dpurdie 2000 
#************ INTERNAL USE ONLY  **********************************************
407 dpurdie 2001 
my @FIND_LIST;
2002 
my $FIND_NAME;
2003 
 
2004 
sub FindFiles
2005 
{
2006 
    my ($root, $match ) = @_;
2007 
    Verbose2("FindFiles: Root: $root, Match: $match");
2008 
 
2009 
    #
2010 
    #   Becareful of closure, Must use globals
2011 
    #
2012 
    @FIND_LIST = ();
2013 
    $FIND_NAME = $match;
2014 
    File::Find::find( \&find_files, $root);
2015 
 
2016 
    #
2017 
    #   Find callback program
2018 
    #
2019 
    sub find_files
2020 
    {
2021 
        my $item =  $File::Find::name;
2022 
 
2023 
        return if ( -d $File::Find::name );
2024 
        return unless ( $_ =~ m~$FIND_NAME~ );
2025 
        push @FIND_LIST, $item;
2026 
    }
2027 
    return @FIND_LIST;
2028 
}
2029 
 
2030 
#-------------------------------------------------------------------------------
2031 
# Function        : CalcRelPath
2032 
#
2033 
# Description     : Return the relative path to the current working directory
2034 
#                   as provided in $Cwd
2035 
#
2036 
# Inputs          : $Cwd - Base dir
2037 
#                   $base - Path to convert
2038 
#
2039 
# Returns         : Relative path from the $Cwd
2040 
#
2041 
sub CalcRelPath
2042 
{
2043 
    my ($Cwd, $base) = @_;
2044 
 
2045 
    my @base = split ('/', $base );
2046 
    my @here = split ('/', $Cwd );
2047 
    my $result;
2048 
 
2049 
    Debug("RelPath: Source: $base");
2050 
 
2051 
    return $base unless ( $base =~ m~^/~ );
2052 
 
2053 
    #
2054 
    #   Remove common bits from the head of both lists
2055 
    #
2056 
    while ( $#base >= 0 && $#here >= 0 && $base[0] eq $here[0] )
2057 
    {
2058 
        shift @base;
2059 
        shift @here;
2060 
    }
2061 
 
2062 
    #
2063 
    #   Need to go up some directories from here and then down into base
2064 
    #
2065 
    $result = '../' x ($#here + 1);
2066 
    $result .= join ( '/', @base);
2067 
    $result = '.' unless ( $result );
2068 
    $result =~ s~//~/~g;
2069 
    $result =~ s~/$~~;
2070 
 
2071 
    Debug("RelPath: Result: $result");
2072 
    return $result;
2073 
}
2074 
 
2075 
#-------------------------------------------------------------------------------
2076 
# Function        : ExpandLinkFiles
2077 
#
2078 
# Description     : Look for .LINK files in the output image and expand
2079 
#                   the links into softlinks
2080 
#
2081 
# Inputs          : None
2082 
#                   The rouine works on the $DebianWorkDir directory tree
2083 
#
2084 
# Returns         : Nothing
2085 
#                   Will remove .LINKS files that are processed
2086 
#
2087 
sub ExpandLinkFiles
2088 
{
2089 
    foreach my $linkfile ( FindFiles( $DebianWorkDir, ".LINKS" ))
2090 
    {
2091 
        next if ( $linkfile =~ m~/\.svn/~ );
2092 
        my $BASEDIR = StripFileExt( $linkfile );
2093 
        $BASEDIR =~ s~^$DebianWorkDir/~~;
2094 
        Verbose "Expand links: $BASEDIR";
2095 
 
2096 
        open (LF, "<", $linkfile ) || Error ("Cannot open link file: $linkfile" );
2097 
        while ( <LF> )
2098 
        {
2099 
            chomp;
2100 
            next if ( m~^#~ );
2101 
            next unless ( $_ );
2102 
            my ($link, $file) = split;
2103 
 
2104 
            MakeSymLink($file ,"$BASEDIR/$link", '--NoDotDot' );
2105 
        }
2106 
        close (LF);
2107 
        unlink $linkfile;
2108 
    }
2109 
}
2110 
 
4676 dpurdie 2111 
#************ INTERNAL USE ONLY  **********************************************
407 dpurdie 2112 
# Function        : ResolveFile
2113 
#
2114 
# Description     : Determine where the source for a file is
415 dpurdie 2115 
#                   Will look in (default):
407 dpurdie 2116 
#                       Local directory
2117 
#                       Local Include
415 dpurdie 2118 
#                   Or  (FromPackage)
2119 
#                       Our Package directory
2120 
#                       Interface directory (BuildPkgArchives)
2121 
#                       Packages (LinkPkgArchive)
2122 
#
407 dpurdie 2123 
#                   Will scan 'parts' subdirs
2124 
#
2125 
# Inputs          : $from_package       - 0 - Local File
2126 
#                   $file
2127 
#
2128 
# Returns         : Path
2129 
#
4676 dpurdie 2130 
#************ INTERNAL USE ONLY  **********************************************
407 dpurdie 2131 
sub ResolveFile
2132 
{
2133 
    my ($from_package, $file) = @_;
2134 
    my $wildcard = ($file =~ /[*?]/);
415 dpurdie 2135 
    my @path;
407 dpurdie 2136 
 
2137 
    #
415 dpurdie 2138 
    #   Determine the paths to search
2139 
    #
2140 
    if ( $from_package )
2141 
    {
2142 
        unless ( @ResolveFileList )
2143 
        {
2144 
            push @ResolveFileList, $opt_pkgdir;
2145 
            foreach my $entry ( getPackageList() )
2146 
            {
2147 
                push @ResolveFileList, $entry->getBase(3);
2148 
            }
2149 
        }
2150 
        @path = @ResolveFileList;
2151 
    }
2152 
    else
2153 
    {
2154 
        @path = ('.', $opt_localincdir);
2155 
    }
2156 
 
2157 
    #
407 dpurdie 2158 
    #   Determine a full list of 'parts' to search
2159 
    #   This is provided within the build information
2160 
    #
2161 
    my @parts = getPlatformParts ();
2162 
    push @parts, '';
2163 
 
2164 
    my @done;
2165 
    foreach my $root (  @path )
2166 
    {
2167 
        foreach my $subdir ( @parts )
2168 
        {
2169 
            my $sfile;
415 dpurdie 2170 
            $sfile = "$root/$subdir/$file";
2171 
            $sfile =~ s~//~/~g;
2172 
            $sfile =~ s~^./~~g;
2173 
            Verbose2("LocateFile: $sfile, $root, $subdir");
2174 
            if ( $wildcard )
2175 
            {
2176 
                push @done, glob ( $sfile );
2177 
            }
2178 
            else
2179 
            {
2180 
                push @done, $sfile if ( -f $sfile || -l $sfile )
2181 
            }
407 dpurdie 2182 
        }
2183 
    }
2184 
 
415 dpurdie 2185 
    Error ("ResolveFile: File not found: $file", "Search Path:", @path)
407 dpurdie 2186 
        unless ( @done );
2187 
 
2188 
    Warning ("ResolveFile: Multiple instances of file found. Only first is used", @done)
2189 
        if ( $#done > 0 && ! $wildcard && !wantarray );
2190 
 
2191 
    return wantarray ? @done : $done[0];
2192 
}
2193 
 
2194 
#-------------------------------------------------------------------------------
2195 
# Function        : ResolveBinFile
2196 
#
415 dpurdie 2197 
# Description     : Determine where the source for a BIN file is
2198 
#                   Will look in (default):
2199 
#                       Local directory
2200 
#                       Local Include
2201 
#                   Or  (FromPackage)
2202 
#                       Our Package directory
2203 
#                       Interface directory (BuildPkgArchives)
2204 
#                       Packages (LinkPkgArchive)
407 dpurdie 2205 
#                   Will scan 'parts' subdirs
2206 
#
2207 
# Inputs          : $from_package       - 0 - Local File
415 dpurdie 2208 
#                   $file
407 dpurdie 2209 
#
2210 
# Returns         : Path
2211 
#
2212 
sub ResolveBinFile
2213 
{
2214 
    my ($from_package, $file) = @_;
2215 
    my @path;
2216 
    my @types;
2217 
    my $wildcard = ($file =~ /[*?]/);
2218 
 
415 dpurdie 2219 
    #
2220 
    #   Determine the paths to search
2221 
    #
407 dpurdie 2222 
    if ( $from_package )
2223 
    {
415 dpurdie 2224 
        unless ( @ResolveBinFileList )
2225 
        {
2226 
            push @ResolveBinFileList, $opt_pkgdir . '/bin';
2227 
            foreach my $entry ( getPackageList() )
2228 
            {
2229 
                if ( my $path = $entry->getBase(3) )
2230 
                {
2231 
                    $path .= '/bin';
2232 
                    push @ResolveBinFileList, $path if ( -d $path );
2233 
                }
2234 
            }
2235 
        }
2236 
        @path = @ResolveBinFileList;
407 dpurdie 2237 
        @types = ($opt_type, '');
2238 
    }
2239 
    else
2240 
    {
2241 
        @path = ($opt_bindir, $opt_localbindir);
2242 
        @types = '';
2243 
    }
2244 
 
2245 
    #
2246 
    #   Determine a full list of 'parts' to search
2247 
    #   This is provided within the build information
2248 
    #
2249 
    my @parts = getPlatformParts ();
2250 
    push @parts, '';
2251 
 
2252 
    my @done;
2253 
    foreach my $root (  @path )
2254 
    {
2255 
        foreach my $subdir ( @parts )
2256 
        {
2257 
            foreach my $type ( @types )
2258 
            {
2259 
                my $sfile;
2260 
                $sfile = "$root/$subdir$type/$file";
2261 
                $sfile =~ s~//~/~g;
2262 
                Verbose2("LocateBinFile: $sfile");
2263 
                if ( $wildcard )
2264 
                {
429 dpurdie 2265 
                    foreach  ( glob ( $sfile ) )
2266 
                    {
4143 dpurdie 2267 
                        # Ignore .dbg (vix) and .debug (qt) files.
429 dpurdie 2268 
                        next if ( m~\.dbg$~ );
4143 dpurdie 2269 
                        next if ( m~\.debug$~ );
429 dpurdie 2270 
                        push @done, $_;
2271 
                    }
407 dpurdie 2272 
                }
2273 
                else
2274 
                {
415 dpurdie 2275 
                    push @done, $sfile if ( -f $sfile || -l $sfile )
407 dpurdie 2276 
                }
2277 
            }
2278 
        }
2279 
    }
2280 
 
415 dpurdie 2281 
    Error ("ResolveBinFile: File not found: $file", "Search Path:", @path)
407 dpurdie 2282 
        unless ( @done );
2283 
 
5026 dpurdie 2284 
    if ( $#done > 0 && ! $wildcard )
2285 
    {
2286 
        Warning ("ResolveBinFile: Multiple instances of file found. Only first is used", @done);
2287 
        splice (@done, 1);
2288 
    }
2289 
 
407 dpurdie 2290 
    return wantarray ? @done : $done[0];
2291 
}
2292 
 
2293 
#-------------------------------------------------------------------------------
2294 
# Function        : ResolveLibFile
2295 
#
415 dpurdie 2296 
# Description     : Determine where the source for a LIB file is
2297 
#                   Will look in (default):
2298 
#                       Local directory
2299 
#                       Local Include
2300 
#                   Or  (FromPackage)
2301 
#                       Our Package directory
2302 
#                       Interface directory (BuildPkgArchives)
2303 
#                       Packages (LinkPkgArchive)
407 dpurdie 2304 
#                   Will scan 'parts' subdirs
2305 
#
4672 dpurdie 2306 
# Inputs          : $from_package   - 0:Local File
2307 
#                   $file           - Basename for a 'realname'
2308 
#                                     Do not provide 'lib' or '.so' or version info
2309 
#                                     May contain embedded options
2310 
#                                       --Dll           - Use Windows style versioned DLL
2311 
#                                       --VersionDll    - Use the versioned DLL
2312 
#                                       --3rdParty      - Use exact name provided
407 dpurdie 2313 
#
2314 
# Returns         : Path
2315 
#
2316 
sub ResolveLibFile
2317 
{
2318 
    my ($from_package, $file) = @_;
2319 
    my $wildcard = ($file =~ /[*?]/);
2320 
    my @options;
2321 
    my $num_dll;
415 dpurdie 2322 
    my @path;
407 dpurdie 2323 
    #
2324 
    #   Extract options from file
2325 
    #
409 alewis 2326 
    $num_dll = 0;
407 dpurdie 2327 
    ($file, @options) = split ( ',', $file);
2328 
    foreach ( @options )
2329 
    {
2330 
        if ( m/^--Dll/ ) {
2331 
            $num_dll = 1;
2332 
        } elsif ( m/^--VersionDll/ ) {
2333 
            $num_dll = 2;
4672 dpurdie 2334 
        } elsif ( m/^--3rdParty/ ) {
2335 
            $num_dll = 3;
407 dpurdie 2336 
        } else {
2337 
            Error ("Unknown suboption to ResolveLibFile: $_" );
2338 
        }
2339 
    }
2340 
 
2341 
    #
415 dpurdie 2342 
    #   Determine the paths to search
2343 
    #
2344 
    if ( $from_package )
2345 
    {
2346 
        unless ( @ResolveLibFileList )
2347 
        {
2348 
            push @ResolveLibFileList, $opt_pkgdir . '/lib';
2349 
            foreach my $entry ( getPackageList() )
2350 
            {
2351 
                push @ResolveLibFileList, $entry->getLibDirs(3);
2352 
            }
2353 
        }
2354 
        @path = @ResolveLibFileList;
2355 
    }
2356 
    else
2357 
    {
2358 
        @path = ($opt_libdir, $opt_locallibdir);
2359 
    }
2360 
 
2361 
    #
407 dpurdie 2362 
    #   Determine a full list of 'parts' to search
2363 
    #   This is provided within the build information
2364 
    #
2365 
    my @parts = getPlatformParts ();
2366 
    push @parts, '';
2367 
 
2368 
    my @done;
2369 
    foreach my $root (  @path )
2370 
    {
2371 
        foreach my $type ( $opt_type, '' )
2372 
        {
2373 
            foreach my $subdir ( @parts )
2374 
            {
2375 
                my $sfile;
2376 
                my $exact;
2377 
                if ( $num_dll == 2 ) {
2378 
                    $sfile = $file . $type . '.*.dll' ;
2379 
                } elsif ( $num_dll == 1 ) {
2380 
                    $sfile = $file . $type . '.dll' ;
2381 
                    $exact = 1;
4672 dpurdie 2382 
                } elsif ( $num_dll == 3 ) {
2383 
                    $sfile = $file;
2384 
                    $exact = 1;
407 dpurdie 2385 
                } else {
2386 
                    $sfile = "lib" . $file . $type . '.so.*';
2387 
                }
2388 
 
2389 
                $sfile = "$root/$subdir/$sfile";
2390 
                $sfile =~ s~//~/~g;
2391 
                Verbose2("LocateLibFile: $sfile");
2392 
                if ( $exact )
2393 
                {
415 dpurdie 2394 
                    push @done, $sfile if ( -f $sfile || -l $sfile );
407 dpurdie 2395 
                }
419 dpurdie 2396 
                elsif ($num_dll)
407 dpurdie 2397 
                {
2398 
                    push @done, glob ( $sfile );
2399 
                }
419 dpurdie 2400 
                else
2401 
                {
2402 
                    #
2403 
                    #   Looking for .so files
2404 
                    #   Filter out the soname so files
2405 
                    #   Assume that the soname is shorter than the realname
4143 dpurdie 2406 
                    #       Ignore .dbg (vix) and .debug (qt) files.
419 dpurdie 2407 
                    #
2408 
                    my %sieve;
2409 
                    foreach ( glob ( $sfile )  )
2410 
                    {
429 dpurdie 2411 
                        next if ( m~\.dbg$~ );
4143 dpurdie 2412 
                        next if ( m~\.debug$~ );
421 alewis 2413 
                        m~(.*\.so\.)([\d\.]*\d)$~;
2414 
                        if ( $1 )
2415 
                        {
2416 
                            my $file = $1;
2417 
                            my $len = exists $sieve{$file} ? length($sieve{$file}) : 0;
2418 
                            $sieve{$file} = $_
2419 
                                if ( $len == 0 || length($_) > $len );
2420 
                        }
419 dpurdie 2421 
                    }
2422 
 
2423 
                    push @done, values %sieve;
2424 
                }
407 dpurdie 2425 
            }
2426 
        }
2427 
    }
2428 
 
415 dpurdie 2429 
    Error ("ResolveLibFile: File not found: $file", "Search Path:", @path)
407 dpurdie 2430 
        unless ( @done );
2431 
 
5026 dpurdie 2432 
    if ( $#done > 0 && ! $wildcard )
2433 
    {
2434 
        Warning ("ResolveLibFile: Multiple instances of file found. Only first is used", @done);
2435 
        splice (@done, 1);
2436 
    }
407 dpurdie 2437 
    return wantarray ? @done : $done[0];
2438 
}
2439 
 
2440 
 
2441 
#-------------------------------------------------------------------------------
2442 
# Function        : AUTOLOAD
2443 
#
2444 
# Description     : Intercept bad user directives and issue a nice error message
2445 
#                   This is a simple routine to report unknown user directives
2446 
#                   It does not attempt to distinguish between user errors and
2447 
#                   programming errors. It assumes that the program has been
2448 
#                   tested. The function simply report filename and line number
2449 
#                   of the bad directive.
2450 
#
2451 
# Inputs          : Original function arguments ( not used )
2452 
#
2453 
# Returns         : This function does not return
2454 
#
2455 
our $AUTOLOAD;
2456 
sub AUTOLOAD
2457 
{
2458 
    my $fname = $AUTOLOAD;
2459 
    $fname =~ s~^main::~~;
2460 
    my ($package, $filename, $line) = caller;
2461 
 
2462 
    Error ("Directive not known or not allowed in this context: $fname",
2463 
           "Directive: $fname( @_ );",
2464 
           "File: $filename, Line: $line" );
2465 
}
2466 
 
2467 
 
2468 
1;
2469