Context Navigation

source: devel/pb/bin/pb @ 1426

Revision 1426, 132.2 KB checked in by bruno, 16 months ago (diff)
Fix an earlier bug introduced on sudoers update
Property svn:executable set to ``*

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

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

Download in other formats: