source: ProjectBuilder/devel/pb/bin/pb@ 566

Last change on this file since 566 was 566, checked in by Bruno Cornec, 16 years ago

Fix a pod issue (=back in excess)

  • Property svn:executable set to *
File size: 75.4 KB
Line 
1#!/usr/bin/perl -w
2#
3# Project Builder main application
4#
5# $Id$
6#
7# Copyright B. Cornec 2007
8# Provided under the GPL v2
9
10# Syntax: see at end
11
12use strict 'vars';
13use Getopt::Long qw(:config auto_abbrev no_ignore_case);
14use Data::Dumper;
15use English;
16use File::Basename;
17use File::Copy;
18use File::stat;
19use File::Temp qw(tempdir);
20use Time::localtime qw(localtime);
21use POSIX qw(strftime);
22use lib qw (lib);
23use ProjectBuilder::Version;
24use ProjectBuilder::Base;
25use ProjectBuilder::Display;
26use ProjectBuilder::Conf;
27use ProjectBuilder::Distribution;
28use ProjectBuilder::CMS;
29use ProjectBuilder::Env;
30use ProjectBuilder::Filter;
31use ProjectBuilder::Changelog;
32use Mail::Sendmail;
33
34# Global variables
35my %opts; # CLI Options
36my $action; # action to realize
37my $test = "FALSE"; # Not used
38my $force = 0; # Force VE/VM rebuild
39my $option = ""; # Not used
40my @pkgs; # list of packages
41my $pbtag; # Global Tag variable
42my $pbver; # Global Version variable
43my $pbscript; # Name of the script
44my %pbver; # per package
45my %pbtag; # per package
46my $pbrev; # Global REVISION variable
47my $pbaccount; # Login to use to connect to the VM
48my $pbport; # Port to use to connect to the VM
49my $newver; # New version to create
50my $iso; # ISO image for the VM to create
51
52my @date = pb_get_date();
53my $pbdate = strftime("%Y-%m-%d", @date);
54
55=pod
56
57=head1 NAME
58
59pb, aka project-builder.org - builds packages for your projects
60
61=head1 DESCRIPTION
62
63pb helps you build various packages directly from your project sources.
64Those sources could be handled by a CMS (Configuration Management System)
65such as Subversion, CVS, ... or being a simple reference to a compressed tar file.
66It's based on a set of configuration files, a set of provided macros to help
67you keeping build files as generic as possible. For example, a single .spec
68file should be required to generate for all rpm based distributions, even
69if you could also have multiple .spec files if required.
70
71=head1 SYNOPSIS
72
73pb [-vhq][-r pbroot][-p project][[-s script -a account -P port][-m mach-1[,...]]][-i iso] <action> [<pkg1> ...]
74
75pb [--verbose][--help][--man][--quiet][--revision pbroot][--project project][[--script script --account account --port port][--machine mach-1[,...]]][--iso iso] <action> [<pkg1> ...]
76
77=head1 OPTIONS
78
79=over 4
80
81=item B<-v|--verbose>
82
83Print a brief help message and exits.
84
85=item B<-q|--quiet>
86
87Do not print any output.
88
89=item B<-h|--help>
90
91Print a brief help message and exits.
92
93=item B<--man>
94
95Prints the manual page and exits.
96
97=item B<-m|--machine machine1[,machine2,...]>
98
99Name of the Virtual Machines (VM) or Virtual Environments (VE) you want to build on (coma separated).
100All if none precised (or use the env variable PBV).
101
102=item B<-s|--script script>
103
104Name of the script you want to execute on the related VMs or VEs.
105
106=item B<-i|--iso iso_image>
107
108Name of the ISO image of the distribution you want to install on the related VMs.
109
110=item B<-a|--account account>
111
112Name of the account to use to connect on the related VMs.
113
114=item B<-P|--port port_number>
115
116Port number to use to connect on the related VMs.\n";
117
118=item B<-p|--project project_name>
119
120Name of the project you're working on (or use the env variable PBPROJ)
121
122=item B<-r|--revision revision>
123
124Path Name of the project revision under the CMS (or use the env variable PBROOT)
125
126=item B<-V|--version new_version>
127
128New version of the project to create based on the current one.
129
130=back
131
132=head1 ARGUMENTS
133
134<action> can be:
135
136=over 4
137
138=item B<cms2build>
139
140Create tar files for the project under your CMS.
141CMS supported are SVN and CVS
142parameters are packages to build
143if not using default list
144
145=item B<build2pkg>
146
147Create packages for your running distribution
148
149=item B<cms2pkg>
150
151cms2build + build2pkg
152
153=item B<build2ssh>
154
155Send the tar files to a SSH host
156
157=item B<cms2ssh>
158
159cms2build + build2ssh
160
161=item B<pkg2ssh>
162
163Send the packages built to a SSH host
164
165=item B<build2vm>
166
167Create packages in VMs, launching them if needed
168and send those packages to a SSH host once built
169VM type supported are QEMU
170
171=item B<build2ve>
172
173Create packages in VEs, creating it if needed
174and send those packages to a SSH host once built
175
176=item B<cms2vm>
177
178cms2build + build2vm
179
180=item B<cms2ve>
181
182cms2build + build2ve
183
184=item B<launchvm>
185
186Launch one virtual machine
187
188=item B<launchve>
189
190Launch one virtual environment
191
192=item B<script2vm>
193
194Launch one virtual machine if needed
195and executes a script on it
196
197=item B<script2ve>
198
199Execute a script in a virtual environment
200
201=item B<newvm>
202
203Create a new virtual machine
204
205=item B<newve>
206
207Create a new virtual environment
208
209=item B<setupvm>
210
211Setup a virtual machine for pb usage
212
213=item B<setupve>
214
215Setup a virtual environment for pb usage
216
217=item B<newver>
218
219Create a new version of the project derived
220from the current one
221
222=item B<newproj>
223
224Create a new project and a template set of
225configuration files under pbconf
226
227=item B<announce>
228
229Announce the availability of the project through various means
230
231=item B<web2ssh>
232
233Deliver the Web site content to the target server using ssh.
234
235=back
236
237<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).
238
239=head1 WEB SITES
240
241The 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/>.
242
243=head1 USER MAILING LIST
244
245None exists for the moment.
246
247=head1 CONFIGURATION FILES
248
249Each pb user may have a configuration in F<$HOME/.pbrc>. The values in this file may overwrite any other configuration file value.
250
251Here is an example of such a configuration file:
252
253 #
254 # Define for each project the URL of its pbconf repository
255 # No default option allowed here as they need to be all different
256 #
257 # URL of the pbconf content
258 # This is the format of a classical URL with the extension of additional schema such as
259 # svn+ssh, cvs+ssh, ...
260 #
261 pbconfurl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe/pbconf
262
263 # This is normaly defined in the project's configuration file
264 # Url of the project
265 #
266 pburl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe
267
268 # All these URLs needs to be defined here as the are the entry point
269 # for how to build packages for the project
270 #
271 pbconfurl pb = svn+ssh://svn.project-builder.org/mondo/svn/pb/pbconf
272 pbconfurl mondorescue = svn+ssh://svn.project-builder.org/mondo/svn/project-builder/mondorescue/pbconf
273 pbconfurl collectl = svn+ssh://bruno@svn.mondorescue.org/mondo/svn/project-builder/collectl/pbconf
274 pbconfurl netperf = svn+ssh://svn.mondorescue.org/mondo/svn/project-builder/netperf/pbconf
275
276 # Under that dir will take place everything related to pb
277 # If you want to use VMs/chroot/..., then use $ENV{'HOME'} to make it portable
278 # to your VMs/chroot/...
279 # if not defined then /var/cache
280 pbdefdir default = $ENV{'HOME'}/project-builder
281 pbdefdir pb = $ENV{'HOME'}
282 pbdefdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
283 pbdefdir mondorescue = $ENV{'HOME'}/mondo/svn
284
285 # pbconfdir points to the directory where the CMS content of the pbconfurl is checked out
286 # If not defined, pbconfdir is under pbdefdir/pbproj/pbconf
287 pbconfdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs/pbconf
288 pbconfdir mondorescue = $ENV{'HOME'}/mondo/svn/pbconf
289
290 # pbdir points to the directory where the CMS content of the pburl is checked out
291 # If not defined, pbdir is under pbdefdir/pbproj
292 # Only defined if we have access to the dev of the project
293 pbdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
294 pbdir mondorescue = $ENV{'HOME'}/mondo/svn
295
296 # -daemonize doesn't work with qemu 0.8.2
297 vmopt default = -m 384
298
299=head1 AUTHORS
300
301The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
302
303=head1 COPYRIGHT
304
305Project-Builder.org is distributed under the GPL v2.0 license
306described in the file C<COPYING> included with the distribution.
307
308=cut
309
310# ---------------------------------------------------------------------------
311
312# Old syntax
313#getopts('a:fhi:l:m:P:p:qr:s:vV:',\%opts);
314
315my ($projectbuilderver,$projectbuilderrev) = pb_version_init();
316
317# Initialize the syntax string
318
319pb_syntax_init("pb (aka project-builder.org) Version $projectbuilderver-$projectbuilderrev\n");
320
321GetOptions("help|?|h" => \$opts{'h'},
322 "man" => \$opts{'man'},
323 "verbose|v+" => \$opts{'v'},
324 "quiet|q" => \$opts{'q'},
325 "log-files|l=s" => \$opts{'l'},
326 "force|f" => \$opts{'f'},
327 "account|a=s" => \$opts{'a'},
328 "revision|r=s" => \$opts{'r'},
329 "script|s=s" => \$opts{'s'},
330 "machines|mock|m=s" => \$opts{'m'},
331 "port|P=i" => \$opts{'P'},
332 "project|p=s" => \$opts{'p'},
333 "iso|i=s" => \$opts{'i'},
334 "version|V=s" => \$opts{'V'},
335) || pb_syntax(-1,0);
336
337if (defined $opts{'h'}) {
338 pb_syntax(0,1);
339}
340if (defined $opts{'man'}) {
341 pb_syntax(0,2);
342}
343if (defined $opts{'v'}) {
344 $pbdebug = $opts{'v'};
345}
346if (defined $opts{'f'}) {
347 $force=1;
348}
349if (defined $opts{'q'}) {
350 $pbdebug=-1;
351}
352if (defined $opts{'l'}) {
353 open(pbLOG,"> $opts{'l'}") || die "Unable to log to $opts{'l'}: $!";
354 $pbLOG = \*pbLOG;
355 $pbdebug = 0 if ($pbdebug == -1);
356 }
357pb_log_init($pbdebug, $pbLOG);
358pb_display_init("text","");
359
360# Handle root of the project if defined
361if (defined $opts{'r'}) {
362 $ENV{'PBROOTDIR'} = $opts{'r'};
363}
364# Handle virtual machines if any
365if (defined $opts{'m'}) {
366 $ENV{'PBV'} = $opts{'m'};
367}
368if (defined $opts{'s'}) {
369 $pbscript = $opts{'s'};
370}
371if (defined $opts{'a'}) {
372 $pbaccount = $opts{'a'};
373 die "option -a requires a -s script option" if (not defined $pbscript);
374}
375if (defined $opts{'P'}) {
376 $pbport = $opts{'P'};
377}
378if (defined $opts{'V'}) {
379 $newver = $opts{'V'};
380}
381if (defined $opts{'i'}) {
382 $iso = $opts{'i'};
383}
384
385# Get Action
386$action = shift @ARGV;
387die pb_syntax(-1,1) if (not defined $action);
388
389my ($filteredfiles, $supfiles, $defpkgdir, $extpkgdir);
390my $pbinit = undef;
391$pbinit = 1 if ($action =~ /^newproj$/);
392
393# Handles project name if any
394# And get global params
395($filteredfiles, $supfiles, $defpkgdir, $extpkgdir) = pb_env_init($opts{'p'},$pbinit,$action);
396
397pb_log(0,"Project: $ENV{'PBPROJ'}\n");
398pb_log(0,"Action: $action\n");
399
400# Act depending on action
401if ($action =~ /^cms2build$/) {
402 pb_cms2build();
403} elsif ($action =~ /^build2pkg$/) {
404 pb_build2pkg();
405} elsif ($action =~ /^cms2pkg$/) {
406 pb_cms2build();
407 pb_build2pkg();
408} elsif ($action =~ /^build2ssh$/) {
409 pb_build2ssh();
410} elsif ($action =~ /^cms2ssh$/) {
411 pb_cms2build();
412 pb_build2ssh();
413} elsif ($action =~ /^pkg2ssh$/) {
414 pb_pkg2ssh();
415} elsif ($action =~ /^build2ve$/) {
416 pb_build2v("ve");
417} elsif ($action =~ /^build2vm$/) {
418 pb_build2v("vm");
419} elsif ($action =~ /^cms2ve$/) {
420 pb_cms2build();
421 pb_build2v("ve");
422} elsif ($action =~ /^cms2vm$/) {
423 pb_cms2build();
424 pb_build2v("vm");
425} elsif ($action =~ /^launchvm$/) {
426 pb_launchv("vm",$ENV{'PBV'},0);
427} elsif ($action =~ /^launchve$/) {
428 pb_launchv("ve",$ENV{'PBV'},0);
429} elsif ($action =~ /^script2vm$/) {
430 pb_script2v($pbscript,"vm");
431} elsif ($action =~ /^script2ve$/) {
432 pb_script2v($pbscript,"ve");
433} elsif ($action =~ /^newver$/) {
434 pb_newver();
435} elsif ($action =~ /^newve$/) {
436 pb_launchv("ve",$ENV{'PBV'},1);
437} elsif ($action =~ /^newvm$/) {
438 pb_launchv("vm",$ENV{'PBV'},1);
439} elsif ($action =~ /^setupve$/) {
440 pb_setup_v("ve");
441} elsif ($action =~ /^setupvm$/) {
442 pb_setup_v("vm");
443} elsif ($action =~ /^newproj$/) {
444 # Nothing to do - already done in pb_env_init
445} elsif ($action =~ /^clean$/) {
446 # TBC
447} elsif ($action =~ /^announce$/) {
448 # For announce only. Require avoids the systematic load of these modules
449 require DBI;
450 require DBD::SQLite;
451
452 pb_announce();
453} elsif ($action =~ /^web2ssh$/) {
454 require DBI;
455 require DBD::SQLite;
456
457 pb_cms2build("Web");
458 pb_send2target("Web");
459} else {
460 pb_log(0,"\'$action\' is not available\n");
461 pb_syntax(-2,1);
462}
463
464sub pb_cms2build {
465
466 my $param = shift || undef;
467
468 my $pkg;
469 my @pkgs;
470 my $webdir;
471
472 my %pkgs;
473 my %pb; # Structure to store conf info
474
475 # If Website, then pkg is only the website
476 if ((defined $param) && ($param eq "Web")) {
477 ($webdir) = pb_conf_get("webdir");
478 pb_log(2,"webdir: ".Dumper($webdir)."\n");
479 $pkgs[0] = $webdir->{$ENV{'PBPROJ'}};
480 $extpkgdir = $webdir;
481 pb_log(0,"Package: $pkgs[0]\n");
482 } else {
483 $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
484 @pkgs = @$pkg;
485 }
486
487 my ($scheme, $uri) = pb_cms_init($pbinit);
488
489 my ($pkgv, $pkgt) = pb_conf_get_if("pkgver","pkgtag");
490
491 # declare packager and repo for filtering
492 my ($tmp1, $tmp2) = pb_conf_get("pbpackager","pbrepo");
493 $ENV{'PBPACKAGER'} = $tmp1->{$ENV{'PBPROJ'}};
494 $ENV{'PBREPO'} = $tmp2->{$ENV{'PBPROJ'}};
495
496 foreach my $pbpkg (@pkgs) {
497 $ENV{'PBPKG'} = $pbpkg;
498 if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
499 $pbver = $pkgv->{$pbpkg};
500 } else {
501 $pbver = $ENV{'PBPROJVER'};
502 }
503 if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
504 $pbtag = $pkgt->{$pbpkg};
505 } else {
506 $pbtag = $ENV{'PBPROJTAG'};
507 }
508
509 $pbrev = $ENV{'PBREVISION'};
510 pb_log(0,"\n");
511 pb_log(0,"Management of $pbpkg $pbver-$pbtag (rev $pbrev)\n");
512 die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
513
514 # Clean up dest if necessary. The export will recreate it
515 my $dest = "$ENV{'PBDESTDIR'}/$pbpkg-$pbver";
516 pb_rm_rf($dest) if (-d $dest);
517
518 # Export CMS tree for the concerned package to dest
519 # And generate some additional files
520 $OUTPUT_AUTOFLUSH=1;
521
522 # computes in which dir we have to work
523 my $dir = $defpkgdir->{$pbpkg};
524 $dir = $extpkgdir->{$pbpkg} if (not defined $dir);
525 $dir = $webdir->{$ENV{'PBPROJ'}} if ((defined $param) && ($param eq "Web"));
526 pb_log(2,"def:".Dumper($defpkgdir)." ext: ".Dumper($extpkgdir)." \n");
527
528 # Exporting content from CMS
529 my $preserve = pb_cms_export($uri,"$ENV{'PBDIR'}/$dir",$dest);
530
531 # Generated fake content for test versions to speed up stuff
532 my ($testver) = pb_conf_get_if("testver");
533 my $chglog;
534
535 # Get project info on authors and log file
536 $chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
537 $chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
538 $chglog = undef if (! -f $chglog);
539
540 my $authors = "$ENV{'PBROOTDIR'}/$pbpkg/pbauthors";
541 $authors = "$ENV{'PBROOTDIR'}/pbauthors" if (! -f $authors);
542 $authors = "/dev/null" if (! -f $authors);
543
544 # Extract cms log history and store it
545 if ((defined $chglog) && (! -f "$dest/NEWS")) {
546 pb_log(2,"Generating NEWS file from $chglog\n");
547 copy($chglog,"$dest/NEWS") || die "Unable to create $dest/NEWS";
548 }
549 pb_cms_log($scheme,"$ENV{'PBDIR'}/$dir",$dest,$chglog,$authors,$testver);
550
551 my %build;
552 my @pt;
553 my $tmpl = "";
554 my %patches;
555
556 @pt = pb_conf_get_if("vmlist","velist");
557 if (defined $pt[0]->{$ENV{'PBPROJ'}}) {
558 $tmpl .= $pt[0]->{$ENV{'PBPROJ'}};
559 }
560 if (defined $pt[1]->{$ENV{'PBPROJ'}}) {
561 # the 2 lists needs to be grouped with a ',' separated them
562 if ($tmpl ne "") {
563 $tmpl .= ",";
564 }
565 $tmpl .= $pt[1]->{$ENV{'PBPROJ'}}
566 }
567
568 # Setup %pb structure to allow filtering later on, on files using that structure
569 $pb{'tag'} = $pbtag;
570 $pb{'rev'} = $pbrev;
571 $pb{'ver'} = $pbver;
572 $pb{'pkg'} = $pbpkg;
573 $pb{'date'} = $pbdate;
574 $pb{'defpkgdir'} = $defpkgdir;
575 $pb{'extpkgdir'} = $extpkgdir;
576 $pb{'chglog'} = $chglog;
577 $pb{'packager'} = $ENV{'PBPACKAGER'};
578 $pb{'proj'} = $ENV{'PBPROJ'};
579 $pb{'repo'} = $ENV{'PBREPO'};
580 $pb{'patches'} = \%patches;
581 pb_log(2,"DEBUG: pb: ".Dumper(%pb)."\n");
582
583 # Do not do that for website
584 if ((not defined $param) || ($param ne "Web")) {
585 foreach my $d (split(/,/,$tmpl)) {
586 my ($name,$ver,$arch) = split(/-/,$d);
587 chomp($arch);
588 my ($ddir, $dver, $dfam);
589 ($ddir, $dver, $dfam, $pb{'dtype'}, $pb{'suf'}) = pb_distro_init($name,$ver);
590 pb_log(2,"DEBUG: distro tuple: ".Dumper($ddir, $dver, $dfam, $pb{'dtype'}, $pb{'suf'})."\n");
591 pb_log(2,"DEBUG Filtering PBDATE => $pbdate, PBTAG => $pbtag, PBVER => $pbver\n");
592
593 # We need to compute the real name of the package
594 my $pbrealpkg = pb_cms_get_real_pkg($pbpkg,$pb{'dtype'});
595 $pb{'realpkg'} = $pbrealpkg;
596 pb_log(1,"Virtual package $pbpkg has a real package name of $pbrealpkg on $ddir-$dver\n") if ($pbrealpkg ne $pbpkg);
597
598 # Filter build files from the less precise up to the most with overloading
599 # Filter all files found, keeping the name, and generating in dest
600
601 # Find all build files first relatively to PBROOTDIR
602 # Find also all specific files referenced in the .pb conf file
603 my %bfiles = ();
604 my %pkgfiles = ();
605 $build{"$ddir-$dver-$arch"} = "yes";
606
607 if (-d "$ENV{'PBROOTDIR'}/$pbpkg/$pb{'dtype'}") {
608 pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$pb{'dtype'}",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
609 } elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$dfam") {
610 pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$dfam",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
611 } elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir") {
612 pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
613 } elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver") {
614 pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
615 } elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver-$arch") {
616 pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver-$arch",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
617 } else {
618 $build{"$ddir-$dver-$arch"} = "no";
619 next;
620 }
621 pb_log(2,"DEBUG bfiles: ".Dumper(\%bfiles)."\n");
622
623 # Get all filters to apply
624 my $ptr = pb_get_filters($pbpkg, $pb{'dtype'}, $dfam, $ddir, $dver);
625
626 # Prepare local patches for this distro - They are always applied first - May be a problem one day
627 foreach my $p (sort(<$ENV{'PBROOTDIR'}/$pbpkg/pbpatch/*>)) {
628 $patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.all$/));
629 $patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.all$/);
630 $patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$pb{'dtype'}$/));
631 $patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$pb{'dtype'}$/);
632 $patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$dfam$/));
633 $patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$dfam$/);
634 $patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir$/));
635 $patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir$/);
636 $patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir-$dver$/));
637 $patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir-$dver$/);
638 $patches{"$ddir-$dver-$arch"} .= "," if ((defined $patches{"$ddir-$dver-$arch"}) and ($p =~ /\.$ddir-$dver-$arch$/));
639 $patches{"$ddir-$dver-$arch"} .= "file://$p" if ($p =~ /\.$ddir-$dver-$arch$/);
640 }
641
642 # Prepare also remote patches to be included - Applied after the local ones
643 foreach my $p ("all","$pb{'dtype'}","$dfam","$ddir","$ddir-$dver","$ddir-$dver-$arch") {
644 my $f = "$ENV{'PBROOTDIR'}/$pbpkg/pbextpatch.$p";
645 next if (not -f $f);
646 if (not open(PATCH,$f)) {
647 pb_display("Unable to open existing external patch file content $f\n");
648 next;
649 }
650 while (<PATCH>) {
651 chomp();
652 $patches{"$ddir-$dver-$arch"} .= "," if (defined $patches{"$ddir-$dver-$arch"});
653 $patches{"$ddir-$dver-$arch"} .= "$_";
654 }
655 close(PATCH);
656 }
657 pb_log(2,"DEBUG: pb->patches: ".Dumper($pb{'patches'})."\n");
658
659 # Apply now all the filters on all the files concerned
660 # destination dir depends on the type of file
661 if (defined $ptr) {
662 # For patch support
663 $pb{'tuple'} = "$ddir-$dver-$arch";
664 foreach my $f (values %bfiles,values %pkgfiles) {
665 pb_filter_file("$ENV{'PBROOTDIR'}/$f",$ptr,"$dest/pbconf/$ddir-$dver-$arch/".basename($f),\%pb);
666 }
667 }
668 }
669 my @found;
670 my @notfound;
671 foreach my $b (keys %build) {
672 push @found,$b if ($build{$b} =~ /yes/);
673 push @notfound,$b if ($build{$b} =~ /no/);
674 }
675 pb_log(0,"Build files generated for ".join(',',sort(@found))."\n");
676 pb_log(0,"No Build files found for ".join(',',sort(@notfound))."\n") if (@notfound);
677 pb_log(2,"DEBUG: patches: ".Dumper(%patches)."\n");
678 }
679
680 # Get the generic filter (all.pbf) and
681 # apply those to the non-build files including those
682 # generated by pbinit if applicable
683
684 # Get only all.pbf filter
685 my $ptr = pb_get_filters($pbpkg);
686
687 my $liste ="";
688 if (defined $filteredfiles->{$pbpkg}) {
689 foreach my $f (split(/,/,$filteredfiles->{$pbpkg})) {
690 pb_filter_file_inplace($ptr,"$dest/$f",\%pb);
691 $liste = "$f $liste";
692 }
693 }
694 pb_log(2,"Files ".$liste."have been filtered\n");
695
696 # Do not do that for website
697 if ((not defined $param) || ($param ne "Web")) {
698 my %tmp;
699 # Filter potential patches (local + remote)
700 pb_log(0,"Delivering and compressing patches ");
701 foreach my $v (keys %patches) {
702 pb_mkdir_p("$dest/pbconf/$v/pbpatch");
703 foreach my $pf (split(/,/,$patches{$v})) {
704 my $pp = basename($pf);
705 pb_cms_export($pf,undef,"$dest/pbconf/$v/pbpatch");
706 pb_filter_file_inplace($ptr,"$dest/pbconf/$v/pbpatch/$pp",\%pb);
707 pb_system("gzip -9f $dest/pbconf/$v/pbpatch/$pp","","quiet");
708 $tmp{$pf} = "";
709 }
710 }
711 foreach my $v (keys %tmp) {
712 pb_log(0,"$v ");
713 }
714 pb_log(0,"\n");
715 } else {
716 # Instead call News generation
717 pb_web_news2html($dest);
718 # And create an empty pbconf
719 pb_mkdir_p("$dest/pbconf");
720 # And prepare the pbscript to execute remotely
721 open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript") || die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
722 print SCRIPT "#!/bin/bash\n";
723 print SCRIPT "#set -x\n";
724 print SCRIPT "echo ... Extracting Website content\n";
725 print SCRIPT "find . -type f | grep -Ev '^./$pbpkg-$pbver.tar.gz|^./pbscript' | xargs rm -f non-existent\n";
726 print SCRIPT "find * -type d -depth | xargs rmdir 2> /dev/null \n";
727 print SCRIPT "tar xfz $pbpkg-$pbver.tar.gz\n";
728 print SCRIPT "mv $pbpkg-$pbver/* .\n";
729 print SCRIPT "rm -f $pbpkg-$pbver.tar.gz\n";
730 print SCRIPT "rmdir $pbpkg-$pbver\n";
731 close(SCRIPT);
732 }
733
734 # Prepare the dest directory for archive
735 if (-x "$ENV{'PBROOTDIR'}/$pbpkg/pbinit") {
736 pb_filter_file("$ENV{'PBROOTDIR'}/$pbpkg/pbinit",$ptr,"$ENV{'PBTMP'}/pbinit",\%pb);
737 chmod 0755,"$ENV{'PBTMP'}/pbinit";
738 pb_system("cd $dest ; $ENV{'PBTMP'}/pbinit","Executing init script from $ENV{'PBROOTDIR'}/$pbpkg/pbinit","verbose");
739 }
740
741 # Archive dest dir
742 chdir "$ENV{'PBDESTDIR'}" || die "Unable to change dir to $ENV{'PBDESTDIR'}";
743 if (defined $preserve) {
744 # In that case we want to preserve the original tar file for checksum purposes
745 # The one created is btw equivalent in that case to this one
746 # Maybe check basename of both to be sure they are the same ?
747 pb_log(0,"Preserving original tar file ");
748 move("$preserve","$pbpkg-$pbver.tar.gz");
749 } else {
750 # Possibility to look at PBSRC to guess more the filename
751 pb_system("tar cfz $pbpkg-$pbver.tar.gz --exclude=$pbpkg-$pbver/pbconf $pbpkg-$pbver","Creating $pbpkg tar files compressed");
752 }
753 pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz\n");
754 pb_system("tar cfz $pbpkg-$pbver.pbconf.tar.gz $pbpkg-$pbver/pbconf","Creating pbconf tar files compressed");
755 pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz\n");
756
757 # Keep track of version-tag per pkg
758 $pkgs{$pbpkg} = "$pbver-$pbtag";
759
760 # Final cleanup
761 pb_rm_rf($dest) if (-d $dest);
762 }
763
764 # Keep track of per package version
765 pb_log(2,"DEBUG pkgs: ".Dumper(%pkgs)."\n");
766 open(PKG,"> $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb") || die "Unable to create $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb";
767 foreach my $pbpkg (keys %pkgs) {
768 print PKG "pbpkg $pbpkg = $pkgs{$pbpkg}\n";
769 }
770 close(PKG);
771
772 # Keep track of what is generated by default
773 # We need to store the dir and info on version-tag
774 # Base our content on the existing .pb file
775 copy("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb","$ENV{'PBDESTDIR'}/pbrc");
776 open(LAST,">> $ENV{'PBDESTDIR'}/pbrc") || die "Unable to create $ENV{'PBDESTDIR'}/pbrc";
777 print LAST "pbroot $ENV{'PBPROJ'} = $ENV{'PBROOTDIR'}\n";
778 print LAST "pbprojver $ENV{'PBPROJ'} = $ENV{'PBPROJVER'}\n";
779 print LAST "pbprojtag $ENV{'PBPROJ'} = $ENV{'PBPROJTAG'}\n";
780 print LAST "pbpackager $ENV{'PBPROJ'} = $ENV{'PBPACKAGER'}\n";
781 close(LAST);
782}
783
784sub pb_build2pkg {
785
786 # Get the running distro to build on
787 my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init();
788 pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n");
789
790 # Get list of packages to build
791 # Get content saved in cms2build
792 my $ptr = pb_get_pkg();
793 @pkgs = @$ptr;
794
795 my $arch = pb_get_arch();
796
797 my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
798 $pkg = { } if (not defined $pkg);
799
800 chdir "$ENV{'PBBUILDDIR'}";
801 my $made = ""; # pkgs made during build
802 foreach my $pbpkg (@pkgs) {
803 my $vertag = $pkg->{$pbpkg};
804 # get the version of the current package - maybe different
805 ($pbver,$pbtag) = split(/-/,$vertag);
806
807 my $src="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz";
808 my $src2="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
809 pb_log(2,"Source file: $src\n");
810 pb_log(2,"Pbconf file: $src2\n");
811
812 pb_log(2,"Working directory: $ENV{'PBBUILDDIR'}\n");
813 if ($dtype eq "rpm") {
814 foreach my $d ('RPMS','SRPMS','SPECS','SOURCES','BUILD') {
815 if (! -d "$ENV{'PBBUILDDIR'}/$d") {
816 pb_mkdir_p("$ENV{'PBBUILDDIR'}/$d") || die "Please ensure that you can write into $ENV{'PBBUILDDIR'} to create $d\nchown the $ENV{'PBBUILDDIR'} directory to your uid";
817 }
818 }
819
820 # Remove in case a previous link/file was there
821 unlink "$ENV{'PBBUILDDIR'}/SOURCES/".basename($src);
822 symlink "$src","$ENV{'PBBUILDDIR'}/SOURCES/".basename($src) || die "Unable to symlink $src in $ENV{'PBBUILDDIR'}/SOURCES";
823 # We need to first extract the spec file
824 my @specfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/","$ENV{'PBBUILDDIR'}/SPECS","spec");
825
826 # We need to handle potential patches to upstream sources
827 pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/pbpatch/","$ENV{'PBBUILDDIR'}/SOURCES","patch");
828
829 pb_log(2,"specfile: ".Dumper(\@specfile)."\n");
830 # set LANGUAGE to check for correct log messages
831 $ENV{'LANGUAGE'}="C";
832 # Older Redhat use _target_platform in %configure incorrectly
833 my $specialdef = "";
834 if (($ddir eq "redhat") || (($ddir eq "rhel") && ($dver eq "2.1"))) {
835 $specialdef = "--define \'_target_platform \"\"\'";
836 }
837 foreach my $f (@specfile) {
838 if ($f =~ /\.spec$/) {
839 pb_system("rpmbuild $specialdef --define \'packager $ENV{'PBPACKAGER'}\' --define \"_topdir $ENV{'PBBUILDDIR'}\" -ba $f","Building package with $f under $ENV{'PBBUILDDIR'}","verbose");
840 last;
841 }
842 }
843 # Get the name of the generated packages
844 open(LOG,"$ENV{'PBTMP'}/system.log") || die "Unable to open $ENV{'PBTMP'}/system.log";
845 while (<LOG>) {
846 chomp();
847 next if ($_ !~ /^Wrote:/);
848 s|.*/([S]*RPMS.*)|$1|;
849 $made="$made $_";
850 }
851 close(LOG);
852
853 } elsif ($dtype eq "deb") {
854 chdir "$ENV{'PBBUILDDIR'}" || die "Unable to chdir to $ENV{'PBBUILDDIR'}";
855 pb_system("tar xfz $src","Extracting sources");
856 pb_system("tar xfz $src2","Extracting pbconf");
857
858 chdir "$pbpkg-$pbver" || die "Unable to chdir to $pbpkg-$pbver";
859 pb_rm_rf("debian");
860 symlink "pbconf/$ddir-$dver-$arch","debian" || die "Unable to symlink to pbconf/$ddir-$dver-$arch";
861 chmod 0755,"debian/rules";
862
863 pb_system("dpkg-buildpackage -us -uc -rfakeroot","Building package","verbose");
864 # Get the name of the generated packages
865 open(LOG,"$ENV{'PBTMP'}/system.log") || die "Unable to open $ENV{'PBTMP'}/system.log";
866 while (<LOG>) {
867 chomp();
868 my $tmp = $_;
869 next if ($tmp !~ /^dpkg-deb.:/);
870 $tmp =~ s|.*../(.*)_(.*).deb.*|$1|;
871 $made="$made $tmp.dsc $tmp.tar.gz $tmp"."_*.deb $tmp"."_*.changes";
872 }
873 close(LOG);
874 } elsif ($dtype eq "ebuild") {
875 my @ebuildfile;
876 # For gentoo we need to take pb as subsystem name
877 # We put every apps here under sys-apps. hope it's correct
878 # We use pb's home dir in order to have a single OVERLAY line
879 my $tmpd = "$ENV{'HOME'}/portage/pb/sys-apps/$pbpkg";
880 pb_mkdir_p($tmpd) if (! -d "$tmpd");
881 pb_mkdir_p("$ENV{'HOME'}/portage/distfiles") if (! -d "$ENV{'HOME'}/portage/distfiles");
882
883 # We need to first extract the ebuild file
884 @ebuildfile = pb_extract_build_files($src2,"$pbpkg-$pbver/pbconf/$ddir-$dver-$arch/","$tmpd","ebuild");
885
886 # Prepare the build env for gentoo
887 my $found = 0;
888 my $pbbd = $ENV{'HOME'};
889 $pbbd =~ s|/|\\/|g;
890 if (-r "/etc/make.conf") {
891 open(MAKE,"/etc/make.conf");
892 while (<MAKE>) {
893 $found = 1 if (/$pbbd\/portage/);
894 }
895 close(MAKE);
896 }
897 if ($found == 0) {
898 pb_system("sudo sh -c 'echo PORTDIR_OVERLAY=\"$ENV{'HOME'}/portage\" >> /etc/make.conf'");
899 }
900 #$found = 0;
901 #if (-r "/etc/portage/package.keywords") {
902 #open(KEYW,"/etc/portage/package.keywords");
903 #while (<KEYW>) {
904 #$found = 1 if (/portage\/pb/);
905 #}
906 #close(KEYW);
907 #}
908 #if ($found == 0) {
909 #pb_system("sudo sh -c \"echo portage/pb >> /etc/portage/package.keywords\"");
910 #}
911
912 # Build
913 foreach my $f (@ebuildfile) {
914 if ($f =~ /\.ebuild$/) {
915 move($f,"$tmpd/$pbpkg-$pbver.ebuild");
916 pb_system("cd $tmpd ; ebuild $pbpkg-$pbver.ebuild clean ; ebuild $pbpkg-$pbver.ebuild digest ; ebuild $pbpkg-$pbver.ebuild package","verbose");
917 # Now move it where pb expects it
918 pb_mkdir_p("$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
919 move("$tmpd/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
920 }
921 }
922
923 $made="$made portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver.ebuild";
924 } elsif ($dtype eq "tgz") {
925 # Slackware family
926 $made="$made $pbpkg/$pbpkg-$pbver-*-$pbtag.tgz";
927
928 chdir "$ENV{'PBBUILDDIR'}" || die "Unable to chdir to $ENV{'PBBUILDDIR'}";
929 pb_system("tar xfz $src","Extracting sources");
930 pb_system("tar xfz $src2","Extracting pbconf");
931 chdir "$pbpkg-$pbver" || die "Unable to chdir to $pbpkg-$pbver";
932 symlink "pbconf/$ddir-$dver-$arch","install" || die "Unable to symlink to pbconf/$ddir-$dver-$arch";
933 if (-x "install/pbslack") {
934 pb_system("./install/pbslack","Building package");
935 pb_system("sudo /sbin/makepkg -p -l y -c y $pbpkg","Packaging $pbpkg","verbose");
936 }
937 } else {
938 die "Unknown dtype format $dtype";
939 }
940 }
941 # Packages check if needed
942 if ($dtype eq "rpm") {
943 if (-f "/usr/bin/rpmlint") {
944 pb_system("rpmlint $made","Checking validity of rpms with rpmlint","verbose");
945 }
946 } elsif ($dtype eq "deb") {
947 if (-f "/usr/bin/lintian") {
948 my $made2 = "";
949 foreach my $f (split(/ /,$made)) {
950 $made2 .= "$f " if ($f =~ /\.changes$/);
951 }
952 pb_system("lintian $made2","Checking validity of debs with lintian","verbose");
953 }
954 } else {
955 pb_log(0, "No check done for $dtype yet");
956 }
957
958 # Keep track of what is generated so that we can get them back from VMs
959 open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") || die "Unable to create $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
960 print KEEP "$made\n";
961 close(KEEP);
962}
963
964sub pb_build2ssh {
965 pb_send2target("Sources");
966}
967
968sub pb_pkg2ssh {
969 pb_send2target("Packages");
970}
971
972# By default deliver to the the public site hosting the
973# ftp structure (or whatever) or a VM/VE
974sub pb_send2target {
975
976 my $cmt = shift;
977 my $v = shift || undef;
978 my $vmexist = shift || 0; # 0 is FALSE
979 my $vmpid = shift || 0; # 0 is FALSE
980
981 pb_log(2,"DEBUG: pb_send2target($cmt,".Dumper($v).",$vmexist,$vmpid)\n");
982 my $host = "sshhost";
983 my $login = "sshlogin";
984 my $dir = "sshdir";
985 my $port = "sshport";
986 my $conf = "sshconf";
987 my $rebuild = "sshrebuild";
988 my $tmout = "vmtmout";
989 my $path = "vmpath";
990 if (($cmt eq "vm") || ($cmt eq "Script")) {
991 $login = "vmlogin";
992 $dir = "pbdefdir";
993 $tmout = "vmtmout";
994 $rebuild = "vmrebuild";
995 # Specific VM
996 $host = "vmhost";
997 $port = "vmport";
998 } elsif ($cmt eq "ve") {
999 $login = "velogin";
1000 $dir = "pbdefdir";
1001 $tmout = "vetmout";
1002 # Specific VE
1003 $path = "vepath";
1004 $conf = "veconf";
1005 $rebuild = "verebuild";
1006 } elsif ($cmt eq "Web") {
1007 $host = "websshhost";
1008 $login = "websshlogin";
1009 $dir = "websshdir";
1010 $port = "websshport";
1011 }
1012 my $cmd = "";
1013 my $src = "";
1014 my ($odir,$over,$oarch) = (undef, undef, undef);
1015 my ($ddir, $dver, $dfam, $dtype, $pbsuf);
1016
1017 if ($cmt ne "Announce") {
1018 my $ptr = pb_get_pkg();
1019 @pkgs = @$ptr;
1020
1021 # Get the running distro to consider
1022 if (defined $v) {
1023 ($odir,$over,$oarch) = split(/-/,$v);
1024 }
1025 ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($odir,$over);
1026 pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n");
1027
1028 # Get list of packages to build
1029 # Get content saved in cms2build
1030 my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
1031 $pkg = { } if (not defined $pkg);
1032
1033 chdir "$ENV{'PBBUILDDIR'}";
1034 foreach my $pbpkg (@pkgs) {
1035 my $vertag = $pkg->{$pbpkg};
1036 # get the version of the current package - maybe different
1037 ($pbver,$pbtag) = split(/-/,$vertag);
1038
1039 if (($cmt eq "Sources") || ($cmt eq "vm") || ($cmt eq "ve")) {
1040 $src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz $ENV{'PBDESTDIR'}/$pbpkg-$pbver.pbconf.tar.gz";
1041 if ($cmd eq "") {
1042 $cmd = "ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
1043 } else {
1044 $cmd = "$cmd ; ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
1045 }
1046 } elsif ($cmt eq "Web") {
1047 $src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz"
1048 }
1049 }
1050 # Adds conf file for availability of conf elements
1051 pb_conf_add("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb");
1052 }
1053
1054 if (($cmt eq "vm") || ($cmt eq "ve")) {
1055 $src="$src $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc $ENV{'PBDESTDIR'}/pbscript";
1056 } elsif (($cmt eq "Script") || ($cmt eq "Web")) {
1057 $src="$src $ENV{'PBDESTDIR'}/pbscript";
1058 } elsif ($cmt eq "Announce") {
1059 $src="$src $ENV{'PBTMP'}/pbscript";
1060 } elsif ($cmt eq "Packages") {
1061 # Get package list from file made during build2pkg
1062 open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") || die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1063 $src = <KEEP>;
1064 chomp($src);
1065 close(KEEP);
1066 $src="$src $ENV{'PBBUILDDIR'}/pbscript" if ($cmt ne "Sources");
1067 }
1068 # Remove potential leading spaces (cause problem with basename)
1069 $src =~ s/^ *//;
1070 my $basesrc = "";
1071 foreach my $i (split(/ +/,$src)) {
1072 $basesrc .= " ".basename($i);
1073 }
1074
1075 pb_log(0,"Sources handled ($cmt): $src\n");
1076 pb_log(2,"values: ".Dumper(($host,$login,$dir,$port,$tmout,$rebuild,$path,$conf))."\n");
1077 my ($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vepath) = pb_conf_get($host,$login,$dir,$port,$tmout,$path);
1078 my ($vrebuild,$veconf) = pb_conf_get_if($rebuild,$conf);
1079 pb_log(2,"ssh: ".Dumper(($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vrebuild,$vepath,$veconf))."\n");
1080 # Not mandatory
1081 my ($testver) = pb_conf_get_if("testver");
1082
1083 my $mac;
1084 # Useless for VE
1085 if ($cmt ne "ve") {
1086 $mac = "$sshlogin->{$ENV{'PBPROJ'}}\@$sshhost->{$ENV{'PBPROJ'}}";
1087 # Overwrite account value if passed as parameter
1088 $mac = "$pbaccount\@$sshhost->{$ENV{'PBPROJ'}}" if (defined $pbaccount);
1089 pb_log(2, "DEBUG: pbaccount: $pbaccount => mac: $mac\n") if (defined $pbaccount);
1090 }
1091
1092 my $tdir;
1093 my $bdir;
1094 if (($cmt eq "Sources") || ($cmt eq "Script")) {
1095 $tdir = $sshdir->{$ENV{'PBPROJ'}}."/src";
1096 if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1097 # This is a test pkg => target dir is under test
1098 $tdir = $sshdir->{$ENV{'PBPROJ'}}."/test/src";
1099 }
1100 } elsif (($cmt eq "vm") || ($cmt eq "ve")) {
1101 $tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/delivery";
1102 $bdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/build";
1103 # Remove a potential $ENV{'HOME'} as bdir should be relative to pb's home
1104 $bdir =~ s|\$ENV.+\}/||;
1105 } elsif ($cmt eq "Announce") {
1106 $tdir = "$sshdir->{$ENV{'PBPROJ'}}";
1107 if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1108 # This is a test pkg => target dir is under test
1109 $tdir = $sshdir->{$ENV{'PBPROJ'}}."/test";
1110 }
1111 } elsif ($cmt eq "Web") {
1112 $tdir = "$sshdir->{$ENV{'PBPROJ'}}";
1113 if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1114 # This is a test website => target dir is under test
1115 $tdir = $sshdir->{$ENV{'PBPROJ'}}."../test";
1116 }
1117 } elsif ($cmt eq "Packages") {
1118 $tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ddir/$dver";
1119
1120 if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
1121 # This is a test pkg => target dir is under test
1122 $tdir = $sshdir->{$ENV{'PBPROJ'}}."/test/$ddir/$dver";
1123 }
1124
1125 my $repodir = $tdir;
1126 $repodir =~ s|^$sshdir->{$ENV{'PBPROJ'}}/||;
1127
1128 my ($pbrepo) = pb_conf_get("pbrepo");
1129
1130 # Repository management
1131 open(PBS,"> $ENV{'PBBUILDDIR'}/pbscript") || die "Unable to create $ENV{'PBBUILDDIR'}/pbscript";
1132 if ($dtype eq "rpm") {
1133 # Also make a pbscript to generate yum/urpmi bases
1134 print PBS << "EOF";
1135#!/bin/bash
1136# Prepare a script to ease yum setup
1137cat > $ENV{'PBPROJ'}.repo << EOT
1138[$ENV{'PBPROJ'}]
1139name=$ddir $dver - $ENV{'PBPROJ'} Vanilla Packages
1140baseurl=$pbrepo->{$ENV{'PBPROJ'}}/$repodir
1141enabled=1
1142gpgcheck=0
1143EOT
1144chmod 644 $ENV{'PBPROJ'}.repo
1145
1146# Clean up old repo content
1147rm -rf headers/ repodata/
1148# Create yum repo
1149yum-arch .
1150# Create repodata
1151createrepo .
1152EOF
1153 if ($dfam eq "md") {
1154 # For Mandriva add urpmi management
1155 print PBS << "EOF";
1156# Prepare a script to ease urpmi setup
1157cat > $ENV{'PBPROJ'}.addmedia << EOT
1158urpmi.addmedia $ENV{'PBPROJ'} $pbrepo->{$ENV{'PBPROJ'}}/$repodir with hdlist.cz
1159EOT
1160chmod 755 $ENV{'PBPROJ'}.addmedia
1161
1162# Clean up old repo content
1163rm -f hdlist.cz synthesis.hdlist.cz
1164# Create urpmi repo
1165genhdlist .
1166EOF
1167 }
1168 if ($ddir eq "fedora") {
1169 # Extract the spec file to please Fedora maintainers :-(
1170 print PBS << "EOF";
1171for p in $basesrc; do
1172 echo \$p | grep -q 'src.rpm'
1173 if [ \$\? -eq 0 ]; then
1174 rpm2cpio \$p | cpio -ivdum --quiet '*.spec'
1175 fi
1176done
1177EOF
1178 }
1179 } elsif ($dtype eq "deb") {
1180 # Also make a pbscript to generate apt bases
1181 # Cf: http://www.debian.org/doc/manuals/repository-howto/repository-howto.fr.html
1182 my $rpd = dirname("$pbrepo->{$ENV{'PBPROJ'}}/$repodir");
1183 print PBS << "EOF";
1184#!/bin/bash
1185# Prepare a script to ease apt setup
1186cat > $ENV{'PBPROJ'}.sources.list << EOT
1187deb $rpd $dver contrib
1188deb-src $rpd $dver contrib
1189EOT
1190chmod 644 $ENV{'PBPROJ'}.sources.list
1191
1192# Prepare a script to create apt info file
1193(cd .. ; for a in i386 amd64 ia64; do mkdir -p dists/$dver/contrib/binary-\$a; dpkg-scanpackages -a\$a $dver /dev/null | gzip -c9 > dists/$dver/contrib/binary-\$a/Packages.gz; done; mkdir -p dists/$dver/contrib/source; dpkg-scansources $dver /dev/null | gzip -c9 > dists/$dver/contrib/source/Sources.gz)
1194#(cd .. ; rm -f dists/$dver/Release ; apt-ftparchive release dists/$dver > dists/$dver/Release; gpg --sign -ba -o dists/$dver/Release.gpg dists/$dver/Release)
1195EOF
1196 }
1197 close(PBS);
1198 chmod 0755,"$ENV{'PBBUILDDIR'}/pbscript";
1199
1200 } else {
1201 return;
1202 }
1203
1204 # Useless for VE
1205 my $nport;
1206 if ($cmt ne "ve") {
1207 $nport = $sshport->{$ENV{'PBPROJ'}};
1208 $nport = "$pbport" if (defined $pbport);
1209 }
1210
1211 # Remove a potential $ENV{'HOME'} as tdir should be relative to pb's home
1212 $tdir =~ s|\$ENV.+\}/||;
1213
1214 my $tm = $vtmout->{$ENV{'PBPROJ'}};
1215
1216 # ssh communication if not VE
1217 # should use a hash instead...
1218 my ($shcmd,$cpcmd,$cptarget,$cp2target);
1219 if ($cmt ne "ve") {
1220 my $keyfile = pb_ssh_get(0);
1221 $shcmd = "ssh -i $keyfile -q -o UserKnownHostsFile=/dev/null -p $nport $mac";
1222 $cpcmd = "scp -i $keyfile -p -o UserKnownHostsFile=/dev/null -P $nport";
1223 $cptarget = "$mac:$tdir";
1224 if ($cmt eq "vm") {
1225 $cp2target = "$mac:$bdir";
1226 }
1227 } else {
1228 my $tp = $vepath->{$ENV{'PBPROJ'}};
1229 $shcmd = "sudo chroot $tp/$v /bin/su - $sshlogin->{$ENV{'PBPROJ'}} -c ";
1230 $cpcmd = "cp -a ";
1231 $cptarget = "$tp/$tdir";
1232 $cp2target = "$tp/$bdir";
1233 }
1234
1235 my $logres = "";
1236 # Do not touch when just announcing
1237 if ($cmt ne "Announce") {
1238 pb_system("$shcmd \"mkdir -p $tdir ; cd $tdir ; echo \'for i in $basesrc; do if [ -f \$i ]; then rm -f \$i; fi; done\ ; $cmd' | bash\"","Preparing $tdir on $cptarget");
1239 } else {
1240 $logres = "> ";
1241 }
1242 pb_system("cd $ENV{'PBBUILDDIR'} ; $cpcmd $src $cptarget 2> /dev/null","$cmt delivery in $cptarget");
1243
1244 # For VE we need to change the owner manually - To be tested if needed
1245 #if ($cmt eq "ve") {
1246 #pb_system("cd $cptarget ; sudo chown -R $sshlogin->{$ENV{'PBPROJ'}} .","$cmt chown in $cptarget to $sshlogin->{$ENV{'PBPROJ'}}");
1247 #}
1248 pb_system("$shcmd \"echo \'cd $tdir ; if [ -f pbscript ]; then ./pbscript; fi ; rm -f ./pbscript\' | bash\"","Executing pbscript on $cptarget if needed","verbose");
1249 if (($cmt eq "vm") || ($cmt eq "ve")) {
1250 # Get back info on pkg produced, compute their name and get them from the VM
1251 pb_system("$cpcmd $cp2target/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'} $ENV{'PBBUILDDIR'} 2> /dev/null","Get package names in $cp2target");
1252 open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") || die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1253 my $src = <KEEP>;
1254 chomp($src);
1255 close(KEEP);
1256 $src =~ s/^ *//;
1257 pb_mkdir_p("$ENV{'PBBUILDDIR'}/$odir/$over");
1258 # Change pgben to make the next send2target happy
1259 my $made = "";
1260 open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") || die "Unable to write $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
1261 foreach my $p (split(/ +/,$src)) {
1262 my $j = basename($p);
1263 pb_system("$cpcmd $cp2target/\'$p\' $ENV{'PBBUILDDIR'}/$odir/$over 2> /dev/null","Package recovery of $j in $cp2target");
1264 $made="$made $odir/$over/$j" if (($dtype ne "rpm") || ($j !~ /.src.rpm$/));
1265 }
1266 print KEEP "$made\n";
1267 close(KEEP);
1268 pb_system("$shcmd \"rm -rf $tdir $bdir\"","$cmt cleanup");
1269
1270 # We want to send them to the ssh account so overwrite what has been done before
1271 undef $pbaccount;
1272 pb_log(2,"Before sending pkgs, vmexist: $vmexist, vmpid: $vmpid\n");
1273 pb_send2target("Packages",$odir."-".$over."-".$oarch,$vmexist,$vmpid);
1274 pb_rm_rf("$ENV{'PBBUILDDIR'}/$odir");
1275 }
1276 pb_log(2,"Before halt, vmexist: $vmexist, vmpid: $vmpid\n");
1277 if ((! $vmexist) && (($cmt eq "vm") || ($cmt eq "Script"))) {
1278 pb_system("$shcmd \"sudo /sbin/halt -p \"; sleep $tm ; echo \'if [ -d /proc/$vmpid ]; then kill -9 $vmpid; fi \' | bash ; sleep 10","VM $v halt (pid $vmpid)");
1279 }
1280}
1281
1282sub pb_script2v {
1283 my $pbscript=shift;
1284 my $vtype=shift;
1285 my $force=shift || 0; # Force stop of VM. Default not
1286 my $vm1=shift || undef; # Only that VM to treat
1287 my $vm;
1288 my $all;
1289
1290 pb_log(2,"DEBUG: pb_script2v($pbscript,$vtype,$force,$vm1)\n");
1291 # Prepare the script to be executed on the VM
1292 # in $ENV{'PBDESTDIR'}/pbscript
1293 if ((defined $pbscript ) && ($pbscript ne "$ENV{'PBDESTDIR'}/pbscript")) {
1294 copy($pbscript,"$ENV{'PBDESTDIR'}/pbscript") || die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
1295 chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
1296 }
1297
1298 if (not defined $vm1) {
1299 ($vm,$all) = pb_get_v($vtype);
1300 } else {
1301 @$vm = ($vm1);
1302 }
1303 my ($vmexist,$vmpid) = (undef,undef);
1304
1305 foreach my $v (@$vm) {
1306 # Launch the VM/VE
1307 if ($vtype eq "vm") {
1308 ($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1309 pb_log(2,"DEBUG: After pb_launchv, vmexist: $vmexist, vmpid: $vmpid\n");
1310
1311 # Skip that VM if something went wrong
1312 next if (($vmpid == 0) && ($vmexist == 0));
1313
1314 # If force stopping the VM then reset vmexist
1315 if ($force == 1) {
1316 $vmpid = $vmexist;
1317 $vmexist = 0;
1318 }
1319 }
1320
1321 # Gather all required files to send them to the VM
1322 # and launch the build through pbscript
1323 pb_log(2,"DEBUG: Before send2target, vmexist: $vmexist, vmpid: $vmpid\n");
1324 pb_send2target("Script","$v",$vmexist,$vmpid);
1325
1326 }
1327}
1328
1329sub pb_launchv {
1330 my $vtype = shift;
1331 my $v = shift;
1332 my $create = shift || 0; # By default do not create a VM
1333
1334 pb_log(2,"DEBUG: pb_launchv($vtype,$v,$create)\n");
1335 die "No VM/VE defined, unable to launch" if (not defined $v);
1336 # Keep only the first VM in case many were given
1337 $v =~ s/,.*//;
1338
1339 my $arch = pb_get_arch();
1340
1341 # Launch the VMs/VEs
1342 if ($vtype eq "vm") {
1343 die "-i iso parameter needed" if (((not defined $iso) || ($iso eq "")) && ($create != 0));
1344
1345 my ($ptr,$vmopt,$vmpath,$vmport,$vmtmout,$vmsize) = pb_conf_get("vmtype","vmopt","vmpath","vmport","vmtmout","vmsize");
1346
1347 my $vmtype = $ptr->{$ENV{'PBPROJ'}};
1348 if (not defined $ENV{'PBVMOPT'}) {
1349 $ENV{'PBVMOPT'} = "";
1350 }
1351 # Set a default timeout of 2 minutes
1352 if (not defined $ENV{'PBVMTMOUT'}) {
1353 $ENV{'PBVMTMOUT'} = "120";
1354 }
1355 if (defined $vmopt->{$v}) {
1356 $ENV{'PBVMOPT'} .= " $vmopt->{$v}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$v}/);
1357 } elsif (defined $vmopt->{$ENV{'PBPROJ'}}) {
1358 $ENV{'PBVMOPT'} .= " $vmopt->{$ENV{'PBPROJ'}}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$ENV{'PBPROJ'}}/);
1359 }
1360 if (defined $vmtmout->{$v}) {
1361 $ENV{'PBVMTMOUT'} = $vmtmout->{$v};
1362 } elsif (defined $vmtmout->{$ENV{'PBPROJ'}}) {
1363 $ENV{'PBVMTMOUT'} = $vmtmout->{$ENV{'PBPROJ'}};
1364 }
1365 my $nport = $vmport->{$ENV{'PBPROJ'}};
1366 $nport = "$pbport" if (defined $pbport);
1367
1368 my $cmd;
1369 my $vmcmd; # has to be used for pb_check_ps
1370 my $vmm; # has to be used for pb_check_ps
1371 if ($vmtype eq "qemu") {
1372 my $qemucmd32;
1373 my $qemucmd64;
1374 if ($arch eq "x86_64") {
1375 $qemucmd32 = "/usr/bin/qemu-system-i386";
1376 $qemucmd64 = "/usr/bin/qemu";
1377 } else {
1378 $qemucmd32 = "/usr/bin/qemu";
1379 $qemucmd64 = "/usr/bin/qemu-system-x86_64";
1380 }
1381 if ($v =~ /x86_64/) {
1382 $vmcmd = "$qemucmd64";
1383 # Not needed with latest versions of qemu it seems
1384 #$vmcmd = "$qemucmd64 -no-kqemu";
1385 # This one may now be needed
1386 #$vmcmd = "$qemucmd64 -no-kvm";
1387 } else {
1388 $vmcmd = "$qemucmd32";
1389 }
1390 $vmm = "$vmpath->{$ENV{'PBPROJ'}}/$v.qemu";
1391 if ($create != 0) {
1392 $ENV{'PBVMOPT'} .= " -cdrom $iso -boot d";
1393 }
1394 $cmd = "$vmcmd $ENV{'PBVMOPT'} -redir tcp:$nport:10.0.2.15:22 $vmm"
1395 } elsif ($vmtype eq "xen") {
1396 } elsif ($vmtype eq "vmware") {
1397 } else {
1398 die "VM of type $vmtype not supported. Report to the dev team";
1399 }
1400 my ($tmpcmd,$void) = split(/ +/,$cmd);
1401 my $vmexist = pb_check_ps($tmpcmd,$vmm);
1402 my $vmpid = 0;
1403 if (! $vmexist) {
1404 if ($create != 0) {
1405 if (($vmtype eq "qemu") || ($vmtype eq "xen")) {
1406 pb_system("/usr/bin/qemu-img create -f qcow2 $vmm $vmsize->{$ENV{'PBPROJ'}}","Creating the QEMU VM");
1407 } elsif ($vmtype eq "vmware") {
1408 } else {
1409 }
1410 }
1411 if (! -f "$vmm") {
1412 pb_log(0,"Unable to find VM $vmm\n");
1413 } else {
1414 pb_system("$cmd &","Launching the VM $vmm");
1415 pb_system("sleep $ENV{'PBVMTMOUT'}","Waiting $ENV{'PBVMTMOUT'} s for VM $v to come up");
1416 $vmpid = pb_check_ps($tmpcmd,$vmm);
1417 pb_log(0,"VM $vmm launched (pid $vmpid)\n");
1418 }
1419 } else {
1420 pb_log(0,"Found an existing VM $vmm (pid $vmexist)\n");
1421 }
1422 pb_log(2,"DEBUG: pb_launchv returns ($vmexist,$vmpid)\n");
1423 return($vmexist,$vmpid);
1424 # VE here
1425 } else {
1426 # Get VE context
1427 my ($ptr,$vetmout,$vepath,$verebuild,$veconf) = pb_conf_get("vetype","vetmout","vepath","verebuild","veconf");
1428 my $vetype = $ptr->{$ENV{'PBPROJ'}};
1429
1430 # Get distro context
1431 my ($name,$ver,$darch) = split(/-/,$v);
1432 chomp($darch);
1433 my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($name,$ver);
1434
1435 if ($vetype eq "chroot") {
1436 # Architecture consistency
1437 if ($arch ne $darch) {
1438 die "Unable to launch a VE of architecture $darch on a $arch platform" if (not (($darch eq "x86_64") && ($arch =~ /i?86/)));
1439 }
1440
1441 if (($create != 0) || ($verebuild->{$ENV{'PBPROJ'}} eq "true") || ($force == 1)) {
1442 # We have to rebuild the chroot
1443 if ($dtype eq "rpm") {
1444 pb_system("sudo /usr/sbin/mock --init --resultdir=\"/tmp\" --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" -r $v","Creating the mock VE");
1445 # Once setup we need to install some packages, the pb account, ...
1446 pb_system("sudo /usr/sbin/mock --install --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" -r $v su","Configuring the mock VE");
1447 #pb_system("sudo /usr/sbin/mock --init --resultdir=\"/tmp\" --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" --basedir=\"$vepath->{$ENV{'PBPROJ'}}\" -r $v","Creating the mock VE");
1448 } elsif ($dtype eq "deb") {
1449 pb_system("","Creating the pbuilder VE");
1450 } elsif ($dtype eq "ebuild") {
1451 die "Please teach the dev team how to build gentoo chroot";
1452 } else {
1453 die "Unknown distribution type $dtype. Report to dev team";
1454 }
1455 }
1456 # Nothing more to do for VE. No real launch
1457 } else {
1458 die "VE of type $vetype not supported. Report to the dev team";
1459 }
1460 }
1461}
1462
1463sub pb_build2v {
1464
1465my $vtype = shift;
1466
1467# Prepare the script to be executed on the VM/VE
1468# in $ENV{'PBDESTDIR'}/pbscript
1469#my ($ntp) = pb_conf_get($vtype."ntp");
1470#my $vntp = $ntp->{$ENV{'PBPROJ'}};
1471
1472open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript") || die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
1473print SCRIPT "#!/bin/bash\n";
1474print SCRIPT "echo ... Execution needed\n";
1475print SCRIPT "# This is in directory delivery\n";
1476print SCRIPT "# Setup the variables required for building\n";
1477print SCRIPT "export PBPROJ=$ENV{'PBPROJ'}\n";
1478print SCRIPT "# Preparation for pb\n";
1479print SCRIPT "mv .pbrc \$HOME\n";
1480print SCRIPT "cd ..\n";
1481# Force new date to be in the future compared to the date of the tar file by adding 1 minute
1482my @date=pb_get_date();
1483$date[1]++;
1484my $upddate = strftime("%m%d%H%M%Y", @date);
1485#print SCRIPT "echo Setting up date on $vntp...\n";
1486# Or use ntpdate if available TBC
1487print SCRIPT "sudo date $upddate\n";
1488# Get list of packages to build and get some ENV vars as well
1489my $ptr = pb_get_pkg();
1490@pkgs = @$ptr;
1491my $p = join(' ',@pkgs) if (@pkgs);
1492print SCRIPT "export PBPROJVER=$ENV{'PBPROJVER'}\n";
1493print SCRIPT "export PBPROJTAG=$ENV{'PBPROJTAG'}\n";
1494print SCRIPT "export PBPACKAGER=\"$ENV{'PBPACKAGER'}\"\n";
1495print SCRIPT "# Build\n";
1496print SCRIPT "echo Building packages on $vtype...\n";
1497print SCRIPT "pb -p $ENV{'PBPROJ'} build2pkg $p\n";
1498close(SCRIPT);
1499chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
1500
1501my ($v,$all) = pb_get_v($vtype);
1502
1503# Send tar files when we do a global generation
1504pb_build2ssh() if ($all == 1);
1505
1506my ($vmexist,$vmpid) = (undef,undef);
1507
1508foreach my $v (@$v) {
1509 if ($vtype eq "vm") {
1510 # Launch the VM
1511 ($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1512
1513 # Skip that VM if it something went wrong
1514 next if (($vmpid == 0) && ($vmexist == 0));
1515 }
1516 # Gather all required files to send them to the VM/VE
1517 # and launch the build through pbscript
1518 pb_log(2,"Calling send2target $vtype,$v,$vmexist,$vmpid\n");
1519 pb_send2target($vtype,"$v",$vmexist,$vmpid);
1520}
1521}
1522
1523
1524sub pb_newver {
1525
1526 die "-V Version parameter needed" if ((not defined $newver) || ($newver eq ""));
1527
1528 # Need this call for PBDIR
1529 my ($scheme2,$uri) = pb_cms_init($pbinit);
1530
1531 my ($pbconf) = pb_conf_get("pbconfurl");
1532 $uri = $pbconf->{$ENV{'PBPROJ'}};
1533 my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);
1534
1535 # Checking CMS repositories status
1536 my ($pburl) = pb_conf_get("pburl");
1537 ($scheme2, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}});
1538
1539 if ($scheme !~ /^svn/) {
1540 die "Only SVN is supported at the moment";
1541 }
1542
1543 my $res = pb_cms_isdiff($scheme,$ENV{'PBROOTDIR'});
1544 die "ERROR: No differences accepted in CMS for $ENV{'PBROOTDIR'} before creating a new version" if ($res != 0);
1545
1546 $res = pb_cms_isdiff($scheme2,$ENV{'PBDIR'});
1547 die "ERROR: No differences accepted in CMS for $ENV{'PBDIR'} before creating a new version" if ($res != 0);
1548
1549 # Tree identical between PBCONFDIR and PBROOTDIR. The delta is what
1550 # we want to get for the root of the new URL
1551
1552 my $tmp = $ENV{'PBROOTDIR'};
1553 $tmp =~ s|^$ENV{'PBCONFDIR'}||;
1554
1555 my $newurl = "$uri/".dirname($tmp)."/$newver";
1556 # Should probably use projver in the old file
1557 my $oldver= basename($tmp);
1558
1559 # Duplicate and extract project-builder part
1560 pb_log(2,"Copying $uri/$tmp to $newurl\n");
1561 pb_cms_copy($scheme,"$uri/$tmp",$newurl);
1562 pb_log(2,"Checkout $newurl to $ENV{'PBROOTDIR'}/../$newver\n");
1563 pb_cms_up($scheme,"$ENV{'PBCONFDIR'}/..");
1564
1565 # Duplicate and extract project
1566 my $newurl2 = "$pburl->{$ENV{'PBPROJ'}}/".dirname($tmp)."/$newver";
1567
1568 pb_log(2,"Copying $pburl->{$ENV{'PBPROJ'}}/$tmp to $newurl2\n");
1569 pb_cms_copy($scheme,"$pburl->{$ENV{'PBPROJ'}}/$tmp",$newurl2);
1570 pb_log(2,"Checkout $newurl2 to $ENV{'PBDIR'}/../$newver\n");
1571 pb_cms_up($scheme,"$ENV{'PBDIR'}/..");
1572
1573 # Update the .pb file
1574 open(FILE,"$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb") || die "Unable to open $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb";
1575 open(OUT,"> $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new") || die "Unable to write to $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new";
1576 while(<FILE>) {
1577 s/^projver\s+$ENV{'PBPROJ'}\s*=\s*$oldver/projver $ENV{'PBPROJ'} = $newver/;
1578 pb_log(0,"Changing projver from $oldver to $newver in $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb\n") if (/^projver\s+$ENV{'PBPROJ'}\s*=\s*$oldver/);
1579 s/^testver/#testver/;
1580 pb_log(0,"Commenting testver in $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb\n") if (/^testver/);
1581 print OUT $_;
1582 }
1583 close(FILE);
1584 close(OUT);
1585 rename("$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new","$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb");
1586
1587 # Checking pbcl files
1588 foreach my $f (<$ENV{'PBROOTDIR'}/*/pbcl>) {
1589 open(PBCL,$f) || die "Unable to open $f";
1590 my $foundnew = 0;
1591 while (<PBCL>) {
1592 $foundnew = 1 if (/^$newver \(/);
1593 }
1594 close(PBCL);
1595 open(OUT,"> $f.new") || die "Unable to write to $f.new: $!";
1596 open(PBCL,$f) || die "Unable to open $f";
1597 while (<PBCL>) {
1598 print OUT "$_" if (not /^$oldver \(/);
1599 if ((/^$oldver \(/) && ($foundnew == 0)) {
1600 print OUT "$newver ($pbdate)\n";
1601 print OUT "- TBD\n";
1602 print OUT "\n";
1603 pb_log(0,"WARNING: version $newver not found in $f so added...") if ($foundnew == 0);
1604 }
1605 }
1606 close(OUT);
1607 close(PBCL);
1608 rename("$f.new","$f");
1609 }
1610
1611 pb_log(2,"Checkin $ENV{'PBROOTDIR'}/../$newver\n");
1612 pb_cms_checkin($scheme,"$ENV{'PBROOTDIR'}/../$newver",undef);
1613}
1614
1615#
1616# Return the list of VMs/VEs we are working on
1617# $all is a flag to know if we return all of them
1618# or only some (if all we publish also tar files in addition to pkgs
1619#
1620sub pb_get_v {
1621
1622my $vtype = shift;
1623my @v;
1624my $all = 0;
1625my $vlist;
1626my $pbv = 'PBV';
1627
1628if ($vtype eq "vm") {
1629 $vlist = "vmlist";
1630} elsif ($vtype eq "ve") {
1631 $vlist = "velist";
1632}
1633# Get VM/VE list
1634if ((not defined $ENV{$pbv}) || ($ENV{$pbv} =~ /^all$/)) {
1635 my ($ptr) = pb_conf_get($vlist);
1636 $ENV{$pbv} = $ptr->{$ENV{'PBPROJ'}};
1637 $all = 1;
1638}
1639pb_log(2,"$vtype: $ENV{$pbv}\n");
1640@v = split(/,/,$ENV{$pbv});
1641return(\@v,$all);
1642}
1643
1644# Function to create a potentialy missing pb account on the VM/VE, and adds it to sudo
1645# Needs to use root account to connect to the VM/VE
1646# pb will take your local public SSH key to access
1647# the pb account in the VM later on if needed
1648sub pb_setup_v {
1649
1650my $vtype = shift;
1651
1652my ($vm,$all) = pb_get_v($vtype);
1653
1654# Script generated
1655my $pbscript = "$ENV{'PBDESTDIR'}/setupv";
1656
1657foreach my $v (@$vm) {
1658 # Name of the account to deal with for VM/VE
1659 # Do not use the one passed potentially with -a
1660 my ($pbac) = pb_conf_get($vtype."login");
1661 my ($key,$zero0,$zero1,$zero2);
1662 my ($vmexist,$vmpid,$ntps);
1663
1664 if ($vtype eq "vm") {
1665 # Prepare the key to be used and transfered remotely
1666 my $keyfile = pb_ssh_get(1);
1667
1668 my ($vmhost,$vmport,$vmntp) = pb_conf_get("vmhost","vmport","vmntp");
1669 my $nport = $vmport->{$ENV{'PBPROJ'}};
1670 $ntps = $vmntp->{$ENV{'PBPROJ'}};
1671 $nport = "$pbport" if (defined $pbport);
1672
1673 # Launch the VM
1674 ($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1675
1676 # Skip that VM if something went wrong
1677 next if (($vmpid == 0) && ($vmexist == 0));
1678
1679 # Store the pub key part in a variable
1680 open(FILE,"$keyfile.pub") || die "Unable to open $keyfile.pub";
1681 ($zero0,$zero1,$zero2) = split(/ /,<FILE>);
1682 close(FILE);
1683
1684 $key = "\Q$zero1";
1685
1686 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\"","Copying local keys to $vtype. This may require the root password");
1687 # once this is done, we can do what we want on the VM remotely
1688 }
1689
1690 # Prepare the script to be executed on the VM/VE
1691 # in $ENV{'PBDESTDIR'}/setupv
1692
1693 open(SCRIPT,"> $pbscript") || die "Unable to create $pbscript";
1694 print SCRIPT << 'EOF';
1695#!/usr/bin/perl -w
1696
1697use strict;
1698use File::Copy;
1699
1700# We should not need in this script more functions than what is provided
1701# by Base and Distribution to avoid problems at exec time.
1702# They are appended at the end.
1703
1704our $pbdebug;
1705our $pbLOG;
1706our $pbsynmsg = "pbscript";
1707our $pbdisplaytype = "text";
1708our $pblocale = "";
1709pb_log_init($pbdebug, $pbLOG);
1710pb_temp_init();
1711
1712EOF
1713 if ($vtype eq "vm") {
1714 print SCRIPT << 'EOF';
1715# Removes duplicate in .ssh/authorized_keys of our key if needed
1716#
1717my $file1="$ENV{'HOME'}/.ssh/authorized_keys";
1718open(PBFILE,$file1) || die "Unable to open $file1";
1719open(PBOUT,"> $file1.new") || die "Unable to open $file1.new";
1720my $count = 0;
1721while (<PBFILE>) {
1722
1723EOF
1724 print SCRIPT << "EOF";
1725 if (/ $key /) {
1726 \$count++;
1727 }
1728print PBOUT \$_ if ((\$count <= 1) || (\$_ !~ / $key /));
1729}
1730close(PBFILE);
1731close(PBOUT);
1732rename("\$file1.new",\$file1);
1733chmod 0600,\$file1;
1734
1735# Sync date
1736pb_system("/usr/sbin/ntpdate $ntps","Syncing date to $ntps");
1737
1738EOF
1739 }
1740 print SCRIPT << 'EOF';
1741
1742# Adds $pbac->{$ENV{'PBPROJ'}} as an account if needed
1743#
1744my $file="/etc/passwd";
1745open(PBFILE,$file) || die "Unable to open $file";
1746my $found = 0;
1747while (<PBFILE>) {
1748EOF
1749 print SCRIPT << "EOF";
1750 \$found = 1 if (/^$pbac->{$ENV{'PBPROJ'}}:/);
1751EOF
1752 print SCRIPT << 'EOF';
1753}
1754close(PBFILE);
1755
1756if ( $found == 0 ) {
1757 if ( ! -d "/home" ) {
1758 pb_mkdir("/home");
1759 }
1760EOF
1761 print SCRIPT << "EOF";
1762pb_system("groupadd $pbac->{$ENV{'PBPROJ'}}","Adding group $pbac->{$ENV{'PBPROJ'}}");
1763pb_system("useradd $pbac->{$ENV{'PBPROJ'}} -g $pbac->{$ENV{'PBPROJ'}} -m -d /home/$pbac->{$ENV{'PBPROJ'}}","Adding user $pbac->{$ENV{'PBPROJ'}} (group $pbac->{$ENV{'PBPROJ'}} - home /home/$pbac->{$ENV{'PBPROJ'}}");
1764}
1765
1766# allow ssh entry to build
1767#
1768mkdir "/home/$pbac->{$ENV{'PBPROJ'}}/.ssh",0700;
1769# Allow those accessing root to access the build account
1770copy("\$ENV{'HOME'}/.ssh/authorized_keys","/home/$pbac->{$ENV{'PBPROJ'}}/.ssh/authorized_keys");
1771chmod 0600,".ssh/authorized_keys";
1772pb_system("chown -R $pbac->{$ENV{'PBPROJ'}}:$pbac->{$ENV{'PBPROJ'}} /home/$pbac->{$ENV{'PBPROJ'}}/.ssh","Finish setting up the SSH env for $pbac->{$ENV{'PBPROJ'}}");
1773
1774EOF
1775 print SCRIPT << 'EOF';
1776# No passwd for build account only keys
1777$file="/etc/shadow";
1778open(PBFILE,$file) || die "Unable to open $file";
1779open(PBOUT,"> $file.new") || die "Unable to open $file.new";
1780while (<PBFILE>) {
1781EOF
1782 print SCRIPT << "EOF";
1783 s/^$pbac->{$ENV{'PBPROJ'}}:\!\!:/$pbac->{$ENV{'PBPROJ'}}:*:/;
1784 s/^$pbac->{$ENV{'PBPROJ'}}:\!:/$pbac->{$ENV{'PBPROJ'}}:*:/; #SLES 9 e.g.
1785EOF
1786 print SCRIPT << 'EOF';
1787 print PBOUT $_;
1788}
1789close(PBFILE);
1790close(PBOUT);
1791rename("$file.new",$file);
1792chmod 0640,$file;
1793
1794# Keep the VM in text mode
1795$file="/etc/inittab";
1796if (-f $file) {
1797 open(PBFILE,$file) || die "Unable to open $file";
1798 open(PBOUT,"> $file.new") || die "Unable to open $file.new";
1799 while (<PBFILE>) {
1800 s/^(..):5:initdefault:$/$1:3:initdefault:/;
1801 print PBOUT $_;
1802 }
1803 close(PBFILE);
1804 close(PBOUT);
1805 rename("$file.new",$file);
1806 chmod 0640,$file;
1807}
1808
1809# pb has to be added to portage group on gentoo
1810
1811# Adapt sudoers
1812$file="/etc/sudoers";
1813open(PBFILE,$file) || die "Unable to open $file";
1814open(PBOUT,"> $file.new") || die "Unable to open $file.new";
1815while (<PBFILE>) {
1816EOF
1817 print SCRIPT << "EOF";
1818 next if (/^$pbac->{$ENV{'PBPROJ'}} /);
1819EOF
1820 print SCRIPT << 'EOF';
1821 s/Defaults[ \t]+requiretty//;
1822 print PBOUT $_;
1823}
1824close(PBFILE);
1825EOF
1826 print SCRIPT << "EOF";
1827# This is needed in order to be able to halt the machine from the $pbac->{$ENV{'PBPROJ'}} account at least
1828print PBOUT "$pbac->{$ENV{'PBPROJ'}} ALL=(ALL) NOPASSWD:ALL\n";
1829EOF
1830 print SCRIPT << 'EOF';
1831close(PBOUT);
1832rename("$file.new",$file);
1833chmod 0440,$file;
1834
1835EOF
1836
1837 my $SCRIPT = \*SCRIPT;
1838
1839 pb_install_deps($SCRIPT);
1840
1841 print SCRIPT << 'EOF';
1842# Suse wants sudoers as 640
1843if (($ddir eq "sles") || (($ddir eq "suse")) && ($dver =~ /10.[012]/)) {
1844 chmod 0640,$file;
1845}
1846
1847pb_system("rm -rf ProjectBuilder-* ; wget --passive-ftp ftp://ftp.mondorescue.org/src/ProjectBuilder-latest.tar.gz ; tar xvfz ProjectBuilder-latest.tar.gz ; cd ProjectBuilder-* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf ProjectBuilder-* ; rm -rf project-builder-* ; wget --passive-ftp ftp://ftp.mondorescue.org/src/project-builder-latest.tar.gz ; tar xvfz project-builder-latest.tar.gz ; cd project-builder-* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf project-builder-* ;","Building Project-Builder");
1848system "pb 2>&1 | head -5";
1849EOF
1850 # Adds pb_distro_init from ProjectBuilder::Distribution and Base
1851 foreach my $d (@INC) {
1852 my @f = ("$d/ProjectBuilder/Base.pm","$d/ProjectBuilder/Distribution.pm");
1853 foreach my $f (@f) {
1854 if (-f "$f") {
1855 open(PBD,"$f") || die "Unable to open $f";
1856 while (<PBD>) {
1857 next if (/^package/);
1858 next if (/^use Exporter/);
1859 next if (/^use ProjectBuilder::/);
1860 next if (/^our /);
1861 print SCRIPT $_;
1862 }
1863 close(PBD);
1864 }
1865 }
1866 }
1867 close(SCRIPT);
1868 chmod 0755,"$pbscript";
1869
1870 # That build script needs to be run as root and force stop of VM at end
1871 $pbaccount = "root";
1872
1873 # Force shutdown of VM exept if it was already launched
1874 my $force = 0;
1875 if ((! $vmexist) && ($vtype eq "vm")) {
1876 $force = 1;
1877 }
1878
1879 pb_script2v($pbscript,$vtype,$force,$v);
1880}
1881return;
1882}
1883
1884sub pb_install_deps {
1885
1886my $SCRIPT = shift;
1887
1888print {$SCRIPT} << 'EOF';
1889# We need to have that pb_distro_init function
1890# Get it from Project-Builder::Distribution
1891my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init();
1892print "distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n";
1893
1894# Get and install pb
1895my $insdm = "rm -rf Date-Manip* ; wget http://search.cpan.org/CPAN/authors/id/S/SB/SBECK/Date-Manip-5.54.tar.gz ; tar xvfz Date-Manip-5.54.tar.gz ; cd Date-Manip* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf Date-Manip*";
1896my $insmb = "rm -rf Module-Build* ; wget http://search.cpan.org/CPAN/authors/id/K/KW/KWILLIAMS/Module-Build-0.2808.tar.gz ; tar xvfz Module-Build-0.2808.tar.gz ; cd Module-Build* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf Module-Build*";
1897my $insfm = "rm -rf File-MimeInfo* ; wget http://search.cpan.org/CPAN/authors/id/P/PA/PARDUS/File-MimeInfo/File-MimeInfo-0.15.tar.gz ; tar xvfz File-MimeInfo-0.15.tar.gz ; cd File-MimeInfo* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf File-MimeInfo*";
1898my $insfb = "rm -rf File-Basedir* ; wget http://search.cpan.org/CPAN/authors/id/P/PA/PARDUS/File-BaseDir-0.03.tar.gz ; tar xvfz File-BaseDir-0.03.tar.gz ; cd File-BaseDir* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf File-BaseDir*";
1899my $insms = "rm -rf Mail-Sendmail* ; wget http://search.cpan.org/CPAN/authors/id/M/MI/MIVKOVIC/Mail-Sendmail-0.79.tar.gz ; tar xvfz Mail-Sendmail-0.79.tar.gz ; cd Mail-Sendmail* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf Mail-Sendmail*";
1900my $inslg = "rm -rf gettext* ; wget http://search.cpan.org/CPAN/authors/id/P/PV/PVANDRY/gettext-1.05.tar.gz ; tar xvfz gettext-1.05.tar.gz ; cd gettext* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf gettext*";
1901my $cmtdm = "Installing Date-Manip perl module";
1902my $cmtmb = "Installing Module-Build perl module";
1903my $cmtfm = "Installing File-MimeInfo perl module";
1904my $cmtfb = "Installing File-Basedir perl module";
1905my $cmtms = "Installing Perl-Sendmail perl module";
1906my $cmtlg = "Installing Perl-Locale-gettext perl module";
1907my $cmtall = "Installing required modules";
1908
1909if ( $ddir eq "fedora" ) {
1910 pb_system("yum clean all","Cleaning yum env");
1911 #system "yum update -y";
1912 my $arch=`uname -m`;
1913 my $opt = "";
1914 chomp($arch);
1915 if ($arch eq "x86_64") {
1916 $opt="--exclude=*.i?86";
1917 }
1918
1919 if ($dver eq 4) {
1920 pb_system("yum -y $opt install rpm-build wget patch ntp sudo perl-DateManip perl-ExtUtils-MakeMaker",$cmtall);
1921 pb_system("$insmb","$cmtmb");
1922 pb_system("$insfm","$cmtfm");
1923 pb_system("$insfb","$cmtfb");
1924 pb_system("$insms","$cmtms");
1925 pb_system("$inslg","$cmtlg");
1926 } else {
1927 pb_system("yum -y $opt install rpm-build wget patch ntp sudo perl-DateManip perl-ExtUtils-MakeMaker perl-File-MimeInfo perl-Mail-Sendmail",$cmtall);
1928 pb_system("$inslg","$cmtlg");
1929 }
1930} elsif (( $dfam eq "rh" ) || ($ddir eq "sles") || (($ddir eq "suse") && (($dver eq "10.1") || ($dver eq "10.0"))) || ($ddir eq "slackware")) {
1931 # Suppose pkg are installed already as no online mirror available
1932 pb_system("rpm -e lsb 2>&1 > /dev/null","Removing lsb package");
1933 pb_system("$insdm","$cmtdm");
1934 pb_system("$insmb","$cmtmb");
1935 pb_system("$insfm","$cmtfm");
1936 pb_system("$insfb","$cmtfb");
1937 pb_system("$insms","$cmtms");
1938 pb_system("$inslg","$cmtlg");
1939} elsif ($ddir eq "suse") {
1940 # New OpenSuSE
1941 pb_system("$insmb","$cmtmb");
1942 pb_system("$insfm","$cmtfm");
1943 pb_system("$insfb","$cmtfb");
1944 pb_system("$insms","$cmtms");
1945 pb_system("export TERM=linux ; liste=\"\" ; for i in make wget patch sudo perl-DateManip perl-File-HomeDir perl-Mail-Sendmail ntp; do rpm -q \$i 1> /dev/null 2> /dev/null ; if [ \$\? != 0 ]; then liste=\"\$liste \$i\"; fi; done; echo \"Liste: \$liste\" ; if [ \"\$liste\" != \"\" ]; then yast2 -i \$liste ; fi","$cmtall");
1946} elsif ( $dfam eq "md" ) {
1947 pb_system("urpmi.update -a ; urpmi --auto rpm-build wget sudo patch ntp-client perl-File-MimeInfo perl-Mail-Sendmail perl-Locale-gettext","$cmtall");
1948 if (($ddir eq "mandrake") && ($dver eq "10.1")) {
1949 pb_system("$insdm","$cmtdm");
1950 pb_system("$inslg","$cmtlg");
1951 } else {
1952 pb_system("urpmi --auto perl-DateManip","$cmtdm");
1953 pb_system("urpmi --auto perl-Locale-gettext","$cmtdm");
1954 }
1955} elsif ( $dfam eq "du" ) {
1956 if (( $dver eq "3.1" ) && ($ddir eq "debian")) {
1957 #system "apt-get update";
1958 pb_system("$insfb","$cmtfb");
1959 pb_system("$insfm","$cmtfm");
1960 pb_system("apt-get -y install wget patch ssh sudo debian-builder dh-make fakeroot ntpdate libmodule-build-perl libdate-manip-perl libmail-sendmail-perl liblocale-gettext-perl","$cmtall");
1961 } else {
1962 pb_system("apt-get update; apt-get -y install wget patch openssh-server dpkg-dev sudo debian-builder dh-make fakeroot ntpdate libfile-mimeinfo-perl libmodule-build-perl libdate-manip-perl libmail-sendmail-perl liblocale-gettext-perl","$cmtall");
1963 }
1964} elsif ( $dfam eq "gen" ) {
1965 #system "emerge -u system";
1966 pb_system("emerge wget sudo ntp DateManip File-MimeInfo Mail-Sendmail Locale-gettext","$cmtall");
1967} else {
1968 pb_log(0,"No pkg to install\n");
1969}
1970EOF
1971}
1972
1973sub pb_announce {
1974
1975 # Get all required parameters
1976 my ($pbpackager,$pbrepo,$pbml,$pbsmtp) = pb_conf_get("pbpackager","pbrepo","pbml","pbsmtp");
1977 my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
1978 my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
1979 my @pkgs = @$pkg;
1980 my %pkgs;
1981 my $first = 0;
1982
1983 # Command to find packages on repo
1984 my $findstr = "find . ";
1985 # Generated announce files
1986 my @files;
1987
1988 foreach my $pbpkg (@pkgs) {
1989 if ($first != 0) {
1990 $findstr .= "-o ";
1991 }
1992 $first++;
1993 if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
1994 $pbver = $pkgv->{$pbpkg};
1995 } else {
1996 $pbver = $ENV{'PBPROJVER'};
1997 }
1998 if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
1999 $pbtag = $pkgt->{$pbpkg};
2000 } else {
2001 $pbtag = $ENV{'PBPROJTAG'};
2002 }
2003
2004 # TODO: use virtual/real names here now
2005 $findstr .= "-name \'$pbpkg-$pbver-$pbtag\.*.rpm\' -o -name \'$pbpkg"."_$pbver*\.deb\' -o -name \'$pbpkg-$pbver\.ebuild\' ";
2006
2007 my $chglog;
2008
2009 # Get project info on log file and generate tmp files used later on
2010 pb_cms_init($pbinit);
2011 $chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
2012 $chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
2013 $chglog = undef if (! -f $chglog);
2014
2015 open(OUT,"> $ENV{'PBTMP'}/$pbpkg.ann") || die "Unable to create $ENV{'PBTMP'}/$pbpkg.ann: $!";
2016 pb_changelog("announce",$pbpkg,$pbver,"N/A","N/A","N/A",\*OUT,"yes",$chglog);
2017 close(OUT);
2018 push(@files,"$ENV{'PBTMP'}/$pbpkg.ann");
2019 }
2020 $findstr .= " | grep -Ev \'src.rpm\'";
2021 if ((not defined $testver) || (not defined $testver->{$ENV{'PBPROJ'}}) || ($testver->{$ENV{'PBPROJ'}} !~ /true/i)) {
2022 $findstr .= " | grep -v ./test/";
2023 }
2024
2025 # Prepare the command to run and execute it
2026 open(PBS,"> $ENV{'PBTMP'}/pbscript") || die "Unable to create $ENV{'PBTMP'}/pbscript";
2027 print PBS "$findstr\n";
2028 close(PBS);
2029 chmod 0755,"$ENV{'PBTMP'}/pbscript";
2030 pb_send2target("Announce");
2031
2032 # Get subject line
2033 my $sl = "Project $ENV{'PBPROJ'} version $ENV{'PBPROJVER'} is now available";
2034 pb_log(0,"Please enter the title of your announce\n");
2035 pb_log(0,"(By default: $sl)\n");
2036 my $sl2 = <STDIN>;
2037 $sl = $sl2 if ($sl2 !~ /^$/);
2038
2039 # Prepare a template of announce
2040 open(ANN,"> $ENV{'PBTMP'}/announce.html") || die "Unable to create $ENV{'PBTMP'}/announce.html: $!";
2041 print ANN << "EOF";
2042$sl</p>
2043
2044<p>The project team is happy to announce the availability of a newest version of $ENV{'PBPROJ'} $ENV{'PBPROJVER'}. Enjoy it as usual!</p>
2045<p>
2046Now available at <a href="$pbrepo->{$ENV{'PBPROJ'}}">$pbrepo->{$ENV{'PBPROJ'}}</a>
2047</p>
2048<p>
2049EOF
2050 open(LOG,"$ENV{'PBTMP'}/system.log") || die "Unable to read $ENV{'PBTMP'}/system.log: $!";
2051 my $col = 2;
2052 my $i = 1;
2053 print ANN << 'EOF';
2054<TABLE WIDTH="700" CELLPADDING="0" CELLSPACING="0" BORDER="0">
2055<TR>
2056EOF
2057 while (<LOG>) {
2058 print ANN "<TD>$_</TD>";
2059 $i++;
2060 if ($i > $col) {
2061 print ANN "</TR>\n<TR>";
2062 $i = 1;
2063 }
2064 }
2065 close(LOG);
2066 print ANN << "EOF";
2067</TR>
2068</TABLE>
2069</p>
2070
2071<p>As usual source packages are also available in the same directory.</p>
2072
2073<p>
2074Changes are :
2075</p>
2076<p>
2077EOF
2078 # Get each package changelog content
2079 foreach my $f (sort(@files)) {
2080 open(IN,"$f") || die "Unable to read $f:$!";
2081 while (<IN>) {
2082 print ANN $_;
2083 }
2084 close(IN);
2085 print ANN "</p><p>\n";
2086 }
2087 print ANN "</p>\n";
2088 close(ANN);
2089
2090 # Allow for modification
2091 pb_system("vi $ENV{'PBTMP'}/announce.html","Allowing modification of the announce","noredir");
2092
2093 # Store it in DB for external usage (Web pages generation)
2094 my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
2095
2096 my $precmd = "";
2097 if (! -f $db) {
2098 $precmd = "CREATE TABLE announces (id INTEGER PRIMARY KEY AUTOINCREMENT, date DATE, announce VARCHAR[65535])";
2099 }
2100
2101 my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
2102 { RaiseError => 1, AutoCommit => 1 })
2103 || die "Unable to connect to $db";
2104
2105 if ($precmd ne "") {
2106 my $sth = $dbh->prepare(qq{$precmd})
2107 || die "Unable to create table into $db";
2108 $sth->execute();
2109 }
2110
2111 # To read whole file
2112 local $/;
2113 open(ANN,"$ENV{'PBTMP'}/announce.html") || die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
2114 my $announce = <ANN>;
2115 close(ANN);
2116
2117 pb_log(2,"INSERT INTO announces VALUES (NULL, $pbdate, $announce)");
2118 my $sth = $dbh->prepare(qq{INSERT INTO announces VALUES (NULL,?,?)})
2119 || die "Unable to insert into $db";
2120 $sth->execute($pbdate, $announce);
2121 $dbh->disconnect;
2122
2123 # Then deliver it on the Web
2124 # $TOOLHOME/livwww www
2125
2126 # Mail it to project's ML
2127 open(ML,"| w3m -dump -T text/html > $ENV{'PBTMP'}/announce.txt") || die "Unable to create $ENV{'PBTMP'}/announce.txt: $!";
2128 print ML << 'EOF';
2129<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/x html1/DTD/xhtml1-strict.dtd">
2130
2131<html xmlns="http://www.w3.org/1999/xhtml" dir="ltr" xml:lang="en" lang="en">
2132 <head>
2133 </head>
2134 <body>
2135 <p>
2136EOF
2137 open(ANN,"$ENV{'PBTMP'}/announce.html") || die "Unable to read $ENV{'PBTMP'}/announce.html: $!";
2138 while(<ANN>) {
2139 print ML $_;
2140 }
2141 print ML << 'EOF';
2142</body>
2143</html>
2144EOF
2145 close(ML);
2146
2147 # To read whole file
2148 local $/;
2149 open(ANN,"$ENV{'PBTMP'}/announce.txt") || die "Unable to read $ENV{'PBTMP'}/announce.txt: $!";
2150 my $msg = <ANN>;
2151 close(ANN);
2152
2153 # Preparation of headers
2154
2155 my %mail = (
2156 To => $pbml->{$ENV{'PBPROJ'}},
2157 From => $pbpackager->{$ENV{'PBPROJ'}},
2158 Smtp => $pbsmtp->{$ENV{'PBPROJ'}},
2159 Body => $msg,
2160 Subject => "[ANNOUNCE] $sl",
2161 );
2162
2163 # Send mail
2164 sendmail(%mail) or die "Unable to send mail ($Mail::Sendmail::error): $Mail::Sendmail::log";
2165}
2166
2167#
2168# Creates a set of HTML file containing the news for the project
2169# based on what has been generated by the pb_announce function
2170#
2171sub pb_web_news2html {
2172
2173 my $dest = shift || $ENV{'PBTMP'};
2174
2175 # Get all required parameters
2176 my ($pkgv, $pkgt, $testver) = pb_conf_get_if("pkgver","pkgtag","testver");
2177
2178 # DB of announces for external usage (Web pages generation)
2179 my $db = "$ENV{'PBCONFDIR'}/announces3.sql";
2180
2181 my $dbh = DBI->connect("dbi:SQLite:dbname=$db","","",
2182 { RaiseError => 1, AutoCommit => 1 })
2183 || die "Unable to connect to $db";
2184 # For date handling
2185 $ENV{LANGUAGE}="C";
2186 my $firstjan = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year(), 0, 0, -1);
2187 my $oldfirst = strftime("%Y-%m-%d", 0, 0, 0, 1, 0, localtime->year()-1, 0, 0, -1);
2188 pb_log(2,"firstjan: $firstjan, oldfirst: $oldfirst, pbdate:$pbdate\n");
2189 my $all = $dbh->selectall_arrayref("SELECT id,date,announce FROM announces ORDER BY date DESC");
2190 my %news;
2191 $news{"cy"} = ""; # current year's news
2192 $news{"ly"} = ""; # last year news
2193 $news{"py"} = ""; # previous years news
2194 $news{"fp"} = ""; # first page news
2195 my $cpt = 4; # how many news for first page
2196 # Extract info from DB
2197 foreach my $row (@$all) {
2198 my ($id, $date, $announce) = @$row;
2199 $news{"cy"} = $news{"cy"}."<p><B>$date</B> $announce\n" if ((($date cmp $pbdate) le 0) && (($firstjan cmp $date) le 0));
2200 $news{"ly"} = $news{"ly"}."<p><B>$date</B> $announce\n" if ((($date cmp $firstjan) le 0) && (($oldfirst cmp $date) le 0));
2201 $news{"py"} = $news{"py"}."<p><B>$date</B> $announce\n" if (($date cmp $oldfirst) le 0);
2202 $news{"fp"} = $news{"fp"}."<p><B>$date</B> $announce\n" if ($cpt > 0);
2203 $cpt--;
2204 }
2205 pb_log(1,"news{fp}: ".$news{"fp"}."\n");
2206 $dbh->disconnect;
2207
2208 # Generate the HTML content
2209 foreach my $pref (keys %news) {
2210 open(NEWS,"> $dest/pb_web_$pref"."news.html") || die "Unable to create $dest/pb_web_$pref"."news.html: $!";
2211 print NEWS "$news{$pref}";
2212 close(NEWS);
2213 }
2214}
2215
2216
2217# Return the SSH key file to use
2218# Potentially create it if needed
2219
2220sub pb_ssh_get {
2221
2222my $create = shift || 0; # Do not create keys by default
2223
2224# Check the SSH environment
2225my $keyfile = undef;
2226
2227# We have specific keys by default
2228$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
2229if (!(-e $keyfile) && ($create eq 1)) {
2230 pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
2231}
2232
2233$keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
2234$keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
2235$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
2236die "Unable to find your public ssh key under $keyfile" if (not defined $keyfile);
2237return($keyfile);
2238}
2239
2240
2241# Returns the pid of a running VM command using a specific VM file
2242sub pb_check_ps {
2243 my $vmcmd = shift;
2244 my $vmm = shift;
2245 my $vmexist = 0; # FALSE by default
2246
2247 open(PS, "ps auxhww|") || die "Unable to call ps";
2248 while (<PS>) {
2249 next if (! /$vmcmd/);
2250 next if (! /$vmm/);
2251 my ($void1, $void2);
2252 ($void1, $vmexist, $void2) = split(/ +/);
2253 last;
2254 }
2255 return($vmexist);
2256}
2257
2258
2259sub pb_extract_build_files {
2260
2261my $src=shift;
2262my $dir=shift;
2263my $ddir=shift;
2264my $mandatory=shift || "spec";
2265my @files;
2266
2267my $flag = "mayfail" if ($mandatory eq "patch");
2268my $res;
2269
2270if ($src =~ /tar\.gz$/) {
2271 $res = pb_system("tar xfpz $src $dir","Extracting $mandatory files from $src",$flag);
2272} elsif ($src =~ /tar\.bz2$/) {
2273 $res = pb_system("tar xfpj $src $dir","Extracting $mandatory files from $src",$flag);
2274} else {
2275 die "Unknown compression algorithm for $src";
2276}
2277# If not mandatory return now
2278return() if (($res != 0) and ($mandatory eq "patch"));
2279opendir(DIR,"$dir") || die "Unable to open directory $dir";
2280foreach my $f (readdir(DIR)) {
2281 next if ($f =~ /^\./);
2282 # Skip potential patch dir
2283 next if ($f =~ /^pbpatch/);
2284 move("$dir/$f","$ddir") || die "Unable to move $dir/$f to $ddir";
2285 pb_log(2,"mv $dir/$f $ddir\n");
2286 push @files,"$ddir/$f";
2287}
2288closedir(DIR);
2289# Not enough but still a first cleanup
2290pb_rm_rf("$dir");
2291return(@files);
2292}
2293
2294sub pb_list_bfiles {
2295
2296my $dir = shift;
2297my $pbpkg = shift;
2298my $bfiles = shift;
2299my $pkgfiles = shift;
2300my $supfiles = shift;
2301
2302opendir(BDIR,"$dir") || die "Unable to open dir $dir: $!";
2303foreach my $f (readdir(BDIR)) {
2304 next if ($f =~ /^\./);
2305 $bfiles->{$f} = "$dir/$f";
2306 $bfiles->{$f} =~ s~$ENV{'PBROOTDIR'}~~;
2307 if (defined $supfiles->{$pbpkg}) {
2308 $pkgfiles->{$f} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
2309 }
2310}
2311closedir(BDIR);
2312}
2313
2314
2315#
2316# Return the list of packages we are working on in a non CMS action
2317#
2318sub pb_get_pkg {
2319
2320my @pkgs = ();
2321
2322my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
2323@pkgs = keys %$var;
2324
2325pb_log(0,"Packages: ".join(',',@pkgs)."\n");
2326return(\@pkgs);
2327}
2328
2329# Which is our local arch ? (standardize on i386 for those platforms)
2330sub pb_get_arch {
2331
2332my $arch = `uname -m`;
2333chomp($arch);
2334$arch =~ s/i.86/i386/;
2335return($arch);
2336}
2337
23381;
Note: See TracBrowser for help on using the repository browser.