source: devel/pb/bin/pb @ 1348

Last change on this file since 1348 was 1348, checked in by Bruno Cornec, 9 years ago

r4374@localhost: bruno | 2011-10-25 12:10:59 +0200

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