source: devel/pb/bin/pb @ 1546

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