Context Navigation

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

Last change on this file since 1552 was 1552, checked in by Bruno Cornec, 12 years ago
pb: log when we start and finish the build, that's an important state. Add missing setting of all_ok to false that kept us from properly stopping on errors. Fix typos in comments. Greatly simplify pb_get_distros function by using split and join. Also remove whitespace since multi-line conf file support will cause that to be added. Filter.pm: use new pb_pbos_to_keylist function to generate the list of basenames we want, and use a loop rather than lots of separate statements. Simplifies and makes more powerful this function. Also now guaranteed to maintain consistency with key lookups in the hash maps.
Property svn:executable set to ``*
File size: 145.5 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 (comma 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	pb_log(0,"INFO: ------ Starting to build package ------\n");
1377	# Get the running distro to build on
1378	my $pbos = pb_distro_get_context();
1379
1380	# If needed we may add repository to the build env
1381	pb_distro_setuprepo($pbos);
1382
1383	# Get list of packages to build
1384	my $ptr = pb_get_pkg();
1385	@pkgs = @$ptr;
1386
1387	# Get content saved in cms2build
1388	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1389	$pkg = { } if (not defined $pkg);
1390	my $pbextdir = pb_get_extdir();
1391
1392	pb_mkdir_p("$ENV{'PBBUILDDIR'}") if (! -d "$ENV{'PBBUILDDIR'}");
1393	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1394	my $made = ""; # pkgs made during build
1395	my $pm;
1396	my $all_ok = 1;
1397
1398	if (defined $pbparallel) {
1399	$pm = new Parallel::ForkManager($pbparallel);
1400	$pm->run_on_finish(sub { my ($pid, $code, $id, $signal, $dump) = @_;
1401	$all_ok = 0 unless (($code == 0) && ($signal == 0) && ($dump == 0)); });
1402	}
1403
1404	# We need to communicate info back from the children if parallel so prepare a dir for that
1405	my $tmpd = "$ENV{'PBTMP'}/build.$$";
1406	pb_mkdir_p($tmpd) if (defined $pbparallel);
1407
1408	foreach my $pbpkg (@pkgs) {
1409	$pm->start and next if (defined $pbparallel);
1410
1411	my $vertag = $pkg->{$pbpkg};
1412	pb_log(2,"Vertag: $vertag\n");
1413	# get the version of the current package - maybe different
1414	($pbver,$pbtag) = split(/-/,$vertag);
1415
1416	my $src="$ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.tar.gz";
1417	my $src2="$ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.pbconf.tar.gz";
1418	pb_log(2,"Source file: $src\n");
1419	pb_log(2,"Pbconf file: $src2\n");
1420
1421	pb_log(2,"Working directory: $ENV{'PBBUILDDIR'}\n");
1422	if ($pbos->{'type'} eq "rpm") {
1423	foreach my $d ('RPMS','SRPMS','SPECS','SOURCES','BUILD') {
1424	if (! -d "$ENV{'PBBUILDDIR'}/$d") {
1425	pb_mkdir_p("$ENV{'PBBUILDDIR'}/$d");
1426	}
1427	}
1428
1429	# Remove in case a previous link/file was there
1430	unlink "$ENV{'PBBUILDDIR'}/SOURCES/".basename($src);
1431	symlink "$src","$ENV{'PBBUILDDIR'}/SOURCES/".basename($src) \|\| die "Unable to symlink $src in $ENV{'PBBUILDDIR'}/SOURCES";
1432	# We need to first extract the spec file
1433	my @specfile = pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/","$ENV{'PBBUILDDIR'}/SPECS","spec");
1434
1435	# We need to handle potential patches to upstream sources
1436	pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbpatch/","$ENV{'PBBUILDDIR'}/SOURCES","patch");
1437
1438	# We need to handle potential additional sources to upstream sources
1439	pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbsrc/","$ENV{'PBBUILDDIR'}/SOURCES","src");
1440
1441	pb_log(2,"specfile: ".Dumper(\@specfile)."\n");
1442	# set LANGUAGE to check for correct log messages
1443	$ENV{'LANGUAGE'}="C";
1444	# Older Redhat use _target_platform in %configure incorrectly
1445	my $specialdef = "";
1446	if (($pbos->{'name'} eq "redhat") \|\| (($pbos->{'name'} eq "rhel") && ($pbos->{'version'} eq "2.1"))) {
1447	$specialdef = "--define \'_target_platform \"\"\'";
1448	}
1449
1450	foreach my $f (@specfile) {
1451	if ($f =~ /\.spec$/) {
1452	# This could cause an issue in // mode
1453	pb_distro_installdeps($f,$pbos);
1454	pb_system("rpmbuild $specialdef --define \"packager $ENV{'PBPACKAGER'}\" --define \"_topdir $ENV{'PBBUILDDIR'}\" -ba $f","Building package with $f under $ENV{'PBBUILDDIR'}","verbose");
1455	last;
1456	}
1457	}
1458	# Get the name of the generated packages
1459	open(LOG,"$ENV{'PBTMP'}/system.$$.log") \|\| die "Unable to open $ENV{'PBTMP'}/system.$$.log";
1460	while (<LOG>) {
1461	chomp($_);
1462	next if ($_ !~ /^Wrote:/);
1463	s\|./([S]RPMS.*)\|$1\|;
1464	$made .=" $_";
1465	}
1466	close(LOG);
1467
1468	} elsif ($pbos->{'type'} eq "deb") {
1469	pb_system("tar xfz $src","Extracting sources");
1470	pb_system("tar xfz $src2","Extracting pbconf");
1471
1472	chdir "$pbpkg-$pbver$pbextdir" \|\| die "Unable to chdir to $pbpkg-$pbver$pbextdir";
1473	pb_rm_rf("debian");
1474	my $confdir = "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
1475	die "Configuration directory $confdir is not a directory\nIs os description listed in your {ve,vm,rm}list values?" if (not -d $confdir);
1476	symlink "$confdir","debian" \|\| die "Unable to symlink 'debian' to $confdir";
1477	chmod 0755,"debian/rules";
1478
1479	# We need to handle potential patches to upstream sources
1480	pb_mkdir_p("debian/patches");
1481	my @f = pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbpatch/","debian/patches","patch");
1482
1483	# By default we use format 1.0 - Cf man dpkg-source
1484	my $debsrcfmt = "1.0";
1485	my $debsrcfile = "debian/source/format";
1486	if (-f $debsrcfile) {
1487	$debsrcfmt = pb_get_content($debsrcfile);
1488	}
1489
1490	if ($debsrcfmt =~ /^3.*quilt/) {
1491	# If we use quilt to manage patches, we then setup the env correctly
1492	# as per http://pkg-perl.alioth.debian.org/howto/quilt.html
1493	# Generate Debian patch series for quilt
1494	open(SERIE,"> debian/patches/series") \|\| die "Unable to write in debian/patches/series";
1495	$ENV{'QUILT_PATCHES'}="debian/patches";
1496	} else {
1497	# If we use dpatch to manage patches, we then setup the 00list file as well
1498	open(SERIE,"> debian/patches/00list") \|\| die "Unable to write in debian/patches/00list";
1499	}
1500	foreach my $f (sort @f) {
1501	# Skip the script made to apply the patches to the Debian tree
1502	next if ($f =~ /pbapplypatch/);
1503	# We also need to uncompress them
1504	pb_system("gzip -d $f","","quiet");
1505	$f =~ s/\.gz$//;
1506	print SERIE "$f\n";
1507	}
1508	close(SERIE);
1509	if (@f) {
1510	# We have patches...
1511	my $patch_file = "debian/patches/pbapplypatch";
1512	if (($debsrcfmt =~ /^1.*/) && (-x $patch_file)) {
1513	# In that case we need to apply the patches ourselves locally
1514	pb_system("cat $patch_file","APPLY","verbose");
1515	pb_system("$patch_file","Applying patches to $pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'} tree");
1516	}
1517	# ...so modify the name of files to be Debian compliant
1518	move("../$src","../$pbpkg-$pbver$pbextdir.orig.tar.gz");
1519	}
1520
1521	# We need to handle potential additional sources to upstream sources
1522	#pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbsrc/","$ENV{'PBBUILDDIR'}/debian","src");
1523
1524	pb_distro_installdeps("debian/control",$pbos);
1525	pb_system("dpkg-buildpackage -us -uc -rfakeroot","Building package","verbose");
1526	# Get the name of the generated packages
1527	open(LOG,"$ENV{'PBTMP'}/system.$$.log") \|\| die "Unable to open $ENV{'PBTMP'}/system.$$.log";
1528	my $tmp = "";
1529	while (<LOG>) {
1530	chomp();
1531	next unless (/^dpkg-deb.:\s+building\s+package\s+.\s+in\s+\`\.\.\/(\S+)\'\./o);
1532	$tmp = $1;
1533	die "Missing file $tmp" if (not -f $tmp);
1534	$made = "$made $tmp";
1535	}
1536	close(LOG);
1537	open(CTRL,"debian/control") or die "Unable to open debian/control: $!";
1538	#$made="$made $tmp.dsc $tmp.tar.gz $tmp"."_.deb $tmp"."_.changes";
1539	while (<CTRL>) {
1540	next unless (/^Source: (\S+)/o);
1541	foreach my $glob (("$1\_.changes", "$1\_.dsc", "$1\_*.tar.gz")) {
1542	my @file = glob($glob);
1543	die "Missing file for $glob" unless @file > 0;
1544	die "Too many files for $glob" if @file > 1;
1545	die "Missing file $file[0]" if (not -f $file[0]);
1546	$made .= " $file[0]";
1547	}
1548	}
1549	close(CTRL);
1550	pb_display_file("$ENV{'PBTMP'}/system.$$.log");
1551
1552	chdir ".." \|\| die "Unable to chdir to parent dir";
1553	pb_rm_rf("$pbpkg-$pbver");
1554	} elsif ($pbos->{'type'} eq "ebuild") {
1555	my @ebuildfile;
1556	# For gentoo we need to take pb as subsystem name
1557	# We put every apps here under sys-apps. hope it's correct
1558	# We use pb's home dir in order to have a single OVERLAY line
1559	my $tmpe = "$ENV{'HOME'}/portage/pb/sys-apps/$pbpkg";
1560	pb_mkdir_p($tmpe) if (! -d "$tmpe");
1561	pb_mkdir_p("$ENV{'HOME'}/portage/distfiles") if (! -d "$ENV{'HOME'}/portage/distfiles");
1562
1563	# We need to first extract the ebuild file
1564	@ebuildfile = pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/","$tmpe","ebuild");
1565
1566	# Prepare the build env for gentoo
1567	my $found = 0;
1568	my $pbbd = $ENV{'HOME'};
1569	$pbbd =~ s\|/\|\\/\|g;
1570	if (-r "/etc/make.conf") {
1571	open(MAKE,"/etc/make.conf");
1572	while (<MAKE>) {
1573	$found = 1 if (/$pbbd\/portage/);
1574	}
1575	close(MAKE);
1576	}
1577	if ($found == 0) {
1578	pb_system("sudo sh -c 'echo PORTDIR_OVERLAY=\"$ENV{'HOME'}/portage\" >> /etc/make.conf'");
1579	}
1580	#$found = 0;
1581	#if (-r "/etc/portage/package.keywords") {
1582	#open(KEYW,"/etc/portage/package.keywords");
1583	#while (<KEYW>) {
1584	#$found = 1 if (/portage\/pb/);
1585	#}
1586	#close(KEYW);
1587	#}
1588	#if ($found == 0) {
1589	#pb_system("sudo sh -c \"echo portage/pb >> /etc/portage/package.keywords\"");
1590	#}
1591
1592	# Build
1593	foreach my $f (@ebuildfile) {
1594	if ($f =~ /\.ebuild$/) {
1595	pb_distro_installdeps($f,$pbos);
1596	move($f,"$tmpe/$pbpkg-$pbver.ebuild");
1597	pb_system("cd $tmpe ; ebuild $pbpkg-$pbver.ebuild clean ; ebuild $pbpkg-$pbver.ebuild digest ; ebuild $pbpkg-$pbver.ebuild package","verbose");
1598	# Now move it where pb expects it
1599	pb_mkdir_p("$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
1600	if ($pbtag eq 0) {
1601	# This is assumed to be a test version
1602	my $nver = substr($pbver,0,-14);
1603	my $ntag = substr($pbver,-14);
1604	my $ebtg = "portage/pb/sys-apps/$pbpkg/$pbpkg-$nver"."_p$ntag.ebuild";
1605	move("$tmpe/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/$ebtg");
1606	$made="$made $ebtg";
1607	} else {
1608	my $ebtg = "portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver-r$pbtag.ebuild";
1609	move("$tmpe/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/$ebtg");
1610	$made="$made $ebtg";
1611	}
1612	}
1613	}
1614
1615	} elsif ($pbos->{'type'} eq "tgz") {
1616	# Slackware family
1617	$made="$made $pbpkg/$pbpkg-$pbver-*-$pbtag.tgz";
1618
1619	pb_system("tar xfz $src","Extracting sources");
1620	pb_system("tar xfz $src2","Extracting pbconf");
1621	chdir "$pbpkg-$pbver$pbextdir" \|\| die "Unable to chdir to $pbpkg-$pbver$pbextdir";
1622	symlink "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}","install" \|\| die "Unable to symlink to pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
1623	if (-x "install/pbslack") {
1624	pb_distro_installdeps("./install/pbslack",$pbos);
1625	pb_system("./install/pbslack","Building software");
1626	pb_system("sudo /sbin/makepkg -p -l y -c y $pbpkg","Packaging $pbpkg","verbose");
1627	}
1628	chdir ".." \|\| die "Unable to chdir to parent dir";
1629	pb_rm_rf("$pbpkg-$pbver$pbextdir");
1630	} elsif ($pbos->{'type'} eq "pkg") {
1631	# Solaris
1632	$made="$made $pbpkg-$pbver-$pbtag.pkg.gz";
1633	my $pkgdestdir="$ENV{'PBBUILDDIR'}/install";
1634
1635	# Will host resulting packages
1636	pb_mkdir_p("$pbos->{'type'}");
1637	pb_mkdir_p("$pkgdestdir/delivery");
1638	pb_system("tar xfz $src","Extracting sources under $ENV{'PBBUILDDIR'}");
1639	pb_system("tar xfz $src2","Extracting pbconf under $ENV{'PBBUILDDIR'}");
1640	# We need to handle potential patches to upstream sources
1641	pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbpatch/","$ENV{'PBBUILDDIR'}","patch");
1642
1643	# We need to handle potential additional sources to upstream sources
1644	pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbsrc/","$ENV{'PBBUILDDIR'}","src");
1645
1646	chdir "$pbpkg-$pbver$pbextdir" \|\| die "Unable to chdir to $pbpkg-$pbver$pbextdir";
1647	if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild") {
1648	chmod 0755,"pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild";
1649	# pkginfo file is mandatory
1650	die "Unable to find pkginfo file in pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}" if (! -f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pkginfo");
1651	# Build
1652	pb_system("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild $pkgdestdir/delivery","Building software and installing under $pkgdestdir/delivery");
1653	# Copy complementary files
1654	if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/prototype") {
1655	copy("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/prototype", $pkgdestdir)
1656	} else {
1657	# No prototype provided, calculating it
1658	open(PROTO,"> $pkgdestdir/prototype") \|\| die "Unable to create prototype file";
1659	print PROTO "i pkginfo\n";
1660	print PROTO "i depend\n" if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/depend");
1661	$ENV{'PBSOLDESTDIR'} = "$pkgdestdir/delivery";
1662	find(\&create_solaris_prototype, "$pkgdestdir/delivery");
1663	}
1664	copy("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/depend", $pkgdestdir) if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/depend");
1665	copy("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pkginfo", $pkgdestdir);
1666	pb_system("cd $pkgdestdir/delivery ; pkgmk -o -f ../prototype -r $pkgdestdir/delivery -d $ENV{'PBBUILDDIR'}/$pbos->{'type'}","Packaging $pbpkg","verbose");
1667	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");
1668	pb_system("cd $ENV{'PBBUILDDIR'} ; gzip -9f $pbpkg-$pbver-$pbtag.pkg","Compressing $pbpkg-$pbver-$pbtag.pkg","verbose");
1669	} else {
1670	pb_log(0,"No pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild file found for $pbpkg-$pbver in \n");
1671	}
1672	chdir ".." \|\| die "Unable to chdir to parent dir";
1673	pb_rm_rf("$pbpkg-$pbver$pbextdir","$ENV{'PBBUILDDIR'}/$pbos->{'type'}","$pkgdestdir");
1674	} elsif ($pbos->{'type'} eq "hpux") {
1675	# HP-UX
1676	pb_system("tar xfz $src","Extracting sources");
1677	pb_system("tar xfz $src2","Extracting pbconf");
1678
1679	chdir "$pbpkg-$pbver$pbextdir" \|\| die "Unable to chdir to $pbpkg-$pbver$pbextdir";
1680	pb_system("buildpackage ","Building package","verbose");
1681	# Get the name of the generated packages
1682	open(LOG,"$ENV{'PBTMP'}/system.$$.log") \|\| die "Unable to open $ENV{'PBTMP'}/system.$$.log";
1683	while (<LOG>) {
1684	chomp();
1685	my $tmp = $_;
1686	next if ($tmp !~ /^SD BUILD.*:/);
1687	$tmp =~ s\|.../(.)_(.).sd.\|$1\|;
1688	$made = "$made $tmp"."_*.sd";
1689	}
1690	close(LOG);
1691	$made="$made $pbpkg-$pbver-$pbtag.sd";
1692
1693	chdir ".." \|\| die "Unable to chdir to parent dir";
1694	pb_rm_rf("$pbpkg-$pbver$pbextdir");
1695	} else {
1696	die "Unknown OS type format $pbos->{'type'}";
1697	}
1698	if (defined $pbparallel) {
1699	# Communicate results back to parent
1700	pb_set_content("$tmpd/$$",$made);
1701	$pm->finish;
1702	}
1703	}
1704	if (defined $pbparallel) {
1705	# In the parent, we need to get the result from the children
1706	$pm->wait_all_children;
1707	foreach my $f (<$tmpd/*>) {
1708	$made .= " ".pb_get_content($f);
1709	}
1710	die "Aborting, one or more of the children failed." if ((not $all_ok) && ($Global::pb_stop_on_error));
1711	pb_rm_rf($tmpd);
1712	}
1713
1714	# Sign packages
1715	pb_sign_pkgs($pbos,$made);
1716
1717	# Find the appropriate check cmd/opts
1718	my ($chkcmd,$chkopt) = pb_distro_get_param($pbos,pb_conf_get_if("oschkcmd","oschkopt"));
1719
1720	# Packages check if needed
1721	if ($pbos->{'type'} eq "rpm") {
1722	if ((defined $chkcmd) && (-x $chkcmd)) {
1723	my $cmd = "$chkcmd";
1724	$cmd .= " $chkopt" if (defined $chkopt);
1725	$cmd .= " $made";
1726	my $ret = pb_system("$cmd","Checking validity of rpms with $chkcmd","verbose",1);
1727	pb_log(0,"ERROR: when checking packages validity\n") if ($ret ne 0);
1728	}
1729	my $rpms ="";
1730	my $srpms ="";
1731	foreach my $f (split(/ /,$made)) {
1732	$rpms .= "$ENV{'PBBUILDDIR'}/$f " if ($f =~ /^RPMS\//);
1733	$srpms .= "$ENV{'PBBUILDDIR'}/$f " if ($f =~ /^SRPMS\//);
1734	}
1735	pb_log(0,"SRPM packages generated: $srpms\n");
1736	pb_log(0,"RPM packages generated: $rpms\n");
1737	} elsif ($pbos->{'type'} eq "deb") {
1738	my $made2 = "";
1739	foreach my $f (split(/ /,$made)) {
1740	$made2 .= "$f " if ($f =~ /\.deb$/);
1741	}
1742	if (-x $chkcmd) {
1743	my $ret = pb_system("$chkcmd $chkopt $made2","Checking validity of debs with $chkcmd","verbose",1);
1744	pb_log(0,"ERROR: when checking packages validity\n") if ($ret ne 0);
1745	}
1746	pb_log(0,"deb packages generated: $made2\n");
1747	} else {
1748	pb_log(0,"No check done for $pbos->{'type'} yet\n");
1749	pb_log(0,"Packages generated: $made\n");
1750	}
1751
1752	# Keep track of what is generated so that we can get them back from VMs/RMs
1753	my $pbkeep = "$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}-$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
1754	open(KEEP,"> $pbkeep") \|\| die "Unable to create $pbkeep: $!";
1755	print KEEP "$made\n";
1756	close(KEEP);
1757	pb_log(0,"INFO: ------ Finished building package ------\n");
1758	}
1759
1760	sub create_solaris_prototype {
1761
1762	my $uidgid = "bin bin";
1763	my $pkgdestdir = $ENV{'PBSOLDESTDIR'};
1764
1765	return if ($_ =~ /^$pkgdestdir$/);
1766	if (-d $_) {
1767	my $n = $File::Find::name;
1768	$n =~ s~$pkgdestdir/~~;
1769	print PROTO "d none $n 0755 $uidgid\n";
1770	} elsif (-x $_) {
1771	my $n = $File::Find::name;
1772	$n =~ s~$pkgdestdir/~~;
1773	print PROTO "f none $n 0755 $uidgid\n";
1774	} elsif (-f $_) {
1775	my $n = $File::Find::name;
1776	$n =~ s~$pkgdestdir/~~;
1777	print PROTO "f none $n 0644 $uidgid\n";
1778	}
1779	}
1780
1781	sub pb_build2ssh {
1782	pb_send2target("Sources");
1783	pb_send2target("CPAN");
1784	}
1785
1786	sub pb_pkg2ssh {
1787	pb_send2target("Packages");
1788	}
1789
1790	# By default deliver to the the public site hosting the
1791	# ftp structure (or whatever) or a VM/VE/RM
1792	sub pb_send2target {
1793
1794	my $cmt = shift;
1795	my $v = shift \|\| undef;
1796	my $vmexist = shift \|\| 0; # 0 is FALSE
1797	my $vmpid = shift \|\| 0; # 0 is FALSE
1798	my $snapme = shift \|\| 0; # 0 is FALSE
1799
1800	pb_log(2,"DEBUG: pb_send2target($cmt,".Dumper($v).",$vmexist,$vmpid)\n");
1801	my $host = "sshhost";
1802	my $login = "sshlogin";
1803	my $dir = "sshdir";
1804	my $port = "sshport";
1805	my $conf = "sshconf";
1806	my $tmout = undef;
1807	my $path = undef;
1808	if ($cmt =~ /^VM/) {
1809	$login = "vmlogin";
1810	$dir = "pbdefdir";
1811	# Specific VM
1812	$tmout = "vmtmout";
1813	$path = "vmpath";
1814	$host = "vmhost";
1815	$port = "vmport";
1816	} elsif ($cmt =~ /^RM/) {
1817	$login = "rmlogin";
1818	$dir = "pbdefdir";
1819	# Specific RM
1820	$tmout = "rmtmout";
1821	$path = "rmpath";
1822	$host = "rmhost";
1823	$port = "rmport";
1824	} elsif ($cmt =~ /^VE/) {
1825	$login = "velogin";
1826	$dir = "pbdefdir";
1827	# Specific VE
1828	$path = "vepath";
1829	$conf = "rbsconf";
1830	} elsif ($cmt eq "Web") {
1831	$host = "websshhost";
1832	$login = "websshlogin";
1833	$dir = "websshdir";
1834	$port = "websshport";
1835	} elsif ($cmt eq "CPAN") {
1836	$host = "cpanpause";
1837	$login = "";
1838	$dir = "cpandir";
1839	$port = "";
1840	}
1841	my $cmd = "";
1842	my $src = "";
1843	my $cpanpkg = 0;
1844	my $pbos;
1845
1846	my $pbextdir = pb_get_extdir();
1847
1848	if ($cmt ne "Announce") {
1849	# Get list of packages to build
1850	my $ptr = pb_get_pkg();
1851	@pkgs = @$ptr;
1852
1853	# Get the running distro to consider
1854	$pbos = pb_distro_get_context($v);
1855
1856	# Get content saved in cms2build
1857	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1858	$pkg = { } if (not defined $pkg);
1859
1860	pb_mkdir_p("$ENV{'PBBUILDDIR'}") if (! -d "$ENV{'PBBUILDDIR'}");
1861	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1862	foreach my $pbpkg (@pkgs) {
1863	my $vertag = $pkg->{$pbpkg};
1864	# get the version of the current package - maybe different
1865	pb_log(2,"Vertag: $vertag\n");
1866	($pbver,$pbtag) = split(/-/,$vertag);
1867
1868	if (($cmt eq "Sources") \|\| ($cmt =~ /(V[EM]\|RM)build/)) {
1869	$src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.tar.gz $ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.pbconf.tar.gz";
1870	if ($cmd eq "") {
1871	$cmd = "ln -sf $pbpkg-$pbver$pbextdir.tar.gz $pbpkg-latest.tar.gz";
1872	} else {
1873	$cmd = "$cmd ; ln -sf $pbpkg-$pbver$pbextdir.tar.gz $pbpkg-latest.tar.gz";
1874	}
1875	} elsif ($cmt eq "Web") {
1876	$src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.tar.gz"
1877	}
1878
1879	# Do we have one perl package
1880	my @nametype = pb_conf_get_if("namingtype");
1881	my $type = $nametype[0]->{$pbpkg};
1882	if ((defined $type) && ($type eq "perl")) {
1883	$cpanpkg = 1;
1884	}
1885	}
1886	# Adds conf file for availability of conf elements
1887	pb_conf_add("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb");
1888	}
1889	my ($rbsconf,$testver,$delivery) = pb_conf_get_if($conf,"testver","delivery");
1890	if ($cmt =~ /CPAN/) {
1891	# Do not deliver on Pause if this is a test version
1892	return if (not defined $testver);
1893	return if ($testver =~ /true/);
1894	# Do not deliver on Pause if this is not a perl package
1895	return if ($cpanpkg == 0);
1896	}
1897
1898	if ($cmt =~ /(V[EM]\|RM)build/) {
1899	$src="$src $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc $ENV{'PBDESTDIR'}/pbscript.$$";
1900	} elsif ($cmt =~ /(V[EM]\|RM)Script/) {
1901	$src="$src $ENV{'PBDESTDIR'}/pbscript.$$";
1902	} elsif ($cmt =~ /(V[EM]\|RM)test/) {
1903	$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";
1904	} elsif (($cmt eq "Announce") \|\| ($cmt eq "Web") \|\| ($cmt eq "CPAN")) {
1905	$src="$src $ENV{'PBTMP'}/pbscript";
1906	} elsif ($cmt eq "Packages") {
1907	# Get package list from file made during build2pkg
1908	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'}";
1909	$src = <KEEP>;
1910	chomp($src);
1911	close(KEEP);
1912	$src = "$src $ENV{'PBBUILDDIR'}/pbscript.$$";
1913	}
1914	if (($cmt eq "Sources") \|\| ($cmt eq "Packages") \|\| ($cmt eq "CPAN")) {
1915	my ($pbpackager) = pb_conf_get("pbpackager");
1916	$ENV{'PBPACKAGER'} = $pbpackager->{$ENV{'PBPROJ'}};
1917	pb_log(0,"Exporting public key for $ENV{'PBPACKAGER'}\n");
1918	# Using pb_system is not working due to redirection below
1919	system("gpg --export -a \'$ENV{'PBPACKAGER'}\' > $ENV{'PBDESTDIR'}/$ENV{'PBPROJ'}.pubkey");
1920	chmod 0644,"$ENV{'PBDESTDIR'}/$ENV{'PBPROJ'}.pubkey";
1921	$src = "$src $ENV{'PBDESTDIR'}/$ENV{'PBPROJ'}.pubkey";
1922	}
1923	# Remove potential leading spaces (cause problem with basename)
1924	$src =~ s/^ *//;
1925	my $basesrc = "";
1926	foreach my $i (split(/ +/,$src)) {
1927	$basesrc .= " ".basename($i);
1928	}
1929
1930	pb_log(0,"Sources handled ($cmt): $src\n");
1931	pb_log(2,"values: ".Dumper(($host,$login,$dir,$port,$tmout,$path,$conf))."\n");
1932	my ($sshhost,$sshdir) = pb_conf_get($host,$dir);
1933	# Not mandatory...
1934	$delivery->{$ENV{'PBPROJ'}} = "" if (not defined $delivery->{$ENV{'PBPROJ'}});
1935	my ($sshlogin,$sshport) = pb_conf_get_if($login,$port);
1936	$sshport->{$ENV{PBPROJ}} = 22 unless (defined $sshport->{$ENV{PBPROJ}});
1937	$sshlogin->{$ENV{PBPROJ}} = getpwuid($UID) unless (defined $sshlogin->{$ENV{PBPROJ}});
1938	my ($vtmout,$vepath);
1939	# ...Except those in virtual context
1940	if ($cmt =~ /^VE/) {
1941	($vepath) = pb_conf_get($path);
1942	}
1943	if ($cmt =~ /^(V\|R)M/) {
1944	$vtmout = pb_distro_get_param($pbos,pb_conf_get_if($tmout));
1945	}
1946	my $remhost = $sshhost->{$ENV{'PBPROJ'}};
1947	my $remdir = $sshdir->{$ENV{'PBPROJ'}};
1948	if ($cmt =~ /^V[EM]\|RM/) {
1949	# In that case our real host is in the xxhost with the OS as key, not project as above
1950	$remhost = pb_distro_get_param($pbos,$sshhost);
1951	}
1952	pb_log(2,"ssh: ".Dumper(($remhost,$sshlogin,$remdir,$sshport,$vepath,$rbsconf))."\n");
1953	pb_log(2,"ssh: ".Dumper($vtmout)."\n") if (defined $vtmout);
1954
1955	my $mac;
1956	if ($cmt !~ /^VE/) {
1957	$mac = "$sshlogin->{$ENV{'PBPROJ'}}\@$remhost";
1958	# Overwrite account value if passed as parameter
1959	$mac = "$pbaccount\@$remhost" if (defined $pbaccount);
1960	pb_log(2, "DEBUG: pbaccount: $pbaccount => mac: $mac\n") if (defined $pbaccount);
1961	} else {
1962	# VE
1963	# Overwrite account value if passed as parameter (typically for setup2v)
1964	$mac = $sshlogin->{$ENV{'PBPROJ'}};
1965	$mac = $pbaccount if (defined $pbaccount);
1966	}
1967
1968	my $tdir;
1969	my $bdir;
1970	if (($cmt eq "Sources") \|\| ($cmt =~ /(V[EM]\|RM)Script/)) {
1971	$tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}/src";
1972	} elsif ($cmt eq "CPAN") {
1973	$tdir = "$remdir";
1974	} elsif ($cmt =~ /(V[EM]\|RM)(build\|test)/) {
1975	$tdir = $remdir."/$ENV{'PBPROJ'}/delivery";
1976	$bdir = $remdir."/$ENV{'PBPROJ'}/build";
1977	# Remove a potential $ENV{'HOME'} as bdir should be relative to pb's home
1978	$bdir =~ s\|\$ENV.+\}/\|\|;
1979	} elsif ($cmt eq "Announce") {
1980	$tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}";
1981	} elsif ($cmt eq "Web") {
1982	$tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}";
1983	} elsif ($cmt eq "Packages") {
1984	if (($pbos->{'type'} eq "rpm") \|\| ($pbos->{'type'} eq "pkg") \|\| ($pbos->{'type'} eq "hpux") \|\| ($pbos->{'type'} eq "tgz")) {
1985	# put packages under an arch subdir
1986	$tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}";
1987	} elsif (($pbos->{'type'} eq "deb") \|\| ($pbos->{'type'} eq "ebuild")) {
1988	# No need for an arch subdir
1989	$tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}";
1990	} else {
1991	die "Please teach the dev team where to deliver ($pbos->{'type'} type of packages\n";
1992	}
1993
1994	my $repodir = $tdir;
1995	$repodir =~ s\|^$remdir/\|\|;
1996
1997	my ($pbrepo) = pb_conf_get("pbrepo");
1998
1999	# Repository management
2000	open(PBS,"> $ENV{'PBBUILDDIR'}/pbscript.$$") \|\| die "Unable to create $ENV{'PBBUILDDIR'}/pbscript.$$";
2001	if ($pbos->{'type'} eq "rpm") {
2002	my $pbsha = pb_distro_get_param($pbos,pb_conf_get("ossha"));
2003	# Also make a pbscript to generate yum/urpmi bases
2004	print PBS << "EOF";
2005	#!/bin/bash
2006	# Prepare a script to ease yum setup
2007	EOF
2008	print PBS "set -x\n" if ($pbdebug gt 1);
2009	print PBS << "EOF";
2010	cat > $ENV{'PBPROJ'}.repo << EOT
2011	[$ENV{'PBPROJ'}]
2012	name=$pbos->{'name'} $pbos->{'version'} $pbos->{'arch'} - $ENV{'PBPROJ'} Vanilla Packages
2013	baseurl=$pbrepo->{$ENV{'PBPROJ'}}/$repodir
2014	enabled=1
2015	gpgcheck=1
2016	gpgkey=$pbrepo->{$ENV{'PBPROJ'}}/$repodir/$ENV{'PBPROJ'}.pubkey
2017	EOT
2018	chmod 644 $ENV{'PBPROJ'}.repo
2019
2020	# Clean up old repo content
2021	rm -rf headers/ repodata/
2022	# Create yum repo
2023	if [ -x /usr/bin/yum-arch ]; then
2024	yum-arch .
2025	fi
2026	# Create repodata
2027	createrepo -s $pbsha .
2028	# Link to the key
2029	(cd repodata ; ln -sf ../$ENV{'PBPROJ'}.pubkey repomd.xml.key)
2030	# sign the repomd (at least useful for SLES - which requires a local key)
2031	# gpg -a --detach-sign repodata/repomd.xml
2032	# SLES also looks for media.1/info.txt
2033	EOF
2034	if ($pbos->{'family'} eq "md") {
2035	# For Mandriva add urpmi management
2036	print PBS << "EOF";
2037	# Prepare a script to ease urpmi setup
2038	cat > $ENV{'PBPROJ'}.addmedia << EOT
2039	urpmi.addmedia $ENV{'PBPROJ'} $pbrepo->{$ENV{'PBPROJ'}}/$repodir with media_info/hdlist.cz
2040	EOT
2041	chmod 755 $ENV{'PBPROJ'}.addmedia
2042
2043	# Clean up old repo content
2044	rm -f hdlist.cz synthesis.hdlist.cz
2045	# Create urpmi repo
2046	genhdlist2 --clean .
2047	if [ \$\? -ne 0 ]; then
2048	genhdlist .
2049	fi
2050	EOF
2051	}
2052	if ($pbos->{'name'} eq "fedora") {
2053	# Extract the spec file to please Fedora maintainers :-(
2054	print PBS << "EOF";
2055	for p in $basesrc; do
2056	echo \$p \| grep -q 'src.rpm'
2057	if [ \$\? -eq 0 ]; then
2058	rpm2cpio \$p \| cpio -ivdum --quiet '*.spec'
2059	fi
2060	done
2061	EOF
2062	}
2063	if ($pbos->{'family'} eq "novell") {
2064	# Add ymp scripts for one-click install on SuSE
2065	print PBS << "EOF";
2066	# Prepare a script to ease SuSE one-click install
2067	# Cf: http://de.opensuse.org/1-Klick-Installation/ISV
2068	#
2069	cat > $ENV{'PBPROJ'}.ymp << EOT
2070	<?xml version="1.0" encoding="utf-8"?>
2071	<!-- vim: set sw=2 ts=2 ai et: -->
2072	<metapackage xmlns:os="http://opensuse.org/Standards/One_Click_Install" xmlns="http://opensuse.org/Standards/One_Click_Install">
2073	<group><!-- The group of software, typically one for project-builder.org -->
2074	<name>$ENV{'PBPROJ'} Bundle</name> <!-- Name of the software group -->
2075	<summary>Software bundle for the $ENV{'PBPROJ'} project</summary> <!--This message is shown to the user and should describe the whole bundle -->
2076	<description>This is the summary of the $ENV{'PBPROJ'} Project
2077
2078	Details are available on a per package basis below
2079
2080	</description><!--This is also shown to the user -->
2081	<remainSubscribed>false</remainSubscribed> <!-- Don't know what it mean -->
2082	<repositories><!-- List of needed repositories -->
2083	<repository>
2084	<name>$ENV{'PBPROJ'} Repository</name> <!-- Name of the repository -->
2085	<summary>This repository contains the $ENV{'PBPROJ'} project packages.</summary> <!-- Summary of the repository -->
2086	<description>This repository contains the $ENV{'PBPROJ'} project packages.</description><!-- This description is shown to the user -->
2087	<url>$pbrepo->{$ENV{'PBPROJ'}}/$repodir</url><!--URL of repository, which is added -->
2088	</repository>
2089	</repositories>
2090	<software><!-- A List of packages, which should be added through the one-click-installation -->
2091	EOT
2092	for p in $basesrc; do
2093	sum=`rpm -q --qf '%{SUMMARY}' \$p`
2094	name=`rpm -q --qf '%{NAME}' \$p`
2095	desc=`rpm -q --qf '%{description}' \$p`
2096	cat >> $ENV{'PBPROJ'}.ymp << EOT
2097	<item>
2098	<name>\$name</name><!-- Name of the package, is shown to the user and used to identify the package at the repository -->
2099	<summary>\$sum</summary> <!-- Summary of the package -->
2100	<description>\$desc</description> <!-- Description, is shown to the user -->
2101	</item>
2102	EOT
2103	done
2104	cat >> $ENV{'PBPROJ'}.ymp << EOT
2105	</software>
2106	</group>
2107	</metapackage>
2108	EOT
2109	chmod 644 $ENV{'PBPROJ'}.ymp
2110	EOF
2111	}
2112	} elsif ($pbos->{'type'} eq "deb") {
2113	# Also make a pbscript to generate apt bases
2114	# Cf: http://www.debian.org/doc/manuals/repository-howto/repository-howto.fr.html
2115	# This dirname removes ver
2116	my $debarch = $pbos->{'arch'};
2117	$debarch = "amd64" if ($pbos->{'arch'} eq "x86_64");
2118	my $rpd = dirname("$pbrepo->{$ENV{'PBPROJ'}}/$repodir");
2119	# Remove extra . in path to fix #522
2120	$rpd =~ s\|/./\|/\|g;
2121	print PBS << "EOF";
2122	#!/bin/bash
2123	# Prepare a script to ease apt setup
2124	cat > $ENV{'PBPROJ'}.sources.list << EOT
2125	deb $rpd $pbos->{'version'} contrib
2126	deb-src $rpd $pbos->{'version'} contrib
2127	EOT
2128	chmod 644 $ENV{'PBPROJ'}.sources.list
2129
2130	# Up two levels to deal with the dist dir cross versions
2131	cd ..
2132	mkdir -p dists/$pbos->{'version'}/contrib/binary-$debarch dists/$pbos->{'version'}/contrib/source
2133
2134	# Prepare a script to create apt info file
2135	# Reuse twice after
2136	TMPD=`mktemp -d /tmp/pb.XXXXXXXXXX` \|\| exit 1
2137	mkdir -p \$TMPD
2138	cat > \$TMPD/Release << EOT
2139	Archive: unstable
2140	Component: contrib
2141	Origin: $ENV{'PBPROJ'}
2142	Label: $ENV{'PBPROJ'} dev repository $pbrepo->{$ENV{'PBPROJ'}}
2143	EOT
2144
2145	echo "Creating Packages metadata ($pbos->{'arch'} aka $debarch)"
2146	dpkg-scanpackages -a$debarch $pbos->{'version'} /dev/null \| gzip -c9 > dists/$pbos->{'version'}/contrib/binary-$debarch/Packages.gz
2147	dpkg-scanpackages -a$debarch $pbos->{'version'} /dev/null \| bzip2 -c9 > dists/$pbos->{'version'}/contrib/binary-$debarch/Packages.bz2
2148	echo "Creating Contents metadata"
2149	apt-ftparchive contents $pbos->{'version'} \| gzip -c9 > dists/$pbos->{'version'}/Contents.gz
2150	echo "Creating Release metadata ($pbos->{'arch'} aka $debarch)"
2151	cat \$TMPD/Release > dists/$pbos->{'version'}/contrib/binary-$debarch/Release
2152	echo "Architecture: $debarch" >> dists/$pbos->{'version'}/contrib/binary-$debarch/Release
2153	echo "Creating Source metadata"
2154	dpkg-scansources $pbos->{'version'} /dev/null \| gzip -c9 > dists/$pbos->{'version'}/contrib/source/Sources.gz
2155	cat \$TMPD/Release > dists/$pbos->{'version'}/contrib/source/Release
2156	echo "Architecture: Source" >> dists/$pbos->{'version'}/contrib/source/Release
2157	echo "Creating Release metadata"
2158	# Signing that file would be useful but uneasy as gpg keys are not there
2159	# Cf: http://wiki.debian.org/SecureApt
2160	# Same as for repomd
2161	apt-ftparchive release dists/$pbos->{'version'} > dists/$pbos->{'version'}/Release
2162	rm -rf \$TMPD
2163	EOF
2164	} elsif ($pbos->{'type'} eq "ebuild") {
2165	# make a pbscript to generate links to latest version
2166	print PBS << "EOF";
2167	#!/bin/bash
2168	# Prepare a script to create correct links
2169	for p in $src; do
2170	echo \$p \| grep -q '.ebuild'
2171	if [ \$\? -eq 0 ]; then
2172	j=`basename \$p`
2173	pp=`echo \$j \| cut -d'-' -f1`
2174	ln -sf \$j \$pp.ebuild
2175	fi
2176	done
2177	EOF
2178	}
2179	close(PBS);
2180	chmod 0755,"$ENV{'PBBUILDDIR'}/pbscript.$$";
2181	} else {
2182	return;
2183	}
2184
2185	# Useless for VE
2186	my $nport = pb_get_port($sshport,$pbos,$cmt) if ($cmt !~ /^VE/);
2187
2188	# Remove a potential $ENV{'HOME'} as tdir should be relative to pb's home
2189	$tdir =~ s\|\$ENV.+\}/\|\|;
2190
2191	my $tm = "";
2192	if ($cmt =~ /^(V\|R)M/) {
2193	$tm = "sleep $vtmout" if (defined $vtmout);
2194	}
2195
2196	# ssh communication if not VE or CPAN
2197	# should use a hash instead...
2198	my ($shcmd,$shcmdroot,$cpcmd,$cptarget,$cp2target);
2199	if ($cmt =~ /^VE/) {
2200	my $tp = pb_path_expand($vepath->{$ENV{'PBPROJ'}});
2201	my $tpdir = pb_path_expand("$tp/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}");
2202	my ($ptr) = pb_conf_get("vetype");
2203	my $vetype = $ptr->{$ENV{'PBPROJ'}};
2204	my $arch = pb_get_arch();
2205	if ($vetype eq "chroot") {
2206	$shcmdroot = "sudo /usr/sbin/chroot $tpdir ";
2207	$shcmd = "$shcmdroot /bin/su - $mac -c ";
2208	} elsif ($vetype eq "schroot") {
2209	$shcmd = "schroot $tp -u $mac -- ";
2210	}
2211	$shcmd = "setarch i386 $shcmd" if (($pbos->{'arch'} =~ /i?86/) && ($arch eq 'x86_64'));
2212	$cpcmd = "sudo /bin/cp -r ";
2213	# We need to get the home dir of the target account to deliver in the right place
2214	open(PASS,"$tpdir/etc/passwd") \|\| die "Unable to open $tpdir/etc/passwd: $!";
2215	my $homedir = "";
2216	while (<PASS>) {
2217	my ($c1,$c2,$c3,$c4,$c5,$c6,$c7) = split(/:/);
2218	$homedir = $c6 if ($c1 =~ /^$mac$/);
2219	pb_log(3,"Homedir: $homedir - account: $c6\n");
2220	}
2221	close(PASS);
2222	$cptarget = "$tpdir/$homedir/$tdir";
2223	if ($cmt eq "VEbuild") {
2224	$cp2target = "$tpdir/$homedir/$bdir";
2225	}
2226	pb_log(2,"On VE using $cptarget as target dir to copy to\n");
2227	} elsif ($cmt =~ /^CPAN/) {
2228	my $ftpput = pb_check_req("ncftpput",1);
2229	my $ftpget = pb_check_req("wget",1);
2230	my ($cpanuser,$cpanpasswd) = pb_conf_get("cpanuser","cpanpasswd");
2231	my ($cpansubdir) = pb_conf_get_if("cpansubdir");
2232	$shcmd = "$ftpget --post-data \'HIDDENNAME=".$cpanuser;
2233	$shcmd .= "&user=".$cpanuser;
2234	$shcmd .= "&password=".$cpanpasswd;
2235	$shcmd .= "&SUBMIT_pause99_add_uri_upload=\"Upload the checked files\"";
2236	$shcmd .= "&pause99_add_uri_subdirtext=".$cpansubdir if (defined $cpansubdir);
2237	foreach my $s (split(/ /,$src)) {
2238	$shcmd .= "&pause99_add_uri_upload=".basename($s);
2239	}
2240	$shcmd .= "'";
2241	$cpcmd = "$ftpput $host $dir";
2242	$cptarget = "CPAN";
2243	} else {
2244	my $keyfile = pb_ssh_get(0);
2245	my $keyopt = defined $keyfile ? "-i $keyfile" : "";
2246	my $sshcmd = pb_check_req("ssh",1);
2247	my $scpcmd = pb_check_req("scp",1);
2248	$shcmd = "$sshcmd $keyopt -q -o NoHostAuthenticationForLocalhost=yes -p $nport $mac";
2249	$cpcmd = "$scpcmd $keyopt -p -o NoHostAuthenticationForLocalhost=yes -P $nport";
2250	$cptarget = "$mac:$tdir";
2251	if ($cmt =~ /^(V\|R)Mbuild/) {
2252	$cp2target = "$mac:$bdir";
2253	}
2254	}
2255
2256	my $logres = "";
2257	# Do not touch when just announcing
2258	if (($cmt ne "Announce") && ($cmt ne "CPAN")) {
2259	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");
2260	} else {
2261	$logres = "> ";
2262	}
2263	pb_system("cd $ENV{'PBBUILDDIR'} ; $cpcmd $src $cptarget 2> /dev/null","$cmt delivery in $cptarget");
2264
2265	# For VE we need to change the owner manually
2266	if ($cmt =~ /^VE/) {
2267	if (defined $shcmdroot) {
2268	# This should help overcome a CentOS 5.8 bug as well as having a simper sequence
2269	pb_system("$shcmdroot \"chown -R $mac $tdir\"","Adapt owner in $tdir to $mac");
2270	} else {
2271	pb_system("$shcmd \"sudo chown -R $mac $tdir\"","Adapt owner in $tdir to $mac");
2272	}
2273	}
2274
2275	# Use the right script name depending on context
2276	my $pbscript;
2277	if (($cmt =~ /^(V[EM]\|RM)/) \|\| ($cmt =~ /Packages/)){
2278	$pbscript = "pbscript.$$";
2279	} else {
2280	$pbscript = "pbscript";
2281	}
2282
2283	# It's already ready for CPAN
2284	my $shcmdbase = $shcmd;
2285	if ($cmt !~ /^CPAN/) {
2286	$shcmd .= " \"echo \'cd $tdir ; if [ -x $pbscript ]; then ./$pbscript; fi ; rm -f ./$pbscript\' \| bash\"";
2287	}
2288	my $cmdverb = "verbose";
2289	if (($cmt eq "Announce") \|\| ($cmt eq "CPAN")) {
2290	$cmdverb = undef;
2291	}
2292	pb_system("$shcmd","Executing pbscript on $cptarget if needed",$cmdverb);
2293	if ($cmt =~ /^(V[EM]\|RM)build/) {
2294	# Get back info on pkg produced, compute their name and get them from the VM/RM
2295	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");
2296	# For VE we need to change the owner manually
2297	if ($cmt eq "VEbuild") {
2298	pb_system("sudo chown $UID $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$","Adapt owner in $tdir to $UID");
2299	}
2300	if (not -f "$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$") {
2301	pb_log(0,"Problem with VM/RM $v on $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$");
2302	} else {
2303	open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$") \|\| die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$";
2304	my $src = <KEEP>;
2305	chomp($src);
2306	close(KEEP);
2307	unlink("$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$");
2308
2309	$src =~ s/^ *//;
2310	pb_mkdir_p("$ENV{'PBBUILDDIR'}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}");
2311	# Change pgben to make the next send2target happy
2312	my $made = "";
2313
2314	# For VM/RM we don't want shell expansion to hapen locally but remotely
2315	my $delim = '\'';
2316	if ($cmt =~ /^VEbuild/) {
2317	# For VE we need to support shell expansion locally
2318	$delim = "";
2319	}
2320
2321	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'}";
2322	foreach my $p (split(/ +/,$src)) {
2323	my $j = basename($p);
2324	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'}");
2325	$made="$made $pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/$j"; # if (($pbos->{'type'} ne "rpm") \|\| ($j !~ /.src.rpm$/));
2326	}
2327	print KEEP "$made\n";
2328	close(KEEP);
2329	pb_system("$shcmdbase \"rm -rf $tdir $bdir\"","$cmt cleanup");
2330
2331	# Sign packages locally
2332	pb_sign_pkgs($pbos,$made);
2333
2334	# We want to send them to the ssh account so overwrite what has been done before
2335	undef $pbaccount;
2336	pb_log(2,"Before sending pkgs, vmexist: $vmexist, vmpid: $vmpid\n");
2337	pb_send2target("Packages",$pbos->{'name'}."-".$pbos->{'version'}."-".$pbos->{'arch'},$vmexist,$vmpid);
2338	pb_rm_rf("$ENV{'PBBUILDDIR'}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}");
2339	}
2340	}
2341	unlink("$ENV{'PBDESTDIR'}/pbscript.$$") if ((($cmt =~ /^(V[ME]\|RM)/) \|\| ($cmt =~ /Packages/)) && ($pbkeep eq 0));
2342
2343	pb_log(2,"Before halt, vmexist: $vmexist, vmpid: $vmpid\n");
2344	if ((! $vmexist) && ($cmt =~ /^VM/)) {
2345	# If in setupvm then takes a snapshot just before halting
2346	if ($snapme != 0) {
2347	my ($vmmonport,$vmtype) = pb_conf_get("vmmonport","vmtype");
2348	# For monitoring control
2349	if ((($vmtype->{$ENV{'PBPROJ'}}) eq "kvm") \|\| (($vmtype->{$ENV{'PBPROJ'}}) eq "qemu")) {
2350	eval
2351	{
2352	require Net::Telnet;
2353	Net::Telnet->import();
2354	};
2355	if ($@) {
2356	# Net::Telnet not found
2357	pb_log(1,"ADVISE: Install Net::Telnet to benefit from monitoring control and snapshot feature.\nWARNING: No snapshot created");
2358	} else {
2359	my $t = new Net::Telnet (Timeout => 120, Host => "localhost", Port => $vmmonport->{$ENV{'PBPROJ'}}) \|\| die "Unable to dialog on the monitor";
2360	# move to monitor mode
2361	my @lines = $t->cmd("c");
2362	# Create a snapshot named pb
2363	@lines = $t->cmd("savevm pb");
2364	# Write the new status in the VM
2365	@lines = $t->cmd("commit all");
2366	# End
2367	@lines = $t->cmd("quit");
2368	}
2369	}
2370	}
2371	my $hoption = "-p";
2372	my $hpath = pb_distro_get_param($pbos,pb_conf_get("ospathcmd-halt"));
2373	# Solaris doesn't support -p of halt
2374	if ($pbos->{'type'} eq "pkg") {
2375	$hoption = "" ;
2376	}
2377	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)");
2378	}
2379	if (($cmt =~ /^VE/) && ($snapme != 0)) {
2380	my $tpdir = "$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}";
2381	pb_system("sudo tar cz -C $tpdir -f $vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}.tar.gz .","Creating a snapshot of $tpdir");
2382	}
2383	}
2384
2385	sub pb_script2v {
2386	my $pbscript=shift;
2387	my $vtype=shift;
2388	my $pbforce=shift \|\| 0; # Force stop of VM. Default not.
2389	my $vm1=shift \|\| undef; # Only that VM/VE/RM to treat. Default all.
2390	my $snapme=shift \|\| 0; # Do we have to create a snapshot. Default not.
2391	my $vm;
2392	my $all;
2393
2394	pb_log(2,"DEBUG: pb_script2v($pbscript,$vtype,$pbforce,".Dumper($vm1).",$snapme)\n");
2395	# Prepare the script to be executed on the VM/VE/RM
2396	# in $ENV{'PBDESTDIR'}/pbscript.$$
2397	if ((defined $pbscript ) && ($pbscript ne "$ENV{'PBDESTDIR'}/pbscript.$$")) {
2398	copy($pbscript,"$ENV{'PBDESTDIR'}/pbscript.$$") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript.$$";
2399	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript.$$";
2400	}
2401
2402	if (not defined $vm1) {
2403	($vm,$all) = pb_get2v($vtype);
2404	} else {
2405	@$vm = ($vm1);
2406	}
2407	my ($vmexist,$vmpid) = (undef,undef);
2408
2409	foreach my $v (@$vm) {
2410	# Launch VM/VE
2411	($vmexist,$vmpid) = pb_launchv($vtype,$v,0,$snapme,$pbsnap);
2412
2413	if ($vtype eq "vm") {
2414	pb_log(2,"DEBUG: After pb_launchv, vmexist: $vmexist, vmpid: $vmpid\n");
2415
2416	# Skip that VM/RM if something went wrong
2417	next if (($vmpid == 0) && ($vmexist == 0));
2418
2419	# If force stopping the VM then reset vmexist
2420	if ($pbforce == 1) {
2421	$vmpid = $vmexist;
2422	$vmexist = 0;
2423	}
2424	} else {
2425	#VE
2426	$vmexist = 0;
2427	$vmpid = 0;
2428	}
2429
2430	# Gather all required files to send them to the VM/VE/RM
2431	# and launch the build through pbscript
2432	pb_log(2,"DEBUG: Before send2target, vmexist: $vmexist, vmpid: $vmpid\n");
2433	pb_send2target(uc($vtype)."Script","$v",$vmexist,$vmpid,$snapme);
2434
2435	}
2436	}
2437
2438	sub pb_launchv {
2439	my $vtype = shift;
2440	my $v = shift;
2441	my $create = shift \|\| 0; # By default do not create a VM/VE/RM
2442	my $snapme = shift \|\| 0; # By default do not snap a VM/VE/RM
2443	my $usesnap = shift \|\| 1; # By default study the usage of the snapshot feature of VM/VE/RM
2444
2445	# If creation or snapshot creation mode, no snapshot usable
2446	if (($create == 1) \|\| ($snapme == 1)) {
2447	$usesnap = 0;
2448	}
2449
2450	pb_log(2,"DEBUG: pb_launchv($vtype,$v,$create,$snapme,$usesnap)\n");
2451	die "No VM/VE/RM defined, unable to launch" if (not defined $v);
2452	# Keep only the first VM in case many were given
2453	if ($v =~ /,/) {
2454	pb_log(0,"WARNING: pruning to just the first of several vms listed ($v)\n");
2455	$v =~ s/,.*//;
2456	}
2457
2458	my $pbos = pb_distro_get_context($v);
2459
2460	my $ftp_proxy = pb_distro_get_param($pbos,pb_conf_get_if("ftp_proxy"));
2461	my $http_proxy = pb_distro_get_param($pbos,pb_conf_get_if("http_proxy"));
2462
2463	$ENV{ftp_proxy} \|\|= $ftp_proxy if ((defined $ftp_proxy) && ($ftp_proxy ne ""));
2464	$ENV{http_proxy} \|\|= $http_proxy if ((defined $http_proxy) && ($http_proxy ne ""));
2465
2466	# Launch the VMs/VEs
2467	if ($vtype eq "vm") {
2468	die "-i iso parameter needed" if (((not defined $iso) \|\| ($iso eq "")) && ($create != 0));
2469
2470	my ($ptr,$ptr2,$vmpath,$vmport,$vms) = pb_conf_get("vmtype","vmcmd","vmpath","vmport","vmsize");
2471	my ($vmopt,$vmmm,$vmtmout,$vmsnap,$vmbuildtm,$vmmonport) = pb_conf_get_if("vmopt","vmmem","vmtmout","vmsnap","vmbuildtm","vmmonport");
2472	my $vmsize = pb_distro_get_param($pbos,$vms);
2473
2474	my $vmtype = $ptr->{$ENV{'PBPROJ'}};
2475	my $vmcmd = $ptr2->{$ENV{'PBPROJ'}};
2476
2477	if (defined $opts{'g'}) {
2478	if (($vmtype eq "kvm") \|\| ($vmtype eq "qemu")) {
2479	$ENV{'PBVMOPT'} = "--nographic";
2480	}
2481	}
2482	if (not defined $ENV{'PBVMOPT'}) {
2483	$ENV{'PBVMOPT'} = "";
2484	}
2485	# Save the current status for later restoration
2486	$ENV{'PBOLDVMOPT'} = $ENV{'PBVMOPT'};
2487	# Set a default timeout of 2 minutes
2488	if (not defined $ENV{'PBVMTMOUT'}) {
2489	$ENV{'PBVMTMOUT'} = "120";
2490	}
2491	if (defined $vmopt->{$v}) {
2492	$ENV{'PBVMOPT'} .= " $vmopt->{$v}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$v}/);
2493	} elsif (defined $vmopt->{$ENV{'PBPROJ'}}) {
2494	$ENV{'PBVMOPT'} .= " $vmopt->{$ENV{'PBPROJ'}}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$ENV{'PBPROJ'}}/);
2495	}
2496
2497	# How much memory to allocate for VMs
2498	if (defined $vmmm) {
2499	my $vmmem = pb_distro_get_param($pbos,$vmmm);
2500	if (defined $vmmem) {
2501	$ENV{'PBVMOPT'} .= " -m $vmmem";
2502	}
2503	}
2504
2505	# Are we allowed to use snapshot feature
2506	if ($usesnap == 1) {
2507	if ((defined $vmsnap->{$v}) && ($vmsnap->{$v} =~ /true/i)) {
2508	$ENV{'PBVMOPT'} .= " -snapshot";
2509	} elsif ((defined $vmsnap->{$ENV{'PBPROJ'}}) && ($vmsnap->{$ENV{'PBPROJ'}} =~ /true/i)) {
2510	$ENV{'PBVMOPT'} .= " -snapshot";
2511	} elsif ($pbsnap eq 1) {
2512	$ENV{'PBVMOPT'} .= " -snapshot";
2513	}
2514	}
2515	if ($snapme != 0) {
2516	if (($vmtype eq "kvm") \|\| ($vmtype eq "qemu")) {
2517	# Configure the monitoring to automate the creation of the 'pb' snapshot
2518	$ENV{'PBVMOPT'} .= " -serial mon:telnet::$vmmonport->{$ENV{'PBPROJ'}},server,nowait" if ((defined $vmmonport) && (defined $vmmonport->{$ENV{'PBPROJ'}}));
2519	# In that case no snapshot call needed
2520	$ENV{'PBVMOPT'} =~ s/ -snapshot//;
2521	}
2522	}
2523	if (defined $vmtmout->{$v}) {
2524	$ENV{'PBVMTMOUT'} = $vmtmout->{$v};
2525	} elsif (defined $vmtmout->{$ENV{'PBPROJ'}}) {
2526	$ENV{'PBVMTMOUT'} = $vmtmout->{$ENV{'PBPROJ'}};
2527	}
2528	my $nport = pb_get_port($vmport,$pbos,$vtype);
2529
2530	my $cmd;
2531	my $vmm; # has to be used for pb_check_ps
2532	if (($vmtype eq "qemu") \|\| ($vmtype eq "kvm")) {
2533	$vmm = "$vmpath->{$ENV{'PBPROJ'}}/$v.qemu";
2534	if (($create != 0) \|\| (defined $iso)) {
2535	$ENV{'PBVMOPT'} .= " -cdrom $iso -boot d";
2536	}
2537	# Always redirect the network and always try to use a 'pb' snapshot
2538	#$cmd = "$vmcmd $ENV{'PBVMOPT'} -net user,hostfwd=tcp:$nport:10.0.2.15:22 -loadvm pb $vmm"
2539	$cmd = "$vmcmd $ENV{'PBVMOPT'} -redir tcp:$nport:10.0.2.15:22 $vmm"
2540	} elsif ($vmtype eq "xen") {
2541	} elsif ($vmtype eq "vmware") {
2542	} else {
2543	die "VM of type $vmtype not supported. Report to the dev team";
2544	}
2545	# Restore the ENV VAR Value
2546	$ENV{'PBVMOPT'} = $ENV{'PBOLDVMOPT'};
2547
2548	my ($tmpcmd,$void) = split(/ +/,$cmd);
2549	my $vmexist = pb_check_ps($tmpcmd,$vmm);
2550	my $vmpid = 0;
2551	if (! $vmexist) {
2552	if ($create != 0) {
2553	die("Found an existing Virtual machine $vmm. Won't overwrite") if (-r $vmm);
2554	if (($vmtype eq "qemu") \|\| ($vmtype eq "xen") \|\| ($vmtype eq "kvm")) {
2555	my $command = pb_check_req("qemu-img",0);
2556	pb_system("$command create -f qcow2 $vmm $vmsize","Creating the QEMU VM");
2557	} elsif ($vmtype eq "vmware") {
2558	} else {
2559	}
2560	}
2561	if (! -f "$vmm") {
2562	pb_log(0,"Unable to find VM $vmm\n");
2563	} else {
2564	# Is the SSH port free? if not kill the existing process using it after a build timeout period
2565	my $vmssh = pb_check_ps($tmpcmd,"tcp:$nport:10.0.2.15:22");
2566	if ($vmssh) {
2567	my $buildtm = $ENV{'PBVMTMOUT'};
2568	if (defined $vmbuildtm->{$v}) {
2569	$buildtm = $vmbuildtm->{$v};
2570	} elsif (defined $vmbuildtm->{$ENV{'PBPROJ'}}) {
2571	$buildtm = $vmbuildtm->{$ENV{'PBPROJ'}};
2572	}
2573
2574	sleep $buildtm;
2575	pb_log(0,"WARNING: Killing the process ($vmssh) using port $nport (previous failed VM ?)\n");
2576	kill 15,$vmssh;
2577	# Let it time to exit
2578	sleep 5;
2579	}
2580	pb_system("$cmd &","Launching the VM $vmm");
2581	# Using system allows to kill it externaly if needed,sosupport that in the call
2582	pb_system("sleep $ENV{'PBVMTMOUT'}","Waiting $ENV{'PBVMTMOUT'} s for VM $v to come up",undef,1);
2583	$vmpid = pb_check_ps($tmpcmd,$vmm);
2584	pb_log(0,"VM $vmm launched (pid $vmpid)\n");
2585	}
2586	} else {
2587	pb_log(0,"Found an existing VM $vmm (pid $vmexist)\n");
2588	}
2589	pb_log(2,"DEBUG: pb_launchv returns ($vmexist,$vmpid)\n");
2590	return($vmexist,$vmpid);
2591	} elsif ($vtype eq "ve") {
2592	# Force the creation of the VE and no snapshot usable
2593	pb_ve_launch($v,$create,$usesnap);
2594	} else {
2595	# RM here
2596	# Get distro context
2597	my $pbos = pb_distro_get_context($v);
2598
2599	# Get RM context
2600	my ($ptr,$rmpath) = pb_conf_get("rmtype","rmpath");
2601
2602	# Nothing more to do for RM. No real launch
2603	# For the moment we support the RM is already running
2604	# For ProLiant may be able to power them on if needed later on as an example.
2605	}
2606	}
2607
2608	# Return string for date synchro
2609	sub pb_date2v {
2610
2611	my $vtype = shift;
2612	my $pbos = shift;
2613
2614	# VE gets time from parent OS.
2615	return "/bin/true" if ($vtype) =~ /^ve/o;
2616
2617	my ($ntp) = pb_conf_get_if($vtype."ntp");
2618	my $vntp = $ntp->{$ENV{'PBPROJ'}} if (defined $ntp);
2619	my $ntpline = undef;
2620
2621	if (defined $vntp) {
2622	# ntp command depends on pbos
2623	my $vntpcmd = pb_distro_get_param($pbos,pb_conf_get($vtype."ntpcmd"));
2624	$ntpline = "sudo $vntpcmd $vntp";
2625	}
2626	# Force new date to be in the future compared to the date
2627	# of the host by adding 1 minute
2628	my @date=pb_get_date();
2629	$date[1]++;
2630	my $upddate = strftime("%m%d%H%M%Y", @date);
2631	my $dateline = "sudo /bin/date $upddate";
2632	if (defined $ntpline) {
2633	return($ntpline);
2634	} else {
2635	return($dateline);
2636	}
2637	}
2638
2639	sub pb_build2v {
2640
2641	my $vtype = shift;
2642	my $action = shift \|\| "build";
2643
2644	my ($v,$all) = pb_get2v($vtype);
2645
2646	# Send tar files when we do a global generation
2647	pb_build2ssh() if (($all == 1) && ($action eq "build"));
2648
2649	# Adapt // mode to memory size
2650	$pbparallel = pb_set_parallel($vtype);
2651
2652	my ($vmexist,$vmpid) = (undef,undef);
2653	my $pm;
2654	my $all_ok = 1;
2655	if (defined $pbparallel) {
2656	$pm = new Parallel::ForkManager($pbparallel);
2657
2658	# Set which port the VM/RM will use to communicate
2659	$pm->run_on_start(\&pb_set_port);
2660	$pm->run_on_finish(sub { my ($pid, $code, $id, $signal, $dump) = @_;
2661	unless ($code == 0 && $signal == 0 && $dump == 0) {
2662	$all_ok = 0;
2663	pb_log(0,"ERROR: pid $pid failed\n");
2664	}
2665	});
2666	}
2667
2668	my $counter = 0;
2669	foreach my $v (@$v) {
2670	$counter++;
2671	# Modulo 2 * pbparallel (to avoid synchronization problems)
2672	$counter = 1 if ((defined $pbparallel) && ($counter > 2 * $pbparallel));
2673	$pm->start($counter) and next if (defined $pbparallel);
2674	# Prepare the script to be executed on the VM/VE/RM
2675	# in $ENV{'PBDESTDIR'}/pbscript.$$
2676	open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript.$$") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript.$$";
2677	print SCRIPT "#!/bin/bash\n";
2678
2679	# Transmit the verbosity level to the virtual env/mach.
2680	my $verbose = "";
2681	my $i = 0; # minimal debug level
2682	while ($i lt $pbdebug) {
2683	$verbose .= "-v ";
2684	$i++;
2685	}
2686	print SCRIPT "set -e\n" if $Global::pb_stop_on_error;
2687	# Activate script verbosity if at least 2 for pbdebug
2688	print SCRIPT "set -x\n" if ($i gt 1);
2689	# Quiet if asked to be so on the original system
2690	$verbose = "-q" if ($pbdebug eq -1);
2691
2692	print SCRIPT "echo ... Execution needed\n";
2693	print SCRIPT "# This is in directory delivery\n";
2694	print SCRIPT "# Setup the variables required for building\n";
2695	print SCRIPT "export PBPROJ=$ENV{'PBPROJ'}\n";
2696
2697	if ($action eq "build") {
2698	print SCRIPT "# Preparation for pb\n";
2699	print SCRIPT "mv .pbrc \$HOME\n";
2700	print SCRIPT "cd ..\n";
2701	}
2702
2703	# VE needs a good /proc, tolerate one being potentially left around after a failure
2704	if ($vtype eq "ve") {
2705	print SCRIPT "[ -d /proc/1 ] \|\| sudo /bin/mount -t proc /proc /proc\n";
2706	}
2707
2708	# Get distro context
2709	my $pbos = pb_distro_get_context($v);
2710
2711	my $ntpline = pb_date2v($vtype,$pbos);
2712	print SCRIPT "# Time sync\n";
2713	print SCRIPT "echo setting up date with $ntpline\n";
2714	print SCRIPT "$ntpline\n";
2715	# Use potential local proxy declaration in case we need it to download repo, pkgs, ...
2716	if (defined $ENV{'http_proxy'}) {
2717	print SCRIPT "export http_proxy=\"$ENV{'http_proxy'}\"\n";
2718	}
2719
2720	if (defined $ENV{'ftp_proxy'}) {
2721	print SCRIPT "export ftp_proxy=\"$ENV{'ftp_proxy'}\"\n";
2722	}
2723
2724	# Get list of packages to build/test and get some ENV vars as well
2725	my $ptr = pb_get_pkg();
2726	@pkgs = @$ptr;
2727	my $p = join(' ',@pkgs) if (@pkgs);
2728	print SCRIPT "export PBPROJVER=$ENV{'PBPROJVER'}\n";
2729	print SCRIPT "export PBPROJTAG=$ENV{'PBPROJTAG'}\n";
2730	print SCRIPT "export PBPACKAGER=\"$ENV{'PBPACKAGER'}\"\n";
2731
2732	# We may need to do some other tasks before building. Read a script here to finish setup
2733	if (-x "$ENV{'PBDESTDIR'}/pb$vtype".".pre") {
2734	print SCRIPT "# Special pre-instructions to be launched\n";
2735	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype".".pre");
2736	}
2737
2738	if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."$action.pre") {
2739	print SCRIPT "# Special pre-$action instructions to be launched\n";
2740	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."$action.pre");
2741	}
2742
2743	print SCRIPT "# $action\n";
2744	print SCRIPT "echo $action"."ing packages on $vtype...\n";
2745
2746	if (($action eq "test") && (! -x "$ENV{'PBDESTDIR'}/pbtest")) {
2747	die "No test script ($ENV{'PBDESTDIR'}/pbtest) found when in test mode. Aborting ...";
2748	}
2749	print SCRIPT "pb $verbose -p $ENV{'PBPROJ'} $action"."2pkg $p\n";
2750
2751	if ($vtype eq "ve") {
2752	print SCRIPT "sudo /bin/umount /proc\n";
2753	}
2754
2755	# We may need to do some other tasks after building. Read a script here to exit properly
2756	if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."$action.post") {
2757	print SCRIPT "# Special post-$action instructions to be launched\n";
2758	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."$action.post");
2759	}
2760
2761	if (-x "$ENV{'PBDESTDIR'}/pb$vtype".".post") {
2762	print SCRIPT "# Special post-instructions to be launched\n";
2763	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype".".post");
2764	}
2765
2766	print SCRIPT q{echo "******** Successful exit of script $$ *******************"}, "\n";
2767	close(SCRIPT);
2768	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript.$$";
2769
2770	# Launch the VM/VE/RM
2771	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
2772
2773
2774	if ($vtype eq "vm") {
2775	# Skip that VM if something went wrong
2776	if (($vmpid == 0) && ($vmexist == 0)) {
2777	$pm->finish if (defined $pbparallel);
2778	next;
2779	}
2780	} else {
2781	# VE/RM
2782	$vmexist = 0;
2783	$vmpid = 0;
2784	}
2785	# Gather all required files to send them to the VM/VE
2786	# and launch the build through pbscript
2787	pb_log(2,"Calling send2target $vtype,$v,$vmexist,$vmpid\n");
2788	pb_send2target(uc($vtype).$action,"$v",$vmexist,$vmpid);
2789	$pm->finish if (defined $pbparallel);
2790	}
2791	$pm->wait_all_children if (defined $pbparallel);
2792	die "Aborting, one or more of the children failed." if ((not $all_ok) && ($Global::pb_stop_on_error));
2793	}
2794
2795
2796	sub pb_clean {
2797
2798	my $sleep=10;
2799	die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
2800	die "Unable to get env var PBBUILDDIR" if (not defined $ENV{'PBBUILDDIR'});
2801	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");
2802	sleep $sleep;
2803	pb_rm_rf($ENV{'PBDESTDIR'});
2804	pb_rm_rf($ENV{'PBBUILDDIR'});
2805	}
2806
2807	sub pb_newver {
2808
2809	die "-V Version parameter needed" if ((not defined $newver) \|\| ($newver eq ""));
2810
2811	# Need this call for PBDIR
2812	my ($scheme2,$uri) = pb_cms_init($pbinit);
2813
2814	my ($pbconf,$pburl) = pb_conf_get("pbconfurl","pburl");
2815	$uri = $pbconf->{$ENV{'PBPROJ'}};
2816	my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);
2817
2818	# Checking CMS repositories status
2819	($scheme2, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}});
2820
2821	if ($scheme !~ /^svn/) {
2822	die "Only SVN is supported at the moment";
2823	}
2824
2825	my $res = pb_vcs_isdiff($scheme,$ENV{'PBROOTDIR'});
2826	die "ERROR: No differences accepted in CMS for $ENV{'PBROOTDIR'} before creating a new version" if ($res != 0);
2827
2828	$res = pb_vcs_isdiff($scheme2,$ENV{'PBDIR'});
2829	die "ERROR: No differences accepted in CMS for $ENV{'PBDIR'} before creating a new version" if ($res != 0);
2830
2831	# Tree identical between PBCONFDIR and PBROOTDIR. The delta is what
2832	# we want to get for the root of the new URL
2833
2834	my $oldver = $ENV{'PBROOTDIR'};
2835	$oldver =~ s\|^$ENV{'PBCONFDIR'}\|\|;
2836
2837	pb_log(2, "PBCONFDIR: $ENV{'PBCONFDIR'}\nPBROOTDIR: $ENV{'PBROOTDIR'}\n");
2838
2839	my $newurl = "$uri/$newver";
2840	# Should probably use projver in the old file
2841	my $oldvertxt= basename($oldver);
2842	my $newvertxt = basename($newver);
2843
2844	# Duplicate and extract project-builder part
2845	pb_log(2,"Copying $uri/$oldver to $newurl\n");
2846	pb_vcs_copy($scheme,"$uri/$oldver",$newurl);
2847	pb_log(2,"Checkout $newurl to $ENV{'PBCONFDIR'}/$newver\n");
2848	pb_vcs_up($scheme,"$ENV{'PBCONFDIR'}");
2849
2850	# Duplicate and extract project
2851	my $newurl2 = "$pburl->{$ENV{'PBPROJ'}}/$newver";
2852
2853	pb_log(2,"Copying $pburl->{$ENV{'PBPROJ'}}/$oldver to $newurl2\n");
2854	pb_vcs_copy($scheme2,"$pburl->{$ENV{'PBPROJ'}}/$oldver",$newurl2);
2855
2856	my $tmp = $ENV{'PBDIR'};
2857	$tmp =~ s\|$oldver$\|\|;
2858	pb_log(2,"Checkout $newurl2 to $tmp/$newver\n");
2859	pb_vcs_up($scheme2,"$tmp");
2860
2861	# Update the .pb file
2862	open(FILE,"$ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb") \|\| die "Unable to open $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb";
2863	open(OUT,"> $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb.new") \|\| die "Unable to write to $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb.new";
2864	while(<FILE>) {
2865	if (/^projver\s+$ENV{'PBPROJ'}\s=\s$oldvertxt$/) {
2866	s/^projver\s+$ENV{'PBPROJ'}\s=\s$oldvertxt$/projver $ENV{'PBPROJ'} = $newvertxt/;
2867	pb_log(0,"Changing projver from $oldvertxt to $newvertxt in $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb\n");
2868	}
2869	if (/^testver/) {
2870	s/^testver/#testver/;
2871	pb_log(0,"Commenting testver in $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb\n") if (/^testver/);
2872	}
2873	if (/^delivery/) {
2874	my $txt = $_;
2875	chomp($txt);
2876	pb_log(0,"Please check delivery ($txt) in $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb\n");
2877	}
2878	print OUT $_;
2879	}
2880	close(FILE);
2881	close(OUT);
2882	rename("$ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb.new","$ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb");
2883
2884	# Checking pbcl files
2885	foreach my $f (<$ENV{'PBROOTDIR'}/*/pbcl>) {
2886	# Compute new pbcl file
2887	my $f2 = $f;
2888	$f2 =~ s\|$ENV{'PBROOTDIR'}\|$ENV{'PBCONFDIR'}/$newver/\|;
2889	open(PBCL,$f) \|\| die "Unable to open $f";
2890	my $foundnew = 0;
2891	while (<PBCL>) {
2892	$foundnew = 1 if (/^$newvertxt \(/);
2893	}
2894	close(PBCL);
2895	open(OUT,"> $f2") \|\| die "Unable to write to $f2: $!";
2896	open(PBCL,$f) \|\| die "Unable to open $f";
2897	while (<PBCL>) {
2898	print OUT "$_" if (not /^$oldvertxt \(/);
2899	if ((/^$oldvertxt \(/) && ($foundnew == 0)) {
2900	print OUT "$newvertxt ($pbdate)\n";
2901	print OUT "- TBD\n";
2902	print OUT "\n";
2903	pb_log(0,"WARNING: version $newvertxt not found in $f so added to $f2...\n") if ($foundnew == 0);
2904	}
2905	}
2906	close(OUT);
2907	close(PBCL);
2908	}
2909
2910	pb_log(2,"Checkin $ENV{'PBCONFDIR'}/$newver\n");
2911	pb_cms_checkin($scheme,"$ENV{'PBCONFDIR'}/$newver",undef);
2912	}
2913
2914	#
2915	# Return the list of VMs/VEs/RMs we are working on
2916	# $all is a flag to know if we return all of them
2917	# or only some (if all we publish also tar files in addition to pkgs
2918	#
2919	sub pb_get2v {
2920
2921	my $vtype = shift;
2922	my @v;
2923	my $all = 0;
2924	my $pbv = 'PBV';
2925	my $vlist = $vtype."list";
2926
2927	# Get VM/VE list
2928	if ((not defined $ENV{$pbv}) \|\| ($ENV{$pbv} =~ /^all$/)) {
2929	my ($ptr) = pb_conf_get($vlist);
2930	$ENV{$pbv} = $ptr->{$ENV{'PBPROJ'}};
2931	$all = 1;
2932	}
2933	pb_log(2,"$vtype: $ENV{$pbv}\n");
2934	@v = split(/,/,$ENV{$pbv});
2935	return(\@v,$all);
2936	}
2937
2938	# This function creates a giant script to configure a particular VM/VE/RM, it then copies the
2939	# script to the target.
2940
2941	# Function to create a potentialy missing pb account on the VM/VE/RM, and adds it to sudo
2942	# Needs to use root account to connect to the VM/VE/RM
2943	# pb will take your local public SSH key to access
2944	# the pb account in the VM/VE/RM later on if needed
2945	sub pb_setup2v {
2946
2947	my $vtype = shift;
2948	my $sbx = shift \|\| undef;
2949
2950	my ($vm,$all) = pb_get2v($vtype);
2951
2952	# Script generated
2953	my $pbscript = "$ENV{'PBDESTDIR'}/setupv";
2954
2955	# Adapt // mode to memory size
2956	$pbparallel = pb_set_parallel($vtype);
2957
2958	my $pm;
2959	my $all_ok = 1;
2960	if (defined $pbparallel) {
2961	$pm = new Parallel::ForkManager($pbparallel);
2962
2963	# Set which port the VM/RM will use to communicate
2964	$pm->run_on_start(\&pb_set_port);
2965	$pm->run_on_finish(sub { my ($pid, $code, $id, $signal, $dump) = @_;
2966	$all_ok = 0 unless (($code == 0) && ($signal == 0) && ($dump == 0));
2967	});
2968	}
2969
2970	my $counter = 0;
2971	foreach my $v (@$vm) {
2972	$counter++;
2973	# Modulo pbparallel
2974	$counter = 1 if ((defined $pbparallel) && ($counter > $pbparallel));
2975	$pm->start($counter) and next if (defined $pbparallel);
2976
2977	# Get distro context
2978	my $pbos = pb_distro_get_context($v);
2979
2980	# Deal with date sync.
2981	my $ntpline = pb_date2v($vtype,$pbos);
2982
2983	# Name of the account to deal with for VM/VE/RM
2984	# Do not use the one passed potentially with -a
2985	my ($pbac) = pb_conf_get($vtype."login");
2986	my ($key,$zero0,$zero1,$zero2);
2987	my ($vmexist,$vmpid);
2988
2989	# Prepare the script to be executed on the VM/VE/RM
2990	# in $ENV{'PBDESTDIR'}/setupv
2991	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
2992
2993	print SCRIPT << 'EOF';
2994	#!/usr/bin/perl -w
2995
2996	use strict;
2997	use File::Copy;
2998
2999	# We should not need in this script more functions than what is provided
3000	# by Base, Conf and Distribution to avoid problems at exec time.
3001	# They are appended at the end.
3002
3003	# Define mandatory global vars
3004	our $pbdebug;
3005	our $pbLOG;
3006	our $pbsynmsg = "pbscript";
3007	our $pbdisplaytype = "text";
3008	our $pblocale = "";
3009	pb_log_init($pbdebug, $pbLOG);
3010	EOF
3011	print SCRIPT << "EOF";
3012	\$Global::pb_stop_on_error = $Global::pb_stop_on_error;
3013	pb_temp_init($pbkeep);
3014	pb_conf_init("$ENV{'PBPROJ'}");
3015
3016	EOF
3017
3018	# Launch the VM/VE/RM - Usage of snapshot disabled
3019	($vmexist,$vmpid) = pb_launchv($vtype,$v,0,0,0);
3020
3021	my $keyfile;
3022	my $nport;
3023	my $vmhost;
3024
3025	# Prepare the key to be used and transfered remotely
3026	$keyfile = pb_ssh_get(1);
3027
3028	if ($vtype =~ /(v\|r)m/) {
3029	my ($vmport);
3030	($vmhost,$vmport) = pb_conf_get($vtype."host",$vtype."port");
3031	$nport = pb_get_port($vmport,$pbos,$vtype);
3032
3033	# Skip that VM/RM if something went wrong
3034	next if (($vmpid == 0) && ($vmexist == 0));
3035
3036	# Store the pub key part in a variable
3037	open(FILE,"$keyfile.pub") \|\| die "Unable to open $keyfile.pub";
3038	($zero0,$zero1,$zero2) = split(/ /,<FILE>);
3039	close(FILE);
3040
3041	$key = "\Q$zero1";
3042
3043	# We call true to avoid problems if SELinux is not activated, but chcon is present and returns in that case 1
3044	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");
3045	# once this is done, we can do what we need on the VM/RM remotely
3046	} elsif ($vtype eq "ve") {
3047	print SCRIPT << "EOF";
3048	# For VE we need a good null dev
3049	pb_system("rm -f /dev/null; mknod /dev/null c 1 3; chmod 777 /dev/null");
3050
3051	# For VE we first need to mount some FS
3052	pb_system("mount -t proc /proc /proc") unless (-d "/proc/$$");
3053
3054	EOF
3055	} else {
3056	die "Unknown virtual type $vtype";
3057	}
3058
3059	if ($vtype =~ /(v\|r)m/) {
3060	print SCRIPT << 'EOF';
3061	# Removes duplicate in .ssh/authorized_keys of our key if needed
3062	#
3063	my $file1="$ENV{'HOME'}/.ssh/authorized_keys";
3064	open(PBFILE,$file1) \|\| die "Unable to open $file1";
3065	open(PBOUT,"> $file1.new") \|\| die "Unable to open $file1.new";
3066	my $count = 0;
3067	while (<PBFILE>) {
3068
3069	EOF
3070	print SCRIPT << "EOF";
3071	if (/ $key /) {
3072	\$count++;
3073	}
3074	print PBOUT \$_ if ((\$count <= 1) \|\| (\$_ !~ / $key /));
3075	}
3076	close(PBFILE);
3077	close(PBOUT);
3078	rename("\$file1.new",\$file1);
3079	chmod 0600,\$file1;
3080
3081	EOF
3082	}
3083	print SCRIPT << 'EOF';
3084
3085	# Adds $pbac->{$ENV{'PBPROJ'}} as an account if needed
3086	#
3087	my $file="/etc/passwd";
3088	open(PBFILE,$file) \|\| die "Unable to open $file";
3089	my $found = 0;
3090	while (<PBFILE>) {
3091	EOF
3092	print SCRIPT << "EOF";
3093	\$found = 1 if (/^$pbac->{$ENV{'PBPROJ'}}:/);
3094	EOF
3095
3096	# TODO: use an external parameter
3097	my $home = "/home";
3098	# Solaris doesn't like that we use /home
3099	$home = "/export/home" if ($pbos->{'type'} eq "pkg");
3100
3101	print SCRIPT << "EOF";
3102	}
3103	close(PBFILE);
3104
3105	if ( \$found == 0 ) {
3106	if ( ! -d "$home" ) {
3107	pb_mkdir_p("$home");
3108	}
3109	EOF
3110	# TODO: Level of portability of these cmds ? Critical now for RM
3111	# TODO: Check existence before adding to avoid errors
3112	print SCRIPT << "EOF";
3113	pb_system("/usr/sbin/groupadd $pbac->{$ENV{'PBPROJ'}}","Adding group $pbac->{$ENV{'PBPROJ'}}");
3114	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'}})");
3115	}
3116	EOF
3117
3118	# Copy the content of our local conf file to the VM/VE/RM
3119	my $content = pb_get_content(pb_distro_conffile());
3120	print SCRIPT << "EOF";
3121	#
3122	# Create a temporary local conf file for distribution support
3123	# This is created here before its use later. Its place is hardcoded, so no choice for the path
3124	#
3125	my \$tempconf = pb_distro_conffile();
3126	pb_mkdir_p(dirname(\$tempconf));
3127	open(CONF,"> \$tempconf") \|\| die "Unable to create \$tempconf";
3128	print CONF q{$content};
3129	close(CONF);
3130	EOF
3131
3132	if ($vtype =~ /(v\|r)m/) {
3133	print SCRIPT << "EOF";
3134	# allow ssh entry to build
3135	#
3136	mkdir "$home/$pbac->{$ENV{'PBPROJ'}}/.ssh",0700;
3137	# Allow those accessing root to access the build account
3138	copy("\$ENV{'HOME'}/.ssh/authorized_keys","$home/$pbac->{$ENV{'PBPROJ'}}/.ssh/authorized_keys");
3139	chmod 0600,".ssh/authorized_keys";
3140	pb_system("chown -R $pbac->{$ENV{'PBPROJ'}}:$pbac->{$ENV{'PBPROJ'}} $home/$pbac->{$ENV{'PBPROJ'}}","Finish setting up the account env for $pbac->{$ENV{'PBPROJ'}}");
3141
3142	EOF
3143	}
3144	print SCRIPT << 'EOF';
3145	# No passwd for build account only keys
3146	$file="/etc/shadow";
3147	if (-f $file) {
3148	open(PBFILE,$file) \|\| die "Unable to open $file";
3149	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
3150	while (<PBFILE>) {
3151	EOF
3152	print SCRIPT << "EOF";
3153	s/^$pbac->{$ENV{'PBPROJ'}}:\!\!:/$pbac->{$ENV{'PBPROJ'}}:*:/;
3154	s/^$pbac->{$ENV{'PBPROJ'}}:\!:/$pbac->{$ENV{'PBPROJ'}}:*:/; #SLES 9 e.g.
3155	s/^$pbac->{$ENV{'PBPROJ'}}:\\LK\\:/$pbac->{$ENV{'PBPROJ'}}:NP:/; #Solaris e.g.
3156	EOF
3157	print SCRIPT << 'EOF';
3158	print PBOUT $_;
3159	}
3160	close(PBFILE);
3161	close(PBOUT);
3162	rename("$file.new",$file);
3163	chmod 0640,$file;
3164	}
3165
3166	# Keep the VM in text mode
3167	$file="/etc/inittab";
3168	if (-f $file) {
3169	open(PBFILE,$file) \|\| die "Unable to open $file";
3170	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
3171	while (<PBFILE>) {
3172	s/^(..):5:initdefault:$/$1:3:initdefault:/;
3173	print PBOUT $_;
3174	}
3175	close(PBFILE);
3176	close(PBOUT);
3177	rename("$file.new",$file);
3178	chmod 0640,$file;
3179	}
3180
3181	# pb has to be added to portage group on gentoo
3182
3183	# We need to have that pb_distro_get_context function
3184	# Get it from Project-Builder::Distribution
3185	# And we now need the conf file required for this to work created above
3186
3187	my $pbos = pb_distro_get_context();
3188	print "distro tuple: ".Dumper($pbos)."\n";
3189
3190	# Adapt sudoers
3191	# sudo is not default on Solaris and needs to be installed first
3192	# from http://www.sunfreeware.com/programlistsparc10.html#sudo
3193	if ($pbos->{'type'} eq "pkg") {
3194	$file="/usr/local/etc/sudoers";
3195	} else {
3196	$file="/etc/sudoers";
3197	}
3198	open(PBFILE,$file) \|\| die "Unable to open $file";
3199	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
3200	while (<PBFILE>) {
3201	EOF
3202	# Skip what will be generated
3203	print SCRIPT << "EOF";
3204	next if (/^$pbac->{$ENV{'PBPROJ'}}\\s+/);
3205	next if (/^Defaults:$pbac->{$ENV{'PBPROJ'}}\\s+/);
3206	next if (/^Defaults:root \!requiretty/);
3207	next if (/^Defaults:root env_keep/);
3208	EOF
3209	print SCRIPT << 'EOF';
3210	s/Defaults\s+requiretty/# disable Defaults: requiretty/;
3211	print PBOUT $_;
3212	}
3213	close(PBFILE);
3214	EOF
3215	print SCRIPT << "EOF";
3216	# Some distro force requiretty at compile time, so disable here
3217	print PBOUT "Defaults:$pbac->{$ENV{'PBPROJ'}} !requiretty\n";
3218	print PBOUT "Defaults:root !requiretty\n";
3219	# Keep proxy configuration while using sudo
3220	print PBOUT "Defaults:$pbac->{$ENV{'PBPROJ'}} env_keep += \\\"http_proxy ftp_proxy\\\"\n";
3221	print PBOUT "Defaults:root env_keep += \\\"http_proxy ftp_proxy\\\"\n";
3222	EOF
3223	# Try to restrict security to what is really needed
3224	if ($vtype =~ /^vm/) {
3225	my $hpath = pb_distro_get_param($pbos,pb_conf_get("ospathcmd-halt"));
3226	my @sudocmds = pb_get_sudocmds($pbos,$ntpline,"sudo $hpath");
3227	print SCRIPT << "EOF";
3228	# This is needed in order to be able on VM to halt the machine from the $pbac->{$ENV{'PBPROJ'}} account at least
3229	# Build account $pbac->{$ENV{'PBPROJ'}} in VM also needs to setup date and install deps.
3230	# Nothing else should be needed
3231	EOF
3232	foreach my $c (@sudocmds) {
3233	print SCRIPT "print PBOUT \"$pbac->{$ENV{'PBPROJ'}} ALL = NOPASSWD: $c\\n\";\n";
3234	}
3235	} elsif ($vtype =~ /^rm/) {
3236	my @sudocmds = pb_get_sudocmds($pbos,$ntpline);
3237	print SCRIPT << "EOF";
3238	# Build account $pbac->{$ENV{'PBPROJ'}} in RM only needs to setup date and install deps if needed each time
3239	EOF
3240	foreach my $c (@sudocmds) {
3241	print SCRIPT "print PBOUT \"$pbac->{$ENV{'PBPROJ'}} ALL = NOPASSWD: $c\\n\";\n";
3242	}
3243	} else {
3244	print SCRIPT << "EOF";
3245	# Build account $pbac->{$ENV{'PBPROJ'}} for VE needs to do a lot in the host (and chroot), so allow without restriction for now
3246	print PBOUT "$pbac->{$ENV{'PBPROJ'}} ALL=(ALL) NOPASSWD:ALL\n";
3247	EOF
3248	}
3249	print SCRIPT << 'EOF';
3250	close(PBOUT);
3251	rename("$file.new",$file);
3252	chmod 0440,$file;
3253
3254	EOF
3255
3256	if ($vtype =~ /(v\|r)m/) {
3257	# Sync date
3258	# do it after sudoers is setup
3259	print SCRIPT "pb_system(\"$ntpline\");\n";
3260	}
3261	# We may need a proxy configuration. Get it from the local env
3262	my $ftp_proxy = pb_distro_get_param($pbos,pb_conf_get_if("ftp_proxy"));
3263	my $http_proxy = pb_distro_get_param($pbos,pb_conf_get_if("http_proxy"));
3264
3265	$ENV{'ftp_proxy'} \|\|= $ftp_proxy if ((defined $ftp_proxy) && ($ftp_proxy ne ""));
3266	$ENV{'http_proxy'} \|\|= $http_proxy if ((defined $http_proxy) && ($http_proxy ne ""));
3267
3268	if (defined $ENV{'http_proxy'}) {
3269	print SCRIPT "\$ENV\{'http_proxy'\}=\"$ENV{'http_proxy'}\";\n";
3270	}
3271
3272	if (defined $ENV{'ftp_proxy'}) {
3273	print SCRIPT "\$ENV\{'ftp_proxy'\}=\"$ENV{'ftp_proxy'}\";\n";
3274	}
3275
3276	print SCRIPT << 'EOF';
3277
3278	# Suse wants sudoers as 640
3279	if ((($pbos->{'name'} eq "sles") && (($pbos->{'version'} =~ /10/) \|\| ($pbos->{'version'} =~ /9/))) \|\| (($pbos->{'name'} eq "opensuse") && ($pbos->{'version'} =~ /10.[012]/))) {
3280	chmod 0640,$file;
3281	}
3282
3283	# First install all required packages
3284	pb_system("yum clean all","Cleaning yum env") if (($pbos->{'name'} eq "fedora") \|\| ($pbos->{'name'} eq "asianux") \|\| ($pbos->{'name'} eq "rhel"));
3285	my ($ospkgdep) = pb_conf_get_if("ospkgdep");
3286
3287	my $pkgdep = pb_distro_get_param($pbos,$ospkgdep);
3288	pb_distro_installdeps(undef,$pbos,pb_distro_only_deps_needed($pbos,join(' ',split(/,/,$pkgdep))));
3289
3290	EOF
3291	my $itype = pb_distro_get_param($pbos,pb_conf_get("pbinstalltype"));
3292	# Install from sandbox mean a file base install
3293	$itype = "file" if (defined $sbx);
3294	if ($itype =~ /^file/) {
3295	my $cmdget;
3296	if (defined $sbx) {
3297	# Install from sandbox mean using the result of the just passed sbx2build command
3298	# Get content saved in cms2build
3299	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
3300	my $pbextdir = pb_get_extdir();
3301	die "Unable to get package list" if (not defined $pkg);
3302
3303	# We consider 2 specific packages
3304	my $vertag1 = $pkg->{"ProjectBuilder"};
3305	my $vertag2 = $pkg->{"project-builder"};
3306	# get the version of the current package - maybe different
3307	pb_log(2,"Vertag1: $vertag1\n");
3308	pb_log(2,"Vertag2: $vertag2\n");
3309	my ($pbver1,$tmp1) = split(/-/,$vertag1);
3310	my ($pbver2,$tmp2) = split(/-/,$vertag2);
3311	# Copy inside the VE
3312	if ($vtype eq "ve") {
3313	my ($vepath) = pb_conf_get("vepath");
3314	copy("$ENV{'PBDESTDIR'}/ProjectBuilder-$pbver1$pbextdir.tar.gz","$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/tmp");
3315	copy("$ENV{'PBDESTDIR'}/project-builder-$pbver2$pbextdir.tar.gz","$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/tmp");
3316	} else {
3317	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.");
3318	}
3319	$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";
3320	} else {
3321	# TODO: shouldn't we have a variable to specify the source file?
3322	# And shouldn't we be getting the one that matches the current pb version?
3323	# For the moment, just take the latest stable one
3324	$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";
3325	}
3326	print SCRIPT << 'EOF';
3327	# Then install manually the missing perl modules
3328	my ($osperldep,$osperlver) = pb_conf_get_if("osperldep","osperlver");
3329
3330	my $perldep = pb_distro_get_param($pbos,$osperldep);
3331	foreach my $m (split(/,/,$perldep)) {
3332	# Skip empty deps
3333	next if ($m =~ /^\s*$/);
3334	my $dir = $m;
3335	$dir =~ s/-.*//;
3336	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}");
3337	}
3338	EOF
3339	print SCRIPT << 'EOF';
3340	pb_system("rm -rf ProjectBuilder-* ; rm -rf project-builder-* ; rm -rf `perl -V:installvendorlib \| awk -F\"'\" '{print \$2}'`/ProjectBuilder ;
3341	EOF
3342	print SCRIPT " $cmdget ; ";
3343	print SCRIPT << 'EOF'
3344	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");
3345	EOF
3346	} elsif ($itype =~ /^pkg/) {
3347	# pkg based install. We need to point to the project-builder.org repository
3348	print SCRIPT << 'EOF';
3349	my $pkgforpb = pb_distro_get_param($pbos,pb_conf_get_if("ospkg"));
3350	pb_distro_setuposrepo($pbos);
3351	pb_distro_installdeps(undef,$pbos,pb_distro_only_deps_needed($pbos,join(' ',split(/,/,$pkgforpb))));
3352	EOF
3353	} else {
3354	# Unknown install type
3355	die("Unknown install type $itype->{$ENV{'PBPROJ'}} for param pbinstalltype");
3356	}
3357	print SCRIPT << 'EOF';
3358	pb_system("pb 2>&1 \| head -5",undef,"verbose");
3359	pb_system("pbdistrocheck",undef,"verbose");
3360	EOF
3361	if ($vtype eq "ve") {
3362	print SCRIPT << 'EOF';
3363	# For VE we need to umount some FS at the end
3364
3365	pb_system("umount /proc");
3366
3367	# Create a basic network file if not already there
3368
3369	my $nf="/etc/sysconfig/network";
3370	if ((! -f $nf) && ($pbos->{'type'} eq "rpm") && ($pbos->{'family'} ne "novell")) {
3371	open(NF,"> $nf") \|\| die "Unable to create $nf";
3372	print NF "NETWORKING=yes\n";
3373	print NF "HOSTNAME=localhost\n";
3374	close(NF);
3375	}
3376	chmod 0755,$nf;
3377	EOF
3378	}
3379
3380	# Adds pb_distro_get_context and all functions needed from ProjectBuilder::Distribution, Conf and Base
3381	foreach my $m ("ProjectBuilder/Base.pm","ProjectBuilder/Distribution.pm","ProjectBuilder/Conf.pm") {
3382	foreach my $d (@INC) {
3383	my $f = "$d/$m";
3384	if (-f "$f") {
3385	open(PBD,"$f") \|\| die "Unable to open $f: $!";
3386	while (<PBD>) {
3387	next if (/^package/);
3388	next if (/^use Exporter/);
3389	next if (/^use ProjectBuilder::/);
3390	next if (/^our /);
3391	print SCRIPT $_;
3392	}
3393	close(PBD);
3394	# We just need the first one of each file wrt @INC - hopefully that's the right one.
3395	last;
3396	}
3397	}
3398	}
3399	# Use a fake pb_version_init version here
3400	print SCRIPT << "EOF";
3401	sub pb_version_init {
3402
3403	return("$projectbuilderver","$projectbuilderrev");
3404	}
3405	1;
3406	EOF
3407	close(SCRIPT);
3408	chmod 0755,"$pbscript";
3409
3410	# That build script needs to be run as root and force stop of VM at end
3411	$pbaccount = "root";
3412
3413	# Force shutdown of VM except if it was already launched
3414	my $pbforce = 0;
3415	if ((! $vmexist) && ($vtype eq "vm")) {
3416	$pbforce = 1;
3417	}
3418
3419	pb_script2v($pbscript,$vtype,$pbforce,$v);
3420	$pm->finish if (defined $pbparallel);
3421	}
3422	$pm->wait_all_children if (defined $pbparallel);
3423	die "Aborting, one or more of the children failed." if ((not $all_ok) && ($Global::pb_stop_on_error));
3424	return;
3425	}
3426
3427	# Function to create a snapshot named 'pb' for VMs and a compressed tar for VEs
3428	sub pb_snap2v {
3429
3430	my $vtype = shift;
3431
3432	my ($vm,$all) = pb_get2v($vtype);
3433
3434	# Script generated
3435	my $pbscript = "$ENV{'PBDESTDIR'}/snapv";
3436
3437	my ($pbac) = pb_conf_get($vtype."login");
3438
3439	foreach my $v (@$vm) {
3440	if ($vtype eq "ve") {
3441	# Get distro context
3442	my $pbos = pb_distro_get_context($v);
3443	my ($vepath) = pb_conf_get("vepath");
3444
3445	# Test if an existing snapshot exists and remove it if there is a VE
3446	if ((-f "$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}.tar.gz") &&
3447	(! -d "$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}")) {
3448	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");
3449	}
3450	}
3451
3452	# Prepare the script to be executed on the VM/VE
3453	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
3454	print SCRIPT << 'EOF';
3455	#!/bin/bash
3456	sleep 2
3457	EOF
3458	close(SCRIPT);
3459	chmod 0755,"$pbscript";
3460
3461	# Force shutdown of VM/VE
3462	# Force snapshot of VM/VE
3463	pb_script2v($pbscript,$vtype,1,$v,1);
3464	}
3465	return;
3466	}
3467
3468	# Function to update VMs/VEs/RMs with the latest distribution content
3469	sub pb_update2v {
3470
3471	my $vtype = shift;
3472
3473	my ($vm,$all) = pb_get2v($vtype);
3474
3475	# Script generated
3476	my $pbscript = "$ENV{'PBDESTDIR'}/updatev";
3477
3478	my ($pbac) = pb_conf_get($vtype."login");
3479
3480	foreach my $v (@$vm) {
3481	# Get distro context
3482	my $pbos = pb_distro_get_context($v);
3483
3484	# Prepare the script to be executed on the VM/VE/RM
3485	# in $ENV{'PBDESTDIR'}/updatev
3486	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
3487
3488	print SCRIPT << 'EOF';
3489	#!/bin/bash
3490	sleep 2
3491	EOF
3492	# VE needs a good /proc
3493	if ($vtype eq "ve") {
3494	print SCRIPT "sudo /bin/mount -t proc /proc /proc\n";
3495	}
3496	print SCRIPT "$pbos->{'update'}\n";
3497	if ($vtype eq "ve") {
3498	print SCRIPT "sudo /bin/umount /proc\n";
3499	}
3500	close(SCRIPT);
3501	chmod 0755,"$pbscript";
3502
3503	# Force shutdown of VM except
3504	pb_script2v($pbscript,$vtype,1,$v);
3505	}
3506	return;
3507	}
3508
3509	sub pb_announce {
3510
3511	my $antype = shift;
3512
3513	# Get all required parameters
3514	my ($pbpackager,$pbrepo,$pbml,$pbsmtp) = pb_conf_get("pbpackager","pbrepo","pbml","pbsmtp");
3515	my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
3516	if (((not defined $testver) \|\| (not defined $testver->{$ENV{'PBPROJ'}}) \|\| ($testver->{$ENV{'PBPROJ'}} !~ /true/i)) && ($antype eq "Clean")) {
3517	# We just clean for test versions
3518	pb_log(0,"Unable to clean SSH repository for non testver version\n");
3519	return;
3520	}
3521	my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
3522	my @pkgs = @$pkg;
3523	my %pkgs;
3524	my $first = 0;
3525
3526	# Get all distros concerned
3527	my $pbos = pb_distro_get_context();
3528	my $distrolist = pb_get_distros($pbos,undef);
3529	my %dl;
3530	my %theorlist;
3531	my %archlist;
3532	foreach my $d (split(/,/,$distrolist)) {
3533	my ($d1,$d2,$d3) = split(/-/,$d);
3534	$dl{$d1}++;
3535	}
3536
3537	# Command to find packages on repo
3538	my $findstr = "find ".join(" ",keys %dl)." ";
3539	my $srcstr = "";
3540	# Generated announce files
3541	my @files;
3542
3543	foreach my $pbpkg (@pkgs) {
3544	if ($first != 0) {
3545	$findstr .= "-o ";
3546	}
3547	$first++;
3548	if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
3549	$pbver = $pkgv->{$pbpkg};
3550	} else {
3551	$pbver = $ENV{'PBPROJVER'};
3552	}
3553	if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
3554	$pbtag = $pkgt->{$pbpkg};
3555	} else {
3556	$pbtag = $ENV{'PBPROJTAG'};
3557	}
3558
3559	# TODO: use virtual/real names here now
3560	my $pbrealpkg = $pbpkg;
3561	my $pbrealpkgrpm = pb_cms_get_real_pkg($pbpkg,"rpm");
3562	my $pbrealpkgdeb = pb_cms_get_real_pkg($pbpkg,"deb");
3563	if ($antype eq "Clean") {
3564	# We only clean test versions anyway
3565	$pbtag = "0";
3566	my $nver = $pbver;
3567	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]";
3568	$pbver .= $ntag;
3569	$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\' ";
3570	$srcstr .= "src/$pbrealpkg-$pbver.tar.gz src/$pbrealpkg-$pbver.pbconf.tar.gz ";
3571	} else {
3572	my @date=pb_get_date();
3573	# the matching is only done on packages made the same day for test version. Hopefully this is enough
3574	my $nver = $pbver;
3575	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i) && ($antype eq "Check")) {
3576	$pbtag = "0";
3577	my $ntag .= strftime("%Y%m%d*", @date);
3578	$nver = $pbver."_p$ntag";
3579	$pbver .= $ntag;
3580	}
3581	$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\' ";
3582	}
3583
3584	if ($antype eq "Announce") {
3585	my $chglog;
3586
3587	pb_cms_init($pbinit);
3588	# Get project info on log file and generate tmp files used later on
3589	$chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
3590	$chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
3591	$chglog = undef if (! -f $chglog);
3592
3593	open(OUT,"> $ENV{'PBTMP'}/$pbpkg.ann") \|\| die "Unable to create $ENV{'PBTMP'}/$pbpkg.ann: $!";
3594	my $pb;
3595	$pb->{'realpkg'} = $pbrealpkg;
3596	$pb->{'ver'} = $pbver;
3597	$pb->{'tag'} = $pbtag;
3598	$pb->{'date'} = $pbdate;
3599	$pb->{'extdir'} = pb_get_extdir();
3600	$pb->{'chglog'} = $chglog;
3601	$pb->{'packager'} = $pbpackager;
3602	$pb->{'proj'} = $ENV{'PBPROJ'};
3603	$pb->{'repo'} = $pbrepo;
3604	$pb->{'pbos'}->{'type'} = "announce";
3605	$pb->{'pbos'}->{'suffix'} = "none";
3606	pb_changelog($pb,\*OUT,"yes");
3607	close(OUT);
3608	push(@files,"$ENV{'PBTMP'}/$pbpkg.ann");
3609	} elsif ($antype eq "Check") {
3610	# For the check we also build the theoritical complete list we should get
3611	foreach my $d (split(/,/,$distrolist)) {
3612	$pbos = pb_distro_get_context($d);
3613	if ($pbos->{'type'} eq "rpm") {
3614	$theorlist{"$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/$pbrealpkgrpm-$pbver-$pbtag$pbos->{'suffix'}"} = 0;
3615	} elsif ($pbos->{'type'} eq "deb") {
3616	$theorlist{"$pbos->{'name'}/$pbos->{'version'}/$pbrealpkgdeb"."_$pbver-$pbtag"} = 0;
3617	# TODO are we always using the last arch ?
3618	$archlist{"$pbos->{'name'}/$pbos->{'version'}/$pbrealpkgdeb"."_$pbver-$pbtag"} = "$pbos->{'arch'}";
3619	} elsif ($pbos->{'type'} eq "ebuild") {
3620	my $prefix = "-r";
3621	$prefix = "_p" if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i));
3622	$theorlist{"$pbos->{'name'}/$pbos->{'version'}/$pbrealpkg-$pbver$prefix$pbtag.ebuild"} = 0;
3623	$archlist{"$pbos->{'name'}/$pbos->{'version'}/$pbrealpkg-$pbver$prefix$pbtag.ebuild"} = "$pbos->{'arch'}";
3624	} elsif ($pbos->{'type'} eq "pkg") {
3625	$theorlist{"$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/$pbrealpkg-$pbver-$pbtag.pkg"} = 0;
3626	} else {
3627	pb_log(1,"No theoritical list possible for type $pbos->{'type'}\n");
3628	}
3629	}
3630	}
3631	pb_log(2,"theorlist : ".Dumper(%theorlist)."\n");
3632	}
3633	if ($antype eq "Announce") {
3634	$findstr .= " \| grep -Ev \'src.rpm\'";
3635	} elsif ($antype eq "Clean") {
3636	$findstr .= " \| xargs rm -f -v $srcstr ";
3637	}
3638
3639	# Prepare the command to run and execute it
3640	open(PBS,"> $ENV{'PBTMP'}/pbscript") \|\| die "Unable to create $ENV{'PBTMP'}/pbscript";
3641	print PBS "#!/bin/bash\n";
3642	print PBS "set -x\n" if ($pbdebug gt 1);
3643	print PBS "$findstr \| sort 2> /dev/null\n";
3644	close(PBS);
3645	chmod 0755,"$ENV{'PBTMP'}/pbscript";
3646	pb_send2target("Announce");
3647
3648	my $sl = "Project $ENV{'PBPROJ'} version $ENV{'PBPROJVER'} is now available";
3649	if ($antype eq "Announce") {
3650	# Get subject line
3651	pb_log(0,"Please enter the title of your announce\n");
3652	pb_log(0,"(By default: $sl)\n");
3653	my $sl2 = <STDIN>;
3654	$sl = $sl2 if ($sl2 !~ /^$/);
3655
3656	# Prepare a template of announce
3657	open(ANN,"> $ENV{'PBTMP'}/announce.html") \|\| die "Unable to create $ENV{'PBTMP'}/announce.html: $!";
3658	print ANN << "EOF";
3659	$sl</p>
3660
3661	<p>The project team is happy to announce the availability of a newest version of $ENV{'PBPROJ'} $ENV{'PBPROJVER'}. Enjoy it as usual!</p>
3662	<p>
3663	Now available at <a href="$pbrepo->{$ENV{'PBPROJ'}}">$pbrepo->{$ENV{'PBPROJ'}}</a>
3664	</p>
3665	<p>
3666	EOF
3667	}
3668
3669	open(LOG,"$ENV{'PBTMP'}/system.$$.log") \|\| die "Unable to read $ENV{'PBTMP'}/system.$$.log: $!";
3670	if ($antype eq "Announce") {
3671	my $col = 2;
3672	my $i = 1;
3673	print ANN << 'EOF';
3674	<TABLE WIDTH="100%" CELLPADDING="0" CELLSPACING="0" BORDER="0">
3675	<TR>
3676	EOF
3677	while (<LOG>) {
3678	print ANN "<TD><A HREF=\"$pbrepo->{$ENV{'PBPROJ'}}/$_\">$_</A></TD>";
3679	$i++;
3680	if ($i > $col) {
3681	print ANN "</TR>\n<TR>";
3682	$i = 1;
3683	}
3684	}
3685	} elsif ($antype eq "Clean") {
3686	while (<LOG>) {
3687	# skip errors
3688	next if ($_ !~ /^removed /);
3689	pb_log(0,"$_");
3690	}
3691	} else {
3692	# In Check mode we need to compare the 2 lists (real and theoritical)
3693	while (<LOG>) {
3694	# Get package name and remove what is in extra for the theoritical list (arch at the end)
3695	chomp();
3696	# skip find errors
3697	next if (/^find:/);
3698	my $p = $_;
3699	$p =~ s/\.(i[3456]86\|x86_64\|noarch\|src)\.rpm$//;
3700	$p =~ s/_(i[3456]86\|amd64\|all).deb$//;
3701	$p =~ s/(-0\.[0-9]{8})[0-9]{6}/$1*/ if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i));
3702	$p =~ s/(-r\|_p[0-9]+)\.ebuild/$1*/ if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i));
3703	$theorlist{$p} = -2 if (not defined $theorlist{$p});
3704	$theorlist{$p} = $theorlist{$p} + 1;
3705	}
3706	pb_log(2,"theorlist : ".Dumper(%theorlist)."\n");
3707	}
3708	close(LOG);
3709
3710	# Nothing more for the cleanssh case
3711	return if ($antype eq "Clean");
3712
3713	if ($antype eq "Check") {
3714	my ($chkex) = pb_conf_get_if("checkexclude");
3715	my $vmbuildlist = "";
3716	my $vebuildlist = "";
3717	my $rmbuildlist = "";
3718	my @pt = pb_conf_get_if("vmlist","velist","rmlist");
3719	foreach my $t (sort keys %theorlist) {
3720	if (defined $theorlist{$t} and $theorlist{$t} >= 1) {
3721	pb_log(1,"Packages found for $t\n");
3722	} elsif (defined $theorlist{$t} and $theorlist{$t} < 0) {
3723	pb_log(0,"Extra Package found for $t\n");
3724	} else {
3725	pb_log(2,"Analyzing $t\n");
3726	my ($os,$ver,$arch,$package) = split(/\//,$t);
3727	# Some distro have no arch subdir
3728	if (not defined $package) {
3729	$package = $arch;
3730	# TODO: If both arch have failed, we just make the last one
3731	$arch = $archlist{$t};
3732	}
3733	my $pbos = pb_distro_get_context("$os-$ver-$arch");
3734	my $pkgn = $package;
3735	if ($pbos->{'type'} ne "deb") {
3736	# package name is more easily found from the end for non deb
3737	# as '-' is the separator, but it can also be used in names
3738	$pkgn = reverse($package);
3739	# search the second '-' and isolate the now last part which is the full name
3740	$pkgn =~ s/([^-]+)-([^-]+)-([\S])+$/$3/;
3741	} else {
3742	$pkgn =~ s/([^_]+)_([\S])+$/$2/;
3743	}
3744	my $found = 0;
3745	# Handle the exclusion of OSes
3746	my $excl = "";
3747	$excl .= $chkex->{$pkgn} if (defined $chkex->{$pkgn});
3748	$excl .= $chkex->{"all"} if (defined $chkex->{"all"});
3749	foreach my $ex (split(/,/,$excl)) {
3750	$found = 1 if ("$os-$ver-$arch" =~ /^$ex/);
3751	}
3752	# Skip as excluded
3753	next if ($found == 1);
3754	pb_log(0,"Package NOT found for $t\n");
3755	# Avoid duplicates in list
3756	next if ($vmbuildlist =~ /$os-$ver-$arch/);
3757	next if ($vebuildlist =~ /$os-$ver-$arch/);
3758	next if ($rmbuildlist =~ /$os-$ver-$arch/);
3759	# check with which method we need to build
3760	if ((defined $pt[0]->{$ENV{'PBPROJ'}}) and ($pt[0]->{$ENV{'PBPROJ'}} =~ /$os-$ver-$arch/)) {
3761	$vmbuildlist = "$os-$ver-$arch" if ($vmbuildlist eq "");
3762	$vmbuildlist .= ",$os-$ver-$arch" if ($vmbuildlist !~ /$os-$ver-$arch/);
3763	next;
3764	}
3765	if ((defined $pt[1]->{$ENV{'PBPROJ'}}) and ($pt[1]->{$ENV{'PBPROJ'}} =~ /$os-$ver-$arch/)) {
3766	$vebuildlist = "$os-$ver-$arch" if ($vebuildlist eq "");
3767	$vebuildlist .= ",$os-$ver-$arch" if ($vebuildlist !~ /$os-$ver-$arch/);
3768	next;
3769	}
3770	if ((defined $pt[2]->{$ENV{'PBPROJ'}}) and ($pt[2]->{$ENV{'PBPROJ'}} =~ /$os-$ver-$arch/)) {
3771	$rmbuildlist = "$os-$ver-$arch" if ($rmbuildlist eq "");
3772	$rmbuildlist .= ",$os-$ver-$arch" if ($rmbuildlist !~ /$os-$ver-$arch/);
3773	}
3774	}
3775	}
3776	# If we want to rebuild automatically, let's do it
3777	if (defined $opts{'rebuild'}) {
3778	# SandBox or CMS
3779	pb_log(0,"Rebuilding from SandBox\n");
3780	pb_log(0,"for VMs: $vmbuildlist\n") if ($vmbuildlist ne "");
3781	pb_log(0,"for VEs: $vebuildlist\n") if ($vebuildlist ne "");
3782	pb_log(0,"for RMs: $rmbuildlist\n") if ($rmbuildlist ne "");
3783	pb_cms2build("SandBox");
3784	# Which mode
3785	$ENV{'PBV'} = $vmbuildlist;
3786	pb_build2v("vm","build") if ($vmbuildlist ne "");
3787	$ENV{'PBV'} = $vebuildlist;
3788	pb_build2v("ve","build") if ($vebuildlist ne "");
3789	$ENV{'PBV'} = $rmbuildlist;
3790	pb_build2v("rm","build") if ($rmbuildlist ne "");
3791	}
3792	# For the check part this is now finished
3793	return;
3794	}
3795
3796	print ANN << "EOF";
3797	</TR>
3798	</TABLE>
3799	</p>
3800
3801	<p>As usual source packages are also available in the same directory.</p>
3802
3803	<p>
3804	Changes are :
3805	</p>
3806	<p>
3807	EOF
3808	# Get each package changelog content
3809	foreach my $f (sort(@files)) {
3810	open(IN,"$f") \|\| die "Unable to read $f:$!";
3811	while (<IN>) {
3812	print ANN $_;
3813	}
3814	close(IN);
3815	print ANN "</p><p>\n";
3816	}
3817	print ANN "</p>\n";
3818	close(ANN);
3819
3820	# Allow for modification
3821	my $editor = "vi";
3822	$editor = $ENV{'EDITOR'} if (defined $ENV{'EDITOR'});
3823	pb_system("$editor $ENV{'PBTMP'}/announce.html","Allowing modification of the announce","noredir");
3824
3825	# Store it in DB for external usage (Web pages generation)
3826	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
3827
3828	my $precmd = "";
3829	if (! -f $db) {
3830	$precmd = "CREATE TABLE announces (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, announce VARCHAR[65535])";
3831	}
3832
3833	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
3834	{ RaiseError => 1, AutoCommit => 1 })
3835	\|\| die "Unable to connect to $db";
3836
3837	if ($precmd ne "") {
3838	my $sth = $dbh->prepare(qq{$precmd})
3839	\|\| die "Unable to create table into $db";
3840	$sth->execute();
3841	}
3842
3843	# To read whole file
3844	local $/;
3845	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
3846	my $announce = <ANN>;
3847	close(ANN);
3848
3849	pb_log(2,"INSERT INTO announces VALUES (NULL, $pbdate, $announce)");
3850	my $sth = $dbh->prepare(qq{INSERT INTO announces VALUES (NULL,?,?)})
3851	\|\| die "Unable to insert into $db";
3852	$sth->execute($pbdate, $announce);
3853	$sth->finish();
3854	$dbh->disconnect;
3855
3856	# Then deliver it on the Web
3857	# $TOOLHOME/livwww www
3858
3859	# Mail it to project's ML
3860	open(ML,"\| w3m -dump -T text/html > $ENV{'PBTMP'}/announce.txt") \|\| die "Unable to create $ENV{'PBTMP'}/announce.txt: $!";
3861	print ML << 'EOF';
3862	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/x html1/DTD/xhtml1-strict.dtd">
3863
3864	<html xmlns="http://www.w3.org/1999/xhtml" dir="ltr" xml:lang="en" lang="en">
3865	<head>
3866	</head>
3867	<body>
3868	<p>
3869	EOF
3870	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
3871	while(<ANN>) {
3872	print ML $_;
3873	}
3874	print ML << 'EOF';
3875	</body>
3876	</html>
3877	EOF
3878	close(ML);
3879
3880	# To read whole file
3881	local $/;
3882	open(ANN,"$ENV{'PBTMP'}/announce.txt") \|\| die "Unable to read $ENV{'PBTMP'}/announce.txt: $!";
3883	my $msg = <ANN>;
3884	close(ANN);
3885
3886	# Preparation of headers
3887	eval
3888	{
3889	require Mail::Sendmail;
3890	Mail::Sendmail->import();
3891	};
3892	if ($@) {
3893	# Mail::Sendmail not found not sending mail !
3894	pb_log(0,"No Mail::Sendmail module found so not sending any mail !\n");
3895	} else {
3896	my %mail = (
3897	To => $pbml->{$ENV{'PBPROJ'}},
3898	From => $pbpackager->{$ENV{'PBPROJ'}},
3899	Smtp => $pbsmtp->{$ENV{'PBPROJ'}},
3900	Body => $msg,
3901	Subject => "[ANNOUNCE] $sl",
3902	);
3903
3904	# Send mail
3905	if (! sendmail(%mail)) {
3906	if ((defined $Mail::Sendmail::error) and (defined $Mail::Sendmail::log)) {
3907	die "Unable to send mail ($Mail::Sendmail::error): $Mail::Sendmail::log";
3908	}
3909	}
3910	}
3911	}
3912
3913	#
3914	# Creates a set of HTML file containing the news for the project
3915	# based on what has been generated by the pb_announce function
3916	#
3917	sub pb_web_news2html {
3918
3919	my $dest = shift \|\| $ENV{'PBTMP'};
3920
3921	# Get all required parameters
3922	my ($pkgv, $pkgt) = pb_conf_get_if("pkgver","pkgtag");
3923
3924	# DB of announces for external usage (Web pages generation)
3925	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
3926
3927	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
3928	{ RaiseError => 1, AutoCommit => 1 })
3929	\|\| die "Unable to connect to $db";
3930	# For date handling
3931	$ENV{LANGUAGE}="C";
3932	my $firstjan = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year(), 0, 0, -1);
3933	my $oldfirst = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year()-1, 0, 0, -1);
3934	pb_log(2,"firstjan: $firstjan, oldfirst: $oldfirst, pbdate:$pbdate\n");
3935	my $all = $dbh->selectall_arrayref("SELECT id,date,announce FROM announces ORDER BY date DESC");
3936	my %news;
3937	$news{"cy"} = ""; # current year's news
3938	$news{"ly"} = ""; # last year news
3939	$news{"py"} = ""; # previous years news
3940	$news{"fp"} = ""; # first page news
3941	my $cpt = 4; # how many news for first page
3942	# Extract info from DB
3943	foreach my $row (@$all) {
3944	my ($id, $date, $announce) = @$row;
3945	$news{"cy"} = $news{"cy"}."<p><B>$date</B> $announce\n" if ((($date cmp $pbdate) le 0) && (($firstjan cmp $date) le 0));
3946	$news{"ly"} = $news{"ly"}."<p><B>$date</B> $announce\n" if ((($date cmp $firstjan) le 0) && (($oldfirst cmp $date) le 0));
3947	$news{"py"} = $news{"py"}."<p><B>$date</B> $announce\n" if (($date cmp $oldfirst) le 0);
3948	$news{"fp"} = $news{"fp"}."<p><B>$date</B> $announce\n" if ($cpt > 0);
3949	$cpt--;
3950	}
3951	pb_log(1,"news{fp}: ".$news{"fp"}."\n");
3952	$dbh->disconnect;
3953
3954	# Generate the HTML content
3955	foreach my $pref (keys %news) {
3956	open(NEWS,"> $dest/pb_web_$pref"."news.html") \|\| die "Unable to create $dest/pb_web_$pref"."news.html: $!";
3957	print NEWS "$news{$pref}";
3958	close(NEWS);
3959	}
3960	}
3961
3962
3963	# Return the SSH key file to use
3964	# Potentially create it if needed
3965
3966	sub pb_ssh_get {
3967
3968	my $create = shift \|\| 0; # Do not create keys by default
3969
3970	my ($pbagent) = pb_conf_get_if("pbusesshagent");
3971	# use ssh-agent if asked so.
3972	return(undef) if (($create == 0) && (defined $pbagent->{$ENV{'PBPROJ'}}) && ($pbagent->{$ENV{'PBPROJ'}} =~ /true/io));
3973
3974	# Check the SSH environment
3975	my $keyfile = undef;
3976
3977	# We have specific keys by default
3978	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
3979	if (!(-e $keyfile) && ($create eq 1)) {
3980	pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
3981	}
3982
3983	$keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
3984	$keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
3985	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
3986	die "Unable to find your public ssh key under $ENV{'HOME'}/.ssh" if (not defined $keyfile);
3987	return($keyfile);
3988	}
3989
3990
3991	# Returns the pid of a running VM command using a specific VM file
3992	sub pb_check_ps {
3993	my $vmcmd = shift;
3994	my $vmm = shift;
3995	my $vmexist = 0; # FALSE by default
3996
3997	open(PS, "ps auxhww\|") \|\| die "Unable to call ps";
3998	while (<PS>) {
3999	next if (! /$vmcmd/);
4000	next if (! /$vmm/);
4001	my ($void1, $void2);
4002	($void1, $vmexist, $void2) = split(/ +/);
4003	last;
4004	}
4005	return($vmexist);
4006	}
4007
4008
4009	sub pb_extract_build_files {
4010
4011	my $src=shift;
4012	my $dir=shift;
4013	my $ddir=shift;
4014	my $mandatory=shift \|\| "spec";
4015	my @files;
4016
4017	my $flag = "mayfail" if (($mandatory eq "patch") \|\| ($mandatory eq "src"));
4018	my $res;
4019
4020	if ($src =~ /tar\.gz$/) {
4021	$res = pb_system("tar xfpz $src $dir","Extracting $mandatory files from $src",$flag);
4022	} elsif ($src =~ /tar\.bz2$/) {
4023	$res = pb_system("tar xfpj $src $dir","Extracting $mandatory files from $src",$flag);
4024	} else {
4025	die "Unknown compression algorithm for $src";
4026	}
4027	# If not mandatory return now
4028	return() if (($res != 0) and (($mandatory eq "patch") \|\| ($mandatory eq "src")));
4029	opendir(DIR,"$dir") \|\| die "Unable to open directory $dir: $!";
4030	foreach my $f (readdir(DIR)) {
4031	next if ($f =~ /^\./);
4032	# Skip potential patch dir
4033	next if ($f =~ /^pbpatch/);
4034	# Skip potential source dir
4035	next if ($f =~ /^pbsrc/);
4036	# Skip potential backup files
4037	next if ($f =~ /~$/);
4038	move("$dir/$f","$ddir") \|\| die "Unable to move $dir/$f to $ddir";
4039	pb_log(2,"mv $dir/$f $ddir\n");
4040	push @files,"$ddir/$f";
4041	}
4042	closedir(DIR);
4043	# Not enough but still a first cleanup
4044	pb_rm_rf("$dir");
4045	return(@files);
4046	}
4047
4048	sub pb_list_bfiles {
4049
4050	my $dir = shift;
4051	my $pbpkg = shift;
4052	my $bfiles = shift;
4053	my $pkgfiles = shift;
4054	my $supfiles = shift;
4055	# subdir to keep if recursive mode, empty by default
4056	my $subdir = shift \|\| "";
4057	# In a recursive function , we need a local var as DIR handle
4058	my $bdir;
4059
4060	pb_log(2,"DEBUG: entering pb_list_bfiles in $dir: ".Dumper($bfiles)."\n");
4061	opendir($bdir,"$dir") \|\| die "Unable to open dir $dir: $!";
4062	foreach my $f (readdir($bdir)) {
4063	pb_log(3,"DEBUG: pb_list_bfiles found $f\n");
4064	next if ($f =~ /^\./);
4065	if (-d "$dir/$f") {
4066	# Recurse for directories (Debian 3.0 format e.g.)
4067	pb_log(2,"DEBUG: pb_list_bfiles recurse in $dir/$f\n");
4068	pb_list_bfiles("$dir/$f",$pbpkg,$bfiles,$pkgfiles,$supfiles,$f);
4069	next;
4070	}
4071
4072	my $key = $f;
4073	# if recursive then store also the subdir
4074	$key = "$subdir/$f" if ($subdir ne "");
4075	$bfiles->{$key} = "$dir/$f";
4076	$bfiles->{$key} =~ s~$ENV{'PBROOTDIR'}~~;
4077	if (defined $supfiles->{$pbpkg}) {
4078	$pkgfiles->{$key} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
4079	}
4080	}
4081	closedir($bdir);
4082	pb_log(2,"DEBUG: exiting pb_list_bfiles: ".Dumper($bfiles)."\n");
4083	}
4084
4085	sub pb_add_comma {
4086
4087	my $str = shift;
4088	my $addstr = shift;
4089
4090	$str .= "," if (defined $str);
4091	$str .= $addstr;
4092	return($str);
4093	}
4094
4095	sub pb_list_sfiles {
4096
4097	my $sdir = shift;
4098	my $ptr = shift;
4099	my $pbos = shift;
4100	my $extdir = shift;
4101
4102	pb_log(2,"DEBUG: entering pb_list_sfiles: ".Dumper($ptr)."\n");
4103	my $key = "$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
4104
4105	# Prepare local sources for this distro - They are always applied first - May be a problem one day
4106	# This function works for both patches and additional sources
4107	foreach my $p (sort(<$sdir/*>)) {
4108	$ptr->{$key} = pb_add_comma($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'}$/));
4109	}
4110
4111	# Prepare also remote sources to be included - Applied after the local ones
4112	foreach my $p ("all","$pbos->{'os'}","$pbos->{'type'}","$pbos->{'family'}","$pbos->{'name'}","$pbos->{'name'}-$pbos->{'version'}","$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}") {
4113	my $f = "$extdir.".".$p";
4114	next if (not -f $f);
4115	if (not open(PATCH,$f)) {
4116	pb_display("Unable to open existing external source file content $f\n");
4117	next;
4118	}
4119	while (<PATCH>) {
4120	chomp();
4121	$ptr->{$key} = pb_add_comma($ptr->{$key},"$_");
4122	}
4123	close(PATCH);
4124	}
4125	pb_log(2,"DEBUG: exiting pb_list_sfiles: ".Dumper($ptr)."\n");
4126	return($ptr);
4127	}
4128
4129	#
4130	# Return the list of packages we are working on in a non CMS action
4131	#
4132	sub pb_get_pkg {
4133
4134	my @pkgs = ();
4135
4136	my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
4137	@pkgs = keys %$var;
4138
4139	pb_log(0,"Packages: ".join(',',@pkgs)."\n");
4140	return(\@pkgs);
4141	}
4142
4143	# Manages VM/RM SSH port communication
4144	sub pb_get_port {
4145
4146	my $port = shift;
4147	my $pbos = shift;
4148	my $cmt = shift;
4149	my $nport;
4150
4151	die "No port passed in parameter. Report to dev team\n" if (not defined $port);
4152	# key is project on VM, but machine tuple for RM
4153	if ($cmt =~ /^RM/i) {
4154	$nport = $port->{"$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}"};
4155	} else {
4156	$nport = $port->{$ENV{'PBPROJ'}};
4157	}
4158	pb_log(2,"pb_get_port with $nport\n");
4159	# Maybe a port was given as parameter so overwrite
4160	$nport = "$pbport" if (defined $pbport);
4161	# 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
4162	if (($cmt ne "Packages") && ($cmt !~ /^RM/i)) {
4163	$nport += $ENV{'PBVMPORT'} if ((defined $pbparallel) && (defined $ENV{'PBVMPORT'}));
4164	}
4165	pb_log(2,"pb_get_port returns $nport\n");
4166	return($nport);
4167	}
4168
4169	sub pb_set_port {
4170
4171	my ($pid,$ident) = @_;
4172	pb_log(2,"pb_set_port for VM ($pid), id $ident\n");
4173	$ENV{'PBVMPORT'} = $ident;
4174	pb_log(2,"pb_set_port sets PBVMPORT in env to $ENV{'PBVMPORT'}\n");
4175	}
4176
4177	sub pb_set_parallel {
4178
4179	my $vtype = shift;
4180
4181	pb_log(2,"pb_set_parallel vtype: $vtype\n");
4182	# Take care of memory size if VM, parallel mode and more than 1 action
4183	if ((defined $pbparallel) && ($pbparallel ne 1) && ($vtype eq "vm")) {
4184	eval
4185	{
4186	require Linux::SysInfo;
4187	Linux::SysInfo->import();
4188	};
4189	if ($@) {
4190	# Linux::SysInfo not found
4191	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");
4192	} else {
4193	# Using the memory size
4194	my $si = Linux::SysInfo::sysinfo();
4195	if (not defined $si) {
4196	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");
4197	} else {
4198	# Keep the number of VM whose memory can be allocated
4199	my $ram = $si->{"totalram"}-$si->{"sharedram"}-$si->{"bufferram"};
4200	my $ram2;
4201	my ($vmmem) = pb_conf_get_if("vmmem");
4202
4203	my $v = "default";
4204	if ((defined $vmmem) and (defined $vmmem->{$v})) {
4205	$ram2 = $vmmem->{$v};
4206	} else {
4207	# Default for KVM/QEMU
4208	$ram2 = 128;
4209	}
4210	$pbparallel = sprintf("%d",$ram/$ram2);
4211	}
4212	pb_log(1,"Using $pbparallel processes at a time\n");
4213	}
4214	}
4215	pb_log(2,"pb_set_parallel returns: $pbparallel\n") if (defined $pbparallel);
4216	return($pbparallel);
4217	}
4218
4219	sub pb_get_sudocmds {
4220
4221	my $pbos = shift;
4222	my %sudocmds;
4223
4224	pb_log(2,"pb_get_sudocmds entering with lines:".Dumper(@_)."\n");
4225	foreach my $c (split(/;/,$pbos->{'update'}),split(/;/,$pbos->{'install'}),@_) {
4226	pb_log(2,"pb_get_sudocmds analyses $c\n");
4227	next if ($c !~ /^\s*sudo/);
4228	# remove sudo and leading spaces
4229	$c =~ s/^\s*sudo\s+//;
4230	# keep only the command, not the params
4231	$c =~ s/([^\s]+)\s.*$/$1/;
4232	$sudocmds{$c} = "";
4233	}
4234	pb_log(2,"pb_get_sudocmds returns ".Dumper(keys %sudocmds)."\n");
4235	return(keys %sudocmds);
4236	}
4237
4238	sub pb_sign_pkgs {
4239
4240	my $pbos = shift;
4241	my $made = shift;
4242
4243	pb_log(2,"entering pb_sign_pkg: $made ".Dumper($pbos)."\n");
4244	my ($passfile, $passphrase, $passpath) = pb_conf_get_if("pbpassfile","pbpassphrase","pbpasspath");
4245	$ENV{'PBPASSPHRASE'} = $passphrase->{$ENV{'PBPROJ'}} if ((not defined $ENV{'PBPASSPHRASE'}) && (defined $passphrase->{$ENV{'PBPROJ'}}));
4246	$ENV{'PBPASSFILE'} = $passfile->{$ENV{'PBPROJ'}} if ((not defined $ENV{'PBPASSFILE'})&& (defined $passfile->{$ENV{'PBPROJ'}})) ;
4247	$ENV{'PBPASSPATH'} = $passpath->{$ENV{'PBPROJ'}} if ((not defined $ENV{'PBPASSPATH'})&& (defined $passpath->{$ENV{'PBPROJ'}})) ;
4248
4249	# Remove extra spaces
4250	$made =~ s/\s+/ /g;
4251	$made =~ s/^\s//g;
4252	$made =~ s/\s$//g;
4253
4254	if ($pbos->{'type'} eq "rpm") {
4255	eval
4256	{
4257	require RPM4::Sign;
4258	RPM4::Sign->import();
4259	};
4260	if ($@) {
4261	# RPM4::Sign not found
4262	pb_log(1,"WARNING: Install RPM4::Sign to benefit from automatic package signing.\n");
4263	} else {
4264	return if ((not defined $ENV{'PBPASSPHRASE'}) and (not defined $ENV{'PBPASSFILE'}));
4265	my $sign = RPM4::Sign->new(
4266	passphrase => $ENV{'PBPASSPHRASE'},
4267	name => $ENV{'PBPACKAGER'},
4268	path => $ENV{'PBPASSPATH'},
4269	password_file => $ENV{'PBPASSFILE'},
4270	);
4271
4272	pb_log(0,"Signing RPM packages...\n");
4273	pb_log(2,"pb_sign_pkg: pkgs:".Dumper(split(/ /,$made))."\n");
4274	$sign->rpmssign(split(/ /,$made));
4275	}
4276	} elsif ($pbos->{'type'} eq "deb") {
4277	my $changes = "";
4278	foreach my $c (split(/ /,$made)) {
4279	$changes .= " $ENV{'PBBUILDDIR'}/$c" if (($c =~ /\.changes$/) && (-f "$ENV{PBBUILDDIR}/$c"));
4280	}
4281	my $debsigncmd = pb_check_req("debsign",1);
4282	pb_system("$debsigncmd -m\'$ENV{'PBPACKAGER'}\' $changes","Signing DEB packages",undef,1) if ($changes ne "");
4283	} else {
4284	pb_log(0,"I don't know yet how to sign packages for type $pbos->{'type'}.\nPlease give feedback to dev team\n");
4285	}
4286	pb_log(2,"exiting pb_sign_pkg\n");
4287	}
4288
4289	# return list of all distributins supported, comma separated
4290	sub pb_get_distros {
4291
4292	my $pbos = shift;
4293	my $pbtarget = shift;
4294
4295	my $dists = ("$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}");
4296
4297	# Get list of distributions for which we need to generate build files if no target
4298	if (not defined $pbtarget) {
4299	my @pt = pb_conf_get_if("vmlist","velist","rmlist");
4300	foreach my $pt (@pt) {
4301	push(@dists, split(/,/, $pt->{$ENV{PBPROJ}})) if defined $pt->{$ENV{PBPROJ}};
4302	}
4303	# remove any whitespace
4304	grep(s/\s+//go, @dists);
4305	}
4306	return(join(",",@dists));
4307	}
4308
4309	sub pb_get_extdir () {
4310
4311	# the pbrc file should contain it and whatever the key, we take it
4312	my ($ed) = pb_conf_read("$ENV{'PBDESTDIR'}/pbrc","pbextdir");
4313	pb_log(2,"ed: ".Dumper($ed)."\n");
4314	my $pbextdir = "";
4315	foreach my $k (keys %$ed) {
4316	$pbextdir = $ed->{$k};
4317	# In case we have an empty field, empty it completely
4318	pb_log(2,"pbextdir: *$pbextdir*\n");
4319	$pbextdir =~ s/^\s*$//;
4320	}
4321	pb_log(2,"pbextdir: *$pbextdir*\n");
4322	return($pbextdir);
4323	}
4324
4325	1;

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

Download in other formats: