[Midnightbsd-cvs] mports: lib/Magus: Sync with my working version.
ctriv at midnightbsd.org
ctriv at midnightbsd.org
Mon Sep 17 14:09:50 EDT 2007
Log Message:
-----------
Sync with my working version. At this point a slave machine can chroot,
test a port, and analyze the results. The next step is to implement the
master machine.
Modified Files:
--------------
mports/Tools/lib/Magus:
Chroot.pm (r1.4 -> r1.5)
OutcomeRules.pm (r1.1 -> r1.2)
mports/Tools/lib/Magus/OutcomeRules:
Base.pm (r1.1 -> r1.2)
Added Files:
-----------
mports/Tools/lib/Magus:
PortTest.pm (r1.1)
-------------- next part --------------
Index: OutcomeRules.pm
===================================================================
RCS file: /home/cvs/mports/Tools/lib/Magus/OutcomeRules.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -LTools/lib/Magus/OutcomeRules.pm -LTools/lib/Magus/OutcomeRules.pm -u -r1.1 -r1.2
--- Tools/lib/Magus/OutcomeRules.pm
+++ Tools/lib/Magus/OutcomeRules.pm
@@ -29,21 +29,125 @@
# MAINTAINER= ctriv at MidnightBSD.org
#
+
+=head1 fetch rules
+
+=cut
+
+package Magus::OutcomeRules::fetch;
+
+use base qw(Magus::OutcomeRules::Base);
+
+
+
+
+=head1 extract rules
+
+=cut
+
+package Magus::OutcomeRules::extract;
+
+use base qw(Magus::OutcomeRules::Base);
+
+
+
+=head1 patch rules
+
+=cut
+
+package Magus::OutcomeRules::patch;
+
+use base qw(Magus::OutcomeRules::Base);
+
+
+
+=head1 configure rules
+
+=cut
+
+package Magus::OutcomeRules::configure;
+
+use base qw(Magus::OutcomeRules::Base);
+
+
+
+=head1 build rules
+
+=cut
+
+package Magus::OutcomeRules::build;
+
+use base qw(Magus::OutcomeRules::Base);
+
+
+
+=head1 fake rules
+
+=cut
+
package Magus::OutcomeRules::fake;
use base qw(Magus::OutcomeRules::Base);
sub IncompleteInstall :error {
- m/^\t .* not installed.\n$/m
- && return "Some file in the plist wasn't installed in the fake dir or the final dir.";
+ m/^\t.* not installed.\n$/m
+ && return "A file in the plist wasn't installed in the fake dir or the final dir.";
}
sub FakeDestdirInFile :error {
m/contains the fake destdir./s
- && return "Some file contained the fake destdir.";
+ && return "A file contained the fake destdir.";
}
-1;
+sub FakedOutsideDestdir :error {
+ m:^\t.* installed in /:m
+ && return "A file was installed in the final dir instead of the fake dir.";
+}
+
+
+
+=head1 package rules
+
+=cut
+
+package Magus::OutcomeRules::package;
+
+use base qw(Magus::OutcomeRules::Base);
+
+
+
+=head1 install rules
+
+=cut
+
+package Magus::OutcomeRules::install;
+
+use base qw(Magus::OutcomeRules::Base);
+
+sub AlreadyInstalled :error {
+ m:package .*? or its older version already installed: &&
+ return "The package was already installed. This is an error in magus, not the port.";
+}
+
+=head1 deinstall rules
+
+=cut
+
+package Magus::OutcomeRules::deinstall;
+
+use base qw(Magus::OutcomeRules::Base);
+
+
+
+=head1 reinstall rules
+
+=cut
+
+package Magus::OutcomeRules::reinstall;
+
+use base qw(Magus::OutcomeRules::Base);
+
+
Index: Chroot.pm
===================================================================
RCS file: /home/cvs/mports/Tools/lib/Magus/Chroot.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -LTools/lib/Magus/Chroot.pm -LTools/lib/Magus/Chroot.pm -u -r1.4 -r1.5
--- Tools/lib/Magus/Chroot.pm
+++ Tools/lib/Magus/Chroot.pm
@@ -140,6 +140,9 @@
rmtree("$self->{root}/$self->{$_}");
$self->_mkdir($self->{$_});
}
+
+ rmtree("$self->{root}/var/db/pkg");
+ rmtree("$self->{root}/var/db/ports");
$self->_mtree('BSD.local.dist', $self->{localbase});
$self->_mtree('BSD.x11-4.dist', $self->{x11base});
@@ -166,11 +169,25 @@
sub _touchfile {
my ($self, $file) = @_;
my $tmp;
- open($tmp, '>>', "$self->{root}$file") && close($tmp)
- || die "Couldn'touch $self->{root}$file\n";
+ open($tmp, '>>', "$self->{root}$file") || die "Couldn't open $self->{root}$file: $!\n";
+ close($tmp) || die "Couldn't close $self->{root}$file: $!\n";
}
+=head2 $chroot->do_chroot
+
+Calls the chroot syscall; making the chroot dir the root dir. Use this
+as it will keep the $chroot object usable.
+
+=cut
+
+sub do_chroot {
+ my ($self) = @_;
+
+ chroot($self->{root}) || die "Couldn't chroot to $self->{root}: $!\n";
+ $self->{root} = '';
+}
+
=head2 $chroot->root
Returns the root directory that the test system should chroot into.
@@ -215,6 +232,18 @@
}
+=head2 $chroot->logs
+
+Returns the log file directory.
+
+=cut
+
+sub logs {
+ return $_[0]->{'logs'};
+}
+
+
+
=head2 $chroot->delete
Deletes the chroot dir.
@@ -232,7 +261,7 @@
system("/bin/chflags 0 $self->{root}/var/empty") == 0
or die "chflags returned non-zero: $?\n";
- rmtree($self->root) || die "Couldn't rmtree $self->{root}\n";
+ rmtree($self->root) || die "Couldn't rmtree $self->{root}: $!\n";
}
=head2 $chroot->mark_dirty
--- /dev/null
+++ Tools/lib/Magus/PortTest.pm
@@ -0,0 +1,156 @@
+package Magus::PortTest;
+#
+# Copyright (c) 2007 Chris Reinhardt. All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are
+# met:
+#
+# 1. Redistributions of source code must retain the above copyright notice
+# this list of conditions and the following disclaimer.
+#
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+# AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+# COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+#
+# $MidnightBSD: mports/Tools/lib/Magus/PortTest.pm,v 1.1 2007/09/17 18:09:48 ctriv Exp $
+#
+# MAINTAINER= ctriv at MidnightBSD.org
+#
+
+use strict;
+use warnings;
+
+use File::Path qw(mkpath);
+
+use Mport::Globals qw($MAKE);
+use Magus::OutcomeRules ();
+
+=head1 NAME
+
+Magus::PortTest
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+This class handles the actual testing of a single port. It does not attempt
+to install depends, or setup the chroot. It simply runs a port, and
+interpretes the results.
+
+B<This class expects the chroot dir to be /. Always chroot before using this
+class.>
+
+=head1 METHODS
+
+=head2 Magus::PortTest->new(port => $port, chroot => $chroot)
+
+Creates a new tester object.
+
+=cut
+
+sub new {
+ my ($class, %args) = @_;
+
+ my $self = bless {
+ %args,
+ uid => "$args{port}:" . time,
+ }, $class;
+
+ $self->{logdir} = join('/', $self->{chroot}->logs, $self->{uid});
+ mkpath($self->{logdir}) || die "Couldn't mkdir $self->{logdir}: $!\n";
+
+ return $self;
+}
+
+=head2 my @results = $test->run
+
+Runs the test and returns a data structure representing the results.
+
+=cut
+
+sub run {
+ my ($self) = @_;
+
+ $self->_set_env;
+ $self->{chroot}->mark_dirty;
+
+ my %results;
+
+ foreach my $target (qw(fetch extract patch configure build fake package install deinstall reinstall)) {
+ if (!$self->_run_make($target)) {
+ push(@{$results{errors}}, {
+ phase => $target,
+ msg => "make $target returned non-zero: $?",
+ name => "MakeExitNonZero",
+ });
+
+ $results{summary} = 'fail';
+ }
+
+ my $testclass = "Magus::OutcomeRules::$target";
+
+ my $presults = $testclass->test("$self->{logdir}/$target");
+
+ $results{summary} = $presults->{summary} if $presults->{summary} eq 'fail';
+
+ if ($presults->{errors}) {
+ push(@{$results{errors}}, @{$presults->{errors}});
+ }
+
+ if ($presults->{warnings}) {
+ push(@{$results{warnings}}, @{$presults->{warnings}});
+ }
+
+ if ($presults->{summary} eq 'fail') {
+ last;
+ }
+ }
+
+ $results{summary} ||= 'pass';
+
+ return \%results;
+}
+
+
+sub _run_make {
+ my ($self, $target) = @_;
+
+ chdir($self->{port}->origin);
+
+ return system("$MAKE $target >$self->{logdir}/$target 2>&1") == 0;
+}
+
+
+sub _set_env {
+ my ($self) = @_;
+
+ $ENV{PACKAGES} = $self->{chroot}->packages;
+ $ENV{WRKDIRPREFIX} = $self->{chroot}->workdir;
+ $ENV{DEPENDS_TARGET} = 'magus-broken-depend';
+ $ENV{DISTDIR} = $self->{chroot}->distfiles;
+ $ENV{MAGUS} = 1;
+ $ENV{BATCH} = 1;
+ $ENV{MPORT_MAINTAINER_MODE} = 1;
+ $ENV{PACKAGE_BUILDING} = 1;
+ $ENV{TRYBROKEN} = 1;
+}
+
+
+1;
+__END__
+
+
+
Index: Base.pm
===================================================================
RCS file: /home/cvs/mports/Tools/lib/Magus/OutcomeRules/Base.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -LTools/lib/Magus/OutcomeRules/Base.pm -LTools/lib/Magus/OutcomeRules/Base.pm -u -r1.1 -r1.2
--- Tools/lib/Magus/OutcomeRules/Base.pm
+++ Tools/lib/Magus/OutcomeRules/Base.pm
@@ -33,6 +33,7 @@
use warnings;
use Attribute::Handlers;
+use Fcntl qw(:seek);
use base qw(Class::Data::Inheritable);
@@ -53,6 +54,8 @@
__PACKAGE__->mk_classdata('error_rules');
__PACKAGE__->mk_classdata('warning_rules');
+
+
#
# __PACKAGE__->fail($msg, $code)
#
@@ -93,27 +96,40 @@
}
sub test {
- my ($class, $text) = @_;
-
- local $_ = $text;
+ my ($class, $file) = @_;
my %result = (
summary => 'pass'
);
- foreach my $rule (@{$class->error_rules}) {
- if (my $msg = $rule->()) {
- $result{summary} = 'fail';
- push(@{$result{errors}}, $msg);
+ open(my $log, '<', $file) || die "Couldn't open $file: $!\n";
+
+ # This kinda sucks (O(n^2)), but it's abstract enough that it can optimized later.
+ while (<$log>) {
+ foreach my $rule (@{$class->error_rules || []}) {
+ if (my $msg = $rule->{code}->()) {
+ $result{summary} = 'fail';
+ push(@{$result{errors}}, {
+ phase => $rule->{phase},
+ msg => $msg,
+ name => $rule->{name},
+ });
+ }
}
- }
- foreach my $rule (@{$class->warning_rules}) {
- if (my $msg = $rule->()) {
- push(@{$result{warnings}}, $msg);
+ foreach my $rule (@{$class->warning_rules || []}) {
+ if (my $msg = $rule->()) {
+ push(@{$result{warnings}}, {
+ phase => $rule->{phase},
+ msg => $msg,
+ name => $rule->{name},
+ });
+ }
}
}
+ close($log) || die "Couldn't close $file: $!\n";
+
return \%result;
}
More information about the Midnightbsd-cvs
mailing list