source: devel/pb/bin/pb @ 1198

Revision 1198, 123.0 KB checked in by bruno, 2 years ago (diff)
  • Fix sudoers format fr env_keep (at least on gentoo)
  • Fix pb_get_sudocmds to deal correctly with additional params, and handle correctly spaces before sudo
  • Add full path names on sudo commands for gentoo
  • 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
763        foreach my $pbpkg (@pkgs) {
764                $ENV{'PBPKG'} = $pbpkg;
765
766                if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
767                        $pbver = $pkgv->{$pbpkg};
768                } else {
769                        $pbver = $ENV{'PBPROJVER'};
770                }
771                # If it's a test version, then tag == 0.date
772                if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
773                        $pbtag = "0.".strftime("%Y%m%d%H%M%S", @date);
774                        $ENV{'PBPROJTAG'} = $pbtag;
775                } elsif ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
776                        $pbtag = $pkgt->{$pbpkg};
777                } else {
778                        $pbtag = $ENV{'PBPROJTAG'};
779                }
780
781                $pbrev = $ENV{'PBREVISION'};
782                pb_log(0,"\n");
783                pb_log(0,"Management of $pbpkg $pbver-$pbtag (rev $pbrev)\n");
784                die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
785
786                my $dest = "$ENV{'PBDESTDIR'}/$pbpkg-$pbver";
787                # Create the structure if needed
788                pb_mkdir_p($dest);
789                # Clean up dest if necessary. The export will recreate it
790                pb_rm_rf($dest) if (-d $dest);
791
792                # Export CMS tree for the concerned package to dest
793                # And generate some additional files
794                $OUTPUT_AUTOFLUSH=1;
795
796                # computes in which dir we have to work
797                my $dir = $defpkgdir->{$pbpkg};
798                $dir = $extpkgdir->{$pbpkg} if (not defined $dir);
799                $dir = $webdir->{$ENV{'PBPROJ'}} if (defined $web);
800                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);
801                pb_log(2,"def:".Dumper($defpkgdir)." ext: ".Dumper($extpkgdir)." \n");
802
803                # Exporting content from CMS
804                my $sourcedir = undef;
805                my $sourceuri = $uri;
806                if ($param eq "SandBox") {
807                        # Point to the local instance
808                        $sourcedir = "$ENV{'PBDIR'}/$dir";
809                } else {
810                        # Get it from a subdir of the URI with same version as localy but different root
811                        # Only if using a real CMS
812                        my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);
813                        if (($scheme !~ /^file/) && ($scheme !~ /^(ht|f)tp/)) {
814                                $sourceuri = "$ENV{'PBDIR'}/$dir"; 
815                                $sourceuri =~ s|^$ENV{'PBPROJDIR'}/|$uri|;
816                        }
817                }
818                my $preserve = pb_cms_export($sourceuri,$sourcedir,$dest);
819
820                # Generated fake content for test versions to speed up stuff
821                my $chglog;
822
823                # Get project info on authors and log file
824                # TODO: Make it CMS aware
825                $chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
826                $chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
827                $chglog = undef if (! -f $chglog);
828
829                # TODO: Make it CMS aware
830                my $authors = "$ENV{'PBROOTDIR'}/$pbpkg/pbauthors";
831                $authors = "$ENV{'PBROOTDIR'}/pbauthors" if (! -f $authors);
832                $authors = "/dev/null" if (! -f $authors);
833
834                # Extract cms log history and store it
835                if ((defined $chglog) && (! -f "$dest/NEWS")) {
836                        pb_log(2,"Generating NEWS file from $chglog\n");
837                        copy($chglog,"$dest/NEWS") || die "Unable to create $dest/NEWS";
838                }
839                pb_cms_log($scheme,"$ENV{'PBDIR'}/$dir",$dest,$chglog,$authors,$testver);
840
841                my %build;
842                # We want to at least build for the underlying distro
843                # except if a target was given, in which case we only build for it
844                my $pbos = pb_distro_get_context($pbtarget);
845                my $tmpl = "$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'},";
846
847                # Get list of distributions for which we need to generate build files if no target
848                if (not defined ($pbtarget)) {
849                        my @pt = pb_conf_get_if("vmlist","velist","rmlist");
850                        if (defined $pt[0]->{$ENV{'PBPROJ'}}) {
851                                $tmpl .= $pt[0]->{$ENV{'PBPROJ'}};
852                        }
853                        if (defined $pt[1]->{$ENV{'PBPROJ'}}) {
854                                # The 2 lists needs to be grouped with a ',' separating them
855                                if ($tmpl ne "") {
856                                        $tmpl .= ",";
857                                }
858                                $tmpl .= $pt[1]->{$ENV{'PBPROJ'}} 
859                        }
860                        if (defined $pt[2]->{$ENV{'PBPROJ'}}) {
861                                # The lists needs to be grouped with a ',' separating them
862                                if ($tmpl ne "") {
863                                        $tmpl .= ",";
864                                }
865                                $tmpl .= $pt[2]->{$ENV{'PBPROJ'}} 
866                        }
867                }
868       
869                # Setup $pb structure to allow filtering later on, on files using that structure
870                $pb->{'tag'} = $pbtag;
871                $pb->{'rev'} = $pbrev;
872                $pb->{'ver'} = $pbver;
873                $pb->{'pkg'} = $pbpkg;
874                $pb->{'suf'} = $pbos->{'suffix'};
875                $pb->{'realpkg'} = $pbpkg;
876                $pb->{'date'} = $pbdate;
877                $pb->{'defpkgdir'} = $defpkgdir;
878                $pb->{'extpkgdir'} = $extpkgdir;
879                $pb->{'chglog'} = $chglog;
880                $pb->{'packager'} = $ENV{'PBPACKAGER'};
881                $pb->{'proj'} = $ENV{'PBPROJ'};
882                $pb->{'repo'} = $ENV{'PBREPO'};
883                $pb->{'patches'} = ();
884                $pb->{'sources'} = ();
885       
886                my $tmpd = "$ENV{'PBTMP'}/cms.$$";
887                pb_mkdir_p($tmpd) if (defined $pbparallel);
888
889                # Get only all.pbf filter at this stage for pbinit
890                my $ptr = pb_get_filters($pbpkg);
891
892                # TODO: Make it CMS aware
893                # Execute the pbinit script if any
894                if (-x "$ENV{'PBROOTDIR'}/$pbpkg/pbinit") {
895                        pb_filter_file("$ENV{'PBROOTDIR'}/$pbpkg/pbinit",$ptr,"$ENV{'PBTMP'}/pbinit",$pb);
896                        chmod 0755,"$ENV{'PBTMP'}/pbinit";
897                        pb_system("cd $dest ; $ENV{'PBTMP'}/pbinit","Executing init script from $ENV{'PBROOTDIR'}/$pbpkg/pbinit","verbose");
898                }
899
900                # Do not do that for website
901                if (not defined $web) {
902                        my %virt;
903                        # De-duplicate similar VM/VE/RM
904                        foreach my $d (split(/,/,$tmpl)) {
905                                # skip ill-formatted vms (name-ver-arch)
906                                next if ($d !~ /-/);
907                                $virt{$d} = $d;
908                        }
909
910                        # Try to use // processing here
911                        my $pm;
912                        $pm = new Parallel::ForkManager($pbparallel) if (defined $pbparallel);
913
914                        pb_log(0,"Preparing delivery ...\n");
915                        foreach my $v (keys %virt) {
916                                $pm->start and next if (defined $pbparallel);
917
918                                # Distro context
919                                my $pbos = pb_distro_get_context($v);
920                                $pb->{'pbos'} = $pbos;
921                                $pb->{'suf'} = $pbos->{'suffix'};
922                                pb_log(3,"DEBUG: pb: ".Dumper($pb)."\n");
923
924                                # Get all filters to apply
925                                $ptr = pb_get_filters($pbpkg,$pbos);
926       
927                                pb_log(2,"DEBUG Filtering PBDATE => $pbdate, PBTAG => $pbtag, PBVER => $pbver\n");
928       
929                                # We need to compute the real name of the package
930                                my $pbrealpkg = pb_cms_get_real_pkg($pbpkg,$pbos->{'type'});
931                                $pb->{'realpkg'} = $pbrealpkg;
932                                pb_log(1,"Virtual package $pbpkg has a real package name of $pbrealpkg on $pbos->{'name'}-$pbos->{'version'}\n") if ($pbrealpkg ne $pbpkg);
933       
934                                # Filter build files from the less precise up to the most with overloading
935                                # Filter all files found, keeping the name, and generating in dest
936       
937                                # Find all build files first relatively to PBROOTDIR
938                                # Find also all specific files referenced in the .pb conf file
939                                my %bfiles = ();
940                                my %pkgfiles = ();
941                                # Used in Filter.pm by pb_filter_file
942
943                                $build{$v} = "yes";
944                                if (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'os'}") {
945                                        pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'os'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
946                                } elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'type'}") {
947                                        pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'type'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
948                                } elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'family'}") {
949                                        pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'family'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
950                                } elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'name'}") {
951                                        pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'name'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
952                                } elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'name'}-$pbos->{'version'}") {
953                                        pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'name'}-$pbos->{'version'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
954                                } elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}") {
955                                        pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
956                                } else {
957                                        $build{$v} = "no";
958                                }
959                                pb_log(2,"DEBUG($v) bfiles: ".Dumper(\%bfiles)."\n");
960       
961                                if ($build{$v} ne "no") {
962                                        # Apply now all the filters on all the files concerned
963                                        # destination dir depends on the type of file
964                                        # For patch support
965                                        # TODO: Make it CMS aware
966                                        $pb->{'patches'} = pb_list_sfiles("$ENV{'PBROOTDIR'}/$pbpkg/pbpatch", $pb->{'patches'}, $pbos, "$ENV{'PBROOTDIR'}/$pbpkg/pbextpatch");
967                                        pb_log(2,"DEBUG($v) patches: ".Dumper($pb->{'patches'})."\n");
968                                        # TODO: Make it CMS aware
969                                        $pb->{'sources'} = pb_list_sfiles("$ENV{'PBROOTDIR'}/$pbpkg/pbsrc", $pb->{'sources'}, $pbos, "$ENV{'PBROOTDIR'}/$pbpkg/pbextsrc");
970                                        pb_log(2,"DEBUG($v) sources: ".Dumper($pb->{'sources'})."\n");
971       
972                                        if (defined $pb->{'patches'}->{$v}) {
973                                                # Filter potential patches (local + remote)
974                                                pb_mkdir_p("$dest/pbconf/$v/pbpatch");
975                                                foreach my $pf (split(/,/,$pb->{'patches'}->{$v})) {
976                                                        my $pp = basename($pf);
977                                                        pb_cms_export($pf,undef,"$dest/pbconf/$v/pbpatch");
978                                                        pb_filter_file_inplace($ptr,"$dest/pbconf/$v/pbpatch/$pp",$pb);
979                                                        pb_system("gzip -9f $dest/pbconf/$v/pbpatch/$pp","","quiet");
980                                                }
981                                        }
982                                        if (defined $pb->{'sources'}->{$v}) {
983                                                pb_mkdir_p("$dest/pbconf/$v/pbsrc");
984                                                foreach my $pf (split(/,/,$pb->{'sources'}->{$v})) {
985                                                        my $pp = basename($pf);
986                                                        pb_cms_export($pf,undef,"$dest/pbconf/$v/pbsrc");
987                                                        pb_filter_file_inplace($ptr,"$dest/pbconf/$v/pbsrc/$pp",$pb);
988                                                }
989                                        }
990                                        # Filter build files at the end, as they depend on patches and sources
991                                        foreach my $f (values %bfiles,values %pkgfiles) {
992                                                pb_filter_file("$ENV{'PBROOTDIR'}/$f",$ptr,"$dest/pbconf/$v/".basename($f),$pb);
993                                        }
994                                }
995
996                                if (defined $pbparallel) {
997                                        # Communicate results back to parent
998                                        my $str = "";
999                                        $str .= "build $v = $build{$v}\n" if (defined $build{$v});
1000                                        $str .= "patches $v = $pb->{'patches'}->{$v}\n" if (defined $pb->{'patches'}->{$v});
1001                                        $str .= "sources $v = $pb->{'sources'}->{$v}\n" if (defined $pb->{'sources'}->{$v});
1002                                        pb_set_content("$tmpd/$$","$str");
1003                                        $pm->finish;
1004                                }
1005                        }
1006                        # In the parent, we need to get the result from the children
1007                        $pm->wait_all_children if (defined $pbparallel);
1008                        my $made = "";
1009                        my %h = ();
1010                        my %tmp;
1011                        my %tmp2;
1012                        my $pt;
1013                        my $k;
1014
1015                        foreach $k (<$tmpd/*>) {
1016                                $made .= pb_get_content($k);
1017                        }
1018                        pb_rm_rf($tmpd);
1019                        pb_log(3,"MADE:\n$made");
1020
1021                        # Rebuild local hashes
1022                        foreach $k (split(/\n/,$made)) {
1023                                if ($k =~ /^\s*([A-z0-9-_]+)\s+([[A-z0-9-_.]+)\s*=\s*(.+)$/) {
1024                                        $h{$1}->{$2}=$3;
1025                                }
1026                        }
1027                        pb_log(2,"HASH: ".Dumper(%h));
1028
1029                        # Patches
1030                        pb_log(0,"Delivered and compressed patches ");
1031                        $pt = $h{'patches'};
1032                        foreach $k (keys %$pt) {
1033                                foreach my $v1 (split(/,/,$pt->{$k})) {
1034                                        $tmp{$v1} = "";
1035                                }
1036                        }
1037                        if (keys %tmp) {
1038                                foreach $k (keys %tmp) {
1039                                        pb_log(0,"$k ");
1040                                }
1041                        } else {
1042                                pb_log(0,"N/A");
1043                        }
1044                        pb_log(0,"\n");
1045
1046                        # Sources
1047                        pb_log(0,"Delivered additional sources ");
1048                        $pt = $h{'sources'};
1049                        foreach $k (keys %$pt) {
1050                                foreach my $v1 (split(/,/,$pt->{$k})) {
1051                                        $tmp2{$v1} = "";
1052                                }
1053                        }
1054                        if (keys %tmp2) {
1055                                foreach $k (keys %tmp2) {
1056                                        pb_log(0,"$k ");
1057                                }
1058                        } else {
1059                                pb_log(0,"N/A");
1060                        }
1061                        pb_log(0,"\n");
1062
1063                        # Build files
1064                        my @found;
1065                        my @notfound;
1066                        $pt = $h{'build'};
1067                        foreach my $b (keys %$pt) {
1068                                push @found,$b if ($pt->{$b} =~ /yes/);
1069                                push @notfound,$b if ($pt->{$b} =~ /no/);
1070                        }
1071                        pb_log(0,"Build files have been generated for ... ".join(',',sort(@found))."\n") if (@found);
1072                        pb_log(0,"No Build files found for ".join(',',sort(@notfound))."\n") if (@notfound);
1073
1074                        # Apply filters to the non-build files
1075                        my $liste ="";
1076                        if (defined $filteredfiles->{$pbpkg}) {
1077                                foreach my $f (split(/,/,$filteredfiles->{$pbpkg})) {
1078                                        pb_filter_file_inplace($ptr,"$dest/$f",$pb);
1079                                        $liste = "$f $liste";
1080                                }
1081                        }
1082                        pb_log(2,"Files ".$liste."have been filtered\n");
1083
1084                        # Do we have additional script to run to prepare the environement for the project ?
1085                        # Then include it in the pbconf delivery
1086                        foreach my $pbvf (<$ENV{'PBROOTDIR'}/pbv*.pre>,<$ENV{'PBROOTDIR'}/pbv*.post>, <$ENV{'PBROOTDIR'}/pbtest*>) {
1087                                if (-x "$pbvf") {
1088                                        my $target = "$ENV{'PBDESTDIR'}/".basename($pbvf);
1089                                        pb_filter_file("$pbvf",$ptr,$target,$pb);
1090                                        chmod 0755,"$target";
1091                                }
1092                        }
1093                } else {
1094                        # Instead call News generation
1095                        pb_web_news2html($dest);
1096                        # And create an empty pbconf
1097                        pb_mkdir_p("$dest/pbconf");
1098                        # And prepare the pbscript to execute remotely
1099                        open(SCRIPT,"> $ENV{'PBTMP'}/pbscript") || die "Unable to create $ENV{'PBTMP'}/pbscript";
1100                        print SCRIPT "#!/bin/bash\n";
1101                        print SCRIPT "#set -x\n";
1102                        print SCRIPT "echo ... Extracting Website content\n";
1103                        print SCRIPT "find . -type f | grep -Ev '^./$pbpkg-$pbver.tar.gz|^./pbscript' | xargs rm -f non-existent\n";
1104                        print SCRIPT "find * -type d -depth | xargs rmdir 2> /dev/null \n";
1105                        print SCRIPT "tar xfz $pbpkg-$pbver.tar.gz\n";
1106                        print SCRIPT "mv $pbpkg-$pbver/* .\n";
1107                        print SCRIPT "rm -f $pbpkg-$pbver.tar.gz\n";
1108                        print SCRIPT "rmdir $pbpkg-$pbver\n";
1109                        close(SCRIPT);
1110                        chmod 0755,"$ENV{'PBTMP'}/pbscript";
1111                }
1112
1113                # Prepare the dest directory for archive
1114                chdir "$ENV{'PBDESTDIR'}" || die "Unable to change dir to $ENV{'PBDESTDIR'}";
1115                if (defined $preserve) {
1116                        # In that case we want to preserve the original tar file for checksum purposes
1117                        # The one created is btw equivalent in that case to this one
1118                        # Maybe check basename of both to be sure they are the same ?
1119                        pb_log(0,"Preserving original tar file ");
1120                        move("$preserve","$pbpkg-$pbver.tar.gz");
1121                } else {
1122                        # Possibility to look at PBSRC to guess more the filename
1123                        pb_system("tar cfz $pbpkg-$pbver.tar.gz --exclude=$pbpkg-$pbver/pbconf $pbpkg-$pbver","Creating $pbpkg tar files compressed");
1124                }
1125                pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz\n");
1126                pb_system("tar cfz $pbpkg-$pbver.pbconf.tar.gz $pbpkg-$pbver/pbconf","Creating pbconf tar files compressed");
1127                pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz\n");
1128
1129                # Keep track of version-tag per pkg
1130                $pkgs{$pbpkg} = "$pbver-$pbtag";
1131
1132                # Final cleanup
1133                pb_rm_rf($dest) if (-d $dest);
1134        }
1135
1136        # Keep track of per package version
1137        pb_log(2,"DEBUG pkgs: ".Dumper(%pkgs)."\n");
1138        open(PKG,"> $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb") || die "Unable to create $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb";
1139        foreach my $pbpkg (keys %pkgs) {
1140                print PKG "pbpkg $pbpkg = $pkgs{$pbpkg}\n";
1141        }
1142        close(PKG);
1143
1144        # Keep track of what is generated by default
1145        # We need to store the dir and info on version-tag
1146        # Base our content on the existing .pb file
1147        copy("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb","$ENV{'PBDESTDIR'}/pbrc");
1148        open(LAST,">> $ENV{'PBDESTDIR'}/pbrc") || die "Unable to create $ENV{'PBDESTDIR'}/pbrc";
1149        print LAST "pbroot $ENV{'PBPROJ'} = $ENV{'PBROOTDIR'}\n";
1150        print LAST "projver $ENV{'PBPROJ'} = $ENV{'PBPROJVER'}\n";
1151        print LAST "projtag $ENV{'PBPROJ'} = $ENV{'PBPROJTAG'}\n";
1152        print LAST "pbpackager $ENV{'PBPROJ'} = $ENV{'PBPACKAGER'}\n";
1153        close(LAST);
1154}
1155
1156sub pb_test2pkg {
1157        # Get the running distro to test on
1158        my $pbos = pb_distro_get_context();
1159
1160        # Get list of packages to test
1161        # Get content saved in cms2build
1162        my $ptr = pb_get_pkg();
1163        @pkgs = @$ptr;
1164
1165        # Additional potential repo
1166        pb_distro_setuprepo($pbos);
1167        foreach my $pbpkg (@pkgs) {
1168                # We need to install the package to test, and deps brought with it
1169                pb_distro_installdeps(undef,$pbos,$pbpkg);
1170                pb_system("$ENV{'PBDESTDIR'}/pbtest","Launching test for $pbpkg","verbose");
1171        }
1172}
1173
1174sub pb_build2pkg {
1175
1176        # Get the running distro to build on
1177        my $pbos = pb_distro_get_context();
1178
1179        # If needed we may add repository to the build env
1180        pb_distro_setuprepo($pbos);
1181
1182        # Get list of packages to build
1183        my $ptr = pb_get_pkg();
1184        @pkgs = @$ptr;
1185
1186        # Get content saved in cms2build
1187        my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1188        $pkg = { } if (not defined $pkg);
1189
1190        chdir "$ENV{'PBBUILDDIR'}";
1191        my $made = ""; # pkgs made during build
1192        my $pm;
1193        $pm = new Parallel::ForkManager($pbparallel) if (defined $pbparallel);
1194
1195        # We need to communicate info back from the children if parallel so prepare a dir for that
1196        my $tmpd = "$ENV{'PBTMP'}/build.$$";
1197        pb_mkdir_p($tmpd) if (defined $pbparallel);
1198
1199        foreach my $pbpkg (@pkgs) {
1200                $pm->start and next if (defined $pbparallel);
1201
1202                my $vertag = $pkg->{$pbpkg};
1203                # get the version of the current package - maybe different
1204                ($pbver,$pbtag) = split(/-/,$vertag);
1205
1206                my $src="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz";
1207                my $src2="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
1208                pb_log(2,"Source file: $src\n");
1209                pb_log(2,"Pbconf file: $src2\n");
1210
1211                pb_log(2,"Working directory: $ENV{'PBBUILDDIR'}\n");
1212                if ($pbos->{'type'} eq "rpm") {
1213                        foreach my $d ('RPMS','SRPMS','SPECS','SOURCES','BUILD') {
1214                                if (! -d "$ENV{'PBBUILDDIR'}/$d") {
1215                                pb_mkdir_p("$ENV{'PBBUILDDIR'}/$d") || die "Please ensure that you can write into $ENV{'PBBUILDDIR'} to create $d\nchown the $ENV{'PBBUILDDIR'} directory to your uid";
1216                                }
1217                        }
1218
1219                        # Remove in case a previous link/file was there
1220                        unlink "$ENV{'PBBUILDDIR'}/SOURCES/".basename($src);
1221                        symlink "$src","$ENV{'PBBUILDDIR'}/SOURCES/".basename($src) || die "Unable to symlink $src in $ENV{'PBBUILDDIR'}/SOURCES";
1222                        # We need to first extract the spec file
1223                        my @specfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/","$ENV{'PBBUILDDIR'}/SPECS","spec");
1224
1225                        # We need to handle potential patches to upstream sources
1226                        pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbpatch/","$ENV{'PBBUILDDIR'}/SOURCES","patch");
1227
1228                        pb_log(2,"specfile: ".Dumper(\@specfile)."\n");
1229                        # set LANGUAGE to check for correct log messages
1230                        $ENV{'LANGUAGE'}="C";
1231                        # Older Redhat use _target_platform in %configure incorrectly
1232                        my $specialdef = "";
1233                        if (($pbos->{'name'} eq "redhat") || (($pbos->{'name'} eq "rhel") && ($pbos->{'version'} eq "2.1"))) {
1234                                $specialdef = "--define \'_target_platform \"\"\'";
1235                        }
1236
1237                        foreach my $f (@specfile) {
1238                                if ($f =~ /\.spec$/) {
1239                                        # This could cause an issue in // mode
1240                                        pb_distro_installdeps($f,$pbos);
1241                                        pb_system("rpmbuild $specialdef --define \"packager $ENV{'PBPACKAGER'}\" --define \"_topdir $ENV{'PBBUILDDIR'}\" -ba $f","Building package with $f under $ENV{'PBBUILDDIR'}","verbose");
1242                                        last;
1243                                }
1244                        }
1245                        # Get the name of the generated packages
1246                        open(LOG,"$ENV{'PBTMP'}/system.$$.log") || die "Unable to open $ENV{'PBTMP'}/system.$$.log";
1247                        while (<LOG>) {
1248                                chomp($_);
1249                                next if ($_ !~ /^Wrote:/);
1250                                s|.*/([S]*RPMS.*)|$1|;
1251                                $made .=" $_";
1252                        }
1253                        close(LOG);
1254
1255                } elsif ($pbos->{'type'} eq "deb") {
1256                        chdir "$ENV{'PBBUILDDIR'}" || die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1257                        pb_system("tar xfz $src","Extracting sources");
1258                        pb_system("tar xfz $src2","Extracting pbconf");
1259
1260                        chdir "$pbpkg-$pbver" || die "Unable to chdir to $pbpkg-$pbver";
1261                        pb_rm_rf("debian");
1262                        symlink "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}","debian" || die "Unable to symlink to pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
1263                        chmod 0755,"debian/rules";
1264
1265                        pb_distro_installdeps("debian/control",$pbos);
1266                        pb_system("dpkg-buildpackage -us -uc -rfakeroot","Building package","verbose");
1267                        # Get the name of the generated packages
1268                        open(LOG,"$ENV{'PBTMP'}/system.$$.log") || die "Unable to open $ENV{'PBTMP'}/system.$$.log";
1269                        while (<LOG>) {
1270                                chomp();
1271                                my $tmp = $_;
1272                                next if ($tmp !~ /^dpkg-deb.*:/);
1273                                $tmp =~ s|.*../(.*)_(.*).deb.*|$1|;
1274                                $made="$made $tmp.dsc $tmp.tar.gz $tmp"."_*.deb $tmp"."_*.changes";
1275                        }
1276                        close(LOG);
1277                } elsif ($pbos->{'type'} eq "ebuild") {
1278                        my @ebuildfile;
1279                        # For gentoo we need to take pb as subsystem name
1280                        # We put every apps here under sys-apps. hope it's correct
1281                        # We use pb's home dir in order to have a single OVERLAY line
1282                        my $tmpe = "$ENV{'HOME'}/portage/pb/sys-apps/$pbpkg";
1283                        pb_mkdir_p($tmpe) if (! -d "$tmpe");
1284                        pb_mkdir_p("$ENV{'HOME'}/portage/distfiles") if (! -d "$ENV{'HOME'}/portage/distfiles");
1285
1286                        # We need to first extract the ebuild file
1287                        @ebuildfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/","$tmpe","ebuild");
1288
1289                        # Prepare the build env for gentoo
1290                        my $found = 0;
1291                        my $pbbd = $ENV{'HOME'};
1292                        $pbbd =~ s|/|\\/|g;
1293                        if (-r "/etc/make.conf") {
1294                                open(MAKE,"/etc/make.conf");
1295                                while (<MAKE>) {
1296                                        $found = 1 if (/$pbbd\/portage/);
1297                                }
1298                                close(MAKE);
1299                        }
1300                        if ($found == 0) {
1301                                pb_system("sudo sh -c 'echo PORTDIR_OVERLAY=\"$ENV{'HOME'}/portage\" >> /etc/make.conf'");
1302                        }
1303                        #$found = 0;
1304                        #if (-r "/etc/portage/package.keywords") {
1305                        #open(KEYW,"/etc/portage/package.keywords");
1306                        #while (<KEYW>) {
1307                        #$found = 1 if (/portage\/pb/);
1308                        #}
1309                        #close(KEYW);
1310                        #}
1311                        #if ($found == 0) {
1312                        #pb_system("sudo sh -c \"echo portage/pb >> /etc/portage/package.keywords\"");
1313                        #}
1314
1315                        # Build
1316                        foreach my $f (@ebuildfile) {
1317                                if ($f =~ /\.ebuild$/) {
1318                                        pb_distro_installdeps($f,$pbos);
1319                                        move($f,"$tmpe/$pbpkg-$pbver.ebuild");
1320                                        pb_system("cd $tmpe ; ebuild $pbpkg-$pbver.ebuild clean ; ebuild $pbpkg-$pbver.ebuild digest ; ebuild $pbpkg-$pbver.ebuild package","verbose");
1321                                        # Now move it where pb expects it
1322                                        pb_mkdir_p("$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
1323                                        if ($pbtag =~ /^0\./) {
1324                                                # This is a test version
1325                                                my $ntag = $pbtag;
1326                                                $ntag =~ s/^0\.//;
1327                                                move("$tmpe/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver"."_p$ntag.ebuild");
1328                                                $made="$made portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver"."_p$ntag.ebuild";
1329                                        } else {
1330                                                move("$tmpe/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver-r$pbtag.ebuild");
1331                                                $made="$made portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver-r$pbtag.ebuild";
1332                                        }
1333                                }
1334                        }
1335
1336                } elsif ($pbos->{'type'} eq "tgz") {
1337                        # Slackware family
1338                        $made="$made $pbpkg/$pbpkg-$pbver-*-$pbtag.tgz";
1339
1340                        chdir "$ENV{'PBBUILDDIR'}" || die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1341                        pb_system("tar xfz $src","Extracting sources");
1342                        pb_system("tar xfz $src2","Extracting pbconf");
1343                        chdir "$pbpkg-$pbver" || die "Unable to chdir to $pbpkg-$pbver";
1344                        symlink "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}","install" || die "Unable to symlink to pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
1345                        if (-x "install/pbslack") {
1346                                pb_distro_installdeps("./install/pbslack",$pbos);
1347                                pb_system("./install/pbslack","Building software");
1348                                pb_system("sudo /sbin/makepkg -p -l y -c y $pbpkg","Packaging $pbpkg","verbose");
1349                        }
1350                } elsif ($pbos->{'type'} eq "pkg") {
1351                        # Solaris
1352                        $made="$made $pbpkg-$pbver-$pbtag.pkg.gz";
1353                        my $pkgdestdir="$ENV{'PBBUILDDIR'}/install";
1354
1355                        chdir "$ENV{'PBBUILDDIR'}" || die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1356                        # Will host resulting packages
1357                        pb_mkdir_p("$pbos->{'type'}");
1358                        pb_mkdir_p("$pkgdestdir/delivery");
1359                        pb_system("tar xfz $src","Extracting sources under $ENV{'PBBUILDDIR'}");
1360                        pb_system("tar xfz $src2","Extracting pbconf under $ENV{'PBBUILDDIR'}");
1361                        chdir "$pbpkg-$pbver" || die "Unable to chdir to $pbpkg-$pbver";
1362                        if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild") {
1363                                chmod 0755,"pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild";
1364                                # pkginfo file is mandatory
1365                                die "Unable to find pkginfo file in pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}" if (! -f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pkginfo");
1366                                # Build
1367                                pb_system("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild $pkgdestdir/delivery","Building software and installing under $pkgdestdir/delivery");
1368                                # Copy complementary files
1369                                if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/prototype") {
1370                                        copy("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/prototype", $pkgdestdir) 
1371                                } else {
1372                                        # No prototype provided, calculating it
1373                                        open(PROTO,"> $pkgdestdir/prototype") || die "Unable to create prototype file";
1374                                        print PROTO "i pkginfo\n";
1375                                        print PROTO "i depend\n" if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/depend");
1376                                        $ENV{'PBSOLDESTDIR'} = "$pkgdestdir/delivery";
1377                                        find(\&create_solaris_prototype, "$pkgdestdir/delivery");
1378                                }
1379                                copy("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/depend", $pkgdestdir) if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/depend");
1380                                copy("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pkginfo", $pkgdestdir);
1381                                pb_system("cd $pkgdestdir/delivery ; pkgmk -o -f ../prototype -r $pkgdestdir/delivery -d $ENV{'PBBUILDDIR'}/$pbos->{'type'}","Packaging $pbpkg","verbose");
1382                                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");
1383                                pb_system("cd $ENV{'PBBUILDDIR'} ;  gzip -9f $pbpkg-$pbver-$pbtag.pkg","Compressing $pbpkg-$pbver-$pbtag.pkg","verbose");
1384                        } else {
1385                                pb_log(0,"No pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild file found for $pbpkg-$pbver in \n");
1386                        }
1387                        chdir ".." || die "Unable to chdir to parent dir";
1388                        pb_system("rm -rf $pbpkg-$pbver $ENV{'PBBUILDDIR'}/$pbos->{'type'} $pkgdestdir", "Cleanup");
1389                } elsif ($pbos->{'type'} eq "hpux") {
1390                        # HP-UX
1391                        chdir "$ENV{'PBBUILDDIR'}" || die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1392                        pb_system("tar xfz $src","Extracting sources");
1393                        pb_system("tar xfz $src2","Extracting pbconf");
1394
1395                        chdir "$pbpkg-$pbver" || die "Unable to chdir to $pbpkg-$pbver";
1396                        pb_system("buildpackage ","Building package","verbose");
1397                        # Get the name of the generated packages
1398                        open(LOG,"$ENV{'PBTMP'}/system.$$.log") || die "Unable to open $ENV{'PBTMP'}/system.$$.log";
1399                        while (<LOG>) {
1400                                chomp();
1401                                my $tmp = $_;
1402                                next if ($tmp !~ /^SD BUILD.*:/);
1403                                $tmp =~ s|.*../(.*)_(.*).sd.*|$1|;
1404                                $made="$made $tmp"."_*.sd";
1405                        }
1406                        close(LOG);
1407                        $made="$made $pbpkg-$pbver-$pbtag.sd";
1408
1409                        pb_system("rm -rf $pbpkg-$pbver", "Cleanup");
1410                } else {
1411                        die "Unknown OS type format $pbos->{'type'}";
1412                }
1413                if (defined $pbparallel) {
1414                        # Communicate results back to parent
1415                        pb_set_content("$tmpd/$$",$made);
1416                        $pm->finish;
1417                }
1418        }
1419        if (defined $pbparallel) {
1420                # In the parent, we need to get the result from the children
1421                $pm->wait_all_children;
1422                foreach my $f (<$tmpd/*>) {
1423                        $made .= " ".pb_get_content($f);
1424                }
1425                pb_rm_rf($tmpd);
1426        }
1427
1428        # Find the appropriate check cmd/opts
1429        my ($chkcmd,$chkopt) = pb_distro_get_param($pbos,pb_conf_get_if("oschkcmd","oschkopt"));
1430
1431        # Packages check if needed
1432        if ($pbos->{'type'} eq "rpm") {
1433                if ((defined  $chkcmd) && (-x $chkcmd)) {
1434                        my $cmd = "$chkcmd";
1435                        $cmd .= " $chkopt" if (defined $chkopt);
1436                        $cmd .= " $made";
1437                        pb_system("$cmd","Checking validity of rpms with $chkcmd","verbose");
1438                }
1439                my $rpms ="";
1440                my $srpms ="";
1441                foreach my $f (split(/ /,$made)) {
1442                        $rpms .= "$ENV{'PBBUILDDIR'}/$f " if ($f =~ /^RPMS\//);
1443                        $srpms .= "$ENV{'PBBUILDDIR'}/$f " if ($f =~ /^SRPMS\//);
1444                }
1445                pb_log(0,"SRPM packages generated: $srpms\n");
1446                pb_log(0,"RPM packages generated: $rpms\n");
1447        } elsif ($pbos->{'type'} eq "deb") {
1448                my $made2 = "";
1449                foreach my $f (split(/ /,$made)) {
1450                        $made2 .= "../$f " if ($f =~ /\.deb$/);
1451                }
1452                if (-x $chkcmd) {
1453                        pb_system("$chkcmd $chkopt $made2","Checking validity of debs with $chkcmd","verbose");
1454                } else {
1455                        pb_log(0,"deb packages generated: $made2\n");
1456                }
1457        } else {
1458                pb_log(0,"No check done for $pbos->{'type'} yet\n");
1459                pb_log(0,"Packages generated: $made\n");
1460        }
1461
1462        # Keep track of what is generated so that we can get them back from VMs/RMs
1463        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'}";
1464        print KEEP "$made\n";
1465        close(KEEP);
1466}
1467
1468sub create_solaris_prototype {
1469
1470        my $uidgid = "bin bin";
1471        my $pkgdestdir = $ENV{'PBSOLDESTDIR'};
1472
1473        return if ($_ =~ /^$pkgdestdir$/);
1474        if (-d $_) {
1475                my $n = $File::Find::name;
1476                $n =~ s~$pkgdestdir/~~;
1477                print PROTO "d none $n 0755 $uidgid\n";
1478        } elsif (-x $_) {
1479                my $n = $File::Find::name;
1480                $n =~ s~$pkgdestdir/~~;
1481                print PROTO "f none $n 0755 $uidgid\n";
1482        } elsif (-f $_) {
1483                my $n = $File::Find::name;
1484                $n =~ s~$pkgdestdir/~~;
1485                print PROTO "f none $n 0644 $uidgid\n";
1486        }
1487}
1488
1489sub pb_build2ssh {
1490        pb_send2target("Sources");
1491}
1492
1493sub pb_pkg2ssh {
1494        pb_send2target("Packages");
1495}
1496
1497# By default deliver to the the public site hosting the
1498# ftp structure (or whatever) or a VM/VE/RM
1499sub pb_send2target {
1500
1501        my $cmt = shift;
1502        my $v = shift || undef;
1503        my $vmexist = shift || 0;                       # 0 is FALSE
1504        my $vmpid = shift || 0;                         # 0 is FALSE
1505        my $snapme = shift || 0;                        # 0 is FALSE
1506
1507        pb_log(2,"DEBUG: pb_send2target($cmt,".Dumper($v).",$vmexist,$vmpid)\n");
1508        my $host = "sshhost";
1509        my $login = "sshlogin";
1510        my $dir = "sshdir";
1511        my $port = "sshport";
1512        my $conf = "sshconf";
1513        my $tmout = undef;
1514        my $path = undef;
1515        if ($cmt =~ /^VM/) {
1516                $login = "vmlogin";
1517                $dir = "pbdefdir";
1518                # Specific VM
1519                $tmout = "vmtmout";
1520                $path = "vmpath";
1521                $host = "vmhost";
1522                $port = "vmport";
1523        } elsif ($cmt =~ /^RM/) {
1524                $login = "rmlogin";
1525                $dir = "pbdefdir";
1526                # Specific RM
1527                $tmout = "rmtmout";
1528                $path = "rmpath";
1529                $host = "rmhost";
1530                $port = "rmport";
1531        } elsif ($cmt =~ /^VE/) {
1532                $login = "velogin";
1533                $dir = "pbdefdir";
1534                # Specific VE
1535                $path = "vepath";
1536                $conf = "rbsconf";
1537        } elsif ($cmt eq "Web") {
1538                $host = "websshhost";
1539                $login = "websshlogin";
1540                $dir = "websshdir";
1541                $port = "websshport";
1542        }
1543        my $cmd = "";
1544        my $src = "";
1545        my $pbos;
1546
1547        if ($cmt ne "Announce") {
1548                # Get list of packages to build
1549                my $ptr = pb_get_pkg();
1550                @pkgs = @$ptr;
1551
1552                # Get the running distro to consider
1553                $pbos = pb_distro_get_context($v);
1554
1555                # Get list of packages to build
1556                # Get content saved in cms2build
1557                my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1558                $pkg = { } if (not defined $pkg);
1559
1560                chdir "$ENV{'PBBUILDDIR'}";
1561                foreach my $pbpkg (@pkgs) {
1562                        my $vertag = $pkg->{$pbpkg};
1563                        # get the version of the current package - maybe different
1564                        ($pbver,$pbtag) = split(/-/,$vertag);
1565
1566                        if (($cmt eq "Sources") || ($cmt =~ /(V[EM]|RM)build/)) {
1567                                $src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
1568                                if ($cmd eq "") {
1569                                        $cmd = "ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
1570                                } else {
1571                                        $cmd = "$cmd ; ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
1572                                }
1573                        } elsif ($cmt eq "Web") {
1574                                $src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz"
1575                        }
1576                }
1577                # Adds conf file for availability of conf elements
1578                pb_conf_add("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb");
1579        }
1580
1581        if ($cmt =~ /(V[EM]|RM)build/) {
1582                $src="$src $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc $ENV{'PBDESTDIR'}/pbscript.$$";
1583        } elsif ($cmt =~ /(V[EM]|RM)Script/) {
1584                $src="$src $ENV{'PBDESTDIR'}/pbscript.$$";
1585        } elsif ($cmt =~ /(V[EM]|RM)test/) {
1586                $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";
1587        } elsif (($cmt eq "Announce") || ($cmt eq "Web")) {
1588                $src="$src $ENV{'PBTMP'}/pbscript";
1589        } elsif ($cmt eq "Packages") {
1590                # Get package list from file made during build2pkg
1591                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'}";
1592                $src = <KEEP>;
1593                chomp($src);
1594                close(KEEP);
1595                $src="$src $ENV{'PBBUILDDIR'}/pbscript.$$";
1596        }
1597        # Remove potential leading spaces (cause problem with basename)
1598        $src =~ s/^ *//;
1599        my $basesrc = "";
1600        foreach my $i (split(/ +/,$src)) {
1601                $basesrc .= " ".basename($i);
1602        }
1603
1604        pb_log(0,"Sources handled ($cmt): $src\n");
1605        pb_log(2,"values: ".Dumper(($host,$login,$dir,$port,$tmout,$path,$conf))."\n");
1606        my ($sshhost,$sshlogin,$sshdir,$sshport) = pb_conf_get($host,$login,$dir,$port);
1607        # Not mandatory...
1608        my ($rbsconf,$testver,$delivery) = pb_conf_get_if($conf,"testver","delivery");
1609        $delivery->{$ENV{'PBPROJ'}} = "" if (not defined $delivery->{$ENV{'PBPROJ'}});
1610        my ($vtmout,$vepath);
1611        # ...Except those in virtual context
1612        if ($cmt =~ /^VE/) {
1613                ($vepath) = pb_conf_get($path);
1614        }
1615        if ($cmt =~ /^(V|R)M/) {
1616                ($vtmout) = pb_conf_get($tmout);
1617        }
1618        my $sshmachine = $sshhost->{$ENV{'PBPROJ'}};
1619        if ($cmt =~ /^RM/) {
1620                # In that case our real host is in the rmhost with the OS as key, not project as above
1621                $sshmachine = pb_distro_get_param($pbos,$sshhost);
1622        }
1623        pb_log(2,"ssh: ".Dumper(($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vepath,$rbsconf))."\n");
1624
1625        my $mac;
1626        if ($cmt !~ /^VE/) {
1627                $mac = "$sshlogin->{$ENV{'PBPROJ'}}\@$sshmachine";
1628                # Overwrite account value if passed as parameter
1629                $mac = "$pbaccount\@$sshmachine" if (defined $pbaccount);
1630                pb_log(2, "DEBUG: pbaccount: $pbaccount => mac: $mac\n") if (defined $pbaccount);
1631        } else {
1632                # VE
1633                # Overwrite account value if passed as parameter (typically for setup2v)
1634                $mac = $sshlogin->{$ENV{'PBPROJ'}};
1635                $mac = $pbaccount if (defined $pbaccount);
1636        }
1637
1638        my $tdir;
1639        my $bdir;
1640        if (($cmt eq "Sources") || ($cmt =~ /(V[EM]|RM)Script/)) {
1641                $tdir = "$sshdir->{$ENV{'PBPROJ'}}/$delivery->{$ENV{'PBPROJ'}}/src";
1642        } elsif ($cmt =~ /(V[EM]|RM)(build|test)/) {
1643                $tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/delivery";
1644                $bdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/build";
1645                # Remove a potential $ENV{'HOME'} as bdir should be relative to pb's home
1646                $bdir =~ s|\$ENV.+\}/||;
1647        } elsif ($cmt eq "Announce") {
1648                $tdir = "$sshdir->{$ENV{'PBPROJ'}}/$delivery->{$ENV{'PBPROJ'}}";
1649        } elsif ($cmt eq "Web") {
1650                $tdir = "$sshdir->{$ENV{'PBPROJ'}}/$delivery->{$ENV{'PBPROJ'}}";
1651        } elsif ($cmt eq "Packages") {
1652                if (($pbos->{'type'} eq "rpm") || ($pbos->{'type'} eq "pkg") || ($pbos->{'type'} eq "hpux") || ($pbos->{'type'} eq "tgz")) {
1653                        # put packages under an arch subdir
1654                        $tdir = "$sshdir->{$ENV{'PBPROJ'}}/$delivery->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}";
1655                } elsif (($pbos->{'type'} eq "deb") || ($pbos->{'type'} eq "ebuild")) {
1656                        # No need for an arch subdir
1657                        $tdir = "$sshdir->{$ENV{'PBPROJ'}}/$delivery->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}";
1658                } else {
1659                        die "Please teach the dev team where to deliver ($pbos->{'type'} type of packages\n";
1660                }
1661
1662                my $repodir = $tdir;
1663                $repodir =~ s|^$sshdir->{$ENV{'PBPROJ'}}/||;
1664
1665                my ($pbrepo) = pb_conf_get("pbrepo");
1666
1667                # Repository management
1668                open(PBS,"> $ENV{'PBBUILDDIR'}/pbscript.$$") || die "Unable to create $ENV{'PBBUILDDIR'}/pbscript.$$";
1669                if ($pbos->{'type'} eq "rpm") {
1670                        # Also make a pbscript to generate yum/urpmi bases
1671                        print PBS << "EOF";
1672#!/bin/bash
1673# Prepare a script to ease yum setup
1674cat > $ENV{'PBPROJ'}.repo << EOT
1675[$ENV{'PBPROJ'}]
1676name=$pbos->{'name'} $pbos->{'version'} $pbos->{'arch'} - $ENV{'PBPROJ'} Vanilla Packages
1677baseurl=$pbrepo->{$ENV{'PBPROJ'}}/$repodir
1678enabled=1
1679gpgcheck=0
1680EOT
1681chmod 644 $ENV{'PBPROJ'}.repo
1682
1683# Clean up old repo content
1684rm -rf headers/ repodata/
1685# Create yum repo
1686if [ -x /usr/bin/yum-arch ]; then
1687        yum-arch .
1688fi
1689# Create repodata
1690createrepo .
1691EOF
1692                        if ($pbos->{'family'} eq "md") {
1693                                # For Mandriva add urpmi management
1694                                print PBS << "EOF";
1695# Prepare a script to ease urpmi setup
1696cat > $ENV{'PBPROJ'}.addmedia << EOT
1697urpmi.addmedia $ENV{'PBPROJ'} $pbrepo->{$ENV{'PBPROJ'}}/$repodir with media_info/hdlist.cz
1698EOT
1699chmod 755 $ENV{'PBPROJ'}.addmedia
1700
1701# Clean up old repo content
1702rm -f hdlist.cz synthesis.hdlist.cz
1703# Create urpmi repo
1704genhdlist2 --clean .
1705if [ \$\? -ne 0 ]; then
1706        genhdlist .
1707fi
1708EOF
1709                        }
1710                        if ($pbos->{'name'} eq "fedora") {
1711                                # Extract the spec file to please Fedora maintainers :-(
1712                                print PBS << "EOF";
1713for p in $basesrc; do
1714        echo \$p | grep -q 'src.rpm'
1715        if [ \$\? -eq 0 ]; then
1716                rpm2cpio \$p | cpio -ivdum --quiet '*.spec'
1717        fi
1718done
1719EOF
1720                        }
1721                        if ($pbos->{'family'} eq "novell") {
1722                                # Add ymp scripts for one-click install on SuSE
1723                                print PBS << "EOF";
1724# Prepare a script to ease SuSE one-click install
1725# Cf: http://de.opensuse.org/1-Klick-Installation/ISV
1726#
1727cat > $ENV{'PBPROJ'}.ymp << EOT
1728<?xml version="1.0" encoding="utf-8"?>
1729<!-- vim: set sw=2 ts=2 ai et: -->
1730<metapackage xmlns:os="http://opensuse.org/Standards/One_Click_Install" xmlns="http://opensuse.org/Standards/One_Click_Install">
1731        <group><!-- The group of software, typically one for project-builder.org -->
1732                <name>$ENV{'PBPROJ'} Bundle</name> <!-- Name of the software group -->
1733                <summary>Software bundle for the $ENV{'PBPROJ'} project</summary> <!--This message is shown to the user and should describe the whole bundle -->
1734                <description>This is the summary of the $ENV{'PBPROJ'} Project
1735                     
1736                        Details are available on a per package basis below
1737
1738                </description><!--This is also shown to the user -->
1739                <remainSubscribed>false</remainSubscribed> <!-- Don't know what it mean -->
1740                <repositories><!-- List of needed repositories -->
1741                        <repository>
1742                                <name>$ENV{'PBPROJ'} Repository</name> <!-- Name of the repository  -->
1743                                <summary>This repository contains the $ENV{'PBPROJ'} project packages.</summary> <!-- Summary of the repository -->
1744                                <description>This repository contains the $ENV{'PBPROJ'} project packages.</description><!-- This description is shown to the user -->
1745                                <url>$pbrepo->{$ENV{'PBPROJ'}}/$repodir</url><!--URL of repository, which is added -->
1746                        </repository>
1747                </repositories>
1748                <software><!-- A List of packages, which should be added through the one-click-installation -->
1749EOT
1750for p in $basesrc; do
1751        sum=`rpm -q --qf '%{SUMMARY}' \$p`
1752        name=`rpm -q --qf '%{NAME}' \$p`
1753        desc=`rpm -q --qf '%{description}' \$p`
1754        cat >> $ENV{'PBPROJ'}.ymp << EOT
1755                        <item>
1756                                <name>\$name</name><!-- Name of the package, is shown to the user and used to identify the package at the repository -->
1757                                <summary>\$sum</summary> <!-- Summary of the package -->
1758                                <description>\$desc</description> <!-- Description, is shown to the user -->
1759                        </item>
1760EOT
1761done
1762cat >> $ENV{'PBPROJ'}.ymp << EOT
1763                </software>
1764        </group>
1765</metapackage>
1766EOT
1767chmod 644 $ENV{'PBPROJ'}.ymp
1768EOF
1769                        }
1770                } elsif ($pbos->{'type'} eq "deb") {
1771                        # Also make a pbscript to generate apt bases
1772                        # Cf: http://www.debian.org/doc/manuals/repository-howto/repository-howto.fr.html
1773                        # This dirname removes arch
1774                        my $rpd = dirname("$pbrepo->{$ENV{'PBPROJ'}}/$repodir");
1775                        # this one removes the ver
1776                        $rpd = dirname($rpd);
1777                        print PBS << "EOF";
1778#!/bin/bash
1779# Prepare a script to ease apt setup
1780cat > $ENV{'PBPROJ'}.sources.list << EOT
1781deb $rpd $pbos->{'version'} contrib
1782deb-src $rpd $pbos->{'version'} contrib
1783EOT
1784chmod 644 $ENV{'PBPROJ'}.sources.list
1785
1786# Up two levels to deal with the dist dir cross versions
1787cd ..
1788mkdir -p dists/$pbos->{'version'}/contrib/binary-$pbos->{'arch'} dists/$pbos->{'version'}/contrib/source
1789
1790# Prepare a script to create apt info file
1791# Reuse twice after
1792TMPD=`mktemp -d /tmp/pb.XXXXXXXXXX` || exit 1
1793mkdir -p \$TMPD
1794cat > \$TMPD/Release << EOT
1795Archive: unstable
1796Component: contrib
1797Origin: $ENV{'PBPROJ'}
1798Label: $ENV{'PBPROJ'} dev repository $pbrepo->{$ENV{'PBPROJ'}}
1799EOT
1800
1801echo "Creating Packages metadata ($pbos->{'arch'})"
1802dpkg-scanpackages -a$pbos->{'arch'} $pbos->{'version'} /dev/null | gzip -c9 > dists/$pbos->{'version'}/contrib/binary-$pbos->{'arch'}/Packages.gz
1803dpkg-scanpackages -a$pbos->{'arch'} $pbos->{'version'} /dev/null | bzip2 -c9 > dists/$pbos->{'version'}/contrib/binary-$pbos->{'arch'}/Packages.bz2
1804echo "Creating Contents metadata"
1805apt-ftparchive contents $pbos->{'version'} | gzip -c9 > dists/$pbos->{'version'}/Contents.gz
1806echo "Creating Release metadata ($pbos->{'arch'})"
1807cat \$TMPD/Release > dists/$pbos->{'version'}/contrib/binary-$pbos->{'arch'}/Release
1808echo "Architecture: $pbos->{'arch'}" >> dists/$pbos->{'version'}/contrib/binary-$pbos->{'arch'}/Release
1809echo "Creating Source metadata"
1810dpkg-scansources $pbos->{'version'} /dev/null | gzip -c9 > dists/$pbos->{'version'}/contrib/source/Sources.gz
1811cat \$TMPD/Release > dists/$pbos->{'version'}/contrib/source/Release
1812echo "Architecture: Source" >> dists/$pbos->{'version'}/contrib/source/Release
1813echo "Creating Release metadata"
1814apt-ftparchive release dists/$pbos->{'version'} > dists/$pbos->{'version'}/Release
1815rm -rf \$TMPD
1816EOF
1817                } elsif ($pbos->{'type'} eq "ebuild") {
1818                        # make a pbscript to generate links to latest version
1819                        print PBS << "EOF";
1820#!/bin/bash
1821# Prepare a script to create correct links
1822for p in $src; do
1823        echo \$p | grep -q '.ebuild'
1824        if [ \$\? -eq 0 ]; then
1825                j=`basename \$p`
1826                pp=`echo \$j | cut -d'-' -f1`
1827                ln -sf \$j \$pp.ebuild
1828        fi
1829done
1830EOF
1831                }
1832                close(PBS);
1833                chmod 0755,"$ENV{'PBBUILDDIR'}/pbscript.$$";
1834        } else {
1835                return;
1836        }
1837
1838        # Useless for VE
1839        my $nport = pb_get_port($sshport,$pbos,$cmt) if ($cmt !~ /^VE/);
1840
1841        # Remove a potential $ENV{'HOME'} as tdir should be relative to pb's home
1842        $tdir =~ s|\$ENV.+\}/||;
1843
1844        my $tm = undef;
1845        if ($cmt =~ /^(V|R)M/) {
1846                $tm = $vtmout->{$ENV{'PBPROJ'}};
1847        }
1848
1849        # ssh communication if not VE
1850        # should use a hash instead...
1851        my ($shcmd,$cpcmd,$cptarget,$cp2target);
1852        if ($cmt !~ /^VE/) {
1853                my $keyfile = pb_ssh_get(0);
1854                $shcmd = "ssh -i $keyfile -q -o UserKnownHostsFile=/dev/null -p $nport $mac";
1855                $cpcmd = "scp -i $keyfile -p -o UserKnownHostsFile=/dev/null -P $nport";
1856                $cptarget = "$mac:$tdir";
1857                if ($cmt =~ /^(V|R)Mbuild/) {
1858                        $cp2target = "$mac:$bdir";
1859                }
1860        } else {
1861                my $tp = $vepath->{$ENV{'PBPROJ'}};
1862                my $tpdir = "$tp/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}";
1863                my ($ptr) = pb_conf_get("vetype");
1864                my $vetype = $ptr->{$ENV{'PBPROJ'}};
1865                if ($vetype eq "chroot") {
1866                        $shcmd = "sudo /usr/sbin/chroot $tpdir /bin/su - $mac -c ";
1867                } elsif ($vetype eq "schroot") {
1868                        $shcmd = "schroot $tp -u $mac -- ";
1869                }
1870                $cpcmd = "sudo /bin/cp -r ";
1871                # We need to get the home dir of the target account to deliver in the right place
1872                open(PASS,"$tpdir/etc/passwd") || die "Unable to open $tpdir/etc/passwd";
1873                my $homedir = "";
1874                while (<PASS>) {
1875                        my ($c1,$c2,$c3,$c4,$c5,$c6,$c7) = split(/:/);
1876                        $homedir = $c6 if ($c1 =~ /^$mac$/);
1877                        pb_log(3,"Homedir: $homedir - account: $c6\n");
1878                }
1879                close(PASS);
1880                $cptarget = "$tpdir/$homedir/$tdir";
1881                if ($cmt eq "VEbuild") {
1882                        $cp2target = "$tpdir/$homedir/$bdir";
1883                }
1884                pb_log(2,"On VE using $cptarget as target dir to copy to\n");
1885        }
1886
1887        my $logres = "";
1888        # Do not touch when just announcing
1889        if ($cmt ne "Announce") {
1890                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");
1891        } else {
1892                $logres = "> ";
1893        }
1894        pb_system("cd $ENV{'PBBUILDDIR'} ; $cpcmd $src $cptarget 2> /dev/null","$cmt delivery in $cptarget");
1895
1896        # For VE we need to change the owner manually
1897        if ($cmt =~ /^VE/) {
1898                pb_system("$shcmd \"sudo chown -R $mac $tdir\"","Adapt owner in $tdir to $mac");
1899        }
1900
1901        # Use the right script name depending on context
1902        my $pbscript;
1903        if (($cmt =~ /^(V[EM]|RM)/) || ($cmt =~ /Packages/)){
1904                $pbscript = "pbscript.$$";
1905        } else {
1906                $pbscript = "pbscript";
1907        }
1908
1909        pb_system("$shcmd \"echo \'cd $tdir ; if [ -x $pbscript ]; then ./$pbscript; fi ; rm -f ./$pbscript\' | bash\"","Executing pbscript on $cptarget if needed","verbose");
1910        if ($cmt =~ /^(V[EM]|RM)build/) {
1911                # Get back info on pkg produced, compute their name and get them from the VM/RM
1912                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");
1913                # For VE we need to change the owner manually
1914                if ($cmt eq "VEbuild") {
1915                        pb_system("sudo chown $UID $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$","Adapt owner in $tdir to $UID");
1916                }
1917                if (not -f "$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$") {
1918                        pb_log(0,"Problem with VM/RM $v on $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$");
1919                } else {
1920                        open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$") || die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$";
1921                        my $src = <KEEP>;
1922                        chomp($src);
1923                        close(KEEP);
1924                        unlink("$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$");
1925
1926                        $src =~ s/^ *//;
1927                        pb_mkdir_p("$ENV{'PBBUILDDIR'}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}");
1928                        # Change pgben to make the next send2target happy
1929                        my $made = "";
1930       
1931                        # For VM/RM we don't want shell expansion to hapen locally but remotely
1932                        my $delim = '\'';
1933                        if ($cmt =~ /^VEbuild/) {
1934                                # For VE we need to support shell expansion locally
1935                                $delim = "";
1936                        }       
1937
1938                        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'}";
1939                        foreach my $p (split(/ +/,$src)) {
1940                                my $j = basename($p);
1941                                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'}");
1942                                $made="$made $pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/$j"; # if (($pbos->{'type'} ne "rpm") || ($j !~ /.src.rpm$/));
1943                        }
1944                        print KEEP "$made\n";
1945                        close(KEEP);
1946                        pb_system("$shcmd \"rm -rf $tdir $bdir\"","$cmt cleanup");
1947
1948                        # Sign packages locally
1949                        if ($pbos->{'type'} eq "rpm") {
1950                                #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");
1951                        } elsif ($pbos->{'type'} eq "deb") {
1952                                #pb_system("debsign $made","Signing DEB packages");
1953                        } else {
1954                                pb_log(0,"I don't know yet how to sign packages for type $pbos->{'type'}.\nPlease give feedback to dev team\n");
1955                        }
1956
1957                        # We want to send them to the ssh account so overwrite what has been done before
1958                        undef $pbaccount;
1959                        pb_log(2,"Before sending pkgs, vmexist: $vmexist, vmpid: $vmpid\n");
1960                        pb_send2target("Packages",$pbos->{'name'}."-".$pbos->{'version'}."-".$pbos->{'arch'},$vmexist,$vmpid);
1961                        pb_rm_rf("$ENV{'PBBUILDDIR'}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}");
1962                }
1963        }
1964        unlink("$ENV{'PBDESTDIR'}/pbscript.$$") if (($cmt =~ /^(V[ME]|RM)/) || ($cmt =~ /Packages/));
1965
1966        pb_log(2,"Before halt, vmexist: $vmexist, vmpid: $vmpid\n");
1967        if ((! $vmexist) && ($cmt =~ /^VM/)) {
1968                # If in setupvm then takes a snapshot just before halting
1969                if ($snapme != 0) {
1970                        my ($vmmonport,$vmtype) = pb_conf_get("vmmonport","vmtype");
1971                        # For monitoring control
1972                        if ((($vmtype->{$ENV{'PBPROJ'}}) eq "kvm") || (($vmtype->{$ENV{'PBPROJ'}}) eq "qemu")) {
1973                                eval
1974                                {
1975                                require Net::Telnet;
1976                                Net::Telnet->import();
1977                                };
1978                                if ($@) {
1979                                        # Net::Telnet not found
1980                                        pb_log(1,"ADVISE: Install Net::Telnet to benefit from monitoring control and snapshot feature.\nWARNING: No snapshot created");
1981                                } else {
1982                                        my $t = new Net::Telnet (Timeout => 120, Host => "localhost", Port => $vmmonport->{$ENV{'PBPROJ'}}) || die "Unable to dialog on the monitor";
1983                                        # move to monitor mode
1984                                        my @lines = $t->cmd("c");
1985                                        # Create a snapshot named pb
1986                                        @lines = $t->cmd("savevm pb");
1987                                        # Write the new status in the VM
1988                                        @lines = $t->cmd("commit all");
1989                                        # End
1990                                        @lines = $t->cmd("quit");
1991                                }
1992                        }
1993                }
1994                my $hoption = "-p";
1995                my $hpath = pb_distro_get_param($pbos,pb_conf_get("ospathcmd-halt"));
1996                # Solaris doesn't support -p of halt
1997                if ($pbos->{'type'} eq "pkg") {
1998                        $hoption = "" ;
1999                }
2000                pb_system("$shcmd \"sudo $hpath $hoption \"; sleep $tm ; echo \'if [ -d /proc/$vmpid ]; then kill -9 $vmpid; fi \' | bash ; sleep 10","VM $v halt (pid $vmpid)");
2001        }
2002        if (($cmt =~ /^VE/) && ($snapme != 0)) {
2003                my $tpdir = "$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}";
2004                pb_system("sudo tar cz -C $tpdir -f $vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}.tar.gz .","Creating a snapshot of $tpdir");
2005        }
2006}
2007
2008sub pb_script2v {
2009        my $pbscript=shift;
2010        my $vtype=shift;
2011        my $pbforce=shift || 0; # Force stop of VM. Default not.
2012        my $vm1=shift || undef; # Only that VM/VE/RM to treat. Default all.
2013        my $snapme=shift || 0;  # Do we have to create a snapshot. Default not.
2014        my $vm;
2015        my $all;
2016
2017        pb_log(2,"DEBUG: pb_script2v($pbscript,$vtype,$pbforce,".Dumper($vm1).",$snapme)\n");
2018        # Prepare the script to be executed on the VM/VE/RM
2019        # in $ENV{'PBDESTDIR'}/pbscript.$$
2020        if ((defined $pbscript ) && ($pbscript ne "$ENV{'PBDESTDIR'}/pbscript.$$")) {
2021                copy($pbscript,"$ENV{'PBDESTDIR'}/pbscript.$$") || die "Unable to create $ENV{'PBDESTDIR'}/pbscript.$$";
2022                chmod 0755,"$ENV{'PBDESTDIR'}/pbscript.$$";
2023        }
2024
2025        if (not defined $vm1) {
2026                ($vm,$all) = pb_get2v($vtype);
2027        } else {
2028                @$vm = ($vm1);
2029        }
2030        my ($vmexist,$vmpid) = (undef,undef);
2031
2032        foreach my $v (@$vm) {
2033                # Launch VM/VE
2034                ($vmexist,$vmpid) = pb_launchv($vtype,$v,0,$snapme,$pbsnap);
2035
2036                if ($vtype eq "vm") {
2037                        pb_log(2,"DEBUG: After pb_launchv, vmexist: $vmexist, vmpid: $vmpid\n");
2038
2039                        # Skip that VM/RM if something went wrong
2040                        next if (($vmpid == 0) && ($vmexist == 0));
2041
2042                        # If force stopping the VM then reset vmexist
2043                        if ($pbforce == 1) {
2044                                $vmpid = $vmexist;
2045                                $vmexist = 0;
2046                        }
2047                } else {
2048                        #VE
2049                        $vmexist = 0;
2050                        $vmpid = 0;
2051                }
2052
2053                # Gather all required files to send them to the VM/VE/RM
2054                # and launch the build through pbscript
2055                pb_log(2,"DEBUG: Before send2target, vmexist: $vmexist, vmpid: $vmpid\n");
2056                pb_send2target(uc($vtype)."Script","$v",$vmexist,$vmpid,$snapme);
2057
2058        }
2059}
2060
2061sub pb_launchv {
2062        my $vtype = shift;
2063        my $v = shift;
2064        my $create = shift || 0;                # By default do not create a VM/VE/RM
2065        my $snapme = shift || 0;                # By default do not snap a VM/VE/RM
2066        my $usesnap = shift || 1;               # By default study the usage of the snapshot feature of VM/VE/RM
2067
2068        # If creation or snapshot creation mode, no snapshot usable
2069        if (($create == 1) || ($snapme == 1)) {
2070                $usesnap = 0;
2071        }
2072
2073        pb_log(2,"DEBUG: pb_launchv($vtype,$v,$create,$snapme,$usesnap)\n");
2074        die "No VM/VE/RM defined, unable to launch" if (not defined $v);
2075        # Keep only the first VM in case many were given
2076        $v =~ s/,.*//;
2077
2078        my $pbos = pb_distro_get_context($v);
2079        my $arch = pb_get_arch();
2080
2081        # Launch the VMs/VEs
2082        if ($vtype eq "vm") {
2083                die "-i iso parameter needed" if (((not defined $iso) || ($iso eq "")) && ($create != 0));
2084
2085                # TODO: vmmonport should be optional
2086                my ($ptr,$ptr2,$vmpath,$vmport,$vmsize,$vmmonport) = pb_conf_get("vmtype","vmcmd","vmpath","vmport","vmsize","vmmonport");
2087                my ($vmopt,$vmmem,$vmtmout,$vmsnap,$vmbuildtm) = pb_conf_get_if("vmopt","vmmem","vmtmout","vmsnap","vmbuildtm");
2088
2089                my $vmtype = $ptr->{$ENV{'PBPROJ'}};
2090                my $vmcmd = $ptr2->{$ENV{'PBPROJ'}};
2091
2092                if (defined $opts{'g'}) {
2093                        if (($vmtype eq "kvm") || ($vmtype eq "qemu")) {
2094                                $ENV{'PBVMOPT'} = "--nographic";
2095                        }
2096                }
2097                if (not defined $ENV{'PBVMOPT'}) {
2098                        $ENV{'PBVMOPT'} = "";
2099                }
2100                # Save the current status for later restoration
2101                $ENV{'PBOLDVMOPT'} = $ENV{'PBVMOPT'};
2102                # Set a default timeout of 2 minutes
2103                if (not defined $ENV{'PBVMTMOUT'}) {
2104                        $ENV{'PBVMTMOUT'} = "120";
2105                }
2106                if (defined $vmopt->{$v}) {
2107                        $ENV{'PBVMOPT'} .= " $vmopt->{$v}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$v}/);
2108                } elsif (defined $vmopt->{$ENV{'PBPROJ'}}) {
2109                        $ENV{'PBVMOPT'} .= " $vmopt->{$ENV{'PBPROJ'}}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$ENV{'PBPROJ'}}/);
2110                }
2111
2112                # How much memory to allocate for VMs
2113                if (defined $vmmem->{$v}) {
2114                        $ENV{'PBVMOPT'} .= " -m $vmmem->{$v}";
2115                } elsif (defined $vmmem->{$ENV{'PBPROJ'}}) {
2116                        $ENV{'PBVMOPT'} .= " -m $vmmem->{$ENV{'PBPROJ'}}";
2117                }
2118
2119                # Are we allowed to use snapshot feature
2120                if ($usesnap == 1) {
2121                        if ((defined $vmsnap->{$v}) && ($vmsnap->{$v} =~ /true/i)) {
2122                                $ENV{'PBVMOPT'} .= " -snapshot";
2123                        } elsif ((defined $vmsnap->{$ENV{'PBPROJ'}}) && ($vmsnap->{$ENV{'PBPROJ'}} =~ /true/i)) {
2124                                $ENV{'PBVMOPT'} .= " -snapshot";
2125                        } elsif ($pbsnap eq 1) {
2126                                $ENV{'PBVMOPT'} .= " -snapshot";
2127                        }
2128                } 
2129                if ($snapme != 0) {
2130                        if (($vmtype eq "kvm") || ($vmtype eq "qemu")) {
2131                                # Configure the monitoring to automate the creation of the 'pb' snapshot
2132                                $ENV{'PBVMOPT'} .= " -serial mon:telnet::$vmmonport->{$ENV{'PBPROJ'}},server,nowait";
2133                                # In that case no snapshot call needed
2134                                $ENV{'PBVMOPT'} =~ s/ -snapshot//;
2135                        }
2136                }
2137                if (defined $vmtmout->{$v}) {
2138                        $ENV{'PBVMTMOUT'} = $vmtmout->{$v};
2139                } elsif (defined $vmtmout->{$ENV{'PBPROJ'}}) {
2140                        $ENV{'PBVMTMOUT'} = $vmtmout->{$ENV{'PBPROJ'}};
2141                }
2142                my $nport = pb_get_port($vmport,$pbos,$vtype);
2143       
2144                my $cmd;
2145                my $vmm;                # has to be used for pb_check_ps
2146                if (($vmtype eq "qemu") || ($vmtype eq "kvm")) {
2147                        $vmm = "$vmpath->{$ENV{'PBPROJ'}}/$v.qemu";
2148                        if (($create != 0) || (defined $iso)) {
2149                                $ENV{'PBVMOPT'} .= " -cdrom $iso -boot d";
2150                        }
2151                        # Always redirect the network and always try to use a 'pb' snapshot
2152                        $cmd = "$vmcmd $ENV{'PBVMOPT'} -redir tcp:$nport:10.0.2.15:22 -loadvm pb $vmm"
2153                } elsif ($vmtype eq "xen") {
2154                } elsif ($vmtype eq "vmware") {
2155                } else {
2156                        die "VM of type $vmtype not supported. Report to the dev team";
2157                }
2158                # Restore the ENV VAR Value
2159                $ENV{'PBVMOPT'} = $ENV{'PBOLDVMOPT'};
2160
2161                my ($tmpcmd,$void) = split(/ +/,$cmd);
2162                my $vmexist = pb_check_ps($tmpcmd,$vmm);
2163                my $vmpid = 0;
2164                if (! $vmexist) {
2165                        if ($create != 0) {
2166                                die("Found an existing Virtual machine $vmm. Won't overwrite") if (-r $vmm);
2167                                if (($vmtype eq "qemu") || ($vmtype eq "xen") || ($vmtype eq "kvm")) {
2168                                        my $command = pb_check_req("qemu-img",0);
2169                                        pb_system("$command create -f qcow2 $vmm $vmsize->{$ENV{'PBPROJ'}}","Creating the QEMU VM");
2170                                } elsif ($vmtype eq "vmware") {
2171                                } else {
2172                                }
2173                        }
2174                        if (! -f "$vmm") {
2175                                pb_log(0,"Unable to find VM $vmm\n");
2176                        } else {
2177                                # Is the SSH port free? if not kill the existing process using it after a build timeout period
2178                                my $vmssh = pb_check_ps($tmpcmd,"tcp:$nport:10.0.2.15:22");
2179                                if ($vmssh) {
2180                                        my $buildtm = $ENV{'PBVMTMOUT'};
2181                                        if (defined $vmbuildtm->{$v}) {
2182                                                $buildtm = $vmbuildtm->{$v};
2183                                        } elsif (defined $vmbuildtm->{$ENV{'PBPROJ'}}) {
2184                                                $buildtm = $vmbuildtm->{$ENV{'PBPROJ'}};
2185                                        }
2186
2187                                        sleep $buildtm;
2188                                        pb_log(0,"WARNING: Killing the process ($vmssh) using port $nport (previous failed VM ?)\n");
2189                                        kill 15,$vmssh;
2190                                        # Let it time to exit
2191                                        sleep 5;
2192                                }
2193                                pb_system("$cmd &","Launching the VM $vmm");
2194                                # Using system allows to kill it externaly if needed
2195                                pb_system("sleep $ENV{'PBVMTMOUT'}","Waiting $ENV{'PBVMTMOUT'} s for VM $v to come up");
2196                                $vmpid = pb_check_ps($tmpcmd,$vmm);
2197                                pb_log(0,"VM $vmm launched (pid $vmpid)\n");
2198                        }
2199                } else {
2200                        pb_log(0,"Found an existing VM $vmm (pid $vmexist)\n");
2201                }
2202                pb_log(2,"DEBUG: pb_launchv returns ($vmexist,$vmpid)\n");
2203                return($vmexist,$vmpid);
2204        } elsif ($vtype eq "ve") {
2205                # VE here
2206                # Get distro context
2207                my $pbos = pb_distro_get_context($v);
2208
2209                # Get VE context
2210                my ($ptr,$vepath) = pb_conf_get("vetype","vepath");
2211                my $vetype = $ptr->{$ENV{'PBPROJ'}};
2212
2213                # We can probably only get those params now we have the distro context
2214                my ($rbsb4pi,$rbspi,$vesnap,$oscodename,$osmindep,$verebuild,$rbsmirrorsrv) = pb_conf_get_if("rbsb4pi","rbspi","vesnap","oscodename","osmindep","verebuild","rbsmirrorsrv");
2215
2216                # We need to avoid umask propagation to the VE
2217                umask 0022;
2218
2219                if (($vetype eq "chroot") || ($vetype eq "schroot")) {
2220                        # Architecture consistency
2221                        if ($arch ne $pbos->{'arch'}) {
2222                                die "Unable to launch a VE of architecture $pbos->{'arch'} on a $arch platform" if (($pbos->{'arch'} eq "x86_64") && ($arch =~ /i?86/));
2223                        }
2224
2225                        my ($verpmtype,$vedebtype) = pb_conf_get("verpmtype","vedebtype");
2226                        if (($create != 0) || ((defined $verebuild) && ($verebuild->{$ENV{'PBPROJ'}} =~ /true/i)) || ($pbforce == 1)) {
2227                                my ($rbsopt1) = pb_conf_get_if("rbsopt");
2228
2229                                # We have to rebuild the chroot
2230                                if ($pbos->{'type'} eq "rpm") {
2231
2232                                        # Which tool is used
2233                                        my $verpmstyle = $verpmtype->{$ENV{'PBPROJ'}};
2234
2235                                        # Get potential rbs option
2236                                        my $rbsopt = "";
2237                                        if (defined $rbsopt1) {
2238                                                if (defined $rbsopt1->{$verpmstyle}) {
2239                                                        $rbsopt = $rbsopt1->{$verpmstyle};
2240                                                } elsif (defined $rbsopt1->{$ENV{'PBPROJ'}}) {
2241                                                        $rbsopt = $rbsopt1->{$ENV{'PBPROJ'}};
2242                                                } else {
2243                                                        $rbsopt = "";
2244                                                }
2245                                        }
2246
2247                                        my $postinstall = pb_get_postinstall($pbos,$rbspi,$verpmstyle);
2248                                        if ($verpmstyle eq "rinse") {
2249                                                # Need to reshape the mirrors generated with local before-post-install script
2250                                                my $b4post = "--before-post-install ";
2251                                                my $postparam = pb_distro_get_param($pbos,$rbsb4pi);
2252                                                if ($postparam eq "") {
2253                                                        $b4post = "";
2254                                                } else {
2255                                                        $b4post .= $postparam;
2256                                                }
2257
2258                                                # Need to reshape the package list for pb
2259                                                my $addpkgs;
2260                                                $postparam = "";
2261                                                $postparam .= pb_distro_get_param($pbos,$osmindep);
2262                                                if ($postparam eq "") {
2263                                                        $addpkgs = "";
2264                                                } else {
2265                                                        my $pkgfile = "$ENV{'PBTMP'}/addpkgs.lis";
2266                                                        open(PKG,"> $pkgfile") || die "Unable to create $pkgfile";
2267                                                        foreach my $p (split(/,/,$postparam)) {
2268                                                                print PKG "$p\n";
2269                                                        }
2270                                                        close(PKG);
2271                                                        $addpkgs = "--add-pkg-list $pkgfile";
2272                                                }
2273
2274                                                my $rinseverb = "";
2275                                                $rinseverb = "--verbose" if ($pbdebug gt 0);
2276                                                my ($rbsconf) = pb_conf_get("rbsconf");
2277
2278                                                my $command = pb_check_req("rinse",0);
2279                                                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");
2280                                        } elsif ($verpmstyle eq "rpmbootstrap") {
2281                                                my $rbsverb = "";
2282                                                foreach my $i (1..$pbdebug) {
2283                                                        $rbsverb .= " -v";
2284                                                }
2285                                                my $addpkgs = "";
2286                                                my $postparam = "";
2287                                                $postparam .= pb_distro_get_param($pbos,$osmindep);
2288                                                if ($postparam eq "") {
2289                                                        $addpkgs = "";
2290                                                } else {
2291                                                        $addpkgs = "-a $postparam";
2292                                                }
2293                                                my $command = pb_check_req("rpmbootstrap",0);
2294                                                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");
2295                                        } elsif ($verpmstyle eq "mock") {
2296                                                my ($rbsconf) = pb_conf_get("rbsconf");
2297                                                my $command = pb_check_req("mock",0);
2298                                                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'})");
2299                                                # Once setup we need to install some packages, the pb account, ...
2300                                                pb_system("sudo $command --install --configdir=\"$rbsconf->{$ENV{'PBPROJ'}}\" -r $v su","Configuring the mock VE");
2301                                        } else {
2302                                                die "Unknown verpmtype type $verpmstyle. Report to dev team";
2303                                        }
2304                                } elsif ($pbos->{'type'} eq "deb") {
2305                                        my $vedebstyle = $vedebtype->{$ENV{'PBPROJ'}};
2306
2307                                        my $codename = pb_distro_get_param($pbos,$oscodename);
2308                                        my $postparam = "";
2309                                        my $addpkgs;
2310                                        $postparam .= pb_distro_get_param($pbos,$osmindep);
2311                                        if ($postparam eq "") {
2312                                                $addpkgs = "";
2313                                        } else {
2314                                                $addpkgs = "--include $postparam";
2315                                        }
2316                                        my $debmir = "";
2317                                        $debmir .= pb_distro_get_param($pbos,$rbsmirrorsrv);
2318
2319                                        # Get potential rbs option
2320                                        my $rbsopt = "";
2321                                        if (defined $rbsopt1) {
2322                                                if (defined $rbsopt1->{$vedebstyle}) {
2323                                                        $rbsopt = $rbsopt1->{$vedebstyle};
2324                                                } elsif (defined $rbsopt1->{$ENV{'PBPROJ'}}) {
2325                                                        $rbsopt = $rbsopt1->{$ENV{'PBPROJ'}};
2326                                                } else {
2327                                                        $rbsopt = "";
2328                                                }
2329                                        }
2330       
2331                                        # debootstrap works with amd64 not x86_64
2332                                        my $debarch = $pbos->{'arch'};
2333                                        $debarch = "amd64" if ($pbos->{'arch'} eq "x86_64");
2334                                        if ($vedebstyle eq "debootstrap") {
2335                                                my $dbsverb = "";
2336                                                $dbsverb = "--verbose" if ($pbdebug gt 0);
2337
2338                                                # Some perl modules are in Universe on Ubuntu
2339                                                $rbsopt .= " --components=main,universe" if ($pbos->{'name'} eq "ubuntu");
2340
2341                                                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");
2342                                                # debootstrap doesn't create an /etc/hosts file
2343                                                if (! -f "$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/etc/hosts" ) {
2344                                                        pb_system("sudo cp /etc/hosts $vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/etc/hosts");
2345                                                }
2346                                        } else {
2347                                                die "Unknown vedebtype type $vedebstyle. Report to dev team";
2348                                        }
2349                                } elsif ($pbos->{'type'} eq "ebuild") {
2350                                        die "Please teach the dev team how to build gentoo chroot";
2351                                } else {
2352                                        die "Unknown distribution type $pbos->{'type'}. Report to dev team";
2353                                }
2354                        }
2355                        # Fix modes to allow access to the VE for pb user
2356                        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");
2357
2358                        # Test if an existing snapshot exists and use it if appropriate
2359                        # And also use it of no local extracted VE is present
2360                        if ((-f "$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}.tar.gz") &&
2361                                (((defined $vesnap->{$v}) && ($vesnap->{$v} =~ /true/i)) ||
2362                                        ((defined $vesnap->{$ENV{'PBPROJ'}}) && ($vesnap->{$ENV{'PBPROJ'}} =~ /true/i)) ||
2363                                        ($pbsnap eq 1) ||
2364                                        (! -d "$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}"))) {
2365                                                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'}");
2366                        }
2367                        # Nothing more to do for VE. No real launch
2368                } else {
2369                        die "VE of type $vetype not supported. Report to the dev team";
2370                }
2371        } else {
2372                # RM here
2373                # Get distro context
2374                my $pbos = pb_distro_get_context($v);
2375
2376                # Get RM context
2377                my ($ptr,$rmpath) = pb_conf_get("rmtype","rmpath");
2378
2379                # Nothing more to do for RM. No real launch
2380                # For the moment we support the RM is already running
2381                # For ProLiant may be able to power them on if needed later on as an example.
2382        }
2383}
2384
2385# Return string for date synchro
2386sub pb_date2v {
2387
2388my $vtype = shift;
2389my $v = shift;
2390
2391my ($ntp) = pb_conf_get_if($vtype."ntp");
2392my $vntp = $ntp->{$ENV{'PBPROJ'}} if (defined $ntp);
2393my $ntpline;
2394
2395if (defined $vntp) {
2396        my ($ntpcmd) = pb_conf_get($vtype."ntpcmd");
2397        my $vntpcmd;
2398        if (defined $ntpcmd->{$v}) {
2399                $vntpcmd = $ntpcmd->{$v};
2400        } elsif (defined $ntpcmd->{$ENV{'PBPROJ'}}) {
2401                $vntpcmd = $ntpcmd->{$ENV{'PBPROJ'}};
2402        } else {
2403                $vntpcmd = "/bin/true";
2404        }
2405        $ntpline = "sudo $vntpcmd $vntp";
2406} else {
2407        $ntpline = undef;
2408}
2409# Force new date to be in the future compared to the date
2410# of the host by adding 1 minute
2411my @date=pb_get_date();
2412$date[1]++;
2413my $upddate = strftime("%m%d%H%M%Y", @date);
2414my $dateline = "sudo /bin/date $upddate";
2415if (defined $ntpline) {
2416        return($ntpline);
2417} else {
2418        return($dateline);
2419}
2420}
2421
2422sub pb_build2v {
2423
2424my $vtype = shift;
2425my $action = shift || "build";
2426
2427my ($v,$all) = pb_get2v($vtype);
2428
2429# Send tar files when we do a global generation
2430pb_build2ssh() if (($all == 1) && ($action eq "build"));
2431
2432# Adapt // mode to memory size
2433$pbparallel = pb_set_parallel($vtype);
2434
2435my ($vmexist,$vmpid) = (undef,undef);
2436my $pm;
2437if (defined $pbparallel) {
2438        $pm = new Parallel::ForkManager($pbparallel);
2439
2440        # Set which port the VM/RM will use to communicate
2441        $pm->run_on_start(\&pb_set_port);
2442}
2443
2444my $counter = 0;
2445foreach my $v (@$v) {
2446        $counter++;
2447        # Modulo 2 * pbparallel (to avoid synchronization problems)
2448        $counter = 1 if ((defined $pbparallel) && ($counter > 2 * $pbparallel));
2449        $pm->start($counter) and next if (defined $pbparallel);
2450        # Prepare the script to be executed on the VM/VE/RM
2451        # in $ENV{'PBDESTDIR'}/pbscript.$$
2452        open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript.$$") || die "Unable to create $ENV{'PBDESTDIR'}/pbscript.$$";
2453        print SCRIPT "#!/bin/bash\n";
2454
2455        # Transmit the verbosity level to the virtual env/mach.
2456        my $verbose = "";
2457        my $i = 0;                                                      # minimal debug level
2458        while ($i lt $pbdebug) {
2459                $verbose .= "-v ";
2460                $i++;
2461        }
2462        # Activate script verbosity if at least 2 for pbdebug
2463        print SCRIPT "set -x\n" if ($i gt 1);
2464        # Quiet if asked to be so on the original system
2465        $verbose = "-q" if ($pbdebug eq -1);
2466
2467        print SCRIPT "echo ... Execution needed\n";
2468        print SCRIPT "# This is in directory delivery\n";
2469        print SCRIPT "# Setup the variables required for building\n";
2470        print SCRIPT "export PBPROJ=$ENV{'PBPROJ'}\n";
2471
2472        if ($action eq "build") {
2473                print SCRIPT "# Preparation for pb\n";
2474                print SCRIPT "mv .pbrc \$HOME\n";
2475                print SCRIPT "cd ..\n";
2476        }
2477
2478        # VE needs a good /proc
2479        if ($vtype eq "ve") {
2480                print SCRIPT "sudo /bin/mount -t proc /proc /proc\n";
2481        }
2482
2483        my $ntpline = pb_date2v($vtype,$v);
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        # Deal with date sync.
2728        my $ntpline = pb_date2v($vtype,$v);
2729
2730        # Get distro context
2731        my $pbos = pb_distro_get_context($v);
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,$vmntp);
2776                ($vmhost,$vmport,$vmntp) = pb_conf_get($vtype."host",$vtype."port",$vtype."ntp");
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");
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"));
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        move("$dir/$f","$ddir") || die "Unable to move $dir/$f to $ddir";
3568        pb_log(2,"mv $dir/$f $ddir\n");
3569        push @files,"$ddir/$f";
3570}
3571closedir(DIR);
3572# Not enough but still a first cleanup
3573pb_rm_rf("$dir");
3574return(@files);
3575}
3576
3577sub pb_list_bfiles {
3578
3579my $dir = shift;
3580my $pbpkg = shift;
3581my $bfiles = shift;
3582my $pkgfiles = shift;
3583my $supfiles = shift;
3584
3585pb_log(2,"DEBUG: entering pb_list_bfiles: ".Dumper($bfiles)."\n");
3586opendir(BDIR,"$dir") || die "Unable to open dir $dir: $!";
3587foreach my $f (readdir(BDIR)) {
3588        next if ($f =~ /^\./);
3589        if (-d $f) {
3590                # Recurse for directories (Debian 3.0 format e.g.)
3591                pb_list_bfiles($f,$pbpkg,$bfiles,$pkgfiles,$supfiles);
3592                next;
3593        }
3594        $bfiles->{$f} = "$dir/$f";
3595        $bfiles->{$f} =~ s~$ENV{'PBROOTDIR'}~~;
3596        if (defined $supfiles->{$pbpkg}) {
3597                $pkgfiles->{$f} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
3598        }
3599}
3600closedir(BDIR);
3601pb_log(2,"DEBUG: exiting pb_list_bfiles: ".Dumper($bfiles)."\n");
3602}
3603
3604sub pb_add_coma {
3605
3606my $str = shift;
3607my $addstr = shift;
3608
3609$str .= "," if (defined $str);
3610$str .= $addstr;
3611return($str);
3612}
3613
3614sub pb_list_sfiles {
3615
3616my $sdir = shift;
3617my $ptr = shift;
3618my $pbos = shift;
3619my $extdir = shift;
3620
3621pb_log(2,"DEBUG: entering pb_list_sfiles: ".Dumper($ptr)."\n");
3622my $key = "$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
3623
3624# Prepare local sources for this distro - They are always applied first - May be a problem one day
3625# This function works for both patches and additional sources
3626foreach my $p (sort(<$sdir/*>)) {
3627        $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'}$/));
3628}
3629
3630# Prepare also remote sources to be included - Applied after the local ones
3631foreach my $p ("all","$pbos->{'os'}","$pbos->{'type'}","$pbos->{'family'}","$pbos->{'name'}","$pbos->{'name'}-$pbos->{'version'}","$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}") {
3632        my $f = "$extdir.".".$p";
3633        next if (not -f $f);
3634        if (not open(PATCH,$f)) {
3635                pb_display("Unable to open existing external source file content $f\n");
3636                next;
3637        }
3638        while (<PATCH>) {
3639                chomp();
3640                $ptr->{$key} = pb_add_coma($ptr->{$key},"$_");
3641        }
3642        close(PATCH);
3643}
3644pb_log(2,"DEBUG: exiting pb_list_sfiles: ".Dumper($ptr)."\n");
3645return($ptr);
3646}
3647       
3648#
3649# Return the list of packages we are working on in a non CMS action
3650#
3651sub pb_get_pkg {
3652
3653my @pkgs = ();
3654
3655my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
3656@pkgs = keys %$var;
3657
3658pb_log(0,"Packages: ".join(',',@pkgs)."\n");
3659return(\@pkgs);
3660}
3661
3662#
3663# Return the postinstall line if needed
3664#
3665
3666sub pb_get_postinstall {
3667
3668my $pbos = shift;
3669my $rbspi = shift;
3670my $vestyle = shift;
3671my $post = "";
3672
3673# Do we have a local post-install script
3674if ($vestyle eq "rinse") {
3675        $post = "--post-install ";
3676} elsif ($vestyle eq "rpmbootstrap") {
3677        $post = "-s ";
3678}
3679
3680my $postparam = pb_distro_get_param($pbos,$rbspi);
3681if ($postparam eq "") {
3682        $post = "";
3683} else {
3684        $post .= $postparam;
3685}
3686return($post);
3687}
3688
3689# Manages VM/RM SSH port communication
3690sub pb_get_port {
3691
3692my $port = shift;
3693my $pbos = shift;
3694my $cmt = shift;
3695my $nport;
3696
3697die "No port passed in parameter. Report to dev team\n" if (not defined $port);
3698# key is project on VM, but machine tuple for RM
3699if ($cmt =~ /^RM/i) {
3700        $nport = $port->{"$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}"};
3701} else {
3702        $nport = $port->{$ENV{'PBPROJ'}};
3703}
3704pb_log(2,"pb_get_port with $nport\n");
3705# Maybe a port was given as parameter so overwrite
3706$nport = "$pbport" if (defined $pbport);
3707# Maybe in // mode so use the env var set up as an offset to the base port, except when called from send2target for Packages
3708if ($cmt ne "Packages") {
3709        $nport += $ENV{'PBVMPORT'} if ((defined $pbparallel) && (defined $ENV{'PBVMPORT'}));
3710}
3711pb_log(2,"pb_get_port returns $nport\n");
3712return($nport);
3713}
3714
3715sub pb_set_port { 
3716               
3717my ($pid,$ident) = @_;
3718pb_log(2,"pb_set_port for VM ($pid), id $ident\n");
3719$ENV{'PBVMPORT'} = $ident;
3720pb_log(2,"pb_set_port sets PBVMPORT in env to $ENV{'PBVMPORT'}\n");
3721}
3722
3723sub pb_set_parallel {
3724
3725my $vtype = shift;
3726
3727pb_log(2,"pb_set_parallel vtype: $vtype\n");
3728# Take care of memory size if VM, parallel mode and more than 1 action
3729if ((defined $pbparallel) && ($pbparallel ne 1) && ($vtype eq "vm")) {
3730        eval
3731        {
3732                require Linux::SysInfo;
3733                Linux::SysInfo->import();
3734        };
3735        if ($@) {
3736                # Linux::SysInfo not found
3737                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");
3738        } else {
3739                # Using the memory size
3740                my $si = Linux::SysInfo::sysinfo();
3741                if (not defined $si) {
3742                        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");
3743                } else {
3744                        # Keep the number of VM whose memory can be allocated
3745                        my $ram = $si->{"totalram"}-$si->{"sharedram"}-$si->{"bufferram"};
3746                        my $ram2;
3747                        my ($vmmem) = pb_conf_get_if("vmmem");
3748
3749                        my $v = "default";
3750                        if ((defined $vmmem) and (defined $vmmem->{$v})) {
3751                                $ram2 = $vmmem->{$v};
3752                        } else {
3753                                # Default for KVM/QEMU
3754                                $ram2 = 128;
3755                        }
3756                        $pbparallel = sprintf("%d",$ram/$ram2);
3757                }
3758                pb_log(1,"Using $pbparallel processes at a time\n");
3759        }
3760}
3761pb_log(2,"pb_set_parallel returns: $pbparallel\n") if (defined $pbparallel);
3762return($pbparallel);
3763}
3764
3765sub pb_get_sudocmds { 
3766               
3767my $pbos = shift;
3768my %sudocmds;
3769
3770pb_log(2,"pb_get_sudocmds entering with lines:".Dumper(@_)."\n");
3771foreach my $c (split(/;/,$pbos->{'update'}),split(/;/,$pbos->{'install'}),@_) {
3772        pb_log(2,"pb_get_sudocmds analyses $c\n");
3773        next if ($c !~ /^\s*sudo/);
3774        # remove sudo and leading spaces
3775        $c =~ s/^\s*sudo\s+//;
3776        # keep only the command, not the params
3777        $c =~ s/([^\s]+)\s.*$/$1/;
3778        $sudocmds{$c} = "";
3779}
3780pb_log(2,"pb_get_sudocmds returns ".Dumper(keys %sudocmds)."\n");
3781return(keys %sudocmds);
3782}
3783
3784
37851;
Note: See TracBrowser for help on using the repository browser.