/[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

Annotation of /lib/PXElator/httpd.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 dpavlin 42 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