--- loncom/lonnet/perl/lonnet.pm 2001/08/16 11:25:03 1.149
+++ loncom/lonnet/perl/lonnet.pm 2001/08/17 19:50:28 1.151
@@ -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 Gerd Kortemeyer
package Apache::lonnet;
@@ -131,7 +131,7 @@ use Apache::File;
use LWP::UserAgent();
use HTTP::Headers;
use vars
-qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache %packagetab);
+qw(%perlvar %hostname %homecache %hostip %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache %packagetab);
use IO::Socket;
use GDBM_File;
use Apache::Constants qw(:common :http);
@@ -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{$_};
@@ -661,7 +662,6 @@ sub log {
# ----------------------------------------------------------- Check out an item
-
sub checkout {
my ($symb,$tuname,$tudom,$tcrsid)=@_;
my $now=time;
@@ -673,29 +673,66 @@ 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=('token' => $token,
- 'checktime' => $now,
- 'remote' => $ENV{'REMOTE_ADDR'});
+ my %infohash=('outtoken' => $token,
+ 'checkouttime' => $now,
+ '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
sub checkin {
my $token=shift;
+ my $now=time;
+ my ($ta,$tb,$lonhost)=split(/\*/,$token);
+ $lonhost=~tr/A-Z/a-z/;
+ my $dtoken=$ta.'_'.$hostip{$lonhost}.'_'.$tb;
+ $dtoken=~s/\W/\_/g;
+ my ($tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
+ split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));
+
+ my %infohash=('intoken' => $token,
+ 'checkintime' => $now,
+ 'inremote' => $ENV{'REMOTE_ADDR'});
+
+ unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
+ return '';
+ }
+
+ if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
+ &escape('Checkin - '.$token)) ne 'ok') {
+ return '';
+ }
+
+ return ($symb,$tuname,$tudom,$tcrsid);
}
# --------------------------------------------- Set Expire Date for Spreadsheet
@@ -2230,6 +2267,7 @@ if ($readit ne 'done') {
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
$hostname{$id}=$name;
$hostdom{$id}=$domain;
+ $hostip{$id}=$ip;
if ($role eq 'library') { $libserv{$id}=$name; }
}
}