--- loncom/lonnet/perl/lonnet.pm	2002/07/17 18:01:33	1.252
+++ loncom/lonnet/perl/lonnet.pm	2002/07/31 13:50:38	1.258
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.252 2002/07/17 18:01:33 albertel Exp $
+# $Id: lonnet.pm,v 1.258 2002/07/31 13:50:38 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -708,6 +708,46 @@ sub ssi {
     return $response->content;
 }
 
+# ------- Add a token to a remote URI's query string to vouch for access rights
+
+sub tokenwrapper {
+    my $uri=shift;
+    my $token=&reply('tmpput:'.&escape($uri),$perlvar{'lonHostID'});
+    return $uri.(($uri=~/\?/)?'&':'?').
+	'token='.$token.'&server='.$perlvar{'lonHostID'};
+}
+    
+# --------------- Take an uploaded file and put it into the userfiles directory
+# input: name of form element
+# output: url of file in userspace
+
+sub userfileupload {
+    my $formname=shift;
+    my $fname=$ENV{'form.'.$formname.'.filename'};
+    $fname=~s/\\/\//g;
+    $fname=~s/^.*\/([^\/]+)$/$1/;
+    unless ($fname) { return 'error: no uploaded file'; }
+    chop($ENV{'form.'.$formname});
+# Create the directory if not present
+    my $path='/userfiles/'.$ENV{'user.domain'}.'/'.$ENV{'user.name'}.'/';
+    my $filepath=$perlvar{'lonDocRoot'};
+    my @parts=split(/\//,$filepath.$path);
+    my $count;
+    for ($count=4;$count<=$#parts;$count++) {
+        $filepath.="/$parts[$count]";
+        if ((-e $filepath)!=1) {
+	    mkdir($filepath,0777);
+        }
+    }
+# Save the file
+    {
+       my $fh=Apache::File->new('>'.$filepath.'/'.$fname);
+       print $fh $ENV{'form.'.$formname};
+    }
+# Return the URL to it
+    return 'http://'.$ENV{'SERVER_NAME'}.$path.$fname;    
+}
+
 # ------------------------------------------------------------------------- Log
 
 sub log {
@@ -1033,7 +1073,7 @@ sub tmpreset {
   my %hash;
   if (tie(%hash,'GDBM_File',
 	  $path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
-	  &GDBM_WRCREAT,0640)) {
+	  &GDBM_WRCREAT(),0640)) {
     foreach my $key (keys %hash) {
       if ($key=~ /:$symb/) {
 	delete($hash{$key});
@@ -1069,7 +1109,7 @@ sub tmpstore {
   my $path=$perlvar{'lonDaemons'}.'/tmp';
   if (tie(%hash,'GDBM_File',
 	  $path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
-	  &GDBM_WRCREAT,0640)) {
+	  &GDBM_WRCREAT(),0640)) {
     $hash{"version:$symb"}++;
     my $version=$hash{"version:$symb"};
     my $allkeys=''; 
@@ -1113,7 +1153,7 @@ sub tmprestore {
   my $path=$perlvar{'lonDaemons'}.'/tmp';
   if (tie(%hash,'GDBM_File',
 	  $path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
-	  &GDBM_READER,0640)) {
+	  &GDBM_READER(),0640)) {
     my $version=$hash{"version:$symb"};
     $returnhash{'version'}=$version;
     my $scope;
@@ -2166,51 +2206,74 @@ sub revokecustomrole {
 # ------------------------------------------------------------ Directory lister
 
 sub dirlist {
-    my $uri=shift;
+    my ($uri,$userdomain,$username,$alternateDirectoryRoot)=@_;
+
     $uri=~s/^\///;
     $uri=~s/\/$//;
-    my ($res,$udom,$uname,@rest)=split(/\//,$uri);
-    if ($udom) {
-     if ($uname) {
-       my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/'.$uri,
-                      homeserver($uname,$udom));
-       return split(/:/,$listing);
-     } else {
-       my $tryserver;
-       my %allusers=();
-       foreach $tryserver (keys %libserv) {
-	  if ($hostdom{$tryserver} eq $udom) {
-             my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.$udom,
-			       $tryserver);
-             if (($listing ne 'no_such_dir') && ($listing ne 'empty')
-              && ($listing ne 'con_lost')) {
-                foreach (split(/:/,$listing)) {
-                  my ($entry,@stat)=split(/&/,$_);
-                  $allusers{$entry}=1;
+    my ($udom, $uname);
+    (undef,$udom,$uname)=split(/\//,$uri);
+    if(defined($userdomain)) {
+        $udom = $userdomain;
+    }
+    if(defined($username)) {
+        $uname = $username;
+    }
+
+    my $dirRoot = $perlvar{'lonDocRoot'};
+    if(defined($alternateDirectoryRoot)) {
+        $dirRoot = $alternateDirectoryRoot;
+        $dirRoot =~ s/\/$//;
+    }
+
+    if($udom) {
+        if($uname) {
+            my $listing=reply('ls:'.$dirRoot.'/'.$uri,
+                              homeserver($uname,$udom));
+            return split(/:/,$listing);
+        } elsif(!defined($alternateDirectoryRoot)) {
+            my $tryserver;
+            my %allusers=();
+            foreach $tryserver (keys %libserv) {
+                if($hostdom{$tryserver} eq $udom) {
+                    my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
+                                      $udom, $tryserver);
+                    if (($listing ne 'no_such_dir') && ($listing ne 'empty')
+                        && ($listing ne 'con_lost')) {
+                        foreach (split(/:/,$listing)) {
+                            my ($entry,@stat)=split(/&/,$_);
+                            $allusers{$entry}=1;
+                        }
+                    }
                 }
-             }
-	  }
-       }
-       my $alluserstr='';
-       foreach (sort keys %allusers) {
-           $alluserstr.=$_.'&user:';
-       }
-       $alluserstr=~s/:$//;
-       return split(/:/,$alluserstr);
-     } 
-   } else {
-       my $tryserver;
-       my %alldom=();
-       foreach $tryserver (keys %libserv) {
-	   $alldom{$hostdom{$tryserver}}=1;
-       }
-       my $alldomstr='';
-       foreach (sort keys %alldom) {
-          $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$_.'&domain:';
-       }
-       $alldomstr=~s/:$//;
-       return split(/:/,$alldomstr);       
-   }
+            }
+            my $alluserstr='';
+            foreach (sort keys %allusers) {
+                $alluserstr.=$_.'&user:';
+            }
+            $alluserstr=~s/:$//;
+            return split(/:/,$alluserstr);
+        } else {
+            my @emptyResults = ();
+            push(@emptyResults, 'missing user name');
+            return split(':',@emptyResults);
+        }
+    } elsif(!defined($alternateDirectoryRoot)) {
+        my $tryserver;
+        my %alldom=();
+        foreach $tryserver (keys %libserv) {
+            $alldom{$hostdom{$tryserver}}=1;
+        }
+        my $alldomstr='';
+        foreach (sort keys %alldom) {
+            $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$_.'&domain:';
+        }
+        $alldomstr=~s/:$//;
+        return split(/:/,$alldomstr);       
+    } else {
+        my @emptyResults = ();
+        push(@emptyResults, 'missing domain');
+        return split(':',@emptyResults);
+    }
 }
 
 # -------------------------------------------------------- Value of a Condition
@@ -2395,7 +2458,7 @@ sub EXT {
 	    my $section;
 	    if (($ENV{'user.name'} eq $uname) &&
 		($ENV{'user.domain'} eq $udom)) {
-		$section={'request.course.sec'};
+		$section=$ENV{'request.course.sec'};
 	    } else {
 		$section=&usection($udom,$uname,$courseid);
 	    }
@@ -2444,7 +2507,7 @@ sub EXT {
 	    my $thisparm='';
 	    if (tie(%parmhash,'GDBM_File',
 		    $ENV{'request.course.fn'}.'_parms.db',
-		    &GDBM_READER,0640)) {
+		    &GDBM_READER(),0640)) {
 		$thisparm=$parmhash{$symbparm};
 		untie(%parmhash);
 	    }
@@ -2631,7 +2694,7 @@ sub symblist {
     my %hash;
     if (($ENV{'request.course.fn'}) && (%newhash)) {
         if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
-                      &GDBM_WRCREAT,0640)) {
+                      &GDBM_WRCREAT(),0640)) {
 	    foreach (keys %newhash) {
                 $hash{declutter($_)}=$mapname.'___'.$newhash{$_};
             }
@@ -2659,7 +2722,7 @@ sub symbverify {
     my %bighash;
     my $okay=0;
     if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
-                            &GDBM_READER,0640)) {
+                            &GDBM_READER(),0640)) {
         my $ids=$bighash{'ids_/res/'.$thisfn};
         unless ($ids) { 
            $ids=$bighash{'ids_/'.$thisfn};
@@ -2713,7 +2776,7 @@ sub symbread {
     my $syval='';
     if (($ENV{'request.course.fn'}) && ($thisfn)) {
         if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
-                      &GDBM_READER,0640)) {
+                      &GDBM_READER(),0640)) {
 	    $syval=$hash{$thisfn};
             untie(%hash);
         }
@@ -2729,7 +2792,7 @@ sub symbread {
         } else {
 # ------------------------------------------------------- Was not in symb table
            if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
-                            &GDBM_READER,0640)) {
+                            &GDBM_READER(),0640)) {
 # ---------------------------------------------- Get ID(s) for current resource
               my $ids=$bighash{'ids_/res/'.$thisfn};
               unless ($ids) {