--- loncom/lond	2005/08/26 19:40:38	1.292
+++ loncom/lond	2005/10/11 21:29:36	1.299
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.292 2005/08/26 19:40:38 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 $DEBUG = 0;		       # Non zero to ena
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.292 $'; #' stupid emacs
+my $VERSION='$Revision: 1.299 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -1370,6 +1370,7 @@ sub du_handler {
 	    if ($_=~/\.meta$/) { return;}
 	    $total_size+=(stat($_))[7];
 	};
+	chdir($ududir);
 	find($code,$ududir);
 	$total_size=int($total_size/1024);
 	&Reply($client,"$total_size\n","$cmd:$ududir");
@@ -1972,6 +1973,13 @@ sub update_resource_handler {
 			alarm(0);
 		    }
 		    rename($transname,$fname);
+		    use Cache::Memcached;
+		    my $memcache=
+			new Cache::Memcached({'servers'=>['127.0.0.1:11211']});
+		    my $url=$fname;
+		    $url=~s-^/home/httpd/html--;
+		    my $id=&escape('meta:'.$url);
+		    $memcache->delete($id);
 		}
 	    }
 	    &Reply( $client, "ok\n", $userinput);
@@ -3501,6 +3509,268 @@ sub get_id_handler {
 &register_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;
+}
+&register_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;
+}
+
+&register_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;
+}
+
+&register_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;
+}
+
+&register_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.
@@ -4404,16 +4674,23 @@ sub ReadHostTable {
     open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
     my $myloncapaname = $perlvar{'lonHostID'};
     Debug("My loncapa name is : $myloncapaname");
+    my %name_to_ip;
     while (my $configline=<CONFIG>) {
 	if ($configline !~ /^\s*\#/ && $configline !~ /^\s*$/ ) {
 	    my ($id,$domain,$role,$name)=split(/:/,$configline);
 	    $name=~s/\s//g;
-	    my $ip = gethostbyname($name);
-	    if (length($ip) ne 4) {
-		&logthis("Skipping host $id name $name no IP $ip found\n");
-		next;
+	    my $ip;
+	    if (!exists($name_to_ip{$name})) {
+		$ip = gethostbyname($name);
+		if (!$ip || length($ip) ne 4) {
+		    &logthis("Skipping host $id name $name no IP found\n");
+		    next;
+		}
+		$ip=inet_ntoa($ip);
+		$name_to_ip{$name} = $ip;
+	    } else {
+		$ip = $name_to_ip{$name};
 	    }
-	    $ip=inet_ntoa($ip);
 	    $hostid{$ip}=$id;         # LonCAPA name of host by IP.
 	    $hostdom{$id}=$domain;    # LonCAPA domain name of host. 
 	    $hostip{$id}=$ip;         # IP address of host.
@@ -4857,7 +5134,7 @@ sub make_new_child {
 #        my $tmpsnum=0;            # Now global
 #---------------------------------------------------- kerberos 5 initialization
         &Authen::Krb5::init_context();
-	if ($dist ne 'fedora4') {
+	unless (($dist eq 'fedora4') || ($dist eq 'suse9.3')) {
 	    &Authen::Krb5::init_ets();
 	}
 
@@ -5468,7 +5745,7 @@ sub thisversion {
 sub subscribe {
     my ($userinput,$clientip)=@_;
     my $result;
-    my ($cmd,$fname)=split(/:/,$userinput);
+    my ($cmd,$fname)=split(/:/,$userinput,2);
     my $ownership=&ishome($fname);
     if ($ownership eq 'owner') {
 # explitly asking for the current version?