--- loncom/lond 2004/02/24 16:53:16 1.179
+++ loncom/lond 2004/03/09 21:05:13 1.183
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.179 2004/02/24 16:53:16 albertel Exp $
+# $Id: lond,v 1.183 2004/03/09 21:05:13 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -53,7 +53,7 @@ my $DEBUG = 0; # Non zero to ena
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.179 $'; #' stupid emacs
+my $VERSION='$Revision: 1.183 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid;
my $currentdomainid;
@@ -822,7 +822,7 @@ sub REAPER { # ta
if (defined($children{$pid})) {
&logthis("Child $pid died");
delete($children{$pid});
- } else {
+ } elsif ($pid > 0) {
&logthis("Unknown Child $pid died");
}
} while ( $pid > 0 );
@@ -1258,8 +1258,18 @@ sub make_new_child {
# the pid hash.
#
my $caller = getpeername($client);
- my ($port,$iaddr)=unpack_sockaddr_in($caller);
- $clientip=inet_ntoa($iaddr);
+ my ($port,$iaddr);
+ if (defined($caller) && length($caller) > 0) {
+ ($port,$iaddr)=unpack_sockaddr_in($caller);
+ } else {
+ &logthis("Unable to determine who caller was, getpeername returned nothing");
+ }
+ if (defined($iaddr)) {
+ $clientip=inet_ntoa($iaddr);
+ } else {
+ &logthis("Unable to determine clinetip");
+ $clientip='Unavailable';
+ }
if ($pid) {
# Parent records the child's birth and returns.
@@ -1817,16 +1827,27 @@ sub make_new_child {
# -------------------------------------- fetch a user file from a remote server
} elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc.
if(isClient) {
- my ($cmd,$fname)=split(/:/,$userinput);
+ my ($cmd,$fname,$fpath)=split(/:/,$userinput);
my ($udom,$uname,$ufile)=split(/\//,$fname);
my $udir=propath($udom,$uname).'/userfiles';
unless (-e $udir) { mkdir($udir,0770); }
if (-e $udir) {
+ unless ($fpath eq '') {
+ my $filepath = $udir;
+ my @parts=split(/\//,$fpath);
+ my $count;
+ for ($count=0;$count<=$#parts;$count++) {
+ $filepath .="/$parts[$count]";
+ if ((-e $filepath)!=1) {
+ mkdir($filepath,0770);
+ }
+ }
+ }
$ufile=~s/^[\.\~]+//;
$ufile=~s/\///g;
- my $destname=$udir.'/'.$ufile;
- my $transname=$udir.'/'.$ufile.'.in.transit';
- my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
+ my $destname=$udir.'/'.$fpath.$ufile;
+ my $transname=$udir.'/'.$fpath.$ufile.'.in.transit';
+ my $remoteurl='http://'.$clientip.'/userfiles/'.$udom.'/'.$uname.'/'.$fpath.$ufile;
my $response;
{
my $ua=new LWP::UserAgent;
@@ -1836,7 +1857,7 @@ sub make_new_child {
if ($response->is_error()) {
unlink($transname);
my $message=$response->status_line;
- &logthis("LWP GET: $message for $fname ($remoteurl)");
+ &logthis("LWP GET: $message for $fpath $fname ($remoteurl)");
print $client "failed\n";
} else {
if (!rename($transname,$destname)) {
@@ -2006,12 +2027,12 @@ sub make_new_child {
} else {
print $client "error: ".($!+0)
." untie(GDBM) failed ".
- "while attempting put\n";
+ "while attempting inc\n";
}
} else {
print $client "error: ".($!)
." tie(GDBM) Failed ".
- "while attempting put\n";
+ "while attempting inc\n";
}
} else {
print $client "refused\n";
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.