/[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 385 - (show annotations)
Sun Aug 30 22:46:57 2009 UTC (14 years, 7 months ago) by dpavlin
File size: 11047 byte(s)
collect amt event logs
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 Regexp::Common qw/net/;
21
22 our $title;
23
24 sub html_start {
25 qq{
26 <html>
27 <head>
28 <title>$title</title>
29 </head>
30 <body>
31 }}
32
33 sub html_end {
34 qq{
35 </body>
36 </html>
37 }}
38
39 sub menu {
40 qq{
41 <div style="font-size: 80%; color: #888">
42 <a href=/>home</a>
43 <a href=/server>server</a>
44 <a href=/brctl>brctl</a>
45 <a href=/ip>ip</a>
46 <a href=/nmap>nmap</a>
47 <a href=/client>client</a>
48 </div>
49
50 }}
51
52 our $port = 7777;
53
54 use server;
55 our $debug = server::debug;
56 our $url = "http://$server::ip:$port";
57
58 use html;
59 our $static_pids;
60 use progress_bar;
61 use config;
62 use client;
63 use log;
64 use x11;
65 use amt;
66 use boolean;
67 use daemons;
68
69 use kvm;
70 use browser;
71 use network;
72 use ip;
73 use wireshark;
74 use syslogd;
75 use nmap;
76 use ping;
77 use wol;
78
79 use CouchDB;
80
81 sub static {
82 my ($client,$path) = @_;
83
84 my $full = "$server::base_dir/tftp/$path";
85
86 return if ! -f $full;
87
88 if ( my $pid = fork ) {
89 # parent
90 close($client);
91 $static_pids->{$pid} = $path;
92 return 1;
93 }
94
95 my $type = 'application/octet-stream';
96 $type = 'text/html' if $path =~ m{\.htm};
97 $type = 'application/javascript' if $path =~ m{\.js};
98 $type = 'text/plain' if $path =~ m{\.txt};
99
100 my $size = -s $full || return;
101
102 print $client "HTTP/1.0 200 OK\r\nContent-Type: $type\r\nContent-Length: $size\r\nConnection: close\r\n\r\n";
103
104 open(my $fh, $full);
105
106 my $block = 1400; # try not to fragment packages (pxelinux seems to have problems with it)
107 my $buff;
108 my $pos = 0;
109
110 CouchDB::audit( 'static', { pid => $$, path => $path, type => $type, size => $size, block => $block, peerhost => $client->peerhost });
111
112 progress_bar::start;
113
114 while( my $len = read $fh, $buff, $block ) {
115 print $client $buff;
116 $client->flush;
117 $pos += $len;
118 progress_bar::tick( $path, $pos, $size );
119 }
120 close($fh);
121 close($client);
122
123 print STDERR "\n";
124
125 exit(0);
126 }
127
128 sub ok {
129 qq|HTTP/1.0 200 OK\r\nContent-Type: text/html\r\nConnection: close\r\n\r\n| . html_start() . menu()
130 }
131
132 sub redirect {
133 my $to = shift;
134 $to ||= $url;
135 qq|HTTP/1.1 302 Found\r\nContent-type: text/html\r\nLocation: $to\r\n\r\n|
136 }
137
138 sub get_request {
139 my ( $client, $path, $param ) = @_;
140
141 server->refresh;
142
143 CouchDB::audit( 'request', { path => $path, param => $param, peerhost => $client->peerhost } );
144
145 $title = $path;
146
147 if ( my $found = static( $client,$path ) ) {
148 warn "static $found" if $debug;
149 } elsif ( $path eq '/' ) {
150
151 my @rows;
152
153 my $debug_proc = '';
154
155 warn "XXX pids = ", dump( $daemons::pids );
156
157 foreach my $name ( sort keys %$daemons::pids ) {
158 my $pid = $daemons::pids->{$name}; # || next;
159
160 my $html;
161
162 my $proc = "/proc/$pid/status";
163
164 if ( -e $proc ) {
165 $html .= qq|<a href=/start_stop/$name>$pid</a>|;
166 if ( $debug ) {
167 $html .= qq| <a name=$pid href=#proc-$pid>?</a>| if $name->can('start');
168
169 $debug_proc
170 .= qq|<a name=proc-$pid href=#$pid>$proc</a><pre style="font-size: 10%">|
171 . read_file($proc)
172 . qq|</pre>|
173 ;
174 }
175
176 if ( $name->can('fork_if_active') ) {
177 $html .= qq| <a href=/start_stop/$name/$_>$_</a>| foreach $name->fork_if_active;
178 }
179
180 if ( $name->can('actions') ) {
181 $html .= qq| <a href=/action/$name/$_>$_</a>| foreach $name->actions;
182 }
183 } else {
184 if ( $pid =~ m{^\d+$} ) {
185 $html .= qq|$pid exited |
186 } else {
187 $html .= qq|$pid |;
188 }
189 $html .= qq|<a href=/start_stop/$name>restart</a>| if $pid || $name->can('start');
190 if ( $name->can('fork_actions') ) {
191 $html .= qq| <a href=/start_stop/$name/$_>$_</a>| foreach $name->fork_actions;
192 }
193 }
194
195 die "no html generated" unless $html;
196
197 push @rows, ( $name => $html );
198 }
199
200 my $below_table = '';
201
202 warn 'static_pids: ', dump( $static_pids ) if $debug;
203 foreach my $pid ( keys %$static_pids ) {
204 my $path = $static_pids->{$pid};
205 if ( -d "/proc/$pid" ) {
206 push @rows, ( $path => qq|<a href=/kill/static/$pid>$pid</a>| );
207 } elsif ( $param->{clean_completed_downloads} ) {
208 delete $static_pids->{$pid}
209 } else {
210 push @rows, ( $path => "$pid competed" );
211 $below_table = qq|<a href="/?clean_completed_downloads=1">clean completed downloads</a>|;
212 }
213 }
214
215 print $client ok
216 , html::table( 2, @rows )
217 , $below_table
218 , html::tabs( log::mac_changes )
219 , $debug_proc
220 ;
221
222 } elsif ( $path =~ m{^/server} ) {
223 print $client ok
224 , html::table( 2,
225 'debug' => qq|<a href=/our/debug/| . boolean::toggle($debug) . qq|>$debug</a>|,
226 map {
227 ( $_, html::tt eval '$server::'.$_ )
228 } ( 'ip', 'netmask', 'ip_from', 'ip_to', 'domain_name', 'base_dir', 'conf' )
229 )
230 ;
231 } elsif ( $path =~ m!^/client(?:/$RE{net}{IPv4}{-keep})?! ) {
232 my $ip = $1;
233 $title = $ip;
234
235 if ( $param->{action} eq 'remove' ) {
236 client::remove( $param->{change_ip} );
237 print $client redirect("$url/client");
238 return;
239 } elsif ( $param->{action} eq 'change' ) {
240 if ( my $new_ip = client::change_ip( $ip, $param->{change_ip} ) ) {
241 print $client redirect("$url/client#$new_ip");
242 return;
243 }
244 }
245
246 if ( ! $ip ) {
247 my $peer_ip = $client->peerhost;
248
249 my $netmask = ip::to_int $server::netmask;
250 my $network = ip::to_int($server::ip) & $netmask;
251 my $from_int = $network | $server::ip_from;
252 my $to_int = $network | $server::ip_to;
253 my $ip_int = ip::to_int $peer_ip;
254
255 # show edit for clients in our dhcp range
256 if ( $ip_int >= $from_int && $ip_int <= $to_int ) {
257 $ip = $peer_ip;
258 }
259 }
260
261 if ( $ip && $ip ne $server::ip ) {
262
263 my @editable = ( qw/hostname config homepage/ );
264
265 client::conf( $ip, $_ => $param->{$_} ) foreach @editable;
266
267 my $conf = client::all_conf( $ip );
268 my $config = delete $conf->{config};
269
270 my $nmap = qq|<a href=/nmap?scan=$ip>nmap</a>|;
271 my @table = (
272 'ping' => ping::host($ip)
273 ? qq|<span style="color:green">up</span> $nmap|
274 : qq|<span style="color: red">down</span> <a href=/wol/$ip>wol</a> $nmap|
275 ,
276 'ip' => qq|<input type=text name=change_ip value="$ip" onChange="document.getElementById('old_ip').style.display = '';"><span id=old_ip style="display: none; color: #888;">old: $ip<span>|,
277 'mac' => format::mac( delete $conf->{mac}, 'html' ),
278 'hostname' => qq|<input type=text name=hostname value="| . delete($conf->{hostname}) . qq|">|,
279 'config' => html::select( 'config', $config, config::available ),
280 html::conf( $ip, $conf, 'edit', @editable )
281 );
282
283 print $client ok
284 , qq|<form method=get>|
285 , html::table( 2, @table ),
286 , qq|
287 <input type=submit name=action value=change>
288 <input type=submit name=action value=remove style="color: red">
289 </form>|
290 ;
291
292 if ( $config ) {
293 if ( my $for_ip = config::for_ip( $ip ) ) {
294 print $client qq|<h2>config::for_ip</h2>| . html::pre( $for_ip );
295 }
296 }
297
298 if ( $conf->{amt} ) {
299 print $client qq|<h2>amt network</h2>|, html::pre_dump( amt::network( $ip ) );
300 print $client qq|<h2>amt log</h2>|, html::pre_dump( amt::log( $ip ) );
301 }
302
303 } else {
304
305 my @ping;
306 if ( my $host = $param->{ping_target} ) {
307 @ping = ( $host );
308 } elsif ( $param->{ping} ) {
309 @ping = client::all_ips;
310 }
311
312 my $ping = ping::fping( @ping ) if @ping;
313 my $arp = client::arp_mac_dev;
314
315 print $client ok
316 , qq|<h2>Clients on $server::ip</h2>|
317 , html::table( -5,
318 'ip', 'mac', 'dev', 'hostname', 'conf',
319 map {
320 my $ip = $_;
321 my $conf = client::all_conf( $ip );
322 my $mac = delete $conf->{mac} || '';
323 my $style;
324 $style
325 = 'style="color:'
326 . ( $ping->{$ip} ? 'green' : 'red' )
327 . '"'
328 if $ping;
329 $style ||= '';
330 (
331 qq|<a $style name=$ip target=$ip href=/client/$ip>$ip</a>|
332 , format::mac( $mac => 'html' )
333 , $arp->{$mac}
334 , delete $conf->{hostname}
335 , html::conf( $ip, $conf, 'inline' )
336 )
337 } client::all_ips
338 )
339 ;
340 print $client qq|
341 <form method=get>
342 <input type=text name=ping_target size=15>
343 <input type=submit name=ping value=ping>
344 </form>
345 |;
346 }
347 } elsif ( $path =~ m{^/brctl} ) {
348 print $client ok, html::table( -4,
349 map {
350 my @c = split(/\t+/,$_,4);
351 if ( $#c == 1 ) {
352 ( '', '', '', $c[1] )
353 } else {
354 @c
355 }
356 } split(/\n/, `brctl show`)
357 );
358 } elsif ( $path =~ m{^/ip/?(\w+)?} ) {
359 print $client ok
360 , join("\n", map { qq|<a href=/ip/$_>$_</a>| } ( qw/link addr route neigh ntable tunnel maddr mroute xfrm/ ))
361 , ip::html( $1 )
362 ;
363 } elsif ( $path =~ m{^/nmap} ) {
364 if ( my $scan = $param->{scan} ) {
365 nmap::scan( $scan );
366 print $client redirect("$url/client#$scan");
367 } else {
368 print $client ok, qq|
369 <form method=get>
370 <input type=text name=scan>
371 <input type=submit value=scan>
372 </form>
373 |;
374 }
375 } elsif ( $path =~ m{^/wol/(\S+)} ) {
376 print $client redirect( "$url/client/$1" ), wol::power_on($1);
377 } elsif ( $path =~ m!^/amt/(\w+)/$RE{net}{IPv4}{-keep}! ) {
378 my ( $run, $ip ) = ( $1, $2 );
379 print $client redirect( "$url/client/$ip" ), amt::RemoteControl( $ip, $run );
380 } elsif ( $path =~ m{^/our/(\w+)/(\S+)} ) {
381 eval 'our $' . $1 . ' = ' . $2;
382 warn $@ if $@;
383 print $client redirect($url), qq|<big>$1 = $2</big><br>Location: <a href="$url">$url</a>|;
384 server::debug( $debug ) if $1 eq 'debug';
385 } elsif ( $path =~ m{^/start_stop/(\S+)} ) {
386 print $client redirect, daemons::start_stop($1);
387 } elsif ( $path =~ m{^/action/([^/]+)/(.+)} ) {
388 $1->$2();
389 print $client redirect;
390 } elsif ( $path =~ m{^/kill/static/(\d+)} ) {
391 print $client redirect;
392 kill 1, $1 || kill 9, $2 && warn "killed $1";
393 } else {
394 print $client "HTTP/1.0 404 $path\r\nConnection: close\r\nContent-type: text/html\r\n\r\n<big>404 $path</big>";
395 warn "404 $path";
396 }
397
398 }
399
400 sub start {
401
402 warn 'network ', network::setup();
403
404 daemons::start_stop 'browser', $url;
405 daemons::start_stop $_ foreach ( qw/dhcpd tftpd dnsd syslogd/ );
406 daemons::start_stop 'kvm' unless $ENV{DEV}; # skip kvm statup when running on real device
407
408 my $server = IO::Socket::INET->new(
409 Proto => 'tcp',
410 LocalAddr => $server::ip,
411 LocalPort => $httpd::port,
412 Listen => SOMAXCONN,
413 Reuse => 1
414 ) || die "can't start server on $url: $!";
415
416 print "url $url\n";
417
418 syslogd::install_local;
419
420 while (1) {
421 my $client = $server->accept() || next; # ALARM trickle us
422 my $request = <$client>;
423
424 warn "request $request\n" if $debug;
425
426 if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
427 my $path = $1;
428 $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/ge;
429 my $param;
430 if ( $path =~ s{\?(.+)}{} ) {
431 foreach my $p ( split(/[&;]/, $1) ) {
432 my ($n,$v) = split(/=/, $p, 2);
433 $param->{$n} = $v;
434 }
435 warn "param: ",dump( $param ) if $debug;
436 }
437 get_request $client, $path, $param;
438 } else {
439 print $client "HTTP/1.0 500 No method\r\nConnection: close\r\nContent-type: text/plain\r\n\r\n500 $request";
440 warn "500 $request";
441 }
442
443 print $client menu() . html_end() if $client->connected;
444
445 }
446
447 die "server died";
448 }
449
450 warn "loaded";
451
452 1;

  ViewVC Help
Powered by ViewVC 1.1.26