Context Navigation

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

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

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

Download in other formats: