#!/usr/bin/perl

###########
# apache-tuner
# A calculator for tuning Apache performance
#
# 2012
###########

## no critic qw(RequireUseStrict RequireUseWarnings ProhibitPunctuationVars RequireLocalizedPunctuationVars ProhibitBacktickOperators RequireCarping RequireCheckedSyscalls ProhibitMagicNumbers RequireLineBoundaryMatching RequireDotMatchAnything RequireExtendedFormatting ProhibitCascadingIfElse ProhibitParensWithBuiltins)

BEGIN { $0 = 'apache-tuner'; }

use strict;
use warnings;
use POSIX;
use Getopt::Long qw(:config no_ignore_case no_auto_abbrev);
use Pod::Usage;

my $debugoutput = 0;

#$Getopt::Std::STANDARD_HELP_VERSION = 1;
our $VERSION = '2.00';

# TODO:
## Clean up/implement currently unused options from GetOptions()
## Detect PHP handler, advise based on that (DSO = prefork required, otherwise confirm it's needed)

sub trim {
    my $string = shift;
    if ( !$string ) {

        #warn "Undefined value in trim()\n";
        return;
    }
    if ( $string =~ /^\s*$/s ) {
        $string = NULL;
    }
    chomp $string;
    $string =~ s/\s+$//s;
    $string =~ s/^\s+//s;
    return $string;
}

sub getmpm {

#my $mpmbuffer = `httpd -V | grep "Server MPM" | cut -d: -f2`;
#my $mpmbuffer = `cat /home/sconnolly/dev/apache-tuner/httpdv.out | grep "Server MPM" | cut -d: -f2`; #dev
    my $mpmbuffer = `httpd -V`;
    $mpmbuffer =~ s/.*?Server.MPM:(.*?)\n.*/$1/gs;
    $mpmbuffer = trim($mpmbuffer);
    return $mpmbuffer;
}

my (
    $perldocall, $helpflag,    $version,      $mpm,
    $php,        $concurrency, $maxthreads,   $minthreads,
    $arps,       $stacksize,   $modstatusurl, $vps,
    $cores,      $keepalive,   $maxkeepaliverequests
);    # Removed $mrps, $threads,
my $threadlimit     = 64;
my $threadsperchild = 64;
my $variability     = 1;
my $numprocs        = 0;
my $sizeprocs       = 0;
my $numrootprocs    = 0;
my $sizerootprocs   = 0;
my $numwwwprocs     = 0;
my $sizewwwprocs    = 0;
my $nummysqlprocs   = 0;
my $sizemysqlprocs  = 0;
my $nummailprocs    = 0;
my $sizemailprocs   = 0;
my $numnamedprocs   = 0;
my $sizenamedprocs  = 0;
my $numphpprocs     = 0;
my $sizephpprocs    = 0;
my $numotherprocs   = 0;
my $sizeotherprocs  = 0;
my $totalmem        = 0;
my $freemem         = 0;

open my $meminfo, '<', '/proc/meminfo'; ## no critic qw(RequireCheckedOpen)
while (<$meminfo>) {
  chomp;
  (undef, $totalmem) = split(/\s+/) if (/^MemTotal/); ## no critic qw(ProhibitPostfixControls)
  (undef, $freemem) = split(/\s+/) if (/^MemFree/);  ## no critic qw(ProhibitPostfixControls)
}
close $meminfo; ## no critic qw(RequireCheckedClose)
$freemem         = $freemem/1024;
$totalmem        = $totalmem * .8 / 1024;    # kb-%20 for overhead

$helpflag = 0;

GetOptions(
    'h|help'     => \$helpflag,
    'o=s'        => \$mpm,
    'p=s'        => \$php,
    'c=i'        => \$concurrency,
    't=i'        => \$threadsperchild,
    'x=i'        => \$maxthreads,
    'm=i'        => \$minthreads,
    'l=i'        => \$threadlimit,
    'r=i'        => \$arps,
    'f=f'        => \$variability,
    'k=i'        => \$keepalive,
    's=i'        => \$stacksize,
    'u=s'        => \$modstatusurl,
    'v|version'  => \$version,
    'pd|perldoc' => \$perldocall,
);

if ($version)  { pod2usage( -verbose => 99, -sections => 'VERSION', -input => \*DATA ); exit; }
if ($helpflag) { pod2usage( -verbose => 99, -sections => 'USAGE', -input => \*DATA );   exit; }
if ($perldocall) { pod2usage( -verbose => 3, -input => \*DATA ); exit; }

my @psdata = split /\n/sx, `ps axo user,pid --no-headers`;
foreach my $pidline (@psdata) {
    $pidline =~ s/\s\s+/ /gsx;
    $pidline = trim($pidline);
    my ( $pidowner, $pid ) = split / /, $pidline;
    my ( $pidsize, $pidexe );
    open my $fh, '<', "/proc/$pid/status"
      || warn
"Warning: Process $pid died before statistics could be gathered. In most cases this is normal and can be safely ignored.\n";
    if ( fileno $fh ) {
        my %status = map {
                ( /^([^:]+):\s+(\d+)\skB/ || /^([^:]+):\s+(.+)$/ )
              ? ( $1 => $2 )
              : ()
        } <$fh>;
        close $fh || warn "Close of $fh failed";
        if ( $status{State} =~ m/zombie/i ) {
            warn "Skipping zombie process \"$status{Name}\" with PID $pid.\n";
            last;
        }
        $pidsize = $status{VmRSS};
        $pidexe  = $status{Name};
        if (defined $pidsize) {
          $sizeprocs += $pidsize;
        }
        if ( $debugoutput == 1 ) {
            print "$pid - $pidowner - $pidexe - $pidsize\n";
        }

        if ( $pidexe =~ /php/ ) {
            $numphpprocs++;
            $sizephpprocs += $pidsize;
        }
        elsif ( $pidexe =~ /imap|pop3/ ) {
            $nummailprocs++;
            $sizemailprocs += $pidsize;
        }

        if ( $pidowner =~ /root|xfs|ntp|dbus/ ) {
            $numrootprocs++;
            if (defined $pidsize) {
                $sizeprocs += $pidsize;
            }
        }
        elsif ( $pidowner =~ /nobody/ ) {
            $numwwwprocs++;
            $sizewwwprocs += $pidsize;
        }
        elsif ( $pidowner =~ /mysql/ ) {
            $nummysqlprocs++;
            $sizemysqlprocs += $pidsize;
        }
        elsif ( $pidowner =~ /mail|dovecot/ ) {
            $nummailprocs++;
            $sizemailprocs += $pidsize;
        }
        elsif ( $pidowner =~ /named/ ) {
            $numnamedprocs++;
            $sizenamedprocs += $pidsize;
        }
    }
}

if ( ( defined $mpm ) && ( $mpm !~ /worker|event|prefork/i ) ) {
    warn "Error! $mpm is not a valid value for -o.\n";
    exit 1;
}
elsif ( !defined $mpm ) {
    $mpm = getmpm();
}
$mpm = lc $mpm;

#if ( !defined $php ) {
#	$php = `which php`;
#	$php = trim($php);
#	unless ( -e $php ) {
#		warn "Error: php binary could not be located in \$PATH. Please override automatic PHP detection with -p.\n";
#		exit 1;
#	}
#};

#if ( $mpm eq "prefork" ) {
#	if (( defined $concurrency ) || ( defined $threads ) || ( defined $maxthreads ) || ( defined $minthreads ) || ( defined $threadlimit )) {
#		warn "Error! -c, -t, -x, -m, or -l are not valid with MPM prefork!\n";
#		exit 1;
#	}
#}

if ( !defined $stacksize ) {
    $stacksize = 2_097_152;
}
if ( $stacksize < 1_048_576 ) {
    warn
"Error: The chosen stack size ($stacksize) is too small and will cause Apache to behave erratically.\nPlease choose a value of at least 1MB (1048576 Bytes).\n";
    exit 1;
}

if ( !defined $modstatusurl ) {
    $modstatusurl = 'http://localhost/whm-server-status';
}

if ( !defined $arps ) {

    #$arps = get "$modstatusurl?auto";
    $arps = `curl -s $modstatusurl?auto`;
    if ( $arps !~ /ReqPerSec/ ) {
        warn
"Error: Invalid data returned from \"curl -s $modstatusurl?auto\".\nThe server is not responding as expected or you may have discovered a bug. Try overriding the whm-mod_status url with -u.\n";
        exit 1;
    }
    $arps =~ s/.*?ReqPerSec:.(.*?)\n.*/$1/gs;
    $arps = trim($arps);
    $arps = ceil($arps);
    if ( $arps <= 0 ) {
        warn
"Warning: The number of detected average requests per second ($arps) is too low to be useful. If possible please override with -r. Automatically overriding with \"-r 1\" for now.\n";
        $arps = 1;
    }
}
if   ( `df /` =~ /vzfs/ ) { $vps = 1; }
else                      { $vps = 0; }

if ( open my $cpuinfo, '<', '/proc/cpuinfo' ) {
    while (<$cpuinfo>) {
        if (m/^processor/) { $cores++ }
    }
    close $cpuinfo || warn "Failed to close $cpuinfo";
}
else {
    warn "Couldn't access /proc/cpuinfo!\n";
    $cores = 1;
}

if ( $debugoutput == 1 ) {
    print "\$vps: $vps\n";
}

if ( $debugoutput == 1 ) {
    print "\$cores: $cores\n\$php: "
      . $php
      . "\n$arps: "
      . $arps
      . "\n\$mpm: "
      . $mpm
      . "\n\$stacksize: "
      . $stacksize
      . "\n\$freemem: "
      . $freemem
      . "\n\$totalmem: "
      . $totalmem
      . "\n\$numprocs: "
      . $numprocs
      . "\n\$sizeprocs: $sizeprocs\n\$numrootprocs: "
      . $numrootprocs
      . "\n\$numwwwprocs: "
      . $numwwwprocs
      . "\n\$sizewwwprocs: $sizewwwprocs\n\$nummysqlprocs: "
      . $nummysqlprocs
      . "\n\$nummailprocs: "
      . $nummailprocs
      . "\n\$numphpprocs: "
      . $numphpprocs
      . "\n\$sizephpprocs: $sizephpprocs\n\$numnamedprocs: "
      . $numnamedprocs
      . "\n\$numotherprocs: "
      . $numotherprocs . "\n";
}

my $serverlimit = $concurrency || $cores;
my $v = log( $serverlimit * $threadlimit * ( sqrt(2) ) / $arps ) * $variability;
if ( $debugoutput == 1 ) { print "\$v: $v\n" }
my $maxclients = $serverlimit * $threadsperchild;
$maxclients = int( $maxclients + 0.5 );
my $threads_needed =
  ( ( $arps + 32 - $threadlimit ) > 0 ) ? ceil( $arps + 32 - $threadlimit ) : 0;
my $servers_needed = ceil( ( ( 32 + $threads_needed ) / 64 ) );
my $minsparethreads = 64 * $servers_needed;
my $maxsparethreads =
  ( ( $v * 96 ) < ($maxclients) ) ? ceil( $v * 96 ) : $maxclients;
$maxsparethreads = ( $maxsparethreads < 96 ) ? 96 : $maxsparethreads;
my $maxrequestsperchild = 1000;

# could be calculated using "total daily requests / daily httpd procsses", but we don't really have a way to extrapolate daily httpd processes reliably. daily requests could be extrapolated via ( $arps * 86400 ) but that's not likely to be accurate either. :\

if ( $mpm =~ /prefork/ ) {
    if ( $numwwwprocs == 0 || $sizewwwprocs == 0 ) {
      die 'Could not obtain running Apache server data!';
    }

    warn "\nMPM Prefork is generally not recommended.\n\n";
    $maxclients           = ( $freemem / ( $sizewwwprocs / $numwwwprocs ) );
    $maxclients           = int( $maxclients + 0.5 );
    $maxkeepaliverequests = int( ( $maxclients * .2 ) + .5 );
    print <<"EOF";
# Recommended Apache Config - Edit as needed:
HostnameLookups off
KeepAlive On
KeepAliveTimeout 2
MaxKeepAliveRequests $maxkeepaliverequests

MaxClients $maxclients
MinSpareServers $minsparethreads 
MaxSpareServers $maxsparethreads
MaxRequestsPerChild $maxrequestsperchild
EOF

    if ( $maxclients > 256 ) { print "ServerLimit $maxclients\n" }
}

if ( $mpm =~ /worker|event/ ) {
    if ( $mpm =~ /worker/ ) {

        #warn "\nMPM Worker is generally not recommended.\n";
        $maxkeepaliverequests = int( ( $maxclients * .20 ) + .5 );
    }
    else {
        $maxkeepaliverequests = int( ( $maxclients * .8 ) + .5 );
    }

    if ( ( $threads_needed + $threadsperchild ) > $maxclients ) {
        warn
"The number of threads needed exceeds the concurrency level selected.\nPlease examine the output and adjust accordingly.\nDO NOT USE THIS OUTPUT WITHOUT FIXING IT.\n";
    }
    $maxrequestsperchild = 0;

# MaxKeepAliveReq for event should be ~80% of $maxclients, ~%20 for worker, prefork
    print <<"EOF";

# Recommended Apache Config - Edit as needed:
HostnameLookups off
KeepAlive On
KeepAliveTimeout 2
MaxKeepAliveRequests $maxkeepaliverequests 

ServerLimit $serverlimit
MaxClients $maxclients
MinSpareThreads $minsparethreads
MaxSpareThreads $maxsparethreads
ThreadLimit $threadlimit
ThreadsPerChild $threadsperchild
ThreadStackSize $stacksize
MaxRequestsPerChild $maxrequestsperchild
EOF
}

exit 0;

__END__

=pod

=head1 NAME

apache-tuner - Command-line tool to create a guideline for Apache tuning based on current (or defined) system status

=head1 VERSION

version 0.00.01a

=head1 DESCRIPTION

apache-tuner [-o prefork|event|worker] [-c n] [-t n] [-x n] [-m n] [-l n] [-r n] [-f n] [-k n] [-s n]

=head1 USAGE

apache-tuner: Shows recommended Apache server directives for performance tuning.
Options:

    -h/--help			This message.
    -o <mpm>			Override detected MPM (Valid values are 'worker', 'event', 'prefork')
    -c <+int>			Number of Apache processes per CPU core (Default = 1)
    -f <+int>			Variability factor
    -c (concurrency)	Concurrency is the number of processes that can run 'simultaneously' on a single CPU core. 
						Use a higher number for more server connections.

=head1 REQUIRED ARGUMENTS

No Required Arguments at this time.

=head1 OPTIONS

Please see Usage.

=head1 DIAGNOSTICS

There is a diagnostic flag.

=head1 EXIT STATUS

Should always return 0.

=head1 CONFIGURATION

No Configure File. See Usage.

=head1 DEPENDENCIES

Getopt::Long, Sys::MemInfo, POSIX

=head1 INCOMPATIBILITIES

Should be run only on cPanel or PSA/Plesk servers with mod_status installed.

=head1 BUGS AND LIMITATIONS

No known bugs at this time except this is an alpha script.

=item B<-o mpm>

Override the MPM that is automatically detected from Apache.
Valid values are B<prefork>, B<worker>, and B<event>, however there are no
differences between worker and event as far as this script is concerned (yet)

=item B<-c integer>

Overrides the number of allowed processes per CPU core.

=item B<-r integer>

Overrides the detected number of requests per second. This is useful if the
current traffic stats do not reflect the norm for one reason or another.

=item B<-f integer>

-f allows overriding of the "variability factor". The default is 1, and is used in the following formula:
v = ln($serverlimit * $threadlimit * sqrt(2)/$average_requests_per_sec) * B<$variability>

A better explanation is pending. tl\;dr: maths, bell curves, statistics, etc.

Note: ln() means natural logarithm and is calculated by log() in perl.

=item B<-s integer in bytes>

Allows overriding of the default stack size, the default is 2097152 bytes (~2M)

=head1 AUTHOR

Sean C <sconnolly@hostgator.com>
Craig D <cdavis@hostgator.com>
Ryan E <regesdahl@hostgator.com>

=head1 LICENSE AND COPYRIGHT

This software is copyright (c) 2012 by HostGator <sconnolly@hostgator.com>.