Context Navigation

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

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

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

Download in other formats: