loncom/publisher/lonupload.pm - view

File: [LON-CAPA] / loncom / publisher / lonupload.pm
Revision 1.63: download - view: text, annotated - select for diffs
Tue Jul 2 19:04:49 2013 UTC (10 years, 11 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- Disk quotas for authoring spaces.
  - Default is 500 MB, unless set at domain level, or individual user level.
  - Domain default set via "Blogs, personal web pages, webDAV/quotas, portfolio" in
    "Set domain configuration" by DC.
  - Quota for individual user's authoring space set via:
    "Create users or modify the roles and privileges of users" by DC
  - &display_usage() moved from portfolio.pm to lonhtmlcommon.pm to
    facilitate re-use. In portfolio.pm &display_portfolio_usage() now calls
    lonhtmlcommon::display_usage().

1: # The LearningOnline Network with CAPA 2: # Handler to upload files into construction space 3: # 4: # $Id: lonupload.pm,v 1.63 2013/07/02 19:04:49 raeburn Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: ### 29: 30: =head1 NAME 31: 32: Apache::lonupload - upload files into construction space 33: 34: =head1 SYNOPSIS 35: 36: Invoked by /etc/httpd/conf/srm.conf: 37: 38: <Location /adm/upload> 39: PerlAccessHandler Apache::lonacc 40: SetHandler perl-script 41: PerlHandler Apache::lonupload 42: ErrorDocument 403 /adm/login 43: ErrorDocument 404 /adm/notfound.html 44: ErrorDocument 406 /adm/unauthorized.html 45: ErrorDocument 500 /adm/errorhandler 46: </Location> 47: 48: =head1 INTRODUCTION 49: 50: This module uploads a file sitting on a client computer into 51: library server construction space. 52: 53: This is part of the LearningOnline Network with CAPA project 54: described at http://www.lon-capa.org. 55: 56: =head1 HANDLER SUBROUTINE 57: 58: This routine is called by Apache and mod_perl. 59: 60: =over 4 61: 62: =item * 63: 64: Initialize variables 65: 66: =item * 67: 68: Start page output 69: 70: =item * 71: 72: output relevant interface phase (phaseone, phasetwo, phasethree or phasefour) 73: 74: =item * 75: 76: (phase one is to specify upload file; phase two is to handle conditions 77: subsequent to specification--like overwriting an existing file; phase three 78: is to handle processing of secondary uploads - of embedded objects in an 79: html file). 80: 81: =back 82: 83: =head1 OTHER SUBROUTINES 84: 85: =over 86: 87: =item phaseone() 88: 89: Interface for specifying file to upload. 90: 91: =item phasetwo() 92: 93: Interface for handling post-conditions about uploading (such 94: as overwriting an existing file). 95: 96: =item phasethree() 97: 98: Interface for handling secondary uploads of embedded objects 99: in an html file. 100: 101: =item phasefour() 102: 103: Interface for handling optional renaming of links to embedded 104: objects. 105: 106: =item upfile_store() 107: 108: Store contents of uploaded file into temporary space. Invoked 109: by phaseone subroutine. 110: 111: =item check_extension() 112: 113: Checks if filename extension is permitted and checks type 114: of file - if html file, calls parser to check for embedded objects. 115: Invoked by phasetwo subroutine. 116: 117: =back 118: 119: =cut 120: 121: package Apache::lonupload; 122: 123: use strict; 124: use Apache::File; 125: use File::Copy; 126: use File::Basename; 127: use Apache::Constants qw(:common :http :methods); 128: use Apache::loncommon(); 129: use Apache::lonnet; 130: use HTML::Entities(); 131: use Apache::lonlocal; 132: use Apache::lonnet; 133: use LONCAPA(); 134: 135: my $DEBUG=0; 136: 137: sub Debug { 138: # Put out the indicated message but only if DEBUG is true. 139: if ($DEBUG) { 140: my ($r,$message) = @_; 141: $r->log_reason($message); 142: } 143: } 144: 145: sub upfile_store { 146: my $r=shift; 147: 148: my $fname=$env{'form.upfile.filename'}; 149: $fname=~s/\W//g; 150: 151: chomp($env{'form.upfile'}); 152: 153: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}. 154: '_upload_'.$fname.'_'.time.'_'.$$; 155: { 156: my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons'). 157: '/tmp/'.$datatoken.'.tmp'); 158: print $fh $env{'form.upfile'}; 159: } 160: return $datatoken; 161: } 162: 163: sub phaseone { 164: my ($r,$fn,$mode,$uname,$udom)=@_; 165: my $action = '/adm/upload'; 166: if ($mode eq 'testbank') { 167: $action = '/adm/testbank'; 168: } elsif ($mode eq 'imsimport') { 169: $action = '/adm/imsimport'; 170: } 171: 172: # Check for file to be uploaded 173: $env{'form.upfile.filename'}=~s/\\/\//g; 174: $env{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/; 175: if (!$env{'form.upfile.filename'}) { 176: $r->print('<p class="LC_warning">'.&mt('No upload file specified.').'</p>'. 177: &earlyout($fn,$uname,$udom)); 178: return; 179: } 180: 181: # Append the name of the uploaded file 182: $fn.=$env{'form.upfile.filename'}; 183: $fn=~s/(\/)+/\//g; 184: 185: # Check for illegal filename 186: &Debug($r, "Filename for upload: $fn"); 187: if (!(($fn) && ($fn!~/\/$/))) { 188: $r->print('<p class="LC_warning">'.&mt('Illegal filename.').'</p>'); 189: return; 190: } 191: # Check if quota exceeded 192: my $filesize = length($env{'form.upfile'}); 193: if (!$filesize) { 194: $r->print('<p class="LC_warning">'. 195: &mt('Unable to upload [_1]. (size = [_2] bytes)', 196: '<span class="LC_filename">'.$env{'form.upfile.filename'}.'</span>', 197: $filesize).'<br />'. 198: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'. 199: '</p>'. 200: &earlyout($fn,$uname,$udom)); 201: return; 202: } 203: $filesize = int($filesize/1000); #expressed in kb 204: my $disk_quota = &Apache::loncommon::get_user_quota($uname,$udom,'author'); #expressed in Mb 205: $disk_quota = int($disk_quota * 1000); 206: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; 207: my $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,"$londocroot/priv/$udom/$uname"); 208: if (($current_disk_usage + $filesize) > $disk_quota){ 209: $r->print('<span class="LC_warning">'. 210: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$env{'form.upfile.filename'}.'</span>',$filesize).'</span>'. 211: '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage). 212: '</p>'. 213: &earlyout($fn,$uname,$udom)); 214: return; 215: } 216: 217: # Split part that I can change from the part that I cannot change 218: my ($fn1,$fn2)=($fn=~/^(\/priv\/[^\/]+\/[^\/]+\/)(.*)$/); 219: # Display additional options for upload 220: # and upload button 221: $r->print( 222: '<form action="'.$action.'" method="post" name="fileupload">' 223: .'<input type="hidden" name="phase" value="two" />' 224: .'<input type="hidden" name="datatoken" value="'.&upfile_store.'" />' 225: ); 226: $r->print( 227: &Apache::lonhtmlcommon::start_pick_box() 228: .&Apache::lonhtmlcommon::row_title(&mt('Save uploaded file as')) 229: .'<span class="LC_filename">'.$fn1.'</span>' 230: .'<input type="hidden" name="filename1" value="'.$fn1.'" />' 231: .'<input type="text" size="50" name="filename2" value="'.$fn2.'" />' 232: .&Apache::lonhtmlcommon::row_closure() 233: .&Apache::lonhtmlcommon::row_title(&mt('File Type')) 234: .'<select name="filetype">' 235: .'<option value="standard" selected="selected">'.&mt('Regular file').'</option>' 236: .'<option value="testbank">'.&mt('Testbank file').'</option>' 237: .'<option value="imsimport">'.&mt('IMS package').'</option>' 238: .'</select>'.&Apache::loncommon::help_open_topic("Uploading_File_Options") 239: .&Apache::lonhtmlcommon::row_closure(1) 240: .&Apache::lonhtmlcommon::end_pick_box() 241: ); 242: $r->print( 243: '<p>' 244: .'<input type="button" value="'.&mt('Upload').'" onclick="javascript:verifyForm()"/>' 245: .'</p>' 246: .'</form>' 247: ); 248: 249: # Check for bad extension and warn user 250: if ($fn=~/\.(\w+)$/ && 251: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { 252: $r->print('<p class="LC_error">' 253: .&mt('The extension on this file, [_1], is reserved internally by LON-CAPA.', 254: '<span class="LC_filename">'.$1.'</span>') 255: .' <br />'.&mt('Please change the extension.') 256: .'</p>'); 257: } elsif($fn=~/\.(\w+)$/ && 258: !defined(&Apache::loncommon::fileembstyle($1))) { 259: $r->print('<p class="LC_error">' 260: .&mt('The extension on this file, [_1], is not recognized by LON-CAPA.', 261: '<span class="LC_filename">'.$1.'</span>') 262: .' <br />'.&mt('Please change the extension.') 263: .'</p>'); 264: } 265: } 266: 267: sub phasetwo { 268: my ($r,$fn,$mode)=@_; 269: 270: my $output; 271: my $action = '/adm/upload'; 272: my $returnflag = ''; 273: if ($mode eq 'testbank') { 274: $action = '/adm/testbank'; 275: } elsif ($mode eq 'imsimport') { 276: $action = '/adm/imsimport'; 277: } 278: $fn=~s/\/+/\//g; 279: if ($fn) { 280: my $target= $r->dir_config('lonDocRoot').'/'.$fn; 281: &Debug($r, "target -> ".$target); 282: # target is the full filesystem path of the destination file. 283: my $base = &File::Basename::basename($fn); 284: my $path = &File::Basename::dirname($fn); 285: $base = &HTML::Entities::encode($base,'<>&"'); 286: my $url = $path."/".$base; 287: &Debug($r, "URL is now ".$url); 288: my $datatoken=$env{'form.datatoken'}; 289: if (($fn) && ($datatoken)) { 290: if ($env{'form.cancel'}) { 291: my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp'; 292: my $dirpath=$path.'/'; 293: $dirpath=~s/\/+/\//g; 294: $output .= '<p class="LC_warning">'.&mt('Upload cancelled.').'</p>' 295: .'<p><a href="'.$dirpath.'">'. 296: &mt('Back to Directory').'</a></p>'; 297: } elsif ((-e $target) && (!$env{'form.override'})) { 298: $output .= '<form action="'.$action.'" method="post">' 299: .'<p class="LC_warning">' 300: .&mt('File [_1] already exists.', 301: '<span class="LC_filename">'.$fn.'</span>') 302: .'<input type="hidden" name="phase" value="two" />' 303: .'<input type="hidden" name="filename" value="'.$url.'" />' 304: .'<input type="hidden" name="datatoken" value="'.$datatoken.'" />' 305: .'<p>' 306: .'<input type="submit" name="cancel" value="'.&mt('Cancel').'" />' 307: .' <input type="submit" name="override" value="'.&mt('Overwrite').'" />' 308: .'</p>' 309: .'</form>'; 310: } else { 311: my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp'; 312: my $dirpath=$path.'/'; 313: $dirpath=~s/\/+/\//g; 314: # Check for bad extension and disallow upload 315: my $result; 316: ($result,$returnflag) = &check_extension($fn,$mode,$source,$target,$action,$dirpath,$url); 317: $output .= $result; 318: } 319: } else { 320: $output .= '<span class="LC_error">'. 321: &mt('Please use browser "Back" button and pick a filename'). 322: '</span><br />'; 323: } 324: } else { 325: $output .= '<span class="LC_error">'. 326: &mt('Please use browser "Back" button and pick a filename'). 327: '</span><br />'; 328: } 329: return ($output,$returnflag); 330: } 331: 332: sub check_extension { 333: my ($fn,$mode,$source,$target,$action,$dirpath,$url) = @_; 334: my ($result,$returnflag); 335: # Check for bad extension and disallow upload 336: if ($fn=~/\.(\w+)$/ && 337: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { 338: $result .= '<p class="LC_warning">'. 339: &mt('File [_1] could not be copied.', 340: '<span class="LC_filename">'.$fn.'</span> '). 341: '<br />'. 342: &mt('The extension on this file is reserved internally by LON-CAPA.'). 343: '</p>'; 344: } elsif ($fn=~/\.(\w+)$/ && 345: !defined(&Apache::loncommon::fileembstyle($1))) { 346: $result .= '<p class="LC_warning">'. 347: &mt('File [_1] could not be copied.', 348: '<span class="LC_filename">'.$fn.'</span> '). 349: '<br />'. 350: &mt('The extension on this file is not recognized by LON-CAPA.'). 351: '</p>'; 352: } elsif (-d $target) { 353: $result .= '<p class="LC_warning">'. 354: &mt('File [_1] could not be copied.', 355: '<span class="LC_filename">'.$fn.'</span>'). 356: '<br />'. 357: &mt('The target is an existing directory.'). 358: '</p>'; 359: } elsif (copy($source,$target)) { 360: chmod(0660, $target); # Set permissions to rw-rw---. 361: if ($mode eq 'testbank' || $mode eq 'imsimport') { 362: $returnflag = 'ok'; 363: $result .= '<p class="LC_success">' 364: .&mt('Your file - [_1] - was uploaded successfully.', 365: '<span class="LC_filename">'.$fn.'<span>') 366: .'</p>'; 367: } else { 368: $result .= '<p class="LC_success">' 369: .&mt('File copied.') 370: .'</p>'; 371: } 372: # Check for embedded objects. 373: my (%allfiles,%codebase); 374: my ($text,$header,$css,$js); 375: if (($mode ne 'imsimport') && ($target =~ /\.(htm|html|shtml)$/i)) { 376: my (%allfiles,%codebase); 377: &Apache::lonnet::extract_embedded_items($target,\%allfiles,\%codebase); 378: if (keys(%allfiles) > 0) { 379: my ($currentpath) = ($url =~ m{^(.+)/[^/]+$}); 380: my $state = &embedded_form_elems('upload_embedded',$url,$mode); 381: my ($embedded,$num,$pathchg) = 382: &Apache::loncommon::ask_for_embedded_content($action,$state,\%allfiles, 383: \%codebase, 384: {'error_on_invalid_names' => 1, 385: 'ignore_remote_references' => 1, 386: 'current_path' => $currentpath}); 387: if ($embedded) { 388: $result .= '<h3>'.&mt('Reference Warning').'</h3>'; 389: if ($num) { 390: $result .= '<p>'.&mt('Completed upload of the file.').' '.&mt('This file contained references to other files.').'</p>'. 391: '<p>'.&mt('Please select the locations from which the referenced files are to be uploaded.').'</p>'. 392: $embedded; 393: if ($mode eq 'testbank') { 394: $returnflag = 'embedded'; 395: $result .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without these files.','<a href="javascript:document.testbankForm.submit();">','</a>').'</p>'; 396: } 397: } else { 398: $result .= '<p>'.&mt('Completed upload of the file.').'</p>'.$embedded; 399: if ($pathchg) { 400: if ($mode eq 'testbank') { 401: $returnflag = 'embedded'; 402: $result .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the references(s).','<a href="javascript:document.testbankForm.submit();">','</a>').'</p>'; 403: } 404: } 405: } 406: } 407: } 408: } 409: if (($mode ne 'imsimport') && ($mode ne 'testbank')) { 410: $result .= '<br /><a href="'.$url.'">'. 411: &mt('View file').'</a>'; 412: } 413: } else { 414: $result .= &mt('Failed to copy: [_1].',$!); 415: } 416: if ($mode ne 'imsimport' && $mode ne 'testbank') { 417: $result .= '<br /><a href="'.$dirpath.'">'. 418: &mt('Back to Directory').'</a><br />'; 419: } 420: return ($result,$returnflag); 421: } 422: 423: sub phasethree { 424: my ($r,$fn,$uname,$udom,$mode) = @_; 425: 426: my $action = '/adm/upload'; 427: if ($mode eq 'testbank') { 428: $action = '/adm/testbank'; 429: } elsif ($mode eq 'imsimport') { 430: $action = '/adm/imsimport'; 431: } 432: my $url_root = "/priv/$udom/$uname"; 433: my $dir_root = $r->dir_config('lonDocRoot').$url_root; 434: my $path = &File::Basename::dirname($fn); 435: $path =~ s{^\Q$url_root\E}{}; 436: my $filename = &HTML::Entities::encode($env{'form.filename'},'<>&"'); 437: my $state = &embedded_form_elems('modify_orightml',$filename,$mode). 438: '<input type="hidden" name="phase" value="four" />'; 439: my ($result,$returnflag) = 440: &Apache::loncommon::upload_embedded($mode,$path,$uname,$udom, 441: $dir_root,$url_root,undef, 442: undef,undef,$state,$action); 443: if ($mode ne 'imsimport' && $mode ne 'testbank') { 444: $result .= '<br /><h3><a href="'.$fn.'">'. 445: &mt('View main file').'</a></h3>'. 446: '<h3><a href="'.$url_root.$path.'">'. 447: &mt('Back to Directory').'</a></h3><br />'; 448: } 449: return ($result,$returnflag); 450: } 451: 452: sub embedded_form_elems { 453: my ($action,$filename,$mode) = @_; 454: return <<STATE; 455: <input type="hidden" name="action" value="$action" /> 456: <input type="hidden" name="mode" value="$mode" /> 457: <input type="hidden" name="filename" value="$filename" /> 458: STATE 459: } 460: 461: sub phasefour { 462: my ($r,$fn,$uname,$udom,$mode) = @_; 463: 464: my $action = '/adm/upload'; 465: if ($mode eq 'testbank') { 466: $action = '/adm/testbank'; 467: } elsif ($mode eq 'imsimport') { 468: $action = '/adm/imsimport'; 469: } 470: my $result; 471: my $url_root = "/priv/$udom/$uname"; 472: my $dir_root = $r->dir_config('lonDocRoot').$url_root; 473: my $path = &File::Basename::dirname($fn); 474: $path =~ s{^\Q$url_root\E}{}; 475: my $outcome = 476: &Apache::loncommon::modify_html_refs($mode,$path,$uname,$udom,$dir_root); 477: $result .= $outcome; 478: if ($mode ne 'imsimport' && $mode ne 'testbank') { 479: $result .= '<br /><h3><a href="'.$fn.'">'. 480: &mt('View main file').'</a></h3>'. 481: '<h3><a href="'.$url_root.$path.'">'. 482: &mt('Back to Directory').'</a></h3><br />'; 483: } 484: return $result; 485: } 486: 487: sub earlyout { 488: my ($fn,$uname,$udom) = @_; 489: if ($fn =~ m{^(/priv/$udom/$uname(?:.*)/)[^/]*}) { 490: return &Apache::lonhtmlcommon::actionbox( 491: ['<a href="'.$1.'">'.&mt('Return to Directory').'</a>']); 492: } 493: return; 494: } 495: 496: # ---------------------------------------------------------------- Main Handler 497: sub handler { 498: 499: my $r=shift; 500: my $javascript = ''; 501: my $fn=$env{'form.filename'}; 502: 503: if ($env{'form.filename1'}) { 504: $fn=$env{'form.filename1'}.$env{'form.filename2'}; 505: } 506: $fn=~s/\/+/\//g; 507: 508: unless ($fn) { 509: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. 510: ' unspecified filename for upload', $r->filename); 511: return HTTP_NOT_FOUND; 512: } 513: 514: my ($uname,$udom)=&Apache::lonnet::constructaccess($fn); 515: 516: unless (($uname) && ($udom)) { 517: $r->log_reason($uname.' at '.$udom. 518: ' trying to publish file '.$env{'form.filename'}. 519: ' - not authorized', 520: $r->filename); 521: return HTTP_NOT_ACCEPTABLE; 522: } 523: 524: # ----------------------------------------------------------- Start page output 525: 526: &Apache::loncommon::content_type($r,'text/html'); 527: $r->send_http_header; 528: 529: unless ($env{'form.phase'} eq 'two') { 530: $javascript = <<"ENDJS"; 531: <script type="text/javascript"> 532: // <![CDATA[ 533: function verifyForm() { 534: var mode = document.fileupload.filetype.options[document.fileupload.filetype.selectedIndex].value 535: if (mode == "testbank") { 536: document.fileupload.action = "/adm/testbank"; 537: } 538: if (mode == "imsimport") { 539: document.fileupload.action = "/adm/imsimport"; 540: } 541: if (mode == "standard") { 542: document.fileupload.action = "/adm/upload"; 543: } 544: document.fileupload.submit(); 545: } 546: // ]]> 547: </script> 548: ENDJS 549: } 550: 551: my $londocroot = $r->dir_config('lonDocRoot'); 552: my $trailfile = $fn; 553: $trailfile =~ s{^/(priv/)}{$londocroot/$1}; 554: 555: # Breadcrumbs 556: my $brcrum = [{'href' => &Apache::loncommon::authorspace($fn), 557: 'text' => 'Authoring Space'}, 558: {'href' => '/adm/upload', 559: 'text' => 'Upload file to Authoring Space'}]; 560: $r->print(&Apache::loncommon::start_page('Upload file to Authoring Space', 561: $javascript, 562: {'bread_crumbs' => $brcrum,}) 563: .&Apache::loncommon::head_subbox( 564: &Apache::loncommon::CSTR_pageheader($trailfile)) 565: ); 566: 567: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { 568: $r->print('<p class="LC_info">' 569: .&mt('Co-Author [_1]',$uname.':'.$udom) 570: .'</p>' 571: ); 572: } 573: if ($env{'form.phase'} eq 'four') { 574: my $output = &phasefour($r,$fn,$uname,$udom,'author'); 575: $r->print($output); 576: } elsif ($env{'form.phase'} eq 'three') { 577: my ($output,$rtnflag) = &phasethree($r,$fn,$uname,$udom,'author'); 578: $r->print($output); 579: } elsif ($env{'form.phase'} eq 'two') { 580: my ($output,$returnflag) = &phasetwo($r,$fn); 581: $r->print($output); 582: } else { 583: &phaseone($r,$fn,undef,$uname,$udom); 584: } 585: 586: $r->print(&Apache::loncommon::end_page()); 587: return OK; 588: } 589: 590: 1; 591: __END__ 592: 593: