--- loncom/lonnet/perl/lonnet.pm	2016/09/21 04:47:57	1.1322
+++ loncom/lonnet/perl/lonnet.pm	2016/11/13 22:07:55	1.1329
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1322 2016/09/21 04:47:57 raeburn Exp $
+# $Id: lonnet.pm,v 1.1329 2016/11/13 22:07:55 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -237,7 +237,9 @@ sub get_servercerts_info {
     }
     if (($context ne 'cgi') && ($uselocal)) {
         my $distro = (split(/\:/,&get_server_distarch($lonhost)))[0];
-        if ($distro =~ /^(?:centos|redhat|scientific)(\d+)$/) {
+        if ($distro eq '') {
+            $uselocal = 0;
+        } elsif ($distro =~ /^(?:centos|redhat|scientific)(\d+)$/) {
             if ($1 < 6) {
                 $uselocal = 0;
             }
@@ -4106,7 +4108,7 @@ sub flushcourselogs {
         }
     }
 #
-# Reverse lookup of domain roles (dc, ad, li, sc, au)
+# Reverse lookup of domain roles (dc, ad, li, sc, dh, au)
 #
     my %domrolebuffer = ();
     foreach my $entry (keys(%domainrolehash)) {
@@ -4121,10 +4123,19 @@ sub flushcourselogs {
         delete $domainrolehash{$entry};
     }
     foreach my $dom (keys(%domrolebuffer)) {
-	my %servers = &get_servers($dom,'library');
+	my %servers;
+	if (defined(&domain($dom,'primary'))) {
+	    my $primary=&domain($dom,'primary');
+	    my $hostname=&hostname($primary);
+	    $servers{$primary} = $hostname;
+	} else { 
+	    %servers = &get_servers($dom,'library');
+	}
 	foreach my $tryserver (keys(%servers)) {
-	    unless (&reply('domroleput:'.$dom.':'.
-			   $domrolebuffer{$dom},$tryserver) eq 'ok') {
+	    if (&reply('domroleput:'.$dom.':'.
+		       $domrolebuffer{$dom},$tryserver) eq 'ok') {
+		last;
+	    } else {  
 		&logthis('Put of domain roles failed for '.$dom.' and  '.$tryserver);
 	    }
         }
@@ -4244,7 +4255,7 @@ sub userrolelog {
          {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}
                     =$tend.':'.$tstart;
     }
-    if ($trole =~ /^(dc|ad|li|au|dg|sc)/ ) {
+    if ($trole =~ /^(dc|ad|li|au|dg|sc|dh)/ ) {
        my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
        $domainrolehash
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
@@ -5823,14 +5834,17 @@ sub delete_env_groupprivs {
 }
 
 sub check_adhoc_privs {
-    my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller) = @_;
+    my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller,$sec) = @_;
     my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
+    if ($sec) {
+        $cckey .= '/'.$sec;
+    } 
     my $setprivs;
     if ($env{$cckey}) {
         my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
         &role_status($cckey,$update,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
         unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
-            &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);
+            &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller,$sec);
             $setprivs = 1;
         }
     } else {
@@ -5841,15 +5855,22 @@ sub check_adhoc_privs {
 }
 
 sub set_adhoc_privileges {
-# role can be cc or ca
-    my ($dcdom,$pickedcourse,$role,$caller) = @_;
+# role can be cc, ca, or cr/<dom>/<dom>-domainconfig/role
+    my ($dcdom,$pickedcourse,$role,$caller,$sec) = @_;
     my $area = '/'.$dcdom.'/'.$pickedcourse;
+    if ($sec ne '') {
+        $area .= '/'.$sec;
+    }
     my $spec = $role.'.'.$area;
     my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'},
                                   $env{'user.name'},1);
-    my %ccrole = ();
-    &standard_roleprivs(\%ccrole,$role,$dcdom,$spec,$pickedcourse,$area);
-    my ($author,$adv)= &set_userprivs(\%userroles,\%ccrole);
+    my %rolehash = ();
+    if ($role =~ m{^cr/$dcdom/$dcdom\Q-domainconfig\E/}) {
+        &custom_roleprivs(\%rolehash,$role,$dcdom,$pickedcourse,$spec,$area);
+    } else {
+        &standard_roleprivs(\%rolehash,$role,$dcdom,$spec,$pickedcourse,$area);
+    }
+    my ($author,$adv)= &set_userprivs(\%userroles,\%rolehash);
     &appenv(\%userroles,[$role,'cm']);
     &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
     unless ($caller eq 'constructaccess' && $env{'request.course.id'}) {
@@ -6239,9 +6260,11 @@ sub tmpget {
     if (!defined($server)) { $server = $perlvar{'lonHostID'}; }
     my $rep=&reply("tmpget:$token",$server);
     my %returnhash;
+    if ($rep =~ /^(con_lost|error|no_such_host)/i) {
+        return %returnhash;
+    }
     foreach my $item (split(/\&/,$rep)) {
 	my ($key,$value)=split(/=/,$item);
-        next if ($key =~ /^error: 2 /);
 	$returnhash{&unescape($key)}=&thaw_unescape($value);
     }
     return %returnhash;
@@ -7425,7 +7448,7 @@ sub constructaccess {
     my ($ownername,$ownerdomain,$ownerhome);
 
     ($ownerdomain,$ownername) =
-        ($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)(?:/daxepage|/daxeopen)?/priv/($match_domain)/($match_username)/});
+        ($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)(?:/daxepage|/daxeopen)?/priv/($match_domain)/($match_username)(?:/|$)});
 
 # The URL does not really point to any authorspace, forget it
     unless (($ownername) && ($ownerdomain)) { return ''; }
@@ -7773,7 +7796,7 @@ sub get_symb_from_alias {
 
 sub definerole {
   if (allowed('mcr','/')) {
-    my ($rolename,$sysrole,$domrole,$courole)=@_;
+    my ($rolename,$sysrole,$domrole,$courole,$uname,$udom)=@_;
     foreach my $role (split(':',$sysrole)) {
 	my ($crole,$cqual)=split(/\&/,$role);
         if ($pr{'cr:s'}!~/\Q$crole\E/) { return "refused:s:$crole"; }
@@ -7801,11 +7824,19 @@ sub definerole {
             }
         }
     }
+    my $uhome;
+    if (($uname ne '') && ($udom ne '')) {
+        $uhome = &homeserver($uname,$udom);
+        return $uhome if ($uhome eq 'no_host');
+    } else {
+        $uname = $env{'user.name'};
+        $udom = $env{'user.domain'};
+        $uhome = $env{'user.home'};
+    }
     my $command="encrypt:rolesput:$env{'user.domain'}:$env{'user.name'}:".
-                "$env{'user.domain'}:$env{'user.name'}:".
-	        "rolesdef_$rolename=".
+                "$udom:$uname:rolesdef_$rolename=".
                 escape($sysrole.'_'.$domrole.'_'.$courole);
-    return reply($command,$env{'user.home'});
+    return reply($command,$uhome);
   } else {
     return 'refused';
   }
@@ -8854,7 +8885,7 @@ sub assignrole {
             &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
                            $selfenroll,$context);
         } elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') ||
-                 ($role eq 'au') || ($role eq 'dc')) {
+                 ($role eq 'au') || ($role eq 'dc') || ($role eq 'dh')) {
             &domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
                            $context);
         } elsif (($role eq 'ca') || ($role eq 'aa')) {
@@ -13745,9 +13776,10 @@ in which case the null string is returne
 
 =item *
 
-definerole($rolename,$sysrole,$domrole,$courole) : define role; define a custom
-role rolename set privileges in format of lonTabs/roles.tab for system, domain,
-and course level
+definerole($rolename,$sysrole,$domrole,$courole,$uname,$udom) : define role;
+define a custom role rolename set privileges in format of lonTabs/roles.tab
+for system, domain, and course level. $uname and $udom are optional (current
+user's username and domain will be used when either of $uname or $udom are absent.
 
 =item *