version 1.243, 2004/08/27 18:34:31
|
version 1.247, 2004/09/02 18:37:44
|
Line 1299 sub push_file_handler {
|
Line 1299 sub push_file_handler {
|
# Side Effects: |
# Side Effects: |
# The reply is written to $client. |
# The reply is written to $client. |
# |
# |
|
|
sub du_handler { |
sub du_handler { |
my ($cmd, $ududir, $client) = @_; |
my ($cmd, $ududir, $client) = @_; |
my $userinput = "$cmd:$ududir"; |
if ($ududir=~/\.\./ || $ududir!~m|^/home/httpd/|) { |
my $obs; |
&Failure($client,"refused\n","$cmd:$ududir"); |
my $rights; |
return 1; |
my $uduout=''; |
} |
my $udufn; |
my $duout = `du -ks $ududir 2>/dev/null`; |
print $client "from lond not yet\n"; |
$duout=~s/[^\d]//g; #preserve only the numbers |
|
&Reply($client,"$duout\n","$cmd:$ududir"); |
return 1; |
return 1; |
} |
} |
®ister_handler("du", \&du_handler, 0, 1, 0); |
®ister_handler("du", \&du_handler, 0, 1, 0); |
|
|
|
|
|
|
# |
# |
# ls - list the contents of a directory. For each file in the |
# ls - list the contents of a directory. For each file in the |
# selected directory the filename followed by the full output of |
# selected directory the filename followed by the full output of |
Line 3368 sub tmp_del_handler {
|
Line 3369 sub tmp_del_handler {
|
} |
} |
®ister_handler("tmpdel", \&tmp_del_handler, 0, 1, 0); |
®ister_handler("tmpdel", \&tmp_del_handler, 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 set_announce_handler { |
|
my ($cmd, $announcement, $client) = @_; |
|
|
|
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; |
|
} |
|
®ister_handler("setannounce", \&set_announce_handler, 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 get_version_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
|
|
my $userinput = $cmd.$tail; |
|
|
|
&Reply($client, &version($userinput)."\n", $userinput); |
|
|
|
|
|
return 1; |
|
} |
|
®ister_handler("version", \&get_version_handler, 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 set_virtual_host_handler { |
|
my ($cmd, $tail, $socket) = @_; |
|
|
|
my $userinput ="$cmd:$tail"; |
|
|
|
&Reply($client, &sethost($userinput)."\n", $userinput); |
|
|
|
|
|
return 1; |
|
} |
|
®ister_handler("sethost", \&set_virtual_host_handler, 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 exit_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
|
|
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; |
|
} |
|
®ister_handler("exit", \&exit_handler, 0,,1); |
|
®ister_handler("init", \&exit_handler, 0,,1); |
|
®ister_handler("quit", \&exit_handler, 0,,1); |
|
|
|
|
|
# |
|
# |
# |
# |
# |
# |
# |
# |
Line 3484 sub process_request {
|
Line 3605 sub process_request {
|
|
|
#------------------- Commands not yet in spearate handlers. -------------- |
#------------------- Commands not yet in spearate handlers. -------------- |
|
|
|
|
|
|
# ----------------------------------------------------------------- setannounce |
|
if ($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; |
|
print $client "ok\n"; |
|
} else { |
|
print $client "error: ".($!+0)."\n"; |
|
} |
|
} else { |
|
Reply($client, "refused\n", $userinput); |
|
|
|
} |
|
# ------------------------------------------------------------------ Hanging up |
|
} elsif (($userinput =~ /^exit/) || |
|
($userinput =~ /^init/)) { # no restrictions. |
|
&logthis( |
|
"Client $clientip ($clientname) hanging up: $userinput"); |
|
print $client "bye\n"; |
|
$client->shutdown(2); # shutdown the socket forcibly. |
|
$client->close(); |
|
return 0; |
|
|
|
# ---------------------------------- set current host/domain |
|
} elsif ($userinput =~ /^sethost/) { |
|
if (isClient) { |
|
print $client &sethost($userinput)."\n"; |
|
} else { |
|
print $client "refused\n"; |
|
} |
|
#---------------------------------- request file (?) version. |
|
} elsif ($userinput =~/^version/) { |
|
if (isClient) { |
|
print $client &version($userinput)."\n"; |
|
} else { |
|
print $client "refused\n"; |
|
} |
|
#------------------------------- is auto-enrollment enabled? |
#------------------------------- is auto-enrollment enabled? |
} elsif ($userinput =~/^autorun/) { |
if ($userinput =~/^autorun/) { |
if (isClient) { |
if (isClient) { |
my ($cmd,$cdom) = split(/:/,$userinput); |
my ($cmd,$cdom) = split(/:/,$userinput); |
my $outcome = &localenroll::run($cdom); |
my $outcome = &localenroll::run($cdom); |