--- loncom/lond 2004/07/23 11:03:05 1.207 +++ loncom/lond 2004/07/23 16:14:19 1.211 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.207 2004/07/23 11:03:05 foxr Exp $ +# $Id: lond,v 1.211 2004/07/23 16:14:19 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -56,7 +56,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.207 $'; #' stupid emacs +my $VERSION='$Revision: 1.211 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -955,10 +955,8 @@ sub EditFile { # Reference to a hash bound to the db file or alternatively undef # if the tie failed. # -sub TieDomainHash { - my ($domain, - $namespace, - $how) = @_; +sub tie_domain_hash { + my ($domain,$namespace,$how,$loghead,$logtail) = @_; # Filter out any whitespace in the domain name: @@ -971,17 +969,16 @@ sub TieDomainHash { my $resource_file = $domain_dir."/$namespace.db"; my %hash; if(tie(%hash, 'GDBM_File', $resource_file, $how, 0640)) { - if (scalar @_) { # Need to log the operation. - my $logFh = IO::File->new(">>domain_dir/$namespace.hist"); + if (defined($loghead)) { # Need to log the operation. + my $logFh = IO::File->new(">>$domain_dir/$namespace.hist"); if($logFh) { my $timestamp = time; - my ($loghead, $logtail) = @_; print $logFh "$loghead:$timestamp:$logtail\n"; } + $logFh->close; } return \%hash; # Return the tied hash. - } - else { + } else { return undef; # Tie failed. } } @@ -1005,40 +1002,32 @@ sub TieDomainHash { # hash to which the database is tied. It's up to the caller to untie. # undef if the has could not be tied. # -sub TieUserHash { - my ($domain, - $user, - $namespace, - $how) = @_; +sub tie_user_hash { + my ($domain,$user,$namespace,$how,$loghead,$what) = @_; - $namespace=~s/\//\_/g; # / -> _ $namespace=~s/\W//g; # whitespace eliminated. 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. my %hash; if(tie(%hash, 'GDBM_File', "$proname/$namespace.db", $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; - } - else { + } else { return undef; } @@ -1054,7 +1043,7 @@ sub TieUserHash { # is defined as a 'line' of text. We remove the new line # from the text line. # -sub GetRequest { +sub get_request { my $input = <$client>; chomp($input); @@ -1073,7 +1062,7 @@ sub GetRequest { # Implicit input: # cipher - This global holds the negotiated encryption key. # -sub Decipher { +sub decipher { my ($input) = @_; my $output = ''; @@ -1117,7 +1106,7 @@ sub Decipher { # - On failure, the program will die as it's a bad internal bug to try to # register a duplicate command handler. # -sub RegisterHandler { +sub register_handler { my ($request_name, $procedure, $must_encode, @@ -2487,28 +2476,24 @@ sub make_new_child { # ------------------------------------------------------------------------- put } elsif ($userinput =~ /^put/) { if(isClient) { - my ($cmd,$udom,$uname,$namespace,$what,@extras) - =split(/:/,$userinput); + my ($cmd,$udom,$uname,$namespace,$what) + =split(/:/,$userinput,5); $namespace=~s/\//\_/g; $namespace=~s/\W//g; if ($namespace ne 'roles') { - if (@extras) { - $what .= ':'.join(':',@extras); - } chomp($what); my $proname=propath($udom,$uname); 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 %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; @@ -2543,17 +2528,15 @@ sub make_new_child { chomp($what); my $proname=propath($udom,$uname); 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 %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... @@ -2595,17 +2578,16 @@ sub make_new_child { chomp($what); my $proname=propath($udom,$uname); 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 %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, @@ -2646,17 +2628,15 @@ sub make_new_child { chomp($what); my $proname=propath($udom,$uname); 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 %hash; 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) { delete $hash{$key}; } @@ -2773,15 +2753,13 @@ sub make_new_child { chomp($what); my $proname=propath($udom,$uname); 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 %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 "D:$now:$what\n"; } + } foreach my $key (@keys) { delete($hash{$key}); } @@ -2936,15 +2914,15 @@ sub make_new_child { chomp($what); my $proname=propath($udom,$uname); 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 %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:$rid:$what\n"; + } + } my @previouskeys=split(/&/,$hash{"keys:$rid"}); my $key; $hash{"version:$rid"}++; @@ -3170,15 +3148,15 @@ sub make_new_child { $udom=~s/\W//g; my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; my $now=time; - { - my $hfh; - if ( - $hfh=IO::File->new(">>$proname.hist") - ) { print $hfh "P:$now:$what\n"; } - } my @pairs=split(/\&/,$what); my %hash; 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) { my ($key,$value)=split(/=/,$pair); $hash{$key}=$value;