Context Navigation

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

Last change on this file since 1176 was 1176, checked in by Bruno Cornec, 13 years ago

r4160@eelzbach2: bruno | 2011-02-06 13:30:39 +0100

Adds support for Remote Machines (RM). Not tested yet.

Property svn:executable set to *

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

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

Download in other formats: