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

Diff for /loncom/publisher/loncfile.pm between versions 1.108 and 1.112

version 1.108, 2011/10/22 23:09:44 version 1.112, 2011/10/30 19:27:27
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;
 }  }
Line 188  sub display { Line 188  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 271  sub exists { Line 271  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 347  sub checksuffix { Line 347  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 362  sub cleanDest { Line 362  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 391  sub cleanDest { Line 391  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/';   $newfilename='/home/httpd/html/res/'.$udom.'/'.$uname.'/';
     } else {      } else {
  my $dir=$fn;   my $dir=$fn;
  $dir=~s/\/[^\/]+$//;   $dir=~s/\/[^\/]+$//;
Line 405  sub relativeDest { Line 405  sub relativeDest {
     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 952  sub phaseone { Line 946  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 1446  sub handler { Line 1440  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)) {
Removed from v.1.108  
changed lines
  Added in v.1.112

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