Daemon-patch / https
Goran Thyni (goran@bildbasen.se)
Wed, 05 Aug 1998 20:51:37 +0000
This is a multi-part message in MIME format.
--------------B4D74A0C37930D46B90162CC
Content-Type: text/plain; charset=iso-8859-1
Content-Transfer-Encoding: quoted-printable
X-MIME-Autoconverted: from 8bit to quoted-printable by hanna.kiruna.se id WAA23108
Gisle,
Attached is a patch to HTTP/Daemon.pm to run it as a
SSL-enabled server.
It is a back patch of overrides in Kirves-httpd 0.60.
* I had to change some IO-functions to be able to
override print function.
* Initialize SSL context in HTTP::Daemon::new
* new arguments to HTTP::Daemon::new :
{ SSL =3D> 0/1, SSL_CERT =3D> <path to certfile>, SSL_KEY =3D> <path to
keyfile> }
* choose normal or SSL I/O in HTTP::Daemon::print and
HTTP::Daemon::_need_more.
local/http test still work as does some quick SSL-access test
I did with Communicator 4.05.
hilsen,
G=F6ran.
--------------B4D74A0C37930D46B90162CC
Content-Type: text/plain; charset=us-ascii; name="HTTP::Daemon.pm.diff"
Content-Disposition: inline; filename="HTTP::Daemon.pm.diff"
Content-Transfer-Encoding: 7bit
*** lib/HTTP/Daemon.pm.orig Wed Apr 15 21:34:35 1998
--- lib/HTTP/Daemon.pm Wed Aug 5 22:34:05 1998
***************
*** 96,101 ****
--- 96,116 ----
$host = Sys::Hostname::hostname();
}
${*$self}{'httpd_server_name'} = $host;
+ if ($args{'SSL'})
+ {
+ require Net::SSLeay;
+ import Net::SSLeay qw(die_now die_if_ssl_error);
+ my $ctx;
+ Net::SSLeay::load_error_strings();
+ Net::SSLeay::ERR_load_crypto_strings();
+ Net::SSLeay::SSLeay_add_ssl_algorithms();
+ Net::SSLeay::randomize();
+ $ctx = Net::SSLeay::CTX_new() or die_now("CTX_new ($ctx): $!\n");
+ Net::SSLeay::set_server_cert_and_key($ctx,
+ $args{'SSL_CERT'},
+ $args{'SSL_KEY'});
+ ${*$self}{'SSL_CTX'} = $ctx;
+ }
$self;
}
***************
*** 115,120 ****
--- 130,152 ----
my $pkg = shift || "HTTP::Daemon::ClientConn";
my $sock = $self->SUPER::accept($pkg);
${*$sock}{'httpd_daemon'} = $self if $sock;
+ if (${*$self}{'SSL_CTX'})
+ {
+ my $ssl;
+ $ssl = Net::SSLeay::new(${*$self}{'SSL_CTX'})
+ or die_now("ssl new ($ssl): $!");
+ Net::SSLeay::set_fd($ssl, $sock->fileno);
+ Net::SSLeay::accept($ssl);
+ # die_if_ssl_error("ssl_echo: ssl accept: ($!)");
+ my $cipher = Net::SSLeay::get_cipher($ssl);
+ if ($cipher =~ /NONE/)
+ {
+ Net::SSLeay::free($ssl);
+ $sock->close();
+ return undef;
+ }
+ ${*$sock}{'SSL'} = $ssl;
+ }
$sock;
}
***************
*** 128,137 ****
sub url
{
my $self = shift;
my $url = "http://";
$url .= ${*$self}{'httpd_server_name'};
my $port = $self->sockport;
! $url .= ":$port" if $port != 80;
$url .= "/";
$url;
}
--- 160,172 ----
sub url
{
my $self = shift;
+ my $ssl = ${*$self}{SSL_CTX};
my $url = "http://";
+ $url = "https://" if $ssl;
$url .= ${*$self}{'httpd_server_name'};
my $port = $self->sockport;
! $url .= ":$port"
! if (!$ssl and $port != 80 ) or ($ssl and $port != 437);
$url .= "/";
$url;
}
***************
*** 401,421 ****
sub _need_more
{
my $self = shift;
#my($buf,$timeout,$fdset) = @_;
if ($_[1]) {
! my($timeout, $fdset) = @_[1,2];
! print STDERR "select(,,,$timeout)\n" if $DEBUG;
! my $n = select($fdset,undef,undef,$timeout);
! unless ($n) {
! $self->reason(defined($n) ? "Timeout" : "select: $!");
! return;
! }
}
! print STDERR "sysread()\n" if $DEBUG;
! my $n = sysread($self, $_[0], 2048, length($_[0]));
! $self->reason(defined($n) ? "Client closed" : "sysread: $!") unless $n;
! $n;
! }
=item $c->read_buffer([$new_value])
--- 436,469 ----
sub _need_more
{
my $self = shift;
+ my $n = 0;
#my($buf,$timeout,$fdset) = @_;
if ($_[1]) {
! my($timeout, $fdset) = @_[1,2];
! print STDERR "select(,,,$timeout)\n" if $DEBUG;
! my $n = select($fdset,undef,undef,$timeout);
! unless ($n) {
! $self->reason(defined($n) ? "Timeout" : "select: $!");
! return;
! }
}
! unless (${*$self}{'SSL'})
! {
! print STDERR "sysread()\n" if $DEBUG;
! my $n = sysread($self, $_[0], 2048, length($_[0]));
! $self->reason(defined($n) ? "Client closed" : "sysread: $!") unless $n;
! return $n;
! }
! my $got = Net::SSLeay::read(${*$self}{'SSL'},2048);
! unless ($got)
! {
! $self->reason("sslread: $!");
! #print STDERR "$$: ssl read failed";
! return 0;
! }
! $_[0] .= $got;
! length($got);
! }
=item $c->read_buffer([$new_value])
***************
*** 536,542 ****
$status ||= RC_OK;
$message ||= status_message($status) || "";
$proto ||= $HTTP::Daemon::PROTO || "HTTP/1.1";
! print $self "$proto $status $message$CRLF";
}
=item $c->send_crlf
--- 584,590 ----
$status ||= RC_OK;
$message ||= status_message($status) || "";
$proto ||= $HTTP::Daemon::PROTO || "HTTP/1.1";
! $self->print("$proto $status $message$CRLF");
}
=item $c->send_crlf
***************
*** 548,555 ****
sub send_crlf
{
! my $self = shift;
! print $self $CRLF;
}
--- 596,602 ----
sub send_crlf
{
! shift->print($CRLF);
}
***************
*** 566,574 ****
my $self = shift;
return if $self->antique_client;
$self->send_status_line(@_);
! print $self "Date: ", time2str(time), $CRLF;
my $product = $self->daemon->product_tokens;
! print $self "Server: $product$CRLF" if $product;
}
--- 613,621 ----
my $self = shift;
return if $self->antique_client;
$self->send_status_line(@_);
! $self->print("Date: ", time2str(time), $CRLF);
my $product = $self->daemon->product_tokens;
! $self->print("Server: $product$CRLF") if $product;
}
***************
*** 619,640 ****
} else {
$self->force_last_request;
}
! print $self $res->headers_as_string($CRLF);
! print $self $CRLF; # separates headers and content
}
if (ref($content) eq "CODE") {
while (1) {
my $chunk = &$content();
last unless defined($chunk) && length($chunk);
if ($chunked) {
! printf $self "%x%s%s%s", length($chunk), $CRLF, $chunk, $CRLF;
} else {
! print $self $chunk;
}
}
! print $self "0$CRLF$CRLF" if $chunked; # no trailers either
} elsif (length $content) {
! print $self $content;
}
}
--- 666,688 ----
} else {
$self->force_last_request;
}
! $self->print($res->headers_as_string($CRLF));
! $self->print($CRLF); # separates headers and content
}
if (ref($content) eq "CODE") {
while (1) {
my $chunk = &$content();
last unless defined($chunk) && length($chunk);
if ($chunked) {
! $self->print(sprintf("%x%s%s%s",
! length($chunk), $CRLF, $chunk, $CRLF));
} else {
! $self->print($chunk);
}
}
! $self->print("0$CRLF$CRLF") if $chunked; # no trailers either
} elsif (length $content) {
! $self->print($content);
}
}
***************
*** 655,667 ****
$self->send_basic_header($status);
$loc = url($loc, $self->daemon->url) unless ref($loc);
$loc = $loc->abs;
! print $self "Location: $loc$CRLF";
if ($content) {
my $ct = $content =~ /^\s*</ ? "text/html" : "text/plain";
! print $self "Content-Type: $ct$CRLF";
}
! print $self $CRLF;
! print $self $content if $content;
$self->force_last_request; # no use keeping the connection open
}
--- 703,715 ----
$self->send_basic_header($status);
$loc = url($loc, $self->daemon->url) unless ref($loc);
$loc = $loc->abs;
! $self->print("Location: $loc$CRLF");
if ($content) {
my $ct = $content =~ /^\s*</ ? "text/html" : "text/plain";
! $self->print("Content-Type: $ct$CRLF");
}
! $self->print($CRLF);
! $self->print($content) if $content;
$self->force_last_request; # no use keeping the connection open
}
***************
*** 688,698 ****
EOT
unless ($self->antique_client) {
$self->send_basic_header($status);
! print $self "Content-Type: text/html$CRLF";
! print $self "Content-Length: " . length($mess) . $CRLF;
! print $self $CRLF;
}
! print $self $mess;
$status;
}
--- 736,746 ----
EOT
unless ($self->antique_client) {
$self->send_basic_header($status);
! $self->print("Content-Type: text/html$CRLF");
! $self->print("Content-Length: " . length($mess) . $CRLF);
! $self->print($CRLF);
}
! $self->print($mess);
$status;
}
***************
*** 719,730 ****
my($size,$mtime) = (stat _)[7,9];
unless ($self->antique_client) {
$self->send_basic_header;
! print $self "Content-Type: $ct$CRLF";
! print $self "Content-Encoding: $ce$CRLF" if $ce;
! print $self "Content-Length: $size$CRLF" if $size;
! print $self "Last-Modified: ", time2str($mtime), "$CRLF" if $mtime;
! print $self $CRLF;
! }
$self->send_file(\*F);
return RC_OK;
} else {
--- 767,779 ----
my($size,$mtime) = (stat _)[7,9];
unless ($self->antique_client) {
$self->send_basic_header;
! $self->print("Content-Type: $ct$CRLF");
! $self->print("Content-Encoding: $ce$CRLF") if $ce;
! $self->print("Content-Length: $size$CRLF") if $size;
! $self->print("Last-Modified: ", time2str($mtime), "$CRLF")
! if $mtime;
! $self->print($CRLF);
! }
$self->send_file(\*F);
return RC_OK;
} else {
***************
*** 766,772 ****
while ($n = sysread($file, $buf, 8*1024)) {
last if !$n;
$cnt += $n;
! print $self $buf;
}
close($file) if $opened;
$cnt;
--- 815,821 ----
while ($n = sysread($file, $buf, 8*1024)) {
last if !$n;
$cnt += $n;
! $self->print($buf);
}
close($file) if $opened;
$cnt;
***************
*** 783,788 ****
--- 832,852 ----
{
my $self = shift;
${*$self}{'httpd_daemon'};
+ }
+
+ =item $c->print
+
+ Override to support normal and SSL output
+
+ =cut
+
+ sub print
+ {
+ my $self = shift;
+ return $self->SUPER::print(@_) unless ${*$self}{'SSL'};
+ my $n = Net::SSLeay::ssl_write_all(${*$self}{'SSL'}, join('', @_));
+ print STDERR "$$: ssl write failed" unless $n;
+ return $n;
}
=back
--------------B4D74A0C37930D46B90162CC--