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

Diff for /loncom/publisher/loncfile.pm between versions 1.98 and 1.111

version 1.98, 2009/05/14 14:24:18 version 1.111, 2011/10/24 22:39:21
Line 161  sub URLToPath { Line 161  sub URLToPath {
     $Url=~ s/\/+/\//g;      $Url=~ s/\/+/\//g;
     $Url=~ s/^https?\:\/\/[^\/]+//;      $Url=~ s/^https?\:\/\/[^\/]+//;
     $Url=~ s/^\///;      $Url=~ s/^\///;
     $Url=~ s/(\~|priv\/)($match_username)\//\/home\/$2\/public_html\//;      $Url='/home/httpd/html/'.$Url;
     &Debug($r, "Returning $Url \n");      &Debug($r, "Returning $Url \n");
     return $Url;      return $Url;
 }  }
   
 sub url {  sub url {
     my $fn=shift;      my $fn=shift;
     $fn=~s/^\/home\/($match_username)\/public\_html/\/priv\/$1/;      $fn=~s/^\/home\/httpd\/html//;
       $fn=~s/\/\.\//\//g;
     $fn=&HTML::Entities::encode($fn,'<>"&');      $fn=&HTML::Entities::encode($fn,'<>"&');
     return $fn;      return $fn;
 }  }
   
 sub display {  sub display {
     my $fn=shift;      my $fn=shift;
     $fn=~s-^/home/($match_username)/public_html-/priv/$1-;      $fn=~s/^\/home\/httpd\/html//;
       $fn=~s/\/\.\//\//g;
     return '<span class="LC_filename">'.$fn.'</span>';      return '<span class="LC_filename">'.$fn.'</span>';
 }  }
   
Line 187  sub display { Line 189  sub display {
 sub obsolete_unpub {  sub obsolete_unpub {
     my ($user,$domain,$construct)=@_;      my ($user,$domain,$construct)=@_;
     my $published=$construct;      my $published=$construct;
     $published=~      $published=~s/^\/home\/httpd\/html\/priv\//\/home\/httpd\/html\/res\//;
  s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//;  
     if (-e $published) {      if (-e $published) {
  if (&Apache::lonnet::metadata($published,'obsolete')) {   if (&Apache::lonnet::metadata($published,'obsolete')) {
     return 1;      return 1;
Line 270  sub exists { Line 271  sub exists {
     $creating ||= 'file';      $creating ||= 'file';
   
     my $published=$construct;      my $published=$construct;
     $published=~      $published=~s{^/home/httpd/html/priv/}{/home/httpd/html/res/};
  s{^/home/$user/public_html/}{/home/httpd/html/res/$domain/$user/};  
     my ($type,$result);      my ($type,$result);
     if ( -d $construct ) {      if ( -d $construct ) {
  return ('error','<p><span class="LC_error">'.&mt('Error: destination for operation is an existing directory.').'</span></p>');   return ('error','<p><span class="LC_error">'.&mt('Error: destination for operation is an existing directory.').'</span></p>');
Line 345  sub checksuffix { Line 345  sub checksuffix {
 }  }
   
 sub cleanDest {  sub cleanDest {
     my ($request,$dest,$subdir,$fn,$uname)=@_;      my ($request,$dest,$subdir,$fn,$uname,$udom)=@_;
     #remove bad characters      #remove bad characters
     my $foundbad=0;      my $foundbad=0;
       my $error='';
     if ($subdir && $dest =~/\./) {      if ($subdir && $dest =~/\./) {
  $foundbad=1;   $foundbad=1;
  $dest=~s/\.//g;   $dest=~s/\.//g;
Line 359  sub cleanDest { Line 360  sub cleanDest {
     }      }
     if ($dest=~m|/|) {      if ($dest=~m|/|) {
  my ($newpath)=($dest=~m|(.*)/|);   my ($newpath)=($dest=~m|(.*)/|);
  $newpath=&relativeDest($fn,$newpath,$uname);   ($newpath,$error)=&relativeDest($fn,$newpath,$uname,$udom);
  if (! -d "$newpath") {   if (! -d "$newpath") {
     $request->print('<p><span class="LC_error">'      $request->print('<p><span 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 file name."                             .&mt("You have requested to create file in directory [_1] which doesn't exist. The requested directory path has been removed from the requested file name."
                                ,'"'.&display($newpath).'"')                                 ,&display($newpath))
                            .'</span></p>');                             .'</span></p>');
     $dest=~s|.*/||;      $dest=~s|.*/||;
  }   }
     }      }
     if ($dest =~ /\.(\d+)\.(\w+)$/){      if ($dest =~ /\.(\d+)\.(\w+)$/){
  $request->print('<span class="LC_error">'   $request->print('<p><span class="LC_warning">'
  .&mt('Bad filename [_1]','<span class="LC_filename">'.&display($dest).'</span>')   .&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>')
  .'</span>');   .'</span></p>');
  $dest =~ s/\.(\d+)(\.\w+)$/$2/;   $dest =~ s/\.(\d+)(\.\w+)$/$2/;
     }      }
     if ($foundbad) {      if ($foundbad) {
  $request->print("<p><span class=\"LC_error\">".&mt('Invalid characters in requested name have been removed.')."</span></p>");          $request->print('<p><span class="LC_warning">'
                          .&mt('Invalid characters in requested name have been removed.')
                           .'</span></p>'
           );
     }      }
     return $dest;      return ($dest,$error);
 }  }
   
 sub relativeDest {  sub relativeDest {
     my ($fn,$newfilename,$uname)=@_;      my ($fn,$newfilename,$uname,$udom)=@_;
       my $error = '';
     if ($newfilename=~/^\//) {      if ($newfilename=~/^\//) {
 # absolute, simply add path  # absolute, simply add path
  $newfilename='/home/'.$uname.'/public_html/';   $newfilename='/home/httpd/html/res/'.$udom.'/'.$uname.'/';
     } else {      } else {
  my $dir=$fn;   my $dir=$fn;
  $dir=~s/\/[^\/]+$//;   $dir=~s/\/[^\/]+$//;
Line 398  sub relativeDest { Line 403  sub relativeDest {
     while ($newfilename=~m:/\.\./:) {      while ($newfilename=~m:/\.\./:) {
  $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..   $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
     }      }
     return $newfilename;      my ($authorname,$authordom)=&Apache::loncacc::constructaccess($newfilename);
       unless (($authorname) && ($authordom)) {
          my $otherdir = &display($newfilename);
          $error = &mt('Access denied to [_1]',$otherdir);
       }
       return ($newfilename,$error);
 }  }
   
 =pod  =pod
Line 514  sub Rename1 { Line 524  sub Rename1 {
     if (-d $fn) {      if (-d $fn) {
  $newfilename=~/\.(\w+)$/;   $newfilename=~/\.(\w+)$/;
  if (&Apache::loncommon::fileembstyle($1) eq 'ssi') {   if (&Apache::loncommon::fileembstyle($1) eq 'ssi') {
     $request->print('<br /><span classr="LC_warning">'.      $request->print('<p><span class="LC_error">'.
     &mt('Cannot change MIME type of a directory').      &mt('Cannot change MIME type of a directory.').
     '</span>'.      '</span>'.
     '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');      '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>');
     return;      return;
  }   }
  $newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/;   $newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/;
Line 533  sub Rename1 { Line 543  sub Rename1 {
  return;   return;
     }      }
     unless (&obsolete_unpub($user,$domain,$fn)) {      unless (&obsolete_unpub($user,$domain,$fn)) {
  $request->print('<h3>'.&mt('Cannot rename or move non-obsolete published file').'</h3>'.                  $request->print('<p><span class="LC_error">'
  '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');                                 .&mt('Cannot rename or move non-obsolete published file.')
                                  .'</span><br />'
                                  .'<a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>'
                   );
  return;   return;
     }      }
     my $action;      my $action;
     if ($style eq 'rename') {      if ($style eq 'rename') {
  $action=&mt('Rename');   $action='Rename';
     } else {      } else {
  $action=&mt('Move');   $action='Move';
     }      }
     $request->print('<input type="hidden" name="newfilename" value="'.              $request->print('<input type="hidden" name="newfilename" value="'
     $newfilename.                             .$newfilename.'" />'
     '" /><p>'.$action.' '.&display($fn).                             .'<p>'
     '</p><br />to '.&display($newfilename).'?</p>');                             .&mt($action.' [_1] to [_2]?',
                                   &display($fn),
                                   &display($newfilename))
                              .'</p>'
           );
     &CloseForm1($request, $fn);      &CloseForm1($request, $fn);
  } else {   } else {
     $request->print('<p>'.&mt('No new filename specified.').'</p></form>');      $request->print('<p class="LC_error">'.&mt('No new filename specified.').'</p></form>');
     return;      return;
  }   }
     } else {      } else {
  $request->print('<p> '.&mt('No such file').': '.&display($fn).'</p></form>');          $request->print('<p class="LC_error">'
                          .&mt('No such file: [_1]',
                               &display($fn))
                          .'</p></form>'
           );
  return;   return;
     }      }
           
Line 591  sub Delete1 { Line 612  sub Delete1 {
  $fn.'" />');   $fn.'" />');
         if (-d $fn) {          if (-d $fn) {
             unless (&empty_directory($fn,'Delete1')) {              unless (&empty_directory($fn,'Delete1')) {
                 $request->print('<h3>'.&mt('Only empty directories may be deleted.').'</h3>'.                  $request->print('<p>'
                             'You must delete the contents of the directory first.<br />'.                                 .'<span class="LC_error">'
                             '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');                                 .&mt('Only empty directories may be deleted.')
                                  .'</span><br />'
                                  .&mt('You must delete the contents of the directory first.')
                                  .'</p>'
                                  .'<p><a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>'
                   );
                 return;                  return;
             }              }
         } else {           } else { 
     unless (&obsolete_unpub($user,$domain,$fn)) {      unless (&obsolete_unpub($user,$domain,$fn)) {
         $request->print('<h3>'.&mt('Cannot delete non-obsolete published file').'</h3>'.                  $request->print('<p><span class="LC_error">'
     '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');                                 .&mt('Cannot delete non-obsolete published file.')
                                  .'</span><br />'
                                  .'<a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>'
                   );
         return;          return;
     }      }
         }          }
  $request->print('<p>'.&mt('Delete').' '.&display($fn).'?</p>');          $request->print('<p>'
                          .&mt('Delete [_1]?',
                               &display($fn))
                          .'</p>'
           );
  &CloseForm1($request, $fn);   &CloseForm1($request, $fn);
     } else {      } else {
  $request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');          $request->print('<p class="LC_error">'
                          .&mt('No such file: [_1]',
                               &display($fn))
                          .'</p></form>'
           );
     }      }
 }  }
   
Line 660  sub Copy1 { Line 697  sub Copy1 {
     $request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');      $request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
     return;      return;
  }   }
  $request->print('<input type="hidden" name="newfilename" value="'.      $request->print(
  $newfilename.          '<input type="hidden" name="newfilename"'
  '" /><p>'.&mt('Copy').' '.&display($fn).'<br />to '.         .' value="'.$newfilename.'" />'
  &display($newfilename).'?</p>');         .'<p>'
          .&mt('Copy [_1] to [_2]?',
               &display($fn),
               &display($newfilename))
          .'</p>'
           );
  &CloseForm1($request, $fn);   &CloseForm1($request, $fn);
     } else {      } else {
  $request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');          $request->print('<p class="LC_error">'
                          .&mt('No such file: [_1]',
                               &display($fn))
                          .'</p></form>'
           );
     }      }
 }  }
   
Line 717  sub NewDir1 { Line 763  sub NewDir1 {
     if ($type eq 'error') {      if ($type eq 'error') {
  $request->print('</form>');   $request->print('</form>');
     } else {      } else {
  if ($mode eq 'testbank') {   if (($mode eq 'testbank') || ($mode eq 'imsimport')) {
     $request->print('<input type="hidden" name="callingmode" value="testbank" />');      $request->print('<input type="hidden" name="callingmode" value="'.$mode.'" />'."\n".
  } elsif ($mode eq 'imsimport') {                              '<input type="hidden" name="inhibitmenu" value="yes" />');
     $request->print('<input type="hidden" name="callingmode" value="imsimport" />');   }
  }          $request->print('<input type="hidden" name="newfilename" value="'
  $request->print('<input type="hidden" name="newfilename" value="'.                         .$newfilename.'" />'
  $newfilename.'" /><p>'.&mt('Make new directory').' '.                         .'<p>'
  &display($newfilename).'?</p>');                         .&mt('Make new directory [_1]?',
                               &display($newfilename))
                          .'</p>'
           );
  &CloseForm1($request, $fn);   &CloseForm1($request, $fn);
     }      }
 }  }
Line 734  sub Decompress1 { Line 783  sub Decompress1 {
     my ($request, $user, $domain, $fn) = @_;      my ($request, $user, $domain, $fn) = @_;
     if( -e $fn) {      if( -e $fn) {
     $request->print('<input type="hidden" name="newfilename" value="'.$fn.'" />');      $request->print('<input type="hidden" name="newfilename" value="'.$fn.'" />');
     $request->print('<p>'.&mt('Decompress').' '.&display($fn).'?</p>');      $request->print('<p>'
                      .&mt('Decompress [_1]?',
                           &display($fn))
                      .'</p>'
       );
     &CloseForm1($request, $fn);      &CloseForm1($request, $fn);
     } else {      } else {
  $request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');          $request->print('<p class="LC_error">'
                          .&mt('No such file: [_1]',
                               &display($fn))
                          .'</p></form>'
           );
     }      }
 }  }
   
Line 806  sub NewFile1 { Line 863  sub NewFile1 {
             $extension = $1;              $extension = $1;
         }          }
   
         my @okexts = qw(xml html xhtml htm xhtm problem page sequence rights sty 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('<p class="LC_warning">'.              $request->print('<p class="LC_warning">'.
Line 886  sub phaseone { Line 943  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=&cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname);      my ($newfilename,$error) = 
     $newfilename=&relativeDest($fn,$newfilename,$uname);          &cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname,$udom);
       unless ($error) {
           ($newfilename,$error)=&relativeDest($fn,$newfilename,$uname,$udom);
       }
       if ($error) {
           my $dirlist;
           if ($fn=~m{^(.*/)[^/]+$}) {
               $dirlist=$1;
           } else {
               $dirlist=$fn; 
           }
           $r->print('<div class="LC_error">'.$error.'</div>'.
                     '<h3><a href="'.&url($dirlist).'">'.&mt('Return to Directory').
                     '</a></h3>');
           return;
       }
     $r->print('<form action="/adm/cfile" method="post">'.      $r->print('<form action="/adm/cfile" method="post">'.
       '<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" />'.
Line 905  sub phaseone { Line 977  sub phaseone {
  if($newfilename) {   if($newfilename) {
     &Copy1($r, $uname, $udom, $fn, $newfilename);      &Copy1($r, $uname, $udom, $fn, $newfilename);
  } else {   } else {
     $r->print('<p>'.&mt('No new filename specified.').'</p></form>');              $r->print('<p class="LC_error">'
                        .&mt('No new filename specified.')
                        .'</p></form>'
               );
  }   }
     } elsif ($env{'form.action'} eq 'newdir') {      } elsif ($env{'form.action'} eq 'newdir') {
  my $mode = '';   my $mode = '';
Line 927  sub phaseone { Line 1002  sub phaseone {
  if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) {   if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) {
     &NewFile1($r, $uname, $udom, $fn, $newfilename);      &NewFile1($r, $uname, $udom, $fn, $newfilename);
  } else {   } else {
     $r->print('<p>'.&mt('No new filename specified.').'</p></form>');              $r->print('<p class="LC_error">'
                        .&mt('No new filename specified.')
                        .'</p></form>'
               );
  }   }
     }      }
 }  }
Line 1014  sub Rename2 { Line 1092  sub Rename2 {
     unlink $tmp2;      unlink $tmp2;
  }   }
     } else {      } else {
  $request->print("<p> ".&mt('No such file').": ".&display($oldfile).'</p></form>');          $request->print(
               '<p>'
              .&mt('No such file: [_1]',
                   &display($oldfile))
              .'</p></form>'
           );
  return 0;   return 0;
     }      }
     return 1;      return 1;
Line 1062  sub Delete2 { Line 1145  sub Delete2 {
     return 0;      return 0;
  }   }
     } else {      } else {
  $request->print('<p> '.&mt('No such file').'. </p></form>');          $request->print('<p class="LC_error">'.&mt('No such file').'</p></form>');
  return 0;   return 0;
     }      }
  }   }
Line 1073  sub Delete2 { Line 1156  sub Delete2 {
  return 0;   return 0;
     }      }
  } else {   } else {
     $request->print('<p> '.&mt('No such file').'. </p></form>');              $request->print('<p class="LC_error">'.&mt('No such file').'</p></form>');
     return 0;      return 0;
  }   }
     }      }
Line 1132  sub Copy2 { Line 1215  sub Copy2 {
     return 1;      return 1;
  }   }
     } else {      } else {
  $request->print('<p> '.&mt('No such file').' </p>');          $request->print('<p class="LC_error">'.&mt('No such file').'</p>');
  return 0;   return 0;
     }      }
     return 1;      return 1;
Line 1286  sub phasetwo { Line 1369  sub phasetwo {
     }      }
     $dest = $env{'form.newfilename'};      $dest = $env{'form.newfilename'};
       } else {        } else {
     $r->print('<p>'.&mt('No New filename specified').'</p></form>');              $r->print('<p class="LC_error">'.&mt('No New filename specified').'</p></form>');
     return;      return;
  }   }
   
Line 1355  sub handler { Line 1438  sub handler {
     my $uname;      my $uname;
     my $udom;      my $udom;
   
     ($uname,$udom)=      ($uname,$udom)=&Apache::loncacc::constructaccess($fn);
  &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));  
     &Debug($r,       &Debug($r, 
    "loncfile::handler constructaccess uname = $uname domain = $udom");     "loncfile::handler constructaccess uname = $uname domain = $udom");
     unless (($uname) && ($udom)) {      unless (($uname) && ($udom)) {
Line 1387  function writeDone() { Line 1469  function writeDone() {
  $loaditem{'onload'} = "writeDone()";   $loaditem{'onload'} = "writeDone()";
     }      }
           
       # Breadcrumbs
       &Apache::lonhtmlcommon::clear_breadcrumbs();
       &Apache::lonhtmlcommon::add_breadcrumb({
           'text'  => 'Construction Space',
           'href'  => &Apache::loncommon::authorspace(),
       });
       &Apache::lonhtmlcommon::add_breadcrumb({
           'text'  => 'File Operation',
           'title' => 'Construction Space File Operation',
           'href'  => '',
       });
   
     $r->print(&Apache::loncommon::start_page('Construction Space File Operation',      $r->print(&Apache::loncommon::start_page('Construction Space File Operation',
      $js,       $js,
      {'add_entries' => \%loaditem,}));       {'add_entries' => \%loaditem,})
                .&Apache::lonhtmlcommon::breadcrumbs()
                .&Apache::loncommon::head_subbox(
                     &Apache::loncommon::CSTR_pageheader())
       );
       
     $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');      $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');
       
     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_warning">'          $r->print('<p class="LC_info">'
                  .&mt('Co-Author [_1]',$uname.':'.$udom)                   .&mt('Co-Author [_1]',$uname.':'.$udom)
                  .'</p>'                   .'</p>'
         );          );
Line 1426  function writeDone() { Line 1524  function writeDone() {
      $env{'form.action'} eq 'Select Action' ) {       $env{'form.action'} eq 'Select Action' ) {
  $r->print('<h3>'.&mt('New Resource').'</h3>');   $r->print('<h3>'.&mt('New Resource').'</h3>');
     } else {      } else {
  $r->print('<p>'.&mt('Unknown Action').' '.$env{'form.action'}.' </p>'.          $r->print('<p class="LC_error">'
   &Apache::loncommon::end_page());                   .&mt('Unknown Action').' '.$env{'form.action'}
                    .'</p>'
                    .&Apache::loncommon::end_page()
           );
  return OK;     return OK;  
     }      }
     if ($env{'form.phase'} eq 'two') {      if ($env{'form.phase'} eq 'two') {
Removed from v.1.98  
changed lines
  Added in v.1.111

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