--- loncom/lond 2007/01/19 03:09:07 1.358 +++ loncom/lond 2007/03/28 00:05:38 1.363 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.358 2007/01/19 03:09:07 albertel Exp $ +# $Id: lond,v 1.363 2007/03/28 00:05:38 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -59,7 +59,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.358 $'; #' stupid emacs +my $VERSION='$Revision: 1.363 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -1268,6 +1268,7 @@ sub du_handler { my $code=sub { if ($_=~/\.\d+\./) { return;} if ($_=~/\.meta$/) { return;} + if (-d $_) { return;} $total_size+=(stat($_))[7]; }; chdir($ududir); @@ -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 ($server) = @_; + my $client=IO::Socket::UNIX->new(Peer => $perlvar{'lonSockCreate'}, + Type => SOCK_STREAM, + Timeout => 10); + return 0 if (!$client); + print $client ("$server\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}); + } + 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,