--- loncom/lonnet/perl/lonnet.pm 2007/12/05 20:06:34 1.929 +++ loncom/lonnet/perl/lonnet.pm 2007/12/21 04:14:24 1.932 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.929 2007/12/05 20:06:34 albertel Exp $ +# $Id: lonnet.pm,v 1.932 2007/12/21 04:14:24 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1635,7 +1635,7 @@ sub ssi_body { &ssi($filelink,%form)); $output=~s|//(\s*)?\s||gs; $output=~s/^.*?\]*\>//si; - $output=~s/(.*)\<\/body\s*\>.*?$/$1/si; + $output=~s/\<\/body\s*\>.*?$//si; return $output; } @@ -5250,11 +5250,21 @@ sub assignrole { } else { my $cwosec=$url; $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/; - unless ((&allowed('c'.$role,$cwosec)) || &allowed('c'.$role,$udom)) { - &logthis('Refused assignrole: '. - $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '. - $env{'user.name'}.' at '.$env{'user.domain'}); - return 'refused'; + if (!(&allowed('c'.$role,$cwosec)) && !(&allowed('c'.$role,$udom))) { + my $refused; + if (($env{'request.course.sec'} ne '') && ($role eq 'st')) { + if (!(&allowed('c'.$role,$url))) { + $refused = 1; + } + } else { + $refused = 1; + } + if ($refused) { + &logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url. + ' '.$role.' '.$end.' '.$start.' by '. + $env{'user.name'}.' at '.$env{'user.domain'}); + return 'refused'; + } } $mrole=$role; } @@ -6612,7 +6622,7 @@ sub EXT { ([$courselevelr,'resource'], [$courselevelm,'map' ], [$courselevel, 'course' ])); - if (defined($userreply)) { return $userreply; } + if (defined($userreply)) { return &get_reply($userreply); } # ------------------------------------------------ second, check some of course my $coursereply; @@ -7973,7 +7983,13 @@ sub filelocation { } } $location=~s://+:/:g; # remove duplicate / - while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/.. + while ($location=~m{/\.\./}) { + if ($location =~ m{/[^/]+/\.\./}) { + $location=~ s{/[^/]+/\.\./}{/}g; + } else { + $location=~ s{/\.\./}{/}g; + } + } #remove dir/.. while ($location=~m:/\./:) {$location=~ s:/\./:/:g;} #remove /./ return $location; }