+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'}++;
+ }
+}
+
+
+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'}++;
+ }
+}
+
+sub gather_loglevel_header_stats ($$) {
+
+ my ($c, $thread) = @_;
+ our %stats;
+
+ 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}++;
+ $stats{'resource'}{$3}++;
+ $stats{'http-version'}{$4}++;
+
+ } elsif ($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,
+ 'reused-connections' => 0,
+ 'server-keep-alive' => 0,
+ );
+}
+
+sub get_percentage ($$) {
+ my $big = shift;
+ my $small = shift;
+ 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};
+
+ 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 "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";
+
+ if ($stats{method} eq 0) {
+ print "No response lines parsed yet yet.\n";
+ return;
+ }
+ 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;
+ }
+ 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;
+ }
+ }
+}
+
+