Context Navigation

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

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

r4486@cabanilles: bruno | 2012-02-01 15:24:46 +0100

Make the parameter of the -t option optional, in which case the underlying distro is used

Property svn:executable set to *

File size: 131.1 KB

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

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

Download in other formats: