--- loncom/lonnet/perl/lonnet.pm 2001/08/16 16:57:31 1.150 +++ loncom/lonnet/perl/lonnet.pm 2001/08/20 19:41:54 1.154 @@ -122,7 +122,7 @@ # 5/30 H. K. Ng # 6/1 Gerd Kortemeyer # July Guy Albertelli -# 8/4,8/7,8/8,8/9,8/11,8/16 Gerd Kortemeyer +# 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18,8/20 Gerd Kortemeyer package Apache::lonnet; @@ -276,7 +276,8 @@ sub appenv { map { if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) { &logthis("WARNING: ". - "Attempt to modify environment ".$_." to ".$newenv{$_}); + "Attempt to modify environment ".$_." to ".$newenv{$_} + .''); delete($newenv{$_}); } else { $ENV{$_}=$newenv{$_}; @@ -672,23 +673,38 @@ sub checkout { $symb.'&'. $now.'&'.$ENV{'REMOTE_ADDR'}); my $token=&reply('tmpput:'.$infostr,$lonhost); - if ($token=~/^error\:/) { return ''; } + if ($token=~/^error\:/) { + &logthis("WARNING: ". + "Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb. + ""); + return ''; + } + $token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/; $token=~tr/a-z/A-Z/; - my %infohash=('outtoken' => $token, - 'checkouttime' => $now, - 'outremote' => $ENV{'REMOTE_ADDR'}); + my %infohash=('resource.0.outtoken' => $token, + 'resource.0.checkouttime' => $now, + 'resource.0.outremote' => $ENV{'REMOTE_ADDR'}); unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') { return ''; + } else { + &logthis("WARNING: ". + "Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb. + ""); } if (&log($tudom,$tuname,&homeserver($tuname,$tudom), &escape('Checkout '.$infostr.' - '. $token)) ne 'ok') { return ''; + } else { + &logthis("WARNING: ". + "Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb. + ""); } + return $token; } # ------------------------------------------------------------ Check in an item @@ -703,9 +719,20 @@ sub checkin { my ($tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)= split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost))); - my %infohash=('intoken' => $token, - 'checkintime' => $now, - 'inremote' => $ENV{'REMOTE_ADDR'}); + unless (($tuname) && ($tudom)) { + &logthis('Check in '.$token.' ('.$dtoken.') failed'); + return ''; + } + + unless (&allowed('mgr',$tcrsid)) { + &logthis('Check in '.$token.' ('.$dtoken.') unauthorized: '. + $ENV{'user.name'}.' - '.$ENV{'user.domain'}); + return ''; + } + + my %infohash=('resource.0.intoken' => $token, + 'resource.0.checkintime' => $now, + 'resource.0.inremote' => $ENV{'REMOTE_ADDR'}); unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') { return ''; @@ -1095,6 +1122,8 @@ sub eget { sub allowed { my ($priv,$uri)=@_; + + my $orguri=$uri; $uri=&declutter($uri); # Free bre access to adm and meta resources @@ -1169,7 +1198,7 @@ sub allowed { } if ($checkreferer) { - my $refuri=$ENV{'httpref.'.$uri}; + my $refuri=$ENV{'httpref.'.$orguri}; unless ($refuri) { map { @@ -1177,19 +1206,18 @@ sub allowed { my $pattern=$_; $pattern=~s/\*/\[\^\/\]\+/g; $pattern=~s/\//\\\//g; - if ($uri=~/$pattern/) { + if ($orguri=~/$pattern/) { $refuri=$ENV{$_}; } } } keys %ENV; } if ($refuri) { + $refuri=&declutter($refuri); my @uriparts=split(/\//,$refuri); my $filename=$uriparts[$#uriparts]; my $pathname=$refuri; $pathname=~s/\/$filename$//; - my @filenameparts=split(/\./,$uri); - if (&fileembstyle($filenameparts[$#filenameparts]) ne 'ssi') { if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~ /\&$filename\:([\d\|]+)\&/) { my $refstatecond=$1; @@ -1199,7 +1227,6 @@ sub allowed { $uri=$refuri; $statecond=$refstatecond; } - } } } } @@ -2248,6 +2275,7 @@ if ($readit ne 'done') { my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab"); while (my $configline=<$config>) { + chomp($configline); my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); $hostname{$id}=$name; $hostdom{$id}=$domain;