source: devel/pb/bin/pb @ 753

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

Use gzip as VEs compressor (much quicker)

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