[LON-CAPA-cvs] cvs: loncom /interface loncommon.pm /lonnet/perl lonnet.pm

raeburn raeburn@source.lon-capa.org
Thu, 25 Feb 2010 03:43:27 -0000


raeburn		Thu Feb 25 03:43:27 2010 EDT

  Modified files:              
    /loncom/interface	loncommon.pm 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Sanity checking of proposed home server for course when creating a course.
    - Use primary library server for course domain if no server specified.
    - Eliminate use of $env{'user.homeserver'} which is not in a user's %env. 
  
  
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.942 loncom/interface/loncommon.pm:1.943
--- loncom/interface/loncommon.pm:1.942	Sun Feb 21 02:38:23 2010
+++ loncom/interface/loncommon.pm	Thu Feb 25 03:43:20 2010
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.942 2010/02/21 02:38:23 raeburn Exp $
+# $Id: loncommon.pm,v 1.943 2010/02/25 03:43:20 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -10096,11 +10096,19 @@
     # if anyone ever decides to not show this, and Utils::Course::new
     # will need to be suitably modified.
     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
+    if ($$courseid =~ /^error:/) {
+        return (0,$outcome);
+    }
+
 #
 # Check if created correctly
 #
     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
+    if ($crsuhome eq 'no_host') {
+        $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
+        return (0,$outcome);
+    }
     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
 
 #
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1051 loncom/lonnet/perl/lonnet.pm:1.1052
--- loncom/lonnet/perl/lonnet.pm:1.1051	Sun Feb 21 06:21:57 2010
+++ loncom/lonnet/perl/lonnet.pm	Thu Feb 25 03:43:27 2010
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1051 2010/02/21 06:21:57 raeburn Exp $
+# $Id: lonnet.pm,v 1.1052 2010/02/25 03:43:27 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -6685,9 +6685,17 @@
     }
     return $uname if ($uname =~ /^error/);
 # -------------------------------------------------- Check supplied server name
-    $course_server = $env{'user.homeserver'} if (! defined($course_server));
-    if (! &is_library($course_server)) {
-        return 'error:bad server name '.$course_server;
+    if (!defined($course_server)) {
+        if (defined(&domain($udom,'primary'))) {
+            $course_server = &domain($udom,'primary');
+        } else {
+            $course_server = $env{'user.home'}; 
+        }
+    }
+    my %host_servers =
+        &Apache::lonnet::get_servers($udom,'library');
+    unless ($host_servers{$course_server}) {
+        return 'error: invalid home server for course: '.$course_server;
     }
 # ------------------------------------------------------------- Make the course
     my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::',