vcs.maemo.org Git - pkg-perl/blob - deb-src/libwww-perl/libwww-perl-5.813/lib/HTTP/Daemon.pm

   1 package HTTP::Daemon;
   2
   3 use strict;
   4 use vars qw($VERSION @ISA $PROTO $DEBUG);
   5
   6 $VERSION = "5.810";
   7
   8 use IO::Socket qw(AF_INET INADDR_ANY inet_ntoa);
   9 @ISA=qw(IO::Socket::INET);
  10
  11 $PROTO = "HTTP/1.1";
  12
  13
  14 sub new
  15 {
  16     my($class, %args) = @_;
  17     $args{Listen} ||= 5;
  18     $args{Proto}  ||= 'tcp';
  19     return $class->SUPER::new(%args);
  20 }
  21
  22
  23 sub accept
  24 {
  25     my $self = shift;
  26     my $pkg = shift || "HTTP::Daemon::ClientConn";
  27     my ($sock, $peer) = $self->SUPER::accept($pkg);
  28     if ($sock) {
  29         ${*$sock}{'httpd_daemon'} = $self;
  30         return wantarray ? ($sock, $peer) : $sock;
  31     }
  32     else {
  33         return;
  34     }
  35 }
  36
  37
  38 sub url
  39 {
  40     my $self = shift;
  41     my $url = $self->_default_scheme . "://";
  42     my $addr = $self->sockaddr;
  43     if (!$addr || $addr eq INADDR_ANY) {
  44         require Sys::Hostname;
  45         $url .= lc Sys::Hostname::hostname();
  46     }
  47     else {
  48         $url .= gethostbyaddr($addr, AF_INET) || inet_ntoa($addr);
  49     }
  50     my $port = $self->sockport;
  51     $url .= ":$port" if $port != $self->_default_port;
  52     $url .= "/";
  53     $url;
  54 }
  55
  56
  57 sub _default_port {
  58     80;
  59 }
  60
  61
  62 sub _default_scheme {
  63     "http";
  64 }
  65
  66
  67 sub product_tokens
  68 {
  69     "libwww-perl-daemon/$HTTP::Daemon::VERSION";
  70 }
  71
  72
  73
  74 package HTTP::Daemon::ClientConn;
  75
  76 use vars qw(@ISA $DEBUG);
  77 use IO::Socket ();
  78 @ISA=qw(IO::Socket::INET);
  79 *DEBUG = \$HTTP::Daemon::DEBUG;
  80
  81 use HTTP::Request  ();
  82 use HTTP::Response ();
  83 use HTTP::Status;
  84 use HTTP::Date qw(time2str);
  85 use LWP::MediaTypes qw(guess_media_type);
  86 use Carp ();
  87
  88 my $CRLF = "\015\012";   # "\r\n" is not portable
  89 my $HTTP_1_0 = _http_version("HTTP/1.0");
  90 my $HTTP_1_1 = _http_version("HTTP/1.1");
  91
  92
  93 sub get_request
  94 {
  95     my($self, $only_headers) = @_;
  96     if (${*$self}{'httpd_nomore'}) {
  97         $self->reason("No more requests from this connection");
  98         return;
  99     }
 100
 101     $self->reason("");
 102     my $buf = ${*$self}{'httpd_rbuf'};
 103     $buf = "" unless defined $buf;
 104
 105     my $timeout = $ {*$self}{'io_socket_timeout'};
 106     my $fdset = "";
 107     vec($fdset, $self->fileno, 1) = 1;
 108     local($_);
 109
 110   READ_HEADER:
 111     while (1) {
 112         # loop until we have the whole header in $buf
 113         $buf =~ s/^(?:\015?\012)+//;  # ignore leading blank lines
 114         if ($buf =~ /\012/) {  # potential, has at least one line
 115             if ($buf =~ /^\w+[^\012]+HTTP\/\d+\.\d+\015?\012/) {
 116                 if ($buf =~ /\015?\012\015?\012/) {
 117                     last READ_HEADER;  # we have it
 118                 }
 119                 elsif (length($buf) > 16*1024) {
 120                     $self->send_error(413); # REQUEST_ENTITY_TOO_LARGE
 121                     $self->reason("Very long header");
 122                     return;
 123                 }
 124             }
 125             else {
 126                 last READ_HEADER;  # HTTP/0.9 client
 127             }
 128         }
 129         elsif (length($buf) > 16*1024) {
 130             $self->send_error(414); # REQUEST_URI_TOO_LARGE
 131             $self->reason("Very long first line");
 132             return;
 133         }
 134         print STDERR "Need more data for complete header\n" if $DEBUG;
 135         return unless $self->_need_more($buf, $timeout, $fdset);
 136     }
 137     if ($buf !~ s/^(\S+)[ \t]+(\S+)(?:[ \t]+(HTTP\/\d+\.\d+))?[^\012]*\012//) {
 138         ${*$self}{'httpd_client_proto'} = _http_version("HTTP/1.0");
 139         $self->send_error(400);  # BAD_REQUEST
 140         $self->reason("Bad request line: $buf");
 141         return;
 142     }
 143     my $method = $1;
 144     my $uri = $2;
 145     my $proto = $3 || "HTTP/0.9";
 146     $uri = "http://$uri" if $method eq "CONNECT";
 147     $uri = $HTTP::URI_CLASS->new($uri, $self->daemon->url);
 148     my $r = HTTP::Request->new($method, $uri);
 149     $r->protocol($proto);
 150     ${*$self}{'httpd_client_proto'} = $proto = _http_version($proto);
 151     ${*$self}{'httpd_head'} = ($method eq "HEAD");
 152
 153     if ($proto >= $HTTP_1_0) {
 154         # we expect to find some headers
 155         my($key, $val);
 156       HEADER:
 157         while ($buf =~ s/^([^\012]*)\012//) {
 158             $_ = $1;
 159             s/\015$//;
 160             if (/^([^:\s]+)\s*:\s*(.*)/) {
 161                 $r->push_header($key, $val) if $key;
 162                 ($key, $val) = ($1, $2);
 163             }
 164             elsif (/^\s+(.*)/) {
 165                 $val .= " $1";
 166             }
 167             else {
 168                 last HEADER;
 169             }
 170         }
 171         $r->push_header($key, $val) if $key;
 172     }
 173
 174     my $conn = $r->header('Connection');
 175     if ($proto >= $HTTP_1_1) {
 176         ${*$self}{'httpd_nomore'}++ if $conn && lc($conn) =~ /\bclose\b/;
 177     }
 178     else {
 179         ${*$self}{'httpd_nomore'}++ unless $conn &&
 180                                            lc($conn) =~ /\bkeep-alive\b/;
 181     }
 182
 183     if ($only_headers) {
 184         ${*$self}{'httpd_rbuf'} = $buf;
 185         return $r;
 186     }
 187
 188     # Find out how much content to read
 189     my $te  = $r->header('Transfer-Encoding');
 190     my $ct  = $r->header('Content-Type');
 191     my $len = $r->header('Content-Length');
 192
 193     # Act on the Expect header, if it's there
 194     for my $e ( $r->header('Expect') ) {
 195         if( lc($e) eq '100-continue' ) {
 196             $self->send_status_line(100);
 197         }
 198         else {
 199             $self->send_error(417);
 200             $self->reason("Unsupported Expect header value");
 201             return;
 202         }
 203     }
 204
 205     if ($te && lc($te) eq 'chunked') {
 206         # Handle chunked transfer encoding
 207         my $body = "";
 208       CHUNK:
 209         while (1) {
 210             print STDERR "Chunked\n" if $DEBUG;
 211             if ($buf =~ s/^([^\012]*)\012//) {
 212                 my $chunk_head = $1;
 213                 unless ($chunk_head =~ /^([0-9A-Fa-f]+)/) {
 214                     $self->send_error(400);
 215                     $self->reason("Bad chunk header $chunk_head");
 216                     return;
 217                 }
 218                 my $size = hex($1);
 219                 last CHUNK if $size == 0;
 220
 221                 my $missing = $size - length($buf) + 2; # 2=CRLF at chunk end
 222                 # must read until we have a complete chunk
 223                 while ($missing > 0) {
 224                     print STDERR "Need $missing more bytes\n" if $DEBUG;
 225                     my $n = $self->_need_more($buf, $timeout, $fdset);
 226                     return unless $n;
 227                     $missing -= $n;
 228                 }
 229                 $body .= substr($buf, 0, $size);
 230                 substr($buf, 0, $size+2) = '';
 231
 232             }
 233             else {
 234                 # need more data in order to have a complete chunk header
 235                 return unless $self->_need_more($buf, $timeout, $fdset);
 236             }
 237         }
 238         $r->content($body);
 239
 240         # pretend it was a normal entity body
 241         $r->remove_header('Transfer-Encoding');
 242         $r->header('Content-Length', length($body));
 243
 244         my($key, $val);
 245       FOOTER:
 246         while (1) {
 247             if ($buf !~ /\012/) {
 248                 # need at least one line to look at
 249                 return unless $self->_need_more($buf, $timeout, $fdset);
 250             }
 251             else {
 252                 $buf =~ s/^([^\012]*)\012//;
 253                 $_ = $1;
 254                 s/\015$//;
 255                 if (/^([\w\-]+)\s*:\s*(.*)/) {
 256                     $r->push_header($key, $val) if $key;
 257                     ($key, $val) = ($1, $2);
 258                 }
 259                 elsif (/^\s+(.*)/) {
 260                     $val .= " $1";
 261                 }
 262                 elsif (!length) {
 263                     last FOOTER;
 264                 }
 265                 else {
 266                     $self->reason("Bad footer syntax");
 267                     return;
 268                 }
 269             }
 270         }
 271         $r->push_header($key, $val) if $key;
 272
 273     }
 274     elsif ($te) {
 275         $self->send_error(501);         # Unknown transfer encoding
 276         $self->reason("Unknown transfer encoding '$te'");
 277         return;
 278
 279     }
 280     elsif ($ct && lc($ct) =~ m/^multipart\/\w+\s*;.*boundary\s*=\s*(\w+)/) {
 281         # Handle multipart content type
 282         my $boundary = "$CRLF--$1--$CRLF";
 283         my $index;
 284         while (1) {
 285             $index = index($buf, $boundary);
 286             last if $index >= 0;
 287             # end marker not yet found
 288             return unless $self->_need_more($buf, $timeout, $fdset);
 289         }
 290         $index += length($boundary);
 291         $r->content(substr($buf, 0, $index));
 292         substr($buf, 0, $index) = '';
 293
 294     }
 295     elsif ($len) {
 296         # Plain body specified by "Content-Length"
 297         my $missing = $len - length($buf);
 298         while ($missing > 0) {
 299             print "Need $missing more bytes of content\n" if $DEBUG;
 300             my $n = $self->_need_more($buf, $timeout, $fdset);
 301             return unless $n;
 302             $missing -= $n;
 303         }
 304         if (length($buf) > $len) {
 305             $r->content(substr($buf,0,$len));
 306             substr($buf, 0, $len) = '';
 307         }
 308         else {
 309             $r->content($buf);
 310             $buf='';
 311         }
 312     }
 313     ${*$self}{'httpd_rbuf'} = $buf;
 314
 315     $r;
 316 }
 317
 318
 319 sub _need_more
 320 {
 321     my $self = shift;
 322     #my($buf,$timeout,$fdset) = @_;
 323     if ($_[1]) {
 324         my($timeout, $fdset) = @_[1,2];
 325         print STDERR "select(,,,$timeout)\n" if $DEBUG;
 326         my $n = select($fdset,undef,undef,$timeout);
 327         unless ($n) {
 328             $self->reason(defined($n) ? "Timeout" : "select: $!");
 329             return;
 330         }
 331     }
 332     print STDERR "sysread()\n" if $DEBUG;
 333     my $n = sysread($self, $_[0], 2048, length($_[0]));
 334     $self->reason(defined($n) ? "Client closed" : "sysread: $!") unless $n;
 335     $n;
 336 }
 337
 338
 339 sub read_buffer
 340 {
 341     my $self = shift;
 342     my $old = ${*$self}{'httpd_rbuf'};
 343     if (@_) {
 344         ${*$self}{'httpd_rbuf'} = shift;
 345     }
 346     $old;
 347 }
 348
 349
 350 sub reason
 351 {
 352     my $self = shift;
 353     my $old = ${*$self}{'httpd_reason'};
 354     if (@_) {
 355         ${*$self}{'httpd_reason'} = shift;
 356     }
 357     $old;
 358 }
 359
 360
 361 sub proto_ge
 362 {
 363     my $self = shift;
 364     ${*$self}{'httpd_client_proto'} >= _http_version(shift);
 365 }
 366
 367
 368 sub _http_version
 369 {
 370     local($_) = shift;
 371     return 0 unless m,^(?:HTTP/)?(\d+)\.(\d+)$,i;
 372     $1 * 1000 + $2;
 373 }
 374
 375
 376 sub antique_client
 377 {
 378     my $self = shift;
 379     ${*$self}{'httpd_client_proto'} < $HTTP_1_0;
 380 }
 381
 382
 383 sub force_last_request
 384 {
 385     my $self = shift;
 386     ${*$self}{'httpd_nomore'}++;
 387 }
 388
 389 sub head_request
 390 {
 391     my $self = shift;
 392     ${*$self}{'httpd_head'};
 393 }
 394
 395
 396 sub send_status_line
 397 {
 398     my($self, $status, $message, $proto) = @_;
 399     return if $self->antique_client;
 400     $status  ||= RC_OK;
 401     $message ||= status_message($status) || "";
 402     $proto   ||= $HTTP::Daemon::PROTO || "HTTP/1.1";
 403     print $self "$proto $status $message$CRLF";
 404 }
 405
 406
 407 sub send_crlf
 408 {
 409     my $self = shift;
 410     print $self $CRLF;
 411 }
 412
 413
 414 sub send_basic_header
 415 {
 416     my $self = shift;
 417     return if $self->antique_client;
 418     $self->send_status_line(@_);
 419     print $self "Date: ", time2str(time), $CRLF;
 420     my $product = $self->daemon->product_tokens;
 421     print $self "Server: $product$CRLF" if $product;
 422 }
 423
 424
 425 sub send_response
 426 {
 427     my $self = shift;
 428     my $res = shift;
 429     if (!ref $res) {
 430         $res ||= RC_OK;
 431         $res = HTTP::Response->new($res, @_);
 432     }
 433     my $content = $res->content;
 434     my $chunked;
 435     unless ($self->antique_client) {
 436         my $code = $res->code;
 437         $self->send_basic_header($code, $res->message, $res->protocol);
 438         if ($code =~ /^(1\d\d|[23]04)$/) {
 439             # make sure content is empty
 440             $res->remove_header("Content-Length");
 441             $content = "";
 442         }
 443         elsif ($res->request && $res->request->method eq "HEAD") {
 444             # probably OK
 445         }
 446         elsif (ref($content) eq "CODE") {
 447             if ($self->proto_ge("HTTP/1.1")) {
 448                 $res->push_header("Transfer-Encoding" => "chunked");
 449                 $chunked++;
 450             }
 451             else {
 452                 $self->force_last_request;
 453             }
 454         }
 455         elsif (length($content)) {
 456             $res->header("Content-Length" => length($content));
 457         }
 458         else {
 459             $self->force_last_request;
 460             $res->header('connection','close');
 461         }
 462         print $self $res->headers_as_string($CRLF);
 463         print $self $CRLF;  # separates headers and content
 464     }
 465     if ($self->head_request) {
 466         # no content
 467     }
 468     elsif (ref($content) eq "CODE") {
 469         while (1) {
 470             my $chunk = &$content();
 471             last unless defined($chunk) && length($chunk);
 472             if ($chunked) {
 473                 printf $self "%x%s%s%s", length($chunk), $CRLF, $chunk, $CRLF;
 474             }
 475             else {
 476                 print $self $chunk;
 477             }
 478         }
 479         print $self "0$CRLF$CRLF" if $chunked;  # no trailers either
 480     }
 481     elsif (length $content) {
 482         print $self $content;
 483     }
 484 }
 485
 486
 487 sub send_redirect
 488 {
 489     my($self, $loc, $status, $content) = @_;
 490     $status ||= RC_MOVED_PERMANENTLY;
 491     Carp::croak("Status '$status' is not redirect") unless is_redirect($status);
 492     $self->send_basic_header($status);
 493     my $base = $self->daemon->url;
 494     $loc = $HTTP::URI_CLASS->new($loc, $base) unless ref($loc);
 495     $loc = $loc->abs($base);
 496     print $self "Location: $loc$CRLF";
 497     if ($content) {
 498         my $ct = $content =~ /^\s*</ ? "text/html" : "text/plain";
 499         print $self "Content-Type: $ct$CRLF";
 500     }
 501     print $self $CRLF;
 502     print $self $content if $content && !$self->head_request;
 503     $self->force_last_request;  # no use keeping the connection open
 504 }
 505
 506
 507 sub send_error
 508 {
 509     my($self, $status, $error) = @_;
 510     $status ||= RC_BAD_REQUEST;
 511     Carp::croak("Status '$status' is not an error") unless is_error($status);
 512     my $mess = status_message($status);
 513     $error  ||= "";
 514     $mess = <<EOT;
 515 <title>$status $mess</title>
 516 <h1>$status $mess</h1>
 517 $error
 518 EOT
 519     unless ($self->antique_client) {
 520         $self->send_basic_header($status);
 521         print $self "Content-Type: text/html$CRLF";
 522         print $self "Content-Length: " . length($mess) . $CRLF;
 523         print $self $CRLF;
 524     }
 525     print $self $mess unless $self->head_request;
 526     $status;
 527 }
 528
 529
 530 sub send_file_response
 531 {
 532     my($self, $file) = @_;
 533     if (-d $file) {
 534         $self->send_dir($file);
 535     }
 536     elsif (-f _) {
 537         # plain file
 538         local(*F);
 539         sysopen(F, $file, 0) or
 540           return $self->send_error(RC_FORBIDDEN);
 541         binmode(F);
 542         my($ct,$ce) = guess_media_type($file);
 543         my($size,$mtime) = (stat _)[7,9];
 544         unless ($self->antique_client) {
 545             $self->send_basic_header;
 546             print $self "Content-Type: $ct$CRLF";
 547             print $self "Content-Encoding: $ce$CRLF" if $ce;
 548             print $self "Content-Length: $size$CRLF" if $size;
 549             print $self "Last-Modified: ", time2str($mtime), "$CRLF" if $mtime;
 550             print $self $CRLF;
 551         }
 552         $self->send_file(\*F) unless $self->head_request;
 553         return RC_OK;
 554     }
 555     else {
 556         $self->send_error(RC_NOT_FOUND);
 557     }
 558 }
 559
 560
 561 sub send_dir
 562 {
 563     my($self, $dir) = @_;
 564     $self->send_error(RC_NOT_FOUND) unless -d $dir;
 565     $self->send_error(RC_NOT_IMPLEMENTED);
 566 }
 567
 568
 569 sub send_file
 570 {
 571     my($self, $file) = @_;
 572     my $opened = 0;
 573     local(*FILE);
 574     if (!ref($file)) {
 575         open(FILE, $file) || return undef;
 576         binmode(FILE);
 577         $file = \*FILE;
 578         $opened++;
 579     }
 580     my $cnt = 0;
 581     my $buf = "";
 582     my $n;
 583     while ($n = sysread($file, $buf, 8*1024)) {
 584         last if !$n;
 585         $cnt += $n;
 586         print $self $buf;
 587     }
 588     close($file) if $opened;
 589     $cnt;
 590 }
 591
 592
 593 sub daemon
 594 {
 595     my $self = shift;
 596     ${*$self}{'httpd_daemon'};
 597 }
 598
 599
 600 1;
 601
 602 __END__
 603
 604 =head1 NAME
 605
 606 HTTP::Daemon - a simple http server class
 607
 608 =head1 SYNOPSIS
 609
 610   use HTTP::Daemon;
 611   use HTTP::Status;
 612
 613   my $d = HTTP::Daemon->new || die;
 614   print "Please contact me at: <URL:", $d->url, ">\n";
 615   while (my $c = $d->accept) {
 616       while (my $r = $c->get_request) {
 617           if ($r->method eq 'GET' and $r->url->path eq "/xyzzy") {
 618               # remember, this is *not* recommended practice :-)
 619               $c->send_file_response("/etc/passwd");
 620           }
 621           else {
 622               $c->send_error(RC_FORBIDDEN)
 623           }
 624       }
 625       $c->close;
 626       undef($c);
 627   }
 628
 629 =head1 DESCRIPTION
 630
 631 Instances of the C<HTTP::Daemon> class are HTTP/1.1 servers that
 632 listen on a socket for incoming requests. The C<HTTP::Daemon> is a
 633 subclass of C<IO::Socket::INET>, so you can perform socket operations
 634 directly on it too.
 635
 636 The accept() method will return when a connection from a client is
 637 available.  The returned value will be an C<HTTP::Daemon::ClientConn>
 638 object which is another C<IO::Socket::INET> subclass.  Calling the
 639 get_request() method on this object will read data from the client and
 640 return an C<HTTP::Request> object.  The ClientConn object also provide
 641 methods to send back various responses.
 642
 643 This HTTP daemon does not fork(2) for you.  Your application, i.e. the
 644 user of the C<HTTP::Daemon> is responsible for forking if that is
 645 desirable.  Also note that the user is responsible for generating
 646 responses that conform to the HTTP/1.1 protocol.
 647
 648 The following methods of C<HTTP::Daemon> are new (or enhanced) relative
 649 to the C<IO::Socket::INET> base class:
 650
 651 =over 4
 652
 653 =item $d = HTTP::Daemon->new
 654
 655 =item $d = HTTP::Daemon->new( %opts )
 656
 657 The constructor method takes the same arguments as the
 658 C<IO::Socket::INET> constructor, but unlike its base class it can also
 659 be called without any arguments.  The daemon will then set up a listen
 660 queue of 5 connections and allocate some random port number.
 661
 662 A server that wants to bind to some specific address on the standard
 663 HTTP port will be constructed like this:
 664
 665   $d = HTTP::Daemon->new(
 666            LocalAddr => 'www.thisplace.com',
 667            LocalPort => 80,
 668        );
 669
 670 See L<IO::Socket::INET> for a description of other arguments that can
 671 be used configure the daemon during construction.
 672
 673 =item $c = $d->accept
 674
 675 =item $c = $d->accept( $pkg )
 676
 677 =item ($c, $peer_addr) = $d->accept
 678
 679 This method works the same the one provided by the base class, but it
 680 returns an C<HTTP::Daemon::ClientConn> reference by default.  If a
 681 package name is provided as argument, then the returned object will be
 682 blessed into the given class.  It is probably a good idea to make that
 683 class a subclass of C<HTTP::Daemon::ClientConn>.
 684
 685 The accept method will return C<undef> if timeouts have been enabled
 686 and no connection is made within the given time.  The timeout() method
 687 is described in L<IO::Socket>.
 688
 689 In list context both the client object and the peer address will be
 690 returned; see the description of the accept method L<IO::Socket> for
 691 details.
 692
 693 =item $d->url
 694
 695 Returns a URL string that can be used to access the server root.
 696
 697 =item $d->product_tokens
 698
 699 Returns the name that this server will use to identify itself.  This
 700 is the string that is sent with the C<Server> response header.  The
 701 main reason to have this method is that subclasses can override it if
 702 they want to use another product name.
 703
 704 The default is the string "libwww-perl-daemon/#.##" where "#.##" is
 705 replaced with the version number of this module.
 706
 707 =back
 708
 709 The C<HTTP::Daemon::ClientConn> is a C<IO::Socket::INET>
 710 subclass. Instances of this class are returned by the accept() method
 711 of C<HTTP::Daemon>.  The following methods are provided:
 712
 713 =over 4
 714
 715 =item $c->get_request
 716
 717 =item $c->get_request( $headers_only )
 718
 719 This method read data from the client and turns it into an
 720 C<HTTP::Request> object which is returned.  It returns C<undef>
 721 if reading fails.  If it fails, then the C<HTTP::Daemon::ClientConn>
 722 object ($c) should be discarded, and you should not try call this
 723 method again on it.  The $c->reason method might give you some
 724 information about why $c->get_request failed.
 725
 726 The get_request() method will normally not return until the whole
 727 request has been received from the client.  This might not be what you
 728 want if the request is an upload of a large file (and with chunked
 729 transfer encoding HTTP can even support infinite request messages -
 730 uploading live audio for instance).  If you pass a TRUE value as the
 731 $headers_only argument, then get_request() will return immediately
 732 after parsing the request headers and you are responsible for reading
 733 the rest of the request content.  If you are going to call
 734 $c->get_request again on the same connection you better read the
 735 correct number of bytes.
 736
 737 =item $c->read_buffer
 738
 739 =item $c->read_buffer( $new_value )
 740
 741 Bytes read by $c->get_request, but not used are placed in the I<read
 742 buffer>.  The next time $c->get_request is called it will consume the
 743 bytes in this buffer before reading more data from the network
 744 connection itself.  The read buffer is invalid after $c->get_request
 745 has failed.
 746
 747 If you handle the reading of the request content yourself you need to
 748 empty this buffer before you read more and you need to place
 749 unconsumed bytes here.  You also need this buffer if you implement
 750 services like I<101 Switching Protocols>.
 751
 752 This method always return the old buffer content and can optionally
 753 replace the buffer content if you pass it an argument.
 754
 755 =item $c->reason
 756
 757 When $c->get_request returns C<undef> you can obtain a short string
 758 describing why it happened by calling $c->reason.
 759
 760 =item $c->proto_ge( $proto )
 761
 762 Return TRUE if the client announced a protocol with version number
 763 greater or equal to the given argument.  The $proto argument can be a
 764 string like "HTTP/1.1" or just "1.1".
 765
 766 =item $c->antique_client
 767
 768 Return TRUE if the client speaks the HTTP/0.9 protocol.  No status
 769 code and no headers should be returned to such a client.  This should
 770 be the same as !$c->proto_ge("HTTP/1.0").
 771
 772 =item $c->head_request
 773
 774 Return TRUE if the last request was a C<HEAD> request.  No content
 775 body must be generated for these requests.
 776
 777 =item $c->force_last_request
 778
 779 Make sure that $c->get_request will not try to read more requests off
 780 this connection.  If you generate a response that is not self
 781 delimiting, then you should signal this fact by calling this method.
 782
 783 This attribute is turned on automatically if the client announces
 784 protocol HTTP/1.0 or worse and does not include a "Connection:
 785 Keep-Alive" header.  It is also turned on automatically when HTTP/1.1
 786 or better clients send the "Connection: close" request header.
 787
 788 =item $c->send_status_line
 789
 790 =item $c->send_status_line( $code )
 791
 792 =item $c->send_status_line( $code, $mess )
 793
 794 =item $c->send_status_line( $code, $mess, $proto )
 795
 796 Send the status line back to the client.  If $code is omitted 200 is
 797 assumed.  If $mess is omitted, then a message corresponding to $code
 798 is inserted.  If $proto is missing the content of the
 799 $HTTP::Daemon::PROTO variable is used.
 800
 801 =item $c->send_crlf
 802
 803 Send the CRLF sequence to the client.
 804
 805 =item $c->send_basic_header
 806
 807 =item $c->send_basic_header( $code )
 808
 809 =item $c->send_basic_header( $code, $mess )
 810
 811 =item $c->send_basic_header( $code, $mess, $proto )
 812
 813 Send the status line and the "Date:" and "Server:" headers back to
 814 the client.  This header is assumed to be continued and does not end
 815 with an empty CRLF line.
 816
 817 See the description of send_status_line() for the description of the
 818 accepted arguments.
 819
 820 =item $c->send_response( $res )
 821
 822 Write a C<HTTP::Response> object to the
 823 client as a response.  We try hard to make sure that the response is
 824 self delimiting so that the connection can stay persistent for further
 825 request/response exchanges.
 826
 827 The content attribute of the C<HTTP::Response> object can be a normal
 828 string or a subroutine reference.  If it is a subroutine, then
 829 whatever this callback routine returns is written back to the
 830 client as the response content.  The routine will be called until it
 831 return an undefined or empty value.  If the client is HTTP/1.1 aware
 832 then we will use chunked transfer encoding for the response.
 833
 834 =item $c->send_redirect( $loc )
 835
 836 =item $c->send_redirect( $loc, $code )
 837
 838 =item $c->send_redirect( $loc, $code, $entity_body )
 839
 840 Send a redirect response back to the client.  The location ($loc) can
 841 be an absolute or relative URL. The $code must be one the redirect
 842 status codes, and defaults to "301 Moved Permanently"
 843
 844 =item $c->send_error
 845
 846 =item $c->send_error( $code )
 847
 848 =item $c->send_error( $code, $error_message )
 849
 850 Send an error response back to the client.  If the $code is missing a
 851 "Bad Request" error is reported.  The $error_message is a string that
 852 is incorporated in the body of the HTML entity body.
 853
 854 =item $c->send_file_response( $filename )
 855
 856 Send back a response with the specified $filename as content.  If the
 857 file is a directory we try to generate an HTML index of it.
 858
 859 =item $c->send_file( $filename )
 860
 861 =item $c->send_file( $fd )
 862
 863 Copy the file to the client.  The file can be a string (which
 864 will be interpreted as a filename) or a reference to an C<IO::Handle>
 865 or glob.
 866
 867 =item $c->daemon
 868
 869 Return a reference to the corresponding C<HTTP::Daemon> object.
 870
 871 =back
 872
 873 =head1 SEE ALSO
 874
 875 RFC 2616
 876
 877 L<IO::Socket::INET>, L<IO::Socket>
 878
 879 =head1 COPYRIGHT
 880
 881 Copyright 1996-2003, Gisle Aas
 882
 883 This library is free software; you can redistribute it and/or
 884 modify it under the same terms as Perl itself.
 885