[LON-CAPA-cvs] cvs: loncom / lond

foxr lon-capa-cvs@mail.lon-capa.org
Tue, 24 Aug 2004 10:40:08 -0000


foxr		Tue Aug 24 06:40:08 2004 EDT

  Modified files:              
    /loncom	lond 
  Log:
  Handlerized idput, idget, tmpput, tmpget.
  
  
Index: loncom/lond
diff -u loncom/lond:1.237 loncom/lond:1.238
--- loncom/lond:1.237	Tue Aug 24 03:26:04 2004
+++ loncom/lond	Tue Aug 24 06:40:08 2004
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.237 2004/08/24 07:26:04 albertel Exp $
+# $Id: lond,v 1.238 2004/08/24 10:40:08 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -52,12 +52,12 @@
 use LONCAPA::lonssl;
 use Fcntl qw(:flock);
 
-my $DEBUG = 0;		       # Non zero to enable debug log entries.
+my $DEBUG = 1;		       # Non zero to enable debug log entries.
 
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.237 $'; #' stupid emacs
+my $VERSION='$Revision: 1.238 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -1284,6 +1284,8 @@
 
 
 
+
+
 #   Process a reinit request.  Reinit requests that either
 #   lonc or lond be reinitialized so that an updated 
 #   host.tab or domain.tab can be processed.
@@ -3060,6 +3062,215 @@
     return 1;
 }
 &register_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0);
+
+#
+#  Puts an id to a domains id database. 
+#
+#  Parameters:
+#   $cmd     - The command that triggered us.
+#   $tail    - Remainder of the request other than the command. This is a 
+#              colon separated list containing:
+#              $domain  - The domain for which we are writing the id.
+#              $pairs  - The id info to write... this is and & separated list
+#                        of keyword=value.
+#   $client  - Socket open on the client.
+#  Returns:
+#    1   - Continue processing.
+#  Side effects:
+#     reply is written to $client.
+#
+sub put_id_handler {
+    my ($cmd,$tail,$client) = @_;
+
+
+    my $userinput = "$cmd:$tail";
+
+    my ($udom,$what)=split(/:/,$tail);
+    chomp($what);
+    my @pairs=split(/\&/,$what);
+    my $hashref = &tie_domain_hash($udom, "ids", &GDBM_WRCREAT(),
+				   "P", $what);
+    if ($hashref) {
+	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 idput\n", $userinput);
+	}
+    } else {
+	&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+		  "while attempting idput\n", $userinput);
+    }
+
+    return 1;
+}
+
+&register_handler("idput", \&put_id_handler, 0, 1, 0);
+#
+#  Retrieves a set of id values from the id database.
+#  Returns an & separated list of results, one for each requested id to the
+#  client.
+#
+# Parameters:
+#   $cmd       - Command keyword that caused us to be dispatched.
+#   $tail      - Tail of the command.  Consists of a colon separated:
+#               domain - the domain whose id table we dump
+#               ids      Consists of an & separated list of
+#                        id keywords whose values will be fetched.
+#                        nonexisting keywords will have an empty value.
+#   $client    - Socket open on the client.
+#
+# Returns:
+#    1 - indicating processing should continue.
+# Side effects:
+#   An & separated list of results is written to $client.
+#
+sub get_id_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    
+    my $userinput = "$client:$tail";
+    
+    my ($udom,$what)=split(/:/,$tail);
+    chomp($what);
+    my @queries=split(/\&/,$what);
+    my $qresult='';
+    my $hashref = &tie_domain_hash($udom, "ids", &GDBM_READER());
+    if ($hashref) {
+	for (my $i=0;$i<=$#queries;$i++) {
+	    $qresult.="$hashref->{$queries[$i]}&";
+	}
+	if (untie(%$hashref)) {
+	    $qresult=~s/\&$//;
+	    &Reply($client, "$qresult\n", $userinput);
+	} else {
+	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
+		      "while attempting idget\n",$userinput);
+	}
+    } else {
+	&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+		 "while attempting idget\n",$userinput);
+    }
+    
+    return 1;
+}
+
+register_handler("idget", \&get_id_handler, 0, 1, 0);
+
+#
+#  Process the tmpput command I'm not sure what this does.. Seems to
+#  create a file in the lonDaemons/tmp directory of the form $id.tmp
+# where Id is the client's ip concatenated with a sequence number.
+# The file will contain some value that is passed in.  Is this e.g.
+# a login token?
+#
+# Parameters:
+#    $cmd     - The command that got us dispatched.
+#    $tail    - The remainder of the request following $cmd:
+#               In this case this will be the contents of the file.
+#    $client  - Socket connected to the client.
+# Returns:
+#    1 indicating processing can continue.
+# Side effects:
+#   A file is created in the local filesystem.
+#   A reply is sent to the client.
+sub tmp_put_handler {
+    my ($cmd, $what, $client) = @_;
+
+    my $userinput = "$cmd:$what";	# Reconstruct for logging.
+
+
+    my $store;
+    $tmpsnum++;
+    my $id=$$.'_'.$clientip.'_'.$tmpsnum;
+    $id=~s/\W/\_/g;
+    $what=~s/\n//g;
+    my $execdir=$perlvar{'lonDaemons'};
+    if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {
+	print $store $what;
+	close $store;
+	&Reply($client, "$id\n", $userinput);
+    } else {
+	&Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
+		  "while attempting tmpput\n", $userinput);
+    }
+    return 1;
+  
+}
+&register_handler("tmpput", \&tmp_put_handler, 0, 1, 0);
+#   Processes the tmpget command.  This command returns the contents
+#  of a temporary resource file(?) created via tmpput.
+#
+# Paramters:
+#    $cmd      - Command that got us dispatched.
+#    $id       - Tail of the command, contain the id of the resource
+#                we want to fetch.
+#    $client   - socket open on the client.
+# Return:
+#    1         - Inidcating processing can continue.
+# Side effects:
+#   A reply is sent to the client.
+
+#
+sub tmp_get_handler {
+    my ($cmd, $id, $client) = @_;
+
+    my $userinput = "$cmd:$id"; 
+    
+
+    $id=~s/\W/\_/g;
+    my $store;
+    my $execdir=$perlvar{'lonDaemons'};
+    if ($store=IO::File->new("$execdir/tmp/$id.tmp")) {
+	my $reply=<$store>;
+	&Reply( $client, "$reply\n", $userinput);
+	close $store;
+    } else {
+	&Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
+		  "while attempting tmpget\n", $userinput);
+    }
+
+    return 1;
+}
+&register_handler("tmpget", \&tmp_get_handler, 0, 1, 0);
+#
+#  Process the tmpdel command.  This command deletes a temp resource
+#  created by the tmpput command.
+#
+# Parameters:
+#   $cmd      - Command that got us here.
+#   $id       - Id of the temporary resource created.
+#   $client   - socket open on the client process.
+#
+# Returns:
+#   1     - Indicating processing should continue.
+# Side Effects:
+#   A file is deleted
+#   A reply is sent to the client.
+sub tmp_del_handler {
+    my ($cmd, $id, $client) = @_;
+    
+    my $userinput= "$cmd:$id";
+    
+    chomp($id);
+    $id=~s/\W/\_/g;
+    my $execdir=$perlvar{'lonDaemons'};
+    if (unlink("$execdir/tmp/$id.tmp")) {
+	&Reply($client, "ok\n", $userinput);
+    } else {
+	&Failure( $client, "error: ".($!+0)."Unlink tmp Failed ".
+		  "while attempting tmpdel\n", $userinput);
+    }
+    
+    return 1;
+
+}
+&register_handler("tmpdel", \&tmp_del_handler, 0, 1, 0);
+#
 #
 #
 #