--- loncom/lond 2000/06/26 02:42:28 1.12 +++ loncom/lond 2000/07/17 21:36:33 1.17 @@ -6,6 +6,9 @@ # 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16, # 12/7,12/15,01/06,01/11,01/12,01/14,2/8, # 03/07,05/31 Gerd Kortemeyer +# 06/26 Scott Harrison +# 06/29,06/30,07/14,07/15,07/17 Gerd Kortemeyer +# # based on "Perl Cookbook" ISBN 1-56592-243-3 # preforker - server who forks first # runs as a daemon @@ -184,6 +187,8 @@ sub reply { return $answer; } +# -------------------------------------------------------------- Talk to lonsql + sub sqlreply { my ($cmd)=@_; my $answer=subsqlreply($cmd); @@ -212,7 +217,7 @@ sub propath { my ($udom,$uname)=@_; $udom=~s/\W//g; $uname=~s/\W//g; - my $subdir=$uname; + my $subdir=$uname.'__'; $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; return $proname; @@ -296,6 +301,8 @@ sub make_new_child { # unblock signals sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n"; + + $tmpsnum=0; # handle connections until we've reached $MAX_CLIENTS_PER_CHILD for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { @@ -326,15 +333,18 @@ sub make_new_child { } else { &logthis( "WARNING: $clientip did not reply challenge"); + print $client "bye\n"; } } else { &logthis( "WARNING: " ."$clientip failed to initialize: >$remotereq< "); + print $client "bye\n"; } } else { &logthis( "WARNING: Unknown client $clientip"); + print $client "bye\n"; } if ($clientok) { # ---------------- New known client connecting, could mean machine online again @@ -506,6 +516,15 @@ sub make_new_child { &logthis( "LWP GET: $message for $fname ($remoteurl)"); } else { + if ($remoteurl!~/\.meta$/) { + my $mrequest= + new HTTP::Request('GET',$remoteurl.'.meta'); + my $mresponse= + $ua->request($mrequest,$fname.'.meta'); + if ($mresponse->is_error()) { + unlink($fname.'.meta'); + } + } rename($transname,$fname); } } @@ -835,14 +854,14 @@ sub make_new_child { # ------------------------------------------------------------------- querysend } elsif ($userinput =~ /^querysend/) { my ($cmd,$query)=split(/:/,$userinput); - # make sure you get one \n and only one $query=~s/\n*$//g; - print $client sqlreply("$hostid{$clientip}\&$query")."\n"; + print $client sqlreply("$hostid{$clientip}\&$query")."\n"; # ------------------------------------------------------------------ queryreply } elsif ($userinput =~ /^queryreply/) { my ($cmd,$id,$reply)=split(/:/,$userinput); my $store; - if ($store=IO::File->new(">/tmp/$id")) { + my $execdir=$perlvar{'lonDaemons'}; + if ($store=IO::File->new(">$execdir/tmp/$id")) { print $store $reply; close $store; print $client "ok\n"; @@ -898,6 +917,40 @@ sub make_new_child { } else { print $client "error:$!\n"; } +# ---------------------------------------------------------------------- tmpput + } elsif ($userinput =~ /^tmpput/) { + my ($cmd,$what)=split(/:/,$userinput); + my $store; + $tmpsnum++; + my $id=$$.'_'.$clientip.'_'.$tmpsnum; + $id=~s/\W/\_/g; + $what=~s/\n//g; + my $execdir=$perlvar{'lonDaemons'}; + if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) { + print $store $what; + close $store; + print $client "$id\n"; + } + else { + print $client "error:$!\n"; + } + +# ---------------------------------------------------------------------- tmpget + } elsif ($userinput =~ /^tmpget/) { + my ($cmd,$id)=split(/:/,$userinput); + chomp($id); + $id=~s/\W/\_/g; + my $store; + my $execdir=$perlvar{'lonDaemons'}; + if ($store=IO::File->new("$execdir/tmp/$id.tmp")) { + my $reply=<$store>; + print $client "$reply\n"; + close $store; + } + else { + print $client "error:$!\n"; + } + # -------------------------------------------------------------------------- ls } elsif ($userinput =~ /^ls/) { my ($cmd,$ulsdir)=split(/:/,$userinput); @@ -911,6 +964,7 @@ sub make_new_child { } else { $ulsout='no_such_dir'; } + if ($ulsout eq '') { $ulsout='empty'; } print $client "$ulsout\n"; # ------------------------------------------------------------- unknown command } else {