1#@!#!123s

: / usr / share / doc / perl-IO-Socket-SSL-1.94 / example /
Filename : ssl_server.pl
back
#
# a test server for testing IO::Socket::SSL-class's behavior
# (marko.asplund at kronodoc.fi).
#
# $Id: ssl_server.pl,v 1.7 2000/11/08 09:25:21 aspa Exp $.
#

use strict;
use IO::Socket::SSL;


my ($sock, $s, $v_mode);

if($ARGV[0] eq "DEBUG") { $IO::Socket::SSL::DEBUG = 1; }

# 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, $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");
      }
      
      warn "\t subject: '$subject_name'.\n";
      warn "\t issuer: '$issuer_name'.\n";
  
      my $date = localtime();
      print $s "my date command says it's: '$date'";
      close($s);
      warn "\t connection closed.\n";
  }
}


$sock->close();

warn "loop exited.\n";