/[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 346 - (hide annotations)
Sat Aug 29 16:51:07 2009 UTC (14 years, 7 months ago) by dpavlin
File size: 10608 byte(s)
make selected configuration options for clients editable
or returned in table format

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 188
243 dpavlin 346 my @editable = ( qw/hostname deploy homepage/ );
244    
245     client::conf( $ip, $_ => $param->{$_} ) foreach @editable;
246    
247     my $conf = client::all_conf( $ip );
248     my $deploy = delete $conf->{deploy};
249    
250 dpavlin 343 my $nmap = qq|<a href=/nmap?scan=$ip>nmap</a>|;
251 dpavlin 188 my @table = (
252 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>|,
253 dpavlin 346 'mac' => format::mac( delete $conf->{mac}, 'html' ),
254     'hostname' => qq|<input type=text name=hostname value="| . delete($conf->{hostname}) . qq|">|,
255     'ping' => ping::host($ip) ? qq|<span style="color:green">up</span> $nmap| : qq|<span style="color: red">down</span> <a href=/wol/$ip>wol</a> $nmap|,
256     'deploy' => html::select( 'deploy', $deploy, config::available ),
257     html::conf( $ip, $conf, 'edit', @editable )
258 dpavlin 188 );
259    
260 dpavlin 346 warn "XX conf ",dump( $conf );
261 dpavlin 188
262 dpavlin 346 my $config = '';
263    
264     if ( $deploy ) {
265 dpavlin 335 if ( $config = config::for_ip( $ip ) ) {
266     $config = qq|<h2>config</h2>| . html::pre( $config );
267 dpavlin 309 }
268 dpavlin 188 }
269    
270 dpavlin 199 print $client ok
271 dpavlin 162 , qq|<form method=get>|
272 dpavlin 188 , html::table( 2, @table ),
273 dpavlin 326 , qq|
274     <input type=submit name=action value=change>
275     <input type=submit name=action value=remove style="color: red">
276     </form>|
277 dpavlin 335 , $config
278 dpavlin 162 ;
279 dpavlin 181
280     if ( my $amt = client::conf( $ip, 'amt' ) ) {
281 dpavlin 262 print $client qq|<h2>AMT</h2>|, amt::info( $amt, $ip );
282 dpavlin 181 }
283 dpavlin 329
284 dpavlin 162 } else {
285 dpavlin 190
286 dpavlin 334 my @ping;
287     if ( my $host = $param->{ping_target} ) {
288     @ping = ( $host );
289     } elsif ( $param->{ping} ) {
290     @ping = client::all_ips;
291     }
292    
293     my $ping = ping::fping( @ping ) if @ping;
294 dpavlin 330 my $arp = client::arp_mac_dev;
295 dpavlin 190
296 dpavlin 199 print $client ok
297 dpavlin 162 , qq|<h2>Clients on $server::ip</h2>|
298 dpavlin 343 , html::table( -5,
299     'ip', 'mac', 'dev', 'hostname', 'conf',
300 dpavlin 162 map {
301     my $ip = $_;
302 dpavlin 309 my $conf = client::all_conf( $ip );
303     my $mac = delete $conf->{mac} || '';
304 dpavlin 330 my $style;
305     $style
306     = 'style="color:'
307     . ( $ping->{$ip} ? 'green' : 'red' )
308     . '"'
309     if $ping;
310 dpavlin 334 $style ||= '';
311 dpavlin 190 (
312 dpavlin 330 qq|<a $style name=$ip href=/client/$ip>$ip</a>|
313 dpavlin 303 , format::mac( $mac => 'html' )
314 dpavlin 327 , $arp->{$mac}
315 dpavlin 309 , delete $conf->{hostname}
316 dpavlin 346 , html::conf( $ip, $conf, 'inline' )
317     )
318 dpavlin 334 } client::all_ips
319 dpavlin 162 )
320     ;
321 dpavlin 330 print $client qq|
322     <form method=get>
323 dpavlin 334 <input type=text name=ping_target size=15>
324 dpavlin 330 <input type=submit name=ping value=ping>
325     </form>
326     |;
327 dpavlin 162 }
328 dpavlin 229 } elsif ( $path =~ m{^/brctl} ) {
329 dpavlin 333 print $client ok, html::table( -4,
330     map {
331     my @c = split(/\t+/,$_,4);
332     if ( $#c == 1 ) {
333     ( '', '', '', $c[1] )
334     } else {
335     @c
336     }
337     } split(/\n/, `brctl show`)
338     );
339 dpavlin 224 } elsif ( $path =~ m{^/ip/?(\w+)?} ) {
340     print $client ok
341     , join("\n", map { qq|<a href=/ip/$_>$_</a>| } ( qw/link addr route neigh ntable tunnel maddr mroute xfrm/ ))
342     , ip::html( $1 )
343     ;
344 dpavlin 311 } elsif ( $path =~ m{^/nmap} ) {
345     if ( my $scan = $param->{scan} ) {
346     nmap::scan( $scan );
347     print $client redirect("$url/client#$scan");
348     } else {
349     print $client ok, qq|
350     <form method=get>
351     <input type=text name=scan>
352     <input type=submit value=scan>
353     </form>
354     |;
355     }
356 dpavlin 335 } elsif ( $path =~ m{^/wol/(\S+)} ) {
357     print $client redirect( "$url/client/$1" ), wol::power_on($1);
358 dpavlin 43 } elsif ( $path =~ m{^/our/(\w+)/(\S+)} ) {
359     eval 'our $' . $1 . ' = ' . $2;
360     warn $@ if $@;
361 dpavlin 199 print $client redirect($url), qq|<big>$1 = $2</big><br>Location: <a href="$url">$url</a>|;
362 dpavlin 67 server::debug( $debug ) if $1 eq 'debug';
363 dpavlin 158 } elsif ( $path =~ m{^/start_stop/(\S+)} ) {
364 dpavlin 199 print $client redirect, daemons::start_stop($1);
365 dpavlin 88 } elsif ( $path =~ m{^/action/([^/]+)/(.+)} ) {
366     $1->$2();
367 dpavlin 199 print $client redirect;
368 dpavlin 70 } elsif ( $path =~ m{^/kill/static/(\d+)} ) {
369 dpavlin 199 print $client redirect;
370 dpavlin 86 kill 1, $1 || kill 9, $2 && warn "killed $1";
371 dpavlin 43 } else {
372     print $client "HTTP/1.0 404 $path\r\nConnection: close\r\nContent-type: text/html\r\n\r\n<big>404 $path</big>";
373     warn "404 $path";
374     }
375    
376     }
377 dpavlin 53
378 dpavlin 42 sub start {
379    
380 dpavlin 229 warn 'network ', network::setup();
381 dpavlin 140
382 dpavlin 189 daemons::start_stop 'browser', $url;
383 dpavlin 231 daemons::start_stop $_ foreach ( qw/dhcpd tftpd dnsd syslogd/ );
384 dpavlin 189 daemons::start_stop 'kvm' unless $ENV{DEV}; # skip kvm statup when running on real device
385    
386 dpavlin 42 my $server = IO::Socket::INET->new(
387     Proto => 'tcp',
388 dpavlin 185 LocalAddr => $server::ip,
389 dpavlin 42 LocalPort => $httpd::port,
390     Listen => SOMAXCONN,
391     Reuse => 1
392 dpavlin 43 ) || die "can't start server on $url: $!";
393 dpavlin 42
394     print "url $url\n";
395    
396 dpavlin 118 while (1) {
397     my $client = $server->accept() || next; # ALARM trickle us
398 dpavlin 42 my $request = <$client>;
399    
400     warn "request $request\n" if $debug;
401    
402     if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
403 dpavlin 43 my $path = $1;
404 dpavlin 328 $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/ge;
405 dpavlin 42 my $param;
406 dpavlin 43 if ( $path =~ s{\?(.+)}{} ) {
407 dpavlin 42 foreach my $p ( split(/[&;]/, $1) ) {
408     my ($n,$v) = split(/=/, $p, 2);
409     $param->{$n} = $v;
410     }
411     warn "param: ",dump( $param ) if $debug;
412     }
413 dpavlin 43 get_request $client, $path, $param;
414 dpavlin 42 } else {
415     print $client "HTTP/1.0 500 No method\r\nConnection: close\r\nContent-type: text/plain\r\n\r\n500 $request";
416     warn "500 $request";
417     }
418    
419 dpavlin 149 print $client menu() if $client->connected;
420 dpavlin 42
421     }
422    
423     die "server died";
424     }
425    
426 dpavlin 45 warn "loaded";
427    
428 dpavlin 42 1;

  ViewVC Help
Powered by ViewVC 1.1.26