[LON-CAPA-cvs] cvs: loncom / lond /lonnet/perl lonnet.pm

raeburn lon-capa-cvs@mail.lon-capa.org
Tue, 21 Nov 2006 20:58:11 -0000


raeburn		Tue Nov 21 15:58:11 2006 EDT

  Modified files:              
    /loncom	lond 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  Put and get data in specified db files at the domain level of the primary domain server (e.g., domain configuration settings in configuration.db).
  
  This is the same location as used currently for ids.db, nohist_courseids.db, and nohist_domainroles.db and nohist_dcmail.db.
  
  
Index: loncom/lond
diff -u loncom/lond:1.347 loncom/lond:1.348
--- loncom/lond:1.347	Thu Nov  9 21:01:55 2006
+++ loncom/lond	Tue Nov 21 15:58:06 2006
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.347 2006/11/10 02:01:55 raeburn Exp $
+# $Id: lond,v 1.348 2006/11/21 20:58:06 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -60,7 +60,7 @@
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.347 $'; #' stupid emacs
+my $VERSION='$Revision: 1.348 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -3510,6 +3510,99 @@
 &register_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0);
 
 #
+# Puts an unencrypted entry in a namespace db file at the domain level 
+#
+# 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.
+#  Side effects:
+#     reply is written to $client.
+#
+sub put_domain_handler {
+    my ($cmd,$tail,$client) = @_;
+
+    my $userinput = "$cmd:$tail";
+
+    my ($udom,$namespace,$what) =split(/:/,$tail,3);
+    chomp($what);
+    my @pairs=split(/\&/,$what);
+    my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_WRCREAT(),
+                                   "P", $what);
+    if ($hashref) {
+        foreach my $pair (@pairs) {
+            my ($key,$value)=split(/=/,$pair);
+            $hashref->{$key}=$value;
+        }
+        if (&untie_domain_hash($hashref)) {
+            &Reply($client, "ok\n", $userinput);
+        } else {
+            &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+                     "while attempting putdom\n", $userinput);
+        }
+    } else {
+        &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+                  "while attempting putdom\n", $userinput);
+    }
+
+    return 1;
+}
+&register_handler("putdom", \&put_domain_handler, 0, 1, 0);
+
+# Unencrypted get from the namespace database file at the domain level.
+# This function retrieves a keyed item from a specific named database in the
+# domain directory.
+#
+# Parameters:
+#   $cmd             - Command request keyword (get).
+#   $tail            - Tail of the command.  This is a colon separated list
+#                      consisting of the domain and the 'namespace' 
+#                      which selects the gdbm file to do the lookup in,
+#                      & separated list of keys to lookup.  Note that
+#                      the values are returned as an & separated list too.
+#   $client          - File descriptor open on the client.
+# Returns:
+#   1       - Continue processing.
+#   0       - Exit.
+#  Side effects:
+#     reply is written to $client.
+#
+
+sub get_domain_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput = "$client:$tail";
+
+    my ($udom,$namespace,$what)=split(/:/,$tail,3);
+    chomp($what);
+    my @queries=split(/\&/,$what);
+    my $qresult='';
+    my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER());
+    if ($hashref) {
+        for (my $i=0;$i<=$#queries;$i++) {
+            $qresult.="$hashref->{$queries[$i]}&";
+        }
+        if (&untie_domain_hash($hashref)) {
+            $qresult=~s/\&$//;
+            &Reply($client, "$qresult\n", $userinput);
+        } else {
+            &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
+                      "while attempting getdom\n",$userinput);
+        }
+    } else {
+        &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+                 "while attempting getdom\n",$userinput);
+    }
+
+    return 1;
+}
+&register_handler("getdom", \&get_id_handler, 0, 1, 0);
+
+
+#
 #  Puts an id to a domains id database. 
 #
 #  Parameters:
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.805 loncom/lonnet/perl/lonnet.pm:1.806
--- loncom/lonnet/perl/lonnet.pm:1.805	Mon Nov 20 18:50:51 2006
+++ loncom/lonnet/perl/lonnet.pm	Tue Nov 21 15:58:06 2006
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.805 2006/11/20 23:50:51 raeburn Exp $
+# $Id: lonnet.pm,v 1.806 2006/11/21 20:58:06 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -694,6 +694,53 @@
     }
 }
 
+# ------------------------------------------- get items from domain db files   
+
+sub get_dom {
+    my ($namespace,$storearr,$udom)=@_;
+    my $items='';
+    foreach my $item (@$storearr) {
+        $items.=&escape($item).'&';
+    }
+    $items=~s/\&$//;
+    if (!$udom) { $udom=$env{'user.domain'}; }
+    if (exists($domain_primary{$udom})) {
+        my $uhome=$domain_primary{$udom};
+        my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
+        my @pairs=split(/\&/,$rep);
+        if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) {
+            return @pairs;
+        }
+        my %returnhash=();
+        my $i=0;
+        foreach my $item (@$storearr) {
+            $returnhash{$item}=&thaw_unescape($pairs[$i]);
+            $i++;
+        }
+        return %returnhash;
+    } else {
+        &logthis("get_dom failed - no primary domain server for $udom");
+    }
+}
+
+# -------------------------------------------- put items in domain db files 
+
+sub put_dom {
+    my ($namespace,$storehash,$udom)=@_;
+    if (!$udom) { $udom=$env{'user.domain'}; }
+    if (exists($domain_primary{$udom})) {
+        my $uhome=$domain_primary{$udom};
+        my $items='';
+        foreach my $item (keys(%$storehash)) {
+            $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
+        }
+        $items=~s/\&$//;
+        return &reply("putdom:$udom:$namespace:$items",$uhome);
+    } else {
+        &logthis("put_dom failed - no primary domain server for $udom");
+    }
+}
+
 # --------------------------------------------------- Assign a key to a student
 
 sub assign_access_key {
@@ -8110,6 +8157,15 @@
 log($udom,$name,$home,$message) : write to permanent log for user; use
 critical subroutine
 
+=item *
+
+get_dom($namespace,$storearr,$udomain) : returns hash with keys from array
+reference filled in from namespace found in domain level on primary domain server ($udomain is optional)
+
+=item *
+
+put_dom($namespace,$storehash,$udomain) :  stores hash in namespace at domain level on primary domain server ($udomain is optional)
+
 =back
 
 =head2 Network Status Functions