source: devel/pb/bin/pb @ 1495

Last change on this file since 1495 was 1495, checked in by bruno, 7 years ago

r4735@localhost: bruno | 2012-05-07 03:46:39 +0200

  • Conf.pm largely rewritten to cache all conf files into a local $h hash in which conf files are added in reverse order.

The new pb_conf_hash stores a configuration file into a hash structure passed in parameter.
pb_conf_add now triggers the computation of the hash structure with pb_conf_cache and adds it to the main $h hash.
pb_conf_read_if now just uses the content in the $h hash to return its table.
pb_conf_get_in_hash_if function added to do the same as pb_conf_read_if on the cached $h hash instead of a configuration file.
pb_conf_get_if now uses pb_conf_get_in_hash_if and the $h hash without re-reading conf files
pb_conf_add_last_in_hash adds the content of a hash behind the content of the $h main hash (was done in pb_conf_get before)
pb_env_init now calls pb_conf_init to have PBPROJ defined when needed.
pb seems to work with this new version (builds itself)

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