use strict; use IO::Socket::SSL; my ($sock, $s, $v_mode); $IO::Socket::SSL::DEBUG = 3; # Check to make sure that we were not accidentally run in the wrong # directory: unless (-d "certs") { if (-d "../certs") { chdir ".."; } else { die "Please run this example from the IO::Socket::SSL distribution directory!\n"; } } if(!($sock = IO::Socket::SSL->new( Listen => 5, LocalAddr => 'localhost', LocalPort => 9000, Proto => 'tcp', Reuse => 1, SSL_verify_mode => 0x01, SSL_passwd_cb => sub {return "bluebell"}, )) ) { warn "unable to create socket: ", &IO::Socket::SSL::errstr, "\n"; exit(0); } warn "socket created: $sock.\n"; while (1) { warn "waiting for next connection.\n"; while(($s = $sock->accept())) { my ($peer_cert, $subject_name, $issuer_name, $cipher, $sslversion, $date, $str); if( ! $s ) { warn "error: ", $sock->errstr, "\n"; next; } warn "connection opened ($s).\n"; if( ref($sock) eq "IO::Socket::SSL") { $subject_name = $s->peer_certificate("subject"); $issuer_name = $s->peer_certificate("issuer"); $cipher = $s->get_cipher(); } warn "\t subject: '$subject_name'.\n"; warn "\t issuer: '$issuer_name'.\n"; warn "\t cipher: '$cipher'.\n"; my $request = "ok"; # somehow swapping next 2 lines will make java client to receive response # my ($request) = $sock->getlines; sysread($s, $request, 100); print "Received: $request \n"; $date = localtime(); my $response = "Perl SSL Server Responded at $date \r\n"; syswrite($s, $response, length($response)); $s->flush(); $s->close(); warn "\t connection closed.\n"; } } $sock->close(); warn "loop exited.\n";