--- lib/PXElator/httpd.pm 2009/08/11 15:13:19 199 +++ lib/PXElator/httpd.pm 2009/08/27 17:44:03 311 @@ -24,6 +24,9 @@
home server +brctl +ip +nmap client
@@ -49,7 +52,12 @@ use kvm; use browser; use network; +use ip; +use wireshark; +use syslogd; +use nmap; +use CouchDB; sub static { my ($client,$path) = @_; @@ -61,7 +69,6 @@ if ( my $pid = fork ) { # parent close($client); - print "http static child $pid\n"; $static_pids->{$pid} = $path; return 1; } @@ -81,7 +88,7 @@ my $buff; my $pos = 0; - warn "static $path $type $size block: $block\n"; + CouchDB::audit( 'static', { pid => $$, path => $path, type => $type, size => $size, block => $block, peerhost => $client->peerhost }); progress_bar::start; @@ -96,8 +103,6 @@ print STDERR "\n"; - warn "exit static child"; - exit(0); } @@ -116,20 +121,20 @@ server->refresh; - warn "get_request $path ", $param ? dump( $param ) : '', "\n"; + CouchDB::audit( 'request', { path => $path, param => $param, peerhost => $client->peerhost } ); if ( my $found = static( $client,$path ) ) { 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; @@ -138,7 +143,7 @@ if ( -e $proc ) { $html .= qq|$pid|; if ( $debug ) { - $html .= qq| ?|; + $html .= qq| ?| if $name->can('start'); $debug_proc .= qq|$proc
|
@@ -147,17 +152,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 );
 		}
 
@@ -185,11 +200,25 @@
 
 	} 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;
-		if ( $ip ne $server::ip ) {
+
+		if ( my $new_ip = $param->{change_ip} ) {
+			client::change_ip( $ip, $new_ip );
+			$ip = $new_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 = (
@@ -199,13 +228,15 @@
 
 			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 ) ); + if ( my $pxelinux = config::for_ip( $ip ) ) { + $deploy = qq|

PXElinux

| . html::pre( $pxelinux ); + } } print $client ok @@ -216,7 +247,7 @@ ; if ( my $amt = client::conf( $ip, 'amt' ) ) { - print $client qq|

AMT

|, amt::info( $amt ); + print $client qq|

AMT

|, amt::info( $amt, $ip ); } } else { @@ -224,6 +255,7 @@ map { my @c = split(/\s+/,$_); if ( $#c == 5 ) { + client::save_ip_mac( $c[0], $c[3] ); ( uc $c[3] => [ $c[0] , $c[5] ] ) } else { } @@ -234,33 +266,58 @@ print $client ok , qq|

Clients on $server::ip

| - , html::table( -5, - 'ip', 'hostname', 'mac', 'deploy', 'arp', + , html::table( -6, + 'ip', 'mac', 'arp', 'hostname', 'deploy', 'conf', map { my $ip = $_; - $ip =~ s{^.+/ip/}{}; - my $arp = $arp->{ client::mac $ip, 'clean' }; - $arp = $arp ? $arp->[1] : ''; - $arp =~ s{$ip}{}; + my $conf = client::all_conf( $ip ); + my $mac = delete $conf->{mac} || ''; ( - qq|$ip| - , client::conf( $ip, 'hostname' ) - , client::mac( $ip ) - , html::tt( client::conf( $ip, 'deploy' ) ) - , $arp + qq|$ip| + , format::mac( $mac => 'html' ) + , ( $arp->{$mac} ? $arp->{$mac}->[1] : '' ) + , delete $conf->{hostname} + , delete $conf->{deploy} + , ( %$conf ? html::pre_dump( $conf ) : qq|nmap| ) ); } - glob("$server::conf/ip/*") + sort { ip::to_int($a) cmp ip::to_int($b) } + map { + my $ip = $_; + $ip =~ s{^.+/ip/}{}; + $ip; + } glob("$server::conf/ip/*") ) , qq|

ARP

| - , html::table( -3, 'mac', 'dev', 'ip', + , html::table( -3, 'ip', 'mac', 'dev', map { my $c = $arp->{$_}; - ( html::tt( $_ ), $c->[1], $c->[0] ) + ( $c->[0], format::mac( $_ => 'html' ), $c->[1] ) } 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{^/nmap} ) { + if ( my $scan = $param->{scan} ) { + nmap::scan( $scan ); + print $client redirect("$url/client#$scan"); + } else { + print $client ok, qq| +
+ + +
+ |; + } } elsif ( $path =~ m{^/our/(\w+)/(\S+)} ) { eval 'our $' . $1 . ' = ' . $2; warn $@ if $@; @@ -283,10 +340,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(