Context Navigation

source: devel/pb/bin/pb @ 556

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

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

Download in other formats: