--- loncom/lond	2002/10/03 15:02:22	1.101
+++ loncom/lond	2003/01/13 21:52:11	1.105
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.101 2002/10/03 15:02:22 www Exp $
+# $Id: lond,v 1.105 2003/01/13 21:52:11 matthew Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -340,6 +340,7 @@ sub status {
     my $now=time;
     my $local=localtime($now);
     $status=$local.': '.$what;
+    $0='lond: '.$what.' '.$local;
 }
 
 # -------------------------------------------------------- Escape Special Chars
@@ -720,13 +721,22 @@ sub make_new_child {
 			      }
 			      }
                           } elsif ($howpwd eq 'krb4') {
-                             $null=pack("C",0);
-			     unless ($upass=~/$null/) {
-                              $pwdcorrect=(
-                                 Authen::Krb4::get_pw_in_tkt($uname,"",
-                                        $contentpwd,'krbtgt',$contentpwd,1,
-							     $upass) == 0);
-			     } else { $pwdcorrect=0; }
+                              $null=pack("C",0);
+                              unless ($upass=~/$null/) {
+                                  my $krb4_error = &Authen::Krb4::get_pw_in_tkt
+                                      ($uname,"",$contentpwd,'krbtgt',
+                                       $contentpwd,1,$upass);
+                                  if (!$krb4_error) {
+                                      $pwdcorrect = 1;
+                                  } else { 
+                                      $pwdcorrect=0; 
+                                      # log error if it is not a bad password
+                                      if ($krb4_error != 62) {
+       &logthis('krb4:'.$uname.','.$contentpwd.','.
+                &Authen::Krb4::get_err_txt($Authen::Krb4::error));
+                                      }
+                                  }
+                              }
                           } elsif ($howpwd eq 'krb5') {
 			      $null=pack("C",0);
 			      unless ($upass=~/$null/) {
@@ -1015,6 +1025,10 @@ sub make_new_child {
 # ------------------------------------------------------------------- subscribe
                    } elsif ($userinput =~ /^sub/) {
 		       print $client &subscribe($userinput,$clientip);
+# ------------------------------------------------------------- current version
+                   } elsif ($userinput =~ /^currentversion/) {
+                       my ($cmd,$fname)=split(/:/,$userinput);
+		       print $client &currentversion($fname)."\n";
 # ------------------------------------------------------------------------- log
                    } elsif ($userinput =~ /^log/) {
                        my ($cmd,$udom,$uname,$what)=split(/:/,$userinput);
@@ -1213,6 +1227,48 @@ sub make_new_child {
                        } else {
                            print $client "error:$!\n";
                        }
+# ----------------------------------------------------------------- dumpcurrent
+                   } elsif ($userinput =~ /^dumpcurrent/) {
+                       my ($cmd,$udom,$uname,$namespace)
+                          =split(/:/,$userinput);
+                       $namespace=~s/\//\_/g;
+                       $namespace=~s/\W//g;
+                       my $qresult='';
+                       my $proname=propath($udom,$uname);
+                       if (tie(%hash,'GDBM_File',
+                               "$proname/$namespace.db",
+                               &GDBM_READER(),0640)) {
+                           # Structure of %data:
+                           # $data{$symb}->{$parameter}=$value;
+                           # $data{$symb}->{'v.'.$parameter}=$version;
+                           # since $parameter will be unescaped, we do not
+                           # have to worry about silly parameter names...
+                           my %data = ();
+                           while (my ($key,$value) = each(%hash)) {
+                              my ($v,$symb,$param) = split(/:/,$key);
+                              next if ($v eq 'version' || $symb eq 'keys');
+                              next if (exists($data{$symb}) && 
+                                       exists($data{$symb}->{$param}) &&
+                                       $data{$symb}->{'v.'.$param} > $v);
+                              #&logthis("v = ".$v." p = ".$param." s = ".$symb);
+                              $data{$symb}->{$param}=$value;
+                              $data{$symb}->{'v.'.$param}=$value;
+                           }
+                           if (untie(%hash)) {
+                             while (my ($symb,$param_hash) = each(%data)) {
+                               while(my ($param,$value) = each (%$param_hash)){
+                                 next if ($param =~ /^v\./);
+                                 $qresult.=$symb.':'.$param.'='.$value.'&';
+                               }
+                             }
+                             chop($qresult);
+                             print $client "$qresult\n";
+                           } else {
+                             print $client "error:$!\n";
+                           }
+                       } else {
+                           print $client "error:$!\n";
+                       }
 # ------------------------------------------------------------------------ dump
                    } elsif ($userinput =~ /^dump/) {
                        my ($cmd,$udom,$uname,$namespace,$regexp)
@@ -1655,7 +1711,8 @@ sub currentversion {
        $ulsdir=$1;
     }
     $fname=~s/\.\d+\.(\w+(?:\.meta)*)$/\.$1/;
-    $fname=~s/\.(\w+)$/\.\(\\d\+\)\.$1\$/;
+    $fname=~s/\.(\w+(?:\.meta)*)$/\.\(\\d\+\)\.$1\$/;
+
     if (-e $fname) { $version=1; }
     if (-e $ulsdir) {
        if(-d $ulsdir) {
@@ -1701,6 +1758,10 @@ sub subscribe {
                     my $extension=$2;
                     symlink($root.'.'.$extension,
                             $root.'.'.$currentversion.'.'.$extension);
+                    unless ($extension=~/\.meta$/) {
+                       symlink($root.'.'.$extension.'.meta',
+                            $root.'.'.$currentversion.'.'.$extension.'.meta');
+		    }
                 }
             }
         }