loncom/lonssl.pm - view

File: [LON-CAPA] / loncom / lonssl.pm
Revision 1.21: download - view: text, annotated - select for diffs
Mon Dec 10 17:34:22 2018 UTC (5 years, 4 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- Verification of CN when creating SSL tunnel on multi-domain servers.
  CN is default lonid, i.e., one listed last for the node's hostname in
  hosts.tab and/or dns_hosts.tab.

1: # 2: # $Id: lonssl.pm,v 1.21 2018/12/10 17:34:22 raeburn Exp $ 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: # 26: package lonssl; 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; 35: 36: # CPAN/Standard modules: 37: 38: use IO::Socket::INET; 39: use IO::Socket::SSL; 40: use Net::SSLeay; 41: 42: use Fcntl; 43: use POSIX; 44: 45: # Loncapa modules: 46: 47: use LONCAPA::Configuration; 48: 49: # Global storage: 50: 51: my $perlvar; # this refers to the apache perlsetvar 52: # variable hash. 53: 54: my $pathsep = "/"; # We're on unix after all. 55: 56: my $DEBUG = 0; # Set to non zero to enable debug output. 57: 58: 59: # Initialization code: 60: 61: $perlvar = LONCAPA::Configuration::read_conf('loncapa.conf'); 62: 63: 64: my $lasterror=""; 65: 66: 67: 68: sub LastError { 69: return $lasterror; 70: } 71: 72: sub Debug { 73: my $msg = shift; 74: if ($DEBUG) { 75: print STDERR $msg; 76: } 77: } 78: 79: #------------------------------------------------------------------------- 80: # Name SetFdBlocking - 81: # Turn blocking mode on on the file handle. This is required for 82: # SSL key negotiation. 83: # 84: # Parameters: 85: # Handle - Reference to the handle to modify. 86: # Returns: 87: # prior flag settings. 88: # 89: sub SetFdBlocking { 90: Debug("SetFdBlocking called \n"); 91: my $Handle = shift; 92: 93: 94: 95: my $flags = fcntl($Handle, F_GETFL, 0); 96: if(!$flags) { 97: Debug("SetBLocking fcntl get faild $!\n"); 98: } 99: my $newflags = $flags & (~ O_NONBLOCK); # Turn off O_NONBLOCK... 100: if(!fcntl($Handle, F_SETFL, $newflags)) { 101: Debug("Can't set non block mode $!\n"); 102: } 103: return $flags; 104: } 105: 106: #-------------------------------------------------------------------------- 107: # 108: # Name PromoteClientSocket 109: # Description Given an ordinary IO::Socket::INET Creates an SSL socket 110: # for a client that is connected to the same server. 111: # Parameters Name Type Description 112: # Socket IO::Socket::INET Original ordinary socket. 113: # CACert string Full path name to the certificate 114: # authority certificate file. 115: # MyCert string Full path name to the certificate 116: # issued to this host. 117: # KeyFile string Full pathname to the host's private 118: # key file for the certificate. 119: # peer string lonid of remote LON-CAPA server 120: # peerdef string default lonHostID of remote server 121: # CRLFile Full path name to the certificate 122: # revocation list file for the cluster 123: # to which server belongs (optional) 124: 125: # Returns 126: # - Reference to an SSL socket on success 127: # - undef on failure. Reason for failure can be interrogated from 128: # IO::Socket::SSL 129: # Side effects: socket is left in blocking mode!! 130: # 131: 132: sub PromoteClientSocket { 133: my ($PlaintextSocket, 134: $CACert, 135: $MyCert, 136: $KeyFile, 137: $peer, 138: $peerdef, 139: $CRLFile) = @_; 140: 141: Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert, CRL: $CRLFile, Remote Host: $peer\n"); 142: 143: # To create the ssl socket we need to duplicate the existing 144: # socket. Otherwise closing the ssl socket will close the plaintext socket 145: # too. We also must flip into blocking mode for the duration of the 146: # ssl negotiation phase.. the caller will have to flip to non block if 147: # that's what they want 148: 149: my $oldflags = SetFdBlocking($PlaintextSocket); 150: my $dupfno = fcntl($PlaintextSocket, F_DUPFD, 0); 151: Debug("Client promotion got dup = $dupfno\n"); 152: 153: # Starting with IO::Socket::SSL rev. 1.79, carp warns that a verify 154: # mode of SSL_VERIFY_NONE should be explicitly set for client, if 155: # verification is not to be used, and SSL_verify_mode is not set. 156: # Starting with rev. 1.95, the default became SSL_VERIFY_PEER which 157: # prevents an SSL connection to lond unless SSL_verifycn_name is set 158: # to the lonHostID of the remote host, (and the remote certificate has 159: # the remote lonHostID as CN, and has been signed by the LON-CAPA CA. 160: # Set SSL_verify_mode to Net::SSLeay::VERIFY_PEER() instead of to 161: # SSL_VERIFY_PEER for compatibility with IO::Socket::SSL rev. 1.01 162: # used by CentOS/RHEL/Scientific Linux 5). 163: 164: my $verify_cn = $peerdef; 165: if ($verify_cn eq '') { 166: $verify_cn = $peer; 167: } 168: 169: my %sslargs = (SSL_use_cert => 1, 170: SSL_key_file => $KeyFile, 171: SSL_cert_file => $MyCert, 172: SSL_ca_file => $CACert, 173: SSL_verifycn_name => $verify_cn, 174: SSL_verify_mode => Net::SSLeay::VERIFY_PEER()); 175: if (($CRLFile ne '') && (-e $CRLFile)) { 176: $sslargs{SSL_check_crl} = 1; 177: $sslargs{SSL_crl_file} = $CRLFile; 178: } 179: my $client = IO::Socket::SSL->new_from_fd($dupfno,%sslargs); 180: if(!$client) { 181: if ($IO::Socket::SSL::SSL_ERROR == -1) { 182: $lasterror = -1; 183: } 184: return undef; 185: } 186: return $client; # Undef if the client negotiation fails. 187: } 188: 189: #---------------------------------------------------------------------- 190: # Name PromoteServerSocket 191: # Description Given an ordinary IO::Socket::INET Creates an SSL socket 192: # for a server that is connected to the same client. 193: # Parameters Name Type Description 194: # Socket IO::Socket::INET Original ordinary socket. 195: # CACert string Full path name to the certificate 196: # authority certificate file. 197: # MyCert string Full path name to the certificate 198: # issued to this host. 199: # KeyFile string Full pathname to the host's private 200: # key file for the certificate. 201: # peer string lonHostID of remote LON-CAPA client 202: # CRLFile Full path name to the certificate 203: # revocation list file for the cluster 204: # to which server belongs (optional) 205: # clientversion LON-CAPA version running on remote 206: # client 207: # Returns 208: # - Reference to an SSL socket on success 209: # - undef on failure. Reason for failure can be interrogated from 210: # IO::Socket::SSL 211: # Side Effects: 212: # Socket is left in blocking mode!!! 213: # 214: sub PromoteServerSocket { 215: my ($PlaintextSocket, 216: $CACert, 217: $MyCert, 218: $KeyFile, 219: $peer, 220: $CRLFile, 221: $clientversion) = @_; 222: 223: # To create the ssl socket we need to duplicate the existing 224: # socket. Otherwise closing the ssl socket will close the plaintext socket 225: # too: 226: 227: Debug("Server promotion: Key = $KeyFile, Cert $MyCert CA $CACert\n"); 228: 229: my $oldflags = SetFdBlocking($PlaintextSocket); 230: my $dupfno = fcntl($PlaintextSocket, F_DUPFD, 0); 231: if (!$dupfno) { 232: Debug("dup failed: $!\n"); 233: } 234: Debug(" Fileno = $dupfno\n"); 235: my %sslargs = (SSL_server => 1, # Server role. 236: SSL_use_cert => 1, 237: SSL_key_file => $KeyFile, 238: SSL_cert_file => $MyCert, 239: SSL_ca_file => $CACert); 240: my ($major,$minor) = split(/\./,$clientversion); 241: if (($major < 2) || ($major == 2 && $minor < 12)) { 242: $sslargs{SSL_verify_mode} = Net::SSLeay::VERIFY_NONE(); 243: } else { 244: $sslargs{SSL_verifycn_name} = $peer; 245: $sslargs{SSL_verify_mode} = Net::SSLeay::VERIFY_PEER(); 246: if (($CRLFile ne '') && (-e $CRLFile)) { 247: $sslargs{SSL_check_crl} = 1; 248: $sslargs{SSL_crl_file} = $CRLFile; 249: } 250: } 251: my $client = IO::Socket::SSL->new_from_fd($dupfno,%sslargs); 252: if(!$client) { 253: if ($IO::Socket::SSL::SSL_ERROR == -1) { 254: $lasterror = -1; 255: } 256: return undef; 257: } 258: return $client; 259: } 260: 261: #------------------------------------------------------------------------- 262: # 263: # Name: Close 264: # Description: Properly closes an ssl client or ssl server socket in 265: # a way that keeps the parent socket open. 266: # Parameters: Name Type Description 267: # Socket IO::Socket::SSL SSL Socket gotten from either 268: # PromoteClientSocket or 269: # PromoteServerSocket 270: # Returns: 271: # NONE 272: # 273: sub Close { 274: my $Socket = shift; 275: 276: $Socket->close(SSL_no_shutdown =>1); # Otherwise the parent socket 277: # gets torn down. 278: } 279: #--------------------------------------------------------------------------- 280: # 281: # Name GetPeerCertificate 282: # Description Inquires about the certificate of the peer of a connection. 283: # Parameters Name Type Description 284: # SSLSocket IO::Socket::SSL SSL tunnel socket open on 285: # the peer. 286: # Returns 287: # A two element list. The first element of the list is the name of 288: # the certificate authority. The second element of the list is the name 289: # of the owner of the certificate. 290: sub GetPeerCertificate { 291: my $SSLSocket = shift; 292: 293: my $CertOwner = $SSLSocket->peer_certificate("owner"); 294: my $CertCA = $SSLSocket->peer_certificate("authority"); 295: 296: return ($CertCA, $CertOwner); 297: } 298: #---------------------------------------------------------------------------- 299: # 300: # Name CertificateFile 301: # Description Locate the certificate files for this host. 302: # Returns 303: # Returns a two element array. The first element contains the name of 304: # the certificate file for this host. The second element contains the name 305: # of the certificate file for the CA that granted the certificate. If 306: # either file cannot be located, returns undef. 307: # 308: sub CertificateFile { 309: 310: # I need some perl variables from the configuration file for this: 311: 312: my $CertificateDir = $perlvar->{lonCertificateDirectory}; 313: my $CaFilename = $perlvar->{lonnetCertificateAuthority}; 314: my $CertFilename = $perlvar->{lonnetCertificate}; 315: 316: # Ensure the existence of these variables: 317: 318: if((!$CertificateDir) || (!$CaFilename) || (!$CertFilename)) { 319: $lasterror = "Missing info: dir: $CertificateDir CA: $CaFilename " 320: ."Cert: $CertFilename"; 321: return undef; 322: } 323: 324: # Build the actual filenames and check for their existence and 325: # readability. 326: 327: $CaFilename = $CertificateDir.$pathsep.$CaFilename; 328: $CertFilename = $CertificateDir.$pathsep.$CertFilename; 329: 330: if((! -r $CaFilename) || (! -r $CertFilename)) { 331: $lasterror = "CA file $CaFilename or Cert File: $CertFilename " 332: ."not readable"; 333: return undef; 334: } 335: 336: # Everything works fine!! 337: 338: return ($CaFilename, $CertFilename); 339: 340: } 341: #------------------------------------------------------------------------ 342: # 343: # Name KeyFile 344: # Description 345: # Returns the name of the private key file of the current host. 346: # Returns 347: # Returns the name of the key file or undef if the file cannot 348: # be found. 349: # 350: sub KeyFile { 351: 352: # I need some perl variables from the configuration file for this: 353: 354: my $CertificateDir = $perlvar->{lonCertificateDirectory}; 355: my $KeyFilename = $perlvar->{lonnetPrivateKey}; 356: 357: # Ensure the variables exist: 358: 359: if((!$CertificateDir) || (!$KeyFilename)) { 360: $lasterror = "Missing parameter dir: $CertificateDir " 361: ."key: $KeyFilename"; 362: return undef; 363: } 364: 365: # Build the actual filename and ensure that it not only exists but 366: # is also readable: 367: 368: $KeyFilename = $CertificateDir.$pathsep.$KeyFilename; 369: if(! (-r $KeyFilename)) { 370: $lasterror = "Unreadable key file $KeyFilename"; 371: return undef; 372: } 373: 374: return $KeyFilename; 375: } 376: 377: sub CRLFile { 378: 379: # I need some perl variables from the configuration file for this: 380: 381: my $CertificateDir = $perlvar->{lonCertificateDirectory}; 382: my $CRLFilename = $perlvar->{lonnetCertRevocationList}; 383: 384: # Ensure the variables exist: 385: 386: if((!$CertificateDir) || (!$CRLFilename)) { 387: $lasterror = "Missing parameter dir: $CertificateDir " 388: ."CRL file: $CRLFilename"; 389: return undef; 390: } 391: 392: # Build the actual filename and ensure that it not only exists but 393: # is also readable: 394: 395: $CRLFilename = $CertificateDir.$pathsep.$CRLFilename; 396: if(! (-r $CRLFilename)) { 397: $lasterror = "Unreadable key file $CRLFilename"; 398: return undef; 399: } 400: 401: return $CRLFilename; 402: } 403: 404: sub BadCertDir { 405: my $SocketDir = $perlvar->{lonSockDir}; 406: if (-d "$SocketDir/nosslverify/") { 407: return "$SocketDir/nosslverify" 408: } 409: } 410: 411: sub has_badcert_file { 412: my ($client) = @_; 413: my $SocketDir = $perlvar->{lonSockDir}; 414: if (-e "$SocketDir/nosslverify/$client") { 415: return 1; 416: } 417: return; 418: } 419: 420: sub Read_Connect_Config { 421: my ($secureconf,$perlvarref) = @_; 422: return unless (ref($secureconf) eq 'HASH'); 423: 424: unless (ref($perlvarref) eq 'HASH') { 425: $perlvarref = $perlvar; 426: } 427: 428: # Clean out the old table first. 429: foreach my $key (keys(%{$secureconf})) { 430: delete($secureconf->{$key}); 431: } 432: 433: my $result; 434: my $tablename = $perlvarref->{'lonTabDir'}."/connectionrules.tab"; 435: if (open(my $fh,'<',$tablename)) { 436: while (my $line = <$fh>) { 437: chomp($line); 438: my ($name,$value) = split(/=/,$line); 439: if ($value =~ /^(?:no|yes|req)$/) { 440: if ($name =~ /^conn(to|from)_(dom|intdom|other)$/) { 441: $secureconf->{'conn'.$1}{$2} = $value; 442: } 443: } 444: } 445: close($fh); 446: return 'ok'; 447: } 448: return; 449: } 450: 451: sub Read_Host_Types { 452: my ($hosttypes,$perlvarref) = @_; 453: return unless (ref($hosttypes) eq 'HASH'); 454: 455: unless (ref($perlvarref) eq 'HASH') { 456: $perlvarref = $perlvar; 457: } 458: 459: # Clean out the old table first. 460: foreach my $key (keys(%{$hosttypes})) { 461: delete($hosttypes->{$key}); 462: } 463: 464: my $result; 465: my $tablename = $perlvarref->{'lonTabDir'}."/hosttypes.tab"; 466: if (open(my $fh,'<',$tablename)) { 467: while (my $line = <$fh>) { 468: chomp($line); 469: my ($name,$value) = split(/:/,$line); 470: if (($name ne '') && ($value =~ /^(dom|intdom|other)$/)) { 471: $hosttypes->{$name} = $value; 472: } 473: } 474: close($fh); 475: return 'ok'; 476: } 477: return; 478: } 479: 480: 1;