diff options
Diffstat (limited to 'gemfeed/examples/conf/frontends/scripts')
8 files changed, 0 insertions, 2414 deletions
diff --git a/gemfeed/examples/conf/frontends/scripts/acme.sh.tpl b/gemfeed/examples/conf/frontends/scripts/acme.sh.tpl deleted file mode 100644 index 8d306092..00000000 --- a/gemfeed/examples/conf/frontends/scripts/acme.sh.tpl +++ /dev/null @@ -1,68 +0,0 @@ -#!/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 deleted file mode 100644 index dfc24ee3..00000000 --- a/gemfeed/examples/conf/frontends/scripts/dns-failover.ksh +++ /dev/null @@ -1,133 +0,0 @@ -#!/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 deleted file mode 100644 index 86b5ecf9..00000000 --- a/gemfeed/examples/conf/frontends/scripts/dserver-update-key-cache.sh.tpl +++ /dev/null @@ -1,34 +0,0 @@ -#!/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 deleted file mode 100644 index 0e08bdd1..00000000 --- a/gemfeed/examples/conf/frontends/scripts/fooodds.txt +++ /dev/null @@ -1,191 +0,0 @@ -% -+ -.. -/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 deleted file mode 100644 index a440d941..00000000 --- a/gemfeed/examples/conf/frontends/scripts/foostats.pl +++ /dev/null @@ -1,1910 +0,0 @@ -#!/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) { - say "\nFailed to fetch the file: " . $response->status_line; - return; - } - - FileHelper::write $dest_path, $response->decoded_content; - say 'done'; - } -} - -# Package: Foostats::Merger — merge per-host daily stats into a single view -# - Purpose: Merge multiple node files per day into totals and unique counts. -package Foostats::Merger { - - # Sub: merge - # - Purpose: Produce merged stats for the last month (date => stats hashref). - # - Params: $stats_dir (str) directory with daily gz JSON files. - # - Return: hash (not ref) of date => merged stats. - sub merge ($stats_dir) { - my %merge; - $merge{$_} = merge_for_date($stats_dir, $_) for DateHelper::last_month_dates; - return %merge; - } - - # Sub: merge_for_date - # - Purpose: Merge all node files for a specific date into one stats hashref. - # - Params: $stats_dir (st |