source: devel/pb/bin/pb @ 1560

Last change on this file since 1560 was 1560, checked in by bruno, 7 years ago

-pb project: Add Copyrights specified by HP Open Source Review Board (Eric Anderson)

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