Context Navigation

source: devel/pb/bin/pb @ 1548

Revision 1548, 143.1 KB checked in by bruno, 12 months ago (diff)
pb: Improve error message when building but config isn't present. Pass through pb_stop_on_error when setting up a virtual environment. (Eric Andersson)
Property svn:executable set to ``*

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

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

Download in other formats: