--- loncom/lond 2007/04/10 23:11:30 1.373
+++ loncom/lond 2007/10/08 21:05:49 1.386
@@ -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.386 2007/10/08 21:05:49 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -33,7 +33,6 @@ use strict;
use lib '/home/httpd/lib/perl/';
use LONCAPA;
use LONCAPA::Configuration;
-use Apache::lonnet;
use IO::Socket;
use IO::File;
@@ -53,13 +52,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.386 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -135,7 +135,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 +2095,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 +2218,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 +3304,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 +3336,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 +3350,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 +3424,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 +3440,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 +3483,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 +3580,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 +3635,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 +4453,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 +4632,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 +5261,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 +5699,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 +5983,10 @@ sub validate_user {
$password,
$credentials);
$validated = ($krbreturn == 1);
+ if (!$validated) {
+ &logthis('krb5: '.$user.', '.$contentpwd.', '.
+ &Authen::Krb5::error());
+ }
} else {
$validated = 0;
}
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.