Skip Menu |

This queue is for tickets about the HTTP-Daemon CPAN distribution.

Report information
The Basics
Id: 2187
Status: resolved
Priority: 0/
Queue: HTTP-Daemon
People
Owner: Nobody in particular
Requestors: mah [...] everybody.org
Cc:
AdminCc:
Bug Information
Severity: Normal
Broken in: (no value)
Fixed in: (no value)

History Show all quoted text
  Thu Mar 06 14:56:04 2003 MAHEX [...] cpan.org - Ticket created
Subject: HTTP::Daemon should support HTTPS
As per title. See attached diff.
cd ~/.cpan/build/libwww-perl-5.69/ diff -u /home/mah/.cpan/build/libwww-perl-5.69/lib/HTTP/Daemon.pm\~ /home/mah/.cpan/build/libwww-perl-5.69/lib/HTTP/Daemon.pm --- /home/mah/.cpan/build/libwww-perl-5.69/lib/HTTP/Daemon.pm~ 2002-08-17 22:23:43.000000000 -0500 +++ /home/mah/.cpan/build/libwww-perl-5.69/lib/HTTP/Daemon.pm 2003-03-06 13:54:35.000000000 -0600 @@ -86,14 +86,26 @@ =cut +{ my $do_ssl = undef; + +sub is_ssl { $do_ssl }; + sub new { my($class, %args) = @_; $args{Listen} ||= 5; $args{Proto} ||= 'tcp'; + + if($args{SSL}) { + $do_ssl = 1; + eval "use IO::Socket::SSL"; + @ISA = qw(IO::Socket::SSL); + delete $args{SSL}; + } + return $class->SUPER::new(%args); } - +} =item $c = $d->accept([$pkg]) @@ -132,7 +144,7 @@ sub url { my $self = shift; - my $url = "http://"; + my $url = $self->is_ssl ? "https://" : "http://"; my $addr = $self->sockaddr; if (!$addr || $addr eq INADDR_ANY) { require Sys::Hostname; Diff finished at Thu Mar 6 13:55:08
  Thu Mar 06 15:12:03 2003 MAHEX [...] cpan.org - Correspondence added
Previous patch is incomplete. This patch is a hack, but works.
cd ~/.cpan/build/libwww-perl-5.69/ diff -u /home/mah/.cpan/build/libwww-perl-5.69/lib/HTTP/Daemon.pm\~ /home/mah/.cpan/build/libwww-perl-5.69/lib/HTTP/Daemon.pm --- /home/mah/.cpan/build/libwww-perl-5.69/lib/HTTP/Daemon.pm~ 2002-08-17 22:23:43.000000000 -0500 +++ /home/mah/.cpan/build/libwww-perl-5.69/lib/HTTP/Daemon.pm 2003-03-06 14:08:41.000000000 -0600 @@ -86,14 +86,26 @@ =cut +{ my $do_ssl = undef; + +sub is_ssl { $do_ssl }; + sub new { my($class, %args) = @_; $args{Listen} ||= 5; $args{Proto} ||= 'tcp'; + + if($args{SSL}) { + $do_ssl = 1; + eval "use IO::Socket::SSL"; + @ISA = qw(IO::Socket::SSL); + delete $args{SSL}; + } + return $class->SUPER::new(%args); } - +} =item $c = $d->accept([$pkg]) @@ -113,6 +125,7 @@ { my $self = shift; my $pkg = shift || "HTTP::Daemon::ClientConn"; + @HTTP::Daemon::ClientConn::ISA = qw(IO::Socket::SSL); my ($sock, $peer) = $self->SUPER::accept($pkg); if ($sock) { ${*$sock}{'httpd_daemon'} = $self; @@ -132,7 +145,7 @@ sub url { my $self = shift; - my $url = "http://"; + my $url = $self->is_ssl ? "https://" : "http://"; my $addr = $self->sockaddr; if (!$addr || $addr eq INADDR_ANY) { require Sys::Hostname; Diff finished at Thu Mar 6 14:10:51
  Thu Mar 06 15:16:14 2003 MAHEX [...] cpan.org - Correspondence added
[MAHEX - Thu Mar 6 15:12:03 2003]: Show quoted text
> This patch is a hack, but works.
For some values of "works". Note that you should add "if $self->is_ssl;" after the line that modifies @HTTP::Daemon::Client::ISA.
  Wed Jan 25 16:34:31 2017 ether [...] cpan.org - Queue changed from libwww-perl to HTTP-Daemon
  Mon Apr 01 12:18:38 2019 olaf [...] wundersolutions.com - Correspondence added
Ticket migrated to github as https://github.com/libwww-perl/HTTP-Daemon/issues/7
  Mon Apr 01 12:18:39 2019 The RT System itself - Status changed from 'new' to 'open'
  Mon Apr 01 12:18:40 2019 olaf [...] wundersolutions.com - Status changed from 'open' to 'resolved'