--- loncom/lond 2006/11/10 02:01:55 1.347
+++ loncom/lond 2007/01/28 18:49:49 1.359
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.347 2006/11/10 02:01:55 raeburn Exp $
+# $Id: lond,v 1.359 2007/01/28 18:49:49 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -44,7 +44,6 @@ use Digest::MD5 qw(md5_hex);
use GDBM_File;
use Authen::Krb4;
use Authen::Krb5;
-use lib '/home/httpd/lib/perl/';
use localauth;
use localenroll;
use localstudentphoto;
@@ -60,7 +59,7 @@ my $DEBUG = 0; # Non zero to ena
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.347 $'; #' stupid emacs
+my $VERSION='$Revision: 1.359 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -504,30 +503,30 @@ sub AdjustHostContents {
my $adjusted;
my $me = $perlvar{'lonHostID'};
- foreach my $line (split(/\n/,$contents)) {
+ foreach my $line (split(/\n/,$contents)) {
if(!(($line eq "") || ($line =~ /^ *\#/) || ($line =~ /^ *$/))) {
chomp($line);
my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon)=split(/:/,$line);
if ($id eq $me) {
- my $ip = gethostbyname($name);
- my $ipnew = inet_ntoa($ip);
- $ip = $ipnew;
+ my $ip = gethostbyname($name);
+ my $ipnew = inet_ntoa($ip);
+ $ip = $ipnew;
# Reconstruct the host line and append to adjusted:
- my $newline = "$id:$domain:$role:$name:$ip";
- if($maxcon ne "") { # Not all hosts have loncnew tuning params
- $newline .= ":$maxcon:$idleto:$mincon";
- }
- $adjusted .= $newline."\n";
+ my $newline = "$id:$domain:$role:$name:$ip";
+ if($maxcon ne "") { # Not all hosts have loncnew tuning params
+ $newline .= ":$maxcon:$idleto:$mincon";
+ }
+ $adjusted .= $newline."\n";
- } else { # Not me, pass unmodified.
- $adjusted .= $line."\n";
- }
+ } else { # Not me, pass unmodified.
+ $adjusted .= $line."\n";
+ }
} else { # Blank or comment never re-written.
$adjusted .= $line."\n"; # Pass blanks and comments as is.
}
- }
- return $adjusted;
+ }
+ return $adjusted;
}
#
# InstallFile: Called to install an administrative file:
@@ -3053,10 +3052,10 @@ sub restore_handler {
my ($cmd, $tail, $client) = @_;
my $userinput = "$cmd:$tail"; # Only used for logging purposes.
-
my ($udom,$uname,$namespace,$rid) = split(/:/,$tail);
$namespace=~s/\//\_/g;
- $namespace=~s/\W//g;
+ $namespace = &LONCAPA::clean_username($namespace);
+
chomp($rid);
my $qresult='';
my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER());
@@ -3293,13 +3292,14 @@ sub put_course_id_handler {
foreach my $pair (@pairs) {
my ($key,$courseinfo) = split(/=/,$pair,2);
$courseinfo =~ s/=/:/g;
-
- my @current_items = split(/:/,$hashref->{$key});
+ my @current_items = split(/:/,$hashref->{$key},-1);
shift(@current_items); # remove description
pop(@current_items); # remove last access
my $numcurrent = scalar(@current_items);
-
- my @new_items = split(/:/,$courseinfo);
+ 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
@@ -3510,6 +3510,99 @@ sub dump_course_id_handler {
®ister_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0);
#
+# Puts an unencrypted entry in a namespace db file at the domain level
+#
+# Parameters:
+# $cmd - The command that got us here.
+# $tail - Tail of the command (remaining parameters).
+# $client - File descriptor connected to client.
+# Returns
+# 0 - Requested to exit, caller should shut down.
+# 1 - Continue processing.
+# Side effects:
+# reply is written to $client.
+#
+sub put_domain_handler {
+ my ($cmd,$tail,$client) = @_;
+
+ my $userinput = "$cmd:$tail";
+
+ my ($udom,$namespace,$what) =split(/:/,$tail,3);
+ chomp($what);
+ my @pairs=split(/\&/,$what);
+ my $hashref = &tie_domain_hash($udom, "$namespace", &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 putdom\n", $userinput);
+ }
+ } else {
+ &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+ "while attempting putdom\n", $userinput);
+ }
+
+ return 1;
+}
+®ister_handler("putdom", \&put_domain_handler, 0, 1, 0);
+
+# Unencrypted get from the namespace database file at the domain level.
+# This function retrieves a keyed item from a specific named database in the
+# domain directory.
+#
+# Parameters:
+# $cmd - Command request keyword (get).
+# $tail - Tail of the command. This is a colon separated list
+# consisting of the domain and the 'namespace'
+# which selects the gdbm file to do the lookup in,
+# & separated list of keys to lookup. Note that
+# the values are returned as an & separated list too.
+# $client - File descriptor open on the client.
+# Returns:
+# 1 - Continue processing.
+# 0 - Exit.
+# Side effects:
+# reply is written to $client.
+#
+
+sub get_domain_handler {
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput = "$client:$tail";
+
+ my ($udom,$namespace,$what)=split(/:/,$tail,3);
+ chomp($what);
+ my @queries=split(/\&/,$what);
+ my $qresult='';
+ my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER());
+ if ($hashref) {
+ for (my $i=0;$i<=$#queries;$i++) {
+ $qresult.="$hashref->{$queries[$i]}&";
+ }
+ if (&untie_domain_hash($hashref)) {
+ $qresult=~s/\&$//;
+ &Reply($client, "$qresult\n", $userinput);
+ } else {
+ &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
+ "while attempting getdom\n",$userinput);
+ }
+ } else {
+ &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+ "while attempting getdom\n",$userinput);
+ }
+
+ return 1;
+}
+®ister_handler("getdom", \&get_id_handler, 0, 1, 0);
+
+
+#
# Puts an id to a domains id database.
#
# Parameters:
@@ -5373,7 +5466,8 @@ sub make_new_child {
# my $tmpsnum=0; # Now global
#---------------------------------------------------- kerberos 5 initialization
&Authen::Krb5::init_context();
- unless (($dist eq 'fedora4') || ($dist eq 'suse9.3')) {
+ unless (($dist eq 'fedora5') || ($dist eq 'fedora4') ||
+ ($dist eq 'fedora6') || ($dist eq 'suse9.3')) {
&Authen::Krb5::init_ets();
}
@@ -5786,7 +5880,8 @@ sub validate_user {
my $krbservice = "krbtgt/".$contentpwd."\@".$contentpwd;
my $krbserver = &Authen::Krb5::parse_name($krbservice);
my $credentials= &Authen::Krb5::cc_default();
- $credentials->initialize($krbclient);
+ $credentials->initialize(&Authen::Krb5::parse_name($user.'@'
+ .$contentpwd));
my $krbreturn = &Authen::Krb5::get_in_tkt_with_password($krbclient,
$krbserver,
$password,
@@ -5799,7 +5894,12 @@ sub validate_user {
# Authenticate via installation specific authentcation method:
$validated = &localauth::localauth($user,
$password,
- $contentpwd);
+ $contentpwd,
+ $domain);
+ if ($validated < 0) {
+ &logthis("localauth for $contentpwd $user:$domain returned a $validated");
+ $validated = 0;
+ }
} else { # Unrecognized auth is also bad.
$validated = 0;
}
@@ -5825,8 +5925,7 @@ sub addline {
my ($fname,$hostid,$ip,$newline)=@_;
my $contents;
my $found=0;
- my $expr='^'.$hostid.':'.$ip.':';
- $expr =~ s/\./\\\./g;
+ my $expr='^'.quotemeta($hostid).':'.quotemeta($ip).':';
my $sh;
if ($sh=IO::File->new("$fname.subscription")) {
while (my $subline=<$sh>) {