version 1.209, 2004/07/23 14:10:47
|
version 1.211, 2004/07/23 16:14:19
|
Line 956 sub EditFile {
|
Line 956 sub EditFile {
|
# if the tie failed. |
# if the tie failed. |
# |
# |
sub tie_domain_hash { |
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 tie_domain_hash {
|
Line 969 sub tie_domain_hash {
|
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 tie_domain_hash {
|
Line 1002 sub tie_domain_hash {
|
# 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); |
Line 1023 sub TieUserHash {
|
Line 1016 sub TieUserHash {
|
$how, 0640)) { |
$how, 0640)) { |
# If this is a namespace for which a history is kept, |
# If this is a namespace for which a history is kept, |
# make the history log entry: |
# make the history log entry: |
if (($namespace =~/^nohist\_/) && (scalar @_ > 0)) { |
if (($namespace =~/^nohist\_/) && (defined($loghead))) { |
my $args = scalar @_; |
my $args = scalar @_; |
Debug(" Opening history: $namespace $args"); |
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; |
my $loghead = shift; |
|
my $what = shift; |
|
print $hfh "$loghead:$now:$what\n"; |
print $hfh "$loghead:$now:$what\n"; |
} |
} |
|
$hfh->close; |
} |
} |
return \%hash; |
return \%hash; |
} else { |
} else { |
Line 1051 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 1070 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 1114 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, |