/[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 43 by dpavlin, Wed Jul 29 19:57:07 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    
22  our $port = 7777;  our $port = 7777;
23  our $debug = 1;  our $debug = 1;
# Line 24  our $debug = 1; Line 25  our $debug = 1;
25  use server;  use server;
26  our $url = "http://$server::ip:$port/";  our $url = "http://$server::ip:$port/";
27    
28    use html;
29    
30  sub static {  sub static {
31          my ($client,$path) = @_;          my ($client,$path) = @_;
32    
# Line 50  sub static { Line 53  sub static {
53    
54  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";
55    
56    use boolean;
57    
58    sub get_request {
59            my ( $client, $path, $param ) = @_;
60    
61            warn "get_request $client $path $param";
62    
63            if ( my $found = static( $client,$path ) ) {
64                    warn "static $found" if $debug;
65            } elsif ( $path eq '/' ) {
66                    print $client $ok,
67                    html::table( 2,
68                            'pid',   $$,
69                            'debug', qq|<a href=/our/debug/| . boolean::toggle($debug) . qq|>$debug</a>|,
70                    );
71    
72            } elsif ( $path =~ m{^/our/(\w+)/(\S+)} ) {
73                    eval 'our $' . $1 . ' = ' . $2;
74                    warn $@ if $@;
75                    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>|;
76            } elsif ( $path =~ m{/boot} ) {
77                    print $client qq{$ok
78    #!gpxe
79    imgfree
80    login
81    chain http://$server::ip:$httpd::port/
82    
83                            };
84            } else {
85                    print $client "HTTP/1.0 404 $path\r\nConnection: close\r\nContent-type: text/html\r\n\r\n<big>404 $path</big>";
86                    warn "404 $path";
87            }
88    
89    }
90  sub start {  sub start {
91    
92          my $server = IO::Socket::INET->new(          my $server = IO::Socket::INET->new(
# Line 58  sub start { Line 94  sub start {
94                          LocalPort => $httpd::port,                          LocalPort => $httpd::port,
95                          Listen    => SOMAXCONN,                          Listen    => SOMAXCONN,
96                          Reuse     => 1                          Reuse     => 1
97          );          ) || die "can't start server on $url: $!";
                                                                             
         die "can't setup server" unless $server;  
98    
99          print "url $url\n";          print "url $url\n";
100    
# Line 72  sub start { Line 106  sub start {
106    
107                  warn "request $request\n" if $debug;                  warn "request $request\n" if $debug;
108    
109                    Module::Refresh->refresh;
110    
111                  if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {                  if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
112                          my $method = $1;                          my $path = $1;
113                          my $param;                          my $param;
114                          if ( $method =~ s{\?(.+)}{} ) {                          if ( $path =~ s{\?(.+)}{} ) {
115                                  foreach my $p ( split(/[&;]/, $1) ) {                                  foreach my $p ( split(/[&;]/, $1) ) {
116                                          my ($n,$v) = split(/=/, $p, 2);                                          my ($n,$v) = split(/=/, $p, 2);
117                                          $param->{$n} = $v;                                          $param->{$n} = $v;
118                                  }                                  }
119                                  warn "param: ",dump( $param ) if $debug;                                  warn "param: ",dump( $param ) if $debug;
120                          }                          }
121                          warn "method $method";                          warn "path $path param: ",dump( $param );
122                            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";  
                         }  
123                  } else {                  } else {
124                          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";
125                          warn "500 $request";                          warn "500 $request";
126                  }                  }
127    
128                  print $client qq{                  print $client qq{
129                  <a href="">reload</a>                    <div style="font-size: 80%; color: #888">
130                  };                  <a href="">reload</a>
131                    <a href="/">index</a>
132                    </div>
133                    } if $client->connected;
134    
                 close($client);  
135          }          }
136    
137          die "server died";          die "server died";

Legend:
Removed from v.42  
changed lines
  Added in v.43

  ViewVC Help
Powered by ViewVC 1.1.26