Context Navigation

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

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

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

Download in other formats: