--- loncom/lonnet/perl/lonnet.pm	2016/09/21 04:43:38	1.1321
+++ loncom/lonnet/perl/lonnet.pm	2018/12/27 20:10:56	1.1398
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1321 2016/09/21 04:43:38 raeburn Exp $
+# $Id: lonnet.pm,v 1.1398 2018/12/27 20:10:56 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -71,10 +71,9 @@ delayed.
 package Apache::lonnet;
 
 use strict;
-use LWP::UserAgent();
 use HTTP::Date;
 use Image::Magick;
-
+use CGI::Cookie;
 
 use Encode;
 
@@ -101,6 +100,7 @@ use LONCAPA qw(:DEFAULT :match);
 use LONCAPA::Configuration;
 use LONCAPA::lonmetadata;
 use LONCAPA::Lond;
+use LONCAPA::LWPReq;
 
 use File::Copy;
 
@@ -146,7 +146,7 @@ our @EXPORT = qw(%env);
 sub logtouch {
     my $execdir=$perlvar{'lonDaemons'};
     unless (-e "$execdir/logs/lonnet.log") {	
-	open(my $fh,">>$execdir/logs/lonnet.log");
+	open(my $fh,">>","$execdir/logs/lonnet.log");
 	close $fh;
     }
     my ($wwwuid,$wwwgid)=(getpwnam('www'))[2,3];
@@ -158,7 +158,7 @@ sub logthis {
     my $execdir=$perlvar{'lonDaemons'};
     my $now=time;
     my $local=localtime($now);
-    if (open(my $fh,">>$execdir/logs/lonnet.log")) {
+    if (open(my $fh,">>","$execdir/logs/lonnet.log")) {
 	my $logstring = $local. " ($$): ".$message."\n"; # Keep any \'s in string.
 	print $fh $logstring;
 	close($fh);
@@ -171,7 +171,7 @@ sub logperm {
     my $execdir=$perlvar{'lonDaemons'};
     my $now=time;
     my $local=localtime($now);
-    if (open(my $fh,">>$execdir/logs/lonnet.perm.log")) {
+    if (open(my $fh,">>","$execdir/logs/lonnet.perm.log")) {
 	print $fh "$now:$message:$local\n";
 	close($fh);
     }
@@ -230,30 +230,38 @@ sub get_server_distarch {
 }
 
 sub get_servercerts_info {
-    my ($lonhost,$context) = @_;
+    my ($lonhost,$hostname,$context) = @_;
+    return if ($lonhost eq '');
+    if ($hostname eq '') {
+        $hostname = &hostname($lonhost);
+    }
+    return if ($hostname eq '');
     my ($rep,$uselocal);
-    if (grep { $_ eq $lonhost } &current_machine_ids()) {
+    if ($context eq 'install') {
+        $uselocal = 1;
+    } elsif (grep { $_ eq $lonhost } &current_machine_ids()) {
         $uselocal = 1;
     }
-    if (($context ne 'cgi') && ($uselocal)) {
+    if (($context ne 'cgi') && ($context ne 'install') && ($uselocal)) {
         my $distro = (split(/\:/,&get_server_distarch($lonhost)))[0];
-        if ($distro =~ /^(?:centos|redhat|scientific)(\d+)$/) {
+        if ($distro eq '') {
+            $uselocal = 0;
+        } elsif ($distro =~ /^(?:centos|redhat|scientific)(\d+)$/) {
             if ($1 < 6) {
                 $uselocal = 0;
             }
+        }  elsif ($distro =~ /^(?:sles)(\d+)$/) {
+            if ($1 < 12) {
+                $uselocal = 0;
+            }
         }
     }
     if ($uselocal) {
-        $rep = LONCAPA::Lond::server_certs(\%perlvar);
+        $rep = LONCAPA::Lond::server_certs(\%perlvar,$lonhost,$hostname);
     } else {
         $rep=&reply('servercerts',$lonhost);
     }
     my ($result,%returnhash);
-    if (defined($lonhost)) {
-        if (!defined(&hostname($lonhost))) {
-            return;
-        }
-    }
     if (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') ||
         ($rep eq 'unknown_cmd')) {
         $result = $rep;
@@ -303,13 +311,12 @@ sub get_server_loncaparev {
             $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 $hostname = &hostname($lonhost);
                     my $protocol = $protocol{$lonhost};
                     $protocol = 'http' if ($protocol ne 'https');
-                    my $url = $protocol.'://'.&hostname($lonhost).'/adm/about.html';
+                    my $url = $protocol.'://'.$hostname.'/adm/about.html';
                     my $request=new HTTP::Request('GET',$url);
-                    my $response=$ua->request($request);
+                    my $response=&LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,4,1);
                     unless ($response->is_error()) {
                         my $content = $response->content;
                         if ($content =~ /<p>VERSION\:\s*([\w.\-]+)<\/p>/) {
@@ -452,8 +459,26 @@ sub reply {
     unless (defined(&hostname($server))) { return 'no_such_host'; }
     my $answer=subreply($cmd,$server);
     if (($answer=~/^refused/) || ($answer=~/^rejected/)) {
-       &logthis("<font color=\"blue\">WARNING:".
-                " $cmd to $server returned $answer</font>");
+        my $logged = $cmd;
+        if ($cmd =~ /^encrypt:([^:]+):/) {
+            my $subcmd = $1;
+            if (($subcmd eq 'auth') || ($subcmd eq 'passwd') ||
+                ($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') ||
+                ($subcmd eq 'putdom') || ($subcmd eq 'autoexportgrades')) {
+                (undef,undef,my @rest) = split(/:/,$cmd);
+                if (($subcmd eq 'auth') || ($subcmd eq 'putdom')) {
+                    splice(@rest,2,1,'Hidden');
+                } elsif ($subcmd eq 'passwd') {
+                    splice(@rest,2,2,('Hidden','Hidden'));
+                } elsif (($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') ||
+                         ($subcmd eq 'autoexportgrades')) {
+                    splice(@rest,3,1,'Hidden');
+                }
+                $logged = join(':',('encrypt:'.$subcmd,@rest));
+            }
+        }
+        &logthis("<font color=\"blue\">WARNING:".
+                 " $logged to $server returned $answer</font>");
     }
     return $answer;
 }
@@ -481,7 +506,7 @@ sub reconlonc {
 
     &logthis("Trying to reconnect lonc");
     my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
-    if (open(my $fh,"<$loncfile")) {
+    if (open(my $fh,"<",$loncfile)) {
 	my $loncpid=<$fh>;
         chomp($loncpid);
         if (kill 0 => $loncpid) {
@@ -521,7 +546,7 @@ sub critical {
             $dumpcount++;
             {
 		my $dfh;
-		if (open($dfh,">$dfilename")) {
+		if (open($dfh,">",$dfilename)) {
 		    print $dfh "$cmd\n"; 
 		    close($dfh);
 		}
@@ -530,7 +555,7 @@ sub critical {
             my $wcmd='';
             {
 		my $dfh;
-		if (open($dfh,"<$dfilename")) {
+		if (open($dfh,"<",$dfilename)) {
 		    $wcmd=<$dfh>; 
 		    close($dfh);
 		}
@@ -646,22 +671,52 @@ sub transfer_profile_to_env {
 
 # ---------------------------------------------------- Check for valid session 
 sub check_for_valid_session {
-    my ($r,$name,$userhashref) = @_;
+    my ($r,$name,$userhashref,$domref) = @_;
     my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
-    if ($name eq '') {
-        $name = 'lonID';
-    }
-    my $lonid=$cookies{$name};
-    return undef if (!$lonid);
-
-    my $handle=&LONCAPA::clean_handle($lonid->value);
-    my $lonidsdir;
+    my ($lonidsdir,$linkname,$pubname,$secure,$lonid);
     if ($name eq 'lonDAV') {
         $lonidsdir=$r->dir_config('lonDAVsessDir');
     } else {
         $lonidsdir=$r->dir_config('lonIDsDir');
+        if ($name eq '') {
+            $name = 'lonID';
+        }
+    }
+    if ($name eq 'lonID') {
+        $secure = 'lonSID';
+        $linkname = 'lonLinkID';
+        $pubname = 'lonPubID';
+        if (exists($cookies{$secure})) {
+            $lonid=$cookies{$secure};
+        } elsif (exists($cookies{$name})) {
+            $lonid=$cookies{$name};
+        } elsif (exists($cookies{$linkname})) {
+            $lonid=$cookies{$linkname};
+        } elsif (exists($cookies{$pubname})) {
+            $lonid=$cookies{$pubname};
+        }
+    } else {
+        $lonid=$cookies{$name};
+    }
+    return undef if (!$lonid);
+
+    my $handle=&LONCAPA::clean_handle($lonid->value);
+    if (-l "$lonidsdir/$handle.id") {
+        my $link = readlink("$lonidsdir/$handle.id");
+        if ((-e $link) && ($link =~ m{^\Q$lonidsdir\E/(.+)\.id$})) {
+            $handle = $1;
+        }
+    }
+    if (!-e "$lonidsdir/$handle.id") {
+        if ((ref($domref)) && ($name eq 'lonID') && 
+            ($handle =~ /^($match_username)\_\d+\_($match_domain)\_(.+)$/)) {
+            my ($possuname,$possudom,$possuhome) = ($1,$2,$3);
+            if ((&domain($possudom) ne '') && (&homeserver($possuname,$possudom) eq $possuhome)) {
+                $$domref = $possudom;
+            }
+        }
+        return undef;
     }
-    return undef if (!-e "$lonidsdir/$handle.id");
 
     my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");
     return undef if (!$opened);
@@ -675,13 +730,20 @@ sub check_for_valid_session {
 
     if (!defined($disk_env{'user.name'})
 	|| !defined($disk_env{'user.domain'})) {
+        untie(%disk_env);
 	return undef;
     }
 
     if (ref($userhashref) eq 'HASH') {
         $userhashref->{'name'} = $disk_env{'user.name'};
         $userhashref->{'domain'} = $disk_env{'user.domain'};
+        $userhashref->{'lti'} = $disk_env{'request.lti.login'};
+        if ($userhashref->{'lti'}) {
+            $userhashref->{'ltitarget'} = $disk_env{'request.lti.target'};
+            $userhashref->{'ltiuri'} = $disk_env{'request.lti.uri'};
+        }
     }
+    untie(%disk_env);
 
     return $handle;
 }
@@ -706,6 +768,37 @@ sub timed_flock {
     }
 }
 
+sub get_sessionfile_vars {
+    my ($handle,$lonidsdir,$storearr) = @_;
+    my %returnhash;
+    unless (ref($storearr) eq 'ARRAY') {
+        return %returnhash;
+    }
+    if (-l "$lonidsdir/$handle.id") {
+        my $link = readlink("$lonidsdir/$handle.id");
+        if ((-e $link) && ($link =~ m{^\Q$lonidsdir\E/(.+)\.id$})) {
+            $handle = $1;
+        }
+    }
+    if ((-e "$lonidsdir/$handle.id") &&
+        ($handle =~ /^($match_username)\_\d+\_($match_domain)\_(.+)$/)) {
+        my ($possuname,$possudom,$possuhome) = ($1,$2,$3);
+        if ((&domain($possudom) ne '') && (&homeserver($possuname,$possudom) eq $possuhome)) {
+            if (open(my $idf,'+<',"$lonidsdir/$handle.id")) {
+                flock($idf,LOCK_SH);
+                if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",
+                        &GDBM_READER(),0640)) {
+                    foreach my $item (@{$storearr}) {
+                        $returnhash{$item} = $disk_env{$item};
+                    }
+                    untie(%disk_env);
+                }
+            }
+        }
+    }
+    return %returnhash;
+}
+
 # ---------------------------------------------------------- Append Environment
 
 sub appenv {
@@ -731,16 +824,19 @@ sub appenv {
                 $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 $lonids = $perlvar{'lonIDsDir'};
+        if ($env{'user.environment'} =~ m{^\Q$lonids/\E$match_username\_\d+\_$match_domain\_[\w\-.]+\.id$}) {
+            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';
@@ -856,6 +952,7 @@ sub userload {
 	while ($filename=readdir(LONIDS)) {
 	    next if ($filename eq '.' || $filename eq '..');
 	    next if ($filename =~ /publicuser_\d+\.id/);
+            next if ($filename =~ /^[a-f0-9]+_linked\.id$/);
 	    my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9];
 	    if ($curtime-$mtime < 1800) { $numusers++; }
 	}
@@ -911,13 +1008,13 @@ sub spareserver {
     }
 
     if (!$want_server_name) {
-        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)) {
+                my $protocol = 'http';
+                if ($protocol{$spare_server} eq 'https') {
+                    $protocol = $protocol{$spare_server};
+                }
 	        $spare_server = $protocol.'://'.$hostname;
             }
         }
@@ -984,6 +1081,75 @@ sub find_existing_session {
     return;
 }
 
+# check if user's browser sent load balancer cookie and server still has session
+# and is not overloaded.
+sub check_for_balancer_cookie {
+    my ($r,$update_mtime) = @_;
+    my ($otherserver,$cookie);
+    my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
+    if (exists($cookies{'balanceID'})) {
+        my $balid = $cookies{'balanceID'};
+        $cookie=&LONCAPA::clean_handle($balid->value);
+        my $balancedir=$r->dir_config('lonBalanceDir');
+        if ((-d $balancedir) && (-e "$balancedir/$cookie.id")) {
+            if ($cookie =~ /^($match_domain)_($match_username)_[a-f0-9]+$/) {
+                my ($possudom,$possuname) = ($1,$2);
+                my $has_session = 0;
+                if ((&domain($possudom) ne '') &&
+                    (&homeserver($possuname,$possudom) ne 'no_host')) {
+                    my $try_server;
+                    my $opened = open(my $idf,'+<',"$balancedir/$cookie.id");
+                    if ($opened) {
+                        flock($idf,LOCK_SH);
+                        while (my $line = <$idf>) {
+                            chomp($line);
+                            if (&hostname($line) ne '') {
+                                $try_server = $line;
+                                last;
+                            }
+                        }
+                        close($idf);
+                        if (($try_server) &&
+                            (&has_user_session($try_server,$possudom,$possuname))) {
+                            my $lowest_load = 30000;
+                            ($otherserver,$lowest_load) =
+                                &compare_server_load($try_server,undef,$lowest_load);
+                            if ($otherserver ne '' && $lowest_load < 100) {
+                                $has_session = 1;
+                            } else {
+                                undef($otherserver);
+                            }
+                        }
+                    }
+                }
+                if ($has_session) {
+                    if ($update_mtime) {
+                        my $atime = my $mtime = time;
+                        utime($atime,$mtime,"$balancedir/$cookie.id");
+                    }
+                } else {
+                    unlink("$balancedir/$cookie.id");
+                }
+            }
+        }
+    }
+    return ($otherserver,$cookie);
+}
+
+sub delbalcookie {
+    my ($cookie,$balancer) =@_;
+    if ($cookie =~ /^($match_domain)\_($match_username)\_[a-f0-9]{32}$/) {
+        my ($udom,$uname) = ($1,$2);
+        my $uprimary_id = &domain($udom,'primary');
+        my $uintdom = &internet_dom($uprimary_id);
+        my $intdom = &internet_dom($balancer);
+        my $serverhomedom = &host_domain($balancer);
+        if (($uintdom ne '') && ($uintdom eq $intdom)) {
+            return &reply("delbalcookie:$cookie",$balancer);
+        }
+    }
+}
+
 # -------------------------------- ask if server already has a session for user
 sub has_user_session {
     my ($lonid,$udom,$uname) = @_;
@@ -1019,7 +1185,7 @@ sub choose_server {
             if (ref($balancers) eq 'HASH') {
                 next if (exists($balancers->{$lonhost}));
             }
-        }   
+        }
         my $loginvia;
         if ($checkloginvia) {
             $loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost};
@@ -1047,7 +1213,7 @@ sub choose_server {
     if ($login_host ne '') {
         $hostname = &hostname($login_host);
     }
-    return ($login_host,$hostname,$portal_path,$isredirect);
+    return ($login_host,$hostname,$portal_path,$isredirect,$lowest_load);
 }
 
 # --------------------------------------------- Try to change a user's password
@@ -1319,9 +1485,9 @@ sub get_lonbalancer_config {
 }
 
 sub check_loadbalancing {
-    my ($uname,$udom) = @_;
+    my ($uname,$udom,$caller) = @_;
     my ($is_balancer,$currtargets,$currrules,$dom_in_use,$homeintdom,
-        $rule_in_effect,$offloadto,$otherserver);
+        $rule_in_effect,$offloadto,$otherserver,$setcookie,$dom_balancers);
     my $lonhost = $perlvar{'lonHostID'};
     my @hosts = &current_machine_ids();
     my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
@@ -1348,7 +1514,7 @@ sub check_loadbalancing {
         }
     }
     if (ref($result) eq 'HASH') {
-        ($is_balancer,$currtargets,$currrules) = 
+        ($is_balancer,$currtargets,$currrules,$setcookie,$dom_balancers) =
             &check_balancer_result($result,@hosts);
         if ($is_balancer) {
             if (ref($currrules) eq 'HASH') {
@@ -1409,7 +1575,7 @@ sub check_loadbalancing {
             }
         }
         if (ref($result) eq 'HASH') {
-            ($is_balancer,$currtargets,$currrules) = 
+            ($is_balancer,$currtargets,$currrules,$setcookie,$dom_balancers) =
                 &check_balancer_result($result,@hosts);
             if ($is_balancer) {
                 if (ref($currrules) eq 'HASH') {
@@ -1470,23 +1636,27 @@ sub check_loadbalancing {
                 }
             }
         }
-        if (($otherserver ne '') && (grep(/^\Q$otherserver\E$/,@hosts))) {
-            $is_balancer = 0;
-            if ($uname ne '' && $udom ne '') {
-                if (($env{'user.name'} eq $uname) && ($env{'user.domain'} eq $udom)) {
-                    
-                    &appenv({'user.loadbalexempt'     => $lonhost,  
-                             'user.loadbalcheck.time' => time});
+        unless ($caller eq 'login') {
+            if (($otherserver ne '') && (grep(/^\Q$otherserver\E$/,@hosts))) {
+                $is_balancer = 0;
+                if ($uname ne '' && $udom ne '') {
+                    if (($env{'user.name'} eq $uname) && ($env{'user.domain'} eq $udom)) {
+                        &appenv({'user.loadbalexempt'     => $lonhost,
+                                 'user.loadbalcheck.time' => time});
+                    }
                 }
             }
         }
+        unless ($homeintdom) {
+            undef($setcookie);
+        }
     }
-    return ($is_balancer,$otherserver);
+    return ($is_balancer,$otherserver,$setcookie,$offloadto,$dom_balancers);
 }
 
 sub check_balancer_result {
     my ($result,@hosts) = @_;
-    my ($is_balancer,$currtargets,$currrules);
+    my ($is_balancer,$currtargets,$currrules,$setcookie,$dom_balancers);
     if (ref($result) eq 'HASH') {
         if ($result->{'lonhost'} ne '') {
             my $currbalancer = $result->{'lonhost'};
@@ -1495,19 +1665,24 @@ sub check_balancer_result {
                 $currtargets = $result->{'targets'};
                 $currrules = $result->{'rules'};
             }
+            $dom_balancers = $currbalancer;
         } else {
-            foreach my $key (keys(%{$result})) {
-                if (($key ne '') && (grep(/^\Q$key\E$/,@hosts)) &&
-                    (ref($result->{$key}) eq 'HASH')) {
-                    $is_balancer = 1;
-                    $currrules = $result->{$key}{'rules'};
-                    $currtargets = $result->{$key}{'targets'};
-                    last;
+            if (keys(%{$result})) {
+                foreach my $key (keys(%{$result})) {
+                    if (($key ne '') && (grep(/^\Q$key\E$/,@hosts)) &&
+                        (ref($result->{$key}) eq 'HASH')) {
+                        $is_balancer = 1;
+                        $currrules = $result->{$key}{'rules'};
+                        $currtargets = $result->{$key}{'targets'};
+                        $setcookie = $result->{$key}{'cookie'};
+                        last;
+                    }
                 }
+                $dom_balancers = join(',',sort(keys(%{$result})));
             }
         }
     }
-    return ($is_balancer,$currtargets,$currrules);
+    return ($is_balancer,$currtargets,$currrules,$setcookie,$dom_balancers);
 }
 
 sub get_loadbalancer_targets {
@@ -1579,6 +1754,101 @@ sub internet_dom_servers {
     return %uniqservers;
 }
 
+sub trusted_domains {
+    my ($cmdtype,$calldom) = @_;
+    my ($trusted,$untrusted);
+    if (&domain($calldom) eq '') {
+        return ($trusted,$untrusted);
+    }
+    unless ($cmdtype =~ /^(content|shared|enroll|coaurem|othcoau|domroles|catalog|reqcrs|msg)$/) {
+        return ($trusted,$untrusted);
+    }
+    my $callprimary = &domain($calldom,'primary');
+    my $intcalldom = &Apache::lonnet::internet_dom($callprimary);
+    if ($intcalldom eq '') {
+        return ($trusted,$untrusted);
+    }
+
+    my ($trustconfig,$cached)=&Apache::lonnet::is_cached_new('trust',$calldom);
+    unless (defined($cached)) {
+        my %domconfig = &Apache::lonnet::get_dom('configuration',['trust'],$calldom);
+        &Apache::lonnet::do_cache_new('trust',$calldom,$domconfig{'trust'},3600);
+        $trustconfig = $domconfig{'trust'};
+    }
+    if (ref($trustconfig)) {
+        my (%possexc,%possinc,@allexc,@allinc); 
+        if (ref($trustconfig->{$cmdtype}) eq 'HASH') {
+            if (ref($trustconfig->{$cmdtype}->{'exc'}) eq 'ARRAY') {
+                map { $possexc{$_} = 1; } @{$trustconfig->{$cmdtype}->{'exc'}}; 
+            }
+            if (ref($trustconfig->{$cmdtype}->{'inc'}) eq 'ARRAY') {
+                $possinc{$intcalldom} = 1;
+                map { $possinc{$_} = 1; } @{$trustconfig->{$cmdtype}->{'inc'}};
+            }
+        }
+        if (keys(%possexc)) {
+            if (keys(%possinc)) {
+                foreach my $key (sort(keys(%possexc))) {
+                    next if ($key eq $intcalldom);
+                    unless ($possinc{$key}) {
+                        push(@allexc,$key);
+                    }
+                }
+            } else {
+                @allexc = sort(keys(%possexc));
+            }
+        }
+        if (keys(%possinc)) {
+            $possinc{$intcalldom} = 1;
+            @allinc = sort(keys(%possinc));
+        }
+        if ((@allexc > 0) || (@allinc > 0)) {
+            my %doms_by_intdom;
+            my %allintdoms = &all_host_intdom();
+            my %alldoms = &all_host_domain();
+            foreach my $key (%allintdoms) {
+                if (ref($doms_by_intdom{$allintdoms{$key}}) eq 'ARRAY') {
+                    unless (grep(/^\Q$alldoms{$key}\E$/,@{$doms_by_intdom{$allintdoms{$key}}})) {
+                        push(@{$doms_by_intdom{$allintdoms{$key}}},$alldoms{$key});
+                    }
+                } else {
+                    $doms_by_intdom{$allintdoms{$key}} = [$alldoms{$key}]; 
+                }
+            }
+            foreach my $exc (@allexc) {
+                if (ref($doms_by_intdom{$exc}) eq 'ARRAY') {
+                    push(@{$untrusted},@{$doms_by_intdom{$exc}});
+                }
+            }
+            foreach my $inc (@allinc) {
+                if (ref($doms_by_intdom{$inc}) eq 'ARRAY') {
+                    push(@{$trusted},@{$doms_by_intdom{$inc}});
+                }
+            }
+        }
+    }
+    return ($trusted,$untrusted);
+}
+
+sub will_trust {
+    my ($cmdtype,$domain,$possdom) = @_;
+    return 1 if ($domain eq $possdom);
+    my ($trustedref,$untrustedref) = &trusted_domains($cmdtype,$possdom);
+    my $willtrust; 
+    if ((ref($trustedref) eq 'ARRAY') && (@{$trustedref} > 0)) {
+        if (grep(/^\Q$domain\E$/,@{$trustedref})) {
+            $willtrust = 1;
+        }
+    } elsif ((ref($untrustedref) eq 'ARRAY') && (@{$untrustedref} > 0)) {
+        unless (grep(/^\Q$domain\E$/,@{$untrustedref})) {
+            $willtrust = 1;
+        }
+    } else {
+        $willtrust = 1;
+    }
+    return $willtrust;
+}
+
 # ---------------------- Find the homebase for a user from domain's lib servers
 
 my %homecache;
@@ -1828,7 +2098,12 @@ sub get_dom {
         }
     }
     if ($udom && $uhome && ($uhome ne 'no_host')) {
-        my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
+        my $rep;
+        if ($namespace =~ /^enc/) {
+            $rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome);
+        } else {
+            $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
+        }
         my %returnhash;
         if ($rep eq '' || $rep =~ /^error: 2 /) {
             return %returnhash;
@@ -1872,7 +2147,11 @@ sub put_dom {
             $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
         }
         $items=~s/\&$//;
-        return &reply("putdom:$udom:$namespace:$items",$uhome);
+        if ($namespace =~ /^enc/) {
+            return &reply("encrypt:putdom:$udom:$namespace:$items",$uhome);
+        } else {
+            return &reply("putdom:$udom:$namespace:$items",$uhome);
+        }
     } else {
         &logthis("put_dom failed - no homeserver and/or domain");
     }
@@ -1963,13 +2242,23 @@ sub inst_directory_query {
     my $homeserver = &domain($udom,'primary');
     my $outcome;
     if ($homeserver ne '') {
+        unless ($homeserver eq $perlvar{'lonHostID'}) {
+            if ($srch->{'srchby'} eq 'email') {
+                my $lcrev = &get_server_loncaparev(undef,$homeserver);
+                my ($major,$minor) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
+                if (($major eq '' && $minor eq '') || ($major < 2) ||
+                    (($major == 2) && ($minor < 12))) {
+                    return;
+                }
+            }
+        }
 	my $queryid=&reply("querysend:instdirsearch:".
 			   &escape($srch->{'srchby'}).':'.
 			   &escape($srch->{'srchterm'}).':'.
 			   &escape($srch->{'srchtype'}),$homeserver);
 	my $host=&hostname($homeserver);
 	if ($queryid !~/^\Q$host\E\_/) {
-	    &logthis('instituional directory search invalid queryid: '.$queryid.' for host: '.$homeserver.'in domain '.$udom);
+	    &logthis('institutional directory search invalid queryid: '.$queryid.' for host: '.$homeserver.' in domain '.$udom);
 	    return;
 	}
 	my $response = &get_query_reply($queryid);
@@ -2004,6 +2293,14 @@ sub usersearch {
     my $query = 'usersearch';
     foreach my $tryserver (keys(%libserv)) {
         if (&host_domain($tryserver) eq $dom) {
+            unless ($tryserver eq $perlvar{'lonHostID'}) {
+                if ($srch->{'srchby'} eq 'email') {
+                    my $lcrev = &get_server_loncaparev(undef,$tryserver);
+                    my ($major,$minor) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
+                    next if (($major eq '' && $minor eq '') || ($major < 2) ||
+                             (($major == 2) && ($minor < 12)));
+                }
+            }
             my $host=&hostname($tryserver);
             my $queryid=
                 &reply("querysend:".&escape($query).':'.
@@ -2243,7 +2540,7 @@ sub get_domain_defaults {
                                   'coursedefaults','usersessions',
                                   'requestauthor','selfenrollment',
                                   'coursecategories','ssl','autoenroll',
-                                  'trust'],$domain);
+                                  'trust','helpsettings'],$domain);
     my @coursetypes = ('official','unofficial','community','textbook','placement');
     if (ref($domconfig{'defaults'}) eq 'HASH') {
         $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; 
@@ -2252,6 +2549,9 @@ sub get_domain_defaults {
         $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};
         $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'};
         $domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_def'};
+        $domdefaults{'intauth_cost'} = $domconfig{'defaults'}{'intauth_cost'};
+        $domdefaults{'intauth_switch'} = $domconfig{'defaults'}{'intauth_switch'};
+        $domdefaults{'intauth_check'} = $domconfig{'defaults'}{'intauth_check'};
     } else {
         $domdefaults{'lang_def'} = &domain($domain,'lang_def');
         $domdefaults{'auth_def'} = &domain($domain,'auth_def');
@@ -2319,6 +2619,9 @@ sub get_domain_defaults {
         } elsif ($domconfig{'coursedefaults'}{'canclone'}) {
             $domdefaults{'canclone'}=$domconfig{'coursedefaults'}{'canclone'};
         }
+        if ($domconfig{'coursedefaults'}{'texengine'}) {
+            $domdefaults{'texengine'} = $domconfig{'coursedefaults'}{'texengine'};
+        } 
     }
     if (ref($domconfig{'usersessions'}) eq 'HASH') {
         if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') {
@@ -2373,8 +2676,11 @@ sub get_domain_defaults {
         if (ref($domconfig{'ssl'}{'replication'}) eq 'HASH') {
             $domdefaults{'replication'} = $domconfig{'ssl'}{'replication'};
         }
-        if (ref($domconfig{'ssl'}{'connect'}) eq 'HASH') {
-            $domdefaults{'connect'} = $domconfig{'ssl'}{'connect'};
+        if (ref($domconfig{'ssl'}{'connto'}) eq 'HASH') {
+            $domdefaults{'connect'} = $domconfig{'ssl'}{'connto'};
+        }
+        if (ref($domconfig{'ssl'}{'connfrom'}) eq 'HASH') {
+            $domdefaults{'connect'} = $domconfig{'ssl'}{'connfrom'};
         }
     }
     if (ref($domconfig{'trust'}) eq 'HASH') {
@@ -2388,6 +2694,12 @@ sub get_domain_defaults {
     if (ref($domconfig{'autoenroll'}) eq 'HASH') {
         $domdefaults{'autofailsafe'} = $domconfig{'autoenroll'}{'autofailsafe'};
     }
+    if (ref($domconfig{'helpsettings'}) eq 'HASH') {
+        $domdefaults{'submitbugs'} = $domconfig{'helpsettings'}{'submitbugs'};
+        if (ref($domconfig{'helpsettings'}{'adhoc'}) eq 'HASH') {
+            $domdefaults{'adhocroles'} = $domconfig{'helpsettings'}{'adhoc'};
+        }
+    }
     &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);
     return %domdefaults;
 }
@@ -2915,9 +3227,13 @@ sub repcopy {
 		   mkdir($path,0777);
                }
            }
-           my $ua=new LWP::UserAgent;
            my $request=new HTTP::Request('GET',"$remoteurl");
-           my $response=$ua->request($request,$transname);
+           my $response;
+           if ($remoteurl =~ m{/raw/}) {
+               $response=&LONCAPA::LWPReq::makerequest($home,$request,$transname,\%perlvar,'',0,1);
+           } else {
+               $response=&LONCAPA::LWPReq::makerequest($home,$request,$transname,\%perlvar,'',1);
+           }
            if ($response->is_error()) {
 	       unlink($transname);
                my $message=$response->status_line;
@@ -2927,7 +3243,12 @@ sub repcopy {
            } else {
 	       if ($remoteurl!~/\.meta$/) {
                   my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta');
-                  my $mresponse=$ua->request($mrequest,$filename.'.meta');
+                  my $mresponse;
+                  if ($remoteurl =~ m{/raw/}) {
+                      $mresponse = &LONCAPA::LWPReq::makerequest($home,$mrequest,$filename.'.meta',\%perlvar,'',0,1);
+                  } else {
+                      $mresponse = &LONCAPA::LWPReq::makerequest($home,$mrequest,$filename.'.meta',\%perlvar,'',1);
+                  }
                   if ($mresponse->is_error()) {
 		      unlink($filename.'.meta');
                       &logthis(
@@ -2990,7 +3311,6 @@ sub absolute_url {
 sub ssi {
 
     my ($fn,%form)=@_;
-    my $ua=new LWP::UserAgent;
     my $request;
 
     $form{'no_update_last_known'}=1;
@@ -3008,22 +3328,30 @@ sub ssi {
     }
 
     $request->header(Cookie => $ENV{'HTTP_COOKIE'});
-    my $response= $ua->request($request);
-    my $content = $response->content;
-
+    my $lonhost = $perlvar{'lonHostID'};
+    my $islocal;
+    if (($env{'request.course.id'}) &&
+        ($form{'grade_courseid'} eq $env{'request.course.id'}) &&
+        ($form{'grade_username'} ne '') && ($form{'grade_domain'} ne '') &&
+        ($form{'grade_symb'} ne '') &&
+        (&Apache::lonnet::allowed('mgr',$env{'request.course.id'}.
+                                 ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) {
+        $islocal = 1;
+    }
+    my $response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,
+                                                '','','',$islocal);
 
     if (wantarray) {
-	return ($content, $response);
+	return ($response->content, $response);
     } else {
-	return $content;
+	return $response->content;
     }
 }
 
 sub externalssi {
     my ($url)=@_;
-    my $ua=new LWP::UserAgent;
     my $request=new HTTP::Request('GET',$url);
-    my $response=$ua->request($request);
+    my $response = &LONCAPA::LWPReq::makerequest('',$request,'',\%perlvar);
     if (wantarray) {
         return ($response->content, $response);
     } else {
@@ -3031,6 +3359,71 @@ sub externalssi {
     }
 }
 
+
+# If the local copy of a replicated resource is outdated, trigger a  
+# connection from the homeserver to flush the delayed queue. If no update 
+# happens, remove local copies of outdated resource (and corresponding
+# metadata file).
+
+sub remove_stale_resfile {
+    my ($url) = @_;
+    my $removed;
+    if ($url=~m{^/res/($match_domain)/($match_username)/}) {
+        my $audom = $1;
+        my $auname = $2;
+        unless (($url =~ /\.\d+\.\w+$/) || ($url =~ m{^/res/lib/templates/})) {
+            my $homeserver = &homeserver($auname,$audom);
+            unless (($homeserver eq 'no_host') ||
+                    (grep { $_ eq $homeserver } &current_machine_ids())) {
+                my $fname = &filelocation('',$url);
+                if (-e $fname) {
+                    my $hostname = &hostname($homeserver);
+                    if ($hostname) {
+                        my $protocol = $protocol{$homeserver};
+                        $protocol = 'http' if ($protocol ne 'https');
+                        my $uri = &declutter($url);
+                        my $request=new HTTP::Request('HEAD',$protocol.'://'.$hostname.'/raw/'.$uri);
+                        my $response = &LONCAPA::LWPReq::makerequest($homeserver,$request,'',\%perlvar,5,0,1);
+                        if ($response->is_success()) {
+                            my $remmodtime = &HTTP::Date::str2time( $response->header('Last-modified') );
+                            my $locmodtime = (stat($fname))[9];
+                            if ($locmodtime < $remmodtime) {
+                                my $stale;
+                                my $answer = &reply('pong',$homeserver);
+                                if ($answer eq $homeserver.':'.$perlvar{'lonHostID'}) {
+                                    sleep(0.2);
+                                    $locmodtime = (stat($fname))[9];
+                                    if ($locmodtime < $remmodtime) {
+                                        my $posstransfer = $fname.'.in.transfer';
+                                        if ((-e $posstransfer) && ($remmodtime < (stat($posstransfer))[9])) {
+                                            $removed = 1;
+                                        } else {
+                                            $stale = 1;
+                                        }
+                                    } else {
+                                        $removed = 1;
+                                    }
+                                } else {
+                                    $stale = 1;
+                                }
+                                if ($stale) {
+                                    unlink($fname);
+                                    if ($uri!~/\.meta$/) {
+                                        unlink($fname.'.meta');
+                                    }
+                                    &reply("unsub:$fname",$homeserver);
+                                    $removed = 1;
+                                }
+                            }
+                        }
+                    }
+                }
+            }
+        }
+    }
+    return $removed;
+}
+
 # -------------------------------- Allow a /uploaded/ URI to be vouched for
 
 sub allowuploaded {
@@ -3169,7 +3562,7 @@ sub can_edit_resource {
                         $forceedit = 1;
                     }
                     $cfile = $resurl;
-                } elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/exttools?$}) {
+                } elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) {
                     $incourse = 1;
                     if ($env{'form.forceedit'}) {
                         $forceview = 1;
@@ -3201,7 +3594,7 @@ sub can_edit_resource {
                         $forceedit = 1;
                     }
                     $cfile = $resurl;
-            } elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/exttools?$}) && ($env{'form.folderpath'} =~ /^supplemental/)) {
+            } elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) && ($env{'form.folderpath'} =~ /^supplemental/)) {
                 $incourse = 1;
                 if ($env{'form.forceedit'}) {
                     $forceview = 1;
@@ -3219,7 +3612,7 @@ sub can_edit_resource {
                 } else {
                     $cfile = $env{'form.suppurl'};
                     my $escfile = &unescape($cfile);
-                    if ($escfile =~ m{^/adm/$cdom/$cnum/\d+/exttools?$}) {
+                    if ($escfile =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
                         $cfile = '/adm/wrapper'.$escfile;
                     } else {
                         $escfile =~ s{^http://}{};
@@ -3380,7 +3773,7 @@ sub process_coursefile {
                                  $home);
             }
         } elsif ($action eq 'uploaddoc') {
-            open(my $fh,'>'.$filepath.'/'.$fname);
+            open(my $fh,'>',$filepath.'/'.$fname);
             print $fh $env{'form.'.$source};
             close($fh);
             if ($parser eq 'parse') {
@@ -3438,7 +3831,7 @@ sub store_edited_file {
     ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|);
     $fpath=$docudom.'/'.$docuname.'/'.$fpath;
     my $filepath = &build_filepath($fpath);
-    open(my $fh,'>'.$filepath.'/'.$fname);
+    open(my $fh,'>',$filepath.'/'.$fname);
     print $fh $content;
     close($fh);
     my $home=&homeserver($docuname,$docudom);
@@ -3554,12 +3947,12 @@ sub userfileupload {
                          '_'.$env{'user.domain'}.'/pending';
         } elsif (($context eq 'existingfile') || ($context eq 'canceloverwrite')) {
             my ($docuname,$docudom);
-            if ($destudom) {
+            if ($destudom =~ /^$match_domain$/) {
                 $docudom = $destudom;
             } else {
                 $docudom = $env{'user.domain'};
             }
-            if ($destuname) {
+            if ($destuname =~ /^$match_username$/) {
                 $docuname = $destuname;
             } else {
                 $docuname = $env{'user.name'};
@@ -3589,7 +3982,7 @@ sub userfileupload {
                 mkdir($fullpath,0777);
             }
         }
-        open(my $fh,'>'.$fullpath.'/'.$fname);
+        open(my $fh,'>',$fullpath.'/'.$fname);
         print $fh $env{'form.'.$formname};
         close($fh);
         if ($context eq 'existingfile') {
@@ -3664,7 +4057,7 @@ sub finishuserfileupload {
 
 # Save the file
     {
-	if (!open(FH,'>'.$filepath.'/'.$file)) {
+	if (!open(FH,'>',$filepath.'/'.$file)) {
 	    &logthis('Failed to create '.$filepath.'/'.$file);
 	    print STDERR ('Failed to create '.$filepath.'/'.$file."\n");
 	    return '/adm/notfound.html';
@@ -3722,7 +4115,8 @@ sub finishuserfileupload {
         my $input = $filepath.'/'.$file;
         my $output = $filepath.'/'.'tn-'.$file;
         my $thumbsize = $thumbwidth.'x'.$thumbheight;
-        system("convert -sample $thumbsize $input $output");
+        my @args = ('convert','-sample',$thumbsize,$input,$output);
+        system({$args[0]} @args);
         if (-e $filepath.'/'.'tn-'.$file) {
             $fetchthumb  = 1; 
         }
@@ -4106,7 +4500,7 @@ sub flushcourselogs {
         }
     }
 #
-# Reverse lookup of domain roles (dc, ad, li, sc, au)
+# Reverse lookup of domain roles (dc, ad, li, sc, dh, da, au)
 #
     my %domrolebuffer = ();
     foreach my $entry (keys(%domainrolehash)) {
@@ -4121,10 +4515,19 @@ sub flushcourselogs {
         delete $domainrolehash{$entry};
     }
     foreach my $dom (keys(%domrolebuffer)) {
-	my %servers = &get_servers($dom,'library');
+	my %servers;
+	if (defined(&domain($dom,'primary'))) {
+	    my $primary=&domain($dom,'primary');
+	    my $hostname=&hostname($primary);
+	    $servers{$primary} = $hostname;
+	} else { 
+	    %servers = &get_servers($dom,'library');
+	}
 	foreach my $tryserver (keys(%servers)) {
-	    unless (&reply('domroleput:'.$dom.':'.
-			   $domrolebuffer{$dom},$tryserver) eq 'ok') {
+	    if (&reply('domroleput:'.$dom.':'.
+		       $domrolebuffer{$dom},$tryserver) eq 'ok') {
+		last;
+	    } else {  
 		&logthis('Put of domain roles failed for '.$dom.' and  '.$tryserver);
 	    }
         }
@@ -4244,7 +4647,7 @@ sub userrolelog {
          {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}
                     =$tend.':'.$tstart;
     }
-    if ($trole =~ /^(dc|ad|li|au|dg|sc)/ ) {
+    if ($trole =~ /^(dc|ad|li|au|dg|sc|dh|da)/ ) {
        my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
        $domainrolehash
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
@@ -4471,6 +4874,195 @@ sub get_my_roles {
     return %returnhash;
 }
 
+sub get_all_adhocroles {
+    my ($dom) = @_;
+    my @roles_by_num = ();
+    my %domdefaults = &get_domain_defaults($dom);
+    my (%description,%access_in_dom,%access_info);
+    if (ref($domdefaults{'adhocroles'}) eq 'HASH') {
+        my $count = 0;
+        my %domcurrent = %{$domdefaults{'adhocroles'}};
+        my %ordered;
+        foreach my $role (sort(keys(%domcurrent))) {
+            my ($order,$desc,$access_in_dom);
+            if (ref($domcurrent{$role}) eq 'HASH') {
+                $order = $domcurrent{$role}{'order'};
+                $desc = $domcurrent{$role}{'desc'};
+                $access_in_dom{$role} = $domcurrent{$role}{'access'};
+                $access_info{$role} = $domcurrent{$role}{$access_in_dom{$role}};
+            }
+            if ($order eq '') {
+                $order = $count;
+            }
+            $ordered{$order} = $role;
+            if ($desc ne '') {
+                $description{$role} = $desc;
+            } else {
+                $description{$role}= $role;
+            }
+            $count++;
+        }
+        foreach my $item (sort {$a <=> $b } (keys(%ordered))) {
+            push(@roles_by_num,$ordered{$item});
+        }
+    }
+    return (\@roles_by_num,\%description,\%access_in_dom,\%access_info);
+}
+
+sub get_my_adhocroles {
+    my ($cid,$checkreg) = @_;
+    my ($cdom,$cnum,%info,@possroles,$description,$roles_by_num);
+    if ($env{'request.course.id'} eq $cid) {
+        $cdom = $env{'course.'.$cid.'.domain'};
+        $cnum = $env{'course.'.$cid.'.num'};
+        $info{'internal.coursecode'} = $env{'course.'.$cid.'.internal.coursecode'};
+    } elsif ($cid =~ /^($match_domain)_($match_courseid)$/) {
+        $cdom = $1;
+        $cnum = $2;
+        %info = &Apache::lonnet::get('environment',['internal.coursecode'],
+                                     $cdom,$cnum);
+    }
+    if (($info{'internal.coursecode'} ne '') && ($checkreg)) {
+        my $user = $env{'user.name'}.':'.$env{'user.domain'};
+        my %rosterhash = &get('classlist',[$user],$cdom,$cnum);
+        if ($rosterhash{$user} ne '') {
+            my $type = (split(/:/,$rosterhash{$user}))[5];
+            return ([],{}) if ($type eq 'auto');
+        }
+    }
+    if (($cdom ne '') && ($cnum ne ''))  {
+        if (($env{"user.role.dh./$cdom/"}) || ($env{"user.role.da./$cdom/"})) {
+            my $then=$env{'user.login.time'};
+            my $update=$env{'user.update.time'};
+            if (!$update) {
+                $update = $then;
+            }
+            my @liveroles;
+            foreach my $role ('dh','da') {
+                if ($env{"user.role.$role./$cdom/"}) {
+                    my ($tstart,$tend)=split(/\./,$env{"user.role.$role./$cdom/"});
+                    my $limit = $update;
+                    if ($env{'request.role'} eq "$role./$cdom/") {
+                        $limit = $then;
+                    }
+                    my $activerole = 1;
+                    if ($tstart && $tstart>$limit) { $activerole = 0; }
+                    if ($tend   && $tend  <$limit) { $activerole = 0; }
+                    if ($activerole) {
+                        push(@liveroles,$role);
+                    }
+                }
+            }
+            if (@liveroles) {
+                if (&homeserver($cnum,$cdom) ne 'no_host') {
+                    my ($accessref,$accessinfo,%access_in_dom);
+                    ($roles_by_num,$description,$accessref,$accessinfo) = &get_all_adhocroles($cdom);
+                    if (ref($roles_by_num) eq 'ARRAY') {
+                        if (@{$roles_by_num}) {
+                            my %settings;
+                            if ($env{'request.course.id'} eq $cid) {
+                                foreach my $envkey (keys(%env)) {
+                                    if ($envkey =~ /^\Qcourse.$cid.\E(internal\.adhoc.+)$/) {
+                                        $settings{$1} = $env{$envkey};
+                                    }
+                                }
+                            } else {
+                                %settings = &dump('environment',$cdom,$cnum,'internal\.adhoc');
+                            }
+                            my %setincrs;
+                            if ($settings{'internal.adhocaccess'}) {
+                                map { $setincrs{$_} = 1; } split(/,/,$settings{'internal.adhocaccess'});
+                            }
+                            my @statuses;
+                            if ($env{'environment.inststatus'}) {
+                                @statuses = split(/,/,$env{'environment.inststatus'});
+                            }
+                            my $user = $env{'user.name'}.':'.$env{'user.domain'};
+                            if (ref($accessref) eq 'HASH') {
+                                %access_in_dom = %{$accessref};
+                            }
+                            foreach my $role (@{$roles_by_num}) {
+                                my ($curraccess,@okstatus,@personnel);
+                                if ($setincrs{$role}) {
+                                    ($curraccess,my $rest) = split(/=/,$settings{'internal.adhoc.'.$role});
+                                    if ($curraccess eq 'status') {
+                                        @okstatus = split(/\&/,$rest);
+                                    } elsif (($curraccess eq 'exc') || ($curraccess eq 'inc')) {
+                                        @personnel = split(/\&/,$rest);
+                                    }
+                                } else {
+                                    $curraccess = $access_in_dom{$role};
+                                    if (ref($accessinfo) eq 'HASH') {
+                                        if ($curraccess eq 'status') {
+                                            if (ref($accessinfo->{$role}) eq 'ARRAY') {
+                                                @okstatus = @{$accessinfo->{$role}};
+                                            }
+                                        } elsif (($curraccess eq 'exc') || ($curraccess eq 'inc')) {
+                                            if (ref($accessinfo->{$role}) eq 'ARRAY') {
+                                                @personnel = @{$accessinfo->{$role}};
+                                            }
+                                        }
+                                    }
+                                }
+                                if ($curraccess eq 'none') {
+                                    next;
+                                } elsif ($curraccess eq 'all') {
+                                    push(@possroles,$role);
+                                } elsif ($curraccess eq 'dh') {
+                                    if (grep(/^dh$/,@liveroles)) {
+                                        push(@possroles,$role);
+                                    } else {
+                                        next;
+                                    }
+                                } elsif ($curraccess eq 'da') {
+                                    if (grep(/^da$/,@liveroles)) {
+                                        push(@possroles,$role);
+                                    } else {
+                                        next;
+                                    }
+                                } elsif ($curraccess eq 'status') {
+                                    if (@okstatus) {
+                                        if (!@statuses) {
+                                            if (grep(/^default$/,@okstatus)) {
+                                                push(@possroles,$role);
+                                            }
+                                        } else {
+                                            foreach my $status (@okstatus) {
+                                                if (grep(/^\Q$status\E$/,@statuses)) {
+                                                    push(@possroles,$role);
+                                                    last;
+                                                }
+                                            }
+                                        }
+                                    }
+                                } elsif (($curraccess eq 'exc') || ($curraccess eq 'inc')) {
+                                    if (grep(/^\Q$user\E$/,@personnel)) {
+                                        if ($curraccess eq 'exc') {
+                                            push(@possroles,$role);
+                                        }
+                                    } elsif ($curraccess eq 'inc') {
+                                        push(@possroles,$role);
+                                    }
+                                }
+                            }
+                        }
+                    }
+                }
+            }
+        }
+    }
+    unless (ref($description) eq 'HASH') {
+        if (ref($roles_by_num) eq 'ARRAY') {
+            my %desc;
+            map { $desc{$_} = $_; } (@{$roles_by_num});
+            $description = \%desc;
+        } else {
+            $description = {};
+        }
+    }
+    return (\@possroles,$description);
+}
+
 # ----------------------------------------------------- Frontpage Announcements
 #
 #
@@ -4484,7 +5076,7 @@ sub postannounce {
 
 sub getannounce {
 
-    if (open(my $fh,$perlvar{'lonDocRoot'}.'/announcement.txt')) {
+    if (open(my $fh,"<",$perlvar{'lonDocRoot'}.'/announcement.txt')) {
 	my $announcement='';
 	while (my $line = <$fh>) { $announcement .= $line; }
 	close($fh);
@@ -4711,6 +5303,21 @@ sub get_domain_roles {
     return %personnel;
 }
 
+sub get_active_domroles {
+    my ($dom,$roles) = @_;
+    return () unless (ref($roles) eq 'ARRAY');
+    my $now = time;
+    my %dompersonnel = &get_domain_roles($dom,$roles,$now,$now);
+    my %domroles;
+    foreach my $server (keys(%dompersonnel)) {
+        foreach my $user (sort(keys(%{$dompersonnel{$server}}))) {
+            my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,$user);
+            $domroles{$uname.':'.$udom} = $dompersonnel{$server}{$user};
+        }
+    }
+    return %domroles;
+}
+
 # ----------------------------------------------------------- Interval timing 
 
 {
@@ -4766,7 +5373,12 @@ sub set_first_access {
     }
     $cachedkey='';
     my $firstaccess=&get_first_access($type,$symb,$map);
-    if (!$firstaccess) {
+    if ($firstaccess) {
+        &logthis("First access time already set ($firstaccess) when attempting ".
+                 "to set new value (type: $type, extent: $res) for $uname:$udom ".
+                 "in $courseid");
+        return 'already_set';
+    } else {
         my $start = time;
 	my $putres = &put('firstaccesstimes',{"$courseid\0$res"=>$start},
                           $udom,$uname);
@@ -4779,6 +5391,12 @@ sub set_first_access {
                         'course.'.$courseid.'.timerinterval.'.$res => $interval,
                      }
                   );
+            if (($cachedtime) && (abs($start-$cachedtime) < 5)) {
+                $cachedtimes{"$courseid\0$res"} = $start;
+            }
+        } elsif ($putres ne 'refused') {
+            &logthis("Result: $putres when attempting to set first access time ".
+                     "(type: $type, extent: $res) for $uname:$udom in $courseid");
         }
         return $putres;
     }
@@ -5565,9 +6183,10 @@ sub rolesinit {
         }
     }
 
-    @userroles{'user.author', 'user.adv'} = &set_userprivs(\%userroles,
-        \%allroles, \%allgroups);
+    @userroles{'user.author','user.adv','user.rar'} = &set_userprivs(\%userroles,
+                                                          \%allroles, \%allgroups);
     $env{'user.adv'} = $userroles{'user.adv'};
+    $env{'user.rar'} = $userroles{'user.rar'};
 
     return (\%userroles,\%firstaccenv,\%timerintenv);
 }
@@ -5603,6 +6222,10 @@ sub custom_roleprivs {
                     $$allroles{$spec.'./'.$tdomain.'/'}.=':'.$dompriv;
                 }
                 if (($trest ne '') && (defined($coursepriv))) {
+                    if ($trole =~ m{^cr/$tdomain/$tdomain\Q-domainconfig\E/([^/]+)$}) {
+                        my $rolename = $1;
+                        $coursepriv = &course_adhocrole_privs($rolename,$tdomain,$trest,$coursepriv);
+                    }
                     $$allroles{'cm.'.$area}.=':'.$coursepriv;
                     $$allroles{$spec.'.'.$area}.=':'.$coursepriv;
                 }
@@ -5611,6 +6234,48 @@ sub custom_roleprivs {
     }
 }
 
+sub course_adhocrole_privs {
+    my ($rolename,$cdom,$cnum,$coursepriv) = @_;
+    my %overrides = &get('environment',["internal.adhocpriv.$rolename"],$cdom,$cnum);
+    if ($overrides{"internal.adhocpriv.$rolename"}) {
+        my (%currprivs,%storeprivs);
+        foreach my $item (split(/:/,$coursepriv)) {
+            my ($priv,$restrict) = split(/\&/,$item);
+            $currprivs{$priv} = $restrict;
+        }
+        my (%possadd,%possremove,%full);
+        foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
+            my ($priv,$restrict)=split(/\&/,$item);
+            $full{$priv} = $restrict;
+        }
+        foreach my $item (split(/,/,$overrides{"internal.adhocpriv.$rolename"})) {
+             next if ($item eq '');
+             my ($rule,$rest) = split(/=/,$item);
+             next unless (($rule eq 'off') || ($rule eq 'on'));
+             foreach my $priv (split(/:/,$rest)) {
+                 if ($priv ne '') {
+                     if ($rule eq 'off') {
+                         $possremove{$priv} = 1;
+                     } else {
+                         $possadd{$priv} = 1;
+                     }
+                 }
+             }
+         }
+         foreach my $priv (sort(keys(%full))) {
+             if (exists($currprivs{$priv})) {
+                 unless (exists($possremove{$priv})) {
+                     $storeprivs{$priv} = $currprivs{$priv};
+                 }
+             } elsif (exists($possadd{$priv})) {
+                 $storeprivs{$priv} = $full{$priv};
+             }
+         }
+         $coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs)));
+     }
+     return $coursepriv;
+}
+
 sub group_roleprivs {
     my ($allgroups,$area,$group_privs,$tend,$tstart) = @_;
     my $access = 1;
@@ -5645,6 +6310,7 @@ sub set_userprivs {
     my ($userroles,$allroles,$allgroups,$groups_roles) = @_; 
     my $author=0;
     my $adv=0;
+    my $rar=0;
     my %grouproles = ();
     if (keys(%{$allgroups}) > 0) {
         my @groupkeys; 
@@ -5692,6 +6358,7 @@ sub set_userprivs {
                     $thesepriv{$privilege}.=$restrictions;
                 }
                 if ($thesepriv{'adv'} eq 'F') { $adv=1; }
+                if ($thesepriv{'rar'} eq 'F') { $rar=1; }
             }
         }
         my $thesestr='';
@@ -5700,7 +6367,7 @@ sub set_userprivs {
 	}
         $userroles->{'user.priv.'.$role} = $thesestr;
     }
-    return ($author,$adv);
+    return ($author,$adv,$rar);
 }
 
 sub role_status {
@@ -5745,9 +6412,10 @@ sub role_status {
                                 push(@rolecodes,$$role);
                                 &standard_roleprivs(\%allroles,$$role,$tdomain,$spec,$trest,$$where);
                             }
-                            my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups,\%groups_roles);
+                            my ($author,$adv,$rar)= &set_userprivs(\%userroles,\%allroles,\%allgroups,
+                                                                   \%groups_roles);
                             &appenv(\%userroles,\@rolecodes);
-                            &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
+                            &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$spec);
                         }
                     }
                     $$tstatus = 'is';
@@ -5823,39 +6491,56 @@ sub delete_env_groupprivs {
 }
 
 sub check_adhoc_privs {
-    my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller) = @_;
+    my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller,$sec) = @_;
     my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
+    if ($sec) {
+        $cckey .= '/'.$sec;
+    } 
     my $setprivs;
     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);
+            &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller,$sec);
             $setprivs = 1;
         }
     } else {
-        &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);
+        &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller,$sec);
         $setprivs = 1;
     }
     return $setprivs;
 }
 
 sub set_adhoc_privileges {
-# role can be cc or ca
-    my ($dcdom,$pickedcourse,$role,$caller) = @_;
+# role can be cc, ca, or cr/<dom>/<dom>-domainconfig/role
+    my ($dcdom,$pickedcourse,$role,$caller,$sec) = @_;
     my $area = '/'.$dcdom.'/'.$pickedcourse;
+    if ($sec ne '') {
+        $area .= '/'.$sec;
+    }
     my $spec = $role.'.'.$area;
     my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'},
                                   $env{'user.name'},1);
-    my %ccrole = ();
-    &standard_roleprivs(\%ccrole,$role,$dcdom,$spec,$pickedcourse,$area);
-    my ($author,$adv)= &set_userprivs(\%userroles,\%ccrole);
+    my %rolehash = ();
+    if ($role =~ m{^\Qcr/$dcdom/$dcdom\E\-domainconfig/(\w+)$}) {
+        my $rolename = $1;
+        &custom_roleprivs(\%rolehash,$role,$dcdom,$pickedcourse,$spec,$area);
+        my %domdef = &get_domain_defaults($dcdom);
+        if (ref($domdef{'adhocroles'}) eq 'HASH') {
+            if (ref($domdef{'adhocroles'}{$rolename}) eq 'HASH') {
+                &appenv({'request.role.desc' => $domdef{'adhocroles'}{$rolename}{'desc'},});
+            }
+        }
+    } else {
+        &standard_roleprivs(\%rolehash,$role,$dcdom,$spec,$pickedcourse,$area);
+    }
+    my ($author,$adv,$rar)= &set_userprivs(\%userroles,\%rolehash);
     &appenv(\%userroles,[$role,'cm']);
-    &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
+    &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$spec);
     unless ($caller eq 'constructaccess' && $env{'request.course.id'}) {
         &appenv( {'request.role'        => $spec,
                   'request.role.domain' => $dcdom,
-                  'request.course.sec'  => ''
+                  'request.course.sec'  => $sec,
                  }
                );
         my $tadv=0;
@@ -6005,7 +6690,7 @@ sub currentdump {
    #
    my %returnhash=();
    #
-   if ($rep eq "unknown_cmd") { 
+   if ($rep eq 'unknown_cmd') {
        # an old lond will not know currentdump
        # Do a dump and make it look like a currentdump
        my @tmp = &dumpstore($courseid,$sdom,$sname,'.');
@@ -6239,9 +6924,11 @@ sub tmpget {
     if (!defined($server)) { $server = $perlvar{'lonHostID'}; }
     my $rep=&reply("tmpget:$token",$server);
     my %returnhash;
+    if ($rep =~ /^(con_lost|error|no_such_host)/i) {
+        return %returnhash;
+    }
     foreach my $item (split(/\&/,$rep)) {
 	my ($key,$value)=split(/=/,$item);
-        next if ($key =~ /^error: 2 /);
 	$returnhash{&unescape($key)}=&thaw_unescape($value);
     }
     return %returnhash;
@@ -6624,6 +7311,7 @@ sub usertools_access {
                       community  => 1,
                       textbook   => 1,
                       placement  => 1,
+                      lti        => 1,
                  );
     } elsif ($context eq 'requestauthor') {
         %tools = (
@@ -6820,25 +7508,29 @@ sub is_advanced_user {
 }
 
 sub check_can_request {
-    my ($dom,$can_request,$request_domains) = @_;
+    my ($dom,$can_request,$request_domains,$uname,$udom) = @_;
     my $canreq = 0;
+    if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) {
+        $uname = $env{'user.name'};
+        $udom = $env{'user.domain'};
+    }
     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')) {
+            if (&usertools_access($uname,$udom,$type,undef,
+                                  'requestcourses')) {
                 $canreq ++;
                 if (ref($request_domains) eq 'HASH') {
-                    push(@{$request_domains->{$type}},$env{'user.domain'});
+                    push(@{$request_domains->{$type}},$udom);
                 }
-                if ($dom eq $env{'user.domain'}) {
+                if ($dom eq $udom) {
                     $can_request->{$type} = 1;
                 }
             }
-            if ($env{'environment.reqcrsotherdom.'.$type} ne '') {
+            if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
+                ($env{'environment.reqcrsotherdom.'.$type} ne '')) {
                 my @curr = split(',',$env{'environment.reqcrsotherdom.'.$type});
                 if (@curr > 0) {
                     foreach my $item (@curr) {
@@ -6855,7 +7547,7 @@ sub check_can_request {
                             }
                         }
                     }
-                    unless($dom eq $env{'user.domain'}) {
+                    unless ($dom eq $env{'user.domain'}) {
                         $canreq ++;
                         if (grep(/^\Q$dom\E:($optregex)(=?\d*)$/,@curr)) {
                             $can_request->{$type} = 1;
@@ -6937,7 +7629,7 @@ sub allowed {
 
     if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }
 # Free bre access to adm and meta resources
-    if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard)$})) 
+    if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|ext\.tool)$})) 
 	 || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) )) 
 	&& ($priv eq 'bre')) {
 	return 'F';
@@ -6985,7 +7677,10 @@ sub allowed {
 # Free bre to public access
 
     if ($priv eq 'bre') {
-        my $copyright=&metadata($uri,'copyright');
+        my $copyright;
+        unless ($uri =~ /ext\.tool/) {
+            $copyright=&metadata($uri,'copyright');
+        }
 	if (($copyright eq 'public') && (!$env{'request.course.id'})) { 
            return 'F'; 
         }
@@ -7425,7 +8120,7 @@ sub constructaccess {
     my ($ownername,$ownerdomain,$ownerhome);
 
     ($ownerdomain,$ownername) =
-        ($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)(?:/daxepage|/daxeopen)?/priv/($match_domain)/($match_username)/});
+        ($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)(?:/daxepage|/daxeopen)?/priv/($match_domain)/($match_username)(?:/|$)});
 
 # The URL does not really point to any authorspace, forget it
     unless (($ownername) && ($ownerdomain)) { return ''; }
@@ -7773,7 +8468,7 @@ sub get_symb_from_alias {
 
 sub definerole {
   if (allowed('mcr','/')) {
-    my ($rolename,$sysrole,$domrole,$courole)=@_;
+    my ($rolename,$sysrole,$domrole,$courole,$uname,$udom)=@_;
     foreach my $role (split(':',$sysrole)) {
 	my ($crole,$cqual)=split(/\&/,$role);
         if ($pr{'cr:s'}!~/\Q$crole\E/) { return "refused:s:$crole"; }
@@ -7801,11 +8496,19 @@ sub definerole {
             }
         }
     }
+    my $uhome;
+    if (($uname ne '') && ($udom ne '')) {
+        $uhome = &homeserver($uname,$udom);
+        return $uhome if ($uhome eq 'no_host');
+    } else {
+        $uname = $env{'user.name'};
+        $udom = $env{'user.domain'};
+        $uhome = $env{'user.home'};
+    }
     my $command="encrypt:rolesput:$env{'user.domain'}:$env{'user.name'}:".
-                "$env{'user.domain'}:$env{'user.name'}:".
-	        "rolesdef_$rolename=".
+                "$udom:$uname:rolesdef_$rolename=".
                 escape($sysrole.'_'.$domrole.'_'.$courole);
-    return reply($command,$env{'user.home'});
+    return reply($command,$uhome);
   } else {
     return 'refused';
   }
@@ -7920,7 +8623,7 @@ sub fetch_enrollment_query {
         &logthis('fetch_enrollment_query error: '.$reply.' for '.$dom.' '.$env{'user.name'}.' for '.$queryid.' context: '.$context.' '.$cnum.' maxtries: '.$maxtries.' tries: '.$tries);
     } else {
         my @responses = split(/:/,$reply);
-        if (grep { $_ eq $homeserver } &current_machine_ids()) { 
+        if (grep { $_ eq $homeserver } &current_machine_ids()) {
             foreach my $line (@responses) {
                 my ($key,$value) = split(/=/,$line,2);
                 $$replyref{$key} = $value;
@@ -7938,7 +8641,7 @@ sub fetch_enrollment_query {
                         if ($xml_classlist =~ /^error/) {
                             &logthis('fetch_enrollment_query - autoretrieve error: '.$xml_classlist.' for '.$filename.' from server: '.$homeserver.' '.$context.' '.$cnum);
                         } else {
-                            if ( open(FILE,">$destname") ) {
+                            if ( open(FILE,">",$destname) ) {
                                 print FILE &unescape($xml_classlist);
                                 close(FILE);
                             } else {
@@ -7967,7 +8670,7 @@ sub get_query_reply {
     for (1..$loopmax) {
 	sleep($sleep);
         if (-e $replyfile.'.end') {
-	    if (open(my $fh,$replyfile)) {
+	    if (open(my $fh,"<",$replyfile)) {
 		$reply = join('',<$fh>);
 		close($fh);
 	   } else { return 'error: reply_file_error'; }
@@ -8359,6 +9062,33 @@ sub auto_validate_class_sec {
     return $response;
 }
 
+sub auto_validate_instclasses {
+    my ($cdom,$cnum,$owners,$classesref) = @_;
+    my ($homeserver,%validations);
+    $homeserver = &homeserver($cnum,$cdom);
+    unless ($homeserver eq 'no_host') {
+        my $ownerlist;
+        if (ref($owners) eq 'ARRAY') {
+            $ownerlist = join(',',@{$owners});
+        } else {
+            $ownerlist = $owners;
+        }
+        if (ref($classesref) eq 'HASH') {
+            my $classes = &freeze_escape($classesref);
+            my $response=&reply('autovalidateinstclasses:'.&escape($ownerlist).
+                                ':'.$cdom.':'.$classes,$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_crsreq_update {
     my ($cdom,$cnum,$crstype,$action,$ownername,$ownerdomain,$fullname,$title,
         $code,$accessstart,$accessend,$inbound) = @_;
@@ -8718,7 +9448,7 @@ sub assignrole {
             }
             if ($refused) {
                 my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
-                if (!$selfenroll && $context eq 'course') {
+                if (!$selfenroll && (($context eq 'course') || ($context eq 'ltienroll' && $env{'request.lti.login'}))) {
                     my %crsenv;
                     if ($role eq 'cc' || $role eq 'co') {
                         %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
@@ -8738,8 +9468,12 @@ sub assignrole {
                             }
                         }
                     }
-                } elsif (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
-                    $refused = '';
+                } elsif (($selfenroll == 1) && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
+                    if ($role eq 'st') {
+                        $refused = '';
+                    } elsif (($context eq 'ltienroll') && ($env{'request.lti.login'})) {
+                        $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 '')) {
@@ -8854,7 +9588,8 @@ sub assignrole {
             &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
                            $selfenroll,$context);
         } elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') ||
-                 ($role eq 'au') || ($role eq 'dc')) {
+                 ($role eq 'au') || ($role eq 'dc') || ($role eq 'dh') ||
+                 ($role eq 'da')) {
             &domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
                            $context);
         } elsif (($role eq 'ca') || ($role eq 'aa')) {
@@ -9004,10 +9739,14 @@ sub modifyuser {
     my $newuser;
     if ($uhome eq 'no_host') {
         $newuser = 1;
+        unless (($umode && ($upass ne '')) || ($umode eq 'localauth') ||
+                ($umode eq 'lti')) {
+            return 'error: more information needed to create new user';
+        }
     }
 # ----------------------------------------------------------------- Create User
     if (($uhome eq 'no_host') && 
-	(($umode && $upass) || ($umode eq 'localauth'))) {
+	(($umode && $upass) || ($umode eq 'localauth') || ($umode eq 'lti'))) {
         my $unhome='';
         if (defined($desiredhome) && &host_domain($desiredhome) eq $udom) { 
             $unhome = $desiredhome;
@@ -9452,12 +10191,25 @@ sub is_course {
     my ($cdom, $cnum) = scalar(@_) == 1 ? 
          ($_[0] =~ /^($match_domain)_($match_courseid)$/)  :  @_;
 
-    return unless $cdom and $cnum;
-
-    my %courses = &courseiddump($cdom, '.', 1, '.', '.', $cnum, undef, undef,
-        '.');
-
-    return unless(exists($courses{$cdom.'_'.$cnum}));
+    return unless (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/));
+    my $uhome=&homeserver($cnum,$cdom);
+    my $iscourse;
+    if (grep { $_ eq $uhome } current_machine_ids()) {
+        $iscourse = &LONCAPA::Lond::is_course($cdom,$cnum);
+    } else {
+        my $hashid = $cdom.':'.$cnum;
+        ($iscourse,my $cached) = &is_cached_new('iscourse',$hashid);
+        unless (defined($cached)) {
+            my %courses = &courseiddump($cdom, '.', 1, '.', '.',
+                                        $cnum,undef,undef,'.');
+            $iscourse = 0;
+            if (exists($courses{$cdom.'_'.$cnum})) {
+                $iscourse = 1;
+            }
+            &do_cache_new('iscourse',$hashid,$iscourse,3600);
+        }
+    }
+    return unless ($iscourse);
     return wantarray ? ($cdom, $cnum) : $cdom.'_'.$cnum;
 }
 
@@ -9593,7 +10345,7 @@ sub save_selected_files {
     my ($user, $path, @files) = @_;
     my $filename = $user."savedfiles";
     my @other_files = &files_not_in_path($user, $path);
-    open (OUT, '>'.$tmpdir.$filename);
+    open (OUT,'>',LONCAPA::tempdir().$filename);
     foreach my $file (@files) {
         print (OUT $env{'form.currentpath'}.$file."\n");
     }
@@ -9607,7 +10359,7 @@ sub save_selected_files {
 sub clear_selected_files {
     my ($user) = @_;
     my $filename = $user."savedfiles";
-    open (OUT, '>'.LONCAPA::tempdir().$filename);
+    open (OUT,'>',LONCAPA::tempdir().$filename);
     print (OUT undef);
     close (OUT);
     return ("ok");    
@@ -9617,7 +10369,7 @@ sub files_in_path {
     my ($user, $path) = @_;
     my $filename = $user."savedfiles";
     my %return_files;
-    open (IN, '<'.LONCAPA::tempdir().$filename);
+    open (IN,'<',LONCAPA::tempdir().$filename);
     while (my $line_in = <IN>) {
         chomp ($line_in);
         my @paths_and_file = split (m!/!, $line_in);
@@ -9639,7 +10391,7 @@ sub files_not_in_path {
     my $filename = $user."savedfiles";
     my @return_files;
     my $path_part;
-    open(IN, '<'.LONCAPA::.$filename);
+    open(IN, '<',LONCAPA::tempdir().$filename);
     while (my $line = <IN>) {
         #ok, I know it's clunky, but I want it to work
         my @paths_and_file = split(m|/|, $line);
@@ -10624,23 +11376,40 @@ sub resdata {
     return undef;
 }
 
-sub get_domain_ltitools {
-    my ($cdom) = @_;
-    my %ltitools;
-    my ($result,$cached)=&is_cached_new('ltitools',$cdom);
+sub get_domain_lti {
+    my ($cdom,$context) = @_;
+    my ($name,%lti);
+    if ($context eq 'consumer') {
+        $name = 'ltitools';
+    } elsif ($context eq 'provider') {
+        $name = 'lti';
+    } else {
+        return %lti;
+    }
+    my ($result,$cached)=&is_cached_new($name,$cdom);
     if (defined($cached)) {
         if (ref($result) eq 'HASH') {
-            %ltitools = %{$result};
+            %lti = %{$result};
         }
     } else {
-        my %domconfig = &get_dom('configuration',['ltitools'],$cdom);
-        if (ref($domconfig{'ltitools'}) eq 'HASH') {
-            %ltitools = %{$domconfig{'ltitools'}};
+        my %domconfig = &get_dom('configuration',[$name],$cdom);
+        if (ref($domconfig{$name}) eq 'HASH') {
+            %lti = %{$domconfig{$name}};
+            my %encdomconfig = &get_dom('encconfig',[$name],$cdom);
+            if (ref($encdomconfig{$name}) eq 'HASH') {
+                foreach my $id (keys(%lti)) {
+                    if (ref($encdomconfig{$name}{$id}) eq 'HASH') {
+                        foreach my $item ('key','secret') {
+                            $lti{$id}{$item} = $encdomconfig{$name}{$id}{$item};
+                        }
+                    }
+                }
+            }
         }
         my $cachetime = 24*60*60;
-        &do_cache_new('ltitools',$cdom,\%ltitools,$cachetime);
+        &do_cache_new($name,$cdom,\%lti,$cachetime);
     }
-    return %ltitools;
+    return %lti;
 }
 
 sub get_numsuppfiles {
@@ -10653,10 +11422,11 @@ sub get_numsuppfiles {
     unless (defined($cached)) {
         my $chome=&homeserver($cnum,$cdom);
         unless ($chome eq 'no_host') {
-            ($suppcount,my $errors) = (0,0);
+            ($suppcount,my $supptools,my $errors) = (0,0,0);
             my $suppmap = 'supplemental.sequence';
-            ($suppcount,$errors) = 
-                &Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount,$errors);
+            ($suppcount,$supptools,$errors) =
+                &Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount,
+                                                         $supptools,$errors);
         }
         &do_cache_new('suppcount',$hashid,$suppcount,600);
     }
@@ -10946,9 +11716,13 @@ sub EXT {
 	} else {
 	    $filename=$env{'request.filename'};
 	}
-	my $metadata=&metadata($filename,$what);
+        my $toolsymb;
+        if (($filename =~ /ext\.tool$/) && ($what ne '0_gradable')) {
+            $toolsymb = $symbparm;
+        }
+	my $metadata=&metadata($filename,$what,$toolsymb);
 	if (defined($metadata)) { return &get_reply([$metadata,'resource']); }
-	$metadata=&metadata($filename,'parameter_'.$what);
+	$metadata=&metadata($filename,'parameter_'.$what,$toolsymb);
 	if (defined($metadata)) { return &get_reply([$metadata,'resource']); }
 
 # ----------------------------------------------- fifth, look in rest of course
@@ -10974,7 +11748,7 @@ sub EXT {
 	    if (defined($partgeneral[0])) { return &get_reply(\@partgeneral); }
 	}
 	if ($recurse) { return undef; }
-	my $pack_def=&packages_tab_default($filename,$varname);
+	my $pack_def=&packages_tab_default($filename,$varname,$toolsymb);
 	if (defined($pack_def)) { return &get_reply([$pack_def,'resource']); }
 # ---------------------------------------------------- Any other user namespace
     } elsif ($realm eq 'environment') {
@@ -11068,11 +11842,11 @@ sub sort_course_groups { # Sort groups b
 }
 
 sub packages_tab_default {
-    my ($uri,$varname)=@_;
+    my ($uri,$varname,$toolsymb)=@_;
     my (undef,$part,$name)=split(/\./,$varname);
 
     my (@extension,@specifics,$do_default);
-    foreach my $package (split(/,/,&metadata($uri,'packages'))) {
+    foreach my $package (split(/,/,&metadata($uri,'packages',$toolsymb))) {
 	my ($pack_type,$pack_part)=split(/_/,$package,2);
 	if ($pack_type eq 'default') {
 	    $do_default=1;
@@ -11139,13 +11913,14 @@ sub add_prefix_and_part {
 
 my %metaentry;
 my %importedpartids;
+my %importedrespids;
 sub metadata {
-    my ($uri,$what,$liburi,$prefix,$depthcount)=@_;
+    my ($uri,$what,$toolsymb,$liburi,$prefix,$depthcount)=@_;
     $uri=&declutter($uri);
     # if it is a non metadata possible uri return quickly
     if (($uri eq '') || 
 	(($uri =~ m|^/*adm/|) && 
-	     ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard|exttools?)$})) ||
+	     ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard|ext\.tool)$})) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {
 	return undef;
     }
@@ -11164,11 +11939,72 @@ sub metadata {
 	my ($result,$cached)=&is_cached_new('meta',$uri);
 	if (defined($cached)) { return $result->{':'.$what}; }
     }
+
+#
+# If the uri is for an external tool the file from
+# which metadata should be retrieved depends on whether
+# the tool had been configured to be gradable (set in the Course
+# Editor or Resource Editor).
+#
+# If a valid symb has been included as the third arg in the call
+# to &metadata() that can be used to retrieve the value of
+# parameter_0_gradable set for the resource, and included in the
+# uploaded map containing the tool. The value is retrieved via
+# &EXT(), if a valid symb is available.  Otherwise the value of
+# gradable in the exttool_$marker.db file for the tool instance
+# is retrieved via &get().
+#
+# When lonuserstate::traceroute() calls lonnet::EXT() for 
+# hiddenresource and encrypturl (during course initialization)
+# the map-level parameter for resource.0.gradable included in the 
+# uploaded map containing the tool will not yet have been stored
+# in the user_course_parms.db file for the user's session, so in 
+# this case fall back to retrieving gradable status from the
+# exttool_$marker.db file.
+#
+# In order to avoid an infinite loop, &metadata() will return
+# before a call to &EXT(), if the uri is for an external tool
+# and the $what for which metadata is being requested is
+# parameter_0_gradable or 0_gradable.
+#
+
+    if ($uri =~ /ext\.tool$/) {
+        if (($what eq 'parameter_0_gradable') || ($what eq '0_gradable')) {
+            return;
+        } else {
+            my ($checked,$use_passback);
+            if ($toolsymb ne '') {
+                (undef,undef,my $tooluri) = &decode_symb($toolsymb);
+                if (($tooluri eq $uri) && (&EXT('resource.0.gradable',$toolsymb))) {
+                    $checked = 1;
+                    if (&EXT('resource.0.gradable',$toolsymb) =~ /^yes$/i) {
+                        $use_passback = 1;
+                    }
+                }
+            }
+            unless ($checked) {
+                my ($ignore,$cdom,$cnum,$marker) = split(m{/},$uri);
+                $marker=~s/\D//g;
+                if ($marker) {
+                    my %toolsettings=&get('exttool_'.$marker,['gradable'],$cdom,$cnum);
+                    $use_passback = $toolsettings{'gradable'};
+                }
+            }
+            if ($use_passback) {
+                $filename = '/home/httpd/html/res/lib/templates/LTIpassback.tool';
+            } else {
+                $filename = '/home/httpd/html/res/lib/templates/LTIstandard.tool';
+            }
+        }
+    }
+
     {
 # Imported parts would go here
-        my %importedids=();
-        my @origfileimportpartids=();
+        my @origfiletagids=();
         my $importedparts=0;
+
+# Imported responseids would go here
+        my $importedresponses=0;
 #
 # Is this a recursive call for a library?
 #
@@ -11263,27 +12099,77 @@ sub metadata {
                         my $dir=$filename;
                         $dir=~s|[^/]*$||;
                         $location=&filelocation($dir,$location);
-                       
+
+                        my $importid=$token->[2]->{'id'};
                         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') {
+#
+# Check metadata for imported file to
+# see if it contained response items
+#
+                        my ($origfile,@libfilekeys);
+                        my %currmetaentry = %metaentry;
+                        @libfilekeys = split(/,/,&metadata($location,'keys',undef,undef,undef,
+                                                           $depthcount+1));
+                        if (grep(/^responseorder$/,@libfilekeys)) {
+                            my $libresponseorder = &metadata($location,'responseorder',undef,undef,
+                                                             undef,$depthcount+1);
+                            if ($libresponseorder ne '') {
+                                if ($#origfiletagids<0) {
+                                    undef(%importedrespids);
+                                    undef(%importedpartids);
+                                }
+                                my @respids = split(/\s*,\s*/,$libresponseorder);
+                                if (@respids) {
+                                    $importedrespids{$importid} = join(',',map { $importid.'_'.$_ } @respids);
+                                }
+                                if ($importedrespids{$importid} ne '') {
+                                    $importedresponses = 1;
+# We need to get the original file and the imported file to get the response order correct
+# Load and inspect original file
+                                    if ($#origfiletagids<0) {
+                                        my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);
+                                        $origfile=&getfile($origfilelocation);
+                                        @origfiletagids=($origfile=~/<((?:\w+)response|import|part)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
+                                    }
+                                }
+                            }
+                        }
+# Do not overwrite contents of %metaentry hash for resource itself with 
+# hash populated for imported library file
+                        %metaentry = %currmetaentry;
+                        undef(%currmetaentry);
+                        if ($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 original file if we didn't do that already
+                           if ($#origfiletagids<0) {
+                               undef(%importedrespids);
+                               undef(%importedpartids);
+                               if ($origfile eq '') {
+                                   my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);
+                                   $origfile=&getfile($origfilelocation);
+                                   @origfiletagids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
+                               }
+                           }
+                           my @impfilepartids;
+# If <partorder> tag is included in metadata for the imported file
+# get the parts in the imported file from that.
+                           if (grep(/^partorder$/,@libfilekeys)) {
+                               %currmetaentry = %metaentry;
+                               my $libpartorder = &metadata($location,'partorder',undef,undef,undef,
+                                                            $depthcount+1);
+                               %metaentry = %currmetaentry;
+                               undef(%currmetaentry);
+                               if ($libpartorder ne '') {
+                                   @impfilepartids=split(/\s*,\s*/,$libpartorder);
+                               }
+                           } else {
+# If no <partorder> tag available, load and inspect imported file
+                               my $impfile=&getfile($location);
+                               @impfilepartids=($impfile=~/<part[^>]*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);
@@ -11294,22 +12180,36 @@ sub metadata {
                                $importedpartids{$token->[2]->{'id'}}=$token->[2]->{'id'};
                            }
                         } else {
+# Import as problem or as normal import
+                            $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'});
+                            unless ($importmode eq 'problem') {
 # Normal import
-                           $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'});
-                           if (defined($token->[2]->{'id'})) {
-                              $unikey.='_'.$token->[2]->{'id'};
-                           }
+                                if (defined($token->[2]->{'id'})) {
+                                    $unikey.='_'.$token->[2]->{'id'};
+                                }
+                            }
+# Check metadata for imported file to
+# see if it contained parts
+                            if (grep(/^partorder$/,@libfilekeys)) {
+                                %currmetaentry = %metaentry;
+                                my $libpartorder = &metadata($location,'partorder',undef,undef,undef,
+                                                             $depthcount+1);
+                                %metaentry = %currmetaentry;
+                                undef(%currmetaentry);
+                                if ($libpartorder ne '') {
+                                    $importedparts = 1;
+                                    $importedpartids{$token->[2]->{'id'}}=$libpartorder;
+                                }
+                            }
                         }
-
 			if ($depthcount<20) {
 			    my $metadata = 
-				&metadata($uri,'keys', $location,$unikey,
+				&metadata($uri,'keys',$toolsymb,$location,$unikey,
 					  $depthcount+1);
 			    foreach my $meta (split(',',$metadata)) {
 				$metaentry{':'.$meta}=$metaentry{':'.$meta};
 				$metathesekeys{$meta}=1;
 			    }
-			
                         }
 		    } else {
 #
@@ -11378,7 +12278,7 @@ sub metadata {
 		$dir=~s|[^/]*$||;
 		$location=&filelocation($dir,$location);
 		my $rights_metadata =
-		    &metadata($uri,'keys',$location,'_rights',
+		    &metadata($uri,'keys',$toolsymb,$location,'_rights',
 			      $depthcount+1);
 		foreach my $rights (split(',',$rights_metadata)) {
 		    #$metaentry{':'.$rights}=$metacache{$uri}->{':'.$rights};
@@ -11392,26 +12292,57 @@ sub metadata {
 	    grep { ! $seen{$_} ++ } (split(',',$metaentry{':packages'}));
 	$metaentry{':packages'} = join(',',@uniq_packages);
 
-        if ($importedparts) {
+        if (($importedresponses) || ($importedparts)) {
+            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{':partorder'}='';
+                $metathesekeys{'partorder'}=1;
+            }
+            if ($importedresponses) {
+# We had imported responses and need to rebuil responseorder
+                $metaentry{':responseorder'}='';
+                $metathesekeys{'responseorder'}=1;
+            }
+            for (my $index=0;$index<$#origfiletagids;$index+=2) {
+                my $origid = $origfiletagids[$index+1];
+                if ($origfiletagids[$index] eq 'part') {
+# Original part, part of the problem
+                    if ($importedparts) {
+                        $metaentry{':partorder'}.=','.$origid;
+                    }
+                } elsif ($origfiletagids[$index] eq 'import') {
+                    if ($importedparts) {
+# We have imported parts at this position
+                        if ($importedpartids{$origid} ne '') {
+                            $metaentry{':partorder'}.=','.$importedpartids{$origid};
+                        }
+                    }
+                    if ($importedresponses) {
+# We have imported responses at this position
+                        if ($importedrespids{$origid} ne '') {
+                            $metaentry{':responseorder'}.=','.$importedrespids{$origid};
+                        }
+                    }
+                } else {
+# Original response item, part of the problem
+                    if ($importedresponses) {
+                        $metaentry{':responseorder'}.=','.$origid;
+                    }
+                }
+            }
+            if ($importedparts) {
+                $metaentry{':partorder'}=~s/^\,//;
+            }
+            if ($importedresponses) {
+                $metaentry{':responseorder'}=~s/^\,//;
+            }
         }
-
 	$metaentry{':keys'} = join(',',keys(%metathesekeys));
 	&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
 	$metaentry{':allpossiblekeys'}=join(',',keys(%metathesekeys));
-	&do_cache_new('meta',$uri,\%metaentry,$cachetime);
+        unless ($liburi) {
+	    &do_cache_new('meta',$uri,\%metaentry,$cachetime);
+        }
 # this is the end of "was not already recently cached
     }
     return $metaentry{':'.$what};
@@ -12421,17 +13352,17 @@ sub repcopy_userfile {
     }
 # now the path exists for sure
 # get a user agent
-    my $ua=new LWP::UserAgent;
     my $transferfile=$file.'.in.transfer';
 # FIXME: this should flock
     if (-e $transferfile) { return 'ok'; }
     my $request;
     $uri=~s/^\///;
     my $homeserver = &homeserver($cnum,$cdom);
+    my $hostname = &hostname($homeserver);
     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);
+    $request=new HTTP::Request('GET',$protocol.'://'.$hostname.'/raw/'.$uri);
+    my $response = &LONCAPA::LWPReq::makerequest($homeserver,$request,$transferfile,\%perlvar,'',0,1);
 # did it work?
     if ($response->is_error()) {
 	unlink($transferfile);
@@ -12454,9 +13385,10 @@ sub tokenwrapper {
 	$file=~s|(\?\.*)*$||;
         &appenv({"userfile.$udom/$uname/$file" => $env{'request.course.id'}});
         my $homeserver = &homeserver($uname,$udom);
+        my $hostname = &hostname($homeserver);
         my $protocol = $protocol{$homeserver};
         $protocol = 'http' if ($protocol ne 'https');
-        return $protocol.'://'.&hostname($homeserver).'/'.$uri.
+        return $protocol.'://'.$hostname.'/'.$uri.
                (($uri=~/\?/)?'&':'?').'token='.$token.
                                '&tokenissued='.$perlvar{'lonHostID'};
     } else {
@@ -12472,12 +13404,12 @@ sub getuploaded {
     my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_;
     $uri=~s/^\///;
     my $homeserver = &homeserver($cnum,$cdom);
+    my $hostname = &hostname($homeserver);
     my $protocol = $protocol{$homeserver};
     $protocol = 'http' if ($protocol ne 'https');
-    $uri = $protocol.'://'.&hostname($homeserver).'/raw/'.$uri;
-    my $ua=new LWP::UserAgent;
+    $uri = $protocol.'://'.$hostname.'/raw/'.$uri;
     my $request=new HTTP::Request($reqtype,$uri);
-    my $response=$ua->request($request);
+    my $response=&LONCAPA::LWPReq::makerequest($homeserver,$request,'',\%perlvar,'',0,1);
     $$rtncode = $response->code;
     if (! $response->is_success()) {
 	return 'failed';
@@ -12494,7 +13426,7 @@ sub readfile {
     my $file = shift;
     if ( (! -e $file ) || ($file eq '') ) { return -1; };
     my $fh;
-    open($fh,"<$file");
+    open($fh,"<",$file);
     my $a='';
     while (my $line = <$fh>) { $a .= $line; }
     return $a;
@@ -12607,7 +13539,7 @@ sub machine_ids {
 
 sub additional_machine_domains {
     my @domains;
-    open(my $fh,"<$perlvar{'lonTabDir'}/expected_domains.tab");
+    open(my $fh,"<","$perlvar{'lonTabDir'}/expected_domains.tab");
     while( my $line = <$fh>) {
         $line =~ s/\s//g;
         push(@domains,$line);
@@ -12628,6 +13560,44 @@ sub default_login_domain {
     return $domain;
 }
 
+sub uses_sts {
+    my ($ignore_cache) = @_;
+    my $lonhost = $perlvar{'lonHostID'};
+    my $hostname = &hostname($lonhost);
+    my $sts_on;
+    if ($protocol{$lonhost} eq 'https') {
+        my $cachetime = 12*3600;
+        if (!$ignore_cache) {
+            ($sts_on,my $cached)=&is_cached_new('stspolicy',$lonhost);
+            if (defined($cached)) {
+                return $sts_on;
+            }
+        }
+        my $url = $protocol{$lonhost}.'://'.$hostname.'/index.html';
+        my $request=new HTTP::Request('HEAD',$url);
+        my $response=&LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,'','','',1);
+        if ($response->is_success) {
+            my $has_sts = $response->header('Strict-Transport-Security');
+            if ($has_sts eq '') {
+                $sts_on = 0;
+            } else {
+                if ($has_sts =~ /\Qmax-age=\E(\d+)/) {
+                    my $maxage = $1;
+                    if ($maxage) {
+                        $sts_on = 1;
+                    } else {
+                        $sts_on = 0;
+                    }
+                } else {
+                    $sts_on = 0;
+                }
+            }
+            return &do_cache_new('stspolicy',$lonhost,$sts_on,$cachetime);
+        }
+    }
+    return;
+}
+
 # ------------------------------------------------------------- Declutters URLs
 
 sub declutter {
@@ -12678,7 +13648,7 @@ sub clutter {
 #		&logthis("Got a blank emb style");
 	    }
 	}
-    } elsif ($thisfn =~ m{^/adm/$match_domain/$match_courseid/\d+/exttools?$}) {
+    } elsif ($thisfn =~ m{^/adm/$match_domain/$match_courseid/\d+/ext\.tool$}) {
         $thisfn='/adm/wrapper'.$thisfn;
     }
     return $thisfn;
@@ -12753,37 +13723,51 @@ sub get_dns {
     }
 
     my %alldns;
-    open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
-    foreach my $dns (<$config>) {
-	next if ($dns !~ /^\^(\S*)/x);
-        my $line = $1;
-        my ($host,$protocol) = split(/:/,$line);
-        if ($protocol ne 'https') {
-            $protocol = 'http';
+    if (open(my $config,"<","$perlvar{'lonTabDir'}/hosts.tab")) {
+        foreach my $dns (<$config>) {
+	    next if ($dns !~ /^\^(\S*)/x);
+            my $line = $1;
+            my ($host,$protocol) = split(/:/,$line);
+            if ($protocol ne 'https') {
+                $protocol = 'http';
+            }
+	    $alldns{$host} = $protocol;
         }
-	$alldns{$host} = $protocol;
+        close($config);
     }
     while (%alldns) {
 	my ($dns) = sort { $b cmp $a } keys(%alldns);
-	my $ua=new LWP::UserAgent;
-        $ua->timeout(30);
 	my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url");
-	my $response=$ua->request($request);
+        my $response = &LONCAPA::LWPReq::makerequest('',$request,'',\%perlvar,30,0);
         delete($alldns{$dns});
 	next if ($response->is_error());
-	my @content = split("\n",$response->content);
-	unless ($nocache) {
-	    &do_cache_new('dns',$url,\@content,30*24*60*60);
-	}
-	&$func(\@content,$hashref);
-	return;
+        if ($url eq '/adm/dns/loncapaCRL') {
+            return &$func($response);
+        } else {
+	    my @content = split("\n",$response->content);
+	    unless ($nocache) {
+	        &do_cache_new('dns',$url,\@content,30*24*60*60);
+	    }
+	    &$func(\@content,$hashref);
+            return;
+        }
+    }
+    my $which = (split('/',$url,4))[3];
+    if ($which eq 'loncapaCRL') {
+        my $diskfile = "$perlvar{'lonCertificateDirectory'}/$perlvar{'lonnetCertRevocationList'}";
+        if (-e $diskfile) {
+            &logthis("unable to contact DNS, on disk file $diskfile not updated");
+        } else {
+            &logthis("unable to contact DNS, no on disk file $diskfile available");
+        }
+    } else {
+        &logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n");
+        if (open(my $config,"<","$perlvar{'lonTabDir'}/dns_$which.tab")) {
+            my @content = <$config>;
+            close($config);
+            &$func(\@content,$hashref);
+        }
     }
-    close($config);
-    my $which = (split('/',$url))[3];
-    &logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n");
-    open($config,"<$perlvar{'lonTabDir'}/dns_$which.tab");
-    my @content = <$config>;
-    &$func(\@content,$hashref);
     return;
 }
 
@@ -12843,6 +13827,79 @@ sub fetch_dns_checksums {
     return \%checksums;
 }
 
+sub fetch_crl_pemfile {
+    return &get_dns("/adm/dns/loncapaCRL",\&save_crl_pem,1,1);
+}
+
+sub save_crl_pem {
+    my ($response) = @_;
+    my ($msg,$hadchanges);
+    if (ref($response)) {
+        my $now = time;
+        my $lonca = $perlvar{'lonCertificateDirectory'}.'/'.$perlvar{'lonnetCertificateAuthority'};
+        my $tmpcrl = $tmpdir.'/'.$perlvar{'lonnetCertRevocationList'}.'_'.$now.'.'.$$.'.tmp';
+        if (open(my $fh,'>',"$tmpcrl")) {
+            print $fh $response->content;
+            close($fh);
+            if (-e $lonca) {
+                if (open(PIPE,"openssl crl -in $tmpcrl -inform pem -CAfile $lonca -noout 2>&1 |")) {
+                    my $check = <PIPE>;
+                    close(PIPE);
+                    chomp($check);
+                    if ($check eq 'verify OK') {
+                        my $dest = "$perlvar{'lonCertificateDirectory'}/$perlvar{'lonnetCertRevocationList'}";
+                        my $backup;
+                        if (-e $dest) {
+                            if (&File::Copy::move($dest,"$dest.bak")) {
+                                $backup = 'ok';
+                            }
+                        }
+                        if (&File::Copy::move($tmpcrl,$dest)) {
+                            $msg = 'ok';
+                            if ($backup) {
+                                my (%oldnums,%newnums);
+                                if (open(PIPE, "openssl crl -inform PEM -text -noout -in $dest.bak |grep 'Serial Number' |")) {
+                                    while (<PIPE>) {
+                                        $oldnums{(split(/:/))[1]} = 1;
+                                    }
+                                    close(PIPE);
+                                }
+                                if (open(PIPE, "openssl crl -inform PEM -text -noout -in $dest |grep 'Serial Number' |")) {
+                                    while(<PIPE>) {
+                                        $newnums{(split(/:/))[1]} = 1;
+                                    }
+                                    close(PIPE);
+                                }
+                                foreach my $key (sort {$b <=> $a } (keys(%newnums))) {
+                                    unless (exists($oldnums{$key})) {
+                                        $hadchanges = 1;
+                                        last;
+                                    }
+                                }
+                                unless ($hadchanges) {
+                                    foreach my $key (sort {$b <=> $a } (keys(%oldnums))) {
+                                        unless (exists($newnums{$key})) {
+                                            $hadchanges = 1;
+                                            last;
+                                        }
+                                    }
+                                }
+                            }
+                        }
+                    } else {
+                        unlink($tmpcrl);
+                    }
+                } else {
+                    unlink($tmpcrl);
+                }
+            } else {
+                unlink($tmpcrl);
+            }
+        }
+    }
+    return ($msg,$hadchanges);
+}
+
 # ------------------------------------------------------------ Read domain file
 {
     my $loaded;
@@ -12874,7 +13931,7 @@ sub fetch_dns_checksums {
 	my ($ignore_cache,$nocache) = @_;
 	&get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache,$nocache);
 	my $fh;
-	if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) {
+	if (open($fh,"<",$perlvar{'lonTabDir'}.'/domain.tab')) {
 	    my @lines = <$fh>;
 	    &parse_domain_tab(\@lines);
 	}
@@ -12926,8 +13983,23 @@ sub fetch_dns_checksums {
 	    my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline);
 	    $name=~s/\s//g;
 	    if ($id && $domain && $role && $name) {
+                if ((exists($hostname{$id})) && ($hostname{$id} ne '')) {
+                    my $curr = $hostname{$id};
+                    my $skip;
+                    if (ref($name_to_host{$curr}) eq 'ARRAY') {
+                        if (($curr eq $name) && (@{$name_to_host{$curr}} == 1)) {
+                            $skip = 1;
+                        } else {
+                            @{$name_to_host{$curr}} = grep { $_ ne $id } @{$name_to_host{$curr}};
+                        }
+                    }
+                    unless ($skip) {
+                        push(@{$name_to_host{$name}},$id);
+                    }
+                } else {
+                    push(@{$name_to_host{$name}},$id);
+                }
 		$hostname{$id}=$name;
-		push(@{$name_to_host{$name}}, $id);
 		$hostdom{$id}=$domain;
 		if ($role eq 'library') { $libserv{$id}=$name; }
                 if (defined($protocol)) {
@@ -12950,6 +14022,7 @@ sub fetch_dns_checksums {
 	&purge_remembered();
 	&reset_domain_info();
 	&reset_hosts_ip_info();
+        undef(%internetdom);
 	undef(%name_to_host);
 	undef(%hostname);
 	undef(%hostdom);
@@ -12960,7 +14033,7 @@ sub fetch_dns_checksums {
     sub load_hosts_tab {
 	my ($ignore_cache,$nocache) = @_;
 	&get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache,$nocache);
-	open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
+	open(my $config,"<","$perlvar{'lonTabDir'}/hosts.tab");
 	my @config = <$config>;
 	&parse_hosts_tab(\@config);
 	close($config);
@@ -12992,6 +14065,11 @@ sub fetch_dns_checksums {
         return %hostdom;
     }
 
+    sub all_host_intdom {
+        &load_hosts_tab() if (!$loaded);
+        return %internetdom;
+    }
+
     sub is_library {
 	&load_hosts_tab() if (!$loaded);
 
@@ -13226,7 +14304,7 @@ sub all_loncaparevs {
 {
     sub load_loncaparevs { 
         if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") {
-            if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) {
+            if (open(my $config,"<","$perlvar{'lonTabDir'}/loncaparevs.tab")) {
                 while (my $configline=<$config>) {
                     chomp($configline);
                     my ($hostid,$loncaparev)=split(/:/,$configline);
@@ -13242,7 +14320,7 @@ sub all_loncaparevs {
 {
     sub load_serverhomeIDs {
         if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") {
-            if (open(my $config,"<$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
+            if (open(my $config,"<","$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
                 while (my $configline=<$config>) {
                     chomp($configline);
                     my ($name,$id)=split(/:/,$configline);
@@ -13267,7 +14345,7 @@ BEGIN {
 
 # ------------------------------------------------------ Read spare server file
 {
-    open(my $config,"<$perlvar{'lonTabDir'}/spare.tab");
+    open(my $config,"<","$perlvar{'lonTabDir'}/spare.tab");
 
     while (my $configline=<$config>) {
        chomp($configline);
@@ -13281,7 +14359,7 @@ BEGIN {
 }
 # ------------------------------------------------------------ Read permissions
 {
-    open(my $config,"<$perlvar{'lonTabDir'}/roles.tab");
+    open(my $config,"<","$perlvar{'lonTabDir'}/roles.tab");
 
     while (my $configline=<$config>) {
 	chomp($configline);
@@ -13295,7 +14373,7 @@ BEGIN {
 
 # -------------------------------------------- Read plain texts for permissions
 {
-    open(my $config,"<$perlvar{'lonTabDir'}/rolesplain.tab");
+    open(my $config,"<","$perlvar{'lonTabDir'}/rolesplain.tab");
 
     while (my $configline=<$config>) {
 	chomp($configline);
@@ -13315,7 +14393,7 @@ BEGIN {
 
 # ---------------------------------------------------------- Read package table
 {
-    open(my $config,"<$perlvar{'lonTabDir'}/packages.tab");
+    open(my $config,"<","$perlvar{'lonTabDir'}/packages.tab");
 
     while (my $configline=<$config>) {
 	if ($configline !~ /\S/ || $configline=~/^#/) { next; }
@@ -13369,7 +14447,7 @@ BEGIN {
 # ---------------------------------------------------------- Read managers table
 {
     if (-e "$perlvar{'lonTabDir'}/managers.tab") {
-        if (open(my $config,"<$perlvar{'lonTabDir'}/managers.tab")) {
+        if (open(my $config,"<","$perlvar{'lonTabDir'}/managers.tab")) {
             while (my $configline=<$config>) {
                 chomp($configline);
                 next if ($configline =~ /^\#/);
@@ -13745,9 +14823,10 @@ in which case the null string is returne
 
 =item *
 
-definerole($rolename,$sysrole,$domrole,$courole) : define role; define a custom
-role rolename set privileges in format of lonTabs/roles.tab for system, domain,
-and course level
+definerole($rolename,$sysrole,$domrole,$courole,$uname,$udom) : define role;
+define a custom role rolename set privileges in format of lonTabs/roles.tab
+for system, domain, and course level. $uname and $udom are optional (current
+user's username and domain will be used when either of $uname or $udom are absent.
 
 =item *
 
@@ -14107,12 +15186,18 @@ condval($condidx) : value of condition i
 
 =item *
 
-metadata($uri,$what,$liburi,$prefix,$depthcount) : request a
+metadata($uri,$what,$toolsymb,$liburi,$prefix,$depthcount) : request a
 resource's metadata, $what should be either a specific key, or either
 'keys' (to get a list of possible keys) or 'packages' to get a list of
-packages that this resource currently uses, the last 3 arguments are only used internally for recursive metadata.
+packages that this resource currently uses, the last 3 arguments are 
+only used internally for recursive metadata.
+
+the toolsymb is only used where the uri is for an external tool (for which
+the uri as well as the symb are guaranteed to be unique).
 
-this function automatically caches all requests
+this function automatically caches all requests except any made recursively
+to retrieve a list of metadata keys for an imported library file ($liburi is 
+defined).
 
 =item *