--- loncom/auth/loncacc.pm	2011/10/30 20:31:02	1.57
+++ loncom/auth/loncacc.pm	2011/11/12 18:48:41	1.58
@@ -2,7 +2,7 @@
 # Cookie Based Access Handler for Construction Area
 # (lonacc: 5/21/99,5/22,5/29,5/31 Gerd Kortemeyer)
 #
-# $Id: loncacc.pm,v 1.57 2011/10/30 20:31:02 raeburn Exp $
+# $Id: loncacc.pm,v 1.58 2011/11/12 18:48:41 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -79,8 +79,15 @@ store where they wanted to go (first url
 
 See if the owner domain and name
 in the URL match those in the expected environment.  If so, return 
-two element list ($ownername,$ownerdomain).  Else, return null string.
-If 'setpriv' is set to 'setpriv', it actually assigns the privileges.
+three element list ($ownername,$ownerdomain,$ownerhome).  
+
+Otherwise return the null string.
+
+If second argument 'setpriv' is true, it assigns the privileges,
+and returns the same three element list, unless the owner has
+blocked "ad hoc" Domain Coordinator access to the Author Space,
+in which case the null string is returned.
+
 =back
 
 =cut
@@ -104,24 +111,29 @@ sub constructaccess {
 
 # Get username and domain from URL
     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
-    my ($ownerdomain,$ownername)=($url=~ m{^(?:\Q$londocroot\E|)/priv/($match_domain)/($match_username)/});
+    my ($ownername,$ownerdomain,$ownerhome);
+
+    ($ownerdomain,$ownername) = 
+        ($url=~ m{^(?:\Q$londocroot\E|)/priv/($match_domain)/($match_username)/});
 
 # The URL does not really point to any authorspace, forget it
     unless (($ownername) && ($ownerdomain)) { return ''; }
-  
+
 # Now we need to see if the user has access to the authorspace of
 # $ownername at $ownerdomain
 
     if (($ownername eq $env{'user.name'}) && ($ownerdomain eq $env{'user.domain'})) {
 # Real author for this?
+       $ownerhome = $env{'user.home'};
        if (exists($env{'user.priv.au./'.$ownerdomain.'/./'})) {
-          return ($ownername,$ownerdomain);
+          return ($ownername,$ownerdomain,$ownerhome);
        }
     } else {
 # Co-author for this?
 	if (exists($env{'user.priv.ca./'.$ownerdomain.'/'.$ownername.'./'}) ||
 	    exists($env{'user.priv.aa./'.$ownerdomain.'/'.$ownername.'./'}) ) {
-	    return ($ownername,$ownerdomain);
+	    $ownerhome = &Apache::lonnet::homeserver($ownername,$ownerdomain);
+	    return ($ownername,$ownerdomain,$ownerhome);
 	}
     }
 # We don't have any access right now. If we are not possibly going to do anything about this,
@@ -150,7 +162,8 @@ sub constructaccess {
         &Apache::lonnet::check_adhoc_privs($ownerdomain,$ownername,
                                            $update,$refresh,$now,'ca',
                                            'constructaccess');
-        return($ownername,$ownerdomain);
+        $ownerhome = &Apache::lonnet::homeserver($ownername,$ownerdomain);
+        return($ownername,$ownerdomain,$ownerhome);
     }
 # No business here
     return '';
@@ -177,7 +190,18 @@ sub handler {
 	$env{'request.state'}    = "construct";
 	$env{'request.filename'} = $r->filename;
 
-	unless (&constructaccess($requrl,'setpriv')) {
+	my $allowed;
+	my ($ownername,$ownerdom,$ownerhome) = &constructaccess($requrl,'setpriv');
+        if (($ownername ne '') && ($ownerdom ne '') && ($ownerhome ne '')) {
+            unless ($ownerhome eq 'no_host') {
+                my @hosts = &Apache::lonnet::current_machine_domains();
+                if (grep(/^\Q$ownerhome\E$/,@hosts)) {
+                    $allowed = 1;
+                }
+            }
+        }
+
+        unless ($allowed) {
 	    $r->log_reason("Unauthorized $requrl", $r->filename); 
 	    return HTTP_NOT_ACCEPTABLE;
 	}
@@ -187,7 +211,7 @@ sub handler {
 	&Apache::lonacc::get_posted_cgi($r);
 
 	return OK; 
-    } else { 
+    } else {
 	$r->log_reason("Cookie $handle not valid", $r->filename) 
     }
 
@@ -200,10 +224,3 @@ sub handler {
 1;
 __END__
 
-
-
-
-
-
-
-