Return to lonupload.pm CVS log

Up to [LON-CAPA] / loncom / publisher

- switch Store to Save

    1: 
    2: # The LearningOnline Network with CAPA
    3: # Handler to upload files into construction space
    4: #
    5: # $Id: lonupload.pm,v 1.35 2007/05/02 01:34:23 albertel Exp $
    6: #
    7: # Copyright Michigan State University Board of Trustees
    8: #
    9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   10: #
   11: # LON-CAPA is free software; you can redistribute it and/or modify
   12: # it under the terms of the GNU General Public License as published by
   13: # the Free Software Foundation; either version 2 of the License, or
   14: # (at your option) any later version.
   15: #
   16: # LON-CAPA is distributed in the hope that it will be useful,
   17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   19: # GNU General Public License for more details.
   20: #
   21: # You should have received a copy of the GNU General Public License
   22: # along with LON-CAPA; if not, write to the Free Software
   23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   24: #
   25: # /home/httpd/html/adm/gpl.txt
   26: #
   27: # http://www.lon-capa.org/
   28: #
   29: ###
   30: 
   31: package Apache::lonupload;
   32: 
   33: use strict;
   34: use Apache::File;
   35: use File::Copy;
   36: use File::Basename;
   37: use Apache::Constants qw(:common :http :methods);
   38: use Apache::loncacc;
   39: use Apache::loncommon();
   40: use Apache::lonnet;
   41: use HTML::Entities();
   42: use Apache::lonlocal;
   43: use Apache::lonnet;
   44: use LONCAPA();
   45: 
   46: my $DEBUG=0;
   47: 
   48: sub Debug {
   49:     # Put out the indicated message but only if DEBUG is true.
   50:     if ($DEBUG) {
   51: 	my ($r,$message) = @_;
   52: 	$r->log_reason($message);
   53:     }
   54: }
   55: 
   56: sub upfile_store {
   57:     my $r=shift;
   58: 	
   59:     my $fname=$env{'form.upfile.filename'};
   60:     $fname=~s/\W//g;
   61:     
   62:     chomp($env{'form.upfile'});
   63:   
   64:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
   65: 		  '_upload_'.$fname.'_'.time.'_'.$$;
   66:     {
   67:        my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
   68:                                    '/tmp/'.$datatoken.'.tmp');
   69:        print $fh $env{'form.upfile'};
   70:     }
   71:     return $datatoken;
   72: }
   73: 
   74: 
   75: sub phaseone {
   76:     my ($r,$fn,$uname,$udom,$mode)=@_;
   77:     my $action = '/adm/upload';
   78:     if ($mode eq 'testbank') {
   79:         $action = '/adm/testbank';
   80:     } elsif ($mode eq 'imsimport') {
   81:         $action = '/adm/imsimport';
   82:     }
   83:     $env{'form.upfile.filename'}=~s/\\/\//g;
   84:     $env{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/;
   85:     if ($env{'form.upfile.filename'}) {
   86: 	$fn=~s/\/[^\/]+$//;
   87: 	$fn=~s/([^\/])$/$1\//;
   88: 	$fn.=$env{'form.upfile.filename'};
   89: 	$fn=~s/^\///;
   90: 	$fn=~s/(\/)+/\//g;
   91: 
   92: #    Fn is the full path to the destination filename.
   93: #    
   94: 
   95: 	&Debug($r, "Filename for upload: $fn");
   96: 	if (($fn) && ($fn!~/\/$/)) {
   97: 	    $r->print('<form action="'.$action.'" method="post" name="fileupload">'.
   98: 		      '<input type="hidden" name="phase" value="two" />'.
   99: 		      '<input type="hidden" name="datatoken" value="'.
  100: 		      &upfile_store.'" />'.
  101: 		      '<input type="hidden" name="uploaduname" value="'.$uname.
  102: 		      '" />'.&mt('Save uploaded file as ').
  103:                       "<span class='LC_filename'>/priv/$uname/</span>".
  104:                       '<input type="text" size="50" name="filename" value="'.$fn.
  105:                       '" /><br />'.
  106: 		      '<br />'.&mt('Choose file type:').'
  107: <select name="filetype">
  108:  <option value="standard" selected>'.&mt('Regular file').'
  109:  <option value="testbank">'.&mt('Testbank file').'
  110:  <option value="imsimport">'.&mt('IMS package').'
  111: </select>'.&Apache::loncommon::help_open_topic("Uploading_File_Options").'
  112: <br />
  113: <br />
  114: ');
  115:             $r->print('<input type="button" value="'.&mt('Save').'" onClick="javascript:verifyForm()"/></form>');
  116: 	    # Check for bad extension and warn user
  117: 	    if ($fn=~/\.(\w+)$/ && 
  118: 		(&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
  119: 		$r->print('<span class="LC_error">'.&mt('The extension on this file,').
  120: 			  ' "'.$1.'"'.&mt(', is reserved internally by LON-CAPA.').
  121: 			  ' <br />'.&mt('Please change the extension.').'</span>');
  122: 	    } elsif($fn=~/\.(\w+)$/ && 
  123: 		    !defined(&Apache::loncommon::fileembstyle($1))) {
  124: 		$r->print('<span class="LC_error">'.&mt('The extension on this file,').
  125: 			  ' "'.$1.'"'.&mt(', is not recognized by LON-CAPA.').
  126: 			  ' <br />'.&mt('Please change the extension.').
  127: 			  '</span>');
  128: 	    }
  129: 	} else {
  130: 	    $r->print('<span class="LC_error">'.&mt('Illegal filename.').'</span>');
  131: 	}
  132:     } else {
  133: 	$r->print('<span class="LC_error">'.&mt('No upload file specified.').'</span>');
  134:     }
  135: }
  136: 
  137: sub phasetwo {
  138:     my ($r,$tfn,$uname,$udom,$mode)=@_;
  139:     my $action = '/adm/upload';
  140:     my $returnflag = '';
  141:     if ($mode eq 'testbank') {
  142:         $action = '/adm/testbank';
  143:     } elsif ($mode eq 'imsimport') {
  144:         $action = '/adm/imsimport';
  145:     }
  146:     my $fn='/priv/'.$uname.'/'.$tfn;
  147:     $fn=~s/\/+/\//g;
  148:     &Debug($r, "Filename is ".$tfn);
  149:     if ($tfn) {
  150: 	&Debug($r, "Filename for tfn = ".$tfn);
  151: 	my $target='/home/'.$uname.'/public_html'.$tfn;
  152: 	&Debug($r, "target -> ".$target);
  153: #     target is the full filesystem path of the destination file.
  154: 	my $base = &File::Basename::basename($fn);
  155: 	my $path = &File::Basename::dirname($fn);
  156: 	$base    = &HTML::Entities::encode($base,'<>&"');
  157: 	my $url  = $path."/".$base; 
  158: 	&Debug($r, "URL is now ".$url);
  159: 	my $datatoken=$env{'form.datatoken'};
  160: 	if (($fn) && ($datatoken)) {
  161: 	    if ((-e $target) && ($env{'form.override'} ne 'Yes')) {
  162: 		$r->print('<form action="'.$action.'" method="post">'.
  163: 			  &mt('File').' <span class="LC_filename">'.$fn.'</span> '.
  164: 			  &mt('exists. Overwrite?').' '.
  165: 			  '<input type="hidden" name="phase" value="two" />'.
  166: 			  '<input type="hidden" name="filename" value="'."$url".'" />'.
  167: 			  '<input type="hidden" name="datatoken" value="'.$datatoken.'" />'.
  168: 			  '<input type="submit" name="override" value="'.&mt('Yes').'" /></form>');
  169: 	    } else {
  170: 		my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';
  171: 		my $dirpath=$path.'/';
  172: 		$dirpath=~s/\/+/\//g;
  173: 		# Check for bad extension and disallow upload
  174: 		if ($fn=~/\.(\w+)$/ && 
  175: 		    (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
  176: 		    $r->print(&mt('File').' <span class="LC_filename">'.$fn.'</span> '.
  177: 			      &mt('could not be copied.').'<br />'.
  178: 			      '<span class="LC_error">'.
  179: 			      &mt('The extension on this file is reserved internally by LON-CAPA.').
  180: 			      '</span>');
  181: 		    $r->print('<br /><font size=+2><a href="'.$dirpath.'">'.
  182: 			      &mt('Back to Directory').'</a></font>');
  183: 		} elsif ($fn=~/\.(\w+)$/ && 
  184: 			 !defined(&Apache::loncommon::fileembstyle($1))) {
  185: 		    $r->print(&mt('File').' <span class="LC_filename">'.$fn.'</span> '.
  186: 			      &mt('could not be copied.').'<br />'.
  187: 			      '<span class="LC_error">'.
  188: 			      &mt('The extension on this file is not recognized by LON-CAPA.').
  189: 			      '</span>');
  190: 		    $r->print('<br /><font size="+2"><a href="'.$dirpath.'">'.
  191: 			      &mt('Back to Directory').'</a></font>');
  192: 		} elsif (-d $target) {
  193: 		    $r->print('File <span class="LC_filename">'.$fn.'</span> could not be copied.<br />'.
  194: 			      '<span class="LC_error">'.
  195: 			      &mt('The target is an existing directory.').
  196: 			      '</span><br />');
  197: 		    $r->print('<font size="+2"><a href="'.$dirpath.'">'.
  198: 			      &mt('Back to Directory').'</a></font>');
  199: 		} elsif (copy($source,$target)) {
  200: 		    chmod(0660, $target); # Set permissions to rw-rw---.
  201:                     if ($mode eq 'testbank' || $mode eq 'imsimport') {
  202:                         $r->print(&mt("Your file - $fn - was uploaded successfully")."<br /><br />");
  203:                         $returnflag = 'ok';
  204:                     } else {
  205:                         $r->print(&mt('File copied.'));
  206: 		        $r->print('<br /><font size="+2"><a href="'.$url.'">'.
  207: 			      &mt('View file').'</a></font>');
  208: 		        $r->print('<br /><font size="+2"><a href="'.$dirpath.'">'.
  209: 			      &mt('Back to Directory').'</a></font><br />');
  210:                     }
  211: 		} else {
  212: 		    $r->print('Failed to copy: '.$!);
  213: 		    $r->print('<br /><font size="+2"><a href="'.$path.'">'.
  214: 			      &mt('Back to Directory').'</a></font>');
  215: 		}
  216: 	    }
  217: 	} else {
  218: 	    $r->print('<span class="LC_error">'.
  219: 		      &mt('Please use browser "Back" button and pick a filename').
  220: 		      '</span><br />');
  221: 	}
  222:     } else {
  223: 	$r->print('<span class="LC_error">'.
  224: 		  &mt('Please use browser "Back" button and pick a filename').
  225: 		  '</span><br />>');
  226:     }
  227:     return $returnflag;
  228: }
  229: 
  230: # ---------------------------------------------------------------- Main Handler
  231: sub handler {
  232: 
  233:     my $r=shift;
  234: 
  235:     my $uname;
  236:     my $udom;
  237:     my $javascript = '';
  238: #
  239: # phase two: re-attach user
  240: #
  241:     if ($env{'form.uploaduname'}) {
  242: 	$env{'form.filename'}='/priv/'.$env{'form.uploaduname'}.'/'.
  243: 	    $env{'form.filename'};
  244:     }
  245: 
  246:     unless ($env{'form.phase'} eq 'two') {
  247: 	my %body_layout = ('rightmargin'  => "0",
  248: 			   'leftmargin'   => "0",
  249: 			   'marginwidth'  => "0",
  250: 			   'topmargin'    => "0",
  251: 			   'marginheight' => "0");
  252: 	my $start_page = 
  253: 	    &Apache::loncommon::start_page('Importing a Testbank file into LON-CAPA',
  254: 					   undef,
  255: 					   {'only_body'   => 1,
  256: 					    'add_entries' => \%body_layout,
  257: 					    'js_ready'    => 1,});
  258: 	my $end_page = 
  259: 	    &Apache::loncommon::end_page({'js_ready' => 1,});
  260: 
  261:         $javascript = qq|
  262: function verifyForm() {
  263:     var mode = document.fileupload.filetype.options[document.fileupload.filetype.selectedIndex].value
  264:     if (mode == "testbank") {
  265:         document.fileupload.action = "/adm/testbank";
  266:     }
  267:     if (mode == "imsimport") {
  268:         document.fileupload.action = "/adm/imsimport";
  269:     }
  270:     if (mode == "standard") {
  271:         document.fileupload.action = "/adm/upload";
  272:     }
  273:     document.fileupload.submit();
  274: }
  275: 	|;
  276:     }
  277:     ($uname,$udom)=
  278: 	&Apache::loncacc::constructaccess($env{'form.filename'},
  279: 					  $r->dir_config('lonDefDomain'));
  280:     unless (($uname) && ($udom)) {
  281: 	$r->log_reason($uname.' at '.$udom.
  282: 		       ' trying to publish file '.$env{'form.filename'}.
  283: 		       ' - not authorized', 
  284: 		       $r->filename); 
  285: 	return HTTP_NOT_ACCEPTABLE;
  286:     }
  287:     
  288:     my $fn;
  289:     if ($env{'form.filename'}) {
  290: 	$fn=$env{'form.filename'};
  291: 	$fn=~s/^http\:\/\/[^\/]+\///;
  292: 	$fn=~s/^\///;
  293: 	$fn=~s{(~|priv/)($LONCAPA::username_re)}{};
  294: 	$fn=~s/\/+/\//g;
  295:     } else {
  296: 	$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
  297: 		       ' unspecified filename for upload', $r->filename); 
  298: 	return HTTP_NOT_FOUND;
  299:     }
  300: 
  301: # ----------------------------------------------------------- Start page output
  302: 
  303: 
  304:     &Apache::loncommon::content_type($r,'text/html');
  305:     $r->send_http_header;
  306: 
  307:    $javascript = "<script type=\"text/javascript\">\n//<!--\n".
  308: 	$javascript."\n// --></script>\n";
  309: 
  310:     $r->print(&Apache::loncommon::start_page('Upload file to Construction Space',
  311: 					     $javascript));
  312:   
  313:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
  314: 	$r->print('<h3><font color=red>'.&mt('Co-Author').': '.$uname.
  315: 		  &mt(' at ').$udom.'</font></h3>');
  316:     }
  317: 
  318:     if ($env{'form.phase'} eq 'two') {
  319: 	&phasetwo($r,$fn,$uname,$udom);
  320:     } else {
  321: 	&phaseone($r,$fn,$uname,$udom);
  322:     }
  323: 
  324:     $r->print(&Apache::loncommon::end_page());
  325:     return OK;  
  326: }
  327: 
  328: 1;
  329: __END__
  330: 
  331: =head1 NAME
  332: 
  333: Apache::lonupload - upload files into construction space
  334: 
  335: =head1 SYNOPSIS
  336: 
  337: Invoked by /etc/httpd/conf/srm.conf:
  338: 
  339:  <Location /adm/upload>
  340:  PerlAccessHandler       Apache::lonacc
  341:  SetHandler perl-script
  342:  PerlHandler Apache::lonupload
  343:  ErrorDocument     403 /adm/login
  344:  ErrorDocument     404 /adm/notfound.html
  345:  ErrorDocument     406 /adm/unauthorized.html
  346:  ErrorDocument	  500 /adm/errorhandler
  347:  </Location>
  348: 
  349: =head1 INTRODUCTION
  350: 
  351: This module uploads a file sitting on a client computer into 
  352: library server construction space.
  353: 
  354: This is part of the LearningOnline Network with CAPA project
  355: described at http://www.lon-capa.org.
  356: 
  357: =head1 HANDLER SUBROUTINE
  358: 
  359: This routine is called by Apache and mod_perl.
  360: 
  361: =over 4
  362: 
  363: =item *
  364: 
  365: Initialize variables
  366: 
  367: =item *
  368: 
  369: Start page output
  370: 
  371: =item *
  372: 
  373: output relevant interface phase (phaseone or phasetwo)
  374: 
  375: =item *
  376: 
  377: (phase one is to specify upload file; phase two is to handle conditions
  378: subsequent to specification--like overwriting an existing file)
  379: 
  380: =back
  381: 
  382: =head1 OTHER SUBROUTINES
  383: 
  384: =over 4
  385: 
  386: =item *
  387: 
  388: phaseone() : Interface for specifying file to upload.
  389: 
  390: =item *
  391: 
  392: phasetwo() : Interface for handling post-conditions about uploading (such
  393: as overwriting an existing file).
  394: 
  395: =item *
  396: 
  397: upfile_store() : Store contents of uploaded file into temporary space.  Invoked
  398: by phaseone subroutine.
  399: 
  400: =back
  401: 
  402: =cut