diff options
| author | Paul Buetow <paul@buetow.org> | 2025-10-02 11:28:55 +0300 |
|---|---|---|
| committer | Paul Buetow <paul@buetow.org> | 2025-10-02 11:28:55 +0300 |
| commit | 2b034797107660d4d83f8a7acdc55d32db785b82 (patch) | |
| tree | 522fb586193c8a65ca6aee42df64eecc3555f644 /gemfeed/examples/conf/frontends/scripts | |
| parent | 4d7d90638186ac71067232007607f6637d560a4d (diff) | |
Update content for md
Diffstat (limited to 'gemfeed/examples/conf/frontends/scripts')
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) { + |
