[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.476 and 1.477

version 1.476, 2004/03/09 16:25:19 version 1.477, 2004/03/16 20:15:08
Line 1171  sub tokenwrapper { Line 1171  sub tokenwrapper {
     $uri=~s/^\///;      $uri=~s/^\///;
     $ENV{'user.environment'}=~/\/([^\/]+)\.id/;      $ENV{'user.environment'}=~/\/([^\/]+)\.id/;
     my $token=$1;      my $token=$1;
     if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) {  #    if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) {
       if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/(.+)(\?\.*)*$/) {
  &appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'});   &appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'});
         return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri.          return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri.
                (($uri=~/\?/)?'&':'?').'token='.$token.                 (($uri=~/\?/)?'&':'?').'token='.$token.
Line 1180  sub tokenwrapper { Line 1181  sub tokenwrapper {
  return '/adm/notfound.html';   return '/adm/notfound.html';
     }      }
 }  }
       
   # --------------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course
   # input: action, courseID, current domain, home server for course, intended path to file,
   # source of file.
   # output: ok if successful, diagnostic message otherwise
   #
   # Allows directory structure to be used within lonUsers/../userfiles/ for a course.
   #
   # action = propagate - /home/httpd/html/userfiles/$domain/1/2/3/$course/$file will
   # be copied to /home/httpd/lonUsers/1/2/3/$course/userfiles in course's home server.
   #
   # action = copy - /home/httpd/html/userfiles/$domain/1/2/3/$course/$file will be copied
   # from $source (current location) to /home/httpd/html/userfiles/$domain/1/2/3/$course/$file
   # and will then be copied to /home/httpd/lonUsers/1/2/3/$course/userfiles/$file in
   # course's home server.
   
   sub process_coursefile {
       my ($action,$docuname,$docudom,$docuhome,$file,$source)=@_;
       my $fetchresult;
       if ($action eq 'propagate') {
           $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file
                               ,$docuhome);
       } elsif ($action eq 'copy') {
           my $fetchresult = '';
           my $fpath = '';
           my $fname = $file;
           ($fpath,$fname) = ($file =~ m/^(.*)\/([^\/]+)$/);
           $fpath=$docudom.'/'.$docuname.'/'.$fpath;
           my $filepath=$perlvar{'lonDocRoot'}.'/userfiles';
           unless ($fpath eq '') {
               my @parts=split(/\//,$fpath);
               foreach my $part (@parts) {
                   $filepath.= '/'.$part;
                   if ((-e $filepath)!=1) {
                       mkdir($filepath,0777);
                   }
               }
           }
           if ($source eq '') {
               $fetchresult = 'no source file';
           } else {
               my $destination = $filepath.'/'.$fname;
               print STDERR "Getting ready to rename $source to $destination\n";
               rename($source,$destination);
               $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
                                    $docuhome);
           }
       }
       unless ( ($fetchresult eq 'ok') || ($fetchresult eq 'no source file') ) {
           &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.
                ' to host '.$docuhome.': '.$fetchresult);
       }
       return $fetchresult;
   }
   
 # --------------- Take an uploaded file and put it into the userfiles directory  # --------------- Take an uploaded file and put it into the userfiles directory
 # input: name of form element, coursedoc=1 means this is for the course  # input: name of form element, coursedoc=1 means this is for the course
 # output: url of file in userspace  # output: url of file in userspace
   
 sub userfileupload {  sub userfileupload {
     my ($formname,$coursedoc,$filename,$fpath,$source)=@_;      my ($formname,$coursedoc)=@_;
     my $fname;      my $fname=$ENV{'form.'.$formname.'.filename'};
     if (defined($filename)) {  
         $fname = $filename;  
     } else {  
         $fname=$ENV{'form.'.$formname.'.filename'};  
     }  
 # Replace Windows backslashes by forward slashes  # Replace Windows backslashes by forward slashes
     $fname=~s/\\/\//g;      $fname=~s/\\/\//g;
 # Get rid of everything but the actual filename  # Get rid of everything but the actual filename
Line 1203  sub userfileupload { Line 1253  sub userfileupload {
     $fname=~s/[^\w\.\-]//g;      $fname=~s/[^\w\.\-]//g;
 # See if there is anything left  # See if there is anything left
     unless ($fname) { return 'error: no uploaded file'; }      unless ($fname) { return 'error: no uploaded file'; }
     if ( defined($formname) ) {      chop($ENV{'form.'.$formname});
         if ( defined($ENV{'form.'.$formname}) ) {  
             chop($ENV{'form.'.$formname});  
         }  
     }  
 # Create the directory if not present  # Create the directory if not present
     my $docuname='';      my $docuname='';
     my $docudom='';      my $docudom='';
Line 1222  sub userfileupload { Line 1268  sub userfileupload {
         $docuhome=$ENV{'user.home'};          $docuhome=$ENV{'user.home'};
     }      }
     return       return 
         &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname,$fpath,$source);          &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname);
 }  }
   
 sub finishuserfileupload {  sub finishuserfileupload {
     my ($docuname,$docudom,$docuhome,$formname,$fname,$fpath,$source)=@_;      my ($docuname,$docudom,$docuhome,$formname,$fname)=@_;
     my $path=$docudom.'/'.$docuname.'/'.$fpath;      my $path=$docudom.'/'.$docuname.'/';
     my $filepath=$perlvar{'lonDocRoot'};      my $filepath=$perlvar{'lonDocRoot'};
     my @parts=split(/\//,$filepath.'/userfiles/'.$path);      my @parts=split(/\//,$filepath.'/userfiles/'.$path);
     my $count;      my $count;
Line 1239  sub finishuserfileupload { Line 1285  sub finishuserfileupload {
     }      }
 # Save the file  # Save the file
     {      {
        if ($source eq '') {         open(my $fh,'>'.$filepath.'/'.$fname);
            open(my $fh,'>'.$filepath.'/'.$fname);         print $fh $ENV{'form.'.$formname};
            print $fh $ENV{'form.'.$formname};         close($fh);
            close($fh);  
        } else {  
            my $destination = $filepath.'/'.$fname;  
            rename($source,$destination);  
        }  
     }      }
 # Notify homeserver to grep it  # Notify homeserver to grep it
 #  #
           my $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,
     my $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname.      $docuhome);
     ':'.$fpath,$docuhome);  
     if ($fetchresult eq 'ok') {      if ($fetchresult eq 'ok') {
 #  #
 # Return the URL to it  # Return the URL to it
Removed from v.1.476  
changed lines
  Added in v.1.477

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>