Context Navigation

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

Last change on this file since 539 was 539, checked in by Bruno Cornec, 16 years ago
First attempt to code support for real/virtual names for packages in order to support perl naming in both Debian and RPM distributions
Property svn:executable set to ``*
File size: 70.4 KB

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

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

Download in other formats: