Annotation of loncom/misc/checkforupdates.pl, revision 1.2

1.1       raeburn     1: #!/usr/bin/perl
                      2: # The LearningOnline Network
                      3: #
1.2     ! raeburn     4: # $Id: checkforupdates.pl,v 1.1 2013/02/02 00:22:39 raeburn Exp $
1.1       raeburn     5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
                     28: #################################################
                     29: 
                     30: =pod
                     31: 
                     32: =head1 NAME
                     33: 
                     34: checkforupdates.pl
                     35: 
                     36: =head1 SYNOPSIS
                     37: 
                     38: checkforupdates.pl gathers version numbers and computes checksums
                     39: for LON-CAPA modules, scripts, and a couple of configuration files,
                     40: and compares them with those expected for the version of LON-CAPA
                     41: installed on the server.
                     42: 
                     43: =head1 DESCRIPTION
                     44: 
                     45: If there are discrepancies in checksums between the installed modules
                     46: and those expected, or if there are problems performing the update check,
                     47: or if a newer stable release of LON-CAPA is available, an e-mail will be
                     48: sent to the e-mail address configured to receive these types of alert.
                     49: 
                     50: Run as www.
                     51: 
                     52: =cut
                     53: 
                     54: #################################################
                     55: 
                     56: use strict;
                     57: use lib '/home/httpd/lib/perl/';
                     58: use Apache::lonnet();
                     59: use Apache::lonlocal();
                     60: use LONCAPA::Configuration;
                     61: use LONCAPA::Checksumming;
                     62: use Apache::loncommon();
                     63: 
                     64: my $perlvar= LONCAPA::Configuration::read_conf('loncapa.conf');
                     65: 
                     66: my ($londaemons,$lonlib,$lonincludes,$lontabdir,$lonhost,$defdom,$origmail,
                     67:     $docroot);
                     68: if (ref($perlvar) eq 'HASH') {
                     69:     $londaemons = $perlvar->{'lonDaemons'};
                     70:     $lonlib = $perlvar->{'lonLib'};
                     71:     $lonincludes = $perlvar->{'lonIncludes'};
                     72:     $lontabdir = $perlvar->{'lonTabDir'};
                     73:     $lonhost = $perlvar->{'lonHostID'};
                     74:     $defdom = $perlvar->{'lonDefDomain'};
                     75:     $origmail = $perlvar->{'lonAdmEMail'};
                     76:     $docroot = $perlvar->{'lonDocRoot'};
                     77: }
                     78: undef($perlvar);
                     79: 
                     80: &Apache::lonlocal::get_language_handle();
                     81: 
                     82: my ($distro,$send,$message);
                     83: 
                     84: my $loncaparev = &Apache::lonnet::get_server_loncaparev($defdom);
                     85: my ($version,$timestamp) = split(/\-/,$loncaparev);
                     86: if ($loncaparev =~ /CVS_HEAD/) {
                     87:     $message = &Apache::lonlocal::mt('Code checking unavailable for LON-CAPA CVS HEAD.')."\n";
                     88: } else {
                     89:     # Get Linux distro
                     90:     if (open(PIPE, "$londaemons/distprobe |")) {
                     91:         $distro = <PIPE>;
                     92:         close(PIPE);
                     93:     }
                     94: 
                     95:     if ($distro) {
                     96:         my ($serversums,$serverversions) =
                     97:             &LONCAPA::Checksumming::get_checksums($distro,$londaemons,$lonlib,
                     98:                                                   $lonincludes,$lontabdir);
                     99:         if ((ref($serversums) eq 'HASH') && (ref($serverversions) eq 'HASH')) {
                    100:             if (keys(%{$serversums}) > 0) {
                    101:                 my ($result,$numchg) =
                    102:                     &LONCAPA::Checksumming::compare_checksums('mail',$lonhost,
                    103:                                                               $version,
                    104:                                                               $serversums,
                    105:                                                               $serverversions);
                    106:                 if ($numchg) {  
                    107:                     $send = 1;
                    108:                 }
                    109:                 $message = $result;
                    110:             } else {
                    111:                 $message = &Apache::lonlocal::mt('No comparison attempted - failed to retrieve checksums for installed files.');
                    112:             }
                    113:         } else {
                    114:             $message = &Apache::lonlocal::mt('No comparison attempted - failed to retrieve checksums for installed files.');
                    115:         }
                    116:     } else {
                    117:         $message = &Apache::lonlocal::mt('No comparison attempted - unable to determine Linux distribution.');
                    118:     }
                    119: 
                    120:     my ($update_toprod,$update_totest);
                    121:     my ($smajor,$sminor,$sdecimal,$smodifier) =
                    122:         ($version =~ /^(\d+)\.(\d+)\.(\d+)\.?(\w*)$/);
                    123:     my ($production,$proddate,$testing,$testdate) = &latest_release();
                    124:     my ($pmajor,$pminor,$pdecimal,$pmodifier) =
                    125:        ($production =~ /^(\d+)\.(\d+)\.(\d+)\.?(\w*)$/);
                    126:     if ($smodifier =~ /^RC(\d+)$/) {
                    127:         my $scand = $1;
                    128:         my ($tmajor,$tminor,$tdecimal,$tmodifier) =
                    129:             ($testing =~ /^(\d+)\.(\d+)\.(\d+)\.?(\w*)$/);
                    130:         my $tcand;
                    131:         if ($tmodifier =~ /^RC(\d+)$/) {
                    132:             $tcand = $1; 
                    133:         }
                    134:         if (($smajor < $tmajor ) ||
                    135:             (($smajor == $tmajor) && ($sminor < $tminor)) ||
                    136:             (($smajor == $tmajor) && ($sminor == $tminor) && 
                    137:              ($sdecimal < $tdecimal)) ||
                    138:             ((($smajor == $tmajor) && ($sminor == $tminor) &&
                    139:               ($sdecimal == $tdecimal) &&
                    140:               (($scand && $tcand) && ($scand < $tcand))))) { 
                    141:             $update_totest = $testing;
                    142:         }
                    143:     }
                    144:     if (($smajor < $pmajor ) ||
                    145:         (($smajor == $pmajor) && ($sminor < $pminor)) ||
                    146:         (($smajor == $pmajor) && ($sminor == $pminor) && 
                    147:          ($sdecimal < $pdecimal))) {
                    148:         $update_toprod = $production;           
                    149:     }
                    150:     if ($update_totest) {
                    151:         $message .= 
                    152:             "\n\n".
                    153:             &Apache::lonlocal::mt('A newer testing version of LON-CAPA: [_1]'.
                    154:                                   ' is available from: [_2]',
                    155:                                   $testing.'-'.$testdate,
                    156:                                   "\n http://install.loncapa.org/\n");
                    157:     }
                    158:     if ($update_toprod) {
                    159:         $message .= 
                    160:             "\n\n".
                    161:             &Apache::lonlocal::mt('A newer version of LON-CAPA: [_1]'.
                    162:                                   ' is available from: [_2]',
                    163:                                   $production.'-'.$proddate,
                    164:                                   "\n http://install.loncapa.org/\n");
                    165:     }
1.2     ! raeburn   166: }
        !           167: 
        !           168: if ($docroot ne '') {
        !           169:     if (open(my $fh,">$docroot/lon-status/checkLCupdates.txt")) {
        !           170:         print $fh
1.1       raeburn   171:              &Apache::lonlocal::mt('Update check result -- [_1]',
                    172:                                    &Apache::lonlocal::locallocaltime(time)).
                    173:              "\n\n".
                    174:              $message;
1.2     ! raeburn   175:         close($fh);
1.1       raeburn   176:         system("chown www:www $docroot/lon-status/checkLCupdates.txt");
1.2     ! raeburn   177:         chmod(0600,"$docroot/lon-status/checkLCupdates.txt");
1.1       raeburn   178: 
1.2     ! raeburn   179:         if ($send) {
        !           180:             # Determine who receives the e-mail
        !           181:             my $emailto =
        !           182:                 &Apache::loncommon::build_recipient_list(undef,'updatesmail',
        !           183:                                                          $defdom,$origmail);
        !           184:             if ($emailto) {
        !           185:                 my $subj = "LON-CAPA module check -- $lonhost";
        !           186:                 if (-e "$docroot/lon-status/checkLCupdates.txt") {
        !           187:                     system(qq{mail -s '$subj' "$emailto" < $docroot/lon-status/checkLCupdates.txt});
        !           188:                 }
        !           189:             }
        !           190:         }
1.1       raeburn   191:     }
                    192: }
                    193: 
                    194: exit;
                    195: 
                    196: sub latest_release {
                    197:     my ($production,$proddate,$testing,$testdate);
                    198:     if (-e "/tmp/latestLCrelease.txt") {
                    199:          unlink("/tmp/latestLCrelease.txt");
                    200:     }
                    201:     my $rtncode = system("wget -O /tmp/latestLCrelease.txt ".
                    202:                          "http://install.loncapa.org/versions/latest.txt ".
                    203:                          "> /dev/null 2>&1");
                    204:     if (!$rtncode) {
                    205:         if (open(my $fh,"</tmp/latestLCrelease.txt")) {
                    206:             my @info = <$fh>;
                    207:             close($fh);
                    208:             foreach my $line (@info) {
                    209:                 chomp($line);
                    210:                 if ($line =~ /^\QLATEST-IS: \E([\w\-.]+):\d+$/) {
                    211:                     $production = $1;
                    212:                 } elsif ($line =~ /^\QLASTRELPROD: \E(\d+)$/) {
                    213:                     $proddate = $1; 
                    214:                 } elsif ($line =~ /^\QLATEST-TESTING-IS: \E([\w\-.]+):\d+$/) {
                    215:                     $testing = $1;
                    216:                 } elsif ($line =~ /^\QLASTRELTEST: \E(\d+)$/) {
                    217:                     $testdate = $1;
                    218:                 } 
                    219:             }
                    220:         }
                    221:     }
                    222:     return ($production,$proddate,$testing,$testdate);
                    223: }
                    224: 

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