source: devel/pb/bin/pb @ 1553

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