--- loncom/lonnet/perl/lonnet.pm 2001/08/17 19:50:28 1.151 +++ 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,8/17 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; @@ -683,9 +683,9 @@ sub checkout { $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 ''; @@ -719,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 ''; @@ -1111,6 +1122,8 @@ sub eget { sub allowed { my ($priv,$uri)=@_; + + my $orguri=$uri; $uri=&declutter($uri); # Free bre access to adm and meta resources @@ -1185,7 +1198,7 @@ sub allowed { } if ($checkreferer) { - my $refuri=$ENV{'httpref.'.$uri}; + my $refuri=$ENV{'httpref.'.$orguri}; unless ($refuri) { map { @@ -1193,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; @@ -1215,7 +1227,6 @@ sub allowed { $uri=$refuri; $statecond=$refstatecond; } - } } } } @@ -2264,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;