source: devel/pb/bin/pb @ 1540

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