--- loncom/lond 2004/02/18 10:43:02 1.178.2.1
+++ loncom/lond 2004/02/24 11:22:41 1.178.2.3
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.178.2.1 2004/02/18 10:43:02 foxr Exp $
+# $Id: lond,v 1.178.2.3 2004/02/24 11:22:41 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -48,12 +48,12 @@ use localauth;
use File::Copy;
use LONCAPA::ConfigFileEdit;
-my $DEBUG = 0; # Non zero to enable debug log entries.
+my $DEBUG = 1; # Non zero to enable debug log entries.
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.178.2.1 $'; #' stupid emacs
+my $VERSION='$Revision: 1.178.2.3 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid;
my $currentdomainid;
@@ -626,6 +626,7 @@ sub AuthenticateHandler {
# upass - User's password.
my ($udom,$uname,$upass)=split(/:/,$tail);
+ Debug(" Authenticate domain = $udom, user = $uname, password = $upass");
chomp($upass);
$upass=unescape($upass);
my $proname=propath($udom,$uname);
@@ -634,6 +635,8 @@ sub AuthenticateHandler {
# The user's 'personal' loncapa passworrd file describes how to authenticate:
if (-e $passfilename) {
+ Debug("Located password file: $passfilename");
+
my $pf = IO::File->new($passfilename);
my $realpasswd=<$pf>;
chomp($realpasswd);
@@ -642,6 +645,7 @@ sub AuthenticateHandler {
#
# Authenticate against password stored in the internal file.
#
+ Debug("Authenticating via $howpwd");
if ($howpwd eq 'internal') {
&Debug("Internal auth");
$pwdcorrect= (crypt($upass,$contentpwd) eq $contentpwd);
@@ -2419,7 +2423,302 @@ sub GetIdHandler {
return 1;
}
+
RegisterHandler("idget", \&GetIdHandler, 0, 1, 0);
+#
+# Process the tmpput command I'm not sure what this does.. Seems to
+# create a file in the lonDaemons/tmp directory of the form $id.tmp
+# where Id is the client's ip concatenated with a sequence number.
+# The file will contain some value that is passed in. Is this e.g.
+# a login token?
+#
+# Parameters:
+# $cmd - The command that got us dispatched.
+# $tail - The remainder of the request following $cmd:
+# In this case this will be the contents of the file.
+# $client - Socket connected to the client.
+# Returns:
+# 1 indicating processing can continue.
+# Side effects:
+# A file is created in the local filesystem.
+# A reply is sent to the client.
+sub TmpPutHandler {
+ my $cmd = shift;
+ my $what = shift;
+ my $client = shift;
+
+ my $userinput = "$cmd:$what"; # Reconstruct for logging.
+
+
+ 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;
+ Reply($client, "$id\n", $userinput);
+ }
+ else {
+ Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
+ "while attempting tmpput\n", $userinput);
+ }
+ return 1;
+
+}
+RegisterHandler("tmpput", \&TmpPutHandler, 0, 1, 0);
+
+# Processes the tmpget command. This command returns the contents
+# of a temporary resource file(?) created via tmpput.
+#
+# Paramters:
+# $cmd - Command that got us dispatched.
+# $id - Tail of the command, contain the id of the resource
+# we want to fetch.
+# $client - socket open on the client.
+# Return:
+# 1 - Inidcating processing can continue.
+# Side effects:
+# A reply is sent to the client.
+
+#
+sub TmpGetHandler {
+ my $cmd = shift;
+ my $id = shift;
+ my $client = shift;
+ my $userinput = "$cmd:$id";
+
+ chomp($id);
+ $id=~s/\W/\_/g;
+ my $store;
+ my $execdir=$perlvar{'lonDaemons'};
+ if ($store=IO::File->new("$execdir/tmp/$id.tmp")) {
+ my $reply=<$store>;
+ Reply( $client, "$reply\n", $userinput);
+ close $store;
+ }
+ else {
+ Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
+ "while attempting tmpget\n", $userinput);
+ }
+
+ return 1;
+}
+RegisterHandler("tmpget", \&TmpGetHandler, 0, 1, 0);
+#
+# Process the tmpdel command. This command deletes a temp resource
+# created by the tmpput command.
+#
+# Parameters:
+# $cmd - Command that got us here.
+# $id - Id of the temporary resource created.
+# $client - socket open on the client process.
+#
+# Returns:
+# 1 - Indicating processing should continue.
+# Side Effects:
+# A file is deleted
+# A reply is sent to the client.
+sub TmpDelHandler {
+ my $cmd = shift;
+ my $id = shift;
+ my $client = shift;
+
+ my $userinput= "$cmd:$id";
+
+ chomp($id);
+ $id=~s/\W/\_/g;
+ my $execdir=$perlvar{'lonDaemons'};
+ if (unlink("$execdir/tmp/$id.tmp")) {
+ Reply($client, "ok\n", $userinput);
+ } else {
+ Failure( $client, "error: ".($!+0)."Unlink tmp Failed ".
+ "while attempting tmpdel\n", $userinput);
+ }
+
+ return 1;
+
+}
+RegisterHandler("tmpdel", \&TmpDelHandler, 0, 1, 0);
+#
+# ls - list the contents of a directory. For each file in the
+# selected directory the filename followed by the full output of
+# the stat function is returned. The returned info for each
+# file are separated by ':'. The stat fields are separated by &'s.
+# Parameters:
+# $cmd - The command that dispatched us (ls).
+# $ulsdir - The directory path to list... I'm not sure what this
+# is relative as things like ls:. return e.g.
+# no_such_dir.
+# $client - Socket open on the client.
+# Returns:
+# 1 - indicating that the daemon should not disconnect.
+# Side Effects:
+# The reply is written to $client.
+#
+sub LsHandler {
+ my $cmd = shift;
+ my $ulsdir = shift;
+ my $client = shift;
+
+ my $userinput = "$cmd:$ulsdir";
+
+ my $ulsout='';
+ my $ulsfn;
+ if (-e $ulsdir) {
+ if(-d $ulsdir) {
+ if (opendir(LSDIR,$ulsdir)) {
+ while ($ulsfn=readdir(LSDIR)) {
+ my @ulsstats=stat($ulsdir.'/'.$ulsfn);
+ $ulsout.=$ulsfn.'&'.
+ join('&',@ulsstats).':';
+ }
+ closedir(LSDIR);
+ }
+ } else {
+ my @ulsstats=stat($ulsdir);
+ $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
+ }
+ } else {
+ $ulsout='no_such_dir';
+ }
+ if ($ulsout eq '') { $ulsout='empty'; }
+ Reply($client, "$ulsout\n", $userinput);
+
+
+ return 1;
+}
+RegisterHandler("ls", \&LsHandler, 0, 1, 0);
+
+
+#
+# Processes the setannounce command. This command
+# creates a file named announce.txt in the top directory of
+# the documentn root and sets its contents. The announce.txt file is
+# printed in its entirety at the LonCAPA login page. Note:
+# once the announcement.txt fileis created it cannot be deleted.
+# However, setting the contents of the file to empty removes the
+# announcement from the login page of loncapa so who cares.
+#
+# Parameters:
+# $cmd - The command that got us dispatched.
+# $announcement - The text of the announcement.
+# $client - Socket open on the client process.
+# Retunrns:
+# 1 - Indicating request processing should continue
+# Side Effects:
+# The file {DocRoot}/announcement.txt is created.
+# A reply is sent to $client.
+#
+sub SetAnnounceHandler {
+ my $cmd = shift;
+ my $announcement = shift;
+ my $client = shift;
+
+ my $userinput = "$cmd:$announcement";
+
+ chomp($announcement);
+ $announcement=&unescape($announcement);
+ if (my $store=IO::File->new('>'.$perlvar{'lonDocRoot'}.
+ '/announcement.txt')) {
+ print $store $announcement;
+ close $store;
+ Reply($client, "ok\n", $userinput);
+ } else {
+ Failure($client, "error: ".($!+0)."\n", $userinput);
+ }
+
+ return 1;
+}
+RegisterHandler("setannounce", \&SetAnnounceHandler, 0, 1, 0);
+
+#
+# Return the version of the daemon. This can be used to determine
+# the compatibility of cross version installations or, alternatively to
+# simply know who's out of date and who isn't. Note that the version
+# is returned concatenated with the tail.
+# Parameters:
+# $cmd - the request that dispatched to us.
+# $tail - Tail of the request (client's version?).
+# $client - Socket open on the client.
+#Returns:
+# 1 - continue processing requests.
+# Side Effects:
+# Replies with version to $client.
+sub GetVersionHandler {
+ my $client = shift;
+ my $tail = shift;
+ my $client = shift;
+ my $userinput = $client;
+
+ Reply($client, &version($userinput)."\n", $userinput);
+
+
+ return 1;
+}
+RegisterHandler("version", \&GetVersionHandler, 0, 1, 0);
+
+# Set the current host and domain. This is used to support
+# multihomed systems. Each IP of the system, or even separate daemons
+# on the same IP can be treated as handling a separate lonCAPA virtual
+# machine. This command selects the virtual lonCAPA. The client always
+# knows the right one since it is lonc and it is selecting the domain/system
+# from the hosts.tab file.
+# Parameters:
+# $cmd - Command that dispatched us.
+# $tail - Tail of the command (domain/host requested).
+# $socket - Socket open on the client.
+#
+# Returns:
+# 1 - Indicates the program should continue to process requests.
+# Side-effects:
+# The default domain/system context is modified for this daemon.
+# a reply is sent to the client.
+#
+sub SelectHostHandler {
+ my $cmd = shift;
+ my $tail = shift;
+ my $socket = shift;
+
+ my $userinput ="$cmd:$tail";
+
+ Reply($client, &sethost($userinput)."\n", $userinput);
+
+
+ return 1;
+}
+RegisterHandler("sethost", \&SelectHostHandler, 0, 1, 0);
+
+# Process a request to exit:
+# - "bye" is sent to the client.
+# - The client socket is shutdown and closed.
+# - We indicate to the caller that we should exit.
+# Formal Parameters:
+# $cmd - The command that got us here.
+# $tail - Tail of the command (empty).
+# $client - Socket open on the tail.
+# Returns:
+# 0 - Indicating the program should exit!!
+#
+sub ExitHandler {
+ my $cmd = shift;
+ my $tail = shift;
+ my $client = shift;
+
+ my $userinput = "$cmd:$tail";
+
+ &logthis("Client $clientip ($clientname) hanging up: $userinput");
+ Reply($client, "bye\n", $userinput);
+ $client->shutdown(2); # shutdown the socket forcibly.
+ $client->close();
+
+ return 0;
+}
+RegisterHandler("exit", \&ExitHandler, 0, 1,1);
+RegisterHandler("init", \&ExitHandler, 0, 1,1); # RE-init is like exit.
+RegisterHandler("quit", \&ExitHandler, 0, 1,1); # I like this too!
#------------------------------------------------------------------------------------
#
# Process a Request. Takes a request from the client validates
@@ -2453,7 +2752,9 @@ sub ProcessRequest {
# Split off the request keyword from the rest of the stuff.
my ($command, $tail) = split(/:/, $userinput, 2);
-
+
+ Debug("Command received: $command, encoded = $wasenc");
+
# ------------------------------------------------------------- Normal commands
@@ -2466,161 +2767,36 @@ sub ProcessRequest {
my $Handler = $$DispatchInfo[0];
my $NeedEncode = $$DispatchInfo[1];
my $ClientTypes = $$DispatchInfo[2];
+ Debug("Matched dispatch hash: mustencode: $NeedEncode ClientType $ClientTypes");
# Validate the request:
my $ok = 1;
- if($NeedEncode && (!$wasenc)) {
- Reply($client, "refused\n", $userinput);
- $ok = 0;
+ my $requesterprivs = 0;
+ if(isClient()) {
+ $requesterprivs |= $CLIENT_OK;
}
- if(isClient && (($ClientTypes & $CLIENT_OK) == 0)) {
- Reply($client, "refused\n", $userinput);
- $ok = 0;
+ if(isManager()) {
+ $requesterprivs |= $MANAGER_OK;
}
- if(isManager && (($ClientTypes & $MANAGER_OK) == 0)) {
- Reply($client, "refused\n", $userinput);
+ if($NeedEncode && (!$wasenc)) {
+ Debug("Must encode but wasn't: $NeedEncode $wasenc");
$ok = 0;
}
+ if(($ClientTypes & $requesterprivs) == 0) {
+ Debug("Client not privileged to do this operation");
+ $ok = 0;
+ }
+
if($ok) {
+ Debug("Dispatching to handler $command $tail");
$KeepGoing = &$Handler($command, $tail, $client);
+ } else {
+ Debug("Refusing to dispatch because ok is false");
+ Failure($client, "refused", $userinput);
}
-
-
-
-# ---------------------------------------------------------------------- tmpput
- } elsif ($userinput =~ /^tmpput/) {
- if(isClient) {
- 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;
- Reply($client, "$id\n", $userinput);
- }
- else {
- Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
- "while attempting tmpput\n", $userinput);
- }
- } else {
- Failure($client, "refused\n", $userinput);
-
- }
-
-# ---------------------------------------------------------------------- tmpget
- } elsif ($userinput =~ /^tmpget/) {
- if(isClient) {
- 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>;
- Reply( $client, "$reply\n", $userinput);
- close $store;
- }
- else {
- Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
- "while attempting tmpget\n", $userinput);
- }
- } else {
- Failure($client, "refused\n", $userinput);
-
- }
-# ---------------------------------------------------------------------- tmpdel
- } elsif ($userinput =~ /^tmpdel/) {
- if(isClient) {
- my ($cmd,$id)=split(/:/,$userinput);
- chomp($id);
- $id=~s/\W/\_/g;
- my $execdir=$perlvar{'lonDaemons'};
- if (unlink("$execdir/tmp/$id.tmp")) {
- Reply($client, "ok\n", $userinput);
- } else {
- Failure( $client, "error: ".($!+0)."Unlink tmp Failed ".
- "while attempting tmpdel\n", $userinput);
- }
- } else {
- Failure($client, "refused\n", $userinput);
- }
-# -------------------------------------------------------------------------- ls
- } elsif ($userinput =~ /^ls/) {
- if(isClient) {
- my ($cmd,$ulsdir)=split(/:/,$userinput);
- my $ulsout='';
- my $ulsfn;
- if (-e $ulsdir) {
- if(-d $ulsdir) {
- if (opendir(LSDIR,$ulsdir)) {
- while ($ulsfn=readdir(LSDIR)) {
- my @ulsstats=stat($ulsdir.'/'.$ulsfn);
- $ulsout.=$ulsfn.'&'.
- join('&',@ulsstats).':';
- }
- closedir(LSDIR);
- }
- } else {
- my @ulsstats=stat($ulsdir);
- $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
- }
- } else {
- $ulsout='no_such_dir';
- }
- if ($ulsout eq '') { $ulsout='empty'; }
- Reply($client, "$ulsout\n", $userinput);
- } else {
- Failure($client, "refused\n", $userinput);
-
- }
-# ----------------------------------------------------------------- setannounce
- } elsif ($userinput =~ /^setannounce/) {
- if (isClient) {
- my ($cmd,$announcement)=split(/:/,$userinput);
- chomp($announcement);
- $announcement=&unescape($announcement);
- if (my $store=IO::File->new('>'.$perlvar{'lonDocRoot'}.
- '/announcement.txt')) {
- print $store $announcement;
- close $store;
- Reply($client, "ok\n", $userinput);
- } else {
- Failure($client, "error: ".($!+0)."\n", $userinput);
- }
- } else {
- Failure($client, "refused\n", $userinput);
-
- }
-# ------------------------------------------------------------------ Hanging up
- } elsif (($userinput =~ /^exit/) ||
- ($userinput =~ /^init/)) { # no restrictions.
- &logthis("Client $clientip ($clientname) hanging up: $userinput");
- Reply($client, "bye\n", $userinput);
- $client->shutdown(2); # shutdown the socket forcibly.
- $client->close();
- $KeepGoing = 0; # Flag to exit the program.
-
-# ---------------------------------- set current host/domain
- } elsif ($userinput =~ /^sethost:/) {
- if (isClient) {
- Reply($client, &sethost($userinput)."\n", $userinput);
- } else {
- Failure($client, "refused\n", $userinput);
- }
-#---------------------------------- request file (?) version.
- } elsif ($userinput =~/^version:/) {
- if (isClient) {
- Reply($client, &version($userinput)."\n", $userinput);
- } else {
- Reply( $client, "refused\n", $userinput);
- }
# ------------------------------------------------------------- unknown command
} else {