HTTP-Server-Singlethreaded
view release on metacpan or search on metacpan
Singlethreaded.pm view on Meta::CPAN
($Sport[$fn], $iaddr) = sockaddr_in($mysockaddr);
$Saddr[$fn] = inet_ntoa($iaddr);
print "Accepted $NewServer (",
$fn,") ",
++$client_tally,
"/$MaxClients on $_ ($fn) port $PortNo[fileno($_)]\n";
push @Clients, $NewServer;
BROKEN_NONBLOCKING and last; # much simpler
}
#BLAH }
}
} # if accepting connections
# Send outbound data from outbufs
my $wlen;
for my $OutFileHandle (@Outs){
$fn = fileno($OutFileHandle);
((defined $fn) and vec($wout,$fn,1)) or next;
$Services++;
$wlen = syswrite $OutFileHandle, $outbuf[$fn], (BROKENSYSWRITE ? 1 : length($outbuf[$fn]));
if(defined $wlen){
DEBUG and print "wrote $wlen of ",length($outbuf[$fn])," to ($fn)\n";
substr $outbuf[$fn], 0, $wlen, '';
if(
length($outbuf[$fn]) < $StaticBufferSize
){
# then we would like to add some more to our outbuf
if(
# support for chunking large files (not HTTP1.1 chunking, just
# reading as we go
defined($LargeFile[$fn])
){
my $slurp;
my $read = sysread $LargeFile[$fn], $slurp, $StaticBufferSize ;
# zero for EOF and undef on error
if ($read){
$outbuf[$fn].= $slurp;
}else{
print "sysread error: $!" unless defined $read;
delete $LargeFile[$fn];
};
}elsif(
# support for continuation coderefs
$continue[$fn]
){
*_ = $Moustache[$fn]; # the hash slot
$_{Data} = '';
HandleDRV( &{$continue[$fn]} );
length ($outbuf[$fn]) or push @PollMe, $fn;
next;
};
}
}else{
warn "Error writing to socket $OutFileHandle ($fn): $!";
$outbuf[$fn] = '';
}
# rewrite this when adding keepalive support
length($outbuf[$fn]) or close $OutFileHandle;
}
# read incoming data to inbufs and list inbufs with complete requests
# close bad connections
for(@Clients){
defined($fn = fileno($_)) or next;
if(vec($rout,$fn,1)){
my $char;
sysread $_,$char,64000;
if(length $char){
DEBUG and print "$fn: read [$char]\n";
$inbuf[$fn] .= $char;
# CompleteRequest or not?
if($inbuf[$fn] =~
/^POST .*?Content-Length: ?(\d+)[\015\012]+(.*)$/is){
DEBUG and print "posting $1 bytes\n";
if(length $2 >= $1){
push @CompleteRequests, $fn;
$PostData[$fn] = $2;
}else{
if(DEBUG){
print "$fn: Waiting for $1 octets of POST data\n";
print "$fn: only have ",length($2),"\n";
}
}
}elsif(substr($inbuf[$fn],-4,4) eq "\015\012\015\012"){
push @CompleteRequests, $fn;
}elsif(DEBUG){
print "Waiting for request completion. So far have\n[",
$inbuf[$fn],"]\n";
};
}else{
print "Received empty packet on $_ ($fn)\n";
print "CLOSING fd $fn\n";
close $_ or print "error on close: $!\n";
$client_tally--;
print "down to $client_tally / $MaxClients\n";
};
}
if(vec($eout,$fn,1)){
# close this one
print "error on $_ ($fn)\n";
print "CLOSING fd $fn\n";
close $_ or print "error on close: $!\n";
};
}
# prune @Clients array
@Clients = grep { defined fileno($_) } @Clients;
$client_tally = @Clients;
DEBUG and print "$client_tally / $MaxClients\n";
# handle complete requests
# (outbound data will get written next time)
for $fn (@CompleteRequests){
Singlethreaded.pm view on Meta::CPAN
$Services and goto BEGIN_SERVICE; # keep selecting while we actually do something
};
1;
__END__
=head1 NAME
HTTP::Server::Singlethreaded - a framework for standalone web applications
=head1 SYNOPSIS
# configuration first:
#
BEGIN { # so the configuration happens before import() is called
# static directories are mapped to file paths in %Static
$HTTP::Server::Singlethreaded::Static{'/images/'} = '/var/www/images';
$HTTP::Server::Singlethreaded::Static{'/'} = '/var/www/htdocs';
#
# configuration for serving static files (defaults are shown)
$HTTP::Server::Singlethreaded::DefaultMimeType = 'text/plain';
@HTTP::Server::Singlethreaded::MimeType{qw/txt htm html jpg gif png/} =
qw{text/plain text/html text/html image/jpeg image/gif image/png};
#
# internal web services are declared in %Functions
$HTTP::Server::Singlethreaded::Function{'/AIS/'} = \&HandleAIS;
#
# external CGI-BIN directories are declared in %CgiBin
# NOT IMPLEMENTED YET
$HTTP::Server::Singlethreaded::CgiBin{'/cgi/'} = '/var/www/cgi-bin';
#
# @Port where we try to listen
@HTTP::Server::Singlethreaded::Port = (80,8000);
#
# Timeout for the selecting
$HTTP::Server::Singlethreaded::Timeout = 5
#
# overload protection
$HTTP::Server::Singlethreaded::MaxClients = 10
#
}; # end BEGIN
# merge path config and open listening sockets
# configuration can also be provided in Use line.
use HTTP::Server::Singlethreaded
timeout => \$NotSetToAnythingForFullBlocking,
function => { # must be a hash ref
'/time/' => sub {
"Content-type: text/plain\n\n".localtime
}
},
path => \%ChangeConfigurationWhileServingBySettingThis;
#
# "top level select loop" is invoked explicitly
for(;;){
#
# manage keepalives on database handles
if ((time - $lasttime) > 40){
...
$lasttime = time;
};
# Auto restart on editing this file
BEGIN{$OriginalM = -M $0}
exec "perl -w $0" if -M $0 != $OriginalM;
#
# do pending IO, invoke functions, read statics
# HTTP::Server::Singlethreaded::Serve()
Serve(); # this gets exported
}
=head1 DESCRIPTION
HTTP::Server::Singlethreaded is a framework for providing web applications without
using a web server (apache, boa, etc.) to handle HTTP.
=head1 CONFIGURATION
One of %Static, %Function, %CgiBin should contain a '/' key, this will
handle just the domain name, or a get request for /.
=head2 %Static
the %Static hash contains paths to directories where files can be found
for serving static files.
=head3 $StaticBufferSize
How much of a large file do we read in at once? Without memory
mapping, we have to read in files, and then write them out. Files larger
than this will get this much read from them when the output buffer is
smaller than this size. Defaults to 50000 bytes, so output buffers
for a request should fluctuate between zero and 100000 bytes while
serving a large file.
=head2 %Function
Paths to functions => functions to run. The entire server request is
available in C<$_> and several variables are available in C<%_>. C<$_{PATH_INFO}>,C<$_{QUERY_STRING}> are of interest. The whole standard CGI environment
will eventually appear in C<%_> for use by functions but it does not yet.
=head2 %CgiBin
CgiBin is a functional wrapper that forks and executes a named
executable program, after setting the common gateway interface
environment variables and changing
directory to the listed directory. NOT IMPLEMENTED YET
=head2 @Port
the C<@Port> array lists the ports the server tries to listen on.
=head2 name-based virtual hosts
not implemented yet; a few configuration interfaces are possible,
most likely a hash of host names that map to strings that will be
prepeneded to the key looked up in %Path, something like
use HTTP::Server::Singlethreaded
vhost => {
'perl.org' => perl =>
'www.perl.org' => perl =>
'web.perl.org' => perl =>
'example.org' => exmpl =>
'example.com' => exmpl =>
'example.net' => exmpl =>
'www.example.org' => exmpl =>
'www.example.com' => exmpl =>
'www.example.net' => exmpl =>
},
static => {
'/' => '/var/web/htdocs/',
'perl/' => '/var/vhosts/perl/htdocs',
'exmpl/' => '/var/vhosts/example/htdocs'
}
;
Please submit comments via rt.cpan.org.
=head2 $Timeout
the timeout for the select. C<0> will cause C<Serve> to simply poll.
C<undef>, to cause Serve to block until thereis a connection, can only
be passed on the C<use> line.
=head2 $MaxClients
if we have more active clients than this we won't accept more. Since
we're not respecting keepalive at this time, this number indicates
how long of a backlog singlethreaded will maintain at any moment,and
should be orders of magnitude lower than the number of simultaneous
web page viewers possible. Depending on how long your functions take.
=head2 $WebEmail
an e-mail address for whoever is responsible for this server,
for use in error messages.
=head2 $forkwidth ( commented out by default )
Set $forkwidth to a number greater than 1
to have singlethreaded fork after binding. If running on a
multiprocessor machine for instance, or if you want to verify
that the elevator algorithm works. After C<import()>, $forkwidth
is altered to indicate which process we are in, such as
"2 of 3". The original gets an array of the process IDs of all
the children in @kids, as well as a $forkwidth variable that
matches C</(\d+) of \1/>. Also, all children are sent a TERM
signal from the parent process's END block. Uncomment the
relevant lines in the module source if you need this. Forking after
initializing the module should work too. This might get removed
as an example of featureitis.
=head2 $uid and $gid
when starting as root in a *nix, specify these numerically. The
process credentials will be changed after the listening sockets
are bound.
=head1 Dynamic Reconfiguration
Dynamic reconfiguration is possible, either by directly altering
the configuration variables or by passing references to import().
=head1 Action Selection Method
The request is split on slashes, then matched against the configuration
hash until there is a match. Longer matching pieces trump shorter ones.
Having the same path listed in more than one of C<%Static>,
C<%Functions>, or C<%CgiBin> is
an error and the server will not start in that case. It will die
while constructing C<%Path>.
=head1 Writing Functions For Use With HTTP::Server::Singlethreaded
This framework uses the C<%_> hash for passing data between elements
which are in different packages.
=head2 Data you get
=head3 the whole enchilada
The full RFC2616-sec5 HTTP Request is available for inspection in C<$_>.
Certain parts have been parsed out and are available in C<%_>. These
include
=head3 Method
Singlethreaded.pm view on Meta::CPAN
the clients in a burst of simultaneous connections. Writing
around this would not be hard: another select loop that only
cares about the Listeners would do it.
=item 0.03
The listen queue will now be drained until empty on platforms
without nonblocking listen sockets thanks to a second C<select>
call.
Large files are now read in pieces instead of being slurped whole.
=item 0.04
Support for continuations for page generating functions is in place.
=item 0.05
Support for POST data is in place. POST data appears in C<$_{POST_DATA}>.
Other CGI variables now available in C<%_> include PATH_INFO, QUERY_STRING, REMOTE_ADDR, REQUEST_METHOD, REQUEST_URI and SCRIPT_NAME.
=item 0.06
Fixed a bug with serving files larger than the chunksize, that inserted
a gratuitous newline. Singlethreaded will now work to serve a minicpan
mirror.
=item 0.08 March, 2008
address of this end of the connection now available
=item 0.10 June, 2008
improved handling of callbacks
improved association logic WRT trailing slashes
repeated selects inside C<Serve()> while outputting
only writing one byte at a time on Windows,
where Cygwin's syswrite does not
do partial writes. (patch welcome to improve this situation)
less debugging output by default, and some informational prints
changed to warnings (to get line number info)
=item 0.11 July, 2008
removed "poll" functions, which were redundant with "continue" functions. Any
reference returned from a function is now presumed to be a coderef. This will
break any installed code that used the "poll" feature or returned the continue
coderef in a hashref or arrayref as previously allowed.
There was a serious problem preventing continuation systems from working right,
so I doubt anyone was using those features.
=item 0.12 July, 2009
silenced a warning about C<$_{Data}> being uninitialized
instead of actually implementing keep-alive, added a "Connection: close" header
line at the beginning of each response
=back
=head1 EXPORTS
C<Serve()> is exported, and must be called in a loop.
=head1 AUTHOR
David Nicol E<lt>davidnico@cpan.orgE<gt>
This module is released AL/GPL, the same terms as Perl.
=head1 References
Paul Tchistopolskii's public domain phttpd
HTTP::Daemon
the University of Missouri - Kansas City Task Definition Interface
perlmonks
TipJar LLC chat hub system (http://tipjar.com/nettoys/bathtub.html)
=cut
( run in 0.781 second using v1.01-cache-2.11-cpan-71847e10f99 )