[LON-CAPA-cvs] cvs: loncom / lond /interface lonnotify.pm /lonnet/perl lonnet.pm
raeburn
lon-capa-cvs@mail.lon-capa.org
Tue, 11 Oct 2005 21:29:44 -0000
This is a MIME encoded message
--raeburn1129066184
Content-Type: text/plain
raeburn Tue Oct 11 17:29:44 2005 EDT
Modified files:
/loncom lond
/loncom/lonnet/perl lonnet.pm
/loncom/interface lonnotify.pm
Log:
Domain roles now stored in nohist_domainroles.db file in /home/httpd/lonUsers/$dom on library servers in domain. To be switched to storage on a single "primary" library server.
lonnotify::print_display_option_form() uses contents of nohist_domainroles.db to present choice of Domain Coordinators when selecting options for display of sent mail.
lond routines added for storage of broadcase dcmail.
Future consolidation of put/dump lond routines for domain-level db files is desirable.
--raeburn1129066184
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20051011172944.txt"
Index: loncom/lond
diff -u loncom/lond:1.298 loncom/lond:1.299
--- loncom/lond:1.298 Thu Oct 6 16:48:33 2005
+++ loncom/lond Tue Oct 11 17:29:36 2005
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.298 2005/10/06 20:48:33 albertel Exp $
+# $Id: lond,v 1.299 2005/10/11 21:29:36 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -59,7 +59,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.298 $'; #' stupid emacs
+my $VERSION='$Revision: 1.299 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -3509,6 +3509,268 @@
®ister_handler("idget", \&get_id_handler, 0, 1, 0);
#
+# Puts broadcast e-mail sent by Domain Coordinator in nohist_dcmail database
+#
+# Parameters
+# $cmd - Command keyword that caused us to be dispatched.
+# $tail - Tail of the command. Consists of a colon separated:
+# domain - the domain whose dcmail we are recording
+# email Consists of key=value pair
+# where key is unique msgid
+# and value is message (in XML)
+# $client - Socket open on the client.
+#
+# Returns:
+# 1 - indicating processing should continue.
+# Side effects
+# reply is written to $client.
+#
+sub put_dcmail_handler {
+ my ($cmd,$tail,$client) = @_;
+ my $userinput = "$cmd:$tail";
+
+ my ($udom,$what)=split(/:/,$tail);
+ chomp($what);
+ my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT());
+ if ($hashref) {
+ my ($key,$value)=split(/=/,$what);
+ $hashref->{$key}=$value;
+ }
+ if (untie(%$hashref)) {
+ &Reply($client, "ok\n", $userinput);
+ } else {
+ &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+ "while attempting dcmailput\n", $userinput);
+ }
+ return 1;
+}
+®ister_handler("dcmailput", \&put_dcmail_handler, 0, 1, 0);
+
+#
+# Retrieves broadcast e-mail from nohist_dcmail database
+# Returns to client an & separated list of key=value pairs,
+# where key is msgid and value is message information.
+#
+# Parameters
+# $cmd - Command keyword that caused us to be dispatched.
+# $tail - Tail of the command. Consists of a colon separated:
+# domain - the domain whose dcmail table we dump
+# startfilter - beginning of time window
+# endfilter - end of time window
+# sendersfilter - & separated list of username:domain
+# for senders to search for.
+# $client - Socket open on the client.
+#
+# Returns:
+# 1 - indicating processing should continue.
+# Side effects
+# reply (& separated list of msgid=messageinfo pairs) is
+# written to $client.
+#
+sub dump_dcmail_handler {
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput = "$cmd:$tail";
+ my ($udom,$startfilter,$endfilter,$sendersfilter) = split(/:/,$tail);
+ chomp($sendersfilter);
+ my @senders = ();
+ if (defined($startfilter)) {
+ $startfilter=&unescape($startfilter);
+ } else {
+ $startfilter='.';
+ }
+ if (defined($endfilter)) {
+ $endfilter=&unescape($endfilter);
+ } else {
+ $endfilter='.';
+ }
+ if (defined($sendersfilter)) {
+ $sendersfilter=&unescape($sendersfilter);
+ if ($sendersfilter =~ /\&/) {
+ @senders = split(/\&/,$sendersfilter);
+ } else {
+ $senders[0] = $sendersfilter;
+ }
+ }
+
+ my $qresult='';
+ my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT());
+ if ($hashref) {
+ while (my ($key,$value) = each(%$hashref)) {
+ my $match = 1;
+ my ($timestamp,$subj,$uname,$udom) = split(/:/,&unescape($key),5);
+ $timestamp = &unescape($timestamp);
+ $subj = &unescape($subj);
+ $uname = &unescape($uname);
+ $udom = &unescape($udom);
+ unless ($startfilter eq '.' || !defined($startfilter)) {
+ if ($timestamp < $startfilter) {
+ $match = 0;
+ }
+ }
+ unless ($endfilter eq '.' || !defined($endfilter)) {
+ if ($timestamp > $endfilter) {
+ $match = 0;
+ }
+ }
+ unless (@senders < 1) {
+ unless (grep/^$uname:$udom$/,@senders) {
+ $match = 0;
+ }
+ }
+ if ($match == 1) {
+ $qresult.=$key.'='.$value.'&';
+ }
+ }
+ if (untie(%$hashref)) {
+ chop($qresult);
+ &Reply($client, "$qresult\n", $userinput);
+ } else {
+ &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+ "while attempting dcmaildump\n", $userinput);
+ }
+ } else {
+ &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+ "while attempting dcmaildump\n", $userinput);
+ }
+ return 1;
+}
+
+®ister_handler("dcmaildump", \&dump_dcmail_handler, 0, 1, 0);
+
+#
+# Puts domain roles in nohist_domainroles database
+#
+# Parameters
+# $cmd - Command keyword that caused us to be dispatched.
+# $tail - Tail of the command. Consists of a colon separated:
+# domain - the domain whose roles we are recording
+# role - Consists of key=value pair
+# where key is unique role
+# and value is start/end date information
+# $client - Socket open on the client.
+#
+# Returns:
+# 1 - indicating processing should continue.
+# Side effects
+# reply is written to $client.
+#
+
+sub put_domainroles_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, "nohist_domainroles", &GDBM_WRCREAT());
+ 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 domroleput\n", $userinput);
+ }
+ } else {
+ &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+ "while attempting domroleput\n", $userinput);
+ }
+
+ return 1;
+}
+
+®ister_handler("domroleput", \&put_domainroles_handler, 0, 1, 0);
+
+#
+# Retrieves domain roles from nohist_domainroles database
+# Returns to client an & separated list of key=value pairs,
+# where key is role and value is start and end date information.
+#
+# Parameters
+# $cmd - Command keyword that caused us to be dispatched.
+# $tail - Tail of the command. Consists of a colon separated:
+# domain - the domain whose domain roles table we dump
+# $client - Socket open on the client.
+#
+# Returns:
+# 1 - indicating processing should continue.
+# Side effects
+# reply (& separated list of role=start/end info pairs) is
+# written to $client.
+#
+sub dump_domainroles_handler {
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput = "$cmd:$tail";
+ my ($udom,$startfilter,$endfilter,$rolesfilter) = split(/:/,$tail);
+ chomp($rolesfilter);
+ my @roles = ();
+ if (defined($startfilter)) {
+ $startfilter=&unescape($startfilter);
+ } else {
+ $startfilter='.';
+ }
+ if (defined($endfilter)) {
+ $endfilter=&unescape($endfilter);
+ } else {
+ $endfilter='.';
+ }
+ if (defined($rolesfilter)) {
+ $rolesfilter=&unescape($rolesfilter);
+ if ($rolesfilter =~ /\&/) {
+ @roles = split(/\&/,$rolesfilter);
+ } else {
+ $roles[0] = $rolesfilter;
+ }
+ }
+
+ my $hashref = &tie_domain_hash($udom, "nohist_domainroles", &GDBM_WRCREAT());
+ if ($hashref) {
+ my $qresult = '';
+ while (my ($key,$value) = each(%$hashref)) {
+ my $match = 1;
+ my ($start,$end) = split(/:/,&unescape($value));
+ my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,&unescape($key));
+ unless ($startfilter eq '.' || !defined($startfilter)) {
+ if ($start >= $startfilter) {
+ $match = 0;
+ }
+ }
+ unless ($endfilter eq '.' || !defined($endfilter)) {
+ if ($end <= $endfilter) {
+ $match = 0;
+ }
+ }
+ unless (@roles < 1) {
+ unless (grep/^$trole$/,@roles) {
+ $match = 0;
+ }
+ }
+ if ($match == 1) {
+ $qresult.=$key.'='.$value.'&';
+ }
+ }
+ if (untie(%$hashref)) {
+ chop($qresult);
+ &Reply($client, "$qresult\n", $userinput);
+ } else {
+ &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+ "while attempting domrolesdump\n", $userinput);
+ }
+ } else {
+ &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+ "while attempting domrolesdump\n", $userinput);
+ }
+ return 1;
+}
+
+®ister_handler("domrolesdump", \&dump_domainroles_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.
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.661 loncom/lonnet/perl/lonnet.pm:1.662
--- loncom/lonnet/perl/lonnet.pm:1.661 Mon Oct 10 14:15:52 2005
+++ loncom/lonnet/perl/lonnet.pm Tue Oct 11 17:29:38 2005
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.661 2005/10/10 18:15:52 raeburn Exp $
+# $Id: lonnet.pm,v 1.662 2005/10/11 21:29:38 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -37,7 +37,7 @@
use vars
qw(%perlvar %hostname %badServerCache %iphost %spareid %hostdom
%libserv %pr %prp $memcache %packagetab
- %courselogs %accesshash %userrolehash $processmarker $dumpcount
+ %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf
%domaindescription %domain_auth_def %domain_auth_arg_def
%domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit
@@ -1610,6 +1610,31 @@
delete $userrolehash{$entry};
}
}
+#
+# Reverse lookup of domain roles (dc, ad, li, sc, au)
+#
+ my %domrolebuffer = ();
+ foreach my $entry (keys %domainrolehash) {
+ my ($role,$uname,$udom,$runame,$rudom,$rsec)=split/:/,$entry;
+ if ($domrolebuffer{$rudom}) {
+ $domrolebuffer{$rudom}.='&'.&escape($entry).
+ '='.&escape($domainrolehash{$entry});
+ } else {
+ $domrolebuffer{$rudom}.=&escape($entry).
+ '='.&escape($domainrolehash{$entry});
+ }
+ delete $domainrolehash{$entry};
+ }
+ foreach my $dom (keys(%domrolebuffer)) {
+ foreach my $tryserver (keys %libserv) {
+ if ($hostdom{$tryserver} eq $dom) {
+ unless (&reply('domroleput:'.$dom.':'.
+ $domrolebuffer{$dom},$tryserver) eq 'ok') {
+ &logthis('Put of domain roles failed for '.$dom.' and '.$tryserver);
+ }
+ }
+ }
+ }
$dumpcount++;
}
@@ -1686,14 +1711,23 @@
sub userrolelog {
my ($trole,$username,$domain,$area,$tstart,$tend)=@_;
if (($trole=~/^ca/) || ($trole=~/^aa/) ||
- ($trole=~/^in/) || ($trole=~/^cc/) ||
+ ($trole=~/^in/) || ($trole=~/^cc/) ||
($trole=~/^ep/) || ($trole=~/^cr/) ||
($trole=~/^ta/)) {
my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
$userrolehash
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
=$tend.':'.$tstart;
- }
+ }
+ if (($trole=~/^dc/) || ($trole=~/^ad/) ||
+ ($trole=~/^li/) || ($trole=~/^li/) ||
+ ($trole=~/^au/) || ($trole=~/^dg/) ||
+ ($trole=~/^sc/)) {
+ my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
+ $domainrolehash
+ {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
+ = $tend.':'.$tstart;
+ }
}
sub get_course_adv_roles {
@@ -1813,6 +1847,15 @@
}
# ---------------------------------------------------------- DC e-mail
+
+sub dcmailput {
+ my ($domain,$msgid,$contents,$server)=@_;
+ my $status = &Apache::lonnet::critical(
+ 'dcmailput:'.$domain.':'.&Apache::lonnet::escape($msgid).'='.
+ &Apache::lonnet::escape($$contents{$server}),$server);
+ return $status;
+}
+
sub dcmaildump {
my ($dom,$startdate,$enddate,$senders) = @_;
my %returnhash=();
@@ -1822,8 +1865,8 @@
foreach (
split(/\&/,&reply('dcmaildump:'.$dom.':'.
&escape($startdate).':'.&escape($enddate).':'.
- &escape($senders), ,$tryserver))) {
- my($key,$value) = split(/\=/,$_);
+ &escape($senders), $tryserver))) {
+ my ($key,$value) = split(/\=/,$_);
if (($key) && ($value)) {
$returnhash{$tryserver}{&unescape($key)} = &unescape($value);
}
@@ -1832,6 +1875,34 @@
}
return %returnhash;
}
+# ---------------------------------------------------------- Domain roles
+
+sub get_domain_roles {
+ my ($dom,$roles,$startdate,$enddate)=@_;
+ if (undef($startdate) || $startdate eq '') {
+ $startdate = '.';
+ }
+ if (undef($enddate) || $enddate eq '') {
+ $enddate = '.';
+ }
+ my $rolelist = join(':',@{$roles});
+ my %personnel = ();
+ foreach my $tryserver (keys(%libserv)) {
+ if ($hostdom{$tryserver} eq $dom) {
+ %{$personnel{$tryserver}}=();
+ foreach (
+ split(/\&/,&reply('domrolesdump:'.$dom.':'.
+ &escape($startdate).':'.&escape($enddate).':'.
+ &escape($rolelist), $tryserver))) {
+ my($key,$value) = split(/\=/,$_);
+ if (($key) && ($value)) {
+ $personnel{$tryserver}{&unescape($key)} = &unescape($value);
+ }
+ }
+ }
+ }
+ return %personnel;
+}
# ----------------------------------------------------------- Check out an item
@@ -2507,7 +2578,6 @@
if ($_!~/^rolesdef_/) {
my ($area,$role)=split(/=/,$_);
$area=~s/\_\w\w$//;
-
my ($trole,$tend,$tstart);
if ($role=~/^cr/) {
if ($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|) {
@@ -2531,7 +2601,7 @@
&standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
}
}
- }
+ }
}
my ($author,$adv) = &set_userprivs(\$userroles,\%allroles);
$userroles.='user.adv='.$adv."\n".
Index: loncom/interface/lonnotify.pm
diff -u loncom/interface/lonnotify.pm:1.3 loncom/interface/lonnotify.pm:1.4
--- loncom/interface/lonnotify.pm:1.3 Wed Oct 5 14:50:08 2005
+++ loncom/interface/lonnotify.pm Tue Oct 11 17:29:39 2005
@@ -151,8 +151,6 @@
'enddate',
$now);
my $jscript;
- my %totals = ();
- my %personnel = ();
my $output = <<"ENDONE";
$html
<head>
@@ -174,14 +172,19 @@
'</td></tr></table></td>';
$output .= &Apache::lonhtmlcommon::row_closure();
$output .= &Apache::lonhtmlcommon::row_title($col_width,$tablecolor,&mt('Choose sender(s)'));
-# FIXME - need to complete work on domain_roles_get
-# &Apache::lonnet::domain_roles_get($cdom,\@roles,\%personnel,%totals);
+ my %personnel = &Apache::lonnet::get_domain_roles($cdom,\@roles);
$output .= '<td>';
- if ($totals{'dc'} > 0) {
- foreach my $user (sort(keys(%{$personnel{'dc'}}))) {
- my ($uname,$udom) = split(/:/,$user);
- my %userinfo = &Apache::lonnet::get('environment',['lastname','firstname'],$udom,$uname);
- $output .= '<input type="checkbox" name="sender" value="'.$user.'" /> '.$userinfo{firstname}.' '.$userinfo{lastname}.' ('.$user.')';
+ my @domcc = ();
+ foreach my $server (keys %personnel) {
+ print STDERR "key level 1 is $server\n";
+ foreach my $user (sort(keys %{$personnel{$server}})) {
+ print STDERR "key level 2 is $user\n";
+ my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,$user);
+ unless (grep/^$uname:$udom$/,@domcc) {
+ my %userinfo = &Apache::lonnet::get('environment',['lastname','firstname'],$udom,$uname);
+ $output .= '<input type="checkbox" name="sender" value="'.$uname.':'.$udom.'" /> '.$userinfo{firstname}.' '.$userinfo{lastname}.' ('.$uname.':'.$udom.')';
+ push (@domcc,$uname.':'.$udom);
+ }
}
}
$output .= '</td>';
@@ -739,16 +742,15 @@
sub store_mail {
my ($subject,$message,$domain,$recipients,$attachmenturl,$ltext) = @_;
- my %status = ();
my %servers = ();
my $msgid=&packagemail($subject,$message,$domain,
$recipients,\%servers,$attachmenturl);
# Store in dc email db files on appropriate servers.
foreach my $server (keys(%servers)) {
-# FIXME This needs to be via a subroutine in lonnet
- $status{$server} = &Apache::lonnet::critical(
- 'dcmailput:'.$domain.':'.&Apache::lonnet::escape($msgid).'='.
- &Apache::lonnet::escape($servers{$server}),$server);
+ unless (&Apache::lonnet::dcmailput($domain,$msgid,\%servers,$server) eq 'ok') {
+ &logthis('Storage of dc mail failed for domain'.$domain.' for server: '.
+ $server.'. Message ID was '.$msgid);
+ }
}
}
--raeburn1129066184--