--- loncom/lond 2004/08/24 07:26:04 1.237 +++ loncom/lond 2004/09/03 10:13:59 1.248 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.237 2004/08/24 07:26:04 albertel Exp $ +# $Id: lond,v 1.248 2004/09/03 10:13:59 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.237 $'; #' stupid emacs +my $VERSION='$Revision: 1.248 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -1282,6 +1282,102 @@ 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); + + +# +# 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 ls_handler { + my ($cmd, $ulsdir, $client) = @_; + + my $userinput = "$cmd:$ulsdir"; + + my $obs; + my $rights; + my $ulsout=''; + my $ulsfn; + if (-e $ulsdir) { + if(-d $ulsdir) { + if (opendir(LSDIR,$ulsdir)) { + while ($ulsfn=readdir(LSDIR)) { + undef $obs, $rights; + my @ulsstats=stat($ulsdir.'/'.$ulsfn); + #We do some obsolete checking here + if(-e $ulsdir.'/'.$ulsfn.".meta") { + open(FILE, $ulsdir.'/'.$ulsfn.".meta"); + my @obsolete=; + foreach my $obsolete (@obsolete) { + if($obsolete =~ m|()(on)|) { $obs = 1; } + if($obsolete =~ m|()(default)|) { $rights = 1; } + } + } + $ulsout.=$ulsfn.'&'.join('&',@ulsstats); + if($obs eq '1') { $ulsout.="&1"; } + else { $ulsout.="&0"; } + if($rights eq '1') { $ulsout.="&1:"; } + else { $ulsout.="&0:"; } + } + closedir(LSDIR); + } + } else { + my @ulsstats=stat($ulsdir); + $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':'; + } + } else { + $ulsout='no_such_dir'; + } + if ($ulsout eq '') { $ulsout='empty'; } + print $client "$ulsout\n"; + + return 1; + +} +®ister_handler("ls", \&ls_handler, 0, 1, 0); + + # Process a reinit request. Reinit requests that either @@ -1843,7 +1939,11 @@ sub remove_user_file_handler { if (-e $udir) { my $file=$udir.'/userfiles/'.$ufile; if (-e $file) { - unlink($file); + if (-f $file){ + unlink($file); + } elsif(-d $file) { + rmdir($file); + } if (-e $file) { &Failure($client, "failed\n", "$cmd:$tail"); } else { @@ -2108,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, @@ -3060,6 +3160,583 @@ sub dump_course_id_handler { return 1; } ®ister_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0); + +# +# Puts an id to a domains id database. +# +# Parameters: +# $cmd - The command that triggered us. +# $tail - Remainder of the request other than the command. This is a +# colon separated list containing: +# $domain - The domain for which we are writing the id. +# $pairs - The id info to write... this is and & separated list +# of keyword=value. +# $client - Socket open on the client. +# Returns: +# 1 - Continue processing. +# Side effects: +# reply is written to $client. +# +sub put_id_handler { + my ($cmd,$tail,$client) = @_; + + + my $userinput = "$cmd:$tail"; + + my ($udom,$what)=split(/:/,$tail); + chomp($what); + my @pairs=split(/\&/,$what); + my $hashref = &tie_domain_hash($udom, "ids", &GDBM_WRCREAT(), + "P", $what); + if ($hashref) { + foreach my $pair (@pairs) { + my ($key,$value)=split(/=/,$pair); + $hashref->{$key}=$value; + } + if (untie(%$hashref)) { + &Reply($client, "ok\n", $userinput); + } else { + &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". + "while attempting idput\n", $userinput); + } + } else { + &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". + "while attempting idput\n", $userinput); + } + + return 1; +} + +®ister_handler("idput", \&put_id_handler, 0, 1, 0); +# +# Retrieves a set of id values from the id database. +# Returns an & separated list of results, one for each requested id to the +# client. +# +# Parameters: +# $cmd - Command keyword that caused us to be dispatched. +# $tail - Tail of the command. Consists of a colon separated: +# domain - the domain whose id table we dump +# ids Consists of an & separated list of +# id keywords whose values will be fetched. +# nonexisting keywords will have an empty value. +# $client - Socket open on the client. +# +# Returns: +# 1 - indicating processing should continue. +# Side effects: +# An & separated list of results is written to $client. +# +sub get_id_handler { + my ($cmd, $tail, $client) = @_; + + + my $userinput = "$client:$tail"; + + my ($udom,$what)=split(/:/,$tail); + chomp($what); + my @queries=split(/\&/,$what); + my $qresult=''; + my $hashref = &tie_domain_hash($udom, "ids", &GDBM_READER()); + if ($hashref) { + for (my $i=0;$i<=$#queries;$i++) { + $qresult.="$hashref->{$queries[$i]}&"; + } + if (untie(%$hashref)) { + $qresult=~s/\&$//; + &Reply($client, "$qresult\n", $userinput); + } else { + &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". + "while attempting idget\n",$userinput); + } + } else { + &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". + "while attempting idget\n",$userinput); + } + + return 1; +} + +register_handler("idget", \&get_id_handler, 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 tmp_put_handler { + my ($cmd, $what, $client) = @_; + + 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; + +} +®ister_handler("tmpput", \&tmp_put_handler, 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 tmp_get_handler { + my ($cmd, $id, $client) = @_; + + my $userinput = "$cmd:$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; +} +®ister_handler("tmpget", \&tmp_get_handler, 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 tmp_del_handler { + my ($cmd, $id, $client) = @_; + + 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; + +} +®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,1); +®ister_handler("init", \&exit_handler, 0,1,1); +®ister_handler("quit", \&exit_handler, 0,1,1); + +# Determine if auto-enrollment is enabled. +# Note that the original had what I believe to be a defect. +# The original returned 0 if the requestor was not a registerd client. +# It should return "refused". +# Formal Parameters: +# $cmd - The command that invoked us. +# $tail - The tail of the command (Extra command parameters. +# $client - The socket open on the client that issued the request. +# Returns: +# 1 - Indicating processing should continue. +# +sub enrollment_enabled_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = $cmd.":".$tail; # For logging purposes. + + + my $cdom = split(/:/, $tail); # Domain we're asking about. + my $outcome = &localenroll::run($cdom); + &Reply($client, "$outcome\n", $userinput); + + return 1; +} +®ister_handler("autorun", \&enrollment_enabled_handler, 0, 1, 0); + +# Get the official sections for which auto-enrollment is possible. +# Since the admin people won't know about 'unofficial sections' +# we cannot auto-enroll on them. +# Formal Parameters: +# $cmd - The command request that got us dispatched here. +# $tail - The remainder of the request. In our case this +# will be split into: +# $coursecode - The course name from the admin point of view. +# $cdom - The course's domain(?). +# $client - Socket open on the client. +# Returns: +# 1 - Indiciting processing should continue. +# +sub get_sections_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + + my ($coursecode, $cdom) = split(/:/, $tail); + my @secs = &localenroll::get_sections($coursecode,$cdom); + my $seclist = &escape(join(':',@secs)); + + &Reply($client, "$seclist\n", $userinput); + + + return 1; +} +®ister_handler("autogetsections", \&get_sections_handler, 0, 1, 0); + +# Validate the owner of a new course section. +# +# Formal Parameters: +# $cmd - Command that got us dispatched. +# $tail - the remainder of the command. For us this consists of a +# colon separated string containing: +# $inst - Course Id from the institutions point of view. +# $owner - Proposed owner of the course. +# $cdom - Domain of the course (from the institutions +# point of view?).. +# $client - Socket open on the client. +# +# Returns: +# 1 - Processing should continue. +# +sub validate_course_owner_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + my ($inst_course_id, $owner, $cdom) = split(/:/, $tail); + + my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom); + &Reply($client, "$outcome\n", $userinput); + + + + return 1; +} +®ister_handler("autonewcourse", \&validate_course_owner_handler, 0, 1, 0); +# +# Validate a course section in the official schedule of classes +# from the institutions point of view (part of autoenrollment). +# +# Formal Parameters: +# $cmd - The command request that got us dispatched. +# $tail - The tail of the command. In this case, +# this is a colon separated set of words that will be split +# into: +# $inst_course_id - The course/section id from the +# institutions point of view. +# $cdom - The domain from the institutions +# point of view. +# $client - Socket open on the client. +# Returns: +# 1 - Indicating processing should continue. +# +sub validate_course_section_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + my ($inst_course_id, $cdom) = split(/:/, $tail); + + my $outcome=&localenroll::validate_courseID($inst_course_id,$cdom); + &Reply($client, "$outcome\n", $userinput); + + + return 1; +} +®ister_handler("autovalidatecourse", \&validate_course_section_handler, 0, 1, 0); + +# +# Create a password for a new auto-enrollment user. +# I think/guess, this password allows access to the institutions +# AIS class list server/services. Stuart can correct this comment +# when he finds out how wrong I am. +# +# Formal Parameters: +# $cmd - The command request that got us dispatched. +# $tail - The tail of the command. In this case this is a colon separated +# set of words that will be split into: +# $authparam - An authentication parameter (username??). +# $cdom - The domain of the course from the institution's +# point of view. +# $client - The socket open on the client. +# Returns: +# 1 - continue processing. +# +sub create_auto_enroll_password_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + + my ($authparam, $cdom) = split(/:/, $userinput); + + my ($create_passwd,$authchk); + ($authparam, + $create_passwd, + $authchk) = &localenroll::create_password($authparam,$cdom); + + &Reply($client, &escape($authparam.':'.$create_passwd.':'.$authchk)."\n", + $userinput); + + + return 1; +} +®ister_handler("autocreatepassword", \&create_auto_enroll_password_handler, + 0, 1, 0); + +# Retrieve and remove temporary files created by/during autoenrollment. +# +# Formal Parameters: +# $cmd - The command that got us dispatched. +# $tail - The tail of the command. In our case this is a colon +# separated list that will be split into: +# $filename - The name of the file to remove. +# The filename is given as a path relative to +# the LonCAPA temp file directory. +# $client - Socket open on the client. +# +# Returns: +# 1 - Continue processing. + +sub retrieve_auto_file_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "cmd:$tail"; + + my ($filename) = split(/:/, $tail); + + my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename; + if ( (-e $source) && ($filename ne '') ) { + my $reply = ''; + if (open(my $fh,$source)) { + while (<$fh>) { + chomp($_); + $_ =~ s/^\s+//g; + $_ =~ s/\s+$//g; + $reply .= $_; + } + close($fh); + &Reply($client, &escape($reply)."\n", $userinput); + +# Does this have to be uncommented??!? (RF). +# +# unlink($source); + } else { + &Failure($client, "error\n", $userinput); + } + } else { + &Failure($client, "error\n", $userinput); + } + + + return 1; +} +®ister_handler("autoretrieve", \&retrieve_auto_file_handler, 0,1,0); + +# +# Read and retrieve institutional code format (for support form). +# Formal Parameters: +# $cmd - Command that dispatched us. +# $tail - Tail of the command. In this case it conatins +# the course domain and the coursename. +# $client - Socket open on the client. +# Returns: +# 1 - Continue processing. +# +sub get_institutional_code_format_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + + my $reply; + my($cdom,$course) = split(/:/,$tail); + my @pairs = split/\&/,$course; + my %instcodes = (); + my %codes = (); + my @codetitles = (); + my %cat_titles = (); + my %cat_order = (); + foreach (@pairs) { + my ($key,$value) = split/=/,$_; + $instcodes{&unescape($key)} = &unescape($value); + } + my $formatreply = &localenroll::instcode_format($cdom, + \%instcodes, + \%codes, + \@codetitles, + \%cat_titles, + \%cat_order); + if ($formatreply eq 'ok') { + my $codes_str = &hash2str(%codes); + my $codetitles_str = &array2str(@codetitles); + my $cat_titles_str = &hash2str(%cat_titles); + my $cat_order_str = &hash2str(%cat_order); + &Reply($client, + $codes_str.':'.$codetitles_str.':'.$cat_titles_str.':' + .$cat_order_str."\n", + $userinput); + } else { + # this else branch added by RF since if not ok, lonc will + # hang waiting on reply until timeout. + # + &Reply($client, "format_error\n", $userinput); + } + + return 1; +} + +®ister_handler("autoinstcodeformat", \&get_institutional_code_format_handler, + 0,1,0); + +# +# # # # @@ -3176,228 +3853,8 @@ sub process_request { #------------------- Commands not yet in spearate handlers. -------------- - -# ----------------------------------------------------------------------- idput - if ($userinput =~ /^idput/) { - if(isClient) { - my ($cmd,$udom,$what)=split(/:/,$userinput); - chomp($what); - $udom=~s/\W//g; - my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; - my $now=time; - my @pairs=split(/\&/,$what); - my %hash; - if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) { - { - my $hfh; - if ($hfh=IO::File->new(">>$proname.hist")) { - print $hfh "P:$now:$what\n"; - } - } - foreach my $pair (@pairs) { - my ($key,$value)=split(/=/,$pair); - $hash{$key}=$value; - } - if (untie(%hash)) { - print $client "ok\n"; - } else { - print $client "error: ".($!+0) - ." untie(GDBM) Failed ". - "while attempting idput\n"; - } - } else { - print $client "error: ".($!+0) - ." tie(GDBM) Failed ". - "while attempting idput\n"; - } - } else { - Reply($client, "refused\n", $userinput); - - } -# ----------------------------------------------------------------------- idget - } elsif ($userinput =~ /^idget/) { - if(isClient) { - my ($cmd,$udom,$what)=split(/:/,$userinput); - chomp($what); - $udom=~s/\W//g; - my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; - my @queries=split(/\&/,$what); - my $qresult=''; - my %hash; - if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) { - for (my $i=0;$i<=$#queries;$i++) { - $qresult.="$hash{$queries[$i]}&"; - } - if (untie(%hash)) { - $qresult=~s/\&$//; - print $client "$qresult\n"; - } else { - print $client "error: ".($!+0) - ." untie(GDBM) Failed ". - "while attempting idget\n"; - } - } else { - print $client "error: ".($!+0) - ." tie(GDBM) Failed ". - "while attempting idget\n"; - } - } else { - Reply($client, "refused\n", $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; - print $client "$id\n"; - } - else { - print $client "error: ".($!+0) - ."IO::File->new Failed ". - "while attempting tmpput\n"; - } - } else { - Reply($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>; - print $client "$reply\n"; - close $store; - } - else { - print $client "error: ".($!+0) - ."IO::File->new Failed ". - "while attempting tmpget\n"; - } - } else { - Reply($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")) { - print $client "ok\n"; - } else { - print $client "error: ".($!+0) - ."Unlink tmp Failed ". - "while attempting tmpdel\n"; - } - } else { - Reply($client, "refused\n", $userinput); - - } -# -------------------------------------------------------------------------- ls - } elsif ($userinput =~ /^ls/) { - if(isClient) { - my $obs; - my $rights; - my ($cmd,$ulsdir)=split(/:/,$userinput); - my $ulsout=''; - my $ulsfn; - if (-e $ulsdir) { - if(-d $ulsdir) { - if (opendir(LSDIR,$ulsdir)) { - while ($ulsfn=readdir(LSDIR)) { - undef $obs, $rights; - my @ulsstats=stat($ulsdir.'/'.$ulsfn); - #We do some obsolete checking here - if(-e $ulsdir.'/'.$ulsfn.".meta") { - open(FILE, $ulsdir.'/'.$ulsfn.".meta"); - my @obsolete=; - foreach my $obsolete (@obsolete) { - if($obsolete =~ m|()(on)|) { $obs = 1; } - if($obsolete =~ m|()(default)|) { $rights = 1; } - } - } - $ulsout.=$ulsfn.'&'.join('&',@ulsstats); - if($obs eq '1') { $ulsout.="&1"; } - else { $ulsout.="&0"; } - if($rights eq '1') { $ulsout.="&1:"; } - else { $ulsout.="&0:"; } - } - closedir(LSDIR); - } - } else { - my @ulsstats=stat($ulsdir); - $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':'; - } - } else { - $ulsout='no_such_dir'; - } - if ($ulsout eq '') { $ulsout='empty'; } - print $client "$ulsout\n"; - } else { - Reply($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; - 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); @@ -3469,7 +3926,8 @@ sub process_request { } else { print $client "refused\n"; } -#--------------------- read and retrieve institutional code format (for support form). +#--------------------- read and retrieve institutional code format +# (for support form). } elsif ($userinput =~/^autoinstcodeformat/) { if (isClient) { my $reply; 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.