source: devel/pb/bin/pb @ 1556

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

pb: Use new pbgpgcheck option to control whether we enable gpgcheck in the repo script. Problem is that signing failure is tolerated, so the rpms can be unsigned, but gpgcheck is on by default. Preserve those semantics by default, but allow for control. (Eric Anderson)

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