[LON-CAPA-cvs] cvs: modules /raeburn/register Session.pm
raeburn
raeburn at source.lon-capa.org
Tue Mar 14 16:41:27 EDT 2017
raeburn Tue Mar 14 20:41:27 2017 EDT
Modified files:
/modules/raeburn/register Session.pm
Log:
- satisfy w3c validation
- switch to Apache2/mod_perl2 calls
- cookie protection
- support Apache 2.4
- use Digest::MD5() instead of MD5()
- use Authen::Krb5::Simple for Kerberos 5 authentication (MSUNetIDs)
-------------- next part --------------
Index: modules/raeburn/register/Session.pm
diff -u modules/raeburn/register/Session.pm:1.7 modules/raeburn/register/Session.pm:1.8
--- modules/raeburn/register/Session.pm:1.7 Mon Mar 11 02:23:14 2013
+++ modules/raeburn/register/Session.pm Tue Mar 14 20:41:27 2017
@@ -1,21 +1,25 @@
package Apache::LON::Session;
-# $Id: Session.pm,v 1.7 2013/03/11 02:23:14 raeburn Exp $
+# $Id: Session.pm,v 1.8 2017/03/14 20:41:27 raeburn Exp $
use strict;
-use Apache::RequestRec();
-use Apache::RequestIO();
+use Apache2::RequestRec();
+use Apache2::RequestIO();
+use Apache2::Response();
+use Apache2::Access();
+use Apache2::Connection ();
+use Apache2::Const qw(OK DECLINED SERVER_ERROR FORBIDDEN);
use DBI;
use Storable qw(store retrieve dclone);
-use MD5;
+use Digest::MD5;
use Crypt::PasswdMD5;
use Crypt::CBC;
use FileHandle;
use HTTP::Request;
use LWP::UserAgent;
+use Authen::Krb5::Simple;
use Apache::LON::processform;
-use Apache::Const qw(OK DECLINED SERVER_ERROR FORBIDDEN);
use Apache::Session::MySQL;
use CGI::Cookie;
use Crypt::DES;
@@ -38,8 +42,8 @@
$r->custom_response(FORBIDDEN, $login);
# return OK unless $r->is_initial_req;
- my $auth_type = $r->auth_type;
- my $auth_name = $r->auth_name; #Auth Name is LONCAPAID
+ my $auth_type = $r->ap_auth_type();
+ my $auth_name = $r->auth_name(); #Auth Name is LONCAPAID
my $cookie; # cookie to send to client
my $dbpwd; # get db credentials
@@ -60,15 +64,14 @@
# connect to database
my $dbh = DBI->connect($attr{data_source}, $attr{username},
- $attr{password});
+ $attr{password});
unless ($dbh) {
return SERVER_ERROR;
}
# Try to get the authentication cookie.
- my %headers = $r->headers_in;
- my %cookiejar = CGI::Cookie->parse($r->header_in('Cookie'));
+ my (%cookiejar) = CGI::Cookie->parse($r->headers_in->{Cookie});
unless($cookiejar{$auth_name}) {
¬e_cookie_auth_failure($r);
$dbh->disconnect;
@@ -108,17 +111,18 @@
if ($sess_entry eq $sess_id) {
my ($sess_ref,$sess_chk) = &expirationchk($r,$dbh,\%attr,$sess_id);
if ($sess_chk == 1) {
+ my $username;
if (defined $sess_ref) {
- my $username = $sess_ref->attr("user_id");
- $r->connection->user("$username");
- $r->connection->auth_type($auth_type);
+ $username = $sess_ref->attr("user_id");
+ $r->user("$username");
+ $r->ap_auth_type($auth_type);
$r->notes->set('_AUTHFAIL' => 0);
} else {
my $sess_quoted = $dbh->quote( $sess_id );
- my $username = $dbh->selectrow_array("SELECT user_id FROM loncapa_sessions WHERE id = $sess_quoted ");
+ $username = $dbh->selectrow_array("SELECT user_id FROM loncapa_sessions WHERE id = $sess_quoted ");
unless ($username eq '') {
- $r->connection->user("$username");
- $r->connection->auth_type($auth_type);
+ $r->user("$username");
+ $r->ap_auth_type($auth_type);
$r->notes->set('_AUTHFAIL' => 0);
}
}
@@ -141,6 +145,7 @@
$r->notes->set('_AUTHFAIL' => 0);
}
}
+ $r->user("$user");
}
if (!$failflag) {
if (keys(%auth_cookie) > 0) {
@@ -148,9 +153,10 @@
-name => $r->auth_name,
-value => \%auth_cookie,
-path => '/',
+ -httponly => 1,
+ -secure => 1,
);
- $r->headers_out->{'Set-cookie'} = $new_auth_cookie;
- $r->err_headers_out->{'Set-cookie'} = $new_auth_cookie;
+ $r->err_headers_out->add('Set-cookie' => $new_auth_cookie);
}
}
$dbh->disconnect;
@@ -174,8 +180,8 @@
$sth->finish;
$r->notes->set('_SESSCOOK' => $sess_id);
$r->notes->set('_AUTHFAIL' => 0);
- $r->connection->user($user);
- $r->connection->auth_type($r->auth_type);
+ $r->user($user);
+ $r->ap_auth_type($r->auth_type);
$newsess = 1;
} else {
$r->notes->set('_RejectAuth' => "Server Error - session creation failed");
@@ -226,7 +232,7 @@
&Apache::LON::processform::postitems($r,\%post_data);
&Apache::LON::processform::getitems($r->args,\%query_str);
my @list = keys %post_data;
- my $token = MD5->hexhash(MD5->hexhash(time.{}.rand().$$));
+ my $token = Digest::MD5->md5_hex(Digest::MD5->md5_hex(time.{}.rand().$$));
if (@list) {
my ($tempHash,$hashid);
foreach (@list) {
@@ -254,8 +260,10 @@
-name => $r->auth_name,
-value => { uri => $caller },
-path => '/'
+ -httponly => 1,
+ -secure => 1,
);
- $r->err_headers_out->{'Set-cookie'} = $auth_cookie;
+ $r->err_headers_out->add('Set-cookie' => $auth_cookie);
}
sub opensession () {
@@ -417,7 +425,7 @@
}
sub authenticate {
- my ($r,$dbh,$user_sent, $passwd_sent,$authtype,$authinfo) = @_;
+ my ($r,$dbh,$user_sent,$passwd_sent,$authtype,$authinfo) = @_;
my $authflag = 0;
if ($authtype eq 'support') {
my $user_sent_quoted = $dbh->quote($user_sent);
@@ -448,8 +456,8 @@
my $keyphrase = <$fh>;
close($fh);
my $udom = $authinfo;
- my $response = &loncapa_auth($user_sent,$passwd_sent,$udom,$keyphrase);
- if ($response eq 'no_host') {
+ my $response = &loncapa_auth($user_sent,$passwd_sent,$udom,$keyphrase,$dbh);
+ if (($response eq 'no_host') || ($response eq '0')) {
$r->notes->set('_RejectAuth' => "Invalid LON-CAPA username and password for domain: $udom");
$authflag = 0;
} else {
@@ -460,12 +468,11 @@
}
} elsif ($authtype eq 'msunet') {
my $response;
- if ($user_sent =~ /^\w{2,8}$/) {
- open(PIPE,"-|") || exec "/home/helpdesk/bin/authkerb.pl",$user_sent,$passwd_sent;
- $response = <PIPE>;
- close PIPE;
+ if ($user_sent =~ /^\w{2,8}$/) {
+ my $null = pack("C",0);
+ $response = &krb5_authen($passwd_sent,$null,$user_sent,'MSU.EDU');
}
- if ($response eq 'ok') {
+ if ($response == 1) {
$authflag = 1;
} else {
$r->notes->set('_RejectAuth' => "Invalid MSUNet ID or password");
@@ -480,7 +487,7 @@
my $cipher = Crypt::CBC->new( {'key' => $keyphrase,
'cipher' => 'DES'});
my $ciphertext = $cipher->encrypt_hex($passwd);
- my $URL = "http://s10.lite.msu.edu/cgi-bin/check_auth.pl";
+ my $URL = "https://s10.lite.msu.edu/cgi-bin/check_auth.pl";
my $request = HTTP::Request->new(POST => $URL);
$request->content_type('application/x-www-form-urlencoded');
$request->content('action=authenticate&username='.$user.'&domain='.$domain.'&key='.$ciphertext);
@@ -493,4 +500,19 @@
}
}
+sub krb5_authen {
+ my ($password,$null,$user,$contentpwd) = @_;
+ my $validated = 0;
+ if(!($password =~ /$null/)) { # Null password not allowed.
+ my $krb = Authen::Krb5::Simple->new();
+ $krb->realm($contentpwd);
+ if ($krb->authenticate($user,$password)) {
+ $validated = 1;
+ } else {
+ print STDERR "errcode is ||".$krb->errcode()."|| and errstr is ||".$krb->errstr()."||\n";
+ }
+ }
+ return $validated;
+}
+
1;
More information about the LON-CAPA-cvs
mailing list