--- loncom/lond 2007/01/10 19:18:12 1.354 +++ 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.354 2007/01/10 19:18:12 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.354 $'; #' stupid emacs +my $VERSION='$Revision: 1.362 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -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>) {