Current File : //usr/share/perl5/vendor_perl/HTTP/Daemon/SSL.pm
#
# This package derived almost entirely from HTTP::Daemon,
# owned by Gisle Aas. Changes include minor alterations in
# the documentation to reflect the use of IO::Socket::SSL
# and modified new(),accept() functions that use IO::Socket::SSL
use strict;
package HTTP::Daemon::SSL;
=head1 NAME
HTTP::Daemon::SSL - a simple http server class with SSL support
=head1 SYNOPSIS
use HTTP::Daemon::SSL;
use HTTP::Status;
# Make sure you have a certs/ directory with "server-cert.pem"
# and "server-key.pem" in it before running this!
my $d = HTTP::Daemon::SSL->new || die;
print "Please contact me at: <URL:", $d->url, ">\n";
while (my $c = $d->accept) {
while (my $r = $c->get_request) {
if ($r->method eq 'GET' and $r->url->path eq "/xyzzy") {
# remember, this is *not* recommened practice :-)
$c->send_file_response("/etc/passwd");
} else {
$c->send_error(RC_FORBIDDEN)
}
}
$c->close;
undef($c);
}
=head1 DESCRIPTION
Instances of the I<HTTP::Daemon::SSL> class are HTTP/1.1 servers that
listen on a socket for incoming requests. The I<HTTP::Daemon::SSL> is a
sub-class of I<IO::Socket::SSL>, so you can perform socket operations
directly on it too.
The accept() method will return when a connection from a client is
available. In a scalar context the returned value will be a reference
to a object of the I<HTTP::Daemon::ClientConn::SSL> class which is another
I<IO::Socket::SSL> subclass. In a list context a two-element array
is returned containing the new I<HTTP::Daemon::ClientConn::SSL> reference
and the peer address; the list will be empty upon failure. (Note that version
1.02 erroneously did not honour list context). Calling
the get_request() method on the I<HTTP::Daemon::ClientConn::SSL> object
will read data from the client and return an I<HTTP::Request> object
reference.
This HTTPS daemon does not fork(2) for you. Your application, i.e. the
user of the I<HTTP::Daemon::SSL> is reponsible for forking if that is
desirable. Also note that the user is responsible for generating
responses that conform to the HTTP/1.1 protocol. The
I<HTTP::Daemon::ClientConn> class provides some methods that make this easier.
=head1 METHODS
The following methods are the only differences from the I<HTTP::Daemon> base class:
=over 4
=cut
use vars qw($VERSION @ISA $PROTO $DEBUG);
use IO::Socket::SSL;
use HTTP::Daemon;
$VERSION = "1.04";
@ISA = qw(IO::Socket::SSL HTTP::Daemon);
=item $d = new HTTP::Daemon::SSL
The constructor takes the same parameters as the
I<IO::Socket::SSL> constructor. It can also be called without specifying
any parameters, but you will have to make sure that you have an SSL certificate
and key for the server in F<certs/server-cert.pem> and F<certs/server-key.pem>.
See the IO::Socket::SSL documentation for how to change these default locations
and specify many other aspects of SSL behavior. The daemon will then set up a
listen queue of 5 connections and allocate some random port number. A server
that wants to bind to some specific address on the standard HTTPS port will be
constructed like this:
$d = new HTTP::Daemon::SSL
LocalAddr => 'www.someplace.com',
LocalPort => 443;
=cut
sub new
{
my ($class, %args) = @_;
$args{Listen} ||= 5;
$args{Proto} ||= 'tcp';
$args{SSL_error_trap} ||= \&ssl_error;
return $class->SUPER::new(%args);
}
sub accept
{
my $self = shift;
my $pkg = shift || "HTTP::Daemon::ClientConn::SSL";
my ($sock, $peer) = IO::Socket::SSL::accept($self,$pkg);
if ($sock) {
${*$sock}{'httpd_daemon'} = $self;
return wantarray ? ($sock, $peer) : $sock;
}
else {
return;
}
}
sub _default_port { 443; }
sub _default_scheme { "https"; }
sub url
{
my $self = shift;
my $url = $self->SUPER::url;
return $url if ($self->can("HTTP::Daemon::_default_port"));
# Workaround for old versions of HTTP::Daemon
$url =~ s!^http:!https:!;
$url =~ s!/$!:80/! unless ($url =~ m!:(?:\d+)/$!);
$url =~ s!:443/$!/!;
return $url;
}
package HTTP::Daemon::SSL::DummyDaemon;
use vars qw(@ISA);
@ISA = qw(HTTP::Daemon);
sub new { bless [], shift; }
package HTTP::Daemon::SSL;
sub ssl_error {
my ($self, $error) = @_;
${*$self}{'httpd_client_proto'} = 1000;
${*$self}{'httpd_daemon'} = new HTTP::Daemon::SSL::DummyDaemon;
if ($error =~ /http/i and $self->opened) {
$self->send_error(400, "Your browser attempted to make an unencrypted\n ".
"request to this server, which is not allowed. Try using\n ".
"HTTPS instead.\n");
}
$self->kill_socket;
}
# we're not overriding any methods here, but we are inserting IO::Socket::SSL
# into the message dispatch tree
package HTTP::Daemon::ClientConn::SSL;
use vars qw(@ISA $DEBUG);
@ISA = qw(IO::Socket::SSL HTTP::Daemon::ClientConn);
*DEBUG = \$HTTP::Daemon::DEBUG;
=head1 SEE ALSO
RFC 2068
L<IO::Socket::SSL>, L<HTTP::Daemon>, L<Apache>
=head1 COPYRIGHT
Code and documentation from HTTP::Daemon Copyright 1996-2001, Gisle Aas
Changes Copyright 2003-2004, Peter Behroozi
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
1;
Mini Shell