Context Navigation

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

Last change on this file since 865 was 865, checked in by Bruno Cornec, 15 years ago
Do not force to have a vepath and vmpath in the .pbrc to start with Force to always build for the local distribution
Property svn:executable set to ``*
File size: 91.6 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 Time::localtime qw(localtime);
21	use POSIX qw(strftime);
22	use lib qw (lib);
23	use ProjectBuilder::Version;
24	use ProjectBuilder::Base;
25	use ProjectBuilder::Display;
26	use ProjectBuilder::Conf;
27	use ProjectBuilder::Distribution;
28	use ProjectBuilder::CMS;
29	use ProjectBuilder::Env;
30	use ProjectBuilder::Filter;
31	use ProjectBuilder::Changelog;
32	use Mail::Sendmail;
33
34	# Global variables
35	my %opts; # CLI Options
36	my $action; # action to realize
37	my $test = "FALSE"; # Not used
38	my $pbforce = 0; # Force VE/VM rebuild
39	my $pbsnap = 0; # Use snapshot mode for VM/VE
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 = undef; # 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, Git, Mercurial... 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 [-vhSq][-r pbroot][-p project][[-s script -a account -P port][-m mach-1[,...]]][-i iso] <action> [<pkg1> ...]
75
76	pb [--verbose][--help][--man][--quiet][--snapshot][--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<-S\|--snapshot>
95
96	Use the snapshot mode of VMs or VEs
97
98	=item B<--man>
99
100	Prints the manual page and exits.
101
102	=item B<-m\|--machine machine1[,machine2,...]>
103
104	Name of the Virtual Machines (VM) or Virtual Environments (VE) you want to build on (coma separated).
105	All if none precised (or use the env variable PBV).
106
107	=item B<-s\|--script script>
108
109	Name of the script you want to execute on the related VMs or VEs.
110
111	=item B<-i\|--iso iso_image>
112
113	Name of the ISO image of the distribution you want to install on the related VMs.
114
115	=item B<-a\|--account account>
116
117	Name of the account to use to connect on the related VMs.
118
119	=item B<-P\|--port port_number>
120
121	Port number to use to connect on the related VMs.\n";
122
123	=item B<-p\|--project project_name>
124
125	Name of the project you're working on (or use the env variable PBPROJ)
126
127	=item B<-r\|--revision revision>
128
129	Path Name of the project revision under the CMS (or use the env variable PBROOT)
130
131	=item B<-V\|--version new_version>
132
133	New version of the project to create based on the current one.
134
135	=back
136
137	=head1 ARGUMENTS
138
139	<action> can be:
140
141	=over 4
142
143	=item B<cms2build>
144
145	Create tar files for the project under your CMS.
146	CMS supported are SVN, CVS and Mercurial
147	parameters are packages to build
148	if not using default list
149
150	=item B<build2pkg>
151
152	Create packages for your running distribution
153
154	=item B<cms2pkg>
155
156	cms2build + build2pkg
157
158	=item B<build2ssh>
159
160	Send the tar files to a SSH host
161
162	=item B<cms2ssh>
163
164	cms2build + build2ssh
165
166	=item B<pkg2ssh>
167
168	Send the packages built to a SSH host
169
170	=item B<build2vm>
171
172	Create packages in VMs, launching them if needed
173	and send those packages to a SSH host once built
174	VM type supported are QEMU
175
176	=item B<build2ve>
177
178	Create packages in VEs, creating it if needed
179	and send those packages to a SSH host once built
180
181	=item B<cms2vm>
182
183	cms2build + build2vm
184
185	=item B<cms2ve>
186
187	cms2build + build2ve
188
189	=item B<launchvm>
190
191	Launch one virtual machine
192
193	=item B<launchve>
194
195	Launch one virtual environment
196
197	=item B<script2vm>
198
199	Launch one virtual machine if needed
200	and executes a script on it
201
202	=item B<script2ve>
203
204	Execute a script in a virtual environment
205
206	=item B<newvm>
207
208	Create a new virtual machine
209
210	=item B<newve>
211
212	Create a new virtual environment
213
214	=item B<setupvm>
215
216	Setup a virtual machine for pb usage
217
218	=item B<setupve>
219
220	Setup a virtual environment for pb usage
221
222	=item B<snapvm>
223
224	Snapshot a virtual machine for pb usage
225
226	=item B<snapve>
227
228	Snapshot a virtual environment for pb usage
229
230	=item B<test2pkg>
231
232	Test a package locally
233
234	=item B<test2vm>
235
236	Test a package in a virtual machine
237
238	=item B<test2ve>
239
240	Test a package in a virtual environment
241
242	=item B<newver>
243
244	Create a new version of the project derived
245	from the current one
246
247	=item B<newproj>
248
249	Create a new project and a template set of
250	configuration files under pbconf
251
252	=item B<announce>
253
254	Announce the availability of the project through various means
255
256	=item B<web2ssh>
257
258	Deliver the Web site content to the target server using ssh.
259
260	=item B<clean>
261
262	Purge the build and delivery directories related to the current project
263
264	=back
265
266	<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).
267
268	=head1 WEB SITES
269
270	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/>.
271
272	=head1 USER MAILING LIST
273
274	None exists for the moment.
275
276	=head1 CONFIGURATION FILES
277
278	Each pb user may have a configuration in F<$HOME/.pbrc>. The values in this file may overwrite any other configuration file value.
279
280	Here is an example of such a configuration file:
281
282	#
283	# Define for each project the URL of its pbconf repository
284	# No default option allowed here as they need to be all different
285	#
286	# URL of the pbconf content
287	# This is the format of a classical URL with the extension of additional schema such as
288	# svn+ssh, cvs+ssh, ...
289	#
290	pbconfurl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe/pbconf
291
292	# This is normaly defined in the project's configuration file
293	# Url of the project
294	#
295	pburl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe
296
297	# All these URLs needs to be defined here as the are the entry point
298	# for how to build packages for the project
299	#
300	pbconfurl pb = svn+ssh://svn.project-builder.org/mondo/svn/pb/pbconf
301	pbconfurl mondorescue = svn+ssh://svn.project-builder.org/mondo/svn/project-builder/mondorescue/pbconf
302	pbconfurl collectl = svn+ssh://bruno@svn.mondorescue.org/mondo/svn/project-builder/collectl/pbconf
303	pbconfurl netperf = svn+ssh://svn.mondorescue.org/mondo/svn/project-builder/netperf/pbconf
304
305	# Under that dir will take place everything related to pb
306	# If you want to use VMs/chroot/..., then use $ENV{'HOME'} to make it portable
307	# to your VMs/chroot/...
308	# if not defined then /var/cache
309	pbdefdir default = $ENV{'HOME'}/project-builder
310	pbdefdir pb = $ENV{'HOME'}
311	pbdefdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
312	pbdefdir mondorescue = $ENV{'HOME'}/mondo/svn
313
314	# pbconfdir points to the directory where the CMS content of the pbconfurl is checked out
315	# If not defined, pbconfdir is under pbdefdir/pbproj/pbconf
316	pbconfdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs/pbconf
317	pbconfdir mondorescue = $ENV{'HOME'}/mondo/svn/pbconf
318
319	# pbdir points to the directory where the CMS content of the pburl is checked out
320	# If not defined, pbdir is under pbdefdir/pbproj
321	# Only defined if we have access to the dev of the project
322	pbdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
323	pbdir mondorescue = $ENV{'HOME'}/mondo/svn
324
325	# -daemonize doesn't work with qemu 0.8.2
326	vmopt default = -m 384
327
328	=head1 AUTHORS
329
330	The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
331
332	=head1 COPYRIGHT
333
334	Project-Builder.org is distributed under the GPL v2.0 license
335	described in the file C<COPYING> included with the distribution.
336
337	=cut
338
339	# ---------------------------------------------------------------------------
340
341	my ($projectbuilderver,$projectbuilderrev) = pb_version_init();
342
343	# Initialize the syntax string
344
345	pb_syntax_init("pb (aka project-builder.org) Version $projectbuilderver-$projectbuilderrev\n");
346
347	GetOptions("help\|?\|h" => \$opts{'h'},
348	"man" => \$opts{'man'},
349	"verbose\|v+" => \$opts{'v'},
350	"snapshot\|S" => \$opts{'S'},
351	"quiet\|q" => \$opts{'q'},
352	"log-files\|l=s" => \$opts{'l'},
353	"force\|f" => \$opts{'f'},
354	"account\|a=s" => \$opts{'a'},
355	"revision\|r=s" => \$opts{'r'},
356	"script\|s=s" => \$opts{'s'},
357	"machines\|mock\|m=s" => \$opts{'m'},
358	"port\|P=i" => \$opts{'P'},
359	"project\|p=s" => \$opts{'p'},
360	"iso\|i=s" => \$opts{'i'},
361	"version\|V=s" => \$opts{'V'},
362	) \|\| pb_syntax(-1,0);
363
364	if (defined $opts{'h'}) {
365	pb_syntax(0,1);
366	}
367	if (defined $opts{'man'}) {
368	pb_syntax(0,2);
369	}
370	if (defined $opts{'v'}) {
371	$pbdebug = $opts{'v'};
372	}
373	if (defined $opts{'f'}) {
374	$pbforce=1;
375	}
376	if (defined $opts{'q'}) {
377	$pbdebug=-1;
378	}
379	if (defined $opts{'S'}) {
380	$pbsnap=1;
381	}
382	if (defined $opts{'l'}) {
383	open(pbLOG,"> $opts{'l'}") \|\| die "Unable to log to $opts{'l'}: $!";
384	$pbLOG = \*pbLOG;
385	$pbdebug = 0 if ($pbdebug == -1);
386	}
387	pb_log_init($pbdebug, $pbLOG);
388	pb_display_init("text","");
389
390	# Handle root of the project if defined
391	if (defined $opts{'r'}) {
392	$ENV{'PBROOTDIR'} = $opts{'r'};
393	}
394	# Handle virtual machines if any
395	if (defined $opts{'m'}) {
396	$ENV{'PBV'} = $opts{'m'};
397	}
398	if (defined $opts{'s'}) {
399	$pbscript = $opts{'s'};
400	}
401	if (defined $opts{'a'}) {
402	$pbaccount = $opts{'a'};
403	die "option -a requires a -s script option" if (not defined $pbscript);
404	}
405	if (defined $opts{'P'}) {
406	$pbport = $opts{'P'};
407	}
408	if (defined $opts{'V'}) {
409	$newver = $opts{'V'};
410	}
411	if (defined $opts{'i'}) {
412	$iso = $opts{'i'};
413	}
414
415	# Get Action
416	$action = shift @ARGV;
417	die pb_syntax(-1,1) if (not defined $action);
418
419	my ($filteredfiles, $supfiles, $defpkgdir, $extpkgdir);
420	my $pbinit = undef;
421	$pbinit = 1 if ($action =~ /^newproj$/);
422
423	# Handles project name if any
424	# And get global params
425	($filteredfiles, $supfiles, $defpkgdir, $extpkgdir) = pb_env_init($opts{'p'},$pbinit,$action);
426
427	pb_log(0,"Project: $ENV{'PBPROJ'}\n");
428	pb_log(0,"Action: $action\n");
429
430	# Act depending on action
431	if ($action =~ /^cms2build$/) {
432	pb_cms2build();
433	} elsif ($action =~ /^build2pkg$/) {
434	pb_build2pkg();
435	} elsif ($action =~ /^cms2pkg$/) {
436	pb_cms2build();
437	pb_build2pkg();
438	} elsif ($action =~ /^build2ssh$/) {
439	pb_build2ssh();
440	} elsif ($action =~ /^cms2ssh$/) {
441	pb_cms2build();
442	pb_build2ssh();
443	} elsif ($action =~ /^pkg2ssh$/) {
444	pb_pkg2ssh();
445	} elsif ($action =~ /^build2ve$/) {
446	pb_build2v("ve","build");
447	} elsif ($action =~ /^build2vm$/) {
448	pb_build2v("vm","build");
449	} elsif ($action =~ /^cms2ve$/) {
450	pb_cms2build();
451	pb_build2v("ve","build");
452	} elsif ($action =~ /^cms2vm$/) {
453	pb_cms2build();
454	pb_build2v("vm","build");
455	} elsif ($action =~ /^launchvm$/) {
456	pb_launchv("vm",$ENV{'PBV'},0);
457	} elsif ($action =~ /^launchve$/) {
458	pb_launchv("ve",$ENV{'PBV'},0);
459	} elsif ($action =~ /^script2vm$/) {
460	pb_script2v($pbscript,"vm");
461	} elsif ($action =~ /^script2ve$/) {
462	pb_script2v($pbscript,"ve");
463	} elsif ($action =~ /^newver$/) {
464	pb_newver();
465	} elsif ($action =~ /^newve$/) {
466	pb_launchv("ve",$ENV{'PBV'},1);
467	} elsif ($action =~ /^newvm$/) {
468	pb_launchv("vm",$ENV{'PBV'},1);
469	} elsif ($action =~ /^setupve$/) {
470	pb_setup2v("ve");
471	} elsif ($action =~ /^setupvm$/) {
472	pb_setup2v("vm");
473	} elsif ($action =~ /^snapve$/) {
474	pb_snap2v("ve");
475	} elsif ($action =~ /^snapvm$/) {
476	pb_snap2v("vm");
477	} elsif ($action =~ /^test2pkg$/) {
478	pb_test2pkg();
479	} elsif ($action =~ /^test2ve$/) {
480	pb_build2v("ve","test");
481	} elsif ($action =~ /^test2vm$/) {
482	pb_build2v("vm","test");
483	} elsif ($action =~ /^newproj$/) {
484	# Nothing to do - already done in pb_env_init
485	} elsif ($action =~ /^clean$/) {
486	pb_clean();
487	} elsif ($action =~ /^announce$/) {
488	# For announce only. Require avoids the systematic load of these modules
489	require DBI;
490	require DBD::SQLite;
491
492	pb_announce();
493	} elsif ($action =~ /^web2ssh$/) {
494	require DBI;
495	require DBD::SQLite;
496
497	pb_cms2build("Web");
498	pb_send2target("Web");
499	} else {
500	pb_log(0,"\'$action\' is not available\n");
501	pb_syntax(-2,1);
502	}
503
504	sub pb_cms2build {
505
506	my $param = shift \|\| undef;
507
508	my $pkg;
509	my @pkgs;
510	my $webdir;
511
512	my %pkgs;
513	my %pb; # Structure to store conf info
514
515	# If Website, then pkg is only the website
516	if ((defined $param) && ($param eq "Web")) {
517	($webdir) = pb_conf_get("webdir");
518	pb_log(2,"webdir: ".Dumper($webdir)."\n");
519	$pkgs[0] = $webdir->{$ENV{'PBPROJ'}};
520	$extpkgdir = $webdir;
521	pb_log(0,"Package: $pkgs[0]\n");
522	} else {
523	$pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
524	@pkgs = @$pkg;
525	}
526
527	my ($scheme, $uri) = pb_cms_init($pbinit);
528
529	my ($pkgv, $pkgt) = pb_conf_get_if("pkgver","pkgtag");
530
531	# declare packager and repo for filtering
532	my ($tmp1, $tmp2) = pb_conf_get("pbpackager","pbrepo");
533	$ENV{'PBPACKAGER'} = $tmp1->{$ENV{'PBPROJ'}};
534	$ENV{'PBREPO'} = $tmp2->{$ENV{'PBPROJ'}};
535
536	foreach my $pbpkg (@pkgs) {
537	my ($testver) = pb_conf_get_if("testver");
538	$ENV{'PBPKG'} = $pbpkg;
539
540	if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
541	$pbver = $pkgv->{$pbpkg};
542	} else {
543	$pbver = $ENV{'PBPROJVER'};
544	}
545	# If it's a test version, then tag == 0.date
546	if (defined $testver->{$ENV{'PBPROJ'}}) {
547	$pbtag = "0.".strftime("%Y%m%d%H%M%S", @date);
548	$ENV{'PBPROJTAG'} = $pbtag;
549	} elsif ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
550	$pbtag = $pkgt->{$pbpkg};
551	} else {
552	$pbtag = $ENV{'PBPROJTAG'};
553	}
554
555	$pbrev = $ENV{'PBREVISION'};
556	pb_log(0,"\n");
557	pb_log(0,"Management of $pbpkg $pbver-$pbtag (rev $pbrev)\n");
558	die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
559
560	# Clean up dest if necessary. The export will recreate it
561	my $dest = "$ENV{'PBDESTDIR'}/$pbpkg-$pbver";
562	pb_rm_rf($dest) if (-d $dest);
563
564	# Export CMS tree for the concerned package to dest
565	# And generate some additional files
566	$OUTPUT_AUTOFLUSH=1;
567
568	# computes in which dir we have to work
569	my $dir = $defpkgdir->{$pbpkg};
570	$dir = $extpkgdir->{$pbpkg} if (not defined $dir);
571	$dir = $webdir->{$ENV{'PBPROJ'}} if ((defined $param) && ($param eq "Web"));
572	pb_log(2,"def:".Dumper($defpkgdir)." ext: ".Dumper($extpkgdir)." \n");
573
574	# Exporting content from CMS
575	my $preserve = pb_cms_export($uri,"$ENV{'PBDIR'}/$dir",$dest);
576
577	# Generated fake content for test versions to speed up stuff
578	my $chglog;
579
580	# Get project info on authors and log file
581	$chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
582	$chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
583	$chglog = undef if (! -f $chglog);
584
585	my $authors = "$ENV{'PBROOTDIR'}/$pbpkg/pbauthors";
586	$authors = "$ENV{'PBROOTDIR'}/pbauthors" if (! -f $authors);
587	$authors = "/dev/null" if (! -f $authors);
588
589	# Extract cms log history and store it
590	if ((defined $chglog) && (! -f "$dest/NEWS")) {
591	pb_log(2,"Generating NEWS file from $chglog\n");
592	copy($chglog,"$dest/NEWS") \|\| die "Unable to create $dest/NEWS";
593	}
594	pb_cms_log($scheme,"$ENV{'PBDIR'}/$dir",$dest,$chglog,$authors,$testver);
595
596	my %build;
597	my @pt;
598	# We want to at least build for the underlying distro
599	my ($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $arch) = pb_distro_init();
600	my $tmpl = "$ddir-$dver-$arch,";
601	my %patches;
602
603	# Get list of distributions for which I need to generate build files
604	@pt = pb_conf_get_if("vmlist","velist");
605	if (defined $pt[0]->{$ENV{'PBPROJ'}}) {
606	$tmpl .= $pt[0]->{$ENV{'PBPROJ'}};
607	}
608	if (defined $pt[1]->{$ENV{'PBPROJ'}}) {
609	# the 2 lists needs to be grouped with a ',' separating them
610	if ($tmpl ne "") {
611	$tmpl .= ",";
612	}
613	$tmpl .= $pt[1]->{$ENV{'PBPROJ'}}
614	}
615
616	# Setup %pb structure to allow filtering later on, on files using that structure
617	$pb{'tag'} = $pbtag;
618	$pb{'rev'} = $pbrev;
619	$pb{'ver'} = $pbver;
620	$pb{'pkg'} = $pbpkg;
621	$pb{'date'} = $pbdate;
622	$pb{'defpkgdir'} = $defpkgdir;
623	$pb{'extpkgdir'} = $extpkgdir;
624	$pb{'chglog'} = $chglog;
625	$pb{'packager'} = $ENV{'PBPACKAGER'};
626	$pb{'proj'} = $ENV{'PBPROJ'};
627	$pb{'repo'} = $ENV{'PBREPO'};
628	$pb{'patches'} = \%patches;
629	pb_log(2,"DEBUG: pb: ".Dumper(%pb)."\n");
630
631	# Do not do that for website
632	if ((not defined $param) \|\| ($param ne "Web")) {
633	my %virt;
634	# De-duplicate similar VM and VE
635	foreach my $d (split(/,/,$tmpl)) {
636	# skip ill-formatted vms (name-ver-arch)
637	next if ($d !~ /-/);
638	$virt{$d} = $d;
639	}
640
641	foreach my $d (keys %virt) {
642	my ($name,$ver,$arch) = split(/-/,$d);
643	pb_log(0,"Bad format for $d") if ((not defined $name) \|\| (not defined $ver) \|\| (not defined $arch)) ;
644	chomp($arch);
645	my ($ddir, $dver, $dfam);
646	($ddir, $dver, $dfam, $pb{'dtype'}, $pb{'suf'}, $pb{'upd'}, $pb{'arch'}) = pb_distro_init($name,$ver,$arch);
647	pb_log(2,"DEBUG: distro tuple: ".Dumper($ddir, $dver, $dfam, $pb{'dtype'}, $pb{'suf'})."\n");
648	pb_log(2,"DEBUG Filtering PBDATE => $pbdate, PBTAG => $pbtag, PBVER => $pbver\n");
649
650	# We need to compute the real name of the package
651	my $pbrealpkg = pb_cms_get_real_pkg($pbpkg,$pb{'dtype'});
652	$pb{'realpkg'} = $pbrealpkg;
653	pb_log(1,"Virtual package $pbpkg has a real package name of $pbrealpkg on $ddir-$dver\n") if ($pbrealpkg ne $pbpkg);
654
655	# Filter build files from the less precise up to the most with overloading
656	# Filter all files found, keeping the name, and generating in dest
657
658	# Find all build files first relatively to PBROOTDIR
659	# Find also all specific files referenced in the .pb conf file
660	my %bfiles = ();
661	my %pkgfiles = ();
662	$build{"$ddir-$dver-$arch"} = "yes";
663
664	if (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pb{'dtype'}") {
665	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pb{'dtype'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
666	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$dfam") {
667	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$dfam",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
668	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir") {
669	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
670	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver") {
671	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
672	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver-$arch") {
673	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver-$arch",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
674	} else {
675	$build{"$ddir-$dver-$arch"} = "no";
676	next;
677	}
678	pb_log(2,"DEBUG bfiles: ".Dumper(\%bfiles)."\n");
679
680	# Get all filters to apply
681	my $ptr = pb_get_filters($pbpkg, $pb{'dtype'}, $dfam, $ddir, $dver);
682
683	# Prepare local patches for this distro - They are always applied first - May be a problem one day
684	foreach my $p (sort(<$ENV{'PBROOTDIR'}/$pbpkg/pbpatch/*>)) {
685	$patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.all$/));
686	$patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.all$/);
687	$patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$pb{'dtype'}$/));
688	$patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$pb{'dtype'}$/);
689	$patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$dfam$/));
690	$patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$dfam$/);
691	$patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir$/));
692	$patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir$/);
693	$patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir-$dver$/));
694	$patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir-$dver$/);
695	$patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir-$dver-$arch$/));
696	$patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir-$dver-$arch$/);
697	}
698
699	# Prepare also remote patches to be included - Applied after the local ones
700	foreach my $p ("all","$pb{'dtype'}","$dfam","$ddir","$ddir-$dver","$ddir-$dver-$arch") {
701	my $f = "$ENV{'PBROOTDIR'}/$pbpkg/pbextpatch.$p";
702	next if (not -f $f);
703	if (not open(PATCH,$f)) {
704	pb_display("Unable to open existing external patch file content $f\n");
705	next;
706	}
707	while (<PATCH>) {
708	chomp();
709	$patches{"$ddir-$dver-$arch"} .= "," if (defined $patches{"$ddir-$dver-$arch"});
710	$patches{"$ddir-$dver-$arch"} .= "$_";
711	}
712	close(PATCH);
713	}
714	pb_log(2,"DEBUG: pb->patches: ".Dumper($pb{'patches'})."\n");
715
716	# Apply now all the filters on all the files concerned
717	# destination dir depends on the type of file
718	if (defined $ptr) {
719	# For patch support
720	$pb{'tuple'} = "$ddir-$dver-$arch";
721	foreach my $f (values %bfiles,values %pkgfiles) {
722	pb_filter_file("$ENV{'PBROOTDIR'}/$f",$ptr,"$dest/pbconf/$ddir-$dver-$arch/".basename($f),\%pb);
723	}
724	}
725	}
726	my @found;
727	my @notfound;
728	foreach my $b (keys %build) {
729	push @found,$b if ($build{$b} =~ /yes/);
730	push @notfound,$b if ($build{$b} =~ /no/);
731	}
732	pb_log(0,"Build files generated for ".join(',',sort(@found))."\n");
733	pb_log(0,"No Build files found for ".join(',',sort(@notfound))."\n") if (@notfound);
734	pb_log(2,"DEBUG: patches: ".Dumper(%patches)."\n");
735	}
736
737	# Get the generic filter (all.pbf) and
738	# apply those to the non-build files including those
739	# generated by pbinit if applicable
740
741	# Get only all.pbf filter
742	my $ptr = pb_get_filters($pbpkg);
743
744	my $liste ="";
745	if (defined $filteredfiles->{$pbpkg}) {
746	foreach my $f (split(/,/,$filteredfiles->{$pbpkg})) {
747	pb_filter_file_inplace($ptr,"$dest/$f",\%pb);
748	$liste = "$f $liste";
749	}
750	}
751	pb_log(2,"Files ".$liste."have been filtered\n");
752
753	# Do not do that for website
754	if ((not defined $param) \|\| ($param ne "Web")) {
755	my %tmp;
756	# Filter potential patches (local + remote)
757	pb_log(0,"Delivering and compressing patches ");
758	foreach my $v (keys %patches) {
759	pb_mkdir_p("$dest/pbconf/$v/pbpatch");
760	foreach my $pf (split(/,/,$patches{$v})) {
761	my $pp = basename($pf);
762	pb_cms_export($pf,undef,"$dest/pbconf/$v/pbpatch");
763	pb_filter_file_inplace($ptr,"$dest/pbconf/$v/pbpatch/$pp",\%pb);
764	pb_system("gzip -9f $dest/pbconf/$v/pbpatch/$pp","","quiet");
765	$tmp{$pf} = "";
766	}
767	}
768	foreach my $v (keys %tmp) {
769	pb_log(0,"$v ");
770	}
771	pb_log(0,"\n");
772	} else {
773	# Instead call News generation
774	pb_web_news2html($dest);
775	# And create an empty pbconf
776	pb_mkdir_p("$dest/pbconf");
777	# And prepare the pbscript to execute remotely
778	open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
779	print SCRIPT "#!/bin/bash\n";
780	print SCRIPT "#set -x\n";
781	print SCRIPT "echo ... Extracting Website content\n";
782	print SCRIPT "find . -type f \| grep -Ev '^./$pbpkg-$pbver.tar.gz\|^./pbscript' \| xargs rm -f non-existent\n";
783	print SCRIPT "find * -type d -depth \| xargs rmdir 2> /dev/null \n";
784	print SCRIPT "tar xfz $pbpkg-$pbver.tar.gz\n";
785	print SCRIPT "mv $pbpkg-$pbver/* .\n";
786	print SCRIPT "rm -f $pbpkg-$pbver.tar.gz\n";
787	print SCRIPT "rmdir $pbpkg-$pbver\n";
788	close(SCRIPT);
789	}
790
791	# Prepare the dest directory for archive
792	if (-x "$ENV{'PBROOTDIR'}/$pbpkg/pbinit") {
793	pb_filter_file("$ENV{'PBROOTDIR'}/$pbpkg/pbinit",$ptr,"$ENV{'PBTMP'}/pbinit",\%pb);
794	chmod 0755,"$ENV{'PBTMP'}/pbinit";
795	pb_system("cd $dest ; $ENV{'PBTMP'}/pbinit","Executing init script from $ENV{'PBROOTDIR'}/$pbpkg/pbinit","verbose");
796	}
797
798	# Do we have additional script to run to prepare the environement for the project ?
799	# Then include it in the pbconf delivery
800	foreach my $pbvf (<$ENV{'PBROOTDIR'}/pbv.pre>,<$ENV{'PBROOTDIR'}/pbv.post>, <$ENV{'PBROOTDIR'}/pbtest*>) {
801	if (-x "$pbvf") {
802	my $target = "$ENV{'PBDESTDIR'}/".basename($pbvf);
803	pb_filter_file("$pbvf",$ptr,$target,\%pb);
804	chmod 0755,"$target";
805	}
806	}
807
808	# Archive dest dir
809	chdir "$ENV{'PBDESTDIR'}" \|\| die "Unable to change dir to $ENV{'PBDESTDIR'}";
810	if (defined $preserve) {
811	# In that case we want to preserve the original tar file for checksum purposes
812	# The one created is btw equivalent in that case to this one
813	# Maybe check basename of both to be sure they are the same ?
814	pb_log(0,"Preserving original tar file ");
815	move("$preserve","$pbpkg-$pbver.tar.gz");
816	} else {
817	# Possibility to look at PBSRC to guess more the filename
818	pb_system("tar cfz $pbpkg-$pbver.tar.gz --exclude=$pbpkg-$pbver/pbconf $pbpkg-$pbver","Creating $pbpkg tar files compressed");
819	}
820	pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz\n");
821	pb_system("tar cfz $pbpkg-$pbver.pbconf.tar.gz $pbpkg-$pbver/pbconf","Creating pbconf tar files compressed");
822	pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz\n");
823
824	# Keep track of version-tag per pkg
825	$pkgs{$pbpkg} = "$pbver-$pbtag";
826
827	# Final cleanup
828	pb_rm_rf($dest) if (-d $dest);
829	}
830
831	# Keep track of per package version
832	pb_log(2,"DEBUG pkgs: ".Dumper(%pkgs)."\n");
833	open(PKG,"> $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb") \|\| die "Unable to create $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb";
834	foreach my $pbpkg (keys %pkgs) {
835	print PKG "pbpkg $pbpkg = $pkgs{$pbpkg}\n";
836	}
837	close(PKG);
838
839	# Keep track of what is generated by default
840	# We need to store the dir and info on version-tag
841	# Base our content on the existing .pb file
842	copy("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb","$ENV{'PBDESTDIR'}/pbrc");
843	open(LAST,">> $ENV{'PBDESTDIR'}/pbrc") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbrc";
844	print LAST "pbroot $ENV{'PBPROJ'} = $ENV{'PBROOTDIR'}\n";
845	print LAST "projver $ENV{'PBPROJ'} = $ENV{'PBPROJVER'}\n";
846	print LAST "projtag $ENV{'PBPROJ'} = $ENV{'PBPROJTAG'}\n";
847	print LAST "pbpackager $ENV{'PBPROJ'} = $ENV{'PBPACKAGER'}\n";
848	close(LAST);
849	}
850
851	sub pb_test2pkg {
852	# Get the running distro to test on
853	my ($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $arch) = pb_distro_init();
854	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $arch))."\n");
855
856	# Get list of packages to test
857	# Get content saved in cms2build
858	my $ptr = pb_get_pkg();
859	@pkgs = @$ptr;
860
861	# Additional potential repo
862	pb_distro_setuprepo($ddir,$dver,$arch,$dtype);
863	foreach my $pbpkg (@pkgs) {
864	# We need to install the package to test, and deps brought with it
865	pb_distro_installdeps(undef,$dtype,$pbupd,$pbpkg);
866	pb_system("$ENV{'PBDESTDIR'}/pbtest","Launching test for $pbpkg","verbose");
867	}
868	}
869
870	sub pb_build2pkg {
871
872	# Get the running distro to build on
873	my ($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $arch) = pb_distro_init();
874	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $arch))."\n");
875
876	# Get list of packages to build
877	# Get content saved in cms2build
878	my $ptr = pb_get_pkg();
879	@pkgs = @$ptr;
880
881	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
882	$pkg = { } if (not defined $pkg);
883
884	chdir "$ENV{'PBBUILDDIR'}";
885	my $made = ""; # pkgs made during build
886	foreach my $pbpkg (@pkgs) {
887	my $vertag = $pkg->{$pbpkg};
888	# get the version of the current package - maybe different
889	($pbver,$pbtag) = split(/-/,$vertag);
890
891	my $src="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz";
892	my $src2="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
893	pb_log(2,"Source file: $src\n");
894	pb_log(2,"Pbconf file: $src2\n");
895
896	pb_log(2,"Working directory: $ENV{'PBBUILDDIR'}\n");
897	if ($dtype eq "rpm") {
898	foreach my $d ('RPMS','SRPMS','SPECS','SOURCES','BUILD') {
899	if (! -d "$ENV{'PBBUILDDIR'}/$d") {
900	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";
901	}
902	}
903
904	# Remove in case a previous link/file was there
905	unlink "$ENV{'PBBUILDDIR'}/SOURCES/".basename($src);
906	symlink "$src","$ENV{'PBBUILDDIR'}/SOURCES/".basename($src) \|\| die "Unable to symlink $src in $ENV{'PBBUILDDIR'}/SOURCES";
907	# We need to first extract the spec file
908	my @specfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/","$ENV{'PBBUILDDIR'}/SPECS","spec");
909
910	# We need to handle potential patches to upstream sources
911	pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/pbpatch/","$ENV{'PBBUILDDIR'}/SOURCES","patch");
912
913	pb_log(2,"specfile: ".Dumper(\@specfile)."\n");
914	# set LANGUAGE to check for correct log messages
915	$ENV{'LANGUAGE'}="C";
916	# Older Redhat use _target_platform in %configure incorrectly
917	my $specialdef = "";
918	if (($ddir eq "redhat") \|\| (($ddir eq "rhel") && ($dver eq "2.1"))) {
919	$specialdef = "--define \'_target_platform \"\"\'";
920	}
921
922	# If needed we may add repository to the build env
923	pb_distro_setuprepo($ddir,$dver,$arch,$dtype);
924	foreach my $f (@specfile) {
925	if ($f =~ /\.spec$/) {
926	pb_distro_installdeps("$f",$dtype,$pbupd);
927	pb_system("rpmbuild $specialdef --define \'packager $ENV{'PBPACKAGER'}\' --define \"_topdir $ENV{'PBBUILDDIR'}\" -ba $f","Building package with $f under $ENV{'PBBUILDDIR'}","verbose");
928	last;
929	}
930	}
931	# Get the name of the generated packages
932	open(LOG,"$ENV{'PBTMP'}/system.log") \|\| die "Unable to open $ENV{'PBTMP'}/system.log";
933	while (<LOG>) {
934	chomp($_);
935	next if ($_ !~ /^Wrote:/);
936	s\|./([S]RPMS.*)\|$1\|;
937	$made .=" $_";
938	}
939	close(LOG);
940
941	} elsif ($dtype eq "deb") {
942	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
943	pb_system("tar xfz $src","Extracting sources");
944	pb_system("tar xfz $src2","Extracting pbconf");
945
946	chdir "$pbpkg-$pbver" \|\| die "Unable to chdir to $pbpkg-$pbver";
947	pb_rm_rf("debian");
948	symlink "pbconf/$ddir-$dver-$arch","debian" \|\| die "Unable to symlink to pbconf/$ddir-$dver-$arch";
949	chmod 0755,"debian/rules";
950
951	pb_distro_setuprepo($ddir,$dver,$arch,$dtype);
952	pb_distro_installdeps("debian/control",$dtype,$pbupd);
953	pb_system("dpkg-buildpackage -us -uc -rfakeroot","Building package","verbose");
954	# Get the name of the generated packages
955	open(LOG,"$ENV{'PBTMP'}/system.log") \|\| die "Unable to open $ENV{'PBTMP'}/system.log";
956	while (<LOG>) {
957	chomp();
958	my $tmp = $_;
959	next if ($tmp !~ /^dpkg-deb.*:/);
960	$tmp =~ s\|.../(.)_(.).deb.\|$1\|;
961	$made="$made $tmp.dsc $tmp.tar.gz $tmp"."_.deb $tmp"."_.changes";
962	}
963	close(LOG);
964	} elsif ($dtype eq "ebuild") {
965	my @ebuildfile;
966	# For gentoo we need to take pb as subsystem name
967	# We put every apps here under sys-apps. hope it's correct
968	# We use pb's home dir in order to have a single OVERLAY line
969	my $tmpd = "$ENV{'HOME'}/portage/pb/sys-apps/$pbpkg";
970	pb_mkdir_p($tmpd) if (! -d "$tmpd");
971	pb_mkdir_p("$ENV{'HOME'}/portage/distfiles") if (! -d "$ENV{'HOME'}/portage/distfiles");
972
973	# We need to first extract the ebuild file
974	@ebuildfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/","$tmpd","ebuild");
975
976	# Prepare the build env for gentoo
977	my $found = 0;
978	my $pbbd = $ENV{'HOME'};
979	$pbbd =~ s\|/\|\\/\|g;
980	if (-r "/etc/make.conf") {
981	open(MAKE,"/etc/make.conf");
982	while (<MAKE>) {
983	$found = 1 if (/$pbbd\/portage/);
984	}
985	close(MAKE);
986	}
987	if ($found == 0) {
988	pb_system("sudo sh -c 'echo PORTDIR_OVERLAY=\"$ENV{'HOME'}/portage\" >> /etc/make.conf'");
989	}
990	#$found = 0;
991	#if (-r "/etc/portage/package.keywords") {
992	#open(KEYW,"/etc/portage/package.keywords");
993	#while (<KEYW>) {
994	#$found = 1 if (/portage\/pb/);
995	#}
996	#close(KEYW);
997	#}
998	#if ($found == 0) {
999	#pb_system("sudo sh -c \"echo portage/pb >> /etc/portage/package.keywords\"");
1000	#}
1001
1002	# Build
1003	foreach my $f (@ebuildfile) {
1004	if ($f =~ /\.ebuild$/) {
1005	pb_distro_installdeps("$f",$dtype,$pbupd);
1006	move($f,"$tmpd/$pbpkg-$pbver.ebuild");
1007	pb_system("cd $tmpd ; ebuild $pbpkg-$pbver.ebuild clean ; ebuild $pbpkg-$pbver.ebuild digest ; ebuild $pbpkg-$pbver.ebuild package","verbose");
1008	# Now move it where pb expects it
1009	pb_mkdir_p("$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
1010	move("$tmpd/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
1011	}
1012	}
1013
1014	$made="$made portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver.ebuild";
1015	} elsif ($dtype eq "tgz") {
1016	# Slackware family
1017	$made="$made $pbpkg/$pbpkg-$pbver-*-$pbtag.tgz";
1018
1019	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1020	pb_system("tar xfz $src","Extracting sources");
1021	pb_system("tar xfz $src2","Extracting pbconf");
1022	chdir "$pbpkg-$pbver" \|\| die "Unable to chdir to $pbpkg-$pbver";
1023	symlink "pbconf/$ddir-$dver-$arch","install" \|\| die "Unable to symlink to pbconf/$ddir-$dver-$arch";
1024	if (-x "install/pbslack") {
1025	pb_distro_installdeps("./install/pbslack",$dtype,$pbupd);
1026	pb_system("./install/pbslack","Building package");
1027	pb_system("sudo /sbin/makepkg -p -l y -c y $pbpkg","Packaging $pbpkg","verbose");
1028	}
1029	} else {
1030	die "Unknown dtype format $dtype";
1031	}
1032	}
1033	# Packages check if needed
1034	if ($dtype eq "rpm") {
1035	if (-f "/usr/bin/rpmlint") {
1036	pb_system("rpmlint $made","Checking validity of rpms with rpmlint","verbose");
1037	} else {
1038	pb_log(0,"rpm packages generated: $made\n");
1039	}
1040	} elsif ($dtype eq "deb") {
1041	my $made2 = "";
1042	if (-f "/usr/bin/lintian") {
1043	foreach my $f (split(/ /,$made)) {
1044	$made2 .= "../$f " if ($f =~ /\.changes$/);
1045	}
1046	pb_system("lintian $made2","Checking validity of debs with lintian","verbose");
1047	} else {
1048	pb_log(0,"deb packages generated: $made2\n");
1049	}
1050	} else {
1051	pb_log(0,"No check done for $dtype yet\n");
1052	pb_log(0,"Packages generated: $made\n");
1053	}
1054
1055	# Keep track of what is generated so that we can get them back from VMs
1056	open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to create $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1057	print KEEP "$made\n";
1058	close(KEEP);
1059	}
1060
1061	sub pb_build2ssh {
1062	pb_send2target("Sources");
1063	}
1064
1065	sub pb_pkg2ssh {
1066	pb_send2target("Packages");
1067	}
1068
1069	# By default deliver to the the public site hosting the
1070	# ftp structure (or whatever) or a VM/VE
1071	sub pb_send2target {
1072
1073	my $cmt = shift;
1074	my $v = shift \|\| undef;
1075	my $vmexist = shift \|\| 0; # 0 is FALSE
1076	my $vmpid = shift \|\| 0; # 0 is FALSE
1077	my $snapme = shift \|\| 0; # 0 is FALSE
1078
1079	pb_log(2,"DEBUG: pb_send2target($cmt,".Dumper($v).",$vmexist,$vmpid)\n");
1080	my $host = "sshhost";
1081	my $login = "sshlogin";
1082	my $dir = "sshdir";
1083	my $port = "sshport";
1084	my $conf = "sshconf";
1085	my $rebuild = "sshrebuild";
1086	my $tmout = "vmtmout";
1087	my $path = "vmpath";
1088	if ($cmt =~ /^VM/) {
1089	$login = "vmlogin";
1090	$dir = "pbdefdir";
1091	$tmout = "vmtmout";
1092	$rebuild = "vmrebuild";
1093	# Specific VM
1094	$host = "vmhost";
1095	$port = "vmport";
1096	} elsif ($cmt =~ /^VE/) {
1097	$login = "velogin";
1098	$dir = "pbdefdir";
1099	# Specific VE
1100	$path = "vepath";
1101	$conf = "veconf";
1102	$rebuild = "verebuild";
1103	} elsif ($cmt eq "Web") {
1104	$host = "websshhost";
1105	$login = "websshlogin";
1106	$dir = "websshdir";
1107	$port = "websshport";
1108	}
1109	my $cmd = "";
1110	my $src = "";
1111	my ($odir,$over,$oarch) = (undef, undef, undef);
1112	my ($ddir, $dver, $dfam, $dtype, $pbsuf);
1113
1114	if ($cmt ne "Announce") {
1115	my $ptr = pb_get_pkg();
1116	@pkgs = @$ptr;
1117
1118	# Get the running distro to consider
1119	if (defined $v) {
1120	($odir,$over,$oarch) = split(/-/,$v);
1121	}
1122	($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($odir,$over,$oarch);
1123	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n");
1124
1125	# Get list of packages to build
1126	# Get content saved in cms2build
1127	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1128	$pkg = { } if (not defined $pkg);
1129
1130	chdir "$ENV{'PBBUILDDIR'}";
1131	foreach my $pbpkg (@pkgs) {
1132	my $vertag = $pkg->{$pbpkg};
1133	# get the version of the current package - maybe different
1134	($pbver,$pbtag) = split(/-/,$vertag);
1135
1136	if (($cmt eq "Sources") \|\| ($cmt =~ /V[EM]build/)) {
1137	$src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
1138	if ($cmd eq "") {
1139	$cmd = "ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
1140	} else {
1141	$cmd = "$cmd ; ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
1142	}
1143	} elsif ($cmt eq "Web") {
1144	$src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz"
1145	}
1146	}
1147	# Adds conf file for availability of conf elements
1148	pb_conf_add("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb");
1149	}
1150
1151	if ($cmt =~ /V[EM]build/) {
1152	$src="$src $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc $ENV{'PBDESTDIR'}/pbscript";
1153	} elsif (($cmt =~ /V[EM]Script/) \|\| ($cmt eq "Web")) {
1154	$src="$src $ENV{'PBDESTDIR'}/pbscript";
1155	} elsif ($cmt =~ /V[EM]test/) {
1156	$src="$src $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc $ENV{'PBDESTDIR'}/pbscript $ENV{'PBDESTDIR'}/pbtest";
1157	} elsif ($cmt eq "Announce") {
1158	$src="$src $ENV{'PBTMP'}/pbscript";
1159	} elsif ($cmt eq "Packages") {
1160	# Get package list from file made during build2pkg
1161	open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1162	$src = <KEEP>;
1163	chomp($src);
1164	close(KEEP);
1165	$src="$src $ENV{'PBBUILDDIR'}/pbscript";
1166	}
1167	# Remove potential leading spaces (cause problem with basename)
1168	$src =~ s/^ *//;
1169	my $basesrc = "";
1170	foreach my $i (split(/ +/,$src)) {
1171	$basesrc .= " ".basename($i);
1172	}
1173
1174	pb_log(0,"Sources handled ($cmt): $src\n");
1175	pb_log(2,"values: ".Dumper(($host,$login,$dir,$port,$tmout,$rebuild,$path,$conf))."\n");
1176	my ($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vepath) = pb_conf_get($host,$login,$dir,$port,$tmout,$path);
1177	# Not mandatory
1178	my ($vrebuild,$veconf,$testver) = pb_conf_get_if($rebuild,$conf,"testver");
1179	pb_log(2,"ssh: ".Dumper(($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vrebuild,$vepath,$veconf))."\n");
1180
1181	my $mac;
1182	if ($cmt !~ /^VE/) {
1183	$mac = "$sshlogin->{$ENV{'PBPROJ'}}\@$sshhost->{$ENV{'PBPROJ'}}";
1184	# Overwrite account value if passed as parameter
1185	$mac = "$pbaccount\@$sshhost->{$ENV{'PBPROJ'}}" if (defined $pbaccount);
1186	pb_log(2, "DEBUG: pbaccount: $pbaccount => mac: $mac\n") if (defined $pbaccount);
1187	} else {
1188	# VE
1189	# Overwrite account value if passed as parameter (typically for setup2ve)
1190	$mac = $sshlogin->{$ENV{'PBPROJ'}};
1191	$mac = $pbaccount if (defined $pbaccount);
1192	}
1193
1194	my $tdir;
1195	my $bdir;
1196	if (($cmt eq "Sources") \|\| ($cmt =~ /V[EM]Script/)) {
1197	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/src";
1198	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1199	# This is a test pkg => target dir is under test
1200	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/test/src";
1201	}
1202	} elsif (($cmt =~ /V[EM]build/) \|\| ($cmt =~ /V[EM]test/)) {
1203	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/delivery";
1204	$bdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/build";
1205	# Remove a potential $ENV{'HOME'} as bdir should be relative to pb's home
1206	$bdir =~ s\|\$ENV.+\}/\|\|;
1207	} elsif ($cmt eq "Announce") {
1208	$tdir = "$sshdir->{$ENV{'PBPROJ'}}";
1209	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1210	# This is a test pkg => target dir is under test
1211	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/test";
1212	}
1213	} elsif ($cmt eq "Web") {
1214	$tdir = "$sshdir->{$ENV{'PBPROJ'}}";
1215	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1216	# This is a test website => target dir is under test
1217	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/../test";
1218	}
1219	} elsif ($cmt eq "Packages") {
1220	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ddir/$dver";
1221
1222	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1223	# This is a test pkg => target dir is under test
1224	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/test/$ddir/$dver";
1225	}
1226
1227	my $repodir = $tdir;
1228	$repodir =~ s\|^$sshdir->{$ENV{'PBPROJ'}}/\|\|;
1229
1230	my ($pbrepo) = pb_conf_get("pbrepo");
1231
1232	# Repository management
1233	open(PBS,"> $ENV{'PBBUILDDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBBUILDDIR'}/pbscript";
1234	if ($dtype eq "rpm") {
1235	# Also make a pbscript to generate yum/urpmi bases
1236	print PBS << "EOF";
1237	#!/bin/bash
1238	# Prepare a script to ease yum setup
1239	cat > $ENV{'PBPROJ'}.repo << EOT
1240	[$ENV{'PBPROJ'}]
1241	name=$ddir $dver - $ENV{'PBPROJ'} Vanilla Packages
1242	baseurl=$pbrepo->{$ENV{'PBPROJ'}}/$repodir
1243	enabled=1
1244	gpgcheck=0
1245	EOT
1246	chmod 644 $ENV{'PBPROJ'}.repo
1247
1248	# Clean up old repo content
1249	rm -rf headers/ repodata/
1250	# Create yum repo
1251	yum-arch .
1252	# Create repodata
1253	createrepo .
1254	EOF
1255	if ($dfam eq "md") {
1256	# For Mandriva add urpmi management
1257	print PBS << "EOF";
1258	# Prepare a script to ease urpmi setup
1259	cat > $ENV{'PBPROJ'}.addmedia << EOT
1260	urpmi.addmedia $ENV{'PBPROJ'} $pbrepo->{$ENV{'PBPROJ'}}/$repodir with hdlist.cz
1261	EOT
1262	chmod 755 $ENV{'PBPROJ'}.addmedia
1263
1264	# Clean up old repo content
1265	rm -f hdlist.cz synthesis.hdlist.cz
1266	# Create urpmi repo
1267	genhdlist .
1268	EOF
1269	}
1270	if ($ddir eq "fedora") {
1271	# Extract the spec file to please Fedora maintainers :-(
1272	print PBS << "EOF";
1273	for p in $basesrc; do
1274	echo \$p \| grep -q 'src.rpm'
1275	if [ \$\? -eq 0 ]; then
1276	rpm2cpio \$p \| cpio -ivdum --quiet '*.spec'
1277	fi
1278	done
1279	EOF
1280	}
1281	} elsif ($dtype eq "deb") {
1282	# Also make a pbscript to generate apt bases
1283	# Cf: http://www.debian.org/doc/manuals/repository-howto/repository-howto.fr.html
1284	my $rpd = dirname("$pbrepo->{$ENV{'PBPROJ'}}/$repodir");
1285	print PBS << "EOF";
1286	#!/bin/bash
1287	# Prepare a script to ease apt setup
1288	cat > $ENV{'PBPROJ'}.sources.list << EOT
1289	deb $rpd $dver contrib
1290	deb-src $rpd $dver contrib
1291	EOT
1292	chmod 644 $ENV{'PBPROJ'}.sources.list
1293
1294	# Prepare a script to create apt info file
1295	(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)
1296	#(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)
1297	EOF
1298	} elsif ($dtype eq "ebuild") {
1299	# make a pbscript to generate links to latest version
1300	print PBS << "EOF";
1301	#!/bin/bash
1302	# Prepare a script to create correct links
1303	for p in $src; do
1304	echo \$p \| grep -q '.ebuild'
1305	if [ \$\? -eq 0 ]; then
1306	j=`basename \$p`
1307	pp=`echo \$j \| cut -d'-' -f1`
1308	ln -sf \$j \$pp.ebuild
1309	fi
1310	done
1311	EOF
1312	}
1313	close(PBS);
1314	chmod 0755,"$ENV{'PBBUILDDIR'}/pbscript";
1315	} else {
1316	return;
1317	}
1318
1319	# Useless for VE
1320	my $nport;
1321	if ($cmt !~ /^VE/) {
1322	$nport = $sshport->{$ENV{'PBPROJ'}};
1323	$nport = "$pbport" if (defined $pbport);
1324	}
1325
1326	# Remove a potential $ENV{'HOME'} as tdir should be relative to pb's home
1327	$tdir =~ s\|\$ENV.+\}/\|\|;
1328
1329	my $tm = $vtmout->{$ENV{'PBPROJ'}};
1330
1331	# ssh communication if not VE
1332	# should use a hash instead...
1333	my ($shcmd,$cpcmd,$cptarget,$cp2target);
1334	if ($cmt !~ /^VE/) {
1335	my $keyfile = pb_ssh_get(0);
1336	$shcmd = "ssh -i $keyfile -q -o UserKnownHostsFile=/dev/null -p $nport $mac";
1337	$cpcmd = "scp -i $keyfile -p -o UserKnownHostsFile=/dev/null -P $nport";
1338	$cptarget = "$mac:$tdir";
1339	if ($cmt =~ /^VMbuild/) {
1340	$cp2target = "$mac:$bdir";
1341	}
1342	} else {
1343	my $tp = $vepath->{$ENV{'PBPROJ'}};
1344	($odir,$over,$oarch) = split(/-/,$v);
1345	my $tpdir = "$tp/$odir/$over/$oarch";
1346	my ($ptr) = pb_conf_get("vetype");
1347	my $vetype = $ptr->{$ENV{'PBPROJ'}};
1348	if ($vetype eq "chroot") {
1349	$shcmd = "sudo chroot $tpdir /bin/su - $mac -c ";
1350	$cpcmd = "sudo cp -r ";
1351	} elsif ($vetype eq "schroot") {
1352	$shcmd = "schroot $tp -u $mac -- ";
1353	$cpcmd = "sudo cp -r ";
1354	}
1355	# We need to get the home dir of the target account to deliver in the right place
1356	open(PASS,"$tpdir/etc/passwd") \|\| die "Unable to open $tpdir/etc/passwd";
1357	my $homedir = "";
1358	while (<PASS>) {
1359	my ($c1,$c2,$c3,$c4,$c5,$c6,$c7) = split(/:/);
1360	$homedir = $c6 if ($c1 =~ /^$mac$/);
1361	pb_log(3,"Homedir: $homedir - account: $c6\n");
1362	}
1363	close(PASS);
1364	$cptarget = "$tpdir/$homedir/$tdir";
1365	if ($cmt eq "VEbuild") {
1366	$cp2target = "$tpdir/$homedir/$bdir";
1367	}
1368	pb_log(2,"On VE using $cptarget as target dir to copy to\n");
1369	}
1370
1371	my $logres = "";
1372	# Do not touch when just announcing
1373	if ($cmt ne "Announce") {
1374	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");
1375	} else {
1376	$logres = "> ";
1377	}
1378	pb_system("cd $ENV{'PBBUILDDIR'} ; $cpcmd $src $cptarget 2> /dev/null","$cmt delivery in $cptarget");
1379
1380	# For VE we need to change the owner manually
1381	if ($cmt =~ /^VE/) {
1382	pb_system("$shcmd \"sudo chown -R $mac $tdir\"","Adapt owner in $tdir to $mac");
1383	}
1384
1385	pb_system("$shcmd \"echo \'cd $tdir ; if [ -x pbscript ]; then ./pbscript; fi ; rm -f ./pbscript\' \| bash\"","Executing pbscript on $cptarget if needed","verbose");
1386	if ($cmt =~ /^V[EM]build/) {
1387	# Get back info on pkg produced, compute their name and get them from the VM
1388	pb_system("$cpcmd $cp2target/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'} $ENV{'PBBUILDDIR'} 2> /dev/null","Get package names in $cp2target");
1389	# For VE we need to change the owner manually
1390	if ($cmt eq "VEbuild") {
1391	pb_system("sudo chown $UID $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}","Adapt owner in $tdir to $UID");
1392	}
1393	# return here to avoid breaking the load on VMs/VEs in case of a bad one
1394	if (not -f "$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") {
1395	pb_log(0,"Problem with VM $v on $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}");
1396	return;
1397	}
1398	open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1399	my $src = <KEEP>;
1400	chomp($src);
1401	close(KEEP);
1402	$src =~ s/^ *//;
1403	pb_mkdir_p("$ENV{'PBBUILDDIR'}/$odir/$over");
1404	# Change pgben to make the next send2target happy
1405	my $made = "";
1406	open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to write $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1407	foreach my $p (split(/ +/,$src)) {
1408	my $j = basename($p);
1409	pb_system("$cpcmd $cp2target/\'$p\' $ENV{'PBBUILDDIR'}/$odir/$over 2> /dev/null","Recovery of package $j in $ENV{'PBBUILDDIR'}/$odir/$over");
1410	$made="$made $odir/$over/$j"; # if (($dtype ne "rpm") \|\| ($j !~ /.src.rpm$/));
1411	}
1412	print KEEP "$made\n";
1413	close(KEEP);
1414	pb_system("$shcmd \"rm -rf $tdir $bdir\"","$cmt cleanup");
1415
1416	# Sign packages locally
1417	if ($dtype eq "rpm") {
1418	#pb_system("rpm --addsign --define \'_signature gpg\' --define \'__gpg_sign_cmd /usr/bin/gpg --batch --no-verbose --no-armor --no-secmem-warning -u \"$ENV{'PBPACKAGER'}\" -sbo %{__signature_filename} %{__plaintext_filename} --use-agent\' $made","Signing RPM packages packages");
1419	} elsif ($dtype eq "deb") {
1420	#pb_system("debsign $made","Signing DEB packages");
1421	} else {
1422	pb_log(0,"I don't know yet how to sign packages for type $dtype. Please give feedback to dev team");
1423	}
1424
1425	# We want to send them to the ssh account so overwrite what has been done before
1426	undef $pbaccount;
1427	pb_log(2,"Before sending pkgs, vmexist: $vmexist, vmpid: $vmpid\n");
1428	pb_send2target("Packages",$odir."-".$over."-".$oarch,$vmexist,$vmpid);
1429	pb_rm_rf("$ENV{'PBBUILDDIR'}/$odir");
1430	}
1431	pb_log(2,"Before halt, vmexist: $vmexist, vmpid: $vmpid\n");
1432	if ((! $vmexist) && ($cmt =~ /^VM/)) {
1433	# If in setupvm then takes a snapshot just before halting
1434	if ($snapme != 0) {
1435	my ($vmmonport,$vmtype) = pb_conf_get("vmmonport","vmtype");
1436	# For monitoring control
1437	if ((($vmtype->{$ENV{'PBPROJ'}}) eq "kvm") \|\| (($vmtype->{$ENV{'PBPROJ'}}) eq "qemu")) {
1438	require Net::Telnet;
1439	my $t = new Net::Telnet (Timeout => 120, Host => "localhost", Port => $vmmonport->{$ENV{'PBPROJ'}}) \|\| die "Unable to dialog on the monitor";
1440	# move to monitor mode
1441	my @lines = $t->cmd("c");
1442	# Create a snapshot named pb
1443	@lines = $t->cmd("savevm pb");
1444	# Write the new status in the VM
1445	@lines = $t->cmd("commit all");
1446	# End
1447	@lines = $t->cmd("quit");
1448	}
1449	}
1450	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)");
1451	}
1452	if (($cmt =~ /^VE/) && ($snapme != 0)) {
1453	($odir,$over,$oarch) = split(/-/,$v);
1454	my $tpdir = "$vepath->{$ENV{'PBPROJ'}}/$odir/$over/$oarch";
1455	pb_system("sudo tar cz -f $vepath->{$ENV{'PBPROJ'}}/$odir-$over-$oarch.tar.gz -C $tpdir .","Creating a snapshot of $tpdir");
1456	}
1457	}
1458
1459	sub pb_script2v {
1460	my $pbscript=shift;
1461	my $vtype=shift;
1462	my $pbforce=shift \|\| 0; # Force stop of VM. Default not
1463	my $vm1=shift \|\| undef; # Only that VM to treat
1464	my $snapme=shift \|\| 0; # Do we have to create a snapshot
1465	my $vm;
1466	my $all;
1467
1468	pb_log(2,"DEBUG: pb_script2v($pbscript,$vtype,$pbforce,".Dumper($vm1).",$snapme)\n");
1469	# Prepare the script to be executed on the VM
1470	# in $ENV{'PBDESTDIR'}/pbscript
1471	if ((defined $pbscript ) && ($pbscript ne "$ENV{'PBDESTDIR'}/pbscript")) {
1472	copy($pbscript,"$ENV{'PBDESTDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
1473	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
1474	}
1475
1476	if (not defined $vm1) {
1477	($vm,$all) = pb_get2v($vtype);
1478	} else {
1479	@$vm = ($vm1);
1480	}
1481	my ($vmexist,$vmpid) = (undef,undef);
1482
1483	foreach my $v (@$vm) {
1484	# Launch VM/VE - Usage of snapshot disabled
1485	($vmexist,$vmpid) = pb_launchv($vtype,$v,0,$snapme,0);
1486
1487	if ($vtype eq "vm") {
1488	pb_log(2,"DEBUG: After pb_launchv, vmexist: $vmexist, vmpid: $vmpid\n");
1489
1490	# Skip that VM if something went wrong
1491	next if (($vmpid == 0) && ($vmexist == 0));
1492
1493	# If force stopping the VM then reset vmexist
1494	if ($pbforce == 1) {
1495	$vmpid = $vmexist;
1496	$vmexist = 0;
1497	}
1498	} else {
1499	#VE
1500	$vmexist = 0;
1501	$vmpid = 0;
1502	}
1503
1504	# Gather all required files to send them to the VM
1505	# and launch the build through pbscript
1506	pb_log(2,"DEBUG: Before send2target, vmexist: $vmexist, vmpid: $vmpid\n");
1507	pb_send2target(uc($vtype)."Script","$v",$vmexist,$vmpid,$snapme);
1508
1509	}
1510	}
1511
1512	sub pb_launchv {
1513	my $vtype = shift;
1514	my $v = shift;
1515	my $create = shift \|\| 0; # By default do not create a VM/VE
1516	my $snapme = shift \|\| 0; # By default do not snap a VM/VE
1517	my $usesnap = shift \|\| 1; # By default study the usage of the snapshot feature of VM/VE
1518
1519	# If creation or snapshot creation mode, no snapshot usable
1520	if (($create == 1) \|\| ($snapme == 1)) {
1521	$usesnap = 0;
1522	}
1523
1524	pb_log(2,"DEBUG: pb_launchv($vtype,$v,$create,$snapme,$usesnap)\n");
1525	die "No VM/VE defined, unable to launch" if (not defined $v);
1526	# Keep only the first VM in case many were given
1527	$v =~ s/,.*//;
1528
1529	my $arch = pb_get_arch();
1530
1531	# Launch the VMs/VEs
1532	if ($vtype eq "vm") {
1533	die "-i iso parameter needed" if (((not defined $iso) \|\| ($iso eq "")) && ($create != 0));
1534
1535	my ($ptr,$vmpath,$vmport,$vmsize,$vmmonport) = pb_conf_get("vmtype","vmpath","vmport","vmsize","vmmonport");
1536	my ($vmopt,$vmtmout,$vmsnap) = pb_conf_get_if("vmopt","vmtmout","vmsnap");
1537
1538	my $vmtype = $ptr->{$ENV{'PBPROJ'}};
1539	if (not defined $ENV{'PBVMOPT'}) {
1540	$ENV{'PBVMOPT'} = "";
1541	}
1542	# Save the current status for later restoration
1543	$ENV{'PBOLDVMOPT'} = $ENV{'PBVMOPT'};
1544	# Set a default timeout of 2 minutes
1545	if (not defined $ENV{'PBVMTMOUT'}) {
1546	$ENV{'PBVMTMOUT'} = "120";
1547	}
1548	if (defined $vmopt->{$v}) {
1549	$ENV{'PBVMOPT'} .= " $vmopt->{$v}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$v}/);
1550	} elsif (defined $vmopt->{$ENV{'PBPROJ'}}) {
1551	$ENV{'PBVMOPT'} .= " $vmopt->{$ENV{'PBPROJ'}}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$ENV{'PBPROJ'}}/);
1552	}
1553
1554	# Are we allowed to use snapshot feature
1555	if ($usesnap == 1) {
1556	if ((defined $vmsnap->{$v}) && ($vmsnap->{$v} =~ /true/i)) {
1557	$ENV{'PBVMOPT'} .= "-snapshot ";
1558	} elsif ((defined $vmsnap->{$ENV{'PBPROJ'}}) && ($vmsnap->{$ENV{'PBPROJ'}} =~ /true/i)) {
1559	$ENV{'PBVMOPT'} .= "-snapshot ";
1560	} elsif ($pbsnap eq 1) {
1561	$ENV{'PBVMOPT'} .= "-snapshot ";
1562	}
1563	}
1564	if ($snapme != 0) {
1565	if (($vmtype eq "kvm") \|\| ($vmtype eq "qemu")) {
1566	# Configure the monitoring to automize the creation of the 'pb' snapshot
1567	$ENV{'PBVMOPT'} .= "-serial mon:telnet::$vmmonport->{$ENV{'PBPROJ'}},server,nowait ";
1568	# In that case no snapshot call needed
1569	$ENV{'PBVMOPT'} =~ s/-snapshot //;
1570	}
1571	}
1572	if (defined $vmtmout->{$v}) {
1573	$ENV{'PBVMTMOUT'} = $vmtmout->{$v};
1574	} elsif (defined $vmtmout->{$ENV{'PBPROJ'}}) {
1575	$ENV{'PBVMTMOUT'} = $vmtmout->{$ENV{'PBPROJ'}};
1576	}
1577	my $nport = $vmport->{$ENV{'PBPROJ'}};
1578	$nport = "$pbport" if (defined $pbport);
1579
1580	my $cmd;
1581	my $vmcmd; # has to be used for pb_check_ps
1582	my $vmm; # has to be used for pb_check_ps
1583	if (($vmtype eq "qemu") \|\| ($vmtype eq "kvm")) {
1584	my $qemucmd32;
1585	my $qemucmd64;
1586	if ($arch eq "x86_64") {
1587	$qemucmd32 = "/usr/bin/qemu-system-i386";
1588	$qemucmd64 = "/usr/bin/qemu";
1589	} else {
1590	$qemucmd32 = "/usr/bin/qemu";
1591	$qemucmd64 = "/usr/bin/qemu-system-x86_64";
1592	}
1593	if ($v =~ /x86_64/) {
1594	$vmcmd = "$qemucmd64";
1595	} else {
1596	$vmcmd = "$qemucmd32";
1597	}
1598	if ($vmtype eq "kvm") {
1599	$vmcmd = "/usr/bin/kvm";
1600	}
1601	$vmm = "$vmpath->{$ENV{'PBPROJ'}}/$v.qemu";
1602	if (($create != 0) \|\| (defined $iso)) {
1603	$ENV{'PBVMOPT'} .= " -cdrom $iso -boot d";
1604	}
1605	# Always redirect the network and always try to use a 'pb' snapshot
1606	$cmd = "$vmcmd $ENV{'PBVMOPT'} -redir tcp:$nport:10.0.2.15:22 -loadvm pb $vmm"
1607	} elsif ($vmtype eq "xen") {
1608	} elsif ($vmtype eq "vmware") {
1609	} else {
1610	die "VM of type $vmtype not supported. Report to the dev team";
1611	}
1612	# Restore the ENV VAR Value
1613	$ENV{'PBVMOPT'} = $ENV{'PBOLDVMOPT'};
1614
1615	my ($tmpcmd,$void) = split(/ +/,$cmd);
1616	my $vmexist = pb_check_ps($tmpcmd,$vmm);
1617	my $vmpid = 0;
1618	if (! $vmexist) {
1619	if ($create != 0) {
1620	die("Found an existing Virtual machine $vmm. Won't overwrite") if (-r $vmm);
1621	if (($vmtype eq "qemu") \|\| ($vmtype eq "xen") \|\| ($vmtype eq "kvm")) {
1622	pb_system("/usr/bin/qemu-img create -f qcow2 $vmm $vmsize->{$ENV{'PBPROJ'}}","Creating the QEMU VM");
1623	} elsif ($vmtype eq "vmware") {
1624	} else {
1625	}
1626	}
1627	if (! -f "$vmm") {
1628	pb_log(0,"Unable to find VM $vmm\n");
1629	} else {
1630	pb_system("$cmd &","Launching the VM $vmm");
1631	pb_system("sleep $ENV{'PBVMTMOUT'}","Waiting $ENV{'PBVMTMOUT'} s for VM $v to come up");
1632	$vmpid = pb_check_ps($tmpcmd,$vmm);
1633	pb_log(0,"VM $vmm launched (pid $vmpid)\n");
1634	}
1635	} else {
1636	pb_log(0,"Found an existing VM $vmm (pid $vmexist)\n");
1637	}
1638	pb_log(2,"DEBUG: pb_launchv returns ($vmexist,$vmpid)\n");
1639	return($vmexist,$vmpid);
1640	# VE here
1641	} else {
1642	# Get VE context
1643	my ($ptr,$vetmout,$vepath,$verebuild,$veconf,$vepostinstall) = pb_conf_get("vetype","vetmout","vepath","verebuild","veconf");
1644	my ($veb4pi,$vepi,$vepkglist,$vesnap) = pb_conf_get_if("veb4pi","vepi","vepkglist","vesnap");
1645	my $vetype = $ptr->{$ENV{'PBPROJ'}};
1646
1647	# Get distro context
1648	my ($name,$ver,$darch) = split(/-/,$v);
1649	chomp($darch);
1650	my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($name,$ver,$darch);
1651
1652	if (($vetype eq "chroot") \|\| ($vetype eq "schroot")) {
1653	# Architecture consistency
1654	if ($arch ne $darch) {
1655	die "Unable to launch a VE of architecture $darch on a $arch platform" if (($darch eq "x86_64") && ($arch =~ /i?86/));
1656	}
1657
1658	my ($verpmtype) = pb_conf_get("verpmtype");
1659	if (($create != 0) \|\| ($verebuild->{$ENV{'PBPROJ'}} eq "true") \|\| ($pbforce == 1)) {
1660	# We have to rebuild the chroot
1661	if ($dtype eq "rpm") {
1662
1663	my $verpmstyle = pb_distro_get_param($ddir,$dver,$darch,$verpmtype);
1664	if ($verpmstyle eq "rinse") {
1665	# Need to reshape the mirrors generated with local before-post-install script
1666	my $b4post = "--before-post-install ";
1667	my $postparam = pb_distro_get_param($ddir,$dver,$darch,$veb4pi);
1668	if ($postparam eq "") {
1669	$b4post = "";
1670	} else {
1671	$b4post .= $postparam;
1672	}
1673	# Do we have a local post-install script
1674	my $post = "--post-install ";
1675	$postparam = pb_distro_get_param($ddir,$dver,$darch,$vepi);
1676	if ($postparam eq "") {
1677	$post = "";
1678	} else {
1679	$post .= $postparam;
1680	}
1681
1682	# Need to reshape the package list for pb
1683	my $addpkgs;
1684	$postparam = pb_distro_get_param($ddir,$dver,$darch,$vepkglist);
1685	if ($postparam eq "") {
1686	$addpkgs = "";
1687	} else {
1688	my $pkgfile = "$ENV{'PBTMP'}/addpkgs.lis";
1689	open(PKG,"> $pkgfile") \|\| die "Unable to create $pkgfile";
1690	foreach my $p (split(/,/,$postparam)) {
1691	print PKG "$p\n";
1692	}
1693	close(PKG);
1694	$addpkgs = "--add-pkg-list $pkgfile";
1695	}
1696	my $rinseverb = "";
1697	$rinseverb = "--verbose" if ($pbdebug gt 0);
1698
1699	pb_system("sudo /usr/sbin/rinse --directory \"$vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch\" --arch \"$darch\" --distribution \"$ddir-$dver\" --config \"$veconf->{$ENV{'PBPROJ'}}\" $b4post $post $addpkgs $rinseverb","Creating the rinse VE for $ddir-$dver ($darch)", "verbose");
1700	} elsif ($verpmstyle eq "mock") {
1701	pb_system("sudo /usr/sbin/mock --init --resultdir=\"/tmp\" --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" -r $v","Creating the mock VE for $ddir-$dver ($darch)");
1702	# Once setup we need to install some packages, the pb account, ...
1703	pb_system("sudo /usr/sbin/mock --install --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" -r $v su","Configuring the mock VE");
1704	}
1705	} elsif ($dtype eq "deb") {
1706	pb_system("","Creating the pbuilder VE TBD");
1707	} elsif ($dtype eq "ebuild") {
1708	die "Please teach the dev team how to build gentoo chroot";
1709	} else {
1710	die "Unknown distribution type $dtype. Report to dev team";
1711	}
1712	}
1713	# Test if an existing snapshot exists and use it if appropriate
1714	# And also use it of no local extracted VE is present
1715	if ((-f "$vepath->{$ENV{'PBPROJ'}}/$ddir-$dver-$darch.tar.gz") &&
1716	(((defined $vesnap->{$v}) && ($vesnap->{$v} =~ /true/i)) \|\|
1717	((defined $vesnap->{$ENV{'PBPROJ'}}) && ($vesnap->{$ENV{'PBPROJ'}} =~ /true/i)) \|\|
1718	($pbsnap eq 1) \|\|
1719	(! -d "$vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch"))) {
1720	pb_system("sudo rm -rf $vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch ; sudo mkdir -p $vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch ; sudo tar xz -C $vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch -f $vepath->{$ENV{'PBPROJ'}}/$ddir-$dver-$darch.tar.gz","Extracting snapshot of $ddir-$dver-$darch.tar.gz under $vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch");
1721	}
1722	# Nothing more to do for VE. No real launch
1723	} else {
1724	die "VE of type $vetype not supported. Report to the dev team";
1725	}
1726	}
1727	}
1728
1729	# Return string for date synchro
1730	sub pb_date2v {
1731
1732	my $vtype = shift;
1733	my $v = shift;
1734
1735	my ($ntp) = pb_conf_get($vtype."ntp");
1736	my $vntp = $ntp->{$ENV{'PBPROJ'}};
1737	my $ntpline;
1738
1739	if (defined $vntp) {
1740	my ($ntpcmd) = pb_conf_get($vtype."ntpcmd");
1741	my $vntpcmd;
1742	if (defined $ntpcmd->{$v}) {
1743	$vntpcmd = $ntpcmd->{$v};
1744	} elsif (defined $ntpcmd->{$ENV{'PBPROJ'}}) {
1745	$vntpcmd = $ntpcmd->{$ENV{'PBPROJ'}};
1746	} else {
1747	$vntpcmd = "/bin/true";
1748	}
1749	$ntpline = "sudo $vntpcmd $vntp";
1750	} else {
1751	$ntpline = undef;
1752	}
1753	# Force new date to be in the future compared to the date
1754	# of the host by adding 1 minute
1755	my @date=pb_get_date();
1756	$date[1]++;
1757	my $upddate = strftime("%m%d%H%M%Y", @date);
1758	my $dateline = "sudo date $upddate";
1759	return($ntpline,$dateline);
1760	}
1761
1762	sub pb_build2v {
1763
1764	my $vtype = shift;
1765	my $action = shift \|\| "build";
1766
1767	my ($v,$all) = pb_get2v($vtype);
1768
1769	# Send tar files when we do a global generation
1770	pb_build2ssh() if (($all == 1) && ($action eq "build"));
1771
1772	my ($vmexist,$vmpid) = (undef,undef);
1773
1774	foreach my $v (@$v) {
1775	# Prepare the script to be executed on the VM/VE
1776	# in $ENV{'PBDESTDIR'}/pbscript
1777	open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
1778	print SCRIPT "#!/bin/bash\n";
1779
1780	# Transmit the verbosity level to the virtual env/mach.
1781	my $verbose = "";
1782	my $i = 0; # minimal debug level
1783	while ($i lt $pbdebug) {
1784	$verbose .= "-v ";
1785	$i++;
1786	}
1787	# Activate script verbosity if at least 2 for pbdebug
1788	print SCRIPT "set -x\n" if ($i gt 1);
1789	# Quiet if asked to be so on the original system
1790	$verbose = "-q" if ($pbdebug eq -1);
1791
1792	print SCRIPT "echo ... Execution needed\n";
1793	print SCRIPT "# This is in directory delivery\n";
1794	print SCRIPT "# Setup the variables required for building\n";
1795	print SCRIPT "export PBPROJ=$ENV{'PBPROJ'}\n";
1796
1797	if ($action eq "build") {
1798	print SCRIPT "# Preparation for pb\n";
1799	print SCRIPT "mv .pbrc \$HOME\n";
1800	print SCRIPT "cd ..\n";
1801	}
1802
1803	# VE needs a good /proc
1804	if ($vtype eq "ve") {
1805	print SCRIPT "sudo mount -t proc /proc /proc\n";
1806	}
1807
1808	my ($ntpline,$dateline) = pb_date2v($vtype,$v);
1809	print SCRIPT "# Time sync\n";
1810	print SCRIPT "echo 'setting up date with '";
1811	if (defined $ntpline) {
1812	print SCRIPT "echo $ntpline\n";
1813	print SCRIPT "$ntpline\n";
1814	} else {
1815	print SCRIPT "echo $dateline\n";
1816	print SCRIPT "$dateline\n";
1817	}
1818	# Use potential local proxy declaration in case we need it to download repo, pkgs, ...
1819	if (defined $ENV{'http_proxy'}) {
1820	print SCRIPT "export http_proxy=\"$ENV{'http_proxy'}\"\n";
1821	}
1822
1823	if (defined $ENV{'ftp_proxy'}) {
1824	print SCRIPT "export ftp_proxy=\"$ENV{'ftp_proxy'}\"\n";
1825	}
1826
1827	# Get list of packages to build/test and get some ENV vars as well
1828	my $ptr = pb_get_pkg();
1829	@pkgs = @$ptr;
1830	my $p = join(' ',@pkgs) if (@pkgs);
1831	print SCRIPT "export PBPROJVER=$ENV{'PBPROJVER'}\n";
1832	print SCRIPT "export PBPROJTAG=$ENV{'PBPROJTAG'}\n";
1833	print SCRIPT "export PBPACKAGER=\"$ENV{'PBPACKAGER'}\"\n";
1834
1835	# We may need to do some other tasks before building. Read a script here to finish setup
1836	if (-x "$ENV{'PBDESTDIR'}/pb$vtype".".pre") {
1837	print SCRIPT "# Special pre-instructions to be launched\n";
1838	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype".".pre");
1839	}
1840
1841	if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."$action.pre") {
1842	print SCRIPT "# Special pre-$action instructions to be launched\n";
1843	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."$action.pre");
1844	}
1845
1846	print SCRIPT "# $action\n";
1847	print SCRIPT "echo $action"."ing packages on $vtype...\n";
1848
1849	if (($action eq "test") && (! -x "$ENV{'PBDESTDIR'}/pbtest")) {
1850	die "No test script ($ENV{'PBDESTDIR'}/pbtest) found when in test mode. Aborting ...";
1851	}
1852	print SCRIPT "pb $verbose -p $ENV{'PBPROJ'} $action"."2pkg $p\n";
1853
1854	if ($vtype eq "ve") {
1855	print SCRIPT "sudo umount /proc\n";
1856	}
1857
1858	# We may need to do some other tasks after building. Read a script here to exit properly
1859	if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."$action.post") {
1860	print SCRIPT "# Special post-$action instructions to be launched\n";
1861	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."$action.post");
1862	}
1863
1864	if (-x "$ENV{'PBDESTDIR'}/pb$vtype".".post") {
1865	print SCRIPT "# Special post-instructions to be launched\n";
1866	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype".".post");
1867	}
1868
1869	close(SCRIPT);
1870	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
1871
1872	# Launch the VM/VE
1873	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1874
1875	if ($vtype eq "vm") {
1876	# Skip that VM if it something went wrong
1877	next if (($vmpid == 0) && ($vmexist == 0));
1878	} else {
1879	# VE
1880	$vmexist = 0;
1881	$vmpid = 0;
1882	}
1883	# Gather all required files to send them to the VM/VE
1884	# and launch the build through pbscript
1885	pb_log(2,"Calling send2target $vtype,$v,$vmexist,$vmpid\n");
1886	pb_send2target(uc($vtype).$action,"$v",$vmexist,$vmpid);
1887	}
1888	}
1889
1890
1891	sub pb_clean {
1892
1893	my $sleep=10;
1894	die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
1895	die "Unable to get env var PBBUILDDIR" if (not defined $ENV{'PBBUILDDIR'});
1896	pb_log(0,"We will now wait $sleep s before removing both directories\n$ENV{'PBDESTDIR'} and $ENV{'PBBUILDDIR'}.\nPlease break me if this is wrong\n");
1897	sleep $sleep;
1898	pb_rm_rf($ENV{'PBDESTDIR'});
1899	pb_rm_rf($ENV{'PBBUILDDIR'});
1900	}
1901
1902	sub pb_newver {
1903
1904	die "-V Version parameter needed" if ((not defined $newver) \|\| ($newver eq ""));
1905
1906	# Need this call for PBDIR
1907	my ($scheme2,$uri) = pb_cms_init($pbinit);
1908
1909	my ($pbconf) = pb_conf_get("pbconfurl");
1910	$uri = $pbconf->{$ENV{'PBPROJ'}};
1911	my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);
1912
1913	# Checking CMS repositories status
1914	my ($pburl) = pb_conf_get("pburl");
1915	($scheme2, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}});
1916
1917	if ($scheme !~ /^svn/) {
1918	die "Only SVN is supported at the moment";
1919	}
1920
1921	my $res = pb_cms_isdiff($scheme,$ENV{'PBROOTDIR'});
1922	die "ERROR: No differences accepted in CMS for $ENV{'PBROOTDIR'} before creating a new version" if ($res != 0);
1923
1924	$res = pb_cms_isdiff($scheme2,$ENV{'PBDIR'});
1925	die "ERROR: No differences accepted in CMS for $ENV{'PBDIR'} before creating a new version" if ($res != 0);
1926
1927	# Tree identical between PBCONFDIR and PBROOTDIR. The delta is what
1928	# we want to get for the root of the new URL
1929
1930	my $tmp = $ENV{'PBROOTDIR'};
1931	$tmp =~ s\|^$ENV{'PBCONFDIR'}\|\|;
1932
1933	my $newurl = "$uri/".dirname($tmp)."/$newver";
1934	# Should probably use projver in the old file
1935	my $oldver= basename($tmp);
1936
1937	# Duplicate and extract project-builder part
1938	pb_log(2,"Copying $uri/$tmp to $newurl\n");
1939	pb_cms_copy($scheme,"$uri/$tmp",$newurl);
1940	pb_log(2,"Checkout $newurl to $ENV{'PBROOTDIR'}/../$newver\n");
1941	pb_cms_up($scheme,"$ENV{'PBCONFDIR'}/..");
1942
1943	# Duplicate and extract project
1944	my $newurl2 = "$pburl->{$ENV{'PBPROJ'}}/".dirname($tmp)."/$newver";
1945
1946	pb_log(2,"Copying $pburl->{$ENV{'PBPROJ'}}/$tmp to $newurl2\n");
1947	pb_cms_copy($scheme2,"$pburl->{$ENV{'PBPROJ'}}/$tmp",$newurl2);
1948	pb_log(2,"Checkout $newurl2 to $ENV{'PBDIR'}/../$newver\n");
1949	pb_cms_up($scheme2,"$ENV{'PBDIR'}/..");
1950
1951	# Update the .pb file
1952	open(FILE,"$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb") \|\| die "Unable to open $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb";
1953	open(OUT,"> $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new") \|\| die "Unable to write to $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new";
1954	while(<FILE>) {
1955	s/^projver\s+$ENV{'PBPROJ'}\s=\s$oldver/projver $ENV{'PBPROJ'} = $newver/;
1956	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/);
1957	s/^testver/#testver/;
1958	pb_log(0,"Commenting testver in $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb\n") if (/^testver/);
1959	print OUT $_;
1960	}
1961	close(FILE);
1962	close(OUT);
1963	rename("$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new","$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb");
1964
1965	# Checking pbcl files
1966	foreach my $f (<$ENV{'PBROOTDIR'}/*/pbcl>) {
1967	# Compute new pbcl file
1968	my $f2 = $f;
1969	$f2 =~ s\|$ENV{'PBROOTDIR'}\|$ENV{'PBROOTDIR'}/../$newver/\|;
1970	open(PBCL,$f) \|\| die "Unable to open $f";
1971	my $foundnew = 0;
1972	while (<PBCL>) {
1973	$foundnew = 1 if (/^$newver \(/);
1974	}
1975	close(PBCL);
1976	open(OUT,"> $f2") \|\| die "Unable to write to $f2: $!";
1977	open(PBCL,$f) \|\| die "Unable to open $f";
1978	while (<PBCL>) {
1979	print OUT "$_" if (not /^$oldver \(/);
1980	if ((/^$oldver \(/) && ($foundnew == 0)) {
1981	print OUT "$newver ($pbdate)\n";
1982	print OUT "- TBD\n";
1983	print OUT "\n";
1984	pb_log(0,"WARNING: version $newver not found in $f so added to $f2...\n") if ($foundnew == 0);
1985	}
1986	}
1987	close(OUT);
1988	close(PBCL);
1989	}
1990
1991	pb_log(2,"Checkin $ENV{'PBROOTDIR'}/../$newver\n");
1992	pb_cms_checkin($scheme,"$ENV{'PBROOTDIR'}/../$newver",undef);
1993	}
1994
1995	#
1996	# Return the list of VMs/VEs we are working on
1997	# $all is a flag to know if we return all of them
1998	# or only some (if all we publish also tar files in addition to pkgs
1999	#
2000	sub pb_get2v {
2001
2002	my $vtype = shift;
2003	my @v;
2004	my $all = 0;
2005	my $vlist;
2006	my $pbv = 'PBV';
2007
2008	if ($vtype eq "vm") {
2009	$vlist = "vmlist";
2010	} elsif ($vtype eq "ve") {
2011	$vlist = "velist";
2012	}
2013	# Get VM/VE list
2014	if ((not defined $ENV{$pbv}) \|\| ($ENV{$pbv} =~ /^all$/)) {
2015	my ($ptr) = pb_conf_get($vlist);
2016	$ENV{$pbv} = $ptr->{$ENV{'PBPROJ'}};
2017	$all = 1;
2018	}
2019	pb_log(2,"$vtype: $ENV{$pbv}\n");
2020	@v = split(/,/,$ENV{$pbv});
2021	return(\@v,$all);
2022	}
2023
2024	# Function to create a potentialy missing pb account on the VM/VE, and adds it to sudo
2025	# Needs to use root account to connect to the VM/VE
2026	# pb will take your local public SSH key to access
2027	# the pb account in the VM later on if needed
2028	sub pb_setup2v {
2029
2030	my $vtype = shift;
2031
2032	my ($vm,$all) = pb_get2v($vtype);
2033
2034	# Script generated
2035	my $pbscript = "$ENV{'PBDESTDIR'}/setupv";
2036
2037	foreach my $v (@$vm) {
2038	# Deal with date sync.
2039	my ($ntpline,$dateline) = pb_date2v($vtype,$v);
2040
2041	# Name of the account to deal with for VM/VE
2042	# Do not use the one passed potentially with -a
2043	my ($pbac) = pb_conf_get($vtype."login");
2044	my ($key,$zero0,$zero1,$zero2);
2045	my ($vmexist,$vmpid);
2046
2047	# Prepare the script to be executed on the VM/VE
2048	# in $ENV{'PBDESTDIR'}/setupv
2049	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
2050
2051	print SCRIPT << 'EOF';
2052	#!/usr/bin/perl -w
2053
2054	use strict;
2055	use File::Copy;
2056
2057	# We should not need in this script more functions than what is provided
2058	# by Base and Distribution to avoid problems at exec time.
2059	# They are appended at the end.
2060
2061	our $pbdebug;
2062	our $pbLOG;
2063	our $pbsynmsg = "pbscript";
2064	our $pbdisplaytype = "text";
2065	our $pblocale = "";
2066	pb_log_init($pbdebug, $pbLOG);
2067	pb_temp_init();
2068
2069	EOF
2070
2071	# Launch the VM/VE - Usage of snapshot disabled
2072	($vmexist,$vmpid) = pb_launchv($vtype,$v,0,0,0);
2073
2074	if ($vtype eq "vm") {
2075	# Prepare the key to be used and transfered remotely
2076	my $keyfile = pb_ssh_get(1);
2077
2078	my ($vmhost,$vmport,$vmntp) = pb_conf_get("vmhost","vmport","vmntp");
2079	my $nport = $vmport->{$ENV{'PBPROJ'}};
2080	$nport = "$pbport" if (defined $pbport);
2081
2082	# Skip that VM if something went wrong
2083	next if (($vmpid == 0) && ($vmexist == 0));
2084
2085	# Store the pub key part in a variable
2086	open(FILE,"$keyfile.pub") \|\| die "Unable to open $keyfile.pub";
2087	($zero0,$zero1,$zero2) = split(/ /,<FILE>);
2088	close(FILE);
2089
2090	$key = "\Q$zero1";
2091
2092	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 may require the root password");
2093	# once this is done, we can do what we want on the VM remotely
2094	} elsif ($vtype eq "ve") {
2095	# We need to finish the setup of packages needed in the VE if needed
2096	# rinse at least needs it
2097	my ($vepkglist) = pb_conf_get_if("vepkglist");
2098
2099	if (defined $vepkglist) {
2100	# Get distro context
2101	my ($name,$ver,$darch) = split(/-/,$v);
2102	chomp($darch);
2103	my ($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd) = pb_distro_init($name,$ver,$darch);
2104
2105	my $postparam = pb_distro_get_param($ddir,$dver,$darch,$vepkglist);
2106	# Change the list of pkg in to a space separated list
2107	$postparam =~ s/,/ /g;
2108	# remove potential sudo from the update command for this time,
2109	# as this will be run as root anyway, and if not we will have
2110	# a problem with tty
2111	$pbupd =~ s/sudo //g;
2112
2113	print SCRIPT << "EOF";
2114	# For VE we first need to mount some FS
2115	pb_system("mount -t proc /proc /proc");
2116
2117	# For VE we need a good null dev
2118	pb_system("rm -f /dev/null; mknod /dev/null c 1 3; chmod 777 /dev/null");
2119
2120	# For VE we need some additional packages that are not there yet
2121	pb_system("$pbupd $postparam");
2122
2123	EOF
2124	}
2125	}
2126	if ($vtype eq "vm") {
2127	print SCRIPT << 'EOF';
2128	# Removes duplicate in .ssh/authorized_keys of our key if needed
2129	#
2130	my $file1="$ENV{'HOME'}/.ssh/authorized_keys";
2131	open(PBFILE,$file1) \|\| die "Unable to open $file1";
2132	open(PBOUT,"> $file1.new") \|\| die "Unable to open $file1.new";
2133	my $count = 0;
2134	while (<PBFILE>) {
2135
2136	EOF
2137	print SCRIPT << "EOF";
2138	if (/ $key /) {
2139	\$count++;
2140	}
2141	print PBOUT \$_ if ((\$count <= 1) \|\| (\$_ !~ / $key /));
2142	}
2143	close(PBFILE);
2144	close(PBOUT);
2145	rename("\$file1.new",\$file1);
2146	chmod 0600,\$file1;
2147
2148	# Sync date
2149	EOF
2150	if (defined $ntpline) {
2151	print SCRIPT "system(\"$ntpline\");\n";
2152	} else {
2153	print SCRIPT "system(\"$dateline\");\n";
2154	}
2155	}
2156	print SCRIPT << 'EOF';
2157
2158	# Adds $pbac->{$ENV{'PBPROJ'}} as an account if needed
2159	#
2160	my $file="/etc/passwd";
2161	open(PBFILE,$file) \|\| die "Unable to open $file";
2162	my $found = 0;
2163	while (<PBFILE>) {
2164	EOF
2165	print SCRIPT << "EOF";
2166	\$found = 1 if (/^$pbac->{$ENV{'PBPROJ'}}:/);
2167	EOF
2168	print SCRIPT << 'EOF';
2169	}
2170	close(PBFILE);
2171
2172	if ( $found == 0 ) {
2173	if ( ! -d "/home" ) {
2174	pb_mkdir("/home");
2175	}
2176	EOF
2177	print SCRIPT << "EOF";
2178	pb_system("groupadd $pbac->{$ENV{'PBPROJ'}}","Adding group $pbac->{$ENV{'PBPROJ'}}");
2179	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'}}");
2180	}
2181	EOF
2182
2183	if ($vtype eq "vm") {
2184	print SCRIPT << "EOF";
2185	# allow ssh entry to build
2186	#
2187	mkdir "/home/$pbac->{$ENV{'PBPROJ'}}/.ssh",0700;
2188	# Allow those accessing root to access the build account
2189	copy("\$ENV{'HOME'}/.ssh/authorized_keys","/home/$pbac->{$ENV{'PBPROJ'}}/.ssh/authorized_keys");
2190	chmod 0600,".ssh/authorized_keys";
2191	pb_system("chown -R $pbac->{$ENV{'PBPROJ'}}:$pbac->{$ENV{'PBPROJ'}} /home/$pbac->{$ENV{'PBPROJ'}}","Finish setting up the account env for $pbac->{$ENV{'PBPROJ'}}");
2192
2193	EOF
2194	}
2195	print SCRIPT << 'EOF';
2196	# No passwd for build account only keys
2197	$file="/etc/shadow";
2198	if (-f $file) {
2199	open(PBFILE,$file) \|\| die "Unable to open $file";
2200	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
2201	while (<PBFILE>) {
2202	EOF
2203	print SCRIPT << "EOF";
2204	s/^$pbac->{$ENV{'PBPROJ'}}:\!\!:/$pbac->{$ENV{'PBPROJ'}}:*:/;
2205	s/^$pbac->{$ENV{'PBPROJ'}}:\!:/$pbac->{$ENV{'PBPROJ'}}:*:/; #SLES 9 e.g.
2206	EOF
2207	print SCRIPT << 'EOF';
2208	print PBOUT $_;
2209	}
2210	close(PBFILE);
2211	close(PBOUT);
2212	rename("$file.new",$file);
2213	chmod 0640,$file;
2214	}
2215
2216	# Keep the VM in text mode
2217	$file="/etc/inittab";
2218	if (-f $file) {
2219	open(PBFILE,$file) \|\| die "Unable to open $file";
2220	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
2221	while (<PBFILE>) {
2222	s/^(..):5:initdefault:$/$1:3:initdefault:/;
2223	print PBOUT $_;
2224	}
2225	close(PBFILE);
2226	close(PBOUT);
2227	rename("$file.new",$file);
2228	chmod 0640,$file;
2229	}
2230
2231	# pb has to be added to portage group on gentoo
2232
2233	# Adapt sudoers
2234	$file="/etc/sudoers";
2235	open(PBFILE,$file) \|\| die "Unable to open $file";
2236	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
2237	while (<PBFILE>) {
2238	EOF
2239	print SCRIPT << "EOF";
2240	next if (/^$pbac->{$ENV{'PBPROJ'}} /);
2241	EOF
2242	print SCRIPT << 'EOF';
2243	s/Defaults[ \t]+requiretty//;
2244	print PBOUT $_;
2245	}
2246	close(PBFILE);
2247	EOF
2248	print SCRIPT << "EOF";
2249	# This is needed in order to be able to halt the machine from the $pbac->{$ENV{'PBPROJ'}} account at least
2250	print PBOUT "Defaults:pb env_keep += \\\"http_proxy ftp_proxy\\\"\n";
2251	print PBOUT "$pbac->{$ENV{'PBPROJ'}} ALL=(ALL) NOPASSWD:ALL\n";
2252	EOF
2253	print SCRIPT << 'EOF';
2254	close(PBOUT);
2255	rename("$file.new",$file);
2256	chmod 0440,$file;
2257
2258	EOF
2259
2260	my $SCRIPT = \*SCRIPT;
2261
2262	pb_install_deps($SCRIPT);
2263
2264	print SCRIPT << 'EOF';
2265	# Suse wants sudoers as 640
2266	if (($ddir eq "sles") \|\| (($ddir eq "opensuse") && ($dver =~ /10.[012]/))) {
2267	chmod 0640,$file;
2268	}
2269
2270	pb_system("rm -rf ProjectBuilder-* ; wget --passive-ftp ftp://ftp.mondorescue.org/src/ProjectBuilder-latest.tar.gz ; tar xvfz ProjectBuilder-latest.tar.gz ; cd ProjectBuilder-* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf 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");
2271	system "pb 2>&1 \| head -5";
2272	EOF
2273	if ($vtype eq "ve") {
2274	print SCRIPT << 'EOF';
2275	# For VE we need to umount some FS at the end
2276
2277	pb_system("umount /proc");
2278
2279	# Create a basic network file if not already there
2280
2281	my $nf="/etc/sysconfig/network";
2282	if (! -f $nf) {
2283	open(NF,"> $nf") \|\| die "Unable to create $nf";
2284	print NF "NETWORKING=yes\n";
2285	print NF "HOSTNAME=localhost\n";
2286	close(NF);
2287	}
2288	chmod 0755,$nf;
2289	EOF
2290	}
2291
2292	# Adds pb_distro_init from ProjectBuilder::Distribution and Base
2293	foreach my $d (@INC) {
2294	my @f = ("$d/ProjectBuilder/Base.pm","$d/ProjectBuilder/Distribution.pm");
2295	foreach my $f (@f) {
2296	if (-f "$f") {
2297	open(PBD,"$f") \|\| die "Unable to open $f";
2298	while (<PBD>) {
2299	next if (/^package/);
2300	next if (/^use Exporter/);
2301	next if (/^use ProjectBuilder::/);
2302	next if (/^our /);
2303	print SCRIPT $_;
2304	}
2305	close(PBD);
2306	}
2307	}
2308	}
2309	close(SCRIPT);
2310	chmod 0755,"$pbscript";
2311
2312	# That build script needs to be run as root and force stop of VM at end
2313	$pbaccount = "root";
2314
2315	# Force shutdown of VM exept if it was already launched
2316	my $pbforce = 0;
2317	if ((! $vmexist) && ($vtype eq "vm")) {
2318	$pbforce = 1;
2319	}
2320
2321	pb_script2v($pbscript,$vtype,$pbforce,$v);
2322	}
2323	return;
2324	}
2325
2326	# Function to create a snapshot named 'pb' for VMs and a compressed tar for VEs
2327	sub pb_snap2v {
2328
2329	my $vtype = shift;
2330
2331	my ($vm,$all) = pb_get2v($vtype);
2332
2333	# Script generated
2334	my $pbscript = "$ENV{'PBDESTDIR'}/snapv";
2335
2336	foreach my $v (@$vm) {
2337	# Name of the account to deal with for VM/VE
2338	# Do not use the one passed potentially with -a
2339	my ($pbac) = pb_conf_get($vtype."login");
2340	my ($vmexist,$vmpid);
2341
2342	# Prepare the script to be executed on the VM/VE
2343	# in $ENV{'PBDESTDIR'}/setupv
2344	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
2345
2346	print SCRIPT << 'EOF';
2347	#!/bin/bash
2348	sleep 2
2349	EOF
2350	close(SCRIPT);
2351	chmod 0755,"$pbscript";
2352
2353	# Force shutdown of VM/VE
2354	# Force snapshot of VM/VE
2355	pb_script2v($pbscript,$vtype,1,$v,1);
2356	}
2357	return;
2358	}
2359
2360	sub pb_install_deps {
2361
2362	my $SCRIPT = shift;
2363
2364	print {$SCRIPT} << 'EOF';
2365	# We need to have that pb_distro_init function
2366	# Get it from Project-Builder::Distribution
2367	my ($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $arch) = pb_distro_init();
2368	print "distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf, $arch))."\n";
2369
2370	# We may need a proxy configuration. Get it from the local env
2371	EOF
2372
2373	if (defined $ENV{'http_proxy'}) {
2374	print SCRIPT "\$ENV\{'http_proxy'\}=\"$ENV{'http_proxy'}\";\n";
2375	}
2376
2377	if (defined $ENV{'ftp_proxy'}) {
2378	print SCRIPT "\$ENV\{'ftp_proxy'\}=\"$ENV{'ftp_proxy'}\";\n";
2379	}
2380
2381	print {$SCRIPT} << 'EOF';
2382	# Get and install pb
2383	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*";
2384	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*";
2385	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*";
2386	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*";
2387	my $insms = "rm -rf Mail-Sendmail* ; wget http://search.cpan.org/CPAN/authors/id/M/MI/MIVKOVIC/Mail-Sendmail-0.79.tar.gz ; tar xvfz Mail-Sendmail-0.79.tar.gz ; cd Mail-Sendmail* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf Mail-Sendmail*";
2388	my $cmtdm = "Installing Date-Manip perl module";
2389	my $cmtmb = "Installing Module-Build perl module";
2390	my $cmtfm = "Installing File-MimeInfo perl module";
2391	my $cmtfb = "Installing File-Basedir perl module";
2392	my $cmtms = "Installing Perl-Sendmail perl module";
2393	my $cmtall = "Installing required modules";
2394
2395	if ( $ddir eq "fedora" ) {
2396	pb_system("yum clean all","Cleaning yum env");
2397	if ($dver == 4) {
2398	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"rpm-build wget patch ntp sudo perl-DateManip perl-ExtUtils-MakeMaker"));
2399	pb_system("$insmb","$cmtmb");
2400	pb_system("$insfm","$cmtfm");
2401	pb_system("$insfb","$cmtfb");
2402	pb_system("$insms","$cmtms");
2403	} else {
2404	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"rpm-build wget patch ntp sudo perl-DateManip perl-ExtUtils-MakeMaker perl-File-MimeInfo perl-Mail-Sendmail"));
2405	}
2406	} elsif ($ddir eq "asianux") {
2407	pb_system("yum clean all","Cleaning yum env");
2408	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"rpm-build wget patch ntp sudo perl-DateManip"));
2409	pb_system("$insmb","$cmtmb");
2410	pb_system("$insfm","$cmtfm");
2411	pb_system("$insfb","$cmtfb");
2412	pb_system("$insms","$cmtms");
2413	} elsif (( $dfam eq "rh" ) \|\| ($ddir eq "suse") \|\| ($ddir eq "sles") \|\| (($ddir eq "opensuse") && (($dver eq "10.1") \|\| ($dver eq "10.0"))) \|\| ($ddir eq "slackware")) {
2414	# Suppose pkg are installed already as no online mirror available
2415	pb_system("rpm -e lsb 2>&1 > /dev/null","Removing lsb package");
2416	pb_system("$insdm","$cmtdm");
2417	pb_system("$insmb","$cmtmb");
2418	pb_system("$insfm","$cmtfm");
2419	pb_system("$insfb","$cmtfb");
2420	pb_system("$insms","$cmtms");
2421	} elsif ($ddir eq "opensuse") {
2422	# New OpenSuSE
2423	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"make wget patch sudo ntp"));
2424	pb_system("$insmb","$cmtmb");
2425	pb_system("$insfm","$cmtfm");
2426	pb_system("$insfb","$cmtfb");
2427	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"perl-Date-Manip perl-File-HomeDir perl-Mail-Sendmail"));
2428	if ($dver < 11) {
2429	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"ntp"));
2430	} else {
2431	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"sntp"));
2432	}
2433	} elsif ( $dfam eq "md" ) {
2434	my $addp = "";
2435	if (($ddir eq "mandrake") && ($dver eq "10.1")) {
2436	pb_system("$insdm","$cmtdm");
2437	} else {
2438	$addp ="perl-DateManip";
2439	}
2440	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"rpm-build wget sudo patch ntp-client perl-File-MimeInfo perl-Mail-Sendmail $addp"));
2441	} elsif ( $dfam eq "du" ) {
2442	if (( $dver eq "3.1" ) && ($ddir eq "debian")) {
2443	pb_system("$insfb","$cmtfb");
2444	pb_system("$insfm","$cmtfm");
2445	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"wget patch ssh sudo debian-builder dh-make fakeroot ntpdate libmodule-build-perl libdate-manip-perl libmail-sendmail-perl"));
2446	} else {
2447	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"wget patch openssh-server dpkg-dev sudo debian-builder dh-make fakeroot ntpdate libfile-mimeinfo-perl libmodule-build-perl libdate-manip-perl libmail-sendmail-perl"));
2448	}
2449	} elsif ( $dfam eq "gen" ) {
2450	#system "emerge -u system";
2451	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"wget sudo ntp DateManip File-MimeInfo Mail-Sendmail"));
2452	} else {
2453	pb_log(0,"No pkg to install\n");
2454	}
2455	EOF
2456	}
2457
2458	sub pb_announce {
2459
2460	# Get all required parameters
2461	my ($pbpackager,$pbrepo,$pbml,$pbsmtp) = pb_conf_get("pbpackager","pbrepo","pbml","pbsmtp");
2462	my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
2463	my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
2464	my @pkgs = @$pkg;
2465	my %pkgs;
2466	my $first = 0;
2467
2468	# Command to find packages on repo
2469	my $findstr = "find . ";
2470	# Generated announce files
2471	my @files;
2472
2473	foreach my $pbpkg (@pkgs) {
2474	if ($first != 0) {
2475	$findstr .= "-o ";
2476	}
2477	$first++;
2478	if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
2479	$pbver = $pkgv->{$pbpkg};
2480	} else {
2481	$pbver = $ENV{'PBPROJVER'};
2482	}
2483	if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
2484	$pbtag = $pkgt->{$pbpkg};
2485	} else {
2486	$pbtag = $ENV{'PBPROJTAG'};
2487	}
2488
2489	# TODO: use virtual/real names here now
2490	$findstr .= "-name \'$pbpkg-$pbver-$pbtag\..rpm\' -o -name \'$pbpkg"."_$pbver\.deb\' -o -name \'$pbpkg-$pbver\.ebuild\' ";
2491
2492	my $chglog;
2493
2494	# Get project info on log file and generate tmp files used later on
2495	pb_cms_init($pbinit);
2496	$chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
2497	$chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
2498	$chglog = undef if (! -f $chglog);
2499
2500	open(OUT,"> $ENV{'PBTMP'}/$pbpkg.ann") \|\| die "Unable to create $ENV{'PBTMP'}/$pbpkg.ann: $!";
2501	my %pb;
2502	$pb{'dtype'} = "announce";
2503	$pb{'realpkg'} = $pbpkg;
2504	$pb{'ver'} = $pbver;
2505	$pb{'tag'} = $pbtag;
2506	$pb{'suf'} = "N/A"; # Should not be empty even if unused
2507	$pb{'date'} = $pbdate;
2508	$pb{'chglog'} = $chglog;
2509	$pb{'packager'} = $pbpackager;
2510	$pb{'proj'} = $ENV{'PBPROJ'};
2511	$pb{'repo'} = $pbrepo;
2512	pb_changelog(\%pb,\*OUT,"yes");
2513	close(OUT);
2514	push(@files,"$ENV{'PBTMP'}/$pbpkg.ann");
2515	}
2516	$findstr .= " \| grep -Ev \'src.rpm\'";
2517	if ((not defined $testver) \|\| (not defined $testver->{$ENV{'PBPROJ'}}) \|\| ($testver->{$ENV{'PBPROJ'}} !~ /true/i)) {
2518	$findstr .= " \| grep -v ./test/";
2519	}
2520
2521	# Prepare the command to run and execute it
2522	open(PBS,"> $ENV{'PBTMP'}/pbscript") \|\| die "Unable to create $ENV{'PBTMP'}/pbscript";
2523	print PBS "$findstr\n";
2524	close(PBS);
2525	chmod 0755,"$ENV{'PBTMP'}/pbscript";
2526	pb_send2target("Announce");
2527
2528	# Get subject line
2529	my $sl = "Project $ENV{'PBPROJ'} version $ENV{'PBPROJVER'} is now available";
2530	pb_log(0,"Please enter the title of your announce\n");
2531	pb_log(0,"(By default: $sl)\n");
2532	my $sl2 = <STDIN>;
2533	$sl = $sl2 if ($sl2 !~ /^$/);
2534
2535	# Prepare a template of announce
2536	open(ANN,"> $ENV{'PBTMP'}/announce.html") \|\| die "Unable to create $ENV{'PBTMP'}/announce.html: $!";
2537	print ANN << "EOF";
2538	$sl</p>
2539
2540	<p>The project team is happy to announce the availability of a newest version of $ENV{'PBPROJ'} $ENV{'PBPROJVER'}. Enjoy it as usual!</p>
2541	<p>
2542	Now available at <a href="$pbrepo->{$ENV{'PBPROJ'}}">$pbrepo->{$ENV{'PBPROJ'}}</a>
2543	</p>
2544	<p>
2545	EOF
2546	open(LOG,"$ENV{'PBTMP'}/system.log") \|\| die "Unable to read $ENV{'PBTMP'}/system.log: $!";
2547	my $col = 2;
2548	my $i = 1;
2549	print ANN << 'EOF';
2550	<TABLE WIDTH="700" CELLPADDING="0" CELLSPACING="0" BORDER="0">
2551	<TR>
2552	EOF
2553	while (<LOG>) {
2554	print ANN "<TD><A HREF=\"$pbrepo->{$ENV{'PBPROJ'}}/$_\">$_</A></TD>";
2555	$i++;
2556	if ($i > $col) {
2557	print ANN "</TR>\n<TR>";
2558	$i = 1;
2559	}
2560	}
2561	close(LOG);
2562	print ANN << "EOF";
2563	</TR>
2564	</TABLE>
2565	</p>
2566
2567	<p>As usual source packages are also available in the same directory.</p>
2568
2569	<p>
2570	Changes are :
2571	</p>
2572	<p>
2573	EOF
2574	# Get each package changelog content
2575	foreach my $f (sort(@files)) {
2576	open(IN,"$f") \|\| die "Unable to read $f:$!";
2577	while (<IN>) {
2578	print ANN $_;
2579	}
2580	close(IN);
2581	print ANN "</p><p>\n";
2582	}
2583	print ANN "</p>\n";
2584	close(ANN);
2585
2586	# Allow for modification
2587	pb_system("vi $ENV{'PBTMP'}/announce.html","Allowing modification of the announce","noredir");
2588
2589	# Store it in DB for external usage (Web pages generation)
2590	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
2591
2592	my $precmd = "";
2593	if (! -f $db) {
2594	$precmd = "CREATE TABLE announces (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, announce VARCHAR[65535])";
2595	}
2596
2597	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
2598	{ RaiseError => 1, AutoCommit => 1 })
2599	\|\| die "Unable to connect to $db";
2600
2601	if ($precmd ne "") {
2602	my $sth = $dbh->prepare(qq{$precmd})
2603	\|\| die "Unable to create table into $db";
2604	$sth->execute();
2605	}
2606
2607	# To read whole file
2608	local $/;
2609	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
2610	my $announce = <ANN>;
2611	close(ANN);
2612
2613	pb_log(2,"INSERT INTO announces VALUES (NULL, $pbdate, $announce)");
2614	my $sth = $dbh->prepare(qq{INSERT INTO announces VALUES (NULL,?,?)})
2615	\|\| die "Unable to insert into $db";
2616	$sth->execute($pbdate, $announce);
2617	$sth->finish();
2618	$dbh->disconnect;
2619
2620	# Then deliver it on the Web
2621	# $TOOLHOME/livwww www
2622
2623	# Mail it to project's ML
2624	open(ML,"\| w3m -dump -T text/html > $ENV{'PBTMP'}/announce.txt") \|\| die "Unable to create $ENV{'PBTMP'}/announce.txt: $!";
2625	print ML << 'EOF';
2626	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/x html1/DTD/xhtml1-strict.dtd">
2627
2628	<html xmlns="http://www.w3.org/1999/xhtml" dir="ltr" xml:lang="en" lang="en">
2629	<head>
2630	</head>
2631	<body>
2632	<p>
2633	EOF
2634	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
2635	while(<ANN>) {
2636	print ML $_;
2637	}
2638	print ML << 'EOF';
2639	</body>
2640	</html>
2641	EOF
2642	close(ML);
2643
2644	# To read whole file
2645	local $/;
2646	open(ANN,"$ENV{'PBTMP'}/announce.txt") \|\| die "Unable to read $ENV{'PBTMP'}/announce.txt: $!";
2647	my $msg = <ANN>;
2648	close(ANN);
2649
2650	# Preparation of headers
2651
2652	my %mail = (
2653	To => $pbml->{$ENV{'PBPROJ'}},
2654	From => $pbpackager->{$ENV{'PBPROJ'}},
2655	Smtp => $pbsmtp->{$ENV{'PBPROJ'}},
2656	Body => $msg,
2657	Subject => "[ANNOUNCE] $sl",
2658	);
2659
2660	# Send mail
2661	sendmail(%mail) or die "Unable to send mail ($Mail::Sendmail::error): $Mail::Sendmail::log";
2662	}
2663
2664	#
2665	# Creates a set of HTML file containing the news for the project
2666	# based on what has been generated by the pb_announce function
2667	#
2668	sub pb_web_news2html {
2669
2670	my $dest = shift \|\| $ENV{'PBTMP'};
2671
2672	# Get all required parameters
2673	my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
2674
2675	# DB of announces for external usage (Web pages generation)
2676	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
2677
2678	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
2679	{ RaiseError => 1, AutoCommit => 1 })
2680	\|\| die "Unable to connect to $db";
2681	# For date handling
2682	$ENV{LANGUAGE}="C";
2683	my $firstjan = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year(), 0, 0, -1);
2684	my $oldfirst = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year()-1, 0, 0, -1);
2685	pb_log(2,"firstjan: $firstjan, oldfirst: $oldfirst, pbdate:$pbdate\n");
2686	my $all = $dbh->selectall_arrayref("SELECT id,date,announce FROM announces ORDER BY date DESC");
2687	my %news;
2688	$news{"cy"} = ""; # current year's news
2689	$news{"ly"} = ""; # last year news
2690	$news{"py"} = ""; # previous years news
2691	$news{"fp"} = ""; # first page news
2692	my $cpt = 4; # how many news for first page
2693	# Extract info from DB
2694	foreach my $row (@$all) {
2695	my ($id, $date, $announce) = @$row;
2696	$news{"cy"} = $news{"cy"}."<p><B>$date</B> $announce\n" if ((($date cmp $pbdate) le 0) && (($firstjan cmp $date) le 0));
2697	$news{"ly"} = $news{"ly"}."<p><B>$date</B> $announce\n" if ((($date cmp $firstjan) le 0) && (($oldfirst cmp $date) le 0));
2698	$news{"py"} = $news{"py"}."<p><B>$date</B> $announce\n" if (($date cmp $oldfirst) le 0);
2699	$news{"fp"} = $news{"fp"}."<p><B>$date</B> $announce\n" if ($cpt > 0);
2700	$cpt--;
2701	}
2702	pb_log(1,"news{fp}: ".$news{"fp"}."\n");
2703	$dbh->disconnect;
2704
2705	# Generate the HTML content
2706	foreach my $pref (keys %news) {
2707	open(NEWS,"> $dest/pb_web_$pref"."news.html") \|\| die "Unable to create $dest/pb_web_$pref"."news.html: $!";
2708	print NEWS "$news{$pref}";
2709	close(NEWS);
2710	}
2711	}
2712
2713
2714	# Return the SSH key file to use
2715	# Potentially create it if needed
2716
2717	sub pb_ssh_get {
2718
2719	my $create = shift \|\| 0; # Do not create keys by default
2720
2721	# Check the SSH environment
2722	my $keyfile = undef;
2723
2724	# We have specific keys by default
2725	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
2726	if (!(-e $keyfile) && ($create eq 1)) {
2727	pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
2728	}
2729
2730	$keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
2731	$keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
2732	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
2733	die "Unable to find your public ssh key under $keyfile" if (not defined $keyfile);
2734	return($keyfile);
2735	}
2736
2737
2738	# Returns the pid of a running VM command using a specific VM file
2739	sub pb_check_ps {
2740	my $vmcmd = shift;
2741	my $vmm = shift;
2742	my $vmexist = 0; # FALSE by default
2743
2744	open(PS, "ps auxhww\|") \|\| die "Unable to call ps";
2745	while (<PS>) {
2746	next if (! /$vmcmd/);
2747	next if (! /$vmm/);
2748	my ($void1, $void2);
2749	($void1, $vmexist, $void2) = split(/ +/);
2750	last;
2751	}
2752	return($vmexist);
2753	}
2754
2755
2756	sub pb_extract_build_files {
2757
2758	my $src=shift;
2759	my $dir=shift;
2760	my $ddir=shift;
2761	my $mandatory=shift \|\| "spec";
2762	my @files;
2763
2764	my $flag = "mayfail" if ($mandatory eq "patch");
2765	my $res;
2766
2767	if ($src =~ /tar\.gz$/) {
2768	$res = pb_system("tar xfpz $src $dir","Extracting $mandatory files from $src",$flag);
2769	} elsif ($src =~ /tar\.bz2$/) {
2770	$res = pb_system("tar xfpj $src $dir","Extracting $mandatory files from $src",$flag);
2771	} else {
2772	die "Unknown compression algorithm for $src";
2773	}
2774	# If not mandatory return now
2775	return() if (($res != 0) and ($mandatory eq "patch"));
2776	opendir(DIR,"$dir") \|\| die "Unable to open directory $dir";
2777	foreach my $f (readdir(DIR)) {
2778	next if ($f =~ /^\./);
2779	# Skip potential patch dir
2780	next if ($f =~ /^pbpatch/);
2781	move("$dir/$f","$ddir") \|\| die "Unable to move $dir/$f to $ddir";
2782	pb_log(2,"mv $dir/$f $ddir\n");
2783	push @files,"$ddir/$f";
2784	}
2785	closedir(DIR);
2786	# Not enough but still a first cleanup
2787	pb_rm_rf("$dir");
2788	return(@files);
2789	}
2790
2791	sub pb_list_bfiles {
2792
2793	my $dir = shift;
2794	my $pbpkg = shift;
2795	my $bfiles = shift;
2796	my $pkgfiles = shift;
2797	my $supfiles = shift;
2798
2799	opendir(BDIR,"$dir") \|\| die "Unable to open dir $dir: $!";
2800	foreach my $f (readdir(BDIR)) {
2801	next if ($f =~ /^\./);
2802	$bfiles->{$f} = "$dir/$f";
2803	$bfiles->{$f} =~ s~$ENV{'PBROOTDIR'}~~;
2804	if (defined $supfiles->{$pbpkg}) {
2805	$pkgfiles->{$f} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
2806	}
2807	}
2808	closedir(BDIR);
2809	}
2810
2811
2812	#
2813	# Return the list of packages we are working on in a non CMS action
2814	#
2815	sub pb_get_pkg {
2816
2817	my @pkgs = ();
2818
2819	my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
2820	@pkgs = keys %$var;
2821
2822	pb_log(0,"Packages: ".join(',',@pkgs)."\n");
2823	return(\@pkgs);
2824	}
2825
2826	1;

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

Download in other formats: