Context Navigation

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

Last change on this file since 1480 was 1480, checked in by Bruno Cornec, 12 years ago

r4694@localhost: bruno | 2012-04-19 00:23:38 +0200

Skip potential backup files during build file tar creation

Property svn:executable set to *

File size: 133.9 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	close(SCRIPT);
1128	chmod 0755,"$ENV{'PBTMP'}/pbscript";
1129	}
1130
1131	# Apply filters to the non-build files
1132	my $liste ="";
1133	if (defined $filteredfiles->{$pbpkg}) {
1134	foreach my $f (split(/,/,$filteredfiles->{$pbpkg})) {
1135	pb_filter_file_inplace($ptr,"$dest/$f",$pb);
1136	$liste = "$f $liste";
1137	}
1138	}
1139	pb_log(2,"Files ".$liste."have been filtered\n");
1140
1141	# TODO: Make it CMS aware
1142	# Execute the pbinit script if any
1143	if (-x "$ENV{'PBROOTDIR'}/$pbpkg/pbinit") {
1144	pb_filter_file("$ENV{'PBROOTDIR'}/$pbpkg/pbinit",$ptr,"$ENV{'PBTMP'}/pbinit",$pb);
1145	chmod 0755,"$ENV{'PBTMP'}/pbinit";
1146	pb_system("cd $dest ; $ENV{'PBTMP'}/pbinit","Executing init script from $ENV{'PBROOTDIR'}/$pbpkg/pbinit under $dest","verbose");
1147	}
1148
1149	# Do we have additional script to run to prepare the environement for the project ?
1150	# Then include it in the pbconf delivery
1151	foreach my $pbvf (<$ENV{'PBROOTDIR'}/pbv.pre>,<$ENV{'PBROOTDIR'}/pbv.post>, <$ENV{'PBROOTDIR'}/pbtest*>) {
1152	if (-x "$pbvf") {
1153	my $target = "$ENV{'PBDESTDIR'}/".basename($pbvf);
1154	pb_filter_file("$pbvf",$ptr,$target,$pb);
1155	chmod 0755,"$target";
1156	}
1157	}
1158
1159	# Prepare the dest directory for archive
1160	chdir "$ENV{'PBDESTDIR'}" \|\| die "Unable to change dir to $ENV{'PBDESTDIR'}";
1161	if (defined $preserve) {
1162	# In that case we want to preserve the original tar file for checksum purposes
1163	# The one created is btw equivalent in that case to this one
1164	# Maybe check basename of both to be sure they are the same ?
1165	pb_log(0,"Preserving original tar file ");
1166	move("$preserve","$pbpkg-$pbver$pbextdir.tar.gz");
1167	} else {
1168	# Possibility to look at PBSRC to guess more the filename
1169	pb_system("tar cfz $pbpkg-$pbver$pbextdir.tar.gz --exclude=$pbpkg-$pbver$pbextdir/pbconf $pbpkg-$pbver$pbextdir","Creating $pbpkg tar files compressed");
1170	}
1171	pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.tar.gz\n");
1172	pb_system("tar cfz $pbpkg-$pbver$pbextdir.pbconf.tar.gz $pbpkg-$pbver$pbextdir/pbconf","Creating pbconf tar files compressed");
1173	pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.pbconf.tar.gz\n");
1174
1175	# Keep track of version-tag per pkg
1176	$pkgs{$pbpkg} = "$pbver-$pbtag";
1177
1178	# Final cleanup
1179	pb_rm_rf($dest) if (-d $dest);
1180	}
1181
1182	# Keep track of per package version
1183	pb_log(2,"DEBUG pkgs: ".Dumper(%pkgs)."\n");
1184	open(PKG,"> $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb") \|\| die "Unable to create $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb";
1185	foreach my $pbpkg (keys %pkgs) {
1186	print PKG "pbpkg $pbpkg = $pkgs{$pbpkg}\n";
1187	}
1188	close(PKG);
1189
1190	# Keep track of what is generated by default
1191	# We need to store the dir and info on version-tag
1192	# Base our content on the existing .pb file
1193	copy("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb","$ENV{'PBDESTDIR'}/pbrc");
1194	open(LAST,">> $ENV{'PBDESTDIR'}/pbrc") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbrc";
1195	print LAST "pbroot $ENV{'PBPROJ'} = $ENV{'PBROOTDIR'}\n";
1196	print LAST "projver $ENV{'PBPROJ'} = $ENV{'PBPROJVER'}\n";
1197	print LAST "projtag $ENV{'PBPROJ'} = $ENV{'PBPROJTAG'}\n";
1198	print LAST "pbpackager $ENV{'PBPROJ'} = $ENV{'PBPACKAGER'}\n";
1199	print LAST "pbextdir $ENV{'PBPROJ'} = $pbextdir\n";
1200	close(LAST);
1201	}
1202
1203	sub pb_test2pkg {
1204	# Get the running distro to test on
1205	my $pbos = pb_distro_get_context();
1206
1207	# Get list of packages to test
1208	# Get content saved in cms2build
1209	my $ptr = pb_get_pkg();
1210	@pkgs = @$ptr;
1211
1212	# Additional potential repo
1213	pb_distro_setuprepo($pbos);
1214	foreach my $pbpkg (@pkgs) {
1215	# We need to install the package to test, and deps brought with it
1216	pb_distro_installdeps(undef,$pbos,$pbpkg);
1217	pb_system("$ENV{'PBDESTDIR'}/pbtest","Launching test for $pbpkg","verbose");
1218	}
1219	}
1220
1221	sub pb_build2pkg {
1222
1223	# Get the running distro to build on
1224	my $pbos = pb_distro_get_context();
1225
1226	# If needed we may add repository to the build env
1227	pb_distro_setuprepo($pbos);
1228
1229	# Get list of packages to build
1230	my $ptr = pb_get_pkg();
1231	@pkgs = @$ptr;
1232
1233	# Get content saved in cms2build
1234	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1235	$pkg = { } if (not defined $pkg);
1236	my $pbextdir = pb_get_extdir();
1237
1238	pb_mkdir_p("$ENV{'PBBUILDDIR'}") if (! -d "$ENV{'PBBUILDDIR'}");
1239	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1240	my $made = ""; # pkgs made during build
1241	my $pm;
1242	$pm = new Parallel::ForkManager($pbparallel) if (defined $pbparallel);
1243
1244	# We need to communicate info back from the children if parallel so prepare a dir for that
1245	my $tmpd = "$ENV{'PBTMP'}/build.$$";
1246	pb_mkdir_p($tmpd) if (defined $pbparallel);
1247
1248	foreach my $pbpkg (@pkgs) {
1249	$pm->start and next if (defined $pbparallel);
1250
1251	my $vertag = $pkg->{$pbpkg};
1252	pb_log(2,"Vertag: $vertag\n");
1253	# get the version of the current package - maybe different
1254	($pbver,$pbtag) = split(/-/,$vertag);
1255
1256	my $src="$ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.tar.gz";
1257	my $src2="$ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.pbconf.tar.gz";
1258	pb_log(2,"Source file: $src\n");
1259	pb_log(2,"Pbconf file: $src2\n");
1260
1261	pb_log(2,"Working directory: $ENV{'PBBUILDDIR'}\n");
1262	if ($pbos->{'type'} eq "rpm") {
1263	foreach my $d ('RPMS','SRPMS','SPECS','SOURCES','BUILD') {
1264	if (! -d "$ENV{'PBBUILDDIR'}/$d") {
1265	pb_mkdir_p("$ENV{'PBBUILDDIR'}/$d");
1266	}
1267	}
1268
1269	# Remove in case a previous link/file was there
1270	unlink "$ENV{'PBBUILDDIR'}/SOURCES/".basename($src);
1271	symlink "$src","$ENV{'PBBUILDDIR'}/SOURCES/".basename($src) \|\| die "Unable to symlink $src in $ENV{'PBBUILDDIR'}/SOURCES";
1272	# We need to first extract the spec file
1273	my @specfile = pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/","$ENV{'PBBUILDDIR'}/SPECS","spec");
1274
1275	# We need to handle potential patches to upstream sources
1276	pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbpatch/","$ENV{'PBBUILDDIR'}/SOURCES","patch");
1277
1278	# We need to handle potential additional sources to upstream sources
1279	pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbsrc/","$ENV{'PBBUILDDIR'}/SOURCES","src");
1280
1281	pb_log(2,"specfile: ".Dumper(\@specfile)."\n");
1282	# set LANGUAGE to check for correct log messages
1283	$ENV{'LANGUAGE'}="C";
1284	# Older Redhat use _target_platform in %configure incorrectly
1285	my $specialdef = "";
1286	if (($pbos->{'name'} eq "redhat") \|\| (($pbos->{'name'} eq "rhel") && ($pbos->{'version'} eq "2.1"))) {
1287	$specialdef = "--define \'_target_platform \"\"\'";
1288	}
1289
1290	foreach my $f (@specfile) {
1291	if ($f =~ /\.spec$/) {
1292	# This could cause an issue in // mode
1293	pb_distro_installdeps($f,$pbos);
1294	pb_system("rpmbuild $specialdef --define \"packager $ENV{'PBPACKAGER'}\" --define \"_topdir $ENV{'PBBUILDDIR'}\" -ba $f","Building package with $f under $ENV{'PBBUILDDIR'}","verbose");
1295	last;
1296	}
1297	}
1298	# Get the name of the generated packages
1299	open(LOG,"$ENV{'PBTMP'}/system.$$.log") \|\| die "Unable to open $ENV{'PBTMP'}/system.$$.log";
1300	while (<LOG>) {
1301	chomp($_);
1302	next if ($_ !~ /^Wrote:/);
1303	s\|./([S]RPMS.*)\|$1\|;
1304	$made .=" $_";
1305	}
1306	close(LOG);
1307
1308	} elsif ($pbos->{'type'} eq "deb") {
1309	pb_system("tar xfz $src","Extracting sources");
1310	pb_system("tar xfz $src2","Extracting pbconf");
1311
1312	chdir "$pbpkg-$pbver$pbextdir" \|\| die "Unable to chdir to $pbpkg-$pbver$pbextdir";
1313	pb_rm_rf("debian");
1314	symlink "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}","debian" \|\| die "Unable to symlink to pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
1315	chmod 0755,"debian/rules";
1316
1317	# We need to handle potential patches to upstream sources
1318	pb_mkdir_p("debian/patches");
1319	my @f = pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbpatch/","debian/patches","patch");
1320
1321	# By default we use format 1.0 - Cf man dpkg-source
1322	my $debsrcfmt = "1.0";
1323	my $debsrcfile = "debian/source/format";
1324	if (-f $debsrcfile) {
1325	$debsrcfmt = pb_get_content($debsrcfile);
1326	}
1327
1328	if ($debsrcfmt =~ /^3.*quilt/) {
1329	# If we use quilt to manage patches, we then setup the env correctly
1330	# as per http://pkg-perl.alioth.debian.org/howto/quilt.html
1331	# Generate Debian patch series for quilt
1332	open(SERIE,"> debian/patches/series") \|\| die "Unable to write in debian/patches/series";
1333	$ENV{'QUILT_PATCHES'}="debian/patches";
1334	} else {
1335	# If we use dpatch to manage patches, we then setup the 00list file as well
1336	open(SERIE,"> debian/patches/00list") \|\| die "Unable to write in debian/patches/00list";
1337	}
1338	foreach my $f (sort @f) {
1339	# Skip the script made to apply the patches to the Debian tree
1340	next if ($f =~ /pbapplypatch/);
1341	# We also need to uncompress them
1342	pb_system("gzip -d $f","","quiet");
1343	$f =~ s/\.gz$//;
1344	print SERIE "$f\n";
1345	}
1346	close(SERIE);
1347	if (@f) {
1348	# We have patches...
1349	if ($debsrcfmt =~ /^1.*/) {
1350	# In that case we need to apply the patches ourselves locally
1351	pb_system("cat debian/patches/pbapplypatch","APPLY","verbose");
1352	pb_system("debian/patches/pbapplypatch","Applying patches to $pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'} tree");
1353	}
1354	# ...so modify the name of files to be Debian compliant
1355	move("../$src","../$pbpkg-$pbver$pbextdir.orig.tar.gz");
1356	}
1357
1358	# We need to handle potential additional sources to upstream sources
1359	#pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbsrc/","$ENV{'PBBUILDDIR'}/debian","src");
1360
1361	pb_distro_installdeps("debian/control",$pbos);
1362	pb_system("dpkg-buildpackage -us -uc -rfakeroot","Building package","verbose");
1363	# Get the name of the generated packages
1364	open(LOG,"$ENV{'PBTMP'}/system.$$.log") \|\| die "Unable to open $ENV{'PBTMP'}/system.$$.log";
1365	while (<LOG>) {
1366	chomp();
1367	my $tmp = $_;
1368	next if ($tmp !~ /^dpkg-deb.*:/);
1369	$tmp =~ s\|.\.\./(.)_(.).deb.\|$1\|;
1370	$made="$made $tmp.dsc $tmp.tar.gz $tmp"."_.deb $tmp"."_.changes";
1371	}
1372	close(LOG);
1373	chdir ".." \|\| die "Unable to chdir to parent dir";
1374	pb_rm_rf("$pbpkg-$pbver");
1375	} elsif ($pbos->{'type'} eq "ebuild") {
1376	my @ebuildfile;
1377	# For gentoo we need to take pb as subsystem name
1378	# We put every apps here under sys-apps. hope it's correct
1379	# We use pb's home dir in order to have a single OVERLAY line
1380	my $tmpe = "$ENV{'HOME'}/portage/pb/sys-apps/$pbpkg";
1381	pb_mkdir_p($tmpe) if (! -d "$tmpe");
1382	pb_mkdir_p("$ENV{'HOME'}/portage/distfiles") if (! -d "$ENV{'HOME'}/portage/distfiles");
1383
1384	# We need to first extract the ebuild file
1385	@ebuildfile = pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/","$tmpe","ebuild");
1386
1387	# Prepare the build env for gentoo
1388	my $found = 0;
1389	my $pbbd = $ENV{'HOME'};
1390	$pbbd =~ s\|/\|\\/\|g;
1391	if (-r "/etc/make.conf") {
1392	open(MAKE,"/etc/make.conf");
1393	while (<MAKE>) {
1394	$found = 1 if (/$pbbd\/portage/);
1395	}
1396	close(MAKE);
1397	}
1398	if ($found == 0) {
1399	pb_system("sudo sh -c 'echo PORTDIR_OVERLAY=\"$ENV{'HOME'}/portage\" >> /etc/make.conf'");
1400	}
1401	#$found = 0;
1402	#if (-r "/etc/portage/package.keywords") {
1403	#open(KEYW,"/etc/portage/package.keywords");
1404	#while (<KEYW>) {
1405	#$found = 1 if (/portage\/pb/);
1406	#}
1407	#close(KEYW);
1408	#}
1409	#if ($found == 0) {
1410	#pb_system("sudo sh -c \"echo portage/pb >> /etc/portage/package.keywords\"");
1411	#}
1412
1413	# Build
1414	foreach my $f (@ebuildfile) {
1415	if ($f =~ /\.ebuild$/) {
1416	pb_distro_installdeps($f,$pbos);
1417	move($f,"$tmpe/$pbpkg-$pbver.ebuild");
1418	pb_system("cd $tmpe ; ebuild $pbpkg-$pbver.ebuild clean ; ebuild $pbpkg-$pbver.ebuild digest ; ebuild $pbpkg-$pbver.ebuild package","verbose");
1419	# Now move it where pb expects it
1420	pb_mkdir_p("$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
1421	if ($pbtag eq 0) {
1422	# This is assumed to be a test version
1423	my $nver = substr($pbver,0,-14);
1424	my $ntag = substr($pbver,-14);
1425	my $ebtg = "portage/pb/sys-apps/$pbpkg/$pbpkg-$nver"."_p$ntag.ebuild";
1426	move("$tmpe/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/$ebtg");
1427	$made="$made $ebtg";
1428	} else {
1429	my $ebtg = "portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver-r$pbtag.ebuild";
1430	move("$tmpe/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/$ebtg");
1431	$made="$made $ebtg";
1432	}
1433	}
1434	}
1435
1436	} elsif ($pbos->{'type'} eq "tgz") {
1437	# Slackware family
1438	$made="$made $pbpkg/$pbpkg-$pbver-*-$pbtag.tgz";
1439
1440	pb_system("tar xfz $src","Extracting sources");
1441	pb_system("tar xfz $src2","Extracting pbconf");
1442	chdir "$pbpkg-$pbver$pbextdir" \|\| die "Unable to chdir to $pbpkg-$pbver$pbextdir";
1443	symlink "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}","install" \|\| die "Unable to symlink to pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
1444	if (-x "install/pbslack") {
1445	pb_distro_installdeps("./install/pbslack",$pbos);
1446	pb_system("./install/pbslack","Building software");
1447	pb_system("sudo /sbin/makepkg -p -l y -c y $pbpkg","Packaging $pbpkg","verbose");
1448	}
1449	chdir ".." \|\| die "Unable to chdir to parent dir";
1450	pb_rm_rf("$pbpkg-$pbver$pbextdir");
1451	} elsif ($pbos->{'type'} eq "pkg") {
1452	# Solaris
1453	$made="$made $pbpkg-$pbver-$pbtag.pkg.gz";
1454	my $pkgdestdir="$ENV{'PBBUILDDIR'}/install";
1455
1456	# Will host resulting packages
1457	pb_mkdir_p("$pbos->{'type'}");
1458	pb_mkdir_p("$pkgdestdir/delivery");
1459	pb_system("tar xfz $src","Extracting sources under $ENV{'PBBUILDDIR'}");
1460	pb_system("tar xfz $src2","Extracting pbconf under $ENV{'PBBUILDDIR'}");
1461	# We need to handle potential patches to upstream sources
1462	pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbpatch/","$ENV{'PBBUILDDIR'}","patch");
1463
1464	# We need to handle potential additional sources to upstream sources
1465	pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbsrc/","$ENV{'PBBUILDDIR'}","src");
1466
1467	chdir "$pbpkg-$pbver$pbextdir" \|\| die "Unable to chdir to $pbpkg-$pbver$pbextdir";
1468	if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild") {
1469	chmod 0755,"pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild";
1470	# pkginfo file is mandatory
1471	die "Unable to find pkginfo file in pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}" if (! -f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pkginfo");
1472	# Build
1473	pb_system("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild $pkgdestdir/delivery","Building software and installing under $pkgdestdir/delivery");
1474	# Copy complementary files
1475	if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/prototype") {
1476	copy("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/prototype", $pkgdestdir)
1477	} else {
1478	# No prototype provided, calculating it
1479	open(PROTO,"> $pkgdestdir/prototype") \|\| die "Unable to create prototype file";
1480	print PROTO "i pkginfo\n";
1481	print PROTO "i depend\n" if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/depend");
1482	$ENV{'PBSOLDESTDIR'} = "$pkgdestdir/delivery";
1483	find(\&create_solaris_prototype, "$pkgdestdir/delivery");
1484	}
1485	copy("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/depend", $pkgdestdir) if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/depend");
1486	copy("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pkginfo", $pkgdestdir);
1487	pb_system("cd $pkgdestdir/delivery ; pkgmk -o -f ../prototype -r $pkgdestdir/delivery -d $ENV{'PBBUILDDIR'}/$pbos->{'type'}","Packaging $pbpkg","verbose");
1488	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");
1489	pb_system("cd $ENV{'PBBUILDDIR'} ; gzip -9f $pbpkg-$pbver-$pbtag.pkg","Compressing $pbpkg-$pbver-$pbtag.pkg","verbose");
1490	} else {
1491	pb_log(0,"No pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild file found for $pbpkg-$pbver in \n");
1492	}
1493	chdir ".." \|\| die "Unable to chdir to parent dir";
1494	pb_rm_rf("$pbpkg-$pbver$pbextdir","$ENV{'PBBUILDDIR'}/$pbos->{'type'}","$pkgdestdir");
1495	} elsif ($pbos->{'type'} eq "hpux") {
1496	# HP-UX
1497	pb_system("tar xfz $src","Extracting sources");
1498	pb_system("tar xfz $src2","Extracting pbconf");
1499
1500	chdir "$pbpkg-$pbver$pbextdir" \|\| die "Unable to chdir to $pbpkg-$pbver$pbextdir";
1501	pb_system("buildpackage ","Building package","verbose");
1502	# Get the name of the generated packages
1503	open(LOG,"$ENV{'PBTMP'}/system.$$.log") \|\| die "Unable to open $ENV{'PBTMP'}/system.$$.log";
1504	while (<LOG>) {
1505	chomp();
1506	my $tmp = $_;
1507	next if ($tmp !~ /^SD BUILD.*:/);
1508	$tmp =~ s\|.../(.)_(.).sd.\|$1\|;
1509	$made = "$made $tmp"."_*.sd";
1510	}
1511	close(LOG);
1512	$made="$made $pbpkg-$pbver-$pbtag.sd";
1513
1514	chdir ".." \|\| die "Unable to chdir to parent dir";
1515	pb_rm_rf("$pbpkg-$pbver$pbextdir");
1516	} else {
1517	die "Unknown OS type format $pbos->{'type'}";
1518	}
1519	if (defined $pbparallel) {
1520	# Communicate results back to parent
1521	pb_set_content("$tmpd/$$",$made);
1522	$pm->finish;
1523	}
1524	}
1525	if (defined $pbparallel) {
1526	# In the parent, we need to get the result from the children
1527	$pm->wait_all_children;
1528	foreach my $f (<$tmpd/*>) {
1529	$made .= " ".pb_get_content($f);
1530	}
1531	pb_rm_rf($tmpd);
1532	}
1533
1534	# Sign packages
1535	pb_sign_pkgs($pbos,$made);
1536
1537	# Find the appropriate check cmd/opts
1538	my ($chkcmd,$chkopt) = pb_distro_get_param($pbos,pb_conf_get_if("oschkcmd","oschkopt"));
1539
1540	# Packages check if needed
1541	if ($pbos->{'type'} eq "rpm") {
1542	if ((defined $chkcmd) && (-x $chkcmd)) {
1543	my $cmd = "$chkcmd";
1544	$cmd .= " $chkopt" if (defined $chkopt);
1545	$cmd .= " $made";
1546	pb_system("$cmd","Checking validity of rpms with $chkcmd","verbose");
1547	}
1548	my $rpms ="";
1549	my $srpms ="";
1550	foreach my $f (split(/ /,$made)) {
1551	$rpms .= "$ENV{'PBBUILDDIR'}/$f " if ($f =~ /^RPMS\//);
1552	$srpms .= "$ENV{'PBBUILDDIR'}/$f " if ($f =~ /^SRPMS\//);
1553	}
1554	pb_log(0,"SRPM packages generated: $srpms\n");
1555	pb_log(0,"RPM packages generated: $rpms\n");
1556	} elsif ($pbos->{'type'} eq "deb") {
1557	my $made2 = "";
1558	foreach my $f (split(/ /,$made)) {
1559	$made2 .= "$f " if ($f =~ /\.deb$/);
1560	}
1561	if (-x $chkcmd) {
1562	pb_system("$chkcmd $chkopt $made2","Checking validity of debs with $chkcmd","verbose");
1563	}
1564	pb_log(0,"deb packages generated: $made2\n");
1565	} else {
1566	pb_log(0,"No check done for $pbos->{'type'} yet\n");
1567	pb_log(0,"Packages generated: $made\n");
1568	}
1569
1570	# Keep track of what is generated so that we can get them back from VMs/RMs
1571	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'}";
1572	print KEEP "$made\n";
1573	close(KEEP);
1574	}
1575
1576	sub create_solaris_prototype {
1577
1578	my $uidgid = "bin bin";
1579	my $pkgdestdir = $ENV{'PBSOLDESTDIR'};
1580
1581	return if ($_ =~ /^$pkgdestdir$/);
1582	if (-d $_) {
1583	my $n = $File::Find::name;
1584	$n =~ s~$pkgdestdir/~~;
1585	print PROTO "d none $n 0755 $uidgid\n";
1586	} elsif (-x $_) {
1587	my $n = $File::Find::name;
1588	$n =~ s~$pkgdestdir/~~;
1589	print PROTO "f none $n 0755 $uidgid\n";
1590	} elsif (-f $_) {
1591	my $n = $File::Find::name;
1592	$n =~ s~$pkgdestdir/~~;
1593	print PROTO "f none $n 0644 $uidgid\n";
1594	}
1595	}
1596
1597	sub pb_build2ssh {
1598	pb_send2target("Sources");
1599	pb_send2target("CPAN");
1600	}
1601
1602	sub pb_pkg2ssh {
1603	pb_send2target("Packages");
1604	}
1605
1606	# By default deliver to the the public site hosting the
1607	# ftp structure (or whatever) or a VM/VE/RM
1608	sub pb_send2target {
1609
1610	my $cmt = shift;
1611	my $v = shift \|\| undef;
1612	my $vmexist = shift \|\| 0; # 0 is FALSE
1613	my $vmpid = shift \|\| 0; # 0 is FALSE
1614	my $snapme = shift \|\| 0; # 0 is FALSE
1615
1616	pb_log(2,"DEBUG: pb_send2target($cmt,".Dumper($v).",$vmexist,$vmpid)\n");
1617	my $host = "sshhost";
1618	my $login = "sshlogin";
1619	my $dir = "sshdir";
1620	my $port = "sshport";
1621	my $conf = "sshconf";
1622	my $tmout = undef;
1623	my $path = undef;
1624	if ($cmt =~ /^VM/) {
1625	$login = "vmlogin";
1626	$dir = "pbdefdir";
1627	# Specific VM
1628	$tmout = "vmtmout";
1629	$path = "vmpath";
1630	$host = "vmhost";
1631	$port = "vmport";
1632	} elsif ($cmt =~ /^RM/) {
1633	$login = "rmlogin";
1634	$dir = "pbdefdir";
1635	# Specific RM
1636	$tmout = "rmtmout";
1637	$path = "rmpath";
1638	$host = "rmhost";
1639	$port = "rmport";
1640	} elsif ($cmt =~ /^VE/) {
1641	$login = "velogin";
1642	$dir = "pbdefdir";
1643	# Specific VE
1644	$path = "vepath";
1645	$conf = "rbsconf";
1646	} elsif ($cmt eq "Web") {
1647	$host = "websshhost";
1648	$login = "websshlogin";
1649	$dir = "websshdir";
1650	$port = "websshport";
1651	} elsif ($cmt eq "CPAN") {
1652	$host = "cpanpause";
1653	$login = "";
1654	$dir = "cpandir";
1655	$port = "";
1656	}
1657	my $cmd = "";
1658	my $src = "";
1659	my $cpanpkg = 0;
1660	my $pbos;
1661
1662	my $pbextdir = pb_get_extdir();
1663
1664	if ($cmt ne "Announce") {
1665	# Get list of packages to build
1666	my $ptr = pb_get_pkg();
1667	@pkgs = @$ptr;
1668
1669	# Get the running distro to consider
1670	$pbos = pb_distro_get_context($v);
1671
1672	# Get content saved in cms2build
1673	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1674	$pkg = { } if (not defined $pkg);
1675
1676	pb_mkdir_p("$ENV{'PBBUILDDIR'}") if (! -d "$ENV{'PBBUILDDIR'}");
1677	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1678	foreach my $pbpkg (@pkgs) {
1679	my $vertag = $pkg->{$pbpkg};
1680	# get the version of the current package - maybe different
1681	pb_log(2,"Vertag: $vertag\n");
1682	($pbver,$pbtag) = split(/-/,$vertag);
1683
1684	if (($cmt eq "Sources") \|\| ($cmt =~ /(V[EM]\|RM)build/)) {
1685	$src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.tar.gz $ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.pbconf.tar.gz";
1686	if ($cmd eq "") {
1687	$cmd = "ln -sf $pbpkg-$pbver$pbextdir.tar.gz $pbpkg-latest.tar.gz";
1688	} else {
1689	$cmd = "$cmd ; ln -sf $pbpkg-$pbver$pbextdir.tar.gz $pbpkg-latest.tar.gz";
1690	}
1691	} elsif ($cmt eq "Web") {
1692	$src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.tar.gz"
1693	}
1694
1695	# Do we have one perl package
1696	my @nametype = pb_conf_get_if("namingtype");
1697	my $type = $nametype[0]->{$pbpkg};
1698	if ((defined $type) && ($type eq "perl")) {
1699	$cpanpkg = 1;
1700	}
1701	}
1702	# Adds conf file for availability of conf elements
1703	pb_conf_add("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb");
1704	}
1705	my ($rbsconf,$testver,$delivery) = pb_conf_get_if($conf,"testver","delivery");
1706	if ($cmt =~ /CPAN/) {
1707	# Do not deliver on Pause if this is a test version
1708	return if (not defined $testver);
1709	return if ($testver =~ /true/);
1710	# Do not deliver on Pause if this is not a perl package
1711	return if ($cpanpkg == 0);
1712	}
1713
1714	if ($cmt =~ /(V[EM]\|RM)build/) {
1715	$src="$src $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc $ENV{'PBDESTDIR'}/pbscript.$$";
1716	} elsif ($cmt =~ /(V[EM]\|RM)Script/) {
1717	$src="$src $ENV{'PBDESTDIR'}/pbscript.$$";
1718	} elsif ($cmt =~ /(V[EM]\|RM)test/) {
1719	$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";
1720	} elsif (($cmt eq "Announce") \|\| ($cmt eq "Web") \|\| ($cmt eq "CPAN")) {
1721	$src="$src $ENV{'PBTMP'}/pbscript";
1722	} elsif ($cmt eq "Packages") {
1723	# Get package list from file made during build2pkg
1724	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'}";
1725	$src = <KEEP>;
1726	chomp($src);
1727	close(KEEP);
1728	$src = "$src $ENV{'PBBUILDDIR'}/pbscript.$$";
1729	}
1730	if (($cmt eq "Sources") \|\| ($cmt eq "Packages") \|\| ($cmt eq "CPAN")) {
1731	my ($pbpackager) = pb_conf_get("pbpackager");
1732	$ENV{'PBPACKAGER'} = $pbpackager->{$ENV{'PBPROJ'}};
1733	pb_log(0,"Exporting public key for $ENV{'PBPACKAGER'}\n");
1734	# Using pb_system is not working due to redirection below
1735	system("gpg --export -a \'$ENV{'PBPACKAGER'}\' > $ENV{'PBDESTDIR'}/$ENV{'PBPROJ'}.pubkey");
1736	chmod 0644,"$ENV{'PBDESTDIR'}/$ENV{'PBPROJ'}.pubkey";
1737	$src = "$src $ENV{'PBDESTDIR'}/$ENV{'PBPROJ'}.pubkey";
1738	}
1739	# Remove potential leading spaces (cause problem with basename)
1740	$src =~ s/^ *//;
1741	my $basesrc = "";
1742	foreach my $i (split(/ +/,$src)) {
1743	$basesrc .= " ".basename($i);
1744	}
1745
1746	pb_log(0,"Sources handled ($cmt): $src\n");
1747	pb_log(2,"values: ".Dumper(($host,$login,$dir,$port,$tmout,$path,$conf))."\n");
1748	my ($sshhost,$sshlogin,$sshdir,$sshport) = pb_conf_get($host,$login,$dir,$port);
1749	# Not mandatory...
1750	$delivery->{$ENV{'PBPROJ'}} = "" if (not defined $delivery->{$ENV{'PBPROJ'}});
1751	my ($vtmout,$vepath);
1752	# ...Except those in virtual context
1753	if ($cmt =~ /^VE/) {
1754	($vepath) = pb_conf_get($path);
1755	}
1756	if ($cmt =~ /^(V\|R)M/) {
1757	$vtmout = pb_distro_get_param($pbos,pb_conf_get_if($tmout));
1758	}
1759	my $remhost = $sshhost->{$ENV{'PBPROJ'}};
1760	my $remdir = $sshdir->{$ENV{'PBPROJ'}};
1761	if ($cmt =~ /^V[EM]\|RM/) {
1762	# In that case our real host is in the xxhost with the OS as key, not project as above
1763	$remhost = pb_distro_get_param($pbos,$sshhost);
1764	}
1765	pb_log(2,"ssh: ".Dumper(($remhost,$sshlogin,$remdir,$sshport,$vepath,$rbsconf))."\n");
1766	pb_log(2,"ssh: ".Dumper($vtmout)."\n") if (defined $vtmout);
1767
1768	my $mac;
1769	if ($cmt !~ /^VE/) {
1770	$mac = "$sshlogin->{$ENV{'PBPROJ'}}\@$remhost";
1771	# Overwrite account value if passed as parameter
1772	$mac = "$pbaccount\@$remhost" if (defined $pbaccount);
1773	pb_log(2, "DEBUG: pbaccount: $pbaccount => mac: $mac\n") if (defined $pbaccount);
1774	} else {
1775	# VE
1776	# Overwrite account value if passed as parameter (typically for setup2v)
1777	$mac = $sshlogin->{$ENV{'PBPROJ'}};
1778	$mac = $pbaccount if (defined $pbaccount);
1779	}
1780
1781	my $tdir;
1782	my $bdir;
1783	if (($cmt eq "Sources") \|\| ($cmt =~ /(V[EM]\|RM)Script/)) {
1784	$tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}/src";
1785	} elsif ($cmt eq "CPAN") {
1786	$tdir = "$remdir";
1787	} elsif ($cmt =~ /(V[EM]\|RM)(build\|test)/) {
1788	$tdir = $remdir."/$ENV{'PBPROJ'}/delivery";
1789	$bdir = $remdir."/$ENV{'PBPROJ'}/build";
1790	# Remove a potential $ENV{'HOME'} as bdir should be relative to pb's home
1791	$bdir =~ s\|\$ENV.+\}/\|\|;
1792	} elsif ($cmt eq "Announce") {
1793	$tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}";
1794	} elsif ($cmt eq "Web") {
1795	$tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}";
1796	} elsif ($cmt eq "Packages") {
1797	if (($pbos->{'type'} eq "rpm") \|\| ($pbos->{'type'} eq "pkg") \|\| ($pbos->{'type'} eq "hpux") \|\| ($pbos->{'type'} eq "tgz")) {
1798	# put packages under an arch subdir
1799	$tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}";
1800	} elsif (($pbos->{'type'} eq "deb") \|\| ($pbos->{'type'} eq "ebuild")) {
1801	# No need for an arch subdir
1802	$tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}";
1803	} else {
1804	die "Please teach the dev team where to deliver ($pbos->{'type'} type of packages\n";
1805	}
1806
1807	my $repodir = $tdir;
1808	$repodir =~ s\|^$remdir/\|\|;
1809
1810	my ($pbrepo) = pb_conf_get("pbrepo");
1811
1812	# Repository management
1813	open(PBS,"> $ENV{'PBBUILDDIR'}/pbscript.$$") \|\| die "Unable to create $ENV{'PBBUILDDIR'}/pbscript.$$";
1814	if ($pbos->{'type'} eq "rpm") {
1815	my $pbsha = pb_distro_get_param($pbos,pb_conf_get("ossha"));
1816	# Also make a pbscript to generate yum/urpmi bases
1817	print PBS << "EOF";
1818	#!/bin/bash
1819	# Prepare a script to ease yum setup
1820	EOF
1821	print PBS "set -x\n" if ($pbdebug gt 1);
1822	print PBS << "EOF";
1823	cat > $ENV{'PBPROJ'}.repo << EOT
1824	[$ENV{'PBPROJ'}]
1825	name=$pbos->{'name'} $pbos->{'version'} $pbos->{'arch'} - $ENV{'PBPROJ'} Vanilla Packages
1826	baseurl=$pbrepo->{$ENV{'PBPROJ'}}/$repodir
1827	enabled=1
1828	gpgcheck=1
1829	gpgkey=$pbrepo->{$ENV{'PBPROJ'}}/$repodir/$ENV{'PBPROJ'}.pubkey
1830	EOT
1831	chmod 644 $ENV{'PBPROJ'}.repo
1832
1833	# Clean up old repo content
1834	rm -rf headers/ repodata/
1835	# Create yum repo
1836	if [ -x /usr/bin/yum-arch ]; then
1837	yum-arch .
1838	fi
1839	# Create repodata
1840	createrepo -s $pbsha .
1841	# Link to the key
1842	(cd repodata ; ln -sf ../$ENV{'PBPROJ'}.pubkey repomd.xml.key)
1843	# sign the repomd (at least useful for SLES - which requires a local key)
1844	# gpg -a --detach-sign repodata/repomd.xml
1845	# SLES also looks for media.1/info.txt
1846	EOF
1847	if ($pbos->{'family'} eq "md") {
1848	# For Mandriva add urpmi management
1849	print PBS << "EOF";
1850	# Prepare a script to ease urpmi setup
1851	cat > $ENV{'PBPROJ'}.addmedia << EOT
1852	urpmi.addmedia $ENV{'PBPROJ'} $pbrepo->{$ENV{'PBPROJ'}}/$repodir with media_info/hdlist.cz
1853	EOT
1854	chmod 755 $ENV{'PBPROJ'}.addmedia
1855
1856	# Clean up old repo content
1857	rm -f hdlist.cz synthesis.hdlist.cz
1858	# Create urpmi repo
1859	genhdlist2 --clean .
1860	if [ \$\? -ne 0 ]; then
1861	genhdlist .
1862	fi
1863	EOF
1864	}
1865	if ($pbos->{'name'} eq "fedora") {
1866	# Extract the spec file to please Fedora maintainers :-(
1867	print PBS << "EOF";
1868	for p in $basesrc; do
1869	echo \$p \| grep -q 'src.rpm'
1870	if [ \$\? -eq 0 ]; then
1871	rpm2cpio \$p \| cpio -ivdum --quiet '*.spec'
1872	fi
1873	done
1874	EOF
1875	}
1876	if ($pbos->{'family'} eq "novell") {
1877	# Add ymp scripts for one-click install on SuSE
1878	print PBS << "EOF";
1879	# Prepare a script to ease SuSE one-click install
1880	# Cf: http://de.opensuse.org/1-Klick-Installation/ISV
1881	#
1882	cat > $ENV{'PBPROJ'}.ymp << EOT
1883	<?xml version="1.0" encoding="utf-8"?>
1884	<!-- vim: set sw=2 ts=2 ai et: -->
1885	<metapackage xmlns:os="http://opensuse.org/Standards/One_Click_Install" xmlns="http://opensuse.org/Standards/One_Click_Install">
1886	<group><!-- The group of software, typically one for project-builder.org -->
1887	<name>$ENV{'PBPROJ'} Bundle</name> <!-- Name of the software group -->
1888	<summary>Software bundle for the $ENV{'PBPROJ'} project</summary> <!--This message is shown to the user and should describe the whole bundle -->
1889	<description>This is the summary of the $ENV{'PBPROJ'} Project
1890
1891	Details are available on a per package basis below
1892
1893	</description><!--This is also shown to the user -->
1894	<remainSubscribed>false</remainSubscribed> <!-- Don't know what it mean -->
1895	<repositories><!-- List of needed repositories -->
1896	<repository>
1897	<name>$ENV{'PBPROJ'} Repository</name> <!-- Name of the repository -->
1898	<summary>This repository contains the $ENV{'PBPROJ'} project packages.</summary> <!-- Summary of the repository -->
1899	<description>This repository contains the $ENV{'PBPROJ'} project packages.</description><!-- This description is shown to the user -->
1900	<url>$pbrepo->{$ENV{'PBPROJ'}}/$repodir</url><!--URL of repository, which is added -->
1901	</repository>
1902	</repositories>
1903	<software><!-- A List of packages, which should be added through the one-click-installation -->
1904	EOT
1905	for p in $basesrc; do
1906	sum=`rpm -q --qf '%{SUMMARY}' \$p`
1907	name=`rpm -q --qf '%{NAME}' \$p`
1908	desc=`rpm -q --qf '%{description}' \$p`
1909	cat >> $ENV{'PBPROJ'}.ymp << EOT
1910	<item>
1911	<name>\$name</name><!-- Name of the package, is shown to the user and used to identify the package at the repository -->
1912	<summary>\$sum</summary> <!-- Summary of the package -->
1913	<description>\$desc</description> <!-- Description, is shown to the user -->
1914	</item>
1915	EOT
1916	done
1917	cat >> $ENV{'PBPROJ'}.ymp << EOT
1918	</software>
1919	</group>
1920	</metapackage>
1921	EOT
1922	chmod 644 $ENV{'PBPROJ'}.ymp
1923	EOF
1924	}
1925	} elsif ($pbos->{'type'} eq "deb") {
1926	# Also make a pbscript to generate apt bases
1927	# Cf: http://www.debian.org/doc/manuals/repository-howto/repository-howto.fr.html
1928	# This dirname removes ver
1929	my $debarch = $pbos->{'arch'};
1930	$debarch = "amd64" if ($pbos->{'arch'} eq "x86_64");
1931	my $rpd = dirname("$pbrepo->{$ENV{'PBPROJ'}}/$repodir");
1932	# Remove extra . in path to fix #522
1933	$rpd =~ s\|/./\|/\|g;
1934	print PBS << "EOF";
1935	#!/bin/bash
1936	# Prepare a script to ease apt setup
1937	cat > $ENV{'PBPROJ'}.sources.list << EOT
1938	deb $rpd $pbos->{'version'} contrib
1939	deb-src $rpd $pbos->{'version'} contrib
1940	EOT
1941	chmod 644 $ENV{'PBPROJ'}.sources.list
1942
1943	# Up two levels to deal with the dist dir cross versions
1944	cd ..
1945	mkdir -p dists/$pbos->{'version'}/contrib/binary-$debarch dists/$pbos->{'version'}/contrib/source
1946
1947	# Prepare a script to create apt info file
1948	# Reuse twice after
1949	TMPD=`mktemp -d /tmp/pb.XXXXXXXXXX` \|\| exit 1
1950	mkdir -p \$TMPD
1951	cat > \$TMPD/Release << EOT
1952	Archive: unstable
1953	Component: contrib
1954	Origin: $ENV{'PBPROJ'}
1955	Label: $ENV{'PBPROJ'} dev repository $pbrepo->{$ENV{'PBPROJ'}}
1956	EOT
1957
1958	echo "Creating Packages metadata ($pbos->{'arch'} aka $debarch)"
1959	dpkg-scanpackages -a$debarch $pbos->{'version'} /dev/null \| gzip -c9 > dists/$pbos->{'version'}/contrib/binary-$debarch/Packages.gz
1960	dpkg-scanpackages -a$debarch $pbos->{'version'} /dev/null \| bzip2 -c9 > dists/$pbos->{'version'}/contrib/binary-$debarch/Packages.bz2
1961	echo "Creating Contents metadata"
1962	apt-ftparchive contents $pbos->{'version'} \| gzip -c9 > dists/$pbos->{'version'}/Contents.gz
1963	echo "Creating Release metadata ($pbos->{'arch'} aka $debarch)"
1964	cat \$TMPD/Release > dists/$pbos->{'version'}/contrib/binary-$debarch/Release
1965	echo "Architecture: $debarch" >> dists/$pbos->{'version'}/contrib/binary-$debarch/Release
1966	echo "Creating Source metadata"
1967	dpkg-scansources $pbos->{'version'} /dev/null \| gzip -c9 > dists/$pbos->{'version'}/contrib/source/Sources.gz
1968	cat \$TMPD/Release > dists/$pbos->{'version'}/contrib/source/Release
1969	echo "Architecture: Source" >> dists/$pbos->{'version'}/contrib/source/Release
1970	echo "Creating Release metadata"
1971	# Signing that file would be useful but uneasy as gpg keys are not there
1972	# Cf: http://wiki.debian.org/SecureApt
1973	# Same as for repomd
1974	apt-ftparchive release dists/$pbos->{'version'} > dists/$pbos->{'version'}/Release
1975	rm -rf \$TMPD
1976	EOF
1977	} elsif ($pbos->{'type'} eq "ebuild") {
1978	# make a pbscript to generate links to latest version
1979	print PBS << "EOF";
1980	#!/bin/bash
1981	# Prepare a script to create correct links
1982	for p in $src; do
1983	echo \$p \| grep -q '.ebuild'
1984	if [ \$\? -eq 0 ]; then
1985	j=`basename \$p`
1986	pp=`echo \$j \| cut -d'-' -f1`
1987	ln -sf \$j \$pp.ebuild
1988	fi
1989	done
1990	EOF
1991	}
1992	close(PBS);
1993	chmod 0755,"$ENV{'PBBUILDDIR'}/pbscript.$$";
1994	} else {
1995	return;
1996	}
1997
1998	# Useless for VE
1999	my $nport = pb_get_port($sshport,$pbos,$cmt) if ($cmt !~ /^VE/);
2000
2001	# Remove a potential $ENV{'HOME'} as tdir should be relative to pb's home
2002	$tdir =~ s\|\$ENV.+\}/\|\|;
2003
2004	my $tm = "";
2005	if ($cmt =~ /^(V\|R)M/) {
2006	$tm = "sleep $vtmout" if (defined $vtmout);
2007	}
2008
2009	# ssh communication if not VE or CPAN
2010	# should use a hash instead...
2011	my ($shcmd,$cpcmd,$cptarget,$cp2target);
2012	if ($cmt =~ /^VE/) {
2013	my $tp = $vepath->{$ENV{'PBPROJ'}};
2014	my $tpdir = "$tp/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}";
2015	my ($ptr) = pb_conf_get("vetype");
2016	my $vetype = $ptr->{$ENV{'PBPROJ'}};
2017	if ($vetype eq "chroot") {
2018	$shcmd = "sudo /usr/sbin/chroot $tpdir /bin/su - $mac -c ";
2019	} elsif ($vetype eq "schroot") {
2020	$shcmd = "schroot $tp -u $mac -- ";
2021	}
2022	$cpcmd = "sudo /bin/cp -r ";
2023	# We need to get the home dir of the target account to deliver in the right place
2024	open(PASS,"$tpdir/etc/passwd") \|\| die "Unable to open $tpdir/etc/passwd";
2025	my $homedir = "";
2026	while (<PASS>) {
2027	my ($c1,$c2,$c3,$c4,$c5,$c6,$c7) = split(/:/);
2028	$homedir = $c6 if ($c1 =~ /^$mac$/);
2029	pb_log(3,"Homedir: $homedir - account: $c6\n");
2030	}
2031	close(PASS);
2032	$cptarget = "$tpdir/$homedir/$tdir";
2033	if ($cmt eq "VEbuild") {
2034	$cp2target = "$tpdir/$homedir/$bdir";
2035	}
2036	pb_log(2,"On VE using $cptarget as target dir to copy to\n");
2037	} elsif ($cmt =~ /^CPAN/) {
2038	my $ftpput = pb_check_req("ncftpput",1);
2039	my $ftpget = pb_check_req("wget",1);
2040	my ($cpanuser,$cpanpasswd) = pb_conf_get("cpanuser","cpanpasswd");
2041	my ($cpansubdir) = pb_conf_get_if("cpansubdir");
2042	$shcmd = "$ftpget --post-data \'HIDDENNAME=".$cpanuser;
2043	$shcmd .= "&user=".$cpanuser;
2044	$shcmd .= "&password=".$cpanpasswd;
2045	$shcmd .= "&SUBMIT_pause99_add_uri_upload=\"Upload the checked files\"";
2046	$shcmd .= "&pause99_add_uri_subdirtext=".$cpansubdir if (defined $cpansubdir);
2047	foreach my $s (split(/ /,$src)) {
2048	$shcmd .= "&pause99_add_uri_upload=".basename($s);
2049	}
2050	$shcmd .= "'";
2051	$cpcmd = "$ftpput $host $dir";
2052	$cptarget = "CPAN";
2053	} else {
2054	my $keyfile = pb_ssh_get(0);
2055	my $sshcmd = pb_check_req("ssh",1);
2056	my $scpcmd = pb_check_req("scp",1);
2057	$shcmd = "$sshcmd -i $keyfile -q -o UserKnownHostsFile=/dev/null -p $nport $mac";
2058	$cpcmd = "$scpcmd -i $keyfile -p -o UserKnownHostsFile=/dev/null -P $nport";
2059	$cptarget = "$mac:$tdir";
2060	if ($cmt =~ /^(V\|R)Mbuild/) {
2061	$cp2target = "$mac:$bdir";
2062	}
2063	}
2064
2065	my $logres = "";
2066	# Do not touch when just announcing
2067	if (($cmt ne "Announce") && ($cmt ne "CPAN")) {
2068	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");
2069	} else {
2070	$logres = "> ";
2071	}
2072	pb_system("cd $ENV{'PBBUILDDIR'} ; $cpcmd $src $cptarget 2> /dev/null","$cmt delivery in $cptarget");
2073
2074	# For VE we need to change the owner manually
2075	if ($cmt =~ /^VE/) {
2076	pb_system("$shcmd \"sudo chown -R $mac $tdir\"","Adapt owner in $tdir to $mac");
2077	}
2078
2079	# Use the right script name depending on context
2080	my $pbscript;
2081	if (($cmt =~ /^(V[EM]\|RM)/) \|\| ($cmt =~ /Packages/)){
2082	$pbscript = "pbscript.$$";
2083	} else {
2084	$pbscript = "pbscript";
2085	}
2086
2087	# It's already ready for CPAN
2088	my $shcmdbase = $shcmd;
2089	if ($cmt !~ /^CPAN/) {
2090	$shcmd .= " \"echo \'cd $tdir ; if [ -x $pbscript ]; then ./$pbscript; fi ; rm -f ./$pbscript\' \| bash\"";
2091	}
2092	my $cmdverb = "verbose";
2093	if (($cmt eq "Announce") \|\| ($cmt eq "CPAN")) {
2094	$cmdverb = undef;
2095	}
2096	pb_system("$shcmd","Executing pbscript on $cptarget if needed",$cmdverb);
2097	if ($cmt =~ /^(V[EM]\|RM)build/) {
2098	# Get back info on pkg produced, compute their name and get them from the VM/RM
2099	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");
2100	# For VE we need to change the owner manually
2101	if ($cmt eq "VEbuild") {
2102	pb_system("sudo chown $UID $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$","Adapt owner in $tdir to $UID");
2103	}
2104	if (not -f "$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$") {
2105	pb_log(0,"Problem with VM/RM $v on $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$");
2106	} else {
2107	open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$") \|\| die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$";
2108	my $src = <KEEP>;
2109	chomp($src);
2110	close(KEEP);
2111	unlink("$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$");
2112
2113	$src =~ s/^ *//;
2114	pb_mkdir_p("$ENV{'PBBUILDDIR'}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}");
2115	# Change pgben to make the next send2target happy
2116	my $made = "";
2117
2118	# For VM/RM we don't want shell expansion to hapen locally but remotely
2119	my $delim = '\'';
2120	if ($cmt =~ /^VEbuild/) {
2121	# For VE we need to support shell expansion locally
2122	$delim = "";
2123	}
2124
2125	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'}";
2126	foreach my $p (split(/ +/,$src)) {
2127	my $j = basename($p);
2128	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'}");
2129	$made="$made $pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/$j"; # if (($pbos->{'type'} ne "rpm") \|\| ($j !~ /.src.rpm$/));
2130	}
2131	print KEEP "$made\n";
2132	close(KEEP);
2133	pb_system("$shcmdbase \"rm -rf $tdir $bdir\"","$cmt cleanup");
2134
2135	# Sign packages locally
2136	pb_sign_pkgs($pbos,$made);
2137
2138	# We want to send them to the ssh account so overwrite what has been done before
2139	undef $pbaccount;
2140	pb_log(2,"Before sending pkgs, vmexist: $vmexist, vmpid: $vmpid\n");
2141	pb_send2target("Packages",$pbos->{'name'}."-".$pbos->{'version'}."-".$pbos->{'arch'},$vmexist,$vmpid);
2142	pb_rm_rf("$ENV{'PBBUILDDIR'}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}");
2143	}
2144	}
2145	unlink("$ENV{'PBDESTDIR'}/pbscript.$$") if ((($cmt =~ /^(V[ME]\|RM)/) \|\| ($cmt =~ /Packages/)) && ($pbkeep eq 0));
2146
2147	pb_log(2,"Before halt, vmexist: $vmexist, vmpid: $vmpid\n");
2148	if ((! $vmexist) && ($cmt =~ /^VM/)) {
2149	# If in setupvm then takes a snapshot just before halting
2150	if ($snapme != 0) {
2151	my ($vmmonport,$vmtype) = pb_conf_get("vmmonport","vmtype");
2152	# For monitoring control
2153	if ((($vmtype->{$ENV{'PBPROJ'}}) eq "kvm") \|\| (($vmtype->{$ENV{'PBPROJ'}}) eq "qemu")) {
2154	eval
2155	{
2156	require Net::Telnet;
2157	Net::Telnet->import();
2158	};
2159	if ($@) {
2160	# Net::Telnet not found
2161	pb_log(1,"ADVISE: Install Net::Telnet to benefit from monitoring control and snapshot feature.\nWARNING: No snapshot created");
2162	} else {
2163	my $t = new Net::Telnet (Timeout => 120, Host => "localhost", Port => $vmmonport->{$ENV{'PBPROJ'}}) \|\| die "Unable to dialog on the monitor";
2164	# move to monitor mode
2165	my @lines = $t->cmd("c");
2166	# Create a snapshot named pb
2167	@lines = $t->cmd("savevm pb");
2168	# Write the new status in the VM
2169	@lines = $t->cmd("commit all");
2170	# End
2171	@lines = $t->cmd("quit");
2172	}
2173	}
2174	}
2175	my $hoption = "-p";
2176	my $hpath = pb_distro_get_param($pbos,pb_conf_get("ospathcmd-halt"));
2177	# Solaris doesn't support -p of halt
2178	if ($pbos->{'type'} eq "pkg") {
2179	$hoption = "" ;
2180	}
2181	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)");
2182	}
2183	if (($cmt =~ /^VE/) && ($snapme != 0)) {
2184	my $tpdir = "$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}";
2185	pb_system("sudo tar cz -C $tpdir -f $vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}.tar.gz .","Creating a snapshot of $tpdir");
2186	}
2187	}
2188
2189	sub pb_script2v {
2190	my $pbscript=shift;
2191	my $vtype=shift;
2192	my $pbforce=shift \|\| 0; # Force stop of VM. Default not.
2193	my $vm1=shift \|\| undef; # Only that VM/VE/RM to treat. Default all.
2194	my $snapme=shift \|\| 0; # Do we have to create a snapshot. Default not.
2195	my $vm;
2196	my $all;
2197
2198	pb_log(2,"DEBUG: pb_script2v($pbscript,$vtype,$pbforce,".Dumper($vm1).",$snapme)\n");
2199	# Prepare the script to be executed on the VM/VE/RM
2200	# in $ENV{'PBDESTDIR'}/pbscript.$$
2201	if ((defined $pbscript ) && ($pbscript ne "$ENV{'PBDESTDIR'}/pbscript.$$")) {
2202	copy($pbscript,"$ENV{'PBDESTDIR'}/pbscript.$$") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript.$$";
2203	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript.$$";
2204	}
2205
2206	if (not defined $vm1) {
2207	($vm,$all) = pb_get2v($vtype);
2208	} else {
2209	@$vm = ($vm1);
2210	}
2211	my ($vmexist,$vmpid) = (undef,undef);
2212
2213	foreach my $v (@$vm) {
2214	# Launch VM/VE
2215	($vmexist,$vmpid) = pb_launchv($vtype,$v,0,$snapme,$pbsnap);
2216
2217	if ($vtype eq "vm") {
2218	pb_log(2,"DEBUG: After pb_launchv, vmexist: $vmexist, vmpid: $vmpid\n");
2219
2220	# Skip that VM/RM if something went wrong
2221	next if (($vmpid == 0) && ($vmexist == 0));
2222
2223	# If force stopping the VM then reset vmexist
2224	if ($pbforce == 1) {
2225	$vmpid = $vmexist;
2226	$vmexist = 0;
2227	}
2228	} else {
2229	#VE
2230	$vmexist = 0;
2231	$vmpid = 0;
2232	}
2233
2234	# Gather all required files to send them to the VM/VE/RM
2235	# and launch the build through pbscript
2236	pb_log(2,"DEBUG: Before send2target, vmexist: $vmexist, vmpid: $vmpid\n");
2237	pb_send2target(uc($vtype)."Script","$v",$vmexist,$vmpid,$snapme);
2238
2239	}
2240	}
2241
2242	sub pb_launchv {
2243	my $vtype = shift;
2244	my $v = shift;
2245	my $create = shift \|\| 0; # By default do not create a VM/VE/RM
2246	my $snapme = shift \|\| 0; # By default do not snap a VM/VE/RM
2247	my $usesnap = shift \|\| 1; # By default study the usage of the snapshot feature of VM/VE/RM
2248
2249	# If creation or snapshot creation mode, no snapshot usable
2250	if (($create == 1) \|\| ($snapme == 1)) {
2251	$usesnap = 0;
2252	}
2253
2254	pb_log(2,"DEBUG: pb_launchv($vtype,$v,$create,$snapme,$usesnap)\n");
2255	die "No VM/VE/RM defined, unable to launch" if (not defined $v);
2256	# Keep only the first VM in case many were given
2257	$v =~ s/,.*//;
2258
2259	my $pbos = pb_distro_get_context($v);
2260
2261	# Launch the VMs/VEs
2262	if ($vtype eq "vm") {
2263	die "-i iso parameter needed" if (((not defined $iso) \|\| ($iso eq "")) && ($create != 0));
2264
2265	# TODO: vmmonport should be optional
2266	my ($ptr,$ptr2,$vmpath,$vmport,$vms,$vmmonport) = pb_conf_get("vmtype","vmcmd","vmpath","vmport","vmsize","vmmonport");
2267	my ($vmopt,$vmmm,$vmtmout,$vmsnap,$vmbuildtm) = pb_conf_get_if("vmopt","vmmem","vmtmout","vmsnap","vmbuildtm");
2268	my $vmsize = pb_distro_get_param($pbos,$vms);
2269
2270	my $vmtype = $ptr->{$ENV{'PBPROJ'}};
2271	my $vmcmd = $ptr2->{$ENV{'PBPROJ'}};
2272
2273	if (defined $opts{'g'}) {
2274	if (($vmtype eq "kvm") \|\| ($vmtype eq "qemu")) {
2275	$ENV{'PBVMOPT'} = "--nographic";
2276	}
2277	}
2278	if (not defined $ENV{'PBVMOPT'}) {
2279	$ENV{'PBVMOPT'} = "";
2280	}
2281	# Save the current status for later restoration
2282	$ENV{'PBOLDVMOPT'} = $ENV{'PBVMOPT'};
2283	# Set a default timeout of 2 minutes
2284	if (not defined $ENV{'PBVMTMOUT'}) {
2285	$ENV{'PBVMTMOUT'} = "120";
2286	}
2287	if (defined $vmopt->{$v}) {
2288	$ENV{'PBVMOPT'} .= " $vmopt->{$v}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$v}/);
2289	} elsif (defined $vmopt->{$ENV{'PBPROJ'}}) {
2290	$ENV{'PBVMOPT'} .= " $vmopt->{$ENV{'PBPROJ'}}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$ENV{'PBPROJ'}}/);
2291	}
2292
2293	# How much memory to allocate for VMs
2294	my $vmmem = pb_distro_get_param($pbos,$vmmm);
2295	if (defined $vmmem) {
2296	$ENV{'PBVMOPT'} .= " -m $vmmem";
2297	}
2298
2299	# Are we allowed to use snapshot feature
2300	if ($usesnap == 1) {
2301	if ((defined $vmsnap->{$v}) && ($vmsnap->{$v} =~ /true/i)) {
2302	$ENV{'PBVMOPT'} .= " -snapshot";
2303	} elsif ((defined $vmsnap->{$ENV{'PBPROJ'}}) && ($vmsnap->{$ENV{'PBPROJ'}} =~ /true/i)) {
2304	$ENV{'PBVMOPT'} .= " -snapshot";
2305	} elsif ($pbsnap eq 1) {
2306	$ENV{'PBVMOPT'} .= " -snapshot";
2307	}
2308	}
2309	if ($snapme != 0) {
2310	if (($vmtype eq "kvm") \|\| ($vmtype eq "qemu")) {
2311	# Configure the monitoring to automate the creation of the 'pb' snapshot
2312	$ENV{'PBVMOPT'} .= " -serial mon:telnet::$vmmonport->{$ENV{'PBPROJ'}},server,nowait";
2313	# In that case no snapshot call needed
2314	$ENV{'PBVMOPT'} =~ s/ -snapshot//;
2315	}
2316	}
2317	if (defined $vmtmout->{$v}) {
2318	$ENV{'PBVMTMOUT'} = $vmtmout->{$v};
2319	} elsif (defined $vmtmout->{$ENV{'PBPROJ'}}) {
2320	$ENV{'PBVMTMOUT'} = $vmtmout->{$ENV{'PBPROJ'}};
2321	}
2322	my $nport = pb_get_port($vmport,$pbos,$vtype);
2323
2324	my $cmd;
2325	my $vmm; # has to be used for pb_check_ps
2326	if (($vmtype eq "qemu") \|\| ($vmtype eq "kvm")) {
2327	$vmm = "$vmpath->{$ENV{'PBPROJ'}}/$v.qemu";
2328	if (($create != 0) \|\| (defined $iso)) {
2329	$ENV{'PBVMOPT'} .= " -cdrom $iso -boot d";
2330	}
2331	# Always redirect the network and always try to use a 'pb' snapshot
2332	#$cmd = "$vmcmd $ENV{'PBVMOPT'} -net user,hostfwd=tcp:$nport:10.0.2.15:22 -loadvm pb $vmm"
2333	$cmd = "$vmcmd $ENV{'PBVMOPT'} -redir tcp:$nport:10.0.2.15:22 $vmm"
2334	} elsif ($vmtype eq "xen") {
2335	} elsif ($vmtype eq "vmware") {
2336	} else {
2337	die "VM of type $vmtype not supported. Report to the dev team";
2338	}
2339	# Restore the ENV VAR Value
2340	$ENV{'PBVMOPT'} = $ENV{'PBOLDVMOPT'};
2341
2342	my ($tmpcmd,$void) = split(/ +/,$cmd);
2343	my $vmexist = pb_check_ps($tmpcmd,$vmm);
2344	my $vmpid = 0;
2345	if (! $vmexist) {
2346	if ($create != 0) {
2347	die("Found an existing Virtual machine $vmm. Won't overwrite") if (-r $vmm);
2348	if (($vmtype eq "qemu") \|\| ($vmtype eq "xen") \|\| ($vmtype eq "kvm")) {
2349	my $command = pb_check_req("qemu-img",0);
2350	pb_system("$command create -f qcow2 $vmm $vmsize","Creating the QEMU VM");
2351	} elsif ($vmtype eq "vmware") {
2352	} else {
2353	}
2354	}
2355	if (! -f "$vmm") {
2356	pb_log(0,"Unable to find VM $vmm\n");
2357	} else {
2358	# Is the SSH port free? if not kill the existing process using it after a build timeout period
2359	my $vmssh = pb_check_ps($tmpcmd,"tcp:$nport:10.0.2.15:22");
2360	if ($vmssh) {
2361	my $buildtm = $ENV{'PBVMTMOUT'};
2362	if (defined $vmbuildtm->{$v}) {
2363	$buildtm = $vmbuildtm->{$v};
2364	} elsif (defined $vmbuildtm->{$ENV{'PBPROJ'}}) {
2365	$buildtm = $vmbuildtm->{$ENV{'PBPROJ'}};
2366	}
2367
2368	sleep $buildtm;
2369	pb_log(0,"WARNING: Killing the process ($vmssh) using port $nport (previous failed VM ?)\n");
2370	kill 15,$vmssh;
2371	# Let it time to exit
2372	sleep 5;
2373	}
2374	pb_system("$cmd &","Launching the VM $vmm");
2375	# Using system allows to kill it externaly if needed
2376	pb_system("sleep $ENV{'PBVMTMOUT'}","Waiting $ENV{'PBVMTMOUT'} s for VM $v to come up");
2377	$vmpid = pb_check_ps($tmpcmd,$vmm);
2378	pb_log(0,"VM $vmm launched (pid $vmpid)\n");
2379	}
2380	} else {
2381	pb_log(0,"Found an existing VM $vmm (pid $vmexist)\n");
2382	}
2383	pb_log(2,"DEBUG: pb_launchv returns ($vmexist,$vmpid)\n");
2384	return($vmexist,$vmpid);
2385	} elsif ($vtype eq "ve") {
2386	# Force the creation of the VE and no snapshot usable
2387	pb_ve_launch($v,$create,$usesnap);
2388	} else {
2389	# RM here
2390	# Get distro context
2391	my $pbos = pb_distro_get_context($v);
2392
2393	# Get RM context
2394	my ($ptr,$rmpath) = pb_conf_get("rmtype","rmpath");
2395
2396	# Nothing more to do for RM. No real launch
2397	# For the moment we support the RM is already running
2398	# For ProLiant may be able to power them on if needed later on as an example.
2399	}
2400	}
2401
2402	# Return string for date synchro
2403	sub pb_date2v {
2404
2405	my $vtype = shift;
2406	my $pbos = shift;
2407
2408	my ($ntp) = pb_conf_get_if($vtype."ntp");
2409	my $vntp = $ntp->{$ENV{'PBPROJ'}} if (defined $ntp);
2410	my $ntpline = undef;
2411
2412	if (defined $vntp) {
2413	# ntp command depends on pbos
2414	my $vntpcmd = pb_distro_get_param($pbos,pb_conf_get($vtype."ntpcmd"));
2415	$ntpline = "sudo $vntpcmd $vntp";
2416	}
2417	# Force new date to be in the future compared to the date
2418	# of the host by adding 1 minute
2419	my @date=pb_get_date();
2420	$date[1]++;
2421	my $upddate = strftime("%m%d%H%M%Y", @date);
2422	my $dateline = "sudo /bin/date $upddate";
2423	if (defined $ntpline) {
2424	return($ntpline);
2425	} else {
2426	return($dateline);
2427	}
2428	}
2429
2430	sub pb_build2v {
2431
2432	my $vtype = shift;
2433	my $action = shift \|\| "build";
2434
2435	my ($v,$all) = pb_get2v($vtype);
2436
2437	# Send tar files when we do a global generation
2438	pb_build2ssh() if (($all == 1) && ($action eq "build"));
2439
2440	# Adapt // mode to memory size
2441	$pbparallel = pb_set_parallel($vtype);
2442
2443	my ($vmexist,$vmpid) = (undef,undef);
2444	my $pm;
2445	if (defined $pbparallel) {
2446	$pm = new Parallel::ForkManager($pbparallel);
2447
2448	# Set which port the VM/RM will use to communicate
2449	$pm->run_on_start(\&pb_set_port);
2450	}
2451
2452	my $counter = 0;
2453	foreach my $v (@$v) {
2454	$counter++;
2455	# Modulo 2 * pbparallel (to avoid synchronization problems)
2456	$counter = 1 if ((defined $pbparallel) && ($counter > 2 * $pbparallel));
2457	$pm->start($counter) and next if (defined $pbparallel);
2458	# Prepare the script to be executed on the VM/VE/RM
2459	# in $ENV{'PBDESTDIR'}/pbscript.$$
2460	open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript.$$") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript.$$";
2461	print SCRIPT "#!/bin/bash\n";
2462
2463	# Transmit the verbosity level to the virtual env/mach.
2464	my $verbose = "";
2465	my $i = 0; # minimal debug level
2466	while ($i lt $pbdebug) {
2467	$verbose .= "-v ";
2468	$i++;
2469	}
2470	# Activate script verbosity if at least 2 for pbdebug
2471	print SCRIPT "set -x\n" if ($i gt 1);
2472	# Quiet if asked to be so on the original system
2473	$verbose = "-q" if ($pbdebug eq -1);
2474
2475	print SCRIPT "echo ... Execution needed\n";
2476	print SCRIPT "# This is in directory delivery\n";
2477	print SCRIPT "# Setup the variables required for building\n";
2478	print SCRIPT "export PBPROJ=$ENV{'PBPROJ'}\n";
2479
2480	if ($action eq "build") {
2481	print SCRIPT "# Preparation for pb\n";
2482	print SCRIPT "mv .pbrc \$HOME\n";
2483	print SCRIPT "cd ..\n";
2484	}
2485
2486	# VE needs a good /proc
2487	if ($vtype eq "ve") {
2488	print SCRIPT "sudo /bin/mount -t proc /proc /proc\n";
2489	}
2490
2491	# Get distro context
2492	my $pbos = pb_distro_get_context($v);
2493
2494	my $ntpline = pb_date2v($vtype,$pbos);
2495	print SCRIPT "# Time sync\n";
2496	print SCRIPT "echo 'setting up date with '";
2497	print SCRIPT "echo $ntpline\n";
2498	print SCRIPT "$ntpline\n";
2499	# Use potential local proxy declaration in case we need it to download repo, pkgs, ...
2500	if (defined $ENV{'http_proxy'}) {
2501	print SCRIPT "export http_proxy=\"$ENV{'http_proxy'}\"\n";
2502	}
2503
2504	if (defined $ENV{'ftp_proxy'}) {
2505	print SCRIPT "export ftp_proxy=\"$ENV{'ftp_proxy'}\"\n";
2506	}
2507
2508	# Get list of packages to build/test and get some ENV vars as well
2509	my $ptr = pb_get_pkg();
2510	@pkgs = @$ptr;
2511	my $p = join(' ',@pkgs) if (@pkgs);
2512	print SCRIPT "export PBPROJVER=$ENV{'PBPROJVER'}\n";
2513	print SCRIPT "export PBPROJTAG=$ENV{'PBPROJTAG'}\n";
2514	print SCRIPT "export PBPACKAGER=\"$ENV{'PBPACKAGER'}\"\n";
2515
2516	# We may need to do some other tasks before building. Read a script here to finish setup
2517	if (-x "$ENV{'PBDESTDIR'}/pb$vtype".".pre") {
2518	print SCRIPT "# Special pre-instructions to be launched\n";
2519	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype".".pre");
2520	}
2521
2522	if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."$action.pre") {
2523	print SCRIPT "# Special pre-$action instructions to be launched\n";
2524	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."$action.pre");
2525	}
2526
2527	print SCRIPT "# $action\n";
2528	print SCRIPT "echo $action"."ing packages on $vtype...\n";
2529
2530	if (($action eq "test") && (! -x "$ENV{'PBDESTDIR'}/pbtest")) {
2531	die "No test script ($ENV{'PBDESTDIR'}/pbtest) found when in test mode. Aborting ...";
2532	}
2533	print SCRIPT "pb $verbose -p $ENV{'PBPROJ'} $action"."2pkg $p\n";
2534
2535	if ($vtype eq "ve") {
2536	print SCRIPT "sudo /bin/umount /proc\n";
2537	}
2538
2539	# We may need to do some other tasks after building. Read a script here to exit properly
2540	if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."$action.post") {
2541	print SCRIPT "# Special post-$action instructions to be launched\n";
2542	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."$action.post");
2543	}
2544
2545	if (-x "$ENV{'PBDESTDIR'}/pb$vtype".".post") {
2546	print SCRIPT "# Special post-instructions to be launched\n";
2547	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype".".post");
2548	}
2549
2550	close(SCRIPT);
2551	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript.$$";
2552
2553	# Launch the VM/VE/RM
2554	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
2555
2556
2557	if ($vtype eq "vm") {
2558	# Skip that VM if something went wrong
2559	if (($vmpid == 0) && ($vmexist == 0)) {
2560	$pm->finish if (defined $pbparallel);
2561	next;
2562	}
2563	} else {
2564	# VE/RM
2565	$vmexist = 0;
2566	$vmpid = 0;
2567	}
2568	# Gather all required files to send them to the VM/VE
2569	# and launch the build through pbscript
2570	pb_log(2,"Calling send2target $vtype,$v,$vmexist,$vmpid\n");
2571	pb_send2target(uc($vtype).$action,"$v",$vmexist,$vmpid);
2572	$pm->finish if (defined $pbparallel);
2573	}
2574	$pm->wait_all_children if (defined $pbparallel);
2575	}
2576
2577
2578	sub pb_clean {
2579
2580	my $sleep=10;
2581	die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
2582	die "Unable to get env var PBBUILDDIR" if (not defined $ENV{'PBBUILDDIR'});
2583	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");
2584	sleep $sleep;
2585	pb_rm_rf($ENV{'PBDESTDIR'});
2586	pb_rm_rf($ENV{'PBBUILDDIR'});
2587	}
2588
2589	sub pb_newver {
2590
2591	die "-V Version parameter needed" if ((not defined $newver) \|\| ($newver eq ""));
2592
2593	# Need this call for PBDIR
2594	my ($scheme2,$uri) = pb_cms_init($pbinit);
2595
2596	my ($pbconf,$pburl) = pb_conf_get("pbconfurl","pburl");
2597	$uri = $pbconf->{$ENV{'PBPROJ'}};
2598	my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);
2599
2600	# Checking CMS repositories status
2601	($scheme2, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}});
2602
2603	if ($scheme !~ /^svn/) {
2604	die "Only SVN is supported at the moment";
2605	}
2606
2607	my $res = pb_vcs_isdiff($scheme,$ENV{'PBROOTDIR'});
2608	die "ERROR: No differences accepted in CMS for $ENV{'PBROOTDIR'} before creating a new version" if ($res != 0);
2609
2610	$res = pb_vcs_isdiff($scheme2,$ENV{'PBDIR'});
2611	die "ERROR: No differences accepted in CMS for $ENV{'PBDIR'} before creating a new version" if ($res != 0);
2612
2613	# Tree identical between PBCONFDIR and PBROOTDIR. The delta is what
2614	# we want to get for the root of the new URL
2615
2616	my $oldver = $ENV{'PBROOTDIR'};
2617	$oldver =~ s\|^$ENV{'PBCONFDIR'}\|\|;
2618
2619	pb_log(2, "PBCONFDIR: $ENV{'PBCONFDIR'}\nPBROOTDIR: $ENV{'PBROOTDIR'}\n");
2620
2621	my $newurl = "$uri/$newver";
2622	# Should probably use projver in the old file
2623	my $oldvertxt= basename($oldver);
2624	my $newvertxt = basename($newver);
2625
2626	# Duplicate and extract project-builder part
2627	pb_log(2,"Copying $uri/$oldver to $newurl\n");
2628	pb_vcs_copy($scheme,"$uri/$oldver",$newurl);
2629	pb_log(2,"Checkout $newurl to $ENV{'PBCONFDIR'}/$newver\n");
2630	pb_vcs_up($scheme,"$ENV{'PBCONFDIR'}");
2631
2632	# Duplicate and extract project
2633	my $newurl2 = "$pburl->{$ENV{'PBPROJ'}}/$newver";
2634
2635	pb_log(2,"Copying $pburl->{$ENV{'PBPROJ'}}/$oldver to $newurl2\n");
2636	pb_vcs_copy($scheme2,"$pburl->{$ENV{'PBPROJ'}}/$oldver",$newurl2);
2637
2638	my $tmp = $ENV{'PBDIR'};
2639	$tmp =~ s\|$oldver$\|\|;
2640	pb_log(2,"Checkout $newurl2 to $tmp/$newver\n");
2641	pb_vcs_up($scheme2,"$tmp");
2642
2643	# Update the .pb file
2644	open(FILE,"$ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb") \|\| die "Unable to open $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb";
2645	open(OUT,"> $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb.new") \|\| die "Unable to write to $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb.new";
2646	while(<FILE>) {
2647	if (/^projver\s+$ENV{'PBPROJ'}\s=\s$oldvertxt$/) {
2648	s/^projver\s+$ENV{'PBPROJ'}\s=\s$oldvertxt$/projver $ENV{'PBPROJ'} = $newvertxt/;
2649	pb_log(0,"Changing projver from $oldvertxt to $newvertxt in $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb\n");
2650	}
2651	if (/^testver/) {
2652	s/^testver/#testver/;
2653	pb_log(0,"Commenting testver in $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb\n") if (/^testver/);
2654	}
2655	if (/^delivery/) {
2656	my $txt = $_;
2657	chomp($txt);
2658	pb_log(0,"Please check delivery ($txt) in $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb\n");
2659	}
2660	print OUT $_;
2661	}
2662	close(FILE);
2663	close(OUT);
2664	rename("$ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb.new","$ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb");
2665
2666	# Checking pbcl files
2667	foreach my $f (<$ENV{'PBROOTDIR'}/*/pbcl>) {
2668	# Compute new pbcl file
2669	my $f2 = $f;
2670	$f2 =~ s\|$ENV{'PBROOTDIR'}\|$ENV{'PBCONFDIR'}/$newver/\|;
2671	open(PBCL,$f) \|\| die "Unable to open $f";
2672	my $foundnew = 0;
2673	while (<PBCL>) {
2674	$foundnew = 1 if (/^$newvertxt \(/);
2675	}
2676	close(PBCL);
2677	open(OUT,"> $f2") \|\| die "Unable to write to $f2: $!";
2678	open(PBCL,$f) \|\| die "Unable to open $f";
2679	while (<PBCL>) {
2680	print OUT "$_" if (not /^$oldvertxt \(/);
2681	if ((/^$oldvertxt \(/) && ($foundnew == 0)) {
2682	print OUT "$newvertxt ($pbdate)\n";
2683	print OUT "- TBD\n";
2684	print OUT "\n";
2685	pb_log(0,"WARNING: version $newvertxt not found in $f so added to $f2...\n") if ($foundnew == 0);
2686	}
2687	}
2688	close(OUT);
2689	close(PBCL);
2690	}
2691
2692	pb_log(2,"Checkin $ENV{'PBCONFDIR'}/$newver\n");
2693	pb_cms_checkin($scheme,"$ENV{'PBCONFDIR'}/$newver",undef);
2694	}
2695
2696	#
2697	# Return the list of VMs/VEs/RMs we are working on
2698	# $all is a flag to know if we return all of them
2699	# or only some (if all we publish also tar files in addition to pkgs
2700	#
2701	sub pb_get2v {
2702
2703	my $vtype = shift;
2704	my @v;
2705	my $all = 0;
2706	my $pbv = 'PBV';
2707	my $vlist = $vtype."list";
2708
2709	# Get VM/VE list
2710	if ((not defined $ENV{$pbv}) \|\| ($ENV{$pbv} =~ /^all$/)) {
2711	my ($ptr) = pb_conf_get($vlist);
2712	$ENV{$pbv} = $ptr->{$ENV{'PBPROJ'}};
2713	$all = 1;
2714	}
2715	pb_log(2,"$vtype: $ENV{$pbv}\n");
2716	@v = split(/,/,$ENV{$pbv});
2717	return(\@v,$all);
2718	}
2719
2720	# Function to create a potentialy missing pb account on the VM/VE/RM, and adds it to sudo
2721	# Needs to use root account to connect to the VM/VE/RM
2722	# pb will take your local public SSH key to access
2723	# the pb account in the VM/VE/RM later on if needed
2724	sub pb_setup2v {
2725
2726	my $vtype = shift;
2727	my $sbx = shift \|\| undef;
2728
2729	my ($vm,$all) = pb_get2v($vtype);
2730
2731	# Script generated
2732	my $pbscript = "$ENV{'PBDESTDIR'}/setupv";
2733
2734	# Adapt // mode to memory size
2735	$pbparallel = pb_set_parallel($vtype);
2736
2737	my $pm;
2738	if (defined $pbparallel) {
2739	$pm = new Parallel::ForkManager($pbparallel);
2740
2741	# Set which port the VM/RM will use to communicate
2742	$pm->run_on_start(\&pb_set_port);
2743	}
2744
2745	my $counter = 0;
2746	foreach my $v (@$vm) {
2747	$counter++;
2748	# Modulo pbparallel
2749	$counter = 1 if ((defined $pbparallel) && ($counter > $pbparallel));
2750	$pm->start($counter) and next if (defined $pbparallel);
2751
2752	# Get distro context
2753	my $pbos = pb_distro_get_context($v);
2754
2755	# Deal with date sync.
2756	my $ntpline = pb_date2v($vtype,$pbos);
2757
2758	# Name of the account to deal with for VM/VE/RM
2759	# Do not use the one passed potentially with -a
2760	my ($pbac) = pb_conf_get($vtype."login");
2761	my ($key,$zero0,$zero1,$zero2);
2762	my ($vmexist,$vmpid);
2763
2764	# Prepare the script to be executed on the VM/VE/RM
2765	# in $ENV{'PBDESTDIR'}/setupv
2766	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
2767
2768	print SCRIPT << 'EOF';
2769	#!/usr/bin/perl -w
2770
2771	use strict;
2772	use File::Copy;
2773
2774	# We should not need in this script more functions than what is provided
2775	# by Base, Conf and Distribution to avoid problems at exec time.
2776	# They are appended at the end.
2777
2778	# Define mandatory global vars
2779	our $pbdebug;
2780	our $pbLOG;
2781	our $pbsynmsg = "pbscript";
2782	our $pbdisplaytype = "text";
2783	our $pblocale = "";
2784	pb_log_init($pbdebug, $pbLOG);
2785	EOF
2786	print SCRIPT << "EOF";
2787	pb_temp_init($pbkeep);
2788
2789	EOF
2790
2791	# Launch the VM/VE/RM - Usage of snapshot disabled
2792	($vmexist,$vmpid) = pb_launchv($vtype,$v,0,0,0);
2793
2794	my $keyfile;
2795	my $nport;
2796	my $vmhost;
2797
2798	# Prepare the key to be used and transfered remotely
2799	$keyfile = pb_ssh_get(1);
2800
2801	if ($vtype =~ /(v\|r)m/) {
2802	my ($vmport);
2803	($vmhost,$vmport) = pb_conf_get($vtype."host",$vtype."port");
2804	$nport = pb_get_port($vmport,$pbos,$vtype);
2805
2806	# Skip that VM/RM if something went wrong
2807	next if (($vmpid == 0) && ($vmexist == 0));
2808
2809	# Store the pub key part in a variable
2810	open(FILE,"$keyfile.pub") \|\| die "Unable to open $keyfile.pub";
2811	($zero0,$zero1,$zero2) = split(/ /,<FILE>);
2812	close(FILE);
2813
2814	$key = "\Q$zero1";
2815
2816	# We call true to avoid problems if SELinux is not activated, but chcon is present and returns in that case 1
2817	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");
2818	# once this is done, we can do what we need on the VM/RM remotely
2819	} elsif ($vtype eq "ve") {
2820	print SCRIPT << "EOF";
2821	# For VE we need a good null dev
2822	pb_system("rm -f /dev/null; mknod /dev/null c 1 3; chmod 777 /dev/null");
2823	EOF
2824	print SCRIPT << "EOF";
2825	# For VE we first need to mount some FS
2826	pb_system("mount -t proc /proc /proc");
2827
2828	EOF
2829	}
2830
2831	if ($vtype =~ /(v\|r)m/) {
2832	print SCRIPT << 'EOF';
2833	# Removes duplicate in .ssh/authorized_keys of our key if needed
2834	#
2835	my $file1="$ENV{'HOME'}/.ssh/authorized_keys";
2836	open(PBFILE,$file1) \|\| die "Unable to open $file1";
2837	open(PBOUT,"> $file1.new") \|\| die "Unable to open $file1.new";
2838	my $count = 0;
2839	while (<PBFILE>) {
2840
2841	EOF
2842	print SCRIPT << "EOF";
2843	if (/ $key /) {
2844	\$count++;
2845	}
2846	print PBOUT \$_ if ((\$count <= 1) \|\| (\$_ !~ / $key /));
2847	}
2848	close(PBFILE);
2849	close(PBOUT);
2850	rename("\$file1.new",\$file1);
2851	chmod 0600,\$file1;
2852
2853	EOF
2854	}
2855	print SCRIPT << 'EOF';
2856
2857	# Adds $pbac->{$ENV{'PBPROJ'}} as an account if needed
2858	#
2859	my $file="/etc/passwd";
2860	open(PBFILE,$file) \|\| die "Unable to open $file";
2861	my $found = 0;
2862	while (<PBFILE>) {
2863	EOF
2864	print SCRIPT << "EOF";
2865	\$found = 1 if (/^$pbac->{$ENV{'PBPROJ'}}:/);
2866	EOF
2867
2868	# TODO: use an external parameter
2869	my $home = "/home";
2870	# Solaris doesn't like that we use /home
2871	$home = "/export/home" if ($pbos->{'type'} eq "pkg");
2872
2873	print SCRIPT << "EOF";
2874	}
2875	close(PBFILE);
2876
2877	if ( \$found == 0 ) {
2878	if ( ! -d "$home" ) {
2879	pb_mkdir_p("$home");
2880	}
2881	EOF
2882	# TODO: Level of portability of these cmds ? Critical now for RM
2883	# TODO: Check existence before adding to avoid errors
2884	print SCRIPT << "EOF";
2885	pb_system("/usr/sbin/groupadd $pbac->{$ENV{'PBPROJ'}}","Adding group $pbac->{$ENV{'PBPROJ'}}");
2886	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'}})");
2887	}
2888	EOF
2889
2890	# Copy the content of our local conf file to the VM/VE/RM
2891	my $content = pb_get_content(pb_distro_conffile());
2892	print SCRIPT << "EOF";
2893	#
2894	# Create a temporary local conf file for distribution support
2895	# This is created here before its use later. Its place is hardcoded, so no choice for the path
2896	#
2897	my \$tempconf = pb_distro_conffile();
2898	pb_mkdir_p(dirname(\$tempconf));
2899	open(CONF,"> \$tempconf") \|\| die "Unable to create \$tempconf";
2900	print CONF q{$content};
2901	close(CONF);
2902	EOF
2903
2904	if ($vtype =~ /(v\|r)m/) {
2905	print SCRIPT << "EOF";
2906	# allow ssh entry to build
2907	#
2908	mkdir "$home/$pbac->{$ENV{'PBPROJ'}}/.ssh",0700;
2909	# Allow those accessing root to access the build account
2910	copy("\$ENV{'HOME'}/.ssh/authorized_keys","$home/$pbac->{$ENV{'PBPROJ'}}/.ssh/authorized_keys");
2911	chmod 0600,".ssh/authorized_keys";
2912	pb_system("chown -R $pbac->{$ENV{'PBPROJ'}}:$pbac->{$ENV{'PBPROJ'}} $home/$pbac->{$ENV{'PBPROJ'}}","Finish setting up the account env for $pbac->{$ENV{'PBPROJ'}}");
2913
2914	EOF
2915	}
2916	print SCRIPT << 'EOF';
2917	# No passwd for build account only keys
2918	$file="/etc/shadow";
2919	if (-f $file) {
2920	open(PBFILE,$file) \|\| die "Unable to open $file";
2921	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
2922	while (<PBFILE>) {
2923	EOF
2924	print SCRIPT << "EOF";
2925	s/^$pbac->{$ENV{'PBPROJ'}}:\!\!:/$pbac->{$ENV{'PBPROJ'}}:*:/;
2926	s/^$pbac->{$ENV{'PBPROJ'}}:\!:/$pbac->{$ENV{'PBPROJ'}}:*:/; #SLES 9 e.g.
2927	s/^$pbac->{$ENV{'PBPROJ'}}:\\LK\\:/$pbac->{$ENV{'PBPROJ'}}:NP:/; #Solaris e.g.
2928	EOF
2929	print SCRIPT << 'EOF';
2930	print PBOUT $_;
2931	}
2932	close(PBFILE);
2933	close(PBOUT);
2934	rename("$file.new",$file);
2935	chmod 0640,$file;
2936	}
2937
2938	# Keep the VM in text mode
2939	$file="/etc/inittab";
2940	if (-f $file) {
2941	open(PBFILE,$file) \|\| die "Unable to open $file";
2942	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
2943	while (<PBFILE>) {
2944	s/^(..):5:initdefault:$/$1:3:initdefault:/;
2945	print PBOUT $_;
2946	}
2947	close(PBFILE);
2948	close(PBOUT);
2949	rename("$file.new",$file);
2950	chmod 0640,$file;
2951	}
2952
2953	# pb has to be added to portage group on gentoo
2954
2955	# We need to have that pb_distro_get_context function
2956	# Get it from Project-Builder::Distribution
2957	# And we now need the conf file required for this to work created above
2958
2959	my $pbos = pb_distro_get_context();
2960	print "distro tuple: ".Dumper($pbos)."\n";
2961
2962	# Adapt sudoers
2963	# sudo is not default on Solaris and needs to be installed first
2964	# from http://www.sunfreeware.com/programlistsparc10.html#sudo
2965	if ($pbos->{'type'} eq "pkg") {
2966	$file="/usr/local/etc/sudoers";
2967	} else {
2968	$file="/etc/sudoers";
2969	}
2970	open(PBFILE,$file) \|\| die "Unable to open $file";
2971	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
2972	while (<PBFILE>) {
2973	EOF
2974	# Skip what will be generated
2975	print SCRIPT << "EOF";
2976	next if (/^$pbac->{$ENV{'PBPROJ'}}\\s+/);
2977	next if (/^Defaults:$pbac->{$ENV{'PBPROJ'}}\\s+/);
2978	next if (/^Defaults:root \!requiretty/);
2979	EOF
2980	print SCRIPT << 'EOF';
2981	s/Defaults[ \t]+requiretty//;
2982	print PBOUT $_;
2983	}
2984	close(PBFILE);
2985	EOF
2986	print SCRIPT << "EOF";
2987	# Some distro force requiretty at compile time, so disable here
2988	print PBOUT "Defaults:$pbac->{$ENV{'PBPROJ'}} !requiretty\n";
2989	print PBOUT "Defaults:root !requiretty\n";
2990	# Keep proxy configuration while using sudo
2991	print PBOUT "Defaults:$pbac->{$ENV{'PBPROJ'}} env_keep += \\\"http_proxy ftp_proxy\\\"\n";
2992	EOF
2993	# Try to restrict security to what is really needed
2994	if ($vtype =~ /^vm/) {
2995	my $hpath = pb_distro_get_param($pbos,pb_conf_get("ospathcmd-halt"));
2996	my @sudocmds = pb_get_sudocmds($pbos,$ntpline,"sudo $hpath");
2997	print SCRIPT << "EOF";
2998	# This is needed in order to be able on VM to halt the machine from the $pbac->{$ENV{'PBPROJ'}} account at least
2999	# Build account $pbac->{$ENV{'PBPROJ'}} in VM also needs to setup date and install deps.
3000	# Nothing else should be needed
3001	EOF
3002	foreach my $c (@sudocmds) {
3003	print SCRIPT "print PBOUT \"$pbac->{$ENV{'PBPROJ'}} ALL = NOPASSWD: $c\\n\";\n";
3004	}
3005	} elsif ($vtype =~ /^rm/) {
3006	my @sudocmds = pb_get_sudocmds($pbos,$ntpline);
3007	print SCRIPT << "EOF";
3008	# Build account $pbac->{$ENV{'PBPROJ'}} in RM only needs to setup date and install deps if needed each time
3009	EOF
3010	foreach my $c (@sudocmds) {
3011	print SCRIPT "print PBOUT \"$pbac->{$ENV{'PBPROJ'}} ALL = NOPASSWD: $c\\n\";\n";
3012	}
3013	} else {
3014	print SCRIPT << "EOF";
3015	# Build account $pbac->{$ENV{'PBPROJ'}} for VE needs to do a lot in the host (and chroot), so allow without restriction for now
3016	print PBOUT "$pbac->{$ENV{'PBPROJ'}} ALL=(ALL) NOPASSWD:ALL\n";
3017	EOF
3018	}
3019	print SCRIPT << 'EOF';
3020	close(PBOUT);
3021	rename("$file.new",$file);
3022	chmod 0440,$file;
3023
3024	EOF
3025
3026	if ($vtype =~ /(v\|r)m/) {
3027	# Sync date
3028	# do it after sudoers is setup
3029	print SCRIPT "pb_system(\"$ntpline\");\n";
3030	}
3031	# We may need a proxy configuration. Get it from the local env
3032
3033	if (defined $ENV{'http_proxy'}) {
3034	print SCRIPT "\$ENV\{'http_proxy'\}=\"$ENV{'http_proxy'}\";\n";
3035	}
3036
3037	if (defined $ENV{'ftp_proxy'}) {
3038	print SCRIPT "\$ENV\{'ftp_proxy'\}=\"$ENV{'ftp_proxy'}\";\n";
3039	}
3040
3041	print SCRIPT << 'EOF';
3042
3043	# Suse wants sudoers as 640
3044	if ((($pbos->{'name'} eq "sles") && (($pbos->{'version'} =~ /10/) \|\| ($pbos->{'version'} =~ /9/))) \|\| (($pbos->{'name'} eq "opensuse") && ($pbos->{'version'} =~ /10.[012]/))) {
3045	chmod 0640,$file;
3046	}
3047
3048	# First install all required packages
3049	pb_system("yum clean all","Cleaning yum env") if (($pbos->{'name'} eq "fedora") \|\| ($pbos->{'name'} eq "asianux") \|\| ($pbos->{'name'} eq "rhel"));
3050	my ($ospkgdep) = pb_conf_get_if("ospkgdep");
3051
3052	my $pkgdep = pb_distro_get_param($pbos,$ospkgdep);
3053	pb_distro_installdeps(undef,$pbos,pb_distro_only_deps_needed($pbos,join(' ',split(/,/,$pkgdep))));
3054
3055	EOF
3056	my $itype = pb_distro_get_param($pbos,pb_conf_get("pbinstalltype"));
3057	# Install from sandbox mean a file base install
3058	$itype = "file" if (defined $sbx);
3059	if ($itype =~ /^file/) {
3060	my $cmdget;
3061	if (defined $sbx) {
3062	# Install from sandbox mean using the result of the just passed sbx2build command
3063	# Get content saved in cms2build
3064	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
3065	my $pbextdir = pb_get_extdir();
3066	die "Unable to get package list" if (not defined $pkg);
3067
3068	# We consider 2 specific packages
3069	my $vertag1 = $pkg->{"ProjectBuilder"};
3070	my $vertag2 = $pkg->{"project-builder"};
3071	# get the version of the current package - maybe different
3072	pb_log(2,"Vertag1: $vertag1\n");
3073	pb_log(2,"Vertag2: $vertag2\n");
3074	my ($pbver1,$tmp1) = split(/-/,$vertag1);
3075	my ($pbver2,$tmp2) = split(/-/,$vertag2);
3076	# Copy inside the VE
3077	if ($vtype eq "ve") {
3078	my ($vepath) = pb_conf_get("vepath");
3079	copy("$ENV{'PBDESTDIR'}/ProjectBuilder-$pbver1$pbextdir.tar.gz","$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/tmp");
3080	copy("$ENV{'PBDESTDIR'}/project-builder-$pbver2$pbextdir.tar.gz","$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/tmp");
3081	} else {
3082	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.");
3083	}
3084	$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";
3085	} else {
3086	$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";
3087	}
3088	print SCRIPT << 'EOF';
3089	# Then install manually the missing perl modules
3090	my ($osperldep,$osperlver) = pb_conf_get_if("osperldep","osperlver");
3091
3092	my $perldep = pb_distro_get_param($pbos,$osperldep);
3093	foreach my $m (split(/,/,$perldep)) {
3094	# Skip empty deps
3095	next if ($m =~ /^\s*$/);
3096	my $dir = $m;
3097	$dir =~ s/-.*//;
3098	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}");
3099	}
3100	EOF
3101	print SCRIPT << 'EOF';
3102	pb_system("rm -rf ProjectBuilder-* ; rm -rf project-builder-* ; rm -rf `perl -V:installvendorlib \| awk -F\"'\" '{print \$2}'`/ProjectBuilder ;
3103	EOF
3104	print SCRIPT " $cmdget ; ";
3105	print SCRIPT << 'EOF'
3106	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");
3107	EOF
3108	} elsif ($itype =~ /^pkg/) {
3109	# pkg based install. We need to point to the project-builder.org repository
3110	print SCRIPT << 'EOF';
3111	my $pkgforpb = pb_distro_get_param($pbos,pb_conf_get_if("ospkg"));
3112	pb_distro_setuposrepo($pbos);
3113	pb_distro_installdeps(undef,$pbos,pb_distro_only_deps_needed($pbos,join(' ',split(/,/,$pkgforpb))));
3114	EOF
3115	} else {
3116	# Unknown install type
3117	die("Unknown install type $itype->{$ENV{'PBPROJ'}} for param pbinstalltype");
3118	}
3119	print SCRIPT << 'EOF';
3120	pb_system("pb 2>&1 \| head -5",undef,"verbose");
3121	pb_system("pbdistrocheck",undef,"verbose");
3122	EOF
3123	if ($vtype eq "ve") {
3124	print SCRIPT << 'EOF';
3125	# For VE we need to umount some FS at the end
3126
3127	pb_system("umount /proc");
3128
3129	# Create a basic network file if not already there
3130
3131	my $nf="/etc/sysconfig/network";
3132	if ((! -f $nf) && ($pbos->{'type'} eq "rpm")) {
3133	open(NF,"> $nf") \|\| die "Unable to create $nf";
3134	print NF "NETWORKING=yes\n";
3135	print NF "HOSTNAME=localhost\n";
3136	close(NF);
3137	}
3138	chmod 0755,$nf;
3139	EOF
3140	}
3141
3142	# Adds pb_distro_get_context and all functions needed from ProjectBuilder::Distribution, Conf and Base
3143	foreach my $d (@INC) {
3144	my @f = ("$d/ProjectBuilder/Base.pm","$d/ProjectBuilder/Distribution.pm","$d/ProjectBuilder/Conf.pm");
3145	foreach my $f (@f) {
3146	if (-f "$f") {
3147	open(PBD,"$f") \|\| die "Unable to open $f";
3148	while (<PBD>) {
3149	next if (/^package/);
3150	next if (/^use Exporter/);
3151	next if (/^use ProjectBuilder::/);
3152	next if (/^our /);
3153	print SCRIPT $_;
3154	}
3155	close(PBD);
3156	}
3157	}
3158	}
3159	# Use a fake pb_version_init version here
3160	print SCRIPT << "EOF";
3161	sub pb_version_init {
3162
3163	return("$projectbuilderver","$projectbuilderrev");
3164	}
3165	1;
3166	EOF
3167	close(SCRIPT);
3168	chmod 0755,"$pbscript";
3169
3170	# That build script needs to be run as root and force stop of VM at end
3171	$pbaccount = "root";
3172
3173	# Force shutdown of VM except if it was already launched
3174	my $pbforce = 0;
3175	if ((! $vmexist) && ($vtype eq "vm")) {
3176	$pbforce = 1;
3177	}
3178
3179	pb_script2v($pbscript,$vtype,$pbforce,$v);
3180	$pm->finish if (defined $pbparallel);
3181	}
3182	$pm->wait_all_children if (defined $pbparallel);
3183	return;
3184	}
3185
3186	# Function to create a snapshot named 'pb' for VMs and a compressed tar for VEs
3187	sub pb_snap2v {
3188
3189	my $vtype = shift;
3190
3191	my ($vm,$all) = pb_get2v($vtype);
3192
3193	# Script generated
3194	my $pbscript = "$ENV{'PBDESTDIR'}/snapv";
3195
3196	my ($pbac) = pb_conf_get($vtype."login");
3197
3198	foreach my $v (@$vm) {
3199	if ($vtype eq "ve") {
3200	# Get distro context
3201	my $pbos = pb_distro_get_context($v);
3202	my ($vepath) = pb_conf_get("vepath");
3203
3204	# Test if an existing snapshot exists and remove it if there is a VE
3205	if ((-f "$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}.tar.gz") &&
3206	(! -d "$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}")) {
3207	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");
3208	}
3209	}
3210
3211	# Prepare the script to be executed on the VM/VE
3212	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
3213	print SCRIPT << 'EOF';
3214	#!/bin/bash
3215	sleep 2
3216	EOF
3217	close(SCRIPT);
3218	chmod 0755,"$pbscript";
3219
3220	# Force shutdown of VM/VE
3221	# Force snapshot of VM/VE
3222	pb_script2v($pbscript,$vtype,1,$v,1);
3223	}
3224	return;
3225	}
3226
3227	# Function to update VMs/VEs/RMs with the latest distribution content
3228	sub pb_update2v {
3229
3230	my $vtype = shift;
3231
3232	my ($vm,$all) = pb_get2v($vtype);
3233
3234	# Script generated
3235	my $pbscript = "$ENV{'PBDESTDIR'}/updatev";
3236
3237	my ($pbac) = pb_conf_get($vtype."login");
3238
3239	foreach my $v (@$vm) {
3240	# Get distro context
3241	my $pbos = pb_distro_get_context($v);
3242
3243	# Prepare the script to be executed on the VM/VE/RM
3244	# in $ENV{'PBDESTDIR'}/updatev
3245	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
3246
3247	print SCRIPT << 'EOF';
3248	#!/bin/bash
3249	sleep 2
3250	EOF
3251	# VE needs a good /proc
3252	if ($vtype eq "ve") {
3253	print SCRIPT "sudo /bin/mount -t proc /proc /proc\n";
3254	}
3255	print SCRIPT "$pbos->{'update'}\n";
3256	if ($vtype eq "ve") {
3257	print SCRIPT "sudo /bin/umount /proc\n";
3258	}
3259	close(SCRIPT);
3260	chmod 0755,"$pbscript";
3261
3262	# Force shutdown of VM except
3263	pb_script2v($pbscript,$vtype,1,$v);
3264	}
3265	return;
3266	}
3267
3268	sub pb_announce {
3269
3270	my $antype = shift;
3271
3272	# Get all required parameters
3273	my ($pbpackager,$pbrepo,$pbml,$pbsmtp) = pb_conf_get("pbpackager","pbrepo","pbml","pbsmtp");
3274	my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
3275	if (((not defined $testver) \|\| (not defined $testver->{$ENV{'PBPROJ'}}) \|\| ($testver->{$ENV{'PBPROJ'}} !~ /true/i)) && ($antype eq "Clean")) {
3276	# We just clean for test versions
3277	pb_log(0,"Unable to clean SSH repository for non testver version\n");
3278	return;
3279	}
3280	my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
3281	my @pkgs = @$pkg;
3282	my %pkgs;
3283	my $first = 0;
3284
3285	# Get all distros concerned
3286	my $pbos = pb_distro_get_context();
3287	my $distrolist = pb_get_distros($pbos,undef);
3288	my %dl;
3289	my %theorlist;
3290	my %archlist;
3291	foreach my $d (split(/,/,$distrolist)) {
3292	my ($d1,$d2,$d3) = split(/-/,$d);
3293	$dl{$d1}++;
3294	}
3295
3296	# Command to find packages on repo
3297	my $findstr = "find ".join(" ",keys %dl)." ";
3298	my $srcstr = "";
3299	# Generated announce files
3300	my @files;
3301
3302	foreach my $pbpkg (@pkgs) {
3303	if ($first != 0) {
3304	$findstr .= "-o ";
3305	}
3306	$first++;
3307	if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
3308	$pbver = $pkgv->{$pbpkg};
3309	} else {
3310	$pbver = $ENV{'PBPROJVER'};
3311	}
3312	if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
3313	$pbtag = $pkgt->{$pbpkg};
3314	} else {
3315	$pbtag = $ENV{'PBPROJTAG'};
3316	}
3317
3318	# TODO: use virtual/real names here now
3319	my $pbrealpkg = $pbpkg;
3320	my $pbrealpkgrpm = pb_cms_get_real_pkg($pbpkg,"rpm");
3321	my $pbrealpkgdeb = pb_cms_get_real_pkg($pbpkg,"deb");
3322	if ($antype eq "Clean") {
3323	# We only clean test versions anyway
3324	$pbtag = "0";
3325	my $nver = $pbver;
3326	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]";
3327	$pbver .= $ntag;
3328	$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\' ";
3329	$srcstr .= "src/$pbrealpkg-$pbver.tar.gz src/$pbrealpkg-$pbver.pbconf.tar.gz ";
3330	} else {
3331	my @date=pb_get_date();
3332	# the matching is only done on packages made the same day for test version. Hopefully this is enough
3333	my $nver = $pbver;
3334	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i) && ($antype eq "Check")) {
3335	$pbtag = "0";
3336	my $ntag .= strftime("%Y%m%d*", @date);
3337	$nver = $pbver."_p$ntag";
3338	$pbver .= $ntag;
3339	}
3340	$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\' ";
3341	}
3342
3343	if ($antype eq "Announce") {
3344	my $chglog;
3345
3346	pb_cms_init($pbinit);
3347	# Get project info on log file and generate tmp files used later on
3348	$chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
3349	$chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
3350	$chglog = undef if (! -f $chglog);
3351
3352	open(OUT,"> $ENV{'PBTMP'}/$pbpkg.ann") \|\| die "Unable to create $ENV{'PBTMP'}/$pbpkg.ann: $!";
3353	my $pb;
3354	$pb->{'realpkg'} = $pbrealpkg;
3355	$pb->{'ver'} = $pbver;
3356	$pb->{'tag'} = $pbtag;
3357	$pb->{'date'} = $pbdate;
3358	$pb->{'extdir'} = pb_get_extdir();
3359	$pb->{'chglog'} = $chglog;
3360	$pb->{'packager'} = $pbpackager;
3361	$pb->{'proj'} = $ENV{'PBPROJ'};
3362	$pb->{'repo'} = $pbrepo;
3363	$pb->{'pbos'}->{'type'} = "announce";
3364	$pb->{'pbos'}->{'suffix'} = "none";
3365	pb_changelog($pb,\*OUT,"yes");
3366	close(OUT);
3367	push(@files,"$ENV{'PBTMP'}/$pbpkg.ann");
3368	} elsif ($antype eq "Check") {
3369	# For the check we also build the theoritical complete list we should get
3370	foreach my $d (split(/,/,$distrolist)) {
3371	$pbos = pb_distro_get_context($d);
3372	if ($pbos->{'type'} eq "rpm") {
3373	$theorlist{"$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/$pbrealpkgrpm-$pbver-$pbtag$pbos->{'suffix'}"} = 0;
3374	} elsif ($pbos->{'type'} eq "deb") {
3375	$theorlist{"$pbos->{'name'}/$pbos->{'version'}/$pbrealpkgdeb"."_$pbver-$pbtag"} = 0;
3376	# TODO are we always using the last arch ?
3377	$archlist{"$pbos->{'name'}/$pbos->{'version'}/$pbrealpkgdeb"."_$pbver-$pbtag"} = "$pbos->{'arch'}";
3378	} elsif ($pbos->{'type'} eq "ebuild") {
3379	my $prefix = "-r";
3380	$prefix = "_p" if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i));
3381	$theorlist{"$pbos->{'name'}/$pbos->{'version'}/$pbrealpkg-$pbver$prefix$pbtag.ebuild"} = 0;
3382	$archlist{"$pbos->{'name'}/$pbos->{'version'}/$pbrealpkg-$pbver$prefix$pbtag.ebuild"} = "$pbos->{'arch'}";
3383	} elsif ($pbos->{'type'} eq "pkg") {
3384	$theorlist{"$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/$pbrealpkg-$pbver-$pbtag.pkg"} = 0;
3385	} else {
3386	pb_log(1,"No theoritical list possible for type $pbos->{'type'}\n");
3387	}
3388	}
3389	}
3390	pb_log(2,"theorlist : ".Dumper(%theorlist)."\n");
3391	}
3392	if ($antype eq "Announce") {
3393	$findstr .= " \| grep -Ev \'src.rpm\'";
3394	} elsif ($antype eq "Clean") {
3395	$findstr .= " \| xargs rm -f -v $srcstr ";
3396	}
3397
3398	# Prepare the command to run and execute it
3399	open(PBS,"> $ENV{'PBTMP'}/pbscript") \|\| die "Unable to create $ENV{'PBTMP'}/pbscript";
3400	print PBS "#!/bin/bash\n";
3401	print PBS "set -x\n" if ($pbdebug gt 1);
3402	print PBS "$findstr \| sort 2> /dev/null\n";
3403	close(PBS);
3404	chmod 0755,"$ENV{'PBTMP'}/pbscript";
3405	pb_send2target("Announce");
3406
3407	my $sl = "Project $ENV{'PBPROJ'} version $ENV{'PBPROJVER'} is now available";
3408	if ($antype eq "Announce") {
3409	# Get subject line
3410	pb_log(0,"Please enter the title of your announce\n");
3411	pb_log(0,"(By default: $sl)\n");
3412	my $sl2 = <STDIN>;
3413	$sl = $sl2 if ($sl2 !~ /^$/);
3414
3415	# Prepare a template of announce
3416	open(ANN,"> $ENV{'PBTMP'}/announce.html") \|\| die "Unable to create $ENV{'PBTMP'}/announce.html: $!";
3417	print ANN << "EOF";
3418	$sl</p>
3419
3420	<p>The project team is happy to announce the availability of a newest version of $ENV{'PBPROJ'} $ENV{'PBPROJVER'}. Enjoy it as usual!</p>
3421	<p>
3422	Now available at <a href="$pbrepo->{$ENV{'PBPROJ'}}">$pbrepo->{$ENV{'PBPROJ'}}</a>
3423	</p>
3424	<p>
3425	EOF
3426	}
3427
3428	open(LOG,"$ENV{'PBTMP'}/system.$$.log") \|\| die "Unable to read $ENV{'PBTMP'}/system.$$.log: $!";
3429	if ($antype eq "Announce") {
3430	my $col = 2;
3431	my $i = 1;
3432	print ANN << 'EOF';
3433	<TABLE WIDTH="100%" CELLPADDING="0" CELLSPACING="0" BORDER="0">
3434	<TR>
3435	EOF
3436	while (<LOG>) {
3437	print ANN "<TD><A HREF=\"$pbrepo->{$ENV{'PBPROJ'}}/$_\">$_</A></TD>";
3438	$i++;
3439	if ($i > $col) {
3440	print ANN "</TR>\n<TR>";
3441	$i = 1;
3442	}
3443	}
3444	} elsif ($antype eq "Clean") {
3445	while (<LOG>) {
3446	# skip errors
3447	next if ($_ !~ /^removed /);
3448	pb_log(0,"$_");
3449	}
3450	} else {
3451	# In Check mode we need to compare the 2 lists (real and theoritical)
3452	while (<LOG>) {
3453	# Get package name and remove what is in extra for the theoritical list (arch at the end)
3454	chomp();
3455	# skip find errors
3456	next if (/^find:/);
3457	my $p = $_;
3458	$p =~ s/\.(i[3456]86\|x86_64\|noarch\|src)\.rpm$//;
3459	$p =~ s/_(i[3456]86\|amd64\|all).deb$//;
3460	$p =~ s/(-0\.[0-9]{8})[0-9]{6}/$1*/ if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i));
3461	$p =~ s/(-r\|_p[0-9]+)\.ebuild/$1*/ if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i));
3462	$theorlist{$p} = -2 if (not defined $theorlist{$p});
3463	$theorlist{$p} = $theorlist{$p} + 1;
3464	}
3465	pb_log(2,"theorlist : ".Dumper(%theorlist)."\n");
3466	}
3467	close(LOG);
3468
3469	# Nothing more for the cleanssh case
3470	return if ($antype eq "Clean");
3471
3472	if ($antype eq "Check") {
3473	my ($chkex) = pb_conf_get_if("checkexclude");
3474	my $vmbuildlist = "";
3475	my $vebuildlist = "";
3476	my $rmbuildlist = "";
3477	my @pt = pb_conf_get_if("vmlist","velist","rmlist");
3478	foreach my $t (sort keys %theorlist) {
3479	if (defined $theorlist{$t} and $theorlist{$t} >= 1) {
3480	pb_log(1,"Packages found for $t\n");
3481	} elsif (defined $theorlist{$t} and $theorlist{$t} < 0) {
3482	pb_log(0,"Extra Package found for $t\n");
3483	} else {
3484	pb_log(2,"Analyzing $t\n");
3485	my ($os,$ver,$arch,$package) = split(/\//,$t);
3486	# Some distro have no arch subdir
3487	if (not defined $package) {
3488	$package = $arch;
3489	# TODO: If both arch have failed, we just make the last one
3490	$arch = $archlist{$t};
3491	}
3492	my $pbos = pb_distro_get_context("$os-$ver-$arch");
3493	my $pkgn = $package;
3494	if ($pbos->{'type'} ne "deb") {
3495	# package name is more easily found from the end for non deb
3496	# as '-' is the separator, but it can also be used in names
3497	$pkgn = reverse($package);
3498	# search the second '-' and isolate the now last part which is the full name
3499	$pkgn =~ s/([^-]+)-([^-]+)-([\S])+$/$3/;
3500	} else {
3501	$pkgn =~ s/([^_]+)_([\S])+$/$2/;
3502	}
3503	my $found = 0;
3504	# Handle the exclusion of OSes
3505	my $excl = "";
3506	$excl .= $chkex->{$pkgn} if (defined $chkex->{$pkgn});
3507	$excl .= $chkex->{"all"} if (defined $chkex->{"all"});
3508	foreach my $ex (split(/,/,$excl)) {
3509	$found = 1 if ("$os-$ver-$arch" =~ /^$ex/);
3510	}
3511	# Skip as excluded
3512	next if ($found == 1);
3513	pb_log(0,"Package NOT found for $t\n");
3514	# Avoid duplicates in list
3515	next if ($vmbuildlist =~ /$os-$ver-$arch/);
3516	next if ($vebuildlist =~ /$os-$ver-$arch/);
3517	next if ($rmbuildlist =~ /$os-$ver-$arch/);
3518	# check with which method we need to build
3519	if ((defined $pt[0]->{$ENV{'PBPROJ'}}) and ($pt[0]->{$ENV{'PBPROJ'}} =~ /$os-$ver-$arch/)) {
3520	$vmbuildlist = "$os-$ver-$arch" if ($vmbuildlist eq "");
3521	$vmbuildlist .= ",$os-$ver-$arch" if ($vmbuildlist !~ /$os-$ver-$arch/);
3522	next;
3523	}
3524	if ((defined $pt[1]->{$ENV{'PBPROJ'}}) and ($pt[1]->{$ENV{'PBPROJ'}} =~ /$os-$ver-$arch/)) {
3525	$vebuildlist = "$os-$ver-$arch" if ($vebuildlist eq "");
3526	$vebuildlist .= ",$os-$ver-$arch" if ($vebuildlist !~ /$os-$ver-$arch/);
3527	next;
3528	}
3529	if ((defined $pt[2]->{$ENV{'PBPROJ'}}) and ($pt[2]->{$ENV{'PBPROJ'}} =~ /$os-$ver-$arch/)) {
3530	$rmbuildlist = "$os-$ver-$arch" if ($rmbuildlist eq "");
3531	$rmbuildlist .= ",$os-$ver-$arch" if ($rmbuildlist !~ /$os-$ver-$arch/);
3532	}
3533	}
3534	}
3535	# If we want to rebuild automatically, let's do it
3536	if (defined $opts{'rebuild'}) {
3537	# SandBox or CMS
3538	pb_log(0,"Rebuilding from SandBox\n");
3539	pb_log(0,"for VMs: $vmbuildlist\n") if ($vmbuildlist ne "");
3540	pb_log(0,"for VEs: $vebuildlist\n") if ($vebuildlist ne "");
3541	pb_log(0,"for RMs: $rmbuildlist\n") if ($rmbuildlist ne "");
3542	pb_cms2build("SandBox");
3543	# Which mode
3544	$ENV{'PBV'} = $vmbuildlist;
3545	pb_build2v("vm","build") if ($vmbuildlist ne "");
3546	$ENV{'PBV'} = $vebuildlist;
3547	pb_build2v("ve","build") if ($vebuildlist ne "");
3548	$ENV{'PBV'} = $rmbuildlist;
3549	pb_build2v("rm","build") if ($rmbuildlist ne "");
3550	}
3551	# For the check part this is now finished
3552	return;
3553	}
3554
3555	print ANN << "EOF";
3556	</TR>
3557	</TABLE>
3558	</p>
3559
3560	<p>As usual source packages are also available in the same directory.</p>
3561
3562	<p>
3563	Changes are :
3564	</p>
3565	<p>
3566	EOF
3567	# Get each package changelog content
3568	foreach my $f (sort(@files)) {
3569	open(IN,"$f") \|\| die "Unable to read $f:$!";
3570	while (<IN>) {
3571	print ANN $_;
3572	}
3573	close(IN);
3574	print ANN "</p><p>\n";
3575	}
3576	print ANN "</p>\n";
3577	close(ANN);
3578
3579	# Allow for modification
3580	my $editor = "vi";
3581	$editor = $ENV{'EDITOR'} if (defined $ENV{'EDITOR'});
3582	pb_system("$editor $ENV{'PBTMP'}/announce.html","Allowing modification of the announce","noredir");
3583
3584	# Store it in DB for external usage (Web pages generation)
3585	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
3586
3587	my $precmd = "";
3588	if (! -f $db) {
3589	$precmd = "CREATE TABLE announces (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, announce VARCHAR[65535])";
3590	}
3591
3592	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
3593	{ RaiseError => 1, AutoCommit => 1 })
3594	\|\| die "Unable to connect to $db";
3595
3596	if ($precmd ne "") {
3597	my $sth = $dbh->prepare(qq{$precmd})
3598	\|\| die "Unable to create table into $db";
3599	$sth->execute();
3600	}
3601
3602	# To read whole file
3603	local $/;
3604	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
3605	my $announce = <ANN>;
3606	close(ANN);
3607
3608	pb_log(2,"INSERT INTO announces VALUES (NULL, $pbdate, $announce)");
3609	my $sth = $dbh->prepare(qq{INSERT INTO announces VALUES (NULL,?,?)})
3610	\|\| die "Unable to insert into $db";
3611	$sth->execute($pbdate, $announce);
3612	$sth->finish();
3613	$dbh->disconnect;
3614
3615	# Then deliver it on the Web
3616	# $TOOLHOME/livwww www
3617
3618	# Mail it to project's ML
3619	open(ML,"\| w3m -dump -T text/html > $ENV{'PBTMP'}/announce.txt") \|\| die "Unable to create $ENV{'PBTMP'}/announce.txt: $!";
3620	print ML << 'EOF';
3621	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/x html1/DTD/xhtml1-strict.dtd">
3622
3623	<html xmlns="http://www.w3.org/1999/xhtml" dir="ltr" xml:lang="en" lang="en">
3624	<head>
3625	</head>
3626	<body>
3627	<p>
3628	EOF
3629	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
3630	while(<ANN>) {
3631	print ML $_;
3632	}
3633	print ML << 'EOF';
3634	</body>
3635	</html>
3636	EOF
3637	close(ML);
3638
3639	# To read whole file
3640	local $/;
3641	open(ANN,"$ENV{'PBTMP'}/announce.txt") \|\| die "Unable to read $ENV{'PBTMP'}/announce.txt: $!";
3642	my $msg = <ANN>;
3643	close(ANN);
3644
3645	# Preparation of headers
3646	eval
3647	{
3648	require Mail::Sendmail;
3649	Mail::Sendmail->import();
3650	};
3651	if ($@) {
3652	# Mail::Sendmail not found not sending mail !
3653	pb_log(0,"No Mail::Sendmail module found so not sending any mail !\n");
3654	} else {
3655	my %mail = (
3656	To => $pbml->{$ENV{'PBPROJ'}},
3657	From => $pbpackager->{$ENV{'PBPROJ'}},
3658	Smtp => $pbsmtp->{$ENV{'PBPROJ'}},
3659	Body => $msg,
3660	Subject => "[ANNOUNCE] $sl",
3661	);
3662
3663	# Send mail
3664	if (! sendmail(%mail)) {
3665	if ((defined $Mail::Sendmail::error) and (defined $Mail::Sendmail::log)) {
3666	die "Unable to send mail ($Mail::Sendmail::error): $Mail::Sendmail::log";
3667	}
3668	}
3669	}
3670	}
3671
3672	#
3673	# Creates a set of HTML file containing the news for the project
3674	# based on what has been generated by the pb_announce function
3675	#
3676	sub pb_web_news2html {
3677
3678	my $dest = shift \|\| $ENV{'PBTMP'};
3679
3680	# Get all required parameters
3681	my ($pkgv, $pkgt) = pb_conf_get_if("pkgver","pkgtag");
3682
3683	# DB of announces for external usage (Web pages generation)
3684	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
3685
3686	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
3687	{ RaiseError => 1, AutoCommit => 1 })
3688	\|\| die "Unable to connect to $db";
3689	# For date handling
3690	$ENV{LANGUAGE}="C";
3691	my $firstjan = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year(), 0, 0, -1);
3692	my $oldfirst = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year()-1, 0, 0, -1);
3693	pb_log(2,"firstjan: $firstjan, oldfirst: $oldfirst, pbdate:$pbdate\n");
3694	my $all = $dbh->selectall_arrayref("SELECT id,date,announce FROM announces ORDER BY date DESC");
3695	my %news;
3696	$news{"cy"} = ""; # current year's news
3697	$news{"ly"} = ""; # last year news
3698	$news{"py"} = ""; # previous years news
3699	$news{"fp"} = ""; # first page news
3700	my $cpt = 4; # how many news for first page
3701	# Extract info from DB
3702	foreach my $row (@$all) {
3703	my ($id, $date, $announce) = @$row;
3704	$news{"cy"} = $news{"cy"}."<p><B>$date</B> $announce\n" if ((($date cmp $pbdate) le 0) && (($firstjan cmp $date) le 0));
3705	$news{"ly"} = $news{"ly"}."<p><B>$date</B> $announce\n" if ((($date cmp $firstjan) le 0) && (($oldfirst cmp $date) le 0));
3706	$news{"py"} = $news{"py"}."<p><B>$date</B> $announce\n" if (($date cmp $oldfirst) le 0);
3707	$news{"fp"} = $news{"fp"}."<p><B>$date</B> $announce\n" if ($cpt > 0);
3708	$cpt--;
3709	}
3710	pb_log(1,"news{fp}: ".$news{"fp"}."\n");
3711	$dbh->disconnect;
3712
3713	# Generate the HTML content
3714	foreach my $pref (keys %news) {
3715	open(NEWS,"> $dest/pb_web_$pref"."news.html") \|\| die "Unable to create $dest/pb_web_$pref"."news.html: $!";
3716	print NEWS "$news{$pref}";
3717	close(NEWS);
3718	}
3719	}
3720
3721
3722	# Return the SSH key file to use
3723	# Potentially create it if needed
3724
3725	sub pb_ssh_get {
3726
3727	my $create = shift \|\| 0; # Do not create keys by default
3728
3729	# Check the SSH environment
3730	my $keyfile = undef;
3731
3732	# We have specific keys by default
3733	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
3734	if (!(-e $keyfile) && ($create eq 1)) {
3735	pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
3736	}
3737
3738	$keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
3739	$keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
3740	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
3741	die "Unable to find your public ssh key under $keyfile" if (not defined $keyfile);
3742	return($keyfile);
3743	}
3744
3745
3746	# Returns the pid of a running VM command using a specific VM file
3747	sub pb_check_ps {
3748	my $vmcmd = shift;
3749	my $vmm = shift;
3750	my $vmexist = 0; # FALSE by default
3751
3752	open(PS, "ps auxhww\|") \|\| die "Unable to call ps";
3753	while (<PS>) {
3754	next if (! /$vmcmd/);
3755	next if (! /$vmm/);
3756	my ($void1, $void2);
3757	($void1, $vmexist, $void2) = split(/ +/);
3758	last;
3759	}
3760	return($vmexist);
3761	}
3762
3763
3764	sub pb_extract_build_files {
3765
3766	my $src=shift;
3767	my $dir=shift;
3768	my $ddir=shift;
3769	my $mandatory=shift \|\| "spec";
3770	my @files;
3771
3772	my $flag = "mayfail" if (($mandatory eq "patch") \|\| ($mandatory eq "src"));
3773	my $res;
3774
3775	if ($src =~ /tar\.gz$/) {
3776	$res = pb_system("tar xfpz $src $dir","Extracting $mandatory files from $src",$flag);
3777	} elsif ($src =~ /tar\.bz2$/) {
3778	$res = pb_system("tar xfpj $src $dir","Extracting $mandatory files from $src",$flag);
3779	} else {
3780	die "Unknown compression algorithm for $src";
3781	}
3782	# If not mandatory return now
3783	return() if (($res != 0) and (($mandatory eq "patch") \|\| ($mandatory eq "src")));
3784	opendir(DIR,"$dir") \|\| die "Unable to open directory $dir";
3785	foreach my $f (readdir(DIR)) {
3786	next if ($f =~ /^\./);
3787	# Skip potential patch dir
3788	next if ($f =~ /^pbpatch/);
3789	# Skip potential source dir
3790	next if ($f =~ /^pbsrc/);
3791	# Skip potential backup files
3792	next if ($f =~ /~$/);
3793	move("$dir/$f","$ddir") \|\| die "Unable to move $dir/$f to $ddir";
3794	pb_log(2,"mv $dir/$f $ddir\n");
3795	push @files,"$ddir/$f";
3796	}
3797	closedir(DIR);
3798	# Not enough but still a first cleanup
3799	pb_rm_rf("$dir");
3800	return(@files);
3801	}
3802
3803	sub pb_list_bfiles {
3804
3805	my $dir = shift;
3806	my $pbpkg = shift;
3807	my $bfiles = shift;
3808	my $pkgfiles = shift;
3809	my $supfiles = shift;
3810	# subdir to keep if recursive mode, empty by default
3811	my $subdir = shift \|\| "";
3812	# In a recursive function , we need a local var as DIR handle
3813	my $bdir;
3814
3815	pb_log(2,"DEBUG: entering pb_list_bfiles in $dir: ".Dumper($bfiles)."\n");
3816	opendir($bdir,"$dir") \|\| die "Unable to open dir $dir: $!";
3817	foreach my $f (readdir($bdir)) {
3818	pb_log(3,"DEBUG: pb_list_bfiles found $f\n");
3819	next if ($f =~ /^\./);
3820	if (-d "$dir/$f") {
3821	# Recurse for directories (Debian 3.0 format e.g.)
3822	pb_log(2,"DEBUG: pb_list_bfiles recurse in $dir/$f\n");
3823	pb_list_bfiles("$dir/$f",$pbpkg,$bfiles,$pkgfiles,$supfiles,$f);
3824	next;
3825	}
3826
3827	my $key = $f;
3828	# if recursive then store also the subdir
3829	$key = "$subdir/$f" if ($subdir ne "");
3830	$bfiles->{$key} = "$dir/$f";
3831	$bfiles->{$key} =~ s~$ENV{'PBROOTDIR'}~~;
3832	if (defined $supfiles->{$pbpkg}) {
3833	$pkgfiles->{$key} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
3834	}
3835	}
3836	closedir($bdir);
3837	pb_log(2,"DEBUG: exiting pb_list_bfiles: ".Dumper($bfiles)."\n");
3838	}
3839
3840	sub pb_add_coma {
3841
3842	my $str = shift;
3843	my $addstr = shift;
3844
3845	$str .= "," if (defined $str);
3846	$str .= $addstr;
3847	return($str);
3848	}
3849
3850	sub pb_list_sfiles {
3851
3852	my $sdir = shift;
3853	my $ptr = shift;
3854	my $pbos = shift;
3855	my $extdir = shift;
3856
3857	pb_log(2,"DEBUG: entering pb_list_sfiles: ".Dumper($ptr)."\n");
3858	my $key = "$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
3859
3860	# Prepare local sources for this distro - They are always applied first - May be a problem one day
3861	# This function works for both patches and additional sources
3862	foreach my $p (sort(<$sdir/*>)) {
3863	$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'}$/));
3864	}
3865
3866	# Prepare also remote sources to be included - Applied after the local ones
3867	foreach my $p ("all","$pbos->{'os'}","$pbos->{'type'}","$pbos->{'family'}","$pbos->{'name'}","$pbos->{'name'}-$pbos->{'version'}","$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}") {
3868	my $f = "$extdir.".".$p";
3869	next if (not -f $f);
3870	if (not open(PATCH,$f)) {
3871	pb_display("Unable to open existing external source file content $f\n");
3872	next;
3873	}
3874	while (<PATCH>) {
3875	chomp();
3876	$ptr->{$key} = pb_add_coma($ptr->{$key},"$_");
3877	}
3878	close(PATCH);
3879	}
3880	pb_log(2,"DEBUG: exiting pb_list_sfiles: ".Dumper($ptr)."\n");
3881	return($ptr);
3882	}
3883
3884	#
3885	# Return the list of packages we are working on in a non CMS action
3886	#
3887	sub pb_get_pkg {
3888
3889	my @pkgs = ();
3890
3891	my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
3892	@pkgs = keys %$var;
3893
3894	pb_log(0,"Packages: ".join(',',@pkgs)."\n");
3895	return(\@pkgs);
3896	}
3897
3898	# Manages VM/RM SSH port communication
3899	sub pb_get_port {
3900
3901	my $port = shift;
3902	my $pbos = shift;
3903	my $cmt = shift;
3904	my $nport;
3905
3906	die "No port passed in parameter. Report to dev team\n" if (not defined $port);
3907	# key is project on VM, but machine tuple for RM
3908	if ($cmt =~ /^RM/i) {
3909	$nport = $port->{"$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}"};
3910	} else {
3911	$nport = $port->{$ENV{'PBPROJ'}};
3912	}
3913	pb_log(2,"pb_get_port with $nport\n");
3914	# Maybe a port was given as parameter so overwrite
3915	$nport = "$pbport" if (defined $pbport);
3916	# 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
3917	if (($cmt ne "Packages") && ($cmt !~ /^RM/i)) {
3918	$nport += $ENV{'PBVMPORT'} if ((defined $pbparallel) && (defined $ENV{'PBVMPORT'}));
3919	}
3920	pb_log(2,"pb_get_port returns $nport\n");
3921	return($nport);
3922	}
3923
3924	sub pb_set_port {
3925
3926	my ($pid,$ident) = @_;
3927	pb_log(2,"pb_set_port for VM ($pid), id $ident\n");
3928	$ENV{'PBVMPORT'} = $ident;
3929	pb_log(2,"pb_set_port sets PBVMPORT in env to $ENV{'PBVMPORT'}\n");
3930	}
3931
3932	sub pb_set_parallel {
3933
3934	my $vtype = shift;
3935
3936	pb_log(2,"pb_set_parallel vtype: $vtype\n");
3937	# Take care of memory size if VM, parallel mode and more than 1 action
3938	if ((defined $pbparallel) && ($pbparallel ne 1) && ($vtype eq "vm")) {
3939	eval
3940	{
3941	require Linux::SysInfo;
3942	Linux::SysInfo->import();
3943	};
3944	if ($@) {
3945	# Linux::SysInfo not found
3946	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");
3947	} else {
3948	# Using the memory size
3949	my $si = Linux::SysInfo::sysinfo();
3950	if (not defined $si) {
3951	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");
3952	} else {
3953	# Keep the number of VM whose memory can be allocated
3954	my $ram = $si->{"totalram"}-$si->{"sharedram"}-$si->{"bufferram"};
3955	my $ram2;
3956	my ($vmmem) = pb_conf_get_if("vmmem");
3957
3958	my $v = "default";
3959	if ((defined $vmmem) and (defined $vmmem->{$v})) {
3960	$ram2 = $vmmem->{$v};
3961	} else {
3962	# Default for KVM/QEMU
3963	$ram2 = 128;
3964	}
3965	$pbparallel = sprintf("%d",$ram/$ram2);
3966	}
3967	pb_log(1,"Using $pbparallel processes at a time\n");
3968	}
3969	}
3970	pb_log(2,"pb_set_parallel returns: $pbparallel\n") if (defined $pbparallel);
3971	return($pbparallel);
3972	}
3973
3974	sub pb_get_sudocmds {
3975
3976	my $pbos = shift;
3977	my %sudocmds;
3978
3979	pb_log(2,"pb_get_sudocmds entering with lines:".Dumper(@_)."\n");
3980	foreach my $c (split(/;/,$pbos->{'update'}),split(/;/,$pbos->{'install'}),@_) {
3981	pb_log(2,"pb_get_sudocmds analyses $c\n");
3982	next if ($c !~ /^\s*sudo/);
3983	# remove sudo and leading spaces
3984	$c =~ s/^\s*sudo\s+//;
3985	# keep only the command, not the params
3986	$c =~ s/([^\s]+)\s.*$/$1/;
3987	$sudocmds{$c} = "";
3988	}
3989	pb_log(2,"pb_get_sudocmds returns ".Dumper(keys %sudocmds)."\n");
3990	return(keys %sudocmds);
3991	}
3992
3993	sub pb_sign_pkgs {
3994
3995	my $pbos = shift;
3996	my $made = shift;
3997
3998	pb_log(2,"entering pb_sign_pkg: $made ".Dumper($pbos)."\n");
3999	my ($passfile, $passphrase, $passpath) = pb_conf_get_if("pbpassfile","pbpassphrase","pbpasspath");
4000	$ENV{'PBPASSPHRASE'} = $passphrase->{$ENV{'PBPROJ'}} if ((not defined $ENV{'PBPASSPHRASE'}) && (defined $passphrase->{$ENV{'PBPROJ'}}));
4001	$ENV{'PBPASSFILE'} = $passfile->{$ENV{'PBPROJ'}} if ((not defined $ENV{'PBPASSFILE'})&& (defined $passfile->{$ENV{'PBPROJ'}})) ;
4002	$ENV{'PBPASSPATH'} = $passpath->{$ENV{'PBPROJ'}} if ((not defined $ENV{'PBPASSPATH'})&& (defined $passpath->{$ENV{'PBPROJ'}})) ;
4003
4004	# Remove extra spaces
4005	$made =~ s/\s+/ /g;
4006	$made =~ s/^\s//g;
4007	$made =~ s/\s$//g;
4008
4009	if ($pbos->{'type'} eq "rpm") {
4010	eval
4011	{
4012	require RPM4::Sign;
4013	RPM4::Sign->import();
4014	};
4015	if ($@) {
4016	# RPM4::Sign not found
4017	pb_log(1,"WARNING: Install RPM4::Sign to benefit from automatic package signing.\n");
4018	} else {
4019	return if ((not defined $ENV{'PBPASSPHRASE'}) and (not defined $ENV{'PBPASSFILE'}));
4020	my $sign = RPM4::Sign->new(
4021	passphrase => $ENV{'PBPASSPHRASE'},
4022	name => $ENV{'PBPACKAGER'},
4023	path => $ENV{'PBPASSPATH'},
4024	password_file => $ENV{'PBPASSFILE'},
4025	);
4026
4027	pb_log(0,"Signing RPM packages...\n");
4028	pb_log(2,"pb_sign_pkg: pkgs:".Dumper(split(/ /,$made))."\n");
4029	$sign->rpmssign(split(/ /,$made));
4030	}
4031	} elsif ($pbos->{'type'} eq "deb") {
4032	my $changes = "";
4033	foreach my $c (split(/ /,$made)) {
4034	$changes .= " $ENV{'PBBUILDDIR'}/$c" if ($c =~ /\.changes$/);
4035	}
4036	my $debsigncmd = pb_check_req("debsign",1);
4037	pb_system("$debsigncmd -m\'$ENV{'PBPACKAGER'}\' $changes","Signing DEB packages");
4038	} else {
4039	pb_log(0,"I don't know yet how to sign packages for type $pbos->{'type'}.\nPlease give feedback to dev team\n");
4040	}
4041	pb_log(2,"exiting pb_sign_pkg\n");
4042	}
4043
4044	# return list of all distributins supported, coma separated
4045	sub pb_get_distros {
4046
4047	my $pbos = shift;
4048	my $pbtarget = shift;
4049
4050	my $tmpl = "$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'},";
4051
4052	# Get list of distributions for which we need to generate build files if no target
4053	if (not defined $pbtarget) {
4054	my @pt = pb_conf_get_if("vmlist","velist","rmlist");
4055	if (defined $pt[0]->{$ENV{'PBPROJ'}}) {
4056	$tmpl .= $pt[0]->{$ENV{'PBPROJ'}};
4057	}
4058	if (defined $pt[1]->{$ENV{'PBPROJ'}}) {
4059	# The 2 lists need to be grouped with a ',' separating them
4060	if ($tmpl ne "") {
4061	$tmpl .= ",";
4062	}
4063	$tmpl .= $pt[1]->{$ENV{'PBPROJ'}}
4064	}
4065	if (defined $pt[2]->{$ENV{'PBPROJ'}}) {
4066	# The lists needs to be grouped with a ',' separating them
4067	if ($tmpl ne "") {
4068	$tmpl .= ",";
4069	}
4070	$tmpl .= $pt[2]->{$ENV{'PBPROJ'}}
4071	}
4072	}
4073	return($tmpl);
4074	}
4075
4076	sub pb_get_extdir () {
4077
4078	# the pbrc file should contain it and whatever the key, we take it
4079	my ($ed) = pb_conf_read("$ENV{'PBDESTDIR'}/pbrc","pbextdir");
4080	pb_log(2,"ed: ".Dumper($ed)."\n");
4081	my $pbextdir = "";
4082	foreach my $k (keys %$ed) {
4083	$pbextdir = $ed->{$k};
4084	# In case we have an empty field, empty it completely
4085	pb_log(2,"pbextdir: *$pbextdir*\n");
4086	$pbextdir =~ s/^\s*$//;
4087	}
4088	pb_log(2,"pbextdir: *$pbextdir*\n");
4089	return($pbextdir);
4090	}
4091
4092	1;

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

Download in other formats: