source: devel/pb/bin/pb @ 761

Last change on this file since 761 was 761, checked in by bruno, 11 years ago

Adapt time out for script in snap mode to the type of virtual env

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