1# 2# a test server for testing IO::Socket::SSL-class's behavior 3# (marko.asplund at kronodoc.fi). 4# 5# $Id: ssl_server.pl,v 1.7 2000/11/08 09:25:21 aspa Exp $. 6# 7 8use strict; 9use IO::Socket::SSL; 10 11 12my ($sock, $s, $v_mode); 13 14if($ARGV[0] eq "DEBUG") { $IO::Socket::SSL::DEBUG = 1; } 15 16# Check to make sure that we were not accidentally run in the wrong 17# directory: 18unless (-d "certs") { 19 if (-d "../certs") { 20 chdir ".."; 21 } else { 22 die "Please run this example from the IO::Socket::SSL distribution directory!\n"; 23 } 24} 25 26if(!($sock = IO::Socket::SSL->new( Listen => 5, 27 LocalAddr => 'localhost', 28 LocalPort => 9000, 29 Proto => 'tcp', 30 Reuse => 1, 31 SSL_verify_mode => 0x01, 32 SSL_passwd_cb => sub {return "bluebell"}, 33 )) ) { 34 warn "unable to create socket: ", &IO::Socket::SSL::errstr, "\n"; 35 exit(0); 36} 37warn "socket created: $sock.\n"; 38 39while (1) { 40 warn "waiting for next connection.\n"; 41 42 while(($s = $sock->accept())) { 43 my ($peer_cert, $subject_name, $issuer_name, $date, $str); 44 45 if( ! $s ) { 46 warn "error: ", $sock->errstr, "\n"; 47 next; 48 } 49 50 warn "connection opened ($s).\n"; 51 52 if( ref($sock) eq "IO::Socket::SSL") { 53 $subject_name = $s->peer_certificate("subject"); 54 $issuer_name = $s->peer_certificate("issuer"); 55 } 56 57 warn "\t subject: '$subject_name'.\n"; 58 warn "\t issuer: '$issuer_name'.\n"; 59 60 my $date = localtime(); 61 print $s "my date command says it's: '$date'"; 62 close($s); 63 warn "\t connection closed.\n"; 64 } 65} 66 67 68$sock->close(); 69 70warn "loop exited.\n"; 71