Context Navigation

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

Last change on this file since 1595 was 1595, checked in by Bruno Cornec, 12 years ago
pb_system is back to 3 params, as the previously undocumented "mayfail" 3rd parameter povides what the 4th was dded for. callers adapted in relationship
Property svn:executable set to ``*
File size: 148.7 KB

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

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

Download in other formats: