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

Last change on this file since 2134 was 2134, checked in by Bruno Cornec, 5 years ago

Fix a Debian build issue

In case multiple control file exists in the debian directory, only the
first was used for dependency analysis, which wasn't working. Now fixed
by an analyze of all control files

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