source: devel/pb/bin/pb @ 1121

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