← Back to branch summary

~ubuntu-branches/ubuntu/precise/libio-socket-ssl-perl/precise

« back to all changes in this revision

Viewing changes to demo/ssl_server.pl

  • Committer: Bazaar Package Importer
  • Author(s): Davide Puricelli (evo)
  • Date: 2004-08-21 18:18:55 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040821181855-gmhulknkkyyjzcb9
Tags: 0.96-1
http://bugs.debian.org/231572
New upstream version, closes: #231572.

Show diffs side-by-side

added added

removed removed

Lines of Context:
demo/ssl_server.pl
1
 
#
2
 
# a test server for testing IO::Socket::SSL-class's behavior
3
 
# (aspa@kronodoc.fi).
4
 
#
5
 
# $Id: ssl_server.pl,v 1.7 2000/11/08 09:25:21 aspa Exp $.
6
 
#
7
 
 
8
 
use strict;
9
 
use IO::Socket::SSL;
10
 
 
11
 
 
12
 
my ($sock, $s, $v_mode);
13
 
 
14
 
if($ARGV[0] eq "DEBUG") { $IO::Socket::SSL::DEBUG = 1; }
15
 
 
16
 
 
17
 
if(!($sock = IO::Socket::SSL->new( Listen => 5,
18
 
                                   LocalAddr => 'localhost',
19
 
                                   LocalPort => 9000,
20
 
                                   Proto     => 'tcp',
21
 
                                   Reuse     => 1,
22
 
                                   SSL_verify_mode => 0x01,
23
 
                                 )) ) {
24
 
  print STDERR "unable to create socket: $!.\n";
25
 
  exit(0);
26
 
}
27
 
print STDERR "socket created: $sock.\n";
28
 
 
29
 
while (1) {
30
 
  print STDERR "waiting for next connection.\n";
31
 
 
32
 
  while(($s = $sock->accept())) {
33
 
    my ($peer_cert, $subject_name, $issuer_name, $date, $str);
34
 
    
35
 
    if( ! $s ) {
36
 
      print STDERR "error: '$!'.\n";
37
 
      next;
38
 
    }
39
 
 
40
 
    print STDERR "connection opened ($s).\n";
41
 
 
42
 
    if( ref($sock) eq "IO::Socket::SSL") {
43
 
      if(($peer_cert = $s->get_peer_certificate())) {
44
 
        $subject_name = $peer_cert->subject_name;
45
 
        $issuer_name = $peer_cert->issuer_name;
46
 
      }
47
 
      
48
 
      print STDERR "\t subject: '$subject_name'.\n";
49
 
      print STDERR "\t issuer: '$issuer_name'.\n";
50
 
    }
51
 
 
52
 
    $date = `date`; chop $date;
53
 
    $str = "my date command says it's: '$date'";
54
 
    $s->write($str, length($str));
55
 
 
56
 
    $s->close();
57
 
    print STDERR "\t connection closed.\n";
58
 
    
59
 
  }
60
 
}
61
 
 
62
 
$sock->close();
63
 
 
64
 
print STDERR "loop exited.\n";