/[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 53 - (hide annotations)
Thu Jul 30 12:10:53 2009 UTC (14 years, 8 months ago) by dpavlin
File size: 3654 byte(s)
start/stop screen with servers from web interface

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

  ViewVC Help
Powered by ViewVC 1.1.26