Context Navigation

source: devel/pb/bin/pb @ 498

Revision 498, 66.0 KB checked in by bruno, 5 years ago (diff)
DBI is only required when using announce Mail::Sendmail is require for variables and future use so VL needs also an update for that Now tht we need 2 tar files to build, VM also needs an updated pb
Property svn:executable set to ``*

Line
1	#!/usr/bin/perl -w
2	#
3	# Project Builder main application
4	#
5	# $Id$
6	#
7	# Copyright B. Cornec 2007
8	# Provided under the GPL v2
9
10	# Syntax: see at end
11
12	use strict 'vars';
13	use Getopt::Long qw(:config auto_abbrev no_ignore_case);
14	use Data::Dumper;
15	use English;
16	use File::Basename;
17	use File::Copy;
18	use File::stat;
19	use File::Temp qw(tempdir);
20	use 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	use Mail::Sendmail;
31
32	# Global variables
33	my %opts; # CLI Options
34	my $action; # action to realize
35	my $test = "FALSE"; # Not used
36	my $force = 0; # Force VE/VM rebuild
37	my $option = ""; # Not used
38	my @pkgs; # list of packages
39	my $pbtag; # Global Tag variable
40	my $pbver; # Global Version variable
41	my $pbscript; # Name of the script
42	my %pbver; # per package
43	my %pbtag; # per package
44	my $pbrev; # Global REVISION variable
45	my $pbaccount; # Login to use to connect to the VM
46	my $pbport; # Port to use to connect to the VM
47	my $newver; # New version to create
48	my $iso; # ISO image for the VM to create
49
50	my @date = pb_get_date();
51	my $pbdate = strftime("%Y-%m-%d", @date);
52
53	=pod
54
55	=head1 NAME
56
57	pb, aka project-builder.org - builds packages for your projects
58
59	=head1 DESCRIPTION
60
61	pb helps you build various packages directly from your project sources.
62	Those sources could be handled by a CMS (Configuration Management System)
63	such as Subversion, CVS, ... or being a simple reference to a compressed tar file.
64	It's based on a set of configuration files, a set of provided macros to help
65	you keeping build files as generic as possible. For example, a single .spec
66	file should be required to generate for all rpm based distributions, even
67	if you could also have multiple .spec files if required.
68
69	=head1 SYNOPSIS
70
71	pb [-vhq][-r pbroot][-p project][[-s script -a account -P port][-m mach-1[,...]]][-i iso] <action> [<pkg1> ...]
72
73	pb [--verbose][--help][--man][--quiet][--revision pbroot][--project project][[--script script --account account --port port][--machine mach-1[,...]]][--iso iso] <action> [<pkg1> ...]
74
75	=head1 OPTIONS
76
77	=over 4
78
79	=item B<-v\|--verbose>
80
81	Print a brief help message and exits.
82
83	=item B<-q\|--quiet>
84
85	Do not print any output.
86
87	=item B<-h\|--help>
88
89	Print a brief help message and exits.
90
91	=item B<--man>
92
93	Prints the manual page and exits.
94
95	=item B<-m\|--machine machine1[,machine2,...]>
96
97	Name of the Virtual Machines (VM) or Virtual Environments (VE) you want to build on (coma separated).
98	All if none precised (or use the env variable PBV).
99
100	=item B<-s\|--script script>
101
102	Name of the script you want to execute on the related VMs or VEs.
103
104	=item B<-i\|--iso iso_image>
105
106	Name of the ISO image of the distribution you want to install on the related VMs.
107
108	=item B<-a\|--account account>
109
110	Name of the account to use to connect on the related VMs.
111
112	=item B<-P\|--port port_number>
113
114	Port number to use to connect on the related VMs.\n";
115
116	=item B<-p\|--project project_name>
117
118	Name of the project you're working on (or use the env variable PBPROJ)
119
120	=item B<-r\|--revision revision>
121
122	Path Name of the project revision under the CMS (or use the env variable PBROOT)
123
124	=item B<-V\|--version new_version>
125
126	New version of the project to create based on the current one.
127
128	=back
129
130	=head1 ARGUMENTS
131
132	<action> can be:
133
134	=over 4
135
136	=item B<cms2build>
137
138	Create tar files for the project under your CMS.
139	CMS supported are SVN and CVS
140	parameters are packages to build
141	if not using default list
142
143	=item B<build2pkg>
144
145	Create packages for your running distribution
146
147	=item B<cms2pkg>
148
149	cms2build + build2pkg
150
151	=item B<build2ssh>
152
153	Send the tar files to a SSH host
154
155	=item B<cms2ssh>
156
157	cms2build + build2ssh
158
159	=item B<pkg2ssh>
160
161	Send the packages built to a SSH host
162
163	=item B<build2vm>
164
165	Create packages in VMs, launching them if needed
166	and send those packages to a SSH host once built
167	VM type supported are QEMU
168
169	=item B<build2ve>
170
171	Create packages in VEs, creating it if needed
172	and send those packages to a SSH host once built
173
174	=item B<cms2vm>
175
176	cms2build + build2vm
177
178	=item B<cms2ve>
179
180	cms2build + build2ve
181
182	=item B<launchvm>
183
184	Launch one virtual machine
185
186	=item B<launchve>
187
188	Launch one virtual environment
189
190	=item B<script2vm>
191
192	Launch one virtual machine if needed
193	and executes a script on it
194
195	=item B<script2ve>
196
197	Execute a script in a virtual environment
198
199	=item B<newvm>
200
201	Create a new virtual machine
202
203	=item B<newve>
204
205	Create a new virtual environment
206
207	=item B<setupvm>
208
209	Setup a virtual machine for pb usage
210
211	=item B<setupve>
212
213	Setup a virtual environment for pb usage
214
215	=item B<newver>
216
217	Create a new version of the project derived
218	from the current one
219
220	=item B<newproj>
221
222	Create a new project and a template set of
223	configuration files under pbconf
224
225	=item B<announce>
226
227	Announce the availability of the project through various means
228
229	=back
230
231	<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).
232
233	=head1 WEB SITES
234
235	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/>.
236
237	=head1 USER MAILING LIST
238
239	None exists for the moment.
240
241	=head1 CONFIGURATION FILES
242
243	Each pb user may have a configuration in F<$HOME/.pbrc>. The values in this file may overwrite any other configuration file value.
244
245	Here is an example of such a configuration file:
246
247	#
248	# Define for each project the URL of its pbconf repository
249	# No default option allowed here as they need to be all different
250	#
251	# URL of the pbconf content
252	# This is the format of a classical URL with the extension of additional schema such as
253	# svn+ssh, cvs+ssh, ...
254	#
255	pbconfurl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe/pbconf
256
257	# This is normaly defined in the project's configuration file
258	# Url of the project
259	#
260	pburl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe
261
262	# All these URLs needs to be defined here as the are the entry point
263	# for how to build packages for the project
264	#
265	pbconfurl pb = svn+ssh://svn.project-builder.org/mondo/svn/pb/pbconf
266	pbconfurl mondorescue = svn+ssh://svn.project-builder.org/mondo/svn/project-builder/mondorescue/pbconf
267	pbconfurl collectl = svn+ssh://bruno@svn.mondorescue.org/mondo/svn/project-builder/collectl/pbconf
268	pbconfurl netperf = svn+ssh://svn.mondorescue.org/mondo/svn/project-builder/netperf/pbconf
269
270	# Under that dir will take place everything related to pb
271	# If you want to use VMs/chroot/..., then use $ENV{'HOME'} to make it portable
272	# to your VMs/chroot/...
273	# if not defined then /var/cache
274	pbdefdir default = $ENV{'HOME'}/project-builder
275	pbdefdir pb = $ENV{'HOME'}
276	pbdefdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
277	pbdefdir mondorescue = $ENV{'HOME'}/mondo/svn
278
279	# pbconfdir points to the directory where the CMS content of the pbconfurl is checked out
280	# If not defined, pbconfdir is under pbdefdir/pbproj/pbconf
281	pbconfdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs/pbconf
282	pbconfdir mondorescue = $ENV{'HOME'}/mondo/svn/pbconf
283
284	# pbdir points to the directory where the CMS content of the pburl is checked out
285	# If not defined, pbdir is under pbdefdir/pbproj
286	# Only defined if we have access to the dev of the project
287	pbdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
288	pbdir mondorescue = $ENV{'HOME'}/mondo/svn
289
290	# -daemonize doesn't work with qemu 0.8.2
291	vmopt default = -m 384
292
293	=head1 AUTHORS
294
295	The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
296
297	=head1 COPYRIGHT
298
299	Project-Builder.org is distributed under the GPL v2.0 license
300	described in the file C<COPYING> included with the distribution.
301
302	=cut
303
304	# ---------------------------------------------------------------------------
305
306	# Old syntax
307	#getopts('a:fhi:l:m:P:p:qr:s:vV:',\%opts);
308
309	my ($projectbuilderver,$projectbuilderrev) = pb_version_init();
310
311	# Initialize the syntax string
312
313	pb_syntax_init("pb (aka project-builder.org) Version $projectbuilderver-$projectbuilderrev\n");
314
315	GetOptions("help\|?\|h" => \$opts{'h'},
316	"man" => \$opts{'man'},
317	"verbose\|v+" => \$opts{'v'},
318	"quiet\|q" => \$opts{'q'},
319	"log-files\|l=s" => \$opts{'l'},
320	"force\|f" => \$opts{'f'},
321	"account\|a=s" => \$opts{'a'},
322	"revision\|r=s" => \$opts{'r'},
323	"script\|s=s" => \$opts{'s'},
324	"machines\|mock\|m=s" => \$opts{'m'},
325	"port\|P=i" => \$opts{'P'},
326	"project\|p=s" => \$opts{'p'},
327	"iso\|i=s" => \$opts{'i'},
328	"version\|V=s" => \$opts{'V'},
329	) \|\| pb_syntax(-1,0);
330
331	if (defined $opts{'h'}) {
332	pb_syntax(0,1);
333	}
334	if (defined $opts{'man'}) {
335	pb_syntax(0,2);
336	}
337	if (defined $opts{'v'}) {
338	$pbdebug = $opts{'v'};
339	}
340	if (defined $opts{'f'}) {
341	$force=1;
342	}
343	if (defined $opts{'q'}) {
344	$pbdebug=-1;
345	}
346	if (defined $opts{'l'}) {
347	open(pbLOG,"> $opts{'l'}") \|\| die "Unable to log to $opts{'l'}: $!";
348	$pbLOG = \*pbLOG;
349	$pbdebug = 0 if ($pbdebug == -1);
350	}
351	pb_log_init($pbdebug, $pbLOG);
352	pb_display_init("text","");
353
354	# Handle root of the project if defined
355	if (defined $opts{'r'}) {
356	$ENV{'PBROOTDIR'} = $opts{'r'};
357	}
358	# Handle virtual machines if any
359	if (defined $opts{'m'}) {
360	$ENV{'PBV'} = $opts{'m'};
361	}
362	if (defined $opts{'s'}) {
363	$pbscript = $opts{'s'};
364	}
365	if (defined $opts{'a'}) {
366	$pbaccount = $opts{'a'};
367	die "option -a requires a -s script option" if (not defined $pbscript);
368	}
369	if (defined $opts{'P'}) {
370	$pbport = $opts{'P'};
371	}
372	if (defined $opts{'V'}) {
373	$newver = $opts{'V'};
374	}
375	if (defined $opts{'i'}) {
376	$iso = $opts{'i'};
377	}
378
379	# Get Action
380	$action = shift @ARGV;
381	die pb_syntax(-1,1) if (not defined $action);
382
383	my ($filteredfiles, $supfiles, $defpkgdir, $extpkgdir);
384	my $pbinit = undef;
385	$pbinit = 1 if ($action =~ /^newproj$/);
386
387	# Handles project name if any
388	# And get global params
389	($filteredfiles, $supfiles, $defpkgdir, $extpkgdir) = pb_env_init($opts{'p'},$pbinit,$action);
390
391	pb_log(0,"Project: $ENV{'PBPROJ'}\n");
392	pb_log(0,"Action: $action\n");
393
394	# Act depending on action
395	if ($action =~ /^cms2build$/) {
396	pb_cms2build();
397	} elsif ($action =~ /^build2pkg$/) {
398	pb_build2pkg();
399	} elsif ($action =~ /^cms2pkg$/) {
400	pb_cms2build();
401	pb_build2pkg();
402	} elsif ($action =~ /^build2ssh$/) {
403	pb_build2ssh();
404	} elsif ($action =~ /^cms2ssh$/) {
405	pb_cms2build();
406	pb_build2ssh();
407	} elsif ($action =~ /^pkg2ssh$/) {
408	pb_pkg2ssh();
409	} elsif ($action =~ /^build2ve$/) {
410	pb_build2v("ve");
411	} elsif ($action =~ /^build2vm$/) {
412	pb_build2v("vm");
413	} elsif ($action =~ /^cms2ve$/) {
414	pb_cms2build();
415	pb_build2v("ve");
416	} elsif ($action =~ /^cms2vm$/) {
417	pb_cms2build();
418	pb_build2v("vm");
419	} elsif ($action =~ /^launchvm$/) {
420	pb_launchv("vm",$ENV{'PBV'},0);
421	} elsif ($action =~ /^launchve$/) {
422	pb_launchv("ve",$ENV{'PBV'},0);
423	} elsif ($action =~ /^script2vm$/) {
424	pb_script2v($pbscript,"vm");
425	} elsif ($action =~ /^script2ve$/) {
426	pb_script2v($pbscript,"ve");
427	} elsif ($action =~ /^newver$/) {
428	pb_newver();
429	} elsif ($action =~ /^newve$/) {
430	pb_launchv("ve",$ENV{'PBV'},1);
431	} elsif ($action =~ /^newvm$/) {
432	pb_launchv("vm",$ENV{'PBV'},1);
433	} elsif ($action =~ /^setupve$/) {
434	pb_setup_v("ve");
435	} elsif ($action =~ /^setupvm$/) {
436	pb_setup_v("vm");
437	} elsif ($action =~ /^newproj$/) {
438	# Nothing to do - already done in pb_env_init
439	} elsif ($action =~ /^clean$/) {
440	# TBC
441	} elsif ($action =~ /^announce$/) {
442	# For announce only. Require avoids the systematic load of these modules
443	require DBI;
444
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 may 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	our $pbdisplaytype = "text";
1535	our $pblocale = "";
1536	pb_log_init($pbdebug, $pbLOG);
1537	pb_temp_init();
1538
1539	EOF
1540	if ($vtype eq "vm") {
1541	print SCRIPT << 'EOF';
1542	# Removes duplicate in .ssh/authorized_keys of our key if needed
1543	#
1544	my $file1="$ENV{'HOME'}/.ssh/authorized_keys";
1545	open(PBFILE,$file1) \|\| die "Unable to open $file1";
1546	open(PBOUT,"> $file1.new") \|\| die "Unable to open $file1.new";
1547	my $count = 0;
1548	while (<PBFILE>) {
1549	EOF
1550	print SCRIPT << "EOF";
1551	if (/ $key /) {
1552	\$count++;
1553	}
1554	print PBOUT \$_ if ((\$count <= 1) \|\| (\$_ !~ / $key /));
1555	}
1556	close(PBFILE);
1557	close(PBOUT);
1558	rename("\$file1.new",\$file1);
1559	chmod 0600,\$file1;
1560	EOF
1561	}
1562	print SCRIPT << 'EOF';
1563
1564	# Adds $pbac->{$ENV{'PBPROJ'}} as an account if needed
1565	#
1566	my $file="/etc/passwd";
1567	open(PBFILE,$file) \|\| die "Unable to open $file";
1568	my $found = 0;
1569	while (<PBFILE>) {
1570	EOF
1571	print SCRIPT << "EOF";
1572	\$found = 1 if (/^$pbac->{$ENV{'PBPROJ'}}:/);
1573	EOF
1574	print SCRIPT << 'EOF';
1575	}
1576	close(PBFILE);
1577
1578	if ( $found == 0 ) {
1579	if ( ! -d "/home" ) {
1580	pb_mkdir("/home");
1581	}
1582	EOF
1583	print SCRIPT << "EOF";
1584	pb_system("groupadd $pbac->{$ENV{'PBPROJ'}}","Adding group $pbac->{$ENV{'PBPROJ'}}");
1585	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'}}");
1586	}
1587
1588	# allow ssh entry to build
1589	#
1590	mkdir "/home/$pbac->{$ENV{'PBPROJ'}}/.ssh",0700;
1591	# Allow those accessing root to access the build account
1592	copy("\$ENV{'HOME'}/.ssh/authorized_keys","/home/$pbac->{$ENV{'PBPROJ'}}/.ssh/authorized_keys");
1593	chmod 0600,".ssh/authorized_keys";
1594	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'}}");
1595
1596	EOF
1597	print SCRIPT << 'EOF';
1598	# No passwd for build account only keys
1599	$file="/etc/shadow";
1600	open(PBFILE,$file) \|\| die "Unable to open $file";
1601	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
1602	while (<PBFILE>) {
1603	EOF
1604	print SCRIPT << "EOF";
1605	s/^$pbac->{$ENV{'PBPROJ'}}:\!\!:/$pbac->{$ENV{'PBPROJ'}}:*:/;
1606	s/^$pbac->{$ENV{'PBPROJ'}}:\!:/$pbac->{$ENV{'PBPROJ'}}:*:/; #SLES 9 e.g.
1607	EOF
1608	print SCRIPT << 'EOF';
1609	print PBOUT $_;
1610	}
1611	close(PBFILE);
1612	close(PBOUT);
1613	rename("$file.new",$file);
1614	chmod 0640,$file;
1615
1616	# Keep the VM in text mode
1617	$file="/etc/inittab";
1618	if (-f $file) {
1619	open(PBFILE,$file) \|\| die "Unable to open $file";
1620	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
1621	while (<PBFILE>) {
1622	s/^(..):5:initdefault:$/$1:3:initdefault:/;
1623	print PBOUT $_;
1624	}
1625	close(PBFILE);
1626	close(PBOUT);
1627	rename("$file.new",$file);
1628	chmod 0640,$file;
1629	}
1630
1631	# pb has to be added to portage group on gentoo
1632
1633	# Adapt sudoers
1634	$file="/etc/sudoers";
1635	open(PBFILE,$file) \|\| die "Unable to open $file";
1636	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
1637	while (<PBFILE>) {
1638	EOF
1639	print SCRIPT << "EOF";
1640	next if (/^$pbac->{$ENV{'PBPROJ'}} /);
1641	EOF
1642	print SCRIPT << 'EOF';
1643	s/Defaults[ \t]+requiretty//;
1644	print PBOUT $_;
1645	}
1646	close(PBFILE);
1647	EOF
1648	print SCRIPT << "EOF";
1649	# This is needed in order to be able to halt the machine from the $pbac->{$ENV{'PBPROJ'}} account at least
1650	print PBOUT "$pbac->{$ENV{'PBPROJ'}} ALL=(ALL) NOPASSWD:ALL\n";
1651	EOF
1652	print SCRIPT << 'EOF';
1653	close(PBOUT);
1654	rename("$file.new",$file);
1655	chmod 0440,$file;
1656
1657	EOF
1658
1659	my $SCRIPT = \*SCRIPT;
1660
1661	pb_install_deps($SCRIPT);
1662
1663	print SCRIPT << 'EOF';
1664	# Suse wants sudoers as 640
1665	if (($ddir eq "sles") \|\| (($ddir eq "suse")) && ($dver ne "10.3")) {
1666	chmod 0640,$file;
1667	}
1668
1669	# Sync date
1670	#system "/usr/sbin/ntpdate ntp.pool.org";
1671
1672	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");
1673	system "pb 2>&1 \| head -5";
1674	EOF
1675	# Adds pb_distro_init from ProjectBuilder::Distribution
1676	foreach my $d (@INC) {
1677	my @f = ("$d/ProjectBuilder/Base.pm","$d/ProjectBuilder/Distribution.pm");
1678	foreach my $f (@f) {
1679	if (-f "$f") {
1680	open(PBD,"$f") \|\| die "Unable to open $f";
1681	while (<PBD>) {
1682	next if (/^package/);
1683	next if (/^use Exporter/);
1684	next if (/^use ProjectBuilder::/);
1685	next if (/^our /);
1686	print SCRIPT $_;
1687	}
1688	close(PBD);
1689	}
1690	}
1691	}
1692	close(SCRIPT);
1693	chmod 0755,"$pbscript";
1694
1695	# That build script needs to be run as root and force stop of VM at end
1696	$pbaccount = "root";
1697
1698	# Force shutdown of VM exept if it was already launched
1699	my $force = 0;
1700	if ((! $vmexist) && ($vtype eq "vm")) {
1701	$force = 1;
1702	}
1703
1704	pb_script2v($pbscript,$vtype,$force,$v);
1705	}
1706	return;
1707	}
1708
1709	sub pb_install_deps {
1710
1711	my $SCRIPT = shift;
1712
1713	print {$SCRIPT} << 'EOF';
1714	# We need to have that pb_distro_init function
1715	# Get it from Project-Builder::Distribution
1716	my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init();
1717	print "distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n";
1718
1719	# Get and install pb
1720	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*";
1721	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*";
1722	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*";
1723	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*";
1724	my $insms = "rm -rf Mail-Sendmail* ; wget http://search.cpan.org/CPAN/authors/id/M/MI/MIVKOVIC/Mail-Sendmail-0.79.tar.gz ; tar xvfz Mail-Sendmail-0.79.tar.gz ; cd Mail-Sendmail* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf Mail-Sendmail*";
1725	my $cmtdm = "Installing Date-Manip perl module";
1726	my $cmtmb = "Installing Module-Build perl module";
1727	my $cmtfm = "Installing File-MimeInfo perl module";
1728	my $cmtfb = "Installing File-Basedir perl module";
1729	my $cmtms = "Installing Perl-Sendmail perl module";
1730	my $cmtall = "Installing required modules";
1731
1732	if ( $ddir eq "fedora" ) {
1733	pb_system("yum clean all","Cleaning yum env");
1734	#system "yum update -y";
1735	my $arch=`uname -m`;
1736	my $opt = "";
1737	chomp($arch);
1738	if ($arch eq "x86_64") {
1739	$opt="--exclude=*.i?86";
1740	}
1741
1742	pb_system("yum -y $opt install rpm-build wget patch ntp sudo perl-DateManip perl-File-MimeInfo perl-ExtUtils-MakeMaker perl-Mail-Sendmail",$cmtall);
1743	if ($dver eq 4) {
1744	pb_system("$insmb","$cmtmb");
1745	pb_system("$insfm","$cmtfm");
1746	pb_system("$insfb","$cmtfb");
1747	}
1748	} elsif (( $dfam eq "rh" ) \|\| ($ddir eq "sles") \|\| (($ddir eq "suse") && (($dver eq "10.1") \|\| ($dver eq "10.0"))) \|\| ($ddir eq "slackware")) {
1749	# Suppose pkg are installed already as no online mirror available
1750	pb_system("rpm -e lsb 2>&1 > /dev/null","Removing lsb package");
1751	pb_system("$insdm","$cmtdm");
1752	pb_system("$insmb","$cmtmb");
1753	pb_system("$insfm","$cmtfm");
1754	pb_system("$insfb","$cmtfb");
1755	pb_system("$insms","$cmtms");
1756	} elsif ($ddir eq "suse") {
1757	# New OpenSuSE
1758	pb_system("$insmb","$cmtmb");
1759	pb_system("$insfm","$cmtfm");
1760	pb_system("$insfb","$cmtfb");
1761	pb_system("export TERM=linux ; liste=\"\" ; for i in make wget patch sudo perl-DateManip perl-File-HomeDir perl-Mail-Sendmail 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");
1762	} elsif ( $dfam eq "md" ) {
1763	pb_system("urpmi.update -a ; urpmi --auto rpm-build wget sudo patch ntp-client perl-File-MimeInfo perl-Mail-Sendmail","$cmtall");
1764	if (($ddir eq "mandrake") && ($dver eq "10.1")) {
1765	pb_system("$insdm","$cmtdm");
1766	} else {
1767	pb_system("urpmi --auto perl-DateManip","$cmtdm");
1768	}
1769	} elsif ( $dfam eq "du" ) {
1770	if (( $dver eq "3.1" ) && ($ddir eq "debian")) {
1771	#system "apt-get update";
1772	pb_system("$insfb","$cmtfb");
1773	pb_system("$insfm","$cmtfm");
1774	pb_system("apt-get -y install wget patch ssh sudo debian-builder dh-make fakeroot ntpdate libmodule-build-perl libdate-manip-perl libmail-sendmail-perl","$cmtall");
1775	} else {
1776	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 libmail-sendmail-perl","$cmtall");
1777	}
1778	} elsif ( $dfam eq "gen" ) {
1779	#system "emerge -u system";
1780	pb_system("emerge wget sudo ntp DateManip File-MimeInfo Mail-Sendmail","$cmtall");
1781	} else {
1782	pb_log(0,"No pkg to install\n");
1783	}
1784	EOF
1785	}
1786
1787	sub pb_announce {
1788
1789	# Get all required parameters
1790	my ($pbpackager,$pbrepo,$pbml,$pbsmtp) = pb_conf_get("pbpackager","pbrepo","pbml","pbsmtp");
1791	my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
1792	my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
1793	my @pkgs = @$pkg;
1794	my %pkgs;
1795	my $first = 0;
1796
1797	# Command to find packages on repo
1798	my $findstr = "find . ";
1799	# Generated announce files
1800	my @files;
1801
1802	foreach my $pbpkg (@pkgs) {
1803	if ($first != 0) {
1804	$findstr .= "-o ";
1805	}
1806	$first++;
1807	if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
1808	$pbver = $pkgv->{$pbpkg};
1809	} else {
1810	$pbver = $ENV{'PBPROJVER'};
1811	}
1812	if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
1813	$pbtag = $pkgt->{$pbpkg};
1814	} else {
1815	$pbtag = $ENV{'PBPROJTAG'};
1816	}
1817
1818	$findstr .= "-name \'$pbpkg-$pbver-$pbtag\..rpm\' -o -name \'$pbpkg"."_$pbver\.deb\' -o -name \'$pbpkg-$pbver\.ebuild\' ";
1819
1820	my $chglog;
1821
1822	# Get project info on log file and generate tmp files used later on
1823	pb_cms_init($pbinit);
1824	$chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
1825	$chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
1826	$chglog = undef if (! -f $chglog);
1827
1828	open(OUT,"> $ENV{'PBTMP'}/$pbpkg.ann") \|\| die "Unable to create $ENV{'PBTMP'}/$pbpkg.ann: $!";
1829	pb_changelog("announce",$pbpkg,$pbver,"N/A","N/A","N/A",\*OUT,"yes",$chglog);
1830	close(OUT);
1831	push(@files,"$ENV{'PBTMP'}/$pbpkg.ann");
1832	}
1833	$findstr .= " \| grep -Ev \'src.rpm\'";
1834	if ((not defined $testver) \|\| (not defined $testver->{$ENV{'PBPROJ'}}) \|\| ($testver->{$ENV{'PBPROJ'}} !~ /true/i)) {
1835	$findstr .= " \| grep -v ./test/";
1836	}
1837
1838	# Prepare the command to run and execute it
1839	open(PBS,"> $ENV{'PBTMP'}/pbscript") \|\| die "Unable to create $ENV{'PBTMP'}/pbscript";
1840	print PBS "$findstr\n";
1841	close(PBS);
1842	chmod 0755,"$ENV{'PBTMP'}/pbscript";
1843	pb_send2target("Announce");
1844
1845	# Get subject line
1846	my $sl = "Project $ENV{'PBPROJ'} version $ENV{'PBPROJVER'} is now available";
1847	pb_log(0,"Please enter the title of your announce\n");
1848	pb_log(0,"(By default: $sl)\n");
1849	my $sl2 = <STDIN>;
1850	$sl = $sl2 if ($sl2 !~ /^$/);
1851
1852	# Prepare a template of announce
1853	open(ANN,"> $ENV{'PBTMP'}/announce.html") \|\| die "Unable to create $ENV{'PBTMP'}/announce.html: $!";
1854	print ANN << "EOF";
1855	$sl</p>
1856
1857	<p>The project team is happy to announce the availability of a newest version of $ENV{'PBPROJ'} $ENV{'PBPROJVER'}. Enjoy it as usual!</p>
1858	<p>
1859	Now available at <a href="$pbrepo->{$ENV{'PBPROJ'}}">$pbrepo->{$ENV{'PBPROJ'}}</a>
1860	</p>
1861	<p>
1862	EOF
1863	open(LOG,"$ENV{'PBTMP'}/system.log") \|\| die "Unable to read $ENV{'PBTMP'}/system.log: $!";
1864	my $col = 2;
1865	my $i = 1;
1866	print ANN << 'EOF';
1867	<TABLE WIDTH="700" CELLPADDING="0" CELLSPACING="0" BORDER="0">
1868	<TR>
1869	EOF
1870	while (<LOG>) {
1871	print ANN "<TD>$_</TD>";
1872	$i++;
1873	if ($i > $col) {
1874	print ANN "</TR>\n<TR>";
1875	$i = 1;
1876	}
1877	}
1878	close(LOG);
1879	print ANN << "EOF";
1880	</TR>
1881	</TABLE>
1882	</p>
1883
1884	<p>As usual source packages are also available in the same directory.</p>
1885
1886	<p>
1887	Changes are :
1888	</p>
1889	<p>
1890	EOF
1891	# Get each package changelog content
1892	foreach my $f (sort(@files)) {
1893	open(IN,"$f") \|\| die "Unable to read $f:$!";
1894	while (<IN>) {
1895	print ANN $_;
1896	}
1897	close(IN);
1898	print ANN "</p><p>\n";
1899	}
1900	print ANN "</p>\n";
1901	close(ANN);
1902
1903	# Allow for modification
1904	pb_system("vi $ENV{'PBTMP'}/announce.html","Allowing modification of the announce","noredir");
1905
1906	# Store it in DB for external usage (Web pages generation)
1907	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
1908
1909	my $precmd = "";
1910	if (! -f $db) {
1911	$precmd = "CREATE TABLE announces (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, announce VARCHAR[65535])";
1912	}
1913
1914	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
1915	{ RaiseError => 1, AutoCommit => 1 })
1916	\|\| die "Unable to connect to $db";
1917
1918	if ($precmd ne "") {
1919	my $sth = $dbh->prepare(qq{$precmd})
1920	\|\| die "Unable to create table into $db";
1921	$sth->execute();
1922	}
1923
1924	# To read whole file
1925	local $/;
1926	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
1927	my $announce = <ANN>;
1928	close(ANN);
1929
1930	pb_log(2,"INSERT INTO announces VALUES (NULL, $pbdate, $announce)");
1931	my $sth = $dbh->prepare(qq{INSERT INTO announces VALUES (NULL,?,?)})
1932	\|\| die "Unable to insert into $db";
1933	$sth->execute($pbdate, $announce);
1934	$dbh->disconnect;
1935
1936	# Then deliver it on the Web
1937	# $TOOLHOME/livwww www
1938
1939	# Mail it to project's ML
1940	open(ML,"\| w3m -dump -T text/html > $ENV{'PBTMP'}/announce.txt") \|\| die "Unable to create $ENV{'PBTMP'}/announce.txt: $!";
1941	print ML << 'EOF';
1942	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/x html1/DTD/xhtml1-strict.dtd">
1943
1944	<html xmlns="http://www.w3.org/1999/xhtml" dir="ltr" xml:lang="en" lang="en">
1945	<head>
1946	</head>
1947	<body>
1948	<p>
1949	EOF
1950	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
1951	while(<ANN>) {
1952	print ML $_;
1953	}
1954	print ML << 'EOF';
1955	</body>
1956	</html>
1957	EOF
1958	close(ML);
1959
1960	# To read whole file
1961	local $/;
1962	open(ANN,"$ENV{'PBTMP'}/announce.txt") \|\| die "Unable to read $ENV{'PBTMP'}/announce.txt: $!";
1963	my $msg = <ANN>;
1964	close(ANN);
1965
1966	# Preparation of headers
1967
1968	my %mail = (
1969	To => $pbml->{$ENV{'PBPROJ'}},
1970	From => $pbpackager->{$ENV{'PBPROJ'}},
1971	Smtp => $pbsmtp->{$ENV{'PBPROJ'}},
1972	Body => $msg,
1973	Subject => "[ANNOUNCE] $sl",
1974	);
1975
1976	# Send mail
1977	sendmail(%mail) or die "Unable to send mail ($Mail::Sendmail::error): $Mail::Sendmail::log";
1978	}
1979
1980	# Return the SSH key file to use
1981	# Potentially create it if needed
1982
1983	sub pb_ssh_get {
1984
1985	my $create = shift \|\| 0; # Do not create keys by default
1986
1987	# Check the SSH environment
1988	my $keyfile = undef;
1989
1990	# We have specific keys by default
1991	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
1992	if (!(-e $keyfile) && ($create eq 1)) {
1993	pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
1994	}
1995
1996	$keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
1997	$keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
1998	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
1999	die "Unable to find your public ssh key under $keyfile" if (not defined $keyfile);
2000	return($keyfile);
2001	}
2002
2003
2004	# Returns the pid of a running VM command using a specific VM file
2005	sub pb_check_ps {
2006	my $vmcmd = shift;
2007	my $vmm = shift;
2008	my $vmexist = 0; # FALSE by default
2009
2010	open(PS, "ps auxhww\|") \|\| die "Unable to call ps";
2011	while (<PS>) {
2012	next if (! /$vmcmd/);
2013	next if (! /$vmm/);
2014	my ($void1, $void2);
2015	($void1, $vmexist, $void2) = split(/ +/);
2016	last;
2017	}
2018	return($vmexist);
2019	}
2020
2021
2022	sub pb_extract_build_files {
2023
2024	my $src=shift;
2025	my $dir=shift;
2026	my $ddir=shift;
2027	my @files;
2028
2029	if ($src =~ /tar\.gz$/) {
2030	pb_system("tar xfpz $src $dir","Extracting build files");
2031	} elsif ($src =~ /tar\.bz2$/) {
2032	pb_system("tar xfpj $src $dir","Extracting build files");
2033	} else {
2034	die "Unknown compression algorithm for $src";
2035	}
2036	opendir(DIR,"$dir") \|\| die "Unable to open directory $dir";
2037	foreach my $f (readdir(DIR)) {
2038	next if ($f =~ /^\./);
2039	move("$dir/$f","$ddir") \|\| die "Unable to move $dir/$f to $ddir";
2040	pb_log(2,"mv $dir/$f $ddir\n");
2041	push @files,"$ddir/$f";
2042	}
2043	closedir(DIR);
2044	# Not enough but still a first cleanup
2045	pb_rm_rf("$dir");
2046	return(@files);
2047	}
2048
2049	sub pb_list_bfiles {
2050
2051	my $dir = shift;
2052	my $pbpkg = shift;
2053	my $bfiles = shift;
2054	my $pkgfiles = shift;
2055	my $supfiles = shift;
2056
2057	opendir(BDIR,"$dir") \|\| die "Unable to open dir $dir: $!";
2058	foreach my $f (readdir(BDIR)) {
2059	next if ($f =~ /^\./);
2060	$bfiles->{$f} = "$dir/$f";
2061	$bfiles->{$f} =~ s~$ENV{'PBROOTDIR'}~~;
2062	if (defined $supfiles->{$pbpkg}) {
2063	$pkgfiles->{$f} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
2064	}
2065	}
2066	closedir(BDIR);
2067	}
2068
2069
2070	#
2071	# Return the list of packages we are working on in a non CMS action
2072	#
2073	sub pb_get_pkg {
2074
2075	my @pkgs = ();
2076
2077	my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
2078	@pkgs = keys %$var;
2079
2080	pb_log(0,"Packages: ".join(',',@pkgs)."\n");
2081	return(\@pkgs);
2082	}
2083
2084	1;

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

Download in other formats: