source: devel/pb/bin/pb @ 865

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