--- lib/PXElator/httpd.pm 2009/07/31 18:16:14 88
+++ lib/PXElator/httpd.pm 2009/08/06 15:40:42 159
@@ -17,7 +17,16 @@
use File::Slurp;
#use JSON;
use IO::Socket::INET;
-use Module::Refresh;
+
+sub menu {qq{
+
+
+
+}}
our $pids;
$pids = { httpd => $$ } unless defined $pids; # keep pids on refresh
@@ -38,6 +47,10 @@
use html;
our $static_pids;
+use progress_bar;
+use config;
+use client;
+use log;
sub static {
my ($client,$path) = @_;
@@ -64,37 +77,42 @@
print $client "HTTP/1.0 200 OK\r\nContent-Type: $type\r\nContent-Length: $size\r\nConnection: close\r\n\r\n";
open(my $fh, $full);
- print "static $path $type $size\n";
- my $block = 8192;
+ my $block = 1400; # try not to fragment packages (pxelinux seems to have problems with it)
my $buff;
my $pos = 0;
+ warn "static $path $type $size block: $block\n";
+
+ progress_bar::start;
+
while( my $len = read $fh, $buff, $block ) {
print $client $buff;
+ $client->flush;
$pos += $len;
- printf "%s %d/%d %.2f%%\r", $path, $pos, $size, $pos * 100 / $size;
+ progress_bar::tick( $path, $pos, $size );
}
close($fh);
close($client);
- print "$path $pos == $size OK\n";
+ print STDERR "\n";
- exit;
+ warn "exit static child";
+
+ exit(0);
}
use boolean;
-use screen;
use kvm;
$SIG{CHLD} = 'IGNORE';
sub start_stop {
my $daemon = shift;
- my $pid = $pids->{$daemon};
+ my $pid = $pids->{$daemon} || 'not started';
- warn "start_stop $daemon $pid pids: ",dump( $pids );
+ warn "start_stop $daemon $pid\n";
if ( $pid =~ m{^\d+$} ) {
my $pstree = `pstree -p $pid`;
@@ -107,16 +125,22 @@
if ( $pid = fork ) {
# parent
$pids->{$daemon} = $pid;
- warn "forked $daemon $pid";
+ warn "forked $daemon $pid\n";
return qq|$daemon pid $pid started|;
} elsif ( defined $pid ) {
# child
my $invoke = 'start';
$invoke = $1 if $daemon =~ s{/(.+)}{};
- my $eval = $daemon . '::' . $invoke . '(' . ( @_ ? dump(@_) : '' ) . ')';
- warn "eval $eval";
- eval $eval;
- warn "can't start $daemon: $@" if $@;
+ if ( $daemon =~ m{dhcpd|tftpd|dnsd} ) {
+ my $exec = "perl -I$server::base_dir/lib -I$server::base_dir/lib/PXElator -M$daemon -e ${daemon}::${invoke}";
+ warn "exec $exec";
+ exec "xterm -T $daemon -n $daemon -e $exec";
+ } else {
+ my $eval = $daemon . '::' . $invoke . '(' . ( @_ ? dump(@_) : '' ) . ')';
+ warn "eval $eval";
+ eval $eval;
+ warn "can't start $daemon: $@" if $@;
+ }
exit;
} else {
die "fork error $!";
@@ -130,30 +154,25 @@
sub get_request {
my ( $client, $path, $param ) = @_;
- warn "get_request $client $path ",dump( $param );
+ server->refresh;
+
+ warn "get_request $path ", $param ? dump( $param ) : '', "\n";
if ( my $found = static( $client,$path ) ) {
warn "static $found" if $debug;
} elsif ( $path eq '/' ) {
- my $screen = $pids->{screen} ? qq|stop $pids->{screen}| : 'start';
- my $kvm = $pids->{kvm} ? qq|stop $pids->{kvm}| :
- $pids->{screen} ? qq|start| : qq|start screen first|;
-
my @rows = (
- 'ip', html::tt( $server::ip ),
- 'netmask', html::tt( $server::netmask ),
-
'debug', qq|$debug|,
);
- my $debug_proc;
+ my $debug_proc = '';
warn 'pids: ', dump( $pids ) if $debug;
foreach my $name ( sort keys %$pids ) {
my $pid = $pids->{$name} || next;
- my $html = qq|$pid|;
+ my $html = qq|$pid|;
my $proc = "/proc/$pid/status";
@@ -180,28 +199,56 @@
push @rows, ( $name => $html );
}
+ my $below_table = '';
+
warn 'static_pids: ', dump( $static_pids ) if $debug;
foreach my $pid ( keys %$static_pids ) {
my $path = $static_pids->{$pid};
if ( -d "/proc/$pid" ) {
push @rows, ( $path => qq|$pid| );
+ } elsif ( $param->{clean_completed_downloads} ) {
+ delete $static_pids->{$pid}
} else {
push @rows, ( $path => "$pid competed" );
+ $below_table = qq|clean completed downloads|;
}
}
print $client $ok
+ , menu()
, html::table( 2, @rows )
+ , $below_table
, html::tabs( log::mac_changes )
, $debug_proc
;
+ } elsif ( $path =~ m{^/server} ) {
+ print $client $ok
+ , menu()
+ , html::table( 2, map { ( $_, eval '$server::'.$_ ) } ( 'ip', 'netmask', 'ip_from', 'ip_to', 'domain_name', 'base_dir' ) )
+ ;
+ } elsif ( $path =~ m{^/client} ) {
+ my $ip = $client->peerhost;
+ my $hostname = client::conf( $ip, 'hostname' => $param->{hostname} );
+ my $deploy = client::conf( $ip, 'deploy' => $param->{deploy} );
+ print $client $ok
+ , menu()
+ , qq||
+ , config::for_ip( $ip )
+ , qq|
|
+ ;
} elsif ( $path =~ m{^/our/(\w+)/(\S+)} ) {
eval 'our $' . $1 . ' = ' . $2;
warn $@ if $@;
print $client $redirect, qq|$1 = $2
Location: $url|;
server::debug( $debug ) if $1 eq 'debug';
- } elsif ( $path =~ m{^/start_stop/((?:screen|kvm).*)} ) {
+ } elsif ( $path =~ m{^/start_stop/(\S+)} ) {
print $client $redirect, start_stop($1);
} elsif ( $path =~ m{^/action/([^/]+)/(.+)} ) {
$1->$2();
@@ -228,9 +275,12 @@
}
use browser;
+use network;
sub start {
+ warn 'tap ', network::tap();
+
my $server = IO::Socket::INET->new(
Proto => 'tcp',
LocalPort => $httpd::port,
@@ -241,17 +291,17 @@
print "url $url\n";
start_stop 'browser', $url;
- start_stop 'screen';
+ start_stop 'dhcpd';
+ start_stop 'tftpd';
+ start_stop 'dnsd';
start_stop 'kvm';
- while (my $client = $server->accept()) {
- $client->autoflush(1);
+ while (1) {
+ my $client = $server->accept() || next; # ALARM trickle us
my $request = <$client>;
warn "request $request\n" if $debug;
- Module::Refresh->refresh;
-
if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
my $path = $1;
my $param;
@@ -262,20 +312,13 @@
}
warn "param: ",dump( $param ) if $debug;
}
- warn "path $path param: ",dump( $param );
get_request $client, $path, $param;
} else {
print $client "HTTP/1.0 500 No method\r\nConnection: close\r\nContent-type: text/plain\r\n\r\n500 $request";
warn "500 $request";
}
- print $client qq{
-
- } if $client->connected;
+ print $client menu() if $client->connected;
}