Context Navigation

source: devel/pb/bin/pb @ 499

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

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

Download in other formats: