version 1.505, 2014/01/01 17:41:37
|
version 1.522, 2016/05/30 03:16:38
|
Line 55 use LONCAPA::lonssl;
|
Line 55 use LONCAPA::lonssl;
|
use Fcntl qw(:flock); |
use Fcntl qw(:flock); |
use Apache::lonnet; |
use Apache::lonnet; |
use Mail::Send; |
use Mail::Send; |
|
use Crypt::Eksblowfish::Bcrypt; |
|
use Digest::SHA; |
|
use Encode; |
|
|
my $DEBUG = 0; # Non zero to enable debug log entries. |
my $DEBUG = 0; # Non zero to enable debug log entries. |
|
|
Line 621 sub ConfigFileFromSelector {
|
Line 624 sub ConfigFileFromSelector {
|
# String to send to client ("ok" or "refused" if bad file). |
# String to send to client ("ok" or "refused" if bad file). |
# |
# |
sub PushFile { |
sub PushFile { |
my $request = shift; |
my $request = shift; |
my ($command, $filename, $contents) = split(":", $request, 3); |
my ($command, $filename, $contents) = split(":", $request, 3); |
&Debug("PushFile"); |
&Debug("PushFile"); |
|
|
Line 651 sub PushFile {
|
Line 654 sub PushFile {
|
|
|
if($filename eq "host") { |
if($filename eq "host") { |
$contents = AdjustHostContents($contents); |
$contents = AdjustHostContents($contents); |
|
} elsif ($filename eq 'dns_host' || $filename eq 'dns_domain') { |
|
if ($contents eq '') { |
|
&logthis('<font color="red"> Pushfile: unable to install ' |
|
.$tablefile." - no data received from push. </font>"); |
|
return 'error: push had no data'; |
|
} |
|
if (&Apache::lonnet::get_host_ip($clientname)) { |
|
my $clienthost = &Apache::lonnet::hostname($clientname); |
|
if ($managers{$clientip} eq $clientname) { |
|
my $clientprotocol = $Apache::lonnet::protocol{$clientname}; |
|
$clientprotocol = 'http' if ($clientprotocol ne 'https'); |
|
my $url = '/adm/'.$filename; |
|
$url =~ s{_}{/}; |
|
my $ua=new LWP::UserAgent; |
|
$ua->timeout(60); |
|
my $request=new HTTP::Request('GET',"$clientprotocol://$clienthost$url"); |
|
my $response=$ua->request($request); |
|
if ($response->is_error()) { |
|
&logthis('<font color="red"> Pushfile: unable to install ' |
|
.$tablefile." - error attempting to pull data. </font>"); |
|
return 'error: pull failed'; |
|
} else { |
|
my $result = $response->content; |
|
chomp($result); |
|
unless ($result eq $contents) { |
|
&logthis('<font color="red"> Pushfile: unable to install ' |
|
.$tablefile." - pushed data and pulled data differ. </font>"); |
|
my $pushleng = length($contents); |
|
my $pullleng = length($result); |
|
if ($pushleng != $pullleng) { |
|
return "error: $pushleng vs $pullleng bytes"; |
|
} else { |
|
return "error: mismatch push and pull"; |
|
} |
|
} |
|
} |
|
} |
|
} |
} |
} |
|
|
# Install the new file: |
# Install the new file: |
Line 1975 sub change_password_handler {
|
Line 2016 sub change_password_handler {
|
my ($howpwd,$contentpwd)=split(/:/,$realpasswd); |
my ($howpwd,$contentpwd)=split(/:/,$realpasswd); |
if ($howpwd eq 'internal') { |
if ($howpwd eq 'internal') { |
&Debug("internal auth"); |
&Debug("internal auth"); |
my $salt=time; |
my $ncpass = &hash_passwd($udom,$npass); |
$salt=substr($salt,6,2); |
|
my $ncpass=crypt($npass,$salt); |
|
if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) { |
if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) { |
my $msg="Result of password change for $uname: pwchange_success"; |
my $msg="Result of password change for $uname: pwchange_success"; |
if ($lonhost) { |
if ($lonhost) { |
$msg .= " - request originated from: $lonhost"; |
$msg .= " - request originated from: $lonhost"; |
} |
} |
&logthis($msg); |
&logthis($msg); |
|
&update_passwd_history($uname,$udom,$howpwd,$context); |
&Reply($client, "ok\n", $userinput); |
&Reply($client, "ok\n", $userinput); |
} else { |
} else { |
&logthis("Unable to open $uname passwd " |
&logthis("Unable to open $uname passwd " |
Line 1992 sub change_password_handler {
|
Line 2032 sub change_password_handler {
|
} |
} |
} elsif ($howpwd eq 'unix' && $context ne 'reset_by_email') { |
} elsif ($howpwd eq 'unix' && $context ne 'reset_by_email') { |
my $result = &change_unix_password($uname, $npass); |
my $result = &change_unix_password($uname, $npass); |
|
if ($result eq 'ok') { |
|
&update_passwd_history($uname,$udom,$howpwd,$context); |
|
} |
&logthis("Result of password change for $uname: ". |
&logthis("Result of password change for $uname: ". |
$result); |
$result); |
&Reply($client, \$result, $userinput); |
&Reply($client, \$result, $userinput); |
Line 2014 sub change_password_handler {
|
Line 2057 sub change_password_handler {
|
} |
} |
®ister_handler("passwd", \&change_password_handler, 1, 1, 0); |
®ister_handler("passwd", \&change_password_handler, 1, 1, 0); |
|
|
|
sub hash_passwd { |
|
my ($domain,$plainpass,@rest) = @_; |
|
my ($salt,$cost); |
|
if (@rest) { |
|
$cost = $rest[0]; |
|
# salt is first 22 characters, base-64 encoded by bcrypt |
|
my $plainsalt = substr($rest[1],0,22); |
|
$salt = Crypt::Eksblowfish::Bcrypt::de_base64($plainsalt); |
|
} else { |
|
my $defaultcost; |
|
my %domconfig = |
|
&Apache::lonnet::get_dom('configuration',['password'],$domain); |
|
if (ref($domconfig{'password'}) eq 'HASH') { |
|
$defaultcost = $domconfig{'password'}{'cost'}; |
|
} |
|
if (($defaultcost eq '') || ($defaultcost =~ /D/)) { |
|
$cost = 10; |
|
} else { |
|
$cost = $defaultcost; |
|
} |
|
# Generate random 16-octet base64 salt |
|
$salt = ""; |
|
$salt .= pack("C", int rand(256)) for 1..16; |
|
} |
|
my $hash = &Crypt::Eksblowfish::Bcrypt::bcrypt_hash({ |
|
key_nul => 1, |
|
cost => $cost, |
|
salt => $salt, |
|
}, Digest::SHA::sha512(Encode::encode('UTF-8',$plainpass))); |
|
|
|
my $result = join("!", "", "bcrypt", sprintf("%02d",$cost), |
|
&Crypt::Eksblowfish::Bcrypt::en_base64($salt). |
|
&Crypt::Eksblowfish::Bcrypt::en_base64($hash)); |
|
return $result; |
|
} |
|
|
# |
# |
# Create a new user. User in this case means a lon-capa user. |
# Create a new user. User in this case means a lon-capa user. |
# The user must either already exist in some authentication realm |
# The user must either already exist in some authentication realm |
Line 2057 sub add_user_handler {
|
Line 2136 sub add_user_handler {
|
."makeuser"; |
."makeuser"; |
} |
} |
unless ($fperror) { |
unless ($fperror) { |
my $result=&make_passwd_file($uname,$udom,$umode,$npass, $passfilename); |
my $result=&make_passwd_file($uname,$udom,$umode,$npass, |
|
$passfilename,'makeuser'); |
&Reply($client,\$result, $userinput); #BUGBUG - could be fail |
&Reply($client,\$result, $userinput); #BUGBUG - could be fail |
} else { |
} else { |
&Failure($client, \$fperror, $userinput); |
&Failure($client, \$fperror, $userinput); |
Line 2126 sub change_authentication_handler {
|
Line 2206 sub change_authentication_handler {
|
my $result = &change_unix_password($uname, $npass); |
my $result = &change_unix_password($uname, $npass); |
&logthis("Result of password change for $uname: ".$result); |
&logthis("Result of password change for $uname: ".$result); |
if ($result eq "ok") { |
if ($result eq "ok") { |
|
&update_passwd_history($uname,$udom,$umode,'changeuserauth'); |
&Reply($client, \$result); |
&Reply($client, \$result); |
} else { |
} else { |
&Failure($client, \$result); |
&Failure($client, \$result); |
} |
} |
} else { |
} else { |
my $result=&make_passwd_file($uname,$udom,$umode,$npass,$passfilename); |
my $result=&make_passwd_file($uname,$udom,$umode,$npass, |
|
$passfilename,'changeuserauth'); |
# |
# |
# If the current auth mode is internal, and the old auth mode was |
# If the current auth mode is internal, and the old auth mode was |
# unix, or krb*, and the user is an author for this domain, |
# unix, or krb*, and the user is an author for this domain, |
Line 2152 sub change_authentication_handler {
|
Line 2234 sub change_authentication_handler {
|
} |
} |
®ister_handler("changeuserauth", \&change_authentication_handler, 1,1, 0); |
®ister_handler("changeuserauth", \&change_authentication_handler, 1,1, 0); |
|
|
|
sub update_passwd_history { |
|
my ($uname,$udom,$umode,$context) = @_; |
|
my $proname=&propath($udom,$uname); |
|
my $now = time; |
|
if (open(my $fh,">>$proname/passwd.log")) { |
|
print $fh "$now:$umode:$context\n"; |
|
close($fh); |
|
} |
|
return; |
|
} |
|
|
# |
# |
# Determines if this is the home server for a user. The home server |
# Determines if this is the home server for a user. The home server |
# for a user will have his/her lon-capa passwd file. Therefore all we need |
# for a user will have his/her lon-capa passwd file. Therefore all we need |
Line 2403 sub remove_user_file_handler {
|
Line 2496 sub remove_user_file_handler {
|
if (-e $file) { |
if (-e $file) { |
# |
# |
# If the file is a regular file unlink is fine... |
# If the file is a regular file unlink is fine... |
# However it's possible the client wants a dir. |
# However it's possible the client wants a dir |
# removed, in which case rmdir is more approprate: |
# removed, in which case rmdir is more appropriate. |
|
# Note: rmdir will only remove an empty directory. |
# |
# |
if (-f $file){ |
if (-f $file){ |
unlink($file); |
unlink($file); |
|
# for html files remove the associated .bak file |
|
# which may have been created by the editor. |
|
if ($ufile =~ m{^((docs|supplemental)/(?:\d+|default)/\d+(?:|/.+)/)[^/]+\.x?html?$}i) { |
|
my $path = $1; |
|
if (-e $file.'.bak') { |
|
unlink($file.'.bak'); |
|
} |
|
} |
} elsif(-d $file) { |
} elsif(-d $file) { |
rmdir($file); |
rmdir($file); |
} |
} |
Line 2770 sub newput_user_profile_entry {
|
Line 2872 sub newput_user_profile_entry {
|
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
if (exists($hashref->{$key})) { |
if (exists($hashref->{$key})) { |
&Failure($client, "key_exists: ".$key."\n",$userinput); |
if (!&untie_user_hash($hashref)) { |
return 1; |
&logthis("error: ".($!+0)." untie (GDBM) failed ". |
|
"while attempting newput - early out as key exists"); |
|
} |
|
&Failure($client, "key_exists: ".$key."\n",$userinput); |
|
return 1; |
} |
} |
} |
} |
|
|
Line 3284 sub dump_with_regexp {
|
Line 3390 sub dump_with_regexp {
|
# namespace - Name of the database being modified |
# namespace - Name of the database being modified |
# rid - Resource keyword to modify. |
# rid - Resource keyword to modify. |
# what - new value associated with rid. |
# what - new value associated with rid. |
|
# laststore - (optional) version=timestamp |
|
# for most recent transaction for rid |
|
# in namespace, when cstore was called |
# |
# |
# $client - Socket open on the client. |
# $client - Socket open on the client. |
# |
# |
Line 3292 sub dump_with_regexp {
|
Line 3401 sub dump_with_regexp {
|
# 1 (keep on processing). |
# 1 (keep on processing). |
# Side-Effects: |
# Side-Effects: |
# Writes to the client |
# Writes to the client |
|
# Successful storage will cause either 'ok', or, if $laststore was included |
|
# in the tail of the request, and the version number for the last transaction |
|
# is larger than the version in $laststore, delay:$numtrans , where $numtrans |
|
# is the number of store evevnts recorded for rid in namespace since |
|
# lonnet::store() was called by the client. |
|
# |
sub store_handler { |
sub store_handler { |
my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
|
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
chomp($tail); |
my ($udom,$uname,$namespace,$rid,$what) =split(/:/,$tail); |
my ($udom,$uname,$namespace,$rid,$what,$laststore) =split(/:/,$tail); |
if ($namespace ne 'roles') { |
if ($namespace ne 'roles') { |
|
|
chomp($what); |
|
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
&GDBM_WRCREAT(), "S", |
&GDBM_WRCREAT(), "S", |
"$rid:$what"); |
"$rid:$what"); |
if ($hashref) { |
if ($hashref) { |
my $now = time; |
my $now = time; |
my @previouskeys=split(/&/,$hashref->{"keys:$rid"}); |
my $numtrans; |
my $key; |
if ($laststore) { |
|
my ($previousversion,$previoustime) = split(/\=/,$laststore); |
|
my ($lastversion,$lasttime) = (0,0); |
|
$lastversion = $hashref->{"version:$rid"}; |
|
if ($lastversion) { |
|
$lasttime = $hashref->{"$lastversion:$rid:timestamp"}; |
|
} |
|
if (($previousversion) && ($previousversion !~ /\D/)) { |
|
if (($lastversion > $previousversion) && ($lasttime >= $previoustime)) { |
|
$numtrans = $lastversion - $previousversion; |
|
} |
|
} elsif ($lastversion) { |
|
$numtrans = $lastversion; |
|
} |
|
if ($numtrans) { |
|
$numtrans =~ s/D//g; |
|
} |
|
} |
$hashref->{"version:$rid"}++; |
$hashref->{"version:$rid"}++; |
my $version=$hashref->{"version:$rid"}; |
my $version=$hashref->{"version:$rid"}; |
my $allkeys=''; |
my $allkeys=''; |
Line 3321 sub store_handler {
|
Line 3452 sub store_handler {
|
$allkeys.='timestamp'; |
$allkeys.='timestamp'; |
$hashref->{"$version:keys:$rid"}=$allkeys; |
$hashref->{"$version:keys:$rid"}=$allkeys; |
if (&untie_user_hash($hashref)) { |
if (&untie_user_hash($hashref)) { |
&Reply($client, "ok\n", $userinput); |
my $msg = 'ok'; |
|
if ($numtrans) { |
|
$msg = 'delay:'.$numtrans; |
|
} |
|
&Reply($client, "$msg\n", $userinput); |
} else { |
} else { |
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". |
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". |
"while attempting store\n", $userinput); |
"while attempting store\n", $userinput); |
Line 4306 sub put_domain_handler {
|
Line 4441 sub put_domain_handler {
|
} |
} |
®ister_handler("putdom", \&put_domain_handler, 0, 1, 0); |
®ister_handler("putdom", \&put_domain_handler, 0, 1, 0); |
|
|
|
# Updates one or more entries in clickers.db file at the domain level |
|
# |
|
# Parameters: |
|
# $cmd - The command that got us here. |
|
# $tail - Tail of the command (remaining parameters). |
|
# In this case a colon separated list containing: |
|
# (a) the domain for which we are updating the entries, |
|
# (b) the action required -- add or del -- and |
|
# (c) a &-separated list of entries to add or delete. |
|
# $client - File descriptor connected to client. |
|
# Returns |
|
# 1 - Continue processing. |
|
# 0 - Requested to exit, caller should shut down. |
|
# Side effects: |
|
# reply is written to $client. |
|
# |
|
|
|
|
|
sub update_clickers { |
|
my ($cmd, $tail, $client) = @_; |
|
|
|
my $userinput = "$cmd:$tail"; |
|
my ($udom,$action,$what) =split(/:/,$tail,3); |
|
chomp($what); |
|
|
|
my $hashref = &tie_domain_hash($udom, "clickers", &GDBM_WRCREAT(), |
|
"U","$action:$what"); |
|
|
|
if (!$hashref) { |
|
&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". |
|
"while attempting updateclickers\n", $userinput); |
|
return 1; |
|
} |
|
|
|
my @pairs=split(/\&/,$what); |
|
foreach my $pair (@pairs) { |
|
my ($key,$value)=split(/=/,$pair); |
|
if ($action eq 'add') { |
|
if (exists($hashref->{$key})) { |
|
my @newvals = split(/,/,&unescape($value)); |
|
my @currvals = split(/,/,&unescape($hashref->{$key})); |
|
my @merged = sort(keys(%{{map { $_ => 1 } (@newvals,@currvals)}})); |
|
$hashref->{$key}=&escape(join(',',@merged)); |
|
} else { |
|
$hashref->{$key}=$value; |
|
} |
|
} elsif ($action eq 'del') { |
|
if (exists($hashref->{$key})) { |
|
my %current; |
|
map { $current{$_} = 1; } split(/,/,&unescape($hashref->{$key})); |
|
map { delete($current{$_}); } split(/,/,&unescape($value)); |
|
if (keys(%current)) { |
|
$hashref->{$key}=&escape(join(',',sort(keys(%current)))); |
|
} else { |
|
delete($hashref->{$key}); |
|
} |
|
} |
|
} |
|
} |
|
if (&untie_user_hash($hashref)) { |
|
&Reply( $client, "ok\n", $userinput); |
|
} else { |
|
&Failure($client, "error: ".($!+0)." untie(GDBM) failed ". |
|
"while attempting put\n", |
|
$userinput); |
|
} |
|
return 1; |
|
} |
|
®ister_handler("updateclickers", \&update_clickers, 0, 1, 0); |
|
|
|
|
|
# Deletes one or more entries in a namespace db file at the domain level |
|
# |
|
# Parameters: |
|
# $cmd - The command that got us here. |
|
# $tail - Tail of the command (remaining parameters). |
|
# In this case a colon separated list containing: |
|
# (a) the domain for which we are deleting the entries, |
|
# (b) &-separated list of keys to delete. |
|
# $client - File descriptor connected to client. |
|
# Returns |
|
# 1 - Continue processing. |
|
# 0 - Requested to exit, caller should shut down. |
|
# Side effects: |
|
# reply is written to $client. |
|
# |
|
|
|
sub del_domain_handler { |
|
my ($cmd,$tail,$client) = @_; |
|
|
|
my $userinput = "$cmd:$tail"; |
|
|
|
my ($udom,$namespace,$what)=split(/:/,$tail,3); |
|
chomp($what); |
|
my $hashref = &tie_domain_hash($udom,$namespace,&GDBM_WRCREAT(), |
|
"D", $what); |
|
if ($hashref) { |
|
my @keys=split(/\&/,$what); |
|
foreach my $key (@keys) { |
|
delete($hashref->{$key}); |
|
} |
|
if (&untie_user_hash($hashref)) { |
|
&Reply($client, "ok\n", $userinput); |
|
} else { |
|
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". |
|
"while attempting deldom\n", $userinput); |
|
} |
|
} else { |
|
&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". |
|
"while attempting deldom\n", $userinput); |
|
} |
|
return 1; |
|
} |
|
®ister_handler("deldom", \&del_domain_handler, 0, 1, 0); |
|
|
|
|
# Unencrypted get from the namespace database file at the domain level. |
# Unencrypted get from the namespace database file at the domain level. |
# This function retrieves a keyed item from a specific named database in the |
# This function retrieves a keyed item from a specific named database in the |
# domain directory. |
# domain directory. |
Line 5211 sub create_auto_enroll_password_handler
|
Line 5462 sub create_auto_enroll_password_handler
|
®ister_handler("autocreatepassword", \&create_auto_enroll_password_handler, |
®ister_handler("autocreatepassword", \&create_auto_enroll_password_handler, |
0, 1, 0); |
0, 1, 0); |
|
|
|
sub auto_export_grades_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my ($cdom,$cnum,$info,$data) = split(/:/,$tail); |
|
my $inforef = &Apache::lonnet::thaw_unescape($info); |
|
my $dataref = &Apache::lonnet::thaw_unescape($data); |
|
my ($outcome,$result);; |
|
eval { |
|
local($SIG{__DIE__})='DEFAULT'; |
|
my %rtnhash; |
|
$outcome=&localenroll::export_grades($cdom,$cnum,$inforef,$dataref,\%rtnhash); |
|
if ($outcome eq 'ok') { |
|
foreach my $key (keys(%rtnhash)) { |
|
$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rtnhash{$key}).'&'; |
|
} |
|
$result =~ s/\&$//; |
|
} |
|
}; |
|
if (!$@) { |
|
if ($outcome eq 'ok') { |
|
if ($cipher) { |
|
my $cmdlength=length($result); |
|
$result.=" "; |
|
my $encresult=''; |
|
for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) { |
|
$encresult.= unpack("H16", |
|
$cipher->encrypt(substr($result, |
|
$encidx, |
|
8))); |
|
} |
|
&Reply( $client, "enc:$cmdlength:$encresult\n", $userinput); |
|
} else { |
|
&Failure( $client, "error:no_key\n", $userinput); |
|
} |
|
} else { |
|
&Reply($client, "$outcome\n", $userinput); |
|
} |
|
} else { |
|
&Failure($client,"export_error\n",$userinput); |
|
} |
|
return 1; |
|
} |
|
®ister_handler("autoexportgrades", \&auto_export_grades_handler, |
|
0, 1, 0); |
|
|
# Retrieve and remove temporary files created by/during autoenrollment. |
# Retrieve and remove temporary files created by/during autoenrollment. |
# |
# |
# Formal Parameters: |
# Formal Parameters: |
Line 5231 sub retrieve_auto_file_handler {
|
Line 5527 sub retrieve_auto_file_handler {
|
my ($filename) = split(/:/, $tail); |
my ($filename) = split(/:/, $tail); |
|
|
my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename; |
my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename; |
if ( (-e $source) && ($filename ne '') ) { |
|
|
if ($filename =~m{/\.\./}) { |
|
&Failure($client, "refused\n", $userinput); |
|
} elsif ( (-e $source) && ($filename ne '') ) { |
my $reply = ''; |
my $reply = ''; |
if (open(my $fh,$source)) { |
if (open(my $fh,$source)) { |
while (<$fh>) { |
while (<$fh>) { |
Line 5263 sub crsreq_checks_handler {
|
Line 5562 sub crsreq_checks_handler {
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
my $dom = $tail; |
my $dom = $tail; |
my $result; |
my $result; |
my @reqtypes = ('official','unofficial','community'); |
my @reqtypes = ('official','unofficial','community','textbook','placement'); |
eval { |
eval { |
local($SIG{__DIE__})='DEFAULT'; |
local($SIG{__DIE__})='DEFAULT'; |
my %validations; |
my %validations; |
Line 5290 sub crsreq_checks_handler {
|
Line 5589 sub crsreq_checks_handler {
|
sub validate_crsreq_handler { |
sub validate_crsreq_handler { |
my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = split(/:/, $tail); |
my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist,$customdata) = split(/:/, $tail); |
$instcode = &unescape($instcode); |
$instcode = &unescape($instcode); |
$owner = &unescape($owner); |
$owner = &unescape($owner); |
$crstype = &unescape($crstype); |
$crstype = &unescape($crstype); |
$inststatuslist = &unescape($inststatuslist); |
$inststatuslist = &unescape($inststatuslist); |
$instcode = &unescape($instcode); |
$instcode = &unescape($instcode); |
$instseclist = &unescape($instseclist); |
$instseclist = &unescape($instseclist); |
|
my $custominfo = &Apache::lonnet::thaw_unescape($customdata); |
my $outcome; |
my $outcome; |
eval { |
eval { |
local($SIG{__DIE__})='DEFAULT'; |
local($SIG{__DIE__})='DEFAULT'; |
$outcome = &localenroll::validate_crsreq($dom,$owner,$crstype, |
$outcome = &localenroll::validate_crsreq($dom,$owner,$crstype, |
$inststatuslist,$instcode, |
$inststatuslist,$instcode, |
$instseclist); |
$instseclist,$custominfo); |
}; |
}; |
if (!$@) { |
if (!$@) { |
&Reply($client, \$outcome, $userinput); |
&Reply($client, \$outcome, $userinput); |
Line 5313 sub validate_crsreq_handler {
|
Line 5613 sub validate_crsreq_handler {
|
} |
} |
®ister_handler("autocrsreqvalidation", \&validate_crsreq_handler, 0, 1, 0); |
®ister_handler("autocrsreqvalidation", \&validate_crsreq_handler, 0, 1, 0); |
|
|
|
sub crsreq_update_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my ($cdom,$cnum,$crstype,$action,$ownername,$ownerdomain,$fullname,$title,$code, |
|
$accessstart,$accessend,$infohashref) = |
|
split(/:/, $tail); |
|
$crstype = &unescape($crstype); |
|
$action = &unescape($action); |
|
$ownername = &unescape($ownername); |
|
$ownerdomain = &unescape($ownerdomain); |
|
$fullname = &unescape($fullname); |
|
$title = &unescape($title); |
|
$code = &unescape($code); |
|
$accessstart = &unescape($accessstart); |
|
$accessend = &unescape($accessend); |
|
my $incoming = &Apache::lonnet::thaw_unescape($infohashref); |
|
my ($result,$outcome); |
|
eval { |
|
local($SIG{__DIE__})='DEFAULT'; |
|
my %rtnhash; |
|
$outcome = &localenroll::crsreq_updates($cdom,$cnum,$crstype,$action, |
|
$ownername,$ownerdomain,$fullname, |
|
$title,$code,$accessstart,$accessend, |
|
$incoming,\%rtnhash); |
|
if ($outcome eq 'ok') { |
|
my @posskeys = qw(createdweb createdmsg createdcustomized createdactions queuedweb queuedmsg formitems reviewweb validationjs onload javascript); |
|
foreach my $key (keys(%rtnhash)) { |
|
if (grep(/^\Q$key\E/,@posskeys)) { |
|
$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rtnhash{$key}).'&'; |
|
} |
|
} |
|
$result =~ s/\&$//; |
|
} |
|
}; |
|
if (!$@) { |
|
if ($outcome eq 'ok') { |
|
&Reply($client, \$result, $userinput); |
|
} else { |
|
&Reply($client, "format_error\n", $userinput); |
|
} |
|
} else { |
|
&Failure($client,"unknown_cmd\n",$userinput); |
|
} |
|
return 1; |
|
} |
|
®ister_handler("autocrsrequpdate", \&crsreq_update_handler, 0, 1, 0); |
|
|
# |
# |
# Read and retrieve institutional code format (for support form). |
# Read and retrieve institutional code format (for support form). |
# Formal Parameters: |
# Formal Parameters: |
Line 6508 sub make_new_child {
|
Line 6855 sub make_new_child {
|
# my $tmpsnum=0; # Now global |
# my $tmpsnum=0; # Now global |
#---------------------------------------------------- kerberos 5 initialization |
#---------------------------------------------------- kerberos 5 initialization |
&Authen::Krb5::init_context(); |
&Authen::Krb5::init_context(); |
unless (($dist eq 'fedora5') || ($dist eq 'fedora4') || |
|
($dist eq 'fedora6') || ($dist eq 'suse9.3') || |
my $no_ets; |
($dist eq 'suse12.2') || ($dist eq 'suse12.3') || |
if ($dist =~ /^(?:centos|rhes|scientific)(\d+)$/) { |
($dist eq 'suse13.1')) { |
if ($1 >= 7) { |
|
$no_ets = 1; |
|
} |
|
} elsif ($dist =~ /^suse(\d+\.\d+)$/) { |
|
if (($1 eq '9.3') || ($1 >= 12.2)) { |
|
$no_ets = 1; |
|
} |
|
} elsif ($dist =~ /^sles(\d+)$/) { |
|
if ($1 > 11) { |
|
$no_ets = 1; |
|
} |
|
} elsif ($dist =~ /^fedora(\d+)$/) { |
|
if ($1 < 7) { |
|
$no_ets = 1; |
|
} |
|
} |
|
unless ($no_ets) { |
&Authen::Krb5::init_ets(); |
&Authen::Krb5::init_ets(); |
} |
} |
|
|
Line 6556 sub make_new_child {
|
Line 6919 sub make_new_child {
|
# |
# |
# If the remote is attempting a local init... give that a try: |
# If the remote is attempting a local init... give that a try: |
# |
# |
logthis("remotereq: $remotereq"); |
|
(my $i, my $inittype, $clientversion) = split(/:/, $remotereq); |
(my $i, my $inittype, $clientversion) = split(/:/, $remotereq); |
# For LON-CAPA 2.9, the client session will have sent its LON-CAPA |
# For LON-CAPA 2.9, the client session will have sent its LON-CAPA |
# version when initiating the connection. For LON-CAPA 2.8 and older, |
# version when initiating the connection. For LON-CAPA 2.8 and older, |
Line 6897 sub validate_user {
|
Line 7259 sub validate_user {
|
} |
} |
if ($howpwd ne 'nouser') { |
if ($howpwd ne 'nouser') { |
if($howpwd eq "internal") { # Encrypted is in local password file. |
if($howpwd eq "internal") { # Encrypted is in local password file. |
$validated = (crypt($password, $contentpwd) eq $contentpwd); |
if (length($contentpwd) == 13) { |
|
$validated = (crypt($password,$contentpwd) eq $contentpwd); |
|
if ($validated) { |
|
my $ncpass = &hash_passwd($domain,$password); |
|
if (&rewrite_password_file($domain,$user,"$howpwd:$ncpass")) { |
|
&update_passwd_history($user,$domain,$howpwd,'conversion'); |
|
&logthis("Validated password hashed with bcrypt for $user:$domain"); |
|
} |
|
} |
|
} else { |
|
$validated = &check_internal_passwd($password,$contentpwd,$domain); |
|
} |
} |
} |
elsif ($howpwd eq "unix") { # User is a normal unix user. |
elsif ($howpwd eq "unix") { # User is a normal unix user. |
$contentpwd = (getpwnam($user))[1]; |
$contentpwd = (getpwnam($user))[1]; |
Line 6965 sub validate_user {
|
Line 7338 sub validate_user {
|
return $validated; |
return $validated; |
} |
} |
|
|
|
sub check_internal_passwd { |
|
my ($plainpass,$stored,$domain) = @_; |
|
my (undef,$method,@rest) = split(/!/,$stored); |
|
if ($method eq "bcrypt") { |
|
my $result = &hash_passwd($domain,$plainpass,@rest); |
|
if ($result ne $stored) { |
|
return 0; |
|
} |
|
# Upgrade to a larger number of rounds if necessary |
|
my $defaultcost; |
|
my %domconfig = |
|
&Apache::lonnet::get_dom('configuration',['password'],$domain); |
|
if (ref($domconfig{'password'}) eq 'HASH') { |
|
$defaultcost = $domconfig{'password'}{'cost'}; |
|
} |
|
if (($defaultcost eq '') || ($defaultcost =~ /D/)) { |
|
$defaultcost = 10; |
|
} |
|
return 1 unless($rest[0]<$defaultcost); |
|
} |
|
return 0; |
|
} |
|
|
|
sub get_last_authchg { |
|
my ($domain,$user) = @_; |
|
my $lastmod; |
|
my $logname = &propath($domain,$user).'/passwd.log'; |
|
if (-e "$logname") { |
|
$lastmod = (stat("$logname"))[9]; |
|
} |
|
return $lastmod; |
|
} |
|
|
sub krb4_authen { |
sub krb4_authen { |
my ($password,$null,$user,$contentpwd) = @_; |
my ($password,$null,$user,$contentpwd) = @_; |
my $validated = 0; |
my $validated = 0; |
Line 7280 sub change_unix_password {
|
Line 7686 sub change_unix_password {
|
|
|
|
|
sub make_passwd_file { |
sub make_passwd_file { |
my ($uname,$udom,$umode,$npass,$passfilename)=@_; |
my ($uname,$udom,$umode,$npass,$passfilename,$action)=@_; |
my $result="ok"; |
my $result="ok"; |
if ($umode eq 'krb4' or $umode eq 'krb5') { |
if ($umode eq 'krb4' or $umode eq 'krb5') { |
{ |
{ |
my $pf = IO::File->new(">$passfilename"); |
my $pf = IO::File->new(">$passfilename"); |
if ($pf) { |
if ($pf) { |
print $pf "$umode:$npass\n"; |
print $pf "$umode:$npass\n"; |
|
&update_passwd_history($uname,$udom,$umode,$action); |
} else { |
} else { |
$result = "pass_file_failed_error"; |
$result = "pass_file_failed_error"; |
} |
} |
} |
} |
} elsif ($umode eq 'internal') { |
} elsif ($umode eq 'internal') { |
my $salt=time; |
my $ncpass = &hash_passwd($udom,$npass); |
$salt=substr($salt,6,2); |
|
my $ncpass=crypt($npass,$salt); |
|
{ |
{ |
&Debug("Creating internal auth"); |
&Debug("Creating internal auth"); |
my $pf = IO::File->new(">$passfilename"); |
my $pf = IO::File->new(">$passfilename"); |
if($pf) { |
if($pf) { |
print $pf "internal:$ncpass\n"; |
print $pf "internal:$ncpass\n"; |
|
&update_passwd_history($uname,$udom,$umode,$action); |
} else { |
} else { |
$result = "pass_file_failed_error"; |
$result = "pass_file_failed_error"; |
} |
} |
Line 7565 Allow for a password to be set.
|
Line 7971 Allow for a password to be set.
|
|
|
Make a user. |
Make a user. |
|
|
=item passwd |
=item changeuserauth |
|
|
Allow for authentication mechanism and password to be changed. |
Allow for authentication mechanism and password to be changed. |
|
|
Line 7654 for each student, defined perhaps by the
|
Line 8060 for each student, defined perhaps by the
|
Returns usernames corresponding to IDs. (These "IDs" are unique identifiers |
Returns usernames corresponding to IDs. (These "IDs" are unique identifiers |
for each student, defined perhaps by the institutional Registrar.) |
for each student, defined perhaps by the institutional Registrar.) |
|
|
|
=item iddel |
|
|
|
Deletes one or more ids in a domain's id database. |
|
|
=item tmpput |
=item tmpput |
|
|
Accept and store information in temporary space. |
Accept and store information in temporary space. |