source: devel/pb/bin/pb @ 1480

Last change on this file since 1480 was 1480, checked in by bruno, 7 years ago

r4694@localhost: bruno | 2012-04-19 00:23:38 +0200

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