--- loncom/lond 2007/04/10 23:11:30 1.373
+++ 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.373 2007/04/10 23:11:30 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.373 $'; #' stupid emacs
+my $VERSION='$Revision: 1.383 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -135,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.",
@@ -2095,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
#
@@ -2187,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.
@@ -3273,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);
@@ -3303,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
@@ -3346,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 {
@@ -3391,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 '.') {
@@ -3451,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$/')) {
@@ -3463,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)) {
@@ -3484,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);
@@ -4304,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);
@@ -4483,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
#
@@ -5048,7 +5193,8 @@ sub UpdateHosts {
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);
@@ -5485,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);
@@ -5769,6 +5915,10 @@ sub validate_user {
$password,
$credentials);
$validated = ($krbreturn == 1);
+ if (!$validated) {
+ &logthis('krb5: '.$user.', '.$contentpwd.', '.
+ &Authen::Krb5::error());
+ }
} else {
$validated = 0;
}