--- loncom/lonnet/perl/lonnet.pm	2016/09/21 05:15:40	1.1324
+++ loncom/lonnet/perl/lonnet.pm	2016/11/15 20:46:35	1.1330
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1324 2016/09/21 05:15:40 raeburn Exp $
+# $Id: lonnet.pm,v 1.1330 2016/11/15 20:46:35 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -4108,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)) {
@@ -4255,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}
@@ -5834,33 +5834,43 @@ sub delete_env_groupprivs {
 }
 
 sub check_adhoc_privs {
-    my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller) = @_;
+    my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller,$sec) = @_;
     my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
+    if ($sec) {
+        $cckey .= '/'.$sec;
+    } 
     my $setprivs;
     if ($env{$cckey}) {
         my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
         &role_status($cckey,$update,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
         unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
-            &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);
+            &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller,$sec);
             $setprivs = 1;
         }
     } else {
-        &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);
+        &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller,$sec);
         $setprivs = 1;
     }
     return $setprivs;
 }
 
 sub set_adhoc_privileges {
-# role can be cc or ca
-    my ($dcdom,$pickedcourse,$role,$caller) = @_;
+# role can be cc, ca, or cr/<dom>/<dom>-domainconfig/role
+    my ($dcdom,$pickedcourse,$role,$caller,$sec) = @_;
     my $area = '/'.$dcdom.'/'.$pickedcourse;
+    if ($sec ne '') {
+        $area .= '/'.$sec;
+    }
     my $spec = $role.'.'.$area;
     my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'},
                                   $env{'user.name'},1);
-    my %ccrole = ();
-    &standard_roleprivs(\%ccrole,$role,$dcdom,$spec,$pickedcourse,$area);
-    my ($author,$adv)= &set_userprivs(\%userroles,\%ccrole);
+    my %rolehash = ();
+    if ($role =~ m{^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'}) {
@@ -6250,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;
@@ -7436,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 ''; }
@@ -7784,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"; }
@@ -7812,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';
   }
@@ -8865,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')) {
@@ -13756,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 *