diff options
Diffstat (limited to 'frontends/scripts')
| -rw-r--r-- | frontends/scripts/foostats.pl | 1209 |
1 files changed, 758 insertions, 451 deletions
diff --git a/frontends/scripts/foostats.pl b/frontends/scripts/foostats.pl index 235da02..e6ef1c5 100644 --- a/frontends/scripts/foostats.pl +++ b/frontends/scripts/foostats.pl @@ -12,8 +12,8 @@ use experimental qw(builtin); use feature qw(refaliasing); no warnings qw(experimental::refaliasing); -# TODO: UNDO -use diagnostics; +# Debugging aids like diagnostics are noisy in production. +# Removed per review: enable locally when debugging only. use constant VERSION => 'v0.1.0'; @@ -24,86 +24,101 @@ use constant VERSION => 'v0.1.0'; # * Nicely formatted .txt output by stats by count by date # * Print out all UAs, to add new excludes/blocked IPs +# 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 ( $path, $content ) { + # 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: $!"; + or die "\nCannot open file: $!"; print $fh $content; close $fh; rename - "$path.tmp", - $path; + "$path.tmp", + $path; } - sub write_json_gz ( $path, $data ) { + # 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: $!"; + or die "$path.tmp: $!"; print $fd $json; close $fd; rename "$path.tmp", $path - or die "$path.tmp: $!"; + 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: $!"; + 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> ); + 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 ( 0 .. 30 ) { - my $date = $today - ( $days_ago * 24 * 60 * 60 ); + for my $days_ago (0 .. 30) { + my $date = $today - ($days_ago * 24 * 60 * 60); push - @dates, - $date->strftime('%Y%m%d'); + @dates, + $date->strftime('%Y%m%d'); } return @dates; } - sub last_n_months_day_dates ($months) { - my $today = localtime; - my $start_year = $today->year; - my $start_month = $today->mon - $months; - while ($start_month <= 0) { $start_month += 12; $start_year--; } - - my $start = Time::Piece->strptime(sprintf('%04d-%02d-01', $start_year, $start_month), '%Y-%m-%d'); - my @dates; - my $t = $start; - while ($t <= $today) { - push @dates, $t->strftime('%Y%m%d'); - $t += 24 * 60 * 60; # one day - } - 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; @@ -111,41 +126,54 @@ package Foostats::Logreader { use Time::Piece; use String::Util qw(contains startswith endswith); - use constant { - GEMINI_LOGS_GLOB => '/var/log/daemon*', - WEB_LOGS_GLOB => '/var/www/logs/access.log*', - }; - + # 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'; + contains($ip, ':') + ? 'IPv6' + : 'IPv4'; my $ip_hash = sha3_512_base64 $ip; - return ( $ip_hash, $ip_proto ); + return ($ip_hash, $ip_proto); } - sub read_lines ( $glob, $cb ) { + # 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'); + localtime((stat $path)->mtime)->strftime('%Y'); } my sub open_file ($path) { my $flag = - $path =~ /\.gz$/ - ? '<:gzip' - : '<'; + $path =~ /\.gz$/ + ? '<:gzip' + : '<'; open my $fd, $flag, $path - or die "$path: $!"; + or die "$path: $!"; return $fd; } my $last = false; - say 'File path glob matches: ' . join( ' ', glob $glob ); + say 'File path glob matches: ' . join(' ', glob $glob); - LAST: - for my $path ( sort { -M $a <=> -M $b } glob $glob ) { + LAST: + for my $path (sort { -M $a <=> -M $b } glob $glob) { say "Processing $path"; my $file = open_file $path; @@ -153,37 +181,41 @@ package Foostats::Logreader { while (<$file>) { next - if contains( $_, 'logfile turned over' ); + if contains($_, 'logfile turned over'); # last == true means: After this file, don't process more $last = true - unless defined $cb->( $year, split / +/ ); + unless defined $cb->($year, split / +/); } say "Closing $path (last:$last)"; close $file; last LAST - if $last; + if $last; } } - sub parse_web_logs ( $last_processed_date, $cb ) { + # 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 $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]; + my ($date, $time) = parse_date $line [4]; return undef - if $date < $last_processed_date; + 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; + $line[-2] eq '-' + ? $line[1] + : $line[-2]; + my ($ip_hash, $ip_proto) = anonymize_ip $ip; return { proto => 'web', @@ -197,42 +229,45 @@ package Foostats::Logreader { }; } - read_lines WEB_LOGS_GLOB, sub ( $year, @line ) { - $cb->( parse_web_line @line ); + read_lines web_logs_glob(), sub ($year, @line) { + $cb->(parse_web_line @line); }; } - sub parse_gemini_logs ( $last_processed_date, $cb ) { - my sub parse_date ( $year, @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"); + return Time::Piece->strptime($timestr, '%b %d')->strftime("$year%m%d"); } - my sub parse_vger_line ( $year, @line ) { + 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; + my ($proto, undef, $host, $uri_path) = + split '/', + $full_path, + 4; $uri_path = '' - unless defined $uri_path; + unless defined $uri_path; return { proto => 'gemini', host => $host, uri_path => "/$uri_path", status => $line[6], - date => int( parse_date( $year, @line ) ), + date => int(parse_date($year, @line)), time => $line[2], }; } - my sub parse_relayd_line ( $year, @line ) { - my $date = int( parse_date( $year, @line ) ); + my sub parse_relayd_line ($year, @line) { + my $date = int(parse_date($year, @line)); - my ( $ip_hash, $ip_proto ) = anonymize_ip $line [12]; + my ($ip_hash, $ip_proto) = anonymize_ip $line [12]; return { ip_hash => $ip_hash, ip_proto => $ip_proto, @@ -241,26 +276,26 @@ package Foostats::Logreader { }; } - # 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:' ) { + # 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' ) ) + 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 $relayd->{date} < $last_processed_date; } if ( defined $vger and defined $relayd - and $vger->{time} eq $relayd->{time} ) + and $vger->{time} eq $relayd->{time}) { - $cb->( { %$vger, %$relayd } ); + $cb->({ %$vger, %$relayd }); $vger = $relayd = undef; } @@ -268,9 +303,12 @@ package Foostats::Logreader { }; } - sub parse_logs ( $last_web_date, $last_gemini_date, $odds_file, $odds_log ) - { - my $agg = Foostats::Aggregator->new( $odds_file, $odds_log ); + # 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"; @@ -287,29 +325,40 @@ package Foostats::Logreader { } # TODO: Write filter summary at the end of the filter log. +# 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 ( $class, $odds_file, $log_path ) { + # 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; + }, + $class; } - sub ok ( $self, $event ) { + # 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 exists $blocked{ $event->{ip_hash} }; if ( $self->odd($event) - or $self->excessive($event) ) + or $self->excessive($event)) { - ( $blocked{ $event->{ip_hash} } //= 0 )++; + ($blocked{ $event->{ip_hash} } //= 0)++; return false; } else { @@ -317,53 +366,64 @@ package Foostats::Filter { } } - sub odd ( $self, $event ) { + # 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}->@* ) { + for ($self->{odds}->@*) { + next if !defined $_ || $_ eq '' || /^\s*#/; next - unless contains( $uri_path, $_ ); + unless contains($uri_path, $_); - $self->log( 'WARN', $uri_path, - "contains $_ and is odd and will therefore be blocked!" ); + $self->log('WARN', $uri_path, "contains $_ and is odd and will therefore be blocked!"); return true; } - $self->log( 'OK', $uri_path, "appears fine..." ); + $self->log('OK', $uri_path, "appears fine..."); return false; } - sub log ( $self, $severity, $subject, $message ) { + # 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}; + if exists $dedup{$subject}; $dedup{$subject} = 1; - open( my $fh, '>>', $self->{log_path} ) - or die $self->{log_path} . ": $!"; + open(my $fh, '>>', $self->{log_path}) + or die $self->{log_path} . ": $!"; print $fh "$severity: $subject $message\n"; close($fh); } - sub excessive ( $self, $event ) { + # 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 ) { + 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..." ); + if (1 < ++($count{$ip_hash} //= 0)) { + $self->log('WARN', $ip_hash, "blocked due to excessive requesting..."); return true; } @@ -371,6 +431,8 @@ package Foostats::Filter { } } +# 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); @@ -380,140 +442,185 @@ package Foostats::Aggregator { GEMFEED_URI_2 => '/gemfeed/', }; - sub new ( $class, $odds_file, $odds_log ) { + # 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 ), + filter => Foostats::Filter->new($odds_file, $odds_log), stats => {} - }, - $class; + }, + $class; } - sub add ( $self, $event ) { + # 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; + 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 - }, + count => { filtered => 0, }, feed_ips => { atom_feed => {}, - gemfeed => {} + gemfeed => {}, }, page_ips => { hosts => {}, - urls => {} + urls => {}, }, }; \my $s = \$self->{stats}{$date_key}; - unless ( $self->{filter}->ok($event) ) { + 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 ); + $self->add_count($s, $event); + $self->add_page_ips($s, $event) + unless $self->add_feed_ips($s, $event); return $event; } - sub add_count ( $self, $stats, $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 )++; + ($c->{ $e->{proto} } //= 0)++; + ($c->{ $e->{ip_proto} } //= 0)++; } - sub add_feed_ips ( $self, $stats, $event ) { + # 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; - if ( endswith( $e->{uri_path}, ATOM_FEED_URI ) ) { - ( $f->{atom_feed}->{ $e->{ip_hash} } //= 0 )++; - } - elsif ( contains( $e->{uri_path}, GEMFEED_URI ) ) { - ( $f->{gemfeed}->{ $e->{ip_hash} } //= 0 )++; + # 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; } - elsif ( endswith( $e->{uri_path}, GEMFEED_URI_2 ) ) { - ( $f->{gemfeed}->{ $e->{ip_hash} } //= 0 )++; - } - else { - 0; + + # 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 ( $self, $stats, $event ) { + # 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' ); + 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 )++; + ($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 ( $class, %args ) { + # 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}; + or die $self->{stats_dir} . ": $!" + unless -d $self->{stats_dir}; return $self; } - sub last_processed_date ( $self, $proto ) { - my $hostname = hostname(); - my @processed = - glob $self->{stats_dir} . "/${proto}_????????.$hostname.json.gz"; + # 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; + @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 ) { + sub ($self, $date_key, $stats) { my $hostname = hostname(); - my $path = - $self->{stats_dir} . "/${date_key}.$hostname.json.gz"; + my $path = $self->{stats_dir} . "/${date_key}.$hostname.json.gz"; FileHelper::write_json_gz - $path, - $stats; + $path, + $stats; } ); } - sub for_dates ( $self, $cb ) { - $cb->( $self, $_, $self->{stats}{$_} ) for sort - keys $self->{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 ( $stats_dir, $partner_node ) { + # 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)) { @@ -527,51 +634,63 @@ package Foostats::Replicator { "https://$partner_node/foostats/$dest_path", "$stats_dir/$dest_path", $count++ - < - 3 + < + 3 , # Always replicate the newest 3 files. ); } } } - sub replicate_file ( $remote_url, $dest_path, $force ) { + # 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; + 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 ) { + unless ($response->is_success) { say "\nFailed to fetch the file: " . $response->status_line; return; } FileHelper::write - $dest_path, - $response->decoded_content; + $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 { - use Data::Dumper; # TODO: UNDO - + # Removed Data::Dumper (debug-only) per review. + # 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; + $merge{$_} = merge_for_date($stats_dir, $_) for DateHelper::last_month_dates; return %merge; } - sub merge_for_date ( $stats_dir, $date ) { + # Sub: merge_for_date + # - Purpose: Merge all node files for a specific date into one stats hashref. + # - Params: $stats_dir (str), $date (YYYYMMDD str/int). + # - Return: { feed_ips => {...}, count => {...}, page_ips => {...} }. + sub merge_for_date ($stats_dir, $date) { printf - "Merging for date %s\n", - $date; + "Merging for date %s\n", + $date; - my @stats = stats_for_date( $stats_dir, $date ); + my @stats = stats_for_date($stats_dir, $date); return { feed_ips => feed_ips(@stats), count => count(@stats), @@ -579,9 +698,13 @@ package Foostats::Merger { }; } - sub merge_ips ( $a, $b, $key_transform = undef ) { - my sub merge ( $a, $b ) { - while ( my ( $key, $val ) = each %$b ) { + # Sub: merge_ips + # - Purpose: Deep-ish merge helper: sums numbers, merges hash-of-hash counts. + # - Params: $a (hashref target), $b (hashref source), $key_transform (code|undef). + # - Return: undef; updates $a in place; dies on incompatible types. + sub merge_ips ($a, $b, $key_transform = undef) { + my sub merge ($a, $b) { + while (my ($key, $val) = each %$b) { $a->{$key} //= 0; $a->{$key} += $val; } @@ -589,52 +712,56 @@ package Foostats::Merger { my $is_num = qr/^\d+(\.\d+)?$/; - while ( my ( $key, $val ) = each %$b ) { + while (my ($key, $val) = each %$b) { $key = $key_transform->($key) - if defined $key_transform; + if defined $key_transform; - if ( not exists $a->{$key} ) { + if (not exists $a->{$key}) { $a->{$key} = $val; } - elsif (ref( $a->{$key} ) eq 'HASH' - && ref($val) eq 'HASH' ) + elsif (ref($a->{$key}) eq 'HASH' + && ref($val) eq 'HASH') { - merge( $a->{$key}, $val ); + merge($a->{$key}, $val); } elsif ($a->{$key} =~ $is_num - && $val =~ $is_num ) + && $val =~ $is_num) { $a->{$key} += $val; } else { die -"Not merging tkey '%s' (ref:%s): '%s' (ref:%s) with '%s' (ref:%s)\n", - $key, - ref($key), $a->{$key}, - ref( $a->{$key} ), - $val, - ref($val); + "Not merging tkey '%s' (ref:%s): '%s' (ref:%s) with '%s' (ref:%s)\n", + $key, + ref($key), $a->{$key}, + ref($a->{$key}), + $val, + ref($val); } } } + # Sub: feed_ips + # - Purpose: Merge feed unique-IP sets from per-proto stats into totals. + # - Params: @stats (list of stats hashrefs) each with {proto, feed_ips}. + # - Return: hashref with Total and per-proto feed counts. sub feed_ips (@stats) { - my ( %gemini, %web ); + my (%gemini, %web); for my $stats (@stats) { my $merge = - $stats->{proto} eq 'web' - ? \%web - : \%gemini; + $stats->{proto} eq 'web' + ? \%web + : \%gemini; printf - "Merging proto %s feed IPs\n", - $stats->{proto}; - merge_ips( $merge, $stats->{feed_ips} ); + "Merging proto %s feed IPs\n", + $stats->{proto}; + merge_ips($merge, $stats->{feed_ips}); } my %total; - merge_ips( \%total, $web{$_} ) for keys %web; - merge_ips( \%total, $gemini{$_} ) for keys %gemini; + merge_ips(\%total, $web{$_}) for keys %web; + merge_ips(\%total, $gemini{$_}) for keys %gemini; my %merge = ( 'Total' => scalar keys %total, @@ -647,11 +774,15 @@ package Foostats::Merger { return \%merge; } + # Sub: count + # - Purpose: Sum request counters across stats for the day. + # - Params: @stats (list of stats hashrefs) each with {count}. + # - Return: hashref of summed counters. sub count (@stats) { my %merge; for my $stats (@stats) { - while ( my ( $key, $val ) = each $stats->{count}->%* ) { + while (my ($key, $val) = each $stats->{count}->%*) { $merge{$key} //= 0; $merge{$key} += $val; } @@ -660,13 +791,17 @@ package Foostats::Merger { return \%merge; } + # Sub: page_ips + # - Purpose: Merge unique IPs per host and per URL; coalesce truncated endings. + # - Params: @stats (list of stats hashrefs) with {page_ips}{urls,hosts}. + # - Return: hashref with urls/hosts each mapping => unique counts. sub page_ips (@stats) { my %merge = ( urls => {}, hosts => {} ); - for my $key ( keys %merge ) { + for my $key (keys %merge) { merge_ips( $merge{$key}, $_->{page_ips}->{$key}, @@ -678,25 +813,28 @@ package Foostats::Merger { ) for @stats; # Keep only uniq IP count - $merge{$key}->{$_} = scalar keys $merge{$key}->{$_}->%* - for keys $merge{$key}->%*; + $merge{$key}->{$_} = scalar keys $merge{$key}->{$_}->%* for keys $merge{$key}->%*; } return \%merge; } - sub stats_for_date ( $stats_dir, $date ) { + # Sub: stats_for_date + # - Purpose: Load all stats files for a date across protos; tag proto/path. + # - Params: $stats_dir (str), $date (YYYYMMDD). + # - Return: list of stats hashrefs. + sub stats_for_date ($stats_dir, $date) { my @stats; for my $proto (qw(gemini web)) { for my $path (<$stats_dir/${proto}_${date}.*.json.gz>) { printf - "Reading %s\n", - $path; + "Reading %s\n", + $path; push - @stats, - FileHelper::read_json_gz($path); - @{ $stats[-1] }{qw(proto path)} = ( $proto, $path ); + @stats, + FileHelper::read_json_gz($path); + @{ $stats[-1] }{qw(proto path)} = ($proto, $path); } } @@ -704,11 +842,18 @@ package Foostats::Merger { } } +# Package: Foostats::Reporter — build gemtext/HTML daily and summary reports +# - Purpose: Render daily reports and rolling summaries (30/365), and index pages. package Foostats::Reporter { use Time::Piece; + use HTML::Entities qw(encode_entities); + # Sub: truncate_url + # - Purpose: Middle-ellipsize long URLs to fit within a target length. + # - Params: $url (str), $max_length (int default 100). + # - Return: possibly truncated string. sub truncate_url { - my ( $url, $max_length |