source: devel/pb/bin/pb @ 1200

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