wip reorg DhcpWatch

diff --git a/Osstest.pm b/Osstest.pm
index ebec77e2fc350c921bcb86e23fdb2cf1e26f139b..d1de7c854b665d9719fb4c03132e2c42faf5f38b 100644 (file)
--- a/Osstest.pm
+++ b/Osstest.pm
@@ -44,6 +44,8 @@ our %c = qw(
    Images images
    Logs logs
    Results results
+
+   HostProp_DhcpWatchMethod leases dhcp3 /var/lib/dhcp3/dhcpd.leases
 );
 
 #---------- general setup and config reading ----------

diff --git a/Osstest/TestSupport.pm b/Osstest/TestSupport.pm
index 543af2fec093c9fafde19b3e9f31e270bba5f2e2..ab2937366df73269337296659672533fadd2e35d 100644 (file)
--- a/Osstest/TestSupport.pm
+++ b/Osstest/TestSupport.pm
@@ -591,16 +591,28 @@ sub poll_loop ($$$&) {
     logm("$what: ok. (${waited}s)");
 }
 
+#---------- dhcp watching ----------
+
+sub dhcp_watch_host_setup ($) {
+    my ($ho) = @_;
+
+    my $meth = get_host_property($ho,'dhcp-watch-method',undef);
+    $ho->{DhcpWatch} = get_host_method_object($ho, 'DhcpWatch', $meth);
+}
+
+sub guest_check_ip ($) {
+    my ($ho) = @_;
+    guest_find_ether($gho);
+    $ho->{DhcpWatch}->guest_check_ip($ho);
+}
+
 #---------- power cycling ----------
 
 sub power_cycle_host_setup ($) {
     my ($ho) = @_;
     my $methobjs = [ ];
     foreach my $meth (split /\;\s*/, $ho->{Power}) {
-        my (@meth) = split /\s+/, $meth;
-       eval ("use Osstest::PDU::$meth[0];".
-             "push \@\$methobjs, Osstest::PDU::$meth[0]->new(\$ho, \@meth);")
-           or die $@;
+       push @$methobjs, get_host_method_object($ho,'PDU',$meth);
     }
     $ho->{PowerMethobjs} = $methobjs;
 }
@@ -655,11 +667,11 @@ sub selecthost ($) {
 
     $ho->{Ether}= get_host_property($ho,'ether');
     $ho->{DiskDevice}= get_host_property($ho,'disk-device');
-    $ho->{DhcpLeases}= get_host_property($ho,'dhcp-leases',$c{Dhcp3Leases});
     $ho->{Power}= get_host_property($ho,'power-method');
 
     $mhostdb->default_methods($ho);
 
+    dhcp_watch_host_setup($ho);
     power_cycle_host_setup($ho);
 
     my $ip_packed= gethostbyname($ho->{Fqdn});
@@ -683,6 +695,16 @@ sub get_host_property ($$;$) {
     return $mhostdb->get_property(@_);
 }
 
+sub get_host_method_object ($$$) {
+    my ($ho, $kind, $meth) = @_;
+    my (@meth) = split /\s+/, $meth;
+    my $mo;
+    eval ("use Osstest::${kind}::$meth[0];".
+         "\$mo = Osstest::${kind}::$meth[0]->new(\$ho, \@meth);")
+       or die "get_host_method_object $kind $meth $@";
+    return $mo;
+}
+
 #---------- stashed files ----------
 
 sub open_unique_stashfile ($) {
@@ -1013,144 +1035,6 @@ sub report_once ($$$) {
     $ho->{$k}= $msg;
 }
 
-sub guest_check_ip ($) {
-    my ($gho) = @_;
-
-    guest_find_ether($gho);
-
-    my $leases;
-    my $leasesfn = $gho->{DhcpLeases} || $gho->{Host}{DhcpLeases};
-
-    if ($leasesfn =~ m,/,) {
-       $leases= new IO::File $leasesfn, 'r';
-       if (!defined $leases) { return "open $leasesfn: $!"; }
-    } else {
-       $leases= new IO::Socket::INET(PeerAddr => $leasesfn);
-    }
-
-    my $lstash= "dhcpleases-$gho->{Guest}";
-    my $inlease;
-    my $props;
-    my $best;
-    my @warns;
-
-    my $copy= new IO::File "$stash/$lstash.new", 'w';
-    $copy or die "$lstash.new $!";
-
-    my $saveas= sub {
-        my ($fn,$keep) = @_;
-
-        while (<$leases>) { print $copy $_ or die $!; }
-        die $! unless $leases->eof;
-
-        my $rename= sub {
-            my ($src,$dst) = @_;
-            rename "$stash/$src", "$stash/$dst"
-                or $!==&ENOENT
-                or die "rename $fn.$keep $!";
-        };
-        while (--$keep>0) {
-            $rename->("$fn.$keep", "$fn.".($keep+1));
-        }
-        if ($keep>=0) {
-            die if $keep;
-            $rename->("$fn", "$fn.$keep");
-        }
-        $copy->close();
-        rename "$stash/$lstash.new", "$stash/$fn" or die "$lstash.new $fn $!";
-        logm("warning: $_") foreach grep { defined } @warns[0..5];
-        logm("$fn: rotated and stashed current leases");
-    };
-
-    my $badleases= sub {
-        my ($m) = @_;
-        $m= "$leasesfn:$.: unknown syntax";
-        $saveas->("$lstash.bad", 7);
-        return $m;
-    };
-
-    while (<$leases>) {
-        print $copy $_ or die $!;
-
-        chomp; s/^\s+//; s/\s+$//;
-        next if m/^\#/;  next unless m/\S/;
-        if (m/^lease\s+([0-9.]+)\s+\{$/) {
-            return $badleases->("lease inside lease") if defined $inlease;
-            $inlease= $1;
-            $props= { };
-            next;
-        }
-        if (!m/^\}$/) {
-            s/^( hardware \s+ ethernet |
-                 binding \s+ state
-               ) \s+//x
-               or
-            s/^( [-a-z0-9]+
-               ) \s+//x
-               or
-              return $badleases->("unknown syntax");
-            my $prop= $1;
-            s/\s*\;$// or return $badleases->("missing semicolon");
-            $props->{$prop}= $_;
-            next;
-        }
-        return $badleases->("end lease not inside lease")
-            unless defined $inlease;
-
-        $props->{' addr'}= $inlease;
-        undef $inlease;
-
-        # got a lease in $props
-
-        # ignore old leases
-        next if exists $props->{'binding state'} &&
-            lc $props->{'binding state'} ne 'active';
-
-        # ignore leases we don't understand
-        my @missing= grep { !defined $props->{$_} }
-            ('binding state', 'hardware ethernet', 'ends');
-        if (@missing) {
-            push @warns, "$leasesfn:$.: lease without \`$_'"
-                foreach @missing;
-            next;
-        }
-
-        # ignore leases for other hosts
-        next unless lc $props->{'hardware ethernet'} eq lc $gho->{Ether};
-
-        $props->{' ends'}= $props->{'ends'};
-        $props->{' ends'} =~
-            s/^[0-6]\s+(\S+)\s+(\d+)\:(\d+\:\d+)$/
-                sprintf "%s %02d:%s", $1,$2,$3 /e
-                or return $badleases->("unexpected syntax for ends");
-
-        next if $best &&
-            $best->{' ends'} gt $props->{' ends'};
-        $best= $props;
-    }
-
-    if (!$best) {
-        $saveas->("$lstash.nolease", 3);
-        return "no active lease";
-    }
-    $gho->{Ip}= $best->{' addr'};
-
-    report_once($gho, 'guest_check_ip', 
-               "guest $gho->{Name}: $gho->{Ether} $gho->{Ip}");
-    return undef;
-}
-
-sub guest_editconfig ($$$) {
-    my ($ho, $gho, $code) = @_;
-    target_editfile_root($ho, "$gho->{CfgPath}", sub {
-        while (<::EI>) {
-            $code->();
-            print ::EO or die $!;
-        }
-        die $! if ::EI->error;
-    });
-}
-
 sub guest_await_reboot ($$$) {
     my ($ho,$gho, $timeout) = @_;
     poll_loop($timeout, 30, "await reboot request from $gho->{Guest}", sub {
@@ -1379,6 +1263,17 @@ END
     return $cfgpath;
 }
 
+sub guest_editconfig ($$$) {
+    my ($ho, $gho, $code) = @_;
+    target_editfile_root($ho, "$gho->{CfgPath}", sub {
+        while (<::EI>) {
+            $code->();
+            print ::EO or die $!;
+        }
+        die $! if ::EI->error;
+    });
+}
+
 sub guest_check_via_ssh ($) {
     my ($gho) = @_;
     return $r{"$gho->{Guest}_tcpcheckport"} == 22;

diff --git a/README b/README
index 392ca09875fdf04fb6134346595bceb396e180cc..5d400bee267a7a9adda1218a98f442f48076c3b7 100644 (file)
--- a/README
+++ b/README
@@ -9,6 +9,10 @@ Config settings are
    Name value
 or
    Name=  perl expression
+or
+   Name= <<'END'
+   blah blah
+   END
 
 ========================================
 
@@ -28,6 +32,11 @@ HostProp_<host>_<property>
 HostFlags                flag,flag,flag,...
 HostFlags_<host>         flag,!flag,!flag,flag...
 
+HostProp_DhcpWatchMethod
+   leases <format> <source>
+      where <format> is dhcp3
+            <source> is filename (with slash) or <host>:<port>
+
 ========================================
 
 General config settings

diff --git a/config.pl b/config.pl
index fb95c9a2fa1ec36c140fc112f5cfa2504ea8b613..9c4381723a9b1de544c9a905f4e79626070b1fd3 100644 (file)
--- a/config.pl
+++ b/config.pl
@@ -1,8 +1,6 @@
 # things which may need sorting at the use site
 
 $c{GenEtherPrefix}= '5a:36:0e';
-$c{Dhcp3Leases}= '/var/lib/dhcp3/dhcpd.leases';
-
 
 
 $c{Repos}= "$ENV{HOME}/repos";