source: devel/pb/bin/pb @ 1541

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