source: devel/pb/bin/pb @ 362

Last change on this file since 362 was 362, checked in by Bruno Cornec, 12 years ago

syntax error

  • Property svn:executable set to *
File size: 50.7 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 Pod::Usage;
15use Data::Dumper;
16use English;
17use File::Basename;
18use File::Copy;
19use Time::localtime qw(localtime);
20use POSIX qw(strftime);
21
22# Global variables
23use lib qw (lib);
24use ProjectBuilder::Distribution;
25use ProjectBuilder::Version;
26use ProjectBuilder::Base;
27
28my %opts;                   # CLI Options
29my $action;                 # action to realize
30my $test = "FALSE";         # Not used
31my $force = 0;              # Force VE/VM rebuild
32my $option = "";            # Not used
33my @pkgs;                   # list of packages
34my $pbtag;                  # Global Tag variable
35my $pbver;                  # Global Version variable
36my $pbscript;               # Name of the script
37my %pbver;                  # per package
38my %pbtag;                  # per package
39my $pbrev;                  # Global REVISION variable
40my $pbaccount;              # Login to use to connect to the VM
41my $pbport;                 # Port to use to connect to the VM
42my $newver;                 # New version to create
43my $iso;                    # ISO image for the VM to create
44
45my @date = pb_get_date();
46my $pbdate = strftime("%Y-%m-%d", @date);
47
48=pod
49
50=head1 NAME
51
52pb, aka project-builder.org - builds packages for your projects
53
54=head1 DESCRIPTION
55
56pb helps you build various packages directly from your project sources.
57Those sources could be handled by a CMS (Configuration Management System)
58such as Subversion, CVS, ... or being a simple reference to a compressed tar file.
59It's based on a set of configuration files, a set of provided macros to help
60you keeping build files as generic as possible. For example, a single .spec
61file should be required to generate for all rpm based distributions, even
62if you could also have multiple .spec files if required.
63
64=head1 SYNOPSIS
65
66pb [-vhq][-r pbroot][-p project][[-s script -a account -P port][-m mach-1[,...]]][-i iso] <action> [<pkg1> ...]
67
68pb [--verbose][--help][--man][--quiet][--revision pbroot][--project project][[--script script --account account --port port][--machine mach-1[,...]]][--iso iso] <action> [<pkg1> ...]
69
70=head1 OPTIONS
71
72=over 4
73
74=item B<-v|--verbose>
75
76Print a brief help message and exits.
77
78=item B<-q|--quiet>
79
80Do not print any output.
81
82=item B<-h|--help>
83
84Print a brief help message and exits.
85
86=item B<--man>
87
88Prints the manual page and exits.
89
90=item B<-m|--machine machine1[,machine2,...]>
91
92Name of the Virtual Machines (VM) or Virtual Environments (VE) you want to build on (coma separated).
93All if none precised (or use the env variable PBV).
94
95=item B<-s|--script script>
96
97Name of the script you want to execute on the related VMs or VEs.
98
99=item B<-i|--iso iso_image>
100
101Name of the ISO image of the distribution you want to install on the related VMs.
102
103=item B<-a|--account account>
104
105Name of the account to use to connect on the related VMs.
106
107=item B<-P|--port port_number>
108
109Port number to use to connect on the related VMs.\n";
110
111=item B<-p|--project project_name>
112
113Name of the project you're working on (or use the env variable PBPROJ)
114
115=item B<-r|--revision revision>
116
117Path Name of the project revision under the CMS (or use the env variable PBROOT)
118
119=item B<-V|--version new_version>
120
121New version of the project to create based on the current one.
122
123=back
124
125=head1 ARGUMENTS
126
127<action> can be:
128
129=over 4
130
131=item B<cms2build>
132
133Create tar files for the project under your CMS.
134CMS supported are SVN and CVS
135parameters are packages to build
136if not using default list
137
138=item B<build2pkg>
139
140Create packages for your running distribution
141
142=item B<cms2pkg>
143
144cms2build + build2pkg
145
146=item B<build2ssh>
147
148Send the tar files to a SSH host
149
150=item B<cms2ssh>
151
152cms2build + build2ssh
153
154=item B<pkg2ssh>
155
156Send the packages built to a SSH host
157
158=item B<build2vm>
159
160Create packages in VMs, launching them if needed
161and send those packages to a SSH host once built
162VM type supported are QEMU
163
164=item B<build2ve>
165
166Create packages in VEs, creating it if needed
167and send those packages to a SSH host once built
168
169=item B<cms2vm>
170
171cms2build + build2vm
172
173=item B<cms2ve>
174
175cms2build + build2ve
176
177=item B<launchvm>
178
179Launch one virtual machine
180
181=item B<launchve>
182
183Launch one virtual environment
184
185=item B<script2vm>
186
187Launch one virtual machine if needed
188and executes a script on it
189
190=item B<script2ve>
191
192Execute a script in a virtual environment
193
194=item B<newvm>
195
196Create a new virtual machine
197
198=item B<newve>
199
200Create a new virtual environment
201
202=item B<setupvm>
203
204Setup a virtual machine for pb usage
205
206=item B<setupve>
207
208Setup a virtual environment for pb usage
209
210=item B<newver>
211
212Create a new version of the project derived
213from the current one
214
215=item B<newproj>
216
217Create a new project and a template set of
218configuration files under pbconf
219
220=back
221
222<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).
223
224=head1 WEB SITES
225
226The 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/>.
227
228=head1 USER MAILING LIST
229
230None exists for the moment.
231
232=head1 CONFIGURATION FILES
233
234Each pb user may have a configuration in F<$HOME/.pbrc>. The values in this file may overwrite any other configuration file value.
235
236Here is an example of such a configuration file:
237
238 #
239 # Define for each project the URL of its pbconf repository
240 # No default option allowed here as they need to be all different
241 #
242 # URL of the pbconf content
243 # This is the format of a classical URL with the extension of additional schema such as
244 # svn+ssh, cvs+ssh, ...
245 #
246 pbconfurl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe/pbconf
247
248 # This is normaly defined in the project's configuration file
249 # Url of the project
250 #
251 pburl linuxcoe = cvs+ssh://:ext:bcornec@linuxcoe.cvs.sourceforge.net:/cvsroot/linuxcoe
252 
253 # All these URLs needs to be defined here as the are the entry point
254 # for how to build packages for the project
255 #
256 pbconfurl pb = svn+ssh://svn.project-builder.org/mondo/svn/pb/pbconf
257 pbconfurl mondorescue = svn+ssh://svn.project-builder.org/mondo/svn/project-builder/mondorescue/pbconf
258 pbconfurl collectl = svn+ssh://bruno@svn.mondorescue.org/mondo/svn/project-builder/collectl/pbconf
259 pbconfurl netperf = svn+ssh://svn.mondorescue.org/mondo/svn/project-builder/netperf/pbconf
260 
261 # Under that dir will take place everything related to pb
262 # If you want to use VMs/chroot/..., then use $ENV{'HOME'} to make it portable
263 # to your VMs/chroot/...
264 # if not defined then /var/cache
265 pbdefdir default = $ENV{'HOME'}/project-builder
266 pbdefdir pb = $ENV{'HOME'}
267 pbdefdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
268 pbdefdir mondorescue = $ENV{'HOME'}/mondo/svn
269 
270 # pbconfdir points to the directory where the CMS content of the pbconfurl is checked out
271 # If not defined, pbconfdir is under pbdefdir/pbproj/pbconf
272 pbconfdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs/pbconf
273 pbconfdir mondorescue = $ENV{'HOME'}/mondo/svn/pbconf
274 
275 # pbdir points to the directory where the CMS content of the pburl is checked out
276 # If not defined, pbdir is under pbdefdir/pbproj
277 # Only defined if we have access to the dev of the project
278 pbdir linuxcoe = $ENV{'HOME'}/LinuxCOE/cvs
279 pbdir mondorescue = $ENV{'HOME'}/mondo/svn
280 
281 # -daemonize doesn't work with qemu 0.8.2
282 vmopt default = -m 384
283
284=head1 AUTHORS
285
286The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
287
288=head1 COPYRIGHT
289
290Project-Builder.org is distributed under the GPL v2.0 license
291described in the file C<COPYING> included with the distribution.
292
293=cut
294
295# ---------------------------------------------------------------------------
296
297# Old syntax
298#getopts('a:fhi:l:m:P:p:qr:s:vV:',\%opts);
299
300my ($projectbuilderver,$projectbuilderrev) = pb_version_init();
301
302GetOptions("help|?|h" => \$opts{'h'}, 
303        "man" => \$opts{'man'},
304        "verbose|v+" => \$opts{'v'},
305        "quiet|q" => \$opts{'q'},
306        "log-files|l=s" => \$opts{'l'},
307        "force|f" => \$opts{'f'},
308        "account|a=s" => \$opts{'a'},
309        "revision|r=s" => \$opts{'r'},
310        "script|s=s" => \$opts{'s'},
311        "machines|mock|m=s" => \$opts{'m'},
312        "port|P=i" => \$opts{'P'},
313        "project|p=s" => \$opts{'p'},
314        "iso|i=s" => \$opts{'i'},
315        "version|V=s" => \$opts{'V'},
316) || pb_syntax(-1,0);
317
318if (defined $opts{'h'}) {
319    pb_syntax(0,1);
320}
321if (defined $opts{'man'}) {
322    pb_syntax(0,2);
323}
324if (defined $opts{'v'}) {
325    $debug = $opts{'v'};
326    pb_log(0,"Debug value: $debug\n");
327}
328if (defined $opts{'f'}) {
329    $force=1;
330}
331if (defined $opts{'q'}) {
332    $debug=-1;
333}
334if (defined $opts{'l'}) {
335    open(LOG,"> $opts{'l'}") || die "Unable to log to $opts{'l'}: $!";
336    $LOG = \*LOG;
337    $debug = 0  if ($debug == -1);
338    }
339pb_log_init($debug, $LOG);
340
341# Handle root of the project if defined
342if (defined $opts{'r'}) {
343    $ENV{'PBROOTDIR'} = $opts{'r'};
344}
345# Handle virtual machines if any
346if (defined $opts{'m'}) {
347    $ENV{'PBV'} = $opts{'m'};
348}
349if (defined $opts{'s'}) {
350    $pbscript = $opts{'s'};
351}
352if (defined $opts{'a'}) {
353    $pbaccount = $opts{'a'};
354    die "option -a requires a -s script option" if (not defined $pbscript);
355}
356if (defined $opts{'P'}) {
357    $pbport = $opts{'P'};
358}
359if (defined $opts{'V'}) {
360    $newver = $opts{'V'};
361}
362if (defined $opts{'i'}) {
363    $iso = $opts{'i'};
364}
365
366# Get Action
367$action = shift @ARGV;
368die pb_syntax(-1,1) if (not defined $action);
369
370my ($filteredfiles, $supfiles, $defpkgdir, $extpkgdir);
371my $pbinit = undef;
372$pbinit = 1 if ($action =~ /^newproj$/);
373
374# Handles project name if any
375# And get global params
376($filteredfiles, $supfiles, $defpkgdir, $extpkgdir) = pb_env_init($opts{'p'},$pbinit,$action);
377
378pb_log(0,"Project: $ENV{'PBPROJ'}\n");
379pb_log(0,"Action: $action\n");
380
381# Act depending on action
382if ($action =~ /^cms2build$/) {
383    pb_cms2build();
384} elsif ($action =~ /^build2pkg$/) {
385    pb_build2pkg();
386} elsif ($action =~ /^cms2pkg$/) {
387    pb_cms2build();
388    pb_build2pkg();
389} elsif ($action =~ /^build2ssh$/) {
390    pb_build2ssh();
391} elsif ($action =~ /^cms2ssh$/) {
392    pb_cms2build();
393    pb_build2ssh();
394} elsif ($action =~ /^pkg2ssh$/) {
395    pb_pkg2ssh();
396} elsif ($action =~ /^build2ve$/) {
397    pb_build2v("ve");
398} elsif ($action =~ /^build2vm$/) {
399    pb_build2v("vm");
400} elsif ($action =~ /^cms2ve$/) {
401    pb_cms2build();
402    pb_build2v("ve");
403} elsif ($action =~ /^cms2vm$/) {
404    pb_cms2build();
405    pb_build2v("vm");
406} elsif ($action =~ /^launchvm$/) {
407    pb_launchv("vm",$ENV{'PBV'},0);
408} elsif ($action =~ /^launchve$/) {
409    pb_launchv("ve",$ENV{'PBV'},0);
410} elsif ($action =~ /^script2vm$/) {
411    pb_script2v($pbscript,"vm");
412} elsif ($action =~ /^script2ve$/) {
413    pb_script2v($pbscript,"ve");
414} elsif ($action =~ /^newver$/) {
415    pb_newver();
416} elsif ($action =~ /^newve$/) {
417    pb_launchv("ve",$ENV{'PBV'},1);
418} elsif ($action =~ /^newvm$/) {
419    pb_launchv("vm",$ENV{'PBV'},1);
420} elsif ($action =~ /^setupve$/) {
421    pb_setup_v("ve");
422} elsif ($action =~ /^setupvm$/) {
423    pb_setup_v("vm");
424} elsif ($action =~ /^newproj$/) {
425    # Nothing to do - already done in pb_env_init
426} elsif ($action =~ /^clean$/) {
427} else {
428    pb_log(0,"\'$action\' is not available\n");
429    pb_syntax(-2,1);
430}
431
432sub pb_cms2build {
433
434    my $pkg = pb_cms_get_pkg($defpkgdir,$extpkgdir);
435    my @pkgs = @$pkg;
436    my %pkgs;
437
438    my ($scheme, $uri) = pb_cms_init($pbinit);
439
440    my ($pkgv, $pkgt) = pb_conf_get_if("pkgver","pkgtag");
441
442    # declare packager for filtering
443    my ($tmp) = pb_conf_get("pbpackager");
444    $ENV{'PBPACKAGER'} = $tmp->{$ENV{'PBPROJ'}};
445
446    foreach my $pbpkg (@pkgs) {
447        $ENV{'PBPKG'} = $pbpkg;
448        if ((defined $pkgv) && (defined $pkgv->{$pbpkg})) {
449            $pbver = $pkgv->{$pbpkg};
450        } else {
451            $pbver = $ENV{'PBPROJVER'};
452        }
453        if ((defined $pkgt) && (defined $pkgt->{$pbpkg})) {
454            $pbtag = $pkgt->{$pbpkg};
455        } else {
456            $pbtag = $ENV{'PBPROJTAG'};
457        }
458
459        $pbrev = $ENV{'PBREVISION'};
460        pb_log(0,"\n");
461        pb_log(0,"Management of $pbpkg $pbver-$pbtag (rev $pbrev)\n");
462        die "Unable to get env var PBDESTDIR" if (not defined $ENV{'PBDESTDIR'});
463        # Clean up dest if necessary. The export will recreate it
464        my $dest = "$ENV{'PBDESTDIR'}/$pbpkg-$pbver";
465        pb_rm_rf($dest) if (-d $dest);
466
467        # Export CMS tree for the concerned package to dest
468        # And generate some additional files
469        $OUTPUT_AUTOFLUSH=1;
470
471        # computes in which dir we have to work
472        my $dir = $defpkgdir->{$pbpkg};
473        $dir = $extpkgdir->{$pbpkg} if (not defined $dir);
474        pb_log(2,"def:".Dumper($defpkgdir)." ext: ".Dumper($extpkgdir)." \n");
475
476        # Exporting from CMS
477        pb_cms_export($uri,"$ENV{'PBDIR'}/$dir",$dest);
478
479        # Get project info on authors and log file
480        my $chglog = "$ENV{'PBROOTDIR'}/$pbpkg/pbcl";
481        $chglog = "$ENV{'PBROOTDIR'}/pbcl" if (! -f $chglog);
482        $chglog = undef if (! -f $chglog);
483
484        my $authors = "$ENV{'PBROOTDIR'}/$pbpkg/pbauthors";
485        $authors = "$ENV{'PBROOTDIR'}/pbauthors" if (! -f $authors);
486        $authors = "/dev/null" if (! -f $authors);
487
488        # Extract cms log history and store it
489        if ((defined $chglog) && (! -f "$dest/NEWS")) {
490            pb_log(2,"Generating NEWS file from $chglog\n");
491            copy($chglog,"$dest/NEWS") || die "Unable to create $dest/NEWS";
492        }
493        pb_cms_log($scheme,"$ENV{'PBDIR'}/$dir",$dest,$chglog,$authors);
494
495        my %build;
496
497        my @pt;
498        @pt = pb_conf_get_if("vmlist","velist");
499        my $tmpl = "";
500        if (defined $pt[0]->{$ENV{'PBPROJ'}}) {
501            $tmpl .= $pt[0]->{$ENV{'PBPROJ'}};
502        }
503        if (defined $pt[1]->{$ENV{'PBPROJ'}}) {
504            # the 2 lists needs to be grouped with a ',' separated them
505            if ($tmpl ne "") {
506                $tmpl .= ",";
507            }
508            $tmpl .= $pt[1]->{$ENV{'PBPROJ'}} 
509        }
510        foreach my $d (split(/,/,$tmpl)) {
511            my ($name,$ver,$arch) = split(/-/,$d);
512            chomp($arch);
513            my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($name,$ver);
514            pb_log(2,"DEBUG: distro tuple: ".Dumper($ddir, $dver, $dfam, $dtype, $pbsuf)."\n");
515            pb_log(2,"DEBUG Filtering PBDATE => $pbdate, PBTAG => $pbtag, PBVER => $pbver\n");
516
517            # Filter build files from the less precise up to the most with overloading
518            # Filter all files found, keeping the name, and generating in dest
519
520            # Find all build files first relatively to PBROOTDIR
521            # Find also all specific files referenced in the .pb conf file
522            my %bfiles = ();
523            my %pkgfiles = ();
524            $build{"$ddir-$dver"} = "yes";
525
526            if (-d "$ENV{'PBROOTDIR'}/$pbpkg/$dtype") {
527                pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$dtype",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
528            } elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$dfam") {
529                pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$dfam",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
530            } elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir") {
531                pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
532            } elsif (-d "$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver") {
533                pb_list_bfiles("$ENV{'PBROOTDIR'}/$pbpkg/$ddir-$dver",$pbpkg,\%bfiles,\%pkgfiles,$supfiles);
534            } else {
535                $build{"$ddir-$dver"} = "no";
536                next;
537            }
538            pb_log(2,"DEBUG bfiles: ".Dumper(\%bfiles)."\n");
539
540            # Get all filters to apply
541            my $ptr = pb_get_filters($pbpkg, $dtype, $dfam, $ddir, $dver);
542
543            # Apply now all the filters on all the files concerned
544            # destination dir depends on the type of file
545            if (defined $ptr) {
546                foreach my $f (values %bfiles,values %pkgfiles) {
547                    pb_filter_file_pb("$ENV{'PBROOTDIR'}/$f",$ptr,"$dest/pbconf/$ddir-$dver/".basename($f),$dtype,$pbsuf,$ENV{'PBPROJ'},$pbpkg,$pbver,$pbtag,$pbrev,$pbdate,$defpkgdir,$extpkgdir,$ENV{'PBPACKAGER'},$chglog);
548                }
549            }
550        }
551        my @found;
552        my @notfound;
553        foreach my $b (keys %build) {
554            push @found,$b if ($build{$b} =~ /yes/);
555            push @notfound,$b if ($build{$b} =~ /no/);
556        }
557        pb_log(0,"Build files generated for ".join(',',@found)."\n");
558        pb_log(0,"No Build files found for ".join(',',@notfound)."\n") if (@notfound);
559        # Get the generic filter (all.pbf) and
560        # apply those to the non-build files including those
561        # generated by pbinit if applicable
562
563        # Get only all.pbf filter
564        my $ptr = pb_get_filters($pbpkg);
565
566        my $liste ="";
567        if (defined $filteredfiles->{$pbpkg}) {
568            foreach my $f (split(/,/,$filteredfiles->{$pbpkg})) {
569                pb_filter_file_inplace($ptr,"$dest/$f",$ENV{'PBPROJ'},$pbpkg,$pbver,$pbtag,$pbrev,$pbdate,$ENV{'PBPACKAGER'});
570                $liste = "$f $liste";
571            }
572        }
573        pb_log(2,"Files ".$liste."have been filtered\n");
574
575        # Prepare the dest directory for archive
576        if (-x "$ENV{'PBROOTDIR'}/$pbpkg/pbinit") {
577            pb_filter_file("$ENV{'PBROOTDIR'}/$pbpkg/pbinit",$ptr,"$ENV{'PBTMP'}/pbinit",$ENV{'PBPROJ'},$pbpkg,$pbver,$pbtag,$pbrev,$pbdate,$ENV{'PBPACKAGER'});
578            chmod 0755,"$ENV{'PBTMP'}/pbinit";
579            pb_system("cd $dest ; $ENV{'PBTMP'}/pbinit","Executing init script from $ENV{'PBROOTDIR'}/$pbpkg/pbinit");
580        }
581
582        # Archive dest dir
583        chdir "$ENV{'PBDESTDIR'}" || die "Unable to change dir to $ENV{'PBDESTDIR'}";
584        # Possibility to look at PBSRC to guess more the filename
585        pb_system("tar cfz $pbpkg-$pbver.tar.gz $pbpkg-$pbver","Creating $pbpkg tar files compressed");
586        pb_log(0,"Under $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz\n");
587
588        # Keep track of version-tag per pkg
589        $pkgs{$pbpkg} = "$pbver-$pbtag";
590
591        # Final cleanup
592        pb_rm_rf($dest) if (-d $dest);
593    }
594
595    # Keep track of per package version
596    pb_log(2,"DEBUG pkgs: ".Dumper(%pkgs)."\n");
597    open(PKG,"> $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb") || die "Unable to create $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb";
598    foreach my $pbpkg (@pkgs) {
599        print PKG "pbpkg $pbpkg = $pkgs{$pbpkg}\n";
600    }
601    close(PKG);
602
603    # Keep track of what is generated by default
604    # We need to store the dir and info on version-tag
605    # Base our content on the existing .pb file
606    copy("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb","$ENV{'PBDESTDIR'}/pbrc");
607    open(LAST,">> $ENV{'PBDESTDIR'}/pbrc") || die "Unable to create $ENV{'PBDESTDIR'}/pbrc";
608    print LAST "pbroot $ENV{'PBPROJ'} = $ENV{'PBROOTDIR'}\n";
609    print LAST "pbprojver $ENV{'PBPROJ'} = $ENV{'PBPROJVER'}\n";
610    print LAST "pbprojtag $ENV{'PBPROJ'} = $ENV{'PBPROJTAG'}\n";
611    print LAST "pbpackager $ENV{'PBPROJ'} = $ENV{'PBPACKAGER'}\n";
612    close(LAST);
613}
614
615sub pb_build2pkg {
616
617    # Get the running distro to build on
618    my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init();
619    pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n");
620
621    # Get list of packages to build
622    # Get content saved in cms2build
623    my $ptr = pb_get_pkg();
624    @pkgs = @$ptr;
625
626    my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
627    $pkg = { } if (not defined $pkg);
628
629    chdir "$ENV{'PBBUILDDIR'}";
630    my $made = ""; # pkgs made during build
631    foreach my $pbpkg (@pkgs) {
632        my $vertag = $pkg->{$pbpkg};
633        # get the version of the current package - maybe different
634        ($pbver,$pbtag) = split(/-/,$vertag);
635
636        my $src="$ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz";
637        pb_log(2,"Source file: $src\n");
638
639        pb_log(2,"Working directory: $ENV{'PBBUILDDIR'}\n");
640        if ($dtype eq "rpm") {
641            foreach my $d ('RPMS','SRPMS','SPECS','SOURCES','BUILD') {
642                if (! -d "$ENV{'PBBUILDDIR'}/$d") {
643                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";
644                }
645            }
646
647            # Remove in case a previous link/file was there
648            unlink "$ENV{'PBBUILDDIR'}/SOURCES/".basename($src);
649            symlink "$src","$ENV{'PBBUILDDIR'}/SOURCES/".basename($src) || die "Unable to symlink $src in $ENV{'PBBUILDDIR'}/SOURCES";
650            # We need to first extract the spec file
651            my @specfile;
652            @specfile = pb_extract_build_files($src,"$pbpkg-$pbver/pbconf/$ddir-$dver/","$ENV{'PBBUILDDIR'}/SPECS");
653
654            pb_log(2,"specfile: ".Dumper(\@specfile)."\n");
655            # set LANGUAGE to check for correct log messages
656            $ENV{'LANGUAGE'}="C";
657            foreach my $f (@specfile) {
658                if ($f =~ /\.spec$/) {
659                    pb_system("rpmbuild --define \'packager $ENV{'PBPACKAGER'}\' --define \"_topdir $ENV{'PBBUILDDIR'}\" -ba $f","Building package with $f under $ENV{'PBBUILDDIR'}");
660                    last;
661                }
662            }
663            $made="$made RPMS/*/$pbpkg-$pbver-$pbtag$pbsuf.*.rpm SRPMS/$pbpkg-$pbver-$pbtag$pbsuf.src.rpm";
664            if (-f "/usr/bin/rpmlint") {
665                pb_system("rpmlint $made","Checking validity of rpms with rpmlint");
666            }
667        } elsif ($dtype eq "deb") {
668            chdir "$ENV{'PBBUILDDIR'}" || die "Unable to chdir to $ENV{'PBBUILDDIR'}";
669            pb_system("tar xfz $src","Extracting sources");
670
671            chdir "$pbpkg-$pbver" || die "Unable to chdir to $pbpkg-$pbver";
672            pb_rm_rf("debian");
673            symlink "pbconf/$ddir-$dver","debian" || die "Unable to symlink to pbconf/$ddir-$dver";
674            chmod 0755,"debian/rules";
675            pb_system("dpkg-buildpackage -us -uc -rfakeroot","Building package");
676            $made="$made $pbpkg"."_*.deb $pbpkg"."_*.dsc $pbpkg"."_*.tar.gz";
677            if (-f "/usr/bin/lintian") {
678                pb_system("lintian $made","Checking validity of debs with lintian");
679            }
680        } elsif ($dtype eq "ebuild") {
681            my @ebuildfile;
682            # For gentoo we need to take pb as subsystem name
683            # We put every apps here under sys-apps. hope it's correct
684            # We use pb's home dir in order o have a single OVERLAY line
685            my $tmpd = "$ENV{'HOME'}/portage/pb/sys-apps/$pbpkg";
686            pb_mkdir_p($tmpd) if (! -d "$tmpd");
687            pb_mkdir_p("$ENV{'HOME'}/portage/distfiles") if (! -d "$ENV{'HOME'}/portage/distfiles");
688
689            # We need to first extract the ebuild file
690            @ebuildfile = pb_extract_build_files($src,"$pbpkg-$pbver/pbconf/$ddir-$dver/","$tmpd");
691
692            # Prepare the build env for gentoo
693            my $found = 0;
694            my $pbbd = $ENV{'HOME'};
695            $pbbd =~ s|/|\\/|g;
696            if (-r "/etc/make.conf") {
697                open(MAKE,"/etc/make.conf");
698                while (<MAKE>) {
699                    $found = 1 if (/$pbbd\/portage/);
700                }
701                close(MAKE);
702            }
703            if ($found == 0) {
704                pb_system("sudo sh -c 'echo PORTDIR_OVERLAY=\"$ENV{'HOME'}/portage\" >> /etc/make.conf'");
705            }
706            #$found = 0;
707            #if (-r "/etc/portage/package.keywords") {
708            #open(KEYW,"/etc/portage/package.keywords");
709            #while (<KEYW>) {
710            #$found = 1 if (/portage\/pb/);
711            #}
712            #close(KEYW);
713            #}
714            #if ($found == 0) {
715            #pb_system("sudo sh -c \"echo portage/pb >> /etc/portage/package.keywords\"");
716            #}
717
718            # Build
719            foreach my $f (@ebuildfile) {
720                if ($f =~ /\.ebuild$/) {
721                    move($f,"$tmpd/$pbpkg-$pbver.ebuild");
722                    pb_system("cd $tmpd ; ebuild $pbpkg-$pbver.ebuild clean ; ebuild $pbpkg-$pbver.ebuild digest ; ebuild $pbpkg-$pbver.ebuild package");
723                    # Now move it where pb expects it
724                    pb_mkdir_p("$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
725                    move("$tmpd/$pbpkg-$pbver.ebuild","$ENV{'PBBUILDDIR'}/portage/pb/sys-apps/$pbpkg");
726                }
727            }
728
729            $made="$made portage/pb/sys-apps/$pbpkg/$pbpkg-$pbver.ebuild";
730        } elsif ($dtype eq "slackware") {
731            $made="$made build-$pbpkg/$pbpkg-$pbver-*-$pbtag.tgz";
732            pb_mkdir_p("$ENV{'PBBUILDDIR'}/install") if (! -d "$ENV{'PBBUILDDIR'}/install");
733        } else {
734            die "Unknown dtype format $dtype";
735        }
736    }
737    # Keep track of what is generated so that we can get them back from VMs
738    open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") || die "Unable to create $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
739    print KEEP "$made\n";
740    close(KEEP);
741}
742
743sub pb_build2ssh {
744    pb_send2target("Sources");
745}
746
747sub pb_pkg2ssh {
748    pb_send2target("Packages");
749}
750
751# By default deliver to the the public site hosting the
752# ftp structure (or whatever) or a VM/VE
753sub pb_send2target {
754
755    my $cmt = shift;
756    my $v = shift || undef;
757    my $vmexist = shift || 0;           # 0 is FALSE
758    my $vmpid = shift || 0;             # 0 is FALSE
759
760    my $host = "sshhost";
761    my $login = "sshlogin";
762    my $dir = "sshdir";
763    my $port = "sshport";
764    my $tmout = "sshtmout";
765    my $path = "sshpath";
766    my $conf = "sshconf";
767    my $rebuild = "sshrebuild";
768    if (($cmt eq "vm") || ($cmt eq "Script")) {
769        $login = "vmlogin";
770        $dir = "pbdefdir";
771        $tmout = "vmtmout";
772        $rebuild = "vmrebuild";
773        # Specific VM
774        $host = "vmhost";
775        $port = "vmport";
776    } elsif ($cmt eq "ve") {
777        $login = "velogin";
778        $dir = "pbdefdir";
779        $tmout = "vetmout";
780        # Specific VE
781        $path = "vepath";
782        $conf = "veconf";
783        $rebuild = "verebuild";
784    }
785    my $cmd = "";
786
787    my $ptr = pb_get_pkg();
788    @pkgs = @$ptr;
789
790    # Get the running distro to consider
791    my ($odir,$over,$oarch) = (undef, undef, undef);
792    if (defined $v) {
793        ($odir,$over,$oarch) = split(/-/,$v);
794    }
795    my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($odir,$over);
796    pb_log(2,"DEBUG: distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n");
797
798    # Get list of packages to build
799    # Get content saved in cms2build
800    my ($pkg) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg");
801    $pkg = { } if (not defined $pkg);
802
803    my $src = "";
804    chdir "$ENV{'PBBUILDDIR'}";
805    foreach my $pbpkg (@pkgs) {
806        my $vertag = $pkg->{$pbpkg};
807        # get the version of the current package - maybe different
808        ($pbver,$pbtag) = split(/-/,$vertag);
809
810        if (($cmt eq "Sources") || ($cmt eq "vm") || ($cmt eq "ve")) {
811            $src = "$src $ENV{'PBDESTDIR'}/$pbpkg-$pbver.tar.gz";
812            if ($cmd eq "") {
813                $cmd = "ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
814            } else {
815                $cmd = "$cmd ; ln -sf $pbpkg-$pbver.tar.gz $pbpkg-latest.tar.gz";
816            }
817        }
818    }
819    if (($cmt eq "vm") || ($cmt eq "ve")) {
820        $src="$src $ENV{'PBDESTDIR'}/pbscript $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb $ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb $ENV{'PBETC'} $ENV{'PBDESTDIR'}/pbrc";
821    } elsif ($cmt eq "Script") {
822        $src="$src $ENV{'PBDESTDIR'}/pbscript";
823    } elsif ($cmt eq "Packages") {
824        # Get package list from file made during build2pkg
825        open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") || die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
826        $src = <KEEP>;
827        chomp($src);
828        close(KEEP);
829        if ($dtype eq "rpm") {
830            # Also make a pbscript to generate yum/urpmi bases
831            # $src = "$src $ENV{'PBDESTDIR'}/pbscript"
832        } elsif ($dtype eq "deb") {
833            # Also make a pbscript to generate apt bases
834            # $src = "$src $ENV{'PBDESTDIR'}/pbscript"
835        }
836    }
837    # Remove potential leading spaces (cause problem with basename)
838    $src =~ s/^ *//;
839    my $basesrc = "";
840    foreach my $i (split(/ +/,$src)) {
841        $basesrc .= " ".basename($i);
842    }
843
844    pb_log(0,"Sources handled ($cmt): $src\n");
845    pb_log(2,"values: ".Dumper(($host,$login,$dir,$port,$tmout,$rebuild,$path,$conf))."\n");
846    my ($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vrebuild,$vepath,$veconf) = pb_conf_get($host,$login,$dir,$port,$tmout,$rebuild,$path,$conf);
847    pb_log(2,"ssh: ".Dumper(($sshhost,$sshlogin,$sshdir,$sshport,$vtmout,$vrebuild,$vepath,$veconf))."\n");
848    # Not mandatory
849    my ($testver) = pb_conf_get_if("testver");
850
851    my $mac;
852    # Useless for VE
853    if ($cmt ne "ve") {
854        $mac = "$sshlogin->{$ENV{'PBPROJ'}}\@$sshhost->{$ENV{'PBPROJ'}}";
855        # Overwrite account value if passed as parameter
856        $mac = "$pbaccount\@$sshhost->{$ENV{'PBPROJ'}}" if (defined $pbaccount);
857        pb_log(2, "DEBUG: pbaccount: $pbaccount => mac: $mac\n") if (defined $pbaccount);
858    }
859
860    my $tdir;
861    my $bdir;
862    if (($cmt eq "Sources") || ($cmt eq "Script")) {
863        $tdir = "$sshdir->{$ENV{'PBPROJ'}}/src";
864    } elsif (($cmt eq "vm") || ($cmt eq "ve")) {
865        $tdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/delivery";
866        $bdir = $sshdir->{$ENV{'PBPROJ'}}."/$ENV{'PBPROJ'}/build";
867        # Remove a potential $ENV{'HOME'} as bdir should be relative to pb's home
868        $bdir =~ s|\$ENV.+\}/||;
869    } elsif ($cmt eq "Packages") {
870        $tdir = "$sshdir->{$ENV{'PBPROJ'}}/$ddir/$dver";
871        if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
872            # This is a test pkg => target dir is under test
873            $tdir .= "/test";
874        }
875    } else {
876        return;
877    }
878
879    # Useless for VE
880    my $nport;
881    if ($cmt ne "ve") {
882        $nport = $sshport->{$ENV{'PBPROJ'}};
883        $nport = "$pbport" if (defined $pbport);
884    }
885
886    # Remove a potential $ENV{'HOME'} as tdir should be relative to pb's home
887    $tdir =~ s|\$ENV.+\}/||;
888
889    my $tm = $vtmout->{$ENV{'PBPROJ'}};
890
891    # ssh communication if not VE
892    # should use a hash instead...
893    my ($shcmd,$cpcmd,$cptarget,$cp2target);
894    if ($cmt ne "ve") {
895        my $keyfile = pb_ssh_get(0);
896        $shcmd = "ssh -i $keyfile -q -p $nport $mac";
897        $cpcmd = "scp -i $keyfile -p -P $nport";
898        $cptarget = "$mac:$tdir";
899        if ($cmt eq "vm") {
900            $cp2target = "$mac:$bdir";
901        }
902    } else {
903        my $tp = $vepath->{$ENV{'PBPROJ'}};
904        $shcmd = "sudo chroot $tp/$v /bin/su - $sshlogin->{$ENV{'PBPROJ'}} -c ";
905        $cpcmd = "cp -a ";
906        $cptarget = "$tp/$tdir";
907        $cp2target = "$tp/$bdir";
908    }
909
910    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");
911    pb_system("cd $ENV{'PBBUILDDIR'} ; $cpcmd $src $cptarget 2> /dev/null","$cmt delivery in $cptarget");
912    # For VE we need to change the owner manually - To be tested if needed
913    #if ($cmt eq "ve") {
914    #pb_system("cd $cptarget ; sudo chown -R $sshlogin->{$ENV{'PBPROJ'}} .","$cmt chown in $cptarget to $sshlogin->{$ENV{'PBPROJ'}}");
915    #}
916    pb_system("$shcmd \"echo \'cd $tdir ; if [ -f pbscript ]; then ./pbscript; fi\' | bash\"","Executing pbscript on $cptarget if needed");
917    if (($cmt eq "vm") || ($cmt eq "ve")) {
918        # Get back info on pkg produced, compute their name and get them from the VM
919        pb_system("$cpcmd $cp2target/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'} $ENV{'PBBUILDDIR'} 2> /dev/null","Get package names in $cp2target");
920        open(KEEP,"$ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") || die "Unable to read $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
921        my $src = <KEEP>;
922        chomp($src);
923        close(KEEP);
924        $src =~ s/^ *//;
925        pb_mkdir_p("$ENV{'PBBUILDDIR'}/$odir/$over");
926        # Change pgben to make the next send2target happy
927        my $made = "";
928        open(KEEP,"> $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}") || die "Unable to write $ENV{'PBBUILDDIR'}/pbgen-$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}";
929        foreach my $p (split(/ +/,$src)) {
930            my $j = basename($p);
931            pb_system("$cpcmd $cp2target/\'$p\' $ENV{'PBBUILDDIR'}/$odir/$over 2> /dev/null","Package recovery of $j in $cp2target");
932            $made="$made $odir/$over/$j" if (($dtype ne "rpm") || ($j !~ /.src.rpm$/));
933        }
934        print KEEP "$made\n";
935        close(KEEP);
936        pb_system("$shcmd \"rm -rf $tdir $bdir\"","$cmt cleanup");
937
938        # We want to send them to the ssh account so overwrite what has been done before
939        undef $pbaccount;
940        pb_log(2,"Before sending pkgs, vmexist: $vmexist, vmpid: $vmpid\n");
941        pb_send2target("Packages",$odir."-".$over."-".$oarch,$vmexist,$vmpid);
942        if ((! $vmexist) && ($cmt eq "vm")) {
943            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)");
944        }
945        pb_rm_rf("$ENV{'PBBUILDDIR'}/$odir");
946    }
947}
948
949sub pb_script2v {
950    my $pbscript=shift;
951    my $vtype=shift;
952
953    # Prepare the script to be executed on the VM
954    # in $ENV{'PBDESTDIR'}/pbscript
955    if ((defined $pbscript ) && ($pbscript ne "$ENV{'PBDESTDIR'}/pbscript")) {
956        copy($pbscript,"$ENV{'PBDESTDIR'}/pbscript") || die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
957        chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
958    }
959
960    my ($vm,$all) = pb_get_v($vtype);
961    my ($vmexist,$vmpid) = (undef,undef);
962
963    foreach my $v (@$vm) {
964        # Launch the VM/VE
965        if ($vtype eq "vm") {
966            ($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
967
968            # Skip that VM if something went wrong
969            next if (($vmpid == 0) && ($vmexist ==0));
970        }
971
972        # Gather all required files to send them to the VM
973        # and launch the build through pbscript
974        pb_send2target("Script","$v",$vmexist,$vmpid);
975
976    }
977}
978
979sub pb_launchv {
980    my $vtype = shift;
981    my $v = shift;
982    my $create = shift || 0;        # By default do not create a VM
983
984    die "No VM/VE defined, unable to launch" if (not defined $v);
985    # Keep only the first VM in case many were given
986    $v =~ s/,.*//;
987
988    # Which is our local arch ? (standardize on i386 for those platforms)
989    my $arch = `uname -m`;
990    chomp($arch);
991    $arch =~ s/i.86/i386/;
992
993    # Launch the VMs/VEs
994    if ($vtype eq "vm") {
995        die "-i iso parameter needed" if (((not defined $iso) || ($iso eq "")) && ($create != 0));
996
997        my ($ptr,$vmopt,$vmport,$vmpath,$vmtmout,$vmsize) = pb_conf_get("vmtype","vmopt","vmport","vmpath","vmtmout","vmsize");
998
999        my $vmtype = $ptr->{$ENV{'PBPROJ'}};
1000        if (not defined $ENV{'PBVMOPT'}) {
1001            $ENV{'PBVMOPT'} = "";
1002        }
1003        if (defined $vmopt->{$ENV{'PBPROJ'}}) {
1004            $ENV{'PBVMOPT'} .= " $vmopt->{$ENV{'PBPROJ'}}" if ($ENV{'PBVMOPT'} !~ / $vmopt->{$ENV{'PBPROJ'}}/);
1005        }
1006        my $nport = $vmport->{$ENV{'PBPROJ'}};
1007        $nport = "$pbport" if (defined $pbport);
1008   
1009        my $cmd;
1010        my $vmcmd;      # has to be used for pb_check_ps
1011        my $vmm;        # has to be used for pb_check_ps
1012        if ($vmtype eq "qemu") {
1013            my $qemucmd32;
1014            my $qemucmd64;
1015            if ($arch eq "x86_64") {
1016                $qemucmd32 = "/usr/bin/qemu-system-i386";
1017                $qemucmd64 = "/usr/bin/qemu";
1018            } else {
1019                $qemucmd32 = "/usr/bin/qemu";
1020                $qemucmd64 = "/usr/bin/qemu-system-x86_64";
1021            }
1022        if ($v =~ /x86_64/) {
1023                $vmcmd = "$qemucmd64 -no-kqemu";
1024            } else {
1025                $vmcmd = "$qemucmd32";
1026            }
1027            $vmm = "$vmpath->{$ENV{'PBPROJ'}}/$v.qemu";
1028            if ($create != 0) {
1029                $ENV{'PBVMOPT'} .= " -cdrom $iso -boot d";
1030            }
1031            $cmd = "$vmcmd $ENV{'PBVMOPT'} -redir tcp:$nport:10.0.2.15:22 $vmm"
1032        } elsif ($vmtype eq "xen") {
1033        } elsif ($vmtype eq "vmware") {
1034        } else {
1035            die "VM of type $vmtype not supported. Report to the dev team";
1036        }
1037        my ($tmpcmd,$void) = split(/ +/,$cmd);
1038        my $vmexist = pb_check_ps($tmpcmd,$vmm);
1039        my $vmpid = 0;
1040        if (! $vmexist) {
1041            if ($create != 0) {
1042                if (($vmtype eq "qemu") || ($vmtype eq "xen")) {
1043                    pb_system("/usr/bin/qemu-img create -f qcow2 $vmm $vmsize->{$ENV{'PBPROJ'}}","Creating the QEMU VM");
1044                } elsif ($vmtype eq "vmware") {
1045                } else {
1046                }
1047            }
1048            if (! -f "$vmm") {
1049                pb_log(0,"Unable to find VM $vmm\n");
1050            } else {
1051                pb_system("$cmd &","Launching the VM $vmm");
1052                pb_system("sleep $vmtmout->{$ENV{'PBPROJ'}}","Waiting for VM $v to come up");
1053                $vmpid = pb_check_ps($tmpcmd,$vmm);
1054                pb_log(0,"VM $vmm launched (pid $vmpid)\n");
1055            }
1056        } else {
1057            pb_log(0,"Found an existing VM $vmm (pid $vmexist)\n");
1058        }
1059        return($vmexist,$vmpid);
1060    # VE here
1061    } else {
1062        # Get VE context
1063        my ($ptr,$vepath,$vetmout,$verebuild,$veconf) = pb_conf_get("vetype","vepath","vetmout","verebuild","veconf");
1064        my $vetype = $ptr->{$ENV{'PBPROJ'}};
1065
1066        # Get distro context
1067        my ($name,$ver,$darch) = split(/-/,$v);
1068        chomp($darch);
1069        my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init($name,$ver);
1070
1071        if ($vetype eq "chroot") {
1072            # Architecture consistency
1073            if ($arch ne $darch) {
1074                die "Unable to launch a VE of architecture $darch on a $arch platform" if (not (($darch eq "x86_64") && ($arch =~ /i?86/)));
1075            }
1076
1077            if (($create != 0) || ($verebuild->{$ENV{'PBPROJ'}} eq "true") || ($force == 1)) {
1078                # We have to rebuild the chroot
1079                if ($dtype eq "rpm") {
1080                    pb_system("sudo /usr/sbin/mock --init --resultdir=\"/tmp\" --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" -r $v","Creating the mock VE");
1081                    # Once setup we need to install some packages, the pb account, ...
1082                    pb_system("sudo /usr/sbin/mock --install --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" -r $v su","Configuring the mock VE");
1083                    #pb_system("sudo /usr/sbin/mock --init --resultdir=\"/tmp\" --configdir=\"$veconf->{$ENV{'PBPROJ'}}\" --basedir=\"$vepath->{$ENV{'PBPROJ'}}\" -r $v","Creating the mock VE");
1084                } elsif ($dtype eq "deb") {
1085                    pb_system("","Creating the pbuilder VE");
1086                } elsif ($dtype eq "ebuild") {
1087                    die "Please teach the dev team how to build gentoo chroot";
1088                } else {
1089                    die "Unknown distribution type $dtype. Report to dev team";
1090                }
1091            }
1092            # Nothing more to do for VE. No real launch
1093        } else {
1094            die "VE of type $vetype not supported. Report to the dev team";
1095        }
1096    }
1097}
1098
1099sub pb_build2v {
1100
1101my $vtype = shift;
1102
1103# Prepare the script to be executed on the VM/VE
1104# in $ENV{'PBDESTDIR'}/pbscript
1105#my ($ntp) = pb_conf_get($vtype."ntp");
1106#my $vntp = $ntp->{$ENV{'PBPROJ'}};
1107
1108open(SCRIPT,"> $ENV{'PBDESTDIR'}/pbscript") || die "Unable to create $ENV{'PBDESTDIR'}/pbscript";
1109print SCRIPT "#!/bin/bash\n";
1110print SCRIPT "echo ... Execution needed\n";
1111print SCRIPT "# This is in directory delivery\n";
1112print SCRIPT "# Setup the variables required for building\n";
1113print SCRIPT "export PBPROJ=$ENV{'PBPROJ'}\n";
1114print SCRIPT "# Preparation for pb\n";
1115print SCRIPT "mv .pbrc \$HOME\n";
1116print SCRIPT "cd ..\n";
1117# Force new date to be in the future compared to the date of the tar file by adding 1 minute
1118my @date=pb_get_date();
1119$date[1]++;
1120my $upddate = strftime("%m%d%H%M%Y", @date);
1121#print SCRIPT "echo Setting up date on $vntp...\n";
1122# Or use ntpdate if available TBC
1123print SCRIPT "sudo date $upddate\n";
1124# Get list of packages to build and get some ENV vars as well
1125my $ptr = pb_get_pkg();
1126@pkgs = @$ptr;
1127my $p = join(' ',@pkgs) if (@pkgs);
1128print SCRIPT "export PBPROJVER=$ENV{'PBPROJVER'}\n";
1129print SCRIPT "export PBPROJTAG=$ENV{'PBPROJTAG'}\n";
1130print SCRIPT "export PBPACKAGER=\"$ENV{'PBPACKAGER'}\"\n";
1131print SCRIPT "# Build\n";
1132print SCRIPT "echo Building packages on $vtype...\n";
1133print SCRIPT "pb -p $ENV{'PBPROJ'} build2pkg $p\n";
1134close(SCRIPT);
1135chmod 0755,"$ENV{'PBDESTDIR'}/pbscript";
1136
1137my ($v,$all) = pb_get_v($vtype);
1138
1139# Send tar files when we do a global generation
1140pb_build2ssh() if ($all == 1);
1141
1142my ($vmexist,$vmpid) = (undef,undef);
1143
1144foreach my $v (@$v) {
1145    if ($vtype eq "vm") {
1146        # Launch the VM
1147        ($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1148
1149        # Skip that VM if it something went wrong
1150        next if (($vmpid == 0) && ($vmexist == 0));
1151    }
1152    # Gather all required files to send them to the VM/VE
1153    # and launch the build through pbscript
1154    pb_log(2,"Calling send2target $vtype,$v,$vmexist,$vmpid\n");
1155    pb_send2target($vtype,"$v",$vmexist,$vmpid);
1156}
1157}
1158
1159
1160sub pb_newver {
1161
1162    die "-V Version parameter needed" if ((not defined $newver) || ($newver eq ""));
1163
1164    my ($scheme,$uri)=pb_cms_init($pbinit);
1165
1166    # Checking CMS repositories status
1167    my ($pburl) = pb_conf_get("pburl");
1168    my ($scheme2, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}});
1169
1170    if ($scheme !~ /^svn/) {
1171        die "Only SVN is supported at the moment";
1172    }
1173    my $res = pb_cms_isdiff($scheme,$ENV{'PBROOTDIR'});
1174    die "ERROR: No differences accepted in CMS for $ENV{'PBROOTDIR'} before creating a new version" if ($res != 0);
1175
1176    $res = pb_cms_isdiff($scheme2,$ENV{'PBDIR'});
1177    die "ERROR: No differences accepted in CMS for $ENV{'PBDIR'} before creating a new version" if ($res != 0);
1178
1179    # Tree identical between PBCONFDIR and PBROOTDIR. The delta is what
1180    # we want to get for the root of the new URL
1181
1182    my $tmp = $ENV{'PBROOTDIR'};
1183    $tmp =~ s|^$ENV{'PBCONFDIR'}||;
1184
1185    my $newurl = "$uri/".dirname($tmp)."/$newver";
1186    my $oldver= basename("$uri/$tmp");
1187
1188    # Checking pbcl files
1189    foreach my $f (<$ENV{'PBCONFDIR'}/*/pbcl>) {
1190        open(PBCL,$f) || die "Unable to open $f";
1191        my $foundnew = 0;
1192        while (<PBCL>) {
1193            $foundnew = 1 if (/^$newver (/);
1194        }
1195        close(PBCL);
1196        die "ERROR: version $newver not found in $f" if ($foundnew == 0);
1197    }
1198
1199    pb_log(2,"Copying $uri/$tmp to $newurl\n");
1200    #pb_cms_copy($scheme,$uri,$newurl);
1201    pb_log(2,"Checkout $newurl to $ENV{'PBDIR'}/../$newver\n");
1202    #pb_cms_checkout($scheme,$newurl,"$ENV{'PBDIR'}/../$newver");
1203
1204    # Update the .pb file
1205    # Should probably use projver in the old file
1206    open(FILE,"$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb") || die "Unable to open $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb";
1207    open(OUT,"> $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new") || die "Unable to write to $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new";
1208    while(<FILE>) {
1209        s/^projver\s+$ENV{'PBPROJ'}\s*=\s*$oldver/projver $ENV{'PBPROJ'} = $newver/;
1210        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/);
1211        s/^testver/#testver/;
1212        pb_log(0,"Commenting testver in $ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb\n") if (/^testver/);
1213        print OUT $_;
1214    }
1215    close(FILE);
1216    close(OUT);
1217    rename("$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb.new","$ENV{'PBROOTDIR'}/../$newver/$ENV{'PBPROJ'}.pb");
1218    pb_log(2,"Checkin $ENV{'PBROOTDIR'}/../$newver\n");
1219
1220    #pb_cms_checkin($scheme,"$ENV{'PBROOTDIR'}/../$newver");
1221}
1222
1223#
1224# Return the list of VMs/VEs we are working on
1225# $all is a flag to know if we return all of them
1226# or only some (if all we publish also tar files in addition to pkgs
1227#
1228sub pb_get_v {
1229
1230my $vtype = shift;
1231my @v;
1232my $all = 0;
1233my $vlist;
1234my $pbv = 'PBV';
1235
1236if ($vtype eq "vm") {
1237    $vlist = "vmlist";
1238} elsif ($vtype eq "ve") {
1239    $vlist = "velist";
1240}
1241# Get VM/VE list
1242if ((not defined $ENV{$pbv}) || ($ENV{$pbv} =~ /^all$/)) {
1243    my ($ptr) = pb_conf_get($vlist);
1244    $ENV{$pbv} = $ptr->{$ENV{'PBPROJ'}};
1245    $all = 1;
1246}
1247pb_log(2,"$vtype: $ENV{$pbv}\n");
1248@v = split(/,/,$ENV{$pbv});
1249return(\@v,$all);
1250}
1251
1252# Function to create a potentialy missing pb account on the VM/VE, and adds it to sudo
1253# Needs to use root account to connect to the VM/VE
1254# pb will take your local public SSH key to access
1255# the pb account in the VM later on if needed
1256sub pb_setup_v {
1257
1258my $vtype = shift;
1259
1260my ($vm,$all) = pb_get_v($vtype);
1261
1262# Script generated
1263my $pbscript = "$ENV{'PBDESTDIR'}/setupv";
1264
1265foreach my $v (@$vm) {
1266    # Name of the account to deal with for VM/VE
1267    # Do not use the one passed potentially with -a
1268    my ($pbac) = pb_conf_get($vtype."login");
1269    my ($key,$zero0,$zero1,$zero2);
1270    my ($vmexist,$vmpid);
1271
1272    if ($vtype eq "vm") {
1273        # Prepare the key to be used and transfered remotely
1274        my $keyfile = pb_ssh_get(1);
1275       
1276        my ($vmhost,$vmport) = pb_conf_get("vmhost","vmport");
1277        my $nport = $vmport->{$ENV{'PBPROJ'}};
1278        $nport = "$pbport" if (defined $pbport);
1279   
1280        # Launch the VM
1281        ($vmexist,$vmpid) = pb_launchv($vtype,$v,0);
1282
1283        # Skip that VM if something went wrong
1284        return if (($vmpid == 0) && ($vmexist == 0));
1285   
1286        # Store the pub key part in a variable
1287        open(FILE,"$keyfile.pub") || die "Unable to open $keyfile.pub";
1288        ($zero0,$zero1,$zero2) = split(/ /,<FILE>);
1289        close(FILE);
1290
1291        $key = "\Q$zero1";
1292
1293        pb_system("cat $keyfile.pub | ssh -q -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 will require the root password");
1294        # once this is done, we can do what we want on the VM remotely
1295    }
1296   
1297    # Prepare the script to be executed on the VM/VE
1298    # in $ENV{'PBDESTDIR'}/setupv
1299   
1300    open(SCRIPT,"> $pbscript") || die "Unable to create $pbscript";
1301    print SCRIPT << 'EOF';
1302#!/usr/bin/perl -w
1303
1304use strict;
1305use File::Copy;
1306
1307EOF
1308    if ($vtype eq "vm") {
1309        print SCRIPT << 'EOF';
1310# Removes duplicate in .ssh/authorized_keys of our key if needed
1311#
1312my $file1="$ENV{'HOME'}/.ssh/authorized_keys";
1313open(PBFILE,$file1) || die "Unable to open $file1";
1314open(PBOUT,"> $file1.new") || die "Unable to open $file1.new";
1315my $count = 0;
1316while (<PBFILE>) {
1317EOF
1318        print SCRIPT << "EOF";
1319    if (/ $key /) {
1320        \$count++;
1321    }
1322print PBOUT \$_ if ((\$count <= 1) || (\$_ !~ / $key /));
1323}
1324close(PBFILE);
1325close(PBOUT);
1326rename("\$file1.new",\$file1);
1327chmod 0600,\$file1;
1328EOF
1329    }
1330    print SCRIPT << 'EOF';
1331
1332# Adds $pbac->{$ENV{'PBPROJ'}} as an account if needed
1333#
1334my $file="/etc/passwd";
1335open(PBFILE,$file) || die "Unable to open $file";
1336my $found = 0;
1337while (<PBFILE>) {
1338EOF
1339    print SCRIPT << "EOF";
1340    \$found = 1 if (/^$pbac->{$ENV{'PBPROJ'}}:/);
1341EOF
1342    print SCRIPT << 'EOF';
1343}
1344close(PBFILE);
1345
1346if ( $found == 0 ) {
1347    if ( ! -d "/home" ) {
1348        mkdir "/home";
1349    }
1350EOF
1351    print SCRIPT << "EOF";
1352system "groupadd $pbac->{$ENV{'PBPROJ'}}";
1353system "useradd $pbac->{$ENV{'PBPROJ'}} -g $pbac->{$ENV{'PBPROJ'}} -m -d /home/$pbac->{$ENV{'PBPROJ'}}";
1354
1355# allow ssh entry to build
1356#
1357chdir "/home/$pbac->{$ENV{'PBPROJ'}}";
1358mkdir ".ssh",0700;
1359# Allow those accessing root to access the build account
1360copy("\$ENV{'HOME'}/.ssh/authorized_keys",".ssh/authorized_keys");
1361chmod 0600,".ssh/authorized_keys";
1362system 'chown -R $pbac->{$ENV{'PBPROJ'}}:$pbac->{$ENV{'PBPROJ'}} .ssh';
1363
1364EOF
1365    print SCRIPT << 'EOF';
1366}
1367
1368# No passwd for build account only keys
1369$file="/etc/shadow";
1370open(PBFILE,$file) || die "Unable to open $file";
1371open(PBOUT,"> $file.new") || die "Unable to open $file.new";
1372while (<PBFILE>) {
1373EOF
1374    print SCRIPT << "EOF";
1375    s/^$pbac->{$ENV{'PBPROJ'}}:\!\!:/$pbac->{$ENV{'PBPROJ'}}:*:/;
1376    s/^$pbac->{$ENV{'PBPROJ'}}:\!:/$pbac->{$ENV{'PBPROJ'}}:*:/; #SLES 9 e.g.
1377EOF
1378    print SCRIPT << 'EOF';
1379    print PBOUT $_;
1380}
1381close(PBFILE);
1382close(PBOUT);
1383rename("$file.new",$file);
1384chmod 0640,$file;
1385
1386# pb has to be added to portage group on gentoo
1387
1388# Adapt sudoers
1389$file="/etc/sudoers";
1390open(PBFILE,$file) || die "Unable to open $file";
1391open(PBOUT,"> $file.new") || die "Unable to open $file.new";
1392while (<PBFILE>) {
1393EOF
1394    print SCRIPT << "EOF";
1395    next if (/^$pbac->{$ENV{'PBPROJ'}}   /);
1396EOF
1397    print SCRIPT << 'EOF';
1398    s/Defaults[ \t]+requiretty//;
1399    print PBOUT $_;
1400}
1401close(PBFILE);
1402EOF
1403    print SCRIPT << "EOF";
1404# This is needed in order to be able to halt the machine from the $pbac->{$ENV{'PBPROJ'}} account at least
1405print PBOUT "$pbac->{$ENV{'PBPROJ'}}   ALL=(ALL) NOPASSWD:ALL\n";
1406EOF
1407    print SCRIPT << 'EOF';
1408close(PBOUT);
1409rename("$file.new",$file);
1410chmod 0440,$file;
1411
1412EOF
1413       
1414    my $SCRIPT = \*SCRIPT;
1415   
1416    pb_install_deps($SCRIPT);
1417   
1418    print SCRIPT << 'EOF';
1419# Suse wants sudoers as 640
1420if (($ddir eq "sles") || (($ddir eq "suse")) && ($dver ne "10.3")) {
1421    chmod 0640,$file;
1422}
1423
1424# Sync date
1425#system "/usr/sbin/ntpdate ntp.pool.org";
1426
1427system "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-*";
1428system "pb 2>&1 | head -5";
1429EOF
1430    if ((! $vmexist) && ($vtype eq "vm")) {
1431        print SCRIPT << 'EOF';
1432system "sudo /sbin/halt -p";
1433EOF
1434    }
1435   
1436    # Adds pb_distro_init from ProjectBuilder::Distribution
1437    foreach my $d (@INC) {
1438        my $f = "$d/ProjectBuilder/Distribution.pm";
1439        if (-f "$f") {
1440            open(PBD,"$f") || die "Unable to open $f";
1441            while (<PBD>) {
1442                next if (/^package/);
1443                next if (/^use Exporter/);
1444                next if (/^\@our /);
1445                print SCRIPT $_;
1446            }
1447            close(PBD);
1448            last;
1449        }
1450    }
1451    close(SCRIPT);
1452    chmod 0755,"$pbscript";
1453
1454    # That build script needs to be run as root
1455    $pbaccount = "root";
1456    pb_script2v($pbscript,$vtype);
1457}
1458return;
1459}
1460
1461sub pb_install_deps {
1462
1463my $SCRIPT = shift;
1464
1465print {$SCRIPT} << 'EOF';
1466# We need to have that pb_distro_init function
1467# Get it from Project-Builder::Distribution
1468my ($ddir, $dver, $dfam, $dtype, $pbsuf) = pb_distro_init(); 
1469print "distro tuple: ".join(',',($ddir, $dver, $dfam, $dtype, $pbsuf))."\n";
1470
1471# Get and install pb
1472my $insdm = "rm -rf Date-Manip* ; wget http://search.cpan.org/CPAN/authors/id/S/SB/SBECK/Date-Manip-5.48.tar.gz ; tar xvfz Date-Manip-5.48.tar.gz ; cd Date-Manip* ; perl Makefile.PL ; make ; make install ; cd .. ; rm -rf Date-Manip*";
1473my $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*";
1474my $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*";
1475my $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*";
1476
1477if ( $ddir eq "fedora" ) {
1478    system "yum clean all";
1479    #system "yum update -y";
1480    my $arch=`uname -m`;
1481    my $opt = "";
1482    chomp($arch);
1483    if ($arch eq "x86_64") {
1484        $opt="--exclude=*.i?86";
1485    }
1486
1487    system "yum -y $opt install rpm-build wget patch ntp sudo perl-DateManip perl-File-MimeInfo perl-ExtUtils-MakeMaker";
1488    if ($dver eq 4) {
1489        system "$insmb";
1490        system "$insfm";
1491        system "$insfb";
1492    }
1493} elsif (( $dfam eq "rh" ) || ($ddir eq "sles") || (($ddir eq "suse") && (($dver eq "10.1") || ($dver eq "10.0"))) || ($ddir eq "slackware")) {
1494    # Suppose pkg are installed already as no online mirror available
1495    system "rpm -e lsb 2>&1 > /dev/null";
1496    system "$insdm";
1497    system "$insmb";
1498    system "$insfm";
1499    system "$insfb";
1500} elsif ($ddir eq "suse") { 
1501    # New OpenSuSE
1502    system "$insmb";
1503    system "$insfm";
1504    system "$insfb";
1505    system "export TERM=linux ; liste=\"\" ; for i in make wget patch sudo perl-DateManip perl-File-HomeDir xntp; 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";
1506} elsif ( $dfam eq "md" ) {
1507        system "urpmi.update -a ; urpmi --auto rpm-build wget sudo patch ntp-client perl-File-MimeInfo";
1508        if (($ddir eq "mandrake") && ($dver eq "10.1")) {
1509            system "$insdm";
1510        } else {
1511            system "urpmi --auto perl-DateManip";
1512        }
1513} elsif ( $dfam eq "du" ) {
1514    if (( $dver eq "3.1" ) && ($ddir eq "debian")) {
1515        #system "apt-get update";
1516        system "$insfb";
1517        system "$insfm";
1518        system "apt-get -y install wget patch ssh sudo debian-builder dh-make fakeroot ntpdate libmodule-build-perl libdate-manip-perl";
1519    } else  {
1520        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";
1521    }
1522} elsif ( $dfam eq "gen" ) {
1523        #system "emerge -u system ; emerge wget sudo ntp DateManip File-MimeInfo";
1524        system "emerge wget sudo ntp DateManip File-MimeInfo";
1525} else {
1526    print "No pkg to install\n";
1527}
1528EOF
1529}
1530
1531# Return the SSH key file to use
1532# Potentially create it if needed
1533
1534sub pb_ssh_get {
1535
1536my $create = shift || 0;    # Do not create keys by default
1537
1538# Check the SSH environment
1539my $keyfile = undef;
1540
1541# We have specific keys by default
1542$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa";
1543if (!(-e $keyfile) && ($create eq 1)) {
1544    pb_system("ssh-keygen -q -b 1024 -N '' -f $keyfile -t dsa","Generating SSH keys for pb");
1545}
1546
1547$keyfile = "$ENV{'HOME'}/.ssh/id_rsa" if (-s "$ENV{'HOME'}/.ssh/id_rsa");
1548$keyfile = "$ENV{'HOME'}/.ssh/id_dsa" if (-s "$ENV{'HOME'}/.ssh/id_dsa");
1549$keyfile = "$ENV{'HOME'}/.ssh/pb_dsa" if (-s "$ENV{'HOME'}/.ssh/pb_dsa");
1550die "Unable to find your public ssh key under $keyfile" if (not defined $keyfile);
1551return($keyfile);
1552}
1553
1554
1555# Returns the pid of a running VM command using a specific VM file
1556sub pb_check_ps {
1557    my $vmcmd = shift;
1558    my $vmm = shift;
1559    my $vmexist = 0;        # FALSE by default
1560
1561    open(PS, "ps auxhww|") || die "Unable to call ps";
1562    while (<PS>) {
1563        next if (! /$vmcmd/);
1564        next if (! /$vmm/);
1565        my ($void1, $void2);
1566        ($void1, $vmexist, $void2) = split(/ +/);
1567        last;
1568    }
1569    return($vmexist);
1570}
1571
1572
1573sub pb_extract_build_files {
1574
1575my $src=shift;
1576my $dir=shift;
1577my $ddir=shift;
1578my @files;
1579
1580if ($src =~ /tar\.gz$/) {
1581    pb_system("tar xfpz $src $dir","Extracting build files");
1582} elsif ($src =~ /tar\.bz2$/) {
1583    pb_system("tar xfpj $src $dir","Extracting build files");
1584} else {
1585    die "Unknown compression algorithm for $src";
1586}
1587opendir(DIR,"$dir") || die "Unable to open directory $dir";
1588foreach my $f (readdir(DIR)) {
1589    next if ($f =~ /^\./);
1590    move("$dir/$f","$ddir") || die "Unable to move $dir/$f to $ddir";
1591    pb_log(2,"mv $dir/$f $ddir\n");
1592    push @files,"$ddir/$f";
1593}
1594closedir(DIR);
1595# Not enough but still a first cleanup
1596pb_rm_rf("$dir");
1597return(@files);
1598}
1599
1600sub pb_list_bfiles {
1601
1602my $dir = shift;
1603my $pbpkg = shift;
1604my $bfiles = shift;
1605my $pkgfiles = shift;
1606my $supfiles = shift;
1607
1608opendir(BDIR,"$dir") || die "Unable to open dir $dir: $!";
1609foreach my $f (readdir(BDIR)) {
1610    next if ($f =~ /^\./);
1611    $bfiles->{$f} = "$dir/$f";
1612    $bfiles->{$f} =~ s~$ENV{'PBROOTDIR'}~~;
1613    if (defined $supfiles->{$pbpkg}) {
1614        $pkgfiles->{$f} = "$dir/$f" if ($f =~ /$supfiles->{$pbpkg}/);
1615    }
1616}
1617closedir(BDIR);
1618}
1619
1620sub pb_syntax {
1621
1622my $exit_status = shift || -1;
1623my $verbose_level = shift || 0;
1624
1625my $filehandle = \*STDERR;
1626
1627$filehandle = \*STDOUT if ($exit_status == 0);
1628
1629pod2usage( { -message => "pb (aka project-builder.org) Version $projectbuilderver-$projectbuilderrev\n",
1630             -exitval => $exit_status  ,
1631             -verbose => $verbose_level,
1632             -output  => $filehandle } );
1633}
Note: See TracBrowser for help on using the repository browser.