source: devel/pb/bin/pb @ 1221

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