Context Navigation

source: 0.9.3/pb/bin/pb @ 518

Revision 518, 69.2 KB checked in by bruno, 5 years ago (diff)

Fix for fedora VM setups
Support for ntp server added to avoid time sync issues in VMs

(backport from devel)

Property svn:executable set to *

Line
1	#!/usr/bin/perl -w
2	#
3	# Project Builder main application
4	#
5	# $Id$
6	#
7	# Copyright B. Cornec 2007
8	# Provided under the GPL v2
9
10	# Syntax: see at end
11
12	use strict 'vars';
13	use Getopt::Long qw(:config auto_abbrev no_ignore_case);
14	use Data::Dumper;
15	use English;
16	use File::Basename;
17	use File::Copy;
18	use File::stat;
19	use File::Temp qw(tempdir);
20	use 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);
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	$nport = "$pbport" if (defined $pbport);
1556
1557	# Launch the VM
1558	($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1559
1560	# Skip that VM if something went wrong
1561	next if (($vmpid == 0) && ($vmexist == 0));
1562
1563	# Store the pub key part in a variable
1564	open(FILE,"$keyfile.pub") \|\| die "Unable to open $keyfile.pub";
1565	($zero0,$zero1,$zero2) = split(/ /,<FILE>);
1566	close(FILE);
1567
1568	$key = "\Q$zero1";
1569
1570	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");
1571	# once this is done, we can do what we want on the VM remotely
1572	}
1573
1574	# Prepare the script to be executed on the VM/VE
1575	# in $ENV{'PBDESTDIR'}/setupv
1576
1577	open(SCRIPT,"> $pbscript") \|\| die "Unable to create $pbscript";
1578	print SCRIPT << 'EOF';
1579	#!/usr/bin/perl -w
1580
1581	use strict;
1582	use File::Copy;
1583
1584	# We should not need in this script more functions than what is provided
1585	# by Base and Distribution to avoid problems at exec time.
1586	# They are appended at the end.
1587
1588	our $pbdebug;
1589	our $pbLOG;
1590	our $pbsynmsg = "pbscript";
1591	our $pbdisplaytype = "text";
1592	our $pblocale = "";
1593	pb_log_init($pbdebug, $pbLOG);
1594	pb_temp_init();
1595
1596	EOF
1597	if ($vtype eq "vm") {
1598	print SCRIPT << 'EOF';
1599	# Removes duplicate in .ssh/authorized_keys of our key if needed
1600	#
1601	my $file1="$ENV{'HOME'}/.ssh/authorized_keys";
1602	open(PBFILE,$file1) \|\| die "Unable to open $file1";
1603	open(PBOUT,"> $file1.new") \|\| die "Unable to open $file1.new";
1604	my $count = 0;
1605	while (<PBFILE>) {
1606
1607	EOF
1608	print SCRIPT << "EOF";
1609	if (/ $key /) {
1610	\$count++;
1611	}
1612	print PBOUT \$_ if ((\$count <= 1) \|\| (\$_ !~ / $key /));
1613	}
1614	close(PBFILE);
1615	close(PBOUT);
1616	rename("\$file1.new",\$file1);
1617	chmod 0600,\$file1;
1618
1619	# Sync date
1620	pb_system("/usr/sbin/ntpdate \$vmntp->{'PBPRROJ'}","Syncing date to \$vmntp{'PBPRROJ'}");
1621
1622	EOF
1623	}
1624	print SCRIPT << 'EOF';
1625
1626	# Adds $pbac->{$ENV{'PBPROJ'}} as an account if needed
1627	#
1628	my $file="/etc/passwd";
1629	open(PBFILE,$file) \|\| die "Unable to open $file";
1630	my $found = 0;
1631	while (<PBFILE>) {
1632	EOF
1633	print SCRIPT << "EOF";
1634	\$found = 1 if (/^$pbac->{$ENV{'PBPROJ'}}:/);
1635	EOF
1636	print SCRIPT << 'EOF';
1637	}
1638	close(PBFILE);
1639
1640	if ( $found == 0 ) {
1641	if ( ! -d "/home" ) {
1642	pb_mkdir("/home");
1643	}
1644	EOF
1645	print SCRIPT << "EOF";
1646	pb_system("groupadd $pbac->{$ENV{'PBPROJ'}}","Adding group $pbac->{$ENV{'PBPROJ'}}");
1647	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'}}");
1648	}
1649
1650	# allow ssh entry to build
1651	#
1652	mkdir "/home/$pbac->{$ENV{'PBPROJ'}}/.ssh",0700;
1653	# Allow those accessing root to access the build account
1654	copy("\$ENV{'HOME'}/.ssh/authorized_keys","/home/$pbac->{$ENV{'PBPROJ'}}/.ssh/authorized_keys");
1655	chmod 0600,".ssh/authorized_keys";
1656	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'}}");
1657
1658	EOF
1659	print SCRIPT << 'EOF';
1660	# No passwd for build account only keys
1661	$file="/etc/shadow";
1662	open(PBFILE,$file) \|\| die "Unable to open $file";
1663	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
1664	while (<PBFILE>) {
1665	EOF
1666	print SCRIPT << "EOF";
1667	s/^$pbac->{$ENV{'PBPROJ'}}:\!\!:/$pbac->{$ENV{'PBPROJ'}}:*:/;
1668	s/^$pbac->{$ENV{'PBPROJ'}}:\!:/$pbac->{$ENV{'PBPROJ'}}:*:/; #SLES 9 e.g.
1669	EOF
1670	print SCRIPT << 'EOF';
1671	print PBOUT $_;
1672	}
1673	close(PBFILE);
1674	close(PBOUT);
1675	rename("$file.new",$file);
1676	chmod 0640,$file;
1677
1678	# Keep the VM in text mode
1679	$file="/etc/inittab";
1680	if (-f $file) {
1681	open(PBFILE,$file) \|\| die "Unable to open $file";
1682	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
1683	while (<PBFILE>) {
1684	s/^(..):5:initdefault:$/$1:3:initdefault:/;
1685	print PBOUT $_;
1686	}
1687	close(PBFILE);
1688	close(PBOUT);
1689	rename("$file.new",$file);
1690	chmod 0640,$file;
1691	}
1692
1693	# pb has to be added to portage group on gentoo
1694
1695	# Adapt sudoers
1696	$file="/etc/sudoers";
1697	open(PBFILE,$file) \|\| die "Unable to open $file";
1698	open(PBOUT,"> $file.new") \|\| die "Unable to open $file.new";
1699	while (<PBFILE>) {
1700	EOF
1701	print SCRIPT << "EOF";
1702	next if (/^$pbac->{$ENV{'PBPROJ'}} /);
1703	EOF
1704	print SCRIPT << 'EOF';
1705	s/Defaults[ \t]+requiretty//;
1706	print PBOUT $_;
1707	}
1708	close(PBFILE);
1709	EOF
1710	print SCRIPT << "EOF";
1711	# This is needed in order to be able to halt the machine from the $pbac->{$ENV{'PBPROJ'}} account at least
1712	print PBOUT "$pbac->{$ENV{'PBPROJ'}} ALL=(ALL) NOPASSWD:ALL\n";
1713	EOF
1714	print SCRIPT << 'EOF';
1715	close(PBOUT);
1716	rename("$file.new",$file);
1717	chmod 0440,$file;
1718
1719	EOF
1720
1721	my $SCRIPT = \*SCRIPT;
1722
1723	pb_install_deps($SCRIPT);
1724
1725	print SCRIPT << 'EOF';
1726	# Suse wants sudoers as 640
1727	if (($ddir eq "sles") \|\| (($ddir eq "suse")) && ($dver ne "10.3")) {
1728	chmod 0640,$file;
1729	}
1730
1731	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");
1732	system "pb 2>&1 \| head -5";
1733	EOF
1734	# Adds pb_distro_init from ProjectBuilder::Distribution and Base
1735	foreach my $d (@INC) {
1736	my @f = ("$d/ProjectBuilder/Base.pm","$d/ProjectBuilder/Distribution.pm");
1737	foreach my $f (@f) {
1738	if (-f "$f") {
1739	open(PBD,"$f") \|\| die "Unable to open $f";
1740	while (<PBD>) {
1741	next if (/^package/);
1742	next if (/^use Exporter/);
1743	next if (/^use ProjectBuilder::/);
1744	next if (/^our /);
1745	print SCRIPT $_;
1746	}
1747	close(PBD);
1748	}
1749	}
1750	}
1751	close(SCRIPT);
1752	chmod 0755,"$pbscript";
1753
1754	# That build script needs to be run as root and force stop of VM at end
1755	$pbaccount = "root";
1756
1757	# Force shutdown of VM exept if it was already launched
1758	my $force = 0;
1759	if ((! $vmexist) && ($vtype eq "vm")) {
1760	$force = 1;
1761	}
1762
1763	pb_script2v($pbscript,$vtype,$force,$v);
1764	}
1765	return;
1766	}
1767
1768	sub pb_install_deps {
1769
1770	my $SCRIPT = shift;
1771
1772	print {$SCRIPT} << 'EOF';
1773	# We need to have that pb_distro_init function
1774	# Get it from Project-Builder::Distribution
1775	my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init();
1776	print "distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n";
1777
1778	# Get and install pb
1779	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*";
1780	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*";
1781	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*";
1782	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*";
1783	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*";
1784	my $cmtdm = "Installing Date-Manip perl module";
1785	my $cmtmb = "Installing Module-Build perl module";
1786	my $cmtfm = "Installing File-MimeInfo perl module";
1787	my $cmtfb = "Installing File-Basedir perl module";
1788	my $cmtms = "Installing Perl-Sendmail perl module";
1789	my $cmtall = "Installing required modules";
1790
1791	if ( $ddir eq "fedora" ) {
1792	pb_system("yum clean all","Cleaning yum env");
1793	#system "yum update -y";
1794	my $arch=`uname -m`;
1795	my $opt = "";
1796	chomp($arch);
1797	if ($arch eq "x86_64") {
1798	$opt="--exclude=*.i?86";
1799	}
1800
1801	if ($dver eq 4) {
1802	pb_system("yum -y $opt install rpm-build wget patch ntp sudo perl-DateManip perl-ExtUtils-MakeMaker",$cmtall);
1803	pb_system("$insmb","$cmtmb");
1804	pb_system("$insfm","$cmtfm");
1805	pb_system("$insfb","$cmtfb");
1806	pb_system("$insms","$cmtms");
1807	} else {
1808	pb_system("yum -y $opt install rpm-build wget patch ntp sudo perl-DateManip perl-ExtUtils-MakeMaker perl-File-MimeInfo perl-Mail-Sendmail",$cmtall);
1809	}
1810	} elsif (( $dfam eq "rh" ) \|\| ($ddir eq "sles") \|\| (($ddir eq "suse") && (($dver eq "10.1") \|\| ($dver eq "10.0"))) \|\| ($ddir eq "slackware")) {
1811	# Suppose pkg are installed already as no online mirror available
1812	pb_system("rpm -e lsb 2>&1 > /dev/null","Removing lsb package");
1813	pb_system("$insdm","$cmtdm");
1814	pb_system("$insmb","$cmtmb");
1815	pb_system("$insfm","$cmtfm");
1816	pb_system("$insfb","$cmtfb");
1817	pb_system("$insms","$cmtms");
1818	} elsif ($ddir eq "suse") {
1819	# New OpenSuSE
1820	pb_system("$insmb","$cmtmb");
1821	pb_system("$insfm","$cmtfm");
1822	pb_system("$insfb","$cmtfb");
1823	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");
1824	} elsif ( $dfam eq "md" ) {
1825	pb_system("urpmi.update -a ; urpmi --auto rpm-build wget sudo patch ntp-client perl-File-MimeInfo perl-Mail-Sendmail","$cmtall");
1826	if (($ddir eq "mandrake") && ($dver eq "10.1")) {
1827	pb_system("$insdm","$cmtdm");
1828	} else {
1829	pb_system("urpmi --auto perl-DateManip","$cmtdm");
1830	}
1831	} elsif ( $dfam eq "du" ) {
1832	if (( $dver eq "3.1" ) && ($ddir eq "debian")) {
1833	#system "apt-get update";
1834	pb_system("$insfb","$cmtfb");
1835	pb_system("$insfm","$cmtfm");
1836	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");
1837	} else {
1838	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");
1839	}
1840	} elsif ( $dfam eq "gen" ) {
1841	#system "emerge -u system";
1842	pb_system("emerge wget sudo ntp DateManip File-MimeInfo Mail-Sendmail","$cmtall");
1843	} else {
1844	pb_log(0,"No pkg to install\n");
1845	}
1846	EOF
1847	}
1848
1849	sub pb_announce {
1850
1851	# Get all required parameters
1852	my ($pbpackager,$pbrepo,$pbml,$pbsmtp) = pb_conf_get("pbpackager","pbrepo","pbml","pbsmtp");
1853	my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
1854	my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
1855	my @pkgs = @$pkg;
1856	my %pkgs;
1857	my $first = 0;
1858
1859	# Command to find packages on repo
1860	my $findstr = "find . ";
1861	# Generated announce files
1862	my @files;
1863
1864	foreach my $pbpkg (@pkgs) {
1865	if ($first != 0) {
1866	$findstr .= "-o ";
1867	}
1868	$first++;
1869	if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
1870	$pbver = $pkgv->{$pbpkg};
1871	} else {
1872	$pbver = $ENV{'PBPROJVER'};
1873	}
1874	if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
1875	$pbtag = $pkgt->{$pbpkg};
1876	} else {
1877	$pbtag = $ENV{'PBPROJTAG'};
1878	}
1879
1880	$findstr .= "-name \'$pbpkg-$pbver-$pbtag\..rpm\' -o -name \'$pbpkg"."_$pbver\.deb\' -o -name \'$pbpkg-$pbver\.ebuild\' ";
1881
1882	my $chglog;
1883
1884	# Get project info on log file and generate tmp files used later on
1885	pb_cms_init($pbinit);
1886	$chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
1887	$chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
1888	$chglog = undef if (! -f $chglog);
1889
1890	open(OUT,"> $ENV{'PBTMP'}/$pbpkg.ann") \|\| die "Unable to create $ENV{'PBTMP'}/$pbpkg.ann: $!";
1891	pb_changelog("announce",$pbpkg,$pbver,"N/A","N/A","N/A",\*OUT,"yes",$chglog);
1892	close(OUT);
1893	push(@files,"$ENV{'PBTMP'}/$pbpkg.ann");
1894	}
1895	$findstr .= " \| grep -Ev \'src.rpm\'";
1896	if ((not defined $testver) \|\| (not defined $testver->{$ENV{'PBPROJ'}}) \|\| ($testver->{$ENV{'PBPROJ'}} !~ /true/i)) {
1897	$findstr .= " \| grep -v ./test/";
1898	}
1899
1900	# Prepare the command to run and execute it
1901	open(PBS,"> $ENV{'PBTMP'}/pbscript") \|\| die "Unable to create $ENV{'PBTMP'}/pbscript";
1902	print PBS "$findstr\n";
1903	close(PBS);
1904	chmod 0755,"$ENV{'PBTMP'}/pbscript";
1905	pb_send2target("Announce");
1906
1907	# Get subject line
1908	my $sl = "Project $ENV{'PBPROJ'} version $ENV{'PBPROJVER'} is now available";
1909	pb_log(0,"Please enter the title of your announce\n");
1910	pb_log(0,"(By default: $sl)\n");
1911	my $sl2 = <STDIN>;
1912	$sl = $sl2 if ($sl2 !~ /^$/);
1913
1914	# Prepare a template of announce
1915	open(ANN,"> $ENV{'PBTMP'}/announce.html") \|\| die "Unable to create $ENV{'PBTMP'}/announce.html: $!";
1916	print ANN << "EOF";
1917	$sl</p>
1918
1919	<p>The project team is happy to announce the availability of a newest version of $ENV{'PBPROJ'} $ENV{'PBPROJVER'}. Enjoy it as usual!</p>
1920	<p>
1921	Now available at <a href="$pbrepo->{$ENV{'PBPROJ'}}">$pbrepo->{$ENV{'PBPROJ'}}</a>
1922	</p>
1923	<p>
1924	EOF
1925	open(LOG,"$ENV{'PBTMP'}/system.log") \|\| die "Unable to read $ENV{'PBTMP'}/system.log: $!";
1926	my $col = 2;
1927	my $i = 1;
1928	print ANN << 'EOF';
1929	<TABLE WIDTH="700" CELLPADDING="0" CELLSPACING="0" BORDER="0">
1930	<TR>
1931	EOF
1932	while (<LOG>) {
1933	print ANN "<TD>$_</TD>";
1934	$i++;
1935	if ($i > $col) {
1936	print ANN "</TR>\n<TR>";
1937	$i = 1;
1938	}
1939	}
1940	close(LOG);
1941	print ANN << "EOF";
1942	</TR>
1943	</TABLE>
1944	</p>
1945
1946	<p>As usual source packages are also available in the same directory.</p>
1947
1948	<p>
1949	Changes are :
1950	</p>
1951	<p>
1952	EOF
1953	# Get each package changelog content
1954	foreach my $f (sort(@files)) {
1955	open(IN,"$f") \|\| die "Unable to read $f:$!";
1956	while (<IN>) {
1957	print ANN $_;
1958	}
1959	close(IN);
1960	print ANN "</p><p>\n";
1961	}
1962	print ANN "</p>\n";
1963	close(ANN);
1964
1965	# Allow for modification
1966	pb_system("vi $ENV{'PBTMP'}/announce.html","Allowing modification of the announce","noredir");
1967
1968	# Store it in DB for external usage (Web pages generation)
1969	my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
1970
1971	my $precmd = "";
1972	if (! -f $db) {
1973	$precmd = "CREATE TABLE announces (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, announce VARCHAR[65535])";
1974	}
1975
1976	my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
1977	{ RaiseError => 1, AutoCommit => 1 })
1978	\|\| die "Unable to connect to $db";
1979
1980	if ($precmd ne "") {
1981	my $sth = $dbh->prepare(qq{$precmd})
1982	\|\| die "Unable to create table into $db";
1983	$sth->execute();
1984	}
1985
1986	# To read whole file
1987	local $/;
1988	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
1989	my $announce = <ANN>;
1990	close(ANN);
1991
1992	pb_log(2,"INSERT INTO announces VALUES (NULL, $pbdate, $announce)");
1993	my $sth = $dbh->prepare(qq{INSERT INTO announces VALUES (NULL,?,?)})
1994	\|\| die "Unable to insert into $db";
1995	$sth->execute($pbdate, $announce);
1996	$dbh->disconnect;
1997
1998	# Then deliver it on the Web
1999	# $TOOLHOME/livwww www
2000
2001	# Mail it to project's ML
2002	open(ML,"\| w3m -dump -T text/html > $ENV{'PBTMP'}/announce.txt") \|\| die "Unable to create $ENV{'PBTMP'}/announce.txt: $!";
2003	print ML << 'EOF';
2004	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/x html1/DTD/xhtml1-strict.dtd">
2005
2006	<html xmlns="http://www.w3.org/1999/xhtml" dir="ltr" xml:lang="en" lang="en">
2007	<head>
2008	</head>
2009	<body>
2010	<p>
2011	EOF
2012	open(ANN,"$ENV{'PBTMP'}/announce.html") \|\| die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
2013	while(<ANN>) {
2014	print ML $_;
2015	}
2016	print ML << 'EOF';
2017	</body>
2018	</html>
2019	EOF
2020	close(ML);
2021
2022	# To read whole file
2023	local $/;
2024	open(ANN,"$ENV{'PBTMP'}/announce.txt") \|\| die "Unable to read $ENV{'PBTMP'}/announce.txt: $!";
2025	my $msg = <ANN>;
2026	close(ANN);
2027
2028	# Preparation of headers
2029
2030	my %mail = (
2031	To => $pbml->{$ENV{'PBPROJ'}},
2032	From => $pbpackager->{$ENV{'PBPROJ'}},
2033	Smtp => $pbsmtp->{$ENV{'PBPROJ'}},
2034	Body => $msg,
2035	Subject => "[ANNOUNCE] $sl",
2036	);
2037
2038	# Send mail
2039	sendmail(%mail) or die "Unable to send mail ($Mail::Sendmail::error): $Mail::Sendmail::log";
2040	}
2041
2042	# Return the SSH key file to use
2043	# Potentially create it if needed
2044
2045	sub pb_ssh_get {
2046
2047	my $create = shift \|\| 0; # Do not create keys by default
2048
2049	# Check the SSH environment
2050	my $keyfile = undef;
2051
2052	# We have specific keys by default
2053	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
2054	if (!(-e $keyfile) && ($create eq 1)) {
2055	pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
2056	}
2057
2058	$keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
2059	$keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
2060	$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
2061	die "Unable to find your public ssh key under $keyfile" if (not defined $keyfile);
2062	return($keyfile);
2063	}
2064
2065
2066	# Returns the pid of a running VM command using a specific VM file
2067	sub pb_check_ps {
2068	my $vmcmd = shift;
2069	my $vmm = shift;
2070	my $vmexist = 0; # FALSE by default
2071
2072	open(PS, "ps auxhww\|") \|\| die "Unable to call ps";
2073	while (<PS>) {
2074	next if (! /$vmcmd/);
2075	next if (! /$vmm/);
2076	my ($void1, $void2);
2077	($void1, $vmexist, $void2) = split(/ +/);
2078	last;
2079	}
2080	return($vmexist);
2081	}
2082
2083
2084	sub pb_extract_build_files {
2085
2086	my $src=shift;
2087	my $dir=shift;
2088	my $ddir=shift;
2089	my $mandatory=shift \|\| "spec";
2090	my @files;
2091
2092	my $flag = "mayfail" if ($mandatory eq "patch");
2093	my $res;
2094
2095	if ($src =~ /tar\.gz$/) {
2096	$res = pb_system("tar xfpz $src $dir","Extracting $mandatory files from $src",$flag);
2097	} elsif ($src =~ /tar\.bz2$/) {
2098	$res = pb_system("tar xfpj $src $dir","Extracting $mandatory files from $src",$flag);
2099	} else {
2100	die "Unknown compression algorithm for $src";
2101	}
2102	# If not mandatory return now
2103	return() if (($res != 0) and ($mandatory eq "patch"));
2104	opendir(DIR,"$dir") \|\| die "Unable to open directory $dir";
2105	foreach my $f (readdir(DIR)) {
2106	next if ($f =~ /^\./);
2107	# Skip potential patch dir
2108	next if ($f =~ /^pbpatch/);
2109	move("$dir/$f","$ddir") \|\| die "Unable to move $dir/$f to $ddir";
2110	pb_log(2,"mv $dir/$f $ddir\n");
2111	push @files,"$ddir/$f";
2112	}
2113	closedir(DIR);
2114	# Not enough but still a first cleanup
2115	pb_rm_rf("$dir");
2116	return(@files);
2117	}
2118
2119	sub pb_list_bfiles {
2120
2121	my $dir = shift;
2122	my $pbpkg = shift;
2123	my $bfiles = shift;
2124	my $pkgfiles = shift;
2125	my $supfiles = shift;
2126
2127	opendir(BDIR,"$dir") \|\| die "Unable to open dir $dir: $!";
2128	foreach my $f (readdir(BDIR)) {
2129	next if ($f =~ /^\./);
2130	$bfiles->{$f} = "$dir/$f";
2131	$bfiles->{$f} =~ s~$ENV{'PBROOTDIR'}~~;
2132	if (defined $supfiles->{$pbpkg}) {
2133	$pkgfiles->{$f} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
2134	}
2135	}
2136	closedir(BDIR);
2137	}
2138
2139
2140	#
2141	# Return the list of packages we are working on in a non CMS action
2142	#
2143	sub pb_get_pkg {
2144
2145	my @pkgs = ();
2146
2147	my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
2148	@pkgs = keys %$var;
2149
2150	pb_log(0,"Packages: ".join(',',@pkgs)."\n");
2151	return(\@pkgs);
2152	}
2153
2154	# Which is our local arch ? (standardize on i386 for those platforms)
2155	sub pb_get_arch {
2156
2157	my $arch = `uname -m`;
2158	chomp($arch);
2159	$arch =~ s/i.86/i386/;
2160	return($arch);
2161	}
2162
2163	1;

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

Download in other formats: