--- loncom/lond 2006/03/27 19:52:16 1.305.2.5 +++ loncom/lond 2006/02/09 20:48:40 1.318.2.3 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.305.2.5 2006/03/27 19:52:16 albertel Exp $ +# $Id: lond,v 1.318.2.3 2006/02/09 20:48:40 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -61,7 +61,7 @@ my $status=''; my $lastlog=''; my $lond_max_wait_time = 13; -my $VERSION='$Revision: 1.305.2.5 $'; #' stupid emacs +my $VERSION='$Revision: 1.318.2.3 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -89,6 +89,7 @@ my $ConnectionType; my %hostid; # ID's for hosts in cluster by ip. my %hostdom; # LonCAPA domain for hosts in cluster. +my %hostname; # DNSname -> ID's mapping. my %hostip; # IPs for hosts in cluster. my %hostdns; # ID's of hosts looked up by DNS name. @@ -2914,11 +2915,22 @@ sub dump_profile_database { while (my ($key,$value) = each(%$hashref)) { my ($v,$symb,$param) = split(/:/,$key); next if ($v eq 'version' || $symb eq 'keys'); - next if (exists($data{$symb}) && - exists($data{$symb}->{$param}) && - $data{$symb}->{'v.'.$param} > $v); - $data{$symb}->{$param}=$value; - $data{$symb}->{'v.'.$param}=$v; + if (!defined($param)) { + foreach my $pair (split(/\&/,$value)) { + my ($param,$value)=split(/=/,$pair); + next if (exists($data{$symb}) && + exists($data{$symb}->{$param}) && + $data{$symb}->{'v.'.$param} > $v); + $data{$symb}->{$param}=$value; + $data{$symb}->{'v.'.$param}=$v; + } + } else { + next if (exists($data{$symb}) && + exists($data{$symb}->{$param}) && + $data{$symb}->{'v.'.$param} > $v); + $data{$symb}->{$param}=$value; + $data{$symb}->{'v.'.$param}=$v; + } } if (&untie_user_hash($hashref)) { while (my ($symb,$param_hash) = each(%data)) { @@ -2975,22 +2987,39 @@ sub dump_with_regexp { my $userinput = "$cmd:$tail"; - my ($udom,$uname,$namespace,$regexp)=split(/:/,$tail); + my ($udom,$uname,$namespace,$regexp,$range)=split(/:/,$tail); if (defined($regexp)) { $regexp=&unescape($regexp); } else { $regexp='.'; } + my ($start,$end); + if (defined($range)) { + if ($range =~/^(\d+)\-(\d+)$/) { + ($start,$end) = ($1,$2); + } elsif ($range =~/^(\d+)$/) { + ($start,$end) = (0,$1); + } else { + undef($range); + } + } my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER()); if ($hashref) { my $qresult=''; + my $count=0; while (my ($key,$value) = each(%$hashref)) { if ($regexp eq '.') { + $count++; + if (defined($range) && $count >= $end) { last; } + if (defined($range) && $count < $start) { next; } $qresult.=$key.'='.$value.'&'; } else { my $unescapeKey = &unescape($key); if (eval('$unescapeKey=~/$regexp/')) { + $count++; + if (defined($range) && $count >= $end) { last; } + if (defined($range) && $count < $start) { next; } $qresult.="$key=$value&"; } } @@ -3050,11 +3079,10 @@ sub store_handler { my $version=$hashref->{"version:$rid"}; my $allkeys=''; foreach my $pair (@pairs) { - my ($key,$value)=split(/=/,$pair); + my ($key)=split(/=/,$pair); $allkeys.=$key.':'; - $hashref->{"$version:$rid:$key"}=$value; } - $hashref->{"$version:$rid:timestamp"}=$now; + $hashref->{"$version:$rid"}=$what."\×tamp=$now"; $allkeys.='timestamp'; $hashref->{"$version:keys:$rid"}=$allkeys; if (&untie_user_hash($hashref)) { @@ -3120,9 +3148,17 @@ sub restore_handler { my @keys=split(/:/,$vkeys); my $key; $qresult.="$scope:keys=$vkeys&"; - foreach $key (@keys) { - $qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&"; - } + if (exists($hashref->{"$scope:$rid"})) { + my $what=$hashref->{"$scope:$rid"}; + foreach my $pair (split(/\&/,$hashref->{"$scope:$rid"})) { + my ($key,$value)=split(/=/,$pair); + $qresult.="$scope:".$pair."&"; + } + } else { + foreach $key (@keys) { + $qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&"; + } + } } if (&untie_user_hash($hashref)) { $qresult=~s/\&$//; @@ -4330,19 +4366,10 @@ sub photo_permission_handler { my $userinput = "$cmd:$tail"; my $cdom = $tail; my ($perm_reqd,$conditions); - my $outcome; - eval { - local($SIG{__DIE__})='DEFAULT'; - $outcome = &localenroll::photo_permission($cdom,\$perm_reqd, - \$conditions); - }; - if (!$@) { - &Reply($client, &escape($outcome.':'.$perm_reqd.':'. $conditions)."\n", - $userinput); - } else { - &Failure($client,"unknown_cmd\n",$userinput); - } - return 1; + my $outcome = &localenroll::photo_permission($cdom,\$perm_reqd, + \$conditions); + &Reply($client, &escape($outcome.':'.$perm_reqd.':'. $conditions)."\n", + $userinput); } ®ister_handler("autophotopermission",\&photo_permission_handler,0,1,0); @@ -4367,7 +4394,6 @@ sub photo_check_handler { my $result = &localstudentphoto::fetch($udom,$uname,$pid,\$response); $result .= ':'.$response; &Reply($client, &escape($result)."\n",$userinput); - return 1; } ®ister_handler("autophotocheck",\&photo_check_handler,0,1,0); @@ -4381,17 +4407,8 @@ sub photo_choice_handler { my ($cmd, $tail, $client) = @_; my $userinput = "$cmd:$tail"; my $cdom = &unescape($tail); - my ($update,$comment); - eval { - local($SIG{__DIE__})='DEFAULT'; - ($update,$comment) = &localenroll::manager_photo_update($cdom); - }; - if (!$@) { - &Reply($client,&escape($update).':'.&escape($comment)."\n",$userinput); - } else { - &Failure($client,"unknown_cmd\n",$userinput); - } - return 1; + my ($update,$comment) = &localenroll::manager_photo_update($cdom); + &Reply($client,&escape($update).':'.&escape($comment)."\n",$userinput); } ®ister_handler("autophotochoice",\&photo_choice_handler,0,1,0); @@ -4424,10 +4441,7 @@ sub student_photo_handler { &mkpath($path); my $file; if ($type eq 'thumbnail') { - eval { - local($SIG{__DIE__})='DEFAULT'; - $file=&localstudentphoto::fetch_thumbnail($domain,$uname); - }; + $file=&localstudentphoto::fetch_thumbnail($domain,$uname); } else { $file=&localstudentphoto::fetch($domain,$uname); } @@ -4851,6 +4865,7 @@ sub ReadHostTable { } $hostid{$ip}=$id; # LonCAPA name of host by IP. $hostdom{$id}=$domain; # LonCAPA domain name of host. + $hostname{$id}=$name; # LonCAPA name -> DNS name $hostip{$id}=$ip; # IP address of host. $hostdns{$name} = $id; # LonCAPA name of host by DNS. @@ -5101,12 +5116,12 @@ sub reconlonc { sub subreply { my ($cmd,$server)=@_; - my $peerfile="$perlvar{'lonSockDir'}/$server"; + my $peerfile="$perlvar{'lonSockDir'}/".$hostname{$server}; my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile", Type => SOCK_STREAM, Timeout => 10) or return "con_lost"; - print $sclient "$cmd\n"; + print $sclient "sethost:$server:$cmd\n"; my $answer=<$sclient>; chomp($answer); if (!$answer) { $answer="con_lost"; } @@ -5122,7 +5137,7 @@ sub reply { $answer=subreply("ping",$server); if ($answer ne $server) { &logthis("sub reply: answer != server answer is $answer, server is $server"); - &reconlonc("$perlvar{'lonSockDir'}/$server"); + &reconlonc("$perlvar{'lonSockDir'}/".$hostname{$server}); } $answer=subreply($cmd,$server); } @@ -5149,7 +5164,7 @@ sub sub_sql_reply { Type => SOCK_STREAM, Timeout => 10) or return "con_lost"; - print $sclient "$cmd:$currentdomainid\n"; + print $sclient "$cmd\n"; my $answer=<$sclient>; chomp($answer); if (!$answer) { $answer="con_lost"; } @@ -5428,7 +5443,7 @@ sub make_new_child { # no need to try to do recon's to myself next; } - &reconlonc("$perlvar{'lonSockDir'}/$id"); + &reconlonc("$perlvar{'lonSockDir'}/".$hostname{$id}); } &logthis("Established connection: $clientname"); &status('Will listen to '.$clientname);