#!/usr/bin/perl # # The Learning Online Network with CAPA # # $Id: lchttpdlogs,v 1.1 2011/11/03 22:32:04 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/ # # lchttpdlogs - LONC-CAPA setuid script to tail Apache access and error logs # called by loncron, output to /home/httpd/html/lonstatus/index.html. # use strict; use lib '/home/httpd/lib/perl/'; use LONCAPA::Configuration; use HTML::Entities; # ---------------------------------------------------------------- Exit codes # Exit codes. # ( (0,"ok"), # (1,"User ID mismatch. This program must be run as user 'www'"), # # ----------------------------------------------------------- Initializations # Security $ENV{'PATH'}='/bin/:/usr/bin:/usr/local/sbin:/home/httpd/perl'; #Nullify path # information delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # nullify potential taints # Do not print error messages. my $noprint=1; print "In lchttpdlogs\n" unless $noprint; # --------------------------- Make sure this process is running from user=www my $wwwid=getpwnam('www'); if ($wwwid != $<) { print("User ID mismatch. This program must be run as user 'www'\n") unless $noprint; &Exit(1); } # ------------------ Read configuration files; determine distro and protocol my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); my $lonhost; if (ref($perlvarref) eq 'HASH') { $lonhost = $perlvarref->{'lonHostID'}; } undef($perlvarref); # ------------------------- tail error_log and access_log (or ssl_ equivalents) my $distro; my $protocol = 'http'; if (open(DSH,"/home/httpd/perl/distprobe |")) { $distro = ; close(DSH); } if (open(HOSTS,">/home/httpd/perl/hosts.tab")) { while (my $configline=) { next if ($configline =~ /^(\^|\#|\s*$)/x); chomp($configline); my ($id,$domain,$role,$name,$prot,$intdom)=split(/:/,$configline); if ($id eq $lonhost) { if ($prot eq 'https') { $protocol = $prot; } last; } } close(HOSTS); } &EnableRoot(); my $result = &check_httpd_logs($distro,$protocol); print $result; # ----------------------------------------------------------------- Exit script print "lchttpdlogs Exiting\n" unless $noprint; &DisableRoot; &Exit(0); sub EnableRoot { if ($wwwid==$>) { ($<,$>)=($>,$<); ($(,$))=($),$(); } else { # root capability is already enabled } return $>; } sub DisableRoot { if ($wwwid==$<) { ($<,$>)=($>,$<); ($(,$))=($),$(); } else { # root capability is already disabled } } sub check_httpd_logs { my ($distro,$protocol) = @_; my $text; my $logpath = '/var/log/httpd'; if ($distro =~ /^(suse|debian|ubuntu)/) { $logpath = '/var/log/apache2'; } elsif ($distro =~ /^sles(\d+)/) { if ($1 >= 10) { $logpath = '/var/log/apache2'; } else { $logpath = '/var/log/apache'; } } my $access_log_file = 'access_log'; my $error_log_file = 'error_log'; if ($protocol eq 'https') { $access_log_file = 'ssl_'.$access_log_file; $error_log_file = 'ssl_'.$error_log_file; } $text='
'."

httpd

Access Log

\n
\n";

    if (open(AFH,"tail -n25 $logpath/$access_log_file |")) {
        while (my $line=) { 
            $text .= &encode_entities($line,'<>&"');
        }
        close(AFH);
    }

    $text .= "
\n

Error Log

\n
\n";

    if (open(EFH,"tail -n25 $logpath/$error_log_file |")) {
        while (my $line=) {
            $text .= $line;
        }
        close(EFH);
        $text .= "
\n"; } return $text; } sub Exit { my ($code) = @_; print "Exiting with status $code\n" unless $noprint; exit $code; }