Context Navigation

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

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

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

Download in other formats: