source: devel/pb/bin/pb @ 1486

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