Subversion Repositories DevTools

Rev

Go to most recent revision | Details | 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
35
#                       CopyDir                 - Copy directory tree
36
#                       CopyFile                - Copy a file
37
#                       CopyBinFile             - Copy an executable file
38
#                       CopyLibFile             - Copy a library file
39
#                       CreateDir               - Create a directory
40
#                       DebianFiles             - Specify control and script files
4636 dpurdie 41
#                       DebianControlFile       - Specify control and script files
42
#                       DebianDepends           - Add Depends entry to control file
407 dpurdie 43
#                       EchoFile                - Place text into a file
44
#                       MakeSymLink             - Create a symbolic link
45
#                       PackageDescription      - Specify the package description
46
#                       SetFilePerms            - Set file permissions
47
#                       SetVerbose              - Control progress display
48
#                       IsProduct               - Flow control
49
#                       IsPlatform              - Flow control
50
#                       IsTarget                - Flow control
427 dpurdie 51
#                       IsVariant               - Flow control
407 dpurdie 52
#
53
#                 Thoughts for expansion:
54
#                       ConvertFile             - Option to convert file(s) to Unix Text
55
#                       ReplaceTags             - Replace Tags on target file
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
64
#                        
65
#......................................................................#
66
 
411 dpurdie 67
require 5.006_001;
407 dpurdie 68
use strict;
69
use warnings;
70
 
71
use Getopt::Long;
72
use File::Path;
73
use File::Copy;
74
use File::Find;
75
use JatsSystem;
76
use FileUtils;
77
use JatsError;
4636 dpurdie 78
use JatsLocateFiles;
407 dpurdie 79
use ReadBuildConfig;
423 dpurdie 80
use JatsCopy ();                            # Don't import anything
407 dpurdie 81
 
82
#
83
#   Globals
84
#
425 dpurdie 85
my $DebianWorkDirBase;                      # Workspace
407 dpurdie 86
my $DebianWorkDir;                          # Dir to create file system image within
87
 
88
#
89
#   Command line options
90
#
91
my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug
92
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
93
my $opt_vargs;                              # Verbose arg
94
my $opt_help = 0;
95
my $opt_manual = 0;
96
my $opt_clean = 0;
97
my $opt_platform;
98
my $opt_type;
99
my $opt_buildname;
100
my $opt_buildversion;
101
my $opt_interfacedir;
102
my $opt_target;
103
my $opt_product;
104
my $opt_package_script;
105
my $opt_interfaceincdir;
106
my $opt_interfacelibdir;
107
my $opt_interfacebindir;
108
my $opt_libdir;
109
my $opt_bindir;
110
my $opt_localincdir;
111
my $opt_locallibdir;
112
my $opt_localbindir;
113
my $opt_pkgdir;
114
my $opt_pkglibdir;
115
my $opt_pkgbindir;
116
my $opt_pkgpkgdir;
117
my $opt_output;
417 dpurdie 118
my $opt_name;
427 dpurdie 119
my $opt_variant;
3921 dpurdie 120
my $opt_pkgarch;
407 dpurdie 121
 
122
#
123
#   Options derived from script directives
124
#
125
my $opt_description;
126
 
415 dpurdie 127
#
128
#   Globals
129
#
130
my @ResolveFileList;                    # Cached Package File List
131
my @ResolveBinFileList;                 # Cached PackageBin File List
132
my @ResolveLibFileList;                 # Cached PackageLib File List
4635 dpurdie 133
my %DebianControlFiles;                 # Control Files
134
my %DebianControlFileNames;             # Control Files by name
135
my @DependencyList;                     # Package Dependencies
407 dpurdie 136
 
137
#-------------------------------------------------------------------------------
138
# Function        : Main Entry point
139
#
140
# Description     : This function will be called when the package is initialised
141
#                   Extract arguments from the users environment
142
#
143
#                   Done here to greatly simplify the user script
144
#                   There should be no junk in the user script - keep it simple
145
#
146
# Inputs          :
147
#
148
# Returns         : 
149
#
150
main();
151
sub main
152
{
153
    my $result = GetOptions (
154
                "verbose:s"         => \$opt_vargs,
155
                "clean"             => \$opt_clean,
156
                "Type=s"            => \$opt_type,
4105 dpurdie 157
                "BuildName=s"       => \$opt_buildname,                     # Raw Jats Package Name (Do not use)
158
                "Name=s"            => \$opt_name,                          # Massaged Debian Package Name
407 dpurdie 159
                "BuildVersion=s"    => \$opt_buildversion,
160
                "Platform=s"        => \$opt_platform,
161
                "Target=s"          => \$opt_target,
162
                "Product=s"         => \$opt_product,
163
                "DebianPackage=s"   => \$opt_package_script,
164
                "InterfaceDir=s"    => \$opt_interfacedir,
165
                "InterfaceIncDir=s" => \$opt_interfaceincdir,
166
                "InterfaceLibDir=s" => \$opt_interfacelibdir,
167
                "InterfaceBinDir=s" => \$opt_interfacebindir,
168
                "LibDir=s"          => \$opt_libdir,
169
                "BinDir=s"          => \$opt_bindir,
170
                "LocalIncDir=s"     => \$opt_localincdir,
171
                "LocalLibDir=s"     => \$opt_locallibdir,
172
                "LocalBinDir=s"     => \$opt_localbindir,
173
                "PackageDir=s"      => \$opt_pkgdir,
174
                "PackageLibDir=s"   => \$opt_pkglibdir,
175
                "PackageBinDir=s"   => \$opt_pkgbindir,
176
                "PackagePkgDir=s"   => \$opt_pkgpkgdir,
177
                "Output=s"          => \$opt_output,
427 dpurdie 178
                "Variant:s"         => \$opt_variant,
3921 dpurdie 179
                "PkgArch:s"         => \$opt_pkgarch,
407 dpurdie 180
    );
181
    $opt_verbose++ unless ( $opt_vargs eq '@' );
182
 
183
    ErrorConfig( 'name'    => 'DebianUtils',
184
                 'verbose' => $opt_verbose,
185
                 'debug'   => $opt_debug );
186
 
187
    #
188
    #   Init the FileSystem Uiltity interface
189
    #
190
    InitFileUtils();
191
 
192
    #
193
    #   Ensure that we have all required options
194
    #
195
    Error ("Platform not set")                  unless ( $opt_platform );
196
    Error ("Type not set")                      unless ( $opt_type );
197
    Error ("BuildName not set")                 unless ( $opt_buildname );
4105 dpurdie 198
    Error ("Debian Package Name not set")       unless ( $opt_name );
407 dpurdie 199
    Error ("BuildVersion not set")              unless ( $opt_buildversion );
200
    Error ("InterfaceDir not set")              unless ( $opt_interfacedir );
201
    Error ("Target not set")                    unless ( $opt_target );
202
    Error ("Product not set")                   unless ( $opt_product );
203
    Error ("DebianPackage not set")             unless ( $opt_package_script );
204
    Error ("Ouput File not set")                unless ( $opt_output );
205
 
206
    #
207
    #   Read in relevent config information
208
    #
209
    ReadBuildConfig ($opt_interfacedir, $opt_platform, '--NoTest' );
210
 
211
    #
212
    #   Build the package image in a directory based on the target being created
213
    #
425 dpurdie 214
    $DebianWorkDirBase = "$opt_platform$opt_type.image";
215
    $DebianWorkDir = "$DebianWorkDirBase/$opt_name";
407 dpurdie 216
 
217
    #
218
    #   Configure the System command to fail on any error
219
    #
220
    SystemConfig ( ExitOnError => 1 );
221
 
222
    #
223
    #   Extract the 'name' of the package from the output path
224
    #   Display purposes only
225
    #
226
    my $DebianPkgName = StripDirExt($opt_output);
227
 
228
    #
229
    #   Display variables used
230
    #
231
    Message    "=Building Debian Package =============================================";
417 dpurdie 232
    Message    "Build $opt_name";
407 dpurdie 233
    Message    "       Package: $opt_buildname";
427 dpurdie 234
    Message    "       Variant: $opt_variant" if ($opt_variant);
407 dpurdie 235
    Message    "       Version: $opt_buildversion";
236
    Message    "  Building for: $opt_platform, $opt_target";
237
    Message    "       Product: $opt_product";
238
    Message    "          Type: $opt_type";
3921 dpurdie 239
    Message    "      Pkg Arch: $opt_pkgarch" if ($opt_pkgarch);
407 dpurdie 240
    Verbose    "       Verbose: $opt_verbose";
241
    Verbose    "  InterfaceDir: $opt_interfacedir";
242
    Message    "       Package: $DebianPkgName";
243
    Message    "======================================================================";
244
 
245
    #
3921 dpurdie 246
    #   Defaults
247
    #
248
    $opt_pkgarch = $opt_platform unless ( $opt_pkgarch );
249
 
250
    #
407 dpurdie 251
    #   Perform Clean up
252
    #   Invoked during "make clean" or "make clobber"
253
    #
254
    if ( $opt_clean )
255
    {
256
        Message ("Remove packaging directory: $DebianWorkDir");
425 dpurdie 257
 
258
        #
259
        #   Remove the directory for this package
260
        #   Remove the general work dir - if all packages have been cleaned
261
        #
407 dpurdie 262
        rmtree( $DebianWorkDir );
425 dpurdie 263
        rmdir( $DebianWorkDirBase );
407 dpurdie 264
        rmtree ($opt_output) if ( -f $opt_output );
265
        exit;
266
    }
267
 
268
    #
269
    #   Clean  out the WORK directory
270
    #   Always start with a clean slate
271
    #
272
    #   Ensure that the base of the directory tree does not have 'setgid'
273
    #       This will upset the debian packager
274
    #       This may be an artifact from the users directory and not expected
275
    #
276
    rmtree( $DebianWorkDir );
277
    mkpath( $DebianWorkDir );
278
 
279
    my $perm = (stat $DebianWorkDir)[2] & 0777;
280
    chmod ( $perm & 0777, $DebianWorkDir );
281
 
282
    #
283
    #   Invoke the user script to do the hard work
284
    #
4139 dpurdie 285
    unless (my $return = do $opt_package_script) {
286
            Error ("Couldn't parse $opt_package_script: $@") if $@;
287
            Error ("Couldn't do $opt_package_script: $!")    unless defined $return;
288
        }
407 dpurdie 289
 
290
    #
291
    #   Complete the building of the package
292
    #
293
    BuildDebianPackage ();
294
    Message ("Created Debian Package");
295
}
296
 
297
#-------------------------------------------------------------------------------
298
# Function        : BuildDebianPackage
299
#
300
# Description     : This function will create the Debian Package
301
#                   and transfer it to the target directory
302
#
303
# Inputs          : None
304
#
305
# Returns         : Nothing
306
#
307
sub BuildDebianPackage
308
{
309
    Error ("BuildDebianPackage: No Control File or Package Description")
4635 dpurdie 310
        unless ( exists($DebianControlFiles{'control'}) || $opt_description );
407 dpurdie 311
 
312
    #
313
    #   Convert the FileSystem Image into a Debian Package
314
    #       Insert Debian control files
315
    #
316
    Verbose ("Copy in the Debian Control Files");
317
    mkdir ( "$DebianWorkDir/DEBIAN" );
318
 
4635 dpurdie 319
    #
320
    #   Copy in all the named Debian Control files
321
    #       Ignore any control file. It will be done next
322
    #
323
    foreach my $key ( keys %DebianControlFiles )
324
    {
325
        next if ($key eq 'control');
326
        CopyFile ( $DebianControlFiles{$key},    "/DEBIAN", $key );
327
    }
328
 
329
    #
330
    #   Massage the 'control' file
331
    #
332
    UpdateControlFile ($DebianControlFiles{'control'} );
407 dpurdie 333
 
4635 dpurdie 334
    #
335
    #   Mark all files in the debian folder as read-execute
336
    #
407 dpurdie 337
    System ( 'chmod', '-R', 'a+rx', "$DebianWorkDir/DEBIAN" );
338
    System ( 'build_dpkg.sh', '-b', $DebianWorkDir);
339
    System ( 'mv', '-f', "$DebianWorkDir.deb", $opt_output );
340
 
341
    System ("build_dpkg.sh", '-I', $opt_output) if (IsVerbose(1));
342
 
343
}
344
 
345
#-------------------------------------------------------------------------------
346
# Function        : UpdateControlFile
347
#
4188 dpurdie 348
# Description     : Update the Debian 'control' file to fix up various fields
407 dpurdie 349
#                   within the file.
350
#
351
#                   If the files has not been specified, then a basic control
352
#                   file will be provided.
353
#
354
#                   This routine knows where the control file will be placed
355
#                   within the output work space.
356
#
357
# Inputs          : $src            - Path to source file
358
#                   Uses global variables
359
#
360
# Returns         : Nothing
361
#
362
sub UpdateControlFile
363
{
364
    my($src) = @_;
365
    my $dst = "$DebianWorkDir/DEBIAN/control";
366
 
367
    unless ( $src )
368
    {
369
        CreateControlFile();
370
        return;
371
    }
372
 
4635 dpurdie 373
    #
374
    #   User has provided a control file
375
    #       Tweak the internals
376
    #
407 dpurdie 377
    Verbose ("UpdateControlFile: $dst" );
378
    $src = ResolveFile( 0, $src );
379
 
4635 dpurdie 380
    #   Calc depends line
4636 dpurdie 381
    my $depData = join (', ', @DependencyList );
4635 dpurdie 382
 
383
    open (SF, '<', $src) || Error ("UpdateControlFile: Cannot open:$src, $!");
384
    open (DF, '>', $dst) || Error ("UpdateControlFile: Cannot create:$dst, $!");
407 dpurdie 385
    while ( <SF> )
386
    {
387
        s~\s*$~~;
388
        if ( m~^Package:~ ) {
4105 dpurdie 389
            $_ = "Package: $opt_name";
407 dpurdie 390
 
391
        } elsif ( m~^Version:~ ) {
392
            $_ = "Version: $opt_buildversion";
393
 
394
        } elsif ( m~^Architecture:~ ) {
3921 dpurdie 395
            $_ = "Architecture: $opt_pkgarch";
407 dpurdie 396
 
397
        } elsif ( $opt_description && m~^Description:~ ) {
398
            $_ = "Description: $opt_description";
4635 dpurdie 399
 
400
        } elsif ( m~^Depends:~ ) {
401
            $_ = "Depends: $depData";
402
            $depData = '';
407 dpurdie 403
        }
404
        print DF $_ , "\n";
405
    }
4635 dpurdie 406
 
407 dpurdie 407
    close (SF);
408
    close (DF);
4635 dpurdie 409
 
410
    #
411
    #   Warn if Depends section is needed
412
    #
413
    Error ("No Depends section seen in user control file") 
414
        if ($depData);
407 dpurdie 415
}
416
 
417
#-------------------------------------------------------------------------------
418
# Function        : CreateControlFile
419
#
420
# Description     : Craete a basic debian control file
421
#
422
# Inputs          : Uses global variables
423
#
424
# Returns         : 
425
#
426
sub CreateControlFile
427
{
428
    my $dst = "$DebianWorkDir/DEBIAN/control";
429
 
430
    Verbose ("CreateControlFile: $dst" );
431
 
4636 dpurdie 432
    my $depData = join (', ', @DependencyList );
4635 dpurdie 433
 
407 dpurdie 434
    open (DF, '>', $dst) || Error ("CreateControlFile: Cannot create:$dst");
4105 dpurdie 435
    print DF "Package: $opt_name\n";
407 dpurdie 436
    print DF "Version: $opt_buildversion\n";
437
    print DF "Section: main\n";
438
    print DF "Priority: standard\n";
3921 dpurdie 439
    print DF "Architecture: $opt_pkgarch\n";
440
    print DF "Essential: No\n";
441
    print DF "Maintainer: Vix Technology\n";
407 dpurdie 442
    print DF "Description: $opt_description\n";
4635 dpurdie 443
    print DF "Depends: $depData\n" if ($depData);
444
 
407 dpurdie 445
    close (DF);
446
}
447
 
448
#-------------------------------------------------------------------------------
449
# Function        : SetVerbose
450
#
451
# Description     : Set the level of verbosity
452
#                   Display activity
453
#
454
# Inputs          : Verbosity level
455
#                       0 - Use makefile verbosity (Default)
456
#                       1..2
457
#
458
# Returns         : 
459
#
460
sub SetVerbose
461
{
462
    my ($level) = @_;
463
 
464
    $level = $opt_verbose unless ( $level );
465
    $opt_verbose = $level;
466
    ErrorConfig( 'verbose' => $level);
467
}
468
 
469
 
470
#-------------------------------------------------------------------------------
471
# Function        : DebianFiles
472
#
473
# Description     : Name Debian builder control files
474
#                   May be called multiple times
475
#
476
# Inputs          : Options
477
#                       --Control=file
478
#                       --PreRm=file
479
#                       --PostRm=file
480
#                       --PreInst=file
481
#                       --PostInst=file
4635 dpurdie 482
#                         
407 dpurdie 483
#
484
# Returns         : Nothing
485
#
486
sub DebianFiles
487
{
488
    #
4635 dpurdie 489
    #   Extract names
407 dpurdie 490
    #
491
    Verbose ("Specify Debian Control Files and Scripts");
492
    foreach  ( @_ )
493
    {
4635 dpurdie 494
        if ( m/^--Control=(.+)/i ) {
495
            DebianControlFile('control',$1)
407 dpurdie 496
 
4635 dpurdie 497
        } elsif ( m/^--PreRm=(.+)/i ) {
498
            DebianControlFile('prerm',$1)
407 dpurdie 499
 
4635 dpurdie 500
        } elsif ( m/^--PostRm=(.+)/i ) {
501
            DebianControlFile('postrm',$1)
407 dpurdie 502
 
4635 dpurdie 503
        } elsif ( m/^--PreInst=(.+)/i ) {
504
            DebianControlFile('preinst',$1)
407 dpurdie 505
 
4635 dpurdie 506
        } elsif ( m/^--PostInst=(.+)/i ) {
507
            DebianControlFile('postinst',$1)
407 dpurdie 508
 
509
        } else {
510
            Error ("DebianFiles: Unknown option: $_");
511
        }
512
    }
513
}
514
 
515
#-------------------------------------------------------------------------------
4635 dpurdie 516
# Function        : DebianControlFile 
517
#
518
# Description     : Add special control files to the Debian Installer 
519
#                   Not useful for embedded installers
520
#
521
#                   More general than DebianFiles()
522
#
523
# Inputs          : name            - Target Name
524
#                                     If the name starts with 'package.' then it will be replaced
525
#                                     with the name of the current package
526
#                   file            - Source File Name
527
#
528
# Returns         : 
529
#
530
sub DebianControlFile
531
{
532
    my ($name, $file, $misc) = @_;
533
    Error ("DebianControlFile: Unknown argument: $misc") if defined $misc;
534
 
535
    #
536
    #   Some control files need to have the package name prepended
537
    #
538
    $name =~ s~^package\.~$opt_name.~;
539
 
540
    #
541
    #   Only allow one file of each type
542
    #       Try to protect the user by testing for names by lowercase
543
    #
544
    my $simpleName = lc($name);
545
    Error("DebianControlFile: Multiple definitions for '$name' not allowed")
546
        if (exists $DebianControlFileNames{$simpleName});
547
 
548
    Error("DebianControlFile: $name. File not found", "Control target: $name", "File not found: $file")
549
        unless (-f $file);
550
 
551
    #
552
    #   Add info to data structures
553
    #
554
    $DebianControlFiles{$name} = $file;
555
    $DebianControlFileNames{$simpleName} = $name;
556
}
557
 
558
#-------------------------------------------------------------------------------
559
# Function        : DebianDepends 
560
#
561
# Description     : This directive allows simple dependency information to be  
562
#                   inserted into the control file
563
#
4636 dpurdie 564
#                   Not useful in embedded system
4635 dpurdie 565
#
566
# Inputs          : Entry             - A dependency entry
567
#                   ...               - More entries
568
#                   
569
#
570
# Returns         : Nothing
571
#
572
sub DebianDepends
573
{
574
    push @DependencyList, @_;
575
}
576
 
577
 
578
#-------------------------------------------------------------------------------
407 dpurdie 579
# Function        : PackageDescription
580
#
581
# Description     : Specify the Package Description
582
#                   Keep it short
583
#
584
# Inputs          : $description
585
#
586
# Returns         : 
587
#
588
sub PackageDescription
589
{
590
    ($opt_description) = @_;
591
}
592
 
593
#-------------------------------------------------------------------------------
594
# Function        : MakeSymLink
595
#
596
# Description     : Create a symlink - with error detection
597
#
598
# Inputs          : old_file    - Link Target
599
#                                 Path to the link target
600
#                                 If an ABS path is provided, the routine will
601
#                                 attempt to create a relative link.
602
#                   new_file    - Relative to the output work space
603
#                                 Path to where the 'link' file will be created
604
#                   Options     - Must be last
605
#                                 --NoClean         - Don't play with links
606
#                                 --NoDotDot        - Don't create symlinks with ..
607
#
608
# Returns         : Nothing
609
#
610
sub MakeSymLink
611
{
612
    my $no_clean;
613
    my $no_dot;
614
    my @args;
615
 
616
    #
617
    #   Extract options
618
    #
619
    foreach ( @_ )
620
    {
621
        if ( m/^--NoClean/i ) {
622
            $no_clean = 1;
623
 
624
        } elsif ( m/^--NoDotDot/i ) {
625
            $no_dot = 1;
626
 
627
        } elsif ( m/^--/ ) {
628
            Error ("MakeSymLink: Unknown option: $_");
629
 
630
        } else {
631
            push @args, $_;
632
        }
633
    }
634
 
635
    my ($old_file, $new_file) = @args;
636
 
637
    my $tfile = $DebianWorkDir . '/' . $new_file;
638
    $tfile =~ s~//~/~;
639
    Verbose ("Symlink $old_file -> $new_file" );
640
 
641
    #
642
    #   Create the directory in which the link will be placed
643
    #   Remove any existing file of the same name
644
    #
645
    my $dir = StripFileExt( $tfile );
646
    mkpath( $dir) unless -d $dir;
647
    unlink $tfile;
648
 
649
    #
650
    #   Determine a good name of the link
651
    #   Convert to a relative link in an attempt to prune them
652
    #
653
    my $sfile = $old_file;
654
    unless ( $no_clean )
655
    {
656
        $sfile = CalcRelPath( StripFileExt( $new_file ), $old_file );
657
        $sfile = $old_file if ( $no_dot && $sfile =~ m~^../~ );
658
    }
659
 
660
    my $result = symlink $sfile, $tfile;
661
    Error ("Cannot create symlink. $old_file -> $new_file") unless ( $result );
662
}
663
 
664
#-------------------------------------------------------------------------------
665
# Function        : CopyFile
666
#
667
# Description     : Copy a file to a target dir
668
#                   Used for text files, or files with fixed names
669
#
670
# Inputs          : $src
671
#                   $dst_dir    - Within the output workspace
672
#                   $dst_name   - Output Name [Optional]
673
#                   Options     - Common Copy Options
674
#
675
# Returns         : Full path to destination file
676
#
677
sub CopyFile
678
{
679
    CopyFileCommon( \&ResolveFile, @_ );
680
}
681
 
682
#-------------------------------------------------------------------------------
683
# Function        : CopyBinFile
684
#
685
# Description     : Copy a file to a target dir
686
#                   Used for executable programs. Will look in places where
687
#                   programs are stored.
688
#
689
# Inputs          : $src
690
#                   $dst_dir    - Within the output workspace
691
#                   $dst_name   - Output Name [Optional]
692
#
693
#                   Options:
694
#                       --FromPackage
695
#                       --SoftLink=xxxx
696
#                       --LinkFile=xxxx
697
#
698
#
699
# Returns         : Full path to destination file
700
#
701
sub CopyBinFile
702
{
703
    CopyFileCommon( \&ResolveBinFile, @_ );
704
}
705
 
706
#-------------------------------------------------------------------------------
707
# Function        : CopyLibFile
708
#
709
# Description     : Copy a file to a target dir
710
#                   Used for shared programs. Will look in places where
711
#                   shared libraries are stored.
712
#
713
# Inputs          : $src        - Base for 'realname' (no lib, no extension)
714
#                   $dst_dir    - Within the output workspace
715
#                   $dst_name   - Output Name [Optional, but not suggested]
716
#
717
# Returns         : Full path to destination file
718
#
719
# Notes           : Copying 'lib' files
720
#                   These are 'shared libaries. There is no provision for copying
721
#                   static libraries.
722
#
723
#                   The tool will attempt to copy a well-formed 'realname' library
724
#                   The soname of the library should be constructed on the target
725
#                   platform using ldconfig.
726
#                   There is no provision to copy the 'linker' name
727
#
728
#                   Given a request to copy a library called 'fred', then the
729
#                   well formed 'realname' will be:
730
#                           libfred[P|D|]].so.nnnnn
731
#                   where:
732
#                           nnnn is the library version
733
#                           [P|D|] indicates Production, Debug or None
734
#
735
#                   The 'soname' is held within the realname form of the library
736
#                   and will be created by lsconfig.
737
#
738
#                   The 'linkername' would be libfred[P|D|].so. This is only
739
#                   needed when linking against the library.
740
#
741
#
742
#                   The routine will also recognize Windows DLLs
743
#                   These are of the form fred[P|D|].nnnnn.dll
744
#
745
sub CopyLibFile
746
{
747
    CopyFileCommon( \&ResolveLibFile, @_ );
748
}
749
 
750
#-------------------------------------------------------------------------------
751
# Function        : CopyFileCommon
752
#
753
# Description     : Common ( internal File Copy )
754
#
755
# Inputs          : $resolver           - Ref to function to resolve source file
756
#                   $src                - Source File Name
757
#                   $dst_dir            - Target Dir
758
#                   $dst_name           - Target Name (optional)
759
#                   Options
760
#                   Options:
761
#                       --FromPackage
762
#                       --SoftLink=xxxx
763
#                       --LinkFile=xxxx
764
#
765
# Returns         : 
766
#
767
sub CopyFileCommon
768
{
769
    my $from_package = 0;
770
    my $isa_linkfile = 0;
771
    my @llist;
772
    my @args;
773
 
774
    #
775
    #   Parse options
776
    #
777
    foreach ( @_ )
778
    {
779
        if ( m/^--FromPackage/ ) {
780
            $from_package = 1;
781
 
782
        } elsif ( m/^--LinkFile/ ) {
783
            $isa_linkfile = 1;
784
 
785
        } elsif ( m/^--SoftLink=(.+)/ ) {
786
            push @llist, $1;
787
 
788
        } elsif ( m/^--/ ) {
789
            Error ("FileCopy: Unknown option: $_");
790
 
791
        } else {
792
            push @args, $_;
793
        }
794
    }
795
 
796
    #
797
    #   Extract non-options.
798
    #   These are the bits that are left over
799
    #
800
    my ($resolver, $src, $dst_dir, $dst_name ) = @args;
801
 
802
    #
803
    #   Clean up dest_dir. Must start with a / and not end with one
804
    #
805
    $dst_dir = "/$dst_dir/";
806
    $dst_dir =~ s~/+~/~g;
807
    $dst_dir =~ s~/$~~;
808
 
809
    Verbose ("CopyFile: $src, $dst_dir, " . ($dst_name || ''));
810
    foreach $src ( &$resolver( $from_package, $src ) )
811
    {
812
        my $dst_fname = $dst_name ? $dst_name : StripDir($src);
813
        my $dst_file = "$dst_dir/$dst_fname";
814
        Verbose ("CopyFile: Copy $src, $dst_file" );
815
 
816
 
817
        #
818
        #   LinkFiles are special
819
        #   They get concatenated to any existing LINKS File
820
        #
821
        if ( $isa_linkfile )
822
        {
823
            CatFile ( $src, "$dst_dir/.LINKS" );
824
        }
825
        else
826
        {
827
            mkpath( "$DebianWorkDir$dst_dir", 0, 0775);
828
            unlink ("$DebianWorkDir$dst_file");
829
            System ('cp','-f', $src, "$DebianWorkDir$dst_file" );
830
 
831
            foreach my $lname ( @llist )
832
            {
833
                $lname = $dst_dir . '/' . $lname unless ( $lname =~ m ~^/~ );
834
                MakeSymLink( $dst_file ,$lname);
835
            }
836
        }
837
    }
838
}
839
 
840
#-------------------------------------------------------------------------------
841
# Function        : CopyDir
842
#
843
# Description     : Copy a directory to a target dir
844
#
845
# Inputs          : $src_dir    - Local to the user
846
#                                 Symbolic Name
847
#                   $dst_dir    - Within the output workspace
848
#                   Options
423 dpurdie 849
#                       --Merge             - Don't delete first
850
#                       --Source=Name       - Source via Symbolic Name
4147 dpurdie 851
#                       --FromPackage       - Source via package roots
4152 dpurdie 852
#                       --NoIgnoreDbgFiles  - Do not ignore .dbg and .debug files in dir copy
853
#                       --IfPresent         - Not an error if the path cannot be found
407 dpurdie 854
#
855
# Returns         :
856
#
857
sub CopyDir
858
{
859
    my ($src_dir, $dst_dir, @opts) = @_;
860
    my $opt_merge;
861
    my $opt_base;
411 dpurdie 862
    my $from_interface = 0;
4152 dpurdie 863
    my $ignoreDbg = 1;
864
    my $ignoreNoDir;
865
    my $user_src_dir = $src_dir;
866
    my $opt_source;
867
    my $opt_package;
407 dpurdie 868
 
869
    $dst_dir = $DebianWorkDir . '/' . $dst_dir;
870
    $dst_dir =~ s~//~/~;
871
 
872
    #
4152 dpurdie 873
    #   Scan and collect user options
407 dpurdie 874
    #
875
    foreach  ( @opts )
876
    {
4152 dpurdie 877
        Verbose2 ("CopyDir: $_");
407 dpurdie 878
        if ( m/^--Merge/ ) {
879
            $opt_merge = 1;
4152 dpurdie 880
 
407 dpurdie 881
        } elsif ( m/^--Source=(.+)/ ) {
425 dpurdie 882
            Error ("Source directory can only be specified once")
4152 dpurdie 883
                if ( defined $opt_source );
884
            $opt_source = $1;
425 dpurdie 885
 
4152 dpurdie 886
        } elsif ( m/^--FromPackage/ ) {
887
            Error ("FromPackage can only be specified once")
888
                if ( defined $opt_package );
889
            $opt_package = 1;
890
 
891
        } elsif ( m/^--NoIgnoreDbgFiles/ ) {
892
            $ignoreDbg = 0;
893
 
894
        } elsif ( m/^--IfPresent/ ) {
895
            $ignoreNoDir = 1;
407 dpurdie 896
 
4152 dpurdie 897
        } else {
898
            Error ("CopyDir: Unknown option: $_" );
899
        }
900
    }
411 dpurdie 901
 
4152 dpurdie 902
    #
903
    #   All options have been gathered. Now process some of them
904
    #
905
    Error ("CopyDir: Cannot use both --Source and --FromPackage: $src_dir") if ($opt_source && $opt_package);
425 dpurdie 906
 
4152 dpurdie 907
    #
908
    #   Convert a symbolic path into a physical path
909
    #
910
    if ($opt_source)
911
    {
912
        Verbose2 ("CopyDir: Determine Source: $opt_source");
425 dpurdie 913
 
4152 dpurdie 914
        $opt_source = lc($opt_source);
915
        my %CopyDirSymbolic = (
916
            'interfaceincdir'   => $opt_interfaceincdir,
917
            'interfacelibdir'   => $opt_interfacelibdir,
918
            'interfacebindir'   => $opt_interfacebindir,
919
            'libdir'            => $opt_libdir,
920
            'bindir'            => $opt_bindir,
921
            'localincdir'       => $opt_localincdir,
922
            'locallibdir'       => $opt_locallibdir,
923
            'localbindir'       => $opt_localbindir,
924
            'packagebindir'     => $opt_pkgbindir,
925
            'packagelibdir'     => $opt_pkglibdir,
926
            'packagepkgdir'     => $opt_pkgpkgdir,
927
            'packagedir'        => $opt_pkgdir,
928
        );
425 dpurdie 929
 
4152 dpurdie 930
        if ( exists $CopyDirSymbolic{$opt_source} )
931
        {
932
            $opt_base = $CopyDirSymbolic{$opt_source};
425 dpurdie 933
 
934
            #
4152 dpurdie 935
            #   If sourceing from interface, then follow
936
            #   symlinks in the copy. All files will be links anyway
425 dpurdie 937
            #
938
            $from_interface = 1
4152 dpurdie 939
                if ( $opt_source =~ m~^interface~ );
940
        }
941
        else
942
        {
943
            DebugDumpData ("CopyDirSymbolic", \%CopyDirSymbolic);
944
            Error ("CopyDir: Unknown Source Name: $opt_source" );
945
        }
946
    }
425 dpurdie 947
 
4152 dpurdie 948
    #
949
    #   Locate the path within an external package
950
    #
951
    if ($opt_package)
952
    {
953
        Verbose2 ("CopyDir: FromPackage: $src_dir");
4147 dpurdie 954
 
4152 dpurdie 955
        my @path;
956
        foreach my $entry ( getPackageList() )
957
        {
958
            my $base = $entry->getBase(3);
959
            next unless ( defined $base );
960
            if ( -d $base . '/' . $src_dir )
961
            {
962
                push @path, $base;
963
                $from_interface = 1
964
                    if ( $entry->{'TYPE'} eq 'interface' );
965
            }
407 dpurdie 966
        }
4152 dpurdie 967
 
968
        if ( $#path < 0 )
969
        {
970
            Error ("CopyDir: Cannot find source dir in any package: $user_src_dir") unless ($ignoreNoDir);
971
            Message ("CopyDir: Optional path not found: $user_src_dir");
972
            return;
973
        }
974
 
975
        Error ("CopyDir: Requested path found in mutiple packages: $user_src_dir",
976
                @path ) if ( $#path > 0 );
977
        $opt_base = pop @path;
978
 
979
        #
980
        #   If sourceing from interface, then follow symlinks in the copy.
981
        #   All files will be links anyway
982
        #
983
        #   This is a very ugly test for 'interface'
984
        #
985
        $from_interface = 1
986
            if ( $opt_base =~ m~/interface/~ );
987
 
407 dpurdie 988
    }
989
 
4152 dpurdie 990
    #
991
    #   Create the full source path
992
    #   May be: from a package, from a known directoru, from a local directory
993
    #
994
 
407 dpurdie 995
    $src_dir = $opt_base . '/' . $src_dir if ( $opt_base );
996
    $src_dir =~ s~//~/~g;
997
    $src_dir =~ s~/$~~;
998
 
999
    Verbose ("CopyDir: $src_dir, $dst_dir");
4152 dpurdie 1000
    unless ( -d $src_dir )
1001
    {
1002
        Error ("CopyDir: Directory not found: $user_src_dir") unless ($ignoreNoDir);
1003
        Message ("CopyDir: Optional path not found: $user_src_dir");
1004
        return;
1005
    }
407 dpurdie 1006
 
1007
    #
423 dpurdie 1008
    #   Setup the copy options
407 dpurdie 1009
    #
423 dpurdie 1010
    my %copyOpts;
4101 dpurdie 1011
    $copyOpts{'IgnoreDirs'} = ['.svn', '.git', '.cvs', '.hg'];
1012
    $copyOpts{'Ignore'} = ['.gbedir', '_gbedir'];
4147 dpurdie 1013
    push (@{$copyOpts{'Ignore'}}, '*.debug', '*.dbg') if $ignoreDbg;
423 dpurdie 1014
    $copyOpts{'EmptyDirs'} = 1;
1015
    $copyOpts{'DeleteFirst'} = 1 unless $opt_merge;
1016
    $copyOpts{'Log'} = 1 if ( $opt_verbose > 1 );
1017
    $copyOpts{'DuplicateLinks'} = 1 unless ( $from_interface );
407 dpurdie 1018
 
1019
    #
423 dpurdie 1020
    #   Transfer the directory
407 dpurdie 1021
    #
423 dpurdie 1022
    JatsCopy::CopyDir ( $src_dir, $dst_dir, \%copyOpts );
407 dpurdie 1023
 
1024
    #
1025
    #   Expand link files that may have been copied in
1026
    #
1027
    Verbose ("Locate LINKFILES in $DebianWorkDir");
1028
    ExpandLinkFiles();
1029
}
1030
 
1031
#-------------------------------------------------------------------------------
1032
# Function        : AddInitScript
1033
#
1034
# Description     : Add an Init Script to the target
1035
#                   Optionally create start and stop links
1036
#
1037
# Inputs          : $script     - Name of the init script
1038
#                   $start      - Start Number
1039
#                   $stop       - Stop Number
1040
#                   Options:
1041
#                       --NoCopy        - Don't copy the script, just add links
1042
#                       --Afc           - Place in AFC init area
1043
#                       --FromPackage   - Source is in a package
1044
#
1045
# Returns         : 
1046
#
1047
sub AddInitScript
1048
{
1049
    my $no_copy;
1050
    my $basedir = "";
1051
    my @args;
1052
    my $from_package = 0;
1053
 
4302 dpurdie 1054
    # This directive is only available on the VIX platforms
1055
    #   Kludgey test - at the moment
407 dpurdie 1056
    #
4302 dpurdie 1057
    if ($opt_pkgarch =~ m~i386~)
1058
    {
1059
        Error ("AddInitScript is not supported on this platform"); 
1060
    }
1061
 
1062
    #
407 dpurdie 1063
    #   Process and Remove options
1064
    #
1065
    foreach  ( @_ )
1066
    {
1067
        if ( m/^--NoCopy/ ) {
1068
            $no_copy = 1;
1069
 
1070
        } elsif ( m/^--Afc/ ) {
1071
            $basedir = "/afc";
1072
 
1073
        } elsif ( m/^--FromPackage/ ) {
1074
            $from_package = 1;
1075
 
1076
        } elsif ( m/^--/ ) {
1077
            Error ("AddInitScript: Unknown option: $_");
1078
 
1079
        } else {
1080
            push @args, $_;
1081
 
1082
        }
1083
    }
1084
 
1085
    my( $script, $start, $stop ) = @args;
1086
    Error ("No script file specified") unless ( $script );
1087
    Warning("AddInitScript: No start or stop index specified") unless ( $start || $stop );
1088
    Verbose ("AddInitScript: $script, " . ($start || 'No Start') . ", " . ($stop || 'No Stop'));
1089
    $script = ResolveFile($from_package, $script );
1090
 
1091
    my $tdir = $basedir . "/etc/init.d/init.d";
1092
    my $base = StripDir($script);
1093
 
1094
    CopyFile( $script, $tdir ) unless $no_copy;
1095
 
1096
    my $link;
1097
    if ( $start )
1098
    {
1099
        $link = sprintf ("${basedir}/etc/init.d/S%2.2d%s", $start, $base );
1100
        MakeSymLink( "$tdir/$base", $link);
1101
    }
1102
 
1103
    if ( $stop )
1104
    {
1105
        $link = sprintf ("${basedir}/etc/init.d/K%2.2d%s", $stop, $base );
1106
        MakeSymLink( "$tdir/$base", $link);
1107
    }
1108
}
1109
 
1110
#-------------------------------------------------------------------------------
1111
# Function        : CatFile
1112
#
1113
# Description     : Copy a file to the end of a file
1114
#
1115
# Inputs          : $src
1116
#                   $dst    - Within the output workspace
1117
#
1118
# Returns         :
1119
#
1120
sub CatFile
1121
{
1122
    my ($src, $dst) = @_;
1123
 
1124
    $dst = $DebianWorkDir . '/' . $dst;
1125
    $dst =~ s~//~/~;
1126
    Verbose ("CatFile: $src, $dst");
1127
    $src = ResolveFile(0, $src );
1128
 
1129
    open (SF, '<', $src)  || Error ("CatFile: Cannot open $src");
1130
    open (DF, '>>', $dst) || Error ("CatFile: Cannot create:$dst");
1131
    while ( <SF> )
1132
    {
1133
        print DF $_;
1134
    }
1135
    close (SF);
1136
    close (DF);
1137
}
1138
 
1139
#-------------------------------------------------------------------------------
1140
# Function        : EchoFile
1141
#
1142
# Description     : Echo simple text to a file
1143
#
1144
# Inputs          : $file   - Within the output workspace
1145
#                   $text
1146
#
1147
# Returns         : 
1148
#
1149
sub EchoFile
1150
{
1151
    my ($file, $text) = @_;
1152
    Verbose ("EchoFile: $file");
1153
 
1154
    $file = $DebianWorkDir . '/' . $file;
1155
    $file =~ s~//~/~;
1156
 
1157
    unlink $file;
1158
    open (DT, ">", $file ) || Error ("Cannot create $file");
1159
    print DT  $text || Error ("Cannot print to $file");
1160
    close DT;
1161
}
1162
 
1163
#-------------------------------------------------------------------------------
1164
# Function        : SetFilePerms
1165
#
1166
# Description     : Set file permissions on one or more files or directories
1167
#
1168
# Inputs          : $perm           - Perm Mask
1169
#                   @paths          - List of paths/files to process
1170
#                   Options
1171
#                       --Recurse   - Recurse subdirs
1172
#
1173
# Returns         : 
1174
#
1175
sub SetFilePerms
1176
{
1177
 
1178
    my @args;
1179
    my $perms;
1180
    my $recurse = 0;
1181
 
1182
    #
1183
    #   Process and Remove options
1184
    #
1185
    foreach  ( @_ )
1186
    {
1187
        if ( m/^--Recurse/ ) {
1188
            $recurse = 1;
1189
 
1190
        } elsif ( m/^--/ ) {
1191
            Error ("SetFilePerms: Unknown option: $_");
1192
 
1193
        } else {
1194
            push @args, $_;
1195
 
1196
        }
1197
    }
1198
 
1199
    $perms = shift @args;
1200
    Error ("SetFilePerms: No Permissions" ) unless ( $perms );
1201
 
1202
    foreach my $path ( @args )
1203
    {
1204
        Verbose ("Set permissions; $perms, $path");
1205
        my $full_path = $DebianWorkDir . '/' . $path;
1206
        if ( -f $full_path )
1207
        {
1208
            System ('chmod', $perms, $full_path );
1209
        }
1210
        elsif ( -d $full_path )
1211
        {
1212
            System ('chmod', '-R', $perms, $full_path ) if ($recurse);
1213
            System ('chmod', $perms, $full_path ) unless ($recurse);
1214
        }
1215
        else
1216
        {
1217
            Warning("SetFilePerms: Path not found: $path");
1218
        }
1219
    }
1220
}
1221
 
1222
#-------------------------------------------------------------------------------
4636 dpurdie 1223
# Function        : SetPermissions 
1224
#
1225
# Description     : Called to set permissions of files/dirs in a directory structure.
1226
#                   With no options sets DirTag and all files/dirs in it to perms
1227
#   
1228
# Inputs          : path        - The directory tag to start setting permissions on
1229
#                   Options     - See below
1230
#       
1231
#   Required Options:
1232
#       One or both of
1233
#               --FilePerms=    Sets the permissions of files to this permission.
1234
#                               If not supplied then no files have their permissions changed
1235
#               --DirPerms=     Sets the permissions of directories to this permission
1236
#                               If not supplied then no directories have their permissions changed
1237
#       OR
1238
#               --Perms=        Sets the permissions of both files and directories to this permissions
1239
#                               Equivalent to supplying both --FilePerms=X && --DirPerms=X
1240
#               
1241
#   Options:                    
1242
#               --RootOnly      Only sets the permissions on the 'path' directory/file, 
1243
#                               all other options ignored
1244
#               --SkipRoot      Does not set permissions on the 'path' directory/file, 
1245
#                               obviously mutually exlusive with --RootOnly
1246
#   
1247
#       Any option supported by JatsLocateFiles. 
1248
#       Some of these include:
1249
#               
1250
#               --Recurse       Recurse the directory tree.  Does a depth first recurse so that all 
1251
#                               dir entries are processed before the dir itself (default)
1252
#               --NoRecurse     Dont recurse
1253
#               --FilterIn=     Apply permissions to files/directories that matches this value.
1254
#               --FilterInRe=   Perl RE's can be used (Not Shell wildcards) and this option
1255
#                               can be supplied mulitple times
1256
#               --FilterOut=    Dont apply permissions to any files/directories matching this value
1257
#               --FilterOutRe=  Perl RE's can be used (Not Shell wildcards) and this option
1258
#                               can be supplied mulitple times
1259
#               
1260
#                               FilterIn is applied before FilterOut.  If Recurse is specified 
1261
#                               the directory will be recursed regardless of these filters, however
1262
#                               the filter will be applied when it comes time to chmod the dir 
1263
#
1264
#------------------------------------------------------------------------------
1265
sub SetPermissions
1266
{
1267
    my ( $path, $filePerms, $dirPerms, $someDone );
1268
    my ( $rootOnly, $skipRoot ) = ( 0, 0 );
1269
 
1270
    my $search =  JatsLocateFiles->new( '--Recurse', '--DirsToo' );
1271
 
1272
    foreach ( @_ )
1273
    {
1274
        if ( m/^--Perms=(.*)/ ) {
1275
            $filePerms = $1;
1276
            $dirPerms = $1;
1277
 
1278
        } elsif (m/^--FilePerms=(.*)/ )  {
1279
            $filePerms = $1;
1280
 
1281
        } elsif ( m/^--DirPerms=(.*)/ )  {
1282
            $dirPerms = $1;
1283
 
1284
        }  elsif ( m/^--RootOnly/ ) {
1285
            $rootOnly = 1;
1286
 
1287
        } elsif ( m/^--SkipRoot/ )  {
1288
            $skipRoot = 1;
1289
 
1290
        } elsif ( m/^--Filter/ && $search->option( $_ ) ) {
1291
            Verbose2 ("Search Option: $_" );
1292
 
1293
        } elsif ( m/^--Recurse|--NoRecurse/ && $search->option( $_ ) ) {
1294
            Verbose2 ("Search Option: $_" );
1295
 
1296
        } elsif (m/^--/ ) {
1297
            Error ("SetPermissions: Unknown option: $_");
1298
 
1299
        } else  {
1300
            Error("SetPermissions 'path' already set", "Path: $_") if ( $path );
1301
            $path = $_;
1302
        }
1303
    }
1304
 
1305
    #
1306
    #   Sanity test
1307
    #
1308
    Error("SetPermissions called with out a 'path' parameter") if ( !defined($path) );
1309
    Error("SetPermissions called with out any Permissions specified") if ( !defined($filePerms) && !defined($dirPerms) );
1310
    Error("SetPermissions: Options --RootOnly & --SkipRoot are mutually exclusive" ) if ( $rootOnly && $skipRoot );
1311
 
1312
 
1313
    #   Convert the target directory name into a physical path
1314
    #   User specifies '/' as the root of the image
1315
    #   User specifies 'name' as relateve to the root of the image
1316
    #
1317
    my $topDir = $DebianWorkDir . '/' . $path;
1318
    $topDir =~ s~/+$~~;
1319
 
1320
    Verbose("SetPermissions: Called with options " . join(", ", @_));
1321
 
1322
    #
1323
    #   Only set perms on the root directory
1324
    #       This is a trivial operation
1325
    #
1326
    if ( $rootOnly )
1327
    {
1328
        $someDone += chmodItem( $topDir, $filePerms, $dirPerms );
1329
    }
1330
    else
1331
    {
1332
        #
1333
        #   Create a list of files/dirs to process
1334
        #
1335
        my @elements = $search->search( $topDir );
1336
 
1337
        foreach my $dirEntry ( @elements )
1338
        {
1339
            my $fullPath = "$topDir/$dirEntry";
1340
 
1341
            # A dir and we dont have dirperms, so skip
1342
            if ( -d $fullPath && !defined($dirPerms) )
1343
            {
1344
                Verbose2("SetPermissions: Skipping dir $fullPath as we have no dir permissions");
1345
                next;
1346
            }
1347
 
1348
            # A file and we dont have fileperms, so skip
1349
            if ( -f $fullPath && !defined($filePerms) )
1350
            {
1351
                Verbose2("SetPermissions: Skipping file $fullPath as we have no file permissions");
1352
                next;
1353
            }
1354
 
1355
            # a file or a dir and have the right permissions and we are not recursing
1356
            if ( -f $fullPath || -d $fullPath )
1357
            {
1358
                $someDone += chmodItem( $fullPath, $filePerms, $dirPerms );
1359
            }
1360
            else
1361
            {
1362
                Warning("SetPermissions: Skipping $fullPath as its not a file or directory");
1363
            }
1364
        }
1365
 
1366
        #
1367
        #   Process the topDir
1368
        #   May not be modified if --SkipRoot has been requested
1369
        #
1370
        if ( !$skipRoot && -e $topDir )
1371
        {
1372
            $someDone += chmodItem( $topDir, $filePerms, $dirPerms );
1373
        }
1374
    }
1375
 
1376
    #   Final warning
1377
    #
1378
    Warning ("SetPermissions: No files located", "Args: @_") unless ( $someDone );
1379
}
1380
 
1381
#-------------------------------------------------------------------------------
1382
# Function        : chmodItem 
1383
#
1384
# Description     : Internal
1385
#                   chmod a file or a folder
1386
#
1387
# Inputs          : item                        - Item to mod
1388
#                   filePerms                   - File perms
1389
#                   dirPerms                    - dire perms
1390
#
1391
# Returns         : 1   - Item modified
1392
#                   0   - Item not modified
1393
#
1394
sub chmodItem
1395
{
1396
    my ($item, $filePerms, $dirPerms) = @_;
1397
 
1398
    if ( -d $item && defined $dirPerms)
1399
    {
1400
        Verbose("SetPermissions: $dirPerms : $item");
1401
        System ('chmod', $dirPerms, $item );
1402
        return 1;
1403
    }
1404
 
1405
    if ( -f $item  && defined $filePerms)
1406
    {
1407
        Verbose("SetPermissions: $filePerms : $item");
1408
        System ('chmod', $filePerms, $item );
1409
        return 1;
1410
    }
1411
 
1412
    return 0;
1413
}
1414
 
1415
 
1416
#-------------------------------------------------------------------------------
407 dpurdie 1417
# Function        : CreateDir
1418
#
1419
# Description     : Create a directory within the target workspace
1420
#
1421
# Inputs          : $path           - Name of the target directory
1422
#
1423
# Returns         : Nothing
1424
#
1425
sub CreateDir
1426
{
1427
    my ($path) = @_;
1428
 
1429
    Verbose ("Create Dir: $path");
1430
    mkpath( $DebianWorkDir . '/' . $path );
1431
}
1432
 
1433
#-------------------------------------------------------------------------------
1434
# Function        : IsProduct
1435
#                   IsPlatform
1436
#                   IsTarget
427 dpurdie 1437
#                   IsVariant
407 dpurdie 1438
#
1439
# Description     : This function allows some level of control in the
1440
#                   packaging scripts. It will return true if the current
1441
#                   product is listed.
1442
#
1443
#                   Ugly after thought
1444
#
1445
#                   Intended use:
1446
#                       Xxxxxx(...) if (IsProduct( 'aaa',bbb' );
1447
#
1448
# Inputs          : products    - a list of products to compare against
1449
#
1450
# Returns         : True if the current build is for one of the listed products
1451
#
1452
sub IsProduct
1453
{
1454
    foreach ( @_ )
1455
    {
1456
        return 1 if ( $opt_product eq $_ );
1457
    }
1458
    return 0;
1459
}
1460
 
1461
sub IsPlatform
1462
{
1463
    foreach ( @_ )
1464
    {
1465
        return 1 if ( $opt_platform eq $_ );
1466
    }
1467
    return 0;
1468
}
1469
 
1470
sub IsTarget
1471
{
1472
    foreach ( @_ )
1473
    {
1474
        return 1 if ( $opt_target eq $_ );
1475
    }
1476
    return 0;
1477
}
1478
 
427 dpurdie 1479
sub IsVariant
1480
{
1481
    foreach ( @_ )
1482
    {
1483
        return 1 if ( $opt_variant eq $_ );
1484
    }
1485
    return 0;
1486
}
407 dpurdie 1487
 
1488
#-------------------------------------------------------------------------------
1489
# Function        : FindFiles
1490
#
1491
# Description     : Locate files within a given dir tree
1492
#
1493
# Inputs          : $root           - Base of the search
1494
#                   $match          - Re to match
1495
#
1496
# Returns         : A list of files that match
1497
#
1498
my @FIND_LIST;
1499
my $FIND_NAME;
1500
 
1501
sub FindFiles
1502
{
1503
    my ($root, $match ) = @_;
1504
    Verbose2("FindFiles: Root: $root, Match: $match");
1505
 
1506
    #
1507
    #   Becareful of closure, Must use globals
1508
    #
1509
    @FIND_LIST = ();
1510
    $FIND_NAME = $match;
1511
    File::Find::find( \&find_files, $root);
1512
 
1513
    #
1514
    #   Find callback program
1515
    #
1516
    sub find_files
1517
    {
1518
        my $item =  $File::Find::name;
1519
 
1520
        return if ( -d $File::Find::name );
1521
        return unless ( $_ =~ m~$FIND_NAME~ );
1522
        push @FIND_LIST, $item;
1523
    }
1524
    return @FIND_LIST;
1525
}
1526
 
1527
#-------------------------------------------------------------------------------
1528
# Function        : CalcRelPath
1529
#
1530
# Description     : Return the relative path to the current working directory
1531
#                   as provided in $Cwd
1532
#
1533
# Inputs          : $Cwd - Base dir
1534
#                   $base - Path to convert
1535
#
1536
# Returns         : Relative path from the $Cwd
1537
#
1538
sub CalcRelPath
1539
{
1540
    my ($Cwd, $base) = @_;
1541
 
1542
    my @base = split ('/', $base );
1543
    my @here = split ('/', $Cwd );
1544
    my $result;
1545
 
1546
    Debug("RelPath: Source: $base");
1547
 
1548
    return $base unless ( $base =~ m~^/~ );
1549
 
1550
    #
1551
    #   Remove common bits from the head of both lists
1552
    #
1553
    while ( $#base >= 0 && $#here >= 0 && $base[0] eq $here[0] )
1554
    {
1555
        shift @base;
1556
        shift @here;
1557
    }
1558
 
1559
    #
1560
    #   Need to go up some directories from here and then down into base
1561
    #
1562
    $result = '../' x ($#here + 1);
1563
    $result .= join ( '/', @base);
1564
    $result = '.' unless ( $result );
1565
    $result =~ s~//~/~g;
1566
    $result =~ s~/$~~;
1567
 
1568
    Debug("RelPath: Result: $result");
1569
    return $result;
1570
}
1571
 
1572
#-------------------------------------------------------------------------------
1573
# Function        : ExpandLinkFiles
1574
#
1575
# Description     : Look for .LINK files in the output image and expand
1576
#                   the links into softlinks
1577
#
1578
# Inputs          : None
1579
#                   The rouine works on the $DebianWorkDir directory tree
1580
#
1581
# Returns         : Nothing
1582
#                   Will remove .LINKS files that are processed
1583
#
1584
sub ExpandLinkFiles
1585
{
1586
    foreach my $linkfile ( FindFiles( $DebianWorkDir, ".LINKS" ))
1587
    {
1588
        next if ( $linkfile =~ m~/\.svn/~ );
1589
        my $BASEDIR = StripFileExt( $linkfile );
1590
        $BASEDIR =~ s~^$DebianWorkDir/~~;
1591
        Verbose "Expand links: $BASEDIR";
1592
 
1593
        open (LF, "<", $linkfile ) || Error ("Cannot open link file: $linkfile" );
1594
        while ( <LF> )
1595
        {
1596
            chomp;
1597
            next if ( m~^#~ );
1598
            next unless ( $_ );
1599
            my ($link, $file) = split;
1600
 
1601
            MakeSymLink($file ,"$BASEDIR/$link", '--NoDotDot' );
1602
        }
1603
        close (LF);
1604
        unlink $linkfile;
1605
    }
1606
}
1607
 
1608
#-------------------------------------------------------------------------------
1609
# Function        : ResolveFile
1610
#
1611
# Description     : Determine where the source for a file is
415 dpurdie 1612
#                   Will look in (default):
407 dpurdie 1613
#                       Local directory
1614
#                       Local Include
415 dpurdie 1615
#                   Or  (FromPackage)
1616
#                       Our Package directory
1617
#                       Interface directory (BuildPkgArchives)
1618
#                       Packages (LinkPkgArchive)
1619
#
407 dpurdie 1620
#                   Will scan 'parts' subdirs
1621
#
1622
# Inputs          : $from_package       - 0 - Local File
1623
#                   $file
1624
#
1625
# Returns         : Path
1626
#
1627
sub ResolveFile
1628
{
1629
    my ($from_package, $file) = @_;
1630
    my $wildcard = ($file =~ /[*?]/);
415 dpurdie 1631
    my @path;
407 dpurdie 1632
 
1633
    #
415 dpurdie 1634
    #   Determine the paths to search
1635
    #
1636
    if ( $from_package )
1637
    {
1638
        unless ( @ResolveFileList )
1639
        {
1640
            push @ResolveFileList, $opt_pkgdir;
1641
            foreach my $entry ( getPackageList() )
1642
            {
1643
                push @ResolveFileList, $entry->getBase(3);
1644
            }
1645
        }
1646
        @path = @ResolveFileList;
1647
    }
1648
    else
1649
    {
1650
        @path = ('.', $opt_localincdir);
1651
    }
1652
 
1653
    #
407 dpurdie 1654
    #   Determine a full list of 'parts' to search
1655
    #   This is provided within the build information
1656
    #
1657
    my @parts = getPlatformParts ();
1658
    push @parts, '';
1659
 
1660
    my @done;
1661
    foreach my $root (  @path )
1662
    {
1663
        foreach my $subdir ( @parts )
1664
        {
1665
            my $sfile;
415 dpurdie 1666
            $sfile = "$root/$subdir/$file";
1667
            $sfile =~ s~//~/~g;
1668
            $sfile =~ s~^./~~g;
1669
            Verbose2("LocateFile: $sfile, $root, $subdir");
1670
            if ( $wildcard )
1671
            {
1672
                push @done, glob ( $sfile );
1673
            }
1674
            else
1675
            {
1676
                push @done, $sfile if ( -f $sfile || -l $sfile )
1677
            }
407 dpurdie 1678
        }
1679
    }
1680
 
415 dpurdie 1681
    Error ("ResolveFile: File not found: $file", "Search Path:", @path)
407 dpurdie 1682
        unless ( @done );
1683
 
1684
    Warning ("ResolveFile: Multiple instances of file found. Only first is used", @done)
1685
        if ( $#done > 0 && ! $wildcard && !wantarray );
1686
 
1687
    return wantarray ? @done : $done[0];
1688
}
1689
 
1690
#-------------------------------------------------------------------------------
1691
# Function        : ResolveBinFile
1692
#
415 dpurdie 1693
# Description     : Determine where the source for a BIN file is
1694
#                   Will look in (default):
1695
#                       Local directory
1696
#                       Local Include
1697
#                   Or  (FromPackage)
1698
#                       Our Package directory
1699
#                       Interface directory (BuildPkgArchives)
1700
#                       Packages (LinkPkgArchive)
407 dpurdie 1701
#                   Will scan 'parts' subdirs
1702
#
1703
# Inputs          : $from_package       - 0 - Local File
415 dpurdie 1704
#                   $file
407 dpurdie 1705
#
1706
# Returns         : Path
1707
#
1708
sub ResolveBinFile
1709
{
1710
    my ($from_package, $file) = @_;
1711
    my @path;
1712
    my @types;
1713
    my $wildcard = ($file =~ /[*?]/);
1714
 
415 dpurdie 1715
    #
1716
    #   Determine the paths to search
1717
    #
407 dpurdie 1718
    if ( $from_package )
1719
    {
415 dpurdie 1720
        unless ( @ResolveBinFileList )
1721
        {
1722
            push @ResolveBinFileList, $opt_pkgdir . '/bin';
1723
            foreach my $entry ( getPackageList() )
1724
            {
1725
                if ( my $path = $entry->getBase(3) )
1726
                {
1727
                    $path .= '/bin';
1728
                    push @ResolveBinFileList, $path if ( -d $path );
1729
                }
1730
            }
1731
        }
1732
        @path = @ResolveBinFileList;
407 dpurdie 1733
        @types = ($opt_type, '');
1734
    }
1735
    else
1736
    {
1737
        @path = ($opt_bindir, $opt_localbindir);
1738
        @types = '';
1739
    }
1740
 
1741
    #
1742
    #   Determine a full list of 'parts' to search
1743
    #   This is provided within the build information
1744
    #
1745
    my @parts = getPlatformParts ();
1746
    push @parts, '';
1747
 
1748
    my @done;
1749
    foreach my $root (  @path )
1750
    {
1751
        foreach my $subdir ( @parts )
1752
        {
1753
            foreach my $type ( @types )
1754
            {
1755
                my $sfile;
1756
                $sfile = "$root/$subdir$type/$file";
1757
                $sfile =~ s~//~/~g;
1758
                Verbose2("LocateBinFile: $sfile");
1759
                if ( $wildcard )
1760
                {
429 dpurdie 1761
                    foreach  ( glob ( $sfile ) )
1762
                    {
4143 dpurdie 1763
                        # Ignore .dbg (vix) and .debug (qt) files.
429 dpurdie 1764
                        next if ( m~\.dbg$~ );
4143 dpurdie 1765
                        next if ( m~\.debug$~ );
429 dpurdie 1766
                        push @done, $_;
1767
                    }
407 dpurdie 1768
                }
1769
                else
1770
                {
415 dpurdie 1771
                    push @done, $sfile if ( -f $sfile || -l $sfile )
407 dpurdie 1772
                }
1773
            }
1774
        }
1775
    }
1776
 
415 dpurdie 1777
    Error ("ResolveBinFile: File not found: $file", "Search Path:", @path)
407 dpurdie 1778
        unless ( @done );
1779
 
1780
    Warning ("ResolveBinFile: Multiple instances of file found. Only first is used", @done)
1781
        if ( $#done > 0 && ! $wildcard && !wantarray );
1782
    return wantarray ? @done : $done[0];
1783
}
1784
 
1785
#-------------------------------------------------------------------------------
1786
# Function        : ResolveLibFile
1787
#
415 dpurdie 1788
# Description     : Determine where the source for a LIB file is
1789
#                   Will look in (default):
1790
#                       Local directory
1791
#                       Local Include
1792
#                   Or  (FromPackage)
1793
#                       Our Package directory
1794
#                       Interface directory (BuildPkgArchives)
1795
#                       Packages (LinkPkgArchive)
407 dpurdie 1796
#                   Will scan 'parts' subdirs
1797
#
1798
# Inputs          : $from_package       - 0 - Local File
415 dpurdie 1799
#                   $file       - Basename for a 'realname'
407 dpurdie 1800
#                                 Do not provide 'lib' or '.so' or version info
1801
#                                 May contain embedded options
1802
#                                   --Dll - use Windows style versioned DLL
1803
#                                   --VersionDll - USe the versioned DLL
1804
#
1805
# Returns         : Path
1806
#
1807
sub ResolveLibFile
1808
{
1809
    my ($from_package, $file) = @_;
1810
    my $wildcard = ($file =~ /[*?]/);
1811
    my @options;
1812
    my $num_dll;
415 dpurdie 1813
    my @path;
407 dpurdie 1814
    #
1815
    #   Extract options from file
1816
    #
409 alewis 1817
    $num_dll = 0;
407 dpurdie 1818
    ($file, @options) = split ( ',', $file);
1819
    foreach ( @options )
1820
    {
1821
        if ( m/^--Dll/ ) {
1822
            $num_dll = 1;
1823
        } elsif ( m/^--VersionDll/ ) {
1824
            $num_dll = 2;
1825
        } else {
1826
            Error ("Unknown suboption to ResolveLibFile: $_" );
1827
        }
1828
    }
1829
 
1830
    #
415 dpurdie 1831
    #   Determine the paths to search
1832
    #
1833
    if ( $from_package )
1834
    {
1835
        unless ( @ResolveLibFileList )
1836
        {
1837
            push @ResolveLibFileList, $opt_pkgdir . '/lib';
1838
            foreach my $entry ( getPackageList() )
1839
            {
1840
                push @ResolveLibFileList, $entry->getLibDirs(3);
1841
            }
1842
        }
1843
        @path = @ResolveLibFileList;
1844
    }
1845
    else
1846
    {
1847
        @path = ($opt_libdir, $opt_locallibdir);
1848
    }
1849
 
1850
    #
407 dpurdie 1851
    #   Determine a full list of 'parts' to search
1852
    #   This is provided within the build information
1853
    #
1854
    my @parts = getPlatformParts ();
1855
    push @parts, '';
1856
 
1857
    my @done;
1858
    foreach my $root (  @path )
1859
    {
1860
        foreach my $type ( $opt_type, '' )
1861
        {
1862
            foreach my $subdir ( @parts )
1863
            {
1864
                my $sfile;
1865
                my $exact;
1866
                if ( $num_dll == 2 ) {
1867
                    $sfile = $file . $type . '.*.dll' ;
1868
                } elsif ( $num_dll == 1 ) {
1869
                    $sfile = $file . $type . '.dll' ;
1870
                    $exact = 1;
1871
                } else {
1872
                    $sfile = "lib" . $file . $type . '.so.*';
1873
                }
1874
 
1875
                $sfile = "$root/$subdir/$sfile";
1876
                $sfile =~ s~//~/~g;
1877
                Verbose2("LocateLibFile: $sfile");
1878
                if ( $exact )
1879
                {
415 dpurdie 1880
                    push @done, $sfile if ( -f $sfile || -l $sfile );
407 dpurdie 1881
                }
419 dpurdie 1882
                elsif ($num_dll)
407 dpurdie 1883
                {
1884
                    push @done, glob ( $sfile );
1885
                }
419 dpurdie 1886
                else
1887
                {
1888
                    #
1889
                    #   Looking for .so files
1890
                    #   Filter out the soname so files
1891
                    #   Assume that the soname is shorter than the realname
4143 dpurdie 1892
                    #       Ignore .dbg (vix) and .debug (qt) files.
419 dpurdie 1893
                    #
1894
                    my %sieve;
1895
                    foreach ( glob ( $sfile )  )
1896
                    {
429 dpurdie 1897
                        next if ( m~\.dbg$~ );
4143 dpurdie 1898
                        next if ( m~\.debug$~ );
421 alewis 1899
                        m~(.*\.so\.)([\d\.]*\d)$~;
1900
                        if ( $1 )
1901
                        {
1902
                            my $file = $1;
1903
                            my $len = exists $sieve{$file} ? length($sieve{$file}) : 0;
1904
                            $sieve{$file} = $_
1905
                                if ( $len == 0 || length($_) > $len );
1906
                        }                                
419 dpurdie 1907
                    }
1908
 
1909
                    push @done, values %sieve;
1910
                }
407 dpurdie 1911
            }
1912
        }
1913
    }
1914
 
415 dpurdie 1915
    Error ("ResolveLibFile: File not found: $file", "Search Path:", @path)
407 dpurdie 1916
        unless ( @done );
1917
 
1918
    Warning ("ResolveLibFile: Multiple instances of file found. Only first is used", @done)
1919
        if ( $#done > 0 && ! $wildcard && !wantarray );
1920
 
1921
    return wantarray ? @done : $done[0];
1922
}
1923
 
1924
 
1925
#-------------------------------------------------------------------------------
1926
# Function        : AUTOLOAD
1927
#
1928
# Description     : Intercept bad user directives and issue a nice error message
1929
#                   This is a simple routine to report unknown user directives
1930
#                   It does not attempt to distinguish between user errors and
1931
#                   programming errors. It assumes that the program has been
1932
#                   tested. The function simply report filename and line number
1933
#                   of the bad directive.
1934
#
1935
# Inputs          : Original function arguments ( not used )
1936
#
1937
# Returns         : This function does not return
1938
#
1939
our $AUTOLOAD;
1940
sub AUTOLOAD
1941
{
1942
    my $fname = $AUTOLOAD;
1943
    $fname =~ s~^main::~~;
1944
    my ($package, $filename, $line) = caller;
1945
 
1946
    Error ("Directive not known or not allowed in this context: $fname",
1947
           "Directive: $fname( @_ );",
1948
           "File: $filename, Line: $line" );
1949
}
1950
 
1951
 
1952
1;
1953