source: devel/pb/bin/pb @ 1432

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

r4556@localhost: bruno | 2012-03-08 22:31:12 +0100

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