[BACK]Return to loncfile.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / publisher

Diff for /loncom/publisher/loncfile.pm between versions 1.124 and 1.126

version 1.124, 2016/05/22 01:09:54 version 1.126, 2023/07/14 14:32:57
Line 109  sub Debug { Line 109  sub Debug {
 }  }
   
 sub done {  sub done {
     my ($url) = @_;      my ($destfn) = @_;
     return      return
        '<p>'         '<p>'
       .&Apache::lonhtmlcommon::confirm_success(&mt("Done"))        .&Apache::lonhtmlcommon::confirm_success(&mt("Done"))
       .'<br /><a href="'.$url.'">'.&mt("Continue").'</a>'        .'<br /><a href="'.&url($destfn).'">'.&mt("Continue").'</a>'
       .'<script type="text/javascript">'        .'<script type="text/javascript">'
       .'location.href="'.$url.'";'        .'location.href="'.&url($destfn,'js').'";'
       .'</script>'        .'</script>'
       .'</p>';        .'</p>';
 }  }
Line 167  sub URLToPath { Line 167  sub URLToPath {
 }  }
   
 sub url {  sub url {
     my $fn=shift;      my ($fn,$context) = @_;
     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};      my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
     $fn=~ s/^\Q$londocroot\E//;      $fn=~ s/^\Q$londocroot\E//;
     $fn=~s{/\./}{/}g;      $fn=~s{/\./}{/}g;
     $fn=&HTML::Entities::encode($fn,'<>"&');      if ($context eq 'js') {
           &js_escape(\$fn);
       } else {
           $fn=&HTML::Entities::encode($fn,'\'<>"&');
       }
     return $fn;      return $fn;
 }  }
   
Line 350  sub checksuffix { Line 354  sub checksuffix {
 }  }
   
 sub cleanDest {  sub cleanDest {
     my ($request,$dest,$subdir,$fn,$uname,$udom)=@_;      my ($dest,$subdir,$fn,$uname,$udom)=@_;
     #remove bad characters      #remove bad characters
     my $foundbad=0;      my $foundbad=0;
       my $warnings;
     my $error='';      my $error='';
     if ($subdir && $dest =~/\./) {      if ($subdir && $dest =~/\./) {
  $foundbad=1;   $foundbad=1;
Line 367  sub cleanDest { Line 372  sub cleanDest {
  my ($newpath)=($dest=~m|(.*)/|);   my ($newpath)=($dest=~m|(.*)/|);
  ($newpath,$error)=&relativeDest($fn,$newpath,$uname,$udom);   ($newpath,$error)=&relativeDest($fn,$newpath,$uname,$udom);
  if (! -d "$newpath") {   if (! -d "$newpath") {
     $request->print('<p class="LC_warning">'      $warnings = '<p class="LC_warning">'
                            .&mt("You have requested to create file in directory [_1] which doesn't exist. The requested directory path has been removed from the requested filename."                         .&mt("You have requested to create file in directory [_1] which doesn't exist. The requested directory path has been removed from the requested filename."
                                ,&display($newpath))                             ,&display($newpath))
                            .'</p>');                         .'</p>';
     $dest=~s|.*/||;      $dest=~s|.*/||;
  }   }
     }      }
     if ($dest =~ /\.(\d+)\.(\w+)$/){      if ($dest =~ /\.(\d+)\.(\w+)$/) {
  $request->print('<p class="LC_warning">'   $warnings .= '<p class="LC_warning">'
  .&mt('Bad filename [_1]',&display($dest))                      .&mt('Bad filename [_1]',&display($dest))
                         .'<br />'                      .'<br />'
                         .&mt('[_1](name).(number).(extension)[_2] not allowed.','<tt>','</tt>')                      .&mt('[_1](name).(number).(extension)[_2] not allowed.','<tt>','</tt>')
                         .'<br />'                      .'<br />'
                         .&mt('Removing the [_1].number.[_2] from requested filename.','<tt>','</tt>')                      .&mt('Removing the [_1].number.[_2] from requested filename.','<tt>','</tt>')
  .'</p>');                      .'</p>';
  $dest =~ s/\.(\d+)(\.\w+)$/$2/;   $dest =~ s/\.(\d+)(\.\w+)$/$2/;
     }      }
     if ($foundbad) {      if ($foundbad) {
         $request->print('<p class="LC_warning">'          $warnings .= '<p class="LC_warning">'
                        .&mt('Invalid characters in requested name have been removed.')                      .&mt('Invalid characters in requested name have been removed.')
                         .'</p>'                      .'</p>';
         );  
     }      }
     return ($dest,$error);      return ($dest,$error,$warnings);
 }  }
   
 sub relativeDest {  sub relativeDest {
Line 469  Parameters: Line 473  Parameters:
   
 sub CloseForm2 {  sub CloseForm2 {
     my ($request, $user, $fn) = @_;      my ($request, $user, $fn) = @_;
     $request->print(&done(&url($fn)));      $request->print(&done($fn));
 }  }
   
 =pod  =pod
Line 840  Parameters: Line 844  Parameters:
   
 =item   $newfilename  =item   $newfilename
                   - Name of the file to be created; no path information                    - Name of the file to be created; no path information
   
   =item   $warnings - Information about changes to filename made by cleanDest().
   
 =back  =back
   
 Side Effects:  Side Effects:
Line 856  button which returns you to the director Line 863  button which returns you to the director
 =cut  =cut
   
 sub NewFile1 {  sub NewFile1 {
     my ($request, $user, $domain, $fn, $newfilename) = @_;      my ($request, $user, $domain, $fn, $newfilename, $warnings) = @_;
     return if (&filename_check($newfilename) ne 'ok');      return if (&filename_check($newfilename,$warnings) ne 'ok');
   
     if ($env{'form.action'} =~ /new(.+)file/) {      if ($env{'form.action'} =~ /new(.+)file/) {
  my $extension=$1;   my $extension=$1;
Line 870  sub NewFile1 { Line 877  sub NewFile1 {
  }   }
     }      }
     my ($type, $result)=&exists($user,$domain,$newfilename);      my ($type, $result)=&exists($user,$domain,$newfilename);
     $request->print($result);  
     if ($type eq 'error') {      if ($type eq 'error') {
           $request->print($warnings.$result);
  $request->print('</form>');   $request->print('</form>');
     } else {      } else {
         my $extension;          my $extension;
Line 883  sub NewFile1 { Line 890  sub NewFile1 {
         my @okexts = qw(xml html xhtml htm xhtm problem page sequence rights sty task library js css txt);          my @okexts = qw(xml html xhtml htm xhtm problem page sequence rights sty task library js css txt);
         if (($extension eq '') || (!grep(/^\Q$extension\E/,@okexts))) {          if (($extension eq '') || (!grep(/^\Q$extension\E/,@okexts))) {
             my $validexts = '.'.join(', .',@okexts);              my $validexts = '.'.join(', .',@okexts);
               $request->print($warnings.$result);
             $request->print('<p class="LC_warning">'.              $request->print('<p class="LC_warning">'.
                 &mt('Invalid filename: ').&display($newfilename).'</p><p>'.                  &mt('Invalid filename: ').&display($newfilename).'</p><p>'.
                 &mt('The name of the new file needs to end with an appropriate file extension to indicate the type of file to create.').'<br />'.                  &mt('The name of the new file needs to end with an appropriate file extension to indicate the type of file to create.').'<br />'.
Line 895  sub NewFile1 { Line 903  sub NewFile1 {
                 '</span></form></p>'.                  '</span></form></p>'.
                 '<p><form action="'.&url($fn).                  '<p><form action="'.&url($fn).
                 '" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></form></p>');                  '" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></form></p>');
         } elsif ($type ne 'warning') {          } elsif (($type ne 'warning') && ($warnings eq '') && ($result eq '')) {
             my $query = "";              my $query = "";
             $query .= "?mode=" . $env{'form.mode'} unless (!exists($env{'form.mode'}) || !length($env{'form.mode'}));              $query .= "?mode=" . $env{'form.mode'} unless (!exists($env{'form.mode'}) || !length($env{'form.mode'}));
             $request->print('              $request->print('
                 <script type="text/javascript">                  <script type="text/javascript">
                     window.location = "'.&url($newfilename). $query .'";                      window.location = "'.&url($newfilename,'js'). $query .'";
                 </script>');                  </script>');
         } else {          } else {
               $request->print($warnings.$result);
             $request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>');              $request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>');
             $request->print('</form>');              $request->print('</form>');
             $request->print('<form action="'.&url($newfilename).              $request->print('<form action="'.&url($newfilename).
Line 965  sub phaseone { Line 974  sub phaseone {
       
     my $doingdir=0;      my $doingdir=0;
     if ($env{'form.action'} eq 'newdir') { $doingdir=1; }      if ($env{'form.action'} eq 'newdir') { $doingdir=1; }
     my ($newfilename,$error) =       my ($newfilename,$error,$warnings) = 
         &cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname,$udom);          &cleanDest($env{'form.newfilename'},$doingdir,$fn,$uname,$udom);
     unless ($error) {      unless ($error) {
         ($newfilename,$error)=&relativeDest($fn,$newfilename,$uname,$udom);          ($newfilename,$error)=&relativeDest($fn,$newfilename,$uname,$udom);
     }      }
Line 977  sub phaseone { Line 986  sub phaseone {
         } else {          } else {
             $dirlist=$fn;               $dirlist=$fn; 
         }          }
           if ($warnings) {
               $r->print($warnings);
           }
         $r->print('<div class="LC_error">'.$error.'</div>'.          $r->print('<div class="LC_error">'.$error.'</div>'.
                   '<p><a href="'.&url($dirlist).'">'.&mt('Return to Directory').                    '<p><a href="'.&url($dirlist).'">'.&mt('Return to Directory').
                   '</a></p>');                    '</a></p>');
Line 986  sub phaseone { Line 998  sub phaseone {
       '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.        '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
       '<input type="hidden" name="phase" value="two" />'.        '<input type="hidden" name="phase" value="two" />'.
       '<input type="hidden" name="action" value="'.$env{'form.action'}.'" />');        '<input type="hidden" name="action" value="'.$env{'form.action'}.'" />');
     
     if ($env{'form.action'} eq 'rename') {      if ($env{'form.action'} eq 'newfile' ||
  &Rename1($r, $uname, $udom, $fn, $newfilename, 'rename');          $env{'form.action'} eq 'newhtmlfile' ||
     } elsif ($env{'form.action'} eq 'move') {          $env{'form.action'} eq 'newproblemfile' ||
  &Rename1($r, $uname, $udom, $fn, $newfilename, 'move');          $env{'form.action'} eq 'newpagefile' ||
     } elsif ($env{'form.action'} eq 'delete') {           $env{'form.action'} eq 'newsequencefile' ||
  &Delete1($r, $uname, $udom, $fn);          $env{'form.action'} eq 'newrightsfile' ||
     } elsif ($env{'form.action'} eq 'decompress') {          $env{'form.action'} eq 'newstyfile' ||
  &Decompress1($r, $uname, $udom, $fn);          $env{'form.action'} eq 'newtaskfile' ||
     } elsif ($env{'form.action'} eq 'copy') {           $env{'form.action'} eq 'newlibraryfile' ||
  if($newfilename) {          $env{'form.action'} eq 'Select Action') {
     &Copy1($r, $uname, $udom, $fn, $newfilename);  
  } else {  
             $r->print('<p class="LC_error">'  
                      .&mt('No new filename specified.')  
                      .'</p></form>'  
             );  
  }  
     } elsif ($env{'form.action'} eq 'newdir') {  
  my $mode = '';  
  if (exists($env{'form.callingmode'}) ) {  
     $mode = $env{'form.callingmode'};  
  }     
  &NewDir1($r, $uname, $udom, $fn, $newfilename, $mode);  
     }  elsif ($env{'form.action'} eq 'newfile' ||  
       $env{'form.action'} eq 'newhtmlfile' ||  
       $env{'form.action'} eq 'newproblemfile' ||  
       $env{'form.action'} eq 'newpagefile' ||  
       $env{'form.action'} eq 'newsequencefile' ||  
       $env{'form.action'} eq 'newrightsfile' ||  
       $env{'form.action'} eq 'newstyfile' ||  
       $env{'form.action'} eq 'newtaskfile' ||  
               $env{'form.action'} eq 'newlibraryfile' ||  
       $env{'form.action'} eq 'Select Action') {  
         my $empty=&mt('Type Name Here');          my $empty=&mt('Type Name Here');
  if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) {          if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) {
     &NewFile1($r, $uname, $udom, $fn, $newfilename);              &NewFile1($r, $uname, $udom, $fn, $newfilename, $warnings);
  } else {          } else {
               if ($warnings) {
                   $r->print($warnings);
               }
             $r->print('<p class="LC_error">'              $r->print('<p class="LC_error">'
                      .&mt('No new filename specified.')                       .&mt('No new filename specified.')
                      .'</p></form>'                       .'</p></form>'
             );              );
  }          }
       } else {
           if ($warnings) {
               $r->print($warnings);
           }
           if ($env{'form.action'} eq 'rename') {
       &Rename1($r, $uname, $udom, $fn, $newfilename, 'rename');
           } elsif ($env{'form.action'} eq 'move') {
       &Rename1($r, $uname, $udom, $fn, $newfilename, 'move');
           } elsif ($env{'form.action'} eq 'delete') { 
       &Delete1($r, $uname, $udom, $fn);
           } elsif ($env{'form.action'} eq 'decompress') {
       &Decompress1($r, $uname, $udom, $fn);
           } elsif ($env{'form.action'} eq 'copy') { 
       if ($newfilename) {
           &Copy1($r, $uname, $udom, $fn, $newfilename);
       } else {
                   $r->print('<p class="LC_error">'
                            .&mt('No new filename specified.')
                            .'</p></form>'
                   );
               }
           } elsif ($env{'form.action'} eq 'newdir') {
       my $mode = '';
       if (exists($env{'form.callingmode'}) ) {
           $mode = $env{'form.callingmode'};
       }
       &NewDir1($r, $uname, $udom, $fn, $newfilename, $mode);
           }
     }      }
 }  }
   
Line 1417  sub phasetwo { Line 1437  sub phasetwo {
                      ['<a href="'.&url($dest).'">'.&mt('Return to Directory').'</a>',                       ['<a href="'.&url($dest).'">'.&mt('Return to Directory').'</a>',
                       '<a href="'.&url($dest_newname).'">'.$disp_newname.'</a>']));                        '<a href="'.&url($dest_newname).'">'.$disp_newname.'</a>']));
         } else {          } else {
     $r->print(&done(&url($dest)));      $r->print(&done($dest));
  }   }
     }      }
 }  }
Line 1457  sub handler { Line 1477  sub handler {
  return HTTP_NOT_FOUND;   return HTTP_NOT_FOUND;
     }      }
   
     unless ($fn) {       unless ($fn) {
  &Debug($r, "loncfile::handler - doctored url is empty");   &Debug($r, "loncfile::handler - doctored url is empty");
  $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.   $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
        ' trying to cfile non-existing file', $r->filename);          ' trying to cfile non-existing file', $r->filename); 
Line 1500  function writeDone() { Line 1520  function writeDone() {
     my $londocroot = $r->dir_config('lonDocRoot');      my $londocroot = $r->dir_config('lonDocRoot');
     my $trailfile = $fn;      my $trailfile = $fn;
     $trailfile =~ s{^/(priv/)}{$londocroot/$1};      $trailfile =~ s{^/(priv/)}{$londocroot/$1};
       
     # Breadcrumbs      # Breadcrumbs
       my $crsauthor;
       my $text = 'Authoring Space';
       my $title = 'Authoring Space File Operation',
       my $href = &Apache::loncommon::authorspace(&url($fn));
       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';
               $title = 'Course Authoring Space File Operation',
               $crsauthor = 1;
           }
       }
     &Apache::lonhtmlcommon::clear_breadcrumbs();      &Apache::lonhtmlcommon::clear_breadcrumbs();
     &Apache::lonhtmlcommon::add_breadcrumb({      &Apache::lonhtmlcommon::add_breadcrumb({
         'text'  => 'Authoring Space',          'text'  => $text,
         'href'  => &Apache::loncommon::authorspace($fn),          'href'  => $href,
     });      });
     &Apache::lonhtmlcommon::add_breadcrumb({      &Apache::lonhtmlcommon::add_breadcrumb({
         'text'  => 'File Operation',          'text'  => 'File Operation',
         'title' => 'Authoring Space File Operation',          'title' => $title,
         'href'  => '',          'href'  => '',
     });      });
   
     $r->print(&Apache::loncommon::start_page('Authoring Space File Operation',      $r->print(&Apache::loncommon::start_page($title,
      $js,       $js,
      {'add_entries' => \%loaditem,})       {'add_entries' => \%loaditem,})
              .&Apache::lonhtmlcommon::breadcrumbs()               .&Apache::lonhtmlcommon::breadcrumbs()
Line 1524  function writeDone() { Line 1557  function writeDone() {
     $r->print('<p>'.&mt('Location').': '.&display($fn).'</p>');      $r->print('<p>'.&mt('Location').': '.&display($fn).'</p>');
       
     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {      if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
         $r->print('<p class="LC_info">'          unless ($crsauthor) {  
                  .&mt('Co-Author [_1]',$uname.':'.$udom)              $r->print('<p class="LC_info">'
                  .'</p>'                       .&mt('Co-Author [_1]',$uname.':'.$udom)
         );                       .'</p>'
               );
           }
     }      }
   
   
Line 1551  function writeDone() { Line 1586  function writeDone() {
  'Select Action'   => 'New Resource',   'Select Action'   => 'New Resource',
     );      );
     if ($action{$env{'form.action'}}) {      if ($action{$env{'form.action'}}) {
           if ($crsauthor) {
               my @disallowed = qw(page sequence rights library);
               my $newtype;
               if ($env{'form.action'} =~ /^new(\w+)file$/) {
                   $newtype = $1;
               } elsif ($env{'form.action'} eq 'newfile') {
                   ($newtype) = ($env{'form.newfilename'} =~ m{\.([^/.]+)$});
                   $newtype = lc($newtype);
               }
               if (($newtype ne '') &&
                   (grep(/^\Q$newtype\E$/,@disallowed))) {
                   $r->print('<p class="LC_error">'
                            .&mt('Creation of a new file of type: [_1] is not permitted in Course Authoring Space',$newtype)
                            .'</p>'
                            .&Apache::loncommon::end_page()
                   );
                   return OK;
               }
           }
         $r->print('<h2>'.$action{$env{'form.action'}}.'</h2>');          $r->print('<h2>'.$action{$env{'form.action'}}.'</h2>');
     } else {      } else {
         $r->print('<p class="LC_error">'          $r->print('<p class="LC_error">'
Removed from v.1.124  
changed lines
  Added in v.1.126

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>