source: devel/pb/bin/pb @ 1545

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