+sub gather_loglevel_request_stats ($$) {
+ my $c = shift;
+ my $thread = shift;
+ our %stats;
+
+ $stats{requests}++;
+}
+
+sub gather_loglevel_crunch_stats ($$) {
+ my $c = shift;
+ my $thread = shift;
+ our %stats;
+
+ $stats{requests}++;
+ $stats{crunches}++;
+
+ if ($c =~ m/^Redirected:/) {
+ # Redirected: http://www.example.org/http://p.p/
+ $stats{'fast-redirections'}++;
+
+ } elsif ($c =~ m/^Blocked:/) {
+ # Blocked: blogger.googleusercontent.com:443
+ $stats{'blocked'}++;
+
+ } elsif ($c =~ m/^Connection timeout:/) {
+ # Connection timeout: http://c.tile.openstreetmap.org/18/136116/87842.png
+ $stats{'connection-timeout'}++;
+
+ } elsif ($c =~ m/^Connection failure:/) {
+ # Connection failure: http://127.0.0.1:8080/
+ $stats{'connection-failure'}++;
+ }
+}
+
+
+sub gather_loglevel_error_stats ($$) {
+
+ my $c = shift;
+ my $thread = shift;
+ our %stats;
+ our %thread_data;
+
+ if ($c =~ m/^Empty server or forwarder response received on socket \d+./) {
+
+ # Empty server or forwarder response received on socket 4.
+ $stats{'empty-responses'}++;
+ if ($thread_data{$thread}{'new_connection'}) {
+ $stats{'empty-responses-on-new-connections'}++;
+ } else {
+ $stats{'empty-responses-on-reused-connections'}++;
+ }
+ }
+}
+
+sub gather_loglevel_connect_stats ($$) {
+
+ my ($c, $thread) = @_;
+ our %thread_data;
+ our %stats;
+
+ if ($c =~ m/^via ([^\s]+) to: [^\s]+/) {
+
+ # Connect: via 10.0.0.1:8123 to: www.example.org.noconnect
+ $thread_data{$thread}{'forwarder'} = $1; # XXX: is this missue?
+
+ } elsif ($c =~ m/^to ([^\s]*)$/) {
+
+ # Connect: to lists.sourceforge.net:443
+
+ $thread_data{$thread}{'forwarder'} = 'direct connection';
+
+ } elsif ($c =~ m/^Created new connection to/) {
+
+ # Created new connection to www.privoxy.org:80 on socket 11.
+
+ $thread_data{$thread}{'new_connection'} = 1;
+
+ } elsif ($c =~ m/^Reusing server socket \d./ or
+ $c =~ m/^Found reusable socket/) {
+
+ # Reusing server socket 4. Opened for 10.0.0.1.
+ # Found reusable socket 9 for www.privoxy.org:80 in slot 0.
+
+ $thread_data{$thread}{'new_connection'} = 0;
+ $stats{'reused-connections'}++;
+
+ } elsif ($c =~ m/^Closing client socket \d+. .* Requests received: (\d+)\.$/) {
+
+ # Closing client socket 12. Keep-alive: 1. Socket alive: 1. Data available: 0. \
+ # Configuration file change detected: 0. Requests received: 14.
+
+ $stats{'client-requests-on-connection'}{$1}++;
+ $stats{'closed-client-connections'}++;
+ }
+}
+
+sub gather_loglevel_header_stats ($$) {
+
+ my ($c, $thread) = @_;
+ our %stats;
+ our %cli_options;
+
+ if ($c =~ m/^A HTTP\/1\.1 response without/ or
+ $c =~ m/^Keeping the server header 'Connection: keep-alive' around./)
+ {
+ # A HTTP/1.1 response without Connection header implies keep-alive.
+ # Keeping the server header 'Connection: keep-alive' around.
+ $stats{'server-keep-alive'}++;
+
+ } elsif ($c =~ m/^scan: ((\w+) (.+) (HTTP\/\d\.\d))/) {
+
+ # scan: HTTP/1.1 200 OK
+ $stats{'method'}{$2}++;
+ if ($cli_options{'url-statistics-threshold'} != 0) {
+ $stats{'resource'}{$3}++;
+ }
+ $stats{'http-version'}{$4}++;
+
+ } elsif ($cli_options{'host-statistics-threshold'} != 0 and
+ $c =~ m/^scan: Host: ([^\s]+)/) {
+
+ # scan: Host: p.p
+ $stats{'hosts'}{$1}++;
+ }
+}
+
+sub init_stats () {
+ our %stats = (
+ requests => 0,
+ crunches => 0,
+ 'server-keep-alive' => 0,
+ 'reused-connections' => 0,
+ 'empty-responses' => 0,
+ 'empty-responses-on-new-connections' => 0,
+ 'empty-responses-on-reused-connections' => 0,
+ 'fast-redirections' => 0,
+ 'blocked' => 0,
+ 'connection-failure' => 0,
+ 'connection-timeout' => 0,
+ 'reused-connections' => 0,
+ 'server-keep-alive' => 0,
+ 'closed-client-connections' => 0,
+ );
+ $stats{'client-requests-on-connection'}{1} = 0;
+}
+
+sub get_percentage ($$) {
+ my $big = shift;
+ my $small = shift;
+
+ # If small is 0 the percentage is always 0%.
+ # Make sure it works even if big is 0 as well.
+ return "0.00%" if ($small eq 0);
+
+ # Prevent division by zero.
+ # XXX: Is this still supposed to be reachable?
+ return "NaN" if ($big eq 0);
+
+ return sprintf("%.2f%%", $small / $big * 100);
+}
+
+sub print_stats () {
+
+ our %stats;
+ our %cli_options;
+ my $new_connections = $stats{requests} - $stats{crunches} - $stats{'reused-connections'};
+ my $outgoing_requests = $stats{requests} - $stats{crunches};
+ my $client_requests_checksum = 0;
+
+ if ($stats{requests} eq 0) {
+ print "No requests yet.\n";
+ return;
+ }
+
+ print "Client requests total: " . $stats{requests} . "\n";
+ print "Crunches: " . $stats{crunches} . " (" .
+ get_percentage($stats{requests}, $stats{crunches}) . ")\n";
+ print "Blocks: " . $stats{'blocked'} . " (" .
+ get_percentage($stats{requests}, $stats{'blocked'}) . ")\n";
+ print "Fast redirections: " . $stats{'fast-redirections'} . " (" .
+ get_percentage($stats{requests}, $stats{'fast-redirections'}) . ")\n";
+ print "Connection timeouts: " . $stats{'connection-timeout'} . " (" .
+ get_percentage($stats{requests}, $stats{'connection-timeout'}) . ")\n";
+ print "Connection failures: " . $stats{'connection-failure'} . " (" .
+ get_percentage($stats{requests}, $stats{'connection-failure'}) . ")\n";
+ print "Outgoing requests: " . $outgoing_requests . " (" .
+ get_percentage($stats{requests}, $outgoing_requests) . ")\n";
+ print "Server keep-alive offers: " . $stats{'server-keep-alive'} . " (" .
+ get_percentage($stats{requests}, $stats{'server-keep-alive'}) . ")\n";
+ print "New outgoing connections: " . $new_connections . " (" .
+ get_percentage($stats{requests}, $new_connections) . ")\n";
+ print "Reused connections: " . $stats{'reused-connections'} . " (" .
+ get_percentage($stats{requests}, $stats{'reused-connections'}) .
+ "; server offers accepted: " .
+ get_percentage($stats{'server-keep-alive'}, $stats{'reused-connections'}) . ")\n";
+ print "Empty responses: " . $stats{'empty-responses'} . " (" .
+ get_percentage($stats{requests}, $stats{'empty-responses'}) . ")\n";
+ print "Empty responses on new connections: "
+ . $stats{'empty-responses-on-new-connections'} . " (" .
+ get_percentage($stats{requests}, $stats{'empty-responses-on-new-connections'})
+ . ")\n";
+ print "Empty responses on reused connections: " .
+ $stats{'empty-responses-on-reused-connections'} . " (" .
+ get_percentage($stats{requests}, $stats{'empty-responses-on-reused-connections'}) .
+ ")\n";
+ print "Client connections: " . $stats{'closed-client-connections'} . "\n";
+
+ my $lines_printed = 0;
+ print "Client requests per connection distribution:\n";
+ foreach my $client_requests (sort {
+ $stats{'client-requests-on-connection'}{$b} <=> $stats{'client-requests-on-connection'}{$a}}
+ keys %{$stats{'client-requests-on-connection'}
+ })
+ {
+ my $count = $stats{'client-requests-on-connection'}{$client_requests};
+ $client_requests_checksum += $count * $client_requests;
+ if ($cli_options{'show-complete-request-distribution'} or ($lines_printed < 10)) {
+ printf "%8d: %d\n", $count, $client_requests;
+ $lines_printed++;
+ }
+ }
+ unless ($cli_options{'show-complete-request-distribution'}) {
+ printf "Enable --show-complete-request-distribution to get less common numbers as well.\n";
+ }
+ # Due to log rotation we may not have a complete picture for all the requests
+ printf "Improperly accounted requests: ~%d\n", abs($stats{requests} - $client_requests_checksum);
+
+ if (exists $stats{method}) {
+ print "Method distribution:\n";
+ foreach my $method (sort {$stats{'method'}{$b} <=> $stats{'method'}{$a}} keys %{$stats{'method'}}) {
+ printf "%8d : %-8s\n", $stats{'method'}{$method}, $method;
+ }
+ } else {
+ print "Method distribution unknown. No response headers parsed yet. Is 'debug 8' enabled?\n";
+ }
+ print "Client HTTP versions:\n";
+ foreach my $http_version (sort {$stats{'http-version'}{$b} <=> $stats{'http-version'}{$a}} keys %{$stats{'http-version'}}) {
+ printf "%d : %s\n", $stats{'http-version'}{$http_version}, $http_version;
+ }
+
+ if ($cli_options{'url-statistics-threshold'} == 0) {
+ print "URL statistics are disabled. Increase --url-statistics-threshold to enable them.\n";
+ } else {
+ print "Requested URLs:\n";
+ foreach my $resource (sort {$stats{'resource'}{$b} <=> $stats{'resource'}{$a}} keys %{$stats{'resource'}}) {
+ if ($stats{'resource'}{$resource} < $cli_options{'url-statistics-threshold'}) {
+ print "Skipped statistics for URLs below the treshold.\n";
+ last;
+ }
+ printf "%d : %s\n", $stats{'resource'}{$resource}, $resource;
+ }
+ }
+
+ if ($cli_options{'host-statistics-threshold'} == 0) {
+ print "Host statistics are disabled. Increase --host-statistics-threshold to enable them.\n";
+ } else {
+ print "Requested Hosts:\n";
+ foreach my $host (sort {$stats{'hosts'}{$b} <=> $stats{'hosts'}{$a}} keys %{$stats{'hosts'}}) {
+ if ($stats{'hosts'}{$host} < $cli_options{'host-statistics-threshold'}) {
+ print "Skipped statistics for Hosts below the treshold.\n";
+ last;
+ }
+ printf "%d : %s\n", $stats{'hosts'}{$host}, $host;
+ }
+ }
+}
+
+