version 1.226, 2004/08/10 11:30:24
|
version 1.230, 2004/08/16 11:44:10
|
Line 1812 sub remove_user_file_handler {
|
Line 1812 sub remove_user_file_handler {
|
my ($fname) = split(/:/, $tail); # Get rid of any tailing :'s lonc may have sent. |
my ($fname) = split(/:/, $tail); # Get rid of any tailing :'s lonc may have sent. |
|
|
my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|); |
my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|); |
&logthis("$udom - $uname - $ufile"); |
|
if ($ufile =~m|/\.\./|) { |
if ($ufile =~m|/\.\./|) { |
# any files paths with /../ in them refuse |
# any files paths with /../ in them refuse |
# to deal with |
# to deal with |
Line 1839 sub remove_user_file_handler {
|
Line 1838 sub remove_user_file_handler {
|
} |
} |
®ister_handler("removeuserfile", \&remove_user_file_handler, 0,1,0); |
®ister_handler("removeuserfile", \&remove_user_file_handler, 0,1,0); |
|
|
|
|
|
# |
|
# Authenticate access to a user file by checking the user's |
|
# session token(?) |
|
# |
|
# Parameters: |
|
# cmd - The request keyword that dispatched to tus. |
|
# tail - The tail of the request (colon separated parameters). |
|
# client - Filehandle open on the client. |
|
# Return: |
|
# 1. |
|
|
|
sub token_auth_user_file_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
|
|
my ($fname, $session) = split(/:/, $tail); |
|
|
|
chomp($session); |
|
my $reply='non_auth'; |
|
if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'. |
|
$session.'.id')) { |
|
while (my $line=<ENVIN>) { |
|
if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply='ok'; } |
|
} |
|
close(ENVIN); |
|
&Reply($client, $reply); |
|
} else { |
|
&Failure($client, "invalid_token\n", "$cmd:$tail"); |
|
} |
|
return 1; |
|
|
|
} |
|
|
|
®ister_handler("tokenauthuserfile", \&token_auth_user_file_handler, 0,1,0); |
|
|
|
|
|
# |
|
# Unsubscribe from a resource. |
|
# |
|
# Parameters: |
|
# $cmd - The command that got us here. |
|
# $tail - Tail of the command (remaining parameters). |
|
# $client - File descriptor connected to client. |
|
# Returns |
|
# 0 - Requested to exit, caller should shut down. |
|
# 1 - Continue processing. |
|
# |
|
sub unsubscribe_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
|
|
my $userinput= "$cmd:$tail"; |
|
|
|
my ($fname) = split(/:/,$tail); # Split in case there's extrs. |
|
|
|
&Debug("Unsubscribing $fname"); |
|
if (-e $fname) { |
|
&Debug("Exists"); |
|
&Reply($client, &unsub($fname,$clientip), $userinput); |
|
} else { |
|
&Failure($client, "not_found\n", $userinput); |
|
} |
|
return 1; |
|
} |
|
®ister_handler("unsub", \&unsubscribe_handler, 0, 1, 0); |
|
# Subscribe to a resource |
|
# |
|
# Parameters: |
|
# $cmd - The command that got us here. |
|
# $tail - Tail of the command (remaining parameters). |
|
# $client - File descriptor connected to client. |
|
# Returns |
|
# 0 - Requested to exit, caller should shut down. |
|
# 1 - Continue processing. |
|
# |
|
sub subscribe_handler { |
|
my ($cmd, $tail, $client)= @_; |
|
|
|
my $userinput = "$cmd:$tail"; |
|
|
|
&Reply( $client, &subscribe($userinput,$clientip), $userinput); |
|
|
|
return 1; |
|
} |
|
®ister_handler("sub", \&subscribe_handler, 0, 1, 0); |
|
|
|
# |
|
# Determine the version of a resource (?) Or is it return |
|
# the top version of the resource? Not yet clear from the |
|
# code in currentversion. |
|
# |
|
# Parameters: |
|
# $cmd - The command that got us here. |
|
# $tail - Tail of the command (remaining parameters). |
|
# $client - File descriptor connected to client. |
|
# Returns |
|
# 0 - Requested to exit, caller should shut down. |
|
# 1 - Continue processing. |
|
# |
|
sub current_version_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
|
|
my $userinput= "$cmd:$tail"; |
|
|
|
my $fname = $tail; |
|
&Reply( $client, ¤tversion($fname)."\n", $userinput); |
|
return 1; |
|
|
|
} |
|
®ister_handler("currentversion", \¤t_version_handler, 0, 1, 0); |
|
|
|
# Make an entry in a user's activity log. |
|
# |
|
# Parameters: |
|
# $cmd - The command that got us here. |
|
# $tail - Tail of the command (remaining parameters). |
|
# $client - File descriptor connected to client. |
|
# Returns |
|
# 0 - Requested to exit, caller should shut down. |
|
# 1 - Continue processing. |
|
# |
|
sub activity_log_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
|
|
|
|
my $userinput= "$cmd:$tail"; |
|
|
|
my ($udom,$uname,$what)=split(/:/,$tail); |
|
chomp($what); |
|
my $proname=&propath($udom,$uname); |
|
my $now=time; |
|
my $hfh; |
|
if ($hfh=IO::File->new(">>$proname/activity.log")) { |
|
print $hfh "$now:$clientname:$what\n"; |
|
&Reply( $client, "ok\n", $userinput); |
|
} else { |
|
&Failure($client, "error: ".($!+0)." IO::File->new Failed " |
|
."while attempting log\n", |
|
$userinput); |
|
} |
|
|
|
return 1; |
|
} |
|
register_handler("log", \&activity_log_handler, 0, 1, 0); |
|
|
|
# |
|
# Put a namespace entry in a user profile hash. |
|
# My druthers would be for this to be an encrypted interaction too. |
|
# anything that might be an inadvertent covert channel about either |
|
# user authentication or user personal information.... |
|
# |
|
# Parameters: |
|
# $cmd - The command that got us here. |
|
# $tail - Tail of the command (remaining parameters). |
|
# $client - File descriptor connected to client. |
|
# Returns |
|
# 0 - Requested to exit, caller should shut down. |
|
# 1 - Continue processing. |
|
# |
|
sub put_user_profile_entry { |
|
my ($cmd, $tail, $client) = @_; |
|
|
|
my $userinput = "$cmd:$tail"; |
|
|
|
my ($udom,$uname,$namespace,$what) =split(/:/,$tail); |
|
if ($namespace ne 'roles') { |
|
chomp($what); |
|
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
|
&GDBM_WRCREAT(),"P",$what); |
|
if($hashref) { |
|
my @pairs=split(/\&/,$what); |
|
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 put\n", |
|
$userinput); |
|
} |
|
} else { |
|
&Failure( $client, "error: ".($!)." tie(GDBM) Failed ". |
|
"while attempting put\n", $userinput); |
|
} |
|
} else { |
|
&Failure( $client, "refused\n", $userinput); |
|
} |
|
|
|
return 1; |
|
} |
|
®ister_handler("put", \&put_user_profile_entry, 0, 1, 0); |
|
|
|
# |
|
# Increment a profile entry in the user history file. |
|
# The history contains keyword value pairs. In this case, |
|
# The value itself is a pair of numbers. The first, the current value |
|
# the second an increment that this function applies to the current |
|
# value. |
|
# |
|
# Parameters: |
|
# $cmd - The command that got us here. |
|
# $tail - Tail of the command (remaining parameters). |
|
# $client - File descriptor connected to client. |
|
# Returns |
|
# 0 - Requested to exit, caller should shut down. |
|
# 1 - Continue processing. |
|
# |
|
sub increment_user_value_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
|
|
my $userinput = "$cmd:$tail"; |
|
|
|
my ($udom,$uname,$namespace,$what) =split(/:/,$tail); |
|
if ($namespace ne 'roles') { |
|
chomp($what); |
|
my $hashref = &tie_user_hash($udom, $uname, |
|
$namespace, &GDBM_WRCREAT(), |
|
"P",$what); |
|
if ($hashref) { |
|
my @pairs=split(/\&/,$what); |
|
foreach my $pair (@pairs) { |
|
my ($key,$value)=split(/=/,$pair); |
|
# We could check that we have a number... |
|
if (! defined($value) || $value eq '') { |
|
$value = 1; |
|
} |
|
$hashref->{$key}+=$value; |
|
} |
|
if (untie(%$hashref)) { |
|
&Reply( $client, "ok\n", $userinput); |
|
} else { |
|
&Failure($client, "error: ".($!+0)." untie(GDBM) failed ". |
|
"while attempting inc\n", $userinput); |
|
} |
|
} else { |
|
&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
|
"while attempting inc\n", $userinput); |
|
} |
|
} else { |
|
&Failure($client, "refused\n", $userinput); |
|
} |
|
|
|
return 1; |
|
} |
|
®ister_handler("inc", \&increment_user_value_handler, 0, 1, 0); |
|
|
|
|
|
# |
|
# Put a new role for a user. Roles are LonCAPA's packaging of permissions. |
|
# Each 'role' a user has implies a set of permissions. Adding a new role |
|
# for a person grants the permissions packaged with that role |
|
# to that user when the role is selected. |
|
# |
|
# Parameters: |
|
# $cmd - The command string (rolesput). |
|
# $tail - The remainder of the request line. For rolesput this |
|
# consists of a colon separated list that contains: |
|
# The domain and user that is granting the role (logged). |
|
# The domain and user that is getting the role. |
|
# The roles being granted as a set of & separated pairs. |
|
# each pair a key value pair. |
|
# $client - File descriptor connected to the client. |
|
# Returns: |
|
# 0 - If the daemon should exit |
|
# 1 - To continue processing. |
|
# |
|
# |
|
sub roles_put_handler { |
|
my ($cmd, $tail, $client) = @_; |
|
|
|
my $userinput = "$cmd:$tail"; |
|
|
|
my ( $exedom, $exeuser, $udom, $uname, $what) = split(/:/,$tail); |
|
|
|
|
|
my $namespace='roles'; |
|
chomp($what); |
|
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
|
&GDBM_WRCREAT(), "P", |
|
"$exedom:$exeuser:$what"); |
|
# |
|
# Log the attempt to set a role. The {}'s here ensure that the file |
|
# handle is open for the minimal amount of time. Since the flush |
|
# is done on close this improves the chances the log will be an un- |
|
# corrupted ordered thing. |
|
if ($hashref) { |
|
my @pairs=split(/\&/,$what); |
|
foreach my $pair (@pairs) { |
|
my ($key,$value)=split(/=/,$pair); |
|
&manage_permissions($key, $udom, $uname, |
|
&get_auth_type( $udom, $uname)); |
|
$hashref->{$key}=$value; |
|
} |
|
if (untie($hashref)) { |
|
&Reply($client, "ok\n", $userinput); |
|
} else { |
|
&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". |
|
"while attempting rolesput\n", $userinput); |
|
} |
|
} else { |
|
&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". |
|
"while attempting rolesput\n", $userinput); |
|
} |
|
return 1; |
|
} |
|
®ister_handler("rolesput", \&roles_put_handler, 1,1,0); # Encoded client only. |
|
|
|
# |
#--------------------------------------------------------------- |
#--------------------------------------------------------------- |
# |
# |
# Getting, decoding and dispatching requests: |
# Getting, decoding and dispatching requests: |
Line 1953 sub process_request {
|
Line 2261 sub process_request {
|
#------------------- Commands not yet in spearate handlers. -------------- |
#------------------- Commands not yet in spearate handlers. -------------- |
|
|
|
|
|
|
# ------------------------------------------ authenticate access to a user file |
|
|
|
if ($userinput =~ /^tokenauthuserfile/) { # Client only |
|
if(isClient) { |
|
my ($cmd,$fname,$session)=split(/:/,$userinput); |
|
chomp($session); |
|
my $reply='non_auth'; |
|
if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'. |
|
$session.'.id')) { |
|
while (my $line=<ENVIN>) { |
|
if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply='ok'; } |
|
} |
|
close(ENVIN); |
|
print $client $reply."\n"; |
|
} else { |
|
print $client "invalid_token\n"; |
|
} |
|
} else { |
|
Reply($client, "refused\n", $userinput); |
|
|
|
} |
|
# ----------------------------------------------------------------- unsubscribe |
|
} elsif ($userinput =~ /^unsub/) { |
|
if(isClient) { |
|
my ($cmd,$fname)=split(/:/,$userinput); |
|
if (-e $fname) { |
|
print $client &unsub($fname,$clientip); |
|
} else { |
|
print $client "not_found\n"; |
|
} |
|
} else { |
|
Reply($client, "refused\n", $userinput); |
|
|
|
} |
|
# ------------------------------------------------------------------- subscribe |
|
} elsif ($userinput =~ /^sub/) { |
|
if(isClient) { |
|
print $client &subscribe($userinput,$clientip); |
|
} else { |
|
Reply($client, "refused\n", $userinput); |
|
|
|
} |
|
# ------------------------------------------------------------- current version |
|
} elsif ($userinput =~ /^currentversion/) { |
|
if(isClient) { |
|
my ($cmd,$fname)=split(/:/,$userinput); |
|
print $client ¤tversion($fname)."\n"; |
|
} else { |
|
Reply($client, "refused\n", $userinput); |
|
|
|
} |
|
# ------------------------------------------------------------------------- log |
|
} elsif ($userinput =~ /^log/) { |
|
if(isClient) { |
|
my ($cmd,$udom,$uname,$what)=split(/:/,$userinput); |
|
chomp($what); |
|
my $proname=propath($udom,$uname); |
|
my $now=time; |
|
{ |
|
my $hfh; |
|
if ($hfh=IO::File->new(">>$proname/activity.log")) { |
|
print $hfh "$now:$clientname:$what\n"; |
|
print $client "ok\n"; |
|
} else { |
|
print $client "error: ".($!+0) |
|
." IO::File->new Failed " |
|
."while attempting log\n"; |
|
} |
|
} |
|
} else { |
|
Reply($client, "refused\n", $userinput); |
|
|
|
} |
|
# ------------------------------------------------------------------------- put |
|
} elsif ($userinput =~ /^put/) { |
|
if(isClient) { |
|
my ($cmd,$udom,$uname,$namespace,$what) |
|
=split(/:/,$userinput,5); |
|
$namespace=~s/\//\_/g; |
|
$namespace=~s/\W//g; |
|
if ($namespace ne 'roles') { |
|
chomp($what); |
|
my $proname=propath($udom,$uname); |
|
my $now=time; |
|
my @pairs=split(/\&/,$what); |
|
my %hash; |
|
if (tie(%hash,'GDBM_File', |
|
"$proname/$namespace.db", |
|
&GDBM_WRCREAT(),0640)) { |
|
unless ($namespace=~/^nohist\_/) { |
|
my $hfh; |
|
if ($hfh=IO::File->new(">>$proname/$namespace.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 put\n"; |
|
} |
|
} else { |
|
print $client "error: ".($!) |
|
." tie(GDBM) Failed ". |
|
"while attempting put\n"; |
|
} |
|
} else { |
|
print $client "refused\n"; |
|
} |
|
} else { |
|
Reply($client, "refused\n", $userinput); |
|
|
|
} |
|
# ------------------------------------------------------------------- inc |
|
} elsif ($userinput =~ /^inc:/) { |
|
if(isClient) { |
|
my ($cmd,$udom,$uname,$namespace,$what) |
|
=split(/:/,$userinput); |
|
$namespace=~s/\//\_/g; |
|
$namespace=~s/\W//g; |
|
if ($namespace ne 'roles') { |
|
chomp($what); |
|
my $proname=propath($udom,$uname); |
|
my $now=time; |
|
my @pairs=split(/\&/,$what); |
|
my %hash; |
|
if (tie(%hash,'GDBM_File', |
|
"$proname/$namespace.db", |
|
&GDBM_WRCREAT(),0640)) { |
|
unless ($namespace=~/^nohist\_/) { |
|
my $hfh; |
|
if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { print $hfh "P:$now:$what\n"; } |
|
} |
|
foreach my $pair (@pairs) { |
|
my ($key,$value)=split(/=/,$pair); |
|
# We could check that we have a number... |
|
if (! defined($value) || $value eq '') { |
|
$value = 1; |
|
} |
|
$hash{$key}+=$value; |
|
} |
|
if (untie(%hash)) { |
|
print $client "ok\n"; |
|
} else { |
|
print $client "error: ".($!+0) |
|
." untie(GDBM) failed ". |
|
"while attempting inc\n"; |
|
} |
|
} else { |
|
print $client "error: ".($!) |
|
." tie(GDBM) Failed ". |
|
"while attempting inc\n"; |
|
} |
|
} else { |
|
print $client "refused\n"; |
|
} |
|
} else { |
|
Reply($client, "refused\n", $userinput); |
|
|
|
} |
|
# -------------------------------------------------------------------- rolesput |
|
} elsif ($userinput =~ /^rolesput/) { |
|
if(isClient) { |
|
&Debug("rolesput"); |
|
if ($wasenc==1) { |
|
my ($cmd,$exedom,$exeuser,$udom,$uname,$what) |
|
=split(/:/,$userinput); |
|
&Debug("cmd = ".$cmd." exedom= ".$exedom. |
|
"user = ".$exeuser." udom=".$udom. |
|
"what = ".$what); |
|
my $namespace='roles'; |
|
chomp($what); |
|
my $proname=propath($udom,$uname); |
|
my $now=time; |
|
my @pairs=split(/\&/,$what); |
|
my %hash; |
|
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { |
|
{ |
|
my $hfh; |
|
if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { |
|
print $hfh "P:$now:$exedom:$exeuser:$what\n"; |
|
} |
|
} |
|
|
|
foreach my $pair (@pairs) { |
|
my ($key,$value)=split(/=/,$pair); |
|
&ManagePermissions($key, $udom, $uname, |
|
&get_auth_type( $udom, |
|
$uname)); |
|
$hash{$key}=$value; |
|
} |
|
if (untie(%hash)) { |
|
print $client "ok\n"; |
|
} else { |
|
print $client "error: ".($!+0) |
|
." untie(GDBM) Failed ". |
|
"while attempting rolesput\n"; |
|
} |
|
} else { |
|
print $client "error: ".($!+0) |
|
." tie(GDBM) Failed ". |
|
"while attempting rolesput\n"; |
|
} |
|
} else { |
|
print $client "refused\n"; |
|
} |
|
} else { |
|
Reply($client, "refused\n", $userinput); |
|
|
|
} |
|
# -------------------------------------------------------------------- rolesdel |
# -------------------------------------------------------------------- rolesdel |
} elsif ($userinput =~ /^rolesdel/) { |
if ($userinput =~ /^rolesdel/) { |
if(isClient) { |
if(isClient) { |
&Debug("rolesdel"); |
&Debug("rolesdel"); |
if ($wasenc==1) { |
if ($wasenc==1) { |
Line 3922 sub make_new_child {
|
Line 4015 sub make_new_child {
|
# user - Name of the user for which the role is being put. |
# user - Name of the user for which the role is being put. |
# authtype - The authentication type associated with the user. |
# authtype - The authentication type associated with the user. |
# |
# |
sub ManagePermissions |
sub manage_permissions |
{ |
{ |
|
|
my ($request, $domain, $user, $authtype) = @_; |
my ($request, $domain, $user, $authtype) = @_; |
Line 4763 Place in B<logs/lond.log>
|
Line 4856 Place in B<logs/lond.log>
|
|
|
stores hash in namespace |
stores hash in namespace |
|
|
=item rolesput |
=item rolesputy |
|
|
put a role into a user's environment |
put a role into a user's environment |
|
|