Context Navigation

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

Last change on this file since 714 was 714, checked in by Bruno Cornec, 15 years ago
Adds Asianux support to pb for MondoRescue official packages support
Property svn:executable set to ``*
File size: 82.4 KB

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

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

Download in other formats: