--- loncom/lond 2007/04/10 23:11:30 1.373
+++ loncom/lond 2007/10/06 04:32:23 1.384
@@ -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.384 2007/10/06 04:32: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.384 $'; #' 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,6 +3305,22 @@ sub put_course_id_handler {
foreach my $pair (@pairs) {
my ($key,$courseinfo) = split(/=/,$pair,2);
$courseinfo =~ s/=/:/g;
+ if (defined($hashref->{$key})) {
+ my $value = &Apache::lonnet::thaw_unescape($hashref->{$key});
+ if (ref($value) eq 'HASH') {
+ my @items = ('description','inst_code','owner','type');
+ my @new_items = split(/:/,$courseinfo,-1);
+ my %storehash;
+ for (my $i=0; $i<@new_items; $i++) {
+ $storehash{$items[$i]} = $new_items[$i];
+ }
+ $hashref->{$key} =
+ &Apache::lonnet::freeze_escape(\%storehash);
+ my $unesc_key = &unescape($key);
+ $hashref->{&escape('lasttime:'.$unesc_key)} = $now;
+ next;
+ }
+ }
my @current_items = split(/:/,$hashref->{$key},-1);
shift(@current_items); # remove description
pop(@current_items); # remove last access
@@ -3289,7 +3337,7 @@ sub put_course_id_handler {
}
}
}
- $hashref->{$key}=$courseinfo.':'.$now;
+ $hashref->{$key}=$courseinfo.':'.$now;
}
if (&untie_domain_hash($hashref)) {
&Reply( $client, "ok\n", $userinput);
@@ -3303,12 +3351,54 @@ 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,$mode,$what) = split(/:/, $tail,3);
+ chomp($what);
+ my $now=time;
+ my @pairs=split(/\&/,$what);
+ my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
+ if ($hashref) {
+ foreach my $pair (@pairs) {
+ my ($key,$value)=split(/=/,$pair);
+ my $unesc_key = &unescape($key);
+ if ($mode ne 'timeonly') {
+ if (!defined($hashref->{&escape('lasttime:'.$unesc_key)})) {
+ my $curritems = &Apache::lonnet::thaw_unescape($key);
+ if (ref($curritems) ne 'HASH') {
+ my @current_items = split(/:/,$hashref->{$key},-1);
+ my $lasttime = pop(@current_items);
+ $hashref->{&escape('lasttime:'.$unesc_key)} = $lasttime;
+ } else {
+ $hashref->{&escape('lasttime:'.$unesc_key)} = '';
+ }
+ }
+ $hashref->{$key} = $value;
+ }
+ if ($mode ne 'notime') {
+ $hashref->{&escape('lasttime:'.$unesc_key)} = $now;
+ }
+ }
+ 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
@@ -3335,6 +3425,15 @@ sub put_course_id_handler {
# owner matches the supplied username and/or domain
# will be returned. Pre-2.2.0 legacy entries from
# nohist_courseiddump will only contain usernames.
+# type - optional parameter for selection
+# regexp_ok - if true, allow the supplied institutional code
+# filter to behave as a regular expression.
+# rtn_as_hash - whether to return the information available for
+# each matched item as a frozen hash of all
+# key, value pairs in the item's hash, or as a
+# colon-separated list of (in order) description,
+# institutional code, and course owner.
+#
# $client - The socket open on the client.
# Returns:
# 1 - Continue processing.
@@ -3342,11 +3441,10 @@ sub put_course_id_handler {
# a reply is written to $client.
sub dump_course_id_handler {
my ($cmd, $tail, $client) = @_;
-
my $userinput = "$cmd:$tail";
my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
- $typefilter,$regexp_ok) =split(/:/,$tail);
+ $typefilter,$regexp_ok,$rtn_as_hash) =split(/:/,$tail);
if (defined($description)) {
$description=&unescape($description);
} else {
@@ -3386,62 +3484,94 @@ sub dump_course_id_handler {
if (defined($regexp_ok)) {
$regexp_ok=&unescape($regexp_ok);
}
-
- unless (defined($since)) { $since=0; }
+ my $unpack = 1;
+ if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' &&
+ $typefilter eq '.') {
+ $unpack = 0;
+ }
+ if (!defined($since)) { $since=0; }
my $qresult='';
my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
if ($hashref) {
while (my ($key,$value) = each(%$hashref)) {
- my ($descr,$lasttime,$inst_code,$owner,$type);
- my @courseitems = split(/:/,$value);
- $lasttime = pop(@courseitems);
- ($descr,$inst_code,$owner,$type)=@courseitems;
- if ($lasttime<$since) { next; }
+ my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val,%unesc_val);
+ $unesc_key = &unescape($key);
+ if ($unesc_key =~ /^lasttime:/) {
+ next;
+ } else {
+ $lasttime_key = &escape('lasttime:'.$unesc_key);
+ }
+ if ($hashref->{$lasttime_key} ne '') {
+ $lasttime = $hashref->{$lasttime_key};
+ next if ($lasttime<$since);
+ }
+ my $items = &Apache::lonnet::thaw_unescape($value);
+ if (ref($items) eq 'HASH') {
+ $is_hash = 1;
+ if ($unpack || !$rtn_as_hash) {
+ $unesc_val{'descr'} = $items->{'description'};
+ $unesc_val{'inst_code'} = $items->{'inst_code'};
+ $unesc_val{'owner'} = $items->{'owner'};
+ $unesc_val{'type'} = $items->{'type'};
+ }
+ } else {
+ $is_hash = 0;
+ my @courseitems = split(/:/,&unescape($value));
+ $lasttime = pop(@courseitems);
+ next if ($lasttime<$since);
+ ($val{'descr'},$val{'inst_code'},$val{'owner'},$val{'type'}) = @courseitems;
+ }
my $match = 1;
- unless ($description eq '.') {
- my $unescapeDescr = &unescape($descr);
- unless (eval('$unescapeDescr=~/\Q$description\E/i')) {
+ if ($description ne '.') {
+ if (!$is_hash) {
+ $unesc_val{'descr'} = &unescape($val{'descr'});
+ }
+ if (eval{$unesc_val{'descr'} !~ /\Q$description\E/i}) {
$match = 0;
- }
+ }
}
- unless ($instcodefilter eq '.' || !defined($instcodefilter)) {
- my $unescapeInstcode = &unescape($inst_code);
+ if ($instcodefilter ne '.') {
+ if (!$is_hash) {
+ $unesc_val{'inst_code'} = &unescape($val{'inst_code'});
+ }
if ($regexp_ok) {
- unless (eval('$unescapeInstcode=~/$instcodefilter/')) {
+ if (eval{$unesc_val{'inst_code'} !~ /$instcodefilter/}) {
$match = 0;
}
} else {
- unless (eval('$unescapeInstcode=~/\Q$instcodefilter\E/i')) {
+ if (eval{$unesc_val{'inst_code'} !~ /\Q$instcodefilter\E/i}) {
$match = 0;
}
}
}
- unless ($ownerfilter eq '.' || !defined($ownerfilter)) {
- my $unescapeOwner = &unescape($owner);
+ if ($ownerfilter ne '.') {
+ if (!$is_hash) {
+ $unesc_val{'owner'} = &unescape($val{'owner'});
+ }
if (($ownerunamefilter ne '') && ($ownerdomfilter ne '')) {
- if ($unescapeOwner =~ /:/) {
- if (eval('$unescapeOwner !~
- /\Q$ownerunamefilter\E:\Q$ownerdomfilter\E$/i')) {
+ if ($unesc_val{'owner'} =~ /:/) {
+ if (eval{$unesc_val{'owner'} !~
+ /\Q$ownerunamefilter\E:\Q$ownerdomfilter\E$/i}) {
$match = 0;
}
} else {
- if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E/i')) {
+ if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E/i}) {
$match = 0;
}
}
} elsif ($ownerunamefilter ne '') {
- if ($unescapeOwner =~ /:/) {
- if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E:[^:]+$/i')) {
+ if ($unesc_val{'owner'} =~ /:/) {
+ if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E:[^:]+$/i}) {
$match = 0;
}
} else {
- if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E/i')) {
+ if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E/i}) {
$match = 0;
}
}
} elsif ($ownerdomfilter ne '') {
- if ($unescapeOwner =~ /:/) {
- if (eval('$unescapeOwner!~/^[^:]+:\Q$ownerdomfilter\E/')) {
+ if ($unesc_val{'owner'} =~ /:/) {
+ if (eval{$unesc_val{'owner'} !~ /^[^:]+:\Q$ownerdomfilter\E/}) {
$match = 0;
}
} else {
@@ -3451,26 +3581,48 @@ sub dump_course_id_handler {
}
}
}
- unless ($coursefilter eq '.' || !defined($coursefilter)) {
- my $unescapeCourse = &unescape($key);
- unless (eval('$unescapeCourse=~/^$udom(_)\Q$coursefilter\E$/')) {
+ if ($coursefilter ne '.') {
+ if (eval{$unesc_key !~ /^$udom(_)\Q$coursefilter\E$/}) {
$match = 0;
}
}
- unless ($typefilter eq '.' || !defined($typefilter)) {
- my $unescapeType = &unescape($type);
- if ($type eq '') {
+ if ($typefilter ne '.') {
+ if (!$is_hash) {
+ $unesc_val{'type'} = &unescape($val{'type'});
+ }
+ if ($unesc_val{'type'} eq '') {
if ($typefilter ne 'Course') {
$match = 0;
}
- } else {
- unless (eval('$unescapeType=~/^\Q$typefilter\E$/')) {
+ } else {
+ if (eval{$unesc_val{'type'} !~ /^\Q$typefilter\E$/}) {
$match = 0;
}
}
}
if ($match == 1) {
- $qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';
+ if ($rtn_as_hash) {
+ if ($is_hash) {
+ $qresult.=$key.'='.$value.'&';
+ } else {
+ my %rtnhash = ( 'description' => &escape($val{'descr'}),
+ 'inst_code' => &escape($val{'inst_code'}),
+ 'owner' => &escape($val{'owner'}),
+ 'type' => &escape($val{'type'}),
+ );
+ my $items = &Apache::lonnet::freeze_escape(\%rtnhash);
+ $qresult.=$key.'='.$items.'&';
+ }
+ } else {
+ if ($is_hash) {
+ $qresult .= $key.'='.&escape($unesc_val{'descr'}).':'.
+ &escape($unesc_val{'inst_code'}).':'.
+ &escape($unesc_val{'owner'}).'&';
+ } else {
+ $qresult .= $key.'='.$val{'descr'}.':'.$val{'inst_code'}.
+ ':'.$val{'owner'}.'&';
+ }
+ }
}
}
if (&untie_domain_hash($hashref)) {
@@ -3484,8 +3636,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 +4454,12 @@ 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);
+ 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 +4633,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 +5262,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('<font color="blue"> UpdateHosts killing child '
." $child for ip $childip </font>");
kill('INT', $child);
@@ -5485,7 +5700,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("<font color='green'>Established connection: $clientname</font>");
&status('Will listen to '.$clientname);
@@ -5769,6 +5984,10 @@ sub validate_user {
$password,
$credentials);
$validated = ($krbreturn == 1);
+ if (!$validated) {
+ &logthis('krb5: '.$user.', '.$contentpwd.', '.
+ &Authen::Krb5::error());
+ }
} else {
$validated = 0;
}