source: 0.12.7/pb/bin/pb @ 1926

Last change on this file since 1926 was 1926, checked in by bruno, 5 years ago

-Improves deb checkssh support again

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