[LON-CAPA-cvs] cvs: loncom / Lond.pm lond
droeschl
droeschl at source.lon-capa.org
Wed Apr 11 17:32:29 EDT 2012
droeschl Wed Apr 11 21:32:29 2012 EDT
Added files:
/loncom Lond.pm
Modified files:
/loncom lond
Log:
*work in progress* BZ #6585
Outsource functional aspects of lond into a separate module Lond.pm.
Functionality in Lond.pm will be used in lond and lonnet. lond will continue
to handle data transfer across the network while lonnet will handle requests
(e.g. dump) in cases where the request originates from the library server that
hosts the data. Thus avoiding serialization and IPC through several sockets
(lonnet <unix socket> lonc <inet socket> lond <- file.db becomes
lonnet <- file.db).
This greatly improves performance on library servers that are also used as
access servers.
See Bugzilla 6585 for details.
-------------- next part --------------
Index: loncom/lond
diff -u loncom/lond:1.489 loncom/lond:1.490
--- loncom/lond:1.489 Wed Apr 11 06:22:04 2012
+++ loncom/lond Wed Apr 11 21:32:28 2012
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.489 2012/04/11 06:22:04 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 lib '/home/httpd/lib/perl/';
use LONCAPA;
use LONCAPA::Configuration;
+use LONCAPA::Lond;
use IO::Socket;
use IO::File;
@@ -60,7 +61,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.489 $'; #' stupid emacs
+my $VERSION='$Revision: 1.490 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -3260,6 +3261,15 @@
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";
@@ -6319,6 +6329,9 @@
# 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)) {
@@ -8031,6 +8044,8 @@
=head1 COREQUISITES
+none
+
=head1 OSNAMES
linux
@@ -8118,9 +8133,9 @@
<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
@@ -8239,7 +8254,7 @@
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>
@@ -8268,7 +8283,7 @@
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
@@ -8352,7 +8367,7 @@
assumed to be hung in some un-fixable way.
=item Finished checking children
-
+
Master processs's USR1 processing is cojmplete.
=item (Red) CRITICAL: ------- Starting ------
@@ -8366,7 +8381,7 @@
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.
@@ -8377,7 +8392,7 @@
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
@@ -8427,7 +8442,7 @@
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.
Index: loncom/Lond.pm
+++ loncom/Lond.pm
# The LearningOnline Network
#
# $Id: Lond.pm,v 1.1 2012/04/11 21:32:28 droeschl Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
###
#NOTE perldoc at the end of file
package LONCAPA::Lond;
use strict;
use lib '/home/httpd/lib/perl/';
use LONCAPA;
use Apache::lonnet;
use GDBM_File;
sub dump_with_regexp {
#TODO encapsulate $clientname and $clientversion in a object.
my ( $cmd, $tail, $clientname, $clientversion ) = @_;
my $userinput = "$cmd:$tail";
my ($udom,$uname,$namespace,$regexp,$range,$extra)=split(/:/,$tail);
if (defined($regexp)) {
$regexp=&unescape($regexp);
} else {
$regexp='.';
}
my ($start,$end);
if (defined($range)) {
if ($range =~/^(\d+)\-(\d+)$/) {
($start,$end) = ($1,$2);
} elsif ($range =~/^(\d+)$/) {
($start,$end) = (0,$1);
} else {
undef($range);
}
}
Apache::lonnet::logthis("Lond.pm: udom:[$udom] uname:[$uname] namespace:[$namespace]");
my $hashref = &tie_user_hash($udom, $uname, $namespace,
&GDBM_READER());
my $skipcheck;
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 '') {
$loncaparev = $Apache::lonnet::loncaparevs{$clientname};
}
if ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
$major = $1;
$minor = $2;
}
$now = time;
}
while (my ($key,$value) = each(%$hashref)) {
if ($namespace eq 'roles') {
if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) {
my $cdom = $1;
my $cnum = $2;
unless ($skipcheck) {
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));
}
}
}
}
if ($regexp eq '.') {
$count++;
if (defined($range) && $count >= $end) { last; }
if (defined($range) && $count < $start) { next; }
$qresult.=$key.'='.$value.'&';
} else {
my $unescapeKey = &unescape($key);
if (eval('$unescapeKey=~/$regexp/')) {
$count++;
if (defined($range) && $count >= $end) { last; }
if (defined($range) && $count < $start) { next; }
$qresult.="$key=$value&";
}
}
}
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,$regexp,$count,
$range,$start,$end,$major,$minor);
}
}
chop($qresult);
Apache::lonnet::logthis("Lond.pm: qresult:[$qresult]");
return $qresult;
#&Reply($client, \$qresult, $userinput);
} else {
return "error: ".($!+0)." untie(GDBM) Failed while attempting dump";
#&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
# "while attempting dump\n", $userinput);
}
} else {
return "error: ".($!+0)." tie(GDBM) Failed while attempting dump";
#&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
# "while attempting dump\n", $userinput);
}
#never get here
die("SHOULD NOT HAPPEN!");
return 1;
}
1;
__END__
=head1 NAME
LONCAPA::Lond.pm
=head1 SYNOPSIS
#TODO
=head1 DESCRIPTION
#TODO
=head1 METHODS
=over 4
=item dump_with_regexp( $cmd, $tail, $client )
Dump a profile database with an optional regular expression to match against
the keys. In this dump, no effort is made to separate symb from version
information. Presumably the databases that are dumped by this command are of a
different structure. Need to look at this and improve the documentation of
both this and the currentdump handler.
$cmd is the command keyword.
$tail a colon separated list containing
=over
=item domain
=item user
identifying the user.
=item namespace
identifying the database.
=item regexp
optional regular expression that is matched against database keywords to do
selective dumps.
=item range
optional range of entries e.g., 10-20 would return the 10th to 19th items, etc.
=item extra
optional ref to hash of additional args. currently skipcheck is only key used.
=back
$client is the channel open on the client.
Returns: 1 (Continue processing).
Side effects: response is written to $client.
=back
=head1 BUGS
No known bugs at this time.
=head1 SEE ALSO
L<Apache::lonnet>, L<lond>
=cut
More information about the LON-CAPA-cvs
mailing list