version 1.178.2.20, 2004/04/27 11:30:28
|
version 1.178.2.22, 2004/05/04 10:09:38
|
Line 242 sub TieUserHash {
|
Line 242 sub TieUserHash {
|
# make the history log entry: |
# 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"); |
my $hfh = IO::File->new(">>$proname/$namespace.hist"); |
if($hfh) { |
if($hfh) { |
my $now = time; |
my $now = time; |
Line 788 sub ChangePasswordHandler {
|
Line 790 sub ChangePasswordHandler {
|
# npass - New password. |
# npass - New password. |
|
|
my ($udom,$uname,$upass,$npass)=split(/:/,$tail); |
my ($udom,$uname,$upass,$npass)=split(/:/,$tail); |
chomp($npass); |
|
$upass=&unescape($upass); |
$upass=&unescape($upass); |
$npass=&unescape($npass); |
$npass=&unescape($npass); |
&Debug("Trying to change password for $uname"); |
&Debug("Trying to change password for $uname"); |
Line 1028 sub UpdateResourceHandler {
|
Line 1030 sub UpdateResourceHandler {
|
|
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my $fname=split(/:/$tail); # This allows interactive testing |
my $fname= $tail; # This allows interactive testing |
chomp($fname); # with telnet. |
|
|
|
my $ownership=ishome($fname); |
my $ownership=ishome($fname); |
if ($ownership eq 'not_owner') { |
if ($ownership eq 'not_owner') { |
Line 1190 sub UnsubscribeHandler {
|
Line 1192 sub UnsubscribeHandler {
|
my $client = shift; |
my $client = shift; |
my $userinput= "$cmd:$tail"; |
my $userinput= "$cmd:$tail"; |
|
|
my ($fname) = split(/:/,$tail); # This allows for interactive testing |
my ($fname) = $tail; |
# e.g. manual telnet and unsub:res: |
|
# Otherwise the \r gets in the way. |
|
chomp($fname); |
|
Debug("Unsubscribing $fname"); |
Debug("Unsubscribing $fname"); |
if (-e $fname) { |
if (-e $fname) { |
Debug("Exists"); |
Debug("Exists"); |
Line 1852 sub DumpWithRegexp {
|
Line 1852 sub DumpWithRegexp {
|
} |
} |
RegisterHandler("dump", \&DumpWithRegexp, 0, 1, 0); |
RegisterHandler("dump", \&DumpWithRegexp, 0, 1, 0); |
|
|
# Store an aitem in any resource meta data(?) or database with |
# Store a set of key=value pairs associated with a versioned name. |
# versioning? |
|
# |
# |
# Parameters: |
# Parameters: |
# $cmd - Request command keyword. |
# $cmd - Request command keyword. |
Line 1919 sub StoreHandler {
|
Line 1918 sub StoreHandler {
|
} |
} |
RegisterHandler("store", \&StoreHandler, 0, 1, 0); |
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: |
# Parameters: |
# $cmd - Command keyword. |
# $cmd - Command keyword. |
Line 1933 RegisterHandler("store", \&StoreHandler,
|
Line 1934 RegisterHandler("store", \&StoreHandler,
|
# 1 indicating the caller should not yet exit. |
# 1 indicating the caller should not yet exit. |
# Side-effects: |
# Side-effects: |
# Writes a reply to the client. |
# 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 { |
sub RestoreHandler { |
my $cmd = shift; |
my $cmd = shift; |
Line 2429 sub TmpGetHandler {
|
Line 2437 sub TmpGetHandler {
|
my $client = shift; |
my $client = shift; |
my $userinput = "$cmd:$id"; |
my $userinput = "$cmd:$id"; |
|
|
chomp($id); |
|
$id=~s/\W/\_/g; |
$id=~s/\W/\_/g; |
my $store; |
my $store; |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
Line 2697 sub ProcessRequest {
|
Line 2705 sub ProcessRequest {
|
my ($command, $tail) = split(/:/, $userinput, 2); |
my ($command, $tail) = split(/:/, $userinput, 2); |
chomp($command); |
chomp($command); |
chomp($tail); |
chomp($tail); |
|
$tail =~ s/(\r)//; # This helps people debugging with e.g. telnet. |
|
|
Debug("Command received: $command, encoded = $wasenc"); |
Debug("Command received: $command, encoded = $wasenc"); |
|
|
Line 4388 sub chatadd {
|
Line 4397 sub chatadd {
|
sub unsub { |
sub unsub { |
my ($fname,$clientip)=@_; |
my ($fname,$clientip)=@_; |
my $result; |
my $result; |
# if (unlink("$fname.$clientname")) { |
my $unsubs = 0; # Number of successful unsubscribes: |
# $result="ok\n"; |
|
# } else { |
|
# $result="not_subscribed\n"; |
# An old way subscriptions were handled was to have a |
# } |
# subscription marker file: |
unlink("$fname.$clientname"); |
|
|
Debug("Attempting unlink of $fname.$clientname"); |
|
if (unlink("$fname.$clientname")) { |
|
$unsubs++; # Successful unsub via marker file. |
|
} |
|
|
|
# The more modern way to do it is to have a subscription list |
|
# file: |
|
|
if (-e "$fname.subscription") { |
if (-e "$fname.subscription") { |
Debug ("Processing subscription file $fname.subscription"); |
|
my $found=&addline($fname,$clientname,$clientip,''); |
my $found=&addline($fname,$clientname,$clientip,''); |
if ($found) { |
if ($found) { |
Debug("Old linek found"); |
$unsubs++; |
$result="ok\n"; |
|
} else { |
|
$result = "not_subscribed\n"; |
|
} |
} |
|
} |
|
|
|
# If either or both of these mechanisms succeeded in unsubscribing a |
|
# resource we can return ok: |
|
|
|
if($unsubs) { |
|
$result = "ok\n"; |
} else { |
} else { |
Debug("No Subscription file $fname.subscription"); |
$result = "not_subscribed\n"; |
if ($result ne "ok\n") { $result="not_subscribed\n"; } |
|
} |
} |
|
|
return $result; |
return $result; |
} |
} |
|
|