--- loncom/lond 2007/04/04 00:03:40 1.370 +++ loncom/lond 2007/10/03 19:57:23 1.383 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.370 2007/04/04 00:03:40 albertel Exp $ +# $Id: lond,v 1.383 2007/10/03 19:57:23 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -53,13 +53,14 @@ use File::Find; use LONCAPA::lonlocal; use LONCAPA::lonssl; use Fcntl qw(:flock); +use Apache::lonnet; my $DEBUG = 0; # Non zero to enable debug log entries. my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.370 $'; #' stupid emacs +my $VERSION='$Revision: 1.383 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -69,7 +70,6 @@ my $clientip; # IP address of client. my $clientname; # LonCAPA name of client. my $server; -my $thisserver; # DNS of us. my $keymode; @@ -136,7 +136,7 @@ my @adderrors = ("ok", "lcuseradd Unable to make www member of users's group", "lcuseradd Unable to su to root", "lcuseradd Unable to set password", - "lcuseradd Usrname has invalid characters", + "lcuseradd Username has invalid characters", "lcuseradd Password has an invalid character", "lcuseradd User already exists", "lcuseradd Could not add user.", @@ -172,19 +172,16 @@ sub ResetStatistics { # $Socket - Socket open on client. # $initcmd - The full text of the init command. # -# Implicit inputs: -# $thisserver - Our DNS name. -# # Returns: # IDEA session key on success. # undef on failure. # sub LocalConnection { my ($Socket, $initcmd) = @_; - Debug("Attempting local connection: $initcmd client: $clientip me: $thisserver"); + Debug("Attempting local connection: $initcmd client: $clientip"); if($clientip ne "127.0.0.1") { &logthis(' LocalConnection rejecting non local: ' - ."$clientip ne $thisserver "); + ."$clientip ne 127.0.0.1 "); close $Socket; return undef; } else { @@ -2099,6 +2096,37 @@ sub rename_user_file_handler { ®ister_handler("renameuserfile", \&rename_user_file_handler, 0,1,0); # +# Checks if the specified user has an active session on the server +# return ok if so, not_found if not +# +# Parameters: +# cmd - The request keyword that dispatched to tus. +# tail - The tail of the request (colon separated parameters). +# client - Filehandle open on the client. +# Return: +# 1. +sub user_has_session_handler { + my ($cmd, $tail, $client) = @_; + + my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail)); + + &logthis("Looking for $udom $uname"); + opendir(DIR,$perlvar{'lonIDsDir'}); + my $filename; + while ($filename=readdir(DIR)) { + last if ($filename=~/^\Q$uname\E_\d+_\Q$udom\E_/); + } + if ($filename) { + &Reply($client, "ok\n", "$cmd:$tail"); + } else { + &Failure($client, "not_found\n", "$cmd:$tail"); + } + return 1; + +} +®ister_handler("userhassession", \&user_has_session_handler, 0,1,0); + +# # Authenticate access to a user file by checking that the token the user's # passed also exists in their session file # @@ -2191,13 +2219,13 @@ sub subscribe_handler { ®ister_handler("sub", \&subscribe_handler, 0, 1, 0); # -# Determine the version of a resource (?) Or is it return -# the top version of the resource? Not yet clear from the -# code in currentversion. +# Determine the latest version of a resource (it looks for the highest +# past version and then returns that +1) # # Parameters: # $cmd - The command that got us here. # $tail - Tail of the command (remaining parameters). +# (Should consist of an absolute path to a file) # $client - File descriptor connected to client. # Returns # 0 - Requested to exit, caller should shut down. @@ -3277,23 +3305,32 @@ sub put_course_id_handler { foreach my $pair (@pairs) { my ($key,$courseinfo) = split(/=/,$pair,2); $courseinfo =~ s/=/:/g; - my @current_items = split(/:/,$hashref->{$key},-1); - shift(@current_items); # remove description - pop(@current_items); # remove last access - my $numcurrent = scalar(@current_items); - if ($numcurrent > 3) { - $numcurrent = 3; - } - my @new_items = split(/:/,$courseinfo,-1); - my $numnew = scalar(@new_items); - if ($numcurrent > 0) { - if ($numnew <= $numcurrent) { # flushcourselogs() from pre 2.2 - for (my $j=$numcurrent-$numnew; $j>=0; $j--) { - $courseinfo .= ':'.$current_items[$numcurrent-$j-1]; + if (ref($hashref) eq 'HASH') { + my @items = ('description','inst_code','owner','type'); + my @new_items = split(/:/,$courseinfo,-1); + for (my $i=0; $i<@new_items; $i++) { + $hashref->{$key}{$items[$i]} = $new_items[$i]; + } + $hashref->{$key}{'lasttime'} = $now; + } else { + my @current_items = split(/:/,$hashref->{$key},-1); + shift(@current_items); # remove description + pop(@current_items); # remove last access + my $numcurrent = scalar(@current_items); + if ($numcurrent > 3) { + $numcurrent = 3; + } + my @new_items = split(/:/,$courseinfo,-1); + my $numnew = scalar(@new_items); + if ($numcurrent > 0) { + if ($numnew <= $numcurrent) { # flushcourselogs() from pre 2.2 + for (my $j=$numcurrent-$numnew; $j>=0; $j--) { + $courseinfo .= ':'.$current_items[$numcurrent-$j-1]; + } } } + $hashref->{$key}=$courseinfo.':'.$now; } - $hashref->{$key}=$courseinfo.':'.$now; } if (&untie_domain_hash($hashref)) { &Reply( $client, "ok\n", $userinput); @@ -3307,12 +3344,39 @@ sub put_course_id_handler { ." tie(GDBM) Failed ". "while attempting courseidput\n", $userinput); } - return 1; } ®ister_handler("courseidput", \&put_course_id_handler, 0, 1, 0); +sub put_course_id_hash_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + my ($udom, $what) = split(/:/, $tail,2); + chomp($what); + my $now=time; + my @pairs=split(/\&/,$what); + my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT(), + "P", $what); + if ($hashref) { + foreach my $pair (@pairs) { + my ($key,$value)=split(/=/,$pair); + $hashref->{$key} = $value; + } + if (&untie_domain_hash($hashref)) { + &Reply($client, "ok\n", $userinput); + } else { + &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". + "while attempting courseidputhash\n", $userinput); + } + } else { + &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". + "while attempting courseidputhash\n", $userinput); + } + return 1; +} +®ister_handler("courseidputhash", \&put_course_id_hash_handler, 0, 1, 0); + # Retrieves the value of a course id resource keyword pattern # defined since a starting date. Both the starting date and the # keyword pattern are optional. If the starting date is not supplied it @@ -3350,7 +3414,7 @@ sub dump_course_id_handler { my $userinput = "$cmd:$tail"; my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter, - $typefilter,$regexp_ok) =split(/:/,$tail); + $typefilter,$regexp_ok,$as_hash) =split(/:/,$tail); if (defined($description)) { $description=&unescape($description); } else { @@ -3395,11 +3459,20 @@ sub dump_course_id_handler { my $qresult=''; my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT()); if ($hashref) { - while (my ($key,$value) = each(%$hashref)) { + while (my ($key,$rawvalue) = each(%$hashref)) { my ($descr,$lasttime,$inst_code,$owner,$type); - my @courseitems = split(/:/,$value); - $lasttime = pop(@courseitems); - ($descr,$inst_code,$owner,$type)=@courseitems; + my $value = &Apache::lonnet::thaw_unescape($rawvalue); + if (ref($value) eq 'HASH') { + $descr = $value->{'description'}; + $inst_code = $value->{'inst_code'}; + $owner = $value->{'owner'}; + $type = $value->{'type'}; + $lasttime = $value->{'lasttime'}; + } else { + my @courseitems = split(/:/,$rawvalue); + $lasttime = pop(@courseitems); + ($descr,$inst_code,$owner,$type)=@courseitems; + } if ($lasttime<$since) { next; } my $match = 1; unless ($description eq '.') { @@ -3455,6 +3528,7 @@ sub dump_course_id_handler { } } } + my $unescapeCourse = &unescape($key); unless ($coursefilter eq '.' || !defined($coursefilter)) { my $unescapeCourse = &unescape($key); unless (eval('$unescapeCourse=~/^$udom(_)\Q$coursefilter\E$/')) { @@ -3467,14 +3541,18 @@ sub dump_course_id_handler { if ($typefilter ne 'Course') { $match = 0; } - } else { + } else { unless (eval('$unescapeType=~/^\Q$typefilter\E$/')) { $match = 0; } } } if ($match == 1) { - $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&'; + if ($as_hash) { + $qresult.=$key.'='.$rawvalue.'&'; + } else { + $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&'; + } } } if (&untie_domain_hash($hashref)) { @@ -3488,8 +3566,6 @@ sub dump_course_id_handler { &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". "while attempting courseiddump\n", $userinput); } - - return 1; } ®ister_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0); @@ -4308,12 +4384,13 @@ sub validate_course_section_handler { sub validate_class_access_handler { my ($cmd, $tail, $client) = @_; my $userinput = "$cmd:$tail"; - my ($inst_class,$courseowner,$cdom) = split(/:/, $tail); - $courseowner = &unescape($courseowner); + my ($inst_class,$ownerlist,$cdom) = split(/:/, $tail); + $ownerlist = &unescape($ownerlist); + my @owners = split(/,/,&unescape($ownerlist)); my $outcome; eval { local($SIG{__DIE__})='DEFAULT'; - $outcome=&localenroll::check_section($inst_class,$courseowner,$cdom); + $outcome=&localenroll::check_section($inst_class,\@owners,$cdom); }; &Reply($client,"$outcome\n", $userinput); @@ -4487,6 +4564,70 @@ sub get_institutional_defaults_handler { ®ister_handler("autoinstcodedefaults", \&get_institutional_defaults_handler,0,1,0); +sub get_institutional_user_rules { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + my $dom = &unescape($tail); + my (%rules_hash,@rules_order); + my $outcome; + eval { + local($SIG{__DIE__})='DEFAULT'; + $outcome = &localenroll::username_rules($dom,\%rules_hash,\@rules_order); + }; + if (!$@) { + if ($outcome eq 'ok') { + my $result; + foreach my $key (keys(%rules_hash)) { + $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rules_hash{$key}).'&'; + } + $result =~ s/\&$//; + $result .= ':'; + if (@rules_order > 0) { + foreach my $item (@rules_order) { + $result .= &escape($item).'&'; + } + } + $result =~ s/\&$//; + &Reply($client,$result."\n",$userinput); + } else { + &Reply($client,"error\n", $userinput); + } + } else { + &Failure($client,"unknown_cmd\n",$userinput); + } +} +®ister_handler("instuserrules",\&get_institutional_user_rules,0,1,0); + + +sub institutional_username_check { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + my %rulecheck; + my $outcome; + my ($udom,$uname,@rules) = split(/:/,$tail); + $udom = &unescape($udom); + $uname = &unescape($uname); + @rules = map {&unescape($_);} (@rules); + eval { + local($SIG{__DIE__})='DEFAULT'; + $outcome = &localenroll::username_check($udom,$uname,\@rules,\%rulecheck); + }; + if (!$@) { + if ($outcome eq 'ok') { + my $result=''; + foreach my $key (keys(%rulecheck)) { + $result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&'; + } + &Reply($client,$result."\n",$userinput); + } else { + &Reply($client,"error\n", $userinput); + } + } else { + &Failure($client,"unknown_cmd\n",$userinput); + } +} +®ister_handler("instrulecheck",\&institutional_username_check,0,1,0); + # Get domain specific conditions for import of student photographs to a course # @@ -4907,7 +5048,7 @@ sub catchexception { $SIG{__DIE__}='DEFAULT'; &status("Catching exception"); &logthis("CRITICAL: " - ."ABNORMAL EXIT. Child $$ for server $thisserver died through " + ."ABNORMAL EXIT. Child $$ for server ".$perlvar{'lonHostID'}." died through " ."a crash with this error msg->[$error]"); &logthis('Famous last words: '.$status.' - '.$lastlog); if ($client) { print $client "error: $error\n"; } @@ -5048,12 +5189,12 @@ sub UpdateHosts { # either dropped or changed hosts. Note that the re-read of the table # will take care of new and changed hosts as connections come into being. - #FIXME need a way to tell lonnet that it needs to reset host - #cached host info + &Apache::lonnet::reset_hosts_info(); foreach my $child (keys(%children)) { my $childip = $children{$child}; - if (defined(&Apache::lonnet::get_hosts_from_ip($childip))) { + if ($childip ne '127.0.0.1' + && !defined(&Apache::lonnet::get_hosts_from_ip($childip))) { logthis(' UpdateHosts killing child ' ." $child for ip $childip "); kill('INT', $child); @@ -5371,8 +5512,6 @@ sub make_new_child { # ----------------------------------------------------------------------------- # see if we know client and 'check' for spoof IP by ineffective challenge - ReadManagerTable; # May also be a manager!! - my $outsideip=$clientip; if ($clientip eq '127.0.0.1') { $outsideip=&Apache::lonnet::get_host_ip($perlvar{'lonHostID'}); @@ -5492,7 +5631,7 @@ sub make_new_child { # ---------------- New known client connecting, could mean machine online again if (&Apache::lonnet::get_host_ip($currenthostid) ne $clientip && $clientip ne '127.0.0.1') { - &Apache::lonnet::reconlonc(); + &Apache::lonnet::reconlonc($clientname); } &logthis("Established connection: $clientname"); &status('Will listen to '.$clientname); @@ -5776,6 +5915,10 @@ sub validate_user { $password, $credentials); $validated = ($krbreturn == 1); + if (!$validated) { + &logthis('krb5: '.$user.', '.$contentpwd.', '. + &Authen::Krb5::error()); + } } else { $validated = 0; } @@ -6021,7 +6164,7 @@ sub subscribe { # the metadata unless ($fname=~/\.meta$/) { &unsub("$fname.meta",$clientip); } $fname=~s/\/home\/httpd\/html\/res/raw/; - $fname="http://$thisserver/".$fname; + $fname="http://".&Apache::lonnet::hostname($perlvar{'lonHostID'})."/".$fname; $result="$fname\n"; } } else {