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

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

Adding function pb_filter_var_print to enhance pb as per #148

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