--- loncom/lond 2002/09/30 21:38:18 1.100 +++ 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.100 2002/09/30 21:38:18 matthew 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 @@ -1015,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 ¤tversion($fname)."\n"; # ------------------------------------------------------------------------- log } elsif ($userinput =~ /^log/) { my ($cmd,$udom,$uname,$what)=split(/:/,$userinput); @@ -1647,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=¤tversion($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";