version 1.178.2.15, 2004/04/13 09:41:57
|
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=$tail; |
my $fname= $tail; # This allows interactive testing |
|
|
|
|
my $ownership=ishome($fname); |
my $ownership=ishome($fname); |
if ($ownership eq 'not_owner') { |
if ($ownership eq 'not_owner') { |
if (-e $fname) { |
if (-e $fname) { |
Line 1138 sub FetchUserFileHandler {
|
Line 1142 sub FetchUserFileHandler {
|
} |
} |
RegisterHandler("fetchuserfile", \&FetchUserFileHandler, 0, 1, 0); |
RegisterHandler("fetchuserfile", \&FetchUserFileHandler, 0, 1, 0); |
# |
# |
# Authenticate access to a user file. Question? The token for athentication |
# Authenticate access to a user file. |
# is allowed to be sent as cleartext is this really what we want? This token |
|
# represents the user's session id. Once it is forged does this allow too much |
|
# access?? |
|
# |
# |
# Parameters: |
# Parameters: |
# $cmd - The command that got us here. |
# $cmd - The command that got us here. |
Line 1191 sub UnsubscribeHandler {
|
Line 1192 sub UnsubscribeHandler {
|
my $client = shift; |
my $client = shift; |
my $userinput= "$cmd:$tail"; |
my $userinput= "$cmd:$tail"; |
|
|
my $fname = $tail; |
my ($fname) = $tail; |
|
|
|
Debug("Unsubscribing $fname"); |
if (-e $fname) { |
if (-e $fname) { |
Reply($client, &unsub($client,$fname,$clientip), $userinput); |
Debug("Exists"); |
|
Reply($client, &unsub($fname,$clientip), $userinput); |
} else { |
} else { |
Failure($client, "not_found\n", $userinput); |
Failure($client, "not_found\n", $userinput); |
} |
} |
return 1; |
return 1; |
} |
} |
RegisterHandler("unusb", \&UnsubscribeHandler, 0, 1, 0); |
RegisterHandler("unsub", \&UnsubscribeHandler, 0, 1, 0); |
|
|
# Subscribe to a resource |
# Subscribe to a resource |
# |
# |
Line 1413 sub RolesPutHandler {
|
Line 1417 sub RolesPutHandler {
|
my $client = shift; |
my $client = shift; |
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($exedom,$exeuser,$udom,$uname,$what) =split(/:/,$tail); |
my ( $exedom, $exeuser, $udom, $uname, $what) = split(/:/,$tail); |
&Debug("cmd = ".$cmd." exedom= ".$exedom."user = ".$exeuser." udom=".$udom. |
|
"what = ".$what); |
|
my $namespace='roles'; |
my $namespace='roles'; |
chomp($what); |
chomp($what); |
my $hashref = TieUserHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
Line 1617 sub GetProfileEntryEncrypted {
|
Line 1621 sub GetProfileEntryEncrypted {
|
|
|
return 1; |
return 1; |
} |
} |
RegisterHandler("eget", \&GetProfileEncrypted, 0, 1, 0); |
RegisterHandler("eget", \&GetProfileEntryEncrypted, 0, 1, 0); |
|
|
# |
# |
# Deletes a key in a user profile database. |
# Deletes a key in a user profile database. |
Line 1848 sub DumpWithRegexp {
|
Line 1852 sub DumpWithRegexp {
|
} |
} |
RegisterHandler("dump", \&DumpWithRegexp, 0, 1, 0); |
RegisterHandler("dump", \&DumpWithRegexp, 0, 1, 0); |
|
|
# Store an aitem in any database but the roles database. |
# Store a set of key=value pairs associated with a versioned name. |
# |
# |
# Parameters: |
# Parameters: |
# $cmd - Request command keyword. |
# $cmd - Request command keyword. |
Line 1914 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 1928 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 2223 sub DumpCourseIdHandler {
|
Line 2236 sub DumpCourseIdHandler {
|
} |
} |
unless (defined($since)) { $since=0; } |
unless (defined($since)) { $since=0; } |
my $qresult=''; |
my $qresult=''; |
|
logthis(" Looking for $description since $since"); |
my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT()); |
my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT()); |
if ($hashref) { |
if ($hashref) { |
while (my ($key,$value) = each(%$hashref)) { |
while (my ($key,$value) = each(%$hashref)) { |
my ($descr,$lasttime)=split(/\:/,$value); |
my ($descr,$lasttime)=split(/\:/,$value); |
|
logthis("Got: key = $key descr = $descr time: $lasttime"); |
if ($lasttime<$since) { |
if ($lasttime<$since) { |
|
logthis("Skipping .. too early"); |
next; |
next; |
} |
} |
if ($description eq '.') { |
if ($description eq '.') { |
|
logthis("Adding wildcard match"); |
$qresult.=$key.'='.$descr.'&'; |
$qresult.=$key.'='.$descr.'&'; |
} else { |
} else { |
my $unescapeVal = &unescape($descr); |
my $unescapeVal = &unescape($descr); |
|
logthis("Matching with $unescapeVal"); |
if (eval('$unescapeVal=~/$description/i')) { |
if (eval('$unescapeVal=~/$description/i')) { |
|
logthis("Adding on match"); |
$qresult.="$key=$descr&"; |
$qresult.="$key=$descr&"; |
} |
} |
} |
} |
Line 2419 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 2493 sub LsHandler {
|
Line 2511 sub LsHandler {
|
|
|
my $userinput = "$cmd:$ulsdir"; |
my $userinput = "$cmd:$ulsdir"; |
|
|
|
chomp($ulsdir); |
|
|
my $ulsout=''; |
my $ulsout=''; |
my $ulsfn; |
my $ulsfn; |
|
logthis("ls for '$ulsdir'"); |
if (-e $ulsdir) { |
if (-e $ulsdir) { |
|
logthis("ls - directory exists"); |
if(-d $ulsdir) { |
if(-d $ulsdir) { |
|
logthis("ls $ulsdir is a file"); |
if (opendir(LSDIR,$ulsdir)) { |
if (opendir(LSDIR,$ulsdir)) { |
while ($ulsfn=readdir(LSDIR)) { |
while ($ulsfn=readdir(LSDIR)) { |
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
Line 2680 sub ProcessRequest {
|
Line 2703 sub ProcessRequest {
|
# Split off the request keyword from the rest of the stuff. |
# Split off the request keyword from the rest of the stuff. |
|
|
my ($command, $tail) = split(/:/, $userinput, 2); |
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"); |
Debug("Command received: $command, encoded = $wasenc"); |
|
|
Line 2721 sub ProcessRequest {
|
Line 2747 sub ProcessRequest {
|
$KeepGoing = &$Handler($command, $tail, $client); |
$KeepGoing = &$Handler($command, $tail, $client); |
} else { |
} else { |
Debug("Refusing to dispatch because ok is false"); |
Debug("Refusing to dispatch because ok is false"); |
Failure($client, "refused", $userinput); |
Failure($client, "refused\n", $userinput); |
} |
} |
|
|
|
|
Line 3808 sub propath {
|
Line 3834 sub propath {
|
|
|
sub ishome { |
sub ishome { |
my $author=shift; |
my $author=shift; |
|
Debug("ishome: $author"); |
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
|
Debug(" after big regsub: $author"); |
my ($udom,$uname)=split(/\//,$author); |
my ($udom,$uname)=split(/\//,$author); |
|
Debug(" domain: $udom user: $uname"); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
|
Debug(" path = $proname"); |
if (-e $proname) { |
if (-e $proname) { |
return 'owner'; |
return 'owner'; |
} else { |
} else { |
Line 4036 sub ManagePermissions {
|
Line 4066 sub ManagePermissions {
|
my $authtype= shift; |
my $authtype= shift; |
|
|
# See if the request is of the form /$domain/_au |
# 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... |
if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput... |
my $execdir = $perlvar{'lonDaemons'}; |
my $execdir = $perlvar{'lonDaemons'}; |
my $userhome= "/home/$user" ; |
my $userhome= "/home/$user" ; |
Line 4276 sub addline {
|
Line 4306 sub addline {
|
my $expr='^'.$hostid.':'.$ip.':'; |
my $expr='^'.$hostid.':'.$ip.':'; |
$expr =~ s/\./\\\./g; |
$expr =~ s/\./\\\./g; |
my $sh; |
my $sh; |
|
Debug("Looking for $expr"); |
if ($sh=IO::File->new("$fname.subscription")) { |
if ($sh=IO::File->new("$fname.subscription")) { |
while (my $subline=<$sh>) { |
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->close(); |
} |
} |
$sh=IO::File->new(">$fname.subscription"); |
$sh=IO::File->new(">$fname.subscription"); |
if ($contents) { print $sh $contents; } |
if ($contents) { print $sh $contents; } |
if ($newline) { print $sh $newline; } |
if ($newline) { |
|
Debug("Appending $newline"); |
|
print $sh $newline; |
|
} |
$sh->close(); |
$sh->close(); |
return $found; |
return $found; |
} |
} |
Line 4357 sub chatadd {
|
Line 4397 sub chatadd {
|
sub unsub { |
sub unsub { |
my ($fname,$clientip)=@_; |
my ($fname,$clientip)=@_; |
my $result; |
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")) { |
if (unlink("$fname.$clientname")) { |
$result="ok\n"; |
$unsubs++; # Successful unsub via marker file. |
} else { |
} |
$result="not_subscribed\n"; |
|
} |
# The more modern way to do it is to have a subscription list |
|
# file: |
|
|
if (-e "$fname.subscription") { |
if (-e "$fname.subscription") { |
my $found=&addline($fname,$clientname,$clientip,''); |
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 { |
} else { |
if ($result != "ok\n") { $result="not_subscribed\n"; } |
$result = "not_subscribed\n"; |
} |
} |
|
|
return $result; |
return $result; |
} |
} |
|
|
Line 4419 sub thisversion {
|
Line 4478 sub thisversion {
|
|
|
sub subscribe { |
sub subscribe { |
my ($userinput,$clientip)=@_; |
my ($userinput,$clientip)=@_; |
|
chomp($userinput); |
my $result; |
my $result; |
my ($cmd,$fname)=split(/:/,$userinput); |
my ($cmd,$fname)=split(/:/,$userinput); |
my $ownership=&ishome($fname); |
my $ownership=&ishome($fname); |
|
Debug("subscribe: Owner = $ownership file: '$fname'"); |
if ($ownership eq 'owner') { |
if ($ownership eq 'owner') { |
# explitly asking for the current version? |
# explitly asking for the current version? |
unless (-e $fname) { |
unless (-e $fname) { |
|
Debug("subscribe - does not exist"); |
my $currentversion=¤tversion($fname); |
my $currentversion=¤tversion($fname); |
if (&thisversion($fname)==$currentversion) { |
if (&thisversion($fname)==$currentversion) { |
if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) { |
if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) { |
Line 4440 sub subscribe {
|
Line 4502 sub subscribe {
|
} |
} |
} |
} |
if (-e $fname) { |
if (-e $fname) { |
|
Debug("subscribe - exists"); |
if (-d $fname) { |
if (-d $fname) { |
$result="directory\n"; |
$result="directory\n"; |
} else { |
} else { |
Line 4510 sub make_passwd_file {
|
Line 4573 sub make_passwd_file {
|
|
|
my $useraddok = $?; |
my $useraddok = $?; |
if($useraddok > 0) { |
if($useraddok > 0) { |
&logthis("Failed lcuseradd: ".&lcuseraddstrerror($useraddok)); |
my $lcstring = lcuseraddstrerror($useraddok); |
|
&logthis("Failed lcuseradd: $lcstring"); |
|
return "error: lcuseradd failed: $lcstring\n"; |
} |
} |
my $pf = IO::File->new(">$passfilename"); |
my $pf = IO::File->new(">$passfilename"); |
print $pf "unix:\n"; |
print $pf "unix:\n"; |
Line 4528 sub make_passwd_file {
|
Line 4593 sub make_passwd_file {
|
|
|
sub sethost { |
sub sethost { |
my ($remotereq) = @_; |
my ($remotereq) = @_; |
|
Debug("sethost got $remotereq"); |
my (undef,$hostid)=split(/:/,$remotereq); |
my (undef,$hostid)=split(/:/,$remotereq); |
if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; } |
if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; } |
|
Debug("sethost attempting to set host $hostid"); |
if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) { |
if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) { |
$currenthostid=$hostid; |
$currenthostid=$hostid; |
$currentdomainid=$hostdom{$hostid}; |
$currentdomainid=$hostdom{$hostid}; |