loncom/publisher/lonupload.pm - view

File: [LON-CAPA] / loncom / publisher / lonupload.pm
Revision 1.49: download - view: text, annotated - select for diffs
Tue Feb 16 10:26:17 2010 UTC (14 years, 3 months ago) by bisitz
Branches: MAIN
CVS tags: version_2_9_99_0, version_2_10_0_RC1, PRINT_INCOMPLETE_base, PRINT_INCOMPLETE, HEAD

- Standard pick_box style for upload options
- Code refactoring: Early escape in case of no file and in case of illeagal filename
- "File already exists": optimized button arrangement and wording
- Problems due to user fault (invalid extension, existing file,  ...):
    - Warning style instead of error style
    - Wrap whole message in warning style
- Filename style for filenames
- Removed deprecated font tag

1: 2: # The LearningOnline Network with CAPA 3: # Handler to upload files into construction space 4: # 5: # $Id: lonupload.pm,v 1.49 2010/02/16 10:26:17 bisitz 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: =head1 NAME 32: 33: Apache::lonupload - upload files into construction space 34: 35: =head1 SYNOPSIS 36: 37: Invoked by /etc/httpd/conf/srm.conf: 38: 39: <Location /adm/upload> 40: PerlAccessHandler Apache::lonacc 41: SetHandler perl-script 42: PerlHandler Apache::lonupload 43: ErrorDocument 403 /adm/login 44: ErrorDocument 404 /adm/notfound.html 45: ErrorDocument 406 /adm/unauthorized.html 46: ErrorDocument 500 /adm/errorhandler 47: </Location> 48: 49: =head1 INTRODUCTION 50: 51: This module uploads a file sitting on a client computer into 52: library server construction space. 53: 54: This is part of the LearningOnline Network with CAPA project 55: described at http://www.lon-capa.org. 56: 57: =head1 HANDLER SUBROUTINE 58: 59: This routine is called by Apache and mod_perl. 60: 61: =over 4 62: 63: =item * 64: 65: Initialize variables 66: 67: =item * 68: 69: Start page output 70: 71: =item * 72: 73: output relevant interface phase (phaseone or phasetwo or phasethree) 74: 75: =item * 76: 77: (phase one is to specify upload file; phase two is to handle conditions 78: subsequent to specification--like overwriting an existing file; phase three 79: is to handle processing of secondary uploads - of embedded objects in an 80: html file). 81: 82: =back 83: 84: =head1 OTHER SUBROUTINES 85: 86: =over 87: 88: =item phaseone() 89: 90: Interface for specifying file to upload. 91: 92: =item phasetwo() 93: 94: Interface for handling post-conditions about uploading (such 95: as overwriting an existing file). 96: 97: =item phasethree() 98: 99: Interface for handling secondary uploads of embedded objects 100: in an html file. 101: 102: =item upfile_store() 103: 104: Store contents of uploaded file into temporary space. Invoked 105: by phaseone subroutine. 106: 107: =item check_extension() 108: 109: Checks if filename extension is permitted and checks type 110: of file - if html file, calls parser to check for embedded objects. 111: Invoked by phasetwo subroutine. 112: 113: =back 114: 115: =cut 116: 117: package Apache::lonupload; 118: 119: use strict; 120: use Apache::File; 121: use File::Copy; 122: use File::Basename; 123: use Apache::Constants qw(:common :http :methods); 124: use Apache::loncacc; 125: use Apache::loncommon(); 126: use Apache::lonnet; 127: use HTML::Entities(); 128: use Apache::lonlocal; 129: use Apache::lonnet; 130: use LONCAPA(); 131: 132: my $DEBUG=0; 133: 134: sub Debug { 135: # Put out the indicated message but only if DEBUG is true. 136: if ($DEBUG) { 137: my ($r,$message) = @_; 138: $r->log_reason($message); 139: } 140: } 141: 142: sub upfile_store { 143: my $r=shift; 144: 145: my $fname=$env{'form.upfile.filename'}; 146: $fname=~s/\W//g; 147: 148: chomp($env{'form.upfile'}); 149: 150: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}. 151: '_upload_'.$fname.'_'.time.'_'.$$; 152: { 153: my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons'). 154: '/tmp/'.$datatoken.'.tmp'); 155: print $fh $env{'form.upfile'}; 156: } 157: return $datatoken; 158: } 159: 160: sub phaseone { 161: my ($r,$fn,$uname,$udom,$mode)=@_; 162: my $action = '/adm/upload'; 163: if ($mode eq 'testbank') { 164: $action = '/adm/testbank'; 165: } elsif ($mode eq 'imsimport') { 166: $action = '/adm/imsimport'; 167: } 168: 169: # Check for file to be uploaded 170: $env{'form.upfile.filename'}=~s/\\/\//g; 171: $env{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/; 172: if (!$env{'form.upfile.filename'}) { 173: $r->print('<p class="LC_warning">'.&mt('No upload file specified.').'</p>'); 174: return; 175: } 176: 177: $fn=~s/\/[^\/]+$//; 178: $fn=~s/([^\/])$/$1\//; 179: $fn.=$env{'form.upfile.filename'}; 180: $fn=~s/^\///; 181: $fn=~s/(\/)+/\//g; 182: # Fn is the full path to the destination filename. 183: 184: # Check for illegal filename 185: &Debug($r, "Filename for upload: $fn"); 186: if (!(($fn) && ($fn!~/\/$/))) { 187: $r->print('<p class="LC_warning">'.&mt('Illegal filename.').'</p>'); 188: return; 189: } 190: 191: # Display additional options for upload 192: # and upload button 193: $r->print( 194: '<form action="'.$action.'" method="post" name="fileupload">' 195: .'<input type="hidden" name="phase" value="two" />' 196: .'<input type="hidden" name="datatoken" value="'.&upfile_store.'" />' 197: .'<input type="hidden" name="uploaduname" value="'.$uname.'" />' 198: ); 199: $r->print( 200: &Apache::lonhtmlcommon::start_pick_box() 201: .&Apache::lonhtmlcommon::row_title(&mt('Save uploaded file as')) 202: .'<span class="LC_filename">/priv/'.$uname.'/</span>' 203: .'<input type="text" size="50" name="filename" value="'.$fn.'" />' 204: .&Apache::lonhtmlcommon::row_closure() 205: .&Apache::lonhtmlcommon::row_title(&mt('File Type')) 206: .'<select name="filetype">' 207: .'<option value="standard" selected="selected">'.&mt('Regular file').'</option>' 208: .'<option value="testbank">'.&mt('Testbank file').'</option>' 209: .'<option value="imsimport">'.&mt('IMS package').'</option>' 210: .'</select>'.&Apache::loncommon::help_open_topic("Uploading_File_Options") 211: .&Apache::lonhtmlcommon::row_closure(1) 212: .&Apache::lonhtmlcommon::end_pick_box() 213: ); 214: $r->print( 215: '<p>' 216: .'<input type="button" value="'.&mt('Upload').'" onclick="javascript:verifyForm()"/>' 217: .'</p>' 218: .'</form>' 219: ); 220: 221: # Check for bad extension and warn user 222: if ($fn=~/\.(\w+)$/ && 223: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { 224: $r->print('<p class="LC_error">' 225: .&mt('The extension on this file, [_1], is reserved internally by LON-CAPA.', 226: '<span class="LC_filename">'.$1.'</span>') 227: .' <br />'.&mt('Please change the extension.') 228: .'</p>'); 229: } elsif($fn=~/\.(\w+)$/ && 230: !defined(&Apache::loncommon::fileembstyle($1))) { 231: $r->print('<p class="LC_error">' 232: .&mt('The extension on this file, [_1], is not recognized by LON-CAPA.', 233: '<span class="LC_filename">'.$1.'</span>') 234: .' <br />'.&mt('Please change the extension.') 235: .'</p>'); 236: } 237: } 238: 239: sub phasetwo { 240: my ($r,$tfn,$uname,$udom,$mode)=@_; 241: my $output; 242: my $action = '/adm/upload'; 243: my $returnflag = ''; 244: if ($mode eq 'testbank') { 245: $action = '/adm/testbank'; 246: } elsif ($mode eq 'imsimport') { 247: $action = '/adm/imsimport'; 248: } 249: my $fn='/priv/'.$uname.'/'.$tfn; 250: $fn=~s/\/+/\//g; 251: &Debug($r, "Filename is ".$tfn); 252: if ($tfn) { 253: &Debug($r, "Filename for tfn = ".$tfn); 254: my $target='/home/'.$uname.'/public_html'.$tfn; 255: &Debug($r, "target -> ".$target); 256: # target is the full filesystem path of the destination file. 257: my $base = &File::Basename::basename($fn); 258: my $path = &File::Basename::dirname($fn); 259: $base = &HTML::Entities::encode($base,'<>&"'); 260: my $url = $path."/".$base; 261: &Debug($r, "URL is now ".$url); 262: my $datatoken=$env{'form.datatoken'}; 263: if (($fn) && ($datatoken)) { 264: if ($env{'form.cancel'}) { 265: my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp'; 266: my $dirpath=$path.'/'; 267: $dirpath=~s/\/+/\//g; 268: $output .= '<p class="LC_warning">'.&mt('Upload cancelled.').'</p>' 269: .'<p><a href="'.$dirpath.'">'. 270: &mt('Back to Directory').'</a></p>'; 271: } elsif ((-e $target) && (!$env{'form.override'})) { 272: $output .= '<form action="'.$action.'" method="post">' 273: .'<p class="LC_warning">' 274: .&mt('File [_1] already exists.', 275: '<span class="LC_filename">'.$fn.'</span>') 276: .'<input type="hidden" name="phase" value="two" />' 277: .'<input type="hidden" name="filename" value="'.$url.'" />' 278: .'<input type="hidden" name="datatoken" value="'.$datatoken.'" />' 279: .'<p>' 280: .'<input type="submit" name="cancel" value="'.&mt('Cancel').'" />' 281: .' <input type="submit" name="override" value="'.&mt('Overwrite').'" />' 282: .'</p>' 283: .'</form>'; 284: } else { 285: my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp'; 286: my $dirpath=$path.'/'; 287: $dirpath=~s/\/+/\//g; 288: # Check for bad extension and disallow upload 289: my $result; 290: ($result,$returnflag) = &check_extension($fn,$mode,$source,$target,$action,$dirpath,$url); 291: $output .= $result; 292: } 293: } else { 294: $output .= '<span class="LC_error">'. 295: &mt('Please use browser "Back" button and pick a filename'). 296: '</span><br />'; 297: } 298: } else { 299: $output .= '<span class="LC_error">'. 300: &mt('Please use browser "Back" button and pick a filename'). 301: '</span><br />'; 302: } 303: return ($output,$returnflag); 304: } 305: 306: sub check_extension { 307: my ($fn,$mode,$source,$target,$action,$dirpath,$url) = @_; 308: my ($result,$returnflag); 309: # Check for bad extension and disallow upload 310: if ($fn=~/\.(\w+)$/ && 311: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { 312: $result .= '<p class="LC_warning">'. 313: &mt('File [_1] could not be copied.', 314: '<span class="LC_filename">'.$fn.'</span> '). 315: '<br />'. 316: &mt('The extension on this file is reserved internally by LON-CAPA.'). 317: '</p>'; 318: } elsif ($fn=~/\.(\w+)$/ && 319: !defined(&Apache::loncommon::fileembstyle($1))) { 320: $result .= '<p class="LC_warning">'. 321: &mt('File [_1] could not be copied.', 322: '<span class="LC_filename">'.$fn.'</span> '). 323: '<br />'. 324: &mt('The extension on this file is not recognized by LON-CAPA.'). 325: '</p>'; 326: } elsif (-d $target) { 327: $result .= '<p class="LC_warning">'. 328: &mt('File [_1] could not be copied.', 329: '<span class="LC_filename">'.$fn.'</span>'). 330: '<br />'. 331: &mt('The target is an existing directory.'). 332: '</p>'; 333: } elsif (copy($source,$target)) { 334: chmod(0660, $target); # Set permissions to rw-rw---. 335: if ($mode eq 'testbank' || $mode eq 'imsimport') { 336: $returnflag = 'ok'; 337: $result .= '<p class="LC_success">' 338: .&mt('Your file - [_1] - was uploaded successfully.', 339: '<span class="LC_filename">'.$fn.'<span>') 340: .'</p>'; 341: } else { 342: $result .= '<p class="LC_success">' 343: .&mt('File copied.') 344: .'</p>'; 345: } 346: # Check for embedded objects. 347: my (%allfiles,%codebase); 348: my ($text,$header,$css,$js); 349: if (($mode ne 'imsimport') && ($target =~ /\.(htm|html|shtml)$/i)) { 350: my (%allfiles,%codebase); 351: &Apache::lonnet::extract_embedded_items($target,\%allfiles,\%codebase); 352: if (keys(%allfiles) > 0) { 353: my $state = <<STATE; 354: <input type="hidden" name="action" value="upload_embedded" /> 355: <input type="hidden" name="currentpath" value="$env{'form.currentpath'}" /> 356: <input type="hidden" name="mode" value="$mode" /> 357: <input type="hidden" name="phase" value="three" /> 358: <input type="hidden" name="filename" value="$url" /> 359: STATE 360: $result .= "<h3>".&mt("Reference Warning")."</h3>". 361: "<p>".&mt("Completed upload of the file. This file contained references to other files.")."</p>". 362: "<p>".&mt("Please select the locations from which the referenced files are to be uploaded.")."</p>". 363: &Apache::loncommon::ask_for_embedded_content($action,$state,\%allfiles,\%codebase, 364: {'error_on_invalid_names' => 1, 365: 'ignore_remote_references' => 1,}); 366: if ($mode eq 'testbank') { 367: $returnflag = 'embedded'; 368: $result .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without these files','<a href="javascript:document.testbankForm.submit();">','</a>').'</p>'; 369: } 370: } 371: } 372: if (($mode ne 'imsimport') && ($mode ne 'testbank')) { 373: $result .= '<br /><a href="'.$url.'">'. 374: &mt('View file').'</a>'; 375: } 376: } else { 377: $result .= &mt('Failed to copy: [_1].',$!); 378: } 379: if ($mode ne 'imsimport' && $mode ne 'testbank') { 380: $result .= '<br /><a href="'.$dirpath.'">'. 381: &mt('Back to Directory').'</a><br />'; 382: } 383: return ($result,$returnflag); 384: } 385: 386: sub phasethree { 387: my ($r,$fn,$uname,$udom,$mode) = @_; 388: my $result; 389: my $dir_root = '/home/'.$uname.'/public_html'; 390: my $url_root = '/priv/'.$uname; 391: my $base = &File::Basename::basename($fn); 392: my $path = &File::Basename::dirname($fn); 393: $result = &Apache::loncommon::upload_embedded($mode,$path,$uname,$udom, 394: $dir_root,$url_root); 395: if ($mode ne 'imsimport' && $mode ne 'testbank') { 396: $result = '<br /><font size="+2"><a href="'.$url_root.$fn.'">'. 397: &mt('View main file').'</a></font>'. 398: '<br /><font size="+2"><a href="'.$url_root.$path.'">'. 399: &mt('Back to Directory').'</a></font><br />'; 400: } 401: return $result; 402: } 403: 404: # ---------------------------------------------------------------- Main Handler 405: sub handler { 406: 407: my $r=shift; 408: 409: my $uname; 410: my $udom; 411: my $javascript = ''; 412: # 413: # phase two: re-attach user 414: # 415: if ($env{'form.uploaduname'}) { 416: $env{'form.filename'}='/priv/'.$env{'form.uploaduname'}.'/'. 417: $env{'form.filename'}; 418: } 419: 420: unless ($env{'form.phase'} eq 'two') { 421: $javascript = qq| 422: function verifyForm() { 423: var mode = document.fileupload.filetype.options[document.fileupload.filetype.selectedIndex].value 424: if (mode == "testbank") { 425: document.fileupload.action = "/adm/testbank"; 426: } 427: if (mode == "imsimport") { 428: document.fileupload.action = "/adm/imsimport"; 429: } 430: if (mode == "standard") { 431: document.fileupload.action = "/adm/upload"; 432: } 433: document.fileupload.submit(); 434: } 435: |; 436: } 437: ($uname,$udom)= 438: &Apache::loncacc::constructaccess($env{'form.filename'}, 439: $r->dir_config('lonDefDomain')); 440: 441: unless (($uname) && ($udom)) { 442: $r->log_reason($uname.' at '.$udom. 443: ' trying to publish file '.$env{'form.filename'}. 444: ' - not authorized', 445: $r->filename); 446: return HTTP_NOT_ACCEPTABLE; 447: } 448: 449: my $fn; 450: if ($env{'form.filename'}) { 451: $fn=$env{'form.filename'}; 452: $fn=~s/^https?\:\/\/[^\/]+\///; 453: $fn=~s/^\///; 454: $fn=~s{(~|priv/)($LONCAPA::username_re)}{}; 455: $fn=~s/\/+/\//g; 456: } else { 457: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. 458: ' unspecified filename for upload', $r->filename); 459: return HTTP_NOT_FOUND; 460: } 461: 462: # ----------------------------------------------------------- Start page output 463: 464: 465: &Apache::loncommon::content_type($r,'text/html'); 466: $r->send_http_header; 467: 468: $javascript = "<script type=\"text/javascript\">\n//</script>\n"; 470: 471: # Breadcrumbs 472: my $brcrum = [{'href' => &Apache::loncommon::authorspace(), 473: 'text' => 'Construction Space'}, 474: {'href' => '/adm/upload', 475: 'text' => 'Upload file to Construction Space'}]; 476: $r->print(&Apache::loncommon::start_page('Upload file to Construction Space', 477: $javascript, 478: {'bread_crumbs' => $brcrum,}) 479: .&Apache::loncommon::head_subbox( 480: &Apache::loncommon::CSTR_pageheader()) 481: ); 482: 483: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { 484: $r->print('<p class="LC_warning">' 485: .&mt('Co-Author [_1]',$uname.':'.$udom) 486: .'</p>' 487: ); 488: } 489: 490: if ($env{'form.phase'} eq 'three') { 491: my $output = &phasethree($r,$fn,$uname,$udom,'author'); 492: $r->print($output); 493: } elsif ($env{'form.phase'} eq 'two') { 494: my ($output,$returnflag) = &phasetwo($r,$fn,$uname,$udom); 495: $r->print($output); 496: } else { 497: &phaseone($r,$fn,$uname,$udom); 498: } 499: 500: $r->print(&Apache::loncommon::end_page()); 501: return OK; 502: } 503: 504: 1; 505: __END__ 506: 507: