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

Comparing Coro/eg/myhttpd (file contents):
Revision 1.1 by root, Thu Aug 9 02:57:54 2001 UTC vs.
Revision 1.7 by root, Mon Feb 25 03:21:09 2002 UTC

1#!/usr/bin/perl 1#!/usr/bin/perl
2
3# this is a relatively small web-server, using coroutines for connections.
4# play around with it but do not use it in production without checking it
5# works for you. ask myhttpd@plan9.de in case of problems, or if you are
6# interested in a newer version (more useless features).
2 7
3use Coro; 8use Coro;
4use Coro::Semaphore; 9use Coro::Semaphore;
5use Coro::Event; 10use Coro::Event;
6use Coro::Socket; 11use Coro::Socket;
… …
83use HTTP::Date; 88use HTTP::Date;
84 89
85sub new { 90sub new {
86 my $class = shift; 91 my $class = shift;
87 my $fh = shift; 92 my $fh = shift;
88 my (undef, $iaddr) = unpack_sockaddr_in $fh->getpeername 93 my (undef, $iaddr) = unpack_sockaddr_in $fh->peername
89 or $self->err(500, "unable to get peername"); 94 or $self->err(500, "unable to get peername");
90 $self->{remote_address} = inet_ntoa $iaddr; 95 $self->{remote_address} = inet_ntoa $iaddr;
91 bless { fh => $fh }, $class; 96 bless { fh => $fh }, $class;
92} 97}
93 98
… …
146 ([^\040]+) \040+ 151 ([^\040]+) \040+
147 HTTP\/([0-9]+\.[0-9]+) 152 HTTP\/([0-9]+\.[0-9]+)
148 \015\012/gx 153 \015\012/gx
149 or $self->err(403, "method not allowed", { Allow => "GET,HEAD" }); 154 or $self->err(403, "method not allowed", { Allow => "GET,HEAD" });
150 155
151 $2 ne "1.0" 156 $2 < 2
152 or $self->err(506, "http protocol version not supported"); 157 or $self->err(506, "http protocol version not supported");
153 158
154 $self->{method} = $1; 159 $self->{method} = $1;
155 $self->{uri} = $2; 160 $self->{uri} = $2;
156 161
… …
159 my (%hdr, $h, $v); 164 my (%hdr, $h, $v);
160 165
161 $hdr{lc $1} .= ",$2" 166 $hdr{lc $1} .= ",$2"
162 while $req =~ /\G 167 while $req =~ /\G
163 ([^:\000-\040]+): 168 ([^:\000-\040]+):
164 [\008\040]* 169 [\011\040]*
165 ((?: [^\015\012]+ | \015\012[\008\040] )*) 170 ((?: [^\015\012]+ | \015\012[\011\040] )*)
166 \015\012 171 \015\012
167 /gxc; 172 /gxc;
168 173
169 $req =~ /\G\015\012$/ 174 $req =~ /\G\015\012$/
170 or $self->err(400, "bad request"); 175 or $self->err(400, "bad request");
… …
201 $self->{path} = "$::DOCROOT/$host$uri"; 206 $self->{path} = "$::DOCROOT/$host$uri";
202} 207}
203 208
204sub server_address { 209sub server_address {
205 my $self = shift; 210 my $self = shift;
206 my ($port, $iaddr) = unpack_sockaddr_in $self->{fh}->getsockname 211 my ($port, $iaddr) = unpack_sockaddr_in $self->{fh}->sockname
207 or $self->err(500, "unable to get socket name"); 212 or $self->err(500, "unable to get socket name");
208 ((inet_ntoa $iaddr), $port); 213 ((inet_ntoa $iaddr), $port);
209} 214}
210 215
211sub server_host { 216sub server_host {
… …
227 } 232 }
228 $port = $port == 80 ? "" : ":$port"; 233 $port = $port == 80 ? "" : ":$port";
229 $host.$port; 234 $host.$port;
230} 235}
231 236
237# no, this doesn't do cgi, but it's close enough
238# for the no-longer-used directory indexing script.
232sub _cgi { 239sub _cgi {
233 my $self = shift; 240 my $self = shift;
234 my $path = shift; 241 my $path = shift;
235 my $fh; 242 my $fh;
236 243
… …
310 ($l, $h) = ($1, ($2 ne "" || $2 >= $length) ? $2 : $length - 1); 317 ($l, $h) = ($1, ($2 ne "" || $2 >= $length) ? $2 : $length - 1);
311 } else { 318 } else {
312 ($l, $h) = (0, $length - 1); 319 ($l, $h) = (0, $length - 1);
313 goto ignore; 320 goto ignore;
314 } 321 }
315 goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h > $l; 322 goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h >= $l;
316 } 323 }
317 $hdr->{"Content-Range"} = "bytes */$length"; 324 $hdr->{"Content-Range"} = "bytes */$length";
318 $self->err(416, "not satisfiable", $hdr); 325 $self->err(416, "not satisfiable", $hdr);
319 326
320satisfiable: 327satisfiable:

Diff Legend

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