ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/eg/myhttpd
(Generate patch)

Comparing Coro/eg/myhttpd (file contents):
Revision 1.2 by root, Sat Aug 11 19:59:19 2001 UTC vs.
Revision 1.11 by root, Wed Apr 11 03:05:15 2007 UTC

1#!/usr/bin/perl 1#!/usr/bin/perl
2 2
3# this is a relatively small web-server, using coroutines 3# this is a relatively small web-server, using coroutines for connections.
4# for connections. play around with it but do not use 4# play around with it but do not use it in production without checking it
5# it in production. ask myhttpd@plan9.de for a better 5# works for you. ask myhttpd@plan9.de in case of problems, or if you are
6# version that's more usable and bugfixed. 6# interested in a newer version (more useless features).
7 7
8use Coro; 8use Coro;
9use Coro::Semaphore; 9use Coro::Semaphore;
10use Coro::Event; 10use Coro::Event;
11use Coro::Socket; 11use Coro::Socket;
… …
42} 42}
43 43
44my $connections = new Coro::Semaphore $MAX_CONNECTS; 44my $connections = new Coro::Semaphore $MAX_CONNECTS;
45 45
46my @fh; 46my @fh;
47my @pool;
48 47
49sub handler { 48# move the event main loop into a coroutine
49async { loop };
50
51slog 1, "accepting connections";
50 while () { 52while () {
51 my $fh = pop @fh; 53 $connections->down;
52 if ($fh) { 54 if (my $fh = $port->accept) {
55 #slog 3, "accepted @$connections ".scalar(@pool);
56 async_pool {
53 eval { 57 eval {
54 conn->new($fh)->handle; 58 conn->new($fh)->handle;
55 }; 59 };
56 close $fh; 60 close $fh;
57 slog 1, "$@" if $@ && !ref $@; 61 slog 1, "$@" if $@ && !ref $@;
58 $connections->up; 62 $connections->up;
59 } else {
60 last if @pool >= $MAX_POOL;
61 push @pool, $Coro::current;
62 schedule;
63 } 63 };
64 } 64 }
65} 65}
66
67async {
68 slog 1, "accepting connections";
69 while () {
70 $connections->down;
71 push @fh, $port->accept;
72 #slog 3, "accepted @$connections ".scalar(@pool);
73 if (@pool) {
74 (pop @pool)->ready;
75 } else {
76 async \&handler;
77 }
78
79 }
80};
81
82loop;
83print "ende\n";#d#
84 66
85package conn; 67package conn;
86 68
87use Socket; 69use Socket;
88use HTTP::Date; 70use HTTP::Date;
89 71
90sub new { 72sub new {
91 my $class = shift; 73 my $class = shift;
92 my $fh = shift; 74 my $fh = shift;
93 my (undef, $iaddr) = unpack_sockaddr_in $fh->getpeername 75 my (undef, $iaddr) = unpack_sockaddr_in $fh->peername
94 or $self->err(500, "unable to get peername"); 76 or $self->err(500, "unable to get peername");
95 $self->{remote_address} = inet_ntoa $iaddr; 77 $self->{remote_address} = inet_ntoa $iaddr;
96 bless { fh => $fh }, $class; 78 bless { fh => $fh }, $class;
97} 79}
98 80
… …
151 ([^\040]+) \040+ 133 ([^\040]+) \040+
152 HTTP\/([0-9]+\.[0-9]+) 134 HTTP\/([0-9]+\.[0-9]+)
153 \015\012/gx 135 \015\012/gx
154 or $self->err(403, "method not allowed", { Allow => "GET,HEAD" }); 136 or $self->err(403, "method not allowed", { Allow => "GET,HEAD" });
155 137
156 $2 ne "1.0" 138 $2 < 2
157 or $self->err(506, "http protocol version not supported"); 139 or $self->err(506, "http protocol version not supported");
158 140
159 $self->{method} = $1; 141 $self->{method} = $1;
160 $self->{uri} = $2; 142 $self->{uri} = $2;
161 143
… …
164 my (%hdr, $h, $v); 146 my (%hdr, $h, $v);
165 147
166 $hdr{lc $1} .= ",$2" 148 $hdr{lc $1} .= ",$2"
167 while $req =~ /\G 149 while $req =~ /\G
168 ([^:\000-\040]+): 150 ([^:\000-\040]+):
169 [\008\040]* 151 [\011\040]*
170 ((?: [^\015\012]+ | \015\012[\008\040] )*) 152 ((?: [^\015\012]+ | \015\012[\011\040] )*)
171 \015\012 153 \015\012
172 /gxc; 154 /gxc;
173 155
174 $req =~ /\G\015\012$/ 156 $req =~ /\G\015\012$/
175 or $self->err(400, "bad request"); 157 or $self->err(400, "bad request");
… …
206 $self->{path} = "$::DOCROOT/$host$uri"; 188 $self->{path} = "$::DOCROOT/$host$uri";
207} 189}
208 190
209sub server_address { 191sub server_address {
210 my $self = shift; 192 my $self = shift;
211 my ($port, $iaddr) = unpack_sockaddr_in $self->{fh}->getsockname 193 my ($port, $iaddr) = unpack_sockaddr_in $self->{fh}->sockname
212 or $self->err(500, "unable to get socket name"); 194 or $self->err(500, "unable to get socket name");
213 ((inet_ntoa $iaddr), $port); 195 ((inet_ntoa $iaddr), $port);
214} 196}
215 197
216sub server_host { 198sub server_host {
… …
317 ($l, $h) = ($1, ($2 ne "" || $2 >= $length) ? $2 : $length - 1); 299 ($l, $h) = ($1, ($2 ne "" || $2 >= $length) ? $2 : $length - 1);
318 } else { 300 } else {
319 ($l, $h) = (0, $length - 1); 301 ($l, $h) = (0, $length - 1);
320 goto ignore; 302 goto ignore;
321 } 303 }
322 goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h > $l; 304 goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h >= $l;
323 } 305 }
324 $hdr->{"Content-Range"} = "bytes */$length"; 306 $hdr->{"Content-Range"} = "bytes */$length";
325 $self->err(416, "not satisfiable", $hdr); 307 $self->err(416, "not satisfiable", $hdr);
326 308
327satisfiable: 309satisfiable:
… …
363 } 345 }
364 } 346 }
365 347
366 close $fh; 348 close $fh;
367} 349}
350

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines