--- lib/PXElator/httpd.pm 2009/08/12 23:59:01 208 +++ lib/PXElator/httpd.pm 2009/08/24 22:04:39 284 @@ -24,6 +24,8 @@
@@ -49,6 +51,9 @@ use kvm; use browser; use network; +use ip; +use wireshark; +use syslogd; use CouchDB; @@ -120,14 +125,14 @@ warn "static $found" if $debug; } elsif ( $path eq '/' ) { - my @rows = ( - 'debug', qq|$debug|, - ); + my @rows; my $debug_proc = ''; +warn "XXX pids = ", dump( $daemons::pids ); + foreach my $name ( sort keys %$daemons::pids ) { - my $pid = $daemons::pids->{$name} || next; + my $pid = $daemons::pids->{$name}; # || next; my $html; @@ -136,7 +141,7 @@ if ( -e $proc ) { $html .= qq|$pid|; if ( $debug ) { - $html .= qq| ?|; + $html .= qq| ?| if $name->can('start'); $debug_proc .= qq|$proc| @@ -145,17 +150,27 @@ ; } - if ( $name->can('start_fork') ) { - $html .= qq| $_| foreach $name->start_fork; + if ( $name->can('fork_if_active') ) { + $html .= qq| $_| foreach $name->fork_if_active; } if ( $name->can('actions') ) { - $html .= qq| $_| foreach $name->actions; + $html .= qq| $_| foreach $name->actions; } } else { - $html .= qq|restart $pid exited|; + if ( $pid =~ m{^\d+$} ) { + $html .= qq|$pid exited | + } else { + $html .= qq|$pid |; + } + $html .= qq|restart| if $pid || $name->can('start'); + if ( $name->can('fork_actions') ) { + $html .= qq| $_| foreach $name->fork_actions; + } } + die "no html generated" unless $html; + push @rows, ( $name => $html ); } @@ -183,7 +198,12 @@ } elsif ( $path =~ m{^/server} ) { print $client ok - , html::table( 2, map { ( $_, html::tt eval '$server::'.$_ ) } ( 'ip', 'netmask', 'ip_from', 'ip_to', 'domain_name', 'base_dir', 'conf' ) ) + , html::table( 2, + 'debug' => qq|$debug|, + map { + ( $_, html::tt eval '$server::'.$_ ) + } ( 'ip', 'netmask', 'ip_from', 'ip_to', 'domain_name', 'base_dir', 'conf' ) + ) ; } elsif ( $path =~ m!^/client(?:/$RE{net}{IPv4}{-keep})?! ) { my $ip = $1 || $client->peerhost; @@ -193,7 +213,10 @@ $ip = $new_ip; } - if ( $ip ne $server::ip ) { + my $ip_short = (split(/\./, $ip, 4))[3]; + + # if ( $ip ne $server::ip ) -- not flexible enough for tunnel endpoints + if ( $ip_short >= $server::ip_from && $ip_short <= $server::ip_to ) { my $hostname = client::conf( $ip, 'hostname' => $param->{hostname} ); my @table = ( @@ -203,10 +226,10 @@ my $deploy; - if ( my $mac = client::mac( $ip ) ) { + if ( my $mac = client::mac_from_ip( $ip ) ) { $deploy = client::conf( $ip, 'deploy' => $param->{deploy} ); push @table, ( - 'mac' => $mac, + 'mac' => format::mac( $mac => 'html' ), 'deploy' => html::select( 'deploy', $deploy, config::available ) ); $deploy = qq|PXElinux
| . html::pre( config::for_ip( $ip ) ); @@ -220,7 +243,7 @@ ; if ( my $amt = client::conf( $ip, 'amt' ) ) { - print $client qq|AMT
|, amt::info( $amt ); + print $client qq|AMT
|, amt::info( $amt, $ip ); } } else { @@ -243,13 +266,14 @@ map { my $ip = $_; $ip =~ s{^.+/ip/}{}; - my $arp = $arp->{ client::mac $ip, 'clean' }; + my $mac = client::mac_from_ip $ip; + my $arp = $arp->{ $mac }; $arp = $arp ? $arp->[1] : ''; $arp =~ s{$ip}{}; ( qq|$ip| , client::conf( $ip, 'hostname' ) - , client::mac( $ip ) + , format::mac( $mac => 'html' ) , html::tt( client::conf( $ip, 'deploy' ) ) , $arp ); @@ -260,11 +284,20 @@ , html::table( -3, 'mac', 'dev', 'ip', map { my $c = $arp->{$_}; - ( html::tt( $_ ), $c->[1], $c->[0] ) + ( format::mac( $_ => 'html' ), $c->[1], $c->[0] ) } sort keys %$arp ) ; } + } elsif ( $path =~ m{^/brctl} ) { + print $client ok + ,html::pre( `brctl show` ) + ; + } elsif ( $path =~ m{^/ip/?(\w+)?} ) { + print $client ok + , join("\n", map { qq|$_| } ( qw/link addr route neigh ntable tunnel maddr mroute xfrm/ )) + , ip::html( $1 ) + ; } elsif ( $path =~ m{^/our/(\w+)/(\S+)} ) { eval 'our $' . $1 . ' = ' . $2; warn $@ if $@; @@ -287,10 +320,10 @@ sub start { - warn 'tap ', network::tap(); + warn 'network ', network::setup(); daemons::start_stop 'browser', $url; - daemons::start_stop $_ foreach ( qw/dhcpd tftpd dnsd/ ); + daemons::start_stop $_ foreach ( qw/dhcpd tftpd dnsd syslogd/ ); daemons::start_stop 'kvm' unless $ENV{DEV}; # skip kvm statup when running on real device my $server = IO::Socket::INET->new(