--- loncom/lond 2004/08/24 20:59:15 1.240 +++ loncom/lond 2004/09/02 09:27:58 1.246 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.240 2004/08/24 20:59:15 banghart Exp $ +# $Id: lond,v 1.246 2004/09/02 09:27:58 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -57,7 +57,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.240 $'; #' stupid emacs +my $VERSION='$Revision: 1.246 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -1282,7 +1282,36 @@ sub push_file_handler { } ®ister_handler("pushfile", \&push_file_handler, 1, 0, 1); +# +# du - list the disk usuage of a directory recursively. +# +# note: stolen code from the ls file handler +# under construction by Rick Banghart +# . +# Parameters: +# $cmd - The command that dispatched us (du). +# $ududir - 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 du_handler { + my ($cmd, $ududir, $client) = @_; + if ($ududir=~/\.\./ || $ududir!~m|^/home/httpd/|) { + &Failure($client,"refused\n","$cmd:$ududir"); + return 1; + } + my $duout = `du -ks $ududir 2>/dev/null`; + $duout=~s/[^\d]//g; #preserve only the numbers + &Reply($client,"$duout\n","$cmd:$ududir"); + return 1; +} +®ister_handler("du", \&du_handler, 0, 1, 0); # @@ -1349,6 +1378,8 @@ sub ls_handler { ®ister_handler("ls", \&ls_handler, 0, 1, 0); + + # Process a reinit request. Reinit requests that either # lonc or lond be reinitialized so that an updated # host.tab or domain.tab can be processed. @@ -1909,9 +1940,9 @@ sub remove_user_file_handler { my $file=$udir.'/userfiles/'.$ufile; if (-e $file) { if (-f $file){ - unlink($file); - }elsif(-d $file){ - rmdir($file); + unlink($file); + } elsif(-d $file) { + rmdir($file); } if (-e $file) { &Failure($client, "failed\n", "$cmd:$tail"); @@ -2177,7 +2208,7 @@ sub put_user_profile_entry { my $userinput = "$cmd:$tail"; - my ($udom,$uname,$namespace,$what) =split(/:/,$tail); + my ($udom,$uname,$namespace,$what) =split(/:/,$tail,4); if ($namespace ne 'roles') { chomp($what); my $hashref = &tie_user_hash($udom, $uname, $namespace, @@ -3338,6 +3369,126 @@ sub tmp_del_handler { } ®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", \&select_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); + + +# +# # # # @@ -3454,52 +3605,8 @@ sub process_request { #------------------- 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? - } elsif ($userinput =~/^autorun/) { + if ($userinput =~/^autorun/) { if (isClient) { my ($cmd,$cdom) = split(/:/,$userinput); my $outcome = &localenroll::run($cdom);