--- loncom/lond 2000/05/01 20:22:39 1.11 +++ loncom/lond 2000/07/14 07:43:15 1.15 @@ -5,7 +5,10 @@ # 7/8,7/9,7/10,7/12,7/17,7/19,9/21, # 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 Gerd Kortemeyer +# 03/07,05/31 Gerd Kortemeyer +# 06/26 Scott Harrison +# 06/29,06/30,07/14 Gerd Kortemeyer +# # based on "Perl Cookbook" ISBN 1-56592-243-3 # preforker - server who forks first # runs as a daemon @@ -184,13 +187,37 @@ sub reply { return $answer; } +# -------------------------------------------------------------- Talk to lonsql + +sub sqlreply { + my ($cmd)=@_; + my $answer=subsqlreply($cmd); + if ($answer eq 'con_lost') { $answer=subsqlreply($cmd); } + return $answer; +} + +sub subsqlreply { + my ($cmd)=@_; + my $unixsock="mysqlsock"; + my $peerfile="$perlvar{'lonSockDir'}/$unixsock"; + my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile", + Type => SOCK_STREAM, + Timeout => 10) + or return "con_lost"; + print $sclient "$cmd\n"; + my $answer=<$sclient>; + chomp($answer); + if (!$answer) { $answer="con_lost"; } + return $answer; +} + # -------------------------------------------- Return path to profile directory 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; @@ -274,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++) { @@ -484,6 +513,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); } } @@ -526,6 +564,21 @@ sub make_new_child { } else { print $client "rejected\n"; } +# ------------------------------------------------------------------------- log + } elsif ($userinput =~ /^log/) { + my ($cmd,$udom,$uname,$what)=split(/:/,$userinput); + chomp($what); + my $proname=propath($udom,$uname); + my $now=time; + { + my $hfh; + if ($hfh=IO::File->new(">>$proname/activity.log")) { + print $hfh "$now:$hostid{$clientip}:$what\n"; + print $client "ok\n"; + } else { + print $client "error:$!\n"; + } + } # ------------------------------------------------------------------------- put } elsif ($userinput =~ /^put/) { my ($cmd,$udom,$uname,$namespace,$what) @@ -795,6 +848,24 @@ sub make_new_child { } else { print $client "error:$!\n"; } +# ------------------------------------------------------------------- querysend + } elsif ($userinput =~ /^querysend/) { + my ($cmd,$query)=split(/:/,$userinput); + $query=~s/\n*$//g; + print $client sqlreply("$hostid{$clientip}\&$query")."\n"; +# ------------------------------------------------------------------ queryreply + } elsif ($userinput =~ /^queryreply/) { + my ($cmd,$id,$reply)=split(/:/,$userinput); + my $store; + my $execdir=$perlvar{'lonDaemons'}; + if ($store=IO::File->new(">$execdir/tmp/$id")) { + print $store $reply; + close $store; + print $client "ok\n"; + } + else { + print $client "error:$!\n"; + } # ----------------------------------------------------------------------- idput } elsif ($userinput =~ /^idput/) { my ($cmd,$udom,$what)=split(/:/,$userinput); @@ -843,6 +914,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);