--- loncom/lond	2004/08/16 10:54:19	1.229
+++ loncom/lond	2004/08/16 11:44:10	1.230
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.229 2004/08/16 10:54:19 foxr Exp $
+# $Id: lond,v 1.230 2004/08/16 11:44:10 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -57,7 +57,7 @@ my $DEBUG = 0;		       # Non zero to ena
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.229 $'; #' stupid emacs
+my $VERSION='$Revision: 1.230 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -1902,7 +1902,251 @@ sub unsubscribe_handler {
     return 1;
 }
 &register_handler("unsub", \&unsubscribe_handler, 0, 1, 0);
+#   Subscribe to a resource
+#
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+#
+sub subscribe_handler {
+    my ($cmd, $tail, $client)= @_;
+
+    my $userinput  = "$cmd:$tail";
+
+    &Reply( $client, &subscribe($userinput,$clientip), $userinput);
+
+    return 1;
+}
+&register_handler("sub", \&subscribe_handler, 0, 1, 0);
+
+#
+#   Determine the version of a resource (?) Or is it return
+#   the top version of the resource?  Not yet clear from the
+#   code in currentversion.
+#
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+#
+sub current_version_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput= "$cmd:$tail";
+   
+    my $fname   = $tail;
+    &Reply( $client, &currentversion($fname)."\n", $userinput);
+    return 1;
+
+}
+&register_handler("currentversion", \&current_version_handler, 0, 1, 0);
+
+#  Make an entry in a user's activity log.
+#
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+#
+sub activity_log_handler {
+    my ($cmd, $tail, $client) = @_;
+
+
+    my $userinput= "$cmd:$tail";
+
+    my ($udom,$uname,$what)=split(/:/,$tail);
+    chomp($what);
+    my $proname=&propath($udom,$uname);
+    my $now=time;
+    my $hfh;
+    if ($hfh=IO::File->new(">>$proname/activity.log")) { 
+	print $hfh "$now:$clientname:$what\n";
+	&Reply( $client, "ok\n", $userinput); 
+    } else {
+	&Failure($client, "error: ".($!+0)." IO::File->new Failed "
+		 ."while attempting log\n", 
+		 $userinput);
+    }
+
+    return 1;
+}
+register_handler("log", \&activity_log_handler, 0, 1, 0);
+
+#
+#   Put a namespace entry in a user profile hash.
+#   My druthers would be for this to be an encrypted interaction too.
+#   anything that might be an inadvertent covert channel about either
+#   user authentication or user personal information....
+#
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+#
+sub put_user_profile_entry {
+    my ($cmd, $tail, $client)  = @_;
 
+    my $userinput = "$cmd:$tail";
+    
+    my ($udom,$uname,$namespace,$what) =split(/:/,$tail);
+    if ($namespace ne 'roles') {
+	chomp($what);
+	my $hashref = &tie_user_hash($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;
+}
+&register_handler("put", \&put_user_profile_entry, 0, 1, 0);
+
+# 
+#   Increment a profile entry in the user history file.
+#   The history contains keyword value pairs.  In this case,
+#   The value itself is a pair of numbers.  The first, the current value
+#   the second an increment that this function applies to the current
+#   value.
+#
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+#
+sub increment_user_value_handler {
+    my ($cmd, $tail, $client) = @_;
+    
+    my $userinput   = "$cmd:$tail";
+    
+    my ($udom,$uname,$namespace,$what) =split(/:/,$tail);
+    if ($namespace ne 'roles') {
+        chomp($what);
+	my $hashref = &tie_user_hash($udom, $uname,
+				     $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);
+    }
+    
+    return 1;
+}
+&register_handler("inc", \&increment_user_value_handler, 0, 1, 0);
+
+
+#
+#   Put a new role for a user.  Roles are LonCAPA's packaging of permissions.
+#   Each 'role' a user has implies a set of permissions.  Adding a new role
+#   for a person grants the permissions packaged with that role
+#   to that user when the role is selected.
+#
+# Parameters:
+#    $cmd       - The command string (rolesput).
+#    $tail      - The remainder of the request line.  For rolesput this
+#                 consists of a colon separated list that contains:
+#                 The domain and user that is granting the role (logged).
+#                 The domain and user that is getting the role.
+#                 The roles being granted as a set of & separated pairs.
+#                 each pair a key value pair.
+#    $client    - File descriptor connected to the client.
+# Returns:
+#     0         - If the daemon should exit
+#     1         - To continue processing.
+#
+#
+sub roles_put_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput  = "$cmd:$tail";
+
+    my ( $exedom, $exeuser, $udom, $uname,  $what) = split(/:/,$tail);
+    
+
+    my $namespace='roles';
+    chomp($what);
+    my $hashref = &tie_user_hash($udom, $uname, $namespace,
+				 &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
+    #  is done on close this improves the chances the log will be an un-
+    #  corrupted ordered thing.
+    if ($hashref) {
+	my @pairs=split(/\&/,$what);
+	foreach my $pair (@pairs) {
+	    my ($key,$value)=split(/=/,$pair);
+	    &manage_permissions($key, $udom, $uname,
+			       &get_auth_type( $udom, $uname));
+	    $hashref->{$key}=$value;
+	}
+	if (untie($hashref)) {
+	    &Reply($client, "ok\n", $userinput);
+	} else {
+	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
+		     "while attempting rolesput\n", $userinput);
+	}
+    } else {
+	&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+		 "while attempting rolesput\n", $userinput);
+    }
+    return 1;
+}
+&register_handler("rolesput", \&roles_put_handler, 1,1,0);  # Encoded client only.
+
+#
 #---------------------------------------------------------------
 #
 #   Getting, decoding and dispatching requests:
@@ -2017,190 +2261,8 @@ sub process_request {
 #------------------- Commands not yet in spearate handlers. --------------
 
 
-
-
-# ------------------------------------------------------------------- subscribe
-   if ($userinput =~ /^sub/) {
-	if(isClient) {
-	    print $client &subscribe($userinput,$clientip);
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ------------------------------------------------------------- current version
-    } elsif ($userinput =~ /^currentversion/) {
-	if(isClient) {
-	    my ($cmd,$fname)=split(/:/,$userinput);
-	    print $client &currentversion($fname)."\n";
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ------------------------------------------------------------------------- log
-    } elsif ($userinput =~ /^log/) {
-	if(isClient) {
-	    my ($cmd,$udom,$uname,$what)=split(/:/,$userinput);
-	    chomp($what);
-	    my $proname=propath($udom,$uname);
-	    my $now=time;
-	    {
-		my $hfh;
-		if ($hfh=IO::File->new(">>$proname/activity.log")) { 
-		    print $hfh "$now:$clientname:$what\n";
-		    print $client "ok\n"; 
-		} else {
-		    print $client "error: ".($!+0)
-			." IO::File->new Failed "
-			."while attempting log\n";
-		}
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ------------------------------------------------------------------------- put
-    } elsif ($userinput =~ /^put/) {
-	if(isClient) {
-	    my ($cmd,$udom,$uname,$namespace,$what)
-		=split(/:/,$userinput,5);
-	    $namespace=~s/\//\_/g;
-	    $namespace=~s/\W//g;
-	    if ($namespace ne 'roles') {
-		chomp($what);
-		my $proname=propath($udom,$uname);
-		my $now=time;
-		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;
-		    }
-		    if (untie(%hash)) {
-			print $client "ok\n";
-		    } else {
-			print $client "error: ".($!+0)
-			    ." untie(GDBM) failed ".
-			    "while attempting put\n";
-		    }
-		} else {
-		    print $client "error: ".($!)
-			." tie(GDBM) Failed ".
-			"while attempting put\n";
-		}
-	    } else {
-		print $client "refused\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ------------------------------------------------------------------- inc
-    } elsif ($userinput =~ /^inc:/) {
-	if(isClient) {
-	    my ($cmd,$udom,$uname,$namespace,$what)
-		=split(/:/,$userinput);
-	    $namespace=~s/\//\_/g;
-	    $namespace=~s/\W//g;
-	    if ($namespace ne 'roles') {
-		chomp($what);
-		my $proname=propath($udom,$uname);
-		my $now=time;
-		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...
-			if (! defined($value) || $value eq '') {
-			    $value = 1;
-			}
-			$hash{$key}+=$value;
-		    }
-		    if (untie(%hash)) {
-			print $client "ok\n";
-		    } else {
-			print $client "error: ".($!+0)
-			    ." untie(GDBM) failed ".
-			    "while attempting inc\n";
-		    }
-		} else {
-		    print $client "error: ".($!)
-			." tie(GDBM) Failed ".
-			"while attempting inc\n";
-		}
-	    } else {
-		print $client "refused\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# -------------------------------------------------------------------- rolesput
-    } elsif ($userinput =~ /^rolesput/) {
-	if(isClient) {
-	    &Debug("rolesput");
-	    if ($wasenc==1) {
-		my ($cmd,$exedom,$exeuser,$udom,$uname,$what)
-		    =split(/:/,$userinput);
-		&Debug("cmd = ".$cmd." exedom= ".$exedom.
-		       "user = ".$exeuser." udom=".$udom.
-		       "what = ".$what);
-		my $namespace='roles';
-		chomp($what);
-		my $proname=propath($udom,$uname);
-		my $now=time;
-		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,
-					   &get_auth_type( $udom, 
-							 $uname));
-			$hash{$key}=$value;
-		    }
-		    if (untie(%hash)) {
-			print $client "ok\n";
-		    } else {
-			print $client "error: ".($!+0)
-			    ." untie(GDBM) Failed ".
-			    "while attempting rolesput\n";
-		    }
-		} else {
-		    print $client "error: ".($!+0)
-			." tie(GDBM) Failed ".
-			"while attempting rolesput\n";
-			    }
-	    } else {
-		print $client "refused\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
 # -------------------------------------------------------------------- rolesdel
-    } elsif ($userinput =~ /^rolesdel/) {
+    if ($userinput =~ /^rolesdel/) {
 	if(isClient) {
 	    &Debug("rolesdel");
 	    if ($wasenc==1) {
@@ -3953,7 +4015,7 @@ sub make_new_child {
 #    user      - Name of the user for which the role is being put.
 #    authtype  - The authentication type associated with the user.
 #
-sub ManagePermissions
+sub manage_permissions
 {
 
     my ($request, $domain, $user, $authtype) = @_;
@@ -4794,7 +4856,7 @@ Place in B<logs/lond.log>
 
 stores hash in namespace
 
-=item rolesput
+=item rolesputy
 
 put a role into a user's environment
 
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>500 Internal Server Error</title>
</head><body>
<h1>Internal Server Error</h1>
<p>The server encountered an internal error or
misconfiguration and was unable to complete
your request.</p>
<p>Please contact the server administrator at 
 root@localhost to inform them of the time this error occurred,
 and the actions you performed just before this error.</p>
<p>More information about this error may be available
in the server error log.</p>
</body></html>