Context Navigation

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

Last change on this file since 557 was 557, checked in by Bruno Cornec, 16 years ago
Adds documentation on QEMU Fix pb to improve website delivery
Property svn:executable set to ``*
File size: 74.6 KB

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

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

Download in other formats: