loncom/lond - diff

Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.12 and 1.15

version 1.12, 2000/06/26 02:42:28	version 1.15, 2000/07/14 07:43:15
Line 6	Line 6
# 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16,	# 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,	# 12/7,12/15,01/06,01/11,01/12,01/14,2/8,
# 03/07,05/31 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	# based on "Perl Cookbook" ISBN 1-56592-243-3
# preforker - server who forks first	# preforker - server who forks first
# runs as a daemon	# runs as a daemon
Line 184 sub reply {	Line 187 sub reply {
return $answer;	return $answer;
}	}

	# -------------------------------------------------------------- Talk to lonsql

sub sqlreply {	sub sqlreply {
my ($cmd)=@_;	my ($cmd)=@_;
my $answer=subsqlreply($cmd);	my $answer=subsqlreply($cmd);
Line 212 sub propath {	Line 217 sub propath {
my ($udom,$uname)=@_;	my ($udom,$uname)=@_;
$udom=~s/\W//g;	$udom=~s/\W//g;
$uname=~s/\W//g;	$uname=~s/\W//g;
my $subdir=$uname;	my $subdir=$uname.'___';
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;	$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";	my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
return $proname;	return $proname;
Line 296 sub make_new_child {	Line 301 sub make_new_child {
# unblock signals	# unblock signals
sigprocmask(SIG_UNBLOCK, $sigset)	sigprocmask(SIG_UNBLOCK, $sigset)
or die "Can't unblock SIGINT for fork: $!\n";	or die "Can't unblock SIGINT for fork: $!\n";

	$tmpsnum=0;

# handle connections until we've reached $MAX_CLIENTS_PER_CHILD	# handle connections until we've reached $MAX_CLIENTS_PER_CHILD
for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {	for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
Line 506 sub make_new_child {	Line 513 sub make_new_child {
&logthis(	&logthis(
"LWP GET: $message for $fname ($remoteurl)");	"LWP GET: $message for $fname ($remoteurl)");
} else {	} 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);	rename($transname,$fname);
}	}
}	}
Line 835 sub make_new_child {	Line 851 sub make_new_child {
# ------------------------------------------------------------------- querysend	# ------------------------------------------------------------------- querysend
} elsif ($userinput =~ /^querysend/) {	} elsif ($userinput =~ /^querysend/) {
my ($cmd,$query)=split(/:/,$userinput);	my ($cmd,$query)=split(/:/,$userinput);
# make sure you get one \n and only one
$query=~s/\n*$//g;	$query=~s/\n*$//g;
print $client sqlreply("$hostid{$clientip}\&$query")."\n";	print $client sqlreply("$hostid{$clientip}\&$query")."\n";
# ------------------------------------------------------------------ queryreply	# ------------------------------------------------------------------ queryreply
} elsif ($userinput =~ /^queryreply/) {	} elsif ($userinput =~ /^queryreply/) {
my ($cmd,$id,$reply)=split(/:/,$userinput);	my ($cmd,$id,$reply)=split(/:/,$userinput);
my $store;	my $store;
if ($store=IO::File->new(">/tmp/$id")) {	my $execdir=$perlvar{'lonDaemons'};
	if ($store=IO::File->new(">$execdir/tmp/$id")) {
print $store $reply;	print $store $reply;
close $store;	close $store;
print $client "ok\n";	print $client "ok\n";
Line 898 sub make_new_child {	Line 914 sub make_new_child {
} else {	} else {
print $client "error:$!\n";	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	# -------------------------------------------------------------------------- ls
} elsif ($userinput =~ /^ls/) {	} elsif ($userinput =~ /^ls/) {
my ($cmd,$ulsdir)=split(/:/,$userinput);	my ($cmd,$ulsdir)=split(/:/,$userinput);

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.12
changed lines
	Added in v.1.15