--- loncom/lonnet/perl/lonnet.pm 2007/03/17 04:13:06 1.824.2.3 +++ loncom/lonnet/perl/lonnet.pm 2007/05/02 22:01:32 1.824.2.5 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.824.2.3 2007/03/17 04:13:06 albertel Exp $ +# $Id: lonnet.pm,v 1.824.2.5 2007/05/02 22:01:32 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -992,7 +992,10 @@ my $kicks=0; my $hits=0; sub make_key { my ($name,$id) = @_; - if (length($id) > 200) { $id=length($id).':'.&Digest::MD5::md5_hex($id); } + if (length($id) > 65 + && length(&escape($id)) > 200) { + $id=length($id).':'.&Digest::MD5::md5_hex($id); + } return &escape($name.':'.$id); } @@ -1039,7 +1042,9 @@ sub do_cache_new { $time=600; } if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } - $memcache->set($id,$setvalue,$time); + if (!($memcache->set($id,$setvalue,$time))) { + &logthis("caching of id -> $id failed"); + } # need to make a copy of $value #&make_room($id,$value,$debug); return $value; @@ -3461,9 +3466,16 @@ sub get_portfolio_access { } if (@users > 0) { foreach my $userkey (@users) { - if (exists($access_hash->{$userkey}{'users'}{$env{'user.name'}.':'.$env{'user.domain'}})) { - return 'ok'; - } + if (ref($access_hash->{$userkey}{'users'}) eq 'ARRAY') { + foreach my $item (@{$access_hash->{$userkey}{'users'}}) { + if (ref($item) eq 'HASH') { + if (($item->{'uname'} eq $env{'user.name'}) && + ($item->{'udom'} eq $env{'user.domain'})) { + return 'ok'; + } + } + } + } } } my %roleshash;