Context Navigation

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

Last change on this file since 1486 was 1486, checked in by Bruno Cornec, 12 years ago
pb_mkdir_p now returns the return value of mkpath Do not point onto Cauldron anymore for Mageia chroots
Property svn:executable set to ``*
File size: 134.0 KB

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

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

Download in other formats: