source: devel/pb/bin/pb @ 727

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