--- loncom/lond 2003/11/11 12:39:14 1.161
+++ loncom/lond 2003/12/02 10:37:59 1.164
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.161 2003/11/11 12:39:14 foxr Exp $
+# $Id: lond,v 1.164 2003/12/02 10:37:59 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -52,7 +52,7 @@ my $DEBUG = 0; # Non zero to ena
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.161 $'; #' stupid emacs
+my $VERSION='$Revision: 1.164 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid;
my $currentdomainid;
@@ -205,26 +205,7 @@ sub ReadManagerTable {
sub ValidManager {
my $certificate = shift;
- ReadManagerTable;
-
- my $hostname = $hostid{$certificate};
-
-
- if ($hostname ne undef) {
- if($managers{$hostname} ne undef) {
- &logthis('Authenticating manager'.
- " $hostname");
- return 1;
- } else {
- &logthis('");
- return 0;
- }
- } else {
- &logthis(' Failed manager authentication '.
- "$certificate ");
- return 0;
- }
+ return isManager;
}
#
# CopyFile: Called as part of the process of installing a
@@ -1707,6 +1688,55 @@ sub make_new_child {
Reply($client, "refused\n", $userinput);
}
+# ------------------------------------------------------------------- inc
+ } elsif ($userinput =~ /^inc:/) {
+ if(isClient) {
+ my ($cmd,$udom,$uname,$namespace,$what)
+ =split(/:/,$userinput);
+ $namespace=~s/\//\_/g;
+ $namespace=~s/\W//g;
+ if ($namespace ne 'roles') {
+ chomp($what);
+ my $proname=propath($udom,$uname);
+ my $now=time;
+ unless ($namespace=~/^nohist\_/) {
+ my $hfh;
+ if (
+ $hfh=IO::File->new(">>$proname/$namespace.hist")
+ ) { print $hfh "P:$now:$what\n"; }
+ }
+ my @pairs=split(/\&/,$what);
+ my %hash;
+ if (tie(%hash,'GDBM_File',
+ "$proname/$namespace.db",
+ &GDBM_WRCREAT(),0640)) {
+ foreach my $pair (@pairs) {
+ my ($key,$value)=split(/=/,$pair);
+ # We could check that we have a number...
+ if (! defined($value) || $value eq '') {
+ $value = 1;
+ }
+ $hash{$key}+=$value;
+ }
+ if (untie(%hash)) {
+ print $client "ok\n";
+ } else {
+ print $client "error: ".($!+0)
+ ." untie(GDBM) failed ".
+ "while attempting put\n";
+ }
+ } else {
+ print $client "error: ".($!)
+ ." tie(GDBM) Failed ".
+ "while attempting put\n";
+ }
+ } else {
+ print $client "refused\n";
+ }
+ } else {
+ Reply($client, "refused\n", $userinput);
+
+ }
# -------------------------------------------------------------------- rolesput
} elsif ($userinput =~ /^rolesput/) {
if(isClient) {
@@ -2470,6 +2500,7 @@ sub make_new_child {
&logthis(
"Client $clientip ($clientname) hanging up: $userinput");
print $client "bye\n";
+ $client->shutdown(2); # shutdown the socket forcibly.
$client->close();
last;