--- loncom/lonnet/perl/lonnet.pm	2007/04/12 00:03:08	1.870
+++ loncom/lonnet/perl/lonnet.pm	2007/05/17 09:25:31	1.878
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.870 2007/04/12 00:03:08 albertel Exp $
+# $Id: lonnet.pm,v 1.878 2007/05/17 09:25:31 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -33,12 +33,13 @@ use strict;
 use LWP::UserAgent();
 use HTTP::Date;
 # use Date::Parse;
-use vars 
-qw(%perlvar %badServerCache %spareid 
-   %pr %prp $memcache %packagetab 
-   %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount 
-   %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf
-   $tmpdir $_64bit %env);
+use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
+            $_64bit %env);
+
+my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,
+    %userrolehash, $processmarker, $dumpcount, %coursedombuf,
+    %coursenumbuf, %coursehombuf, %coursedescrbuf, %courseinstcodebuf,
+    %courseownerbuf, %coursetypebuf);
 
 use IO::Socket;
 use GDBM_File;
@@ -743,7 +744,7 @@ sub get_dom {
         if (defined(&domain($udom,'primary'))) {
             $uhome=&domain($udom,'primary');
         } else {
-            $uhome eq '';
+            undef($uhome);
         }
     } else {
         if (!$uhome) {
@@ -755,14 +756,13 @@ sub get_dom {
     if ($udom && $uhome && ($uhome ne 'no_host')) {
         my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
         my %returnhash;
-        if ($rep =~ /^error: 2 /) {
+        if ($rep eq '' || $rep =~ /^error: 2 /) {
             return %returnhash;
         }
         my @pairs=split(/\&/,$rep);
         if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) {
             return @pairs;
         }
-        my %returnhash=();
         my $i=0;
         foreach my $item (@$storearr) {
             $returnhash{$item}=&thaw_unescape($pairs[$i]);
@@ -783,7 +783,7 @@ sub put_dom {
         if (defined(&domain($udom,'primary'))) {
             $uhome=&domain($udom,'primary');
         } else {
-            $uhome eq '';
+            undef($uhome);
         }
     } else {
         if (!$uhome) {
@@ -1064,7 +1064,10 @@ my $kicks=0;
 my $hits=0;
 sub make_key {
     my ($name,$id) = @_;
-    if (length($id) > 200) { $id=length($id).':'.&Digest::MD5::md5_hex($id); }
+    if (length($id) > 65 
+	&& length(&escape($id)) > 200) {
+	$id=length($id).':'.&Digest::MD5::md5_hex($id);
+    }
     return &escape($name.':'.$id);
 }
 
@@ -1111,7 +1114,9 @@ sub do_cache_new {
 	$time=600;
     }
     if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }
-    $memcache->set($id,$setvalue,$time);
+    if (!($memcache->set($id,$setvalue,$time))) {
+	&logthis("caching of id -> $id  failed");
+    }
     # need to make a copy of $value
     #&make_room($id,$value,$debug);
     return $value;
@@ -4449,8 +4454,18 @@ sub userlog_query {
 
 sub auto_run {
     my ($cnum,$cdom) = @_;
-    my $homeserver = &homeserver($cnum,$cdom);
-    my $response = &reply('autorun:'.$cdom,$homeserver);
+    my $response = 0;
+    my $settings;
+    my %domconfig = &get_dom('configuration',['autoenroll'],$cdom);
+    if (ref($domconfig{'autoenroll'}) eq 'HASH') {
+        $settings = $domconfig{'autoenroll'};
+        if ($settings->{'run'} eq '1') {
+            $response = 1;
+        }
+    } else {
+        my $homeserver = &homeserver($cnum,$cdom);
+        $response = &reply('autorun:'.$cdom,$homeserver);
+    }
     return $response;
 }
 
@@ -4480,15 +4495,27 @@ sub auto_validate_courseID {
 }
 
 sub auto_create_password {
-    my ($cnum,$cdom,$authparam) = @_;
-    my $homeserver = &homeserver($cnum,$cdom); 
+    my ($cnum,$cdom,$authparam,$udom) = @_;
+    my ($homeserver,$response);
     my $create_passwd = 0;
     my $authchk = '';
-    my $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver));
-    if ($response eq 'refused') {
-        $authchk = 'refused';
+    if ($udom =~ /^$match_domain$/) {
+        $homeserver = &domain($udom,'primary');
+    }
+    if ($homeserver eq '') {
+        if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) {
+            $homeserver = &homeserver($cnum,$cdom);
+        }
+    }
+    if ($homeserver eq '') {
+        $authchk = 'nodomain';
     } else {
-        ($authparam,$create_passwd,$authchk) = split/:/,$response;
+        $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver));
+        if ($response eq 'refused') {
+            $authchk = 'refused';
+        } else {
+            ($authparam,$create_passwd,$authchk) = split/:/,$response;
+        }
     }
     return ($authparam,$create_passwd,$authchk);
 }
@@ -5293,7 +5320,7 @@ sub save_selected_files {
     my ($user, $path, @files) = @_;
     my $filename = $user."savedfiles";
     my @other_files = &files_not_in_path($user, $path);
-    open (OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);
+    open (OUT, '>'.$tmpdir.$filename);
     foreach my $file (@files) {
         print (OUT $env{'form.currentpath'}.$file."\n");
     }
@@ -5885,6 +5912,13 @@ sub devalidatecourseresdata {
 
 
 # --------------------------------------------------- Course Resourcedata Query
+#
+#  Parameters:
+#      $coursenum    - Number of the course.
+#      $coursedomain - Domain at which the course was created.
+#  Returns:
+#     A hash of the course parameters along (I think) with timestamps
+#     and version info.
 
 sub get_courseresdata {
     my ($coursenum,$coursedomain)=@_;
@@ -7709,8 +7743,9 @@ sub get_dns {
 	return;
     }
     close($config);
-    &logthis("unable to contact DNS defaulting to on disk file\n");
-    open($config,"<$perlvar{'lonTabDir'}/dns_hosts.tab");
+    my $which = (split('/',$url))[3];
+    &logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n");
+    open($config,"<$perlvar{'lonTabDir'}/dns_$which.tab");
     my @content = <$config>;
     &$func(\@content);
     return;
@@ -8502,6 +8537,14 @@ setting for a specific $type, where $typ
 @what should be a list of parameters to ask about. This routine caches
 answers for 5 minutes.
 
+=item *
+
+get_courseresdata($courseid, $domain) : dump the entire course resource
+data base, returning a hash that is keyed by the resource name and has
+values that are the resource value.  I believe that the timestamps and
+versions are also returned.
+
+
 =back
 
 =head2 Course Modification
@@ -9184,3 +9227,4 @@ symblist($mapname,%newhash) : update sym
 =back
 
 =cut
+