--- loncom/lond 2004/04/26 10:37:47 1.178.2.19 +++ loncom/lond 2004/05/07 17:57:18 1.178.2.23 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.178.2.19 2004/04/26 10:37:47 foxr Exp $ +# $Id: lond,v 1.178.2.23 2004/05/07 17:57:18 www 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.19 $'; #' stupid emacs +my $VERSION='$Revision: 1.178.2.23 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -242,7 +242,9 @@ sub TieUserHash { # make the history log entry: - unless ($namespace =~/^nohist\_/ && (scalar @_ > 0)) { + if (($namespace =~/^nohist\_/) && (scalar @_ > 0)) { + my $args = scalar @_; + Debug(" Opening history: $namespace $args"); my $hfh = IO::File->new(">>$proname/$namespace.hist"); if($hfh) { my $now = time; @@ -788,7 +790,7 @@ sub ChangePasswordHandler { # npass - New password. my ($udom,$uname,$upass,$npass)=split(/:/,$tail); - chomp($npass); + $upass=&unescape($upass); $npass=&unescape($npass); &Debug("Trying to change password for $uname"); @@ -1028,7 +1030,9 @@ sub UpdateResourceHandler { my $userinput = "$cmd:$tail"; - my $fname=$tail; + my $fname= $tail; # This allows interactive testing + + my $ownership=ishome($fname); if ($ownership eq 'not_owner') { if (-e $fname) { @@ -1188,15 +1192,18 @@ sub UnsubscribeHandler { my $client = shift; my $userinput= "$cmd:$tail"; - my $fname = $tail; + my ($fname) = $tail; + + 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 # @@ -1845,8 +1852,7 @@ sub DumpWithRegexp { } RegisterHandler("dump", \&DumpWithRegexp, 0, 1, 0); -# Store an aitem in any resource meta data(?) or database with -# versioning? +# Store a set of key=value pairs associated with a versioned name. # # Parameters: # $cmd - Request command keyword. @@ -1912,7 +1918,9 @@ sub StoreHandler { } RegisterHandler("store", \&StoreHandler, 0, 1, 0); # -# Restore a prior version of a resource. +# Dump out all versions of a resource that has key=value pairs associated +# with it for each version. These resources are built up via the store +# command. # # Parameters: # $cmd - Command keyword. @@ -1926,6 +1934,13 @@ RegisterHandler("store", \&StoreHandler, # 1 indicating the caller should not yet exit. # Side-effects: # Writes a reply to the client. +# The reply is a string of the following shape: +# version=current&version:keys=k1:k2...&1:k1=v1&1:k2=v2... +# Where the 1 above represents version 1. +# this continues for all pairs of keys in all versions. +# +# +# # sub RestoreHandler { my $cmd = shift; @@ -2237,7 +2252,7 @@ sub DumpCourseIdHandler { } else { my $unescapeVal = &unescape($descr); logthis("Matching with $unescapeVal"); - if (eval('$unescapeVal=~/$description/i')) { + if (eval('$unescapeVal=~/\Q$description\E/i')) { logthis("Adding on match"); $qresult.="$key=$descr&"; } @@ -2422,7 +2437,7 @@ sub TmpGetHandler { my $client = shift; my $userinput = "$cmd:$id"; - chomp($id); + $id=~s/\W/\_/g; my $store; my $execdir=$perlvar{'lonDaemons'}; @@ -2690,6 +2705,7 @@ sub ProcessRequest { my ($command, $tail) = split(/:/, $userinput, 2); chomp($command); chomp($tail); + $tail =~ s/(\r)//; # This helps people debugging with e.g. telnet. Debug("Command received: $command, encoded = $wasenc"); @@ -3818,9 +3834,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 { @@ -4286,15 +4306,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; } @@ -4367,17 +4397,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; } @@ -4429,12 +4478,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)*)$/) { @@ -4450,6 +4502,7 @@ sub subscribe { } } if (-e $fname) { + Debug("subscribe - exists"); if (-d $fname) { $result="directory\n"; } else {