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