--- loncom/lond 2004/03/22 09:05:11 1.178.2.9 +++ loncom/lond 2004/03/22 09:16:26 1.178.2.10 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.178.2.9 2004/03/22 09:05:11 foxr Exp $ +# $Id: lond,v 1.178.2.10 2004/03/22 09:16:26 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -53,7 +53,7 @@ my $DEBUG = 1; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.178.2.9 $'; #' stupid emacs +my $VERSION='$Revision: 1.178.2.10 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -182,24 +182,24 @@ sub TieDomainHash { my $domain = shift; my $namespace = shift; my $how = shift; - + # Filter out any whitespace in the domain name: - + $domain =~ s/\W//g; - + # We have enough to go on to tie the hash: - - my $UserTopDir = $perlvar('lonUsersDir'); + + my $UserTopDir = $perlvar{'lonUsersDir'}; my $DomainDir = $UserTopDir."/$domain"; my $ResourceFile = $DomainDir."/$namespace.db"; my %hash; if(tie(%hash, 'GDBM_File', $ResourceFile, $how, 0640)) { if (scalar @_) { # Need to log the operation. my $logFh = IO::File->new(">>$DomainDir/$namespace.hist"); - if($logFH) { + if($logFh) { my $TimeStamp = time; my ($loghead, $logtail) = @_; - print $logFH "$loghead:$TimeStamp:$logtail\n"; + print $logFh "$loghead:$TimeStamp:$logtail\n"; } } return \%hash; # Return the tied hash. @@ -229,39 +229,39 @@ sub TieDomainHash { # undef if the has could not be tied. # sub TieUserHash { - my $domain = shift; - my $user = shift; - my $namespace = shift; - my $how = shift; - - $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: - - - unless ($namespace =~/^nohist\_/ && (scalar @_ > 0)) { - 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)) { - return \%hash; - } - else { - return undef; - } - + my $domain = shift; + my $user = shift; + my $namespace = shift; + my $how = shift; + + $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: + + + unless ($namespace =~/^nohist\_/ && (scalar @_ > 0)) { + 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)) { + return \%hash; + } + else { + return undef; + } + } # @@ -725,15 +725,15 @@ sub AuthenticateHandler { my $cmd = shift; my $tail = shift; my $client = shift; - + # Regenerate the full input line - + my $userinput = $cmd.":".$tail; - + # udom - User's domain. # uname - Username. # upass - User's password. - + my ($udom,$uname,$upass)=split(/:/,$tail); Debug(" Authenticate domain = $udom, user = $uname, password = $upass"); chomp($upass); @@ -1409,34 +1409,34 @@ sub PutUserProfileEntry { my $tail = shift; my $client = shift; my $userinput = "$cmd:$tail"; - + my ($udom,$uname,$namespace,$what) =split(/:/,$tail); if ($namespace ne 'roles') { - chomp($what); - my $hashref = TieUserHash($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 { + chomp($what); + my $hashref = TieUserHash($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; + return 1; } RegisterHandler("put", \&PutUserProfileEntry, 0, 1, 0); @@ -1465,31 +1465,31 @@ sub IncrementUserValueHandler { if ($namespace ne 'roles') { chomp($what); my $hashref = TieUserHash($udom, $uname, - $namespace, &GDBM_WRCREAT(), - "P",$what); + $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); - } + 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; } @@ -1526,8 +1526,8 @@ sub RolesPutHandler { my $namespace='roles'; chomp($what); my $hashref = TieUserHash($udom, $uname, $namespace, - &GDBM_WRCREAT(), "P", - "$exedom:$exeuser:$what"); + &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 @@ -1583,25 +1583,25 @@ sub RolesDeleteHandler { my $namespace='roles'; chomp($what); my $hashref = TieUserHash($udom, $uname, $namespace, - &GDBM_WRCREAT(), "D", - "$exedom:$exeuser:$what"); - + &GDBM_WRCREAT(), "D", + "$exedom:$exeuser:$what"); + if ($hashref) { - my @rolekeys=split(/\&/,$what); - - foreach my $key (@rolekeys) { - delete $hashref->{$key}; - } - if (untie(%$hashref)) { - Reply($client, "ok\n", $userinput); + my @rolekeys=split(/\&/,$what); + + foreach my $key (@rolekeys) { + delete $hashref->{$key}; + } + if (untie(%$hashref)) { + Reply($client, "ok\n", $userinput); } else { - Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". - "while attempting rolesdel\n", $userinput); + Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". + "while attempting rolesdel\n", $userinput); } - } else { + } else { Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". "while attempting rolesdel\n", $userinput); - } + } return 1; } @@ -1635,11 +1635,11 @@ sub GetProfileEntry { my ($udom,$uname,$namespace,$what) = split(/:/,$tail); chomp($what); my $hashref = TieUserHash($udom, $uname, $namespace, - &GDBM_READER()); + &GDBM_READER()); if ($hashref) { my @queries=split(/\&/,$what); my $qresult=''; - + for (my $i=0;$i<=$#queries;$i++) { $qresult.="$hashref->{$queries[$i]}&"; # Presumably failure gives empty string. } @@ -1704,9 +1704,10 @@ sub GetProfileEntryEncrypted { $qresult.=" "; my $encqresult=''; for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) { - $encqresult.= unpack("H16", $cipher->encrypt(substr($qresult, - $encidx, - 8))); + $encqresult.= unpack("H16", + $cipher->encrypt(substr($qresult, + $encidx, + 8))); } Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput); } else { @@ -1851,7 +1852,7 @@ sub DumpProfileDatabase { # $data{$symb}->{'v.'.$parameter}=$version; # since $parameter will be unescaped, we do not # have to worry about silly parameter names... - + my $qresult=''; my %data = (); # A hash of anonymous hashes.. while (my ($key,$value) = each(%$hashref)) { @@ -2263,6 +2264,7 @@ sub PutCourseIdHandler { my $userinput = "$cmd:$tail"; + my ($udom, $what) = split(/:/, $tail); chomp($what); my $now=time; my @pairs=split(/\&/,$what); @@ -2432,9 +2434,9 @@ sub GetIdHandler { my $cmd = shift; my $tail = shift; my $client = shift; - + my $userinput = "$client:$tail"; - + my ($udom,$what)=split(/:/,$tail); chomp($what); my @queries=split(/\&/,$what); @@ -2455,7 +2457,7 @@ sub GetIdHandler { Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". "while attempting idget\n",$userinput); } - + return 1; } @@ -2523,7 +2525,7 @@ sub TmpGetHandler { my $id = shift; my $client = shift; my $userinput = "$cmd:$id"; - + chomp($id); $id=~s/\W/\_/g; my $store; @@ -2558,9 +2560,9 @@ sub TmpDelHandler { my $cmd = shift; my $id = shift; my $client = shift; - + my $userinput= "$cmd:$id"; - + chomp($id); $id=~s/\W/\_/g; my $execdir=$perlvar{'lonDaemons'}; @@ -2570,7 +2572,7 @@ sub TmpDelHandler { Failure( $client, "error: ".($!+0)."Unlink tmp Failed ". "while attempting tmpdel\n", $userinput); } - + return 1; }