--- loncom/lond 2006/11/27 16:33:38 1.349 +++ loncom/lond 2007/03/28 20:28:29 1.364 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.349 2006/11/27 16:33:38 albertel Exp $ +# $Id: lond,v 1.364 2007/03/28 20:28:29 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.349 $'; #' stupid emacs +my $VERSION='$Revision: 1.364 $'; #' 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); @@ -3053,9 +3053,9 @@ sub restore_handler { my ($cmd, $tail, $client) = @_; my $userinput = "$cmd:$tail"; # Only used for logging purposes. - $namespace=~s/\W//g; my ($udom,$uname,$namespace,$rid) = split(/:/,$tail); $namespace=~s/\//\_/g; + $namespace = &LONCAPA::clean_username($namespace); chomp($rid); my $qresult=''; @@ -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 @@ -5283,15 +5309,36 @@ sub reconlonc { } } -# -------------------------------------------------- Non-critical communication +sub create_connection { + my ($hostname,$lonid) = @_; + my $client=IO::Socket::UNIX->new(Peer => $perlvar{'lonSockCreate'}, + Type => SOCK_STREAM, + Timeout => 10); + return 0 if (!$client); + print $client ("$hostname:$lonid\n"); + my $result = <$client>; + chomp($result); + return 1 if ($result eq 'done'); + return 0; +} +# -------------------------------------------------- Non-critical communication +my $max_connection_retries = 10; sub subreply { my ($cmd,$server)=@_; my $peerfile="$perlvar{'lonSockDir'}/".$hostname{$server}; - my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile", - Type => SOCK_STREAM, - Timeout => 10) - or return "con_lost"; + my $sclient; + for (my $retries = 0; $retries < $max_connection_retries; $retries++) { + $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile", + Type => SOCK_STREAM, + Timeout => 10); + if($sclient) { + last; # Connected! + } else { + &create_connection($hostname{$server},$server); + } + sleep(1); # Try again later if failed connection. + } print $sclient "sethost:$server:$cmd\n"; my $answer=<$sclient>; chomp($answer); @@ -5466,8 +5513,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 +5927,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, @@ -5893,7 +5941,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; } @@ -5919,8 +5972,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>) {