--- loncom/lond 2004/04/19 11:28:18 1.178.2.17
+++ loncom/lond 2004/04/29 10:35:07 1.178.2.21
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.178.2.17 2004/04/19 11:28:18 foxr Exp $
+# $Id: lond,v 1.178.2.21 2004/04/29 10:35:07 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -53,7 +53,7 @@ my $DEBUG = 1; # Non zero to ena
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.178.2.17 $'; #' stupid emacs
+my $VERSION='$Revision: 1.178.2.21 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid;
my $currentdomainid;
@@ -1028,7 +1028,9 @@ sub UpdateResourceHandler {
my $userinput = "$cmd:$tail";
- my $fname=$tail;
+ my $fname=split(/:/,$tail); # This allows interactive testing
+ chomp($fname); # with telnet.
+
my $ownership=ishome($fname);
if ($ownership eq 'not_owner') {
if (-e $fname) {
@@ -1188,15 +1190,20 @@ sub UnsubscribeHandler {
my $client = shift;
my $userinput= "$cmd:$tail";
- my $fname = $tail;
+ my ($fname) = split(/:/,$tail); # This allows for interactive testing
+ # e.g. manual telnet and unsub:res:
+ # Otherwise the \r gets in the way.
+ chomp($fname);
+ Debug("Unsubscribing $fname");
if (-e $fname) {
- Reply($client, &unsub($client,$fname,$clientip), $userinput);
+ Debug("Exists");
+ Reply($client, &unsub($fname,$clientip), $userinput);
} else {
Failure($client, "not_found\n", $userinput);
}
return 1;
}
-RegisterHandler("unusb", \&UnsubscribeHandler, 0, 1, 0);
+RegisterHandler("unsub", \&UnsubscribeHandler, 0, 1, 0);
# Subscribe to a resource
#
@@ -1410,9 +1417,9 @@ sub RolesPutHandler {
my $client = shift;
my $userinput = "$cmd:$tail";
- my ($exedom,$exeuser,$udom,$uname,$what) =split(/:/,$tail);
- &Debug("cmd = ".$cmd." exedom= ".$exedom."user = ".$exeuser." udom=".$udom.
- "what = ".$what);
+ my ( $exedom, $exeuser, $udom, $uname, $what) = split(/:/,$tail);
+
+
my $namespace='roles';
chomp($what);
my $hashref = TieUserHash($udom, $uname, $namespace,
@@ -2385,8 +2392,7 @@ sub TmpPutHandler {
my $store;
$tmpsnum++;
- my $pid = $$;
- my $id=$$.'_'.$clientip.'_'.$tmpsnum.'_'.$pid;
+ my $id=$$.'_'.$clientip.'_'.$tmpsnum;
$id=~s/\W/\_/g;
$what=~s/\n//g;
my $execdir=$perlvar{'lonDaemons'};
@@ -2497,10 +2503,15 @@ sub LsHandler {
my $userinput = "$cmd:$ulsdir";
+ chomp($ulsdir);
+
my $ulsout='';
my $ulsfn;
+ logthis("ls for '$ulsdir'");
if (-e $ulsdir) {
+ logthis("ls - directory exists");
if(-d $ulsdir) {
+ logthis("ls $ulsdir is a file");
if (opendir(LSDIR,$ulsdir)) {
while ($ulsfn=readdir(LSDIR)) {
my @ulsstats=stat($ulsdir.'/'.$ulsfn);
@@ -2684,6 +2695,8 @@ sub ProcessRequest {
# Split off the request keyword from the rest of the stuff.
my ($command, $tail) = split(/:/, $userinput, 2);
+ chomp($command);
+ chomp($tail);
Debug("Command received: $command, encoded = $wasenc");
@@ -2725,7 +2738,7 @@ sub ProcessRequest {
$KeepGoing = &$Handler($command, $tail, $client);
} else {
Debug("Refusing to dispatch because ok is false");
- Failure($client, "refused", $userinput);
+ Failure($client, "refused\n", $userinput);
}
@@ -3812,9 +3825,13 @@ sub propath {
sub ishome {
my $author=shift;
+ Debug("ishome: $author");
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
+ Debug(" after big regsub: $author");
my ($udom,$uname)=split(/\//,$author);
+ Debug(" domain: $udom user: $uname");
my $proname=propath($udom,$uname);
+ Debug(" path = $proname");
if (-e $proname) {
return 'owner';
} else {
@@ -4040,7 +4057,7 @@ sub ManagePermissions {
my $authtype= shift;
# See if the request is of the form /$domain/_au
- &logthis("ruequest is $request");
+ &logthis("request is $request");
if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput...
my $execdir = $perlvar{'lonDaemons'};
my $userhome= "/home/$user" ;
@@ -4280,15 +4297,25 @@ sub addline {
my $expr='^'.$hostid.':'.$ip.':';
$expr =~ s/\./\\\./g;
my $sh;
+ Debug("Looking for $expr");
if ($sh=IO::File->new("$fname.subscription")) {
while (my $subline=<$sh>) {
- if ($subline !~ /$expr/) {$contents.= $subline;} else {$found=1;}
+ Debug("addline: line: $subline");
+ if ($subline !~ /$expr/) {
+ $contents.= $subline;
+ } else {
+ Debug("Found $subline");
+ $found=1;
+ }
}
$sh->close();
}
$sh=IO::File->new(">$fname.subscription");
if ($contents) { print $sh $contents; }
- if ($newline) { print $sh $newline; }
+ if ($newline) {
+ Debug("Appending $newline");
+ print $sh $newline;
+ }
$sh->close();
return $found;
}
@@ -4361,17 +4388,36 @@ sub chatadd {
sub unsub {
my ($fname,$clientip)=@_;
my $result;
+ my $unsubs = 0; # Number of successful unsubscribes:
+
+
+ # An old way subscriptions were handled was to have a
+ # subscription marker file:
+
+ Debug("Attempting unlink of $fname.$clientname");
if (unlink("$fname.$clientname")) {
- $result="ok\n";
- } else {
- $result="not_subscribed\n";
- }
+ $unsubs++; # Successful unsub via marker file.
+ }
+
+ # The more modern way to do it is to have a subscription list
+ # file:
+
if (-e "$fname.subscription") {
my $found=&addline($fname,$clientname,$clientip,'');
- if ($found) { $result="ok\n"; }
+ if ($found) {
+ $unsubs++;
+ }
+ }
+
+ # If either or both of these mechanisms succeeded in unsubscribing a
+ # resource we can return ok:
+
+ if($unsubs) {
+ $result = "ok\n";
} else {
- if ($result != "ok\n") { $result="not_subscribed\n"; }
+ $result = "not_subscribed\n";
}
+
return $result;
}
@@ -4423,12 +4469,15 @@ sub thisversion {
sub subscribe {
my ($userinput,$clientip)=@_;
+ chomp($userinput);
my $result;
my ($cmd,$fname)=split(/:/,$userinput);
my $ownership=&ishome($fname);
+ Debug("subscribe: Owner = $ownership file: '$fname'");
if ($ownership eq 'owner') {
# explitly asking for the current version?
unless (-e $fname) {
+ Debug("subscribe - does not exist");
my $currentversion=¤tversion($fname);
if (&thisversion($fname)==$currentversion) {
if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) {
@@ -4444,6 +4493,7 @@ sub subscribe {
}
}
if (-e $fname) {
+ Debug("subscribe - exists");
if (-d $fname) {
$result="directory\n";
} else {
@@ -4534,8 +4584,10 @@ sub make_passwd_file {
sub sethost {
my ($remotereq) = @_;
+ Debug("sethost got $remotereq");
my (undef,$hostid)=split(/:/,$remotereq);
if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }
+ Debug("sethost attempting to set host $hostid");
if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {
$currenthostid=$hostid;
$currentdomainid=$hostdom{$hostid};
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.