[libhttp-daemon-ssl-perl] 01/07: Import Upstream version 1.02

Mike Gabriel sunweaver at debian.org
Mon Sep 18 16:02:15 UTC 2017


This is an automated email from the git hooks/post-receive script.

sunweaver pushed a commit to branch master
in repository libhttp-daemon-ssl-perl.

commit ab5f526b214663b20a1b895accad45589ccd4272
Author: Mike Gabriel <mike.gabriel at das-netzwerkteam.de>
Date:   Mon Sep 18 18:00:17 2017 +0200

    Import Upstream version 1.02
---
 BUGS                  |   4 +
 Changes               |  17 +++++
 MANIFEST              |  13 ++++
 META.yml              |  13 ++++
 Makefile.PL           |  14 ++++
 README                |  18 +++++
 SSL.pm                | 201 ++++++++++++++++++++++++++++++++++++++++++++++++++
 certs/server-cert.pem |  44 +++++++++++
 certs/server-key.pem  |   9 +++
 certs/test-ca.pem     |  21 ++++++
 t/loadmodule.t        |  21 ++++++
 t/ssl_settings.req    |   4 +
 t/testmodule.t        |  98 ++++++++++++++++++++++++
 13 files changed, 477 insertions(+)

diff --git a/BUGS b/BUGS
new file mode 100644
index 0000000..65a6b50
--- /dev/null
+++ b/BUGS
@@ -0,0 +1,4 @@
+None known for this release.
+
+-- 
+Peter Behroozi (behrooz at fas.harvard.edu)
\ No newline at end of file
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..5186d13
--- /dev/null
+++ b/Changes
@@ -0,0 +1,17 @@
+v1.02
+	- Async updates
+	- Documentation update to mention SSL certificates. (requested
+	  by Cedric Bouvier <Cedric.Bouvier at ctp.com>)
+	- Update to URL function to return 'https' instead of 'http'
+	  as protocol (Patch from Kees Cook <kees at osdl.org>).
+
+--- Old Versions --------------------------------------------------
+
+v1.01  2003.7.27
+	- Patch from Evgeniy Pirogov <epirogov at tucows.com> to fix
+	  read issues when a client and server have different timeouts.
+	- Fixed the README to actually deal with HTTP::Daemon::SSL
+	  instead of IO::Socket::SSL.
+
+v1.00  2003.7.24
+	- Initial public release.
\ No newline at end of file
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..7a20ce6
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,13 @@
+BUGS
+certs/server-cert.pem
+certs/server-key.pem
+certs/test-ca.pem
+Changes
+Makefile.PL
+MANIFEST
+README
+SSL.pm
+t/loadmodule.t
+t/testmodule.t
+t/ssl_settings.req
+META.yml                                 Module meta-data (added by MakeMaker)
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..4c61cb0
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,13 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
+name:         HTTP-Daemon-SSL
+version:      1.02
+version_from: SSL.pm
+installdirs:  site
+license:      perl
+requires:
+    HTTP::Daemon:                  1
+    IO::Socket::SSL:               0.93
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..17fe591
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,14 @@
+#
+# A Makemaker script to build HTTP::Daemon::SSL
+#
+use ExtUtils::MakeMaker;
+
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+  'NAME'	=> 'HTTP::Daemon::SSL',
+  'VERSION_FROM' => 'SSL.pm',
+  'DISTNAME' => 'HTTP-Daemon-SSL',
+  'PREREQ_PM' => { 'HTTP::Daemon' => 1.0, 'IO::Socket::SSL' => 0.93 },
+  'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz', },
+);
diff --git a/README b/README
new file mode 100644
index 0000000..b85af9d
--- /dev/null
+++ b/README
@@ -0,0 +1,18 @@
+
+HTTP::Daemon::SSL is a descendant of HTTP::Daemon that uses SSL
+sockets (via IO::Socket::SSL) instead of cleartext sockets.  It
+also handles SSL-specific problems, such as dealing with HTTP
+clients that attempt to connect to it without using SSL.
+
+In order to use HTTP::Daemon::SSL, you need to have IO::Socket::SSL
+v0.93 or newer installed as well as a recent version of libwww-perl.
+
+installation:
+	perl Makefile.PL
+	make
+	make test
+	make install
+
+
+--
+(Peter Behroozi, behrooz at fas.harvard.edu (sic))
diff --git a/SSL.pm b/SSL.pm
new file mode 100644
index 0000000..97856ed
--- /dev/null
+++ b/SSL.pm
@@ -0,0 +1,201 @@
+#
+# 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.  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.02";
+ at 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";
+    while (1) {
+	my $sock = IO::Socket::SSL::accept($self,$pkg);
+	${*$sock}{'httpd_daemon'} = $self if ($sock);
+	return $sock if ($sock || $self->errstr =~ /^IO::Socket[^\n]* accept failed$/);
+    }
+}
+
+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);
+ at 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;
+}
+
+
+package HTTP::Daemon::ClientConn::SSL;
+use vars qw(@ISA $DEBUG);
+ at ISA = qw(IO::Socket::SSL HTTP::Daemon::ClientConn);
+*DEBUG = \$HTTP::Daemon::DEBUG;
+
+sub _need_more
+{
+    my $self = shift;
+    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;
+        }
+    }
+    my $total = 0;
+    while (1){
+        print STDERR sprintf("sysread() already %d\n",$total) if $DEBUG;
+        my $n = sysread($self, $_[0], 2048, length($_[0]));
+        print STDERR sprintf("sysread() just \$n=%s\n",(defined $n?$n:'undef')) if $DEBUG;
+        $total += $n if defined $n;
+        last if $! =~ 'Resource temporarily unavailable';
+            #SSL_Error because of aggressive reading
+
+        $self->reason(defined($n) ? "Client closed" : "sysread: $!") unless $n;
+        last unless $n;
+        last unless $n == 2048;
+    }
+    $total;
+}
+
+=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;
diff --git a/certs/server-cert.pem b/certs/server-cert.pem
new file mode 100644
index 0000000..0fc5c24
--- /dev/null
+++ b/certs/server-cert.pem
@@ -0,0 +1,44 @@
+Certificate:
+    Data:
+        Version: 1 (0x0)
+        Serial Number: 2 (0x2)
+        Signature Algorithm: md5WithRSAEncryption
+        Issuer: C=US, ST=Some-State, O=Dummy IO::Socket::SSL Certificate Authority, CN=Dummy IO::Socket::SSL Certificate Authority
+        Validity
+            Not Before: Jul 20 16:06:37 2002 GMT
+            Not After : Dec  5 16:06:37 2029 GMT
+        Subject: C=US, ST=Some-State, O=IO::Socket::SSL Dummy Server Certificate, CN=IO::Socket::SSL Dummy Server Certificate
+        Subject Public Key Info:
+            Public Key Algorithm: rsaEncryption
+            RSA Public Key: (512 bit)
+                Modulus (512 bit):
+                    00:9f:27:5f:4a:8a:35:4a:7f:3f:d1:80:25:96:26:
+                    0a:da:af:9a:6d:bc:23:ba:71:91:5b:40:d1:2d:2b:
+                    c8:60:2a:ef:e9:54:e5:a2:64:0a:57:90:35:bf:cd:
+                    b6:36:f3:25:53:68:65:2c:d8:d0:f9:b7:f3:7f:2e:
+                    f8:e2:3d:e0:dd
+                Exponent: 65537 (0x10001)
+    Signature Algorithm: md5WithRSAEncryption
+        57:a7:2d:91:cc:e9:11:16:bb:c1:cd:b5:a5:e1:26:99:8f:ee:
+        8c:b0:2d:b6:54:f4:8a:8e:fd:8f:45:9a:68:d8:0e:ef:d6:a5:
+        38:6a:48:d0:08:da:a8:87:3c:70:05:18:69:a1:c8:ee:94:a7:
+        87:40:f5:4f:64:b4:b0:c6:d3:d2:ed:f9:cc:d1:fe:da:4d:99:
+        4d:22:02:f6:0e:9b:c0:cc:42:59:50:2f:5c:fc:5b:70:f9:0b:
+        ec:6e:5b:eb:d7:6f:a1:b8:67:57:b1:4f:99:bd:ad:03:9d:b5:
+        f3:44:5c:36:1c:fa:33:82:87:0b:99:aa:f5:39:5c:63:23:6b:
+        48:2d
+-----BEGIN CERTIFICATE-----
+MIICQzCCAawCAQIwDQYJKoZIhvcNAQEEBQAwgY4xCzAJBgNVBAYTAlVTMRMwEQYD
+VQQIEwpTb21lLVN0YXRlMTQwMgYDVQQKEytEdW1teSBJTzo6U29ja2V0OjpTU0wg
+Q2VydGlmaWNhdGUgQXV0aG9yaXR5MTQwMgYDVQQDEytEdW1teSBJTzo6U29ja2V0
+OjpTU0wgQ2VydGlmaWNhdGUgQXV0aG9yaXR5MB4XDTAyMDcyMDE2MDYzN1oXDTI5
+MTIwNTE2MDYzN1owgYgxCzAJBgNVBAYTAlVTMRMwEQYDVQQIEwpTb21lLVN0YXRl
+MTEwLwYDVQQKEyhJTzo6U29ja2V0OjpTU0wgRHVtbXkgU2VydmVyIENlcnRpZmlj
+YXRlMTEwLwYDVQQDEyhJTzo6U29ja2V0OjpTU0wgRHVtbXkgU2VydmVyIENlcnRp
+ZmljYXRlMFwwDQYJKoZIhvcNAQEBBQADSwAwSAJBAJ8nX0qKNUp/P9GAJZYmCtqv
+mm28I7pxkVtA0S0ryGAq7+lU5aJkCleQNb/NtjbzJVNoZSzY0Pm3838u+OI94N0C
+AwEAATANBgkqhkiG9w0BAQQFAAOBgQBXpy2RzOkRFrvBzbWl4SaZj+6MsC22VPSK
+jv2PRZpo2A7v1qU4akjQCNqohzxwBRhpocjulKeHQPVPZLSwxtPS7fnM0f7aTZlN
+IgL2DpvAzEJZUC9c/Ftw+Qvsblvr12+huGdXsU+Zva0DnbXzRFw2HPozgocLmar1
+OVxjI2tILQ==
+-----END CERTIFICATE-----
diff --git a/certs/server-key.pem b/certs/server-key.pem
new file mode 100644
index 0000000..b7a165f
--- /dev/null
+++ b/certs/server-key.pem
@@ -0,0 +1,9 @@
+-----BEGIN RSA PRIVATE KEY-----
+MIIBPAIBAAJBAJ8nX0qKNUp/P9GAJZYmCtqvmm28I7pxkVtA0S0ryGAq7+lU5aJk
+CleQNb/NtjbzJVNoZSzY0Pm3838u+OI94N0CAwEAAQJAf/DavcVVCco5t2TY0ldK
+qno4Hrb70cmyHDWC8lkb/5HAGbCGxpsstXxVKczRO201vcFUKm6PX5moUnFCINpg
+UQIhAM+ooHbD0eLL0K6limEnW7GId/+DFI/6KFXk2Nzm//XXAiEAxDQbWQvZS8DO
+HJ5JV8flvMhH30KLeH+zpsvBjWJK4GsCIQCUF7woNsquJZBznNctJjZ8S8jYThES
+BONTLluCXrNYDQIhAJFnsHDQqCxM6jMpV193pJnAsAsUbPpTYZeWX43hL26bAiEA
+jNB3PPNvTNr5tICkO/lMZcN87eUn4ZAtrNzCVF5ilEo=
+-----END RSA PRIVATE KEY-----
diff --git a/certs/test-ca.pem b/certs/test-ca.pem
new file mode 100644
index 0000000..36bf8e4
--- /dev/null
+++ b/certs/test-ca.pem
@@ -0,0 +1,21 @@
+-----BEGIN CERTIFICATE-----
+MIIDgzCCAuygAwIBAgIBADANBgkqhkiG9w0BAQQFADCBjjELMAkGA1UEBhMCVVMx
+EzARBgNVBAgTClNvbWUtU3RhdGUxNDAyBgNVBAoTK0R1bW15IElPOjpTb2NrZXQ6
+OlNTTCBDZXJ0aWZpY2F0ZSBBdXRob3JpdHkxNDAyBgNVBAMTK0R1bW15IElPOjpT
+b2NrZXQ6OlNTTCBDZXJ0aWZpY2F0ZSBBdXRob3JpdHkwHhcNMDIwNzIwMTYwNTU0
+WhcNMjkxMjA1MTYwNTU0WjCBjjELMAkGA1UEBhMCVVMxEzARBgNVBAgTClNvbWUt
+U3RhdGUxNDAyBgNVBAoTK0R1bW15IElPOjpTb2NrZXQ6OlNTTCBDZXJ0aWZpY2F0
+ZSBBdXRob3JpdHkxNDAyBgNVBAMTK0R1bW15IElPOjpTb2NrZXQ6OlNTTCBDZXJ0
+aWZpY2F0ZSBBdXRob3JpdHkwgZ8wDQYJKoZIhvcNAQEBBQADgY0AMIGJAoGBALQm
+bgkEUWImNkjWcO6qn5NZ7rCFbtrzqEYbqciy+1qlWuoBgU44n9ykD1c/BcmBPsDT
+bIOfLzjcdJj38taXu7kcRclchJ+/c6o/SmDv7UqcL6QgVSZRvRrK7TDypMqe3sW8
+zCvTF8WtSsgFy5f9qlUdx4NowMzVV7OFl+6x4YlpAgMBAAGjge4wgeswHQYDVR0O
+BBYEFDU4SrHVMHDjd2kBgFM/qyC3DPxFMIG7BgNVHSMEgbMwgbCAFDU4SrHVMHDj
+d2kBgFM/qyC3DPxFoYGUpIGRMIGOMQswCQYDVQQGEwJVUzETMBEGA1UECBMKU29t
+ZS1TdGF0ZTE0MDIGA1UEChMrRHVtbXkgSU86OlNvY2tldDo6U1NMIENlcnRpZmlj
+YXRlIEF1dGhvcml0eTE0MDIGA1UEAxMrRHVtbXkgSU86OlNvY2tldDo6U1NMIENl
+cnRpZmljYXRlIEF1dGhvcml0eYIBADAMBgNVHRMEBTADAQH/MA0GCSqGSIb3DQEB
+BAUAA4GBAIbCsK/qUXiIsRvg1ptaLNM6VsuR8ifNrmo9A4zk1h4OCixys6Hmoow6
+3MndnLpD3rh3UCYh0M20+fiHcwSmHZvBo3dfSSvYnH0gFSBjKp/wgGcb3Cvl3dRX
+aeWZGrKQKLI6DrHqAiSu9rv+2kfzgmRLt0K+gdb2GkQqCBwT8Gjr
+-----END CERTIFICATE-----
diff --git a/t/loadmodule.t b/t/loadmodule.t
new file mode 100644
index 0000000..6d56fc9
--- /dev/null
+++ b/t/loadmodule.t
@@ -0,0 +1,21 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl t/01loadmodule.t'
+
+######################### We start with some black magic to print on failure.
+
+BEGIN { $| = 1; print "1..3\n"; }
+END {print "Load failed ... not ok 1\n" unless $loaded;}
+
+use IO::Socket::SSL qw(:debug1);
+$loaded = 1;
+$test=1;
+print "ok $test\n";
+
+$test++;
+if ($IO::Socket::SSL::DEBUG == 1) { print "ok $test\n"; }
+else { print "not ok $test\n"; }
+
+$test++;
+if ($Net::SSLeay::trace == 1) { print "ok $test\n"; }
+else { print "not ok $test\n"; }
+
diff --git a/t/ssl_settings.req b/t/ssl_settings.req
new file mode 100644
index 0000000..ce6cf90
--- /dev/null
+++ b/t/ssl_settings.req
@@ -0,0 +1,4 @@
+#Change the following to a port and address that you can create a listening socket on:
+$SSL_SERVER_PORT = 2000;
+$SSL_SERVER_ADDR = '127.0.0.1';
+'True Value';
\ No newline at end of file
diff --git a/t/testmodule.t b/t/testmodule.t
new file mode 100644
index 0000000..db0b83a
--- /dev/null
+++ b/t/testmodule.t
@@ -0,0 +1,98 @@
+#!perl -w
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl t/testmodule.t'
+
+use HTTP::Daemon::SSL;
+use HTTP::Status;
+eval {require "t/ssl_settings.req";} ||
+eval {require "ssl_settings.req";};
+
+$numtests = 8;
+$|=1;
+$SIG{PIPE}='IGNORE';
+
+foreach ($^O) {
+    if (/MacOS/ or /VOS/ or /vmesa/ or /riscos/ or /amigaos/) {
+	print "1..0 # Skipped: fork not implemented on this platform\n";
+	exit;
+    }
+}
+
+print "1..$numtests\n";
+
+$test = 0;
+
+unless (fork) {
+    sleep 1;
+
+    my $client = new IO::Socket::INET(PeerAddr => $SSL_SERVER_ADDR,
+				      PeerPort => $SSL_SERVER_PORT);
+
+    print $client "GET / HTTP/1.0\r\n\r\n";
+    (<$client> eq "HTTP/1.1 400 Bad Request\r\n") || print "not ";
+    &ok("client bad connection test");
+    my @ary = <$client>;
+    close $client;
+
+    $client = new IO::Socket::SSL(PeerAddr => $SSL_SERVER_ADDR,
+				  PeerPort => $SSL_SERVER_PORT,
+				  SSL_verify_mode => 0x01,
+				  SSL_ca_file => "certs/test-ca.pem");
+
+    $client || (print("not ok #client failure\n") && exit);
+    &ok("client good connection test");
+
+    print $client "GET /foo HTTP/1.0\r\n\r\n";
+
+    (<$client> eq "HTTP/1.1 403 Forbidden\r\n") || print "not ";
+    &ok("client permission test");
+    @ary = <$client>;
+
+    exit(0);
+}
+
+
+my $server = new HTTP::Daemon::SSL(LocalPort => $SSL_SERVER_PORT,
+				   LocalAddr => $SSL_SERVER_ADDR,
+				   Listen => 5,
+				   Timeout => 30,
+				   ReuseAddr => 1,
+				   SSL_verify_mode => 0x00,
+				   SSL_ca_file => "certs/test-ca.pem",
+				   SSL_cert_file => "certs/server-cert.pem");
+
+if (!$server) {
+    print "not ok $test\n";
+    exit;
+}
+&ok("server init");
+
+print "not " if (!defined fileno($server));
+&ok("server fileno");
+
+print "not " unless ($server->url =~ m!^https:!);
+&ok("server url test");
+
+my $client = $server->accept;
+
+if (!$client) {
+    print "not ok # no client\n";
+    exit;
+}
+&ok("server accept");
+
+my $r = $client->get_request();
+
+unless ($r->method eq 'GET' and $r->url->path eq '/foo') {
+    print "not ";
+}
+&ok("server method processing");
+
+$client->send_error(RC_FORBIDDEN);
+
+close $client;
+wait;
+
+sub ok {
+    print "ok #$_[0] ", ++$test, "\n"; 
+}

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libhttp-daemon-ssl-perl.git



More information about the Pkg-perl-cvs-commits mailing list