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

Comparing Coro/eg/myhttpd (file contents):
Revision 1.3 by root, Fri Sep 14 15:40:56 2001 UTC vs.
Revision 1.9 by root, Wed Apr 11 02:49:39 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;
… …
62 schedule; 62 schedule;
63 } 63 }
64 } 64 }
65} 65}
66 66
67async { 67async { loop };
68
68 slog 1, "accepting connections"; 69slog 1, "accepting connections";
69 while () { 70while () {
70 $connections->down; 71 $connections->down;
71 push @fh, $port->accept; 72 push @fh, $port->accept;
72 #slog 3, "accepted @$connections ".scalar(@pool); 73 #slog 3, "accepted @$connections ".scalar(@pool);
73 if (@pool) { 74 if (@pool) {
74 (pop @pool)->ready; 75 (pop @pool)->ready;
75 } else { 76 } else {
76 async \&handler; 77 async \&handler;
77 }
78
79 } 78 }
80};
81 79
82loop; 80}
83print "ende\n";#d#
84 81
85package conn; 82package conn;
86 83
87use Socket; 84use Socket;
88use HTTP::Date; 85use HTTP::Date;
… …
151 ([^\040]+) \040+ 148 ([^\040]+) \040+
152 HTTP\/([0-9]+\.[0-9]+) 149 HTTP\/([0-9]+\.[0-9]+)
153 \015\012/gx 150 \015\012/gx
154 or $self->err(403, "method not allowed", { Allow => "GET,HEAD" }); 151 or $self->err(403, "method not allowed", { Allow => "GET,HEAD" });
155 152
156 $2 ne "1.0" 153 $2 < 2
157 or $self->err(506, "http protocol version not supported"); 154 or $self->err(506, "http protocol version not supported");
158 155
159 $self->{method} = $1; 156 $self->{method} = $1;
160 $self->{uri} = $2; 157 $self->{uri} = $2;
161 158
… …
164 my (%hdr, $h, $v); 161 my (%hdr, $h, $v);
165 162
166 $hdr{lc $1} .= ",$2" 163 $hdr{lc $1} .= ",$2"
167 while $req =~ /\G 164 while $req =~ /\G
168 ([^:\000-\040]+): 165 ([^:\000-\040]+):
169 [\008\040]* 166 [\011\040]*
170 ((?: [^\015\012]+ | \015\012[\008\040] )*) 167 ((?: [^\015\012]+ | \015\012[\011\040] )*)
171 \015\012 168 \015\012
172 /gxc; 169 /gxc;
173 170
174 $req =~ /\G\015\012$/ 171 $req =~ /\G\015\012$/
175 or $self->err(400, "bad request"); 172 or $self->err(400, "bad request");
… …
317 ($l, $h) = ($1, ($2 ne "" || $2 >= $length) ? $2 : $length - 1); 314 ($l, $h) = ($1, ($2 ne "" || $2 >= $length) ? $2 : $length - 1);
318 } else { 315 } else {
319 ($l, $h) = (0, $length - 1); 316 ($l, $h) = (0, $length - 1);
320 goto ignore; 317 goto ignore;
321 } 318 }
322 goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h > $l; 319 goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h >= $l;
323 } 320 }
324 $hdr->{"Content-Range"} = "bytes */$length"; 321 $hdr->{"Content-Range"} = "bytes */$length";
325 $self->err(416, "not satisfiable", $hdr); 322 $self->err(416, "not satisfiable", $hdr);
326 323
327satisfiable: 324satisfiable:
… …
363 } 360 }
364 } 361 }
365 362
366 close $fh; 363 close $fh;
367} 364}
365

Diff Legend

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