--- loncom/lond 2000/05/01 20:22:39 1.11
+++ loncom/lond 2000/07/21 00:40:37 1.18
@@ -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,07/15,07/17,07/20 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++) {
@@ -304,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
@@ -484,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);
}
}
@@ -512,6 +553,9 @@ sub make_new_child {
my $ownership=ishome($fname);
if ($ownership eq 'owner') {
if (-e $fname) {
+ if (-d $fname) {
+ print $client "directory\n";
+ } else {
$now=time;
{
my $sh=IO::File->new(">$fname.$hostid{$clientip}");
@@ -520,12 +564,28 @@ sub make_new_child {
$fname=~s/\/home\/httpd\/html\/res/raw/;
$fname="http://$thisserver/".$fname;
print $client "$fname\n";
+ }
} else {
print $client "not_found\n";
}
} 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 +855,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 +921,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);
@@ -856,6 +968,7 @@ sub make_new_child {
} else {
$ulsout='no_such_dir';
}
+ if ($ulsout eq '') { $ulsout='empty'; }
print $client "$ulsout\n";
# ------------------------------------------------------------- unknown command
} else {