--- loncom/lond 2006/08/29 21:08:08 1.340 +++ loncom/lond 2006/11/10 02:01:55 1.347 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.340 2006/08/29 21:08:08 raeburn Exp $ +# $Id: lond,v 1.347 2006/11/10 02:01:55 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -40,6 +40,7 @@ use IO::File; use POSIX; use Crypt::IDEA; use LWP::UserAgent(); +use Digest::MD5 qw(md5_hex); use GDBM_File; use Authen::Krb4; use Authen::Krb5; @@ -59,7 +60,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.340 $'; #' stupid emacs +my $VERSION='$Revision: 1.347 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -1574,17 +1575,24 @@ sub change_password_handler { # uname - Username. # upass - Current password. # npass - New password. + # context - Context in which this was called + # (preferences or reset_by_email). - my ($udom,$uname,$upass,$npass)=split(/:/,$tail); + my ($udom,$uname,$upass,$npass,$context)=split(/:/,$tail); $upass=&unescape($upass); $npass=&unescape($npass); &Debug("Trying to change password for $uname"); # First require that the user can be authenticated with their - # old password: - - my $validated = &validate_user($udom, $uname, $upass); + # old password unless context was 'reset_by_email': + + my $validated; + if ($context eq 'reset_by_email') { + $validated = 1; + } else { + $validated = &validate_user($udom, $uname, $upass); + } if($validated) { my $realpasswd = &get_auth_type($udom, $uname); # Defined since authd. @@ -1603,7 +1611,7 @@ sub change_password_handler { ."to change password"); &Failure( $client, "non_authorized\n",$userinput); } - } elsif ($howpwd eq 'unix') { + } elsif ($howpwd eq 'unix' && $context ne 'reset_by_email') { my $result = &change_unix_password($uname, $npass); &logthis("Result of password change for $uname: ". $result); @@ -2123,14 +2131,21 @@ sub token_auth_user_file_handler { chomp($session); my $reply="non_auth\n"; - if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'. - $session.'.id')) { + my $file = $perlvar{'lonIDsDir'}.'/'.$session.'.id'; + if (open(ENVIN,"$file")) { flock(ENVIN,LOCK_SH); - while (my $line=) { - my ($envname)=split(/=/,$line,2); - $envname=&unescape($envname); - if ($envname=~ m|^userfile\.\Q$fname\E|) { $reply="ok\n"; } + tie(my %disk_env,'GDBM_File',"$file",&GDBM_READER(),0640); + if (exists($disk_env{"userfile.$fname"})) { + $reply="ok\n"; + } else { + foreach my $envname (keys(%disk_env)) { + if ($envname=~ m|^userfile\.\Q$fname\E|) { + $reply="ok\n"; + last; + } + } } + untie(%disk_env); close(ENVIN); &Reply($client, $reply, "$cmd:$tail"); } else { @@ -3350,7 +3365,7 @@ sub dump_course_id_handler { my $userinput = "$cmd:$tail"; my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter, - $typefilter) =split(/:/,$tail); + $typefilter,$regexp_ok) =split(/:/,$tail); if (defined($description)) { $description=&unescape($description); } else { @@ -3387,6 +3402,9 @@ sub dump_course_id_handler { } else { $typefilter='.'; } + if (defined($regexp_ok)) { + $regexp_ok=&unescape($regexp_ok); + } unless (defined($since)) { $since=0; } my $qresult=''; @@ -3407,8 +3425,14 @@ sub dump_course_id_handler { } unless ($instcodefilter eq '.' || !defined($instcodefilter)) { my $unescapeInstcode = &unescape($inst_code); - unless (eval('$unescapeInstcode=~/\Q$instcodefilter\E/i')) { - $match = 0; + if ($regexp_ok) { + unless (eval('$unescapeInstcode=~/$instcodefilter/')) { + $match = 0; + } + } else { + unless (eval('$unescapeInstcode=~/\Q$instcodefilter\E/i')) { + $match = 0; + } } } unless ($ownerfilter eq '.' || !defined($ownerfilter)) { @@ -3454,7 +3478,7 @@ sub dump_course_id_handler { } unless ($typefilter eq '.' || !defined($typefilter)) { my $unescapeType = &unescape($type); - if (!defined($type)) { + if ($type eq '') { if ($typefilter ne 'Course') { $match = 0; } @@ -3856,15 +3880,23 @@ sub tmp_put_handler { my $userinput = "$cmd:$what"; # Reconstruct for logging. - - my $store; + my ($record,$context) = split(/:/,$what); + if ($context ne '') { + chomp($context); + $context = &unescape($context); + } + my ($id,$store); $tmpsnum++; - my $id=$$.'_'.$clientip.'_'.$tmpsnum; + if ($context eq 'resetpw') { + $id = &md5_hex(&md5_hex(time.{}.rand().$$)); + } else { + $id = $$.'_'.$clientip.'_'.$tmpsnum; + } $id=~s/\W/\_/g; - $what=~s/\n//g; + $record=~s/\n//g; my $execdir=$perlvar{'lonDaemons'}; if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) { - print $store $what; + print $store $record; close $store; &Reply($client, "$id\n", $userinput); } else { @@ -4200,7 +4232,11 @@ sub validate_class_access_handler { my $userinput = "$cmd:$tail"; my ($inst_class,$courseowner,$cdom) = split(/:/, $tail); $courseowner = &unescape($courseowner); - my $outcome=&localenroll::check_section($inst_class,$courseowner,$cdom); + my $outcome; + eval { + local($SIG{__DIE__})='DEFAULT'; + $outcome=&localenroll::check_section($inst_class,$courseowner,$cdom); + }; &Reply($client,"$outcome\n", $userinput); return 1; @@ -4342,6 +4378,38 @@ sub get_institutional_code_format_handle ®ister_handler("autoinstcodeformat", \&get_institutional_code_format_handler,0,1,0); +sub get_institutional_defaults_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + + my $dom = $tail; + my %defaults_hash; + my @code_order; + my $outcome; + eval { + local($SIG{__DIE__})='DEFAULT'; + $outcome = &localenroll::instcode_defaults($dom,\%defaults_hash, + \@code_order); + }; + if (!$@) { + if ($outcome eq 'ok') { + my $result=''; + while (my ($key,$value) = each(%defaults_hash)) { + $result.=&escape($key).'='.&escape($value).'&'; + } + $result .= 'code_order='.&escape(join('&',@code_order)); + &Reply($client,$result."\n",$userinput); + } else { + &Reply($client,"error\n", $userinput); + } + } else { + &Failure($client,"unknown_cmd\n",$userinput); + } +} +®ister_handler("autoinstcodedefaults", + \&get_institutional_defaults_handler,0,1,0); + + # Get domain specific conditions for import of student photographs to a course # # Retrieves information from photo_permission subroutine in localenroll.