Context Navigation

source: devel/pb/bin/pb @ 735

Revision 735, 84.5 KB checked in by bruno, 4 years ago (diff)
pb now differentiates suse (aka SuSE Professional) and opensuse. Fix original #40
Property svn:executable set to ``*

Line
1	#!/usr/bin/perl -w
2	#
3	# Project Builder main application
4	#
5	# $Id$
6	#
7	# Copyright B. Cornec 2007
8	# Provided under the GPL v2
9
10	# Syntax: see at end
11
12	use strict 'vars';
13	use Getopt::Long qw(:config auto_abbrev no_ignore_case);
14	use Data::Dumper;
15	use English;
16	use File::Basename;
17	use File::Copy;
18	use File::stat;
19	use File::Temp qw(tempdir);
20	use Time::localtime qw(localtime);
21	use POSIX qw(strftime);
22	use lib qw (lib);
23	use ProjectBuilder::Version;
24	use ProjectBuilder::Base;
25	use ProjectBuilder::Display;
26	use ProjectBuilder::Conf;
27	use ProjectBuilder::Distribution;
28	use ProjectBuilder::CMS;
29	use ProjectBuilder::Env;
30	use ProjectBuilder::Filter;
31	use ProjectBuilder::Changelog;
32	use Mail::Sendmail;
33
34	# Global variables
35	my %opts; # CLI Options
36	my $action; # action to realize
37	my $test = "FALSE"; # Not used
38	my $force = 0; # Force VE/VM rebuild
39	my $option = ""; # Not used
40	my @pkgs; # list of packages
41	my $pbtag; # Global Tag variable
42	my $pbver; # Global Version variable
43	my $pbscript; # Name of the script
44	my %pbver; # per package
45	my %pbtag; # per package
46	my $pbrev; # Global REVISION variable
47	my $pbaccount; # Login to use to connect to the VM
48	my $pbport; # Port to use to connect to the VM
49	my $newver; # New version to create
50	my $iso; # ISO image for the VM to create
51
52	my @date = pb_get_date();
53	my $pbdate = strftime("%Y-%m-%d", @date);
54
55	=pod
56
57	=head1 NAME
58
59	pb, aka project-builder.org - builds packages for your projects
60
61	=head1 DESCRIPTION
62
63	pb helps you build various packages directly from your project sources.
64	Those sources could be handled by a CMS (Configuration Management System)
65	such as Subversion, CVS, Mercurial... or being a simple reference to a compressed tar file.
66	It's based on a set of configuration files, a set of provided macros to help
67	you keeping build files as generic as possible. For example, a single .spec
68	file should be required to generate for all rpm based distributions, even
69	if you could also have multiple .spec files if required.
70
71	=head1 SYNOPSIS
72
73	pb [-vhq][-r pbroot][-p project][[-s script -a account -P port][-m mach-1[,...]]][-i iso] <action> [<pkg1> ...]
74
75	pb [--verbose][--help][--man][--quiet][--revision pbroot][--project project][[--script script --account account --port port][--machine mach-1[,...]]][--iso iso] <action> [<pkg1> ...]
76
77	=head1 OPTIONS
78
79	=over 4
80
81	=item B<-v\|--verbose>
82
83	Print a brief help message and exits.
84
85	=item B<-q\|--quiet>
86
87	Do not print any output.
88
89	=item B<-h\|--help>
90
91	Print a brief help message and exits.
92
93	=item B<--man>
94
95	Prints the manual page and exits.
96
97	=item B<-m\|--machine machine1[,machine2,...]>
98
99	Name of the Virtual Machines (VM) or Virtual Environments (VE) you want to build on (coma separated).
100	All if none precised (or use the env variable PBV).
101
102	=item B<-s\|--script script>
103
104	Name of the script you want to execute on the related VMs or VEs.
105
106	=item B<-i\|--iso iso_image>
107
108	Name of the ISO image of the distribution you want to install on the related VMs.
109
110	=item B<-a\|--account account>
111
112	Name of the account to use to connect on the related VMs.
113
114	=item B<-P\|--port port_number>
115
116	Port number to use to connect on the related VMs.\n";
117
118	=item B<-p\|--project project_name>
119
120	Name of the project you're working on (or use the env variable PBPROJ)
121
122	=item B<-r\|--revision revision>
123
124	Path Name of the project revision under the CMS (or use the env variable PBROOT)
125
126	=item B<-V\|--version new_version>
127
128	New version of the project to create based on the current one.
129
130	=back
131
132	=head1 ARGUMENTS
133
134	<action> can be:
135
136	=over 4
137
138	=item B<cms2build>
139
140	Create tar files for the project under your CMS.
141	CMS supported are SVN, CVS and Mercurial
142	parameters are packages to build
143	if not using default list
144
145	=item B<build2pkg>
146
147	Create packages for your running distribution
148
149	=item B<cms2pkg>
150
151	cms2build + build2pkg
152
153	=item B<build2ssh>
154
155	Send the tar files to a SSH host
156
157	=item B<cms2ssh>
158
159	cms2build + build2ssh
160
161	=item B<pkg2ssh>
162
163	Send the packages built to a SSH host
164
165	=item B<build2vm>
166
167	Create packages in VMs, launching them if needed
168	and send those packages to a SSH host once built
169	VM type supported are QEMU
170
171	=item B<build2ve>
172
173	Create packages in VEs, creating it if needed
174	and send those packages to a SSH host once built
175
176	=item B<cms2vm>
177
178	cms2build + build2vm
179
180	=item B<cms2ve>
181
182	cms2build + build2ve
183
184	=item B<launchvm>
185
186	Launch one virtual machine
187
188	=item B<launchve>
189
190	Launch one virtual environment
191
192	=item B<script2vm>
193
194	Launch one virtual machine if needed
195	and executes a script on it
196
197	=item B<script2ve>
198
199	Execute a script in a virtual environment
200
201	=item B<newvm>
202
203	Create a new virtual machine
204
205	=item B<newve>
206
207	Create a new virtual environment
208
209	=item B<setupvm>
210
211	Setup a virtual machine for pb usage
212
213	=item B<setupve>
214
215	Setup a virtual environment for pb usage
216
217	=item B<newver>
218
219	Create a new version of the project derived
220	from the current one
221
222	=item B<newproj>
223
224	Create a new project and a template set of
225	configuration files under pbconf
226
227	=item B<announce>
228
229	Announce the availability of the project through various means
230
231	=item B<web2ssh>
232
233	Deliver the Web site content to the target server using ssh.
234
235	=back
236
237	<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).
238
239	=head1 WEB SITES
240
241	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/>.
242
243	=head1 USER MAILING LIST
244
245	None exists for the moment.
246
247	=head1 CONFIGURATION FILES
248
249	Each pb user may have a configuration in F<$HOME/.pbrc>. The values in this file may overwrite any other configuration file value.
250
251	Here is an example of such a configuration file:
252
253	#
254	# Define for each project the URL of its pbconf repository
255	# No default option allowed here as they need to be all different
256	#
257	# URL of the pbconf content
258	# This is the format of a classical URL with the extension of additional schema such as
259	# svn+ssh, cvs+ssh, ...
260	#
261	pbconfurl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe/pbconf
262
263	# This is normaly defined in the project's configuration file
264	# Url of the project
265	#
266	pburl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe
267
268	# All these URLs needs to be defined here as the are the entry point
269	# for how to build packages for the project
270	#
271	pbconfurl pb = svn+ssh://svn.project-builder.org/mondo/svn/pb/pbconf
272	pbconfurl mondorescue = svn+ssh://svn.project-builder.org/mondo/svn/project-builder/mondorescue/pbconf
273	pbconfurl collectl = svn+ssh://bruno@svn.mondorescue.org/mondo/svn/project-builder/collectl/pbconf
274	pbconfurl netperf = svn+ssh://svn.mondorescue.org/mondo/svn/project-builder/netperf/pbconf
275
276	# Under that dir will take place everything related to pb
277	# If you want to use VMs/chroot/..., then use $ENV{'HOME'} to make it portable
278	# to your VMs/chroot/...
279	# if not defined then /var/cache
280	pbdefdir default = $ENV{'HOME'}/project-builder
281	pbdefdir pb = $ENV{'HOME'}
282	pbdefdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
283	pbdefdir mondorescue = $ENV{'HOME'}/mondo/svn
284
285	# pbconfdir points to the directory where the CMS content of the pbconfurl is checked out
286	# If not defined, pbconfdir is under pbdefdir/pbproj/pbconf
287	pbconfdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs/pbconf
288	pbconfdir mondorescue = $ENV{'HOME'}/mondo/svn/pbconf
289
290	# pbdir points to the directory where the CMS content of the pburl is checked out
291	# If not defined, pbdir is under pbdefdir/pbproj
292	# Only defined if we have access to the dev of the project
293	pbdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
294	pbdir mondorescue = $ENV{'HOME'}/mondo/svn
295
296	# -daemonize doesn't work with qemu 0.8.2
297	vmopt default = -m 384
298
299	=head1 AUTHORS
300
301	The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
302
303	=head1 COPYRIGHT
304
305	Project-Builder.org is distributed under the GPL v2.0 license
306	described in the file C<COPYING> included with the distribution.
307
308	=cut
309
310	# ---------------------------------------------------------------------------
311
312	# Old syntax
313	#getopts('a:fhi:l:m:P:p:qr:s:vV:',\%opts);
314
315	my ($projectbuilderver,$projectbuilderrev) = pb_version_init();
316
317	# Initialize the syntax string
318
319	pb_syntax_init("pb (aka project-builder.org) Version $projectbuilderver-$projectbuilderrev\n");
320
321	GetOptions("help\|?\|h" => \$opts{'h'},
322	"man" => \$opts{'man'},
323	"verbose\|v+" => \$opts{'v'},
324	"quiet\|q" => \$opts{'q'},
325	"log-files\|l=s" => \$opts{'l'},
326	"force\|f" => \$opts{'f'},
327	"account\|a=s" => \$opts{'a'},
328	"revision\|r=s" => \$opts{'r'},
329	"script\|s=s" => \$opts{'s'},
330	"machines\|mock\|m=s" => \$opts{'m'},
331	"port\|P=i" => \$opts{'P'},
332	"project\|p=s" => \$opts{'p'},
333	"iso\|i=s" => \$opts{'i'},
334	"version\|V=s" => \$opts{'V'},
335	) \|\| pb_syntax(-1,0);
336
337	if (defined $opts{'h'}) {
338	pb_syntax(0,1);
339	}
340	if (defined $opts{'man'}) {
341	pb_syntax(0,2);
342	}
343	if (defined $opts{'v'}) {
344	$pbdebug = $opts{'v'};
345	}
346	if (defined $opts{'f'}) {
347	$force=1;
348	}
349	if (defined $opts{'q'}) {
350	$pbdebug=-1;
351	}
352	if (defined $opts{'l'}) {
353	open(pbLOG,"> $opts{'l'}") \|\| die "Unable to log to $opts{'l'}: $!";
354	$pbLOG = \*pbLOG;
355	$pbdebug = 0 if ($pbdebug == -1);
356	}
357	pb_log_init($pbdebug, $pbLOG);
358	pb_display_init("text","");
359
360	# Handle root of the project if defined
361	if (defined $opts{'r'}) {
362	$ENV{'PBROOTDIR'} = $opts{'r'};
363	}
364	# Handle virtual machines if any
365	if (defined $opts{'m'}) {
366	$ENV{'PBV'} = $opts{'m'};
367	}
368	if (defined $opts{'s'}) {
369	$pbscript = $opts{'s'};
370	}
371	if (defined $opts{'a'}) {
372	$pbaccount = $opts{'a'};
373	die "option -a requires a -s script option" if (not defined $pbscript);
374	}
375	if (defined $opts{'P'}) {
376	$pbport = $opts{'P'};
377	}
378	if (defined $opts{'V'}) {
379	$newver = $opts{'V'};
380	}
381	if (defined $opts{'i'}) {
382	$iso = $opts{'i'};
383	}
384
385	# Get Action
386	$action = shift @ARGV;
387	die pb_syntax(-1,1) if (not defined $action);
388
389	my ($filteredfiles, $supfiles, $defpkgdir, $extpkgdir);
390	my $pbinit = undef;
391	$pbinit = 1 if ($action =~ /^newproj$/);
392
393	# Handles project name if any
394	# And get global params
395	($filteredfiles, $supfiles, $defpkgdir, $extpkgdir) = pb_env_init($opts{'p'},$pbinit,$action);
396
397	pb_log(0,"Project: $ENV{'PBPROJ'}\n");
398	pb_log(0,"Action: $action\n");
399
400	# Act depending on action
401	if ($action =~ /^cms2build$/) {
402	pb_cms2build();
403	} elsif ($action =~ /^build2pkg$/) {
404	pb_build2pkg();
405	} elsif ($action =~ /^cms2pkg$/) {
406	pb_cms2build();
407	pb_build2pkg();
408	} elsif ($action =~ /^build2ssh$/) {
409	pb_build2ssh();
410	} elsif ($action =~ /^cms2ssh$/) {
411	pb_cms2build();
412	pb_build2ssh();
413	} elsif ($action =~ /^pkg2ssh$/) {
414	pb_pkg2ssh();
415	} elsif ($action =~ /^build2ve$/) {
416	pb_build2v("ve");
417	} elsif ($action =~ /^build2vm$/) {
418	pb_build2v("vm");
419	} elsif ($action =~ /^cms2ve$/) {
420	pb_cms2build();
421	pb_build2v("ve");
422	} elsif ($action =~ /^cms2vm$/) {
423	pb_cms2build();
424	pb_build2v("vm");
425	} elsif ($action =~ /^launchvm$/) {
426	pb_launchv("vm",$ENV{'PBV'},0);
427	} elsif ($action =~ /^launchve$/) {
428	pb_launchv("ve",$ENV{'PBV'},0);
429	} elsif ($action =~ /^script2vm$/) {
430	pb_script2v($pbscript,"vm");
431	} elsif ($action =~ /^script2ve$/) {
432	pb_script2v($pbscript,"ve");
433	} elsif ($action =~ /^newver$/) {
434	pb_newver();
435	} elsif ($action =~ /^newve$/) {
436	pb_launchv("ve",$ENV{'PBV'},1);
437	} elsif ($action =~ /^newvm$/) {
438	pb_launchv("vm",$ENV{'PBV'},1);
439	} elsif ($action =~ /^setupve$/) {
440	pb_setup_v("ve");
441	} elsif ($action =~ /^setupvm$/) {
442	pb_setup_v("vm");
443	} elsif ($action =~ /^newproj$/) {
444	# Nothing to do - already done in pb_env_init
445	} elsif ($action =~ /^clean$/) {
446	# TBC
447	} elsif ($action =~ /^announce$/) {
448	# For announce only. Require avoids the systematic load of these modules
449	require DBI;
450	require DBD::SQLite;
451
452	pb_announce();
453	} elsif ($action =~ /^web2ssh$/) {
454	require DBI;
455	require DBD::SQLite;
456
457	pb_cms2build("Web");
458	pb_send2target("Web");
459	} else {
460	pb_log(0,"\'$action\' is not available\n");
461	pb_syntax(-2,1);
462	}
463
464	sub pb_cms2build {
465
466	my $param = shift \|\| undef;
467
468	my $pkg;
469	my @pkgs;
470	my $webdir;
471
472	my %pkgs;
473	my %pb; # Structure to store conf info
474
475	# If Website, then pkg is only the website
476	if ((defined $param) && ($param eq "Web")) {
477	($webdir) = pb_conf_get("webdir");
478	pb_log(2,"webdir: ".Dumper($webdir)."\n");
479	$pkgs[0] = $webdir->{$ENV{'PBPROJ'}};
480	$extpkgdir = $webdir;
481	pb_log(0,"Package: $pkgs[0]\n");
482	} else {
483	$pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
484	@pkgs = @$pkg;
485	}
486
487	my ($scheme, $uri) = pb_cms_init($pbinit);
488
489	my ($pkgv, $pkgt) = pb_conf_get_if("pkgver","pkgtag");
490
491	# declare packager and repo for filtering
492	my ($tmp1, $tmp2) = pb_conf_get("pbpackager","pbrepo");
493	$ENV{'PBPACKAGER'} = $tmp1->{$ENV{'PBPROJ'}};
494	$ENV{'PBREPO'} = $tmp2->{$ENV{'PBPROJ'}};
495
496	foreach my $pbpkg (@pkgs) {
497	my ($testver) = pb_conf_get_if("testver");
498	$ENV{'PBPKG'} = $pbpkg;
499
500	if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
501	$pbver = $pkgv->{$pbpkg};
502	} else {
503	$pbver = $ENV{'PBPROJVER'};
504	}
505	# If it's a test version, then tag == 0.date
506	if (defined $testver->{$ENV{'PBPROJ'}}) {
507	$pbtag = "0.".strftime("%Y%m%d%H%M%S", @date);
508	$ENV{'PBPROJTAG'} = $pbtag;
509	} elsif ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
510	$pbtag = $pkgt->{$pbpkg};
511	} else {
512	$pbtag = $ENV{'PBPROJTAG'};
513	}
514
515	$pbrev = $ENV{'PBREVISION'};
516	pb_log(0,"\n");
517	pb_log(0,"Management of $pbpkg $pbver-$pbtag (rev $pbrev)\n");
518	die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
519
520	# Clean up dest if necessary. The export will recreate it
521	my $dest = "$ENV{'PBDESTDIR'}/$pbpkg-$pbver";
522	pb_rm_rf($dest) if (-d $dest);
523
524	# Export CMS tree for the concerned package to dest
525	# And generate some additional files
526	$OUTPUT_AUTOFLUSH=1;
527
528	# computes in which dir we have to work
529	my $dir = $defpkgdir->{$pbpkg};
530	$dir = $extpkgdir->{$pbpkg} if (not defined $dir);
531	$dir = $webdir->{$ENV{'PBPROJ'}} if ((defined $param) && ($param eq "Web"));
532	pb_log(2,"def:".Dumper($defpkgdir)." ext: ".Dumper($extpkgdir)." \n");
533
534	# Exporting content from CMS
535	my $preserve = pb_cms_export($uri,"$ENV{'PBDIR'}/$dir",$dest);
536
537	# Generated fake content for test versions to speed up stuff
538	my $chglog;
539
540	# Get project info on authors and log file
541	$chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
542	$chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
543	$chglog = undef if (! -f $chglog);
544
545	my $authors = "$ENV{'PBROOTDIR'}/$pbpkg/pbauthors";
546	$authors = "$ENV{'PBROOTDIR'}/pbauthors" if (! -f $authors);
547	$authors = "/dev/null" if (! -f $authors);
548
549	# Extract cms log history and store it
550	if ((defined $chglog) && (! -f "$dest/NEWS")) {
551	pb_log(2,"Generating NEWS file from $chglog\n");
552	copy($chglog,"$dest/NEWS") \|\| die "Unable to create $dest/NEWS";
553	}
554	pb_cms_log($scheme,"$ENV{'PBDIR'}/$dir",$dest,$chglog,$authors,$testver);
555
556	my %build;
557	my @pt;
558	my $tmpl = "";
559	my %patches;
560
561	@pt = pb_conf_get_if("vmlist","velist");
562	if (defined $pt[0]->{$ENV{'PBPROJ'}}) {
563	$tmpl .= $pt[0]->{$ENV{'PBPROJ'}};
564	}
565	if (defined $pt[1]->{$ENV{'PBPROJ'}}) {
566	# the 2 lists need to be grouped with a ',' separated them
567	if ($tmpl ne "") {
568	$tmpl .= ",";
569	}
570	$tmpl .= $pt[1]->{$ENV{'PBPROJ'}}
571	}
572
573	# Setup %pb structure to allow filtering later on, on files using that structure
574	$pb{'tag'} = $pbtag;
575	$pb{'rev'} = $pbrev;
576	$pb{'ver'} = $pbver;
577	$pb{'pkg'} = $pbpkg;
578	$pb{'date'} = $pbdate;
579	$pb{'defpkgdir'} = $defpkgdir;
580	$pb{'extpkgdir'} = $extpkgdir;
581	$pb{'chglog'} = $chglog;
582	$pb{'packager'} = $ENV{'PBPACKAGER'};
583	$pb{'proj'} = $ENV{'PBPROJ'};
584	$pb{'repo'} = $ENV{'PBREPO'};
585	$pb{'patches'} = \%patches;
586	pb_log(2,"DEBUG: pb: ".Dumper(%pb)."\n");
587
588	# Do not do that for website
589	if ((not defined $param) \|\| ($param ne "Web")) {
590	my %virt;
591	# De-duplicate similar VM and VE
592	foreach my $d (split(/,/,$tmpl)) {
593	$virt{$d} = $d;
594	}
595
596	foreach my $d (keys %virt) {
597	my ($name,$ver,$arch) = split(/-/,$d);
598	chomp($arch);
599	my ($ddir, $dver, $dfam);
600	($ddir, $dver, $dfam, $pb{'dtype'}, $pb{'suf'}, $pb{'upd'}) = pb_distro_init($name,$ver);
601	pb_log(2,"DEBUG: distro tuple: ".Dumper($ddir, $dver, $dfam, $pb{'dtype'}, $pb{'suf'})."\n");
602	pb_log(2,"DEBUG Filtering PBDATE => $pbdate, PBTAG => $pbtag, PBVER => $pbver\n");
603
604	# We need to compute the real name of the package
605	my $pbrealpkg = pb_cms_get_real_pkg($pbpkg,$pb{'dtype'});
606	$pb{'realpkg'} = $pbrealpkg;
607	pb_log(1,"Virtual package $pbpkg has a real package name of $pbrealpkg on $ddir-$dver\n") if ($pbrealpkg ne $pbpkg);
608
609	# Filter build files from the less precise up to the most with overloading
610	# Filter all files found, keeping the name, and generating in dest
611
612	# Find all build files first relatively to PBROOTDIR
613	# Find also all specific files referenced in the .pb conf file
614	my %bfiles = ();
615	my %pkgfiles = ();
616	$build{"$ddir-$dver-$arch"} = "yes";
617
618	if (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pb{'dtype'}") {
619	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pb{'dtype'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
620	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$dfam") {
621	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$dfam",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
622	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir") {
623	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
624	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver") {
625	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
626	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver-$arch") {
627	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver-$arch",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
628	} else {
629	$build{"$ddir-$dver-$arch"} = "no";
630	next;
631	}
632	pb_log(2,"DEBUG bfiles: ".Dumper(\%bfiles)."\n");
633
634	# Get all filters to apply
635	my $ptr = pb_get_filters($pbpkg, $pb{'dtype'}, $dfam, $ddir, $dver);
636
637	# Prepare local patches for this distro - They are always applied first - May be a problem one day
638	foreach my $p (sort(<$ENV{'PBROOTDIR'}/$pbpkg/pbpatch/*>)) {
639	$patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.all$/));
640	$patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.all$/);
641	$patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$pb{'dtype'}$/));
642	$patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$pb{'dtype'}$/);
643	$patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$dfam$/));
644	$patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$dfam$/);
645	$patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir$/));
646	$patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir$/);
647	$patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir-$dver$/));
648	$patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir-$dver$/);
649	$patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir-$dver-$arch$/));
650	$patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir-$dver-$arch$/);
651	}
652
653	# Prepare also remote patches to be included - Applied after the local ones
654	foreach my $p ("all","$pb{'dtype'}","$dfam","$ddir","$ddir-$dver","$ddir-$dver-$arch") {
655	my $f = "$ENV{'PBROOTDIR'}/$pbpkg/pbextpatch.$p";
656	next if (not -f $f);
657	if (not open(PATCH,$f)) {
658	pb_display("Unable to open existing external patch file content $f\n");
659	next;
660	}
661	while (<PATCH>) {
662	chomp();
663	$patches{"$ddir-$dver-$arch"} .= "," if (defined $patches{"$ddir-$dver-$arch"});
664	$patches{"$ddir-$dver-$arch"} .= "$_";
665	}
666	close(PATCH);
667	}
668	pb_log(2,"DEBUG: pb->patches: ".Dumper($pb{'patches'})."\n");
669
670	# Apply now all the filters on all the files concerned
671	# destination dir depends on the type of file
672	if (defined $ptr) {
673	# For patch support
674	$pb{'tuple'} = "$ddir-$dver-$arch";
675	foreach my $f (values %bfiles,values %pkgfiles) {
676	pb_filter_file("$ENV{'PBROOTDIR'}/$f",$ptr,"$dest/pbconf/$ddir-$dver-$arch/".basename($f),\%pb);
677	}
678	}
679	}
680	my @found;
681	my @notfound;
682	foreach my $b (keys %build) {
683	push @found,$b if ($build{$b} =~ /yes/);
684	push @notfound,$b if ($build{$b} =~ /no/);
685	}
686	pb_log(0,"Build files generated for ".join(',',sort(@found))."\n");
687	pb_log(0,"No Build files found for ".join(',',sort(@notfound))."\n") if (@notfound);
688	pb_log(2,"DEBUG: patches: ".Dumper(%patches)."\n");
689	}
690
691	# Get the generic filter (all.pbf) and
692	# apply those to the non-build files including those
693	# generated by pbinit if applicable
694
695	# Get only all.pbf filter
696	my $ptr = pb_get_filters($pbpkg);
697
698	my $liste ="";
699	if (defined $filteredfiles->{$pbpkg}) {
700	foreach my $f (split(/,/,$filteredfiles->{$pbpkg})) {
701	pb_filter_file_inplace($ptr,"$dest/$f",\%pb);
702	$liste = "$f $liste";
703	}
704	}
705	pb_log(2,"Files ".$liste."have been filtered\n");
706
707	# Do not do that for website
708	if ((not defined $param) \|\| ($param ne "Web")) {
709	my %tmp;
710	# Filter potential patches (local + remote)
711	pb_log(0,"Delivering and compressing patches ");
712	foreach my $v (keys %patches) {
713	pb_mkdir_p("$dest/pbconf/$v/pbpatch");
714	foreach my $pf (split(/,/,$patches{$v})) {
715	my $pp = basename($pf);
716	pb_cms_export($pf,undef,"$dest/pbconf/$v/pbpatch");
717	pb_filter_file_inplace($ptr,"$dest/pbconf/$v/pbpatch/$pp",\%pb);
718	pb_system("gzip -9f $dest/pbconf/$v/pbpatch/$pp","","quiet");
719	$tmp{$pf} = "";
720	}
721	}
722	foreach my $v (keys %tmp) {
723	pb_log(0,"$v ");
724	}
725	pb_log(0,"\n");
726	} else {
727	# Instead call News generation
728	pb_web_news2html($dest);
729	# And create an empty pbconf
730	pb_mkdir_p("$dest/pbconf");
731	# And prepare the pbscript to execute remotely
732	open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
733	print SCRIPT "#!/bin/bash\n";
734	print SCRIPT "#set -x\n";
735	print SCRIPT "echo ... Extracting Website content\n";
736	print SCRIPT "find . -type f \| grep -Ev '^./$pbpkg-$pbver.tar.gz\|^./pbscript' \| xargs rm -f non-existent\n";
737	print SCRIPT "find * -type d -depth \| xargs rmdir 2> /dev/null \n";
738	print SCRIPT "tar xfz $pbpkg-$pbver.tar.gz\n";
739	print SCRIPT "mv $pbpkg-$pbver/* .\n";
740	print SCRIPT "rm -f $pbpkg-$pbver.tar.gz\n";
741	print SCRIPT "rmdir $pbpkg-$pbver\n";
742	close(SCRIPT);
743	}
744
745	# Prepare the dest directory for archive
746	if (-x "$ENV{'PBROOTDIR'}/$pbpkg/pbinit") {
747	pb_filter_file("$ENV{'PBROOTDIR'}/$pbpkg/pbinit",$ptr,"$ENV{'PBTMP'}/pbinit",\%pb);
748	chmod 0755,"$ENV{'PBTMP'}/pbinit";
749	pb_system("cd $dest ; $ENV{'PBTMP'}/pbinit","Executing init script from $ENV{'PBROOTDIR'}/$pbpkg/pbinit","verbose");
750	}
751
752	# Do we have additional script to run to prepare the environement for the project ?
753	# Then include it in the pbconf delivery
754	foreach my $pbvf ("pbvebuild.pre","pbvmbuild.pre","pbvebuild.post","pbvmbuild.post") {
755	if (-x "$ENV{'PBROOTDIR'}/$pbvf") {
756	pb_filter_file("$ENV{'PBROOTDIR'}/$pbvf",$ptr,"$ENV{'PBDESTDIR'}/$pbvf",\%pb);
757	chmod 0755,"$ENV{'PBDESTDIR'}/$pbvf";
758	}
759	}
760
761	# Archive dest dir
762	chdir "$ENV{'PBDESTDIR'}" \|\| die "Unable to change dir to $ENV{'PBDESTDIR'}";
763	if (defined $preserve) {
764	# In that case we want to preserve the original tar file for checksum purposes
765	# The one created is btw equivalent in that case to this one
766	# Maybe check basename of both to be sure they are the same ?
767	pb_log(0,"Preserving original tar file ");
768	move("$preserve","$pbpkg-$pbver.tar.gz");
769	} else {
770	# Possibility to look at PBSRC to guess more the filename
771	pb_system("tar cfz $pbpkg-$pbver.tar.gz --exclude=$pbpkg-$pbver/pbconf $pbpkg-$pbver","Creating $pbpkg tar files compressed");
772	}
773	pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz\n");
774	pb_system("tar cfz $pbpkg-$pbver.pbconf.tar.gz $pbpkg-$pbver/pbconf","Creating pbconf tar files compressed");
775	pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz\n");
776
777	# Keep track of version-tag per pkg
778	$pkgs{$pbpkg} = "$pbver-$pbtag";
779
780	# Final cleanup
781	pb_rm_rf($dest) if (-d $dest);
782	}
783
784	# Keep track of per package version
785	pb_log(2,"DEBUG pkgs: ".Dumper(%pkgs)."\n");
786	open(PKG,"> $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb") \|\| die "Unable to create $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb";
787	foreach my $pbpkg (keys %pkgs) {
788	print PKG "pbpkg $pbpkg = $pkgs{$pbpkg}\n";
789	}
790	close(PKG);
791
792	# Keep track of what is generated by default
793	# We need to store the dir and info on version-tag
794	# Base our content on the existing .pb file
795	copy("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb","$ENV{'PBDESTDIR'}/pbrc");
796	open(LAST,">> $ENV{'PBDESTDIR'}/pbrc") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbrc";
797	print LAST "pbroot $ENV{'PBPROJ'} = $ENV{'PBROOTDIR'}\n";
798	print LAST "projver $ENV{'PBPROJ'} = $ENV{'PBPROJVER'}\n";
799	print LAST "projtag $ENV{'PBPROJ'} = $ENV{'PBPROJTAG'}\n";
800	print LAST "pbpackager $ENV{'PBPROJ'} = $ENV{'PBPACKAGER'}\n";
801	close(LAST);
802	}
803
804	sub pb_build2pkg {
805
806	# Get the running distro to build on
807	my ($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd) = pb_distro_init();
808	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd))."\n");
809
810	# Get list of packages to build
811	# Get content saved in cms2build
812	my $ptr = pb_get_pkg();
813	@pkgs = @$ptr;
814
815	my $arch = pb_get_arch();
816
817	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
818	$pkg = { } if (not defined $pkg);
819
820	chdir "$ENV{'PBBUILDDIR'}";
821	my $made = ""; # pkgs made during build
822	foreach my $pbpkg (@pkgs) {
823	my $vertag = $pkg->{$pbpkg};
824	# get the version of the current package - maybe different
825	($pbver,$pbtag) = split(/-/,$vertag);
826
827	my $src="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz";
828	my $src2="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
829	pb_log(2,"Source file: $src\n");
830	pb_log(2,"Pbconf file: $src2\n");
831
832	pb_log(2,"Working directory: $ENV{'PBBUILDDIR'}\n");
833	if ($dtype eq "rpm") {
834	foreach my $d ('RPMS','SRPMS','SPECS','SOURCES','BUILD') {
835	if (! -d "$ENV{'PBBUILDDIR'}/$d") {
836	pb_mkdir_p("$ENV{'PBBUILDDIR'}/$d") \|\| die "Please ensure that you can write into $ENV{'PBBUILDDIR'} to create $d\nchown the $ENV{'PBBUILDDIR'} directory to your uid";
837	}
838	}
839
840	# Remove in case a previous link/file was there
841	unlink "$ENV{'PBBUILDDIR'}/SOURCES/".basename($src);
842	symlink "$src","$ENV{'PBBUILDDIR'}/SOURCES/".basename($src) \|\| die "Unable to symlink $src in $ENV{'PBBUILDDIR'}/SOURCES";
843	# We need to first extract the spec file
844	my @specfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/","$ENV{'PBBUILDDIR'}/SPECS","spec");
845
846	# We need to handle potential patches to upstream sources
847	pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/pbpatch/","$ENV{'PBBUILDDIR'}/SOURCES","patch");
848
849	pb_log(2,"specfile: ".Dumper(\@specfile)."\n");
850	# set LANGUAGE to check for correct log messages
851	$ENV{'LANGUAGE'}="C";
852	# Older Redhat use _target_platform in %configure incorrectly
853	my $specialdef = "";
854	if (($ddir eq "redhat") \|\| (($ddir eq "rhel") && ($dver eq "2.1"))) {
855	$specialdef = "--define \'_target_platform \"\"\'";
856	}
857
858	# If needed we may add repository to the build env
859	my $darch = pb_get_arch();
860	pb_distro_setuprepo($ddir,$dver,$darch,$dtype);
861	foreach my $f (@specfile) {
862	if ($f =~ /\.spec$/) {
863	pb_distro_installdeps("$f",$dtype,$pbupd);
864	pb_system("rpmbuild $specialdef --define \'packager $ENV{'PBPACKAGER'}\' --define \"_topdir $ENV{'PBBUILDDIR'}\" -ba $f","Building package with $f under $ENV{'PBBUILDDIR'}","verbose");
865	last;
866	}
867	}
868	# Get the name of the generated packages
869	open(LOG,"$ENV{'PBTMP'}/system.log") \|\| die "Unable to open $ENV{'PBTMP'}/system.log";
870	while (<LOG>) {
871	chomp($_);
872	next if ($_ !~ /^Wrote:/);
873	s\|./([S]RPMS.*)\|$1\|;
874	$made .=" $_";
875	}
876	close(LOG);
877
878	} elsif ($dtype eq "deb") {
879	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
880	pb_system("tar xfz $src","Extracting sources");
881	pb_system("tar xfz $src2","Extracting pbconf");
882
883	chdir "$pbpkg-$pbver" \|\| die "Unable to chdir to $pbpkg-$pbver";
884	pb_rm_rf("debian");
885	symlink "pbconf/$ddir-$dver-$arch","debian" \|\| die "Unable to symlink to pbconf/$ddir-$dver-$arch";
886	chmod 0755,"debian/rules";
887
888	my $darch = pb_get_arch();
889	pb_distro_setuprepo($ddir,$dver,$darch,$dtype);
890	pb_distro_installdeps("debian/control",$dtype,$pbupd);
891	pb_system("dpkg-buildpackage -us -uc -rfakeroot","Building package","verbose");
892	# Get the name of the generated packages
893	open(LOG,"$ENV{'PBTMP'}/system.log") \|\| die "Unable to open $ENV{'PBTMP'}/system.log";
894	while (<LOG>) {
895	chomp();
896	my $tmp = $_;
897	next if ($tmp !~ /^dpkg-deb.*:/);
898	$tmp =~ s\|.../(.)_(.).deb.\|$1\|;
899	$made="$made $tmp.dsc $tmp.tar.gz $tmp"."_.deb $tmp"."_.changes";
900	}
901	close(LOG);
902	} elsif ($dtype eq "ebuild") {
903	my @ebuildfile;
904	# For gentoo we need to take pb as subsystem name
905	# We put every apps here under sys-apps. hope it's correct
906	# We use pb's home dir in order to have a single OVERLAY line
907	my $tmpd = "$ENV{'HOME'}/portage/pb/sys-apps/$pbpkg";
908	pb_mkdir_p($tmpd) if (! -d "$tmpd");
909	pb_mkdir_p("$ENV{'HOME'}/portage/distfiles") if (! -d "$ENV{'HOME'}/portage/distfiles");
910
911	# We need to first extract the ebuild file
912	@ebuildfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/","$tmpd","ebuild");
913
914	# Prepare the build env for gentoo
915	my $found = 0;
916	my $pbbd = $ENV{'HOME'};
917	$pbbd =~ s\|/\|\\/\|g;
918	if (-r "/etc/make.conf") {
919	open(MAKE,"/etc/make.conf");
920	while (<MAKE>) {
921	$found = 1 if (/$pbbd\/portage/);
922	}
923	close(MAKE);
924	}
925	if ($found == 0) {
926	pb_system("sudo sh -c 'echo PORTDIR_OVERLAY=\"$ENV{'HOME'}/portage\" >> /etc/make.conf'");
927	}
928	#$found = 0;
929	#if (-r "/etc/portage/package.keywords") {
930	#open(KEYW,"/etc/portage/package.keywords");
931	#while (<KEYW>) {
932	#$found = 1 if (/portage\/pb/);
933	#}
934	#close(KEYW);
935	#}
936	#if ($found == 0) {
937	#pb_system("sudo sh -c \"echo portage/pb >> /etc/portage/package.keywords\"");
938	#}
939
940	# Build
941	foreach my $f (@ebuildfile) {
942	if ($f =~ /\.ebuild$/) {
943	pb_distro_installdeps("$f",$dtype,$pbupd);
944	move($f,"$tmpd/$pbpkg-$pbver.ebuild");
945	pb_system("cd $tmpd ; ebuild $pbpkg-$pbver.ebuild clean ; ebuild $pbpkg-$pbver.ebuild digest ; ebuild $pbpkg-$pbver.ebuild package","verbose");
946	# Now move it where pb expects it
947	pb_mkdir_p("$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
948	move("$tmpd/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
949	}
950	}
951
952	$made="$made portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver.ebuild";
953	} elsif ($dtype eq "tgz") {
954	# Slackware family
955	$made="$made $pbpkg/$pbpkg-$pbver-*-$pbtag.tgz";
956
957	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
958	pb_system("tar xfz $src","Extracting sources");
959	pb_system("tar xfz $src2","Extracting pbconf");
960	chdir "$pbpkg-$pbver" \|\| die "Unable to chdir to $pbpkg-$pbver";
961	symlink "pbconf/$ddir-$dver-$arch","install" \|\| die "Unable to symlink to pbconf/$ddir-$dver-$arch";
962	if (-x "install/pbslack") {
963	pb_distro_installdeps("./install/pbslack",$dtype,$pbupd);
964	pb_system("./install/pbslack","Building package");
965	pb_system("sudo /sbin/makepkg -p -l y -c y $pbpkg","Packaging $pbpkg","verbose");
966	}
967	} else {
968	die "Unknown dtype format $dtype";
969	}
970	}
971	# Packages check if needed
972	if ($dtype eq "rpm") {
973	if (-f "/usr/bin/rpmlint") {
974	pb_system("rpmlint $made","Checking validity of rpms with rpmlint","verbose");
975	} else {
976	pb_log(0,"rpm packages generated: $made\n");
977	}
978	} elsif ($dtype eq "deb") {
979	my $made2 = "";
980	if (-f "/usr/bin/lintian") {
981	foreach my $f (split(/ /,$made)) {
982	$made2 .= "../$f " if ($f =~ /\.changes$/);
983	}
984	pb_system("lintian $made2","Checking validity of debs with lintian","verbose");
985	} else {
986	pb_log(0,"deb packages generated: $made2\n");
987	}
988	} else {
989	pb_log(0,"No check done for $dtype yet\n");
990	pb_log(0,"Packages generated: $made\n");
991	}
992
993	# Keep track of what is generated so that we can get them back from VMs
994	open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to create $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
995	print KEEP "$made\n";
996	close(KEEP);
997	}
998
999	sub pb_build2ssh {
1000	pb_send2target("Sources");
1001	}
1002
1003	sub pb_pkg2ssh {
1004	pb_send2target("Packages");
1005	}
1006
1007	# By default deliver to the the public site hosting the
1008	# ftp structure (or whatever) or a VM/VE
1009	sub pb_send2target {
1010
1011	my $cmt = shift;
1012	my $v = shift \|\| undef;
1013	my $vmexist = shift \|\| 0; # 0 is FALSE
1014	my $vmpid = shift \|\| 0; # 0 is FALSE
1015
1016	pb_log(2,"DEBUG: pb_send2target($cmt,".Dumper($v).",$vmexist,$vmpid)\n");
1017	my $host = "sshhost";
1018	my $login = "sshlogin";
1019	my $dir = "sshdir";
1020	my $port = "sshport";
1021	my $conf = "sshconf";
1022	my $rebuild = "sshrebuild";
1023	my $tmout = "vmtmout";
1024	my $path = "vmpath";
1025	if (($cmt eq "vm") \|\| ($cmt eq "VMScript")) {
1026	$login = "vmlogin";
1027	$dir = "pbdefdir";
1028	$tmout = "vmtmout";
1029	$rebuild = "vmrebuild";
1030	# Specific VM
1031	$host = "vmhost";
1032	$port = "vmport";
1033	} elsif (($cmt eq "ve")\|\| ($cmt eq "VEScript")) {
1034	$login = "velogin";
1035	$dir = "pbdefdir";
1036	# Specific VE
1037	$path = "vepath";
1038	$conf = "veconf";
1039	$rebuild = "verebuild";
1040	} elsif ($cmt eq "Web") {
1041	$host = "websshhost";
1042	$login = "websshlogin";
1043	$dir = "websshdir";
1044	$port = "websshport";
1045	}
1046	my $cmd = "";
1047	my $src = "";
1048	my ($odir,$over,$oarch) = (undef, undef, undef);
1049	my ($ddir, $dver, $dfam, $dtype, $pbsuf);
1050
1051	if ($cmt ne "Announce") {
1052	my $ptr = pb_get_pkg();
1053	@pkgs = @$ptr;
1054
1055	# Get the running distro to consider
1056	if (defined $v) {
1057	($odir,$over,$oarch) = split(/-/,$v);
1058	}
1059	($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($odir,$over);
1060	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n");
1061
1062	# Get list of packages to build
1063	# Get content saved in cms2build
1064	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1065	$pkg = { } if (not defined $pkg);
1066
1067	chdir "$ENV{'PBBUILDDIR'}";
1068	foreach my $pbpkg (@pkgs) {
1069	my $vertag = $pkg->{$pbpkg};
1070	# get the version of the current package - maybe different
1071	($pbver,$pbtag) = split(/-/,$vertag);
1072
1073	if (($cmt eq "Sources") \|\| ($cmt eq "vm") \|\| ($cmt eq "ve")) {
1074	$src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
1075	if ($cmd eq "") {
1076	$cmd = "ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
1077	} else {
1078	$cmd = "$cmd ; ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
1079	}
1080	} elsif ($cmt eq "Web") {
1081	$src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz"
1082	}
1083	}
1084	# Adds conf file for availability of conf elements
1085	pb_conf_add("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb");
1086	}
1087
1088	if (($cmt eq "vm") \|\| ($cmt eq "ve")) {
1089	$src="$src $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc $ENV{'PBDESTDIR'}/pbscript";
1090	} elsif (($cmt =~ /V[EM]Script/) \|\| ($cmt eq "Web")) {
1091	$src="$src $ENV{'PBDESTDIR'}/pbscript";
1092	} elsif ($cmt eq "Announce") {
1093	$src="$src $ENV{'PBTMP'}/pbscript";
1094	} elsif ($cmt eq "Packages") {
1095	# Get package list from file made during build2pkg
1096	open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1097	$src = <KEEP>;
1098	chomp($src);
1099	close(KEEP);
1100	$src="$src $ENV{'PBBUILDDIR'}/pbscript";
1101	}
1102	# Remove potential leading spaces (cause problem with basename)
1103	$src =~ s/^ *//;
1104	my $basesrc = "";
1105	foreach my $i (split(/ +/,$src)) {
1106	$basesrc .= " ".basename($i);
1107	}
1108
1109	pb_log(0,"Sources handled ($cmt): $src\n");
1110	pb_log(2,"values: ".Dumper(($host,$login,$dir,$port,$tmout,$rebuild,$path,$conf))."\n");
1111	my ($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vepath) = pb_conf_get($host,$login,$dir,$port,$tmout,$path);
1112	# Not mandatory
1113	my ($vrebuild,$veconf,$testver) = pb_conf_get_if($rebuild,$conf,"testver");
1114	pb_log(2,"ssh: ".Dumper(($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vrebuild,$vepath,$veconf))."\n");
1115
1116	my $mac;
1117	if (($cmt ne "ve") && ($cmt ne "VEScript")) {
1118	$mac = "$sshlogin->{$ENV{'PBPROJ'}}\@$sshhost->{$ENV{'PBPROJ'}}";
1119	# Overwrite account value if passed as parameter
1120	$mac = "$pbaccount\@$sshhost->{$ENV{'PBPROJ'}}" if (defined $pbaccount);
1121	pb_log(2, "DEBUG: pbaccount: $pbaccount => mac: $mac\n") if (defined $pbaccount);
1122	} else {
1123	# VE
1124	# Overwrite account value if passed as parameter (typically for setup_ve)
1125	$mac = $sshlogin->{$ENV{'PBPROJ'}};
1126	$mac = $pbaccount if (defined $pbaccount);
1127	}
1128
1129	my $tdir;
1130	my $bdir;
1131	if (($cmt eq "Sources") \|\| ($cmt =~ /V[EM]Script/)) {
1132	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/src";
1133	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1134	# This is a test pkg => target dir is under test
1135	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/test/src";
1136	}
1137	} elsif (($cmt eq "vm") \|\| ($cmt eq "ve")) {
1138	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/delivery";
1139	$bdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/build";
1140	# Remove a potential $ENV{'HOME'} as bdir should be relative to pb's home
1141	$bdir =~ s\|\$ENV.+\}/\|\|;
1142	} elsif ($cmt eq "Announce") {
1143	$tdir = "$sshdir->{$ENV{'PBPROJ'}}";
1144	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1145	# This is a test pkg => target dir is under test
1146	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/test";
1147	}
1148	} elsif ($cmt eq "Web") {
1149	$tdir = "$sshdir->{$ENV{'PBPROJ'}}";
1150	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1151	# This is a test website => target dir is under test
1152	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/../test";
1153	}
1154	} elsif ($cmt eq "Packages") {
1155	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ddir/$dver";
1156
1157	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1158	# This is a test pkg => target dir is under test
1159	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/test/$ddir/$dver";
1160	}
1161
1162	my $repodir = $tdir;
1163	$repodir =~ s\|^$sshdir->{$ENV{'PBPROJ'}}/\|\|;
1164
1165	my ($pbrepo) = pb_conf_get("pbrepo");
1166
1167	# Repository management
1168	open(PBS,"> $ENV{'PBBUILDDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBBUILDDIR'}/pbscript";
1169	if ($dtype eq "rpm") {
1170	# Also make a pbscript to generate yum/urpmi bases
1171	print PBS << "EOF";
1172	#!/bin/bash
1173	# Prepare a script to ease yum setup
1174	cat > $ENV{'PBPROJ'}.repo << EOT
1175	[$ENV{'PBPROJ'}]
1176	name=$ddir $dver - $ENV{'PBPROJ'} Vanilla Packages
1177	baseurl=$pbrepo->{$ENV{'PBPROJ'}}/$repodir
1178	enabled=1
1179	gpgcheck=0
1180	EOT
1181	chmod 644 $ENV{'PBPROJ'}.repo
1182
1183	# Clean up old repo content
1184	rm -rf headers/ repodata/
1185	# Create yum repo
1186	yum-arch .
1187	# Create repodata
1188	createrepo .
1189	EOF
1190	if ($dfam eq "md") {
1191	# For Mandriva add urpmi management
1192	print PBS << "EOF";
1193	# Prepare a script to ease urpmi setup
1194	cat > $ENV{'PBPROJ'}.addmedia << EOT
1195	urpmi.addmedia $ENV{'PBPROJ'} $pbrepo->{$ENV{'PBPROJ'}}/$repodir with hdlist.cz
1196	EOT
1197	chmod 755 $ENV{'PBPROJ'}.addmedia
1198
1199	# Clean up old repo content
1200	rm -f hdlist.cz synthesis.hdlist.cz
1201	# Create urpmi repo
1202	genhdlist .
1203	EOF
1204	}
1205	if ($ddir eq "fedora") {
1206	# Extract the spec file to please Fedora maintainers :-(
1207	print PBS << "EOF";
1208	for p in $basesrc; do
1209	echo \$p \| grep -q 'src.rpm'
1210	if [ \$\? -eq 0 ]; then
1211	rpm2cpio \$p \| cpio -ivdum --quiet '*.spec'
1212	fi
1213	done
1214	EOF
1215	}
1216	} elsif ($dtype eq "deb") {
1217	# Also make a pbscript to generate apt bases
1218	# Cf: http://www.debian.org/doc/manuals/repository-howto/repository-howto.fr.html
1219	my $rpd = dirname("$pbrepo->{$ENV{'PBPROJ'}}/$repodir");
1220	print PBS << "EOF";
1221	#!/bin/bash
1222	# Prepare a script to ease apt setup
1223	cat > $ENV{'PBPROJ'}.sources.list << EOT
1224	deb $rpd $dver contrib
1225	deb-src $rpd $dver contrib
1226	EOT
1227	chmod 644 $ENV{'PBPROJ'}.sources.list
1228
1229	# Prepare a script to create apt info file
1230	(cd .. ; for a in i386 amd64 ia64; do mkdir -p dists/$dver/contrib/binary-\$a; dpkg-scanpackages -a\$a $dver /dev/null \| gzip -c9 > dists/$dver/contrib/binary-\$a/Packages.gz; done; mkdir -p dists/$dver/contrib/source; dpkg-scansources $dver /dev/null \| gzip -c9 > dists/$dver/contrib/source/Sources.gz)
1231	#(cd .. ; rm -f dists/$dver/Release ; apt-ftparchive release dists/$dver > dists/$dver/Release; gpg --sign -ba -o dists/$dver/Release.gpg dists/$dver/Release)
1232	EOF
1233	} elsif ($dtype eq "ebuild") {
1234	# make a pbscript to generate links to latest version
1235	print PBS << "EOF";
1236	#!/bin/bash
1237	# Prepare a script to create correct links
1238	for p in $src; do
1239	echo \$p \| grep -q '.ebuild'
1240	if [ \$\? -eq 0 ]; then
1241	j=`basename \$p`
1242	pp=`echo \$j \| cut -d'-' -f1`
1243	ln -sf \$j \$pp.ebuild
1244	fi
1245	done
1246	EOF
1247	}
1248	close(PBS);
1249	chmod 0755,"$ENV{'PBBUILDDIR'}/pbscript";
1250	} else {
1251	return;
1252	}
1253
1254	# Useless for VE
1255	my $nport;
1256	if (($cmt ne "ve") && ($cmt ne "VEScript")) {
1257	$nport = $sshport->{$ENV{'PBPROJ'}};
1258	$nport = "$pbport" if (defined $pbport);
1259	}
1260
1261	# Remove a potential $ENV{'HOME'} as tdir should be relative to pb's home
1262	$tdir =~ s\|\$ENV.+\}/\|\|;
1263
1264	my $tm = $vtmout->{$ENV{'PBPROJ'}};
1265
1266	# ssh communication if not VE
1267	# should use a hash instead...
1268	my ($shcmd,$cpcmd,$cptarget,$cp2target);
1269	if (($cmt ne "ve") && ($cmt ne "VEScript")) {
1270	my $keyfile = pb_ssh_get(0);
1271	$shcmd = "ssh -i $keyfile -q -o UserKnownHostsFile=/dev/null -p $nport $mac";
1272	$cpcmd = "scp -i $keyfile -p -o UserKnownHostsFile=/dev/null -P $nport";
1273	$cptarget = "$mac:$tdir";
1274	if ($cmt eq "vm") {
1275	$cp2target = "$mac:$bdir";
1276	}
1277	} else {
1278	my $tp = $vepath->{$ENV{'PBPROJ'}};
1279	($odir,$over,$oarch) = split(/-/,$v);
1280	my $tpdir = "$tp/$odir/$over/$oarch";
1281	my ($ptr) = pb_conf_get("vetype");
1282	my $vetype = $ptr->{$ENV{'PBPROJ'}};
1283	if ($vetype eq "chroot") {
1284	$shcmd = "sudo chroot $tpdir /bin/su - $mac -c ";
1285	$cpcmd = "sudo cp -r ";
1286	} elsif ($vetype eq "schroot") {
1287	$shcmd = "schroot $tp -u $mac -- ";
1288	$cpcmd = "sudo cp -r ";
1289	}
1290	# We need to get the home dir of the target account to deliver in the right place
1291	open(PASS,"$tpdir/etc/passwd") \|\| die "Unable to open $tpdir/etc/passwd";
1292	my $homedir = "";
1293	while (<PASS>) {
1294	my ($c1,$c2,$c3,$c4,$c5,$c6,$c7) = split(/:/);
1295	$homedir = $c6 if ($c1 =~ /^$mac$/);
1296	pb_log(3,"Homedir: $homedir - account: $c6\n");
1297	}
1298	close(PASS);
1299	$cptarget = "$tpdir/$homedir/$tdir";
1300	if ($cmt eq "ve") {
1301	$cp2target = "$tpdir/$homedir/$bdir";
1302	}
1303	pb_log(2,"On VE using $cptarget as target dir to copy to\n");
1304	}
1305
1306	my $logres = "";
1307	# Do not touch when just announcing
1308	if ($cmt ne "Announce") {
1309	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");
1310	} else {
1311	$logres = "> ";
1312	}
1313	pb_system("cd $ENV{'PBBUILDDIR'} ; $cpcmd $src $cptarget 2> /dev/null","$cmt delivery in $cptarget");
1314
1315	# For VE we need to change the owner manually
1316	if ($cmt eq "ve") {
1317	pb_system("$shcmd \"sudo chown -R $mac $tdir\"","Adapt owner in $tdir to $mac");
1318	}
1319
1320	pb_system("$shcmd \"echo \'cd $tdir ; if [ -f pbscript ]; then ./pbscript; fi ; rm -f ./pbscript\' \| bash\"","Executing pbscript on $cptarget if needed","verbose");
1321	if (($cmt eq "vm") \|\| ($cmt eq "ve")) {
1322	# Get back info on pkg produced, compute their name and get them from the VM
1323	pb_system("$cpcmd $cp2target/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'} $ENV{'PBBUILDDIR'} 2> /dev/null","Get package names in $cp2target");
1324	# For VE we need to change the owner manually
1325	if ($cmt eq "ve") {
1326	pb_system("sudo chown $UID $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}","Adapt owner in $tdir to $UID");
1327	}
1328	open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1329	my $src = <KEEP>;
1330	chomp($src);
1331	close(KEEP);
1332	$src =~ s/^ *//;
1333	pb_mkdir_p("$ENV{'PBBUILDDIR'}/$odir/$over");
1334	# Change pgben to make the next send2target happy
1335	my $made = "";
1336	open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to write $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1337	foreach my $p (split(/ +/,$src)) {
1338	my $j = basename($p);
1339	pb_system("$cpcmd $cp2target/\'$p\' $ENV{'PBBUILDDIR'}/$odir/$over 2> /dev/null","Package recovery of $j in $cp2target");
1340	$made="$made $odir/$over/$j"; # if (($dtype ne "rpm") \|\| ($j !~ /.src.rpm$/));
1341	}
1342	print KEEP "$made\n";
1343	close(KEEP);
1344	pb_system("$shcmd \"rm -rf $tdir $bdir\"","$cmt cleanup");
1345
1346	# Sign packages locally
1347	if ($dtype eq "rpm") {
1348	#pb_system("rpm --addsign --define \'_signature gpg\' --define \'__gpg_sign_cmd /usr/bin/gpg --batch --no-verbose --no-armor --no-secmem-warning -u \"$ENV{'PBPACKAGER'}\" -sbo %{__signature_filename} %{__plaintext_filename} --use-agent\' $made","Signing RPM packages packages");
1349	} elsif ($dtype eq "deb") {
1350	#pb_system("debsign $made","Signing DEB packages");
1351	} else {
1352	pb_log(0,"I don't know yet how to sign packages for type $dtype. Please give feedback to dev team");
1353	}
1354
1355	# We want to send them to the ssh account so overwrite what has been done before
1356	undef $pbaccount;
1357	pb_log(2,"Before sending pkgs, vmexist: $vmexist, vmpid: $vmpid\n");
1358	pb_send2target("Packages",$odir."-".$over."-".$oarch,$vmexist,$vmpid);
1359	pb_rm_rf("$ENV{'PBBUILDDIR'}/$odir");
1360	}
1361	pb_log(2,"Before halt, vmexist: $vmexist, vmpid: $vmpid\n");
1362	if ((! $vmexist) && (($cmt eq "vm") \|\| ($cmt eq "VMScript"))) {
1363	pb_system("$shcmd \"sudo /sbin/halt -p \"; sleep $tm ; echo \'if [ -d /proc/$vmpid ]; then kill -9 $vmpid; fi \' \| bash ; sleep 10","VM $v halt (pid $vmpid)");
1364	}
1365	}
1366
1367	sub pb_script2v {
1368	my $pbscript=shift;
1369	my $vtype=shift;
1370	my $force=shift \|\| 0; # Force stop of VM. Default not
1371	my $vm1=shift \|\| undef; # Only that VM to treat
1372	my $vm;
1373	my $all;
1374
1375	pb_log(2,"DEBUG: pb_script2v($pbscript,$vtype,$force)\n");
1376	# Prepare the script to be executed on the VM
1377	# in $ENV{'PBDESTDIR'}/pbscript
1378	if ((defined $pbscript ) && ($pbscript ne "$ENV{'PBDESTDIR'}/pbscript")) {
1379	copy($pbscript,"$ENV{'PBDESTDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
1380	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
1381	}
1382
1383	if (not defined $vm1) {
1384	($vm,$all) = pb_get_v($vtype);
1385	} else {
1386	@$vm = ($vm1);
1387	}
1388	my ($vmexist,$vmpid) = (undef,undef);
1389
1390	foreach my $v (@$vm) {
1391	# Launch the VM/VE
1392	if ($vtype eq "vm") {
1393	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1394	pb_log(2,"DEBUG: After pb_launchv, vmexist: $vmexist, vmpid: $vmpid\n");
1395
1396	# Skip that VM if something went wrong
1397	next if (($vmpid == 0) && ($vmexist == 0));
1398
1399	# If force stopping the VM then reset vmexist
1400	if ($force == 1) {
1401	$vmpid = $vmexist;
1402	$vmexist = 0;
1403	}
1404	} else {
1405	#VE
1406	$vmexist = 0;
1407	$vmpid = 0;
1408	}
1409
1410	# Gather all required files to send them to the VM
1411	# and launch the build through pbscript
1412	pb_log(2,"DEBUG: Before send2target, vmexist: $vmexist, vmpid: $vmpid\n");
1413	pb_send2target(uc($vtype)."Script","$v",$vmexist,$vmpid);
1414
1415	}
1416	}
1417
1418	sub pb_launchv {
1419	my $vtype = shift;
1420	my $v = shift;
1421	my $create = shift \|\| 0; # By default do not create a VM
1422
1423	pb_log(2,"DEBUG: pb_launchv($vtype,$v,$create)\n");
1424	die "No VM/VE defined, unable to launch" if (not defined $v);
1425	# Keep only the first VM in case many were given
1426	$v =~ s/,.*//;
1427
1428	my $arch = pb_get_arch();
1429
1430	# Launch the VMs/VEs
1431	if ($vtype eq "vm") {
1432	die "-i iso parameter needed" if (((not defined $iso) \|\| ($iso eq "")) && ($create != 0));
1433
1434	my ($ptr,$vmopt,$vmpath,$vmport,$vmtmout,$vmsize) = pb_conf_get("vmtype","vmopt","vmpath","vmport","vmtmout","vmsize");
1435
1436	my $vmtype = $ptr->{$ENV{'PBPROJ'}};
1437	if (not defined $ENV{'PBVMOPT'}) {
1438	$ENV{'PBVMOPT'} = "";
1439	}
1440	# Save the current status for later restoration
1441	$ENV{'PBOLDVMOPT'} = $ENV{'PBVMOPT'};
1442	# Set a default timeout of 2 minutes
1443	if (not defined $ENV{'PBVMTMOUT'}) {
1444	$ENV{'PBVMTMOUT'} = "120";
1445	}
1446	if (defined $vmopt->{$v}) {
1447	$ENV{'PBVMOPT'} .= " $vmopt->{$v}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$v}/);
1448	} elsif (defined $vmopt->{$ENV{'PBPROJ'}}) {
1449	$ENV{'PBVMOPT'} .= " $vmopt->{$ENV{'PBPROJ'}}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$ENV{'PBPROJ'}}/);
1450	}
1451	if (defined $vmtmout->{$v}) {
1452	$ENV{'PBVMTMOUT'} = $vmtmout->{$v};
1453	} elsif (defined $vmtmout->{$ENV{'PBPROJ'}}) {
1454	$ENV{'PBVMTMOUT'} = $vmtmout->{$ENV{'PBPROJ'}};
1455	}
1456	my $nport = $vmport->{$ENV{'PBPROJ'}};
1457	$nport = "$pbport" if (defined $pbport);
1458
1459	my $cmd;
1460	my $vmcmd; # has to be used for pb_check_ps
1461	my $vmm; # has to be used for pb_check_ps
1462	if (($vmtype eq "qemu") \|\| ($vmtype eq "kvm")) {
1463	my $qemucmd32;
1464	my $qemucmd64;
1465	if ($arch eq "x86_64") {
1466	$qemucmd32 = "/usr/bin/qemu-system-i386";
1467	$qemucmd64 = "/usr/bin/qemu";
1468	} else {
1469	$qemucmd32 = "/usr/bin/qemu";
1470	$qemucmd64 = "/usr/bin/qemu-system-x86_64";
1471	}
1472	if ($v =~ /x86_64/) {
1473	$vmcmd = "$qemucmd64";
1474	} else {
1475	$vmcmd = "$qemucmd32";
1476	}
1477	if ($vmtype eq "kvm") {
1478	$vmcmd = "/usr/bin/kvm";
1479	}
1480	$vmm = "$vmpath->{$ENV{'PBPROJ'}}/$v.qemu";
1481	if ($create != 0) {
1482	$ENV{'PBVMOPT'} .= " -cdrom $iso -boot d";
1483	}
1484	$cmd = "$vmcmd $ENV{'PBVMOPT'} -redir tcp:$nport:10.0.2.15:22 $vmm"
1485	} elsif ($vmtype eq "xen") {
1486	} elsif ($vmtype eq "vmware") {
1487	} else {
1488	die "VM of type $vmtype not supported. Report to the dev team";
1489	}
1490	# Restore the ENV VAR Value
1491	$ENV{'PBVMOPT'} = $ENV{'PBOLDVMOPT'};
1492
1493	my ($tmpcmd,$void) = split(/ +/,$cmd);
1494	my $vmexist = pb_check_ps($tmpcmd,$vmm);
1495	my $vmpid = 0;
1496	if (! $vmexist) {
1497	if ($create != 0) {
1498	die("Found an existing Virtual machine $vmm. Won't overwrite") if (-r $vmm);
1499	if (($vmtype eq "qemu") \|\| ($vmtype eq "xen") \|\| ($vmtype eq "kvm")) {
1500	pb_system("/usr/bin/qemu-img create -f qcow2 $vmm $vmsize->{$ENV{'PBPROJ'}}","Creating the QEMU VM");
1501	} elsif ($vmtype eq "vmware") {
1502	} else {
1503	}
1504	}
1505	if (! -f "$vmm") {
1506	pb_log(0,"Unable to find VM $vmm\n");
1507	} else {
1508	pb_system("$cmd &","Launching the VM $vmm");
1509	pb_system("sleep $ENV{'PBVMTMOUT'}","Waiting $ENV{'PBVMTMOUT'} s for VM $v to come up");
1510	$vmpid = pb_check_ps($tmpcmd,$vmm);
1511	pb_log(0,"VM $vmm launched (pid $vmpid)\n");
1512	}
1513	} else {
1514	pb_log(0,"Found an existing VM $vmm (pid $vmexist)\n");
1515	}
1516	pb_log(2,"DEBUG: pb_launchv returns ($vmexist,$vmpid)\n");
1517	return($vmexist,$vmpid);
1518	# VE here
1519	} else {
1520	# Get VE context
1521	my ($ptr,$vetmout,$vepath,$verebuild,$veconf,$vepostinstall) = pb_conf_get("vetype","vetmout","vepath","verebuild","veconf");
1522	my ($veb4pi,$vepkglist) = pb_conf_get_if("veb4pi","vepkglist");
1523	my $vetype = $ptr->{$ENV{'PBPROJ'}};
1524
1525	# Get distro context
1526	my ($name,$ver,$darch) = split(/-/,$v);
1527	chomp($darch);
1528	my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($name,$ver);
1529
1530	if (($vetype eq "chroot") \|\| ($vetype eq "schroot")) {
1531	# Architecture consistency
1532	if ($arch ne $darch) {
1533	die "Unable to launch a VE of architecture $darch on a $arch platform" if (($darch eq "x86_64") && ($arch =~ /i?86/));
1534	}
1535
1536	my ($verpmtype) = pb_conf_get("verpmtype");
1537	if (($create != 0) \|\| ($verebuild->{$ENV{'PBPROJ'}} eq "true") \|\| ($force == 1)) {
1538	# We have to rebuild the chroot
1539	if ($dtype eq "rpm") {
1540
1541	my $verpmstyle = pb_distro_get_param($ddir,$dver,$darch,$verpmtype);
1542	if ($verpmstyle eq "rinse") {
1543	# Need to reshape the mirrors generated
1544	my $post = "--before-post-install ";
1545	my $postparam = pb_distro_get_param($ddir,$dver,$darch,$veb4pi);
1546	if ($postparam eq "") {
1547	$post = "";
1548	} else {
1549	$post .= $postparam;
1550	}
1551
1552	# Need to reshape the package list for pb
1553	my $addpkgs;
1554	$postparam = pb_distro_get_param($ddir,$dver,$darch,$vepkglist);
1555	if ($postparam eq "") {
1556	$addpkgs = "";
1557	} else {
1558	my $pkgfile = "$ENV{'PBTMP'}/addpkgs.lis";
1559	open(PKG,"> $pkgfile") \|\| die "Unable to create $pkgfile";
1560	foreach my $p (split(/,/,$postparam)) {
1561	print PKG "$p\n";
1562	}
1563	close(PKG);
1564	$addpkgs = "--add-pkg-list $pkgfile";
1565	}
1566	my $rinseverb = "";
1567	$rinseverb = "--verbose" if ($pbdebug gt 0);
1568
1569	pb_system("sudo /usr/sbin/rinse --directory \"$vepath->{$ENV{'PBPROJ'}}/$ddir/$dver/$darch\" --arch \"$darch\" --distribution \"$ddir-$dver\" --config \"$veconf->{$ENV{'PBPROJ'}}\" $post $addpkgs $rinseverb","Creating the rinse VE for $ddir-$dver ($darch)", "verbose");
1570	} elsif ($verpmstyle eq "mock") {
1571	pb_system("sudo /usr/sbin/mock --init --resultdir=\"/tmp\" --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" -r $v","Creating the mock VE for $ddir-$dver ($darch)");
1572	# Once setup we need to install some packages, the pb account, ...
1573	pb_system("sudo /usr/sbin/mock --install --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" -r $v su","Configuring the mock VE");
1574	}
1575	} elsif ($dtype eq "deb") {
1576	pb_system("","Creating the pbuilder VE TBD");
1577	} elsif ($dtype eq "ebuild") {
1578	die "Please teach the dev team how to build gentoo chroot";
1579	} else {
1580	die "Unknown distribution type $dtype. Report to dev team";
1581	}
1582	}
1583	# Nothing more to do for VE. No real launch
1584	} else {
1585	die "VE of type $vetype not supported. Report to the dev team";
1586	}
1587	}
1588	}
1589
1590	# Return string for date synchro
1591	sub pb_date_v {
1592
1593	my $vtype = shift;
1594	my $v = shift;
1595
1596	my ($ntp) = pb_conf_get($vtype."ntp");
1597	my $vntp = $ntp->{$ENV{'PBPROJ'}};
1598	my $ntpline;
1599
1600	if (defined $vntp) {
1601	my ($ntpcmd) = pb_conf_get($vtype."ntpcmd");
1602	my $vntpcmd;
1603	if (defined $ntpcmd->{$v}) {
1604	$vntpcmd = $ntpcmd->{$v};
1605	} elsif (defined $ntpcmd->{$ENV{'PBPROJ'}}) {
1606	$vntpcmd = $ntpcmd->{$ENV{'PBPROJ'}};
1607	} else {
1608	$vntpcmd = "/bin/true";
1609	}
1610	$ntpline = "sudo $vntpcmd $vntp";
1611	} else {
1612	$ntpline = undef;
1613	}
1614	# Force new date to be in the future compared to the date
1615	# of the host by adding 1 minute
1616	my @date=pb_get_date();
1617	$date[1]++;
1618	my $upddate = strftime("%m%d%H%M%Y", @date);
1619	my $dateline = "sudo date $upddate";
1620	return($ntpline,$dateline);
1621	}
1622
1623	sub pb_build2v {
1624
1625	my $vtype = shift;
1626
1627	my ($v,$all) = pb_get_v($vtype);
1628
1629	# Send tar files when we do a global generation
1630	pb_build2ssh() if ($all == 1);
1631
1632	my ($vmexist,$vmpid) = (undef,undef);
1633
1634	foreach my $v (@$v) {
1635	# Prepare the script to be executed on the VM/VE
1636	# in $ENV{'PBDESTDIR'}/pbscript
1637	open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
1638	print SCRIPT "#!/bin/bash\n";
1639
1640	# Transmit the verbosity level to the virtual env/mach.
1641	my $verbose = "";
1642	my $i = 0; # minimal debug level
1643	while ($i lt $pbdebug) {
1644	$verbose .= "-v ";
1645	$i++;
1646	}
1647	# Activate script verbosity if at least 2 for pbdebug
1648	print SCRIPT "set -x\n" if ($i gt 1);
1649	# Quiet if asked to be so on the original system
1650	$verbose = "-q" if ($pbdebug eq -1);
1651
1652	print SCRIPT "echo ... Execution needed\n";
1653	print SCRIPT "# This is in directory delivery\n";
1654	print SCRIPT "# Setup the variables required for building\n";
1655	print SCRIPT "export PBPROJ=$ENV{'PBPROJ'}\n";
1656	print SCRIPT "# Preparation for pb\n";
1657	print SCRIPT "mv .pbrc \$HOME\n";
1658	print SCRIPT "cd ..\n";
1659
1660	# VE needs a good /proc
1661	if ($vtype eq "ve") {
1662	print SCRIPT "sudo mount -t proc /proc /proc\n";
1663	}
1664
1665	# Get list of packages to build and get some ENV vars as well
1666	my $ptr = pb_get_pkg();
1667	@pkgs = @$ptr;
1668	my $p = join(' ',@pkgs) if (@pkgs);
1669	print SCRIPT "export PBPROJVER=$ENV{'PBPROJVER'}\n";
1670	print SCRIPT "export PBPROJTAG=$ENV{'PBPROJTAG'}\n";
1671	print SCRIPT "export PBPACKAGER=\"$ENV{'PBPACKAGER'}\"\n";
1672
1673	my ($ntpline,$dateline) = pb_date_v($vtype,$v);
1674	print SCRIPT "# Time sync\n";
1675	print SCRIPT "echo 'setting up date with '";
1676	if (defined $ntpline) {
1677	print SCRIPT "echo $ntpline\n";
1678	print SCRIPT "$ntpline\n";
1679	} else {
1680	print SCRIPT "echo $dateline\n";
1681	print SCRIPT "$dateline\n";
1682	}
1683	# Use potential local proxy declaration in case we need it to download repo, pkgs, ...
1684	if (defined $ENV{'http_proxy'}) {
1685	print SCRIPT "export http_proxy=\"$ENV{'http_proxy'}\"\n";
1686	}
1687
1688	if (defined $ENV{'ftp_proxy'}) {
1689	print SCRIPT "export ftp_proxy=\"$ENV{'ftp_proxy'}\"\n";
1690	}
1691
1692
1693	# We may need to do some other tasks before building. Read a script here to finish setup
1694	if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."build.pre") {
1695	print SCRIPT "# Special pre-build instructions to be launched\n";
1696	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."build.pre");
1697	}
1698
1699	print SCRIPT "# Build\n";
1700	print SCRIPT "echo Building packages on $vtype...\n";
1701	print SCRIPT "pb $verbose -p $ENV{'PBPROJ'} build2pkg $p\n";
1702	if ($vtype eq "ve") {
1703	print SCRIPT "sudo umount /proc\n";
1704	}
1705
1706	# We may need to do some other tasks after building. Read a script here to exit properly
1707	if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."build.post") {
1708	print SCRIPT "# Special post-build instructions to be launched\n";
1709	print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."build.post");
1710	}
1711
1712	close(SCRIPT);
1713	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
1714
1715	if ($vtype eq "vm") {
1716	# Launch the VM
1717	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1718
1719	# Skip that VM if it something went wrong
1720	next if (($vmpid == 0) && ($vmexist == 0));
1721	} else {
1722	# VE
1723	$vmexist = 0;
1724	$vmpid = 0;
1725	}
1726	# Gather all required files to send them to the VM/VE
1727	# and launch the build through pbscript
1728	pb_log(2,"Calling send2target $vtype,$v,$vmexist,$vmpid\n");
1729	pb_send2target($vtype,"$v",$vmexist,$vmpid);
1730	}
1731	}
1732
1733
1734	sub pb_newver {
1735
1736	die "-V Version parameter needed" if ((not defined $newver) \|\| ($newver eq ""));
1737
1738	# Need this call for PBDIR
1739	my ($scheme2,$uri) = pb_cms_init($pbinit);
1740
1741	my ($pbconf) = pb_conf_get("pbconfurl");
1742	$uri = $pbconf->{$ENV{'PBPROJ'}};
1743	my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);
1744
1745	# Checking CMS repositories status
1746	my ($pburl) = pb_conf_get("pburl");
1747	($scheme2, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}});
1748
1749	if ($scheme !~ /^svn/) {
1750	die "Only SVN is supported at the moment";
1751	}
1752
1753	my $res = pb_cms_isdiff($scheme,$ENV{'PBROOTDIR'});
1754	die "ERROR: No differences accepted in CMS for $ENV{'PBROOTDIR'} before creating a new version" if ($res != 0);
1755
1756	$res = pb_cms_isdiff($scheme2,$ENV{'PBDIR'});
1757	die "ERROR: No differences accepted in CMS for $ENV{'PBDIR'} before creating a new version" if ($res != 0);
1758
1759	# Tree identical between PBCONFDIR and PBROOTDIR. The delta is what
1760	# we want to get for the root of the new URL
1761
1762	my $tmp = $ENV{'PBROOTDIR'};
1763	$tmp =~ s\|^$ENV{'PBCONFDIR'}\|\|;
1764
1765	my $newurl = "$uri/".dirname($tmp)."/$newver";
1766	# Should probably use projver in the old file
1767	my $oldver= basename($tmp);
1768
1769	# Duplicate and extract project-builder part
1770	pb_log(2,"Copying $uri/$tmp to $newurl\n");
1771	pb_cms_copy($scheme,"$uri/$tmp",$newurl);
1772	pb_log(2,"Checkout $newurl to $ENV{'PBROOTDIR'}/../$newver\n");
1773	pb_cms_up($scheme,"$ENV{'PBCONFDIR'}/..");
1774
1775	# Duplicate and extract project
1776	my $newurl2 = "$pburl->{$ENV{'PBPROJ'}}/".dirname($tmp)."/$newver";
1777
1778	pb_log(2,"Copying $pburl->{$ENV{'PBPROJ'}}/$tmp to $newurl2\n");
1779	pb_cms_copy($scheme2,"$pburl->{$ENV{'PBPROJ'}}/$tmp",$newurl2);
1780	pb_log(2,"Checkout $newurl2 to $ENV{'PBDIR'}/../$newver\n");
1781	pb_cms_up($scheme2,"$ENV{'PBDIR'}/..");
1782
1783	# Update the .pb file
1784	open(FILE,"$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb") \|\| die "Unable to open $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb";
1785	open(OUT,"> $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new") \|\| die "Unable to write to $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new";
1786	while(<FILE>) {
1787	s/^projver\s+$ENV{'PBPROJ'}\s=\s$oldver/projver $ENV{'PBPROJ'} = $newver/;
1788	pb_log(0,"Changing projver from $oldver to $newver in $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb\n") if (/^projver\s+$ENV{'PBPROJ'}\s=\s$oldver/);
1789	s/^testver/#testver/;
1790	pb_log(0,"Commenting testver in $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb\n") if (/^testver/);
1791	print OUT $_;
1792	}
1793	close(FILE);
1794	close(OUT);
1795	rename("$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new","$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb");
1796
1797	# Checking pbcl files
1798	foreach my $f (<$ENV{'PBROOTDIR'}/*/pbcl>) {
1799	# Compute new pbcl file
1800	my $f2 = $f;
1801	$f2 =~ s\|$ENV{'PBROOTDIR'}\|$ENV{'PBROOTDIR'}/../$newver/\|;
1802	open(PBCL,$f) \|\| die "Unable to open $f";
1803	my $foundnew = 0;
1804	while (<PBCL>) {
1805	$foundnew = 1 if (/^$newver \(/);
1806	}
1807	close(PBCL);
1808	open(OUT,"> $f2") \|\| die "Unable to write to $f2: $!";
1809	open(PBCL,$f) \|\| die "Unable to open $f";
1810	while (<PBCL>) {
1811	print OUT "$_" if (not /^$oldver \(/);
1812	if ((/^$oldver \(/) && ($foundnew == 0)) {
1813	print OUT "$newver ($pbdate)\n";
1814	print OUT "- TBD\n";
1815	print OUT "\n";
1816	pb_log(0,"WARNING: version $newver not found in $f so added to $f2...\n") if ($foundnew == 0);
1817	}
1818	}
1819	close(OUT);
1820	close(PBCL);
1821	}
1822
1823	pb_log(2,"Checkin $ENV{'PBROOTDIR'}/../$newver\n");
1824	pb_cms_checkin($scheme,"$ENV{'PBROOTDIR'}/../$newver",undef);
1825	}
1826
1827	#
1828	# Return the list of VMs/VEs we are working on
1829	# $all is a flag to know if we return all of them
1830	# or only some (if all we publish also tar files in addition to pkgs
1831	#
1832	sub pb_get_v {
1833
1834	my $vtype = shift;
1835	my @v;
1836	my $all = 0;
1837	my $vlist;
1838	my $pbv = 'PBV';
1839
1840	if ($vtype eq "vm") {
1841	$vlist = "vmlist";
1842	} elsif ($vtype eq "ve") {
1843	$vlist = "velist";
1844	}
1845	# Get VM/VE list
1846	if ((not defined $ENV{$pbv}) \|\| ($ENV{$pbv} =~ /^all$/)) {
1847	my ($ptr) = pb_conf_get($vlist);
1848	$ENV{$pbv} = $ptr->{$ENV{'PBPROJ'}};
1849	$all = 1;
1850	}
1851	pb_log(2,"$vtype: $ENV{$pbv}\n");
1852	@v = split(/,/,$ENV{$pbv});
1853	return(\@v,$all);
1854	}
1855
1856	# Function to create a potentialy missing pb account on the VM/VE, and adds it to sudo
1857	# Needs to use root account to connect to the VM/VE
1858	# pb will take your local public SSH key to access
1859	# the pb account in the VM later on if needed
1860	sub pb_setup_v {
1861
1862	my $vtype = shift;
1863
1864	my ($vm,$all) = pb_get_v($vtype);
1865
1866	# Script generated
1867	my $pbscript = "$ENV{'PBDESTDIR'}/setupv";
1868
1869	foreach my $v (@$vm) {
1870	# Deal with date sync.
1871	my ($ntpline,$dateline) = pb_date_v($vtype,$v);
1872
1873	# Name of the account to deal with for VM/VE
1874	# Do not use the one passed potentially with -a
1875	my ($pbac) = pb_conf_get($vtype."login");
1876	my ($key,$zero0,$zero1,$zero2);
1877	my ($vmexist,$vmpid);
1878
1879	# Prepare the script to be executed on the VM/VE
1880	# in $ENV{'PBDESTDIR'}/setupv
1881	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
1882
1883	print SCRIPT << 'EOF';
1884	#!/usr/bin/perl -w
1885
1886	use strict;
1887	use File::Copy;
1888
1889	# We should not need in this script more functions than what is provided
1890	# by Base and Distribution to avoid problems at exec time.
1891	# They are appended at the end.
1892
1893	our $pbdebug;
1894	our $pbLOG;
1895	our $pbsynmsg = "pbscript";
1896	our $pbdisplaytype = "text";
1897	our $pblocale = "";
1898	pb_log_init($pbdebug, $pbLOG);
1899	pb_temp_init();
1900
1901	EOF
1902
1903	if ($vtype eq "vm") {
1904	# Prepare the key to be used and transfered remotely
1905	my $keyfile = pb_ssh_get(1);
1906
1907	my ($vmhost,$vmport,$vmntp) = pb_conf_get("vmhost","vmport","vmntp");
1908	my $nport = $vmport->{$ENV{'PBPROJ'}};
1909	$nport = "$pbport" if (defined $pbport);
1910
1911	# Launch the VM
1912	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1913
1914	# Skip that VM if something went wrong
1915	next if (($vmpid == 0) && ($vmexist == 0));
1916
1917	# Store the pub key part in a variable
1918	open(FILE,"$keyfile.pub") \|\| die "Unable to open $keyfile.pub";
1919	($zero0,$zero1,$zero2) = split(/ /,<FILE>);
1920	close(FILE);
1921
1922	$key = "\Q$zero1";
1923
1924	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\"","Copying local keys to $vtype. This may require the root password");
1925	# once this is done, we can do what we want on the VM remotely
1926	} elsif ($vtype eq "ve") {
1927	# We need to finish the setup of packages needed in the VE if needed
1928	# rinse at least needs it
1929	my ($vepkglist) = pb_conf_get_if("vepkglist");
1930
1931	if (defined $vepkglist) {
1932	# Get distro context
1933	my ($name,$ver,$darch) = split(/-/,$v);
1934	chomp($darch);
1935	my ($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd) = pb_distro_init($name,$ver);
1936
1937	my $postparam = pb_distro_get_param($ddir,$dver,$darch,$vepkglist);
1938	# Change the list of pkg in to a space separated list
1939	$postparam =~ s/,/ /g;
1940	# remove potential sudo from the update command for this time,
1941	# as this will be run as root anyway, and if not we will have
1942	# a problem with tty
1943	$pbupd =~ s/sudo //g;
1944
1945	print SCRIPT << "EOF";
1946	# For VE we first need to mount some FS
1947	pb_system("mount -t proc /proc /proc");
1948
1949	# For VE we need a good null dev
1950	pb_system("rm -f /dev/null; mknod /dev/null c 1 3; chmod 777 /dev/null");
1951
1952
1953	# For VE we need some additional packages that are not there yet
1954	pb_system("$pbupd $postparam");
1955
1956	EOF
1957	}
1958	}
1959	if ($vtype eq "vm") {
1960	print SCRIPT << 'EOF';
1961	# Removes duplicate in .ssh/authorized_keys of our key if needed
1962	#
1963	my $file1="$ENV{'HOME'}/.ssh/authorized_keys";
1964	open(PBFILE,$file1) \|\| die "Unable to open $file1";
1965	open(PBOUT,"> $file1.new") \|\| die "Unable to open $file1.new";
1966	my $count = 0;
1967	while (<PBFILE>) {
1968
1969	EOF
1970	print SCRIPT << "EOF";
1971	if (/ $key /) {
1972	\$count++;
1973	}
1974	print PBOUT \$_ if ((\$count <= 1) \|\| (\$_ !~ / $key /));
1975	}
1976	close(PBFILE);
1977	close(PBOUT);
1978	rename("\$file1.new",\$file1);
1979	chmod 0600,\$file1;
1980
1981	# Sync date
1982	EOF
1983	if (defined $ntpline) {
1984	print SCRIPT "system(\"$ntpline\");\n";
1985	} else {
1986	print SCRIPT "system(\"$dateline\");\n";
1987	}
1988	}
1989	print SCRIPT << 'EOF';
1990
1991	# Adds $pbac->{$ENV{'PBPROJ'}} as an account if needed
1992	#
1993	my $file="/etc/passwd";
1994	open(PBFILE,$file) \|\| die "Unable to open $file";
1995	my $found = 0;
1996	while (<PBFILE>) {
1997	EOF
1998	print SCRIPT << "EOF";
1999	\$found = 1 if (/^$pbac->{$ENV{'PBPROJ'}}:/);
2000	EOF
2001	print SCRIPT << 'EOF';
2002	}
2003	close(PBFILE);
2004
2005	if ( $found == 0 ) {
2006	if ( ! -d "/home" ) {
2007	pb_mkdir("/home");
2008	}
2009	EOF
2010	print SCRIPT << "EOF";
2011	pb_system("groupadd $pbac->{$ENV{'PBPROJ'}}","Adding group $pbac->{$ENV{'PBPROJ'}}");
2012	pb_system("useradd $pbac->{$ENV{'PBPROJ'}} -g $pbac->{$ENV{'PBPROJ'}} -m -d /home/$pbac->{$ENV{'PBPROJ'}}","Adding user $pbac->{$ENV{'PBPROJ'}} (group $pbac->{$ENV{'PBPROJ'}} - home /home/$pbac->{$ENV{'PBPROJ'}}");
2013	}
2014	EOF
2015
2016	if ($vtype eq "vm") {
2017	print SCRIPT << "EOF";
2018	# allow ssh entry to build
2019	#
2020	mkdir "/home/$pbac->{$ENV{'PBPROJ'}}/.ssh",0700;
2021	# Allow those accessing root to access the build account
2022	copy("\$ENV{'HOME'}/.ssh/authorized_keys","/home/$pbac->{$ENV{'PBPROJ'}}/.ssh/authorized_keys");
2023	chmod 0600,".ssh/authorized_keys";
2024	pb_system("chown -R $pbac->{$ENV{'PBPROJ'}}:$pbac->{$ENV{'PBPROJ'}} /home/$pbac->{$ENV{'PBPROJ'}}/.ssh","Finish setting up the SSH env for $pbac->{$ENV{'PBPROJ'}}");
2025
2026	EOF
2027	}
2028	print SCRIPT << 'EOF';
2029	# No passwd for build account only keys
2030	$file="/etc/shadow";
2031	if (-f $file) {
2032	open(PBFILE,$file) \|\| die "Unable to open $file";
2033	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
2034	while (<PBFILE>) {
2035	EOF
2036	print SCRIPT << "EOF";
2037	s/^$pbac->{$ENV{'PBPROJ'}}:\!\!:/$pbac->{$ENV{'PBPROJ'}}:*:/;
2038	s/^$pbac->{$ENV{'PBPROJ'}}:\!:/$pbac->{$ENV{'PBPROJ'}}:*:/; #SLES 9 e.g.
2039	EOF
2040	print SCRIPT << 'EOF';
2041	print PBOUT $_;
2042	}
2043	close(PBFILE);
2044	close(PBOUT);
2045	rename("$file.new",$file);
2046	chmod 0640,$file;
2047	}
2048
2049	# Keep the VM in text mode
2050	$file="/etc/inittab";
2051	if (-f $file) {
2052	open(PBFILE,$file) \|\| die "Unable to open $file";
2053	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
2054	while (<PBFILE>) {
2055	s/^(..):5:initdefault:$/$1:3:initdefault:/;
2056	print PBOUT $_;
2057	}
2058	close(PBFILE);
2059	close(PBOUT);
2060	rename("$file.new",$file);
2061	chmod 0640,$file;
2062	}
2063
2064	# pb has to be added to portage group on gentoo
2065
2066	# Adapt sudoers
2067	$file="/etc/sudoers";
2068	open(PBFILE,$file) \|\| die "Unable to open $file";
2069	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
2070	while (<PBFILE>) {
2071	EOF
2072	print SCRIPT << "EOF";
2073	next if (/^$pbac->{$ENV{'PBPROJ'}} /);
2074	EOF
2075	print SCRIPT << 'EOF';
2076	s/Defaults[ \t]+requiretty//;
2077	print PBOUT $_;
2078	}
2079	close(PBFILE);
2080	EOF
2081	print SCRIPT << "EOF";
2082	# This is needed in order to be able to halt the machine from the $pbac->{$ENV{'PBPROJ'}} account at least
2083	print PBOUT "Defaults:pb env_keep += \"http_proxy ftp_proxy\"\n";
2084	print PBOUT "$pbac->{$ENV{'PBPROJ'}} ALL=(ALL) NOPASSWD:ALL\n";
2085	EOF
2086	print SCRIPT << 'EOF';
2087	close(PBOUT);
2088	rename("$file.new",$file);
2089	chmod 0440,$file;
2090
2091	EOF
2092
2093	my $SCRIPT = \*SCRIPT;
2094
2095	pb_install_deps($SCRIPT);
2096
2097	print SCRIPT << 'EOF';
2098	# Suse wants sudoers as 640
2099	if (($ddir eq "sles") \|\| (($ddir eq "opensuse") && ($dver =~ /10.[012]/))) {
2100	chmod 0640,$file;
2101	}
2102
2103	pb_system("rm -rf ProjectBuilder-* ; wget --passive-ftp ftp://ftp.mondorescue.org/src/ProjectBuilder-latest.tar.gz ; tar xvfz ProjectBuilder-latest.tar.gz ; cd ProjectBuilder-* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf ProjectBuilder-* ; rm -rf project-builder-* ; wget --passive-ftp ftp://ftp.mondorescue.org/src/project-builder-latest.tar.gz ; tar xvfz project-builder-latest.tar.gz ; cd project-builder-* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf project-builder-* ;","Building Project-Builder");
2104	system "pb 2>&1 \| head -5";
2105	EOF
2106	if ($vtype eq "ve") {
2107	print SCRIPT << 'EOF';
2108	# For VE we need to umount some FS at the end
2109
2110	pb_system("umount /proc");
2111
2112	# Create a basic network file if not already there
2113
2114	my $nf="/etc/sysconfig/network";
2115	if (! -f $nf) {
2116	open(NF,"> $nf") \|\| die "Unable to create $nf";
2117	print NF "NETWORKING=yes\n";
2118	print NF "HOSTNAME=localhost\n";
2119	close(NF);
2120	}
2121	chmod 0755,$nf;
2122	EOF
2123	}
2124
2125	# Adds pb_distro_init from ProjectBuilder::Distribution and Base
2126	foreach my $d (@INC) {
2127	my @f = ("$d/ProjectBuilder/Base.pm","$d/ProjectBuilder/Distribution.pm");
2128	foreach my $f (@f) {
2129	if (-f "$f") {
2130	open(PBD,"$f") \|\| die "Unable to open $f";
2131	while (<PBD>) {
2132	next if (/^package/);
2133	next if (/^use Exporter/);
2134	next if (/^use ProjectBuilder::/);
2135	next if (/^our /);
2136	print SCRIPT $_;
2137	}
2138	close(PBD);
2139	}
2140	}
2141	}
2142	close(SCRIPT);
2143	chmod 0755,"$pbscript";
2144
2145	# That build script needs to be run as root and force stop of VM at end
2146	$pbaccount = "root";
2147
2148	# Force shutdown of VM exept if it was already launched
2149	my $force = 0;
2150	if ((! $vmexist) && ($vtype eq "vm")) {
2151	$force = 1;
2152	}
2153
2154	pb_script2v($pbscript,$vtype,$force,$v);
2155	}
2156	return;
2157	}
2158
2159	sub pb_install_deps {
2160
2161	my $SCRIPT = shift;
2162
2163	print {$SCRIPT} << 'EOF';
2164	# We need to have that pb_distro_init function
2165	# Get it from Project-Builder::Distribution
2166	my ($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd) = pb_distro_init();
2167	print "distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n";
2168
2169	# We may need a proxy configuration. Get it from the local env
2170	EOF
2171
2172	if (defined $ENV{'http_proxy'}) {
2173	print SCRIPT "\$ENV\{'http_proxy'\}=\"$ENV{'http_proxy'}\";\n";
2174	}
2175
2176	if (defined $ENV{'ftp_proxy'}) {
2177	print SCRIPT "\$ENV\{'ftp_proxy'\}=\"$ENV{'ftp_proxy'}\";\n";
2178	}
2179
2180	print {$SCRIPT} << 'EOF';
2181	# Get and install pb
2182	my $insdm = "rm -rf Date-Manip* ; wget http://search.cpan.org/CPAN/authors/id/S/SB/SBECK/Date-Manip-5.54.tar.gz ; tar xvfz Date-Manip-5.54.tar.gz ; cd Date-Manip* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf Date-Manip*";
2183	my $insmb = "rm -rf Module-Build* ; wget http://search.cpan.org/CPAN/authors/id/K/KW/KWILLIAMS/Module-Build-0.2808.tar.gz ; tar xvfz Module-Build-0.2808.tar.gz ; cd Module-Build* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf Module-Build*";
2184	my $insfm = "rm -rf File-MimeInfo* ; wget http://search.cpan.org/CPAN/authors/id/P/PA/PARDUS/File-MimeInfo/File-MimeInfo-0.15.tar.gz ; tar xvfz File-MimeInfo-0.15.tar.gz ; cd File-MimeInfo* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf File-MimeInfo*";
2185	my $insfb = "rm -rf File-Basedir* ; wget http://search.cpan.org/CPAN/authors/id/P/PA/PARDUS/File-BaseDir-0.03.tar.gz ; tar xvfz File-BaseDir-0.03.tar.gz ; cd File-BaseDir* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf File-BaseDir*";
2186	my $insms = "rm -rf Mail-Sendmail* ; wget http://search.cpan.org/CPAN/authors/id/M/MI/MIVKOVIC/Mail-Sendmail-0.79.tar.gz ; tar xvfz Mail-Sendmail-0.79.tar.gz ; cd Mail-Sendmail* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf Mail-Sendmail*";
2187	my $cmtdm = "Installing Date-Manip perl module";
2188	my $cmtmb = "Installing Module-Build perl module";
2189	my $cmtfm = "Installing File-MimeInfo perl module";
2190	my $cmtfb = "Installing File-Basedir perl module";
2191	my $cmtms = "Installing Perl-Sendmail perl module";
2192	my $cmtall = "Installing required modules";
2193
2194	if ( $ddir eq "fedora" ) {
2195	pb_system("yum clean all","Cleaning yum env");
2196	if ($dver == 4) {
2197	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"rpm-build wget patch ntp sudo perl-DateManip perl-ExtUtils-MakeMaker"));
2198	pb_system("$insmb","$cmtmb");
2199	pb_system("$insfm","$cmtfm");
2200	pb_system("$insfb","$cmtfb");
2201	pb_system("$insms","$cmtms");
2202	} else {
2203	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"rpm-build wget patch ntp sudo perl-DateManip perl-ExtUtils-MakeMaker perl-File-MimeInfo perl-Mail-Sendmail"));
2204	}
2205	} elsif ($ddir eq "asianux") {
2206	pb_system("yum clean all","Cleaning yum env");
2207	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"rpm-build wget patch ntp sudo perl-DateManip"));
2208	pb_system("$insmb","$cmtmb");
2209	pb_system("$insfm","$cmtfm");
2210	pb_system("$insfb","$cmtfb");
2211	pb_system("$insms","$cmtms");
2212	} elsif (( $dfam eq "rh" ) \|\| ($ddir eq "suse") \|\| ($ddir eq "sles") \|\| (($ddir eq "opensuse") && (($dver eq "10.1") \|\| ($dver eq "10.0"))) \|\| ($ddir eq "slackware")) {
2213	# Suppose pkg are installed already as no online mirror available
2214	pb_system("rpm -e lsb 2>&1 > /dev/null","Removing lsb package");
2215	pb_system("$insdm","$cmtdm");
2216	pb_system("$insmb","$cmtmb");
2217	pb_system("$insfm","$cmtfm");
2218	pb_system("$insfb","$cmtfb");
2219	pb_system("$insms","$cmtms");
2220	} elsif ($ddir eq "opensuse") {
2221	# New OpenSuSE
2222	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"make wget patch sudo ntp"));
2223	pb_system("$insmb","$cmtmb");
2224	pb_system("$insfm","$cmtfm");
2225	pb_system("$insfb","$cmtfb");
2226	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"perl-Date-Manip perl-File-HomeDir perl-Mail-Sendmail"));
2227	if ($dver < 11) {
2228	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"ntp"));
2229	} else {
2230	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"sntp"));
2231	}
2232	} elsif ( $dfam eq "md" ) {
2233	my $addp = "";
2234	if (($ddir eq "mandrake") && ($dver eq "10.1")) {
2235	pb_system("$insdm","$cmtdm");
2236	} else {
2237	$addp ="perl-DateManip";
2238	}
2239	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"rpm-build wget sudo patch ntp-client perl-File-MimeInfo perl-Mail-Sendmail $addp"));
2240	} elsif ( $dfam eq "du" ) {
2241	if (( $dver eq "3.1" ) && ($ddir eq "debian")) {
2242	pb_system("$insfb","$cmtfb");
2243	pb_system("$insfm","$cmtfm");
2244	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"wget patch ssh sudo debian-builder dh-make fakeroot ntpdate libmodule-build-perl libdate-manip-perl libmail-sendmail-perl"));
2245	} else {
2246	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"wget patch openssh-server dpkg-dev sudo debian-builder dh-make fakeroot ntpdate libfile-mimeinfo-perl libmodule-build-perl libdate-manip-perl libmail-sendmail-perl"));
2247	}
2248	} elsif ( $dfam eq "gen" ) {
2249	#system "emerge -u system";
2250	pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"wget sudo ntp DateManip File-MimeInfo Mail-Sendmail"));
2251	} else {
2252	pb_log(0,"No pkg to install\n");
2253	}
2254	EOF
2255	}
2256
2257	sub pb_announce {
2258
2259	# Get all required parameters
2260	my ($pbpackager,$pbrepo,$pbml,$pbsmtp) = pb_conf_get("pbpackager","pbrepo","pbml","pbsmtp");
2261	my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
2262	my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
2263	my @pkgs = @$pkg;
2264	my %pkgs;
2265	my $first = 0;
2266
2267	# Command to find packages on repo
2268	my $findstr = "find . ";
2269	# Generated announce files
2270	my @files;
2271
2272	foreach my $pbpkg (@pkgs) {
2273	if ($first != 0) {
2274	$findstr .= "-o ";
2275	}
2276	$first++;
2277	if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
2278	$pbver = $pkgv->{$pbpkg};
2279	} else {
2280	$pbver = $ENV{'PBPROJVER'};
2281	}
2282	if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
2283	$pbtag = $pkgt->{$pbpkg};
2284	} else {
2285	$pbtag = $ENV{'PBPROJTAG'};
2286	}
2287
2288	# TODO: use virtual/real names here now
2289	$findstr .= "-name \'$pbpkg-$pbver-$pbtag\..rpm\' -o -name \'$pbpkg"."_$pbver\.deb\' -o -name \'$pbpkg-$pbver\.ebuild\' ";
2290
2291	my $chglog;
2292
2293	# Get project info on log file and generate tmp files used later on
2294	pb_cms_init($pbinit);
2295	$chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
2296	$chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
2297	$chglog = undef if (! -f $chglog);
2298
2299	open(OUT,"> $ENV{'PBTMP'}/$pbpkg.ann") \|\| die "Unable to create $ENV{'PBTMP'}/$pbpkg.ann: $!";
2300	my %pb;
2301	$pb{'dtype'} = "announce";
2302	$pb{'realpkg'} = $pbpkg;
2303	$pb{'ver'} = $pbver;
2304	$pb{'tag'} = $pbtag;
2305	$pb{'suf'} = "N/A"; # Should not be empty even if unused
2306	$pb{'date'} = $pbdate;
2307	$pb{'chglog'} = $chglog;
2308	$pb{'packager'} = $pbpackager;
2309	$pb{'proj'} = $ENV{'PBPROJ'};
2310	$pb{'repo'} = $pbrepo;
2311	pb_changelog(\%pb,\*OUT,"yes");
2312	close(OUT);
2313	push(@files,"$ENV{'PBTMP'}/$pbpkg.ann");
2314	}
2315	$findstr .= " \| grep -Ev \'src.rpm\'";
2316	if ((not defined $testver) \|\| (not defined $testver->{$ENV{'PBPROJ'}}) \|\| ($testver->{$ENV{'PBPROJ'}} !~ /true/i)) {
2317	$findstr .= " \| grep -v ./test/";
2318	}
2319
2320	# Prepare the command to run and execute it
2321	open(PBS,"> $ENV{'PBTMP'}/pbscript") \|\| die "Unable to create $ENV{'PBTMP'}/pbscript";
2322	print PBS "$findstr\n";
2323	close(PBS);
2324	chmod 0755,"$ENV{'PBTMP'}/pbscript";
2325	pb_send2target("Announce");
2326
2327	# Get subject line
2328	my $sl = "Project $ENV{'PBPROJ'} version $ENV{'PBPROJVER'} is now available";
2329	pb_log(0,"Please enter the title of your announce\n");
2330	pb_log(0,"(By default: $sl)\n");
2331	my $sl2 = <STDIN>;
2332	$sl = $sl2 if ($sl2 !~ /^$/);
2333
2334	# Prepare a template of announce
2335	open(ANN,"> $ENV{'PBTMP'}/announce.html") \|\| die "Unable to create $ENV{'PBTMP'}/announce.html: $!";
2336	print ANN << "EOF";
2337	$sl</p>
2338
2339	<p>The project team is happy to announce the availability of a newest version of $ENV{'PBPROJ'} $ENV{'PBPROJVER'}. Enjoy it as usual!</p>
2340	<p>
2341	Now available at <a href="$pbrepo->{$ENV{'PBPROJ'}}">$pbrepo->{$ENV{'PBPROJ'}}</a>
2342	</p>
2343	<p>
2344	EOF
2345	open(LOG,"$ENV{'PBTMP'}/system.log") \|\| die "Unable to read $ENV{'PBTMP'}/system.log: $!";
2346	my $col = 2;
2347	my $i = 1;
2348	print ANN << 'EOF';
2349	<TABLE WIDTH="700" CELLPADDING="0" CELLSPACING="0" BORDER="0">
2350	<TR>
2351	EOF
2352	while (<LOG>) {
2353	print ANN "<TD><A HREF=\"$pbrepo->{$ENV{'PBPROJ'}}/$_\">$_</A></TD>";
2354	$i++;
2355	if ($i > $col) {
2356	print ANN "</TR>\n<TR>";
2357	$i = 1;
2358	}
2359	}
2360	close(LOG);
2361	print ANN << "EOF";
2362	</TR>
2363	</TABLE>
2364	</p>
2365
2366	<p>As usual source packages are also available in the same directory.</p>
2367
2368	<p>
2369	Changes are :
2370	</p>
2371	<p>
2372	EOF
2373	# Get each package changelog content
2374	foreach my $f (sort(@files)) {
2375	open(IN,"$f") \|\| die "Unable to read $f:$!";
2376	while (<IN>) {
2377	print ANN $_;
2378	}
2379	close(IN);
2380	print ANN "</p><p>\n";
2381	}
2382	print ANN "</p>\n";
2383	close(ANN);
2384
2385	# Allow for modification
2386	pb_system("vi $ENV{'PBTMP'}/announce.html","Allowing modification of the announce","noredir");
2387
2388	# Store it in DB for external usage (Web pages generation)
2389	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
2390
2391	my $precmd = "";
2392	if (! -f $db) {
2393	$precmd = "CREATE TABLE announces (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, announce VARCHAR[65535])";
2394	}
2395
2396	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
2397	{ RaiseError => 1, AutoCommit => 1 })
2398	\|\| die "Unable to connect to $db";
2399
2400	if ($precmd ne "") {
2401	my $sth = $dbh->prepare(qq{$precmd})
2402	\|\| die "Unable to create table into $db";
2403	$sth->execute();
2404	}
2405
2406	# To read whole file
2407	local $/;
2408	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
2409	my $announce = <ANN>;
2410	close(ANN);
2411
2412	pb_log(2,"INSERT INTO announces VALUES (NULL, $pbdate, $announce)");
2413	my $sth = $dbh->prepare(qq{INSERT INTO announces VALUES (NULL,?,?)})
2414	\|\| die "Unable to insert into $db";
2415	$sth->execute($pbdate, $announce);
2416	$sth->finish();
2417	$dbh->disconnect;
2418
2419	# Then deliver it on the Web
2420	# $TOOLHOME/livwww www
2421
2422	# Mail it to project's ML
2423	open(ML,"\| w3m -dump -T text/html > $ENV{'PBTMP'}/announce.txt") \|\| die "Unable to create $ENV{'PBTMP'}/announce.txt: $!";
2424	print ML << 'EOF';
2425	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/x html1/DTD/xhtml1-strict.dtd">
2426
2427	<html xmlns="http://www.w3.org/1999/xhtml" dir="ltr" xml:lang="en" lang="en">
2428	<head>
2429	</head>
2430	<body>
2431	<p>
2432	EOF
2433	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
2434	while(<ANN>) {
2435	print ML $_;
2436	}
2437	print ML << 'EOF';
2438	</body>
2439	</html>
2440	EOF
2441	close(ML);
2442
2443	# To read whole file
2444	local $/;
2445	open(ANN,"$ENV{'PBTMP'}/announce.txt") \|\| die "Unable to read $ENV{'PBTMP'}/announce.txt: $!";
2446	my $msg = <ANN>;
2447	close(ANN);
2448
2449	# Preparation of headers
2450
2451	my %mail = (
2452	To => $pbml->{$ENV{'PBPROJ'}},
2453	From => $pbpackager->{$ENV{'PBPROJ'}},
2454	Smtp => $pbsmtp->{$ENV{'PBPROJ'}},
2455	Body => $msg,
2456	Subject => "[ANNOUNCE] $sl",
2457	);
2458
2459	# Send mail
2460	sendmail(%mail) or die "Unable to send mail ($Mail::Sendmail::error): $Mail::Sendmail::log";
2461	}
2462
2463	#
2464	# Creates a set of HTML file containing the news for the project
2465	# based on what has been generated by the pb_announce function
2466	#
2467	sub pb_web_news2html {
2468
2469	my $dest = shift \|\| $ENV{'PBTMP'};
2470
2471	# Get all required parameters
2472	my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
2473
2474	# DB of announces for external usage (Web pages generation)
2475	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
2476
2477	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
2478	{ RaiseError => 1, AutoCommit => 1 })
2479	\|\| die "Unable to connect to $db";
2480	# For date handling
2481	$ENV{LANGUAGE}="C";
2482	my $firstjan = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year(), 0, 0, -1);
2483	my $oldfirst = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year()-1, 0, 0, -1);
2484	pb_log(2,"firstjan: $firstjan, oldfirst: $oldfirst, pbdate:$pbdate\n");
2485	my $all = $dbh->selectall_arrayref("SELECT id,date,announce FROM announces ORDER BY date DESC");
2486	my %news;
2487	$news{"cy"} = ""; # current year's news
2488	$news{"ly"} = ""; # last year news
2489	$news{"py"} = ""; # previous years news
2490	$news{"fp"} = ""; # first page news
2491	my $cpt = 4; # how many news for first page
2492	# Extract info from DB
2493	foreach my $row (@$all) {
2494	my ($id, $date, $announce) = @$row;
2495	$news{"cy"} = $news{"cy"}."<p><B>$date</B> $announce\n" if ((($date cmp $pbdate) le 0) && (($firstjan cmp $date) le 0));
2496	$news{"ly"} = $news{"ly"}."<p><B>$date</B> $announce\n" if ((($date cmp $firstjan) le 0) && (($oldfirst cmp $date) le 0));
2497	$news{"py"} = $news{"py"}."<p><B>$date</B> $announce\n" if (($date cmp $oldfirst) le 0);
2498	$news{"fp"} = $news{"fp"}."<p><B>$date</B> $announce\n" if ($cpt > 0);
2499	$cpt--;
2500	}
2501	pb_log(1,"news{fp}: ".$news{"fp"}."\n");
2502	$dbh->disconnect;
2503
2504	# Generate the HTML content
2505	foreach my $pref (keys %news) {
2506	open(NEWS,"> $dest/pb_web_$pref"."news.html") \|\| die "Unable to create $dest/pb_web_$pref"."news.html: $!";
2507	print NEWS "$news{$pref}";
2508	close(NEWS);
2509	}
2510	}
2511
2512
2513	# Return the SSH key file to use
2514	# Potentially create it if needed
2515
2516	sub pb_ssh_get {
2517
2518	my $create = shift \|\| 0; # Do not create keys by default
2519
2520	# Check the SSH environment
2521	my $keyfile = undef;
2522
2523	# We have specific keys by default
2524	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
2525	if (!(-e $keyfile) && ($create eq 1)) {
2526	pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
2527	}
2528
2529	$keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
2530	$keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
2531	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
2532	die "Unable to find your public ssh key under $keyfile" if (not defined $keyfile);
2533	return($keyfile);
2534	}
2535
2536
2537	# Returns the pid of a running VM command using a specific VM file
2538	sub pb_check_ps {
2539	my $vmcmd = shift;
2540	my $vmm = shift;
2541	my $vmexist = 0; # FALSE by default
2542
2543	open(PS, "ps auxhww\|") \|\| die "Unable to call ps";
2544	while (<PS>) {
2545	next if (! /$vmcmd/);
2546	next if (! /$vmm/);
2547	my ($void1, $void2);
2548	($void1, $vmexist, $void2) = split(/ +/);
2549	last;
2550	}
2551	return($vmexist);
2552	}
2553
2554
2555	sub pb_extract_build_files {
2556
2557	my $src=shift;
2558	my $dir=shift;
2559	my $ddir=shift;
2560	my $mandatory=shift \|\| "spec";
2561	my @files;
2562
2563	my $flag = "mayfail" if ($mandatory eq "patch");
2564	my $res;
2565
2566	if ($src =~ /tar\.gz$/) {
2567	$res = pb_system("tar xfpz $src $dir","Extracting $mandatory files from $src",$flag);
2568	} elsif ($src =~ /tar\.bz2$/) {
2569	$res = pb_system("tar xfpj $src $dir","Extracting $mandatory files from $src",$flag);
2570	} else {
2571	die "Unknown compression algorithm for $src";
2572	}
2573	# If not mandatory return now
2574	return() if (($res != 0) and ($mandatory eq "patch"));
2575	opendir(DIR,"$dir") \|\| die "Unable to open directory $dir";
2576	foreach my $f (readdir(DIR)) {
2577	next if ($f =~ /^\./);
2578	# Skip potential patch dir
2579	next if ($f =~ /^pbpatch/);
2580	move("$dir/$f","$ddir") \|\| die "Unable to move $dir/$f to $ddir";
2581	pb_log(2,"mv $dir/$f $ddir\n");
2582	push @files,"$ddir/$f";
2583	}
2584	closedir(DIR);
2585	# Not enough but still a first cleanup
2586	pb_rm_rf("$dir");
2587	return(@files);
2588	}
2589
2590	sub pb_list_bfiles {
2591
2592	my $dir = shift;
2593	my $pbpkg = shift;
2594	my $bfiles = shift;
2595	my $pkgfiles = shift;
2596	my $supfiles = shift;
2597
2598	opendir(BDIR,"$dir") \|\| die "Unable to open dir $dir: $!";
2599	foreach my $f (readdir(BDIR)) {
2600	next if ($f =~ /^\./);
2601	$bfiles->{$f} = "$dir/$f";
2602	$bfiles->{$f} =~ s~$ENV{'PBROOTDIR'}~~;
2603	if (defined $supfiles->{$pbpkg}) {
2604	$pkgfiles->{$f} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
2605	}
2606	}
2607	closedir(BDIR);
2608	}
2609
2610
2611	#
2612	# Return the list of packages we are working on in a non CMS action
2613	#
2614	sub pb_get_pkg {
2615
2616	my @pkgs = ();
2617
2618	my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
2619	@pkgs = keys %$var;
2620
2621	pb_log(0,"Packages: ".join(',',@pkgs)."\n");
2622	return(\@pkgs);
2623	}
2624
2625	# Which is our local arch ? (standardize on i386 for those platforms)
2626	sub pb_get_arch {
2627
2628	my $arch = `uname -m`;
2629	chomp($arch);
2630	$arch =~ s/i.86/i386/;
2631	return($arch);
2632	}
2633
2634	1;

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

Download in other formats: