source: devel/pb/bin/pb @ 1298

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