Context Navigation

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

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

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

Download in other formats: