source: ProjectBuilder/devel/pb/bin/pb @ 2150

Last change on this file since 2150 was 2150, checked in by Bruno Cornec, 4 years ago

The cidfile should be different for each container to avoid conflicts when launching multiple containers at the same time

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