source: devel/pb/bin/pb @ 1551

Last change on this file since 1551 was 1551, checked in by bruno, 7 years ago
  • pbdistrocheck: remove hack to have common library path and static ref to /usr/share/perl5. That should really be done in the build process if needed not in code (Bruno Cornec)
  • pb: Just create the /etc/sysconfig/network file on rpm based distro not being opensuse (where it is a directory) (Eric Andersson/Bruno? Cornec)
  • CMS.pm: drop log level down to 2 this is a pretty irrelevant log message. (Eric Andersson)
  • Property svn:executable set to *
File size: 145.6 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 (coma 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    # Get the running distro to build on
1377    my $pbos = pb_distro_get_context();
1378
1379    # If needed we may add repository to the build env
1380    pb_distro_setuprepo($pbos);
1381
1382    # Get list of packages to build
1383    my $ptr = pb_get_pkg();
1384    @pkgs = @$ptr;
1385
1386    # Get content saved in cms2build
1387    my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1388    $pkg = { } if (not defined $pkg);
1389    my $pbextdir = pb_get_extdir();
1390
1391    pb_mkdir_p("$ENV{'PBBUILDDIR'}") if (! -d "$ENV{'PBBUILDDIR'}");
1392    chdir "$ENV{'PBBUILDDIR'}" || die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1393    my $made = ""; # pkgs made during build
1394    my $pm;
1395    my $all_ok = 1;
1396
1397    if (defined $pbparallel) {
1398        $pm = new Parallel::ForkManager($pbparallel);
1399        $pm->run_on_finish(sub { my ($pid, $code, $id, $signal, $dump) = @_;
1400                                $all_ok = 0 unless (($code == 0) && ($signal == 0) && ($dump == 0)); });
1401    }
1402
1403    # We need to communicate info back from the children if parallel so prepare a dir for that
1404    my $tmpd = "$ENV{'PBTMP'}/build.$$";
1405    pb_mkdir_p($tmpd) if (defined $pbparallel);
1406
1407    foreach my $pbpkg (@pkgs) {
1408        $pm->start and next if (defined $pbparallel);
1409
1410        my $vertag = $pkg->{$pbpkg};
1411        pb_log(2,"Vertag: $vertag\n");
1412        # get the version of the current package - maybe different
1413        ($pbver,$pbtag) = split(/-/,$vertag);
1414
1415        my $src="$ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.tar.gz";
1416        my $src2="$ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.pbconf.tar.gz";
1417        pb_log(2,"Source file: $src\n");
1418        pb_log(2,"Pbconf file: $src2\n");
1419
1420        pb_log(2,"Working directory: $ENV{'PBBUILDDIR'}\n");
1421        if ($pbos->{'type'} eq "rpm") {
1422            foreach my $d ('RPMS','SRPMS','SPECS','SOURCES','BUILD') {
1423                if (! -d "$ENV{'PBBUILDDIR'}/$d") {
1424                    pb_mkdir_p("$ENV{'PBBUILDDIR'}/$d");
1425                }
1426            }
1427
1428            # Remove in case a previous link/file was there
1429            unlink "$ENV{'PBBUILDDIR'}/SOURCES/".basename($src);
1430            symlink "$src","$ENV{'PBBUILDDIR'}/SOURCES/".basename($src) || die "Unable to symlink $src in $ENV{'PBBUILDDIR'}/SOURCES";
1431            # We need to first extract the spec file
1432            my @specfile = pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/","$ENV{'PBBUILDDIR'}/SPECS","spec");
1433
1434            # We need to handle potential patches to upstream sources
1435            pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbpatch/","$ENV{'PBBUILDDIR'}/SOURCES","patch");
1436
1437            # We need to handle potential additional sources to upstream sources
1438            pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbsrc/","$ENV{'PBBUILDDIR'}/SOURCES","src");
1439
1440            pb_log(2,"specfile: ".Dumper(\@specfile)."\n");
1441            # set LANGUAGE to check for correct log messages
1442            $ENV{'LANGUAGE'}="C";
1443            # Older Redhat use _target_platform in %configure incorrectly
1444            my $specialdef = "";
1445            if (($pbos->{'name'} eq "redhat") || (($pbos->{'name'} eq "rhel") && ($pbos->{'version'} eq "2.1"))) {
1446                $specialdef = "--define \'_target_platform \"\"\'";
1447            }
1448
1449            foreach my $f (@specfile) {
1450                if ($f =~ /\.spec$/) {
1451                    # This could cause an issue in // mode
1452                    pb_distro_installdeps($f,$pbos);
1453                    pb_system("rpmbuild $specialdef --define \"packager $ENV{'PBPACKAGER'}\" --define \"_topdir $ENV{'PBBUILDDIR'}\" -ba $f","Building package with $f under $ENV{'PBBUILDDIR'}","verbose");
1454                    last;
1455                }
1456            }
1457            # Get the name of the generated packages
1458            open(LOG,"$ENV{'PBTMP'}/system.$$.log") || die "Unable to open $ENV{'PBTMP'}/system.$$.log";
1459            while (<LOG>) {
1460                chomp($_);
1461                next if ($_ !~ /^Wrote:/);
1462                s|.*/([S]*RPMS.*)|$1|;
1463                $made .=" $_";
1464            }
1465            close(LOG);
1466
1467        } elsif ($pbos->{'type'} eq "deb") {
1468            pb_system("tar xfz $src","Extracting sources");
1469            pb_system("tar xfz $src2","Extracting pbconf");
1470
1471            chdir "$pbpkg-$pbver$pbextdir" || die "Unable to chdir to $pbpkg-$pbver$pbextdir";
1472            pb_rm_rf("debian");
1473            my $confdir = "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
1474            die "Configuration directory $confdir is not a directory\nIs os description listed in your {ve,vm,rm}list values?" if (not -d $confdir);
1475            symlink "$confdir","debian" || die "Unable to symlink 'debian' to $confdir";
1476            chmod 0755,"debian/rules";
1477
1478            # We need to handle potential patches to upstream sources
1479            pb_mkdir_p("debian/patches");
1480            my @f = pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbpatch/","debian/patches","patch");
1481
1482            # By default we use format 1.0 - Cf man dpkg-source
1483            my $debsrcfmt = "1.0";
1484            my $debsrcfile = "debian/source/format";
1485            if (-f $debsrcfile) {
1486                $debsrcfmt = pb_get_content($debsrcfile);
1487            }
1488
1489            if ($debsrcfmt =~ /^3.*quilt/) {
1490                # If we use quilt to manage patches, we then setup the env correctly
1491                # as per http://pkg-perl.alioth.debian.org/howto/quilt.html
1492                # Generate Debian patch series for quilt
1493                open(SERIE,"> debian/patches/series") || die "Unable to write in debian/patches/series";
1494                $ENV{'QUILT_PATCHES'}="debian/patches";
1495            } else {
1496                # If we use dpatch to manage patches, we then setup the 00list file as well
1497                open(SERIE,"> debian/patches/00list") || die "Unable to write in debian/patches/00list";
1498            }
1499            foreach my $f (sort @f) {
1500                # Skip the script made to apply the patches to the Debian tree
1501                next if ($f =~ /pbapplypatch/);
1502                # We also need to uncompress them
1503                pb_system("gzip -d $f","","quiet");
1504                $f =~ s/\.gz$//;
1505                print SERIE "$f\n";
1506            }
1507            close(SERIE);
1508            if (@f) {
1509                # We have patches...
1510                my $patch_file = "debian/patches/pbapplypatch";
1511                if (($debsrcfmt =~ /^1.*/) && (-x $patch_file)) {
1512                    # In that case we need to apply the patches ourselves locally
1513                    pb_system("cat $patch_file","APPLY","verbose");
1514                    pb_system("$patch_file","Applying patches to $pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'} tree");
1515                }
1516                # ...so modify the name of files to be Debian compliant
1517                move("../$src","../$pbpkg-$pbver$pbextdir.orig.tar.gz");
1518            }
1519
1520            # We need to handle potential additional sources to upstream sources
1521            #pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbsrc/","$ENV{'PBBUILDDIR'}/debian","src");
1522
1523            pb_distro_installdeps("debian/control",$pbos);
1524            pb_system("dpkg-buildpackage -us -uc -rfakeroot","Building package","verbose");
1525            # Get the name of the generated packages
1526            open(LOG,"$ENV{'PBTMP'}/system.$$.log") || die "Unable to open $ENV{'PBTMP'}/system.$$.log";
1527            my $tmp = "";
1528            while (<LOG>) {
1529                chomp();
1530                next unless (/^dpkg-deb.*:\s+building\s+package\s+.*\s+in\s+\`\.\.\/(\S+)\'\./o);
1531                $tmp = $1;
1532                die "Missing file $tmp" if (not -f $tmp);
1533                $made = "$made $tmp";
1534            }
1535            close(LOG);
1536            open(CTRL,"debian/control") or die "Unable to open debian/control: $!";
1537            #$made="$made $tmp.dsc $tmp.tar.gz $tmp"."_*.deb $tmp"."_*.changes";
1538            while (<CTRL>) {
1539                next unless (/^Source: (\S+)/o);
1540                foreach my $glob (("$1\_*.changes", "$1\_*.dsc", "$1\_*.tar.gz")) {
1541                    my @file = glob($glob);
1542                    die "Missing file for $glob" unless @file > 0;
1543                    die "Too many files for $glob" if @file > 1;
1544                    die "Missing file $file[0]" if (not -f $file[0]);
1545                    $made .= " $file[0]";
1546                }
1547            }
1548            close(CTRL);
1549            pb_display_file("$ENV{'PBTMP'}/system.$$.log");
1550
1551            chdir ".." || die "Unable to chdir to parent dir";
1552            pb_rm_rf("$pbpkg-$pbver");
1553        } elsif ($pbos->{'type'} eq "ebuild") {
1554            my @ebuildfile;
1555            # For gentoo we need to take pb as subsystem name
1556            # We put every apps here under sys-apps. hope it's correct
1557            # We use pb's home dir in order to have a single OVERLAY line
1558            my $tmpe = "$ENV{'HOME'}/portage/pb/sys-apps/$pbpkg";
1559            pb_mkdir_p($tmpe) if (! -d "$tmpe");
1560            pb_mkdir_p("$ENV{'HOME'}/portage/distfiles") if (! -d "$ENV{'HOME'}/portage/distfiles");
1561
1562            # We need to first extract the ebuild file
1563            @ebuildfile = pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/","$tmpe","ebuild");
1564
1565            # Prepare the build env for gentoo
1566            my $found = 0;
1567            my $pbbd = $ENV{'HOME'};
1568            $pbbd =~ s|/|\\/|g;
1569            if (-r "/etc/make.conf") {
1570                open(MAKE,"/etc/make.conf");
1571                while (<MAKE>) {
1572                    $found = 1 if (/$pbbd\/portage/);
1573                }
1574                close(MAKE);
1575            }
1576            if ($found == 0) {
1577                pb_system("sudo sh -c 'echo PORTDIR_OVERLAY=\"$ENV{'HOME'}/portage\" >> /etc/make.conf'");
1578            }
1579            #$found = 0;
1580            #if (-r "/etc/portage/package.keywords") {
1581            #open(KEYW,"/etc/portage/package.keywords");
1582            #while (<KEYW>) {
1583            #$found = 1 if (/portage\/pb/);
1584            #}
1585            #close(KEYW);
1586            #}
1587            #if ($found == 0) {
1588            #pb_system("sudo sh -c \"echo portage/pb >> /etc/portage/package.keywords\"");
1589            #}
1590
1591            # Build
1592            foreach my $f (@ebuildfile) {
1593                if ($f =~ /\.ebuild$/) {
1594                    pb_distro_installdeps($f,$pbos);
1595                    move($f,"$tmpe/$pbpkg-$pbver.ebuild");
1596                    pb_system("cd $tmpe ; ebuild $pbpkg-$pbver.ebuild clean ; ebuild $pbpkg-$pbver.ebuild digest ; ebuild $pbpkg-$pbver.ebuild package","verbose");
1597                    # Now move it where pb expects it
1598                    pb_mkdir_p("$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
1599                    if ($pbtag eq 0) {
1600                        # This is assumed to be a test version
1601                        my $nver = substr($pbver,0,-14);
1602                        my $ntag = substr($pbver,-14);
1603                        my $ebtg = "portage/pb/sys-apps/$pbpkg/$pbpkg-$nver"."_p$ntag.ebuild";
1604                        move("$tmpe/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/$ebtg");
1605                        $made="$made $ebtg";
1606                    } else {
1607                        my $ebtg = "portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver-r$pbtag.ebuild";
1608                        move("$tmpe/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/$ebtg");
1609                        $made="$made $ebtg";
1610                    }
1611                }
1612            }
1613
1614        } elsif ($pbos->{'type'} eq "tgz") {
1615            # Slackware family
1616            $made="$made $pbpkg/$pbpkg-$pbver-*-$pbtag.tgz";
1617
1618            pb_system("tar xfz $src","Extracting sources");
1619            pb_system("tar xfz $src2","Extracting pbconf");
1620            chdir "$pbpkg-$pbver$pbextdir" || die "Unable to chdir to $pbpkg-$pbver$pbextdir";
1621            symlink "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}","install" || die "Unable to symlink to pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
1622            if (-x "install/pbslack") {
1623                pb_distro_installdeps("./install/pbslack",$pbos);
1624                pb_system("./install/pbslack","Building software");
1625                pb_system("sudo /sbin/makepkg -p -l y -c y $pbpkg","Packaging $pbpkg","verbose");
1626            }
1627            chdir ".." || die "Unable to chdir to parent dir";
1628            pb_rm_rf("$pbpkg-$pbver$pbextdir");
1629        } elsif ($pbos->{'type'} eq "pkg") {
1630            # Solaris
1631            $made="$made $pbpkg-$pbver-$pbtag.pkg.gz";
1632            my $pkgdestdir="$ENV{'PBBUILDDIR'}/install";
1633
1634            # Will host resulting packages
1635            pb_mkdir_p("$pbos->{'type'}");
1636            pb_mkdir_p("$pkgdestdir/delivery");
1637            pb_system("tar xfz $src","Extracting sources under $ENV{'PBBUILDDIR'}");
1638            pb_system("tar xfz $src2","Extracting pbconf under $ENV{'PBBUILDDIR'}");
1639            # We need to handle potential patches to upstream sources
1640            pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbpatch/","$ENV{'PBBUILDDIR'}","patch");
1641
1642            # We need to handle potential additional sources to upstream sources
1643            pb_extract_build_files($src2,"$pbpkg-$pbver$pbextdir/pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbsrc/","$ENV{'PBBUILDDIR'}","src");
1644
1645            chdir "$pbpkg-$pbver$pbextdir" || die "Unable to chdir to $pbpkg-$pbver$pbextdir";
1646            if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild") {
1647                chmod 0755,"pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild";
1648                # pkginfo file is mandatory
1649                die "Unable to find pkginfo file in pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}" if (! -f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pkginfo");
1650                # Build
1651                pb_system("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild $pkgdestdir/delivery","Building software and installing under $pkgdestdir/delivery");
1652                # Copy complementary files
1653                if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/prototype") {
1654                    copy("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/prototype", $pkgdestdir) 
1655                } else {
1656                    # No prototype provided, calculating it
1657                    open(PROTO,"> $pkgdestdir/prototype") || die "Unable to create prototype file";
1658                    print PROTO "i pkginfo\n";
1659                    print PROTO "i depend\n" if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/depend");
1660                    $ENV{'PBSOLDESTDIR'} = "$pkgdestdir/delivery";
1661                    find(\&create_solaris_prototype, "$pkgdestdir/delivery");
1662                }
1663                copy("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/depend", $pkgdestdir) if (-f "pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/depend");
1664                copy("pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pkginfo", $pkgdestdir);
1665                pb_system("cd $pkgdestdir/delivery ; pkgmk -o -f ../prototype -r $pkgdestdir/delivery -d $ENV{'PBBUILDDIR'}/$pbos->{'type'}","Packaging $pbpkg","verbose");
1666                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");
1667                pb_system("cd $ENV{'PBBUILDDIR'} ;  gzip -9f $pbpkg-$pbver-$pbtag.pkg","Compressing $pbpkg-$pbver-$pbtag.pkg","verbose");
1668            } else {
1669                pb_log(0,"No pbconf/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}/pbbuild file found for $pbpkg-$pbver in \n");
1670            }
1671            chdir ".." || die "Unable to chdir to parent dir";
1672            pb_rm_rf("$pbpkg-$pbver$pbextdir","$ENV{'PBBUILDDIR'}/$pbos->{'type'}","$pkgdestdir");
1673        } elsif ($pbos->{'type'} eq "hpux") {
1674            # HP-UX
1675            pb_system("tar xfz $src","Extracting sources");
1676            pb_system("tar xfz $src2","Extracting pbconf");
1677
1678            chdir "$pbpkg-$pbver$pbextdir" || die "Unable to chdir to $pbpkg-$pbver$pbextdir";
1679            pb_system("buildpackage ","Building package","verbose");
1680            # Get the name of the generated packages
1681            open(LOG,"$ENV{'PBTMP'}/system.$$.log") || die "Unable to open $ENV{'PBTMP'}/system.$$.log";
1682            while (<LOG>) {
1683                chomp();
1684                my $tmp = $_;
1685                next if ($tmp !~ /^SD BUILD.*:/);
1686                $tmp =~ s|.*../(.*)_(.*).sd.*|$1|;
1687                $made = "$made $tmp"."_*.sd";
1688            }
1689            close(LOG);
1690            $made="$made $pbpkg-$pbver-$pbtag.sd";
1691
1692            chdir ".." || die "Unable to chdir to parent dir";
1693            pb_rm_rf("$pbpkg-$pbver$pbextdir");
1694        } else {
1695            die "Unknown OS type format $pbos->{'type'}";
1696        }
1697        if (defined $pbparallel) {
1698            # Communicate results back to parent
1699            pb_set_content("$tmpd/$$",$made);
1700            $pm->finish;
1701        }
1702    }
1703    if (defined $pbparallel) {
1704        # In the parent, we need to get the result from the children
1705        $pm->wait_all_children;
1706        foreach my $f (<$tmpd/*>) {
1707            $made .= " ".pb_get_content($f);
1708        }
1709        die "Aborting, one or more of the children failed." if ((not $all_ok) && ($Global::pb_stop_on_error));
1710        pb_rm_rf($tmpd);
1711    }
1712
1713    # Sign packages
1714    pb_sign_pkgs($pbos,$made);
1715
1716    # Find the appropriate check cmd/opts
1717    my ($chkcmd,$chkopt) = pb_distro_get_param($pbos,pb_conf_get_if("oschkcmd","oschkopt"));
1718
1719    # Packages check if needed
1720    if ($pbos->{'type'} eq "rpm") {
1721        if ((defined  $chkcmd) && (-x $chkcmd)) {
1722            my $cmd = "$chkcmd";
1723            $cmd .= " $chkopt" if (defined $chkopt);
1724            $cmd .= " $made";
1725            my $ret = pb_system("$cmd","Checking validity of rpms with $chkcmd","verbose",1);
1726            pb_log(0,"ERROR: when checking packages validity\n") if ($ret ne 0);
1727        }
1728        my $rpms ="";
1729        my $srpms ="";
1730        foreach my $f (split(/ /,$made)) {
1731            $rpms .= "$ENV{'PBBUILDDIR'}/$f " if ($f =~ /^RPMS\//);
1732            $srpms .= "$ENV{'PBBUILDDIR'}/$f " if ($f =~ /^SRPMS\//);
1733        }
1734        pb_log(0,"SRPM packages generated: $srpms\n");
1735        pb_log(0,"RPM packages generated: $rpms\n");
1736    } elsif ($pbos->{'type'} eq "deb") {
1737        my $made2 = "";
1738        foreach my $f (split(/ /,$made)) {
1739            $made2 .= "$f " if ($f =~ /\.deb$/);
1740        }
1741        if (-x $chkcmd) {
1742            my $ret = pb_system("$chkcmd $chkopt $made2","Checking validity of debs with $chkcmd","verbose",1);
1743            pb_log(0,"ERROR: when checking packages validity\n") if ($ret ne 0);
1744        }
1745        pb_log(0,"deb packages generated: $made2\n");
1746    } else {
1747        pb_log(0,"No check done for $pbos->{'type'} yet\n");
1748        pb_log(0,"Packages generated: $made\n");
1749    }
1750
1751    # Keep track of what is generated so that we can get them back from VMs/RMs
1752    my $pbkeep = "$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}-$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
1753    open(KEEP,"> $pbkeep") || die "Unable to create $pbkeep: $!";
1754    print KEEP "$made\n";
1755    close(KEEP);
1756}
1757
1758sub create_solaris_prototype {
1759
1760    my $uidgid = "bin bin";
1761    my $pkgdestdir = $ENV{'PBSOLDESTDIR'};
1762
1763    return if ($_ =~ /^$pkgdestdir$/);
1764    if (-d $_) {
1765        my $n = $File::Find::name;
1766        $n =~ s~$pkgdestdir/~~;
1767        print PROTO "d none $n 0755 $uidgid\n";
1768    } elsif (-x $_) {
1769        my $n = $File::Find::name;
1770        $n =~ s~$pkgdestdir/~~;
1771        print PROTO "f none $n 0755 $uidgid\n";
1772    } elsif (-f $_) {
1773        my $n = $File::Find::name;
1774        $n =~ s~$pkgdestdir/~~;
1775        print PROTO "f none $n 0644 $uidgid\n";
1776    }
1777}
1778
1779sub pb_build2ssh {
1780    pb_send2target("Sources");
1781    pb_send2target("CPAN");
1782}
1783
1784sub pb_pkg2ssh {
1785    pb_send2target("Packages");
1786}
1787
1788# By default deliver to the the public site hosting the
1789# ftp structure (or whatever) or a VM/VE/RM
1790sub pb_send2target {
1791
1792    my $cmt = shift;
1793    my $v = shift || undef;
1794    my $vmexist = shift || 0;           # 0 is FALSE
1795    my $vmpid = shift || 0;             # 0 is FALSE
1796    my $snapme = shift || 0;            # 0 is FALSE
1797
1798    pb_log(2,"DEBUG: pb_send2target($cmt,".Dumper($v).",$vmexist,$vmpid)\n");
1799    my $host = "sshhost";
1800    my $login = "sshlogin";
1801    my $dir = "sshdir";
1802    my $port = "sshport";
1803    my $conf = "sshconf";
1804    my $tmout = undef;
1805    my $path = undef;
1806    if ($cmt =~ /^VM/) {
1807        $login = "vmlogin";
1808        $dir = "pbdefdir";
1809        # Specific VM
1810        $tmout = "vmtmout";
1811        $path = "vmpath";
1812        $host = "vmhost";
1813        $port = "vmport";
1814    } elsif ($cmt =~ /^RM/) {
1815        $login = "rmlogin";
1816        $dir = "pbdefdir";
1817        # Specific RM
1818        $tmout = "rmtmout";
1819        $path = "rmpath";
1820        $host = "rmhost";
1821        $port = "rmport";
1822    } elsif ($cmt =~ /^VE/) {
1823        $login = "velogin";
1824        $dir = "pbdefdir";
1825        # Specific VE
1826        $path = "vepath";
1827        $conf = "rbsconf";
1828    } elsif ($cmt eq "Web") {
1829        $host = "websshhost";
1830        $login = "websshlogin";
1831        $dir = "websshdir";
1832        $port = "websshport";
1833    } elsif ($cmt eq "CPAN") {
1834        $host = "cpanpause";
1835        $login = "";
1836        $dir = "cpandir";
1837        $port = "";
1838    }
1839    my $cmd = "";
1840    my $src = "";
1841    my $cpanpkg = 0;
1842    my $pbos;
1843
1844    my $pbextdir = pb_get_extdir();
1845
1846    if ($cmt ne "Announce") {
1847        # Get list of packages to build
1848        my $ptr = pb_get_pkg();
1849        @pkgs = @$ptr;
1850
1851        # Get the running distro to consider
1852        $pbos = pb_distro_get_context($v);
1853
1854        # Get content saved in cms2build
1855        my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1856        $pkg = { } if (not defined $pkg);
1857
1858        pb_mkdir_p("$ENV{'PBBUILDDIR'}") if (! -d "$ENV{'PBBUILDDIR'}");
1859        chdir "$ENV{'PBBUILDDIR'}" || die "Unable to chdir to $ENV{'PBBUILDDIR'}";
1860        foreach my $pbpkg (@pkgs) {
1861            my $vertag = $pkg->{$pbpkg};
1862            # get the version of the current package - maybe different
1863            pb_log(2,"Vertag: $vertag\n");
1864            ($pbver,$pbtag) = split(/-/,$vertag);
1865
1866            if (($cmt eq "Sources") || ($cmt =~ /(V[EM]|RM)build/)) {
1867                $src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.tar.gz $ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.pbconf.tar.gz";
1868                if ($cmd eq "") {
1869                    $cmd = "ln -sf $pbpkg-$pbver$pbextdir.tar.gz $pbpkg-latest.tar.gz";
1870                } else {
1871                    $cmd = "$cmd ; ln -sf $pbpkg-$pbver$pbextdir.tar.gz $pbpkg-latest.tar.gz";
1872                }
1873            } elsif ($cmt eq "Web") {
1874                $src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver$pbextdir.tar.gz"
1875            }
1876
1877            # Do we have one perl package
1878            my @nametype = pb_conf_get_if("namingtype");
1879            my $type = $nametype[0]->{$pbpkg};
1880            if ((defined $type) && ($type eq "perl")) {
1881                $cpanpkg = 1;
1882            }
1883        }
1884        # Adds conf file for availability of conf elements
1885        pb_conf_add("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb");
1886    }
1887    my ($rbsconf,$testver,$delivery) = pb_conf_get_if($conf,"testver","delivery");
1888    if ($cmt =~ /CPAN/) {
1889        # Do not deliver on Pause if this is a test version
1890        return if (not defined $testver);
1891        return if ($testver =~ /true/);
1892        # Do not deliver on Pause if this is not a perl package
1893        return if ($cpanpkg == 0);
1894    }
1895
1896    if ($cmt =~ /(V[EM]|RM)build/) {
1897        $src="$src $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc $ENV{'PBDESTDIR'}/pbscript.$$";
1898    } elsif ($cmt =~ /(V[EM]|RM)Script/) {
1899        $src="$src $ENV{'PBDESTDIR'}/pbscript.$$";
1900    } elsif ($cmt =~ /(V[EM]|RM)test/) {
1901        $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";
1902    } elsif (($cmt eq "Announce") || ($cmt eq "Web") || ($cmt eq "CPAN")) {
1903        $src="$src $ENV{'PBTMP'}/pbscript";
1904    } elsif ($cmt eq "Packages") {
1905        # Get package list from file made during build2pkg
1906        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'}";
1907        $src = <KEEP>;
1908        chomp($src);
1909        close(KEEP);
1910        $src = "$src $ENV{'PBBUILDDIR'}/pbscript.$$";
1911    }
1912    if (($cmt eq "Sources") || ($cmt eq "Packages") || ($cmt eq "CPAN")) {
1913        my ($pbpackager) = pb_conf_get("pbpackager");
1914        $ENV{'PBPACKAGER'} = $pbpackager->{$ENV{'PBPROJ'}};
1915        pb_log(0,"Exporting public key for $ENV{'PBPACKAGER'}\n");
1916        # Using pb_system is not working due to redirection below
1917        system("gpg --export -a \'$ENV{'PBPACKAGER'}\' > $ENV{'PBDESTDIR'}/$ENV{'PBPROJ'}.pubkey");
1918        chmod 0644,"$ENV{'PBDESTDIR'}/$ENV{'PBPROJ'}.pubkey";
1919        $src = "$src $ENV{'PBDESTDIR'}/$ENV{'PBPROJ'}.pubkey";
1920    }
1921    # Remove potential leading spaces (cause problem with basename)
1922    $src =~ s/^ *//;
1923    my $basesrc = "";
1924    foreach my $i (split(/ +/,$src)) {
1925        $basesrc .= " ".basename($i);
1926    }
1927
1928    pb_log(0,"Sources handled ($cmt): $src\n");
1929    pb_log(2,"values: ".Dumper(($host,$login,$dir,$port,$tmout,$path,$conf))."\n");
1930    my ($sshhost,$sshdir) = pb_conf_get($host,$dir);
1931    # Not mandatory...
1932    $delivery->{$ENV{'PBPROJ'}} = "" if (not defined $delivery->{$ENV{'PBPROJ'}});
1933    my ($sshlogin,$sshport) = pb_conf_get_if($login,$port);
1934    $sshport->{$ENV{PBPROJ}} = 22 unless (defined $sshport->{$ENV{PBPROJ}});
1935    $sshlogin->{$ENV{PBPROJ}} = getpwuid($UID) unless (defined $sshlogin->{$ENV{PBPROJ}});
1936    my ($vtmout,$vepath);
1937    # ...Except those in virtual context
1938    if ($cmt =~ /^VE/) {
1939        ($vepath) = pb_conf_get($path);
1940    }
1941    if ($cmt =~ /^(V|R)M/) {
1942        $vtmout = pb_distro_get_param($pbos,pb_conf_get_if($tmout));
1943    }
1944    my $remhost = $sshhost->{$ENV{'PBPROJ'}};
1945    my $remdir = $sshdir->{$ENV{'PBPROJ'}};
1946    if ($cmt =~ /^V[EM]|RM/) {
1947        # In that case our real host is in the xxhost with the OS as key, not project as above
1948        $remhost = pb_distro_get_param($pbos,$sshhost);
1949    }
1950    pb_log(2,"ssh: ".Dumper(($remhost,$sshlogin,$remdir,$sshport,$vepath,$rbsconf))."\n");
1951    pb_log(2,"ssh: ".Dumper($vtmout)."\n") if (defined $vtmout);
1952
1953    my $mac;
1954    if ($cmt !~ /^VE/) {
1955        $mac = "$sshlogin->{$ENV{'PBPROJ'}}\@$remhost";
1956        # Overwrite account value if passed as parameter
1957        $mac = "$pbaccount\@$remhost" if (defined $pbaccount);
1958        pb_log(2, "DEBUG: pbaccount: $pbaccount => mac: $mac\n") if (defined $pbaccount);
1959    } else {
1960        # VE
1961        # Overwrite account value if passed as parameter (typically for setup2v)
1962        $mac = $sshlogin->{$ENV{'PBPROJ'}};
1963        $mac = $pbaccount if (defined $pbaccount);
1964    }
1965
1966    my $tdir;
1967    my $bdir;
1968    if (($cmt eq "Sources") || ($cmt =~ /(V[EM]|RM)Script/)) {
1969        $tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}/src";
1970    } elsif ($cmt eq "CPAN") {
1971        $tdir = "$remdir";
1972    } elsif ($cmt =~ /(V[EM]|RM)(build|test)/) {
1973        $tdir = $remdir."/$ENV{'PBPROJ'}/delivery";
1974        $bdir = $remdir."/$ENV{'PBPROJ'}/build";
1975        # Remove a potential $ENV{'HOME'} as bdir should be relative to pb's home
1976        $bdir =~ s|\$ENV.+\}/||;
1977    } elsif ($cmt eq "Announce") {
1978        $tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}";
1979    } elsif ($cmt eq "Web") {
1980        $tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}";
1981    } elsif ($cmt eq "Packages") {
1982        if (($pbos->{'type'} eq "rpm") || ($pbos->{'type'} eq "pkg") || ($pbos->{'type'} eq "hpux") || ($pbos->{'type'} eq "tgz")) {
1983            # put packages under an arch subdir
1984            $tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}";
1985        } elsif (($pbos->{'type'} eq "deb") || ($pbos->{'type'} eq "ebuild")) {
1986            # No need for an arch subdir
1987            $tdir = "$remdir/$delivery->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}";
1988        } else {
1989            die "Please teach the dev team where to deliver ($pbos->{'type'} type of packages\n";
1990        }
1991
1992        my $repodir = $tdir;
1993        $repodir =~ s|^$remdir/||;
1994
1995        my ($pbrepo) = pb_conf_get("pbrepo");
1996
1997        # Repository management
1998        open(PBS,"> $ENV{'PBBUILDDIR'}/pbscript.$$") || die "Unable to create $ENV{'PBBUILDDIR'}/pbscript.$$";
1999        if ($pbos->{'type'} eq "rpm") {
2000            my $pbsha = pb_distro_get_param($pbos,pb_conf_get("ossha"));
2001            # Also make a pbscript to generate yum/urpmi bases
2002            print PBS << "EOF";
2003#!/bin/bash
2004# Prepare a script to ease yum setup
2005EOF
2006            print PBS "set -x\n" if ($pbdebug gt 1);
2007            print PBS << "EOF";
2008cat > $ENV{'PBPROJ'}.repo << EOT
2009[$ENV{'PBPROJ'}]
2010name=$pbos->{'name'} $pbos->{'version'} $pbos->{'arch'} - $ENV{'PBPROJ'} Vanilla Packages
2011baseurl=$pbrepo->{$ENV{'PBPROJ'}}/$repodir
2012enabled=1
2013gpgcheck=1
2014gpgkey=$pbrepo->{$ENV{'PBPROJ'}}/$repodir/$ENV{'PBPROJ'}.pubkey
2015EOT
2016chmod 644 $ENV{'PBPROJ'}.repo
2017
2018# Clean up old repo content
2019rm -rf headers/ repodata/
2020# Create yum repo
2021if [ -x /usr/bin/yum-arch ]; then
2022    yum-arch .
2023fi
2024# Create repodata
2025createrepo -s $pbsha .
2026# Link to the key
2027(cd repodata ; ln -sf ../$ENV{'PBPROJ'}.pubkey repomd.xml.key)
2028# sign the repomd (at least useful for SLES - which requires a local key)
2029# gpg -a --detach-sign repodata/repomd.xml
2030# SLES also looks for media.1/info.txt
2031EOF
2032            if ($pbos->{'family'} eq "md") {
2033                # For Mandriva add urpmi management
2034                print PBS << "EOF";
2035# Prepare a script to ease urpmi setup
2036cat > $ENV{'PBPROJ'}.addmedia << EOT
2037urpmi.addmedia $ENV{'PBPROJ'} $pbrepo->{$ENV{'PBPROJ'}}/$repodir with media_info/hdlist.cz
2038EOT
2039chmod 755 $ENV{'PBPROJ'}.addmedia
2040
2041# Clean up old repo content
2042rm -f hdlist.cz synthesis.hdlist.cz
2043# Create urpmi repo
2044genhdlist2 --clean .
2045if [ \$\? -ne 0 ]; then
2046    genhdlist .
2047fi
2048EOF
2049            }
2050            if ($pbos->{'name'} eq "fedora") {
2051                # Extract the spec file to please Fedora maintainers :-(
2052                print PBS << "EOF";
2053for p in $basesrc; do
2054    echo \$p | grep -q 'src.rpm'
2055    if [ \$\? -eq 0 ]; then
2056        rpm2cpio \$p | cpio -ivdum --quiet '*.spec'
2057    fi
2058done
2059EOF
2060            }
2061            if ($pbos->{'family'} eq "novell") {
2062                # Add ymp scripts for one-click install on SuSE
2063                print PBS << "EOF";
2064# Prepare a script to ease SuSE one-click install
2065# Cf: http://de.opensuse.org/1-Klick-Installation/ISV
2066#
2067cat > $ENV{'PBPROJ'}.ymp << EOT
2068<?xml version="1.0" encoding="utf-8"?>
2069<!-- vim: set sw=2 ts=2 ai et: -->
2070<metapackage xmlns:os="http://opensuse.org/Standards/One_Click_Install" xmlns="http://opensuse.org/Standards/One_Click_Install">
2071    <group><!-- The group of software, typically one for project-builder.org -->
2072        <name>$ENV{'PBPROJ'} Bundle</name> <!-- Name of the software group -->
2073        <summary>Software bundle for the $ENV{'PBPROJ'} project</summary> <!--This message is shown to the user and should describe the whole bundle -->
2074        <description>This is the summary of the $ENV{'PBPROJ'} Project
2075             
2076            Details are available on a per package basis below
2077
2078        </description><!--This is also shown to the user -->
2079        <remainSubscribed>false</remainSubscribed> <!-- Don't know what it mean -->
2080        <repositories><!-- List of needed repositories -->
2081            <repository>
2082                <name>$ENV{'PBPROJ'} Repository</name> <!-- Name of the repository  -->
2083                <summary>This repository contains the $ENV{'PBPROJ'} project packages.</summary> <!-- Summary of the repository -->
2084                <description>This repository contains the $ENV{'PBPROJ'} project packages.</description><!-- This description is shown to the user -->
2085                <url>$pbrepo->{$ENV{'PBPROJ'}}/$repodir</url><!--URL of repository, which is added -->
2086            </repository>
2087        </repositories>
2088        <software><!-- A List of packages, which should be added through the one-click-installation -->
2089EOT
2090for p in $basesrc; do
2091    sum=`rpm -q --qf '%{SUMMARY}' \$p`
2092    name=`rpm -q --qf '%{NAME}' \$p`
2093    desc=`rpm -q --qf '%{description}' \$p`
2094    cat >> $ENV{'PBPROJ'}.ymp << EOT
2095            <item>
2096                <name>\$name</name><!-- Name of the package, is shown to the user and used to identify the package at the repository -->
2097                <summary>\$sum</summary> <!-- Summary of the package -->
2098                <description>\$desc</description> <!-- Description, is shown to the user -->
2099            </item>
2100EOT
2101done
2102cat >> $ENV{'PBPROJ'}.ymp << EOT
2103        </software>
2104    </group>
2105</metapackage>
2106EOT
2107chmod 644 $ENV{'PBPROJ'}.ymp
2108EOF
2109            }
2110        } elsif ($pbos->{'type'} eq "deb") {
2111            # Also make a pbscript to generate apt bases
2112            # Cf: http://www.debian.org/doc/manuals/repository-howto/repository-howto.fr.html
2113            # This dirname removes ver
2114            my $debarch = $pbos->{'arch'};
2115            $debarch = "amd64" if ($pbos->{'arch'} eq "x86_64");
2116            my $rpd = dirname("$pbrepo->{$ENV{'PBPROJ'}}/$repodir");
2117            # Remove extra . in path to fix #522
2118            $rpd =~ s|/./|/|g;
2119            print PBS << "EOF";
2120#!/bin/bash
2121# Prepare a script to ease apt setup
2122cat > $ENV{'PBPROJ'}.sources.list << EOT
2123deb $rpd $pbos->{'version'} contrib
2124deb-src $rpd $pbos->{'version'} contrib
2125EOT
2126chmod 644 $ENV{'PBPROJ'}.sources.list
2127
2128# Up two levels to deal with the dist dir cross versions
2129cd ..
2130mkdir -p dists/$pbos->{'version'}/contrib/binary-$debarch dists/$pbos->{'version'}/contrib/source
2131
2132# Prepare a script to create apt info file
2133# Reuse twice after
2134TMPD=`mktemp -d /tmp/pb.XXXXXXXXXX` || exit 1
2135mkdir -p \$TMPD
2136cat > \$TMPD/Release << EOT
2137Archive: unstable
2138Component: contrib
2139Origin: $ENV{'PBPROJ'}
2140Label: $ENV{'PBPROJ'} dev repository $pbrepo->{$ENV{'PBPROJ'}}
2141EOT
2142
2143echo "Creating Packages metadata ($pbos->{'arch'} aka $debarch)"
2144dpkg-scanpackages -a$debarch $pbos->{'version'} /dev/null | gzip -c9 > dists/$pbos->{'version'}/contrib/binary-$debarch/Packages.gz
2145dpkg-scanpackages -a$debarch $pbos->{'version'} /dev/null | bzip2 -c9 > dists/$pbos->{'version'}/contrib/binary-$debarch/Packages.bz2
2146echo "Creating Contents metadata"
2147apt-ftparchive contents $pbos->{'version'} | gzip -c9 > dists/$pbos->{'version'}/Contents.gz
2148echo "Creating Release metadata ($pbos->{'arch'} aka $debarch)"
2149cat \$TMPD/Release > dists/$pbos->{'version'}/contrib/binary-$debarch/Release
2150echo "Architecture: $debarch" >> dists/$pbos->{'version'}/contrib/binary-$debarch/Release
2151echo "Creating Source metadata"
2152dpkg-scansources $pbos->{'version'} /dev/null | gzip -c9 > dists/$pbos->{'version'}/contrib/source/Sources.gz
2153cat \$TMPD/Release > dists/$pbos->{'version'}/contrib/source/Release
2154echo "Architecture: Source" >> dists/$pbos->{'version'}/contrib/source/Release
2155echo "Creating Release metadata"
2156# Signing that file would be useful but uneasy as gpg keys are not there
2157# Cf: http://wiki.debian.org/SecureApt
2158# Same as for repomd
2159apt-ftparchive release dists/$pbos->{'version'} > dists/$pbos->{'version'}/Release
2160rm -rf \$TMPD
2161EOF
2162        } elsif ($pbos->{'type'} eq "ebuild") {
2163            # make a pbscript to generate links to latest version
2164            print PBS << "EOF";
2165#!/bin/bash
2166# Prepare a script to create correct links
2167for p in $src; do
2168    echo \$p | grep -q '.ebuild'
2169    if [ \$\? -eq 0 ]; then
2170        j=`basename \$p`
2171        pp=`echo \$j | cut -d'-' -f1`
2172        ln -sf \$j \$pp.ebuild
2173    fi
2174done
2175EOF
2176        }
2177        close(PBS);
2178        chmod 0755,"$ENV{'PBBUILDDIR'}/pbscript.$$";
2179    } else {
2180        return;
2181    }
2182
2183    # Useless for VE
2184    my $nport = pb_get_port($sshport,$pbos,$cmt) if ($cmt !~ /^VE/);
2185
2186    # Remove a potential $ENV{'HOME'} as tdir should be relative to pb's home
2187    $tdir =~ s|\$ENV.+\}/||;
2188
2189    my $tm = "";
2190    if ($cmt =~ /^(V|R)M/) {
2191        $tm = "sleep $vtmout" if (defined $vtmout);
2192    }
2193
2194    # ssh communication if not VE or CPAN
2195    # should use a hash instead...
2196    my ($shcmd,$shcmdroot,$cpcmd,$cptarget,$cp2target);
2197    if ($cmt =~ /^VE/) {
2198        my $tp = pb_path_expand($vepath->{$ENV{'PBPROJ'}});
2199        my $tpdir = pb_path_expand("$tp/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}");
2200        my ($ptr) = pb_conf_get("vetype");
2201        my $vetype = $ptr->{$ENV{'PBPROJ'}};
2202        my $arch = pb_get_arch();
2203        if ($vetype eq "chroot") {
2204            $shcmdroot = "sudo /usr/sbin/chroot $tpdir ";
2205            $shcmd = "$shcmdroot /bin/su - $mac -c ";
2206        } elsif ($vetype eq "schroot") {
2207            $shcmd = "schroot $tp -u $mac -- ";
2208        }
2209        $shcmd = "setarch i386 $shcmd" if (($pbos->{'arch'} =~ /i?86/) && ($arch eq 'x86_64'));
2210        $cpcmd = "sudo /bin/cp -r ";
2211        # We need to get the home dir of the target account to deliver in the right place
2212        open(PASS,"$tpdir/etc/passwd") || die "Unable to open $tpdir/etc/passwd: $!";
2213        my $homedir = "";
2214        while (<PASS>) {
2215            my ($c1,$c2,$c3,$c4,$c5,$c6,$c7) = split(/:/);
2216            $homedir = $c6 if ($c1 =~ /^$mac$/);
2217            pb_log(3,"Homedir: $homedir - account: $c6\n");
2218        }
2219        close(PASS);
2220        $cptarget = "$tpdir/$homedir/$tdir";
2221        if ($cmt eq "VEbuild") {
2222            $cp2target = "$tpdir/$homedir/$bdir";
2223        }
2224        pb_log(2,"On VE using $cptarget as target dir to copy to\n");
2225    } elsif ($cmt =~ /^CPAN/) {
2226        my $ftpput = pb_check_req("ncftpput",1);
2227        my $ftpget = pb_check_req("wget",1);
2228        my ($cpanuser,$cpanpasswd) = pb_conf_get("cpanuser","cpanpasswd");
2229        my ($cpansubdir) = pb_conf_get_if("cpansubdir");
2230        $shcmd = "$ftpget --post-data \'HIDDENNAME=".$cpanuser;
2231        $shcmd .= "&user=".$cpanuser;
2232        $shcmd .= "&password=".$cpanpasswd;
2233        $shcmd .= "&SUBMIT_pause99_add_uri_upload=\"Upload the checked files\"";
2234        $shcmd .= "&pause99_add_uri_subdirtext=".$cpansubdir if (defined $cpansubdir);
2235        foreach my $s (split(/ /,$src)) {
2236            $shcmd .= "&pause99_add_uri_upload=".basename($s);
2237        }
2238        $shcmd .= "'";
2239        $cpcmd = "$ftpput $host $dir";
2240        $cptarget = "CPAN";
2241    } else {
2242        my $keyfile = pb_ssh_get(0);
2243        my $keyopt = defined $keyfile ? "-i $keyfile" : "";
2244        my $sshcmd = pb_check_req("ssh",1);
2245        my $scpcmd = pb_check_req("scp",1);
2246        $shcmd = "$sshcmd $keyopt -q -o NoHostAuthenticationForLocalhost=yes -p $nport $mac";
2247        $cpcmd = "$scpcmd $keyopt -p -o NoHostAuthenticationForLocalhost=yes -P $nport";
2248        $cptarget = "$mac:$tdir";
2249        if ($cmt =~ /^(V|R)Mbuild/) {
2250            $cp2target = "$mac:$bdir";
2251        }
2252    }
2253   
2254    my $logres = "";
2255    # Do not touch when just announcing
2256    if (($cmt ne "Announce") && ($cmt ne "CPAN")) {
2257        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");
2258    } else {
2259        $logres = "> ";
2260    }
2261    pb_system("cd $ENV{'PBBUILDDIR'} ; $cpcmd $src $cptarget 2> /dev/null","$cmt delivery in $cptarget");
2262
2263    # For VE we need to change the owner manually
2264    if ($cmt =~ /^VE/) {
2265        if (defined $shcmdroot) {
2266            # This should help overcome a CentOS 5.8 bug as well as having a simper sequence
2267            pb_system("$shcmdroot \"chown -R $mac $tdir\"","Adapt owner in $tdir to $mac");
2268        } else {
2269            pb_system("$shcmd \"sudo chown -R $mac $tdir\"","Adapt owner in $tdir to $mac");
2270        }
2271    }
2272
2273    # Use the right script name depending on context
2274    my $pbscript;
2275    if (($cmt =~ /^(V[EM]|RM)/) || ($cmt =~ /Packages/)){
2276        $pbscript = "pbscript.$$";
2277    } else {
2278        $pbscript = "pbscript";
2279    }
2280
2281    # It's already ready for CPAN
2282    my $shcmdbase = $shcmd;
2283    if ($cmt !~ /^CPAN/) {
2284        $shcmd .= " \"echo \'cd $tdir ; if [ -x $pbscript ]; then ./$pbscript; fi ; rm -f ./$pbscript\' | bash\"";
2285    }
2286    my $cmdverb = "verbose";
2287    if (($cmt eq "Announce") || ($cmt eq "CPAN")) {
2288        $cmdverb = undef;
2289    }
2290    pb_system("$shcmd","Executing pbscript on $cptarget if needed",$cmdverb);
2291    if ($cmt =~ /^(V[EM]|RM)build/) {
2292        # Get back info on pkg produced, compute their name and get them from the VM/RM
2293        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");
2294        # For VE we need to change the owner manually
2295        if ($cmt eq "VEbuild") {
2296            pb_system("sudo chown $UID $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$","Adapt owner in $tdir to $UID");
2297        }
2298        if (not -f "$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$") {
2299            pb_log(0,"Problem with VM/RM $v on $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$");
2300        } else {
2301            open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$") || die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$";
2302            my $src = <KEEP>;
2303            chomp($src);
2304            close(KEEP);
2305            unlink("$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.$$");
2306
2307            $src =~ s/^ *//;
2308            pb_mkdir_p("$ENV{'PBBUILDDIR'}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}");
2309            # Change pgben to make the next send2target happy
2310            my $made = "";
2311   
2312            # For VM/RM we don't want shell expansion to hapen locally but remotely
2313            my $delim = '\'';
2314            if ($cmt =~ /^VEbuild/) {
2315                # For VE we need to support shell expansion locally
2316                $delim = "";
2317            }   
2318
2319            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'}";
2320            foreach my $p (split(/ +/,$src)) {
2321                my $j = basename($p);
2322                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'}");
2323                $made="$made $pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/$j"; # if (($pbos->{'type'} ne "rpm") || ($j !~ /.src.rpm$/));
2324            }
2325            print KEEP "$made\n";
2326            close(KEEP);
2327            pb_system("$shcmdbase \"rm -rf $tdir $bdir\"","$cmt cleanup");
2328
2329            # Sign packages locally
2330            pb_sign_pkgs($pbos,$made);
2331
2332            # We want to send them to the ssh account so overwrite what has been done before
2333            undef $pbaccount;
2334            pb_log(2,"Before sending pkgs, vmexist: $vmexist, vmpid: $vmpid\n");
2335            pb_send2target("Packages",$pbos->{'name'}."-".$pbos->{'version'}."-".$pbos->{'arch'},$vmexist,$vmpid);
2336            pb_rm_rf("$ENV{'PBBUILDDIR'}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}");
2337        }
2338    }
2339    unlink("$ENV{'PBDESTDIR'}/pbscript.$$") if ((($cmt =~ /^(V[ME]|RM)/) || ($cmt =~ /Packages/)) && ($pbkeep eq 0));
2340
2341    pb_log(2,"Before halt, vmexist: $vmexist, vmpid: $vmpid\n");
2342    if ((! $vmexist) && ($cmt =~ /^VM/)) {
2343        # If in setupvm then takes a snapshot just before halting
2344        if ($snapme != 0) {
2345            my ($vmmonport,$vmtype) = pb_conf_get("vmmonport","vmtype");
2346            # For monitoring control
2347            if ((($vmtype->{$ENV{'PBPROJ'}}) eq "kvm") || (($vmtype->{$ENV{'PBPROJ'}}) eq "qemu")) {
2348                eval
2349                {
2350                require Net::Telnet;
2351                Net::Telnet->import();
2352                };
2353                if ($@) {
2354                    # Net::Telnet not found
2355                    pb_log(1,"ADVISE: Install Net::Telnet to benefit from monitoring control and snapshot feature.\nWARNING: No snapshot created");
2356                } else {
2357                    my $t = new Net::Telnet (Timeout => 120, Host => "localhost", Port => $vmmonport->{$ENV{'PBPROJ'}}) || die "Unable to dialog on the monitor";
2358                    # move to monitor mode
2359                    my @lines = $t->cmd("c");
2360                    # Create a snapshot named pb
2361                    @lines = $t->cmd("savevm pb");
2362                    # Write the new status in the VM
2363                    @lines = $t->cmd("commit all");
2364                    # End
2365                    @lines = $t->cmd("quit");
2366                }
2367            }
2368        }
2369        my $hoption = "-p";
2370        my $hpath = pb_distro_get_param($pbos,pb_conf_get("ospathcmd-halt"));
2371        # Solaris doesn't support -p of halt
2372        if ($pbos->{'type'} eq "pkg") {
2373            $hoption = "" ;
2374        }
2375        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)");
2376    }
2377    if (($cmt =~ /^VE/) && ($snapme != 0)) {
2378        my $tpdir = "$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}";
2379        pb_system("sudo tar cz -C $tpdir -f $vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}.tar.gz .","Creating a snapshot of $tpdir");
2380    }
2381}
2382
2383sub pb_script2v {
2384    my $pbscript=shift;
2385    my $vtype=shift;
2386    my $pbforce=shift || 0; # Force stop of VM. Default not.
2387    my $vm1=shift || undef; # Only that VM/VE/RM to treat. Default all.
2388    my $snapme=shift || 0;  # Do we have to create a snapshot. Default not.
2389    my $vm;
2390    my $all;
2391
2392    pb_log(2,"DEBUG: pb_script2v($pbscript,$vtype,$pbforce,".Dumper($vm1).",$snapme)\n");
2393    # Prepare the script to be executed on the VM/VE/RM
2394    # in $ENV{'PBDESTDIR'}/pbscript.$$
2395    if ((defined $pbscript ) && ($pbscript ne "$ENV{'PBDESTDIR'}/pbscript.$$")) {
2396        copy($pbscript,"$ENV{'PBDESTDIR'}/pbscript.$$") || die "Unable to create $ENV{'PBDESTDIR'}/pbscript.$$";
2397        chmod 0755,"$ENV{'PBDESTDIR'}/pbscript.$$";
2398    }
2399
2400    if (not defined $vm1) {
2401        ($vm,$all) = pb_get2v($vtype);
2402    } else {
2403        @$vm = ($vm1);
2404    }
2405    my ($vmexist,$vmpid) = (undef,undef);
2406
2407    foreach my $v (@$vm) {
2408        # Launch VM/VE
2409        ($vmexist,$vmpid) = pb_launchv($vtype,$v,0,$snapme,$pbsnap);
2410
2411        if ($vtype eq "vm") {
2412            pb_log(2,"DEBUG: After pb_launchv, vmexist: $vmexist, vmpid: $vmpid\n");
2413
2414            # Skip that VM/RM if something went wrong
2415            next if (($vmpid == 0) && ($vmexist == 0));
2416
2417            # If force stopping the VM then reset vmexist
2418            if ($pbforce == 1) {
2419                $vmpid = $vmexist;
2420                $vmexist = 0;
2421            }
2422        } else {
2423            #VE
2424            $vmexist = 0;
2425            $vmpid = 0;
2426        }
2427
2428        # Gather all required files to send them to the VM/VE/RM
2429        # and launch the build through pbscript
2430        pb_log(2,"DEBUG: Before send2target, vmexist: $vmexist, vmpid: $vmpid\n");
2431        pb_send2target(uc($vtype)."Script","$v",$vmexist,$vmpid,$snapme);
2432
2433    }
2434}
2435
2436sub pb_launchv {
2437    my $vtype = shift;
2438    my $v = shift;
2439    my $create = shift || 0;        # By default do not create a VM/VE/RM
2440    my $snapme = shift || 0;        # By default do not snap a VM/VE/RM
2441    my $usesnap = shift || 1;       # By default study the usage of the snapshot feature of VM/VE/RM   
2442
2443    # If creation or snapshot creation mode, no snapshot usable
2444    if (($create == 1) || ($snapme == 1)) {
2445        $usesnap = 0;
2446    }
2447
2448    pb_log(2,"DEBUG: pb_launchv($vtype,$v,$create,$snapme,$usesnap)\n");
2449    die "No VM/VE/RM defined, unable to launch" if (not defined $v);
2450    # Keep only the first VM in case many were given
2451    if ($v =~ /,/) {
2452        pb_log(0,"WARNING: pruning to just the first of several vms listed ($v)\n");
2453        $v =~ s/,.*//;
2454    }
2455
2456    my $pbos = pb_distro_get_context($v);
2457   
2458    my $ftp_proxy = pb_distro_get_param($pbos,pb_conf_get_if("ftp_proxy"));
2459    my $http_proxy = pb_distro_get_param($pbos,pb_conf_get_if("http_proxy"));
2460
2461    $ENV{ftp_proxy} ||= $ftp_proxy if ((defined $ftp_proxy) && ($ftp_proxy ne ""));
2462    $ENV{http_proxy} ||= $http_proxy if ((defined $http_proxy) && ($http_proxy ne ""));
2463
2464    # Launch the VMs/VEs
2465    if ($vtype eq "vm") {
2466        die "-i iso parameter needed" if (((not defined $iso) || ($iso eq "")) && ($create != 0));
2467
2468        my ($ptr,$ptr2,$vmpath,$vmport,$vms) = pb_conf_get("vmtype","vmcmd","vmpath","vmport","vmsize");
2469        my ($vmopt,$vmmm,$vmtmout,$vmsnap,$vmbuildtm,$vmmonport) = pb_conf_get_if("vmopt","vmmem","vmtmout","vmsnap","vmbuildtm","vmmonport");
2470        my $vmsize = pb_distro_get_param($pbos,$vms);
2471
2472        my $vmtype = $ptr->{$ENV{'PBPROJ'}};
2473        my $vmcmd = $ptr2->{$ENV{'PBPROJ'}};
2474
2475        if (defined $opts{'g'}) {
2476            if (($vmtype eq "kvm") || ($vmtype eq "qemu")) {
2477                $ENV{'PBVMOPT'} = "--nographic";
2478            }
2479        }
2480        if (not defined $ENV{'PBVMOPT'}) {
2481            $ENV{'PBVMOPT'} = "";
2482        }
2483        # Save the current status for later restoration
2484        $ENV{'PBOLDVMOPT'} = $ENV{'PBVMOPT'};
2485        # Set a default timeout of 2 minutes
2486        if (not defined $ENV{'PBVMTMOUT'}) {
2487            $ENV{'PBVMTMOUT'} = "120";
2488        }
2489        if (defined $vmopt->{$v}) {
2490            $ENV{'PBVMOPT'} .= " $vmopt->{$v}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$v}/);
2491        } elsif (defined $vmopt->{$ENV{'PBPROJ'}}) {
2492            $ENV{'PBVMOPT'} .= " $vmopt->{$ENV{'PBPROJ'}}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$ENV{'PBPROJ'}}/);
2493        }
2494
2495        # How much memory to allocate for VMs
2496        if (defined $vmmm) {
2497            my $vmmem = pb_distro_get_param($pbos,$vmmm);
2498            if (defined $vmmem) {
2499                $ENV{'PBVMOPT'} .= " -m $vmmem";
2500            }
2501        }
2502
2503        # Are we allowed to use snapshot feature
2504        if ($usesnap == 1) {
2505            if ((defined $vmsnap->{$v}) && ($vmsnap->{$v} =~ /true/i)) {
2506                $ENV{'PBVMOPT'} .= " -snapshot";
2507            } elsif ((defined $vmsnap->{$ENV{'PBPROJ'}}) && ($vmsnap->{$ENV{'PBPROJ'}} =~ /true/i)) {
2508                $ENV{'PBVMOPT'} .= " -snapshot";
2509            } elsif ($pbsnap eq 1) {
2510                $ENV{'PBVMOPT'} .= " -snapshot";
2511            }
2512        } 
2513        if ($snapme != 0) {
2514            if (($vmtype eq "kvm") || ($vmtype eq "qemu")) {
2515                # Configure the monitoring to automate the creation of the 'pb' snapshot
2516                $ENV{'PBVMOPT'} .= " -serial mon:telnet::$vmmonport->{$ENV{'PBPROJ'}},server,nowait" if ((defined $vmmonport) && (defined $vmmonport->{$ENV{'PBPROJ'}}));
2517                # In that case no snapshot call needed
2518                $ENV{'PBVMOPT'} =~ s/ -snapshot//;
2519            }
2520        }
2521        if (defined $vmtmout->{$v}) {
2522            $ENV{'PBVMTMOUT'} = $vmtmout->{$v};
2523        } elsif (defined $vmtmout->{$ENV{'PBPROJ'}}) {
2524            $ENV{'PBVMTMOUT'} = $vmtmout->{$ENV{'PBPROJ'}};
2525        }
2526        my $nport = pb_get_port($vmport,$pbos,$vtype);
2527   
2528        my $cmd;
2529        my $vmm;        # has to be used for pb_check_ps
2530        if (($vmtype eq "qemu") || ($vmtype eq "kvm")) {
2531            $vmm = "$vmpath->{$ENV{'PBPROJ'}}/$v.qemu";
2532            if (($create != 0) || (defined $iso)) {
2533                $ENV{'PBVMOPT'} .= " -cdrom $iso -boot d";
2534            }
2535            # Always redirect the network and always try to use a 'pb' snapshot
2536            #$cmd = "$vmcmd $ENV{'PBVMOPT'} -net user,hostfwd=tcp:$nport:10.0.2.15:22 -loadvm pb $vmm"
2537            $cmd = "$vmcmd $ENV{'PBVMOPT'} -redir tcp:$nport:10.0.2.15:22 $vmm"
2538        } elsif ($vmtype eq "xen") {
2539        } elsif ($vmtype eq "vmware") {
2540        } else {
2541            die "VM of type $vmtype not supported. Report to the dev team";
2542        }
2543        # Restore the ENV VAR Value
2544        $ENV{'PBVMOPT'} = $ENV{'PBOLDVMOPT'};
2545
2546        my ($tmpcmd,$void) = split(/ +/,$cmd);
2547        my $vmexist = pb_check_ps($tmpcmd,$vmm);
2548        my $vmpid = 0;
2549        if (! $vmexist) {
2550            if ($create != 0) {
2551                die("Found an existing Virtual machine $vmm. Won't overwrite") if (-r $vmm);
2552                if (($vmtype eq "qemu") || ($vmtype eq "xen") || ($vmtype eq "kvm")) {
2553                    my $command = pb_check_req("qemu-img",0);
2554                    pb_system("$command create -f qcow2 $vmm $vmsize","Creating the QEMU VM");
2555                } elsif ($vmtype eq "vmware") {
2556                } else {
2557                }
2558            }
2559            if (! -f "$vmm") {
2560                pb_log(0,"Unable to find VM $vmm\n");
2561            } else {
2562                # Is the SSH port free? if not kill the existing process using it after a build timeout period
2563                my $vmssh = pb_check_ps($tmpcmd,"tcp:$nport:10.0.2.15:22");
2564                if ($vmssh) {
2565                    my $buildtm = $ENV{'PBVMTMOUT'};
2566                    if (defined $vmbuildtm->{$v}) {
2567                        $buildtm = $vmbuildtm->{$v};
2568                    } elsif (defined $vmbuildtm->{$ENV{'PBPROJ'}}) {
2569                        $buildtm = $vmbuildtm->{$ENV{'PBPROJ'}};
2570                    }
2571
2572                    sleep $buildtm;
2573                    pb_log(0,"WARNING: Killing the process ($vmssh) using port $nport (previous failed VM ?)\n");
2574                    kill 15,$vmssh;
2575                    # Let it time to exit
2576                    sleep 5;
2577                }
2578                pb_system("$cmd &","Launching the VM $vmm");
2579                # Using system allows to kill it externaly if needed,sosupport that in the call
2580                pb_system("sleep $ENV{'PBVMTMOUT'}","Waiting $ENV{'PBVMTMOUT'} s for VM $v to come up",undef,1);
2581                $vmpid = pb_check_ps($tmpcmd,$vmm);
2582                pb_log(0,"VM $vmm launched (pid $vmpid)\n");
2583            }
2584        } else {
2585            pb_log(0,"Found an existing VM $vmm (pid $vmexist)\n");
2586        }
2587        pb_log(2,"DEBUG: pb_launchv returns ($vmexist,$vmpid)\n");
2588        return($vmexist,$vmpid);
2589    } elsif ($vtype eq "ve") {
2590        # Force the creation of the VE and no snapshot usable
2591        pb_ve_launch($v,$create,$usesnap);
2592    } else {
2593        # RM here
2594        # Get distro context
2595        my $pbos = pb_distro_get_context($v);
2596
2597        # Get RM context
2598        my ($ptr,$rmpath) = pb_conf_get("rmtype","rmpath");
2599
2600        # Nothing more to do for RM. No real launch
2601        # For the moment we support the RM is already running
2602        # For ProLiant may be able to power them on if needed later on as an example.
2603    }
2604}
2605
2606# Return string for date synchro
2607sub pb_date2v {
2608
2609my $vtype = shift;
2610my $pbos = shift;
2611
2612# VE gets time from parent OS.
2613return "/bin/true" if ($vtype) =~ /^ve/o; 
2614
2615my ($ntp) = pb_conf_get_if($vtype."ntp");
2616my $vntp = $ntp->{$ENV{'PBPROJ'}} if (defined $ntp);
2617my $ntpline = undef;
2618
2619if (defined $vntp) {
2620    # ntp command depends on pbos
2621    my $vntpcmd = pb_distro_get_param($pbos,pb_conf_get($vtype."ntpcmd"));
2622    $ntpline = "sudo $vntpcmd $vntp";
2623}
2624# Force new date to be in the future compared to the date
2625# of the host by adding 1 minute
2626my @date=pb_get_date();
2627$date[1]++;
2628my $upddate = strftime("%m%d%H%M%Y", @date);
2629my $dateline = "sudo /bin/date $upddate";
2630if (defined $ntpline) {
2631    return($ntpline);
2632} else {
2633    return($dateline);
2634}
2635}
2636
2637sub pb_build2v {
2638
2639my $vtype = shift;
2640my $action = shift || "build";
2641
2642my ($v,$all) = pb_get2v($vtype);
2643
2644# Send tar files when we do a global generation
2645pb_build2ssh() if (($all == 1) && ($action eq "build"));
2646
2647# Adapt // mode to memory size
2648$pbparallel = pb_set_parallel($vtype);
2649
2650my ($vmexist,$vmpid) = (undef,undef);
2651my $pm;
2652my $all_ok = 1;
2653if (defined $pbparallel) {
2654    $pm = new Parallel::ForkManager($pbparallel);
2655
2656    # Set which port the VM/RM will use to communicate
2657    $pm->run_on_start(\&pb_set_port);
2658    $pm->run_on_finish(sub { my ($pid, $code, $id, $signal, $dump) = @_;
2659                            unless ($code == 0 && $signal == 0 && $dump == 0) {
2660                                pb_log(0,"ERROR: pid $pid failed\n");
2661                            }
2662                        });
2663}
2664
2665my $counter = 0;
2666foreach my $v (@$v) {
2667    $counter++;
2668    # Modulo 2 * pbparallel (to avoid synchronization problems)
2669    $counter = 1 if ((defined $pbparallel) && ($counter > 2 * $pbparallel));
2670    $pm->start($counter) and next if (defined $pbparallel);
2671    # Prepare the script to be executed on the VM/VE/RM
2672    # in $ENV{'PBDESTDIR'}/pbscript.$$
2673    open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript.$$") || die "Unable to create $ENV{'PBDESTDIR'}/pbscript.$$";
2674    print SCRIPT "#!/bin/bash\n";
2675
2676    # Transmit the verbosity level to the virtual env/mach.
2677    my $verbose = "";
2678    my $i = 0;                          # minimal debug level
2679    while ($i lt $pbdebug) {
2680        $verbose .= "-v ";
2681        $i++;
2682    }
2683    print SCRIPT "set -e\n" if $Global::pb_stop_on_error;
2684    # Activate script verbosity if at least 2 for pbdebug
2685    print SCRIPT "set -x\n" if ($i gt 1);
2686    # Quiet if asked to be so on the original system
2687    $verbose = "-q" if ($pbdebug eq -1);
2688
2689    print SCRIPT "echo ... Execution needed\n";
2690    print SCRIPT "# This is in directory delivery\n";
2691    print SCRIPT "# Setup the variables required for building\n";
2692    print SCRIPT "export PBPROJ=$ENV{'PBPROJ'}\n";
2693
2694    if ($action eq "build") {
2695        print SCRIPT "# Preparation for pb\n";
2696        print SCRIPT "mv .pbrc \$HOME\n";
2697        print SCRIPT "cd ..\n";
2698    }
2699
2700    # VE needs a good /proc, tolerate one being potentially left around after a failure
2701    if ($vtype eq "ve") {
2702        print SCRIPT "[ -d /proc/1 ] || sudo /bin/mount -t proc /proc /proc\n";
2703    }
2704
2705    # Get distro context
2706    my $pbos = pb_distro_get_context($v);
2707   
2708    my $ntpline = pb_date2v($vtype,$pbos);
2709    print SCRIPT "# Time sync\n";
2710    print SCRIPT "echo setting up date with $ntpline\n";
2711    print SCRIPT "$ntpline\n";
2712    # Use potential local proxy declaration in case we need it to download repo, pkgs, ...
2713    if (defined $ENV{'http_proxy'}) {
2714        print SCRIPT "export http_proxy=\"$ENV{'http_proxy'}\"\n";
2715    }
2716
2717    if (defined $ENV{'ftp_proxy'}) {
2718        print SCRIPT "export ftp_proxy=\"$ENV{'ftp_proxy'}\"\n";
2719    }
2720
2721    # Get list of packages to build/test and get some ENV vars as well
2722    my $ptr = pb_get_pkg();
2723    @pkgs = @$ptr;
2724    my $p = join(' ',@pkgs) if (@pkgs);
2725    print SCRIPT "export PBPROJVER=$ENV{'PBPROJVER'}\n";
2726    print SCRIPT "export PBPROJTAG=$ENV{'PBPROJTAG'}\n";
2727    print SCRIPT "export PBPACKAGER=\"$ENV{'PBPACKAGER'}\"\n";
2728
2729    # We may need to do some other tasks before building. Read a script here to finish setup
2730    if (-x "$ENV{'PBDESTDIR'}/pb$vtype".".pre") {
2731        print SCRIPT "# Special pre-instructions to be launched\n";
2732        print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype".".pre");
2733    }
2734
2735    if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."$action.pre") {
2736        print SCRIPT "# Special pre-$action instructions to be launched\n";
2737        print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."$action.pre");
2738    }
2739
2740    print SCRIPT "# $action\n";
2741    print SCRIPT "echo $action"."ing packages on $vtype...\n";
2742
2743    if (($action eq "test") && (! -x "$ENV{'PBDESTDIR'}/pbtest")) {
2744            die "No test script ($ENV{'PBDESTDIR'}/pbtest) found when in test mode. Aborting ...";
2745    }
2746    print SCRIPT "pb $verbose -p $ENV{'PBPROJ'} $action"."2pkg $p\n";
2747
2748    if ($vtype eq "ve") {
2749        print SCRIPT "sudo /bin/umount /proc\n";
2750    }
2751
2752    # We may need to do some other tasks after building. Read a script here to exit properly
2753    if (-x "$ENV{'PBDESTDIR'}/pb$vtype"."$action.post") {
2754        print SCRIPT "# Special post-$action instructions to be launched\n";
2755        print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype"."$action.post");
2756    }
2757
2758    if (-x "$ENV{'PBDESTDIR'}/pb$vtype".".post") {
2759        print SCRIPT "# Special post-instructions to be launched\n";
2760        print SCRIPT pb_get_content("$ENV{'PBDESTDIR'}/pb$vtype".".post");
2761    }
2762
2763    print SCRIPT q{echo "********** Successful exit of script $$ *********************"}, "\n";
2764    close(SCRIPT);
2765    chmod 0755,"$ENV{'PBDESTDIR'}/pbscript.$$";
2766   
2767    # Launch the VM/VE/RM
2768    ($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
2769
2770
2771    if ($vtype eq "vm") {
2772        # Skip that VM if something went wrong
2773        if (($vmpid == 0) && ($vmexist == 0)) {
2774            $pm->finish if (defined $pbparallel);
2775            next;
2776        }
2777    } else {
2778        # VE/RM
2779        $vmexist = 0;
2780        $vmpid = 0;
2781    }
2782    # Gather all required files to send them to the VM/VE
2783    # and launch the build through pbscript
2784    pb_log(2,"Calling send2target $vtype,$v,$vmexist,$vmpid\n");
2785    pb_send2target(uc($vtype).$action,"$v",$vmexist,$vmpid);
2786    $pm->finish if (defined $pbparallel);
2787}
2788$pm->wait_all_children if (defined $pbparallel);
2789die "Aborting, one or more of the children failed." if ((not $all_ok) && ($Global::pb_stop_on_error));
2790}
2791
2792
2793sub pb_clean {
2794
2795    my $sleep=10;
2796    die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
2797    die "Unable to get env var PBBUILDDIR" if (not defined $ENV{'PBBUILDDIR'});
2798    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");
2799    sleep $sleep;
2800    pb_rm_rf($ENV{'PBDESTDIR'});
2801    pb_rm_rf($ENV{'PBBUILDDIR'});
2802}
2803
2804sub pb_newver {
2805
2806    die "-V Version parameter needed" if ((not defined $newver) || ($newver eq ""));
2807
2808    # Need this call for PBDIR
2809    my ($scheme2,$uri) = pb_cms_init($pbinit);
2810
2811    my ($pbconf,$pburl) = pb_conf_get("pbconfurl","pburl");
2812    $uri = $pbconf->{$ENV{'PBPROJ'}};
2813    my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);
2814
2815    # Checking CMS repositories status
2816    ($scheme2, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}});
2817
2818    if ($scheme !~ /^svn/) {
2819        die "Only SVN is supported at the moment";
2820    }
2821
2822    my $res = pb_vcs_isdiff($scheme,$ENV{'PBROOTDIR'});
2823    die "ERROR: No differences accepted in CMS for $ENV{'PBROOTDIR'} before creating a new version" if ($res != 0);
2824
2825    $res = pb_vcs_isdiff($scheme2,$ENV{'PBDIR'});
2826    die "ERROR: No differences accepted in CMS for $ENV{'PBDIR'} before creating a new version" if ($res != 0);
2827
2828    # Tree identical between PBCONFDIR and PBROOTDIR. The delta is what
2829    # we want to get for the root of the new URL
2830
2831    my $oldver = $ENV{'PBROOTDIR'};
2832    $oldver =~ s|^$ENV{'PBCONFDIR'}||;
2833
2834    pb_log(2, "PBCONFDIR: $ENV{'PBCONFDIR'}\nPBROOTDIR: $ENV{'PBROOTDIR'}\n");
2835
2836    my $newurl = "$uri/$newver";
2837    # Should probably use projver in the old file
2838    my $oldvertxt= basename($oldver);
2839    my $newvertxt = basename($newver);
2840
2841    # Duplicate and extract project-builder part
2842    pb_log(2,"Copying $uri/$oldver to $newurl\n");
2843    pb_vcs_copy($scheme,"$uri/$oldver",$newurl);
2844    pb_log(2,"Checkout $newurl to $ENV{'PBCONFDIR'}/$newver\n");
2845    pb_vcs_up($scheme,"$ENV{'PBCONFDIR'}");
2846
2847    # Duplicate and extract project
2848    my $newurl2 = "$pburl->{$ENV{'PBPROJ'}}/$newver";
2849
2850    pb_log(2,"Copying $pburl->{$ENV{'PBPROJ'}}/$oldver to $newurl2\n");
2851    pb_vcs_copy($scheme2,"$pburl->{$ENV{'PBPROJ'}}/$oldver",$newurl2);
2852
2853    my $tmp = $ENV{'PBDIR'};
2854    $tmp =~ s|$oldver$||;
2855    pb_log(2,"Checkout $newurl2 to $tmp/$newver\n");
2856    pb_vcs_up($scheme2,"$tmp");
2857
2858    # Update the .pb file
2859    open(FILE,"$ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb") || die "Unable to open $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb";
2860    open(OUT,"> $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb.new") || die "Unable to write to $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb.new";
2861    while(<FILE>) {
2862        if (/^projver\s+$ENV{'PBPROJ'}\s*=\s*$oldvertxt$/) {
2863            s/^projver\s+$ENV{'PBPROJ'}\s*=\s*$oldvertxt$/projver $ENV{'PBPROJ'} = $newvertxt/;
2864            pb_log(0,"Changing projver from $oldvertxt to $newvertxt in $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb\n");
2865        }
2866        if (/^testver/) {
2867            s/^testver/#testver/;
2868            pb_log(0,"Commenting testver in $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb\n") if (/^testver/);
2869        }
2870        if (/^delivery/) {
2871            my $txt = $_;
2872            chomp($txt);
2873            pb_log(0,"Please check delivery ($txt) in $ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb\n");
2874        }
2875        print OUT $_;
2876    }
2877    close(FILE);
2878    close(OUT);
2879    rename("$ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb.new","$ENV{'PBCONFDIR'}/$newver/$ENV{'PBPROJ'}.pb");
2880
2881    # Checking pbcl files
2882    foreach my $f (<$ENV{'PBROOTDIR'}/*/pbcl>) {
2883        # Compute new pbcl file
2884        my $f2 = $f;
2885        $f2 =~ s|$ENV{'PBROOTDIR'}|$ENV{'PBCONFDIR'}/$newver/|;
2886        open(PBCL,$f) || die "Unable to open $f";
2887        my $foundnew = 0;
2888        while (<PBCL>) {
2889            $foundnew = 1 if (/^$newvertxt \(/);
2890        }
2891        close(PBCL);
2892        open(OUT,"> $f2") || die "Unable to write to $f2: $!";
2893        open(PBCL,$f) || die "Unable to open $f";
2894        while (<PBCL>) {
2895            print OUT "$_" if (not /^$oldvertxt \(/);
2896            if ((/^$oldvertxt \(/) && ($foundnew == 0)) {
2897                print OUT "$newvertxt ($pbdate)\n";
2898                print OUT "- TBD\n";
2899                print OUT "\n";
2900                pb_log(0,"WARNING: version $newvertxt not found in $f so added to $f2...\n") if ($foundnew == 0);
2901            }
2902        }
2903        close(OUT);
2904        close(PBCL);
2905    }
2906
2907    pb_log(2,"Checkin $ENV{'PBCONFDIR'}/$newver\n");
2908    pb_cms_checkin($scheme,"$ENV{'PBCONFDIR'}/$newver",undef);
2909}
2910
2911#
2912# Return the list of VMs/VEs/RMs we are working on
2913# $all is a flag to know if we return all of them
2914# or only some (if all we publish also tar files in addition to pkgs
2915#
2916sub pb_get2v {
2917
2918my $vtype = shift;
2919my @v;
2920my $all = 0;
2921my $pbv = 'PBV';
2922my $vlist = $vtype."list";
2923
2924# Get VM/VE list
2925if ((not defined $ENV{$pbv}) || ($ENV{$pbv} =~ /^all$/)) {
2926    my ($ptr) = pb_conf_get($vlist);
2927    $ENV{$pbv} = $ptr->{$ENV{'PBPROJ'}};
2928    $all = 1;
2929}
2930pb_log(2,"$vtype: $ENV{$pbv}\n");
2931@v = split(/,/,$ENV{$pbv});
2932return(\@v,$all);
2933}
2934
2935# This function creates a giant script to configure a particular VM/VE/RM, it then copies the
2936# script to the target.
2937
2938# Function to create a potentialy missing pb account on the VM/VE/RM, and adds it to sudo
2939# Needs to use root account to connect to the VM/VE/RM
2940# pb will take your local public SSH key to access
2941# the pb account in the VM/VE/RM later on if needed
2942sub pb_setup2v {
2943
2944my $vtype = shift;
2945my $sbx = shift || undef;
2946
2947my ($vm,$all) = pb_get2v($vtype);
2948
2949# Script generated
2950my $pbscript = "$ENV{'PBDESTDIR'}/setupv";
2951
2952# Adapt // mode to memory size
2953$pbparallel = pb_set_parallel($vtype);
2954
2955my $pm;
2956my $all_ok = 1;
2957if (defined $pbparallel) {
2958    $pm = new Parallel::ForkManager($pbparallel);
2959
2960    # Set which port the VM/RM will use to communicate
2961    $pm->run_on_start(\&pb_set_port);
2962    $pm->run_on_finish(sub { my ($pid, $code, $id, $signal, $dump) = @_;
2963                            $all_ok = 0 unless (($code == 0) && ($signal == 0) && ($dump == 0)); 
2964                        });
2965}
2966
2967my $counter = 0;
2968foreach my $v (@$vm) {
2969    $counter++;
2970    # Modulo pbparallel
2971    $counter = 1 if ((defined $pbparallel) && ($counter > $pbparallel));
2972    $pm->start($counter) and next if (defined $pbparallel);
2973
2974    # Get distro context
2975    my $pbos = pb_distro_get_context($v);
2976   
2977    # Deal with date sync.
2978    my $ntpline = pb_date2v($vtype,$pbos);
2979
2980    # Name of the account to deal with for VM/VE/RM
2981    # Do not use the one passed potentially with -a
2982    my ($pbac) = pb_conf_get($vtype."login");
2983    my ($key,$zero0,$zero1,$zero2);
2984    my ($vmexist,$vmpid);
2985
2986    # Prepare the script to be executed on the VM/VE/RM
2987    # in $ENV{'PBDESTDIR'}/setupv
2988    open(SCRIPT,"> $pbscript") || die "Unable to create $pbscript";
2989   
2990    print SCRIPT << 'EOF';
2991#!/usr/bin/perl -w
2992
2993use strict;
2994use File::Copy;
2995
2996# We should not need in this script more functions than what is provided
2997# by Base, Conf and Distribution to avoid problems at exec time.
2998# They are appended at the end.
2999
3000# Define mandatory global vars
3001our $pbdebug;
3002our $pbLOG;
3003our $pbsynmsg = "pbscript";
3004our $pbdisplaytype = "text";
3005our $pblocale = "";
3006pb_log_init($pbdebug, $pbLOG);
3007EOF
3008    print SCRIPT << "EOF";
3009\$Global::pb_stop_on_error = $Global::pb_stop_on_error;
3010pb_temp_init($pbkeep);
3011pb_conf_init("$ENV{'PBPROJ'}");
3012
3013EOF
3014
3015    # Launch the VM/VE/RM - Usage of snapshot disabled
3016    ($vmexist,$vmpid) = pb_launchv($vtype,$v,0,0,0);
3017
3018    my $keyfile;
3019    my $nport;
3020    my $vmhost;
3021
3022    # Prepare the key to be used and transfered remotely
3023    $keyfile = pb_ssh_get(1);
3024       
3025    if ($vtype =~ /(v|r)m/) {
3026        my ($vmport);
3027        ($vmhost,$vmport) = pb_conf_get($vtype."host",$vtype."port");
3028        $nport = pb_get_port($vmport,$pbos,$vtype);
3029   
3030        # Skip that VM/RM if something went wrong
3031        next if (($vmpid == 0) && ($vmexist == 0));
3032   
3033        # Store the pub key part in a variable
3034        open(FILE,"$keyfile.pub") || die "Unable to open $keyfile.pub";
3035        ($zero0,$zero1,$zero2) = split(/ /,<FILE>);
3036        close(FILE);
3037
3038        $key = "\Q$zero1";
3039
3040        # We call true to avoid problems if SELinux is not activated, but chcon is present and returns in that case 1
3041        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");
3042        # once this is done, we can do what we need on the VM/RM remotely
3043    } elsif ($vtype eq "ve") {
3044        print SCRIPT << "EOF";
3045# For VE we need a good null dev
3046pb_system("rm -f /dev/null; mknod /dev/null c 1 3; chmod 777 /dev/null");
3047
3048# For VE we first need to mount some FS
3049pb_system("mount -t proc /proc /proc") unless (-d "/proc/$$");
3050
3051EOF
3052    } else {
3053        die "Unknown virtual type $vtype";
3054    }
3055
3056    if ($vtype =~ /(v|r)m/) {
3057        print SCRIPT << 'EOF';
3058# Removes duplicate in .ssh/authorized_keys of our key if needed
3059#
3060my $file1="$ENV{'HOME'}/.ssh/authorized_keys";
3061open(PBFILE,$file1) || die "Unable to open $file1";
3062open(PBOUT,"> $file1.new") || die "Unable to open $file1.new";
3063my $count = 0;
3064while (<PBFILE>) {
3065
3066EOF
3067        print SCRIPT << "EOF";
3068    if (/ $key /) {
3069        \$count++;
3070    }
3071print PBOUT \$_ if ((\$count <= 1) || (\$_ !~ / $key /));
3072}
3073close(PBFILE);
3074close(PBOUT);
3075rename("\$file1.new",\$file1);
3076chmod 0600,\$file1;
3077
3078EOF
3079    }
3080    print SCRIPT << 'EOF';
3081
3082# Adds $pbac->{$ENV{'PBPROJ'}} as an account if needed
3083#
3084my $file="/etc/passwd";
3085open(PBFILE,$file) || die "Unable to open $file";
3086my $found = 0;
3087while (<PBFILE>) {
3088EOF
3089    print SCRIPT << "EOF";
3090    \$found = 1 if (/^$pbac->{$ENV{'PBPROJ'}}:/);
3091EOF
3092
3093# TODO: use an external parameter
3094my $home = "/home";
3095# Solaris doesn't like that we use /home
3096$home = "/export/home" if ($pbos->{'type'} eq "pkg");
3097
3098    print SCRIPT << "EOF";
3099}
3100close(PBFILE);
3101
3102if ( \$found == 0 ) {
3103    if ( ! -d "$home" ) {
3104        pb_mkdir_p("$home");
3105    }
3106EOF
3107    # TODO: Level of portability of these cmds ? Critical now for RM
3108    # TODO: Check existence before adding to avoid errors
3109    print SCRIPT << "EOF";
3110pb_system("/usr/sbin/groupadd $pbac->{$ENV{'PBPROJ'}}","Adding group $pbac->{$ENV{'PBPROJ'}}");
3111pb_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'}})");
3112}
3113EOF
3114
3115    # Copy the content of our local conf file to the VM/VE/RM
3116    my $content = pb_get_content(pb_distro_conffile());
3117    print SCRIPT << "EOF";
3118    #
3119    # Create a temporary local conf file for distribution support
3120    # This is created here before its use later. Its place is hardcoded, so no choice for the path
3121    #
3122    my \$tempconf = pb_distro_conffile();
3123    pb_mkdir_p(dirname(\$tempconf));
3124    open(CONF,"> \$tempconf") || die "Unable to create \$tempconf";
3125    print CONF q{$content};
3126    close(CONF);
3127EOF
3128
3129    if ($vtype =~ /(v|r)m/) {
3130        print SCRIPT << "EOF";
3131# allow ssh entry to build
3132#
3133mkdir "$home/$pbac->{$ENV{'PBPROJ'}}/.ssh",0700;
3134# Allow those accessing root to access the build account
3135copy("\$ENV{'HOME'}/.ssh/authorized_keys","$home/$pbac->{$ENV{'PBPROJ'}}/.ssh/authorized_keys");
3136chmod 0600,".ssh/authorized_keys";
3137pb_system("chown -R $pbac->{$ENV{'PBPROJ'}}:$pbac->{$ENV{'PBPROJ'}} $home/$pbac->{$ENV{'PBPROJ'}}","Finish setting up the account env for $pbac->{$ENV{'PBPROJ'}}");
3138
3139EOF
3140}
3141    print SCRIPT << 'EOF';
3142# No passwd for build account only keys
3143$file="/etc/shadow";
3144if (-f $file) {
3145    open(PBFILE,$file) || die "Unable to open $file";
3146    open(PBOUT,"> $file.new") || die "Unable to open $file.new";
3147    while (<PBFILE>) {
3148EOF
3149    print SCRIPT << "EOF";
3150        s/^$pbac->{$ENV{'PBPROJ'}}:\!\!:/$pbac->{$ENV{'PBPROJ'}}:*:/;
3151        s/^$pbac->{$ENV{'PBPROJ'}}:\!:/$pbac->{$ENV{'PBPROJ'}}:*:/; #SLES 9 e.g.
3152        s/^$pbac->{$ENV{'PBPROJ'}}:\\*LK\\*:/$pbac->{$ENV{'PBPROJ'}}:NP:/;  #Solaris e.g.
3153EOF
3154        print SCRIPT << 'EOF';
3155        print PBOUT $_;
3156    }
3157    close(PBFILE);
3158    close(PBOUT);
3159    rename("$file.new",$file);
3160    chmod 0640,$file;
3161    }
3162
3163# Keep the VM in text mode
3164$file="/etc/inittab";
3165if (-f $file) {
3166    open(PBFILE,$file) || die "Unable to open $file";
3167    open(PBOUT,"> $file.new") || die "Unable to open $file.new";
3168    while (<PBFILE>) {
3169        s/^(..):5:initdefault:$/$1:3:initdefault:/;
3170        print PBOUT $_;
3171    }
3172    close(PBFILE);
3173    close(PBOUT);
3174    rename("$file.new",$file);
3175    chmod 0640,$file;
3176}
3177
3178# pb has to be added to portage group on gentoo
3179
3180# We need to have that pb_distro_get_context function
3181# Get it from Project-Builder::Distribution
3182# And we now need the conf file required for this to work created above
3183
3184my $pbos = pb_distro_get_context(); 
3185print "distro tuple: ".Dumper($pbos)."\n";
3186
3187# Adapt sudoers
3188# sudo is not default on Solaris and needs to be installed first
3189# from http://www.sunfreeware.com/programlistsparc10.html#sudo
3190if ($pbos->{'type'} eq "pkg") {
3191    $file="/usr/local/etc/sudoers";
3192} else {
3193    $file="/etc/sudoers";
3194}
3195open(PBFILE,$file) || die "Unable to open $file";
3196open(PBOUT,"> $file.new") || die "Unable to open $file.new";
3197while (<PBFILE>) {
3198EOF
3199    # Skip what will be generated
3200    print SCRIPT << "EOF";
3201    next if (/^$pbac->{$ENV{'PBPROJ'}}\\s+/);
3202    next if (/^Defaults:$pbac->{$ENV{'PBPROJ'}}\\s+/);
3203    next if (/^Defaults:root \!requiretty/);
3204    next if (/^Defaults:root env_keep/);
3205EOF
3206    print SCRIPT << 'EOF';
3207    s/Defaults\s+requiretty/# disable Defaults: requiretty/;
3208    print PBOUT $_;
3209}
3210close(PBFILE);
3211EOF
3212    print SCRIPT << "EOF";
3213# Some distro force requiretty at compile time, so disable here
3214print PBOUT "Defaults:$pbac->{$ENV{'PBPROJ'}} !requiretty\n";
3215print PBOUT "Defaults:root !requiretty\n";
3216# Keep proxy configuration while using sudo
3217print PBOUT "Defaults:$pbac->{$ENV{'PBPROJ'}}    env_keep += \\\"http_proxy ftp_proxy\\\"\n";
3218print PBOUT "Defaults:root    env_keep += \\\"http_proxy ftp_proxy\\\"\n";
3219EOF
3220    # Try to restrict security to what is really needed
3221    if ($vtype =~ /^vm/) {
3222        my $hpath = pb_distro_get_param($pbos,pb_conf_get("ospathcmd-halt"));
3223        my @sudocmds = pb_get_sudocmds($pbos,$ntpline,"sudo $hpath");
3224        print SCRIPT << "EOF";
3225# This is needed in order to be able on VM to halt the machine from the $pbac->{$ENV{'PBPROJ'}} account at least
3226# Build account $pbac->{$ENV{'PBPROJ'}} in VM also needs to setup date and install deps.
3227# Nothing else should be needed
3228EOF
3229        foreach my $c (@sudocmds) {
3230            print SCRIPT "print PBOUT \"$pbac->{$ENV{'PBPROJ'}}   ALL = NOPASSWD: $c\\n\";\n";
3231        }
3232    } elsif ($vtype =~ /^rm/) {
3233        my @sudocmds = pb_get_sudocmds($pbos,$ntpline);
3234        print SCRIPT << "EOF";
3235# Build account $pbac->{$ENV{'PBPROJ'}} in RM only needs to setup date and install deps if needed each time
3236EOF
3237        foreach my $c (@sudocmds) {
3238            print SCRIPT "print PBOUT \"$pbac->{$ENV{'PBPROJ'}}   ALL = NOPASSWD: $c\\n\";\n";
3239        }
3240    } else {
3241        print SCRIPT << "EOF";
3242# Build account $pbac->{$ENV{'PBPROJ'}} for VE needs to do a lot in the host (and chroot), so allow without restriction for now
3243print PBOUT "$pbac->{$ENV{'PBPROJ'}}   ALL=(ALL) NOPASSWD:ALL\n";
3244EOF
3245}
3246    print SCRIPT << 'EOF';
3247close(PBOUT);
3248rename("$file.new",$file);
3249chmod 0440,$file;
3250
3251EOF
3252
3253    if ($vtype =~ /(v|r)m/) {
3254        # Sync date
3255        # do it after sudoers is setup
3256        print SCRIPT "pb_system(\"$ntpline\");\n";
3257    }
3258    # We may need a proxy configuration. Get it from the local env
3259    my $ftp_proxy = pb_distro_get_param($pbos,pb_conf_get_if("ftp_proxy"));
3260    my $http_proxy = pb_distro_get_param($pbos,pb_conf_get_if("http_proxy"));
3261
3262    $ENV{'ftp_proxy'} ||= $ftp_proxy if ((defined $ftp_proxy) && ($ftp_proxy ne ""));
3263    $ENV{'http_proxy'} ||= $http_proxy if ((defined $http_proxy) && ($http_proxy ne ""));
3264
3265    if (defined $ENV{'http_proxy'}) {
3266        print SCRIPT "\$ENV\{'http_proxy'\}=\"$ENV{'http_proxy'}\";\n";
3267    }
3268
3269    if (defined $ENV{'ftp_proxy'}) {
3270        print SCRIPT "\$ENV\{'ftp_proxy'\}=\"$ENV{'ftp_proxy'}\";\n";
3271    }
3272
3273    print SCRIPT << 'EOF';
3274   
3275# Suse wants sudoers as 640
3276if ((($pbos->{'name'} eq "sles") && (($pbos->{'version'} =~ /10/) || ($pbos->{'version'} =~ /9/))) || (($pbos->{'name'} eq "opensuse") && ($pbos->{'version'} =~ /10.[012]/))) {
3277    chmod 0640,$file;
3278}
3279
3280# First install all required packages
3281pb_system("yum clean all","Cleaning yum env") if (($pbos->{'name'} eq "fedora") || ($pbos->{'name'} eq "asianux") || ($pbos->{'name'} eq "rhel"));
3282my ($ospkgdep) = pb_conf_get_if("ospkgdep");
3283   
3284my $pkgdep = pb_distro_get_param($pbos,$ospkgdep);
3285pb_distro_installdeps(undef,$pbos,pb_distro_only_deps_needed($pbos,join(' ',split(/,/,$pkgdep))));
3286
3287EOF
3288    my $itype = pb_distro_get_param($pbos,pb_conf_get("pbinstalltype"));
3289    # Install from sandbox mean a file base install
3290    $itype = "file" if (defined $sbx);
3291    if ($itype =~ /^file/) {
3292        my $cmdget;
3293        if (defined $sbx) {
3294            # Install from sandbox mean using the result of the just passed sbx2build command
3295            # Get content saved in cms2build
3296            my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
3297            my $pbextdir = pb_get_extdir();
3298            die "Unable to get package list" if (not defined $pkg);
3299
3300            # We consider 2 specific packages
3301            my $vertag1 = $pkg->{"ProjectBuilder"};
3302            my $vertag2 = $pkg->{"project-builder"};
3303            # get the version of the current package - maybe different
3304            pb_log(2,"Vertag1: $vertag1\n");
3305            pb_log(2,"Vertag2: $vertag2\n");
3306            my ($pbver1,$tmp1) = split(/-/,$vertag1);
3307            my ($pbver2,$tmp2) = split(/-/,$vertag2);
3308            # Copy inside the VE
3309            if ($vtype eq "ve") {
3310                my ($vepath) = pb_conf_get("vepath");
3311                copy("$ENV{'PBDESTDIR'}/ProjectBuilder-$pbver1$pbextdir.tar.gz","$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/tmp");
3312                copy("$ENV{'PBDESTDIR'}/project-builder-$pbver2$pbextdir.tar.gz","$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/tmp");
3313            } else {
3314                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.");
3315            }
3316            $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";
3317        } else {
3318            # TODO: shouldn't we have a variable to specify the source file?
3319            # And shouldn't we be getting the one that matches the current pb version?
3320            # For the moment, just take the latest stable one
3321            $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";
3322        }
3323        print SCRIPT << 'EOF';
3324# Then install manually the missing perl modules
3325my ($osperldep,$osperlver) = pb_conf_get_if("osperldep","osperlver");
3326   
3327my $perldep = pb_distro_get_param($pbos,$osperldep);
3328foreach my $m (split(/,/,$perldep)) {
3329    # Skip empty deps
3330    next if ($m =~ /^\s*$/);
3331    my $dir = $m;
3332    $dir =~ s/-.*//;
3333    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}");
3334}
3335EOF
3336        print SCRIPT << 'EOF';
3337pb_system("rm -rf ProjectBuilder-* ; rm -rf project-builder-* ; rm -rf `perl -V:installvendorlib  | awk -F\"'\" '{print \$2}'`/ProjectBuilder ;
3338EOF
3339        print SCRIPT " $cmdget ; ";
3340        print SCRIPT << 'EOF'
3341gzip -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");
3342EOF
3343    } elsif ($itype =~ /^pkg/) {
3344        # pkg based install. We need to point to the project-builder.org repository
3345        print SCRIPT << 'EOF';
3346my $pkgforpb = pb_distro_get_param($pbos,pb_conf_get_if("ospkg"));
3347pb_distro_setuposrepo($pbos);
3348pb_distro_installdeps(undef,$pbos,pb_distro_only_deps_needed($pbos,join(' ',split(/,/,$pkgforpb))));
3349EOF
3350    } else {
3351        # Unknown install type
3352        die("Unknown install type $itype->{$ENV{'PBPROJ'}} for param pbinstalltype");
3353    }
3354    print SCRIPT << 'EOF';
3355pb_system("pb 2>&1 | head -5",undef,"verbose");
3356pb_system("pbdistrocheck",undef,"verbose");
3357EOF
3358    if ($vtype eq "ve") {
3359            print SCRIPT << 'EOF';
3360# For VE we need to umount some FS at the end
3361
3362pb_system("umount /proc");
3363
3364# Create a basic network file if not already there
3365
3366my $nf="/etc/sysconfig/network";
3367if ((! -f $nf) && ($pbos->{'type'} eq "rpm") && ($pbos->{'family'} ne "novell")) {
3368    open(NF,"> $nf") || die "Unable to create $nf";
3369    print NF "NETWORKING=yes\n";
3370    print NF "HOSTNAME=localhost\n";
3371    close(NF);
3372}
3373chmod 0755,$nf;
3374EOF
3375    }
3376
3377    # Adds pb_distro_get_context and all functions needed from ProjectBuilder::Distribution, Conf and Base
3378    foreach my $m ("ProjectBuilder/Base.pm","ProjectBuilder/Distribution.pm","ProjectBuilder/Conf.pm") {
3379        foreach my $d (@INC) {
3380            my $f = "$d/$m";
3381            if (-f "$f") {
3382                open(PBD,"$f") || die "Unable to open $f: $!";
3383                while (<PBD>) {
3384                    next if (/^package/);
3385                    next if (/^use Exporter/);
3386                    next if (/^use ProjectBuilder::/);
3387                    next if (/^our /);
3388                    print SCRIPT $_;
3389                }
3390                close(PBD);
3391                # We just need the first one of each file wrt @INC - hopefully that's the right one.
3392                last;
3393            }
3394        }
3395    }
3396    # Use a fake pb_version_init version here
3397    print SCRIPT << "EOF";
3398sub pb_version_init {
3399
3400return("$projectbuilderver","$projectbuilderrev");
3401}
34021;
3403EOF
3404    close(SCRIPT);
3405    chmod 0755,"$pbscript";
3406
3407    # That build script needs to be run as root and force stop of VM at end
3408    $pbaccount = "root";
3409
3410    # Force shutdown of VM except if it was already launched
3411    my $pbforce = 0;
3412    if ((! $vmexist) && ($vtype eq "vm")) {
3413        $pbforce = 1;
3414    }
3415   
3416    pb_script2v($pbscript,$vtype,$pbforce,$v);
3417    $pm->finish if (defined $pbparallel);
3418}
3419$pm->wait_all_children if (defined $pbparallel);
3420die "Aborting, one or more of the children failed." if ((not $all_ok) && ($Global::pb_stop_on_error));
3421return;
3422}
3423
3424# Function to create a snapshot named 'pb' for VMs and a compressed tar for VEs
3425sub pb_snap2v {
3426
3427my $vtype = shift;
3428
3429my ($vm,$all) = pb_get2v($vtype);
3430
3431# Script generated
3432my $pbscript = "$ENV{'PBDESTDIR'}/snapv";
3433
3434my ($pbac) = pb_conf_get($vtype."login");
3435
3436foreach my $v (@$vm) {
3437    if ($vtype eq "ve") {
3438        # Get distro context
3439        my $pbos = pb_distro_get_context($v);
3440        my ($vepath) = pb_conf_get("vepath");
3441
3442        # Test if an existing snapshot exists and remove it if there is a VE
3443        if ((-f "$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}.tar.gz") &&
3444            (! -d "$vepath->{$ENV{'PBPROJ'}}/$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}")) {
3445                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");
3446        }
3447    }
3448
3449    # Prepare the script to be executed on the VM/VE
3450    open(SCRIPT,"> $pbscript") || die "Unable to create $pbscript";
3451    print SCRIPT << 'EOF';
3452    #!/bin/bash
3453    sleep 2
3454EOF
3455    close(SCRIPT);
3456    chmod 0755,"$pbscript";
3457
3458    # Force shutdown of VM/VE
3459    # Force snapshot of VM/VE
3460    pb_script2v($pbscript,$vtype,1,$v,1);
3461}
3462return;
3463}
3464
3465# Function to update VMs/VEs/RMs with the latest distribution content
3466sub pb_update2v {
3467
3468my $vtype = shift;
3469
3470my ($vm,$all) = pb_get2v($vtype);
3471
3472# Script generated
3473my $pbscript = "$ENV{'PBDESTDIR'}/updatev";
3474
3475my ($pbac) = pb_conf_get($vtype."login");
3476
3477foreach my $v (@$vm) {
3478    # Get distro context
3479    my $pbos = pb_distro_get_context($v);
3480
3481    # Prepare the script to be executed on the VM/VE/RM
3482    # in $ENV{'PBDESTDIR'}/updatev
3483    open(SCRIPT,"> $pbscript") || die "Unable to create $pbscript";
3484   
3485    print SCRIPT << 'EOF';
3486    #!/bin/bash
3487    sleep 2
3488EOF
3489    # VE needs a good /proc
3490    if ($vtype eq "ve") {
3491        print SCRIPT "sudo /bin/mount -t proc /proc /proc\n";
3492    }
3493    print SCRIPT "$pbos->{'update'}\n";
3494    if ($vtype eq "ve") {
3495        print SCRIPT "sudo /bin/umount /proc\n";
3496    }
3497    close(SCRIPT);
3498    chmod 0755,"$pbscript";
3499
3500    # Force shutdown of VM except
3501    pb_script2v($pbscript,$vtype,1,$v);
3502}
3503return;
3504}
3505
3506sub pb_announce {
3507
3508    my $antype = shift;
3509
3510    # Get all required parameters
3511    my ($pbpackager,$pbrepo,$pbml,$pbsmtp) = pb_conf_get("pbpackager","pbrepo","pbml","pbsmtp");
3512    my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
3513    if (((not defined $testver) || (not defined $testver->{$ENV{'PBPROJ'}}) || ($testver->{$ENV{'PBPROJ'}} !~ /true/i)) && ($antype eq "Clean")) {
3514        # We just clean for test versions
3515        pb_log(0,"Unable to clean SSH repository for non testver version\n");
3516        return;
3517    }
3518    my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
3519    my @pkgs = @$pkg;
3520    my %pkgs;
3521    my $first = 0;
3522
3523    # Get all distros concerned
3524    my $pbos = pb_distro_get_context();
3525    my $distrolist = pb_get_distros($pbos,undef);
3526    my %dl;
3527    my %theorlist;
3528    my %archlist;
3529    foreach my $d (split(/,/,$distrolist)) {
3530        my ($d1,$d2,$d3) = split(/-/,$d);
3531        $dl{$d1}++;
3532    }
3533
3534    # Command to find packages on repo
3535    my $findstr = "find ".join(" ",keys %dl)." ";
3536    my $srcstr = "";
3537    # Generated announce files
3538    my @files;
3539
3540    foreach my $pbpkg (@pkgs) {
3541        if ($first != 0) {
3542            $findstr .= "-o ";
3543        }
3544        $first++;
3545        if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
3546            $pbver = $pkgv->{$pbpkg};
3547        } else {
3548            $pbver = $ENV{'PBPROJVER'};
3549        }
3550        if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
3551            $pbtag = $pkgt->{$pbpkg};
3552        } else {
3553            $pbtag = $ENV{'PBPROJTAG'};
3554        }
3555
3556        # TODO: use virtual/real names here now
3557        my $pbrealpkg = $pbpkg;
3558        my $pbrealpkgrpm = pb_cms_get_real_pkg($pbpkg,"rpm");
3559        my $pbrealpkgdeb = pb_cms_get_real_pkg($pbpkg,"deb");
3560        if ($antype eq "Clean") {
3561            # We only clean test versions anyway
3562            $pbtag = "0";
3563            my $nver = $pbver;
3564            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]";
3565            $pbver .= $ntag;
3566            $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\' ";
3567            $srcstr .= "src/$pbrealpkg-$pbver.tar.gz src/$pbrealpkg-$pbver.pbconf.tar.gz ";
3568        } else {
3569            my @date=pb_get_date();
3570            # the matching is only done on packages made the same day for test version. Hopefully this is enough
3571            my $nver = $pbver;
3572            if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i) && ($antype eq "Check")) {
3573                $pbtag = "0";
3574                my $ntag .= strftime("%Y%m%d*", @date);
3575                $nver = $pbver."_p$ntag";
3576                $pbver .= $ntag;
3577            }
3578            $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\' ";
3579        }
3580
3581        if ($antype eq "Announce") {
3582            my $chglog;
3583
3584            pb_cms_init($pbinit);
3585            # Get project info on log file and generate tmp files used later on
3586            $chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
3587            $chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
3588            $chglog = undef if (! -f $chglog);
3589
3590            open(OUT,"> $ENV{'PBTMP'}/$pbpkg.ann") || die "Unable to create $ENV{'PBTMP'}/$pbpkg.ann: $!";
3591            my $pb;
3592            $pb->{'realpkg'} = $pbrealpkg;
3593            $pb->{'ver'} = $pbver;
3594            $pb->{'tag'} = $pbtag;
3595            $pb->{'date'} = $pbdate;
3596            $pb->{'extdir'} = pb_get_extdir();
3597            $pb->{'chglog'} = $chglog;
3598            $pb->{'packager'} = $pbpackager;
3599            $pb->{'proj'} = $ENV{'PBPROJ'};
3600            $pb->{'repo'} = $pbrepo;
3601            $pb->{'pbos'}->{'type'} = "announce";
3602            $pb->{'pbos'}->{'suffix'} = "none";
3603            pb_changelog($pb,\*OUT,"yes");
3604            close(OUT);
3605            push(@files,"$ENV{'PBTMP'}/$pbpkg.ann");
3606        } elsif ($antype eq "Check") {
3607            # For the check we also build the theoritical complete list we should get
3608            foreach my $d (split(/,/,$distrolist)) {
3609                $pbos = pb_distro_get_context($d);
3610                if ($pbos->{'type'} eq "rpm") {
3611                    $theorlist{"$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/$pbrealpkgrpm-$pbver-$pbtag$pbos->{'suffix'}"} = 0;
3612                } elsif ($pbos->{'type'} eq "deb") {
3613                    $theorlist{"$pbos->{'name'}/$pbos->{'version'}/$pbrealpkgdeb"."_$pbver-$pbtag"} = 0;
3614                    # TODO are we always using the last arch ?
3615                    $archlist{"$pbos->{'name'}/$pbos->{'version'}/$pbrealpkgdeb"."_$pbver-$pbtag"} = "$pbos->{'arch'}";
3616                } elsif ($pbos->{'type'} eq "ebuild") {
3617                    my $prefix = "-r";
3618                    $prefix = "_p" if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i));
3619                    $theorlist{"$pbos->{'name'}/$pbos->{'version'}/$pbrealpkg-$pbver$prefix$pbtag.ebuild"} = 0;
3620                    $archlist{"$pbos->{'name'}/$pbos->{'version'}/$pbrealpkg-$pbver$prefix$pbtag.ebuild"} = "$pbos->{'arch'}";
3621                } elsif ($pbos->{'type'} eq "pkg") {
3622                    $theorlist{"$pbos->{'name'}/$pbos->{'version'}/$pbos->{'arch'}/$pbrealpkg-$pbver-$pbtag.pkg"} = 0;
3623                } else {
3624                    pb_log(1,"No theoritical list possible for type $pbos->{'type'}\n");
3625                }
3626            }
3627        }
3628        pb_log(2,"theorlist : ".Dumper(%theorlist)."\n");
3629    }
3630    if ($antype eq "Announce") {
3631        $findstr .= " | grep -Ev \'src.rpm\'";
3632    } elsif ($antype eq "Clean") {
3633        $findstr .= " | xargs rm -f -v $srcstr ";
3634    }
3635
3636    # Prepare the command to run and execute it
3637    open(PBS,"> $ENV{'PBTMP'}/pbscript") || die "Unable to create $ENV{'PBTMP'}/pbscript";
3638    print PBS "#!/bin/bash\n";
3639    print PBS "set -x\n" if ($pbdebug gt 1);
3640    print PBS "$findstr | sort 2> /dev/null\n";
3641    close(PBS);
3642    chmod 0755,"$ENV{'PBTMP'}/pbscript";
3643    pb_send2target("Announce");
3644
3645    my $sl = "Project $ENV{'PBPROJ'} version $ENV{'PBPROJVER'} is now available";
3646    if ($antype eq "Announce") {
3647        # Get subject line
3648        pb_log(0,"Please enter the title of your announce\n");
3649        pb_log(0,"(By default: $sl)\n");
3650        my $sl2 = <STDIN>;
3651        $sl = $sl2 if ($sl2 !~ /^$/);
3652
3653        # Prepare a template of announce
3654        open(ANN,"> $ENV{'PBTMP'}/announce.html") || die "Unable to create $ENV{'PBTMP'}/announce.html: $!";
3655        print ANN << "EOF";
3656$sl</p>
3657
3658<p>The project team is happy to announce the availability of a newest version of $ENV{'PBPROJ'} $ENV{'PBPROJVER'}. Enjoy it as usual!</p>
3659<p>
3660Now available at <a href="$pbrepo->{$ENV{'PBPROJ'}}">$pbrepo->{$ENV{'PBPROJ'}}</a>
3661</p>
3662<p>
3663EOF
3664    }
3665
3666    open(LOG,"$ENV{'PBTMP'}/system.$$.log") || die "Unable to read $ENV{'PBTMP'}/system.$$.log: $!";
3667    if ($antype eq "Announce") {
3668        my $col = 2;
3669        my $i = 1;
3670        print ANN << 'EOF';
3671<TABLE WIDTH="100%" CELLPADDING="0" CELLSPACING="0" BORDER="0">
3672<TR>
3673EOF
3674        while (<LOG>) {
3675            print ANN "<TD><A HREF=\"$pbrepo->{$ENV{'PBPROJ'}}/$_\">$_</A></TD>";
3676            $i++;
3677            if ($i > $col) {
3678                print ANN "</TR>\n<TR>";
3679                $i = 1;
3680            }
3681        }
3682    } elsif ($antype eq "Clean") {
3683        while (<LOG>) {
3684            # skip errors
3685            next if ($_ !~ /^removed /);
3686            pb_log(0,"$_");
3687        }
3688    } else {
3689        # In Check mode we need to compare the 2 lists (real and theoritical)
3690        while (<LOG>) {
3691            # Get package name and remove what is in extra for the theoritical list (arch at the end)
3692            chomp();
3693            # skip find errors
3694            next if (/^find:/);
3695            my $p = $_;
3696            $p =~ s/\.(i[3456]86|x86_64|noarch|src)\.rpm$//;
3697            $p =~ s/_(i[3456]86|amd64|all).deb$//;
3698            $p =~ s/(-0\.[0-9]{8})[0-9]{6}/$1*/ if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i));
3699            $p =~ s/(-r|_p[0-9]+)\.ebuild/$1*/ if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i));
3700            $theorlist{$p} = -2 if (not defined $theorlist{$p});
3701            $theorlist{$p} = $theorlist{$p} + 1;
3702        }
3703        pb_log(2,"theorlist : ".Dumper(%theorlist)."\n");
3704    }
3705    close(LOG);
3706
3707    # Nothing more for the cleanssh case
3708    return if ($antype eq "Clean");
3709
3710    if ($antype eq "Check") {
3711        my ($chkex) = pb_conf_get_if("checkexclude");
3712        my $vmbuildlist = "";
3713        my $vebuildlist = "";
3714        my $rmbuildlist = "";
3715        my @pt = pb_conf_get_if("vmlist","velist","rmlist");
3716        foreach my $t (sort keys %theorlist) {
3717            if (defined $theorlist{$t} and $theorlist{$t} >= 1) {
3718                pb_log(1,"Packages found for $t\n");
3719            } elsif (defined $theorlist{$t} and $theorlist{$t} < 0) {
3720                pb_log(0,"Extra Package found for $t\n");
3721            } else {
3722                pb_log(2,"Analyzing $t\n");
3723                my ($os,$ver,$arch,$package) = split(/\//,$t);
3724                # Some distro have no arch subdir
3725                if (not defined $package) {
3726                    $package = $arch;
3727                    # TODO: If both arch have failed, we just make the last one
3728                    $arch = $archlist{$t};
3729                }
3730                my $pbos = pb_distro_get_context("$os-$ver-$arch");
3731                my $pkgn = $package;
3732                if ($pbos->{'type'} ne "deb") {
3733                    # package name is more easily found from the end for non deb
3734                    # as '-' is the separator, but it can also be used in names
3735                    $pkgn = reverse($package);
3736                    # search the second '-' and isolate the now last part which is the full name
3737                    $pkgn =~ s/([^-]+)-([^-]+)-([\S])+$/$3/;
3738                } else {
3739                    $pkgn =~ s/([^_]+)_([\S])+$/$2/;
3740                }
3741                my $found = 0;
3742                # Handle the exclusion of OSes
3743                my $excl = "";
3744                $excl .= $chkex->{$pkgn} if (defined $chkex->{$pkgn});
3745                $excl .= $chkex->{"all"} if (defined $chkex->{"all"});
3746                foreach my $ex (split(/,/,$excl)) {
3747                    $found = 1 if ("$os-$ver-$arch" =~ /^$ex/);
3748                }
3749                # Skip as excluded
3750                next if ($found == 1);
3751                pb_log(0,"Package NOT found for $t\n");
3752                # Avoid duplicates in list
3753                next if ($vmbuildlist =~ /$os-$ver-$arch/);
3754                next if ($vebuildlist =~ /$os-$ver-$arch/);
3755                next if ($rmbuildlist =~ /$os-$ver-$arch/);
3756                # check with which method we need to build
3757                if ((defined $pt[0]->{$ENV{'PBPROJ'}}) and ($pt[0]->{$ENV{'PBPROJ'}} =~ /$os-$ver-$arch/)) {
3758                    $vmbuildlist = "$os-$ver-$arch" if ($vmbuildlist eq "");
3759                    $vmbuildlist .= ",$os-$ver-$arch" if ($vmbuildlist !~ /$os-$ver-$arch/);
3760                    next;
3761                }
3762                if ((defined $pt[1]->{$ENV{'PBPROJ'}}) and ($pt[1]->{$ENV{'PBPROJ'}} =~ /$os-$ver-$arch/)) {
3763                    $vebuildlist = "$os-$ver-$arch" if ($vebuildlist eq "");
3764                    $vebuildlist .= ",$os-$ver-$arch" if ($vebuildlist !~ /$os-$ver-$arch/);
3765                    next;
3766                }
3767                if ((defined $pt[2]->{$ENV{'PBPROJ'}}) and ($pt[2]->{$ENV{'PBPROJ'}} =~ /$os-$ver-$arch/)) {
3768                    $rmbuildlist = "$os-$ver-$arch" if ($rmbuildlist eq "");
3769                    $rmbuildlist .= ",$os-$ver-$arch" if ($rmbuildlist !~ /$os-$ver-$arch/);
3770                }
3771            }
3772        }
3773        # If we want to rebuild automatically, let's do it
3774        if (defined $opts{'rebuild'}) {
3775            # SandBox or CMS
3776            pb_log(0,"Rebuilding from SandBox\n");
3777            pb_log(0,"for VMs: $vmbuildlist\n") if ($vmbuildlist ne "");
3778            pb_log(0,"for VEs: $vebuildlist\n") if ($vebuildlist ne "");
3779            pb_log(0,"for RMs: $rmbuildlist\n") if ($rmbuildlist ne "");
3780            pb_cms2build("SandBox");
3781            # Which mode
3782            $ENV{'PBV'} = $vmbuildlist;
3783            pb_build2v("vm","build") if ($vmbuildlist ne "");
3784            $ENV{'PBV'} = $vebuildlist;
3785            pb_build2v("ve","build") if ($vebuildlist ne "");
3786            $ENV{'PBV'} = $rmbuildlist;
3787            pb_build2v("rm","build") if ($rmbuildlist ne "");
3788        }
3789        # For the check part this is now finished
3790        return;
3791    }
3792
3793    print ANN << "EOF";
3794</TR>
3795</TABLE>
3796</p>
3797
3798<p>As usual source packages are also available in the same directory.</p>
3799
3800<p>
3801Changes are :
3802</p>
3803<p>
3804EOF
3805    # Get each package changelog content
3806    foreach my $f (sort(@files)) {
3807        open(IN,"$f") || die "Unable to read $f:$!";
3808        while (<IN>) {
3809            print ANN $_;
3810        }
3811        close(IN);
3812        print ANN "</p><p>\n";
3813    }
3814    print ANN "</p>\n";
3815    close(ANN);
3816
3817    # Allow for modification
3818    my $editor = "vi";
3819    $editor = $ENV{'EDITOR'} if (defined $ENV{'EDITOR'});
3820    pb_system("$editor $ENV{'PBTMP'}/announce.html","Allowing modification of the announce","noredir");
3821
3822    # Store it in DB for external usage (Web pages generation)
3823    my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
3824
3825    my $precmd = "";
3826    if (! -f $db) {
3827        $precmd = "CREATE TABLE announces (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, announce VARCHAR[65535])";
3828    }
3829
3830    my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
3831                        { RaiseError => 1, AutoCommit => 1 })
3832                        || die "Unable to connect to $db";
3833
3834    if ($precmd ne "") {
3835        my $sth = $dbh->prepare(qq{$precmd})
3836                    || die "Unable to create table into $db";
3837        $sth->execute();
3838    }
3839
3840    # To read whole file
3841    local $/;
3842    open(ANN,"$ENV{'PBTMP'}/announce.html") || die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
3843    my $announce = <ANN>;
3844    close(ANN);
3845   
3846    pb_log(2,"INSERT INTO announces VALUES (NULL, $pbdate, $announce)");
3847    my $sth = $dbh->prepare(qq{INSERT INTO announces VALUES (NULL,?,?)})
3848                    || die "Unable to insert into $db";
3849    $sth->execute($pbdate, $announce);
3850    $sth->finish();
3851    $dbh->disconnect;
3852
3853    # Then deliver it on the Web
3854    # $TOOLHOME/livwww www
3855
3856    # Mail it to project's ML
3857    open(ML,"| w3m -dump -T text/html > $ENV{'PBTMP'}/announce.txt") || die "Unable to create $ENV{'PBTMP'}/announce.txt: $!";
3858    print ML << 'EOF';
3859<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/x html1/DTD/xhtml1-strict.dtd">
3860
3861<html xmlns="http://www.w3.org/1999/xhtml" dir="ltr" xml:lang="en" lang="en">
3862  <head>
3863  </head>
3864  <body>
3865  <p>
3866EOF
3867    open(ANN,"$ENV{'PBTMP'}/announce.html") || die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
3868    while(<ANN>) {
3869        print ML $_;
3870    }
3871    print ML << 'EOF';
3872</body>
3873</html>
3874EOF
3875    close(ML);
3876
3877    # To read whole file
3878    local $/;
3879    open(ANN,"$ENV{'PBTMP'}/announce.txt") || die "Unable to read $ENV{'PBTMP'}/announce.txt: $!";
3880    my $msg = <ANN>;
3881    close(ANN);
3882   
3883    # Preparation of headers
3884    eval
3885    {
3886        require Mail::Sendmail;
3887        Mail::Sendmail->import();
3888    };
3889    if ($@) {
3890        # Mail::Sendmail not found not sending mail !
3891        pb_log(0,"No Mail::Sendmail module found so not sending any mail !\n");
3892    } else {
3893        my %mail = (   
3894            To          =>  $pbml->{$ENV{'PBPROJ'}},
3895            From        =>  $pbpackager->{$ENV{'PBPROJ'}},
3896            Smtp        =>  $pbsmtp->{$ENV{'PBPROJ'}},
3897            Body        =>  $msg,
3898            Subject     =>  "[ANNOUNCE] $sl",
3899        );
3900           
3901        # Send mail
3902        if (! sendmail(%mail)) {
3903            if ((defined $Mail::Sendmail::error) and (defined $Mail::Sendmail::log)) {
3904                die "Unable to send mail ($Mail::Sendmail::error): $Mail::Sendmail::log";
3905            }
3906        }
3907    }
3908}
3909
3910#
3911# Creates a set of HTML file containing the news for the project
3912# based on what has been generated by the pb_announce function
3913#
3914sub pb_web_news2html {
3915
3916    my $dest = shift || $ENV{'PBTMP'};
3917
3918    # Get all required parameters
3919    my ($pkgv, $pkgt) = pb_conf_get_if("pkgver","pkgtag");
3920
3921    # DB of announces for external usage (Web pages generation)
3922    my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
3923
3924    my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
3925                        { RaiseError => 1, AutoCommit => 1 })
3926                        || die "Unable to connect to $db";
3927    # For date handling
3928    $ENV{LANGUAGE}="C";
3929    my $firstjan = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year(), 0, 0, -1);
3930    my $oldfirst = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year()-1, 0, 0, -1);
3931    pb_log(2,"firstjan: $firstjan, oldfirst: $oldfirst, pbdate:$pbdate\n");
3932    my $all = $dbh->selectall_arrayref("SELECT id,date,announce FROM announces ORDER BY date DESC");
3933    my %news;
3934    $news{"cy"} = "";   # current year's news
3935    $news{"ly"} = "";   # last year news
3936    $news{"py"} = "";   # previous years news
3937    $news{"fp"} = "";   # first page news
3938    my $cpt = 4;        # how many news for first page
3939    # Extract info from DB
3940    foreach my $row (@$all) {
3941        my ($id, $date, $announce) = @$row;
3942        $news{"cy"} = $news{"cy"}."<p><B>$date</B> $announce\n" if ((($date cmp $pbdate) le 0) && (($firstjan cmp $date) le 0));
3943        $news{"ly"} = $news{"ly"}."<p><B>$date</B> $announce\n" if ((($date cmp $firstjan) le 0) && (($oldfirst cmp $date) le 0));
3944        $news{"py"} = $news{"py"}."<p><B>$date</B> $announce\n" if (($date cmp $oldfirst) le 0);
3945        $news{"fp"} = $news{"fp"}."<p><B>$date</B> $announce\n" if ($cpt > 0);
3946        $cpt--;
3947    }
3948    pb_log(1,"news{fp}: ".$news{"fp"}."\n");
3949    $dbh->disconnect;
3950
3951    # Generate the HTML content
3952    foreach my $pref (keys %news) {
3953        open(NEWS,"> $dest/pb_web_$pref"."news.html") || die "Unable to create $dest/pb_web_$pref"."news.html: $!";
3954        print NEWS "$news{$pref}";
3955        close(NEWS);
3956    }
3957}
3958
3959
3960# Return the SSH key file to use
3961# Potentially create it if needed
3962
3963sub pb_ssh_get {
3964
3965my $create = shift || 0;    # Do not create keys by default
3966
3967my ($pbagent) = pb_conf_get_if("pbusesshagent");
3968# use ssh-agent if asked so.
3969return(undef) if (($create == 0) && (defined $pbagent->{$ENV{'PBPROJ'}}) && ($pbagent->{$ENV{'PBPROJ'}} =~ /true/io));
3970
3971# Check the SSH environment
3972my $keyfile = undef;
3973
3974# We have specific keys by default
3975$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
3976if (!(-e $keyfile) && ($create eq 1)) {
3977    pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
3978}
3979
3980$keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
3981$keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
3982$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
3983die "Unable to find your public ssh key under $ENV{'HOME'}/.ssh" if (not defined $keyfile);
3984return($keyfile);
3985}
3986
3987
3988# Returns the pid of a running VM command using a specific VM file
3989sub pb_check_ps {
3990    my $vmcmd = shift;
3991    my $vmm = shift;
3992    my $vmexist = 0;        # FALSE by default
3993
3994    open(PS, "ps auxhww|") || die "Unable to call ps";
3995    while (<PS>) {
3996        next if (! /$vmcmd/);
3997        next if (! /$vmm/);
3998        my ($void1, $void2);
3999        ($void1, $vmexist, $void2) = split(/ +/);
4000        last;
4001    }
4002    return($vmexist);
4003}
4004
4005
4006sub pb_extract_build_files {
4007
4008my $src=shift;
4009my $dir=shift;
4010my $ddir=shift;
4011my $mandatory=shift || "spec";
4012my @files;
4013
4014my $flag = "mayfail" if (($mandatory eq "patch") || ($mandatory eq "src"));
4015my $res;
4016
4017if ($src =~ /tar\.gz$/) {
4018    $res = pb_system("tar xfpz $src $dir","Extracting $mandatory files from $src",$flag);
4019} elsif ($src =~ /tar\.bz2$/) {
4020    $res = pb_system("tar xfpj $src $dir","Extracting $mandatory files from $src",$flag);
4021} else {
4022    die "Unknown compression algorithm for $src";
4023}
4024# If not mandatory return now
4025return() if (($res != 0) and (($mandatory eq "patch") || ($mandatory eq "src")));
4026opendir(DIR,"$dir") || die "Unable to open directory $dir: $!";
4027foreach my $f (readdir(DIR)) {
4028    next if ($f =~ /^\./);
4029    # Skip potential patch dir
4030    next if ($f =~ /^pbpatch/);
4031    # Skip potential source dir
4032    next if ($f =~ /^pbsrc/);
4033    # Skip potential backup files
4034    next if ($f =~ /~$/);
4035    move("$dir/$f","$ddir") || die "Unable to move $dir/$f to $ddir";
4036    pb_log(2,"mv $dir/$f $ddir\n");
4037    push @files,"$ddir/$f";
4038}
4039closedir(DIR);
4040# Not enough but still a first cleanup
4041pb_rm_rf("$dir");
4042return(@files);
4043}
4044
4045sub pb_list_bfiles {
4046
4047my $dir = shift;
4048my $pbpkg = shift;
4049my $bfiles = shift;
4050my $pkgfiles = shift;
4051my $supfiles = shift;
4052# subdir to keep if recursive mode, empty by default
4053my $subdir = shift || "";
4054# In a recursive function , we need a local var as DIR handle
4055my $bdir;
4056
4057pb_log(2,"DEBUG: entering pb_list_bfiles in $dir: ".Dumper($bfiles)."\n");
4058opendir($bdir,"$dir") || die "Unable to open dir $dir: $!";
4059foreach my $f (readdir($bdir)) {
4060    pb_log(3,"DEBUG: pb_list_bfiles found $f\n");
4061    next if ($f =~ /^\./);
4062    if (-d "$dir/$f") {
4063        # Recurse for directories (Debian 3.0 format e.g.)
4064        pb_log(2,"DEBUG: pb_list_bfiles recurse in $dir/$f\n");
4065        pb_list_bfiles("$dir/$f",$pbpkg,$bfiles,$pkgfiles,$supfiles,$f);
4066        next;
4067    }
4068
4069    my $key = $f;
4070    # if recursive then store also the subdir
4071    $key = "$subdir/$f" if ($subdir ne "");
4072    $bfiles->{$key} = "$dir/$f";
4073    $bfiles->{$key} =~ s~$ENV{'PBROOTDIR'}~~;
4074    if (defined $supfiles->{$pbpkg}) {
4075        $pkgfiles->{$key} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
4076    }
4077}
4078closedir($bdir);
4079pb_log(2,"DEBUG: exiting pb_list_bfiles: ".Dumper($bfiles)."\n");
4080}
4081
4082sub pb_add_coma {
4083
4084my $str = shift;
4085my $addstr = shift;
4086
4087$str .= "," if (defined $str);
4088$str .= $addstr;
4089return($str);
4090}
4091
4092sub pb_list_sfiles {
4093
4094my $sdir = shift;
4095my $ptr = shift;
4096my $pbos = shift;
4097my $extdir = shift;
4098
4099pb_log(2,"DEBUG: entering pb_list_sfiles: ".Dumper($ptr)."\n");
4100my $key = "$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}";
4101
4102# Prepare local sources for this distro - They are always applied first - May be a problem one day
4103# This function works for both patches and additional sources
4104foreach my $p (sort(<$sdir/*>)) {
4105    $ptr->{$key} = pb_add_coma($ptr->{$key},"file://$p") if (($p =~ /\.all$/) || ($p =~ /\.$pbos->{'os'}$/) || ($p =~ /\.$pbos->{'type'}$/) || ($p =~ /\.$pbos->{'family'}$/) || ($p =~ /\.$pbos->{'name'}$/) || ($p =~ /\.$pbos->{'name'}-$pbos->{'version'}$/) ||($p =~ /\.$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}$/));
4106}
4107
4108# Prepare also remote sources to be included - Applied after the local ones
4109foreach my $p ("all","$pbos->{'os'}","$pbos->{'type'}","$pbos->{'family'}","$pbos->{'name'}","$pbos->{'name'}-$pbos->{'version'}","$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}") {
4110    my $f = "$extdir.".".$p";
4111    next if (not -f $f);
4112    if (not open(PATCH,$f)) {
4113        pb_display("Unable to open existing external source file content $f\n");
4114        next;
4115    }
4116    while (<PATCH>) {
4117        chomp();
4118        $ptr->{$key} = pb_add_coma($ptr->{$key},"$_");
4119    }
4120    close(PATCH);
4121}
4122pb_log(2,"DEBUG: exiting pb_list_sfiles: ".Dumper($ptr)."\n");
4123return($ptr);
4124}
4125   
4126#
4127# Return the list of packages we are working on in a non CMS action
4128#
4129sub pb_get_pkg {
4130
4131my @pkgs = ();
4132
4133my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
4134@pkgs = keys %$var;
4135
4136pb_log(0,"Packages: ".join(',',@pkgs)."\n");
4137return(\@pkgs);
4138}
4139
4140# Manages VM/RM SSH port communication
4141sub pb_get_port {
4142
4143my $port = shift;
4144my $pbos = shift;
4145my $cmt = shift;
4146my $nport;
4147
4148die "No port passed in parameter. Report to dev team\n" if (not defined $port);
4149# key is project on VM, but machine tuple for RM
4150if ($cmt =~ /^RM/i) {
4151    $nport = $port->{"$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}"};
4152} else {
4153    $nport = $port->{$ENV{'PBPROJ'}};
4154}
4155pb_log(2,"pb_get_port with $nport\n");
4156# Maybe a port was given as parameter so overwrite
4157$nport = "$pbport" if (defined $pbport);
4158# 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
4159if (($cmt ne "Packages") && ($cmt !~ /^RM/i)) {
4160    $nport += $ENV{'PBVMPORT'} if ((defined $pbparallel) && (defined $ENV{'PBVMPORT'}));
4161}
4162pb_log(2,"pb_get_port returns $nport\n");
4163return($nport);
4164}
4165
4166sub pb_set_port { 
4167       
4168my ($pid,$ident) = @_;
4169pb_log(2,"pb_set_port for VM ($pid), id $ident\n");
4170$ENV{'PBVMPORT'} = $ident;
4171pb_log(2,"pb_set_port sets PBVMPORT in env to $ENV{'PBVMPORT'}\n");
4172}
4173
4174sub pb_set_parallel {
4175
4176my $vtype = shift;
4177
4178pb_log(2,"pb_set_parallel vtype: $vtype\n");
4179# Take care of memory size if VM, parallel mode and more than 1 action
4180if ((defined $pbparallel) && ($pbparallel ne 1) && ($vtype eq "vm")) {
4181    eval
4182    {
4183        require Linux::SysInfo;
4184        Linux::SysInfo->import();
4185    };
4186    if ($@) {
4187        # Linux::SysInfo not found
4188        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");
4189    } else {
4190        # Using the memory size
4191        my $si = Linux::SysInfo::sysinfo();
4192        if (not defined $si) {
4193            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");
4194        } else {
4195            # Keep the number of VM whose memory can be allocated
4196            my $ram = $si->{"totalram"}-$si->{"sharedram"}-$si->{"bufferram"};
4197            my $ram2;
4198            my ($vmmem) = pb_conf_get_if("vmmem");
4199
4200            my $v = "default";
4201            if ((defined $vmmem) and (defined $vmmem->{$v})) {
4202                $ram2 = $vmmem->{$v};
4203            } else {
4204                # Default for KVM/QEMU
4205                $ram2 = 128;
4206            }
4207            $pbparallel = sprintf("%d",$ram/$ram2);
4208        }
4209        pb_log(1,"Using $pbparallel processes at a time\n");
4210    }
4211}
4212pb_log(2,"pb_set_parallel returns: $pbparallel\n") if (defined $pbparallel);
4213return($pbparallel);
4214}
4215
4216sub pb_get_sudocmds { 
4217       
4218my $pbos = shift;
4219my %sudocmds;
4220
4221pb_log(2,"pb_get_sudocmds entering with lines:".Dumper(@_)."\n");
4222foreach my $c (split(/;/,$pbos->{'update'}),split(/;/,$pbos->{'install'}),@_) {
4223    pb_log(2,"pb_get_sudocmds analyses $c\n");
4224    next if ($c !~ /^\s*sudo/);
4225    # remove sudo and leading spaces
4226    $c =~ s/^\s*sudo\s+//;
4227    # keep only the command, not the params
4228    $c =~ s/([^\s]+)\s.*$/$1/;
4229    $sudocmds{$c} = "";
4230}
4231pb_log(2,"pb_get_sudocmds returns ".Dumper(keys %sudocmds)."\n");
4232return(keys %sudocmds);
4233}
4234
4235sub pb_sign_pkgs {
4236
4237my $pbos = shift;
4238my $made = shift;
4239
4240pb_log(2,"entering pb_sign_pkg: $made ".Dumper($pbos)."\n");
4241my ($passfile, $passphrase, $passpath) = pb_conf_get_if("pbpassfile","pbpassphrase","pbpasspath");
4242$ENV{'PBPASSPHRASE'} = $passphrase->{$ENV{'PBPROJ'}} if ((not defined $ENV{'PBPASSPHRASE'}) && (defined $passphrase->{$ENV{'PBPROJ'}}));
4243$ENV{'PBPASSFILE'} = $passfile->{$ENV{'PBPROJ'}} if ((not defined $ENV{'PBPASSFILE'})&& (defined $passfile->{$ENV{'PBPROJ'}})) ;
4244$ENV{'PBPASSPATH'} = $passpath->{$ENV{'PBPROJ'}} if ((not defined $ENV{'PBPASSPATH'})&& (defined $passpath->{$ENV{'PBPROJ'}})) ;
4245
4246# Remove extra spaces
4247$made =~ s/\s+/ /g;
4248$made =~ s/^\s//g;
4249$made =~ s/\s$//g;
4250
4251if ($pbos->{'type'} eq "rpm") {
4252    eval
4253    {
4254        require RPM4::Sign;
4255        RPM4::Sign->import();
4256    };
4257    if ($@) {
4258        # RPM4::Sign not found
4259        pb_log(1,"WARNING: Install RPM4::Sign to benefit from automatic package signing.\n");
4260    } else {
4261        return if ((not defined $ENV{'PBPASSPHRASE'}) and (not defined $ENV{'PBPASSFILE'}));
4262        my $sign = RPM4::Sign->new(
4263            passphrase => $ENV{'PBPASSPHRASE'},
4264            name => $ENV{'PBPACKAGER'},
4265            path => $ENV{'PBPASSPATH'},
4266            password_file => $ENV{'PBPASSFILE'}, 
4267        );
4268
4269        pb_log(0,"Signing RPM packages...\n");
4270        pb_log(2,"pb_sign_pkg: pkgs:".Dumper(split(/ /,$made))."\n");
4271        $sign->rpmssign(split(/ /,$made));
4272    }
4273} elsif ($pbos->{'type'} eq "deb") {
4274    my $changes = "";
4275    foreach my $c (split(/ /,$made)) {
4276        $changes .= " $ENV{'PBBUILDDIR'}/$c" if (($c =~ /\.changes$/) && (-f "$ENV{PBBUILDDIR}/$c"));
4277    }
4278    my $debsigncmd = pb_check_req("debsign",1);
4279    pb_system("$debsigncmd -m\'$ENV{'PBPACKAGER'}\' $changes","Signing DEB packages",undef,1) if ($changes ne "");
4280} else {
4281    pb_log(0,"I don't know yet how to sign packages for type $pbos->{'type'}.\nPlease give feedback to dev team\n");
4282}
4283pb_log(2,"exiting pb_sign_pkg\n");
4284}
4285
4286# return list of all distributins supported, coma separated
4287sub pb_get_distros {
4288
4289my $pbos = shift;
4290my $pbtarget = shift;
4291
4292my $tmpl = "$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'},";
4293
4294# Get list of distributions for which we need to generate build files if no target
4295if (not defined $pbtarget) {
4296    my @pt = pb_conf_get_if("vmlist","velist","rmlist");
4297    if (defined $pt[0]->{$ENV{'PBPROJ'}}) {
4298        $tmpl .= $pt[0]->{$ENV{'PBPROJ'}};
4299    }
4300    if (defined $pt[1]->{$ENV{'PBPROJ'}}) {
4301        # The 2 lists need to be grouped with a ',' separating them
4302        if ($tmpl ne "") {
4303            $tmpl .= ",";
4304        }
4305        $tmpl .= $pt[1]->{$ENV{'PBPROJ'}} 
4306    }
4307    if (defined $pt[2]->{$ENV{'PBPROJ'}}) {
4308        # The lists needs to be grouped with a ',' separating them
4309        if ($tmpl ne "") {
4310            $tmpl .= ",";
4311        }
4312    $tmpl .= $pt[2]->{$ENV{'PBPROJ'}} 
4313    }
4314}
4315return($tmpl);
4316}   
4317
4318sub pb_get_extdir () {
4319
4320    # the pbrc file should contain it and whatever the key, we take it
4321    my ($ed) = pb_conf_read("$ENV{'PBDESTDIR'}/pbrc","pbextdir");
4322    pb_log(2,"ed: ".Dumper($ed)."\n");
4323    my $pbextdir = "";
4324    foreach my $k (keys %$ed) {
4325        $pbextdir = $ed->{$k};
4326        # In case we have an empty field, empty it completely
4327        pb_log(2,"pbextdir: ***$pbextdir***\n");
4328        $pbextdir =~ s/^\s*$//;
4329    }
4330    pb_log(2,"pbextdir: ***$pbextdir***\n");
4331    return($pbextdir);
4332}
4333
43341;
Note: See TracBrowser for help on using the repository browser.