/[pxelator]/lib/PXElator/httpd.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /lib/PXElator/httpd.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 42 - (show annotations)
Wed Jul 29 17:42:48 2009 UTC (12 years, 4 months ago) by dpavlin
File size: 2339 byte(s)
simple httpd server

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;

  ViewVC Help
Powered by ViewVC 1.1.26