[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.109 and 1.115

version 1.109, 2003/03/01 04:18:22 version 1.115, 2003/03/18 22:51:03
Line 52 Line 52
 #      preforking is not really needed.  #      preforking is not really needed.
 ###  ###
   
   
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   
Line 74  my $DEBUG = 0;         # Non zero to ena Line 73  my $DEBUG = 0;         # Non zero to ena
 my $status='';  my $status='';
 my $lastlog='';  my $lastlog='';
   
   my $currenthostid;
   my $currentdomainid;
 #  #
 #  The array below are password error strings."  #  The array below are password error strings."
 #  #
Line 169  undef $perlvarref; Line 170  undef $perlvarref;
 my $wwwid=getpwnam('www');  my $wwwid=getpwnam('www');
 if ($wwwid!=$<) {  if ($wwwid!=$<) {
    $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";     $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
    $subj="LON: $perlvar{'lonHostID'} User ID mismatch";     $subj="LON: $currenthostid User ID mismatch";
    system("echo 'User ID mismatch.  lond must be run as user www.' |\     system("echo 'User ID mismatch.  lond must be run as user www.' |\
  mailto $emailto -s '$subj' > /dev/null");   mailto $emailto -s '$subj' > /dev/null");
    exit 1;     exit 1;
Line 196  while ($configline=<CONFIG>) { Line 197  while ($configline=<CONFIG>) {
     my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);      my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
     chomp($ip); $ip=~s/\D+$//;      chomp($ip); $ip=~s/\D+$//;
     $hostid{$ip}=$id;      $hostid{$ip}=$id;
     if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }      $hostdom{$id}=$domain;
       $hostip{$id}=$ip;
       if ($id eq $perlvar{'lonHostId'}) { $thisserver=$name; }
     $PREFORK++;      $PREFORK++;
 }  }
 close(CONFIG);  close(CONFIG);
Line 263  sub checkchildren { Line 266  sub checkchildren {
         }           } 
     }      }
     sleep 5;      sleep 5;
       $SIG{ALRM} = sub { die "timeout" };
       $SIG{__DIE__} = 'DEFAULT';
     foreach (sort keys %children) {      foreach (sort keys %children) {
         unless (-e "$docdir/lon-status/londchld/$_.txt") {          unless (-e "$docdir/lon-status/londchld/$_.txt") {
             eval {
               alarm(300);
     &logthis('Child '.$_.' did not respond');      &logthis('Child '.$_.' did not respond');
     kill 9 => $_;      kill 9 => $_;
     $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";      $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
     $subj="LON: $perlvar{'lonHostID'} killed lond process $_";      $subj="LON: $currenthostid killed lond process $_";
     my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`;      my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`;
     $execdir=$perlvar{'lonDaemons'};      $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  # --------------------------------------------------------------------- Logging
Line 301  sub logstatus { Line 312  sub logstatus {
     my $docdir=$perlvar{'lonDocRoot'};      my $docdir=$perlvar{'lonDocRoot'};
     {      {
     my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt");      my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt");
     print $fh $$."\t".$status."\t".$lastlog."\n";      print $fh $$."\t".$currenthostid."\t".$status."\t".$lastlog."\n";
     $fh->close();      $fh->close();
     }      }
     {      {
Line 398  sub subreply { Line 409  sub subreply {
 sub reply {  sub reply {
   my ($cmd,$server)=@_;    my ($cmd,$server)=@_;
   my $answer;    my $answer;
   if ($server ne $perlvar{'lonHostID'}) {     if ($server ne $currenthostid) { 
     $answer=subreply($cmd,$server);      $answer=subreply($cmd,$server);
     if ($answer eq 'con_lost') {      if ($answer eq 'con_lost') {
  $answer=subreply("ping",$server);   $answer=subreply("ping",$server);
         if ($answer ne $server) {          if ($answer ne $server) {
     &logthis("sub reply: answer != server");      &logthis("sub reply: answer != server answer is $answer, server is $server");
            &reconlonc("$perlvar{'lonSockDir'}/$server");             &reconlonc("$perlvar{'lonSockDir'}/$server");
         }          }
         $answer=subreply($cmd,$server);          $answer=subreply($cmd,$server);
Line 504  while (1) { Line 515  while (1) {
     make_new_child($client);      make_new_child($client);
 }  }
   
   sub init_host_and_domain {
       my ($remotereq) = @_;
       my (undef,$hostid)=split(/:/,$remotereq);
       if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }
       if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {
    $currenthostid=$hostid;
    $currentdomainid=$hostdom{$hostid};
    &logthis("Setting hostid to $hostid, and domain to $currentdomainid");
       } else {
    &logthis("Requested host id $hostid not an alias of ".
    $perlvar{'lonHostID'}." refusing connection");
    return 0;
       }
       return 1;
   }
   
 sub make_new_child {  sub make_new_child {
     my $client;      my $client;
     my $pid;      my $pid;
Line 556  sub make_new_child { Line 583  sub make_new_child {
             my $clientip=inet_ntoa($iaddr);              my $clientip=inet_ntoa($iaddr);
             my $clientrec=($hostid{$clientip} ne undef);              my $clientrec=($hostid{$clientip} ne undef);
             &logthis(              &logthis(
 "<font color=yellow>INFO: Connection $i, $clientip ($hostid{$clientip})</font>"  "<font color=yellow>INFO: Connection, $clientip ($hostid{$clientip})</font>"
             );              );
             &status("Connecting $clientip ($hostid{$clientip})");               &status("Connecting $clientip ($hostid{$clientip})"); 
             my $clientok;              my $clientok;
             if ($clientrec) {              if ($clientrec) {
       &status("Waiting for init from $clientip ($hostid{$clientip})");        &status("Waiting for init from $clientip ($hostid{$clientip})");
       my $remotereq=<$client>;        my $remotereq=<$client>;
               $remotereq=~s/\W//g;                $remotereq=~s/[^\w:]//g;
               if ($remotereq eq 'init') {                if ($remotereq =~ /^init/) {
     if (!&init_host_and_domain($remotereq)) {
         &status("Got bad init message, exiting");
         print $client "refused\n";
         $client->close();
         &logthis("<font color=blue>WARNING: "
          ."Bad init message $remotereq, closing connection</font>");
         exit;
     }
   my $challenge="$$".time;    my $challenge="$$".time;
                   print $client "$challenge\n";                    print $client "$challenge\n";
                   &status(                    &status(
Line 593  sub make_new_child { Line 628  sub make_new_child {
             if ($clientok) {              if ($clientok) {
 # ---------------- New known client connecting, could mean machine online again  # ---------------- New known client connecting, could mean machine online again
   
       &reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}");   foreach my $id (keys(%hostip)) {
               &logthis(      if ($hostip{$id} ne $clientip ||
        "<font color=green>Established connection: $hostid{$clientip}</font>");         $hostip{$currenthostid} eq $clientip) {
    # no need to try to do recon's to myself
    next;
       }
       &reconlonc("$perlvar{'lonSockDir'}/$id");
    }
    &logthis("<font color=green>Established connection: $hostid{$clientip}</font>");
               &status('Will listen to '.$hostid{$clientip});                &status('Will listen to '.$hostid{$clientip});
 # ------------------------------------------------------------ Process requests  # ------------------------------------------------------------ Process requests
               while (my $userinput=<$client>) {                while (my $userinput=<$client>) {
Line 623  sub make_new_child { Line 664  sub make_new_child {
 # ------------------------------------------------------------- Normal commands  # ------------------------------------------------------------- Normal commands
 # ------------------------------------------------------------------------ ping  # ------------------------------------------------------------------------ ping
    if ($userinput =~ /^ping/) {     if ($userinput =~ /^ping/) {
                        print $client "$perlvar{'lonHostID'}\n";                         print $client "$currenthostid\n";
 # ------------------------------------------------------------------------ pong  # ------------------------------------------------------------------------ pong
    } elsif ($userinput =~ /^pong/) {     } elsif ($userinput =~ /^pong/) {
                        $reply=reply("ping",$hostid{$clientip});                         $reply=reply("ping",$hostid{$clientip});
                        print $client "$perlvar{'lonHostID'}:$reply\n";                          print $client "$currenthostid:$reply\n"; 
 # ------------------------------------------------------------------------ ekey  # ------------------------------------------------------------------------ ekey
    } elsif ($userinput =~ /^ekey/) {     } elsif ($userinput =~ /^ekey/) {
                        my $buildkey=time.$$.int(rand 100000);                         my $buildkey=time.$$.int(rand 100000);
                        $buildkey=~tr/1-6/A-F/;                         $buildkey=~tr/1-6/A-F/;
                        $buildkey=int(rand 100000).$buildkey.int(rand 100000);                         $buildkey=int(rand 100000).$buildkey.int(rand 100000);
                        my $key=$perlvar{'lonHostID'}.$hostid{$clientip};                         my $key=$currenthostid.$hostid{$clientip};
                        $key=~tr/a-z/A-Z/;                         $key=~tr/a-z/A-Z/;
                        $key=~tr/G-P/0-9/;                         $key=~tr/G-P/0-9/;
                        $key=~tr/Q-Z/0-9/;                         $key=~tr/Q-Z/0-9/;
Line 845  sub make_new_child { Line 886  sub make_new_child {
     $passfilename);      $passfilename);
                        if (-e $passfilename) {                         if (-e $passfilename) {
    print $client "already_exists\n";     print $client "already_exists\n";
                        } elsif ($udom ne $perlvar{'lonDefDomain'}) {                         } elsif ($udom ne $currentdomainid) {
                            print $client "not_right_domain\n";                             print $client "not_right_domain\n";
                        } else {                         } else {
                            @fpparts=split(/\//,$proname);                             @fpparts=split(/\//,$proname);
Line 856  sub make_new_child { Line 897  sub make_new_child {
                                unless (-e $fpnow) {                                 unless (-e $fpnow) {
    unless (mkdir($fpnow,0777)) {     unless (mkdir($fpnow,0777)) {
                                       $fperror="error: ".($!+0)                                        $fperror="error: ".($!+0)
   ." mkdir failed\n";    ." mkdir failed while attempting "
                                                 ."makeuser\n";
                                    }                                     }
                                }                                 }
                            }                             }
Line 884  sub make_new_child { Line 926  sub make_new_child {
                        $npass=&unescape($npass);                         $npass=&unescape($npass);
                        my $proname=&propath($udom,$uname);                         my $proname=&propath($udom,$uname);
                        my $passfilename="$proname/passwd";                         my $passfilename="$proname/passwd";
        if ($udom ne $perlvar{'lonDefDomain'}) {         if ($udom ne $currentdomainid) {
                            print $client "not_right_domain\n";                             print $client "not_right_domain\n";
                        } else {                         } else {
    my $result=&make_passwd_file($uname, $umode,$npass,     my $result=&make_passwd_file($uname, $umode,$npass,
Line 1028  sub make_new_child { Line 1070  sub make_new_child {
                             print $client "ok\n";                               print $client "ok\n"; 
  } else {   } else {
                             print $client "error: ".($!+0)                              print $client "error: ".($!+0)
  ." IO::File->new Failed\n";   ." IO::File->new Failed "
                                       ."while attempting log\n";
         }          }
        }         }
 # ------------------------------------------------------------------------- put  # ------------------------------------------------------------------------- put
Line 1057  sub make_new_child { Line 1100  sub make_new_child {
                               print $client "ok\n";                                print $client "ok\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) failed\n";    ." untie(GDBM) failed ".
                                         "while attempting put\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!)                             print $client "error: ".($!)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                      "while attempting put\n";
                        }                         }
       } else {        } else {
                           print $client "refused\n";                            print $client "refused\n";
Line 1101  sub make_new_child { Line 1146  sub make_new_child {
                               print $client "ok\n";                                print $client "ok\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting rolesput\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                      "while attempting rolesput\n";
                        }                         }
       } else {        } else {
                           print $client "refused\n";                            print $client "refused\n";
Line 1129  sub make_new_child { Line 1176  sub make_new_child {
                               print $client "$qresult\n";                                print $client "$qresult\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting get\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             if ($!+0 == 2) {
        ." tie(GDBM) Failed\n";                                 print $client "error:No such file or ".
                                      "GDBM reported bad block error\n";
                              } else {
                                  print $client "error: ".($!+0)
                                      ." tie(GDBM) Failed ".
                                          "while attempting get\n";
                              }
                        }                         }
 # ------------------------------------------------------------------------ eget  # ------------------------------------------------------------------------ eget
                    } elsif ($userinput =~ /^eget/) {                     } elsif ($userinput =~ /^eget/) {
Line 1167  sub make_new_child { Line 1221  sub make_new_child {
                               }                                }
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting eget\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                      "while attempting eget\n";
                        }                         }
 # ------------------------------------------------------------------------- del  # ------------------------------------------------------------------------- del
                    } elsif ($userinput =~ /^del/) {                     } elsif ($userinput =~ /^del/) {
Line 1197  sub make_new_child { Line 1253  sub make_new_child {
                               print $client "ok\n";                                print $client "ok\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting del\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                      "while attempting del\n";
                        }                         }
 # ------------------------------------------------------------------------ keys  # ------------------------------------------------------------------------ keys
                    } elsif ($userinput =~ /^keys/) {                     } elsif ($userinput =~ /^keys/) {
Line 1220  sub make_new_child { Line 1278  sub make_new_child {
                               print $client "$qresult\n";                                print $client "$qresult\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting keys\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                      "while attempting keys\n";
                        }                         }
 # ----------------------------------------------------------------- dumpcurrent  # ----------------------------------------------------------------- dumpcurrent
                    } elsif ($userinput =~ /^currentdump/) {                     } elsif ($userinput =~ /^currentdump/) {
Line 1263  sub make_new_child { Line 1323  sub make_new_child {
                              print $client "$qresult\n";                               print $client "$qresult\n";
                            } else {                             } else {
                              print $client "error: ".($!+0)                               print $client "error: ".($!+0)
  ." untie(GDBM) Failed\n";   ." untie(GDBM) Failed ".
                                        "while attempting currentdump\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                         "while attempting currentdump\n";
                        }                         }
 # ------------------------------------------------------------------------ dump  # ------------------------------------------------------------------------ dump
                    } elsif ($userinput =~ /^dump/) {                     } elsif ($userinput =~ /^dump/) {
Line 1299  sub make_new_child { Line 1361  sub make_new_child {
                                print $client "$qresult\n";                                 print $client "$qresult\n";
                            } else {                             } else {
                                print $client "error: ".($!+0)                                 print $client "error: ".($!+0)
    ." untie(GDBM) Failed\n";     ." untie(GDBM) Failed ".
                                          "while attempting dump\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                         "while attempting dump\n";
                        }                         }
 # ----------------------------------------------------------------------- store  # ----------------------------------------------------------------------- store
                    } elsif ($userinput =~ /^store/) {                     } elsif ($userinput =~ /^store/) {
Line 1341  sub make_new_child { Line 1405  sub make_new_child {
                               print $client "ok\n";                                print $client "ok\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting store\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                      "while attempting store\n";
                        }                         }
       } else {        } else {
                           print $client "refused\n";                            print $client "refused\n";
Line 1377  sub make_new_child { Line 1443  sub make_new_child {
                               print $client "$qresult\n";                                print $client "$qresult\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting restore\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                      "while attempting restore\n";
                        }                         }
 # -------------------------------------------------------------------- chatsend  # -------------------------------------------------------------------- chatsend
                    } elsif ($userinput =~ /^chatsend/) {                     } elsif ($userinput =~ /^chatsend/) {
Line 1421  sub make_new_child { Line 1489  sub make_new_child {
        }         }
        else {         else {
    print $client "error: ".($!+0)     print $client "error: ".($!+0)
        ." IO::File->new Failed\n";         ." IO::File->new Failed ".
                                      "while attempting queryreply\n";
        }         }
 # ----------------------------------------------------------------------- idput  # ----------------------------------------------------------------------- idput
                    } elsif ($userinput =~ /^idput/) {                     } elsif ($userinput =~ /^idput/) {
Line 1446  sub make_new_child { Line 1515  sub make_new_child {
                               print $client "ok\n";                                print $client "ok\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting idput\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                         "while attempting idput\n";
                        }                         }
 # ----------------------------------------------------------------------- idget  # ----------------------------------------------------------------------- idget
                    } elsif ($userinput =~ /^idget/) {                     } elsif ($userinput =~ /^idget/) {
Line 1469  sub make_new_child { Line 1540  sub make_new_child {
                               print $client "$qresult\n";                                print $client "$qresult\n";
                            } else {                             } else {
                               print $client "error: ".($!+0)                                print $client "error: ".($!+0)
   ." untie(GDBM) Failed\n";    ." untie(GDBM) Failed ".
                                         "while attempting idget\n";
                            }                             }
                        } else {                         } else {
                            print $client "error: ".($!+0)                             print $client "error: ".($!+0)
        ." tie(GDBM) Failed\n";         ." tie(GDBM) Failed ".
                                      "while attempting idget\n";
                        }                         }
 # ---------------------------------------------------------------------- tmpput  # ---------------------------------------------------------------------- tmpput
                    } elsif ($userinput =~ /^tmpput/) {                     } elsif ($userinput =~ /^tmpput/) {
Line 1491  sub make_new_child { Line 1564  sub make_new_child {
        }         }
        else {         else {
    print $client "error: ".($!+0)     print $client "error: ".($!+0)
        ."IO::File->new Failed\n";         ."IO::File->new Failed ".
                                      "while attempting tmpput\n";
        }         }
   
 # ---------------------------------------------------------------------- tmpget  # ---------------------------------------------------------------------- tmpget
Line 1508  sub make_new_child { Line 1582  sub make_new_child {
        }         }
        else {         else {
    print $client "error: ".($!+0)     print $client "error: ".($!+0)
        ."IO::File->new Failed\n";         ."IO::File->new Failed ".
                                      "while attempting tmpget\n";
        }         }
   
   # ---------------------------------------------------------------------- tmpdel
                      } elsif ($userinput =~ /^tmpdel/) {
                          my ($cmd,$id)=split(/:/,$userinput);
                          chomp($id);
                          $id=~s/\W/\_/g;
                          my $execdir=$perlvar{'lonDaemons'};
                          if (unlink("$execdir/tmp/$id.tmp")) {
      print $client "ok\n";
          } else {
      print $client "error: ".($!+0)
          ."Unlink tmp Failed ".
                                      "while attempting tmpdel\n";
          }
 # -------------------------------------------------------------------------- ls  # -------------------------------------------------------------------------- ls
                    } elsif ($userinput =~ /^ls/) {                     } elsif ($userinput =~ /^ls/) {
                        my ($cmd,$ulsdir)=split(/:/,$userinput);                         my ($cmd,$ulsdir)=split(/:/,$userinput);
Line 1721  sub currentversion { Line 1809  sub currentversion {
     if ($fname=~/^(.+)\/[^\/]+$/) {      if ($fname=~/^(.+)\/[^\/]+$/) {
        $ulsdir=$1;         $ulsdir=$1;
     }      }
       my ($fnamere1,$fnamere2);
       # remove version if already specified
     $fname=~s/\.\d+\.(\w+(?:\.meta)*)$/\.$1/;      $fname=~s/\.\d+\.(\w+(?:\.meta)*)$/\.$1/;
     $fname=~s/\.(\w+(?:\.meta)*)$/\.\(\\d\+\)\.$1\$/;      # get the bits that go before and after the version number
       if ( $fname=~/^(.*\.)(\w+(?:\.meta)*)$/ ) {
    $fnamere1=$1;
    $fnamere2='.'.$2;
       }
     if (-e $fname) { $version=1; }      if (-e $fname) { $version=1; }
     if (-e $ulsdir) {      if (-e $ulsdir) {
        if(-d $ulsdir) {         if(-d $ulsdir) {
           if (opendir(LSDIR,$ulsdir)) {            if (opendir(LSDIR,$ulsdir)) {
   
              while ($ulsfn=readdir(LSDIR)) {               while ($ulsfn=readdir(LSDIR)) {
 # see if this is a regular file (ignore links produced earlier)  # see if this is a regular file (ignore links produced earlier)
                  my $thisfile=$ulsdir.'/'.$ulsfn;                   my $thisfile=$ulsdir.'/'.$ulsfn;
                  unless (-l $thisfile) {                   unless (-l $thisfile) {
     if ($thisfile=~/$fname/) {       if ($thisfile=~/\Q$fnamere1\E(\d+)\Q$fnamere2\E/) {
         if ($1>$version) { $version=$1; }   if ($1>$version) { $version=$1; }
                     }       }
  }   }
              }               }
              closedir(LSDIR);               closedir(LSDIR);
Removed from v.1.109  
changed lines
  Added in v.1.115

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>