Context Navigation

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

Last change on this file since 540 was 540, checked in by Bruno Cornec, 16 years ago
Fix #32 for RPMS based packages
Property svn:executable set to ``*
File size: 70.6 KB

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

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

Download in other formats: