Context Navigation

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

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

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

Download in other formats: