--- loncom/lonnet/perl/lonnet.pm	2019/07/23 01:30:44	1.1412
+++ loncom/lonnet/perl/lonnet.pm	2020/03/03 01:16:39	1.1419
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1412 2019/07/23 01:30:44 raeburn Exp $
+# $Id: lonnet.pm,v 1.1419 2020/03/03 01:16:39 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -79,7 +79,7 @@ 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,
@@ -2261,7 +2261,7 @@ sub inst_directory_query {
     if ($homeserver ne '') {
         unless ($homeserver eq $perlvar{'lonHostID'}) {
             if ($srch->{'srchby'} eq 'email') {
-                my $lcrev = &get_server_loncaparev(undef,$homeserver);
+                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))) {
@@ -2312,7 +2312,7 @@ sub usersearch {
         if (&host_domain($tryserver) eq $dom) {
             unless ($tryserver eq $perlvar{'lonHostID'}) {
                 if ($srch->{'srchby'} eq 'email') {
-                    my $lcrev = &get_server_loncaparev(undef,$tryserver);
+                    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)));
@@ -2682,7 +2682,7 @@ sub get_domain_defaults {
     if (ref($domconfig{'coursecategories'}) eq 'HASH') {
         $domdefaults{'catauth'} = 'std';
         $domdefaults{'catunauth'} = 'std';
-        if ($domconfig{'coursecategories'}{'auth'}) { 
+        if ($domconfig{'coursecategories'}{'auth'}) {
             $domdefaults{'catauth'} = $domconfig{'coursecategories'}{'auth'};
         }
         if ($domconfig{'coursecategories'}{'unauth'}) {
@@ -2738,7 +2738,46 @@ sub get_dom_cats {
         }
         &Apache::lonnet::do_cache_new('cats',$dom,$cats,3600);
     }
-    return $cats; 
+    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 = {
+                                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 {
@@ -3622,6 +3661,18 @@ 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'}) {
@@ -3647,13 +3698,13 @@ sub can_edit_resource {
                     $cfile = $template;
                 }
             } elsif (($resurl =~ m{^/adm/wrapper/ext/}) && ($env{'form.folderpath'} =~ /^supplemental/)) {
-                    $incourse = 1;
-                    if ($env{'form.forceedit'}) {
-                        $forceview = 1;
-                    } else {
-                        $forceedit = 1;
-                    }
-                    $cfile = $resurl;
+                $incourse = 1;
+                if ($env{'form.forceedit'}) {
+                    $forceview = 1;
+                } else {
+                    $forceedit = 1;
+                }
+                $cfile = $resurl;
             } elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) && ($env{'form.folderpath'} =~ /^supplemental/)) {
                 $incourse = 1;
                 if ($env{'form.forceedit'}) {
@@ -12241,6 +12292,10 @@ sub EXT {
 	if ($space eq 'name') {
 	    return $ENV{'SERVER_NAME'};
         }
+    } elsif ($realm eq 'client') {
+        if ($space eq 'remote_addr') {
+            return $ENV{'REMOTE_ADDR'};
+        }
     }
     return '';
 }
@@ -13069,18 +13124,16 @@ 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) {
-            $ids=$bighash{'ids_'.$thisurl};
+        if ($map =~ m{^uploaded/.+\.page$}) {
+            $ids=$bighash{'ids_'.&clutter_with_no_wrapper($thisurl)};
         } else {
             $ids=$bighash{'ids_'.&clutter($thisurl)};
         }
@@ -14028,6 +14081,27 @@ sub default_login_domain {
     return $domain;
 }
 
+sub shared_institution {
+    my ($dom) = @_;
+    my $same_intdom;
+    my $hostintdom = &internet_dom($perlvar{'lonHostID'});
+    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'};
@@ -14939,6 +15013,11 @@ BEGIN {
     $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,
  			        });