--- loncom/lonnet/perl/lonnet.pm	2008/02/21 10:04:35	1.942
+++ loncom/lonnet/perl/lonnet.pm	2011/06/03 00:22:25	1.1108
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.942 2008/02/21 10:04:35 foxr Exp $
+# $Id: lonnet.pm,v 1.1108 2011/06/03 00:22:25 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -27,19 +27,61 @@
 #
 ###
 
+=pod
+
+=head1 NAME
+
+Apache::lonnet.pm
+
+=head1 SYNOPSIS
+
+This file is an interface to the lonc processes of
+the LON-CAPA network as well as set of elaborated functions for handling information
+necessary for navigating through a given cluster of LON-CAPA machines within a
+domain. There are over 40 specialized functions in this module which handle the
+reading and transmission of metadata, user information (ids, names, environments, roles,
+logs), file information (storage, reading, directories, extensions, replication, embedded
+styles and descriptors), educational resources (course descriptions, section names and
+numbers), url hashing (to assign roles on a url basis), and translating abbreviated symbols to
+and from more descriptive phrases or explanations.
+
+This is part of the LearningOnline Network with CAPA project
+described at http://www.lon-capa.org.
+
+=head1 Package Variables
+
+These are largely undocumented, so if you decipher one please note it here.
+
+=over 4
+
+=item $processmarker
+
+Contains the time this process was started and this servers host id.
+
+=item $dumpcount
+
+Counts the number of times a message log flush has been attempted (regardless
+of success) by this process.  Used as part of the filename when messages are
+delayed.
+
+=back
+
+=cut
+
 package Apache::lonnet;
 
 use strict;
 use LWP::UserAgent();
 use HTTP::Date;
-# use Date::Parse;
+use Image::Magick;
+
 use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
-            $_64bit %env);
+            $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease);
 
 my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,
     %userrolehash, $processmarker, $dumpcount, %coursedombuf,
     %coursenumbuf, %coursehombuf, %coursedescrbuf, %courseinstcodebuf,
-    %courseownerbuf, %coursetypebuf);
+    %courseownerbuf, %coursetypebuf,$locknum);
 
 use IO::Socket;
 use GDBM_File;
@@ -50,8 +92,10 @@ use Time::HiRes qw( gettimeofday tv_inte
 use Cache::Memcached;
 use Digest::MD5;
 use Math::Random;
+use File::MMagic;
 use LONCAPA qw(:DEFAULT :match);
 use LONCAPA::Configuration;
+use File::Copy;
 
 my $readit;
 my $max_connection_retries = 10;     # Or some such value.
@@ -61,51 +105,31 @@ require Exporter;
 our @ISA = qw (Exporter);
 our @EXPORT = qw(%env);
 
-=pod
-
-=head1 Package Variables
-
-These are largely undocumented, so if you decipher one please note it here.
-
-=over 4
-
-=item $processmarker
-
-Contains the time this process was started and this servers host id.
-
-=item $dumpcount
-
-Counts the number of times a message log flush has been attempted (regardless
-of success) by this process.  Used as part of the filename when messages are
-delayed.
-
-=back
-
-=cut
-
 
 # --------------------------------------------------------------------- Logging
 {
     my $logid;
     sub instructor_log {
-	my ($hash_name,$storehash,$delflag,$uname,$udom)=@_;
+	my ($hash_name,$storehash,$delflag,$uname,$udom,$cnum,$cdom)=@_;
+        if (($cnum eq '') || ($cdom eq '')) {
+            $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+            $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+        }
 	$logid++;
-	my $id=time().'00000'.$$.'00000'.$logid;
+        my $now = time();
+	my $id=$now.'00000'.$$.'00000'.$logid;
 	return &Apache::lonnet::put('nohist_'.$hash_name,
 				    { $id => {
 					'exe_uname' => $env{'user.name'},
 					'exe_udom'  => $env{'user.domain'},
-					'exe_time'  => time(),
+					'exe_time'  => $now,
 					'exe_ip'    => $ENV{'REMOTE_ADDR'},
 					'delflag'   => $delflag,
 					'logentry'  => $storehash,
 					'uname'     => $uname,
 					'udom'      => $udom,
 				    }
-				  },
-				    $env{'course.'.$env{'request.course.id'}.'.domain'},
-				    $env{'course.'.$env{'request.course.id'}.'.num'}
-				    );
+				  },$cdom,$cnum);
     }
 }
 
@@ -125,7 +149,8 @@ sub logthis {
     my $now=time;
     my $local=localtime($now);
     if (open(my $fh,">>$execdir/logs/lonnet.log")) {
-	print $fh "$local ($$): $message\n";
+	my $logstring = $local. " ($$): ".$message."\n"; # Keep any \'s in string.
+	print $fh $logstring;
 	close($fh);
     }
     return 1;
@@ -156,6 +181,129 @@ sub create_connection {
     return 0;
 }
 
+sub get_server_timezone {
+    my ($cnum,$cdom) = @_;
+    my $home=&homeserver($cnum,$cdom);
+    if ($home ne 'no_host') {
+        my $cachetime = 24*3600;
+        my ($timezone,$cached)=&is_cached_new('servertimezone',$home);
+        if (defined($cached)) {
+            return $timezone;
+        } else {
+            my $timezone = &reply('servertimezone',$home);
+            return &do_cache_new('servertimezone',$home,$timezone,$cachetime);
+        }
+    }
+}
+
+sub get_server_distarch {
+    my ($lonhost,$ignore_cache) = @_;
+    if (defined($lonhost)) {
+        if (!defined(&hostname($lonhost))) {
+            return;
+        }
+        my $cachetime = 12*3600;
+        if (!$ignore_cache) {
+            my ($distarch,$cached)=&is_cached_new('serverdistarch',$lonhost);
+            if (defined($cached)) {
+                return $distarch;
+            }
+        }
+        my $rep = &reply('serverdistarch',$lonhost);
+        unless ($rep eq 'unknown_command' || $rep eq 'no_such_host' ||
+                $rep eq 'con_lost' || $rep eq 'rejected' || $rep eq 'refused' ||
+                $rep eq '') {
+            return &do_cache_new('serverdistarch',$lonhost,$rep,$cachetime);
+        }
+    }
+    return;
+}
+
+sub get_server_loncaparev {
+    my ($dom,$lonhost,$ignore_cache,$caller) = @_;
+    if (defined($lonhost)) {
+        if (!defined(&hostname($lonhost))) {
+            undef($lonhost);
+        }
+    }
+    if (!defined($lonhost)) {
+        if (defined(&domain($dom,'primary'))) {
+            $lonhost=&domain($dom,'primary');
+            if ($lonhost eq 'no_host') {
+                undef($lonhost);
+            }
+        }
+    }
+    if (defined($lonhost)) {
+        my $cachetime = 12*3600;
+        if (!$ignore_cache) {
+            my ($loncaparev,$cached)=&is_cached_new('serverloncaparev',$lonhost);
+            if (defined($cached)) {
+                return $loncaparev;
+            }
+        }
+        my ($answer,$loncaparev);
+        my @ids=&current_machine_ids();
+        if (grep(/^\Q$lonhost\E$/,@ids)) {
+            $answer = $perlvar{'lonVersion'};
+            if ($answer =~ /^[\'\"]?([\w.\-]+)[\'\"]?$/) {
+                $loncaparev = $1;
+            }
+        } else {
+            $answer = &reply('serverloncaparev',$lonhost);
+            if (($answer eq 'unknown_cmd') || ($answer eq 'con_lost')) {
+                if ($caller eq 'loncron') {
+                    my $ua=new LWP::UserAgent;
+                    $ua->timeout(4);
+                    my $protocol = $protocol{$lonhost};
+                    $protocol = 'http' if ($protocol ne 'https');
+                    my $url = $protocol.'://'.&hostname($lonhost).'/adm/about.html';
+                    my $request=new HTTP::Request('GET',$url);
+                    my $response=$ua->request($request);
+                    unless ($response->is_error()) {
+                        my $content = $response->content;
+                        if ($content =~ /<p>VERSION\:\s*([\w.\-]+)<\/p>/) {
+                            $loncaparev = $1;
+                        }
+                    }
+                } else {
+                    $loncaparev = $loncaparevs{$lonhost};
+                }
+            } elsif ($answer =~ /^[\'\"]?([\w.\-]+)[\'\"]?$/) {
+                $loncaparev = $1;
+            }
+        }
+        return &do_cache_new('serverloncaparev',$lonhost,$loncaparev,$cachetime);
+    }
+}
+
+sub get_server_homeID {
+    my ($hostname,$ignore_cache,$caller) = @_;
+    unless ($ignore_cache) {
+        my ($serverhomeID,$cached)=&is_cached_new('serverhomeID',$hostname);
+        if (defined($cached)) {
+            return $serverhomeID;
+        }
+    }
+    my $cachetime = 12*3600;
+    my $serverhomeID;
+    if ($caller eq 'loncron') { 
+        my @machine_ids = &machine_ids($hostname);
+        foreach my $id (@machine_ids) {
+            my $response = &reply('serverhomeID',$id);
+            unless (($response eq 'unknown_cmd') || ($response eq 'con_lost')) {
+                $serverhomeID = $response;
+                last;
+            }
+        }
+        if ($serverhomeID eq '') {
+            $serverhomeID = $machine_ids[-1];
+        }
+    } else {
+        $serverhomeID = $serverhomeIDs{$hostname};
+    }
+    return &do_cache_new('serverhomeID',$hostname,$serverhomeID,$cachetime);
+}
 
 # -------------------------------------------------- Non-critical communication
 sub subreply {
@@ -448,38 +596,59 @@ sub timed_flock {
 # ---------------------------------------------------------- Append Environment
 
 sub appenv {
-    my %newenv=@_;
-    foreach my $key (keys(%newenv)) {
-	if (($newenv{$key}=~/^user\.role/) || ($newenv{$key}=~/^user\.priv/)) {
-            &logthis("<font color=\"blue\">WARNING: ".
-                "Attempt to modify environment ".$key." to ".$newenv{$key}
-                .'</font>');
-	    delete($newenv{$key});
-        } else {
-            $env{$key}=$newenv{$key};
+    my ($newenv,$roles) = @_;
+    if (ref($newenv) eq 'HASH') {
+        foreach my $key (keys(%{$newenv})) {
+            my $refused = 0;
+	    if (($key =~ /^user\.role/) || ($key =~ /^user\.priv/)) {
+                $refused = 1;
+                if (ref($roles) eq 'ARRAY') {
+                    my ($type,$role) = ($key =~ /^user\.(role|priv)\.([^.]+)\./);
+                    if (grep(/^\Q$role\E$/,@{$roles})) {
+                        $refused = 0;
+                    }
+                }
+            }
+            if ($refused) {
+                &logthis("<font color=\"blue\">WARNING: ".
+                         "Attempt to modify environment ".$key." to ".$newenv->{$key}
+                         .'</font>');
+	        delete($newenv->{$key});
+            } else {
+                $env{$key}=$newenv->{$key};
+            }
+        }
+        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)) {
+	    while (my ($key,$value) = each(%{$newenv})) {
+	        $disk_env{$key} = $value;
+	    }
+	    untie(%disk_env);
         }
-    }
-    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)) {
-	while (my ($key,$value) = each(%newenv)) {
-	    $disk_env{$key} = $value;
-	}
-	untie(%disk_env);
     }
     return 'ok';
 }
 # ----------------------------------------------------- Delete from Environment
 
 sub delenv {
-    my $delthis=shift;
-    if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) {
-        &logthis("<font color=\"blue\">WARNING: ".
-                "Attempt to delete from environment ".$delthis);
-        return 'error';
+    my ($delthis,$regexp,$roles) = @_;
+    if (($delthis=~/^user\.role/) || ($delthis=~/^user\.priv/)) {
+        my $refused = 1;
+        if (ref($roles) eq 'ARRAY') {
+            my ($type,$role) = ($delthis =~ /^user\.(role|priv)\.([^.]+)\./);
+            if (grep(/^\Q$role\E$/,@{$roles})) {
+                $refused = 0;
+            }
+        }
+        if ($refused) {
+            &logthis("<font color=\"blue\">WARNING: ".
+                     "Attempt to delete from environment ".$delthis);
+            return 'error';
+        }
     }
     my $opened = open(my $env_file,'+<',$env{'user.environment'});
     if ($opened
@@ -488,10 +657,17 @@ sub delenv {
 	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});
-	    }
+	    if ($regexp) {
+                if ($key=~/^$delthis/) {
+                    delete($env{$key});
+                    delete($disk_env{$key});
+                } 
+            } else {
+                if ($key=~/^\Q$delthis\E/) {
+		    delete($env{$key});
+		    delete($disk_env{$key});
+	        }
+            }
 	}
 	untie(%disk_env);
     }
@@ -512,6 +688,51 @@ sub get_env_multiple {
     return(@values);
 }
 
+# ------------------------------------------------------------------- Locking
+
+sub set_lock {
+    my ($text)=@_;
+    $locknum++;
+    my $id=$$.'-'.$locknum;
+    &appenv({'session.locks' => $env{'session.locks'}.','.$id,
+             'session.lock.'.$id => $text});
+    return $id;
+}
+
+sub get_locks {
+    my $num=0;
+    my %texts=();
+    foreach my $lock (split(/\,/,$env{'session.locks'})) {
+       if ($lock=~/\w/) {
+          $num++;
+          $texts{$lock}=$env{'session.lock.'.$lock};
+       }
+   }
+   return ($num,%texts);
+}
+
+sub remove_lock {
+    my ($id)=@_;
+    my $newlocks='';
+    foreach my $lock (split(/\,/,$env{'session.locks'})) {
+       if (($lock=~/\w/) && ($lock ne $id)) {
+          $newlocks.=','.$lock;
+       }
+    }
+    &appenv({'session.locks' => $newlocks});
+    &delenv('session.lock.'.$id);
+}
+
+sub remove_all_locks {
+    my $activelocks=$env{'session.locks'};
+    foreach my $lock (split(/\,/,$env{'session.locks'})) {
+       if ($lock=~/\w/) {
+          &remove_lock($lock);
+       }
+    }
+}
+
+
 # ------------------------------------------ Find out current server userload
 sub userload {
     my $numusers=0;
@@ -536,40 +757,26 @@ sub userload {
     return $userloadpercent;
 }
 
-# ------------------------------------------ Fight off request when overloaded
-
-sub overloaderror {
-    my ($r,$checkserver)=@_;
-    unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; }
-    my $loadavg;
-    if ($checkserver eq $perlvar{'lonHostID'}) {
-       open(my $loadfile,'/proc/loadavg');
-       $loadavg=<$loadfile>;
-       $loadavg =~ s/\s.*//g;
-       $loadavg = 100*$loadavg/$perlvar{'lonLoadLim'};
-       close($loadfile);
-    } else {
-       $loadavg=&reply('load',$checkserver);
-    }
-    my $overload=$loadavg-100;
-    if ($overload>0) {
-	$r->err_headers_out->{'Retry-After'}=$overload;
-        $r->log_error('Overload of '.$overload.' on '.$checkserver);
-        return 413;
-    }    
-    return '';
-}
-
 # ------------------------------ Find server with least workload from spare.tab
 
 sub spareserver {
-    my ($loadpercent,$userloadpercent,$want_server_name) = @_;
+    my ($loadpercent,$userloadpercent,$want_server_name,$udom) = @_;
     my $spare_server;
     if ($userloadpercent !~ /\d/) { $userloadpercent=0; }
     my $lowest_load=($loadpercent > $userloadpercent) ? $loadpercent 
                                                      :  $userloadpercent;
-    
+    my ($uint_dom,$remotesessions);
+    if (($udom ne '') && (&domain($udom) ne '')) {
+        my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
+        $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
+        my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom);
+        $remotesessions = $udomdefaults{'remotesessions'};
+    }
     foreach my $try_server (@{ $spareid{'primary'} }) {
+        if ($uint_dom) {
+             next unless (&spare_can_host($udom,$uint_dom,$remotesessions,
+                                          $try_server));
+        }
 	($spare_server, $lowest_load) =
 	    &compare_server_load($try_server, $spare_server, $lowest_load);
     }
@@ -578,13 +785,26 @@ sub spareserver {
 
     if (!$found_server) {
 	foreach my $try_server (@{ $spareid{'default'} }) {
+            if ($uint_dom) {
+                next unless (&spare_can_host($udom,$uint_dom,$remotesessions,
+                                             $try_server));
+            }
 	    ($spare_server, $lowest_load) =
 		&compare_server_load($try_server, $spare_server, $lowest_load);
 	}
     }
 
     if (!$want_server_name) {
-	$spare_server="http://".&hostname($spare_server);
+        my $protocol = 'http';
+        if ($protocol{$spare_server} eq 'https') {
+            $protocol = $protocol{$spare_server};
+        }
+        if (defined($spare_server)) {
+            my $hostname = &hostname($spare_server);
+            if (defined($hostname)) {
+	        $spare_server = $protocol.'://'.$hostname;
+            }
+        }
     }
     return $spare_server;
 }
@@ -596,7 +816,7 @@ sub compare_server_load {
     my $userloadans = &reply('userload',$try_server);
 
     if ($loadans !~ /\d/ && $userloadans !~ /\d/) {
-	next; #didn't get a number from the server
+	return; #didn't get a number from the server
     }
 
     my $load;
@@ -639,13 +859,35 @@ sub has_user_session {
     return 0;
 }
 
+# --------- determine least loaded server in a user's domain which allows login
+
+sub choose_server {
+    my ($udom) = @_;
+    my %domconfhash = &Apache::loncommon::get_domainconf($udom);
+    my %servers = &get_servers($udom);
+    my $lowest_load = 30000;
+    my ($login_host,$hostname);
+    foreach my $lonhost (keys(%servers)) {
+        my $loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost};
+        if ($loginvia eq '') {
+            ($login_host, $lowest_load) =
+            &compare_server_load($lonhost, $login_host, $lowest_load);
+        }
+    }
+    if ($login_host ne '') {
+        $hostname = $servers{$login_host};
+    }
+    return ($login_host,$hostname);
+}
+
 # --------------------------------------------- Try to change a user's password
 
 sub changepass {
     my ($uname,$udom,$currentpass,$newpass,$server,$context)=@_;
     $currentpass = &escape($currentpass);
     $newpass     = &escape($newpass);
-    my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass:$context",
+    my $lonhost = $perlvar{'lonHostID'};
+    my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass:$context:$lonhost",
 		       $server);
     if (! $answer) {
 	&logthis("No reply on password change request to $server ".
@@ -670,6 +912,9 @@ sub changepass {
     } elsif ($answer =~ "^refused") {
 	&logthis("$server refused to change $uname in $udom password because ".
 		 "it was sent an unencrypted request to change the password.");
+    } elsif ($answer =~ "invalid_client") {
+        &logthis("$server refused to change $uname in $udom password because ".
+                 "it was a reset by e-mail originating from an invalid server.");
     }
     return $answer;
 }
@@ -693,24 +938,38 @@ sub queryauthenticate {
 # --------- Try to authenticate user from domain's lib servers (first this one)
 
 sub authenticate {
-    my ($uname,$upass,$udom)=@_;
+    my ($uname,$upass,$udom,$checkdefauth,$clientcancheckhost)=@_;
     $upass=&escape($upass);
     $uname= &LONCAPA::clean_username($uname);
     my $uhome=&homeserver($uname,$udom,1);
+    my $newhome;
     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);
+	$uhome=&homeserver($uname,$udom,1);
+        if (($uhome eq 'no_host') && $checkdefauth) {
+            if (defined(&domain($udom,'primary'))) {
+                $newhome=&domain($udom,'primary');
+            }
+            if ($newhome ne '') {
+                $uhome = $newhome;
+            }
+        }
 	if ((!$uhome) || ($uhome eq 'no_host')) {
 	    &logthis("User $uname at $udom is unknown in authenticate");
-	}
-	return 'no_host';
+	    return 'no_host';
+        }
     }
-    my $answer=reply("encrypt:auth:$udom:$uname:$upass",$uhome);
+    my $answer=reply("encrypt:auth:$udom:$uname:$upass:$checkdefauth:$clientcancheckhost",$uhome);
     if ($answer eq 'authorized') {
-	&logthis("User $uname at $udom authorized by $uhome"); 
-	return $uhome; 
+        if ($newhome) {
+            &logthis("User $uname at $udom authorized by $uhome, but needs account");
+            return 'no_account_on_host'; 
+        } else {
+            &logthis("User $uname at $udom authorized by $uhome");
+            return $uhome;
+        }
     }
     if ($answer eq 'non_authorized') {
 	&logthis("User $uname at $udom rejected by $uhome");
@@ -720,6 +979,84 @@ sub authenticate {
     return 'no_host';
 }
 
+sub can_host_session {
+    my ($udom,$lonhost,$remoterev,$remotesessions,$hostedsessions) = @_;
+    my $canhost = 1;
+    my $host_idn = &Apache::lonnet::internet_dom($lonhost);
+    if (ref($remotesessions) eq 'HASH') {
+        if (ref($remotesessions->{'excludedomain'}) eq 'ARRAY') {
+            if (grep(/^\Q$host_idn\E$/,@{$remotesessions->{'excludedomain'}})) {
+                $canhost = 0;
+            } else {
+                $canhost = 1;
+            }
+        }
+        if (ref($remotesessions->{'includedomain'}) eq 'ARRAY') {
+            if (grep(/^\Q$host_idn\E$/,@{$remotesessions->{'includedomain'}})) {
+                $canhost = 1;
+            } else {
+                $canhost = 0;
+            }
+        }
+        if ($canhost) {
+            if ($remotesessions->{'version'} ne '') {
+                my ($reqmajor,$reqminor) = ($remotesessions->{'version'} =~ /^(\d+)\.(\d+)$/);
+                if ($reqmajor ne '' && $reqminor ne '') {
+                    if ($remoterev =~ /^\'?(\d+)\.(\d+)/) {
+                        my $major = $1;
+                        my $minor = $2;
+                        if (($major < $reqmajor ) ||
+                            (($major == $reqmajor) && ($minor < $reqminor))) {
+                            $canhost = 0;
+                        }
+                    } else {
+                        $canhost = 0;
+                    }
+                }
+            }
+        }
+    }
+    if ($canhost) {
+        if (ref($hostedsessions) eq 'HASH') {
+            if (ref($hostedsessions->{'excludedomain'}) eq 'ARRAY') {
+                if (grep(/^\Q$udom\E$/,@{$hostedsessions->{'excludedomain'}})) {
+                    $canhost = 0;
+                } else {
+                    $canhost = 1;
+                }
+            }
+            if (ref($hostedsessions->{'includedomain'}) eq 'ARRAY') {
+                if (grep(/^\Q$udom\E$/,@{$hostedsessions->{'includedomain'}})) {
+                    $canhost = 1;
+                } else {
+                    $canhost = 0;
+                }
+            }
+        }
+    }
+    return $canhost;
+}
+
+sub spare_can_host {
+    my ($udom,$uint_dom,$remotesessions,$try_server)=@_;
+    my $canhost=1;
+    my @intdoms;
+    my $internet_names = &Apache::lonnet::get_internet_names($try_server);
+    if (ref($internet_names) eq 'ARRAY') {
+        @intdoms = @{$internet_names};
+    }
+    unless (grep(/^\Q$uint_dom\E$/,@intdoms)) {
+        my $serverhomeID = &Apache::lonnet::get_server_homeID($try_server);
+        my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
+        my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
+        my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$try_server);
+        $canhost = &can_host_session($udom,$try_server,$remoterev,
+                                     $remotesessions,
+                                     $defdomdefaults{'hostedsessions'});
+    }
+    return $canhost;
+}
+
 # ---------------------- Find the homebase for a user from domain's lib servers
 
 my %homecache;
@@ -805,7 +1142,21 @@ sub idput {
     }
 }
 
-# ------------------------------------------- get items from domain db files   
+# ------------------------------dump from db file owned by domainconfig user
+sub dump_dom {
+    my ($namespace,$udom,$regexp,$range)=@_;
+    if (!$udom) {
+        $udom=$env{'user.domain'};
+    }
+    my %returnhash;
+    if ($udom) {
+        my $uname = &get_domainconfiguser($udom);
+        %returnhash = &dump($namespace,$udom,$uname,$regexp,$range);
+    }
+    return %returnhash;
+}
+
+# ------------------------------------------ get items from domain db files   
 
 sub get_dom {
     my ($namespace,$storearr,$udom,$uhome)=@_;
@@ -879,26 +1230,71 @@ sub put_dom {
     }
 }
 
+# --------------------- newput for items in db file owned by domainconfig user
+sub newput_dom {
+    my ($namespace,$storehash,$udom) = @_;
+    my $result;
+    if (!$udom) {
+        $udom=$env{'user.domain'};
+    }
+    if ($udom) {
+        my $uname = &get_domainconfiguser($udom);
+        $result = &newput($namespace,$storehash,$udom,$uname);
+    }
+    return $result;
+}
+
+# --------------------- delete for items in db file owned by domainconfig user
+sub del_dom {
+    my ($namespace,$storearr,$udom)=@_;
+    if (ref($storearr) eq 'ARRAY') {
+        if (!$udom) {
+            $udom=$env{'user.domain'};
+        }
+        if ($udom) {
+            my $uname = &get_domainconfiguser($udom); 
+            return &del($namespace,$storearr,$udom,$uname);
+        }
+    }
+}
+
+# ----------------------------------construct domainconfig user for a domain 
+sub get_domainconfiguser {
+    my ($udom) = @_;
+    return $udom.'-domainconfig';
+}
+
 sub retrieve_inst_usertypes {
     my ($udom) = @_;
     my (%returnhash,@order);
-    if (defined(&domain($udom,'primary'))) {
-        my $uhome=&domain($udom,'primary');
-        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));
-        }
+    my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
+    if ((ref($domdefs{'inststatustypes'}) eq 'HASH') && 
+        (ref($domdefs{'inststatusorder'}) eq 'ARRAY')) {
+        %returnhash = %{$domdefs{'inststatustypes'}};
+        @order = @{$domdefs{'inststatusorder'}};
     } else {
-        &logthis("get_dom failed - no primary domain server for $udom");
+        if (defined(&domain($udom,'primary'))) {
+            my $uhome=&domain($udom,'primary');
+            my $rep=&reply("inst_usertypes:$udom",$uhome);
+            if ($rep =~ /^(con_lost|error|no_such_host|refused)/) {
+                &logthis("get_dom failed - $rep returned from $uhome in domain: $udom");
+                return (\%returnhash,\@order);
+            }
+            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);
 }
@@ -1064,6 +1460,10 @@ sub inst_rulecheck {
                     $response=&unescape(&reply('instidrulecheck:'.&escape($udom).
                                               ':'.&escape($id).':'.$rulestr,
                                               $homeserver));
+                } elsif ($item eq 'selfcreate') {
+                    $response=&unescape(&reply('instselfcreatecheck:'.
+                                               &escape($udom).':'.&escape($uname).
+                                              ':'.$rulestr,$homeserver));
                 }
                 if ($response ne 'refused') {
                     my @pairs=split(/\&/,$response);
@@ -1090,6 +1490,9 @@ sub inst_userrules {
             if ($check eq 'id') {
                 $response=&reply('instidrules:'.&escape($udom),
                                  $homeserver);
+            } elsif ($check eq 'email') {
+                $response=&reply('instemailrules:'.&escape($udom),
+                                 $homeserver);
             } else {
                 $response=&reply('instuserrules:'.&escape($udom),
                                  $homeserver);
@@ -1115,6 +1518,74 @@ sub inst_userrules {
     return (\%ruleshash,\@ruleorder);
 }
 
+# ------------- Get Authentication, Language and User Tools Defaults for Domain
+
+sub get_domain_defaults {
+    my ($domain) = @_;
+    my $cachetime = 60*60*24;
+    my ($result,$cached)=&is_cached_new('domdefaults',$domain);
+    if (defined($cached)) {
+        if (ref($result) eq 'HASH') {
+            return %{$result};
+        }
+    }
+    my %domdefaults;
+    my %domconfig =
+         &Apache::lonnet::get_dom('configuration',['defaults','quotas',
+                                  'requestcourses','inststatus',
+                                  'coursedefaults','usersessions'],$domain);
+    if (ref($domconfig{'defaults'}) eq 'HASH') {
+        $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; 
+        $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
+        $domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'};
+        $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};
+        $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'};
+    } else {
+        $domdefaults{'lang_def'} = &domain($domain,'lang_def');
+        $domdefaults{'auth_def'} = &domain($domain,'auth_def');
+        $domdefaults{'auth_arg_def'} = &domain($domain,'auth_arg_def');
+    }
+    if (ref($domconfig{'quotas'}) eq 'HASH') {
+        if (ref($domconfig{'quotas'}{'defaultquota'}) eq 'HASH') {
+            $domdefaults{'defaultquota'} = $domconfig{'quotas'}{'defaultquota'};
+        } else {
+            $domdefaults{'defaultquota'} = $domconfig{'quotas'};
+        } 
+        my @usertools = ('aboutme','blog','portfolio');
+        foreach my $item (@usertools) {
+            if (ref($domconfig{'quotas'}{$item}) eq 'HASH') {
+                $domdefaults{$item} = $domconfig{'quotas'}{$item};
+            }
+        }
+    }
+    if (ref($domconfig{'requestcourses'}) eq 'HASH') {
+        foreach my $item ('official','unofficial','community') {
+            $domdefaults{$item} = $domconfig{'requestcourses'}{$item};
+        }
+    }
+    if (ref($domconfig{'inststatus'}) eq 'HASH') {
+        foreach my $item ('inststatustypes','inststatusorder') {
+            $domdefaults{$item} = $domconfig{'inststatus'}{$item};
+        }
+    }
+    if (ref($domconfig{'coursedefaults'}) eq 'HASH') {
+        foreach my $item ('canuse_pdfforms') {
+            $domdefaults{$item} = $domconfig{'coursedefaults'}{$item};
+        }
+    }
+    if (ref($domconfig{'usersessions'}) eq 'HASH') {
+        if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') {
+            $domdefaults{'remotesessions'} = $domconfig{'usersessions'}{'remote'};
+        }
+        if (ref($domconfig{'usersessions'}{'hosted'}) eq 'HASH') {
+            $domdefaults{'hostedsessions'} = $domconfig{'usersessions'}{'hosted'};
+        }
+    }
+    &Apache::lonnet::do_cache_new('domdefaults',$domain,\%domdefaults,
+                                  $cachetime);
+    return %domdefaults;
+}
+
 # --------------------------------------------------- Assign a key to a student
 
 sub assign_access_key {
@@ -1147,7 +1618,7 @@ sub assign_access_key {
 # key now belongs to user
 	    my $envkey='key.'.$cdom.'_'.$cnum;
             if (&put('environment',{$envkey => $ckey}) eq 'ok') {
-                &appenv('environment.'.$envkey => $ckey);
+                &appenv({'environment.'.$envkey => $ckey});
                 return 'ok';
             } else {
                 return 
@@ -1295,7 +1766,8 @@ sub getsection {
     # If there is a role which has expired, return it.
     #
     $courseid = &courseid_to_courseurl($courseid);
-    my %roleshash = &dump('roles',$udom,$unam,$courseid);
+    my $extra = &freeze_escape({'skipcheck' => 1});
+    my %roleshash = &dump('roles',$udom,$unam,$courseid,undef,$extra);
     foreach my $key (keys(%roleshash)) {
         next if ($key !~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/);
         my $section=$1;
@@ -1434,13 +1906,23 @@ sub purge_remembered {
 
 sub userenvironment {
     my ($udom,$unam,@what)=@_;
+    my $items;
+    foreach my $item (@what) {
+        $items.=&escape($item).'&';
+    }
+    $items=~s/\&$//;
     my %returnhash=();
-    my @answer=split(/\&/,
-                &reply('get:'.$udom.':'.$unam.':environment:'.join('&',@what),
-                      &homeserver($unam,$udom)));
-    my $i;
-    for ($i=0;$i<=$#what;$i++) {
-	$returnhash{$what[$i]}=&unescape($answer[$i]);
+    my $uhome = &homeserver($unam,$udom);
+    unless ($uhome eq 'no_host') {
+        my @answer=split(/\&/, 
+            &reply('get:'.$udom.':'.$unam.':environment:'.$items,$uhome));
+        if ($#answer==0 && $answer[0] =~ /^(con_lost|error:|no_such_host)/i) {
+            return %returnhash;
+        }
+        my $i;
+        for ($i=0;$i<=$#what;$i++) {
+	    $returnhash{$what[$i]}=&unescape($answer[$i]);
+        }
     }
     return %returnhash;
 }
@@ -1631,12 +2113,23 @@ sub ssi_body {
     if (! exists($form{'LONCAPA_INTERNAL_no_discussion'})) {
         $form{'LONCAPA_INTERNAL_no_discussion'}='true';
     }
-    my $output=($filelink=~/^http\:/?&externalssi($filelink):
-                                     &ssi($filelink,%form));
+    my $output='';
+    my $response;
+    if ($filelink=~/^https?\:/) {
+       ($output,$response)=&externalssi($filelink);
+    } else {
+       $filelink .= $filelink=~/\?/ ? '&' : '?';
+       $filelink .= 'inhibitmenu=yes';
+       ($output,$response)=&ssi($filelink,%form);
+    }
     $output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+?// END LON-CAPA Internal\s*(-->)?\s||gs;
     $output=~s/^.*?\<body[^\>]*\>//si;
     $output=~s/\<\/body\s*\>.*?$//si;
-    return $output;
+    if (wantarray) {
+        return ($output, $response);
+    } else {
+        return $output;
+    }
 }
 
 # --------------------------------------------------------- Server Side Include
@@ -1656,25 +2149,21 @@ sub absolute_url {
 #  fn     Possibly encrypted resource name/id.
 #  form   Hash that describes how the rendering should be done
 #         and other things.
-#  r      Optional reference that will be given the response.
-#         This is mostly provided so that the caller can implement
-#         error detection, recovery and retry policies.
-#     
 # Returns:
-#    The content of the response.
+#   Scalar context: The content of the response.
+#   Array context:  2 element list of the content and the full response object.
+#     
 sub ssi {
 
-    my ($fn,%form, $r)=@_;
-
+    my ($fn,%form)=@_;
     my $ua=new LWP::UserAgent;
-    
     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));
+      $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys(%form)));
     } else {
       $request=new HTTP::Request('GET',&absolute_url().$fn);
     }
@@ -1682,11 +2171,11 @@ sub ssi {
     $request->header(Cookie => $ENV{'HTTP_COOKIE'});
     my $response=$ua->request($request);
 
-    if ($r) {
-	$$r = $response;
+    if (wantarray) {
+	return ($response->content, $response);
+    } else {
+	return $response->content;
     }
-
-    return $response->content;
 }
 
 sub externalssi {
@@ -1694,7 +2183,11 @@ sub externalssi {
     my $ua=new LWP::UserAgent;
     my $request=new HTTP::Request('GET',$url);
     my $response=$ua->request($request);
-    return $response->content;
+    if (wantarray) {
+        return ($response->content, $response);
+    } else {
+        return $response->content;
+    }
 }
 
 # -------------------------------- Allow a /uploaded/ URI to be vouched for
@@ -1707,7 +2200,7 @@ sub allowuploaded {
     my %httpref=();
     my $httpurl=&hreflocation('',$url);
     $httpref{'httpref.'.$httpurl}=$srcurl;
-    &Apache::lonnet::appenv(%httpref);
+    &Apache::lonnet::appenv(\%httpref);
 }
 
 # --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course
@@ -1715,6 +2208,8 @@ sub allowuploaded {
 #        path to file, source of file, instruction to parse file for objects,
 #        ref to hash for embedded objects,
 #        ref to hash for codebase of java objects.
+#        reference to scalar to accommodate mime type determined
+#          from File::MMagic if $parser = parse.
 #
 # output: url to file (if action was uploaddoc), 
 #         ok if successful, or diagnostic message otherwise (if action was propagate or copy)
@@ -1741,7 +2236,8 @@ sub allowuploaded {
 #
 
 sub process_coursefile {
-    my ($action,$docuname,$docudom,$file,$source,$parser,$allfiles,$codebase)=@_;
+    my ($action,$docuname,$docudom,$file,$source,$parser,$allfiles,$codebase,
+        $mimetype)=@_;
     my $fetchresult;
     my $home=&homeserver($docuname,$docudom);
     if ($action eq 'propagate') {
@@ -1768,10 +2264,17 @@ sub process_coursefile {
             print $fh $env{'form.'.$source};
             close($fh);
             if ($parser eq 'parse') {
-                my $parse_result = &extract_embedded_items($filepath,$fname,$allfiles,$codebase);
-                unless ($parse_result eq 'ok') {
-                    &logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result);
+                my $mm = new File::MMagic;
+                my $type = $mm->checktype_filename($filepath.'/'.$fname);
+                if ($type eq 'text/html') {
+                    my $parse_result = &extract_embedded_items($filepath.'/'.$fname,$allfiles,$codebase);
+                    unless ($parse_result eq 'ok') {
+                        &logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result);
+                    }
                 }
+                if (ref($mimetype)) {
+                    $$mimetype = $type;
+                } 
             }
             $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
                                  $home);
@@ -1847,12 +2350,53 @@ sub clean_filename {
     $fname=~s/\.(\d+)(?=\.)/_$1/g;
     return $fname;
 }
+# This Function checks if an Image's dimensions exceed either $resizewidth (width) 
+# or $resizeheight (height) - both pixels. If so, the image is scaled to produce an 
+# image with the same aspect ratio as the original, but with dimensions which do 
+# not exceed $resizewidth and $resizeheight.
+ 
+sub resizeImage {
+    my ($img_path,$resizewidth,$resizeheight) = @_;
+    my $ima = Image::Magick->new;
+    my $resized;
+    if (-e $img_path) {
+        $ima->Read($img_path);
+        if (($resizewidth =~ /^\d+$/) && ($resizeheight > 0)) {
+            my $width = $ima->Get('width');
+            my $height = $ima->Get('height');
+            if ($width > $resizewidth) {
+	        my $factor = $width/$resizewidth;
+                my $newheight = $height/$factor;
+                $ima->Scale(width=>$resizewidth,height=>$newheight);
+                $resized = 1;
+            }
+        }
+        if (($resizeheight =~ /^\d+$/) && ($resizeheight > 0)) {
+            my $width = $ima->Get('width');
+            my $height = $ima->Get('height');
+            if ($height > $resizeheight) {
+                my $factor = $height/$resizeheight;
+                my $newwidth = $width/$factor;
+                $ima->Scale(width=>$newwidth,height=>$resizeheight);
+                $resized = 1;
+            }
+        }
+        if ($resized) {
+            $ima->Write($img_path);
+        }
+    }
+    return;
+}
 
 # --------------- Take an uploaded file and put it into the userfiles directory
 # input: $formname - the contents of the file are in $env{"form.$formname"}
-#                    the desired filenam is in $env{"form.$formname.filename"}
-#        $coursedoc - if true up to the current course
-#                     if false
+#                    the desired filename is in $env{"form.$formname.filename"}
+#        $context - possible values: coursedoc, existingfile, overwrite, 
+#                                    canceloverwrite, or ''. 
+#                   if 'coursedoc': upload to the current course
+#                   if 'existingfile': write file to tmp/overwrites directory 
+#                   if 'canceloverwrite': delete file written to tmp/overwrites directory
+#                   $context is passed as argument to &finishuserfileupload
 #        $subdir - directory in userfile to store the file into
 #        $parser - instruction to parse file for objects ($parser = parse)    
 #        $allfiles - reference to hash for embedded objects
@@ -1861,38 +2405,62 @@ sub clean_filename {
 #        $dsetudom - domain for permanaent storage of uploaded file
 #        $thumbwidth - width (pixels) of thumbnail to make for uploaded image 
 #        $thumbheight - height (pixels) of thumbnail to make for uploaded image
+#        $resizewidth - width (pixels) to which to resize uploaded image
+#        $resizeheight - height (pixels) to which to resize uploaded image
+#        $mimetype - reference to scalar to accommodate mime type determined
+#                    from File::MMagic if $parser = parse.
 # 
 # output: url of file in userspace, or error: <message> 
 #             or /adm/notfound.html if failure to upload occurse
 
-
 sub userfileupload {
-    my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase,$destuname,
-        $destudom,$thumbwidth,$thumbheight)=@_;
+    my ($formname,$context,$subdir,$parser,$allfiles,$codebase,$destuname,
+        $destudom,$thumbwidth,$thumbheight,$resizewidth,$resizeheight,$mimetype)=@_;
     if (!defined($subdir)) { $subdir='unknown'; }
     my $fname=$env{'form.'.$formname.'.filename'};
     $fname=&clean_filename($fname);
-# See if there is anything left
+    # See if there is anything left
     unless ($fname) { return 'error: no uploaded file'; }
-    chop($env{'form.'.$formname});
-    if (($formname eq 'screenshot') && ($subdir eq 'helprequests')) { #files uploaded to help request form are handled differently
+    # Files uploaded to help request form, or uploaded to "create course" page are handled differently
+    if ((($formname eq 'screenshot') && ($subdir eq 'helprequests')) ||
+        (($formname eq 'coursecreatorxml') && ($subdir eq 'batchupload')) ||
+         ($context eq 'existingfile') || ($context eq 'canceloverwrite')) {
         my $now = time;
-        my $filepath = 'tmp/helprequests/'.$now;
-        my @parts=split(/\//,$filepath);
-        my $fullpath = $perlvar{'lonDaemons'};
-        for (my $i=0;$i<@parts;$i++) {
-            $fullpath .= '/'.$parts[$i];
-            if ((-e $fullpath)!=1) {
-                mkdir($fullpath,0777);
+        my $filepath;
+        if (($formname eq 'screenshot') && ($subdir eq 'helprequests')) {
+             $filepath = 'tmp/helprequests/'.$now;
+        } elsif (($formname eq 'coursecreatorxml') && ($subdir eq 'batchupload')) {
+             $filepath = 'tmp/addcourse/'.$destudom.'/web/'.$env{'user.name'}.
+                         '_'.$env{'user.domain'}.'/pending';
+        } elsif (($context eq 'existingfile') || ($context eq 'canceloverwrite')) {
+            my ($docuname,$docudom);
+            if ($destudom) {
+                $docudom = $destudom;
+            } else {
+                $docudom = $env{'user.domain'};
+            }
+            if ($destuname) {
+                $docuname = $destuname;
+            } else {
+                $docuname = $env{'user.name'};
+            }
+            if (exists($env{'form.group'})) {
+                $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
+                $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+            }
+            $filepath = 'tmp/overwrites/'.$docudom.'/'.$docuname.'/'.$subdir;
+            if ($context eq 'canceloverwrite') {
+                my $tempfile =  $perlvar{'lonDaemons'}.'/'.$filepath.'/'.$fname;
+                if (-e  $tempfile) {
+                    my @info = stat($tempfile);
+                    if ($info[9] eq $env{'form.timestamp'}) {
+                        unlink($tempfile);
+                    }
+                }
+                return;
             }
         }
-        open(my $fh,'>'.$fullpath.'/'.$fname);
-        print $fh $env{'form.'.$formname};
-        close($fh);
-        return $fullpath.'/'.$fname;
-    } elsif (($formname eq 'coursecreatorxml') && ($subdir eq 'batchupload')) { #files uploaded to create course page are handled differently
-        my $filepath = 'tmp/addcourse/'.$destudom.'/web/'.$env{'user.name'}.
-                       '_'.$env{'user.domain'}.'/pending';
+        # Create the directory if not present
         my @parts=split(/\//,$filepath);
         my $fullpath = $perlvar{'lonDaemons'};
         for (my $i=0;$i<@parts;$i++) {
@@ -1904,31 +2472,39 @@ sub userfileupload {
         open(my $fh,'>'.$fullpath.'/'.$fname);
         print $fh $env{'form.'.$formname};
         close($fh);
-        return $fullpath.'/'.$fname;
+        if ($context eq 'existingfile') {
+            my @info = stat($fullpath.'/'.$fname);
+            return ($fullpath.'/'.$fname,$info[9]);
+        } else {
+            return $fullpath.'/'.$fname;
+        }
     }
-    
-# Create the directory if not present
-    $fname="$subdir/$fname";
-    if ($coursedoc) {
+    if ($subdir eq 'scantron') {
+        $fname = 'scantron_orig_'.$fname;
+    } else {
+        $fname="$subdir/$fname";
+    }
+    if ($context eq 'coursedoc') {
 	my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
 	my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
         if ($env{'form.folder'} =~ m/^(default|supplemental)/) {
             return &finishuserfileupload($docuname,$docudom,
 					 $formname,$fname,$parser,$allfiles,
-					 $codebase,$thumbwidth,$thumbheight);
+					 $codebase,$thumbwidth,$thumbheight,
+                                         $resizewidth,$resizeheight,$context,$mimetype);
         } else {
             $fname=$env{'form.folder'}.'/'.$fname;
             return &process_coursefile('uploaddoc',$docuname,$docudom,
 				       $fname,$formname,$parser,
-				       $allfiles,$codebase);
+				       $allfiles,$codebase,$mimetype);
         }
     } elsif (defined($destuname)) {
         my $docuname=$destuname;
         my $docudom=$destudom;
 	return &finishuserfileupload($docuname,$docudom,$formname,$fname,
 				     $parser,$allfiles,$codebase,
-                                     $thumbwidth,$thumbheight);
-        
+                                     $thumbwidth,$thumbheight,
+                                     $resizewidth,$resizeheight,$context,$mimetype);
     } else {
         my $docuname=$env{'user.name'};
         my $docudom=$env{'user.domain'};
@@ -1938,15 +2514,17 @@ sub userfileupload {
         }
 	return &finishuserfileupload($docuname,$docudom,$formname,$fname,
 				     $parser,$allfiles,$codebase,
-                                     $thumbwidth,$thumbheight);
+                                     $thumbwidth,$thumbheight,
+                                     $resizewidth,$resizeheight,$context,$mimetype);
     }
 }
 
 sub finishuserfileupload {
     my ($docuname,$docudom,$formname,$fname,$parser,$allfiles,$codebase,
-        $thumbwidth,$thumbheight) = @_;
+        $thumbwidth,$thumbheight,$resizewidth,$resizeheight,$context,$mimetype) = @_;
     my $path=$docudom.'/'.$docuname.'/';
     my $filepath=$perlvar{'lonDocRoot'};
+  
     my ($fnamepath,$file,$fetchthumb);
     $file=$fname;
     if ($fname=~m|/|) {
@@ -1961,6 +2539,7 @@ sub finishuserfileupload {
 	    mkdir($filepath,0777);
         }
     }
+
 # Save the file
     {
 	if (!open(FH,'>'.$filepath.'/'.$file)) {
@@ -1968,19 +2547,49 @@ sub finishuserfileupload {
 	    print STDERR ('Failed to create '.$filepath.'/'.$file."\n");
 	    return '/adm/notfound.html';
 	}
-	if (!print FH ($env{'form.'.$formname})) {
+        if ($context eq 'overwrite') {
+            my $source =  $perlvar{'lonDaemons'}.'/tmp/overwrites/'.$docudom.'/'.$docuname.'/'.$fname;
+            my $target = $filepath.'/'.$file;
+            if (-e $source) {
+                my @info = stat($source);
+                if ($info[9] eq $env{'form.timestamp'}) {   
+                    unless (&File::Copy::move($source,$target)) {
+                        &logthis('Failed to overwrite '.$filepath.'/'.$file);
+                        return "Moving from $source failed";
+                    }
+                } else {
+                    return "Temporary file: $source had unexpected date/time for last modification";
+                }
+            } else {
+                return "Temporary file: $source missing";
+            }
+        } elsif (!print FH ($env{'form.'.$formname})) {
 	    &logthis('Failed to write to '.$filepath.'/'.$file);
 	    print STDERR ('Failed to write to '.$filepath.'/'.$file."\n");
 	    return '/adm/notfound.html';
 	}
 	close(FH);
+        if ($resizewidth && $resizeheight) {
+            my $mm = new File::MMagic;
+            my $mime_type = $mm->checktype_filename($filepath.'/'.$file);
+            if ($mime_type =~ m{^image/}) {
+	        &resizeImage($filepath.'/'.$file,$resizewidth,$resizeheight);
+            }  
+	}
     }
     if ($parser eq 'parse') {
-        my $parse_result = &extract_embedded_items($filepath,$file,$allfiles,
-						   $codebase);
-        unless ($parse_result eq 'ok') {
-            &logthis('Failed to parse '.$filepath.$file.
-		     ' for embedded media: '.$parse_result); 
+        my $mm = new File::MMagic;
+        my $type = $mm->checktype_filename($filepath.'/'.$file);
+        if ($type eq 'text/html') {
+            my $parse_result = &extract_embedded_items($filepath.'/'.$file,
+                                                       $allfiles,$codebase);
+            unless ($parse_result eq 'ok') {
+                &logthis('Failed to parse '.$filepath.$file.
+	   	         ' for embedded media: '.$parse_result); 
+            }
+        }
+        if (ref($mimetype)) {
+            $$mimetype = $type;
         }
     }
     if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {
@@ -1995,7 +2604,7 @@ sub finishuserfileupload {
  
 # Notify homeserver to grep it
 #
-    my $docuhome=&homeserver($docuname,$docudom);
+    my $docuhome=&homeserver($docuname,$docudom);	
     my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);
     if ($fetchresult eq 'ok') {
         if ($fetchthumb) {
@@ -2016,7 +2625,7 @@ sub finishuserfileupload {
 }
 
 sub extract_embedded_items {
-    my ($filepath,$file,$allfiles,$codebase,$content) = @_;
+    my ($fullpath,$allfiles,$codebase,$content) = @_;
     my @state = ();
     my %javafiles = (
                       codebase => '',
@@ -2031,7 +2640,7 @@ sub extract_embedded_items {
     if ($content) {
         $p = HTML::LCParser->new($content);
     } else {
-        $p = HTML::LCParser->new($filepath.'/'.$file);
+        $p = HTML::LCParser->new($fullpath);
     }
     while (my $t=$p->get_token()) {
 	if ($t->[0] eq 'S') {
@@ -2127,21 +2736,21 @@ sub add_filetype {
 }
 
 sub removeuploadedurl {
-    my ($url)=@_;
-    my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);
+    my ($url)=@_;	
+    my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);    
     return &removeuserfile($uname,$udom,$fname);
 }
 
 sub removeuserfile {
     my ($docuname,$docudom,$fname)=@_;
-    my $home=&homeserver($docuname,$docudom);
+    my $home=&homeserver($docuname,$docudom);    
     my $result = &reply("removeuserfile:$docudom/$docuname/$fname",$home);
-    if ($result eq 'ok') {
+    if ($result eq 'ok') {	
         if (($fname !~ /\.meta$/) && (&is_portfolio_file($fname))) {
             my $metafile = $fname.'.meta';
             my $metaresult = &removeuserfile($docuname,$docudom,$metafile); 
 	    my $url = "/uploaded/$docudom/$docuname/$fname";
-            my ($file,$group) = (&parse_portfolio_url($url))[3,4];
+            my ($file,$group) = (&parse_portfolio_url($url))[3,4];	   
             my $sqlresult = 
                 &update_portfolio_table($docuname,$docudom,$file,
                                         'portfolio_metadata',$group,
@@ -2284,7 +2893,7 @@ sub flushcourselogs {
 # Reverse lookup of domain roles (dc, ad, li, sc, au)
 #
     my %domrolebuffer = ();
-    foreach my $entry (keys %domainrolehash) {
+    foreach my $entry (keys(%domainrolehash)) {
         my ($role,$uname,$udom,$runame,$rudom,$rsec)=split(/:/,$entry);
         if ($domrolebuffer{$rudom}) {
             $domrolebuffer{$rudom}.='&'.&escape($entry).
@@ -2344,7 +2953,12 @@ sub courseacclog {
         # FIXME: Probably ought to escape things....
 	foreach my $key (keys(%env)) {
             if ($key=~/^form\.(.*)/) {
-		$what.=':'.$1.'='.$env{$key};
+                my $formitem = $1;
+                if ($formitem =~ /^HWFILE(?:SIZE|TOOBIG)/) {
+                    $what.=':'.$formitem.'='.$env{$key};
+                } elsif ($formitem !~ /^HWFILE(?:[^.]+)$/) {
+                    $what.=':'.$formitem.'='.$env{$key};
+                }
             }
         }
     } elsif ($fnsymb =~ m:^/adm/searchcat:) {
@@ -2384,7 +2998,7 @@ sub userrolelog {
     if (($trole=~/^ca/) || ($trole=~/^aa/) ||
         ($trole=~/^in/) || ($trole=~/^cc/) ||
         ($trole=~/^ep/) || ($trole=~/^cr/) ||
-        ($trole=~/^ta/)) {
+        ($trole=~/^ta/) || ($trole=~/^co/)) {
        my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
        $userrolehash
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
@@ -2393,7 +3007,8 @@ sub userrolelog {
     if (($env{'request.role'} =~ /dc\./) &&
 	(($trole=~/^au/) || ($trole=~/^in/) ||
 	 ($trole=~/^cc/) || ($trole=~/^ep/) ||
-	 ($trole=~/^cr/) || ($trole=~/^ta/))) {
+	 ($trole=~/^cr/) || ($trole=~/^ta/) ||
+         ($trole=~/^co/))) {
        $userrolehash
          {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}
                     =$tend.':'.$tstart;
@@ -2409,10 +3024,45 @@ sub userrolelog {
     }
 }
 
+sub courserolelog {
+    my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$selfenroll,$context)=@_;
+    if (($trole eq 'cc') || ($trole eq 'in') ||
+        ($trole eq 'ep') || ($trole eq 'ad') ||
+        ($trole eq 'ta') || ($trole eq 'st') ||
+        ($trole=~/^cr/) || ($trole eq 'gr') ||
+        ($trole eq 'co')) {
+        if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) {
+            my $cdom = $1;
+            my $cnum = $2;
+            my $sec = $3;
+            my $namespace = 'rolelog';
+            my %storehash = (
+                               role    => $trole,
+                               start   => $tstart,
+                               end     => $tend,
+                               selfenroll => $selfenroll,
+                               context    => $context,
+                            );
+            if ($trole eq 'gr') {
+                $namespace = 'groupslog';
+                $storehash{'group'} = $sec;
+            } else {
+                $storehash{'section'} = $sec;
+            }
+            &instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom);
+            if (($trole ne 'st') || ($sec ne '')) {
+                &devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum);
+            }
+        }
+    }
+    return;
+}
+
 sub get_course_adv_roles {
-    my $cid=shift;
+    my ($cid,$codes) = @_;
     $cid=$env{'request.course.id'} unless (defined($cid));
     my %coursehash=&coursedescription($cid);
+    my $crstype = &Apache::loncommon::course_type($cid);
     my %nothide=();
     foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
         if ($user !~ /:/) {
@@ -2425,24 +3075,47 @@ sub get_course_adv_roles {
     my %dumphash=
             &dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'});
     my $now=time;
-    foreach my $entry (keys %dumphash) {
+    my %privileged;
+    foreach my $entry (keys(%dumphash)) {
 	my ($tend,$tstart)=split(/\:/,$dumphash{$entry});
         if (($tstart) && ($tstart<0)) { next; }
         if (($tend) && ($tend<$now)) { next; }
         if (($tstart) && ($now<$tstart)) { next; }
         my ($role,$username,$domain,$section)=split(/\:/,$entry);
 	if ($username eq '' || $domain eq '') { next; }
-	if ((&privileged($username,$domain)) && 
-	    (!$nothide{$username.':'.$domain})) { next; }
+        unless (ref($privileged{$domain}) eq 'HASH') {
+            my %dompersonnel =
+                &Apache::lonnet::get_domain_roles($domain,['dc'],$now,$now);
+            $privileged{$domain} = {};
+            foreach my $server (keys(%dompersonnel)) {
+                if (ref($dompersonnel{$server}) eq 'HASH') {
+                    foreach my $user (keys(%{$dompersonnel{$server}})) {
+                        my ($trole,$uname,$udom) = split(/:/,$user);
+                        $privileged{$udom}{$uname} = 1;
+                    }
+                }
+            }
+        }
+        if ((exists($privileged{$domain}{$username})) && 
+            (!$nothide{$username.':'.$domain})) { next; }
 	if ($role eq 'cr') { next; }
-        my $key=&plaintext($role);
-        if ($section) { $key.=' (Sec/Grp '.$section.')'; }
-        if ($returnhash{$key}) {
-	    $returnhash{$key}.=','.$username.':'.$domain;
+        if ($codes) {
+            if ($section) { $role .= ':'.$section; }
+            if ($returnhash{$role}) {
+                $returnhash{$role}.=','.$username.':'.$domain;
+            } else {
+                $returnhash{$role}=$username.':'.$domain;
+            }
         } else {
-            $returnhash{$key}=$username.':'.$domain;
+            my $key=&plaintext($role,$crstype);
+            if ($section) { $key.=' ('.&Apache::lonlocal::mt('Section [_1]',$section).')'; }
+            if ($returnhash{$key}) {
+	        $returnhash{$key}.=','.$username.':'.$domain;
+            } else {
+                $returnhash{$key}=$username.':'.$domain;
+            }
         }
-     }
+    }
     return %returnhash;
 }
 
@@ -2451,8 +3124,9 @@ sub get_my_roles {
     unless (defined($uname)) { $uname=$env{'user.name'}; }
     unless (defined($udom)) { $udom=$env{'user.domain'}; }
     my (%dumphash,%nothide);
-    if ($context eq 'userroles') { 
-        %dumphash = &dump('roles',$udom,$uname);
+    if ($context eq 'userroles') {
+        my $extra = &freeze_escape({'skipcheck' => 1});
+        %dumphash = &dump('roles',$udom,$uname,'.',undef,$extra);
     } else {
         %dumphash=
             &dump('nohist_userroles',$udom,$uname);
@@ -2469,6 +3143,7 @@ sub get_my_roles {
     }
     my %returnhash=();
     my $now=time;
+    my %privileged;
     foreach my $entry (keys(%dumphash)) {
         my ($role,$tend,$tstart);
         if ($context eq 'userroles') {
@@ -2511,15 +3186,42 @@ sub get_my_roles {
                     if (!grep(/^cr$/,@{$roles})) {
                         next;
                     }
+                } elsif ($role =~ /^gr\//) {
+                    if (!grep(/^gr$/,@{$roles})) {
+                        next;
+                    }
                 } else {
                     next;
                 }
             }
         }
         if ($hidepriv) {
-            if ((&privileged($username,$domain)) &&
-                (!$nothide{$username.':'.$domain})) { 
-                next;
+            if ($context eq 'userroles') {
+                if ((&privileged($username,$domain)) &&
+                    (!$nothide{$username.':'.$domain})) {
+                    next;
+                }
+            } else {
+                unless (ref($privileged{$domain}) eq 'HASH') {
+                    my %dompersonnel =
+                        &Apache::lonnet::get_domain_roles($domain,['dc'],$now,$now);
+                    $privileged{$domain} = {};
+                    if (keys(%dompersonnel)) {
+                        foreach my $server (keys(%dompersonnel)) {
+                            if (ref($dompersonnel{$server}) eq 'HASH') {
+                                foreach my $user (keys(%{$dompersonnel{$server}})) {
+                                    my ($trole,$uname,$udom) = split(/:/,$user);
+                                    $privileged{$udom}{$uname} = $trole;
+                                }
+                            }
+                        }
+                    }
+                }
+                if (exists($privileged{$domain}{$username})) {
+                    if (!$nothide{$username.':'.$domain}) {
+                        next;
+                    }
+                }
             }
         }
         if ($withsec) {
@@ -2567,6 +3269,7 @@ sub getannounce {
 
 sub courseidput {
     my ($domain,$storehash,$coursehome,$caller) = @_;
+    return unless (ref($storehash) eq 'HASH');
     my $outcome;
     if ($caller eq 'timeonly') {
         my $cids = '';
@@ -2604,7 +3307,9 @@ sub courseidput {
 
 sub courseiddump {
     my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,
-        $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;
+        $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok,
+        $selfenrollonly,$catfilter,$showhidden,$caller,$cloner,$cc_clone,
+        $cloneonly,$createdbefore,$createdafter,$creationcontext,$domcloner)=@_;
     my $as_hash = 1;
     my %returnhash;
     if (!$domfilter) { $domfilter=''; }
@@ -2621,7 +3326,13 @@ sub courseiddump {
                          $sincefilter.':'.&escape($descfilter).':'.
                          &escape($instcodefilter).':'.&escape($ownerfilter).
                          ':'.&escape($coursefilter).':'.&escape($typefilter).
-                         ':'.&escape($regexp_ok).':'.$as_hash,$tryserver);
+                         ':'.&escape($regexp_ok).':'.$as_hash.':'.
+                         &escape($selfenrollonly).':'.&escape($catfilter).':'.
+                         $showhidden.':'.$caller.':'.&escape($cloner).':'.
+                         &escape($cc_clone).':'.$cloneonly.':'.
+                         &escape($createdbefore).':'.&escape($createdafter).':'.
+                         &escape($creationcontext).':'.$domcloner,
+                         $tryserver);
                 my @pairs=split(/\&/,$rep);
                 foreach my $item (@pairs) {
                     my ($key,$value)=split(/\=/,$item,2);
@@ -2636,7 +3347,7 @@ sub courseiddump {
                         for (my $i=0; $i<@responses; $i++) {
                             $returnhash{$key}{$items[$i]} = &unescape($responses[$i]);
                         }
-                    } 
+                    }
                 }
             }
         }
@@ -2644,6 +3355,49 @@ sub courseiddump {
     return %returnhash;
 }
 
+sub courselastaccess {
+    my ($cdom,$cnum,$hostidref) = @_;
+    my %returnhash;
+    if ($cdom && $cnum) {
+        my $chome = &homeserver($cnum,$cdom);
+        if ($chome ne 'no_host') {
+            my $rep = &reply('courselastaccess:'.$cdom.':'.$cnum,$chome);
+            &extract_lastaccess(\%returnhash,$rep);
+        }
+    } else {
+        if (!$cdom) { $cdom=''; }
+        my %libserv = &all_library();
+        foreach my $tryserver (keys(%libserv)) {
+            if (ref($hostidref) eq 'ARRAY') {
+                next unless (grep(/^\Q$tryserver\E$/,@{$hostidref}));
+            } 
+            if (($cdom eq '') || (&host_domain($tryserver) eq $cdom)) {
+                my $rep = &reply('courselastaccess:'.&host_domain($tryserver).':',$tryserver);
+                &extract_lastaccess(\%returnhash,$rep);
+            }
+        }
+    }
+    return %returnhash;
+}
+
+sub extract_lastaccess {
+    my ($returnhash,$rep) = @_;
+    if (ref($returnhash) eq 'HASH') {
+        unless ($rep eq 'unknown_command' || $rep eq 'no_such_host' || 
+                $rep eq 'con_lost' || $rep eq 'rejected' || $rep eq 'refused' ||
+                 $rep eq '') {
+            my @pairs=split(/\&/,$rep);
+            foreach my $item (@pairs) {
+                my ($key,$value)=split(/\=/,$item,2);
+                $key = &unescape($key);
+                next if ($key =~ /^error: 2 /);
+                $returnhash->{$key} = &thaw_unescape($value);
+            }
+        }
+    }
+    return;
+}
+
 # ---------------------------------------------------------- DC e-mail
 
 sub dcmailput {
@@ -2676,10 +3430,10 @@ sub dcmaildump {
 
 sub get_domain_roles {
     my ($dom,$roles,$startdate,$enddate)=@_;
-    if (undef($startdate) || $startdate eq '') {
+    if ((!defined($startdate)) || ($startdate eq '')) {
         $startdate = '.';
     }
-    if (undef($enddate) || $enddate eq '') {
+    if ((!defined($enddate)) || ($enddate eq '')) {
         $enddate = '.';
     }
     my $rolelist;
@@ -2704,7 +3458,7 @@ sub get_domain_roles {
     return %personnel;
 }
 
-# ----------------------------------------------------------- Check out an item
+# ----------------------------------------------------------- Interval timing 
 
 sub get_first_access {
     my ($type,$argsymb)=@_;
@@ -2740,91 +3494,6 @@ sub set_first_access {
     return 'already_set';
 }
 
-sub checkout {
-    my ($symb,$tuname,$tudom,$tcrsid)=@_;
-    my $now=time;
-    my $lonhost=$perlvar{'lonHostID'};
-    my $infostr=&escape(
-                 'CHECKOUTTOKEN&'.
-                 $tuname.'&'.
-                 $tudom.'&'.
-                 $tcrsid.'&'.
-                 $symb.'&'.
-		 $now.'&'.$ENV{'REMOTE_ADDR'});
-    my $token=&reply('tmpput:'.$infostr,$lonhost);
-    if ($token=~/^error\:/) { 
-        &logthis("<font color=\"blue\">WARNING: ".
-                "Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb.
-                 "</font>");
-        return ''; 
-    }
-
-    $token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/;
-    $token=~tr/a-z/A-Z/;
-
-    my %infohash=('resource.0.outtoken' => $token,
-                  'resource.0.checkouttime' => $now,
-                  'resource.0.outremote' => $ENV{'REMOTE_ADDR'});
-
-    unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
-       return '';
-    } else {
-        &logthis("<font color=\"blue\">WARNING: ".
-                "Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb.
-                 "</font>");
-    }    
-
-    if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
-                         &escape('Checkout '.$infostr.' - '.
-                                                 $token)) ne 'ok') {
-	return '';
-    } else {
-        &logthis("<font color=\"blue\">WARNING: ".
-                "Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb.
-                 "</font>");
-    }
-    return $token;
-}
-
-# ------------------------------------------------------------ Check in an item
-
-sub checkin {
-    my $token=shift;
-    my $now=time;
-    my ($ta,$tb,$lonhost)=split(/\*/,$token);
-    $lonhost=~tr/A-Z/a-z/;
-    my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb;
-    $dtoken=~s/\W/\_/g;
-    my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
-                 split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));
-
-    unless (($tuname) && ($tudom)) {
-        &logthis('Check in '.$token.' ('.$dtoken.') failed');
-        return '';
-    }
-    
-    unless (&allowed('mgr',$tcrsid)) {
-        &logthis('Check in '.$token.' ('.$dtoken.') unauthorized: '.
-                 $env{'user.name'}.' - '.$env{'user.domain'});
-        return '';
-    }
-
-    my %infohash=('resource.0.intoken' => $token,
-                  'resource.0.checkintime' => $now,
-                  'resource.0.inremote' => $ENV{'REMOTE_ADDR'});
-
-    unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
-       return '';
-    }    
-
-    if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
-                         &escape('Checkin - '.$token)) ne 'ok') {
-	return '';
-    }
-
-    return ($symb,$tuname,$tudom,$tcrsid);    
-}
-
 # --------------------------------------------- Set Expire Date for Spreadsheet
 
 sub expirespread {
@@ -3086,7 +3755,7 @@ sub tmpreset {
   if (tie(%hash,'GDBM_File',
 	  $path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
 	  &GDBM_WRCREAT(),0640)) {
-    foreach my $key (keys %hash) {
+    foreach my $key (keys(%hash)) {
       if ($key=~ /:$symb/) {
 	delete($hash{$key});
       }
@@ -3358,18 +4027,59 @@ sub coursedescription {
        }
     }
     if (!$args->{'one_time'}) {
-	&appenv(%envhash);
+	&appenv(\%envhash);
     }
     return %returnhash;
 }
 
+sub update_released_required {
+    my ($needsrelease,$cdom,$cnum,$chome,$cid) = @_;
+    if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
+        $cid = $env{'request.course.id'};
+        $cdom = $env{'course.'.$cid.'.domain'};
+        $cnum = $env{'course.'.$cid.'.num'};
+        $chome = $env{'course.'.$cid.'.home'};
+    }
+    if ($needsrelease) {
+        my %curr_reqd_hash = &userenvironment($cdom,$cnum,'internal.releaserequired');
+        my $needsupdate;
+        if ($curr_reqd_hash{'internal.releaserequired'} eq '') {
+            $needsupdate = 1;
+        } else {
+            my ($currmajor,$currminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
+            my ($needsmajor,$needsminor) = split(/\./,$needsrelease);
+            if (($currmajor < $needsmajor) || ($currmajor == $needsmajor && $currminor < $needsminor)) {
+                $needsupdate = 1;
+            }
+        }
+        if ($needsupdate) {
+            my %needshash = (
+                             'internal.releaserequired' => $needsrelease,
+                            );
+            my $putresult = &put('environment',\%needshash,$cdom,$cnum);
+            if ($putresult eq 'ok') {
+                &appenv({'course.'.$cid.'.internal.releaserequired' => $needsrelease});
+                my %crsinfo = &courseiddump($cdom,'.',1,'.','.',$cnum,undef,undef,'.');
+                if (ref($crsinfo{$cid}) eq 'HASH') {
+                    $crsinfo{$cid}{'releaserequired'} = $needsrelease;
+                    &courseidput($cdom,\%crsinfo,$chome,'notime');
+                }
+            }
+        }
+    }
+    return;
+}
+
 # -------------------------------------------------See if a user is privileged
 
 sub privileged {
     my ($username,$domain)=@_;
     my $rolesdump=&reply("dump:$domain:$username:roles",
 			&homeserver($username,$domain));
-    if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return 0; }
+    if (($rolesdump eq 'con_lost') || ($rolesdump eq '') || 
+        ($rolesdump =~ /^error:/)) {
+        return 0;
+    }
     my $now=time;
     if ($rolesdump ne '') {
         foreach my $entry (split(/&/,$rolesdump)) {
@@ -3397,13 +4107,16 @@ sub privileged {
 
 sub rolesinit {
     my ($domain,$username,$authhost)=@_;
-    my $rolesdump=reply("dump:$domain:$username:roles",$authhost);
-    if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return ''; }
-    my %allroles=();
-    my %allgroups=();   
     my $now=time;
     my %userroles = ('user.login.time' => $now);
-    my $group_privs;
+    my $extra = &freeze_escape({'skipcheck' => 1});
+    my $rolesdump=reply("dump:$domain:$username:roles:.::$extra",$authhost);
+    if (($rolesdump eq 'con_lost') || ($rolesdump eq '') || 
+        ($rolesdump =~ /^error:/)) {
+        return \%userroles;
+    }
+    my %allroles=();
+    my %allgroups=();   
 
     if ($rolesdump ne '') {
         foreach my $entry (split(/&/,$rolesdump)) {
@@ -3420,6 +4133,7 @@ sub rolesinit {
 		}
             } elsif ($role =~ m|^gr/|) {
                 ($trole,$tend,$tstart) = split(/_/,$role);
+                next if ($tstart eq '-1');
                 ($trole,$group_privs) = split(/\//,$trole);
                 $group_privs = &unescape($group_privs);
 	    } else {
@@ -3468,6 +4182,9 @@ sub custom_roleprivs {
         if (($rdummy ne 'con_lost') && ($roledef ne '')) {
             my ($syspriv,$dompriv,$coursepriv)=split(/\_/,$roledef);
             if (defined($syspriv)) {
+                if ($trest =~ /^$match_community$/) {
+                    $syspriv =~ s/bre\&S//; 
+                }
                 $$allroles{'cm./'}.=':'.$syspriv;
                 $$allroles{$spec.'./'}.=':'.$syspriv;
             }
@@ -3516,23 +4233,36 @@ sub standard_roleprivs {
 }
 
 sub set_userprivs {
-    my ($userroles,$allroles,$allgroups) = @_; 
+    my ($userroles,$allroles,$allgroups,$groups_roles) = @_; 
     my $author=0;
     my $adv=0;
     my %grouproles = ();
     if (keys(%{$allgroups}) > 0) {
-        foreach my $role (keys %{$allroles}) {
-            my ($trole,$area,$sec,$extendedarea);
-            if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) {
-                $trole = $1;
-                $area = $2;
-                $sec = $3;
-                $extendedarea = $area.$sec;
-                if (exists($$allgroups{$area})) {
-                    foreach my $group (keys(%{$$allgroups{$area}})) {
-                        my $spec = $trole.'.'.$extendedarea;
-                        $grouproles{$spec.'.'.$area.'/'.$group} = 
+        my @groupkeys; 
+        foreach my $role (keys(%{$allroles})) {
+            push(@groupkeys,$role);
+        }
+        if (ref($groups_roles) eq 'HASH') {
+            foreach my $key (keys(%{$groups_roles})) {
+                unless (grep(/^\Q$key\E$/,@groupkeys)) {
+                    push(@groupkeys,$key);
+                }
+            }
+        }
+        if (@groupkeys > 0) {
+            foreach my $role (@groupkeys) {
+                my ($trole,$area,$sec,$extendedarea);
+                if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) {
+                    $trole = $1;
+                    $area = $2;
+                    $sec = $3;
+                    $extendedarea = $area.$sec;
+                    if (exists($$allgroups{$area})) {
+                        foreach my $group (keys(%{$$allgroups{$area}})) {
+                            my $spec = $trole.'.'.$extendedarea;
+                            $grouproles{$spec.'.'.$area.'/'.$group} = 
                                                 $$allgroups{$area}{$group};
+                        }
                     }
                 }
             }
@@ -3556,7 +4286,7 @@ sub set_userprivs {
             }
         }
         my $thesestr='';
-        foreach my $priv (keys(%thesepriv)) {
+        foreach my $priv (sort(keys(%thesepriv))) {
 	    $thesestr.=':'.$priv.'&'.$thesepriv{$priv};
 	}
         $userroles->{'user.priv.'.$role} = $thesestr;
@@ -3564,6 +4294,163 @@ sub set_userprivs {
     return ($author,$adv);
 }
 
+sub role_status {
+    my ($rolekey,$update,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
+    my @pwhere = ();
+    if (exists($env{$rolekey}) && $env{$rolekey} ne '') {
+        (undef,undef,$$role,@pwhere)=split(/\./,$rolekey);
+        unless (!defined($$role) || $$role eq '') {
+            $$where=join('.',@pwhere);
+            $$trolecode=$$role.'.'.$$where;
+            ($$tstart,$$tend)=split(/\./,$env{$rolekey});
+            $$tstatus='is';
+            if ($$tstart && $$tstart>$update) {
+                $$tstatus='future';
+                if ($$tstart<$now) {
+                    if ($$tstart && $$tstart>$refresh) {
+                        if (($$where ne '') && ($$role ne '')) {
+                            my (%allroles,%allgroups,$group_privs,
+                                %groups_roles,@rolecodes);
+                            my %userroles = (
+                                'user.role.'.$$role.'.'.$$where => $$tstart.'.'.$$tend
+                            );
+                            @rolecodes = ('cm'); 
+                            my $spec=$$role.'.'.$$where;
+                            my ($tdummy,$tdomain,$trest)=split(/\//,$$where);
+                            if ($$role =~ /^cr\//) {
+                                &custom_roleprivs(\%allroles,$$role,$tdomain,$trest,$spec,$$where);
+                                push(@rolecodes,'cr');
+                            } elsif ($$role eq 'gr') {
+                                push(@rolecodes,$$role);
+                                my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},
+                                                    $env{'user.name'});
+                                my ($trole) = split('_',$rolehash{$$where.'_'.$$role},2);
+                                (undef,my $group_privs) = split(/\//,$trole);
+                                $group_privs = &unescape($group_privs);
+                                &group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart);
+                                my %course_roles = &get_my_roles($env{'user.name'},$env{'user.domain'},'userroles',['active'],['cc','co','in','ta','ep','ad','st','cr'],[$tdomain],1);
+                                &get_groups_roles($tdomain,$trest,
+                                                  \%course_roles,\@rolecodes,
+                                                  \%groups_roles);
+                            } else {
+                                push(@rolecodes,$$role);
+                                &standard_roleprivs(\%allroles,$$role,$tdomain,$spec,$trest,$$where);
+                            }
+                            my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups,\%groups_roles);
+                            &appenv(\%userroles,\@rolecodes);
+                            &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
+                        }
+                    }
+                    $$tstatus = 'is';
+                }
+            }
+            if ($$tend) {
+                if ($$tend<$update) {
+                    $$tstatus='expired';
+                } elsif ($$tend<$now) {
+                    $$tstatus='will_not';
+                }
+            }
+        }
+    }
+}
+
+sub get_groups_roles {
+    my ($cdom,$rest,$cdom_courseroles,$rolecodes,$groups_roles) = @_;
+    return unless((ref($cdom_courseroles) eq 'HASH') && 
+                  (ref($rolecodes) eq 'ARRAY') && 
+                  (ref($groups_roles) eq 'HASH')); 
+    if (keys(%{$cdom_courseroles}) > 0) {
+        my ($cnum) = ($rest =~ /^($match_courseid)/);
+        if ($cdom ne '' && $cnum ne '') {
+            foreach my $key (keys(%{$cdom_courseroles})) {
+                if ($key =~ /^\Q$cnum\E:\Q$cdom\E:([^:]+):?([^:]*)/) {
+                    my $crsrole = $1;
+                    my $crssec = $2;
+                    if ($crsrole =~ /^cr/) {
+                        unless (grep(/^cr$/,@{$rolecodes})) {
+                            push(@{$rolecodes},'cr');
+                        }
+                    } else {
+                        unless(grep(/^\Q$crsrole\E$/,@{$rolecodes})) {
+                            push(@{$rolecodes},$crsrole);
+                        }
+                    }
+                    my $rolekey = "$crsrole./$cdom/$cnum";
+                    if ($crssec ne '') {
+                        $rolekey .= "/$crssec";
+                    }
+                    $rolekey .= './';
+                    $groups_roles->{$rolekey} = $rolecodes;
+                }
+            }
+        }
+    }
+    return;
+}
+
+sub delete_env_groupprivs {
+    my ($where,$courseroles,$possroles) = @_;
+    return unless((ref($courseroles) eq 'HASH') && (ref($possroles) eq 'ARRAY'));
+    my ($dummy,$udom,$uname,$group) = split(/\//,$where);
+    unless (ref($courseroles->{$udom}) eq 'HASH') {
+        %{$courseroles->{$udom}} =
+            &get_my_roles('','','userroles',['active'],
+                          $possroles,[$udom],1);
+    }
+    if (ref($courseroles->{$udom}) eq 'HASH') {
+        foreach my $item (keys(%{$courseroles->{$udom}})) {
+            my ($cnum,$cdom,$crsrole,$crssec) = split(/:/,$item);
+            my $area = '/'.$cdom.'/'.$cnum;
+            my $privkey = "user.priv.$crsrole.$area";
+            if ($crssec ne '') {
+                $privkey .= '/'.$crssec;
+            }
+            $privkey .= ".$area/$group";
+            &Apache::lonnet::delenv($privkey,undef,[$crsrole]);
+        }
+    }
+    return;
+}
+
+sub check_adhoc_privs {
+    my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller) = @_;
+    my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
+    if ($env{$cckey}) {
+        my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
+        &role_status($cckey,$update,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
+        unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
+            &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);
+        }
+    } else {
+        &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);
+    }
+}
+
+sub set_adhoc_privileges {
+# role can be cc or ca
+    my ($dcdom,$pickedcourse,$role,$caller) = @_;
+    my $area = '/'.$dcdom.'/'.$pickedcourse;
+    my $spec = $role.'.'.$area;
+    my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'},
+                                  $env{'user.name'});
+    my %ccrole = ();
+    &standard_roleprivs(\%ccrole,$role,$dcdom,$spec,$pickedcourse,$area);
+    my ($author,$adv)= &set_userprivs(\%userroles,\%ccrole);
+    &appenv(\%userroles,[$role,'cm']);
+    &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
+    unless ($caller eq 'constructaccess' && $env{'request.course.id'}) {
+        &appenv( {'request.role'        => $spec,
+                  'request.role.domain' => $dcdom,
+                  'request.course.sec'  => ''
+                 }
+               );
+        my $tadv=0;
+        if (&allowed('adv') eq 'F') { $tadv=1; }
+        &appenv({'request.role.adv'    => $tadv});
+    }
+}
+
 # --------------------------------------------------------------- get interface
 
 sub get {
@@ -3599,18 +4486,18 @@ sub del {
    foreach my $item (@$storearr) {
        $items.=&escape($item).'&';
    }
+
    $items=~s/\&$//;
    if (!$udomain) { $udomain=$env{'user.domain'}; }
    if (!$uname) { $uname=$env{'user.name'}; }
    my $uhome=&homeserver($uname,$udomain);
-
    return &reply("del:$udomain:$uname:$namespace:$items",$uhome);
 }
 
 # -------------------------------------------------------------- dump interface
 
 sub dump {
-    my ($namespace,$udomain,$uname,$regexp,$range)=@_;
+    my ($namespace,$udomain,$uname,$regexp,$range,$extra)=@_;
     if (!$udomain) { $udomain=$env{'user.domain'}; }
     if (!$uname) { $uname=$env{'user.name'}; }
     my $uhome=&homeserver($uname,$udomain);
@@ -3619,18 +4506,21 @@ sub dump {
     } else {
 	$regexp='.';
     }
-    my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
+    my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range:$extra",$uhome);
     my @pairs=split(/\&/,$rep);
     my %returnhash=();
-    foreach my $item (@pairs) {
-	my ($key,$value)=split(/=/,$item,2);
-	$key = &unescape($key);
-	next if ($key =~ /^error: 2 /);
-	$returnhash{$key}=&thaw_unescape($value);
+    if (!($rep =~ /^error/ )) {
+	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;
 }
 
+
 # --------------------------------------------------------- dumpstore interface
 
 sub dumpstore {
@@ -3907,6 +4797,7 @@ sub tmpget {
     my %returnhash;
     foreach my $item (split(/\&/,$rep)) {
 	my ($key,$value)=split(/=/,$item);
+        next if ($key =~ /^error: 2 /);
 	$returnhash{&unescape($key)}=&thaw_unescape($value);
     }
     return %returnhash;
@@ -4023,7 +4914,7 @@ sub get_portfolio_access {
                 my (%allgroups,%allroles); 
                 my ($start,$end,$role,$sec,$group);
                 foreach my $envkey (%env) {
-                    if ($envkey =~ m-^user\.role\.(gr|cc|in|ta|ep|st)\./($match_domain)/($match_courseid)/?([^/]*)$-) {
+                    if ($envkey =~ m-^user\.role\.(gr|cc|co|in|ta|ep|ad|st)\./($match_domain)/($match_courseid)/?([^/]*)$-) {
                         my $cid = $2.'_'.$3; 
                         if ($1 eq 'gr') {
                             $group = $4;
@@ -4162,6 +5053,238 @@ sub is_portfolio_file {
     return;
 }
 
+sub usertools_access {
+    my ($uname,$udom,$tool,$action,$context,$userenvref,$domdefref,$is_advref)=@_;
+    my ($access,%tools);
+    if ($context eq '') {
+        $context = 'tools';
+    }
+    if ($context eq 'requestcourses') {
+        %tools = (
+                      official   => 1,
+                      unofficial => 1,
+                      community  => 1,
+                 );
+    } else {
+        %tools = (
+                      aboutme   => 1,
+                      blog      => 1,
+                      portfolio => 1,
+                 );
+    }
+    return if (!defined($tools{$tool}));
+
+    if ((!defined($udom)) || (!defined($uname))) {
+        $udom = $env{'user.domain'};
+        $uname = $env{'user.name'};
+    }
+
+    if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
+        if ($action ne 'reload') {
+            if ($context eq 'requestcourses') {
+                return $env{'environment.canrequest.'.$tool};
+            } else {
+                return $env{'environment.availabletools.'.$tool};
+            }
+        }
+    }
+
+    my ($toolstatus,$inststatus);
+
+    if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'}) &&
+         ($action ne 'reload')) {
+        $toolstatus = $env{'environment.'.$context.'.'.$tool};
+        $inststatus = $env{'environment.inststatus'};
+    } else {
+        if (ref($userenvref) eq 'HASH') {
+            $toolstatus = $userenvref->{$context.'.'.$tool};
+            $inststatus = $userenvref->{'inststatus'};
+        } else {
+            my %userenv = &userenvironment($udom,$uname,$context.'.'.$tool,'inststatus');
+            $toolstatus = $userenv{$context.'.'.$tool};
+            $inststatus = $userenv{'inststatus'};
+        }
+    }
+
+    if ($toolstatus ne '') {
+        if ($toolstatus) {
+            $access = 1;
+        } else {
+            $access = 0;
+        }
+        return $access;
+    }
+
+    my ($is_adv,%domdef);
+    if (ref($is_advref) eq 'HASH') {
+        $is_adv = $is_advref->{'is_adv'};
+    } else {
+        $is_adv = &is_advanced_user($udom,$uname);
+    }
+    if (ref($domdefref) eq 'HASH') {
+        %domdef = %{$domdefref};
+    } else {
+        %domdef = &get_domain_defaults($udom);
+    }
+    if (ref($domdef{$tool}) eq 'HASH') {
+        if ($is_adv) {
+            if ($domdef{$tool}{'_LC_adv'} ne '') {
+                if ($domdef{$tool}{'_LC_adv'}) { 
+                    $access = 1;
+                } else {
+                    $access = 0;
+                }
+                return $access;
+            }
+        }
+        if ($inststatus ne '') {
+            my ($hasaccess,$hasnoaccess);
+            foreach my $affiliation (split(/:/,$inststatus)) {
+                if ($domdef{$tool}{$affiliation} ne '') { 
+                    if ($domdef{$tool}{$affiliation}) {
+                        $hasaccess = 1;
+                    } else {
+                        $hasnoaccess = 1;
+                    }
+                }
+            }
+            if ($hasaccess || $hasnoaccess) {
+                if ($hasaccess) {
+                    $access = 1;
+                } elsif ($hasnoaccess) {
+                    $access = 0; 
+                }
+                return $access;
+            }
+        } else {
+            if ($domdef{$tool}{'default'} ne '') {
+                if ($domdef{$tool}{'default'}) {
+                    $access = 1;
+                } elsif ($domdef{$tool}{'default'} == 0) {
+                    $access = 0;
+                }
+                return $access;
+            }
+        }
+    } else {
+        if ($context eq 'tools') {
+            $access = 1;
+        } else {
+            $access = 0;
+        }
+        return $access;
+    }
+}
+
+sub is_course_owner {
+    my ($cdom,$cnum,$udom,$uname) = @_;
+    if (($udom eq '') || ($uname eq '')) {
+        $udom = $env{'user.domain'};
+        $uname = $env{'user.name'};
+    }
+    unless (($udom eq '') || ($uname eq '')) {
+        if (exists($env{'course.'.$cdom.'_'.$cnum.'.internal.courseowner'})) {
+            if ($env{'course.'.$cdom.'_'.$cnum.'.internal.courseowner'} eq $uname.':'.$udom) {
+                return 1;
+            } else {
+                my %courseinfo = &Apache::lonnet::coursedescription($cdom.'/'.$cnum);
+                if ($courseinfo{'internal.courseowner'} eq $uname.':'.$udom) {
+                    return 1;
+                }
+            }
+        }
+    }
+    return;
+}
+
+sub is_advanced_user {
+    my ($udom,$uname) = @_;
+    if ($udom ne '' && $uname ne '') {
+        if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
+            return $env{'user.adv'};  
+        }
+    }
+    my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1);
+    my %allroles;
+    my $is_adv;
+    foreach my $role (keys(%roleshash)) {
+        my ($trest,$tdomain,$trole,$sec) = split(/:/,$role);
+        my $area = '/'.$tdomain.'/'.$trest;
+        if ($sec ne '') {
+            $area .= '/'.$sec;
+        }
+        if (($area ne '') && ($trole ne '')) {
+            my $spec=$trole.'.'.$area;
+            if ($trole =~ /^cr\//) {
+                &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);
+            } elsif ($trole ne 'gr') {
+                &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
+            }
+        }
+    }
+    foreach my $role (keys(%allroles)) {
+        last if ($is_adv);
+        foreach my $item (split(/:/,$allroles{$role})) {
+            if ($item ne '') {
+                my ($privilege,$restrictions)=split(/&/,$item);
+                if ($privilege eq 'adv') {
+                    $is_adv = 1;
+                    last;
+                }
+            }
+        }
+    }
+    return $is_adv;
+}
+
+sub check_can_request {
+    my ($dom,$can_request,$request_domains) = @_;
+    my $canreq = 0;
+    my ($types,$typename) = &Apache::loncommon::course_types();
+    my @options = ('approval','validate','autolimit');
+    my $optregex = join('|',@options);
+    if ((ref($can_request) eq 'HASH') && (ref($types) eq 'ARRAY')) {
+        foreach my $type (@{$types}) {
+            if (&usertools_access($env{'user.name'},
+                                  $env{'user.domain'},
+                                  $type,undef,'requestcourses')) {
+                $canreq ++;
+                if (ref($request_domains) eq 'HASH') {
+                    push(@{$request_domains->{$type}},$env{'user.domain'});
+                }
+                if ($dom eq $env{'user.domain'}) {
+                    $can_request->{$type} = 1;
+                }
+            }
+            if ($env{'environment.reqcrsotherdom.'.$type} ne '') {
+                my @curr = split(',',$env{'environment.reqcrsotherdom.'.$type});
+                if (@curr > 0) {
+                    foreach my $item (@curr) {
+                        if (ref($request_domains) eq 'HASH') {
+                            my ($otherdom) = ($item =~ /^($match_domain):($optregex)(=?\d*)$/);
+                            if ($otherdom ne '') {
+                                if (ref($request_domains->{$type}) eq 'ARRAY') {
+                                    unless (grep(/^\Q$otherdom\E$/,@{$request_domains->{$type}})) {
+                                        push(@{$request_domains->{$type}},$otherdom);
+                                    }
+                                } else {
+                                    push(@{$request_domains->{$type}},$otherdom);
+                                }
+                            }
+                        }
+                    }
+                    unless($dom eq $env{'user.domain'}) {
+                        $canreq ++;
+                        if (grep(/^\Q$dom\E:($optregex)(=?\d*)$/,@curr)) {
+                            $can_request->{$type} = 1;
+                        }
+                    }
+                }
+            }
+        }
+    }
+    return $canreq;
+}
 
 # ---------------------------------------------- Custom access rule evaluation
 
@@ -4317,17 +5440,68 @@ sub allowed {
     my $statecond=0;
     my $courseprivid='';
 
+    my $ownaccess;
+    # Community Coordinator or Assistant Co-author browsing resource space.
+    if (($priv eq 'bro') && ($env{'user.author'})) {
+        if ($uri eq '') {
+            $ownaccess = 1;
+        } else {
+            if (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
+                my $udom = $env{'user.domain'};
+                my $uname = $env{'user.name'};
+                if ($uri =~ m{^\Q$udom\E/?$}) {
+                    $ownaccess = 1;
+                } elsif ($uri =~ m{^\Q$udom\E/\Q$uname\E/?}) {
+                    unless ($uri =~ m{\.\./}) {
+                        $ownaccess = 1;
+                    }
+                } elsif (($udom ne 'public') && ($uname ne 'public')) {
+                    my $now = time;
+                    if ($uri =~ m{^([^/]+)/?$}) {
+                        my $adom = $1;
+                        foreach my $key (keys(%env)) {
+                            if ($key =~ m{^user\.role\.(ca|aa)/\Q$adom\E}) {
+                                my ($start,$end) = split('.',$env{$key});
+                                if (($now >= $start) && (!$end || $end < $now)) {
+                                    $ownaccess = 1;
+                                    last;
+                                }
+                            }
+                        }
+                    } elsif ($uri =~ m{^([^/]+)/([^/]+)/?}) {
+                        my $adom = $1;
+                        my $aname = $2;
+                        foreach my $role ('ca','aa') { 
+                            if ($env{"user.role.$role./$adom/$aname"}) {
+                                my ($start,$end) =
+                                    split('.',$env{"user.role.$role./$adom/$aname"});
+                                if (($now >= $start) && (!$end || $end < $now)) {
+                                    $ownaccess = 1;
+                                    last;
+                                }
+                            }
+                        }
+                    }
+                }
+            }
+        }
+    }
+
 # Course
 
     if ($env{'user.priv.'.$env{'request.role'}.'./'}=~/\Q$priv\E\&([^\:]*)/) {
-       $thisallowed.=$1;
+        unless (($priv eq 'bro') && (!$ownaccess)) {
+            $thisallowed.=$1;
+        }
     }
 
 # Domain
 
     if ($env{'user.priv.'.$env{'request.role'}.'./'.(split(/\//,$uri))[0].'/'}
        =~/\Q$priv\E\&([^\:]*)/) {
-       $thisallowed.=$1;
+        unless (($priv eq 'bro') && (!$ownaccess)) {
+            $thisallowed.=$1;
+        }
     }
 
 # Course: uri itself is a course
@@ -4337,7 +5511,9 @@ sub allowed {
 
     if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseuri}
        =~/\Q$priv\E\&([^\:]*)/) {
-       $thisallowed.=$1;
+        unless (($priv eq 'bro') && (!$ownaccess)) {
+            $thisallowed.=$1;
+        }
     }
 
 # URI is an uploaded document for this course, default permissions don't matter
@@ -4374,7 +5550,6 @@ sub allowed {
     }
     
 # Full access at system, domain or course-wide level? Exit.
-
     if ($thisallowed=~/F/) {
 	return 'F';
     }
@@ -4478,7 +5653,7 @@ sub allowed {
 
     my $envkey;
     if ($thisallowed=~/L/) {
-        foreach $envkey (keys %env) {
+        foreach $envkey (keys(%env)) {
            if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {
                my $courseid=$2;
                my $roleid=$1.'.'.$2;
@@ -4544,7 +5719,7 @@ sub allowed {
        my $unamedom=$env{'user.name'}.':'.$env{'user.domain'};
        if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'}
 	   =~/\Q$rolecode\E/) {
-	   if ($priv ne 'pch') { 
+	   if (($priv ne 'pch') && ($priv ne 'plc')) { 
 	       &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
 			'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
 			$env{'request.course.id'});
@@ -4554,7 +5729,7 @@ sub allowed {
 
        if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'}
 	   =~/\Q$unamedom\E/) {
-	   if ($priv ne 'pch') { 
+	   if (($priv ne 'pch') && ($priv ne 'plc')) { 
 	       &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.
 			'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.
 			$env{'request.course.id'});
@@ -4568,7 +5743,7 @@ sub allowed {
    if ($thisallowed=~/R/) {
        my $rolecode=(split(/\./,$env{'request.role'}))[0];
        if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) {
-	   if ($priv ne 'pch') { 
+	   if (($priv ne 'pch') && ($priv ne 'plc')) { 
 	       &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
 			'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
 	   }
@@ -4727,6 +5902,9 @@ sub log_query {
 
 sub update_portfolio_table {
     my ($uname,$udom,$file_name,$query,$group,$action) = @_;
+    if ($group ne '') {
+        $file_name =~s /^\Q$group\E//;
+    }
     my $homeserver = &homeserver($uname,$udom);
     my $queryid=
         &reply("querysend:".$query.':'.&escape($uname.':'.$udom.':'.$group).
@@ -4748,8 +5926,7 @@ sub update_allusers_table {
                'generation='.&escape($names->{'generation'}).'%%'.
                'permanentemail='.&escape($names->{'permanentemail'}).'%%'.
                'id='.&escape($names->{'id'}),$homeserver);
-    my $reply = &get_query_reply($queryid);
-    return $reply;
+    return;
 }
 
 # ------- Request retrieval of institutional classlists for course(s)
@@ -4766,7 +5943,7 @@ sub fetch_enrollment_query {
     }
     my $host=&hostname($homeserver);
     my $cmd = '';
-    foreach my $affiliate (keys %{$affiliatesref}) {
+    foreach my $affiliate (keys(%{$affiliatesref})) {
         $cmd .= $affiliate.'='.join(",",@{$$affiliatesref{$affiliate}}).'%%';
     }
     $cmd =~ s/%%$//;
@@ -4899,19 +6076,29 @@ sub auto_run {
 
 sub auto_get_sections {
     my ($cnum,$cdom,$inst_coursecode) = @_;
-    my $homeserver = &homeserver($cnum,$cdom);
-    my @secs = ();
-    my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver));
-    unless ($response eq 'refused') {
-        @secs = split(/:/,$response);
+    my $homeserver;
+    if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) { 
+        $homeserver = &homeserver($cnum,$cdom);
+    }
+    if (!defined($homeserver)) { 
+        if ($cdom =~ /^$match_domain$/) {
+            $homeserver = &domain($cdom,'primary');
+        }
+    }
+    my @secs;
+    if (defined($homeserver)) {
+        my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver));
+        unless ($response eq 'refused') {
+            @secs = split(/:/,$response);
+        }
     }
     return @secs;
 }
 
 sub auto_new_course {
-    my ($cnum,$cdom,$inst_course_id,$owner) = @_;
+    my ($cnum,$cdom,$inst_course_id,$owner,$coowners) = @_;
     my $homeserver = &homeserver($cnum,$cdom);
-    my $response=&unescape(&reply('autonewcourse:'.$inst_course_id.':'.$owner.':'.$cdom,$homeserver));
+    my $response=&unescape(&reply('autonewcourse:'.$inst_course_id.':'.&escape($owner).':'.$cdom.':'.&escape($coowners),$homeserver));
     return $response;
 }
 
@@ -4922,6 +6109,23 @@ sub auto_validate_courseID {
     return $response;
 }
 
+sub auto_validate_instcode {
+    my ($cnum,$cdom,$instcode,$owner) = @_;
+    my ($homeserver,$response);
+    if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) {
+        $homeserver = &homeserver($cnum,$cdom);
+    }
+    if (!defined($homeserver)) {
+        if ($cdom =~ /^$match_domain$/) {
+            $homeserver = &domain($cdom,'primary');
+        }
+    }
+    $response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'.
+                        &escape($instcode).':'.&escape($owner),$homeserver));
+    my ($outcome,$description) = map { &unescape($_); } split('&',$response,2);
+    return ($outcome,$description);
+}
+
 sub auto_create_password {
     my ($cnum,$cdom,$authparam,$udom) = @_;
     my ($homeserver,$response);
@@ -5036,6 +6240,13 @@ sub auto_instcode_format {
 		push(@homeservers,$tryserver);
 	    }
         }
+    } elsif ($caller eq 'requests') {
+        if ($codedom =~ /^$match_domain$/) {
+            my $chome = &domain($codedom,'primary');
+            unless ($chome eq 'no_host') {
+                push(@homeservers,$chome);
+            }
+        }
     } else {
         push(@homeservers,&homeserver($caller,$codedom));
     }
@@ -5093,7 +6304,81 @@ sub auto_instcode_defaults {
     }
 
     return $response;
-} 
+}
+
+sub auto_possible_instcodes {
+    my ($domain,$codetitles,$cat_titles,$cat_orders,$code_order) = @_;
+    unless ((ref($codetitles) eq 'ARRAY') && (ref($cat_titles) eq 'HASH') && 
+            (ref($cat_orders) eq 'HASH') && (ref($code_order) eq 'ARRAY')) {
+        return;
+    }
+    my (@homeservers,$uhome);
+    if (defined(&domain($domain,'primary'))) {
+        $uhome=&domain($domain,'primary');
+        push(@homeservers,&domain($domain,'primary'));
+    } else {
+        my %servers = &get_servers($domain,'library');
+        foreach my $tryserver (keys(%servers)) {
+            if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
+                push(@homeservers,$tryserver);
+            }
+        }
+    }
+    my $response;
+    foreach my $server (@homeservers) {
+        $response=&reply('autopossibleinstcodes:'.$domain,$server);
+        next if ($response =~ /(con_lost|error|no_such_host|refused)/);
+        my ($codetitlestr,$codeorderstr,$cat_title,$cat_order) = 
+            split(':',$response);
+        @{$codetitles} = map { &unescape($_); } (split('&',$codetitlestr));
+        @{$code_order} = map { &unescape($_); } (split('&',$codeorderstr));
+        foreach my $item (split('&',$cat_title)) {   
+            my ($name,$value)=split('=',$item);
+            $cat_titles->{&unescape($name)}=&thaw_unescape($value);
+        }
+        foreach my $item (split('&',$cat_order)) {
+            my ($name,$value)=split('=',$item);
+            $cat_orders->{&unescape($name)}=&thaw_unescape($value);
+        }
+        return 'ok';
+    }
+    return $response;
+}
+
+sub auto_courserequest_checks {
+    my ($dom) = @_;
+    my ($homeserver,%validations);
+    if ($dom =~ /^$match_domain$/) {
+        $homeserver = &domain($dom,'primary');
+    }
+    unless ($homeserver eq 'no_host') {
+        my $response=&reply('autocrsreqchecks:'.$dom,$homeserver);
+        unless ($response =~ /(con_lost|error|no_such_host|refused)/) {
+            my @items = split(/&/,$response);
+            foreach my $item (@items) {
+                my ($key,$value) = split('=',$item);
+                $validations{&unescape($key)} = &thaw_unescape($value);
+            }
+        }
+    }
+    return %validations; 
+}
+
+sub auto_courserequest_validation {
+    my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = @_;
+    my ($homeserver,$response);
+    if ($dom =~ /^$match_domain$/) {
+        $homeserver = &domain($dom,'primary');
+    }
+    unless ($homeserver eq 'no_host') {  
+          
+        $response=&unescape(&reply('autocrsreqvalidation:'.$dom.':'.&escape($owner).
+                                    ':'.&escape($crstype).':'.&escape($inststatuslist).
+                                    ':'.&escape($instcode).':'.&escape($instseclist),
+                                    $homeserver));
+    }
+    return $response;
+}
 
 sub auto_validate_class_sec {
     my ($cdom,$cnum,$owners,$inst_class) = @_;
@@ -5153,11 +6438,11 @@ sub toggle_coursegroup_status {
 }
 
 sub modify_group_roles {
-    my ($cdom,$cnum,$group_id,$user,$end,$start,$userprivs) = @_;
+    my ($cdom,$cnum,$group_id,$user,$end,$start,$userprivs,$selfenroll,$context) = @_;
     my $url = '/'.$cdom.'/'.$cnum.'/'.$group_id;
     my $role = 'gr/'.&escape($userprivs);
     my ($uname,$udom) = split(/:/,$user);
-    my $result = &assignrole($udom,$uname,$url,$role,$end,$start);
+    my $result = &assignrole($udom,$uname,$url,$role,$end,$start,'',$selfenroll,$context);
     if ($result eq 'ok') {
         &devalidate_getgroups_cache($udom,$uname,$cdom,$cnum);
     }
@@ -5204,7 +6489,8 @@ sub get_users_groups {
     } else {  
         $grouplist = '';
         my $courseurl = &courseid_to_courseurl($courseid);
-        my %roleshash = &dump('roles',$udom,$uname,$courseurl);
+        my $extra = &freeze_escape({'skipcheck' => 1});
+        my %roleshash = &dump('roles',$udom,$uname,$courseurl,undef,$extra);
         my $access_end = $env{'course.'.$courseid.
                               '.default_enrollment_end_date'};
         my $now = time;
@@ -5246,43 +6532,71 @@ sub devalidate_getgroups_cache {
 # ------------------------------------------------------------------ Plain Text
 
 sub plaintext {
-    my ($short,$type,$cid) = @_;
-    if ($short =~ /^cr/) {
+    my ($short,$type,$cid,$forcedefault) = @_;
+    if ($short =~ m{^cr/}) {
 	return (split('/',$short))[-1];
     }
     if (!defined($cid)) {
         $cid = $env{'request.course.id'};
     }
-    if (defined($cid) && defined($env{'course.'.$cid.'.'.$short.'.plaintext'})) {
-        return &Apache::lonlocal::mt($env{'course.'.$cid.'.'.$short.
-                                          '.plaintext'});
-    }
     my %rolenames = (
-                      Course => 'std',
-                      Group => 'alt1',
+                      Course    => 'std',
+                      Community => 'alt1',
                     );
-    if (defined($type) && 
-         defined($rolenames{$type}) && 
-         defined($prp{$short}{$rolenames{$type}})) {
+    if ($cid ne '') {
+        if ($env{'course.'.$cid.'.'.$short.'.plaintext'} ne '') {
+            unless ($forcedefault) {
+                my $roletext = $env{'course.'.$cid.'.'.$short.'.plaintext'}; 
+                &Apache::lonlocal::mt_escape(\$roletext);
+                return &Apache::lonlocal::mt($roletext);
+            }
+        }
+    }
+    if ((defined($type)) && (defined($rolenames{$type})) &&
+        (defined($rolenames{$type})) && 
+        (defined($prp{$short}{$rolenames{$type}}))) {
         return &Apache::lonlocal::mt($prp{$short}{$rolenames{$type}});
-    } else {
-        return &Apache::lonlocal::mt($prp{$short}{'std'});
+    } elsif ($cid ne '') {
+        my $crstype = $env{'course.'.$cid.'.type'};
+        if (($crstype ne '') && (defined($rolenames{$crstype})) &&
+            (defined($prp{$short}{$rolenames{$crstype}}))) {
+            return &Apache::lonlocal::mt($prp{$short}{$rolenames{$crstype}});
+        }
     }
+    return &Apache::lonlocal::mt($prp{$short}{'std'});
 }
 
 # ----------------------------------------------------------------- Assign Role
 
 sub assignrole {
-    my ($udom,$uname,$url,$role,$end,$start,$deleteflag)=@_;
+    my ($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll,
+        $context)=@_;
     my $mrole;
     if ($role =~ /^cr\//) {
         my $cwosec=$url;
         $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;
 	unless (&allowed('ccr',$cwosec)) {
-           &logthis('Refused custom assignrole: '.
-             $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
-		    $env{'user.name'}.' at '.$env{'user.domain'});
-           return 'refused'; 
+           my $refused = 1;
+           if ($context eq 'requestcourses') {
+               if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) {
+                   if ($role =~ m{^cr/($match_domain)/($match_username)/([^/]+)$}) {
+                       if (($1 eq $env{'user.domain'}) && ($2 eq $env{'user.name'})) {
+                           my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
+                           my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
+                           if ($crsenv{'internal.courseowner'} eq
+                               $env{'user.name'}.':'.$env{'user.domain'}) {
+                               $refused = '';
+                           }
+                       }
+                   }
+               }
+           }
+           if ($refused) {
+               &logthis('Refused custom assignrole: '.
+                        $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.
+                        ' by '.$env{'user.name'}.' at '.$env{'user.domain'});
+               return 'refused';
+           }
         }
         $mrole='cr';
     } elsif ($role =~ /^gr\//) {
@@ -5307,11 +6621,54 @@ sub assignrole {
             } else {
                 $refused = 1;
             }
-            if ($refused) { 
-                &logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url.
-                         ' '.$role.' '.$end.' '.$start.' by '.
-	  	         $env{'user.name'}.' at '.$env{'user.domain'});
-                return 'refused';
+            if ($refused) {
+                my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
+                if (!$selfenroll && $context eq 'course') {
+                    my %crsenv;
+                    if ($role eq 'cc' || $role eq 'co') {
+                        %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
+                        if (($role eq 'cc') && ($cnum !~ /^$match_community$/)) {
+                            if ($env{'request.role'} eq 'cc./'.$cdom.'/'.$cnum) {
+                                if ($crsenv{'internal.courseowner'} eq 
+                                    $env{'user.name'}.':'.$env{'user.domain'}) {
+                                    $refused = '';
+                                }
+                            }
+                        } elsif (($role eq 'co') && ($cnum =~ /^$match_community$/)) { 
+                            if ($env{'request.role'} eq 'co./'.$cdom.'/'.$cnum) {
+                                if ($crsenv{'internal.courseowner'} eq 
+                                    $env{'user.name'}.':'.$env{'user.domain'}) {
+                                    $refused = '';
+                                }
+                            }
+                        }
+                    }
+                } elsif (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
+                    $refused = '';
+                } elsif ($context eq 'requestcourses') {
+                    my @possroles = ('st','ta','ep','in','cc','co');
+                    if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {
+                        my $wrongcc;
+                        if ($cnum =~ /^$match_community$/) {
+                            $wrongcc = 1 if ($role eq 'cc');
+                        } else {
+                            $wrongcc = 1 if ($role eq 'co');
+                        }
+                        unless ($wrongcc) {
+                            my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
+                            if ($crsenv{'internal.courseowner'} eq 
+                                 $env{'user.name'}.':'.$env{'user.domain'}) {
+                                $refused = '';
+                            }
+                        }
+                    }
+                }
+                if ($refused) {
+                    &logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url.
+                             ' '.$role.' '.$end.' '.$start.' by '.
+	  	             $env{'user.name'}.' at '.$env{'user.domain'});
+                    return 'refused';
+                }
             }
         }
         $mrole=$role;
@@ -5328,6 +6685,7 @@ sub assignrole {
     }
     my $origstart = $start;
     my $origend = $end;
+    my $delflag;
 # actually delete
     if ($deleteflag) {
 	if ((&allowed('dro',$udom)) || (&allowed('dro',$url))) {
@@ -5338,6 +6696,7 @@ sub assignrole {
 # set start and finish to negative values for userrolelog
            $start=-1;
            $end=-1;
+           $delflag = 1;
         }
     }
 # send command
@@ -5346,14 +6705,102 @@ sub assignrole {
     if ($answer eq 'ok') {
 	&userrolelog($role,$uname,$udom,$url,$start,$end);
 # for course roles, perform group memberships changes triggered by role change.
+        &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,$selfenroll,$context);
         unless ($role =~ /^gr/) {
             &Apache::longroup::group_changes($udom,$uname,$url,$role,$origend,
-                                             $origstart);
+                                             $origstart,$selfenroll,$context);
+        }
+        if ($role eq 'cc') {
+            &autoupdate_coowners($url,$end,$start,$uname,$udom);
         }
     }
     return $answer;
 }
 
+sub autoupdate_coowners {
+    my ($url,$end,$start,$uname,$udom) = @_;
+    my ($cdom,$cnum) = ($url =~ m{^/($match_domain)/($match_courseid)});
+    if (($cdom ne '') && ($cnum ne '')) {
+        my $now = time;
+        my %domdesign = &Apache::loncommon::get_domainconf($cdom);
+        if ($domdesign{$cdom.'.autoassign.co-owners'}) {
+            my %coursehash = &coursedescription($cdom.'_'.$cnum);
+            my $instcode = $coursehash{'internal.coursecode'};
+            if ($instcode ne '') {
+                if (($start && $start <= $now) && ($end == 0) || ($end > $now)) {
+                    unless ($coursehash{'internal.courseowner'} eq $uname.':'.$udom) {
+                        my ($delcoowners,@newcoowners,$putresult,$delresult,$coowners);
+                        my ($result,$desc) = &auto_validate_instcode($cnum,$cdom,$instcode,$uname.':'.$udom);
+                        if ($result eq 'valid') {
+                            if ($coursehash{'internal.co-owners'}) {
+                                foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) {
+                                    push(@newcoowners,$coowner);
+                                }
+                                unless (grep(/^\Q$uname\E:\Q$udom\E$/,@newcoowners)) {
+                                    push(@newcoowners,$uname.':'.$udom);
+                                }
+                                @newcoowners = sort(@newcoowners);
+                            } else {
+                                push(@newcoowners,$uname.':'.$udom);
+                            }
+                        } else {
+                            if ($coursehash{'internal.co-owners'}) {
+                                foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) {
+                                    unless ($coowner eq $uname.':'.$udom) {
+                                        push(@newcoowners,$coowner);
+                                    }
+                                }
+                                unless (@newcoowners > 0) {
+                                    $delcoowners = 1;
+                                    $coowners = '';
+                                }
+                            }
+                        }
+                        if (@newcoowners || $delcoowners) {
+                            &store_coowners($cdom,$cnum,$coursehash{'home'},
+                                            $delcoowners,@newcoowners);
+                        }
+                    }
+                }
+            }
+        }
+    }
+}
+
+sub store_coowners {
+    my ($cdom,$cnum,$chome,$delcoowners,@newcoowners) = @_;
+    my $cid = $cdom.'_'.$cnum;
+    my ($coowners,$delresult,$putresult);
+    if (@newcoowners) {
+        $coowners = join(',',@newcoowners);
+        my %coownershash = (
+                            'internal.co-owners' => $coowners,
+                           );
+        $putresult = &put('environment',\%coownershash,$cdom,$cnum);
+        if ($putresult eq 'ok') {
+            if ($env{'course.'.$cid.'.num'} eq $cnum) {
+                &appenv({'course.'.$cid.'.internal.co-owners' => $coowners});
+            }
+        }
+    }
+    if ($delcoowners) {
+        $delresult = &Apache::lonnet::del('environment',['internal.co-owners'],$cdom,$cnum);
+        if ($delresult eq 'ok') {
+            if ($env{'course.'.$cid.'.internal.co-owners'}) {
+                &Apache::lonnet::delenv('course.'.$cid.'.internal.co-owners');
+            }
+        }
+    }
+    if (($putresult eq 'ok') || ($delresult eq 'ok')) {
+        my %crsinfo =
+            &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,undef,undef,'.');
+        if (ref($crsinfo{$cid}) eq 'HASH') {
+            $crsinfo{$cid}{'co-owners'} = \@newcoowners;
+            my $cidput = &Apache::lonnet::courseidput($cdom,\%crsinfo,$chome,'notime');
+        }
+    }
+}
+
 # -------------------------------------------------- Modify user authentication
 # Overrides without validation
 
@@ -5386,17 +6833,27 @@ sub modifyuser {
     my ($udom,    $uname, $uid,
         $umode,   $upass, $first,
         $middle,  $last,  $gene,
-        $forceid, $desiredhome, $email)=@_;
+        $forceid, $desiredhome, $email, $inststatus, $candelete)=@_;
     $udom= &LONCAPA::clean_domain($udom);
     $uname=&LONCAPA::clean_username($uname);
+    my $showcandelete = 'none';
+    if (ref($candelete) eq 'ARRAY') {
+        if (@{$candelete} > 0) {
+            $showcandelete = join(', ',@{$candelete});
+        }
+    }
     &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.
-	     $last.', '.$gene.'(forceid: '.$forceid.')'.
+	     $last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$showcandelete.')'.
              (defined($desiredhome) ? ' desiredhome = '.$desiredhome :
                                      ' desiredhome not specified'). 
              ' by '.$env{'user.name'}.' at '.$env{'user.domain'}.
              ' in domain '.$env{'request.role.domain'});
     my $uhome=&homeserver($uname,$udom,'true');
+    my $newuser;
+    if ($uhome eq 'no_host') {
+        $newuser = 1;
+    }
 # ----------------------------------------------------------------- Create User
     if (($uhome eq 'no_host') && 
 	(($umode && $upass) || ($umode eq 'localauth'))) {
@@ -5447,37 +6904,102 @@ sub modifyuser {
 # -------------------------------------------------------------- Add names, etc
     my @tmp=&get('environment',
 		   ['firstname','middlename','lastname','generation','id',
-                    'permanentemail'],
+                    'permanentemail','inststatus'],
 		   $udom,$uname);
-    my %names;
+    my (%names,%oldnames);
     if ($tmp[0] =~ m/^error:.*/) { 
         %names=(); 
     } else {
         %names = @tmp;
+        %oldnames = %names;
     }
 #
-# Make sure to not trash student environment if instructor does not bother
-# to supply name and email information
-#
+# If name, email and/or uid are blank (e.g., because an uploaded file
+# of users did not contain them), do not overwrite existing values
+# unless field is in $candelete array ref.  
+#
+
+    my @fields = ('firstname','middlename','lastname','generation',
+                  'permanentemail','id');
+    my %newvalues;
+    if (ref($candelete) eq 'ARRAY') {
+        foreach my $field (@fields) {
+            if (grep(/^\Q$field\E$/,@{$candelete})) {
+                if ($field eq 'firstname') {
+                    $names{$field} = $first;
+                } elsif ($field eq 'middlename') {
+                    $names{$field} = $middle;
+                } elsif ($field eq 'lastname') {
+                    $names{$field} = $last;
+                } elsif ($field eq 'generation') { 
+                    $names{$field} = $gene;
+                } elsif ($field eq 'permanentemail') {
+                    $names{$field} = $email;
+                } elsif ($field eq 'id') {
+                    $names{$field}  = $uid;
+                }
+            }
+        }
+    }
     if ($first)  { $names{'firstname'}  = $first; }
     if (defined($middle)) { $names{'middlename'} = $middle; }
     if ($last)   { $names{'lastname'}   = $last; }
     if (defined($gene))   { $names{'generation'} = $gene; }
     if ($email) {
        $email=~s/[^\w\@\.\-\,]//gs;
-       if ($email=~/\@/) { $names{'notification'} = $email;
-			   $names{'critnotification'} = $email;
-			   $names{'permanentemail'} = $email; }
+       if ($email=~/\@/) { $names{'permanentemail'} = $email; }
     }
     if ($uid) { $names{'id'}  = $uid; }
+    if (defined($inststatus)) {
+        $names{'inststatus'} = '';
+        my ($usertypes,$typesorder) = &retrieve_inst_usertypes($udom);
+        if (ref($usertypes) eq 'HASH') {
+            my @okstatuses; 
+            foreach my $item (split(/:/,$inststatus)) {
+                if (defined($usertypes->{$item})) {
+                    push(@okstatuses,$item);  
+                }
+            }
+            if (@okstatuses) {
+                $names{'inststatus'} = join(':', map { &escape($_); } @okstatuses);
+            }
+        }
+    }
+    my $logmsg = $udom.', '.$uname.', '.$uid.', '.
+                 $umode.', '.$first.', '.$middle.', '.
+                 $last.', '.$gene.', '.$email.', '.$inststatus;
+    if ($env{'user.name'} ne '' && $env{'user.domain'}) {
+        $logmsg .= ' by '.$env{'user.name'}.' at '.$env{'user.domain'};
+    } else {
+        $logmsg .= ' during self creation';
+    }
+    my $changed;
+    if ($newuser) {
+        $changed = 1;
+    } else {
+        foreach my $field (@fields) {
+            if ($names{$field} ne $oldnames{$field}) {
+                $changed = 1;
+                last;
+            }
+        }
+    }
+    unless ($changed) {
+        $logmsg = 'No changes in user information needed for: '.$logmsg;
+        &logthis($logmsg);
+        return 'ok';
+    }
     my $reply = &put('environment', \%names, $udom,$uname);
-    if ($reply ne 'ok') { return 'error: '.$reply; }
+    if ($reply ne 'ok') { 
+        return 'error: '.$reply;
+    }
+    if ($names{'permanentemail'} ne $oldnames{'permanentemail'}) {
+        &Apache::lonnet::devalidate_cache_new('emailscache',$uname.':'.$udom);
+    }
     my $sqlresult = &update_allusers_table($uname,$udom,\%names);
     &devalidate_cache_new('namescache',$uname.':'.$udom);
-    &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
-             $umode.', '.$first.', '.$middle.', '.
-	     $last.', '.$gene.' by '.
-             $env{'user.name'}.' at '.$env{'user.domain'});
+    $logmsg = 'Success modifying user '.$logmsg;
+    &logthis($logmsg);
     return 'ok';
 }
 
@@ -5485,7 +7007,8 @@ sub modifyuser {
 
 sub modifystudent {
     my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
-        $end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid)=@_;
+        $end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid,
+        $selfenroll,$context,$inststatus)=@_;
     if (!$cid) {
 	unless ($cid=$env{'request.course.id'}) {
 	    return 'not_in_class';
@@ -5494,18 +7017,18 @@ sub modifystudent {
 # --------------------------------------------------------------- Make the user
     my $reply=&modifyuser
 	($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid,
-         $desiredhome,$email);
+         $desiredhome,$email,$inststatus);
     unless ($reply eq 'ok') { return $reply; }
     # This will cause &modify_student_enrollment to get the uid from the
     # students environment
     $uid = undef if (!$forceid);
     $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last,
-					$gene,$usec,$end,$start,$type,$locktype,$cid);
+					$gene,$usec,$end,$start,$type,$locktype,$cid,$selfenroll,$context);
     return $reply;
 }
 
 sub modify_student_enrollment {
-    my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,$locktype,$cid) = @_;
+    my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,$locktype,$cid,$selfenroll,$context) = @_;
     my ($cdom,$cnum,$chome);
     if (!$cid) {
 	unless ($cid=$env{'request.course.id'}) {
@@ -5563,7 +7086,7 @@ sub modify_student_enrollment {
     if ($usec) {
 	$uurl.='/'.$usec;
     }
-    return &assignrole($udom,$uname,$uurl,'st',$end,$start);
+    return &assignrole($udom,$uname,$uurl,'st',$end,$start,undef,$selfenroll,$context);
 }
 
 sub format_name {
@@ -5608,48 +7131,90 @@ sub writecoursepref {
 
 sub createcourse {
     my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,
-        $course_owner,$crstype)=@_;
+        $course_owner,$crstype,$cnum,$context,$category)=@_;
     $url=&declutter($url);
     my $cid='';
-    unless (&allowed('ccc',$udom)) {
+    if ($context eq 'requestcourses') {
+        my $can_create = 0;
+        my ($ownername,$ownerdom) = split(':',$course_owner);
+        if ($udom eq $ownerdom) {
+            if (&usertools_access($ownername,$ownerdom,$category,undef,
+                                  $context)) {
+                $can_create = 1;
+            }
+        } else {
+            my %userenv = &userenvironment($ownerdom,$ownername,'reqcrsotherdom.'.
+                                           $category);
+            if ($userenv{'reqcrsotherdom.'.$category} ne '') {
+                my @curr = split(',',$userenv{'reqcrsotherdom.'.$category});
+                if (@curr > 0) {
+                    my @options = qw(approval validate autolimit);
+                    my $optregex = join('|',@options);
+                    if (grep(/^\Q$udom\E:($optregex)(=?\d*)$/,@curr)) {
+                        $can_create = 1;
+                    }
+                }
+            }
+        }
+        if ($can_create) {
+            unless ($ownername eq $env{'user.name'} && $ownerdom eq $env{'user.domain'}) {
+                unless (&allowed('ccc',$udom)) {
+                    return 'refused'; 
+                }
+            }
+        } else {
+            return 'refused';
+        }
+    } elsif (!&allowed('ccc',$udom)) {
         return 'refused';
     }
-# ------------------------------------------------------------------- Create ID
-   my $uname=int(1+rand(9)).
-       ('a'..'z','A'..'Z','0'..'9')[int(rand(62))].
-       substr($$.time,0,5).unpack("H8",pack("I32",time)).
-       unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
-# ----------------------------------------------- Make sure that does not exist
-   my $uhome=&homeserver($uname,$udom,'true');
-   unless (($uhome eq '') || ($uhome eq 'no_host')) {
-       $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).
-        unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
-       $uhome=&homeserver($uname,$udom,'true');       
-       unless (($uhome eq '') || ($uhome eq 'no_host')) {
-           return 'error: unable to generate unique course-ID';
-       } 
-   }
-# ------------------------------------------------ Check supplied server name
-    $course_server = $env{'user.homeserver'} if (! defined($course_server));
-    if (! &is_library($course_server)) {
-        return 'error:bad server name '.$course_server;
+# --------------------------------------------------------------- Get Unique ID
+    my $uname;
+    if ($cnum =~ /^$match_courseid$/) {
+        my $chome=&homeserver($cnum,$udom,'true');
+        if (($chome eq '') || ($chome eq 'no_host')) {
+            $uname = $cnum;
+        } else {
+            $uname = &generate_coursenum($udom,$crstype);
+        }
+    } else {
+        $uname = &generate_coursenum($udom,$crstype);
+    }
+    return $uname if ($uname =~ /^error/);
+# -------------------------------------------------- Check supplied server name
+    if (!defined($course_server)) {
+        if (defined(&domain($udom,'primary'))) {
+            $course_server = &domain($udom,'primary');
+        } else {
+            $course_server = $env{'user.home'}; 
+        }
+    }
+    my %host_servers =
+        &Apache::lonnet::get_servers($udom,'library');
+    unless ($host_servers{$course_server}) {
+        return 'error: invalid home server for course: '.$course_server;
     }
 # ------------------------------------------------------------- Make the course
     my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::',
                       $course_server);
     unless ($reply eq 'ok') { return 'error: '.$reply; }
-    $uhome=&homeserver($uname,$udom,'true');
+    my $uhome=&homeserver($uname,$udom,'true');
     if (($uhome eq '') || ($uhome eq 'no_host')) { 
 	return 'error: no such course';
     }
 # ----------------------------------------------------------------- Course made
 # log existence
+    my $now = time;
     my $newcourse = {
                     $udom.'_'.$uname => {
                                      description => $description,
                                      inst_code   => $inst_code,
                                      owner       => $course_owner,
                                      type        => $crstype,
+                                     creator     => $env{'user.name'}.':'.
+                                                    $env{'user.domain'},
+                                     created     => $now,
+                                     context     => $context,
                                                 },
                     };
     &courseidput($udom,$newcourse,$uhome,'notime');
@@ -5674,59 +7239,140 @@ ENDINITMAP
     }
 # ----------------------------------------------------------- Write preferences
     &writecoursepref($udom.'_'.$uname,
-                     ('description' => $description,
-                      'url'         => $topurl));
+                     ('description'              => $description,
+                      'url'                      => $topurl,
+                      'internal.creator'         => $env{'user.name'}.':'.
+                                                    $env{'user.domain'},
+                      'internal.created'         => $now,
+                      'internal.creationcontext' => $context)
+                    );
     return '/'.$udom.'/'.$uname;
 }
 
+# ------------------------------------------------------------------- Create ID
+sub generate_coursenum {
+    my ($udom,$crstype) = @_;
+    my $domdesc = &domain($udom);
+    return 'error: invalid domain' if ($domdesc eq '');
+    my $first;
+    if ($crstype eq 'Community') {
+        $first = '0';
+    } else {
+        $first = int(1+rand(9)); 
+    } 
+    my $uname=$first.
+        ('a'..'z','A'..'Z','0'..'9')[int(rand(62))].
+        substr($$.time,0,5).unpack("H8",pack("I32",time)).
+        unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
+# ----------------------------------------------- Make sure that does not exist
+    my $uhome=&homeserver($uname,$udom,'true');
+    unless (($uhome eq '') || ($uhome eq 'no_host')) {
+        if ($crstype eq 'Community') {
+            $first = '0';
+        } else {
+            $first = int(1+rand(9));
+        }
+        $uname=$first.
+               ('a'..'z','A'..'Z','0'..'9')[int(rand(62))].
+               substr($$.time,0,5).unpack("H8",pack("I32",time)).
+               unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
+        $uhome=&homeserver($uname,$udom,'true');
+        unless (($uhome eq '') || ($uhome eq 'no_host')) {
+            return 'error: unable to generate unique course-ID';
+        }
+    }
+    return $uname;
+}
+
 sub is_course {
     my ($cdom,$cnum) = @_;
     my %courses = &courseiddump($cdom,'.',1,'.','.',$cnum,undef,
-				undef,'.',undef,1);
+				undef,'.');
     if (exists($courses{$cdom.'_'.$cnum})) {
         return 1;
     }
     return 0;
 }
 
+sub store_userdata {
+    my ($storehash,$datakey,$namespace,$udom,$uname) = @_;
+    my $result;
+    if ($datakey ne '') {
+        if (ref($storehash) eq 'HASH') {
+            if ($udom eq '' || $uname eq '') {
+                $udom = $env{'user.domain'};
+                $uname = $env{'user.name'};
+            }
+            my $uhome=&homeserver($uname,$udom);
+            if (($uhome eq '') || ($uhome eq 'no_host')) {
+                $result = 'error: no_host';
+            } else {
+                $storehash->{'ip'} = $ENV{'REMOTE_ADDR'};
+                $storehash->{'host'} = $perlvar{'lonHostID'};
+
+                my $namevalue='';
+                foreach my $key (keys(%{$storehash})) {
+                    $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
+                }
+                $namevalue=~s/\&$//;
+                $result =  &reply("store:$udom:$uname:$namespace:$datakey:".
+                                  $namevalue,$uhome);
+            }
+        } else {
+            $result = 'error: data to store was not a hash reference'; 
+        }
+    } else {
+        $result= 'error: invalid requestkey'; 
+    }
+    return $result;
+}
+
 # ---------------------------------------------------------- Assign Custom Role
 
 sub assigncustomrole {
-    my ($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start,$deleteflag)=@_;
+    my ($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start,$deleteflag,$selfenroll,$context)=@_;
     return &assignrole($udom,$uname,$url,'cr/'.$rdom.'/'.$rnam.'/'.$rolename,
-                       $end,$start,$deleteflag);
+                       $end,$start,$deleteflag,$selfenroll,$context);
 }
 
 # ----------------------------------------------------------------- Revoke Role
 
 sub revokerole {
-    my ($udom,$uname,$url,$role,$deleteflag)=@_;
+    my ($udom,$uname,$url,$role,$deleteflag,$selfenroll,$context)=@_;
     my $now=time;
-    return &assignrole($udom,$uname,$url,$role,$now,$deleteflag);
+    return &assignrole($udom,$uname,$url,$role,$now,undef,$deleteflag,$selfenroll,$context);
 }
 
 # ---------------------------------------------------------- Revoke Custom Role
 
 sub revokecustomrole {
-    my ($udom,$uname,$url,$rdom,$rnam,$rolename,$deleteflag)=@_;
+    my ($udom,$uname,$url,$rdom,$rnam,$rolename,$deleteflag,$selfenroll,$context)=@_;
     my $now=time;
     return &assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$now,
-           $deleteflag);
+           $deleteflag,$selfenroll,$context);
 }
 
 # ------------------------------------------------------------ Disk usage
 sub diskusage {
-    my ($udom,$uname,$directoryRoot)=@_;
-    $directoryRoot =~ s/\/$//;
-    my $listing=&reply('du:'.$directoryRoot,homeserver($uname,$udom));
+    my ($udom,$uname,$directorypath,$getpropath)=@_;
+    $directorypath =~ s/\/$//;
+    my $listing=&reply('du2:'.&escape($directorypath).':'
+                       .&escape($getpropath).':'.&escape($uname).':'
+                       .&escape($udom),homeserver($uname,$udom));
+    if ($listing eq 'unknown_cmd') {
+        if ($getpropath) {
+            $directorypath = &propath($udom,$uname).'/'.$directorypath; 
+        }
+        $listing = &reply('du:'.$directorypath,homeserver($uname,$udom));
+    }
     return $listing;
 }
 
 sub is_locked {
-    my ($file_name, $domain, $user) = @_;
+    my ($file_name, $domain, $user, $which) = @_;
     my @check;
     my $is_locked;
-    push @check, $file_name;
+    push (@check,$file_name);
     my %locked = &get('file_permissions',\@check,
 		      $env{'user.domain'},$env{'user.name'});
     my ($tmp)=keys(%locked);
@@ -5735,14 +7381,19 @@ sub is_locked {
     if (ref($locked{$file_name}) eq 'ARRAY') {
         $is_locked = 'false';
         foreach my $entry (@{$locked{$file_name}}) {
-           if (ref($entry) eq 'ARRAY') { 
+           if (ref($entry) eq 'ARRAY') {
                $is_locked = 'true';
-               last;
+               if (ref($which) eq 'ARRAY') {
+                   push(@{$which},$entry);
+               } else {
+                   last;
+               }
            }
        }
     } else {
         $is_locked = 'false';
     }
+    return $is_locked;
 }
 
 sub declutter_portfile {
@@ -5959,20 +7610,18 @@ sub modify_access_controls {
                 }
             }
         }
+        my ($group);
+        if (&is_course($domain,$user)) {
+            ($group,my $file) = split(/\//,$file_name,2);
+        }
         $deloutcome = &del('file_permissions',\@deletions,$domain,$user);
         $new_values{$file_name."\0".'accesscontrol'} = \%new_control;
         $outcome = &put('file_permissions',\%new_values,$domain,$user);
         #  remove lock
         my @del_lock = ($file_name."\0".'locked_access_records');
         my $dellockoutcome = &del('file_permissions',\@del_lock,$domain,$user);
-        my ($file,$group);
-        if (&is_course($domain,$user)) {
-            ($group,$file) = split(/\//,$file_name,2);
-        } else {
-            $file = $file_name;
-        }
         my $sqlresult =
-            &update_portfolio_table($user,$domain,$file,'portfolio_access',
+            &update_portfolio_table($user,$domain,$file_name,'portfolio_access',
                                     $group);
     } else {
         $outcome = "error: could not obtain lockfile\n";  
@@ -6135,30 +7784,49 @@ sub unmark_as_readonly {
 # ------------------------------------------------------------ Directory lister
 
 sub dirlist {
-    my ($uri,$userdomain,$username,$alternateDirectoryRoot)=@_;
-
+    my ($uri,$userdomain,$username,$getpropath,$getuserdir,$alternateRoot)=@_;
     $uri=~s/^\///;
     $uri=~s/\/$//;
     my ($udom, $uname);
-    (undef,$udom,$uname)=split(/\//,$uri);
-    if(defined($userdomain)) {
+    if ($getuserdir) {
         $udom = $userdomain;
-    }
-    if(defined($username)) {
         $uname = $username;
+    } else {
+        (undef,$udom,$uname)=split(/\//,$uri);
+        if(defined($userdomain)) {
+            $udom = $userdomain;
+        }
+        if(defined($username)) {
+            $uname = $username;
+        }
     }
+    my ($dirRoot,$listing,@listing_results);
 
-    my $dirRoot = $perlvar{'lonDocRoot'};
-    if(defined($alternateDirectoryRoot)) {
-        $dirRoot = $alternateDirectoryRoot;
+    $dirRoot = $perlvar{'lonDocRoot'};
+    if (defined($getpropath)) {
+        $dirRoot = &propath($udom,$uname);
         $dirRoot =~ s/\/$//;
+    } elsif (defined($getuserdir)) {
+        my $subdir=$uname.'__';
+        $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
+        $dirRoot = $Apache::lonnet::perlvar{'lonUsersDir'}
+                   ."/$udom/$subdir/$uname";
+    } elsif (defined($alternateRoot)) {
+        $dirRoot = $alternateRoot;
     }
 
     if($udom) {
         if($uname) {
-            my $listing = &reply('ls2:'.$dirRoot.'/'.$uri,
-				 &homeserver($uname,$udom));
-            my @listing_results;
+            $listing = &reply('ls3:'.&escape('/'.$uri).':'.$getpropath.':'
+                              .$getuserdir.':'.&escape($dirRoot)
+                              .':'.&escape($uname).':'.&escape($udom),
+                              &homeserver($uname,$udom));
+            if ($listing eq 'unknown_cmd') {
+                $listing = &reply('ls2:'.$dirRoot.'/'.$uri,
+                                  &homeserver($uname,$udom));
+            } else {
+                @listing_results = map { &unescape($_); } split(/:/,$listing);
+            }
             if ($listing eq 'unknown_cmd') {
                 $listing = &reply('ls:'.$dirRoot.'/'.$uri,
 				  &homeserver($uname,$udom));
@@ -6167,13 +7835,18 @@ sub dirlist {
                 @listing_results = map { &unescape($_); } split(/:/,$listing);
             }
             return @listing_results;
-        } elsif(!defined($alternateDirectoryRoot)) {
+        } elsif(!$alternateRoot) {
             my %allusers;
 	    my %servers = &get_servers($udom,'library');
-	    foreach my $tryserver (keys(%servers)) {
-		my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
-				     $udom, $tryserver);
-		my @listing_results;
+ 	    foreach my $tryserver (keys(%servers)) {
+                $listing = &reply('ls3:'.&escape("/res/$udom").':::::'.
+                                  &escape($udom),$tryserver);
+                if ($listing eq 'unknown_cmd') {
+		    $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
+				      $udom, $tryserver);
+                } else {
+                    @listing_results = map { &unescape($_); } split(/:/,$listing);
+                }
 		if ($listing eq 'unknown_cmd') {
 		    $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
 				      $udom, $tryserver);
@@ -6200,13 +7873,13 @@ sub dirlist {
         } else {
             return ('missing user name');
         }
-    } elsif(!defined($alternateDirectoryRoot)) {
+    } elsif(!defined($getpropath)) {
         my @all_domains = sort(&all_domains());
-         foreach my $domain (@all_domains) {
-             $domain = $perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain';
-         }
-         return @all_domains;
-     } else {
+        foreach my $domain (@all_domains) {
+            $domain = $perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain';
+        }
+        return @all_domains;
+    } else {
         return ('missing domain');
     }
 }
@@ -6216,23 +7889,13 @@ sub dirlist {
 # when it was last modified.  It will also return an error of -1
 # if an error occurs
 
-##
-## FIXME: This subroutine assumes its caller knows something about the
-## directory structure of the home server for the student ($root).
-## Not a good assumption to make.  Since this is for looking up files
-## in user directories, the full path should be constructed by lond, not
-## whatever machine we request data from.
-##
 sub GetFileTimestamp {
-    my ($studentDomain,$studentName,$filename,$root)=@_;
+    my ($studentDomain,$studentName,$filename,$getuserdir)=@_;
     $studentDomain = &LONCAPA::clean_domain($studentDomain);
     $studentName   = &LONCAPA::clean_username($studentName);
-    my $subdir=$studentName.'__';
-    $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
-    my $proname="$studentDomain/$subdir/$studentName";
-    $proname .= '/'.$filename;
-    my ($fileStat) = &Apache::lonnet::dirlist($proname, $studentDomain, 
-                                              $studentName, $root);
+    my ($fileStat) = 
+        &Apache::lonnet::dirlist($filename,$studentDomain,$studentName, 
+                                 undef,$getuserdir);
     my @stats = split('&', $fileStat);
     if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
         # @stats contains first the filename, then the stat output
@@ -6246,12 +7909,11 @@ sub stat_file {
     my ($uri) = @_;
     $uri = &clutter_with_no_wrapper($uri);
 
-    my ($udom,$uname,$file,$dir);
+    my ($udom,$uname,$file);
     if ($uri =~ m-^/(uploaded|editupload)/-) {
 	($udom,$uname,$file) =
 	    ($uri =~ m-/(?:uploaded|editupload)/?($match_domain)/?($match_name)/?(.*)-);
 	$file = 'userfiles/'.$file;
-	$dir = &propath($udom,$uname);
     }
     if ($uri =~ m-^/res/-) {
 	($udom,$uname) = 
@@ -6263,8 +7925,11 @@ sub stat_file {
 	# unable to handle the uri
 	return ();
     }
-
-    my ($result) = &dirlist($file,$udom,$uname,$dir);
+    my $getpropath;
+    if ($file =~ /^userfiles\//) {
+        $getpropath = 1;
+    }
+    my ($result) = &dirlist($file,$udom,$uname,$getpropath);
     my @stats = split('&', $result);
     
     if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
@@ -6297,7 +7962,7 @@ sub directcondval {
 	    untie(%bighash);
 	}
 	my $value = &docondval($sub_condition);
-	&appenv('user.state.'.$env{'request.course.id'}.".$number" => $value);
+	&appenv({'user.state.'.$env{'request.course.id'}.".$number" => $value});
 	return $value;
     }
     if ($env{'user.state.'.$env{'request.course.id'}}) {
@@ -6483,7 +8148,7 @@ sub EXT_cache_status {
 sub EXT_cache_set {
     my ($target_domain,$target_user) = @_;
     my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain;
-    #&appenv($cachename => time);
+    #&appenv({$cachename => time});
 }
 
 # --------------------------------------------------------- Value of a Variable
@@ -6871,6 +8536,7 @@ sub add_prefix_and_part {
 # ---------------------------------------------------------------- Get metadata
 
 my %metaentry;
+my %importedpartids;
 sub metadata {
     my ($uri,$what,$liburi,$prefix,$depthcount)=@_;
     $uri=&declutter($uri);
@@ -6878,7 +8544,7 @@ sub metadata {
     if (($uri eq '') || 
 	(($uri =~ m|^/*adm/|) && 
 	     ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) ||
-        ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) ) {
+        ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {
 	return undef;
     }
     if (($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) 
@@ -6897,6 +8563,10 @@ sub metadata {
 	if (defined($cached)) { return $result->{':'.$what}; }
     }
     {
+# Imported parts would go here
+        my %importedids=();
+        my @origfileimportpartids=();
+        my $importedparts=0;
 #
 # Is this a recursive call for a library?
 #
@@ -6920,7 +8590,8 @@ sub metadata {
 		&Apache::lonnet::ssi_body($which,
 					  ('grade_target' => 'meta'));
 	    $cachetime = 1; # only want this cached in the child not long term
-	} elsif ($uri !~ m -^(editupload)/-) {
+	} elsif (($uri !~ m -^(editupload)/-) && 
+                 ($uri !~ m{^/*uploaded/$match_domain/$match_courseid/docs/})) {
 	    my $file=&filelocation('',&clutter($filename));
 	    #push(@{$metaentry{$uri.'.file'}},$file);
 	    $metastring=&getfile($file);
@@ -6980,27 +8651,55 @@ sub metadata {
 # This is not a package - some other kind of start tag
 #
 		    my $entry=$token->[1];
-		    my $unikey;
-		    if ($entry eq 'import') {
-			$unikey='';
-		    } else {
-			$unikey=$entry;
-		    }
-		    $unikey.=&add_prefix_and_part($prefix,$token->[2]->{'part'});
-
-		    if (defined($token->[2]->{'id'})) { 
-			$unikey.='_'.$token->[2]->{'id'}; 
-		    }
+		    my $unikey='';
 
 		    if ($entry eq 'import') {
 #
 # Importing a library here
 #
+                        my $location=$parser->get_text('/import');
+                        my $dir=$filename;
+                        $dir=~s|[^/]*$||;
+                        $location=&filelocation($dir,$location);
+                       
+                        my $importmode=$token->[2]->{'importmode'};
+                        if ($importmode eq 'problem') {
+# Import as problem/response
+                           $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'});
+                        } elsif ($importmode eq 'part') {
+# Import as part(s)
+                           $importedparts=1;
+# We need to get the original file and the imported file to get the part order correct
+# Good news: we do not need to worry about nested libraries, since parts cannot be nested
+# Load and inspect original file
+                           if ($#origfileimportpartids<0) {
+                              undef(%importedpartids);
+                              my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);
+                              my $origfile=&getfile($origfilelocation);
+                              @origfileimportpartids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
+                           }
+
+# Load and inspect imported file
+                           my $impfile=&getfile($location);
+                           my @impfilepartids=($impfile=~/<part[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
+                           if ($#impfilepartids>=0) {
+# This problem had parts
+                               $importedpartids{$token->[2]->{'id'}}=join(',',@impfilepartids);
+                           } else {
+# Importing by turning a single problem into a problem part
+# It gets the import-tags ID as part-ID
+                               $unikey=&add_prefix_and_part($prefix,$token->[2]->{'id'});
+                               $importedpartids{$token->[2]->{'id'}}=$token->[2]->{'id'};
+                           }
+                        } else {
+# Normal import
+                           $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'});
+                           if (defined($token->[2]->{'id'})) {
+                              $unikey.='_'.$token->[2]->{'id'};
+                           }
+                        }
+
 			if ($depthcount<20) {
-			    my $location=$parser->get_text('/import');
-			    my $dir=$filename;
-			    $dir=~s|[^/]*$||;
-			    $location=&filelocation($dir,$location);
 			    my $metadata = 
 				&metadata($uri,'keys', $location,$unikey,
 					  $depthcount+1);
@@ -7008,9 +8707,16 @@ sub metadata {
 				$metaentry{':'.$meta}=$metaentry{':'.$meta};
 				$metathesekeys{$meta}=1;
 			    }
-			}
-		    } else { 
 			
+                        }
+		    } else {
+#
+# Not importing, some other kind of non-package, non-library start tag
+# 
+                        $unikey=$entry.&add_prefix_and_part($prefix,$token->[2]->{'part'});
+                        if (defined($token->[2]->{'id'})) {
+                            $unikey.='_'.$token->[2]->{'id'};
+                        }
 			if (defined($token->[2]->{'name'})) { 
 			    $unikey.='_'.$token->[2]->{'name'}; 
 			}
@@ -7084,6 +8790,22 @@ sub metadata {
 	    grep { ! $seen{$_} ++ } (split(',',$metaentry{':packages'}));
 	$metaentry{':packages'} = join(',',@uniq_packages);
 
+        if ($importedparts) {
+# We had imported parts and need to rebuild partorder
+           $metaentry{':partorder'}='';
+           $metathesekeys{'partorder'}=1;
+           for (my $index=0;$index<$#origfileimportpartids;$index+=2) {
+               if ($origfileimportpartids[$index] eq 'part') {
+# original part, part of the problem
+                  $metaentry{':partorder'}.=','.$origfileimportpartids[$index+1];
+               } else {
+# we have imported parts at this position
+                  $metaentry{':partorder'}.=','.$importedpartids{$origfileimportpartids[$index+1]};
+               }
+           }
+           $metaentry{':partorder'}=~s/^\,//;
+        }
+
 	$metaentry{':keys'} = join(',',keys(%metathesekeys));
 	&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
 	$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);
@@ -7156,6 +8878,11 @@ sub devalidate_title_cache {
     &devalidate_cache_new('title',$key);
 }
 
+# ------------------------------------------------- Get the title of a course
+
+sub current_course_title {
+    return $env{ 'course.' . $env{'request.course.id'} . '.description' };
+}
 # ------------------------------------------------- Get the title of a resource
 
 sub gettitle {
@@ -7222,7 +8949,7 @@ sub symblist {
     if (($env{'request.course.fn'}) && (%newhash)) {
         if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                       &GDBM_WRCREAT(),0640)) {
-	    foreach my $url (keys %newhash) {
+	    foreach my $url (keys(%newhash)) {
 		next if ($url eq 'last_known'
 			 && $env{'form.no_update_last_known'});
 		$hash{declutter($url)}=&encode_symb($mapname,
@@ -7259,19 +8986,27 @@ sub symbverify {
 
     if (tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
                             &GDBM_READER(),0640)) {
+        if (($thisurl =~ m{^/adm/wrapper/ext/}) || ($thisurl =~ m{^ext/})) {
+            $thisurl =~ s/\?.+$//;
+        }
         my $ids=$bighash{'ids_'.&clutter($thisurl)};
-        unless ($ids) { 
-           $ids=$bighash{'ids_/'.$thisurl};
+        unless ($ids) {
+            my $idkey = 'ids_'.($thisurl =~ m{^/}? '' : '/').$thisurl;  
+            $ids=$bighash{$idkey};
         }
         if ($ids) {
 # ------------------------------------------------------------------- Has ID(s)
 	    foreach my $id (split(/\,/,$ids)) {
 	       my ($mapid,$resid)=split(/\./,$id);
+               if ($thisfn =~ m{^/adm/wrapper/ext/}) {
+                   $symb =~ s/\?.+$//;
+               }
                if (
   &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
    eq $symb) { 
 		   if (($env{'request.role.adv'}) ||
-		       $bighash{'encrypted_'.$id} eq $env{'request.enc'}) {
+		       ($bighash{'encrypted_'.$id} eq $env{'request.enc'}) ||
+                       ($thisurl eq '/adm/navmaps')) {
 		       $okay=1; 
 		   }
 	       }
@@ -7385,7 +9120,7 @@ sub symbread {
         if ($syval) {
 	    #unless ($syval=~/\_\d+$/) {
 		#unless ($env{'form.request.prefix'}=~/\.(\d+)\_$/) {
-		    #&appenv('request.ambiguous' => $thisfn);
+		    #&appenv({'request.ambiguous' => $thisfn});
 		    #return $env{$cache_str}='';
 		#}    
 		#$syval.=$1;
@@ -7437,7 +9172,7 @@ sub symbread {
 	    return $env{$cache_str}=$syval;
         }
     }
-    &appenv('request.ambiguous' => $thisfn);
+    &appenv({'request.ambiguous' => $thisfn});
     return $env{$cache_str}='';
 }
 
@@ -7929,7 +9664,10 @@ sub repcopy_userfile {
     if (-e $transferfile) { return 'ok'; }
     my $request;
     $uri=~s/^\///;
-    $request=new HTTP::Request('GET','http://'.&hostname(&homeserver($cnum,$cdom)).'/raw/'.$uri);
+    my $homeserver = &homeserver($cnum,$cdom);
+    my $protocol = $protocol{$homeserver};
+    $protocol = 'http' if ($protocol ne 'https');
+    $request=new HTTP::Request('GET',$protocol.'://'.&hostname($homeserver).'/raw/'.$uri);
     my $response=$ua->request($request,$transferfile);
 # did it work?
     if ($response->is_error()) {
@@ -7944,15 +9682,18 @@ sub repcopy_userfile {
 
 sub tokenwrapper {
     my $uri=shift;
-    $uri=~s|^http\://([^/]+)||;
+    $uri=~s|^https?\://([^/]+)||;
     $uri=~s|^/||;
     $env{'user.environment'}=~/\/([^\/]+)\.id/;
     my $token=$1;
     my (undef,$udom,$uname,$file)=split('/',$uri,4);
     if ($udom && $uname && $file) {
 	$file=~s|(\?\.*)*$||;
-        &appenv("userfile.$udom/$uname/$file" => $env{'request.course.id'});
-        return 'http://'.&hostname(&homeserver($uname,$udom)).'/'.$uri.
+        &appenv({"userfile.$udom/$uname/$file" => $env{'request.course.id'}});
+        my $homeserver = &homeserver($uname,$udom);
+        my $protocol = $protocol{$homeserver};
+        $protocol = 'http' if ($protocol ne 'https');
+        return $protocol.'://'.&hostname($homeserver).'/'.$uri.
                (($uri=~/\?/)?'&':'?').'token='.$token.
                                '&tokenissued='.$perlvar{'lonHostID'};
     } else {
@@ -7967,7 +9708,10 @@ sub tokenwrapper {
 sub getuploaded {
     my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_;
     $uri=~s/^\///;
-    $uri = 'http://'.&hostname(&homeserver($cnum,$cdom)).'/raw/'.$uri;
+    my $homeserver = &homeserver($cnum,$cdom);
+    my $protocol = $protocol{$homeserver};
+    $protocol = 'http' if ($protocol ne 'https');
+    $uri = $protocol.'://'.&hostname($homeserver).'/raw/'.$uri;
     my $ua=new LWP::UserAgent;
     my $request=new HTTP::Request($reqtype,$uri);
     my $response=$ua->request($request);
@@ -8009,6 +9753,8 @@ sub filelocation {
     } elsif ($file=~m{^/home/$match_username/public_html/}) {
 	# is a correct contruction space reference
         $location = $file;
+    } elsif ($file =~ m-^\Q$Apache::lonnet::perlvar{'lonTabDir'}\E/-) {
+        $location = $file;
     } elsif ($file=~/^\/*(uploaded|editupload)/) { # is an uploaded file
         my ($udom,$uname,$filename)=
   	    ($file=~m -^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$-);
@@ -8017,8 +9763,7 @@ sub filelocation {
         my @ids=&current_machine_ids();
         foreach my $id (@ids) { if ($id eq $home) { $is_me=1; } }
         if ($is_me) {
-  	    $location=&propath($udom,$uname).
-  	      '/userfiles/'.$filename;
+  	    $location=&propath($udom,$uname).'/userfiles/'.$filename;
         } else {
   	  $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.
   	      $udom.'/'.$uname.'/'.$filename;
@@ -8048,7 +9793,7 @@ sub filelocation {
 
 sub hreflocation {
     my ($dir,$file)=@_;
-    unless (($file=~m-^http://-i) || ($file=~m-^/-)) {
+    unless (($file=~m-^https?\://-i) || ($file=~m-^/-)) {
 	$file=filelocation($dir,$file);
     } elsif ($file=~m-^/adm/-) {
 	$file=~s-^/adm/wrapper/-/-;
@@ -8133,7 +9878,9 @@ sub declutter {
     $thisfn=~s|^adm/wrapper/||;
     $thisfn=~s|^adm/coursedocs/showdoc/||;
     $thisfn=~s/^res\///;
-    $thisfn=~s/\?.+$//;
+    unless (($thisfn =~ /^ext/) || ($thisfn =~ /\.(page|sequence)___\d+___ext/)) {
+        $thisfn=~s/\?.+$//;
+    }
     return $thisfn;
 }
 
@@ -8145,8 +9892,8 @@ sub clutter {
 	|| $thisfn =~ m{^/adm/(includes|pages)} ) { 
        $thisfn='/res'.$thisfn; 
     }
-    if ($thisfn !~m|/adm|) {
-	if ($thisfn =~ m|/ext/|) {
+    if ($thisfn !~m|^/adm|) {
+	if ($thisfn =~ m|^/ext/|) {
 	    $thisfn='/adm/wrapper'.$thisfn;
 	} else {
 	    my ($ext) = ($thisfn =~ /\.(\w+)$/);
@@ -8244,14 +9991,19 @@ sub get_dns {
     open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
     foreach my $dns (<$config>) {
 	next if ($dns !~ /^\^(\S*)/x);
-	$alldns{$1} = 1;
+        my $line = $1;
+        my ($host,$protocol) = split(/:/,$line);
+        if ($protocol ne 'https') {
+            $protocol = 'http';
+        }
+	$alldns{$host} = $protocol;
     }
     while (%alldns) {
 	my ($dns) = keys(%alldns);
-	delete($alldns{$dns});
 	my $ua=new LWP::UserAgent;
-	my $request=new HTTP::Request('GET',"http://$dns$url");
+	my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url");
 	my $response=$ua->request($request);
+        delete($alldns{$dns});
 	next if ($response->is_error());
 	my @content = split("\n",$response->content);
 	&Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60);
@@ -8316,6 +10068,12 @@ sub get_dns {
 	}
 	return $domain{$name}{$what};
     }
+
+    sub domain_info {
+        &load_domain_tab() if (!$loaded);
+        return %domain;
+    }
+
 }
 
 
@@ -8326,20 +10084,39 @@ sub get_dns {
     my %libserv;
     my $loaded;
     my %name_to_host;
+    my %internetdom;
+    my %LC_dns_serv;
 
     sub parse_hosts_tab {
 	my ($file) = @_;
 	foreach my $configline (@$file) {
 	    next if ($configline =~ /^(\#|\s*$ )/x);
-	    next if ($configline =~ /^\^/);
-	    chomp($configline);
-	    my ($id,$domain,$role,$name)=split(/:/,$configline);
+            chomp($configline);
+	    if ($configline =~ /^\^/) {
+                if ($configline =~ /^\^([\w.\-]+)/) {
+                    $LC_dns_serv{$1} = 1;
+                }
+                next;
+            }
+	    my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline);
 	    $name=~s/\s//g;
 	    if ($id && $domain && $role && $name) {
 		$hostname{$id}=$name;
 		push(@{$name_to_host{$name}}, $id);
 		$hostdom{$id}=$domain;
 		if ($role eq 'library') { $libserv{$id}=$name; }
+                if (defined($protocol)) {
+                    if ($protocol eq 'https') {
+                        $protocol{$id} = $protocol;
+                    } else {
+                        $protocol{$id} = 'http'; 
+                    }
+                } else {
+                    $protocol{$id} = 'http';
+                }
+                if (defined($intdom)) {
+                    $internetdom{$id} = $intdom;
+                }
 	    }
 	}
     }
@@ -8384,6 +10161,11 @@ sub get_dns {
 	return %name_to_host;
     }
 
+    sub all_host_domain {
+        &load_hosts_tab() if (!$loaded);
+        return %hostdom;
+    }
+
     sub is_library {
 	&load_hosts_tab() if (!$loaded);
 
@@ -8396,6 +10178,12 @@ sub get_dns {
 	return %libserv;
     }
 
+    sub unique_library {
+	#2x reverse removes all hostnames that appear more than once
+        my %unique = reverse &all_library();
+        return reverse %unique;
+    }
+
     sub get_servers {
 	&load_hosts_tab() if (!$loaded);
 
@@ -8419,6 +10207,11 @@ sub get_dns {
 	return %result;
     }
 
+    sub get_unique_servers {
+        my %unique = reverse &get_servers(@_);
+	return reverse %unique;
+    }
+
     sub host_domain {
 	&load_hosts_tab() if (!$loaded);
 
@@ -8433,6 +10226,21 @@ sub get_dns {
 	my @uniq = grep(!$seen{$_}++, values(%hostdom));
 	return @uniq;
     }
+
+    sub internet_dom {
+        &load_hosts_tab() if (!$loaded);
+
+        my ($lonid) = @_;
+        return $internetdom{$lonid};
+    }
+
+    sub is_LC_dns {
+        &load_hosts_tab() if (!$loaded);
+
+        my ($hostname) = @_;
+        return exists($LC_dns_serv{$hostname});
+    }
+
 }
 
 { 
@@ -8525,6 +10333,65 @@ sub get_dns {
 
 	return %iphost;
     }
+
+    #
+    #  Given a DNS returns the loncapa host name for that DNS 
+    # 
+    sub host_from_dns {
+        my ($dns) = @_;
+        my @hosts;
+        my $ip;
+
+        if (exists($name_to_ip{$dns})) {
+            $ip = $name_to_ip{$dns};
+        }
+        if (!$ip) {
+            $ip = gethostbyname($dns); # Initial translation to IP is in net order.
+            if (length($ip) == 4) { 
+	        $ip   = &IO::Socket::inet_ntoa($ip);
+            }
+        }
+        if ($ip) {
+	    @hosts = get_hosts_from_ip($ip);
+	    return $hosts[0];
+        }
+        return undef;
+    }
+
+    sub get_internet_names {
+        my ($lonid) = @_;
+        return if ($lonid eq '');
+        my ($idnref,$cached)=
+            &Apache::lonnet::is_cached_new('internetnames',$lonid);
+        if ($cached) {
+            return $idnref;
+        }
+        my $ip = &get_host_ip($lonid);
+        my @hosts = &get_hosts_from_ip($ip);
+        my %iphost = &get_iphost();
+        my (@idns,%seen);
+        foreach my $id (@hosts) {
+            my $dom = &host_domain($id);
+            my $prim_id = &domain($dom,'primary');
+            my $prim_ip = &get_host_ip($prim_id);
+            next if ($seen{$prim_ip});
+            if (ref($iphost{$prim_ip}) eq 'ARRAY') {
+                foreach my $id (@{$iphost{$prim_ip}}) {
+                    my $intdom = &internet_dom($id);
+                    unless (grep(/^\Q$intdom\E$/,@idns)) {
+                        push(@idns,$intdom);
+                    }
+                }
+            }
+            $seen{$prim_ip} = 1;
+        }
+        return &Apache::lonnet::do_cache_new('internetnames',$lonid,\@idns,12*60*60);
+    }
+
+}
+
+sub all_loncaparevs {
+    return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10);
 }
 
 BEGIN {
@@ -8602,6 +10469,53 @@ BEGIN {
     close($config);
 }
 
+# ---------------------------------------------------------- Read loncaparev table
+{
+    if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") {
+        if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) {
+            while (my $configline=<$config>) {
+                chomp($configline);
+                my ($hostid,$loncaparev)=split(/:/,$configline);
+                $loncaparevs{$hostid}=$loncaparev;
+            }
+            close($config);
+        }
+    }
+}
+
+# ---------------------------------------------------------- Read serverhostID table
+{
+    if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") {
+        if (open(my $config,"<$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
+            while (my $configline=<$config>) {
+                chomp($configline);
+                my ($name,$id)=split(/:/,$configline);
+                $serverhomeIDs{$name}=$id;
+            }
+            close($config);
+        }
+    }
+}
+
+{
+    my $file = $Apache::lonnet::perlvar{'lonTabDir'}.'/releaseslist.xml';
+    if (-e $file) {
+        my $parser = HTML::LCParser->new($file);
+        while (my $token = $parser->get_token()) {
+            if ($token->[0] eq 'S') {
+                my $item = $token->[1];
+                my $name = $token->[2]{'name'};
+                my $value = $token->[2]{'value'};
+                if ($item ne '' && $name ne '' && $value ne '') {
+                    my $release = $parser->get_text();
+                    $release =~ s/(^\s*|\s*$ )//gx;
+                    $needsrelease{$item.':'.$name.':'.$value} = $release;
+                }
+            }
+        }
+    }
+}
+
 # ------------- set up temporary directory
 {
     $tmpdir = $perlvar{'lonDaemons'}.'/tmp/';
@@ -8614,6 +10528,7 @@ $memcache=new Cache::Memcached({'servers
 
 $processmarker='_'.time.'_'.$perlvar{'lonHostID'};
 $dumpcount=0;
+$locknum=0;
 
 &logtouch();
 &logthis('<font color="yellow">INFO: Read configuration</font>');
@@ -8781,7 +10696,7 @@ when the connection is brought back up
 =item * B<con_failed>: unable to contact remote host and unable to save message
 for later delivery
 
-=item * B<error:>: an error a occured, a description of the error follows the :
+=item * B<error:>: an error a occurred, a description of the error follows the :
 
 =item * B<no_such_host>: unable to fund a host associated with the user/domain
 that was requested
@@ -8796,16 +10711,20 @@ that was requested
 
 =item * 
 X<appenv()>
-B<appenv(%hash)>: the value of %hash is written to
+B<appenv($hashref,$rolesarrayref)>: the value of %{$hashref} is written to
 the user envirnoment file, and will be restored for each access this
 user makes during this session, also modifies the %env for the current
-process
+process. Optional rolesarrayref - if defined contains a reference to an array
+of roles which are exempt from the restriction on modifying user.role entries 
+in the user's environment.db and in %env.    
 
 =item *
 X<delenv()>
-B<delenv($regexp)>: removes all items from the session
-environment file that matches the regular expression in $regexp. The
-values are also delted from the current processes %env.
+B<delenv($delthis,$regexp)>: removes all items from the session
+environment file that begin with $delthis. If the 
+optional second arg - $regexp - is true, $delthis is treated as a 
+regular expression, otherwise \Q$delthis\E is used. 
+The values are also deleted from the current processes %env.
 
 =item * get_env_multiple($name) 
 
@@ -8827,9 +10746,14 @@ authentication scheme
 
 =item *
 X<authenticate()>
-B<authenticate($uname,$upass,$udom)>: try to
+B<authenticate($uname,$upass,$udom,$checkdefauth,$clientcancheckhost)>: try to
 authenticate user from domain's lib servers (first use the current
 one). C<$upass> should be the users password.
+$checkdefauth is optional (value is 1 if a check should be made to
+   authenticate user using default authentication method, and allow
+   account creation if username does not have account in the domain).
+$clientcancheckhost is optional (value is 1 if checking whether the
+   server can host will occur on the client side in lonauth.pm).   
 
 =item *
 X<homeserver()>
@@ -8902,9 +10826,14 @@ and course level
 
 =item *
 
-plaintext($short) : return value in %prp hash (rolesplain.tab); plain text
-explanation of a user role term
-
+plaintext($short,$type,$cid,$forcedefault) : return value in %prp hash 
+(rolesplain.tab); plain text explanation of a user role term.
+$type is Course (default) or Community.
+If $forcedefault evaluates to true, text returned will be default 
+text for $type. Otherwise, if this is a course, the text returned 
+will be a custom name for the role (if defined in the course's 
+environment).  If no custom name is defined the default is returned.
+   
 =item *
 
 get_my_roles($uname,$udom,$context,$types,$roles,$roledoms,$withsec) :
@@ -8929,7 +10858,7 @@ provided for types, will default to retu
 
 =item *
 
-assignrole($udom,$uname,$url,$role,$end,$start) : assign role; give a role to a
+assignrole($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll,$context) : assign role; give a role to a
 user for the level given by URL.  Optional start and end dates (leave empty
 string or zero for "no date")
 
@@ -8946,14 +10875,22 @@ modifyuserauth($udom,$uname,$umode,$upas
 
 =item *
 
-modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene) : 
-modify user
+modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last, $gene,
+           $forceid,$desiredhome,$email,$inststatus,$candelete) :
+
+will update user information (firstname,middlename,lastname,generation,
+permanentemail), and if forceid is true, student/employee ID also.
+A user's institutional affiliation(s) can also be updated.
+User information fields will not be overwritten with empty entries 
+unless the field is included in the $candelete array reference.
+This array is included when a single user is modified via "Manage Users",
+or when Autoupdate.pl is run by cron in a domain.
 
 =item *
 
 modifystudent
 
-modify a students enrollment and identification information.
+modify a student's enrollment and identification information.
 The course id is resolved based on the current users environment.  
 This means the envoking user must be a course coordinator or otherwise
 associated with a course.
@@ -8965,25 +10902,25 @@ Inputs:
 
 =over 4
 
-=item B<$udom> Students loncapa domain
+=item B<$udom> Student's loncapa domain
 
-=item B<$uname> Students loncapa login name
+=item B<$uname> Student's loncapa login name
 
-=item B<$uid> Students id/student number
+=item B<$uid> Student/Employee ID
 
-=item B<$umode> Students authentication mode
+=item B<$umode> Student's authentication mode
 
-=item B<$upass> Students password
+=item B<$upass> Student's password
 
-=item B<$first> Students first name
+=item B<$first> Student's first name
 
-=item B<$middle> Students middle name
+=item B<$middle> Student's middle name
 
-=item B<$last> Students last name
+=item B<$last> Student's last name
 
-=item B<$gene> Students generation
+=item B<$gene> Student's generation
 
-=item B<$usec> Students section in course
+=item B<$usec> Student's section in course
 
 =item B<$end> Unix time of the roles expiration
 
@@ -8993,6 +10930,20 @@ Inputs:
 
 =item B<$desiredhome> server to use as home server for student
 
+=item B<$email> Student's permanent e-mail address
+
+=item B<$type> Type of enrollment (auto or manual)
+
+=item B<$locktype> boolean - enrollment type locked to prevent Autoenroll.pl changing manual to auto    
+
+=item B<$cid> courseID - needed if a course role is assigned by a user whose current role is DC
+
+=item B<$selfenroll> boolean - 1 if user role change occurred via self-enrollment
+
+=item B<$context> role change context (shown in User Management Logs display in a course)
+
+=item B<$inststatus> institutional status of user - : separated string of escaped status types  
+
 =back
 
 =item *
@@ -9026,6 +10977,16 @@ Inputs:
 
 =item $start
 
+=item $type
+
+=item $locktype
+
+=item $cid
+
+=item $selfenroll
+
+=item $context
+
 =back
 
 
@@ -9084,7 +11045,11 @@ database) for a course
 
 =item *
 
-createcourse($udom,$description,$url) : make/modify course
+createcourse($udom,$description,$url,$course_server,$nonstandard,$inst_code,$course_owner,$crstype,$cnum) : make course
+
+=item *
+
+generate_coursenum($udom,$crstype) : get a unique (unused) course number in domain $udom for course type $crstype (Course or Community).
 
 =back
 
@@ -9334,7 +11299,7 @@ Returns:
  'key_exists: <key>' -> failed to anything out of $storehash, as at
                         least <key> already existed in the db (other
                         requested keys may also already exist)
- 'error: <msg>' -> unable to tie the DB or other erorr occured
+ 'error: <msg>' -> unable to tie the DB or other error occurred
  'con_lost' -> unable to contact request server
  'refused' -> action was not allowed by remote machine
 
@@ -9362,6 +11327,18 @@ put_dom($namespace,$storehash,$udom,$uho
 domain level either on specified domain server ($uhome) or primary domain 
 server ($udom and $uhome are optional)
 
+=item * 
+
+get_domain_defaults($target_domain) : returns hash with defaults for
+authentication and language in the domain. Keys are: auth_def, auth_arg_def,
+lang_def; corresponsing values are authentication type (internal, krb4, krb5,
+or localauth), initial password or a kerberos realm, language (e.g., en-us).
+Values are retrieved from cache (if current), or from domain's configuration.db
+(if available), or lastly from values in lonTabs/dns_domain,tab, 
+or lonTabs/domain.tab. 
+
+%domdefaults = &get_auth_defaults($target_domain);
+
 =back
 
 =head2 Network Status Functions
@@ -9376,8 +11353,15 @@ dirlist($uri) : return directory list ba
 
 spareserver() : find server with least workload from spare.tab
 
+
+=item *
+
+host_from_dns($dns) : Returns the loncapa hostname corresponding to a DNS name or undef
+if there is no corresponding loncapa host.
+
 =back
 
+
 =head2 Apache Request
 
 =over 4
@@ -9518,8 +11502,10 @@ userfileupload(): main rotine for puttin
            filename, and the contents of the file to create/modifed exist
            the filename is in $env{'form.'.$formname.'.filename'} and the
            contents of the file is located in $env{'form.'.$formname}
- coursedoc - if true, store the file in the course of the active role
-             of the current user
+ context - if coursedoc, store the file in the course of the active role
+             of the current user; 
+           if 'existingfile': store in 'overwrites' in /home/httpd/perl/tmp
+           if 'canceloverwrite': delete file in tmp/overwrites directory
  subdir - required - subdirectory to put the file in under ../userfiles/
          if undefined, it will be placed in "unknown"
 
@@ -9541,16 +11527,29 @@ returns: the new clean filename
 
 =item *
 
-finishuserfileupload(): routine that creaes and sends the file to
+finishuserfileupload(): routine that creates and sends the file to
 userspace, probably shouldn't be called directly
 
   docuname: username or courseid of destination for the file
   docudom: domain of user/course of destination for the file
   formname: same as for userfileupload()
-  fname: filename (inculding subdirectories) for the file
+  fname: filename (including subdirectories) for the file
+  parser: if 'parse', will parse (html) file to extract references to objects, links etc.
+  allfiles: reference to hash used to store objects found by parser
+  codebase: reference to hash used for codebases of java objects found by parser
+  thumbwidth: width (pixels) of thumbnail to be created for uploaded image
+  thumbheight: height (pixels) of thumbnail to be created for uploaded image
+  resizewidth: width to be used to resize image using resizeImage from ImageMagick
+  resizeheight: height to be used to resize image using resizeImage from ImageMagick
+  context: if 'overwrite', will move the uploaded file from its temporary location to
+            userfiles to facilitate overwriting a previously uploaded file with same name.
+  mimetype: reference to scalar to accommodate mime type determined
+            from File::MMagic if $parser = parse.
 
  returns either the url of the uploaded file (/uploaded/....) if successful
- and /adm/notfound.html if unsuccessful
+ and /adm/notfound.html if unsuccessful (or an error message if context 
+ was 'overwrite').
+ 
 
 =item *