source: devel/pb/bin/pb @ 1549

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