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

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

First coding of pb_web_news2html which generates news from the announces DB in order to be used on the Website

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