Context Navigation

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

Last change on this file since 1541 was 1541, checked in by Bruno Cornec, 12 years ago
pb: Update to make the port and login optional config entries. Add more places where we use pb_path_expand so that $ENV{HOME} is properly expanded. Add more documentation to pb_setup2v. Error out on an unknown vtype. Fix code so that the http_proxy/ftp_proxy are kept for the root user as well as the build user. Apply new {ftp,http}_proxy options. (Eric Anderson)
Property svn:executable set to ``*
File size: 137.6 KB

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

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

Download in other formats: