loncom/lonnet/perl/lonnet.pm - diff

Return to lonnet.pm CVS log

Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1172.2.96 and 1.1503

-version 1.1172.2.96, 2018/09/02 23:22:47
+version 1.1503, 2022/12/31 14:09:00
  Line 71  delayed.
  package Apache::lonnet;
  use strict;
- use LWP::UserAgent();
  use HTTP::Date;
  use Image::Magick;
+ use CGI::Cookie;
- use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
+ use Encode;
+ use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir $deftex
              $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease
-             %managerstab);
+             %managerstab $passwdmin);
  my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,
      %userrolehash, $processmarker, $dumpcount, %coursedombuf,
- Line 94  use Cache::Memcached;
+ Line 96  use Cache::Memcached;
  use Digest::MD5;
  use Math::Random;
  use File::MMagic;
+ use Net::CIDR;
+ use Sys::Hostname::FQDN();
  use LONCAPA qw(:DEFAULT :match);
  use LONCAPA::Configuration;
  use LONCAPA::lonmetadata;
  use LONCAPA::Lond;
+ use LONCAPA::LWPReq;
+ use LONCAPA::transliterate;
  use File::Copy;
- Line 109  require Exporter;
+ Line 115  require Exporter;
  our @ISA = qw (Exporter);
  our @EXPORT = qw(%env);
  # ------------------------------------ Logging (parameters, docs, slots, roles)
  {
      my $logid;
- Line 123  our @EXPORT = qw(%env);
+ Line 130  our @EXPORT = qw(%env);
  	$logid ++;
          my $now = time();
  	my $id=$now.'00000'.$$.'00000'.$logid;
-         my $logentry = {
+         my $ip = &get_requestor_ip();
-                          $id => {
+         my $logentry = {
-                                   'exe_uname' => $env{'user.name'},
+                           $id => {
-                                   'exe_udom'  => $env{'user.domain'},
+                                    'exe_uname' => $env{'user.name'},
-                                   'exe_time'  => $now,
+                                    'exe_udom'  => $env{'user.domain'},
-                                   'exe_ip'    => $ENV{'REMOTE_ADDR'},
+                                    'exe_time'  => $now,
-                                   'delflag'   => $delflag,
+                                    'exe_ip'    => $ip,
-                                   'logentry'  => $storehash,
+                                    'delflag'   => $delflag,
-                                   'uname'     => $uname,
+                                    'logentry'  => $storehash,
-                                   'udom'      => $udom,
+                                    'uname'     => $uname,
-                                 }
+                                    'udom'      => $udom,
+                                   }
                         };
-         return &put('nohist_'.$hash_name,$logentry,$cdom,$cnum);
+ 	return &put('nohist_'.$hash_name,$logentry,$cdom,$cnum);
      }
  }
- Line 180  sub create_connection {
+ Line 188  sub create_connection {
  				     Type    => SOCK_STREAM,
  				     Timeout => 10);
      return 0 if (!$client);
-     print $client (join(':',$hostname,$lonid,&machine_ids($hostname))."\n");
+     print $client (join(':',$hostname,$lonid,&machine_ids($hostname),$loncaparevs{$lonid})."\n");
      my $result = <$client>;
      chomp($result);
      return 1 if ($result eq 'done');
- Line 225  sub get_server_distarch {
+ Line 233  sub get_server_distarch {
      return;
  }
+ sub get_servercerts_info {
+     my ($lonhost,$hostname,$context) = @_;
+     return if ($lonhost eq '');
+     if ($hostname eq '') {
+         $hostname = &hostname($lonhost);
+     }
+     return if ($hostname eq '');
+     my ($rep,$uselocal);
+     if ($context eq 'install') {
+         $uselocal = 1;
+     } elsif (grep { $_ eq $lonhost } &current_machine_ids()) {
+         $uselocal = 1;
+     }
+     if (($context ne 'cgi') && ($context ne 'install') && ($uselocal)) {
+         my $distro = (split(/\:/,&get_server_distarch($lonhost)))[0];
+         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,$lonhost,$hostname);
+     } else {
+         $rep=&reply('servercerts',$lonhost);
+     }
+     my ($result,%returnhash);
+     if (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') ||
+         ($rep eq 'unknown_cmd')) {
+         $result = $rep;
+     } else {
+         $result = 'ok';
+         my @pairs=split(/\&/,$rep);
+         foreach my $item (@pairs) {
+             my ($key,$value)=split(/=/,$item,2);
+             my $what = &unescape($key);
+             $returnhash{$what}=&thaw_unescape($value);
+         }
+     }
+     return ($result,\%returnhash);
+ }
  sub get_server_loncaparev {
      my ($dom,$lonhost,$ignore_cache,$caller) = @_;
      if (defined($lonhost)) {
- Line 259  sub get_server_loncaparev {
+ Line 315  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;
+                     my $hostname = &hostname($lonhost);
-                     $ua->timeout(4);
                      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>/) {
- Line 356  sub remote_devalidate_cache {
+ Line 411  sub remote_devalidate_cache {
      my $items;
      return unless (ref($cachekeys) eq 'ARRAY');
      my $cachestr = join('&',@{$cachekeys});
-     return &reply('devalidatecache:'.&escape($cachestr),$lonhost);
+     my $response = &reply('devalidatecache:'.&escape($cachestr),$lonhost);
+     return $response;
  }
  # -------------------------------------------------- Non-critical communication
- Line 388  sub subreply {
+ Line 444  sub subreply {
  	} else {
  	    &create_connection(&hostname($server),$server);
  	}
-         sleep(0.1);		# Try again later if failed connection.
+         sleep(0.1);	# Try again later if failed connection.
      }
      my $answer;
      if ($client) {
- Line 407  sub reply {
+ Line 463  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:".
+         my $logged = $cmd;
-                 " $cmd to $server returned $answer</font>");
+         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') ||
+                 ($subcmd eq 'put')) {
+                 (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') || ($subcmd eq 'put')) {
+                     splice(@rest,3,1,'Hidden');
+                 }
+                 $logged = join(':',('encrypt:'.$subcmd,@rest));
+             }
+         }
+         &logthis("<font color=\"blue\">WARNING:".
+                  " $logged to $server returned $answer</font>");
      }
      return $answer;
  }
- Line 443  sub reconlonc {
+ Line 518  sub reconlonc {
  	    &logthis("lonc at pid $loncpid responding, sending USR1");
              kill USR1 => $loncpid;
              sleep 1;
-          } else {
+         } else {
  	    &logthis(
                 "<font color=\"blue\">WARNING:".
                 " lonc at pid $loncpid not responding, giving up</font>");
- Line 603  sub transfer_profile_to_env {
+ Line 678  sub transfer_profile_to_env {
  sub check_for_valid_session {
      my ($r,$name,$userhashref,$domref) = @_;
      my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
-     if ($name eq '') {
+     my ($lonidsdir,$linkname,$pubname,$secure,$lonid);
-         $name = 'lonID';
-     }
-     my $lonid=$cookies{$name};
-     return undef if (!$lonid);
-     my $handle=&LONCAPA::clean_handle($lonid->value);
-     my $lonidsdir;
      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})) && ($ENV{'SERVER_PORT'} != 443)) {
+             $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)) {
- Line 639  sub check_for_valid_session {
+ Line 735  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'};
+         if ($disk_env{'request.role'}) {
+             $userhashref->{'role'} = $disk_env{'request.role'};
+         }
+         $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;
  }
- Line 670  sub timed_flock {
+ Line 776  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 {
- Line 823  sub userload {
+ Line 960  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++; }
  	}
- Line 840  sub userload {
+ Line 978  sub userload {
  # ------------------------------ Find server with least workload from spare.tab
  sub spareserver {
-     my ($loadpercent,$userloadpercent,$want_server_name,$udom) = @_;
+     my ($r,$loadpercent,$userloadpercent,$want_server_name,$udom) = @_;
      my $spare_server;
      if ($userloadpercent !~ /\d/) { $userloadpercent=0; }
      my $lowest_load=($loadpercent > $userloadpercent) ? $loadpercent
                                                       :  $userloadpercent;
      my ($uint_dom,$remotesessions);
      if (($udom ne '') && (&domain($udom) ne '')) {
-         my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
+         my $uprimary_id = &domain($udom,'primary');
-         $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
+         $uint_dom = &internet_dom($uprimary_id);
-         my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom);
+         my %udomdefaults = &get_domain_defaults($udom);
          $remotesessions = $udomdefaults{'remotesessions'};
      }
      my $spareshash = &this_host_spares($udom);
- Line 878  sub spareserver {
+ Line 1016  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};
+                 }
+                 my $alias = &use_proxy_alias($r,$spare_server);
+                 $hostname = $alias if ($alias ne '');
  	        $spare_server = $protocol.'://'.$hostname;
              }
          }
- Line 951  sub find_existing_session {
+ Line 1091  sub find_existing_session {
      return;
  }
+ sub delusersession {
+     my ($lonid,$udom,$uname) = @_;
+     my $uprimary_id = &domain($udom,'primary');
+     my $uintdom = &internet_dom($uprimary_id);
+     my $intdom = &internet_dom($lonid);
+     my $serverhomedom = &host_domain($lonid);
+     if (($uintdom ne '') && ($uintdom eq $intdom)) {
+         return &reply(join(':','delusersession',
+                             map {&escape($_)} ($udom,$uname)),$lonid);
+     }
+     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 updatebalcookie {
+     my ($cookie,$balancer,$lastentry)=@_;
+     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('updatebalcookie:'.&escape($cookie).':'.&escape($lastentry),$balancer);
+         }
+     }
+     return;
+ }
+ 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:'.&escape($cookie),$balancer);
+         }
+     }
+ }
  # -------------------------------- ask if server already has a session for user
  sub has_user_session {
      my ($lonid,$udom,$uname) = @_;
- Line 974  sub choose_server {
+ Line 1211  sub choose_server {
          unless (defined($cached)) {
              my $cachetime = 60*60*24;
              my %domconfig =
-                 &Apache::lonnet::get_dom('configuration',['loadbalancing'],$udom);
+                 &get_dom('configuration',['loadbalancing'],$udom);
              if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
                  $balancers = &do_cache_new('loadbalancing',$udom,$domconfig{'loadbalancing'},
                                             $cachetime);
- Line 982  sub choose_server {
+ Line 1219  sub choose_server {
          }
      }
      foreach my $lonhost (keys(%servers)) {
-         my $loginvia;
          if ($skiploadbal) {
              if (ref($balancers) eq 'HASH') {
                  next if (exists($balancers->{$lonhost}));
              }
          }
+         my $loginvia;
          if ($checkloginvia) {
              $loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost};
              if ($loginvia) {
- Line 1017  sub choose_server {
+ Line 1254  sub choose_server {
      return ($login_host,$hostname,$portal_path,$isredirect,$lowest_load);
  }
+ sub get_course_sessions {
+     my ($cnum,$cdom,$lastactivity) = @_;
+     my %servers = &internet_dom_servers($cdom);
+     my %returnhash;
+     foreach my $server (sort(keys(%servers))) {
+         my $rep = &reply("coursesessions:$cdom:$cnum:$lastactivity",$server);
+         my @pairs=split(/\&/,$rep);
+         unless (($rep eq 'unknown_cmd') || ($rep =~ /^error/)) {
+             foreach my $item (@pairs) {
+                 my ($key,$value)=split(/=/,$item,2);
+                 $key = &unescape($key);
+                 next if ($key =~ /^error: 2 /);
+                 if (exists($returnhash{$key})) {
+                     next if ($value < $returnhash{$key});
+                 }
+                 $returnhash{$key}=$value;
+             }
+         }
+     }
+     return %returnhash;
+ }
  # --------------------------------------------- Try to change a user's password
  sub changepass {
- Line 1052  sub changepass {
+ Line 1311  sub changepass {
      } elsif ($answer =~ "invalid_client") {
          &logthis("$server refused to change $uname in $udom password because ".
                   "it was a reset by e-mail originating from an invalid server.");
+     } elsif ($answer =~ "^prioruse") {
+        &logthis("$server refused to change $uname in $udom password because ".
+                 "the password had been used before");
      }
      return $answer;
  }
- Line 1061  sub changepass {
+ Line 1323  sub changepass {
  sub queryauthenticate {
      my ($uname,$udom)=@_;
      my $uhome=&homeserver($uname,$udom);
-     if (!$uhome) {
+     if ((!$uhome) || ($uhome eq 'no_host')) {
  	&logthis("User $uname at $udom is unknown when looking for authentication mechanism");
  	return 'no_host';
      }
- Line 1110  sub authenticate {
+ Line 1372  sub authenticate {
      }
      if ($answer eq 'non_authorized') {
  	&logthis("User $uname at $udom rejected by $uhome");
  	return 'no_host';
      }
      &logthis("User $uname at $udom threw error $answer when checking authentication mechanism");
      return 'no_host';
  }
+ sub can_switchserver {
+     my ($udom,$home) = @_;
+     my ($canswitch,@intdoms);
+     my $internet_names = &get_internet_names($home);
+     if (ref($internet_names) eq 'ARRAY') {
+         @intdoms = @{$internet_names};
+     }
+     my $uint_dom = &internet_dom(&domain($udom,'primary'));
+     if ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {
+         $canswitch = 1;
+     } else {
+          my $serverhomeID = &get_server_homeID(&hostname($home));
+          my $serverhomedom = &host_domain($serverhomeID);
+          my %defdomdefaults = &get_domain_defaults($serverhomedom);
+          my %udomdefaults = &get_domain_defaults($udom);
+          my $remoterev = &get_server_loncaparev('',$home);
+          $canswitch = &can_host_session($udom,$home,$remoterev,
+                                         $udomdefaults{'remotesessions'},
+                                         $defdomdefaults{'hostedsessions'});
+     }
+     return $canswitch;
+ }
  sub can_host_session {
      my ($udom,$lonhost,$remoterev,$remotesessions,$hostedsessions) = @_;
      my $canhost = 1;
-     my $host_idn = &Apache::lonnet::internet_dom($lonhost);
+     my $host_idn = &internet_dom($lonhost);
      if (ref($remotesessions) eq 'HASH') {
          if (ref($remotesessions->{'excludedomain'}) eq 'ARRAY') {
              if (grep(/^\Q$host_idn\E$/,@{$remotesessions->{'excludedomain'}})) {
- Line 1155  sub can_host_session {
+ Line 1440  sub can_host_session {
      }
      if ($canhost) {
          if (ref($hostedsessions) eq 'HASH') {
-             my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
+             my $uprimary_id = &domain($udom,'primary');
-             my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
+             my $uint_dom = &internet_dom($uprimary_id);
              if (ref($hostedsessions->{'excludedomain'}) eq 'ARRAY') {
                  if (($uint_dom ne '') &&
                      (grep(/^\Q$uint_dom\E$/,@{$hostedsessions->{'excludedomain'}}))) {
- Line 1190  sub spare_can_host {
+ Line 1475  sub spare_can_host {
              $canhost = 0;
          }
      }
+     if ($canhost) {
+         if (ref($defdomdefaults{'offloadoth'}) eq 'HASH') {
+             if ($defdomdefaults{'offloadoth'}{$try_server}) {
+                 unless (&shared_institution($udom,$try_server)) {
+                     $canhost = 0;
+                 }
+             }
+         }
+     }
      if (($canhost) && ($uint_dom)) {
          my @intdoms;
          my $internet_names = &get_internet_names($try_server);
- Line 1239  sub spares_for_offload  {
+ Line 1533  sub spares_for_offload  {
      } else {
          my $cachetime = 60*60*24;
          my %domconfig =
-             &Apache::lonnet::get_dom('configuration',['usersessions'],$dom_in_use);
+             &get_dom('configuration',['usersessions'],$dom_in_use);
          if (ref($domconfig{'usersessions'}) eq 'HASH') {
              if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') {
                  if (ref($domconfig{'usersessions'}{'spares'}{$lonhost_in_use}) eq 'HASH') {
- Line 1288  sub get_lonbalancer_config {
+ Line 1582  sub get_lonbalancer_config {
  sub check_loadbalancing {
      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');
+     my $uprimary_id = &domain($udom,'primary');
-     my $uintdom = &Apache::lonnet::internet_dom($uprimary_id);
+     my $uintdom = &internet_dom($uprimary_id);
-     my $intdom = &Apache::lonnet::internet_dom($lonhost);
+     my $intdom = &internet_dom($lonhost);
      my $serverhomedom = &host_domain($lonhost);
      my $domneedscache;
      my $cachetime = 60*60*24;
      if (($uintdom ne '') && ($uintdom eq $intdom)) {
- Line 1307  sub check_loadbalancing {
+ Line 1601  sub check_loadbalancing {
      my ($result,$cached)=&is_cached_new('loadbalancing',$dom_in_use);
      unless (defined($cached)) {
          my %domconfig =
-             &Apache::lonnet::get_dom('configuration',['loadbalancing'],$dom_in_use);
+             &get_dom('configuration',['loadbalancing'],$dom_in_use);
          if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
              $result = &do_cache_new('loadbalancing',$dom_in_use,$domconfig{'loadbalancing'},$cachetime);
          } else {
- Line 1315  sub check_loadbalancing {
+ Line 1609  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') {
- Line 1368  sub check_loadbalancing {
+ Line 1662  sub check_loadbalancing {
          ($result,$cached)=&is_cached_new('loadbalancing',$serverhomedom);
          unless (defined($cached)) {
              my %domconfig =
-                 &Apache::lonnet::get_dom('configuration',['loadbalancing'],$serverhomedom);
+                 &get_dom('configuration',['loadbalancing'],$serverhomedom);
              if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
                  $result = &do_cache_new('loadbalancing',$serverhomedom,$domconfig{'loadbalancing'},$cachetime);
              } else {
- Line 1376  sub check_loadbalancing {
+ Line 1670  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') {
- Line 1408  sub check_loadbalancing {
+ Line 1702  sub check_loadbalancing {
      if ($domneedscache) {
          &do_cache_new('loadbalancing',$domneedscache,$is_balancer,$cachetime);
      }
-     if ($is_balancer) {
+     if (($is_balancer) && ($caller ne 'switchserver')) {
          my $lowest_load = 30000;
          if (ref($offloadto) eq 'HASH') {
              if (ref($offloadto->{'primary'}) eq 'ARRAY') {
- Line 1442  sub check_loadbalancing {
+ Line 1736  sub check_loadbalancing {
                  $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});
                      }
- Line 1450  sub check_loadbalancing {
+ Line 1743  sub check_loadbalancing {
              }
          }
      }
-     return ($is_balancer,$otherserver);
+     if (($is_balancer) && (!$homeintdom)) {
+         undef($setcookie);
+     }
+     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'};
- Line 1464  sub check_balancer_result {
+ Line 1760  sub check_balancer_result {
                  $currtargets = $result->{'targets'};
                  $currrules = $result->{'rules'};
              }
+             $dom_balancers = $currbalancer;
          } else {
-             foreach my $key (keys(%{$result})) {
+             if (keys(%{$result})) {
-                 if (($key ne '') && (grep(/^\Q$key\E$/,@hosts)) &&
+                 foreach my $key (keys(%{$result})) {
-                     (ref($result->{$key}) eq 'HASH')) {
+                     if (($key ne '') && (grep(/^\Q$key\E$/,@hosts)) &&
-                     $is_balancer = 1;
+                         (ref($result->{$key}) eq 'HASH')) {
-                     $currrules = $result->{$key}{'rules'};
+                         $is_balancer = 1;
-                     $currtargets = $result->{$key}{'targets'};
+                         $currrules = $result->{$key}{'rules'};
-                     last;
+                         $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 {
- Line 1494  sub get_loadbalancer_targets {
+ Line 1795  sub get_loadbalancer_targets {
              }
          } elsif ($rule_in_effect eq 'externalbalancer') {
              my %domconfig =
-                 &Apache::lonnet::get_dom('configuration',['loadbalancing'],$udom);
+                 &get_dom('configuration',['loadbalancing'],$udom);
              if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
                  if ($domconfig{'loadbalancing'}{'lonhost'} ne '') {
                      if (&hostname($domconfig{'loadbalancing'}{'lonhost'}) ne '') {
- Line 1548  sub internet_dom_servers {
+ Line 1849  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 = &internet_dom($callprimary);
+     if ($intcalldom eq '') {
+         return ($trusted,$untrusted);
+     }
+     my ($trustconfig,$cached)=&is_cached_new('trust',$calldom);
+     unless (defined($cached)) {
+         my %domconfig = &get_dom('configuration',['trust'],$calldom);
+         &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;
- Line 1573  sub homeserver {
+ Line 1969  sub homeserver {
      return 'no_host';
  }
- # ------------------------------------- Find the usernames behind a list of IDs
+ # ----- Find the usernames behind a list of student/employee IDs or clicker IDs
  sub idget {
-     my ($udom,@ids)=@_;
+     my ($udom,$idsref,$namespace)=@_;
      my %returnhash=();
+     my @ids=();
+     if (ref($idsref) eq 'ARRAY') {
+         @ids = @{$idsref};
+     } else {
+         return %returnhash;
+     }
+     if ($namespace eq '') {
+         $namespace = 'ids';
+     }
      my %servers = &get_servers($udom,'library');
      foreach my $tryserver (keys(%servers)) {
  	my $idlist=join('&', map { &escape($_); } @ids);
- 	$idlist=~tr/A-Z/a-z/;
+ 	if ($namespace eq 'ids') {
- 	my $reply=&reply("idget:$udom:".$idlist,$tryserver);
+ 	    $idlist=~tr/A-Z/a-z/;
+ 	}
+ 	my $reply;
+ 	if ($namespace eq 'ids') {
+ 	    $reply=&reply("idget:$udom:".$idlist,$tryserver);
+ 	} else {
+ 	    $reply=&reply("getdom:$udom:$namespace:$idlist",$tryserver);
+ 	}
  	my @answer=();
  	if (($reply ne 'con_lost') && ($reply!~/^error\:/)) {
  	    @answer=split(/\&/,$reply);
- Line 1592  sub idget {
+ Line 2004  sub idget {
  	for ($i=0;$i<=$#ids;$i++) {
  	    if ($answer[$i]) {
  		$returnhash{$ids[$i]}=&unescape($answer[$i]);
  	    }
  	}
      }
      return %returnhash;
  }
- Line 1609  sub idrget {
+ Line 2021  sub idrget {
      return %returnhash;
  }
- # ------------------------------- Store away a list of names and associated IDs
+ # Store away a list of names and associated student/employee IDs or clicker IDs
  sub idput {
-     my ($udom,%ids)=@_;
+     my ($udom,$idsref,$uhom,$namespace)=@_;
      my %servers=();
+     my %ids=();
+     my %byid = ();
+     if (ref($idsref) eq 'HASH') {
+         %ids=%{$idsref};
+     }
+     if ($namespace eq '') {
+         $namespace = 'ids';
+     }
      foreach my $uname (keys(%ids)) {
  	&cput('environment',{'id'=>$ids{$uname}},$udom,$uname);
-         my $uhom=&homeserver($uname,$udom);
+         if ($uhom eq '') {
+             $uhom=&homeserver($uname,$udom);
+         }
          if ($uhom ne 'no_host') {
-             my $id=&escape($ids{$uname});
-             $id=~tr/A-Z/a-z/;
              my $esc_unam=&escape($uname);
- 	    if ($servers{$uhom}) {
+             if ($namespace eq 'ids') {
- 		$servers{$uhom}.='&'.$id.'='.$esc_unam;
+                 my $id=&escape($ids{$uname});
+                 $id=~tr/A-Z/a-z/;
+                 my $esc_unam=&escape($uname);
+                 $servers{$uhom}.=$id.'='.$esc_unam.'&';
              } else {
-                 $servers{$uhom}=$id.'='.$esc_unam;
+                 my @currids = split(/,/,$ids{$uname});
+                 foreach my $id (@currids) {
+                     $byid{$uhom}{$id} .= $uname.',';
+                 }
+             }
+         }
+     }
+     if ($namespace eq 'clickers') {
+         foreach my $server (keys(%byid)) {
+             if (ref($byid{$server}) eq 'HASH') {
+                 foreach my $id (keys(%{$byid{$server}})) {
+                     $byid{$server} =~ s/,$//;
+                     $servers{$uhom}.=&escape($id).'='.&escape($byid{$server}).'&';
+                 }
              }
          }
      }
      foreach my $server (keys(%servers)) {
-         &critical('idput:'.$udom.':'.$servers{$server},$server);
+         $servers{$server} =~ s/\&$//;
+         if ($namespace eq 'ids') {
+             &critical('idput:'.$udom.':'.$servers{$server},$server);
+         } else {
+             &critical('updateclickers:'.$udom.':add:'.$servers{$server},$server);
+         }
      }
  }
- # ---------------------------------------- Delete unwanted IDs from ids.db file
+ # ------------- Delete unwanted student/employee IDs or clicker IDs from domain
  sub iddel {
-     my ($udom,$idshashref,$uhome)=@_;
+     my ($udom,$idshashref,$uhome,$namespace)=@_;
      my %result=();
-     unless (ref($idshashref) eq 'HASH') {
+     my %ids=();
+     my %byid = ();
+     if (ref($idshashref) eq 'HASH') {
+         %ids=%{$idshashref};
+     } else {
          return %result;
      }
+     if ($namespace eq '') {
+         $namespace = 'ids';
+     }
      my %servers=();
-     while (my ($id,$uname) = each(%{$idshashref})) {
+     while (my ($id,$unamestr) = each(%ids)) {
-         my $uhom;
+         if ($namespace eq 'ids') {
-         if ($uhome) {
+             my $uhom = $uhome;
-             $uhom = $uhome;
+             if ($uhom eq '') {
-         } else {
+                 $uhom=&homeserver($unamestr,$udom);
-             $uhom=&homeserver($uname,$udom);
+             }
-         }
+             if ($uhom ne 'no_host') {
-         if ($uhom ne 'no_host') {
-             if ($servers{$uhom}) {
                  $servers{$uhom}.='&'.&escape($id);
-             } else {
+             }
-                 $servers{$uhom}=&escape($id);
+          } else {
+             my @curritems = split(/,/,$ids{$id});
+             foreach my $uname (@curritems) {
+                 my $uhom = $uhome;
+                 if ($uhom eq '') {
+                     $uhom=&homeserver($uname,$udom);
+                 }
+                 if ($uhom ne 'no_host') {
+                     $byid{$uhom}{$id} .= $uname.',';
+                 }
+             }
+         }
+     }
+     if ($namespace eq 'clickers') {
+         foreach my $server (keys(%byid)) {
+             if (ref($byid{$server}) eq 'HASH') {
+                 foreach my $id (keys(%{$byid{$server}})) {
+                     $byid{$server}{$id} =~ s/,$//;
+                     $servers{$server}.=&escape($id).'='.&escape($byid{$server}{$id}).'&';
+                 }
              }
          }
      }
      foreach my $server (keys(%servers)) {
-         $result{$server} = &critical('iddel:'.$udom.':'.$servers{$server},$uhome);
+         $servers{$server} =~ s/\&$//;
+         if ($namespace eq 'ids') {
+             $result{$server} = &critical('iddel:'.$udom.':'.$servers{$server},$uhome);
+         } elsif ($namespace eq 'clickers') {
+             $result{$server} = &critical('updateclickers:'.$udom.':del:'.$servers{$server},$server);
+         }
      }
      return %result;
  }
+ # ----- Update clicker ID-to-username look-ups in clickers.db on library server
+ sub updateclickers {
+     my ($udom,$action,$idshashref,$uhome,$critical) = @_;
+     my %clickers;
+     if (ref($idshashref) eq 'HASH') {
+         %clickers=%{$idshashref};
+     } else {
+         return;
+     }
+     my $items='';
+     foreach my $item (keys(%clickers)) {
+         $items.=&escape($item).'='.&escape($clickers{$item}).'&';
+     }
+     $items=~s/\&$//;
+     my $request = "updateclickers:$udom:$action:$items";
+     if ($critical) {
+         return &critical($request,$uhome);
+     } else {
+         return &reply($request,$uhome);
+     }
+ }
  # ------------------------------dump from db file owned by domainconfig user
  sub dump_dom {
      my ($namespace, $udom, $regexp) = @_;
- Line 1677  sub dump_dom {
+ Line 2170  sub dump_dom {
  # ------------------------------------------ get items from domain db files
  sub get_dom {
-     my ($namespace,$storearr,$udom,$uhome)=@_;
+     my ($namespace,$storearr,$udom,$uhome,$encrypt)=@_;
      return if ($udom eq 'public');
      my $items='';
      foreach my $item (@$storearr) {
- Line 1700  sub get_dom {
+ Line 2193  sub get_dom {
          }
      }
      if ($udom && $uhome && ($uhome ne 'no_host')) {
-         my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
+         my $rep;
+         if (grep { $_ eq $uhome } &current_machine_ids()) {
+             # domain information is hosted on this machine
+             $rep = &LONCAPA::Lond::get_dom("getdom:$udom:$namespace:$items");
+         } else {
+             if ($encrypt) {
+                 $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;
- Line 1723  sub get_dom {
+ Line 2226  sub get_dom {
  # -------------------------------------------- put items in domain db files
  sub put_dom {
-     my ($namespace,$storehash,$udom,$uhome)=@_;
+     my ($namespace,$storehash,$udom,$uhome,$encrypt)=@_;
      if (!$udom) {
          $udom=$env{'user.domain'};
          if (defined(&domain($udom,'primary'))) {
- Line 1744  sub put_dom {
+ Line 2247  sub put_dom {
              $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
          }
          $items=~s/\&$//;
-         return &reply("putdom:$udom:$namespace:$items",$uhome);
+         if ($encrypt) {
+             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");
      }
- Line 1778  sub del_dom {
+ Line 2285  sub del_dom {
      }
  }
+ sub store_dom {
+     my ($storehash,$id,$namespace,$dom,$home,$encrypt) = @_;
+     $$storehash{'ip'}=&get_requestor_ip();
+     $$storehash{'host'}=$perlvar{'lonHostID'};
+     my $namevalue='';
+     foreach my $key (keys(%{$storehash})) {
+         $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
+     }
+     $namevalue=~s/\&$//;
+     if (grep { $_ eq $home } current_machine_ids()) {
+         return LONCAPA::Lond::store_dom("storedom:$dom:$namespace:$id:$namevalue");
+     } else {
+         if ($namespace eq 'private') {
+             return 'refused';
+         } elsif ($encrypt) {
+             return reply("encrypt:storedom:$dom:$namespace:$id:$namevalue",$home);
+         } else {
+             return reply("storedom:$dom:$namespace:$id:$namevalue",$home);
+         }
+     }
+ }
+ sub restore_dom {
+     my ($id,$namespace,$dom,$home,$encrypt) = @_;
+     my $answer;
+     if (grep { $_ eq $home } current_machine_ids()) {
+         $answer = LONCAPA::Lond::restore_dom("restoredom:$dom:$namespace:$id");
+     } elsif ($namespace ne 'private') {
+         if ($encrypt) {
+             $answer=&reply("encrypt:restoredom:$dom:$namespace:$id",$home);
+         } else {
+             $answer=&reply("restoredom:$dom:$namespace:$id",$home);
+         }
+     }
+     my %returnhash=();
+     unless (($answer eq '') || ($answer eq 'con_lost') || ($answer eq 'refused') ||
+             ($answer eq 'unknown_cmd') || ($answer eq 'rejected')) {
+         foreach my $line (split(/\&/,$answer)) {
+             my ($name,$value)=split(/\=/,$line);
+             $returnhash{&unescape($name)}=&thaw_unescape($value);
+         }
+         my $version;
+         for ($version=1;$version<=$returnhash{'version'};$version++) {
+             foreach my $item (split(/\:/,$returnhash{$version.':keys'})) {
+                 $returnhash{$item}=$returnhash{$version.':'.$item};
+             }
+         }
+     }
+     return %returnhash;
+ }
  # ----------------------------------construct domainconfig user for a domain
  sub get_domainconfiguser {
      my ($udom) = @_;
- Line 1787  sub get_domainconfiguser {
+ Line 2345  sub get_domainconfiguser {
  sub retrieve_inst_usertypes {
      my ($udom) = @_;
      my (%returnhash,@order);
-     my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
+     my %domdefs = &get_domain_defaults($udom);
      if ((ref($domdefs{'inststatustypes'}) eq 'HASH') &&
          (ref($domdefs{'inststatusorder'}) eq 'ARRAY')) {
          return ($domdefs{'inststatustypes'},$domdefs{'inststatusorder'});
- Line 1820  sub retrieve_inst_usertypes {
+ Line 2378  sub retrieve_inst_usertypes {
  sub is_domainimage {
      my ($url) = @_;
-     if ($url=~m-^/+res/+($match_domain)/+\1\-domainconfig/+(img|logo|domlogo)/+[^/]-) {
+     if ($url=~m-^/+res/+($match_domain)/+\1\-domainconfig/+(img|logo|domlogo|login)/+[^/]-) {
          if (&domain($1) ne '') {
              return '1';
          }
- Line 1835  sub inst_directory_query {
+ Line 2393  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($udom,$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'}).':'.
- Line 1876  sub usersearch {
+ Line 2444  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($dom,$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).':'.
- Line 1965  sub get_multiple_instusers {
+ Line 2541  sub get_multiple_instusers {
      my ($udom,$users,$caller) = @_;
      my ($outcome,$results);
      if (ref($users) eq 'HASH') {
          my $count = keys(%{$users});
          my $requested = &freeze_escape($users);
          my $homeserver = &domain($udom,'primary');
          if ($homeserver ne '') {
- Line 2009  sub get_multiple_instusers {
+ Line 2585  sub get_multiple_instusers {
                  } else {
                      ($outcome,my $userdata) = split(/=/,$response,2);
                      if ($outcome eq 'ok') {
                          $results = &thaw_unescape($userdata);
                      }
                  }
              }
- Line 2040  sub inst_rulecheck {
+ Line 2616  sub inst_rulecheck {
                      $response=&unescape(&reply('instselfcreatecheck:'.
                                                 &escape($udom).':'.&escape($uname).
                                                ':'.$rulestr,$homeserver));
+                 } elsif ($item eq 'unamemap') {
+                     $response=&unescape(&reply('instunamemapcheck:'.
+                                                &escape($udom).':'.&escape($uname).
+                                               ':'.$rulestr,$homeserver));
                  }
                  if ($response ne 'refused') {
                      my @pairs=split(/\&/,$response);
- Line 2069  sub inst_userrules {
+ Line 2649  sub inst_userrules {
              } elsif ($check eq 'email') {
                  $response=&reply('instemailrules:'.&escape($udom),
                                   $homeserver);
+             } elsif ($check eq 'unamemap') {
+                 $response=&reply('unamemaprules:'.&escape($udom),
+                                  $homeserver);
              } else {
                  $response=&reply('instuserrules:'.&escape($udom),
                                   $homeserver);
- Line 2110  sub get_domain_defaults {
+ Line 2693  sub get_domain_defaults {
      }
      my %domdefaults;
      my %domconfig =
-          &Apache::lonnet::get_dom('configuration',['defaults','quotas',
+          &get_dom('configuration',['defaults','quotas',
                                    'requestcourses','inststatus',
                                    'coursedefaults','usersessions',
                                    'requestauthor','selfenrollment',
-                                   'coursecategories','autoenroll',
+                                   'coursecategories','ssl','autoenroll',
-                                   'helpsettings'],$domain);
+                                   'trust','helpsettings','wafproxy','ltisec'],$domain);
-     my @coursetypes = ('official','unofficial','community','textbook');
+     my @coursetypes = ('official','unofficial','community','textbook','placement');
      if (ref($domconfig{'defaults'}) eq 'HASH') {
          $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};
          $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
- Line 2124  sub get_domain_defaults {
+ Line 2707  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{'portal_def_email'} = $domconfig{'defaults'}{'portal_def_email'};
+         $domdefaults{'portal_def_web'} = $domconfig{'defaults'}{'portal_def_web'};
          $domdefaults{'intauth_cost'} = $domconfig{'defaults'}{'intauth_cost'};
          $domdefaults{'intauth_switch'} = $domconfig{'defaults'}{'intauth_switch'};
          $domdefaults{'intauth_check'} = $domconfig{'defaults'}{'intauth_check'};
+         $domdefaults{'unamemap_rule'} = $domconfig{'defaults'}{'unamemap_rule'};
      } else {
          $domdefaults{'lang_def'} = &domain($domain,'lang_def');
          $domdefaults{'auth_def'} = &domain($domain,'auth_def');
- Line 2149  sub get_domain_defaults {
+ Line 2735  sub get_domain_defaults {
          }
      }
      if (ref($domconfig{'requestcourses'}) eq 'HASH') {
-         foreach my $item ('official','unofficial','community','textbook') {
+         foreach my $item ('official','unofficial','community','textbook','placement') {
              $domdefaults{$item} = $domconfig{'requestcourses'}{$item};
          }
      }
- Line 2162  sub get_domain_defaults {
+ Line 2748  sub get_domain_defaults {
          }
      }
      if (ref($domconfig{'coursedefaults'}) eq 'HASH') {
+         $domdefaults{'canuse_pdfforms'} = $domconfig{'coursedefaults'}{'canuse_pdfforms'};
          $domdefaults{'usejsme'} = $domconfig{'coursedefaults'}{'usejsme'};
+         $domdefaults{'inline_chem'} = $domconfig{'coursedefaults'}{'inline_chem'};
          $domdefaults{'uselcmath'} = $domconfig{'coursedefaults'}{'uselcmath'};
          if (ref($domconfig{'coursedefaults'}{'postsubmit'}) eq 'HASH') {
              $domdefaults{'postsubmit'} = $domconfig{'coursedefaults'}{'postsubmit'}{'client'};
- Line 2178  sub get_domain_defaults {
+ Line 2766  sub get_domain_defaults {
              }
              if ($domdefaults{'postsubmit'} eq 'on') {
                  if (ref($domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') {
                      $domdefaults{$type.'postsubtimeout'} =
                          $domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}{$type};
                  }
              }
          }
- Line 2193  sub get_domain_defaults {
+ Line 2781  sub get_domain_defaults {
          } elsif ($domconfig{'coursedefaults'}{'canclone'}) {
              $domdefaults{'canclone'}=$domconfig{'coursedefaults'}{'canclone'};
          }
+         if ($domconfig{'coursedefaults'}{'texengine'}) {
+             $domdefaults{'texengine'} = $domconfig{'coursedefaults'}{'texengine'};
+         }
+         if (exists($domconfig{'coursedefaults'}{'ltiauth'})) {
+             $domdefaults{'crsltiauth'} = $domconfig{'coursedefaults'}{'ltiauth'};
+         }
      }
      if (ref($domconfig{'usersessions'}) eq 'HASH') {
          if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') {
- Line 2204  sub get_domain_defaults {
+ Line 2798  sub get_domain_defaults {
          if (ref($domconfig{'usersessions'}{'offloadnow'}) eq 'HASH') {
              $domdefaults{'offloadnow'} = $domconfig{'usersessions'}{'offloadnow'};
          }
+         if (ref($domconfig{'usersessions'}{'offloadoth'}) eq 'HASH') {
+             $domdefaults{'offloadoth'} = $domconfig{'usersessions'}{'offloadoth'};
+         }
      }
      if (ref($domconfig{'selfenrollment'}) eq 'HASH') {
          if (ref($domconfig{'selfenrollment'}{'admin'}) eq 'HASH') {
- Line 2243  sub get_domain_defaults {
+ Line 2840  sub get_domain_defaults {
              $domdefaults{'catunauth'} = $domconfig{'coursecategories'}{'unauth'};
          }
      }
+     if (ref($domconfig{'ssl'}) eq 'HASH') {
+         if (ref($domconfig{'ssl'}{'replication'}) eq 'HASH') {
+             $domdefaults{'replication'} = $domconfig{'ssl'}{'replication'};
+         }
+         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') {
+         my @prefixes = qw(content shared enroll othcoau coaurem domroles catalog reqcrs msg);
+         foreach my $prefix (@prefixes) {
+             if (ref($domconfig{'trust'}{$prefix}) eq 'HASH') {
+                 $domdefaults{'trust'.$prefix} = $domconfig{'trust'}{$prefix};
+             }
+         }
+     }
      if (ref($domconfig{'autoenroll'}) eq 'HASH') {
          $domdefaults{'autofailsafe'} = $domconfig{'autoenroll'}{'autofailsafe'};
+         $domdefaults{'failsafe'} = $domconfig{'autoenroll'}{'failsafe'};
      }
      if (ref($domconfig{'helpsettings'}) eq 'HASH') {
          $domdefaults{'submitbugs'} = $domconfig{'helpsettings'}{'submitbugs'};
- Line 2252  sub get_domain_defaults {
+ Line 2869  sub get_domain_defaults {
              $domdefaults{'adhocroles'} = $domconfig{'helpsettings'}{'adhoc'};
          }
      }
+     if (ref($domconfig{'wafproxy'}) eq 'HASH') {
+         foreach my $item ('ipheader','trusted','vpnint','vpnext','sslopt') {
+             if ($domconfig{'wafproxy'}{$item}) {
+                 $domdefaults{'waf_'.$item} = $domconfig{'wafproxy'}{$item};
+             }
+         }
+     }
+     if (ref($domconfig{'ltisec'}) eq 'HASH') {
+         if (ref($domconfig{'ltisec'}{'encrypt'}) eq 'HASH') {
+             $domdefaults{'linkprotenc_crs'} = $domconfig{'ltisec'}{'encrypt'}{'crs'};
+             $domdefaults{'linkprotenc_dom'} = $domconfig{'ltisec'}{'encrypt'}{'dom'};
+             $domdefaults{'ltienc_consumers'} = $domconfig{'ltisec'}{'encrypt'}{'consumers'};
+         }
+         if (ref($domconfig{'ltisec'}{'private'}) eq 'HASH') {
+             if (ref($domconfig{'ltisec'}{'private'}{'keys'}) eq 'ARRAY') {
+                 $domdefaults{'privhosts'} = $domconfig{'ltisec'}{'private'}{'keys'};
+             }
+         }
+     }
      &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);
      return %domdefaults;
  }
+ sub get_dom_cats {
+     my ($dom) = @_;
+     return unless (&domain($dom));
+     my ($cats,$cached)=&is_cached_new('cats',$dom);
+     unless (defined($cached)) {
+         my %domconfig = &get_dom('configuration',['coursecategories'],$dom);
+         if (ref($domconfig{'coursecategories'}) eq 'HASH') {
+             if (ref($domconfig{'coursecategories'}{'cats'}) eq 'HASH') {
+                 %{$cats} = %{$domconfig{'coursecategories'}{'cats'}};
+             } else {
+                 $cats = {};
+             }
+         } else {
+             $cats = {};
+         }
+         &do_cache_new('cats',$dom,$cats,3600);
+     }
+     return $cats;
+ }
+ sub get_dom_instcats {
+     my ($dom) = @_;
+     return unless (&domain($dom));
+     my ($instcats,$cached)=&is_cached_new('instcats',$dom);
+     unless (defined($cached)) {
+         my (%coursecodes,%codes,@codetitles,%cat_titles,%cat_order);
+         my $totcodes = &retrieve_instcodes(\%coursecodes,$dom);
+         if ($totcodes > 0) {
+             my $caller = 'global';
+             if (&auto_instcode_format($caller,$dom,\%coursecodes,\%codes,
+                                       \@codetitles,\%cat_titles,\%cat_order) eq 'ok') {
+                 $instcats = {
+                                 totcodes => $totcodes,
+                                 codes => \%codes,
+                                 codetitles => \@codetitles,
+                                 cat_titles => \%cat_titles,
+                                 cat_order => \%cat_order,
+                             };
+                 &do_cache_new('instcats',$dom,$instcats,3600);
+             }
+         }
+     }
+     return $instcats;
+ }
+ sub retrieve_instcodes {
+     my ($coursecodes,$dom) = @_;
+     my $totcodes;
+     my %courses = &courseiddump($dom,'.',1,'.','.','.',undef,undef,'Course');
+     foreach my $course (keys(%courses)) {
+         if (ref($courses{$course}) eq 'HASH') {
+             if ($courses{$course}{'inst_code'} ne '') {
+                 $$coursecodes{$course} = $courses{$course}{'inst_code'};
+                 $totcodes ++;
+             }
+         }
+     }
+     return $totcodes;
+ }
+ sub course_portal_url {
+     my ($cnum,$cdom,$r) = @_;
+     my $chome = &homeserver($cnum,$cdom);
+     my $hostname = &hostname($chome);
+     my $protocol = $protocol{$chome};
+     $protocol = 'http' if ($protocol ne 'https');
+     my %domdefaults = &get_domain_defaults($cdom);
+     my $firsturl;
+     if ($domdefaults{'portal_def'}) {
+         $firsturl = $domdefaults{'portal_def'};
+     } else {
+         my $alias = &use_proxy_alias($r,$chome);
+         $hostname = $alias if ($alias ne '');
+         $firsturl = $protocol.'://'.$hostname;
+     }
+     return $firsturl;
+ }
+ sub url_prefix {
+     my ($r,$dom,$home,$context) = @_;
+     my $prefix;
+     my %domdefs = &get_domain_defaults($dom);
+     if ($domdefs{'portal_def'} && $domdefs{'portal_def_'.$context}) {
+         if ($domdefs{'portal_def'} =~ m{^(https?://[^/]+)}) {
+             $prefix = $1;
+         }
+     }
+     if ($prefix eq '') {
+         my $hostname = &hostname($home);
+         my $protocol = $protocol{$home};
+         $protocol = 'http' if ($protocol{$home} ne 'https');
+         my $alias = &use_proxy_alias($r,$home);
+         $hostname = $alias if ($alias ne '');
+         $prefix = $protocol.'://'.$hostname;
+     }
+     return $prefix;
+ }
+ # --------------------------------------------- Get domain config for passwords
+ sub get_passwdconf {
+     my ($dom) = @_;
+     my (%passwdconf,$gotconf,$lookup);
+     my ($result,$cached)=&is_cached_new('passwdconf',$dom);
+     if (defined($cached)) {
+         if (ref($result) eq 'HASH') {
+             %passwdconf = %{$result};
+             $gotconf = 1;
+         }
+     }
+     unless ($gotconf) {
+         my %domconfig = &get_dom('configuration',['passwords'],$dom);
+         if (ref($domconfig{'passwords'}) eq 'HASH') {
+             %passwdconf = %{$domconfig{'passwords'}};
+         }
+         my $cachetime = 24*60*60;
+         &do_cache_new('passwdconf',$dom,\%passwdconf,$cachetime);
+     }
+     return %passwdconf;
+ }
  # --------------------------------------------------- Assign a key to a student
  sub assign_access_key {
- Line 2404  sub courseid_to_courseurl {
+ Line 3161  sub courseid_to_courseurl {
  	return "/$cdom/$cnum";
      }
-     my %courseinfo=&Apache::lonnet::coursedescription($courseid);
+     my %courseinfo=&coursedescription($courseid);
      if (exists($courseinfo{'num'})) {
  	return "/$courseinfo{'domain'}/$courseinfo{'num'}";
      }
- Line 2501  sub devalidate_cache_new {
+ Line 3258  sub devalidate_cache_new {
  sub is_cached_new {
      my ($name,$id,$debug) = @_;
-     my $remembered_id=$name.':'.$id; # this is to avoid make_key (which is slow) for
+     my $remembered_id=$name.':'.$id; # this is to avoid make_key (which is slow) whenever possible
-                                      # keys in %remembered hash, which persists for
-                                      # duration of request (no restriction on key length).
      if (exists($remembered{$remembered_id})) {
  	if ($debug) { &Apache::lonnet::logthis("Early return $remembered_id of $remembered{$remembered_id} "); }
  	$accessed{$remembered_id}=[&gettimeofday()];
- Line 2604  sub userenvironment {
+ Line 3359  sub userenvironment {
  # ---------------------------------------------------------- Get a studentphoto
  sub studentphoto {
      my ($udom,$unam,$ext) = @_;
-     my $home=&Apache::lonnet::homeserver($unam,$udom);
+     my $home=&homeserver($unam,$udom);
      if (defined($env{'request.course.id'})) {
          if ($env{'course.'.$env{'request.course.id'}.'.internal.showphoto'}) {
              if ($udom eq $env{'course.'.$env{'request.course.id'}.'.domain'}) {
                  return(&retrievestudentphoto($udom,$unam,$ext));
              } else {
                  my ($result,$perm_reqd)=
- 		    &Apache::lonnet::auto_photo_permission($unam,$udom);
+ 		    &auto_photo_permission($unam,$udom);
                  if ($result eq 'ok') {
                      if (!($perm_reqd eq 'yes')) {
                          return(&retrievestudentphoto($udom,$unam,$ext));
- Line 2621  sub studentphoto {
+ Line 3376  sub studentphoto {
          }
      } else {
          my ($result,$perm_reqd) =
- 	    &Apache::lonnet::auto_photo_permission($unam,$udom);
+ 	    &auto_photo_permission($unam,$udom);
          if ($result eq 'ok') {
              if (!($perm_reqd eq 'yes')) {
                  return(&retrievestudentphoto($udom,$unam,$ext));
- Line 2633  sub studentphoto {
+ Line 3388  sub studentphoto {
  sub retrievestudentphoto {
      my ($udom,$unam,$ext,$type) = @_;
-     my $home=&Apache::lonnet::homeserver($unam,$udom);
+     my $home=&homeserver($unam,$udom);
-     my $ret=&Apache::lonnet::reply("studentphoto:$udom:$unam:$ext:$type",$home);
+     my $ret=&reply("studentphoto:$udom:$unam:$ext:$type",$home);
      if ($ret eq 'ok') {
          my $url="/uploaded/$udom/$unam/internal/studentphoto.$ext";
          if ($type eq 'thumbnail') {
              $url="/uploaded/$udom/$unam/internal/studentphoto_tn.$ext";
          }
-         my $tokenurl=&Apache::lonnet::tokenwrapper($url);
+         my $tokenurl=&tokenwrapper($url);
          return $tokenurl;
      } else {
          if ($type eq 'thumbnail') {
- Line 2765  sub repcopy {
+ Line 3520  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;
- Line 2777  sub repcopy {
+ Line 3536  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(
- Line 2791  sub repcopy {
+ Line 3555  sub repcopy {
      }
  }
+ # ------------------------------------------------- Unsubscribe from a resource
+ sub unsubscribe {
+     my ($fname) = @_;
+     my $answer;
+     if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return $answer; }
+     $fname=~s/[\n\r]//g;
+     my $author=$fname;
+     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
+     my ($udom,$uname)=split(/\//,$author);
+     my $home=homeserver($uname,$udom);
+     if ($home eq 'no_host') {
+         $answer = 'no_host';
+     } elsif (grep { $_ eq $home } &current_machine_ids()) {
+         $answer = 'home';
+     } else {
+         my $defdom = $perlvar{'lonDefDomain'};
+         if (&will_trust('content',$defdom,$udom)) {
+             $answer = reply("unsub:$fname",$home);
+         } else {
+             $answer = 'untrusted';
+         }
+     }
+     return $answer;
+ }
  # ------------------------------------------------ Get server side include body
  sub ssi_body {
      my ($filelink,%form)=@_;
- Line 2819  sub ssi_body {
+ Line 3609  sub ssi_body {
  # --------------------------------------------------------- Server Side Include
  sub absolute_url {
-     my ($host_name) = @_;
+     my ($host_name,$unalias,$keep_proto) = @_;
      my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://');
      if ($host_name eq '') {
  	$host_name = $ENV{'SERVER_NAME'};
      }
+     if ($unalias) {
+         my $alias = &get_proxy_alias();
+         if ($alias eq $host_name) {
+             my $lonhost = $perlvar{'lonHostID'};
+             my $hostname = &hostname($lonhost);
+             my $lcproto;
+             if (($keep_proto) || ($hostname eq '')) {
+                 $lcproto = $protocol;
+             } else {
+                 $lcproto = $protocol{$lonhost};
+                 $lcproto = 'http' if ($lcproto ne 'https');
+                 $lcproto .= '://';
+             }
+             unless ($hostname eq '') {
+                 return $lcproto.$hostname;
+             }
+         }
+     }
      return $protocol.$host_name;
  }
- Line 2840  sub absolute_url {
+ Line 3648  sub absolute_url {
  sub ssi {
      my ($fn,%form)=@_;
-     my $ua=new LWP::UserAgent;
+     my ($host,$request,$response);
-     my $request;
+     $host = &absolute_url('',1);
      $form{'no_update_last_known'}=1;
      &Apache::lonenc::check_encrypt(\$fn);
      if (%form) {
-       $request=new HTTP::Request('POST',&absolute_url().$fn);
+       $request=new HTTP::Request('POST',$host.$fn);
        $request->content(join('&',map {
              my $name = escape($_);
              "$name=" . ( ref($form{$_}) eq 'ARRAY'
              ? join("&$name=", map {escape($_) } @{$form{$_}})
              : &escape($form{$_}) );
          } keys(%form)));
      } else {
-       $request=new HTTP::Request('GET',&absolute_url().$fn);
+       $request=new HTTP::Request('GET',$host.$fn);
      }
      $request->header(Cookie => $ENV{'HTTP_COOKIE'});
-     my $response= $ua->request($request);
+     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 '') &&
+         (&allowed('mgr',$env{'request.course.id'}.
+                         ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) {
+         $islocal = 1;
+     }
+     $response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,
+                                              '','','',$islocal);
      if (wantarray) {
  	return ($response->content, $response);
      } else {
- Line 2868  sub ssi {
+ Line 3688  sub ssi {
  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 {
- Line 2878  sub externalssi {
+ Line 3697  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) {
+                                     if (unlink($fname)) {
+                                         if ($uri!~/\.meta$/) {
+                                             if (-e $fname.'.meta') {
+                                                 unlink($fname.'.meta');
+                                             }
+                                         }
+                                         my $unsubresult = &unsubscribe($fname);
+                                         unless ($unsubresult eq 'ok') {
+                                             &logthis("no unsub of $fname from $homeserver, reason: $unsubresult");
+                                         }
+                                         $removed = 1;
+                                     }
+                                 }
+                             }
+                         }
+                     }
+                 }
+             }
+         }
+     }
+     return $removed;
+ }
  # -------------------------------- Allow a /uploaded/ URI to be vouched for
  sub allowuploaded {
- Line 2894  sub allowuploaded {
+ Line 3784  sub allowuploaded {
  #
  # Determine if the current user should be able to edit a particular resource,
  # when viewing in course context.
  # (a) When viewing resource used to determine if "Edit" item is included in
  #     Functions.
  # (b) When displaying folder contents in course editor, used to determine if
  #     "Edit" link will be displayed alongside resource.
- Line 2902  sub allowuploaded {
+ Line 3792  sub allowuploaded {
  #  input: six args -- filename (decluttered), course number, course domain,
  #                   url, symb (if registered) and group (if this is a group
  #                   item -- e.g., bulletin board, group page etc.).
  #  output: array of five scalars --
  #          $cfile -- url for file editing if editable on current server
  #          $home -- homeserver of resource (i.e., for author if published,
  #                                           or course if uploaded.).
  #          $switchserver --  1 if server switch will be needed.
  #          $forceedit -- 1 if icon/link should be to go to edit mode
  #          $forceview -- 1 if icon/link should be to go to view mode
  #
- Line 2934  sub can_edit_resource {
+ Line 3824  sub can_edit_resource {
      }
      if ($env{'request.course.id'}) {
-         my $crsedit = &Apache::lonnet::allowed('mdc',$env{'request.course.id'});
+         my $crsedit = &allowed('mdc',$env{'request.course.id'});
          if ($group ne '') {
  # if this is a group homepage or group bulletin board, check group privs
              my $allowed = 0;
- Line 2963  sub can_edit_resource {
+ Line 3853  sub can_edit_resource {
              }
          } else {
              if ($resurl =~ m{^/?adm/viewclasslist$}) {
-                 unless (&Apache::lonnet::allowed('opa',$env{'request.course.id'})) {
+                 unless (&allowed('opa',$env{'request.course.id'})) {
                      return;
                  }
              } elsif (!$crsedit) {
- Line 2996  sub can_edit_resource {
+ Line 3886  sub can_edit_resource {
                      $forceedit = 1;
                  }
                  $cfile = $resurl;
              } elsif (($resurl ne '') && (&is_on_map($resurl))) {
                  if ($resurl =~ m{^/adm/$match_domain/$match_username/\d+/smppg|bulletinboard$}) {
                      $incourse = 1;
                      if ($env{'form.forceedit'}) {
- Line 3016  sub can_edit_resource {
+ Line 3906  sub can_edit_resource {
                          $forceedit = 1;
                      }
                      $cfile = $resurl;
+                 } elsif (($resurl =~ m{^/ext/}) && ($symb ne '')) {
+                     my ($map,$id,$res) = &decode_symb($symb);
+                     if ($map =~ /\.page$/) {
+                         $incourse = 1;
+                         if ($env{'form.forceedit'}) {
+                             $forceview = 1;
+                             $cfile = $map;
+                         } else {
+                             $forceedit = 1;
+                             $cfile =  '/adm/wrapper'.$resurl;
+                         }
+                     }
+                 } elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) {
+                     $incourse = 1;
+                     if ($env{'form.forceedit'}) {
+                         $forceview = 1;
+                     } else {
+                         $forceedit = 1;
+                     }
+                     $cfile = $resurl;
                  } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
                      $incourse = 1;
                      if ($env{'form.forceedit'}) {
- Line 3027  sub can_edit_resource {
+ Line 3937  sub can_edit_resource {
                  }
              } elsif ($resurl eq '/res/lib/templates/simpleproblem.problem/smpedit') {
                  my $template = '/res/lib/templates/simpleproblem.problem';
                  if (&is_on_map($template)) {
                      $incourse = 1;
                      $forceview = 1;
                      $cfile = $template;
                  }
              } elsif (($resurl =~ m{^/adm/wrapper/ext/}) && ($env{'form.folderpath'} =~ /^supplemental/)) {
-                     $incourse = 1;
+                 $incourse = 1;
-                     if ($env{'form.forceedit'}) {
+                 if ($env{'form.forceedit'}) {
-                         $forceview = 1;
+                     $forceview = 1;
-                     } else {
+                 } else {
-                         $forceedit = 1;
+                     $forceedit = 1;
-                     }
+                 }
-                     $cfile = $resurl;
+                 $cfile = $resurl;
+             } elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) && ($env{'form.folderpath'} =~ /^supplemental/)) {
+                 $incourse = 1;
+                 if ($env{'form.forceedit'}) {
+                     $forceview = 1;
+                 } else {
+                     $forceedit = 1;
+                 }
+                 $cfile = $resurl;
              } elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) {
                  $incourse = 1;
                  $forceview = 1;
- Line 3049  sub can_edit_resource {
+ Line 3967  sub can_edit_resource {
                      $cfile = &clutter($res);
                  } else {
                      $cfile = $env{'form.suppurl'};
-                     $cfile =~ s{^http://}{};
+                     my $escfile = &unescape($cfile);
-                     $cfile = '/adm/wrapper/ext/'.$cfile;
+                     if ($escfile =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
+                         $cfile = '/adm/wrapper'.$escfile;
+                     } else {
+                         $escfile =~ s{^http://}{};
+                         $cfile = &escape("/adm/wrapper/ext/$escfile");
+                     }
                  }
              } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
                  if ($env{'form.forceedit'}) {
- Line 3074  sub can_edit_resource {
+ Line 3997  sub can_edit_resource {
                  $cfile=$file;
              }
          }
          if (($cfile ne '') && (!$incourse || $uploaded) &&
              (($home ne '') && ($home ne 'no_host'))) {
              my @ids=&current_machine_ids();
              unless (grep(/^\Q$home\E$/,@ids)) {
- Line 3101  sub in_course {
+ Line 4024  sub in_course {
      if ($hideprivileged) {
          my $skipuser;
          my %coursehash = &coursedescription($cdom.'_'.$cnum);
          my @possdoms = ($cdom);
          if ($coursehash{'checkforpriv'}) {
              push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
          }
          if (&privileged($uname,$udom,\@possdoms)) {
              $skipuser = 1;
- Line 3289  sub clean_filename {
+ Line 4212  sub clean_filename {
      }
  # Replace spaces by underscores
      $fname=~s/\s+/\_/g;
+ # Transliterate non-ascii text to ascii
+     my $lang = &Apache::lonlocal::current_language();
+     $fname = &LONCAPA::transliterate::fname_to_ascii($fname,$lang);
  # Replace all other weird characters by nothing
      $fname=~s{[^/\w\.\-]}{}g;
  # Replace all .\d. sequences with _\d. so they no longer look like version
  # numbers
      $fname=~s/\.(\d+)(?=\.)/_$1/g;
+ # Replace three or more adjacent underscores with one for consistency
+ # with loncfile::filename_check() so complete url can be extracted by
+ # lonnet::decode_symb()
+     $fname=~s/_{3,}/_/g;
      return $fname;
  }
  # This Function checks if an Image's dimensions exceed either $resizewidth (width)
  # or $resizeheight (height) - both pixels. If so, the image is scaled to produce an
  # image with the same aspect ratio as the original, but with dimensions which do
- Line 3338  sub resizeImage {
+ Line 4269  sub resizeImage {
  # input: $formname - the contents of the file are in $env{"form.$formname"}
  #                    the desired filename is in $env{"form.$formname.filename"}
  #        $context - possible values: coursedoc, existingfile, overwrite,
- #                                    canceloverwrite, or ''.
+ #                                    canceloverwrite, scantron or ''.
  #                   if 'coursedoc': upload to the current course
  #                   if 'existingfile': write file to tmp/overwrites directory
  #                   if 'canceloverwrite': delete file written to tmp/overwrites directory
  #                   $context is passed as argument to &finishuserfileupload
  #        $subdir - directory in userfile to store the file into
- #        $parser - instruction to parse file for objects ($parser = parse)
+ #        $parser - instruction to parse file for objects ($parser = parse) or
+ #                  if context is 'scantron', $parser is hashref of csv column mapping
+ #                  (e.g.,{ PaperID => 0, LastName => 1, FirstName => 2, ID => 3,
+ #                          Section => 4, CODE => 5, FirstQuestion => 9 }).
  #        $allfiles - reference to hash for embedded objects
  #        $codebase - reference to hash for codebase of java objects
  #        $desuname - username for permanent storage of uploaded file
- Line 3367  sub userfileupload {
+ Line 4301  sub userfileupload {
      $fname=&clean_filename($fname);
      # See if there is anything left
      unless ($fname) { return 'error: no uploaded file'; }
+     # If filename now begins with a . prepend unix timestamp _ milliseconds
+     if ($fname =~ /^\./) {
+         my ($s,$usec) = &gettimeofday();
+         while (length($usec) < 6) {
+             $usec = '0'.$usec;
+         }
+         $fname = $s.'_'.substr($usec,0,3).$fname;
+     }
      # Files uploaded to help request form, or uploaded to "create course" page are handled differently
      if ((($formname eq 'screenshot') && ($subdir eq 'helprequests')) ||
          (($formname eq 'coursecreatorxml') && ($subdir eq 'batchupload')) ||
- Line 3385  sub userfileupload {
+ Line 4327  sub userfileupload {
              } else {
                  $docudom = $env{'user.domain'};
              }
              if ($destuname =~ /^$match_username$/) {
                  $docuname = $destuname;
              } else {
                  $docuname = $env{'user.name'};
- Line 3534  sub finishuserfileupload {
+ Line 4476  sub finishuserfileupload {
              }
          }
      }
-     if ($parser eq 'parse') {
+     if (($context ne 'scantron') && ($parser eq 'parse')) {
          if ((ref($mimetype)) && ($$mimetype eq 'text/html')) {
              my $parse_result = &extract_embedded_items($filepath.'/'.$file,
                                                         $allfiles,$codebase);
- Line 3543  sub finishuserfileupload {
+ Line 4485  sub finishuserfileupload {
  	   	         ' for embedded media: '.$parse_result);
              }
          }
+     } elsif (($context eq 'scantron') && (ref($parser) eq 'HASH')) {
+         my $format = $env{'form.scantron_format'};
+         &bubblesheet_converter($docudom,$filepath.'/'.$file,$parser,$format);
      }
      if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {
          my $input = $filepath.'/'.$file;
- Line 3608  sub extract_embedded_items {
+ Line 4553  sub extract_embedded_items {
  	    }
  	    if (lc($tagname) eq 'a') {
                  unless (($attr->{'href'} =~ /^#/) || ($attr->{'href'} eq '')) {
- 		    &add_filetype($allfiles,$attr->{'href'},'href');
+                     &add_filetype($allfiles,$attr->{'href'},'href');
                  }
  	    }
              if (lc($tagname) eq 'script') {
- Line 3783  sub embedded_dependency {
+ Line 4728  sub embedded_dependency {
      return;
  }
+ sub bubblesheet_converter {
+     my ($cdom,$fullpath,$config,$format) = @_;
+     if ((&domain($cdom) ne '') &&
+         ($fullpath =~ m{^\Q$perlvar{'lonDocRoot'}/userfiles/$cdom/\E$match_courseid/scantron_orig}) &&
+         (-e $fullpath) && (ref($config) eq 'HASH') && ($format ne '')) {
+         my (%csvcols,%csvoptions);
+         if (ref($config->{'fields'}) eq 'HASH') {
+             %csvcols = %{$config->{'fields'}};
+         }
+         if (ref($config->{'options'}) eq 'HASH') {
+             %csvoptions = %{$config->{'options'}};
+         }
+         my %csvbynum = reverse(%csvcols);
+         my %scantronconf = &get_scantron_config($format,$cdom);
+         if (keys(%scantronconf)) {
+             my %bynum = (
+                           $scantronconf{CODEstart} => 'CODEstart',
+                           $scantronconf{IDstart}   => 'IDstart',
+                           $scantronconf{PaperID}   => 'PaperID',
+                           $scantronconf{FirstName} => 'FirstName',
+                           $scantronconf{LastName}  => 'LastName',
+                           $scantronconf{Qstart}    => 'Qstart',
+                         );
+             my @ordered;
+             foreach my $item (sort { $a <=> $b } keys(%bynum)) {
+                 push(@ordered,$bynum{$item});
+             }
+             my %mapstart = (
+                               CODEstart => 'CODE',
+                               IDstart   => 'ID',
+                               PaperID   => 'PaperID',
+                               FirstName => 'FirstName',
+                               LastName  => 'LastName',
+                               Qstart    => 'FirstQuestion',
+                            );
+             my %maplength = (
+                               CODEstart => 'CODElength',
+                               IDstart   => 'IDlength',
+                               PaperID   => 'PaperIDlength',
+                               FirstName => 'FirstNamelength',
+                               LastName  => 'LastNamelength',
+             );
+             if (open(my $fh,'<',$fullpath)) {
+                 my $output;
+                 my %lettdig = &letter_to_digits();
+                 my %diglett = reverse(%lettdig);
+                 my $numletts = scalar(keys(%lettdig));
+                 my $num = 0;
+                 while (my $line=<$fh>) {
+                     $num ++;
+                     next if (($num == 1) && ($csvoptions{'hdr'} == 1));
+                     $line =~ s{[\r\n]+$}{};
+                     my %found;
+                     my @values = split(/,/,$line,-1);
+                     my ($qstart,$record);
+                     for (my $i=0; $i<@values; $i++) {
+                         if ((($qstart ne '') && ($i > $qstart)) ||
+                             ($csvbynum{$i} eq 'FirstQuestion')) {
+                             if ($values[$i] eq '') {
+                                 $values[$i] = $scantronconf{'Qoff'};
+                             } elsif ($scantronconf{'Qon'} eq 'number') {
+                                 if ($values[$i] =~ /^[A-Ja-j]$/) {
+                                     $values[$i] = $lettdig{uc($values[$i])};
+                                 }
+                             } elsif ($scantronconf{'Qon'} eq 'letter') {
+                                 if ($values[$i] =~ /^[0-9]$/) {
+                                     $values[$i] = $diglett{$values[$i]};
+                                 }
+                             } else {
+                                 if ($values[$i] =~ /^[0-9A-Ja-j]$/) {
+                                     my $digit;
+                                     if ($values[$i] =~ /^[A-Ja-j]$/) {
+                                         $digit = $lettdig{uc($values[$i])}-1;
+                                         if ($values[$i] eq 'J') {
+                                             $digit += $numletts;
+                                         }
+                                     } elsif ($values[$i] =~ /^[0-9]$/) {
+                                         $digit = $values[$i]-1;
+                                         if ($values[$i] eq '0') {
+                                             $digit += $numletts;
+                                         }
+                                     }
+                                     my $qval='';
+                                     for (my $j=0; $j<$scantronconf{'Qlength'}; $j++) {
+                                         if ($j == $digit) {
+                                             $qval .= $scantronconf{'Qon'};
+                                         } else {
+                                             $qval .= $scantronconf{'Qoff'};
+                                         }
+                                     }
+                                     $values[$i] = $qval;
+                                 }
+                             }
+                             if (length($values[$i]) > $scantronconf{'Qlength'}) {
+                                 $values[$i] = substr($values[$i],0,$scantronconf{'Qlength'});
+                             }
+                             my $numblank = $scantronconf{'Qlength'} - length($values[$i]);
+                             if ($numblank > 0) {
+                                  $values[$i] .= ($scantronconf{'Qoff'} x $numblank);
+                             }
+                             if ($csvbynum{$i} eq 'FirstQuestion') {
+                                 $qstart = $i;
+                                 $found{$csvbynum{$i}} = $values[$i];
+                             } else {
+                                 $found{'FirstQuestion'} .= $values[$i];
+                             }
+                         } elsif (exists($csvbynum{$i})) {
+                             if ($csvoptions{'rem'}) {
+                                 $values[$i] =~ s/^\s+//;
+                             }
+                             if (($csvbynum{$i} eq 'PaperID') && ($csvoptions{'pad'})) {
+                                 while (length($values[$i]) < $scantronconf{$maplength{$csvbynum{$i}}}) {
+                                     $values[$i] = '0'.$values[$i];
+                                 }
+                             }
+                             $found{$csvbynum{$i}} = $values[$i];
+                         }
+                     }
+                     foreach my $item (@ordered) {
+                         my $currlength = 1+length($record);
+                         my $numspaces = $scantronconf{$item} - $currlength;
+                         if ($numspaces > 0) {
+                             $record .= (' ' x $numspaces);
+                         }
+                         if (($mapstart{$item} ne '') && (exists($found{$mapstart{$item}}))) {
+                             unless ($item eq 'Qstart') {
+                                 if (length($found{$mapstart{$item}}) > $scantronconf{$maplength{$item}}) {
+                                     $found{$mapstart{$item}} = substr($found{$mapstart{$item}},0,$scantronconf{$maplength{$item}});
+                                 }
+                             }
+                             $record .= $found{$mapstart{$item}};
+                         }
+                     }
+                     $output .= "$record\n";
+                 }
+                 close($fh);
+                 if ($output) {
+                     if (open(my $fh,'>',$fullpath)) {
+                         print $fh $output;
+                         close($fh);
+                     }
+                 }
+             }
+         }
+         return;
+     }
+ }
+ sub letter_to_digits {
+     my %lettdig = (
+                     A => 1,
+                     B => 2,
+                     C => 3,
+                     D => 4,
+                     E => 5,
+                     F => 6,
+                     G => 7,
+                     H => 8,
+                     I => 9,
+                     J => 0,
+                   );
+     return %lettdig;
+ }
+ sub get_scantron_config {
+     my ($which,$cdom) = @_;
+     my @lines = &get_scantronformat_file($cdom);
+     my %config;
+     #FIXME probably should move to XML it has already gotten a bit much now
+     foreach my $line (@lines) {
+         my ($name,$descrip)=split(/:/,$line);
+         if ($name ne $which ) { next; }
+         chomp($line);
+         my @config=split(/:/,$line);
+         $config{'name'}=$config[0];
+         $config{'description'}=$config[1];
+         $config{'CODElocation'}=$config[2];
+         $config{'CODEstart'}=$config[3];
+         $config{'CODElength'}=$config[4];
+         $config{'IDstart'}=$config[5];
+         $config{'IDlength'}=$config[6];
+         $config{'Qstart'}=$config[7];
+         $config{'Qlength'}=$config[8];
+         $config{'Qoff'}=$config[9];
+         $config{'Qon'}=$config[10];
+         $config{'PaperID'}=$config[11];
+         $config{'PaperIDlength'}=$config[12];
+         $config{'FirstName'}=$config[13];
+         $config{'FirstNamelength'}=$config[14];
+         $config{'LastName'}=$config[15];
+         $config{'LastNamelength'}=$config[16];
+         $config{'BubblesPerRow'}=$config[17];
+         last;
+     }
+     return %config;
+ }
+ sub get_scantronformat_file {
+     my ($cdom) = @_;
+     if ($cdom eq '') {
+         $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'};
+     }
+     my %domconfig = &get_dom('configuration',['scantron'],$cdom);
+     my $gottab = 0;
+     my @lines;
+     if (ref($domconfig{'scantron'}) eq 'HASH') {
+         if ($domconfig{'scantron'}{'scantronformat'} ne '') {
+             my $formatfile = &getfile($perlvar{'lonDocRoot'}.$domconfig{'scantron'}{'scantronformat'});
+             if ($formatfile ne '-1') {
+                 @lines = split("\n",$formatfile,-1);
+                 $gottab = 1;
+             }
+         }
+     }
+     if (!$gottab) {
+         my $confname = $cdom.'-domainconfig';
+         my $default = $perlvar{'lonDocRoot'}.'/res/'.$cdom.'/'.$confname.'/default.tab';
+         my $formatfile = &getfile($default);
+         if ($formatfile ne '-1') {
+             @lines = split("\n",$formatfile,-1);
+             $gottab = 1;
+         }
+     }
+     if (!$gottab) {
+         my @domains = &current_machine_domains();
+         if (grep(/^\Q$cdom\E$/,@domains)) {
+             if (open(my $fh,'<',$perlvar{'lonTabDir'}.'/scantronformat.tab')) {
+                 @lines = <$fh>;
+                 close($fh);
+             }
+         } else {
+             if (open(my $fh,'<',$perlvar{'lonTabDir'}.'/default_scantronformat.tab')) {
+                 @lines = <$fh>;
+                 close($fh);
+             }
+         }
+         chomp(@lines);
+     }
+     return @lines;
+ }
  sub removeuploadedurl {
      my ($url)=@_;
      my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);
- Line 3900  sub flushcourselogs {
+ Line 5086  sub flushcourselogs {
              if (! defined($dom) || $dom eq '' ||
                  ! defined($name) || $name eq '') {
                  my $cid = $env{'request.course.id'};
+ #
+ # FIXME 11/29/2021
+ # Typo in rev. 1.458 (2003/12/09)??
+ # These should likely by $env{'course.'.$cid.'.domain'} and $env{'course.'.$cid.'.num'}
+ #
+ # While these ramain as  $env{'request.'.$cid.'.domain'} and $env{'request.'.$cid.'.num'}
+ # $dom and $name will always be null, so the &inc() call will default to storing this data
+ # in a nohist_accesscount.db file for the user rather than the course.
+ #
+ # That said there is a lot of noise in the data being stored.
+ # So counts for prtspool/  and adm/ etc. are recorded.
+ #
+ # A review of which items ending '___count' are written to %accesshash should likely be
+ # made before deciding whether to set these to 'course.' instead of 'request.'
+ #
+ # Under the current scheme each user receives a nohist_accesscount.db file listing
+ # accesses for things which are not published resources, regardless of course, and
+ # there is not a nohist_accesscount.db file in a course, which might log accesses from
+ # anyone in the course for things which are not published resources.
+ #
+ # For an author, nohist_accesscount.db ends up having records for other items
+ # mixed up with the legitimate access counts for the author's published resources.
+ #
                  $dom  = $env{'request.'.$cid.'.domain'};
                  $name = $env{'request.'.$cid.'.num'};
              }
- Line 3926  sub flushcourselogs {
+ Line 5135  sub flushcourselogs {
      foreach my $entry (keys(%userrolehash)) {
          my ($role,$uname,$udom,$runame,$rudom,$rsec)=
  	    split(/\:/,$entry);
-         if (&Apache::lonnet::put('nohist_userroles',
+         if (&put('nohist_userroles',
               { $role.':'.$uname.':'.$udom.':'.$rsec => $userrolehash{$entry} },
                  $rudom,$runame) eq 'ok') {
  	    delete $userrolehash{$entry};
- Line 3948  sub flushcourselogs {
+ Line 5157  sub flushcourselogs {
          delete $domainrolehash{$entry};
      }
      foreach my $dom (keys(%domrolebuffer)) {
-         my %servers;
+ 	my %servers;
-         if (defined(&domain($dom,'primary'))) {
+ 	if (defined(&domain($dom,'primary'))) {
-             my $primary=&domain($dom,'primary');
+ 	    my $primary=&domain($dom,'primary');
-             my $hostname=&hostname($primary);
+ 	    my $hostname=&hostname($primary);
-             $servers{$primary} = $hostname;
+ 	    $servers{$primary} = $hostname;
-         } else {
+ 	} else {
-             %servers = &get_servers($dom,'library');
+ 	    %servers = &get_servers($dom,'library');
-         }
+ 	}
  	foreach my $tryserver (keys(%servers)) {
  	    if (&reply('domroleput:'.$dom.':'.
- 	               $domrolebuffer{$dom},$tryserver) eq 'ok') {
+ 		       $domrolebuffer{$dom},$tryserver) eq 'ok') {
- 	        last;
+ 		last;
  	    } else {
  		&logthis('Put of domain roles failed for '.$dom.' and  '.$tryserver);
  	    }
          }
- Line 4009  sub courseacclog {
+ Line 5218  sub courseacclog {
                  if ($formitem =~ /^HWFILE(?:SIZE|TOOBIG)/) {
                      $what.=':'.$formitem.'='.$env{$key};
                  } elsif ($formitem !~ /^HWFILE(?:[^.]+)$/) {
-                     $what.=':'.$formitem.'='.$env{$key};
+                     if ($formitem eq 'proctorpassword') {
+                         $what.=':'.$formitem.'=' . '*' x length($env{$key});
+                     } else {
+                         $what.=':'.$formitem.'='.$env{$key};
+                     }
                  }
              }
          }
- Line 4121  sub domainrolelog {
+ Line 5334  sub domainrolelog {
      my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$context)=@_;
      if ($area =~ m{^/($match_domain)/$}) {
          my $cdom = $1;
-         my $domconfiguser = &Apache::lonnet::get_domainconfiguser($cdom);
+         my $domconfiguser = &get_domainconfiguser($cdom);
          my $namespace = 'rolelog';
          my %storehash = (
                             role    => $trole,
- Line 4288  sub get_my_roles {
+ Line 5501  sub get_my_roles {
              } else {
                  my $possdoms = [$domain];
                  if (ref($roledoms) eq 'ARRAY') {
                     push(@{$possdoms},@{$roledoms});
                  }
                  if (&privileged($username,$domain,$possdoms,\@privroles)) {
                      if (!$nothide{$username.':'.$domain}) {
- Line 4352  sub get_my_adhocroles {
+ Line 5565  sub get_my_adhocroles {
      } elsif ($cid =~ /^($match_domain)_($match_courseid)$/) {
          $cdom = $1;
          $cnum = $2;
-         %info = &Apache::lonnet::get('environment',['internal.coursecode'],
+         %info = &get('environment',['internal.coursecode'],
-                                      $cdom,$cnum);
+                      $cdom,$cnum);
      }
      if (($info{'internal.coursecode'} ne '') && ($checkreg)) {
          my $user = $env{'user.name'}.':'.$env{'user.domain'};
- Line 4585  sub courseiddump {
+ Line 5798  sub courseiddump {
  	    if (($domfilter eq '') ||
  		(&host_domain($tryserver) eq $domfilter)) {
                  my $rep;
-                 if (grep { $_ eq $tryserver } &current_machine_ids()) {
+                 if (grep { $_ eq $tryserver } current_machine_ids()) {
-                     $rep = &LONCAPA::Lond::dump_course_id_handler(
+                     $rep = LONCAPA::Lond::dump_course_id_handler(
                          join(":", (&host_domain($tryserver), $sincefilter,
                                  &escape($descfilter), &escape($instcodefilter),
                                  &escape($ownerfilter), &escape($coursefilter),
                                  &escape($typefilter), &escape($regexp_ok),
                                  $as_hash, &escape($selfenrollonly),
                                  &escape($catfilter), $showhidden, $caller,
                                  &escape($cloner), &escape($cc_clone), $cloneonly,
                                  &escape($createdbefore), &escape($createdafter),
                                  &escape($creationcontext),$domcloner,$hasuniquecode,
                                  $reqcrsdom,&escape($reqinstcode))));
                  } else {
- Line 4610  sub courseiddump {
+ Line 5823  sub courseiddump {
                               &escape($creationcontext).':'.$domcloner.':'.$hasuniquecode.
                               ':'.$reqcrsdom.':'.&escape($reqinstcode),$tryserver);
                  }
                  my @pairs=split(/\&/,$rep);
                  foreach my $item (@pairs) {
                      my ($key,$value)=split(/\=/,$item,2);
- Line 4680  sub extract_lastaccess {
+ Line 5893  sub extract_lastaccess {
  sub dcmailput {
      my ($domain,$msgid,$message,$server)=@_;
-     my $status = &Apache::lonnet::critical(
+     my $status = &critical(
         'dcmailput:'.$domain.':'.&escape($msgid).'='.
         &escape($message),$server);
      return $status;
- Line 4765  my %cachedtimes=();
+ Line 5978  my %cachedtimes=();
  my $cachedtime='';
  sub load_all_first_access {
-     my ($uname,$udom)=@_;
+     my ($uname,$udom,$ignorecache)=@_;
      if (($cachedkey eq $uname.':'.$udom) &&
-         (abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) {
+         (abs($cachedtime-time)<5) && (!$env{'form.markaccess'}) &&
+         (!$ignorecache)) {
          return;
      }
      $cachedtime=time;
- Line 4776  sub load_all_first_access {
+ Line 5990  sub load_all_first_access {
  }
  sub get_first_access {
-     my ($type,$argsymb,$argmap)=@_;
+     my ($type,$argsymb,$argmap,$ignorecache)=@_;
      my ($symb,$courseid,$udom,$uname)=&whichuser();
      if ($argsymb) { $symb=$argsymb; }
      my ($map,$id,$res)=&decode_symb($symb);
- Line 4788  sub get_first_access {
+ Line 6002  sub get_first_access {
      } else {
  	$res=$symb;
      }
-     &load_all_first_access($uname,$udom);
+     &load_all_first_access($uname,$udom,$ignorecache);
      return $cachedtimes{"$courseid\0$res"};
  }
- Line 4805  sub set_first_access {
+ Line 6019  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);
- Line 4818  sub set_first_access {
+ Line 6037  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;
      }
- Line 4825  sub set_first_access {
+ Line 6050  sub set_first_access {
  }
  }
- sub checkout {
-     my ($symb,$tuname,$tudom,$tcrsid)=@_;
-     my $now=time;
-     my $lonhost=$perlvar{'lonHostID'};
-     my $infostr=&escape(
-                  'CHECKOUTTOKEN&'.
-                  $tuname.'&'.
-                  $tudom.'&'.
-                  $tcrsid.'&'.
-                  $symb.'&'.
-                  $now.'&'.$ENV{'REMOTE_ADDR'});
-     my $token=&reply('tmpput:'.$infostr,$lonhost);
-     if ($token=~/^error\:/) {
-         &logthis("<font color=\"blue\">WARNING: ".
-                 "Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb.
-                  "</font>");
-         return '';
-     }
-     $token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/;
-     $token=~tr/a-z/A-Z/;
-     my %infohash=('resource.0.outtoken' => $token,
-                   'resource.0.checkouttime' => $now,
-                   'resource.0.outremote' => $ENV{'REMOTE_ADDR'});
-     unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
-        return '';
-     } else {
-         &logthis("<font color=\"blue\">WARNING: ".
-                 "Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb.
-                  "</font>");
-     }
-     if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
-                          &escape('Checkout '.$infostr.' - '.
-                                                  $token)) ne 'ok') {
-         return '';
-     } else {
-         &logthis("<font color=\"blue\">WARNING: ".
-                 "Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb.
-                  "</font>");
-     }
-     return $token;
- }
- # ------------------------------------------------------------ Check in an item
- sub checkin {
-     my $token=shift;
-     my $now=time;
-     my ($ta,$tb,$lonhost)=split(/\*/,$token);
-     $lonhost=~tr/A-Z/a-z/;
-     my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb;
-     $dtoken=~s/\W/\_/g;
-     my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
-                  split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));
-     unless (($tuname) && ($tudom)) {
-         &logthis('Check in '.$token.' ('.$dtoken.') failed');
-         return '';
-     }
-     unless (&allowed('mgr',$tcrsid)) {
-         &logthis('Check in '.$token.' ('.$dtoken.') unauthorized: '.
-                  $env{'user.name'}.' - '.$env{'user.domain'});
-         return '';
-     }
-     my %infohash=('resource.0.intoken' => $token,
-                   'resource.0.checkintime' => $now,
-                   'resource.0.inremote' => $ENV{'REMOTE_ADDR'});
-     unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
-        return '';
-     }
-     if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
-                          &escape('Checkin - '.$token)) ne 'ok') {
-         return '';
-     }
-     return ($symb,$tuname,$tudom,$tcrsid);
- }
  # --------------------------------------------- Set Expire Date for Spreadsheet
  sub expirespread {
- Line 5164  sub tmpreset {
+ Line 6304  sub tmpreset {
    if (!$domain) { $domain=$env{'user.domain'}; }
    if (!$stuname) { $stuname=$env{'user.name'}; }
    if ($domain eq 'public' && $stuname eq 'public') {
-       $stuname=$ENV{'REMOTE_ADDR'};
+       $stuname=&get_requestor_ip();
    }
    my $path=LONCAPA::tempdir();
    my %hash;
- Line 5201  sub tmpstore {
+ Line 6341  sub tmpstore {
    if (!$domain) { $domain=$env{'user.domain'}; }
    if (!$stuname) { $stuname=$env{'user.name'}; }
    if ($domain eq 'public' && $stuname eq 'public') {
-       $stuname=$ENV{'REMOTE_ADDR'};
+       $stuname=&get_requestor_ip();
    }
    my $now=time;
    my %hash;
- Line 5245  sub tmprestore {
+ Line 6385  sub tmprestore {
    if (!$domain) { $domain=$env{'user.domain'}; }
    if (!$stuname) { $stuname=$env{'user.name'}; }
    if ($domain eq 'public' && $stuname eq 'public') {
-       $stuname=$ENV{'REMOTE_ADDR'};
+       $stuname=&get_requestor_ip();
    }
    my %returnhash;
    $namespace=~s/\//\_/g;
- Line 5301  sub store {
+ Line 6441  sub store {
      }
      if (!$home) { $home=$env{'user.home'}; }
-     $$storehash{'ip'}=$ENV{'REMOTE_ADDR'};
+     $$storehash{'ip'}=&get_requestor_ip();
      $$storehash{'host'}=$perlvar{'lonHostID'};
      my $namevalue='';
- Line 5337  sub cstore {
+ Line 6477  sub cstore {
      }
      if (!$home) { $home=$env{'user.home'}; }
-     $$storehash{'ip'}=$ENV{'REMOTE_ADDR'};
+     $$storehash{'ip'}=&get_requestor_ip();
      $$storehash{'host'}=$perlvar{'lonHostID'};
      my $namevalue='';
- Line 5503  sub privileged {
+ Line 6643  sub privileged {
      my $now = time;
      my $roles;
      if (ref($possroles) eq 'ARRAY') {
          $roles = $possroles;
      } else {
          $roles = ['dc','su'];
      }
- Line 5530  sub privileged {
+ Line 6670  sub privileged {
          for my $role (@rolesdump{grep { ! /^rolesdef_/ } keys(%rolesdump)}) {
              my ($trole, $tend, $tstart) = split(/_/, $role);
              if (grep(/^\Q$trole\E$/,@{$roles})) {
                  return 1 unless ($tend && $tend < $now)
                          or ($tstart && $tstart > $now);
              }
          }
- Line 5568  sub privileged_by_domain {
+ Line 6708  sub privileged_by_domain {
                          my ($trole,$uname,$udom,$rest) = split(/:/,$item,4);
                          my ($end,$start) = split(/:/,$dompersonnel{$server}{$item});
                          next if ($end && $end < $now);
                          $privileged{$dom}{$trole}{$uname.':'.$udom} =
                              $dompersonnel{$server}{$item};
                      }
                  }
- Line 5755  sub course_adhocrole_privs {
+ Line 6895  sub course_adhocrole_privs {
              $full{$priv} = $restrict;
          }
          foreach my $item (split(/,/,$overrides{"internal.adhocpriv.$rolename"})) {
-              next if ($item eq '');
+             next if ($item eq '');
-              my ($rule,$rest) = split(/=/,$item);
+             my ($rule,$rest) = split(/=/,$item);
-              next unless (($rule eq 'off') || ($rule eq 'on'));
+             next unless (($rule eq 'off') || ($rule eq 'on'));
-              foreach my $priv (split(/:/,$rest)) {
+             foreach my $priv (split(/:/,$rest)) {
-                  if ($priv ne '') {
+                 if ($priv ne '') {
-                      if ($rule eq 'off') {
+                     if ($rule eq 'off') {
-                          $possremove{$priv} = 1;
+                         $possremove{$priv} = 1;
-                      } else {
+                     } else {
-                          $possadd{$priv} = 1;
+                         $possadd{$priv} = 1;
-                      }
+                     }
-                  }
+                 }
-              }
+             }
-          }
+         }
-          foreach my $priv (sort(keys(%full))) {
+         foreach my $priv (sort(keys(%full))) {
-              if (exists($currprivs{$priv})) {
+             if (exists($currprivs{$priv})) {
-                  unless (exists($possremove{$priv})) {
+                 unless (exists($possremove{$priv})) {
-                      $storeprivs{$priv} = $currprivs{$priv};
+                     $storeprivs{$priv} = $currprivs{$priv};
-                  }
+                 }
-              } elsif (exists($possadd{$priv})) {
+             } elsif (exists($possadd{$priv})) {
-                  $storeprivs{$priv} = $full{$priv};
+                 $storeprivs{$priv} = $full{$priv};
-              }
+             }
-          }
+         }
-          $coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs)));
+         $coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs)));
-      }
+     }
-      return $coursepriv;
+     return $coursepriv;
  }
  sub group_roleprivs {
- Line 6001  sub check_adhoc_privs {
+ Line 7141  sub check_adhoc_privs {
      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);
- Line 6043  sub set_adhoc_privileges {
+ Line 7183  sub set_adhoc_privileges {
      my ($author,$adv,$rar)= &set_userprivs(\%userroles,\%rolehash);
      &appenv(\%userroles,[$role,'cm']);
      &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$spec);
-     unless ($caller eq 'constructaccess' && $env{'request.course.id'}) {
+     unless (($caller eq 'constructaccess' && $env{'request.course.id'}) ||
+             ($caller eq 'tiny')) {
          &appenv( {'request.role'        => $spec,
                    'request.role.domain' => $dcdom,
                    'request.course.sec'  => $sec,
                   }
                 );
          my $tadv=0;
- Line 6106  sub unserialize {
+ Line 7247  sub unserialize {
      return {} if $rep =~ /^error/;
      my %returnhash=();
-     foreach my $item (split(/\&/,$rep)) {
+ 	foreach my $item (split(/\&/,$rep)) {
-         my ($key, $value) = split(/=/, $item, 2);
+ 	    my ($key, $value) = split(/=/, $item, 2);
-         $key = unescape($key) unless $escapedkeys;
+ 	    $key = unescape($key) unless $escapedkeys;
-         next if $key =~ /^error: 2 /;
+ 	    next if $key =~ /^error: 2 /;
-         $returnhash{$key} = &thaw_unescape($value);
+ 	    $returnhash{$key} = &thaw_unescape($value);
-     }
+ 	}
+     #return %returnhash;
      return \%returnhash;
  }
  # see Lond::dump_with_regexp
  # if $escapedkeys hash keys won't get unescaped.
  sub dump {
-     my ($namespace,$udomain,$uname,$regexp,$range,$escapedkeys)=@_;
+     my ($namespace,$udomain,$uname,$regexp,$range,$escapedkeys,$encrypt)=@_;
      if (!$udomain) { $udomain=$env{'user.domain'}; }
      if (!$uname) { $uname=$env{'user.name'}; }
      my $uhome=&homeserver($uname,$udomain);
- Line 6128  sub dump {
+ Line 7270  sub dump {
      } else {
          $regexp='.';
      }
-     if (grep { $_ eq $uhome } &current_machine_ids()) {
+     if (grep { $_ eq $uhome } current_machine_ids()) {
          # user is hosted on this machine
-         my $reply = LONCAPA::Lond::dump_with_regexp(join(':', ($udomain,
+         my $reply = LONCAPA::Lond::dump_with_regexp(join(":", ($udomain,
                      $uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'});
-         return %{&unserialize($reply, $escapedkeys)};
+         return %{unserialize($reply, $escapedkeys)};
+     }
+     my $rep;
+     if ($encrypt) {
+         $rep=&reply("encrypt:edump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
+     } else {
+         $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
      }
-     my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
      my @pairs=split(/\&/,$rep);
      my %returnhash=();
      if (!($rep =~ /^error/ )) {
  	foreach my $item (@pairs) {
  	    my ($key,$value)=split(/=/,$item,2);
-             $key = &unescape($key) unless ($escapedkeys);
+         $key = unescape($key) unless $escapedkeys;
+         #$key = &unescape($key);
  	    next if ($key =~ /^error: 2 /);
  	    $returnhash{$key}=&thaw_unescape($value);
  	}
- Line 6184  sub currentdump {
+ Line 7332  sub currentdump {
     my $rep;
     if (grep { $_ eq $uhome } current_machine_ids()) {
         $rep = LONCAPA::Lond::dump_profile_database(join(":", ($sdom, $sname,
                     $courseid)));
     } else {
         $rep = reply('currentdump:'.$sdom.':'.$sname.':'.$courseid,$uhome);
- Line 6194  sub currentdump {
+ Line 7342  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,'.');
- Line 6280  sub inc {
+ Line 7428  sub inc {
  # --------------------------------------------------------------- put interface
  sub put {
-    my ($namespace,$storehash,$udomain,$uname)=@_;
+    my ($namespace,$storehash,$udomain,$uname,$encrypt)=@_;
     if (!$udomain) { $udomain=$env{'user.domain'}; }
     if (!$uname) { $uname=$env{'user.name'}; }
     my $uhome=&homeserver($uname,$udomain);
- Line 6289  sub put {
+ Line 7437  sub put {
         $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
     }
     $items=~s/\&$//;
-    return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
+    if ($encrypt) {
+        return &reply("encrypt:put:$udomain:$uname:$namespace:$items",$uhome);
+    } else {
+        return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
+    }
  }
  # ------------------------------------------------------------ newput interface
- Line 6329  sub putstore {
+ Line 7481  sub putstore {
         foreach my $key (keys(%{$storehash})) {
             $namevalue.=&escape($key).'='.&freeze_escape($storehash->{$key}).'&';
         }
-        $namevalue .= 'ip='.&escape($ENV{'REMOTE_ADDR'}).
+        my $ip = &get_requestor_ip();
+        $namevalue .= 'ip='.&escape($ip).
                       '&host='.&escape($perlvar{'lonHostID'}).
                       '&version='.$esc_v.
                       '&by='.&escape($env{'user.name'}.':'.$env{'user.domain'});
-        &Apache::lonnet::courselog($symb.':'.$uname.':'.$udomain.':PUTSTORE:'.$namevalue);
+        &courselog($symb.':'.$uname.':'.$udomain.':PUTSTORE:'.$namevalue);
     }
     if ($reply eq 'unknown_cmd') {
         # gfall back to way things use to be done
- Line 6445  sub tmpdel {
+ Line 7598  sub tmpdel {
      return &reply("tmpdel:$token",$server);
  }
  # ------------------------------------------------------------ get_timebased_id
  sub get_timebased_id {
      my ($prefix,$keyid,$namespace,$cdom,$cnum,$idtype,$who,$locktries,
          $maxtries) = @_;
      my ($newid,$error,$dellock);
      unless (($prefix =~ /^\w+$/) && ($keyid =~ /^\w+$/) && ($namespace ne '')) {
          return ('','ok','invalid call to get suffix');
      }
- Line 6465  sub get_timebased_id {
+ Line 7618  sub get_timebased_id {
      if (!$maxtries) {
          $maxtries = 10;
      }
      if (($cdom eq '') || ($cnum eq '')) {
          if ($env{'request.course.id'}) {
              $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
- Line 6483  sub get_timebased_id {
+ Line 7636  sub get_timebased_id {
      my $tries = 0;
  # attempt to get lock on nohist_$namespace file
-     my $gotlock = &Apache::lonnet::newput('nohist_'.$namespace,$lockhash,$cdom,$cnum);
+     my $gotlock = &newput('nohist_'.$namespace,$lockhash,$cdom,$cnum);
      while (($gotlock ne 'ok') && $tries <$locktries) {
          $tries ++;
          sleep 1;
-         $gotlock = &Apache::lonnet::newput('nohist_'.$namespace,$lockhash,$cdom,$cnum);
+         $gotlock = &newput('nohist_'.$namespace,$lockhash,$cdom,$cnum);
      }
  # attempt to get unique identifier, based on current timestamp
      if ($gotlock eq 'ok') {
-         my %inuse = &Apache::lonnet::dump('nohist_'.$namespace,$cdom,$cnum,$prefix);
+         my %inuse = &dump('nohist_'.$namespace,$cdom,$cnum,$prefix);
          my $id = time;
          $newid = $id;
          if ($idtype eq 'addcode') {
- Line 6513  sub get_timebased_id {
+ Line 7666  sub get_timebased_id {
              my %new_item =  (
                                $prefix."\0".$newid => $who,
                              );
-             my $putresult = &Apache::lonnet::put('nohist_'.$namespace,\%new_item,
+             my $putresult = &put('nohist_'.$namespace,\%new_item,
                                                   $cdom,$cnum);
              if ($putresult ne 'ok') {
                  undef($newid);
- Line 6553  sub portfolio_access {
+ Line 7706  sub portfolio_access {
      if ($result) {
          my %setters;
          if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
-             my ($startblock,$endblock) =
+             my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
-                 &Apache::loncommon::blockcheck(\%setters,'port',$unum,$udom);
+                 &Apache::loncommon::blockcheck(\%setters,'port',$clientip,$unum,$udom);
-             if ($startblock && $endblock) {
+             if (($startblock && $endblock) || ($by_ip)) {
                  return 'B';
              }
          } else {
-             my ($startblock,$endblock) =
+             my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
-                 &Apache::loncommon::blockcheck(\%setters,'port');
+                 &Apache::loncommon::blockcheck(\%setters,'port',$clientip);
-             if ($startblock && $endblock) {
+             if (($startblock && $endblock) || ($by_ip)) {
                  return 'B';
              }
          }
- Line 6620  sub get_portfolio_access {
+ Line 7773  sub get_portfolio_access {
                  if (ref($access_hash->{$ipkey}{'ip'}) eq 'ARRAY') {
                      if (&Apache::loncommon::check_ip_acc(join(',',@{$access_hash->{$ipkey}{'ip'}}),$clientip)) {
                          $allowed = 1;
                          last;
                      }
                  }
              }
- Line 6814  sub usertools_access {
+ Line 7967  sub usertools_access {
                        unofficial => 1,
                        community  => 1,
                        textbook   => 1,
+                       placement  => 1,
+                       lti        => 1,
                   );
      } elsif ($context eq 'requestauthor') {
          %tools = (
- Line 6825  sub usertools_access {
+ Line 7980  sub usertools_access {
                        blog      => 1,
                        webdav    => 1,
                        portfolio => 1,
+                       timezone  => 1,
                   );
      }
      return if (!defined($tools{$tool}));
- Line 6848  sub usertools_access {
+ Line 8004  sub usertools_access {
      my ($toolstatus,$inststatus,$envkey);
      if ($context eq 'requestauthor') {
          $envkey = $context;
      } else {
          $envkey = $context.'.'.$tool;
      }
- Line 6949  sub is_course_owner {
+ Line 8105  sub is_course_owner {
              if ($env{'course.'.$cdom.'_'.$cnum.'.internal.courseowner'} eq $uname.':'.$udom) {
                  return 1;
              } else {
-                 my %courseinfo = &Apache::lonnet::coursedescription($cdom.'/'.$cnum);
+                 my %courseinfo = &coursedescription($cdom.'/'.$cnum);
                  if ($courseinfo{'internal.courseowner'} eq $uname.':'.$udom) {
                      return 1;
                  }
- Line 7010  sub is_advanced_user {
+ Line 8166  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')) {
+         my %willtrust;
          foreach my $type (@{$types}) {
-             if (&usertools_access($env{'user.name'},
+             if (&usertools_access($uname,$udom,$type,undef,
-                                   $env{'user.domain'},
+                                   'requestcourses')) {
-                                   $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) {
                          if (ref($request_domains) eq 'HASH') {
                              my ($otherdom) = ($item =~ /^($match_domain):($optregex)(=?\d*)$/);
                              if ($otherdom ne '') {
-                                 if (ref($request_domains->{$type}) eq 'ARRAY') {
+                                 unless (exists($willtrust{$otherdom})) {
-                                     unless (grep(/^\Q$otherdom\E$/,@{$request_domains->{$type}})) {
+                                     $willtrust{$otherdom} = &will_trust('reqcrs',$env{'user.domain'},$otherdom);
+                                 }
+                                 if ($willtrust{$otherdom}) {
+                                     if (ref($request_domains->{$type}) eq 'ARRAY') {
+                                         unless (grep(/^\Q$otherdom\E$/,@{$request_domains->{$type}})) {
+                                             push(@{$request_domains->{$type}},$otherdom);
+                                         }
+                                     } else {
                                          push(@{$request_domains->{$type}},$otherdom);
                                      }
-                                 } else {
-                                     push(@{$request_domains->{$type}},$otherdom);
                                  }
                              }
                          }
                      }
-                     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;
- Line 7110  sub customaccess {
+ Line 8276  sub customaccess {
  # ------------------------------------------------- Check for a user privilege
  sub allowed {
-     my ($priv,$uri,$symb,$role,$clientip,$noblockcheck)=@_;
+     my ($priv,$uri,$symb,$role,$clientip,$noblockcheck,$ignorecache,$nodeeplinkcheck,$nodeeplinkout)=@_;
      my $ver_orguri=$uri;
      $uri=&deversion($uri);
      my $orguri=$uri;
      $uri=&declutter($uri);
      if ($priv eq 'evb') {
- # Evade communication block restrictions for specified role in a course
+ # Evade communication block restrictions for specified role in a course or domain
          if ($env{'user.priv.'.$role} =~/evb\&([^\:]*)/) {
              return $1;
          } else {
- Line 7127  sub allowed {
+ Line 8293  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|viewclasslist|aboutme|ext\.tool)$}))
  	 || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) ))
  	&& ($priv eq 'bre')) {
  	return 'F';
- Line 7138  sub allowed {
+ Line 8304  sub allowed {
      if (($space=~/^(uploaded|editupload)$/) && ($env{'user.name'} eq $name) &&
  	($env{'user.domain'} eq $domain) && ('portfolio' eq $dir[0])) {
          my %setters;
-         my ($startblock,$endblock) =
+         my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
-             &Apache::loncommon::blockcheck(\%setters,'port');
+             &Apache::loncommon::blockcheck(\%setters,'port',$clientip);
-         if ($startblock && $endblock) {
+         if (($startblock && $endblock) || ($by_ip)) {
              return 'B';
          } else {
              return 'F';
- Line 7175  sub allowed {
+ Line 8341  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';
          }
- Line 7233  sub allowed {
+ Line 8402  sub allowed {
                          my $adom = $1;
                          foreach my $key (keys(%env)) {
                              if ($key =~ m{^user\.role\.(ca|aa)/\Q$adom\E}) {
-                                 my ($start,$end) = split('.',$env{$key});
+                                 my ($start,$end) = split(/\./,$env{$key});
-                                 if (($now >= $start) && (!$end || $end < $now)) {
+                                 if (($now >= $start) && (!$end || $end > $now)) {
                                      $ownaccess = 1;
                                      last;
                                  }
- Line 7246  sub allowed {
+ Line 8415  sub allowed {
                          foreach my $role ('ca','aa') {
                              if ($env{"user.role.$role./$adom/$aname"}) {
                                  my ($start,$end) =
-                                     split('.',$env{"user.role.$role./$adom/$aname"});
+                                     split(/\./,$env{"user.role.$role./$adom/$aname"});
-                                 if (($now >= $start) && (!$end || $end < $now)) {
+                                 if (($now >= $start) && (!$end || $end > $now)) {
                                      $ownaccess = 1;
                                      last;
                                  }
- Line 7292  sub allowed {
+ Line 8461  sub allowed {
      if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseuri}
         =~/\Q$priv\E\&([^\:]*)/) {
-         unless (($priv eq 'bro') && (!$ownaccess)) {
+         if ($priv eq 'mip') {
-             $thisallowed.=$1;
+             my $rem = $1;
+             if (($uri ne '') && ($env{'request.course.id'} eq $uri) &&
+                 ($env{'course.'.$env{'request.course.id'}.'.internal.courseowner'} eq $env{'user.name'}.':'.$env{'user.domain'})) {
+                 my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+                 if ($cdom ne '') {
+                     my %passwdconf = &get_passwdconf($cdom);
+                     if (ref($passwdconf{'crsownerchg'}) eq 'HASH') {
+                         if (ref($passwdconf{'crsownerchg'}{'by'}) eq 'ARRAY') {
+                             if (@{$passwdconf{'crsownerchg'}{'by'}}) {
+                                 my @inststatuses = split(':',$env{'environment.inststatus'});
+                                 unless (@inststatuses) {
+                                     @inststatuses = ('default');
+                                 }
+                                 foreach my $status (@inststatuses) {
+                                     if (grep(/^\Q$status\E$/,@{$passwdconf{'crsownerchg'}{'by'}})) {
+                                         $thisallowed.=$rem;
+                                     }
+                                 }
+                             }
+                         }
+                     }
+                 }
+             }
+         } else {
+             unless (($priv eq 'bro') && (!$ownaccess)) {
+                 $thisallowed.=$1;
+             }
          }
      }
- Line 7306  sub allowed {
+ Line 8501  sub allowed {
              if ($env{'user.priv.'.$env{'request.role'}.'./'}
                    =~/\Q$priv\E\&([^\:]*)/) {
                  my $value = $1;
-                 if ($noblockcheck) {
+                 my $deeplinkblock;
+                 unless ($nodeeplinkcheck) {
+                     $deeplinkblock = &deeplink_check($priv,$symb,$uri);
+                 }
+                 if ($deeplinkblock) {
+                     $thisallowed='D';
+                 } elsif ($noblockcheck) {
                      $thisallowed.=$value;
                  } else {
-                     my @blockers = &has_comm_blocking($priv,$symb,$uri);
+                     my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache);
                      if (@blockers > 0) {
                          $thisallowed = 'B';
                      } else {
- Line 7326  sub allowed {
+ Line 8527  sub allowed {
                      $refuri=&declutter($refuri);
                      my ($match) = &is_on_map($refuri);
                      if ($match) {
-                         if ($noblockcheck) {
+                         my $deeplinkblock;
+                         unless ($nodeeplinkcheck) {
+                             $deeplinkblock = &deeplink_check($priv,$symb,$refuri);
+                         }
+                         if ($deeplinkblock) {
+                             $thisallowed='D';
+                         } elsif ($noblockcheck) {
                              $thisallowed='F';
                          } else {
-                             my @blockers = &has_comm_blocking($priv,$symb,$refuri);
+                             my @blockers = &has_comm_blocking($priv,'',$refuri,'',1);
                              if (@blockers > 0) {
                                  $thisallowed = 'B';
                              } else {
- Line 7348  sub allowed {
+ Line 8555  sub allowed {
  	&& &is_portfolio_url($uri)) {
  	$thisallowed = &portfolio_access($uri,$clientip);
      }
  # Full access at system, domain or course-wide level? Exit.
      if ($thisallowed=~/F/) {
  	return 'F';
- Line 7376  sub allowed {
+ Line 8583  sub allowed {
      if ($env{'request.course.id'}) {
+ # If this is modifying password (internal auth) domains must match for user and user's role.
+         if ($priv eq 'mip') {
+             if ($env{'user.domain'} eq $env{'request.role.domain'}) {
+                 return $thisallowed;
+             } else {
+                 return '';
+             }
+         }
         $courseprivid=$env{'request.course.id'};
         if ($env{'request.course.sec'}) {
            $courseprivid.='/'.$env{'request.course.sec'};
- Line 7389  sub allowed {
+ Line 8606  sub allowed {
                 =~/\Q$priv\E\&([^\:]*)/) {
                 my $value = $1;
                 if ($priv eq 'bre') {
-                    if ($noblockcheck) {
+                    my $deeplinkblock;
+                    unless ($nodeeplinkcheck) {
+                        $deeplinkblock = &deeplink_check($priv,$symb,$uri);
+                    }
+                    if ($deeplinkblock) {
+                        $thisallowed = 'D';
+                    } elsif ($noblockcheck) {
                         $thisallowed.=$value;
                     } else {
-                        my @blockers = &has_comm_blocking($priv,$symb,$uri);
+                        my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache);
                         if (@blockers > 0) {
                             $thisallowed = 'B';
                         } else {
- Line 7405  sub allowed {
+ Line 8628  sub allowed {
                 $checkreferer=0;
             }
         }
         if ($checkreferer) {
  	  my $refuri=$env{'httpref.'.$orguri};
              unless ($refuri) {
- Line 7431  sub allowed {
+ Line 8654  sub allowed {
                    =~/\Q$priv\E\&([^\:]*)/) {
                    my $value = $1;
                    if ($priv eq 'bre') {
-                       if ($noblockcheck) {
+                       my $deeplinkblock;
+                       unless ($nodeeplinkcheck) {
+                           $deeplinkblock = &deeplink_check($priv,$symb,$refuri);
+                       }
+                       if ($deeplinkblock) {
+                           $thisallowed = 'D';
+                       } elsif ($noblockcheck) {
                            $thisallowed.=$value;
                        } else {
-                           my @blockers = &has_comm_blocking($priv,$symb,$refuri);
+                           my @blockers = &has_comm_blocking($priv,'',$refuri,'',1);
                            if (@blockers > 0) {
                                $thisallowed = 'B';
                            } else {
- Line 7476  sub allowed {
+ Line 8705  sub allowed {
  #
  # Possibly locked functionality, check all courses
+ # In roles.tab, L (unless locked) available for bre, pch, plc, pac and sma.
  # Locks might take effect only after 10 minutes cache expiration for other
- # courses, and 2 minutes for current course
+ # courses, and 2 minutes for current course, in which user has st or ta role
+ # which is neither expired nor a future role (unless current course).
-     my $envkey;
+     my ($needlockcheck,$now,$crsonly);
      if ($thisallowed=~/L/) {
-         foreach $envkey (keys(%env)) {
+         $now = time;
+         if ($priv eq 'bre') {
+             if ($uri ne '') {
+                 if ($orguri =~ m{^/+res/}) {
+                     if ($uri =~ m{^lib/templates/}) {
+                         if ($env{'request.course.id'}) {
+                             $crsonly = 1;
+                             $needlockcheck = 1;
+                         }
+                     } else {
+                         $needlockcheck = 1;
+                     }
+                 } elsif ($env{'request.course.id'}) {
+                     my ($crsdom,$crsnum) = split('_',$env{'request.course.id'});
+                     if (($uri =~ m{^(adm|uploaded|public)/$crsdom/$crsnum/}) ||
+                         ($uri =~ m{^adm/$match_domain/$match_username/\d+/(smppg|bulletinboard)$})) {
+                         $crsonly = 1;
+                     }
+                     $needlockcheck = 1;
+                 }
+             }
+         } elsif (($priv eq 'pch') || ($priv eq 'plc') || ($priv eq 'pac') || ($priv eq 'sma')) {
+             $needlockcheck = 1;
+         }
+     }
+     if ($needlockcheck) {
+         foreach my $envkey (keys(%env)) {
             if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {
                 my $courseid=$2;
                 my $roleid=$1.'.'.$2;
                 $courseid=~s/^\///;
+                unless ($env{'request.role'} eq $roleid) {
+                    my ($start,$end) = split(/\./,$env{$envkey});
+                    next unless (($now >= $start) && (!$end || $end > $now));
+                }
                 my $expiretime=600;
                 if ($env{'request.role'} eq $roleid) {
  		  $expiretime=120;
- Line 7508  sub allowed {
+ Line 8769  sub allowed {
                 }
                 if (($env{$prefix.'priv.'.$priv.'.lock.sections'}=~/\,\Q$csec\E\,/)
                  || ($env{$prefix.'priv.'.$priv.'.lock.sections'} eq 'all')) {
- 		   if ($env{'priv.'.$priv.'.lock.expire'}>time) {
+ 		   if ($env{$prefix.'priv.'.$priv.'.lock.expire'}>time) {
                         &log($env{'user.domain'},$env{'user.name'},
                              $env{'user.home'},
                              'Locked by priv: '.$priv.' for '.$uri.' due to '.
- Line 7520  sub allowed {
+ Line 8781  sub allowed {
  	   }
         }
      }
  #
  # Rest of the restrictions depend on selected course
  #
- Line 7547  sub allowed {
+ Line 8808  sub allowed {
         my $unamedom=$env{'user.name'}.':'.$env{'user.domain'};
         if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'}
  	   =~/\Q$rolecode\E/) {
- 	   if (($priv ne 'pch') && ($priv ne 'plc')) {
+ 	   if (($priv ne 'pch') && ($priv ne 'plc') && ($priv ne 'pac')) {
  	       &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
  			'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
  			$env{'request.course.id'});
- Line 7557  sub allowed {
+ Line 8818  sub allowed {
         if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'}
  	   =~/\Q$unamedom\E/) {
- 	   if (($priv ne 'pch') && ($priv ne 'plc')) {
+ 	   if (($priv ne 'pch') && ($priv ne 'plc') && ($priv ne 'pac')) {
  	       &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.
  			'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.
  			$env{'request.course.id'});
- Line 7579  sub allowed {
+ Line 8840  sub allowed {
         }
     }
+ # Restricted for deeplinked session?
+     if ($env{'request.deeplink.login'}) {
+         if ($env{'acc.deeplinkout'} && !$nodeeplinkout) {
+             if (!$symb) { $symb=&symbread($uri,1); }
+             if (($symb) && ($env{'acc.deeplinkout'}=~/\&\Q$symb\E\&/)) {
+                 return '';
+             }
+         }
+     }
  # Restricted by state or randomout?
     if ($thisallowed=~/X/) {
- Line 7599  sub allowed {
+ Line 8871  sub allowed {
  	return 'A';
      } elsif ($thisallowed eq 'B') {
          return 'B';
+     } elsif ($thisallowed eq 'D') {
+         return 'D';
      }
     return 'F';
  }
- Line 7615  sub constructaccess {
+ Line 8889  sub constructaccess {
      my ($ownername,$ownerdomain,$ownerhome);
      ($ownerdomain,$ownername) =
-         ($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)/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 ''; }
- Line 7636  sub constructaccess {
+ Line 8910  sub constructaccess {
              $ownerhome = &homeserver($ownername,$ownerdomain);
              return ($ownername,$ownerdomain,$ownerhome);
          }
+         if ($env{'request.course.id'}) {
+             if (($ownername eq $env{'course.'.$env{'request.course.id'}.'.num'}) &&
+                 ($ownerdomain eq $env{'course.'.$env{'request.course.id'}.'.domain'})) {
+                 if (&allowed('mdc',$env{'request.course.id'})) {
+                     $ownerhome = $env{'course.'.$env{'request.course.id'}.'.home'};
+                     return ($ownername,$ownerdomain,$ownerhome);
+                 }
+             }
+         }
      }
  # We don't have any access right now. If we are not possibly going to do anything about this,
- Line 7678  sub constructaccess {
+ Line 8961  sub constructaccess {
  #
  # User for whom data are being temporarily cached.
  my $cacheduser='';
- # Cached blockers for this user (a hash of blocking items).
+ # Course for which data are being temporarily cached.
+ my $cachedcid='';
+ # Cached blockers for this user (a hash of blocking items).
  my %cachedblockers=();
  # When the data were last cached.
  my $cachedlast='';
  sub load_all_blockers {
-     my ($uname,$udom,$blocks)=@_;
+     my ($uname,$udom)=@_;
      if (($uname ne '') && ($udom ne '')) {
          if (($cacheduser eq $uname.':'.$udom) &&
+             ($cachedcid eq $env{'request.course.id'}) &&
              (abs($cachedlast-time)<5)) {
              return;
          }
      }
      $cachedlast=time;
      $cacheduser=$uname.':'.$udom;
-     %cachedblockers = &get_commblock_resources($blocks);
+     $cachedcid=$env{'request.course.id'};
+     %cachedblockers = &get_commblock_resources();
+     return;
  }
  sub get_comm_blocks {
- Line 7709  sub get_comm_blocks {
+ Line 8997  sub get_comm_blocks {
      if ((defined($cached)) && (ref($blocksref) eq 'HASH')) {
          %commblocks = %{$blocksref};
      } else {
-         %commblocks = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
+         %commblocks = &dump('comm_block',$cdom,$cnum);
          my $cachetime = 600;
          &do_cache_new('comm_block',$hashid,\%commblocks,$cachetime);
      }
- Line 7720  sub get_commblock_resources {
+ Line 9008  sub get_commblock_resources {
      my ($blocks) = @_;
      my %blockers = ();
      return %blockers unless ($env{'request.course.id'});
-     return %blockers if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/);
+     my $courseurl = &courseid_to_courseurl($env{'request.course.id'});
+     if ($env{'request.course.sec'}) {
+         $courseurl .= '/'.$env{'request.course.sec'};
+     }
+     return %blockers if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseurl} =~/evb\&([^\:]*)/);
      my %commblocks;
      if (ref($blocks) eq 'HASH') {
          %commblocks = %{$blocks};
      } else {
          %commblocks = &get_comm_blocks();
      }
      return %blockers unless (keys(%commblocks) > 0);
      my $navmap = Apache::lonnavmaps::navmap->new();
      return %blockers unless (ref($navmap));
      my $now = time;
- Line 7739  sub get_commblock_resources {
+ Line 9031  sub get_commblock_resources {
                      if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') {
                          if (ref($commblocks{$block}{'blocks'}{'docs'}{'maps'}) eq 'HASH') {
                              if (keys(%{$commblocks{$block}{'blocks'}{'docs'}{'maps'}})) {
                                  $blockers{$block}{maps} = $commblocks{$block}{'blocks'}{'docs'}{'maps'};
                              }
                          }
                          if (ref($commblocks{$block}{'blocks'}{'docs'}{'resources'}) eq 'HASH') {
- Line 7752  sub get_commblock_resources {
+ Line 9044  sub get_commblock_resources {
              }
          } elsif ($block =~ /^firstaccess____(.+)$/) {
              my $item = $1;
-             my @to_test;
              if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                  if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') {
-                     my @interval;
+                     my (@interval,$mapname);
                      my $type = 'map';
                      if ($item eq 'course') {
                          $type = 'course';
- Line 7764  sub get_commblock_resources {
+ Line 9055  sub get_commblock_resources {
                          if ($item =~ /___\d+___/) {
                              $type = 'resource';
                              @interval=&EXT("resource.0.interval",$item);
-                             if (ref($navmap)) {
-                                 my $res = $navmap->getBySymb($item);
-                                 push(@to_test,$res);
-                             }
                          } else {
-                             my $mapsymb = &symbread($item,1);
+                             $mapname = &deversion($item);
-                             if ($mapsymb) {
+                             if (ref($navmap)) {
-                                 if (ref($navmap)) {
+                                 my $timelimit = $navmap->get_mapparam(undef,$mapname,'0.interval');
-                                     my $mapres = $navmap->getBySymb($mapsymb);
+                                 @interval = ($timelimit,'map');
-                                     @to_test = $mapres->retrieveResources($mapres,undef,0,0,0,1);
-                                     foreach my $res (@to_test) {
-                                         my $symb = $res->symb();
-                                         next if ($symb eq $mapsymb);
-                                         if ($symb ne '') {
-                                             @interval=&EXT("resource.0.interval",$symb);
-                                             if ($interval[1] eq 'map') {
-                                                 last;
-                                             }
-                                         }
-                                     }
-                                 }
                              }
                          }
                      }
-                     if ($interval[0] =~ /^\d+$/) {
+                     if ($interval[0] =~ /^(\d+)/) {
+                         my $timelimit = $1;
                          my $first_access;
                          if ($type eq 'resource') {
                              $first_access=&get_first_access($interval[1],$item);
- Line 7798  sub get_commblock_resources {
+ Line 9074  sub get_commblock_resources {
                              $first_access=&get_first_access($interval[1]);
                          }
                          if ($first_access) {
-                             my $timesup = $first_access+$interval[0];
+                             my $timesup = $first_access+$timelimit;
                              if ($timesup > $now) {
                                  my $activeblock;
-                                 foreach my $res (@to_test) {
+                                 if ($type eq 'resource') {
-                                     if ($res->answerable()) {
+                                     if (ref($navmap)) {
-                                         $activeblock = 1;
+                                         my $res = $navmap->getBySymb($item);
-                                         last;
+                                         if ($res->answerable()) {
+                                             $activeblock = 1;
+                                         }
+                                     }
+                                 } elsif ($type eq 'map') {
+                                     my $mapsymb = &symbread($mapname,1);
+                                     if (($mapsymb) && (ref($navmap))) {
+                                         my $mapres = $navmap->getBySymb($mapsymb);
+                                         if (ref($mapres)) {
+                                             my $first = $mapres->map_start();
+                                             my $finish = $mapres->map_finish();
+                                             my $it = $navmap->getIterator($first,$finish,undef,0,0);
+                                             if (ref($it)) {
+                                                 my $res;
+                                                 while ($res = $it->next(undef,1)) {
+                                                     next unless (ref($res));
+                                                     my $symb = $res->symb();
+                                                     next if (($symb eq $mapsymb) || ($symb eq ''));
+                                                     @interval=&EXT("resource.0.interval",$symb);
+                                                     if ($interval[1] eq 'map') {
+                                                         if ($res->answerable()) {
+                                                             $activeblock = 1;
+                                                             last;
+                                                         }
+                                                     }
+                                                 }
+                                             }
+                                         }
                                      }
                                  }
                                  if ($activeblock) {
- Line 7830  sub get_commblock_resources {
+ Line 9133  sub get_commblock_resources {
  }
  sub has_comm_blocking {
-     my ($priv,$symb,$uri,$blocks) = @_;
+     my ($priv,$symb,$uri,$ignoresymbdb,$noenccheck,$blocked,$blocks) = @_;
      my @blockers;
      return unless ($env{'request.course.id'});
      return unless ($priv eq 'bre');
-     return if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/);
      return if ($env{'request.state'} eq 'construct');
-     &load_all_blockers($env{'user.name'},$env{'user.domain'},$blocks);
+     my $courseurl = &courseid_to_courseurl($env{'request.course.id'});
-     return unless (keys(%cachedblockers) > 0);
+     if ($env{'request.course.sec'}) {
+         $courseurl .= '/'.$env{'request.course.sec'};
+     }
+     return if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseurl} =~/evb\&([^\:]*)/);
+     my %blockinfo;
+     if (ref($blocks) eq 'HASH') {
+         %blockinfo = &get_commblock_resources($blocks);
+     } else {
+         &load_all_blockers($env{'user.name'},$env{'user.domain'});
+         %blockinfo = %cachedblockers;
+     }
+     return unless (keys(%blockinfo) > 0);
      my (%possibles,@symbs);
      if (!$symb) {
-         $symb = &symbread($uri,1,1,1,\%possibles);
+         $symb = &symbread($uri,1,1,1,\%possibles,$ignoresymbdb,$noenccheck);
      }
      if ($symb) {
          @symbs = ($symb);
      } elsif (keys(%possibles)) {
          @symbs = keys(%possibles);
      }
      my $noblock;
      foreach my $symb (@symbs) {
          last if ($noblock);
          my ($map,$resid,$resurl)=&decode_symb($symb);
-         foreach my $block (keys(%cachedblockers)) {
+         foreach my $block (keys(%blockinfo)) {
              if ($block =~ /^firstaccess____(.+)$/) {
                  my $item = $1;
-                 if (($item eq $map) || ($item eq $symb)) {
+                 unless ($blocked) {
-                     $noblock = 1;
+                     if (($item eq $map) || ($item eq $symb)) {
-                     last;
+                         $noblock = 1;
+                         last;
+                     }
                  }
              }
-             if (ref($cachedblockers{$block}) eq 'HASH') {
+             if (ref($blockinfo{$block}) eq 'HASH') {
-                 if (ref($cachedblockers{$block}{'resources'}) eq 'HASH') {
+                 if (ref($blockinfo{$block}{'resources'}) eq 'HASH') {
-                     if ($cachedblockers{$block}{'resources'}{$symb}) {
+                     if ($blockinfo{$block}{'resources'}{$symb}) {
                          unless (grep(/^\Q$block\E$/,@blockers)) {
                              push(@blockers,$block);
                          }
                      }
                  }
-             }
+                 if (ref($blockinfo{$block}{'maps'}) eq 'HASH') {
-             if (ref($cachedblockers{$block}{'maps'}) eq 'HASH') {
+                     if ($blockinfo{$block}{'maps'}{$map}) {
-                 if ($cachedblockers{$block}{'maps'}{$map}) {
+                         unless (grep(/^\Q$block\E$/,@blockers)) {
-                     unless (grep(/^\Q$block\E$/,@blockers)) {
+                             push(@blockers,$block);
-                         push(@blockers,$block);
+                         }
                      }
                  }
              }
          }
      }
-     return if ($noblock);
+     unless ($noblock) {
-     return @blockers;
+         return @blockers;
+     }
+     return;
  }
  }
- # -------------------------------- Deversion and split uri into path an filename
+ sub deeplink_check {
+     my ($priv,$symb,$uri) = @_;
+     return unless ($env{'request.course.id'});
+     return unless ($priv eq 'bre');
+     return if ($env{'request.state'} eq 'construct');
+     return if ($env{'request.role.adv'});
+     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+     my (%possibles,@symbs);
+     if (!$symb) {
+         $symb = &symbread($uri,1,1,1,\%possibles);
+     }
+     if ($symb) {
+         @symbs = ($symb);
+     } elsif (keys(%possibles)) {
+         @symbs = keys(%possibles);
+     }
+     my ($deeplink_symb,$allow);
+     if ($env{'request.deeplink.login'}) {
+         $deeplink_symb = &Apache::loncommon::deeplink_login_symb($cnum,$cdom);
+     }
+     foreach my $symb (@symbs) {
+         last if ($allow);
+         my $deeplink = &EXT("resource.0.deeplink",$symb);
+         if ($deeplink eq '') {
+             $allow = 1;
+         } else {
+             my ($state,$others,$listed,$scope,$protect) = split(/,/,$deeplink);
+             if ($state ne 'only') {
+                 $allow = 1;
+             } else {
+                 my $check_deeplink_entry;
+                 if ($protect ne 'none') {
+                     my ($acctype,$item) = split(/:/,$protect);
+                     if (($acctype eq 'ltic') && ($env{'user.linkprotector'})) {
+                         if (grep(/^\Q$item\Ec$/,split(/,/,$env{'user.linkprotector'}))) {
+                             $check_deeplink_entry = 1
+                         }
+                     } elsif (($acctype eq 'ltid') && ($env{'user.linkprotector'})) {
+                         if (grep(/^\Q$item\Ed$/,split(/,/,$env{'user.linkprotector'}))) {
+                             $check_deeplink_entry = 1;
+                         }
+                     } elsif (($acctype eq 'key') && ($env{'user.deeplinkkey'})) {
+                         if (grep(/^\Q$item\E$/,split(/,/,$env{'user.deeplinkkey'}))) {
+                             $check_deeplink_entry = 1;
+                         }
+                     }
+                 }
+                 if (($protect eq 'none') || ($check_deeplink_entry)) {
+                     if ($scope eq 'res') {
+                         if ($symb eq $deeplink_symb) {
+                             $allow = 1;
+                         }
+                     } elsif (($scope eq 'map') || ($scope eq 'rec')) {
+                         my ($map_from_symb,$map_from_login);
+                         $map_from_symb = &deversion((&decode_symb($symb))[0]);
+                         if ($deeplink_symb =~ /\.(page|sequence)$/) {
+                             $map_from_login = &deversion((&decode_symb($deeplink_symb))[2]);
+                         } else {
+                             $map_from_login = &deversion((&decode_symb($deeplink_symb))[0]);
+                         }
+                         if (($map_from_symb) && ($map_from_login)) {
+                             if ($map_from_symb eq $map_from_login) {
+                                 $allow = 1;
+                             } elsif ($scope eq 'rec') {
+                                 my @recurseup = &get_map_hierarchy($map_from_symb,$env{'request.course.id'});
+                                 if (grep(/^\Q$map_from_login\E$/,@recurseup)) {
+                                     $allow = 1;
+                                 }
+                             }
+                         }
+                     }
+                 }
+             }
+         }
+     }
+     return if ($allow);
+     return 1;
+ }
+ # -------------------------------- Deversion and split uri into path an filename
  #
  #   Removes the version from a URI and
- Line 8008  sub metadata_query {
+ Line 9406  sub metadata_query {
      my @server_list = (defined($server_array) ? @$server_array
                                                : keys(%libserv) );
      for my $server (@server_list) {
          my $domains = '';
          if (ref($domains_hash) eq 'HASH') {
              $domains = $domains_hash->{$server};
          }
  	unless ($custom or $customshow) {
  	    my $reply=&reply("querysend:".&escape($query).':::'.&escape($domains),$server);
- Line 8276  sub auto_validate_instcode {
+ Line 9674  sub auto_validate_instcode {
      return ($outcome,$description,$defaultcredits);
  }
+ sub auto_validate_inst_crosslist {
+     my ($cnum,$cdom,$instcode,$inst_xlist,$coowner) = @_;
+     my ($homeserver,$response);
+     if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) {
+         $homeserver = &homeserver($cnum,$cdom);
+     }
+     if (!defined($homeserver)) {
+         if ($cdom =~ /^$match_domain$/) {
+             $homeserver = &domain($cdom,'primary');
+         }
+     }
+     unless (($homeserver eq '') || ($homeserver eq 'no_host')) {
+         $response=&reply('autovalidateinstcrosslist:'.$cdom.':'.
+                          &escape($instcode).':'.&escape($inst_xlist).':'.
+                          &escape($coowner),$homeserver);
+     }
+     return $response;
+ }
  sub auto_create_password {
      my ($cnum,$cdom,$authparam,$udom) = @_;
      my ($homeserver,$response);
- Line 8547  sub auto_validate_class_sec {
+ Line 9964  sub auto_validate_class_sec {
      return $response;
  }
+ sub auto_instsec_reformat {
+     my ($cdom,$action,$instsecref) = @_;
+     return unless(($action eq 'clutter') || ($action eq 'declutter'));
+     my @homeservers;
+     if (defined(&domain($cdom,'primary'))) {
+         push(@homeservers,&domain($cdom,'primary'));
+     } else {
+         my %servers = &get_servers($cdom,'library');
+         foreach my $tryserver (keys(%servers)) {
+             if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
+                 push(@homeservers,$tryserver);
+             }
+         }
+     }
+     my $response;
+     my %reformatted = %{$instsecref};
+     foreach my $server (@homeservers) {
+         if (ref($instsecref) eq 'HASH') {
+             my $info = &freeze_escape($instsecref);
+             my $response=&reply('autoinstsecreformat:'.$cdom.':'.
+                                 $action.':'.$info,$server);
+             next if ($response =~ /(con_lost|error|no_such_host|refused|unknown_command)/);
+             my @items = split(/&/,$response);
+             foreach my $item (@items) {
+                 my ($key,$value) = split(/=/,$item);
+                 $reformatted{&unescape($key)} = &thaw_unescape($value);
+             }
+         }
+     }
+     return %reformatted;
+ }
  sub auto_validate_instclasses {
      my ($cdom,$cnum,$owners,$classesref) = @_;
      my ($homeserver,%validations);
- Line 8590  sub auto_crsreq_update {
+ Line 10039  sub auto_crsreq_update {
                              ':'.&escape($action).':'.&escape($ownername).':'.
                              &escape($ownerdomain).':'.&escape($fullname).':'.
                              &escape($title).':'.&escape($code).':'.
-                             &escape($accessstart).':'.&escape($accessend).':'.$info,$homeserver);
+                             &escape($accessstart).':'.&escape($accessend).':'.$info,
+                             $homeserver);
          unless ($response =~ /(con_lost|error|no_such_host|refused)/) {
              my @items = split(/&/,$response);
              foreach my $item (@items) {
- Line 8850  sub plaintext {
+ Line 10300  sub plaintext {
      my %rolenames = (
                        Course    => 'std',
                        Community => 'alt1',
+                       Placement => 'std',
                      );
      if ($cid ne '') {
          if ($env{'course.'.$cid.'.'.$short.'.plaintext'} ne '') {
- Line 8883  sub assignrole {
+ Line 10334  sub assignrole {
      if ($role =~ /^cr\//) {
          my $cwosec=$url;
          $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;
- 	unless (&allowed('ccr',$cwosec)) {
+         if ((!&allowed('ccr',$cwosec)) && (!&allowed('ccr',$udom))) {
             my $refused = 1;
             if ($context eq 'requestcourses') {
                 if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) {
- Line 8931  sub assignrole {
+ Line 10382  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'));
- Line 8951  sub assignrole {
+ Line 10402  sub assignrole {
                              }
                          }
                      }
-                 } elsif (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
+                 } elsif (($selfenroll == 1) && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
-                     $refused = '';
+                     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 '')) {
- Line 8971  sub assignrole {
+ Line 10426  sub assignrole {
                          }
                      }
                  } elsif ($context eq 'requestauthor') {
                      if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'}) &&
                          ($url eq '/'.$udom.'/') && ($role eq 'au')) {
                          if ($env{'environment.requestauthor'} eq 'automatic') {
                              $refused = '';
- Line 8979  sub assignrole {
+ Line 10434  sub assignrole {
                              my %domdefaults = &get_domain_defaults($udom);
                              if (ref($domdefaults{'requestauthor'}) eq 'HASH') {
                                  my $checkbystatus;
                                  if ($env{'user.adv'}) {
                                      my $disposition = $domdefaults{'requestauthor'}{'_LC_adv'};
                                      if ($disposition eq 'automatic') {
                                          $refused = '';
                                      } elsif ($disposition eq '') {
                                          $checkbystatus = 1;
                                      }
                                  } else {
                                      $checkbystatus = 1;
                                  }
- Line 9073  sub assignrole {
+ Line 10528  sub assignrole {
                             $context);
          } elsif (($role eq 'ca') || ($role eq 'aa')) {
              &coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
                               $context);
          }
          if ($role eq 'cc') {
              &autoupdate_coowners($url,$end,$start,$uname,$udom);
- Line 9091  sub autoupdate_coowners {
+ Line 10546  sub autoupdate_coowners {
          if ($domdesign{$cdom.'.autoassign.co-owners'}) {
              my %coursehash = &coursedescription($cdom.'_'.$cnum);
              my $instcode = $coursehash{'internal.coursecode'};
+             my $xlists = $coursehash{'internal.crosslistings'};
              if ($instcode ne '') {
                  if (($start && $start <= $now) && ($end == 0) || ($end > $now)) {
                      unless ($coursehash{'internal.courseowner'} eq $uname.':'.$udom) {
                          my ($delcoowners,@newcoowners,$putresult,$delresult,$coowners);
                          my ($result,$desc) = &auto_validate_instcode($cnum,$cdom,$instcode,$uname.':'.$udom);
+                         unless ($result eq 'valid') {
+                             if ($xlists ne '') {
+                                 foreach my $xlist (split(',',$xlists)) {
+                                     my ($inst_crosslist,$lcsec) = split(':',$xlist);
+                                     $result =
+                                         &auto_validate_inst_crosslist($cnum,$cdom,$instcode,
+                                                                       $inst_crosslist,$uname.':'.$udom);
+                                     last if ($result eq 'valid');
+                                 }
+                             }
+                         }
                          if ($result eq 'valid') {
                              if ($coursehash{'internal.co-owners'}) {
                                  foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) {
- Line 9108  sub autoupdate_coowners {
+ Line 10575  sub autoupdate_coowners {
                              } else {
                                  push(@newcoowners,$uname.':'.$udom);
                              }
-                         } else {
+                         } elsif ($coursehash{'internal.co-owners'}) {
-                             if ($coursehash{'internal.co-owners'}) {
+                             foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) {
-                                 foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) {
+                                 unless ($coowner eq $uname.':'.$udom) {
-                                     unless ($coowner eq $uname.':'.$udom) {
+                                     push(@newcoowners,$coowner);
-                                         push(@newcoowners,$coowner);
-                                     }
-                                 }
-                                 unless (@newcoowners > 0) {
-                                     $delcoowners = 1;
-                                     $coowners = '';
                                  }
                              }
+                             unless (@newcoowners > 0) {
+                                 $delcoowners = 1;
+                                 $coowners = '';
+                             }
                          }
                          if (@newcoowners || $delcoowners) {
                              &store_coowners($cdom,$cnum,$coursehash{'home'},
- Line 9158  sub store_coowners {
+ Line 10623  sub store_coowners {
      }
      if (($putresult eq 'ok') || ($delresult eq 'ok')) {
          my %crsinfo =
-             &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,undef,undef,'.');
+             &courseiddump($cdom,'.',1,'.','.',$cnum,undef,undef,'.');
          if (ref($crsinfo{$cid}) eq 'HASH') {
              $crsinfo{$cid}{'co-owners'} = \@newcoowners;
-             my $cidput = &Apache::lonnet::courseidput($cdom,\%crsinfo,$chome,'notime');
+             my $cidput = &courseidput($cdom,\%crsinfo,$chome,'notime');
          }
      }
  }
- Line 9172  sub store_coowners {
+ Line 10637  sub store_coowners {
  sub modifyuserauth {
      my ($udom,$uname,$umode,$upass)=@_;
      my $uhome=&homeserver($uname,$udom);
-     unless (&allowed('mau',$udom)) { return 'refused'; }
+     my $allowed;
+     if (&allowed('mau',$udom)) {
+         $allowed = 1;
+     } elsif (($umode eq 'internal') && ($udom eq $env{'user.domain'}) &&
+              ($env{'request.course.id'}) && (&allowed('mip',$env{'request.course.id'})) &&
+              (!$env{'course.'.$env{'request.course.id'}.'.internal.nopasswdchg'})) {
+         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+         if (($cdom ne '') && ($cnum ne '')) {
+             my $is_owner = &is_course_owner($cdom,$cnum);
+             if ($is_owner) {
+                 $allowed = 1;
+             }
+         }
+     }
+     unless ($allowed) { return 'refused'; }
      &logthis('Call to modify user authentication '.$udom.', '.$uname.', '.
               $umode.' by '.$env{'user.name'}.' at '.$env{'user.domain'}.
               ' in domain '.$env{'request.role.domain'});
      my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'.
  		     &escape($upass),$uhome);
+     my $ip = &get_requestor_ip();
      &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},
          'Authentication changed for '.$udom.', '.$uname.', '.$umode.
-          '(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply);
+          '(Remote '.$ip.'): '.$reply);
      &log($udom,,$uname,$uhome,
          'Authentication changed by '.$env{'user.domain'}.', '.
                                       $env{'user.name'}.', '.$umode.
-          '(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply);
+          '(Remote '.$ip.'): '.$reply);
      unless ($reply eq 'ok') {
          &logthis('Authentication mode error: '.$reply);
  	return 'error: '.$reply;
- Line 9218  sub modifyuser {
+ Line 10699  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;
- Line 9263  sub modifyuser {
+ Line 10748  sub modifyuser {
                    'current user id "'.$uidhash{$uname}.'".';
            }
         } else {
- 	  &idput($udom,($uname => $uid));
+ 	  &idput($udom,{$uname => $uid},$uhome,'ids');
         }
      }
  # -------------------------------------------------------------- Add names, etc
- Line 9359  sub modifyuser {
+ Line 10844  sub modifyuser {
          return 'error: '.$reply;
      }
      if ($names{'permanentemail'} ne $oldnames{'permanentemail'}) {
-         &Apache::lonnet::devalidate_cache_new('emailscache',$uname.':'.$udom);
+         &devalidate_cache_new('emailscache',$uname.':'.$udom);
      }
      my $sqlresult = &update_allusers_table($uname,$udom,\%names);
      &devalidate_cache_new('namescache',$uname.':'.$udom);
- Line 9388  sub modifystudent {
+ Line 10873  sub modifystudent {
      # student's environment
      $uid = undef if (!$forceid);
      $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last,
- 					$gene,$usec,$end,$start,$type,$locktype,
+                                         $gene,$usec,$end,$start,$type,$locktype,
                                          $cid,$selfenroll,$context,$credits,$instsec);
      return $reply;
  }
- Line 9439  sub modify_student_enrollment {
+ Line 10924  sub modify_student_enrollment {
      }
      my $fullname = &format_name($first,$middle,$last,$gene,'lastname');
      my $user = "$uname:$udom";
-     my %old_entry = &Apache::lonnet::get('classlist',[$user],$cdom,$cnum);
+     my %old_entry = &get('classlist',[$user],$cdom,$cnum);
      my $reply=cput('classlist',
  		   {$user =>
  			join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype,$credits,$instsec) },
- Line 9509  sub writecoursepref {
+ Line 10994  sub writecoursepref {
  sub createcourse {
      my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,
-         $course_owner,$crstype,$cnum,$context,$category)=@_;
+         $course_owner,$crstype,$cnum,$context,$category,$callercontext)=@_;
      $url=&declutter($url);
      my $cid='';
      if ($context eq 'requestcourses') {
          my $can_create = 0;
          my ($ownername,$ownerdom) = split(':',$course_owner);
          if ($udom eq $ownerdom) {
-             if (&usertools_access($ownername,$ownerdom,$category,undef,
+             my $reload;
+             if (($callercontext eq 'auto') &&
+                ($ownerdom eq $env{'user.domain'}) && ($ownername eq $env{'user.name'})) {
+                 $reload = 'reload';
+             }
+             if (&usertools_access($ownername,$ownerdom,$category,$reload,
                                    $context)) {
                  $can_create = 1;
              }
- Line 9568  sub createcourse {
+ Line 11058  sub createcourse {
          }
      }
      my %host_servers =
-         &Apache::lonnet::get_servers($udom,'library');
+         &get_servers($udom,'library');
      unless ($host_servers{$course_server}) {
          return 'error: invalid home server for course: '.$course_server;
      }
- Line 9665  sub generate_coursenum {
+ Line 11155  sub generate_coursenum {
  sub is_course {
      my ($cdom, $cnum) = scalar(@_) == 1 ?
           ($_[0] =~ /^($match_domain)_($match_courseid)$/)  :  @_;
      return unless (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/));
      my $uhome=&homeserver($cnum,$cdom);
      my $iscourse;
- Line 9683  sub is_course {
+ Line 11174  sub is_course {
              &do_cache_new('iscourse',$hashid,$iscourse,3600);
          }
      }
-     return unless($iscourse);
+     return unless ($iscourse);
      return wantarray ? ($cdom, $cnum) : $cdom.'_'.$cnum;
  }
- Line 9700  sub store_userdata {
+ Line 11191  sub store_userdata {
              if (($uhome eq '') || ($uhome eq 'no_host')) {
                  $result = 'error: no_host';
              } else {
-                 $storehash->{'ip'} = $ENV{'REMOTE_ADDR'};
+                 $storehash->{'ip'} = &get_requestor_ip();
                  $storehash->{'host'} = $perlvar{'lonHostID'};
                  my $namevalue='';
- Line 9882  sub files_not_in_path {
+ Line 11373  sub files_not_in_path {
      return (@return_files);
  }
+ #------------------------------Submitted/Handedback Portfolio Files Versioning
+ sub portfiles_versioning {
+     my ($symb,$domain,$stu_name,$portfiles,$versioned_portfiles) = @_;
+     my $portfolio_root = '/userfiles/portfolio';
+     return unless ((ref($portfiles) eq 'ARRAY') && (ref($versioned_portfiles) eq 'ARRAY'));
+     foreach my $file (@{$portfiles}) {
+         &unmark_as_readonly($domain,$stu_name,[$symb,$env{'request.course.id'}],$file);
+         my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/);
+         my ($answer_name,$answer_ver,$answer_ext) = &file_name_version_ext($answer_file);
+         my $getpropath = 1;
+         my ($dir_list,$listerror) = &dirlist($portfolio_root.$directory,$domain,
+                                              $stu_name,$getpropath);
+         my $version = &get_next_version($answer_name,$answer_ext,$dir_list);
+         my $new_answer =
+             &version_selected_portfile($domain,$stu_name,$directory,$answer_file,$version);
+         if ($new_answer ne 'problem getting file') {
+             push(@{$versioned_portfiles}, $directory.$new_answer);
+             &mark_as_readonly($domain,$stu_name,[$directory.$new_answer],
+                               [$symb,$env{'request.course.id'},'graded']);
+         }
+     }
+ }
+ sub get_next_version {
+     my ($answer_name, $answer_ext, $dir_list) = @_;
+     my $version;
+     if (ref($dir_list) eq 'ARRAY') {
+         foreach my $row (@{$dir_list}) {
+             my ($file) = split(/\&/,$row,2);
+             my ($file_name,$file_version,$file_ext) =
+                 &file_name_version_ext($file);
+             if (($file_name eq $answer_name) &&
+                 ($file_ext eq $answer_ext)) {
+                      # gets here if filename and extension match,
+                      # regardless of version
+                 if ($file_version ne '') {
+                     # a versioned file is found  so save it for later
+                     if ($file_version > $version) {
+                         $version = $file_version;
+                     }
+                 }
+             }
+         }
+     }
+     $version ++;
+     return($version);
+ }
+ sub version_selected_portfile {
+     my ($domain,$stu_name,$directory,$file_name,$version) = @_;
+     my ($answer_name,$answer_ver,$answer_ext) =
+         &file_name_version_ext($file_name);
+     my $new_answer;
+     $env{'form.copy'} =
+         &getfile("/uploaded/$domain/$stu_name/portfolio$directory$file_name");
+     if($env{'form.copy'} eq '-1') {
+         $new_answer = 'problem getting file';
+     } else {
+         $new_answer = $answer_name.'.'.$version.'.'.$answer_ext;
+         my $copy_result =
+             &finishuserfileupload($stu_name,$domain,'copy',
+                                   '/portfolio'.$directory.$new_answer);
+     }
+     undef($env{'form.copy'});
+     return ($new_answer);
+ }
+ sub file_name_version_ext {
+     my ($file)=@_;
+     my @file_parts = split(/\./, $file);
+     my ($name,$version,$ext);
+     if (@file_parts > 1) {
+         $ext=pop(@file_parts);
+         if (@file_parts > 1 && $file_parts[-1] =~ /^\d+$/) {
+             $version=pop(@file_parts);
+         }
+         $name=join('.',@file_parts);
+     } else {
+         $name=join('.',@file_parts);
+     }
+     return($name,$version,$ext);
+ }
  #----------------------------------------------Get portfolio file permissions
  sub get_portfile_permissions {
- Line 10026  sub modify_access_controls {
+ Line 11601  sub modify_access_controls {
  }
  sub make_public_indefinitely {
-     my ($requrl) = @_;
+     my (@requrl) = @_;
+     return &automated_portfile_access('public',\@requrl);
+ }
+ sub automated_portfile_access {
+     my ($accesstype,$addsref,$delsref,$info) = @_;
+     unless (($accesstype eq 'public') || ($accesstype eq 'ip')) {
+         return 'invalid';
+     }
+     my %urls;
+     if (ref($addsref) eq 'ARRAY') {
+         foreach my $requrl (@{$addsref}) {
+             if (&is_portfolio_url($requrl)) {
+                 unless (exists($urls{$requrl})) {
+                     $urls{$requrl} = 'add';
+                 }
+             }
+         }
+     }
+     if (ref($delsref) eq 'ARRAY') {
+         foreach my $requrl (@{$delsref}) {
+             if (&is_portfolio_url($requrl)) {
+                 unless (exists($urls{$requrl})) {
+                     $urls{$requrl} = 'delete';
+                 }
+             }
+         }
+     }
+     unless (keys(%urls)) {
+         return 'invalid';
+     }
+     my $ip;
+     if ($accesstype eq 'ip') {
+         if (ref($info) eq 'HASH') {
+             if ($info->{'ip'} ne '') {
+                 $ip = $info->{'ip'};
+             }
+         }
+         if ($ip eq '') {
+             return 'invalid';
+         }
+     }
+     my $errors;
      my $now = time;
-     my $action = 'activate';
+     my %current_perms;
-     my $aclnum = 0;
+     foreach my $requrl (sort(keys(%urls))) {
-     if (&is_portfolio_url($requrl)) {
+         my $action;
+         if ($urls{$requrl} eq 'add') {
+             $action = 'activate';
+         } else {
+             $action = 'none';
+         }
+         my $aclnum = 0;
          my (undef,$udom,$unum,$file_name,$group) =
              &parse_portfolio_url($requrl);
-         my $current_perms = &get_portfile_permissions($udom,$unum);
+         unless (exists($current_perms{$unum.':'.$udom})) {
-         my %access_controls = &get_access_controls($current_perms,
+             $current_perms{$unum.':'.$udom} = &get_portfile_permissions($udom,$unum);
+         }
+         my %access_controls = &get_access_controls($current_perms{$unum.':'.$udom},
                                                     $group,$file_name);
          foreach my $key (keys(%{$access_controls{$file_name}})) {
              my ($num,$scope,$end,$start) =
                  ($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/);
-             if ($scope eq 'public') {
+             if ($scope eq $accesstype) {
-                 if ($start <= $now && $end == 0) {
+                 if (($start <= $now) && ($end == 0)) {
-                     $action = 'none';
+                     if ($accesstype eq 'ip') {
-                 } else {
+                         if (ref($access_controls{$file_name}{$key}) eq 'HASH') {
+                             if (ref($access_controls{$file_name}{$key}{'ip'}) eq 'ARRAY') {
+                                 if (grep(/^\Q$ip\E$/,@{$access_controls{$file_name}{$key}{'ip'}})) {
+                                     if ($urls{$requrl} eq 'add') {
+                                         $action = 'none';
+                                         last;
+                                     } else {
+                                         $action = 'delete';
+                                         $aclnum = $num;
+                                         last;
+                                     }
+                                 }
+                             }
+                         }
+                     } elsif ($accesstype eq 'public') {
+                         if ($urls{$requrl} eq 'add') {
+                             $action = 'none';
+                             last;
+                         } else {
+                             $action = 'delete';
+                             $aclnum = $num;
+                             last;
+                         }
+                     }
+                 } elsif ($accesstype eq 'public') {
                      $action = 'update';
                      $aclnum = $num;
+                     last;
                  }
-                 last;
              }
          }
          if ($action eq 'none') {
-              return 'ok';
+             next;
          } else {
              my %changes;
              my $newend = 0;
              my $newstart = $now;
-             my $newkey = $aclnum.':public_'.$newend.'_'.$newstart;
+             my $newkey = $aclnum.':'.$accesstype.'_'.$newend.'_'.$newstart;
              $changes{$action}{$newkey} = {
-                 type => 'public',
+                 type => $accesstype,
                  time => {
                      start => $newstart,
                      end   => $newend,
                  },
              };
+             if ($accesstype eq 'ip') {
+                 $changes{$action}{$newkey}{'ip'} = [$ip];
+             }
              my ($outcome,$deloutcome,$new_values,$translation) =
                  &modify_access_controls($file_name,\%changes,$udom,$unum);
-             return $outcome;
+             unless ($outcome eq 'ok') {
+                 $errors .= $outcome.' ';
+             }
          }
+     }
+     if ($errors) {
+         $errors =~ s/\s$//;
+         return $errors;
      } else {
-         return 'invalid';
+         return 'ok';
      }
  }
- Line 10273  sub dirlist {
+ Line 11931  sub dirlist {
              foreach my $user (sort(keys(%allusers))) {
                  push(@alluserslist,$user.'&user');
              }
              if (!%listerror) {
                  # no errors
                  return (\@alluserslist);
              } elsif (scalar(keys(%servers)) == 1) {
                  # one library server, one error
                  my ($key) = keys(%listerror);
                  return (\@alluserslist, $listerror{$key});
              } elsif ( grep { $_ eq 'con_lost' } values(%listerror) ) {
- Line 10286  sub dirlist {
+ Line 11945  sub dirlist {
                  return (\@alluserslist, 'con_lost');
              } else {
                  # multiple library servers and no con_lost -> data should be
                  # complete.
                  return (\@alluserslist);
              }
- Line 10362  sub stat_file {
+ Line 12021  sub stat_file {
      return ();
  }
+ # --------------------------------------------------------- recursedirs
+ # Recursive function to traverse either a specific user's Authoring Space
+ # or corresponding Published Resource Space, and populate the hash ref:
+ # $dirhashref with URLs of all directories, and if $filehashref hash
+ # ref arg is provided, the URLs of any files, excluding versioned, .meta,
+ # or .rights files in resource space, and .meta, .save, .log, .bak and
+ # .rights files in Authoring Space.
+ #
+ # Inputs:
+ #
+ # $is_home - true if current server is home server for user's space
+ # $recurse - if true will also traverse subdirectories recursively
+ # $include - reference to hash containing allowed file extensions.  If provided,
+ #             files which do not have a matching extension will be ignored.
+ # $exclude - reference to hash containing excluded file extensions.  If provided,
+ #             files which have a matching extension will be ignored.
+ # $nonemptydir - if true, will only populate $fileshashref hash entry for a particular
+ #             directory with first file found (with acceptable extension).
+ # $toppath - Top level directory (i.e., /res/$dom/$uname or /priv/$dom/$uname
+ # $relpath - Current path (relative to top level).
+ # $dirhashref - reference to hash to populate with URLs of directories (Required)
+ # $filehashref - reference to hash to populate with URLs of files (Optional)
+ #
+ # Returns: nothing
+ #
+ # Side Effects: populates $dirhashref, and $filehashref (if provided).
+ #
+ # Currently used by interface/londocs.pm to create linked select boxes for
+ # directory and filename to import a Course "Author" resource into a course, and
+ # also to create linked select boxes for Authoring Space and Directory to choose
+ # save location for creation of a new "standard" problem from the Course Editor.
+ #
+ sub recursedirs {
+     my ($is_home,$recurse,$include,$exclude,$nonemptydir,$toppath,$relpath,$dirhashref,$filehashref) = @_;
+     return unless (ref($dirhashref) eq 'HASH');
+     my $docroot = $perlvar{'lonDocRoot'};
+     my $currpath = $docroot.$toppath;
+     if ($relpath ne '') {
+         $currpath .= "/$relpath";
+     }
+     my ($savefile,$checkinc,$checkexc);
+     if (ref($filehashref)) {
+         $savefile = 1;
+     }
+     if (ref($include) eq 'HASH') {
+         $checkinc = 1;
+     }
+     if (ref($exclude) eq 'HASH') {
+         $checkexc = 1;
+     }
+     if ($is_home) {
+         if (opendir(my $dirh,$currpath)) {
+             my $filecount = 0;
+             foreach my $item (sort { lc($a) cmp lc($b) } grep(!/^\.+$/,readdir($dirh))) {
+                 next if ($item eq '');
+                 if (-d "$currpath/$item") {
+                     my $newpath;
+                     if ($relpath ne '') {
+                         $newpath = "$relpath/$item";
+                     } else {
+                         $newpath = $item;
+                     }
+                     $dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1;
+                     if ($recurse) {
+                         &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$toppath,$newpath,$dirhashref,$filehashref);
+                     }
+                 } elsif (($savefile) || ($relpath eq '')) {
+                     next if ($nonemptydir && $filecount);
+                     if ($checkinc || $checkexc) {
+                         my ($extension) = ($item =~ /\.(\w+)$/);
+                         if ($checkinc) {
+                             next unless ($extension && $include->{$extension});
+                         }
+                         if ($checkexc) {
+                             next if ($extension && $exclude->{$extension});
+                         }
+                     }
+                     if (($relpath eq '') && (!exists($dirhashref->{'/'})))  {
+                         $dirhashref->{'/'} = 1;
+                     }
+                     if ($savefile) {
+                         if ($relpath eq '') {
+                             $filehashref->{'/'}{$item} = 1;
+                         } else {
+                             $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;
+                         }
+                     }
+                     $filecount ++;
+                 }
+             }
+             closedir($dirh);
+         }
+     } else {
+         my ($dirlistref,$listerror) =
+             &dirlist($toppath.$relpath);
+         my @dir_lines;
+         my $dirptr=16384;
+         if (ref($dirlistref) eq 'ARRAY') {
+             my $filecount = 0;
+             foreach my $dir_line (sort
+                               {
+                                   my ($afile)=split('&',$a,2);
+                                   my ($bfile)=split('&',$b,2);
+                                   return (lc($afile) cmp lc($bfile));
+                               } (@{$dirlistref})) {
+                 my ($item,$dom,undef,$testdir,undef,undef,undef,undef,$size,undef,$mtime,undef,undef,undef,$obs,undef) =
+                     split(/\&/,$dir_line,16);
+                 $item =~ s/\s+$//;
+                 next if (($item =~ /^\.\.?$/) || ($obs));
+                 if ($dirptr&$testdir) {
+                     my $newpath;
+                     if ($relpath) {
+                         $newpath = "$relpath/$item";
+                     } else {
+                         $newpath = $item;
+                     }
+                     $dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1;
+                     if ($recurse) {
+                         &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$toppath,$newpath,$dirhashref,$filehashref);
+                     }
+                 } elsif (($savefile) || ($relpath eq '')) {
+                     next if ($nonemptydir && $filecount);
+                     if ($checkinc || $checkexc) {
+                         my $extension;
+                         if ($checkinc) {
+                             next unless ($extension && $include->{$extension});
+                         }
+                         if ($checkexc) {
+                             next if ($extension && $exclude->{$extension});
+                         }
+                     }
+                     if (($relpath eq '') && (!exists($dirhashref->{'/'}))) {
+                         $dirhashref->{'/'} = 1;
+                     }
+                     if ($savefile) {
+                         if ($relpath eq '') {
+                             $filehashref->{'/'}{$item} = 1;
+                         } else {
+                             $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;
+                         }
+                     }
+                     $filecount ++;
+                 }
+             }
+         }
+     }
+     return;
+ }
+ sub priv_exclude {
+     return {
+              meta => 1,
+              save => 1,
+              log => 1,
+              bak => 1,
+              rights => 1,
+              DS_Store => 1,
+            };
+ }
  # -------------------------------------------------------- Value of a Condition
  # gets the value of a specific preevaluated condition
- Line 10525  sub get_userresdata {
+ Line 12345  sub get_userresdata {
  #  Parameters:
  #     $name      - Course/user name.
  #     $domain    - Name of the domain the user/course is registered on.
- #     $type      - Type of thing $name is (must be 'course' or 'user'
+ #     $type      - Type of thing $name is (must be 'course' or 'user')
+ #     $mapp      - decluttered URL of enclosing map
+ #     $recursed  - Ref to scalar -- set to 1, if nested maps have been recursed.
+ #     $recurseup - Ref to array of map URLs, starting with map containing
+ #                  $mapp up through hierarchy of nested maps to top level map.
+ #     $courseid  - CourseID (first part of param identifier).
+ #     $modifier  - Middle part of param identifier.
+ #     $what      - Last part of param identifier.
  #     @which     - Array of names of resources desired.
  #  Returns:
  #     The value of the first reasource in @which that is found in the
- Line 10535  sub get_userresdata {
+ Line 12362  sub get_userresdata {
  #     'user', an undefined  reference is returned.
  #     If none of the resources are found, an undef is returned
  sub resdata {
-     my ($name,$domain,$type,@which)=@_;
+     my ($name,$domain,$type,$mapp,$recursed,$recurseup,$courseid,
+         $modifier,$what,@which)=@_;
      my $result;
      if ($type eq 'course') {
  	$result=&get_courseresdata($name,$domain);
- Line 10544  sub resdata {
+ Line 12372  sub resdata {
      }
      if (!ref($result)) { return $result; }
      foreach my $item (@which) {
- 	if (defined($result->{$item->[0]})) {
+         if ($item->[1] eq 'course') {
+             if ((ref($recurseup) eq 'ARRAY') && (ref($recursed) eq 'SCALAR')) {
+                 unless ($$recursed) {
+                     @{$recurseup} = &get_map_hierarchy($mapp,$courseid);
+                     $$recursed = 1;
+                 }
+                 foreach my $item (@${recurseup}) {
+                     my $norecursechk=$courseid.$modifier.$item.'___(all).'.$what;
+                     last if (defined($result->{$norecursechk}));
+                     my $recursechk=$courseid.$modifier.$item.'___(rec).'.$what;
+                     if (defined($result->{$recursechk})) { return [$result->{$recursechk},'map']; }
+                 }
+             }
+         }
+         if (defined($result->{$item->[0]})) {
  	    return [$result->{$item->[0]},$item->[1]];
  	}
      }
      return undef;
  }
- sub get_numsuppfiles {
+ sub get_domain_lti {
-     my ($cnum,$cdom,$ignorecache)=@_;
+     my ($cdom,$context) = @_;
+     my ($name,$cachename,%lti);
+     if ($context eq 'consumer') {
+         $name = 'ltitools';
+     } elsif ($context eq 'provider') {
+         $name = 'lti';
+     } elsif ($context eq 'linkprot') {
+         $name = 'ltisec';
+     } else {
+         return %lti;
+     }
+     if ($context eq 'linkprot') {
+         $cachename = $context;
+     } else {
+         $cachename = $name;
+     }
+     my ($result,$cached)=&is_cached_new($cachename,$cdom);
+     if (defined($cached)) {
+         if (ref($result) eq 'HASH') {
+             %lti = %{$result};
+         }
+     } else {
+         my %domconfig = &get_dom('configuration',[$name],$cdom);
+         if (ref($domconfig{$name}) eq 'HASH') {
+             if ($context eq 'linkprot') {
+                 if (ref($domconfig{$name}{'linkprot'}) eq 'HASH') {
+                     %lti = %{$domconfig{$name}{'linkprot'}};
+                 }
+             } else {
+                 %lti = %{$domconfig{$name}};
+             }
+             if (($context eq 'consumer') && (keys(%lti))) {
+                 my %encdomconfig = &get_dom('encconfig',[$name],$cdom,undef,1);
+                 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($cachename,$cdom,\%lti,$cachetime);
+     }
+     return %lti;
+ }
+ sub get_course_lti {
+     my ($cnum,$cdom) = @_;
+     my $hashid=$cdom.'_'.$cnum;
+     my %courselti;
+     my ($result,$cached)=&is_cached_new('courselti',$hashid);
+     if (defined($cached)) {
+         if (ref($result) eq 'HASH') {
+             %courselti = %{$result};
+         }
+     } else {
+         %courselti = &dump('lti',$cdom,$cnum,undef,undef,undef,1);
+         my $cachetime = 24*60*60;
+         &do_cache_new('courselti',$hashid,\%courselti,$cachetime);
+     }
+     return %courselti;
+ }
+ sub courselti_itemid {
+     my ($cnum,$cdom,$url,$method,$params,$context) = @_;
+     my ($chome,$itemid);
+     $chome = &homeserver($cnum,$cdom);
+     return if ($chome eq 'no_host');
+     if (ref($params) eq 'HASH') {
+         my $rep;
+         if (grep { $_ eq $chome } current_machine_ids()) {
+             $rep = LONCAPA::Lond::crslti_itemid($cdom,$cnum,$url,$method,$params,$perlvar{'lonVersion'});
+         } else {
+             my $escurl = &escape($url);
+             my $escmethod = &escape($method);
+             my $items = &freeze_escape($params);
+             $rep = &reply("encrypt:lti:$cdom:$cnum:$context:$escurl:$escmethod:$items",$chome);
+         }
+         unless (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') ||
+                 ($rep eq 'unknown_cmd')) {
+             $itemid = $rep;
+         }
+     }
+     return $itemid;
+ }
+ sub domainlti_itemid {
+     my ($cdom,$url,$method,$params,$context) = @_;
+     my ($primary_id,$itemid);
+     $primary_id = &domain($cdom,'primary');
+     return if ($primary_id eq '');
+     if (ref($params) eq 'HASH') {
+         my $rep;
+         if (grep { $_ eq $primary_id } current_machine_ids()) {
+             $rep = LONCAPA::Lond::domlti_itemid($cdom,$context,$url,$method,$params,$perlvar{'lonVersion'});
+         } else {
+             my $cnum = '';
+             my $escurl = &escape($url);
+             my $escmethod = &escape($method);
+             my $items = &freeze_escape($params);
+             $rep = &reply("encrypt:lti:$cdom:$cnum:$context:$escurl:$escmethod:$items",$primary_id);
+         }
+         unless (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') ||
+                 ($rep eq 'unknown_cmd')) {
+             $itemid = $rep;
+         }
+     }
+     return $itemid;
+ }
+ sub count_supptools {
+     my ($cnum,$cdom,$ignorecache,$reload)=@_;
+     my $hashid=$cnum.':'.$cdom;
+     my ($numexttools,$cached);
+     unless ($ignorecache) {
+         ($numexttools,$cached) = &is_cached_new('supptools',$hashid);
+     }
+     unless (defined($cached)) {
+         my $chome=&homeserver($cnum,$cdom);
+         $numexttools = 0;
+         unless ($chome eq 'no_host') {
+             my ($supplemental) = &Apache::loncommon::get_supplemental($cnum,$cdom,$reload);
+             if (ref($supplemental) eq 'HASH') {
+                 if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
+                     foreach my $key (keys(%{$supplemental->{'ids'}})) {
+                         if ($key =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
+                             $numexttools ++;
+                         }
+                     }
+                 }
+             }
+         }
+         &do_cache_new('supptools',$hashid,$numexttools,600);
+     }
+     return $numexttools;
+ }
+ sub has_unhidden_suppfiles {
+     my ($cnum,$cdom,$ignorecache,$possdel)=@_;
      my $hashid=$cnum.':'.$cdom;
-     my ($suppcount,$cached);
+     my ($showsupp,$cached);
      unless ($ignorecache) {
-         ($suppcount,$cached) = &is_cached_new('suppcount',$hashid);
+         ($showsupp,$cached) = &is_cached_new('showsupp',$hashid);
      }
      unless (defined($cached)) {
          my $chome=&homeserver($cnum,$cdom);
          unless ($chome eq 'no_host') {
-             ($suppcount,my $errors) = (0,0);
+             my ($supplemental) = &Apache::loncommon::get_supplemental($cnum,$cdom,$ignorecache,$possdel);
-             my $suppmap = 'supplemental.sequence';
+             if (ref($supplemental) eq 'HASH') {
-             ($suppcount,$errors) =
+                 if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
-                 &Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount,$errors);
+                     foreach my $key (keys(%{$supplemental->{'ids'}})) {
+                         next if ($key =~ /\.sequence$/);
+                         if (ref($supplemental->{'ids'}->{$key}) eq 'ARRAY') {
+                             foreach my $id (@{$supplemental->{'ids'}->{$key}}) {
+                                 unless ($supplemental->{'hidden'}->{$id}) {
+                                     $showsupp = 1;
+                                     last;
+                                 }
+                             }
+                         }
+                         last if ($showsupp);
+                     }
+                 }
+             }
          }
-         &do_cache_new('suppcount',$hashid,$suppcount,600);
+         &do_cache_new('showsupp',$hashid,$showsupp,600);
      }
-     return $suppcount;
+     return $showsupp;
  }
  #
  # EXT resource caching routines
  #
+ {
+ # Cache (5 seconds) of map hierarchy for speedup of navmaps display
+ #
+ # The course for which we cache
+ my $cachedmapkey='';
+ # The cached recursive maps for this course
+ my %cachedmaps=();
+ # When this was last done
+ my $cachedmaptime='';
  sub clear_EXT_cache_status {
      &delenv('cache.EXT.');
  }
- Line 10599  sub EXT_cache_set {
+ Line 12608  sub EXT_cache_set {
  # --------------------------------------------------------- Value of a Variable
  sub EXT {
-     my ($varname,$symbparm,$udom,$uname,$usection,$recurse,$cid)=@_;
+     my ($varname,$symbparm,$udom,$uname,$usection,$recurse,$cid,$recurseupref)=@_;
      unless ($varname) { return ''; }
      #get real user name/domain, courseid and symb
      my $courseid;
- Line 10631  sub EXT {
+ Line 12640  sub EXT {
  	    if ( (defined($Apache::lonhomework::parsing_a_problem)
  		  || defined($Apache::lonhomework::parsing_a_task))
  		 &&
  		 ($symbparm eq &symbread()) ) {
  		# if we are in the middle of processing the resource the
  		# get the value we are planning on committing
                  if (defined($Apache::lonhomework::results{$qualifierrest})) {
- Line 10752  sub EXT {
+ Line 12761  sub EXT {
              }
          }
- 	my ($section, $group, @groups);
+ 	my ($section, $group, @groups, @recurseup, $recursed);
- 	my ($courselevelm,$courselevel);
+         if (ref($recurseupref) eq 'ARRAY') {
+             @recurseup = @{$recurseupref};
+             $recursed = 1;
+         }
+ 	my ($courselevelm,$courseleveli,$courselevel,$mapp);
          if (($courseid eq '') && ($cid)) {
              $courseid = $cid;
          }
  	if (($symbparm && $courseid) &&
- 	    (($courseid eq $env{'request.course.id'}) || ($courseid eq $cid))) {
+ 	    (($courseid eq $env{'request.course.id'}) || ($courseid eq $cid)))  {
  	    #print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
  # ----------------------------------------------------- Cascading lookup scheme
  	    my $symbp=$symbparm;
- 	    my $mapp=&deversion((&decode_symb($symbp))[0]);
+ 	    $mapp=&deversion((&decode_symb($symbp))[0]);
  	    my $symbparm=$symbp.'.'.$spacequalifierrest;
+             my $recurseparm=$mapp.'___(rec).'.$spacequalifierrest;
  	    my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
  	    if (($env{'user.name'} eq $uname) &&
  		($env{'user.domain'} eq $udom)) {
  		$section=$env{'request.course.sec'};
- Line 10785  sub EXT {
+ Line 12797  sub EXT {
  	    my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
  	    my $seclevelr=$courseid.'.['.$section.'].'.$symbparm;
+             my $secleveli=$courseid.'.['.$section.'].'.$recurseparm;
  	    my $seclevelm=$courseid.'.['.$section.'].'.$mapparm;
  	    $courselevel=$courseid.'.'.$spacequalifierrest;
  	    my $courselevelr=$courseid.'.'.$symbparm;
+             $courseleveli=$courseid.'.'.$recurseparm;
  	    $courselevelm=$courseid.'.'.$mapparm;
  # ----------------------------------------------------------- first, check user
- 	    my $userreply=&resdata($uname,$udom,'user',
+ 	    my $userreply=&resdata($uname,$udom,'user',$mapp,\$recursed,
+                                    \@recurseup,$courseid,'.',$spacequalifierrest,
  				       ([$courselevelr,'resource'],
  					[$courselevelm,'map'     ],
+                                         [$courseleveli,'map'     ],
  					[$courselevel, 'course'  ]));
  	    if (defined($userreply)) { return &get_reply($userreply); }
- Line 10803  sub EXT {
+ Line 12819  sub EXT {
              my $coursereply;
              if (@groups > 0) {
                  $coursereply = &check_group_parms($courseid,\@groups,$symbparm,
-                                        $mapparm,$spacequalifierrest);
+                                        $recurseparm,$mapparm,$spacequalifierrest,
-                 if (defined($coursereply)) { return &get_reply($coursereply); }
+                                        $mapp,\$recursed,\@recurseup);
+                 if (defined($coursereply)) { return &get_reply($coursereply); }
              }
  	    $coursereply=&resdata($env{'course.'.$courseid.'.num'},
  				  $env{'course.'.$courseid.'.domain'},
- 				  'course',
+ 				  'course',$mapp,\$recursed,\@recurseup,
+                                   $courseid,'.['.$section.'].',$spacequalifierrest,
  				  ([$seclevelr,   'resource'],
  				   [$seclevelm,   'map'     ],
+                                    [$secleveli,   'map'     ],
  				   [$seclevel,    'course'  ],
  				   [$courselevelr,'resource']));
  	    if (defined($coursereply)) { return &get_reply($coursereply); }
- Line 10828  sub EXT {
+ Line 12847  sub EXT {
  	    if ($thisparm) { return &get_reply([$thisparm,'resource']); }
  	}
  # ------------------------------------------ fourth, look in resource metadata
- 	$spacequalifierrest=~s/\./\_/;
+         my $what = $spacequalifierrest;
+ 	$what=~s/\./\_/;
  	my $filename;
  	if (!$symbparm) { $symbparm=&symbread(); }
  	if ($symbparm) {
- Line 10837  sub EXT {
+ Line 12857  sub EXT {
  	} else {
  	    $filename=$env{'request.filename'};
  	}
- 	my $metadata=&metadata($filename,$spacequalifierrest);
+         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_'.$spacequalifierrest);
+ 	$metadata=&metadata($filename,'parameter_'.$what,$toolsymb);
  	if (defined($metadata)) { return &get_reply([$metadata,'resource']); }
- # ---------------------------------------------- fourth, look in rest of course
+ # ----------------------------------------------- fifth, look in rest of course
  	if ($symbparm && defined($courseid) &&
  	    $courseid eq $env{'request.course.id'}) {
  	    my $coursereply=&resdata($env{'course.'.$courseid.'.num'},
  				     $env{'course.'.$courseid.'.domain'},
- 				     'course',
+ 				     'course',$mapp,\$recursed,\@recurseup,
+                                      $courseid,'.',$spacequalifierrest,
  				     ([$courselevelm,'map'   ],
+                                       [$courseleveli,'map'   ],
  				      [$courselevel, 'course']));
  	    if (defined($coursereply)) { return &get_reply($coursereply); }
  	}
- Line 10863  sub EXT {
+ Line 12889  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') {
- Line 10888  sub EXT {
+ Line 12914  sub EXT {
  	if ($space eq 'name') {
  	    return $ENV{'SERVER_NAME'};
          }
+     } elsif ($realm eq 'client') {
+         if ($space eq 'remote_addr') {
+             return &get_requestor_ip();
+         }
      }
      return '';
  }
- Line 10905  sub get_reply {
+ Line 12935  sub get_reply {
  }
  sub check_group_parms {
-     my ($courseid,$groups,$symbparm,$mapparm,$what) = @_;
+     my ($courseid,$groups,$symbparm,$recurseparm,$mapparm,$what,$mapp,
-     my @groupitems = ();
+         $recursed,$recurseupref) = @_;
-     my $resultitem;
+     my @levels = ([$symbparm,'resource'],[$mapparm,'map'],[$recurseparm,'map'],
-     my @levels = ([$symbparm,'resource'],[$mapparm,'map'],[$what,'course']);
+                   [$what,'course']);
+     my $coursereply;
      foreach my $group (@{$groups}) {
+         my @groupitems = ();
          foreach my $level (@levels) {
               my $item = $courseid.'.['.$group.'].'.$level->[0];
               push(@groupitems,[$item,$level->[1]]);
          }
+         my $coursereply = &resdata($env{'course.'.$courseid.'.num'},
+                                    $env{'course.'.$courseid.'.domain'},
+                                    'course',$mapp,$recursed,$recurseupref,
+                                    $courseid,'.['.$group.'].',$what,
+                                    @groupitems);
+         last if (defined($coursereply));
      }
-     my $coursereply = &resdata($env{'course.'.$courseid.'.num'},
-                             $env{'course.'.$courseid.'.domain'},
-                                      'course',@groupitems);
      return $coursereply;
  }
+ sub get_map_hierarchy {
+     my ($mapname,$courseid) = @_;
+     my @recurseup = ();
+     if ($mapname) {
+         if (($cachedmapkey eq $courseid) &&
+             (abs($cachedmaptime-time)<5)) {
+             if (ref($cachedmaps{$mapname}) eq 'ARRAY') {
+                 return @{$cachedmaps{$mapname}};
+             }
+         }
+         my $navmap = Apache::lonnavmaps::navmap->new();
+         if (ref($navmap)) {
+             @recurseup = $navmap->recurseup_maps($mapname);
+             undef($navmap);
+             $cachedmaps{$mapname} = \@recurseup;
+             $cachedmaptime=time;
+             $cachedmapkey=$courseid;
+         }
+     }
+     return @recurseup;
+ }
+ }
  sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().
      my ($courseid,@groups) = @_;
      @groups = sort(@groups);
- Line 10928  sub sort_course_groups { # Sort groups b
+ Line 12987  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;
- Line 10999  sub add_prefix_and_part {
+ Line 13058  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)$})) ||
+ 	     ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard|ext\.tool)$})) ||
          ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {
  	return undef;
      }
- Line 11024  sub metadata {
+ Line 13084  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 @origfiletagids=();
-         my @origfileimportpartids=();
          my $importedparts=0;
+ # Imported responseids would go here
+         my $importedresponses=0;
  #
  # Is this a recursive call for a library?
  #
- Line 11123  sub metadata {
+ Line 13244  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
+ # Check metadata for imported file to
-                            $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'});
+ # see if it contained response items
-                         } elsif ($importmode eq 'part') {
+ #
+                         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
+ # Load and inspect original file if we didn't do that already
-                            if ($#origfileimportpartids<0) {
+                            if ($#origfiletagids<0) {
-                               undef(%importedpartids);
+                                undef(%importedrespids);
-                               my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);
+                                undef(%importedpartids);
-                               my $origfile=&getfile($origfilelocation);
+                                if ($origfile eq '') {
-                               @origfileimportpartids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
+                                    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);
- Line 11154  sub metadata {
+ Line 13325  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'})) {
-                            if (defined($token->[2]->{'id'})) {
+                                     $unikey.='_'.$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 {
  #
- Line 11238  sub metadata {
+ Line 13423  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};
- Line 11252  sub metadata {
+ Line 13437  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'}='';
+                 $metaentry{':partorder'}='';
-            $metathesekeys{'partorder'}=1;
+                 $metathesekeys{'partorder'}=1;
-            for (my $index=0;$index<$#origfileimportpartids;$index+=2) {
+             }
-                if ($origfileimportpartids[$index] eq 'part') {
+             if ($importedresponses) {
- # original part, part of the problem
+ # We had imported responses and need to rebuil responseorder
-                   $metaentry{':partorder'}.=','.$origfileimportpartids[$index+1];
+                 $metaentry{':responseorder'}='';
-                } else {
+                 $metathesekeys{'responseorder'}=1;
- # we have imported parts at this position
+             }
-                   $metaentry{':partorder'}.=','.$importedpartids{$origfileimportpartids[$index+1]};
+             for (my $index=0;$index<$#origfiletagids;$index+=2) {
-                }
+                 my $origid = $origfiletagids[$index+1];
-            }
+                 if ($origfiletagids[$index] eq 'part') {
-            $metaentry{':partorder'}=~s/^\,//;
+ # 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};
- Line 11427  sub get_reservable_slots {
+ Line 13643  sub get_reservable_slots {
  sub get_course_slots {
      my ($cnum,$cdom) = @_;
      my $hashid=$cnum.':'.$cdom;
-     my ($result,$cached) = &Apache::lonnet::is_cached_new('allslots',$hashid);
+     my ($result,$cached) = &is_cached_new('allslots',$hashid);
      if (defined($cached)) {
          if (ref($result) eq 'HASH') {
              return %{$result};
          }
      } else {
-         my %slots=&Apache::lonnet::dump('slots',$cdom,$cnum);
+         my %slots=&dump('slots',$cdom,$cnum);
          my ($tmp) = keys(%slots);
          if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
              &do_cache_new('allslots',$hashid,\%slots,600);
- Line 11479  sub get_coursechange {
+ Line 13695  sub get_coursechange {
  }
  sub devalidate_coursechange_cache {
-     my ($cnum,$cdom)=@_;
+     my ($cdom,$cnum)=@_;
-     my $hashid=$cnum.':'.$cdom;
+     my $hashid=$cdom.'_'.$cnum;
      &devalidate_cache_new('crschange',$hashid);
  }
+ sub get_suppchange {
+     my ($cdom,$cnum) = @_;
+     if ($cdom eq '' || $cnum eq '') {
+         return unless ($env{'request.course.id'});
+         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+     }
+     my $hashid=$cdom.'_'.$cnum;
+     my ($change,$cached)=&is_cached_new('suppchange',$hashid);
+     if ((defined($cached)) && ($change ne '')) {
+         return $change;
+     } else {
+         my %crshash = &get('environment',['internal.supplementalchange'],$cdom,$cnum);
+         if ($crshash{'internal.supplementalchange'} eq '') {
+             $change = $env{'course.'.$cdom.'_'.$cnum.'.internal.created'};
+             if ($change eq '') {
+                 %crshash = &get('environment',['internal.created'],$cdom,$cnum);
+                 $change = $crshash{'internal.created'};
+             }
+         } else {
+             $change = $crshash{'internal.supplementalchange'};
+         }
+         my $cachetime = 600;
+         &do_cache_new('suppchange',$hashid,$change,$cachetime);
+     }
+     return $change;
+ }
+ sub devalidate_suppchange_cache {
+     my ($cdom,$cnum)=@_;
+     my $hashid=$cdom.'_'.$cnum;
+     &devalidate_cache_new('suppchange',$hashid);
+ }
+ sub update_supp_caches {
+     my ($cdom,$cnum) = @_;
+     my %servers = &internet_dom_servers($cdom);
+     my @ids=&current_machine_ids();
+     foreach my $server (keys(%servers)) {
+         next if (grep(/^\Q$server\E$/,@ids));
+         my $hashid=$cnum.':'.$cdom;
+         my $cachekey = &escape('showsupp').':'.&escape($hashid);
+         &remote_devalidate_cache($server,[$cachekey]);
+     }
+     &has_unhidden_suppfiles($cnum,$cdom,1,1);
+     &count_supptools($cnum,$cdom,1);
+     my $now = time;
+     if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
+         &Apache::lonnet::appenv({'request.course.suppupdated' => $now});
+     }
+     &put('environment',{'internal.supplementalchange' => $now},
+          $cdom,$cnum);
+     &Apache::lonnet::appenv(
+         {'course.'.$cdom.'_'.$cnum.'.internal.supplementalchange' => $now});
+     &do_cache_new('suppchange',$cdom.'_'.$cnum,$now,600);
+ }
  # ------------------------------------------------- Update symbolic store links
  sub symblist {
- Line 11530  sub symbverify {
+ Line 13803  sub symbverify {
      if (tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
                              &GDBM_READER(),0640)) {
-         my $noclutter;
          if (($thisurl =~ m{^/adm/wrapper/ext/}) || ($thisurl =~ m{^ext/})) {
              $thisurl =~ s/\?.+$//;
              if ($map =~ m{^uploaded/.+\.page$}) {
                  $thisurl =~ s{^(/adm/wrapper|)/ext/}{http://};
                  $thisurl =~ s{^\Qhttp://https://\E}{https://};
-                 $noclutter = 1;
              }
          }
          my $ids;
-         if ($noclutter) {
+         if ($map =~ m{^uploaded/.+\.page$}) {
-             $ids=$bighash{'ids_'.$thisurl};
+             $ids=$bighash{'ids_'.&clutter_with_no_wrapper($thisurl)};
          } else {
              $ids=$bighash{'ids_'.&clutter($thisurl)};
          }
          unless ($ids) {
              my $idkey = 'ids_'.($thisurl =~ m{^/}? '' : '/').$thisurl;
              $ids=$bighash{$idkey};
          }
          if ($ids) {
- Line 11562  sub symbverify {
+ Line 13833  sub symbverify {
                     if (ref($encstate)) {
                         $$encstate = $bighash{'encrypted_'.$id};
                     }
-                    if (($env{'request.role.adv'}) ||
+ 		   if (($env{'request.role.adv'}) ||
-                        ($bighash{'encrypted_'.$id} eq $env{'request.enc'}) ||
+ 		       ($bighash{'encrypted_'.$id} eq $env{'request.enc'}) ||
                         ($thisurl eq '/adm/navmaps')) {
-                        $okay=1;
+ 		       $okay=1;
                         last;
-                    }
+ 		   }
-                }
+ 	       }
-            }
+ 	   }
          }
  	untie(%bighash);
      }
- Line 11641  sub deversion {
+ Line 13912  sub deversion {
  # ------------------------------------------------------ Return symb list entry
  sub symbread {
-     my ($thisfn,$donotrecurse,$ignorecachednull,$checkforblock,$possibles)=@_;
+     my ($thisfn,$donotrecurse,$ignorecachednull,$checkforblock,$possibles,
+         $ignoresymbdb,$noenccheck)=@_;
      my $cache_str='request.symbread.cached.'.$thisfn;
      if (defined($env{$cache_str})) {
-         if ($ignorecachednull) {
+         unless (ref($possibles) eq 'HASH') {
-             return $env{$cache_str} unless ($env{$cache_str} eq '');
+             if ($ignorecachednull) {
-         } else {
+                 return $env{$cache_str} unless ($env{$cache_str} eq '');
-             return $env{$cache_str};
+             } else {
+                 return $env{$cache_str};
+             }
          }
      }
  # no filename provided? try from environment
      unless ($thisfn) {
          if ($env{'request.symb'}) {
              return $env{$cache_str}=&symbclean($env{'request.symb'});
-         }
+ 	}
-         $thisfn=$env{'request.filename'};
+ 	$thisfn=$env{'request.filename'};
      }
      if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); }
  # is that filename actually a symb? Verify, clean, and return
- Line 11669  sub symbread {
+ Line 13943  sub symbread {
      my %bighash;
      my $syval='';
      if (($env{'request.course.fn'}) && ($thisfn)) {
-         my $targetfn = $thisfn;
+         unless ($ignoresymbdb) {
-         if ( ($thisfn =~ m/^(uploaded|editupload)\//) && ($thisfn !~ m/\.(page|sequence)$/) ) {
+             if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
-             $targetfn = 'adm/wrapper/'.$thisfn;
+                           &GDBM_READER(),0640)) {
-         }
+ 	        $syval=$hash{$thisfn};
- 	if ($targetfn =~ m|^adm/wrapper/(ext/.*)|) {
+                 untie(%hash);
- 	    $targetfn=$1;
+             }
- 	}
+             if ($syval && $checkforblock) {
-         if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
+                 my @blockers = &has_comm_blocking('bre',$syval,$thisfn,$ignoresymbdb,$noenccheck);
-                       &GDBM_READER(),0640)) {
+                 if (@blockers) {
- 	    $syval=$hash{$targetfn};
+                     $syval='';
-             untie(%hash);
+                 }
+             }
          }
  # ---------------------------------------------------------- There was an entry
          if ($syval) {
- Line 11712  sub symbread {
+ Line 13987  sub symbread {
  		     $syval=&encode_symb($bighash{'map_id_'.$mapid},
  						    $resid,$thisfn);
                       if (ref($possibles) eq 'HASH') {
-                          $possibles->{$syval} = 1;
+                          unless ($bighash{'randomout_'.$ids} || $env{'request.role.adv'}) {
+                              $possibles->{$syval} = 1;
+                          }
                       }
                       if ($checkforblock) {
-                          my @blockers = &has_comm_blocking('bre',$syval,$bighash{'src_'.$ids});
+                          unless ($bighash{'randomout_'.$ids} || $env{'request.role.adv'}) {
-                          if (@blockers) {
+                              my @blockers = &has_comm_blocking('bre',$syval,$bighash{'src_'.$ids},'',$noenccheck);
-                              $syval = '';
+                              if (@blockers) {
-                              return;
+                                  $syval = '';
+                                  untie(%bighash);
+                                  return $env{$cache_str}='';
+                              }
                           }
                       }
                   } elsif ((!$donotrecurse) || ($checkforblock) || (ref($possibles) eq 'HASH')) {
  # ------------------------------------------ There is more than one possibility
                       my $realpossible=0;
                       foreach my $id (@possibilities) {
- Line 11729  sub symbread {
+ Line 14009  sub symbread {
                           my $canaccess;
                           if (($donotrecurse) || ($checkforblock) || (ref($possibles) eq 'HASH')) {
                               $canaccess = 1;
                           } else {
                               $canaccess = &allowed('bre',$file);
                           }
                           if ($canaccess) {
           		     my ($mapid,$resid)=split(/\./,$id);
                               if ($bighash{'map_type_'.$mapid} ne 'page') {
                                   my $poss_syval=&encode_symb($bighash{'map_id_'.$mapid},
-                                                              $resid,$thisfn);
+ 						             $resid,$thisfn);
-                                  if (ref($possibles) eq 'HASH') {
+                                  next if ($bighash{'randomout_'.$id} && !$env{'request.role.adv'});
-                                      $possibles->{$syval} = 1;
+                                  next unless (($noenccheck) || ($bighash{'encrypted_'.$id} eq $env{'request.enc'}));
-                                  }
                                   if ($checkforblock) {
-                                      my @blockers = &has_comm_blocking('bre',$poss_syval,$file);
+                                      my @blockers = &has_comm_blocking('bre',$poss_syval,$file,'',$noenccheck);
-                                      unless (@blockers > 0) {
+                                      if (@blockers > 0) {
+                                          $syval = '';
+                                      } else {
                                           $syval = $poss_syval;
                                           $realpossible++;
                                       }
- Line 11750  sub symbread {
+ Line 14031  sub symbread {
                                       $syval = $poss_syval;
                                       $realpossible++;
                                   }
+                                  if ($syval) {
+                                      if (ref($possibles) eq 'HASH') {
+                                          $possibles->{$syval} = 1;
+                                      }
+                                  }
                               }
  			 }
                       }
- Line 11911  sub rndseed {
+ Line 14197  sub rndseed {
  	$which =&get_rand_alg($courseid);
      }
      if (defined(&getCODE())) {
  	if ($which eq '64bit5') {
  	    return &rndseed_CODE_64bit5($symb,$courseid,$domain,$username);
  	} elsif ($which eq '64bit4') {
- Line 12096  sub rndseed_CODE_64bit5 {
+ Line 14383  sub rndseed_CODE_64bit5 {
  sub setup_random_from_rndseed {
      my ($rndseed)=@_;
      if ($rndseed =~/([,:])/) {
- 	my ($num1,$num2) = map { abs($_); } (split(/[,:]/,$rndseed));
+         my ($num1,$num2) = map { abs($_); } (split(/[,:]/,$rndseed));
          if ((!$num1) || (!$num2) || ($num1 > 2147483562) || ($num2 > 2147483398)) {
              &Math::Random::random_set_seed_from_phrase($rndseed);
          } else {
- Line 12280  sub repcopy_userfile {
+ Line 14567  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);
+     $request=new HTTP::Request('GET',$protocol.'://'.$hostname.'/raw/'.$uri);
-     my $response=$ua->request($request,$transferfile);
+     my $response = &LONCAPA::LWPReq::makerequest($homeserver,$request,$transferfile,\%perlvar,'',0,1);
  # did it work?
      if ($response->is_error()) {
  	unlink($transferfile);
- Line 12313  sub tokenwrapper {
+ Line 14600  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 {
- Line 12331  sub getuploaded {
+ Line 14619  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;
+     $uri = $protocol.'://'.$hostname.'/raw/'.$uri;
-     my $ua=new LWP::UserAgent;
      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';
- Line 12466  sub machine_ids {
+ Line 14754  sub machine_ids {
  sub additional_machine_domains {
      my @domains;
-     open(my $fh,"<","$perlvar{'lonTabDir'}/expected_domains.tab");
+     if (-e "$perlvar{'lonTabDir'}/expected_domains.tab") {
-     while( my $line = <$fh>) {
+         if (open(my $fh,"<","$perlvar{'lonTabDir'}/expected_domains.tab")) {
-         $line =~ s/\s//g;
+             while (my $line = <$fh>) {
-         push(@domains,$line);
+                 chomp($line);
+                 $line =~ s/\s//g;
+                 push(@domains,$line);
+             }
+             close($fh);
+         }
      }
      return @domains;
  }
- Line 12487  sub default_login_domain {
+ Line 14780  sub default_login_domain {
      return $domain;
  }
+ sub shared_institution {
+     my ($dom,$lonhost) = @_;
+     if ($lonhost eq '') {
+         $lonhost = $perlvar{'lonHostID'};
+     }
+     my $same_intdom;
+     my $hostintdom = &internet_dom($lonhost);
+     if ($hostintdom ne '') {
+         my %iphost = &get_iphost();
+         my $primary_id = &domain($dom,'primary');
+         my $primary_ip = &get_host_ip($primary_id);
+         if (ref($iphost{$primary_ip}) eq 'ARRAY') {
+             foreach my $id (@{$iphost{$primary_ip}}) {
+                 my $intdom = &internet_dom($id);
+                 if ($intdom eq $hostintdom) {
+                     $same_intdom = 1;
+                     last;
+                 }
+             }
+         }
+     }
+     return $same_intdom;
+ }
+ 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;
+ }
+ sub waf_allssl {
+     my ($host_name) = @_;
+     my $alias = &get_proxy_alias();
+     if ($host_name eq '') {
+         $host_name = $ENV{'SERVER_NAME'};
+     }
+     if (($host_name ne '') && ($alias eq $host_name)) {
+         my $serverhomedom = &host_domain($perlvar{'lonHostID'});
+         my %defdomdefaults = &get_domain_defaults($serverhomedom);
+         if ($defdomdefaults{'waf_sslopt'}) {
+             return $defdomdefaults{'waf_sslopt'};
+         }
+     }
+     return;
+ }
+ sub get_requestor_ip {
+     my ($r,$nolookup,$noproxy) = @_;
+     my $from_ip;
+     if (ref($r)) {
+         if ($r->can('useragent_ip')) {
+             if ($noproxy && $r->can('client_ip')) {
+                 $from_ip = $r->client_ip();
+             } else {
+                 $from_ip = $r->useragent_ip();
+             }
+         } elsif ($r->connection->can('remote_ip')) {
+             $from_ip = $r->connection->remote_ip();
+         } else {
+             $from_ip = $r->get_remote_host($nolookup);
+         }
+     } else {
+         $from_ip = $ENV{'REMOTE_ADDR'};
+     }
+     return $from_ip if ($noproxy);
+     # Who controls proxy settings for server
+     my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
+     my $proxyinfo = &get_proxy_settings($dom_in_use);
+     if ((ref($proxyinfo) eq 'HASH') && ($from_ip)) {
+         if ($proxyinfo->{'vpnint'}) {
+             if (&ip_match($from_ip,$proxyinfo->{'vpnint'})) {
+                 return $from_ip;
+             }
+         }
+         if ($proxyinfo->{'trusted'}) {
+             if (&ip_match($from_ip,$proxyinfo->{'trusted'})) {
+                 my $ipheader = $proxyinfo->{'ipheader'};
+                 my ($ip,$xfor);
+                 if (ref($r)) {
+                     if ($ipheader) {
+                         $ip = $r->headers_in->{$ipheader};
+                     }
+                     $xfor = $r->headers_in->{'X-Forwarded-For'};
+                 } else {
+                     if ($ipheader) {
+                         $ip = $ENV{'HTTP_'.uc($ipheader)};
+                     }
+                     $xfor = $ENV{'HTTP_X_FORWARDED_FOR'};
+                 }
+                 if (($ip eq '') && ($xfor ne '')) {
+                     foreach my $poss_ip (reverse(split(/\s*,\s*/,$xfor))) {
+                         unless (&ip_match($poss_ip,$proxyinfo->{'trusted'})) {
+                             $ip = $poss_ip;
+                             last;
+                         }
+                     }
+                 }
+                 if ($ip ne '') {
+                     return $ip;
+                 }
+             }
+         }
+     }
+     return $from_ip;
+ }
+ sub get_proxy_settings {
+     my ($dom_in_use) = @_;
+     my %domdefaults = &get_domain_defaults($dom_in_use);
+     my $proxyinfo = {
+                        ipheader => $domdefaults{'waf_ipheader'},
+                        trusted  => $domdefaults{'waf_trusted'},
+                        vpnint   => $domdefaults{'waf_vpnint'},
+                        vpnext   => $domdefaults{'waf_vpnext'},
+                        sslopt   => $domdefaults{'waf_sslopt'},
+                     };
+     return $proxyinfo;
+ }
+ sub ip_match {
+     my ($ip,$pattern_str) = @_;
+     $ip=Net::CIDR::cidrvalidate($ip);
+     if ($ip) {
+         return Net::CIDR::cidrlookup($ip,split(/\s*,\s*/,$pattern_str));
+     }
+     return;
+ }
+ sub get_proxy_alias {
+     my ($lonid) = @_;
+     if ($lonid eq '') {
+         $lonid = $perlvar{'lonHostID'};
+     }
+     if (!defined(&hostname($lonid))) {
+         return;
+     }
+     if ($lonid ne '') {
+         my ($alias,$cached) = &is_cached_new('proxyalias',$lonid);
+         if ($cached) {
+             return $alias;
+         }
+         my $dom = &host_domain($lonid);
+         if ($dom ne '') {
+             my $cachetime = 60*60*24;
+             my %domconfig =
+                 &get_dom('configuration',['wafproxy'],$dom);
+             if (ref($domconfig{'wafproxy'}) eq 'HASH') {
+                 if (ref($domconfig{'wafproxy'}{'alias'}) eq 'HASH') {
+                     $alias = $domconfig{'wafproxy'}{'alias'}{$lonid};
+                 }
+             }
+             return &do_cache_new('proxyalias',$lonid,$alias,$cachetime);
+         }
+     }
+     return;
+ }
+ sub use_proxy_alias {
+     my ($r,$lonid) = @_;
+     my $alias = &get_proxy_alias($lonid);
+     if ($alias) {
+         my $dom = &host_domain($lonid);
+         if ($dom ne '') {
+             my $proxyinfo = &get_proxy_settings($dom);
+             my ($vpnint,$remote_ip);
+             if (ref($proxyinfo) eq 'HASH') {
+                 $vpnint = $proxyinfo->{'vpnint'};
+                 if ($vpnint) {
+                     $remote_ip = &get_requestor_ip($r,1,1);
+                 }
+             }
+             unless ($vpnint && &ip_match($remote_ip,$vpnint)) {
+                 return $alias;
+             }
+         }
+     }
+     return;
+ }
+ sub alias_sso {
+     my ($lonid) = @_;
+     if ($lonid eq '') {
+         $lonid = $perlvar{'lonHostID'};
+     }
+     if (!defined(&hostname($lonid))) {
+         return;
+     }
+     if ($lonid ne '') {
+         my ($use_alias,$cached) = &is_cached_new('proxysaml',$lonid);
+         if ($cached) {
+             return $use_alias;
+         }
+         my $dom = &host_domain($lonid);
+         if ($dom ne '') {
+             my $cachetime = 60*60*24;
+             my %domconfig =
+                 &get_dom('configuration',['wafproxy'],$dom);
+             if (ref($domconfig{'wafproxy'}) eq 'HASH') {
+                 if (ref($domconfig{'wafproxy'}{'saml'}) eq 'HASH') {
+                     $use_alias = $domconfig{'wafproxy'}{'saml'}{$lonid};
+                 }
+             }
+             return &do_cache_new('proxysaml',$lonid,$use_alias,$cachetime);
+         }
+     }
+     return;
+ }
+ sub get_saml_landing {
+     my ($lonid) = @_;
+     if ($lonid eq '') {
+         my $defdom = &default_login_domain();
+         my @hosts = &current_machine_ids();
+         if (@hosts > 1) {
+             foreach my $hostid (@hosts) {
+                 if (&host_domain($hostid) eq $defdom) {
+                     $lonid = $hostid;
+                     last;
+                 }
+             }
+         } else {
+             $lonid = $perlvar{'lonHostID'};
+         }
+         if ($lonid) {
+             unless (&host_domain($lonid) eq $defdom) {
+                 return;
+             }
+         } else {
+             return;
+         }
+     } elsif (!defined(&hostname($lonid))) {
+         return;
+     }
+     my ($landing,$cached) = &is_cached_new('samllanding',$lonid);
+     if ($cached) {
+         return $landing;
+     }
+     my $dom = &host_domain($lonid);
+     if ($dom ne '') {
+         my $cachetime = 60*60*24;
+         my %domconfig =
+             &get_dom('configuration',['login'],$dom);
+         if (ref($domconfig{'login'}) eq 'HASH') {
+             if (ref($domconfig{'login'}{'saml'}) eq 'HASH') {
+                 if (ref($domconfig{'login'}{'saml'}{$lonid}) eq 'HASH') {
+                     $landing = 1;
+                 }
+             }
+         }
+         return &do_cache_new('samllanding',$lonid,$landing,$cachetime);
+     }
+     return;
+ }
  # ------------------------------------------------------------- Declutters URLs
  sub declutter {
- Line 12537  sub clutter {
+ Line 15116  sub clutter {
  #		&logthis("Got a blank emb style");
  	    }
  	}
+     } elsif ($thisfn =~ m{^/adm/$match_domain/$match_courseid/\d+/ext\.tool$}) {
+         $thisfn='/adm/wrapper'.$thisfn;
      }
      return $thisfn;
  }
- Line 12602  sub get_dns {
+ Line 15183  sub get_dns {
      my ($url,$func,$ignore_cache,$nocache,$hashref) = @_;
      if (!$ignore_cache) {
  	my ($content,$cached)=
- 	    &Apache::lonnet::is_cached_new('dns',$url);
+ 	    &is_cached_new('dns',$url);
  	if ($cached) {
  	    &$func($content,$hashref);
  	    return;
- Line 12624  sub get_dns {
+ Line 15205  sub get_dns {
      }
      while (%alldns) {
  	my ($dns) = sort { $b cmp $a } keys(%alldns);
- 	my $ua=new LWP::UserAgent;
+         my ($contents,@content);
-         $ua->timeout(30);
+         if ($dns eq Sys::Hostname::FQDN::fqdn()) {
- 	my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url");
+             my $command = (split('/',$url))[3];
- 	my $response=$ua->request($request);
+             my ($dir,$file) = &parse_getdns_url($command,$url);
-         delete($alldns{$dns});
+             delete($alldns{$dns});
- 	next if ($response->is_error());
+             next if (($dir eq '') || ($file eq ''));
- 	my @content = split("\n",$response->content);
+             if (open(my $config,'<',"$dir/$file")) {
-         unless ($nocache) {
+                 @content = <$config>;
- 	    &do_cache_new('dns',$url,\@content,30*24*60*60);
+                 close($config);
+             }
+             if ($url eq '/adm/dns/loncapaCRL') {
+                 $contents = join('',@content);
+             }
+         } else {
+ 	    my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url");
+             my $response = &LONCAPA::LWPReq::makerequest('',$request,'',\%perlvar,30,0);
+             delete($alldns{$dns});
+ 	    next if ($response->is_error());
+             if ($url eq '/adm/dns/loncapaCRL') {
+                 $contents = $response->content;
+             } else {
+                 @content = split("\n",$response->content);
+             }
+         }
+         if ($url eq '/adm/dns/loncapaCRL') {
+             return &$func($contents);
+         } else {
+ 	    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);
          }
- 	&$func(\@content,$hashref);
- 	return;
      }
-     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;
  }
- Line 12650  sub get_dns {
+ Line 15262  sub get_dns {
  sub parse_dns_checksums_tab {
      my ($lines,$hashref) = @_;
      my $lonhost = $perlvar{'lonHostID'};
-     my $machine_dom = &Apache::lonnet::host_domain($lonhost);
+     my $machine_dom = &host_domain($lonhost);
      my $loncaparev = &get_server_loncaparev($machine_dom);
      my $distro = (split(/\:/,&get_server_distarch($lonhost)))[0];
      my $webconfdir = '/etc/httpd/conf';
- Line 12670  sub parse_dns_checksums_tab {
+ Line 15282  sub parse_dns_checksums_tab {
      if (ref($lines) eq 'ARRAY') {
          chomp(@{$lines});
          my $version = shift(@{$lines});
          if ($version eq $release) {
              foreach my $line (@{$lines}) {
                  my ($file,$version,$shasum) = split(/,/,$line);
                  if ($file =~ m{^/etc/httpd/conf}) {
- Line 12694  sub parse_dns_checksums_tab {
+ Line 15306  sub parse_dns_checksums_tab {
  sub fetch_dns_checksums {
      my %checksums;
-     my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});
+     my $machine_dom = &host_domain($perlvar{'lonHostID'});
      my $loncaparev = &get_server_loncaparev($machine_dom,$perlvar{'lonHostID'});
      my ($release,$timestamp) = split(/\-/,$loncaparev);
      &get_dns("/adm/dns/checksums/$release",\&parse_dns_checksums_tab,1,1,
- Line 12702  sub fetch_dns_checksums {
+ Line 15314  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 ($content) = @_;
+     my ($msg,$hadchanges);
+     if ($content ne '') {
+         my $now = time;
+         my $lonca = $perlvar{'lonCertificateDirectory'}.'/'.$perlvar{'lonnetCertificateAuthority'};
+         my $tmpcrl = $tmpdir.'/'.$perlvar{'lonnetCertRevocationList'}.'_'.$now.'.'.$$.'.tmp';
+         if (open(my $fh,'>',"$tmpcrl")) {
+             print $fh $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);
+ }
+ sub parse_getdns_url {
+     my ($command,$url) = @_;
+     my $dir = $perlvar{'lonTabDir'};
+     my $file;
+     if ($command eq 'hosts') {
+         $file = 'dns_hosts.tab';
+     } elsif ($command eq 'domain') {
+         $file = 'dns_domain.tab';
+     } elsif ($command eq 'checksums') {
+         my $version = (split('/',$url))[4];
+         $file = "dns_checksums/$version.tab",
+     } elsif ($command eq 'loncapaCRL') {
+         $dir = $perlvar{'lonCertificateDirectory'};
+         $file = $perlvar{'lonnetCertRevocationList'};
+     }
+     return ($dir,$file);
+ }
  # ------------------------------------------------------------ Read domain file
  {
      my $loaded;
- Line 12824  sub fetch_dns_checksums {
+ Line 15527  sub fetch_dns_checksums {
  	&purge_remembered();
  	&reset_domain_info();
  	&reset_hosts_ip_info();
+         undef(%internetdom);
  	undef(%name_to_host);
  	undef(%hostname);
  	undef(%hostdom);
- Line 12866  sub fetch_dns_checksums {
+ Line 15570  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);
- Line 12985  sub fetch_dns_checksums {
+ Line 15694  sub fetch_dns_checksums {
  		return %iphost;
  	    }
  	    my ($ip_info,$cached)=
- 		&Apache::lonnet::is_cached_new('iphost','iphost');
+ 		&is_cached_new('iphost','iphost');
  	    if ($cached) {
  		%iphost      = %{$ip_info->[0]};
  		%name_to_ip  = %{$ip_info->[1]};
- Line 12997  sub fetch_dns_checksums {
+ Line 15706  sub fetch_dns_checksums {
  	# get yesterday's info for fallback
  	my %old_name_to_ip;
  	my ($ip_info,$cached)=
- 	    &Apache::lonnet::is_cached_new('iphost','iphost');
+ 	    &is_cached_new('iphost','iphost');
  	if ($cached) {
  	    %old_name_to_ip = %{$ip_info->[1]};
  	}
- Line 13064  sub fetch_dns_checksums {
+ Line 15773  sub fetch_dns_checksums {
          my ($lonid) = @_;
          return if ($lonid eq '');
          my ($idnref,$cached)=
-             &Apache::lonnet::is_cached_new('internetnames',$lonid);
+             &is_cached_new('internetnames',$lonid);
          if ($cached) {
              return $idnref;
          }
- Line 13096  sub all_loncaparevs {
+ Line 15805  sub all_loncaparevs {
      return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10 2.11);
  }
- # ------------------------------------------------------- Read loncaparev table
+ # ---------------------------------------------------------- Read loncaparev table
  {
      sub load_loncaparevs {
          if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") {
              if (open(my $config,"<","$perlvar{'lonTabDir'}/loncaparevs.tab")) {
                  while (my $configline=<$config>) {
- Line 13112  sub all_loncaparevs {
+ Line 15821  sub all_loncaparevs {
      }
  }
- # ----------------------------------------------------- Read serverhostID table
+ # ---------------------------------------------------------- Read serverhostID table
  {
      sub load_serverhomeIDs {
          if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") {
- Line 13204  BEGIN {
+ Line 15913  BEGIN {
      close($config);
  }
- # --------------------------------------------------------- Read loncaparev table
+ # ---------------------------------------------------------- Read loncaparev table
  &load_loncaparevs();
- # ------------------------------------------------------- Read serverhostID table
+ # ---------------------------------------------------------- Read serverhostID table
  &load_serverhomeIDs();
- Line 13222  BEGIN {
+ Line 15931  BEGIN {
                  my $item = $token->[1];
                  my $name = $token->[2]{'name'};
                  my $value = $token->[2]{'value'};
-                 if ($item ne '' && $name ne '' && $value ne '') {
+                 my $valuematch = $token->[2]{'valuematch'};
+                 my $namematch = $token->[2]{'namematch'};
+                 if ($item eq 'parameter') {
+                     if (($namematch ne '') || (($name ne '') && ($value ne '' || $valuematch ne ''))) {
+                         my $release = $parser->get_text();
+                         $release =~ s/(^\s*|\s*$ )//gx;
+                         $needsrelease{$item.':'.$name.':'.$value.':'.$valuematch.':'.$namematch} = $release;
+                     }
+                 } elsif ($item ne '' && $name ne '') {
                      my $release = $parser->get_text();
                      $release =~ s/(^\s*|\s*$ )//gx;
                      $needsrelease{$item.':'.$name.':'.$value} = $release;
- Line 13254  BEGIN {
+ Line 15971  BEGIN {
  }
+ # ------------- set default texengine (domain default overrides this)
+ {
+     $deftex = LONCAPA::texengine();
+ }
+ # ------------- set default minimum length for passwords for internal auth users
+ {
+     $passwdmin = LONCAPA::passwd_min();
+ }
  $memcache=new Cache::Memcached({'servers'           => ['127.0.0.1:11211'],
  				'compress_threshold'=> 20_000,
   			        });
- Line 13495  the answer, and also caches if there is
+ Line 16222  the answer, and also caches if there is
  =item *
  X<idget()>
- B<idget($udom,@ids)>: find the usernames behind a list of IDs
+ B<idget($udom,$idsref,$namespace)>: find the usernames behind either
- (IDs are a unique resource in a domain, there must be only 1 ID per
+ a list of student/employee IDs or clicker IDs
- username, and only 1 username per ID in a specific domain) (returns
+ (student/employee IDs are a unique resource in a domain, there must be
- hash: id=>name,id=>name)
+ only 1 ID per username, and only 1 username per ID in a specific domain).
+ clickerIDs are not necessarily unique, as students might share clickers.
+ (returns hash: id=>name,id=>name)
  =item *
  X<idrget()>
- Line 13507  usernames (returns hash: name=>id,name=>
+ Line 16236  usernames (returns hash: name=>id,name=>
  =item *
  X<idput()>
- B<idput($udom,%ids)>: store away a list of names and associated IDs
+ B<idput($udom,$idsref,$uhome,$namespace)>: store away a list of
+ names and associated student/employee IDs or clicker IDs.
+ =item *
+ X<iddel()>
+ B<iddel($udom,$idshashref,$uhome,$namespace)>: delete unwanted
+ student/employee ID or clicker ID username look-ups from domain.
+ The homeserver ($uhome) and namespace ($namespace) are optional.
+ If no $uhome is provided, it will be determined usig &homeserver()
+ for each user.  If no $namespace is provided, the default is ids.
+ =item *
+ X<updateclickers()>
+ B<updateclickers($udom,$action,$idshashref,$uhome,$critical)>: update
+ clicker ID-to-username look-ups in clickers.db on library server.
+ Permitted actions are add or del (i.e., add or delete). The
+ clickers.db contains clickerID as keys (escaped), and each corresponding
+ value is an escaped comma-separated list of usernames (for whom the
+ library server is the homeserver), who registered that particular ID.
+ If $critical is true, the update will be sent via &critical, otherwise
+ &reply() will be used.
  =item *
  X<rolesinit()>
- Line 13555  The first argument is required, all othe
+ Line 16304  The first argument is required, all othe
  $priv is the privilege being checked.
  $uri contains additional information about what is being checked for access (e.g.,
  URL, course ID etc.).
  $symb is the unique resource instance identifier in a course; if needed,
  but not provided, it will be retrieved via a call to &symbread().
  $role is the role for which a priv is being checked (only used if priv is evb).
  $clientip is the user's IP address (only used when checking for access to portfolio
  files).
  $noblockcheck, if true, skips calls to &has_comm_blocking() for the bre priv. This
  prevents recursive calls to &allowed.
   F: full access
- Line 13571  prevents recursive calls to &allowed.
+ Line 16320  prevents recursive calls to &allowed.
 : browse allowed
   A: passphrase authentication needed
   B: access temporarily blocked because of a blocking event in a course.
+  D: access blocked because access is required via session initiated via deep-link
  =item *
- Line 13623  provided for types, will default to retu
+ Line 16373  provided for types, will default to retu
  =item *
  in_course($udom,$uname,$cdom,$cnum,$type,$hideprivileged) : determine if
  user: $uname:$udom has a role in the course: $cdom_$cnum.
  Additional optional arguments are: $type (if role checking is to be restricted
  to certain user status types -- previous (expired roles), active (currently
  available roles) or future (roles available in the future), and
  $hideprivileged -- if true will not report course roles for users who
- Line 13863  data base, returning a hash that is keye
+ Line 16613  data base, returning a hash that is keye
  values that are the resource value.  I believe that the timestamps and
  versions are also returned.
- get_numsuppfiles($cnum,$cdom) : retrieve number of files in a course's
- supplemental content area. This routine caches the number of files for
-minutes.
  =back
  =head2 Course Modification
- Line 13901  Returns:
+ Line 16647  Returns:
  =back
+ =head2 Bubblesheet Configuration
+ =over 4
+ =item *
+ get_scantron_config($which)
+ $which - the name of the configuration to parse from the file.
+ Parses and returns the bubblesheet configuration line selected as a
+ hash of configuration file fields.
+ Returns:
+     If the named configuration is not in the file, an empty
+     hash is returned.
+     a hash with the fields
+       name         - internal name for the this configuration setup
+       description  - text to display to operator that describes this config
+       CODElocation - if 0 or the string 'none'
+                           - no CODE exists for this config
+                      if -1 || the string 'letter'
+                           - a CODE exists for this config and is
+                             a string of letters
+                      Unsupported value (but planned for future support)
+                           if a positive integer
+                                - The CODE exists as the first n items from
+                                  the question section of the form
+                           if the string 'number'
+                                - The CODE exists for this config and is
+                                  a string of numbers
+       CODEstart   - (only matter if a CODE exists) column in the line where
+                      the CODE starts
+       CODElength  - length of the CODE
+       IDstart     - column where the student/employee ID starts
+       IDlength    - length of the student/employee ID info
+       Qstart      - column where the information from the bubbled
+                     'questions' start
+       Qlength     - number of columns comprising a single bubble line from
+                     the sheet. (usually either 1 or 10)
+       Qon         - either a single character representing the character used
+                     to signal a bubble was chosen in the positional setup, or
+                     the string 'letter' if the letter of the chosen bubble is
+                     in the final, or 'number' if a number representing the
+                     chosen bubble is in the file (1->A 0->J)
+       Qoff        - the character used to represent that a bubble was
+                     left blank
+       PaperID     - if the scanning process generates a unique number for each
+                     sheet scanned the column that this ID number starts in
+       PaperIDlength - number of columns that comprise the unique ID number
+                       for the sheet of paper
+       FirstName   - column that the first name starts in
+       FirstNameLength - number of columns that the first name spans
+       LastName    - column that the last name starts in
+       LastNameLength - number of columns that the last name spans
+       BubblesPerRow - number of bubbles available in each row used to
+                       bubble an answer. (If not specified, 10 assumed).
+ =item *
+ get_scantronformat_file($cdom)
+ $cdom - the course's domain (optional); if not supplied, uses
+ domain for current $env{'request.course.id'}.
+ Returns an array containing lines from the scantron format file for
+ the domain of the course.
+ If a url for a custom.tab file is listed in domain's configuration.db,
+ lines are from this file.
+ Otherwise, if a default.tab has been published in RES space by the
+ domainconfig user, lines are from this file.
+ Otherwise, fall back to getting lines from the legacy file on the
+ local server:  /home/httpd/lonTabs/default_scantronformat.tab
+ =back
  =head2 Resource Subroutines
  =over 4
- Line 13952  condval($condidx) : value of condition i
+ Line 16780  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 *
- Line 13967  will be stored for query
+ Line 16801  will be stored for query
  =item *
  symbread($filename,$donotrecurse,$ignorecachednull,$checkforblock,$possibles) :
  return symbolic list entry (all arguments optional).
  Args: filename is the filename (including path) for the file for which a symb
  is required; donotrecurse, if true will prevent calls to allowed() being made
  to check access status if more than one resource was found in the bighash
  (see rev. 1.249) to avoid an infinite loop if an ambiguous resource is part of
  a randompick); ignorecachednull, if true will prevent a symb of '' being
  returned if $env{$cache_str} is defined as ''; checkforblock if true will
  cause possible symbs to be checked to determine if they are subject to content
  blocking, if so they will not be included as possible symbs; possibles is a
  ref to a hash, which, as a side effect, will be populated with all possible
  symbs (content blocking not tested).
  returns the data handle
  =item *
- Line 13990  and is a possible symb for the URL in $t
+ Line 16824  and is a possible symb for the URL in $t
  resource that the user accessed using /enc/ returns a 1 on success, 0
  on failure, user must be in a course, as it assumes the existence of
  the course initial hash, and uses $env('request.course.id'}.  The third
  arg is an optional reference to a scalar.  If this arg is passed in the
  call to symbverify, it will be set to 1 if the symb has been set to be
  encrypted; otherwise it will be null.
  =item *
- Line 14045  expirespread($uname,$udom,$stype,$usymb)
+ Line 16879  expirespread($uname,$udom,$stype,$usymb)
  devalidate($symb) : devalidate temporary spreadsheet calculations,
  forcing spreadsheet to reevaluate the resource scores next time.
  =item *
  can_edit_resource($file,$cnum,$cdom,$resurl,$symb,$group) : determine if current user can edit a particular resource,
  when viewing in course context.
   input: six args -- filename (decluttered), course number, course domain,
                      url, symb (if registered) and group (if this is a
                      group item -- e.g., bulletin board, group page etc.).
   output: array of five scalars --
- Line 14059  when viewing in course context.
+ Line 16893  when viewing in course context.
           $home -- homeserver of resource (i.e., for author if published,
                                            or course if uploaded.).
           $switchserver --  1 if server switch will be needed.
           $forceedit -- 1 if icon/link should be to go to edit mode
           $forceview -- 1 if icon/link should be to go to view mode
  =item *
  is_course_upload($file,$cnum,$cdom)
  Used in course context to determine if current file was uploaded to
  the course (i.e., would be found in /userfiles/docs on the course's
  homeserver.
    input: 3 args -- filename (decluttered), course number and course domain.
- Line 14081  homeserver.
+ Line 16915  homeserver.
  =item *
  store($storehash,$symb,$namespace,$udom,$uname,$laststore) : stores hash
  permanently for this url; hashref needs to be given and should be a \%hashname;
  the remaining args aren't required and if they aren't passed or are '' they will
  be derived from the env (with the exception of $laststore, which is an
  optional arg used when a user's submission is stored in grading).
  $laststore is $version=$timestamp, where $version is the most recent version
  number retrieved for the corresponding $symb in the $namespace db file, and
  $timestamp is the timestamp for that transaction (UNIX time).
  $laststore is currently only passed when cstore() is called by
  structuretags::finalize_storage().
  =item *
  cstore($storehash,$symb,$namespace,$udom,$uname,$laststore) : same as store
  but uses critical subroutine
  =item *
- Line 14232  server ($udom and $uhome are optional)
+ Line 17066  server ($udom and $uhome are optional)
  =item *
  get_domain_defaults($target_domain,$ignore_cache) : returns hash with defaults
  for: authentication, language, quotas, timezone, date locale, and portal URL in
  the target domain.
- Line 14266  requestcourses: ability to request cours
+ Line 17100  requestcourses: ability to request cours
  =over
  =item
- official, unofficial, community, textbook
+ official, unofficial, community, textbook, placement
  =back
- Line 14287  for course's uploaded content.
+ Line 17121  for course's uploaded content.
  =over
  =item
  canuse_pdfforms, officialcredits, unofficialcredits, textbookcredits, officialquota, unofficialquota,
- communityquota, textbookquota
+ communityquota, textbookquota, placementquota
  =back
- Line 14298  on your servers.
+ Line 17132  on your servers.
  =over
  =item
  remotesessions, hostedsessions
  =back
- Line 14306  remotesessions, hostedsessions
+ Line 17140  remotesessions, hostedsessions
  =back
  In cases where a domain coordinator has never used the "Set Domain Configuration"
  utility to create a configuration.db file on a domain's primary library server
  only the following domain defaults: auth_def, auth_arg_def, lang_def
  -- corresponding values are authentication type (internal, krb4, krb5,
  or localauth), initial password or a kerberos realm, language (e.g., en-us) --
  will be available. Values are retrieved from cache (if current), unless the
  optional $ignore_cache arg is true, or from domain's configuration.db (if available),
  or lastly from values in lonTabs/dns_domain,tab, or lonTabs/domain.tab.
- Line 14592  userspace, probably shouldn't be called
+ Line 17426  userspace, probably shouldn't be called
    formname: same as for userfileupload()
    fname: filename (including subdirectories) for the file
    parser: if 'parse', will parse (html) file to extract references to objects, links etc.
+           if hashref, and context is scantron, will convert csv format to standard format
    allfiles: reference to hash used to store objects found by parser
    codebase: reference to hash used for codebases of java objects found by parser
    thumbwidth: width (pixels) of thumbnail to be created for uploaded image
- Line 14737  Returns:
+ Line 17572  Returns:
  get_timebased_id():
  Attempts to get a unique timestamp-based suffix for use with items added to a
  course via the Course Editor (e.g., folders, composite pages,
  group bulletin boards).
  Args: (first three required; six others optional)
- Line 14749  Args: (first three required; six others
+ Line 17584  Args: (first three required; six others
 . keyid (alphanumeric): name of temporary locking key in hash,
     e.g., num, boardids
 . namespace: name of gdbm file used to store suffixes already assigned;
     file will be named nohist_namespace.db
 . cdom: domain of course; default is current course domain from %env
 . cnum: course number; default is current course number from %env
 . idtype: set to concat if an additional digit is to be appended to the
     unix timestamp to form the suffix, if the plain timestamp is already
     in use.  Default is to not do this, but simply increment the unix
     timestamp by 1 until a unique key is obtained.
 . who: holder of locking key; defaults to user:domain for user.
 . locktries: number of attempts to obtain a lock (sleep of 1s before
     retrying); default is 3.
 . maxtries: number of attempts to obtain a unique suffix; default is 20.
  Returns:

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.1172.2.96
changed lines
	Added in v.1.1503