implemented correct start/stop logic (which now works!)
authorDobrica Pavlinusic <dpavlin@rot13.org>
Thu, 30 Jul 2009 21:31:30 +0000 (21:31 +0000)
committerDobrica Pavlinusic <dpavlin@rot13.org>
Thu, 30 Jul 2009 21:31:30 +0000 (21:31 +0000)
and pushed debug state into $server::debug and file
conf/debug for shared state between servers

lib/PXElator/dhcpd.pm
lib/PXElator/httpd.pm
lib/PXElator/kvm.pm
lib/PXElator/screen.pm
lib/PXElator/server.pm
lib/PXElator/tftpd.pm

index ac11b03..8cd6a1b 100644 (file)
@@ -26,10 +26,9 @@ use Net::DHCP::Packet;
 use Net::DHCP::Constants 0.67;
 
 use server;
+my $debug = server::debug;
 use pxe;
 
-my $debug = 1;
-
 if ( ! $server::ip ) {
        my $server_ip = `/sbin/ifconfig`;
        $server_ip =~ s/^.+?addr:([\d\.]+).*$/$1/gs;
@@ -92,7 +91,7 @@ sub process_packet {
        my $dhcp = Net::DHCP::Packet->new($buf);
        $dhcp->comment( $transaction++ );
 
-       warn "recv: ", $dhcp->toString;
+       warn "recv: ", $dhcp->toString if $debug;
 
        my $mac = substr($dhcp->chaddr(),0,$dhcp->hlen()*2);
        my $ip = client_ip($mac);
@@ -155,7 +154,7 @@ sub process_packet {
        warn ">> $mac == $ip server: $server::ip", $pxe::file ? " pxe file: $pxe::file\n" : "\n";
 
        $packet = new Net::DHCP::Packet( %$packet );
-       warn "## ",$packet->toString(),"\n" if $debug;
+       warn "send ",$packet->toString() if $debug;
 
        my $reply = IO::Socket::INET->new(
                LocalAddr => $server::ip,
index 3971385..5283184 100644 (file)
@@ -30,9 +30,9 @@ sub DESTROY {
 }
 
 our $port = 7777;
-our $debug = 0;
 
 use server;
+our $debug = server::debug;
 our $url = "http://$server::ip:$port";
 
 use html;
@@ -73,8 +73,6 @@ sub static {
        return $path;
 }
 
-my $ok = "HTTP/1.0 200 OK\r\nContent-Type: text/html\r\nConnection: close\r\n\r\n";
-
 use boolean;
 
 use screen;
@@ -86,9 +84,9 @@ sub start_stop {
        my $daemon = shift;
        my $pid = $pids->{$daemon};
 
-       warn "start_stop $daemon pids: ",dump( $pids );
+       warn "start_stop $daemon $pid pids: ",dump( $pids );
 
-       if ( $pid ) {
+       if ( $pid =~ m{^\d+$} ) {
                warn "kill 9 $pid";
                kill 9, $pid;
                $pids->{$daemon} = 'stopped';
@@ -101,7 +99,7 @@ sub start_stop {
                        return qq|$daemon pid $pid started|;
                } elsif ( defined $pid ) {
                        # child
-                       my $eval = $daemon . '::start(' . dump(@_) . ')';
+                       my $eval = $daemon . '::start(' . ( @_ ? dump(@_) : '' ) . ')';
                        warn "eval $eval";
                        eval $eval;
                        warn "can't start $daemon: $@" if $@;
@@ -112,6 +110,9 @@ sub start_stop {
        }
 }
 
+my $ok =       qq|HTTP/1.0 200 OK\r\nContent-Type: text/html\r\nConnection: close\r\n\r\n|;
+my $redirect = qq|HTTP/1.1 302 Found\r\nContent-type: text/html\r\nLocation: $url\r\n\r\n|;
+
 sub get_request {
        my ( $client, $path, $param ) = @_;
 
@@ -133,10 +134,11 @@ sub get_request {
                );
                foreach my $name ( %$pids ) {
                        my $pid = $pids->{$name} || next;
+                       my $proc = "/proc/$pid/status";
 
                        my $html = qq|<a href=/$name>$pid</a>|;
                        $html   .= qq|<pre style="font-size: 10%">|
-                                       .  ( $debug ? read_file("/proc/$pid/status") : '' )
+                                       .  ( $debug && -e $proc ? read_file($proc) : '' )
                                        .  qq|</pre>| if $debug;
 
                        push @rows, ( $name => $html );
@@ -147,9 +149,10 @@ sub get_request {
        } elsif ( $path =~ m{^/our/(\w+)/(\S+)} ) {
                eval 'our $' . $1 . ' = ' . $2;
                warn $@ if $@;
-               print $client qq|HTTP/1.1 302 Found\r\nLocation: $url\r\nContent-type: text/html\r\n\r\n<big>$1 = $2</big><br>Location: <a href="$url">$url</a>|;
+               print $client $redirect, qq|<big>$1 = $2</big><br>Location: <a href="$url">$url</a>|;
+               server::debug( $debug ) if $1 eq 'debug';
        } elsif ( $path =~ m{^/(screen|kvm)} ) {
-               print $client $ok, start_stop($1);
+               print $client $redirect, start_stop($1);
        } elsif ( $path eq '/exit' ) {
 #              DESTROY;
                exit 0;
index f3af706..c05d4bc 100644 (file)
@@ -8,6 +8,8 @@ use File::Slurp;
 
 use server;
 
+our $debug = server::debug;
+
 my $interfaces = read_file '/etc/network/interfaces';
 
 if ( $interfaces !~ m{tap0.*$server::ip}s ) {
index 1041cc3..9a37321 100644 (file)
@@ -9,6 +9,8 @@ use File::Slurp;
 use log;
 use server;
 
+our $debug = server::debug;
+
 my $screenrc = '/tmp/screenrc';
 
 sub screen_daemon {
index a292a60..cd1c07b 100644 (file)
@@ -1,5 +1,9 @@
 package server;
 
+use warnings;
+use strict;
+use File::Slurp;
+
 our $ip      = '172.16.10.1';
 our $netmask = '255.255.255.0';
 
@@ -7,4 +11,16 @@ our ( $ip_from, $ip_to ) = ( 10, 100 );
 
 our $base_dir = '/home/dpavlin/llin/pxelator';
 
+our $debug = 0;
+sub debug {
+       my $new = shift;
+       my $path ="$base_dir/conf/debug";
+       if ( defined $new ) {
+               write_file $path, $debug = $new;
+       } else {
+               $debug = read_file $path if -e $path;
+       }
+       return $debug;
+}
+
 warn "loaded";
index d67ff88..5e20f9a 100644 (file)
@@ -8,6 +8,8 @@ use Data::Dump qw/dump/;
 
 use server;
 
+our $debug = server::debug;
+
 our $dir  = "$server::base_dir/tftp";
 
 sub path {
@@ -71,7 +73,7 @@ sub start {
                Debug => 99,
        ) || die Net::TFTPd->error;
 
-       warn 'listener: ',dump( $listener );
+       warn 'listener: ',dump( $listener ) if $debug;
 
        while(1) {