Context Navigation

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

Last change on this file since 559 was 559, checked in by Bruno Cornec, 16 years ago
web2ssh is now producing a correct tar file, as well as generated news files
Property svn:executable set to ``*
File size: 74.8 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	# And create an empty pbconf
721	pb_mkdir_p("$dest/pbconf");
722	}
723
724	# Prepare the dest directory for archive
725	if (-x "$ENV{'PBROOTDIR'}/$pbpkg/pbinit") {
726	pb_filter_file("$ENV{'PBROOTDIR'}/$pbpkg/pbinit",$ptr,"$ENV{'PBTMP'}/pbinit",\%pb);
727	chmod 0755,"$ENV{'PBTMP'}/pbinit";
728	pb_system("cd $dest ; $ENV{'PBTMP'}/pbinit","Executing init script from $ENV{'PBROOTDIR'}/$pbpkg/pbinit","verbose");
729	}
730
731	# Archive dest dir
732	chdir "$ENV{'PBDESTDIR'}" \|\| die "Unable to change dir to $ENV{'PBDESTDIR'}";
733	if (defined $preserve) {
734	# In that case we want to preserve the original tar file for checksum purposes
735	# The one created is btw equivalent in that case to this one
736	# Maybe check basename of both to be sure they are the same ?
737	pb_log(0,"Preserving original tar file ");
738	move("$preserve","$pbpkg-$pbver.tar.gz");
739	} else {
740	# Possibility to look at PBSRC to guess more the filename
741	pb_system("tar cfz $pbpkg-$pbver.tar.gz --exclude=$pbpkg-$pbver/pbconf $pbpkg-$pbver","Creating $pbpkg tar files compressed");
742	}
743	pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz\n");
744	pb_system("tar cfz $pbpkg-$pbver.pbconf.tar.gz $pbpkg-$pbver/pbconf","Creating pbconf tar files compressed");
745	pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz\n");
746
747	# Keep track of version-tag per pkg
748	$pkgs{$pbpkg} = "$pbver-$pbtag";
749
750	# Final cleanup
751	pb_rm_rf($dest) if (-d $dest);
752	}
753
754	# Keep track of per package version
755	pb_log(2,"DEBUG pkgs: ".Dumper(%pkgs)."\n");
756	open(PKG,"> $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb") \|\| die "Unable to create $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb";
757	foreach my $pbpkg (keys %pkgs) {
758	print PKG "pbpkg $pbpkg = $pkgs{$pbpkg}\n";
759	}
760	close(PKG);
761
762	# Keep track of what is generated by default
763	# We need to store the dir and info on version-tag
764	# Base our content on the existing .pb file
765	copy("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb","$ENV{'PBDESTDIR'}/pbrc");
766	open(LAST,">> $ENV{'PBDESTDIR'}/pbrc") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbrc";
767	print LAST "pbroot $ENV{'PBPROJ'} = $ENV{'PBROOTDIR'}\n";
768	print LAST "pbprojver $ENV{'PBPROJ'} = $ENV{'PBPROJVER'}\n";
769	print LAST "pbprojtag $ENV{'PBPROJ'} = $ENV{'PBPROJTAG'}\n";
770	print LAST "pbpackager $ENV{'PBPROJ'} = $ENV{'PBPACKAGER'}\n";
771	close(LAST);
772	}
773
774	sub pb_build2pkg {
775
776	# Get the running distro to build on
777	my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init();
778	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n");
779
780	# Get list of packages to build
781	# Get content saved in cms2build
782	my $ptr = pb_get_pkg();
783	@pkgs = @$ptr;
784
785	my $arch = pb_get_arch();
786
787	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
788	$pkg = { } if (not defined $pkg);
789
790	chdir "$ENV{'PBBUILDDIR'}";
791	my $made = ""; # pkgs made during build
792	foreach my $pbpkg (@pkgs) {
793	my $vertag = $pkg->{$pbpkg};
794	# get the version of the current package - maybe different
795	($pbver,$pbtag) = split(/-/,$vertag);
796
797	my $src="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz";
798	my $src2="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
799	pb_log(2,"Source file: $src\n");
800	pb_log(2,"Pbconf file: $src2\n");
801
802	pb_log(2,"Working directory: $ENV{'PBBUILDDIR'}\n");
803	if ($dtype eq "rpm") {
804	foreach my $d ('RPMS','SRPMS','SPECS','SOURCES','BUILD') {
805	if (! -d "$ENV{'PBBUILDDIR'}/$d") {
806	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";
807	}
808	}
809
810	# Remove in case a previous link/file was there
811	unlink "$ENV{'PBBUILDDIR'}/SOURCES/".basename($src);
812	symlink "$src","$ENV{'PBBUILDDIR'}/SOURCES/".basename($src) \|\| die "Unable to symlink $src in $ENV{'PBBUILDDIR'}/SOURCES";
813	# We need to first extract the spec file
814	my @specfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/","$ENV{'PBBUILDDIR'}/SPECS","spec");
815
816	# We need to handle potential patches to upstream sources
817	pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/pbpatch/","$ENV{'PBBUILDDIR'}/SOURCES","patch");
818
819	pb_log(2,"specfile: ".Dumper(\@specfile)."\n");
820	# set LANGUAGE to check for correct log messages
821	$ENV{'LANGUAGE'}="C";
822	# Older Redhat use _target_platform in %configure incorrectly
823	my $specialdef = "";
824	if (($ddir eq "redhat") \|\| (($ddir eq "rhel") && ($dver eq "2.1"))) {
825	$specialdef = "--define \'_target_platform \"\"\'";
826	}
827	foreach my $f (@specfile) {
828	if ($f =~ /\.spec$/) {
829	pb_system("rpmbuild $specialdef --define \'packager $ENV{'PBPACKAGER'}\' --define \"_topdir $ENV{'PBBUILDDIR'}\" -ba $f","Building package with $f under $ENV{'PBBUILDDIR'}","verbose");
830	last;
831	}
832	}
833	# Get the name of the generated packages
834	open(LOG,"$ENV{'PBTMP'}/system.log") \|\| die "Unable to open $ENV{'PBTMP'}/system.log";
835	while (<LOG>) {
836	chomp();
837	next if ($_ !~ /^Wrote:/);
838	s\|./([S]RPMS.*)\|$1\|;
839	$made="$made $_";
840	}
841	close(LOG);
842
843	} elsif ($dtype eq "deb") {
844	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
845	pb_system("tar xfz $src","Extracting sources");
846	pb_system("tar xfz $src2","Extracting pbconf");
847
848	chdir "$pbpkg-$pbver" \|\| die "Unable to chdir to $pbpkg-$pbver";
849	pb_rm_rf("debian");
850	symlink "pbconf/$ddir-$dver-$arch","debian" \|\| die "Unable to symlink to pbconf/$ddir-$dver-$arch";
851	chmod 0755,"debian/rules";
852
853	pb_system("dpkg-buildpackage -us -uc -rfakeroot","Building package","verbose");
854	# Get the name of the generated packages
855	open(LOG,"$ENV{'PBTMP'}/system.log") \|\| die "Unable to open $ENV{'PBTMP'}/system.log";
856	while (<LOG>) {
857	chomp();
858	my $tmp = $_;
859	next if ($tmp !~ /^dpkg-deb.:/);
860	$tmp =~ s\|.../(.)_(.).deb.\|$1\|;
861	$made="$made $tmp.dsc $tmp.tar.gz $tmp"."_.deb $tmp"."_.changes";
862	}
863	close(LOG);
864	} elsif ($dtype eq "ebuild") {
865	my @ebuildfile;
866	# For gentoo we need to take pb as subsystem name
867	# We put every apps here under sys-apps. hope it's correct
868	# We use pb's home dir in order to have a single OVERLAY line
869	my $tmpd = "$ENV{'HOME'}/portage/pb/sys-apps/$pbpkg";
870	pb_mkdir_p($tmpd) if (! -d "$tmpd");
871	pb_mkdir_p("$ENV{'HOME'}/portage/distfiles") if (! -d "$ENV{'HOME'}/portage/distfiles");
872
873	# We need to first extract the ebuild file
874	@ebuildfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/","$tmpd","ebuild");
875
876	# Prepare the build env for gentoo
877	my $found = 0;
878	my $pbbd = $ENV{'HOME'};
879	$pbbd =~ s\|/\|\\/\|g;
880	if (-r "/etc/make.conf") {
881	open(MAKE,"/etc/make.conf");
882	while (<MAKE>) {
883	$found = 1 if (/$pbbd\/portage/);
884	}
885	close(MAKE);
886	}
887	if ($found == 0) {
888	pb_system("sudo sh -c 'echo PORTDIR_OVERLAY=\"$ENV{'HOME'}/portage\" >> /etc/make.conf'");
889	}
890	#$found = 0;
891	#if (-r "/etc/portage/package.keywords") {
892	#open(KEYW,"/etc/portage/package.keywords");
893	#while (<KEYW>) {
894	#$found = 1 if (/portage\/pb/);
895	#}
896	#close(KEYW);
897	#}
898	#if ($found == 0) {
899	#pb_system("sudo sh -c \"echo portage/pb >> /etc/portage/package.keywords\"");
900	#}
901
902	# Build
903	foreach my $f (@ebuildfile) {
904	if ($f =~ /\.ebuild$/) {
905	move($f,"$tmpd/$pbpkg-$pbver.ebuild");
906	pb_system("cd $tmpd ; ebuild $pbpkg-$pbver.ebuild clean ; ebuild $pbpkg-$pbver.ebuild digest ; ebuild $pbpkg-$pbver.ebuild package","verbose");
907	# Now move it where pb expects it
908	pb_mkdir_p("$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
909	move("$tmpd/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
910	}
911	}
912
913	$made="$made portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver.ebuild";
914	} elsif ($dtype eq "tgz") {
915	# Slackware family
916	$made="$made $pbpkg/$pbpkg-$pbver-*-$pbtag.tgz";
917
918	chdir "$ENV{'PBBUILDDIR'}" \|\| die "Unable to chdir to $ENV{'PBBUILDDIR'}";
919	pb_system("tar xfz $src","Extracting sources");
920	pb_system("tar xfz $src2","Extracting pbconf");
921	chdir "$pbpkg-$pbver" \|\| die "Unable to chdir to $pbpkg-$pbver";
922	symlink "pbconf/$ddir-$dver-$arch","install" \|\| die "Unable to symlink to pbconf/$ddir-$dver-$arch";
923	if (-x "install/pbslack") {
924	pb_system("./install/pbslack","Building package");
925	pb_system("sudo /sbin/makepkg -p -l y -c y $pbpkg","Packaging $pbpkg","verbose");
926	}
927	} else {
928	die "Unknown dtype format $dtype";
929	}
930	}
931	# Packages check if needed
932	if ($dtype eq "rpm") {
933	if (-f "/usr/bin/rpmlint") {
934	pb_system("rpmlint $made","Checking validity of rpms with rpmlint","verbose");
935	}
936	} elsif ($dtype eq "deb") {
937	if (-f "/usr/bin/lintian") {
938	my $made2 = "";
939	foreach my $f (split(/ /,$made)) {
940	$made2 .= "$f " if ($f =~ /\.changes$/);
941	}
942	pb_system("lintian $made2","Checking validity of debs with lintian","verbose");
943	}
944	} else {
945	pb_log(0, "No check done for $dtype yet");
946	}
947
948	# Keep track of what is generated so that we can get them back from VMs
949	open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to create $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
950	print KEEP "$made\n";
951	close(KEEP);
952	}
953
954	sub pb_build2ssh {
955	pb_send2target("Sources");
956	}
957
958	sub pb_pkg2ssh {
959	pb_send2target("Packages");
960	}
961
962	# By default deliver to the the public site hosting the
963	# ftp structure (or whatever) or a VM/VE
964	sub pb_send2target {
965
966	my $cmt = shift;
967	my $v = shift \|\| undef;
968	my $vmexist = shift \|\| 0; # 0 is FALSE
969	my $vmpid = shift \|\| 0; # 0 is FALSE
970
971	pb_log(2,"DEBUG: pb_send2target($cmt,".Dumper($v).",$vmexist,$vmpid)\n");
972	my $host = "sshhost";
973	my $login = "sshlogin";
974	my $dir = "sshdir";
975	my $port = "sshport";
976	my $conf = "sshconf";
977	my $rebuild = "sshrebuild";
978	my $tmout = "vmtmout";
979	my $path = "vmpath";
980	if (($cmt eq "vm") \|\| ($cmt eq "Script")) {
981	$login = "vmlogin";
982	$dir = "pbdefdir";
983	$tmout = "vmtmout";
984	$rebuild = "vmrebuild";
985	# Specific VM
986	$host = "vmhost";
987	$port = "vmport";
988	} elsif ($cmt eq "ve") {
989	$login = "velogin";
990	$dir = "pbdefdir";
991	$tmout = "vetmout";
992	# Specific VE
993	$path = "vepath";
994	$conf = "veconf";
995	$rebuild = "verebuild";
996	} elsif ($cmt eq "Web") {
997	$host = "websshhost";
998	$login = "websshlogin";
999	$dir = "websshdir";
1000	$port = "websshport";
1001	}
1002	my $cmd = "";
1003	my $src = "";
1004	my ($odir,$over,$oarch) = (undef, undef, undef);
1005	my ($ddir, $dver, $dfam, $dtype, $pbsuf);
1006
1007	if ($cmt ne "Announce") {
1008	my $ptr = pb_get_pkg();
1009	@pkgs = @$ptr;
1010
1011	# Get the running distro to consider
1012	if (defined $v) {
1013	($odir,$over,$oarch) = split(/-/,$v);
1014	}
1015	($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($odir,$over);
1016	pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n");
1017
1018	# Get list of packages to build
1019	# Get content saved in cms2build
1020	my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1021	$pkg = { } if (not defined $pkg);
1022
1023	chdir "$ENV{'PBBUILDDIR'}";
1024	foreach my $pbpkg (@pkgs) {
1025	my $vertag = $pkg->{$pbpkg};
1026	# get the version of the current package - maybe different
1027	($pbver,$pbtag) = split(/-/,$vertag);
1028
1029	if (($cmt eq "Sources") \|\| ($cmt eq "vm") \|\| ($cmt eq "ve")) {
1030	$src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
1031	if ($cmd eq "") {
1032	$cmd = "ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
1033	} else {
1034	$cmd = "$cmd ; ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
1035	}
1036	}
1037	}
1038	# Adds conf file for availability of conf elements
1039	pb_conf_add("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb");
1040	}
1041
1042	if (($cmt eq "vm") \|\| ($cmt eq "ve")) {
1043	$src="$src $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc $ENV{'PBDESTDIR'}/pbscript";
1044	} elsif ($cmt eq "Script") {
1045	$src="$src $ENV{'PBDESTDIR'}/pbscript";
1046	} elsif (($cmt eq "Announce") \|\| ($cmt eq "Web")) {
1047	$src="$src $ENV{'PBTMP'}/pbscript";
1048	} elsif ($cmt eq "Packages") {
1049	# Get package list from file made during build2pkg
1050	open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1051	$src = <KEEP>;
1052	chomp($src);
1053	close(KEEP);
1054	$src="$src $ENV{'PBBUILDDIR'}/pbscript" if ($cmt ne "Sources");
1055	}
1056	# Remove potential leading spaces (cause problem with basename)
1057	$src =~ s/^ *//;
1058	my $basesrc = "";
1059	foreach my $i (split(/ +/,$src)) {
1060	$basesrc .= " ".basename($i);
1061	}
1062
1063	pb_log(0,"Sources handled ($cmt): $src\n");
1064	pb_log(2,"values: ".Dumper(($host,$login,$dir,$port,$tmout,$rebuild,$path,$conf))."\n");
1065	my ($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vepath) = pb_conf_get($host,$login,$dir,$port,$tmout,$path);
1066	my ($vrebuild,$veconf) = pb_conf_get_if($rebuild,$conf);
1067	pb_log(2,"ssh: ".Dumper(($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vrebuild,$vepath,$veconf))."\n");
1068	# Not mandatory
1069	my ($testver) = pb_conf_get_if("testver");
1070
1071	my $mac;
1072	# Useless for VE
1073	if ($cmt ne "ve") {
1074	$mac = "$sshlogin->{$ENV{'PBPROJ'}}\@$sshhost->{$ENV{'PBPROJ'}}";
1075	# Overwrite account value if passed as parameter
1076	$mac = "$pbaccount\@$sshhost->{$ENV{'PBPROJ'}}" if (defined $pbaccount);
1077	pb_log(2, "DEBUG: pbaccount: $pbaccount => mac: $mac\n") if (defined $pbaccount);
1078	}
1079
1080	my $tdir;
1081	my $bdir;
1082	if (($cmt eq "Sources") \|\| ($cmt eq "Script")) {
1083	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/src";
1084	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1085	# This is a test pkg => target dir is under test
1086	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/test/src";
1087	}
1088	} elsif (($cmt eq "vm") \|\| ($cmt eq "ve")) {
1089	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/delivery";
1090	$bdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/build";
1091	# Remove a potential $ENV{'HOME'} as bdir should be relative to pb's home
1092	$bdir =~ s\|\$ENV.+\}/\|\|;
1093	} elsif ($cmt eq "Announce") {
1094	$tdir = "$sshdir->{$ENV{'PBPROJ'}}";
1095	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1096	# This is a test pkg => target dir is under test
1097	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/test";
1098	}
1099	} elsif ($cmt eq "Web") {
1100	$tdir = "$sshdir->{$ENV{'PBPROJ'}}";
1101	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1102	# This is a test website => target dir is under test
1103	$tdir = $sshdir->{$ENV{'PBPROJ'}}."../test";
1104	}
1105	} elsif ($cmt eq "Packages") {
1106	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ddir/$dver";
1107
1108	if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1109	# This is a test pkg => target dir is under test
1110	$tdir = $sshdir->{$ENV{'PBPROJ'}}."/test/$ddir/$dver";
1111	}
1112
1113	my $repodir = $tdir;
1114	$repodir =~ s\|^$sshdir->{$ENV{'PBPROJ'}}/\|\|;
1115
1116	my ($pbrepo) = pb_conf_get("pbrepo");
1117
1118	# Repository management
1119	open(PBS,"> $ENV{'PBBUILDDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBBUILDDIR'}/pbscript";
1120	if ($dtype eq "rpm") {
1121	# Also make a pbscript to generate yum/urpmi bases
1122	print PBS << "EOF";
1123	#!/bin/bash
1124	# Prepare a script to ease yum setup
1125	cat > $ENV{'PBPROJ'}.repo << EOT
1126	[$ENV{'PBPROJ'}]
1127	name=$ddir $dver - $ENV{'PBPROJ'} Vanilla Packages
1128	baseurl=$pbrepo->{$ENV{'PBPROJ'}}/$repodir
1129	enabled=1
1130	gpgcheck=0
1131	EOT
1132	chmod 644 $ENV{'PBPROJ'}.repo
1133
1134	# Clean up old repo content
1135	rm -rf headers/ repodata/
1136	# Create yum repo
1137	yum-arch .
1138	# Create repodata
1139	createrepo .
1140	EOF
1141	if ($dfam eq "md") {
1142	# For Mandriva add urpmi management
1143	print PBS << "EOF";
1144	# Prepare a script to ease urpmi setup
1145	cat > $ENV{'PBPROJ'}.addmedia << EOT
1146	urpmi.addmedia $ENV{'PBPROJ'} $pbrepo->{$ENV{'PBPROJ'}}/$repodir with hdlist.cz
1147	EOT
1148	chmod 755 $ENV{'PBPROJ'}.addmedia
1149
1150	# Clean up old repo content
1151	rm -f hdlist.cz synthesis.hdlist.cz
1152	# Create urpmi repo
1153	genhdlist .
1154	EOF
1155	}
1156	if ($ddir eq "fedora") {
1157	# Extract the spec file to please Fedora maintainers :-(
1158	print PBS << "EOF";
1159	for p in $basesrc; do
1160	echo \$p \| grep -q 'src.rpm'
1161	if [ \$\? -eq 0 ]; then
1162	rpm2cpio \$p \| cpio -ivdum --quiet '*.spec'
1163	fi
1164	done
1165	EOF
1166	}
1167	} elsif ($dtype eq "deb") {
1168	# Also make a pbscript to generate apt bases
1169	# Cf: http://www.debian.org/doc/manuals/repository-howto/repository-howto.fr.html
1170	my $rpd = dirname("$pbrepo->{$ENV{'PBPROJ'}}/$repodir");
1171	print PBS << "EOF";
1172	#!/bin/bash
1173	# Prepare a script to ease apt setup
1174	cat > $ENV{'PBPROJ'}.sources.list << EOT
1175	deb $rpd $dver contrib
1176	deb-src $rpd $dver contrib
1177	EOT
1178	chmod 644 $ENV{'PBPROJ'}.sources.list
1179
1180	# Prepare a script to create apt info file
1181	(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)
1182	#(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)
1183	EOF
1184	}
1185	close(PBS);
1186	chmod 0755,"$ENV{'PBBUILDDIR'}/pbscript";
1187
1188	} else {
1189	return;
1190	}
1191
1192	# Useless for VE
1193	my $nport;
1194	if ($cmt ne "ve") {
1195	$nport = $sshport->{$ENV{'PBPROJ'}};
1196	$nport = "$pbport" if (defined $pbport);
1197	}
1198
1199	# Remove a potential $ENV{'HOME'} as tdir should be relative to pb's home
1200	$tdir =~ s\|\$ENV.+\}/\|\|;
1201
1202	my $tm = $vtmout->{$ENV{'PBPROJ'}};
1203
1204	# ssh communication if not VE
1205	# should use a hash instead...
1206	my ($shcmd,$cpcmd,$cptarget,$cp2target);
1207	if ($cmt ne "ve") {
1208	my $keyfile = pb_ssh_get(0);
1209	$shcmd = "ssh -i $keyfile -q -o UserKnownHostsFile=/dev/null -p $nport $mac";
1210	$cpcmd = "scp -i $keyfile -p -o UserKnownHostsFile=/dev/null -P $nport";
1211	$cptarget = "$mac:$tdir";
1212	if ($cmt eq "vm") {
1213	$cp2target = "$mac:$bdir";
1214	}
1215	} else {
1216	my $tp = $vepath->{$ENV{'PBPROJ'}};
1217	$shcmd = "sudo chroot $tp/$v /bin/su - $sshlogin->{$ENV{'PBPROJ'}} -c ";
1218	$cpcmd = "cp -a ";
1219	$cptarget = "$tp/$tdir";
1220	$cp2target = "$tp/$bdir";
1221	}
1222
1223	my $logres = "";
1224	# Do not touch when just announcing
1225	if ($cmt ne "Announce") {
1226	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");
1227	} else {
1228	$logres = "> ";
1229	}
1230	pb_system("cd $ENV{'PBBUILDDIR'} ; $cpcmd $src $cptarget 2> /dev/null","$cmt delivery in $cptarget");
1231
1232	# For VE we need to change the owner manually - To be tested if needed
1233	#if ($cmt eq "ve") {
1234	#pb_system("cd $cptarget ; sudo chown -R $sshlogin->{$ENV{'PBPROJ'}} .","$cmt chown in $cptarget to $sshlogin->{$ENV{'PBPROJ'}}");
1235	#}
1236	pb_system("$shcmd \"echo \'cd $tdir ; if [ -f pbscript ]; then ./pbscript; fi ; rm -f ./pbscript\' \| bash\"","Executing pbscript on $cptarget if needed","verbose");
1237	if (($cmt eq "vm") \|\| ($cmt eq "ve")) {
1238	# Get back info on pkg produced, compute their name and get them from the VM
1239	pb_system("$cpcmd $cp2target/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'} $ENV{'PBBUILDDIR'} 2> /dev/null","Get package names in $cp2target");
1240	open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1241	my $src = <KEEP>;
1242	chomp($src);
1243	close(KEEP);
1244	$src =~ s/^ *//;
1245	pb_mkdir_p("$ENV{'PBBUILDDIR'}/$odir/$over");
1246	# Change pgben to make the next send2target happy
1247	my $made = "";
1248	open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") \|\| die "Unable to write $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1249	foreach my $p (split(/ +/,$src)) {
1250	my $j = basename($p);
1251	pb_system("$cpcmd $cp2target/\'$p\' $ENV{'PBBUILDDIR'}/$odir/$over 2> /dev/null","Package recovery of $j in $cp2target");
1252	$made="$made $odir/$over/$j" if (($dtype ne "rpm") \|\| ($j !~ /.src.rpm$/));
1253	}
1254	print KEEP "$made\n";
1255	close(KEEP);
1256	pb_system("$shcmd \"rm -rf $tdir $bdir\"","$cmt cleanup");
1257
1258	# We want to send them to the ssh account so overwrite what has been done before
1259	undef $pbaccount;
1260	pb_log(2,"Before sending pkgs, vmexist: $vmexist, vmpid: $vmpid\n");
1261	pb_send2target("Packages",$odir."-".$over."-".$oarch,$vmexist,$vmpid);
1262	pb_rm_rf("$ENV{'PBBUILDDIR'}/$odir");
1263	}
1264	pb_log(2,"Before halt, vmexist: $vmexist, vmpid: $vmpid\n");
1265	if ((! $vmexist) && (($cmt eq "vm") \|\| ($cmt eq "Script"))) {
1266	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)");
1267	}
1268	}
1269
1270	sub pb_script2v {
1271	my $pbscript=shift;
1272	my $vtype=shift;
1273	my $force=shift \|\| 0; # Force stop of VM. Default not
1274	my $vm1=shift \|\| undef; # Only that VM to treat
1275	my $vm;
1276	my $all;
1277
1278	pb_log(2,"DEBUG: pb_script2v($pbscript,$vtype,$force,$vm1)\n");
1279	# Prepare the script to be executed on the VM
1280	# in $ENV{'PBDESTDIR'}/pbscript
1281	if ((defined $pbscript ) && ($pbscript ne "$ENV{'PBDESTDIR'}/pbscript")) {
1282	copy($pbscript,"$ENV{'PBDESTDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
1283	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
1284	}
1285
1286	if (not defined $vm1) {
1287	($vm,$all) = pb_get_v($vtype);
1288	} else {
1289	@$vm = ($vm1);
1290	}
1291	my ($vmexist,$vmpid) = (undef,undef);
1292
1293	foreach my $v (@$vm) {
1294	# Launch the VM/VE
1295	if ($vtype eq "vm") {
1296	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1297	pb_log(2,"DEBUG: After pb_launchv, vmexist: $vmexist, vmpid: $vmpid\n");
1298
1299	# Skip that VM if something went wrong
1300	next if (($vmpid == 0) && ($vmexist == 0));
1301
1302	# If force stopping the VM then reset vmexist
1303	if ($force == 1) {
1304	$vmpid = $vmexist;
1305	$vmexist = 0;
1306	}
1307	}
1308
1309	# Gather all required files to send them to the VM
1310	# and launch the build through pbscript
1311	pb_log(2,"DEBUG: Before send2target, vmexist: $vmexist, vmpid: $vmpid\n");
1312	pb_send2target("Script","$v",$vmexist,$vmpid);
1313
1314	}
1315	}
1316
1317	sub pb_launchv {
1318	my $vtype = shift;
1319	my $v = shift;
1320	my $create = shift \|\| 0; # By default do not create a VM
1321
1322	pb_log(2,"DEBUG: pb_launchv($vtype,$v,$create)\n");
1323	die "No VM/VE defined, unable to launch" if (not defined $v);
1324	# Keep only the first VM in case many were given
1325	$v =~ s/,.*//;
1326
1327	my $arch = pb_get_arch();
1328
1329	# Launch the VMs/VEs
1330	if ($vtype eq "vm") {
1331	die "-i iso parameter needed" if (((not defined $iso) \|\| ($iso eq "")) && ($create != 0));
1332
1333	my ($ptr,$vmopt,$vmpath,$vmport,$vmtmout,$vmsize) = pb_conf_get("vmtype","vmopt","vmpath","vmport","vmtmout","vmsize");
1334
1335	my $vmtype = $ptr->{$ENV{'PBPROJ'}};
1336	if (not defined $ENV{'PBVMOPT'}) {
1337	$ENV{'PBVMOPT'} = "";
1338	}
1339	# Set a default timeout of 2 minutes
1340	if (not defined $ENV{'PBVMTMOUT'}) {
1341	$ENV{'PBVMTMOUT'} = "120";
1342	}
1343	if (defined $vmopt->{$v}) {
1344	$ENV{'PBVMOPT'} .= " $vmopt->{$v}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$v}/);
1345	} elsif (defined $vmopt->{$ENV{'PBPROJ'}}) {
1346	$ENV{'PBVMOPT'} .= " $vmopt->{$ENV{'PBPROJ'}}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$ENV{'PBPROJ'}}/);
1347	}
1348	if (defined $vmtmout->{$v}) {
1349	$ENV{'PBVMTMOUT'} = $vmtmout->{$v};
1350	} elsif (defined $vmtmout->{$ENV{'PBPROJ'}}) {
1351	$ENV{'PBVMTMOUT'} = $vmtmout->{$ENV{'PBPROJ'}};
1352	}
1353	my $nport = $vmport->{$ENV{'PBPROJ'}};
1354	$nport = "$pbport" if (defined $pbport);
1355
1356	my $cmd;
1357	my $vmcmd; # has to be used for pb_check_ps
1358	my $vmm; # has to be used for pb_check_ps
1359	if ($vmtype eq "qemu") {
1360	my $qemucmd32;
1361	my $qemucmd64;
1362	if ($arch eq "x86_64") {
1363	$qemucmd32 = "/usr/bin/qemu-system-i386";
1364	$qemucmd64 = "/usr/bin/qemu";
1365	} else {
1366	$qemucmd32 = "/usr/bin/qemu";
1367	$qemucmd64 = "/usr/bin/qemu-system-x86_64";
1368	}
1369	if ($v =~ /x86_64/) {
1370	$vmcmd = "$qemucmd64";
1371	# Not needed with latest versions of qemu it seems
1372	#$vmcmd = "$qemucmd64 -no-kqemu";
1373	# This one may now be needed
1374	#$vmcmd = "$qemucmd64 -no-kvm";
1375	} else {
1376	$vmcmd = "$qemucmd32";
1377	}
1378	$vmm = "$vmpath->{$ENV{'PBPROJ'}}/$v.qemu";
1379	if ($create != 0) {
1380	$ENV{'PBVMOPT'} .= " -cdrom $iso -boot d";
1381	}
1382	$cmd = "$vmcmd $ENV{'PBVMOPT'} -redir tcp:$nport:10.0.2.15:22 $vmm"
1383	} elsif ($vmtype eq "xen") {
1384	} elsif ($vmtype eq "vmware") {
1385	} else {
1386	die "VM of type $vmtype not supported. Report to the dev team";
1387	}
1388	my ($tmpcmd,$void) = split(/ +/,$cmd);
1389	my $vmexist = pb_check_ps($tmpcmd,$vmm);
1390	my $vmpid = 0;
1391	if (! $vmexist) {
1392	if ($create != 0) {
1393	if (($vmtype eq "qemu") \|\| ($vmtype eq "xen")) {
1394	pb_system("/usr/bin/qemu-img create -f qcow2 $vmm $vmsize->{$ENV{'PBPROJ'}}","Creating the QEMU VM");
1395	} elsif ($vmtype eq "vmware") {
1396	} else {
1397	}
1398	}
1399	if (! -f "$vmm") {
1400	pb_log(0,"Unable to find VM $vmm\n");
1401	} else {
1402	pb_system("$cmd &","Launching the VM $vmm");
1403	pb_system("sleep $ENV{'PBVMTMOUT'}","Waiting $ENV{'PBVMTMOUT'} s for VM $v to come up");
1404	$vmpid = pb_check_ps($tmpcmd,$vmm);
1405	pb_log(0,"VM $vmm launched (pid $vmpid)\n");
1406	}
1407	} else {
1408	pb_log(0,"Found an existing VM $vmm (pid $vmexist)\n");
1409	}
1410	pb_log(2,"DEBUG: pb_launchv returns ($vmexist,$vmpid)\n");
1411	return($vmexist,$vmpid);
1412	# VE here
1413	} else {
1414	# Get VE context
1415	my ($ptr,$vetmout,$vepath,$verebuild,$veconf) = pb_conf_get("vetype","vetmout","vepath","verebuild","veconf");
1416	my $vetype = $ptr->{$ENV{'PBPROJ'}};
1417
1418	# Get distro context
1419	my ($name,$ver,$darch) = split(/-/,$v);
1420	chomp($darch);
1421	my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($name,$ver);
1422
1423	if ($vetype eq "chroot") {
1424	# Architecture consistency
1425	if ($arch ne $darch) {
1426	die "Unable to launch a VE of architecture $darch on a $arch platform" if (not (($darch eq "x86_64") && ($arch =~ /i?86/)));
1427	}
1428
1429	if (($create != 0) \|\| ($verebuild->{$ENV{'PBPROJ'}} eq "true") \|\| ($force == 1)) {
1430	# We have to rebuild the chroot
1431	if ($dtype eq "rpm") {
1432	pb_system("sudo /usr/sbin/mock --init --resultdir=\"/tmp\" --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" -r $v","Creating the mock VE");
1433	# Once setup we need to install some packages, the pb account, ...
1434	pb_system("sudo /usr/sbin/mock --install --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" -r $v su","Configuring the mock VE");
1435	#pb_system("sudo /usr/sbin/mock --init --resultdir=\"/tmp\" --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" --basedir=\"$vepath->{$ENV{'PBPROJ'}}\" -r $v","Creating the mock VE");
1436	} elsif ($dtype eq "deb") {
1437	pb_system("","Creating the pbuilder VE");
1438	} elsif ($dtype eq "ebuild") {
1439	die "Please teach the dev team how to build gentoo chroot";
1440	} else {
1441	die "Unknown distribution type $dtype. Report to dev team";
1442	}
1443	}
1444	# Nothing more to do for VE. No real launch
1445	} else {
1446	die "VE of type $vetype not supported. Report to the dev team";
1447	}
1448	}
1449	}
1450
1451	sub pb_build2v {
1452
1453	my $vtype = shift;
1454
1455	# Prepare the script to be executed on the VM/VE
1456	# in $ENV{'PBDESTDIR'}/pbscript
1457	#my ($ntp) = pb_conf_get($vtype."ntp");
1458	#my $vntp = $ntp->{$ENV{'PBPROJ'}};
1459
1460	open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript") \|\| die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
1461	print SCRIPT "#!/bin/bash\n";
1462	print SCRIPT "echo ... Execution needed\n";
1463	print SCRIPT "# This is in directory delivery\n";
1464	print SCRIPT "# Setup the variables required for building\n";
1465	print SCRIPT "export PBPROJ=$ENV{'PBPROJ'}\n";
1466	print SCRIPT "# Preparation for pb\n";
1467	print SCRIPT "mv .pbrc \$HOME\n";
1468	print SCRIPT "cd ..\n";
1469	# Force new date to be in the future compared to the date of the tar file by adding 1 minute
1470	my @date=pb_get_date();
1471	$date[1]++;
1472	my $upddate = strftime("%m%d%H%M%Y", @date);
1473	#print SCRIPT "echo Setting up date on $vntp...\n";
1474	# Or use ntpdate if available TBC
1475	print SCRIPT "sudo date $upddate\n";
1476	# Get list of packages to build and get some ENV vars as well
1477	my $ptr = pb_get_pkg();
1478	@pkgs = @$ptr;
1479	my $p = join(' ',@pkgs) if (@pkgs);
1480	print SCRIPT "export PBPROJVER=$ENV{'PBPROJVER'}\n";
1481	print SCRIPT "export PBPROJTAG=$ENV{'PBPROJTAG'}\n";
1482	print SCRIPT "export PBPACKAGER=\"$ENV{'PBPACKAGER'}\"\n";
1483	print SCRIPT "# Build\n";
1484	print SCRIPT "echo Building packages on $vtype...\n";
1485	print SCRIPT "pb -p $ENV{'PBPROJ'} build2pkg $p\n";
1486	close(SCRIPT);
1487	chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
1488
1489	my ($v,$all) = pb_get_v($vtype);
1490
1491	# Send tar files when we do a global generation
1492	pb_build2ssh() if ($all == 1);
1493
1494	my ($vmexist,$vmpid) = (undef,undef);
1495
1496	foreach my $v (@$v) {
1497	if ($vtype eq "vm") {
1498	# Launch the VM
1499	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1500
1501	# Skip that VM if it something went wrong
1502	next if (($vmpid == 0) && ($vmexist == 0));
1503	}
1504	# Gather all required files to send them to the VM/VE
1505	# and launch the build through pbscript
1506	pb_log(2,"Calling send2target $vtype,$v,$vmexist,$vmpid\n");
1507	pb_send2target($vtype,"$v",$vmexist,$vmpid);
1508	}
1509	}
1510
1511
1512	sub pb_newver {
1513
1514	die "-V Version parameter needed" if ((not defined $newver) \|\| ($newver eq ""));
1515
1516	# Need this call for PBDIR
1517	my ($scheme2,$uri) = pb_cms_init($pbinit);
1518
1519	my ($pbconf) = pb_conf_get("pbconfurl");
1520	$uri = $pbconf->{$ENV{'PBPROJ'}};
1521	my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);
1522
1523	# Checking CMS repositories status
1524	my ($pburl) = pb_conf_get("pburl");
1525	($scheme2, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}});
1526
1527	if ($scheme !~ /^svn/) {
1528	die "Only SVN is supported at the moment";
1529	}
1530
1531	my $res = pb_cms_isdiff($scheme,$ENV{'PBROOTDIR'});
1532	die "ERROR: No differences accepted in CMS for $ENV{'PBROOTDIR'} before creating a new version" if ($res != 0);
1533
1534	$res = pb_cms_isdiff($scheme2,$ENV{'PBDIR'});
1535	die "ERROR: No differences accepted in CMS for $ENV{'PBDIR'} before creating a new version" if ($res != 0);
1536
1537	# Tree identical between PBCONFDIR and PBROOTDIR. The delta is what
1538	# we want to get for the root of the new URL
1539
1540	my $tmp = $ENV{'PBROOTDIR'};
1541	$tmp =~ s\|^$ENV{'PBCONFDIR'}\|\|;
1542
1543	my $newurl = "$uri/".dirname($tmp)."/$newver";
1544	# Should probably use projver in the old file
1545	my $oldver= basename($tmp);
1546
1547	# Duplicate and extract project-builder part
1548	pb_log(2,"Copying $uri/$tmp to $newurl\n");
1549	pb_cms_copy($scheme,"$uri/$tmp",$newurl);
1550	pb_log(2,"Checkout $newurl to $ENV{'PBROOTDIR'}/../$newver\n");
1551	pb_cms_up($scheme,"$ENV{'PBCONFDIR'}/..");
1552
1553	# Duplicate and extract project
1554	my $newurl2 = "$pburl->{$ENV{'PBPROJ'}}/".dirname($tmp)."/$newver";
1555
1556	pb_log(2,"Copying $pburl->{$ENV{'PBPROJ'}}/$tmp to $newurl2\n");
1557	pb_cms_copy($scheme,"$pburl->{$ENV{'PBPROJ'}}/$tmp",$newurl2);
1558	pb_log(2,"Checkout $newurl2 to $ENV{'PBDIR'}/../$newver\n");
1559	pb_cms_up($scheme,"$ENV{'PBDIR'}/..");
1560
1561	# Update the .pb file
1562	open(FILE,"$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb") \|\| die "Unable to open $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb";
1563	open(OUT,"> $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new") \|\| die "Unable to write to $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new";
1564	while(<FILE>) {
1565	s/^projver\s+$ENV{'PBPROJ'}\s=\s$oldver/projver $ENV{'PBPROJ'} = $newver/;
1566	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/);
1567	s/^testver/#testver/;
1568	pb_log(0,"Commenting testver in $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb\n") if (/^testver/);
1569	print OUT $_;
1570	}
1571	close(FILE);
1572	close(OUT);
1573	rename("$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new","$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb");
1574
1575	# Checking pbcl files
1576	foreach my $f (<$ENV{'PBROOTDIR'}/*/pbcl>) {
1577	open(PBCL,$f) \|\| die "Unable to open $f";
1578	my $foundnew = 0;
1579	while (<PBCL>) {
1580	$foundnew = 1 if (/^$newver \(/);
1581	}
1582	close(PBCL);
1583	open(OUT,"> $f.new") \|\| die "Unable to write to $f.new: $!";
1584	open(PBCL,$f) \|\| die "Unable to open $f";
1585	while (<PBCL>) {
1586	print OUT "$_" if (not /^$oldver \(/);
1587	if ((/^$oldver \(/) && ($foundnew == 0)) {
1588	print OUT "$newver ($pbdate)\n";
1589	print OUT "- TBD\n";
1590	print OUT "\n";
1591	pb_log(0,"WARNING: version $newver not found in $f so added...") if ($foundnew == 0);
1592	}
1593	}
1594	close(OUT);
1595	close(PBCL);
1596	rename("$f.new","$f");
1597	}
1598
1599	pb_log(2,"Checkin $ENV{'PBROOTDIR'}/../$newver\n");
1600	pb_cms_checkin($scheme,"$ENV{'PBROOTDIR'}/../$newver",undef);
1601	}
1602
1603	#
1604	# Return the list of VMs/VEs we are working on
1605	# $all is a flag to know if we return all of them
1606	# or only some (if all we publish also tar files in addition to pkgs
1607	#
1608	sub pb_get_v {
1609
1610	my $vtype = shift;
1611	my @v;
1612	my $all = 0;
1613	my $vlist;
1614	my $pbv = 'PBV';
1615
1616	if ($vtype eq "vm") {
1617	$vlist = "vmlist";
1618	} elsif ($vtype eq "ve") {
1619	$vlist = "velist";
1620	}
1621	# Get VM/VE list
1622	if ((not defined $ENV{$pbv}) \|\| ($ENV{$pbv} =~ /^all$/)) {
1623	my ($ptr) = pb_conf_get($vlist);
1624	$ENV{$pbv} = $ptr->{$ENV{'PBPROJ'}};
1625	$all = 1;
1626	}
1627	pb_log(2,"$vtype: $ENV{$pbv}\n");
1628	@v = split(/,/,$ENV{$pbv});
1629	return(\@v,$all);
1630	}
1631
1632	# Function to create a potentialy missing pb account on the VM/VE, and adds it to sudo
1633	# Needs to use root account to connect to the VM/VE
1634	# pb will take your local public SSH key to access
1635	# the pb account in the VM later on if needed
1636	sub pb_setup_v {
1637
1638	my $vtype = shift;
1639
1640	my ($vm,$all) = pb_get_v($vtype);
1641
1642	# Script generated
1643	my $pbscript = "$ENV{'PBDESTDIR'}/setupv";
1644
1645	foreach my $v (@$vm) {
1646	# Name of the account to deal with for VM/VE
1647	# Do not use the one passed potentially with -a
1648	my ($pbac) = pb_conf_get($vtype."login");
1649	my ($key,$zero0,$zero1,$zero2);
1650	my ($vmexist,$vmpid,$ntps);
1651
1652	if ($vtype eq "vm") {
1653	# Prepare the key to be used and transfered remotely
1654	my $keyfile = pb_ssh_get(1);
1655
1656	my ($vmhost,$vmport,$vmntp) = pb_conf_get("vmhost","vmport","vmntp");
1657	my $nport = $vmport->{$ENV{'PBPROJ'}};
1658	$ntps = $vmntp->{$ENV{'PBPROJ'}};
1659	$nport = "$pbport" if (defined $pbport);
1660
1661	# Launch the VM
1662	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1663
1664	# Skip that VM if something went wrong
1665	next if (($vmpid == 0) && ($vmexist == 0));
1666
1667	# Store the pub key part in a variable
1668	open(FILE,"$keyfile.pub") \|\| die "Unable to open $keyfile.pub";
1669	($zero0,$zero1,$zero2) = split(/ /,<FILE>);
1670	close(FILE);
1671
1672	$key = "\Q$zero1";
1673
1674	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");
1675	# once this is done, we can do what we want on the VM remotely
1676	}
1677
1678	# Prepare the script to be executed on the VM/VE
1679	# in $ENV{'PBDESTDIR'}/setupv
1680
1681	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
1682	print SCRIPT << 'EOF';
1683	#!/usr/bin/perl -w
1684
1685	use strict;
1686	use File::Copy;
1687
1688	# We should not need in this script more functions than what is provided
1689	# by Base and Distribution to avoid problems at exec time.
1690	# They are appended at the end.
1691
1692	our $pbdebug;
1693	our $pbLOG;
1694	our $pbsynmsg = "pbscript";
1695	our $pbdisplaytype = "text";
1696	our $pblocale = "";
1697	pb_log_init($pbdebug, $pbLOG);
1698	pb_temp_init();
1699
1700	EOF
1701	if ($vtype eq "vm") {
1702	print SCRIPT << 'EOF';
1703	# Removes duplicate in .ssh/authorized_keys of our key if needed
1704	#
1705	my $file1="$ENV{'HOME'}/.ssh/authorized_keys";
1706	open(PBFILE,$file1) \|\| die "Unable to open $file1";
1707	open(PBOUT,"> $file1.new") \|\| die "Unable to open $file1.new";
1708	my $count = 0;
1709	while (<PBFILE>) {
1710
1711	EOF
1712	print SCRIPT << "EOF";
1713	if (/ $key /) {
1714	\$count++;
1715	}
1716	print PBOUT \$_ if ((\$count <= 1) \|\| (\$_ !~ / $key /));
1717	}
1718	close(PBFILE);
1719	close(PBOUT);
1720	rename("\$file1.new",\$file1);
1721	chmod 0600,\$file1;
1722
1723	# Sync date
1724	pb_system("/usr/sbin/ntpdate $ntps","Syncing date to $ntps");
1725
1726	EOF
1727	}
1728	print SCRIPT << 'EOF';
1729
1730	# Adds $pbac->{$ENV{'PBPROJ'}} as an account if needed
1731	#
1732	my $file="/etc/passwd";
1733	open(PBFILE,$file) \|\| die "Unable to open $file";
1734	my $found = 0;
1735	while (<PBFILE>) {
1736	EOF
1737	print SCRIPT << "EOF";
1738	\$found = 1 if (/^$pbac->{$ENV{'PBPROJ'}}:/);
1739	EOF
1740	print SCRIPT << 'EOF';
1741	}
1742	close(PBFILE);
1743
1744	if ( $found == 0 ) {
1745	if ( ! -d "/home" ) {
1746	pb_mkdir("/home");
1747	}
1748	EOF
1749	print SCRIPT << "EOF";
1750	pb_system("groupadd $pbac->{$ENV{'PBPROJ'}}","Adding group $pbac->{$ENV{'PBPROJ'}}");
1751	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'}}");
1752	}
1753
1754	# allow ssh entry to build
1755	#
1756	mkdir "/home/$pbac->{$ENV{'PBPROJ'}}/.ssh",0700;
1757	# Allow those accessing root to access the build account
1758	copy("\$ENV{'HOME'}/.ssh/authorized_keys","/home/$pbac->{$ENV{'PBPROJ'}}/.ssh/authorized_keys");
1759	chmod 0600,".ssh/authorized_keys";
1760	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'}}");
1761
1762	EOF
1763	print SCRIPT << 'EOF';
1764	# No passwd for build account only keys
1765	$file="/etc/shadow";
1766	open(PBFILE,$file) \|\| die "Unable to open $file";
1767	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
1768	while (<PBFILE>) {
1769	EOF
1770	print SCRIPT << "EOF";
1771	s/^$pbac->{$ENV{'PBPROJ'}}:\!\!:/$pbac->{$ENV{'PBPROJ'}}:*:/;
1772	s/^$pbac->{$ENV{'PBPROJ'}}:\!:/$pbac->{$ENV{'PBPROJ'}}:*:/; #SLES 9 e.g.
1773	EOF
1774	print SCRIPT << 'EOF';
1775	print PBOUT $_;
1776	}
1777	close(PBFILE);
1778	close(PBOUT);
1779	rename("$file.new",$file);
1780	chmod 0640,$file;
1781
1782	# Keep the VM in text mode
1783	$file="/etc/inittab";
1784	if (-f $file) {
1785	open(PBFILE,$file) \|\| die "Unable to open $file";
1786	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
1787	while (<PBFILE>) {
1788	s/^(..):5:initdefault:$/$1:3:initdefault:/;
1789	print PBOUT $_;
1790	}
1791	close(PBFILE);
1792	close(PBOUT);
1793	rename("$file.new",$file);
1794	chmod 0640,$file;
1795	}
1796
1797	# pb has to be added to portage group on gentoo
1798
1799	# Adapt sudoers
1800	$file="/etc/sudoers";
1801	open(PBFILE,$file) \|\| die "Unable to open $file";
1802	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
1803	while (<PBFILE>) {
1804	EOF
1805	print SCRIPT << "EOF";
1806	next if (/^$pbac->{$ENV{'PBPROJ'}} /);
1807	EOF
1808	print SCRIPT << 'EOF';
1809	s/Defaults[ \t]+requiretty//;
1810	print PBOUT $_;
1811	}
1812	close(PBFILE);
1813	EOF
1814	print SCRIPT << "EOF";
1815	# This is needed in order to be able to halt the machine from the $pbac->{$ENV{'PBPROJ'}} account at least
1816	print PBOUT "$pbac->{$ENV{'PBPROJ'}} ALL=(ALL) NOPASSWD:ALL\n";
1817	EOF
1818	print SCRIPT << 'EOF';
1819	close(PBOUT);
1820	rename("$file.new",$file);
1821	chmod 0440,$file;
1822
1823	EOF
1824
1825	my $SCRIPT = \*SCRIPT;
1826
1827	pb_install_deps($SCRIPT);
1828
1829	print SCRIPT << 'EOF';
1830	# Suse wants sudoers as 640
1831	if (($ddir eq "sles") \|\| (($ddir eq "suse")) && ($dver =~ /10.[012]/)) {
1832	chmod 0640,$file;
1833	}
1834
1835	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");
1836	system "pb 2>&1 \| head -5";
1837	EOF
1838	# Adds pb_distro_init from ProjectBuilder::Distribution and Base
1839	foreach my $d (@INC) {
1840	my @f = ("$d/ProjectBuilder/Base.pm","$d/ProjectBuilder/Distribution.pm");
1841	foreach my $f (@f) {
1842	if (-f "$f") {
1843	open(PBD,"$f") \|\| die "Unable to open $f";
1844	while (<PBD>) {
1845	next if (/^package/);
1846	next if (/^use Exporter/);
1847	next if (/^use ProjectBuilder::/);
1848	next if (/^our /);
1849	print SCRIPT $_;
1850	}
1851	close(PBD);
1852	}
1853	}
1854	}
1855	close(SCRIPT);
1856	chmod 0755,"$pbscript";
1857
1858	# That build script needs to be run as root and force stop of VM at end
1859	$pbaccount = "root";
1860
1861	# Force shutdown of VM exept if it was already launched
1862	my $force = 0;
1863	if ((! $vmexist) && ($vtype eq "vm")) {
1864	$force = 1;
1865	}
1866
1867	pb_script2v($pbscript,$vtype,$force,$v);
1868	}
1869	return;
1870	}
1871
1872	sub pb_install_deps {
1873
1874	my $SCRIPT = shift;
1875
1876	print {$SCRIPT} << 'EOF';
1877	# We need to have that pb_distro_init function
1878	# Get it from Project-Builder::Distribution
1879	my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init();
1880	print "distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n";
1881
1882	# Get and install pb
1883	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*";
1884	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*";
1885	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*";
1886	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*";
1887	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*";
1888	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*";
1889	my $cmtdm = "Installing Date-Manip perl module";
1890	my $cmtmb = "Installing Module-Build perl module";
1891	my $cmtfm = "Installing File-MimeInfo perl module";
1892	my $cmtfb = "Installing File-Basedir perl module";
1893	my $cmtms = "Installing Perl-Sendmail perl module";
1894	my $cmtlg = "Installing Perl-Locale-gettext perl module";
1895	my $cmtall = "Installing required modules";
1896
1897	if ( $ddir eq "fedora" ) {
1898	pb_system("yum clean all","Cleaning yum env");
1899	#system "yum update -y";
1900	my $arch=`uname -m`;
1901	my $opt = "";
1902	chomp($arch);
1903	if ($arch eq "x86_64") {
1904	$opt="--exclude=*.i?86";
1905	}
1906
1907	if ($dver eq 4) {
1908	pb_system("yum -y $opt install rpm-build wget patch ntp sudo perl-DateManip perl-ExtUtils-MakeMaker",$cmtall);
1909	pb_system("$insmb","$cmtmb");
1910	pb_system("$insfm","$cmtfm");
1911	pb_system("$insfb","$cmtfb");
1912	pb_system("$insms","$cmtms");
1913	pb_system("$inslg","$cmtlg");
1914	} else {
1915	pb_system("yum -y $opt install rpm-build wget patch ntp sudo perl-DateManip perl-ExtUtils-MakeMaker perl-File-MimeInfo perl-Mail-Sendmail",$cmtall);
1916	pb_system("$inslg","$cmtlg");
1917	}
1918	} elsif (( $dfam eq "rh" ) \|\| ($ddir eq "sles") \|\| (($ddir eq "suse") && (($dver eq "10.1") \|\| ($dver eq "10.0"))) \|\| ($ddir eq "slackware")) {
1919	# Suppose pkg are installed already as no online mirror available
1920	pb_system("rpm -e lsb 2>&1 > /dev/null","Removing lsb package");
1921	pb_system("$insdm","$cmtdm");
1922	pb_system("$insmb","$cmtmb");
1923	pb_system("$insfm","$cmtfm");
1924	pb_system("$insfb","$cmtfb");
1925	pb_system("$insms","$cmtms");
1926	pb_system("$inslg","$cmtlg");
1927	} elsif ($ddir eq "suse") {
1928	# New OpenSuSE
1929	pb_system("$insmb","$cmtmb");
1930	pb_system("$insfm","$cmtfm");
1931	pb_system("$insfb","$cmtfb");
1932	pb_system("$insms","$cmtms");
1933	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");
1934	} elsif ( $dfam eq "md" ) {
1935	pb_system("urpmi.update -a ; urpmi --auto rpm-build wget sudo patch ntp-client perl-File-MimeInfo perl-Mail-Sendmail perl-Locale-gettext","$cmtall");
1936	if (($ddir eq "mandrake") && ($dver eq "10.1")) {
1937	pb_system("$insdm","$cmtdm");
1938	pb_system("$inslg","$cmtlg");
1939	} else {
1940	pb_system("urpmi --auto perl-DateManip","$cmtdm");
1941	pb_system("urpmi --auto perl-Locale-gettext","$cmtdm");
1942	}
1943	} elsif ( $dfam eq "du" ) {
1944	if (( $dver eq "3.1" ) && ($ddir eq "debian")) {
1945	#system "apt-get update";
1946	pb_system("$insfb","$cmtfb");
1947	pb_system("$insfm","$cmtfm");
1948	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");
1949	} else {
1950	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");
1951	}
1952	} elsif ( $dfam eq "gen" ) {
1953	#system "emerge -u system";
1954	pb_system("emerge wget sudo ntp DateManip File-MimeInfo Mail-Sendmail Locale-gettext","$cmtall");
1955	} else {
1956	pb_log(0,"No pkg to install\n");
1957	}
1958	EOF
1959	}
1960
1961	sub pb_announce {
1962
1963	# Get all required parameters
1964	my ($pbpackager,$pbrepo,$pbml,$pbsmtp) = pb_conf_get("pbpackager","pbrepo","pbml","pbsmtp");
1965	my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
1966	my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
1967	my @pkgs = @$pkg;
1968	my %pkgs;
1969	my $first = 0;
1970
1971	# Command to find packages on repo
1972	my $findstr = "find . ";
1973	# Generated announce files
1974	my @files;
1975
1976	foreach my $pbpkg (@pkgs) {
1977	if ($first != 0) {
1978	$findstr .= "-o ";
1979	}
1980	$first++;
1981	if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
1982	$pbver = $pkgv->{$pbpkg};
1983	} else {
1984	$pbver = $ENV{'PBPROJVER'};
1985	}
1986	if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
1987	$pbtag = $pkgt->{$pbpkg};
1988	} else {
1989	$pbtag = $ENV{'PBPROJTAG'};
1990	}
1991
1992	# TODO: use virtual/real names here now
1993	$findstr .= "-name \'$pbpkg-$pbver-$pbtag\..rpm\' -o -name \'$pbpkg"."_$pbver\.deb\' -o -name \'$pbpkg-$pbver\.ebuild\' ";
1994
1995	my $chglog;
1996
1997	# Get project info on log file and generate tmp files used later on
1998	pb_cms_init($pbinit);
1999	$chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
2000	$chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
2001	$chglog = undef if (! -f $chglog);
2002
2003	open(OUT,"> $ENV{'PBTMP'}/$pbpkg.ann") \|\| die "Unable to create $ENV{'PBTMP'}/$pbpkg.ann: $!";
2004	pb_changelog("announce",$pbpkg,$pbver,"N/A","N/A","N/A",\*OUT,"yes",$chglog);
2005	close(OUT);
2006	push(@files,"$ENV{'PBTMP'}/$pbpkg.ann");
2007	}
2008	$findstr .= " \| grep -Ev \'src.rpm\'";
2009	if ((not defined $testver) \|\| (not defined $testver->{$ENV{'PBPROJ'}}) \|\| ($testver->{$ENV{'PBPROJ'}} !~ /true/i)) {
2010	$findstr .= " \| grep -v ./test/";
2011	}
2012
2013	# Prepare the command to run and execute it
2014	open(PBS,"> $ENV{'PBTMP'}/pbscript") \|\| die "Unable to create $ENV{'PBTMP'}/pbscript";
2015	print PBS "$findstr\n";
2016	close(PBS);
2017	chmod 0755,"$ENV{'PBTMP'}/pbscript";
2018	pb_send2target("Announce");
2019
2020	# Get subject line
2021	my $sl = "Project $ENV{'PBPROJ'} version $ENV{'PBPROJVER'} is now available";
2022	pb_log(0,"Please enter the title of your announce\n");
2023	pb_log(0,"(By default: $sl)\n");
2024	my $sl2 = <STDIN>;
2025	$sl = $sl2 if ($sl2 !~ /^$/);
2026
2027	# Prepare a template of announce
2028	open(ANN,"> $ENV{'PBTMP'}/announce.html") \|\| die "Unable to create $ENV{'PBTMP'}/announce.html: $!";
2029	print ANN << "EOF";
2030	$sl</p>
2031
2032	<p>The project team is happy to announce the availability of a newest version of $ENV{'PBPROJ'} $ENV{'PBPROJVER'}. Enjoy it as usual!</p>
2033	<p>
2034	Now available at <a href="$pbrepo->{$ENV{'PBPROJ'}}">$pbrepo->{$ENV{'PBPROJ'}}</a>
2035	</p>
2036	<p>
2037	EOF
2038	open(LOG,"$ENV{'PBTMP'}/system.log") \|\| die "Unable to read $ENV{'PBTMP'}/system.log: $!";
2039	my $col = 2;
2040	my $i = 1;
2041	print ANN << 'EOF';
2042	<TABLE WIDTH="700" CELLPADDING="0" CELLSPACING="0" BORDER="0">
2043	<TR>
2044	EOF
2045	while (<LOG>) {
2046	print ANN "<TD>$_</TD>";
2047	$i++;
2048	if ($i > $col) {
2049	print ANN "</TR>\n<TR>";
2050	$i = 1;
2051	}
2052	}
2053	close(LOG);
2054	print ANN << "EOF";
2055	</TR>
2056	</TABLE>
2057	</p>
2058
2059	<p>As usual source packages are also available in the same directory.</p>
2060
2061	<p>
2062	Changes are :
2063	</p>
2064	<p>
2065	EOF
2066	# Get each package changelog content
2067	foreach my $f (sort(@files)) {
2068	open(IN,"$f") \|\| die "Unable to read $f:$!";
2069	while (<IN>) {
2070	print ANN $_;
2071	}
2072	close(IN);
2073	print ANN "</p><p>\n";
2074	}
2075	print ANN "</p>\n";
2076	close(ANN);
2077
2078	# Allow for modification
2079	pb_system("vi $ENV{'PBTMP'}/announce.html","Allowing modification of the announce","noredir");
2080
2081	# Store it in DB for external usage (Web pages generation)
2082	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
2083
2084	my $precmd = "";
2085	if (! -f $db) {
2086	$precmd = "CREATE TABLE announces (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, announce VARCHAR[65535])";
2087	}
2088
2089	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
2090	{ RaiseError => 1, AutoCommit => 1 })
2091	\|\| die "Unable to connect to $db";
2092
2093	if ($precmd ne "") {
2094	my $sth = $dbh->prepare(qq{$precmd})
2095	\|\| die "Unable to create table into $db";
2096	$sth->execute();
2097	}
2098
2099	# To read whole file
2100	local $/;
2101	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
2102	my $announce = <ANN>;
2103	close(ANN);
2104
2105	pb_log(2,"INSERT INTO announces VALUES (NULL, $pbdate, $announce)");
2106	my $sth = $dbh->prepare(qq{INSERT INTO announces VALUES (NULL,?,?)})
2107	\|\| die "Unable to insert into $db";
2108	$sth->execute($pbdate, $announce);
2109	$dbh->disconnect;
2110
2111	# Then deliver it on the Web
2112	# $TOOLHOME/livwww www
2113
2114	# Mail it to project's ML
2115	open(ML,"\| w3m -dump -T text/html > $ENV{'PBTMP'}/announce.txt") \|\| die "Unable to create $ENV{'PBTMP'}/announce.txt: $!";
2116	print ML << 'EOF';
2117	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/x html1/DTD/xhtml1-strict.dtd">
2118
2119	<html xmlns="http://www.w3.org/1999/xhtml" dir="ltr" xml:lang="en" lang="en">
2120	<head>
2121	</head>
2122	<body>
2123	<p>
2124	EOF
2125	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
2126	while(<ANN>) {
2127	print ML $_;
2128	}
2129	print ML << 'EOF';
2130	</body>
2131	</html>
2132	EOF
2133	close(ML);
2134
2135	# To read whole file
2136	local $/;
2137	open(ANN,"$ENV{'PBTMP'}/announce.txt") \|\| die "Unable to read $ENV{'PBTMP'}/announce.txt: $!";
2138	my $msg = <ANN>;
2139	close(ANN);
2140
2141	# Preparation of headers
2142
2143	my %mail = (
2144	To => $pbml->{$ENV{'PBPROJ'}},
2145	From => $pbpackager->{$ENV{'PBPROJ'}},
2146	Smtp => $pbsmtp->{$ENV{'PBPROJ'}},
2147	Body => $msg,
2148	Subject => "[ANNOUNCE] $sl",
2149	);
2150
2151	# Send mail
2152	sendmail(%mail) or die "Unable to send mail ($Mail::Sendmail::error): $Mail::Sendmail::log";
2153	}
2154
2155	#
2156	# Creates a set of HTML file containing the news for the project
2157	# based on what has been generated by the pb_announce function
2158	#
2159	sub pb_web_news2html {
2160
2161	my $dest = shift \|\| $ENV{'PBTMP'};
2162
2163	# Get all required parameters
2164	my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
2165
2166	# DB of announces for external usage (Web pages generation)
2167	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
2168
2169	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
2170	{ RaiseError => 1, AutoCommit => 1 })
2171	\|\| die "Unable to connect to $db";
2172	# For date handling
2173	$ENV{LANGUAGE}="C";
2174	my $firstjan = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year(), 0, 0, -1);
2175	my $oldfirst = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year()-1, 0, 0, -1);
2176	pb_log(2,"firstjan: $firstjan, oldfirst: $oldfirst, pbdate:$pbdate\n");
2177	my $all = $dbh->selectall_arrayref("SELECT id,date,announce FROM announces ORDER BY date DESC");
2178	my %news;
2179	$news{"cy"} = ""; # current year's news
2180	$news{"ly"} = ""; # last year news
2181	$news{"py"} = ""; # previous years news
2182	$news{"fp"} = ""; # first page news
2183	my $cpt = 4; # how many news for first page
2184	# Extract info from DB
2185	foreach my $row (@$all) {
2186	my ($id, $date, $announce) = @$row;
2187	$news{"cy"} = $news{"cy"}."<p><B>$date</B> $announce\n" if ((($date cmp $pbdate) le 0) && (($firstjan cmp $date) le 0));
2188	$news{"ly"} = $news{"ly"}."<p><B>$date</B> $announce\n" if ((($date cmp $firstjan) le 0) && (($oldfirst cmp $date) le 0));
2189	$news{"py"} = $news{"py"}."<p><B>$date</B> $announce\n" if (($date cmp $oldfirst) le 0);
2190	$news{"fp"} = $news{"fp"}."<p><B>$date</B> $announce\n" if ($cpt > 0);
2191	$cpt--;
2192	}
2193	pb_log(1,"news{fp}: ".$news{"fp"}."\n");
2194	$dbh->disconnect;
2195
2196	# Generate the HTML content
2197	foreach my $pref (keys %news) {
2198	open(NEWS,"> $dest/pb_web_$pref"."news.html") \|\| die "Unable to create $dest/pb_web_$pref"."news.html: $!";
2199	print NEWS "$news{$pref}";
2200	close(NEWS);
2201	}
2202	}
2203
2204
2205	# Return the SSH key file to use
2206	# Potentially create it if needed
2207
2208	sub pb_ssh_get {
2209
2210	my $create = shift \|\| 0; # Do not create keys by default
2211
2212	# Check the SSH environment
2213	my $keyfile = undef;
2214
2215	# We have specific keys by default
2216	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
2217	if (!(-e $keyfile) && ($create eq 1)) {
2218	pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
2219	}
2220
2221	$keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
2222	$keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
2223	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
2224	die "Unable to find your public ssh key under $keyfile" if (not defined $keyfile);
2225	return($keyfile);
2226	}
2227
2228
2229	# Returns the pid of a running VM command using a specific VM file
2230	sub pb_check_ps {
2231	my $vmcmd = shift;
2232	my $vmm = shift;
2233	my $vmexist = 0; # FALSE by default
2234
2235	open(PS, "ps auxhww\|") \|\| die "Unable to call ps";
2236	while (<PS>) {
2237	next if (! /$vmcmd/);
2238	next if (! /$vmm/);
2239	my ($void1, $void2);
2240	($void1, $vmexist, $void2) = split(/ +/);
2241	last;
2242	}
2243	return($vmexist);
2244	}
2245
2246
2247	sub pb_extract_build_files {
2248
2249	my $src=shift;
2250	my $dir=shift;
2251	my $ddir=shift;
2252	my $mandatory=shift \|\| "spec";
2253	my @files;
2254
2255	my $flag = "mayfail" if ($mandatory eq "patch");
2256	my $res;
2257
2258	if ($src =~ /tar\.gz$/) {
2259	$res = pb_system("tar xfpz $src $dir","Extracting $mandatory files from $src",$flag);
2260	} elsif ($src =~ /tar\.bz2$/) {
2261	$res = pb_system("tar xfpj $src $dir","Extracting $mandatory files from $src",$flag);
2262	} else {
2263	die "Unknown compression algorithm for $src";
2264	}
2265	# If not mandatory return now
2266	return() if (($res != 0) and ($mandatory eq "patch"));
2267	opendir(DIR,"$dir") \|\| die "Unable to open directory $dir";
2268	foreach my $f (readdir(DIR)) {
2269	next if ($f =~ /^\./);
2270	# Skip potential patch dir
2271	next if ($f =~ /^pbpatch/);
2272	move("$dir/$f","$ddir") \|\| die "Unable to move $dir/$f to $ddir";
2273	pb_log(2,"mv $dir/$f $ddir\n");
2274	push @files,"$ddir/$f";
2275	}
2276	closedir(DIR);
2277	# Not enough but still a first cleanup
2278	pb_rm_rf("$dir");
2279	return(@files);
2280	}
2281
2282	sub pb_list_bfiles {
2283
2284	my $dir = shift;
2285	my $pbpkg = shift;
2286	my $bfiles = shift;
2287	my $pkgfiles = shift;
2288	my $supfiles = shift;
2289
2290	opendir(BDIR,"$dir") \|\| die "Unable to open dir $dir: $!";
2291	foreach my $f (readdir(BDIR)) {
2292	next if ($f =~ /^\./);
2293	$bfiles->{$f} = "$dir/$f";
2294	$bfiles->{$f} =~ s~$ENV{'PBROOTDIR'}~~;
2295	if (defined $supfiles->{$pbpkg}) {
2296	$pkgfiles->{$f} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
2297	}
2298	}
2299	closedir(BDIR);
2300	}
2301
2302
2303	#
2304	# Return the list of packages we are working on in a non CMS action
2305	#
2306	sub pb_get_pkg {
2307
2308	my @pkgs = ();
2309
2310	my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
2311	@pkgs = keys %$var;
2312
2313	pb_log(0,"Packages: ".join(',',@pkgs)."\n");
2314	return(\@pkgs);
2315	}
2316
2317	# Which is our local arch ? (standardize on i386 for those platforms)
2318	sub pb_get_arch {
2319
2320	my $arch = `uname -m`;
2321	chomp($arch);
2322	$arch =~ s/i.86/i386/;
2323	return($arch);
2324	}
2325
2326	1;

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

Download in other formats: