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.8 by root, Wed Apr 11 02:48:20 2007 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;
… …
72 } 77 }
73 78
74 } 79 }
75}; 80};
76 81
82cede;
77loop; 83loop;
78print "ende\n";#d# 84print "ende\n";#d#
79 85
80package conn; 86package conn;
81 87
… …
83use HTTP::Date; 89use HTTP::Date;
84 90
85sub new { 91sub new {
86 my $class = shift; 92 my $class = shift;
87 my $fh = shift; 93 my $fh = shift;
88 my (undef, $iaddr) = unpack_sockaddr_in $fh->getpeername 94 my (undef, $iaddr) = unpack_sockaddr_in $fh->peername
89 or $self->err(500, "unable to get peername"); 95 or $self->err(500, "unable to get peername");
90 $self->{remote_address} = inet_ntoa $iaddr; 96 $self->{remote_address} = inet_ntoa $iaddr;
91 bless { fh => $fh }, $class; 97 bless { fh => $fh }, $class;
92} 98}
93 99
… …
146 ([^\040]+) \040+ 152 ([^\040]+) \040+
147 HTTP\/([0-9]+\.[0-9]+) 153 HTTP\/([0-9]+\.[0-9]+)
148 \015\012/gx 154 \015\012/gx
149 or $self->err(403, "method not allowed", { Allow => "GET,HEAD" }); 155 or $self->err(403, "method not allowed", { Allow => "GET,HEAD" });
150 156
151 $2 ne "1.0" 157 $2 < 2
152 or $self->err(506, "http protocol version not supported"); 158 or $self->err(506, "http protocol version not supported");
153 159
154 $self->{method} = $1; 160 $self->{method} = $1;
155 $self->{uri} = $2; 161 $self->{uri} = $2;
156 162
… …
159 my (%hdr, $h, $v); 165 my (%hdr, $h, $v);
160 166
161 $hdr{lc $1} .= ",$2" 167 $hdr{lc $1} .= ",$2"
162 while $req =~ /\G 168 while $req =~ /\G
163 ([^:\000-\040]+): 169 ([^:\000-\040]+):
164 [\008\040]* 170 [\011\040]*
165 ((?: [^\015\012]+ | \015\012[\008\040] )*) 171 ((?: [^\015\012]+ | \015\012[\011\040] )*)
166 \015\012 172 \015\012
167 /gxc; 173 /gxc;
168 174
169 $req =~ /\G\015\012$/ 175 $req =~ /\G\015\012$/
170 or $self->err(400, "bad request"); 176 or $self->err(400, "bad request");
… …
201 $self->{path} = "$::DOCROOT/$host$uri"; 207 $self->{path} = "$::DOCROOT/$host$uri";
202} 208}
203 209
204sub server_address { 210sub server_address {
205 my $self = shift; 211 my $self = shift;
206 my ($port, $iaddr) = unpack_sockaddr_in $self->{fh}->getsockname 212 my ($port, $iaddr) = unpack_sockaddr_in $self->{fh}->sockname
207 or $self->err(500, "unable to get socket name"); 213 or $self->err(500, "unable to get socket name");
208 ((inet_ntoa $iaddr), $port); 214 ((inet_ntoa $iaddr), $port);
209} 215}
210 216
211sub server_host { 217sub server_host {
… …
227 } 233 }
228 $port = $port == 80 ? "" : ":$port"; 234 $port = $port == 80 ? "" : ":$port";
229 $host.$port; 235 $host.$port;
230} 236}
231 237
238# no, this doesn't do cgi, but it's close enough
239# for the no-longer-used directory indexing script.
232sub _cgi { 240sub _cgi {
233 my $self = shift; 241 my $self = shift;
234 my $path = shift; 242 my $path = shift;
235 my $fh; 243 my $fh;
236 244
… …
310 ($l, $h) = ($1, ($2 ne "" || $2 >= $length) ? $2 : $length - 1); 318 ($l, $h) = ($1, ($2 ne "" || $2 >= $length) ? $2 : $length - 1);
311 } else { 319 } else {
312 ($l, $h) = (0, $length - 1); 320 ($l, $h) = (0, $length - 1);
313 goto ignore; 321 goto ignore;
314 } 322 }
315 goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h > $l; 323 goto satisfiable if $l >= 0 && $l < $length && $h >= 0 && $h >= $l;
316 } 324 }
317 $hdr->{"Content-Range"} = "bytes */$length"; 325 $hdr->{"Content-Range"} = "bytes */$length";
318 $self->err(416, "not satisfiable", $hdr); 326 $self->err(416, "not satisfiable", $hdr);
319 327
320satisfiable: 328satisfiable:
… …
356 } 364 }
357 } 365 }
358 366
359 close $fh; 367 close $fh;
360} 368}
369

Diff Legend

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