Context Navigation

source: devel/pb/bin/pb @ 547

Revision 547, 72.8 KB checked in by bruno, 5 years ago (diff)
First coding of pb_web_news2html which generates news from the announces DB in order to be used on the Website
Property svn:executable set to ``*

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

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

Download in other formats: