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

  ViewVC Help
Powered by ViewVC 1.1.26