Context Navigation

source: ProjectBuilder/devel/pb/bin/pb@ 492

Last change on this file since 492 was 492, checked in by Bruno Cornec, 16 years ago
Fix a bug on script2vm which wasn't working anymore. Makes script execution verbose
Property svn:executable set to ``*
File size: 64.3 KB

Line
1	#!/usr/bin/perl -w
2	#
3	# Project Builder main application
4	#
5	# $Id$
6	#
7	# Copyright B. Cornec 2007
8	# Provided under the GPL v2
9
10	# Syntax: see at end
11
12	use strict 'vars';
13	use Getopt::Long qw(:config auto_abbrev no_ignore_case);
14	use Data::Dumper;
15	use English;
16	use File::Basename;
17	use File::Copy;
18	use File::stat;
19	use File::Temp qw(tempdir);
20	use POSIX qw(strftime);
21	use lib qw (lib);
22	use ProjectBuilder::Version;
23	use ProjectBuilder::Base;
24	use ProjectBuilder::Conf;
25	use ProjectBuilder::Distribution;
26	use ProjectBuilder::CMS;
27	use ProjectBuilder::Env;
28	use ProjectBuilder::Filter;
29	use ProjectBuilder::Changelog;
30
31	# For announce only
32	use DBI;
33	use Mail::Sendmail;
34
35	# Global variables
36	my %opts; # CLI Options
37	my $action; # action to realize
38	my $test = "FALSE"; # Not used
39	my $force = 0; # Force VE/VM rebuild
40	my $option = ""; # Not used
41	my @pkgs; # list of packages
42	my $pbtag; # Global Tag variable
43	my $pbver; # Global Version variable
44	my $pbscript; # Name of the script
45	my %pbver; # per package
46	my %pbtag; # per package
47	my $pbrev; # Global REVISION variable
48	my $pbaccount; # Login to use to connect to the VM
49	my $pbport; # Port to use to connect to the VM
50	my $newver; # New version to create
51	my $iso; # ISO image for the VM to create
52
53	my @date = pb_get_date();
54	my $pbdate = strftime("%Y-%m-%d", @date);
55
56	=pod
57
58	=head1 NAME
59
60	pb, aka project-builder.org - builds packages for your projects
61
62	=head1 DESCRIPTION
63
64	pb helps you build various packages directly from your project sources.
65	Those sources could be handled by a CMS (Configuration Management System)
66	such as Subversion, CVS, ... or being a simple reference to a compressed tar file.
67	It's based on a set of configuration files, a set of provided macros to help
68	you keeping build files as generic as possible. For example, a single .spec
69	file should be required to generate for all rpm based distributions, even
70	if you could also have multiple .spec files if required.
71
72	=head1 SYNOPSIS
73
74	pb [-vhq][-r pbroot][-p project][[-s script -a account -P port][-m mach-1[,...]]][-i iso] <action> [<pkg1> ...]
75
76	pb [--verbose][--help][--man][--quiet][--revision pbroot][--project project][[--script script --account account --port port][--machine mach-1[,...]]][--iso iso] <action> [<pkg1> ...]
77
78	=head1 OPTIONS
79
80	=over 4
81
82	=item B<-v\|--verbose>
83
84	Print a brief help message and exits.
85
86	=item B<-q\|--quiet>
87
88	Do not print any output.
89
90	=item B<-h\|--help>
91
92	Print a brief help message and exits.
93
94	=item B<--man>
95
96	Prints the manual page and exits.
97
98	=item B<-m\|--machine machine1[,machine2,...]>
99
100	Name of the Virtual Machines (VM) or Virtual Environments (VE) you want to build on (coma separated).
101	All if none precised (or use the env variable PBV).
102
103	=item B<-s\|--script script>
104
105	Name of the script you want to execute on the related VMs or VEs.
106
107	=item B<-i\|--iso iso_image>
108
109	Name of the ISO image of the distribution you want to install on the related VMs.
110
111	=item B<-a\|--account account>
112
113	Name of the account to use to connect on the related VMs.
114
115	=item B<-P\|--port port_number>
116
117	Port number to use to connect on the related VMs.\n";
118
119	=item B<-p\|--project project_name>
120
121	Name of the project you're working on (or use the env variable PBPROJ)
122
123	=item B<-r\|--revision revision>
124
125	Path Name of the project revision under the CMS (or use the env variable PBROOT)
126
127	=item B<-V\|--version new_version>
128
129	New version of the project to create based on the current one.
130
131	=back
132
133	=head1 ARGUMENTS
134
135	<action> can be:
136
137	=over 4
138
139	=item B<cms2build>
140
141	Create tar files for the project under your CMS.
142	CMS supported are SVN and CVS
143	parameters are packages to build
144	if not using default list
145
146	=item B<build2pkg>
147
148	Create packages for your running distribution
149
150	=item B<cms2pkg>
151
152	cms2build + build2pkg
153
154	=item B<build2ssh>
155
156	Send the tar files to a SSH host
157
158	=item B<cms2ssh>
159
160	cms2build + build2ssh
161
162	=item B<pkg2ssh>
163
164	Send the packages built to a SSH host
165
166	=item B<build2vm>
167
168	Create packages in VMs, launching them if needed
169	and send those packages to a SSH host once built
170	VM type supported are QEMU
171
172	=item B<build2ve>
173
174	Create packages in VEs, creating it if needed
175	and send those packages to a SSH host once built
176
177	=item B<cms2vm>
178
179	cms2build + build2vm
180
181	=item B<cms2ve>
182
183	cms2build + build2ve
184
185	=item B<launchvm>
186
187	Launch one virtual machine
188
189	=item B<launchve>
190
191	Launch one virtual environment
192
193	=item B<script2vm>
194
195	Launch one virtual machine if needed
196	and executes a script on it
197
198	=item B<script2ve>
199
200	Execute a script in a virtual environment
201
202	=item B<newvm>
203
204	Create a new virtual machine
205
206	=item B<newve>
207
208	Create a new virtual environment
209
210	=item B<setupvm>
211
212	Setup a virtual machine for pb usage
213
214	=item B<setupve>
215
216	Setup a virtual environment for pb usage
217
218	=item B<newver>
219
220	Create a new version of the project derived
221	from the current one
222
223	=item B<newproj>
224
225	Create a new project and a template set of
226	configuration files under pbconf
227
228	=item B<announce>
229
230	Announce the availability of the project through various means
231
232	=back
233
234	<pkgs> can be a list of packages, the keyword 'all' or nothing, in which case the default list of packages is taken (corresponding to the defpkgdir list of arguments in the configuration file).
235
236	=head1 WEB SITES
237
238	The main Web site of the project is available at L<http://www.project-builder.org/>. Bug reports should be filled using the trac instance of the project at L<http://trac.project-builder.org/>.
239
240	=head1 USER MAILING LIST
241
242	None exists for the moment.
243
244	=head1 CONFIGURATION FILES
245
246	Each pb user may have a configuration in F<$HOME/.pbrc>. The values in this file may overwrite any other configuration file value.
247
248	Here is an example of such a configuration file:
249
250	#
251	# Define for each project the URL of its pbconf repository
252	# No default option allowed here as they need to be all different
253	#
254	# URL of the pbconf content
255	# This is the format of a classical URL with the extension of additional schema such as
256	# svn+ssh, cvs+ssh, ...
257	#
258	pbconfurl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe/pbconf
259
260	# This is normaly defined in the project's configuration file
261	# Url of the project
262	#
263	pburl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe
264
265	# All these URLs needs to be defined here as the are the entry point
266	# for how to build packages for the project
267	#
268	pbconfurl pb = svn+ssh://svn.project-builder.org/mondo/svn/pb/pbconf
269	pbconfurl mondorescue = svn+ssh://svn.project-builder.org/mondo/svn/project-builder/mondorescue/pbconf
270	pbconfurl collectl = svn+ssh://bruno@svn.mondorescue.org/mondo/svn/project-builder/collectl/pbconf
271	pbconfurl netperf = svn+ssh://svn.mondorescue.org/mondo/svn/project-builder/netperf/pbconf
272
273	# Under that dir will take place everything related to pb
274	# If you want to use VMs/chroot/..., then use $ENV{'HOME'} to make it portable
275	# to your VMs/chroot/...
276	# if not defined then /var/cache
277	pbdefdir default = $ENV{'HOME'}/project-builder
278	pbdefdir pb = $ENV{'HOME'}
279	pbdefdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
280	pbdefdir mondorescue = $ENV{'HOME'}/mondo/svn
281
282	# pbconfdir points to the directory where the CMS content of the pbconfurl is checked out
283	# If not defined, pbconfdir is under pbdefdir/pbproj/pbconf
284	pbconfdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs/pbconf
285	pbconfdir mondorescue = $ENV{'HOME'}/mondo/svn/pbconf
286
287	# pbdir points to the directory where the CMS content of the pburl is checked out
288	# If not defined, pbdir is under pbdefdir/pbproj
289	# Only defined if we have access to the dev of the project
290	pbdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
291	pbdir mondorescue = $ENV{'HOME'}/mondo/svn
292
293	# -daemonize doesn't work with qemu 0.8.2
294	vmopt default = -m 384
295
296	=head1 AUTHORS
297
298	The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
299
300	=head1 COPYRIGHT
301
302	Project-Builder.org is distributed under the GPL v2.0 license
303	described in the file C<COPYING> included with the distribution.
304
305	=cut
306
307	# ---------------------------------------------------------------------------
308
309	# Old syntax
310	#getopts('a:fhi:l:m:P:p:qr:s:vV:',\%opts);
311
312	my ($projectbuilderver,$projectbuilderrev) = pb_version_init();
313
314	# Initialize the syntax string
315
316	pb_syntax_init("pb (aka project-builder.org) Version $projectbuilderver-$projectbuilderrev\n");
317
318	GetOptions("help\|?\|h" => \$opts{'h'},
319	"man" => \$opts{'man'},
320	"verbose\|v+" => \$opts{'v'},
321	"quiet\|q" => \$opts{'q'},
322	"log-files\|l=s" => \$opts{'l'},
323	"force\|f" => \$opts{'f'},
324	"account\|a=s" => \$opts{'a'},
325	"revision\|r=s" => \$opts{'r'},
326	"script\|s=s" => \$opts{'s'},
327	"machines\|mock\|m=s" => \$opts{'m'},
328	"port\|P=i" => \$opts{'P'},
329	"project\|p=s" => \$opts{'p'},
330	"iso\|i=s" => \$opts{'i'},
331	"version\|V=s" => \$opts{'V'},
332	) \|\| pb_syntax(-1,0);
333
334	if (defined $opts{'h'}) {
335	pb_syntax(0,1);
336	}
337	if (defined $opts{'man'}) {
338	pb_syntax(0,2);
339	}
340	if (defined $opts{'v'}) {
341	$debug = $opts{'v'};
342	}
343	if (defined $opts{'f'}) {
344	$force=1;
345	}
346	if (defined $opts{'q'}) {
347	$debug=-1;
348	}
349	if (defined $opts{'l'}) {
350	open(LOG,"> $opts{'l'}") \|\| die "Unable to log to $opts{'l'}: $!";
351	$LOG = \*LOG;
352	$debug = 0 if ($debug == -1);
353	}
354	pb_log_init($debug, $LOG);
355
356	# Handle root of the project if defined
357	if (defined $opts{'r'}) {
358	$ENV{'PBROOTDIR'} = $opts{'r'};
359	}
360	# Handle virtual machines if any
361	if (defined $opts{'m'}) {
362	$ENV{'PBV'} = $opts{'m'};
363	}
364	if (defined $opts{'s'}) {
365	$pbscript = $opts{'s'};
366	}
367	if (defined $opts{'a'}) {
368	$pbaccount = $opts{'a'};
369	die "option -a requires a -s script option" if (not defined $pbscript);
370	}
371	if (defined $opts{'P'}) {
372	$pbport = $opts{'P'};
373	}
374	if (defined $opts{'V'}) {
375	$newver = $opts{'V'};
376	}
377	if (defined $opts{'i'}) {
378	$iso = $opts{'i'};
379	}
380
381	# Get Action
382	$action = shift @ARGV;
383	die pb_syntax(-1,1) if (not defined $action);
384
385	my ($filteredfiles, $supfiles, $defpkgdir, $extpkgdir);
386	my $pbinit = undef;
387	$pbinit = 1 if ($action =~ /^newproj$/);
388
389	# Handles project name if any
390	# And get global params
391	($filteredfiles, $supfiles, $defpkgdir, $extpkgdir) = pb_env_init($opts{'p'},$pbinit,$action);
392
393	pb_log(0,"Project: $ENV{'PBPROJ'}\n");
394	pb_log(0,"Action: $action\n");
395
396	# Act depending on action
397	if ($action =~ /^cms2build$/) {
398	pb_cms2build();
399	} elsif ($action =~ /^build2pkg$/) {
400	pb_build2pkg();
401	} elsif ($action =~ /^cms2pkg$/) {
402	pb_cms2build();
403	pb_build2pkg();
404	} elsif ($action =~ /^build2ssh$/) {
405	pb_build2ssh();
406	} elsif ($action =~ /^cms2ssh$/) {
407	pb_cms2build();
408	pb_build2ssh();
409	} elsif ($action =~ /^pkg2ssh$/) {
410	pb_pkg2ssh();
411	} elsif ($action =~ /^build2ve$/) {
412	pb_build2v("ve");
413	} elsif ($action =~ /^build2vm$/) {
414	pb_build2v("vm");
415	} elsif ($action =~ /^cms2ve$/) {
416	pb_cms2build();
417	pb_build2v("ve");
418	} elsif ($action =~ /^cms2vm$/) {
419	pb_cms2build();
420	pb_build2v("vm");
421	} elsif ($action =~ /^launchvm$/) {
422	pb_launchv("vm",$ENV{'PBV'},0);
423	} elsif ($action =~ /^launchve$/) {
424	pb_launchv("ve",$ENV{'PBV'},0);
425	} elsif ($action =~ /^script2vm$/) {
426	pb_script2v($pbscript,"vm");
427	} elsif ($action =~ /^script2ve$/) {
428	pb_script2v($pbscript,"ve");
429	} elsif ($action =~ /^newver$/) {
430	pb_newver();
431	} elsif ($action =~ /^newve$/) {
432	pb_launchv("ve",$ENV{'PBV'},1);
433	} elsif ($action =~ /^newvm$/) {
434	pb_launchv("vm",$ENV{'PBV'},1);
435	} elsif ($action =~ /^setupve$/) {
436	pb_setup_v("ve");
437	} elsif ($action =~ /^setupvm$/) {
438	pb_setup_v("vm");
439	} elsif ($action =~ /^newproj$/) {
440	# Nothing to do - already done in pb_env_init
441	} elsif ($action =~ /^clean$/) {
442	# TBC
443	} elsif ($action =~ /^announce$/) {
444	pb_announce();
445	} else {
446	pb_log(0,"\'$action\' is not available\n");
447	pb_syntax(-2,1);
448	}
449
450	sub pb_cms2build {
451
452	my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
453	my @pkgs = @$pkg;
454	my %pkgs;
455
456	my ($scheme, $uri) = pb_cms_init($pbinit);
457
458	my ($pkgv, $pkgt) = pb_conf_get_if("pkgver","pkgtag");
459
460	# declare packager and repo for filtering
461	my ($tmp1, $tmp2) = pb_conf_get("pbpackager","pbrepo");
462	$ENV{'PBPACKAGER'} = $tmp1->{$ENV{'PBPROJ'}};
463	$ENV{'PBREPO'} = $tmp2->{$ENV{'PBPROJ'}};
464
465	foreach my $pbpkg (@pkgs) {
466	$ENV{'PBPKG'} = $pbpkg;
467	if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
468	$pbver = $pkgv->{$pbpkg};
469	} else {
470	$pbver = $ENV{'PBPROJVER'};
471	}
472	if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
473	$pbtag = $pkgt->{$pbpkg};
474	} else {
475	$pbtag = $ENV{'PBPROJTAG'};
476	}
477
478	$pbrev = $ENV{'PBREVISION'};
479	pb_log(0,"\n");
480	pb_log(0,"Management of $pbpkg $pbver-$pbtag (rev $pbrev)\n");
481	die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
482	# Clean up dest if necessary. The export will recreate it
483	my $dest = "$ENV{'PBDESTDIR'}/$pbpkg-$pbver";
484	pb_rm_rf($dest) if (-d $dest);
485
486	# Export CMS tree for the concerned package to dest
487	# And generate some additional files
488	$OUTPUT_AUTOFLUSH=1;
489
490	# computes in which dir we have to work
491	my $dir = $defpkgdir->{$pbpkg};
492	$dir = $extpkgdir->{$pbpkg} if (not defined $dir);
493	pb_log(2,"def:".Dumper($defpkgdir)." ext: ".Dumper($extpkgdir)." \n");
494
495	# Exporting from CMS
496	pb_cms_export($uri,"$ENV{'PBDIR'}/$dir",$dest);
497
498	# Generated fake content for test versions to speed up stuff
499	my ($testver) = pb_conf_get_if("testver");
500	my $chglog;
501
502	# Get project info on authors and log file
503	$chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
504	$chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
505	$chglog = undef if (! -f $chglog);
506
507	my $authors = "$ENV{'PBROOTDIR'}/$pbpkg/pbauthors";
508	$authors = "$ENV{'PBROOTDIR'}/pbauthors" if (! -f $authors);
509	$authors = "/dev/null" if (! -f $authors);
510
511	# Extract cms log history and store it
512	if ((defined $chglog) && (! -f "$dest/NEWS")) {
513	pb_log(2,"Generating NEWS file from $chglog\n");
514	copy($chglog,"$dest/NEWS") \|\| die "Unable to create $dest/NEWS";
515	}
516	pb_cms_log($scheme,"$ENV{'PBDIR'}/$dir",$dest,$chglog,$authors,$testver);
517
518	my %build;
519	my @pt;
520	my $tmpl = "";
521
522	@pt = pb_conf_get_if("vmlist","velist");
523	if (defined $pt[0]->{$ENV{'PBPROJ'}}) {
524	$tmpl .= $pt[0]->{$ENV{'PBPROJ'}};
525	}
526	if (defined $pt[1]->{$ENV{'PBPROJ'}}) {
527	# the 2 lists needs to be grouped with a ',' separated them
528	if ($tmpl ne "") {
529	$tmpl .= ",";
530	}
531	$tmpl .= $pt[1]->{$ENV{'PBPROJ'}}
532	}
533	foreach my $d (split(/,/,$tmpl)) {
534	my ($name,$ver,$arch) = split(/-/,$d);
535	chomp($arch);
536	my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($name,$ver);
537	pb_log(2,"DEBUG: distro tuple: ".Dumper($ddir, $dver, $dfam, $dtype, $pbsuf)."\n");
538	pb_log(2,"DEBUG Filtering PBDATE => $pbdate, PBTAG => $pbtag, PBVER => $pbver\n");
539
540	# Filter build files from the less precise up to the most with overloading
541	# Filter all files found, keeping the name, and generating in dest
542
543	# Find all build files first relatively to PBROOTDIR
544	# Find also all specific files referenced in the .pb conf file
545	my %bfiles = ();
546	my %pkgfiles = ();
547	$build{"$ddir-$dver"} = "yes";
548
549	if (-d "$ENV{'PBROOTDIR'}/$pbpkg/$dtype") {
550	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$dtype",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
551	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$dfam") {
552	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$dfam",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
553	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir") {
554	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
555	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver") {
556	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
557	} else {
558	$build{"$ddir-$dver"} = "no";
559	next;
560	}
561	pb_log(2,"DEBUG bfiles: ".Dumper(\%bfiles)."\n");
562
563	# Get all filters to apply
564	my $ptr = pb_get_filters($pbpkg, $dtype, $dfam, $ddir, $dver);
565
566	# Apply now all the filters on all the files concerned
567	# destination dir depends on the type of file
568	if (defined $ptr) {
569	foreach my $f (values %bfiles,values %pkgfiles) {
570	pb_filter_file_pb("$ENV{'PBROOTDIR'}/$f",$ptr,"$dest/pbconf/$ddir-$dver/".basename($f),$dtype,$pbsuf,$pbpkg,$pbver,$pbtag,$pbrev,$pbdate,$defpkgdir,$extpkgdir,$ENV{'PBPACKAGER'},$chglog,$ENV{'PBPROJ'},$ENV{'PBREPO'});
571	}
572	}
573	}
574	my @found;
575	my @notfound;
576	foreach my $b (keys %build) {
577	push @found,$b if ($build{$b} =~ /yes/);
578	push @notfound,$b if ($build{$b} =~ /no/);
579	}
580	pb_log(0,"Build files generated for ".join(',',sort(@found))."\n");
581	pb_log(0,"No Build files found for ".join(',',sort(@notfound))."\n") if (@notfound);
582	# Get the generic filter (all.pbf) and
583	# apply those to the non-build files including those
584	# generated by pbinit if applicable
585
586	# Get only all.pbf filter
587	my $ptr = pb_get_filters($pbpkg);
588
589	my $liste ="";
590	if (defined $filteredfiles->{$pbpkg}) {
591	foreach my $f (split(/,/,$filteredfiles->{$pbpkg})) {
592	pb_filter_file_inplace($ptr,"$dest/$f",$pbpkg,$pbver,$pbtag,$pbrev,$pbdate,$ENV{'PBPACKAGER'},$ENV{'PBPROJ'},$ENV{'PBREPO'});
593	$liste = "$f $liste";
594	}
595	}
596	pb_log(2,"Files ".$liste."have been filtered\n");
597
598	# Prepare the dest directory for archive
599	if (-x "$ENV{'PBROOTDIR'}/$pbpkg/pbinit") {
600	pb_filter_file("$ENV{'PBROOTDIR'}/$pbpkg/pbinit",$ptr,"$ENV{'PBTMP'}/pbinit",$pbpkg,$pbver,$pbtag,$pbrev,$pbdate,$ENV{'PBPACKAGER'},$ENV{'PBPROJ'},$ENV{'PBREPO'});
601	chmod 0755,"$ENV{'PBTMP'}/pbinit";
602	pb_system("cd $dest ; $ENV{'PBTMP'}/pbinit","Executing init script from $ENV{'PBROOTDIR'}/$pbpkg/pbinit","verbose");
603	}
604
605	# Archive dest dir
606	chdir "$ENV{'PBDESTDIR'}" \|\| die "Unable to change dir to $ENV{'PBDESTDIR'}";
607	# Possibility to look at PBSRC to guess more the filename
608	pb_system("tar cfz $pbpkg-$pbver.tar.gz $pbpkg-$pbver","Creating $pbpkg tar files compressed");
609	pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz\n");
610
611	# Keep track of version-tag per pkg
612	$pkgs{$pbpkg} = "$pbver-$pbtag";
613
614	# Final cleanup
615	pb_rm_rf($dest) if (-d $dest);
616	}
617
618	# Keep track of per package version
619	pb_log(2,"DEBUG pkgs: ".Dumper(%pkgs)."\n");
620	open(PKG,"> $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb") \|\| die "Unable to create $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb";
621	foreach my $pbpkg (@pkgs) {
622	print PKG "pbpkg $pbpkg = $pkgs{$pbpkg}\n";
623	}
624	close(PKG);
625
626	# Keep track of what is generated by default
627	# We need to store the dir and info on version-tag
628	# Base our content on the existing .pb file
629	copy("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb","$ENV{'PBDESTDIR'}/pbrc");
630	open(LAST,">> $ENV{'PBDESTDIR'}/pbrc") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbrc";
631	print LAST "pbroot $ENV{'PBPROJ'} = $ENV{'PBROOTDIR'}\n";
632	print LAST "pbprojver $ENV{'PBPROJ'} = $ENV{'PBPROJVER'}\n";
633	print LAST "pbprojtag $ENV{'PBPROJ'} = $ENV{'PBPROJTAG'}\n";
634	print LAST "pbpackager $ENV{'PBPROJ'} = $ENV{'PBPACKAGER'}\n";
635	close(LAST);
636	}
637
638	sub pb_build2pkg {
639
640	# Get the running distro to build on
641	my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init();
642	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n");
643
644	# Get list of packages to build
645	# Get content saved in cms2build
646	my $ptr = pb_get_pkg();
647	@pkgs = @$ptr;
648
649	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
650	$pkg = { } if (not defined $pkg);
651
652	chdir "$ENV{'PBBUILDDIR'}";
653	my $made = ""; # pkgs made during build
654	foreach my $pbpkg (@pkgs) {
655	my $vertag = $pkg->{$pbpkg};
656	# get the version of the current package - maybe different
657	($pbver,$pbtag) = split(/-/,$vertag);
658
659	my $src="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz";
660	pb_log(2,"Source file: $src\n");
661
662	pb_log(2,"Working directory: $ENV{'PBBUILDDIR'}\n");
663	if ($dtype eq "rpm") {
664	foreach my $d ('RPMS','SRPMS','SPECS','SOURCES','BUILD') {
665	if (! -d "$ENV{'PBBUILDDIR'}/$d") {
666	pb_mkdir_p("$ENV{'PBBUILDDIR'}/$d") \|\| die "Please ensure that you can write into $ENV{'PBBUILDDIR'} to create $d\nchown the $ENV{'PBBUILDDIR'} directory to your uid";
667	}
668	}
669
670	# Remove in case a previous link/file was there
671	unlink "$ENV{'PBBUILDDIR'}/SOURCES/".basename($src);
672	symlink "$src","$ENV{'PBBUILDDIR'}/SOURCES/".basename($src) \|\| die "Unable to symlink $src in $ENV{'PBBUILDDIR'}/SOURCES";
673	# We need to first extract the spec file
674	my @specfile;
675	@specfile = pb_extract_build_files($src,"$pbpkg-$pbver/pbconf/$ddir-$dver/","$ENV{'PBBUILDDIR'}/SPECS");
676
677	pb_log(2,"specfile: ".Dumper(\@specfile)."\n");
678	# set LANGUAGE to check for correct log messages
679	$ENV{'LANGUAGE'}="C";
680	# Older Redhat use _target_platform in %configure incorrectly
681	my $specialdef = "";
682	if (($ddir eq "redhat") \|\| (($ddir eq "rhel") && ($dver eq "2.1"))) {
683	$specialdef = "--define \'_target_platform \"\"\'";
684	}
685	foreach my $f (@specfile) {
686	if ($f =~ /\.spec$/) {
687	pb_system("rpmbuild $specialdef --define \'packager $ENV{'PBPACKAGER'}\' --define \"_topdir $ENV{'PBBUILDDIR'}\" -ba $f","Building package with $f under $ENV{'PBBUILDDIR'}","verbose");
688	last;
689	}
690	}
691	$made="$made RPMS//$pbpkg-$pbver-$pbtag$pbsuf..rpm SRPMS/$pbpkg-$pbver-$pbtag$pbsuf.src.rpm";
692	if (-f "/usr/bin/rpmlint") {
693	pb_system("rpmlint $made","Checking validity of rpms with rpmlint","verbose");
694	}
695	} elsif ($dtype eq "deb") {
696	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
697	pb_system("tar xfz $src","Extracting sources");
698
699	chdir "$pbpkg-$pbver" \|\| die "Unable to chdir to $pbpkg-$pbver";
700	pb_rm_rf("debian");
701	symlink "pbconf/$ddir-$dver","debian" \|\| die "Unable to symlink to pbconf/$ddir-$dver";
702	chmod 0755,"debian/rules";
703	if ($dver !~ /[0-9]/) {
704	# dpkg-deb doesn't accept non digit versions. removing checks
705	# dpkg-source checks upper case when generating perl modules
706	}
707	pb_system("dpkg-buildpackage -us -uc -rfakeroot","Building package");
708	$made="$made $pbpkg"."_.deb $pbpkg"."_.dsc $pbpkg"."_*.tar.gz";
709	if (-f "/usr/bin/lintian") {
710	pb_system("lintian $made","Checking validity of debs with lintian");
711	}
712	} elsif ($dtype eq "ebuild") {
713	my @ebuildfile;
714	# For gentoo we need to take pb as subsystem name
715	# We put every apps here under sys-apps. hope it's correct
716	# We use pb's home dir in order to have a single OVERLAY line
717	my $tmpd = "$ENV{'HOME'}/portage/pb/sys-apps/$pbpkg";
718	pb_mkdir_p($tmpd) if (! -d "$tmpd");
719	pb_mkdir_p("$ENV{'HOME'}/portage/distfiles") if (! -d "$ENV{'HOME'}/portage/distfiles");
720
721	# We need to first extract the ebuild file
722	@ebuildfile = pb_extract_build_files($src,"$pbpkg-$pbver/pbconf/$ddir-$dver/","$tmpd");
723
724	# Prepare the build env for gentoo
725	my $found = 0;
726	my $pbbd = $ENV{'HOME'};
727	$pbbd =~ s\|/\|\\/\|g;
728	if (-r "/etc/make.conf") {
729	open(MAKE,"/etc/make.conf");
730	while (<MAKE>) {
731	$found = 1 if (/$pbbd\/portage/);
732	}
733	close(MAKE);
734	}
735	if ($found == 0) {
736	pb_system("sudo sh -c 'echo PORTDIR_OVERLAY=\"$ENV{'HOME'}/portage\" >> /etc/make.conf'");
737	}
738	#$found = 0;
739	#if (-r "/etc/portage/package.keywords") {
740	#open(KEYW,"/etc/portage/package.keywords");
741	#while (<KEYW>) {
742	#$found = 1 if (/portage\/pb/);
743	#}
744	#close(KEYW);
745	#}
746	#if ($found == 0) {
747	#pb_system("sudo sh -c \"echo portage/pb >> /etc/portage/package.keywords\"");
748	#}
749
750	# Build
751	foreach my $f (@ebuildfile) {
752	if ($f =~ /\.ebuild$/) {
753	move($f,"$tmpd/$pbpkg-$pbver.ebuild");
754	pb_system("cd $tmpd ; ebuild $pbpkg-$pbver.ebuild clean ; ebuild $pbpkg-$pbver.ebuild digest ; ebuild $pbpkg-$pbver.ebuild package");
755	# Now move it where pb expects it
756	pb_mkdir_p("$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
757	move("$tmpd/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
758	}
759	}
760
761	$made="$made portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver.ebuild";
762	} elsif ($dtype eq "tgz") {
763	# Slackware family
764	$made="$made $pbpkg/$pbpkg-$pbver-*-$pbtag.tgz";
765
766	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
767	pb_system("tar xfz $src","Extracting sources");
768	chdir "$pbpkg-$pbver" \|\| die "Unable to chdir to $pbpkg-$pbver";
769	symlink "pbconf/$ddir-$dver","install" \|\| die "Unable to symlink to pbconf/$ddir-$dver";
770	if (-x "install/pbslack") {
771	pb_system("./install/pbslack","Building package");
772	pb_system("sudo /sbin/makepkg -p -l y -c y $pbpkg","Packaging $pbpkg");
773	}
774	} else {
775	die "Unknown dtype format $dtype";
776	}
777	}
778	# Keep track of what is generated so that we can get them back from VMs
779	open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to create $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
780	print KEEP "$made\n";
781	close(KEEP);
782	}
783
784	sub pb_build2ssh {
785	pb_send2target("Sources");
786	}
787
788	sub pb_pkg2ssh {
789	pb_send2target("Packages");
790	}
791
792	# By default deliver to the the public site hosting the
793	# ftp structure (or whatever) or a VM/VE
794	sub pb_send2target {
795
796	my $cmt = shift;
797	my $v = shift \|\| undef;
798	my $vmexist = shift \|\| 0; # 0 is FALSE
799	my $vmpid = shift \|\| 0; # 0 is FALSE
800
801	pb_log(2,"DEBUG: pb_send2target($cmt,".Dumper($v).",$vmexist,$vmpid)\n");
802	my $host = "sshhost";
803	my $login = "sshlogin";
804	my $dir = "sshdir";
805	my $port = "sshport";
806	my $conf = "sshconf";
807	my $rebuild = "sshrebuild";
808	my $tmout = "vmtmout";
809	my $path = "vmpath";
810	if (($cmt eq "vm") \|\| ($cmt eq "Script")) {
811	$login = "vmlogin";
812	$dir = "pbdefdir";
813	$tmout = "vmtmout";
814	$rebuild = "vmrebuild";
815	# Specific VM
816	$host = "vmhost";
817	$port = "vmport";
818	} elsif ($cmt eq "ve") {
819	$login = "velogin";
820	$dir = "pbdefdir";
821	$tmout = "vetmout";
822	# Specific VE
823	$path = "vepath";
824	$conf = "veconf";
825	$rebuild = "verebuild";
826	}
827	my $cmd = "";
828	my $src = "";
829	my ($odir,$over,$oarch) = (undef, undef, undef);
830	my ($ddir, $dver, $dfam, $dtype, $pbsuf);
831
832	if ($cmt ne "Announce") {
833	my $ptr = pb_get_pkg();
834	@pkgs = @$ptr;
835
836	# Get the running distro to consider
837	if (defined $v) {
838	($odir,$over,$oarch) = split(/-/,$v);
839	}
840	($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($odir,$over);
841	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n");
842
843	# Get list of packages to build
844	# Get content saved in cms2build
845	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
846	$pkg = { } if (not defined $pkg);
847
848	chdir "$ENV{'PBBUILDDIR'}";
849	foreach my $pbpkg (@pkgs) {
850	my $vertag = $pkg->{$pbpkg};
851	# get the version of the current package - maybe different
852	($pbver,$pbtag) = split(/-/,$vertag);
853
854	if (($cmt eq "Sources") \|\| ($cmt eq "vm") \|\| ($cmt eq "ve")) {
855	$src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz";
856	if ($cmd eq "") {
857	$cmd = "ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
858	} else {
859	$cmd = "$cmd ; ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
860	}
861	}
862	}
863	# Adds conf file for availability of conf elements
864	pb_conf_add("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb");
865	}
866
867	if (($cmt eq "vm") \|\| ($cmt eq "ve")) {
868	$src="$src $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc $ENV{'PBDESTDIR'}/pbscript";
869	} elsif ($cmt eq "Script") {
870	$src="$src $ENV{'PBDESTDIR'}/pbscript";
871	} elsif ($cmt eq "Announce") {
872	$src="$src $ENV{'PBTMP'}/pbscript";
873	} elsif ($cmt eq "Packages") {
874	# Get package list from file made during build2pkg
875	open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
876	$src = <KEEP>;
877	chomp($src);
878	close(KEEP);
879	$src="$src $ENV{'PBBUILDDIR'}/pbscript" if ($cmt ne "Sources");
880	}
881	# Remove potential leading spaces (cause problem with basename)
882	$src =~ s/^ *//;
883	my $basesrc = "";
884	foreach my $i (split(/ +/,$src)) {
885	$basesrc .= " ".basename($i);
886	}
887
888	pb_log(0,"Sources handled ($cmt): $src\n");
889	pb_log(2,"values: ".Dumper(($host,$login,$dir,$port,$tmout,$rebuild,$path,$conf))."\n");
890	my ($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vepath) = pb_conf_get($host,$login,$dir,$port,$tmout,$path);
891	my ($vrebuild,$veconf) = pb_conf_get_if($rebuild,$conf);
892	pb_log(2,"ssh: ".Dumper(($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vrebuild,$vepath,$veconf))."\n");
893	# Not mandatory
894	my ($testver) = pb_conf_get_if("testver");
895
896	my $mac;
897	# Useless for VE
898	if ($cmt ne "ve") {
899	$mac = "$sshlogin->{$ENV{'PBPROJ'}}\@$sshhost->{$ENV{'PBPROJ'}}";
900	# Overwrite account value if passed as parameter
901	$mac = "$pbaccount\@$sshhost->{$ENV{'PBPROJ'}}" if (defined $pbaccount);
902	pb_log(2, "DEBUG: pbaccount: $pbaccount => mac: $mac\n") if (defined $pbaccount);
903	}
904
905	my $tdir;
906	my $bdir;
907	if (($cmt eq "Sources") \|\| ($cmt eq "Script")) {
908	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/src";
909	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
910	# This is a test pkg => target dir is under test
911	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/test/src";
912	}
913	} elsif (($cmt eq "vm") \|\| ($cmt eq "ve")) {
914	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/delivery";
915	$bdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/build";
916	# Remove a potential $ENV{'HOME'} as bdir should be relative to pb's home
917	$bdir =~ s\|\$ENV.+\}/\|\|;
918	} elsif ($cmt eq "Announce") {
919	$tdir = "$sshdir->{$ENV{'PBPROJ'}}";
920	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
921	# This is a test pkg => target dir is under test
922	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/test";
923	}
924	} elsif ($cmt eq "Packages") {
925	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ddir/$dver";
926
927	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
928	# This is a test pkg => target dir is under test
929	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/test/$ddir/$dver";
930	}
931
932	my $repodir = $tdir;
933	$repodir =~ s\|^$sshdir->{$ENV{'PBPROJ'}}/\|\|;
934
935	my ($pbrepo) = pb_conf_get("pbrepo");
936
937	# Repository management
938	open(PBS,"> $ENV{'PBBUILDDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBBUILDDIR'}/pbscript";
939	if ($dtype eq "rpm") {
940	# Also make a pbscript to generate yum/urpmi bases
941	print PBS << "EOF";
942	#!/bin/bash
943	# Prepare a script to ease yum setup
944	cat > $ENV{'PBPROJ'}.repo << EOT
945	[$ENV{'PBPROJ'}]
946	name=$ddir $dver - $ENV{'PBPROJ'} Vanilla Packages
947	baseurl=$pbrepo->{$ENV{'PBPROJ'}}/$repodir
948	enabled=1
949	gpgcheck=0
950	EOT
951	chmod 644 $ENV{'PBPROJ'}.repo
952
953	# Clean up old repo content
954	rm -rf headers/ repodata/
955	# Create yum repo
956	yum-arch .
957	# Create repodata
958	createrepo .
959	EOF
960	if ($dfam eq "md") {
961	# For Mandriva add urpmi management
962	print PBS << "EOF";
963	# Prepare a script to ease urpmi setup
964	cat > $ENV{'PBPROJ'}.addmedia << EOT
965	urpmi.addmedia $ENV{'PBPROJ'} $pbrepo->{$ENV{'PBPROJ'}}/$repodir with hdlist.cz
966	EOT
967	chmod 755 $ENV{'PBPROJ'}.addmedia
968
969	# Clean up old repo content
970	rm -f hdlist.cz synthesis.hdlist.cz
971	# Create urpmi repo
972	genhdlist .
973	EOF
974	}
975	if ($ddir eq "fedora") {
976	# Extract the spec file to please Fedora maintainers :-(
977	print PBS << "EOF";
978	for p in $basesrc; do
979	echo \$p \| grep -q 'src.rpm'
980	if [ \$\? -eq 0 ]; then
981	rpm2cpio \$p \| cpio -ivdum --quiet '*.spec'
982	fi
983	done
984	EOF
985	}
986	} elsif ($dtype eq "deb") {
987	# Also make a pbscript to generate apt bases
988	# Cf: http://www.debian.org/doc/manuals/repository-howto/repository-howto.fr.html
989	my $rpd = dirname("$pbrepo->{$ENV{'PBPROJ'}}/$repodir");
990	print PBS << "EOF";
991	#!/bin/bash
992	# Prepare a script to ease apt setup
993	cat > $ENV{'PBPROJ'}.sources.list << EOT
994	deb $rpd $dver contrib
995	deb-src $rpd $dver contrib
996	EOT
997	chmod 644 $ENV{'PBPROJ'}.sources.list
998
999	# Prepare a script to create apt info file
1000	(cd .. ; for a in i386 amd64 ia64; do mkdir -p dists/$dver/contrib/binary-\$a; dpkg-scanpackages -a\$a $dver /dev/null \| gzip -c9 > dists/$dver/contrib/binary-\$a/Packages.gz; done; mkdir -p dists/$dver/contrib/source; dpkg-scansources $dver /dev/null \| gzip -c9 > dists/$dver/contrib/source/Sources.gz)
1001	#(cd .. ; rm -f dists/$dver/Release ; apt-ftparchive release dists/$dver > dists/$dver/Release; gpg --sign -ba -o dists/$dver/Release.gpg dists/$dver/Release)
1002	EOF
1003	}
1004	close(PBS);
1005	chmod 0755,"$ENV{'PBBUILDDIR'}/pbscript";
1006
1007	} else {
1008	return;
1009	}
1010
1011	# Useless for VE
1012	my $nport;
1013	if ($cmt ne "ve") {
1014	$nport = $sshport->{$ENV{'PBPROJ'}};
1015	$nport = "$pbport" if (defined $pbport);
1016	}
1017
1018	# Remove a potential $ENV{'HOME'} as tdir should be relative to pb's home
1019	$tdir =~ s\|\$ENV.+\}/\|\|;
1020
1021	my $tm = $vtmout->{$ENV{'PBPROJ'}};
1022
1023	# ssh communication if not VE
1024	# should use a hash instead...
1025	my ($shcmd,$cpcmd,$cptarget,$cp2target);
1026	if ($cmt ne "ve") {
1027	my $keyfile = pb_ssh_get(0);
1028	$shcmd = "ssh -i $keyfile -q -o UserKnownHostsFile=/dev/null -p $nport $mac";
1029	$cpcmd = "scp -i $keyfile -p -o UserKnownHostsFile=/dev/null -P $nport";
1030	$cptarget = "$mac:$tdir";
1031	if ($cmt eq "vm") {
1032	$cp2target = "$mac:$bdir";
1033	}
1034	} else {
1035	my $tp = $vepath->{$ENV{'PBPROJ'}};
1036	$shcmd = "sudo chroot $tp/$v /bin/su - $sshlogin->{$ENV{'PBPROJ'}} -c ";
1037	$cpcmd = "cp -a ";
1038	$cptarget = "$tp/$tdir";
1039	$cp2target = "$tp/$bdir";
1040	}
1041
1042	my $logres = "";
1043	# Do not touch when just announcing
1044	if ($cmt ne "Announce") {
1045	pb_system("$shcmd \"mkdir -p $tdir ; cd $tdir ; echo \'for i in $basesrc; do if [ -f \$i ]; then rm -f \$i; fi; done\ ; $cmd' \| bash\"","Preparing $tdir on $cptarget");
1046	} else {
1047	$logres = "> ";
1048	}
1049	pb_system("cd $ENV{'PBBUILDDIR'} ; $cpcmd $src $cptarget 2> /dev/null","$cmt delivery in $cptarget");
1050
1051	# For VE we need to change the owner manually - To be tested if needed
1052	#if ($cmt eq "ve") {
1053	#pb_system("cd $cptarget ; sudo chown -R $sshlogin->{$ENV{'PBPROJ'}} .","$cmt chown in $cptarget to $sshlogin->{$ENV{'PBPROJ'}}");
1054	#}
1055	pb_system("$shcmd \"echo \'cd $tdir ; if [ -f pbscript ]; then ./pbscript; fi ; rm -f ./pbscript\' \| bash\"","Executing pbscript on $cptarget if needed","verbose");
1056	if (($cmt eq "vm") \|\| ($cmt eq "ve")) {
1057	# Get back info on pkg produced, compute their name and get them from the VM
1058	pb_system("$cpcmd $cp2target/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'} $ENV{'PBBUILDDIR'} 2> /dev/null","Get package names in $cp2target");
1059	open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1060	my $src = <KEEP>;
1061	chomp($src);
1062	close(KEEP);
1063	$src =~ s/^ *//;
1064	pb_mkdir_p("$ENV{'PBBUILDDIR'}/$odir/$over");
1065	# Change pgben to make the next send2target happy
1066	my $made = "";
1067	open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to write $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1068	foreach my $p (split(/ +/,$src)) {
1069	my $j = basename($p);
1070	pb_system("$cpcmd $cp2target/\'$p\' $ENV{'PBBUILDDIR'}/$odir/$over 2> /dev/null","Package recovery of $j in $cp2target");
1071	$made="$made $odir/$over/$j" if (($dtype ne "rpm") \|\| ($j !~ /.src.rpm$/));
1072	}
1073	print KEEP "$made\n";
1074	close(KEEP);
1075	pb_system("$shcmd \"rm -rf $tdir $bdir\"","$cmt cleanup");
1076
1077	# We want to send them to the ssh account so overwrite what has been done before
1078	undef $pbaccount;
1079	pb_log(2,"Before sending pkgs, vmexist: $vmexist, vmpid: $vmpid\n");
1080	pb_send2target("Packages",$odir."-".$over."-".$oarch,$vmexist,$vmpid);
1081	pb_rm_rf("$ENV{'PBBUILDDIR'}/$odir");
1082	}
1083	pb_log(2,"Before halt, vmexist: $vmexist, vmpid: $vmpid\n");
1084	if ((! $vmexist) && (($cmt eq "vm") \|\| ($cmt eq "Script"))) {
1085	pb_system("$shcmd \"sudo /sbin/halt -p \"; sleep $tm ; echo \'if [ -d /proc/$vmpid ]; then kill -9 $vmpid; fi \' \| bash ; sleep 10","VM $v halt (pid $vmpid)");
1086	}
1087	}
1088
1089	sub pb_script2v {
1090	my $pbscript=shift;
1091	my $vtype=shift;
1092	my $force=shift \|\| 0; # Force stop of VM. Default not
1093	my $vm1=shift \|\| undef; # Only that VM to treat
1094	my $vm;
1095	my $all;
1096
1097	pb_log(2,"DEBUG: pb_script2v($pbscript,$vtype,$force,$vm1)\n");
1098	# Prepare the script to be executed on the VM
1099	# in $ENV{'PBDESTDIR'}/pbscript
1100	if ((defined $pbscript ) && ($pbscript ne "$ENV{'PBDESTDIR'}/pbscript")) {
1101	copy($pbscript,"$ENV{'PBDESTDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
1102	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
1103	}
1104
1105	if (not defined $vm1) {
1106	($vm,$all) = pb_get_v($vtype);
1107	} else {
1108	@$vm = ($vm1);
1109	}
1110	my ($vmexist,$vmpid) = (undef,undef);
1111
1112	foreach my $v (@$vm) {
1113	# Launch the VM/VE
1114	if ($vtype eq "vm") {
1115	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1116	pb_log(2,"DEBUG: After pb_launchv, vmexist: $vmexist, vmpid: $vmpid\n");
1117
1118	# Skip that VM if something went wrong
1119	next if (($vmpid == 0) && ($vmexist == 0));
1120
1121	# If force stopping the VM then reset vmexist
1122	if ($force == 1) {
1123	$vmpid = $vmexist;
1124	$vmexist = 0;
1125	}
1126	}
1127
1128	# Gather all required files to send them to the VM
1129	# and launch the build through pbscript
1130	pb_log(2,"DEBUG: Before send2target, vmexist: $vmexist, vmpid: $vmpid\n");
1131	pb_send2target("Script","$v",$vmexist,$vmpid);
1132
1133	}
1134	}
1135
1136	sub pb_launchv {
1137	my $vtype = shift;
1138	my $v = shift;
1139	my $create = shift \|\| 0; # By default do not create a VM
1140
1141	pb_log(2,"DEBUG: pb_launchv($vtype,$v,$create)\n");
1142	die "No VM/VE defined, unable to launch" if (not defined $v);
1143	# Keep only the first VM in case many were given
1144	$v =~ s/,.*//;
1145
1146	# Which is our local arch ? (standardize on i386 for those platforms)
1147	my $arch = `uname -m`;
1148	chomp($arch);
1149	$arch =~ s/i.86/i386/;
1150
1151	# Launch the VMs/VEs
1152	if ($vtype eq "vm") {
1153	die "-i iso parameter needed" if (((not defined $iso) \|\| ($iso eq "")) && ($create != 0));
1154
1155	my ($ptr,$vmopt,$vmpath,$vmport,$vmtmout,$vmsize) = pb_conf_get("vmtype","vmopt","vmpath","vmport","vmtmout","vmsize");
1156
1157	my $vmtype = $ptr->{$ENV{'PBPROJ'}};
1158	if (not defined $ENV{'PBVMOPT'}) {
1159	$ENV{'PBVMOPT'} = "";
1160	}
1161	# Set a default timeout of 2 minutes
1162	if (not defined $ENV{'PBVMTMOUT'}) {
1163	$ENV{'PBVMTMOUT'} = "120";
1164	}
1165	if (defined $vmopt->{$v}) {
1166	$ENV{'PBVMOPT'} .= " $vmopt->{$v}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$v}/);
1167	} elsif (defined $vmopt->{$ENV{'PBPROJ'}}) {
1168	$ENV{'PBVMOPT'} .= " $vmopt->{$ENV{'PBPROJ'}}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$ENV{'PBPROJ'}}/);
1169	}
1170	if (defined $vmtmout->{$v}) {
1171	$ENV{'PBVMTMOUT'} = $vmtmout->{$v};
1172	} elsif (defined $vmtmout->{$ENV{'PBPROJ'}}) {
1173	$ENV{'PBVMTMOUT'} = $vmtmout->{$ENV{'PBPROJ'}};
1174	}
1175	my $nport = $vmport->{$ENV{'PBPROJ'}};
1176	$nport = "$pbport" if (defined $pbport);
1177
1178	my $cmd;
1179	my $vmcmd; # has to be used for pb_check_ps
1180	my $vmm; # has to be used for pb_check_ps
1181	if ($vmtype eq "qemu") {
1182	my $qemucmd32;
1183	my $qemucmd64;
1184	if ($arch eq "x86_64") {
1185	$qemucmd32 = "/usr/bin/qemu-system-i386";
1186	$qemucmd64 = "/usr/bin/qemu";
1187	} else {
1188	$qemucmd32 = "/usr/bin/qemu";
1189	$qemucmd64 = "/usr/bin/qemu-system-x86_64";
1190	}
1191	if ($v =~ /x86_64/) {
1192	$vmcmd = "$qemucmd64 -no-kqemu";
1193	} else {
1194	$vmcmd = "$qemucmd32";
1195	}
1196	$vmm = "$vmpath->{$ENV{'PBPROJ'}}/$v.qemu";
1197	if ($create != 0) {
1198	$ENV{'PBVMOPT'} .= " -cdrom $iso -boot d";
1199	}
1200	$cmd = "$vmcmd $ENV{'PBVMOPT'} -redir tcp:$nport:10.0.2.15:22 $vmm"
1201	} elsif ($vmtype eq "xen") {
1202	} elsif ($vmtype eq "vmware") {
1203	} else {
1204	die "VM of type $vmtype not supported. Report to the dev team";
1205	}
1206	my ($tmpcmd,$void) = split(/ +/,$cmd);
1207	my $vmexist = pb_check_ps($tmpcmd,$vmm);
1208	my $vmpid = 0;
1209	if (! $vmexist) {
1210	if ($create != 0) {
1211	if (($vmtype eq "qemu") \|\| ($vmtype eq "xen")) {
1212	pb_system("/usr/bin/qemu-img create -f qcow2 $vmm $vmsize->{$ENV{'PBPROJ'}}","Creating the QEMU VM");
1213	} elsif ($vmtype eq "vmware") {
1214	} else {
1215	}
1216	}
1217	if (! -f "$vmm") {
1218	pb_log(0,"Unable to find VM $vmm\n");
1219	} else {
1220	pb_system("$cmd &","Launching the VM $vmm");
1221	pb_system("sleep $ENV{'PBVMTMOUT'}","Waiting $ENV{'PBVMTMOUT'} s for VM $v to come up");
1222	$vmpid = pb_check_ps($tmpcmd,$vmm);
1223	pb_log(0,"VM $vmm launched (pid $vmpid)\n");
1224	}
1225	} else {
1226	pb_log(0,"Found an existing VM $vmm (pid $vmexist)\n");
1227	}
1228	pb_log(2,"DEBUG: pb_launchv returns ($vmexist,$vmpid)\n");
1229	return($vmexist,$vmpid);
1230	# VE here
1231	} else {
1232	# Get VE context
1233	my ($ptr,$vetmout,$vepath,$verebuild,$veconf) = pb_conf_get("vetype","vetmout","vepath","verebuild","veconf");
1234	my $vetype = $ptr->{$ENV{'PBPROJ'}};
1235
1236	# Get distro context
1237	my ($name,$ver,$darch) = split(/-/,$v);
1238	chomp($darch);
1239	my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($name,$ver);
1240
1241	if ($vetype eq "chroot") {
1242	# Architecture consistency
1243	if ($arch ne $darch) {
1244	die "Unable to launch a VE of architecture $darch on a $arch platform" if (not (($darch eq "x86_64") && ($arch =~ /i?86/)));
1245	}
1246
1247	if (($create != 0) \|\| ($verebuild->{$ENV{'PBPROJ'}} eq "true") \|\| ($force == 1)) {
1248	# We have to rebuild the chroot
1249	if ($dtype eq "rpm") {
1250	pb_system("sudo /usr/sbin/mock --init --resultdir=\"/tmp\" --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" -r $v","Creating the mock VE");
1251	# Once setup we need to install some packages, the pb account, ...
1252	pb_system("sudo /usr/sbin/mock --install --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" -r $v su","Configuring the mock VE");
1253	#pb_system("sudo /usr/sbin/mock --init --resultdir=\"/tmp\" --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" --basedir=\"$vepath->{$ENV{'PBPROJ'}}\" -r $v","Creating the mock VE");
1254	} elsif ($dtype eq "deb") {
1255	pb_system("","Creating the pbuilder VE");
1256	} elsif ($dtype eq "ebuild") {
1257	die "Please teach the dev team how to build gentoo chroot";
1258	} else {
1259	die "Unknown distribution type $dtype. Report to dev team";
1260	}
1261	}
1262	# Nothing more to do for VE. No real launch
1263	} else {
1264	die "VE of type $vetype not supported. Report to the dev team";
1265	}
1266	}
1267	}
1268
1269	sub pb_build2v {
1270
1271	my $vtype = shift;
1272
1273	# Prepare the script to be executed on the VM/VE
1274	# in $ENV{'PBDESTDIR'}/pbscript
1275	#my ($ntp) = pb_conf_get($vtype."ntp");
1276	#my $vntp = $ntp->{$ENV{'PBPROJ'}};
1277
1278	open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
1279	print SCRIPT "#!/bin/bash\n";
1280	print SCRIPT "echo ... Execution needed\n";
1281	print SCRIPT "# This is in directory delivery\n";
1282	print SCRIPT "# Setup the variables required for building\n";
1283	print SCRIPT "export PBPROJ=$ENV{'PBPROJ'}\n";
1284	print SCRIPT "# Preparation for pb\n";
1285	print SCRIPT "mv .pbrc \$HOME\n";
1286	print SCRIPT "cd ..\n";
1287	# Force new date to be in the future compared to the date of the tar file by adding 1 minute
1288	my @date=pb_get_date();
1289	$date[1]++;
1290	my $upddate = strftime("%m%d%H%M%Y", @date);
1291	#print SCRIPT "echo Setting up date on $vntp...\n";
1292	# Or use ntpdate if available TBC
1293	print SCRIPT "sudo date $upddate\n";
1294	# Get list of packages to build and get some ENV vars as well
1295	my $ptr = pb_get_pkg();
1296	@pkgs = @$ptr;
1297	my $p = join(' ',@pkgs) if (@pkgs);
1298	print SCRIPT "export PBPROJVER=$ENV{'PBPROJVER'}\n";
1299	print SCRIPT "export PBPROJTAG=$ENV{'PBPROJTAG'}\n";
1300	print SCRIPT "export PBPACKAGER=\"$ENV{'PBPACKAGER'}\"\n";
1301	print SCRIPT "# Build\n";
1302	print SCRIPT "echo Building packages on $vtype...\n";
1303	print SCRIPT "pb -p $ENV{'PBPROJ'} build2pkg $p\n";
1304	close(SCRIPT);
1305	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
1306
1307	my ($v,$all) = pb_get_v($vtype);
1308
1309	# Send tar files when we do a global generation
1310	pb_build2ssh() if ($all == 1);
1311
1312	my ($vmexist,$vmpid) = (undef,undef);
1313
1314	foreach my $v (@$v) {
1315	if ($vtype eq "vm") {
1316	# Launch the VM
1317	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1318
1319	# Skip that VM if it something went wrong
1320	next if (($vmpid == 0) && ($vmexist == 0));
1321	}
1322	# Gather all required files to send them to the VM/VE
1323	# and launch the build through pbscript
1324	pb_log(2,"Calling send2target $vtype,$v,$vmexist,$vmpid\n");
1325	pb_send2target($vtype,"$v",$vmexist,$vmpid);
1326	}
1327	}
1328
1329
1330	sub pb_newver {
1331
1332	die "-V Version parameter needed" if ((not defined $newver) \|\| ($newver eq ""));
1333
1334	# Need this call for PBDIR
1335	my ($scheme2,$uri) = pb_cms_init($pbinit);
1336
1337	my ($pbconf) = pb_conf_get("pbconfurl");
1338	$uri = $pbconf->{$ENV{'PBPROJ'}};
1339	my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);
1340
1341	# Checking CMS repositories status
1342	my ($pburl) = pb_conf_get("pburl");
1343	($scheme2, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}});
1344
1345	if ($scheme !~ /^svn/) {
1346	die "Only SVN is supported at the moment";
1347	}
1348
1349	my $res = pb_cms_isdiff($scheme,$ENV{'PBROOTDIR'});
1350	die "ERROR: No differences accepted in CMS for $ENV{'PBROOTDIR'} before creating a new version" if ($res != 0);
1351
1352	$res = pb_cms_isdiff($scheme2,$ENV{'PBDIR'});
1353	die "ERROR: No differences accepted in CMS for $ENV{'PBDIR'} before creating a new version" if ($res != 0);
1354
1355	# Tree identical between PBCONFDIR and PBROOTDIR. The delta is what
1356	# we want to get for the root of the new URL
1357
1358	my $tmp = $ENV{'PBROOTDIR'};
1359	$tmp =~ s\|^$ENV{'PBCONFDIR'}\|\|;
1360
1361	my $newurl = "$uri/".dirname($tmp)."/$newver";
1362	# Should probably use projver in the old file
1363	my $oldver= basename($tmp);
1364
1365	# Duplicate and extract project-builder part
1366	pb_log(2,"Copying $uri/$tmp to $newurl\n");
1367	pb_cms_copy($scheme,"$uri/$tmp",$newurl);
1368	pb_log(2,"Checkout $newurl to $ENV{'PBROOTDIR'}/../$newver\n");
1369	pb_cms_up($scheme,"$ENV{'PBCONFDIR'}/..");
1370
1371	# Duplicate and extract project
1372	my $newurl2 = "$pburl->{$ENV{'PBPROJ'}}/".dirname($tmp)."/$newver";
1373
1374	pb_log(2,"Copying $pburl->{$ENV{'PBPROJ'}}/$tmp to $newurl2\n");
1375	pb_cms_copy($scheme,"$pburl->{$ENV{'PBPROJ'}}/$tmp",$newurl2);
1376	pb_log(2,"Checkout $newurl2 to $ENV{'PBDIR'}/../$newver\n");
1377	pb_cms_up($scheme,"$ENV{'PBDIR'}/..");
1378
1379	# Update the .pb file
1380	open(FILE,"$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb") \|\| die "Unable to open $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb";
1381	open(OUT,"> $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new") \|\| die "Unable to write to $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new";
1382	while(<FILE>) {
1383	s/^projver\s+$ENV{'PBPROJ'}\s=\s$oldver/projver $ENV{'PBPROJ'} = $newver/;
1384	pb_log(0,"Changing projver from $oldver to $newver in $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb\n") if (/^projver\s+$ENV{'PBPROJ'}\s=\s$oldver/);
1385	s/^testver/#testver/;
1386	pb_log(0,"Commenting testver in $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb\n") if (/^testver/);
1387	print OUT $_;
1388	}
1389	close(FILE);
1390	close(OUT);
1391	rename("$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new","$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb");
1392
1393	# Checking pbcl files
1394	foreach my $f (<$ENV{'PBROOTDIR'}/*/pbcl>) {
1395	open(PBCL,$f) \|\| die "Unable to open $f";
1396	my $foundnew = 0;
1397	while (<PBCL>) {
1398	$foundnew = 1 if (/^$newver \(/);
1399	}
1400	close(PBCL);
1401	open(OUT,"> $f.new") \|\| die "Unable to write to $f.new: $!";
1402	open(PBCL,$f) \|\| die "Unable to open $f";
1403	while (<PBCL>) {
1404	print OUT "$_" if (not /^$oldver \(/);
1405	if ((/^$oldver \(/) && ($foundnew == 0)) {
1406	print OUT "$newver ($pbdate)\n";
1407	print OUT "- TBD\n";
1408	print OUT "\n";
1409	pb_log(0,"WARNING: version $newver not found in $f so added...") if ($foundnew == 0);
1410	}
1411	}
1412	close(OUT);
1413	close(PBCL);
1414	rename("$f.new","$f");
1415	}
1416
1417	pb_log(2,"Checkin $ENV{'PBROOTDIR'}/../$newver\n");
1418	pb_cms_checkin($scheme,"$ENV{'PBROOTDIR'}/../$newver",undef);
1419	}
1420
1421	#
1422	# Return the list of VMs/VEs we are working on
1423	# $all is a flag to know if we return all of them
1424	# or only some (if all we publish also tar files in addition to pkgs
1425	#
1426	sub pb_get_v {
1427
1428	my $vtype = shift;
1429	my @v;
1430	my $all = 0;
1431	my $vlist;
1432	my $pbv = 'PBV';
1433
1434	if ($vtype eq "vm") {
1435	$vlist = "vmlist";
1436	} elsif ($vtype eq "ve") {
1437	$vlist = "velist";
1438	}
1439	# Get VM/VE list
1440	if ((not defined $ENV{$pbv}) \|\| ($ENV{$pbv} =~ /^all$/)) {
1441	my ($ptr) = pb_conf_get($vlist);
1442	$ENV{$pbv} = $ptr->{$ENV{'PBPROJ'}};
1443	$all = 1;
1444	}
1445	pb_log(2,"$vtype: $ENV{$pbv}\n");
1446	@v = split(/,/,$ENV{$pbv});
1447	return(\@v,$all);
1448	}
1449
1450	# Function to create a potentialy missing pb account on the VM/VE, and adds it to sudo
1451	# Needs to use root account to connect to the VM/VE
1452	# pb will take your local public SSH key to access
1453	# the pb account in the VM later on if needed
1454	sub pb_setup_v {
1455
1456	my $vtype = shift;
1457
1458	my ($vm,$all) = pb_get_v($vtype);
1459
1460	# Script generated
1461	my $pbscript = "$ENV{'PBDESTDIR'}/setupv";
1462
1463	foreach my $v (@$vm) {
1464	# Name of the account to deal with for VM/VE
1465	# Do not use the one passed potentially with -a
1466	my ($pbac) = pb_conf_get($vtype."login");
1467	my ($key,$zero0,$zero1,$zero2);
1468	my ($vmexist,$vmpid);
1469
1470	if ($vtype eq "vm") {
1471	# Prepare the key to be used and transfered remotely
1472	my $keyfile = pb_ssh_get(1);
1473
1474	my ($vmhost,$vmport) = pb_conf_get("vmhost","vmport");
1475	my $nport = $vmport->{$ENV{'PBPROJ'}};
1476	$nport = "$pbport" if (defined $pbport);
1477
1478	# Launch the VM
1479	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1480
1481	# Skip that VM if something went wrong
1482	next if (($vmpid == 0) && ($vmexist == 0));
1483
1484	# Store the pub key part in a variable
1485	open(FILE,"$keyfile.pub") \|\| die "Unable to open $keyfile.pub";
1486	($zero0,$zero1,$zero2) = split(/ /,<FILE>);
1487	close(FILE);
1488
1489	$key = "\Q$zero1";
1490
1491	pb_system("cat $keyfile.pub \| ssh -q -o UserKnownHostsFile=/dev/null -p $nport -i $keyfile root\@$vmhost->{$ENV{'PBPROJ'}} \"mkdir -p .ssh ; chmod 700 .ssh ; cat >> .ssh/authorized_keys ; chmod 600 .ssh/authorized_keys\"","Copying local keys to $vtype. This will require the root password");
1492	# once this is done, we can do what we want on the VM remotely
1493	}
1494
1495	# Prepare the script to be executed on the VM/VE
1496	# in $ENV{'PBDESTDIR'}/setupv
1497
1498	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
1499	print SCRIPT << 'EOF';
1500	#!/usr/bin/perl -w
1501
1502	use strict;
1503	use File::Copy;
1504
1505	our $debug;
1506	our $LOG;
1507	our $synmsg = "pbscript";
1508	pb_log_init($debug, $LOG);
1509	pb_temp_init();
1510
1511	EOF
1512	if ($vtype eq "vm") {
1513	print SCRIPT << 'EOF';
1514	# Removes duplicate in .ssh/authorized_keys of our key if needed
1515	#
1516	my $file1="$ENV{'HOME'}/.ssh/authorized_keys";
1517	open(PBFILE,$file1) \|\| die "Unable to open $file1";
1518	open(PBOUT,"> $file1.new") \|\| die "Unable to open $file1.new";
1519	my $count = 0;
1520	while (<PBFILE>) {
1521	EOF
1522	print SCRIPT << "EOF";
1523	if (/ $key /) {
1524	\$count++;
1525	}
1526	print PBOUT \$_ if ((\$count <= 1) \|\| (\$_ !~ / $key /));
1527	}
1528	close(PBFILE);
1529	close(PBOUT);
1530	rename("\$file1.new",\$file1);
1531	chmod 0600,\$file1;
1532	EOF
1533	}
1534	print SCRIPT << 'EOF';
1535
1536	# Adds $pbac->{$ENV{'PBPROJ'}} as an account if needed
1537	#
1538	my $file="/etc/passwd";
1539	open(PBFILE,$file) \|\| die "Unable to open $file";
1540	my $found = 0;
1541	while (<PBFILE>) {
1542	EOF
1543	print SCRIPT << "EOF";
1544	\$found = 1 if (/^$pbac->{$ENV{'PBPROJ'}}:/);
1545	EOF
1546	print SCRIPT << 'EOF';
1547	}
1548	close(PBFILE);
1549
1550	if ( $found == 0 ) {
1551	if ( ! -d "/home" ) {
1552	pb_mkdir("/home");
1553	}
1554	EOF
1555	print SCRIPT << "EOF";
1556	pb_system("groupadd $pbac->{$ENV{'PBPROJ'}}","Adding group $pbac->{$ENV{'PBPROJ'}}");
1557	pb_system("useradd $pbac->{$ENV{'PBPROJ'}} -g $pbac->{$ENV{'PBPROJ'}} -m -d /home/$pbac->{$ENV{'PBPROJ'}}","Adding user $pbac->{$ENV{'PBPROJ'}} (group $pbac->{$ENV{'PBPROJ'}} - home /home/$pbac->{$ENV{'PBPROJ'}}");
1558	}
1559
1560	# allow ssh entry to build
1561	#
1562	mkdir "/home/$pbac->{$ENV{'PBPROJ'}}/.ssh",0700;
1563	# Allow those accessing root to access the build account
1564	copy("\$ENV{'HOME'}/.ssh/authorized_keys","/home/$pbac->{$ENV{'PBPROJ'}}/.ssh/authorized_keys");
1565	chmod 0600,".ssh/authorized_keys";
1566	pb_system("chown -R $pbac->{$ENV{'PBPROJ'}}:$pbac->{$ENV{'PBPROJ'}} /home/$pbac->{$ENV{'PBPROJ'}}/.ssh","Finish setting up the SSH env for $pbac->{$ENV{'PBPROJ'}}");
1567
1568	EOF
1569	print SCRIPT << 'EOF';
1570	# No passwd for build account only keys
1571	$file="/etc/shadow";
1572	open(PBFILE,$file) \|\| die "Unable to open $file";
1573	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
1574	while (<PBFILE>) {
1575	EOF
1576	print SCRIPT << "EOF";
1577	s/^$pbac->{$ENV{'PBPROJ'}}:\!\!:/$pbac->{$ENV{'PBPROJ'}}:*:/;
1578	s/^$pbac->{$ENV{'PBPROJ'}}:\!:/$pbac->{$ENV{'PBPROJ'}}:*:/; #SLES 9 e.g.
1579	EOF
1580	print SCRIPT << 'EOF';
1581	print PBOUT $_;
1582	}
1583	close(PBFILE);
1584	close(PBOUT);
1585	rename("$file.new",$file);
1586	chmod 0640,$file;
1587
1588	# Keep the VM in text mode
1589	$file="/etc/inittab";
1590	if (-f $file) {
1591	open(PBFILE,$file) \|\| die "Unable to open $file";
1592	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
1593	while (<PBFILE>) {
1594	s/^(..):5:initdefault:$/$1:3:initdefault:/;
1595	print PBOUT $_;
1596	}
1597	close(PBFILE);
1598	close(PBOUT);
1599	rename("$file.new",$file);
1600	chmod 0640,$file;
1601	}
1602
1603	# pb has to be added to portage group on gentoo
1604
1605	# Adapt sudoers
1606	$file="/etc/sudoers";
1607	open(PBFILE,$file) \|\| die "Unable to open $file";
1608	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
1609	while (<PBFILE>) {
1610	EOF
1611	print SCRIPT << "EOF";
1612	next if (/^$pbac->{$ENV{'PBPROJ'}} /);
1613	EOF
1614	print SCRIPT << 'EOF';
1615	s/Defaults[ \t]+requiretty//;
1616	print PBOUT $_;
1617	}
1618	close(PBFILE);
1619	EOF
1620	print SCRIPT << "EOF";
1621	# This is needed in order to be able to halt the machine from the $pbac->{$ENV{'PBPROJ'}} account at least
1622	print PBOUT "$pbac->{$ENV{'PBPROJ'}} ALL=(ALL) NOPASSWD:ALL\n";
1623	EOF
1624	print SCRIPT << 'EOF';
1625	close(PBOUT);
1626	rename("$file.new",$file);
1627	chmod 0440,$file;
1628
1629	EOF
1630
1631	my $SCRIPT = \*SCRIPT;
1632
1633	pb_install_deps($SCRIPT);
1634
1635	print SCRIPT << 'EOF';
1636	# Suse wants sudoers as 640
1637	if (($ddir eq "sles") \|\| (($ddir eq "suse")) && ($dver ne "10.3")) {
1638	chmod 0640,$file;
1639	}
1640
1641	# Sync date
1642	#system "/usr/sbin/ntpdate ntp.pool.org";
1643
1644	pb_system("rm -rf perl-ProjectBuilder-* ; wget --passive-ftp ftp://ftp.mondorescue.org/src/perl-ProjectBuilder-latest.tar.gz ; tar xvfz perl-ProjectBuilder-latest.tar.gz ; cd perl-ProjectBuilder-* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf perl-ProjectBuilder-* ; rm -rf project-builder-* ; wget --passive-ftp ftp://ftp.mondorescue.org/src/project-builder-latest.tar.gz ; tar xvfz project-builder-latest.tar.gz ; cd project-builder-* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf project-builder-* ;","Building Project-Builder");
1645	system "pb 2>&1 \| head -5";
1646	EOF
1647	# Adds pb_distro_init from ProjectBuilder::Distribution
1648	foreach my $d (@INC) {
1649	my @f = ("$d/ProjectBuilder/Base.pm","$d/ProjectBuilder/Distribution.pm");
1650	foreach my $f (@f) {
1651	if (-f "$f") {
1652	open(PBD,"$f") \|\| die "Unable to open $f";
1653	while (<PBD>) {
1654	next if (/^package/);
1655	next if (/^use Exporter/);
1656	next if (/^use ProjectBuilder::/);
1657	next if (/^our /);
1658	print SCRIPT $_;
1659	}
1660	close(PBD);
1661	}
1662	}
1663	}
1664	close(SCRIPT);
1665	chmod 0755,"$pbscript";
1666
1667	# That build script needs to be run as root and force stop of VM at end
1668	$pbaccount = "root";
1669
1670	# Force shutdown of VM exept if it was already launched
1671	my $force = 0;
1672	if ((! $vmexist) && ($vtype eq "vm")) {
1673	$force = 1;
1674	}
1675
1676	pb_script2v($pbscript,$vtype,$force,$v);
1677	}
1678	return;
1679	}
1680
1681	sub pb_install_deps {
1682
1683	my $SCRIPT = shift;
1684
1685	print {$SCRIPT} << 'EOF';
1686	# We need to have that pb_distro_init function
1687	# Get it from Project-Builder::Distribution
1688	my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init();
1689	print "distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n";
1690
1691	# Get and install pb
1692	my $insdm = "rm -rf Date-Manip* ; wget http://search.cpan.org/CPAN/authors/id/S/SB/SBECK/Date-Manip-5.54.tar.gz ; tar xvfz Date-Manip-5.54.tar.gz ; cd Date-Manip* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf Date-Manip*";
1693	my $insmb = "rm -rf Module-Build* ; wget http://search.cpan.org/CPAN/authors/id/K/KW/KWILLIAMS/Module-Build-0.2808.tar.gz ; tar xvfz Module-Build-0.2808.tar.gz ; cd Module-Build* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf Module-Build*";
1694	my $insfm = "rm -rf File-MimeInfo* ; wget http://search.cpan.org/CPAN/authors/id/P/PA/PARDUS/File-MimeInfo/File-MimeInfo-0.15.tar.gz ; tar xvfz File-MimeInfo-0.15.tar.gz ; cd File-MimeInfo* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf File-MimeInfo*";
1695	my $insfb = "rm -rf File-Basedir* ; wget http://search.cpan.org/CPAN/authors/id/P/PA/PARDUS/File-BaseDir-0.03.tar.gz ; tar xvfz File-BaseDir-0.03.tar.gz ; cd File-BaseDir* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf File-BaseDir*";
1696	my $cmtdm = "Installing Date-Manip perl module";
1697	my $cmtmb = "Installing Module-Build perl module";
1698	my $cmtfm = "Installing File-MimeInfo perl module";
1699	my $cmtfb = "Installing File-Basedir perl module";
1700	my $cmtall = "Installing required modules";
1701
1702	if ( $ddir eq "fedora" ) {
1703	pb_system("yum clean all","Cleaning yum env");
1704	#system "yum update -y";
1705	my $arch=`uname -m`;
1706	my $opt = "";
1707	chomp($arch);
1708	if ($arch eq "x86_64") {
1709	$opt="--exclude=*.i?86";
1710	}
1711
1712	pb_system("yum -y $opt install rpm-build wget patch ntp sudo perl-DateManip perl-File-MimeInfo perl-ExtUtils-MakeMaker",$cmtall);
1713	if ($dver eq 4) {
1714	pb_system("$insmb","$cmtmb");
1715	pb_system("$insfm","$cmtfm");
1716	pb_system("$insfb","$cmtfb");
1717	}
1718	} elsif (( $dfam eq "rh" ) \|\| ($ddir eq "sles") \|\| (($ddir eq "suse") && (($dver eq "10.1") \|\| ($dver eq "10.0"))) \|\| ($ddir eq "slackware")) {
1719	# Suppose pkg are installed already as no online mirror available
1720	pb_system("rpm -e lsb 2>&1 > /dev/null","Removing lsb package");
1721	pb_system("$insdm","$cmtdm");
1722	pb_system("$insmb","$cmtmb");
1723	pb_system("$insfm","$cmtfm");
1724	pb_system("$insfb","$cmtfb");
1725	} elsif ($ddir eq "suse") {
1726	# New OpenSuSE
1727	pb_system("$insmb","$cmtmb");
1728	pb_system("$insfm","$cmtfm");
1729	pb_system("$insfb","$cmtfb");
1730	pb_system("export TERM=linux ; liste=\"\" ; for i in make wget patch sudo perl-DateManip perl-File-HomeDir xntp; do rpm -q \$i 1> /dev/null 2> /dev/null ; if [ \$\? != 0 ]; then liste=\"\$liste \$i\"; fi; done; echo \"Liste: \$liste\" ; if [ \"\$liste\" != \"\" ]; then yast2 -i \$liste ; fi","$cmtall");
1731	} elsif ( $dfam eq "md" ) {
1732	pb_system("urpmi.update -a ; urpmi --auto rpm-build wget sudo patch ntp-client perl-File-MimeInfo","$cmtall");
1733	if (($ddir eq "mandrake") && ($dver eq "10.1")) {
1734	pb_system("$insdm","$cmtdm");
1735	} else {
1736	pb_system("urpmi --auto perl-DateManip","$cmtdm");
1737	}
1738	} elsif ( $dfam eq "du" ) {
1739	if (( $dver eq "3.1" ) && ($ddir eq "debian")) {
1740	#system "apt-get update";
1741	pb_system("$insfb","$cmtfb");
1742	pb_system("$insfm","$cmtfm");
1743	pb_system("apt-get -y install wget patch ssh sudo debian-builder dh-make fakeroot ntpdate libmodule-build-perl libdate-manip-perl","$cmtall");
1744	} else {
1745	pb_system("apt-get update; apt-get -y install wget patch openssh-server dpkg-dev sudo debian-builder dh-make fakeroot ntpdate libfile-mimeinfo-perl libmodule-build-perl libdate-manip-perl","$cmtall");
1746	}
1747	} elsif ( $dfam eq "gen" ) {
1748	#system "emerge -u system";
1749	pb_system("emerge wget sudo ntp DateManip File-MimeInfo","$cmtall");
1750	} else {
1751	print "No pkg to install\n";
1752	}
1753	EOF
1754	}
1755
1756	sub pb_announce {
1757
1758	# Get all required parameters
1759	my ($pbpackager,$pbrepo,$pbml,$pbsmtp) = pb_conf_get("pbpackager","pbrepo","pbml","pbsmtp");
1760	my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
1761	my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
1762	my @pkgs = @$pkg;
1763	my %pkgs;
1764	my $first = 0;
1765
1766	# Command to find packages on repo
1767	my $findstr = "find . ";
1768	# Generated announce files
1769	my @files;
1770
1771	foreach my $pbpkg (@pkgs) {
1772	if ($first != 0) {
1773	$findstr .= "-o ";
1774	}
1775	$first++;
1776	if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
1777	$pbver = $pkgv->{$pbpkg};
1778	} else {
1779	$pbver = $ENV{'PBPROJVER'};
1780	}
1781	if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
1782	$pbtag = $pkgt->{$pbpkg};
1783	} else {
1784	$pbtag = $ENV{'PBPROJTAG'};
1785	}
1786
1787	$findstr .= "-name \'$pbpkg-$pbver-$pbtag\..rpm\' -o -name \'$pbpkg"."_$pbver\.deb\' -o -name \'$pbpkg-$pbver\.ebuild\' ";
1788
1789	my $chglog;
1790
1791	# Get project info on log file and generate tmp files used later on
1792	pb_cms_init($pbinit);
1793	$chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
1794	$chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
1795	$chglog = undef if (! -f $chglog);
1796
1797	open(OUT,"> $ENV{'PBTMP'}/$pbpkg.ann") \|\| die "Unable to create $ENV{'PBTMP'}/$pbpkg.ann: $!";
1798	pb_changelog("announce",$pbpkg,$pbver,"N/A","N/A","N/A",\*OUT,"yes",$chglog);
1799	close(OUT);
1800	push(@files,"$ENV{'PBTMP'}/$pbpkg.ann");
1801	}
1802	$findstr .= " \| grep -Ev \'src.rpm\'";
1803	if ((not defined $testver) \|\| (not defined $testver->{$ENV{'PBPROJ'}}) \|\| ($testver->{$ENV{'PBPROJ'}} !~ /true/i)) {
1804	$findstr .= " \| grep -v ./test/";
1805	}
1806
1807	# Prepare the command to run and execute it
1808	open(PBS,"> $ENV{'PBTMP'}/pbscript") \|\| die "Unable to create $ENV{'PBTMP'}/pbscript";
1809	print PBS "$findstr\n";
1810	close(PBS);
1811	chmod 0755,"$ENV{'PBTMP'}/pbscript";
1812	pb_send2target("Announce");
1813
1814	# Get subject line
1815	my $sl = "Project $ENV{'PBPROJ'} version $ENV{'PBPROJVER'} is now available";
1816	print "Please enter the title of your announce\n";
1817	print "(By default: $sl)\n";
1818	my $sl2 = <STDIN>;
1819	$sl = $sl2 if ($sl2 !~ /^$/);
1820
1821	# Prepare a template of announce
1822	open(ANN,"> $ENV{'PBTMP'}/announce.html") \|\| die "Unable to create $ENV{'PBTMP'}/announce.html: $!";
1823	print ANN << "EOF";
1824	$sl</p>
1825
1826	<p>The project team is happy to announce the availability of a newest version of $ENV{'PBPROJ'} $ENV{'PBPROJVER'}. Enjoy it as usual!</p>
1827	<p>
1828	Now available at <a href="$pbrepo->{$ENV{'PBPROJ'}}">$pbrepo->{$ENV{'PBPROJ'}}</a>
1829	</p>
1830	<p>
1831	EOF
1832	open(LOG,"$ENV{'PBTMP'}/system.log") \|\| die "Unable to read $ENV{'PBTMP'}/system.log: $!";
1833	my $col = 2;
1834	my $i = 1;
1835	print ANN << 'EOF';
1836	<TABLE WIDTH="700" CELLPADDING="0" CELLSPACING="0" BORDER="0">
1837	<TR>
1838	EOF
1839	while (<LOG>) {
1840	print ANN "<TD>$_</TD>";
1841	$i++;
1842	if ($i > $col) {
1843	print ANN "</TR>\n<TR>";
1844	$i = 1;
1845	}
1846	}
1847	close(LOG);
1848	print ANN << "EOF";
1849	</TR>
1850	</TABLE>
1851	</p>
1852
1853	<p>As usual source packages are also available in the same directory.</p>
1854
1855	<p>
1856	Changes are :
1857	</p>
1858	<p>
1859	EOF
1860	# Get each package changelog content
1861	foreach my $f (sort(@files)) {
1862	open(IN,"$f") \|\| die "Unable to read $f:$!";
1863	while (<IN>) {
1864	print ANN $_;
1865	}
1866	close(IN);
1867	print ANN "</p><p>\n";
1868	}
1869	print ANN "</p>\n";
1870	close(ANN);
1871
1872	# Allow for modification
1873	pb_system("vi $ENV{'PBTMP'}/announce.html","Allowing modification of the announce","noredir");
1874
1875	# Store it in DB for external usage (Web pages generation)
1876	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
1877
1878	my $precmd = "";
1879	if (! -f $db) {
1880	$precmd = "CREATE TABLE announces (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, announce VARCHAR[65535])";
1881	}
1882
1883	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
1884	{ RaiseError => 1, AutoCommit => 1 })
1885	\|\| die "Unable to connect to $db";
1886
1887	if ($precmd ne "") {
1888	my $sth = $dbh->prepare(qq{$precmd})
1889	\|\| die "Unable to create table into $db";
1890	$sth->execute();
1891	}
1892
1893	# To read whole file
1894	local $/;
1895	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
1896	my $announce = <ANN>;
1897	close(ANN);
1898
1899	pb_log(2,"INSERT INTO announces VALUES (NULL, $pbdate, $announce)");
1900	my $sth = $dbh->prepare(qq{INSERT INTO announces VALUES (NULL,?,?)})
1901	\|\| die "Unable to insert into $db";
1902	$sth->execute($pbdate, $announce);
1903	$dbh->disconnect;
1904
1905	# Then deliver it on the Web
1906	# $TOOLHOME/livwww www
1907
1908	# Mail it to project's ML
1909	open(ML,"\| w3m -dump -T text/html > $ENV{'PBTMP'}/announce.txt") \|\| die "Unable to create $ENV{'PBTMP'}/announce.txt: $!";
1910	print ML << 'EOF';
1911	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/x html1/DTD/xhtml1-strict.dtd">
1912
1913	<html xmlns="http://www.w3.org/1999/xhtml" dir="ltr" xml:lang="en" lang="en">
1914	<head>
1915	</head>
1916	<body>
1917	<p>
1918	EOF
1919	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
1920	while(<ANN>) {
1921	print ML $_;
1922	}
1923	print ML << 'EOF';
1924	</body>
1925	</html>
1926	EOF
1927	close(ML);
1928
1929	# To read whole file
1930	local $/;
1931	open(ANN,"$ENV{'PBTMP'}/announce.txt") \|\| die "Unable to read $ENV{'PBTMP'}/announce.txt: $!";
1932	my $msg = <ANN>;
1933	close(ANN);
1934
1935	# Preparation of headers
1936
1937	my %mail = (
1938	To => $pbml->{$ENV{'PBPROJ'}},
1939	From => $pbpackager->{$ENV{'PBPROJ'}},
1940	Smtp => $pbsmtp->{$ENV{'PBPROJ'}},
1941	Body => $msg,
1942	Subject => "[ANNOUNCE] $sl",
1943	);
1944
1945	# Send mail
1946	sendmail(%mail) or die "Unable to send mail ($Mail::Sendmail::error): $Mail::Sendmail::log";
1947	}
1948
1949	# Return the SSH key file to use
1950	# Potentially create it if needed
1951
1952	sub pb_ssh_get {
1953
1954	my $create = shift \|\| 0; # Do not create keys by default
1955
1956	# Check the SSH environment
1957	my $keyfile = undef;
1958
1959	# We have specific keys by default
1960	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
1961	if (!(-e $keyfile) && ($create eq 1)) {
1962	pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
1963	}
1964
1965	$keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
1966	$keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
1967	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
1968	die "Unable to find your public ssh key under $keyfile" if (not defined $keyfile);
1969	return($keyfile);
1970	}
1971
1972
1973	# Returns the pid of a running VM command using a specific VM file
1974	sub pb_check_ps {
1975	my $vmcmd = shift;
1976	my $vmm = shift;
1977	my $vmexist = 0; # FALSE by default
1978
1979	open(PS, "ps auxhww\|") \|\| die "Unable to call ps";
1980	while (<PS>) {
1981	next if (! /$vmcmd/);
1982	next if (! /$vmm/);
1983	my ($void1, $void2);
1984	($void1, $vmexist, $void2) = split(/ +/);
1985	last;
1986	}
1987	return($vmexist);
1988	}
1989
1990
1991	sub pb_extract_build_files {
1992
1993	my $src=shift;
1994	my $dir=shift;
1995	my $ddir=shift;
1996	my @files;
1997
1998	if ($src =~ /tar\.gz$/) {
1999	pb_system("tar xfpz $src $dir","Extracting build files");
2000	} elsif ($src =~ /tar\.bz2$/) {
2001	pb_system("tar xfpj $src $dir","Extracting build files");
2002	} else {
2003	die "Unknown compression algorithm for $src";
2004	}
2005	opendir(DIR,"$dir") \|\| die "Unable to open directory $dir";
2006	foreach my $f (readdir(DIR)) {
2007	next if ($f =~ /^\./);
2008	move("$dir/$f","$ddir") \|\| die "Unable to move $dir/$f to $ddir";
2009	pb_log(2,"mv $dir/$f $ddir\n");
2010	push @files,"$ddir/$f";
2011	}
2012	closedir(DIR);
2013	# Not enough but still a first cleanup
2014	pb_rm_rf("$dir");
2015	return(@files);
2016	}
2017
2018	sub pb_list_bfiles {
2019
2020	my $dir = shift;
2021	my $pbpkg = shift;
2022	my $bfiles = shift;
2023	my $pkgfiles = shift;
2024	my $supfiles = shift;
2025
2026	opendir(BDIR,"$dir") \|\| die "Unable to open dir $dir: $!";
2027	foreach my $f (readdir(BDIR)) {
2028	next if ($f =~ /^\./);
2029	$bfiles->{$f} = "$dir/$f";
2030	$bfiles->{$f} =~ s~$ENV{'PBROOTDIR'}~~;
2031	if (defined $supfiles->{$pbpkg}) {
2032	$pkgfiles->{$f} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
2033	}
2034	}
2035	closedir(BDIR);
2036	}
2037
2038
2039	#
2040	# Return the list of packages we are working on in a non CMS action
2041	#
2042	sub pb_get_pkg {
2043
2044	my @pkgs = ();
2045
2046	my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
2047	@pkgs = keys %$var;
2048
2049	pb_log(0,"Packages: ".join(',',@pkgs)."\n");
2050	return(\@pkgs);
2051	}
2052
2053	1;

Note: See TracBrowser for help on using the repository browser.

Download in other formats: