version 1.207, 2004/07/23 11:03:05
|
version 1.211, 2004/07/23 16:14:19
|
Line 955 sub EditFile {
|
Line 955 sub EditFile {
|
# Reference to a hash bound to the db file or alternatively undef |
# Reference to a hash bound to the db file or alternatively undef |
# if the tie failed. |
# if the tie failed. |
# |
# |
sub TieDomainHash { |
sub tie_domain_hash { |
my ($domain, |
my ($domain,$namespace,$how,$loghead,$logtail) = @_; |
$namespace, |
|
$how) = @_; |
|
|
|
# Filter out any whitespace in the domain name: |
# Filter out any whitespace in the domain name: |
|
|
Line 971 sub TieDomainHash {
|
Line 969 sub TieDomainHash {
|
my $resource_file = $domain_dir."/$namespace.db"; |
my $resource_file = $domain_dir."/$namespace.db"; |
my %hash; |
my %hash; |
if(tie(%hash, 'GDBM_File', $resource_file, $how, 0640)) { |
if(tie(%hash, 'GDBM_File', $resource_file, $how, 0640)) { |
if (scalar @_) { # Need to log the operation. |
if (defined($loghead)) { # Need to log the operation. |
my $logFh = IO::File->new(">>domain_dir/$namespace.hist"); |
my $logFh = IO::File->new(">>$domain_dir/$namespace.hist"); |
if($logFh) { |
if($logFh) { |
my $timestamp = time; |
my $timestamp = time; |
my ($loghead, $logtail) = @_; |
|
print $logFh "$loghead:$timestamp:$logtail\n"; |
print $logFh "$loghead:$timestamp:$logtail\n"; |
} |
} |
|
$logFh->close; |
} |
} |
return \%hash; # Return the tied hash. |
return \%hash; # Return the tied hash. |
} |
} else { |
else { |
|
return undef; # Tie failed. |
return undef; # Tie failed. |
} |
} |
} |
} |
Line 1005 sub TieDomainHash {
|
Line 1002 sub TieDomainHash {
|
# hash to which the database is tied. It's up to the caller to untie. |
# hash to which the database is tied. It's up to the caller to untie. |
# undef if the has could not be tied. |
# undef if the has could not be tied. |
# |
# |
sub TieUserHash { |
sub tie_user_hash { |
my ($domain, |
my ($domain,$user,$namespace,$how,$loghead,$what) = @_; |
$user, |
|
$namespace, |
|
$how) = @_; |
|
|
|
|
|
$namespace=~s/\//\_/g; # / -> _ |
$namespace=~s/\//\_/g; # / -> _ |
$namespace=~s/\W//g; # whitespace eliminated. |
$namespace=~s/\W//g; # whitespace eliminated. |
my $proname = propath($domain, $user); |
my $proname = propath($domain, $user); |
|
|
# If this is a namespace for which a history is kept, |
|
# make the history log entry: |
|
|
|
|
|
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; |
|
my $loghead = shift; |
|
my $what = shift; |
|
print $hfh "$loghead:$now:$what\n"; |
|
} |
|
} |
|
# Tie the database. |
# Tie the database. |
|
|
my %hash; |
my %hash; |
if(tie(%hash, 'GDBM_File', "$proname/$namespace.db", |
if(tie(%hash, 'GDBM_File', "$proname/$namespace.db", |
$how, 0640)) { |
$how, 0640)) { |
|
# If this is a namespace for which a history is kept, |
|
# make the history log entry: |
|
if (($namespace =~/^nohist\_/) && (defined($loghead))) { |
|
my $args = scalar @_; |
|
Debug(" Opening history: $namespace $args"); |
|
my $hfh = IO::File->new(">>$proname/$namespace.hist"); |
|
if($hfh) { |
|
my $now = time; |
|
print $hfh "$loghead:$now:$what\n"; |
|
} |
|
$hfh->close; |
|
} |
return \%hash; |
return \%hash; |
} |
} else { |
else { |
|
return undef; |
return undef; |
} |
} |
|
|
Line 1054 sub TieUserHash {
|
Line 1043 sub TieUserHash {
|
# is defined as a 'line' of text. We remove the new line |
# is defined as a 'line' of text. We remove the new line |
# from the text line. |
# from the text line. |
# |
# |
sub GetRequest { |
sub get_request { |
my $input = <$client>; |
my $input = <$client>; |
chomp($input); |
chomp($input); |
|
|
Line 1073 sub GetRequest {
|
Line 1062 sub GetRequest {
|
# Implicit input: |
# Implicit input: |
# cipher - This global holds the negotiated encryption key. |
# cipher - This global holds the negotiated encryption key. |
# |
# |
sub Decipher { |
sub decipher { |
my ($input) = @_; |
my ($input) = @_; |
my $output = ''; |
my $output = ''; |
|
|
Line 1117 sub Decipher {
|
Line 1106 sub Decipher {
|
# - On failure, the program will die as it's a bad internal bug to try to |
# - On failure, the program will die as it's a bad internal bug to try to |
# register a duplicate command handler. |
# register a duplicate command handler. |
# |
# |
sub RegisterHandler { |
sub register_handler { |
my ($request_name, |
my ($request_name, |
$procedure, |
$procedure, |
$must_encode, |
$must_encode, |
Line 2487 sub make_new_child {
|
Line 2476 sub make_new_child {
|
# ------------------------------------------------------------------------- put |
# ------------------------------------------------------------------------- put |
} elsif ($userinput =~ /^put/) { |
} elsif ($userinput =~ /^put/) { |
if(isClient) { |
if(isClient) { |
my ($cmd,$udom,$uname,$namespace,$what,@extras) |
my ($cmd,$udom,$uname,$namespace,$what) |
=split(/:/,$userinput); |
=split(/:/,$userinput,5); |
$namespace=~s/\//\_/g; |
$namespace=~s/\//\_/g; |
$namespace=~s/\W//g; |
$namespace=~s/\W//g; |
if ($namespace ne 'roles') { |
if ($namespace ne 'roles') { |
if (@extras) { |
|
$what .= ':'.join(':',@extras); |
|
} |
|
chomp($what); |
chomp($what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $now=time; |
my $now=time; |
unless ($namespace=~/^nohist\_/) { |
|
my $hfh; |
|
if ( |
|
$hfh=IO::File->new(">>$proname/$namespace.hist") |
|
) { print $hfh "P:$now:$what\n"; } |
|
} |
|
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
my %hash; |
my %hash; |
if (tie(%hash,'GDBM_File', |
if (tie(%hash,'GDBM_File', |
"$proname/$namespace.db", |
"$proname/$namespace.db", |
&GDBM_WRCREAT(),0640)) { |
&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) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
$hash{$key}=$value; |
$hash{$key}=$value; |
Line 2543 sub make_new_child {
|
Line 2528 sub make_new_child {
|
chomp($what); |
chomp($what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $now=time; |
my $now=time; |
unless ($namespace=~/^nohist\_/) { |
|
my $hfh; |
|
if ( |
|
$hfh=IO::File->new(">>$proname/$namespace.hist") |
|
) { print $hfh "P:$now:$what\n"; } |
|
} |
|
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
my %hash; |
my %hash; |
if (tie(%hash,'GDBM_File', |
if (tie(%hash,'GDBM_File', |
"$proname/$namespace.db", |
"$proname/$namespace.db", |
&GDBM_WRCREAT(),0640)) { |
&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) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
# We could check that we have a number... |
# We could check that we have a number... |
Line 2595 sub make_new_child {
|
Line 2578 sub make_new_child {
|
chomp($what); |
chomp($what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $now=time; |
my $now=time; |
{ |
|
my $hfh; |
|
if ( |
|
$hfh=IO::File->new(">>$proname/$namespace.hist") |
|
) { |
|
print $hfh "P:$now:$exedom:$exeuser:$what\n"; |
|
} |
|
} |
|
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
my %hash; |
my %hash; |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { |
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) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
&ManagePermissions($key, $udom, $uname, |
&ManagePermissions($key, $udom, $uname, |
Line 2646 sub make_new_child {
|
Line 2628 sub make_new_child {
|
chomp($what); |
chomp($what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $now=time; |
my $now=time; |
{ |
|
my $hfh; |
|
if ( |
|
$hfh=IO::File->new(">>$proname/$namespace.hist") |
|
) { |
|
print $hfh "D:$now:$exedom:$exeuser:$what\n"; |
|
} |
|
} |
|
my @rolekeys=split(/\&/,$what); |
my @rolekeys=split(/\&/,$what); |
my %hash; |
my %hash; |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { |
|
{ |
|
my $hfh; |
|
if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { |
|
print $hfh "D:$now:$exedom:$exeuser:$what\n"; |
|
} |
|
} |
foreach my $key (@rolekeys) { |
foreach my $key (@rolekeys) { |
delete $hash{$key}; |
delete $hash{$key}; |
} |
} |
Line 2773 sub make_new_child {
|
Line 2753 sub make_new_child {
|
chomp($what); |
chomp($what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $now=time; |
my $now=time; |
unless ($namespace=~/^nohist\_/) { |
|
my $hfh; |
|
if ( |
|
$hfh=IO::File->new(">>$proname/$namespace.hist") |
|
) { print $hfh "D:$now:$what\n"; } |
|
} |
|
my @keys=split(/\&/,$what); |
my @keys=split(/\&/,$what); |
my %hash; |
my %hash; |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { |
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 "D:$now:$what\n"; } |
|
} |
foreach my $key (@keys) { |
foreach my $key (@keys) { |
delete($hash{$key}); |
delete($hash{$key}); |
} |
} |
Line 2936 sub make_new_child {
|
Line 2914 sub make_new_child {
|
chomp($what); |
chomp($what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $now=time; |
my $now=time; |
unless ($namespace=~/^nohist\_/) { |
|
my $hfh; |
|
if ( |
|
$hfh=IO::File->new(">>$proname/$namespace.hist") |
|
) { print $hfh "P:$now:$rid:$what\n"; } |
|
} |
|
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
my %hash; |
my %hash; |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { |
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:$rid:$what\n"; |
|
} |
|
} |
my @previouskeys=split(/&/,$hash{"keys:$rid"}); |
my @previouskeys=split(/&/,$hash{"keys:$rid"}); |
my $key; |
my $key; |
$hash{"version:$rid"}++; |
$hash{"version:$rid"}++; |
Line 3170 sub make_new_child {
|
Line 3148 sub make_new_child {
|
$udom=~s/\W//g; |
$udom=~s/\W//g; |
my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; |
my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; |
my $now=time; |
my $now=time; |
{ |
|
my $hfh; |
|
if ( |
|
$hfh=IO::File->new(">>$proname.hist") |
|
) { print $hfh "P:$now:$what\n"; } |
|
} |
|
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
my %hash; |
my %hash; |
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) { |
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) { |
|
{ |
|
my $hfh; |
|
if ($hfh=IO::File->new(">>$proname.hist")) { |
|
print $hfh "P:$now:$what\n"; |
|
} |
|
} |
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
$hash{$key}=$value; |
$hash{$key}=$value; |