report error without nmap output
[pxelator] / lib / PXElator / httpd.pm
index 6325d95..6f72a5a 100644 (file)
@@ -18,6 +18,7 @@ use File::Slurp;
 #use JSON;
 use IO::Socket::INET;
 use Regexp::Common qw/net/;
+use POSIX qw(strftime);
 
 our $title;
 
@@ -36,19 +37,6 @@ qq{
 </html>
 }}
 
-sub menu {
-qq{
-<div style="font-size: 80%; color: #888">
-<a href=/>home</a>
-<a href=/server>server</a>
-<a href=/brctl>brctl</a>
-<a href=/ip>ip</a>
-<a href=/nmap>nmap</a>
-<a href=/client>client</a>
-</div>
-
-}}
-
 our $port = 7777;
 
 use server;
@@ -63,7 +51,6 @@ use client;
 use log;
 use x11;
 use amt;
-use boolean;
 use daemons;
 
 use kvm;
@@ -76,7 +63,29 @@ use nmap;
 use ping;
 use wol;
 
-use CouchDB;
+use store;
+
+
+sub menu {
+       my $store_url = $url;
+       $store_url =~ s{:\d+.+}{:28017};
+qq{
+<div style="font-size: 80%; color: #888">
+<a target=pids href=/ >home</a>
+|
+<a target=server href=/server >server</a>
+<a target=server href=/brctl >brctl</a>
+<a target=server href=/ip >ip</a>
+|
+<a target=store href=$store_url >MongoDB</a>
+<a target=store href=/store/latest >latest</a>
+|
+<a target=client href=/nmap >nmap</a>
+<a target=client href=/client >client</a>
+</div>
+
+}}
+
 
 sub static {
        my ($client,$path) = @_;
@@ -109,7 +118,7 @@ sub static {
        my $buff;
        my $pos = 0;
 
-       CouchDB::audit( 'static', { pid => $$, path => $path, type => $type, size => $size, block => $block, peerhost => $client->peerhost });
+       store::audit( 'static', { pid => $$, path => $path, type => $type, size => $size, block => $block, peerhost => $client->peerhost });
 
        progress_bar::start;
 
@@ -137,12 +146,17 @@ sub redirect {
        qq|HTTP/1.1 302 Found\r\nContent-type: text/html\r\nLocation: $to\r\n\r\n|
 }
 
+sub toggle {
+       my $v = shift;
+       return $v ? 0 : 1;
+}
+
 sub get_request {
        my ( $client, $path, $param ) = @_;
 
        server->refresh;
 
-       CouchDB::audit( 'request', { path => $path, param => $param, peerhost => $client->peerhost } );
+       store::audit( 'request', { path => $path, param => $param, peerhost => $client->peerhost } );
 
        $title = $path;
 
@@ -217,9 +231,13 @@ warn "XXX pids = ", dump( $daemons::pids );
                        }
                }
 
+               my $kvm = kvm::next_nr;
+               $kvm = qq|<div><a href=/start_stop/kvm?nr=$kvm>create new kvm $kvm</a></div>|;
+
                print $client ok
                        , html::table( 2, @rows )
                        , $below_table
+                       , $kvm
                        , html::tabs( log::mac_changes )
                        , $debug_proc
                        ;
@@ -229,11 +247,11 @@ warn "XXX pids = ", dump( $daemons::pids );
                        eval '$server::' . $name . '= $param->{$name}';
                }
                my @table = (
-                         'debug' => qq|<a href=/our/debug/| . boolean::toggle($debug) . qq|>$debug</a>|,
+                         'debug' => qq|<a href=/our/debug/| . toggle($debug) . qq|>$debug</a>|,
                        , 'new_clients' => qq|<input type=text name=new_clients size=3 value="$server::new_clients">|
                );
 
-               foreach my $editable ( 'ip', 'netmask', 'ip_from', 'ip_to', 'domain' ) {
+               foreach my $editable ( 'ip', 'bcast', 'netmask', 'ip_from', 'ip_to', 'domain' ) {
                        my $v = eval '$server::' . $editable;
                        push @table, ( $editable, qq|<input type=text name=$editable value="$v">| );
                }
@@ -252,9 +270,69 @@ warn "XXX pids = ", dump( $daemons::pids );
                        |
                        ;
 
+       } elsif ( $path =~ m{^/store/latest} ) {
+               print $client ok
+                       , qq|
+<style type=text/css>
+       .z {
+               background: #eee;
+       }
+       td > pre {
+               margin: 0;
+               max-height: 3em;
+               overflow: hidden;
+       }
+       td:hover > pre {
+               max-height: 100%;
+               overflow: show;
+       }
+</style>
+                       |
+                       , qq|<table>|
+               ;
+               my ( $s1,$s2 ) = ( ' class=z', '' );
+               my @cols;
+
+               my $from_t = $param->{from_t};
+
+               my $q;
+               $q->{'package.time'} = { '$lt' => $from_t * 1 } if $from_t;
+#              $q->{'package.name'} = { '$ne' => 'syslogd' };
+               $q->{'package.name'} = { '$ne' => 'dhcpd' };
+#              $q->{'package.name'} = { '$ne' => [ 'dhcpd', 'dnsd' ] };
+               $q->{'tag'} = { '$ne' => 'CRON' };
+               store::query( $q, sub {
+                       my $o = shift;
+                       my $p = delete( $o->{package} );
+                       delete( $o->{_id} );
+
+                       if ( ! @cols ) {
+                               #@cols = keys %$p;
+                               @cols = qw( time name );
+                               print $client qq|<tr><th>|
+                                       , join(qq|</th><th>|, @cols)
+                                       , qq|</th><th></th></tr>|
+                               ;
+                       }
+
+                       # XXX sigh, dump dies if we don't do this
+#                      delete $o->{$_} foreach ( grep { ! defined $o->{$_} } keys %$o );
+
+                       print $client qq|<tr$s1>|
+                               , strftime( qq|<td title="%Y-%m-%d">%H:%M:%S</td>|, localtime($p->{time}) )
+                               , map { qq|<td>$_<td>| } ( $p->{name} , html::pre_dump($o) )
+                               , qq|</tr>\n|
+                       ;
+                       ( $s1, $s2 ) = ( $s2, $s1 );
+                       $from_t = $p->{time};
+               });
+               print $client qq|</table>|,
+                       qq|<a href="/store/latest?from_t=$from_t">more</a>|
+               ;
+
        } elsif ( $path =~ m!^/client(?:/$RE{net}{IPv4}{-keep})?! ) {
                my $ip = $1;
-               $title = $ip;
+               $title = $ip if $ip;
 
                if ( $param->{action} eq 'remove' ) {
                        client::remove( $param->{change_ip} );
@@ -284,13 +362,19 @@ warn "XXX pids = ", dump( $daemons::pids );
 
                if ( $ip && $ip ne $server::ip ) {
 
-                       my @editable = ( qw/hostname config homepage/ );
-
-                       client::conf( $ip, $_ => $param->{$_} ) foreach @editable;
-
                        my $conf = client::all_conf( $ip );
                        my $config = delete $conf->{config};
 
+                       my @editable = ( qw/hostname config homepage/ );
+                       # add params with config prefix if config exists
+                       push @editable, grep { m{^\Q$config\E} } keys %$conf if $config;
+                       my @update = grep { defined $param->{$_} } @editable;
+                       if ( @update ) {
+                               client::conf( $ip, $_ => $param->{$_} ) foreach @update;
+                               print $client redirect("$url/client/$ip");
+                               return;
+                       }
+
                        my $nmap = qq|<a href=/nmap?scan=$ip>nmap</a>|;
                        my @table = (
                                'ping' => ping::host($ip)
@@ -326,6 +410,8 @@ warn "XXX pids = ", dump( $daemons::pids );
 
                } else {
 
+                       print $client ok qq|<h2>Clients on $server::ip</h2>|;
+
                        my @ping;
                        if ( my $host = $param->{ping_target} ) {
                                @ping = ( $host );
@@ -336,31 +422,42 @@ warn "XXX pids = ", dump( $daemons::pids );
                        my $ping = ping::fping( @ping ) if @ping;
                        my $arp = client::arp_mac_dev;
 
-                       print $client ok
-                               , qq|<h2>Clients on $server::ip</h2>|
-                               , html::table( -5,
-                                       'ip', 'mac', 'dev', 'hostname', 'conf',
-                                       map {
-                                               my $ip = $_;
-                                               my $conf = client::all_conf( $ip );
-                                               my $mac = delete $conf->{mac} || '';
-                                               my $style;
-                                               $style
-                                                       = 'style="color:'
-                                                       . ( $ping->{$ip} ? 'green' : 'red' )
-                                                       . '"'
-                                                       if $ping;
-                                               $style ||= '';
-                                               (
-                                                       qq|<a $style name=$ip target=$ip href=/client/$ip>$ip</a>|
-                                                       , format::mac( $mac => 'html' )
-                                                       , $arp->{$mac}
-                                                       , delete $conf->{hostname}
-                                                       , html::conf( $ip, $conf, 'inline' )
-                                               )
-                                       } client::all_ips
-                               )
+                       my @clients;
+
+                       foreach my $ip ( client::all_ips ) {
+                               
+                               my $conf = client::all_conf( $ip );
+                               my $mac = delete $conf->{mac} || '';
+                               my $dev = $arp->{$mac};
+
+                               my $in_dhcp_range = ip::in_dhcp_range($ip);
+
+                               next unless $dev || $param->{all} || $in_dhcp_range;
+
+                               my $style
+                                       = 'style="color:'
+                                       . ( $ping->{$ip} ? 'green' : 'red' )
+                                       . '"'
+                                       if $ping;
+
+                               $style ||= '';
+                               my $ip_text = qq|<tt>$ip</tt>|;
+                               $ip_text = qq|<tt><b>$ip</b></tt>| if $in_dhcp_range;
+
+                               $dev = qq|<tt>$dev</tt>| if $dev;
+
+                               push @clients
+                                       , qq|<a $style name=$ip target=client href=/client/$ip>$ip_text</a>|
+                                       , format::mac( $mac => 'html' )
+                                       , $dev
+                                       , delete $conf->{hostname}
+                                       , html::conf( $ip, $conf, 'inline' )
                                ;
+                       }
+
+                       my $all = $param->{all} ? 0 : 1;
+
+                       print $client html::table( -5, 'ip', 'mac', qq|<a href="?all=$all">dev</a>|, 'hostname', 'conf', @clients );
                        print $client qq|
                                <form method=get>
                                <input type=text   name=ping_target   size=15>
@@ -458,7 +555,7 @@ sub start {
 
        my $server = IO::Socket::INET->new(
                        Proto     => 'tcp',
-                       LocalAddr => $server::ip,
+#                      LocalAddr => $server::ip,
                        LocalPort => $httpd::port,
                        Listen    => SOMAXCONN,
                        Reuse     => 1
@@ -467,12 +564,27 @@ sub start {
        print "url $url\n";
 
        syslogd::install_local;
+       client::rebuild_mac_links;
 
        while (1) {
                my $client = $server->accept() || next; # ALARM trickle us
                my $request = <$client>;
 
-               warn "request $request\n" if $debug;
+               my $headers;
+
+               while ( my $header = <$client> ) {
+                       chomp $header;
+                       last if $header =~ m{^\s*$};
+                       my ( $n, $v ) = split(/:\s*/, $header);
+                       $headers->{ lc $n } = $v;
+               }
+
+               if ( my $host = $headers->{host} ) {
+                       $url = 'http://' . $host;
+                       $url .= ":$port" unless $url =~ m{:\d+$};
+               }
+
+               warn "## $url ## $request", dump( $headers ) if $debug;
 
                if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
                        my $path = $1;