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 $port = 7777;
  23 our $debug = 1;
  24
  25 use server;
  26 our $url = "http://$server::ip:$port/";
  27
  28 use html;
  29
  30 sub static {
  31         my ($client,$path) = @_;
  32
  33         $path = "tftp/$path";
  34
  35         if ( ! -e $path ||  -d $path ) {
  36                 print $client "HTTP/1.0 404 $path not found\r\n";
  37                 return;
  38         }
  39
  40         my $type = 'text/plain';
  41         $type = 'text/html' if $path =~ m{\.htm};
  42         $type = 'application/javascript' if $path =~ m{\.js};
  43
  44         print $client "HTTP/1.0 200 OK\r\nContent-Type: $type\r\nContent-Length: ", -s $path,"\r\n\r\n";
  45         open(my $html, $path);
  46         while(<$html>) {
  47                 print $client $_;
  48         }
  49         close($html);
  50
  51         return $path;
  52 }
  53
  54 my $ok = "HTTP/1.0 200 OK\r\nContent-Type: text/html\r\nConnection: close\r\n\r\n";
  55
  56 use boolean;
  57
  58 sub get_request {
  59         my ( $client, $path, $param ) = @_;
  60
  61         warn "get_request $client $path $param";
  62
  63         if ( my $found = static( $client,$path ) ) {
  64                 warn "static $found" if $debug;
  65         } elsif ( $path eq '/' ) {
  66                 print $client $ok,
  67                 html::table( 2,
  68                         'pid',   $$,
  69                         'debug', qq|<a href=/our/debug/| . boolean::toggle($debug) . qq|>$debug</a>|,
  70                 );
  71
  72         } elsif ( $path =~ m{^/our/(\w+)/(\S+)} ) {
  73                 eval 'our $' . $1 . ' = ' . $2;
  74                 warn $@ if $@;
  75                 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>|;
  76         } elsif ( $path =~ m{/boot} ) {
  77                 print $client qq{$ok
  78 #!gpxe
  79 imgfree
  80 login
  81 chain http://$server::ip:$httpd::port/
  82
  83                         };
  84         } else {
  85                 print $client "HTTP/1.0 404 $path\r\nConnection: close\r\nContent-type: text/html\r\n\r\n<big>404 $path</big>";
  86                 warn "404 $path";
  87         }
  88
  89 }
  90 sub start {
  91
  92         my $server = IO::Socket::INET->new(
  93                         Proto     => 'tcp',
  94                         LocalPort => $httpd::port,
  95                         Listen    => SOMAXCONN,
  96                         Reuse     => 1
  97         ) || die "can't start server on $url: $!";
  98
  99         print "url $url\n";
 100
 101         system "/mnt/llin/rest/cvs/uzbl/uzbl -u $url &";
 102
 103         while (my $client = $server->accept()) {
 104                 $client->autoflush(1);
 105                 my $request = <$client>;
 106
 107                 warn "request $request\n" if $debug;
 108
 109                 Module::Refresh->refresh;
 110
 111                 if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
 112                         my $path = $1;
 113                         my $param;
 114                         if ( $path =~ s{\?(.+)}{} ) {
 115                                 foreach my $p ( split(/[&;]/, $1) ) {
 116                                         my ($n,$v) = split(/=/, $p, 2);
 117                                         $param->{$n} = $v;
 118                                 }
 119                                 warn "param: ",dump( $param ) if $debug;
 120                         }
 121                         warn "path $path param: ",dump( $param );
 122                         get_request $client, $path, $param;
 123                 } else {
 124                         print $client "HTTP/1.0 500 No method\r\nConnection: close\r\nContent-type: text/plain\r\n\r\n500 $request";
 125                         warn "500 $request";
 126                 }
 127
 128                 print $client qq{
 129                 <div style="font-size: 80%; color: #888">
 130                 <a href="">reload</a>
 131                 <a href="/">index</a>
 132                 </div>
 133                 } if $client->connected;
 134
 135         }
 136
 137         die "server died";
 138 }
 139
 140 warn "loaded";
 141
 142 1;