lib/HTTP/Daemon.pm

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