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

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1141 and 1.1145

version 1.1141, 2011/10/31 13:44:37 version 1.1145, 2011/11/09 13:14:20
Line 2429  sub subscribe { Line 2429  sub subscribe {
 sub repcopy {  sub repcopy {
     my $filename=shift;      my $filename=shift;
     $filename=~s/\/+/\//g;      $filename=~s/\/+/\//g;
     if ($filename=~m|^/home/httpd/html/adm/|) { return 'ok'; }      my $londocroot = $perlvar{'lonDocRoot'};
     if ($filename=~m|^/home/httpd/html/lonUsers/|) { return 'ok'; }      if ($filename=~m{^\Q$londocroot/adm/\E}) { return 'ok'; }
     if ($filename=~m|^/home/httpd/html/userfiles/| or      if ($filename=~m{^\Q$londocroot/lonUsers/\E}) { return 'ok'; }
  $filename=~m -^/*(uploaded|editupload)/-) {       if ($filename=~m{^\Q$londocroot/userfiles/\E} or
    $filename=~m{^/*(uploaded|editupload)/}) {
  return &repcopy_userfile($filename);   return &repcopy_userfile($filename);
     }      }
     $filename=~s/[\n\r]//g;      $filename=~s/[\n\r]//g;
Line 2459  sub repcopy { Line 2460  sub repcopy {
         unless ($home eq $perlvar{'lonHostID'}) {          unless ($home eq $perlvar{'lonHostID'}) {
            my @parts=split(/\//,$filename);             my @parts=split(/\//,$filename);
            my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";             my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
            if ($path ne "$perlvar{'lonDocRoot'}/res") {             if ($path ne "$londocroot/res") {
                &logthis("Malconfiguration for replication: $filename");                 &logthis("Malconfiguration for replication: $filename");
        return 'bad_request';         return 'bad_request';
            }             }
Line 3337  sub courseacclog { Line 3338  sub courseacclog {
     my $fnsymb=shift;      my $fnsymb=shift;
     unless ($env{'request.course.id'}) { return ''; }      unless ($env{'request.course.id'}) { return ''; }
     my $what=$fnsymb.':'.$env{'user.name'}.':'.$env{'user.domain'};      my $what=$fnsymb.':'.$env{'user.name'}.':'.$env{'user.domain'};
     if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|task|page)$/) {      if ($fnsymb=~/$LONCAPA::assess_re/) {
         $what.=':POST';          $what.=':POST';
         # FIXME: Probably ought to escape things....          # FIXME: Probably ought to escape things....
  foreach my $key (keys(%env)) {   foreach my $key (keys(%env)) {
Line 8708  sub EXT { Line 8709  sub EXT {
    } elsif ($realm eq 'request') {     } elsif ($realm eq 'request') {
 # ------------------------------------------------------------- request.browser  # ------------------------------------------------------------- request.browser
         if ($space eq 'browser') {          if ($space eq 'browser') {
     if ($qualifier eq 'textremote') {              return $env{'browser.'.$qualifier};
  if (&Apache::lonlocal::mt('textual_remote_display') eq 'on') {  
     return 1;  
  } else {  
     return 0;  
  }  
     } else {  
  return $env{'browser.'.$qualifier};  
     }  
 # ------------------------------------------------------------ request.filename  # ------------------------------------------------------------ request.filename
         } else {          } else {
             return $env{'request.'.$spacequalifierrest};              return $env{'request.'.$spacequalifierrest};
Line 10094  sub getfile { Line 10087  sub getfile {
   
 sub repcopy_userfile {  sub repcopy_userfile {
     my ($file)=@_;      my ($file)=@_;
     if ($file =~ m -^/*(uploaded|editupload)/-) { $file=&filelocation("",$file); }      my $londocroot = $perlvar{'lonDocRoot'};
     if ($file =~ m|^/home/httpd/html/lonUsers/|) { return 'ok'; }      if ($file =~ m{^/*(uploaded|editupload)/}) { $file=&filelocation("",$file); }
       if ($file =~ m{^\Q$londocroot/lonUsers/\E}) { return 'ok'; }
     my ($cdom,$cnum,$filename) =       my ($cdom,$cnum,$filename) = 
  ($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+($match_domain)/+($match_name)/+(.*)|);   ($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+($match_domain)/+($match_name)/+(.*)|);
     my $uri="/uploaded/$cdom/$cnum/$filename";      my $uri="/uploaded/$cdom/$cnum/$filename";
Line 10248  sub filelocation { Line 10242  sub filelocation {
         if ( !( $file =~ m:^/:) ) {          if ( !( $file =~ m:^/:) ) {
             $location = $dir. '/'.$file;              $location = $dir. '/'.$file;
         } else {          } else {
             $location = '/home/httpd/html/'.$space.$file;              $location = $perlvar{'lonDocRoot'}.'/'.$space.$file;
         }          }
     }      }
     $location=~s://+:/:g; # remove duplicate /      $location=~s://+:/:g; # remove duplicate /
Line 10274  sub hreflocation { Line 10268  sub hreflocation {
     if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) {      if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) {
  $file=~s-^\Q$perlvar{'lonDocRoot'}\E--;   $file=~s-^\Q$perlvar{'lonDocRoot'}\E--;
     } elsif ($file=~m-^\Q$perlvar{'lonUsersDir'}\E-) {      } elsif ($file=~m-^\Q$perlvar{'lonUsersDir'}\E-) {
  $file=~s-^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/   $file=~s{^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/}
     -/uploaded/$1/$2/-x;          {/uploaded/$1/$2/}x;
     }      }
     if ($file=~ m{^/userfiles/}) {      if ($file=~ m{^/userfiles/}) {
  $file =~ s{^/userfiles/}{/uploaded/};   $file =~ s{^/userfiles/}{/uploaded/};
Removed from v.1.1141  
changed lines
  Added in v.1.1145

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