--- loncom/publisher/lonupload.pm 2013/07/02 19:04:49 1.63 +++ loncom/publisher/lonupload.pm 2019/03/06 03:39:54 1.70 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to upload files into construction space # -# $Id: lonupload.pm,v 1.63 2013/07/02 19:04:49 raeburn Exp $ +# $Id: lonupload.pm,v 1.70 2019/03/06 03:39:54 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -130,7 +130,7 @@ use Apache::lonnet; use HTML::Entities(); use Apache::lonlocal; use Apache::lonnet; -use LONCAPA(); +use LONCAPA qw(:DEFAULT :match); my $DEBUG=0; @@ -150,8 +150,12 @@ sub upfile_store { chomp($env{'form.upfile'}); - my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}. - '_upload_'.$fname.'_'.time.'_'.$$; + 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'); @@ -172,6 +176,7 @@ sub phaseone { # 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('

'.&mt('No upload file specified.').'

'. &earlyout($fn,$uname,$udom)); @@ -201,21 +206,23 @@ sub phaseone { return; } $filesize = int($filesize/1000); #expressed in kb - my $disk_quota = &Apache::loncommon::get_user_quota($uname,$udom,'author'); #expressed in Mb - $disk_quota = int($disk_quota * 1000); - my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; - my $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,"$londocroot/priv/$udom/$uname"); - if (($current_disk_usage + $filesize) > $disk_quota){ - $r->print(''. - &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.',''.$env{'form.upfile.filename'}.'',$filesize).''. - '
'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage). - '

'. - &earlyout($fn,$uname,$udom)); + 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( @@ -283,9 +290,12 @@ sub phasetwo { my $base = &File::Basename::basename($fn); my $path = &File::Basename::dirname($fn); $base = &HTML::Entities::encode($base,'<>&"'); - my $url = $path."/".$base; + my $url = $path."/".$base; &Debug($r, "URL is now ".$url); - my $datatoken=$env{'form.datatoken'}; + 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'; @@ -399,7 +409,7 @@ sub check_extension { if ($pathchg) { if ($mode eq 'testbank') { $returnflag = 'embedded'; - $result .= '

'.&mt('Or [_1]continue[_2] the testbank import without modifying the references(s).','','').'

'; + $result .= '

'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).','','').'

'; } } } @@ -420,6 +430,47 @@ sub check_extension { return ($result,$returnflag); } +sub check_filename { + my ($fname) = @_; + my $warning; + if ($fname =~/[#\?&%":<>`|]/) { + $fname =~s/[#\?&%":<>`|]//g; + $warning .= '

' + .&mt('Removed one or more disallowed characters from filename') + .'

'; + } + if ($fname=~ /\.(\d+)\.(\w+)$/) { + my $num = $1; + $warning .= '

' + .&mt('Bad filename [_1]',''.$fname.'') + .'
' + .&mt('[_1](name).(number).(extension)[_2] not allowed.','','') + .'
' + .&mt('Replacing the [_1].number.[_2] with [_1]_letter.[_2] in requested filename.','','') + .'

'; + 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 .= '

' + .&mt('Changed ___ to a single _ in filename') + .'

'; + } + return ($fname,$warning); +} + sub phasethree { my ($r,$fn,$uname,$udom,$mode) = @_; @@ -433,6 +484,8 @@ sub phasethree { 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). ''; @@ -443,7 +496,7 @@ sub phasethree { if ($mode ne 'imsimport' && $mode ne 'testbank') { $result .= '

'. &mt('View main file').'

'. - '

'. + '

'. &mt('Back to Directory').'


'; } return ($result,$returnflag); @@ -472,13 +525,15 @@ sub phasefour { 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 .= '

'. &mt('View main file').'

'. - '

'. + '

'. &mt('Back to Directory').'


'; } return $result; @@ -498,12 +553,28 @@ sub handler { my $r=shift; my $javascript = ''; - my $fn=$env{'form.filename'}; + my $fn; + my $warning; if ($env{'form.filename1'}) { - $fn=$env{'form.filename1'}.$env{'form.filename2'}; + 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 .= '

' + .&mt('Path modified as a result of one or more instances of /../') + .'

'; + while ($fn =~ m{/\.\./}) { + $fn =~ s{/[^/]+/\.\./}{/}g; + } + } unless ($fn) { $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. @@ -514,8 +585,8 @@ sub handler { my ($uname,$udom)=&Apache::lonnet::constructaccess($fn); unless (($uname) && ($udom)) { - $r->log_reason($uname.' at '.$udom. - ' trying to publish file '.$env{'form.filename'}. + $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. + ' trying to upload file '.$fn. ' - not authorized', $r->filename); return HTTP_NOT_ACCEPTABLE; @@ -570,6 +641,9 @@ ENDJS .'

' ); } + if ($warning) { + $r->print($warning); + } if ($env{'form.phase'} eq 'four') { my $output = &phasefour($r,$fn,$uname,$udom,'author'); $r->print($output); @@ -584,7 +658,7 @@ ENDJS } $r->print(&Apache::loncommon::end_page()); - return OK; + return OK; } 1;