source: devel/pb/bin/pb @ 751

Last change on this file since 751 was 751, checked in by bruno, 11 years ago
  • Adds snapshot support for VEs
  • Force usage of correct arch in pb_distro_init to avoid issues when cross building
  • Property svn:executable set to *
File size: 88.0 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        if ((($cmt eq "ve") || ($cmt eq "VEScript")) && ($snapme != 0)) {
1404            pb_system("tar cfj $tp/$odir-$over-$oarch.tar.bz2 $tpdir","Creating a snapshot of $tpdir");
1405        }
1406        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)");
1407    }
1408}
1409
1410sub pb_script2v {
1411    my $pbscript=shift;
1412    my $vtype=shift;
1413    my $pbforce=shift || 0; # Force stop of VM. Default not
1414    my $vm1=shift || undef; # Only that VM to treat
1415    my $snapme=shift || 0;  # Do we have to create a snapshot
1416    my $vm;
1417    my $all;
1418
1419    pb_log(2,"DEBUG: pb_script2v($pbscript,$vtype,$pbforce)\n");
1420    # Prepare the script to be executed on the VM
1421    # in $ENV{'PBDESTDIR'}/pbscript
1422    if ((defined $pbscript ) && ($pbscript ne "$ENV{'PBDESTDIR'}/pbscript")) {
1423        copy($pbscript,"$ENV{'PBDESTDIR'}/pbscript") || die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
1424        chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
1425    }
1426
1427    if (not defined $vm1) {
1428        ($vm,$all) = pb_get_v($vtype);
1429    } else {
1430        @$vm = ($vm1);
1431    }
1432    my ($vmexist,$vmpid) = (undef,undef);
1433
1434    foreach my $v (@$vm) {
1435        # Launch the VM/VE
1436        if ($vtype eq "vm") {
1437            ($vmexist,$vmpid) = pb_launchv($vtype,$v,0,$snapme);
1438            pb_log(2,"DEBUG: After pb_launchv, vmexist: $vmexist, vmpid: $vmpid\n");
1439
1440            # Skip that VM if something went wrong
1441            next if (($vmpid == 0) && ($vmexist == 0));
1442
1443            # If force stopping the VM then reset vmexist
1444            if ($pbforce == 1) {
1445                $vmpid = $vmexist;
1446                $vmexist = 0;
1447            }
1448        } else {
1449            #VE
1450            $vmexist = 0;
1451            $vmpid = 0;
1452        }
1453
1454        # Gather all required files to send them to the VM
1455        # and launch the build through pbscript
1456        pb_log(2,"DEBUG: Before send2target, vmexist: $vmexist, vmpid: $vmpid\n");
1457        pb_send2target(uc($vtype)."Script","$v",$vmexist,$vmpid,$snapme);
1458
1459    }
1460}
1461
1462sub pb_launchv {
1463    my $vtype = shift;
1464    my $v = shift;
1465    my $create = shift || 0;        # By default do not create a VM
1466    my $snapme = shift || 0;        # By default do not create a VM
1467
1468    pb_log(2,"DEBUG: pb_launchv($vtype,$v,$create)\n");
1469    die "No VM/VE defined, unable to launch" if (not defined $v);
1470    # Keep only the first VM in case many were given
1471    $v =~ s/,.*//;
1472
1473    my $arch = pb_get_arch();
1474
1475    # Launch the VMs/VEs
1476    if ($vtype eq "vm") {
1477        die "-i iso parameter needed" if (((not defined $iso) || ($iso eq "")) && ($create != 0));
1478
1479        my ($ptr,$vmpath,$vmport,$vmsize,$vmmonport) = pb_conf_get("vmtype","vmpath","vmport","vmsize","vmmonport");
1480        my ($vmopt,$vmtmout,$vmsnap) = pb_conf_get_if("vmopt","vmtmout","vmsnap");
1481
1482        my $vmtype = $ptr->{$ENV{'PBPROJ'}};
1483        if (not defined $ENV{'PBVMOPT'}) {
1484            $ENV{'PBVMOPT'} = "";
1485        }
1486        # Save the current status for later restoration
1487        $ENV{'PBOLDVMOPT'} = $ENV{'PBVMOPT'};
1488        # Set a default timeout of 2 minutes
1489        if (not defined $ENV{'PBVMTMOUT'}) {
1490            $ENV{'PBVMTMOUT'} = "120";
1491        }
1492        if (defined $vmopt->{$v}) {
1493            $ENV{'PBVMOPT'} .= " $vmopt->{$v}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$v}/);
1494        } elsif (defined $vmopt->{$ENV{'PBPROJ'}}) {
1495            $ENV{'PBVMOPT'} .= " $vmopt->{$ENV{'PBPROJ'}}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$ENV{'PBPROJ'}}/);
1496        }
1497        # Do not use snapshot feature at creation
1498        if ($create != 0) {
1499            if ((defined $vmsnap->{$v}) && ($vmsnap->{$v} =~ /true/i)) {
1500                $ENV{'PBVMOPT'} .= " -snapshot";
1501            } elsif ((defined $vmsnap->{$ENV{'PBPROJ'}}) && ($vmsnap->{$ENV{'PBPROJ'}} =~ /true/i)) {
1502                $ENV{'PBVMOPT'} .= " -snapshot";
1503            } elsif ($pbsnap eq 1) {
1504                $ENV{'PBVMOPT'} .= " -snapshot";
1505            }
1506        } elsif ($snapme != 0) {
1507            if (($vmtype eq "kvm") || ($vmtype eq "qemu")) {
1508                # Configure the monitoring to automize the creation of the 'pb' snapshot
1509                $ENV{'PBVMOPT'} .= "-serial mon:telnet::$vmmonport->{$ENV{'PBPROJ'}},server,nowait ";
1510            }
1511        }
1512        if (defined $vmtmout->{$v}) {
1513            $ENV{'PBVMTMOUT'} = $vmtmout->{$v};
1514        } elsif (defined $vmtmout->{$ENV{'PBPROJ'}}) {
1515            $ENV{'PBVMTMOUT'} = $vmtmout->{$ENV{'PBPROJ'}};
1516        }
1517        my $nport = $vmport->{$ENV{'PBPROJ'}};
1518        $nport = "$pbport" if (defined $pbport);
1519   
1520        my $cmd;
1521        my $vmcmd;      # has to be used for pb_check_ps
1522        my $vmm;        # has to be used for pb_check_ps
1523        if (($vmtype eq "qemu") || ($vmtype eq "kvm")) {
1524            my $qemucmd32;
1525            my $qemucmd64;
1526            if ($arch eq "x86_64") {
1527                $qemucmd32 = "/usr/bin/qemu-system-i386";
1528                $qemucmd64 = "/usr/bin/qemu";
1529            } else {
1530                $qemucmd32 = "/usr/bin/qemu";
1531                $qemucmd64 = "/usr/bin/qemu-system-x86_64";
1532            }
1533            if ($v =~ /x86_64/) {
1534                    $vmcmd = "$qemucmd64";
1535                } else {
1536                    $vmcmd = "$qemucmd32";
1537                }
1538            if ($vmtype eq "kvm") {
1539                $vmcmd = "/usr/bin/kvm";
1540                }
1541            $vmm = "$vmpath->{$ENV{'PBPROJ'}}/$v.qemu";
1542            if ($create != 0) {
1543                $ENV{'PBVMOPT'} .= " -cdrom $iso -boot d";
1544            }
1545            # Always redirect the network and always try to use a 'pb' snapshot
1546            $cmd = "$vmcmd $ENV{'PBVMOPT'} -redir tcp:$nport:10.0.2.15:22 -loadvm pb $vmm"
1547        } elsif ($vmtype eq "xen") {
1548        } elsif ($vmtype eq "vmware") {
1549        } else {
1550            die "VM of type $vmtype not supported. Report to the dev team";
1551        }
1552        # Restore the ENV VAR Value
1553        $ENV{'PBVMOPT'} = $ENV{'PBOLDVMOPT'};
1554
1555        my ($tmpcmd,$void) = split(/ +/,$cmd);
1556        my $vmexist = pb_check_ps($tmpcmd,$vmm);
1557        my $vmpid = 0;
1558        if (! $vmexist) {
1559            if ($create != 0) {
1560                die("Found an existing Virtual machine $vmm. Won't overwrite") if (-r $vmm);
1561                if (($vmtype eq "qemu") || ($vmtype eq "xen") || ($vmtype eq "kvm")) {
1562                    pb_system("/usr/bin/qemu-img create -f qcow2 $vmm $vmsize->{$ENV{'PBPROJ'}}","Creating the QEMU VM");
1563                } elsif ($vmtype eq "vmware") {
1564                } else {
1565                }
1566            }
1567            if (! -f "$vmm") {
1568                pb_log(0,"Unable to find VM $vmm\n");
1569            } else {
1570                pb_system("$cmd &","Launching the VM $vmm");
1571                pb_system("sleep $ENV{'PBVMTMOUT'}","Waiting $ENV{'PBVMTMOUT'} s for VM $v to come up");
1572                $vmpid = pb_check_ps($tmpcmd,$vmm);
1573                pb_log(0,"VM $vmm launched (pid $vmpid)\n");
1574            }
1575        } else {
1576            pb_log(0,"Found an existing VM $vmm (pid $vmexist)\n");
1577        }
1578        pb_log(2,"DEBUG: pb_launchv returns ($vmexist,$vmpid)\n");
1579        return($vmexist,$vmpid);
1580    # VE here
1581    } else {
1582        # Get VE context
1583        my ($ptr,$vetmout,$vepath,$verebuild,$veconf,$vepostinstall) = pb_conf_get("vetype","vetmout","vepath","verebuild","veconf");
1584        my ($veb4pi,$vepi,$vepkglist) = pb_conf_get_if("veb4pi","vepi","vepkglist");
1585        my $vetype = $ptr->{$ENV{'PBPROJ'}};
1586
1587        # Get distro context
1588        my ($name,$ver,$darch) = split(/-/,$v);
1589        chomp($darch);
1590        my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($name,$ver,$darch);
1591
1592        if (($vetype eq "chroot") || ($vetype eq "schroot")) {
1593            # Architecture consistency
1594            if ($arch ne $darch) {
1595                die "Unable to launch a VE of architecture $darch on a $arch platform" if (($darch eq "x86_64") && ($arch =~ /i?86/));
1596            }
1597
1598            my ($verpmtype) = pb_conf_get("verpmtype");
1599            if (($create != 0) || ($verebuild->{$ENV{'PBPROJ'}} eq "true") || ($pbforce == 1)) {
1600                # We have to rebuild the chroot
1601                if ($dtype eq "rpm") {
1602
1603                    my $verpmstyle = pb_distro_get_param($ddir,$dver,$darch,$verpmtype);
1604                    if ($verpmstyle eq "rinse") {
1605                        # Need to reshape the mirrors generated with local before-post-install script
1606                        my $b4post = "--before-post-install ";
1607                        my $postparam = pb_distro_get_param($ddir,$dver,$darch,$veb4pi);
1608                        if ($postparam eq "") {
1609                            $b4post = "";
1610                        } else {
1611                            $b4post .= $postparam;
1612                        }
1613                        # Do we have a local post-install script
1614                        my $post = "--post-install ";
1615                        $postparam = pb_distro_get_param($ddir,$dver,$darch,$vepi);
1616                        if ($postparam eq "") {
1617                            $post = "";
1618                        } else {
1619                            $post .= $postparam;
1620                        }
1621
1622                        # Need to reshape the package list for pb
1623                        my $addpkgs;
1624                        $postparam = pb_distro_get_param($ddir,$dver,$darch,$vepkglist);
1625                        if ($postparam eq "") {
1626                            $addpkgs = "";
1627                        } else {
1628                            my $pkgfile = "$ENV{'PBTMP'}/addpkgs.lis";
1629                            open(PKG,"> $pkgfile") || die "Unable to create $pkgfile";
1630                            foreach my $p (split(/,/,$postparam)) {
1631                                print PKG "$p\n";
1632                            }
1633                            close(PKG);
1634                            $addpkgs = "--add-pkg-list $pkgfile";
1635                        }
1636                        my $rinseverb = "";
1637                        $rinseverb = "--verbose" if ($pbdebug gt 0);
1638
1639                        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");
1640                    } elsif ($verpmstyle eq "mock") {
1641                        pb_system("sudo /usr/sbin/mock --init --resultdir=\"/tmp\" --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" -r $v","Creating the mock VE for $ddir-$dver ($darch)");
1642                        # Once setup we need to install some packages, the pb account, ...
1643                        pb_system("sudo /usr/sbin/mock --install --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" -r $v su","Configuring the mock VE");
1644                    }
1645                } elsif ($dtype eq "deb") {
1646                    pb_system("","Creating the pbuilder VE TBD");
1647                } elsif ($dtype eq "ebuild") {
1648                    die "Please teach the dev team how to build gentoo chroot";
1649                } else {
1650                    die "Unknown distribution type $dtype. Report to dev team";
1651                }
1652            }
1653            # Nothing more to do for VE. No real launch
1654        } else {
1655            die "VE of type $vetype not supported. Report to the dev team";
1656        }
1657    }
1658}
1659
1660# Return string for date synchro
1661sub pb_date_v {
1662
1663my $vtype = shift;
1664my $v = shift;
1665
1666my ($ntp) = pb_conf_get($vtype."ntp");
1667my $vntp = $ntp->{$ENV{'PBPROJ'}};
1668my $ntpline;
1669
1670if (defined $vntp) {
1671    my ($ntpcmd) = pb_conf_get($vtype."ntpcmd");
1672    my $vntpcmd;
1673    if (defined $ntpcmd->{$v}) {
1674        $vntpcmd = $ntpcmd->{$v};
1675    } elsif (defined $ntpcmd->{$ENV{'PBPROJ'}}) {
1676        $vntpcmd = $ntpcmd->{$ENV{'PBPROJ'}};
1677    } else {
1678        $vntpcmd = "/bin/true";
1679    }
1680    $ntpline = "sudo $vntpcmd $vntp";
1681} else {
1682    $ntpline = undef;
1683}
1684# Force new date to be in the future compared to the date
1685# of the host by adding 1 minute
1686my @date=pb_get_date();
1687$date[1]++;
1688my $upddate = strftime("%m%d%H%M%Y", @date);
1689my $dateline = "sudo date $upddate";
1690return($ntpline,$dateline);
1691}
1692
1693sub pb_build2v {
1694
1695my $vtype = shift;
1696
1697my ($v,$all) = pb_get_v($vtype);
1698
1699# Send tar files when we do a global generation
1700pb_build2ssh() if ($all == 1);
1701
1702my ($vmexist,$vmpid) = (undef,undef);
1703
1704foreach my $v (@$v) {
1705    # Prepare the script to be executed on the VM/VE
1706    # in $ENV{'PBDESTDIR'}/pbscript
1707    open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript") || die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
1708    print SCRIPT "#!/bin/bash\n";
1709
1710    # Transmit the verbosity level to the virtual env/mach.
1711    my $verbose = "";
1712    my $i = 0;                          # minimal debug level
1713    while ($i lt $pbdebug) {
1714        $verbose .= "-v ";
1715        $i++;
1716    }
1717    # Activate script verbosity if at least 2 for pbdebug
1718    print SCRIPT "set -x\n" if ($i gt 1);
1719    # Quiet if asked to be so on the original system
1720    $verbose = "-q" if ($pbdebug eq -1);
1721
1722    print SCRIPT "echo ... Execution needed\n";
1723    print SCRIPT "# This is in directory delivery\n";
1724    print SCRIPT "# Setup the variables required for building\n";
1725    print SCRIPT "export PBPROJ=$ENV{'PBPROJ'}\n";
1726    print SCRIPT "# Preparation for pb\n";
1727    print SCRIPT "mv .pbrc \$HOME\n";
1728    print SCRIPT "cd ..\n";
1729
1730    # VE needs a good /proc
1731    if ($vtype eq "ve") {
1732        print SCRIPT "sudo mount -t proc /proc /proc\n";
1733    }
1734   
1735    # Get list of packages to build and get some ENV vars as well
1736    my $ptr = pb_get_pkg();
1737    @pkgs = @$ptr;
1738    my $p = join(' ',@pkgs) if (@pkgs);
1739    print SCRIPT "export PBPROJVER=$ENV{'PBPROJVER'}\n";
1740    print SCRIPT "export PBPROJTAG=$ENV{'PBPROJTAG'}\n";
1741    print SCRIPT "export PBPACKAGER=\"$ENV{'PBPACKAGER'}\"\n";
1742
1743    my ($ntpline,$dateline) = pb_date_v($vtype,$v);
1744    print SCRIPT "# Time sync\n";
1745    print SCRIPT "echo 'setting up date with '";
1746    if (defined $ntpline) {
1747        print SCRIPT "echo $ntpline\n";
1748        print SCRIPT "$ntpline\n";
1749    } else {
1750        print SCRIPT "echo $dateline\n";
1751        print SCRIPT "$dateline\n";
1752    }
1753    # Use potential local proxy declaration in case we need it to download repo, pkgs, ...
1754    if (defined $ENV{'http_proxy'}) {
1755        print SCRIPT "export http_proxy=\"$ENV{'http_proxy'}\"\n";
1756    }
1757
1758    if (defined $ENV{'ftp_proxy'}) {
1759        print SCRIPT "export ftp_proxy=\"$ENV{'ftp_proxy'}\"\n";
1760    }
1761
1762
1763    # We may need to do some other tasks before building. Read a script here to finish setup
1764    if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."build.pre") {
1765        print SCRIPT "# Special pre-build instructions to be launched\n";
1766        print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."build.pre");
1767    }
1768
1769    print SCRIPT "# Build\n";
1770    print SCRIPT "echo Building packages on $vtype...\n";
1771    print SCRIPT "pb $verbose -p $ENV{'PBPROJ'} build2pkg $p\n";
1772    if ($vtype eq "ve") {
1773        print SCRIPT "sudo umount /proc\n";
1774    }
1775
1776    # We may need to do some other tasks after building. Read a script here to exit properly
1777    if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."build.post") {
1778        print SCRIPT "# Special post-build instructions to be launched\n";
1779        print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."build.post");
1780    }
1781
1782    close(SCRIPT);
1783    chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
1784   
1785    if ($vtype eq "vm") {
1786        # Launch the VM
1787        ($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1788
1789        # Skip that VM if it something went wrong
1790        next if (($vmpid == 0) && ($vmexist == 0));
1791    } else {
1792        # VE
1793        $vmexist = 0;
1794        $vmpid = 0;
1795    }
1796    # Gather all required files to send them to the VM/VE
1797    # and launch the build through pbscript
1798    pb_log(2,"Calling send2target $vtype,$v,$vmexist,$vmpid\n");
1799    pb_send2target($vtype,"$v",$vmexist,$vmpid);
1800}
1801}
1802
1803
1804sub pb_clean {
1805
1806    my $sleep=10;
1807    die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
1808    die "Unable to get env var PBBUILDDIR" if (not defined $ENV{'PBBUILDDIR'});
1809    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");
1810    sleep $sleep;
1811    pb_rm_rf($ENV{'PBDESTDIR'});
1812    pb_rm_rf($ENV{'PBBUILDDIR'});
1813}
1814
1815sub pb_newver {
1816
1817    die "-V Version parameter needed" if ((not defined $newver) || ($newver eq ""));
1818
1819    # Need this call for PBDIR
1820    my ($scheme2,$uri) = pb_cms_init($pbinit);
1821
1822    my ($pbconf) = pb_conf_get("pbconfurl");
1823    $uri = $pbconf->{$ENV{'PBPROJ'}};
1824    my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);
1825
1826    # Checking CMS repositories status
1827    my ($pburl) = pb_conf_get("pburl");
1828    ($scheme2, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}});
1829
1830    if ($scheme !~ /^svn/) {
1831        die "Only SVN is supported at the moment";
1832    }
1833
1834    my $res = pb_cms_isdiff($scheme,$ENV{'PBROOTDIR'});
1835    die "ERROR: No differences accepted in CMS for $ENV{'PBROOTDIR'} before creating a new version" if ($res != 0);
1836
1837    $res = pb_cms_isdiff($scheme2,$ENV{'PBDIR'});
1838    die "ERROR: No differences accepted in CMS for $ENV{'PBDIR'} before creating a new version" if ($res != 0);
1839
1840    # Tree identical between PBCONFDIR and PBROOTDIR. The delta is what
1841    # we want to get for the root of the new URL
1842
1843    my $tmp = $ENV{'PBROOTDIR'};
1844    $tmp =~ s|^$ENV{'PBCONFDIR'}||;
1845
1846    my $newurl = "$uri/".dirname($tmp)."/$newver";
1847    # Should probably use projver in the old file
1848    my $oldver= basename($tmp);
1849
1850    # Duplicate and extract project-builder part
1851    pb_log(2,"Copying $uri/$tmp to $newurl\n");
1852    pb_cms_copy($scheme,"$uri/$tmp",$newurl);
1853    pb_log(2,"Checkout $newurl to $ENV{'PBROOTDIR'}/../$newver\n");
1854    pb_cms_up($scheme,"$ENV{'PBCONFDIR'}/..");
1855
1856    # Duplicate and extract project
1857    my $newurl2 = "$pburl->{$ENV{'PBPROJ'}}/".dirname($tmp)."/$newver";
1858
1859    pb_log(2,"Copying $pburl->{$ENV{'PBPROJ'}}/$tmp to $newurl2\n");
1860    pb_cms_copy($scheme2,"$pburl->{$ENV{'PBPROJ'}}/$tmp",$newurl2);
1861    pb_log(2,"Checkout $newurl2 to $ENV{'PBDIR'}/../$newver\n");
1862    pb_cms_up($scheme2,"$ENV{'PBDIR'}/..");
1863
1864    # Update the .pb file
1865    open(FILE,"$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb") || die "Unable to open $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb";
1866    open(OUT,"> $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new") || die "Unable to write to $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new";
1867    while(<FILE>) {
1868        s/^projver\s+$ENV{'PBPROJ'}\s*=\s*$oldver/projver $ENV{'PBPROJ'} = $newver/;
1869        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/);
1870        s/^testver/#testver/;
1871        pb_log(0,"Commenting testver in $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb\n") if (/^testver/);
1872        print OUT $_;
1873    }
1874    close(FILE);
1875    close(OUT);
1876    rename("$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new","$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb");
1877
1878    # Checking pbcl files
1879    foreach my $f (<$ENV{'PBROOTDIR'}/*/pbcl>) {
1880        # Compute new pbcl file
1881        my $f2 = $f;
1882        $f2 =~ s|$ENV{'PBROOTDIR'}|$ENV{'PBROOTDIR'}/../$newver/|;
1883        open(PBCL,$f) || die "Unable to open $f";
1884        my $foundnew = 0;
1885        while (<PBCL>) {
1886            $foundnew = 1 if (/^$newver \(/);
1887        }
1888        close(PBCL);
1889        open(OUT,"> $f2") || die "Unable to write to $f2: $!";
1890        open(PBCL,$f) || die "Unable to open $f";
1891        while (<PBCL>) {
1892            print OUT "$_" if (not /^$oldver \(/);
1893            if ((/^$oldver \(/) && ($foundnew == 0)) {
1894                print OUT "$newver ($pbdate)\n";
1895                print OUT "- TBD\n";
1896                print OUT "\n";
1897                pb_log(0,"WARNING: version $newver not found in $f so added to $f2...\n") if ($foundnew == 0);
1898            }
1899        }
1900        close(OUT);
1901        close(PBCL);
1902    }
1903
1904    pb_log(2,"Checkin $ENV{'PBROOTDIR'}/../$newver\n");
1905    pb_cms_checkin($scheme,"$ENV{'PBROOTDIR'}/../$newver",undef);
1906}
1907
1908#
1909# Return the list of VMs/VEs we are working on
1910# $all is a flag to know if we return all of them
1911# or only some (if all we publish also tar files in addition to pkgs
1912#
1913sub pb_get_v {
1914
1915my $vtype = shift;
1916my @v;
1917my $all = 0;
1918my $vlist;
1919my $pbv = 'PBV';
1920
1921if ($vtype eq "vm") {
1922    $vlist = "vmlist";
1923} elsif ($vtype eq "ve") {
1924    $vlist = "velist";
1925}
1926# Get VM/VE list
1927if ((not defined $ENV{$pbv}) || ($ENV{$pbv} =~ /^all$/)) {
1928    my ($ptr) = pb_conf_get($vlist);
1929    $ENV{$pbv} = $ptr->{$ENV{'PBPROJ'}};
1930    $all = 1;
1931}
1932pb_log(2,"$vtype: $ENV{$pbv}\n");
1933@v = split(/,/,$ENV{$pbv});
1934return(\@v,$all);
1935}
1936
1937# Function to create a potentialy missing pb account on the VM/VE, and adds it to sudo
1938# Needs to use root account to connect to the VM/VE
1939# pb will take your local public SSH key to access
1940# the pb account in the VM later on if needed
1941sub pb_setup_v {
1942
1943my $vtype = shift;
1944
1945my ($vm,$all) = pb_get_v($vtype);
1946
1947# Script generated
1948my $pbscript = "$ENV{'PBDESTDIR'}/setupv";
1949
1950foreach my $v (@$vm) {
1951    # Deal with date sync.
1952    my ($ntpline,$dateline) = pb_date_v($vtype,$v);
1953
1954    # Name of the account to deal with for VM/VE
1955    # Do not use the one passed potentially with -a
1956    my ($pbac) = pb_conf_get($vtype."login");
1957    my ($key,$zero0,$zero1,$zero2);
1958    my ($vmexist,$vmpid);
1959
1960    # Prepare the script to be executed on the VM/VE
1961    # in $ENV{'PBDESTDIR'}/setupv
1962    open(SCRIPT,"> $pbscript") || die "Unable to create $pbscript";
1963   
1964    print SCRIPT << 'EOF';
1965#!/usr/bin/perl -w
1966
1967use strict;
1968use File::Copy;
1969
1970# We should not need in this script more functions than what is provided
1971# by Base and Distribution to avoid problems at exec time.
1972# They are appended at the end.
1973
1974our $pbdebug;
1975our $pbLOG;
1976our $pbsynmsg = "pbscript";
1977our $pbdisplaytype = "text";
1978our $pblocale = "";
1979pb_log_init($pbdebug, $pbLOG);
1980pb_temp_init();
1981
1982EOF
1983
1984    if ($vtype eq "vm") {
1985        # Prepare the key to be used and transfered remotely
1986        my $keyfile = pb_ssh_get(1);
1987       
1988        my ($vmhost,$vmport,$vmntp) = pb_conf_get("vmhost","vmport","vmntp");
1989        my $nport = $vmport->{$ENV{'PBPROJ'}};
1990        $nport = "$pbport" if (defined $pbport);
1991   
1992        # Launch the VM
1993        ($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1994
1995        # Skip that VM if something went wrong
1996        next if (($vmpid == 0) && ($vmexist == 0));
1997   
1998        # Store the pub key part in a variable
1999        open(FILE,"$keyfile.pub") || die "Unable to open $keyfile.pub";
2000        ($zero0,$zero1,$zero2) = split(/ /,<FILE>);
2001        close(FILE);
2002
2003        $key = "\Q$zero1";
2004
2005        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");
2006        # once this is done, we can do what we want on the VM remotely
2007    } elsif ($vtype eq "ve") {
2008        # We need to finish the setup of packages needed in the VE if needed
2009        # rinse at least needs it
2010        my ($vepkglist) = pb_conf_get_if("vepkglist");
2011
2012        if (defined $vepkglist) {
2013            # Get distro context
2014            my ($name,$ver,$darch) = split(/-/,$v);
2015            chomp($darch);
2016            my ($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd) = pb_distro_init($name,$ver,$darch);
2017   
2018            my $postparam = pb_distro_get_param($ddir,$dver,$darch,$vepkglist);
2019            # Change the list of pkg in to a space separated list
2020            $postparam =~ s/,/ /g;
2021            # remove potential sudo from the update command for this time,
2022            # as this will be run as root anyway, and if not we will have
2023            # a problem with tty
2024            $pbupd =~ s/sudo //g;
2025
2026            print SCRIPT << "EOF";
2027# For VE we first need to mount some FS
2028pb_system("mount -t proc /proc /proc");
2029
2030# For VE we need a good null dev
2031pb_system("rm -f /dev/null; mknod /dev/null c 1 3; chmod 777 /dev/null");
2032
2033
2034# For VE we need some additional packages that are not there yet
2035pb_system("$pbupd $postparam");
2036
2037EOF
2038        }
2039    }
2040    if ($vtype eq "vm") {
2041        print SCRIPT << 'EOF';
2042# Removes duplicate in .ssh/authorized_keys of our key if needed
2043#
2044my $file1="$ENV{'HOME'}/.ssh/authorized_keys";
2045open(PBFILE,$file1) || die "Unable to open $file1";
2046open(PBOUT,"> $file1.new") || die "Unable to open $file1.new";
2047my $count = 0;
2048while (<PBFILE>) {
2049
2050EOF
2051        print SCRIPT << "EOF";
2052    if (/ $key /) {
2053        \$count++;
2054    }
2055print PBOUT \$_ if ((\$count <= 1) || (\$_ !~ / $key /));
2056}
2057close(PBFILE);
2058close(PBOUT);
2059rename("\$file1.new",\$file1);
2060chmod 0600,\$file1;
2061
2062# Sync date
2063EOF
2064        if (defined $ntpline) {
2065            print SCRIPT "system(\"$ntpline\");\n";
2066        } else {
2067            print SCRIPT "system(\"$dateline\");\n";
2068        }
2069    }
2070    print SCRIPT << 'EOF';
2071
2072# Adds $pbac->{$ENV{'PBPROJ'}} as an account if needed
2073#
2074my $file="/etc/passwd";
2075open(PBFILE,$file) || die "Unable to open $file";
2076my $found = 0;
2077while (<PBFILE>) {
2078EOF
2079    print SCRIPT << "EOF";
2080    \$found = 1 if (/^$pbac->{$ENV{'PBPROJ'}}:/);
2081EOF
2082    print SCRIPT << 'EOF';
2083}
2084close(PBFILE);
2085
2086if ( $found == 0 ) {
2087    if ( ! -d "/home" ) {
2088        pb_mkdir("/home");
2089    }
2090EOF
2091    print SCRIPT << "EOF";
2092pb_system("groupadd $pbac->{$ENV{'PBPROJ'}}","Adding group $pbac->{$ENV{'PBPROJ'}}");
2093pb_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'}}");
2094}
2095EOF
2096
2097    if ($vtype eq "vm") {
2098        print SCRIPT << "EOF";
2099# allow ssh entry to build
2100#
2101mkdir "/home/$pbac->{$ENV{'PBPROJ'}}/.ssh",0700;
2102# Allow those accessing root to access the build account
2103copy("\$ENV{'HOME'}/.ssh/authorized_keys","/home/$pbac->{$ENV{'PBPROJ'}}/.ssh/authorized_keys");
2104chmod 0600,".ssh/authorized_keys";
2105pb_system("chown -R $pbac->{$ENV{'PBPROJ'}}:$pbac->{$ENV{'PBPROJ'}} /home/$pbac->{$ENV{'PBPROJ'}}/.ssh","Finish setting up the SSH env for $pbac->{$ENV{'PBPROJ'}}");
2106
2107EOF
2108}
2109    print SCRIPT << 'EOF';
2110# No passwd for build account only keys
2111$file="/etc/shadow";
2112if (-f $file) {
2113    open(PBFILE,$file) || die "Unable to open $file";
2114    open(PBOUT,"> $file.new") || die "Unable to open $file.new";
2115    while (<PBFILE>) {
2116EOF
2117    print SCRIPT << "EOF";
2118        s/^$pbac->{$ENV{'PBPROJ'}}:\!\!:/$pbac->{$ENV{'PBPROJ'}}:*:/;
2119        s/^$pbac->{$ENV{'PBPROJ'}}:\!:/$pbac->{$ENV{'PBPROJ'}}:*:/; #SLES 9 e.g.
2120EOF
2121        print SCRIPT << 'EOF';
2122        print PBOUT $_;
2123    }
2124    close(PBFILE);
2125    close(PBOUT);
2126    rename("$file.new",$file);
2127    chmod 0640,$file;
2128    }
2129
2130# Keep the VM in text mode
2131$file="/etc/inittab";
2132if (-f $file) {
2133    open(PBFILE,$file) || die "Unable to open $file";
2134    open(PBOUT,"> $file.new") || die "Unable to open $file.new";
2135    while (<PBFILE>) {
2136        s/^(..):5:initdefault:$/$1:3:initdefault:/;
2137        print PBOUT $_;
2138    }
2139    close(PBFILE);
2140    close(PBOUT);
2141    rename("$file.new",$file);
2142    chmod 0640,$file;
2143}
2144
2145# pb has to be added to portage group on gentoo
2146
2147# Adapt sudoers
2148$file="/etc/sudoers";
2149open(PBFILE,$file) || die "Unable to open $file";
2150open(PBOUT,"> $file.new") || die "Unable to open $file.new";
2151while (<PBFILE>) {
2152EOF
2153    print SCRIPT << "EOF";
2154    next if (/^$pbac->{$ENV{'PBPROJ'}}   /);
2155EOF
2156    print SCRIPT << 'EOF';
2157    s/Defaults[ \t]+requiretty//;
2158    print PBOUT $_;
2159}
2160close(PBFILE);
2161EOF
2162    print SCRIPT << "EOF";
2163# This is needed in order to be able to halt the machine from the $pbac->{$ENV{'PBPROJ'}} account at least
2164print PBOUT "Defaults:pb env_keep += \"http_proxy ftp_proxy\"\n";
2165print PBOUT "$pbac->{$ENV{'PBPROJ'}}   ALL=(ALL) NOPASSWD:ALL\n";
2166EOF
2167    print SCRIPT << 'EOF';
2168close(PBOUT);
2169rename("$file.new",$file);
2170chmod 0440,$file;
2171
2172EOF
2173       
2174    my $SCRIPT = \*SCRIPT;
2175   
2176    pb_install_deps($SCRIPT);
2177   
2178    print SCRIPT << 'EOF';
2179# Suse wants sudoers as 640
2180if (($ddir eq "sles") || (($ddir eq "opensuse") && ($dver =~ /10.[012]/))) {
2181    chmod 0640,$file;
2182}
2183
2184pb_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");
2185system "pb 2>&1 | head -5";
2186EOF
2187    if ($vtype eq "ve") {
2188            print SCRIPT << 'EOF';
2189# For VE we need to umount some FS at the end
2190
2191pb_system("umount /proc");
2192
2193# Create a basic network file if not already there
2194
2195my $nf="/etc/sysconfig/network";
2196if (! -f $nf) {
2197    open(NF,"> $nf") || die "Unable to create $nf";
2198    print NF "NETWORKING=yes\n";
2199    print NF "HOSTNAME=localhost\n";
2200    close(NF);
2201}
2202chmod 0755,$nf;
2203EOF
2204    }
2205
2206    # Adds pb_distro_init from ProjectBuilder::Distribution and Base
2207    foreach my $d (@INC) {
2208        my @f = ("$d/ProjectBuilder/Base.pm","$d/ProjectBuilder/Distribution.pm");
2209        foreach my $f (@f) {
2210            if (-f "$f") {
2211                open(PBD,"$f") || die "Unable to open $f";
2212                while (<PBD>) {
2213                        next if (/^package/);
2214                        next if (/^use Exporter/);
2215                        next if (/^use ProjectBuilder::/);
2216                        next if (/^our /);
2217                    print SCRIPT $_;
2218                }
2219                close(PBD);
2220            }
2221        }
2222    }
2223    close(SCRIPT);
2224    chmod 0755,"$pbscript";
2225
2226    # That build script needs to be run as root and force stop of VM at end
2227    $pbaccount = "root";
2228
2229    # Force shutdown of VM exept if it was already launched
2230    my $pbforce = 0;
2231    if ((! $vmexist) && ($vtype eq "vm")) {
2232        $pbforce = 1;
2233    }
2234   
2235    pb_script2v($pbscript,$vtype,$pbforce,$v);
2236}
2237return;
2238}
2239
2240# Function to create a snapshot named 'pb' for VMs/VEs
2241sub pb_snap_v {
2242
2243my $vtype = shift;
2244
2245my ($vm,$all) = pb_get_v($vtype);
2246
2247# Script generated
2248my $pbscript = "$ENV{'PBDESTDIR'}/snapv";
2249
2250foreach my $v (@$vm) {
2251    # Name of the account to deal with for VM/VE
2252    # Do not use the one passed potentially with -a
2253    my ($pbac) = pb_conf_get($vtype."login");
2254    my ($vmexist,$vmpid);
2255
2256    # Prepare the script to be executed on the VM/VE
2257    # in $ENV{'PBDESTDIR'}/setupv
2258    open(SCRIPT,"> $pbscript") || die "Unable to create $pbscript";
2259   
2260    print SCRIPT << 'EOF';
2261    #!/bin/bash
2262    sleep 60
2263EOF
2264    close(SCRIPT);
2265    chmod 0755,"$pbscript";
2266
2267    # Force shutdown of VM/VE
2268    $pbforce = 1;
2269    # Force snapshot of VM/VE
2270    pb_script2v($pbscript,$vtype,$pbforce,$v,1);
2271}
2272return;
2273}
2274
2275sub pb_install_deps {
2276
2277my $SCRIPT = shift;
2278
2279print {$SCRIPT} << 'EOF';
2280# We need to have that pb_distro_init function
2281# Get it from Project-Builder::Distribution
2282my ($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd) = pb_distro_init(); 
2283print "distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n";
2284
2285# We may need a proxy configuration. Get it from the local env
2286EOF
2287
2288if (defined $ENV{'http_proxy'}) {
2289    print SCRIPT "\$ENV\{'http_proxy'\}=\"$ENV{'http_proxy'}\";\n";
2290}
2291
2292if (defined $ENV{'ftp_proxy'}) {
2293    print SCRIPT "\$ENV\{'ftp_proxy'\}=\"$ENV{'ftp_proxy'}\";\n";
2294}
2295
2296print {$SCRIPT} << 'EOF';
2297# Get and install pb
2298my $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*";
2299my $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*";
2300my $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*";
2301my $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*";
2302my $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*";
2303my $cmtdm = "Installing Date-Manip perl module";
2304my $cmtmb = "Installing Module-Build perl module";
2305my $cmtfm = "Installing File-MimeInfo perl module";
2306my $cmtfb = "Installing File-Basedir perl module";
2307my $cmtms = "Installing Perl-Sendmail perl module";
2308my $cmtall = "Installing required modules";
2309
2310if ( $ddir eq "fedora" ) {
2311    pb_system("yum clean all","Cleaning yum env");
2312    if ($dver == 4) {
2313        pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"rpm-build wget patch ntp sudo perl-DateManip perl-ExtUtils-MakeMaker"));
2314        pb_system("$insmb","$cmtmb");
2315        pb_system("$insfm","$cmtfm");
2316        pb_system("$insfb","$cmtfb");
2317        pb_system("$insms","$cmtms");
2318    } else {
2319        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"));
2320    }
2321} elsif ($ddir eq "asianux") {
2322    pb_system("yum clean all","Cleaning yum env");
2323    pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"rpm-build wget patch ntp sudo perl-DateManip"));
2324    pb_system("$insmb","$cmtmb");
2325    pb_system("$insfm","$cmtfm");
2326    pb_system("$insfb","$cmtfb");
2327    pb_system("$insms","$cmtms");
2328} elsif (( $dfam eq "rh" ) || ($ddir eq "suse") || ($ddir eq "sles") || (($ddir eq "opensuse") && (($dver eq "10.1") || ($dver eq "10.0"))) || ($ddir eq "slackware")) {
2329    # Suppose pkg are installed already as no online mirror available
2330    pb_system("rpm -e lsb 2>&1 > /dev/null","Removing lsb package");
2331    pb_system("$insdm","$cmtdm");
2332    pb_system("$insmb","$cmtmb");
2333    pb_system("$insfm","$cmtfm");
2334    pb_system("$insfb","$cmtfb");
2335    pb_system("$insms","$cmtms");
2336} elsif ($ddir eq "opensuse") { 
2337    # New OpenSuSE
2338    pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"make wget patch sudo ntp"));
2339    pb_system("$insmb","$cmtmb");
2340    pb_system("$insfm","$cmtfm");
2341    pb_system("$insfb","$cmtfb");
2342    pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"perl-Date-Manip perl-File-HomeDir perl-Mail-Sendmail"));
2343    if ($dver < 11) {
2344        pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"ntp"));
2345    } else {
2346        pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"sntp"));
2347    }
2348} elsif ( $dfam eq "md" ) {
2349        my $addp = "";
2350        if (($ddir eq "mandrake") && ($dver eq "10.1")) {
2351            pb_system("$insdm","$cmtdm");
2352        } else {
2353            $addp ="perl-DateManip";
2354        }
2355        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"));
2356} elsif ( $dfam eq "du" ) {
2357    if (( $dver eq "3.1" ) && ($ddir eq "debian")) {
2358        pb_system("$insfb","$cmtfb");
2359        pb_system("$insfm","$cmtfm");
2360        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"));
2361    } else  {
2362        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"));
2363    }
2364} elsif ( $dfam eq "gen" ) {
2365        #system "emerge -u system";
2366        pb_distro_installdeps(undef,$dtype,$pbupd,pb_distro_only_deps_needed($dtype,"wget sudo ntp DateManip File-MimeInfo Mail-Sendmail"));
2367} else {
2368    pb_log(0,"No pkg to install\n");
2369}
2370EOF
2371}
2372
2373sub pb_announce {
2374
2375    # Get all required parameters
2376    my ($pbpackager,$pbrepo,$pbml,$pbsmtp) = pb_conf_get("pbpackager","pbrepo","pbml","pbsmtp");
2377    my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
2378    my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
2379    my @pkgs = @$pkg;
2380    my %pkgs;
2381    my $first = 0;
2382
2383    # Command to find packages on repo
2384    my $findstr = "find . ";
2385    # Generated announce files
2386    my @files;
2387
2388    foreach my $pbpkg (@pkgs) {
2389        if ($first != 0) {
2390            $findstr .= "-o ";
2391        }
2392        $first++;
2393        if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
2394            $pbver = $pkgv->{$pbpkg};
2395        } else {
2396            $pbver = $ENV{'PBPROJVER'};
2397        }
2398        if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
2399            $pbtag = $pkgt->{$pbpkg};
2400        } else {
2401            $pbtag = $ENV{'PBPROJTAG'};
2402        }
2403
2404        # TODO: use virtual/real names here now
2405        $findstr .= "-name \'$pbpkg-$pbver-$pbtag\.*.rpm\' -o -name \'$pbpkg"."_$pbver*\.deb\' -o -name \'$pbpkg-$pbver\.ebuild\' ";
2406
2407        my $chglog;
2408
2409        # Get project info on log file and generate tmp files used later on
2410        pb_cms_init($pbinit);
2411        $chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
2412        $chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
2413        $chglog = undef if (! -f $chglog);
2414
2415        open(OUT,"> $ENV{'PBTMP'}/$pbpkg.ann") || die "Unable to create $ENV{'PBTMP'}/$pbpkg.ann: $!";
2416        my %pb;
2417        $pb{'dtype'} = "announce";
2418        $pb{'realpkg'} = $pbpkg;
2419        $pb{'ver'} = $pbver;
2420        $pb{'tag'} = $pbtag;
2421        $pb{'suf'} = "N/A";     # Should not be empty even if unused
2422        $pb{'date'} = $pbdate;
2423        $pb{'chglog'} = $chglog;
2424        $pb{'packager'} = $pbpackager;
2425        $pb{'proj'} = $ENV{'PBPROJ'};
2426        $pb{'repo'} = $pbrepo;
2427        pb_changelog(\%pb,\*OUT,"yes");
2428        close(OUT);
2429        push(@files,"$ENV{'PBTMP'}/$pbpkg.ann");
2430    }
2431    $findstr .= " | grep -Ev \'src.rpm\'";
2432    if ((not defined $testver) || (not defined $testver->{$ENV{'PBPROJ'}}) || ($testver->{$ENV{'PBPROJ'}} !~ /true/i)) {
2433        $findstr .= " | grep -v ./test/";
2434    }
2435
2436    # Prepare the command to run and execute it
2437    open(PBS,"> $ENV{'PBTMP'}/pbscript") || die "Unable to create $ENV{'PBTMP'}/pbscript";
2438    print PBS "$findstr\n";
2439    close(PBS);
2440    chmod 0755,"$ENV{'PBTMP'}/pbscript";
2441    pb_send2target("Announce");
2442
2443    # Get subject line
2444    my $sl = "Project $ENV{'PBPROJ'} version $ENV{'PBPROJVER'} is now available";
2445    pb_log(0,"Please enter the title of your announce\n");
2446    pb_log(0,"(By default: $sl)\n");
2447    my $sl2 = <STDIN>;
2448    $sl = $sl2 if ($sl2 !~ /^$/);
2449
2450    # Prepare a template of announce
2451    open(ANN,"> $ENV{'PBTMP'}/announce.html") || die "Unable to create $ENV{'PBTMP'}/announce.html: $!";
2452    print ANN << "EOF";
2453$sl</p>
2454
2455<p>The project team is happy to announce the availability of a newest version of $ENV{'PBPROJ'} $ENV{'PBPROJVER'}. Enjoy it as usual!</p>
2456<p>
2457Now available at <a href="$pbrepo->{$ENV{'PBPROJ'}}">$pbrepo->{$ENV{'PBPROJ'}}</a>
2458</p>
2459<p>
2460EOF
2461    open(LOG,"$ENV{'PBTMP'}/system.log") || die "Unable to read $ENV{'PBTMP'}/system.log: $!";
2462    my $col = 2;
2463    my $i = 1;
2464    print ANN << 'EOF';
2465<TABLE WIDTH="700" CELLPADDING="0" CELLSPACING="0" BORDER="0">
2466<TR>
2467EOF
2468    while (<LOG>) {
2469        print ANN "<TD><A HREF=\"$pbrepo->{$ENV{'PBPROJ'}}/$_\">$_</A></TD>";
2470        $i++;
2471        if ($i > $col) {
2472            print ANN "</TR>\n<TR>";
2473            $i = 1;
2474        }
2475    }
2476    close(LOG);
2477    print ANN << "EOF";
2478</TR>
2479</TABLE>
2480</p>
2481
2482<p>As usual source packages are also available in the same directory.</p>
2483
2484<p>
2485Changes are :
2486</p>
2487<p>
2488EOF
2489    # Get each package changelog content
2490    foreach my $f (sort(@files)) {
2491        open(IN,"$f") || die "Unable to read $f:$!";
2492        while (<IN>) {
2493            print ANN $_;
2494        }
2495        close(IN);
2496        print ANN "</p><p>\n";
2497    }
2498    print ANN "</p>\n";
2499    close(ANN);
2500
2501    # Allow for modification
2502    pb_system("vi $ENV{'PBTMP'}/announce.html","Allowing modification of the announce","noredir");
2503
2504    # Store it in DB for external usage (Web pages generation)
2505    my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
2506
2507    my $precmd = "";
2508    if (! -f $db) {
2509        $precmd = "CREATE TABLE announces (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, announce VARCHAR[65535])";
2510    }
2511
2512    my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
2513                        { RaiseError => 1, AutoCommit => 1 })
2514                        || die "Unable to connect to $db";
2515
2516    if ($precmd ne "") {
2517        my $sth = $dbh->prepare(qq{$precmd})
2518                    || die "Unable to create table into $db";
2519        $sth->execute();
2520    }
2521
2522    # To read whole file
2523    local $/;
2524    open(ANN,"$ENV{'PBTMP'}/announce.html") || die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
2525    my $announce = <ANN>;
2526    close(ANN);
2527   
2528    pb_log(2,"INSERT INTO announces VALUES (NULL, $pbdate, $announce)");
2529    my $sth = $dbh->prepare(qq{INSERT INTO announces VALUES (NULL,?,?)})
2530                    || die "Unable to insert into $db";
2531    $sth->execute($pbdate, $announce);
2532    $sth->finish();
2533    $dbh->disconnect;
2534
2535    # Then deliver it on the Web
2536    # $TOOLHOME/livwww www
2537
2538    # Mail it to project's ML
2539    open(ML,"| w3m -dump -T text/html > $ENV{'PBTMP'}/announce.txt") || die "Unable to create $ENV{'PBTMP'}/announce.txt: $!";
2540    print ML << 'EOF';
2541<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/x html1/DTD/xhtml1-strict.dtd">
2542
2543<html xmlns="http://www.w3.org/1999/xhtml" dir="ltr" xml:lang="en" lang="en">
2544  <head>
2545  </head>
2546  <body>
2547  <p>
2548EOF
2549    open(ANN,"$ENV{'PBTMP'}/announce.html") || die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
2550    while(<ANN>) {
2551        print ML $_;
2552    }
2553    print ML << 'EOF';
2554</body>
2555</html>
2556EOF
2557    close(ML);
2558
2559    # To read whole file
2560    local $/;
2561    open(ANN,"$ENV{'PBTMP'}/announce.txt") || die "Unable to read $ENV{'PBTMP'}/announce.txt: $!";
2562    my $msg = <ANN>;
2563    close(ANN);
2564   
2565    # Preparation of headers
2566
2567    my %mail = (   
2568            To          =>  $pbml->{$ENV{'PBPROJ'}},
2569            From        =>  $pbpackager->{$ENV{'PBPROJ'}},
2570            Smtp        =>  $pbsmtp->{$ENV{'PBPROJ'}},
2571            Body        =>  $msg,
2572            Subject     =>  "[ANNOUNCE] $sl",
2573        );
2574           
2575    # Send mail
2576    sendmail(%mail) or die "Unable to send mail ($Mail::Sendmail::error): $Mail::Sendmail::log";
2577}
2578
2579#
2580# Creates a set of HTML file containing the news for the project
2581# based on what has been generated by the pb_announce function
2582#
2583sub pb_web_news2html {
2584
2585    my $dest = shift || $ENV{'PBTMP'};
2586
2587    # Get all required parameters
2588    my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
2589
2590    # DB of announces for external usage (Web pages generation)
2591    my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
2592
2593    my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
2594                        { RaiseError => 1, AutoCommit => 1 })
2595                        || die "Unable to connect to $db";
2596    # For date handling
2597    $ENV{LANGUAGE}="C";
2598    my $firstjan = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year(), 0, 0, -1);
2599    my $oldfirst = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year()-1, 0, 0, -1);
2600    pb_log(2,"firstjan: $firstjan, oldfirst: $oldfirst, pbdate:$pbdate\n");
2601    my $all = $dbh->selectall_arrayref("SELECT id,date,announce FROM announces ORDER BY date DESC");
2602    my %news;
2603    $news{"cy"} = "";   # current year's news
2604    $news{"ly"} = "";   # last year news
2605    $news{"py"} = "";   # previous years news
2606    $news{"fp"} = "";   # first page news
2607    my $cpt = 4;        # how many news for first page
2608    # Extract info from DB
2609    foreach my $row (@$all) {
2610        my ($id, $date, $announce) = @$row;
2611        $news{"cy"} = $news{"cy"}."<p><B>$date</B> $announce\n" if ((($date cmp $pbdate) le 0) && (($firstjan cmp $date) le 0));
2612        $news{"ly"} = $news{"ly"}."<p><B>$date</B> $announce\n" if ((($date cmp $firstjan) le 0) && (($oldfirst cmp $date) le 0));
2613        $news{"py"} = $news{"py"}."<p><B>$date</B> $announce\n" if (($date cmp $oldfirst) le 0);
2614        $news{"fp"} = $news{"fp"}."<p><B>$date</B> $announce\n" if ($cpt > 0);
2615        $cpt--;
2616    }
2617    pb_log(1,"news{fp}: ".$news{"fp"}."\n");
2618    $dbh->disconnect;
2619
2620    # Generate the HTML content
2621    foreach my $pref (keys %news) {
2622        open(NEWS,"> $dest/pb_web_$pref"."news.html") || die "Unable to create $dest/pb_web_$pref"."news.html: $!";
2623        print NEWS "$news{$pref}";
2624        close(NEWS);
2625    }
2626}
2627
2628
2629# Return the SSH key file to use
2630# Potentially create it if needed
2631
2632sub pb_ssh_get {
2633
2634my $create = shift || 0;    # Do not create keys by default
2635
2636# Check the SSH environment
2637my $keyfile = undef;
2638
2639# We have specific keys by default
2640$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
2641if (!(-e $keyfile) && ($create eq 1)) {
2642    pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
2643}
2644
2645$keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
2646$keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
2647$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
2648die "Unable to find your public ssh key under $keyfile" if (not defined $keyfile);
2649return($keyfile);
2650}
2651
2652
2653# Returns the pid of a running VM command using a specific VM file
2654sub pb_check_ps {
2655    my $vmcmd = shift;
2656    my $vmm = shift;
2657    my $vmexist = 0;        # FALSE by default
2658
2659    open(PS, "ps auxhww|") || die "Unable to call ps";
2660    while (<PS>) {
2661        next if (! /$vmcmd/);
2662        next if (! /$vmm/);
2663        my ($void1, $void2);
2664        ($void1, $vmexist, $void2) = split(/ +/);
2665        last;
2666    }
2667    return($vmexist);
2668}
2669
2670
2671sub pb_extract_build_files {
2672
2673my $src=shift;
2674my $dir=shift;
2675my $ddir=shift;
2676my $mandatory=shift || "spec";
2677my @files;
2678
2679my $flag = "mayfail" if ($mandatory eq "patch");
2680my $res;
2681
2682if ($src =~ /tar\.gz$/) {
2683    $res = pb_system("tar xfpz $src $dir","Extracting $mandatory files from $src",$flag);
2684} elsif ($src =~ /tar\.bz2$/) {
2685    $res = pb_system("tar xfpj $src $dir","Extracting $mandatory files from $src",$flag);
2686} else {
2687    die "Unknown compression algorithm for $src";
2688}
2689# If not mandatory return now
2690return() if (($res != 0) and ($mandatory eq "patch"));
2691opendir(DIR,"$dir") || die "Unable to open directory $dir";
2692foreach my $f (readdir(DIR)) {
2693    next if ($f =~ /^\./);
2694    # Skip potential patch dir
2695    next if ($f =~ /^pbpatch/);
2696    move("$dir/$f","$ddir") || die "Unable to move $dir/$f to $ddir";
2697    pb_log(2,"mv $dir/$f $ddir\n");
2698    push @files,"$ddir/$f";
2699}
2700closedir(DIR);
2701# Not enough but still a first cleanup
2702pb_rm_rf("$dir");
2703return(@files);
2704}
2705
2706sub pb_list_bfiles {
2707
2708my $dir = shift;
2709my $pbpkg = shift;
2710my $bfiles = shift;
2711my $pkgfiles = shift;
2712my $supfiles = shift;
2713
2714opendir(BDIR,"$dir") || die "Unable to open dir $dir: $!";
2715foreach my $f (readdir(BDIR)) {
2716    next if ($f =~ /^\./);
2717    $bfiles->{$f} = "$dir/$f";
2718    $bfiles->{$f} =~ s~$ENV{'PBROOTDIR'}~~;
2719    if (defined $supfiles->{$pbpkg}) {
2720        $pkgfiles->{$f} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
2721    }
2722}
2723closedir(BDIR);
2724}
2725
2726
2727#
2728# Return the list of packages we are working on in a non CMS action
2729#
2730sub pb_get_pkg {
2731
2732my @pkgs = ();
2733
2734my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
2735@pkgs = keys %$var;
2736
2737pb_log(0,"Packages: ".join(',',@pkgs)."\n");
2738return(\@pkgs);
2739}
2740
27411;
Note: See TracBrowser for help on using the repository browser.