view release on metacpan or  search on metacpan

lib/Net/HTTPServer.pm  view on Meta::CPAN

that I have in the module to see what it is doing.  If you want to
turn debugging on simply provide the debug => [ zones ] option when
creating the server.  You can optionally specify a file to write
the log into instead of STDOUT by specifying the debuglog => file
option.

I've coded the modules debugging using the concept of zones.  Each
zone (or task) has it's own debug messages and you can enable/disable
them as you want to.  Here are the list of available zones:

  INIT - Initializing the sever
  PROC - Processing a request
  REQ  - Parsing requests
  RESP - Returning the response (file contents are not printed)
  AUTH - Handling and authentication request
  FILE - Handling a file system request.
  READ - Low-level read
  SEND - Low-level send (even prints binary characters)
  ALL  - Turn all of the above on.

So as an example:

  my $server = new Net::HTTPServer(..., debug=>["REQ","RESP"],...);

That would show all requests and responses.

=head1 AUTHOR

Ryan Eatmon

=head1 COPYRIGHT

Copyright (c) 2003-2005 Ryan Eatmon <reatmon@mail.com>. All rights
reserved.  This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

=cut
  
use strict;
use Carp;
use IO::Socket;
use IO::Select;
use FileHandle;
use File::Path;
use POSIX;
use Net::HTTPServer::Session;
use Net::HTTPServer::Response;
use Net::HTTPServer::Request;

use vars qw ( $VERSION %ALLOWED $SSL $Base64 $DigestMD5 );

$VERSION = "1.1.1";

$ALLOWED{GET} = 1;
$ALLOWED{HEAD} = 1;
$ALLOWED{OPTIONS} = 1;
$ALLOWED{POST} = 1;
$ALLOWED{TRACE} = 1;

#------------------------------------------------------------------------------
# Do we have IO::Socket::SSL for https support?
#------------------------------------------------------------------------------
if (eval "require IO::Socket::SSL;")
{
    require IO::Socket::SSL;
    import IO::Socket::SSL;
    $SSL = 1;
}
else
{
    $SSL = 0;
}

#------------------------------------------------------------------------------
# Do we have MIME::Base64 for Basic Authentication support?
#------------------------------------------------------------------------------
if (eval "require MIME::Base64;")
{
    require MIME::Base64;
    import MIME::Base64;
    $Base64 = 1;
}
else
{
    $Base64 = 0;
}

#------------------------------------------------------------------------------
# Do we have Digest::MD5 for Digest Authentication support?
#------------------------------------------------------------------------------
if (eval "require Digest::MD5;")
{
    require Digest::MD5;
    import Digest::MD5;
    $DigestMD5 = 1;
}
else
{
    $DigestMD5 = 0;
}


sub new
{
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = { };
    
    bless($self, $proto);

    my (%args) = @_;

    $self->{ARGS} = \%args;

    #--------------------------------------------------------------------------
    # Get the hostname...
    #--------------------------------------------------------------------------
    my $hostname = (uname)[1];
    my $address  = gethostbyname($hostname);
    if ($address)
    {
        $hostname = $address;
        my $temp = gethostbyaddr($address, AF_INET);
        $hostname = $temp if ($temp);
    }

lib/Net/HTTPServer.pm  view on Meta::CPAN

    if (ref($url) eq "HASH")
    {
        foreach my $hashURL (keys(%{$url}))
        {
            $self->{CALLBACKS}->{$hashURL} = $url->{$hashURL};
        }
    }
    else
    {
        my $callback = shift;

        $self->{CALLBACKS}->{$url} = $callback;
    }
}


###############################################################################
#
# Start - Just a little initialization routine to start the server.
#
###############################################################################
sub Start
{
    my $self = shift;

    $self->_debug("INIT","Start: Starting the server");

    my $port = $self->{CFG}->{PORT};
    my $scan = ($port eq "scan" ? 1 : 0);
    $port = 8000 if $scan;
    
    $self->{SOCK} = undef;

    while(!defined($self->{SOCK}))
    {
        $self->_debug("INIT","Start: Attempting to listen on port $port");
        
        if ($self->{CFG}->{SSL} == 0)
        {
            $self->{SOCK} = new IO::Socket::INET(LocalPort=>$port,
                                                 Proto=>"tcp",
                                                 Listen=>10,
                                                 Reuse=>1,
                                                 (($^O ne "MSWin32") ?
                                                  (Blocking=>0) :
                                                  ()
                                                 ),
                                                );
        }
        else
        {
            if (!defined($self->{CFG}->{SSL_KEY}) ||
                !defined($self->{CFG}->{SSL_CERT}) ||
                !defined($self->{CFG}->{SSL_CA}))
            {
                croak("You must specify ssl_key, ssl_cert, and ssl_ca if you want to use SSL.");
                return;
            }
            $self->_debug("INIT","Start: Create an SSL socket.");
            $self->{SOCK} = new IO::Socket::SSL(LocalPort=>$port,
                                                Proto=>"tcp",
                                                Listen=>10,
                                                Reuse=>1,
                                                SSL_key_file=>$self->{CFG}->{SSL_KEY},
                                                SSL_cert_file=>$self->{CFG}->{SSL_CERT},
                                                SSL_ca_file=>$self->{CFG}->{SSL_CA},
                                                SSL_verify_mode=> 0x01,
                                                (($^O ne "MSWin32") ?
                                                 (Blocking=>0) :
                                                 ()
                                                ),
                                               );
        }
        last if defined($self->{SOCK});
        last if ($port == 9999);
        last if !$scan;
        
        $port++;
    }

    if (!defined($self->{SOCK}))
    {
        $self->_log("Could not start the server...");
        if ($self->{CFG}->{SSL} == 0)
        {
            carp("Could not start the server: $!");
        }
        else
        {
            carp("Could not start the server: ",&IO::Socket::SSL::errstr);
        }

        return;
    }

    $self->{SELECT} = new IO::Select($self->{SOCK});

    if ($self->{CFG}->{TYPE} eq "forking")
    {
        $self->_debug("INIT","Start: Initializing forking");
        $SIG{CHLD} = sub{ $self->_forking_reaper(); };
        $self->{CHILDREN} = {};
        $self->{NUMCHILDREN} = 0;
    }
    
    $self->_log("Server running on port $port");

    $self->{SERVER}->{PORT} = $port;

    return $port;
}


###############################################################################
#
# Stop - Stop the server.
#
###############################################################################
sub Stop
{
    my $self = shift;

    $self->_debug("INIT","Stop: Stopping the server");

    if ($self->{CFG}->{TYPE} eq "forking")
    {
        $self->_forking_huntsman();
    }
    
    if (exists($self->{SELECT}) && defined($self->{SELECT}))
    {
        $self->{SELECT}->remove($self->{SOCK});
    }

    if (exists($self->{SOCK}) && defined($self->{SOCK}))
    {
        $self->{SOCK}->close();
    }
}




###############################################################################
#+-----------------------------------------------------------------------------
#| Private Flow Functions
#+-----------------------------------------------------------------------------
###############################################################################

###############################################################################