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

Diff for /loncom/publisher/loncfile.pm between versions 1.107 and 1.113

version 1.107, 2011/10/22 21:25:37 version 1.113, 2011/11/02 19:12:40
Line 158  Global References Line 158  Global References
 sub URLToPath {  sub URLToPath {
     my $Url = shift;      my $Url = shift;
     &Debug($r, "UrlToPath got: $Url");      &Debug($r, "UrlToPath got: $Url");
     $Url=~ s/\/+/\//g;      $Url=~ s{^https?\://[^/]+}{};
     $Url=~ s/^https?\:\/\/[^\/]+//;      $Url=~ s{//+}{/}g;
     $Url=~ s/^\///;      $Url=~ s{^/}{};
     $Url=~ s/(\~|priv\/)($match_username)\//\/home\/$2\/public_html\//;      $Url=$Apache::lonnet::perlvar{'lonDocRoot'}."/$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/;      my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
       $fn=~ s/^\Q$londocroot\E//;
       $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\/httpd\/html//;      my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
     $fn=~s/\/\.\//\//g;      $fn=~s/^\Q$londocroot\E//;
       $fn=~s{/\./}{/}g;
     return '<span class="LC_filename">'.$fn.'</span>';      return '<span class="LC_filename">'.$fn.'</span>';
 }  }
   
Line 187  sub display { Line 190  sub display {
   
 sub obsolete_unpub {  sub obsolete_unpub {
     my ($user,$domain,$construct)=@_;      my ($user,$domain,$construct)=@_;
       my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
     my $published=$construct;      my $published=$construct;
     $published=~      $published=~s{^\Q$londocroot/priv/\E}{$londocroot/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 273  sub exists {
     my ($user, $domain, $construct, $creating) = @_;      my ($user, $domain, $construct, $creating) = @_;
     $creating ||= 'file';      $creating ||= 'file';
   
       my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
     my $published=$construct;      my $published=$construct;
     $published=~      $published=~s{^\Q$londocroot/priv/\E}{$londocroot/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 346  sub checksuffix { Line 349  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='';      my $error='';
Line 361  sub cleanDest { Line 364  sub cleanDest {
     }      }
     if ($dest=~m|/|) {      if ($dest=~m|/|) {
  my ($newpath)=($dest=~m|(.*)/|);   my ($newpath)=($dest=~m|(.*)/|);
  ($newpath,$error)=&relativeDest($fn,$newpath,$uname);   ($newpath,$error)=&relativeDest($fn,$newpath,$uname,$udom);
  if (! -d "$newpath") {   if (! -d "$newpath") {
     $request->print('<p><span class="LC_warning">'      $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."
Line 390  sub cleanDest { Line 393  sub cleanDest {
 }  }
   
 sub relativeDest {  sub relativeDest {
     my ($fn,$newfilename,$uname)=@_;      my ($fn,$newfilename,$uname,$udom)=@_;
     my $error = '';      my $error = '';
     if ($newfilename=~/^\//) {      if ($newfilename=~/^\//) {
 # absolute, simply add path  # absolute, simply add path
  $newfilename='/home/'.$uname.'/public_html/';          my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
    $newfilename="$londocroot/res/$udom/$uname/";
     } else {      } else {
  my $dir=$fn;   my $dir=$fn;
  $dir=~s/\/[^\/]+$//;   $dir=~s{/[^/]+$}{};
  $newfilename=$dir.'/'.$newfilename;   $newfilename=$dir.'/'.$newfilename;
     }      }
     $newfilename=~s://+:/:g; # remove duplicate /      $newfilename=~s{//+}{/}g; # remove duplicate /
     while ($newfilename=~m:/\.\./:) {      while ($newfilename=~m{/\.\./}) {
  $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..   $newfilename=~ s{/[^/]+/\.\./}{/}g; #remove dir/..
     }      }
     if ($newfilename =~ m{^/home/($match_username)/(?:public\_html|priv)/}) {      my ($authorname,$authordom)=&Apache::loncacc::constructaccess($newfilename);
         my $otheruname = $1;      unless (($authorname) && ($authordom)) {
         unless ($otheruname eq $uname) {         my $otherdir = &display($newfilename);
             my ($authorname,$authordom)=         $error = &mt('Access denied to [_1]',$otherdir);
                 &Apache::loncacc::constructaccess($newfilename,$env{'request.role.domain'});  
             unless (($authorname eq $otheruname) && ($authordom ne '')) {  
                 my $otherdir = &display($newfilename);  
                 $error = &mt('Access denied to [_1]',$otherdir);  
             }  
         }  
     }      }
     return ($newfilename,$error);      return ($newfilename,$error);
 }  }
Line 951  sub phaseone { Line 949  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) = 
         &cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname);          &cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname,$udom);
     unless ($error) {      unless ($error) {
         ($newfilename,$error)=&relativeDest($fn,$newfilename,$uname);          ($newfilename,$error)=&relativeDest($fn,$newfilename,$uname,$udom);
     }      }
     if ($error) {      if ($error) {
         my $dirlist;          my $dirlist;
Line 1442  sub handler { Line 1440  sub handler {
     }       } 
   
 # ----------------------------------------------------------- Start page output  # ----------------------------------------------------------- Start page output
     my $uname;  
     my $udom;  
   
     ($uname,$udom)=      my ($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)) {      if (($uname eq '') || ($udom eq '')) {
  $r->log_reason($uname.' at '.$udom.   $r->log_reason($uname.' at '.$udom.
        ' trying to manipulate file '.$env{'form.filename'}.         ' trying to manipulate file '.$env{'form.filename'}.
        ' ('.$fn.') - not authorized',          ' ('.$fn.') - not authorized', 
Line 1476  function writeDone() { Line 1471  function writeDone() {
 |;  |;
  $loaditem{'onload'} = "writeDone()";   $loaditem{'onload'} = "writeDone()";
     }      }
   
       my $londocroot = $r->dir_config('lonDocRoot');
       my $trailfile = $fn;
       $trailfile =~ s{^/(priv/)}{$londocroot/$1};
           
     # Breadcrumbs      # Breadcrumbs
     &Apache::lonhtmlcommon::clear_breadcrumbs();      &Apache::lonhtmlcommon::clear_breadcrumbs();
Line 1494  function writeDone() { Line 1493  function writeDone() {
      {'add_entries' => \%loaditem,})       {'add_entries' => \%loaditem,})
              .&Apache::lonhtmlcommon::breadcrumbs()               .&Apache::lonhtmlcommon::breadcrumbs()
              .&Apache::loncommon::head_subbox(               .&Apache::loncommon::head_subbox(
                   &Apache::loncommon::CSTR_pageheader())                    &Apache::loncommon::CSTR_pageheader($trailfile))
     );      );
       
     $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');      $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');
Removed from v.1.107  
changed lines
  Added in v.1.113

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