--- loncom/interface/loncommon.pm 2017/08/11 00:24:52 1.1288 +++ loncom/interface/loncommon.pm 2017/08/13 20:56:24 1.1292 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1288 2017/08/11 00:24:52 raeburn Exp $ +# $Id: loncommon.pm,v 1.1292 2017/08/13 20:56:24 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -84,6 +84,8 @@ use Crypt::DES; use DynaLoader; # for Crypt::DES version use MIME::Lite; use MIME::Types; +use File::Copy(); +use File::Path::Tiny(); # ---------------------------------------------- Designs use vars qw(%defaultdesign); @@ -2477,10 +2479,24 @@ sub create_text_file { # ------------------------------------------ sub domain_select { - my ($name,$value,$multiple)=@_; + my ($name,$value,$multiple,$incdoms,$excdoms)=@_; + my @possdoms; + if (ref($incdoms) eq 'ARRAY') { + @possdoms = @{$incdoms}; + } else { + @possdoms = &Apache::lonnet::all_domains(); + } + my %domains=map { $_ => $_.' '. &Apache::lonnet::domain($_,'description') - } &Apache::lonnet::all_domains(); + } @possdoms; + + if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) { + foreach my $dom (@{$excdoms}) { + delete($domains{$dom}); + } + } + if ($multiple) { $domains{''}=&mt('Any domain'); $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))]; @@ -12580,6 +12596,18 @@ sub decompress_uploaded_file { sub process_decompression { my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_; + unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) { + return '

'.&mt('Not extracted.').'
'. + &mt('Unexpected file path.').'

'."\n"; + } + unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) { + return '

'.&mt('Not extracted.').'
'. + &mt('Unexpected course context.').'

'."\n"; + } + unless ($file eq &Apache::lonnet::clean_name($file)) { + return '

'.&mt('Not extracted.').'
'. + &mt('Filename contained unexpected characters.').'

'."\n"; + } my ($dir,$error,$warning,$output); if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) { $error = &mt('Filename not a supported archive file type.'). @@ -12614,30 +12642,44 @@ sub process_decompression { } } my $numskip = scalar(@to_skip); - if (($numskip > 0) && - ($numskip == $env{'form.archive_itemcount'})) { + my $numoverwrite = scalar(@to_overwrite); + if (($numskip) && (!$numoverwrite)) { $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.'); } elsif ($dir eq '') { $error = &mt('Directory containing archive file unavailable.'); } elsif (!$error) { my ($decompressed,$display); - if ($numskip > 0) { + if (($numskip) || ($numoverwrite)) { my $tempdir = time.'_'.$$.int(rand(10000)); mkdir("$dir/$tempdir",0755); - system("mv $dir/$file $dir/$tempdir/$file"); - ($decompressed,$display) = - &decompress_uploaded_file($file,"$dir/$tempdir"); - foreach my $item (@to_skip) { - if (($item ne '') && ($item !~ /\.\./)) { - if (-f "$dir/$tempdir/$item") { - unlink("$dir/$tempdir/$item"); - } elsif (-d "$dir/$tempdir/$item") { - system("rm -rf $dir/$tempdir/$item"); + if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) { + ($decompressed,$display) = + &decompress_uploaded_file($file,"$dir/$tempdir"); + foreach my $item (@to_skip) { + if (($item ne '') && ($item !~ /\.\./)) { + if (-f "$dir/$tempdir/$item") { + unlink("$dir/$tempdir/$item"); + } elsif (-d "$dir/$tempdir/$item") { + &File::Path::Tiny::rm("$dir/$tempdir/$item"); + } + } + } + foreach my $item (@to_overwrite) { + if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) { + if (($item ne '') && ($item !~ /\.\./)) { + if (-f "$dir/$item") { + unlink("$dir/$item"); + } elsif (-d "$dir/$item") { + &File::Path::Tiny::rm("$dir/$item"); + } + &File::Copy::move("$dir/$tempdir/$item","$dir/$item"); + } } } + if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) { + &File::Path::Tiny::rm("$dir/$tempdir"); + } } - system("mv $dir/$tempdir/* $dir"); - rmdir("$dir/$tempdir"); } else { ($decompressed,$display) = &decompress_uploaded_file($file,$dir); @@ -12655,8 +12697,7 @@ sub process_decompression { if (ref($newdirlistref) eq 'ARRAY') { foreach my $dir_line (@{$newdirlistref}) { my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); - unless (($item =~ /^\.+$/) || ($item eq $file) || - ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) { + unless (($item =~ /^\.+$/) || ($item eq $file)) { push(@newitems,$item); if ($dirptr&$testdir) { $is_dir{$item} = 1; @@ -13259,12 +13300,13 @@ sub process_extracted_files { mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx"); } if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { - system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title"); - $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx"; - unless ($ishome) { - my $fetch = "$newdest{$i}/$title"; - $fetch =~ s/^\Q$prefix$dir\E//; - $prompttofetch{$fetch} = 1; + if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) { + $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx"; + unless ($ishome) { + my $fetch = "$newdest{$i}/$title"; + $fetch =~ s/^\Q$prefix$dir\E//; + $prompttofetch{$fetch} = 1; + } } } $LONCAPA::map::resources[$newidx]= @@ -13344,7 +13386,9 @@ sub process_extracted_files { } if ($fullpath ne '') { if (-e "$prefix$path") { - system("mv $prefix$path $fullpath/$title"); + unless (rename("$prefix$path","$fullpath/$title")) { + $warning .= &mt('Failed to rename dependency').'
'; + } } if (-e "$fullpath/$title") { my $showpath; @@ -13354,11 +13398,11 @@ sub process_extracted_files { $showpath = "/$title"; } $result .= '
  • '.&mt('[_1] included as a dependency',$showpath).'
    • '."\n"; - } - unless ($ishome) { - my $fetch = "$fullpath/$title"; - $fetch =~ s/^\Q$prefix$dir\E//; - $prompttofetch{$fetch} = 1; + unless ($ishome) { + my $fetch = "$fullpath/$title"; + $fetch =~ s/^\Q$prefix$dir\E//; + $prompttofetch{$fetch} = 1; + } } } } @@ -13656,20 +13700,21 @@ sub upfile_store { =pod -=item * &load_tmp_file($r) +=item * &load_tmp_file($r,$datatoken) Load uploaded file from tmp, $r should be the HTTP Request object, -needs $env{'form.datatoken'}, +$datatoken is the name to assign to the temporary file. sets $env{'form.upfile'} to the contents of the file =cut sub load_tmp_file { - my $r=shift; + my ($r,$datatoken) = @_; + return if ($datatoken eq ''); my @studentdata=(); { my $studentfile = $r->dir_config('lonDaemons'). - '/tmp/'.$env{'form.datatoken'}.'.tmp'; + '/tmp/'.$datatoken.'.tmp'; if ( open(my $fh,"<$studentfile") ) { @studentdata=<$fh>; close($fh); @@ -13678,6 +13723,14 @@ sub load_tmp_file { $env{'form.upfile'}=join('',@studentdata); } +sub valid_datatoken { + my ($datatoken) = @_; + if ($datatoken =~ /^$match_username\_$match_domain\_enroll_$match_domain\_$match_courseid\_\d+_\d+$/) { + return $datatoken; + } + return; +} + =pod =item * &upfile_record_sep()