summaryrefslogtreecommitdiff
path: root/gemfeed/examples/conf/frontends/scripts
diff options
context:
space:
mode:
authorPaul Buetow <paul@buetow.org>2025-10-02 11:28:55 +0300
committerPaul Buetow <paul@buetow.org>2025-10-02 11:28:55 +0300
commit2b034797107660d4d83f8a7acdc55d32db785b82 (patch)
tree522fb586193c8a65ca6aee42df64eecc3555f644 /gemfeed/examples/conf/frontends/scripts
parent4d7d90638186ac71067232007607f6637d560a4d (diff)
Update content for md
Diffstat (limited to 'gemfeed/examples/conf/frontends/scripts')
-rw-r--r--gemfeed/examples/conf/frontends/scripts/acme.sh.tpl68
-rw-r--r--gemfeed/examples/conf/frontends/scripts/dns-failover.ksh133
-rw-r--r--gemfeed/examples/conf/frontends/scripts/dserver-update-key-cache.sh.tpl34
-rw-r--r--gemfeed/examples/conf/frontends/scripts/fooodds.txt191
-rw-r--r--gemfeed/examples/conf/frontends/scripts/foostats.pl1910
-rw-r--r--gemfeed/examples/conf/frontends/scripts/gemtexter.sh.tpl65
-rw-r--r--gemfeed/examples/conf/frontends/scripts/rsync.sh.tpl8
-rw-r--r--gemfeed/examples/conf/frontends/scripts/taskwarrior.sh.tpl5
8 files changed, 2414 insertions, 0 deletions
diff --git a/gemfeed/examples/conf/frontends/scripts/acme.sh.tpl b/gemfeed/examples/conf/frontends/scripts/acme.sh.tpl
new file mode 100644
index 00000000..8d306092
--- /dev/null
+++ b/gemfeed/examples/conf/frontends/scripts/acme.sh.tpl
@@ -0,0 +1,68 @@
+#!/bin/sh
+
+MY_IP=`ifconfig vio0 | awk '$1 == "inet" { print $2 }'`
+
+# New hosts may not have a cert, just copy foo.zone as a
+# placeholder, so that services can at least start proprely.
+# cert will be updated with next acme-client runs!
+ensure_placeholder_cert () {
+ host=$1
+ copy_from=foo.zone
+
+ if [ ! -f /etc/ssl/$host.crt ]; then
+ cp -v /etc/ssl/$copy_from.crt /etc/ssl/$host.crt
+ cp -v /etc/ssl/$copy_from.fullchain.pem /etc/ssl/$host.fullchain.pem
+ cp -v /etc/ssl/private/$copy_from.key /etc/ssl/private/$host.key
+ fi
+}
+
+handle_cert () {
+ host=$1
+ host_ip=`host $host | awk '/has address/ { print $(NF) }'`
+
+ grep -q "^server \"$host\"" /etc/httpd.conf
+ if [ $? -ne 0 ]; then
+ echo "Host $host not configured in httpd, skipping..."
+ return
+ fi
+ ensure_placeholder_cert "$host"
+
+ if [ "$MY_IP" != "$host_ip" ]; then
+ echo "Not serving $host, skipping..."
+ return
+ fi
+
+ # Create symlink, so that relayd also can read it.
+ crt_path=/etc/ssl/$host
+ if [ -e $crt_path.crt ]; then
+ rm $crt_path.crt
+ fi
+ ln -s $crt_path.fullchain.pem $crt_path.crt
+ # Requesting and renewing certificate.
+ /usr/sbin/acme-client -v $host
+}
+
+has_update=no
+<% for my $host (@$acme_hosts) { -%>
+<% for my $prefix ('', 'www.', 'standby.') { -%>
+handle_cert <%= $prefix.$host %>
+if [ $? -eq 0 ]; then
+ has_update=yes
+fi
+<% } -%>
+<% } -%>
+
+# Current server's FQDN (e.g. for mail server certs)
+handle_cert <%= "$hostname.$domain" %>
+if [ $? -eq 0 ]; then
+ has_update=yes
+fi
+
+# Pick up the new certs.
+if [ $has_update = yes ]; then
+ # TLS offloading fully moved to relayd now
+ # /usr/sbin/rcctl reload httpd
+
+ /usr/sbin/rcctl reload relayd
+ /usr/sbin/rcctl restart smtpd
+fi
diff --git a/gemfeed/examples/conf/frontends/scripts/dns-failover.ksh b/gemfeed/examples/conf/frontends/scripts/dns-failover.ksh
new file mode 100644
index 00000000..dfc24ee3
--- /dev/null
+++ b/gemfeed/examples/conf/frontends/scripts/dns-failover.ksh
@@ -0,0 +1,133 @@
+#!/bin/ksh
+
+ZONES_DIR=/var/nsd/zones/master/
+DEFAULT_MASTER=fishfinger.buetow.org
+DEFAULT_STANDBY=blowfish.buetow.org
+
+determine_master_and_standby () {
+ local master=$DEFAULT_MASTER
+ local standby=$DEFAULT_STANDBY
+
+ # Weekly auto-failover for Let's Encrypt automation
+ local -i -r week_of_the_year=$(date +%U)
+ if [ $(( week_of_the_year % 2 )) -ne 0 ]; then
+ local tmp=$master
+ master=$standby
+ standby=$tmp
+ fi
+
+ local -i health_ok=1
+ if ! ftp -4 -o - https://$master/index.txt | grep -q "Welcome to $master"; then
+ echo "https://$master/index.txt IPv4 health check failed"
+ health_ok=0
+ elif ! ftp -6 -o - https://$master/index.txt | grep -q "Welcome to $master"; then
+ echo "https://$master/index.txt IPv6 health check failed"
+ health_ok=0
+ fi
+
+ if [ $health_ok -eq 0 ]; then
+ local tmp=$master
+ master=$standby
+ standby=$tmp
+ fi
+
+ echo "Master is $master, standby is $standby"
+
+ host $master | awk '/has address/ { print $(NF) }' >/var/nsd/run/master_a
+ host $master | awk '/has IPv6 address/ { print $(NF) }' >/var/nsd/run/master_aaaa
+ host $standby | awk '/has address/ { print $(NF) }' >/var/nsd/run/standby_a
+ host $standby | awk '/has IPv6 address/ { print $(NF) }' >/var/nsd/run/standby_aaaa
+}
+
+transform () {
+ sed -E '
+ /IN A .*; Enable failover/ {
+ /^standby/! {
+ s/^(.*) 300 IN A (.*) ; (.*)/\1 300 IN A '$(cat /var/nsd/run/master_a)' ; \3/;
+ }
+ /^standby/ {
+ s/^(.*) 300 IN A (.*) ; (.*)/\1 300 IN A '$(cat /var/nsd/run/standby_a)' ; \3/;
+ }
+ }
+ /IN AAAA .*; Enable failover/ {
+ /^standby/! {
+ s/^(.*) 300 IN AAAA (.*) ; (.*)/\1 300 IN AAAA '$(cat /var/nsd/run/master_aaaa)' ; \3/;
+ }
+ /^standby/ {
+ s/^(.*) 300 IN AAAA (.*) ; (.*)/\1 300 IN AAAA '$(cat /var/nsd/run/standby_aaaa)' ; \3/;
+ }
+ }
+ / ; serial/ {
+ s/^( +) ([0-9]+) .*; (.*)/\1 '$(date +%s)' ; \3/;
+ }
+ '
+}
+
+zone_is_ok () {
+ local -r zone=$1
+ local -r domain=${zone%.zone}
+ dig $domain @localhost | grep -q "$domain.*IN.*NS"
+}
+
+failover_zone () {
+ local -r zone_file=$1
+ local -r zone=$(basename $zone_file)
+
+ # Race condition (e.g. script execution abored in the middle previous run)
+ if [ -f $zone_file.bak ]; then
+ mv $zone_file.bak $zone_file
+ fi
+
+ cat $zone_file | transform > $zone_file.new.tmp
+
+ grep -v ' ; serial' $zone_file.new.tmp > $zone_file.new.noserial.tmp
+ grep -v ' ; serial' $zone_file > $zone_file.old.noserial.tmp
+
+ echo "Has zone $zone_file changed?"
+ if diff -u $zone_file.old.noserial.tmp $zone_file.new.noserial.tmp; then
+ echo "The zone $zone_file hasn't changed"
+ rm $zone_file.*.tmp
+ return 0
+ fi
+
+ cp $zone_file $zone_file.bak
+ mv $zone_file.new.tmp $zone_file
+ rm $zone_file.*.tmp
+ echo "Reloading nsd"
+ nsd-control reload
+
+ if ! zone_is_ok $zone; then
+ echo "Rolling back $zone_file changes"
+ cp $zone_file $zone_file.invalid
+ mv $zone_file.bak $zone_file
+ echo "Reloading nsd"
+ nsd-control reload
+ zone_is_ok $zone
+ return 3
+ fi
+
+ for cleanup in invalid bak; do
+ if [ -f $zone_file.$cleanup ]; then
+ rm $zone_file.$cleanup
+ fi
+ done
+
+ echo "Failover of zone $zone to $MASTER completed"
+ return 1
+}
+
+main () {
+ determine_master_and_standby
+
+ local -i ec=0
+ for zone_file in $ZONES_DIR/*.zone; do
+ if ! failover_zone $zone_file; then
+ ec=1
+ fi
+ done
+
+ # ec other than 0: CRON will send out an E-Mail.
+ exit $ec
+}
+
+main
diff --git a/gemfeed/examples/conf/frontends/scripts/dserver-update-key-cache.sh.tpl b/gemfeed/examples/conf/frontends/scripts/dserver-update-key-cache.sh.tpl
new file mode 100644
index 00000000..86b5ecf9
--- /dev/null
+++ b/gemfeed/examples/conf/frontends/scripts/dserver-update-key-cache.sh.tpl
@@ -0,0 +1,34 @@
+#!/bin/ksh
+
+CACHEDIR=/var/run/dserver/cache
+DSERVER_USER=_dserver
+DSERVER_GROUP=_dserver
+
+echo 'Updating SSH key cache'
+
+ls /home/ | while read remoteuser; do
+ keysfile=/home/$remoteuser/.ssh/authorized_keys
+
+ if [ -f $keysfile ]; then
+ cachefile=$CACHEDIR/$remoteuser.authorized_keys
+ echo "Caching $keysfile -> $cachefile"
+
+ cp $keysfile $cachefile
+ chown $DSERVER_USER:$DSERVER_GROUP $cachefile
+ chmod 600 $cachefile
+ fi
+done
+
+# Cleanup obsolete public SSH keys
+find $CACHEDIR -name \*.authorized_keys -type f |
+while read cachefile; do
+ remoteuser=$(basename $cachefile | cut -d. -f1)
+ keysfile=/home/$remoteuser/.ssh/authorized_keys
+
+ if [ ! -f $keysfile ]; then
+ echo 'Deleting obsolete cache file $cachefile'
+ rm $cachefile
+ fi
+done
+
+echo 'All set...'
diff --git a/gemfeed/examples/conf/frontends/scripts/fooodds.txt b/gemfeed/examples/conf/frontends/scripts/fooodds.txt
new file mode 100644
index 00000000..0e08bdd1
--- /dev/null
+++ b/gemfeed/examples/conf/frontends/scripts/fooodds.txt
@@ -0,0 +1,191 @@
+%
++
+..
+/actuator
+/actuator/health
+/admin
+/ajax
+alfacgiapi
+/ALFA_DATA
+/api
+/apply.cgi
+/ARest1.exe
+.asp
+/aspera
+/assets
+/audiobookshelf
+/auth
+/autodiscover
+/.aws
+/bac
+/back
+/backup
+/bak
+/base
+/.bash_history
+/bf
+/bin
+/bin/sh
+/bk
+/bkp
+/blog
+/blurs
+/boaform
+/boafrm
+/.bod
+/Br7q
+/british-airways
+/buetow.org.zip
+/buetow.zip
+/burodecredito
+/c
+/.cache
+/ccaguardians
+/cdn-cgi
+/centralbankthailand
+/cfdump.packetsdatabase.com
+/charlesbridge
+/check.txt
+/cimtechsolutions
+/.circleci
+/c/k2
+/ckfinder
+/client.zip
+/cloud-config.yml
+/cloudflare.com
+/clssettlement
+/cmd,/simZysh/register_main/setCookie
+/cn/cmd
+/codeberg
+/CODE_OF_CONDUCT.md
+/columbiagas
+/common_page
+/comp
+/concerto
+/config
+/config.json
+/config.xml
+/Config.xml
+/config.yaml
+/config.yml
+/connectivitycheck.gstatic.com
+/connector.sds
+/console
+/contact-information.html
+/contact-us
+/containers
+/CONTRIBUTING.md
+/credentials.txt
+/crivo
+/current_config
+/cwservices
+/daAV
+/dana-cached
+/dana-na
+/database_backup.sql
+/.database.bak
+/database.sql
+/data.zip
+/db
+/debug
+/debug.cgi
+/decoherence-is-just-realizing-this
+/demo
+/developmentserver
+/directory.gz
+/directory.tar
+/directory.zip
+/dir.html
+/DnHb
+/dns-query
+docker-compose
+/docker-compose.yml
+/?document=images
+/Dorybau2.html
+/Dorybau.html
+/dory.buetow.org
+/download
+/DpbF
+/druid
+/dtail.dev.gz
+/dtail.dev.sql
+/dtail.dev.tar.gz
+/dtail.dev.zip
+/dtail.html
+/dtail.zip
+/dump.sql
+/dvQ1
+/dvr/cmd
+/edualy-shammin
+/ekggho
+.env
+/epa
+/etc
+/eW9h
+/ews
+/F3to
+/f3Yk
+/fahrzeugtechnik.fh-joanneum.at
+/failedbythefos
+/features
+/federalhomeloanbankofdesmoines
+/fhir
+/fhir-server
+/file-manager
+/files
+/files.zip
+/firstfinancial
+/flash
+/flower
+/foostats
+/footlocker
+/foo.zip
+/foo.zone.bz2
+/foozone.webp
+/foo.zone.zip
+/form.html
+/freeze.na4u.ru
+/frontend.zip
+/ftpsync.settings
+/full_backup.zip
+/FvwmRearrange.png
+/gdb.pdf
+/geoserver
+.git
+/git-guides
+/global-protect
+/gm-donate.net
+/GMUs
+/goform
+/google.com
+/GoRU
+/GponForm
+/helpdesk
+/high-noise-level-for-that-earth-day-with-colors-gay
+/his-viewpoint-is-not-economics-until-they-harden
+/hN6p
+HNAP1
+/hp
+/_ignition
+jndi:ldap
+.js
+.lua
+microsoft.exchange
+/owa/
+.php
+/phpinfo
+phpunit
+/portal/redlion
+/_profiler
+.rar
+/RDWeb
+robots.txt
+/SDK
+/sitemap.xml
+/sites
+.sql
+/ueditor
+/vendor
+@vite
+wordpress
+/wp
diff --git a/gemfeed/examples/conf/frontends/scripts/foostats.pl b/gemfeed/examples/conf/frontends/scripts/foostats.pl
new file mode 100644
index 00000000..a440d941
--- /dev/null
+++ b/gemfeed/examples/conf/frontends/scripts/foostats.pl
@@ -0,0 +1,1910 @@
+#!/usr/bin/perl
+
+use v5.38;
+
+# Those are enabled automatically now w/ this version of Perl
+# use strict;
+# use warnings;
+
+use builtin qw(true false);
+use experimental qw(builtin);
+
+use feature qw(refaliasing);
+no warnings qw(experimental::refaliasing);
+
+# Debugging aids like diagnostics are noisy in production.
+# Removed per review: enable locally when debugging only.
+
+use constant VERSION => 'v0.1.0';
+
+# Package: FileHelper — small file/JSON helpers
+# - Purpose: Atomic writes, gzip JSON read/write, and line reading.
+# - Notes: Dies on I/O errors; JSON encoding uses core JSON.
+package FileHelper {
+ use JSON;
+
+ # Sub: write
+ # - Purpose: Atomic write to a file via "$path.tmp" and rename.
+ # - Params: $path (str) destination; $content (str) contents to write.
+ # - Return: undef; dies on failure.
+ sub write ($path, $content) {
+ open my $fh, '>', "$path.tmp" or die "\nCannot open file: $!";
+ print $fh $content;
+ close $fh;
+ rename "$path.tmp", $path;
+ }
+
+ # Sub: write_json_gz
+ # - Purpose: JSON-encode $data and write it gzipped atomically.
+ # - Params: $path (str) destination path; $data (ref/scalar) Perl data.
+ # - Return: undef; dies on failure.
+ sub write_json_gz ($path, $data) {
+ my $json = encode_json $data;
+
+ say "Writing $path";
+ open my $fd, '>:gzip', "$path.tmp" or die "$path.tmp: $!";
+ print $fd $json;
+ close $fd;
+
+ rename "$path.tmp", $path or die "$path.tmp: $!";
+ }
+
+ # Sub: read_json_gz
+ # - Purpose: Read a gzipped JSON file and decode to Perl data.
+ # - Params: $path (str) path to .json.gz file.
+ # - Return: Perl data structure.
+ sub read_json_gz ($path) {
+ say "Reading $path";
+ open my $fd, '<:gzip', $path or die "$path: $!";
+ my $json = decode_json <$fd>;
+ close $fd;
+ return $json;
+ }
+
+ # Sub: read_lines
+ # - Purpose: Slurp file lines and chomp newlines.
+ # - Params: $path (str) file path.
+ # - Return: list of lines (no trailing newlines).
+ sub read_lines ($path) {
+ my @lines;
+ open(my $fh, '<', $path) or die "$path: $!";
+ chomp(@lines = <$fh>);
+ close($fh);
+ return @lines;
+ }
+}
+
+# Package: DateHelper — date range helpers
+# - Purpose: Produce date strings used for report windows.
+# - Format: Dates are returned as YYYYMMDD strings.
+package DateHelper {
+ use Time::Piece;
+
+ # Sub: last_month_dates
+ # - Purpose: Return dates for today back to 30 days ago (inclusive).
+ # - Params: none.
+ # - Return: list of YYYYMMDD strings, newest first.
+ sub last_month_dates () {
+ my $today = localtime;
+ my @dates;
+
+ for my $days_ago (1 .. 31) {
+ my $date = $today - ($days_ago * 24 * 60 * 60);
+ push @dates, $date->strftime('%Y%m%d');
+ }
+
+ return @dates;
+ }
+
+}
+
+# Package: Foostats::Logreader — parse and normalize logs
+# - Purpose: Read web and gemini logs, anonymize IPs, and emit normalized events.
+# - Output Event: { proto, host, ip_hash, ip_proto, date, time, uri_path, status }
+package Foostats::Logreader {
+ use Digest::SHA3 'sha3_512_base64';
+ use File::stat;
+ use PerlIO::gzip;
+ use Time::Piece;
+ use String::Util qw(contains startswith endswith);
+
+ # Make log locations configurable (env overrides) to enable testing.
+ # Sub: gemini_logs_glob
+ # - Purpose: Glob for gemini-related logs; env override for testing.
+ # - Return: glob pattern string.
+ sub gemini_logs_glob { $ENV{FOOSTATS_GEMINI_LOGS_GLOB} // '/var/log/daemon*' }
+
+ # Sub: web_logs_glob
+ # - Purpose: Glob for web access logs; env override for testing.
+ # - Return: glob pattern string.
+ sub web_logs_glob { $ENV{FOOSTATS_WEB_LOGS_GLOB} // '/var/www/logs/access.log*' }
+
+ # Sub: anonymize_ip
+ # - Purpose: Classify IPv4/IPv6 and map IP to a stable SHA3-512 base64 hash.
+ # - Params: $ip (str) source IP.
+ # - Return: ($hash, $proto) where $proto is 'IPv4' or 'IPv6'.
+ sub anonymize_ip ($ip) {
+ my $ip_proto = contains($ip, ':') ? 'IPv6' : 'IPv4';
+ my $ip_hash = sha3_512_base64 $ip;
+ return ($ip_hash, $ip_proto);
+ }
+
+ # Sub: read_lines
+ # - Purpose: Iterate files matching glob by age; invoke $cb for each line.
+ # - Params: $glob (str) file glob; $cb (code) callback ($year, @fields).
+ # - Return: undef; stops early if callback returns undef for a file.
+ sub read_lines ($glob, $cb) {
+ my sub year ($path) {
+ localtime((stat $path)->mtime)->strftime('%Y');
+ }
+
+ my sub open_file ($path) {
+ my $flag = $path =~ /\.gz$/ ? '<:gzip' : '<';
+ open my $fd, $flag, $path or die "$path: $!";
+ return $fd;
+ }
+
+ my $last = false;
+ say 'File path glob matches: ' . join(' ', glob $glob);
+
+ LAST:
+ for my $path (sort { -M $a <=> -M $b } glob $glob) {
+ say "Processing $path";
+
+ my $file = open_file $path;
+ my $year = year $file;
+
+ while (<$file>) {
+ next if contains($_, 'logfile turned over');
+
+ # last == true means: After this file, don't process more
+ $last = true unless defined $cb->($year, split / +/);
+ }
+
+ say "Closing $path (last:$last)";
+ close $file;
+ last LAST if $last;
+ }
+ }
+
+ # Sub: parse_web_logs
+ # - Purpose: Parse web log lines into normalized events and pass to callback.
+ # - Params: $last_processed_date (YYYYMMDD int) lower bound; $cb (code) event consumer.
+ # - Return: undef.
+ sub parse_web_logs ($last_processed_date, $cb) {
+ my sub parse_date ($date) {
+ my $t = Time::Piece->strptime($date, '[%d/%b/%Y:%H:%M:%S');
+ return ($t->strftime('%Y%m%d'), $t->strftime('%H%M%S'));
+ }
+
+ my sub parse_web_line (@line) {
+ my ($date, $time) = parse_date $line [4];
+ return undef if $date < $last_processed_date;
+
+ # X-Forwarded-For?
+ my $ip = $line[-2] eq '-' ? $line[1] : $line[-2];
+ my ($ip_hash, $ip_proto) = anonymize_ip $ip;
+
+ return {
+ proto => 'web',
+ host => $line[0],
+ ip_hash => $ip_hash,
+ ip_proto => $ip_proto,
+ date => $date,
+ time => $time,
+ uri_path => $line[7],
+ status => $line[9],
+ };
+ }
+
+ read_lines web_logs_glob(), sub ($year, @line) {
+ $cb->(parse_web_line @line);
+ };
+ }
+
+ # Sub: parse_gemini_logs
+ # - Purpose: Parse vger/relayd lines, merge paired entries, and emit events.
+ # - Params: $last_processed_date (YYYYMMDD int); $cb (code) event consumer.
+ # - Return: undef.
+ sub parse_gemini_logs ($last_processed_date, $cb) {
+ my sub parse_date ($year, @line) {
+ my $timestr = "$line[0] $line[1]";
+ return Time::Piece->strptime($timestr, '%b %d')->strftime("$year%m%d");
+ }
+
+ my sub parse_vger_line ($year, @line) {
+ my $full_path = $line[5];
+ $full_path =~ s/"//g;
+ my ($proto, undef, $host, $uri_path) = split '/', $full_path, 4;
+ $uri_path = '' unless defined $uri_path;
+
+ return {
+ proto => 'gemini',
+ host => $host,
+ uri_path => "/$uri_path",
+ status => $line[6],
+ date => int(parse_date($year, @line)),
+ time => $line[2],
+ };
+ }
+
+ my sub parse_relayd_line ($year, @line) {
+ my $date = int(parse_date($year, @line));
+
+ my ($ip_hash, $ip_proto) = anonymize_ip $line [12];
+ return {
+ ip_hash => $ip_hash,
+ ip_proto => $ip_proto,
+ date => $date,
+ time => $line[2],
+ };
+ }
+
+ # Expect one vger and one relayd log line per event! So collect
+ # both events (one from one log line each) and then merge the result hash!
+ my ($vger, $relayd);
+ read_lines gemini_logs_glob(), sub ($year, @line) {
+ if ($line[4] eq 'vger:') {
+ $vger = parse_vger_line $year, @line;
+ }
+ elsif ($line[5] eq 'relay' and startswith($line[6], 'gemini')) {
+ $relayd = parse_relayd_line $year, @line;
+ return undef
+ if $relayd->{date} < $last_processed_date;
+ }
+
+ if (defined $vger and defined $relayd and $vger->{time} eq $relayd->{time}) {
+ $cb->({ %$vger, %$relayd });
+ $vger = $relayd = undef;
+ }
+
+ true;
+ };
+ }
+
+ # Sub: parse_logs
+ # - Purpose: Coordinate parsing for both web and gemini, aggregating into stats.
+ # - Params: $last_web_date, $last_gemini_date (YYYYMMDD int), $odds_file, $odds_log.
+ # - Return: stats hashref keyed by "proto_YYYYMMDD".
+ sub parse_logs ($last_web_date, $last_gemini_date, $odds_file, $odds_log) {
+ my $agg = Foostats::Aggregator->new($odds_file, $odds_log);
+
+ say "Last web date: $last_web_date";
+ say "Last gemini date: $last_gemini_date";
+
+ parse_web_logs $last_web_date, sub ($event) {
+ $agg->add($event);
+ };
+ parse_gemini_logs $last_gemini_date, sub ($event) {
+ $agg->add($event);
+ };
+
+ return $agg->{stats};
+ }
+}
+
+# Package: Foostats::Filter — request filtering and logging
+# - Purpose: Identify odd URI patterns and excessive requests per second per IP.
+# - Notes: Maintains an in-process blocklist for the current run.
+package Foostats::Filter {
+ use String::Util qw(contains startswith endswith);
+
+ # Sub: new
+ # - Purpose: Construct a filter with odd patterns and a log path.
+ # - Params: $odds_file (str) pattern list; $log_path (str) append-only log file.
+ # - Return: blessed Foostats::Filter instance.
+ sub new ($class, $odds_file, $log_path) {
+ say "Logging filter to $log_path";
+ my @odds = FileHelper::read_lines($odds_file);
+ bless { odds => \@odds, log_path => $log_path }, $class;
+ }
+
+ # Sub: ok
+ # - Purpose: Check if an event passes filters; updates block state/logging.
+ # - Params: $event (hashref) normalized request.
+ # - Return: true if allowed; false if blocked.
+ sub ok ($self, $event) {
+ state %blocked = ();
+ return false if exists $blocked{ $event->{ip_hash} };
+
+ if ($self->odd($event) or $self->excessive($event)) {
+ ($blocked{ $event->{ip_hash} } //= 0)++;
+ return false;
+ }
+ else {
+ return true;
+ }
+ }
+
+ # Sub: odd
+ # - Purpose: Match URI path against user-provided odd patterns (substring match).
+ # - Params: $event (hashref) with uri_path.
+ # - Return: true if odd (blocked), false otherwise.
+ sub odd ($self, $event) {
+ \my $uri_path = \$event->{uri_path};
+
+ for ($self->{odds}->@*) {
+ next if !defined $_ || $_ eq '' || /^\s*#/;
+ next unless contains($uri_path, $_);
+ $self->log('WARN', $uri_path, "contains $_ and is odd and will therefore be blocked!");
+ return true;
+ }
+
+ $self->log('OK', $uri_path, "appears fine...");
+ return false;
+ }
+
+ # Sub: log
+ # - Purpose: Deduplicated append-only logging for filter decisions.
+ # - Params: $severity (OK|WARN), $subject (str), $message (str).
+ # - Return: undef.
+ sub log ($self, $severity, $subject, $message) {
+ state %dedup;
+
+ # Don't log if path was already logged
+ return if exists $dedup{$subject};
+ $dedup{$subject} = 1;
+
+ open(my $fh, '>>', $self->{log_path}) or die $self->{log_path} . ": $!";
+ print $fh "$severity: $subject $message\n";
+ close($fh);
+ }
+
+ # Sub: excessive
+ # - Purpose: Block if an IP makes more than one request within the same second.
+ # - Params: $event (hashref) with time and ip_hash.
+ # - Return: true if blocked; false otherwise.
+ sub excessive ($self, $event) {
+ \my $time = \$event->{time};
+ \my $ip_hash = \$event->{ip_hash};
+
+ state $last_time = $time; # Time with second: 'HH:MM:SS'
+ state %count = (); # IPs accessing within the same second!
+
+ if ($last_time ne $time) {
+ $last_time = $time;
+ %count = ();
+ return false;
+ }
+
+ # IP requested site more than once within the same second!?
+ if (1 < ++($count{$ip_hash} //= 0)) {
+ $self->log('WARN', $ip_hash, "blocked due to excessive requesting...");
+ return true;
+ }
+
+ return false;
+ }
+}
+
+# Package: Foostats::Aggregator — in-memory stats builder
+# - Purpose: Apply filters and accumulate counts, unique IPs per feed/page.
+package Foostats::Aggregator {
+ use String::Util qw(contains startswith endswith);
+
+ use constant {
+ ATOM_FEED_URI => '/gemfeed/atom.xml',
+ GEMFEED_URI => '/gemfeed/index.gmi',
+ GEMFEED_URI_2 => '/gemfeed/',
+ };
+
+ # Sub: new
+ # - Purpose: Construct aggregator with a filter and empty stats store.
+ # - Params: $odds_file (str), $odds_log (str).
+ # - Return: Foostats::Aggregator instance.
+ sub new ($class, $odds_file, $odds_log) {
+ bless { filter => Foostats::Filter->new($odds_file, $odds_log), stats => {} }, $class;
+ }
+
+ # Sub: add
+ # - Purpose: Apply filter, update counts and unique-IP sets, and return event.
+ # - Params: $event (hashref) normalized event; ignored if undef.
+ # - Return: $event; filtered events increment filtered count only.
+ sub add ($self, $event) {
+ return undef unless defined $event;
+
+ my $date = $event->{date};
+ my $date_key = $event->{proto} . "_$date";
+
+ # Stats data model per protocol+day (key: "proto_YYYYMMDD"):
+ # - count: per-proto request count, per IP version, and filtered count
+ # - feed_ips: unique IPs per feed type (atom_feed, gemfeed)
+ # - page_ips: unique IPs per host and per URL
+ $self->{stats}{$date_key} //= {
+ count => { filtered => 0, },
+ feed_ips => {
+ atom_feed => {},
+ gemfeed => {},
+ },
+ page_ips => {
+ hosts => {},
+ urls => {},
+ },
+ };
+
+ \my $s = \$self->{stats}{$date_key};
+ unless ($self->{filter}->ok($event)) {
+ $s->{count}{filtered}++;
+ return $event;
+ }
+
+ $self->add_count($s, $event);
+ $self->add_page_ips($s, $event) unless $self->add_feed_ips($s, $event);
+ return $event;
+ }
+
+ # Sub: add_count
+ # - Purpose: Increment totals by protocol and IP version.
+ # - Params: $stats (hashref) date bucket; $event (hashref).
+ # - Return: undef.
+ sub add_count ($self, $stats, $event) {
+ \my $c = \$stats->{count};
+ \my $e = \$event;
+
+ ($c->{ $e->{proto} } //= 0)++;
+ ($c->{ $e->{ip_proto} } //= 0)++;
+ }
+
+ # Sub: add_feed_ips
+ # - Purpose: If event hits feed endpoints, add unique IP and short-circuit.
+ # - Params: $stats (hashref), $event (hashref).
+ # - Return: 1 if feed matched; 0 otherwise.
+ sub add_feed_ips ($self, $stats, $event) {
+ \my $f = \$stats->{feed_ips};
+ \my $e = \$event;
+
+ # Atom feed (exact path match, allow optional query string)
+ if ($e->{uri_path} =~ m{^/gemfeed/atom\.xml(?:[?#].*)?$}) {
+ ($f->{atom_feed}->{ $e->{ip_hash} } //= 0)++;
+ return 1;
+ }
+
+ # Gemfeed index: '/gemfeed/' or '/gemfeed/index.gmi' (optionally with query)
+ if ($e->{uri_path} =~ m{^/gemfeed/(?:index\.gmi)?(?:[?#].*)?$}) {
+ ($f->{gemfeed}->{ $e->{ip_hash} } //= 0)++;
+ return 1;
+ }
+
+ return 0;
+ }
+
+ # Sub: add_page_ips
+ # - Purpose: Track unique IPs per host and per URL for .html/.gmi pages.
+ # - Params: $stats (hashref), $event (hashref).
+ # - Return: undef.
+ sub add_page_ips ($self, $stats, $event) {
+ \my $e = \$event;
+ \my $p = \$stats->{page_ips};
+
+ return if !endswith($e->{uri_path}, '.html') && !endswith($e->{uri_path}, '.gmi');
+
+ ($p->{hosts}->{ $e->{host} }->{ $e->{ip_hash} } //= 0)++;
+ ($p->{urls}->{ $e->{host} . $e->{uri_path} }->{ $e->{ip_hash} } //= 0)++;
+ }
+}
+
+# Package: Foostats::FileOutputter — write per-day stats to disk
+# - Purpose: Persist aggregated stats to gzipped JSON files under a stats dir.
+package Foostats::FileOutputter {
+ use JSON;
+ use Sys::Hostname;
+ use PerlIO::gzip;
+
+ # Sub: new
+ # - Purpose: Create outputter with stats_dir; ensures directory exists.
+ # - Params: %args (hash) must include stats_dir.
+ # - Return: Foostats::FileOutputter instance.
+ sub new ($class, %args) {
+ my $self = bless \%args, $class;
+ mkdir $self->{stats_dir} or die $self->{stats_dir} . ": $!" unless -d $self->{stats_dir};
+ return $self;
+ }
+
+ # Sub: last_processed_date
+ # - Purpose: Determine the most recent processed date for a protocol for this host.
+ # - Params: $proto (str) 'web' or 'gemini'.
+ # - Return: YYYYMMDD int (0 if none found).
+ sub last_processed_date ($self, $proto) {
+ my $hostname = hostname();
+ my @processed = glob $self->{stats_dir} . "/${proto}_????????.$hostname.json.gz";
+ my ($date) = @processed ? ($processed[-1] =~ /_(\d{8})\.$hostname\.json.gz/) : 0;
+ return int($date);
+ }
+
+ # Sub: write
+ # - Purpose: Write one gzipped JSON file per date bucket to stats_dir.
+ # - Params: none (uses $self->{stats}).
+ # - Return: undef.
+ sub write ($self) {
+ $self->for_dates(
+ sub ($self, $date_key, $stats) {
+ my $hostname = hostname();
+ my $path = $self->{stats_dir} . "/${date_key}.$hostname.json.gz";
+ FileHelper::write_json_gz $path, $stats;
+ }
+ );
+ }
+
+ # Sub: for_dates
+ # - Purpose: Iterate date-keyed stats in sorted order and call $cb.
+ # - Params: $cb (code) receives ($self, $date_key, $stats).
+ # - Return: undef.
+ sub for_dates ($self, $cb) {
+ $cb->($self, $_, $self->{stats}{$_}) for sort keys $self->{stats}->%*;
+ }
+}
+
+# Package: Foostats::Replicator — pull partner stats files over HTTP(S)
+# - Purpose: Fetch recent partner node stats into local stats dir.
+package Foostats::Replicator {
+ use JSON;
+ use File::Basename;
+ use LWP::UserAgent;
+ use String::Util qw(endswith);
+
+ # Sub: replicate
+ # - Purpose: For each proto and last 31 days, replicate newest files.
+ # - Params: $stats_dir (str) local dir; $partner_node (str) hostname.
+ # - Return: undef (best-effort fetches).
+ sub replicate ($stats_dir, $partner_node) {
+ say "Replicating from $partner_node";
+
+ for my $proto (qw(gemini web)) {
+ my $count = 0;
+
+ for my $date (DateHelper::last_month_dates) {
+ my $file_base = "${proto}_${date}";
+ my $dest_path = "${file_base}.$partner_node.json.gz";
+
+ replicate_file(
+ "https://$partner_node/foostats/$dest_path",
+ "$stats_dir/$dest_path",
+ $count++ < 3, # Always replicate the newest 3 files.
+ );
+ }
+ }
+ }
+
+ # Sub: replicate_file
+ # - Purpose: Download a single URL to a destination unless already present (unless forced).
+ # - Params: $remote_url (str) source; $dest_path (str) destination; $force (bool/int).
+ # - Return: undef; logs failures.
+ sub replicate_file ($remote_url, $dest_path, $force) {
+
+ # $dest_path already exists, not replicating it
+ return if !$force && -f $dest_path;
+
+ say "Replicating $remote_url to $dest_path (force:$force)... ";
+ my $response = LWP::UserAgent->new->get($remote_url);
+ unless ($response->is_success) {
+