--- loncom/lond 2012/02/28 15:54:07 1.486
+++ loncom/lond 2012/04/11 21:32:28 1.490
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.486 2012/02/28 15:54:07 raeburn Exp $
+# $Id: lond,v 1.490 2012/04/11 21:32:28 droeschl Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -34,6 +34,7 @@ use strict;
use lib '/home/httpd/lib/perl/';
use LONCAPA;
use LONCAPA::Configuration;
+use LONCAPA::Lond;
use IO::Socket;
use IO::File;
@@ -60,7 +61,7 @@ my $DEBUG = 0; # Non zero to ena
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.486 $'; #' stupid emacs
+my $VERSION='$Revision: 1.490 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -3245,6 +3246,12 @@ sub dump_profile_database {
# that is matched against
# database keywords to do
# selective dumps.
+# range - optional range of entries
+# e.g., 10-20 would return the
+# 10th to 19th items, etc.
+# extra - optional ref to hash of
+# additional args. currently
+# skipcheck is only key used.
# $client - Channel open on the client.
# Returns:
# 1 - Continue processing.
@@ -3254,6 +3261,15 @@ sub dump_profile_database {
sub dump_with_regexp {
my ($cmd, $tail, $client) = @_;
+ #TODO encapsulate $clientname and $clientversion in a object.
+ my $res = LONCAPA::Lond::dump_with_regexp($cmd, $tail, $clientname, $clientversion);
+
+ if ($res =~ /^error:/) {
+ Failure($client, \$res, "$cmd:$tail");
+ } else {
+ Reply($client, \$res, "$cmd:$tail");
+ }
+ return 1;
my $userinput = "$cmd:$tail";
@@ -3279,12 +3295,26 @@ sub dump_with_regexp {
if ($hashref) {
my $qresult='';
my $count=0;
+#
+# When dump is for roles.db, determine if LON-CAPA version checking is needed.
+# Sessions on 2.10 and later will include skipcheck => 1 in extra args ref,
+# to indicate no version checking is needed (in this case, checking occurs
+# on the server hosting the user session, when constructing the roles/courses
+# screen).
+#
if ($extra ne '') {
$extra = &Apache::lonnet::thaw_unescape($extra);
$skipcheck = $extra->{'skipcheck'};
}
my @ids = &Apache::lonnet::current_machine_ids();
my (%homecourses,$major,$minor,$now);
+#
+# If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA
+# version on the server which requested the data. For LON-CAPA 2.9, the
+# client session will have sent its LON-CAPA version when initiating the
+# connection. For LON-CAPA 2.8 and older, the version is retrieved from
+# the global %loncaparevs in lonnet.pm.
+#
if (($namespace eq 'roles') && (!$skipcheck)) {
my $loncaparev = $clientversion;
if ($loncaparev eq '') {
@@ -3302,8 +3332,18 @@ sub dump_with_regexp {
my $cdom = $1;
my $cnum = $2;
unless ($skipcheck) {
- my ($role,$end,$start) = split(/\_/,$value);
- if (!$end || $end > $now) {
+ my ($role,$roleend,$rolestart) = split(/\_/,$value);
+ if (!$roleend || $roleend > $now) {
+#
+# For active course roles, check that requesting server is running a LON-CAPA
+# version which meets any version requirements for the course. Do not include
+# the role amongst the results returned if the requesting server's version is
+# too old.
+#
+# This determination is handled differently depending on whether the course's
+# homeserver is the current server, or whether it is a different server.
+# In both cases, the course's version requirement needs to be retrieved.
+#
next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
$minor,\%homecourses,\@ids));
}
@@ -3326,9 +3366,16 @@ sub dump_with_regexp {
}
}
if (&untie_user_hash($hashref)) {
+#
+# If dump is for roles.db from a pre-2.10 server, check if the LON-CAPA
+# version requirements for courses for which the current server is the home
+# server permit course roles to be usable on the client server hosting the
+# user's session. If so, include those role results in the data returned to
+# the client server.
+#
if (($namespace eq 'roles') && (!$skipcheck)) {
if (keys(%homecourses) > 0) {
- $qresult .= &check_homecourses(\%homecourses,$udom,$regexp,$count,
+ $qresult .= &check_homecourses(\%homecourses,$regexp,$count,
$range,$start,$end,$major,$minor);
}
}
@@ -6282,6 +6329,9 @@ sub Debug {
# reply - Text to send to client.
# request - Original request from client.
#
+#NOTE $reply must be terminated by exactly *one* \n. If $reply is a reference
+#this is done automatically ($$reply must not contain any \n in this case).
+#If $reply is a string the caller has to ensure this.
sub Reply {
my ($fd, $reply, $request) = @_;
if (ref($reply)) {
@@ -6717,14 +6767,22 @@ sub is_author {
# Author role should show up as a key /domain/_au
- my $key = "/$domain/_au";
my $value;
- if (defined($hashref)) {
- $value = $hashref->{$key};
- }
+ if ($hashref) {
- if(defined($value)) {
- &Debug("$user @ $domain is an author");
+ my $key = "/$domain/_au";
+ if (defined($hashref)) {
+ $value = $hashref->{$key};
+ if(!untie_user_hash($hashref)) {
+ return 'error: ' . ($!+0)." untie (GDBM) Failed";
+ }
+ }
+
+ if(defined($value)) {
+ &Debug("$user @ $domain is an author");
+ }
+ } else {
+ return 'error: '.($!+0)." tie (GDBM) Failed";
}
return defined($value);
@@ -7429,6 +7487,20 @@ sub get_usersession_config {
return;
}
+#
+# releasereqd_check() will determine if a LON-CAPA version (defined in the
+# $major,$minor args passed) is not too old to allow use of a role in a
+# course ($cnum,$cdom args passed), if at least one of the following applies:
+# (a) the course is a Community, (b) the course's home server is *not* the
+# current server, or (c) cached course information is not stale.
+#
+# For the case where none of these apply, the course is added to the
+# $homecourse hash ref (keys = courseIDs, values = array of a hash of roles).
+# The $homecourse hash ref is for courses for which the current server is the
+# home server. LON-CAPA version requirements are checked elsewhere for the
+# items in $homecourse.
+#
+
sub releasereqd_check {
my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_;
my $home = &Apache::lonnet::homeserver($cnum,$cdom);
@@ -7458,10 +7530,18 @@ sub releasereqd_check {
if (ref($ids) eq 'ARRAY') {
if (grep(/^\Q$home\E$/,@{$ids})) {
if (ref($homecourses) eq 'HASH') {
- if (ref($homecourses->{$hashid}) eq 'ARRAY') {
- push(@{$homecourses->{$hashid}},{$key=>$value});
+ if (ref($homecourses->{$cdom}) eq 'HASH') {
+ if (ref($homecourses->{$cdom}{$cnum}) eq 'HASH') {
+ if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
+ push(@{$homecourses->{$cdom}{$cnum}},{$key=>$value});
+ } else {
+ $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
+ }
+ } else {
+ $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
+ }
} else {
- $homecourses->{$hashid} = [{$key=>$value}];
+ $homecourses->{$cdom}{$cnum} = [{$key=>$value}];
}
}
return;
@@ -7480,6 +7560,17 @@ sub releasereqd_check {
return 1;
}
+#
+# get_courseinfo_hash() is used to retrieve course information from the db
+# file: nohist_courseids.db for a course for which the current server is *not*
+# the home server.
+#
+# A hash of a hash will be retrieved. The outer hash contains a single key --
+# courseID -- for the course for which the data are being requested.
+# The contents of the inner hash, for that single item in the outer hash
+# are returned (and cached in memcache for 10 minutes).
+#
+
sub get_courseinfo_hash {
my ($cnum,$cdom,$home) = @_;
my %info;
@@ -7505,43 +7596,64 @@ sub get_courseinfo_hash {
return;
}
+#
+# check_homecourses() will retrieve course information for those courses which
+# are keys of the $homecourses hash ref (first arg). The nohist_courseids.db
+# GDBM file is tied and course information for each course retrieved. Last
+# visit (lasttime key) is also retrieved for each, and cached values updated
+# for any courses last visited less than 24 hours ago. Cached values are also
+# updated for any courses included in the $homecourses hash ref.
+#
+# The reason for the 24 hours constraint is that the cron entry in
+# /etc/cron.d/loncapa for /home/httpd/perl/refresh_courseids_db.pl causes
+# cached course information to be updated nightly for courses with activity
+# within the past 24 hours.
+#
+# Role information for the user (included in a ref to an array of hashes as the
+# value for each key in $homecourses) is appended to the result returned by the
+# routine, which will in turn be appended to the string returned to the client
+# hosting the user's session.
+#
+
sub check_homecourses {
- my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
+ my ($homecourses,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
my ($result,%addtocache);
my $yesterday = time - 24*3600;
if (ref($homecourses) eq 'HASH') {
my (%okcourses,%courseinfo,%recent);
- my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
- if ($hashref) {
- while (my ($key,$value) = each(%$hashref)) {
- my $unesc_key = &unescape($key);
- if ($unesc_key =~ /^lasttime:(\w+)$/) {
- my $cid = $1;
- $cid =~ s/_/:/;
- if ($value > $yesterday ) {
- $recent{$cid} = 1;
+ foreach my $domain (keys(%{$homecourses})) {
+ my $hashref =
+ &tie_domain_hash($domain, "nohist_courseids", &GDBM_WRCREAT());
+ if (ref($hashref) eq 'HASH') {
+ while (my ($key,$value) = each(%$hashref)) {
+ my $unesc_key = &unescape($key);
+ if ($unesc_key =~ /^lasttime:(\w+)$/) {
+ my $cid = $1;
+ $cid =~ s/_/:/;
+ if ($value > $yesterday ) {
+ $recent{$cid} = 1;
+ }
+ next;
}
- next;
- }
- my $items = &Apache::lonnet::thaw_unescape($value);
- if (ref($items) eq 'HASH') {
- my $hashid = $unesc_key;
- $hashid =~ s/_/:/;
- $courseinfo{$hashid} = $items;
- if (ref($homecourses->{$hashid}) eq 'ARRAY') {
- my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
- if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
- $okcourses{$hashid} = 1;
+ my $items = &Apache::lonnet::thaw_unescape($value);
+ if (ref($items) eq 'HASH') {
+ my ($cdom,$cnum) = split(/_/,$unesc_key);
+ my $hashid = $cdom.':'.$cnum;
+ $courseinfo{$hashid} = $items;
+ if (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY') {
+ my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
+ if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
+ $okcourses{$hashid} = 1;
+ }
}
}
}
+ unless (&untie_domain_hash($hashref)) {
+ &logthis("Failed to untie tied hash for nohist_courseids.db for $domain");
+ }
+ } else {
+ &logthis("Failed to tie hash for nohist_courseids.db for $domain");
}
- unless (&untie_domain_hash($hashref)) {
- &logthis('Failed to untie tied hash for nohist_courseids.db');
- }
- } else {
- &logthis('Failed to tie hash for nohist_courseids.db');
- return;
}
foreach my $hashid (keys(%recent)) {
my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);
@@ -7549,13 +7661,20 @@ sub check_homecourses {
&Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
}
}
- foreach my $hashid (keys(%{$homecourses})) {
- next if ($recent{$hashid});
- &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
+ foreach my $cdom (keys(%{$homecourses})) {
+ if (ref($homecourses->{$cdom}) eq 'HASH') {
+ foreach my $cnum (keys(%{$homecourses->{$cdom}})) {
+ my $hashid = $cdom.':'.$cnum;
+ next if ($recent{$hashid});
+ &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
+ }
+ }
}
foreach my $hashid (keys(%okcourses)) {
- if (ref($homecourses->{$hashid}) eq 'ARRAY') {
- foreach my $role (@{$homecourses->{$hashid}}) {
+ my ($cdom,$cnum) = split(/:/,$hashid);
+ if ((ref($homecourses->{$cdom}) eq 'HASH') &&
+ (ref($homecourses->{$cdom}{$cnum}) eq 'ARRAY')) {
+ foreach my $role (@{$homecourses->{$cdom}{$cnum}}) {
if (ref($role) eq 'HASH') {
while (my ($key,$value) = each(%{$role})) {
if ($regexp eq '.') {
@@ -7581,6 +7700,12 @@ sub check_homecourses {
return $result;
}
+#
+# useable_role() will compare the LON-CAPA version required by a course with
+# the version available on the client server. If the client server's version
+# is compatible, 1 will be returned.
+#
+
sub useable_role {
my ($reqdmajor,$reqdminor,$major,$minor) = @_;
if ($reqdmajor ne '' && $reqdminor ne '') {
@@ -7919,6 +8044,8 @@ Authen::Krb5
=head1 COREQUISITES
+none
+
=head1 OSNAMES
linux
@@ -8006,9 +8133,9 @@ or the CA's certificate in the call to l
<error> is the textual reason this failed. Usual reasons:
=over 2
-
+
=item Apache config file for loncapa incorrect:
-
+
one of the variables
lonCertificateDirectory, lonnetCertificateAuthority, or lonnetCertificate
undefined or incorrect
@@ -8127,7 +8254,7 @@ Could not rewrite the
internal password file for a user
=item Result of password change for <user> : <result>
-
+
A unix password change for <user> was attempted
and the pipe returned <result>
@@ -8156,7 +8283,7 @@ lond has been asked to exit by its clien
client systemand <input> is the full exit command sent to the server.
=item Red CRITICAL: ABNORMAL EXIT. child <pid> for server <hostname> died through a crass with this error->[<message>].
-
+
A lond child terminated. NOte that this termination can also occur when the
child receives the QUIT or DIE signals. <pid> is the process id of the child,
<hostname> the host lond is working for, and <message> the reason the child died
@@ -8240,7 +8367,7 @@ file when sent it's USR1 signal. That p
assumed to be hung in some un-fixable way.
=item Finished checking children
-
+
Master processs's USR1 processing is cojmplete.
=item (Red) CRITICAL: ------- Starting ------
@@ -8254,7 +8381,7 @@ Started a new child process for <client>
connected to the child. This was as a result of a TCP/IP connection from a client.
=item Unable to determine who caller was, getpeername returned nothing
-
+
In child process initialization. either getpeername returned undef or
a zero sized object was returned. Processing continues, but in my opinion,
this should be cause for the child to exit.
@@ -8265,7 +8392,7 @@ In child process initialization. The pe
The client address is stored as "Unavailable" and processing continues.
=item (Yellow) INFO: Connection <ip> <name> connection type = <type>
-
+
In child initialization. A good connectionw as received from <ip>.
=over 2
@@ -8315,7 +8442,7 @@ The client (<client> is the peer's name
negotiated an SSL connection with this child process.
=item (Green) Successful insecure authentication with <client>
-
+
The client has successfully negotiated an insecure connection withthe child process.