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

Diff of /lib/PXElator/httpd.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 42 by dpavlin, Wed Jul 29 17:42:48 2009 UTC revision 53 by dpavlin, Thu Jul 30 12:10:53 2009 UTC
# Line 17  use Carp qw/confess/; Line 17  use Carp qw/confess/;
17  use File::Slurp;  use File::Slurp;
18  #use JSON;  #use JSON;
19  use IO::Socket::INET;  use IO::Socket::INET;
20    use Module::Refresh;
21    use Parallel::ForkManager;
22    
23  our $port = 7777;  our $port = 7777;
24  our $debug = 1;  our $debug = 1;
25    
26    my $pm = Parallel::ForkManager->new(10);
27    
28    our $screen_pid;
29    
30  use server;  use server;
31  our $url = "http://$server::ip:$port/";  our $url = "http://$server::ip:$port/";
32    
33    use html;
34    
35  sub static {  sub static {
36          my ($client,$path) = @_;          my ($client,$path) = @_;
37    
# Line 50  sub static { Line 58  sub static {
58    
59  my $ok = "HTTP/1.0 200 OK\r\nContent-Type: text/html\r\nConnection: close\r\n\r\n";  my $ok = "HTTP/1.0 200 OK\r\nContent-Type: text/html\r\nConnection: close\r\n\r\n";
60    
61    use boolean;
62    use screen;
63    
64    sub get_request {
65            my ( $client, $path, $param ) = @_;
66    
67            warn "get_request $client $path ",dump( $param );
68    
69            if ( my $found = static( $client,$path ) ) {
70                    warn "static $found" if $debug;
71            } elsif ( $path eq '/' ) {
72    
73                    my $screen = $screen_pid ? qq|stop <tt>$screen_pid</tt>| : 'start';
74    
75                    print $client $ok,
76                    html::table( 2,
77                            'pid',   $$,
78                            'debug', qq|<a href=/our/debug/| . boolean::toggle($debug) . qq|>$debug</a>|,
79                            'screen', qq|<a href=/screen>$screen</a>|,
80                    );
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            } 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            } 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    
122  sub start {  sub start {
123    
# Line 58  sub start { Line 126  sub start {
126                          LocalPort => $httpd::port,                          LocalPort => $httpd::port,
127                          Listen    => SOMAXCONN,                          Listen    => SOMAXCONN,
128                          Reuse     => 1                          Reuse     => 1
129          );          ) || die "can't start server on $url: $!";
                                                                             
         die "can't setup server" unless $server;  
130    
131          print "url $url\n";          print "url $url\n";
132    
# Line 72  sub start { Line 138  sub start {
138    
139                  warn "request $request\n" if $debug;                  warn "request $request\n" if $debug;
140    
141                    Module::Refresh->refresh;
142    
143                  if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {                  if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
144                          my $method = $1;                          my $path = $1;
145                          my $param;                          my $param;
146                          if ( $method =~ s{\?(.+)}{} ) {                          if ( $path =~ s{\?(.+)}{} ) {
147                                  foreach my $p ( split(/[&;]/, $1) ) {                                  foreach my $p ( split(/[&;]/, $1) ) {
148                                          my ($n,$v) = split(/=/, $p, 2);                                          my ($n,$v) = split(/=/, $p, 2);
149                                          $param->{$n} = $v;                                          $param->{$n} = $v;
150                                  }                                  }
151                                  warn "param: ",dump( $param ) if $debug;                                  warn "param: ",dump( $param ) if $debug;
152                          }                          }
153                          warn "method $method";                          warn "path $path param: ",dump( $param );
154                            get_request $client, $path, $param;
                         if ( my $path = static( $client,$1 ) ) {  
                                 warn "static $path" if $debug;  
                         } elsif ( $method eq '/' ) {  
                                 print $client qq{$ok  
                                         pid <tt>$$</tt>  
                                         debug $debug  
                                 };  
                                   
                         } elsif ( $method =~ m{/boot} ) {  
                                 print $client qq{$ok  
 #!gpxe  
 imgfree  
 login  
 chain http://$server::ip:$httpd::port/  
   
                                         };  
                         } else {  
                                 print $client "HTTP/1.0 404 Unkown method\r\nConnection: close\r\nContent-type: text/plain\r\n\r\n404 $request";  
                                 warn "404 $request";  
                         }  
155                  } else {                  } else {
156                          print $client "HTTP/1.0 500 No method\r\nConnection: close\r\nContent-type: text/plain\r\n\r\n500 $request";                          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";                          warn "500 $request";
158                  }                  }
159    
160                  print $client qq{                  print $client qq{
161                  <a href="">reload</a>                    <div style="font-size: 80%; color: #888">
162                  };                  <a href="">reload</a>
163                    <a href="/">index</a>
164                    </div>
165                    } if $client->connected;
166    
                 close($client);  
167          }          }
168    
169          die "server died";          die "server died";
170  }  }
171    
172    warn "loaded";
173    
174  1;  1;
Legend:
Removed from v.42  
changed lines
  Added in v.53
  ViewVC Help
Powered by ViewVC 1.1.26