#!/usr/bin/perl
#
# Program: DTrace Apache Top <apachetop.pl>
#
# Author: Clay McClure <clay@daemons.net> && Matty <matty91 at gmail dot com>
#
# Current Version: 0.1a
#
# Revision History:
#  Version 0.1a
#
# Last Updated: 11-30-2005
#
# Purpose: Prints the requests to a server in "top"-like format
# 
# Acknowledgements: This idea came from the awesome Apachetop C program
#
# Installation:
#   Copy the shell script to a suitable location
#
# CDDL HEADER START
#  The contents of this file are subject to the terms of the
#  Common Development and Distribution License, Version 1.0 only
#  (the "License").  You may not use this file except in compliance
#  with the License.
#
#  You can obtain a copy of the license at Docs/cddl1.txt
#  or http://www.opensolaris.org/os/licensing.
#  See the License for the specific language governing permissions
#  and limitations under the License.
# CDDL HEADER END
#
# Example:
#  $ apachetop.pl 
#  21:12:39    Requests:    347 (  69/sec)    Bytes:  35349 (7069/sec,  101/request)
#  Requests:   GETs:  347    POSTs:    0    HEADs:    0    TRACEs:    0
#  Responses:   1XX:    0      2XX:  301      3XX:   46       4XX:    0      5XX:    0
#
# Requests   Requests/Sec   Bytes Sent    URI                                     
#       13            2.6        13312    /blah                                   
#        6            1.2            0    /manual/ja/mod/directives.html          
#        6            1.2            0    /manual/ru/mod/directives.html          
#        6            1.2            0    /manual/de/mod/directives.html          
#        6            1.2            0    /manual/en/mod/directives.html          
#        6            1.2            0    /manual/es/mod/directives.html          
#        6            1.2            0    /manual/ko/mod/directives.html          
#        2            0.4            0    /manual/ja/mod/                         
#        2            0.4            0    /manual/es/mod/                         
#        2            0.4            0    /manual/de/mod/                         
#        2            0.4            0    /manual/ko/mod/                         
#        2            0.4            0    /manual/en/mod/                         
#        1            0.2            0    /manual/ja/mod/mod_negotiation.html     
#        1            0.2            0    /manual/ja/mod/mod_isapi.html           
#        1            0.2            0    /manual/ko/mod/mod_file_cache.html      
#        1            0.2          344    /manual/ko/ru/mod/directives.html       
#        1            0.2            0    /manual/ja/mod/mod_asis.html            
#        1            0.2            0    /manual/es/mod/mod_autoindex.html       
#        1            0.2            0    /manual/ru/mod/beos.html                
#        1            0.2            0    /manual/ko/mod/mod_setenvif.html        

use Getopt::Std;
use POSIX;

$DELAY = $ARGV[0] || 5;
$CLEAR = `tput clear`;
$COUNT = 20;

$DTRACE = <<END;
/usr/sbin/dtrace -Z -q -32 -n'
::apache_log_request:log-request
{
  this->responsecode = (int)*(uintptr_t *)copyin(arg0 + 68, sizeof(int));
  this->method       = copyinstr(*(uintptr_t *)copyin(arg0 + 72, sizeof(uintptr_t)));
  this->request_size = (int)*(uintptr_t *)copyin(arg0 + 100, sizeof(int)); 
  this->uuri         = copyinstr(*(uintptr_t *)copyin(arg0 + 200, sizeof(uintptr_t)));

  printf("%d %s %s %d\\n", this->responsecode,
                           this->method,
                           this->uuri,
                           this->request_size);
}'
END

# Hello
print("Starting dtrace, please wait...");

# Open the dtrace command 
open(DTRACE, "$DTRACE |") || die "Cannot execute /usr/sbin/dtrace: $@\n";

# Install our signal handler.
my $sigset = POSIX::SigSet->new(SIGALRM); 

my $action = POSIX::SigAction->new('print_requests',
                                    $sigset,
                                    &POSIX::SA_NODEFER);

POSIX::sigaction(&POSIX::SIGALRM, $action);


alarm($DELAY);

while (<DTRACE>) {
    sigprocmask(SIG_BLOCK, $sigset);

    chomp;

    ($responsecode, $method, $uri, $request_size) = split;

    $requests++;
    $bytes += $request_size;

    $methods{$method}++;
    $responsecodes{int($responsecode / 100)}++;

    $uris{$uri}{BYTES} += $request_size;
    $uris{$uri}{REQUESTS}++;

    sigprocmask(SIG_UNBLOCK, $sigset);
}

sub print_requests {
   print($CLEAR);
   
   # Print the header
   ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
   printf("%02d:%02d:%02d    Requests: %6d (%4d/sec)    Bytes: %6d (%4d/sec, %4d/request)\n", $hour,
                                                           $min,
                                                           $sec,
                                                           $requests,
                                                           $requests / $DELAY, 
                                                           $bytes,
                                                           $bytes / $DELAY,
                                                           $requests ? $bytes / $requests : 0);

   printf("Requests:   GETs: %4d    POSTs: %4d    HEADs: %4d    TRACEs: %4d\n", $methods{GET},
                                                                                $methods{POST},
                                                                                $methods{HEAD},
                                                                                $methods{TRACE});

   printf("Responses:   1XX: %4d      2XX: %4d      3XX: %4d       4XX: %4d      5XX: %4d\n\n", 
                                                                             $responsecodes{1},
                                                                             $responsecodes{2},
                                                                             $responsecodes{3},
                                                                             $responsecodes{4},
                                                                             $responsecodes{5});

   printf("%-8s   %-12s   %-10s    %-40s\n", "Requests", "Requests/Sec", "Bytes Sent", "URI");

   @sarray = sort { $uris{$b}{REQUESTS} <=> $uris{$a}{REQUESTS} } keys %uris;
   for ( $i = 0; ( ( $i < $COUNT) && ( $i < @sarray)); $i++ ) {
        printf("%8s   %12s   %10s    %-40s\n", $uris{$sarray[$i]}{REQUESTS},
                                               $uris{$sarray[$i]}{REQUESTS} / $DELAY,
                                               $uris{$sarray[$i]}{BYTES},
                                               $sarray[$i]) ;
   }

   # Set all values to 0 or NULL
   $bytes = 0;
   $requests = 0;
   undef %methods;
   undef %responsecodes;
   undef %uris;

   alarm($DELAY);
}