Context Navigation

pb@ 521

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

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

Context Navigation

source: ProjectBuilder/0.9.3/pb/bin/pb@ 521

Download in other formats: