--- loncom/lond 2000/06/26 02:42:28 1.12
+++ loncom/lond 2000/07/21 00:40:37 1.18
@@ -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,07/20 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);
}
}
@@ -534,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}");
@@ -542,6 +564,7 @@ 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";
}
@@ -835,14 +858,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 +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);
@@ -911,6 +968,7 @@ sub make_new_child {
} else {
$ulsout='no_such_dir';
}
+ if ($ulsout eq '') { $ulsout='empty'; }
print $client "$ulsout\n";
# ------------------------------------------------------------- unknown command
} else {