Context Navigation

source: 0.9.3/pb/bin/pb @ 516

Revision 516, 68.9 KB checked in by bruno, 5 years ago (diff)
Remove everthing related to gettext for 0.9.3. Will have to look closer at which modules are really to be used for that (Locale::gettext or libintl)
Property svn:executable set to ``*

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

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

Download in other formats: