source: devel/pb/bin/pb @ 767

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