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