source: devel/pb/bin/pb @ 1554

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