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>