Context Navigation

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

Last change on this file since 495 was 495, checked in by Bruno Cornec, 16 years ago
all global variables are prefixed with pb First attempt at using locale and gettext use of pb_display and pb_display_init added Update presentation following RMLL 2008
Property svn:executable set to ``*
File size: 65.5 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 POSIX qw(strftime);
21	use lib qw (lib);
22	use ProjectBuilder::Version;
23	use ProjectBuilder::Base;
24	use ProjectBuilder::Conf;
25	use ProjectBuilder::Distribution;
26	use ProjectBuilder::CMS;
27	use ProjectBuilder::Env;
28	use ProjectBuilder::Filter;
29	use ProjectBuilder::Changelog;
30
31	# For announce only
32	use DBI;
33	use Mail::Sendmail;
34
35	# Global variables
36	my %opts; # CLI Options
37	my $action; # action to realize
38	my $test = "FALSE"; # Not used
39	my $force = 0; # Force VE/VM rebuild
40	my $option = ""; # Not used
41	my @pkgs; # list of packages
42	my $pbtag; # Global Tag variable
43	my $pbver; # Global Version variable
44	my $pbscript; # Name of the script
45	my %pbver; # per package
46	my %pbtag; # per package
47	my $pbrev; # Global REVISION variable
48	my $pbaccount; # Login to use to connect to the VM
49	my $pbport; # Port to use to connect to the VM
50	my $newver; # New version to create
51	my $iso; # ISO image for the VM to create
52
53	my @date = pb_get_date();
54	my $pbdate = strftime("%Y-%m-%d", @date);
55
56	=pod
57
58	=head1 NAME
59
60	pb, aka project-builder.org - builds packages for your projects
61
62	=head1 DESCRIPTION
63
64	pb helps you build various packages directly from your project sources.
65	Those sources could be handled by a CMS (Configuration Management System)
66	such as Subversion, CVS, ... or being a simple reference to a compressed tar file.
67	It's based on a set of configuration files, a set of provided macros to help
68	you keeping build files as generic as possible. For example, a single .spec
69	file should be required to generate for all rpm based distributions, even
70	if you could also have multiple .spec files if required.
71
72	=head1 SYNOPSIS
73
74	pb [-vhq][-r pbroot][-p project][[-s script -a account -P port][-m mach-1[,...]]][-i iso] <action> [<pkg1> ...]
75
76	pb [--verbose][--help][--man][--quiet][--revision pbroot][--project project][[--script script --account account --port port][--machine mach-1[,...]]][--iso iso] <action> [<pkg1> ...]
77
78	=head1 OPTIONS
79
80	=over 4
81
82	=item B<-v\|--verbose>
83
84	Print a brief help message and exits.
85
86	=item B<-q\|--quiet>
87
88	Do not print any output.
89
90	=item B<-h\|--help>
91
92	Print a brief help message and exits.
93
94	=item B<--man>
95
96	Prints the manual page and exits.
97
98	=item B<-m\|--machine machine1[,machine2,...]>
99
100	Name of the Virtual Machines (VM) or Virtual Environments (VE) you want to build on (coma separated).
101	All if none precised (or use the env variable PBV).
102
103	=item B<-s\|--script script>
104
105	Name of the script you want to execute on the related VMs or VEs.
106
107	=item B<-i\|--iso iso_image>
108
109	Name of the ISO image of the distribution you want to install on the related VMs.
110
111	=item B<-a\|--account account>
112
113	Name of the account to use to connect on the related VMs.
114
115	=item B<-P\|--port port_number>
116
117	Port number to use to connect on the related VMs.\n";
118
119	=item B<-p\|--project project_name>
120
121	Name of the project you're working on (or use the env variable PBPROJ)
122
123	=item B<-r\|--revision revision>
124
125	Path Name of the project revision under the CMS (or use the env variable PBROOT)
126
127	=item B<-V\|--version new_version>
128
129	New version of the project to create based on the current one.
130
131	=back
132
133	=head1 ARGUMENTS
134
135	<action> can be:
136
137	=over 4
138
139	=item B<cms2build>
140
141	Create tar files for the project under your CMS.
142	CMS supported are SVN and CVS
143	parameters are packages to build
144	if not using default list
145
146	=item B<build2pkg>
147
148	Create packages for your running distribution
149
150	=item B<cms2pkg>
151
152	cms2build + build2pkg
153
154	=item B<build2ssh>
155
156	Send the tar files to a SSH host
157
158	=item B<cms2ssh>
159
160	cms2build + build2ssh
161
162	=item B<pkg2ssh>
163
164	Send the packages built to a SSH host
165
166	=item B<build2vm>
167
168	Create packages in VMs, launching them if needed
169	and send those packages to a SSH host once built
170	VM type supported are QEMU
171
172	=item B<build2ve>
173
174	Create packages in VEs, creating it if needed
175	and send those packages to a SSH host once built
176
177	=item B<cms2vm>
178
179	cms2build + build2vm
180
181	=item B<cms2ve>
182
183	cms2build + build2ve
184
185	=item B<launchvm>
186
187	Launch one virtual machine
188
189	=item B<launchve>
190
191	Launch one virtual environment
192
193	=item B<script2vm>
194
195	Launch one virtual machine if needed
196	and executes a script on it
197
198	=item B<script2ve>
199
200	Execute a script in a virtual environment
201
202	=item B<newvm>
203
204	Create a new virtual machine
205
206	=item B<newve>
207
208	Create a new virtual environment
209
210	=item B<setupvm>
211
212	Setup a virtual machine for pb usage
213
214	=item B<setupve>
215
216	Setup a virtual environment for pb usage
217
218	=item B<newver>
219
220	Create a new version of the project derived
221	from the current one
222
223	=item B<newproj>
224
225	Create a new project and a template set of
226	configuration files under pbconf
227
228	=item B<announce>
229
230	Announce the availability of the project through various means
231
232	=back
233
234	<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).
235
236	=head1 WEB SITES
237
238	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/>.
239
240	=head1 USER MAILING LIST
241
242	None exists for the moment.
243
244	=head1 CONFIGURATION FILES
245
246	Each pb user may have a configuration in F<$HOME/.pbrc>. The values in this file may overwrite any other configuration file value.
247
248	Here is an example of such a configuration file:
249
250	#
251	# Define for each project the URL of its pbconf repository
252	# No default option allowed here as they need to be all different
253	#
254	# URL of the pbconf content
255	# This is the format of a classical URL with the extension of additional schema such as
256	# svn+ssh, cvs+ssh, ...
257	#
258	pbconfurl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe/pbconf
259
260	# This is normaly defined in the project's configuration file
261	# Url of the project
262	#
263	pburl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe
264
265	# All these URLs needs to be defined here as the are the entry point
266	# for how to build packages for the project
267	#
268	pbconfurl pb = svn+ssh://svn.project-builder.org/mondo/svn/pb/pbconf
269	pbconfurl mondorescue = svn+ssh://svn.project-builder.org/mondo/svn/project-builder/mondorescue/pbconf
270	pbconfurl collectl = svn+ssh://bruno@svn.mondorescue.org/mondo/svn/project-builder/collectl/pbconf
271	pbconfurl netperf = svn+ssh://svn.mondorescue.org/mondo/svn/project-builder/netperf/pbconf
272
273	# Under that dir will take place everything related to pb
274	# If you want to use VMs/chroot/..., then use $ENV{'HOME'} to make it portable
275	# to your VMs/chroot/...
276	# if not defined then /var/cache
277	pbdefdir default = $ENV{'HOME'}/project-builder
278	pbdefdir pb = $ENV{'HOME'}
279	pbdefdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
280	pbdefdir mondorescue = $ENV{'HOME'}/mondo/svn
281
282	# pbconfdir points to the directory where the CMS content of the pbconfurl is checked out
283	# If not defined, pbconfdir is under pbdefdir/pbproj/pbconf
284	pbconfdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs/pbconf
285	pbconfdir mondorescue = $ENV{'HOME'}/mondo/svn/pbconf
286
287	# pbdir points to the directory where the CMS content of the pburl is checked out
288	# If not defined, pbdir is under pbdefdir/pbproj
289	# Only defined if we have access to the dev of the project
290	pbdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
291	pbdir mondorescue = $ENV{'HOME'}/mondo/svn
292
293	# -daemonize doesn't work with qemu 0.8.2
294	vmopt default = -m 384
295
296	=head1 AUTHORS
297
298	The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
299
300	=head1 COPYRIGHT
301
302	Project-Builder.org is distributed under the GPL v2.0 license
303	described in the file C<COPYING> included with the distribution.
304
305	=cut
306
307	# ---------------------------------------------------------------------------
308
309	# Old syntax
310	#getopts('a:fhi:l:m:P:p:qr:s:vV:',\%opts);
311
312	my ($projectbuilderver,$projectbuilderrev) = pb_version_init();
313
314	# Initialize the syntax string
315
316	pb_syntax_init("pb (aka project-builder.org) Version $projectbuilderver-$projectbuilderrev\n");
317
318	GetOptions("help\|?\|h" => \$opts{'h'},
319	"man" => \$opts{'man'},
320	"verbose\|v+" => \$opts{'v'},
321	"quiet\|q" => \$opts{'q'},
322	"log-files\|l=s" => \$opts{'l'},
323	"force\|f" => \$opts{'f'},
324	"account\|a=s" => \$opts{'a'},
325	"revision\|r=s" => \$opts{'r'},
326	"script\|s=s" => \$opts{'s'},
327	"machines\|mock\|m=s" => \$opts{'m'},
328	"port\|P=i" => \$opts{'P'},
329	"project\|p=s" => \$opts{'p'},
330	"iso\|i=s" => \$opts{'i'},
331	"version\|V=s" => \$opts{'V'},
332	) \|\| pb_syntax(-1,0);
333
334	if (defined $opts{'h'}) {
335	pb_syntax(0,1);
336	}
337	if (defined $opts{'man'}) {
338	pb_syntax(0,2);
339	}
340	if (defined $opts{'v'}) {
341	$pbdebug = $opts{'v'};
342	}
343	if (defined $opts{'f'}) {
344	$force=1;
345	}
346	if (defined $opts{'q'}) {
347	$pbdebug=-1;
348	}
349	if (defined $opts{'l'}) {
350	open(pbLOG,"> $opts{'l'}") \|\| die "Unable to log to $opts{'l'}: $!";
351	$pbLOG = \*pbLOG;
352	$pbdebug = 0 if ($pbdebug == -1);
353	}
354	pb_log_init($pbdebug, $pbLOG);
355	pb_display_init("text","");
356
357	# Handle root of the project if defined
358	if (defined $opts{'r'}) {
359	$ENV{'PBROOTDIR'} = $opts{'r'};
360	}
361	# Handle virtual machines if any
362	if (defined $opts{'m'}) {
363	$ENV{'PBV'} = $opts{'m'};
364	}
365	if (defined $opts{'s'}) {
366	$pbscript = $opts{'s'};
367	}
368	if (defined $opts{'a'}) {
369	$pbaccount = $opts{'a'};
370	die "option -a requires a -s script option" if (not defined $pbscript);
371	}
372	if (defined $opts{'P'}) {
373	$pbport = $opts{'P'};
374	}
375	if (defined $opts{'V'}) {
376	$newver = $opts{'V'};
377	}
378	if (defined $opts{'i'}) {
379	$iso = $opts{'i'};
380	}
381
382	# Get Action
383	$action = shift @ARGV;
384	die pb_syntax(-1,1) if (not defined $action);
385
386	my ($filteredfiles, $supfiles, $defpkgdir, $extpkgdir);
387	my $pbinit = undef;
388	$pbinit = 1 if ($action =~ /^newproj$/);
389
390	# Handles project name if any
391	# And get global params
392	($filteredfiles, $supfiles, $defpkgdir, $extpkgdir) = pb_env_init($opts{'p'},$pbinit,$action);
393
394	pb_log(0,"Project: $ENV{'PBPROJ'}\n");
395	pb_log(0,"Action: $action\n");
396
397	# Act depending on action
398	if ($action =~ /^cms2build$/) {
399	pb_cms2build();
400	} elsif ($action =~ /^build2pkg$/) {
401	pb_build2pkg();
402	} elsif ($action =~ /^cms2pkg$/) {
403	pb_cms2build();
404	pb_build2pkg();
405	} elsif ($action =~ /^build2ssh$/) {
406	pb_build2ssh();
407	} elsif ($action =~ /^cms2ssh$/) {
408	pb_cms2build();
409	pb_build2ssh();
410	} elsif ($action =~ /^pkg2ssh$/) {
411	pb_pkg2ssh();
412	} elsif ($action =~ /^build2ve$/) {
413	pb_build2v("ve");
414	} elsif ($action =~ /^build2vm$/) {
415	pb_build2v("vm");
416	} elsif ($action =~ /^cms2ve$/) {
417	pb_cms2build();
418	pb_build2v("ve");
419	} elsif ($action =~ /^cms2vm$/) {
420	pb_cms2build();
421	pb_build2v("vm");
422	} elsif ($action =~ /^launchvm$/) {
423	pb_launchv("vm",$ENV{'PBV'},0);
424	} elsif ($action =~ /^launchve$/) {
425	pb_launchv("ve",$ENV{'PBV'},0);
426	} elsif ($action =~ /^script2vm$/) {
427	pb_script2v($pbscript,"vm");
428	} elsif ($action =~ /^script2ve$/) {
429	pb_script2v($pbscript,"ve");
430	} elsif ($action =~ /^newver$/) {
431	pb_newver();
432	} elsif ($action =~ /^newve$/) {
433	pb_launchv("ve",$ENV{'PBV'},1);
434	} elsif ($action =~ /^newvm$/) {
435	pb_launchv("vm",$ENV{'PBV'},1);
436	} elsif ($action =~ /^setupve$/) {
437	pb_setup_v("ve");
438	} elsif ($action =~ /^setupvm$/) {
439	pb_setup_v("vm");
440	} elsif ($action =~ /^newproj$/) {
441	# Nothing to do - already done in pb_env_init
442	} elsif ($action =~ /^clean$/) {
443	# TBC
444	} elsif ($action =~ /^announce$/) {
445	pb_announce();
446	} else {
447	pb_log(0,"\'$action\' is not available\n");
448	pb_syntax(-2,1);
449	}
450
451	sub pb_cms2build {
452
453	my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
454	my @pkgs = @$pkg;
455	my %pkgs;
456
457	my ($scheme, $uri) = pb_cms_init($pbinit);
458
459	my ($pkgv, $pkgt) = pb_conf_get_if("pkgver","pkgtag");
460
461	# declare packager and repo for filtering
462	my ($tmp1, $tmp2) = pb_conf_get("pbpackager","pbrepo");
463	$ENV{'PBPACKAGER'} = $tmp1->{$ENV{'PBPROJ'}};
464	$ENV{'PBREPO'} = $tmp2->{$ENV{'PBPROJ'}};
465
466	foreach my $pbpkg (@pkgs) {
467	$ENV{'PBPKG'} = $pbpkg;
468	if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
469	$pbver = $pkgv->{$pbpkg};
470	} else {
471	$pbver = $ENV{'PBPROJVER'};
472	}
473	if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
474	$pbtag = $pkgt->{$pbpkg};
475	} else {
476	$pbtag = $ENV{'PBPROJTAG'};
477	}
478
479	$pbrev = $ENV{'PBREVISION'};
480	pb_log(0,"\n");
481	pb_log(0,"Management of $pbpkg $pbver-$pbtag (rev $pbrev)\n");
482	die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
483	# Clean up dest if necessary. The export will recreate it
484	my $dest = "$ENV{'PBDESTDIR'}/$pbpkg-$pbver";
485	pb_rm_rf($dest) if (-d $dest);
486
487	# Export CMS tree for the concerned package to dest
488	# And generate some additional files
489	$OUTPUT_AUTOFLUSH=1;
490
491	# computes in which dir we have to work
492	my $dir = $defpkgdir->{$pbpkg};
493	$dir = $extpkgdir->{$pbpkg} if (not defined $dir);
494	pb_log(2,"def:".Dumper($defpkgdir)." ext: ".Dumper($extpkgdir)." \n");
495
496	# Exporting from CMS
497	pb_cms_export($uri,"$ENV{'PBDIR'}/$dir",$dest);
498
499	# Generated fake content for test versions to speed up stuff
500	my ($testver) = pb_conf_get_if("testver");
501	my $chglog;
502
503	# Get project info on authors and log file
504	$chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
505	$chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
506	$chglog = undef if (! -f $chglog);
507
508	my $authors = "$ENV{'PBROOTDIR'}/$pbpkg/pbauthors";
509	$authors = "$ENV{'PBROOTDIR'}/pbauthors" if (! -f $authors);
510	$authors = "/dev/null" if (! -f $authors);
511
512	# Extract cms log history and store it
513	if ((defined $chglog) && (! -f "$dest/NEWS")) {
514	pb_log(2,"Generating NEWS file from $chglog\n");
515	copy($chglog,"$dest/NEWS") \|\| die "Unable to create $dest/NEWS";
516	}
517	pb_cms_log($scheme,"$ENV{'PBDIR'}/$dir",$dest,$chglog,$authors,$testver);
518
519	my %build;
520	my @pt;
521	my $tmpl = "";
522
523	@pt = pb_conf_get_if("vmlist","velist");
524	if (defined $pt[0]->{$ENV{'PBPROJ'}}) {
525	$tmpl .= $pt[0]->{$ENV{'PBPROJ'}};
526	}
527	if (defined $pt[1]->{$ENV{'PBPROJ'}}) {
528	# the 2 lists needs to be grouped with a ',' separated them
529	if ($tmpl ne "") {
530	$tmpl .= ",";
531	}
532	$tmpl .= $pt[1]->{$ENV{'PBPROJ'}}
533	}
534	foreach my $d (split(/,/,$tmpl)) {
535	my ($name,$ver,$arch) = split(/-/,$d);
536	chomp($arch);
537	my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($name,$ver);
538	pb_log(2,"DEBUG: distro tuple: ".Dumper($ddir, $dver, $dfam, $dtype, $pbsuf)."\n");
539	pb_log(2,"DEBUG Filtering PBDATE => $pbdate, PBTAG => $pbtag, PBVER => $pbver\n");
540
541	# Filter build files from the less precise up to the most with overloading
542	# Filter all files found, keeping the name, and generating in dest
543
544	# Find all build files first relatively to PBROOTDIR
545	# Find also all specific files referenced in the .pb conf file
546	my %bfiles = ();
547	my %pkgfiles = ();
548	$build{"$ddir-$dver"} = "yes";
549
550	if (-d "$ENV{'PBROOTDIR'}/$pbpkg/$dtype") {
551	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$dtype",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
552	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$dfam") {
553	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$dfam",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
554	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir") {
555	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
556	} elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver") {
557	pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
558	} else {
559	$build{"$ddir-$dver"} = "no";
560	next;
561	}
562	pb_log(2,"DEBUG bfiles: ".Dumper(\%bfiles)."\n");
563
564	# Get all filters to apply
565	my $ptr = pb_get_filters($pbpkg, $dtype, $dfam, $ddir, $dver);
566
567	# Prepare patches for this distro
568	my @patches;
569
570	foreach my $p (sort(<$ENV{'PBROOTDIR'}/$pbpkg/pbpatch/*>)) {
571	push @patches,$p if ($p =~ /\.all$/);
572	push @patches,$p if ($p =~ /\.$dtype$/);
573	push @patches,$p if ($p =~ /\.$dfam$/);
574	push @patches,$p if ($p =~ /\.$ddir$/);
575	push @patches,$p if ($p =~ /\.$ddir-$dver$/);
576	}
577
578	# Apply now all the filters on all the files concerned
579	# destination dir depends on the type of file
580	if (defined $ptr) {
581	foreach my $f (values %bfiles,values %pkgfiles) {
582	pb_filter_file_pb("$ENV{'PBROOTDIR'}/$f",$ptr,"$dest/pbconf/$ddir-$dver/".basename($f),$dtype,$pbsuf,$pbpkg,$pbver,$pbtag,$pbrev,$pbdate,$defpkgdir,$extpkgdir,$ENV{'PBPACKAGER'},$chglog,$ENV{'PBPROJ'},$ENV{'PBREPO'});
583	}
584	}
585	}
586	my @found;
587	my @notfound;
588	foreach my $b (keys %build) {
589	push @found,$b if ($build{$b} =~ /yes/);
590	push @notfound,$b if ($build{$b} =~ /no/);
591	}
592	pb_log(0,"Build files generated for ".join(',',sort(@found))."\n");
593	pb_log(0,"No Build files found for ".join(',',sort(@notfound))."\n") if (@notfound);
594	# Get the generic filter (all.pbf) and
595	# apply those to the non-build files including those
596	# generated by pbinit if applicable
597
598	# Get only all.pbf filter
599	my $ptr = pb_get_filters($pbpkg);
600
601	my $liste ="";
602	if (defined $filteredfiles->{$pbpkg}) {
603	foreach my $f (split(/,/,$filteredfiles->{$pbpkg})) {
604	pb_filter_file_inplace($ptr,"$dest/$f",$pbpkg,$pbver,$pbtag,$pbrev,$pbdate,$ENV{'PBPACKAGER'},$ENV{'PBPROJ'},$ENV{'PBREPO'});
605	$liste = "$f $liste";
606	}
607	}
608	pb_log(2,"Files ".$liste."have been filtered\n");
609
610	# Prepare the dest directory for archive
611	if (-x "$ENV{'PBROOTDIR'}/$pbpkg/pbinit") {
612	pb_filter_file("$ENV{'PBROOTDIR'}/$pbpkg/pbinit",$ptr,"$ENV{'PBTMP'}/pbinit",$pbpkg,$pbver,$pbtag,$pbrev,$pbdate,$ENV{'PBPACKAGER'},$ENV{'PBPROJ'},$ENV{'PBREPO'});
613	chmod 0755,"$ENV{'PBTMP'}/pbinit";
614	pb_system("cd $dest ; $ENV{'PBTMP'}/pbinit","Executing init script from $ENV{'PBROOTDIR'}/$pbpkg/pbinit","verbose");
615	}
616
617	# Filter potential patches
618	foreach my $p (sort(<$ENV{'PBROOTDIR'}/$pbpkg/pbpatch/*>)) {
619	pb_mkdir_p("$dest/pbconf/pbpatch");
620	pb_filter_file("$ENV{'PBROOTDIR'}/$pbpkg/pbpatch/$p",$ptr,"$dest/pbconf/pbpatch/$p",$pbpkg,$pbver,$pbtag,$pbrev,$pbdate,$ENV{'PBPACKAGER'},$ENV{'PBPROJ'},$ENV{'PBREPO'});
621	}
622
623	# Archive dest dir
624	chdir "$ENV{'PBDESTDIR'}" \|\| die "Unable to change dir to $ENV{'PBDESTDIR'}";
625	# Possibility to look at PBSRC to guess more the filename
626	pb_system("tar cfz $pbpkg-$pbver.tar.gz --exclude=$pbpkg-$pbver/pbconf $pbpkg-$pbver","Creating $pbpkg tar files compressed");
627	pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz\n");
628	pb_system("tar cfz $pbpkg-$pbver.pbconf.tar.gz $pbpkg-$pbver/pbconf","Creating pbconf tar files compressed");
629	pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz\n");
630
631	# Keep track of version-tag per pkg
632	$pkgs{$pbpkg} = "$pbver-$pbtag";
633
634	# Final cleanup
635	pb_rm_rf($dest) if (-d $dest);
636	}
637
638	# Keep track of per package version
639	pb_log(2,"DEBUG pkgs: ".Dumper(%pkgs)."\n");
640	open(PKG,"> $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb") \|\| die "Unable to create $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb";
641	foreach my $pbpkg (@pkgs) {
642	print PKG "pbpkg $pbpkg = $pkgs{$pbpkg}\n";
643	}
644	close(PKG);
645
646	# Keep track of what is generated by default
647	# We need to store the dir and info on version-tag
648	# Base our content on the existing .pb file
649	copy("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb","$ENV{'PBDESTDIR'}/pbrc");
650	open(LAST,">> $ENV{'PBDESTDIR'}/pbrc") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbrc";
651	print LAST "pbroot $ENV{'PBPROJ'} = $ENV{'PBROOTDIR'}\n";
652	print LAST "pbprojver $ENV{'PBPROJ'} = $ENV{'PBPROJVER'}\n";
653	print LAST "pbprojtag $ENV{'PBPROJ'} = $ENV{'PBPROJTAG'}\n";
654	print LAST "pbpackager $ENV{'PBPROJ'} = $ENV{'PBPACKAGER'}\n";
655	close(LAST);
656	}
657
658	sub pb_build2pkg {
659
660	# Get the running distro to build on
661	my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init();
662	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n");
663
664	# Get list of packages to build
665	# Get content saved in cms2build
666	my $ptr = pb_get_pkg();
667	@pkgs = @$ptr;
668
669	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
670	$pkg = { } if (not defined $pkg);
671
672	chdir "$ENV{'PBBUILDDIR'}";
673	my $made = ""; # pkgs made during build
674	foreach my $pbpkg (@pkgs) {
675	my $vertag = $pkg->{$pbpkg};
676	# get the version of the current package - maybe different
677	($pbver,$pbtag) = split(/-/,$vertag);
678
679	my $src="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz";
680	my $src2="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
681	pb_log(2,"Source file: $src\n");
682	pb_log(2,"Pbconf file: $src2\n");
683
684	pb_log(2,"Working directory: $ENV{'PBBUILDDIR'}\n");
685	if ($dtype eq "rpm") {
686	foreach my $d ('RPMS','SRPMS','SPECS','SOURCES','BUILD') {
687	if (! -d "$ENV{'PBBUILDDIR'}/$d") {
688	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";
689	}
690	}
691
692	# Remove in case a previous link/file was there
693	unlink "$ENV{'PBBUILDDIR'}/SOURCES/".basename($src);
694	symlink "$src","$ENV{'PBBUILDDIR'}/SOURCES/".basename($src) \|\| die "Unable to symlink $src in $ENV{'PBBUILDDIR'}/SOURCES";
695	# We need to first extract the spec file
696	my @specfile;
697	@specfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver/","$ENV{'PBBUILDDIR'}/SPECS");
698
699	# We need to handle potential patches to upstream sources
700
701	pb_log(2,"specfile: ".Dumper(\@specfile)."\n");
702	# set LANGUAGE to check for correct log messages
703	$ENV{'LANGUAGE'}="C";
704	# Older Redhat use _target_platform in %configure incorrectly
705	my $specialdef = "";
706	if (($ddir eq "redhat") \|\| (($ddir eq "rhel") && ($dver eq "2.1"))) {
707	$specialdef = "--define \'_target_platform \"\"\'";
708	}
709	foreach my $f (@specfile) {
710	if ($f =~ /\.spec$/) {
711	pb_system("rpmbuild $specialdef --define \'packager $ENV{'PBPACKAGER'}\' --define \"_topdir $ENV{'PBBUILDDIR'}\" -ba $f","Building package with $f under $ENV{'PBBUILDDIR'}","verbose");
712	last;
713	}
714	}
715	$made="$made RPMS//$pbpkg-$pbver-$pbtag$pbsuf..rpm SRPMS/$pbpkg-$pbver-$pbtag$pbsuf.src.rpm";
716	if (-f "/usr/bin/rpmlint") {
717	pb_system("rpmlint $made","Checking validity of rpms with rpmlint","verbose");
718	}
719	} elsif ($dtype eq "deb") {
720	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
721	pb_system("tar xfz $src","Extracting sources");
722	pb_system("tar xfz $src2","Extracting pbconf");
723
724	chdir "$pbpkg-$pbver" \|\| die "Unable to chdir to $pbpkg-$pbver";
725	pb_rm_rf("debian");
726	symlink "pbconf/$ddir-$dver","debian" \|\| die "Unable to symlink to pbconf/$ddir-$dver";
727	chmod 0755,"debian/rules";
728	if ($dver !~ /[0-9]/) {
729	# dpkg-deb doesn't accept non digit versions. removing checks
730	# dpkg-source checks upper case when generating perl modules
731	}
732	pb_system("dpkg-buildpackage -us -uc -rfakeroot","Building package");
733	$made="$made $pbpkg"."_.deb $pbpkg"."_.dsc $pbpkg"."_*.tar.gz";
734	if (-f "/usr/bin/lintian") {
735	pb_system("lintian $made","Checking validity of debs with lintian");
736	}
737	} elsif ($dtype eq "ebuild") {
738	my @ebuildfile;
739	# For gentoo we need to take pb as subsystem name
740	# We put every apps here under sys-apps. hope it's correct
741	# We use pb's home dir in order to have a single OVERLAY line
742	my $tmpd = "$ENV{'HOME'}/portage/pb/sys-apps/$pbpkg";
743	pb_mkdir_p($tmpd) if (! -d "$tmpd");
744	pb_mkdir_p("$ENV{'HOME'}/portage/distfiles") if (! -d "$ENV{'HOME'}/portage/distfiles");
745
746	# We need to first extract the ebuild file
747	@ebuildfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver/","$tmpd");
748
749	# Prepare the build env for gentoo
750	my $found = 0;
751	my $pbbd = $ENV{'HOME'};
752	$pbbd =~ s\|/\|\\/\|g;
753	if (-r "/etc/make.conf") {
754	open(MAKE,"/etc/make.conf");
755	while (<MAKE>) {
756	$found = 1 if (/$pbbd\/portage/);
757	}
758	close(MAKE);
759	}
760	if ($found == 0) {
761	pb_system("sudo sh -c 'echo PORTDIR_OVERLAY=\"$ENV{'HOME'}/portage\" >> /etc/make.conf'");
762	}
763	#$found = 0;
764	#if (-r "/etc/portage/package.keywords") {
765	#open(KEYW,"/etc/portage/package.keywords");
766	#while (<KEYW>) {
767	#$found = 1 if (/portage\/pb/);
768	#}
769	#close(KEYW);
770	#}
771	#if ($found == 0) {
772	#pb_system("sudo sh -c \"echo portage/pb >> /etc/portage/package.keywords\"");
773	#}
774
775	# Build
776	foreach my $f (@ebuildfile) {
777	if ($f =~ /\.ebuild$/) {
778	move($f,"$tmpd/$pbpkg-$pbver.ebuild");
779	pb_system("cd $tmpd ; ebuild $pbpkg-$pbver.ebuild clean ; ebuild $pbpkg-$pbver.ebuild digest ; ebuild $pbpkg-$pbver.ebuild package");
780	# Now move it where pb expects it
781	pb_mkdir_p("$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
782	move("$tmpd/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
783	}
784	}
785
786	$made="$made portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver.ebuild";
787	} elsif ($dtype eq "tgz") {
788	# Slackware family
789	$made="$made $pbpkg/$pbpkg-$pbver-*-$pbtag.tgz";
790
791	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
792	pb_system("tar xfz $src","Extracting sources");
793	pb_system("tar xfz $src2","Extracting pbconf");
794	chdir "$pbpkg-$pbver" \|\| die "Unable to chdir to $pbpkg-$pbver";
795	symlink "pbconf/$ddir-$dver","install" \|\| die "Unable to symlink to pbconf/$ddir-$dver";
796	if (-x "install/pbslack") {
797	pb_system("./install/pbslack","Building package");
798	pb_system("sudo /sbin/makepkg -p -l y -c y $pbpkg","Packaging $pbpkg");
799	}
800	} else {
801	die "Unknown dtype format $dtype";
802	}
803	}
804	# Keep track of what is generated so that we can get them back from VMs
805	open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to create $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
806	print KEEP "$made\n";
807	close(KEEP);
808	}
809
810	sub pb_build2ssh {
811	pb_send2target("Sources");
812	}
813
814	sub pb_pkg2ssh {
815	pb_send2target("Packages");
816	}
817
818	# By default deliver to the the public site hosting the
819	# ftp structure (or whatever) or a VM/VE
820	sub pb_send2target {
821
822	my $cmt = shift;
823	my $v = shift \|\| undef;
824	my $vmexist = shift \|\| 0; # 0 is FALSE
825	my $vmpid = shift \|\| 0; # 0 is FALSE
826
827	pb_log(2,"DEBUG: pb_send2target($cmt,".Dumper($v).",$vmexist,$vmpid)\n");
828	my $host = "sshhost";
829	my $login = "sshlogin";
830	my $dir = "sshdir";
831	my $port = "sshport";
832	my $conf = "sshconf";
833	my $rebuild = "sshrebuild";
834	my $tmout = "vmtmout";
835	my $path = "vmpath";
836	if (($cmt eq "vm") \|\| ($cmt eq "Script")) {
837	$login = "vmlogin";
838	$dir = "pbdefdir";
839	$tmout = "vmtmout";
840	$rebuild = "vmrebuild";
841	# Specific VM
842	$host = "vmhost";
843	$port = "vmport";
844	} elsif ($cmt eq "ve") {
845	$login = "velogin";
846	$dir = "pbdefdir";
847	$tmout = "vetmout";
848	# Specific VE
849	$path = "vepath";
850	$conf = "veconf";
851	$rebuild = "verebuild";
852	}
853	my $cmd = "";
854	my $src = "";
855	my ($odir,$over,$oarch) = (undef, undef, undef);
856	my ($ddir, $dver, $dfam, $dtype, $pbsuf);
857
858	if ($cmt ne "Announce") {
859	my $ptr = pb_get_pkg();
860	@pkgs = @$ptr;
861
862	# Get the running distro to consider
863	if (defined $v) {
864	($odir,$over,$oarch) = split(/-/,$v);
865	}
866	($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($odir,$over);
867	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n");
868
869	# Get list of packages to build
870	# Get content saved in cms2build
871	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
872	$pkg = { } if (not defined $pkg);
873
874	chdir "$ENV{'PBBUILDDIR'}";
875	foreach my $pbpkg (@pkgs) {
876	my $vertag = $pkg->{$pbpkg};
877	# get the version of the current package - maybe different
878	($pbver,$pbtag) = split(/-/,$vertag);
879
880	if (($cmt eq "Sources") \|\| ($cmt eq "vm") \|\| ($cmt eq "ve")) {
881	$src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
882	if ($cmd eq "") {
883	$cmd = "ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
884	} else {
885	$cmd = "$cmd ; ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
886	}
887	}
888	}
889	# Adds conf file for availability of conf elements
890	pb_conf_add("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb");
891	}
892
893	if (($cmt eq "vm") \|\| ($cmt eq "ve")) {
894	$src="$src $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc $ENV{'PBDESTDIR'}/pbscript";
895	} elsif ($cmt eq "Script") {
896	$src="$src $ENV{'PBDESTDIR'}/pbscript";
897	} elsif ($cmt eq "Announce") {
898	$src="$src $ENV{'PBTMP'}/pbscript";
899	} elsif ($cmt eq "Packages") {
900	# Get package list from file made during build2pkg
901	open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
902	$src = <KEEP>;
903	chomp($src);
904	close(KEEP);
905	$src="$src $ENV{'PBBUILDDIR'}/pbscript" if ($cmt ne "Sources");
906	}
907	# Remove potential leading spaces (cause problem with basename)
908	$src =~ s/^ *//;
909	my $basesrc = "";
910	foreach my $i (split(/ +/,$src)) {
911	$basesrc .= " ".basename($i);
912	}
913
914	pb_log(0,"Sources handled ($cmt): $src\n");
915	pb_log(2,"values: ".Dumper(($host,$login,$dir,$port,$tmout,$rebuild,$path,$conf))."\n");
916	my ($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vepath) = pb_conf_get($host,$login,$dir,$port,$tmout,$path);
917	my ($vrebuild,$veconf) = pb_conf_get_if($rebuild,$conf);
918	pb_log(2,"ssh: ".Dumper(($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vrebuild,$vepath,$veconf))."\n");
919	# Not mandatory
920	my ($testver) = pb_conf_get_if("testver");
921
922	my $mac;
923	# Useless for VE
924	if ($cmt ne "ve") {
925	$mac = "$sshlogin->{$ENV{'PBPROJ'}}\@$sshhost->{$ENV{'PBPROJ'}}";
926	# Overwrite account value if passed as parameter
927	$mac = "$pbaccount\@$sshhost->{$ENV{'PBPROJ'}}" if (defined $pbaccount);
928	pb_log(2, "DEBUG: pbaccount: $pbaccount => mac: $mac\n") if (defined $pbaccount);
929	}
930
931	my $tdir;
932	my $bdir;
933	if (($cmt eq "Sources") \|\| ($cmt eq "Script")) {
934	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/src";
935	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
936	# This is a test pkg => target dir is under test
937	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/test/src";
938	}
939	} elsif (($cmt eq "vm") \|\| ($cmt eq "ve")) {
940	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/delivery";
941	$bdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/build";
942	# Remove a potential $ENV{'HOME'} as bdir should be relative to pb's home
943	$bdir =~ s\|\$ENV.+\}/\|\|;
944	} elsif ($cmt eq "Announce") {
945	$tdir = "$sshdir->{$ENV{'PBPROJ'}}";
946	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
947	# This is a test pkg => target dir is under test
948	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/test";
949	}
950	} elsif ($cmt eq "Packages") {
951	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ddir/$dver";
952
953	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
954	# This is a test pkg => target dir is under test
955	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/test/$ddir/$dver";
956	}
957
958	my $repodir = $tdir;
959	$repodir =~ s\|^$sshdir->{$ENV{'PBPROJ'}}/\|\|;
960
961	my ($pbrepo) = pb_conf_get("pbrepo");
962
963	# Repository management
964	open(PBS,"> $ENV{'PBBUILDDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBBUILDDIR'}/pbscript";
965	if ($dtype eq "rpm") {
966	# Also make a pbscript to generate yum/urpmi bases
967	print PBS << "EOF";
968	#!/bin/bash
969	# Prepare a script to ease yum setup
970	cat > $ENV{'PBPROJ'}.repo << EOT
971	[$ENV{'PBPROJ'}]
972	name=$ddir $dver - $ENV{'PBPROJ'} Vanilla Packages
973	baseurl=$pbrepo->{$ENV{'PBPROJ'}}/$repodir
974	enabled=1
975	gpgcheck=0
976	EOT
977	chmod 644 $ENV{'PBPROJ'}.repo
978
979	# Clean up old repo content
980	rm -rf headers/ repodata/
981	# Create yum repo
982	yum-arch .
983	# Create repodata
984	createrepo .
985	EOF
986	if ($dfam eq "md") {
987	# For Mandriva add urpmi management
988	print PBS << "EOF";
989	# Prepare a script to ease urpmi setup
990	cat > $ENV{'PBPROJ'}.addmedia << EOT
991	urpmi.addmedia $ENV{'PBPROJ'} $pbrepo->{$ENV{'PBPROJ'}}/$repodir with hdlist.cz
992	EOT
993	chmod 755 $ENV{'PBPROJ'}.addmedia
994
995	# Clean up old repo content
996	rm -f hdlist.cz synthesis.hdlist.cz
997	# Create urpmi repo
998	genhdlist .
999	EOF
1000	}
1001	if ($ddir eq "fedora") {
1002	# Extract the spec file to please Fedora maintainers :-(
1003	print PBS << "EOF";
1004	for p in $basesrc; do
1005	echo \$p \| grep -q 'src.rpm'
1006	if [ \$\? -eq 0 ]; then
1007	rpm2cpio \$p \| cpio -ivdum --quiet '*.spec'
1008	fi
1009	done
1010	EOF
1011	}
1012	} elsif ($dtype eq "deb") {
1013	# Also make a pbscript to generate apt bases
1014	# Cf: http://www.debian.org/doc/manuals/repository-howto/repository-howto.fr.html
1015	my $rpd = dirname("$pbrepo->{$ENV{'PBPROJ'}}/$repodir");
1016	print PBS << "EOF";
1017	#!/bin/bash
1018	# Prepare a script to ease apt setup
1019	cat > $ENV{'PBPROJ'}.sources.list << EOT
1020	deb $rpd $dver contrib
1021	deb-src $rpd $dver contrib
1022	EOT
1023	chmod 644 $ENV{'PBPROJ'}.sources.list
1024
1025	# Prepare a script to create apt info file
1026	(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)
1027	#(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)
1028	EOF
1029	}
1030	close(PBS);
1031	chmod 0755,"$ENV{'PBBUILDDIR'}/pbscript";
1032
1033	} else {
1034	return;
1035	}
1036
1037	# Useless for VE
1038	my $nport;
1039	if ($cmt ne "ve") {
1040	$nport = $sshport->{$ENV{'PBPROJ'}};
1041	$nport = "$pbport" if (defined $pbport);
1042	}
1043
1044	# Remove a potential $ENV{'HOME'} as tdir should be relative to pb's home
1045	$tdir =~ s\|\$ENV.+\}/\|\|;
1046
1047	my $tm = $vtmout->{$ENV{'PBPROJ'}};
1048
1049	# ssh communication if not VE
1050	# should use a hash instead...
1051	my ($shcmd,$cpcmd,$cptarget,$cp2target);
1052	if ($cmt ne "ve") {
1053	my $keyfile = pb_ssh_get(0);
1054	$shcmd = "ssh -i $keyfile -q -o UserKnownHostsFile=/dev/null -p $nport $mac";
1055	$cpcmd = "scp -i $keyfile -p -o UserKnownHostsFile=/dev/null -P $nport";
1056	$cptarget = "$mac:$tdir";
1057	if ($cmt eq "vm") {
1058	$cp2target = "$mac:$bdir";
1059	}
1060	} else {
1061	my $tp = $vepath->{$ENV{'PBPROJ'}};
1062	$shcmd = "sudo chroot $tp/$v /bin/su - $sshlogin->{$ENV{'PBPROJ'}} -c ";
1063	$cpcmd = "cp -a ";
1064	$cptarget = "$tp/$tdir";
1065	$cp2target = "$tp/$bdir";
1066	}
1067
1068	my $logres = "";
1069	# Do not touch when just announcing
1070	if ($cmt ne "Announce") {
1071	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");
1072	} else {
1073	$logres = "> ";
1074	}
1075	pb_system("cd $ENV{'PBBUILDDIR'} ; $cpcmd $src $cptarget 2> /dev/null","$cmt delivery in $cptarget");
1076
1077	# For VE we need to change the owner manually - To be tested if needed
1078	#if ($cmt eq "ve") {
1079	#pb_system("cd $cptarget ; sudo chown -R $sshlogin->{$ENV{'PBPROJ'}} .","$cmt chown in $cptarget to $sshlogin->{$ENV{'PBPROJ'}}");
1080	#}
1081	pb_system("$shcmd \"echo \'cd $tdir ; if [ -f pbscript ]; then ./pbscript; fi ; rm -f ./pbscript\' \| bash\"","Executing pbscript on $cptarget if needed","verbose");
1082	if (($cmt eq "vm") \|\| ($cmt eq "ve")) {
1083	# Get back info on pkg produced, compute their name and get them from the VM
1084	pb_system("$cpcmd $cp2target/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'} $ENV{'PBBUILDDIR'} 2> /dev/null","Get package names in $cp2target");
1085	open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1086	my $src = <KEEP>;
1087	chomp($src);
1088	close(KEEP);
1089	$src =~ s/^ *//;
1090	pb_mkdir_p("$ENV{'PBBUILDDIR'}/$odir/$over");
1091	# Change pgben to make the next send2target happy
1092	my $made = "";
1093	open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to write $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1094	foreach my $p (split(/ +/,$src)) {
1095	my $j = basename($p);
1096	pb_system("$cpcmd $cp2target/\'$p\' $ENV{'PBBUILDDIR'}/$odir/$over 2> /dev/null","Package recovery of $j in $cp2target");
1097	$made="$made $odir/$over/$j" if (($dtype ne "rpm") \|\| ($j !~ /.src.rpm$/));
1098	}
1099	print KEEP "$made\n";
1100	close(KEEP);
1101	pb_system("$shcmd \"rm -rf $tdir $bdir\"","$cmt cleanup");
1102
1103	# We want to send them to the ssh account so overwrite what has been done before
1104	undef $pbaccount;
1105	pb_log(2,"Before sending pkgs, vmexist: $vmexist, vmpid: $vmpid\n");
1106	pb_send2target("Packages",$odir."-".$over."-".$oarch,$vmexist,$vmpid);
1107	pb_rm_rf("$ENV{'PBBUILDDIR'}/$odir");
1108	}
1109	pb_log(2,"Before halt, vmexist: $vmexist, vmpid: $vmpid\n");
1110	if ((! $vmexist) && (($cmt eq "vm") \|\| ($cmt eq "Script"))) {
1111	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)");
1112	}
1113	}
1114
1115	sub pb_script2v {
1116	my $pbscript=shift;
1117	my $vtype=shift;
1118	my $force=shift \|\| 0; # Force stop of VM. Default not
1119	my $vm1=shift \|\| undef; # Only that VM to treat
1120	my $vm;
1121	my $all;
1122
1123	pb_log(2,"DEBUG: pb_script2v($pbscript,$vtype,$force,$vm1)\n");
1124	# Prepare the script to be executed on the VM
1125	# in $ENV{'PBDESTDIR'}/pbscript
1126	if ((defined $pbscript ) && ($pbscript ne "$ENV{'PBDESTDIR'}/pbscript")) {
1127	copy($pbscript,"$ENV{'PBDESTDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
1128	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
1129	}
1130
1131	if (not defined $vm1) {
1132	($vm,$all) = pb_get_v($vtype);
1133	} else {
1134	@$vm = ($vm1);
1135	}
1136	my ($vmexist,$vmpid) = (undef,undef);
1137
1138	foreach my $v (@$vm) {
1139	# Launch the VM/VE
1140	if ($vtype eq "vm") {
1141	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1142	pb_log(2,"DEBUG: After pb_launchv, vmexist: $vmexist, vmpid: $vmpid\n");
1143
1144	# Skip that VM if something went wrong
1145	next if (($vmpid == 0) && ($vmexist == 0));
1146
1147	# If force stopping the VM then reset vmexist
1148	if ($force == 1) {
1149	$vmpid = $vmexist;
1150	$vmexist = 0;
1151	}
1152	}
1153
1154	# Gather all required files to send them to the VM
1155	# and launch the build through pbscript
1156	pb_log(2,"DEBUG: Before send2target, vmexist: $vmexist, vmpid: $vmpid\n");
1157	pb_send2target("Script","$v",$vmexist,$vmpid);
1158
1159	}
1160	}
1161
1162	sub pb_launchv {
1163	my $vtype = shift;
1164	my $v = shift;
1165	my $create = shift \|\| 0; # By default do not create a VM
1166
1167	pb_log(2,"DEBUG: pb_launchv($vtype,$v,$create)\n");
1168	die "No VM/VE defined, unable to launch" if (not defined $v);
1169	# Keep only the first VM in case many were given
1170	$v =~ s/,.*//;
1171
1172	# Which is our local arch ? (standardize on i386 for those platforms)
1173	my $arch = `uname -m`;
1174	chomp($arch);
1175	$arch =~ s/i.86/i386/;
1176
1177	# Launch the VMs/VEs
1178	if ($vtype eq "vm") {
1179	die "-i iso parameter needed" if (((not defined $iso) \|\| ($iso eq "")) && ($create != 0));
1180
1181	my ($ptr,$vmopt,$vmpath,$vmport,$vmtmout,$vmsize) = pb_conf_get("vmtype","vmopt","vmpath","vmport","vmtmout","vmsize");
1182
1183	my $vmtype = $ptr->{$ENV{'PBPROJ'}};
1184	if (not defined $ENV{'PBVMOPT'}) {
1185	$ENV{'PBVMOPT'} = "";
1186	}
1187	# Set a default timeout of 2 minutes
1188	if (not defined $ENV{'PBVMTMOUT'}) {
1189	$ENV{'PBVMTMOUT'} = "120";
1190	}
1191	if (defined $vmopt->{$v}) {
1192	$ENV{'PBVMOPT'} .= " $vmopt->{$v}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$v}/);
1193	} elsif (defined $vmopt->{$ENV{'PBPROJ'}}) {
1194	$ENV{'PBVMOPT'} .= " $vmopt->{$ENV{'PBPROJ'}}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$ENV{'PBPROJ'}}/);
1195	}
1196	if (defined $vmtmout->{$v}) {
1197	$ENV{'PBVMTMOUT'} = $vmtmout->{$v};
1198	} elsif (defined $vmtmout->{$ENV{'PBPROJ'}}) {
1199	$ENV{'PBVMTMOUT'} = $vmtmout->{$ENV{'PBPROJ'}};
1200	}
1201	my $nport = $vmport->{$ENV{'PBPROJ'}};
1202	$nport = "$pbport" if (defined $pbport);
1203
1204	my $cmd;
1205	my $vmcmd; # has to be used for pb_check_ps
1206	my $vmm; # has to be used for pb_check_ps
1207	if ($vmtype eq "qemu") {
1208	my $qemucmd32;
1209	my $qemucmd64;
1210	if ($arch eq "x86_64") {
1211	$qemucmd32 = "/usr/bin/qemu-system-i386";
1212	$qemucmd64 = "/usr/bin/qemu";
1213	} else {
1214	$qemucmd32 = "/usr/bin/qemu";
1215	$qemucmd64 = "/usr/bin/qemu-system-x86_64";
1216	}
1217	if ($v =~ /x86_64/) {
1218	$vmcmd = "$qemucmd64 -no-kqemu";
1219	} else {
1220	$vmcmd = "$qemucmd32";
1221	}
1222	$vmm = "$vmpath->{$ENV{'PBPROJ'}}/$v.qemu";
1223	if ($create != 0) {
1224	$ENV{'PBVMOPT'} .= " -cdrom $iso -boot d";
1225	}
1226	$cmd = "$vmcmd $ENV{'PBVMOPT'} -redir tcp:$nport:10.0.2.15:22 $vmm"
1227	} elsif ($vmtype eq "xen") {
1228	} elsif ($vmtype eq "vmware") {
1229	} else {
1230	die "VM of type $vmtype not supported. Report to the dev team";
1231	}
1232	my ($tmpcmd,$void) = split(/ +/,$cmd);
1233	my $vmexist = pb_check_ps($tmpcmd,$vmm);
1234	my $vmpid = 0;
1235	if (! $vmexist) {
1236	if ($create != 0) {
1237	if (($vmtype eq "qemu") \|\| ($vmtype eq "xen")) {
1238	pb_system("/usr/bin/qemu-img create -f qcow2 $vmm $vmsize->{$ENV{'PBPROJ'}}","Creating the QEMU VM");
1239	} elsif ($vmtype eq "vmware") {
1240	} else {
1241	}
1242	}
1243	if (! -f "$vmm") {
1244	pb_log(0,"Unable to find VM $vmm\n");
1245	} else {
1246	pb_system("$cmd &","Launching the VM $vmm");
1247	pb_system("sleep $ENV{'PBVMTMOUT'}","Waiting $ENV{'PBVMTMOUT'} s for VM $v to come up");
1248	$vmpid = pb_check_ps($tmpcmd,$vmm);
1249	pb_log(0,"VM $vmm launched (pid $vmpid)\n");
1250	}
1251	} else {
1252	pb_log(0,"Found an existing VM $vmm (pid $vmexist)\n");
1253	}
1254	pb_log(2,"DEBUG: pb_launchv returns ($vmexist,$vmpid)\n");
1255	return($vmexist,$vmpid);
1256	# VE here
1257	} else {
1258	# Get VE context
1259	my ($ptr,$vetmout,$vepath,$verebuild,$veconf) = pb_conf_get("vetype","vetmout","vepath","verebuild","veconf");
1260	my $vetype = $ptr->{$ENV{'PBPROJ'}};
1261
1262	# Get distro context
1263	my ($name,$ver,$darch) = split(/-/,$v);
1264	chomp($darch);
1265	my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($name,$ver);
1266
1267	if ($vetype eq "chroot") {
1268	# Architecture consistency
1269	if ($arch ne $darch) {
1270	die "Unable to launch a VE of architecture $darch on a $arch platform" if (not (($darch eq "x86_64") && ($arch =~ /i?86/)));
1271	}
1272
1273	if (($create != 0) \|\| ($verebuild->{$ENV{'PBPROJ'}} eq "true") \|\| ($force == 1)) {
1274	# We have to rebuild the chroot
1275	if ($dtype eq "rpm") {
1276	pb_system("sudo /usr/sbin/mock --init --resultdir=\"/tmp\" --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" -r $v","Creating the mock VE");
1277	# Once setup we need to install some packages, the pb account, ...
1278	pb_system("sudo /usr/sbin/mock --install --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" -r $v su","Configuring the mock VE");
1279	#pb_system("sudo /usr/sbin/mock --init --resultdir=\"/tmp\" --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" --basedir=\"$vepath->{$ENV{'PBPROJ'}}\" -r $v","Creating the mock VE");
1280	} elsif ($dtype eq "deb") {
1281	pb_system("","Creating the pbuilder VE");
1282	} elsif ($dtype eq "ebuild") {
1283	die "Please teach the dev team how to build gentoo chroot";
1284	} else {
1285	die "Unknown distribution type $dtype. Report to dev team";
1286	}
1287	}
1288	# Nothing more to do for VE. No real launch
1289	} else {
1290	die "VE of type $vetype not supported. Report to the dev team";
1291	}
1292	}
1293	}
1294
1295	sub pb_build2v {
1296
1297	my $vtype = shift;
1298
1299	# Prepare the script to be executed on the VM/VE
1300	# in $ENV{'PBDESTDIR'}/pbscript
1301	#my ($ntp) = pb_conf_get($vtype."ntp");
1302	#my $vntp = $ntp->{$ENV{'PBPROJ'}};
1303
1304	open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
1305	print SCRIPT "#!/bin/bash\n";
1306	print SCRIPT "echo ... Execution needed\n";
1307	print SCRIPT "# This is in directory delivery\n";
1308	print SCRIPT "# Setup the variables required for building\n";
1309	print SCRIPT "export PBPROJ=$ENV{'PBPROJ'}\n";
1310	print SCRIPT "# Preparation for pb\n";
1311	print SCRIPT "mv .pbrc \$HOME\n";
1312	print SCRIPT "cd ..\n";
1313	# Force new date to be in the future compared to the date of the tar file by adding 1 minute
1314	my @date=pb_get_date();
1315	$date[1]++;
1316	my $upddate = strftime("%m%d%H%M%Y", @date);
1317	#print SCRIPT "echo Setting up date on $vntp...\n";
1318	# Or use ntpdate if available TBC
1319	print SCRIPT "sudo date $upddate\n";
1320	# Get list of packages to build and get some ENV vars as well
1321	my $ptr = pb_get_pkg();
1322	@pkgs = @$ptr;
1323	my $p = join(' ',@pkgs) if (@pkgs);
1324	print SCRIPT "export PBPROJVER=$ENV{'PBPROJVER'}\n";
1325	print SCRIPT "export PBPROJTAG=$ENV{'PBPROJTAG'}\n";
1326	print SCRIPT "export PBPACKAGER=\"$ENV{'PBPACKAGER'}\"\n";
1327	print SCRIPT "# Build\n";
1328	print SCRIPT "echo Building packages on $vtype...\n";
1329	print SCRIPT "pb -p $ENV{'PBPROJ'} build2pkg $p\n";
1330	close(SCRIPT);
1331	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
1332
1333	my ($v,$all) = pb_get_v($vtype);
1334
1335	# Send tar files when we do a global generation
1336	pb_build2ssh() if ($all == 1);
1337
1338	my ($vmexist,$vmpid) = (undef,undef);
1339
1340	foreach my $v (@$v) {
1341	if ($vtype eq "vm") {
1342	# Launch the VM
1343	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1344
1345	# Skip that VM if it something went wrong
1346	next if (($vmpid == 0) && ($vmexist == 0));
1347	}
1348	# Gather all required files to send them to the VM/VE
1349	# and launch the build through pbscript
1350	pb_log(2,"Calling send2target $vtype,$v,$vmexist,$vmpid\n");
1351	pb_send2target($vtype,"$v",$vmexist,$vmpid);
1352	}
1353	}
1354
1355
1356	sub pb_newver {
1357
1358	die "-V Version parameter needed" if ((not defined $newver) \|\| ($newver eq ""));
1359
1360	# Need this call for PBDIR
1361	my ($scheme2,$uri) = pb_cms_init($pbinit);
1362
1363	my ($pbconf) = pb_conf_get("pbconfurl");
1364	$uri = $pbconf->{$ENV{'PBPROJ'}};
1365	my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);
1366
1367	# Checking CMS repositories status
1368	my ($pburl) = pb_conf_get("pburl");
1369	($scheme2, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}});
1370
1371	if ($scheme !~ /^svn/) {
1372	die "Only SVN is supported at the moment";
1373	}
1374
1375	my $res = pb_cms_isdiff($scheme,$ENV{'PBROOTDIR'});
1376	die "ERROR: No differences accepted in CMS for $ENV{'PBROOTDIR'} before creating a new version" if ($res != 0);
1377
1378	$res = pb_cms_isdiff($scheme2,$ENV{'PBDIR'});
1379	die "ERROR: No differences accepted in CMS for $ENV{'PBDIR'} before creating a new version" if ($res != 0);
1380
1381	# Tree identical between PBCONFDIR and PBROOTDIR. The delta is what
1382	# we want to get for the root of the new URL
1383
1384	my $tmp = $ENV{'PBROOTDIR'};
1385	$tmp =~ s\|^$ENV{'PBCONFDIR'}\|\|;
1386
1387	my $newurl = "$uri/".dirname($tmp)."/$newver";
1388	# Should probably use projver in the old file
1389	my $oldver= basename($tmp);
1390
1391	# Duplicate and extract project-builder part
1392	pb_log(2,"Copying $uri/$tmp to $newurl\n");
1393	pb_cms_copy($scheme,"$uri/$tmp",$newurl);
1394	pb_log(2,"Checkout $newurl to $ENV{'PBROOTDIR'}/../$newver\n");
1395	pb_cms_up($scheme,"$ENV{'PBCONFDIR'}/..");
1396
1397	# Duplicate and extract project
1398	my $newurl2 = "$pburl->{$ENV{'PBPROJ'}}/".dirname($tmp)."/$newver";
1399
1400	pb_log(2,"Copying $pburl->{$ENV{'PBPROJ'}}/$tmp to $newurl2\n");
1401	pb_cms_copy($scheme,"$pburl->{$ENV{'PBPROJ'}}/$tmp",$newurl2);
1402	pb_log(2,"Checkout $newurl2 to $ENV{'PBDIR'}/../$newver\n");
1403	pb_cms_up($scheme,"$ENV{'PBDIR'}/..");
1404
1405	# Update the .pb file
1406	open(FILE,"$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb") \|\| die "Unable to open $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb";
1407	open(OUT,"> $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new") \|\| die "Unable to write to $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new";
1408	while(<FILE>) {
1409	s/^projver\s+$ENV{'PBPROJ'}\s=\s$oldver/projver $ENV{'PBPROJ'} = $newver/;
1410	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/);
1411	s/^testver/#testver/;
1412	pb_log(0,"Commenting testver in $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb\n") if (/^testver/);
1413	print OUT $_;
1414	}
1415	close(FILE);
1416	close(OUT);
1417	rename("$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new","$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb");
1418
1419	# Checking pbcl files
1420	foreach my $f (<$ENV{'PBROOTDIR'}/*/pbcl>) {
1421	open(PBCL,$f) \|\| die "Unable to open $f";
1422	my $foundnew = 0;
1423	while (<PBCL>) {
1424	$foundnew = 1 if (/^$newver \(/);
1425	}
1426	close(PBCL);
1427	open(OUT,"> $f.new") \|\| die "Unable to write to $f.new: $!";
1428	open(PBCL,$f) \|\| die "Unable to open $f";
1429	while (<PBCL>) {
1430	print OUT "$_" if (not /^$oldver \(/);
1431	if ((/^$oldver \(/) && ($foundnew == 0)) {
1432	print OUT "$newver ($pbdate)\n";
1433	print OUT "- TBD\n";
1434	print OUT "\n";
1435	pb_log(0,"WARNING: version $newver not found in $f so added...") if ($foundnew == 0);
1436	}
1437	}
1438	close(OUT);
1439	close(PBCL);
1440	rename("$f.new","$f");
1441	}
1442
1443	pb_log(2,"Checkin $ENV{'PBROOTDIR'}/../$newver\n");
1444	pb_cms_checkin($scheme,"$ENV{'PBROOTDIR'}/../$newver",undef);
1445	}
1446
1447	#
1448	# Return the list of VMs/VEs we are working on
1449	# $all is a flag to know if we return all of them
1450	# or only some (if all we publish also tar files in addition to pkgs
1451	#
1452	sub pb_get_v {
1453
1454	my $vtype = shift;
1455	my @v;
1456	my $all = 0;
1457	my $vlist;
1458	my $pbv = 'PBV';
1459
1460	if ($vtype eq "vm") {
1461	$vlist = "vmlist";
1462	} elsif ($vtype eq "ve") {
1463	$vlist = "velist";
1464	}
1465	# Get VM/VE list
1466	if ((not defined $ENV{$pbv}) \|\| ($ENV{$pbv} =~ /^all$/)) {
1467	my ($ptr) = pb_conf_get($vlist);
1468	$ENV{$pbv} = $ptr->{$ENV{'PBPROJ'}};
1469	$all = 1;
1470	}
1471	pb_log(2,"$vtype: $ENV{$pbv}\n");
1472	@v = split(/,/,$ENV{$pbv});
1473	return(\@v,$all);
1474	}
1475
1476	# Function to create a potentialy missing pb account on the VM/VE, and adds it to sudo
1477	# Needs to use root account to connect to the VM/VE
1478	# pb will take your local public SSH key to access
1479	# the pb account in the VM later on if needed
1480	sub pb_setup_v {
1481
1482	my $vtype = shift;
1483
1484	my ($vm,$all) = pb_get_v($vtype);
1485
1486	# Script generated
1487	my $pbscript = "$ENV{'PBDESTDIR'}/setupv";
1488
1489	foreach my $v (@$vm) {
1490	# Name of the account to deal with for VM/VE
1491	# Do not use the one passed potentially with -a
1492	my ($pbac) = pb_conf_get($vtype."login");
1493	my ($key,$zero0,$zero1,$zero2);
1494	my ($vmexist,$vmpid);
1495
1496	if ($vtype eq "vm") {
1497	# Prepare the key to be used and transfered remotely
1498	my $keyfile = pb_ssh_get(1);
1499
1500	my ($vmhost,$vmport) = pb_conf_get("vmhost","vmport");
1501	my $nport = $vmport->{$ENV{'PBPROJ'}};
1502	$nport = "$pbport" if (defined $pbport);
1503
1504	# Launch the VM
1505	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1506
1507	# Skip that VM if something went wrong
1508	next if (($vmpid == 0) && ($vmexist == 0));
1509
1510	# Store the pub key part in a variable
1511	open(FILE,"$keyfile.pub") \|\| die "Unable to open $keyfile.pub";
1512	($zero0,$zero1,$zero2) = split(/ /,<FILE>);
1513	close(FILE);
1514
1515	$key = "\Q$zero1";
1516
1517	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 will require the root password");
1518	# once this is done, we can do what we want on the VM remotely
1519	}
1520
1521	# Prepare the script to be executed on the VM/VE
1522	# in $ENV{'PBDESTDIR'}/setupv
1523
1524	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
1525	print SCRIPT << 'EOF';
1526	#!/usr/bin/perl -w
1527
1528	use strict;
1529	use File::Copy;
1530
1531	our $pbdebug;
1532	our $pbLOG;
1533	our $pbsynmsg = "pbscript";
1534	pb_log_init($pbdebug, $pbLOG);
1535	pb_temp_init();
1536
1537	EOF
1538	if ($vtype eq "vm") {
1539	print SCRIPT << 'EOF';
1540	# Removes duplicate in .ssh/authorized_keys of our key if needed
1541	#
1542	my $file1="$ENV{'HOME'}/.ssh/authorized_keys";
1543	open(PBFILE,$file1) \|\| die "Unable to open $file1";
1544	open(PBOUT,"> $file1.new") \|\| die "Unable to open $file1.new";
1545	my $count = 0;
1546	while (<PBFILE>) {
1547	EOF
1548	print SCRIPT << "EOF";
1549	if (/ $key /) {
1550	\$count++;
1551	}
1552	print PBOUT \$_ if ((\$count <= 1) \|\| (\$_ !~ / $key /));
1553	}
1554	close(PBFILE);
1555	close(PBOUT);
1556	rename("\$file1.new",\$file1);
1557	chmod 0600,\$file1;
1558	EOF
1559	}
1560	print SCRIPT << 'EOF';
1561
1562	# Adds $pbac->{$ENV{'PBPROJ'}} as an account if needed
1563	#
1564	my $file="/etc/passwd";
1565	open(PBFILE,$file) \|\| die "Unable to open $file";
1566	my $found = 0;
1567	while (<PBFILE>) {
1568	EOF
1569	print SCRIPT << "EOF";
1570	\$found = 1 if (/^$pbac->{$ENV{'PBPROJ'}}:/);
1571	EOF
1572	print SCRIPT << 'EOF';
1573	}
1574	close(PBFILE);
1575
1576	if ( $found == 0 ) {
1577	if ( ! -d "/home" ) {
1578	pb_mkdir("/home");
1579	}
1580	EOF
1581	print SCRIPT << "EOF";
1582	pb_system("groupadd $pbac->{$ENV{'PBPROJ'}}","Adding group $pbac->{$ENV{'PBPROJ'}}");
1583	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'}}");
1584	}
1585
1586	# allow ssh entry to build
1587	#
1588	mkdir "/home/$pbac->{$ENV{'PBPROJ'}}/.ssh",0700;
1589	# Allow those accessing root to access the build account
1590	copy("\$ENV{'HOME'}/.ssh/authorized_keys","/home/$pbac->{$ENV{'PBPROJ'}}/.ssh/authorized_keys");
1591	chmod 0600,".ssh/authorized_keys";
1592	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'}}");
1593
1594	EOF
1595	print SCRIPT << 'EOF';
1596	# No passwd for build account only keys
1597	$file="/etc/shadow";
1598	open(PBFILE,$file) \|\| die "Unable to open $file";
1599	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
1600	while (<PBFILE>) {
1601	EOF
1602	print SCRIPT << "EOF";
1603	s/^$pbac->{$ENV{'PBPROJ'}}:\!\!:/$pbac->{$ENV{'PBPROJ'}}:*:/;
1604	s/^$pbac->{$ENV{'PBPROJ'}}:\!:/$pbac->{$ENV{'PBPROJ'}}:*:/; #SLES 9 e.g.
1605	EOF
1606	print SCRIPT << 'EOF';
1607	print PBOUT $_;
1608	}
1609	close(PBFILE);
1610	close(PBOUT);
1611	rename("$file.new",$file);
1612	chmod 0640,$file;
1613
1614	# Keep the VM in text mode
1615	$file="/etc/inittab";
1616	if (-f $file) {
1617	open(PBFILE,$file) \|\| die "Unable to open $file";
1618	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
1619	while (<PBFILE>) {
1620	s/^(..):5:initdefault:$/$1:3:initdefault:/;
1621	print PBOUT $_;
1622	}
1623	close(PBFILE);
1624	close(PBOUT);
1625	rename("$file.new",$file);
1626	chmod 0640,$file;
1627	}
1628
1629	# pb has to be added to portage group on gentoo
1630
1631	# Adapt sudoers
1632	$file="/etc/sudoers";
1633	open(PBFILE,$file) \|\| die "Unable to open $file";
1634	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
1635	while (<PBFILE>) {
1636	EOF
1637	print SCRIPT << "EOF";
1638	next if (/^$pbac->{$ENV{'PBPROJ'}} /);
1639	EOF
1640	print SCRIPT << 'EOF';
1641	s/Defaults[ \t]+requiretty//;
1642	print PBOUT $_;
1643	}
1644	close(PBFILE);
1645	EOF
1646	print SCRIPT << "EOF";
1647	# This is needed in order to be able to halt the machine from the $pbac->{$ENV{'PBPROJ'}} account at least
1648	print PBOUT "$pbac->{$ENV{'PBPROJ'}} ALL=(ALL) NOPASSWD:ALL\n";
1649	EOF
1650	print SCRIPT << 'EOF';
1651	close(PBOUT);
1652	rename("$file.new",$file);
1653	chmod 0440,$file;
1654
1655	EOF
1656
1657	my $SCRIPT = \*SCRIPT;
1658
1659	pb_install_deps($SCRIPT);
1660
1661	print SCRIPT << 'EOF';
1662	# Suse wants sudoers as 640
1663	if (($ddir eq "sles") \|\| (($ddir eq "suse")) && ($dver ne "10.3")) {
1664	chmod 0640,$file;
1665	}
1666
1667	# Sync date
1668	#system "/usr/sbin/ntpdate ntp.pool.org";
1669
1670	pb_system("rm -rf perl-ProjectBuilder-* ; wget --passive-ftp ftp://ftp.mondorescue.org/src/perl-ProjectBuilder-latest.tar.gz ; tar xvfz perl-ProjectBuilder-latest.tar.gz ; cd perl-ProjectBuilder-* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf perl-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");
1671	system "pb 2>&1 \| head -5";
1672	EOF
1673	# Adds pb_distro_init from ProjectBuilder::Distribution
1674	foreach my $d (@INC) {
1675	my @f = ("$d/ProjectBuilder/Base.pm","$d/ProjectBuilder/Distribution.pm");
1676	foreach my $f (@f) {
1677	if (-f "$f") {
1678	open(PBD,"$f") \|\| die "Unable to open $f";
1679	while (<PBD>) {
1680	next if (/^package/);
1681	next if (/^use Exporter/);
1682	next if (/^use ProjectBuilder::/);
1683	next if (/^our /);
1684	print SCRIPT $_;
1685	}
1686	close(PBD);
1687	}
1688	}
1689	}
1690	close(SCRIPT);
1691	chmod 0755,"$pbscript";
1692
1693	# That build script needs to be run as root and force stop of VM at end
1694	$pbaccount = "root";
1695
1696	# Force shutdown of VM exept if it was already launched
1697	my $force = 0;
1698	if ((! $vmexist) && ($vtype eq "vm")) {
1699	$force = 1;
1700	}
1701
1702	pb_script2v($pbscript,$vtype,$force,$v);
1703	}
1704	return;
1705	}
1706
1707	sub pb_install_deps {
1708
1709	my $SCRIPT = shift;
1710
1711	print {$SCRIPT} << 'EOF';
1712	# We need to have that pb_distro_init function
1713	# Get it from Project-Builder::Distribution
1714	my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init();
1715	print "distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n";
1716
1717	# Get and install pb
1718	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*";
1719	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*";
1720	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*";
1721	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*";
1722	my $cmtdm = "Installing Date-Manip perl module";
1723	my $cmtmb = "Installing Module-Build perl module";
1724	my $cmtfm = "Installing File-MimeInfo perl module";
1725	my $cmtfb = "Installing File-Basedir perl module";
1726	my $cmtall = "Installing required modules";
1727
1728	if ( $ddir eq "fedora" ) {
1729	pb_system("yum clean all","Cleaning yum env");
1730	#system "yum update -y";
1731	my $arch=`uname -m`;
1732	my $opt = "";
1733	chomp($arch);
1734	if ($arch eq "x86_64") {
1735	$opt="--exclude=*.i?86";
1736	}
1737
1738	pb_system("yum -y $opt install rpm-build wget patch ntp sudo perl-DateManip perl-File-MimeInfo perl-ExtUtils-MakeMaker",$cmtall);
1739	if ($dver eq 4) {
1740	pb_system("$insmb","$cmtmb");
1741	pb_system("$insfm","$cmtfm");
1742	pb_system("$insfb","$cmtfb");
1743	}
1744	} elsif (( $dfam eq "rh" ) \|\| ($ddir eq "sles") \|\| (($ddir eq "suse") && (($dver eq "10.1") \|\| ($dver eq "10.0"))) \|\| ($ddir eq "slackware")) {
1745	# Suppose pkg are installed already as no online mirror available
1746	pb_system("rpm -e lsb 2>&1 > /dev/null","Removing lsb package");
1747	pb_system("$insdm","$cmtdm");
1748	pb_system("$insmb","$cmtmb");
1749	pb_system("$insfm","$cmtfm");
1750	pb_system("$insfb","$cmtfb");
1751	} elsif ($ddir eq "suse") {
1752	# New OpenSuSE
1753	pb_system("$insmb","$cmtmb");
1754	pb_system("$insfm","$cmtfm");
1755	pb_system("$insfb","$cmtfb");
1756	pb_system("export TERM=linux ; liste=\"\" ; for i in make wget patch sudo perl-DateManip perl-File-HomeDir xntp; do rpm -q \$i 1> /dev/null 2> /dev/null ; if [ \$\? != 0 ]; then liste=\"\$liste \$i\"; fi; done; echo \"Liste: \$liste\" ; if [ \"\$liste\" != \"\" ]; then yast2 -i \$liste ; fi","$cmtall");
1757	} elsif ( $dfam eq "md" ) {
1758	pb_system("urpmi.update -a ; urpmi --auto rpm-build wget sudo patch ntp-client perl-File-MimeInfo","$cmtall");
1759	if (($ddir eq "mandrake") && ($dver eq "10.1")) {
1760	pb_system("$insdm","$cmtdm");
1761	} else {
1762	pb_system("urpmi --auto perl-DateManip","$cmtdm");
1763	}
1764	} elsif ( $dfam eq "du" ) {
1765	if (( $dver eq "3.1" ) && ($ddir eq "debian")) {
1766	#system "apt-get update";
1767	pb_system("$insfb","$cmtfb");
1768	pb_system("$insfm","$cmtfm");
1769	pb_system("apt-get -y install wget patch ssh sudo debian-builder dh-make fakeroot ntpdate libmodule-build-perl libdate-manip-perl","$cmtall");
1770	} else {
1771	pb_system("apt-get update; apt-get -y install wget patch openssh-server dpkg-dev sudo debian-builder dh-make fakeroot ntpdate libfile-mimeinfo-perl libmodule-build-perl libdate-manip-perl","$cmtall");
1772	}
1773	} elsif ( $dfam eq "gen" ) {
1774	#system "emerge -u system";
1775	pb_system("emerge wget sudo ntp DateManip File-MimeInfo","$cmtall");
1776	} else {
1777	pb_log(0,"No pkg to install\n");
1778	}
1779	EOF
1780	}
1781
1782	sub pb_announce {
1783
1784	# Get all required parameters
1785	my ($pbpackager,$pbrepo,$pbml,$pbsmtp) = pb_conf_get("pbpackager","pbrepo","pbml","pbsmtp");
1786	my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
1787	my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
1788	my @pkgs = @$pkg;
1789	my %pkgs;
1790	my $first = 0;
1791
1792	# Command to find packages on repo
1793	my $findstr = "find . ";
1794	# Generated announce files
1795	my @files;
1796
1797	foreach my $pbpkg (@pkgs) {
1798	if ($first != 0) {
1799	$findstr .= "-o ";
1800	}
1801	$first++;
1802	if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
1803	$pbver = $pkgv->{$pbpkg};
1804	} else {
1805	$pbver = $ENV{'PBPROJVER'};
1806	}
1807	if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
1808	$pbtag = $pkgt->{$pbpkg};
1809	} else {
1810	$pbtag = $ENV{'PBPROJTAG'};
1811	}
1812
1813	$findstr .= "-name \'$pbpkg-$pbver-$pbtag\..rpm\' -o -name \'$pbpkg"."_$pbver\.deb\' -o -name \'$pbpkg-$pbver\.ebuild\' ";
1814
1815	my $chglog;
1816
1817	# Get project info on log file and generate tmp files used later on
1818	pb_cms_init($pbinit);
1819	$chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
1820	$chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
1821	$chglog = undef if (! -f $chglog);
1822
1823	open(OUT,"> $ENV{'PBTMP'}/$pbpkg.ann") \|\| die "Unable to create $ENV{'PBTMP'}/$pbpkg.ann: $!";
1824	pb_changelog("announce",$pbpkg,$pbver,"N/A","N/A","N/A",\*OUT,"yes",$chglog);
1825	close(OUT);
1826	push(@files,"$ENV{'PBTMP'}/$pbpkg.ann");
1827	}
1828	$findstr .= " \| grep -Ev \'src.rpm\'";
1829	if ((not defined $testver) \|\| (not defined $testver->{$ENV{'PBPROJ'}}) \|\| ($testver->{$ENV{'PBPROJ'}} !~ /true/i)) {
1830	$findstr .= " \| grep -v ./test/";
1831	}
1832
1833	# Prepare the command to run and execute it
1834	open(PBS,"> $ENV{'PBTMP'}/pbscript") \|\| die "Unable to create $ENV{'PBTMP'}/pbscript";
1835	print PBS "$findstr\n";
1836	close(PBS);
1837	chmod 0755,"$ENV{'PBTMP'}/pbscript";
1838	pb_send2target("Announce");
1839
1840	# Get subject line
1841	my $sl = "Project $ENV{'PBPROJ'} version $ENV{'PBPROJVER'} is now available";
1842	pb_log(0,"Please enter the title of your announce\n");
1843	pb_log(0,"(By default: $sl)\n");
1844	my $sl2 = <STDIN>;
1845	$sl = $sl2 if ($sl2 !~ /^$/);
1846
1847	# Prepare a template of announce
1848	open(ANN,"> $ENV{'PBTMP'}/announce.html") \|\| die "Unable to create $ENV{'PBTMP'}/announce.html: $!";
1849	print ANN << "EOF";
1850	$sl</p>
1851
1852	<p>The project team is happy to announce the availability of a newest version of $ENV{'PBPROJ'} $ENV{'PBPROJVER'}. Enjoy it as usual!</p>
1853	<p>
1854	Now available at <a href="$pbrepo->{$ENV{'PBPROJ'}}">$pbrepo->{$ENV{'PBPROJ'}}</a>
1855	</p>
1856	<p>
1857	EOF
1858	open(LOG,"$ENV{'PBTMP'}/system.log") \|\| die "Unable to read $ENV{'PBTMP'}/system.log: $!";
1859	my $col = 2;
1860	my $i = 1;
1861	print ANN << 'EOF';
1862	<TABLE WIDTH="700" CELLPADDING="0" CELLSPACING="0" BORDER="0">
1863	<TR>
1864	EOF
1865	while (<LOG>) {
1866	print ANN "<TD>$_</TD>";
1867	$i++;
1868	if ($i > $col) {
1869	print ANN "</TR>\n<TR>";
1870	$i = 1;
1871	}
1872	}
1873	close(LOG);
1874	print ANN << "EOF";
1875	</TR>
1876	</TABLE>
1877	</p>
1878
1879	<p>As usual source packages are also available in the same directory.</p>
1880
1881	<p>
1882	Changes are :
1883	</p>
1884	<p>
1885	EOF
1886	# Get each package changelog content
1887	foreach my $f (sort(@files)) {
1888	open(IN,"$f") \|\| die "Unable to read $f:$!";
1889	while (<IN>) {
1890	print ANN $_;
1891	}
1892	close(IN);
1893	print ANN "</p><p>\n";
1894	}
1895	print ANN "</p>\n";
1896	close(ANN);
1897
1898	# Allow for modification
1899	pb_system("vi $ENV{'PBTMP'}/announce.html","Allowing modification of the announce","noredir");
1900
1901	# Store it in DB for external usage (Web pages generation)
1902	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
1903
1904	my $precmd = "";
1905	if (! -f $db) {
1906	$precmd = "CREATE TABLE announces (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, announce VARCHAR[65535])";
1907	}
1908
1909	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
1910	{ RaiseError => 1, AutoCommit => 1 })
1911	\|\| die "Unable to connect to $db";
1912
1913	if ($precmd ne "") {
1914	my $sth = $dbh->prepare(qq{$precmd})
1915	\|\| die "Unable to create table into $db";
1916	$sth->execute();
1917	}
1918
1919	# To read whole file
1920	local $/;
1921	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
1922	my $announce = <ANN>;
1923	close(ANN);
1924
1925	pb_log(2,"INSERT INTO announces VALUES (NULL, $pbdate, $announce)");
1926	my $sth = $dbh->prepare(qq{INSERT INTO announces VALUES (NULL,?,?)})
1927	\|\| die "Unable to insert into $db";
1928	$sth->execute($pbdate, $announce);
1929	$dbh->disconnect;
1930
1931	# Then deliver it on the Web
1932	# $TOOLHOME/livwww www
1933
1934	# Mail it to project's ML
1935	open(ML,"\| w3m -dump -T text/html > $ENV{'PBTMP'}/announce.txt") \|\| die "Unable to create $ENV{'PBTMP'}/announce.txt: $!";
1936	print ML << 'EOF';
1937	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/x html1/DTD/xhtml1-strict.dtd">
1938
1939	<html xmlns="http://www.w3.org/1999/xhtml" dir="ltr" xml:lang="en" lang="en">
1940	<head>
1941	</head>
1942	<body>
1943	<p>
1944	EOF
1945	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
1946	while(<ANN>) {
1947	print ML $_;
1948	}
1949	print ML << 'EOF';
1950	</body>
1951	</html>
1952	EOF
1953	close(ML);
1954
1955	# To read whole file
1956	local $/;
1957	open(ANN,"$ENV{'PBTMP'}/announce.txt") \|\| die "Unable to read $ENV{'PBTMP'}/announce.txt: $!";
1958	my $msg = <ANN>;
1959	close(ANN);
1960
1961	# Preparation of headers
1962
1963	my %mail = (
1964	To => $pbml->{$ENV{'PBPROJ'}},
1965	From => $pbpackager->{$ENV{'PBPROJ'}},
1966	Smtp => $pbsmtp->{$ENV{'PBPROJ'}},
1967	Body => $msg,
1968	Subject => "[ANNOUNCE] $sl",
1969	);
1970
1971	# Send mail
1972	sendmail(%mail) or die "Unable to send mail ($Mail::Sendmail::error): $Mail::Sendmail::log";
1973	}
1974
1975	# Return the SSH key file to use
1976	# Potentially create it if needed
1977
1978	sub pb_ssh_get {
1979
1980	my $create = shift \|\| 0; # Do not create keys by default
1981
1982	# Check the SSH environment
1983	my $keyfile = undef;
1984
1985	# We have specific keys by default
1986	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
1987	if (!(-e $keyfile) && ($create eq 1)) {
1988	pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
1989	}
1990
1991	$keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
1992	$keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
1993	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
1994	die "Unable to find your public ssh key under $keyfile" if (not defined $keyfile);
1995	return($keyfile);
1996	}
1997
1998
1999	# Returns the pid of a running VM command using a specific VM file
2000	sub pb_check_ps {
2001	my $vmcmd = shift;
2002	my $vmm = shift;
2003	my $vmexist = 0; # FALSE by default
2004
2005	open(PS, "ps auxhww\|") \|\| die "Unable to call ps";
2006	while (<PS>) {
2007	next if (! /$vmcmd/);
2008	next if (! /$vmm/);
2009	my ($void1, $void2);
2010	($void1, $vmexist, $void2) = split(/ +/);
2011	last;
2012	}
2013	return($vmexist);
2014	}
2015
2016
2017	sub pb_extract_build_files {
2018
2019	my $src=shift;
2020	my $dir=shift;
2021	my $ddir=shift;
2022	my @files;
2023
2024	if ($src =~ /tar\.gz$/) {
2025	pb_system("tar xfpz $src $dir","Extracting build files");
2026	} elsif ($src =~ /tar\.bz2$/) {
2027	pb_system("tar xfpj $src $dir","Extracting build files");
2028	} else {
2029	die "Unknown compression algorithm for $src";
2030	}
2031	opendir(DIR,"$dir") \|\| die "Unable to open directory $dir";
2032	foreach my $f (readdir(DIR)) {
2033	next if ($f =~ /^\./);
2034	move("$dir/$f","$ddir") \|\| die "Unable to move $dir/$f to $ddir";
2035	pb_log(2,"mv $dir/$f $ddir\n");
2036	push @files,"$ddir/$f";
2037	}
2038	closedir(DIR);
2039	# Not enough but still a first cleanup
2040	pb_rm_rf("$dir");
2041	return(@files);
2042	}
2043
2044	sub pb_list_bfiles {
2045
2046	my $dir = shift;
2047	my $pbpkg = shift;
2048	my $bfiles = shift;
2049	my $pkgfiles = shift;
2050	my $supfiles = shift;
2051
2052	opendir(BDIR,"$dir") \|\| die "Unable to open dir $dir: $!";
2053	foreach my $f (readdir(BDIR)) {
2054	next if ($f =~ /^\./);
2055	$bfiles->{$f} = "$dir/$f";
2056	$bfiles->{$f} =~ s~$ENV{'PBROOTDIR'}~~;
2057	if (defined $supfiles->{$pbpkg}) {
2058	$pkgfiles->{$f} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
2059	}
2060	}
2061	closedir(BDIR);
2062	}
2063
2064
2065	#
2066	# Return the list of packages we are working on in a non CMS action
2067	#
2068	sub pb_get_pkg {
2069
2070	my @pkgs = ();
2071
2072	my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
2073	@pkgs = keys %$var;
2074
2075	pb_log(0,"Packages: ".join(',',@pkgs)."\n");
2076	return(\@pkgs);
2077	}
2078
2079	1;

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

Download in other formats: