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

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