--- loncom/lond	2010/05/23 10:45:46	1.442
+++ loncom/lond	2011/09/02 13:10:38	1.446.2.2
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.442 2010/05/23 10:45:46 www Exp $
+# $Id: lond,v 1.446.2.2 2011/09/02 13:10:38 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -58,7 +58,7 @@ my $DEBUG = 0;		       # Non zero to ena
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.442 $'; #' stupid emacs
+my $VERSION='$Revision: 1.446.2.2 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -2197,7 +2197,9 @@ sub fetch_user_file_handler {
 
 	my $destname=$udir.'/'.$ufile;
 	my $transname=$udir.'/'.$ufile.'.in.transit';
-	my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
+        my $clientprotocol=$Apache::lonnet::protocol{$clientname};
+        $clientprotocol = 'http' if ($clientprotocol ne 'https');
+        my $remoteurl=$clientprotocol.'://'.$clientip.'/userfiles/'.$fname;
 	my $response;
 	Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname");
 	alarm(120);
@@ -3127,11 +3129,16 @@ sub dump_with_regexp {
 	my $count=0;
 	while (my ($key,$value) = each(%$hashref)) {
             if ($namespace eq 'roles') {
-                if ($key =~ /^($LONCAPA::match_domain)_($LONCAPA::match_community)_(cc|co|in|ta|ep|ad|st|cr)/) {
-                    if ($clientversion =~ /^(\d+)\.(\d+)$/) {
+                if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_community)_(cc|co|in|ta|ep|ad|st|cr)}) {
+                    my $cdom = $1;
+                    my $cnum = $2;
+                    if ($clientversion =~ /^['"]?(\d+)\.(\d+)[.\d\-]+['"]?$/) {
                         my $major = $1;
                         my $minor = $2;
                         next if (($major < 2) || (($major == 2) && ($minor < 9)));
+                    } else {
+                        my $homeserver = &Apache::lonnet::homeserver($cnum,$cdom);
+                        next unless ($currenthostid eq $homeserver);
                     }
                 }
             }
@@ -3728,6 +3735,9 @@ sub put_course_id_hash_handler {
 #                 createdafter - include courses for which creation date followed this date.
 #                 creationcontext - include courses created in specified context 
 #
+#                 domcloner - flag to indicate if user can create CCs in course's domain.
+#                             If so, ability to clone course is automatic. 
+#
 #     $client  - The socket open on the client.
 # Returns:
 #    1     - Continue processing.
@@ -3740,7 +3750,7 @@ sub dump_course_id_handler {
     my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
         $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
         $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,
-        $creationcontext) =split(/:/,$tail);
+        $creationcontext,$domcloner) =split(/:/,$tail);
     my $now = time;
     my ($cloneruname,$clonerudom,%cc_clone);
     if (defined($description)) {
@@ -3813,7 +3823,6 @@ sub dump_course_id_handler {
     } else {
         $creationcontext = '.';
     }
-    
     my $unpack = 1;
     if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' && 
         $typefilter eq '.') {
@@ -3844,7 +3853,9 @@ sub dump_course_id_handler {
                     next if ($since > 1);
                 }
                 $is_hash =  1;
-                if (defined($clonerudom)) {
+                if ($domcloner) {
+                    $canclone = 1;
+                } elsif (defined($clonerudom)) {
                     if ($items->{'cloners'}) {
                         my @cloneable = split(',',$items->{'cloners'});
                         if (@cloneable) {
@@ -3877,7 +3888,7 @@ sub dump_course_id_handler {
                                 if ($items->{'owner'} eq $cloner) {
                                     $canclone = 1;
                                 }
-                            } elsif ($cloner eq $udom.':'.$items->{'owner'}) {
+                            } elsif ($cloner eq $items->{'owner'}.':'.$udom) {
                                 $canclone = 1;
                             }
                             if ($canclone) {
@@ -6301,6 +6312,7 @@ sub make_new_child {
             or die "Can't unblock SIGINT for fork: $!\n";
         $children{$pid} = $clientip;
         &status('Started child '.$pid);
+        close($client);
         return;
     } else {
         # Child can *not* return from this subroutine.
@@ -7029,7 +7041,9 @@ sub subscribe {
                 # the metadata
 		unless ($fname=~/\.meta$/) { &unsub("$fname.meta",$clientip); }
 		$fname=~s/\/home\/httpd\/html\/res/raw/;
-		$fname="http://".&Apache::lonnet::hostname($perlvar{'lonHostID'})."/".$fname;
+                my $protocol = $Apache::lonnet::protocol{$perlvar{'lonHostID'}};
+                $protocol = 'http' if ($protocol ne 'https');
+                $fname=$protocol.'://'.&Apache::lonnet::hostname($perlvar{'lonHostID'})."/".$fname;
 		$result="$fname\n";
 	    }
 	} else {
@@ -7187,7 +7201,7 @@ sub sethost {
 	eq &Apache::lonnet::get_host_ip($hostid)) {
 	$currenthostid  =$hostid;
 	$currentdomainid=&Apache::lonnet::host_domain($hostid);
-	&logthis("Setting hostid to $hostid, and domain to $currentdomainid");
+#	&logthis("Setting hostid to $hostid, and domain to $currentdomainid");
     } else {
 	&logthis("Requested host id $hostid not an alias of ".
 		 $perlvar{'lonHostID'}." refusing connection");