Annotation of loncom/lonssl.pm, revision 1.8
1.2 foxr 1: #
1.8 ! foxr 2: # $Id: lonssl.pm,v 1.7 2004/06/01 09:53:44 foxr Exp $
1.2 foxr 3: #
4: # Copyright Michigan State University Board of Trustees
5: #
6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
7: #
8: # LON-CAPA is free software; you can redistribute it and/or modify
9: # it under the terms of the GNU General Public License as published by
10: # the Free Software Foundation; either version 2 of the License, or
11: # (at your option) any later version.
12: #
13: # LON-CAPA is distributed in the hope that it will be useful,
14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16: # GNU General Public License for more details.
17: #
18: # You should have received a copy of the GNU General Public License
19: # along with LON-CAPA; if not, write to the Free Software
20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21: #
22: # /home/httpd/html/adm/gpl.txt
23: #
24: # http://www.lon-capa.org/
25: #
1.6 foxr 26: package lonssl;
1.2 foxr 27: # lonssl.pm
28: # This file contains common functions used by lond and lonc when
29: # negotiating the exchange of the session encryption key via an
30: # SSL tunnel.
31: # See the POD sections and function documentation for more information.
32: #
33:
34: use strict;
1.4 foxr 35:
1.6 foxr 36: # CPAN/Standard modules:
1.4 foxr 37:
1.2 foxr 38: use IO::Socket::INET;
39: use IO::Socket::SSL;
40:
1.8 ! foxr 41: use Fcntl;
! 42: use POSIX;
! 43:
1.4 foxr 44: # Loncapa modules:
45:
46: use LONCAPA::Configuration;
47:
48: # Global storage:
49:
1.5 foxr 50: my $perlvar; # this refers to the apache perlsetvar
51: # variable hash.
1.4 foxr 52:
53: my $pathsep = "/"; # We're on unix after all.
54:
55:
56: # Initialization code:
57:
58: $perlvar = LONCAPA::Configuration::read_conf('loncapa.conf');
59:
60:
1.8 ! foxr 61: my $lasterror="";
! 62:
! 63:
! 64: sub LastError {
! 65: return $lasterror;
! 66: }
! 67:
! 68: #-------------------------------------------------------------------------
! 69: # Name SetFdBlocking -
! 70: # Turn blocking mode on on the file handle. This is required for
! 71: # SSL key negotiation.
! 72: #
! 73: # Parameters:
! 74: # Handle - Reference to the handle to modify.
! 75: # Returns:
! 76: # prior flag settings.
! 77: #
! 78: sub SetFdBlocking {
! 79: print STDERR "SetFdBlocking called \n";
! 80: my $Handle = shift;
! 81:
! 82:
! 83:
! 84: my $flags = fcntl($Handle, F_GETFL, 0);
! 85: if(!$flags) {
! 86: print STDERR "SetBLocking fcntl get faild $!\n";
! 87: }
! 88: my $newflags = $flags & (~ O_NONBLOCK); # Turn off O_NONBLOCK...
! 89: if(!fcntl($Handle, F_SETFL, $newflags)) {
! 90: print STDERR "Can't set non block mode $!\n";
! 91: }
! 92: return $flags;
! 93: }
1.2 foxr 94:
95: #--------------------------------------------------------------------------
96: #
97: # Name PromoteClientSocket
98: # Description Given an ordinary IO::Socket::INET Creates an SSL socket
99: # for a client that is connected to the same server.
100: # Parameters Name Type Description
101: # Socket IO::Socket::INET Original ordinary socket.
102: # CACert string Full path name to the certificate
103: # authority certificate file.
104: # MyCert string Full path name to the certificate
105: # issued to this host.
106: # KeyFile string Full pathname to the host's private
107: # key file for the certificate.
108: # Returns
109: # - Reference to an SSL socket on success
110: # - undef on failure. Reason for failure can be interrogated from
111: # IO::Socket::SSL
1.8 ! foxr 112: # Side effects: socket is left in blocking mode!!
! 113: #
1.2 foxr 114:
115: sub PromoteClientSocket {
1.6 foxr 116: my ($PlaintextSocket,
117: $CACert,
118: $MyCert,
1.7 foxr 119: $KeyFile) = @_;
1.6 foxr 120:
121:
1.8 ! foxr 122: print STDERR "Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert\n";
! 123:
1.3 albertel 124: # To create the ssl socket we need to duplicate the existing
125: # socket. Otherwise closing the ssl socket will close the plaintext socket
1.8 ! foxr 126: # too. We also must flip into blocking mode for the duration of the
! 127: # ssl negotiation phase.. the caller will have to flip to non block if
! 128: # that's what they want
! 129:
! 130: my $oldflags = SetFdBlocking($PlaintextSocket);
! 131: my $dupfno = fcntl($PlaintextSocket, F_DUPFD, 0);
! 132: print STDERR "Client promotion got dup = $dupfno\n";
! 133:
1.6 foxr 134:
1.8 ! foxr 135: my $client = IO::Socket::SSL->new_from_fd($dupfno,
1.3 albertel 136: SSL_user_cert => 1,
137: SSL_key_file => $KeyFile,
138: SSL_cert_file => $MyCert,
1.8 ! foxr 139: SSL_ca_fie => $CACert);
1.6 foxr 140:
1.8 ! foxr 141: if(!$client) {
! 142: $lasterror = IO::Socket::SSL::errstr();
! 143: return undef;
! 144: }
1.3 albertel 145: return $client; # Undef if the client negotiation fails.
1.2 foxr 146: }
147:
148: #----------------------------------------------------------------------
149: # Name PromoteServerSocket
150: # Description Given an ordinary IO::Socket::INET Creates an SSL socket
151: # for a server that is connected to the same client.l
152: # Parameters Name Type Description
153: # Socket IO::Socket::INET Original ordinary socket.
154: # CACert string Full path name to the certificate
155: # authority certificate file.
156: # MyCert string Full path name to the certificate
157: # issued to this host.
158: # KeyFile string Full pathname to the host's private
159: # key file for the certificate.
160: # Returns
161: # - Reference to an SSL socket on success
162: # - undef on failure. Reason for failure can be interrogated from
163: # IO::Socket::SSL
1.8 ! foxr 164: # Side Effects:
! 165: # Socket is left in blocking mode!!!
! 166: #
1.3 albertel 167: sub PromoteServerSocket {
1.6 foxr 168: my ($PlaintextSocket,
169: $CACert,
170: $MyCert,
1.7 foxr 171: $KeyFile) = @_;
1.6 foxr 172:
1.3 albertel 173:
174:
175: # To create the ssl socket we need to duplicate the existing
176: # socket. Otherwise closing the ssl socket will close the plaintext socket
177: # too:
178:
1.8 ! foxr 179: print STDERR "Server promotion: Key = $KeyFile, Cert $MyCert CA $CACert\n";
! 180:
! 181: my $oldflags = SetFdBlocking($PlaintextSocket);
! 182: my $dupfno = fcntl($PlaintextSocket, F_DUPFD, 0);
! 183: if (!$dupfno) {
! 184: print STDERR "dup failed: $!\n";
! 185: }
! 186: print STDERR " Fileno = $dupfno\n";
! 187: my $client = IO::Socket::SSL->new_from_fd($dupfno,
1.3 albertel 188: SSL_server => 1, # Server role.
189: SSL_user_cert => 1,
190: SSL_key_file => $KeyFile,
191: SSL_cert_file => $MyCert,
1.8 ! foxr 192: SSL_ca_fie => $CACert);
! 193: if(!$client) {
! 194: $lasterror = IO::Socket::SSL::errstr();
! 195: return undef;
! 196: }
1.3 albertel 197: return $client;
1.2 foxr 198: }
199:
200: #-------------------------------------------------------------------------
201: #
202: # Name: Close
203: # Description: Properly closes an ssl client or ssl server socket in
204: # a way that keeps the parent socket open.
205: # Parameters: Name Type Description
206: # Socket IO::Socket::SSL SSL Socket gotten from either
207: # PromoteClientSocket or
208: # PromoteServerSocket
209: # Returns:
210: # NONE
211: #
212: sub Close {
1.3 albertel 213: my $Socket = shift;
1.4 foxr 214:
1.3 albertel 215: $Socket->close(SSL_no_shutdown =>1); # Otherwise the parent socket
216: # gets torn down.
1.2 foxr 217: }
1.4 foxr 218: #---------------------------------------------------------------------------
219: #
220: # Name GetPeerCertificate
221: # Description Inquires about the certificate of the peer of a connection.
222: # Parameters Name Type Description
223: # SSLSocket IO::Socket::SSL SSL tunnel socket open on
224: # the peer.
225: # Returns
226: # A two element list. The first element of the list is the name of
227: # the certificate authority. The second element of the list is the name
228: # of the owner of the certificate.
229: sub GetPeerCertificate {
1.6 foxr 230: my $SSLSocket = shift;
231:
232: my $CertOwner = $SSLSocket->peer_certificate("owner");
233: my $CertCA = $SSLSocket->peer_certificate("authority");
234:
1.8 ! foxr 235: return ($CertCA, $CertOwner);
1.4 foxr 236: }
237: #----------------------------------------------------------------------------
238: #
239: # Name CertificateFile
240: # Description Locate the certificate files for this host.
241: # Returns
242: # Returns a two element array. The first element contains the name of
243: # the certificate file for this host. The second element contains the name
244: # of the certificate file for the CA that granted the certificate. If
245: # either file cannot be located, returns undef.
246: #
247: sub CertificateFile {
248:
1.6 foxr 249: # I need some perl variables from the configuration file for this:
250:
251: my $CertificateDir = $perlvar->{lonCertificateDirectory};
252: my $CaFilename = $perlvar->{lonnetCertificateAuthority};
253: my $CertFilename = $perlvar->{lonnetCertificate};
254:
255: # Ensure the existence of these variables:
256:
257: if((!$CertificateDir) || (!$CaFilename) || (!$CertFilename)) {
1.8 ! foxr 258: $lasterror = "Missing info: dir: $CertificateDir CA: $CaFilename "
! 259: ."Cert: $CertFilename";
1.6 foxr 260: return undef;
261: }
262:
263: # Build the actual filenames and check for their existence and
264: # readability.
265:
266: my $CaFilename = $CertificateDir.$pathsep.$CaFilename;
267: my $CertFilename = $CertificateDir.$pathsep.$CertFilename;
268:
269: if((! -r $CaFilename) || (! -r $CertFilename)) {
1.8 ! foxr 270: $lasterror = "CA file $CaFilename or Cert File: $CertFilename "
! 271: ."not readable";
1.6 foxr 272: return undef;
273: }
274:
275: # Everything works fine!!
276:
1.8 ! foxr 277: return ($CaFilename, $CertFilename);
1.4 foxr 278:
279: }
280: #------------------------------------------------------------------------
281: #
282: # Name KeyFile
283: # Description
284: # Returns the name of the private key file of the current host.
285: # Returns
286: # Returns the name of the key file or undef if the file cannot
287: # be found.
288: #
289: sub KeyFile {
290:
1.6 foxr 291: # I need some perl variables from the configuration file for this:
292:
293: my $CertificateDir = $perlvar->{lonCertificateDirectory};
294: my $KeyFilename = $perlvar->{lonnetPrivateKey};
295:
296: # Ensure the variables exist:
297:
298: if((!$CertificateDir) || (!$KeyFilename)) {
1.8 ! foxr 299: $lasterror = "Missing parameter dir: $CertificateDir "
! 300: ."key: $KeyFilename";
1.6 foxr 301: return undef;
302: }
303:
304: # Build the actual filename and ensure that it not only exists but
305: # is also readable:
306:
307: my $KeyFilename = $CertificateDir.$pathsep.$KeyFilename;
308: if(! (-r $KeyFilename)) {
1.8 ! foxr 309: $lasterror = "Unreadable key file $KeyFilename";
1.6 foxr 310: return undef;
311: }
312:
313: return $KeyFilename;
1.4 foxr 314: }
1.2 foxr 315:
1.4 foxr 316: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonssl.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom