File:
[LON-CAPA] /
loncom /
lonlocal.pm
Revision
1.7:
download - view:
text,
annotated -
select for diffs
Fri Sep 17 03:00:42 2004 UTC (20 years, 3 months ago) by
albertel
Branches:
MAIN
CVS tags:
version_2_9_X,
version_2_9_99_0,
version_2_9_1,
version_2_9_0,
version_2_8_X,
version_2_8_99_1,
version_2_8_99_0,
version_2_8_2,
version_2_8_1,
version_2_8_0,
version_2_7_X,
version_2_7_99_1,
version_2_7_99_0,
version_2_7_1,
version_2_7_0,
version_2_6_X,
version_2_6_99_1,
version_2_6_99_0,
version_2_6_3,
version_2_6_2,
version_2_6_1,
version_2_6_0,
version_2_5_X,
version_2_5_99_1,
version_2_5_99_0,
version_2_5_2,
version_2_5_1,
version_2_5_0,
version_2_4_X,
version_2_4_99_0,
version_2_4_2,
version_2_4_1,
version_2_4_0,
version_2_3_X,
version_2_3_99_0,
version_2_3_2,
version_2_3_1,
version_2_3_0,
version_2_2_X,
version_2_2_99_1,
version_2_2_99_0,
version_2_2_2,
version_2_2_1,
version_2_2_0,
version_2_1_X,
version_2_1_99_3,
version_2_1_99_2,
version_2_1_99_1,
version_2_1_99_0,
version_2_1_3,
version_2_1_2,
version_2_1_1,
version_2_1_0,
version_2_12_X,
version_2_11_X,
version_2_11_5_msu,
version_2_11_5,
version_2_11_4_uiuc,
version_2_11_4_msu,
version_2_11_4,
version_2_11_3_uiuc,
version_2_11_3_msu,
version_2_11_3,
version_2_11_2_uiuc,
version_2_11_2_msu,
version_2_11_2_educog,
version_2_11_2,
version_2_11_1,
version_2_11_0_RC3,
version_2_11_0_RC2,
version_2_11_0_RC1,
version_2_11_0,
version_2_10_X,
version_2_10_1,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
version_2_0_X,
version_2_0_99_1,
version_2_0_2,
version_2_0_1,
version_2_0_0,
version_1_99_3,
version_1_99_2,
version_1_99_1_tmcc,
version_1_99_1,
version_1_99_0_tmcc,
version_1_99_0,
version_1_3_X,
version_1_3_3,
version_1_3_2,
version_1_3_1,
version_1_3_0,
version_1_2_X,
version_1_2_99_1,
version_1_2_99_0,
version_1_2_1,
loncapaMITrelate_1,
language_hyphenation_merge,
language_hyphenation,
bz6209-base,
bz6209,
bz5969,
bz2851,
PRINT_INCOMPLETE_base,
PRINT_INCOMPLETE,
HEAD,
GCI_3,
GCI_2,
GCI_1,
BZ5971-printing-apage,
BZ5434-fox,
BZ4492-merge,
BZ4492-feature_horizontal_radioresponse,
BZ4492-feature_Support_horizontal_radioresponse,
BZ4492-Support_horizontal_radioresponse
- stop the log spew
#
# $Id: lonlocal.pm,v 1.7 2004/09/17 03:00:42 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
package lonlocal;
#
# Module that provides support for local connections between secure
# lonc and secure lond.
#
# A local connection exchanges one-time session keys through a
# file that is written in the certificate directory by lonc and
# read/deleted by lond. The file is created with permissions
# rw------- (0600) to prevent it from being snooped unless the system
# itself has been broken. In addition the file will not be around
# for very long so it will be hard to find.
#
use strict;
# CPAN/standard modules
use Crypt::IDEA;
use Fcntl;
# LONCAPA modules
use LONCAPA::Configuration;
# Global variables:
my $perlvar; # Refers to the apache perlsetvar hash.
my $pathsep = "/"; # Unix path seperator
my $fileindex = 0; # Per process lonc uniquifier.
my $lastError; # Reason for last failure.
# Debugging:
my $DEBUG = 0;
sub Debug {
my $msg = shift;
if ($DEBUG) { print STDERR "$msg\n"; }
}
# Initialization
$perlvar = LONCAPA::Configuration::read_conf('loncapa.conf');
#------------------------------------------------------------------------
#
# Name CreateCipherKey
# Description: Create an encryption key.
# Returns: The key.
#
sub CreateCipherKey {
my $keylength;
my $binaryKey;
my $cipherkey;
# we'll use the output of /dev/urandom to produce our key.
# On a system with decent entropy, this ought to be much more
# random than all the playing that used to be done to get a key.
# On a system with not so decent entropy we'll still get an ok key.
# My concern with /dev/random is that we may block for an indefinite
# time period...where for us decent keys are probably good enough.
$keylength = IDEA::keysize();
open(RANDOM, "</dev/urandom");
sysread(RANDOM, $binaryKey, $keylength);
close RANDOM;
# The key must be returned in a stringified form in order to be
# transmitted to the peer:
my $hexdigits = $keylength*2; # Assume 8 bits/byte.
my $template = "H".$hexdigits;
$cipherkey = unpack($template, $binaryKey);
return $cipherkey;
}
#------------------------------------------------------------------------
#
# Name CreateKeyFile
# Description Creates a private key file and writes an IDEA key into it.
#
# Returns
# A two element list containing:
# - The private key that was created
# - The full path to the file that contains it.
# or undef on failure.
sub CreateKeyFile {
# To create the file we need some perlvars to tell us where the
# certificate directory. We'll make a file named localkey.$pid
# there, and set the mode before writing into it.
#
$fileindex++;
my $CertificateDir = $perlvar->{lonCertificateDirectory};
my $Filename = $CertificateDir.$pathsep.".$fileindex.".$$;
# If this file already exists, this is a recoverable error... we just
# delete the earlier incarnation of the file.
if (-w $Filename) {
unlink $Filename;
}
# If the file still exists this is really really bad:
# It most likely means someone has been devious enough to drop a key file
# in place to attemp to spoof the lond. We'll fail in that case hoping
# that the user looks at the log to figure out that local connections
# are failing.
if( -e $Filename) {
$lastError = "Key file already exists after deletion probably a spoof!";
return undef;
}
# Now we can create the file we use sysopen in order to ensure
# the file is created with the appropriate locked down permissions.
if(! sysopen(KEYFILE, $Filename, O_CREAT | O_EXCL | O_WRONLY, 0600)) {
$lastError = "Creation of key file failed ".$!;
return undef;
}
# Create the key, write it to the file and close the file:
my $key = CreateCipherKey();
print KEYFILE "$key\n";
close KEYFILE;
return ($key, $Filename);
}
# Name ReadKeyFile
# Description Opens the private local key file and reads the IDEA key from it.
# Parameters
# Name Type Description
# Filename string path to key file
#
# NOTE:
# Reading the keyfile is a one-time thing. This sub destroys the
# keyfile after reading it to ensure the one-timedness of the keys they
# contain!!
# Returns
# On success the IDEA key that was written into the key fileon failure undef.
#
#
sub ReadKeyFile {
my $Filename = shift;
Debug("ReadKeyFile: $Filename");
if(! open(KEYFILE, "<$Filename")) {
Debug(" Open of $Filename failed\n");
$lastError = "Key file open failed";
return undef
}
my $key = <KEYFILE>;
chomp($key);
Debug(" Read key: $key");
close KEYFILE;
unlink $Filename;
#
# If the filename still exists some spoofer wrote it with the wrong
# permissions:
#
if(-e $Filename) {
Debug("File did not get deleted");
$lastError = "Key file still exists after unlink";
return undef;
}
#
# The IDEA key must be IDEA::keysize*2 characters
# long. If it isn't probably someone's trying to break us by
# hitting the timing hole between the file write and read...
# replacing our file... of course if they read this comment they'll
# be too smart to put an incorrectly sized file
#
my $keylen = length($key);
my $rightlen= IDEA::keysize()*2;
if($keylen != $rightlen) {
Debug("Key is incorrect length is $keylen sb $rightlen");
$lastError = "Key file has incorrect length";
return undef;
}
Debug("Returning key: $key to caller");
return $key;
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>