source: devel/pb/bin/pb @ 1459

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