--- loncom/lonnet/perl/lonnet.pm	2007/09/12 20:29:16	1.912
+++ loncom/lonnet/perl/lonnet.pm	2007/11/06 13:05:00	1.922
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.912 2007/09/12 20:29:16 raeburn Exp $
+# $Id: lonnet.pm,v 1.922 2007/11/06 13:05:00 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -320,7 +320,10 @@ sub convert_and_load_session_env {
     my ($lonidsdir,$handle)=@_;
     my @profile;
     {
-	open(my $idf,"$lonidsdir/$handle.id");
+	my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");
+	if (!$opened) {
+	    return 0;
+	}
 	flock($idf,LOCK_SH);
 	@profile=<$idf>;
 	close($idf);
@@ -359,7 +362,10 @@ sub transfer_profile_to_env {
 
     my $convert;
     {
-    	open(my $idf,"$lonidsdir/$handle.id");
+    	my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");
+	if (!$opened) {
+	    return;
+	}
 	flock($idf,LOCK_SH);
 	if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",
 		&GDBM_READER(),0640)) {
@@ -391,6 +397,34 @@ sub transfer_profile_to_env {
     }
 }
 
+# ---------------------------------------------------- Check for valid session 
+sub check_for_valid_session {
+    my ($r) = @_;
+    my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
+    my $lonid=$cookies{'lonID'};
+    return undef if (!$lonid);
+
+    my $handle=&LONCAPA::clean_handle($lonid->value);
+    my $lonidsdir=$r->dir_config('lonIDsDir');
+    return undef if (!-e "$lonidsdir/$handle.id");
+
+    my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");
+    return undef if (!$opened);
+
+    flock($idf,LOCK_SH);
+    my %disk_env;
+    if (!tie(%disk_env,'GDBM_File',"$lonidsdir/$handle.id",
+	    &GDBM_READER(),0640)) {
+	return undef;	
+    }
+
+    if (!defined($disk_env{'user.name'})
+	|| !defined($disk_env{'user.domain'})) {
+	return undef;
+    }
+    return $handle;
+}
+
 sub timed_flock {
     my ($file,$lock_type) = @_;
     my $failed=0;
@@ -425,8 +459,9 @@ sub appenv {
             $env{$key}=$newenv{$key};
         }
     }
-    open(my $env_file,$env{'user.environment'});
-    if (&timed_flock($env_file,LOCK_EX)
+    my $opened = open(my $env_file,'+<',$env{'user.environment'});
+    if ($opened
+	&& &timed_flock($env_file,LOCK_EX)
 	&&
 	tie(my %disk_env,'GDBM_File',$env{'user.environment'},
 	    (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {
@@ -446,16 +481,17 @@ sub delenv {
                 "Attempt to delete from environment ".$delthis);
         return 'error';
     }
-    open(my $env_file,$env{'user.environment'});
-    if (&timed_flock($env_file,LOCK_EX)
+    my $opened = open(my $env_file,'+<',$env{'user.environment'});
+    if ($opened
+	&& &timed_flock($env_file,LOCK_EX)
 	&&
 	tie(my %disk_env,'GDBM_File',$env{'user.environment'},
 	    (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {
 	foreach my $key (keys(%disk_env)) {
 	    if ($key=~/^$delthis/) { 
-                delete($env{$key});
-                delete($disk_env{$key});
-            }
+		delete($env{$key});
+		delete($disk_env{$key});
+	    }
 	}
 	untie(%disk_env);
     }
@@ -582,6 +618,27 @@ sub compare_server_load {
     }
     return ($spare_server,$lowest_load);
 }
+
+# --------------------------- ask offload servers if user already has a session
+sub find_existing_session {
+    my ($udom,$uname) = @_;
+    foreach my $try_server (@{ $spareid{'primary'} },
+			    @{ $spareid{'default'} }) {
+	return $try_server if (&has_user_session($try_server, $udom, $uname));
+    }
+    return;
+}
+
+# -------------------------------- ask if server already has a session for user
+sub has_user_session {
+    my ($lonid,$udom,$uname) = @_;
+    my $result = &reply(join(':','userhassession',
+			     map {&escape($_)} ($udom,$uname)),$lonid);
+    return 1 if ($result eq 'ok');
+
+    return 0;
+}
+
 # --------------------------------------------- Try to change a user's password
 
 sub changepass {
@@ -1326,13 +1383,15 @@ sub do_cache_new {
 	$memcache->disconnect_all();
     }
     # need to make a copy of $value
-    #&make_room($id,$value,$debug);
+    &make_room($id,$value,$debug);
     return $value;
 }
 
 sub make_room {
     my ($id,$value,$debug)=@_;
-    $remembered{$id}=$value;
+
+    $remembered{$id}= (ref($value)) ? &Storable::dclone($value)
+                                    : $value;
     if ($to_remember<0) { return; }
     $accessed{$id}=[&gettimeofday()];
     if (scalar(keys(%remembered)) <= $to_remember) { return; }
@@ -2113,7 +2172,7 @@ sub flushcourselogs {
 # times and course titles for all courseids
 #
     my %courseidbuffer=();
-    foreach my $crsid (keys %courselogs) {
+    foreach my $crsid (keys(%courselogs)) {
         if (&reply('log:'.$coursedombuf{$crsid}.':'.$coursenumbuf{$crsid}.':'.
 		          &escape($courselogs{$crsid}),
 		          $coursehombuf{$crsid}) eq 'ok') {
@@ -2126,23 +2185,21 @@ sub flushcourselogs {
                delete $courselogs{$crsid};
             }
         }
-        if ($courseidbuffer{$coursehombuf{$crsid}}) {
-           $courseidbuffer{$coursehombuf{$crsid}}.='&'.
-			 &escape($crsid).'='.&escape($coursedescrbuf{$crsid}).
-                         ':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid}).':'.&escape($coursetypebuf{$crsid});
-        } else {
-           $courseidbuffer{$coursehombuf{$crsid}}=
-			 &escape($crsid).'='.&escape($coursedescrbuf{$crsid}).
-                         ':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid}).':'.&escape($coursetypebuf{$crsid});
-        }
+        $courseidbuffer{$coursehombuf{$crsid}}{$crsid} = {
+            'description' => &escape($coursedescrbuf{$crsid}),
+            'inst_code'    => &escape($courseinstcodebuf{$crsid}),
+            'type'        => &escape($coursetypebuf{$crsid}),
+            'owner'       => &escape($courseownerbuf{$crsid}),
+        };
     }
 #
 # Write course id database (reverse lookup) to homeserver of courses 
 # Is used in pickcourse
 #
     foreach my $crs_home (keys(%courseidbuffer)) {
-        &courseidput(&host_domain($crs_home),$courseidbuffer{$crs_home},
-		     $crs_home);
+        my $response = &courseidput(&host_domain($crs_home),
+                                    $courseidbuffer{$crs_home},
+                                    $crs_home,'timeonly');
     }
 #
 # File accesses
@@ -2406,7 +2463,13 @@ sub get_my_roles {
         }
         if (ref($roles) eq 'ARRAY') {
             if (!grep(/^\Q$role\E$/,@{$roles})) {
-                next;
+                if ($role =~ /^cr\//) {
+                    if (!grep(/^cr$/,@{$roles})) {
+                        next;
+                    }
+                } else {
+                    next;
+                }
             }
         }
 	$returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend;
@@ -2448,31 +2511,77 @@ sub getannounce {
 #
 
 sub courseidput {
-    my ($domain,$what,$coursehome)=@_;
-    return &reply('courseidput:'.$domain.':'.$what,$coursehome);
+    my ($domain,$storehash,$coursehome,$caller) = @_;
+    my $outcome;
+    if ($caller eq 'timeonly') {
+        my $cids = '';
+        foreach my $item (keys(%$storehash)) {
+            $cids.=&escape($item).'&';
+        }
+        $cids=~s/\&$//;
+        $outcome = &reply('courseidputhash:'.$domain.':'.$caller.':'.$cids,
+                          $coursehome);       
+    } else {
+        my $items = '';
+        foreach my $item (keys(%$storehash)) {
+            $items.= &escape($item).'='.
+                     &freeze_escape($$storehash{$item}).'&';
+        }
+        $items=~s/\&$//;
+        $outcome = &reply('courseidputhash:'.$domain.':'.$caller.':'.$items,
+                          $coursehome);
+    }
+    if ($outcome eq 'unknown_cmd') {
+        my $what;
+        foreach my $cid (keys(%$storehash)) {
+            $what .= &escape($cid).'=';
+            foreach my $item ('description','inst_code','owner','type') {
+                $what .= &escape($storehash->{$item}).':';
+            }
+            $what =~ s/\:$/&/;
+        }
+        $what =~ s/\&$//;  
+        return &reply('courseidput:'.$domain.':'.$what,$coursehome);
+    } else {
+        return $outcome;
+    }
 }
 
 sub courseiddump {
-    my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;
-    my %returnhash=();
-    unless ($domfilter) { $domfilter=''; }
+    my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,
+        $coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;
+    my $as_hash = 1;
+    my %returnhash;
+    if (!$domfilter) { $domfilter=''; }
     my %libserv = &all_library();
     foreach my $tryserver (keys(%libserv)) {
         if ( (  $hostidflag == 1 
 	        && grep(/^\Q$tryserver\E$/,@{$hostidref}) ) 
 	     || (!defined($hostidflag)) ) {
 
-	    if ($domfilter eq ''
-		|| (&host_domain($tryserver) eq $domfilter)) {
-	        foreach my $line (
-                 split(/\&/,&reply('courseiddump:'.&host_domain($tryserver).':'.
-			       $sincefilter.':'.&escape($descfilter).':'.
-                               &escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter).':'.&escape($typefilter).':'.&escape($regexp_ok),
-                               $tryserver))) {
-		    my ($key,$value)=split(/\=/,$line,2);
-                    if (($key) && ($value)) {
-		        $returnhash{&unescape($key)}=$value;
-                    }
+	    if (($domfilter eq '') ||
+		(&host_domain($tryserver) eq $domfilter)) {
+                my $rep = 
+                  &reply('courseiddump:'.&host_domain($tryserver).':'.
+                         $sincefilter.':'.&escape($descfilter).':'.
+                         &escape($instcodefilter).':'.&escape($ownerfilter).
+                         ':'.&escape($coursefilter).':'.&escape($typefilter).
+                         ':'.&escape($regexp_ok).':'.$as_hash,$tryserver);
+                my @pairs=split(/\&/,$rep);
+                foreach my $item (@pairs) {
+                    my ($key,$value)=split(/\=/,$item,2);
+                    $key = &unescape($key);
+                    next if ($key =~ /^error: 2 /);
+                    my $result = &thaw_unescape($value);
+                    if (ref($result) eq 'HASH') {
+                        $returnhash{$key}=$result;
+                    } else {
+                        my @responses = split(/:/,$value);
+                        my @items = ('description','inst_code','owner','type');
+                        for (my $i=0; $i<@responses; $i++) {
+                            $returnhash{$key}{$items[$i]} = &unescape($responses[$i]);
+                        }
+                    } 
                 }
             }
         }
@@ -2518,7 +2627,10 @@ sub get_domain_roles {
     if (undef($enddate) || $enddate eq '') {
         $enddate = '.';
     }
-    my $rolelist = join(':',@{$roles});
+    my $rolelist;
+    if (ref($roles) eq 'ARRAY') {
+        $rolelist = join(':',@{$roles});
+    }
     my %personnel = ();
 
     my %servers = &get_servers($dom,'library');
@@ -4918,10 +5030,16 @@ sub auto_instcode_defaults {
 } 
 
 sub auto_validate_class_sec {
-    my ($cdom,$cnum,$owner,$inst_class) = @_;
+    my ($cdom,$cnum,$owners,$inst_class) = @_;
     my $homeserver = &homeserver($cnum,$cdom);
+    my $ownerlist;
+    if (ref($owners) eq 'ARRAY') {
+        $ownerlist = join(',',@{$owners});
+    } else {
+        $ownerlist = $owners;
+    }
     my $response=&reply('autovalidateclass_sec:'.$inst_class.':'.
-                        &escape($owner).':'.$cdom,$homeserver);
+                        &escape($ownerlist).':'.$cdom,$homeserver);
     return $response;
 }
 
@@ -5450,10 +5568,15 @@ sub createcourse {
     }
 # ----------------------------------------------------------------- Course made
 # log existence
-    &courseidput($udom,&escape($udom.'_'.$uname).'='.&escape($description).
-                 ':'.&escape($inst_code).':'.&escape($course_owner).':'.
-                  &escape($crstype),$uhome);
-    &flushcourselogs();
+    my $newcourse = {
+                    $udom.'_'.$uname => {
+                                     description => $description,
+                                     inst_code   => $inst_code,
+                                     owner       => $course_owner,
+                                     type        => $crstype,
+                                                },
+                    };
+    &courseidput($udom,$newcourse,$uhome,'notime');
 # set toplevel url
     my $topurl=$url;
     unless ($nonstandard) {
@@ -5483,7 +5606,7 @@ ENDINITMAP
 sub is_course {
     my ($cdom,$cnum) = @_;
     my %courses = &courseiddump($cdom,'.',1,'.','.',$cnum,undef,
-				undef,'.');
+				undef,'.',undef,1);
     if (exists($courses{$cdom.'_'.$cnum})) {
         return 1;
     }
@@ -7832,6 +7955,9 @@ sub hreflocation {
 	$file=~s-^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/
 	    -/uploaded/$1/$2/-x;
     }
+    if ($file=~ m{^/userfiles/}) {
+	$file =~ s{^/userfiles/}{/uploaded/};
+    }
     return $file;
 }