source: devel/pb/bin/pb @ 1425

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