#!/usr/bin/perl
# csp-stats v1.0  (c) 18.1.2019 by Andreas Ley  (u) 7.2.2025
# Read log of reports for Content Security Policy violations, show stats

my $author = 'Andreas.Ley\@kit.edu';
my $title = 'CSP Stats';

my $root = '/var/www';

use strict;

use File::Spec::Functions;
use Net::Domain 'hostfqdn';
use JSON;
use URI::Escape;
use CGI '-utf8',':standard','*table';

use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Terse = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Deepcopy = 1;
#print Data::Dumper->new([\@col2],['*'])->Indent(0)->Dump if (param('debug')>0);

my $server = $ENV{'SERVER_NAME'};
my $log = catfile($root,$server,'log','csp-report.log');
#my $servers = catfile($root,'conf','servers');
my $servers = '/etc/apache2/servers';
my $conf = catfile($root,'conf','csp');
my $blocked_filter = catfile($conf,'blocked.filter');

my @ssh = ('/usr/bin/ssh','-q','-n','-a','-k','-x','-o','BatchMode=yes');
my $cat = '/bin/cat';
my $zcat = '/bin/zcat';

my (%violated,%stats);
my $seen_query_string = 0;
my $debug;

my $violated = param('violated');
my $document = uri_unescape(scalar(param('document')));
my $blocked = uri_unescape(scalar(param('blocked')));
my $query_string = param('query-string');
my $strip_query_string = ($query_string eq 'strip');
my $full = param('full');
my $past = param('past');

my @blocked_filter;
if (open(FILTER,'<',$blocked_filter)) {
	while (<FILTER>) {
		chomp;
		s/\s*#.*$//;
		push(@blocked_filter,qr/$_/) if (length);
	}
	close(FILTER);
	$debug .= Data::Dumper->new([\@blocked_filter],['*'])->Indent(0)->Dump."\n" if (param('debug')>0);
}

sub read_log
{
	$debug .= Data::Dumper->new([\@_],['*'])->Indent(0)->Dump."\n" if (param('debug')>0);
	# open() doesn't take its direction argument from an array
	my ($dir,@cmd) = @_;

	if (open(LOG,$dir,@cmd)) {
		LINE: while (<LOG>) {
			chomp;
			$debug .= $_."\n" if (param('debug')>1);
			my $entry = decode_json($_);
			if (defined($entry->{'csp-report'})) {
				my $report = $entry->{'csp-report'};
				if (defined($report->{'document-uri'})) {
					my $document_uri = $report->{'document-uri'};
					if ($document_uri =~ /\?/) {
						$document_uri = $` if ($strip_query_string);
						$seen_query_string = 1;
					}
					next if (defined($violated) && $report->{'violated-directive'} ne $violated);
					next if (defined($document) && $document_uri ne $document);
					if (defined($report->{'blocked-uri'})) {
						my $blocked_uri = $report->{'blocked-uri'};
						if (defined($blocked)) {
							next if ($blocked_uri ne $blocked);
							$violated{$report->{'violated-directive'}}++;
							my %reduced = %{$report};
							unless ($full) {
								delete $reduced{'original-policy'};
								delete $reduced{'document-uri'};
								delete $reduced{'blocked-uri'};
								delete $reduced{'referrer'};
								delete $reduced{'disposition'} if ($report->{'disposition'} eq 'report');
								delete $reduced{'source-file'} if ($report->{'source-file'} eq $document_uri);
								delete $reduced{'status-code'} unless ($report->{'status-code'});
								delete $reduced{'script-sample'} unless (length($report->{'script-sample'}));
								#delete $reduced{'effective-directive'};
								#delete $reduced{'violated-directive'};
							}
							$stats{$entry->{'user-agent'}}{JSON->new->utf8->canonical->encode(\%reduced)}++;
						}
						else {
							for my $filter (@blocked_filter) {
								next LINE if ($blocked_uri =~ /$filter/);
							}
							$violated{$report->{'violated-directive'}}++;
							$stats{$document_uri}{$blocked_uri}++;
						}
					}
				}
			}
		}
		close(LOG);
	}
}

unless (&read_log('<',$log)) {
	print header('-type'=>'text/plain','-status'=>'500 No CSP log');
	print "$log: $!\n";
	exit;
}

if ($past) {
	&read_log('<',$log.'.1');
	if ($past>1) {
		for my $days (2..$past) {
			&read_log('-|',$zcat,$log.'.'.$days.'.gz');
		}
	}
}

if (open(SERVERS,'<',$servers)) {
	while (<SERVERS>) {
		chomp;
		s/\s*#.*$//;
		my ($host) = split;
		if (length($host) && $host ne hostfqdn()) {
			&read_log('-|',@ssh,$host,'exec',$cat,$log);
			if ($past) {
				&read_log('-|',@ssh,$host,'exec',$cat,$log.'.1');
				if ($past>1) {
					for my $days (2..$past) {
						&read_log('-|',@ssh,$host,'exec',$zcat,$log.'.'.$days.'.gz');
					}
				}
			}
		}
	}
	close(SERVERS);
}

sub link
{
	my (%param) = @_;

	my %old;
	for my $param (keys %param) {
		$old{$param} = param($param);
		if (defined($param{$param})) {
			param($param,$param{$param});
		}
		else {
			Delete($param);
		}
	}
	my $url = url('-query'=>1);
	#$url .= '?'.join('&',@param) if (@param);
	for my $param (keys %param) {
		if (defined($old{$param})) {
			param($param,$old{$param});
		}
		else {
			Delete($param);
		}
	}
	return ($url);
}

my @menu;
charset('utf-8');
print header;
print start_html({'title'=>$title.' for '.(defined($document)?$document.' blocking '.$blocked:$server),'author'=>$author,'meta'=>{'viewport'=>'width=device-width, initial-scale=1'}});
if (defined($document)) {
	push(@menu,a({'href'=>&link('document'=>undef,'blocked'=>undef,'full'=>undef),'title'=>'Show overview of all requests'},'All requests'));
	push(@menu,a({'href'=>&link('full'=>1),'title'=>'Show all report details'},'Full report')) unless ($full);
	push(@menu,a({'href'=>&link('full'=>undef),'title'=>'Hide report details of minor concern'},'Reduced report')) if ($full);
}
elsif ($seen_query_string) {
	push(@menu,a({'href'=>&link('query-string'=>'strip'),'title'=>'Strip query string from originating document URL(s) (reduces list length if provoking content is parameter-independent)'},'Strip Query-String')) unless ($strip_query_string);
	push(@menu,a({'href'=>&link('query-string'=>undef),'title'=>'No longer strip query string from originating document URL(s)'},'Show Query-String')) if ($strip_query_string);
}
push(@menu,a({'href'=>&link('past'=>undef),'title'=>"Show only today's requests"},'Today')) if ($past);
my $prefix = 'Days: ';
for my $days (1..7) {
	my $file = $log.'.'.$days;
	$file .= '.gz' if ($days>1);
	if ($past != $days && -e $file) {
		push(@menu,a({'href'=>&link('past'=>$days),'title'=>"Show today's and ".($days>1?"the last $days days'":"yesterday's")." requests"},$prefix.$days));
		$prefix = '';
	}
}
if (defined($violated)) {
		push(@menu,a({'href'=>&link('violated'=>undef),'title'=>'Show all requests (violating any directive)'},'Any directive'));
}
else {
	for my $violated (sort keys %violated) {
		push(@menu,a({'href'=>&link('violated'=>$violated),'title'=>"Show only requests violating directive $violated"},$violated));
	}
}
print code(join(' · ',@menu));
print h1($title.' for '.(defined($document)?a({'href'=>$document},code($document)).' blocking '.code($blocked):$server));

print start_table({'border'=>1});
if (defined($document)) {
	print Tr(th(['User-Agent','Report']));
}
else {
	print Tr(th(['Document','Blocked']));
}
for my $col1 (sort keys %stats) {
	my @col2 = sort keys %{$stats{$col1}};
	my $td1 = td({'valign'=>'top','rowspan'=>scalar(@col2)},defined($document)?$col1:a({'href'=>$col1},$col1));
	for my $col2 (@col2) {
		my $td2;
		if (defined($document)) {
			my $report = decode_json($col2);
			#delete($report->{'effective-directive'});
			#delete($report->{'violated-directive'});
			$td2 = join(br,map($_.': '.($_ =~ /(-uri|^referrer)$/?a({'href'=>$report->{$_}},$report->{$_}):$report->{$_}),sort keys %{$report}));
		}
		else {
			$td2 = a({'href'=>&link('document'=>uri_escape($col1),'blocked'=>uri_escape($col2))},length($col2)?$col2:em('None'));
		}
		print Tr($td1,td($td2));
		$td1 = '';
	}
}
print end_table;
unless (defined($document)) {
	print p('Originating documents link to the documents themselves; blocked URLs link to a detailed view of the blocking details (like user agents or content security policy directive contents).');
	print p(em('Keep in mind that this is automated but anyhow user-generated content, so be careful with links.'));
}
print pre($debug) if (param('debug')>0);
print end_html;
