loncom/lontrans.pm - diff

Return to lontrans.pm CVS log

Up to [LON-CAPA] / loncom

-version 1.6, 2003/11/12 21:37:07
+version 1.14, 2011/10/21 16:03:06
  Line 32  use strict;
  use Apache::Constants qw(:common :remotehost);
  use Apache::lonnet();
  use Apache::File();
- use Apache::loncommon;
+ use LONCAPA;
  sub handler {
      my $r = shift;
-     if ($r->uri=~m|^/uploaded/|) {
+     # FIXME line remove when mod_perl fixes BUG#4948
- 	my (undef,undef,$udom,$uname,$ufile)=split(/\//,$r->uri);
+     $r->notes->set('error-notes' => '');
- 	$ufile=~s/^[\~\.]+//;
+     if ($r->uri=~m|^(/raw)?/uploaded/|) {
- 	$r->filename(&Apache::loncommon::propath($udom,$uname).
+         my $fn = $r->uri();
- 		     '/userfiles/'.$ufile);
+         $fn=~s/^\/raw//;
-     } elsif ($r->uri=~m|^/~|) {
+         my (undef,undef,$udom,$uname,@ufile)=split(/\//,$fn);
- 	#internal authentication, needs fixup.
+ 	if (@ufile) { $ufile[-1]=~s/^[\~\.]+//; }
- 	my $fn = $r->uri(); # non users do not get the full path request
+         my $chome=&Apache::lonnet::homeserver($uname,$udom);
- 	                 # through SCRIPT_FILENAME
+ 	my $allowed=0;
- 	$fn=~s|^/~(\w+)|/home/$1/public_html|;
+ 	my @ids=&Apache::lonnet::current_machine_ids();
- 	$r->filename($fn);
+ 	foreach my $id (@ids) { if ($id eq $chome) { $allowed=1; } }
+ 	if ($allowed) {
+ 	    $r->filename(&propath($udom,$uname).
+ 			 '/userfiles/'.(join('/',@ufile)));
+         }
      } else { return DECLINED; }
      return OK;
  }