version 1.136, 2014/12/05 12:03:20
|
version 1.140, 2016/04/02 04:31:33
|
Line 29
|
Line 29
|
package Apache::lonauth;
|
package Apache::lonauth;
|
|
|
use strict;
|
use strict;
|
use LONCAPA;
|
use LONCAPA qw(:DEFAULT :match);
|
use Apache::Constants qw(:common);
|
use Apache::Constants qw(:common);
|
use CGI qw(:standard);
|
use CGI qw(:standard);
|
use DynaLoader; # for Crypt::DES version
|
use DynaLoader; # for Crypt::DES version
|
Line 103 sub success {
|
Line 103 sub success {
|
if ($destsymb =~ /___/) {
|
if ($destsymb =~ /___/) {
|
# FIXME Need to deal with encrypted symbs and urls as needed.
|
# FIXME Need to deal with encrypted symbs and urls as needed.
|
my ($map,$resid,$desturl)=split(/___/,$destsymb);
|
my ($map,$resid,$desturl)=split(/___/,$destsymb);
|
unless ($desturl=~/^(adm|editupload|public)/) {
|
$desturl = &Apache::lonnet::clutter($desturl);
|
$desturl = &Apache::lonnet::clutter($desturl);
|
|
}
|
|
$desturl = &HTML::Entities::encode($desturl,'"<>&');
|
$desturl = &HTML::Entities::encode($desturl,'"<>&');
|
$destsymb = &HTML::Entities::encode($destsymb,'"<>&');
|
$destsymb = &HTML::Entities::encode($destsymb,'"<>&');
|
$destination .= 'destinationurl='.$desturl.
|
$destination .= 'destinationurl='.$desturl.
|
Line 124 sub success {
|
Line 122 sub success {
|
my $header = '<meta HTTP-EQUIV="Refresh" CONTENT="0; url='.$destination.'" />';
|
my $header = '<meta HTTP-EQUIV="Refresh" CONTENT="0; url='.$destination.'" />';
|
my $brcrum = [{'href' => '',
|
my $brcrum = [{'href' => '',
|
'text' => 'Successful Login'},];
|
'text' => 'Successful Login'},];
|
|
my $args = {'bread_crumbs' => $brcrum,};
|
|
unless ((defined($form->{role})) || (defined($form->{symb}))) {
|
|
my $update=$env{'user.update.time'};
|
|
if (!$update) {
|
|
$update = $env{'user.login.time'};
|
|
}
|
|
my %roles_in_env;
|
|
my $showcount = &Apache::lonroles::roles_from_env(\%roles_in_env,$update);
|
|
if ($showcount == 1) {
|
|
foreach my $rolecode (keys(%roles_in_env)) {
|
|
my ($cid) = ($rolecode =~ m{^\Quser.role.st./\E($match_domain/$match_courseid)(?:/|$)});
|
|
if ($cid) {
|
|
my %coursedescription =
|
|
&Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
|
|
if ($coursedescription{'type'} eq 'Placement') {
|
|
$args->{'crstype'} = 'Placement';
|
|
}
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
my $start_page=&Apache::loncommon::start_page('Successful Login',
|
my $start_page=&Apache::loncommon::start_page('Successful Login',
|
$header,
|
$header,$args);
|
{'bread_crumbs' => $brcrum,});
|
|
my $end_page =&Apache::loncommon::end_page();
|
my $end_page =&Apache::loncommon::end_page();
|
|
|
my $continuelink='<a href="'.$destination.'">'.&mt('Continue').'</a>';
|
my $continuelink='<a href="'.$destination.'">'.&mt('Continue').'</a>';
|
Line 309 sub handler {
|
Line 328 sub handler {
|
my $tmpinfo=Apache::lonnet::reply('tmpget:'.$form{'logtoken'},
|
my $tmpinfo=Apache::lonnet::reply('tmpget:'.$form{'logtoken'},
|
$form{'serverid'});
|
$form{'serverid'});
|
|
|
my %sessiondata;
|
|
if ($form{'iptoken'}) {
|
|
%sessiondata = &Apache::lonnet::tmpget($form{'iptoken'});
|
|
my $delete = &Apache::lonnet::tmpdel($form{'iptoken'});
|
|
}
|
|
|
|
if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost') ||
|
if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost') ||
|
($tmpinfo eq 'no_such_host')) {
|
($tmpinfo eq 'no_such_host')) {
|
&failed($r,'Information needed to verify your login information is missing, inaccessible or expired.',\%form);
|
&failed($r,'Information needed to verify your login information is missing, inaccessible or expired.',\%form);
|
Line 334 sub handler {
|
Line 347 sub handler {
|
return OK;
|
return OK;
|
}
|
}
|
|
|
my ($key,$firsturl,$rolestr,$symbstr)=split(/&/,$tmpinfo);
|
my ($key,$firsturl,$rolestr,$symbstr,$iptokenstr)=split(/&/,$tmpinfo);
|
if ($rolestr) {
|
if ($rolestr) {
|
$rolestr = &unescape($rolestr);
|
$rolestr = &unescape($rolestr);
|
}
|
}
|
if ($symbstr) {
|
if ($symbstr) {
|
$symbstr= &unescape($symbstr);
|
$symbstr= &unescape($symbstr);
|
}
|
}
|
|
if ($iptokenstr) {
|
|
$iptokenstr = &unescape($iptokenstr);
|
|
}
|
if ($rolestr =~ /^role=/) {
|
if ($rolestr =~ /^role=/) {
|
(undef,$form{'role'}) = split('=',$rolestr);
|
(undef,$form{'role'}) = split('=',$rolestr);
|
}
|
}
|
if ($symbstr =~ /^symb=/) {
|
if ($symbstr =~ /^symb=/) {
|
(undef,$form{'symb'}) = split('=',$symbstr);
|
(undef,$form{'symb'}) = split('=',$symbstr);
|
}
|
}
|
|
if ($iptokenstr =~ /^iptoken=/) {
|
|
(undef,$form{'iptoken'}) = split('=',$iptokenstr);
|
|
}
|
|
|
my $upass = $ENV{HTTPS} ? join("", @form{qw(upass0 upass1 upass2)})
|
my $upass = $ENV{HTTPS} ? $form{'upass0'}
|
: decrypt($key, @form{qw(upass0 upass1 upass2)});
|
: &Apache::loncommon::des_decrypt($key,$form{'upass0'});
|
|
|
# ---------------------------------------------------------------- Authenticate
|
# ---------------------------------------------------------------- Authenticate
|
|
|
Line 412 sub handler {
|
Line 431 sub handler {
|
|
|
my $hosthere;
|
my $hosthere;
|
if ($form{'iptoken'}) {
|
if ($form{'iptoken'}) {
|
|
my %sessiondata = &Apache::lonnet::tmpget($form{'iptoken'});
|
|
my $delete = &Apache::lonnet::tmpdel($form{'iptoken'});
|
if (($sessiondata{'domain'} eq $form{'udom'}) &&
|
if (($sessiondata{'domain'} eq $form{'udom'}) &&
|
($sessiondata{'username'} eq $form{'uname'})) {
|
($sessiondata{'username'} eq $form{'uname'})) {
|
$hosthere = 1;
|
$hosthere = 1;
|
Line 525 sub handler {
|
Line 546 sub handler {
|
}
|
}
|
}
|
}
|
|
|
sub decrypt {
|
|
my ($key, @chunks) = @_;
|
|
|
|
my $keybin = pack("H16",$key);
|
|
|
|
my $cipher;
|
|
if ($Crypt::DES::VERSION >= 2.03) {
|
|
$cipher = new Crypt::DES $keybin;
|
|
} else {
|
|
$cipher = new DES $keybin;
|
|
}
|
|
|
|
my $upass='';
|
|
for (my $i=0;$i<=2;$i++) {
|
|
my $chunk =
|
|
$cipher->decrypt(
|
|
unpack("a8",pack("H16",substr($chunks[$i],0,16))));
|
|
|
|
$chunk .=
|
|
$cipher->decrypt(
|
|
unpack("a8",pack("H16",substr($chunks[$i],16,16))));
|
|
|
|
$chunk = substr($chunk,1,ord(substr($chunk,0,1)));
|
|
$upass .= $chunk;
|
|
}
|
|
return $upass;
|
|
}
|
|
|
|
sub check_can_host {
|
sub check_can_host {
|
my ($r,$form,$authhost,$domdesc) = @_;
|
my ($r,$form,$authhost,$domdesc) = @_;
|
return unless (ref($form) eq 'HASH');
|
return unless (ref($form) eq 'HASH');
|