| 5485 |
dpurdie |
1 |
########################################################################
|
|
|
2 |
# Copyright (c) VIX TECHNOLOGY (AUST) LTD
|
|
|
3 |
#
|
|
|
4 |
# Module name : create_dpkg2.pl
|
|
|
5 |
# Module type : Makefile system
|
|
|
6 |
# Compiler(s) : Perl
|
|
|
7 |
# Environment(s): jats
|
|
|
8 |
#
|
|
|
9 |
# Description : This script is used to create a dpkg_archive.
|
|
|
10 |
# Based on create_dpkg with following changes
|
|
|
11 |
# * Generate file list with MD5 information
|
|
|
12 |
# * Create a compressed file image.
|
|
|
13 |
# Uses simple tar for best cross machine compatability
|
|
|
14 |
# * Copy the compressed file image
|
|
|
15 |
#
|
|
|
16 |
# Intended use.
|
|
|
17 |
# Used in the build system to address two issues:
|
|
|
18 |
# 1) Slow speed in copying lots of files from the build machine to the
|
|
|
19 |
# package server.
|
|
|
20 |
# 2) Need for cross platform file lock in order to prevent
|
|
|
21 |
# copy collisions.
|
|
|
22 |
#
|
|
|
23 |
# Usage: : See POD
|
|
|
24 |
#
|
|
|
25 |
#......................................................................#
|
|
|
26 |
|
|
|
27 |
|
|
|
28 |
require 5.008_002;
|
|
|
29 |
|
|
|
30 |
# Include Standard Perl Functions
|
|
|
31 |
#
|
|
|
32 |
use strict;
|
|
|
33 |
use warnings;
|
|
|
34 |
use Cwd;
|
|
|
35 |
use Getopt::Long;
|
|
|
36 |
use File::Basename;
|
|
|
37 |
use File::Find;
|
|
|
38 |
use File::Path;
|
|
|
39 |
use File::Copy;
|
|
|
40 |
use Pod::Usage;
|
|
|
41 |
use Digest::MD5;
|
|
|
42 |
use XML::Simple;
|
|
|
43 |
use Encode qw(decode encode);
|
|
|
44 |
|
|
|
45 |
use JatsError;
|
|
|
46 |
use JatsEnv;
|
|
|
47 |
use DescPkg;
|
|
|
48 |
use FileUtils;
|
|
|
49 |
use JatsSystem;
|
|
|
50 |
|
|
|
51 |
#
|
|
|
52 |
# Under Windows we need the Win32::FileSecurity module
|
|
|
53 |
# It only exists under windows
|
|
|
54 |
#
|
|
|
55 |
my $Win32 = eval "require Win32::FileSecurity";
|
|
|
56 |
|
|
|
57 |
# define Global variables
|
|
|
58 |
#
|
|
|
59 |
my $VERSION = "3.0.0";
|
|
|
60 |
my $PROGNAME = "create_dpkg.pl";
|
|
|
61 |
|
|
|
62 |
# Globals imported from environment
|
|
|
63 |
#
|
|
|
64 |
our $GBE_MACHTYPE;
|
|
|
65 |
our $GBE_HOSTNAME;
|
|
|
66 |
our $USER;
|
|
|
67 |
our $GBE_ABT;
|
|
|
68 |
|
|
|
69 |
# Global variables
|
|
|
70 |
#
|
|
|
71 |
my $DPKG_NAME = "";
|
|
|
72 |
my $DESC_NAME = "";
|
|
|
73 |
my $DPKG_VERSION = "";
|
|
|
74 |
my $DESCPKG_FILE = "";
|
|
|
75 |
my $DESCPKG_TYPE = "";
|
|
|
76 |
my $CWD_DIR = cwd;
|
|
|
77 |
my $SRC_ROOT;
|
|
|
78 |
my $DPKG_DIR;
|
|
|
79 |
my $DPKG_ROOT;
|
|
|
80 |
my $PKG_BASE;
|
|
|
81 |
my $bad_merge_count = 0;
|
|
|
82 |
my @bad_symlinks;
|
|
|
83 |
my @fileList;
|
|
|
84 |
my $descPkgCount = 0;
|
|
|
85 |
|
|
|
86 |
#
|
|
|
87 |
# Option variables
|
|
|
88 |
#
|
|
|
89 |
my $opt_help = 0;
|
|
|
90 |
my $opt_manual = 0;
|
|
|
91 |
my $opt_verbose = 0;
|
|
|
92 |
my $opt_quiet = 0;
|
|
|
93 |
my $opt_delete = 0;
|
|
|
94 |
my $opt_override = 0;
|
|
|
95 |
my $opt_merge = 0;
|
|
|
96 |
my $opt_archive;
|
|
|
97 |
my $opt_generic;
|
|
|
98 |
my $opt_pname;
|
|
|
99 |
my $opt_pversion;
|
|
|
100 |
my $opt_test;
|
|
|
101 |
my $opt_md5 = 1;
|
|
|
102 |
my $opt_outfile;
|
|
|
103 |
my $opt_info;
|
|
|
104 |
my $opt_tarmode;
|
|
|
105 |
|
|
|
106 |
|
|
|
107 |
#
|
|
|
108 |
# Structure to translate -archive=xxx option to archive variable
|
|
|
109 |
# These are the various dpkg_archives known to JATS
|
|
|
110 |
#
|
|
|
111 |
my %Archive2Var =( 'main' => 'GBE_DPKG',
|
|
|
112 |
'store' => 'GBE_DPKG_STORE',
|
|
|
113 |
'cache' => 'GBE_DPKG_CACHE',
|
|
|
114 |
'local' => 'GBE_DPKG_LOCAL',
|
|
|
115 |
'sandbox' => 'GBE_DPKG_SBOX',
|
|
|
116 |
'deploy' => 'GBE_DPLY',
|
|
|
117 |
'replica' => 'GBE_DPKG_REPLICA',
|
|
|
118 |
);
|
|
|
119 |
|
|
|
120 |
#------------------------------------------------------------------------------
|
|
|
121 |
#------------------------------------------------------------------------------
|
|
|
122 |
# Subroutines
|
|
|
123 |
#------------------------------------------------------------------------------
|
|
|
124 |
#------------------------------------------------------------------------------
|
|
|
125 |
|
|
|
126 |
#------------------------------------------------------------------------------
|
|
|
127 |
sub LogFileOp
|
|
|
128 |
#
|
|
|
129 |
# Description:
|
|
|
130 |
# This sub-routine is used to generate a consistent informational log
|
|
|
131 |
#------------------------------------------------------------------------------
|
|
|
132 |
{
|
|
|
133 |
my ($opr, $file) = @_;
|
|
|
134 |
$file =~ s/$DPKG_ROOT/DPKG/;
|
|
|
135 |
|
|
|
136 |
Information (sprintf( "%-15s [%s]", $opr, $file));
|
|
|
137 |
}
|
|
|
138 |
|
|
|
139 |
#-------------------------------------------------------------------------------
|
|
|
140 |
# Function : addFile
|
|
|
141 |
#
|
|
|
142 |
# Description : Add a file to the list of transferred files
|
|
|
143 |
#
|
|
|
144 |
# Inputs : $type - File type
|
|
|
145 |
# $source - Source file - full path
|
|
|
146 |
# Use local copy, not network copy for file ops
|
|
|
147 |
# $target - Target file name
|
|
|
148 |
# $md5sum - Precalculated MD5 sum
|
|
|
149 |
#
|
|
|
150 |
# Returns :
|
|
|
151 |
#
|
|
|
152 |
sub addFile
|
|
|
153 |
{
|
|
|
154 |
my ($type, $source, $target, $md5sum) = @_;
|
|
|
155 |
my %data;
|
|
|
156 |
|
|
|
157 |
if ((not defined $md5sum) && ($type eq 'file'))
|
|
|
158 |
{
|
|
|
159 |
Verbose("Calculate MD5 Digest: $source");
|
|
|
160 |
open(my $fh , $source) or Error ("Can't open '$source': $!");
|
|
|
161 |
binmode $fh, ':crlf';
|
|
|
162 |
$md5sum = Digest::MD5->new->addfile($fh)->hexdigest;
|
|
|
163 |
close $fh;
|
|
|
164 |
}
|
|
|
165 |
|
|
|
166 |
$target =~ s~$DPKG_DIR~~;
|
|
|
167 |
$target =~ s~^/~~;
|
|
|
168 |
$target =~ s~/$~~;
|
|
|
169 |
|
|
|
170 |
#
|
|
|
171 |
# Convert from iso-8859-1 into utf-8
|
|
|
172 |
#
|
|
|
173 |
$target = decode( 'iso-8859-1', $target );
|
|
|
174 |
$target = encode( 'utf-8', $target );
|
|
|
175 |
|
|
|
176 |
if ($type eq 'dir')
|
|
|
177 |
{
|
|
|
178 |
$data{path} = $target;
|
|
|
179 |
}
|
|
|
180 |
else
|
|
|
181 |
{
|
|
|
182 |
$data{path} = StripFileExt($target);
|
|
|
183 |
$data{name} = StripDir($target);
|
|
|
184 |
if ($type eq 'file')
|
|
|
185 |
{
|
|
|
186 |
$data{size} = (stat($source))[7];
|
|
|
187 |
$data{md5sum} = $md5sum;
|
|
|
188 |
}
|
|
|
189 |
}
|
|
|
190 |
|
|
|
191 |
$data{fullname} = $target;
|
|
|
192 |
$data{type} = $type;
|
|
|
193 |
$data{machtype} = $GBE_MACHTYPE;
|
|
|
194 |
$data{host} = $GBE_HOSTNAME;
|
|
|
195 |
|
|
|
196 |
# Put a nice '/' on the end of the path elements
|
|
|
197 |
$data{path} .= '/'
|
|
|
198 |
if ( exists ($data{path}) && length($data{path}) > 0);
|
|
|
199 |
|
|
|
200 |
push @fileList, \%data;
|
|
|
201 |
}
|
|
|
202 |
|
|
|
203 |
#-------------------------------------------------------------------------------
|
|
|
204 |
# Function : writeFileInfo
|
|
|
205 |
#
|
|
|
206 |
# Description : Write out an XML file that contains this processes
|
|
|
207 |
# contribution to the output package
|
|
|
208 |
#
|
|
|
209 |
# Inputs :
|
|
|
210 |
#
|
|
|
211 |
# Returns :
|
|
|
212 |
#
|
|
|
213 |
sub writeFileInfo
|
|
|
214 |
{
|
|
|
215 |
my $data;
|
|
|
216 |
$data->{file} = \@fileList;
|
|
|
217 |
|
|
|
218 |
#
|
|
|
219 |
# Write out sections of XML
|
|
|
220 |
# Want control over the output order
|
|
|
221 |
# Use lots of attributes and only elements for arrays
|
|
|
222 |
# Save as one attribute per line - for readability
|
|
|
223 |
#
|
|
|
224 |
my $targetRoot = $opt_tarmode ? $SRC_ROOT : $DPKG_DIR;
|
|
|
225 |
$opt_outfile = $opt_generic ? "built.files.generic.xml" : "built.files.$GBE_HOSTNAME.xml";
|
|
|
226 |
$opt_outfile = catfile( $targetRoot, $opt_outfile);
|
|
|
227 |
|
|
|
228 |
LogFileOp ('Meta File', $opt_outfile);
|
|
|
229 |
my $xs = XML::Simple->new( NoAttr =>0, AttrIndent => 1 );
|
|
|
230 |
|
|
|
231 |
open (my $XML, '>', $opt_outfile) || Error ("Cannot create output file: $opt_outfile", $!);
|
|
|
232 |
$xs->XMLout($data,
|
|
|
233 |
'RootName' => 'files',
|
|
|
234 |
'XMLDecl' => '<?xml version="1.0" encoding="UTF-8"?>',
|
|
|
235 |
'OutputFile' => $XML);
|
|
|
236 |
close $XML;
|
|
|
237 |
|
|
|
238 |
}
|
|
|
239 |
|
|
|
240 |
#------------------------------------------------------------------------------
|
|
|
241 |
sub Init
|
|
|
242 |
#
|
|
|
243 |
# Description:
|
|
|
244 |
# This function is used to process any command line arguements
|
|
|
245 |
# and print the start banner.
|
|
|
246 |
#
|
|
|
247 |
#------------------------------------------------------------------------------
|
|
|
248 |
{
|
|
|
249 |
# Process any command line arguements...
|
|
|
250 |
my $result = GetOptions (
|
|
|
251 |
"help:+" => \$opt_help, # flag, multiple use allowed
|
|
|
252 |
"manual:3" => \$opt_help, # flag
|
|
|
253 |
"verbose:+" => \$opt_verbose, # flag, multiple use allowed
|
|
|
254 |
"override!" => \$opt_override, # [no]flag (No longer used. Backward compat with build tool)
|
|
|
255 |
"delete!" => \$opt_delete, # [no]flag
|
|
|
256 |
"merge|m!" => \$opt_merge, # [no]flag.
|
|
|
257 |
"archive=s" => \$opt_archive, # string
|
|
|
258 |
"quiet+" => \$opt_quiet, # Flag
|
|
|
259 |
"generic!" => \$opt_generic, # [no]Flag
|
|
|
260 |
"pname=s" => \$opt_pname, # string
|
|
|
261 |
"pversion=s" => \$opt_pversion, # string
|
|
|
262 |
"test!" => \$opt_test, # [no]flag
|
|
|
263 |
"md5!" => \$opt_md5, # [no]flag
|
|
|
264 |
"info!" => \$opt_info, # [no]flag
|
|
|
265 |
"tarmode!" => \$opt_tarmode, # [no]flag
|
|
|
266 |
);
|
|
|
267 |
|
|
|
268 |
|
|
|
269 |
#
|
|
|
270 |
# Process help and manual options
|
|
|
271 |
#
|
|
|
272 |
pod2usage(-verbose => 0, -message => "Version: $VERSION") if ($opt_help == 1 || ! $result);
|
|
|
273 |
pod2usage(-verbose => 1) if ($opt_help == 2 );
|
|
|
274 |
pod2usage(-verbose => 2) if ($opt_help > 2);
|
|
|
275 |
|
|
|
276 |
#
|
|
|
277 |
# Init the error and message subsystem
|
|
|
278 |
#
|
|
|
279 |
ErrorConfig( 'name' =>'CREATE_DPKG',
|
|
|
280 |
'verbose' => $opt_verbose,
|
|
|
281 |
'quiet' => $opt_quiet );
|
|
|
282 |
|
|
|
283 |
if ($opt_verbose)
|
|
|
284 |
{
|
|
|
285 |
Verbose ("Program: $PROGNAME");
|
|
|
286 |
Verbose ("Version: $VERSION");
|
|
|
287 |
}
|
|
|
288 |
|
|
|
289 |
#
|
|
|
290 |
# Needed EnvVars
|
|
|
291 |
#
|
|
|
292 |
EnvImport ('GBE_MACHTYPE');
|
|
|
293 |
EnvImport ('GBE_HOSTNAME');
|
|
|
294 |
EnvImport ('USER' );
|
|
|
295 |
EnvImportOptional ('GBE_ABT', "");
|
|
|
296 |
|
|
|
297 |
#
|
|
|
298 |
# Determine the target archive
|
|
|
299 |
# The default archive is GBE_DPKG, but this may be changed
|
|
|
300 |
#
|
|
|
301 |
$opt_archive = 'main' unless ( $opt_archive );
|
|
|
302 |
my $archive_tag = $Archive2Var{$opt_archive};
|
|
|
303 |
Error("Unknown archive specified: $opt_archive")
|
|
|
304 |
unless ( $archive_tag );
|
|
|
305 |
$DPKG_ROOT = $ENV{$archive_tag} || '';
|
|
|
306 |
Verbose ("Archive Variable: $archive_tag" );
|
|
|
307 |
Verbose2 ("Archive Path: $DPKG_ROOT" );
|
|
|
308 |
|
|
|
309 |
#
|
|
|
310 |
# Detect NoBuild marker
|
|
|
311 |
# This will bypass most of the operation of this package
|
|
|
312 |
#
|
|
|
313 |
if ( -f 'noBuild.gbe' )
|
|
|
314 |
{
|
|
|
315 |
Verbose ("No Build Marker file found");
|
|
|
316 |
Error("Use of noBuild marker should only be done by a build daemon")
|
|
|
317 |
unless ( $GBE_ABT );
|
|
|
318 |
|
|
|
319 |
$SRC_ROOT = '';
|
|
|
320 |
$DPKG_NAME = 'pkg';
|
|
|
321 |
$DESCPKG_FILE = 'descpkg';
|
|
|
322 |
$PKG_BASE =$CWD_DIR;
|
|
|
323 |
return;
|
|
|
324 |
}
|
|
|
325 |
|
|
|
326 |
#
|
|
|
327 |
# Check for a "pkg" directory
|
|
|
328 |
# This may be in:
|
|
|
329 |
# 1) The deploy directory (DEPLOY) build/deploy/descpkg
|
|
|
330 |
# 2) The build directory (ANT) build/pkg/descpkg
|
|
|
331 |
# 3) The current directory (JATS) pkg/xxxx/descpkg
|
|
|
332 |
#
|
|
|
333 |
$PKG_BASE = "$CWD_DIR/build/deploy";
|
|
|
334 |
Verbose2 ("Looking for descpkg: $PKG_BASE");
|
|
|
335 |
if ( -f "$PKG_BASE/descpkg" )
|
|
|
336 |
{
|
|
|
337 |
#
|
|
|
338 |
# This is a deployment package.
|
|
|
339 |
# Force the use of the GBE_DPLY
|
|
|
340 |
#
|
|
|
341 |
$opt_archive = 'deploy' unless ( $opt_archive );
|
|
|
342 |
}
|
|
|
343 |
else
|
|
|
344 |
{
|
|
|
345 |
$PKG_BASE = "$CWD_DIR/build/pkg";
|
|
|
346 |
Verbose ("Looking for descpkg: $PKG_BASE");
|
|
|
347 |
if ( ! -f "$PKG_BASE/descpkg" )
|
|
|
348 |
{
|
|
|
349 |
$PKG_BASE = "$CWD_DIR/pkg";
|
|
|
350 |
Verbose ("Looking for descpkg: $PKG_BASE");
|
|
|
351 |
Error("Failed to find a package to transfer. Looked in:",
|
|
|
352 |
"./build/deploy",
|
|
|
353 |
"./build/pkg",
|
|
|
354 |
"./pkg"
|
|
|
355 |
)
|
|
|
356 |
unless( -d $PKG_BASE );
|
|
|
357 |
}
|
|
|
358 |
}
|
|
|
359 |
Verbose("Package directory: $PKG_BASE");
|
|
|
360 |
|
|
|
361 |
Error("Repository location not specified: $archive_tag")
|
|
|
362 |
unless $DPKG_ROOT;
|
|
|
363 |
|
|
|
364 |
Error("Failed to find Repository: $DPKG_ROOT")
|
|
|
365 |
unless ( -d $DPKG_ROOT );
|
|
|
366 |
|
|
|
367 |
# Locate the package
|
|
|
368 |
# Packages are located by looking for a file called descpkg within the
|
|
|
369 |
# main package directory.
|
|
|
370 |
#
|
|
|
371 |
# This installation process only handles one such file
|
|
|
372 |
#
|
|
|
373 |
$descPkgCount = 0;
|
|
|
374 |
File::Find::find( \&pkgFind, $PKG_BASE);
|
|
|
375 |
|
|
|
376 |
if ($descPkgCount > 1 )
|
|
|
377 |
{
|
|
|
378 |
Warning ("Package contains multiple ($descPkgCount) descpkg files");
|
|
|
379 |
}
|
|
|
380 |
}
|
|
|
381 |
|
|
|
382 |
#-------------------------------------------------------------------------------
|
|
|
383 |
# Function : CheckDescPkg
|
|
|
384 |
#
|
|
|
385 |
# Description : Check the descpkg file
|
|
|
386 |
#
|
|
|
387 |
# Inputs : Globals
|
|
|
388 |
#
|
|
|
389 |
# Returns : Will not return on error
|
|
|
390 |
#
|
|
|
391 |
sub CheckDescPkg
|
|
|
392 |
{
|
|
|
393 |
# Get the dpkg_archive version number we are going to create.
|
|
|
394 |
#
|
|
|
395 |
Error("Descpkg file not found in package directory: $PKG_BASE")
|
|
|
396 |
unless ( -f "$DESCPKG_FILE" );
|
|
|
397 |
|
|
|
398 |
#
|
|
|
399 |
# Read in the package description and validate essential fields
|
|
|
400 |
#
|
|
|
401 |
GetDpkgArchiveVersion($DESCPKG_FILE);
|
|
|
402 |
unless ( "$DPKG_VERSION" )
|
|
|
403 |
{
|
|
|
404 |
Error ("Incorrect descpkg content detected.",
|
|
|
405 |
"Check JATS build.pl config.");
|
|
|
406 |
}
|
|
|
407 |
|
|
|
408 |
#
|
|
|
409 |
# Need to support two forms of pkg subdirectory
|
|
|
410 |
# 1) packages are in a named subdir within 'pkg'
|
|
|
411 |
# 2) package is within 'pkg' or 'deploy'
|
|
|
412 |
#
|
|
|
413 |
if ( $DPKG_NAME eq 'pkg' || $DPKG_NAME eq 'deploy' )
|
|
|
414 |
{
|
|
|
415 |
$DPKG_NAME = $DESC_NAME;
|
|
|
416 |
unless ( $DESC_NAME )
|
|
|
417 |
{
|
|
|
418 |
Error ("Cannot determine package name",
|
|
|
419 |
"The packages 'descpkg' file is bad or missing");
|
|
|
420 |
}
|
|
|
421 |
}
|
|
|
422 |
elsif ( $DESC_NAME ne $DPKG_NAME )
|
|
|
423 |
{
|
|
|
424 |
Error ("Package name MUST match package description",
|
|
|
425 |
"Check build.pl and package.pl",
|
|
|
426 |
"Package name: $DPKG_NAME",
|
|
|
427 |
"Description : $DESC_NAME" );
|
|
|
428 |
}
|
|
|
429 |
|
|
|
430 |
#
|
|
|
431 |
# lets just check to see if we have a version number before
|
|
|
432 |
# we proceed.
|
|
|
433 |
#
|
|
|
434 |
unless ( $DPKG_VERSION )
|
|
|
435 |
{
|
|
|
436 |
Error("Cannot determine dpkg_archive version number.",
|
|
|
437 |
"Check JATS build config.");
|
|
|
438 |
}
|
|
|
439 |
|
|
|
440 |
#
|
|
|
441 |
# Sanity test package name and version, if provided
|
|
|
442 |
#
|
|
|
443 |
if ( $opt_pname )
|
|
|
444 |
{
|
|
|
445 |
ReportError ("Package Name does not match expected name",
|
|
|
446 |
"Expected: '$opt_pname'",
|
|
|
447 |
"Descpkg : '$DPKG_NAME'") unless ( $DPKG_NAME eq $opt_pname );
|
|
|
448 |
}
|
|
|
449 |
if ( $opt_pversion )
|
|
|
450 |
{
|
|
|
451 |
ReportError ("Package Version does not match expected version",
|
|
|
452 |
"Expected: '$opt_pversion'",
|
|
|
453 |
"Descpkg : '$DPKG_VERSION'") unless ( $DPKG_VERSION eq $opt_pversion );
|
|
|
454 |
}
|
|
|
455 |
ErrorDoExit();
|
|
|
456 |
}
|
|
|
457 |
|
|
|
458 |
#-------------------------------------------------------------------------------
|
|
|
459 |
# Function : ShowInfo
|
|
|
460 |
#
|
|
|
461 |
# Description : Show info to the user
|
|
|
462 |
#
|
|
|
463 |
# Inputs :
|
|
|
464 |
#
|
|
|
465 |
# Returns :
|
|
|
466 |
#
|
|
|
467 |
sub ShowInfo
|
|
|
468 |
{
|
|
|
469 |
#
|
|
|
470 |
# Set up the target directory path and name
|
|
|
471 |
# It will be created later
|
|
|
472 |
#
|
|
|
473 |
$DPKG_DIR = "$DPKG_ROOT/$DPKG_NAME/$DPKG_VERSION";
|
|
|
474 |
|
|
|
475 |
#
|
|
|
476 |
# Information for the user
|
|
|
477 |
#
|
|
|
478 |
Information ("---------------------------------------------------------------");
|
|
|
479 |
Information ("Dpkg archive creation tool...");
|
|
|
480 |
Information ("Version: $VERSION");
|
|
|
481 |
Information ("");
|
|
|
482 |
Information ("Information:");
|
|
|
483 |
Information ("Working dir = [$CWD_DIR]");
|
|
|
484 |
Information ("Package Root = [$SRC_ROOT]");
|
|
|
485 |
Information ("Repository = [$DPKG_ROOT]");
|
|
|
486 |
Information (" *Non Standard archive") unless $opt_archive eq 'main';
|
|
|
487 |
Information ("Target dir = [$DPKG_DIR]");
|
|
|
488 |
Information1("DPKG_NAME = [$DPKG_NAME]");
|
|
|
489 |
Information1("DPKG_VERSION = [$DPKG_VERSION]");
|
|
|
490 |
Information1("GBE_MACHTYPE = [$GBE_MACHTYPE]");
|
|
|
491 |
Information1("GBE_HOSTNAME = [$GBE_HOSTNAME]");
|
|
|
492 |
Information1("GBE_ABT = [$GBE_ABT]");
|
|
|
493 |
Information1("USER = [$USER]");
|
|
|
494 |
Information ("") if ( $opt_merge || $opt_delete || $opt_info);
|
|
|
495 |
Information ("Opt:Delete = Enabled") if ( $opt_delete );
|
|
|
496 |
Information ("Opt:Merge = Enabled") if ( $opt_merge );
|
|
|
497 |
Information ("Opt:TestMode = Enabled. No Package Transferred") if ( $opt_test );
|
|
|
498 |
Information ("Opt:Info = Enabled. No Package Transferred") if ( $opt_info );
|
|
|
499 |
Warning ("Sandbox Build = Yes") if ($ENV{GBE_DPKG_SBOX}) ;
|
|
|
500 |
Information ("---------------------------------------------------------------");
|
|
|
501 |
|
|
|
502 |
#
|
|
|
503 |
# If the environment variable GBE_DPKG_SBOX is defined then the package
|
|
|
504 |
# is being built within a development sandbox. In such a sandbox the
|
|
|
505 |
# version numbers of the packages are ignored. Publishing a package
|
|
|
506 |
# from such an environment is certainly not reproducible - so don't allow
|
|
|
507 |
# it to happen
|
|
|
508 |
#
|
|
|
509 |
# Allow versions of 99.99.99 as these are known to be test versions
|
|
|
510 |
#
|
|
|
511 |
unless ( $opt_archive eq 'local' || $opt_archive eq 'sandbox' )
|
|
|
512 |
{
|
|
|
513 |
if ( $ENV{GBE_DPKG_SBOX} )
|
|
|
514 |
{
|
|
|
515 |
unless ( $DPKG_VERSION =~ /^99.99.99/ )
|
|
|
516 |
{
|
|
|
517 |
Error("Cannot not publish a package that has been generated",
|
|
|
518 |
"within a Sandbox as the version of dependent packages",
|
|
|
519 |
"is not guaranteed.",
|
|
|
520 |
"Only version 99.99.99 is allowed");
|
|
|
521 |
}
|
|
|
522 |
}
|
|
|
523 |
}
|
|
|
524 |
}
|
|
|
525 |
|
|
|
526 |
|
|
|
527 |
#------------------------------------------------------------------------------
|
|
|
528 |
sub pkgFind
|
|
|
529 |
#
|
|
|
530 |
# Description:
|
|
|
531 |
# This subroutine is used to locate the FIRST descpkg file in
|
|
|
532 |
# the local pkg dir.
|
|
|
533 |
#
|
|
|
534 |
#------------------------------------------------------------------------------
|
|
|
535 |
{
|
|
|
536 |
my($item)= "$File::Find::name";
|
|
|
537 |
my($file)= File::Basename::basename($item);
|
|
|
538 |
|
|
|
539 |
# we get the absolute path from the find, but we only require
|
|
|
540 |
# a relative path from the starting dir.
|
|
|
541 |
# so our start dir.
|
|
|
542 |
|
|
|
543 |
# we need to determine which file we are dealing with
|
|
|
544 |
if ( ! -d $item && $file =~ /^descpkg$/ )
|
|
|
545 |
{
|
|
|
546 |
$descPkgCount++;
|
|
|
547 |
|
|
|
548 |
#
|
|
|
549 |
# Only grab the first one
|
|
|
550 |
#
|
|
|
551 |
if ( $DESCPKG_FILE )
|
|
|
552 |
{
|
|
|
553 |
$item =~ s~$PKG_BASE/~~;
|
|
|
554 |
Verbose ("Multiple descpkg files:", $item );
|
|
|
555 |
return;
|
|
|
556 |
}
|
|
|
557 |
|
|
|
558 |
$DESCPKG_FILE = $item;
|
|
|
559 |
my($dir)= File::Basename::dirname($item);
|
|
|
560 |
$DPKG_NAME = File::Basename::basename($dir);
|
|
|
561 |
$SRC_ROOT = $dir;
|
|
|
562 |
}
|
|
|
563 |
}
|
|
|
564 |
|
|
|
565 |
|
|
|
566 |
#------------------------------------------------------------------------------
|
|
|
567 |
sub GetDpkgArchiveVersion
|
|
|
568 |
#
|
|
|
569 |
# Description:
|
|
|
570 |
# This subroutine is used to determine the version of the dpkg_archive.
|
|
|
571 |
# We assume that the version number is in the descpkg file.
|
|
|
572 |
#
|
|
|
573 |
# Need to allow for two forms of descpkg. Some one decided that a Java
|
|
|
574 |
# Manifest would be a good descpkg file - a long time after the rest of the
|
|
|
575 |
# world had been using an existing file format.
|
|
|
576 |
#
|
|
|
577 |
# Lines are tagged
|
|
|
578 |
#
|
|
|
579 |
# Once the version number is determined we set the
|
|
|
580 |
# global DPKG_VERSION variable.
|
|
|
581 |
#
|
|
|
582 |
#------------------------------------------------------------------------------
|
|
|
583 |
{
|
|
|
584 |
my ($path) = @_;
|
|
|
585 |
my $line;
|
|
|
586 |
my $type;
|
|
|
587 |
|
|
|
588 |
#
|
|
|
589 |
# Use a common routine to parse the package descriptor
|
|
|
590 |
# There are several forms that may need to be processed
|
|
|
591 |
#
|
|
|
592 |
my $pkg_data = ReadDescpkg( $path );
|
|
|
593 |
Error("Failed to open file [$path].") unless $pkg_data;
|
|
|
594 |
|
|
|
595 |
$DESC_NAME = $pkg_data->{'NAME'};
|
|
|
596 |
$DPKG_VERSION = $pkg_data->{'VERSION_FULL'};
|
|
|
597 |
}
|
|
|
598 |
|
|
|
599 |
#-------------------------------------------------------------------------------
|
|
|
600 |
# Function : TransferDescpkg
|
|
|
601 |
#
|
|
|
602 |
# Description : Copy and process the descpkg file to the target
|
|
|
603 |
#
|
|
|
604 |
# Inputs :
|
|
|
605 |
#
|
|
|
606 |
# Returns :
|
|
|
607 |
#
|
|
|
608 |
sub TransferDescpkg
|
|
|
609 |
{
|
|
|
610 |
my $result = CopyDescpkg( @_ );
|
|
|
611 |
Error("Transfer descpkg: $result") if ( $result );
|
|
|
612 |
}
|
|
|
613 |
|
|
|
614 |
#------------------------------------------------------------------------------
|
|
|
615 |
sub CreateDpkgArchive
|
|
|
616 |
#
|
|
|
617 |
# Description:
|
|
|
618 |
# This subroutine is used to create the dpkg_archive in the $DPKG_ROOT
|
|
|
619 |
# location
|
|
|
620 |
#
|
|
|
621 |
# We use the global DPKG_ROOT, DPKG_DIR, DPKG_NAME, and DPKG_VERSION
|
|
|
622 |
# to create the required directory structure.
|
|
|
623 |
#
|
|
|
624 |
# If the dpkg_archive is new (ie not a new version) it is assumed the user
|
|
|
625 |
# has access to create the top level dir for the new dpkg_archive.
|
|
|
626 |
#
|
|
|
627 |
# The new dpkg_archive is created with the permission of the user
|
|
|
628 |
# executing this script.
|
|
|
629 |
#
|
|
|
630 |
# If an error ocurs during the dpkg_archive creation the script
|
|
|
631 |
# will terminate.
|
|
|
632 |
#
|
|
|
633 |
#------------------------------------------------------------------------------
|
|
|
634 |
{
|
|
|
635 |
#
|
|
|
636 |
# first we need to ensure we have the top level directory
|
|
|
637 |
#
|
|
|
638 |
if ( -d $DPKG_DIR )
|
|
|
639 |
{
|
|
|
640 |
Warning("Detected previous dpkg_archive [$DPKG_DIR]");
|
|
|
641 |
Error ("Package already exists and Package merging not selected")
|
|
|
642 |
unless ( $opt_delete || $opt_merge );
|
|
|
643 |
|
|
|
644 |
#
|
|
|
645 |
# Target exists
|
|
|
646 |
# Unless we are merging, we need to blow the entire tree away
|
|
|
647 |
#
|
|
|
648 |
unless ( $opt_merge )
|
|
|
649 |
{
|
|
|
650 |
LogFileOp("Remove Prev Pkg",$DPKG_DIR);
|
|
|
651 |
rmtree($DPKG_DIR);
|
|
|
652 |
|
|
|
653 |
#
|
|
|
654 |
# At this point the target directory 'should not' exist
|
|
|
655 |
# but it may. Some packges (like JATS) have Unix links within
|
|
|
656 |
# dpkg_archive filesystem. These cannot be deleted under windows
|
|
|
657 |
#
|
|
|
658 |
# Not nice, but we live with it.
|
|
|
659 |
#
|
|
|
660 |
Warning ("Unable to delete previous instance of the package")
|
|
|
661 |
if ( -d $DPKG_DIR );
|
|
|
662 |
}
|
|
|
663 |
}
|
|
|
664 |
Information("");
|
|
|
665 |
|
|
|
666 |
#
|
|
|
667 |
# Create the top level directory
|
|
|
668 |
#
|
|
|
669 |
mkpath($DPKG_DIR, 0, 0775);
|
|
|
670 |
|
|
|
671 |
#
|
|
|
672 |
# Transfer source directory, unless this is a noBuild
|
|
|
673 |
#
|
|
|
674 |
if ( $SRC_ROOT ne '' )
|
|
|
675 |
{
|
|
|
676 |
# Process the files
|
|
|
677 |
#
|
|
|
678 |
if ( -d $SRC_ROOT )
|
|
|
679 |
{
|
|
|
680 |
File::Find::find( \&pkgFind2, $SRC_ROOT );
|
|
|
681 |
|
|
|
682 |
if (@bad_symlinks)
|
|
|
683 |
{
|
|
|
684 |
my $msg = "Bad Symlinks: " . scalar @bad_symlinks;
|
|
|
685 |
$opt_test ? ReportError($msg, @bad_symlinks) : Warning($msg, @bad_symlinks);
|
|
|
686 |
}
|
|
|
687 |
|
|
|
688 |
if ( $bad_merge_count )
|
|
|
689 |
{
|
|
|
690 |
my $msg = "Merged files that differ: $bad_merge_count";
|
|
|
691 |
$opt_md5 ? ReportError($msg) : Warning($msg);
|
|
|
692 |
}
|
|
|
693 |
ErrorDoExit();
|
|
|
694 |
}
|
|
|
695 |
else
|
|
|
696 |
{
|
|
|
697 |
Error("Failed to find dir [$SRC_ROOT]",
|
|
|
698 |
"Check JATS config.");
|
|
|
699 |
}
|
|
|
700 |
}
|
|
|
701 |
|
|
|
702 |
#
|
|
|
703 |
# Transfer of data is complete
|
|
|
704 |
# Mark the archive with the build machine to indicate which parts of
|
|
|
705 |
# a multi-machine build have been performed
|
|
|
706 |
#
|
|
|
707 |
my $touchfile = $opt_generic ? "$DPKG_DIR/built.generic" : "$DPKG_DIR/built.$GBE_HOSTNAME";
|
|
|
708 |
|
|
|
709 |
#
|
|
|
710 |
# Create a string to be appended to the 'built' file
|
|
|
711 |
# Comma seperated list of (possibly) useful info
|
|
|
712 |
# Date-Time ( Local and GMT)
|
|
|
713 |
# machine type, machine name and the user
|
|
|
714 |
# GBE_ABT value
|
|
|
715 |
#
|
|
|
716 |
# Having build issues where the file is not seen for a very long time
|
|
|
717 |
#
|
|
|
718 |
my $built_info = localtime() ."," . gmtime() . " GMT,$GBE_MACHTYPE,$GBE_HOSTNAME,$USER,$GBE_ABT";
|
|
|
719 |
LogFileOp("Mark File",$touchfile);
|
|
|
720 |
FileAppend ( $touchfile, $built_info );
|
|
|
721 |
|
|
|
722 |
addFile('file', $touchfile, $touchfile);
|
|
|
723 |
|
|
|
724 |
#
|
|
|
725 |
# If there is a .lnk file in the archive then remove it now that the
|
|
|
726 |
# archive has been transferred. The .lnk files are created in 'local'
|
|
|
727 |
# archives in order to simplify multi-package builds
|
|
|
728 |
#
|
|
|
729 |
my $link_file = "$DPKG_ROOT/$DPKG_NAME/$DPKG_VERSION.lnk";
|
|
|
730 |
if ( -f $link_file )
|
|
|
731 |
{
|
|
|
732 |
LogFileOp("Removing Link",$link_file);
|
|
|
733 |
unlink $link_file;
|
|
|
734 |
}
|
|
|
735 |
|
|
|
736 |
return 1;
|
|
|
737 |
}
|
|
|
738 |
|
|
|
739 |
#------------------------------------------------------------------------------
|
|
|
740 |
sub pkgFind2
|
|
|
741 |
#
|
|
|
742 |
# Description:
|
|
|
743 |
# This subroutine is used to locate all associated pkg files in
|
|
|
744 |
# the local pkg dir.
|
|
|
745 |
#
|
|
|
746 |
# This routine is called for each file and directory within the package
|
|
|
747 |
# Some files and directories are treated in a special manner
|
|
|
748 |
# - Top level directory is ignored
|
|
|
749 |
#
|
|
|
750 |
#
|
|
|
751 |
#
|
|
|
752 |
#------------------------------------------------------------------------------
|
|
|
753 |
{
|
|
|
754 |
my $item = $File::Find::name;
|
|
|
755 |
my $base = File::Basename::basename($item);
|
|
|
756 |
|
|
|
757 |
#
|
|
|
758 |
# Calculate the target directory name
|
|
|
759 |
#
|
|
|
760 |
my $target = $item;
|
|
|
761 |
$target = $DPKG_DIR . substr ( $item, length ($SRC_ROOT) );
|
|
|
762 |
|
|
|
763 |
if ( -d $item )
|
|
|
764 |
{
|
|
|
765 |
#
|
|
|
766 |
# Ignore the top level directory
|
|
|
767 |
# It has already been created
|
|
|
768 |
#
|
|
|
769 |
return
|
|
|
770 |
if ( $item eq $SRC_ROOT );
|
|
|
771 |
|
|
|
772 |
#
|
|
|
773 |
# Directories are handled differently
|
|
|
774 |
# - Directories are created with nice permissions
|
|
|
775 |
# - If the directory already exists then it is being merged.
|
|
|
776 |
#
|
|
|
777 |
if ( ! -d "$target" )
|
|
|
778 |
{
|
|
|
779 |
LogFileOp("Creating Dir", $target);
|
|
|
780 |
mkpath("$target", 0, 0775);
|
|
|
781 |
addFile('dir', $item , $target);
|
|
|
782 |
}
|
|
|
783 |
}
|
|
|
784 |
else
|
|
|
785 |
{
|
|
|
786 |
#
|
|
|
787 |
# File copy
|
|
|
788 |
# If merging then do not overwrite an existing file
|
|
|
789 |
#
|
|
|
790 |
unless ( $opt_merge && -f $target )
|
|
|
791 |
{
|
|
|
792 |
if ( $item =~ m~/descpkg$~ )
|
|
|
793 |
{
|
|
|
794 |
LogFileOp("Rewrite File",$target);
|
|
|
795 |
TransferDescpkg( $item, $target );
|
|
|
796 |
CORE::chmod oct("0664"), $target;
|
|
|
797 |
addFile('file', $item, $target);
|
|
|
798 |
}
|
|
|
799 |
else
|
|
|
800 |
{
|
|
|
801 |
#
|
|
|
802 |
# Copy file to destination
|
|
|
803 |
# If the file is a link, then duplicate the link contents
|
|
|
804 |
# Use: Unix libraries are created as two files:
|
|
|
805 |
# lib.xxxx.so -> libxxxx.so.vv.vv.vv
|
|
|
806 |
#
|
|
|
807 |
if ( -l $item )
|
|
|
808 |
{
|
|
|
809 |
if (-f $item)
|
|
|
810 |
{
|
|
|
811 |
LogFileOp("Copying Link", $target);
|
|
|
812 |
my $link = readlink $item;
|
|
|
813 |
Verbose( "Link: $item, $link");
|
|
|
814 |
symlink ($link, $target );
|
|
|
815 |
unless ( $link && -l $target )
|
|
|
816 |
{
|
|
|
817 |
Error("Failed to copy link [$item] to [$target]: $!");
|
|
|
818 |
}
|
|
|
819 |
addFile('link', $item , $target);
|
|
|
820 |
}
|
|
|
821 |
else
|
|
|
822 |
{
|
|
|
823 |
# Don't copy broken Symlinks
|
|
|
824 |
# Perhaps this should be an error - but is will break escrow builds
|
|
|
825 |
#
|
|
|
826 |
LogFileOp("Broken SymLink", $target);
|
|
|
827 |
push @bad_symlinks, substr ( $item, 1+length ($SRC_ROOT) );
|
|
|
828 |
}
|
|
|
829 |
}
|
|
|
830 |
elsif (File::Copy::copy($item, $target))
|
|
|
831 |
{
|
|
|
832 |
LogFileOp("Copying File",$target);
|
|
|
833 |
#
|
|
|
834 |
# Mark the file as executable by all
|
|
|
835 |
# Under windows, this is tricky
|
|
|
836 |
#
|
|
|
837 |
if ( $Win32 )
|
|
|
838 |
{
|
|
|
839 |
my %hash;
|
|
|
840 |
$hash{Everyone} = Win32::FileSecurity::MakeMask( qw( FULL ) );
|
|
|
841 |
Win32::FileSecurity::Set( $target, \%hash );
|
|
|
842 |
}
|
|
|
843 |
else
|
|
|
844 |
{
|
|
|
845 |
CORE::chmod oct("0775"), $target;
|
|
|
846 |
}
|
|
|
847 |
addFile('file', $item, $target);
|
|
|
848 |
}
|
|
|
849 |
else
|
|
|
850 |
{
|
|
|
851 |
Error("Failed to copy file [$item] to [$target]: $!");
|
|
|
852 |
}
|
|
|
853 |
}
|
|
|
854 |
}
|
|
|
855 |
else
|
|
|
856 |
{
|
|
|
857 |
#
|
|
|
858 |
# Merging packages
|
|
|
859 |
# Ensure that the descpkg file is "touched" so that caches
|
|
|
860 |
# that use this file as a timestamp can be updated
|
|
|
861 |
#
|
|
|
862 |
if ( $item =~ m~/descpkg$~ )
|
|
|
863 |
{
|
|
|
864 |
LogFileOp("Touch File",$target);
|
|
|
865 |
TouchFile( $target ) && Error ( "Failed to touch: $target" );
|
|
|
866 |
addFile('merge', $item, $target);
|
|
|
867 |
}
|
|
|
868 |
else
|
|
|
869 |
{
|
|
|
870 |
#
|
|
|
871 |
# MD5 digest the files that are being merged
|
|
|
872 |
# Ignore version_*.h files as these are generated
|
|
|
873 |
# and may contain different dates and line endings
|
|
|
874 |
#
|
|
|
875 |
# Don't put the files into 'binmode'
|
|
|
876 |
# Need to handle some level of Unix/DOS file endings
|
|
|
877 |
#
|
|
|
878 |
#
|
|
|
879 |
my $msg = "Merge Skip File";
|
|
|
880 |
unless ( $target =~ m~/version[^/]*\.h$~ )
|
|
|
881 |
{
|
|
|
882 |
$msg = "Merge Test File";
|
|
|
883 |
#
|
|
|
884 |
# Compare the two files with an MD5
|
|
|
885 |
#
|
|
|
886 |
local *FILE;
|
|
|
887 |
open(FILE, $target) or Error ("Can't open '$target': $!");
|
|
|
888 |
binmode FILE, ':crlf';
|
|
|
889 |
my $target_md5 = Digest::MD5->new->addfile(*FILE)->hexdigest;
|
|
|
890 |
close FILE;
|
|
|
891 |
|
|
|
892 |
open(FILE, $item) or Error ("Can't open '$item': $!");
|
|
|
893 |
binmode FILE, ':crlf';
|
|
|
894 |
my $source_md5 = Digest::MD5->new->addfile(*FILE)->hexdigest;
|
|
|
895 |
close FILE;
|
|
|
896 |
|
|
|
897 |
unless ( $source_md5 eq $target_md5 )
|
|
|
898 |
{
|
|
|
899 |
$msg = "DIFF: Merge Test File";
|
|
|
900 |
$bad_merge_count ++;
|
|
|
901 |
}
|
|
|
902 |
addFile('merge', $item, $target, $target_md5);
|
|
|
903 |
}
|
|
|
904 |
LogFileOp($msg,$target);
|
|
|
905 |
}
|
|
|
906 |
}
|
|
|
907 |
}
|
|
|
908 |
}
|
|
|
909 |
|
|
|
910 |
#-------------------------------------------------------------------------------
|
|
|
911 |
# Function : CreateDpkgArchiveTarBall
|
|
|
912 |
#
|
|
|
913 |
# Description : Similar to CreateDpkgArchive, but it will create a tar file within the target
|
|
|
914 |
# directory.
|
|
|
915 |
#
|
|
|
916 |
# This is used by the build system to:
|
|
|
917 |
# 1) Greatly speedup the transfer of packages with a very large number of files
|
|
|
918 |
# 2) Remove the need for an multi-filesytem, multi OS atomic lock on the package
|
|
|
919 |
#
|
|
|
920 |
# The build system will process the tarball and create the package archive
|
|
|
921 |
# In doing so it will handle merge errors
|
|
|
922 |
#
|
|
|
923 |
# Inputs :
|
|
|
924 |
#
|
|
|
925 |
# Returns :
|
|
|
926 |
#
|
|
|
927 |
sub CreateDpkgArchiveTarBall
|
|
|
928 |
{
|
|
|
929 |
Information("");
|
| 5486 |
dpurdie |
930 |
InitFileUtils();
|
| 5485 |
dpurdie |
931 |
|
| 5486 |
dpurdie |
932 |
|
| 5485 |
dpurdie |
933 |
#
|
| 5486 |
dpurdie |
934 |
# Locate the tar utility
|
|
|
935 |
# Use gtar if its available otherwise use tar
|
|
|
936 |
#
|
|
|
937 |
my $tarProg = LocateProgInPath('gtar', '--All');
|
|
|
938 |
$tarProg = LocateProgInPath('tar', '--All') unless $tarProg;
|
|
|
939 |
Error ("Tar utility not found in path") unless $tarProg;
|
|
|
940 |
|
| 5485 |
dpurdie |
941 |
#
|
| 5486 |
dpurdie |
942 |
# If a 'noBuild' then create a dummy package directory simply
|
|
|
943 |
# to contain the metadata
|
|
|
944 |
#
|
|
|
945 |
if ( $SRC_ROOT eq '' )
|
| 5485 |
dpurdie |
946 |
{
|
| 5486 |
dpurdie |
947 |
$SRC_ROOT = AbsPath('pkg/noBuild');
|
|
|
948 |
mkpath($SRC_ROOT, 0, 0775);
|
|
|
949 |
}
|
| 5485 |
dpurdie |
950 |
|
| 5486 |
dpurdie |
951 |
#
|
|
|
952 |
# Mark the archive with the build machine to indicate which parts of
|
|
|
953 |
# a multi-machine build have been performed
|
|
|
954 |
#
|
|
|
955 |
my $touchfile = $opt_generic ? "$SRC_ROOT/built.generic" : "$SRC_ROOT/built.$GBE_HOSTNAME";
|
|
|
956 |
|
|
|
957 |
#
|
|
|
958 |
# Create a string to be appended to the 'built' file
|
|
|
959 |
# Comma seperated list of (possibly) useful info
|
|
|
960 |
# Date-Time ( Local and GMT)
|
|
|
961 |
# machine type, machine name and the user
|
|
|
962 |
# GBE_ABT value
|
|
|
963 |
#
|
|
|
964 |
# Having build issues where the file is not seen for a very long time
|
|
|
965 |
#
|
|
|
966 |
my $built_info = localtime() ."," . gmtime() . " GMT,$GBE_MACHTYPE,$GBE_HOSTNAME,$USER,$GBE_ABT";
|
|
|
967 |
LogFileOp("Mark File",$touchfile);
|
|
|
968 |
FileAppend ( $touchfile, $built_info );
|
|
|
969 |
|
|
|
970 |
# Process the source directory
|
|
|
971 |
# A NoBuild will contain one metafile
|
|
|
972 |
#
|
|
|
973 |
if ( -d $SRC_ROOT )
|
|
|
974 |
{
|
|
|
975 |
File::Find::find( \&pkgFindTarBall, $SRC_ROOT );
|
|
|
976 |
|
|
|
977 |
if (@bad_symlinks)
|
| 5485 |
dpurdie |
978 |
{
|
| 5486 |
dpurdie |
979 |
my $msg = "Bad Symlinks: " . scalar @bad_symlinks;
|
|
|
980 |
$opt_test ? ReportError($msg, @bad_symlinks) : Warning($msg, @bad_symlinks);
|
| 5485 |
dpurdie |
981 |
}
|
| 5486 |
dpurdie |
982 |
ErrorDoExit();
|
|
|
983 |
}
|
|
|
984 |
else
|
|
|
985 |
{
|
|
|
986 |
Error("Failed to find dir [$SRC_ROOT]",
|
|
|
987 |
"Check JATS config.");
|
|
|
988 |
}
|
| 5485 |
dpurdie |
989 |
|
| 5486 |
dpurdie |
990 |
#
|
|
|
991 |
# Create the MD5 info file
|
|
|
992 |
#
|
|
|
993 |
writeFileInfo();
|
| 5485 |
dpurdie |
994 |
|
| 5486 |
dpurdie |
995 |
#
|
|
|
996 |
# Create the target patch in the target archive
|
|
|
997 |
#
|
|
|
998 |
Message "Creating: $DPKG_DIR";
|
|
|
999 |
mkpath($DPKG_DIR, 0, 0775);
|
| 5485 |
dpurdie |
1000 |
|
|
|
1001 |
|
| 5486 |
dpurdie |
1002 |
#
|
|
|
1003 |
# Create the TAR file
|
|
|
1004 |
# Use gzip compression (tar.gz) as it provides a good compromise bewteen speed and size
|
|
|
1005 |
# - Not Windows yet
|
|
|
1006 |
my $tarTarget = join('_', $DPKG_NAME, $DPKG_VERSION, $GBE_HOSTNAME) . '.tar.gz';
|
|
|
1007 |
my $tarPath = catfile($DPKG_DIR, $tarTarget);
|
|
|
1008 |
Message "Creating: $tarTarget";
|
|
|
1009 |
my @tarArgs;
|
|
|
1010 |
push @tarArgs, '-v' if IsVerbose(1);
|
|
|
1011 |
my $rv = System ('--NoShell', '--NoExit',$tarProg, @tarArgs, '-czf', $tarPath, '-C', $SRC_ROOT, '.' );
|
|
|
1012 |
if ($rv)
|
|
|
1013 |
{
|
|
|
1014 |
unlink $tarPath;
|
|
|
1015 |
unlink $opt_outfile;
|
|
|
1016 |
Error ('Cannot create tarball', "Path:$tarPath");
|
| 5485 |
dpurdie |
1017 |
}
|
|
|
1018 |
|
|
|
1019 |
return 1;
|
|
|
1020 |
|
|
|
1021 |
}
|
|
|
1022 |
|
|
|
1023 |
#-------------------------------------------------------------------------------
|
|
|
1024 |
# Function : pkgFindTarBall
|
|
|
1025 |
#
|
|
|
1026 |
# Description : Used by CreateDpkgArchiveTarBall
|
|
|
1027 |
# File::Find processing function
|
|
|
1028 |
#
|
|
|
1029 |
# This routine is called for each file and directory within the package
|
|
|
1030 |
#
|
|
|
1031 |
# Inputs : As per File::Find
|
|
|
1032 |
#
|
|
|
1033 |
# Returns : Nothing
|
|
|
1034 |
#
|
|
|
1035 |
sub pkgFindTarBall
|
|
|
1036 |
{
|
|
|
1037 |
my $item = $File::Find::name;
|
|
|
1038 |
my $base = File::Basename::basename($item);
|
|
|
1039 |
my $type;
|
|
|
1040 |
|
|
|
1041 |
#
|
| 5486 |
dpurdie |
1042 |
# Ignore the top level directory
|
|
|
1043 |
#
|
|
|
1044 |
return
|
|
|
1045 |
if ( $item eq $SRC_ROOT );
|
|
|
1046 |
|
|
|
1047 |
#
|
| 5485 |
dpurdie |
1048 |
# Determine type of this item
|
|
|
1049 |
# file
|
|
|
1050 |
# link, badlink
|
|
|
1051 |
# dir
|
|
|
1052 |
if ( -l $item)
|
|
|
1053 |
{
|
|
|
1054 |
if (-f $item) {
|
|
|
1055 |
$type = 'link';
|
|
|
1056 |
}
|
|
|
1057 |
else
|
|
|
1058 |
{
|
| 5486 |
dpurdie |
1059 |
# Broken symlink
|
|
|
1060 |
# Remove it from the 'pkg'
|
|
|
1061 |
# Could try other ways of excluding it from the tar, but this is the simplest
|
| 5485 |
dpurdie |
1062 |
LogFileOp("Broken SymLink", $item);
|
|
|
1063 |
push @bad_symlinks, substr ( $item, 1+length ($SRC_ROOT) );
|
|
|
1064 |
$type = 'badlink';
|
| 5486 |
dpurdie |
1065 |
unlink $item;
|
|
|
1066 |
return;
|
| 5485 |
dpurdie |
1067 |
}
|
|
|
1068 |
} elsif ( -f $item) {
|
|
|
1069 |
$type = 'file';
|
|
|
1070 |
} elsif ( -d $item) {
|
|
|
1071 |
$type = 'dir';
|
| 5486 |
dpurdie |
1072 |
} else {
|
|
|
1073 |
Error("Unknown file type. Cannot be packaged");
|
| 5485 |
dpurdie |
1074 |
}
|
|
|
1075 |
|
|
|
1076 |
#
|
|
|
1077 |
# Calculate the target directory name
|
|
|
1078 |
#
|
|
|
1079 |
my $target = $item;
|
|
|
1080 |
$target = $DPKG_DIR . substr ( $item, length ($SRC_ROOT) );
|
|
|
1081 |
|
|
|
1082 |
addFile($type, $item, $target);
|
|
|
1083 |
LogFileOp('Process',$target);
|
|
|
1084 |
}
|
|
|
1085 |
|
|
|
1086 |
#-------------------------------------------------------------------------------
|
|
|
1087 |
# Function : TestDpkgArchive
|
|
|
1088 |
#
|
|
|
1089 |
# Description : Test the structure of the source achive
|
|
|
1090 |
# Ensure that it has some files
|
|
|
1091 |
# Warn if files are present in the root directory
|
|
|
1092 |
#
|
|
|
1093 |
# Inputs : None
|
|
|
1094 |
#
|
|
|
1095 |
# Returns : Warnings
|
|
|
1096 |
#
|
|
|
1097 |
my $test_dir_count = 0;
|
|
|
1098 |
my $test_file_count = 0;
|
|
|
1099 |
my @test_root_file = ();
|
|
|
1100 |
sub TestDpkgArchive
|
|
|
1101 |
{
|
|
|
1102 |
$test_dir_count = 0;
|
|
|
1103 |
$test_file_count = 0;
|
|
|
1104 |
@test_root_file = ();
|
|
|
1105 |
|
|
|
1106 |
if ( $SRC_ROOT ne '' )
|
|
|
1107 |
{
|
|
|
1108 |
Error("Failed to find dir [$SRC_ROOT]",
|
|
|
1109 |
"Check JATS config.") unless ( -d $SRC_ROOT );
|
|
|
1110 |
|
|
|
1111 |
|
|
|
1112 |
#
|
|
|
1113 |
# Scan the package counting files and folders
|
|
|
1114 |
#
|
|
|
1115 |
File::Find::find( \&pkgFind3, $SRC_ROOT );
|
|
|
1116 |
}
|
|
|
1117 |
|
|
|
1118 |
Information ("Package contains:",
|
|
|
1119 |
"Files: $test_file_count",
|
|
|
1120 |
"Dirs: $test_dir_count",
|
|
|
1121 |
);
|
|
|
1122 |
#
|
|
|
1123 |
# There shouldn't be any files in the root directory
|
|
|
1124 |
# other than the descpkg and incpkg.
|
|
|
1125 |
#
|
|
|
1126 |
Warning ("Unexpected files in package root:", @test_root_file)
|
|
|
1127 |
if ( @test_root_file );
|
|
|
1128 |
|
|
|
1129 |
Error ("Bad symbolic links found:", @bad_symlinks)
|
|
|
1130 |
if ( @bad_symlinks );
|
|
|
1131 |
|
|
|
1132 |
}
|
|
|
1133 |
|
|
|
1134 |
sub pkgFind3
|
|
|
1135 |
{
|
|
|
1136 |
|
|
|
1137 |
#
|
|
|
1138 |
# Calculate the target directory name
|
|
|
1139 |
#
|
|
|
1140 |
my $target = $File::Find::dir;
|
|
|
1141 |
$target = substr ( $target, length ($SRC_ROOT) );
|
|
|
1142 |
$target =~ s~^.~~;
|
|
|
1143 |
|
|
|
1144 |
if ( -d $_ ) {
|
|
|
1145 |
$test_dir_count++;
|
|
|
1146 |
} else {
|
|
|
1147 |
$test_file_count++;
|
|
|
1148 |
unless ( $target )
|
|
|
1149 |
{
|
|
|
1150 |
#
|
|
|
1151 |
# Locate files in the package root directory that
|
|
|
1152 |
# are not expected to be there.
|
|
|
1153 |
#
|
|
|
1154 |
unless (( $_ eq 'descpkg' ) || ( $_ eq 'incpkg' ))
|
|
|
1155 |
{
|
|
|
1156 |
push @test_root_file, $_;
|
|
|
1157 |
}
|
|
|
1158 |
}
|
|
|
1159 |
if (-l $_ && ! -f $_)
|
|
|
1160 |
{
|
|
|
1161 |
push @bad_symlinks, substr ( $File::Find::name, 1+length ($SRC_ROOT) );
|
|
|
1162 |
}
|
|
|
1163 |
}
|
|
|
1164 |
}
|
|
|
1165 |
|
|
|
1166 |
# ---------------------------------------------------------
|
|
|
1167 |
# ---------------------------------------------------------
|
|
|
1168 |
# Main
|
|
|
1169 |
# ---------------------------------------------------------
|
|
|
1170 |
# ---------------------------------------------------------
|
|
|
1171 |
|
|
|
1172 |
|
|
|
1173 |
# Initialise our world
|
|
|
1174 |
#
|
|
|
1175 |
Init();
|
|
|
1176 |
CheckDescPkg();
|
|
|
1177 |
ShowInfo();
|
|
|
1178 |
unless ($opt_info)
|
|
|
1179 |
{
|
|
|
1180 |
unless ( $opt_test )
|
|
|
1181 |
{
|
|
|
1182 |
if ($opt_tarmode)
|
|
|
1183 |
{
|
|
|
1184 |
Information("Creating dpkg_archive tarball:", $DPKG_DIR);
|
|
|
1185 |
CreateDpkgArchiveTarBall();
|
|
|
1186 |
}
|
|
|
1187 |
else
|
|
|
1188 |
{
|
|
|
1189 |
Information("Creating dpkg_archive package:", $DPKG_DIR);
|
|
|
1190 |
CreateDpkgArchive();
|
|
|
1191 |
writeFileInfo();
|
|
|
1192 |
}
|
|
|
1193 |
}
|
|
|
1194 |
else
|
|
|
1195 |
{
|
|
|
1196 |
Information("Testing user package.");
|
|
|
1197 |
TestDpkgArchive();
|
|
|
1198 |
}
|
|
|
1199 |
}
|
|
|
1200 |
|
|
|
1201 |
# Done
|
|
|
1202 |
#
|
|
|
1203 |
Information ("Done.");
|
|
|
1204 |
exit 0;
|
|
|
1205 |
|
|
|
1206 |
|
|
|
1207 |
#-------------------------------------------------------------------------------
|
|
|
1208 |
# Documentation
|
|
|
1209 |
#
|
|
|
1210 |
|
|
|
1211 |
=pod
|
|
|
1212 |
|
|
|
1213 |
=for htmltoc SYSUTIL::
|
|
|
1214 |
|
|
|
1215 |
=head1 NAME
|
|
|
1216 |
|
|
|
1217 |
create_dpkg - Create a dpkg_archive entry
|
|
|
1218 |
|
|
|
1219 |
=head1 SYNOPSIS
|
|
|
1220 |
|
|
|
1221 |
jats create_dpkg [options]
|
|
|
1222 |
|
|
|
1223 |
Options:
|
|
|
1224 |
-help - Brief help message
|
|
|
1225 |
-help -help - Detailed help message
|
|
|
1226 |
-man - Full documentation
|
|
|
1227 |
-quiet - Suppress progress messages, then warning messages
|
|
|
1228 |
-verbose - Display additional progress messages
|
|
|
1229 |
-override - Deprecated option
|
|
|
1230 |
-delete - Delete any previous version of the package
|
|
|
1231 |
-[no]merge - merge with existing version of the package
|
|
|
1232 |
-archive=name - Specify archive (cache, local, main, store, sandbox, deploy)
|
|
|
1233 |
-pname=name - Ensure package is named correctly
|
|
|
1234 |
-pversion=version - Ensure package version is correct
|
|
|
1235 |
-generic - Create a built.generic file
|
|
|
1236 |
-[no]tarmode - Transfer package as tarball
|
|
|
1237 |
-[no]md5 - Use MD5 comparison of merged files(enabled)
|
|
|
1238 |
-[no]test - Test package. Do not transfer.
|
|
|
1239 |
-[no]info - Display packaging info. Do not transfer.
|
|
|
1240 |
|
|
|
1241 |
=head1 OPTIONS
|
|
|
1242 |
|
|
|
1243 |
=over 8
|
|
|
1244 |
|
|
|
1245 |
=item B<-help>
|
|
|
1246 |
|
|
|
1247 |
Print a brief help message and exits.
|
|
|
1248 |
|
|
|
1249 |
=item B<-help -help>
|
|
|
1250 |
|
|
|
1251 |
Print a detailed help message with an explanation for each option.
|
|
|
1252 |
|
|
|
1253 |
=item B<-man>
|
|
|
1254 |
|
|
|
1255 |
Prints the manual page and exits.
|
|
|
1256 |
|
|
|
1257 |
=item B<-quiet>
|
|
|
1258 |
|
|
|
1259 |
This option will suppress almost all of the progress messages, except for a single
|
|
|
1260 |
copy message. It is intended to be used when the program is called from another
|
|
|
1261 |
script.
|
|
|
1262 |
|
|
|
1263 |
=item B<-override>
|
|
|
1264 |
|
|
|
1265 |
If this option has been deprecated. It has no effect.
|
|
|
1266 |
|
|
|
1267 |
It is still present to preserve backward compatability with the automated
|
|
|
1268 |
build system.
|
|
|
1269 |
|
|
|
1270 |
=item B<-delete>
|
|
|
1271 |
|
|
|
1272 |
If this option is enabled then any previous version of the target package will
|
|
|
1273 |
be deleted.
|
|
|
1274 |
|
|
|
1275 |
=item B<-merge>
|
|
|
1276 |
|
|
|
1277 |
If this option is enabled then the package will be merged with any existing
|
|
|
1278 |
package. This option is used by the auto build tool to assemble multi-machine
|
|
|
1279 |
packages in dpkg_archive.
|
|
|
1280 |
|
|
|
1281 |
=item B<-archive=name>
|
|
|
1282 |
|
|
|
1283 |
This option specifies the destination archive to be used. The following names
|
|
|
1284 |
are supported:
|
|
|
1285 |
|
|
|
1286 |
=over 8
|
|
|
1287 |
|
|
|
1288 |
=item cache
|
|
|
1289 |
|
|
|
1290 |
The location of the target archive will be taken from C<GBE_DPKG_CACHE>.
|
|
|
1291 |
|
|
|
1292 |
=item local
|
|
|
1293 |
|
|
|
1294 |
The location of the target archive will be taken from C<GBE_DPKG_LOCAL>.
|
|
|
1295 |
|
|
|
1296 |
=item main (default)
|
|
|
1297 |
|
|
|
1298 |
The location of the target archive will be taken from C<GBE_DPKG>. This is the
|
|
|
1299 |
default target archive.
|
|
|
1300 |
|
|
|
1301 |
=item store
|
|
|
1302 |
|
|
|
1303 |
The location of the target archive will be taken from C<GBE_DPKG_STORE>.
|
|
|
1304 |
|
|
|
1305 |
=item replica
|
|
|
1306 |
|
|
|
1307 |
The location of the target archive will be taken from C<GBE_DPKG_REPLICA>.
|
|
|
1308 |
|
|
|
1309 |
=item sandbox
|
|
|
1310 |
|
|
|
1311 |
The location of the target archive will be taken from C<GBE_DPKG_SBOX>.
|
|
|
1312 |
|
|
|
1313 |
=item deploy
|
|
|
1314 |
|
|
|
1315 |
The location of the target archive will be taken from C<GBE_DPLY>. This is the
|
|
|
1316 |
default target archive is a deployment package is detected.
|
|
|
1317 |
|
|
|
1318 |
=back
|
|
|
1319 |
|
|
|
1320 |
=item B<-pname=name>
|
|
|
1321 |
|
|
|
1322 |
If this option is provided, the utility will ensure that the package is named
|
|
|
1323 |
correctly.
|
|
|
1324 |
|
|
|
1325 |
=item B<-pversion=version>
|
|
|
1326 |
|
|
|
1327 |
If this option is provided, the utility will ensure that the package version is
|
|
|
1328 |
that expected.
|
|
|
1329 |
|
|
|
1330 |
=item B<-generic>
|
|
|
1331 |
|
|
|
1332 |
This option will create a built.generic file, instead of one based on the machine
|
|
|
1333 |
that actually built the package. This is used by the AutoBuilder toolchain.
|
|
|
1334 |
|
|
|
1335 |
=item B<-[no]tarmode>
|
|
|
1336 |
|
|
|
1337 |
This option will case the package to be transferred into the package archive as
|
|
|
1338 |
a tar ball. It is used by the build system.
|
|
|
1339 |
|
|
|
1340 |
=item B<-[no]md5>
|
|
|
1341 |
|
|
|
1342 |
If package builds are being merged then a validity check is performed using
|
|
|
1343 |
an MD5 digest over the current and the existing file.
|
|
|
1344 |
|
|
|
1345 |
By default, it is an error for the user file to differ from the merged file.
|
|
|
1346 |
|
|
|
1347 |
This option disabled the error. The test is still done and the results are
|
|
|
1348 |
reported.
|
|
|
1349 |
|
|
|
1350 |
=item B<-test>
|
|
|
1351 |
|
|
|
1352 |
If this option is enabled the utility will perform initial sanity testing, but
|
|
|
1353 |
it will not perform the copy.
|
|
|
1354 |
|
|
|
1355 |
=item B<-[no]info>
|
|
|
1356 |
|
|
|
1357 |
This option will cause the program to display information about the packaging
|
|
|
1358 |
process and then exit.
|
|
|
1359 |
|
|
|
1360 |
No data will be transferred to the archive.
|
|
|
1361 |
|
|
|
1362 |
=back
|
|
|
1363 |
|
|
|
1364 |
=head1 DESCRIPTION
|
|
|
1365 |
|
|
|
1366 |
This utility program is used to transfer a package that has been built into
|
|
|
1367 |
dpkg_archive. The package is then available for general consumption.
|
|
|
1368 |
|
|
|
1369 |
The utility will perform several operations in the transfer process. These incude:
|
|
|
1370 |
|
|
|
1371 |
=over 4
|
|
|
1372 |
|
|
|
1373 |
=item *
|
|
|
1374 |
|
|
|
1375 |
Create a tag file to indicate the machine that has performed the transfer
|
|
|
1376 |
|
|
|
1377 |
=item *
|
|
|
1378 |
|
|
|
1379 |
Create an XML file of files that have been transferred. This file contains information
|
|
|
1380 |
used by the build system when it releases the package, including: name, size and MD5SUM.
|
|
|
1381 |
|
|
|
1382 |
=item *
|
|
|
1383 |
|
|
|
1384 |
Detect file conflicts when different builds are merged into a single package. Header files are
|
|
|
1385 |
allowed to differ in line ending style, but other files must not conflict. The package will not be
|
|
|
1386 |
reproducible if file conflicts exist.
|
|
|
1387 |
|
|
|
1388 |
=item *
|
|
|
1389 |
|
|
|
1390 |
Suppress dead symbolic links. A valid symlink will be preserved, but invalid links will be
|
|
|
1391 |
removed from the transferred image.
|
|
|
1392 |
|
|
|
1393 |
=back
|
|
|
1394 |
|
|
|
1395 |
=head2 PACKAGE LOCATION
|
|
|
1396 |
|
|
|
1397 |
The utility will locate a package by examining the following directores for
|
|
|
1398 |
the package description file(descpkg).
|
|
|
1399 |
|
|
|
1400 |
=over 8
|
|
|
1401 |
|
|
|
1402 |
=item ./build/deploy
|
|
|
1403 |
|
|
|
1404 |
This format is generated by the deployment builds. The default target archive
|
|
|
1405 |
will be taken from the environment variable GBE_DPLY.
|
|
|
1406 |
|
|
|
1407 |
=item ./pkg
|
|
|
1408 |
|
|
|
1409 |
This format is generated by JATS builds.
|
|
|
1410 |
|
|
|
1411 |
=item ./build/pkg
|
|
|
1412 |
|
|
|
1413 |
This format is generated by ANT builds.
|
|
|
1414 |
|
|
|
1415 |
=back
|
|
|
1416 |
|
|
|
1417 |
The program should be run in the same directory as the build control files as
|
|
|
1418 |
the package subdirectory will be created in that directory.
|
|
|
1419 |
|
|
|
1420 |
=head1 EXAMPLE
|
|
|
1421 |
|
|
|
1422 |
=head2 jats create_dpkg
|
|
|
1423 |
|
|
|
1424 |
This will locate a generated package and install it into the dpkg_archive repository.
|
|
|
1425 |
|
|
|
1426 |
=cut
|
|
|
1427 |
|