Subversion Repositories DevTools

Rev

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

Rev Author Line No. Line
1105 dpurdie 1
########################################################################
2
# Copyright (C) 2008 ERG Limited, All rights reserved
3
#
4
# Module name   : Proc_day0fs_script.pl
5
# Module type   : Makefile system
6
# Compiler(s)   : Perl
7
# Environment(s): jats
8
#
9
# Description   :
10
#
11
# Usage:
12
#
13
#......................................................................#
14
 
15
require 5.008_002;
16
 
17
use strict;
18
use warnings;
19
 
20
use Pod::Usage;
21
use Getopt::Long;
22
use File::Path;
23
use File::Copy;
24
 
25
use FindBin;                                    # Determine the current directory
26
use lib "$FindBin::Bin";                        # Allow Modules in current directory
27
 
28
use JatsError;
29
use JatsSystem;
30
use FileUtils;
31
use JatsCopy qw(SetCopyDirDefaults DeleteDir CopyDir CreateDir);
32
use CreateSdImage qw( CreateSdImage );
33
 
34
#
35
#
36
#   Global Variables
37
#
38
my $VERSION = 1.0;
39
our $AUTOLOAD;
40
my $BUILD = 'build';                        # Build subdir
41
my $WORK = "${BUILD}/image";
42
 
43
my $source_specified = 0;                   # Ensure that source is specified
44
my $output_image = 0;                       # Ensure output is specified
45
my $output_sd = 0;
46
 
47
#
48
#   Command line options
49
#
50
my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug
51
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
52
my $opt_vargs;                              # Verbose arg
53
my $opt_help = 0;
54
my $opt_manual = 0;
55
my $opt_clean = 0;
56
my $opt_platform;
57
my $opt_type;
58
my $opt_buildname;
59
my $opt_packagedir;
60
my $opt_interfacedir;
61
my $opt_compilerpath;
62
my $opt_product;
63
my $opt_packagebindir;
64
our $opt_buildroot;
65
my $opt_target;
66
my $opt_version;
67
my $opt_userscript;
68
 
69
#-------------------------------------------------------------------------------
70
# Function        : Mainline Entry Point
71
#
72
# Description     :
73
#
74
# Inputs          :
75
#
76
my $result = GetOptions (
77
                "help+"             => \$opt_help,
78
                "manual"            => \$opt_manual,
79
                "verbose:s"         => \$opt_vargs,
80
                "clean"             => \$opt_clean,
81
                "Platform=s"        => \$opt_platform,
82
                "Type=s"            => \$opt_type,
83
                "BuildName=s"       => \$opt_buildname,
84
                "PackageDir=s"      => \$opt_packagedir,
85
                "InterfaceDir=s"    => \$opt_interfacedir,
86
                "CompilerPath=s"    => \$opt_compilerpath,
87
                "Product=s"         => \$opt_product,
88
                "PackageBinDir=s"   => \$opt_packagebindir,
89
                "BuildRoot=s"       => \$opt_buildroot,
90
                "Target=s"          => \$opt_target,
91
                "BuildVersion=s"    => \$opt_version,
92
                "UserScript=s"      => \$opt_userscript,
93
 
94
    );
95
 
96
#
97
#   Process help and manual options
98
#
99
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
100
pod2usage(-verbose => 1)  if ($opt_help == 2 );
101
pod2usage(-verbose => 2)  if ($opt_manual || ($opt_help > 2));
102
 
103
#
104
#   Configure the error reporting process now that we have the user options
105
#
106
$opt_verbose++ unless ( $opt_vargs eq '@' );
107
ErrorConfig( 'name'    => 'Proc_Day0fs',
108
             'verbose' => $opt_verbose );
109
 
110
#
111
#   Configure the System command to fail on any error
112
#
113
SystemConfig ( ExitOnError => 1 );
114
SetCopyDirDefaults ( 'EmptyDirs' => 1 ,Log => 0 );
115
 
116
#
117
#   Init the FileSystem Uiltity interface
118
#
119
InitFileUtils();
120
 
121
#
122
#   Ensure that we have all required options
123
#
124
Error ("CompilePath not set")       unless ( $opt_compilerpath );
125
Error ("Platform not set")          unless ( $opt_platform );
126
Error ("Type not set")              unless ( $opt_type );
127
Error ("BuildName not set")         unless ( $opt_buildname );
128
Error ("PackageBinDir not set")     unless ( $opt_packagebindir );
129
Error ("InterfaceDir not set")      unless ( $opt_interfacedir );
130
Error ("CompilePath not set")       unless ( $opt_compilerpath );
131
Error ("Product not set")           unless ( $opt_product );
132
Error ("BuildRoot not set")         unless ( $opt_buildroot );
133
Error ("Target not set")            unless ( $opt_target );
134
Error ("User Script not set")       unless ( $opt_userscript );
135
 
136
#
137
#   Calculate a few paths
138
#
139
my $TOOLSUITE = $opt_compilerpath;
140
$TOOLSUITE =~ s~^.*/~~;
141
$TOOLSUITE =~ s~-gcc$~~;
142
 
143
my $CROSSLIBS = $opt_compilerpath;
144
$CROSSLIBS =~ s~/bin/.*$~~;
145
$CROSSLIBS .= "/${TOOLSUITE}/lib";
146
 
147
my $CROSSEXE = $opt_compilerpath;
148
$CROSSEXE =~ s~/bin/.*$~~;
149
$CROSSEXE .= "/${TOOLSUITE}";
150
 
151
 
152
my $CROSS_COMPILE = $opt_compilerpath;
153
$CROSS_COMPILE =~ s~gcc$~~;
154
 
155
my $CROSS_STRIP = ${CROSS_COMPILE} . "strip";
156
 
157
#
158
#   Display variables used
159
#
160
Message    "======================================================================";
161
Message    "Build day0 file system";
162
Message    "           Package: ${opt_buildname}";
163
Message    "           Version: ${opt_version}";
164
Message    "      Building for: ${opt_platform}, $opt_target";
165
Message    "           Product: ${opt_product}";
166
Message    "              Type: ${opt_type}";
167
Message    "            Script: ${opt_userscript}";
168
Verbose    "           Verbose: ${opt_verbose}";
169
Message    "         BuildRoot: ${opt_buildroot}";
170
Verbose    "         BuildRoot: ${opt_buildroot}";
171
Verbose    "      InterfaceDir: ${opt_interfacedir}";
172
Verbose    "     CROSS_COMPILE: ${CROSS_COMPILE}";
173
Verbose    "         CROSSLIBS: ${CROSSLIBS}";
174
Verbose    "       CROSS_STRIP: ${CROSS_STRIP}";
175
Message    "======================================================================";
176
 
177
#
178
#   Perform Clean up
179
#   Invoked during "make clean" or "make clobber"
180
#
181
if ( $opt_clean )
182
{
183
    Message ("Remove build directory: $BUILD");
184
    rmtree( $BUILD );
185
    exit;
186
}
187
 
188
#
189
#   Have setup the basics
190
#   Invoke the user script to drive the remainder of the process
191
#       The script should only contain known directives
192
#       The directives will build up data structures that will be processed
193
#       after the script has been read
194
#
195
#
196
Message ("Process User Script: $opt_userscript");
197
Error ("Board Specfic file Not found: $opt_userscript") unless ( -f $opt_userscript );
198
require $opt_userscript;
199
 
200
#
201
#   The process of requiring the user script
202
#   will have done all the required work
203
#   Perform minor sanity testing
204
#
205
#
206
#   All done
207
#
208
Error ( "No package output specified" )
209
    unless ( $output_image || $output_sd );
210
exit 0;
211
 
212
 
213
################################################################################
214
################################################################################
215
#
216
#   The following functions are intended to be used to manipulate files within
217
#   the output image.
218
#
219
#   These may be used by the board specfic functions.
220
#
221
################################################################################
222
 
223
#-------------------------------------------------------------------------------
224
# Function        : Day0Source
225
#
226
# Description     : Determine the source of the Day0 File System
227
#                   Use of this directive is mandatory
228
#
229
#
230
# Inputs          : Options
231
#                       --Dir=name              - Source dir
232
#                       --Image=name            - Source image
233
#
234
# Returns         : Nothing
235
#
236
sub Day0Source
237
{
238
    my ($opt) = @_;
239
    #
240
    #   Can only use this directive ONCE
241
    #
242
    Error ("Multiple Day0Source directives not allowed")
243
        if ( $source_specified++ );
244
 
245
    #
246
    #   Start with a clean slate
247
    #
248
    DeleteDir ( $WORK );
249
 
250
    #
251
    #   Process options
252
    #
253
    if ( $opt =~ /^--Dir=(.+)/ ) {
254
        #
255
        #   User has specified a directory
256
        #   Copy the entire directory to the work area
257
        #
258
        Message ("Copy in Day0 source directory: $WORK");
259
        CopyDir ( $1, $WORK, 'DeleteFirst' => 1 );
260
 
261
    } elsif ( $opt =~ /^--Image=(.+)/ ) {
262
 
263
        #
264
        #   User has specified an Image
265
        #   Locate the image and extract it into the work area
266
        #
267
        my $name = $1;
268
        Message ("Extract File System Image: $name");
269
 
270
        #
271
        #   File will come from a Package
272
        #   This is where the tool places output files
273
        #
274
        my $fname = Internal::LocateFile ('bin', $name . '.tgz' );
275
        Error ("Cannot locate Day0 source image: $name")
276
            unless $fname;
277
 
278
        #
279
        #   Create a Tar command
280
        #   Assumes the presence of a GNU style tar
281
        #
282
        CreateDir ( $WORK );
283
        System ( 'gtar',
284
                 '--extract',
285
                 '--file',  $fname,
286
                 '--gzip',
287
                 IsVerbose(1) ? ( '--verbose' ) : (),
288
                 '--directory', $WORK,
289
                 );
290
 
291
    } else {
292
        Error ("Unknown Day0Source option: $opt");
293
    }
294
}
295
 
296
 
297
#-------------------------------------------------------------------------------
298
# Function        : Day0Operation
299
#
300
# Description     : Perform one of the special Day0 Operations
301
#
302
# Inputs          : $subfunction            - Sub function to perform
303
#                   @opts                   - Sub function options
304
#
305
# Returns         : Nothing
306
#
307
sub Day0Operation
308
{
309
    Error ("Day0Source must be specified first")
310
        unless ( $source_specified );
311
 
312
    #
313
    #   Perform the Day0Operation
314
    #   These are specialised operations and normally only performed on the
315
    #   the basic skelton.
316
    #
317
    #   Dispatch to the required function
318
    #
319
    my $opt = shift (@_);
320
    if ( my $fref = UNIVERSAL::can ( 'Day0Ops', lc($opt) ) )
321
    {
322
        &$fref( @_ );
323
    }
324
    else
325
    {
326
        Error ("Unknown Day0Operation option: $opt @_");
327
    }
328
}
329
 
330
#-------------------------------------------------------------------------------
331
# Function        : Day0BuildImage
332
#
333
# Description     : Package up the created image as a tar-zip file
334
#                   This allows the Image to be processed again later
335
#
336
# Inputs          : Options
337
#                       --name=Name             - Output Name
338
#
339
# Returns         : 
340
#
341
sub Day0BuildImage
342
{
343
    my $name = 'Day0Image';
344
    Message ("Create File System Image; $name");
345
 
346
    #
347
    #   Indicate that we have created some output
348
    #
349
    Error ("Day0Source must be specified first")
350
        unless ( $source_specified );
351
    $output_image++;
352
 
353
    #
354
    #   Process user options
355
    #
356
    foreach  ( @_ )
357
    {
358
        if ( m~^--Name=(.+)~i ) {
359
            $name = $1;
360
        } else {
361
            Error ("Day0BuildImage: Unknown option: $_");
362
        }
363
    }
364
 
365
    #
366
    #   Place the file in the BIN directory
367
    #   Have no reall good reason
368
    #
369
    $name = $opt_packagebindir . '/' . $name . '.tgz';
370
    CreateDir ( $opt_packagebindir);
371
 
372
    #
373
    #   Create a Tar command
374
    #   Assumes the presence of a GNU style tar
375
    #
376
    System ( 'gtar',
377
             '--create',
378
             '--file',  $name,
379
             '--gzip',
380
             IsVerbose(1) ? ( '--verbose' ) : (),
381
             '--directory', $WORK,
382
             '.' );
383
}
384
 
385
#-------------------------------------------------------------------------------
386
# Function        : Day0BuildSdImage
387
#
388
# Description     : Package up the created image and create an SD memory image
389
#                   This is destructive and can only be done one
390
#
391
# Inputs          : Options
392
#                       --disk_blocks           - Size the output disk
1107 dpurdie 393
#                       --full_image            - Size of Full Image
394
#                       --debug
1105 dpurdie 395
#
396
# Returns         : 
397
#
398
sub Day0BuildSdImage
399
{
400
    my $size = 501248;
1107 dpurdie 401
    my $fullfs = 0;
1105 dpurdie 402
    my $debug;
403
 
404
    #
405
    #   Ensure that some work is being done
406
    #
407
    Error ("Day0Source must be specified first")
408
        unless ( $source_specified );
409
 
410
    Error ("Cannot create multiple SD images")
411
        if ( $output_sd++ );
412
 
413
    #
414
    #   Process user options
415
    #
416
    foreach  ( @_ )
417
    {
418
        if ( m~^--disk-blocks=(\d+)$~i ) {
419
            $size = $1;
1107 dpurdie 420
        } elsif ( m~^--full_image=(\d+)$~i ) {
421
            $fullfs = $1;
1105 dpurdie 422
        } elsif ( m~^--debug~i ) {
423
            $debug = 1;
424
        } else {
425
            Error ("Day0BuildSdImage: Unknown option: $_");
426
        }
427
    }
428
 
429
    #
430
    #   Perform specific processing on the image
431
    #
432
 
433
    #
434
    #   Scan the skeleton and process .LINKS files
435
    #   File links do not store well in version control systems
436
    #   NOTE: .LINKS are a local invention and not a part of e2fsimage like
437
    #         .DEVICES on which they are modelled.
438
    #
439
    Message ("Locate LINKFILES in $WORK");
440
    foreach my $linkfile ( Internal::FindFiles( $WORK, ".LINKS" ))
441
    {
442
        my $BASEDIR = StripFileExt( $linkfile );
443
        $BASEDIR =~ s~^$WORK/~~;
444
        Message "Expand links: $BASEDIR";
445
        open (LF, "<", $linkfile ) || Error ("Cannot open link file: $linkfile" );
446
        while ( <LF> )
447
        {
448
            chomp;
449
            next if ( m~^#~ );
450
            next unless ( $_ );
451
            my ($link, $file) = split;
452
 
453
            Internal::MakeSymLink($file ,"$BASEDIR/$link", '--NoDotDot' );
454
        }
455
        close (LF);
456
        unlink $linkfile;
457
    }
458
 
459
 
460
    #   Update the Shared Library Cache
461
    #
462
    Message ("Create Shared Library Cache");
463
    System ('/sbin/ldconfig', '-r', $WORK );
464
 
465
    #
466
    #   Make every thing executable
467
    #       This is good for directories
468
    #       This is good for all files. Shouldn't be an issue to files in /etc
469
    #
470
    Message ("Mark files as executable");
471
    foreach my $dir ( glob ("$WORK/*") )
472
    {
473
        next if ( $dir =~ m~/etc$~ );
474
        System ('chmod', '-R', 'a+rx', $dir );
475
    }
476
 
477
    foreach my $dir ( glob ("$WORK/etc/*") )
478
    {
479
        next unless ( -d $dir );
480
        System ('chmod', '-R', 'a+rx', $dir );
481
    }
482
 
483
    #
484
    #   Special considertaion
485
    #       /etc/busybox.conf   - Accessible by root
486
    #       /bin/busybox        - setuid
487
    #
488
    System ('chmod', '600',  "$WORK/etc/busybox.conf" );
489
    System ('chmod', '4755', "$WORK/bin/busybox" );
490
 
491
    #
492
    #   Stop here if debugging
493
    #   Don't create the actual image as the process destroys the image
494
    #
495
    Error ("Day0BuildSdImage: Debug Image. SD Image not built")
496
        if ( $debug );
497
 
498
    #
499
    #   Invoke SD build function
500
    #   Held in another package to make this one readable
501
    #
502
    my $name = "${opt_buildname}-${opt_version}-${opt_target}";
1107 dpurdie 503
    CreateSdImage( $opt_packagebindir, $name, $WORK, $BUILD, $size, $fullfs );
1105 dpurdie 504
}
505
 
506
#-------------------------------------------------------------------------------
507
# Function        : AddInitScript
508
#
509
# Description     : Add an Init Script to the target
510
#                   Optionally create start and stop links
511
#
512
#                   Existing links will always be delete
513
#
514
# Inputs          : $script     - Name of the init script
515
#                   $start      - Start Number
516
#                   $stop       - Stop Number
517
#                   Options:
518
#                       --NoCopy    - Don't copy the script, just add links
519
#
520
# Returns         : 
521
#
522
sub AddInitScript
523
{
524
    my ( $script, $start, $stop, @opts ) = @_;
525
 
526
    Error ("Day0Source must be specified first")
527
        unless ( $source_specified );
528
 
529
    Message ("AddInitScript: $script, $start, $stop");
530
 
531
    my $tdir = "/etc/init.d/init.d";
532
    my $base = StripDir($script);
533
 
534
    unless ( grep '^--NoCopy', @opts )
535
    {
536
        ::CopyFile( $script, $tdir );
537
    }
538
 
539
    #
540
    #   Delete any existing links
541
    #
542
    foreach my $file ( glob("$WORK/etc/init.d/*$base") )
543
    {
544
        next unless ( $file =~ m~/[KS][\d]+${base}~ );
545
        unlink $file;
546
    }
547
 
548
    my $link;
549
    if ( $start )
550
    {
551
        $link = sprintf ("/etc/init.d/S%2.2d%s", $start, $base );
552
        Internal::MakeSymLink( "$tdir/$base", $link);
553
    }
554
 
555
    if ( $stop )
556
    {
557
        $link = sprintf ("/etc/init.d/K%2.2d%s", $stop, $base );
558
        Internal::MakeSymLink( "$tdir/$base", $link);
559
    }
560
}
561
 
562
#-------------------------------------------------------------------------------
563
# Function        : EchoFile
564
#
565
# Description     : Echo simple text to a file
566
#
567
# Inputs          : $file   - Within the output workspace
568
#                   $text
569
#
570
# Returns         : 
571
#
572
sub EchoFile
573
{
574
    my ($file, $text) = @_;
575
    Error ("Day0Source must be specified first")
576
        unless ( $source_specified );
577
 
578
    $file = $WORK . '/' . $file;
579
    $file =~ s~//~/~;
580
 
581
    unlink $file;
582
    open (DT, ">", $file ) || Error ("Cannot create $file");
583
    print DT  $text || Error ("Cannot print to $file");
584
    close DT;
585
}
586
 
587
#-------------------------------------------------------------------------------
588
# Function        : CopyPkgDir
589
#
590
# Description     : Copy a directory to a target dir
591
#                   Source directory is within a 'package'
592
#                   Does not delete the target directory, but will add files
593
#
594
#                   Currently does not support
595
#                       Recursion
596
#                       Flattening
597
#
598
#
599
# Inputs          : $src_dir    - Within a package
600
#                   $dst_dir    - Within the output workspace
601
#
602
#                   Options:
603
#                       --FilterIn=Filter           Simple filter
604
#                       --FilterOut=Filter          Simple filter
605
#
606
# Returns         :
607
#
608
sub CopyPkgDir
609
{
610
    my @filter_out;
611
    my @filter_in;
612
    my @args;
613
 
614
    Error ("Day0Source must be specified first")
615
        unless ( $source_specified );
616
 
617
    #
618
    #   Process options
619
    #
620
    foreach  ( @_ )
621
    {
622
        if ( m/^--FilterIn=(.+)/ ) {
623
            push @filter_in, $1;
624
 
625
        } elsif ( m/^--FilterOut=(.+)/ ) {
626
            push @filter_out, $1;
627
 
628
        } elsif ( m/^-/ ) {
629
            Error("CopyPkgDir: Unknown option: $_");
630
 
631
        } else {
632
            push @args, $_;
633
        }
634
    }
635
    my ($src_dir, $dst_dir) = @args;
636
    #
637
    #   Calculate the destination path
638
    #
639
    $dst_dir = $WORK . '/' . $dst_dir;
640
    $dst_dir =~ s~//~/~;
641
 
642
    #
643
    #   Validate source dir
644
    #
645
    my $full_src_dir = "$opt_interfacedir/$src_dir";
646
    Error("CopyPkgDir: Source dir not found: $src_dir") unless ( -d $full_src_dir );
647
 
648
    #
649
    #   Copy as required
650
    #
651
    CopyDir ( $full_src_dir, $dst_dir,
652
                    'Flatten' => 1,
653
                    'NoSubDirs' => 1,
654
                    'Ignore' =>  \@filter_out,
655
                    'Match' => \@filter_in,
656
                    );
657
}
658
 
659
#-------------------------------------------------------------------------------
660
# Function        : CopyPackage
661
#
662
# Description     : Copy in files from a package located in the interface
663
#                   directory.
664
#
665
#                   The source directory may be:
666
#                       pkg/<platform>
667
#                       pkg/<product>
668
#                       pkg/<target>
669
#
670
# Inputs          : $section    - Section to search
671
#                   $file       - Source Path within a package
672
#                   @llist      - list of softlinks
673
#                                 Abs or Relative to destination dir
674
#
675
#                   Embedded Options:
676
#                               --Dest=Dir (Default is taken from $file)
677
#                               --LinkFile (Append to .LINKS file)
678
#                               --Rename=Name
679
#
680
# Returns         :  Path to the target file
681
#
682
sub CopyPackage
683
{
684
    my $dest;
685
    my $isa_linkfile;
686
    my @args;
687
    my $dfile;
688
    my @options;
689
 
690
    Error ("Day0Source must be specified first")
691
        unless ( $source_specified );
692
 
693
    #
694
    #   Process and Remove options
695
    #
696
    foreach  ( @_ )
697
    {
698
        if ( m/^--Dest=(.*)/ ) {
699
            $dest = $1 . '/xxx';
700
 
701
        } elsif ( m/^--LinkFile/ ) {
702
            $isa_linkfile = 1;
703
 
704
        } elsif ( m/^--Rename=(.+)/ ) {
705
            push @options, $_;
706
 
707
        } elsif ( m/^--/ ) {
708
            Error ("CopyPackage: Unknown option: $_");
709
 
710
        } else {
711
            push @args, $_;
712
 
713
        }
714
    }
715
 
716
    my ($section, $file, @llist) = @args;
717
 
718
    #
719
    #   Default destination is the same as the source
720
    #
721
    $dest = $file unless ( $dest );
722
    my $dest_dir = StripFileExt($dest);
723
 
724
    my $tfile = Internal::LocateFile($section, $file);
725
    Error ("CopyPackage: File not found: $file") unless $tfile;
726
 
727
    #
728
    #   LinkFiles are special
729
    #   They get concatenated to any existing Link File
730
    #
731
    if ( $isa_linkfile )
732
    {
733
        CatFile ( $tfile, "$dest_dir/.LINKS" );
734
    }
735
    else
736
    {
737
        $dfile = CopyFile ($tfile, $dest_dir, @options );
738
        foreach my $lname ( @llist )
739
        {
740
            $lname = $dest_dir . '/' . $lname unless ( $lname =~ m ~^/~ );
741
            my $dest_file = $dest_dir . '/' . StripDir($dfile);
742
            Internal::MakeSymLink($dest_file ,$lname);
743
        }
744
    }
745
 
746
    return $dfile;
747
}
748
 
749
#-------------------------------------------------------------------------------
750
# Function        : CatFile
751
#
752
# Description     : Copy a file to the end of a file
753
#
754
# Inputs          : $src
755
#                   $dst    - Within the output workspace
756
#
757
# Returns         :
758
#
759
sub CatFile
760
{
761
    my ($src, $dst) = @_;
762
    $dst = $WORK . '/' . $dst;
763
    $dst =~ s~//~/~;
764
    Verbose ("CatFile: $src, $dst");
765
 
766
    Error ("Day0Source must be specified first")
767
        unless ( $source_specified );
768
 
769
    open (SF, '<', $src)  || Error ("CatFile: Cannot open $src");
770
    open (DF, '>>', $dst) || Error ("CatFile: Cannot create:$dst");
771
    while ( <SF> )
772
    {
773
        print DF $_;
774
    }
775
    close (SF);
776
    close (DF);
777
}
778
 
779
 
780
#-------------------------------------------------------------------------------
781
# Function        : CopyFile
782
#
783
# Description     : Copy a file to a target dir
784
#
785
# Inputs          : $src
786
#                   $dst_dir    - Within the output workspace
787
#                   Options     - Optional flags
788
#                                 --Symlink
789
#                                   Copies symlink, not symlink target
790
#                                 --Rename=xxx
791
#                                   Renames file
792
#
793
# Returns         : Full path to destination file
794
#
795
sub CopyFile
796
{
797
    my ($src, $dst_dir, @opts ) = @_;
798
    my $tfile = StripDir($src);
799
    my %opts;
800
 
801
    Error ("Day0Source must be specified first")
802
        unless ( $source_specified );
803
 
804
    #
805
    #   Extract options
806
    #
807
    foreach  ( @opts )
808
    {
809
        if ( m/^--Symlink/ ) {
810
            $opts{DuplicateLinks} = 1;
811
 
812
        } elsif ( m/^--Rename=(.+)/ ) {
813
            $tfile = $1;
814
 
815
        } else {
816
            Error("CopyFile: Unknown option: $_");
817
        }
818
    }
819
 
820
    #
821
    #   Calculate the destination path
822
    #
823
    $dst_dir = $WORK . '/' . $dst_dir;
824
    $dst_dir =~ s~//~/~;
825
 
826
    #
827
    #   Determine the full name of the target
828
    #
829
    my $dst_file = "$dst_dir/$tfile";
830
 
831
    Verbose ("CopyFile: $src, $dst_dir");
832
    return JatsCopy::CopyFile( $src, $dst_file, \%opts );
833
}
834
 
835
#-------------------------------------------------------------------------------
836
# Function        : AUTOLOAD
837
#
838
# Description     : Intercept bad user directives and issue a nice error message
839
#                   This is a simple routine to report unknown user directives
840
#                   It does not attempt to distinguish between user errors and
841
#                   programming errors. It assumes that the program has been
842
#                   tested. The function simply report filename and line number
843
#                   of the bad directive.
844
#
845
# Inputs          : Original function arguments ( not used )
846
#
847
# Returns         : This function does not return
848
#
849
sub AUTOLOAD
850
{
851
    my $fname = $::AUTOLOAD;
852
    $fname =~ s~^\w+::~~;
853
    my ($package, $filename, $line) = caller;
854
 
855
    Error ("Directive not known or not allowed in this context: $fname",
856
           "Directive: $fname( @_ );",
857
           "File: $filename, Line: $line" );
858
}
859
 
860
 
861
#-------------------------------------------------------------------------------
862
# Function        : FirstBoot
863
#
864
# Description     : Add a file to the first boot section
865
#                   Assumes that the firstboot directory is /var/afc/firstboot
866
#                   This is the default
867
#
868
# Inputs          : All options
869
#                       --Debian=xxx[,opts] - Locate debian package
870
#                                             Sub opts are:
871
#                                               --Arch=xxx
872
#                                               --Product=xxx
873
#                                               --Debug
874
#                                               --Prod
875
#                       --File=yyy          - Locate a files
876
#                       --Level=nn          - Level to run (default=50)
877
#
878
# Returns         : 
879
#
880
sub FirstBoot
881
{
882
    my  $file;
883
    my  $level = 50;
884
 
885
    Error ("Day0Source must be specified first")
886
        unless ( $source_specified );
887
 
888
    #
889
    #   Collect user items
890
    #
891
    foreach ( @_ )
892
    {
893
        if ( m~^--Debian=(.+)~ ) {
894
            Error ("FirstBoot: Multiple source files not supported in one directive: $_") if $file;
895
            $file = Internal::LocateDebianFile($1, $opt_target, $opt_product);
896
 
897
        } elsif ( m~^--File=(.+)~ ) {
898
            Error ("FirstBoot: Multiple source files not supported in one directive: $_") if $file;
899
            $file = $1;
900
 
901
        } elsif ( m~^--Level=(\d+)~ ) {
902
            $level = $1;
903
            Error ("FirstBoot: Invalid Level: $_") if ($level < 0 || $level > 99);
904
 
905
        } else {
906
            Error ("FirstBoot: Unknown option or argument: $_");
907
        }
908
    }
909
 
910
    #
911
    #   Insert the required file
912
    #       Prepend name with a two digit level
913
    #
914
    my $fname = sprintf ('%2.2d.%s', $level, StripDir($file)  );
915
    Message ("FirstBoot: $fname");
916
 
917
    CopyFile ( $file, '/var/afc/firstboot', "--Rename=$fname" );
918
}
919
 
920
################################################################################
921
################################################################################
922
#   
923
#   Package to contain DayOp opereration
924
#
925
package Day0Ops;
926
 
927
use strict;
928
use warnings;
929
 
930
 
931
use JatsError;
932
use JatsSystem;
933
use JatsCopy qw(SetCopyDirDefaults DeleteDir CopyDir CreateDir);
934
 
935
#-------------------------------------------------------------------------------
936
# Function        : hostname
937
#
938
# Description     : Insert hostname information into the target
939
#                       Insert /etc/devicetype
940
#                       Insert into hostname too
941
#
942
#
943
# Inputs          : 
944
#
945
# Returns         : 
946
#
947
sub hostname
948
{
949
    Message ("Insert Hostname an Devicename: ${opt_product}");
950
    ::EchoFile ( "/etc/devicetype", $opt_product );
951
    ::EchoFile ( "/etc/hostname", $opt_product );
952
    ::EchoFile ( "/etc/day0-version", "$opt_buildname $opt_version $opt_product $opt_platform $opt_target" );
953
}
954
 
955
#-------------------------------------------------------------------------------
956
# Function        : setupbusybox
957
#
958
# Description     : Insert busybox into the skeleton
959
#                   Locate busybox and associated links file
960
#
961
# Inputs          : None
962
#
963
# Returns         : Nothing
964
#
965
sub setupbusybox
966
{
967
    #
968
    #   Insert busybox into the skeleton
969
    #   Locate busybox and associated links file
970
    #
971
    Message ("Copy in busybox");
972
    my $bbfile  = ::CopyPackage ('bin', 'busybox',       "--Dest=bin" );
973
    my $bblinks = ::CopyPackage ('bin', 'busybox.links', "--Dest=bin" );
974
 
975
    #
976
    #   Expand the busybox links
977
    #   Use soft links. Expect that they will be easier to update in the field
978
    #   Keep the .links file on the target.
979
    #
980
    Message "Expand busybox links";
981
    open ( BBLINK, "<", $bblinks ) || Error ("Cannot open BusyBox Links file");
982
    while ( <BBLINK> )
983
    {
984
        s~\s+~~;
985
        Internal::MakeSymLink ("/bin/busybox", $_, '--NoDotDot'  );
986
    }
987
    close BBLINK;
988
 
989
    #
990
    #   May want to convert busybox.links into a .LINKS file and process
991
    #   it when we instantiate the file system
992
    #
993
 
994
}
995
 
996
#-------------------------------------------------------------------------------
997
# Function        : upgrade
998
#
999
# Description     : Insert day0 upgrade components
1000
#
1001
# Inputs          : None
1002
#
1003
# Returns         : Nothing
1004
#
1005
sub upgrade
1006
{
1007
    Message ("Copy in day0 upgrade");
1008
    my $DAY0BIN="/afc/day-zero/bin";       #/day-zero
1009
 
1010
    ::CopyPackage ('bin',     "--Dest=$DAY0BIN", 'udp_broadcast' );
1011
    ::CopyPackage ('bin',     "--Dest=$DAY0BIN", 'udp_listen' );
1012
    ::CopyPackage ('scripts', "--Dest=$DAY0BIN", 'day-zero.conf' );
1013
    ::CopyPackage ('scripts', "--Dest=$DAY0BIN", 'day-zero.sh', 'day-zero' );
1014
 
1015
    #
1016
    #   Start Day-Zero Service
1017
    #   The service script is a part of the skeleton
1018
    #
1019
    ::AddInitScript ("day-zero"   , 95, 100-95, "--NoCopy" );
1020
}
1021
 
1022
#-------------------------------------------------------------------------------
1023
# Function        : dams
1024
#
1025
# Description     : Insert DAMS
1026
#                   Only sutable for single exe versions
1027
#
1028
# Inputs          : 
1029
#
1030
# Returns         : 
1031
#
1032
sub dams
1033
{
1034
    Message ("Copy in DAMS");
1035
    ::CopyPackage ('bin',     "--Dest=/afc/dams/bin", 'dams' );
1036
}
1037
 
1038
#-------------------------------------------------------------------------------
1039
# Function        : wirelesstools
1040
#
1041
# Description     : Insert wireless tools
1042
#                   This is a multi-call binary
1043
# Inputs          :
1044
#
1045
# Returns         : 
1046
#
1047
sub wirelesstools
1048
{
1049
    Message ("Copy in wireless tools");
1050
 
1051
    ::CopyPackage ('bin', 'ifrename'  , "--Dest=/sbin");
1052
    ::CopyPackage ('bin', 'iwconfig'  , "--Dest=/sbin");
1053
    ::CopyPackage ('bin', 'iwevent'   , "--Dest=/sbin");
1054
    ::CopyPackage ('bin', 'iwgetid'   , "--Dest=/sbin");
1055
    ::CopyPackage ('bin', 'iwlist'    , "--Dest=/sbin");
1056
    ::CopyPackage ('bin', 'iwpriv'    , "--Dest=/sbin");
1057
    ::CopyPackage ('bin', 'iwspy'     , "--Dest=/sbin");
1058
}
1059
 
1060
#-------------------------------------------------------------------------------
1061
# Function        : zd1211
1062
#
1063
# Description     : Copy in the zd1211 support files
1064
#
1065
# Inputs          : 
1066
#
1067
# Returns         : 
1068
#
1069
 
1070
sub zd1211
1071
{
1072
    Message ("Copy in zd1211 firmware");
1073
    ::CopyPkgDir  ( 'pkg/zd1211', '/lib/firmware/zd1211', '--FilterOut=READ*' );
1074
 
1075
    #
1076
    #   Install the start up script
1077
    #   This will be delivered by the kernel package
1078
    #
1079
    ::AddInitScript ("$opt_interfacedir/etc/zd1211", 41, 100-41 );
1080
}
1081
 
1082
#-------------------------------------------------------------------------------
1083
# Function        : kernelmodules
1084
#
1085
# Description     : Insert Kernel Modules
1086
#                   Note: The EMU flavour does not have any kernel modules (yet)
1087
#                          Allow for no files to be present or copied
1088
#
1089
# Inputs          : 
1090
#
1091
# Returns         : 
1092
#
1093
sub kernelmodules
1094
{
1095
    Message ("Copy in Kernel Modules");
1096
    CopyDir ( "${opt_interfacedir}/bin", "$WORK/lib/modules",
1097
                    'Flatten' => 1,
1098
                    'Match' => [ '*.ko' ],
1099
                    'Log' => 1,
1100
                     );
1101
}
1102
 
1103
#-------------------------------------------------------------------------------
1104
# Function        : e2fsprogs
1105
#
1106
# Description     : Insert e2fsprogs
1107
#                   Busybox 1.4.2 and later does not provide these utilities
1108
#                   so they have been built up.
1109
#
1110
# Inputs          :
1111
#
1112
# Returns         : 
1113
#
1114
sub e2fsprogs
1115
{
1116
    #
1117
    #   Only install the files that are needed
1118
    #
1119
    Message        ("Copy in e2fsprogs");
1120
    ::CopyPackage    ('pkg', "/etc/mke2fs.conf");
1121
    ::CopyPackage    ('pkg', "/sbin/fsck");
1122
    ::CopyPackage    ('pkg', "/sbin/tune2fs"   ,"e2label"   ,"findfs");
1123
    ::CopyPackage    ('pkg', "/sbin/mke2fs"    ,"mkfs.ext2" ,"mkfs.ext3");
1124
    ::CopyPackage    ('pkg', "/sbin/e2fsck"    ,"fsck.ext2" ,"fsck.ext3");
1125
    #::CopyPackage   ('pkg', "/sbin/badblocks");
1126
    #::CopyPackage   ('pkg', "/sbin/blkid");
1127
    #::CopyPackage   ('pkg', "/sbin/debugfs");
1128
    #::CopyPackage   ('pkg', "/sbin/dumpe2fs");
1129
    #::CopyPackage   ('pkg', "/sbin/logsave");
1130
    ::CopyPackage    ('pkg', "/sbin/resize2fs");
1131
}
1132
 
1133
#-------------------------------------------------------------------------------
1134
# Function        : compilerruntime
1135
#
1136
# Description     : Copy in the runtime shared libraries provided by the compiler
1137
#                       Many libraries are also symlinked
1138
#                       Need to ensure that the linkis copied
1139
#
1140
#                       Strip many ( but not all) of the libaries
1141
#                       Some are special
1142
# Inputs          : 
1143
#
1144
# Returns         : 
1145
#
1146
sub compilerruntime
1147
{
1148
    Message ("Copy in Compiler Shared Libaries");
1149
    my @slibs;
1150
    JatsCopy::CopyDir( $CROSSLIBS, "$WORK/lib",
1151
                            'Flatten' => 1,
1152
                            'NoSubDirs' => 1,
1153
                            'DuplicateLinks' => 1,
1154
                            'Match' => [ '*.so', '*.so.*[0-9]' ],
1155
                            'FileList' => \@slibs,
1156
                            );
1157
 
1158
 
1159
    foreach my $file (@slibs)
1160
    {
1161
        next if ( -d $file );
1162
        next if ( -l $file );
1163
        next if ( $file =~ m~libc.so$~ );
1164
        next if ( $file =~ m~libpthread.so$~ );
1165
        next if ( $file =~ m~libthread_db.*\.so~ );         # Needs symbols
1166
        Verbose ("Stripping: $file");
1167
        System ($CROSS_STRIP, $file );
1168
    }
1169
 
1170
    #
1171
    #   Copy in ldconfig
1172
    #
1173
    Message ("Copy in the ldconfig utility");
1174
    ::CopyFile ( "${CROSSEXE}/sbin/ldconfig", "/sbin" );
1175
}
1176
 
1177
#-------------------------------------------------------------------------------
1178
# Function        : grub
1179
#
1180
# Description     : Install grub related files, if requested by the user
1181
#
1182
# Inputs          : Options
1183
#                       --Menu=file             - Found locally
1184
#                       --Kernel=file           - Found in Bin
1185
#
1186
# Returns         : 
1187
#
1188
sub grub
1189
{
1190
    my $menu;
1191
    my $kernel;
1192
 
1193
    Message ("Installing Grub");
1194
 
1195
    #
1196
    #   Extract options
1197
    #
1198
    foreach ( @_ )
1199
    {
1200
        if ( m~^--Menu=(.+)~ ) {
1201
            $menu = $1;
1202
        } elsif ( m~^--Kernel=(.+)~ ) {
1203
            $kernel = $1;
1204
        } else {
1205
            Error ("Day0 Grub: Unknown option: $_");
1206
        }
1207
    }
1208
 
1209
    Error ("Day0 Grub: No Menu file specified") unless ( $menu );
1210
    Error ("Day0 Grub: No Kernel file specified") unless ( $kernel );
1211
 
1212
    ::CopyPackage ( 'pkg', '/boot/grub/grub');                     # Not really needed
1213
    ::CopyPackage ( 'pkg', '/boot/grub/stage1');                   # These are ..
1214
    ::CopyPackage ( 'pkg', '/boot/grub/stage2');
1215
    ::CopyPackage ( 'pkg', '/boot/grub/e2fs_stage1_5');
1216
 
1217
    #
1218
    #   Copy in the user specified boot related files
1219
    #
1220
    ::CopyFile   ( $menu,  '/boot/grub' );
1221
    ::CopyPackage ('bin', $kernel, '--Dest=/boot');
1222
 
1223
}
1224
 
1225
 
1226
 
1227
################################################################################
1228
################################################################################
1229
#
1230
#   Package to contain Internal functions
1231
#   Functions placed here are not available to the user in the user scripts
1232
#   They have been placed here simply to hide them from the user
1233
#
1234
#
1235
package Internal;
1236
 
1237
use strict;
1238
use warnings;
1239
 
1240
use File::Find;
1241
use JatsError;
1242
use FileUtils;
1243
 
1244
#-------------------------------------------------------------------------------
1245
# Function        : MakeSymLink
1246
#
1247
# Description     : Create a symlink - with error detection
1248
#
1249
# Inputs          : old_file    - Link Target
1250
#                                 Path to the link target
1251
#                                 If an ABS path is provided, the routine will
1252
#                                 attempt to create a relative link.
1253
#                   new_file    - Relative to the output work space
1254
#                                 Path to where the 'link' file will be created
1255
#                   Options     - Must be last
1256
#                                 --NoClean         - Don't play with links
1257
#                                 --NoDotDot        - Don't create symlinks with ..
1258
#
1259
# Returns         : Nothing
1260
#
1261
sub MakeSymLink
1262
{
1263
    my $no_clean;
1264
    my $no_dot;
1265
    my @args;
1266
 
1267
    #
1268
    #   Extract options
1269
    #
1270
    foreach ( @_ )
1271
    {
1272
        if ( m/^--NoClean/i ) {
1273
            $no_clean = 1;
1274
 
1275
        } elsif ( m/^--NoDotDot/i ) {
1276
            $no_dot = 1;
1277
 
1278
        } elsif ( m/^--/ ) {
1279
            Error ("MakeSymLink: Unknown option: $_");
1280
 
1281
        } else {
1282
            push @args, $_;
1283
        }
1284
    }
1285
 
1286
    my ($old_file, $new_file) = @args;
1287
 
1288
    my $tfile = $WORK . '/' . $new_file;
1289
    $tfile =~ s~//~/~;
1290
    Verbose ("Symlink $old_file -> $new_file" );
1291
 
1292
    #
1293
    #   Create the directory in which the link will be placed
1294
    #   Remove any existing file of the same name
1295
    #
1296
    my $dir = StripFileExt( $tfile );
1297
    mkdir $dir unless -d $dir;
1298
    unlink $tfile;
1299
 
1300
    #
1301
    #   Determine a good name of the link
1302
    #   Convert to a relative link in an attempt to prune them
1303
    #
1304
    my $sfile = $old_file;
1305
    unless ( $no_clean )
1306
    {
1307
        $sfile = CalcRelPath( StripFileExt( $new_file ), $old_file );
1308
        if ( $no_dot && $sfile =~ m~^../~ )
1309
        {
1310
            $sfile = $old_file;
1311
        }
1312
    }
1313
 
1314
    my $result = symlink $sfile, $tfile;
1315
    Error ("Cannot create symlink. $old_file -> $new_file") unless ( $result );
1316
}
1317
 
1318
#-------------------------------------------------------------------------------
1319
# Function        : LocateFile
1320
#
1321
# Description     : Locate a file within the interface directory
1322
#                   These files will have come from an external package
1323
#
1324
# Inputs          : $section            One of: bin, lib, pkg, scripts
1325
#                                       Will be translated into a suitable path
1326
#                   $file               Path to file
1327
#
1328
# Returns         : Full path to the file
1329
#                   Will return 'undef' if not found
1330
#                   The user must generate the error
1331
#
1332
sub LocateFile
1333
{
1334
    my ($section, $file) = @_;
1335
    my $base = "$opt_interfacedir/$section";
1336
 
1337
    unless ( -d $base )
1338
    {
1339
        Warning("LocateFile: Section not found: $section");
1340
        return undef;
1341
    }
1342
 
1343
    my @done;
1344
    my @parts = GetBuildParts ($opt_interfacedir, $opt_platform );
1345
    push @parts, '';
1346
    foreach my $type ( $opt_type, '' )
1347
    {
1348
        foreach my $subdir ( @parts )
1349
        {
1350
            my $sfile = "$base/$subdir$type/$file";
1351
            $sfile =~ s~//~/~g;
1352
            Verbose2("LocateFile: $sfile");
1353
            if ( -f $sfile )
1354
            {
1355
                unless ( @done )
1356
                {
1357
                    push @done, $sfile;
1358
                }
1359
            }
1360
        }
1361
    }
1362
 
1363
    if ( $#done > 0)
1364
    {
1365
        Warning ("LocateFile: Multiple instances of file found. Only first is used", @done);
1366
    }
1367
    return $done[0];
1368
}
1369
 
1370
#-------------------------------------------------------------------------------
1371
# Function        : LocateDebianFile
1372
#
1373
# Description     : Locate a debian file
1374
#                   Internal Function
1375
#
1376
#                   Scan packages for the Debian package specified
1377
#                   The user provides the base name of the package
1378
#                   A Debian Package name has several fields
1379
#                   These are:
1380
#                       1) Base Name - Provided by the user
1381
#                       2) Version - Version will be wildcarded
1382
#                       3) Architecture - Wildcarded. Uses bin/arch directory
1383
#                   
1384
#                   Expect to find Debian Packages in the bin/PLATFORM subdir
1385
#
1386
# Inputs          : Debian base name, complete with suboptions
1387
#
1388
# Returns         : Full path of the file
1389
#
1390
sub LocateDebianFile
1391
{
1392
    my ($arg, $arch, $product) = @_;
1393
    Verbose("LocateDebianFile: Processing: $arg");
1394
 
1395
    my @type = qw( P D );
1396
    my %debian_file_path;
1397
 
1398
    #
1399
    #   Extract sub-options
1400
    #       --Prod[uction]
1401
    #       --Debug
1402
    #       --Arch[itecture]=yyy
1403
    #
1404
    my ($base_name, @opts) = split( ',', $arg );
1405
    foreach ( @opts )
1406
    {
1407
        if ( m/^--Arch(.*)=(.+)/ ) {
1408
            $arch=$2;
1409
        } elsif ( m/^--Product=(.+)/ ) {
1410
            $product=$1;
1411
        } elsif ( m/^--Prod/ ) {
1412
            @type = 'P';
1413
        } elsif ( m/^--Debug/ ) {
1414
            @type = 'D';
1415
        }
1416
    }
1417
 
1418
    #
1419
    #   Create a list of products
1420
    #   ie: PRODUCT_ARCH
1421
    #
1422
    my @products;
1423
    push @products, $product . '_' . $arch if ( $product );
1424
    push @products, $arch;
1425
 
1426
    #
1427
    #   Scan all packages for the specified debian package
1428
    #
1429
    foreach my $package_dir ( $opt_interfacedir )
1430
    {
1431
        foreach my $type ( @type )
1432
        {
1433
            foreach my $prd ( @products )
1434
            {
1435
                foreach my $joiner ( qw(/ .) )
1436
                {
1437
                    my $dir = "$package_dir/bin$joiner$prd$type";
1438
                    Verbose("LocateDebianFile: Search in $dir");
1439
                    next unless ( -d $dir );
1440
                    my @files = glob ( "$dir/${base_name}_*.deb" );
1441
                    next unless ( @files );
1442
                    push @{$debian_file_path{$type}}, @files;
1443
                }
1444
            }
1445
        }
1446
    }
1447
 
1448
    Error ("Required Debain package not found: $base_name",) unless %debian_file_path;
1449
 
1450
    #
1451
    #   Select 'preferred' type of file
1452
    #   If we are doing a debug build, then prefer debug package
1453
    #   If not available then use any available
1454
    #
1455
    my @debian_file_path = @{$debian_file_path{$opt_type}};
1456
    if ( ! @debian_file_path )
1457
    {
1458
        foreach ( keys %debian_file_path )
1459
        {
1460
            push @debian_file_path,@{$debian_file_path{$_}};
1461
        }
1462
    }
1463
 
1464
    Error ("Multiple matching Debian Packages located", @debian_file_path)
1465
        if ( $#debian_file_path > 0 );
1466
 
1467
    return $debian_file_path[0];
1468
}
1469
 
1470
#-------------------------------------------------------------------------------
1471
# Function        : CalcRelPath
1472
#
1473
# Description     : Return the relative path to the current working directory
1474
#                   as provided in $Cwd
1475
#
1476
# Inputs          : $Cwd - Base dir
1477
#                   $base - Path to convert
1478
#
1479
# Returns         : Relative path from the $Cwd
1480
#
1481
sub CalcRelPath
1482
{
1483
    my ($Cwd, $base) = @_;
1484
 
1485
    my @base = split ('/', $base );
1486
    my @here = split ('/', $Cwd );
1487
    my $result;
1488
 
1489
    Debug("CalcRelPath: Source: $base");
1490
 
1491
    return $base unless ( $base =~ m~^/~ );
1492
 
1493
    #
1494
    #   Remove common bits from the head of both lists
1495
    #
1496
    while ( $#base >= 0 && $#here >= 0 && $base[0] eq $here[0] )
1497
    {
1498
        shift @base;
1499
        shift @here;
1500
    }
1501
 
1502
    #
1503
    #   Need to go up some directories from here and then down into base
1504
    #
1505
    $result = '../' x ($#here + 1);
1506
    $result .= join ( '/', @base);
1507
    $result = '.' unless ( $result );
1508
    $result =~ s~//~/~g;
1509
    $result =~ s~/$~~;
1510
 
1511
    Debug("CalcRelPath: Result: $result");
1512
    return $result;
1513
}
1514
 
1515
#-------------------------------------------------------------------------------
1516
# Function        : GetBuildParts
1517
#
1518
# Description     : Determine the 'parts' of the build for the current platform
1519
#                   This is complex information. It is held within the build.cfg
1520
#                   file.
1521
#
1522
# Inputs          : $interface_dir          - Path to the interface dir
1523
#                   $platform               - Platform to process
1524
#
1525
# Returns         : An array of platform parts
1526
#
1527
 
1528
#
1529
#   The following varaibles are "read" in from the build.cfg file
1530
#   In order to access them we need to declare them
1531
#
1532
our %ScmBuildPkgRules;
1533
our %BUILDPLATFORM_PARTS;
1534
 
1535
sub GetBuildParts
1536
{
1537
    my ($interface_dir, $platform) = @_;
1538
 
1539
    #
1540
    #   Tthe build.cfg file is within the interface directory
1541
    #
1542
    my $cfgfile = "$interface_dir/build.cfg";
1543
    Error ("Cannot find file: $cfgfile" ) unless ( -f $cfgfile );
1544
 
1545
    #
1546
    #   Include the build.cfg data
1547
    #
1548
    require ( $cfgfile );
1549
 
1550
    #
1551
    #   Extract the platform parts
1552
    #
1553
    if ( exists  $BUILDPLATFORM_PARTS{$platform})
1554
    {
1555
        return @{$BUILDPLATFORM_PARTS{$platform}};
1556
    }
1557
    else
1558
    {
1559
        Error ("Platform not found in build.cfg: $platform");
1560
    }
1561
}
1562
 
1563
#-------------------------------------------------------------------------------
1564
# Function        : FindFiles
1565
#
1566
# Description     : Locate files within a given dir tree
1567
#
1568
# Inputs          : $root           - Base of the search
1569
#                   $match          - Re to match
1570
#
1571
# Returns         : A list of files that match
1572
#
1573
my @FIND_LIST;
1574
my $FIND_NAME;
1575
 
1576
sub FindFiles
1577
{
1578
    my ($root, $match ) = @_;
1579
    Verbose2("FindFiles: Root: $root, Match: $match");
1580
 
1581
    #
1582
    #   Becareful of closure, Must use globals
1583
    #
1584
    @FIND_LIST = ();
1585
    $FIND_NAME = $match;
1586
    File::Find::find( \&find_files, $root);
1587
 
1588
    #
1589
    #   Find callback program
1590
    #
1591
    sub find_files
1592
    {
1593
        my $item =  $File::Find::name;
1594
        return if ( -d $_ );
1595
        return unless ( $_ =~ m~$FIND_NAME~ );
1596
        push @FIND_LIST, $item;
1597
    }
1598
    return @FIND_LIST;
1599
}
1600
 
1601
 
1602