source: devel/pb/bin/pb @ 1393

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