1package IO::Socket::SSL::SafeAccept; 2 3use strict; 4use POSIX; 5use IO::Socket::SSL; 6$IO::Socket::SSL::SafeAccept::VERSION = ( split " ", '# $Id: SSL.pm,v 1.0 2000/06/14 10:30:56 mkul Exp $ ' )[3]; 7@IO::Socket::SSL::SafeAccept::ISA = qw(IO::Socket::SSL); 8 9sub accept 10{ 11 my $this = shift; 12 my $result = $this->SUPER::accept ( @_ ); 13 $! = POSIX::EINTR() if ( ! $result ); 14 $result; 15} 16 171; 18 19package Net::Daemon::SSL; 20 21=head1 NAME 22 23Net::Daemon::SSL - perl extensions for portable ssl daemons 24 25=head1 SYNOPSIS 26 27 use Net::Daemon::SSL; 28 package MyDaemon; 29 @MyDaemon::ISA = qw (Net::Daemon::SSL); 30 sub Run 31 { 32 my $this = shift; 33 my $buffer; 34 $this->{socket}->print ( "vasja was here\n" ); 35 $this->{socket}->sysread ( $buffer, 100 ); # Attention! getline() method 36 # do not work with IO::Socket::SSL 37 # version 0.73 38 # see perldoc IO::Socket::SSL 39 # for more details 40 } 41 package main; 42 my $daemon = new MyDaemon ( {}, \ @ARGV ); # you can use --help command line key 43 $daemon || die "error create daemon instance: $!\n"; 44 $daemon->Bind(); 45 46=head1 DESCRIPTION 47 48This class implements an IO::Socket::SSL functionality for Net::Daemon 49class. See perldoc Net::Daemon for more information about Net::Daemon usage. 50 51=cut 52 53use strict; 54use Net::Daemon; 55$Net::Daemon::SSL::VERSION = ( split " ", '# $Id: SSL.pm,v 1.0 2000/06/14 10:30:56 mkul Exp $ ' )[3]; 56@Net::Daemon::SSL::ISA = qw (Net::Daemon); 57 58sub Version ($) 59{ 60 'Generic Net::Daemon::SSL server 1.0 (C) Michael Kulakov 2000'; 61} 62 63=head2 Options 64 65This method add IO::Socket::SSL specific options ( SSL_use_cert, 66SSL_verify_mode, SSL_key_file, SSL_cert_file, SSL_ca_path, SSL_ca_file ) to 67generic Net::Daemon options. See perldoc IO::Socket::SSL for description of 68this options 69 70=cut 71 72sub Options ($) 73{ 74 my $this = shift; 75 my $options = $this->SUPER::Options(); 76 my $descr = ' - see perldoc IO::Socket::SSL for same parameter'; 77 $options->{SSL_use_cert} = { 'template' => 'SSL_use_cert', 78 'description' => '--SSL_use_cert' . $descr }; 79 $options->{SSL_verify_mode} = { 'template' => 'SSL_verify_mode=s', 80 'description' => '--SSL_verify_mode' . $descr }; 81 $options->{SSL_key_file} = { 'template' => 'SSL_key_file=s', 82 'description' => '--SSL_key_file' . $descr }; 83 $options->{SSL_cert_file} = { 'template' => 'SSL_cert_file=s', 84 'description' => '--SSL_cert_file' . $descr }; 85 $options->{SSL_ca_path} = { 'template' => 'SSL_ca_path=s', 86 'description' => '--SSL_ca_path' . $descr }; 87 $options->{SSL_ca_file} = { 'template' => 'SSL_ca_file=s', 88 'description' => '--SSL_ca_file' . $descr }; 89 $options; 90} 91 92=head2 Bind 93 94This method creates an IO::Socket::SSL::SafeAccept socket, stores this socket 95into $this->{socket} and passes control to parent Net::Daemon::Bind. The 96IO::Socket::SSL::SafeAccept is a class inherited from 97IO::Socket::SSL with the only difference from parent class - the accept() method of 98this class returns EINTR on *any* error. This trick is needed to "hack" 99Net::Daemon::Bind functionality: if this method gets an error from accept() 100( Net::Daemon::SSL auth error, for example ) it will call Fatal() method and 101die unless this is a EINTR error. 102 103=cut 104 105sub Bind 106{ 107 my $this = shift; 108 unless ( $this->{socket} ) 109 { 110 $this->{socket} = new IO::Socket::SSL::SafeAccept 111 ( LocalAddr => $this->{localaddr}, 112 LocalPort => $this->{localport}, 113 Proto => $this->{proto} || 'tcp', 114 Listen => $this->{listen} || 10, 115 Reuse => 1, 116 SSL_use_cert => $this->{SSL_use_cert}, 117 SSL_verify_mode => $this->{SSL_verify_mode}, 118 SSL_key_file => $this->{SSL_key_file}, 119 SSL_cert_file => $this->{SSL_cert_file}, 120 SSL_ca_path => $this->{SSL_ca_path}, 121 SSL_ca_file => $this->{SSL_ca_file} ) || $this->Fatal("Cannot create socket: $!"); 122 } 123 $this->SUPER::Bind ( @_ ); 124} 125 1261; 127 128=head1 AUTHOR AND COPYRIGHT 129 130 Net::Daemon::SSL (C) Michael Kulakov, Zenon N.S.P. 2000 131 125124, 19, 1-st Jamskogo polja st, 132 Moscow, Russian Federation 133 134 mkul@cpan.org 135 136 All rights reserved. 137 138 You may distribute this package under the terms of either the GNU 139 General Public License or the Artistic License, as specified in the 140 Perl README file. 141 142=head1 SEE ALSO 143 144L<Net::Daemon(3)>, L<IO::Socket::SSL(3)> 145 146=cut 147 148__END__ 149 150