Annotation of loncom/lchttpdlogs, revision 1.1
1.1 ! raeburn 1: #!/usr/bin/perl
! 2: #
! 3: # The Learning Online Network with CAPA
! 4: #
! 5: # $Id: lchttpdlogs,v 1.1 2011/11/03 18:25:27 raeburn Exp $
! 6: #
! 7: # Copyright Michigan State University Board of Trustees
! 8: #
! 9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
! 10: #
! 11: # LON-CAPA is free software; you can redistribute it and/or modify
! 12: # it under the terms of the GNU General Public License as published by
! 13: # the Free Software Foundation; either version 2 of the License, or
! 14: # (at your option) any later version.
! 15: #
! 16: # LON-CAPA is distributed in the hope that it will be useful,
! 17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
! 18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! 19: # GNU General Public License for more details.
! 20: #
! 21: # You should have received a copy of the GNU General Public License
! 22: # along with LON-CAPA; if not, write to the Free Software
! 23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! 24: #
! 25: # /home/httpd/html/adm/gpl.txt
! 26: #
! 27: # http://www.lon-capa.org/
! 28: #
! 29: # lchttpdlogs - LONC-CAPA setuid script to tail Apache access and error logs
! 30: # called by loncron, output to /home/httpd/html/lonstatus/index.html.
! 31: #
! 32:
! 33: use strict;
! 34: use lib '/home/httpd/lib/perl/';
! 35: use LONCAPA::Configuration;
! 36: use HTML::Entities;
! 37:
! 38: # ---------------------------------------------------------------- Exit codes
! 39: # Exit codes.
! 40: # ( (0,"ok"),
! 41: # (1,"User ID mismatch. This program must be run as user 'www'"),
! 42: #
! 43: # ----------------------------------------------------------- Initializations
! 44: # Security
! 45: $ENV{'PATH'}='/bin/:/usr/bin:/usr/local/sbin:/home/httpd/perl'; #Nullify path
! 46: # information
! 47: delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # nullify potential taints
! 48:
! 49: # Do not print error messages.
! 50: my $noprint=1;
! 51:
! 52: print "In lchttpdlogs\n" unless $noprint;
! 53:
! 54: # --------------------------- Make sure this process is running from user=www
! 55: my $wwwid=getpwnam('www');
! 56: if ($wwwid != $<) {
! 57: print("User ID mismatch. This program must be run as user 'www'\n")
! 58: unless $noprint;
! 59: &Exit(1);
! 60: }
! 61:
! 62: # ------------------ Read configuration files; determine distro and protocol
! 63:
! 64: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
! 65: my $lonhost;
! 66: if (ref($perlvarref) eq 'HASH') {
! 67: $lonhost = $perlvarref->{'lonHostID'};
! 68: }
! 69: undef($perlvarref);
! 70:
! 71: # ------------------------- tail error_log and access_log (or ssl_ equivalents)
! 72:
! 73: my $distro;
! 74: my $protocol = 'http';
! 75:
! 76: if (open(DSH,"/home/httpd/perl/distprobe |")) {
! 77: $distro = <DSH>;
! 78: close(DSH);
! 79: }
! 80: if (open(HOSTS,">/home/httpd/perl/hosts.tab")) {
! 81: while (my $configline=<HOSTS>) {
! 82: next if ($configline =~ /^(\^|\#|\s*$)/x);
! 83: chomp($configline);
! 84: my ($id,$domain,$role,$name,$prot,$intdom)=split(/:/,$configline);
! 85: if ($id eq $lonhost) {
! 86: if ($prot eq 'https') {
! 87: $protocol = $prot;
! 88: }
! 89: last;
! 90: }
! 91: }
! 92: close(HOSTS);
! 93: }
! 94:
! 95: &EnableRoot();
! 96: my $result = &check_httpd_logs($distro,$protocol);
! 97: print $result;
! 98:
! 99: # ----------------------------------------------------------------- Exit script
! 100: print "lchttpdlogs Exiting\n" unless $noprint;
! 101: &DisableRoot;
! 102: &Exit(0);
! 103:
! 104: sub EnableRoot {
! 105: if ($wwwid==$>) {
! 106: ($<,$>)=($>,$<);
! 107: ($(,$))=($),$();
! 108: } else {
! 109: # root capability is already enabled
! 110: }
! 111: return $>;
! 112: }
! 113:
! 114: sub DisableRoot {
! 115: if ($wwwid==$<) {
! 116: ($<,$>)=($>,$<);
! 117: ($(,$))=($),$();
! 118: } else {
! 119: # root capability is already disabled
! 120: }
! 121: }
! 122:
! 123: sub check_httpd_logs {
! 124: my ($distro,$protocol) = @_;
! 125: my $text;
! 126: my $logpath = '/var/log/httpd';
! 127: if ($distro =~ /^(suse|debian|ubuntu)/) {
! 128: $logpath = '/var/log/apache2';
! 129: } elsif ($distro =~ /^sles(\d+)/) {
! 130: if ($1 >= 10) {
! 131: $logpath = '/var/log/apache2';
! 132: } else {
! 133: $logpath = '/var/log/apache';
! 134: }
! 135: }
! 136: my $access_log_file = 'access_log';
! 137: my $error_log_file = 'error_log';
! 138: if ($protocol eq 'https') {
! 139: $access_log_file = 'ssl_'.$access_log_file;
! 140: $error_log_file = 'ssl_'.$error_log_file;
! 141: }
! 142:
! 143: $text='<hr /><a name="httpd" />'."<h2>httpd</h2><h3>Access Log</h3>\n<pre>\n";
! 144:
! 145: if (open(AFH,"tail -n25 $logpath/$access_log_file |")) {
! 146: while (my $line=<AFH>) {
! 147: $text .= &encode_entities($line,'<>&"');
! 148: }
! 149: close(AFH);
! 150: }
! 151:
! 152: $text .= "</pre>\n<h3>Error Log</h3>\n<pre>\n";
! 153:
! 154: if (open(EFH,"tail -n25 $logpath/$error_log_file |")) {
! 155: while (my $line=<EFH>) {
! 156: $text .= $line;
! 157: }
! 158: close(EFH);
! 159: $text .= "</pre>\n";
! 160: }
! 161: return $text;
! 162: }
! 163:
! 164: sub Exit {
! 165: my ($code) = @_;
! 166: print "Exiting with status $code\n" unless $noprint;
! 167: exit $code;
! 168: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>