Context Navigation

source: devel/pb/bin/pb @ 1165

Revision 1165, 115.2 KB checked in by bruno, 2 years ago (diff)
Fix a bug in Web delivery where the pbscript wasn't executable by default which now is a problem.
Property svn:executable set to ``*

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
14	# The modules mentioned here are required by pb when used both
15	# locally or inside a VE/VM
16	# Additional required modules only used locally are called with a require
17	# in their respective section
18	use Getopt::Long qw(:config auto_abbrev no_ignore_case);
19	use Data::Dumper;
20	use English;
21	use File::Basename;
22	use File::Copy;
23	use File::stat;
24	use File::Temp qw(tempdir);
25	use File::Find;
26	use Time::localtime qw(localtime);
27	use POSIX qw(strftime);
28	use lib qw (lib);
29	use ProjectBuilder::Version;
30	use ProjectBuilder::Base;
31	use ProjectBuilder::Display;
32	use ProjectBuilder::Conf;
33	use ProjectBuilder::Distribution;
34	use ProjectBuilder::CMS;
35	use ProjectBuilder::Env;
36	use ProjectBuilder::Filter;
37	use ProjectBuilder::Changelog;
38
39	# Global variables
40	my %opts; # CLI Options
41	my $action; # action to realize
42	my $test = "FALSE"; # Not used
43	my $pbforce = 0; # Force VE/VM rebuild
44	my $pbsnap = 0; # Do not use snapshot mode for VM/VE by default
45	my $option = ""; # Not used
46	my @pkgs; # list of packages
47	my $pbtag; # Global Tag variable
48	my $pbver; # Global Version variable
49	my $pbscript; # Name of the script
50	my %pbver; # per package
51	my %pbtag; # per package
52	my $pbrev; # Global REVISION variable
53	my $pbaccount; # Login to use to connect to the VM
54	my $pbtarget; # Target os-ver-arch you want to build for
55	my $pbport; # Port to use to connect to the VM
56	my $newver; # New version to create
57	my $iso = undef; # ISO image for the VM to create
58
59	my @date = pb_get_date();
60	my $pbdate = strftime("%Y-%m-%d", @date);
61
62	=pod
63
64	=head1 NAME
65
66	pb, aka project-builder.org - builds packages for your projects
67
68	=head1 DESCRIPTION
69
70	pb helps you build various packages directly from your project sources.
71	Those sources could be handled by a CMS (Configuration Management System)
72	such as Subversion, CVS, Git, Mercurial... or being a simple reference to a compressed tar file.
73	It's based on a set of configuration files, a set of provided macros to help
74	you keeping build files as generic as possible. For example, a single .spec
75	file should be required to generate for all rpm based distributions, even
76	if you could also have multiple .spec files if required.
77
78	=head1 SYNOPSIS
79
80	pb [-vhSq][-r pbroot][-p project][[-s script -a account -P port][-t os-ver-arch][-m os-ver-arch[,...]]][-g][-i iso] <action> [<pkg1> ...]
81
82	pb [--verbose][--help][--man][--quiet][--snapshot][--revision pbroot][--project project][[--script script --account account --port port][--target os-ver-arch][--machine os-ver-arch[,...]]][--nographic][--iso iso] <action> [<pkg1> ...]
83
84	=head1 OPTIONS
85
86	=over 4
87
88	=item B<-v\|--verbose>
89
90	Print a brief help message and exits.
91
92	=item B<-q\|--quiet>
93
94	Do not print any output.
95
96	=item B<-h\|--help>
97
98	Print a brief help message and exits.
99
100	=item B<-S\|--snapshot>
101
102	Use the snapshot mode of VMs or VEs
103
104	=item B<--man>
105
106	Prints the manual page and exits.
107
108	=item B<-t\|--target os-ver-arch>
109
110	Name of the target system you want to build for.
111	All if none precised.
112
113	=item B<-m\|--machine os-ver-arch[,os-ver-arch,...]>
114
115	Name of the Virtual Machines (VM) or Virtual Environments (VE) you want to build on (coma separated).
116	All if none precised (or use the env variable PBV).
117
118	=item B<-s\|--script script>
119
120	Name of the script you want to execute on the related VMs or VEs.
121
122	=item B<-g\|--nographic>
123
124	Do not launch VMs in graphical mode.
125
126	=item B<-i\|--iso iso_image>
127
128	Name of the ISO image of the distribution you want to install on the related VMs.
129
130	=item B<-a\|--account account>
131
132	Name of the account to use to connect on the related VMs.
133
134	=item B<-P\|--port port_number>
135
136	Port number to use to connect on the related VMs.\n";
137
138	=item B<-p\|--project project_name>
139
140	Name of the project you're working on (or use the env variable PBPROJ)
141
142	=item B<-r\|--revision revision>
143
144	Path Name of the project revision under the CMS (or use the env variable PBROOT)
145
146	=item B<-V\|--version new_version>
147
148	New version of the project to create based on the current one.
149
150	=back
151
152	=head1 ARGUMENTS
153
154	<action> can be:
155
156	=over 4
157
158	=item B<sbx2build>
159
160	Create tar files for the project under your CMS.
161	Current state of the exported content is taken.
162	CMS supported are SVN, SVK, CVS, Git and Mercurial
163	parameters are packages to build
164	if not using default list
165
166	=item B<cms2build>
167
168	Create tar files for the project under your CMS.
169	Current state of the CMS is taken.
170	CMS supported are SVN, SVK, CVS, Git and Mercurial
171	parameters are packages to build
172	if not using default list
173
174	=item B<build2pkg>
175
176	Create packages for your running distribution
177
178	=item B<cms2pkg>
179
180	cms2build + build2pkg
181
182	=item B<sbx2pkg>
183
184	sbx2build + build2pkg
185
186	=item B<build2ssh>
187
188	Send the tar files to a SSH host
189
190	=item B<sbx2ssh>
191
192	sbx2build + build2ssh
193
194	=item B<cms2ssh>
195
196	cms2build + build2ssh
197
198	=item B<pkg2ssh>
199
200	Send the packages built to a SSH host
201
202	=item B<build2vm>
203
204	Create packages in VMs, launching them if needed
205	and send those packages to a SSH host once built
206	VM type supported are QEMU
207
208	=item B<build2ve>
209
210	Create packages in VEs, creating it if needed
211	and send those packages to a SSH host once built
212
213	=item B<sbx2vm>
214
215	sbx2build + build2vm
216
217	=item B<sbx2ve>
218
219	sbx2build + build2ve
220
221	=item B<cms2vm>
222
223	cms2build + build2vm
224
225	=item B<cms2ve>
226
227	cms2build + build2ve
228
229	=item B<launchvm>
230
231	Launch one virtual machine
232
233	=item B<launchve>
234
235	Launch one virtual environment
236
237	=item B<script2vm>
238
239	Launch one virtual machine if needed
240	and executes a script on it
241
242	=item B<script2ve>
243
244	Execute a script in a virtual environment
245
246	=item B<newvm>
247
248	Create a new virtual machine
249
250	=item B<newve>
251
252	Create a new virtual environment
253
254	=item B<setupvm>
255
256	Setup a virtual machine for pb usage
257
258	=item B<setupve>
259
260	Setup a virtual environment for pb usage
261
262	=item B<sbx2setupvm>
263
264	Setup a virtual machine for pb usage using the sandbox version of pb instead of the latest stable
265	Reserved to dev team.
266
267	=item B<sbx2setupve>
268
269	Setup a virtual environment for pb usage using the sandbox version of pb instead of the latest stable
270	Reserved to dev team.
271
272	=item B<snapvm>
273
274	Snapshot a virtual machine for pb usage
275
276	=item B<snapve>
277
278	Snapshot a virtual environment for pb usage
279
280	=item B<updatevm>
281
282	Update the distribution in the virtual machine
283
284	=item B<updateve>
285
286	Update the distribution in the virtual environment
287
288	=item B<test2pkg>
289
290	Test a package locally
291
292	=item B<test2vm>
293
294	Test a package in a virtual machine
295
296	=item B<test2ve>
297
298	Test a package in a virtual environment
299
300	=item B<newver>
301
302	Create a new version of the project derived
303	from the current one
304
305	=item B<newproj>
306
307	Create a new project and a template set of
308	configuration files under pbconf
309
310	=item B<announce>
311
312	Announce the availability of the project through various means
313
314	=item B<sbx2webssh>
315
316	Create tar files for the website under your CMS.
317	Current state of the exported content is taken.
318	Deliver the content to the target server using ssh from the exported dir.
319
320	=item B<cms2webssh>
321
322	Create tar files for the website from your CMS.
323	Deliver the content to the target server using ssh from the DVCS.
324
325	=item B<sbx2webpkg>
326
327	Create tar files for the website under your CMS.
328	Current state of the exported content is taken.
329
330	=item B<cms2webpkg>
331
332	Create tar files for the website under your CMS.
333
334	=item B<clean>
335
336	Purge the build and delivery directories related to the current project
337
338	=back
339
340	<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).
341
342	=head1 WEB SITES
343
344	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/>.
345
346	=head1 USER MAILING LIST
347
348	None exists for the moment.
349
350	=head1 CONFIGURATION FILES
351
352	Each pb user may have a configuration in F<$HOME/.pbrc>. The values in this file may overwrite any other configuration file value.
353
354	Here is an example of such a configuration file:
355
356	#
357	# Define for each project the URL of its pbconf repository
358	# No default option allowed here as they need to be all different
359	#
360	# URL of the pbconf content
361	# This is the format of a classical URL with the extension of additional schema such as
362	# svn+ssh, cvs+ssh, ...
363	#
364	pbconfurl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe/pbconf
365
366	# This is normaly defined in the project's configuration file
367	# Url of the project
368	#
369	pburl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe
370
371	# All these URLs needs to be defined here as the are the entry point
372	# for how to build packages for the project
373	#
374	pbconfurl pb = svn+ssh://svn.project-builder.org/mondo/svn/pb/pbconf
375	pbconfurl mondorescue = svn+ssh://svn.project-builder.org/mondo/svn/project-builder/mondorescue/pbconf
376	pbconfurl collectl = svn+ssh://bruno@svn.mondorescue.org/mondo/svn/project-builder/collectl/pbconf
377	pbconfurl netperf = svn+ssh://svn.mondorescue.org/mondo/svn/project-builder/netperf/pbconf
378
379	# Under that dir will take place everything related to pb
380	# If you want to use VMs/chroot/..., then use $ENV{'HOME'} to make it portable
381	# to your VMs/chroot/...
382	# if not defined then /var/cache
383	pbdefdir default = $ENV{'HOME'}/project-builder
384	pbdefdir pb = $ENV{'HOME'}
385	pbdefdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
386	pbdefdir mondorescue = $ENV{'HOME'}/mondo/svn
387
388	# pbconfdir points to the directory where the CMS content of the pbconfurl is checked out
389	# If not defined, pbconfdir is under pbdefdir/pbproj/pbconf
390	pbconfdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs/pbconf
391	pbconfdir mondorescue = $ENV{'HOME'}/mondo/svn/pbconf
392
393	# pbdir points to the directory where the CMS content of the pburl is checked out
394	# If not defined, pbdir is under pbdefdir/pbproj
395	# Only defined if we have access to the dev of the project
396	pbdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
397	pbdir mondorescue = $ENV{'HOME'}/mondo/svn
398
399	# -daemonize doesn't work with qemu 0.8.2
400	vmopt default = -m 384
401
402	=head1 AUTHORS
403
404	The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
405
406	=head1 COPYRIGHT
407
408	Project-Builder.org is distributed under the GPL v2.0 license
409	described in the file C<COPYING> included with the distribution.
410
411	=cut
412
413	# ---------------------------------------------------------------------------
414
415	my ($projectbuilderver,$projectbuilderrev) = pb_version_init();
416	my $appname = "pb";
417
418	# Initialize the syntax string
419
420	pb_syntax_init("$appname (aka project-builder.org) Version $projectbuilderver-$projectbuilderrev\n");
421
422	GetOptions("help\|?\|h" => \$opts{'h'},
423	"man" => \$opts{'man'},
424	"verbose\|v+" => \$opts{'v'},
425	"snapshot\|S" => \$opts{'S'},
426	"quiet\|q" => \$opts{'q'},
427	"log-files\|l=s" => \$opts{'l'},
428	"force\|f" => \$opts{'f'},
429	"account\|a=s" => \$opts{'a'},
430	"revision\|r=s" => \$opts{'r'},
431	"script\|s=s" => \$opts{'s'},
432	"machines\|mock\|m=s" => \$opts{'m'},
433	"target\|t=s" => \$opts{'t'},
434	"nographic\|g" => \$opts{'g'},
435	"port\|P=i" => \$opts{'P'},
436	"project\|p=s" => \$opts{'p'},
437	"iso\|i=s" => \$opts{'i'},
438	"version\|V=s" => \$opts{'V'},
439	) \|\| pb_syntax(-1,0);
440
441	if (defined $opts{'h'}) {
442	pb_syntax(0,1);
443	}
444	if (defined $opts{'man'}) {
445	pb_syntax(0,2);
446	}
447	if (defined $opts{'v'}) {
448	$pbdebug = $opts{'v'};
449	}
450	if (defined $opts{'f'}) {
451	$pbforce=1;
452	}
453	if (defined $opts{'q'}) {
454	$pbdebug=-1;
455	}
456	if (defined $opts{'S'}) {
457	$pbsnap=1;
458	}
459	if (defined $opts{'l'}) {
460	open(pbLOG,"> $opts{'l'}") \|\| die "Unable to log to $opts{'l'}: $!";
461	$pbLOG = \*pbLOG;
462	$pbdebug = 0 if ($pbdebug == -1);
463	}
464	pb_log_init($pbdebug, $pbLOG);
465	pb_display_init("text","");
466
467	# Handle root of the project if defined
468	if (defined $opts{'r'}) {
469	$ENV{'PBROOTDIR'} = $opts{'r'};
470	}
471	# Handle virtual machines if any
472	if (defined $opts{'m'}) {
473	$ENV{'PBV'} = $opts{'m'};
474	}
475	if (defined $opts{'s'}) {
476	$pbscript = $opts{'s'};
477	}
478	if (defined $opts{'a'}) {
479	$pbaccount = $opts{'a'};
480	die "option -a requires a -s script option" if (not defined $pbscript);
481	}
482	if (defined $opts{'P'}) {
483	$pbport = $opts{'P'};
484	}
485	if (defined $opts{'V'}) {
486	$newver = $opts{'V'};
487	}
488	if (defined $opts{'i'}) {
489	$iso = $opts{'i'};
490	}
491	if (defined $opts{'t'}) {
492	$pbtarget = $opts{'t'};
493	}
494
495	# Get Action
496	$action = shift @ARGV;
497	die pb_syntax(-1,1) if (not defined $action);
498
499	my ($filteredfiles, $supfiles, $defpkgdir, $extpkgdir);
500	my $pbinit = undef;
501	$pbinit = 1 if ($action =~ /^newproj$/);
502
503	# Handles project name if any
504	# And get global params
505	($filteredfiles, $supfiles, $defpkgdir, $extpkgdir) = pb_env_init($opts{'p'},$pbinit,$action);
506
507	#
508	# Check for command requirements
509	#
510	my ($req,$opt,$pbpara) = pb_conf_get_if("oscmd","oscmdopt","pbparallel");
511	pb_check_requirements($req,$opt,$appname);
512
513	#
514	# Check if we can launch some actions in // with Parallel::ForkManager
515	#
516	my $pbparallel = $pbpara->{$appname} if (defined $pbpara);
517	if (not defined $pbparallel) {
518	eval
519	{
520	require Sys::CPU;
521	Sys::CPU->import();
522	};
523	if ($@) {
524	# Sys::CPU not found, defaulting to 1
525	pb_log(1,"ADVISE: Install Sys::CPU to benefit from automatic parallelism optimization.\nOr use pbparallel in your pb.conf file\nOnly 1 process at a time for the moment\n");
526	$pbparallel = 1;
527	} else {
528	# Using the number of cores
529	$pbparallel = Sys::CPU::cpu_count();
530	pb_log(1,"Using parallel mode with $pbparallel processes\n");
531	}
532	}
533
534	eval
535	{
536	require Parallel::ForkManager;
537	Parallel::ForkManager->import();
538	};
539	# Parallel::ForkManager not found so no // actions
540	if ($@) {
541	$pbparallel = undef;
542	pb_log(1,"ADVISE: Install Parallel::ForkManager to benefit from automatic parallelism optimization.\nOnly 1 process at a time for the moment\n");
543	}
544
545	pb_log(0,"Project: $ENV{'PBPROJ'}\n");
546	pb_log(0,"Action: $action\n");
547
548	# Act depending on action
549	if ($action =~ /^cms2build$/) {
550	pb_cms2build("CMS");
551	} elsif ($action =~ /^sbx2build$/) {
552	pb_cms2build("SandBox");
553	} elsif ($action =~ /^build2pkg$/) {
554	pb_build2pkg();
555	} elsif ($action =~ /^cms2pkg$/) {
556	pb_cms2build("CMS");
557	pb_build2pkg();
558	} elsif ($action =~ /^sbx2pkg$/) {
559	pb_cms2build("SandBox");
560	pb_build2pkg();
561	} elsif ($action =~ /^build2ssh$/) {
562	pb_build2ssh();
563	} elsif ($action =~ /^cms2ssh$/) {
564	pb_cms2build("CMS");
565	pb_build2ssh();
566	} elsif ($action =~ /^sbx2ssh$/) {
567	pb_cms2build("SandBox");
568	pb_build2ssh();
569	} elsif ($action =~ /^pkg2ssh$/) {
570	pb_pkg2ssh();
571	} elsif ($action =~ /^build2ve$/) {
572	pb_build2v("ve","build");
573	} elsif ($action =~ /^build2vm$/) {
574	pb_build2v("vm","build");
575	} elsif ($action =~ /^cms2ve$/) {
576	pb_cms2build("CMS");
577	pb_build2v("ve","build");
578	} elsif ($action =~ /^sbx2ve$/) {
579	pb_cms2build("SandBox");
580	pb_build2v("ve","build");
581	} elsif ($action =~ /^cms2vm$/) {
582	pb_cms2build("CMS");
583	pb_build2v("vm","build");
584	} elsif ($action =~ /^sbx2vm$/) {
585	pb_cms2build("SandBox");
586	pb_build2v("vm","build");
587	} elsif ($action =~ /^launchvm$/) {
588	pb_launchv("vm",$ENV{'PBV'},0);
589	} elsif ($action =~ /^launchve$/) {
590	pb_launchv("ve",$ENV{'PBV'},0);
591	} elsif ($action =~ /^script2vm$/) {
592	pb_script2v($pbscript,"vm");
593	} elsif ($action =~ /^script2ve$/) {
594	pb_script2v($pbscript,"ve");
595	} elsif ($action =~ /^newver$/) {
596	pb_newver();
597	} elsif ($action =~ /^newve$/) {
598	pb_launchv("ve",$ENV{'PBV'},1);
599	} elsif ($action =~ /^newvm$/) {
600	pb_launchv("vm",$ENV{'PBV'},1);
601	pb_log(0, "Please ensure that sshd is running in your VM by default\n");
602	pb_log(0, "and that it allows remote root login (PermitRootLogin yes in /etc/ssh/sshd_config)\n");
603	pb_log(0, "Also ensure that network is up, firewalling correctly configured\n");
604	pb_log(0, "and perl, sudo, ntpdate and scp/ssh installed\n");
605	pb_log(0, "You should then be able to login with ssh -p VMPORT root\@localhost (if VM started with pb)\n");
606	} elsif ($action =~ /^setupve$/) {
607	pb_setup2v("ve");
608	} elsif ($action =~ /^setupvm$/) {
609	pb_setup2v("vm");
610	} elsif ($action =~ /^sbx2setupve$/) {
611	die "This feature is limited to the pb project" if ($ENV{'PBPROJ'} ne $appname);
612	pb_cms2build("SandBox");
613	pb_setup2v("ve","SandBox");
614	} elsif ($action =~ /^sbx2setupvm$/) {
615	die "This feature is limited to the pb project" if ($ENV{'PBPROJ'} ne $appname);
616	pb_cms2build("SandBox");
617	pb_setup2v("vm","SandBox");
618	} elsif ($action =~ /^updateve$/) {
619	pb_update2v("ve");
620	} elsif ($action =~ /^updatevm$/) {
621	pb_update2v("vm");
622	} elsif ($action =~ /^snapve$/) {
623	pb_snap2v("ve");
624	} elsif ($action =~ /^snapvm$/) {
625	pb_snap2v("vm");
626	} elsif ($action =~ /^test2pkg$/) {
627	pb_test2pkg();
628	} elsif ($action =~ /^test2ve$/) {
629	pb_build2v("ve","test");
630	} elsif ($action =~ /^test2vm$/) {
631	pb_build2v("vm","test");
632	} elsif ($action =~ /^newproj$/) {
633	# Nothing to do - already done in pb_env_init
634	} elsif ($action =~ /^clean$/) {
635	pb_clean();
636	} elsif ($action =~ /^announce$/) {
637	# For announce only. Require avoids the systematic load of these modules
638	require DBI;
639	require DBD::SQLite;
640
641	pb_announce();
642	} elsif ($action =~ /^sbx2webpkg$/) {
643	require DBI;
644	require DBD::SQLite;
645
646	pb_cms2build("SandBox","Web");
647	} elsif ($action =~ /^sbx2webssh$/) {
648	require DBI;
649	require DBD::SQLite;
650
651	pb_cms2build("SandBox","Web");
652	pb_send2target("Web");
653	} elsif ($action =~ /^cms2webpkg$/) {
654	require DBI;
655	require DBD::SQLite;
656
657	pb_cms2build("CMS","Web");
658	} elsif ($action =~ /^cms2webssh$/) {
659	require DBI;
660	require DBD::SQLite;
661
662	pb_cms2build("CMS","Web");
663	pb_send2target("Web");
664	} else {
665	pb_log(0,"\'$action\' is not available\n");
666	pb_syntax(-2,1);
667	}
668
669	sub pb_cms2build {
670
671	my $param = shift \|\| undef;
672	my $web = shift \|\| undef;
673
674	my $pkg;
675	my @pkgs;
676	my $webdir;
677
678	my %pkgs;
679	my %pb; # Structure to store conf info
680
681	die "pb_cms2build requires a parameter: SandBox or CMS" if (not defined $param);
682
683	# If Website, then pkg is only the website
684	if (defined $web) {
685	($webdir) = pb_conf_get("webdir");
686	pb_log(2,"webdir: ".Dumper($webdir)."\n");
687	$pkgs[0] = $webdir->{$ENV{'PBPROJ'}};
688	$extpkgdir = $webdir;
689	pb_log(0,"Package: $pkgs[0]\n");
690	} else {
691	$pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
692	@pkgs = @$pkg;
693	}
694
695	my ($scheme, $uri) = pb_cms_init($pbinit,$param);
696
697	# We need 2 lines here
698	my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
699
700	# declare packager and repo for filtering
701	# TODO: Is pbrepo needed so early in the process ?
702	my ($tmp1, $tmp2) = pb_conf_get("pbpackager","pbrepo");
703	$ENV{'PBPACKAGER'} = $tmp1->{$ENV{'PBPROJ'}};
704	$ENV{'PBREPO'} = $tmp2->{$ENV{'PBPROJ'}};
705
706	foreach my $pbpkg (@pkgs) {
707	$ENV{'PBPKG'} = $pbpkg;
708
709	if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
710	$pbver = $pkgv->{$pbpkg};
711	} else {
712	$pbver = $ENV{'PBPROJVER'};
713	}
714	# If it's a test version, then tag == 0.date
715	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
716	$pbtag = "0.".strftime("%Y%m%d%H%M%S", @date);
717	$ENV{'PBPROJTAG'} = $pbtag;
718	} elsif ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
719	$pbtag = $pkgt->{$pbpkg};
720	} else {
721	$pbtag = $ENV{'PBPROJTAG'};
722	}
723
724	$pbrev = $ENV{'PBREVISION'};
725	pb_log(0,"\n");
726	pb_log(0,"Management of $pbpkg $pbver-$pbtag (rev $pbrev)\n");
727	die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
728
729	# Clean up dest if necessary. The export will recreate it
730	my $dest = "$ENV{'PBDESTDIR'}/$pbpkg-$pbver";
731	pb_rm_rf($dest) if (-d $dest);
732
733	# Export CMS tree for the concerned package to dest
734	# And generate some additional files
735	$OUTPUT_AUTOFLUSH=1;
736
737	# computes in which dir we have to work
738	my $dir = $defpkgdir->{$pbpkg};
739	$dir = $extpkgdir->{$pbpkg} if (not defined $dir);
740	$dir = $webdir->{$ENV{'PBPROJ'}} if (defined $web);
741	die "Variable \$dir not defined. Please report to dev team with log of a verbose run and this info ".Dumper($webdir) if (not defined $dir);
742	pb_log(2,"def:".Dumper($defpkgdir)." ext: ".Dumper($extpkgdir)." \n");
743
744	# Exporting content from CMS
745	my $sourcedir = undef;
746	my $sourceuri = $uri;
747	if ($param eq "SandBox") {
748	# Point to the local instance
749	$sourcedir = "$ENV{'PBDIR'}/$dir";
750	} else {
751	# Get it from a subdir of the URI with same version as localy but different root
752	$sourceuri = "$ENV{'PBDIR'}/$dir";
753	$sourceuri =~ s\|^$ENV{'PBPROJDIR'}/\|$uri\|;
754	}
755	my $preserve = pb_cms_export($sourceuri,$sourcedir,$dest);
756
757	# Generated fake content for test versions to speed up stuff
758	my $chglog;
759
760	# Get project info on authors and log file
761	$chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
762	$chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
763	$chglog = undef if (! -f $chglog);
764
765	my $authors = "$ENV{'PBROOTDIR'}/$pbpkg/pbauthors";
766	$authors = "$ENV{'PBROOTDIR'}/pbauthors" if (! -f $authors);
767	$authors = "/dev/null" if (! -f $authors);
768
769	# Extract cms log history and store it
770	if ((defined $chglog) && (! -f "$dest/NEWS")) {
771	pb_log(2,"Generating NEWS file from $chglog\n");
772	copy($chglog,"$dest/NEWS") \|\| die "Unable to create $dest/NEWS";
773	}
774	pb_cms_log($scheme,"$ENV{'PBDIR'}/$dir",$dest,$chglog,$authors,$testver);
775
776	my %build;
777	my %patches;
778	my %sources;
779	# We want to at least build for the underlying distro
780	# except if a target was given, in which case we only build for it
781	my ($tdir,$tver,$tarch);
782	($tdir,$tver,$tarch) = split(/-/,$pbtarget) if (defined ($pbtarget));
783
784	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins, $arch) = pb_distro_init($tdir,$tver,$tarch);
785	my $tmpl = "$ddir-$dver-$arch,";
786
787	# Get list of distributions for which we need to generate build files if no target
788	if (not defined ($pbtarget)) {
789	my @pt = pb_conf_get_if("vmlist","velist");
790	if (defined $pt[0]->{$ENV{'PBPROJ'}}) {
791	$tmpl .= $pt[0]->{$ENV{'PBPROJ'}};
792	}
793	if (defined $pt[1]->{$ENV{'PBPROJ'}}) {
794	# The 2 lists needs to be grouped with a ',' separating them
795	if ($tmpl ne "") {
796	$tmpl .= ",";
797	}
798	$tmpl .= $pt[1]->{$ENV{'PBPROJ'}}
799	}
800	}
801
802	# Setup %pb structure to allow filtering later on, on files using that structure
803	$pb{'tag'} = $pbtag;
804	$pb{'rev'} = $pbrev;
805	$pb{'ver'} = $pbver;
806	$pb{'pkg'} = $pbpkg;
807	$pb{'realpkg'} = $pbpkg;
808	$pb{'date'} = $pbdate;
809	$pb{'defpkgdir'} = $defpkgdir;
810	$pb{'extpkgdir'} = $extpkgdir;
811	$pb{'chglog'} = $chglog;
812	$pb{'packager'} = $ENV{'PBPACKAGER'};
813	$pb{'proj'} = $ENV{'PBPROJ'};
814	$pb{'repo'} = $ENV{'PBREPO'};
815	$pb{'patches'} = \%patches;
816	$pb{'sources'} = \%sources;
817	pb_log(2,"DEBUG: pb: ".Dumper(%pb)."\n");
818
819	# Do not do that for website
820	if (not defined $web) {
821	pb_log(0,"Build files are being generated for ...\n");
822	my %virt;
823	# De-duplicate similar VM and VE
824	foreach my $d (split(/,/,$tmpl)) {
825	# skip ill-formatted vms (name-ver-arch)
826	next if ($d !~ /-/);
827	$virt{$d} = $d;
828	}
829
830	# Try to use // processing here
831	my $pm = new Parallel::ForkManager($pbparallel) if (defined $pbparallel);
832
833	foreach my $d (keys %virt) {
834	$pm->start and next if (defined $pbparallel);
835	my ($name,$ver,$arch) = split(/-/,$d);
836	pb_log(0,"Bad format for $d") if ((not defined $name) \|\| (not defined $ver) \|\| (not defined $arch)) ;
837	chomp($arch);
838	my ($ddir, $dver, $dfam);
839	($ddir, $dver, $dfam, $pb{'dtype'}, $pb{'os'}, $pb{'suf'}, $pb{'upd'}, $pb{'arch'}) = pb_distro_init($name,$ver,$arch);
840	pb_log(2,"DEBUG: distro tuple: ".Dumper($ddir, $dver, $dfam, $pb{'dtype'}, $pb{'suf'})."\n");
841	pb_log(2,"DEBUG Filtering PBDATE => $pbdate, PBTAG => $pbtag, PBVER => $pbver\n");
842
843	# We need to compute the real name of the package
844	my $pbrealpkg = pb_cms_get_real_pkg($pbpkg,$pb{'dtype'});
845	$pb{'realpkg'} = $pbrealpkg;
846	pb_log(1,"Virtual package $pbpkg has a real package name of $pbrealpkg on $ddir-$dver\n") if ($pbrealpkg ne $pbpkg);
847
848	# Filter build files from the less precise up to the most with overloading
849	# Filter all files found, keeping the name, and generating in dest
850
851	# Find all build files first relatively to PBROOTDIR
852	# Find also all specific files referenced in the .pb conf file
853	my %bfiles = ();
854	my %pkgfiles = ();
855	$build{"$ddir-$dver-$arch"} = "yes";
856
857	if (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pb{'dtype'}") {
858	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pb{'dtype'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
859	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$dfam") {
860	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$dfam",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
861	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir") {
862	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
863	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver") {
864	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
865	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver-$arch") {
866	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver-$arch",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
867	} else {
868	$build{"$ddir-$dver-$arch"} = "no";
869	next;
870	}
871	pb_log(2,"DEBUG bfiles: ".Dumper(\%bfiles)."\n");
872
873	# Get all filters to apply
874	my $ptr = pb_get_filters($pbpkg, $pb{'dtype'}, $dfam, $ddir, $dver);
875
876	# Apply now all the filters on all the files concerned
877	# destination dir depends on the type of file
878	if (defined $ptr) {
879	# For patch support
880	$pb{'tuple'} = "$ddir-$dver-$arch";
881	foreach my $f (values %bfiles,values %pkgfiles) {
882	pb_filter_file("$ENV{'PBROOTDIR'}/$f",$ptr,"$dest/pbconf/$ddir-$dver-$arch/".basename($f),\%pb);
883	}
884	}
885	pb_list_sfiles("$ENV{'PBROOTDIR'}/$pbpkg/pbpatch", \%patches, $pb{'dtype'}, $dfam, $ddir, $dver, $arch, "$ENV{'PBROOTDIR'}/$pbpkg/pbextpatch");
886	pb_list_sfiles("$ENV{'PBROOTDIR'}/$pbpkg/pbsrc", \%sources, $pb{'dtype'}, $dfam, $ddir, $dver, $arch, "$ENV{'PBROOTDIR'}/$pbpkg/pbextsrc");
887
888	$pm->finish if (defined $pbparallel);
889	}
890	$pm->wait_all_children if (defined $pbparallel);
891	my @found;
892	my @notfound;
893	foreach my $b (keys %build) {
894	push @found,$b if ($build{$b} =~ /yes/);
895	push @notfound,$b if ($build{$b} =~ /no/);
896	}
897	pb_log(0," ... ".join(',',sort(@found))."\n");
898	pb_log(0,"No Build files found for ".join(',',sort(@notfound))."\n") if (@notfound);
899	pb_log(2,"DEBUG: patches: ".Dumper(%patches)."\n");
900	pb_log(2,"DEBUG: sources: ".Dumper(%sources)."\n");
901	}
902
903	# Get the generic filter (all.pbf) and
904	# apply those to the non-build files including those
905	# generated by pbinit if applicable
906
907	# Get only all.pbf filter
908	my $ptr = pb_get_filters($pbpkg);
909
910	my $liste ="";
911	if (defined $filteredfiles->{$pbpkg}) {
912	foreach my $f (split(/,/,$filteredfiles->{$pbpkg})) {
913	pb_filter_file_inplace($ptr,"$dest/$f",\%pb);
914	$liste = "$f $liste";
915	}
916	}
917	pb_log(2,"Files ".$liste."have been filtered\n");
918
919	# Do not do that for website
920	if (not defined $web) {
921	my %tmp;
922	my $warnptcflag = 0;
923	my $warnsrcflag = 0;
924	# Filter potential patches (local + remote)
925	pb_log(0,"Delivering and compressing patches ");
926	foreach my $v (keys %patches) {
927	pb_mkdir_p("$dest/pbconf/$v/pbpatch");
928	foreach my $pf (split(/,/,$patches{$v})) {
929	my $pp = basename($pf);
930	if ($param eq "SandBox") {
931	$warnptcflag = 1;
932	}
933	pb_cms_export($pf,undef,"$dest/pbconf/$v/pbpatch");
934	pb_filter_file_inplace($ptr,"$dest/pbconf/$v/pbpatch/$pp",\%pb);
935	pb_system("gzip -9f $dest/pbconf/$v/pbpatch/$pp","","quiet");
936	$tmp{$pf} = "";
937	}
938	}
939	pb_log(0,"Delivering additional sources ");
940	foreach my $v (keys %sources) {
941	pb_mkdir_p("$dest/pbconf/$v/pbsrc");
942	foreach my $pf (split(/,/,$sources{$v})) {
943	my $pp = basename($pf);
944	if ($param eq "SandBox") {
945	$warnsrcflag = 1;
946	}
947	pb_cms_export($pf,undef,"$dest/pbconf/$v/pbsrc");
948	pb_filter_file_inplace($ptr,"$dest/pbconf/$v/pbsrc/$pp",\%pb);
949	$tmp{$pf} = "";
950	}
951	}
952	foreach my $v (keys %tmp) {
953	pb_log(0,"$v ");
954	}
955	pb_log(0,"\n");
956	pb_log(0,"WARNING: Patches are always taken from repository not local export\n") if ($warnptcflag == 1);
957	pb_log(0,"WARNING: Sources are always taken from repository not local export\n") if ($warnsrcflag == 1);
958	} else {
959	# Instead call News generation
960	pb_web_news2html($dest);
961	# And create an empty pbconf
962	pb_mkdir_p("$dest/pbconf");
963	# And prepare the pbscript to execute remotely
964	open(SCRIPT,"> $ENV{'PBTMP'}/pbscript") \|\| die "Unable to create $ENV{'PBTMP'}/pbscript";
965	print SCRIPT "#!/bin/bash\n";
966	print SCRIPT "#set -x\n";
967	print SCRIPT "echo ... Extracting Website content\n";
968	print SCRIPT "find . -type f \| grep -Ev '^./$pbpkg-$pbver.tar.gz\|^./pbscript' \| xargs rm -f non-existent\n";
969	print SCRIPT "find * -type d -depth \| xargs rmdir 2> /dev/null \n";
970	print SCRIPT "tar xfz $pbpkg-$pbver.tar.gz\n";
971	print SCRIPT "mv $pbpkg-$pbver/* .\n";
972	print SCRIPT "rm -f $pbpkg-$pbver.tar.gz\n";
973	print SCRIPT "rmdir $pbpkg-$pbver\n";
974	close(SCRIPT);
975	chmod 0755,"$ENV{'PBTMP'}/pbscript";
976	}
977
978	# Prepare the dest directory for archive
979	if (-x "$ENV{'PBROOTDIR'}/$pbpkg/pbinit") {
980	pb_filter_file("$ENV{'PBROOTDIR'}/$pbpkg/pbinit",$ptr,"$ENV{'PBTMP'}/pbinit",\%pb);
981	chmod 0755,"$ENV{'PBTMP'}/pbinit";
982	pb_system("cd $dest ; $ENV{'PBTMP'}/pbinit","Executing init script from $ENV{'PBROOTDIR'}/$pbpkg/pbinit","verbose");
983	}
984
985	# Do we have additional script to run to prepare the environement for the project ?
986	# Then include it in the pbconf delivery
987	foreach my $pbvf (<$ENV{'PBROOTDIR'}/pbv.pre>,<$ENV{'PBROOTDIR'}/pbv.post>, <$ENV{'PBROOTDIR'}/pbtest*>) {
988	if (-x "$pbvf") {
989	my $target = "$ENV{'PBDESTDIR'}/".basename($pbvf);
990	pb_filter_file("$pbvf",$ptr,$target,\%pb);
991	chmod 0755,"$target";
992	}
993	}
994
995	# Archive dest dir
996	chdir "$ENV{'PBDESTDIR'}" \|\| die "Unable to change dir to $ENV{'PBDESTDIR'}";
997	if (defined $preserve) {
998	# In that case we want to preserve the original tar file for checksum purposes
999	# The one created is btw equivalent in that case to this one
1000	# Maybe check basename of both to be sure they are the same ?
1001	pb_log(0,"Preserving original tar file ");
1002	move("$preserve","$pbpkg-$pbver.tar.gz");
1003	} else {
1004	# Possibility to look at PBSRC to guess more the filename
1005	pb_system("tar cfz $pbpkg-$pbver.tar.gz --exclude=$pbpkg-$pbver/pbconf $pbpkg-$pbver","Creating $pbpkg tar files compressed");
1006	}
1007	pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz\n");
1008	pb_system("tar cfz $pbpkg-$pbver.pbconf.tar.gz $pbpkg-$pbver/pbconf","Creating pbconf tar files compressed");
1009	pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz\n");
1010
1011	# Keep track of version-tag per pkg
1012	$pkgs{$pbpkg} = "$pbver-$pbtag";
1013
1014	# Final cleanup
1015	pb_rm_rf($dest) if (-d $dest);
1016	}
1017
1018	# Keep track of per package version
1019	pb_log(2,"DEBUG pkgs: ".Dumper(%pkgs)."\n");
1020	open(PKG,"> $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb") \|\| die "Unable to create $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb";
1021	foreach my $pbpkg (keys %pkgs) {
1022	print PKG "pbpkg $pbpkg = $pkgs{$pbpkg}\n";
1023	}
1024	close(PKG);
1025
1026	# Keep track of what is generated by default
1027	# We need to store the dir and info on version-tag
1028	# Base our content on the existing .pb file
1029	copy("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb","$ENV{'PBDESTDIR'}/pbrc");
1030	open(LAST,">> $ENV{'PBDESTDIR'}/pbrc") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbrc";
1031	print LAST "pbroot $ENV{'PBPROJ'} = $ENV{'PBROOTDIR'}\n";
1032	print LAST "projver $ENV{'PBPROJ'} = $ENV{'PBPROJVER'}\n";
1033	print LAST "projtag $ENV{'PBPROJ'} = $ENV{'PBPROJTAG'}\n";
1034	print LAST "pbpackager $ENV{'PBPROJ'} = $ENV{'PBPACKAGER'}\n";
1035	close(LAST);
1036	}
1037
1038	sub pb_test2pkg {
1039	# Get the running distro to test on
1040	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins, $arch) = pb_distro_init();
1041	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $pbins, $arch))."\n");
1042
1043	# Get list of packages to test
1044	# Get content saved in cms2build
1045	my $ptr = pb_get_pkg();
1046	@pkgs = @$ptr;
1047
1048	# Additional potential repo
1049	pb_distro_setuprepo($ddir,$dver,$arch,$dtype,$dfam,$dos);
1050	foreach my $pbpkg (@pkgs) {
1051	# We need to install the package to test, and deps brought with it
1052	pb_distro_installdeps(undef,$dtype,$pbins,$pbpkg);
1053	pb_system("$ENV{'PBDESTDIR'}/pbtest","Launching test for $pbpkg","verbose");
1054	}
1055	}
1056
1057	sub pb_build2pkg {
1058
1059	# Get the running distro to build on
1060	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins, $arch) = pb_distro_init();
1061	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $pbins, $arch))."\n");
1062
1063	# If needed we may add repository to the build env
1064	pb_distro_setuprepo($ddir,$dver,$arch,$dtype,$dfam,$dos);
1065
1066	# Get list of packages to build
1067	my $ptr = pb_get_pkg();
1068	@pkgs = @$ptr;
1069
1070	# Get content saved in cms2build
1071	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1072	$pkg = { } if (not defined $pkg);
1073
1074	chdir "$ENV{'PBBUILDDIR'}";
1075	my $made = ""; # pkgs made during build
1076	my $pm = new Parallel::ForkManager($pbparallel) if (defined $pbparallel);
1077
1078	# We need to communicate info back from the children if parallel so prepare a dir for that
1079	my $tmpd = "$ENV{'PBTMP'}/build.$$";
1080	pb_mkdir_p($tmpd) if (defined $pbparallel);
1081
1082	foreach my $pbpkg (@pkgs) {
1083	$pm->start and next if (defined $pbparallel);
1084
1085	my $vertag = $pkg->{$pbpkg};
1086	# get the version of the current package - maybe different
1087	($pbver,$pbtag) = split(/-/,$vertag);
1088
1089	my $src="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz";
1090	my $src2="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
1091	pb_log(2,"Source file: $src\n");
1092	pb_log(2,"Pbconf file: $src2\n");
1093
1094	pb_log(2,"Working directory: $ENV{'PBBUILDDIR'}\n");
1095	if ($dtype eq "rpm") {
1096	foreach my $d ('RPMS','SRPMS','SPECS','SOURCES','BUILD') {
1097	if (! -d "$ENV{'PBBUILDDIR'}/$d") {
1098	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";
1099	}
1100	}
1101
1102	# Remove in case a previous link/file was there
1103	unlink "$ENV{'PBBUILDDIR'}/SOURCES/".basename($src);
1104	symlink "$src","$ENV{'PBBUILDDIR'}/SOURCES/".basename($src) \|\| die "Unable to symlink $src in $ENV{'PBBUILDDIR'}/SOURCES";
1105	# We need to first extract the spec file
1106	my @specfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/","$ENV{'PBBUILDDIR'}/SPECS","spec");
1107
1108	# We need to handle potential patches to upstream sources
1109	pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/pbpatch/","$ENV{'PBBUILDDIR'}/SOURCES","patch");
1110
1111	pb_log(2,"specfile: ".Dumper(\@specfile)."\n");
1112	# set LANGUAGE to check for correct log messages
1113	$ENV{'LANGUAGE'}="C";
1114	# Older Redhat use _target_platform in %configure incorrectly
1115	my $specialdef = "";
1116	if (($ddir eq "redhat") \|\| (($ddir eq "rhel") && ($dver eq "2.1"))) {
1117	$specialdef = "--define \'_target_platform \"\"\'";
1118	}
1119
1120	foreach my $f (@specfile) {
1121	if ($f =~ /\.spec$/) {
1122	# This could cause an issue in // mode
1123	pb_distro_installdeps($f,$dtype,$pbins);
1124	pb_system("rpmbuild $specialdef --define \"packager $ENV{'PBPACKAGER'}\" --define \"_topdir $ENV{'PBBUILDDIR'}\" -ba $f","Building package with $f under $ENV{'PBBUILDDIR'}","verbose");
1125	last;
1126	}
1127	}
1128	# Get the name of the generated packages
1129	open(LOG,"$ENV{'PBTMP'}/system.$$.log") \|\| die "Unable to open $ENV{'PBTMP'}/system.$$.log";
1130	while (<LOG>) {
1131	chomp($_);
1132	next if ($_ !~ /^Wrote:/);
1133	s\|./([S]RPMS.*)\|$1\|;
1134	$made .=" $_";
1135	}
1136	close(LOG);
1137
1138	} elsif ($dtype eq "deb") {
1139	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1140	pb_system("tar xfz $src","Extracting sources");
1141	pb_system("tar xfz $src2","Extracting pbconf");
1142
1143	chdir "$pbpkg-$pbver" \|\| die "Unable to chdir to $pbpkg-$pbver";
1144	pb_rm_rf("debian");
1145	symlink "pbconf/$ddir-$dver-$arch","debian" \|\| die "Unable to symlink to pbconf/$ddir-$dver-$arch";
1146	chmod 0755,"debian/rules";
1147
1148	pb_distro_installdeps("debian/control",$dtype,$pbins);
1149	pb_system("dpkg-buildpackage -us -uc -rfakeroot","Building package","verbose");
1150	# Get the name of the generated packages
1151	open(LOG,"$ENV{'PBTMP'}/system.$$.log") \|\| die "Unable to open $ENV{'PBTMP'}/system.$$.log";
1152	while (<LOG>) {
1153	chomp();
1154	my $tmp = $_;
1155	next if ($tmp !~ /^dpkg-deb.*:/);
1156	$tmp =~ s\|.../(.)_(.).deb.\|$1\|;
1157	$made="$made $tmp.dsc $tmp.tar.gz $tmp"."_.deb $tmp"."_.changes";
1158	}
1159	close(LOG);
1160	} elsif ($dtype eq "ebuild") {
1161	my @ebuildfile;
1162	# For gentoo we need to take pb as subsystem name
1163	# We put every apps here under sys-apps. hope it's correct
1164	# We use pb's home dir in order to have a single OVERLAY line
1165	my $tmpd = "$ENV{'HOME'}/portage/pb/sys-apps/$pbpkg";
1166	pb_mkdir_p($tmpd) if (! -d "$tmpd");
1167	pb_mkdir_p("$ENV{'HOME'}/portage/distfiles") if (! -d "$ENV{'HOME'}/portage/distfiles");
1168
1169	# We need to first extract the ebuild file
1170	@ebuildfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/","$tmpd","ebuild");
1171
1172	# Prepare the build env for gentoo
1173	my $found = 0;
1174	my $pbbd = $ENV{'HOME'};
1175	$pbbd =~ s\|/\|\\/\|g;
1176	if (-r "/etc/make.conf") {
1177	open(MAKE,"/etc/make.conf");
1178	while (<MAKE>) {
1179	$found = 1 if (/$pbbd\/portage/);
1180	}
1181	close(MAKE);
1182	}
1183	if ($found == 0) {
1184	pb_system("sudo sh -c 'echo PORTDIR_OVERLAY=\"$ENV{'HOME'}/portage\" >> /etc/make.conf'");
1185	}
1186	#$found = 0;
1187	#if (-r "/etc/portage/package.keywords") {
1188	#open(KEYW,"/etc/portage/package.keywords");
1189	#while (<KEYW>) {
1190	#$found = 1 if (/portage\/pb/);
1191	#}
1192	#close(KEYW);
1193	#}
1194	#if ($found == 0) {
1195	#pb_system("sudo sh -c \"echo portage/pb >> /etc/portage/package.keywords\"");
1196	#}
1197
1198	# Build
1199	foreach my $f (@ebuildfile) {
1200	if ($f =~ /\.ebuild$/) {
1201	pb_distro_installdeps($f,$dtype,$pbins);
1202	move($f,"$tmpd/$pbpkg-$pbver.ebuild");
1203	pb_system("cd $tmpd ; ebuild $pbpkg-$pbver.ebuild clean ; ebuild $pbpkg-$pbver.ebuild digest ; ebuild $pbpkg-$pbver.ebuild package","verbose");
1204	# Now move it where pb expects it
1205	pb_mkdir_p("$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
1206	move("$tmpd/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver-r$pbtag.ebuild");
1207	}
1208	}
1209
1210	$made="$made portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver-r$pbtag.ebuild";
1211	} elsif ($dtype eq "tgz") {
1212	# Slackware family
1213	$made="$made $pbpkg/$pbpkg-$pbver-*-$pbtag.tgz";
1214
1215	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1216	pb_system("tar xfz $src","Extracting sources");
1217	pb_system("tar xfz $src2","Extracting pbconf");
1218	chdir "$pbpkg-$pbver" \|\| die "Unable to chdir to $pbpkg-$pbver";
1219	symlink "pbconf/$ddir-$dver-$arch","install" \|\| die "Unable to symlink to pbconf/$ddir-$dver-$arch";
1220	if (-x "install/pbslack") {
1221	pb_distro_installdeps("./install/pbslack",$dtype,$pbins);
1222	pb_system("./install/pbslack","Building software");
1223	pb_system("sudo /sbin/makepkg -p -l y -c y $pbpkg","Packaging $pbpkg","verbose");
1224	}
1225	} elsif ($dtype eq "pkg") {
1226	# Solaris
1227	$made="$made $pbpkg-$pbver-$pbtag.pkg.gz";
1228	my $pkgdestdir="$ENV{'PBBUILDDIR'}/install";
1229
1230	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1231	# Will host resulting packages
1232	pb_mkdir_p("$dtype");
1233	pb_mkdir_p("$pkgdestdir/delivery");
1234	pb_system("tar xfz $src","Extracting sources under $ENV{'PBBUILDDIR'}");
1235	pb_system("tar xfz $src2","Extracting pbconf under $ENV{'PBBUILDDIR'}");
1236	chdir "$pbpkg-$pbver" \|\| die "Unable to chdir to $pbpkg-$pbver";
1237	if (-f "pbconf/$ddir-$dver-$arch/pbbuild") {
1238	chmod 0755,"pbconf/$ddir-$dver-$arch/pbbuild";
1239	# pkginfo file is mandatory
1240	die "Unable to find pkginfo file in pbconf/$ddir-$dver-$arch" if (! -f "pbconf/$ddir-$dver-$arch/pkginfo");
1241	# Build
1242	pb_system("pbconf/$ddir-$dver-$arch/pbbuild $pkgdestdir/delivery","Building software and installing under $pkgdestdir/delivery");
1243	# Copy complementary files
1244	if (-f "pbconf/$ddir-$dver-$arch/prototype") {
1245	copy("pbconf/$ddir-$dver-$arch/prototype", $pkgdestdir)
1246	} else {
1247	# No prototype provided, calculating it
1248	open(PROTO,"> $pkgdestdir/prototype") \|\| die "Unable to create prototype file";
1249	print PROTO "i pkginfo\n";
1250	print PROTO "i depend\n" if (-f "pbconf/$ddir-$dver-$arch/depend");
1251	$ENV{'PBSOLDESTDIR'} = "$pkgdestdir/delivery";
1252	find(\&create_solaris_prototype, "$pkgdestdir/delivery");
1253	}
1254	copy("pbconf/$ddir-$dver-$arch/depend", $pkgdestdir) if (-f "pbconf/$ddir-$dver-$arch/depend");
1255	copy("pbconf/$ddir-$dver-$arch/pkginfo", $pkgdestdir);
1256	pb_system("cd $pkgdestdir/delivery ; pkgmk -o -f ../prototype -r $pkgdestdir/delivery -d $ENV{'PBBUILDDIR'}/$dtype","Packaging $pbpkg","verbose");
1257	pb_system("cd $ENV{'PBBUILDDIR'}/$dtype ; echo \"\" \| pkgtrans -o -n -s $ENV{'PBBUILDDIR'}/$dtype $ENV{'PBBUILDDIR'}/$pbpkg-$pbver-$pbtag.pkg all","Transforming $pbpkg","verbose");
1258	pb_system("cd $ENV{'PBBUILDDIR'} ; gzip -9f $pbpkg-$pbver-$pbtag.pkg","Compressing $pbpkg-$pbver-$pbtag.pkg","verbose");
1259	} else {
1260	pb_log(0,"No pbconf/$ddir-$dver-$arch/pbbuild file found for $pbpkg-$pbver in \n");
1261	}
1262	chdir ".." \|\| die "Unable to chdir to parent dir";
1263	pb_system("rm -rf $pbpkg-$pbver $ENV{'PBBUILDDIR'}/$dtype $pkgdestdir", "Cleanup");
1264	} else {
1265	die "Unknown dtype format $dtype";
1266	}
1267	if (defined $pbparallel) {
1268	# Communicate results back to parent
1269	pb_set_content("$tmpd/$$",$made);
1270	$pm->finish;
1271	}
1272	}
1273	if (defined $pbparallel) {
1274	# In the parent, we need to get the result from the children
1275	$pm->wait_all_children;
1276	foreach my $f (<$tmpd/*>) {
1277	$made .= " ".pb_get_content($f);
1278	}
1279	pb_rm_rf($tmpd);
1280	}
1281
1282	# Find the appropriate check cmd/opts
1283	my ($oschkcmd,$oschkopt) = pb_conf_get_if("oschkcmd","oschkopt");
1284	my $chkcmd .= pb_distro_get_param($ddir,$dver,$arch,$oschkcmd,$dtype,$dfam,$dos);
1285	my $chkopt .= pb_distro_get_param($ddir,$dver,$arch,$oschkopt,$dtype,$dfam,$dos);
1286
1287	# Packages check if needed
1288	if ($dtype eq "rpm") {
1289	if (-x $chkcmd) {
1290	pb_system("$chkcmd $chkopt $made","Checking validity of rpms with $chkcmd","verbose");
1291	}
1292	my $rpms ="";
1293	my $srpms ="";
1294	foreach my $f (split(/ /,$made)) {
1295	$rpms .= "$ENV{'PBBUILDDIR'}/$f " if ($f =~ /^RPMS\//);
1296	$srpms .= "$ENV{'PBBUILDDIR'}/$f " if ($f =~ /^SRPMS\//);
1297	}
1298	pb_log(0,"SRPM packages generated: $srpms\n");
1299	pb_log(0,"RPM packages generated: $rpms\n");
1300	} elsif ($dtype eq "deb") {
1301	my $made2 = "";
1302	foreach my $f (split(/ /,$made)) {
1303	$made2 .= "../$f " if ($f =~ /\.changes$/);
1304	}
1305	if (-x $chkcmd) {
1306	pb_system("$chkcmd $chkopt $made2","Checking validity of debs with $chkcmd","verbose");
1307	} else {
1308	pb_log(0,"deb packages generated: $made2\n");
1309	}
1310	} else {
1311	pb_log(0,"No check done for $dtype yet\n");
1312	pb_log(0,"Packages generated: $made\n");
1313	}
1314
1315	# Keep track of what is generated so that we can get them back from VMs
1316	open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to create $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1317	print KEEP "$made\n";
1318	close(KEEP);
1319	}
1320
1321	sub create_solaris_prototype {
1322
1323	my $uidgid = "bin bin";
1324	my $pkgdestdir = $ENV{'PBSOLDESTDIR'};
1325
1326	return if ($_ =~ /^$pkgdestdir$/);
1327	if (-d $_) {
1328	my $n = $File::Find::name;
1329	$n =~ s~$pkgdestdir/~~;
1330	print PROTO "d none $n 0755 $uidgid\n";
1331	} elsif (-x $_) {
1332	my $n = $File::Find::name;
1333	$n =~ s~$pkgdestdir/~~;
1334	print PROTO "f none $n 0755 $uidgid\n";
1335	} elsif (-f $_) {
1336	my $n = $File::Find::name;
1337	$n =~ s~$pkgdestdir/~~;
1338	print PROTO "f none $n 0644 $uidgid\n";
1339	}
1340	}
1341
1342	sub pb_build2ssh {
1343	pb_send2target("Sources");
1344	}
1345
1346	sub pb_pkg2ssh {
1347	pb_send2target("Packages");
1348	}
1349
1350	# By default deliver to the the public site hosting the
1351	# ftp structure (or whatever) or a VM/VE
1352	sub pb_send2target {
1353
1354	my $cmt = shift;
1355	my $v = shift \|\| undef;
1356	my $vmexist = shift \|\| 0; # 0 is FALSE
1357	my $vmpid = shift \|\| 0; # 0 is FALSE
1358	my $snapme = shift \|\| 0; # 0 is FALSE
1359
1360	pb_log(2,"DEBUG: pb_send2target($cmt,".Dumper($v).",$vmexist,$vmpid)\n");
1361	my $host = "sshhost";
1362	my $login = "sshlogin";
1363	my $dir = "sshdir";
1364	my $port = "sshport";
1365	my $conf = "sshconf";
1366	my $tmout = undef;
1367	my $path = undef;
1368	if ($cmt =~ /^VM/) {
1369	$login = "vmlogin";
1370	$dir = "pbdefdir";
1371	# Specific VM
1372	$tmout = "vmtmout";
1373	$path = "vmpath";
1374	$host = "vmhost";
1375	$port = "vmport";
1376	} elsif ($cmt =~ /^VE/) {
1377	$login = "velogin";
1378	$dir = "pbdefdir";
1379	# Specific VE
1380	$path = "vepath";
1381	$conf = "rbsconf";
1382	} elsif ($cmt eq "Web") {
1383	$host = "websshhost";
1384	$login = "websshlogin";
1385	$dir = "websshdir";
1386	$port = "websshport";
1387	}
1388	my $cmd = "";
1389	my $src = "";
1390	my ($odir,$over,$oarch) = (undef, undef, undef);
1391	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins, $darch);
1392
1393	if ($cmt ne "Announce") {
1394	# Get list of packages to build
1395	my $ptr = pb_get_pkg();
1396	@pkgs = @$ptr;
1397
1398	# Get the running distro to consider
1399	if (defined $v) {
1400	($odir,$over,$oarch) = split(/-/,$v);
1401	}
1402	($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins, $darch) = pb_distro_init($odir,$over,$oarch);
1403	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $pbins, $darch))."\n");
1404
1405	# Get list of packages to build
1406	# Get content saved in cms2build
1407	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1408	$pkg = { } if (not defined $pkg);
1409
1410	chdir "$ENV{'PBBUILDDIR'}";
1411	foreach my $pbpkg (@pkgs) {
1412	my $vertag = $pkg->{$pbpkg};
1413	# get the version of the current package - maybe different
1414	($pbver,$pbtag) = split(/-/,$vertag);
1415
1416	if (($cmt eq "Sources") \|\| ($cmt =~ /V[EM]build/)) {
1417	$src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
1418	if ($cmd eq "") {
1419	$cmd = "ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
1420	} else {
1421	$cmd = "$cmd ; ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
1422	}
1423	} elsif ($cmt eq "Web") {
1424	$src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz"
1425	}
1426	}
1427	# Adds conf file for availability of conf elements
1428	pb_conf_add("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb");
1429	}
1430
1431	if ($cmt =~ /V[EM]build/) {
1432	$src="$src $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc $ENV{'PBDESTDIR'}/pbscript.$$";
1433	} elsif ($cmt =~ /V[EM]Script/) {
1434	$src="$src $ENV{'PBDESTDIR'}/pbscript.$$";
1435	} elsif ($cmt =~ /V[EM]test/) {
1436	$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";
1437	} elsif (($cmt eq "Announce") \|\| ($cmt eq "Web")) {
1438	$src="$src $ENV{'PBTMP'}/pbscript";
1439	} elsif ($cmt eq "Packages") {
1440	# Get package list from file made during build2pkg
1441	open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1442	$src = <KEEP>;
1443	chomp($src);
1444	close(KEEP);
1445	$src="$src $ENV{'PBBUILDDIR'}/pbscript";
1446	}
1447	# Remove potential leading spaces (cause problem with basename)
1448	$src =~ s/^ *//;
1449	my $basesrc = "";
1450	foreach my $i (split(/ +/,$src)) {
1451	$basesrc .= " ".basename($i);
1452	}
1453
1454	pb_log(0,"Sources handled ($cmt): $src\n");
1455	pb_log(2,"values: ".Dumper(($host,$login,$dir,$port,$tmout,$path,$conf))."\n");
1456	my ($sshhost,$sshlogin,$sshdir,$sshport) = pb_conf_get($host,$login,$dir,$port);
1457	# Not mandatory...
1458	my ($rbsconf,$testver,$delivery) = pb_conf_get_if($conf,"testver","delivery");
1459	$delivery->{$ENV{'PBPROJ'}} = "" if (not defined $delivery->{$ENV{'PBPROJ'}});
1460	my ($vtmout,$vepath);
1461	# ...Except those in virtual context
1462	if ($cmt =~ /^VE/) {
1463	($vepath) = pb_conf_get($path);
1464	}
1465	if ($cmt =~ /^VM/) {
1466	($vtmout) = pb_conf_get($tmout);
1467	}
1468	pb_log(2,"ssh: ".Dumper(($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vepath,$rbsconf))."\n");
1469
1470	my $mac;
1471	if ($cmt !~ /^VE/) {
1472	$mac = "$sshlogin->{$ENV{'PBPROJ'}}\@$sshhost->{$ENV{'PBPROJ'}}";
1473	# Overwrite account value if passed as parameter
1474	$mac = "$pbaccount\@$sshhost->{$ENV{'PBPROJ'}}" if (defined $pbaccount);
1475	pb_log(2, "DEBUG: pbaccount: $pbaccount => mac: $mac\n") if (defined $pbaccount);
1476	} else {
1477	# VE
1478	# Overwrite account value if passed as parameter (typically for setup2v)
1479	$mac = $sshlogin->{$ENV{'PBPROJ'}};
1480	$mac = $pbaccount if (defined $pbaccount);
1481	}
1482
1483	my $tdir;
1484	my $bdir;
1485	if (($cmt eq "Sources") \|\| ($cmt =~ /V[EM]Script/)) {
1486	$tdir = "$sshdir->{$ENV{'PBPROJ'}}/$delivery->{$ENV{'PBPROJ'}}/src";
1487	} elsif (($cmt =~ /V[EM]build/) \|\| ($cmt =~ /V[EM]test/)) {
1488	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/delivery";
1489	$bdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/build";
1490	# Remove a potential $ENV{'HOME'} as bdir should be relative to pb's home
1491	$bdir =~ s\|\$ENV.+\}/\|\|;
1492	} elsif ($cmt eq "Announce") {
1493	$tdir = "$sshdir->{$ENV{'PBPROJ'}}/$delivery->{$ENV{'PBPROJ'}}";
1494	} elsif ($cmt eq "Web") {
1495	$tdir = "$sshdir->{$ENV{'PBPROJ'}}/$delivery->{$ENV{'PBPROJ'}}";
1496	} elsif ($cmt eq "Packages") {
1497	$tdir = "$sshdir->{$ENV{'PBPROJ'}}/$delivery->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch";
1498
1499	my $repodir = $tdir;
1500	$repodir =~ s\|^$sshdir->{$ENV{'PBPROJ'}}/\|\|;
1501
1502	my ($pbrepo) = pb_conf_get("pbrepo");
1503
1504	# Repository management
1505	open(PBS,"> $ENV{'PBBUILDDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBBUILDDIR'}/pbscript";
1506	if ($dtype eq "rpm") {
1507	# Also make a pbscript to generate yum/urpmi bases
1508	print PBS << "EOF";
1509	#!/bin/bash
1510	# Prepare a script to ease yum setup
1511	cat > $ENV{'PBPROJ'}.repo << EOT
1512	[$ENV{'PBPROJ'}]
1513	name=$ddir $dver $darch - $ENV{'PBPROJ'} Vanilla Packages
1514	baseurl=$pbrepo->{$ENV{'PBPROJ'}}/$repodir
1515	enabled=1
1516	gpgcheck=0
1517	EOT
1518	chmod 644 $ENV{'PBPROJ'}.repo
1519
1520	# Clean up old repo content
1521	rm -rf headers/ repodata/
1522	# Create yum repo
1523	if [ -x /usr/bin/yum-arch ]; then
1524	yum-arch .
1525	fi
1526	# Create repodata
1527	createrepo .
1528	EOF
1529	if ($dfam eq "md") {
1530	# For Mandriva add urpmi management
1531	print PBS << "EOF";
1532	# Prepare a script to ease urpmi setup
1533	cat > $ENV{'PBPROJ'}.addmedia << EOT
1534	urpmi.addmedia $ENV{'PBPROJ'} $pbrepo->{$ENV{'PBPROJ'}}/$repodir with media_info/hdlist.cz
1535	EOT
1536	chmod 755 $ENV{'PBPROJ'}.addmedia
1537
1538	# Clean up old repo content
1539	rm -f hdlist.cz synthesis.hdlist.cz
1540	# Create urpmi repo
1541	genhdlist2 --clean .
1542	if [ \$\? -ne 0 ]; then
1543	genhdlist .
1544	fi
1545	EOF
1546	}
1547	if ($ddir eq "fedora") {
1548	# Extract the spec file to please Fedora maintainers :-(
1549	print PBS << "EOF";
1550	for p in $basesrc; do
1551	echo \$p \| grep -q 'src.rpm'
1552	if [ \$\? -eq 0 ]; then
1553	rpm2cpio \$p \| cpio -ivdum --quiet '*.spec'
1554	fi
1555	done
1556	EOF
1557	}
1558	if ($dfam eq "novell") {
1559	# Add ymp scripts for one-click install on SuSE
1560	print PBS << "EOF";
1561	# Prepare a script to ease SuSE one-click install
1562	# Cf: http://de.opensuse.org/1-Klick-Installation/ISV
1563	#
1564	cat > $ENV{'PBPROJ'}.ymp << EOT
1565	<?xml version="1.0" encoding="utf-8"?>
1566	<!-- vim: set sw=2 ts=2 ai et: -->
1567	<metapackage xmlns:os="http://opensuse.org/Standards/One_Click_Install" xmlns="http://opensuse.org/Standards/One_Click_Install">
1568	<group><!-- The group of software, typically one for project-builder.org -->
1569	<name>$ENV{'PBPROJ'} Bundle</name> <!-- Name of the software group -->
1570	<summary>Software bundle for the $ENV{'PBPROJ'} project</summary> <!--This message is shown to the user and should describe the whole bundle -->
1571	<description>This is the summary of the $ENV{'PBPROJ'} Project
1572
1573	Details are available on a per package basis below
1574
1575	</description><!--This is also shown to the user -->
1576	<remainSubscribed>false</remainSubscribed> <!-- Don't know what it mean -->
1577	<repositories><!-- List of needed repositories -->
1578	<repository>
1579	<name>$ENV{'PBPROJ'} Repository</name> <!-- Name of the repository -->
1580	<summary>This repository contains the $ENV{'PBPROJ'} project packages.</summary> <!-- Summary of the repository -->
1581	<description>This repository contains the $ENV{'PBPROJ'} project packages.</description><!-- This description is shown to the user -->
1582	<url>$pbrepo->{$ENV{'PBPROJ'}}/$repodir</url><!--URL of repository, which is added -->
1583	</repository>
1584	</repositories>
1585	<software><!-- A List of packages, which should be added through the one-click-installation -->
1586	EOT
1587	for p in $basesrc; do
1588	sum=`rpm -q --qf '%{SUMMARY}' \$p`
1589	name=`rpm -q --qf '%{NAME}' \$p`
1590	desc=`rpm -q --qf '%{description}' \$p`
1591	cat >> $ENV{'PBPROJ'}.ymp << EOT
1592	<item>
1593	<name>\$name</name><!-- Name of the package, is shown to the user and used to identify the package at the repository -->
1594	<summary>\$sum</summary> <!-- Summary of the package -->
1595	<description>\$desc</description> <!-- Description, is shown to the user -->
1596	</item>
1597	EOT
1598	done
1599	cat >> $ENV{'PBPROJ'}.ymp << EOT
1600	</software>
1601	</group>
1602	</metapackage>
1603	EOT
1604	chmod 644 $ENV{'PBPROJ'}.ymp
1605	EOF
1606	}
1607	} elsif ($dtype eq "deb") {
1608	# Also make a pbscript to generate apt bases
1609	# Cf: http://www.debian.org/doc/manuals/repository-howto/repository-howto.fr.html
1610	# This dirname removes arch
1611	my $rpd = dirname("$pbrepo->{$ENV{'PBPROJ'}}/$repodir");
1612	# this one removes the ver
1613	$rpd = dirname($rpd);
1614	print PBS << "EOF";
1615	#!/bin/bash
1616	# Prepare a script to ease apt setup
1617	cat > $ENV{'PBPROJ'}.sources.list << EOT
1618	deb $rpd $dver contrib
1619	deb-src $rpd $dver contrib
1620	EOT
1621	chmod 644 $ENV{'PBPROJ'}.sources.list
1622
1623	# Up two levels to deal with the dist dir cross versions
1624	cd ../..
1625	mkdir -p dists/$dver/contrib/binary-$darch dists/$dver/contrib/source
1626
1627	# Prepare a script to create apt info file
1628	TMPD=`mktemp -d /tmp/pb.XXXXXXXXXX` \|\| exit 1
1629	mkdir -p \$TMPD
1630	cat > \$TMPD/Release << EOT
1631	Archive: unstable
1632	Component: contrib
1633	Origin: $ENV{'PBPROJ'}
1634	Label: $ENV{'PBPROJ'} dev repository $pbrepo->{$ENV{'PBPROJ'}}
1635	EOT
1636
1637	echo "Creating Packages metadata ($darch)"
1638	dpkg-scanpackages -a$darch $dver/$darch /dev/null \| gzip -c9 > dists/$dver/contrib/binary-$darch/Packages.gz
1639	dpkg-scanpackages -a$darch $dver/$darch /dev/null \| bzip2 -c9 > dists/$dver/contrib/binary-$darch/Packages.bz2
1640	echo "Creating Contents metadata ($darch)"
1641	apt-ftparchive contents $dver \| gzip -c9 > dists/$dver/Contents-$darch.gz
1642	echo "Creating Release metadata ($darch)"
1643	cat \$TMPD/Release > dists/$dver/contrib/binary-$darch/Release
1644	echo "Architecture: $darch" >> dists/$dver/contrib/binary-$darch/Release
1645	echo "Creating Source metadata"
1646	dpkg-scansources $dver/$darch /dev/null \| gzip -c9 > dists/$dver/contrib/source/Sources.gz
1647	cat \$TMPD/Release > dists/$dver/contrib/source/Release
1648	echo "Architecture: Source" >> dists/$dver/contrib/source/Release
1649	echo "Creating Release metadata"
1650	apt-ftparchive release dists/$dver > dists/$dver/Release
1651	rm -rf \$TMPD
1652	EOF
1653	} elsif ($dtype eq "ebuild") {
1654	# make a pbscript to generate links to latest version
1655	print PBS << "EOF";
1656	#!/bin/bash
1657	# Prepare a script to create correct links
1658	for p in $src; do
1659	echo \$p \| grep -q '.ebuild'
1660	if [ \$\? -eq 0 ]; then
1661	j=`basename \$p`
1662	pp=`echo \$j \| cut -d'-' -f1`
1663	ln -sf \$j \$pp.ebuild
1664	fi
1665	done
1666	EOF
1667	}
1668	close(PBS);
1669	chmod 0755,"$ENV{'PBBUILDDIR'}/pbscript";
1670	} else {
1671	return;
1672	}
1673
1674	# Useless for VE
1675	my $nport = pb_get_port($sshport->{$ENV{'PBPROJ'}},$cmt) if ($cmt !~ /^VE/);
1676
1677	# Remove a potential $ENV{'HOME'} as tdir should be relative to pb's home
1678	$tdir =~ s\|\$ENV.+\}/\|\|;
1679
1680	my $tm = undef;
1681	if ($cmt =~ /^VM/) {
1682	$tm = $vtmout->{$ENV{'PBPROJ'}};
1683	}
1684
1685	# ssh communication if not VE
1686	# should use a hash instead...
1687	my ($shcmd,$cpcmd,$cptarget,$cp2target);
1688	if ($cmt !~ /^VE/) {
1689	my $keyfile = pb_ssh_get(0);
1690	$shcmd = "ssh -i $keyfile -q -o UserKnownHostsFile=/dev/null -p $nport $mac";
1691	$cpcmd = "scp -i $keyfile -p -o UserKnownHostsFile=/dev/null -P $nport";
1692	$cptarget = "$mac:$tdir";
1693	if ($cmt =~ /^VMbuild/) {
1694	$cp2target = "$mac:$bdir";
1695	}
1696	} else {
1697	my $tp = $vepath->{$ENV{'PBPROJ'}};
1698	($odir,$over,$oarch) = split(/-/,$v);
1699	my $tpdir = "$tp/$odir/$over/$oarch";
1700	my ($ptr) = pb_conf_get("vetype");
1701	my $vetype = $ptr->{$ENV{'PBPROJ'}};
1702	if ($vetype eq "chroot") {
1703	$shcmd = "sudo chroot $tpdir /bin/su - $mac -c ";
1704	} elsif ($vetype eq "schroot") {
1705	$shcmd = "schroot $tp -u $mac -- ";
1706	}
1707	$cpcmd = "sudo cp -r ";
1708	# We need to get the home dir of the target account to deliver in the right place
1709	open(PASS,"$tpdir/etc/passwd") \|\| die "Unable to open $tpdir/etc/passwd";
1710	my $homedir = "";
1711	while (<PASS>) {
1712	my ($c1,$c2,$c3,$c4,$c5,$c6,$c7) = split(/:/);
1713	$homedir = $c6 if ($c1 =~ /^$mac$/);
1714	pb_log(3,"Homedir: $homedir - account: $c6\n");
1715	}
1716	close(PASS);
1717	$cptarget = "$tpdir/$homedir/$tdir";
1718	if ($cmt eq "VEbuild") {
1719	$cp2target = "$tpdir/$homedir/$bdir";
1720	}
1721	pb_log(2,"On VE using $cptarget as target dir to copy to\n");
1722	}
1723
1724	my $logres = "";
1725	# Do not touch when just announcing
1726	if ($cmt ne "Announce") {
1727	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");
1728	} else {
1729	$logres = "> ";
1730	}
1731	pb_system("cd $ENV{'PBBUILDDIR'} ; $cpcmd $src $cptarget 2> /dev/null","$cmt delivery in $cptarget");
1732
1733	# For VE we need to change the owner manually
1734	if ($cmt =~ /^VE/) {
1735	pb_system("$shcmd \"sudo chown -R $mac $tdir\"","Adapt owner in $tdir to $mac");
1736	}
1737
1738	# Use the right script name depending on context
1739	my $pbscript;
1740	if ($cmt =~ /^V[EM]/) {
1741	$pbscript = "pbscript.$$";
1742	} else {
1743	$pbscript = "pbscript";
1744	}
1745
1746	pb_system("$shcmd \"echo \'cd $tdir ; if [ -x $pbscript ]; then ./$pbscript; fi ; rm -f ./$pbscript\' \| bash\"","Executing pbscript on $cptarget if needed","verbose");
1747	if ($cmt =~ /^V[EM]build/) {
1748	# Get back info on pkg produced, compute their name and get them from the VM
1749	pb_system("$cpcmd $cp2target/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'} $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$ 2> /dev/null","Get package names in $cp2target");
1750	# For VE we need to change the owner manually
1751	if ($cmt eq "VEbuild") {
1752	pb_system("sudo chown $UID $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$","Adapt owner in $tdir to $UID");
1753	}
1754	if (not -f "$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$") {
1755	pb_log(0,"Problem with VM $v on $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$");
1756	} else {
1757	open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$") \|\| die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$";
1758	my $src = <KEEP>;
1759	chomp($src);
1760	close(KEEP);
1761	unlink("$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$");
1762
1763	$src =~ s/^ *//;
1764	pb_mkdir_p("$ENV{'PBBUILDDIR'}/$odir/$over/$oarch");
1765	# Change pgben to make the next send2target happy
1766	my $made = "";
1767
1768	# For VM we don't want shell expansion to hapen locally but remotely
1769	my $delim = '\'';
1770	if ($cmt =~ /^VEbuild/) {
1771	# For VE we need to support shell expansion locally
1772	$delim = "";
1773	}
1774
1775	open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to write $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1776	foreach my $p (split(/ +/,$src)) {
1777	my $j = basename($p);
1778	pb_system("$cpcmd $cp2target/$delim$p$delim $ENV{'PBBUILDDIR'}/$odir/$over/$oarch 2> /dev/null","Recovery of package $j in $ENV{'PBBUILDDIR'}/$odir/$over/$oarch");
1779	$made="$made $odir/$over/$oarch/$j"; # if (($dtype ne "rpm") \|\| ($j !~ /.src.rpm$/));
1780	}
1781	print KEEP "$made\n";
1782	close(KEEP);
1783	pb_system("$shcmd \"rm -rf $tdir $bdir\"","$cmt cleanup");
1784
1785	# Sign packages locally
1786	if ($dtype eq "rpm") {
1787	#pb_system("rpm --addsign --define \"_signature gpg\" --define \"_gpg_name $ENV{'PBPACKAGER'}\" --define \"__gpg_sign_cmd /usr/bin/gpg --batch --no-verbose --no-armor --no-tty --no-secmem-warning -sbo %{__signature_filename} %{__plaintext_filename} --use-agent\" $made","Signing RPM packages packages");
1788	} elsif ($dtype eq "deb") {
1789	#pb_system("debsign $made","Signing DEB packages");
1790	} else {
1791	pb_log(0,"I don't know yet how to sign packages for type $dtype.\nPlease give feedback to dev team\n");
1792	}
1793
1794	# We want to send them to the ssh account so overwrite what has been done before
1795	undef $pbaccount;
1796	pb_log(2,"Before sending pkgs, vmexist: $vmexist, vmpid: $vmpid\n");
1797	pb_send2target("Packages",$odir."-".$over."-".$oarch,$vmexist,$vmpid);
1798	pb_rm_rf("$ENV{'PBBUILDDIR'}/$odir/$over/$oarch");
1799	}
1800	}
1801	unlink("$ENV{'PBDESTDIR'}/pbscript.$$") if ($cmt =~ /^V[ME]/);
1802
1803	pb_log(2,"Before halt, vmexist: $vmexist, vmpid: $vmpid\n");
1804	if ((! $vmexist) && ($cmt =~ /^VM/)) {
1805	# If in setupvm then takes a snapshot just before halting
1806	if ($snapme != 0) {
1807	my ($vmmonport,$vmtype) = pb_conf_get("vmmonport","vmtype");
1808	# For monitoring control
1809	if ((($vmtype->{$ENV{'PBPROJ'}}) eq "kvm") \|\| (($vmtype->{$ENV{'PBPROJ'}}) eq "qemu")) {
1810	eval
1811	{
1812	require Net::Telnet;
1813	Net::Telnet->import();
1814	};
1815	if ($@) {
1816	# Net::Telnet not found
1817	pb_log(1,"ADVISE: Install Net::Telnet to benefit from monitoring control and snapshot feature.\nWARNING: No snapshot created");
1818	} else {
1819	my $t = new Net::Telnet (Timeout => 120, Host => "localhost", Port => $vmmonport->{$ENV{'PBPROJ'}}) \|\| die "Unable to dialog on the monitor";
1820	# move to monitor mode
1821	my @lines = $t->cmd("c");
1822	# Create a snapshot named pb
1823	@lines = $t->cmd("savevm pb");
1824	# Write the new status in the VM
1825	@lines = $t->cmd("commit all");
1826	# End
1827	@lines = $t->cmd("quit");
1828	}
1829	}
1830	}
1831	my $hoption = "-p";
1832	my $hpath = "/sbin";
1833	# Solaris doesn't support -h and has halt elsewhere
1834	if ($dtype eq "pkg") {
1835	$hoption = "" ;
1836	$hpath = "/usr/sbin";
1837	}
1838	pb_system("$shcmd \"sudo $hpath/halt $hoption \"; sleep $tm ; echo \'if [ -d /proc/$vmpid ]; then kill -9 $vmpid; fi \' \| bash ; sleep 10","VM $v halt (pid $vmpid)");
1839	}
1840	if (($cmt =~ /^VE/) && ($snapme != 0)) {
1841	($odir,$over,$oarch) = split(/-/,$v);
1842	my $tpdir = "$vepath->{$ENV{'PBPROJ'}}/$odir/$over/$oarch";
1843	pb_system("sudo tar cz -f $vepath->{$ENV{'PBPROJ'}}/$odir-$over-$oarch.tar.gz -C $tpdir .","Creating a snapshot of $tpdir");
1844	}
1845	}
1846
1847	sub pb_script2v {
1848	my $pbscript=shift;
1849	my $vtype=shift;
1850	my $pbforce=shift \|\| 0; # Force stop of VM. Default not.
1851	my $vm1=shift \|\| undef; # Only that VM to treat. Default all.
1852	my $snapme=shift \|\| 0; # Do we have to create a snapshot. Default not.
1853	my $vm;
1854	my $all;
1855
1856	pb_log(2,"DEBUG: pb_script2v($pbscript,$vtype,$pbforce,".Dumper($vm1).",$snapme)\n");
1857	# Prepare the script to be executed on the VM
1858	# in $ENV{'PBDESTDIR'}/pbscript.$$
1859	if ((defined $pbscript ) && ($pbscript ne "$ENV{'PBDESTDIR'}/pbscript.$$")) {
1860	copy($pbscript,"$ENV{'PBDESTDIR'}/pbscript.$$") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript.$$";
1861	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript.$$";
1862	}
1863
1864	if (not defined $vm1) {
1865	($vm,$all) = pb_get2v($vtype);
1866	} else {
1867	@$vm = ($vm1);
1868	}
1869	my ($vmexist,$vmpid) = (undef,undef);
1870
1871	foreach my $v (@$vm) {
1872	# Launch VM/VE
1873	($vmexist,$vmpid) = pb_launchv($vtype,$v,0,$snapme,$pbsnap);
1874
1875	if ($vtype eq "vm") {
1876	pb_log(2,"DEBUG: After pb_launchv, vmexist: $vmexist, vmpid: $vmpid\n");
1877
1878	# Skip that VM if something went wrong
1879	next if (($vmpid == 0) && ($vmexist == 0));
1880
1881	# If force stopping the VM then reset vmexist
1882	if ($pbforce == 1) {
1883	$vmpid = $vmexist;
1884	$vmexist = 0;
1885	}
1886	} else {
1887	#VE
1888	$vmexist = 0;
1889	$vmpid = 0;
1890	}
1891
1892	# Gather all required files to send them to the VM
1893	# and launch the build through pbscript
1894	pb_log(2,"DEBUG: Before send2target, vmexist: $vmexist, vmpid: $vmpid\n");
1895	pb_send2target(uc($vtype)."Script","$v",$vmexist,$vmpid,$snapme);
1896
1897	}
1898	}
1899
1900	sub pb_launchv {
1901	my $vtype = shift;
1902	my $v = shift;
1903	my $create = shift \|\| 0; # By default do not create a VM/VE
1904	my $snapme = shift \|\| 0; # By default do not snap a VM/VE
1905	my $usesnap = shift \|\| 1; # By default study the usage of the snapshot feature of VM/VE
1906
1907	# If creation or snapshot creation mode, no snapshot usable
1908	if (($create == 1) \|\| ($snapme == 1)) {
1909	$usesnap = 0;
1910	}
1911
1912	pb_log(2,"DEBUG: pb_launchv($vtype,$v,$create,$snapme,$usesnap)\n");
1913	die "No VM/VE defined, unable to launch" if (not defined $v);
1914	# Keep only the first VM in case many were given
1915	$v =~ s/,.*//;
1916
1917	my $arch = pb_get_arch();
1918
1919	# Launch the VMs/VEs
1920	if ($vtype eq "vm") {
1921	die "-i iso parameter needed" if (((not defined $iso) \|\| ($iso eq "")) && ($create != 0));
1922
1923	# TODO: vmmonport should be optional
1924	my ($ptr,$ptr2,$vmpath,$vmport,$vmsize,$vmmonport) = pb_conf_get("vmtype","vmcmd","vmpath","vmport","vmsize","vmmonport");
1925	my ($vmopt,$vmmem,$vmtmout,$vmsnap,$vmbuildtm) = pb_conf_get_if("vmopt","vmmem","vmtmout","vmsnap","vmbuildtm");
1926
1927	my $vmtype = $ptr->{$ENV{'PBPROJ'}};
1928	my $vmcmd = $ptr2->{$ENV{'PBPROJ'}};
1929
1930	if (defined $opts{'g'}) {
1931	if (($vmtype eq "kvm") \|\| ($vmtype eq "qemu")) {
1932	$ENV{'PBVMOPT'} = "--nographic";
1933	}
1934	}
1935	if (not defined $ENV{'PBVMOPT'}) {
1936	$ENV{'PBVMOPT'} = "";
1937	}
1938	# Save the current status for later restoration
1939	$ENV{'PBOLDVMOPT'} = $ENV{'PBVMOPT'};
1940	# Set a default timeout of 2 minutes
1941	if (not defined $ENV{'PBVMTMOUT'}) {
1942	$ENV{'PBVMTMOUT'} = "120";
1943	}
1944	if (defined $vmopt->{$v}) {
1945	$ENV{'PBVMOPT'} .= " $vmopt->{$v}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$v}/);
1946	} elsif (defined $vmopt->{$ENV{'PBPROJ'}}) {
1947	$ENV{'PBVMOPT'} .= " $vmopt->{$ENV{'PBPROJ'}}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$ENV{'PBPROJ'}}/);
1948	}
1949
1950	# How much memory to allocate for VMs
1951	if (defined $vmmem->{$v}) {
1952	$ENV{'PBVMOPT'} .= " -m $vmmem->{$v}";
1953	} elsif (defined $vmmem->{$ENV{'PBPROJ'}}) {
1954	$ENV{'PBVMOPT'} .= " -m $vmmem->{$ENV{'PBPROJ'}}";
1955	}
1956
1957	# Are we allowed to use snapshot feature
1958	if ($usesnap == 1) {
1959	if ((defined $vmsnap->{$v}) && ($vmsnap->{$v} =~ /true/i)) {
1960	$ENV{'PBVMOPT'} .= " -snapshot";
1961	} elsif ((defined $vmsnap->{$ENV{'PBPROJ'}}) && ($vmsnap->{$ENV{'PBPROJ'}} =~ /true/i)) {
1962	$ENV{'PBVMOPT'} .= " -snapshot";
1963	} elsif ($pbsnap eq 1) {
1964	$ENV{'PBVMOPT'} .= " -snapshot";
1965	}
1966	}
1967	if ($snapme != 0) {
1968	if (($vmtype eq "kvm") \|\| ($vmtype eq "qemu")) {
1969	# Configure the monitoring to automate the creation of the 'pb' snapshot
1970	$ENV{'PBVMOPT'} .= " -serial mon:telnet::$vmmonport->{$ENV{'PBPROJ'}},server,nowait";
1971	# In that case no snapshot call needed
1972	$ENV{'PBVMOPT'} =~ s/ -snapshot//;
1973	}
1974	}
1975	if (defined $vmtmout->{$v}) {
1976	$ENV{'PBVMTMOUT'} = $vmtmout->{$v};
1977	} elsif (defined $vmtmout->{$ENV{'PBPROJ'}}) {
1978	$ENV{'PBVMTMOUT'} = $vmtmout->{$ENV{'PBPROJ'}};
1979	}
1980	my $nport = pb_get_port($vmport->{$ENV{'PBPROJ'}});
1981
1982	my $cmd;
1983	my $vmm; # has to be used for pb_check_ps
1984	if (($vmtype eq "qemu") \|\| ($vmtype eq "kvm")) {
1985	$vmm = "$vmpath->{$ENV{'PBPROJ'}}/$v.qemu";
1986	if (($create != 0) \|\| (defined $iso)) {
1987	$ENV{'PBVMOPT'} .= " -cdrom $iso -boot d";
1988	}
1989	# Always redirect the network and always try to use a 'pb' snapshot
1990	$cmd = "$vmcmd $ENV{'PBVMOPT'} -redir tcp:$nport:10.0.2.15:22 -loadvm pb $vmm"
1991	} elsif ($vmtype eq "xen") {
1992	} elsif ($vmtype eq "vmware") {
1993	} else {
1994	die "VM of type $vmtype not supported. Report to the dev team";
1995	}
1996	# Restore the ENV VAR Value
1997	$ENV{'PBVMOPT'} = $ENV{'PBOLDVMOPT'};
1998
1999	my ($tmpcmd,$void) = split(/ +/,$cmd);
2000	my $vmexist = pb_check_ps($tmpcmd,$vmm);
2001	my $vmpid = 0;
2002	if (! $vmexist) {
2003	if ($create != 0) {
2004	die("Found an existing Virtual machine $vmm. Won't overwrite") if (-r $vmm);
2005	if (($vmtype eq "qemu") \|\| ($vmtype eq "xen") \|\| ($vmtype eq "kvm")) {
2006	my $command = pb_check_req("qemu-img",0);
2007	pb_system("$command create -f qcow2 $vmm $vmsize->{$ENV{'PBPROJ'}}","Creating the QEMU VM");
2008	} elsif ($vmtype eq "vmware") {
2009	} else {
2010	}
2011	}
2012	if (! -f "$vmm") {
2013	pb_log(0,"Unable to find VM $vmm\n");
2014	} else {
2015	# Is the SSH port free? if not kill the existing process using it after a build timeout period
2016	my $vmssh = pb_check_ps($tmpcmd,"tcp:$nport:10.0.2.15:22");
2017	if ($vmssh) {
2018	my $buildtm = $ENV{'PBVMTMOUT'};
2019	if (defined $vmbuildtm->{$v}) {
2020	$buildtm = $vmbuildtm->{$v};
2021	} elsif (defined $vmbuildtm->{$ENV{'PBPROJ'}}) {
2022	$buildtm = $vmbuildtm->{$ENV{'PBPROJ'}};
2023	}
2024
2025	sleep $buildtm;
2026	pb_log(0,"WARNING: Killing the process ($vmssh) using port $nport (previous failed VM ?)\n");
2027	kill 15,$vmssh;
2028	# Let it time to exit
2029	sleep 5;
2030	}
2031	pb_system("$cmd &","Launching the VM $vmm");
2032	# Using system allows to kill it externaly if needed
2033	pb_system("sleep $ENV{'PBVMTMOUT'}","Waiting $ENV{'PBVMTMOUT'} s for VM $v to come up");
2034	$vmpid = pb_check_ps($tmpcmd,$vmm);
2035	pb_log(0,"VM $vmm launched (pid $vmpid)\n");
2036	}
2037	} else {
2038	pb_log(0,"Found an existing VM $vmm (pid $vmexist)\n");
2039	}
2040	pb_log(2,"DEBUG: pb_launchv returns ($vmexist,$vmpid)\n");
2041	return($vmexist,$vmpid);
2042	# VE here
2043	} else {
2044	# Get distro context
2045	my ($name,$ver,$darch) = split(/-/,$v);
2046	chomp($darch);
2047	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf) = pb_distro_init($name,$ver,$darch);
2048
2049	# Get VE context
2050	my ($ptr,$vepath) = pb_conf_get("vetype","vepath");
2051	my $vetype = $ptr->{$ENV{'PBPROJ'}};
2052
2053	# We can probably only get those params now we have the distro context
2054	my ($rbsb4pi,$rbspi,$vesnap,$oscodename,$osmindep,$verebuild,$rbsmirrorsrv) = pb_conf_get_if("rbsb4pi","rbspi","vesnap","oscodename","osmindep","verebuild","rbsmirrorsrv");
2055
2056	# We need to avoid umask propagation to the VE
2057	umask 0022;
2058
2059	if (($vetype eq "chroot") \|\| ($vetype eq "schroot")) {
2060	# Architecture consistency
2061	if ($arch ne $darch) {
2062	die "Unable to launch a VE of architecture $darch on a $arch platform" if (($darch eq "x86_64") && ($arch =~ /i?86/));
2063	}
2064
2065	my ($verpmtype,$vedebtype) = pb_conf_get("verpmtype","vedebtype");
2066	if (($create != 0) \|\| ((defined $verebuild) && ($verebuild->{$ENV{'PBPROJ'}} =~ /true/i)) \|\| ($pbforce == 1)) {
2067	my ($rbsopt1) = pb_conf_get_if("rbsopt");
2068
2069	# We have to rebuild the chroot
2070	if ($dtype eq "rpm") {
2071
2072	# Which tool is used
2073	my $verpmstyle = $verpmtype->{$ENV{'PBPROJ'}};
2074
2075	# Get potential rbs option
2076	my $rbsopt = "";
2077	if (defined $rbsopt1) {
2078	if (defined $rbsopt1->{$verpmstyle}) {
2079	$rbsopt = $rbsopt1->{$verpmstyle};
2080	} elsif (defined $rbsopt1->{$ENV{'PBPROJ'}}) {
2081	$rbsopt = $rbsopt1->{$ENV{'PBPROJ'}};
2082	} else {
2083	$rbsopt = "";
2084	}
2085	}
2086
2087	my $postinstall = pb_get_postinstall($ddir,$dver,$darch,$rbspi,$verpmstyle);
2088	if ($verpmstyle eq "rinse") {
2089	# Need to reshape the mirrors generated with local before-post-install script
2090	my $b4post = "--before-post-install ";
2091	my $postparam = pb_distro_get_param($ddir,$dver,$darch,$rbsb4pi);
2092	if ($postparam eq "") {
2093	$b4post = "";
2094	} else {
2095	$b4post .= $postparam;
2096	}
2097
2098	# Need to reshape the package list for pb
2099	my $addpkgs;
2100	$postparam = "";
2101	$postparam .= pb_distro_get_param($ddir,$dver,$darch,$osmindep);
2102	if ($postparam eq "") {
2103	$addpkgs = "";
2104	} else {
2105	my $pkgfile = "$ENV{'PBTMP'}/addpkgs.lis";
2106	open(PKG,"> $pkgfile") \|\| die "Unable to create $pkgfile";
2107	foreach my $p (split(/,/,$postparam)) {
2108	print PKG "$p\n";
2109	}
2110	close(PKG);
2111	$addpkgs = "--add-pkg-list $pkgfile";
2112	}
2113
2114	my $rinseverb = "";
2115	$rinseverb = "--verbose" if ($pbdebug gt 0);
2116	my ($rbsconf) = pb_conf_get("rbsconf");
2117
2118	my $command = pb_check_req("rinse",0);
2119	pb_system("sudo $command --directory \"$vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch\" --arch \"$darch\" --distribution \"$ddir-$dver\" --config \"$rbsconf->{$ENV{'PBPROJ'}}\" $b4post $postinstall $rbsopt $addpkgs $rinseverb","Creating the rinse VE for $ddir-$dver ($darch)", "verbose");
2120	} elsif ($verpmstyle eq "rpmbootstrap") {
2121	my $rbsverb = "";
2122	foreach my $i (1..$pbdebug) {
2123	$rbsverb .= " -v";
2124	}
2125	my $addpkgs = "";
2126	my $postparam = "";
2127	$postparam .= pb_distro_get_param($ddir,$dver,$darch,$osmindep);
2128	if ($postparam eq "") {
2129	$addpkgs = "";
2130	} else {
2131	$addpkgs = "-a $postparam";
2132	}
2133	my $command = pb_check_req("rpmbootstrap",0);
2134	pb_system("sudo $command $rbsopt $postinstall $addpkgs $ddir-$dver-$darch $rbsverb","Creating the rpmbootstrap VE for $ddir-$dver ($darch)", "verbose");
2135	} elsif ($verpmstyle eq "mock") {
2136	my ($rbsconf) = pb_conf_get("rbsconf");
2137	my $command = pb_check_req("mock",0);
2138	pb_system("sudo $command --init --resultdir=\"/tmp\" --configdir=\"$rbsconf->{$ENV{'PBPROJ'}}\" -r $v $rbsopt","Creating the mock VE for $ddir-$dver ($darch)");
2139	# Once setup we need to install some packages, the pb account, ...
2140	pb_system("sudo $command --install --configdir=\"$rbsconf->{$ENV{'PBPROJ'}}\" -r $v su","Configuring the mock VE");
2141	} else {
2142	die "Unknown verpmtype type $verpmstyle. Report to dev team";
2143	}
2144	} elsif ($dtype eq "deb") {
2145	my $vedebstyle = $vedebtype->{$ENV{'PBPROJ'}};
2146
2147	my $codename = pb_distro_get_param($ddir,$dver,$darch,$oscodename);
2148	my $postparam = "";
2149	my $addpkgs;
2150	$postparam .= pb_distro_get_param($ddir,$dver,$darch,$osmindep);
2151	if ($postparam eq "") {
2152	$addpkgs = "";
2153	} else {
2154	$addpkgs = "--include $postparam";
2155	}
2156	my $debmir = "";
2157	$debmir .= pb_distro_get_param($ddir,$dver,$darch,$rbsmirrorsrv);
2158
2159	# Get potential rbs option
2160	my $rbsopt = "";
2161	if (defined $rbsopt1) {
2162	if (defined $rbsopt1->{$vedebstyle}) {
2163	$rbsopt = $rbsopt1->{$vedebstyle};
2164	} elsif (defined $rbsopt1->{$ENV{'PBPROJ'}}) {
2165	$rbsopt = $rbsopt1->{$ENV{'PBPROJ'}};
2166	} else {
2167	$rbsopt = "";
2168	}
2169	}
2170
2171	# debootstrap works with amd64 not x86_64
2172	my $debarch = $darch;
2173	$debarch = "amd64" if ($darch eq "x86_64");
2174	if ($vedebstyle eq "debootstrap") {
2175	my $dbsverb = "";
2176	$dbsverb = "--verbose" if ($pbdebug gt 0);
2177
2178	# Some perl modules are in Universe on Ubuntu
2179	$rbsopt .= " --components=main,universe" if ($ddir eq "ubuntu");
2180
2181	pb_system("sudo /usr/sbin/debootstrap $dbsverb $rbsopt --arch=$debarch $addpkgs $codename \"$vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch\" $debmir","Creating the debootstrap VE for $ddir-$dver ($darch)", "verbose");
2182	# debootstrap doesn't create an /etc/hosts file
2183	if (! -f "$vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch/etc/hosts" ) {
2184	pb_system("sudo cp /etc/hosts $vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch/etc/hosts");
2185	}
2186	} else {
2187	die "Unknown vedebtype type $vedebstyle. Report to dev team";
2188	}
2189	} elsif ($dtype eq "ebuild") {
2190	die "Please teach the dev team how to build gentoo chroot";
2191	} else {
2192	die "Unknown distribution type $dtype. Report to dev team";
2193	}
2194	}
2195	# Fix modes to allow access to the VE for pb user
2196	pb_system("sudo chmod 755 $vepath->{$ENV{'PBPROJ'}}/$ddir $vepath->{$ENV{'PBPROJ'}}/$ddir/$dver $vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch","Fixing permissions");
2197
2198	# Test if an existing snapshot exists and use it if appropriate
2199	# And also use it of no local extracted VE is present
2200	if ((-f "$vepath->{$ENV{'PBPROJ'}}/$ddir-$dver-$darch.tar.gz") &&
2201	(((defined $vesnap->{$v}) && ($vesnap->{$v} =~ /true/i)) \|\|
2202	((defined $vesnap->{$ENV{'PBPROJ'}}) && ($vesnap->{$ENV{'PBPROJ'}} =~ /true/i)) \|\|
2203	($pbsnap eq 1) \|\|
2204	(! -d "$vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch"))) {
2205	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");
2206	}
2207	# Nothing more to do for VE. No real launch
2208	} else {
2209	die "VE of type $vetype not supported. Report to the dev team";
2210	}
2211	}
2212	}
2213
2214	# Return string for date synchro
2215	sub pb_date2v {
2216
2217	my $vtype = shift;
2218	my $v = shift;
2219
2220	my ($ntp) = pb_conf_get_if($vtype."ntp");
2221	my $vntp = $ntp->{$ENV{'PBPROJ'}} if (defined $ntp);
2222	my $ntpline;
2223
2224	if (defined $vntp) {
2225	my ($ntpcmd) = pb_conf_get($vtype."ntpcmd");
2226	my $vntpcmd;
2227	if (defined $ntpcmd->{$v}) {
2228	$vntpcmd = $ntpcmd->{$v};
2229	} elsif (defined $ntpcmd->{$ENV{'PBPROJ'}}) {
2230	$vntpcmd = $ntpcmd->{$ENV{'PBPROJ'}};
2231	} else {
2232	$vntpcmd = "/bin/true";
2233	}
2234	$ntpline = "sudo $vntpcmd $vntp";
2235	} else {
2236	$ntpline = undef;
2237	}
2238	# Force new date to be in the future compared to the date
2239	# of the host by adding 1 minute
2240	my @date=pb_get_date();
2241	$date[1]++;
2242	my $upddate = strftime("%m%d%H%M%Y", @date);
2243	my $dateline = "sudo date $upddate";
2244	return($ntpline,$dateline);
2245	}
2246
2247	sub pb_build2v {
2248
2249	my $vtype = shift;
2250	my $action = shift \|\| "build";
2251
2252	my ($v,$all) = pb_get2v($vtype);
2253
2254	# Send tar files when we do a global generation
2255	pb_build2ssh() if (($all == 1) && ($action eq "build"));
2256
2257	# Adapt // mode to memory size
2258	$pbparallel = pb_set_parallel($vtype);
2259
2260	my ($vmexist,$vmpid) = (undef,undef);
2261	my $pm = new Parallel::ForkManager($pbparallel) if (defined $pbparallel);
2262
2263	# Set which port the VM will use to communicate
2264	$pm->run_on_start(\&pb_set_port);
2265
2266	my $counter = 0;
2267	foreach my $v (@$v) {
2268	$counter++;
2269	# Modulo 2 * pbparallel (to avoid synchronization problems)
2270	$counter = 1 if ($counter > 2 * $pbparallel);
2271	$pm->start($counter) and next if (defined $pbparallel);
2272	# Prepare the script to be executed on the VM/VE
2273	# in $ENV{'PBDESTDIR'}/pbscript.$$
2274	open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript.$$") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript.$$";
2275	print SCRIPT "#!/bin/bash\n";
2276
2277	# Transmit the verbosity level to the virtual env/mach.
2278	my $verbose = "";
2279	my $i = 0; # minimal debug level
2280	while ($i lt $pbdebug) {
2281	$verbose .= "-v ";
2282	$i++;
2283	}
2284	# Activate script verbosity if at least 2 for pbdebug
2285	print SCRIPT "set -x\n" if ($i gt 1);
2286	# Quiet if asked to be so on the original system
2287	$verbose = "-q" if ($pbdebug eq -1);
2288
2289	print SCRIPT "echo ... Execution needed\n";
2290	print SCRIPT "# This is in directory delivery\n";
2291	print SCRIPT "# Setup the variables required for building\n";
2292	print SCRIPT "export PBPROJ=$ENV{'PBPROJ'}\n";
2293
2294	if ($action eq "build") {
2295	print SCRIPT "# Preparation for pb\n";
2296	print SCRIPT "mv .pbrc \$HOME\n";
2297	print SCRIPT "cd ..\n";
2298	}
2299
2300	# VE needs a good /proc
2301	if ($vtype eq "ve") {
2302	print SCRIPT "sudo mount -t proc /proc /proc\n";
2303	}
2304
2305	my ($ntpline,$dateline) = pb_date2v($vtype,$v);
2306	print SCRIPT "# Time sync\n";
2307	print SCRIPT "echo 'setting up date with '";
2308	if (defined $ntpline) {
2309	print SCRIPT "echo $ntpline\n";
2310	print SCRIPT "$ntpline\n";
2311	} else {
2312	print SCRIPT "echo $dateline\n";
2313	print SCRIPT "$dateline\n";
2314	}
2315	# Use potential local proxy declaration in case we need it to download repo, pkgs, ...
2316	if (defined $ENV{'http_proxy'}) {
2317	print SCRIPT "export http_proxy=\"$ENV{'http_proxy'}\"\n";
2318	}
2319
2320	if (defined $ENV{'ftp_proxy'}) {
2321	print SCRIPT "export ftp_proxy=\"$ENV{'ftp_proxy'}\"\n";
2322	}
2323
2324	# Get list of packages to build/test and get some ENV vars as well
2325	my $ptr = pb_get_pkg();
2326	@pkgs = @$ptr;
2327	my $p = join(' ',@pkgs) if (@pkgs);
2328	print SCRIPT "export PBPROJVER=$ENV{'PBPROJVER'}\n";
2329	print SCRIPT "export PBPROJTAG=$ENV{'PBPROJTAG'}\n";
2330	print SCRIPT "export PBPACKAGER=\"$ENV{'PBPACKAGER'}\"\n";
2331
2332	# We may need to do some other tasks before building. Read a script here to finish setup
2333	if (-x "$ENV{'PBDESTDIR'}/pb$vtype".".pre") {
2334	print SCRIPT "# Special pre-instructions to be launched\n";
2335	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype".".pre");
2336	}
2337
2338	if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."$action.pre") {
2339	print SCRIPT "# Special pre-$action instructions to be launched\n";
2340	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."$action.pre");
2341	}
2342
2343	print SCRIPT "# $action\n";
2344	print SCRIPT "echo $action"."ing packages on $vtype...\n";
2345
2346	if (($action eq "test") && (! -x "$ENV{'PBDESTDIR'}/pbtest")) {
2347	die "No test script ($ENV{'PBDESTDIR'}/pbtest) found when in test mode. Aborting ...";
2348	}
2349	print SCRIPT "pb $verbose -p $ENV{'PBPROJ'} $action"."2pkg $p\n";
2350
2351	if ($vtype eq "ve") {
2352	print SCRIPT "sudo umount /proc\n";
2353	}
2354
2355	# We may need to do some other tasks after building. Read a script here to exit properly
2356	if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."$action.post") {
2357	print SCRIPT "# Special post-$action instructions to be launched\n";
2358	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."$action.post");
2359	}
2360
2361	if (-x "$ENV{'PBDESTDIR'}/pb$vtype".".post") {
2362	print SCRIPT "# Special post-instructions to be launched\n";
2363	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype".".post");
2364	}
2365
2366	close(SCRIPT);
2367	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript.$$";
2368
2369	# Launch the VM/VE
2370	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
2371
2372
2373	if ($vtype eq "vm") {
2374	# Skip that VM if something went wrong
2375	if (($vmpid == 0) && ($vmexist == 0)) {
2376	$pm->finish if (defined $pbparallel);
2377	next;
2378	}
2379	} else {
2380	# VE
2381	$vmexist = 0;
2382	$vmpid = 0;
2383	}
2384	# Gather all required files to send them to the VM/VE
2385	# and launch the build through pbscript
2386	pb_log(2,"Calling send2target $vtype,$v,$vmexist,$vmpid\n");
2387	pb_send2target(uc($vtype).$action,"$v",$vmexist,$vmpid);
2388	$pm->finish if (defined $pbparallel);
2389	}
2390	if (defined $pbparallel) {
2391	$pm->wait_all_children;
2392	}
2393	}
2394
2395
2396	sub pb_clean {
2397
2398	my $sleep=10;
2399	die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
2400	die "Unable to get env var PBBUILDDIR" if (not defined $ENV{'PBBUILDDIR'});
2401	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");
2402	sleep $sleep;
2403	pb_rm_rf($ENV{'PBDESTDIR'});
2404	pb_rm_rf($ENV{'PBBUILDDIR'});
2405	}
2406
2407	sub pb_newver {
2408
2409	die "-V Version parameter needed" if ((not defined $newver) \|\| ($newver eq ""));
2410
2411	# Need this call for PBDIR
2412	my ($scheme2,$uri) = pb_cms_init($pbinit);
2413
2414	my ($pbconf,$pburl) = pb_conf_get("pbconfurl","pburl");
2415	$uri = $pbconf->{$ENV{'PBPROJ'}};
2416	my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);
2417
2418	# Checking CMS repositories status
2419	($scheme2, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}});
2420
2421	if ($scheme !~ /^svn/) {
2422	die "Only SVN is supported at the moment";
2423	}
2424
2425	my $res = pb_cms_isdiff($scheme,$ENV{'PBROOTDIR'});
2426	die "ERROR: No differences accepted in CMS for $ENV{'PBROOTDIR'} before creating a new version" if ($res != 0);
2427
2428	$res = pb_cms_isdiff($scheme2,$ENV{'PBDIR'});
2429	die "ERROR: No differences accepted in CMS for $ENV{'PBDIR'} before creating a new version" if ($res != 0);
2430
2431	# Tree identical between PBCONFDIR and PBROOTDIR. The delta is what
2432	# we want to get for the root of the new URL
2433
2434	my $tmp = $ENV{'PBROOTDIR'};
2435	$tmp =~ s\|^$ENV{'PBCONFDIR'}\|\|;
2436
2437	my $newurl = "$uri/".dirname($tmp)."/$newver";
2438	# Should probably use projver in the old file
2439	my $oldver= basename($tmp);
2440
2441	# Duplicate and extract project-builder part
2442	pb_log(2,"Copying $uri/$tmp to $newurl\n");
2443	pb_cms_copy($scheme,"$uri/$tmp",$newurl);
2444	pb_log(2,"Checkout $newurl to $ENV{'PBROOTDIR'}/../$newver\n");
2445	pb_cms_up($scheme,"$ENV{'PBCONFDIR'}/..");
2446
2447	# Duplicate and extract project
2448	my $newurl2 = "$pburl->{$ENV{'PBPROJ'}}/".dirname($tmp)."/$newver";
2449
2450	pb_log(2,"Copying $pburl->{$ENV{'PBPROJ'}}/$tmp to $newurl2\n");
2451	pb_cms_copy($scheme2,"$pburl->{$ENV{'PBPROJ'}}/$tmp",$newurl2);
2452	pb_log(2,"Checkout $newurl2 to $ENV{'PBDIR'}/../$newver\n");
2453	pb_cms_up($scheme2,"$ENV{'PBDIR'}/..");
2454
2455	# Update the .pb file
2456	open(FILE,"$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb") \|\| die "Unable to open $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb";
2457	open(OUT,"> $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new") \|\| die "Unable to write to $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new";
2458	while(<FILE>) {
2459	s/^projver\s+$ENV{'PBPROJ'}\s=\s$oldver/projver $ENV{'PBPROJ'} = $newver/;
2460	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/);
2461	pb_log(0,"Commenting testver in $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb\n") if (/^testver/);
2462	s/^testver/#testver/;
2463	print OUT $_;
2464	pb_log(0,"Please check delivery (".chomp($_).") in $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb\n") if (/^delivery/);
2465	}
2466	close(FILE);
2467	close(OUT);
2468	rename("$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new","$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb");
2469
2470	# Checking pbcl files
2471	foreach my $f (<$ENV{'PBROOTDIR'}/*/pbcl>) {
2472	# Compute new pbcl file
2473	my $f2 = $f;
2474	$f2 =~ s\|$ENV{'PBROOTDIR'}\|$ENV{'PBROOTDIR'}/../$newver/\|;
2475	open(PBCL,$f) \|\| die "Unable to open $f";
2476	my $foundnew = 0;
2477	while (<PBCL>) {
2478	$foundnew = 1 if (/^$newver \(/);
2479	}
2480	close(PBCL);
2481	open(OUT,"> $f2") \|\| die "Unable to write to $f2: $!";
2482	open(PBCL,$f) \|\| die "Unable to open $f";
2483	while (<PBCL>) {
2484	print OUT "$_" if (not /^$oldver \(/);
2485	if ((/^$oldver \(/) && ($foundnew == 0)) {
2486	print OUT "$newver ($pbdate)\n";
2487	print OUT "- TBD\n";
2488	print OUT "\n";
2489	pb_log(0,"WARNING: version $newver not found in $f so added to $f2...\n") if ($foundnew == 0);
2490	}
2491	}
2492	close(OUT);
2493	close(PBCL);
2494	}
2495
2496	pb_log(2,"Checkin $ENV{'PBROOTDIR'}/../$newver\n");
2497	pb_cms_checkin($scheme,"$ENV{'PBROOTDIR'}/../$newver",undef);
2498	}
2499
2500	#
2501	# Return the list of VMs/VEs we are working on
2502	# $all is a flag to know if we return all of them
2503	# or only some (if all we publish also tar files in addition to pkgs
2504	#
2505	sub pb_get2v {
2506
2507	my $vtype = shift;
2508	my @v;
2509	my $all = 0;
2510	my $vlist;
2511	my $pbv = 'PBV';
2512
2513	if ($vtype eq "vm") {
2514	$vlist = "vmlist";
2515	} elsif ($vtype eq "ve") {
2516	$vlist = "velist";
2517	}
2518	# Get VM/VE list
2519	if ((not defined $ENV{$pbv}) \|\| ($ENV{$pbv} =~ /^all$/)) {
2520	my ($ptr) = pb_conf_get($vlist);
2521	$ENV{$pbv} = $ptr->{$ENV{'PBPROJ'}};
2522	$all = 1;
2523	}
2524	pb_log(2,"$vtype: $ENV{$pbv}\n");
2525	@v = split(/,/,$ENV{$pbv});
2526	return(\@v,$all);
2527	}
2528
2529	# Function to create a potentialy missing pb account on the VM/VE, and adds it to sudo
2530	# Needs to use root account to connect to the VM/VE
2531	# pb will take your local public SSH key to access
2532	# the pb account in the VM later on if needed
2533	sub pb_setup2v {
2534
2535	my $vtype = shift;
2536	my $sbx = shift \|\| undef;
2537
2538	my ($vm,$all) = pb_get2v($vtype);
2539
2540	# Script generated
2541	my $pbscript = "$ENV{'PBDESTDIR'}/setupv";
2542
2543	# Adapt // mode to memory size
2544	$pbparallel = pb_set_parallel($vtype);
2545
2546	my $pm = new Parallel::ForkManager($pbparallel) if (defined $pbparallel);
2547
2548	# Set which port the VM will use to communicate
2549	$pm->run_on_start(\&pb_set_port);
2550
2551	my $counter = 0;
2552	foreach my $v (@$vm) {
2553	$counter++;
2554	# Modulo pbparallel
2555	$counter = 1 if ($counter > $pbparallel);
2556	$pm->start($counter) and next if (defined $pbparallel);
2557
2558	# Deal with date sync.
2559	my ($ntpline,$dateline) = pb_date2v($vtype,$v);
2560
2561	# Get distro context
2562	my ($name,$ver,$darch) = split(/-/,$v);
2563	chomp($darch);
2564	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins) = pb_distro_init($name,$ver,$darch);
2565
2566	# Name of the account to deal with for VM/VE
2567	# Do not use the one passed potentially with -a
2568	my ($pbac) = pb_conf_get($vtype."login");
2569	my ($key,$zero0,$zero1,$zero2);
2570	my ($vmexist,$vmpid);
2571
2572	# Prepare the script to be executed on the VM/VE
2573	# in $ENV{'PBDESTDIR'}/setupv
2574	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
2575
2576	print SCRIPT << 'EOF';
2577	#!/usr/bin/perl -w
2578
2579	use strict;
2580	use File::Copy;
2581
2582	# We should not need in this script more functions than what is provided
2583	# by Base, Conf and Distribution to avoid problems at exec time.
2584	# They are appended at the end.
2585
2586	# Define mandatory global vars
2587	our $pbdebug;
2588	our $pbLOG;
2589	our $pbsynmsg = "pbscript";
2590	our $pbdisplaytype = "text";
2591	our $pblocale = "";
2592	pb_log_init($pbdebug, $pbLOG);
2593	pb_temp_init();
2594
2595	EOF
2596
2597	# Launch the VM/VE - Usage of snapshot disabled
2598	($vmexist,$vmpid) = pb_launchv($vtype,$v,0,0,0);
2599
2600	my $keyfile;
2601	my $nport;
2602	my $vmhost;
2603
2604	if ($vtype eq "vm") {
2605	# Prepare the key to be used and transfered remotely
2606	$keyfile = pb_ssh_get(1);
2607
2608	my ($vmport,$vmntp);
2609	($vmhost,$vmport,$vmntp) = pb_conf_get("vmhost","vmport","vmntp");
2610	$nport = pb_get_port($vmport->{$ENV{'PBPROJ'}});
2611
2612	# Skip that VM if something went wrong
2613	next if (($vmpid == 0) && ($vmexist == 0));
2614
2615	# Store the pub key part in a variable
2616	open(FILE,"$keyfile.pub") \|\| die "Unable to open $keyfile.pub";
2617	($zero0,$zero1,$zero2) = split(/ /,<FILE>);
2618	close(FILE);
2619
2620	$key = "\Q$zero1";
2621
2622	# We call true to avoid problems if SELinux is not activated, but chcon is present and returns in that case 1
2623	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 ; if [ -x /usr/bin/chcon ]; then /usr/bin/chcon -Rt home_ssh_t .ssh 2> /dev/null; /bin/true; fi\"","Copying local keys to $vtype. This may require the root password");
2624	# once this is done, we can do what we want on the VM remotely
2625	} elsif ($vtype eq "ve") {
2626	print SCRIPT << "EOF";
2627	# For VE we need a good null dev
2628	pb_system("rm -f /dev/null; mknod /dev/null c 1 3; chmod 777 /dev/null");
2629	EOF
2630	print SCRIPT << "EOF";
2631	# For VE we first need to mount some FS
2632	pb_system("mount -t proc /proc /proc");
2633
2634	EOF
2635	}
2636
2637	if ($vtype eq "vm") {
2638	print SCRIPT << 'EOF';
2639	# Removes duplicate in .ssh/authorized_keys of our key if needed
2640	#
2641	my $file1="$ENV{'HOME'}/.ssh/authorized_keys";
2642	open(PBFILE,$file1) \|\| die "Unable to open $file1";
2643	open(PBOUT,"> $file1.new") \|\| die "Unable to open $file1.new";
2644	my $count = 0;
2645	while (<PBFILE>) {
2646
2647	EOF
2648	print SCRIPT << "EOF";
2649	if (/ $key /) {
2650	\$count++;
2651	}
2652	print PBOUT \$_ if ((\$count <= 1) \|\| (\$_ !~ / $key /));
2653	}
2654	close(PBFILE);
2655	close(PBOUT);
2656	rename("\$file1.new",\$file1);
2657	chmod 0600,\$file1;
2658
2659	# Sync date
2660	EOF
2661	if (defined $ntpline) {
2662	print SCRIPT "pb_system(\"$ntpline\");\n";
2663	} else {
2664	print SCRIPT "pb_system(\"$dateline\");\n";
2665	}
2666	}
2667	print SCRIPT << 'EOF';
2668
2669	# Adds $pbac->{$ENV{'PBPROJ'}} as an account if needed
2670	#
2671	my $file="/etc/passwd";
2672	open(PBFILE,$file) \|\| die "Unable to open $file";
2673	my $found = 0;
2674	while (<PBFILE>) {
2675	EOF
2676	print SCRIPT << "EOF";
2677	\$found = 1 if (/^$pbac->{$ENV{'PBPROJ'}}:/);
2678	EOF
2679
2680	my $home = "/home";
2681	# Solaris doesn't like that we use /home
2682	$home = "/export/home" if ($dtype eq "pkg");
2683
2684	print SCRIPT << "EOF";
2685	}
2686	close(PBFILE);
2687
2688	if ( \$found == 0 ) {
2689	if ( ! -d "$home" ) {
2690	pb_mkdir_p("$home");
2691	}
2692	EOF
2693	print SCRIPT << "EOF";
2694	pb_system("/usr/sbin/groupadd $pbac->{$ENV{'PBPROJ'}}","Adding group $pbac->{$ENV{'PBPROJ'}}");
2695	pb_system("/usr/sbin/useradd -g $pbac->{$ENV{'PBPROJ'}} -m -d $home/$pbac->{$ENV{'PBPROJ'}} $pbac->{$ENV{'PBPROJ'}}","Adding user $pbac->{$ENV{'PBPROJ'}} (group $pbac->{$ENV{'PBPROJ'}} - home $home/$pbac->{$ENV{'PBPROJ'}})");
2696	}
2697	EOF
2698
2699	# Copy the content of our local conf file to the VM/VE
2700	my $content = pb_get_content(pb_distro_conffile());
2701	print SCRIPT << "EOF";
2702	#
2703	# Create a temporary local conf file for distribution support
2704	# This is created here before its use later. Its place is hardcoded, so no choice for the path
2705	#
2706	my \$tempconf = pb_distro_conffile();
2707	pb_mkdir_p(dirname(\$tempconf));
2708	open(CONF,"> \$tempconf") \|\| die "Unable to create \$tempconf";
2709	print CONF q{$content};
2710	close(CONF);
2711	EOF
2712
2713	if ($vtype eq "vm") {
2714	print SCRIPT << "EOF";
2715	# allow ssh entry to build
2716	#
2717	mkdir "$home/$pbac->{$ENV{'PBPROJ'}}/.ssh",0700;
2718	# Allow those accessing root to access the build account
2719	copy("\$ENV{'HOME'}/.ssh/authorized_keys","$home/$pbac->{$ENV{'PBPROJ'}}/.ssh/authorized_keys");
2720	chmod 0600,".ssh/authorized_keys";
2721	pb_system("chown -R $pbac->{$ENV{'PBPROJ'}}:$pbac->{$ENV{'PBPROJ'}} $home/$pbac->{$ENV{'PBPROJ'}}","Finish setting up the account env for $pbac->{$ENV{'PBPROJ'}}");
2722
2723	EOF
2724	}
2725	print SCRIPT << 'EOF';
2726	# No passwd for build account only keys
2727	$file="/etc/shadow";
2728	if (-f $file) {
2729	open(PBFILE,$file) \|\| die "Unable to open $file";
2730	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
2731	while (<PBFILE>) {
2732	EOF
2733	print SCRIPT << "EOF";
2734	s/^$pbac->{$ENV{'PBPROJ'}}:\!\!:/$pbac->{$ENV{'PBPROJ'}}:*:/;
2735	s/^$pbac->{$ENV{'PBPROJ'}}:\!:/$pbac->{$ENV{'PBPROJ'}}:*:/; #SLES 9 e.g.
2736	s/^$pbac->{$ENV{'PBPROJ'}}:\\LK\\:/$pbac->{$ENV{'PBPROJ'}}:NP:/; #Solaris e.g.
2737	EOF
2738	print SCRIPT << 'EOF';
2739	print PBOUT $_;
2740	}
2741	close(PBFILE);
2742	close(PBOUT);
2743	rename("$file.new",$file);
2744	chmod 0640,$file;
2745	}
2746
2747	# Keep the VM in text mode
2748	$file="/etc/inittab";
2749	if (-f $file) {
2750	open(PBFILE,$file) \|\| die "Unable to open $file";
2751	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
2752	while (<PBFILE>) {
2753	s/^(..):5:initdefault:$/$1:3:initdefault:/;
2754	print PBOUT $_;
2755	}
2756	close(PBFILE);
2757	close(PBOUT);
2758	rename("$file.new",$file);
2759	chmod 0640,$file;
2760	}
2761
2762	# pb has to be added to portage group on gentoo
2763
2764	# We need to have that pb_distro_init function
2765	# Get it from Project-Builder::Distribution
2766	# And we now need the conf file required for this to work created above
2767
2768	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins, $darch) = pb_distro_init();
2769	print "distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $pbins, $darch))."\n";
2770
2771	# Adapt sudoers
2772	# sudo is not default on Solaris and needs to be installed first
2773	# from http://www.sunfreeware.com/programlistsparc10.html#sudo
2774	if ($dtype eq "pkg") {
2775	$file="/usr/local/etc/sudoers";
2776	} else {
2777	$file="/etc/sudoers";
2778	}
2779	open(PBFILE,$file) \|\| die "Unable to open $file";
2780	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
2781	while (<PBFILE>) {
2782	EOF
2783	print SCRIPT << "EOF";
2784	next if (/^$pbac->{$ENV{'PBPROJ'}} /);
2785	EOF
2786	print SCRIPT << 'EOF';
2787	s/Defaults[ \t]+requiretty//;
2788	print PBOUT $_;
2789	}
2790	close(PBFILE);
2791	EOF
2792	print SCRIPT << "EOF";
2793	# Some distro force requiretty at compile time, so disable here
2794	print PBOUT "Defaults:$pbac->{$ENV{'PBPROJ'}} !requiretty\n";
2795	print PBOUT "Defaults:root !requiretty\n";
2796	# This is needed in order to be able to halt the machine from the $pbac->{$ENV{'PBPROJ'}} account at least
2797	print PBOUT "Defaults:$pbac->{$ENV{'PBPROJ'}} env_keep += \\\"http_proxy ftp_proxy\\\"\n";
2798	print PBOUT "$pbac->{$ENV{'PBPROJ'}} ALL=(ALL) NOPASSWD:ALL\n";
2799	EOF
2800	print SCRIPT << 'EOF';
2801	close(PBOUT);
2802	rename("$file.new",$file);
2803	chmod 0440,$file;
2804
2805	EOF
2806
2807	# We may need a proxy configuration. Get it from the local env
2808
2809	if (defined $ENV{'http_proxy'}) {
2810	print SCRIPT "\$ENV\{'http_proxy'\}=\"$ENV{'http_proxy'}\";\n";
2811	}
2812
2813	if (defined $ENV{'ftp_proxy'}) {
2814	print SCRIPT "\$ENV\{'ftp_proxy'\}=\"$ENV{'ftp_proxy'}\";\n";
2815	}
2816
2817	print SCRIPT << 'EOF';
2818
2819	# Suse wants sudoers as 640
2820	if ((($ddir eq "sles") && (($dver =~ /10/) \|\| ($dver =~ /9/))) \|\| (($ddir eq "opensuse") && ($dver =~ /10.[012]/))) {
2821	chmod 0640,$file;
2822	}
2823
2824	# First install all required packages
2825	pb_system("yum clean all","Cleaning yum env") if (($ddir eq "fedora") \|\| ($ddir eq "asianux") \|\| ($ddir eq "rhel"));
2826	my ($ospkgdep) = pb_conf_get_if("ospkgdep");
2827
2828	my $pkgdep = pb_distro_get_param($ddir,$dver,$darch,$ospkgdep,$dfam,$dtype,$dos);
2829	pb_distro_installdeps(undef,$dtype,$pbins,pb_distro_only_deps_needed($dtype,join(' ',split(/,/,$pkgdep))));
2830
2831	EOF
2832	my ($instype) = pb_conf_get("pbinstalltype");
2833	my $itype = pb_distro_get_param($ddir,$dver,$darch,$instype,$dfam,$dtype,$dos);
2834	if (defined $sbx) {
2835	# Install from sandbox mean a file base install
2836	$itype = "file";
2837	}
2838	if ($itype =~ /^file/) {
2839	my $cmdget;
2840	if (defined $sbx) {
2841	# Install from sandbox mean using the result of the just passed sbx2build command
2842	# Get content saved in cms2build
2843	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
2844	die "Unable to get package list" if (not defined $pkg);
2845
2846	# We consider 2 specific packages
2847	my $vertag1 = $pkg->{"ProjectBuilder"};
2848	my $vertag2 = $pkg->{"project-builder"};
2849	# get the version of the current package - maybe different
2850	my ($pbver1,$tmp1) = split(/-/,$vertag1);
2851	my ($pbver2,$tmp2) = split(/-/,$vertag2);
2852	# Copy inside the VE
2853	if ($vtype eq "ve") {
2854	my ($vepath) = pb_conf_get("vepath");
2855	copy("$ENV{'PBDESTDIR'}/ProjectBuilder-$pbver1.tar.gz","$vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch/tmp");
2856	copy("$ENV{'PBDESTDIR'}/project-builder-$pbver2.tar.gz","$vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch/tmp");
2857	} else {
2858	pb_system("scp -i $keyfile -p -o UserKnownHostsFile=/dev/null -P $nport $ENV{'PBDESTDIR'}/ProjectBuilder-$pbver1.tar.gz $ENV{'PBDESTDIR'}/project-builder-$pbver2.tar.gz root\@$vmhost->{$ENV{'PBPROJ'}}:/tmp","Copying local project files to $vtype.");
2859	}
2860	$cmdget = "mv /tmp/ProjectBuilder-$pbver1.tar.gz ProjectBuilder-latest.tar.gz ; mv /tmp/project-builder-$pbver2.tar.gz project-builder-latest.tar.gz";
2861	} else {
2862	$cmdget = "wget --passive-ftp ftp://ftp.project-builder.org/src/ProjectBuilder-latest.tar.gz; wget --passive-ftp ftp://ftp.project-builder.org/src/project-builder-latest.tar.gz";
2863	}
2864	print SCRIPT << 'EOF';
2865	# Then install manually the missing perl modules
2866	my ($osperldep,$osperlver) = pb_conf_get_if("osperldep","osperlver");
2867
2868	my $perldep = pb_distro_get_param($ddir,$dver,$darch,$osperldep,$dfam,$dtype,$dos);
2869	foreach my $m (split(/,/,$perldep)) {
2870	# Skip empty deps
2871	next if ($m =~ /^\s*$/);
2872	my $dir = $m;
2873	$dir =~ s/-.*//;
2874	pb_system("echo \"rm -rf $m* ; wget http://search.cpan.org/CPAN/modules/by-module/$dir/$m-$osperlver->{$m}.tar.gz ; gzip -cd $m-$osperlver->{$m}.tar.gz \| tar xf - ; cd $m* ; if [ -f Build.PL ]; then perl Build.PL; ./Build ; ./Build install ; else perl Makefile.PL; make ; make install ; fi; cd .. ; rm -rf $m*\" \| bash" ,"Installing perl module $m-$osperlver->{$m}");
2875	}
2876	EOF
2877
2878	print SCRIPT << "EOF";
2879	pb_system("rm -rf ProjectBuilder-* ; rm -rf project-builder-* ; $cmdget ; gzip -cd ProjectBuilder-latest.tar.gz \| tar xf - ; cd ProjectBuilder-* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf ProjectBuilder-* ; gzip -cd project-builder-latest.tar.gz \| tar xf - ; cd project-builder-* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf project-builder-* ;","Building Project-Builder");
2880	EOF
2881	} elsif ($itype =~ /^pkg/) {
2882	# pkg based install. We need to point to the project-builder.org repository
2883	print SCRIPT << 'EOF';
2884	my ($ospkg) = pb_conf_get_if("ospkg");
2885
2886	my $pkgforpb = pb_distro_get_param($ddir,$dver,$darch,$ospkg,$dfam,$dtype,$dos);
2887	pb_distro_setuposrepo($ddir,$dver,$darch,$dtype,$dfam,$dos);
2888	pb_distro_installdeps(undef,$dtype,$pbins,pb_distro_only_deps_needed($dtype,join(' ',split(/,/,$pkgforpb))));
2889	EOF
2890	} else {
2891	# Unknown install type
2892	die("Unknown install type $itype->{$ENV{'PBPROJ'}} for param pbinstalltype");
2893	}
2894	print SCRIPT << 'EOF';
2895	pb_system("pb 2>&1 \| head -5",undef,"verbose");
2896	EOF
2897	if ($vtype eq "ve") {
2898	print SCRIPT << 'EOF';
2899	# For VE we need to umount some FS at the end
2900
2901	pb_system("umount /proc");
2902
2903	# Create a basic network file if not already there
2904
2905	my $nf="/etc/sysconfig/network";
2906	if ((! -f $nf) && ($dtype eq "rpm")) {
2907	open(NF,"> $nf") \|\| die "Unable to create $nf";
2908	print NF "NETWORKING=yes\n";
2909	print NF "HOSTNAME=localhost\n";
2910	close(NF);
2911	}
2912	chmod 0755,$nf;
2913	EOF
2914	}
2915
2916	# Adds pb_distro_init and all functions needed from ProjectBuilder::Distribution, Conf and Base
2917	foreach my $d (@INC) {
2918	my @f = ("$d/ProjectBuilder/Base.pm","$d/ProjectBuilder/Distribution.pm","$d/ProjectBuilder/Conf.pm");
2919	foreach my $f (@f) {
2920	if (-f "$f") {
2921	open(PBD,"$f") \|\| die "Unable to open $f";
2922	while (<PBD>) {
2923	next if (/^package/);
2924	next if (/^use Exporter/);
2925	next if (/^use ProjectBuilder::/);
2926	next if (/^our /);
2927	print SCRIPT $_;
2928	}
2929	close(PBD);
2930	}
2931	}
2932	}
2933	# Use a fake pb_version_init version here
2934	print SCRIPT << "EOF";
2935	sub pb_version_init {
2936
2937	return("$projectbuilderver","$projectbuilderrev");
2938	}
2939	1;
2940	EOF
2941	close(SCRIPT);
2942	chmod 0755,"$pbscript";
2943
2944	# That build script needs to be run as root and force stop of VM at end
2945	$pbaccount = "root";
2946
2947	# Force shutdown of VM except if it was already launched
2948	my $pbforce = 0;
2949	if ((! $vmexist) && ($vtype eq "vm")) {
2950	$pbforce = 1;
2951	}
2952
2953	pb_script2v($pbscript,$vtype,$pbforce,$v);
2954	$pm->finish if (defined $pbparallel);
2955	}
2956	if (defined $pbparallel) {
2957	$pm->wait_all_children;
2958	}
2959	return;
2960	}
2961
2962	# Function to create a snapshot named 'pb' for VMs and a compressed tar for VEs
2963	sub pb_snap2v {
2964
2965	my $vtype = shift;
2966
2967	my ($vm,$all) = pb_get2v($vtype);
2968
2969	# Script generated
2970	my $pbscript = "$ENV{'PBDESTDIR'}/snapv";
2971
2972	my ($pbac) = pb_conf_get($vtype."login");
2973
2974	foreach my $v (@$vm) {
2975	if ($vtype eq "ve") {
2976	# Get distro context
2977	my ($name,$ver,$darch) = split(/-/,$v);
2978	chomp($darch);
2979	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf) = pb_distro_init($name,$ver,$darch);
2980	my ($vepath) = pb_conf_get("vepath");
2981
2982	# Test if an existing snapshot exists and remove it if there is a VE
2983	if ((-f "$vepath->{$ENV{'PBPROJ'}}/$ddir-$dver-$darch.tar.gz") &&
2984	(! -d "$vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch")) {
2985	pb_system("sudo rm -f $vepath->{$ENV{'PBPROJ'}}/$ddir-$dver-$darch.tar.gz","Removing previous snapshot $ddir-$dver-$darch.tar.gz");
2986	}
2987	}
2988
2989	# Prepare the script to be executed on the VM/VE
2990	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
2991	print SCRIPT << 'EOF';
2992	#!/bin/bash
2993	sleep 2
2994	EOF
2995	close(SCRIPT);
2996	chmod 0755,"$pbscript";
2997
2998	# Force shutdown of VM/VE
2999	# Force snapshot of VM/VE
3000	pb_script2v($pbscript,$vtype,1,$v,1);
3001	}
3002	return;
3003	}
3004
3005	# Function to update a VMs or VEs with the latest distribution content
3006	sub pb_update2v {
3007
3008	my $vtype = shift;
3009
3010	my ($vm,$all) = pb_get2v($vtype);
3011
3012	# Script generated
3013	my $pbscript = "$ENV{'PBDESTDIR'}/updatev";
3014
3015	my ($pbac) = pb_conf_get($vtype."login");
3016
3017	foreach my $v (@$vm) {
3018	# Get distro context
3019	my ($name,$ver,$darch) = split(/-/,$v);
3020	chomp($darch);
3021	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins) = pb_distro_init($name,$ver,$darch);
3022
3023	# Prepare the script to be executed on the VM/VE
3024	# in $ENV{'PBDESTDIR'}/updatev
3025	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
3026
3027	print SCRIPT << 'EOF';
3028	#!/bin/bash
3029	sleep 2
3030	EOF
3031	# VE needs a good /proc
3032	if ($vtype eq "ve") {
3033	print SCRIPT "sudo mount -t proc /proc /proc\n";
3034	}
3035	print SCRIPT "$pbupd\n";
3036	if ($vtype eq "ve") {
3037	print SCRIPT "sudo umount /proc\n";
3038	}
3039	close(SCRIPT);
3040	chmod 0755,"$pbscript";
3041
3042	# Force shutdown of VM except
3043	pb_script2v($pbscript,$vtype,1,$v);
3044	}
3045	return;
3046	}
3047
3048	sub pb_announce {
3049
3050	# Get all required parameters
3051	my ($pbpackager,$pbrepo,$pbml,$pbsmtp) = pb_conf_get("pbpackager","pbrepo","pbml","pbsmtp");
3052	my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
3053	my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
3054	my @pkgs = @$pkg;
3055	my %pkgs;
3056	my $first = 0;
3057
3058	# Command to find packages on repo
3059	my $findstr = "find . ";
3060	# Generated announce files
3061	my @files;
3062
3063	foreach my $pbpkg (@pkgs) {
3064	if ($first != 0) {
3065	$findstr .= "-o ";
3066	}
3067	$first++;
3068	if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
3069	$pbver = $pkgv->{$pbpkg};
3070	} else {
3071	$pbver = $ENV{'PBPROJVER'};
3072	}
3073	if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
3074	$pbtag = $pkgt->{$pbpkg};
3075	} else {
3076	$pbtag = $ENV{'PBPROJTAG'};
3077	}
3078
3079	# TODO: use virtual/real names here now
3080	$findstr .= "-name \'$pbpkg-$pbver-$pbtag\..rpm\' -o -name \'$pbpkg"."_$pbver\.deb\' -o -name \'$pbpkg-$pbver*\.ebuild\' ";
3081
3082	my $chglog;
3083
3084	# Get project info on log file and generate tmp files used later on
3085	pb_cms_init($pbinit);
3086	$chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
3087	$chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
3088	$chglog = undef if (! -f $chglog);
3089
3090	open(OUT,"> $ENV{'PBTMP'}/$pbpkg.ann") \|\| die "Unable to create $ENV{'PBTMP'}/$pbpkg.ann: $!";
3091	my %pb;
3092	$pb{'dtype'} = "announce";
3093	$pb{'realpkg'} = $pbpkg;
3094	$pb{'ver'} = $pbver;
3095	$pb{'tag'} = $pbtag;
3096	$pb{'suf'} = "N/A"; # Should not be empty even if unused
3097	$pb{'date'} = $pbdate;
3098	$pb{'chglog'} = $chglog;
3099	$pb{'packager'} = $pbpackager;
3100	$pb{'proj'} = $ENV{'PBPROJ'};
3101	$pb{'repo'} = $pbrepo;
3102	pb_changelog(\%pb,\*OUT,"yes");
3103	close(OUT);
3104	push(@files,"$ENV{'PBTMP'}/$pbpkg.ann");
3105	}
3106	$findstr .= " \| grep -Ev \'src.rpm\'";
3107
3108	# Prepare the command to run and execute it
3109	open(PBS,"> $ENV{'PBTMP'}/pbscript") \|\| die "Unable to create $ENV{'PBTMP'}/pbscript";
3110	print PBS "$findstr\n";
3111	close(PBS);
3112	chmod 0755,"$ENV{'PBTMP'}/pbscript";
3113	pb_send2target("Announce");
3114
3115	# Get subject line
3116	my $sl = "Project $ENV{'PBPROJ'} version $ENV{'PBPROJVER'} is now available";
3117	pb_log(0,"Please enter the title of your announce\n");
3118	pb_log(0,"(By default: $sl)\n");
3119	my $sl2 = <STDIN>;
3120	$sl = $sl2 if ($sl2 !~ /^$/);
3121
3122	# Prepare a template of announce
3123	open(ANN,"> $ENV{'PBTMP'}/announce.html") \|\| die "Unable to create $ENV{'PBTMP'}/announce.html: $!";
3124	print ANN << "EOF";
3125	$sl</p>
3126
3127	<p>The project team is happy to announce the availability of a newest version of $ENV{'PBPROJ'} $ENV{'PBPROJVER'}. Enjoy it as usual!</p>
3128	<p>
3129	Now available at <a href="$pbrepo->{$ENV{'PBPROJ'}}">$pbrepo->{$ENV{'PBPROJ'}}</a>
3130	</p>
3131	<p>
3132	EOF
3133	open(LOG,"$ENV{'PBTMP'}/system.$$.log") \|\| die "Unable to read $ENV{'PBTMP'}/system.$$.log: $!";
3134	my $col = 2;
3135	my $i = 1;
3136	print ANN << 'EOF';
3137	<TABLE WIDTH="700" CELLPADDING="0" CELLSPACING="0" BORDER="0">
3138	<TR>
3139	EOF
3140	while (<LOG>) {
3141	print ANN "<TD><A HREF=\"$pbrepo->{$ENV{'PBPROJ'}}/$_\">$_</A></TD>";
3142	$i++;
3143	if ($i > $col) {
3144	print ANN "</TR>\n<TR>";
3145	$i = 1;
3146	}
3147	}
3148	close(LOG);
3149	print ANN << "EOF";
3150	</TR>
3151	</TABLE>
3152	</p>
3153
3154	<p>As usual source packages are also available in the same directory.</p>
3155
3156	<p>
3157	Changes are :
3158	</p>
3159	<p>
3160	EOF
3161	# Get each package changelog content
3162	foreach my $f (sort(@files)) {
3163	open(IN,"$f") \|\| die "Unable to read $f:$!";
3164	while (<IN>) {
3165	print ANN $_;
3166	}
3167	close(IN);
3168	print ANN "</p><p>\n";
3169	}
3170	print ANN "</p>\n";
3171	close(ANN);
3172
3173	# Allow for modification
3174	my $editor = "vi";
3175	$editor = $ENV{'EDITOR'} if (defined $ENV{'EDITOR'});
3176	pb_system("$editor $ENV{'PBTMP'}/announce.html","Allowing modification of the announce","noredir");
3177
3178	# Store it in DB for external usage (Web pages generation)
3179	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
3180
3181	my $precmd = "";
3182	if (! -f $db) {
3183	$precmd = "CREATE TABLE announces (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, announce VARCHAR[65535])";
3184	}
3185
3186	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
3187	{ RaiseError => 1, AutoCommit => 1 })
3188	\|\| die "Unable to connect to $db";
3189
3190	if ($precmd ne "") {
3191	my $sth = $dbh->prepare(qq{$precmd})
3192	\|\| die "Unable to create table into $db";
3193	$sth->execute();
3194	}
3195
3196	# To read whole file
3197	local $/;
3198	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
3199	my $announce = <ANN>;
3200	close(ANN);
3201
3202	pb_log(2,"INSERT INTO announces VALUES (NULL, $pbdate, $announce)");
3203	my $sth = $dbh->prepare(qq{INSERT INTO announces VALUES (NULL,?,?)})
3204	\|\| die "Unable to insert into $db";
3205	$sth->execute($pbdate, $announce);
3206	$sth->finish();
3207	$dbh->disconnect;
3208
3209	# Then deliver it on the Web
3210	# $TOOLHOME/livwww www
3211
3212	# Mail it to project's ML
3213	open(ML,"\| w3m -dump -T text/html > $ENV{'PBTMP'}/announce.txt") \|\| die "Unable to create $ENV{'PBTMP'}/announce.txt: $!";
3214	print ML << 'EOF';
3215	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/x html1/DTD/xhtml1-strict.dtd">
3216
3217	<html xmlns="http://www.w3.org/1999/xhtml" dir="ltr" xml:lang="en" lang="en">
3218	<head>
3219	</head>
3220	<body>
3221	<p>
3222	EOF
3223	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
3224	while(<ANN>) {
3225	print ML $_;
3226	}
3227	print ML << 'EOF';
3228	</body>
3229	</html>
3230	EOF
3231	close(ML);
3232
3233	# To read whole file
3234	local $/;
3235	open(ANN,"$ENV{'PBTMP'}/announce.txt") \|\| die "Unable to read $ENV{'PBTMP'}/announce.txt: $!";
3236	my $msg = <ANN>;
3237	close(ANN);
3238
3239	# Preparation of headers
3240	eval
3241	{
3242	require Mail::Sendmail;
3243	Mail::Sendmail->import();
3244	};
3245	if ($@) {
3246	# Mail::Sendmail not found not sending mail !
3247	pb_log(0,"No Mail::Sendmail module found so not sending any mail !\n");
3248	} else {
3249	my %mail = (
3250	To => $pbml->{$ENV{'PBPROJ'}},
3251	From => $pbpackager->{$ENV{'PBPROJ'}},
3252	Smtp => $pbsmtp->{$ENV{'PBPROJ'}},
3253	Body => $msg,
3254	Subject => "[ANNOUNCE] $sl",
3255	);
3256
3257	# Send mail
3258	if (! sendmail(%mail)) {
3259	if ((defined $Mail::Sendmail::error) and (defined $Mail::Sendmail::log)) {
3260	die "Unable to send mail ($Mail::Sendmail::error): $Mail::Sendmail::log";
3261	}
3262	}
3263	}
3264	}
3265
3266	#
3267	# Creates a set of HTML file containing the news for the project
3268	# based on what has been generated by the pb_announce function
3269	#
3270	sub pb_web_news2html {
3271
3272	my $dest = shift \|\| $ENV{'PBTMP'};
3273
3274	# Get all required parameters
3275	my ($pkgv, $pkgt) = pb_conf_get_if("pkgver","pkgtag");
3276
3277	# DB of announces for external usage (Web pages generation)
3278	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
3279
3280	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
3281	{ RaiseError => 1, AutoCommit => 1 })
3282	\|\| die "Unable to connect to $db";
3283	# For date handling
3284	$ENV{LANGUAGE}="C";
3285	my $firstjan = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year(), 0, 0, -1);
3286	my $oldfirst = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year()-1, 0, 0, -1);
3287	pb_log(2,"firstjan: $firstjan, oldfirst: $oldfirst, pbdate:$pbdate\n");
3288	my $all = $dbh->selectall_arrayref("SELECT id,date,announce FROM announces ORDER BY date DESC");
3289	my %news;
3290	$news{"cy"} = ""; # current year's news
3291	$news{"ly"} = ""; # last year news
3292	$news{"py"} = ""; # previous years news
3293	$news{"fp"} = ""; # first page news
3294	my $cpt = 4; # how many news for first page
3295	# Extract info from DB
3296	foreach my $row (@$all) {
3297	my ($id, $date, $announce) = @$row;
3298	$news{"cy"} = $news{"cy"}."<p><B>$date</B> $announce\n" if ((($date cmp $pbdate) le 0) && (($firstjan cmp $date) le 0));
3299	$news{"ly"} = $news{"ly"}."<p><B>$date</B> $announce\n" if ((($date cmp $firstjan) le 0) && (($oldfirst cmp $date) le 0));
3300	$news{"py"} = $news{"py"}."<p><B>$date</B> $announce\n" if (($date cmp $oldfirst) le 0);
3301	$news{"fp"} = $news{"fp"}."<p><B>$date</B> $announce\n" if ($cpt > 0);
3302	$cpt--;
3303	}
3304	pb_log(1,"news{fp}: ".$news{"fp"}."\n");
3305	$dbh->disconnect;
3306
3307	# Generate the HTML content
3308	foreach my $pref (keys %news) {
3309	open(NEWS,"> $dest/pb_web_$pref"."news.html") \|\| die "Unable to create $dest/pb_web_$pref"."news.html: $!";
3310	print NEWS "$news{$pref}";
3311	close(NEWS);
3312	}
3313	}
3314
3315
3316	# Return the SSH key file to use
3317	# Potentially create it if needed
3318
3319	sub pb_ssh_get {
3320
3321	my $create = shift \|\| 0; # Do not create keys by default
3322
3323	# Check the SSH environment
3324	my $keyfile = undef;
3325
3326	# We have specific keys by default
3327	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
3328	if (!(-e $keyfile) && ($create eq 1)) {
3329	pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
3330	}
3331
3332	$keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
3333	$keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
3334	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
3335	die "Unable to find your public ssh key under $keyfile" if (not defined $keyfile);
3336	return($keyfile);
3337	}
3338
3339
3340	# Returns the pid of a running VM command using a specific VM file
3341	sub pb_check_ps {
3342	my $vmcmd = shift;
3343	my $vmm = shift;
3344	my $vmexist = 0; # FALSE by default
3345
3346	open(PS, "ps auxhww\|") \|\| die "Unable to call ps";
3347	while (<PS>) {
3348	next if (! /$vmcmd/);
3349	next if (! /$vmm/);
3350	my ($void1, $void2);
3351	($void1, $vmexist, $void2) = split(/ +/);
3352	last;
3353	}
3354	return($vmexist);
3355	}
3356
3357
3358	sub pb_extract_build_files {
3359
3360	my $src=shift;
3361	my $dir=shift;
3362	my $ddir=shift;
3363	my $mandatory=shift \|\| "spec";
3364	my @files;
3365
3366	my $flag = "mayfail" if ($mandatory eq "patch");
3367	my $res;
3368
3369	if ($src =~ /tar\.gz$/) {
3370	$res = pb_system("tar xfpz $src $dir","Extracting $mandatory files from $src",$flag);
3371	} elsif ($src =~ /tar\.bz2$/) {
3372	$res = pb_system("tar xfpj $src $dir","Extracting $mandatory files from $src",$flag);
3373	} else {
3374	die "Unknown compression algorithm for $src";
3375	}
3376	# If not mandatory return now
3377	return() if (($res != 0) and ($mandatory eq "patch"));
3378	opendir(DIR,"$dir") \|\| die "Unable to open directory $dir";
3379	foreach my $f (readdir(DIR)) {
3380	next if ($f =~ /^\./);
3381	# Skip potential patch dir
3382	next if ($f =~ /^pbpatch/);
3383	move("$dir/$f","$ddir") \|\| die "Unable to move $dir/$f to $ddir";
3384	pb_log(2,"mv $dir/$f $ddir\n");
3385	push @files,"$ddir/$f";
3386	}
3387	closedir(DIR);
3388	# Not enough but still a first cleanup
3389	pb_rm_rf("$dir");
3390	return(@files);
3391	}
3392
3393	sub pb_list_bfiles {
3394
3395	my $dir = shift;
3396	my $pbpkg = shift;
3397	my $bfiles = shift;
3398	my $pkgfiles = shift;
3399	my $supfiles = shift;
3400
3401	opendir(BDIR,"$dir") \|\| die "Unable to open dir $dir: $!";
3402	foreach my $f (readdir(BDIR)) {
3403	next if ($f =~ /^\./);
3404	if (-d $f) {
3405	# Recurse for directories (Debian 3.0 format e.g.)
3406	pb_list_bfiles($f,$pbpkg,$bfiles,$pkgfiles,$supfiles);
3407	next;
3408	}
3409	$bfiles->{$f} = "$dir/$f";
3410	$bfiles->{$f} =~ s~$ENV{'PBROOTDIR'}~~;
3411	if (defined $supfiles->{$pbpkg}) {
3412	$pkgfiles->{$f} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
3413	}
3414	}
3415	closedir(BDIR);
3416	}
3417
3418	sub pb_list_sfiles {
3419
3420	my $sdir = shift;
3421	my $sources = shift;
3422	my $dtype = shift;
3423	my $dfam = shift;
3424	my $ddir = shift;
3425	my $dver = shift;
3426	my $arch = shift;
3427	my $extdir = shift;
3428
3429	# Prepare local sources for this distro - They are always applied first - May be a problem one day
3430	# This function works for both patches and additional sources
3431	foreach my $p (sort(<$sdir/*>)) {
3432	$sources->{"$ddir-$dver-$arch"} .= "," if ((defined $sources->{"$ddir-$dver-$arch"}) and ($p =~ /\.all$/));
3433	$sources->{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.all$/);
3434	$sources->{"$ddir-$dver-$arch"} .= "," if ((defined $sources->{"$ddir-$dver-$arch"}) and ($p =~ /\.$dtype$/));
3435	$sources->{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$dtype$/);
3436	$sources->{"$ddir-$dver-$arch"} .= "," if ((defined $sources->{"$ddir-$dver-$arch"}) and ($p =~ /\.$dfam$/));
3437	$sources->{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$dfam$/);
3438	$sources->{"$ddir-$dver-$arch"} .= "," if ((defined $sources->{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir$/));
3439	$sources->{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir$/);
3440	$sources->{"$ddir-$dver-$arch"} .= "," if ((defined $sources->{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir-$dver$/));
3441	$sources->{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir-$dver$/);
3442	$sources->{"$ddir-$dver-$arch"} .= "," if ((defined $sources->{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir-$dver-$arch$/));
3443	$sources->{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir-$dver-$arch$/);
3444	}
3445
3446	# Prepare also remote sources to be included - Applied after the local ones
3447	foreach my $p ("all","$dtype","$dfam","$ddir","$ddir-$dver","$ddir-$dver-$arch") {
3448	my $f = "$extdir.".".$p";
3449	next if (not -f $f);
3450	if (not open(PATCH,$f)) {
3451	pb_display("Unable to open existing external source file content $f\n");
3452	next;
3453	}
3454	while (<PATCH>) {
3455	chomp();
3456	$sources->{"$ddir-$dver-$arch"} .= "," if (defined $sources->{"$ddir-$dver-$arch"});
3457	$sources->{"$ddir-$dver-$arch"} .= "$_";
3458	}
3459	close(PATCH);
3460	}
3461	pb_log(2,"DEBUG: sources: ".Dumper($sources)."\n");
3462	}
3463
3464	#
3465	# Return the list of packages we are working on in a non CMS action
3466	#
3467	sub pb_get_pkg {
3468
3469	my @pkgs = ();
3470
3471	my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
3472	@pkgs = keys %$var;
3473
3474	pb_log(0,"Packages: ".join(',',@pkgs)."\n");
3475	return(\@pkgs);
3476	}
3477
3478	#
3479	# Return the postinstall line if needed
3480	#
3481
3482	sub pb_get_postinstall {
3483
3484	my $ddir = shift;
3485	my $dver = shift;
3486	my $darch = shift;
3487	my $rbspi = shift;
3488	my $vestyle = shift;
3489	my $post = "";
3490
3491	# Do we have a local post-install script
3492	if ($vestyle eq "rinse") {
3493	$post = "--post-install ";
3494	} elsif ($vestyle eq "rpmbootstrap") {
3495	$post = "-s ";
3496	}
3497
3498	my $postparam = pb_distro_get_param($ddir,$dver,$darch,$rbspi);
3499	if ($postparam eq "") {
3500	$post = "";
3501	} else {
3502	$post .= $postparam;
3503	}
3504	return($post);
3505	}
3506
3507	# Manages VM SSH port communication
3508	sub pb_get_port {
3509
3510	my $port = shift;
3511	my $cmt = shift;
3512
3513	die "No port passed in parameter. Report to dev team\n" if (not defined $port);
3514	pb_log(2,"pb_get_port with $port\n");
3515	my $nport = $port;
3516	# Maybe a port was given as parameter so overwrite
3517	$nport = "$pbport" if (defined $pbport);
3518	# Maybe in // mode so use the env var set up as an offset to the base port, except when called from send2target for Packages
3519	if ((not defined $cmt) \|\| ($cmt ne "Packages")) {
3520	$nport += $ENV{'PBVMPORT'} if ((defined $pbparallel) && (defined $ENV{'PBVMPORT'}));
3521	}
3522	pb_log(2,"pb_get_port returns $nport\n");
3523	return($nport);
3524	}
3525
3526	sub pb_set_port {
3527
3528	my ($pid,$ident) = @_;
3529	pb_log(2,"pb_set_port for VM ($pid), id $ident\n");
3530	$ENV{'PBVMPORT'} = $ident;
3531	pb_log(2,"pb_set_port sets PBVMPORT in env to $ENV{'PBVMPORT'}\n");
3532	}
3533
3534	sub pb_set_parallel {
3535
3536	my $vtype = shift;
3537
3538	pb_log(2,"pb_set_parallel vtype: $vtype\n");
3539	# Take care of memory size if VM, parallel mode and more than 1 action
3540	if ((defined $pbparallel) && ($pbparallel ne 1) && ($vtype eq "vm")) {
3541	eval
3542	{
3543	require Linux::SysInfo;
3544	Linux::SysInfo->import();
3545	};
3546	if ($@) {
3547	# Linux::SysInfo not found
3548	pb_log(1,"ADVISE: Install Linux::SysInfo to benefit from automatic parallelism optimization.\nOr optimize manually pbparallel in your pb.conf file\nUsing $pbparallel processes max at a time for the moment\nWARNING: This may consume too much memory for your system");
3549	} else {
3550	# Using the memory size
3551	my $si = Linux::SysInfo::sysinfo();
3552	if (not defined $si) {
3553	pb_log(1,"ADVISE: Install Linux::SysInfo to benefit from automatic parallelism optimization.\nOr optimize manually pbparallel in your pb.conf file\nUsing $pbparallel processes max at a time for the moment\nWARNING: This may consume too much memory for your system");
3554	} else {
3555	# Keep the number of VM whose memory can be allocated
3556	my $ram = $si->{"totalram"}-$si->{"sharedram"}-$si->{"bufferram"};
3557	my $ram2;
3558	my ($vmmem) = pb_conf_get_if("vmmem");
3559
3560	my $v = "default";
3561	if ((defined $vmmem) and (defined $vmmem->{$v})) {
3562	$ram2 = $vmmem->{$v};
3563	} else {
3564	# Default for KVM/QEMU
3565	$ram2 = 128;
3566	}
3567	$pbparallel = sprintf("%d",$ram/$ram2);
3568	}
3569	pb_log(1,"Using $pbparallel processes at a time\n");
3570	}
3571	}
3572	pb_log(2,"pb_set_parallel returns: $pbparallel\n");
3573	return($pbparallel);
3574	}
3575
3576
3577	1;

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

Download in other formats: