Context Navigation

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

Last change on this file since 493 was 493, checked in by Bruno Cornec, 16 years ago
Split the pbconf dir content in a seaparate tar file to allow for matching upstream tar files. this should permit to handle patches more easily now.
Property svn:executable set to ``*
File size: 64.8 KB

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

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

Download in other formats: