loncom/publisher/lonupload.pm - view

File: [LON-CAPA] / loncom / publisher / lonupload.pm
Revision 1.59: download - view: text, annotated - select for diffs
Mon Nov 14 00:20:31 2011 UTC (12 years, 7 months ago) by raeburn
Branches: MAIN
CVS tags: language_hyphenation_merge, language_hyphenation, HEAD, BZ4492-merge, BZ4492-feature_horizontal_radioresponse

- &authorspace() routine now takes an argument: $uri
  so "Construction Space" breadcrumb points at appropriate author space
  for resource/directory being viewed or acted om.
  - current role could be different or ("no role" - i.e., cm), so is only
    used to determine authorspace when $uri is unavailable.

1: # The LearningOnline Network with CAPA 2: # Handler to upload files into construction space 3: # 4: # $Id: lonupload.pm,v 1.59 2011/11/14 00:20:31 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::loncacc; 129: use Apache::loncommon(); 130: use Apache::lonnet; 131: use HTML::Entities(); 132: use Apache::lonlocal; 133: use Apache::lonnet; 134: use LONCAPA(); 135: 136: my $DEBUG=0; 137: 138: sub Debug { 139: # Put out the indicated message but only if DEBUG is true. 140: if ($DEBUG) { 141: my ($r,$message) = @_; 142: $r->log_reason($message); 143: } 144: } 145: 146: sub upfile_store { 147: my $r=shift; 148: 149: my $fname=$env{'form.upfile.filename'}; 150: $fname=~s/\W//g; 151: 152: chomp($env{'form.upfile'}); 153: 154: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}. 155: '_upload_'.$fname.'_'.time.'_'.$$; 156: { 157: my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons'). 158: '/tmp/'.$datatoken.'.tmp'); 159: print $fh $env{'form.upfile'}; 160: } 161: return $datatoken; 162: } 163: 164: sub phaseone { 165: my ($r,$fn,$mode)=@_; 166: my $action = '/adm/upload'; 167: if ($mode eq 'testbank') { 168: $action = '/adm/testbank'; 169: } elsif ($mode eq 'imsimport') { 170: $action = '/adm/imsimport'; 171: } 172: 173: # Check for file to be uploaded 174: $env{'form.upfile.filename'}=~s/\\/\//g; 175: $env{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/; 176: if (!$env{'form.upfile.filename'}) { 177: $r->print('<p class="LC_warning">'.&mt('No upload file specified.').'</p>'); 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: # Split part that I can change from the part that I cannot change 192: my ($fn1,$fn2)=($fn=~/^(\/priv\/[^\/]+\/[^\/]+\/)(.*)$/); 193: # Display additional options for upload 194: # and upload button 195: $r->print( 196: '<form action="'.$action.'" method="post" name="fileupload">' 197: .'<input type="hidden" name="phase" value="two" />' 198: .'<input type="hidden" name="datatoken" value="'.&upfile_store.'" />' 199: ); 200: $r->print( 201: &Apache::lonhtmlcommon::start_pick_box() 202: .&Apache::lonhtmlcommon::row_title(&mt('Save uploaded file as')) 203: .'<span class="LC_filename">'.$fn1.'</span>' 204: .'<input type="hidden" name="filename1" value="'.$fn1.'" />' 205: .'<input type="text" size="50" name="filename2" value="'.$fn2.'" />' 206: .&Apache::lonhtmlcommon::row_closure() 207: .&Apache::lonhtmlcommon::row_title(&mt('File Type')) 208: .'<select name="filetype">' 209: .'<option value="standard" selected="selected">'.&mt('Regular file').'</option>' 210: .'<option value="testbank">'.&mt('Testbank file').'</option>' 211: .'<option value="imsimport">'.&mt('IMS package').'</option>' 212: .'</select>'.&Apache::loncommon::help_open_topic("Uploading_File_Options") 213: .&Apache::lonhtmlcommon::row_closure(1) 214: .&Apache::lonhtmlcommon::end_pick_box() 215: ); 216: $r->print( 217: '<p>' 218: .'<input type="button" value="'.&mt('Upload').'" onclick="javascript:verifyForm()"/>' 219: .'</p>' 220: .'</form>' 221: ); 222: 223: # Check for bad extension and warn user 224: if ($fn=~/\.(\w+)$/ && 225: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { 226: $r->print('<p class="LC_error">' 227: .&mt('The extension on this file, [_1], is reserved internally by LON-CAPA.', 228: '<span class="LC_filename">'.$1.'</span>') 229: .' <br />'.&mt('Please change the extension.') 230: .'</p>'); 231: } elsif($fn=~/\.(\w+)$/ && 232: !defined(&Apache::loncommon::fileembstyle($1))) { 233: $r->print('<p class="LC_error">' 234: .&mt('The extension on this file, [_1], is not recognized by LON-CAPA.', 235: '<span class="LC_filename">'.$1.'</span>') 236: .' <br />'.&mt('Please change the extension.') 237: .'</p>'); 238: } 239: } 240: 241: sub phasetwo { 242: my ($r,$fn,$mode)=@_; 243: 244: my $output; 245: my $action = '/adm/upload'; 246: my $returnflag = ''; 247: if ($mode eq 'testbank') { 248: $action = '/adm/testbank'; 249: } elsif ($mode eq 'imsimport') { 250: $action = '/adm/imsimport'; 251: } 252: $fn=~s/\/+/\//g; 253: if ($fn) { 254: my $target= $r->dir_config('lonDocRoot').'/'.$fn; 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 ($currentpath) = ($url =~ m{^(.+)/[^/]+$}); 354: my $state = &embedded_form_elems('upload_embedded',$url,$mode); 355: my ($embedded,$num,$pathchg) = 356: &Apache::loncommon::ask_for_embedded_content($action,$state,\%allfiles, 357: \%codebase, 358: {'error_on_invalid_names' => 1, 359: 'ignore_remote_references' => 1, 360: 'current_path' => $currentpath}); 361: if ($embedded) { 362: $result .= '<h3>'.&mt('Reference Warning').'</h3>'; 363: if ($num) { 364: $result .= '<p>'.&mt('Completed upload of the file.').' '.&mt('This file contained references to other files.').'</p>'. 365: '<p>'.&mt('Please select the locations from which the referenced files are to be uploaded.').'</p>'. 366: $embedded; 367: if ($mode eq 'testbank') { 368: $returnflag = 'embedded'; 369: $result .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without these files.','<a href="javascript:document.testbankForm.submit();">','</a>').'</p>'; 370: } 371: } else { 372: $result .= '<p>'.&mt('Completed upload of the file.').'</p>'.$embedded; 373: if ($pathchg) { 374: if ($mode eq 'testbank') { 375: $returnflag = 'embedded'; 376: $result .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the references(s).','<a href="javascript:document.testbankForm.submit();">','</a>').'</p>'; 377: } 378: } 379: } 380: } 381: } 382: } 383: if (($mode ne 'imsimport') && ($mode ne 'testbank')) { 384: $result .= '<br /><a href="'.$url.'">'. 385: &mt('View file').'</a>'; 386: } 387: } else { 388: $result .= &mt('Failed to copy: [_1].',$!); 389: } 390: if ($mode ne 'imsimport' && $mode ne 'testbank') { 391: $result .= '<br /><a href="'.$dirpath.'">'. 392: &mt('Back to Directory').'</a><br />'; 393: } 394: return ($result,$returnflag); 395: } 396: 397: sub phasethree { 398: my ($r,$fn,$uname,$udom,$mode) = @_; 399: 400: my $action = '/adm/upload'; 401: if ($mode eq 'testbank') { 402: $action = '/adm/testbank'; 403: } elsif ($mode eq 'imsimport') { 404: $action = '/adm/imsimport'; 405: } 406: my $url_root = "/priv/$udom/$uname"; 407: my $dir_root = $r->dir_config('lonDocRoot').$url_root; 408: my $path = &File::Basename::dirname($fn); 409: $path =~ s{^\Q$url_root\E}{}; 410: my $filename = &HTML::Entities::encode($env{'form.filename'},'<>&"'); 411: my $state = &embedded_form_elems('modify_orightml',$filename,$mode). 412: '<input type="hidden" name="phase" value="four" />'; 413: my ($result,$returnflag) = 414: &Apache::loncommon::upload_embedded($mode,$path,$uname,$udom, 415: $dir_root,$url_root,undef, 416: undef,undef,$state,$action); 417: if ($mode ne 'imsimport' && $mode ne 'testbank') { 418: $result .= '<br /><h3><a href="'.$fn.'">'. 419: &mt('View main file').'</a></h3>'. 420: '<h3><a href="'.$url_root.$path.'">'. 421: &mt('Back to Directory').'</a></h3><br />'; 422: } 423: return ($result,$returnflag); 424: } 425: 426: sub embedded_form_elems { 427: my ($action,$filename,$mode) = @_; 428: return <<STATE; 429: <input type="hidden" name="action" value="$action" /> 430: <input type="hidden" name="mode" value="$mode" /> 431: <input type="hidden" name="filename" value="$filename" /> 432: STATE 433: } 434: 435: sub phasefour { 436: my ($r,$fn,$uname,$udom,$mode) = @_; 437: 438: my $action = '/adm/upload'; 439: if ($mode eq 'testbank') { 440: $action = '/adm/testbank'; 441: } elsif ($mode eq 'imsimport') { 442: $action = '/adm/imsimport'; 443: } 444: my $result; 445: my $url_root = "/priv/$udom/$uname"; 446: my $dir_root = $r->dir_config('lonDocRoot').$url_root; 447: my $path = &File::Basename::dirname($fn); 448: $path =~ s{^\Q$url_root\E}{}; 449: $result .= &Apache::loncommon::modify_html_refs($mode,$path, 450: $uname,$udom,$dir_root); 451: if ($mode ne 'imsimport' && $mode ne 'testbank') { 452: $result .= '<br /><h3><a href="'.$fn.'">'. 453: &mt('View main file').'</a></h3>'. 454: '<h3><a href="'.$url_root.$path.'">'. 455: &mt('Back to Directory').'</a></h3><br />'; 456: } 457: return $result; 458: } 459: 460: # ---------------------------------------------------------------- Main Handler 461: sub handler { 462: 463: my $r=shift; 464: my $javascript = ''; 465: my $fn=$env{'form.filename'}; 466: 467: if ($env{'form.filename1'}) { 468: $fn=$env{'form.filename1'}.$env{'form.filename2'}; 469: } 470: $fn=~s/\/+/\//g; 471: 472: unless ($fn) { 473: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. 474: ' unspecified filename for upload', $r->filename); 475: return HTTP_NOT_FOUND; 476: } 477: 478: my ($uname,$udom)=&Apache::loncacc::constructaccess($fn); 479: 480: unless (($uname) && ($udom)) { 481: $r->log_reason($uname.' at '.$udom. 482: ' trying to publish file '.$env{'form.filename'}. 483: ' - not authorized', 484: $r->filename); 485: return HTTP_NOT_ACCEPTABLE; 486: } 487: 488: # ----------------------------------------------------------- Start page output 489: 490: &Apache::loncommon::content_type($r,'text/html'); 491: $r->send_http_header; 492: 493: unless ($env{'form.phase'} eq 'two') { 494: $javascript = <<"ENDJS"; 495: <script type="text/javascript"> 496: // <![CDATA[ 497: function verifyForm() { 498: var mode = document.fileupload.filetype.options[document.fileupload.filetype.selectedIndex].value 499: if (mode == "testbank") { 500: document.fileupload.action = "/adm/testbank"; 501: } 502: if (mode == "imsimport") { 503: document.fileupload.action = "/adm/imsimport"; 504: } 505: if (mode == "standard") { 506: document.fileupload.action = "/adm/upload"; 507: } 508: document.fileupload.submit(); 509: } 510: // ]]> 511: </script> 512: ENDJS 513: } 514: 515: my $londocroot = $r->dir_config('lonDocRoot'); 516: my $trailfile = $fn; 517: $trailfile =~ s{^/(priv/)}{$londocroot/$1}; 518: 519: # Breadcrumbs 520: my $brcrum = [{'href' => &Apache::loncommon::authorspace($fn), 521: 'text' => 'Construction Space'}, 522: {'href' => '/adm/upload', 523: 'text' => 'Upload file to Construction Space'}]; 524: $r->print(&Apache::loncommon::start_page('Upload file to Construction Space', 525: $javascript, 526: {'bread_crumbs' => $brcrum,}) 527: .&Apache::loncommon::head_subbox( 528: &Apache::loncommon::CSTR_pageheader($trailfile)) 529: ); 530: 531: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { 532: $r->print('<p class="LC_info">' 533: .&mt('Co-Author [_1]',$uname.':'.$udom) 534: .'</p>' 535: ); 536: } 537: if ($env{'form.phase'} eq 'four') { 538: my $output = &phasefour($r,$fn,$uname,$udom,'author'); 539: $r->print($output); 540: } elsif ($env{'form.phase'} eq 'three') { 541: my ($output,$rtnflag) = &phasethree($r,$fn,$uname,$udom,'author'); 542: $r->print($output); 543: } elsif ($env{'form.phase'} eq 'two') { 544: my ($output,$returnflag) = &phasetwo($r,$fn); 545: $r->print($output); 546: } else { 547: &phaseone($r,$fn); 548: } 549: 550: $r->print(&Apache::loncommon::end_page()); 551: return OK; 552: } 553: 554: 1; 555: __END__ 556: 557:

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.