--- loncom/lond 2007/01/08 16:23:48 1.353
+++ loncom/lond 2007/03/12 22:24:58 1.362
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.353 2007/01/08 16:23:48 albertel Exp $
+# $Id: lond,v 1.362 2007/03/12 22:24:58 albertel 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.353 $'; #' stupid emacs
+my $VERSION='$Revision: 1.362 $'; #' 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:
@@ -1269,6 +1268,7 @@ sub du_handler {
my $code=sub {
if ($_=~/\.\d+\./) { return;}
if ($_=~/\.meta$/) { return;}
+ if (-d $_) { return;}
$total_size+=(stat($_))[7];
};
chdir($ududir);
@@ -3293,13 +3293,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
@@ -3599,7 +3600,7 @@ sub get_domain_handler {
return 1;
}
-®ister_handler("getdom", \&get_id_handler, 0, 1, 0);
+®ister_handler("getdom", \&get_domain_handler, 0, 1, 0);
#
@@ -4630,6 +4631,31 @@ sub student_photo_handler {
}
®ister_handler("studentphoto", \&student_photo_handler, 0, 1, 0);
+sub inst_usertypes_handler {
+ my ($cmd, $domain, $client) = @_;
+ my $res;
+ my $userinput = $cmd.":".$domain; # For logging purposes.
+ my (%typeshash,@order);
+ if (&localenroll::inst_usertypes($domain,\%typeshash,\@order) eq 'ok') {
+ if (keys(%typeshash) > 0) {
+ foreach my $key (keys(%typeshash)) {
+ $res.=&escape($key).'='.&escape($typeshash{$key}).'&';
+ }
+ }
+ $res=~s/\&$//;
+ $res .= ':';
+ if (@order > 0) {
+ foreach my $item (@order) {
+ $res .= &escape($item).'&';
+ }
+ }
+ $res=~s/\&$//;
+ }
+ &Reply($client, "$res\n", $userinput);
+ return 1;
+}
+®ister_handler("inst_usertypes", \&inst_usertypes_handler, 0, 1, 0);
+
# mkpath makes all directories for a file, expects an absolute path with a
# file or a trailing / if just a dir is passed
# returns 1 on success 0 on failure
@@ -5466,8 +5492,8 @@ sub make_new_child {
# my $tmpsnum=0; # Now global
#---------------------------------------------------- kerberos 5 initialization
&Authen::Krb5::init_context();
- unless (($dist eq 'fedora5') || ($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();
}
@@ -5880,7 +5906,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,
@@ -5895,6 +5922,10 @@ sub validate_user {
$password,
$contentpwd,
$domain);
+ if ($validated < 0) {
+ &logthis("localauth for $contentpwd $user:$domain returned a $validated");
+ $validated = 0;
+ }
} else { # Unrecognized auth is also bad.
$validated = 0;
}
@@ -5920,8 +5951,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>) {
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.