--- loncom/lond 2015/06/14 00:15:13 1.515 +++ loncom/lond 2016/05/08 19:05:10 1.520 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.515 2015/06/14 00:15:13 raeburn Exp $ +# $Id: lond,v 1.520 2016/05/08 19:05:10 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -55,13 +55,16 @@ use LONCAPA::lonssl; use Fcntl qw(:flock); use Apache::lonnet; use Mail::Send; +use Crypt::Eksblowfish::Bcrypt; +use Digest::SHA; +use Encode; my $DEBUG = 0; # Non zero to enable debug log entries. my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.515 $'; #' stupid emacs +my $VERSION='$Revision: 1.520 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -2013,15 +2016,14 @@ sub change_password_handler { my ($howpwd,$contentpwd)=split(/:/,$realpasswd); if ($howpwd eq 'internal') { &Debug("internal auth"); - my $salt=time; - $salt=substr($salt,6,2); - my $ncpass=crypt($npass,$salt); + my $ncpass = &hash_passwd($udom,$npass); if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) { my $msg="Result of password change for $uname: pwchange_success"; if ($lonhost) { $msg .= " - request originated from: $lonhost"; } &logthis($msg); + &update_passwd_history($uname,$udom,$howpwd,$context); &Reply($client, "ok\n", $userinput); } else { &logthis("Unable to open $uname passwd " @@ -2030,6 +2032,9 @@ sub change_password_handler { } } elsif ($howpwd eq 'unix' && $context ne 'reset_by_email') { 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: ". $result); &Reply($client, \$result, $userinput); @@ -2052,6 +2057,42 @@ sub change_password_handler { } ®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. # The user must either already exist in some authentication realm @@ -2095,7 +2136,8 @@ sub add_user_handler { ."makeuser"; } 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 } else { &Failure($client, \$fperror, $userinput); @@ -2164,12 +2206,14 @@ sub change_authentication_handler { my $result = &change_unix_password($uname, $npass); &logthis("Result of password change for $uname: ".$result); if ($result eq "ok") { + &update_passwd_history($uname,$udom,$umode,'changeuserauth'); &Reply($client, \$result); } else { &Failure($client, \$result); } } 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 # unix, or krb*, and the user is an author for this domain, @@ -2190,6 +2234,17 @@ sub change_authentication_handler { } ®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 # for a user will have his/her lon-capa passwd file. Therefore all we need @@ -2441,11 +2496,20 @@ sub remove_user_file_handler { if (-e $file) { # # If the file is a regular file unlink is fine... - # However it's possible the client wants a dir. - # removed, in which case rmdir is more approprate: + # However it's possible the client wants a dir + # removed, in which case rmdir is more appropriate. + # Note: rmdir will only remove an empty directory. # if (-f $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) { rmdir($file); } @@ -4377,6 +4441,122 @@ sub put_domain_handler { } ®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. # This function retrieves a keyed item from a specific named database in the # domain directory. @@ -5334,7 +5514,7 @@ sub crsreq_checks_handler { my $userinput = "$cmd:$tail"; my $dom = $tail; my $result; - my @reqtypes = ('official','unofficial','community','textbook'); + my @reqtypes = ('official','unofficial','community','textbook','placement'); eval { local($SIG{__DIE__})='DEFAULT'; my %validations; @@ -6691,7 +6871,6 @@ sub make_new_child { # # If the remote is attempting a local init... give that a try: # - logthis("remotereq: $remotereq"); (my $i, my $inittype, $clientversion) = split(/:/, $remotereq); # 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, @@ -7032,7 +7211,18 @@ sub validate_user { } if ($howpwd ne 'nouser') { 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. $contentpwd = (getpwnam($user))[1]; @@ -7100,6 +7290,39 @@ sub validate_user { 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 { my ($password,$null,$user,$contentpwd) = @_; my $validated = 0; @@ -7415,26 +7638,26 @@ sub change_unix_password { sub make_passwd_file { - my ($uname,$udom,$umode,$npass,$passfilename)=@_; + my ($uname,$udom,$umode,$npass,$passfilename,$action)=@_; my $result="ok"; if ($umode eq 'krb4' or $umode eq 'krb5') { { my $pf = IO::File->new(">$passfilename"); if ($pf) { print $pf "$umode:$npass\n"; + &update_passwd_history($uname,$udom,$umode,$action); } else { $result = "pass_file_failed_error"; } } } elsif ($umode eq 'internal') { - my $salt=time; - $salt=substr($salt,6,2); - my $ncpass=crypt($npass,$salt); + my $ncpass = &hash_passwd($udom,$npass); { &Debug("Creating internal auth"); my $pf = IO::File->new(">$passfilename"); if($pf) { - print $pf "internal:$ncpass\n"; + print $pf "internal:$ncpass\n"; + &update_passwd_history($uname,$udom,$umode,$action); } else { $result = "pass_file_failed_error"; } @@ -7700,7 +7923,7 @@ Allow for a password to be set. Make a user. -=item passwd +=item changeuserauth Allow for authentication mechanism and password to be changed. @@ -7789,6 +8012,10 @@ for each student, defined perhaps by the Returns usernames corresponding to IDs. (These "IDs" are unique identifiers for each student, defined perhaps by the institutional Registrar.) +=item iddel + +Deletes one or more ids in a domain's id database. + =item tmpput Accept and store information in temporary space.