source: devel/pb/bin/pb @ 755

Last change on this file since 755 was 755, checked in by Bruno Cornec, 11 years ago
  • Adds snapshot support for VEs
  • Property svn:executable set to *
File size: 88.8 KB
Line 
1#!/usr/bin/perl -w
2#
3# Project Builder main application
4#
5# $Id$
6#
7# Copyright B. Cornec 2007
8# Provided under the GPL v2
9
10# Syntax: see at end
11
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_snap_v("vm");
461} elsif ($action =~ /^snapve$/) {
462    pb_snap_v("ve");
463} elsif ($action =~ /^snapvm$/) {
464    pb_setup_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 need to be grouped with a ',' separated 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                $virt{$d} = $d;
616            }
617
618            foreach my $d (keys %virt) {
619                my ($name,$ver,$arch) = split(/-/,$d);
620                chomp($arch);
621                my ($ddir, $dver, $dfam);
622                ($ddir, $dver, $dfam, $pb{'dtype'}, $pb{'suf'}, $pb{'upd'}) = pb_distro_init($name,$ver,$arch);
623                pb_log(2,"DEBUG: distro tuple: ".Dumper($ddir, $dver, $dfam, $pb{'dtype'}, $pb{'suf'})."\n");
624                pb_log(2,"DEBUG Filtering PBDATE => $pbdate, PBTAG => $pbtag, PBVER => $pbver\n");
625   
626                # We need to compute the real name of the package
627                my $pbrealpkg = pb_cms_get_real_pkg($pbpkg,$pb{'dtype'});
628                $pb{'realpkg'} = $pbrealpkg;
629                pb_log(1,"Virtual package $pbpkg has a real package name of $pbrealpkg on $ddir-$dver\n") if ($pbrealpkg ne $pbpkg);
630   
631                # Filter build files from the less precise up to the most with overloading
632                # Filter all files found, keeping the name, and generating in dest
633   
634                # Find all build files first relatively to PBROOTDIR
635                # Find also all specific files referenced in the .pb conf file
636                my %bfiles = ();
637                my %pkgfiles = ();
638                $build{"$ddir-$dver-$arch"} = "yes";
639   
640                if (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pb{'dtype'}") {
641                    pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pb{'dtype'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
642                } elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$dfam") {
643                    pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$dfam",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
644                } elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir") {
645                    pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
646                } elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver") {
647                    pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
648                } elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver-$arch") {
649                    pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver-$arch",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
650                } else {
651                    $build{"$ddir-$dver-$arch"} = "no";
652                    next;
653                }
654                pb_log(2,"DEBUG bfiles: ".Dumper(\%bfiles)."\n");
655   
656                # Get all filters to apply
657                my $ptr = pb_get_filters($pbpkg, $pb{'dtype'}, $dfam, $ddir, $dver);
658   
659                # Prepare local patches for this distro - They are always applied first - May be a problem one day
660                foreach my $p (sort(<$ENV{'PBROOTDIR'}/$pbpkg/pbpatch/*>)) {
661                    $patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.all$/));
662                    $patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.all$/);
663                    $patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$pb{'dtype'}$/));
664                    $patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$pb{'dtype'}$/);
665                    $patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$dfam$/));
666                    $patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$dfam$/);
667                    $patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir$/));
668                    $patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir$/);
669                    $patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir-$dver$/));
670                    $patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir-$dver$/);
671                    $patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir-$dver-$arch$/));
672                    $patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir-$dver-$arch$/);
673                }
674   
675                # Prepare also remote patches to be included - Applied after the local ones
676                foreach my $p ("all","$pb{'dtype'}","$dfam","$ddir","$ddir-$dver","$ddir-$dver-$arch") {
677                    my $f = "$ENV{'PBROOTDIR'}/$pbpkg/pbextpatch.$p";
678                    next if (not -f $f);
679                    if (not open(PATCH,$f)) {
680                        pb_display("Unable to open existing external patch file content $f\n");
681                        next;
682                    }
683                    while (<PATCH>) {
684                        chomp();
685                        $patches{"$ddir-$dver-$arch"} .= "," if (defined $patches{"$ddir-$dver-$arch"});
686                        $patches{"$ddir-$dver-$arch"} .= "$_";
687                    }
688                    close(PATCH);
689                }
690                pb_log(2,"DEBUG: pb->patches: ".Dumper($pb{'patches'})."\n");
691   
692                # Apply now all the filters on all the files concerned
693                # destination dir depends on the type of file
694                if (defined $ptr) {
695                    # For patch support
696                    $pb{'tuple'} = "$ddir-$dver-$arch";
697                    foreach my $f (values %bfiles,values %pkgfiles) {
698                        pb_filter_file("$ENV{'PBROOTDIR'}/$f",$ptr,"$dest/pbconf/$ddir-$dver-$arch/".basename($f),\%pb);
699                    }
700                }
701            }
702            my @found;
703            my @notfound;
704            foreach my $b (keys %build) {
705                push @found,$b if ($build{$b} =~ /yes/);
706                push @notfound,$b if ($build{$b} =~ /no/);
707            }
708            pb_log(0,"Build files generated for ".join(',',sort(@found))."\n");
709            pb_log(0,"No Build files found for ".join(',',sort(@notfound))."\n") if (@notfound);
710            pb_log(2,"DEBUG: patches: ".Dumper(%patches)."\n");
711        }
712
713        # Get the generic filter (all.pbf) and
714        # apply those to the non-build files including those
715        # generated by pbinit if applicable
716
717        # Get only all.pbf filter
718        my $ptr = pb_get_filters($pbpkg);
719
720        my $liste ="";
721        if (defined $filteredfiles->{$pbpkg}) {
722            foreach my $f (split(/,/,$filteredfiles->{$pbpkg})) {
723                pb_filter_file_inplace($ptr,"$dest/$f",\%pb);
724                $liste = "$f $liste";
725            }
726        }
727        pb_log(2,"Files ".$liste."have been filtered\n");
728
729        # Do not do that for website
730        if ((not defined $param) || ($param ne "Web")) {
731            my %tmp;
732            # Filter potential patches (local + remote)
733            pb_log(0,"Delivering and compressing patches ");
734            foreach my $v (keys %patches) {
735                pb_mkdir_p("$dest/pbconf/$v/pbpatch");
736                foreach my $pf (split(/,/,$patches{$v})) {
737                    my $pp = basename($pf);
738                    pb_cms_export($pf,undef,"$dest/pbconf/$v/pbpatch");
739                    pb_filter_file_inplace($ptr,"$dest/pbconf/$v/pbpatch/$pp",\%pb);
740                    pb_system("gzip -9f $dest/pbconf/$v/pbpatch/$pp","","quiet");
741                    $tmp{$pf} = "";
742                }
743            }
744            foreach my $v (keys %tmp) {
745                pb_log(0,"$v ");
746            }
747            pb_log(0,"\n");
748        } else {
749            # Instead call News generation
750            pb_web_news2html($dest);
751            # And create an empty pbconf
752            pb_mkdir_p("$dest/pbconf");
753            # And prepare the pbscript to execute remotely
754            open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript") || die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
755            print SCRIPT "#!/bin/bash\n";
756            print SCRIPT "#set -x\n";
757            print SCRIPT "echo ... Extracting Website content\n";
758            print SCRIPT "find . -type f | grep -Ev '^./$pbpkg-$pbver.tar.gz|^./pbscript' | xargs rm -f non-existent\n";
759            print SCRIPT "find * -type d -depth | xargs rmdir 2> /dev/null \n";
760            print SCRIPT "tar xfz $pbpkg-$pbver.tar.gz\n";
761            print SCRIPT "mv $pbpkg-$pbver/* .\n";
762            print SCRIPT "rm -f $pbpkg-$pbver.tar.gz\n";
763            print SCRIPT "rmdir $pbpkg-$pbver\n";
764            close(SCRIPT);
765        }
766
767        # Prepare the dest directory for archive
768        if (-x "$ENV{'PBROOTDIR'}/$pbpkg/pbinit") {
769            pb_filter_file("$ENV{'PBROOTDIR'}/$pbpkg/pbinit",$ptr,"$ENV{'PBTMP'}/pbinit",\%pb);
770            chmod 0755,"$ENV{'PBTMP'}/pbinit";
771            pb_system("cd $dest ; $ENV{'PBTMP'}/pbinit","Executing init script from $ENV{'PBROOTDIR'}/$pbpkg/pbinit","verbose");
772        }
773
774        # Do we have additional script to run to prepare the environement for the project ?
775        # Then include it in the pbconf delivery
776        foreach my $pbvf ("pbvebuild.pre","pbvmbuild.pre","pbvebuild.post","pbvmbuild.post") {
777            if (-x "$ENV{'PBROOTDIR'}/$pbvf") {
778                pb_filter_file("$ENV{'PBROOTDIR'}/$pbvf",$ptr,"$ENV{'PBDESTDIR'}/$pbvf",\%pb);
779                chmod 0755,"$ENV{'PBDESTDIR'}/$pbvf";
780            }
781        }
782
783        # Archive dest dir
784        chdir "$ENV{'PBDESTDIR'}" || die "Unable to change dir to $ENV{'PBDESTDIR'}";
785        if (defined $preserve) {
786            # In that case we want to preserve the original tar file for checksum purposes
787            # The one created is btw equivalent in that case to this one
788            # Maybe check basename of both to be sure they are the same ?
789            pb_log(0,"Preserving original tar file ");
790            move("$preserve","$pbpkg-$pbver.tar.gz");
791        } else {
792            # Possibility to look at PBSRC to guess more the filename
793            pb_system("tar cfz $pbpkg-$pbver.tar.gz --exclude=$pbpkg-$pbver/pbconf $pbpkg-$pbver","Creating $pbpkg tar files compressed");
794        }
795        pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz\n");
796        pb_system("tar cfz $pbpkg-$pbver.pbconf.tar.gz $pbpkg-$pbver/pbconf","Creating pbconf tar files compressed");
797        pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz\n");
798
799        # Keep track of version-tag per pkg
800        $pkgs{$pbpkg} = "$pbver-$pbtag";
801
802        # Final cleanup
803        pb_rm_rf($dest) if (-d $dest);
804    }
805
806    # Keep track of per package version
807    pb_log(2,"DEBUG pkgs: ".Dumper(%pkgs)."\n");
808    open(PKG,"> $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb") || die "Unable to create $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb";
809    foreach my $pbpkg (keys %pkgs) {
810        print PKG "pbpkg $pbpkg = $pkgs{$pbpkg}\n";
811    }
812    close(PKG);
813
814    # Keep track of what is generated by default
815    # We need to store the dir and info on version-tag
816    # Base our content on the existing .pb file
817    copy("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb","$ENV{'PBDESTDIR'}/pbrc");
818    open(LAST,">> $ENV{'PBDESTDIR'}/pbrc") || die "Unable to create $ENV{'PBDESTDIR'}/pbrc";
819    print LAST "pbroot $ENV{'PBPROJ'} = $ENV{'PBROOTDIR'}\n";
820    print LAST "projver $ENV{'PBPROJ'} = $ENV{'PBPROJVER'}\n";
821    print LAST "projtag $ENV{'PBPROJ'} = $ENV{'PBPROJTAG'}\n";
822    print LAST "pbpackager $ENV{'PBPROJ'} = $ENV{'PBPACKAGER'}\n";
823    close(LAST);
824}
825
826sub pb_build2pkg {
827
828    # Get the running distro to build on
829    my ($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd) = pb_distro_init();
830    pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd))."\n");
831
832    # Get list of packages to build
833    # Get content saved in cms2build
834    my $ptr = pb_get_pkg();
835    @pkgs = @$ptr;
836
837    my $arch = pb_get_arch();
838
839    my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
840    $pkg = { } if (not defined $pkg);
841
842    chdir "$ENV{'PBBUILDDIR'}";
843    my $made = ""; # pkgs made during build
844    foreach my $pbpkg (@pkgs) {
845        my $vertag = $pkg->{$pbpkg};
846        # get the version of the current package - maybe different
847        ($pbver,$pbtag) = split(/-/,$vertag);
848
849        my $src="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz";
850        my $src2="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
851        pb_log(2,"Source file: $src\n");
852        pb_log(2,"Pbconf file: $src2\n");
853
854        pb_log(2,"Working directory: $ENV{'PBBUILDDIR'}\n");
855        if ($dtype eq "rpm") {
856            foreach my $d ('RPMS','SRPMS','SPECS','SOURCES','BUILD') {
857                if (! -d "$ENV{'PBBUILDDIR'}/$d") {
858                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";
859                }
860            }
861
862            # Remove in case a previous link/file was there
863            unlink "$ENV{'PBBUILDDIR'}/SOURCES/".basename($src);
864            symlink "$src","$ENV{'PBBUILDDIR'}/SOURCES/".basename($src) || die "Unable to symlink $src in $ENV{'PBBUILDDIR'}/SOURCES";
865            # We need to first extract the spec file
866            my @specfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/","$ENV{'PBBUILDDIR'}/SPECS","spec");
867
868            # We need to handle potential patches to upstream sources
869            pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/pbpatch/","$ENV{'PBBUILDDIR'}/SOURCES","patch");
870
871            pb_log(2,"specfile: ".Dumper(\@specfile)."\n");
872            # set LANGUAGE to check for correct log messages
873            $ENV{'LANGUAGE'}="C";
874            # Older Redhat use _target_platform in %configure incorrectly
875            my $specialdef = "";
876            if (($ddir eq "redhat") || (($ddir eq "rhel") && ($dver eq "2.1"))) {
877                $specialdef = "--define \'_target_platform \"\"\'";
878            }
879
880            # If needed we may add repository to the build env
881            my $darch = pb_get_arch();
882            pb_distro_setuprepo($ddir,$dver,$darch,$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            my $darch = pb_get_arch();
911            pb_distro_setuprepo($ddir,$dver,$darch,$dtype);
912            pb_distro_installdeps("debian/control",$dtype,$pbupd);
913            pb_system("dpkg-buildpackage -us -uc -rfakeroot","Building package","verbose");
914            # Get the name of the generated packages
915            open(LOG,"$ENV{'PBTMP'}/system.log") || die "Unable to open $ENV{'PBTMP'}/system.log";
916            while (<LOG>) {
917                chomp();
918                my $tmp = $_;
919                next if ($tmp !~ /^dpkg-deb.*:/);
920                $tmp =~ s|.*../(.*)_(.*).deb.*|$1|;
921                $made="$made $tmp.dsc $tmp.tar.gz $tmp"."_*.deb $tmp"."_*.changes";
922            }
923            close(LOG);
924        } elsif ($dtype eq "ebuild") {
925            my @ebuildfile;
926            # For gentoo we need to take pb as subsystem name
927            # We put every apps here under sys-apps. hope it's correct
928            # We use pb's home dir in order to have a single OVERLAY line
929            my $tmpd = "$ENV{'HOME'}/portage/pb/sys-apps/$pbpkg";
930            pb_mkdir_p($tmpd) if (! -d "$tmpd");
931            pb_mkdir_p("$ENV{'HOME'}/portage/distfiles") if (! -d "$ENV{'HOME'}/portage/distfiles");
932
933            # We need to first extract the ebuild file
934            @ebuildfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/","$tmpd","ebuild");
935
936            # Prepare the build env for gentoo
937            my $found = 0;
938            my $pbbd = $ENV{'HOME'};
939            $pbbd =~ s|/|\\/|g;
940            if (-r "/etc/make.conf") {
941                open(MAKE,"/etc/make.conf");
942                while (<MAKE>) {
943                    $found = 1 if (/$pbbd\/portage/);
944                }
945                close(MAKE);
946            }
947            if ($found == 0) {
948                pb_system("sudo sh -c 'echo PORTDIR_OVERLAY=\"$ENV{'HOME'}/portage\" >> /etc/make.conf'");
949            }
950            #$found = 0;
951            #if (-r "/etc/portage/package.keywords") {
952            #open(KEYW,"/etc/portage/package.keywords");
953            #while (<KEYW>) {
954            #$found = 1 if (/portage\/pb/);
955            #}
956            #close(KEYW);
957            #}
958            #if ($found == 0) {
959            #pb_system("sudo sh -c \"echo portage/pb >> /etc/portage/package.keywords\"");
960            #}
961
962            # Build
963            foreach my $f (@ebuildfile) {
964                if ($f =~ /\.ebuild$/) {
965                    pb_distro_installdeps("$f",$dtype,$pbupd);
966                    move($f,"$tmpd/$pbpkg-$pbver.ebuild");
967                    pb_system("cd $tmpd ; ebuild $pbpkg-$pbver.ebuild clean ; ebuild $pbpkg-$pbver.ebuild digest ; ebuild $pbpkg-$pbver.ebuild package","verbose");
968                    # Now move it where pb expects it
969                    pb_mkdir_p("$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
970                    move("$tmpd/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
971                }
972            }
973
974            $made="$made portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver.ebuild";
975        } elsif ($dtype eq "tgz") {
976            # Slackware family
977            $made="$made $pbpkg/$pbpkg-$pbver-*-$pbtag.tgz";
978
979            chdir "$ENV{'PBBUILDDIR'}" || die "Unable to chdir to $ENV{'PBBUILDDIR'}";
980            pb_system("tar xfz $src","Extracting sources");
981            pb_system("tar xfz $src2","Extracting pbconf");
982            chdir "$pbpkg-$pbver" || die "Unable to chdir to $pbpkg-$pbver";
983            symlink "pbconf/$ddir-$dver-$arch","install" || die "Unable to symlink to pbconf/$ddir-$dver-$arch";
984            if (-x "install/pbslack") {
985                pb_distro_installdeps("./install/pbslack",$dtype,$pbupd);
986                pb_system("./install/pbslack","Building package");
987                pb_system("sudo /sbin/makepkg -p -l y -c y $pbpkg","Packaging $pbpkg","verbose");
988            }
989        } else {
990            die "Unknown dtype format $dtype";
991        }
992    }
993    # Packages check if needed
994    if ($dtype eq "rpm") {
995        if (-f "/usr/bin/rpmlint") {
996            pb_system("rpmlint $made","Checking validity of rpms with rpmlint","verbose");
997        } else {
998            pb_log(0,"rpm packages generated: $made\n");
999        }
1000    } elsif ($dtype eq "deb") {
1001        my $made2 = "";
1002        if (-f "/usr/bin/lintian") {
1003            foreach my $f (split(/ /,$made)) {
1004                $made2 .= "../$f " if ($f =~ /\.changes$/);
1005            }
1006            pb_system("lintian $made2","Checking validity of debs with lintian","verbose");
1007        } else {
1008            pb_log(0,"deb packages generated: $made2\n");
1009        }
1010    } else {
1011        pb_log(0,"No check done for $dtype yet\n");
1012        pb_log(0,"Packages generated: $made\n");
1013    }
1014
1015    # Keep track of what is generated so that we can get them back from VMs
1016    open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") || die "Unable to create $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1017    print KEEP "$made\n";
1018    close(KEEP);
1019}
1020
1021sub pb_build2ssh {
1022    pb_send2target("Sources");
1023}
1024
1025sub pb_pkg2ssh {
1026    pb_send2target("Packages");
1027}
1028
1029# By default deliver to the the public site hosting the
1030# ftp structure (or whatever) or a VM/VE
1031sub pb_send2target {
1032
1033    my $cmt = shift;
1034    my $v = shift || undef;
1035    my $vmexist = shift || 0;           # 0 is FALSE
1036    my $vmpid = shift || 0;             # 0 is FALSE
1037    my $snapme = shift || 0;            # 0 is FALSE
1038
1039    pb_log(2,"DEBUG: pb_send2target($cmt,".Dumper($v).",$vmexist,$vmpid)\n");
1040    my $host = "sshhost";
1041    my $login = "sshlogin";
1042    my $dir = "sshdir";
1043    my $port = "sshport";
1044    my $conf = "sshconf";
1045    my $rebuild = "sshrebuild";
1046    my $tmout = "vmtmout";
1047    my $path = "vmpath";
1048    if (($cmt eq "vm") || ($cmt eq "VMScript")) {
1049        $login = "vmlogin";
1050        $dir = "pbdefdir";
1051        $tmout = "vmtmout";
1052        $rebuild = "vmrebuild";
1053        # Specific VM
1054        $host = "vmhost";
1055        $port = "vmport";
1056    } elsif (($cmt eq "ve")|| ($cmt eq "VEScript")) {
1057        $login = "velogin";
1058        $dir = "pbdefdir";
1059        # Specific VE
1060        $path = "vepath";
1061        $conf = "veconf";
1062        $rebuild = "verebuild";
1063    } elsif ($cmt eq "Web") {
1064        $host = "websshhost";
1065        $login = "websshlogin";
1066        $dir = "websshdir";
1067        $port = "websshport";
1068    }
1069    my $cmd = "";
1070    my $src = "";
1071    my ($odir,$over,$oarch) = (undef, undef, undef);
1072    my ($ddir, $dver, $dfam, $dtype, $pbsuf);
1073
1074    if ($cmt ne "Announce") {
1075        my $ptr = pb_get_pkg();
1076        @pkgs = @$ptr;
1077
1078        # Get the running distro to consider
1079        if (defined $v) {
1080            ($odir,$over,$oarch) = split(/-/,$v);
1081        }
1082        ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($odir,$over,$oarch);
1083        pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n");
1084
1085        # Get list of packages to build
1086        # Get content saved in cms2build
1087        my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1088        $pkg = { } if (not defined $pkg);
1089
1090        chdir "$ENV{'PBBUILDDIR'}";
1091        foreach my $pbpkg (@pkgs) {
1092            my $vertag = $pkg->{$pbpkg};
1093            # get the version of the current package - maybe different
1094            ($pbver,$pbtag) = split(/-/,$vertag);
1095
1096            if (($cmt eq "Sources") || ($cmt eq "vm") || ($cmt eq "ve")) {
1097                $src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
1098                if ($cmd eq "") {
1099                    $cmd = "ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
1100                } else {
1101                    $cmd = "$cmd ; ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
1102                }
1103            } elsif ($cmt eq "Web") {
1104                $src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz"
1105            }
1106        }
1107        # Adds conf file for availability of conf elements
1108        pb_conf_add("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb");
1109    }
1110
1111    if (($cmt eq "vm") || ($cmt eq "ve")) {
1112        $src="$src $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc $ENV{'PBDESTDIR'}/pbscript";
1113    } elsif (($cmt =~ /V[EM]Script/) || ($cmt eq "Web")) {
1114        $src="$src $ENV{'PBDESTDIR'}/pbscript";
1115    } elsif ($cmt eq "Announce") {
1116        $src="$src $ENV{'PBTMP'}/pbscript";
1117    } elsif ($cmt eq "Packages") {
1118        # Get package list from file made during build2pkg
1119        open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") || die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1120        $src = <KEEP>;
1121        chomp($src);
1122        close(KEEP);
1123        $src="$src $ENV{'PBBUILDDIR'}/pbscript";
1124    }
1125    # Remove potential leading spaces (cause problem with basename)
1126    $src =~ s/^ *//;
1127    my $basesrc = "";
1128    foreach my $i (split(/ +/,$src)) {
1129        $basesrc .= " ".basename($i);
1130    }
1131
1132    pb_log(0,"Sources handled ($cmt): $src\n");
1133    pb_log(2,"values: ".Dumper(($host,$login,$dir,$port,$tmout,$rebuild,$path,$conf))."\n");
1134    my ($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vepath) = pb_conf_get($host,$login,$dir,$port,$tmout,$path);
1135    # Not mandatory
1136    my ($vrebuild,$veconf,$testver) = pb_conf_get_if($rebuild,$conf,"testver");
1137    pb_log(2,"ssh: ".Dumper(($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vrebuild,$vepath,$veconf))."\n");
1138
1139    my $mac;
1140    if (($cmt ne "ve") && ($cmt ne "VEScript")) {
1141        $mac = "$sshlogin->{$ENV{'PBPROJ'}}\@$sshhost->{$ENV{'PBPROJ'}}";
1142        # Overwrite account value if passed as parameter
1143        $mac = "$pbaccount\@$sshhost->{$ENV{'PBPROJ'}}" if (defined $pbaccount);
1144        pb_log(2, "DEBUG: pbaccount: $pbaccount => mac: $mac\n") if (defined $pbaccount);
1145    } else {
1146        # VE
1147        # Overwrite account value if passed as parameter (typically for setup_ve)
1148        $mac = $sshlogin->{$ENV{'PBPROJ'}};
1149        $mac = $pbaccount if (defined $pbaccount);
1150    }
1151
1152    my $tdir;
1153    my $bdir;
1154    if (($cmt eq "Sources") || ($cmt =~ /V[EM]Script/)) {
1155        $tdir = $sshdir->{$ENV{'PBPROJ'}}."/src";
1156        if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1157            # This is a test pkg => target dir is under test
1158            $tdir = $sshdir->{$ENV{'PBPROJ'}}."/test/src";
1159        }
1160    } elsif (($cmt eq "vm") || ($cmt eq "ve")) {
1161        $tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/delivery";
1162        $bdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/build";
1163        # Remove a potential $ENV{'HOME'} as bdir should be relative to pb's home
1164        $bdir =~ s|\$ENV.+\}/||;
1165    } elsif ($cmt eq "Announce") {
1166        $tdir = "$sshdir->{$ENV{'PBPROJ'}}";
1167        if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1168            # This is a test pkg => target dir is under test
1169            $tdir = $sshdir->{$ENV{'PBPROJ'}}."/test";
1170        }
1171    } elsif ($cmt eq "Web") {
1172        $tdir = "$sshdir->{$ENV{'PBPROJ'}}";
1173        if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1174            # This is a test website => target dir is under test
1175            $tdir = $sshdir->{$ENV{'PBPROJ'}}."/../test";
1176        }
1177    } elsif ($cmt eq "Packages") {
1178        $tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ddir/$dver";
1179
1180        if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1181            # This is a test pkg => target dir is under test
1182            $tdir = $sshdir->{$ENV{'PBPROJ'}}."/test/$ddir/$dver";
1183        }
1184
1185        my $repodir = $tdir;
1186        $repodir =~ s|^$sshdir->{$ENV{'PBPROJ'}}/||;
1187
1188        my ($pbrepo) = pb_conf_get("pbrepo");
1189
1190        # Repository management
1191        open(PBS,"> $ENV{'PBBUILDDIR'}/pbscript") || die "Unable to create $ENV{'PBBUILDDIR'}/pbscript";
1192        if ($dtype eq "rpm") {
1193            # Also make a pbscript to generate yum/urpmi bases
1194            print PBS << "EOF";
1195#!/bin/bash
1196# Prepare a script to ease yum setup
1197cat > $ENV{'PBPROJ'}.repo << EOT
1198[$ENV{'PBPROJ'}]
1199name=$ddir $dver - $ENV{'PBPROJ'} Vanilla Packages
1200baseurl=$pbrepo->{$ENV{'PBPROJ'}}/$repodir
1201enabled=1
1202gpgcheck=0
1203EOT
1204chmod 644 $ENV{'PBPROJ'}.repo
1205
1206# Clean up old repo content
1207rm -rf headers/ repodata/
1208# Create yum repo
1209yum-arch .
1210# Create repodata
1211createrepo .
1212EOF
1213            if ($dfam eq "md") {
1214                # For Mandriva add urpmi management
1215                print PBS << "EOF";
1216# Prepare a script to ease urpmi setup
1217cat > $ENV{'PBPROJ'}.addmedia << EOT
1218urpmi.addmedia $ENV{'PBPROJ'} $pbrepo->{$ENV{'PBPROJ'}}/$repodir with hdlist.cz
1219EOT
1220chmod 755 $ENV{'PBPROJ'}.addmedia
1221
1222# Clean up old repo content
1223rm -f hdlist.cz synthesis.hdlist.cz
1224# Create urpmi repo
1225genhdlist .
1226EOF
1227            }
1228            if ($ddir eq "fedora") {
1229                # Extract the spec file to please Fedora maintainers :-(
1230                print PBS << "EOF";
1231for p in $basesrc; do
1232    echo \$p | grep -q 'src.rpm'
1233    if [ \$\? -eq 0 ]; then
1234        rpm2cpio \$p | cpio -ivdum --quiet '*.spec'
1235    fi
1236done
1237EOF
1238            }
1239        } elsif ($dtype eq "deb") {
1240            # Also make a pbscript to generate apt bases
1241            # Cf: http://www.debian.org/doc/manuals/repository-howto/repository-howto.fr.html
1242            my $rpd = dirname("$pbrepo->{$ENV{'PBPROJ'}}/$repodir");
1243            print PBS << "EOF";
1244#!/bin/bash
1245# Prepare a script to ease apt setup
1246cat > $ENV{'PBPROJ'}.sources.list << EOT
1247deb $rpd $dver contrib
1248deb-src $rpd $dver contrib
1249EOT
1250chmod 644 $ENV{'PBPROJ'}.sources.list
1251
1252# Prepare a script to create apt info file
1253(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)
1254#(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)
1255EOF
1256        } elsif ($dtype eq "ebuild") {
1257            # make a pbscript to generate links to latest version
1258            print PBS << "EOF";
1259#!/bin/bash
1260# Prepare a script to create correct links
1261for p in $src; do
1262    echo \$p | grep -q '.ebuild'
1263    if [ \$\? -eq 0 ]; then
1264        j=`basename \$p`
1265        pp=`echo \$j | cut -d'-' -f1`
1266        ln -sf \$j \$pp.ebuild
1267    fi
1268done
1269EOF
1270        }
1271        close(PBS);
1272        chmod 0755,"$ENV{'PBBUILDDIR'}/pbscript";
1273    } else {
1274        return;
1275    }
1276
1277    # Useless for VE
1278    my $nport;
1279    if (($cmt ne "ve") && ($cmt ne "VEScript")) {
1280        $nport = $sshport->{$ENV{'PBPROJ'}};
1281        $nport = "$pbport" if (defined $pbport);
1282    }
1283
1284    # Remove a potential $ENV{'HOME'} as tdir should be relative to pb's home
1285    $tdir =~ s|\$ENV.+\}/||;
1286
1287    my $tm = $vtmout->{$ENV{'PBPROJ'}};
1288
1289    # ssh communication if not VE
1290    # should use a hash instead...
1291    my ($shcmd,$cpcmd,$cptarget,$cp2target);
1292    if (($cmt ne "ve") && ($cmt ne "VEScript")) {
1293        my $keyfile = pb_ssh_get(0);
1294        $shcmd = "ssh -i $keyfile -q -o UserKnownHostsFile=/dev/null -p $nport $mac";
1295        $cpcmd = "scp -i $keyfile -p -o UserKnownHostsFile=/dev/null -P $nport";
1296        $cptarget = "$mac:$tdir";
1297        if ($cmt eq "vm") {
1298            $cp2target = "$mac:$bdir";
1299        }
1300    } else {
1301        my $tp = $vepath->{$ENV{'PBPROJ'}};
1302        ($odir,$over,$oarch) = split(/-/,$v);
1303        my $tpdir = "$tp/$odir/$over/$oarch";
1304        my ($ptr) = pb_conf_get("vetype");
1305        my $vetype = $ptr->{$ENV{'PBPROJ'}};
1306        if ($vetype eq "chroot") {
1307            $shcmd = "sudo chroot $tpdir /bin/su - $mac -c ";
1308            $cpcmd = "sudo cp -r ";
1309        } elsif ($vetype eq "schroot") {
1310            $shcmd = "schroot $tp -u $mac -- ";
1311            $cpcmd = "sudo cp -r ";
1312        }
1313        # We need to get the home dir of the target account to deliver in the right place
1314        open(PASS,"$tpdir/etc/passwd") || die "Unable to open $tpdir/etc/passwd";
1315        my $homedir = "";
1316        while (<PASS>) {
1317            my ($c1,$c2,$c3,$c4,$c5,$c6,$c7) = split(/:/);
1318            $homedir = $c6 if ($c1 =~ /^$mac$/);
1319            pb_log(3,"Homedir: $homedir - account: $c6\n");
1320        }
1321        close(PASS);
1322        $cptarget = "$tpdir/$homedir/$tdir";
1323        if ($cmt eq "ve") {
1324            $cp2target = "$tpdir/$homedir/$bdir";
1325        }
1326        pb_log(2,"On VE using $cptarget as target dir to copy to\n");
1327    }
1328
1329    my $logres = "";
1330    # Do not touch when just announcing
1331    if ($cmt ne "Announce") {
1332        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");
1333    } else {
1334        $logres = "> ";
1335    }
1336    pb_system("cd $ENV{'PBBUILDDIR'} ; $cpcmd $src $cptarget 2> /dev/null","$cmt delivery in $cptarget");
1337
1338    # For VE we need to change the owner manually
1339    if ($cmt eq "ve") {
1340        pb_system("$shcmd \"sudo chown -R $mac $tdir\"","Adapt owner in $tdir to $mac");
1341    }
1342
1343    pb_system("$shcmd \"echo \'cd $tdir ; if [ -f pbscript ]; then ./pbscript; fi ; rm -f ./pbscript\' | bash\"","Executing pbscript on $cptarget if needed","verbose");
1344    if (($cmt eq "vm") || ($cmt eq "ve")) {
1345        # Get back info on pkg produced, compute their name and get them from the VM
1346        pb_system("$cpcmd $cp2target/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'} $ENV{'PBBUILDDIR'} 2> /dev/null","Get package names in $cp2target");
1347        # For VE we need to change the owner manually
1348        if ($cmt eq "ve") {
1349            pb_system("sudo chown $UID $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}","Adapt owner in $tdir to $UID");
1350        }
1351        open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") || die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1352        my $src = <KEEP>;
1353        chomp($src);
1354        close(KEEP);
1355        $src =~ s/^ *//;
1356        pb_mkdir_p("$ENV{'PBBUILDDIR'}/$odir/$over");
1357        # Change pgben to make the next send2target happy
1358        my $made = "";
1359        open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") || die "Unable to write $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1360        foreach my $p (split(/ +/,$src)) {
1361            my $j = basename($p);
1362            pb_system("$cpcmd $cp2target/\'$p\' $ENV{'PBBUILDDIR'}/$odir/$over 2> /dev/null","Package recovery of $j in $cp2target");
1363            $made="$made $odir/$over/$j"; # if (($dtype ne "rpm") || ($j !~ /.src.rpm$/));
1364        }
1365        print KEEP "$made\n";
1366        close(KEEP);
1367        pb_system("$shcmd \"rm -rf $tdir $bdir\"","$cmt cleanup");
1368
1369        # Sign packages locally
1370        if ($dtype eq "rpm") {
1371                #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");
1372        } elsif ($dtype eq "deb") {
1373                #pb_system("debsign $made","Signing DEB packages");
1374        } else {
1375            pb_log(0,"I don't know yet how to sign packages for type $dtype. Please give feedback to dev team");
1376        }
1377
1378        # We want to send them to the ssh account so overwrite what has been done before
1379        undef $pbaccount;
1380        pb_log(2,"Before sending pkgs, vmexist: $vmexist, vmpid: $vmpid\n");
1381        pb_send2target("Packages",$odir."-".$over."-".$oarch,$vmexist,$vmpid);
1382        pb_rm_rf("$ENV{'PBBUILDDIR'}/$odir");
1383    }
1384    pb_log(2,"Before halt, vmexist: $vmexist, vmpid: $vmpid\n");
1385    if ((! $vmexist) && (($cmt eq "vm") || ($cmt eq "VMScript"))) {
1386        # If in setupvm then takes a snapshot just before halting
1387        if ($snapme != 0) {
1388            my ($vmmonport,$vmtype) = pb_conf_get("vmmonport","vmtype");
1389            # For monitoring control
1390            if ((($vmtype->{$ENV{'PBPROJ'}}) eq "kvm") || (($vmtype->{$ENV{'PBPROJ'}}) eq "qemu")) {
1391                use Net::Telnet;
1392                my $t = new Net::Telnet (Host => "localhost", Port => $vmmonport->{$ENV{'PBPROJ'}}) || die "Unable to dialog on the monitor";
1393                # move to monitor mode
1394                my @lines = $t->cmd("c");
1395                # Create a snapshot named pb
1396                @lines = $t->cmd("savevm pb");
1397                # Write the new status in the VM
1398                @lines = $t->cmd("commit all");
1399                # End
1400                @lines = $t->cmd("quit");
1401            }
1402        }
1403        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)");
1404    }
1405    if ((($cmt eq "ve") || ($cmt eq "VEScript")) && ($snapme != 0)) {
1406        ($odir,$over,$oarch) = split(/-/,$v);
1407        my $tpdir = "$vepath->{$ENV{'PBPROJ'}}/$odir/$over/$oarch";
1408        pb_system("sudo tar cz -f $vepath->{$ENV{'PBPROJ'}}/$odir-$over-$oarch.tar.gz -C $tpdir .","Creating a snapshot of $tpdir");
1409    }
1410}
1411
1412sub pb_script2v {
1413    my $pbscript=shift;
1414    my $vtype=shift;
1415    my $pbforce=shift || 0; # Force stop of VM. Default not
1416    my $vm1=shift || undef; # Only that VM to treat
1417    my $snapme=shift || 0;  # Do we have to create a snapshot
1418    my $vm;
1419    my $all;
1420
1421    pb_log(2,"DEBUG: pb_script2v($pbscript,$vtype,$pbforce)\n");
1422    # Prepare the script to be executed on the VM
1423    # in $ENV{'PBDESTDIR'}/pbscript
1424    if ((defined $pbscript ) && ($pbscript ne "$ENV{'PBDESTDIR'}/pbscript")) {
1425        copy($pbscript,"$ENV{'PBDESTDIR'}/pbscript") || die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
1426        chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
1427    }
1428
1429    if (not defined $vm1) {
1430        ($vm,$all) = pb_get_v($vtype);
1431    } else {
1432        @$vm = ($vm1);
1433    }
1434    my ($vmexist,$vmpid) = (undef,undef);
1435
1436    foreach my $v (@$vm) {
1437        # Launch VM/VE
1438        ($vmexist,$vmpid) = pb_launchv($vtype,$v,0,$snapme);
1439
1440        if ($vtype eq "vm") {
1441            pb_log(2,"DEBUG: After pb_launchv, vmexist: $vmexist, vmpid: $vmpid\n");
1442
1443            # Skip that VM if something went wrong
1444            next if (($vmpid == 0) && ($vmexist == 0));
1445
1446            # If force stopping the VM then reset vmexist
1447            if ($pbforce == 1) {
1448                $vmpid = $vmexist;
1449                $vmexist = 0;
1450            }
1451        } else {
1452            #VE
1453            $vmexist = 0;
1454            $vmpid = 0;
1455        }
1456
1457        # Gather all required files to send them to the VM
1458        # and launch the build through pbscript
1459        pb_log(2,"DEBUG: Before send2target, vmexist: $vmexist, vmpid: $vmpid\n");
1460        pb_send2target(uc($vtype)."Script","$v",$vmexist,$vmpid,$snapme);
1461
1462    }
1463}
1464
1465sub pb_launchv {
1466    my $vtype = shift;
1467    my $v = shift;
1468    my $create = shift || 0;        # By default do not create a VM/VE
1469    my $snapme = shift || 0;        # By default do not snap a VM/VE
1470
1471    pb_log(2,"DEBUG: pb_launchv($vtype,$v,$create)\n");
1472    die "No VM/VE defined, unable to launch" if (not defined $v);
1473    # Keep only the first VM in case many were given
1474    $v =~ s/,.*//;
1475
1476    my $arch = pb_get_arch();
1477
1478    # Launch the VMs/VEs
1479    if ($vtype eq "vm") {
1480        die "-i iso parameter needed" if (((not defined $iso) || ($iso eq "")) && ($create != 0));
1481
1482        my ($ptr,$vmpath,$vmport,$vmsize,$vmmonport) = pb_conf_get("vmtype","vmpath","vmport","vmsize","vmmonport");
1483        my ($vmopt,$vmtmout,$vmsnap) = pb_conf_get_if("vmopt","vmtmout","vmsnap");
1484
1485        my $vmtype = $ptr->{$ENV{'PBPROJ'}};
1486        if (not defined $ENV{'PBVMOPT'}) {
1487            $ENV{'PBVMOPT'} = "";
1488        }
1489        # Save the current status for later restoration
1490        $ENV{'PBOLDVMOPT'} = $ENV{'PBVMOPT'};
1491        # Set a default timeout of 2 minutes
1492        if (not defined $ENV{'PBVMTMOUT'}) {
1493            $ENV{'PBVMTMOUT'} = "120";
1494        }
1495        if (defined $vmopt->{$v}) {
1496            $ENV{'PBVMOPT'} .= " $vmopt->{$v}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$v}/);
1497        } elsif (defined $vmopt->{$ENV{'PBPROJ'}}) {
1498            $ENV{'PBVMOPT'} .= " $vmopt->{$ENV{'PBPROJ'}}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$ENV{'PBPROJ'}}/);
1499        }
1500        # Use snapshot feature when not creating VM
1501        if ($create == 0) {
1502            if ((defined $vmsnap->{$v}) && ($vmsnap->{$v} =~ /true/i)) {
1503                $ENV{'PBVMOPT'} .= " -snapshot";
1504            } elsif ((defined $vmsnap->{$ENV{'PBPROJ'}}) && ($vmsnap->{$ENV{'PBPROJ'}} =~ /true/i)) {
1505                $ENV{'PBVMOPT'} .= " -snapshot";
1506            } elsif ($pbsnap eq 1) {
1507                $ENV{'PBVMOPT'} .= " -snapshot";
1508            }
1509        } elsif ($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'}}/.ssh","Finish setting up the SSH 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    sleep 60
2275EOF
2276    close(SCRIPT);
2277    chmod 0755,"$pbscript";
2278
2279    # Force shutdown of VM/VE
2280    $pbforce = 1;
2281    # Force snapshot of VM/VE
2282    pb_script2v($pbscript,$vtype,$pbforce,$v,1);
2283}
2284return;
2285}
2286
2287sub pb_install_deps {
2288
2289my $SCRIPT = shift;
2290
2291print {$SCRIPT} << 'EOF';
2292# We need to have that pb_distro_init function
2293# Get it from Project-Builder::Distribution
2294my ($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd) = pb_distro_init(); 
2295print "distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n";
2296
2297# We may need a proxy configuration. Get it from the local env
2298EOF
2299
2300if (defined $ENV{'http_proxy'}) {
2301    print SCRIPT "\$ENV\{'http_proxy'\}=\"$ENV{'http_proxy'}\";\n";
2302}
2303
2304if (defined $ENV{'ftp_proxy'}) {
2305    print SCRIPT "\$ENV\{'ftp_proxy'\}=\"$ENV{'ftp_proxy'}\";\n";
2306}
2307
2308print {$SCRIPT} << 'EOF';
2309# Get and install pb
2310my $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*";
2311my $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*";
2312my $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*";
2313my $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*";
2314my $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*";
2315my $cmtdm = "Installing Date-Manip perl module";
2316my $cmtmb = "Installing Module-Build perl module";
2317my $cmtfm = "Installing File-MimeInfo perl module";
2318my $cmtfb = "Installing File-Basedir perl module";
2319my $cmtms = "Installing Perl-Sendmail perl module";
2320my $cmtall = "Installing required modules";
2321
2322if ( $ddir eq "fedora" ) {
2323    pb_system("yum clean all","Cleaning yum env");
2324    if ($dver == 4) {
2325        pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"rpm-build wget patch ntp sudo perl-DateManip perl-ExtUtils-MakeMaker"));
2326        pb_system("$insmb","$cmtmb");
2327        pb_system("$insfm","$cmtfm");
2328        pb_system("$insfb","$cmtfb");
2329        pb_system("$insms","$cmtms");
2330    } else {
2331        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"));
2332    }
2333} elsif ($ddir eq "asianux") {
2334    pb_system("yum clean all","Cleaning yum env");
2335    pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"rpm-build wget patch ntp sudo perl-DateManip"));
2336    pb_system("$insmb","$cmtmb");
2337    pb_system("$insfm","$cmtfm");
2338    pb_system("$insfb","$cmtfb");
2339    pb_system("$insms","$cmtms");
2340} elsif (( $dfam eq "rh" ) || ($ddir eq "suse") || ($ddir eq "sles") || (($ddir eq "opensuse") && (($dver eq "10.1") || ($dver eq "10.0"))) || ($ddir eq "slackware")) {
2341    # Suppose pkg are installed already as no online mirror available
2342    pb_system("rpm -e lsb 2>&1 > /dev/null","Removing lsb package");
2343    pb_system("$insdm","$cmtdm");
2344    pb_system("$insmb","$cmtmb");
2345    pb_system("$insfm","$cmtfm");
2346    pb_system("$insfb","$cmtfb");
2347    pb_system("$insms","$cmtms");
2348} elsif ($ddir eq "opensuse") { 
2349    # New OpenSuSE
2350    pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"make wget patch sudo ntp"));
2351    pb_system("$insmb","$cmtmb");
2352    pb_system("$insfm","$cmtfm");
2353    pb_system("$insfb","$cmtfb");
2354    pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"perl-Date-Manip perl-File-HomeDir perl-Mail-Sendmail"));
2355    if ($dver < 11) {
2356        pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"ntp"));
2357    } else {
2358        pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"sntp"));
2359    }
2360} elsif ( $dfam eq "md" ) {
2361        my $addp = "";
2362        if (($ddir eq "mandrake") && ($dver eq "10.1")) {
2363            pb_system("$insdm","$cmtdm");
2364        } else {
2365            $addp ="perl-DateManip";
2366        }
2367        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"));
2368} elsif ( $dfam eq "du" ) {
2369    if (( $dver eq "3.1" ) && ($ddir eq "debian")) {
2370        pb_system("$insfb","$cmtfb");
2371        pb_system("$insfm","$cmtfm");
2372        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"));
2373    } else  {
2374        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"));
2375    }
2376} elsif ( $dfam eq "gen" ) {
2377        #system "emerge -u system";
2378        pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"wget sudo ntp DateManip File-MimeInfo Mail-Sendmail"));
2379} else {
2380    pb_log(0,"No pkg to install\n");
2381}
2382EOF
2383}
2384
2385sub pb_announce {
2386
2387    # Get all required parameters
2388    my ($pbpackager,$pbrepo,$pbml,$pbsmtp) = pb_conf_get("pbpackager","pbrepo","pbml","pbsmtp");
2389    my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
2390    my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
2391    my @pkgs = @$pkg;
2392    my %pkgs;
2393    my $first = 0;
2394
2395    # Command to find packages on repo
2396    my $findstr = "find . ";
2397    # Generated announce files
2398    my @files;
2399
2400    foreach my $pbpkg (@pkgs) {
2401        if ($first != 0) {
2402            $findstr .= "-o ";
2403        }
2404        $first++;
2405        if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
2406            $pbver = $pkgv->{$pbpkg};
2407        } else {
2408            $pbver = $ENV{'PBPROJVER'};
2409        }
2410        if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
2411            $pbtag = $pkgt->{$pbpkg};
2412        } else {
2413            $pbtag = $ENV{'PBPROJTAG'};
2414        }
2415
2416        # TODO: use virtual/real names here now
2417        $findstr .= "-name \'$pbpkg-$pbver-$pbtag\.*.rpm\' -o -name \'$pbpkg"."_$pbver*\.deb\' -o -name \'$pbpkg-$pbver\.ebuild\' ";
2418
2419        my $chglog;
2420
2421        # Get project info on log file and generate tmp files used later on
2422        pb_cms_init($pbinit);
2423        $chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
2424        $chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
2425        $chglog = undef if (! -f $chglog);
2426
2427        open(OUT,"> $ENV{'PBTMP'}/$pbpkg.ann") || die "Unable to create $ENV{'PBTMP'}/$pbpkg.ann: $!";
2428        my %pb;
2429        $pb{'dtype'} = "announce";
2430        $pb{'realpkg'} = $pbpkg;
2431        $pb{'ver'} = $pbver;
2432        $pb{'tag'} = $pbtag;
2433        $pb{'suf'} = "N/A";     # Should not be empty even if unused
2434        $pb{'date'} = $pbdate;
2435        $pb{'chglog'} = $chglog;
2436        $pb{'packager'} = $pbpackager;
2437        $pb{'proj'} = $ENV{'PBPROJ'};
2438        $pb{'repo'} = $pbrepo;
2439        pb_changelog(\%pb,\*OUT,"yes");
2440        close(OUT);
2441        push(@files,"$ENV{'PBTMP'}/$pbpkg.ann");
2442    }
2443    $findstr .= " | grep -Ev \'src.rpm\'";
2444    if ((not defined $testver) || (not defined $testver->{$ENV{'PBPROJ'}}) || ($testver->{$ENV{'PBPROJ'}} !~ /true/i)) {
2445        $findstr .= " | grep -v ./test/";
2446    }
2447
2448    # Prepare the command to run and execute it
2449    open(PBS,"> $ENV{'PBTMP'}/pbscript") || die "Unable to create $ENV{'PBTMP'}/pbscript";
2450    print PBS "$findstr\n";
2451    close(PBS);
2452    chmod 0755,"$ENV{'PBTMP'}/pbscript";
2453    pb_send2target("Announce");
2454
2455    # Get subject line
2456    my $sl = "Project $ENV{'PBPROJ'} version $ENV{'PBPROJVER'} is now available";
2457    pb_log(0,"Please enter the title of your announce\n");
2458    pb_log(0,"(By default: $sl)\n");
2459    my $sl2 = <STDIN>;
2460    $sl = $sl2 if ($sl2 !~ /^$/);
2461
2462    # Prepare a template of announce
2463    open(ANN,"> $ENV{'PBTMP'}/announce.html") || die "Unable to create $ENV{'PBTMP'}/announce.html: $!";
2464    print ANN << "EOF";
2465$sl</p>
2466
2467<p>The project team is happy to announce the availability of a newest version of $ENV{'PBPROJ'} $ENV{'PBPROJVER'}. Enjoy it as usual!</p>
2468<p>
2469Now available at <a href="$pbrepo->{$ENV{'PBPROJ'}}">$pbrepo->{$ENV{'PBPROJ'}}</a>
2470</p>
2471<p>
2472EOF
2473    open(LOG,"$ENV{'PBTMP'}/system.log") || die "Unable to read $ENV{'PBTMP'}/system.log: $!";
2474    my $col = 2;
2475    my $i = 1;
2476    print ANN << 'EOF';
2477<TABLE WIDTH="700" CELLPADDING="0" CELLSPACING="0" BORDER="0">
2478<TR>
2479EOF
2480    while (<LOG>) {
2481        print ANN "<TD><A HREF=\"$pbrepo->{$ENV{'PBPROJ'}}/$_\">$_</A></TD>";
2482        $i++;
2483        if ($i > $col) {
2484            print ANN "</TR>\n<TR>";
2485            $i = 1;
2486        }
2487    }
2488    close(LOG);
2489    print ANN << "EOF";
2490</TR>
2491</TABLE>
2492</p>
2493
2494<p>As usual source packages are also available in the same directory.</p>
2495
2496<p>
2497Changes are :
2498</p>
2499<p>
2500EOF
2501    # Get each package changelog content
2502    foreach my $f (sort(@files)) {
2503        open(IN,"$f") || die "Unable to read $f:$!";
2504        while (<IN>) {
2505            print ANN $_;
2506        }
2507        close(IN);
2508        print ANN "</p><p>\n";
2509    }
2510    print ANN "</p>\n";
2511    close(ANN);
2512
2513    # Allow for modification
2514    pb_system("vi $ENV{'PBTMP'}/announce.html","Allowing modification of the announce","noredir");
2515
2516    # Store it in DB for external usage (Web pages generation)
2517    my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
2518
2519    my $precmd = "";
2520    if (! -f $db) {
2521        $precmd = "CREATE TABLE announces (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, announce VARCHAR[65535])";
2522    }
2523
2524    my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
2525                        { RaiseError => 1, AutoCommit => 1 })
2526                        || die "Unable to connect to $db";
2527
2528    if ($precmd ne "") {
2529        my $sth = $dbh->prepare(qq{$precmd})
2530                    || die "Unable to create table into $db";
2531        $sth->execute();
2532    }
2533
2534    # To read whole file
2535    local $/;
2536    open(ANN,"$ENV{'PBTMP'}/announce.html") || die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
2537    my $announce = <ANN>;
2538    close(ANN);
2539   
2540    pb_log(2,"INSERT INTO announces VALUES (NULL, $pbdate, $announce)");
2541    my $sth = $dbh->prepare(qq{INSERT INTO announces VALUES (NULL,?,?)})
2542                    || die "Unable to insert into $db";
2543    $sth->execute($pbdate, $announce);
2544    $sth->finish();
2545    $dbh->disconnect;
2546
2547    # Then deliver it on the Web
2548    # $TOOLHOME/livwww www
2549
2550    # Mail it to project's ML
2551    open(ML,"| w3m -dump -T text/html > $ENV{'PBTMP'}/announce.txt") || die "Unable to create $ENV{'PBTMP'}/announce.txt: $!";
2552    print ML << 'EOF';
2553<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/x html1/DTD/xhtml1-strict.dtd">
2554
2555<html xmlns="http://www.w3.org/1999/xhtml" dir="ltr" xml:lang="en" lang="en">
2556  <head>
2557  </head>
2558  <body>
2559  <p>
2560EOF
2561    open(ANN,"$ENV{'PBTMP'}/announce.html") || die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
2562    while(<ANN>) {
2563        print ML $_;
2564    }
2565    print ML << 'EOF';
2566</body>
2567</html>
2568EOF
2569    close(ML);
2570
2571    # To read whole file
2572    local $/;
2573    open(ANN,"$ENV{'PBTMP'}/announce.txt") || die "Unable to read $ENV{'PBTMP'}/announce.txt: $!";
2574    my $msg = <ANN>;
2575    close(ANN);
2576   
2577    # Preparation of headers
2578
2579    my %mail = (   
2580            To          =>  $pbml->{$ENV{'PBPROJ'}},
2581            From        =>  $pbpackager->{$ENV{'PBPROJ'}},
2582            Smtp        =>  $pbsmtp->{$ENV{'PBPROJ'}},
2583            Body        =>  $msg,
2584            Subject     =>  "[ANNOUNCE] $sl",
2585        );
2586           
2587    # Send mail
2588    sendmail(%mail) or die "Unable to send mail ($Mail::Sendmail::error): $Mail::Sendmail::log";
2589}
2590
2591#
2592# Creates a set of HTML file containing the news for the project
2593# based on what has been generated by the pb_announce function
2594#
2595sub pb_web_news2html {
2596
2597    my $dest = shift || $ENV{'PBTMP'};
2598
2599    # Get all required parameters
2600    my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
2601
2602    # DB of announces for external usage (Web pages generation)
2603    my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
2604
2605    my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
2606                        { RaiseError => 1, AutoCommit => 1 })
2607                        || die "Unable to connect to $db";
2608    # For date handling
2609    $ENV{LANGUAGE}="C";
2610    my $firstjan = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year(), 0, 0, -1);
2611    my $oldfirst = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year()-1, 0, 0, -1);
2612    pb_log(2,"firstjan: $firstjan, oldfirst: $oldfirst, pbdate:$pbdate\n");
2613    my $all = $dbh->selectall_arrayref("SELECT id,date,announce FROM announces ORDER BY date DESC");
2614    my %news;
2615    $news{"cy"} = "";   # current year's news
2616    $news{"ly"} = "";   # last year news
2617    $news{"py"} = "";   # previous years news
2618    $news{"fp"} = "";   # first page news
2619    my $cpt = 4;        # how many news for first page
2620    # Extract info from DB
2621    foreach my $row (@$all) {
2622        my ($id, $date, $announce) = @$row;
2623        $news{"cy"} = $news{"cy"}."<p><B>$date</B> $announce\n" if ((($date cmp $pbdate) le 0) && (($firstjan cmp $date) le 0));
2624        $news{"ly"} = $news{"ly"}."<p><B>$date</B> $announce\n" if ((($date cmp $firstjan) le 0) && (($oldfirst cmp $date) le 0));
2625        $news{"py"} = $news{"py"}."<p><B>$date</B> $announce\n" if (($date cmp $oldfirst) le 0);
2626        $news{"fp"} = $news{"fp"}."<p><B>$date</B> $announce\n" if ($cpt > 0);
2627        $cpt--;
2628    }
2629    pb_log(1,"news{fp}: ".$news{"fp"}."\n");
2630    $dbh->disconnect;
2631
2632    # Generate the HTML content
2633    foreach my $pref (keys %news) {
2634        open(NEWS,"> $dest/pb_web_$pref"."news.html") || die "Unable to create $dest/pb_web_$pref"."news.html: $!";
2635        print NEWS "$news{$pref}";
2636        close(NEWS);
2637    }
2638}
2639
2640
2641# Return the SSH key file to use
2642# Potentially create it if needed
2643
2644sub pb_ssh_get {
2645
2646my $create = shift || 0;    # Do not create keys by default
2647
2648# Check the SSH environment
2649my $keyfile = undef;
2650
2651# We have specific keys by default
2652$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
2653if (!(-e $keyfile) && ($create eq 1)) {
2654    pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
2655}
2656
2657$keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
2658$keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
2659$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
2660die "Unable to find your public ssh key under $keyfile" if (not defined $keyfile);
2661return($keyfile);
2662}
2663
2664
2665# Returns the pid of a running VM command using a specific VM file
2666sub pb_check_ps {
2667    my $vmcmd = shift;
2668    my $vmm = shift;
2669    my $vmexist = 0;        # FALSE by default
2670
2671    open(PS, "ps auxhww|") || die "Unable to call ps";
2672    while (<PS>) {
2673        next if (! /$vmcmd/);
2674        next if (! /$vmm/);
2675        my ($void1, $void2);
2676        ($void1, $vmexist, $void2) = split(/ +/);
2677        last;
2678    }
2679    return($vmexist);
2680}
2681
2682
2683sub pb_extract_build_files {
2684
2685my $src=shift;
2686my $dir=shift;
2687my $ddir=shift;
2688my $mandatory=shift || "spec";
2689my @files;
2690
2691my $flag = "mayfail" if ($mandatory eq "patch");
2692my $res;
2693
2694if ($src =~ /tar\.gz$/) {
2695    $res = pb_system("tar xfpz $src $dir","Extracting $mandatory files from $src",$flag);
2696} elsif ($src =~ /tar\.bz2$/) {
2697    $res = pb_system("tar xfpj $src $dir","Extracting $mandatory files from $src",$flag);
2698} else {
2699    die "Unknown compression algorithm for $src";
2700}
2701# If not mandatory return now
2702return() if (($res != 0) and ($mandatory eq "patch"));
2703opendir(DIR,"$dir") || die "Unable to open directory $dir";
2704foreach my $f (readdir(DIR)) {
2705    next if ($f =~ /^\./);
2706    # Skip potential patch dir
2707    next if ($f =~ /^pbpatch/);
2708    move("$dir/$f","$ddir") || die "Unable to move $dir/$f to $ddir";
2709    pb_log(2,"mv $dir/$f $ddir\n");
2710    push @files,"$ddir/$f";
2711}
2712closedir(DIR);
2713# Not enough but still a first cleanup
2714pb_rm_rf("$dir");
2715return(@files);
2716}
2717
2718sub pb_list_bfiles {
2719
2720my $dir = shift;
2721my $pbpkg = shift;
2722my $bfiles = shift;
2723my $pkgfiles = shift;
2724my $supfiles = shift;
2725
2726opendir(BDIR,"$dir") || die "Unable to open dir $dir: $!";
2727foreach my $f (readdir(BDIR)) {
2728    next if ($f =~ /^\./);
2729    $bfiles->{$f} = "$dir/$f";
2730    $bfiles->{$f} =~ s~$ENV{'PBROOTDIR'}~~;
2731    if (defined $supfiles->{$pbpkg}) {
2732        $pkgfiles->{$f} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
2733    }
2734}
2735closedir(BDIR);
2736}
2737
2738
2739#
2740# Return the list of packages we are working on in a non CMS action
2741#
2742sub pb_get_pkg {
2743
2744my @pkgs = ();
2745
2746my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
2747@pkgs = keys %$var;
2748
2749pb_log(0,"Packages: ".join(',',@pkgs)."\n");
2750return(\@pkgs);
2751}
2752
27531;
Note: See TracBrowser for help on using the repository browser.