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

Diff for /loncom/publisher/lonupload.pm between versions 1.30 and 1.71

version 1.30, 2005/11/08 17:58:35 version 1.71, 2023/07/23 11:54:56
Line 1 Line 1
   
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # Handler to upload files into construction space  # Handler to upload files into construction space
 #  #
Line 28 Line 27
 #  #
 ###  ###
   
   =head1 NAME
   
   Apache::lonupload - upload files into construction space
   
   =head1 SYNOPSIS
   
   Invoked by /etc/httpd/conf/srm.conf:
   
    <Location /adm/upload>
    PerlAccessHandler       Apache::lonacc
    SetHandler perl-script
    PerlHandler Apache::lonupload
    ErrorDocument     403 /adm/login
    ErrorDocument     404 /adm/notfound.html
    ErrorDocument     406 /adm/unauthorized.html
    ErrorDocument  500 /adm/errorhandler
    </Location>
   
   =head1 INTRODUCTION
   
   This module uploads a file sitting on a client computer into 
   library server construction space.
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   =head1 HANDLER SUBROUTINE
   
   This routine is called by Apache and mod_perl.
   
   =over 4
   
   =item *
   
   Initialize variables
   
   =item *
   
   Start page output
   
   =item *
   
   output relevant interface phase (phaseone, phasetwo, phasethree or phasefour)
   
   =item *
   
   (phase one is to specify upload file; phase two is to handle conditions
   subsequent to specification--like overwriting an existing file; phase three
   is to handle processing of secondary uploads - of embedded objects in an
   html file).
   
   =back
   
   =head1 OTHER SUBROUTINES
   
   =over
   
   =item phaseone()
   
   Interface for specifying file to upload.
   
   =item phasetwo()
   
   Interface for handling post-conditions about uploading (such
   as overwriting an existing file).
   
   =item phasethree()
   
   Interface for handling secondary uploads of embedded objects
   in an html file.
   
   =item phasefour()
   
   Interface for handling optional renaming of links to embedded
   objects. 
   
   =item upfile_store()
   
   Store contents of uploaded file into temporary space.  Invoked
   by phaseone subroutine.
   
   =item check_extension()
   
   Checks if filename extension is permitted and checks type
    of file - if html file, calls parser to check for embedded objects.
    Invoked by phasetwo subroutine.
   
   =back
   
   =cut
   
 package Apache::lonupload;  package Apache::lonupload;
   
 use strict;  use strict;
Line 35  use Apache::File; Line 125  use Apache::File;
 use File::Copy;  use File::Copy;
 use File::Basename;  use File::Basename;
 use Apache::Constants qw(:common :http :methods);  use Apache::Constants qw(:common :http :methods);
 use Apache::loncacc;  
 use Apache::loncommon();  use Apache::loncommon();
 use Apache::lonnet;  use Apache::lonnet;
 use HTML::Entities();  use HTML::Entities();
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::lonnet;  use Apache::lonnet;
   use LONCAPA qw(:DEFAULT :match);
   
 my $DEBUG=0;  my $DEBUG=0;
   
Line 60  sub upfile_store { Line 150  sub upfile_store {
           
     chomp($env{'form.upfile'});      chomp($env{'form.upfile'});
       
     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.      my $datatoken;
   '_upload_'.$fname.'_'.time.'_'.$$;      if (($env{'user.name'} =~ /^$match_username$/) && ($env{'user.domain'} =~ /^$match_domain$/)) {
           $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                      '_upload_'.$fname.'_'.time.'_'.$$;
       }
       return if ($datatoken eq '');
     {      {
        my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').         my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
                                    '/tmp/'.$datatoken.'.tmp');                                     '/tmp/'.$datatoken.'.tmp');
Line 70  sub upfile_store { Line 164  sub upfile_store {
     return $datatoken;      return $datatoken;
 }  }
   
   
 sub phaseone {  sub phaseone {
     my ($r,$fn,$uname,$udom,$mode)=@_;      my ($r,$fn,$mode,$uname,$udom)=@_;
     my $action = '/adm/upload';      my $action = '/adm/upload';
     if ($mode eq 'testbank') {      if ($mode eq 'testbank') {
         $action = '/adm/testbank';          $action = '/adm/testbank';
     } elsif ($mode eq 'imsimport') {      } elsif ($mode eq 'imsimport') {
         $action = '/adm/imsimport';          $action = '/adm/imsimport';
     }      }
   
       # Check for file to be uploaded
     $env{'form.upfile.filename'}=~s/\\/\//g;      $env{'form.upfile.filename'}=~s/\\/\//g;
     $env{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/;      $env{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/;
     if ($env{'form.upfile.filename'}) {      $env{'form.upfile.filename'}=~s/(\s+$|^\s+)//g;
  $fn=~s/\/[^\/]+$//;      if (!$env{'form.upfile.filename'}) {
  $fn=~s/([^\/])$/$1\//;          $r->print('<p class="LC_warning">'.&mt('No upload file specified.').'</p>'.
  $fn.=$env{'form.upfile.filename'};                    &earlyout($fn,$uname,$udom));
  $fn=~s/^\///;          return;
  $fn=~s/(\/)+/\//g;      }
   
 #    Fn is the full path to the destination filename.      # Append the name of the uploaded file
 #          $fn.=$env{'form.upfile.filename'};
       $fn=~s/(\/)+/\//g;
  &Debug($r, "Filename for upload: $fn");  
  if (($fn) && ($fn!~/\/$/)) {      # Check for illegal filename
     $r->print('<form action="'.$action.'" method="post" name="fileupload">'.      &Debug($r, "Filename for upload: $fn");
       '<input type="hidden" name="phase" value="two" />'.      if (!(($fn) && ($fn!~/\/$/))) {
       '<input type="hidden" name="datatoken" value="'.          $r->print('<p class="LC_warning">'.&mt('Illegal filename.').'</p>');
       &upfile_store.'" />'.          return;
       '<input type="hidden" name="uploaduname" value="'.$uname.      }
       '" />'.&mt('Store uploaded file as ').      # Check if quota exceeded
                       "<tt>/priv/$uname/</tt>".      my $filesize = length($env{'form.upfile'});
                       '<input type="text" size="50" name="filename" value="'.$fn.      if (!$filesize) {
                       '" /><br />');          $r->print('<p class="LC_warning">'.
             $r->print('<br />'.&mt('Please indicate the type of file you are uploading. The possible types of file are as follows:').'                    &mt('Unable to upload [_1]. (size = [_2] bytes)',
 <ul>                        '<span class="LC_filename">'.$env{'form.upfile.filename'}.'</span>',
  <li><b>'.&mt('Regular file:').'</b>'.&mt(' A file that requires no special handling during upload. The "Regular file" designation applies to html files, image files etc., as well as to zip, tar or gzip files that you wish to decompress after upload. In the case of a zip/tar/gz file etc., once the file has been uploaded, a "Decompress" link will automatically be displayed adjacent to the name of the file in the display of construction space directory contents. You will be able to decompress this file by clicking the link.').'</li>                             $filesize).'<br />'.
  <li><b>'.&mt('Testbank file:').'</b>'.&mt(' a testbank file containing plain text (ascii) questions and answers, which you plan to convert to LON-CAPA problems. The following question types can be converted: 1 of N multiple choice questions, individual True/False questions, groups of True/False questions, Fill-in-the-blank questions, Ranking questions, and Essay/short answer questions. Specific information about the format of the questions, foils, and correct answers is available ').'<a href="javascript:testbankWin()">'.&mt('here').'</a>,'.&mt(' and is also included in the pages displayed during step-by-step conversion of the testbank. The original testbank file can be removed from your construction space later, once the testbank questions have been converted.').'</li>                    &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
 <li><b>'.&mt('IMS package').':</b>'.&mt(' a file containing course content from another Course Management System (e.g., Blackboard or ANGEL) packaged according to the IMS 1.1 specification.  The original IMS package file can be removed from your construction space later, once the package has been decompressed and the files converted to LON-CAPA sequence, page, problem, or bulletin board files, or stored as html, image or movie files etc., as appropriate.').'</li>                    '</p>'.
 </ul>                    &earlyout($fn,$uname,$udom));
 <br />'.&mt('Choose file type:').'          return;
 <select name="filetype">      }
  <option value="standard" selected>'.&mt('Regular file').'      $filesize = int($filesize/1000); #expressed in kb
  <option value="testbank">'.&mt('Testbank file').'      my $output = &Apache::loncommon::excess_filesize_warning($uname,$udom,'author',
  <option value="imsimport">'.&mt('IMS package').'                                                               $env{'form.upfile.filename'},$filesize,'upload');
 </select>      if ($output) {
 <br />          $r->print($output.&earlyout($fn,$uname,$udom));
 <br />          return;
 ');      }
             $r->print('<input type="button" value="'.&mt('Store').'" onClick="javascript:verifyForm()"/></form>');  
     # Check for bad extension and warn user  # Split part that I can change from the part that I cannot change
     if ($fn=~/\.(\w+)$/ &&       my ($fn1,$fn2)=($fn=~/^(\/priv\/[^\/]+\/[^\/]+\/)(.*)$/);
  (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {  # Check for pattern: .number.extension which is reserved for LON-CAPA versioning. 
  $r->print('<font color="red">'.&mt('The extension on this file,').  # Check for disallowed characters: #?&%:<>`|, and remove
   ' "'.$1.'"'.&mt(', is reserved internally by LON-CAPA.').      if ($fn2 ne '') {
   ' <br />'.&mt('Please change the extension.').'</font>');          ($fn2,my $warning) = &check_filename($fn2);
     } elsif($fn=~/\.(\w+)$/ &&           if ($warning ne '') {
     !defined(&Apache::loncommon::fileembstyle($1))) {              $r->print($warning);
  $r->print('<font color="red">'.&mt('The extension on this file,').          }
   ' "'.$1.'"'.&mt(', is not recognized by LON-CAPA.').      }
   ' <br />'.&mt('Please change the extension.').      # Display additional options for upload
   '</font>');      # and upload button
     }      $r->print(
  } else {          '<form action="'.$action.'" method="post" name="fileupload">'
     $r->print('<font color="red">'.&mt('Illegal filename.').'</font>');         .'<input type="hidden" name="phase" value="two" />'
  }         .'<input type="hidden" name="datatoken" value="'.&upfile_store.'" />'
     } else {      );
  $r->print('<font color="red">'.&mt('No upload file specified.').'</font>');      $r->print(
           &Apache::lonhtmlcommon::start_pick_box()
          .&Apache::lonhtmlcommon::row_title(&mt('Save uploaded file as'))
          .'<span class="LC_filename">'.$fn1.'</span>'
          .'<input type="hidden" name="filename1" value="'.$fn1.'" />'
          .'<input type="text" size="50" name="filename2" value="'.$fn2.'" />'
          .&Apache::lonhtmlcommon::row_closure()
          .&Apache::lonhtmlcommon::row_title(&mt('File Type'))
          .'<select name="filetype">'
          .'<option value="standard" selected="selected">'.&mt('Regular file').'</option>'
          .'<option value="testbank">'.&mt('Testbank file').'</option>'
          .'<option value="imsimport">'.&mt('IMS package').'</option>'
          .'</select>'.&Apache::loncommon::help_open_topic("Uploading_File_Options")
          .&Apache::lonhtmlcommon::row_closure(1)
          .&Apache::lonhtmlcommon::end_pick_box()
       );
       $r->print(
           '<p>'
          .'<input type="button" value="'.&mt('Upload').'" onclick="javascript:verifyForm()"/>'
          .'</p>'
          .'</form>'
       );
   
      # Check for bad extension and warn user
       if ($fn=~/\.(\w+)$/ && 
           (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
                   $r->print('<p class="LC_error">'
                             .&mt('The extension on this file, [_1], is reserved internally by LON-CAPA.',
                                  '<span class="LC_filename">'.$1.'</span>')
                             .' <br />'.&mt('Please change the extension.')
                             .'</p>');
       } elsif($fn=~/\.(\w+)$/ && 
                       !defined(&Apache::loncommon::fileembstyle($1))) {
                   $r->print('<p class="LC_error">'
                            .&mt('The extension on this file, [_1], is not recognized by LON-CAPA.',
                                 '<span class="LC_filename">'.$1.'</span>')
                            .' <br />'.&mt('Please change the extension.')
                            .'</p>');
     }      }
 }  }
   
 sub phasetwo {  sub phasetwo {
     my ($r,$tfn,$uname,$udom,$mode)=@_;      my ($r,$fn,$mode)=@_;
   
       my $output;
     my $action = '/adm/upload';      my $action = '/adm/upload';
     my $returnflag = '';      my $returnflag = '';
     if ($mode eq 'testbank') {      if ($mode eq 'testbank') {
Line 148  sub phasetwo { Line 282  sub phasetwo {
     } elsif ($mode eq 'imsimport') {      } elsif ($mode eq 'imsimport') {
         $action = '/adm/imsimport';          $action = '/adm/imsimport';
     }      }
     my $fn='/priv/'.$uname.'/'.$tfn;  
     $fn=~s/\/+/\//g;      $fn=~s/\/+/\//g;
     &Debug($r, "Filename is ".$tfn);      if ($fn) {
     if ($tfn) {   my $target= $r->dir_config('lonDocRoot').'/'.$fn;
  &Debug($r, "Filename for tfn = ".$tfn);  
  my $target='/home/'.$uname.'/public_html'.$tfn;  
  &Debug($r, "target -> ".$target);   &Debug($r, "target -> ".$target);
 #     target is the full filesystem path of the destination file.  #     target is the full filesystem path of the destination file.
  my $base = &File::Basename::basename($fn);   my $base = &File::Basename::basename($fn);
  my $path = &File::Basename::dirname($fn);   my $path = &File::Basename::dirname($fn);
  $base    = &HTML::Entities::encode($base,'<>&"');   $base    = &HTML::Entities::encode($base,'<>&"');
  my $url  = $path."/".$base;    my $url  = $path."/".$base;
  &Debug($r, "URL is now ".$url);   &Debug($r, "URL is now ".$url);
  my $datatoken=$env{'form.datatoken'};   my $datatoken;
           if ($env{'form.datatoken'} =~ /^$match_username\_$match_domain\_upload_\w*_\d+_\d+$/) {
               $datatoken = $env{'form.datatoken'};
           }
  if (($fn) && ($datatoken)) {   if (($fn) && ($datatoken)) {
     if ((-e $target) && ($env{'form.override'} ne 'Yes')) {              if ($env{'form.cancel'}) {
  $r->print('<form action="'.$action.'" method="post">'.                  my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';
   &mt('File').' <tt>'.$fn.'</tt> '.                  my $dirpath=$path.'/';
   &mt('exists. Overwrite?').' '.                  $dirpath=~s/\/+/\//g;
   '<input type="hidden" name="phase" value="two" />'.                  $output .= '<p class="LC_warning">'.&mt('Upload cancelled.').'</p>'
   '<input type="hidden" name="filename" value="'."$url".'" />'.                            .'<p><a href="'.$dirpath.'">'.
   '<input type="hidden" name="datatoken" value="'.$datatoken.'" />'.                            &mt('Back to Directory').'</a></p>';
   '<input type="submit" name="override" value="'.&mt('Yes').'" /></form>');              } elsif ((-e $target) && (!$env{'form.override'})) {
     } else {                  $output .= '<form action="'.$action.'" method="post">'
                             .'<p class="LC_warning">'
                             .&mt('File [_1] already exists.',
                                  '<span class="LC_filename">'.$fn.'</span>')
                            .'<input type="hidden" name="phase" value="two" />'
                            .'<input type="hidden" name="filename" value="'.$url.'" />'
                            .'<input type="hidden" name="datatoken" value="'.$datatoken.'" />'
                            .'<p>'
                            .'<input type="submit" name="cancel" value="'.&mt('Cancel').'" />'
                            .' <input type="submit" name="override" value="'.&mt('Overwrite').'" />'
                            .'</p>'
                            .'</form>';
               } else {
  my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';   my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';
  my $dirpath=$path.'/';   my $dirpath=$path.'/';
  $dirpath=~s/\/+/\//g;   $dirpath=~s/\/+/\//g;
  # Check for bad extension and disallow upload   # Check for bad extension and disallow upload
  if ($fn=~/\.(\w+)$/ &&                   my $result;
     (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {                  ($result,$returnflag) = &check_extension($fn,$mode,$source,$target,$action,$dirpath,$url);
     $r->print(&mt('File').' <tt>'.$fn.'</tt> '.                  $output .= $result;
       &mt('could not be copied.').'<br />'.  
       '<font color="red">'.  
       &mt('The extension on this file is reserved internally by LON-CAPA.').  
       '</font>');  
     $r->print('<br /><font size=+2><a href="'.$dirpath.'">'.  
       &mt('Back to Directory').'</a></font>');  
  } elsif ($fn=~/\.(\w+)$/ &&   
  !defined(&Apache::loncommon::fileembstyle($1))) {  
     $r->print(&mt('File').' <tt>'.$fn.'</tt> '.  
       &mt('could not be copied.').'<br />'.  
       '<font color="red">'.  
       &mt('The extension on this file is not recognized by LON-CAPA.').  
       '</font>');  
     $r->print('<br /><font size="+2"><a href="'.$dirpath.'">'.  
       &mt('Back to Directory').'</a></font>');  
  } elsif (-d $target) {  
     $r->print('File <tt>'.$fn.'</tt> could not be copied.<br />'.  
       '<font color="red">'.  
       &mt('The target is an existing directory.').  
       '</font><br />');  
     $r->print('<font size="+2"><a href="'.$dirpath.'">'.  
       &mt('Back to Directory').'</a></font>');  
  } elsif (copy($source,$target)) {  
     chmod(0660, $target); # Set permissions to rw-rw---.  
                     if ($mode eq 'testbank' || $mode eq 'imsimport') {  
                         $r->print(&mt("Your file - $fn - was uploaded successfully")."<br /><br />");  
                         $returnflag = 'ok';  
                     } else {  
                         $r->print(&mt('File copied.'));  
         $r->print('<br /><font size="+2"><a href="'.$url.'">'.  
       &mt('View file').'</a></font>');  
         $r->print('<br /><font size="+2"><a href="'.$dirpath.'">'.  
       &mt('Back to Directory').'</a></font><br />');  
                     }  
  } else {  
     $r->print('Failed to copy: '.$!);  
     $r->print('<br /><font size="+2"><a href="'.$path.'">'.  
       &mt('Back to Directory').'</a></font>');  
  }  
     }      }
  } else {   } else {
     $r->print('<font size="+1" color="red">'.      $output .= '<span class="LC_error">'.
       &mt('Please use browser "Back" button and pick a filename').        &mt('Please use browser "Back" button and pick a filename').
       '</font><br />');        '</span><br />';
  }   }
     } else {      } else {
  $r->print('<font size=+1 color=red>'.   $output .= '<span class="LC_error">'.
   &mt('Please use browser "Back" button and pick a filename').     &mt('Please use browser "Back" button and pick a filename').
   '</font><br />>');     '</span><br />';
       }
       return ($output,$returnflag);
   }
   
   sub check_extension {
       my ($fn,$mode,$source,$target,$action,$dirpath,$url) = @_;
       my ($result,$returnflag);
       # Check for bad extension and disallow upload
       if ($fn=~/\.(\w+)$/ &&
           (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
           $result .= '<p class="LC_warning">'.
                      &mt('File [_1] could not be copied.',
                          '<span class="LC_filename">'.$fn.'</span> ').
                      '<br />'.
                      &mt('The extension on this file is reserved internally by LON-CAPA.').
                      '</p>';
       } elsif ($fn=~/\.(\w+)$/ &&
                !defined(&Apache::loncommon::fileembstyle($1))) {
           $result .= '<p class="LC_warning">'.
                      &mt('File [_1] could not be copied.',
                          '<span class="LC_filename">'.$fn.'</span> ').
                      '<br />'.
                      &mt('The extension on this file is not recognized by LON-CAPA.').
                      '</p>';
       } elsif (-d $target) {
           $result .= '<p class="LC_warning">'.
                      &mt('File [_1] could not be copied.',
                          '<span class="LC_filename">'.$fn.'</span>').
                      '<br />'.
                      &mt('The target is an existing directory.').
                      '</p>';
       } elsif (copy($source,$target)) {
           chmod(0660, $target); # Set permissions to rw-rw---.
           if ($mode eq 'testbank' || $mode eq 'imsimport') {
               $returnflag = 'ok';
               $result .= '<p class="LC_success">'
                         .&mt('Your file - [_1] - was uploaded successfully.',
                              '<span class="LC_filename">'.$fn.'<span>')
                         .'</p>';
           } else {
               $result .= '<p class="LC_success">'
                         .&mt('File copied.')  
                         .'</p>';
           }
           # Check for embedded objects.
           my (%allfiles,%codebase);
           my ($text,$header,$css,$js);
           if (($mode ne 'imsimport') && ($target =~ /\.(htm|html|shtml)$/i)) {
               my (%allfiles,%codebase);
               &Apache::lonnet::extract_embedded_items($target,\%allfiles,\%codebase);
               if (keys(%allfiles) > 0) {
                   my ($currentpath) = ($url =~ m{^(.+)/[^/]+$});
                   my $state = &embedded_form_elems('upload_embedded',$url,$mode);
                   my ($embedded,$num,$pathchg) = 
                       &Apache::loncommon::ask_for_embedded_content($action,$state,\%allfiles,
                                                                    \%codebase,
                                                                    {'error_on_invalid_names'   => 1,
                                                                     'ignore_remote_references' => 1,
                                                                     'current_path'             => $currentpath});
                   if ($embedded) {
                       $result .= '<h3>'.&mt('Reference Warning').'</h3>';
                       if ($num) {
                           $result .= '<p>'.&mt('Completed upload of the file.').' '.&mt('This file contained references to other files.').'</p>'.
                                      '<p>'.&mt('Please select the locations from which the referenced files are to be uploaded.').'</p>'.
                                      $embedded;
                           if ($mode eq 'testbank') {
                               $returnflag = 'embedded';
                               $result .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without these files.','<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
                           }
                       } else {
                           $result .= '<p>'.&mt('Completed upload of the file.').'</p>'.$embedded;
                           if ($pathchg) {
                               if ($mode eq 'testbank') {
                                   $returnflag = 'embedded';
                                   $result .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).','<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
                               }
                           }
                       }
                   }
               }
           }
           if (($mode ne 'imsimport') && ($mode ne 'testbank')) {
               $result .= '<br /><a href="'.$url.'">'.
                           &mt('View file').'</a>';
           }
       } else {
           $result .= &mt('Failed to copy: [_1].',$!);
       }
       if ($mode ne 'imsimport' && $mode ne 'testbank') {
           $result .= '<br /><a href="'.$dirpath.'">'.
                      &mt('Back to Directory').'</a><br />';
       }
       return ($result,$returnflag);
   }
   
   sub check_filename {
       my ($fname) = @_;
       my $warning;
       if ($fname =~/[#\?&%":<>`|]/) {
           $fname =~s/[#\?&%":<>`|]//g;
           $warning .= '<p class="LC_warning">'
                      .&mt('Removed one or more disallowed characters from filename')
                      .'</p>';
       }
       if ($fname=~ /\.(\d+)\.(\w+)$/) {
           my $num = $1;
           $warning .= '<p class="LC_warning">'
                      .&mt('Bad filename [_1]','<span class="LC_filename">'.$fname.'</span>')
                      .'<br />'
                      .&mt('[_1](name).(number).(extension)[_2] not allowed.','<tt>','</tt>')
                      .'<br />'
                      .&mt('Replacing the [_1].number.[_2] with [_1]_letter.[_2] in requested filename.','<tt>','</tt>')
                      .'</p>';
           if ($num eq '0') {
               $fname =~ s/\.(\d+)(\.\w+)$/_A$2/;
           } else {
               my $letts = '';
               my %digletter = reverse &Apache::lonnet::letter_to_digits();
               if ($num >= 100) {
                   $num = substr($num,-2);
               }
               foreach my $digit (split('',$num)) {
                   $letts .= $digletter{$digit};
               }
               $fname =~ s/\.(\d+)(\.\w+)$/_$letts$2/;
           }
       }
       if ($fname =~/___/) {
           $fname =~s/_+/_/g;
           $warning .= '<p class="LC_warning">'
                       .&mt('Changed ___ to a single _ in filename')
                       .'</p>';
       }
       return ($fname,$warning);
   }
   
   sub phasethree {
       my ($r,$fn,$uname,$udom,$mode) = @_;
   
       my $action = '/adm/upload'; 
       if ($mode eq 'testbank') {
           $action = '/adm/testbank';
       } elsif ($mode eq 'imsimport') {
           $action = '/adm/imsimport';
       }
       my $url_root = "/priv/$udom/$uname";
       my $dir_root = $r->dir_config('lonDocRoot').$url_root;
       my $path = &File::Basename::dirname($fn);
       $path =~ s{^\Q$url_root\E}{};
       my $dirpath = $url_root.$path.'/';
       $dirpath=~s{/+}{/}g;
       my $filename = &HTML::Entities::encode($env{'form.filename'},'<>&"');
       my $state = &embedded_form_elems('modify_orightml',$filename,$mode).
                   '<input type="hidden" name="phase" value="four" />';
       my ($result,$returnflag) = 
           &Apache::loncommon::upload_embedded($mode,$path,$uname,$udom,
                                               $dir_root,$url_root,undef,
                                               undef,undef,$state,$action);
       if ($mode ne 'imsimport' && $mode ne 'testbank') {
           $result .= '<br /><h3><a href="'.$fn.'">'.
                     &mt('View main file').'</a></h3>'.
                     '<h3><a href="'.$dirpath.'">'.
                     &mt('Back to Directory').'</a></h3><br />';
       }
       return ($result,$returnflag);
   }
   
   sub embedded_form_elems {
       my ($action,$filename,$mode) = @_;
       return <<STATE;
       <input type="hidden" name="action" value="$action" />
       <input type="hidden" name="mode" value="$mode" />
       <input type="hidden" name="filename" value="$filename" />
   STATE
   }
   
   sub phasefour {
       my ($r,$fn,$uname,$udom,$mode) = @_;
   
       my $action = '/adm/upload';
       if ($mode eq 'testbank') {
           $action = '/adm/testbank';
       } elsif ($mode eq 'imsimport') {
           $action = '/adm/imsimport';
       }
       my $result;
       my $url_root = "/priv/$udom/$uname";
       my $dir_root = $r->dir_config('lonDocRoot').$url_root;
       my $path = &File::Basename::dirname($fn);
       $path =~ s{^\Q$url_root\E}{};
       my $dirpath = $url_root.$path.'/';
       $dirpath=~s{/+}{/}g;
       my $outcome = 
           &Apache::loncommon::modify_html_refs($mode,$path,$uname,$udom,$dir_root);
       $result .= $outcome;
       if ($mode ne 'imsimport' && $mode ne 'testbank') {
           $result .= '<br /><h3><a href="'.$fn.'">'.
                     &mt('View main file').'</a></h3>'.
                     '<h3><a href="'.$dirpath.'">'.
                     &mt('Back to Directory').'</a></h3><br />';
       }
       return $result;
   }
   
   sub earlyout {
       my ($fn,$uname,$udom) = @_;
       if ($fn =~ m{^(/priv/$udom/$uname(?:.*)/)[^/]*}) {
           return &Apache::lonhtmlcommon::actionbox(
                  ['<a href="'.$1.'">'.&mt('Return to Directory').'</a>']);
     }      }
     return $returnflag;      return;
 }  }
   
 # ---------------------------------------------------------------- Main Handler  # ---------------------------------------------------------------- Main Handler
 sub handler {  sub handler {
   
     my $r=shift;      my $r=shift;
   
     my $uname;  
     my $udom;  
     my $javascript = '';      my $javascript = '';
 #      my $fn;
 # phase two: re-attach user      my $warning;
 #  
     if ($env{'form.uploaduname'}) {      if ($env{'form.filename1'}) {
  $env{'form.filename'}='/priv/'.$env{'form.uploaduname'}.'/'.          my $fn1 = $env{'form.filename1'};
     $env{'form.filename'};          my $fn2 = $env{'form.filename2'};
           $fn2 =~ s/(\s+$|^\s+)//g;
           $fn2 =~ s/\/+/\//g;
           ($fn2,$warning) = &check_filename($fn2);
           $fn = $fn1.$fn2;
       } else {
           $fn = $env{'form.filename'};
     }      }
       $fn=~s/\/+/\//g;
       if ($fn =~ m{/\.\./}) {
           $warning .= '<p class="LC_warning">'
                      .&mt('Path modified as a result of one or more instances of /../')
                      .'</p>';
           while ($fn =~ m{/\.\./}) {
               $fn =~ s{/[^/]+/\.\./}{/}g;
           }
       }
   
       unless ($fn) {
           $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
                          ' unspecified filename for upload', $r->filename);
           return HTTP_NOT_FOUND;
       }
   
       my ($uname,$udom)=&Apache::lonnet::constructaccess($fn);
   
       unless (($uname) && ($udom)) {
           $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
                          ' trying to upload file '.$fn.
                          ' - not authorized',
                          $r->filename);
           return HTTP_NOT_ACCEPTABLE;
       }
   
   # ----------------------------------------------------------- Start page output
   
       &Apache::loncommon::content_type($r,'text/html');
       $r->send_http_header;
   
     unless ($env{'form.phase'} eq 'two') {      unless ($env{'form.phase'} eq 'two') {
         $javascript = qq|          $javascript = <<"ENDJS";
   <script type="text/javascript">
   // <![CDATA[
 function verifyForm() {  function verifyForm() {
     var mode = document.fileupload.filetype.options[document.fileupload.filetype.selectedIndex].value      var mode = document.fileupload.filetype.options[document.fileupload.filetype.selectedIndex].value
     if (mode == "testbank") {      if (mode == "testbank") {
Line 263  function verifyForm() { Line 614  function verifyForm() {
     }      }
     document.fileupload.submit();      document.fileupload.submit();
 }  }
   // ]]>
 function testbankWin() {  </script>
   newWindow = window.open("","testbankinfo","HEIGHT=400,WIDTH=750,scrollbars=yes")  ENDJS
   newWindow.document.open()      }
   newWindow.document.write("<html><head><title>'Importing a Testbank file into LON-CAPA</title><meta http-equiv='pragma' content='no-cache'>\\n")  
   newWindow.document.write("</head><body bgcolor='#CCFFDD' topmargin='0' leftmargin='0' marginheight='0'marginwidth='0' rightmargin='0'>\\n")      my $londocroot = $r->dir_config('lonDocRoot');
   newWindow.document.write("<img border='0' src='/adm/lonInterFace/author.jpg' alt='[Author Header]'>\\n")      my $trailfile = $fn;
   newWindow.document.write("<table border='0' cellspacing='0' cellpadding='0' width='95%' bgcolor='#CCFFDD'>\\n")      $trailfile =~ s{^/(priv/)}{$londocroot/$1};
   newWindow.document.write("<tr><td width='2'>&nbsp;</td><td width='3'>&nbsp;</td>\\n")  
   newWindow.document.write("<td><font face='arial,helvetica,sans-serif'><h3>Importing Testbank questions into LON-CAPA</h3>")      # Breadcrumbs
   newWindow.document.write("<font face='arial,helvetica,sans-serif'><br />Four requirements must be met to ensure that you will succeed in building LON-CAPA problem files using your plain text file containing testbank questions.")      my $text = 'Authoring Space';
   newWindow.document.write("<ol><li>The questions and answers you upload must be in plain text format.  Any header lines should occur before the text containing the questions and answers.</li>")      my $href = &Apache::loncommon::authorspace($fn);
   newWindow.document.write("<li>All questions must occur before any of the answers.  Each question should be numbered sequentially using a number followed immediately by a space, a period, or enclosed in parentheses, i.e., 1 , 1., (1), 1), or (1 .</li>")      my $crsauthor;
    newWindow.document.write("<li>One or more correct answers should be provided for all questions (although blank answers may be provided for <i>essay</i> questions).  Answers should be numbered sequentially, using the same scheme as used for the questions, and must occur after all the questions.")      if ($env{'request.course.id'}) {
     newWindow.document.write("<li><i>Multiple choice</i> and <i>multiple answer correct</i> questions should consist of (i) the question number followed by (ii) a question stem beginning on the same line and (iii) two or more foils, with each foil beginning on a new line and prefixed by a unique letter, or Roman numeral, listed in alphabetic or numeric order, beginning at a (alphabetic) or i (Roman numeral), followed by a period, or enclosed in parentheses, i.e., a., (a), i., or (i) .</li>")          my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
      newWindow.document.write("<li>If <i>fill-in-the-blank</i> or <i>multiple answer</i> questions have more than one correct answer, each answer should appear in a comma-, tab-, space-, or new line-delimited list. </li></ol>")          my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
   newWindow.document.write("</td></tr>\\n")          if ($href eq "/priv/$cdom/$cnum/") {
   newWindow.document.write("</table></body></html>")              $text = 'Course Authoring Space';
   newWindow.document.close()              $crsauthor = 1;
   newWindow.focus()          }
 }      }
 |;      my $brcrum = [{'href' => $href,
     }                     'text' => $text},
     ($uname,$udom)=                    {'href' => '/adm/upload',
  &Apache::loncacc::constructaccess($env{'form.filename'},                     'text' => 'Upload file to '.$text}];
   $r->dir_config('lonDefDomain'));      $r->print(&Apache::loncommon::start_page('Upload file to '.$text,
     unless (($uname) && ($udom)) {                                               $javascript,
  $r->log_reason($uname.' at '.$udom.                                               {'bread_crumbs' => $brcrum,})
        ' trying to publish file '.$env{'form.filename'}.               .&Apache::loncommon::head_subbox(
        ' - not authorized',                   &Apache::loncommon::CSTR_pageheader($trailfile))
        $r->filename);       );
  return HTTP_NOT_ACCEPTABLE;  
     }      unless ($crsauthor) {
               if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
     my $fn;              $r->print('<p class="LC_info">'
     if ($env{'form.filename'}) {                       .&mt('Co-Author [_1]',$uname.':'.$udom)
  $fn=$env{'form.filename'};                       .'</p>'
  $fn=~s/^http\:\/\/[^\/]+\///;              );
  $fn=~s/^\///;          }
  $fn=~s/(\~|priv\/)(\w+)//;      }
  $fn=~s/\/+/\//g;      if ($warning) {
           $r->print($warning);
       }
       if ($env{'form.phase'} eq 'four') {
           my $output = &phasefour($r,$fn,$uname,$udom,'author');
           $r->print($output);
       } elsif ($env{'form.phase'} eq 'three') {
           my ($output,$rtnflag) = &phasethree($r,$fn,$uname,$udom,'author');
           $r->print($output);
       } elsif ($env{'form.phase'} eq 'two') {
    my ($output,$returnflag) = &phasetwo($r,$fn);
           $r->print($output);
     } else {      } else {
  $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.   &phaseone($r,$fn,undef,$uname,$udom);
        ' unspecified filename for upload', $r->filename);   
  return HTTP_NOT_FOUND;  
     }  
   
 # ----------------------------------------------------------- Start page output  
   
   
     &Apache::loncommon::content_type($r,'text/html');  
     $r->send_http_header;  
   
     $r->print("<html><head><title>LON-CAPA Construction Space</title><script type=\"text/javascript\">\n//<!--\n$javascript\n// --></script>\n</head>");  
   
     $r->print(&Apache::loncommon::bodytag('Upload file to Construction Space'));  
     
     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {  
  $r->print('<h3><font color=red>'.&mt('Co-Author').': '.$uname.  
   &mt(' at ').$udom.'</font></h3>');  
     }      }
   
     if ($env{'form.phase'} eq 'two') {      $r->print(&Apache::loncommon::end_page());
  &phasetwo($r,$fn,$uname,$udom);      return OK;
     } else {  
  &phaseone($r,$fn,$uname,$udom);  
     }  
   
     $r->print('</body></html>');  
     return OK;    
 }  }
   
 1;  1;
 __END__  __END__
   
 =head1 NAME  
   
 Apache::lonupload - upload files into construction space  
   
 =head1 SYNOPSIS  
   
 Invoked by /etc/httpd/conf/srm.conf:  
   
  <Location /adm/upload>  
  PerlAccessHandler       Apache::lonacc  
  SetHandler perl-script  
  PerlHandler Apache::lonupload  
  ErrorDocument     403 /adm/login  
  ErrorDocument     404 /adm/notfound.html  
  ErrorDocument     406 /adm/unauthorized.html  
  ErrorDocument  500 /adm/errorhandler  
  </Location>  
   
 =head1 INTRODUCTION  
   
 This module uploads a file sitting on a client computer into   
 library server construction space.  
   
 This is part of the LearningOnline Network with CAPA project  
 described at http://www.lon-capa.org.  
   
 =head1 HANDLER SUBROUTINE  
   
 This routine is called by Apache and mod_perl.  
   
 =over 4  
   
 =item *  
   
 Initialize variables  
   
 =item *  
   
 Start page output  
   
 =item *  
   
 output relevant interface phase (phaseone or phasetwo)  
   
 =item *  
   
 (phase one is to specify upload file; phase two is to handle conditions  
 subsequent to specification--like overwriting an existing file)  
   
 =back  
   
 =head1 OTHER SUBROUTINES  
   
 =over 4  
   
 =item *  
   
 phaseone() : Interface for specifying file to upload.  
   
 =item *  
   
 phasetwo() : Interface for handling post-conditions about uploading (such  
 as overwriting an existing file).  
   
 =item *  
   
 upfile_store() : Store contents of uploaded file into temporary space.  Invoked  
 by phaseone subroutine.  
   
 =back  
   
 =cut  
Removed from v.1.30  
changed lines
  Added in v.1.71

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