loncom/publisher/lonupload.pm - view

File: [LON-CAPA] / loncom / publisher / lonupload.pm
Revision 1.71: download - view: text, annotated - select for diffs
Sun Jul 23 11:54:56 2023 UTC (15 months, 2 weeks ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, HEAD

- Breadcrumbs text when displaying/editing resource in Course Authoring Space.

# The LearningOnline Network with CAPA # Handler to upload files into construction space # # $Id: lonupload.pm,v 1.71 2023/07/23 11:54:56 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # ### =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; use strict; use Apache::File; use File::Copy; use File::Basename; use Apache::Constants qw(:common :http :methods); use Apache::loncommon(); use Apache::lonnet; use HTML::Entities(); use Apache::lonlocal; use Apache::lonnet; use LONCAPA qw(:DEFAULT :match); my $DEBUG=0; sub Debug { # Put out the indicated message but only if DEBUG is true. if ($DEBUG) { my ($r,$message) = @_; $r->log_reason($message); } } sub upfile_store { my $r=shift; my $fname=$env{'form.upfile.filename'}; $fname=~s/\W//g; chomp($env{'form.upfile'}); my $datatoken; 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'). '/tmp/'.$datatoken.'.tmp'); print $fh $env{'form.upfile'}; } return $datatoken; } sub phaseone { my ($r,$fn,$mode,$uname,$udom)=@_; my $action = '/adm/upload'; if ($mode eq 'testbank') { $action = '/adm/testbank'; } elsif ($mode eq 'imsimport') { $action = '/adm/imsimport'; } # Check for file to be uploaded $env{'form.upfile.filename'}=~s/\\/\//g; $env{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/; $env{'form.upfile.filename'}=~s/(\s+$|^\s+)//g; if (!$env{'form.upfile.filename'}) { $r->print('<p class="LC_warning">'.&mt('No upload file specified.').'</p>'. &earlyout($fn,$uname,$udom)); return; } # Append the name of the uploaded file $fn.=$env{'form.upfile.filename'}; $fn=~s/(\/)+/\//g; # Check for illegal filename &Debug($r, "Filename for upload: $fn"); if (!(($fn) && ($fn!~/\/$/))) { $r->print('<p class="LC_warning">'.&mt('Illegal filename.').'</p>'); return; } # Check if quota exceeded my $filesize = length($env{'form.upfile'}); if (!$filesize) { $r->print('<p class="LC_warning">'. &mt('Unable to upload [_1]. (size = [_2] bytes)', '<span class="LC_filename">'.$env{'form.upfile.filename'}.'</span>', $filesize).'<br />'. &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'. '</p>'. &earlyout($fn,$uname,$udom)); return; } $filesize = int($filesize/1000); #expressed in kb my $output = &Apache::loncommon::excess_filesize_warning($uname,$udom,'author', $env{'form.upfile.filename'},$filesize,'upload'); if ($output) { $r->print($output.&earlyout($fn,$uname,$udom)); return; } # Split part that I can change from the part that I cannot change my ($fn1,$fn2)=($fn=~/^(\/priv\/[^\/]+\/[^\/]+\/)(.*)$/); # Check for pattern: .number.extension which is reserved for LON-CAPA versioning. # Check for disallowed characters: #?&%:<>`|, and remove if ($fn2 ne '') { ($fn2,my $warning) = &check_filename($fn2); if ($warning ne '') { $r->print($warning); } } # Display additional options for upload # and upload button $r->print( '<form action="'.$action.'" method="post" name="fileupload">' .'<input type="hidden" name="phase" value="two" />' .'<input type="hidden" name="datatoken" value="'.&upfile_store.'" />' ); $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 { my ($r,$fn,$mode)=@_; my $output; my $action = '/adm/upload'; my $returnflag = ''; if ($mode eq 'testbank') { $action = '/adm/testbank'; } elsif ($mode eq 'imsimport') { $action = '/adm/imsimport'; } $fn=~s/\/+/\//g; if ($fn) { my $target= $r->dir_config('lonDocRoot').'/'.$fn; &Debug($r, "target -> ".$target); # target is the full filesystem path of the destination file. my $base = &File::Basename::basename($fn); my $path = &File::Basename::dirname($fn); $base = &HTML::Entities::encode($base,'<>&"'); my $url = $path."/".$base; &Debug($r, "URL is now ".$url); my $datatoken; if ($env{'form.datatoken'} =~ /^$match_username\_$match_domain\_upload_\w*_\d+_\d+$/) { $datatoken = $env{'form.datatoken'}; } if (($fn) && ($datatoken)) { if ($env{'form.cancel'}) { my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp'; my $dirpath=$path.'/'; $dirpath=~s/\/+/\//g; $output .= '<p class="LC_warning">'.&mt('Upload cancelled.').'</p>' .'<p><a href="'.$dirpath.'">'. &mt('Back to Directory').'</a></p>'; } elsif ((-e $target) && (!$env{'form.override'})) { $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 $dirpath=$path.'/'; $dirpath=~s/\/+/\//g; # Check for bad extension and disallow upload my $result; ($result,$returnflag) = &check_extension($fn,$mode,$source,$target,$action,$dirpath,$url); $output .= $result; } } else { $output .= '<span class="LC_error">'. &mt('Please use browser "Back" button and pick a filename'). '</span><br />'; } } else { $output .= '<span class="LC_error">'. &mt('Please use browser "Back" button and pick a filename'). '</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; } # ---------------------------------------------------------------- Main Handler sub handler { my $r=shift; my $javascript = ''; my $fn; my $warning; if ($env{'form.filename1'}) { my $fn1 = $env{'form.filename1'}; 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') { $javascript = <<"ENDJS"; <script type="text/javascript"> // <![CDATA[ function verifyForm() { var mode = document.fileupload.filetype.options[document.fileupload.filetype.selectedIndex].value if (mode == "testbank") { document.fileupload.action = "/adm/testbank"; } if (mode == "imsimport") { document.fileupload.action = "/adm/imsimport"; } if (mode == "standard") { document.fileupload.action = "/adm/upload"; } document.fileupload.submit(); } // ]]> </script> ENDJS } my $londocroot = $r->dir_config('lonDocRoot'); my $trailfile = $fn; $trailfile =~ s{^/(priv/)}{$londocroot/$1}; # Breadcrumbs my $text = 'Authoring Space'; my $href = &Apache::loncommon::authorspace($fn); my $crsauthor; if ($env{'request.course.id'}) { my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; if ($href eq "/priv/$cdom/$cnum/") { $text = 'Course Authoring Space'; $crsauthor = 1; } } my $brcrum = [{'href' => $href, 'text' => $text}, {'href' => '/adm/upload', 'text' => 'Upload file to '.$text}]; $r->print(&Apache::loncommon::start_page('Upload file to '.$text, $javascript, {'bread_crumbs' => $brcrum,}) .&Apache::loncommon::head_subbox( &Apache::loncommon::CSTR_pageheader($trailfile)) ); unless ($crsauthor) { if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { $r->print('<p class="LC_info">' .&mt('Co-Author [_1]',$uname.':'.$udom) .'</p>' ); } } 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 { &phaseone($r,$fn,undef,$uname,$udom); } $r->print(&Apache::loncommon::end_page()); return OK; } 1; __END__