--- loncom/lonnet/perl/lonnet.pm	2002/08/08 13:42:01	1.263
+++ loncom/lonnet/perl/lonnet.pm	2002/08/17 18:23:27	1.268
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.263 2002/08/08 13:42:01 www Exp $
+# $Id: lonnet.pm,v 1.268 2002/08/17 18:23:27 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -820,7 +820,7 @@ sub flushcourselogs {
         my $entry=$_;
         $entry=~/\_\_\_(\w+)\/(\w+)\/(.*)\_\_\_(\w+)$/;
         my %temphash=($entry => $accesshash{$entry});
-        if (&Apache::lonnet::put('resevaldata',\%temphash,$1,$2) eq 'ok') {
+        if (&Apache::lonnet::put('nohist_resevaldata',\%temphash,$1,$2) eq 'ok') {
 	    delete $accesshash{$entry};
         }
     }
@@ -1000,97 +1000,195 @@ sub devalidate {
     }
 }
 
+sub get_scalar {
+    my ($string,$end) = @_;
+    my $value;
+    if ($$string =~ s/^([^&]*?)($end)/$2/) {
+	$value = $1;
+    } elsif ($$string =~ s/^([^&]*?)&//) {
+	$value = $1;
+    }
+    return &unescape($value);
+}
+
+sub array2str {
+  my (@array) = @_;
+  my $result=&arrayref2str(\@array);
+  $result=~s/^__ARRAY_REF__//;
+  $result=~s/__END_ARRAY_REF__$//;
+  return $result;
+}
+
 sub arrayref2str {
   my ($arrayref) = @_;
-  my $result='_ARRAY_REF__';
+  my $result='__ARRAY_REF__';
   foreach my $elem (@$arrayref) {
-    if (ref($elem) eq 'ARRAY') {
-      $result.=&escape(&arrayref2str($elem)).'&';
-    } elsif (ref($elem) eq 'HASH') {
-      $result.=&escape(&hashref2str($elem)).'&';
-    } elsif (ref($elem)) {
-      &logthis("Got a ref of ".(ref($elem))." skipping.");
+    if(ref($elem) eq 'ARRAY') {
+      $result.=&arrayref2str($elem).'&';
+    } elsif(ref($elem) eq 'HASH') {
+      $result.=&hashref2str($elem).'&';
+    } elsif(ref($elem)) {
+      #print("Got a ref of ".(ref($elem))." skipping.");
     } else {
       $result.=&escape($elem).'&';
     }
   }
   $result=~s/\&$//;
+  $result .= '__END_ARRAY_REF__';
   return $result;
 }
 
 sub hash2str {
   my (%hash) = @_;
   my $result=&hashref2str(\%hash);
-  $result=~s/^_HASH_REF__//;
+  $result=~s/^__HASH_REF__//;
+  $result=~s/__END_HASH_REF__$//;
   return $result;
 }
 
 sub hashref2str {
   my ($hashref)=@_;
-  my $result='_HASH_REF__';
+  my $result='__HASH_REF__';
   foreach (keys(%$hashref)) {
     if (ref($_) eq 'ARRAY') {
-      $result.=&escape(&arrayref2str($_)).'=';
+      $result.=&arrayref2str($_).'=';
     } elsif (ref($_) eq 'HASH') {
-      $result.=&escape(&hashref2str($_)).'=';
+      $result.=&hashref2str($_).'=';
     } elsif (ref($_)) {
-      &logthis("Got a ref of ".(ref($_))." skipping.");
+      $result.='=';
+      #print("Got a ref of ".(ref($_))." skipping.");
     } else {
-      $result.=&escape($_).'=';
+	if ($_) {$result.=&escape($_).'=';} else { last; }
     }
 
-    if (ref($$hashref{$_}) eq 'ARRAY') {
-      $result.=&escape(&arrayref2str($$hashref{$_})).'&';
-    } elsif (ref($$hashref{$_}) eq 'HASH') {
-      $result.=&escape(&hashref2str($$hashref{$_})).'&';
-    } elsif (ref($$hashref{$_})) {
-      &logthis("Got a ref of ".(ref($$hashref{$_}))." skipping.");
+    if(ref($hashref->{$_}) eq 'ARRAY') {
+      $result.=&arrayref2str($hashref->{$_}).'&';
+    } elsif(ref($hashref->{$_}) eq 'HASH') {
+      $result.=&hashref2str($hashref->{$_}).'&';
+    } elsif(ref($hashref->{$_})) {
+       $result.='&';
+      #print("Got a ref of ".(ref($hashref->{$_}))." skipping.");
     } else {
-      $result.=&escape($$hashref{$_}).'&';
+      $result.=&escape($hashref->{$_}).'&';
     }
   }
   $result=~s/\&$//;
+  $result .= '__END_HASH_REF__';
   return $result;
 }
 
 sub str2hash {
+    my ($string)=@_;
+    my ($hash)=&str2hashref('__HASH_REF__'.$string.'__END_HASH_REF__');
+    return %$hash;
+}
+
+sub str2hashref {
   my ($string) = @_;
-  my %returnhash;
-  foreach (split(/\&/,$string)) {
-    my ($name,$value)=split(/\=/,$_);
-    $name=&unescape($name);
-    $value=&unescape($value);
-    if ($value =~ /^_HASH_REF__/) {
-      $value =~ s/^_HASH_REF__//;
-      my %hash=&str2hash($value);
-      $value=\%hash;
-    } elsif ($value =~ /^_ARRAY_REF__/) {
-      $value =~ s/^_ARRAY_REF__//;
-      my @array=&str2array($value);
-      $value=\@array;
-    }
-    $returnhash{$name}=$value;
+
+  my %hash;
+
+  if($string !~ /^__HASH_REF__/) {
+      if (! ($string eq '' || !defined($string))) {
+	  $hash{'error'}='Not hash reference';
+      }
+      return (\%hash, $string);
   }
-  return (%returnhash);
+
+  $string =~ s/^__HASH_REF__//;
+
+  while($string !~ /^__END_HASH_REF__/) {
+      #key
+      my $key='';
+      if($string =~ /^__HASH_REF__/) {
+          ($key, $string)=&str2hashref($string);
+          if(defined($key->{'error'})) {
+              $hash{'error'}='Bad data';
+              return (\%hash, $string);
+          }
+      } elsif($string =~ /^__ARRAY_REF__/) {
+          ($key, $string)=&str2arrayref($string);
+          if($key->[0] eq 'Array reference error') {
+              $hash{'error'}='Bad data';
+              return (\%hash, $string);
+          }
+      } else {
+          $string =~ s/^(.*?)=//;
+	  $key=&unescape($1);
+      }
+      $string =~ s/^=//;
+
+      #value
+      my $value='';
+      if($string =~ /^__HASH_REF__/) {
+          ($value, $string)=&str2hashref($string);
+          if(defined($value->{'error'})) {
+              $hash{'error'}='Bad data';
+              return (\%hash, $string);
+          }
+      } elsif($string =~ /^__ARRAY_REF__/) {
+          ($value, $string)=&str2arrayref($string);
+          if($value->[0] eq 'Array reference error') {
+              $hash{'error'}='Bad data';
+              return (\%hash, $string);
+          }
+      } else {
+	  $value=&get_scalar(\$string,'__END_HASH_REF__');
+      }
+      $string =~ s/^&//;
+
+      $hash{$key}=$value;
+  }
+
+  $string =~ s/^__END_HASH_REF__//;
+
+  return (\%hash, $string);
 }
 
 sub str2array {
+    my ($string)=@_;
+    my ($array)=&str2arrayref('__ARRAY_REF__'.$string.'__END_ARRAY_REF__');
+    return @$array;
+}
+
+sub str2arrayref {
   my ($string) = @_;
-  my @returnarray;
-  foreach my $value (split(/\&/,$string)) {
-    $value=&unescape($value);
-    if ($value =~ /^_HASH_REF__/) {
-      $value =~ s/^_HASH_REF__//;
-      my %hash=&str2hash($value);
-      $value=\%hash;
-    } elsif ($value =~ /^_ARRAY_REF__/) {
-      $value =~ s/^_ARRAY_REF__//;
-      my @array=&str2array($value);
-      $value=\@array;
-    }
-    push(@returnarray,$value);
+  my @array;
+
+  if($string !~ /^__ARRAY_REF__/) {
+      if (! ($string eq '' || !defined($string))) {
+	  $array[0]='Array reference error';
+      }
+      return (\@array, $string);
+  }
+
+  $string =~ s/^__ARRAY_REF__//;
+
+  while($string !~ /^__END_ARRAY_REF__/) {
+      my $value='';
+      if($string =~ /^__HASH_REF__/) {
+          ($value, $string)=&str2hashref($string);
+          if(defined($value->{'error'})) {
+              $array[0] ='Array reference error';
+              return (\@array, $string);
+          }
+      } elsif($string =~ /^__ARRAY_REF__/) {
+          ($value, $string)=&str2arrayref($string);
+          if($value->[0] eq 'Array reference error') {
+              $array[0] ='Array reference error';
+              return (\@array, $string);
+          }
+      } else {
+	  $value=&get_scalar(\$string,'__END_ARRAY_REF__');
+      }
+      $string =~ s/^&//;
+
+      push(@array, $value);
   }
-  return (@returnarray);
+
+  $string =~ s/^__END_ARRAY_REF__//;
+
+  return (\@array, $string);
 }
 
 # -------------------------------------------------------------------Temp Store
@@ -1602,6 +1700,13 @@ sub allowed {
             return 'F';
         }
     }
+    # Domain coordinator is trying to create a course
+    if (($priv eq 'ccc') && ($ENV{'request.role'} =~ /^dc\./)) {
+        # uri is the requested domain in this case.
+        # comparison to 'request.role.domain' shows if the user has selected
+        # a role of dc for the domain in question. 
+        return 'F' if ($uri eq $ENV{'request.role.domain'});
+    }
 
     my $thisallowed='';
     my $statecond=0;
@@ -2188,13 +2293,10 @@ sub writecoursepref {
 # ---------------------------------------------------------- Make/modify course
 
 sub createcourse {
-    my ($udom,$description,$url)=@_;
+    my ($udom,$description,$url,$course_server)=@_;
     $url=&declutter($url);
     my $cid='';
-    unless (&allowed('ccc',$ENV{'user.domain'})) {
-        return 'refused';
-    }
-    unless ($udom eq $ENV{'user.domain'}) {
+    unless (&allowed('ccc',$udom)) {
         return 'refused';
     }
 # ------------------------------------------------------------------- Create ID
@@ -2210,9 +2312,14 @@ sub createcourse {
            return 'error: unable to generate unique course-ID';
        } 
    }
+# ------------------------------------------------ Check supplied server name
+    $course_server = $ENV{'user.homeserver'} if (! defined($course_server));
+    if (! exists($libserv{$course_server})) {
+        return 'error:bad server name '.$course_server;
+    }
 # ------------------------------------------------------------- Make the course
     my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::',
-                      $ENV{'user.home'});
+                      $course_server);
     unless ($reply eq 'ok') { return 'error: '.$reply; }
     $uhome=&homeserver($uname,$udom,'true');
     if (($uhome eq '') || ($uhome eq 'no_host')) { 
@@ -3028,6 +3135,14 @@ sub declutter {
     return $thisfn;
 }
 
+# ------------------------------------------------------------- Clutter up URLs
+
+sub clutter {
+    my $thisfn='/'.&declutter(shift);
+    unless ($thisfn=~/^\/(uploaded|adm)\//) { $thisfn='/res'.$thisfn; }
+    return $thisfn;
+}
+
 # -------------------------------------------------------- Escape Special Chars
 
 sub escape {