Context Navigation

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

Last change on this file since 1542 was 1542, checked in by Bruno Cornec, 12 years ago
pb: Add documentation for newve and setupve; fix bug in build2pkg documentation (Eric Anderson)
Property svn:executable set to ``*
File size: 139.6 KB

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

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

Download in other formats: