[LON-CAPA-cvs] cvs: loncom(Refactoring) / lond
foxr
lon-capa-cvs@mail.lon-capa.org
Mon, 22 Mar 2004 09:16:26 -0000
This is a MIME encoded message
--foxr1079946986
Content-Type: text/plain
foxr Mon Mar 22 04:16:26 2004 EDT
Modified files: (Branch: Refactoring)
/loncom lond
Log:
Remove some syntax errors
--foxr1079946986
Content-Type: text/plain
Content-Disposition: attachment; filename="foxr-20040322041626.txt"
Index: loncom/lond
diff -u loncom/lond:1.178.2.9 loncom/lond:1.178.2.10
--- loncom/lond:1.178.2.9 Mon Mar 22 04:05:11 2004
+++ loncom/lond Mon Mar 22 04:16:26 2004
@@ -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 $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 @@
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 @@
# 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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
$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 @@
# $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 @@
my $userinput = "$cmd:$tail";
+ my ($udom, $what) = split(/:/, $tail);
chomp($what);
my $now=time;
my @pairs=split(/\&/,$what);
@@ -2432,9 +2434,9 @@
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 @@
Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
"while attempting idget\n",$userinput);
}
-
+
return 1;
}
@@ -2523,7 +2525,7 @@
my $id = shift;
my $client = shift;
my $userinput = "$cmd:$id";
-
+
chomp($id);
$id=~s/\W/\_/g;
my $store;
@@ -2558,9 +2560,9 @@
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 @@
Failure( $client, "error: ".($!+0)."Unlink tmp Failed ".
"while attempting tmpdel\n", $userinput);
}
-
+
return 1;
}
--foxr1079946986--