--- loncom/lonnet/perl/lonnet.pm	2007/02/18 01:51:20	1.833
+++ loncom/lonnet/perl/lonnet.pm	2007/03/03 01:54:13	1.842
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.833 2007/02/18 01:51:20 albertel Exp $
+# $Id: lonnet.pm,v 1.842 2007/03/03 01:54:13 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -35,7 +35,7 @@ use HTTP::Headers;
 use HTTP::Date;
 # use Date::Parse;
 use vars 
-qw(%perlvar %hostname %badServerCache %iphost %spareid %hostdom 
+qw(%perlvar %badServerCache %iphost %spareid %hostdom 
    %libserv %pr %prp $memcache %packagetab 
    %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount 
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf
@@ -149,7 +149,7 @@ sub logperm {
 # -------------------------------------------------- Non-critical communication
 sub subreply {
     my ($cmd,$server)=@_;
-    my $peerfile="$perlvar{'lonSockDir'}/".$hostname{$server};
+    my $peerfile="$perlvar{'lonSockDir'}/".&hostname($server);
     #
     #  With loncnew process trimming, there's a timing hole between lonc server
     #  process exit and the master server picking up the listen on the AF_UNIX
@@ -189,7 +189,7 @@ sub subreply {
 
 sub reply {
     my ($cmd,$server)=@_;
-    unless (defined($hostname{$server})) { return 'no_such_host'; }
+    unless (defined(&hostname($server))) { return 'no_such_host'; }
     my $answer=subreply($cmd,$server);
     if (($answer=~/^refused/) || ($answer=~/^rejected/)) {
        &logthis("<font color=\"blue\">WARNING:".
@@ -201,8 +201,7 @@ sub reply {
 # ----------------------------------------------------------- Send USR1 to lonc
 
 sub reconlonc {
-    my $peerfile=shift;
-    &logthis("Trying to reconnect for $peerfile");
+    &logthis("Trying to reconnect lonc");
     my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
     if (open(my $fh,"<$loncfile")) {
 	my $loncpid=<$fh>;
@@ -211,19 +210,13 @@ sub reconlonc {
 	    &logthis("lonc at pid $loncpid responding, sending USR1");
             kill USR1 => $loncpid;
             sleep 1;
-            if (-e "$peerfile") { return; }
-            &logthis("$peerfile still not there, give it another try");
-            sleep 5;
-            if (-e "$peerfile") { return; }
-            &logthis(
-  "<font color=\"blue\">WARNING: $peerfile still not there, giving up</font>");
-        } else {
+         } else {
 	    &logthis(
                "<font color=\"blue\">WARNING:".
                " lonc at pid $loncpid not responding, giving up</font>");
         }
     } else {
-     &logthis('<font color="blue">WARNING: lonc not running, giving up</font>');
+	&logthis('<font color="blue">WARNING: lonc not running, giving up</font>');
     }
 }
 
@@ -231,7 +224,7 @@ sub reconlonc {
 
 sub critical {
     my ($cmd,$server)=@_;
-    unless ($hostname{$server}) {
+    unless (&hostname($server)) {
         &logthis("<font color=\"blue\">WARNING:".
                " Critical message to unknown server ($server)</font>");
         return 'no_such_host';
@@ -524,7 +517,7 @@ sub spareserver {
     }
 
     if (!$want_server_name) {
-	$spare_server="http://$hostname{$spare_server}";
+	$spare_server="http://".&hostname($spare_server);
     }
     return $spare_server;
 }
@@ -615,9 +608,15 @@ sub authenticate {
     my ($uname,$upass,$udom)=@_;
     $upass=&escape($upass);
     $uname= &LONCAPA::clean_username($uname);
-    my $uhome=&homeserver($uname,$udom);
-    if (!$uhome) {
-	&logthis("User $uname at $udom is unknown in authenticate");
+    my $uhome=&homeserver($uname,$udom,1);
+    if ((!$uhome) || ($uhome eq 'no_host')) {
+# Maybe the machine was offline and only re-appeared again recently?
+        &reconlonc();
+# One more
+	my $uhome=&homeserver($uname,$udom,1);
+	if ((!$uhome) || ($uhome eq 'no_host')) {
+	    &logthis("User $uname at $udom is unknown in authenticate");
+	}
 	return 'no_host';
     }
     my $answer=reply("encrypt:auth:$udom:$uname:$upass",$uhome);
@@ -641,18 +640,19 @@ sub homeserver {
     my $index="$uname:$udom";
 
     if (exists($homecache{$index})) { return $homecache{$index}; }
-    my $tryserver;
-    foreach $tryserver (keys %libserv) {
+
+    my %servers = &get_servers($udom,'library');
+    foreach my $tryserver (keys(%servers)) {
         next if ($ignoreBadCache ne 'true' && 
 		 exists($badServerCache{$tryserver}));
-	if ($hostdom{$tryserver} eq $udom) {
-           my $answer=reply("home:$udom:$uname",$tryserver);
-           if ($answer eq 'found') { 
-	       return $homecache{$index}=$tryserver;
-           } elsif ($answer eq 'no_host') {
-	       $badServerCache{$tryserver}=1;
-           }
-       }
+
+	my $answer=reply("home:$udom:$uname",$tryserver);
+	if ($answer eq 'found') {
+	    delete($badServerCache{$tryserver}); 
+	    return $homecache{$index}=$tryserver;
+	} elsif ($answer eq 'no_host') {
+	    $badServerCache{$tryserver}=1;
+	}
     }    
     return 'no_host';
 }
@@ -663,24 +663,22 @@ sub idget {
     my ($udom,@ids)=@_;
     my %returnhash=();
     
-    my $tryserver;
-    foreach $tryserver (keys %libserv) {
-       if ($hostdom{$tryserver} eq $udom) {
-	  my $idlist=join('&',@ids);
-          $idlist=~tr/A-Z/a-z/; 
-	  my $reply=&reply("idget:$udom:".$idlist,$tryserver);
-          my @answer=();
-          if (($reply ne 'con_lost') && ($reply!~/^error\:/)) {
-	      @answer=split(/\&/,$reply);
-          }                    ;
-          my $i;
-          for ($i=0;$i<=$#ids;$i++) {
-              if ($answer[$i]) {
-		  $returnhash{$ids[$i]}=$answer[$i];
-              } 
-          }
-       }
-    }    
+    my %servers = &get_servers($udom,'library');
+    foreach my $tryserver (keys(%servers)) {
+	my $idlist=join('&',@ids);
+	$idlist=~tr/A-Z/a-z/; 
+	my $reply=&reply("idget:$udom:".$idlist,$tryserver);
+	my @answer=();
+	if (($reply ne 'con_lost') && ($reply!~/^error\:/)) {
+	    @answer=split(/\&/,$reply);
+	}                    ;
+	my $i;
+	for ($i=0;$i<=$#ids;$i++) {
+	    if ($answer[$i]) {
+		$returnhash{$ids[$i]}=$answer[$i];
+	    } 
+	}
+    } 
     return %returnhash;
 }
 
@@ -766,6 +764,30 @@ sub put_dom {
     }
 }
 
+sub retrieve_inst_usertypes {
+    my ($udom) = @_;
+    my (%returnhash,@order);
+    if (exists($domain_primary{$udom})) {
+        my $uhome=$domain_primary{$udom};
+        my $rep=&reply("inst_usertypes:$udom",$uhome);
+        my ($hashitems,$orderitems) = split(/:/,$rep); 
+        my @pairs=split(/\&/,$hashitems);
+        foreach my $item (@pairs) {
+            my ($key,$value)=split(/=/,$item,2);
+            $key = &unescape($key);
+            next if ($key =~ /^error: 2 /);
+            $returnhash{$key}=&thaw_unescape($value);
+        }
+        my @esc_order = split(/\&/,$orderitems);
+        foreach my $item (@esc_order) {
+            push(@order,&unescape($item));
+        }
+    } else {
+        &logthis("get_dom failed - no primary domain server for $udom");
+    }
+    return (\%returnhash,\@order);
+}
+
 # --------------------------------------------------- Assign a key to a student
 
 sub assign_access_key {
@@ -1819,8 +1841,9 @@ sub flushcourselogs {
 # Write course id database (reverse lookup) to homeserver of courses 
 # Is used in pickcourse
 #
-    foreach my $crsid (keys(%courseidbuffer)) {
-        &courseidput($hostdom{$crsid},$courseidbuffer{$crsid},$crsid);
+    foreach my $crs_home (keys(%courseidbuffer)) {
+        &courseidput($hostdom{$crs_home},$courseidbuffer{$crs_home},
+		     $crs_home);
     }
 #
 # File accesses
@@ -1887,13 +1910,12 @@ sub flushcourselogs {
         delete $domainrolehash{$entry};
     }
     foreach my $dom (keys(%domrolebuffer)) {
-        foreach my $tryserver (keys %libserv) {
-            if ($hostdom{$tryserver} eq $dom) {
-                unless (&reply('domroleput:'.$dom.':'.
-                  $domrolebuffer{$dom},$tryserver) eq 'ok') {
-                    &logthis('Put of domain roles failed for '.$dom.' and  '.$tryserver);
-                }
-            }
+	my %servers = &get_servers($dom,'library');
+	foreach my $tryserver (keys(%servers)) {
+	    unless (&reply('domroleput:'.$dom.':'.
+			   $domrolebuffer{$dom},$tryserver) eq 'ok') {
+		&logthis('Put of domain roles failed for '.$dom.' and  '.$tryserver);
+	    }
         }
     }
     $dumpcount++;
@@ -2169,19 +2191,19 @@ sub get_domain_roles {
     }
     my $rolelist = join(':',@{$roles});
     my %personnel = ();
-    foreach my $tryserver (keys(%libserv)) {
-        if ($hostdom{$tryserver} eq $dom) {
-            %{$personnel{$tryserver}}=();
-            foreach my $line (
-                split(/\&/,&reply('domrolesdump:'.$dom.':'.
-                   &escape($startdate).':'.&escape($enddate).':'.
-                   &escape($rolelist), $tryserver))) {
-                my ($key,$value) = split(/\=/,$line,2);
-                if (($key) && ($value)) {
-                    $personnel{$tryserver}{&unescape($key)} = &unescape($value);
-                }
-            }
-        }
+
+    my %servers = &get_servers($dom,'library');
+    foreach my $tryserver (keys(%servers)) {
+	%{$personnel{$tryserver}}=();
+	foreach my $line (split(/\&/,&reply('domrolesdump:'.$dom.':'.
+					    &escape($startdate).':'.
+					    &escape($enddate).':'.
+					    &escape($rolelist), $tryserver))) {
+	    my ($key,$value) = split(/\=/,$line,2);
+	    if (($key) && ($value)) {
+		$personnel{$tryserver}{&unescape($key)} = &unescape($value);
+	    }
+	}
     }
     return %personnel;
 }
@@ -2271,7 +2293,7 @@ sub checkin {
     my $now=time;
     my ($ta,$tb,$lonhost)=split(/\*/,$token);
     $lonhost=~tr/A-Z/a-z/;
-    my $dtoken=$ta.'_'.$hostname{$lonhost}.'_'.$tb;
+    my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb;
     $dtoken=~s/\W/\_/g;
     my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
                  split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));
@@ -2940,7 +2962,7 @@ sub custom_roleprivs {
     my ($allroles,$trole,$tdomain,$trest,$spec,$area) = @_;
     my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);
     my $homsvr=homeserver($rauthor,$rdomain);
-    if ($hostname{$homsvr} ne '') {
+    if (&hostname($homsvr) ne '') {
         my ($rdummy,$roledef)=
             &get('roles',["rolesdef_$rrole"],$rdomain,$rauthor);
         if (($rdummy ne 'con_lost') && ($roledef ne '')) {
@@ -4171,7 +4193,7 @@ sub log_query {
     my ($uname,$udom,$query,%filters)=@_;
     my $uhome=&homeserver($uname,$udom);
     if ($uhome eq 'no_host') { return 'error: no_host'; }
-    my $uhost=$hostname{$uhome};
+    my $uhost=&hostname($uhome);
     my $command=&escape(join(':',map{$_.'='.$filters{$_}} keys(%filters)));
     my $queryid=&reply("querysend:".$query.':'.$udom.':'.$uname.':'.$command,
                        $uhome);
@@ -4203,7 +4225,7 @@ sub fetch_enrollment_query {
     } else {
         $homeserver = &homeserver($cnum,$dom);
     }
-    my $host=$hostname{$homeserver};
+    my $host=&hostname($homeserver);
     my $cmd = '';
     foreach my $affiliate (keys %{$affiliatesref}) {
         $cmd .= $affiliate.'='.join(",",@{$$affiliatesref{$affiliate}}).'%%';
@@ -4394,7 +4416,7 @@ sub auto_photochoice {
 sub auto_photoupdate {
     my ($affiliatesref,$dom,$cnum,$photo) = @_;
     my $homeserver = &homeserver($cnum,$dom);
-    my $host=$hostname{$homeserver};
+    my $host=&hostname($homeserver);
     my $cmd = '';
     my $maxtries = 1;
     foreach my $affiliate (keys(%{$affiliatesref})) {
@@ -4434,12 +4456,11 @@ sub auto_instcode_format {
     my $courses = '';
     my @homeservers;
     if ($caller eq 'global') {
-        foreach my $tryserver (keys(%libserv)) {
-            if ($hostdom{$tryserver} eq $codedom) {
-                if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
-                    push(@homeservers,$tryserver);
-                }
-            }
+	my %servers = &get_servers($codedom,'library');
+	foreach my $tryserver (keys(%servers)) {
+	    if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
+		push(@homeservers,$tryserver);
+	    }
         }
     } else {
         push(@homeservers,&homeserver($caller,$codedom));
@@ -4473,35 +4494,31 @@ sub auto_instcode_format {
 sub auto_instcode_defaults {
     my ($domain,$returnhash,$code_order) = @_;
     my @homeservers;
-    foreach my $tryserver (keys(%libserv)) {
-        if ($hostdom{$tryserver} eq $domain) {
-            if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
-                push(@homeservers,$tryserver);
-            }
-        }
+
+    my %servers = &get_servers($domain,'library');
+    foreach my $tryserver (keys(%servers)) {
+	if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
+	    push(@homeservers,$tryserver);
+	}
     }
-    my $ok_response = 0;
+
     my $response;
-    while (@homeservers > 0 && $ok_response == 0) {
-        my $server = shift(@homeservers);
+    foreach my $server (@homeservers) {
         $response=&reply('autoinstcodedefaults:'.$domain,$server);
-        if ($response !~ /(con_lost|error|no_such_host|refused)/) {
-            foreach my $pair (split(/\&/,$response)) {
-                my ($name,$value)=split(/\=/,$pair);
-                if ($name eq 'code_order') {
-                    @{$code_order} = split(/\&/,&unescape($value));
-                } else {
-                    $returnhash->{&unescape($name)}=&unescape($value);
-                }
-            }
-            $ok_response = 1;
-        }
-    }
-    if ($ok_response) {
-        return 'ok';
-    } else {
-        return $response;
+        next if ($response =~ /(con_lost|error|no_such_host|refused)/);
+	
+	foreach my $pair (split(/\&/,$response)) {
+	    my ($name,$value)=split(/\=/,$pair);
+	    if ($name eq 'code_order') {
+		@{$code_order} = split(/\&/,&unescape($value));
+	    } else {
+		$returnhash->{&unescape($name)}=&unescape($value);
+	    }
+	}
+	return 'ok';
     }
+
+    return $response;
 } 
 
 sub auto_validate_class_sec {
@@ -4799,16 +4816,14 @@ sub modifyuser {
 	} elsif($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom) {
 	    $unhome=$env{'course.'.$env{'request.course.id'}.'.home'};
         } else { # load balancing routine for determining $unhome
-            my $tryserver;
             my $loadm=10000000;
-            foreach $tryserver (keys %libserv) {
-	       if ($hostdom{$tryserver} eq $udom) {
-                  my $answer=reply('load',$tryserver);
-                  if (($answer=~/\d+/) && ($answer<$loadm)) {
-		      $loadm=$answer;
-                      $unhome=$tryserver;
-                  }
-	       }
+	    my %servers = &get_servers($udom,'library');
+	    foreach my $tryserver (keys(%servers)) {
+		my $answer=reply('load',$tryserver);
+		if (($answer=~/\d+/) && ($answer<$loadm)) {
+		    $loadm=$answer;
+		    $unhome=$tryserver;
+		}
 	    }
         }
         if (($unhome eq '') || ($unhome eq 'no_host')) {
@@ -5556,28 +5571,27 @@ sub dirlist {
             return @listing_results;
         } elsif(!defined($alternateDirectoryRoot)) {
             my %allusers;
-            foreach my $tryserver (keys(%libserv)) {
-                if($hostdom{$tryserver} eq $udom) {
-                    my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
-					 $udom, $tryserver);
-                    my @listing_results;
-                    if ($listing eq 'unknown_cmd') {
-                        $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
-					  $udom, $tryserver);
-                        @listing_results = split(/:/,$listing);
-                    } else {
-                        @listing_results =
-                            map { &unescape($_); } split(/:/,$listing);
-                    }
-                    if ($listing_results[0] ne 'no_such_dir' && 
-                        $listing_results[0] ne 'empty'       &&
-                        $listing_results[0] ne 'con_lost') {
-                        foreach my $line (@listing_results) {
-                            my ($entry) = split(/&/,$line,2);
-                            $allusers{$entry} = 1;
-                        }
-                    }
-                }
+	    my %servers = &get_servers($udom,'library');
+	    foreach my $tryserver (keys(%servers)) {
+		my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
+				     $udom, $tryserver);
+		my @listing_results;
+		if ($listing eq 'unknown_cmd') {
+		    $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
+				      $udom, $tryserver);
+		    @listing_results = split(/:/,$listing);
+		} else {
+		    @listing_results =
+			map { &unescape($_); } split(/:/,$listing);
+		}
+		if ($listing_results[0] ne 'no_such_dir' && 
+		    $listing_results[0] ne 'empty'       &&
+		    $listing_results[0] ne 'con_lost') {
+		    foreach my $line (@listing_results) {
+			my ($entry) = split(/&/,$line,2);
+			$allusers{$entry} = 1;
+		    }
+		}
             }
             my $alluserstr='';
             foreach my $user (sort(keys(%allusers))) {
@@ -5589,18 +5603,12 @@ sub dirlist {
             return ('missing user name');
         }
     } elsif(!defined($alternateDirectoryRoot)) {
-        my $tryserver;
-        my %alldom=();
-        foreach $tryserver (keys(%libserv)) {
-            $alldom{$hostdom{$tryserver}}=1;
-        }
-        my $alldomstr='';
-        foreach my $domain (sort(keys(%alldom))) {
-            $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain:';
-        }
-        $alldomstr=~s/:$//;
-        return split(/:/,$alldomstr);       
-    } else {
+        my @all_domains = sort(&all_domains());
+         foreach my $domain (@all_domains) {
+             $domain = $perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain';
+         }
+         return @all_domains;
+     } else {
         return ('missing domain');
     }
 }
@@ -7085,13 +7093,14 @@ sub setup_random_from_rndseed {
 }
 
 sub latest_receipt_algorithm_id {
-    return 'receipt2';
+    return 'receipt3';
 }
 
 sub recunique {
     my $fucourseid=shift;
     my $unique;
-    if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2') {
+    if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2' ||
+	$env{"course.$fucourseid.receiptalg"} eq 'receipt3' ) {
 	$unique=$env{"course.$fucourseid.internal.encseed"};
     } else {
 	$unique=$perlvar{'lonReceipt'};
@@ -7102,7 +7111,8 @@ sub recunique {
 sub recprefix {
     my $fucourseid=shift;
     my $prefix;
-    if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2') {
+    if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2'||
+	$env{"course.$fucourseid.receiptalg"} eq 'receipt3' ) {
 	$prefix=$env{"course.$fucourseid.internal.encpref"};
     } else {
 	$prefix=$perlvar{'lonHostID'};
@@ -7112,15 +7122,23 @@ sub recprefix {
 
 sub ireceipt {
     my ($funame,$fudom,$fucourseid,$fusymb,$part)=@_;
+
+    my $return =&recprefix($fucourseid).'-';
+
+    if ($env{"course.$fucourseid.receiptalg"} eq 'receipt3' ||
+	$env{'request.state'} eq 'construct') {
+	$return .= (&digest("$funame,$fudom,$fucourseid,$fusymb,$part")%10000);
+	return $return;
+    }
+
     my $cuname=unpack("%32C*",$funame);
     my $cudom=unpack("%32C*",$fudom);
     my $cucourseid=unpack("%32C*",$fucourseid);
     my $cusymb=unpack("%32C*",$fusymb);
     my $cunique=&recunique($fucourseid);
     my $cpart=unpack("%32S*",$part);
-    my $return =&recprefix($fucourseid).'-';
-    if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2' ||
-	$env{'request.state'} eq 'construct') {
+    if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2') {
+
 	#&logthis("doing receipt2  using parts $cpart, uname $cuname and udom $cudom gets  ".($cpart%$cuname)." and ".($cpart%$cudom));
 			       
 	$return.= ($cunique%$cuname+
@@ -7252,7 +7270,7 @@ sub repcopy_userfile {
     if (-e $transferfile) { return 'ok'; }
     my $request;
     $uri=~s/^\///;
-    $request=new HTTP::Request('GET','http://'.$hostname{&homeserver($cnum,$cdom)}.'/raw/'.$uri);
+    $request=new HTTP::Request('GET','http://'.&hostname(&homeserver($cnum,$cdom)).'/raw/'.$uri);
     my $response=$ua->request($request,$transferfile);
 # did it work?
     if ($response->is_error()) {
@@ -7275,7 +7293,7 @@ sub tokenwrapper {
     if ($udom && $uname && $file) {
 	$file=~s|(\?\.*)*$||;
         &appenv("userfile.$udom/$uname/$file" => $env{'request.course.id'});
-        return 'http://'.$hostname{ &homeserver($uname,$udom)}.'/'.$uri.
+        return 'http://'.&hostname(&homeserver($uname,$udom)).'/'.$uri.
                (($uri=~/\?/)?'&':'?').'token='.$token.
                                '&tokenissued='.$perlvar{'lonHostID'};
     } else {
@@ -7290,7 +7308,7 @@ sub tokenwrapper {
 sub getuploaded {
     my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_;
     $uri=~s/^\///;
-    $uri = 'http://'.$hostname{ &homeserver($cnum,$cdom)}.'/raw/'.$uri;
+    $uri = 'http://'.&hostname(&homeserver($cnum,$cdom)).'/raw/'.$uri;
     my $ua=new LWP::UserAgent;
     my $request=new HTTP::Request($reqtype,$uri);
     my $response=$ua->request($request);
@@ -7380,8 +7398,9 @@ sub hreflocation {
 }
 
 sub current_machine_domains {
-    my $hostname=$hostname{$perlvar{'lonHostID'}};
+    my $hostname=&hostname($perlvar{'lonHostID'});
     my @domains;
+    my %hostname = &all_hostnames();
     while( my($id, $name) = each(%hostname)) {
 #	&logthis("-$id-$name-$hostname-");
 	if ($hostname eq $name) {
@@ -7392,8 +7411,9 @@ sub current_machine_domains {
 }
 
 sub current_machine_ids {
-    my $hostname=$hostname{$perlvar{'lonHostID'}};
+    my $hostname=&hostname($perlvar{'lonHostID'});
     my @ids;
+    my %hostname = &all_hostnames();
     while( my($id, $name) = each(%hostname)) {
 #	&logthis("-$id-$name-$hostname-");
 	if ($hostname eq $name) {
@@ -7571,6 +7591,7 @@ BEGIN {
 
 # ------------------------------------------------------------- Read hosts file
 {
+    my %hostname;
     open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
 
     while (my $configline=<$config>) {
@@ -7587,11 +7608,54 @@ BEGIN {
     close($config);
     # FIXME: dev server don't want this, production servers _do_ want this
     #&get_iphost();
+
+    sub hostname {
+	my ($lonid) = @_;
+	return $hostname{$lonid};
+    }
+    sub all_hostnames {
+	return %hostname;
+    }
+    sub get_servers {
+	my ($domain,$type) = @_;
+	my %possible_hosts = ($type eq 'library') ? %libserv
+	                                          : %hostname;
+	my %result;
+	if (ref($domain) eq 'ARRAY') {
+	    while ( my ($host,$hostname) = each(%possible_hosts)) {
+		if (grep(/\Q$hostdom{$host}\E/,@$domain)) {
+		    $result{$host} = $hostname;
+		}
+	    }
+	} else {
+	    while ( my ($host,$hostname) = each(%possible_hosts)) {
+		if ($hostdom{$host} eq $domain) {
+		    $result{$host} = $hostname;
+		}
+	    }
+	}
+	return %result;
+    }
+    sub all_domains {
+	my %seen;
+	my @uniq = grep(!$seen{$_}++, values(%hostdom));
+	return @uniq;
+    }
+}
+
+sub get_hosts_from_ip {
+    my ($ip) = @_;
+    my %iphosts = &get_iphost();
+    if (ref($iphosts{$ip})) {
+	return @{$iphosts{$ip}};
+    }
+    return;
 }
 
 sub get_iphost {
     if (%iphost) { return %iphost; }
     my %name_to_ip;
+    my %hostname = &all_hostnames();
     foreach my $id (keys(%hostname)) {
 	my $name=$hostname{$id};
 	my $ip;
@@ -7971,7 +8035,17 @@ explanation of a user role term
 
 =item *
 
-get_my_roles($uname,$udom,$types,$roles,$roledoms) : All arguments are optional.  Returns a hash of a user's roles, with keys set to colon-sparated $uname,$udom,and $role, and value set to colon-separated start and end times for the role. If no username and domain are specified, will default to current user/domain. Types, roles, and roledoms are references to arrays, of role statuses (active, future or previous), roles (e.g., cc,in, st etc.) and domains of the roles which can be used to restrict the list if roles reported. If no array ref is provided for types, will default to return only active roles.  
+get_my_roles($uname,$udom,$types,$roles,$roledoms) : All arguments are
+optional.  Returns a hash of a user's roles, with keys set to
+colon-sparated $uname,$udom,and $role, and value set to
+colon-separated start and end times for the role. If no username and
+domain are specified, will default to current user/domain. Types,
+roles, and roledoms are references to arrays, of role statuses
+(active, future or previous), roles (e.g., cc,in, st etc.) and domains
+of the roles which can be used to restrict the list if roles
+reported. If no array ref is provided for types, will default to
+return only active roles.
+
 =back
 
 =head2 User Modification