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