source: devel/pb/bin/pb @ 1539

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