--- loncom/interface/loncommon.pm 2010/09/27 01:16:22 1.948.2.11 +++ loncom/interface/loncommon.pm 2010/12/25 17:35:53 1.948.2.18 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.948.2.11 2010/09/27 01:16:22 raeburn Exp $ +# $Id: loncommon.pm,v 1.948.2.18 2010/12/25 17:35:53 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2284,12 +2284,16 @@ function changed_text(choice,currentform } function set_auth_radio_buttons(newvalue,currentform) { + var numauthchoices = currentform.login.length; + if (typeof numauthchoices == "undefined") { + return; + } var i=0; - while (i < currentform.login.length) { + while (i < numauthchoices) { if (currentform.login[i].value == newvalue) { break; } i++; } - if (i == currentform.login.length) { + if (i == numauthchoices) { return; } current.radiovalue = newvalue; @@ -3256,7 +3260,6 @@ sub filemimetype { sub filecategoryselect { my ($name,$value)=@_; return &select_form($value,$name, - '' => &mt('Any category'), {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))}); } @@ -3428,6 +3431,7 @@ sub get_previous_attempt { my ($ign,@parts) = split(/\./,$key); if ($#parts > 0) { my $data=$parts[-1]; + next if ($data eq 'foilorder'); pop(@parts); if ($data eq 'type') { unless ($showsurv) { @@ -3464,6 +3468,7 @@ sub get_previous_attempt { ''.&mt('Transaction [_1]',$version).''; if (@hidden) { foreach my $key (sort(keys(%lasthash))) { + next if ($key =~ /\.foilorder$/); my $hide; foreach my $id (@hidden) { if ($key =~ /^\Q$id\E/) { @@ -3492,6 +3497,7 @@ sub get_previous_attempt { } } else { foreach my $key (sort(keys(%lasthash))) { + next if ($key =~ /\.foilorder$/); my $value = &format_previous_attempt_value($key, $returnhash{$version.':'.$key}); $prevattempts.=''.$value.' '; @@ -3503,6 +3509,7 @@ sub get_previous_attempt { my @currhidden = keys(%lasthidden); $prevattempts.=&start_data_table_row().''.&mt('Current').''; foreach my $key (sort(keys(%lasthash))) { + next if ($key =~ /\.foilorder$/); if (%typeparts) { my $hidden; foreach my $id (@currhidden) { @@ -3558,6 +3565,29 @@ sub format_previous_attempt_value { $value = &Apache::lonlocal::locallocaltime($value); } elsif (ref($value) eq 'ARRAY') { $value = '('.join(', ', @{ $value }).')'; + } elsif ($key =~ /answerstring$/) { + my %answers = &Apache::lonnet::str2hash($value); + my @anskeys = sort(keys(%answers)); + if (@anskeys == 1) { + my $answer = $answers{$anskeys[0]}; + if ($answer =~ m{\Q\0\E}) { + $answer =~ s{\Q\0\E}{, }g; + } + my $tag_internal_answer_name = 'INTERNAL'; + if ($anskeys[0] eq $tag_internal_answer_name) { + $value = $answer; + } else { + $value = $anskeys[0].'='.$answer; + } + } else { + foreach my $ans (@anskeys) { + my $answer = $answers{$ans}; + if ($answer =~ m{\Q\0\E}) { + $answer =~ s{\Q\0\E}{, }g; + } + $value .= $ans.'='.$answer.'
';; + } + } } else { $value = &unescape($value); } @@ -6809,7 +6839,7 @@ $args - additional optional args support should it have jsmath forced on by the current page bread_crumbs -> Array containing breadcrumbs - bread_crumbs_components -> if exists show it as headline else show only the breadcrumbs + bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs =back @@ -8437,68 +8467,307 @@ sub get_env_multiple { sub ask_for_embedded_content { my ($actionurl,$state,$allfiles,$codebase,$args)=@_; - my $upload_output = ' -
'; - $upload_output .= $state; - $upload_output .= 'Upload embedded files:
'.&start_data_table(); - + my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges); my $num = 0; - foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%{$allfiles})) { + my $numremref = 0; + my $numinvalid = 0; + my $numpathchg = 0; + my $numexisting = 0; + my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath); + if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { + my $current_path='/'; + if ($env{'form.currentpath'}) { + $current_path = $env{'form.currentpath'}; + } + if ($actionurl eq '/adm/coursegrp_portfolio') { + $udom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + $uname = $env{'course.'.$env{'request.course.id'}.'.num'}; + $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio'; + } else { + $udom = $env{'user.domain'}; + $uname = $env{'user.name'}; + $url = '/userfiles/portfolio'; + } + $toplevel = $url.'/'; + $url .= $current_path; + $getpropath = 1; + } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || + ($actionurl eq '/adm/imsimport')) { + ($uname,my $rest) = ($args->{'current_path'} =~ m{/priv/($match_username)/?(.*)$}); + $url = '/home/'.$uname.'/public_html/'; + $toplevel = $url; + if ($rest ne '') { + $url .= $rest; + } + } elsif ($actionurl eq '/adm/coursedocs') { + if (ref($args) eq 'HASH') { + $url = $args->{'docs_url'}; + $toplevel = $url; + } + } + my $now = time(); + foreach my $embed_file (keys(%{$allfiles})) { + my $absolutepath; + if ($embed_file =~ m{^\w+://}) { + $newfiles{$embed_file} = 1; + $mapping{$embed_file} = $embed_file; + } else { + if ($embed_file =~ m{^/}) { + $absolutepath = $embed_file; + $embed_file =~ s{^(/+)}{}; + } + if ($embed_file =~ m{/}) { + my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$}); + $path = &check_for_traversal($path,$url,$toplevel); + my $item = $fname; + if ($path ne '') { + $item = $path.'/'.$fname; + $subdependencies{$path}{$fname} = 1; + } else { + $dependencies{$item} = 1; + } + if ($absolutepath) { + $mapping{$item} = $absolutepath; + } else { + $mapping{$item} = $embed_file; + } + } else { + $dependencies{$embed_file} = 1; + if ($absolutepath) { + $mapping{$embed_file} = $absolutepath; + } else { + $mapping{$embed_file} = $embed_file; + } + } + } + } + foreach my $path (keys(%subdependencies)) { + my %currsubfile; + if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { + my @subdir_list = &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath); + foreach my $line (@subdir_list) { + my ($file_name,$rest) = split(/\&/,$line,2); + $currsubfile{$file_name} = 1; + } + } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) { + if (opendir(my $dir,$url.'/'.$path)) { + my @subdir_list = grep(!/^\./,readdir($dir)); + map {$currsubfile{$_} = 1;} @subdir_list; + } + } + foreach my $file (keys(%{$subdependencies{$path}})) { + if ($currsubfile{$file}) { + my $item = $path.'/'.$file; + unless ($mapping{$item} eq $item) { + $pathchanges{$item} = 1; + } + $existing{$item} = 1; + $numexisting ++; + } else { + $newfiles{$path.'/'.$file} = 1; + } + } + } + my %currfile; + if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { + my @dir_list = &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath); + foreach my $line (@dir_list) { + my ($file_name,$rest) = split(/\&/,$line,2); + $currfile{$file_name} = 1; + } + } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) { + if (opendir(my $dir,$url)) { + my @dir_list = grep(!/^\./,readdir($dir)); + map {$currfile{$_} = 1;} @dir_list; + } + } + foreach my $file (keys(%dependencies)) { + if ($currfile{$file}) { + unless ($mapping{$file} eq $file) { + $pathchanges{$file} = 1; + } + $existing{$file} = 1; + $numexisting ++; + } else { + $newfiles{$file} = 1; + } + } + foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) { $upload_output .= &start_data_table_row(). - ''.$embed_file.''; + ''.$embed_file.''; + unless ($mapping{$embed_file} eq $embed_file) { + $upload_output .= '
'.&mt('changed from: [_1]',$mapping{$embed_file}).''; + } + $upload_output .= ''; if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { $upload_output.=''.&mt("URL points to other server.").''; + $numremref++; } elsif ($args->{'error_on_invalid_names'} && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) { - $upload_output.=''.&mt("Invalid characters").''; - + $upload_output.=''.&mt('Invalid characters').''; + $numinvalid++; } else { - $upload_output .=' - - '; - my $attrib = join(':',@{$$allfiles{$embed_file}}); - $upload_output .= - "\n\t\t". - ''; - if (exists($$codebase{$embed_file})) { - $upload_output .= - "\n\t\t". - ''; - } - } - $upload_output .= ''.&Apache::loncommon::end_data_table_row(); - $num++; - } - $upload_output .= &Apache::loncommon::end_data_table().'
- - - '.&mt('(only files for which a location has been provided will be uploaded)').' -
'; - return $upload_output; + $upload_output .= &embedded_file_element('upload_embedded',$num, + $embed_file,\%mapping, + $allfiles,$codebase); + $num++; + } + $upload_output .= ''.&Apache::loncommon::end_data_table_row()."\n"; + } + foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) { + $upload_output .= &start_data_table_row(). + ''.$embed_file.''. + ''.&mt('Already exists').''. + &Apache::loncommon::end_data_table_row()."\n"; + } + if ($upload_output) { + $upload_output = &start_data_table(). + $upload_output. + &end_data_table()."\n"; + } + my $applies = 0; + if ($numremref) { + $applies ++; + } + if ($numinvalid) { + $applies ++; + } + if ($numexisting) { + $applies ++; + } + if ($num) { + $output = '
'."\n". + $state. + '

'.&mt('Upload embedded files'). + ':

'.$upload_output.'
'."\n". + ''."\n"; + if ($actionurl eq '') { + $output .= ''; + } + } elsif ($applies) { + $output = ''.&mt('Referenced files').':
'; + if ($applies > 1) { + $output .= + &mt('No files need to be uploaded, as one of the following applies to each reference:').'
'; + } elsif ($numremref) { + $output .= '

'.&mt('None to upload, as all references are to URLs pointing to another server.').'

'; + } elsif ($numinvalid) { + $output .= '

'.&mt('None to upload, as all references are to files with names containing invalid characters.').'

'; + } elsif ($numexisting) { + $output .= '

'.&mt('None to upload, as all references are to existing files.').'

'; + } + $output .= $upload_output.'
'; + } + my ($pathchange_output,$chgcount); + $chgcount = $num; + if (keys(%pathchanges) > 0) { + foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) { + if ($num) { + $output .= &embedded_file_element('pathchange',$chgcount, + $embed_file,\%mapping, + $allfiles,$codebase); + } else { + $pathchange_output .= + &start_data_table_row(). + ''. + ''.$mapping{$embed_file}.''. + ''.$embed_file. + &embedded_file_element('pathchange',$numpathchg,$embed_file, + \%mapping,$allfiles,$codebase). + ''.&end_data_table_row(); + } + $numpathchg ++; + $chgcount ++; + } + } + if ($num) { + if ($numpathchg) { + $output .= ''."\n"; + } + if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || + ($actionurl eq '/adm/imsimport')) { + $output .= ''."\n"; + } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') { + $output .= ''; + } + $output .= ''."\n". + &mt('(only files for which a location has been provided will be uploaded)').'
'."\n"; + } elsif ($numpathchg) { + my %pathchange = (); + $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output); + if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { + $output .= '

'.&mt('or').'

'; + } + } + return ($output,$num,$numpathchg); +} + +sub embedded_file_element { + my ($context,$num,$embed_file,$mapping,$allfiles,$codebase) = @_; + return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') && + (ref($codebase) eq 'HASH')); + my $output; + if ($context eq 'upload_embedded') { + $output = ''."\n"; + } + $output .= ''; + unless (($context eq 'upload_embedded') && + ($mapping->{$embed_file} eq $embed_file)) { + $output .=' + '; + } + my $attrib; + if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') { + $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}})); + } + $output .= + "\n\t\t". + ''; + if (exists($codebase->{$mapping->{$embed_file}})) { + $output .= + "\n\t\t". + ''; + } + return $output; } sub upload_embedded { my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota, - $current_disk_usage) = @_; - my $output; + $current_disk_usage,$hiddenstate,$actionurl) = @_; + my (%pathchange,$output,$modifyform,$footer,$returnflag); for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) { next if (!exists($env{'form.embedded_item_'.$i.'.filename'})); my $orig_uploaded_filename = $env{'form.embedded_item_'.$i.'.filename'}; - - $env{'form.embedded_orig_'.$i} = - &unescape($env{'form.embedded_orig_'.$i}); + foreach my $type ('orig','ref','attrib','codebase') { + if ($env{'form.embedded_'.$type.'_'.$i} ne '') { + $env{'form.embedded_'.$type.'_'.$i} = + &unescape($env{'form.embedded_'.$type.'_'.$i}); + } + } my ($path,$fname) = ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)}); # no path, whole string is fname if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} }; - - $path = $env{'form.currentpath'}.$path; $fname = &Apache::lonnet::clean_filename($fname); # See if there is anything left next if ($fname eq ''); @@ -8510,12 +8779,12 @@ sub upload_embedded { if ($group ne '') { $port_path = "groups/$group/$port_path"; } - ($state,$msg) = &check_for_upload($path,$fname,$group,'embedded_item_'.$i, + ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path, + $fname,$group,'embedded_item_'.$i, $dir_root,$port_path,$disk_quota, $current_disk_usage,$uname,$udom); if ($state eq 'will_exceed_quota' - || $state eq 'file_locked' - || $state eq 'file_exists' ) { + || $state eq 'file_locked') { $output .= $msg; next; } @@ -8529,31 +8798,53 @@ sub upload_embedded { # Check if extension is valid if (($fname =~ /\.(\w+)$/) && (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { - $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1); + $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1).'
'; next; } elsif (($fname =~ /\.(\w+)$/) && (!defined(&Apache::loncommon::fileembstyle($1)))) { - $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1); + $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'
'; next; } elsif ($fname=~/\.(\d+)\.(\w+)$/) { - $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2); + $output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'
'; next; } $env{'form.embedded_item_'.$i.'.filename'}=$fname; if ($context eq 'portfolio') { - my $result= - &Apache::lonnet::userfileupload('embedded_item_'.$i,'', - $dirpath.$path); + my $result; + if ($state eq 'existingfile') { + $result= + &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile', + $dirpath.$env{'form.currentpath'}.$path); + } else { + $result= + &Apache::lonnet::userfileupload('embedded_item_'.$i,'', + $dirpath. + $env{'form.currentpath'}.$path); + if ($result !~ m|^/uploaded/|) { + $output .= '' + .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].' + ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}) + .'
'; + next; + } else { + $output .= &mt('Uploaded [_1]',''. + $path.$fname.'').'
'; + } + } + } elsif ($context eq 'coursedoc') { + my $result = + &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc', + $dirpath.'/'.$path); if ($result !~ m|^/uploaded/|) { $output .= '' - .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].' + .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].' ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}) - .'
'; - next; + .'
'; + next; } else { - $output .= '

'.&mt('Uploaded [_1]',''. - $path.$fname.'').'

'; + $output .= &mt('Uploaded [_1]',''. + $path.$fname.'').'
'; } } else { # Save the file @@ -8583,19 +8874,190 @@ sub upload_embedded { &mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}). '
'; } else { - if ($context eq 'testbank') { - $output .= &mt('Embedded file uploaded successfully:'). - ' '. - $orig_uploaded_filename.'
'; - } else { - $output .= ''. - &mt('View embedded file: [_1]',''. - $orig_uploaded_filename.'').'
'; + $output .= &mt('Uploaded [_1]',''. + $url.'').'
'; + unless ($context eq 'testbank') { + $footer .= &mt('View embedded file: [_1]', + ''.$fname.'').'
'; } } close($fh); } } + if ($env{'form.embedded_ref_'.$i}) { + $pathchange{$i} = 1; + } + } + if ($output) { + $output = '

'.$output.'

'; + } + $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange); + $returnflag = 'ok'; + if (keys(%pathchange) > 0) { + if ($context eq 'portfolio') { + $output .= '

'.&mt('or').'

'; + } elsif ($context eq 'testbank') { + $output .= '

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

'; + $returnflag = 'modify_orightml'; + } + } + return ($output.$footer,$returnflag); +} + +sub modify_html_form { + my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_; + my $end = 0; + my $modifyform; + if ($context eq 'upload_embedded') { + return unless (ref($pathchange) eq 'HASH'); + if ($env{'form.number_embedded_items'}) { + $end += $env{'form.number_embedded_items'}; + } + if ($env{'form.number_pathchange_items'}) { + $end += $env{'form.number_pathchange_items'}; + } + if ($end) { + for (my $i=0; $i<$end; $i++) { + if ($i < $env{'form.number_embedded_items'}) { + next unless($pathchange->{$i}); + } + $modifyform .= + &start_data_table_row(). + ''. + ''.$env{'form.embedded_ref_'.$i}. + ''. + ''. + ''. + ''.$env{'form.embedded_orig_'.$i}. + ''. + &end_data_table_row(); + } + } + } else { + $modifyform = $pathchgtable; + if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) { + $hiddenstate .= ''; + } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { + $hiddenstate .= ''; + } + } + if ($modifyform) { + return '

'.&mt('Changes in content of HTML file required').'

'."\n". + '

'.&mt('Changes need to be made to the reference(s) used for one or more of the dependencies, if your HTML file is to work correctly:').'

    '."\n". + '
  1. '.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'
    2. '."\n". + '
  2. '.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'
    3. '."\n". + '

'."\n".'

'. + &mt('LON-CAPA can make the required changes to your HTML file.').'

'."\n". + '
'. + &start_data_table()."\n". + &start_data_table_header_row(). + ''.&mt('Change?').''. + ''.&mt('Current reference').''. + ''.&mt('Required reference').''. + &end_data_table_header_row()."\n". + $modifyform. + &end_data_table().'
'."\n".$hiddenstate. + ''. + '
'."\n"; + } + return; +} + +sub modify_html_refs { + my ($context,$dirpath,$uname,$udom,$dir_root) = @_; + my $container; + if ($context eq 'portfolio') { + $container = $env{'form.container'}; + } elsif ($context eq 'coursedoc') { + $container = $env{'form.primaryurl'}; + } else { + $container = $env{'form.filename'}; + $container =~ s{^/priv/(\Q$uname\E)/(.*)}{/home/$1/public_html/$2}; + } + my (%allfiles,%codebase,$output,$content); + my @changes = &get_env_multiple('form.namechange'); + return unless (@changes > 0); + if (($context eq 'portfolio') || ($context eq 'coursedoc')) { + return unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}); + $content = &Apache::lonnet::getfile($container); + return if ($content eq '-1'); + } else { + return unless ($container =~ /^\Q$dir_root\E/); + if (open(my $fh,"<$container")) { + $content = join('', <$fh>); + close($fh); + } else { + return; + } + } + my ($count,$codebasecount) = (0,0); + my $mm = new File::MMagic; + my $mime_type = $mm->checktype_contents($content); + if ($mime_type eq 'text/html') { + my $parse_result = + &Apache::lonnet::extract_embedded_items($container,\%allfiles, + \%codebase,\$content); + if ($parse_result eq 'ok') { + foreach my $i (@changes) { + my $orig = &unescape($env{'form.embedded_orig_'.$i}); + my $ref = &unescape($env{'form.embedded_ref_'.$i}); + if ($allfiles{$ref}) { + my $newname = $orig; + my ($attrib_regexp,$codebase); + my $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i}); + if ($attrib_regexp =~ /:/) { + $attrib_regexp =~ s/\:/|/g; + } + if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) { + my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi); + $count += $numchg; + } + if ($env{'form.embedded_codebase_'.$i} ne '') { + my $codebase = &unescape($env{'form.embedded_codebase_'.$i}); + my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs + $codebasecount ++; + } + } + } + if ($count || $codebasecount) { + my $saveresult; + if ($context eq 'portfolio' || $context eq 'coursedoc') { + my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult); + if ($url eq $container) { + my ($fname) = ($container =~ m{/([^/]+)$}); + $output = '

'.&mt('Updated [quant,_1,reference] in [_2].', + $count,''. + $fname.'').'

'; + } else { + $output = '

'. + &mt('Error: update failed for: [_1].', + ''. + $container.'').'

'; + } + } else { + if (open(my $fh,">$container")) { + print $fh $content; + close($fh); + $output = '

'.&mt('Updated [quant,_1,reference] in [_2].', + $count,''. + $container.'').'

'; + } else { + $output = '

'. + &mt('Error: could not update [_1].', + ''. + $container.'').'

'; + } + } + } + } else { + &logthis('Failed to parse '.$container. + ' to modify references: '.$parse_result); + } } return $output; } @@ -8619,14 +9081,24 @@ sub check_for_existing { sub check_for_upload { my ($path,$fname,$group,$element,$portfolio_root,$port_path, $disk_quota,$current_disk_usage,$uname,$udom) = @_; - my $filesize = (length($env{'form.'.$element})) / 1000; #express in k (1024?) + my $filesize = length($env{'form.'.$element}); + if (!$filesize) { + my $msg = ''. + &mt('Unable to upload [_1]. (size = [_2] bytes)', + ''.$fname.'', + $filesize).'
'. + &mt('Either the file you uploaded was empty, or your web browser was unable to read its contents.').'
'; + ''; + return ('zero_bytes',$msg); + } + $filesize = $filesize/1000; #express in k (1024?) my $getpropath = 1; my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname, $getpropath); my $found_file = 0; my $locked_file = 0; foreach my $line (@dir_list) { - my ($file_name)=split(/\&/,$line,2); + my ($file_name,$rest)=split(/\&/,$line,2); if ($file_name eq $fname){ $file_name = $path.$file_name; if ($group ne '') { @@ -8635,6 +9107,20 @@ sub check_for_upload { $found_file = 1; if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') { $locked_file = 1; + } else { + my @info = split(/\&/,$rest); + my $currsize = $info[6]/1000; + if ($currsize < $filesize) { + my $extra = $filesize - $currsize; + if (($current_disk_usage + $extra) > $disk_quota) { + my $msg = ''. + &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded if existing (smaller) file with same name (size = [_3] kilobytes) is replaced.', + ''.$fname.'',$filesize,$currsize).''. + '
'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.', + $disk_quota,$current_disk_usage); + return ('will_exceed_quota',$msg); + } + } } } } @@ -8652,15 +9138,55 @@ sub check_for_upload { return ('file_locked',$msg); } else { my $msg = ''; - $msg .= &mt('Unable to upload [_1]. A file by that name was found in [_2].',''.$fname.'',$port_path.$env{'form.currentpath'}); + $msg .= &mt(' A file by that name: [_1] was found in [_2].',''.$fname.'',$port_path.$env{'form.currentpath'}); $msg .= ''; - $msg .= '
'; - $msg .= &mt('To upload, rename or delete existing [_1] in [_2].',''.$fname.'', $port_path.$env{'form.currentpath'}); - return ('file_exists',$msg); + return ('existingfile',$msg); } } } +sub check_for_traversal { + my ($path,$url,$toplevel) = @_; + my @parts=split(/\//,$path); + my $cleanpath; + my $fullpath = $url; + for (my $i=0;$i<@parts;$i++) { + next if ($parts[$i] eq '.'); + if ($parts[$i] eq '..') { + $fullpath =~ s{([^/]+/)$}{}; + } else { + $fullpath .= $parts[$i].'/'; + } + } + if ($fullpath =~ /^\Q$url\E(.*)$/) { + $cleanpath = $1; + } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) { + my $curr_toprel = $1; + my @parts = split(/\//,$curr_toprel); + my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/); + my @urlparts = split(/\//,$url_toprel); + my $doubledots; + my $startdiff = -1; + for (my $i=0; $i<@urlparts; $i++) { + if ($startdiff == -1) { + unless ($urlparts[$i] eq $parts[$i]) { + $startdiff = $i; + $doubledots .= '../'; + } + } else { + $doubledots .= '../'; + } + } + if ($startdiff > -1) { + $cleanpath = $doubledots; + for (my $i=$startdiff; $i<@parts; $i++) { + $cleanpath .= $parts[$i].'/'; + } + } + } + $cleanpath =~ s{(/)$}{}; + return $cleanpath; +} =pod @@ -10888,6 +11414,36 @@ sub clean_symb { return ($symb,$enc); } +sub build_release_hashes { + my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_; + return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') && + (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') && + (ref($randomizetry) eq 'HASH')); + foreach my $key (keys(%Apache::lonnet::needsrelease)) { + my ($item,$name,$value) = split(/:/,$key); + if ($item eq 'parameter') { + if (ref($checkparms->{$name}) eq 'ARRAY') { + unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) { + push(@{$checkparms->{$name}},$value); + } + } else { + push(@{$checkparms->{$name}},$value); + } + } elsif ($item eq 'resourcetag') { + if ($name eq 'responsetype') { + $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key} + } + } elsif ($item eq 'course') { + if ($name eq 'crstype') { + $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key}; + } + } + } + ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'}); + ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'}); + return; +} + =pod =back