--- loncom/lond	2002/09/19 21:16:24	1.98
+++ loncom/lond	2003/03/14 21:25:44	1.103.2.1
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.98 2002/09/19 21:16:24 foxr Exp $
+# $Id: lond,v 1.103.2.1 2003/03/14 21:25:44 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -272,17 +272,25 @@ sub checkchildren {
         } 
     }
     sleep 5;
+    $SIG{ALRM} = sub { die "timeout" };
+    $SIG{__DIE__} = 'DEFAULT';
     foreach (sort keys %children) {
         unless (-e "$docdir/lon-status/londchld/$_.txt") {
+          eval {
+            alarm(300);
 	    &logthis('Child '.$_.' did not respond');
 	    kill 9 => $_;
 	    $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
 	    $subj="LON: $perlvar{'lonHostID'} killed lond process $_";
 	    my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`;
 	    $execdir=$perlvar{'lonDaemons'};
-	    $result=`/bin/cp $execdir/logs/lond.log $execdir/logs/lond.log.$_`
+	    $result=`/bin/cp $execdir/logs/lond.log $execdir/logs/lond.log.$_`;
+	    alarm(0);
+	  }
         }
     }
+    $SIG{ALRM} = 'DEFAULT';
+    $SIG{__DIE__} = \&cathcexception;
 }
 
 # --------------------------------------------------------------------- Logging
@@ -340,6 +348,7 @@ sub status {
     my $now=time;
     my $local=localtime($now);
     $status=$local.': '.$what;
+    $0='lond: '.$what.' '.$local;
 }
 
 # -------------------------------------------------------- Escape Special Chars
@@ -695,15 +704,22 @@ sub make_new_child {
                           my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
                           my $pwdcorrect=0;
                           if ($howpwd eq 'internal') {
+			      &Debug("Internal auth");
 			      $pwdcorrect=
 				  (crypt($upass,$contentpwd) eq $contentpwd);
                           } elsif ($howpwd eq 'unix') {
-                              $contentpwd=(getpwnam($uname))[1];
-			      my $pwauth_path="/usr/local/sbin/pwauth";
-			      unless ($contentpwd eq 'x') {
-				  $pwdcorrect=
-                                    (crypt($upass,$contentpwd) eq $contentpwd);
-			      }
+			      &Debug("Unix auth");
+                              if((getpwnam($uname))[1] eq "") { #no such user!
+				  $pwdcorrect = 0;
+			      } else {
+				  $contentpwd=(getpwnam($uname))[1];
+				  my $pwauth_path="/usr/local/sbin/pwauth";
+				  unless ($contentpwd eq 'x') {
+				      $pwdcorrect=
+					  (crypt($upass,$contentpwd) eq 
+					   $contentpwd);
+				  }
+		  
 			      elsif (-e $pwauth_path) {
 				  open PWAUTH, "|$pwauth_path" or
 				      die "Cannot invoke authentication";
@@ -711,6 +727,7 @@ sub make_new_child {
 				  close PWAUTH;
 				  $pwdcorrect=!$?;
 			      }
+			      }
                           } elsif ($howpwd eq 'krb4') {
                              $null=pack("C",0);
 			     unless ($upass=~/$null/) {
@@ -1007,6 +1024,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);
@@ -1216,21 +1237,25 @@ sub make_new_child {
 		       } else {
                           $regexp='.';
 		       }
-                       my $proname=propath($udom,$uname);
                        my $qresult='';
-      if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
+                       my $proname=propath($udom,$uname);
+    if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
                            study($regexp);
-                           foreach $key (keys %hash) {
-                               my $unescapeKey = &unescape($key);
-                               if (eval('$unescapeKey=~/$regexp/')) {
-                                  $qresult.="$key=$hash{$key}&";
-                              }
+                           while (($key,$value) = each(%hash)) {
+                               if ($regexp eq '.') {
+                                   $qresult.=$key.'='.$value.'&';
+                               } else {
+                                   my $unescapeKey = &unescape($key);
+                                   if (eval('$unescapeKey=~/$regexp/')) {
+                                       $qresult.="$key=$value&";
+                                   }
+                               }
                            }
-			   if (untie(%hash)) {
-		              $qresult=~s/\&$//;
-                              print $client "$qresult\n";
+                           if (untie(%hash)) {
+                               chop($qresult);
+                               print $client "$qresult\n";
                            } else {
-                              print $client "error:$!\n";
+                               print $client "error:$!\n";
                            }
                        } else {
                            print $client "error:$!\n";
@@ -1635,12 +1660,68 @@ sub unsub {
     return $result;
 }
 
+sub currentversion {
+    my $fname=shift;
+    my $version=-1;
+    my $ulsdir='';
+    if ($fname=~/^(.+)\/[^\/]+$/) {
+       $ulsdir=$1;
+    }
+    $fname=~s/\.\d+\.(\w+(?:\.meta)*)$/\.$1/;
+    $fname=~s/\.(\w+(?:\.meta)*)$/\.\(\\d\+\)\.$1\$/;
+
+    if (-e $fname) { $version=1; }
+    if (-e $ulsdir) {
+       if(-d $ulsdir) {
+          if (opendir(LSDIR,$ulsdir)) {
+             while ($ulsfn=readdir(LSDIR)) {
+# see if this is a regular file (ignore links produced earlier)
+                 my $thisfile=$ulsdir.'/'.$ulsfn;
+                 unless (-l $thisfile) {
+		    if ($thisfile=~/$fname/) {
+		        if ($1>$version) { $version=$1; }
+                    }
+		 }
+             }
+             closedir(LSDIR);
+             $version++;
+          }
+      }
+   }
+   return $version;
+}
+
+sub thisversion {
+    my $fname=shift;
+    my $version=-1;
+    if ($fname=~/\.(\d+)\.\w+(?:\.meta)*$/) {
+	$version=$1;
+    }
+    return $version;
+}
+
 sub subscribe {
     my ($userinput,$clientip)=@_;
     my $result;
     my ($cmd,$fname)=split(/:/,$userinput);
     my $ownership=&ishome($fname);
     if ($ownership eq 'owner') {
+# explitly asking for the current version?
+        unless (-e $fname) {
+            my $currentversion=&currentversion($fname);
+	    if (&thisversion($fname)==$currentversion) {
+                if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) {
+		    my $root=$1;
+                    my $extension=$2;
+                    symlink($root.'.'.$extension,
+                            $root.'.'.$currentversion.'.'.$extension);
+                    unless ($extension=~/\.meta$/) {
+                       symlink($root.'.'.$extension.'.meta',
+                            $root.'.'.$currentversion.'.'.$extension.'.meta');
+		    }
+                }
+            }
+        }
 	if (-e $fname) {
 	    if (-d $fname) {
 		$result="directory\n";