--- loncom/lonnet/perl/lonnet.pm	2007/06/13 03:00:59	1.890
+++ loncom/lonnet/perl/lonnet.pm	2007/10/03 19:57:26	1.918
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.890 2007/06/13 03:00:59 albertel Exp $
+# $Id: lonnet.pm,v 1.918 2007/10/03 19:57:26 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -214,6 +214,24 @@ sub reply {
 # ----------------------------------------------------------- Send USR1 to lonc
 
 sub reconlonc {
+    my ($lonid) = @_;
+    my $hostname = &hostname($lonid);
+    if ($lonid) {
+	my $peerfile="$perlvar{'lonSockDir'}/$hostname";
+	if ($hostname && -e $peerfile) {
+	    &logthis("Trying to reconnect lonc for $lonid ($hostname)");
+	    my $client=IO::Socket::UNIX->new(Peer    => $peerfile,
+					     Type    => SOCK_STREAM,
+					     Timeout => 10);
+	    if ($client) {
+		print $client ("reset_retries\n");
+		my $answer=<$client>;
+		#reset just this one.
+	    }
+	}
+	return;
+    }
+
     &logthis("Trying to reconnect lonc");
     my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
     if (open(my $fh,"<$loncfile")) {
@@ -302,7 +320,10 @@ sub convert_and_load_session_env {
     my ($lonidsdir,$handle)=@_;
     my @profile;
     {
-	open(my $idf,"$lonidsdir/$handle.id");
+	my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");
+	if (!$opened) {
+	    return 0;
+	}
 	flock($idf,LOCK_SH);
 	@profile=<$idf>;
 	close($idf);
@@ -341,7 +362,10 @@ sub transfer_profile_to_env {
 
     my $convert;
     {
-    	open(my $idf,"$lonidsdir/$handle.id");
+    	my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");
+	if (!$opened) {
+	    return;
+	}
 	flock($idf,LOCK_SH);
 	if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",
 		&GDBM_READER(),0640)) {
@@ -373,6 +397,34 @@ sub transfer_profile_to_env {
     }
 }
 
+# ---------------------------------------------------- Check for valid session 
+sub check_for_valid_session {
+    my ($r) = @_;
+    my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
+    my $lonid=$cookies{'lonID'};
+    return undef if (!$lonid);
+
+    my $handle=&LONCAPA::clean_handle($lonid->value);
+    my $lonidsdir=$r->dir_config('lonIDsDir');
+    return undef if (!-e "$lonidsdir/$handle.id");
+
+    my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");
+    return undef if (!$opened);
+
+    flock($idf,LOCK_SH);
+    my %disk_env;
+    if (!tie(%disk_env,'GDBM_File',"$lonidsdir/$handle.id",
+	    &GDBM_READER(),0640)) {
+	return undef;	
+    }
+
+    if (!defined($disk_env{'user.name'})
+	|| !defined($disk_env{'user.domain'})) {
+	return undef;
+    }
+    return $handle;
+}
+
 sub timed_flock {
     my ($file,$lock_type) = @_;
     my $failed=0;
@@ -407,8 +459,9 @@ sub appenv {
             $env{$key}=$newenv{$key};
         }
     }
-    open(my $env_file,$env{'user.environment'});
-    if (&timed_flock($env_file,LOCK_EX)
+    my $opened = open(my $env_file,'+<',$env{'user.environment'});
+    if ($opened
+	&& &timed_flock($env_file,LOCK_EX)
 	&&
 	tie(my %disk_env,'GDBM_File',$env{'user.environment'},
 	    (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {
@@ -428,16 +481,17 @@ sub delenv {
                 "Attempt to delete from environment ".$delthis);
         return 'error';
     }
-    open(my $env_file,$env{'user.environment'});
-    if (&timed_flock($env_file,LOCK_EX)
+    my $opened = open(my $env_file,'+<',$env{'user.environment'});
+    if ($opened
+	&& &timed_flock($env_file,LOCK_EX)
 	&&
 	tie(my %disk_env,'GDBM_File',$env{'user.environment'},
 	    (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {
 	foreach my $key (keys(%disk_env)) {
 	    if ($key=~/^$delthis/) { 
-                delete($env{$key});
-                delete($disk_env{$key});
-            }
+		delete($env{$key});
+		delete($disk_env{$key});
+	    }
 	}
 	untie(%disk_env);
     }
@@ -564,6 +618,27 @@ sub compare_server_load {
     }
     return ($spare_server,$lowest_load);
 }
+
+# --------------------------- ask offload servers if user already has a session
+sub find_existing_session {
+    my ($udom,$uname) = @_;
+    foreach my $try_server (@{ $spareid{'primary'} },
+			    @{ $spareid{'default'} }) {
+	return $try_server if (&has_user_session($try_server, $udom, $uname));
+    }
+    return;
+}
+
+# -------------------------------- ask if server already has a session for user
+sub has_user_session {
+    my ($lonid,$udom,$uname) = @_;
+    my $result = &reply(join(':','userhassession',
+			     map {&escape($_)} ($udom,$uname)),$lonid);
+    return 1 if ($result eq 'ok');
+
+    return 0;
+}
+
 # --------------------------------------------- Try to change a user's password
 
 sub changepass {
@@ -838,6 +913,194 @@ sub is_domainimage {
     return;
 }
 
+sub inst_directory_query {
+    my ($srch) = @_;
+    my $udom = $srch->{'srchdomain'};
+    my %results;
+    my $homeserver = &domain($udom,'primary');
+    my $outcome;
+    if ($homeserver ne '') {
+	my $queryid=&reply("querysend:instdirsearch:".
+			   &escape($srch->{'srchby'}).':'.
+			   &escape($srch->{'srchterm'}).':'.
+			   &escape($srch->{'srchtype'}),$homeserver);
+	my $host=&hostname($homeserver);
+	if ($queryid !~/^\Q$host\E\_/) {
+	    &logthis('instituional directory search invalid queryid: '.$queryid.' for host: '.$homeserver.'in domain '.$udom);
+	    return;
+	}
+	my $response = &get_query_reply($queryid);
+	my $maxtries = 5;
+	my $tries = 1;
+	while (($response=~/^timeout/) && ($tries < $maxtries)) {
+	    $response = &get_query_reply($queryid);
+	    $tries ++;
+	}
+
+        if (!&error($response) && $response ne 'refused') {
+            if ($response eq 'unavailable') {
+                $outcome = $response;
+            } else {
+                $outcome = 'ok';
+                my @matches = split(/\n/,$response);
+                foreach my $match (@matches) {
+                    my ($key,$value) = split(/=/,$match);
+                    $results{&unescape($key).':'.$udom} = &thaw_unescape($value);
+                }
+            }
+        }
+    }
+    return ($outcome,%results);
+}
+
+sub usersearch {
+    my ($srch) = @_;
+    my $dom = $srch->{'srchdomain'};
+    my %results;
+    my %libserv = &all_library();
+    my $query = 'usersearch';
+    foreach my $tryserver (keys(%libserv)) {
+        if (&host_domain($tryserver) eq $dom) {
+            my $host=&hostname($tryserver);
+            my $queryid=
+                &reply("querysend:".&escape($query).':'.
+                       &escape($srch->{'srchby'}).':'.
+                       &escape($srch->{'srchtype'}).':'.
+                       &escape($srch->{'srchterm'}),$tryserver);
+            if ($queryid !~/^\Q$host\E\_/) {
+                &logthis('usersearch: invalid queryid: '.$queryid.' for host: '.$host.'in domain '.$dom.' and server: '.$tryserver);
+                next;
+            }
+            my $reply = &get_query_reply($queryid);
+            my $maxtries = 1;
+            my $tries = 1;
+            while (($reply=~/^timeout/) && ($tries < $maxtries)) {
+                $reply = &get_query_reply($queryid);
+                $tries ++;
+            }
+            if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
+                &logthis('usersrch error: '.$reply.' for '.$dom.' - searching for : '.$srch->{'srchterm'}.' by '.$srch->{'srchby'}.' ('.$srch->{'srchtype'}.') -  maxtries: '.$maxtries.' tries: '.$tries);
+            } else {
+                my @matches;
+                if ($reply =~ /\n/) {
+                    @matches = split(/\n/,$reply);
+                } else {
+                    @matches = split(/\&/,$reply);
+                }
+                foreach my $match (@matches) {
+                    my ($uname,$udom,%userhash);
+                    foreach my $entry (split(/:/,$match)) {
+                        my ($key,$value) =
+                            map {&unescape($_);} split(/=/,$entry);
+                        $userhash{$key} = $value;
+                        if ($key eq 'username') {
+                            $uname = $value;
+                        } elsif ($key eq 'domain') {
+                            $udom = $value;
+                        }
+                    }
+                    $results{$uname.':'.$udom} = \%userhash;
+                }
+            }
+        }
+    }
+    return %results;
+}
+
+sub get_instuser {
+    my ($udom,$uname,$id) = @_;
+    my $homeserver = &domain($udom,'primary');
+    my ($outcome,%results);
+    if ($homeserver ne '') {
+        my $queryid=&reply("querysend:getinstuser:".&escape($uname).':'.
+                           &escape($id).':'.&escape($udom),$homeserver);
+        my $host=&hostname($homeserver);
+        if ($queryid !~/^\Q$host\E\_/) {
+            &logthis('get_instuser invalid queryid: '.$queryid.' for host: '.$homeserver.'in domain '.$udom);
+            return;
+        }
+        my $response = &get_query_reply($queryid);
+        my $maxtries = 5;
+        my $tries = 1;
+        while (($response=~/^timeout/) && ($tries < $maxtries)) {
+            $response = &get_query_reply($queryid);
+            $tries ++;
+        }
+        if (!&error($response) && $response ne 'refused') {
+            if ($response eq 'unavailable') {
+                $outcome = $response;
+            } else {
+                $outcome = 'ok';
+                my @matches = split(/\n/,$response);
+                foreach my $match (@matches) {
+                    my ($key,$value) = split(/=/,$match);
+                    $results{&unescape($key)} = &thaw_unescape($value);
+                }
+            }
+        }
+    }
+    my %userinfo;
+    if (ref($results{$uname}) eq 'HASH') {
+        %userinfo = %{$results{$uname}};
+    } 
+    return ($outcome,%userinfo);
+}
+
+sub inst_rulecheck {
+    my ($udom,$uname,$rules) = @_;
+    my %returnhash;
+    if ($udom ne '') {
+        if (ref($rules) eq 'ARRAY') {
+            @{$rules} = map {&escape($_);} (@{$rules});
+            my $rulestr = join(':',@{$rules});
+            my $homeserver=&domain($udom,'primary');
+            if (($homeserver ne '') && ($homeserver ne 'no_host')) {
+                my $response=&unescape(&reply('instrulecheck:'.&escape($udom).':'.
+                                              &escape($uname).':'.$rulestr,
+                                              $homeserver));
+                if ($response ne 'refused') {
+                    my @pairs=split(/\&/,$response);
+                    foreach my $item (@pairs) {
+                        my ($key,$value)=split(/=/,$item,2);
+                        $key = &unescape($key);
+                        next if ($key =~ /^error: 2 /);
+                        $returnhash{$key}=&thaw_unescape($value);
+                    }
+                }
+            }
+        }
+    }
+    return %returnhash;
+}
+
+sub inst_userrules {
+    my ($udom) = @_;
+    my (%ruleshash,@ruleorder);
+    if ($udom ne '') {
+        my $homeserver=&domain($udom,'primary');
+        if (($homeserver ne '') && ($homeserver ne 'no_host')) {
+            my $response=&reply('instuserrules:'.&escape($udom),
+                                 $homeserver);
+            if (($response ne 'refused') && ($response ne 'error') && 
+                ($response ne 'no_such_host')) {
+                my ($hashitems,$orderitems) = split(/:/,$response);
+                my @pairs=split(/\&/,$hashitems);
+                foreach my $item (@pairs) {
+                    my ($key,$value)=split(/=/,$item,2);
+                    $key = &unescape($key);
+                    next if ($key =~ /^error: 2 /);
+                    $ruleshash{$key}=&thaw_unescape($value);
+                }
+                my @esc_order = split(/\&/,$orderitems);
+                foreach my $item (@esc_order) {
+                    push(@ruleorder,&unescape($item));
+                }
+            }
+        }
+    }
+    return (\%ruleshash,\@ruleorder);
+}
+
 # --------------------------------------------------- Assign a key to a student
 
 sub assign_access_key {
@@ -1114,8 +1377,10 @@ sub do_cache_new {
 	$time=600;
     }
     if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }
-    if (!($memcache->set($id,$setvalue,$time))) {
+    my $result = $memcache->set($id,$setvalue,$time);
+    if (! $result) {
 	&logthis("caching of id -> $id  failed");
+	$memcache->disconnect_all();
     }
     # need to make a copy of $value
     #&make_room($id,$value,$debug);
@@ -1378,7 +1643,7 @@ sub ssi {
     my $request;
 
     $form{'no_update_last_known'}=1;
-
+    &Apache::lonenc::check_encrypt(\$fn);
     if (%form) {
       $request=new HTTP::Request('POST',&absolute_url().$fn);
       $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form));
@@ -1918,23 +2183,20 @@ sub flushcourselogs {
                delete $courselogs{$crsid};
             }
         }
-        if ($courseidbuffer{$coursehombuf{$crsid}}) {
-           $courseidbuffer{$coursehombuf{$crsid}}.='&'.
-			 &escape($crsid).'='.&escape($coursedescrbuf{$crsid}).
-                         ':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid}).':'.&escape($coursetypebuf{$crsid});
-        } else {
-           $courseidbuffer{$coursehombuf{$crsid}}=
-			 &escape($crsid).'='.&escape($coursedescrbuf{$crsid}).
-                         ':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid}).':'.&escape($coursetypebuf{$crsid});
-        }
+        $courseidbuffer{$coursehombuf{$crsid}}{$crsid} = (
+            'description' => &escape($coursedescrbuf{$crsid}),
+            'instcode'    => &escape($courseinstcodebuf{$crsid}),
+            'type'        => &escape($coursetypebuf{$crsid}),
+            'owner'       => &escape($courseownerbuf{$crsid}),
+        );
     }
 #
 # Write course id database (reverse lookup) to homeserver of courses 
 # Is used in pickcourse
 #
     foreach my $crs_home (keys(%courseidbuffer)) {
-        &courseidput(&host_domain($crs_home),$courseidbuffer{$crs_home},
-		     $crs_home);
+        my $response = &courseidput(&host_domain($crs_home),
+                                    $courseidbuffer{$crs_home},$crs_home);
     }
 #
 # File accesses
@@ -1990,7 +2252,7 @@ sub flushcourselogs {
 #
     my %domrolebuffer = ();
     foreach my $entry (keys %domainrolehash) {
-        my ($role,$uname,$udom,$runame,$rudom,$rsec)=split/:/,$entry;
+        my ($role,$uname,$udom,$runame,$rudom,$rsec)=split(/:/,$entry);
         if ($domrolebuffer{$rudom}) {
             $domrolebuffer{$rudom}.='&'.&escape($entry).
                       '='.&escape($domainrolehash{$entry});
@@ -2095,6 +2357,14 @@ sub userrolelog {
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
                     =$tend.':'.$tstart;
     }
+    if (($env{'request.role'} =~ /dc\./) &&
+	(($trole=~/^au/) || ($trole=~/^in/) ||
+	 ($trole=~/^cc/) || ($trole=~/^ep/) ||
+	 ($trole=~/^cr/) || ($trole=~/^ta/))) {
+       $userrolehash
+         {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}
+                    =$tend.':'.$tstart;
+    }
     if (($trole=~/^dc/) || ($trole=~/^ad/) ||
         ($trole=~/^li/) || ($trole=~/^li/) ||
         ($trole=~/^au/) || ($trole=~/^dg/) ||
@@ -2232,31 +2502,65 @@ sub getannounce {
 #
 
 sub courseidput {
-    my ($domain,$what,$coursehome)=@_;
-    return &reply('courseidput:'.$domain.':'.$what,$coursehome);
+    my ($domain,$storehash,$coursehome)=@_;
+    my $items='';
+    my $now = time;
+    foreach my $item (keys(%$storehash)) {
+        $storehash->{$item}{'lasttime'} = $now;
+        $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
+    }
+    $items=~s/\&$//;
+    my $outcome = &reply('courseidputhash:'.$domain.':'.$items,$coursehome);
+    if ($outcome eq 'unknown_cmd') {
+        my $what;
+        foreach my $cid (keys(%$storehash)) {
+            $what .= &escape($cid).'=';
+            foreach my $item ('description','instcode','owner','type') {
+                $what .= $storehash->{$item}.':';
+            }
+            $what =~ s/\:$/&/;
+        }
+        $what =~ s/\&$//;  
+        return &reply('courseidput:'.$domain.':'.$what,$coursehome);
+    } else {
+        return $outcome;
+    }
 }
 
 sub courseiddump {
     my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;
-    my %returnhash=();
-    unless ($domfilter) { $domfilter=''; }
+    my $as_hash = 1;
+    my %returnhash;
+    if (!$domfilter) { $domfilter=''; }
     my %libserv = &all_library();
     foreach my $tryserver (keys(%libserv)) {
         if ( (  $hostidflag == 1 
 	        && grep(/^\Q$tryserver\E$/,@{$hostidref}) ) 
 	     || (!defined($hostidflag)) ) {
 
-	    if ($domfilter eq ''
-		|| (&host_domain($tryserver) eq $domfilter)) {
-	        foreach my $line (
-                 split(/\&/,&reply('courseiddump:'.&host_domain($tryserver).':'.
-			       $sincefilter.':'.&escape($descfilter).':'.
-                               &escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter).':'.&escape($typefilter).':'.&escape($regexp_ok),
-                               $tryserver))) {
-		    my ($key,$value)=split(/\=/,$line,2);
-                    if (($key) && ($value)) {
-		        $returnhash{&unescape($key)}=$value;
-                    }
+	    if (($domfilter eq '') ||
+		(&host_domain($tryserver) eq $domfilter)) {
+                my $rep = 
+                  &reply('courseiddump:'.&host_domain($tryserver).':'.
+                         $sincefilter.':'.&escape($descfilter).':'.
+                         &escape($instcodefilter).':'.&escape($ownerfilter).
+                         ':'.&escape($coursefilter).':'.&escape($typefilter).
+                         ':'.&escape($regexp_ok).':'.$as_hash,$tryserver); 
+                my @pairs=split(/\&/,$rep);
+                foreach my $item (@pairs) {
+                    my ($key,$value)=split(/\=/,$item,2);
+                    $key = &unescape($key);
+                    next if ($key =~ /^error: 2 /);
+                    my $result = &thaw_unescape($value);
+                    if (ref($result) eq 'HASH') {
+                        $returnhash{$key}=$result;
+                    } else {
+                        my @responses = split(/:/,$result);
+                        my @items = ('description','instcode','owner','type');
+                        for (my $i=0; $i<@responses; $i++) {
+                            $returnhash{$key}{$items[$i]} = $responses[$i];
+                        }
+                    } 
                 }
             }
         }
@@ -3786,26 +4090,40 @@ sub customaccess {
     $ucrs = &LONCAPA::clean_username($ucrs);
     my $access=0;
     foreach my $right (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) {
-	my ($effect,$realm,$role)=split(/\:/,$right);
-        if ($role) {
-	   if ($role ne $urole) { next; }
-        }
-        foreach my $scope (split(/\s*\,\s*/,$realm)) {
-            my ($tdom,$tcrs,$tsec)=split(/\_/,$scope);
-            if ($tdom) {
-		if ($tdom ne $udom) { next; }
-            }
-            if ($tcrs) {
-		if ($tcrs ne $ucrs) { next; }
-            }
-            if ($tsec) {
-		if ($tsec ne $usec) { next; }
-            }
-            $access=($effect eq 'allow');
-            last;
-        }
-	if ($realm eq '' && $role eq '') {
-            $access=($effect eq 'allow');
+	my ($effect,$realm,$role,$type)=split(/\:/,$right);
+	if ($type eq 'user') {
+	    foreach my $scope (split(/\s*\,\s*/,$realm)) {
+		my ($tdom,$tuname)=split(m{/},$scope);
+		if ($tdom) {
+		    if ($tdom ne $env{'user.domain'}) { next; }
+		}
+		if ($tuname) {
+		    if ($tuname ne $env{'user.name'}) { next; }
+		}
+		$access=($effect eq 'allow');
+		last;
+	    }
+	} else {
+	    if ($role) {
+		if ($role ne $urole) { next; }
+	    }
+	    foreach my $scope (split(/\s*\,\s*/,$realm)) {
+		my ($tdom,$tcrs,$tsec)=split(/\_/,$scope);
+		if ($tdom) {
+		    if ($tdom ne $udom) { next; }
+		}
+		if ($tcrs) {
+		    if ($tcrs ne $ucrs) { next; }
+		}
+		if ($tsec) {
+		    if ($tsec ne $usec) { next; }
+		}
+		$access=($effect eq 'allow');
+		last;
+	    }
+	    if ($realm eq '' && $role eq '') {
+		$access=($effect eq 'allow');
+	    }
 	}
     }
     return $access;
@@ -4334,6 +4652,23 @@ sub update_portfolio_table {
     return $reply;
 }
 
+# -------------------------- Update MySQL allusers table
+
+sub update_allusers_table {
+    my ($uname,$udom,$names) = @_;
+    my $homeserver = &homeserver($uname,$udom);
+    my $queryid=
+        &reply('querysend:allusers:'.&escape($uname).':'.&escape($udom).':'.
+               'lastname='.&escape($names->{'lastname'}).'%%'.
+               'firstname='.&escape($names->{'firstname'}).'%%'.
+               'middlename='.&escape($names->{'middlename'}).'%%'.
+               'generation='.&escape($names->{'generation'}).'%%'.
+               'permanentemail='.&escape($names->{'permanentemail'}).'%%'.
+               'id='.&escape($names->{'id'}),$homeserver);
+    my $reply = &get_query_reply($queryid);
+    return $reply;
+}
+
 # ------- Request retrieval of institutional classlists for course(s)
 
 sub fetch_enrollment_query {
@@ -4368,7 +4703,7 @@ sub fetch_enrollment_query {
     if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) {
         &logthis('fetch_enrollment_query error: '.$reply.' for '.$dom.' '.$env{'user.name'}.' for '.$queryid.' context: '.$context.' '.$cnum.' maxtries: '.$maxtries.' tries: '.$tries);
     } else {
-        my @responses = split/:/,$reply;
+        my @responses = split(/:/,$reply);
         if ($homeserver eq $perlvar{'lonHostID'}) {
             foreach my $line (@responses) {
                 my ($key,$value) = split(/=/,$line,2);
@@ -4411,8 +4746,8 @@ sub get_query_reply {
 	sleep 2;
         if (-e $replyfile.'.end') {
 	    if (open(my $fh,$replyfile)) {
-               $reply.=<$fh>;
-               close($fh);
+		$reply = join('',<$fh>);
+		close($fh);
 	   } else { return 'error: reply_file_error'; }
            return &unescape($reply);
 	}
@@ -4478,7 +4813,7 @@ sub auto_get_sections {
     my @secs = ();
     my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver));
     unless ($response eq 'refused') {
-        @secs = split/:/,$response;
+        @secs = split(/:/,$response);
     }
     return @secs;
 }
@@ -4517,7 +4852,7 @@ sub auto_create_password {
         if ($response eq 'refused') {
             $authchk = 'refused';
         } else {
-            ($authparam,$create_passwd,$authchk) = split/:/,$response;
+            ($authparam,$create_passwd,$authchk) = split(/:/,$response);
         }
     }
     return ($authparam,$create_passwd,$authchk);
@@ -4625,7 +4960,7 @@ sub auto_instcode_format {
         $response=&reply('autoinstcodeformat:'.$codedom.':'.$courses,$server);
         if ($response !~ /(con_lost|error|no_such_host|refused)/) {
             my ($codes_str,$codetitles_str,$cat_titles_str,$cat_order_str) = 
-		split/:/,$response;
+		split(/:/,$response);
             %{$codes} = (%{$codes},&str2hash($codes_str));
             push(@{$codetitles},&str2array($codetitles_str));
             %{$cat_titles} = (%{$cat_titles},&str2hash($cat_titles_str));
@@ -4671,10 +5006,16 @@ sub auto_instcode_defaults {
 } 
 
 sub auto_validate_class_sec {
-    my ($cdom,$cnum,$owner,$inst_class) = @_;
+    my ($cdom,$cnum,$owners,$inst_class) = @_;
     my $homeserver = &homeserver($cnum,$cdom);
+    my $ownerlist;
+    if (ref($owners) eq 'ARRAY') {
+        $ownerlist = join(',',@{$owners});
+    } else {
+        $ownerlist = $owners;
+    }
     my $response=&reply('autovalidateclass_sec:'.$inst_class.':'.
-                        &escape($owner).':'.$cdom,$homeserver);
+                        &escape($ownerlist).':'.$cdom,$homeserver);
     return $response;
 }
 
@@ -5005,7 +5346,8 @@ sub modifyuser {
     }
 # -------------------------------------------------------------- Add names, etc
     my @tmp=&get('environment',
-		   ['firstname','middlename','lastname','generation'],
+		   ['firstname','middlename','lastname','generation','id',
+                    'permanentemail'],
 		   $udom,$uname);
     my %names;
     if ($tmp[0] =~ m/^error:.*/) { 
@@ -5027,8 +5369,10 @@ sub modifyuser {
 			   $names{'critnotification'} = $email;
 			   $names{'permanentemail'} = $email; }
     }
+    if ($uid) { $names{'id'}  = $uid; }
     my $reply = &put('environment', \%names, $udom,$uname);
     if ($reply ne 'ok') { return 'error: '.$reply; }
+    my $sqlresult = &update_allusers_table($uname,$udom,\%names);
     &devalidate_cache_new('namescache',$uname.':'.$udom);
     &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.
@@ -5200,9 +5544,15 @@ sub createcourse {
     }
 # ----------------------------------------------------------------- Course made
 # log existence
-    &courseidput($udom,&escape($udom.'_'.$uname).'='.&escape($description).
-                 ':'.&escape($inst_code).':'.&escape($course_owner).':'.
-                  &escape($crstype),$uhome);
+    my $newcourse = {
+                    $udom.'_'.$uname => {
+                                     description => &escape($description),
+                                     inst_code   => &escape($inst_code),
+                                     owner       => &escape($course_owner),
+                                     type        => &escape($crstype),
+                                                },
+                    };
+    &courseidput($udom,$newcourse);
     &flushcourselogs();
 # set toplevel url
     my $topurl=$url;
@@ -5233,7 +5583,7 @@ ENDINITMAP
 sub is_course {
     my ($cdom,$cnum) = @_;
     my %courses = &courseiddump($cdom,'.',1,'.','.',$cnum,undef,
-				undef,'.');
+				undef,'.',undef,1);
     if (exists($courses{$cdom.'_'.$cnum})) {
         return 1;
     }
@@ -6172,6 +6522,12 @@ sub EXT {
 	    my ($map) = &decode_symb($symbparm);
 	    return &symbread($map);
 	}
+	if ($space eq 'filename') {
+	    if ($symbparm) {
+		return &clutter((&decode_symb($symbparm))[2]);
+	    }
+	    return &hreflocation('',$env{'request.filename'});
+	}
 
 	my ($section, $group, @groups);
 	my ($courselevelm,$courselevel);
@@ -6545,10 +6901,11 @@ sub metadata {
 		 # only ws inside the tag, and not in default, so use default
 		 # as value
 			    $metaentry{':'.$unikey}=$default;
-			} else {
-		  # either something interesting inside the tag or default
-                  # uninteresting
+			} elsif ( $internaltext =~ /\S/ ) {
+		  # something interesting inside the tag
 			    $metaentry{':'.$unikey}=$internaltext;
+			} else {
+		  # no interesting values, don't set a default
 			}
 # end of not-a-package not-a-library import
 		    }
@@ -6688,12 +7045,15 @@ sub gettitle {
 	}
 	my ($map,$resid,$url)=&decode_symb($symb);
 	my $title='';
-	my %bighash;
-	if (tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
-		&GDBM_READER(),0640)) {
-	    my $mapid=$bighash{'map_pc_'.&clutter($map)};
-	    $title=$bighash{'title_'.$mapid.'.'.$resid};
-	    untie %bighash;
+	if (!$map && $resid == 0 && $url =~/default\.sequence$/) {
+	    $title = $env{'course.'.$env{'request.course.id'}.'.description'};
+	} else {
+	    if (tie(my %bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
+		    &GDBM_READER(),0640)) {
+		my $mapid=$bighash{'map_pc_'.&clutter($map)};
+		$title=$bighash{'title_'.$mapid.'.'.$resid};
+		untie(%bighash);
+	    }
 	}
 	$title=~s/\&colon\;/\:/gs;
 	if ($title) {
@@ -7066,7 +7426,7 @@ sub getCODE {
 sub rndseed {
     my ($symb,$courseid,$domain,$username)=@_;
     my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser();
-    if (!$symb) {
+    if (!defined($symb)) {
 	unless ($symb=$wsymb) { return time; }
     }
     if (!$courseid) { $courseid=$wcourseid; }
@@ -7572,6 +7932,9 @@ sub hreflocation {
 	$file=~s-^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/
 	    -/uploaded/$1/$2/-x;
     }
+    if ($file=~ m{^/userfiles/}) {
+	$file =~ s{^/userfiles/}{/uploaded/};
+    }
     return $file;
 }
 
@@ -7852,8 +8215,10 @@ sub get_dns {
     }
     
     sub reset_hosts_info {
+	&purge_remembered();
 	&reset_domain_info();
 	&reset_hosts_ip_info();
+	undef(%name_to_host);
 	undef(%hostname);
 	undef(%hostdom);
 	undef(%libserv);
@@ -7945,24 +8310,6 @@ sub get_dns {
     my %name_to_ip;
     my %lonid_to_ip;
 
-    my %valid_ip;
-    sub valid_ip {
-	my ($ip) = @_;
-	if (exists($iphost{$ip}) || exists($valid_ip{$ip})) {
-	    return 1;	
-	}
-	my $name = gethostbyip($ip);
-	my $lonid = &hostname($name);
-	if (defined($lonid)) {
-	    $valid_ip{$ip} = $lonid;
-	    return 1;
-	}
-	my %iphosts = &get_iphost();
-	if (ref($iphost{$ip})) {
-	    return 1;	
-	}
-    }
-
     sub get_hosts_from_ip {
 	my ($ip) = @_;
 	my %iphosts = &get_iphost();
@@ -7994,6 +8341,7 @@ sub get_dns {
     
     sub get_iphost {
 	my ($ignore_cache) = @_;
+
 	if (!$ignore_cache) {
 	    if (%iphost) {
 		return %iphost;
@@ -8007,16 +8355,31 @@ sub get_dns {
 		return %iphost;
 	    }
 	}
+
+	# get yesterday's info for fallback
+	my %old_name_to_ip;
+	my ($ip_info,$cached)=
+	    &Apache::lonnet::is_cached_new('iphost','iphost');
+	if ($cached) {
+	    %old_name_to_ip = %{$ip_info->[1]};
+	}
+
 	my %name_to_host = &all_names();
 	foreach my $name (keys(%name_to_host)) {
 	    my $ip;
 	    if (!exists($name_to_ip{$name})) {
 		$ip = gethostbyname($name);
 		if (!$ip || length($ip) ne 4) {
-		    &logthis("Skipping name $name no IP found");
-		    next;
+		    if (defined($old_name_to_ip{$name})) {
+			$ip = $old_name_to_ip{$name};
+			&logthis("Can't find $name defaulting to old $ip");
+		    } else {
+			&logthis("Name $name no IP found");
+			next;
+		    }
+		} else {
+		    $ip=inet_ntoa($ip);
 		}
-		$ip=inet_ntoa($ip);
 		$name_to_ip{$name} = $ip;
 	    } else {
 		$ip = $name_to_ip{$name};
@@ -8028,7 +8391,7 @@ sub get_dns {
 	}
 	&Apache::lonnet::do_cache_new('iphost','iphost',
 				      [\%iphost,\%name_to_ip,\%lonid_to_ip],
-				      24*60*60);
+				      48*60*60);
 
 	return %iphost;
     }
@@ -8417,7 +8780,7 @@ explanation of a user role term
 get_my_roles($uname,$udom,$context,$types,$roles,$roledoms) :
 All arguments are optional. Returns a hash of a roles, either for
 co-author/assistant author roles for a user's Construction Space
-(default), or if $context is 'user', roles for the user himself,
+(default), or if $context is 'userroles', roles for the user himself,
 In the hash, keys are set to colon-sparated $uname,$udom,and $role,
 and value is set to colon-separated start and end times for the role.
 If no username and domain are specified, will default to current