Context Navigation

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

Last change on this file since 1153 was 1153, checked in by Bruno Cornec, 13 years ago
Avoid File::MimeInfo hard requirement. Only abort if not found when needed. Improve report when a perl module is missing Kill an existing crashed VM using an SSH port needed for another VM (should avoid crashed VM to stay when building for all VMs) Use a new parameter vmbuildtm as a timeout before killing the VM (shoudl correspond to build + transfer time) use twice the number of VMs for ports in the range for SSH communication to allow for VMs to finish in an unordered way. Fix a bug in test modules when using Test simple only Mail::Sendmail is now optional for Log module as well, even if not used yet Update pb.conf doc with info for vmbuildtm and vmmem Ready for 0.10.1
Property svn:executable set to ``*
File size: 114.6 KB

Line
1	#!/usr/bin/perl -w
2	#
3	# Project Builder main application
4	#
5	# $Id$
6	#
7	# Copyright B. Cornec 2007
8	# Provided under the GPL v2
9
10	# Syntax: see at end
11
12	use strict 'vars';
13
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[,...]]][--nographics][--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\|--nographics>
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	"nographics\|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	}
976
977	# Prepare the dest directory for archive
978	if (-x "$ENV{'PBROOTDIR'}/$pbpkg/pbinit") {
979	pb_filter_file("$ENV{'PBROOTDIR'}/$pbpkg/pbinit",$ptr,"$ENV{'PBTMP'}/pbinit",\%pb);
980	chmod 0755,"$ENV{'PBTMP'}/pbinit";
981	pb_system("cd $dest ; $ENV{'PBTMP'}/pbinit","Executing init script from $ENV{'PBROOTDIR'}/$pbpkg/pbinit","verbose");
982	}
983
984	# Do we have additional script to run to prepare the environement for the project ?
985	# Then include it in the pbconf delivery
986	foreach my $pbvf (<$ENV{'PBROOTDIR'}/pbv.pre>,<$ENV{'PBROOTDIR'}/pbv.post>, <$ENV{'PBROOTDIR'}/pbtest*>) {
987	if (-x "$pbvf") {
988	my $target = "$ENV{'PBDESTDIR'}/".basename($pbvf);
989	pb_filter_file("$pbvf",$ptr,$target,\%pb);
990	chmod 0755,"$target";
991	}
992	}
993
994	# Archive dest dir
995	chdir "$ENV{'PBDESTDIR'}" \|\| die "Unable to change dir to $ENV{'PBDESTDIR'}";
996	if (defined $preserve) {
997	# In that case we want to preserve the original tar file for checksum purposes
998	# The one created is btw equivalent in that case to this one
999	# Maybe check basename of both to be sure they are the same ?
1000	pb_log(0,"Preserving original tar file ");
1001	move("$preserve","$pbpkg-$pbver.tar.gz");
1002	} else {
1003	# Possibility to look at PBSRC to guess more the filename
1004	pb_system("tar cfz $pbpkg-$pbver.tar.gz --exclude=$pbpkg-$pbver/pbconf $pbpkg-$pbver","Creating $pbpkg tar files compressed");
1005	}
1006	pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz\n");
1007	pb_system("tar cfz $pbpkg-$pbver.pbconf.tar.gz $pbpkg-$pbver/pbconf","Creating pbconf tar files compressed");
1008	pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz\n");
1009
1010	# Keep track of version-tag per pkg
1011	$pkgs{$pbpkg} = "$pbver-$pbtag";
1012
1013	# Final cleanup
1014	pb_rm_rf($dest) if (-d $dest);
1015	}
1016
1017	# Keep track of per package version
1018	pb_log(2,"DEBUG pkgs: ".Dumper(%pkgs)."\n");
1019	open(PKG,"> $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb") \|\| die "Unable to create $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb";
1020	foreach my $pbpkg (keys %pkgs) {
1021	print PKG "pbpkg $pbpkg = $pkgs{$pbpkg}\n";
1022	}
1023	close(PKG);
1024
1025	# Keep track of what is generated by default
1026	# We need to store the dir and info on version-tag
1027	# Base our content on the existing .pb file
1028	copy("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb","$ENV{'PBDESTDIR'}/pbrc");
1029	open(LAST,">> $ENV{'PBDESTDIR'}/pbrc") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbrc";
1030	print LAST "pbroot $ENV{'PBPROJ'} = $ENV{'PBROOTDIR'}\n";
1031	print LAST "projver $ENV{'PBPROJ'} = $ENV{'PBPROJVER'}\n";
1032	print LAST "projtag $ENV{'PBPROJ'} = $ENV{'PBPROJTAG'}\n";
1033	print LAST "pbpackager $ENV{'PBPROJ'} = $ENV{'PBPACKAGER'}\n";
1034	close(LAST);
1035	}
1036
1037	sub pb_test2pkg {
1038	# Get the running distro to test on
1039	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins, $arch) = pb_distro_init();
1040	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $pbins, $arch))."\n");
1041
1042	# Get list of packages to test
1043	# Get content saved in cms2build
1044	my $ptr = pb_get_pkg();
1045	@pkgs = @$ptr;
1046
1047	# Additional potential repo
1048	pb_distro_setuprepo($ddir,$dver,$arch,$dtype,$dfam,$dos);
1049	foreach my $pbpkg (@pkgs) {
1050	# We need to install the package to test, and deps brought with it
1051	pb_distro_installdeps(undef,$dtype,$pbins,$pbpkg);
1052	pb_system("$ENV{'PBDESTDIR'}/pbtest","Launching test for $pbpkg","verbose");
1053	}
1054	}
1055
1056	sub pb_build2pkg {
1057
1058	# Get the running distro to build on
1059	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins, $arch) = pb_distro_init();
1060	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $pbins, $arch))."\n");
1061
1062	# If needed we may add repository to the build env
1063	pb_distro_setuprepo($ddir,$dver,$arch,$dtype,$dfam,$dos);
1064
1065	# Get list of packages to build
1066	my $ptr = pb_get_pkg();
1067	@pkgs = @$ptr;
1068
1069	# Get content saved in cms2build
1070	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1071	$pkg = { } if (not defined $pkg);
1072
1073	chdir "$ENV{'PBBUILDDIR'}";
1074	my $made = ""; # pkgs made during build
1075	my $pm = new Parallel::ForkManager($pbparallel) if (defined $pbparallel);
1076
1077	# We need to communicate info back from the children if parallel so prepare a dir for that
1078	my $tmpd = "$ENV{'PBTMP'}/build.$$";
1079	pb_mkdir_p($tmpd) if (defined $pbparallel);
1080
1081	foreach my $pbpkg (@pkgs) {
1082	$pm->start and next if (defined $pbparallel);
1083
1084	my $vertag = $pkg->{$pbpkg};
1085	# get the version of the current package - maybe different
1086	($pbver,$pbtag) = split(/-/,$vertag);
1087
1088	my $src="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz";
1089	my $src2="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
1090	pb_log(2,"Source file: $src\n");
1091	pb_log(2,"Pbconf file: $src2\n");
1092
1093	pb_log(2,"Working directory: $ENV{'PBBUILDDIR'}\n");
1094	if ($dtype eq "rpm") {
1095	foreach my $d ('RPMS','SRPMS','SPECS','SOURCES','BUILD') {
1096	if (! -d "$ENV{'PBBUILDDIR'}/$d") {
1097	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";
1098	}
1099	}
1100
1101	# Remove in case a previous link/file was there
1102	unlink "$ENV{'PBBUILDDIR'}/SOURCES/".basename($src);
1103	symlink "$src","$ENV{'PBBUILDDIR'}/SOURCES/".basename($src) \|\| die "Unable to symlink $src in $ENV{'PBBUILDDIR'}/SOURCES";
1104	# We need to first extract the spec file
1105	my @specfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/","$ENV{'PBBUILDDIR'}/SPECS","spec");
1106
1107	# We need to handle potential patches to upstream sources
1108	pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/pbpatch/","$ENV{'PBBUILDDIR'}/SOURCES","patch");
1109
1110	pb_log(2,"specfile: ".Dumper(\@specfile)."\n");
1111	# set LANGUAGE to check for correct log messages
1112	$ENV{'LANGUAGE'}="C";
1113	# Older Redhat use _target_platform in %configure incorrectly
1114	my $specialdef = "";
1115	if (($ddir eq "redhat") \|\| (($ddir eq "rhel") && ($dver eq "2.1"))) {
1116	$specialdef = "--define \'_target_platform \"\"\'";
1117	}
1118
1119	foreach my $f (@specfile) {
1120	if ($f =~ /\.spec$/) {
1121	# This could cause an issue in // mode
1122	pb_distro_installdeps($f,$dtype,$pbins);
1123	pb_system("rpmbuild $specialdef --define \"packager $ENV{'PBPACKAGER'}\" --define \"_topdir $ENV{'PBBUILDDIR'}\" -ba $f","Building package with $f under $ENV{'PBBUILDDIR'}","verbose");
1124	last;
1125	}
1126	}
1127	# Get the name of the generated packages
1128	open(LOG,"$ENV{'PBTMP'}/system.$$.log") \|\| die "Unable to open $ENV{'PBTMP'}/system.$$.log";
1129	while (<LOG>) {
1130	chomp($_);
1131	next if ($_ !~ /^Wrote:/);
1132	s\|./([S]RPMS.*)\|$1\|;
1133	$made .=" $_";
1134	}
1135	close(LOG);
1136
1137	} elsif ($dtype eq "deb") {
1138	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1139	pb_system("tar xfz $src","Extracting sources");
1140	pb_system("tar xfz $src2","Extracting pbconf");
1141
1142	chdir "$pbpkg-$pbver" \|\| die "Unable to chdir to $pbpkg-$pbver";
1143	pb_rm_rf("debian");
1144	symlink "pbconf/$ddir-$dver-$arch","debian" \|\| die "Unable to symlink to pbconf/$ddir-$dver-$arch";
1145	chmod 0755,"debian/rules";
1146
1147	pb_distro_installdeps("debian/control",$dtype,$pbins);
1148	pb_system("dpkg-buildpackage -us -uc -rfakeroot","Building package","verbose");
1149	# Get the name of the generated packages
1150	open(LOG,"$ENV{'PBTMP'}/system.$$.log") \|\| die "Unable to open $ENV{'PBTMP'}/system.$$.log";
1151	while (<LOG>) {
1152	chomp();
1153	my $tmp = $_;
1154	next if ($tmp !~ /^dpkg-deb.*:/);
1155	$tmp =~ s\|.../(.)_(.).deb.\|$1\|;
1156	$made="$made $tmp.dsc $tmp.tar.gz $tmp"."_.deb $tmp"."_.changes";
1157	}
1158	close(LOG);
1159	} elsif ($dtype eq "ebuild") {
1160	my @ebuildfile;
1161	# For gentoo we need to take pb as subsystem name
1162	# We put every apps here under sys-apps. hope it's correct
1163	# We use pb's home dir in order to have a single OVERLAY line
1164	my $tmpd = "$ENV{'HOME'}/portage/pb/sys-apps/$pbpkg";
1165	pb_mkdir_p($tmpd) if (! -d "$tmpd");
1166	pb_mkdir_p("$ENV{'HOME'}/portage/distfiles") if (! -d "$ENV{'HOME'}/portage/distfiles");
1167
1168	# We need to first extract the ebuild file
1169	@ebuildfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/","$tmpd","ebuild");
1170
1171	# Prepare the build env for gentoo
1172	my $found = 0;
1173	my $pbbd = $ENV{'HOME'};
1174	$pbbd =~ s\|/\|\\/\|g;
1175	if (-r "/etc/make.conf") {
1176	open(MAKE,"/etc/make.conf");
1177	while (<MAKE>) {
1178	$found = 1 if (/$pbbd\/portage/);
1179	}
1180	close(MAKE);
1181	}
1182	if ($found == 0) {
1183	pb_system("sudo sh -c 'echo PORTDIR_OVERLAY=\"$ENV{'HOME'}/portage\" >> /etc/make.conf'");
1184	}
1185	#$found = 0;
1186	#if (-r "/etc/portage/package.keywords") {
1187	#open(KEYW,"/etc/portage/package.keywords");
1188	#while (<KEYW>) {
1189	#$found = 1 if (/portage\/pb/);
1190	#}
1191	#close(KEYW);
1192	#}
1193	#if ($found == 0) {
1194	#pb_system("sudo sh -c \"echo portage/pb >> /etc/portage/package.keywords\"");
1195	#}
1196
1197	# Build
1198	foreach my $f (@ebuildfile) {
1199	if ($f =~ /\.ebuild$/) {
1200	pb_distro_installdeps($f,$dtype,$pbins);
1201	move($f,"$tmpd/$pbpkg-$pbver.ebuild");
1202	pb_system("cd $tmpd ; ebuild $pbpkg-$pbver.ebuild clean ; ebuild $pbpkg-$pbver.ebuild digest ; ebuild $pbpkg-$pbver.ebuild package","verbose");
1203	# Now move it where pb expects it
1204	pb_mkdir_p("$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
1205	move("$tmpd/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver-r$pbtag.ebuild");
1206	}
1207	}
1208
1209	$made="$made portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver-r$pbtag.ebuild";
1210	} elsif ($dtype eq "tgz") {
1211	# Slackware family
1212	$made="$made $pbpkg/$pbpkg-$pbver-*-$pbtag.tgz";
1213
1214	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1215	pb_system("tar xfz $src","Extracting sources");
1216	pb_system("tar xfz $src2","Extracting pbconf");
1217	chdir "$pbpkg-$pbver" \|\| die "Unable to chdir to $pbpkg-$pbver";
1218	symlink "pbconf/$ddir-$dver-$arch","install" \|\| die "Unable to symlink to pbconf/$ddir-$dver-$arch";
1219	if (-x "install/pbslack") {
1220	pb_distro_installdeps("./install/pbslack",$dtype,$pbins);
1221	pb_system("./install/pbslack","Building software");
1222	pb_system("sudo /sbin/makepkg -p -l y -c y $pbpkg","Packaging $pbpkg","verbose");
1223	}
1224	} elsif ($dtype eq "pkg") {
1225	# Solaris
1226	$made="$made $pbpkg-$pbver-$pbtag.pkg.gz";
1227	my $pkgdestdir="$ENV{'PBBUILDDIR'}/install";
1228
1229	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1230	# Will host resulting packages
1231	pb_mkdir_p("$dtype");
1232	pb_mkdir_p("$pkgdestdir/delivery");
1233	pb_system("tar xfz $src","Extracting sources under $ENV{'PBBUILDDIR'}");
1234	pb_system("tar xfz $src2","Extracting pbconf under $ENV{'PBBUILDDIR'}");
1235	chdir "$pbpkg-$pbver" \|\| die "Unable to chdir to $pbpkg-$pbver";
1236	if (-f "pbconf/$ddir-$dver-$arch/pbbuild") {
1237	chmod 0755,"pbconf/$ddir-$dver-$arch/pbbuild";
1238	# pkginfo file is mandatory
1239	die "Unable to find pkginfo file in pbconf/$ddir-$dver-$arch" if (! -f "pbconf/$ddir-$dver-$arch/pkginfo");
1240	# Build
1241	pb_system("pbconf/$ddir-$dver-$arch/pbbuild $pkgdestdir/delivery","Building software and installing under $pkgdestdir/delivery");
1242	# Copy complementary files
1243	if (-f "pbconf/$ddir-$dver-$arch/prototype") {
1244	copy("pbconf/$ddir-$dver-$arch/prototype", $pkgdestdir)
1245	} else {
1246	# No prototype provided, calculating it
1247	open(PROTO,"> $pkgdestdir/prototype") \|\| die "Unable to create prototype file";
1248	print PROTO "i pkginfo\n";
1249	print PROTO "i depend\n" if (-f "pbconf/$ddir-$dver-$arch/depend");
1250	$ENV{'PBSOLDESTDIR'} = "$pkgdestdir/delivery";
1251	find(\&create_solaris_prototype, "$pkgdestdir/delivery");
1252	}
1253	copy("pbconf/$ddir-$dver-$arch/depend", $pkgdestdir) if (-f "pbconf/$ddir-$dver-$arch/depend");
1254	copy("pbconf/$ddir-$dver-$arch/pkginfo", $pkgdestdir);
1255	pb_system("cd $pkgdestdir/delivery ; pkgmk -o -f ../prototype -r $pkgdestdir/delivery -d $ENV{'PBBUILDDIR'}/$dtype","Packaging $pbpkg","verbose");
1256	pb_system("cd $ENV{'PBBUILDDIR'}/$dtype ; echo \"\" \| pkgtrans -o -n -s $ENV{'PBBUILDDIR'}/$dtype $ENV{'PBBUILDDIR'}/$pbpkg-$pbver-$pbtag.pkg all","Transforming $pbpkg","verbose");
1257	pb_system("cd $ENV{'PBBUILDDIR'} ; gzip -9f $pbpkg-$pbver-$pbtag.pkg","Compressing $pbpkg-$pbver-$pbtag.pkg","verbose");
1258	} else {
1259	pb_log(0,"No pbconf/$ddir-$dver-$arch/pbbuild file found for $pbpkg-$pbver in \n");
1260	}
1261	chdir ".." \|\| die "Unable to chdir to parent dir";
1262	pb_system("rm -rf $pbpkg-$pbver $ENV{'PBBUILDDIR'}/$dtype $pkgdestdir", "Cleanup");
1263	} else {
1264	die "Unknown dtype format $dtype";
1265	}
1266	if (defined $pbparallel) {
1267	# Communicate results back to parent
1268	pb_set_content("$tmpd/$$",$made);
1269	$pm->finish;
1270	}
1271	}
1272	if (defined $pbparallel) {
1273	# In the parent, we need to get the result from the children
1274	$pm->wait_all_children;
1275	foreach my $f (<$tmpd/*>) {
1276	$made .= " ".pb_get_content($f);
1277	}
1278	pb_rm_rf($tmpd);
1279	}
1280
1281	# Find the appropriate check cmd/opts
1282	my ($oschkcmd,$oschkopt) = pb_conf_get_if("oschkcmd","oschkopt");
1283	my $chkcmd .= pb_distro_get_param($ddir,$dver,$arch,$oschkcmd,$dtype,$dfam,$dos);
1284	my $chkopt .= pb_distro_get_param($ddir,$dver,$arch,$oschkopt,$dtype,$dfam,$dos);
1285
1286	# Packages check if needed
1287	if ($dtype eq "rpm") {
1288	if (-x $chkcmd) {
1289	pb_system("$chkcmd $chkopt $made","Checking validity of rpms with $chkcmd","verbose");
1290	}
1291	my $rpms ="";
1292	my $srpms ="";
1293	foreach my $f (split(/ /,$made)) {
1294	$rpms .= "$ENV{'PBBUILDDIR'}/$f " if ($f =~ /^RPMS\//);
1295	$srpms .= "$ENV{'PBBUILDDIR'}/$f " if ($f =~ /^SRPMS\//);
1296	}
1297	pb_log(0,"SRPM packages generated: $srpms\n");
1298	pb_log(0,"RPM packages generated: $rpms\n");
1299	} elsif ($dtype eq "deb") {
1300	my $made2 = "";
1301	foreach my $f (split(/ /,$made)) {
1302	$made2 .= "../$f " if ($f =~ /\.changes$/);
1303	}
1304	if (-x $chkcmd) {
1305	pb_system("$chkcmd $chkopt $made2","Checking validity of debs with $chkcmd","verbose");
1306	} else {
1307	pb_log(0,"deb packages generated: $made2\n");
1308	}
1309	} else {
1310	pb_log(0,"No check done for $dtype yet\n");
1311	pb_log(0,"Packages generated: $made\n");
1312	}
1313
1314	# Keep track of what is generated so that we can get them back from VMs
1315	open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to create $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1316	print KEEP "$made\n";
1317	close(KEEP);
1318	}
1319
1320	sub create_solaris_prototype {
1321
1322	my $uidgid = "bin bin";
1323	my $pkgdestdir = $ENV{'PBSOLDESTDIR'};
1324
1325	return if ($_ =~ /^$pkgdestdir$/);
1326	if (-d $_) {
1327	my $n = $File::Find::name;
1328	$n =~ s~$pkgdestdir/~~;
1329	print PROTO "d none $n 0755 $uidgid\n";
1330	} elsif (-x $_) {
1331	my $n = $File::Find::name;
1332	$n =~ s~$pkgdestdir/~~;
1333	print PROTO "f none $n 0755 $uidgid\n";
1334	} elsif (-f $_) {
1335	my $n = $File::Find::name;
1336	$n =~ s~$pkgdestdir/~~;
1337	print PROTO "f none $n 0644 $uidgid\n";
1338	}
1339	}
1340
1341	sub pb_build2ssh {
1342	pb_send2target("Sources");
1343	}
1344
1345	sub pb_pkg2ssh {
1346	pb_send2target("Packages");
1347	}
1348
1349	# By default deliver to the the public site hosting the
1350	# ftp structure (or whatever) or a VM/VE
1351	sub pb_send2target {
1352
1353	my $cmt = shift;
1354	my $v = shift \|\| undef;
1355	my $vmexist = shift \|\| 0; # 0 is FALSE
1356	my $vmpid = shift \|\| 0; # 0 is FALSE
1357	my $snapme = shift \|\| 0; # 0 is FALSE
1358
1359	pb_log(2,"DEBUG: pb_send2target($cmt,".Dumper($v).",$vmexist,$vmpid)\n");
1360	my $host = "sshhost";
1361	my $login = "sshlogin";
1362	my $dir = "sshdir";
1363	my $port = "sshport";
1364	my $conf = "sshconf";
1365	my $tmout = undef;
1366	my $path = undef;
1367	if ($cmt =~ /^VM/) {
1368	$login = "vmlogin";
1369	$dir = "pbdefdir";
1370	# Specific VM
1371	$tmout = "vmtmout";
1372	$path = "vmpath";
1373	$host = "vmhost";
1374	$port = "vmport";
1375	} elsif ($cmt =~ /^VE/) {
1376	$login = "velogin";
1377	$dir = "pbdefdir";
1378	# Specific VE
1379	$path = "vepath";
1380	$conf = "rbsconf";
1381	} elsif ($cmt eq "Web") {
1382	$host = "websshhost";
1383	$login = "websshlogin";
1384	$dir = "websshdir";
1385	$port = "websshport";
1386	}
1387	my $cmd = "";
1388	my $src = "";
1389	my ($odir,$over,$oarch) = (undef, undef, undef);
1390	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins, $darch);
1391
1392	if ($cmt ne "Announce") {
1393	# Get list of packages to build
1394	my $ptr = pb_get_pkg();
1395	@pkgs = @$ptr;
1396
1397	# Get the running distro to consider
1398	if (defined $v) {
1399	($odir,$over,$oarch) = split(/-/,$v);
1400	}
1401	($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins, $darch) = pb_distro_init($odir,$over,$oarch);
1402	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $pbins, $darch))."\n");
1403
1404	# Get list of packages to build
1405	# Get content saved in cms2build
1406	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1407	$pkg = { } if (not defined $pkg);
1408
1409	chdir "$ENV{'PBBUILDDIR'}";
1410	foreach my $pbpkg (@pkgs) {
1411	my $vertag = $pkg->{$pbpkg};
1412	# get the version of the current package - maybe different
1413	($pbver,$pbtag) = split(/-/,$vertag);
1414
1415	if (($cmt eq "Sources") \|\| ($cmt =~ /V[EM]build/)) {
1416	$src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
1417	if ($cmd eq "") {
1418	$cmd = "ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
1419	} else {
1420	$cmd = "$cmd ; ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
1421	}
1422	} elsif ($cmt eq "Web") {
1423	$src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz"
1424	}
1425	}
1426	# Adds conf file for availability of conf elements
1427	pb_conf_add("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb");
1428	}
1429
1430	if ($cmt =~ /V[EM]build/) {
1431	$src="$src $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc $ENV{'PBDESTDIR'}/pbscript.$$";
1432	} elsif ($cmt =~ /V[EM]Script/) {
1433	$src="$src $ENV{'PBDESTDIR'}/pbscript.$$";
1434	} elsif ($cmt =~ /V[EM]test/) {
1435	$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";
1436	} elsif (($cmt eq "Announce") \|\| ($cmt eq "Web")) {
1437	$src="$src $ENV{'PBTMP'}/pbscript";
1438	} elsif ($cmt eq "Packages") {
1439	# Get package list from file made during build2pkg
1440	open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1441	$src = <KEEP>;
1442	chomp($src);
1443	close(KEEP);
1444	$src="$src $ENV{'PBBUILDDIR'}/pbscript";
1445	}
1446	# Remove potential leading spaces (cause problem with basename)
1447	$src =~ s/^ *//;
1448	my $basesrc = "";
1449	foreach my $i (split(/ +/,$src)) {
1450	$basesrc .= " ".basename($i);
1451	}
1452
1453	pb_log(0,"Sources handled ($cmt): $src\n");
1454	pb_log(2,"values: ".Dumper(($host,$login,$dir,$port,$tmout,$path,$conf))."\n");
1455	my ($sshhost,$sshlogin,$sshdir,$sshport) = pb_conf_get($host,$login,$dir,$port);
1456	# Not mandatory...
1457	my ($rbsconf,$testver,$delivery) = pb_conf_get_if($conf,"testver","delivery");
1458	$delivery->{$ENV{'PBPROJ'}} = "" if (not defined $delivery->{$ENV{'PBPROJ'}});
1459	my ($vtmout,$vepath);
1460	# ...Except those in virtual context
1461	if ($cmt =~ /^VE/) {
1462	($vepath) = pb_conf_get($path);
1463	}
1464	if ($cmt =~ /^VM/) {
1465	($vtmout) = pb_conf_get($tmout);
1466	}
1467	pb_log(2,"ssh: ".Dumper(($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vepath,$rbsconf))."\n");
1468
1469	my $mac;
1470	if ($cmt !~ /^VE/) {
1471	$mac = "$sshlogin->{$ENV{'PBPROJ'}}\@$sshhost->{$ENV{'PBPROJ'}}";
1472	# Overwrite account value if passed as parameter
1473	$mac = "$pbaccount\@$sshhost->{$ENV{'PBPROJ'}}" if (defined $pbaccount);
1474	pb_log(2, "DEBUG: pbaccount: $pbaccount => mac: $mac\n") if (defined $pbaccount);
1475	} else {
1476	# VE
1477	# Overwrite account value if passed as parameter (typically for setup2v)
1478	$mac = $sshlogin->{$ENV{'PBPROJ'}};
1479	$mac = $pbaccount if (defined $pbaccount);
1480	}
1481
1482	my $tdir;
1483	my $bdir;
1484	if (($cmt eq "Sources") \|\| ($cmt =~ /V[EM]Script/)) {
1485	$tdir = "$sshdir->{$ENV{'PBPROJ'}}/$delivery->{$ENV{'PBPROJ'}}/src";
1486	} elsif (($cmt =~ /V[EM]build/) \|\| ($cmt =~ /V[EM]test/)) {
1487	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/delivery";
1488	$bdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/build";
1489	# Remove a potential $ENV{'HOME'} as bdir should be relative to pb's home
1490	$bdir =~ s\|\$ENV.+\}/\|\|;
1491	} elsif ($cmt eq "Announce") {
1492	$tdir = "$sshdir->{$ENV{'PBPROJ'}}/$delivery->{$ENV{'PBPROJ'}}";
1493	} elsif ($cmt eq "Web") {
1494	$tdir = "$sshdir->{$ENV{'PBPROJ'}}/$delivery->{$ENV{'PBPROJ'}}";
1495	} elsif ($cmt eq "Packages") {
1496	$tdir = "$sshdir->{$ENV{'PBPROJ'}}/$delivery->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch";
1497
1498	my $repodir = $tdir;
1499	$repodir =~ s\|^$sshdir->{$ENV{'PBPROJ'}}/\|\|;
1500
1501	my ($pbrepo) = pb_conf_get("pbrepo");
1502
1503	# Repository management
1504	open(PBS,"> $ENV{'PBBUILDDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBBUILDDIR'}/pbscript";
1505	if ($dtype eq "rpm") {
1506	# Also make a pbscript to generate yum/urpmi bases
1507	print PBS << "EOF";
1508	#!/bin/bash
1509	# Prepare a script to ease yum setup
1510	cat > $ENV{'PBPROJ'}.repo << EOT
1511	[$ENV{'PBPROJ'}]
1512	name=$ddir $dver $darch - $ENV{'PBPROJ'} Vanilla Packages
1513	baseurl=$pbrepo->{$ENV{'PBPROJ'}}/$repodir
1514	enabled=1
1515	gpgcheck=0
1516	EOT
1517	chmod 644 $ENV{'PBPROJ'}.repo
1518
1519	# Clean up old repo content
1520	rm -rf headers/ repodata/
1521	# Create yum repo
1522	if [ -x /usr/bin/yum-arch ]; then
1523	yum-arch .
1524	fi
1525	# Create repodata
1526	createrepo .
1527	EOF
1528	if ($dfam eq "md") {
1529	# For Mandriva add urpmi management
1530	print PBS << "EOF";
1531	# Prepare a script to ease urpmi setup
1532	cat > $ENV{'PBPROJ'}.addmedia << EOT
1533	urpmi.addmedia $ENV{'PBPROJ'} $pbrepo->{$ENV{'PBPROJ'}}/$repodir with media_info/hdlist.cz
1534	EOT
1535	chmod 755 $ENV{'PBPROJ'}.addmedia
1536
1537	# Clean up old repo content
1538	rm -f hdlist.cz synthesis.hdlist.cz
1539	# Create urpmi repo
1540	genhdlist2 --clean .
1541	if [ \$\? -ne 0 ]; then
1542	genhdlist .
1543	fi
1544	EOF
1545	}
1546	if ($ddir eq "fedora") {
1547	# Extract the spec file to please Fedora maintainers :-(
1548	print PBS << "EOF";
1549	for p in $basesrc; do
1550	echo \$p \| grep -q 'src.rpm'
1551	if [ \$\? -eq 0 ]; then
1552	rpm2cpio \$p \| cpio -ivdum --quiet '*.spec'
1553	fi
1554	done
1555	EOF
1556	}
1557	if ($dfam eq "novell") {
1558	# Add ymp scripts for one-click install on SuSE
1559	print PBS << "EOF";
1560	# Prepare a script to ease SuSE one-click install
1561	# Cf: http://de.opensuse.org/1-Klick-Installation/ISV
1562	#
1563	cat > $ENV{'PBPROJ'}.ymp << EOT
1564	<?xml version="1.0" encoding="utf-8"?>
1565	<!-- vim: set sw=2 ts=2 ai et: -->
1566	<metapackage xmlns:os="http://opensuse.org/Standards/One_Click_Install" xmlns="http://opensuse.org/Standards/One_Click_Install">
1567	<group><!-- The group of software, typically one for project-builder.org -->
1568	<name>$ENV{'PBPROJ'} Bundle</name> <!-- Name of the software group -->
1569	<summary>Software bundle for the $ENV{'PBPROJ'} project</summary> <!--This message is shown to the user and should describe the whole bundle -->
1570	<description>This is the summary of the $ENV{'PBPROJ'} Project
1571
1572	Details are available on a per package basis below
1573
1574	</description><!--This is also shown to the user -->
1575	<remainSubscribed>false</remainSubscribed> <!-- Don't know what it mean -->
1576	<repositories><!-- List of needed repositories -->
1577	<repository>
1578	<name>$ENV{'PBPROJ'} Repository</name> <!-- Name of the repository -->
1579	<summary>This repository contains the $ENV{'PBPROJ'} project packages.</summary> <!-- Summary of the repository -->
1580	<description>This repository contains the $ENV{'PBPROJ'} project packages.</description><!-- This description is shown to the user -->
1581	<url>$pbrepo->{$ENV{'PBPROJ'}}/$repodir</url><!--URL of repository, which is added -->
1582	</repository>
1583	</repositories>
1584	<software><!-- A List of packages, which should be added through the one-click-installation -->
1585	EOT
1586	for p in $basesrc; do
1587	sum=`rpm -q --qf '%{SUMMARY}' \$p`
1588	name=`rpm -q --qf '%{NAME}' \$p`
1589	desc=`rpm -q --qf '%{description}' \$p`
1590	cat >> $ENV{'PBPROJ'}.ymp << EOT
1591	<item>
1592	<name>\$name</name><!-- Name of the package, is shown to the user and used to identify the package at the repository -->
1593	<summary>\$sum</summary> <!-- Summary of the package -->
1594	<description>\$desc</description> <!-- Description, is shown to the user -->
1595	</item>
1596	EOT
1597	done
1598	cat >> $ENV{'PBPROJ'}.ymp << EOT
1599	</software>
1600	</group>
1601	</metapackage>
1602	EOT
1603	chmod 644 $ENV{'PBPROJ'}.ymp
1604	EOF
1605	}
1606	} elsif ($dtype eq "deb") {
1607	# Also make a pbscript to generate apt bases
1608	# Cf: http://www.debian.org/doc/manuals/repository-howto/repository-howto.fr.html
1609	# This dirname removes arch
1610	my $rpd = dirname("$pbrepo->{$ENV{'PBPROJ'}}/$repodir");
1611	# this one removes the ver
1612	$rpd = dirname($rpd);
1613	print PBS << "EOF";
1614	#!/bin/bash
1615	# Prepare a script to ease apt setup
1616	cat > $ENV{'PBPROJ'}.sources.list << EOT
1617	deb $rpd $dver contrib
1618	deb-src $rpd $dver contrib
1619	EOT
1620	chmod 644 $ENV{'PBPROJ'}.sources.list
1621
1622	# Up two levels to deal with the dist dir cross versions
1623	cd ../..
1624	mkdir -p dists/$dver/contrib/binary-$darch dists/$dver/contrib/source
1625
1626	# Prepare a script to create apt info file
1627	TMPD=`mktemp -d /tmp/pb.XXXXXXXXXX` \|\| exit 1
1628	mkdir -p \$TMPD
1629	cat > \$TMPD/Release << EOT
1630	Archive: unstable
1631	Component: contrib
1632	Origin: $ENV{'PBPROJ'}
1633	Label: $ENV{'PBPROJ'} dev repository $pbrepo->{$ENV{'PBPROJ'}}
1634	EOT
1635
1636	echo "Creating Packages metadata ($darch)"
1637	dpkg-scanpackages -a$darch $dver/$darch /dev/null \| gzip -c9 > dists/$dver/contrib/binary-$darch/Packages.gz
1638	dpkg-scanpackages -a$darch $dver/$darch /dev/null \| bzip2 -c9 > dists/$dver/contrib/binary-$darch/Packages.bz2
1639	echo "Creating Contents metadata ($darch)"
1640	apt-ftparchive contents $dver \| gzip -c9 > dists/$dver/Contents-$darch.gz
1641	echo "Creating Release metadata ($darch)"
1642	cat \$TMPD/Release > dists/$dver/contrib/binary-$darch/Release
1643	echo "Architecture: $darch" >> dists/$dver/contrib/binary-$darch/Release
1644	echo "Creating Source metadata"
1645	dpkg-scansources $dver/$darch /dev/null \| gzip -c9 > dists/$dver/contrib/source/Sources.gz
1646	cat \$TMPD/Release > dists/$dver/contrib/source/Release
1647	echo "Architecture: Source" >> dists/$dver/contrib/source/Release
1648	echo "Creating Release metadata"
1649	apt-ftparchive release dists/$dver > dists/$dver/Release
1650	rm -rf \$TMPD
1651	EOF
1652	} elsif ($dtype eq "ebuild") {
1653	# make a pbscript to generate links to latest version
1654	print PBS << "EOF";
1655	#!/bin/bash
1656	# Prepare a script to create correct links
1657	for p in $src; do
1658	echo \$p \| grep -q '.ebuild'
1659	if [ \$\? -eq 0 ]; then
1660	j=`basename \$p`
1661	pp=`echo \$j \| cut -d'-' -f1`
1662	ln -sf \$j \$pp.ebuild
1663	fi
1664	done
1665	EOF
1666	}
1667	close(PBS);
1668	chmod 0755,"$ENV{'PBBUILDDIR'}/pbscript";
1669	} else {
1670	return;
1671	}
1672
1673	# Useless for VE
1674	my $nport = pb_get_port($sshport->{$ENV{'PBPROJ'}},$cmt) if ($cmt !~ /^VE/);
1675
1676	# Remove a potential $ENV{'HOME'} as tdir should be relative to pb's home
1677	$tdir =~ s\|\$ENV.+\}/\|\|;
1678
1679	my $tm = undef;
1680	if ($cmt =~ /^VM/) {
1681	$tm = $vtmout->{$ENV{'PBPROJ'}};
1682	}
1683
1684	# ssh communication if not VE
1685	# should use a hash instead...
1686	my ($shcmd,$cpcmd,$cptarget,$cp2target);
1687	if ($cmt !~ /^VE/) {
1688	my $keyfile = pb_ssh_get(0);
1689	$shcmd = "ssh -i $keyfile -q -o UserKnownHostsFile=/dev/null -p $nport $mac";
1690	$cpcmd = "scp -i $keyfile -p -o UserKnownHostsFile=/dev/null -P $nport";
1691	$cptarget = "$mac:$tdir";
1692	if ($cmt =~ /^VMbuild/) {
1693	$cp2target = "$mac:$bdir";
1694	}
1695	} else {
1696	my $tp = $vepath->{$ENV{'PBPROJ'}};
1697	($odir,$over,$oarch) = split(/-/,$v);
1698	my $tpdir = "$tp/$odir/$over/$oarch";
1699	my ($ptr) = pb_conf_get("vetype");
1700	my $vetype = $ptr->{$ENV{'PBPROJ'}};
1701	if ($vetype eq "chroot") {
1702	$shcmd = "sudo chroot $tpdir /bin/su - $mac -c ";
1703	} elsif ($vetype eq "schroot") {
1704	$shcmd = "schroot $tp -u $mac -- ";
1705	}
1706	$cpcmd = "sudo cp -r ";
1707	# We need to get the home dir of the target account to deliver in the right place
1708	open(PASS,"$tpdir/etc/passwd") \|\| die "Unable to open $tpdir/etc/passwd";
1709	my $homedir = "";
1710	while (<PASS>) {
1711	my ($c1,$c2,$c3,$c4,$c5,$c6,$c7) = split(/:/);
1712	$homedir = $c6 if ($c1 =~ /^$mac$/);
1713	pb_log(3,"Homedir: $homedir - account: $c6\n");
1714	}
1715	close(PASS);
1716	$cptarget = "$tpdir/$homedir/$tdir";
1717	if ($cmt eq "VEbuild") {
1718	$cp2target = "$tpdir/$homedir/$bdir";
1719	}
1720	pb_log(2,"On VE using $cptarget as target dir to copy to\n");
1721	}
1722
1723	my $logres = "";
1724	# Do not touch when just announcing
1725	if ($cmt ne "Announce") {
1726	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");
1727	} else {
1728	$logres = "> ";
1729	}
1730	pb_system("cd $ENV{'PBBUILDDIR'} ; $cpcmd $src $cptarget 2> /dev/null","$cmt delivery in $cptarget");
1731
1732	# For VE we need to change the owner manually
1733	if ($cmt =~ /^VE/) {
1734	pb_system("$shcmd \"sudo chown -R $mac $tdir\"","Adapt owner in $tdir to $mac");
1735	}
1736
1737	# Use the right script name depending on context
1738	my $pbscript;
1739	if ($cmt =~ /^V[EM]/) {
1740	$pbscript = "pbscript.$$";
1741	} else {
1742	$pbscript = "pbscript";
1743	}
1744
1745	pb_system("$shcmd \"echo \'cd $tdir ; if [ -x $pbscript ]; then ./$pbscript; fi ; rm -f ./$pbscript\' \| bash\"","Executing pbscript on $cptarget if needed","verbose");
1746	if ($cmt =~ /^V[EM]build/) {
1747	# Get back info on pkg produced, compute their name and get them from the VM
1748	pb_system("$cpcmd $cp2target/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'} $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$ 2> /dev/null","Get package names in $cp2target");
1749	# For VE we need to change the owner manually
1750	if ($cmt eq "VEbuild") {
1751	pb_system("sudo chown $UID $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$","Adapt owner in $tdir to $UID");
1752	}
1753	# return here to avoid breaking the load on VMs/VEs in case of a bad one
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	return;
1757	}
1758	open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$") \|\| die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$";
1759	my $src = <KEEP>;
1760	chomp($src);
1761	close(KEEP);
1762	unlink("$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$");
1763
1764	$src =~ s/^ *//;
1765	pb_mkdir_p("$ENV{'PBBUILDDIR'}/$odir/$over");
1766	# Change pgben to make the next send2target happy
1767	my $made = "";
1768
1769	# For VM we don't want shell expansion to hapen locally but remotely
1770	my $delim = '\'';
1771	if ($cmt =~ /^VEbuild/) {
1772	# For VE we need to support shell expansion locally
1773	$delim = "";
1774	}
1775
1776	open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to write $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1777	foreach my $p (split(/ +/,$src)) {
1778	my $j = basename($p);
1779	pb_system("$cpcmd $cp2target/$delim$p$delim $ENV{'PBBUILDDIR'}/$odir/$over 2> /dev/null","Recovery of package $j in $ENV{'PBBUILDDIR'}/$odir/$over");
1780	$made="$made $odir/$over/$j"; # if (($dtype ne "rpm") \|\| ($j !~ /.src.rpm$/));
1781	}
1782	print KEEP "$made\n";
1783	close(KEEP);
1784	pb_system("$shcmd \"rm -rf $tdir $bdir\"","$cmt cleanup");
1785
1786	# Sign packages locally
1787	if ($dtype eq "rpm") {
1788	#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");
1789	} elsif ($dtype eq "deb") {
1790	#pb_system("debsign $made","Signing DEB packages");
1791	} else {
1792	pb_log(0,"I don't know yet how to sign packages for type $dtype.\nPlease give feedback to dev team\n");
1793	}
1794
1795	# We want to send them to the ssh account so overwrite what has been done before
1796	undef $pbaccount;
1797	pb_log(2,"Before sending pkgs, vmexist: $vmexist, vmpid: $vmpid\n");
1798	pb_send2target("Packages",$odir."-".$over."-".$oarch,$vmexist,$vmpid);
1799	pb_rm_rf("$ENV{'PBBUILDDIR'}/$odir");
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'} = "--nographics";
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	}
2029	pb_system("$cmd &","Launching the VM $vmm");
2030	# Using system allows to kill it externaly if needed
2031	pb_system("sleep $ENV{'PBVMTMOUT'}","Waiting $ENV{'PBVMTMOUT'} s for VM $v to come up");
2032	$vmpid = pb_check_ps($tmpcmd,$vmm);
2033	pb_log(0,"VM $vmm launched (pid $vmpid)\n");
2034	}
2035	} else {
2036	pb_log(0,"Found an existing VM $vmm (pid $vmexist)\n");
2037	}
2038	pb_log(2,"DEBUG: pb_launchv returns ($vmexist,$vmpid)\n");
2039	return($vmexist,$vmpid);
2040	# VE here
2041	} else {
2042	# Get distro context
2043	my ($name,$ver,$darch) = split(/-/,$v);
2044	chomp($darch);
2045	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf) = pb_distro_init($name,$ver,$darch);
2046
2047	# Get VE context
2048	my ($ptr,$vepath) = pb_conf_get("vetype","vepath");
2049	my $vetype = $ptr->{$ENV{'PBPROJ'}};
2050
2051	# We can probably only get those params now we have the distro context
2052	my ($rbsb4pi,$rbspi,$vesnap,$oscodename,$osmindep,$verebuild,$rbsmirrorsrv) = pb_conf_get_if("rbsb4pi","rbspi","vesnap","oscodename","osmindep","verebuild","rbsmirrorsrv");
2053
2054	# We need to avoid umask propagation to the VE
2055	umask 0022;
2056
2057	if (($vetype eq "chroot") \|\| ($vetype eq "schroot")) {
2058	# Architecture consistency
2059	if ($arch ne $darch) {
2060	die "Unable to launch a VE of architecture $darch on a $arch platform" if (($darch eq "x86_64") && ($arch =~ /i?86/));
2061	}
2062
2063	my ($verpmtype,$vedebtype) = pb_conf_get("verpmtype","vedebtype");
2064	if (($create != 0) \|\| ((defined $verebuild) && ($verebuild->{$ENV{'PBPROJ'}} =~ /true/i)) \|\| ($pbforce == 1)) {
2065	my ($rbsopt1) = pb_conf_get_if("rbsopt");
2066
2067	# We have to rebuild the chroot
2068	if ($dtype eq "rpm") {
2069
2070	# Which tool is used
2071	my $verpmstyle = $verpmtype->{$ENV{'PBPROJ'}};
2072
2073	# Get potential rbs option
2074	my $rbsopt = "";
2075	if (defined $rbsopt1) {
2076	if (defined $rbsopt1->{$verpmstyle}) {
2077	$rbsopt = $rbsopt1->{$verpmstyle};
2078	} elsif (defined $rbsopt1->{$ENV{'PBPROJ'}}) {
2079	$rbsopt = $rbsopt1->{$ENV{'PBPROJ'}};
2080	} else {
2081	$rbsopt = "";
2082	}
2083	}
2084
2085	my $postinstall = pb_get_postinstall($ddir,$dver,$darch,$rbspi,$verpmstyle);
2086	if ($verpmstyle eq "rinse") {
2087	# Need to reshape the mirrors generated with local before-post-install script
2088	my $b4post = "--before-post-install ";
2089	my $postparam = pb_distro_get_param($ddir,$dver,$darch,$rbsb4pi);
2090	if ($postparam eq "") {
2091	$b4post = "";
2092	} else {
2093	$b4post .= $postparam;
2094	}
2095
2096	# Need to reshape the package list for pb
2097	my $addpkgs;
2098	$postparam = "";
2099	$postparam .= pb_distro_get_param($ddir,$dver,$darch,$osmindep);
2100	if ($postparam eq "") {
2101	$addpkgs = "";
2102	} else {
2103	my $pkgfile = "$ENV{'PBTMP'}/addpkgs.lis";
2104	open(PKG,"> $pkgfile") \|\| die "Unable to create $pkgfile";
2105	foreach my $p (split(/,/,$postparam)) {
2106	print PKG "$p\n";
2107	}
2108	close(PKG);
2109	$addpkgs = "--add-pkg-list $pkgfile";
2110	}
2111
2112	my $rinseverb = "";
2113	$rinseverb = "--verbose" if ($pbdebug gt 0);
2114	my ($rbsconf) = pb_conf_get("rbsconf");
2115
2116	my $command = pb_check_req("rinse",0);
2117	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");
2118	} elsif ($verpmstyle eq "rpmbootstrap") {
2119	my $rbsverb = "";
2120	foreach my $i (1..$pbdebug) {
2121	$rbsverb .= " -v";
2122	}
2123	my $addpkgs = "";
2124	my $postparam = "";
2125	$postparam .= pb_distro_get_param($ddir,$dver,$darch,$osmindep);
2126	if ($postparam eq "") {
2127	$addpkgs = "";
2128	} else {
2129	$addpkgs = "-a $postparam";
2130	}
2131	my $command = pb_check_req("rpmbootstrap",0);
2132	pb_system("sudo $command $rbsopt $postinstall $addpkgs $ddir-$dver-$darch $rbsverb","Creating the rpmbootstrap VE for $ddir-$dver ($darch)", "verbose");
2133	} elsif ($verpmstyle eq "mock") {
2134	my ($rbsconf) = pb_conf_get("rbsconf");
2135	my $command = pb_check_req("mock",0);
2136	pb_system("sudo $command --init --resultdir=\"/tmp\" --configdir=\"$rbsconf->{$ENV{'PBPROJ'}}\" -r $v $rbsopt","Creating the mock VE for $ddir-$dver ($darch)");
2137	# Once setup we need to install some packages, the pb account, ...
2138	pb_system("sudo $command --install --configdir=\"$rbsconf->{$ENV{'PBPROJ'}}\" -r $v su","Configuring the mock VE");
2139	} else {
2140	die "Unknown verpmtype type $verpmstyle. Report to dev team";
2141	}
2142	} elsif ($dtype eq "deb") {
2143	my $vedebstyle = $vedebtype->{$ENV{'PBPROJ'}};
2144
2145	my $codename = pb_distro_get_param($ddir,$dver,$darch,$oscodename);
2146	my $postparam = "";
2147	my $addpkgs;
2148	$postparam .= pb_distro_get_param($ddir,$dver,$darch,$osmindep);
2149	if ($postparam eq "") {
2150	$addpkgs = "";
2151	} else {
2152	$addpkgs = "--include $postparam";
2153	}
2154	my $debmir = "";
2155	$debmir .= pb_distro_get_param($ddir,$dver,$darch,$rbsmirrorsrv);
2156
2157	# Get potential rbs option
2158	my $rbsopt = "";
2159	if (defined $rbsopt1) {
2160	if (defined $rbsopt1->{$vedebstyle}) {
2161	$rbsopt = $rbsopt1->{$vedebstyle};
2162	} elsif (defined $rbsopt1->{$ENV{'PBPROJ'}}) {
2163	$rbsopt = $rbsopt1->{$ENV{'PBPROJ'}};
2164	} else {
2165	$rbsopt = "";
2166	}
2167	}
2168
2169	# debootstrap works with amd64 not x86_64
2170	my $debarch = $darch;
2171	$debarch = "amd64" if ($darch eq "x86_64");
2172	if ($vedebstyle eq "debootstrap") {
2173	my $dbsverb = "";
2174	$dbsverb = "--verbose" if ($pbdebug gt 0);
2175
2176	# Some perl modules are in Universe on Ubuntu
2177	$rbsopt .= " --components=main,universe" if ($ddir eq "ubuntu");
2178
2179	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");
2180	# debootstrap doesn't create an /etc/hosts file
2181	if (! -f "$vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch/etc/hosts" ) {
2182	pb_system("sudo cp /etc/hosts $vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch/etc/hosts");
2183	}
2184	} else {
2185	die "Unknown vedebtype type $vedebstyle. Report to dev team";
2186	}
2187	} elsif ($dtype eq "ebuild") {
2188	die "Please teach the dev team how to build gentoo chroot";
2189	} else {
2190	die "Unknown distribution type $dtype. Report to dev team";
2191	}
2192	}
2193	# Fix modes to allow access to the VE for pb user
2194	pb_system("sudo chmod 755 $vepath->{$ENV{'PBPROJ'}}/$ddir $vepath->{$ENV{'PBPROJ'}}/$ddir/$dver $vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch","Fixing permissions");
2195
2196	# Test if an existing snapshot exists and use it if appropriate
2197	# And also use it of no local extracted VE is present
2198	if ((-f "$vepath->{$ENV{'PBPROJ'}}/$ddir-$dver-$darch.tar.gz") &&
2199	(((defined $vesnap->{$v}) && ($vesnap->{$v} =~ /true/i)) \|\|
2200	((defined $vesnap->{$ENV{'PBPROJ'}}) && ($vesnap->{$ENV{'PBPROJ'}} =~ /true/i)) \|\|
2201	($pbsnap eq 1) \|\|
2202	(! -d "$vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch"))) {
2203	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");
2204	}
2205	# Nothing more to do for VE. No real launch
2206	} else {
2207	die "VE of type $vetype not supported. Report to the dev team";
2208	}
2209	}
2210	}
2211
2212	# Return string for date synchro
2213	sub pb_date2v {
2214
2215	my $vtype = shift;
2216	my $v = shift;
2217
2218	my ($ntp) = pb_conf_get_if($vtype."ntp");
2219	my $vntp = $ntp->{$ENV{'PBPROJ'}} if (defined $ntp);
2220	my $ntpline;
2221
2222	if (defined $vntp) {
2223	my ($ntpcmd) = pb_conf_get($vtype."ntpcmd");
2224	my $vntpcmd;
2225	if (defined $ntpcmd->{$v}) {
2226	$vntpcmd = $ntpcmd->{$v};
2227	} elsif (defined $ntpcmd->{$ENV{'PBPROJ'}}) {
2228	$vntpcmd = $ntpcmd->{$ENV{'PBPROJ'}};
2229	} else {
2230	$vntpcmd = "/bin/true";
2231	}
2232	$ntpline = "sudo $vntpcmd $vntp";
2233	} else {
2234	$ntpline = undef;
2235	}
2236	# Force new date to be in the future compared to the date
2237	# of the host by adding 1 minute
2238	my @date=pb_get_date();
2239	$date[1]++;
2240	my $upddate = strftime("%m%d%H%M%Y", @date);
2241	my $dateline = "sudo date $upddate";
2242	return($ntpline,$dateline);
2243	}
2244
2245	sub pb_build2v {
2246
2247	my $vtype = shift;
2248	my $action = shift \|\| "build";
2249
2250	my ($v,$all) = pb_get2v($vtype);
2251
2252	# Send tar files when we do a global generation
2253	pb_build2ssh() if (($all == 1) && ($action eq "build"));
2254
2255	# Adapt // mode to memory size
2256	$pbparallel = pb_set_parallel($vtype);
2257
2258	my ($vmexist,$vmpid) = (undef,undef);
2259	my $pm = new Parallel::ForkManager($pbparallel) if (defined $pbparallel);
2260
2261	# Set which port the VM will use to communicate
2262	$pm->run_on_start(\&pb_set_port);
2263
2264	my $counter = 0;
2265	foreach my $v (@$v) {
2266	$counter++;
2267	# Modulo 2 * pbparallel (to avoid synchronization problems)
2268	$counter = 1 if ($counter > 2 * $pbparallel);
2269	$pm->start($counter) and next if (defined $pbparallel);
2270	# Prepare the script to be executed on the VM/VE
2271	# in $ENV{'PBDESTDIR'}/pbscript.$$
2272	open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript.$$") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript.$$";
2273	print SCRIPT "#!/bin/bash\n";
2274
2275	# Transmit the verbosity level to the virtual env/mach.
2276	my $verbose = "";
2277	my $i = 0; # minimal debug level
2278	while ($i lt $pbdebug) {
2279	$verbose .= "-v ";
2280	$i++;
2281	}
2282	# Activate script verbosity if at least 2 for pbdebug
2283	print SCRIPT "set -x\n" if ($i gt 1);
2284	# Quiet if asked to be so on the original system
2285	$verbose = "-q" if ($pbdebug eq -1);
2286
2287	print SCRIPT "echo ... Execution needed\n";
2288	print SCRIPT "# This is in directory delivery\n";
2289	print SCRIPT "# Setup the variables required for building\n";
2290	print SCRIPT "export PBPROJ=$ENV{'PBPROJ'}\n";
2291
2292	if ($action eq "build") {
2293	print SCRIPT "# Preparation for pb\n";
2294	print SCRIPT "mv .pbrc \$HOME\n";
2295	print SCRIPT "cd ..\n";
2296	}
2297
2298	# VE needs a good /proc
2299	if ($vtype eq "ve") {
2300	print SCRIPT "sudo mount -t proc /proc /proc\n";
2301	}
2302
2303	my ($ntpline,$dateline) = pb_date2v($vtype,$v);
2304	print SCRIPT "# Time sync\n";
2305	print SCRIPT "echo 'setting up date with '";
2306	if (defined $ntpline) {
2307	print SCRIPT "echo $ntpline\n";
2308	print SCRIPT "$ntpline\n";
2309	} else {
2310	print SCRIPT "echo $dateline\n";
2311	print SCRIPT "$dateline\n";
2312	}
2313	# Use potential local proxy declaration in case we need it to download repo, pkgs, ...
2314	if (defined $ENV{'http_proxy'}) {
2315	print SCRIPT "export http_proxy=\"$ENV{'http_proxy'}\"\n";
2316	}
2317
2318	if (defined $ENV{'ftp_proxy'}) {
2319	print SCRIPT "export ftp_proxy=\"$ENV{'ftp_proxy'}\"\n";
2320	}
2321
2322	# Get list of packages to build/test and get some ENV vars as well
2323	my $ptr = pb_get_pkg();
2324	@pkgs = @$ptr;
2325	my $p = join(' ',@pkgs) if (@pkgs);
2326	print SCRIPT "export PBPROJVER=$ENV{'PBPROJVER'}\n";
2327	print SCRIPT "export PBPROJTAG=$ENV{'PBPROJTAG'}\n";
2328	print SCRIPT "export PBPACKAGER=\"$ENV{'PBPACKAGER'}\"\n";
2329
2330	# We may need to do some other tasks before building. Read a script here to finish setup
2331	if (-x "$ENV{'PBDESTDIR'}/pb$vtype".".pre") {
2332	print SCRIPT "# Special pre-instructions to be launched\n";
2333	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype".".pre");
2334	}
2335
2336	if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."$action.pre") {
2337	print SCRIPT "# Special pre-$action instructions to be launched\n";
2338	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."$action.pre");
2339	}
2340
2341	print SCRIPT "# $action\n";
2342	print SCRIPT "echo $action"."ing packages on $vtype...\n";
2343
2344	if (($action eq "test") && (! -x "$ENV{'PBDESTDIR'}/pbtest")) {
2345	die "No test script ($ENV{'PBDESTDIR'}/pbtest) found when in test mode. Aborting ...";
2346	}
2347	print SCRIPT "pb $verbose -p $ENV{'PBPROJ'} $action"."2pkg $p\n";
2348
2349	if ($vtype eq "ve") {
2350	print SCRIPT "sudo umount /proc\n";
2351	}
2352
2353	# We may need to do some other tasks after building. Read a script here to exit properly
2354	if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."$action.post") {
2355	print SCRIPT "# Special post-$action instructions to be launched\n";
2356	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."$action.post");
2357	}
2358
2359	if (-x "$ENV{'PBDESTDIR'}/pb$vtype".".post") {
2360	print SCRIPT "# Special post-instructions to be launched\n";
2361	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype".".post");
2362	}
2363
2364	close(SCRIPT);
2365	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript.$$";
2366
2367	# Launch the VM/VE
2368	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
2369
2370
2371	if ($vtype eq "vm") {
2372	# Skip that VM if something went wrong
2373	if (($vmpid == 0) && ($vmexist == 0)) {
2374	$pm->finish if (defined $pbparallel);
2375	next;
2376	}
2377	} else {
2378	# VE
2379	$vmexist = 0;
2380	$vmpid = 0;
2381	}
2382	# Gather all required files to send them to the VM/VE
2383	# and launch the build through pbscript
2384	pb_log(2,"Calling send2target $vtype,$v,$vmexist,$vmpid\n");
2385	pb_send2target(uc($vtype).$action,"$v",$vmexist,$vmpid);
2386	$pm->finish if (defined $pbparallel);
2387	}
2388	if (defined $pbparallel) {
2389	$pm->wait_all_children;
2390	}
2391	}
2392
2393
2394	sub pb_clean {
2395
2396	my $sleep=10;
2397	die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
2398	die "Unable to get env var PBBUILDDIR" if (not defined $ENV{'PBBUILDDIR'});
2399	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");
2400	sleep $sleep;
2401	pb_rm_rf($ENV{'PBDESTDIR'});
2402	pb_rm_rf($ENV{'PBBUILDDIR'});
2403	}
2404
2405	sub pb_newver {
2406
2407	die "-V Version parameter needed" if ((not defined $newver) \|\| ($newver eq ""));
2408
2409	# Need this call for PBDIR
2410	my ($scheme2,$uri) = pb_cms_init($pbinit);
2411
2412	my ($pbconf,$pburl) = pb_conf_get("pbconfurl","pburl");
2413	$uri = $pbconf->{$ENV{'PBPROJ'}};
2414	my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);
2415
2416	# Checking CMS repositories status
2417	($scheme2, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}});
2418
2419	if ($scheme !~ /^svn/) {
2420	die "Only SVN is supported at the moment";
2421	}
2422
2423	my $res = pb_cms_isdiff($scheme,$ENV{'PBROOTDIR'});
2424	die "ERROR: No differences accepted in CMS for $ENV{'PBROOTDIR'} before creating a new version" if ($res != 0);
2425
2426	$res = pb_cms_isdiff($scheme2,$ENV{'PBDIR'});
2427	die "ERROR: No differences accepted in CMS for $ENV{'PBDIR'} before creating a new version" if ($res != 0);
2428
2429	# Tree identical between PBCONFDIR and PBROOTDIR. The delta is what
2430	# we want to get for the root of the new URL
2431
2432	my $tmp = $ENV{'PBROOTDIR'};
2433	$tmp =~ s\|^$ENV{'PBCONFDIR'}\|\|;
2434
2435	my $newurl = "$uri/".dirname($tmp)."/$newver";
2436	# Should probably use projver in the old file
2437	my $oldver= basename($tmp);
2438
2439	# Duplicate and extract project-builder part
2440	pb_log(2,"Copying $uri/$tmp to $newurl\n");
2441	pb_cms_copy($scheme,"$uri/$tmp",$newurl);
2442	pb_log(2,"Checkout $newurl to $ENV{'PBROOTDIR'}/../$newver\n");
2443	pb_cms_up($scheme,"$ENV{'PBCONFDIR'}/..");
2444
2445	# Duplicate and extract project
2446	my $newurl2 = "$pburl->{$ENV{'PBPROJ'}}/".dirname($tmp)."/$newver";
2447
2448	pb_log(2,"Copying $pburl->{$ENV{'PBPROJ'}}/$tmp to $newurl2\n");
2449	pb_cms_copy($scheme2,"$pburl->{$ENV{'PBPROJ'}}/$tmp",$newurl2);
2450	pb_log(2,"Checkout $newurl2 to $ENV{'PBDIR'}/../$newver\n");
2451	pb_cms_up($scheme2,"$ENV{'PBDIR'}/..");
2452
2453	# Update the .pb file
2454	open(FILE,"$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb") \|\| die "Unable to open $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb";
2455	open(OUT,"> $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new") \|\| die "Unable to write to $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new";
2456	while(<FILE>) {
2457	s/^projver\s+$ENV{'PBPROJ'}\s=\s$oldver/projver $ENV{'PBPROJ'} = $newver/;
2458	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/);
2459	pb_log(0,"Commenting testver in $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb\n") if (/^testver/);
2460	s/^testver/#testver/;
2461	print OUT $_;
2462	pb_log(0,"Please check delivery ($_) in $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb\n") if (/^delivery/);
2463	}
2464	close(FILE);
2465	close(OUT);
2466	rename("$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new","$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb");
2467
2468	# Checking pbcl files
2469	foreach my $f (<$ENV{'PBROOTDIR'}/*/pbcl>) {
2470	# Compute new pbcl file
2471	my $f2 = $f;
2472	$f2 =~ s\|$ENV{'PBROOTDIR'}\|$ENV{'PBROOTDIR'}/../$newver/\|;
2473	open(PBCL,$f) \|\| die "Unable to open $f";
2474	my $foundnew = 0;
2475	while (<PBCL>) {
2476	$foundnew = 1 if (/^$newver \(/);
2477	}
2478	close(PBCL);
2479	open(OUT,"> $f2") \|\| die "Unable to write to $f2: $!";
2480	open(PBCL,$f) \|\| die "Unable to open $f";
2481	while (<PBCL>) {
2482	print OUT "$_" if (not /^$oldver \(/);
2483	if ((/^$oldver \(/) && ($foundnew == 0)) {
2484	print OUT "$newver ($pbdate)\n";
2485	print OUT "- TBD\n";
2486	print OUT "\n";
2487	pb_log(0,"WARNING: version $newver not found in $f so added to $f2...\n") if ($foundnew == 0);
2488	}
2489	}
2490	close(OUT);
2491	close(PBCL);
2492	}
2493
2494	pb_log(2,"Checkin $ENV{'PBROOTDIR'}/../$newver\n");
2495	pb_cms_checkin($scheme,"$ENV{'PBROOTDIR'}/../$newver",undef);
2496	}
2497
2498	#
2499	# Return the list of VMs/VEs we are working on
2500	# $all is a flag to know if we return all of them
2501	# or only some (if all we publish also tar files in addition to pkgs
2502	#
2503	sub pb_get2v {
2504
2505	my $vtype = shift;
2506	my @v;
2507	my $all = 0;
2508	my $vlist;
2509	my $pbv = 'PBV';
2510
2511	if ($vtype eq "vm") {
2512	$vlist = "vmlist";
2513	} elsif ($vtype eq "ve") {
2514	$vlist = "velist";
2515	}
2516	# Get VM/VE list
2517	if ((not defined $ENV{$pbv}) \|\| ($ENV{$pbv} =~ /^all$/)) {
2518	my ($ptr) = pb_conf_get($vlist);
2519	$ENV{$pbv} = $ptr->{$ENV{'PBPROJ'}};
2520	$all = 1;
2521	}
2522	pb_log(2,"$vtype: $ENV{$pbv}\n");
2523	@v = split(/,/,$ENV{$pbv});
2524	return(\@v,$all);
2525	}
2526
2527	# Function to create a potentialy missing pb account on the VM/VE, and adds it to sudo
2528	# Needs to use root account to connect to the VM/VE
2529	# pb will take your local public SSH key to access
2530	# the pb account in the VM later on if needed
2531	sub pb_setup2v {
2532
2533	my $vtype = shift;
2534	my $sbx = shift \|\| undef;
2535
2536	my ($vm,$all) = pb_get2v($vtype);
2537
2538	# Script generated
2539	my $pbscript = "$ENV{'PBDESTDIR'}/setupv";
2540
2541	# Adapt // mode to memory size
2542	$pbparallel = pb_set_parallel($vtype);
2543
2544	my $pm = new Parallel::ForkManager($pbparallel) if (defined $pbparallel);
2545
2546	# Set which port the VM will use to communicate
2547	$pm->run_on_start(\&pb_set_port);
2548
2549	my $counter = 0;
2550	foreach my $v (@$vm) {
2551	$counter++;
2552	# Modulo pbparallel
2553	$counter = 1 if ($counter > $pbparallel);
2554	$pm->start($counter) and next if (defined $pbparallel);
2555
2556	# Deal with date sync.
2557	my ($ntpline,$dateline) = pb_date2v($vtype,$v);
2558
2559	# Get distro context
2560	my ($name,$ver,$darch) = split(/-/,$v);
2561	chomp($darch);
2562	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins) = pb_distro_init($name,$ver,$darch);
2563
2564	# Name of the account to deal with for VM/VE
2565	# Do not use the one passed potentially with -a
2566	my ($pbac) = pb_conf_get($vtype."login");
2567	my ($key,$zero0,$zero1,$zero2);
2568	my ($vmexist,$vmpid);
2569
2570	# Prepare the script to be executed on the VM/VE
2571	# in $ENV{'PBDESTDIR'}/setupv
2572	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
2573
2574	print SCRIPT << 'EOF';
2575	#!/usr/bin/perl -w
2576
2577	use strict;
2578	use File::Copy;
2579
2580	# We should not need in this script more functions than what is provided
2581	# by Base, Conf and Distribution to avoid problems at exec time.
2582	# They are appended at the end.
2583
2584	our $pbdebug;
2585	our $pbLOG;
2586	our $pbsynmsg = "pbscript";
2587	our $pbdisplaytype = "text";
2588	our $pblocale = "";
2589	pb_log_init($pbdebug, $pbLOG);
2590	pb_temp_init();
2591
2592	EOF
2593
2594	# Launch the VM/VE - Usage of snapshot disabled
2595	($vmexist,$vmpid) = pb_launchv($vtype,$v,0,0,0);
2596
2597	if ($vtype eq "vm") {
2598	# Prepare the key to be used and transfered remotely
2599	my $keyfile = pb_ssh_get(1);
2600
2601	my ($vmhost,$vmport,$vmntp) = pb_conf_get("vmhost","vmport","vmntp");
2602	my $nport = pb_get_port($vmport->{$ENV{'PBPROJ'}});
2603
2604	# Skip that VM if something went wrong
2605	next if (($vmpid == 0) && ($vmexist == 0));
2606
2607	# Store the pub key part in a variable
2608	open(FILE,"$keyfile.pub") \|\| die "Unable to open $keyfile.pub";
2609	($zero0,$zero1,$zero2) = split(/ /,<FILE>);
2610	close(FILE);
2611
2612	$key = "\Q$zero1";
2613
2614	# We call true to avoid problems if SELinux is not activated, but chcon is present and returns in that case 1
2615	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");
2616	# once this is done, we can do what we want on the VM remotely
2617	} elsif ($vtype eq "ve") {
2618	print SCRIPT << "EOF";
2619	# For VE we need a good null dev
2620	pb_system("rm -f /dev/null; mknod /dev/null c 1 3; chmod 777 /dev/null");
2621	EOF
2622	print SCRIPT << "EOF";
2623	# For VE we first need to mount some FS
2624	pb_system("mount -t proc /proc /proc");
2625
2626	EOF
2627	}
2628
2629	if ($vtype eq "vm") {
2630	print SCRIPT << 'EOF';
2631	# Removes duplicate in .ssh/authorized_keys of our key if needed
2632	#
2633	my $file1="$ENV{'HOME'}/.ssh/authorized_keys";
2634	open(PBFILE,$file1) \|\| die "Unable to open $file1";
2635	open(PBOUT,"> $file1.new") \|\| die "Unable to open $file1.new";
2636	my $count = 0;
2637	while (<PBFILE>) {
2638
2639	EOF
2640	print SCRIPT << "EOF";
2641	if (/ $key /) {
2642	\$count++;
2643	}
2644	print PBOUT \$_ if ((\$count <= 1) \|\| (\$_ !~ / $key /));
2645	}
2646	close(PBFILE);
2647	close(PBOUT);
2648	rename("\$file1.new",\$file1);
2649	chmod 0600,\$file1;
2650
2651	# Sync date
2652	EOF
2653	if (defined $ntpline) {
2654	print SCRIPT "pb_system(\"$ntpline\");\n";
2655	} else {
2656	print SCRIPT "pb_system(\"$dateline\");\n";
2657	}
2658	}
2659	print SCRIPT << 'EOF';
2660
2661	# Adds $pbac->{$ENV{'PBPROJ'}} as an account if needed
2662	#
2663	my $file="/etc/passwd";
2664	open(PBFILE,$file) \|\| die "Unable to open $file";
2665	my $found = 0;
2666	while (<PBFILE>) {
2667	EOF
2668	print SCRIPT << "EOF";
2669	\$found = 1 if (/^$pbac->{$ENV{'PBPROJ'}}:/);
2670	EOF
2671
2672	my $home = "/home";
2673	# Solaris doesn't like that we use /home
2674	$home = "/export/home" if ($dtype eq "pkg");
2675
2676	print SCRIPT << "EOF";
2677	}
2678	close(PBFILE);
2679
2680	if ( \$found == 0 ) {
2681	if ( ! -d "$home" ) {
2682	pb_mkdir_p("$home");
2683	}
2684	EOF
2685	print SCRIPT << "EOF";
2686	pb_system("/usr/sbin/groupadd $pbac->{$ENV{'PBPROJ'}}","Adding group $pbac->{$ENV{'PBPROJ'}}");
2687	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'}})");
2688	}
2689	EOF
2690
2691	# Copy the content of our local conf file to the VM/VE
2692	my $content = pb_get_content(pb_distro_conffile());
2693	print SCRIPT << "EOF";
2694	#
2695	# Create a temporary local conf file for distribution support
2696	# This is created here before its use later. Its place is hardcoded, so no choice for the path
2697	#
2698	my \$tempconf = pb_distro_conffile();
2699	pb_mkdir_p(dirname(\$tempconf));
2700	open(CONF,"> \$tempconf") \|\| die "Unable to create \$tempconf";
2701	print CONF q{$content};
2702	close(CONF);
2703	EOF
2704
2705	if ($vtype eq "vm") {
2706	print SCRIPT << "EOF";
2707	# allow ssh entry to build
2708	#
2709	mkdir "$home/$pbac->{$ENV{'PBPROJ'}}/.ssh",0700;
2710	# Allow those accessing root to access the build account
2711	copy("\$ENV{'HOME'}/.ssh/authorized_keys","$home/$pbac->{$ENV{'PBPROJ'}}/.ssh/authorized_keys");
2712	chmod 0600,".ssh/authorized_keys";
2713	pb_system("chown -R $pbac->{$ENV{'PBPROJ'}}:$pbac->{$ENV{'PBPROJ'}} $home/$pbac->{$ENV{'PBPROJ'}}","Finish setting up the account env for $pbac->{$ENV{'PBPROJ'}}");
2714
2715	EOF
2716	}
2717	print SCRIPT << 'EOF';
2718	# No passwd for build account only keys
2719	$file="/etc/shadow";
2720	if (-f $file) {
2721	open(PBFILE,$file) \|\| die "Unable to open $file";
2722	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
2723	while (<PBFILE>) {
2724	EOF
2725	print SCRIPT << "EOF";
2726	s/^$pbac->{$ENV{'PBPROJ'}}:\!\!:/$pbac->{$ENV{'PBPROJ'}}:*:/;
2727	s/^$pbac->{$ENV{'PBPROJ'}}:\!:/$pbac->{$ENV{'PBPROJ'}}:*:/; #SLES 9 e.g.
2728	s/^$pbac->{$ENV{'PBPROJ'}}:\\LK\\:/$pbac->{$ENV{'PBPROJ'}}:NP:/; #Solaris e.g.
2729	EOF
2730	print SCRIPT << 'EOF';
2731	print PBOUT $_;
2732	}
2733	close(PBFILE);
2734	close(PBOUT);
2735	rename("$file.new",$file);
2736	chmod 0640,$file;
2737	}
2738
2739	# Keep the VM in text mode
2740	$file="/etc/inittab";
2741	if (-f $file) {
2742	open(PBFILE,$file) \|\| die "Unable to open $file";
2743	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
2744	while (<PBFILE>) {
2745	s/^(..):5:initdefault:$/$1:3:initdefault:/;
2746	print PBOUT $_;
2747	}
2748	close(PBFILE);
2749	close(PBOUT);
2750	rename("$file.new",$file);
2751	chmod 0640,$file;
2752	}
2753
2754	# pb has to be added to portage group on gentoo
2755
2756	# We need to have that pb_distro_init function
2757	# Get it from Project-Builder::Distribution
2758	# And we now need the conf file required for this to work created above
2759
2760	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins, $darch) = pb_distro_init();
2761	print "distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $pbins, $darch))."\n";
2762
2763	# Adapt sudoers
2764	# sudo is not default on Solaris and needs to be installed first
2765	# from http://www.sunfreeware.com/programlistsparc10.html#sudo
2766	if ($dtype eq "pkg") {
2767	$file="/usr/local/etc/sudoers";
2768	} else {
2769	$file="/etc/sudoers";
2770	}
2771	open(PBFILE,$file) \|\| die "Unable to open $file";
2772	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
2773	while (<PBFILE>) {
2774	EOF
2775	print SCRIPT << "EOF";
2776	next if (/^$pbac->{$ENV{'PBPROJ'}} /);
2777	EOF
2778	print SCRIPT << 'EOF';
2779	s/Defaults[ \t]+requiretty//;
2780	print PBOUT $_;
2781	}
2782	close(PBFILE);
2783	EOF
2784	print SCRIPT << "EOF";
2785	# Some distro force requiretty at compile time, so disable here
2786	print PBOUT "Defaults:$pbac->{$ENV{'PBPROJ'}} !requiretty\n";
2787	print PBOUT "Defaults:root !requiretty\n";
2788	# This is needed in order to be able to halt the machine from the $pbac->{$ENV{'PBPROJ'}} account at least
2789	print PBOUT "Defaults:$pbac->{$ENV{'PBPROJ'}} env_keep += \\\"http_proxy ftp_proxy\\\"\n";
2790	print PBOUT "$pbac->{$ENV{'PBPROJ'}} ALL=(ALL) NOPASSWD:ALL\n";
2791	EOF
2792	print SCRIPT << 'EOF';
2793	close(PBOUT);
2794	rename("$file.new",$file);
2795	chmod 0440,$file;
2796
2797	EOF
2798
2799	# We may need a proxy configuration. Get it from the local env
2800
2801	if (defined $ENV{'http_proxy'}) {
2802	print SCRIPT "\$ENV\{'http_proxy'\}=\"$ENV{'http_proxy'}\";\n";
2803	}
2804
2805	if (defined $ENV{'ftp_proxy'}) {
2806	print SCRIPT "\$ENV\{'ftp_proxy'\}=\"$ENV{'ftp_proxy'}\";\n";
2807	}
2808
2809	print SCRIPT << 'EOF';
2810
2811	# Suse wants sudoers as 640
2812	if ((($ddir eq "sles") && (($dver =~ /10/) \|\| ($dver =~ /9/))) \|\| (($ddir eq "opensuse") && ($dver =~ /10.[012]/))) {
2813	chmod 0640,$file;
2814	}
2815
2816	# First install all required packages
2817	pb_system("yum clean all","Cleaning yum env") if (($ddir eq "fedora") \|\| ($ddir eq "asianux") \|\| ($ddir eq "rhel"));
2818	my ($ospkgdep) = pb_conf_get_if("ospkgdep");
2819
2820	my $pkgdep = pb_distro_get_param($ddir,$dver,$darch,$ospkgdep,$dfam,$dtype,$dos);
2821	pb_distro_installdeps(undef,$dtype,$pbins,pb_distro_only_deps_needed($dtype,join(' ',split(/,/,$pkgdep))));
2822
2823	EOF
2824	my ($instype) = pb_conf_get("pbinstalltype");
2825	my $itype = pb_distro_get_param($ddir,$dver,$darch,$instype,$dfam,$dtype,$dos);
2826	if (defined $sbx) {
2827	# Install from sandbox mean a file base install
2828	$itype = "file";
2829	}
2830	if ($itype =~ /^file/) {
2831	my $cmdget;
2832	if (defined $sbx) {
2833	# Install from sandbox mean using the result of the just passed sbx2build command
2834	# Get content saved in cms2build
2835	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
2836	die "Unable to get package list" if (not defined $pkg);
2837	my ($vepath) = pb_conf_get("vepath");
2838
2839	# We consider 2 specific packages
2840	my $vertag1 = $pkg->{"ProjectBuilder"};
2841	my $vertag2 = $pkg->{"project-builder"};
2842	# get the version of the current package - maybe different
2843	my ($pbver1,$tmp1) = split(/-/,$vertag1);
2844	my ($pbver2,$tmp2) = split(/-/,$vertag2);
2845	# Copy inside the VM
2846	copy("$ENV{'PBDESTDIR'}/ProjectBuilder-$pbver1.tar.gz","$vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch/tmp");
2847	copy("$ENV{'PBDESTDIR'}/project-builder-$pbver2.tar.gz","$vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch/tmp");
2848	$cmdget = "mv /tmp/ProjectBuilder-$pbver1.tar.gz ProjectBuilder-latest.tar.gz ; mv /tmp/project-builder-$pbver2.tar.gz project-builder-latest.tar.gz";
2849	} else {
2850	$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";
2851	}
2852	print SCRIPT << 'EOF';
2853	# Then install manually the missing perl modules
2854	my ($osperldep,$osperlver) = pb_conf_get_if("osperldep","osperlver");
2855
2856	my $perldep = pb_distro_get_param($ddir,$dver,$darch,$osperldep,$dfam,$dtype,$dos);
2857	foreach my $m (split(/,/,$perldep)) {
2858	# Skip empty deps
2859	next if ($m =~ /^\s*$/);
2860	my $dir = $m;
2861	$dir =~ s/-.*//;
2862	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}");
2863	}
2864	EOF
2865
2866	print SCRIPT << "EOF";
2867	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");
2868	EOF
2869	} elsif ($itype =~ /^pkg/) {
2870	# pkg based install. We need to point to the project-builder.org repository
2871	print SCRIPT << 'EOF';
2872	my ($ospkg) = pb_conf_get_if("ospkg");
2873
2874	my $pkgforpb = pb_distro_get_param($ddir,$dver,$darch,$ospkg,$dfam,$dtype,$dos);
2875	pb_distro_setuposrepo($ddir,$dver,$darch,$dtype,$dfam,$dos);
2876	pb_distro_installdeps(undef,$dtype,$pbins,pb_distro_only_deps_needed($dtype,join(' ',split(/,/,$pkgforpb))));
2877	EOF
2878	} else {
2879	# Unknown install type
2880	die("Unknown install type $itype->{$ENV{'PBPROJ'}} for param pbinstalltype");
2881	}
2882	print SCRIPT << 'EOF';
2883	pb_system("pb 2>&1 \| head -5",undef,"verbose");
2884	EOF
2885	if ($vtype eq "ve") {
2886	print SCRIPT << 'EOF';
2887	# For VE we need to umount some FS at the end
2888
2889	pb_system("umount /proc");
2890
2891	# Create a basic network file if not already there
2892
2893	my $nf="/etc/sysconfig/network";
2894	if ((! -f $nf) && ($dtype eq "rpm")) {
2895	open(NF,"> $nf") \|\| die "Unable to create $nf";
2896	print NF "NETWORKING=yes\n";
2897	print NF "HOSTNAME=localhost\n";
2898	close(NF);
2899	}
2900	chmod 0755,$nf;
2901	EOF
2902	}
2903
2904	# Adds pb_distro_init and all functions needed from ProjectBuilder::Distribution and Base
2905	foreach my $d (@INC) {
2906	my @f = ("$d/ProjectBuilder/Base.pm","$d/ProjectBuilder/Distribution.pm","$d/ProjectBuilder/Conf.pm");
2907	foreach my $f (@f) {
2908	if (-f "$f") {
2909	open(PBD,"$f") \|\| die "Unable to open $f";
2910	while (<PBD>) {
2911	next if (/^package/);
2912	next if (/^use Exporter/);
2913	next if (/^use ProjectBuilder::/);
2914	next if (/^our /);
2915	print SCRIPT $_;
2916	}
2917	close(PBD);
2918	}
2919	}
2920	}
2921	close(SCRIPT);
2922	chmod 0755,"$pbscript";
2923
2924	# That build script needs to be run as root and force stop of VM at end
2925	$pbaccount = "root";
2926
2927	# Force shutdown of VM except if it was already launched
2928	my $pbforce = 0;
2929	if ((! $vmexist) && ($vtype eq "vm")) {
2930	$pbforce = 1;
2931	}
2932
2933	pb_script2v($pbscript,$vtype,$pbforce,$v);
2934	$pm->finish if (defined $pbparallel);
2935	}
2936	if (defined $pbparallel) {
2937	$pm->wait_all_children;
2938	}
2939	return;
2940	}
2941
2942	# Function to create a snapshot named 'pb' for VMs and a compressed tar for VEs
2943	sub pb_snap2v {
2944
2945	my $vtype = shift;
2946
2947	my ($vm,$all) = pb_get2v($vtype);
2948
2949	# Script generated
2950	my $pbscript = "$ENV{'PBDESTDIR'}/snapv";
2951
2952	my ($pbac) = pb_conf_get($vtype."login");
2953
2954	foreach my $v (@$vm) {
2955	if ($vtype eq "ve") {
2956	# Get distro context
2957	my ($name,$ver,$darch) = split(/-/,$v);
2958	chomp($darch);
2959	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf) = pb_distro_init($name,$ver,$darch);
2960	my ($vepath) = pb_conf_get("vepath");
2961
2962	# Test if an existing snapshot exists and remove it if there is a VE
2963	if ((-f "$vepath->{$ENV{'PBPROJ'}}/$ddir-$dver-$darch.tar.gz") &&
2964	(! -d "$vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch")) {
2965	pb_system("sudo rm -f $vepath->{$ENV{'PBPROJ'}}/$ddir-$dver-$darch.tar.gz","Removing previous snapshot $ddir-$dver-$darch.tar.gz");
2966	}
2967	}
2968
2969	# Prepare the script to be executed on the VM/VE
2970	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
2971	print SCRIPT << 'EOF';
2972	#!/bin/bash
2973	sleep 2
2974	EOF
2975	close(SCRIPT);
2976	chmod 0755,"$pbscript";
2977
2978	# Force shutdown of VM/VE
2979	# Force snapshot of VM/VE
2980	pb_script2v($pbscript,$vtype,1,$v,1);
2981	}
2982	return;
2983	}
2984
2985	# Function to update a VMs or VEs with the latest distribution content
2986	sub pb_update2v {
2987
2988	my $vtype = shift;
2989
2990	my ($vm,$all) = pb_get2v($vtype);
2991
2992	# Script generated
2993	my $pbscript = "$ENV{'PBDESTDIR'}/updatev";
2994
2995	my ($pbac) = pb_conf_get($vtype."login");
2996
2997	foreach my $v (@$vm) {
2998	# Get distro context
2999	my ($name,$ver,$darch) = split(/-/,$v);
3000	chomp($darch);
3001	my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins) = pb_distro_init($name,$ver,$darch);
3002
3003	# Prepare the script to be executed on the VM/VE
3004	# in $ENV{'PBDESTDIR'}/updatev
3005	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
3006
3007	print SCRIPT << 'EOF';
3008	#!/bin/bash
3009	sleep 2
3010	EOF
3011	# VE needs a good /proc
3012	if ($vtype eq "ve") {
3013	print SCRIPT "sudo mount -t proc /proc /proc\n";
3014	}
3015	print SCRIPT "$pbupd\n";
3016	if ($vtype eq "ve") {
3017	print SCRIPT "sudo umount /proc\n";
3018	}
3019	close(SCRIPT);
3020	chmod 0755,"$pbscript";
3021
3022	# Force shutdown of VM except
3023	pb_script2v($pbscript,$vtype,1,$v);
3024	}
3025	return;
3026	}
3027
3028	sub pb_announce {
3029
3030	# Get all required parameters
3031	my ($pbpackager,$pbrepo,$pbml,$pbsmtp) = pb_conf_get("pbpackager","pbrepo","pbml","pbsmtp");
3032	my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
3033	my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
3034	my @pkgs = @$pkg;
3035	my %pkgs;
3036	my $first = 0;
3037
3038	# Command to find packages on repo
3039	my $findstr = "find . ";
3040	# Generated announce files
3041	my @files;
3042
3043	foreach my $pbpkg (@pkgs) {
3044	if ($first != 0) {
3045	$findstr .= "-o ";
3046	}
3047	$first++;
3048	if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
3049	$pbver = $pkgv->{$pbpkg};
3050	} else {
3051	$pbver = $ENV{'PBPROJVER'};
3052	}
3053	if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
3054	$pbtag = $pkgt->{$pbpkg};
3055	} else {
3056	$pbtag = $ENV{'PBPROJTAG'};
3057	}
3058
3059	# TODO: use virtual/real names here now
3060	$findstr .= "-name \'$pbpkg-$pbver-$pbtag\..rpm\' -o -name \'$pbpkg"."_$pbver\.deb\' -o -name \'$pbpkg-$pbver*\.ebuild\' ";
3061
3062	my $chglog;
3063
3064	# Get project info on log file and generate tmp files used later on
3065	pb_cms_init($pbinit);
3066	$chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
3067	$chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
3068	$chglog = undef if (! -f $chglog);
3069
3070	open(OUT,"> $ENV{'PBTMP'}/$pbpkg.ann") \|\| die "Unable to create $ENV{'PBTMP'}/$pbpkg.ann: $!";
3071	my %pb;
3072	$pb{'dtype'} = "announce";
3073	$pb{'realpkg'} = $pbpkg;
3074	$pb{'ver'} = $pbver;
3075	$pb{'tag'} = $pbtag;
3076	$pb{'suf'} = "N/A"; # Should not be empty even if unused
3077	$pb{'date'} = $pbdate;
3078	$pb{'chglog'} = $chglog;
3079	$pb{'packager'} = $pbpackager;
3080	$pb{'proj'} = $ENV{'PBPROJ'};
3081	$pb{'repo'} = $pbrepo;
3082	pb_changelog(\%pb,\*OUT,"yes");
3083	close(OUT);
3084	push(@files,"$ENV{'PBTMP'}/$pbpkg.ann");
3085	}
3086	$findstr .= " \| grep -Ev \'src.rpm\'";
3087
3088	# Prepare the command to run and execute it
3089	open(PBS,"> $ENV{'PBTMP'}/pbscript") \|\| die "Unable to create $ENV{'PBTMP'}/pbscript";
3090	print PBS "$findstr\n";
3091	close(PBS);
3092	chmod 0755,"$ENV{'PBTMP'}/pbscript";
3093	pb_send2target("Announce");
3094
3095	# Get subject line
3096	my $sl = "Project $ENV{'PBPROJ'} version $ENV{'PBPROJVER'} is now available";
3097	pb_log(0,"Please enter the title of your announce\n");
3098	pb_log(0,"(By default: $sl)\n");
3099	my $sl2 = <STDIN>;
3100	$sl = $sl2 if ($sl2 !~ /^$/);
3101
3102	# Prepare a template of announce
3103	open(ANN,"> $ENV{'PBTMP'}/announce.html") \|\| die "Unable to create $ENV{'PBTMP'}/announce.html: $!";
3104	print ANN << "EOF";
3105	$sl</p>
3106
3107	<p>The project team is happy to announce the availability of a newest version of $ENV{'PBPROJ'} $ENV{'PBPROJVER'}. Enjoy it as usual!</p>
3108	<p>
3109	Now available at <a href="$pbrepo->{$ENV{'PBPROJ'}}">$pbrepo->{$ENV{'PBPROJ'}}</a>
3110	</p>
3111	<p>
3112	EOF
3113	open(LOG,"$ENV{'PBTMP'}/system.$$.log") \|\| die "Unable to read $ENV{'PBTMP'}/system.$$.log: $!";
3114	my $col = 2;
3115	my $i = 1;
3116	print ANN << 'EOF';
3117	<TABLE WIDTH="700" CELLPADDING="0" CELLSPACING="0" BORDER="0">
3118	<TR>
3119	EOF
3120	while (<LOG>) {
3121	print ANN "<TD><A HREF=\"$pbrepo->{$ENV{'PBPROJ'}}/$_\">$_</A></TD>";
3122	$i++;
3123	if ($i > $col) {
3124	print ANN "</TR>\n<TR>";
3125	$i = 1;
3126	}
3127	}
3128	close(LOG);
3129	print ANN << "EOF";
3130	</TR>
3131	</TABLE>
3132	</p>
3133
3134	<p>As usual source packages are also available in the same directory.</p>
3135
3136	<p>
3137	Changes are :
3138	</p>
3139	<p>
3140	EOF
3141	# Get each package changelog content
3142	foreach my $f (sort(@files)) {
3143	open(IN,"$f") \|\| die "Unable to read $f:$!";
3144	while (<IN>) {
3145	print ANN $_;
3146	}
3147	close(IN);
3148	print ANN "</p><p>\n";
3149	}
3150	print ANN "</p>\n";
3151	close(ANN);
3152
3153	# Allow for modification
3154	my $editor = "vi";
3155	$editor = $ENV{'EDITOR'} if (defined $ENV{'EDITOR'});
3156	pb_system("$editor $ENV{'PBTMP'}/announce.html","Allowing modification of the announce","noredir");
3157
3158	# Store it in DB for external usage (Web pages generation)
3159	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
3160
3161	my $precmd = "";
3162	if (! -f $db) {
3163	$precmd = "CREATE TABLE announces (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, announce VARCHAR[65535])";
3164	}
3165
3166	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
3167	{ RaiseError => 1, AutoCommit => 1 })
3168	\|\| die "Unable to connect to $db";
3169
3170	if ($precmd ne "") {
3171	my $sth = $dbh->prepare(qq{$precmd})
3172	\|\| die "Unable to create table into $db";
3173	$sth->execute();
3174	}
3175
3176	# To read whole file
3177	local $/;
3178	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
3179	my $announce = <ANN>;
3180	close(ANN);
3181
3182	pb_log(2,"INSERT INTO announces VALUES (NULL, $pbdate, $announce)");
3183	my $sth = $dbh->prepare(qq{INSERT INTO announces VALUES (NULL,?,?)})
3184	\|\| die "Unable to insert into $db";
3185	$sth->execute($pbdate, $announce);
3186	$sth->finish();
3187	$dbh->disconnect;
3188
3189	# Then deliver it on the Web
3190	# $TOOLHOME/livwww www
3191
3192	# Mail it to project's ML
3193	open(ML,"\| w3m -dump -T text/html > $ENV{'PBTMP'}/announce.txt") \|\| die "Unable to create $ENV{'PBTMP'}/announce.txt: $!";
3194	print ML << 'EOF';
3195	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/x html1/DTD/xhtml1-strict.dtd">
3196
3197	<html xmlns="http://www.w3.org/1999/xhtml" dir="ltr" xml:lang="en" lang="en">
3198	<head>
3199	</head>
3200	<body>
3201	<p>
3202	EOF
3203	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
3204	while(<ANN>) {
3205	print ML $_;
3206	}
3207	print ML << 'EOF';
3208	</body>
3209	</html>
3210	EOF
3211	close(ML);
3212
3213	# To read whole file
3214	local $/;
3215	open(ANN,"$ENV{'PBTMP'}/announce.txt") \|\| die "Unable to read $ENV{'PBTMP'}/announce.txt: $!";
3216	my $msg = <ANN>;
3217	close(ANN);
3218
3219	# Preparation of headers
3220	eval
3221	{
3222	require Mail::Sendmail;
3223	Mail::Sendmail->import();
3224	};
3225	if ($@) {
3226	# Mail::Sendmail not found not sending mail !
3227	pb_log(0,"No Mail::Sendmail module found so not sending any mail !\n");
3228	} else {
3229	my %mail = (
3230	To => $pbml->{$ENV{'PBPROJ'}},
3231	From => $pbpackager->{$ENV{'PBPROJ'}},
3232	Smtp => $pbsmtp->{$ENV{'PBPROJ'}},
3233	Body => $msg,
3234	Subject => "[ANNOUNCE] $sl",
3235	);
3236
3237	# Send mail
3238	if (! sendmail(%mail)) {
3239	if ((defined $Mail::Sendmail::error) and (defined $Mail::Sendmail::log)) {
3240	die "Unable to send mail ($Mail::Sendmail::error): $Mail::Sendmail::log";
3241	}
3242	}
3243	}
3244	}
3245
3246	#
3247	# Creates a set of HTML file containing the news for the project
3248	# based on what has been generated by the pb_announce function
3249	#
3250	sub pb_web_news2html {
3251
3252	my $dest = shift \|\| $ENV{'PBTMP'};
3253
3254	# Get all required parameters
3255	my ($pkgv, $pkgt) = pb_conf_get_if("pkgver","pkgtag");
3256
3257	# DB of announces for external usage (Web pages generation)
3258	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
3259
3260	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
3261	{ RaiseError => 1, AutoCommit => 1 })
3262	\|\| die "Unable to connect to $db";
3263	# For date handling
3264	$ENV{LANGUAGE}="C";
3265	my $firstjan = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year(), 0, 0, -1);
3266	my $oldfirst = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year()-1, 0, 0, -1);
3267	pb_log(2,"firstjan: $firstjan, oldfirst: $oldfirst, pbdate:$pbdate\n");
3268	my $all = $dbh->selectall_arrayref("SELECT id,date,announce FROM announces ORDER BY date DESC");
3269	my %news;
3270	$news{"cy"} = ""; # current year's news
3271	$news{"ly"} = ""; # last year news
3272	$news{"py"} = ""; # previous years news
3273	$news{"fp"} = ""; # first page news
3274	my $cpt = 4; # how many news for first page
3275	# Extract info from DB
3276	foreach my $row (@$all) {
3277	my ($id, $date, $announce) = @$row;
3278	$news{"cy"} = $news{"cy"}."<p><B>$date</B> $announce\n" if ((($date cmp $pbdate) le 0) && (($firstjan cmp $date) le 0));
3279	$news{"ly"} = $news{"ly"}."<p><B>$date</B> $announce\n" if ((($date cmp $firstjan) le 0) && (($oldfirst cmp $date) le 0));
3280	$news{"py"} = $news{"py"}."<p><B>$date</B> $announce\n" if (($date cmp $oldfirst) le 0);
3281	$news{"fp"} = $news{"fp"}."<p><B>$date</B> $announce\n" if ($cpt > 0);
3282	$cpt--;
3283	}
3284	pb_log(1,"news{fp}: ".$news{"fp"}."\n");
3285	$dbh->disconnect;
3286
3287	# Generate the HTML content
3288	foreach my $pref (keys %news) {
3289	open(NEWS,"> $dest/pb_web_$pref"."news.html") \|\| die "Unable to create $dest/pb_web_$pref"."news.html: $!";
3290	print NEWS "$news{$pref}";
3291	close(NEWS);
3292	}
3293	}
3294
3295
3296	# Return the SSH key file to use
3297	# Potentially create it if needed
3298
3299	sub pb_ssh_get {
3300
3301	my $create = shift \|\| 0; # Do not create keys by default
3302
3303	# Check the SSH environment
3304	my $keyfile = undef;
3305
3306	# We have specific keys by default
3307	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
3308	if (!(-e $keyfile) && ($create eq 1)) {
3309	pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
3310	}
3311
3312	$keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
3313	$keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
3314	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
3315	die "Unable to find your public ssh key under $keyfile" if (not defined $keyfile);
3316	return($keyfile);
3317	}
3318
3319
3320	# Returns the pid of a running VM command using a specific VM file
3321	sub pb_check_ps {
3322	my $vmcmd = shift;
3323	my $vmm = shift;
3324	my $vmexist = 0; # FALSE by default
3325
3326	open(PS, "ps auxhww\|") \|\| die "Unable to call ps";
3327	while (<PS>) {
3328	next if (! /$vmcmd/);
3329	next if (! /$vmm/);
3330	my ($void1, $void2);
3331	($void1, $vmexist, $void2) = split(/ +/);
3332	last;
3333	}
3334	return($vmexist);
3335	}
3336
3337
3338	sub pb_extract_build_files {
3339
3340	my $src=shift;
3341	my $dir=shift;
3342	my $ddir=shift;
3343	my $mandatory=shift \|\| "spec";
3344	my @files;
3345
3346	my $flag = "mayfail" if ($mandatory eq "patch");
3347	my $res;
3348
3349	if ($src =~ /tar\.gz$/) {
3350	$res = pb_system("tar xfpz $src $dir","Extracting $mandatory files from $src",$flag);
3351	} elsif ($src =~ /tar\.bz2$/) {
3352	$res = pb_system("tar xfpj $src $dir","Extracting $mandatory files from $src",$flag);
3353	} else {
3354	die "Unknown compression algorithm for $src";
3355	}
3356	# If not mandatory return now
3357	return() if (($res != 0) and ($mandatory eq "patch"));
3358	opendir(DIR,"$dir") \|\| die "Unable to open directory $dir";
3359	foreach my $f (readdir(DIR)) {
3360	next if ($f =~ /^\./);
3361	# Skip potential patch dir
3362	next if ($f =~ /^pbpatch/);
3363	move("$dir/$f","$ddir") \|\| die "Unable to move $dir/$f to $ddir";
3364	pb_log(2,"mv $dir/$f $ddir\n");
3365	push @files,"$ddir/$f";
3366	}
3367	closedir(DIR);
3368	# Not enough but still a first cleanup
3369	pb_rm_rf("$dir");
3370	return(@files);
3371	}
3372
3373	sub pb_list_bfiles {
3374
3375	my $dir = shift;
3376	my $pbpkg = shift;
3377	my $bfiles = shift;
3378	my $pkgfiles = shift;
3379	my $supfiles = shift;
3380
3381	opendir(BDIR,"$dir") \|\| die "Unable to open dir $dir: $!";
3382	foreach my $f (readdir(BDIR)) {
3383	next if ($f =~ /^\./);
3384	if (-d $f) {
3385	# Recurse for directories (Debian 3.0 format e.g.)
3386	pb_list_bfiles($f,$pbpkg,$bfiles,$pkgfiles,$supfiles);
3387	next;
3388	}
3389	$bfiles->{$f} = "$dir/$f";
3390	$bfiles->{$f} =~ s~$ENV{'PBROOTDIR'}~~;
3391	if (defined $supfiles->{$pbpkg}) {
3392	$pkgfiles->{$f} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
3393	}
3394	}
3395	closedir(BDIR);
3396	}
3397
3398	sub pb_list_sfiles {
3399
3400	my $sdir = shift;
3401	my $sources = shift;
3402	my $dtype = shift;
3403	my $dfam = shift;
3404	my $ddir = shift;
3405	my $dver = shift;
3406	my $arch = shift;
3407	my $extdir = shift;
3408
3409	# Prepare local sources for this distro - They are always applied first - May be a problem one day
3410	# This function works for both patches and additional sources
3411	foreach my $p (sort(<$sdir/*>)) {
3412	$sources->{"$ddir-$dver-$arch"} .= "," if ((defined $sources->{"$ddir-$dver-$arch"}) and ($p =~ /\.all$/));
3413	$sources->{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.all$/);
3414	$sources->{"$ddir-$dver-$arch"} .= "," if ((defined $sources->{"$ddir-$dver-$arch"}) and ($p =~ /\.$dtype$/));
3415	$sources->{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$dtype$/);
3416	$sources->{"$ddir-$dver-$arch"} .= "," if ((defined $sources->{"$ddir-$dver-$arch"}) and ($p =~ /\.$dfam$/));
3417	$sources->{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$dfam$/);
3418	$sources->{"$ddir-$dver-$arch"} .= "," if ((defined $sources->{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir$/));
3419	$sources->{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir$/);
3420	$sources->{"$ddir-$dver-$arch"} .= "," if ((defined $sources->{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir-$dver$/));
3421	$sources->{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir-$dver$/);
3422	$sources->{"$ddir-$dver-$arch"} .= "," if ((defined $sources->{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir-$dver-$arch$/));
3423	$sources->{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir-$dver-$arch$/);
3424	}
3425
3426	# Prepare also remote sources to be included - Applied after the local ones
3427	foreach my $p ("all","$dtype","$dfam","$ddir","$ddir-$dver","$ddir-$dver-$arch") {
3428	my $f = "$extdir.".".$p";
3429	next if (not -f $f);
3430	if (not open(PATCH,$f)) {
3431	pb_display("Unable to open existing external source file content $f\n");
3432	next;
3433	}
3434	while (<PATCH>) {
3435	chomp();
3436	$sources->{"$ddir-$dver-$arch"} .= "," if (defined $sources->{"$ddir-$dver-$arch"});
3437	$sources->{"$ddir-$dver-$arch"} .= "$_";
3438	}
3439	close(PATCH);
3440	}
3441	pb_log(2,"DEBUG: sources: ".Dumper($sources)."\n");
3442	}
3443
3444	#
3445	# Return the list of packages we are working on in a non CMS action
3446	#
3447	sub pb_get_pkg {
3448
3449	my @pkgs = ();
3450
3451	my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
3452	@pkgs = keys %$var;
3453
3454	pb_log(0,"Packages: ".join(',',@pkgs)."\n");
3455	return(\@pkgs);
3456	}
3457
3458	#
3459	# Return the postinstall line if needed
3460	#
3461
3462	sub pb_get_postinstall {
3463
3464	my $ddir = shift;
3465	my $dver = shift;
3466	my $darch = shift;
3467	my $rbspi = shift;
3468	my $vestyle = shift;
3469	my $post = "";
3470
3471	# Do we have a local post-install script
3472	if ($vestyle eq "rinse") {
3473	$post = "--post-install ";
3474	} elsif ($vestyle eq "rpmbootstrap") {
3475	$post = "-s ";
3476	}
3477
3478	my $postparam = pb_distro_get_param($ddir,$dver,$darch,$rbspi);
3479	if ($postparam eq "") {
3480	$post = "";
3481	} else {
3482	$post .= $postparam;
3483	}
3484	return($post);
3485	}
3486
3487	# Manages VM SSH port communication
3488	sub pb_get_port {
3489
3490	my $port = shift;
3491	my $cmt = shift;
3492
3493	die "No port passed in parameter. Report to dev team\n" if (not defined $port);
3494	pb_log(2,"pb_get_port with $port\n");
3495	my $nport = $port;
3496	# Maybe a port was given as parameter so overwrite
3497	$nport = "$pbport" if (defined $pbport);
3498	# Maybe in // mode so use the env var set up as an offset to the base port, except when called from send2target for Packages
3499	if ((not defined $cmt) \|\| ($cmt ne "Packages")) {
3500	$nport += $ENV{'PBVMPORT'} if ((defined $pbparallel) && (defined $ENV{'PBVMPORT'}));
3501	}
3502	pb_log(2,"pb_get_port returns $nport\n");
3503	return($nport);
3504	}
3505
3506	sub pb_set_port {
3507
3508	my ($pid,$ident) = @_;
3509	pb_log(2,"pb_set_port for VM ($pid), id $ident\n");
3510	$ENV{'PBVMPORT'} = $ident;
3511	pb_log(2,"pb_set_port sets PBVMPORT in env to $ENV{'PBVMPORT'}\n");
3512	}
3513
3514	sub pb_set_parallel {
3515
3516	my $vtype = shift;
3517
3518	pb_log(2,"pb_set_parallel vtype: $vtype\n");
3519	# Take care of memory size if VM, parallel mode and more than 1 action
3520	if ((defined $pbparallel) && ($pbparallel ne 1) && ($vtype eq "vm")) {
3521	eval
3522	{
3523	require Linux::SysInfo;
3524	Linux::SysInfo->import();
3525	};
3526	if ($@) {
3527	# Linux::SysInfo not found
3528	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");
3529	} else {
3530	# Using the memory size
3531	my $si = Linux::SysInfo::sysinfo();
3532	if (not defined $si) {
3533	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");
3534	} else {
3535	# Keep the number of VM whose memory can be allocated
3536	my $ram = $si->{"totalram"}-$si->{"sharedram"}-$si->{"bufferram"};
3537	my $ram2;
3538	my ($vmmem) = pb_conf_get_if("vmmem");
3539
3540	my $v = "default";
3541	if ((defined $vmmem) and (defined $vmmem->{$v})) {
3542	$ram2 = $vmmem->{$v};
3543	} else {
3544	# Default for KVM/QEMU
3545	$ram2 = 128;
3546	}
3547	$pbparallel = sprintf("%d",$ram/$ram2);
3548	}
3549	pb_log(1,"Using $pbparallel processes at a time\n");
3550	}
3551	}
3552	pb_log(2,"pb_set_parallel returns: $pbparallel\n");
3553	return($pbparallel);
3554	}
3555
3556
3557	1;

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

Download in other formats: