[LON-CAPA-cvs] cvs: loncom / lond /interface loncoursequeueadmin.pm /lonnet/perl lonnet.pm
raeburn
raeburn@source.lon-capa.org
Mon, 24 Aug 2009 20:08:41 -0000
This is a MIME encoded message
--raeburn1251144521
Content-Type: text/plain
raeburn Mon Aug 24 20:08:41 2009 EDT
Modified files:
/loncom lond
/loncom/interface loncoursequeueadmin.pm
/loncom/lonnet/perl lonnet.pm
Log:
- Reverse changes in lond 1.420.
- &newput_dom(), &dump_dom and &del_dom in lonnet.pm now use the corresponding routines for user files - &newput, &del and &dump - with domain db data stored in .db files belonging to the domainconfig user.
- new routine: &get_domainconfiguser() provides the username of the domainconfig user.
--raeburn1251144521
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20090824200841.txt"
Index: loncom/lond
diff -u loncom/lond:1.424 loncom/lond:1.425
--- loncom/lond:1.424 Sat Aug 22 19:52:08 2009
+++ loncom/lond Mon Aug 24 20:08:31 2009
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.424 2009/08/22 19:52:08 raeburn Exp $
+# $Id: lond,v 1.425 2009/08/24 20:08:31 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -59,7 +59,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.424 $'; #' stupid emacs
+my $VERSION='$Revision: 1.425 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -4052,60 +4052,6 @@
}
®ister_handler("putdom", \&put_domain_handler, 0, 1, 0);
-#
-# Puts a piece of new data in a namespace db file at the domain level
-# returns error if key already exists
-#
-# 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 newput_domain_handler {
- my ($cmd, $tail, $client) = @_;
-
- my $userinput = "$cmd:$tail";
-
- my ($udom,$namespace,$what) =split(/:/,$tail,3);
- chomp($what);
- my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_WRCREAT(),
- "N", $what);
- if(!$hashref) {
- &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
- "while attempting newputdom\n", $userinput);
- return 1;
- }
-
- my @pairs=split(/\&/,$what);
- foreach my $pair (@pairs) {
- my ($key,$value)=split(/=/,$pair);
- if (exists($hashref->{$key})) {
- &Failure($client, "key_exists: ".$key."\n",$userinput);
- return 1;
- }
- }
-
- 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 newputdom\n",
- $userinput);
- }
- return 1;
-}
-®ister_handler("newputdom", \&newput_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.
@@ -4156,50 +4102,6 @@
®ister_handler("getdom", \&get_domain_handler, 0, 1, 0);
#
-# Deletes a key in a user profile database.
-#
-# Parameters:
-# $cmd - Command keyword (deldom).
-# $tail - Command tail. IN this case a colon
-# separated list containing:
-# the domain to which the database file belongs;
-# the namespace (name of the database file);
-# & separated list of keys to delete.
-# $client - File open on client socket.
-# Returns:
-# 1 - Continue processing
-# 0 - Exit server.
-#
-#
-sub delete_domain_entry {
- my ($cmd, $tail, $client) = @_;
-
- my $userinput = "cmd:$tail";
-
- my ($udom,$namespace,$what) = split(/:/,$tail);
- chomp($what);
- my $hashref = &tie_domain_hash($udom, $namespace, &GDBM_WRCREAT(),
- "D",$what);
- if ($hashref) {
- my @keys=split(/\&/,$what);
- foreach my $key (@keys) {
- delete($hashref->{$key});
- }
- if (&untie_user_hash($hashref)) {
- &Reply($client, "ok\n", $userinput);
- } else {
- &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
- "while attempting deldom\n", $userinput);
- }
- } else {
- &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
- "while attempting deldom\n", $userinput);
- }
- return 1;
-}
-®ister_handler("deldom", \&delete_domain_entry, 0, 1, 0);
-
-#
# Puts an id to a domains id database.
#
# Parameters:
@@ -4296,60 +4198,6 @@
}
®ister_handler("idget", \&get_id_handler, 0, 1, 0);
-sub dump_dom_with_regexp {
- my ($cmd, $tail, $client) = @_;
- my $userinput = "$cmd:$tail";
- my ($udom,$namespace,$regexp,$range)=split(/:/,$tail);
- if (defined($regexp)) {
- $regexp=&unescape($regexp);
- } else {
- $regexp='.';
- }
- my ($start,$end);
- if (defined($range)) {
- if ($range =~/^(\d+)\-(\d+)$/) {
- ($start,$end) = ($1,$2);
- } elsif ($range =~/^(\d+)$/) {
- ($start,$end) = (0,$1);
- } else {
- undef($range);
- }
- }
- my $hashref = &tie_domain_hash($udom, $namespace, &GDBM_READER());
- if ($hashref) {
- my $qresult='';
- my $count=0;
- while (my ($key,$value) = each(%$hashref)) {
- if ($regexp eq '.') {
- $count++;
- if (defined($range) && $count >= $end) { last; }
- if (defined($range) && $count < $start) { next; }
- $qresult.=$key.'='.$value.'&';
- } else {
- my $unescapeKey = &unescape($key);
- if (eval('$unescapeKey=~/$regexp/')) {
- $count++;
- if (defined($range) && $count >= $end) { last; }
- if (defined($range) && $count < $start) { next; }
- $qresult.="$key=$value&";
- }
- }
- }
- if (&untie_user_hash($hashref)) {
- chop($qresult);
- &Reply($client, \$qresult, $userinput);
- } else {
- &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
- "while attempting dump\n", $userinput);
- }
- } else {
- &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
- "while attempting dump\n", $userinput);
- }
- return 1;
-}
-®ister_handler("dumpdom", \&dump_dom_with_regexp, 0, 1, 0);
-
#
# Puts broadcast e-mail sent by Domain Coordinator in nohist_dcmail database
#
Index: loncom/interface/loncoursequeueadmin.pm
diff -u loncom/interface/loncoursequeueadmin.pm:1.5 loncom/interface/loncoursequeueadmin.pm:1.6
--- loncom/interface/loncoursequeueadmin.pm:1.5 Thu Aug 20 20:43:08 2009
+++ loncom/interface/loncoursequeueadmin.pm Mon Aug 24 20:08:36 2009
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Utilities to administer domain course requests and course self-enroll requests
#
-# $Id: loncoursequeueadmin.pm,v 1.5 2009/08/20 20:43:08 raeburn Exp $
+# $Id: loncoursequeueadmin.pm,v 1.6 2009/08/24 20:08:36 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -220,7 +220,7 @@
} else {
$formaction = '/adm/createcourse';
$namespace = 'courserequestqueue';
- %requesthash = &Apache::lonnet::dump_dom($namespace,$dom,undef,'_approval');
+ %requesthash = &Apache::lonnet::dump_dom($namespace,$dom,'_approval');
$nextelement = '<input type="hidden" name="phase" value="requestchange" />';
}
my ($output,%queue_by_date,%crstypes);
@@ -380,7 +380,7 @@
$domdesc = &Apache::lonnet::domain($cdom);
$namespace = 'courserequestqueue';
$beneficiary = 'courserequestor';
- %requesthash = &Apache::lonnet::dump_dom($namespace,$cdom,undef,'_approval');
+ %requesthash = &Apache::lonnet::dump_dom($namespace,$cdom,'_approval');
my $chome = &Apache::lonnet::domain($cdom,'primary');
$hostname = &Apache::lonnet::hostname($chome);
$protocol = $Apache::lonnet::protocol{$chome};
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1022 loncom/lonnet/perl/lonnet.pm:1.1023
--- loncom/lonnet/perl/lonnet.pm:1.1022 Sun Aug 23 03:57:20 2009
+++ loncom/lonnet/perl/lonnet.pm Mon Aug 24 20:08:40 2009
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1022 2009/08/23 03:57:20 raeburn Exp $
+# $Id: lonnet.pm,v 1.1023 2009/08/24 20:08:40 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -958,44 +958,21 @@
}
}
-# ------------------------------------------------ dump from domain db files
-
+# ------------------------------dump from db file owned by domainconfig user
sub dump_dom {
- my ($namespace,$udom,$uhome,$regexp,$range)=@_;
+ my ($namespace,$udom,$regexp,$range)=@_;
if (!$udom) {
$udom=$env{'user.domain'};
- if (defined(&domain($udom,'primary'))) {
- $uhome=&domain($udom,'primary');
- } else {
- undef($uhome);
- }
- } else {
- if (!$uhome) {
- if (defined(&domain($udom,'primary'))) {
- $uhome=&domain($udom,'primary');
- }
- }
}
my %returnhash;
- if ($udom && $uhome && ($uhome ne 'no_host')) {
- if ($regexp) {
- $regexp=&escape($regexp);
- } else {
- $regexp='.';
- }
- my $rep=&reply("dumpdom:$udom:$namespace:$regexp:$range",$uhome);
- my @pairs=split(/\&/,$rep);
- foreach my $item (@pairs) {
- my ($key,$value)=split(/=/,$item,2);
- $key = &unescape($key);
- next if ($key =~ /^error: 2 /);
- $returnhash{$key}=&thaw_unescape($value);
- }
+ if ($udom) {
+ my $uname = &get_domainconfiguser($udom);
+ %returnhash = &dump($namespace,$udom,$uname,$regexp,$range);
}
return %returnhash;
}
-# ------------------------------------------- get items from domain db files
+# ------------------------------------------ get items from domain db files
sub get_dom {
my ($namespace,$storearr,$udom,$uhome)=@_;
@@ -1069,70 +1046,40 @@
}
}
-# -------------------------------------- newput for items in domain db files
-
+# --------------------- newput for items in db file owned by domainconfig user
sub newput_dom {
- my ($namespace,$storehash,$udom,$uhome) = @_;
+ my ($namespace,$storehash,$udom) = @_;
my $result;
if (!$udom) {
$udom=$env{'user.domain'};
- if (defined(&domain($udom,'primary'))) {
- $uhome=&domain($udom,'primary');
- } else {
- undef($uhome);
- }
- } else {
- if (!$uhome) {
- if (defined(&domain($udom,'primary'))) {
- $uhome=&domain($udom,'primary');
- }
- }
}
- if ($udom && $uhome && ($uhome ne 'no_host')) {
- my $items='';
- if (ref($storehash) eq 'HASH') {
- foreach my $key (keys(%$storehash)) {
- $items.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
- }
- $items=~s/\&$//;
- $result = &reply("newputdom:$udom:$namespace:$items",$uhome);
- }
- } else {
- &logthis("put_dom failed - no homeserver and/or domain");
+ if ($udom) {
+ my $uname = &get_domainconfiguser($udom);
+ $result = &newput($namespace,$storehash,$udom,$uname);
}
return $result;
}
+# --------------------- delete for items in db file owned by domainconfig user
sub del_dom {
- my ($namespace,$storearr,$udom,$uhome)=@_;
+ my ($namespace,$storearr,$udom)=@_;
if (ref($storearr) eq 'ARRAY') {
- my $items='';
- foreach my $item (@$storearr) {
- $items.=&escape($item).'&';
- }
- $items=~s/\&$//;
if (!$udom) {
$udom=$env{'user.domain'};
- if (defined(&domain($udom,'primary'))) {
- $uhome=&domain($udom,'primary');
- } else {
- undef($uhome);
- }
- } else {
- if (!$uhome) {
- if (defined(&domain($udom,'primary'))) {
- $uhome=&domain($udom,'primary');
- }
- }
}
- if ($udom && $uhome && ($uhome ne 'no_host')) {
- return &reply("deldom:$udom:$namespace:$items",$uhome);
- } else {
- &logthis("del_dom failed - no homeserver and/or domain");
+ if ($udom) {
+ my $uname = &get_domainconfiguser($udom);
+ return &del($namespace,$storearr,$udom,$uname);
}
}
}
+# ----------------------------------construct domainconfig user for a domain
+sub get_domainconfiguser {
+ my ($udom) = @_;
+ return $udom.'-domainconfig';
+}
+
sub retrieve_inst_usertypes {
my ($udom) = @_;
my (%returnhash,@order);
--raeburn1251144521--