source: devel/pb/bin/pb @ 1555

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