git.rot13.org Git - pxelator/blob - lib/PXElator/httpd.pm

   1 package httpd;
   2
   3 use warnings;
   4 use strict;
   5 use autodie;
   6
   7 =head1 httpd
   8
   9 Start with:
  10
  11   perl -Ilib/PXElator -Mhttpd -e httpd::start
  12
  13 =cut
  14
  15 use Data::Dump qw/dump/;
  16 use Carp qw/confess/;
  17 use File::Slurp;
  18 #use JSON;
  19 use IO::Socket::INET;
  20 use Module::Refresh;
  21
  22 our $pids;
  23 $pids = { httpd => $$ } unless defined $pids; # keep pids on refresh
  24
  25 sub DESTROY {
  26         warn "pids ",dump( $pids );
  27         foreach ( values %$pids ) {
  28                 warn "kill $_";
  29                 kill 1,$_ || kill 9, $_;
  30         }
  31 }
  32
  33 our $port = 7777;
  34
  35 use server;
  36 our $debug = server::debug;
  37 our $url = "http://$server::ip:$port";
  38
  39 use html;
  40 our $static_pids;
  41
  42 sub static {
  43         my ($client,$path) = @_;
  44
  45         my $full = "$server::base_dir/tftp/$path";
  46
  47         return if ! -f $full;
  48
  49         if ( my $pid = fork ) {
  50                 # parent
  51                 close($client);
  52                 print "http static child $pid\n";
  53                 $static_pids->{$pid} = $path;
  54                 return 1;
  55         }
  56
  57         my $type = 'application/octet-stream';
  58         $type = 'text/html' if $path =~ m{\.htm};
  59         $type = 'application/javascript' if $path =~ m{\.js};
  60         $type = 'text/plain' if $path =~ m{\.txt};
  61
  62         my $size = -s $full || return;
  63
  64         print $client "HTTP/1.0 200 OK\r\nContent-Type: $type\r\nContent-Length: $size\r\nConnection: close\r\n\r\n";
  65
  66         open(my $fh, $full);
  67         print "static $path $type $size\n";
  68
  69         my $block = 8192;
  70         my $buff;
  71         my $pos = 0;
  72
  73         while( my $len = read $fh, $buff, $block ) {
  74                 print $client $buff;
  75                 $pos += $len;
  76                 printf "%s %d/%d %.2f%%\r", $path, $pos, $size, $pos * 100 / $size;
  77         }
  78         close($fh);
  79         close($client);
  80
  81         print "$path $pos == $size OK\n";
  82
  83         exit;
  84 }
  85
  86 use boolean;
  87
  88 use screen;
  89 use kvm;
  90
  91 $SIG{CHLD} = 'IGNORE';
  92
  93 sub start_stop {
  94         my $daemon = shift;
  95         my $pid = $pids->{$daemon};
  96
  97         warn "start_stop $daemon $pid pids: ",dump( $pids );
  98
  99         if ( $pid =~ m{^\d+$} ) {
 100                 my $pstree = `pstree -p $pid`;
 101                 my @pids = $pstree =~ m{\((\d+)\)}g;
 102                 warn "pstree $pstree pids ",dump( @pids );
 103                 kill 1, $_ foreach reverse @pids;
 104                 $pids->{$daemon} = 'stopped';
 105                 return qq|$daemon pid $pid stopped|;
 106         } else {
 107                 if ( $pid = fork ) {
 108                         # parent
 109                         $pids->{$daemon} = $pid;
 110                         warn "forked $daemon $pid";
 111                         return qq|$daemon pid $pid started|;
 112                 } elsif ( defined $pid ) {
 113                         # child
 114                         my $eval = $daemon . '::start(' . ( @_ ? dump(@_) : '' ) . ')';
 115                         warn "eval $eval";
 116                         eval $eval;
 117                         warn "can't start $daemon: $@" if $@;
 118                         exit;
 119                 } else {
 120                         die "fork error $!";
 121                 }
 122         }
 123 }
 124
 125 my $ok =       qq|HTTP/1.0 200 OK\r\nContent-Type: text/html\r\nConnection: close\r\n\r\n|;
 126 my $redirect = qq|HTTP/1.1 302 Found\r\nContent-type: text/html\r\nLocation: $url\r\n\r\n|;
 127
 128 sub get_request {
 129         my ( $client, $path, $param ) = @_;
 130
 131         warn "get_request $client $path ",dump( $param );
 132
 133         if ( my $found = static( $client,$path ) ) {
 134                 warn "static $found" if $debug;
 135         } elsif ( $path eq '/' ) {
 136
 137                 my $screen = $pids->{screen} ? qq|stop <tt>$pids->{screen}</tt>|        : 'start';
 138                 my $kvm    = $pids->{kvm}    ? qq|stop <tt>$pids->{kvm}</tt>|           :
 139                                          $pids->{screen} ? qq|start|                                                    : qq|start screen first|;
 140
 141                 my @rows = (
 142                         'ip',           html::tt( $server::ip ),
 143                         'netmask',      html::tt( $server::netmask ),
 144
 145                         'debug',        qq|<a href=/our/debug/| . boolean::toggle($debug) . qq|>$debug</a>|,
 146                 );
 147
 148                 my $debug_proc;
 149
 150                 warn 'pids: ', dump( $pids );
 151                 foreach my $name ( keys %$pids ) {
 152                         my $pid = $pids->{$name} || next;
 153
 154                         my $html = qq|<a href=/$name>$pid</a>|;
 155
 156                         if ( $debug ) {
 157                                 $html .= qq| <a name=$pid href=#proc-$pid>?</a>|;
 158
 159                                 my $proc = "/proc/$pid/status";
 160                                 $debug_proc
 161                                         .= qq|<a name=proc-$pid href=#$pid>$proc</a><pre style="font-size: 10%">|
 162                                         .  read_file($proc)
 163                                         .  qq|</pre>|
 164                                         if -e $proc;
 165                         }
 166
 167                         push @rows, ( $name => $html );
 168                 }
 169
 170                 warn 'static_pids: ', dump( $static_pids );
 171                 foreach my $pid ( keys %$static_pids ) {
 172                         my $path = $static_pids->{$pid};
 173                         if ( -d "/proc/$pid" ) {
 174                                 push @rows, ( $path => qq|<a href=/kill/static/$pid>$pid</a>| );
 175                         } else {
 176                                 push @rows, ( $path => "$pid competed" );
 177                         }
 178                 }
 179
 180                 print $client $ok
 181                         , html::table( 2, @rows )
 182                         , html::tabs( log::mac_changes )
 183                         , $debug_proc
 184                         ;
 185
 186         } elsif ( $path =~ m{^/our/(\w+)/(\S+)} ) {
 187                 eval 'our $' . $1 . ' = ' . $2;
 188                 warn $@ if $@;
 189                 print $client $redirect, qq|<big>$1 = $2</big><br>Location: <a href="$url">$url</a>|;
 190                 server::debug( $debug ) if $1 eq 'debug';
 191         } elsif ( $path =~ m{^/(screen|kvm)} ) {
 192                 print $client $redirect, start_stop($1);
 193         } elsif ( $path =~ m{^/kill/static/(\d+)} ) {
 194                 print $client $redirect;
 195                 kill 9, $1 && warn "killed $1";
 196         } elsif ( $path eq '/exit' ) {
 197 #               DESTROY;
 198                 exit 0;
 199         } elsif ( $path =~ m{/boot} ) {
 200                 print $client qq{$ok
 201 #!gpxe
 202 imgfree
 203 login
 204 chain http://$server::ip:$httpd::port/
 205
 206                         };
 207         } else {
 208                 print $client "HTTP/1.0 404 $path\r\nConnection: close\r\nContent-type: text/html\r\n\r\n<big>404 $path</big>";
 209                 warn "404 $path";
 210         }
 211
 212 }
 213
 214 use browser;
 215
 216 sub start {
 217
 218         my $server = IO::Socket::INET->new(
 219                         Proto     => 'tcp',
 220                         LocalPort => $httpd::port,
 221                         Listen    => SOMAXCONN,
 222                         Reuse     => 1
 223         ) || die "can't start server on $url: $!";
 224
 225         print "url $url\n";
 226
 227         start_stop 'browser', $url;
 228         start_stop 'screen';
 229         start_stop 'kvm';
 230
 231         while (my $client = $server->accept()) {
 232                 $client->autoflush(1);
 233                 my $request = <$client>;
 234
 235                 warn "request $request\n" if $debug;
 236
 237                 Module::Refresh->refresh;
 238
 239                 if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
 240                         my $path = $1;
 241                         my $param;
 242                         if ( $path =~ s{\?(.+)}{} ) {
 243                                 foreach my $p ( split(/[&;]/, $1) ) {
 244                                         my ($n,$v) = split(/=/, $p, 2);
 245                                         $param->{$n} = $v;
 246                                 }
 247                                 warn "param: ",dump( $param ) if $debug;
 248                         }
 249                         warn "path $path param: ",dump( $param );
 250                         get_request $client, $path, $param;
 251                 } else {
 252                         print $client "HTTP/1.0 500 No method\r\nConnection: close\r\nContent-type: text/plain\r\n\r\n500 $request";
 253                         warn "500 $request";
 254                 }
 255
 256                 print $client qq{
 257                 <div style="font-size: 80%; color: #888">
 258                 <a href="">reload</a>
 259                 <a href=/>index</a>
 260                 <a href=/exit>exit</a>
 261                 </div>
 262                 } if $client->connected;
 263
 264         }
 265
 266         die "server died";
 267 }
 268
 269 warn "loaded";
 270
 271 1;