File:  [LON-CAPA] / loncom / misc / checkforupdates.pl
Revision 1.3: download - view: text, annotated - select for diffs
Wed Oct 2 23:47:17 2013 UTC (8 years, 7 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, version_2_11_X, version_2_11_4_uiuc, version_2_11_4_msu, version_2_11_4, version_2_11_3_uiuc, version_2_11_3_msu, version_2_11_3, version_2_11_2_uiuc, version_2_11_2_msu, version_2_11_2_educog, version_2_11_2, version_2_11_1, version_2_11_0_RC3, version_2_11_0_RC2, version_2_11_0, HEAD
- Bring punctuation into agreement with usage in similar phrase in lonmodulecheck.pl

#!/usr/bin/perl
# The LearningOnline Network
#
# $Id: checkforupdates.pl,v 1.3 2013/10/02 23:47:17 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
#################################################

=pod

=head1 NAME

checkforupdates.pl

=head1 SYNOPSIS

checkforupdates.pl gathers version numbers and computes checksums
for LON-CAPA modules, scripts, and a couple of configuration files,
and compares them with those expected for the version of LON-CAPA
installed on the server.

=head1 DESCRIPTION

If there are discrepancies in checksums between the installed modules
and those expected, or if there are problems performing the update check,
or if a newer stable release of LON-CAPA is available, an e-mail will be
sent to the e-mail address configured to receive these types of alert.

Run as www.

=cut

#################################################

use strict;
use lib '/home/httpd/lib/perl/';
use Apache::lonnet();
use Apache::lonlocal();
use LONCAPA::Configuration;
use LONCAPA::Checksumming;
use Apache::loncommon();

my $perlvar= LONCAPA::Configuration::read_conf('loncapa.conf');

my ($londaemons,$lonlib,$lonincludes,$lontabdir,$lonhost,$defdom,$origmail,
    $docroot);
if (ref($perlvar) eq 'HASH') {
    $londaemons = $perlvar->{'lonDaemons'};
    $lonlib = $perlvar->{'lonLib'};
    $lonincludes = $perlvar->{'lonIncludes'};
    $lontabdir = $perlvar->{'lonTabDir'};
    $lonhost = $perlvar->{'lonHostID'};
    $defdom = $perlvar->{'lonDefDomain'};
    $origmail = $perlvar->{'lonAdmEMail'};
    $docroot = $perlvar->{'lonDocRoot'};
}
undef($perlvar);

&Apache::lonlocal::get_language_handle();

my ($distro,$send,$message);

my $loncaparev = &Apache::lonnet::get_server_loncaparev($defdom);
my ($version,$timestamp) = split(/\-/,$loncaparev);
if ($loncaparev =~ /CVS_HEAD/) {
    $message = &Apache::lonlocal::mt('Code checking unavailable for LON-CAPA CVS HEAD')."\n";
} else {
    # Get Linux distro
    if (open(PIPE, "$londaemons/distprobe |")) {
        $distro = <PIPE>;
        close(PIPE);
    }

    if ($distro) {
        my ($serversums,$serverversions) =
            &LONCAPA::Checksumming::get_checksums($distro,$londaemons,$lonlib,
                                                  $lonincludes,$lontabdir);
        if ((ref($serversums) eq 'HASH') && (ref($serverversions) eq 'HASH')) {
            if (keys(%{$serversums}) > 0) {
                my ($result,$numchg) =
                    &LONCAPA::Checksumming::compare_checksums('mail',$lonhost,
                                                              $version,
                                                              $serversums,
                                                              $serverversions);
                if ($numchg) {  
                    $send = 1;
                }
                $message = $result;
            } else {
                $message = &Apache::lonlocal::mt('No comparison attempted - failed to retrieve checksums for installed files.');
            }
        } else {
            $message = &Apache::lonlocal::mt('No comparison attempted - failed to retrieve checksums for installed files.');
        }
    } else {
        $message = &Apache::lonlocal::mt('No comparison attempted - unable to determine Linux distribution.');
    }

    my ($update_toprod,$update_totest);
    my ($smajor,$sminor,$sdecimal,$smodifier) =
        ($version =~ /^(\d+)\.(\d+)\.(\d+)\.?(\w*)$/);
    my ($production,$proddate,$testing,$testdate) = &latest_release();
    my ($pmajor,$pminor,$pdecimal,$pmodifier) =
       ($production =~ /^(\d+)\.(\d+)\.(\d+)\.?(\w*)$/);
    if ($smodifier =~ /^RC(\d+)$/) {
        my $scand = $1;
        my ($tmajor,$tminor,$tdecimal,$tmodifier) =
            ($testing =~ /^(\d+)\.(\d+)\.(\d+)\.?(\w*)$/);
        my $tcand;
        if ($tmodifier =~ /^RC(\d+)$/) {
            $tcand = $1; 
        }
        if (($smajor < $tmajor ) ||
            (($smajor == $tmajor) && ($sminor < $tminor)) ||
            (($smajor == $tmajor) && ($sminor == $tminor) && 
             ($sdecimal < $tdecimal)) ||
            ((($smajor == $tmajor) && ($sminor == $tminor) &&
              ($sdecimal == $tdecimal) &&
              (($scand && $tcand) && ($scand < $tcand))))) { 
            $update_totest = $testing;
        }
    }
    if (($smajor < $pmajor ) ||
        (($smajor == $pmajor) && ($sminor < $pminor)) ||
        (($smajor == $pmajor) && ($sminor == $pminor) && 
         ($sdecimal < $pdecimal))) {
        $update_toprod = $production;           
    }
    if ($update_totest) {
        $message .= 
            "\n\n".
            &Apache::lonlocal::mt('A newer testing version of LON-CAPA: [_1]'.
                                  ' is available from: [_2]',
                                  $testing.'-'.$testdate,
                                  "\n http://install.loncapa.org/\n");
    }
    if ($update_toprod) {
        $message .= 
            "\n\n".
            &Apache::lonlocal::mt('A newer version of LON-CAPA: [_1]'.
                                  ' is available from: [_2]',
                                  $production.'-'.$proddate,
                                  "\n http://install.loncapa.org/\n");
    }
}

if ($docroot ne '') {
    if (open(my $fh,">$docroot/lon-status/checkLCupdates.txt")) {
        print $fh
             &Apache::lonlocal::mt('Update check result -- [_1]',
                                   &Apache::lonlocal::locallocaltime(time)).
             "\n\n".
             $message;
        close($fh);
        system("chown www:www $docroot/lon-status/checkLCupdates.txt");
        chmod(0600,"$docroot/lon-status/checkLCupdates.txt");

        if ($send) {
            # Determine who receives the e-mail
            my $emailto =
                &Apache::loncommon::build_recipient_list(undef,'updatesmail',
                                                         $defdom,$origmail);
            if ($emailto) {
                my $subj = "LON-CAPA module check -- $lonhost";
                if (-e "$docroot/lon-status/checkLCupdates.txt") {
                    system(qq{mail -s '$subj' "$emailto" < $docroot/lon-status/checkLCupdates.txt});
                }
            }
        }
    }
}

exit;

sub latest_release {
    my ($production,$proddate,$testing,$testdate);
    if (-e "/tmp/latestLCrelease.txt") {
         unlink("/tmp/latestLCrelease.txt");
    }
    my $rtncode = system("wget -O /tmp/latestLCrelease.txt ".
                         "http://install.loncapa.org/versions/latest.txt ".
                         "> /dev/null 2>&1");
    if (!$rtncode) {
        if (open(my $fh,"</tmp/latestLCrelease.txt")) {
            my @info = <$fh>;
            close($fh);
            foreach my $line (@info) {
                chomp($line);
                if ($line =~ /^\QLATEST-IS: \E([\w\-.]+):\d+$/) {
                    $production = $1;
                } elsif ($line =~ /^\QLASTRELPROD: \E(\d+)$/) {
                    $proddate = $1; 
                } elsif ($line =~ /^\QLATEST-TESTING-IS: \E([\w\-.]+):\d+$/) {
                    $testing = $1;
                } elsif ($line =~ /^\QLASTRELTEST: \E(\d+)$/) {
                    $testdate = $1;
                } 
            }
        }
    }
    return ($production,$proddate,$testing,$testdate);
}


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