From a31e86444a129d26104d7817f767a6279063f810 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sat, 10 May 2025 14:13:02 +0200 Subject: [PATCH 01/30] Bump version. Signed-off-by: Thomas Hochstein --- doc/ChangeLog | 3 +++ lib/NewsStats.pm | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 569a3e6..b21f9a5 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,3 +1,6 @@ +NewsStats 0.3.0 (unreleased) + + NewsStats 0.2.0 (2025-05-10) * Redo directory structure: - Move all scripts to /bin diff --git a/lib/NewsStats.pm b/lib/NewsStats.pm index 11f25f8..01e1994 100644 --- a/lib/NewsStats.pm +++ b/lib/NewsStats.pm @@ -48,7 +48,7 @@ require Exporter; Output => [qw(OutputData FormatOutput)], SQLHelper => [qw(SQLHierarchies SQLSortOrder SQLGroupList SQLSetBounds SQLBuildClause GetMaxLength)]); -$VERSION = '0.2.0'; +$VERSION = '0.3.0'; use Data::Dumper; use File::Basename; From 0a0e615edee8c9c6470e5bc8f7b0ae119ef7b9b4 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sat, 10 May 2025 21:27:40 +0200 Subject: [PATCH 02/30] Factor Groupstats() out from gatherstats main. Signed-off-by: Thomas Hochstein --- bin/gatherstats.pl | 172 +++++++++++++++++++++++++-------------------- 1 file changed, 94 insertions(+), 78 deletions(-) diff --git a/bin/gatherstats.pl b/bin/gatherstats.pl index 60043d1..d360541 100755 --- a/bin/gatherstats.pl +++ b/bin/gatherstats.pl @@ -7,7 +7,7 @@ # # It is part of the NewsStats package. # -# Copyright (c) 2010-2013 Thomas Hochstein +# Copyright (c) 2010-2013, 2025 Thomas Hochstein # # It can be redistributed and/or modified under the same terms under # which Perl itself is published. @@ -108,6 +108,8 @@ if ($Conf{'TLH'}) { ### init database my $DBHandle = InitDB(\%Conf,1); +my $DBRaw = sprintf('%s.%s',$Conf{'DBDatabase'},$Conf{'DBTableRaw'}); +my $DBGrps = sprintf('%s.%s',$Conf{'DBDatabase'},$Conf{'DBTableGrps'}); ### get data for each month &Bleat(1,'Test mode. Database is not updated.') if $OptTest; @@ -115,90 +117,104 @@ foreach my $Month (&ListMonth($Period)) { print "---------- $Month ----------\n" if $OptDebug; + ### GroupStats if ($OptStatsType eq 'all' or $OptStatsType eq 'groups') { - # read list of newsgroups from --checkgroups - # into a hash - my %ValidGroups = %{ReadGroupList(sprintf('%s-%s',$OptCheckgroupsFile,$Month))} - if $OptCheckgroupsFile; - - ### ---------------------------------------------- - ### get groups data (number of postings per group) - # get groups data from raw table for given month - my $DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups FROM %s.%s ". - "WHERE day LIKE ? AND NOT disregard", - $Conf{'DBDatabase'}, - $Conf{'DBTableRaw'})); - $DBQuery->execute($Month.'-%') - or &Bleat(2,sprintf("Can't get groups data for %s from %s.%s: ". - "$DBI::errstr\n",$Month, - $Conf{'DBDatabase'},$Conf{'DBTableRaw'})); - - # count postings per group - my %Postings; - while (($_) = $DBQuery->fetchrow_array) { - # get list of newsgroups and hierarchies from Newsgroups: - my %Newsgroups = ListNewsgroups($_,$TLH, - $OptCheckgroupsFile ? \%ValidGroups : ''); - # count each newsgroup and hierarchy once - foreach (sort keys %Newsgroups) { - $Postings{$_}++; - }; - }; - - # add valid but empty groups if --checkgroups is set - if (%ValidGroups) { - foreach (sort keys %ValidGroups) { - if (!defined($Postings{$_})) { - # add current newsgroup as empty group - $Postings{$_} = 0; - warn (sprintf("ADDED: %s as empty group\n",$_)); - # add empty hierarchies for current newsgroup as needed - foreach (ParseHierarchies($_)) { - my $Hierarchy = $_ . '.ALL'; - if (!defined($Postings{$Hierarchy})) { - $Postings{$Hierarchy} = 0; - warn (sprintf("ADDED: %s as empty group\n",$Hierarchy)); - }; - }; - } - }; - }; - - # delete old data for that month - if (!$OptTest) { - $DBQuery = $DBHandle->do(sprintf("DELETE FROM %s.%s WHERE month = ?", - $Conf{'DBDatabase'},$Conf{'DBTableGrps'}), - undef,$Month) - or &Bleat(2,sprintf("Can't delete old groups data for %s from %s.%s: ". - "$DBI::errstr\n",$Month, - $Conf{'DBDatabase'},$Conf{'DBTableGrps'})); - }; - - print "----- GroupStats -----\n" if $OptDebug; - foreach my $Newsgroup (sort keys %Postings) { - print "$Newsgroup => $Postings{$Newsgroup}\n" if $OptDebug; - if (!$OptTest) { - # write to database - $DBQuery = $DBHandle->prepare(sprintf("INSERT INTO %s.%s ". - "(month,newsgroup,postings) ". - "VALUES (?, ?, ?)", - $Conf{'DBDatabase'}, - $Conf{'DBTableGrps'})); - $DBQuery->execute($Month, $Newsgroup, $Postings{$Newsgroup}) - or &Bleat(2,sprintf("Can't write groups data for %s/%s to %s.%s: ". - "$DBI::errstr\n",$Month,$Newsgroup, - $Conf{'DBDatabase'},$Conf{'DBTableGrps'})); - $DBQuery->finish; - }; - }; - } else { - # other types of information go here - later on + &GroupStats($DBHandle,$DBRaw,$DBGrps,$Month,$TLH,$OptCheckgroupsFile,$OptTest,$OptDebug); }; }; ### close handles $DBHandle->disconnect; +################################# Subroutines ################################## + +sub GroupStats { +### ---------------------------------------------------------------------------- +### collect number of postings per group +### IN : $DBHandle : database handle +### $DBRaw : database table for raw data (to read from) +### $DBGrps : database table for groups data (to write to) +### $Month : current month to do +### $TLH : TLHs to collect +### $Checkgroupsfile : filename template for checkgroups file +### (expanded to $Checkgroupsfile-$Month) +### $Test : test mode +### $Debug : debug mode +### OUT: (nothing) + my ($DBHandle,$DBRaw,$DBGrps,$Month,$TLH,$CheckgroupsFile,$Test,$Debug) = @_; + + # read list of newsgroups from --checkgroups + # into a hash + my %ValidGroups = %{ReadGroupList(sprintf('%s-%s',$CheckgroupsFile,$Month))} + if $CheckgroupsFile; + + ### ---------------------------------------------- + ### get groups data (number of postings per group) + # get groups data from raw table for given month + my $DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups FROM %s ". + "WHERE day LIKE ? AND NOT disregard", + $DBRaw)); + $DBQuery->execute($Month.'-%') + or &Bleat(2,sprintf("Can't get groups data for %s from %s: ". + "$DBI::errstr\n",$Month, + $DBRaw)); + + # count postings per group + my %Postings; + while (($_) = $DBQuery->fetchrow_array) { + # get list of newsgroups and hierarchies from Newsgroups: + my %Newsgroups = ListNewsgroups($_,$TLH, + $CheckgroupsFile ? \%ValidGroups : ''); + # count each newsgroup and hierarchy once + foreach (sort keys %Newsgroups) { + $Postings{$_}++; + }; + }; + + # add valid but empty groups if --checkgroups is set + if (%ValidGroups) { + foreach (sort keys %ValidGroups) { + if (!defined($Postings{$_})) { + # add current newsgroup as empty group + $Postings{$_} = 0; + warn (sprintf("ADDED: %s as empty group\n",$_)); + # add empty hierarchies for current newsgroup as needed + foreach (ParseHierarchies($_)) { + my $Hierarchy = $_ . '.ALL'; + if (!defined($Postings{$Hierarchy})) { + $Postings{$Hierarchy} = 0; + warn (sprintf("ADDED: %s as empty group\n",$Hierarchy)); + }; + }; + } + }; + }; + + # delete old data for that month + if (!$Test) { + $DBQuery = $DBHandle->do(sprintf("DELETE FROM %s WHERE month = ?", + $DBGrps), undef,$Month) + or &Bleat(2,sprintf("Can't delete old groups data for %s from %s: ". + "$DBI::errstr\n",$Month,$DBGrps)); + }; + + print "----- GroupStats -----\n" if $Debug; + foreach my $Newsgroup (sort keys %Postings) { + print "$Newsgroup => $Postings{$Newsgroup}\n" if $Debug; + if (!$Test) { + # write to database + $DBQuery = $DBHandle->prepare(sprintf("INSERT INTO %s ". + "(month,newsgroup,postings) ". + "VALUES (?, ?, ?)",$DBGrps)); + $DBQuery->execute($Month, $Newsgroup, $Postings{$Newsgroup}) + or &Bleat(2,sprintf("Can't write groups data for %s/%s to %s: ". + "$DBI::errstr\n",$Month,$Newsgroup,$DBGrps)); + $DBQuery->finish; + }; + }; +}; +### ---------------------------------------------------------------------------- + __END__ ################################ Documentation ################################# From 73a2d70f167d8a1333886e5a797f63aab3f79aa1 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sat, 10 May 2025 21:09:25 +0200 Subject: [PATCH 03/30] Add ParseHeaders() to library. Signed-off-by: Thomas Hochstein --- lib/NewsStats.pm | 39 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 38 insertions(+), 1 deletion(-) diff --git a/lib/NewsStats.pm b/lib/NewsStats.pm index 01e1994..1664e48 100644 --- a/lib/NewsStats.pm +++ b/lib/NewsStats.pm @@ -2,7 +2,7 @@ # # Library functions for the NewsStats package. # -# Copyright (c) 2010-2013 Thomas Hochstein +# Copyright (c) 2010-2013, 2025 Thomas Hochstein # # This module can be redistributed and/or modified under the same terms under # which Perl itself is published. @@ -34,6 +34,7 @@ require Exporter; ListNewsgroups ParseHierarchies ReadGroupList + ParseHeaders OutputData FormatOutput SQLHierarchies @@ -254,6 +255,42 @@ sub ReadGroupList { return \%ValidGroups; }; +################################################################################ +sub ParseHeaders { +################################################################################ +### return a hash of all headers (ignoring duplicate headers) +### parsed from raw headers +### -> taken and modified from pgpverify +### -> Written April 1996, (David C Lawrence) +### -> Currently maintained by Russ Allbery +### IN : $RawHeaders : raw headers as found in posting +### OUT: %Headers : hash containing header contents, +### keyed by lower-case header name + my (%Header, $Label, $Value); + foreach (@_) { + s/\r?\n$//; + + last if /^$/; + + if (/^(\S+):[ \t](.+)/) { + ($Label, $Value) = ($1, $2); + # discard all duplicate headers + next if $Header{lc($Label)}; + $Header{lc($Label)} = $Value; + } elsif (/^\s/) { + # continuation lines + if ($Label) { + $Header{lc($Label)} .= "\n$_"; + } else { + warn (sprintf("Non-header line: %s\n",$_)); + } + } else { + warn (sprintf("Non-header line: %s\n",$_)); + } + } + return %Header; +}; + ################################################################################ #####----------------------------- TimePeriods ----------------------------##### From 9ccb915d773b6f52fef43ca603966184b2c3a9ed Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sat, 10 May 2025 21:39:08 +0200 Subject: [PATCH 04/30] First version of HostStats. Signed-off-by: Thomas Hochstein --- bin/gatherstats.pl | 134 ++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 132 insertions(+), 2 deletions(-) diff --git a/bin/gatherstats.pl b/bin/gatherstats.pl index d360541..c741da7 100755 --- a/bin/gatherstats.pl +++ b/bin/gatherstats.pl @@ -20,7 +20,7 @@ BEGIN { use strict; use warnings; -use NewsStats qw(:DEFAULT :TimePeriods ListNewsgroups ParseHierarchies ReadGroupList); +use NewsStats qw(:DEFAULT :TimePeriods ListNewsgroups ParseHierarchies ReadGroupList ParseHeaders); use DBI; use Getopt::Long qw(GetOptions); @@ -31,7 +31,7 @@ Getopt::Long::config ('bundling'); # define types of information that can be gathered # all / groups (/ clients / hosts) my %LegalStats; -@LegalStats{('all','groups')} = (); +@LegalStats{('all','groups','hosts')} = (); ################################# Main program ################################# @@ -110,6 +110,7 @@ if ($Conf{'TLH'}) { my $DBHandle = InitDB(\%Conf,1); my $DBRaw = sprintf('%s.%s',$Conf{'DBDatabase'},$Conf{'DBTableRaw'}); my $DBGrps = sprintf('%s.%s',$Conf{'DBDatabase'},$Conf{'DBTableGrps'}); +my $DBHosts = sprintf('%s.%s',$Conf{'DBDatabase'},$Conf{'DBTableHosts'}); ### get data for each month &Bleat(1,'Test mode. Database is not updated.') if $OptTest; @@ -121,6 +122,15 @@ foreach my $Month (&ListMonth($Period)) { if ($OptStatsType eq 'all' or $OptStatsType eq 'groups') { &GroupStats($DBHandle,$DBRaw,$DBGrps,$Month,$TLH,$OptCheckgroupsFile,$OptTest,$OptDebug); }; + + ### HostStats + if ($OptStatsType eq 'all' or $OptStatsType eq 'hosts') { + # define known hosts using subdomains + my @KnownHosts = qw(aioe.org arcor-online.net arcor-ip.de news.astraweb.com read.cnntp.org easynews.com eternal-september.org + fernuni-hagen.de free.fr newsread.freenet.ag googlegroups.com + news.neostrada.pl newsdawg.com newscene.com news-service.com octanews.com xsnews.nl news.xs4all.nl); + &HostStats($DBHandle,$DBRaw,$DBHosts,$Month,$OptTest,$OptDebug,@KnownHosts); + }; }; ### close handles @@ -215,6 +225,126 @@ sub GroupStats { }; ### ---------------------------------------------------------------------------- +sub HostStats { +### ---------------------------------------------------------------------------- +### collect number of postings per server +### IN : $DBHandle : database handle +### $DBRaw : database table for raw data (to read from) +### $DBHosts : database table for hosts data (to write to) +### $Month : current month to do +### $Test : test mode +### $Debug : debug mode +### @KnownHosts : list of known hosts with subdomains +### OUT: (nothing) + my ($DBHandle,$DBRaw,$DBHosts,$Month,$Test,$Debug,@KnownHosts) = @_; + + # define known hosts using subdomains + my %Postings; + + # get raw header data from raw table for given month + my $DBQuery = $DBHandle->prepare(sprintf("SELECT headers FROM %s ". + "WHERE day LIKE ? AND NOT disregard", + $DBRaw)); + $DBQuery->execute($Month.'-%') + or &Bleat(2,sprintf("Can't get hosts data for %s from %s.%s: ". + "$DBI::errstr\n",$Month,$DBRaw)); + + ### ---------------------------------------------- + print "----- HostStats -----\n" if $Debug; + ### parse headers + while (($_) = $DBQuery->fetchrow_array) { + my $Host; + my %Header = ParseHeaders(split(/\n/,$_)); + + # ([a-z0-9-_]+\.[a-z0-9-_.]+) tries to match a hostname + # Injection-Info + if($Header{'injection-info'}) { + ($Host) = $Header{'injection-info'} =~ /^\s*([a-z0-9-_]+\.[a-z0-9-_.]+);/i; + # reset if IP address + undef($Host) if $Host && $Host !~ /[g-z]/i; + } + # X-Trace + if (!$Host && $Header{'x-trace'}) { + (undef, $Host) = $Header{'x-trace'} =~ /^(\s|\d)*([a-z0-9-_]+\.[a-z0-9-_.]+)/i; + # reset if IP address + undef($Host) if $Host && $Host !~ /[g-z]/i; + } + # NNTP-Posting-Host + if (!$Host && $Header{'nntp-posting-host'}) { + ($Host) = $Header{'nntp-posting-host'} =~ /^\s*([a-z0-9-_]+\.[a-z0-9-_.]+)/i; + # reset if IP address + undef($Host) if $Host && $Host !~ /[g-z]/i; + } + # Path + if (!$Host) { + if ($Header{'path'} =~ /!([^!]+)!.POSTED!/) { + $Host = "$1"; + } elsif ($Header{'path'} =~ /!.POSTED.([^!]+)!/) { + $Host = "$1"; + } else { + # iterate on the Path: header until we have a host name or no more + # path elements + while (!$Host && $Header{'path'} =~ /!/) { + ($Host) = $Header{'path'} =~ /!?([a-z0-9-_]+\.[a-z0-9-_.]+)![^!]+$/i; + undef($Host) if $Host && $Host =~ /\.MISMATCH/; + # remove last path element + $Header{'path'} =~ s/![^!]+$//; + }; + } + } + + # special cases + $Host = 'news.highwinds-media.com' if $Host =~ /fx\d\d\.\S{3}\.POSTED/ + or $Host =~ /newsfe\d+\.(iad|ams2)/; + $Host = 'newshosting.com' if $Host =~ /post\d*\.iad/; + + # trailing .POSTED + ($Host) = $Host =~ /(\S+)\.POSTED$/ if $Host =~ /\.POSTED$/; + + # normalize hosts + foreach (@KnownHosts) { + if ($Host =~ /\.$_$/) { + ($Host) = $_ ; + last; + } + } + + # lowercase + $Host = lc($Host); + + # count host + if ($Host) { + $Postings{$Host}++; + } else { + &Bleat(2,sprintf("%s FAILED", $Header{'message-id'})) if !$Host; + } + + # !DEBUG! printf("%s: %s\n", $Header{'message-id'}, $Host); + }; + + # delete old data for that month + if (!$Test) { + $DBQuery = $DBHandle->do(sprintf("DELETE FROM %s WHERE month = ?", + $DBHosts),undef,$Month) + or &Bleat(2,sprintf("Can't delete old hosts data for %s from %s: ". + "$DBI::errstr\n",$Month,$DBHosts)); + }; + + foreach my $Host (sort keys %Postings) { + print "$Host => $Postings{$Host}\n" if $Debug; + if (!$Test) { + # write to database + $DBQuery = $DBHandle->prepare(sprintf("INSERT INTO %s ". + "(month,host,postings) ". + "VALUES (?, ?, ?)",$DBHosts)); + $DBQuery->execute($Month, $Host, $Postings{$Host}) + or &Bleat(2,sprintf("Can't write groups data for %s/%s to %s: ". + "$DBI::errstr\n",$Month,$Host,$DBHosts)); + $DBQuery->finish; + }; + }; +}; + __END__ ################################ Documentation ################################# From 713db805459aa29c70cfd8a8cd612d550ca544a3 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sat, 10 May 2025 21:39:25 +0200 Subject: [PATCH 05/30] Add HostStats table to install script. Signed-off-by: Thomas Hochstein --- install/install.pl | 30 +++++++++++++++++++++++------- 1 file changed, 23 insertions(+), 7 deletions(-) diff --git a/install/install.pl b/install/install.pl index 826052d..b4eb4cc 100755 --- a/install/install.pl +++ b/install/install.pl @@ -46,7 +46,7 @@ my $DBCreate = < < < < < <connect(sprintf('DBI:%s:host=%s',$Conf{'DBDriver'}, $Conf{'DBHost'}), $Conf{'DBUser'}, $Conf{'DBPw'}, { PrintError => 0 }); @@ -162,7 +178,7 @@ if (!$OptUpdate) { $DBQuery->execute() or &Bleat(2, sprintf("Can't create database %s: %s%\n", $Conf{'DBDatabase'}, $DBI::errstr)); - printf("Database table %s created succesfully.\n",$Conf{'DBDatabase'}); + printf("Database %s created succesfully.\n",$Conf{'DBDatabase'}); $DBHandle->disconnect; }; @@ -185,7 +201,7 @@ if (!$OptUpdate) { } else { ##### upgrade mode print "----------\nStarting upgrade process.\n"; - $PackageVersion = '0.03'; + my $PackageVersion = '0.03'; if ($OptUpdate < $PackageVersion) { if ($OptUpdate < 0.02) { # 0.01 -> 0.02 From 867498fdc8acbcb1a99321d18e0d4df35fd0b7a1 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 00:29:52 +0200 Subject: [PATCH 06/30] Refactor SQL query generators. Accept other column names than newsgroup. Signed-off-by: Thomas Hochstein --- bin/groupstats.pl | 4 +-- lib/NewsStats.pm | 91 ++++++++++++++++++++++++----------------------- 2 files changed, 49 insertions(+), 46 deletions(-) diff --git a/bin/groupstats.pl b/bin/groupstats.pl index b716566..f463a6e 100755 --- a/bin/groupstats.pl +++ b/bin/groupstats.pl @@ -110,7 +110,7 @@ my ($CaptionPeriod,$SQLWherePeriod) = &GetTimePeriod($OptMonth); # with placeholders as well as a list of newsgroup to bind to them my ($SQLWhereNewsgroups,@SQLBindNewsgroups); if ($OptNewsgroups) { - ($SQLWhereNewsgroups,@SQLBindNewsgroups) = &SQLGroupList($OptNewsgroups); + ($SQLWhereNewsgroups,@SQLBindNewsgroups) = &SQLGroupList($OptNewsgroups,'newsgroup'); # bail out if --newsgroups is invalid &Bleat(2,"--newsgroups option has an invalid format!") if !$SQLWhereNewsgroups; @@ -143,7 +143,7 @@ $OptGroupBy = 'newsgroup' if (!$OptGroupBy and $OptMonth and $OptMonth =~ /:/ and $OptNewsgroups and $OptNewsgroups !~ /[:*%]/); # parse $OptGroupBy to $GroupBy, create ORDER BY clause $SQLOrderClause # if $OptGroupBy is still not set, SQLSortOrder() will default to 'month' -my ($GroupBy,$SQLOrderClause) = SQLSortOrder($OptGroupBy, $OptOrderBy); +my ($GroupBy,$SQLOrderClause) = SQLSortOrder($OptGroupBy, $OptOrderBy, 'newsgroup'); # $GroupBy will contain 'month' or 'newsgroup' (parsed result of $OptGroupBy) # set it to 'month' or 'key' for OutputData() $GroupBy = ($GroupBy eq 'month') ? 'month' : 'key'; diff --git a/lib/NewsStats.pm b/lib/NewsStats.pm index 1664e48..9aec802 100644 --- a/lib/NewsStats.pm +++ b/lib/NewsStats.pm @@ -579,21 +579,22 @@ sub SQLSortOrder { ### IN : $GroupBy: primary sort by 'month' (default) or 'newsgroups' ### $OrderBy: secondary sort by month/newsgroups (default) ### or number of 'postings' +### $Type : newsgroup, host, client ### OUT: a SQL ORDER BY clause - my ($GroupBy,$OrderBy) = @_; + my ($GroupBy,$OrderBy,$Type) = @_; my ($GroupSort,$OrderSort) = ('',''); # $GroupBy (primary sorting) if (!$GroupBy) { $GroupBy = 'month'; } else { ($GroupBy, $GroupSort) = SQLParseOrder($GroupBy); - if ($GroupBy =~ /group/i) { - $GroupBy = 'newsgroup'; + if ($GroupBy =~ /name/i) { + $GroupBy = $Type; } else { $GroupBy = 'month'; } } - my $Secondary = ($GroupBy eq 'month') ? 'newsgroup' : 'month'; + my $Secondary = ($GroupBy eq 'month') ? $Type : 'month'; # $OrderBy (secondary sorting) if (!$OrderBy) { $OrderBy = $Secondary; @@ -629,44 +630,45 @@ sub SQLParseOrder { ################################################################################ sub SQLGroupList { ################################################################################ -### explode list of newsgroups separated by : (with wildcards) +### explode list of names separated by : (with wildcards) ### to a SQL 'WHERE' expression -### IN : $Newsgroups: list of newsgroups (group.one.*:group.two:group.three.*) +### IN : $Names: list of names, e.g. newsgroups (group.one.*:group.two:group.three.*) +### $Type : newsgroup, host, client ### OUT: SQL code to become part of a 'WHERE' clause, -### list of newsgroups for SQL bindings - my ($Newsgroups) = @_; +### list of names for SQL bindings + my ($Names,$Type) = @_; # substitute '*' wildcard with SQL wildcard character '%' - $Newsgroups =~ s/\*/%/g; - return (undef,undef) if !CheckValidNewsgroups($Newsgroups); - # just one newsgroup? - return (SQLGroupWildcard($Newsgroups),$Newsgroups) if $Newsgroups !~ /:/; - my ($SQL,@WildcardGroups,@NoWildcardGroups); - # list of newsgroups separated by ':' - my @GroupList = split /:/, $Newsgroups; - foreach (@GroupList) { + $Names =~ s/\*/%/g; + return (undef,undef) if !CheckValidNames($Names); + # just one name/newsgroup? + return (SQLGroupWildcard($Names,$Type),$Names) if $Names !~ /:/; + my ($SQL,@WildcardNames,@NoWildcardNames); + # list of names/newsgroups separated by ':' + my @NameList = split /:/, $Names; + foreach (@NameList) { if ($_ !~ /%/) { - # add to list of newsgroup names WITHOUT wildcard - push (@NoWildcardGroups,$_); + # add to list of names/newsgroup names WITHOUT wildcard + push (@NoWildcardNames,$_); } else { - # add to list of newsgroup names WITH wildcard - push (@WildcardGroups,$_); + # add to list of names WITH wildcard + push (@WildcardNames,$_); # add wildcard to SQL clause # 'OR' if SQL clause is not empty $SQL .= ' OR ' if $SQL; - $SQL .= 'newsgroup LIKE ?' + $SQL .= "$Type LIKE ?" } }; - if (scalar(@NoWildcardGroups)) { + if (scalar(@NoWildcardNames)) { # add 'OR' if SQL clause is not empty $SQL .= ' OR ' if $SQL; - if (scalar(@NoWildcardGroups) < 2) { - # special case: just one newsgroup without wildcard - $SQL .= 'newsgroup = ?'; + if (scalar(@NoWildcardNames) < 2) { + # special case: just one name without wildcard + $SQL .= "$Type = ?"; } else { - # create list of newsgroups to include: 'newsgroup IN (...)' - $SQL .= 'newsgroup IN ('; + # create list of names to include: e.g. 'newsgroup IN (...)' + $SQL .= "$Type IN ("; my $SQLin; - foreach (@NoWildcardGroups) { + foreach (@NoWildcardNames) { $SQLin .= ',' if $SQLin; $SQLin .= '?'; } @@ -674,27 +676,28 @@ sub SQLGroupList { $SQL .= $SQLin .= ')'; } } - # add brackets '()' to SQL clause as needed (more than one wildcard group) - if (scalar(@WildcardGroups)) { + # add brackets '()' to SQL clause as needed (more than one wildcard name) + if (scalar(@WildcardNames)) { $SQL = '(' . $SQL .')'; } - # rebuild @GroupList in (now) correct order - @GroupList = (@WildcardGroups,@NoWildcardGroups); - return ($SQL,@GroupList); + # rebuild @NameList in (now) correct order + @NameList = (@WildcardNames,@NoWildcardNames); + return ($SQL,@NameList); }; ################################################################################ sub SQLGroupWildcard { ################################################################################ ### build a valid SQL 'WHERE' expression with or without wildcards -### IN : $Newsgroup: newsgroup expression, probably with wildcard -### (group.name or group.name.%) +### IN : $Name: expression, probably with wildcard +### (group.name or group.name.%) +### $Type: newsgroup, host, client ### OUT: SQL code to become part of a 'WHERE' clause - my ($Newsgroup) = @_; - if ($Newsgroup !~ /%/) { - return 'newsgroup = ?'; + my ($Name,$Type) = @_; + if ($Name !~ /%/) { + return "$Type = ?"; } else { - return 'newsgroup LIKE ?'; + return "$Type LIKE ?"; } }; @@ -796,14 +799,14 @@ sub SQLBuildClause { #####--------------------------- Verifications ----------------------------##### ################################################################################ -sub CheckValidNewsgroups { +sub CheckValidNames { ################################################################################ -### syntax check of newgroup list -### IN : $Newsgroups: list of newsgroups (group.one.*:group.two:group.three.*) +### syntax check of a list +### IN : $Names: list of names, e.g. newsgroups (group.one.*:group.two:group.three.*) ### OUT: boolean - my ($Newsgroups) = @_; + my ($Names) = @_; my $InvalidCharRegExp = ',; '; - return ($Newsgroups =~ /[$InvalidCharRegExp]/) ? 0 : 1; + return ($Names =~ /[$InvalidCharRegExp]/) ? 0 : 1; }; From 57af475b80e3a56f6bdb41a9d854dd303fdbabfc Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 00:31:20 +0200 Subject: [PATCH 07/30] First version of cliservstats.pl Signed-off-by: Thomas Hochstein --- bin/cliservstats.pl | 534 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 534 insertions(+) create mode 100644 bin/cliservstats.pl diff --git a/bin/cliservstats.pl b/bin/cliservstats.pl new file mode 100644 index 0000000..6d76779 --- /dev/null +++ b/bin/cliservstats.pl @@ -0,0 +1,534 @@ +#! /usr/bin/perl +# +# cliservstats.pl +# +# This script will get statistical data on client (newsreader) and +# server (host) usage from a database. +# +# It is part of the NewsStats package. +# +# Copyright (c) 2025 Thomas Hochstein +# +# It can be redistributed and/or modified under the same terms under +# which Perl itself is published. + +BEGIN { + use File::Basename; + # we're in .../bin, so our module is in ../lib + push(@INC, dirname($0).'/../lib'); +} +use strict; +use warnings; + +use NewsStats qw(:DEFAULT :TimePeriods :Output :SQLHelper ReadGroupList); + +use DBI; +use Getopt::Long qw(GetOptions); +Getopt::Long::config ('bundling'); + +################################# Main program ################################# + +### read commandline options +my ($OptCaptions,$OptComments,$OptDB,$OptFileTemplate,$OptFormat, + $OptGroupBy,$LowBound,$OptMonth,$OptNames,$OptOrderBy, + $OptReportType,$OptSums,$OptType,$UppBound,$OptConfFile); +GetOptions ('c|captions!' => \$OptCaptions, + 'comments!' => \$OptComments, + 'db=s' => \$OptDB, + 'filetemplate=s' => \$OptFileTemplate, + 'f|format=s' => \$OptFormat, + 'g|group-by=s' => \$OptGroupBy, + 'l|lower=i' => \$LowBound, + 'm|month=s' => \$OptMonth, + 'n|names=s' => \$OptNames, + 'o|order-by=s' => \$OptOrderBy, + 'r|report=s' => \$OptReportType, + 's|sums!' => \$OptSums, + 't|type=s' => \$OptType, + 'u|upper=i' => \$UppBound, + 'conffile=s' => \$OptConfFile, + 'h|help' => \&ShowPOD, + 'V|version' => \&ShowVersion) or exit 1; +# parse parameters +# TODO: $OptSums is currently a no-op +# $OptComments defaults to TRUE +$OptComments = 1 if (!defined($OptComments)); +# force --nocomments when --filetemplate is used +$OptComments = 0 if ($OptFileTemplate); +# parse $OptType +if ($OptType) { + if ($OptType =~ /(host|server)s?/i) { + $OptType = 'host'; + } elsif ($OptType =~ /(newsreader|client)s?/i) { + $OptType = 'client'; + } +} +&Bleat(2, "Please use '--type server' or '-type newsreader'.") if !$OptType; +# parse $OptReportType +if ($OptReportType) { + if ($OptReportType =~ /sums?/i) { + $OptReportType = 'sum'; + } else { + $OptReportType = 'default'; + } +} + +### read configuration +my %Conf = %{ReadConfig($OptConfFile)}; + +### set DBTable +if ($OptDB) { + $Conf{'DBTable'} = $OptDB; +} +elsif ($OptType eq 'host') { + $Conf{'DBTable'} = $Conf{'DBTableHosts'}; +} else { + $Conf{'DBTable'} = $Conf{'DBTableClnts'}; +} + +### init database +my $DBHandle = InitDB(\%Conf,1); + +### get time period and newsgroups, prepare SQL 'WHERE' clause +# get time period +# and set caption for output and expression for SQL 'WHERE' clause +my ($CaptionPeriod,$SQLWherePeriod) = &GetTimePeriod($OptMonth); +# bail out if --month is invalid +&Bleat(2,"--month option has an invalid format - ". + "please use 'YYYY-MM', 'YYYY-MM:YYYY-MM' or 'ALL'!") if !$CaptionPeriod; +# get list of hosts and set expression for SQL 'WHERE' clause +# with placeholders as well as a list of newsgroup to bind to them +my ($SQLWhereNames,@SQLBindNames); +if ($OptNames) { + ($SQLWhereNames,@SQLBindNames) = &SQLGroupList($OptNames,$OptType); + # bail out if --names is invalid + &Bleat(2,"--names option has an invalid format!") + if !$SQLWhereNames; +} + +### build SQL WHERE clause +my $SQLWhereClause = SQLBuildClause('where',$SQLWherePeriod,$SQLWhereNames, + &SQLSetBounds('default',$LowBound,$UppBound)); + +### get sort order and build SQL 'ORDER BY' clause +# force to 'month' for $OptReportType 'sum' +$OptGroupBy = 'month' if ($OptReportType and $OptReportType ne 'default'); +# default to 'name' if $OptGroupBy is not set and +# just one name is requested, but more than one month +$OptGroupBy = 'name' if (!$OptGroupBy and $OptMonth and $OptMonth =~ /:/ + and $OptNames and $OptNames !~ /[:*%]/); +# parse $OptGroupBy to $GroupBy, create ORDER BY clause $SQLOrderClause +# if $OptGroupBy is still not set, SQLSortOrder() will default to 'month' +my ($GroupBy,$SQLOrderClause) = SQLSortOrder($OptGroupBy, $OptOrderBy, $OptType); +# $GroupBy will contain 'month' or 'host'/'client' (parsed result of $OptGroupBy) +# set it to 'month' or 'key' for OutputData() +$GroupBy = ($GroupBy eq 'month') ? 'month' : 'key'; + +### get report type and build SQL 'SELECT' query +my $SQLSelect; +my $SQLGroupClause = ''; +my $Precision = 0; # number of digits right of decimal point for output +if ($OptReportType and $OptReportType ne 'default') { + $SQLGroupClause = "GROUP BY $OptType"; + # change $SQLOrderClause: replace everything before 'postings' + $SQLOrderClause =~ s/BY.+postings/BY postings/; + $SQLSelect = "'All months',$OptType,SUM(postings)"; + # change $SQLOrderClause: replace 'postings' with 'SUM(postings)' + $SQLOrderClause =~ s/postings/SUM(postings)/; + } else { + $SQLSelect = "month,$OptType,postings"; +}; + +### get length of longest newsgroup name delivered by query +### for formatting purposes +my $Field = ($GroupBy eq 'month') ? $OptType : 'month'; +my ($MaxLength,$MaxValLength) = &GetMaxLength($DBHandle,$Conf{'DBTable'}, + $Field,'postings',$SQLWhereClause, + @SQLBindNames); + +### build and execute SQL query +my ($DBQuery); +# prepare query +$DBQuery = $DBHandle->prepare(sprintf('SELECT %s FROM %s.%s %s %s %s', + $SQLSelect, + $Conf{'DBDatabase'},$Conf{'DBTable'}, + $SQLWhereClause,$SQLGroupClause, + $SQLOrderClause)); +# execute query +$DBQuery->execute(@SQLBindNames) + or &Bleat(2,sprintf("Can't get %ss data for %s from %s.%s: %s\n", + $OptType,$CaptionPeriod,$Conf{'DBDatabase'},$Conf{'DBTable'}, + $DBI::errstr)); + +### output results +# set default to 'pretty' +$OptFormat = 'pretty' if !$OptFormat; +# print captions if --caption is set +if ($OptCaptions && $OptComments) { + # print time period with report type + my $CaptionReportType = '(number of postings for each month)'; + if ($OptReportType and $OptReportType ne 'default') { + $CaptionReportType = '(number of all postings for that time period)'; + } + printf("# ----- Report for %s %s\n",$CaptionPeriod,$CaptionReportType); + # print name list if --names is set + printf("# ----- Names: %s\n",join(',',split(/:/,$OptNames))) + if $OptNames; + # print boundaries, if set + my $CaptionBoundary= '(counting only month fulfilling this condition)'; + printf("# ----- Threshold: %s %s x %s %s %s\n", + $LowBound ? $LowBound : '',$LowBound ? '=>' : '', + $UppBound ? '<=' : '',$UppBound ? $UppBound : '',$CaptionBoundary) + if ($LowBound or $UppBound); + # print primary and secondary sort order + printf("# ----- Grouped by %s (%s), sorted %s%s\n", + ($GroupBy eq 'month') ? 'Months' : 'Names', + ($OptGroupBy and $OptGroupBy =~ /-?desc$/i) ? 'descending' : 'ascending', + ($OptOrderBy and $OptOrderBy =~ /posting/i) ? 'by number of postings ' : '', + ($OptOrderBy and $OptOrderBy =~ /-?desc$/i) ? 'descending' : 'ascending'); +} + +# output data +&OutputData($OptFormat,$OptComments,$GroupBy,$Precision,'', + $OptFileTemplate,$DBQuery,$MaxLength,$MaxValLength); + +### close handles +$DBHandle->disconnect; + +__END__ + +################################ Documentation ################################# + +=head1 NAME + +cliservstats - create reports on host or client usage + +=head1 SYNOPSIS + +B B<-t> I [B<-Vhcs> B<--comments>] [B<-m> I[:I] | I] [B<-n> I] [B<-r> I] [B<-l> I] [B<-u> I] [B<-g> I] [B<-o> I] [B<-f> I] [B<--filetemplate> I] [B<--db> I] [B<--conffile> I] + +=head1 REQUIREMENTS + +See L. + +=head1 DESCRIPTION + +This script create reports on newsgroup usage (number of postings from +each host or using each client per month) taken from result tables +created by B. + +=head2 Features and options + +=head3 Time period and names + +The time period to act on defaults to last month; you can assign another +time period or a single month (or drop all time constraints) via the +B<--month> option (see below). + +B will process all hosts or clients by default; you can +limit processing to only some hosts or clients by supplying a list of +those names by using the B<--names> option (see below). + +=head3 Report type + +You can choose between different B<--report> types: postings per month +or all postings summed up; for details, see below. + +=head3 Upper and lower boundaries + +Furthermore you can set an upper and/or lower boundary to exclude some +results from output via the B<--lower> and B<--upper> options, +respectively. By default, all hosts/clients with more and/or less +postings per month will be excluded from the result set (i.e. not +shown and not considered forsum reports). + +=head3 Sorting and formatting the output + +By default, all results are grouped by month; you can group results by +hosts/clients instead via the B<--group-by> option. Within those +groups, the list of hosts/clients (or months) is sorted alphabetically +(or chronologically, respectively) ascending. You can change that order +(and sort by number of postings) with the B<--order-by> option. For +details and exceptions, please see below. + +The results will be formatted as a kind of table; you can change the +output format to a simple list or just a list of names and number of +postings with the B<--format> option. Captions will be added by means of +the B<--caption> option; all comments (and captions) can be supressed by +using B<--nocomments>. + +Last but not least you can redirect all output to a number of files, e.g. +one for each month, by submitting the B<--filetemplate> option, see below. +Captions and comments are automatically disabled in this case. + +=head2 Configuration + +B will read its configuration from F +which should be present in etc/ via Config::Auto or from a configuration file +submitted by the B<--conffile> option. + +See doc/INSTALL for an overview of possible configuration options. + +You can override some configuration options via the B<--db> option. + +=head1 OPTIONS + +=over 3 + +=item B<-V>, B<--version> + +Print out version and copyright information and exit. + +=item B<-h>, B<--help> + +Print this man page and exit. + +=item B<-t>, B<--type> I + +Create report for hosts (servers) or clients (newsreaders), using +I or I respectively. + +=item B<-m>, B<--month> I + +Set processing period to a single month in YYYY-MM format or to a time +period between two month in YYYY-MM:YYYY-MM format (two month, separated +by a colon). By using the keyword I instead, you can set no +processing period to process the whole database. + +=item B<-n>, B<--names> I + +Limit processing to a certain set of host or client names. I +can be a single name (eternal-september.org), a group of names +(*.inka.de) or a list of either of these, separated by colons, for +example + + eternal-september.org:solani.org:*.inka.de + +=item B<-r>, B<--report> I + +Choose the report type: I or I + +By default, B will report the number of postings for each +host/client in each month. But it can also report the total sum of postings +per host/client for all months. + +For report type I, the B option has no meaning and +will be silently ignored (see below). + +=item B<-l>, B<--lower> I + +Set the lower boundary. See below. + +=item B<-l>, B<--upper> I + +Set the upper boundary. + +By default, all hosts/clients with more postings per month than the +upper boundary and/or less postings per month than the lower boundary +will be excluded from further processing. For the default report that +means each month only hosts/clients with a number of postings between +the boundaries will be displayed. For the sums report, hosts/clients +with a number of postings exceeding the boundaries in all (!) months +will not be considered. + +=item B<-g>, B<--group-by> I + +By default, all results are grouped by month, sorted chronologically in +ascending order, like this: + + # ----- 2012-01: + arcor-online.net : 9379 + individual.net : 19525 + news.albasani.net: 9063 + # ----- 2012-02: + arcor-online.net : 8606 + individual.net : 16768 + news.albasani.net: 7879 + +The results can be grouped by host/client instead via +B<--group-by> I: + + ----- individual.net + 2012-01: 19525 + 2012-02: 16768 + ----- arcor-online.net + 2012-01: 9379 + 2012-02: 8606 + ----- news.albasani.net + 2012-01: 9063 + 2012-02: 7879 + +By appending I<-desc> to the group-by option parameter, you can reverse +the sort order - e.g. B<--group-by> I will give: + + # ----- 2012-02: + arcor-online.net : 8606 + individual.net : 16768 + news.albasani.net: 7879 + # ----- 2012-01: + arcor-online.net : 9379 + individual.net : 19525 + news.albasani.net: 9063 + +Sums reports (see above) will always be grouped by months; this option +will therefore be ignored. + +=item B<-o>, B<--order-by> I + +Within each group (a single month or single host/client, see above), +the report will be sorted by name (or month) in ascending alphabetical +order by default. You can change the sort order to descending or sort +by number of postings instead. + +=item B<-f>, B<--format> I + +Select the output format, I being the default: + + # ----- 2012-01: + arcor-online.net : 9379 + individual.net : 19525 + # ----- 2012-02: + arcor-online.net : 8606 + individual.net : 16768 + +I format looks like this: + + 2012-01 arcor-online.net 9379 + 2012-01 individual.net 19525 + 2012-02 arcor-online.net 8606 + 2012-02 individual.net 16768 + +And I format looks like this: + + # 2012-01: + arcor-online.net 9379 + individual.net 19525 + # 2012-02: + arcor-online.net 8606 + individual.net 16768 + +You can remove the comments by using B<--nocomments>, see below. + +=item B<-c>, B<--captions|--nocaptions> + +Add captions to output, like this: + + ----- Report for 2012-01 to 2012-02 (number of postings for each month) + ----- Names: individual.net + ----- Threshold: 8000 => x (counting only month fulfilling this condition) + ----- Grouped by Month (ascending), sorted by number of postings descending + +False by default. + +=item B<--comments|--nocomments> + +Add comments (group headers) to I and I output. True by default. + +Use I<--nocomments> to suppress anything except newsgroup names/months and +numbers of postings. This is enforced when using B<--filetemplate>, see below. + +=item B<--filetemplate> I + +Save output to file(s) instead of dumping it to STDOUT. B will +create one file for each month (or each host/client, accordant to the +setting of B<--group-by>, see above), with filenames composed by adding +year and month (or host/client names) to the I, for +example with B<--filetemplate> I: + + stats-2012-01 + stats-2012-02 + ... and so on + +B<--nocomments> is enforced, see above. + +=item B<--db> I + +Override I or I from F. + +=item B<--conffile> I + +Load configuration from I instead of F. + +=back + +=head1 INSTALLATION + +See L. + +=head1 EXAMPLES + +Show number of postings per group for lasth month in I format: + + cliservstats --type host + +Show that report for January of 2010 and *.inka plus individual.net: + + cliservstats --type host --month 2010-01 --names *.inka:individual.net: + +Only show clients with 30 postings or less last month, ordered +by number of postings, descending, in I format: + + cliservstats --type client --upper 30 --order-by postings-desc + +List number of postings per host for each month of 2010 and redirect +output to one file for each month, named hosts-2010-01 and so on, in +machine-readable form (without formatting): + + cliservstats -t host -m 2010-01:2010-12 -f dump --filetemplate hosts + + +=head1 FILES + +=over 4 + +=item F + +The script itself. + +=item F + +Library functions for the NewsStats package. + +=item F + +Runtime configuration file. + +=back + +=head1 BUGS + +Please report any bugs or feature requests to the author or use the +bug tracker at L! + +=head1 SEE ALSO + +=over 2 + +=item - + +L + +=item - + +l>doc/INSTALL> + +=item - + +gatherstats -h + +=back + +This script is part of the B package. + +=head1 AUTHOR + +Thomas Hochstein + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2025 Thomas Hochstein + +This program is free software; you may redistribute it and/or modify it +under the same terms as Perl itself. + +=cut From c6432dcd4464e750146e0d3d27ada34188d250b3 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 01:55:09 +0200 Subject: [PATCH 08/30] Add --mid to gatherstats. Parse just a specific entry defined by Message-ID and set --test and --debug modes. Signed-off-by: Thomas Hochstein --- bin/gatherstats.pl | 76 +++++++++++++++++++++++++++++++--------------- 1 file changed, 51 insertions(+), 25 deletions(-) diff --git a/bin/gatherstats.pl b/bin/gatherstats.pl index c741da7..22ebcc8 100755 --- a/bin/gatherstats.pl +++ b/bin/gatherstats.pl @@ -37,13 +37,15 @@ my %LegalStats; ### read commandline options my ($OptCheckgroupsFile,$OptClientsDB,$OptDebug,$OptGroupsDB,$OptTLH, - $OptHostsDB,$OptMonth,$OptRawDB,$OptStatsType,$OptTest,$OptConfFile); + $OptHostsDB,$OptMID,$OptMonth,$OptRawDB,$OptStatsType,$OptTest, + $OptConfFile); GetOptions ('c|checkgroups=s' => \$OptCheckgroupsFile, 'clientsdb=s' => \$OptClientsDB, 'd|debug!' => \$OptDebug, 'groupsdb=s' => \$OptGroupsDB, 'hierarchy=s' => \$OptTLH, 'hostsdb=s' => \$OptHostsDB, + 'mid=s' => \$OptMID, 'm|month=s' => \$OptMonth, 'rawdb=s' => \$OptRawDB, 's|stats=s' => \$OptStatsType, @@ -64,6 +66,11 @@ $ConfOverride{'DBTableHosts'} = $OptHostsDB if $OptHostsDB; $ConfOverride{'TLH'} = $OptTLH if $OptTLH; &OverrideConfig(\%Conf,\%ConfOverride); +# set --debug and --test if --mid is set +if ($OptMID) { + $OptDebug = 1; $OptTest = 1; +} + ### get type of information to gather, defaulting to 'all' $OptStatsType = 'all' if !$OptStatsType; &Bleat(2, sprintf("Unknown type '%s'!", $OptStatsType)) @@ -120,7 +127,7 @@ foreach my $Month (&ListMonth($Period)) { ### GroupStats if ($OptStatsType eq 'all' or $OptStatsType eq 'groups') { - &GroupStats($DBHandle,$DBRaw,$DBGrps,$Month,$TLH,$OptCheckgroupsFile,$OptTest,$OptDebug); + &GroupStats($DBHandle,$DBRaw,$DBGrps,$Month,$TLH,$OptCheckgroupsFile,$OptMID,$OptTest,$OptDebug); }; ### HostStats @@ -129,7 +136,7 @@ foreach my $Month (&ListMonth($Period)) { my @KnownHosts = qw(aioe.org arcor-online.net arcor-ip.de news.astraweb.com read.cnntp.org easynews.com eternal-september.org fernuni-hagen.de free.fr newsread.freenet.ag googlegroups.com news.neostrada.pl newsdawg.com newscene.com news-service.com octanews.com xsnews.nl news.xs4all.nl); - &HostStats($DBHandle,$DBRaw,$DBHosts,$Month,$OptTest,$OptDebug,@KnownHosts); + &HostStats($DBHandle,$DBRaw,$DBHosts,$Month,$OptMID,$OptTest,$OptDebug,@KnownHosts); }; }; @@ -145,29 +152,40 @@ sub GroupStats { ### $DBRaw : database table for raw data (to read from) ### $DBGrps : database table for groups data (to write to) ### $Month : current month to do +### $MID : specific Message-ID to fetch (testing purposes) ### $TLH : TLHs to collect ### $Checkgroupsfile : filename template for checkgroups file ### (expanded to $Checkgroupsfile-$Month) ### $Test : test mode ### $Debug : debug mode ### OUT: (nothing) - my ($DBHandle,$DBRaw,$DBGrps,$Month,$TLH,$CheckgroupsFile,$Test,$Debug) = @_; + my ($DBHandle,$DBRaw,$DBGrps,$Month,$TLH,$CheckgroupsFile,$MID,$Test,$Debug) = @_; # read list of newsgroups from --checkgroups # into a hash my %ValidGroups = %{ReadGroupList(sprintf('%s-%s',$CheckgroupsFile,$Month))} if $CheckgroupsFile; - ### ---------------------------------------------- - ### get groups data (number of postings per group) - # get groups data from raw table for given month - my $DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups FROM %s ". - "WHERE day LIKE ? AND NOT disregard", - $DBRaw)); - $DBQuery->execute($Month.'-%') - or &Bleat(2,sprintf("Can't get groups data for %s from %s: ". - "$DBI::errstr\n",$Month, - $DBRaw)); + my $DBQuery; + if (!$MID) { + ### ---------------------------------------------- + ### get groups data (number of postings per group) + # get groups data from raw table for given month + $DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups FROM %s ". + "WHERE day LIKE ? AND NOT disregard", + $DBRaw)); + $DBQuery->execute($Month.'-%') + or &Bleat(2,sprintf("Can't get groups data for %s from %s: ". + "$DBI::errstr\n",$Month, + $DBRaw)); + } else { + $DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups FROM %s ". + "WHERE mid = ?", $DBRaw)); + $DBQuery->execute($MID) + or &Bleat(2,sprintf("Can't get groups data for %s from %s: ". + "$DBI::errstr\n",$MID, + $DBRaw)); + } # count postings per group my %Postings; @@ -232,22 +250,30 @@ sub HostStats { ### $DBRaw : database table for raw data (to read from) ### $DBHosts : database table for hosts data (to write to) ### $Month : current month to do +### $MID : specific Message-ID to fetch (testing purposes) ### $Test : test mode ### $Debug : debug mode ### @KnownHosts : list of known hosts with subdomains ### OUT: (nothing) - my ($DBHandle,$DBRaw,$DBHosts,$Month,$Test,$Debug,@KnownHosts) = @_; + my ($DBHandle,$DBRaw,$DBHosts,$Month,$MID,$Test,$Debug,@KnownHosts) = @_; - # define known hosts using subdomains - my %Postings; + my (%Postings,$DBQuery); - # get raw header data from raw table for given month - my $DBQuery = $DBHandle->prepare(sprintf("SELECT headers FROM %s ". - "WHERE day LIKE ? AND NOT disregard", - $DBRaw)); - $DBQuery->execute($Month.'-%') - or &Bleat(2,sprintf("Can't get hosts data for %s from %s.%s: ". - "$DBI::errstr\n",$Month,$DBRaw)); + if (!$MID) { + # get raw header data from raw table for given month + $DBQuery = $DBHandle->prepare(sprintf("SELECT headers FROM %s ". + "WHERE day LIKE ? AND NOT disregard", + $DBRaw)); + $DBQuery->execute($Month.'-%') + or &Bleat(2,sprintf("Can't get hosts data for %s from %s.%s: ". + "$DBI::errstr\n",$Month,$DBRaw)); + } else { + $DBQuery = $DBHandle->prepare(sprintf("SELECT headers FROM %s ". + "WHERE mid = ?", $DBRaw)); + $DBQuery->execute($MID) + or &Bleat(2,sprintf("Can't get hosts data for %s from %s.%s: ". + "$DBI::errstr\n",$MID,$DBRaw)); + } ### ---------------------------------------------- print "----- HostStats -----\n" if $Debug; @@ -319,7 +345,7 @@ sub HostStats { &Bleat(2,sprintf("%s FAILED", $Header{'message-id'})) if !$Host; } - # !DEBUG! printf("%s: %s\n", $Header{'message-id'}, $Host); + printf("%s: %s\n", $Header{'message-id'}, $Host) if $MID; }; # delete old data for that month From 93b8d564ba3b05d261f6b2d7d0dc0be05db1c788 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 01:55:45 +0200 Subject: [PATCH 09/30] Remove parsing of NNTP-Posting-Host. NNTP-Posting-Host contains the client, not the server. Signed-off-by: Thomas Hochstein --- bin/gatherstats.pl | 6 ------ 1 file changed, 6 deletions(-) diff --git a/bin/gatherstats.pl b/bin/gatherstats.pl index 22ebcc8..6819b62 100755 --- a/bin/gatherstats.pl +++ b/bin/gatherstats.pl @@ -295,12 +295,6 @@ sub HostStats { # reset if IP address undef($Host) if $Host && $Host !~ /[g-z]/i; } - # NNTP-Posting-Host - if (!$Host && $Header{'nntp-posting-host'}) { - ($Host) = $Header{'nntp-posting-host'} =~ /^\s*([a-z0-9-_]+\.[a-z0-9-_.]+)/i; - # reset if IP address - undef($Host) if $Host && $Host !~ /[g-z]/i; - } # Path if (!$Host) { if ($Header{'path'} =~ /!([^!]+)!.POSTED!/) { From f5aa64981059fdadb68a1f364d402a460dc5b4e7 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 02:00:15 +0200 Subject: [PATCH 10/30] Add known hosts. Signed-off-by: Thomas Hochstein --- bin/gatherstats.pl | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/bin/gatherstats.pl b/bin/gatherstats.pl index 6819b62..8e2e1bf 100755 --- a/bin/gatherstats.pl +++ b/bin/gatherstats.pl @@ -133,9 +133,11 @@ foreach my $Month (&ListMonth($Period)) { ### HostStats if ($OptStatsType eq 'all' or $OptStatsType eq 'hosts') { # define known hosts using subdomains - my @KnownHosts = qw(aioe.org arcor-online.net arcor-ip.de news.astraweb.com read.cnntp.org easynews.com eternal-september.org - fernuni-hagen.de free.fr newsread.freenet.ag googlegroups.com - news.neostrada.pl newsdawg.com newscene.com news-service.com octanews.com xsnews.nl news.xs4all.nl); + my @KnownHosts = qw(aioe.org arcor-online.net arcor-ip.de news.astraweb.com read.cnntp.org easynews.com + eternal-september.org euro.net fernuni-hagen.de free.fr newsread.freenet.ag + googlegroups.com news.neostrada.pl newsdawg.com newscene.com news-service.com + octanews.com wieslauf.sub.de highway.telekom.at united-newsserver.de xsnews.nl + news.xs4all.nl); &HostStats($DBHandle,$DBRaw,$DBHosts,$Month,$OptMID,$OptTest,$OptDebug,@KnownHosts); }; }; From c1e6b0161e67c744f566395ebba578c88101f1fd Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 02:27:24 +0200 Subject: [PATCH 11/30] Update gatherstats documentation. Signed-off-by: Thomas Hochstein --- bin/gatherstats.pl | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/bin/gatherstats.pl b/bin/gatherstats.pl index 8e2e1bf..04da9bd 100755 --- a/bin/gatherstats.pl +++ b/bin/gatherstats.pl @@ -399,9 +399,7 @@ below). By default B will process all types of information; you can change that using the B<--stats> option and assigning the type of -information to process. Currently that doesn't matter yet as only -processing of the number of postings per group per month is -implemented anyway. +information to process. Possible information types include: @@ -423,6 +421,16 @@ only once for de.alt.ALL and de.ALL. Data is written to I (see L); you can override that default through the B<--groupsdb> option. +=item B (postings from host per month) + +B will examine Injection-Info:, X-Trace: and Path: +headers and try to normalize them. + +Filtering on I is not yet implemented. + +Data is written to I (see L); you can +override that default through the B<--hostsdb> option. + =back =head2 Configuration @@ -467,9 +475,8 @@ by a colon). =item B<-s>, B<--stats> I -Set processing type to one of I and I. Defaults to all -(and is currently rather pointless as only I has been -implemented). +Set processing type to one of I, I or I. Defaults +to all. =item B<-c>, B<--checkgroups> I @@ -585,7 +592,7 @@ Thomas Hochstein =head1 COPYRIGHT AND LICENSE -Copyright (c) 2010-2013 Thomas Hochstein +Copyright (c) 2010-2013, 2025 Thomas Hochstein This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. From 799eddab5bbb093f4d2572373103b9544d3a08f7 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 02:48:02 +0200 Subject: [PATCH 12/30] Update ChangeLog. Signed-off-by: Thomas Hochstein --- doc/ChangeLog | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index b21f9a5..856c101 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,13 @@ NewsStats 0.3.0 (unreleased) - + * Extract GroupStats (in gatherstats) to subroutine. + * Add ParseHeader() to library. + * Add HostStats to gatherstats + * Add DBTableHosts structure to install script. + * Add cliservstats (for hosts and clients). + - Refactor SQL generators. + * Add --mid option to gatherstats for debugging purposes. + * Don't parse NNTP-Posting-Host to determine the server name. + * Add more known hosts. NewsStats 0.2.0 (2025-05-10) * Redo directory structure: From c7206a2eaf8d757922e5d4d6b37b63fd9c71ddd3 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 03:01:06 +0200 Subject: [PATCH 13/30] Update README, TODO and copyright dates. Signed-off-by: Thomas Hochstein --- doc/INSTALL | 2 +- doc/README | 16 +++++++++------- doc/TODO | 5 ++--- install/install.pl | 4 ++-- lib/NewsStats.pm | 2 +- 5 files changed, 15 insertions(+), 14 deletions(-) diff --git a/doc/INSTALL b/doc/INSTALL index 24eeaf8..731f000 100644 --- a/doc/INSTALL +++ b/doc/INSTALL @@ -1,4 +1,4 @@ -NewsStats (c) 2010-2013 Thomas Hochstein +NewsStats (c) 2010-2013, 2025 Thomas Hochstein NewsStats is a software package used to gather statistical information from a live Usenet feed and for its subsequent examination. diff --git a/doc/README b/doc/README index 57f8bec..9ac37ed 100644 --- a/doc/README +++ b/doc/README @@ -1,4 +1,4 @@ -NewsStats (c) 2010-2013 Thomas Hochstein +NewsStats (c) 2010-2013, 2025 Thomas Hochstein NewsStats is a software package for gathering statistical data live from a Usenet feed and subsequent examination. @@ -61,14 +61,16 @@ Getting Started 'feedlog.pl' will continuously feed raw data to your raw data table. See the feedlog.pl man page for more information. - You can process that data via 'gatherstats.pl'; currently only the - tabulation of postings per group and month is supported. More to - come. See the gatherstats.pl man page for more information. + You can process that data via 'gatherstats.pl'; currently the + tabulation of postings per group and injection server per month is + supported. Tabulation of clients (newsreaders) is planned. See + the gatherstats.pl man page for more information. Report generation is handled by specialised scripts for each - report type. Currently only reports on the number of postings per - group and month are supported; you can use 'groupstats.pl' for - this. See the groupstats.pl man page for more information. + report type. Currently reports on the number of postings per group + and month and injection server and month are supported; you can + use 'groupstats.pl' and 'cliservstats.pl' for. See the + groupstats.pl and cliservstats.pl man pages for more information. Reporting Bugs diff --git a/doc/TODO b/doc/TODO index 63bcfdf..a376c53 100644 --- a/doc/TODO +++ b/doc/TODO @@ -28,8 +28,7 @@ NewsStats. mentioned information; and you should be able to get the history of any group. - Add other reports - NewsStats should include some other kinds of reports (stats on used clients, - on postings hosts/servers, ...) + NewsStats should include some other kinds of reports (stats on used clients) - Add tools for database management NewsStats should offer tools e.g. to inject postings into the 'raw' database, or to split databases. @@ -65,7 +64,7 @@ NewsStats. + gatherstats.pl - Use hierarchy information (see GroupInfo above) - - Add gathering of other stats (clients, hosts, ...) + - Add gathering of other stats (clients, ...) - better modularisation (code reuse for other reports!) - Add / enhance / test error handling - General tests and optimisations diff --git a/install/install.pl b/install/install.pl index b4eb4cc..deaa43a 100755 --- a/install/install.pl +++ b/install/install.pl @@ -6,7 +6,7 @@ # # It is part of the NewsStats package. # -# Copyright (c) 2010-2013 Thomas Hochstein +# Copyright (c) 2010-2013, 2025 Thomas Hochstein # # It can be redistributed and/or modified under the same terms under # which Perl itself is published. @@ -350,7 +350,7 @@ Thomas Hochstein =head1 COPYRIGHT AND LICENSE -Copyright (c) 2010-2013 Thomas Hochstein +Copyright (c) 2010-2013, 2025 Thomas Hochstein This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. diff --git a/lib/NewsStats.pm b/lib/NewsStats.pm index 9aec802..cb376c0 100644 --- a/lib/NewsStats.pm +++ b/lib/NewsStats.pm @@ -77,7 +77,7 @@ sub ShowVersion { ################################################################################ ### display version and exit print "$0 from NewsStats v$VERSION\n"; - print "Copyright (c) 2010-2013 Thomas Hochstein \n"; + print "Copyright (c) 2010-2013, 2025 Thomas Hochstein \n"; print "This program is free software; you may redistribute it ". "and/or modify it under the same terms as Perl itself.\n"; exit(100); From f6b7a1d000ec42e0debdab3b6b2542edab801195 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 10:54:06 +0200 Subject: [PATCH 14/30] Add higher debug level to gatherstats. Signed-off-by: Thomas Hochstein --- bin/gatherstats.pl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bin/gatherstats.pl b/bin/gatherstats.pl index 04da9bd..bb58252 100755 --- a/bin/gatherstats.pl +++ b/bin/gatherstats.pl @@ -41,7 +41,7 @@ my ($OptCheckgroupsFile,$OptClientsDB,$OptDebug,$OptGroupsDB,$OptTLH, $OptConfFile); GetOptions ('c|checkgroups=s' => \$OptCheckgroupsFile, 'clientsdb=s' => \$OptClientsDB, - 'd|debug!' => \$OptDebug, + 'd|debug+' => \$OptDebug, 'groupsdb=s' => \$OptGroupsDB, 'hierarchy=s' => \$OptTLH, 'hostsdb=s' => \$OptHostsDB, @@ -341,7 +341,7 @@ sub HostStats { &Bleat(2,sprintf("%s FAILED", $Header{'message-id'})) if !$Host; } - printf("%s: %s\n", $Header{'message-id'}, $Host) if $MID; + printf("%s: %s\n", $Header{'message-id'}, $Host) if ($MID or $Debug && $Debug >1); }; # delete old data for that month From f7485561ddf849ac9e80d72809abf153e583694a Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 10:54:16 +0200 Subject: [PATCH 15/30] Fix Path: header parsing. Signed-off-by: Thomas Hochstein --- bin/gatherstats.pl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/bin/gatherstats.pl b/bin/gatherstats.pl index bb58252..e47f51f 100755 --- a/bin/gatherstats.pl +++ b/bin/gatherstats.pl @@ -301,16 +301,16 @@ sub HostStats { if (!$Host) { if ($Header{'path'} =~ /!([^!]+)!.POSTED!/) { $Host = "$1"; - } elsif ($Header{'path'} =~ /!.POSTED.([^!]+)!/) { + } elsif ($Header{'path'} =~ /([^!]+)!.POSTED.[^!]+!?/) { $Host = "$1"; } else { # iterate on the Path: header until we have a host name or no more # path elements while (!$Host && $Header{'path'} =~ /!/) { - ($Host) = $Header{'path'} =~ /!?([a-z0-9-_]+\.[a-z0-9-_.]+)![^!]+$/i; + ($Host) = $Header{'path'} =~ /!?([a-z0-9-_]+\.[a-z0-9-_.]+)!!?[^!]+!?$/i; undef($Host) if $Host && $Host =~ /\.MISMATCH/; # remove last path element - $Header{'path'} =~ s/![^!]+$//; + $Header{'path'} =~ s/!!?[^!]+$//; }; } } From e40e96a1e2e1a359d1d8094bdbb2b3c8b42518c4 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 11:11:52 +0200 Subject: [PATCH 16/30] Add more hosts and special cases. Signed-off-by: Thomas Hochstein --- bin/gatherstats.pl | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/bin/gatherstats.pl b/bin/gatherstats.pl index e47f51f..8359b8a 100755 --- a/bin/gatherstats.pl +++ b/bin/gatherstats.pl @@ -133,11 +133,11 @@ foreach my $Month (&ListMonth($Period)) { ### HostStats if ($OptStatsType eq 'all' or $OptStatsType eq 'hosts') { # define known hosts using subdomains - my @KnownHosts = qw(aioe.org arcor-online.net arcor-ip.de news.astraweb.com read.cnntp.org easynews.com - eternal-september.org euro.net fernuni-hagen.de free.fr newsread.freenet.ag - googlegroups.com news.neostrada.pl newsdawg.com newscene.com news-service.com - octanews.com wieslauf.sub.de highway.telekom.at united-newsserver.de xsnews.nl - news.xs4all.nl); + my @KnownHosts = qw(abavia.com aioe.org arcor-online.net arcor-ip.de news.astraweb.com read.cnntp.org + easynews.com eternal-september.org euro.net fernuni-hagen.de free.fr newsread.freenet.ag + googlegroups.com heirich.name news.neostrada.pl netcologne.de newsdawg.com newscene.com + news-service.com octanews.com .readnews.com wieslauf.sub.de highway.telekom.at + united-newsserver.de xennanews.com xlned.com xsnews.nl news.xs4all.nl); &HostStats($DBHandle,$DBRaw,$DBHosts,$Month,$OptMID,$OptTest,$OptDebug,@KnownHosts); }; }; @@ -315,14 +315,15 @@ sub HostStats { } } - # special cases - $Host = 'news.highwinds-media.com' if $Host =~ /fx\d\d\.\S{3}\.POSTED/ - or $Host =~ /newsfe\d+\.(iad|ams2)/; - $Host = 'newshosting.com' if $Host =~ /post\d*\.iad/; - # trailing .POSTED ($Host) = $Host =~ /(\S+)\.POSTED$/ if $Host =~ /\.POSTED$/; + # special cases + $Host = 'news.highwinds-media.com' if $Host =~ /f(e|x)\d\d\.\S{3}\d?$/ + or $Host =~ /(newsfe|fed)\d+\.(iad|ams2)$/; + $Host = 'newshosting.com' if $Host =~ /post\d*\.iad$/; + $Host = 'eternal-september.org' if $Host =~ /dont-email\.me$/; + # normalize hosts foreach (@KnownHosts) { if ($Host =~ /\.$_$/) { From ea493f3da0621af4bc9e6439b7356375cafbb276 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 12:11:28 +0200 Subject: [PATCH 17/30] gatherstats: implement --hierarchy check. Signed-off-by: Thomas Hochstein --- bin/gatherstats.pl | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/bin/gatherstats.pl b/bin/gatherstats.pl index 8359b8a..83f2ee9 100755 --- a/bin/gatherstats.pl +++ b/bin/gatherstats.pl @@ -263,26 +263,38 @@ sub HostStats { if (!$MID) { # get raw header data from raw table for given month - $DBQuery = $DBHandle->prepare(sprintf("SELECT headers FROM %s ". + $DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups,headers FROM %s ". "WHERE day LIKE ? AND NOT disregard", $DBRaw)); $DBQuery->execute($Month.'-%') - or &Bleat(2,sprintf("Can't get hosts data for %s from %s.%s: ". + or &Bleat(2,sprintf("Can't get hosts data for %s from %s: ". "$DBI::errstr\n",$Month,$DBRaw)); } else { - $DBQuery = $DBHandle->prepare(sprintf("SELECT headers FROM %s ". + $DBQuery = $DBHandle->prepare(sprintf("SELECT newsgroups,headers FROM %s ". "WHERE mid = ?", $DBRaw)); $DBQuery->execute($MID) - or &Bleat(2,sprintf("Can't get hosts data for %s from %s.%s: ". + or &Bleat(2,sprintf("Can't get hosts data for %s from %s: ". "$DBI::errstr\n",$MID,$DBRaw)); } ### ---------------------------------------------- print "----- HostStats -----\n" if $Debug; ### parse headers - while (($_) = $DBQuery->fetchrow_array) { + while (my ($Newsgroups,$Headers) = $DBQuery->fetchrow_array) { + ### skip postings with wrong TLH + # remove whitespace from contents of Newsgroups: + chomp($Newsgroups); + $Newsgroups =~ s/\s//; + my $GroupCount; + for (split /,/, $Newsgroups) { + # don't count newsgroup/hierarchy in wrong TLH + next if($TLH and !/^$TLH/); + $GroupCount++; + }; + next if !$GroupCount; + my $Host; - my %Header = ParseHeaders(split(/\n/,$_)); + my %Header = ParseHeaders(split(/\n/,$Headers)); # ([a-z0-9-_]+\.[a-z0-9-_.]+) tries to match a hostname # Injection-Info @@ -425,9 +437,8 @@ override that default through the B<--groupsdb> option. =item B (postings from host per month) B will examine Injection-Info:, X-Trace: and Path: -headers and try to normalize them. - -Filtering on I is not yet implemented. +headers and try to normalize them. Groups not in I will be +ignored. Data is written to I (see L); you can override that default through the B<--hostsdb> option. From c6346470f9246c7006d0ac17a18ef5b7e8f44385 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 14:32:09 +0200 Subject: [PATCH 18/30] Add sums per month to HostStats. Signed-off-by: Thomas Hochstein --- bin/cliservstats.pl | 7 +++++++ bin/gatherstats.pl | 3 ++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/bin/cliservstats.pl b/bin/cliservstats.pl index 6d76779..5f9b3f4 100644 --- a/bin/cliservstats.pl +++ b/bin/cliservstats.pl @@ -107,7 +107,9 @@ if ($OptNames) { } ### build SQL WHERE clause +my $ExcludeSums = $OptSums ? '' : sprintf("%s != 'ALL'",$OptType); my $SQLWhereClause = SQLBuildClause('where',$SQLWherePeriod,$SQLWhereNames, + $ExcludeSums, &SQLSetBounds('default',$LowBound,$UppBound)); ### get sort order and build SQL 'ORDER BY' clause @@ -304,6 +306,11 @@ example eternal-september.org:solani.org:*.inka.de +=item B<-s>, B<--sums|--nosums> (sum per month) + +Include a "virtual" host named "ALL" for every month in output, +containing the sum of all detected hosts for that month. + =item B<-r>, B<--report> I Choose the report type: I or I diff --git a/bin/gatherstats.pl b/bin/gatherstats.pl index 83f2ee9..1dc5b78 100755 --- a/bin/gatherstats.pl +++ b/bin/gatherstats.pl @@ -350,6 +350,7 @@ sub HostStats { # count host if ($Host) { $Postings{$Host}++; + $Postings{'ALL'}++; } else { &Bleat(2,sprintf("%s FAILED", $Header{'message-id'})) if !$Host; } @@ -438,7 +439,7 @@ override that default through the B<--groupsdb> option. B will examine Injection-Info:, X-Trace: and Path: headers and try to normalize them. Groups not in I will be -ignored. +ignored. The sum of all detected hosts will also saved for each month. Data is written to I (see L); you can override that default through the B<--hostsdb> option. From 53c2032850f427d28d82f71f809d20d680a5da26 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Fri, 4 May 2012 07:42:52 +0200 Subject: [PATCH 19/30] Add postingstats to tools. postingstats.pl will parse groupstats output and create a posting ready to post to de.admin.news.misc. Signed-off-by: Thomas Hochstein --- tools/postingstats.pl | 99 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 99 insertions(+) create mode 100644 tools/postingstats.pl diff --git a/tools/postingstats.pl b/tools/postingstats.pl new file mode 100644 index 0000000..227f53e --- /dev/null +++ b/tools/postingstats.pl @@ -0,0 +1,99 @@ +#!/usr/bin/perl +# +# postingstats.pl +# +# This script will create a posting statistic for de.admin.lists +# from NewsStats output. +# +# It is part of the NewsStats package. +# +# Copyright (c) 2010-2012 Thomas Hochstein +# +# It can be redistributed and/or modified under the same terms under +# which Perl itself is published. +# +# $~ groupstats.pl --nocomments --sums --format dump | postingstats.pl xxxx-xx +# + +use strict; +use constant TABLEWIDTH => 28; # width of table without newsgroup name + +our $VERSION = '0.01'; + +##### ----- subroutines ----- + +sub percentage { +# calculate percentage rate from base value and percentage + my ($base,$percentage) = @_; + return ($percentage * 100 / $base); +} + +sub divider { +# build a divider line of $symbol as wide as the table is + my ($symbol,$maxlength) = @_; + return ':' . $symbol x ($maxlength+TABLEWIDTH) . ":\n"; +} + +##### ----- main loop ----- + +# get $month from ARGV +my $month = shift; + +# read from STDIN +my (%postings, $hierarchy, $maxlength); + +while(<>) { + my ($group, $postings) = split; + $hierarchy = $postings if $group eq 'de.ALL'; + next if $group =~ /ALL$/; + $postings{$group} = $postings; + $maxlength = length($group) if length($group) > $maxlength; +} + +# print to STDOUT +my $heading = ' Postingstatistik fuer de.* im Monat '.$month; +my $padding = ' ' x (($maxlength+TABLEWIDTH-2-length($heading))/2); +my $timestamp = time; +my $counter = 0; + +print < +Newsgroups: de.admin.news.misc +Subject: Postingstatistik fuer de.* im Monat $month +Message-ID: +Mime-Version: 1.0 +Content-Type: text/plain; charset=ISO-8859-1 +Content-Transfer-Encoding: 7bit +User-Agent: postingstats.pl/$VERSION (NewsStats) + +HEADER + +print ÷r('=',$maxlength); +printf(": %s%s%s :\n",$padding,$heading,$padding); +print ÷r('=',$maxlength); +printf(": Nr. : Anzahl : Prozent : %-*s :\n",$maxlength,'Newsgroup'); +print ÷r('-',$maxlength); + +foreach my $group (sort { $postings{$b} <=> $postings {$a}} keys %postings) { + $counter++; + printf(": %3u. : %6u : %6.2f%% : %-*s :\n",$counter,$postings{$group},&percentage($hierarchy,$postings{$group}),$maxlength,$group); +} + +print ÷r('-',$maxlength); +printf(": : %6u : %s : %-*s :\n",$hierarchy,'100.00%',$maxlength,'de.*'); +print ÷r('=',$maxlength); + +print < zur +Verfuegung. +LEADOUT From 83d4da5e306233c9333adcf0501d81f1566cd9f8 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 13:47:25 +0200 Subject: [PATCH 20/30] Move postingstats to /bin. Signed-off-by: Thomas Hochstein --- {tools => bin}/postingstats.pl | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename {tools => bin}/postingstats.pl (100%) diff --git a/tools/postingstats.pl b/bin/postingstats.pl similarity index 100% rename from tools/postingstats.pl rename to bin/postingstats.pl From 29e978404864c2dfa788d23d0efc10c41320fbe1 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 14:31:53 +0200 Subject: [PATCH 21/30] Refactor postingstats. - Make all text configurable (i18n). - Generalize to make it usable for HostStats. - Fallback to last month if no month is given. - Add option handling, import VERSION, add POD. Signed-off-by: Thomas Hochstein --- bin/postingstats.pl | 384 ++++++++++++++++++++++++++++++++++++-------- 1 file changed, 319 insertions(+), 65 deletions(-) diff --git a/bin/postingstats.pl b/bin/postingstats.pl index 227f53e..b378fbb 100644 --- a/bin/postingstats.pl +++ b/bin/postingstats.pl @@ -2,88 +2,93 @@ # # postingstats.pl # -# This script will create a posting statistic for de.admin.lists -# from NewsStats output. +# This script will create statistic postings from NewsStats output. +# It defaults to statistics for de.* posted to de.admin.lists, but +# defaults can be changed at ----- configuration -----. # # It is part of the NewsStats package. # -# Copyright (c) 2010-2012 Thomas Hochstein +# Copyright (c) 2010-2012, 2025 Thomas Hochstein # # It can be redistributed and/or modified under the same terms under # which Perl itself is published. # -# $~ groupstats.pl --nocomments --sums --format dump | postingstats.pl xxxx-xx +# Usage: +# $~ groupstats.pl --nocomments --sums --format dump | postingstats.pl -t groups +# $~ cliservstats.pl -t server --nocomments --sums --format dump | postingstats.pl -t hosts # +BEGIN { + use File::Basename; + # we're in .../bin, so our module is in ../lib + push(@INC, dirname($0).'/../lib'); +} use strict; +use warnings; + +use NewsStats qw(:DEFAULT LastMonth); + +use Getopt::Long qw(GetOptions); +Getopt::Long::config ('bundling'); + use constant TABLEWIDTH => 28; # width of table without newsgroup name -our $VERSION = '0.01'; +##### ----- pre-config ----------------------------------------------- +### read commandline options +my ($Month, $Type); +GetOptions ('m|month=s' => \$Month, + 't|type=s' => \$Type, + 'h|help' => \&ShowPOD, + 'V|version' => \&ShowVersion) or exit 1; +$Month = &LastMonth if !$Month; +if ($Month !~ /^\d{4}-\d{2}$/) { + $Month = &LastMonth; + &Bleat(1,"--month option has an invalid format - set to $Month."); +}; +# parse $Type +if (!$Type) { + # default + $Type = 'GroupStats'; +} elsif ($Type =~ /(news)?groups?/i) { + $Type = 'GroupStats'; +} elsif ($Type =~ /(host|server)s?/i) { + $Type = 'HostStats'; +}; +my $Timestamp = time; -##### ----- subroutines ----- - -sub percentage { -# calculate percentage rate from base value and percentage - my ($base,$percentage) = @_; - return ($percentage * 100 / $base); -} - -sub divider { -# build a divider line of $symbol as wide as the table is - my ($symbol,$maxlength) = @_; - return ':' . $symbol x ($maxlength+TABLEWIDTH) . ":\n"; -} - -##### ----- main loop ----- - -# get $month from ARGV -my $month = shift; - -# read from STDIN -my (%postings, $hierarchy, $maxlength); - -while(<>) { - my ($group, $postings) = split; - $hierarchy = $postings if $group eq 'de.ALL'; - next if $group =~ /ALL$/; - $postings{$group} = $postings; - $maxlength = length($group) if length($group) > $maxlength; -} - -# print to STDOUT -my $heading = ' Postingstatistik fuer de.* im Monat '.$month; -my $padding = ' ' x (($maxlength+TABLEWIDTH-2-length($heading))/2); -my $timestamp = time; -my $counter = 0; - -print < -Newsgroups: de.admin.news.misc -Subject: Postingstatistik fuer de.* im Monat $month -Message-ID: +##### ----- configuration -------------------------------------------- +my $TLH = 'de'; +my %Heading = ('GroupStats' => 'Postingstatistik fuer de.* im Monat '.$Month, + 'HostStats' => 'Serverstatistik fuer de.* im Monat '.$Month + ); +my %TH = ('counter' => 'Nr.', + 'value' => 'Anzahl', + 'percentage' => 'Prozent' + ); +my %LeadIn = ('GroupStats' => < < +Newsgroups: local.test +Subject: Postingstatistik fuer de.* im Monat $Month +Message-ID: +Approved: thh\@thh.name Mime-Version: 1.0 -Content-Type: text/plain; charset=ISO-8859-1 +Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: 7bit User-Agent: postingstats.pl/$VERSION (NewsStats) -HEADER +GROUPSIN +From: Thomas Hochstein +Newsgroups: local.test +Subject: Serverstatistik fuer de.* im Monat $Month +Message-ID: +Approved: thh\@thh.name +Mime-Version: 1.0 +Content-Type: text/plain; charset=us-ascii +Content-Transfer-Encoding: 7bit +User-Agent: postingstats.pl/$VERSION (NewsStats) -print ÷r('=',$maxlength); -printf(": %s%s%s :\n",$padding,$heading,$padding); -print ÷r('=',$maxlength); -printf(": Nr. : Anzahl : Prozent : %-*s :\n",$maxlength,'Newsgroup'); -print ÷r('-',$maxlength); - -foreach my $group (sort { $postings{$b} <=> $postings {$a}} keys %postings) { - $counter++; - printf(": %3u. : %6u : %6.2f%% : %-*s :\n",$counter,$postings{$group},&percentage($hierarchy,$postings{$group}),$maxlength,$group); -} - -print ÷r('-',$maxlength); -printf(": : %6u : %s : %-*s :\n",$hierarchy,'100.00%',$maxlength,'de.*'); -print ÷r('=',$maxlength); - -print < < < zur Verfuegung. -LEADOUT +GROUPSOUT + +Alle Zahlen wurden ermittelt auf einem Newsserver mit redundanter Anbin- +dung fuer de.* unter Anwendung ueblicher Filtermassnahmen. Steuernach- +richten werden nicht erfasst; Postings, die supersedet oder gecancelt +wurden, bleiben erfasst, sofern sie das System ueberhaupt (und vor der +Loeschnachricht) erreicht haben. +HOSTSOUT + +##### ----- subroutines ---------------------------------------------- + +sub Percentage { +# calculate percentage rate from base value and percentage + my ($Base,$Percentage) = @_; + return ($Percentage * 100 / $Base); +} + +sub Divider { +# build a divider line of $Symbol as wide as the table is + my ($Symbol,$MaxLength) = @_; + return ':' . $Symbol x ($MaxLength+TABLEWIDTH) . ":\n"; +} + +##### ----- main loop ------------------------------------------------ + +my (%Value, $SumName, $SumTotal, $MaxLength); +$MaxLength = 0; +if ($Type eq 'GroupStats') { + $SumName = "$TLH.ALL"; + $TH{'name'} = 'Newsgroup' +} elsif ($Type eq 'HostStats') { + $SumName = 'ALL'; + $TH{'name'} = 'Server' +} + +# read from STDIN +while(<>) { + my ($Name, $Value) = split; + $SumTotal = $Value if $Name eq $SumName; + next if $Name =~ /ALL$/; + $Value{$Name} = $Value; + $MaxLength = length($Name) if length($Name) > $MaxLength; +} + +# print to STDOUT +my $PaddingLeft = ' ' x int((($MaxLength+TABLEWIDTH-2-length($Heading{$Type}))/2)); +my $PaddingRight = $PaddingLeft; +$PaddingLeft .= ' ' if (length($Heading{$Type}) + (length($PaddingLeft) * 2) < $MaxLength+TABLEWIDTH); +my $Counter = 0; + +print $LeadIn{$Type}; + +print &Divider('=',$MaxLength); +printf(": %s%s%s :\n",$PaddingLeft,$Heading{$Type},$PaddingRight); +print &Divider('=',$MaxLength); +printf(": %-3s : %-6s : %-7s : %-*s :\n", + substr($TH{'counter'},0,3), + substr($TH{'value'},0,6), + substr($TH{'percentage'},0,7), + $MaxLength,$TH{'name'}); +print &Divider('-',$MaxLength); + +foreach my $Name (sort { $Value{$b} <=> $Value {$a}} keys %Value) { + $Counter++; + printf(": %3u. : %6u : %6.2f%% : %-*s :\n",$Counter,$Value{$Name},&Percentage($SumTotal,$Value{$Name}),$MaxLength,$Name); +} + +print &Divider('-',$MaxLength); +printf(": : %6u : %s : %-*s :\n",$SumTotal,'100.00%',$MaxLength,''); +print &Divider('=',$MaxLength); + +print $LeadOut{$Type}; + +__END__ + +################################ Documentation ################################# + +=head1 NAME + +postingstats - format and post reports + +=head1 SYNOPSIS + +B B<-t> I [B<-Vh> [B<-m> I] + +=head1 REQUIREMENTS + +See L. + +=head1 DESCRIPTION + +This script will re-format reports on newsgroup usage created by +B or B and create a message that can +be posted to Usenet. + +=head2 Features and options + +B will create a table with entries numbered from most +to least and percentages calculated from the sum total of all values. + +It depends on a sorted list on STDIN in I format with I. + +B needs a B<--type> and a B<--month> to create a caption +and select matching lead-ins and lead-outs. B<--type> is also needed +to catch the correct sum total from input. + +It will default to posting statistics (number of postings per group) +and last month. + +Output from B can be piped to any C implementation, +e.g. C from L. + +=head2 Configuration + +Configuration is done by changing the code in the +C<----- configuration -----> section. + +=over 3 + +=item C<$TLH> + +Top level hierarchy the report was created for. Used for display and +sum total. + +=item C<%Heading> + +Hash with keys for I and I. Used to display a +heading. + +=item C<%TH> + +Hash with keys for I, I and I. Used to +create the table header for I, I and I. + +I must not be longer than 3 characters, I no longer +than 6 characters and I no longer than 7 characters. +Output will be truncated otherwise. + +=item C<%LeadIn> + +Hash with keys for I and I. Used to create the +headers for our posting. Can contain other text that will be shown +before C<%Heading>. + +=item C<%LeadOut> + +Hash with keys for I and I. Will be shown at the +end of our posting. + +=back + +=head1 OPTIONS + +=over 3 + +=item B<-V>, B<--version> + +Print out version and copyright information and exit. + +=item B<-h>, B<--help> + +Print this man page and exit. + +=item B<-t>, B<--type> I + +Set report type to posting statistics or hosts statistics accordingly. + +=item B<-m>, B<--month> I + +Set month for display. + +=back + +=head1 INSTALLATION + +See L. + +=head1 USAGE + +Create a posting from a posting statistics report for last month: + + groupstats.pl --nocomments --sums --format dump | postingstats.pl -t groups + +Create a posting from a posting statistics report for 2012-01: + + groupstats.pl --nocomments --sums --format dump | postingstats.pl -t groups -m 2012-01 + +Create a posting from a host statistics report for last month: + + cliservstats.pl -t server --nocomments --sums --format dump | postingstats.pl -t hosts + +=head1 FILES + +=over 4 + +=item F + +The script itself. + +=item F + +Library functions for the NewsStats package. + +=item F + +Runtime configuration file. + +=back + +=head1 BUGS + +Please report any bugs or feature requests to the author or use the +bug tracker at L! + +=head1 SEE ALSO + +=over 2 + +=item - + +L + +=item - + +l>doc/INSTALL> + +=item - + +groupstats -h + +=item - + +cliservstats -h + +=back + +This script is part of the B package. + +=head1 AUTHOR + +Thomas Hochstein + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2010-2012, 2025 Thomas Hochstein + +This program is free software; you may redistribute it and/or modify it +under the same terms as Perl itself. + +=cut From 7dd8a95be3097fb79cf0924850820cad84961acc Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 17:46:40 +0200 Subject: [PATCH 22/30] Update README, INSTALL and ChangeLog. Signed-off-by: Thomas Hochstein --- doc/ChangeLog | 10 +++++++++- doc/INSTALL | 5 ++++- doc/README | 2 +- 3 files changed, 14 insertions(+), 3 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 856c101..379fa6b 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,13 +1,21 @@ NewsStats 0.3.0 (unreleased) * Extract GroupStats (in gatherstats) to subroutine. * Add ParseHeader() to library. - * Add HostStats to gatherstats + * Add HostStats to gatherstats. * Add DBTableHosts structure to install script. * Add cliservstats (for hosts and clients). - Refactor SQL generators. * Add --mid option to gatherstats for debugging purposes. * Don't parse NNTP-Posting-Host to determine the server name. * Add more known hosts. + * Implement hierarchy check on gatherstats. + * Add sums per month to HostStats. + * Add postingstats and refactor it: + - Make all text configurable (i18n). + - Generalize to make it usable for HostStats. + - Fallback to last month if no month is given. + - Add option handling, import VERSION, add POD. + * Update README, INSTALL and ChangeLog. NewsStats 0.2.0 (2025-05-10) * Redo directory structure: diff --git a/doc/INSTALL b/doc/INSTALL index 731f000..6eb1453 100644 --- a/doc/INSTALL +++ b/doc/INSTALL @@ -14,7 +14,7 @@ INSTALLATION INSTRUCTIONS 1) Install the scripts * Download the current version of NewsStats from - . + . * Untar it into a directory of your choice: @@ -57,6 +57,9 @@ INSTALLATION INSTRUCTIONS * DBTableGrps = groups_de Table holding data on postings per group. + * DBTableHosts = hosts_de + Table holding data on postings per server. + b) Optional configuration options * TLH = de diff --git a/doc/README b/doc/README index 9ac37ed..05a5e91 100644 --- a/doc/README +++ b/doc/README @@ -13,7 +13,7 @@ What's that? There's a multitude of tools for the statistical examination of newsgroups: number of postings per month or per person, longest - threads, and so on (see + threads, and so on (see [German language] for an incomplete list). Most of them use a per- newsgroup approach while NewsStats is hierarchy oriented. From 28157570f185a8726f86b5224aa380425d93c3fd Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 11 May 2025 19:56:17 +0200 Subject: [PATCH 23/30] Change --comments behaviour. --comments defaulted to true, but --nocomments was enforced if --filetemplate was set. Remove enforcement, but default to --nocomments if --filetemplate is set. Default behaviour is unchanged, but it's now possible to have comments in files. Change handling of captions accordingly (must be sent to output handle now). Update POD. Signed-off-by: Thomas Hochstein --- bin/cliservstats.pl | 28 ++++++++++++---------------- bin/groupstats.pl | 25 +++++++++++-------------- doc/ChangeLog | 2 ++ lib/NewsStats.pm | 15 +++++++++------ 4 files changed, 34 insertions(+), 36 deletions(-) diff --git a/bin/cliservstats.pl b/bin/cliservstats.pl index 5f9b3f4..b367a1f 100644 --- a/bin/cliservstats.pl +++ b/bin/cliservstats.pl @@ -50,11 +50,8 @@ GetOptions ('c|captions!' => \$OptCaptions, 'h|help' => \&ShowPOD, 'V|version' => \&ShowVersion) or exit 1; # parse parameters -# TODO: $OptSums is currently a no-op -# $OptComments defaults to TRUE -$OptComments = 1 if (!defined($OptComments)); -# force --nocomments when --filetemplate is used -$OptComments = 0 if ($OptFileTemplate); +# $OptComments defaults to TRUE if --filetemplate is not used +$OptComments = 1 if (!$OptFileTemplate && !defined($OptComments)); # parse $OptType if ($OptType) { if ($OptType =~ /(host|server)s?/i) { @@ -166,24 +163,25 @@ $DBQuery->execute(@SQLBindNames) # set default to 'pretty' $OptFormat = 'pretty' if !$OptFormat; # print captions if --caption is set +my $LeadIn; if ($OptCaptions && $OptComments) { # print time period with report type my $CaptionReportType = '(number of postings for each month)'; if ($OptReportType and $OptReportType ne 'default') { $CaptionReportType = '(number of all postings for that time period)'; } - printf("# ----- Report for %s %s\n",$CaptionPeriod,$CaptionReportType); + $LeadIn .= sprintf("# ----- Report for %s %s\n",$CaptionPeriod,$CaptionReportType); # print name list if --names is set - printf("# ----- Names: %s\n",join(',',split(/:/,$OptNames))) + $LeadIn .= sprintf("# ----- Names: %s\n",join(',',split(/:/,$OptNames))) if $OptNames; # print boundaries, if set my $CaptionBoundary= '(counting only month fulfilling this condition)'; - printf("# ----- Threshold: %s %s x %s %s %s\n", + $LeadIn .= sprintf("# ----- Threshold: %s %s x %s %s %s\n", $LowBound ? $LowBound : '',$LowBound ? '=>' : '', $UppBound ? '<=' : '',$UppBound ? $UppBound : '',$CaptionBoundary) if ($LowBound or $UppBound); # print primary and secondary sort order - printf("# ----- Grouped by %s (%s), sorted %s%s\n", + $LeadIn .= sprintf("# ----- Grouped by %s (%s), sorted %s%s\n", ($GroupBy eq 'month') ? 'Months' : 'Names', ($OptGroupBy and $OptGroupBy =~ /-?desc$/i) ? 'descending' : 'ascending', ($OptOrderBy and $OptOrderBy =~ /posting/i) ? 'by number of postings ' : '', @@ -191,7 +189,7 @@ if ($OptCaptions && $OptComments) { } # output data -&OutputData($OptFormat,$OptComments,$GroupBy,$Precision,'', +&OutputData($OptFormat,$OptComments,$GroupBy,$Precision,'',$LeadIn, $OptFileTemplate,$DBQuery,$MaxLength,$MaxValLength); ### close handles @@ -261,7 +259,6 @@ using B<--nocomments>. Last but not least you can redirect all output to a number of files, e.g. one for each month, by submitting the B<--filetemplate> option, see below. -Captions and comments are automatically disabled in this case. =head2 Configuration @@ -429,10 +426,11 @@ False by default. =item B<--comments|--nocomments> -Add comments (group headers) to I and I output. True by default. +Add comments (group headers) to I and I output. True by default +as logn as B<--filetemplate> is not set. -Use I<--nocomments> to suppress anything except newsgroup names/months and -numbers of postings. This is enforced when using B<--filetemplate>, see below. +Use I<--nocomments> to suppress anything except host/client names or months and +numbers of postings. =item B<--filetemplate> I @@ -446,8 +444,6 @@ example with B<--filetemplate> I: stats-2012-02 ... and so on -B<--nocomments> is enforced, see above. - =item B<--db> I Override I or I from F. diff --git a/bin/groupstats.pl b/bin/groupstats.pl index f463a6e..cc13550 100755 --- a/bin/groupstats.pl +++ b/bin/groupstats.pl @@ -51,10 +51,8 @@ GetOptions ('b|boundary=s' => \$OptBoundType, 'h|help' => \&ShowPOD, 'V|version' => \&ShowVersion) or exit 1; # parse parameters -# $OptComments defaults to TRUE -$OptComments = 1 if (!defined($OptComments)); -# force --nocomments when --filetemplate is used -$OptComments = 0 if ($OptFileTemplate); +# $OptComments defaults to TRUE if --filetemplate is not used +$OptComments = 1 if (!$OptFileTemplate && !defined($OptComments)); # parse $OptBoundType if ($OptBoundType) { if ($OptBoundType =~ /level/i) { @@ -226,6 +224,7 @@ $DBQuery->execute(@SQLBindNewsgroups) # set default to 'pretty' $OptFormat = 'pretty' if !$OptFormat; # print captions if --caption is set +my $LeadIn; if ($OptCaptions && $OptComments) { # print time period with report type my $CaptionReportType= '(number of postings for each month)'; @@ -235,9 +234,9 @@ if ($OptCaptions && $OptComments) { $CaptionReportType= '(number of all postings for that time period)' if $OptReportType eq 'sum'; } - printf("# ----- Report for %s %s\n",$CaptionPeriod,$CaptionReportType); + $LeadIn .= sprintf("# ----- Report for %s %s\n",$CaptionPeriod,$CaptionReportType); # print newsgroup list if --newsgroups is set - printf("# ----- Newsgroups: %s\n",join(',',split(/:/,$OptNewsgroups))) + $LeadIn .= sprintf("# ----- Newsgroups: %s\n",join(',',split(/:/,$OptNewsgroups))) if $OptNewsgroups; # print boundaries, if set my $CaptionBoundary= '(counting only month fulfilling this condition)'; @@ -246,12 +245,12 @@ if ($OptCaptions && $OptComments) { $CaptionBoundary= '(on average)' if $OptBoundType eq 'average'; $CaptionBoundary= '(all month summed up)' if $OptBoundType eq 'sum'; } - printf("# ----- Threshold: %s %s x %s %s %s\n", + $LeadIn .= sprintf("# ----- Threshold: %s %s x %s %s %s\n", $LowBound ? $LowBound : '',$LowBound ? '=>' : '', $UppBound ? '<=' : '',$UppBound ? $UppBound : '',$CaptionBoundary) if ($LowBound or $UppBound); # print primary and secondary sort order - printf("# ----- Grouped by %s (%s), sorted %s%s\n", + $LeadIn .= sprintf("# ----- Grouped by %s (%s), sorted %s%s\n", ($GroupBy eq 'month') ? 'Months' : 'Newsgroups', ($OptGroupBy and $OptGroupBy =~ /-?desc$/i) ? 'descending' : 'ascending', ($OptOrderBy and $OptOrderBy =~ /posting/i) ? 'by number of postings ' : '', @@ -260,7 +259,7 @@ if ($OptCaptions && $OptComments) { # output data &OutputData($OptFormat,$OptComments,$GroupBy,$Precision, - $OptCheckgroupsFile ? $ValidGroups : '', + $OptCheckgroupsFile ? $ValidGroups : '',$LeadIn, $OptFileTemplate,$DBQuery,$MaxLength,$MaxValLength); ### close handles @@ -336,7 +335,6 @@ using B<--nocomments>. Last but not least you can redirect all output to a number of files, e.g. one for each month, by submitting the B<--filetemplate> option, see below. -Captions and comments are automatically disabled in this case. =head2 Configuration @@ -589,10 +587,11 @@ False by default. =item B<--comments|--nocomments> -Add comments (group headers) to I and I output. True by default. +Add comments (group headers) to I and I output. True by default +as logn as B<--filetemplate> is not set. Use I<--nocomments> to suppress anything except newsgroup names/months and -numbers of postings. This is enforced when using B<--filetemplate>, see below. +numbers of postings. =item B<--filetemplate> I @@ -606,8 +605,6 @@ example with B<--filetemplate> I: stats-2012-02 ... and so on -B<--nocomments> is enforced, see above. - =item B<--groupsdb> I Override I from F. diff --git a/doc/ChangeLog b/doc/ChangeLog index 379fa6b..9dd4129 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -16,6 +16,8 @@ NewsStats 0.3.0 (unreleased) - Fallback to last month if no month is given. - Add option handling, import VERSION, add POD. * Update README, INSTALL and ChangeLog. + * Don't enforce --nocomment for --filetemplate, just default to it. + Change caption handling, update documentation accordingly. NewsStats 0.2.0 (2025-05-10) * Redo directory structure: diff --git a/lib/NewsStats.pm b/lib/NewsStats.pm index cb376c0..d16965b 100644 --- a/lib/NewsStats.pm +++ b/lib/NewsStats.pm @@ -430,12 +430,13 @@ sub OutputData { ### $GroupBy : primary sorting order (month or key) ### $Precision: number of digits right of decimal point (0 or 2) ### $ValidKeys: reference to a hash containing all valid keys +### $LeadIn : print at start of output ### $FileTempl: file name template (--filetemplate): filetempl-YYYY-MM ### $DBQuery : database query handle with executed query, ### containing $Month, $Key, $Value ### $PadField : padding length for key field (optional) for 'pretty' ### $PadValue : padding length for value field (optional) for 'pretty' - my ($Format, $Comments, $GroupBy, $Precision, $ValidKeys, $FileTempl, + my ($Format, $Comments, $GroupBy, $Precision, $ValidKeys, $LeadIn, $FileTempl, $DBQuery, $PadField, $PadValue) = @_; my %ValidKeys = %{$ValidKeys} if $ValidKeys; my ($FileName, $Handle, $OUT); @@ -478,8 +479,8 @@ sub OutputData { $FileName)); $Handle = $OUT; }; - print $Handle &FormatOutput($Format, $Comments, $Caption, $Key, $Value, - $Precision, $PadField, $PadValue); + print $Handle &FormatOutput($Format, $Comments, $LeadIn, $Caption, + $Key, $Value, $Precision, $PadField, $PadValue); $LastIteration = $Caption; }; close $OUT if ($FileTempl); @@ -498,7 +499,7 @@ sub FormatOutput { ### $PadField : padding length for key field (optional) for 'pretty' ### $PadValue : padding length for value field (optional) for 'pretty' ### OUT: $Output: formatted output - my ($Format, $Comments, $Caption, $Key, $Value, $Precision, $PadField, + my ($Format, $Comments, $LeadIn, $Caption, $Key, $Value, $Precision, $PadField, $PadValue) = @_; my ($Output); # keep last caption in mind @@ -514,8 +515,10 @@ sub FormatOutput { $Output = sprintf ("%s %s %u\n",$Caption,$Key,$Value); } elsif ($Format eq 'pretty') { # output as a table - $Output = sprintf ("# ----- %s:\n",$Caption) - if ($Comments and (!defined($LastIteration) or $Caption ne $LastIteration)); + if ($Comments and (!defined($LastIteration) or $Caption ne $LastIteration)) { + $Output = $LeadIn; + $Output .= sprintf ("# ----- %s:\n",$Caption); + } # increase $PadValue for numbers with decimal point $PadValue += $Precision+1 if $Precision; # add padding if $PadField is set; $PadValue HAS to be set then From 0ee389fc4289cfdfba025b482672e25d25a8404b Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Fri, 16 May 2025 21:00:08 +0200 Subject: [PATCH 24/30] Fix comments and code in clisverstats. Signed-off-by: Thomas Hochstein --- bin/cliservstats.pl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/bin/cliservstats.pl b/bin/cliservstats.pl index b367a1f..6e3a575 100644 --- a/bin/cliservstats.pl +++ b/bin/cliservstats.pl @@ -86,7 +86,7 @@ elsif ($OptType eq 'host') { ### init database my $DBHandle = InitDB(\%Conf,1); -### get time period and newsgroups, prepare SQL 'WHERE' clause +### get time period and names, prepare SQL 'WHERE' clause # get time period # and set caption for output and expression for SQL 'WHERE' clause my ($CaptionPeriod,$SQLWherePeriod) = &GetTimePeriod($OptMonth); @@ -94,7 +94,7 @@ my ($CaptionPeriod,$SQLWherePeriod) = &GetTimePeriod($OptMonth); &Bleat(2,"--month option has an invalid format - ". "please use 'YYYY-MM', 'YYYY-MM:YYYY-MM' or 'ALL'!") if !$CaptionPeriod; # get list of hosts and set expression for SQL 'WHERE' clause -# with placeholders as well as a list of newsgroup to bind to them +# with placeholders as well as a list of names to bind to them my ($SQLWhereNames,@SQLBindNames); if ($OptNames) { ($SQLWhereNames,@SQLBindNames) = &SQLGroupList($OptNames,$OptType); @@ -138,7 +138,7 @@ if ($OptReportType and $OptReportType ne 'default') { $SQLSelect = "month,$OptType,postings"; }; -### get length of longest newsgroup name delivered by query +### get length of longest name delivered by query ### for formatting purposes my $Field = ($GroupBy eq 'month') ? $OptType : 'month'; my ($MaxLength,$MaxValLength) = &GetMaxLength($DBHandle,$Conf{'DBTable'}, @@ -155,7 +155,7 @@ $DBQuery = $DBHandle->prepare(sprintf('SELECT %s FROM %s.%s %s %s %s', $SQLOrderClause)); # execute query $DBQuery->execute(@SQLBindNames) - or &Bleat(2,sprintf("Can't get %ss data for %s from %s.%s: %s\n", + or &Bleat(2,sprintf("Can't get %s data for %s from %s.%s: %s\n", $OptType,$CaptionPeriod,$Conf{'DBDatabase'},$Conf{'DBTable'}, $DBI::errstr)); From 7169e2636f55da1809c88d48f78e7bc3718326fa Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Fri, 16 May 2025 21:00:13 +0200 Subject: [PATCH 25/30] Add more hosts and special cases. Signed-off-by: Thomas Hochstein --- bin/gatherstats.pl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bin/gatherstats.pl b/bin/gatherstats.pl index 1dc5b78..15b7ad4 100755 --- a/bin/gatherstats.pl +++ b/bin/gatherstats.pl @@ -133,10 +133,10 @@ foreach my $Month (&ListMonth($Period)) { ### HostStats if ($OptStatsType eq 'all' or $OptStatsType eq 'hosts') { # define known hosts using subdomains - my @KnownHosts = qw(abavia.com aioe.org arcor-online.net arcor-ip.de news.astraweb.com read.cnntp.org + my @KnownHosts = qw(abavia.com aioe.org arcor-online.net arcor-ip.de astraweb.com read.cnntp.org easynews.com eternal-september.org euro.net fernuni-hagen.de free.fr newsread.freenet.ag googlegroups.com heirich.name news.neostrada.pl netcologne.de newsdawg.com newscene.com - news-service.com octanews.com .readnews.com wieslauf.sub.de highway.telekom.at + news-service.com octanews.com readnews.com wieslauf.sub.de highway.telekom.at united-newsserver.de xennanews.com xlned.com xsnews.nl news.xs4all.nl); &HostStats($DBHandle,$DBRaw,$DBHosts,$Month,$OptMID,$OptTest,$OptDebug,@KnownHosts); }; From 6afa9a62b9d6382c941cb5cb11b92fe73eca28f6 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Fri, 16 May 2025 21:09:59 +0200 Subject: [PATCH 26/30] Fix call to GetMaxLength(). Signed-off-by: Thomas Hochstein --- bin/cliservstats.pl | 2 +- doc/ChangeLog | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/bin/cliservstats.pl b/bin/cliservstats.pl index 6e3a575..a38cba0 100644 --- a/bin/cliservstats.pl +++ b/bin/cliservstats.pl @@ -143,7 +143,7 @@ if ($OptReportType and $OptReportType ne 'default') { my $Field = ($GroupBy eq 'month') ? $OptType : 'month'; my ($MaxLength,$MaxValLength) = &GetMaxLength($DBHandle,$Conf{'DBTable'}, $Field,'postings',$SQLWhereClause, - @SQLBindNames); + '',@SQLBindNames); ### build and execute SQL query my ($DBQuery); diff --git a/doc/ChangeLog b/doc/ChangeLog index 9dd4129..2410fcd 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -18,6 +18,7 @@ NewsStats 0.3.0 (unreleased) * Update README, INSTALL and ChangeLog. * Don't enforce --nocomment for --filetemplate, just default to it. Change caption handling, update documentation accordingly. + * Fix call to GetMaxLength() in cliservstats. NewsStats 0.2.0 (2025-05-10) * Redo directory structure: From 4ad63fcb4e70dc02190a63063a80884fef99f150 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 18 May 2025 13:27:38 +0200 Subject: [PATCH 27/30] Fix typos in doc, update sample config file. Signed-off-by: Thomas Hochstein --- doc/ChangeLog | 1 + doc/README | 5 ++--- etc/newsstats.conf.sample | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 2410fcd..7743223 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -19,6 +19,7 @@ NewsStats 0.3.0 (unreleased) * Don't enforce --nocomment for --filetemplate, just default to it. Change caption handling, update documentation accordingly. * Fix call to GetMaxLength() in cliservstats. + * Fix typos in documentation, update sample config file. NewsStats 0.2.0 (2025-05-10) * Redo directory structure: diff --git a/doc/README b/doc/README index 05a5e91..1d608b7 100644 --- a/doc/README +++ b/doc/README @@ -43,7 +43,7 @@ Prerequisites - File::Basename - Sys::Syslog - * Perl modules form CPAN + * Perl modules from CPAN - Config::Auto - Date::Format - DBI @@ -69,7 +69,7 @@ Getting Started Report generation is handled by specialised scripts for each report type. Currently reports on the number of postings per group and month and injection server and month are supported; you can - use 'groupstats.pl' and 'cliservstats.pl' for. See the + use 'groupstats.pl' and 'cliservstats.pl' for that. See the groupstats.pl and cliservstats.pl man pages for more information. Reporting Bugs @@ -95,4 +95,3 @@ Author Thomas Hochstein - diff --git a/etc/newsstats.conf.sample b/etc/newsstats.conf.sample index 3133ed2..a960644 100644 --- a/etc/newsstats.conf.sample +++ b/etc/newsstats.conf.sample @@ -12,8 +12,8 @@ DBDatabase = newsstats # DBTableRaw = raw_de DBTableGrps = groups_de +DBTableHosts = hosts_de #DBTableClnts = -#DBTableHosts = ### hierarchy configuration TLH = de From 9b6bf3e194cdab67d010235c470e705477f34604 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 18 May 2025 13:33:49 +0200 Subject: [PATCH 28/30] Move database creation to bin/dbcreate.pl. Remove install/* Signed-off-by: Thomas Hochstein --- install/install.pl => bin/dbcreate.pl | 17 +++++++++-------- doc/ChangeLog | 1 + doc/INSTALL | 4 ++-- 3 files changed, 12 insertions(+), 10 deletions(-) rename install/install.pl => bin/dbcreate.pl (95%) diff --git a/install/install.pl b/bin/dbcreate.pl similarity index 95% rename from install/install.pl rename to bin/dbcreate.pl index deaa43a..ea0fd6c 100755 --- a/install/install.pl +++ b/bin/dbcreate.pl @@ -1,6 +1,6 @@ #! /usr/bin/perl # -# install.pl +# dbcreate.pl # # This script will create database tables as necessary. # @@ -13,7 +13,7 @@ BEGIN { use File::Basename; - # we're in .../install, so our module is in ../lib + # we're in .../bin, so our module is in ../lib push(@INC, dirname($0).'/../lib'); } use strict; @@ -231,7 +231,7 @@ sub CreateTable { }; my $DBQuery = $DBHandle->prepare($DBCreate{$Table}); $DBQuery->execute() or - &Bleat(2, sprintf("Can't create table %s in database %s: %s%\n",$Table, + &Bleat(2, sprintf("Can't create table %s in database %s: %s\n",$Table, $Conf{'DBDatabase'},$DBI::errstr)); printf("Database table %s.%s created succesfully.\n", $Conf{'DBDatabase'},$Conf{$Table}); @@ -261,11 +261,11 @@ __END__ =head1 NAME -install - installation script +dbcreate - database creation script =head1 SYNOPSIS -B [B<-Vh> [--update I] [B<--conffile> I] +B [B<-Vh> [--update I] [B<--conffile> I] =head1 REQUIREMENTS @@ -273,11 +273,12 @@ See L. =head1 DESCRIPTION -This script will create database tables as necessary and configured. +This script will create a database and database tables as necessary +and configured. =head2 Configuration -B will read its configuration from F which should +B will read its configuration from F which should be present in etc/ via Config::Auto or from a configuration file submitted by the B<--conffile> option. @@ -309,7 +310,7 @@ Load configuration from I instead of F. =over 4 -=item F +=item F The script itself. diff --git a/doc/ChangeLog b/doc/ChangeLog index 7743223..3cced70 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -20,6 +20,7 @@ NewsStats 0.3.0 (unreleased) Change caption handling, update documentation accordingly. * Fix call to GetMaxLength() in cliservstats. * Fix typos in documentation, update sample config file. + * Move database creation from install/install.pl to bin/dbcreate.pl NewsStats 0.2.0 (2025-05-10) * Redo directory structure: diff --git a/doc/INSTALL b/doc/INSTALL index 6eb1453..2ef057e 100644 --- a/doc/INSTALL +++ b/doc/INSTALL @@ -70,9 +70,9 @@ INSTALLATION INSTRUCTIONS * Setup your database server with a username, password and database matching the NewsStats configuration (see 2 a). - * Start the installation script: + * Start the database creation script: - # install/install.pl + # bin/dbcreate.pl It will setup the necessary database tables and display some information on the next steps. From 8c9d450d476269fc40e621b394ae2481a57ea259 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 18 May 2025 13:54:57 +0200 Subject: [PATCH 29/30] Add tinews.pl and some shell scripts to /contrib. Signed-off-by: Thomas Hochstein --- bin/postingstats.pl | 3 +- contrib/dopostingstats.sh | 9 + contrib/tinews.pl | 1506 +++++++++++++++++++++++++++++++++++++ contrib/yearstats.sh | 11 + doc/ChangeLog | 1 + doc/README | 7 +- 6 files changed, 1535 insertions(+), 2 deletions(-) create mode 100644 contrib/dopostingstats.sh create mode 100644 contrib/tinews.pl create mode 100644 contrib/yearstats.sh diff --git a/bin/postingstats.pl b/bin/postingstats.pl index b378fbb..e6fe3db 100644 --- a/bin/postingstats.pl +++ b/bin/postingstats.pl @@ -211,7 +211,8 @@ It will default to posting statistics (number of postings per group) and last month. Output from B can be piped to any C implementation, -e.g. C from L. +e.g. C from L +(present in C). =head2 Configuration diff --git a/contrib/dopostingstats.sh b/contrib/dopostingstats.sh new file mode 100644 index 0000000..30ef8f1 --- /dev/null +++ b/contrib/dopostingstats.sh @@ -0,0 +1,9 @@ +#!/bin/bash +# installation path is /srv/newsstats/, please adjust accordingly +if [[ $1 =~ [0-9]{4}-[0-9]{2} ]]; then + /srv/newsstats/bin/groupstats.pl --nocomments --sums --format dump --month $1 | /srv/newsstats/bin/postingstats.pl --month $1 | /srv/newsstats/contrib/tinews.pl -X -Y + /srv/newsstats/bin/cliservstats.pl -t server --nocomments --sums --format dump --month $1 | /srv/newsstats/bin/postingstats.pl -t server --month $1 | /srv/newsstats/contrib/tinews.pl -X -Y +else + echo 'Input error, please use dopostingstats.sh YYYY-MM' +fi + diff --git a/contrib/tinews.pl b/contrib/tinews.pl new file mode 100644 index 0000000..b90199e --- /dev/null +++ b/contrib/tinews.pl @@ -0,0 +1,1506 @@ +#! /usr/bin/perl +# +# reads an article on STDIN, mails any copies if required, +# signs the article and posts it. +# +# +# Copyright (c) 2002-2024 Urs Janssen , +# Marc Brockschmidt +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# +# 1. Redistributions of source code must retain the above copyright notice, +# this list of conditions and the following disclaimer. +# +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# 3. Neither the name of the copyright holder nor the names of its +# contributors may be used to endorse or promote products derived from +# this software without specific prior written permission. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +# POSSIBILITY OF SUCH DAMAGE. +# +# +# TODO: - extend debug mode to not delete tmp-files and be more verbose +# - add pid to pgptmpf to allow multiple simultaneous instances +# - check for /etc/nntpserver (and /etc/news/server) +# - add $PGPOPTS, $PGPPATH and $GNUPGHOME support +# - cleanup and remove duplicated code +# - quote inpupt properly before passing to shell +# - $ENV{'NEWSHOST'} / $ENV{'NNTPSERVER'} and $ENV{'NNTPPORT'} +# do have higher precedence than settings in the script and +# config-file, but config-settig SSL may override $ENV{'NNTPPORT'} +# - if (!defined $ENV{'GPG_TTY'}) {if (open(my $T,'-|','tty')) { +# chomp(my $tty=<$T>); close($T); +# $ENV{'GPG_TTY'}=$tty if($tty =~ m/^\//)}} +# for gpg? +# - option to break long header lines? +# - option to trim References +# - option to foce connection via AF_INET6 (-6) +# ... +# +# cmd-line options used in other inews: +# inews-xt (Olaf Titz): +# -C accepted for historic reasons and errors out +# inews (inn) +# -P don't add Sender +# inews (Eric S. Raymond; 1989) +# -C create grp +# -d Distribution: +# -p [file] ; run rnews mode +# -M moderator option +# -v print returned ID + +require 5.004; + +use strict; +use warnings; + +# version Number +my $version = "1.1.70"; + +my %config; + +# configuration, may be overwritten via ~/.tinewsrc +$config{'nntp-server'} = 'news'; # your NNTP servers name, may be set via $NNTPSERVER +$config{'nntp-port'} = 119; # NNTP-port, may be set via $NNTPPORT +$config{'nntp-user'} = ''; # username for nntp-auth, may be set via ~/.newsauth or ~/.nntpauth +$config{'nntp-pass'} = ''; # password for nntp-auth, may be set via ~/.newsauth or ~/.nntpauth + +$config{'ssl'} = 0; # set to 1 to use NNTPS if possible + +$config{'pgp-signer'} = ''; # sign as who? +$config{'pgp-pass'} = ''; # pgp2 only +$config{'path-to-pgp-pass'}= ''; # pgp2, pgp5, pgp6 and gpg +$config{'pgp-pass-fd'} = 9; # file descriptor used for input redirection of path-to-pgp-pass; GPG1, GPG2, PGP5 and PGP6 only + +$config{'pgp'} = '/usr/bin/pgp'; # path to pgp +$config{'pgp-version'} = '2'; # Use 2 for 2.X, 5 for PGP5, 6 for PGP6, GPG or GPG1 for GPG1 and GPG2 for GPG2 +$config{'digest-algo'} = 'MD5';# Digest Algorithm for GPG. Must be supported by your installation + +$config{'interactive'} = 'yes';# allow interactive usage + +$config{'verbose'} = 0; # set to 1 to get warning messages +$config{'debug'} = 0; # set to 1 to get some debug output + +$config{'sig-path'} = glob('~/.signature'); # path to signature +$config{'add-signature'}= 'yes';# Add $config{'sig-path'} to posting if there is no sig +$config{'sig-max-lines'}= 4; # max number of signatures lines + +$config{'max-header-length'} = 998; # RFC 5536 + +$config{'sendmail'} = '/usr/sbin/sendmail -i -t'; # set to '' to disable mail-actions + +$config{'pgptmpf'} = 'pgptmp'; # temporary file for PGP. + +$config{'pgpheader'} = 'X-PGP-Sig'; +$config{'pgpbegin'} = '-----BEGIN PGP SIGNATURE-----'; # Begin of PGP-Signature +$config{'pgpend'} = '-----END PGP SIGNATURE-----'; # End of PGP-Signature + +$config{'canlock-algorithm'} = 'sha1'; # Digest algorithm used for cancel-lock and cancel-key; sha1, sha256 and sha512 are supported +# $config{'canlock-secret'} = '~/.cancelsecret'; # Path to canlock secret file + +# $config{'ignore-headers'} = ''; # headers to be ignored during signing + +$config{'pgp-sign-headers'} = [ + 'From', 'Newsgroups', 'Subject', 'Control', 'Supersedes', 'Followup-To', + 'Date', 'Injection-Date', 'Sender', 'Approved', 'Message-ID', 'Reply-To', + 'Cancel-Key', 'Also-Control', 'Distribution' ]; +$config{'pgp-order-headers'} = [ + 'from', 'newsgroups', 'subject', 'control', 'supersedes', 'followup-To', + 'date', 'injection-date', 'organization', 'lines', 'sender', 'approved', + 'distribution', 'message-id', 'references', 'reply-to', 'mime-version', + 'content-type', 'content-transfer-encoding', 'summary', 'keywords', + 'cancel-lock', 'cancel-key', 'also-control', 'x-pgp', 'user-agent' ]; + +################################################################################ + +use Getopt::Long qw(GetOptions); +use Net::NNTP; +use IO::Socket qw(AF_INET PF_INET); +use Time::Local; +use Term::ReadLine; + +(my $pname = $0) =~ s#^.*/##; + +# read config file (first match counts) from +# $XDG_CONFIG_HOME/tinewsrc +# ~/.config/tinewsrc +# ~/.tinewsrc +# if present +my $TINEWSRC = undef; +my (@try, %seen); + +if ($ENV{'XDG_CONFIG_HOME'}) { + push(@try, (glob("$ENV{'XDG_CONFIG_HOME'}/tinewsrc"))[0]); +} +push(@try, (glob('~/.config/tinewsrc'))[0], (glob('~/.tinewsrc'))[0]); + +foreach (grep { ! $seen{$_}++ } @try) { # uniq @try + last if (open($TINEWSRC, '<', $_)); + $TINEWSRC = undef; +} +if (defined($TINEWSRC)) { + my $changes = 0; + while (defined($_ = <$TINEWSRC>)) { + if (m/^([^#\s=]+)\s*=\s*(\S[^#]+)/io) { + # rename pre 1.1.56 tinewsrc-var names + my $key = $1; + my $val = $2; + $key =~ s#^followupto#follow-to# && $changes++; + $key =~ s#^replyto#reply-to# && $changes++; + $key =~ s#^NNTP(?!\-).#NNTP-# && $changes++; + $key =~ s#^PathtoPGPPass#path-to-pgp-pass# && $changes++; + $key =~ s#^PGPorderheaders#pgp-order-headers# && $changes++; + $key =~ s#^PGPPassFD#pgp-pass-fd# && $changes++; + $key =~ s#^PGPSignHeaders#pgp-sign-headers# && $changes++; + $key =~ s#^PGP(?!\-).#PGP-# && $changes++; + $key =~ s#_#-# && $changes++; + chomp($config{lc($key)} = $val); + } + } + close($TINEWSRC); + print "Old style tinewsrc option names found, you should adjust them.\n" if ($changes && ($config{'verbose'} || $config{'debug'})); +} + +# as of tinews 1.1.51 we use 3 args open() to pipe to sendmail +# thus we remove any leading '|' to avoid syntax errors; +# for redirections use cat etc.pp., eg. 'cat > /tmp/foo' +$config{'sendmail'} =~ s/^\s*\|\s*//io; + +# digest-algo is case sensitive and should be all uppercase +$config{'digest-algo'} = uc($config{'digest-algo'}); + +# these env-vars have higher priority (order is important) +$config{'nntp-server'} = $ENV{'NEWSHOST'} if ($ENV{'NEWSHOST'}); +$config{'nntp-server'} = $ENV{'NNTPSERVER'} if ($ENV{'NNTPSERVER'}); +$config{'nntp-port'} = $ENV{'NNTPPORT'} if ($ENV{'NNTPPORT'}); + +# Get options +Getopt::Long::Configure ("bundling", "no_ignore_case"); +my $oret = GetOptions( + 'A|V|W|h|headers' => [], # do nothing + 'debug|D|N' => \$config{'debug'}, + 'port|p=i' => \$config{'nntp-port'}, + 'no-sign|X' => \$config{'no-sign'}, + 'no-control|R' => \$config{'no-control'}, + 'no-signature|S' => \$config{'no-signature'}, + 'no-canlock|L' => \$config{'no-canlock'}, + 'no-injection-date|I' => \$config{'no-injection-date'}, + 'no-organization|O' => \$config{'no-organization'}, + 'force-auth|Y' => \$config{'force-auth'}, + 'approved|a=s' => \$config{'approved'}, + 'control|c=s' => \$config{'control'}, + 'canlock-algorithm=s' => \$config{'canlock-algorithm'}, + 'distribution|d=s' => \$config{'distribution'}, + 'discard-empty|E' => \$config{'discard-empty'}, + 'expires|e=s' => \$config{'expires'}, + 'from|f=s' => \$config{'from'}, + 'ignore-headers|i=s' => \$config{'ignore-headers'}, + 'followup-to|w=s' => \$config{'followup-to'}, + 'message-id|m=s' => \$config{'message-id'}, + 'newsgroups|n=s' => \$config{'newsgroups'}, + 'reply-to|r=s' => \$config{'reply-to'}, + 'savedir|s=s' => \$config{'savedir'}, + 'ssl|nntps' => \$config{'ssl'}, + 'subject|t=s' => \$config{'subject'}, + 'references|F=s' => \$config{'references'}, + 'organization|o=s' => \$config{'organization'}, + 'path|x=s' => \$config{'path'}, + 'timeout|T=i' => \$config{'timeout'}, + 'ipv4|4' => \$config{'ipv4'}, + 'help|H' => \$config{'help'}, + 'transform' => \$config{'transform'}, + 'verbose|v' => \$config{'verbose'}, + 'version' => \$config{'version'}, + 'man' => \$config{'man'} +); + +usage() unless $oret; + +if ($config{'version'}) { + version(); + exit 0; +} + +usage() if ($config{'help'}); + +# not listed in usage() or man-page as it may not work +if ($config{'man'}) { + if (eval { require Pod::Usage;1; } != 1) { + $config{'man'} = 0; + print STDERR "Unknown option: man.\n"; + usage(); + } else { + use Pod::Usage; + pod2usage(-verbose => 3, -exit => 0); + } +} + +# check if SSL support is available +if ($config{'ssl'}) { + eval "Net::NNTP->can_ssl"; + if ($@) { + warn "Your Net::NNTP doesn't support SSL.\n" if ($config{'debug'} || $config{'verbose'}); + $config{'ssl'} = 0; + } +} + +# and now adjust default port depending on SSL requested and +# available or not +if ($config{'ssl'}) { + $config{'nntp-port'} = 563 if ($config{'nntp-port'} == 119); +} else { + $config{'nntp-port'} = 119 if ($config{'nntp-port'} == 563); +} + +# Cancel-Locks require some more modules +my $sha_mod = undef; +if ($config{'canlock-secret'} && !$config{'no-canlock'}) { + $config{'canlock-algorithm'} = lc($config{'canlock-algorithm'}); + # we support sha1, sha256 and sha512, fallback to sha1 if something else is given + if (!($config{'canlock-algorithm'} =~ /^sha(1|256|512)$/)) { + warn "Digest algorithm " . $config{'canlock-algorithm'} . " not supported. Falling back to sha1.\n" if ($config{'debug'} || $config{'verbose'}); + $config{'canlock-algorithm'} = 'sha1'; + } + if ($config{'canlock-algorithm'} eq 'sha1') { + foreach ('Digest::SHA qw(sha1)', 'Digest::SHA1()') { + eval "use $_"; + if (!$@) { + ($sha_mod = $_) =~ s#( qw\(sha1\)|\(\))##; + last; + } + } + foreach ('MIME::Base64()', 'Digest::HMAC_SHA1()') { + eval "use $_"; + if ($@ || !defined($sha_mod)) { + $config{'no-canlock'} = 1; + warn "Cancel-Locks disabled: Can't locate ".$_." (".__FILE__.":".__LINE__.")\n" if ($config{'debug'} || $config{'verbose'}); + last; + } + } + } elsif ($config{'canlock-algorithm'} eq 'sha256') { + foreach ('MIME::Base64()', 'Digest::SHA qw(sha256 hmac_sha256)') { + eval "use $_"; + if ($@) { + $config{'no-canlock'} = 1; + warn "Cancel-Locks disabled: Can't locate ".$_." (".__FILE__.":".__LINE__.")\n" if ($config{'debug'} || $config{'verbose'}); + last; + } + } + } else { + foreach ('MIME::Base64()', 'Digest::SHA qw(sha512 hmac_sha512)') { + eval "use $_"; + if ($@) { + $config{'no-canlock'} = 1; + warn "Cancel-Locks disabled: Can't locate ".$_." (".__FILE__.":".__LINE__.")\n" if ($config{'debug'} || $config{'verbose'}); + last; + } + } + } +} + +my $term = Term::ReadLine->new('tinews'); +my $attribs = $term->Attribs; +my $in_header = 1; +my (%Header, @Body, $PGPCommand); + +if (! $config{'no-sign'}) { + $config{'pgp-signer'} = $ENV{'SIGNER'} if ($ENV{'SIGNER'}); + $config{'path-to-pgp-pass'} = $ENV{'PGPPASSFILE'} if ($ENV{'PGPPASSFILE'}); + if ($config{'path-to-pgp-pass'}) { + open(my $pgppass, '<', (glob($config{'path-to-pgp-pass'}))[0]) or + $config{'interactive'} && die("$0: Can't open ".$config{'path-to-pgp-pass'}.": $!"); + chomp($config{'pgp-pass'} = <$pgppass>); + close($pgppass); + } + if ($config{'pgp-version'} eq '2' && $ENV{'PGPPASS'}) { + $config{'pgp-pass'} = $ENV{'PGPPASS'}; + } +} + +# Remove unwanted headers from pgp-sign-headers +if (${config{'ignore-headers'}}) { + my @hdr_to_ignore = split(/,/, ${config{'ignore-headers'}}); + foreach my $hdr (@hdr_to_ignore) { + @{$config{'pgp-sign-headers'}} = map {lc($_) eq lc($hdr) ? () : $_} @{$config{'pgp-sign-headers'}}; + } +} + +# Read the message and split the header +readarticle(\%Header, \@Body); + +# empty @Body +if (scalar @Body == 0) { + warn("Empty article\n") if ($config{'verbose'}); + exit 0 if ($config{'discard-empty'}); +} + +# Add signature if there is none +if (!$config{'no-signature'}) { + if ($config{'add-signature'} && !grep {/^-- /} @Body) { + if (-r glob($config{'sig-path'})) { + my $l = 0; + push @Body, "-- \n"; + open(my $SIGNATURE, '<', glob($config{'sig-path'})) or die("Can't open " . $config{'sig-path'} . ": $!"); + while (<$SIGNATURE>) { + die $config{'sig-path'} . " longer than " . $config{'sig-max-lines'}. " lines!" if (++$l > $config{'sig-max-lines'}); + push @Body, $_; + } + close($SIGNATURE); + } else { + warn "Tried to add " . $config{'sig-path'} . ", but it is unreadable.\n" if ($config{'debug'} || $config{'verbose'}); + } + } +} + +# import headers set in the environment +if (!defined($Header{'reply-to'})) { + if ($ENV{'REPLYTO'}) { + chomp($Header{'reply-to'} = "Reply-To: " . $ENV{'REPLYTO'}); + $Header{'reply-to'} .= "\n"; + } +} +foreach ('DISTRIBUTION', 'ORGANIZATION') { + if (!defined($Header{lc($_)}) && $ENV{$_}) { + chomp($Header{lc($_)} = ucfirst($_).": " . $ENV{$_}); + $Header{lc($_)} .= "\n"; + } +} + +# overwrite headers if specified via cmd-line +foreach ('Approved', 'Control', 'Distribution', 'Expires', + 'From', 'Followup-To', 'Message-ID', 'Newsgroups', 'Reply-To', + 'Subject', 'References', 'Organization') { + next if (!defined($config{lc($_)})); + chomp($Header{lc($_)} = $_ . ": " . $config{lc($_)}); + $Header{lc($_)} .= "\n"; +} + +# -x doesn't overwrite but prefixes +if (defined($config{'path'})) { + if (defined($Header{'path'})) { + (my $pbody = $Header{'path'}) =~ s#^Path: ##i; + chomp($Header{'path'} = "Path: " . $config{'path'} . "!" . $pbody); + } else { + chomp($Header{'path'} = "Path: " . $config{'path'}); + } + $Header{'path'} .= "\n"; +} + +# verify/add/remove headers +foreach ('From', 'Subject') { + die("$0: No $_:-header defined.") if (!defined($Header{lc($_)})); +} + +$Header{'date'} = "Date: ".getdate()."\n" if (!defined($Header{'date'}) || $Header{'date'} !~ m/^[^\s:]+: .+/o); +$Header{'injection-date'} = "Injection-Date: ".getdate()."\n" if (!$config{'no-injection-date'}); + +if (defined($Header{'user-agent'})) { + chomp $Header{'user-agent'}; + $Header{'user-agent'} = $Header{'user-agent'}." ".$pname."/".$version."\n"; +} + +delete $Header{'x-pgp-key'} if (!$config{'no-sign'} && defined($Header{'x-pgp-key'})); + +delete $Header{'organization'} if ($config{'no-organization'} && defined($Header{'organization'})); + +# No control. No control. You have no control. +if ($config{'no-control'} and $Header{control}) { + print STDERR "No control messages allowed.\n"; + exit 1; +} + +# various checks +if ($config{'debug'} || $config{'verbose'}) { + foreach (keys %Header) { + warn "Raw 8-bit data in the following header:\n$Header{$_}\n" if ($Header{$_} =~ m/[\x80-\xff]/o); + } + # do not check for CTE as it's not required for miltipart/* + if (!defined($Header{'mime-version'}) || !defined($Header{'content-type'})) { + warn "8bit body without MIME-headers\n" if (grep {/[\x80-\xff]/} @Body); + } +} + +# try ~/.newsauth if no $config{'nntp-pass'} was set +if (!$config{'nntp-pass'}) { + my ($l, $server, $pass, $user); + if (-r (glob("~/.newsauth"))[0]) { + open (my $NEWSAUTH, '<', (glob("~/.newsauth"))[0]) or die("Can't open ~/.newsauth: $!"); + while ($l = <$NEWSAUTH>) { + next if ($l =~ m/^([#\s]|$)/); + chomp $l; + $user = $pass = $server = undef; + if ($l =~ m/^ + (\S+)\s+ # server + ("(?:[^"]+)"|(?:\S+)) # password + \s+("(?:[^"]+)"|(?:\S+)) # user + /x) { + $server = $1; + $pass = $2; + $user = $3; + if ($pass =~ m/^"([^"]+)"/) { # strip enclising " + $pass = $1; + } + if ($user =~ m/^"([^"]+)"/) { # likewise + $user = $1; + } + } else { # server passwrd + if ($l =~ m/^(\S+)\s+("(?:[^"]+)"|(?:\S+))/) { + $server = $1; + $pass = $2; + if ($pass =~ m/^"([^"]+)"/) { # likewise + $pass = $1; + } + } + } + last if ($server =~ m/\Q$config{'nntp-server'}\E/); + } + close($NEWSAUTH); + if ($pass && $server =~ m/\Q$config{'nntp-server'}\E/) { + $config{'nntp-pass'} = $pass; + $config{'nntp-user'} = $user || getlogin || getpwuid($<) || $ENV{USER}; + } else { + $pass = $user = ""; + } + } + # try ~/.nntpauth if we still got no password + if (!$pass) { + if (-r (glob("~/.nntpauth"))[0]) { + open (my $NNTPAUTH, '<', (glob("~/.nntpauth"))[0]) or die("Can't open ~/.nntpauth: $!"); + while ($l = <$NNTPAUTH>) { + chomp $l; + next if ($l =~ m/(^[#\s]|)/); + ($server, $user, $pass) = split(/\s+\b/, $l); + last if ($server =~ m/\Q$config{'nntp-server'}\E/); + } + close($NNTPAUTH); + if ($pass && $server =~ m/\Q$config{'nntp-server'}\E/) { + $config{'nntp-pass'} = $pass; + $config{'nntp-user'} = $user || getlogin || getpwuid($<) || $ENV{USER}; + } + } + } +} + +# instead of abort posting just to prefetch a Messsage-ID we should (try +# to) keep the session open instead +if (!($config{'no-sign'} && $config{'no-canlock'})) { + if (! $config{'savedir'} && defined($Header{'newsgroups'}) && !defined($Header{'message-id'})) { + my $Server = AuthonNNTP(); + my $ServerMsg = $Server->message(); + $Header{'message-id'} = "Message-ID: $1\n" if ($ServerMsg =~ m/(<\S+\@\S+>)/o); + #$Server->datasend('.'); # dataend() already sends "." + $Server->dataend(); + $Server->quit(); + } + + if (!defined($Header{'message-id'})) { + my $hname; + if (eval { require Sys::Hostname;1; } != 1) { + chomp($hname = `hostname`); + } else { + use Sys::Hostname; + $hname = hostname(); + } + my ($hostname,) = gethostbyname($hname); + if (defined($hostname) && $hostname =~ m/\./io) { + $Header{'message-id'} = "Message-ID: " . sprintf("\n", $>, timelocal(localtime), $$, $hostname); + } + } +} + +# add Cancel-Lock (and Cancel-Key) header(s) if requested +if ($config{'canlock-secret'} && !$config{'no-canlock'} && defined($Header{'message-id'})) { + open(my $CANLock, '<', (glob($config{'canlock-secret'}))[0]) or die("$0: Can't open " . $config{'canlock-secret'} . ": $!"); + chomp(my $key = <$CANLock>); + close($CANLock); + (my $data = $Header{'message-id'}) =~ s#^Message-ID: ##i; + chomp $data; + my $cancel_key = buildcancelkey($data, $key); + my $cancel_lock = buildcancellock($cancel_key, $sha_mod); + if (defined($Header{'cancel-lock'})) { + chomp $Header{'cancel-lock'}; + $Header{'cancel-lock'} .= " " . $config{'canlock-algorithm'} . ":" . $cancel_lock . "\n"; + } else { + $Header{'cancel-lock'} = "Cancel-Lock: " . $config{'canlock-algorithm'} . ":" . $cancel_lock . "\n"; + } + + if ((defined($Header{'supersedes'}) && $Header{'supersedes'} =~ m/^Supersedes:\s+<\S+>\s*$/i) || (defined($Header{'control'}) && $Header{'control'} =~ m/^Control:\s+cancel\s+<\S+>\s*$/i) ||(defined($Header{'also-control'}) && $Header{'also-control'} =~ m/^Also-Control:\s+cancel\s+<\S+>\s*$/i)) { + if (defined($Header{'also-control'}) && $Header{'also-control'} =~ m/^Also-Control:\s+cancel\s+/i) { + ($data = $Header{'also-control'}) =~ s#^Also-Control:\s+cancel\s+##i; + chomp $data; + $cancel_key = buildcancelkey($data, $key); + } else { + if (defined($Header{'control'}) && $Header{'control'} =~ m/^Control: cancel /i) { + ($data = $Header{'control'})=~ s#^Control:\s+cancel\s+##i; + chomp $data; + $cancel_key = buildcancelkey($data, $key); + } else { + if (defined($Header{'supersedes'})) { + ($data = $Header{'supersedes'}) =~ s#^Supersedes: ##i; + chomp $data; + $cancel_key = buildcancelkey($data, $key); + } + } + } + if (defined($Header{'cancel-key'})) { + chomp $Header{'cancel-key'}; + $Header{'cancel-key'} .= " " . $config{'canlock-algorithm'} . ":" . $cancel_key . "\n"; + } else { + $Header{'cancel-key'} = "Cancel-Key: " . $config{'canlock-algorithm'} . ":" . $cancel_key . "\n"; + } + } +} + +# set Posted-And-Mailed if we send a mailcopy to someone else +if ($config{'sendmail'} && defined($Header{'newsgroups'}) && (defined($Header{'to'}) || defined($Header{'cc'}) || defined($Header{'bcc'}))) { + foreach ('to', 'bcc', 'cc') { + if (defined($Header{$_}) && $Header{$_} ne $Header{'from'}) { + $Header{'posted-and-mailed'} = "Posted-And-Mailed: yes\n"; + last; + } + } +} + +if (! $config{'no-sign'}) { + if (!$config{'pgp-signer'}) { + chomp($config{'pgp-signer'} = $Header{'from'}); + $config{'pgp-signer'} =~ s/^[^\s:]+: (.*)/$1/; + } + $PGPCommand = getpgpcommand($config{'pgp-version'}); +} + +# exit with error if neither $Newsgroups nor any of $To, $Cc or $Bcc are set +my $required = 0; +foreach ('Newsgroups', 'To', 'Cc', 'Bcc') { + $required++ if (defined($Header{lc($_)})); + last if $required; +} +die("$0: neither Newsgroups: nor any of To:, Cc:, or Bcc: present.\n") if (!$required); + +# (re)move mail-headers +my ($To, $Cc, $Bcc, $Newsgroups) = ''; +$To = $Header{'to'} if (defined($Header{'to'})); +$Cc = $Header{'cc'} if (defined($Header{'cc'})); +$Bcc = $Header{'bcc'} if (defined($Header{'bcc'})); +delete $Header{$_} foreach ('to', 'cc', 'bcc'); +$Newsgroups = $Header{'newsgroups'} if (defined($Header{'newsgroups'})); + +my $MessageR = []; + +if ($config{'no-sign'}) { + # don't sign article + push @$MessageR, $Header{$_} for (keys %Header); + push @$MessageR, "\n", @Body; +} else { + # sign article + $MessageR = signarticle(\%Header, \@Body); +} + +# post or save article +if (! $config{'savedir'}) { + postarticle($MessageR) if ($Newsgroups); +} else { + savearticle($MessageR) if ($Newsgroups); +} + +# mail article +if (($To || $Cc || $Bcc) && $config{'sendmail'}) { + open(my $MAIL, '|-', $config{'sendmail'}) || die("$!"); + unshift @$MessageR, "$To" if ($To); + unshift @$MessageR, "$Cc" if ($Cc); + unshift @$MessageR, "$Bcc" if ($Bcc); + print($MAIL @$MessageR); + + close($MAIL); +} + +# Game over. Insert new coin. +exit; + + +#-------- sub readarticle +# +sub readarticle { + my ($HeaderR, $BodyR) = @_; + my $currentheader; + my $l = 0; + while (defined($_ = <>)) { + s#\r\n$#\n# if ($config{'transform'}); + if ($in_header) { + use bytes; + if (m/^$/o) { #end of header + $in_header = 0; + } elsif (m/^([^\s:]+): (.*)$/s) { + $currentheader = lc($1); + $$HeaderR{$currentheader} = "$1: $2"; + $l = length($_); + print "" . $1 . ":-header exceeds line length limit " . $l . " > " . $config{'max-header-length'} . " octets.\n" if (($config{'verbose'} || $config{'debug'}) && length($_) > $config{'max-header-length'}); + } elsif (m/^[ \t]/o) { + $$HeaderR{$currentheader} .= $_; + $l = length($_); + print "Part of continued " . ucfirst($currentheader) . ":-header exceeds line length limit " . $l . " > " . $config{'max-header-length'} . " octets.\n" if (($config{'verbose'} || $config{'debug'}) && $l > $config{'max-header-length'}); +# } elsif (m/^([^\s:]+):$/) { # skip over empty headers +# next; + } else { + chomp($_); + # TODO: quote esc. sequences? + die("'$_' is not a correct header-line"); + } + } else { + push @$BodyR, $_; + } + } + return; +} + +#-------- sub getdate +# getdate generates a date and returns it. +# +sub getdate { + my @time = localtime; + my $ss = ($time[0]<10) ? "0".$time[0] : $time[0]; + my $mm = ($time[1]<10) ? "0".$time[1] : $time[1]; + my $hh = ($time[2]<10) ? "0".$time[2] : $time[2]; + my $day = $time[3]; +# my $month = ($time[4]+1 < 10) ? "0".($time[4]+1) : $time[4]+1; # 01...12; unused + my $monthN = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")[$time[4]]; + my $wday = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat")[$time[6]]; + my $year = $time[5] + 1900; + my $offset = timelocal(localtime) - timelocal(gmtime); + my $sign ="+"; + if ($offset < 0) { + $sign ="-"; + $offset *= -1; + } + my $offseth = int($offset/3600); + my $offsetm = int(($offset - $offseth*3600)/60); + my $tz = sprintf("%s%0.2d%0.2d", $sign, $offseth, $offsetm); + return "$wday, $day $monthN $year $hh:$mm:$ss $tz"; +} + + +#-------- sub AuthonNNTP +# AuthonNNTP opens the connection to a Server and returns a Net::NNTP-Object. +# +# User, Password and Server are defined before as elements +# of the global hash %config. If no values for user or password +# are defined, the sub will try to ask the user (only if +# $config{'interactive'} is != 0). +sub AuthonNNTP { + my $Server = Net::NNTP->new( + Host => $config{'nntp-server'}, + Reader => 1, + Debug => $config{'debug'}, + Port => $config{'nntp-port'}, + Timeout => $config{'timeout'}, + Domain => ($config{'ipv4'} ? AF_INET : undef), + SSL => $config{'ssl'}, + SSL_verify_mode => 0 + ) or die("$0: Can't connect to ".$config{'nntp-server'}.":".$config{'nntp-port'}."!\n"); + if ($config{'debug'}) { + printf("Connected to : ".$Server->peerhost.":".$Server->peerport." [%s]\n", ($Server->sockdomain == PF_INET) ? "IPv4" : "IPv6"); + if ($config{'ssl'}) { + printf("SSL_fingerprint: %s %s\n", split(/\$/, $Server->get_fingerprint)); + } + } + my $ServerMsg = $Server->message(); + my $ServerCod = $Server->code(); + + # no read and/or write access - give up + if ($ServerCod < 200 || $ServerCod > 201) { + $Server->quit(); + die($0.": ".$ServerCod." ".$ServerMsg."\n"); + } + + # read access - try auth + if ($ServerCod == 201 || $config{'force-auth'}) { + if ($config{'nntp-pass'} eq "") { + if ($config{'interactive'}) { + $config{'nntp-user'} = $term->readline("Your Username at ".$config{'nntp-server'}.": "); + $attribs->{redisplay_function} = $attribs->{shadow_redisplay}; + $config{'nntp-pass'} = $term->readline("Password for ".$config{'nntp-user'}." at ".$config{'nntp-server'}.": "); + } else { + $Server->quit(); + die($0.": ".$ServerCod." ".$ServerMsg."\n"); + } + } + $Server->authinfo($config{'nntp-user'}, $config{'nntp-pass'}); + $ServerCod = $Server->code(); + $ServerMsg = $Server->message(); + if ($ServerCod != 281) { # auth failed + $Server->quit(); + die $0.": ".$ServerCod." ".$ServerMsg."\n"; + } + } + + $Server->post(); + $ServerCod = $Server->code(); + if ($ServerCod == 480) { + if ($config{'nntp-pass'} eq "") { + if ($config{'interactive'}) { + $config{'nntp-user'} = $term->readline("Your Username at ".$config{'nntp-server'}.": "); + $attribs->{redisplay_function} = $attribs->{shadow_redisplay}; + $config{'nntp-pass'} = $term->readline("Password for ".$config{'nntp-user'}." at ".$config{'nntp-server'}.": "); + } else { + $ServerMsg = $Server->message(); + $Server->quit(); + die($0.": ".$ServerCod." ".$ServerMsg."\n"); + } + } + $Server->authinfo($config{'nntp-user'}, $config{'nntp-pass'}); + $Server->post(); + } + return $Server; +} + + +#-------- sub getpgpcommand +# getpgpcommand generates the command to sign the message and returns it. +# +# Receives: +# - $pgpversion: A scalar holding the pgp-version +sub getpgpcommand { + my ($pgpversion) = @_; + my $found = 0; + + if ($config{'pgp'} !~ /^\//) { + foreach(split(/:/, $ENV{'PATH'})) { + if (-x $_."/".$config{'pgp'}) { + $found++; + last; + } + } + } + if (!-x $config{'pgp'} && ! $found) { + warn "PGP signing disabled: Can't locate executable ".$config{'pgp'}."\n" if ($config{'debug'} || $config{'verbose'}); + $config{'no-sign'} = 1; + } + + if ($pgpversion eq '2') { + if ($config{'pgp-pass'}) { + $PGPCommand = "PGPPASS=\"".$config{'pgp-pass'}."\" ".$config{'pgp'}." -z -u \"".$config{'pgp-signer'}."\" +verbose=0 language='en' -saft <".$config{'pgptmpf'}.".txt >".$config{'pgptmpf'}.".txt.asc"; + } elsif ($config{'interactive'}) { + $PGPCommand = $config{'pgp'}." -z -u \"".$config{'pgp-signer'}."\" +verbose=0 language='en' -saft <".$config{'pgptmpf'}.".txt >".$config{'pgptmpf'}.".txt.asc"; + } else { + die("$0: Passphrase is unknown!\n"); + } + } elsif ($pgpversion eq '5') { + if ($config{'path-to-pgp-pass'}) { + $PGPCommand = "PGPPASSFD=".$config{'pgp-pass-fd'}." ".$config{'pgp'}."s -u \"".$config{'pgp-signer'}."\" -t --armor -o ".$config{'pgptmpf'}.".txt.asc -z -f < ".$config{'pgptmpf'}.".txt ".$config{'pgp-pass-fd'}."<".$config{'path-to-pgp-pass'}; + } elsif ($config{'interactive'}) { + $PGPCommand = $config{'pgp'}."s -u \"".$config{'pgp-signer'}."\" -t --armor -o ".$config{'pgptmpf'}.".txt.asc -z -f < ".$config{'pgptmpf'}.".txt"; + } else { + die("$0: Passphrase is unknown!\n"); + } + } elsif ($pgpversion eq '6') { # this is untested + if ($config{'path-to-pgp-pass'}) { + $PGPCommand = "PGPPASSFD=".$config{'pgp-pass-fd'}." ".$config{'pgp'}." -u \"".$config{'pgp-signer'}."\" -saft -o ".$config{'pgptmpf'}.".txt.asc < ".$config{'pgptmpf'}.".txt ".$config{'pgp-pass-fd'}."<".$config{'path-to-pgp-pass'}; + } elsif ($config{'interactive'}) { + $PGPCommand = $config{'pgp'}." -u \"".$config{'pgp-signer'}."\" -saft -o ".$config{'pgptmpf'}.".txt.asc < ".$config{'pgptmpf'}.".txt"; + } else { + die("$0: Passphrase is unknown!\n"); + } + } elsif ($pgpversion =~ m/GPG1?$/io) { + if ($config{'path-to-pgp-pass'}) { + $PGPCommand = $config{'pgp'}." --emit-version --digest-algo $config{'digest-algo'} -a -u \"".$config{'pgp-signer'}."\" -o ".$config{'pgptmpf'}.".txt.asc --no-tty --batch --passphrase-fd ".$config{'pgp-pass-fd'}." ".$config{'pgp-pass-fd'}."<".$config{'path-to-pgp-pass'}." --clearsign ".$config{'pgptmpf'}.".txt"; + } elsif ($config{'interactive'}) { + $PGPCommand = $config{'pgp'}." --emit-version --digest-algo $config{'digest-algo'} -a -u \"".$config{'pgp-signer'}."\" -o ".$config{'pgptmpf'}.".txt.asc --no-secmem-warning --no-batch --clearsign ".$config{'pgptmpf'}.".txt"; + } else { + die("$0: Passphrase is unknown!\n"); + } + } elsif ($pgpversion =~ m/GPG2$/io) { + if ($config{'path-to-pgp-pass'}) { + $PGPCommand = $config{'pgp'}." --pinentry-mode loopback --emit-version --digest-algo $config{'digest-algo'} -a -u \"".$config{'pgp-signer'}."\" -o ".$config{'pgptmpf'}.".txt.asc --no-tty --batch --passphrase-fd ".$config{'pgp-pass-fd'}." ".$config{'pgp-pass-fd'}."<".$config{'path-to-pgp-pass'}." --clearsign ".$config{'pgptmpf'}.".txt"; + } elsif ($config{'interactive'}) { + $PGPCommand = $config{'pgp'}." --emit-version --digest-algo $config{'digest-algo'} -a -u \"".$config{'pgp-signer'}."\" -o ".$config{'pgptmpf'}.".txt.asc --no-secmem-warning --no-batch --clearsign ".$config{'pgptmpf'}.".txt"; + } else { + die("$0: Passphrase is unknown!\n"); + } + } else { + die("$0: Unknown PGP-Version $pgpversion!"); + } + return $PGPCommand; +} + + +#-------- sub postarticle +# postarticle posts your article to your Newsserver. +# +# Receives: +# - $ArticleR: A reference to an array containing the article +sub postarticle { + my ($ArticleR) = @_; + + my $Server = AuthonNNTP(); + my $ServerCod = $Server->code(); + my $ServerMsg = $Server->message(); + if ($ServerCod == 340) { + $Server->datasend(@$ArticleR); + ## buggy Net::Cmd < 2.31 + $Server->set_status(200, ""); + $Server->dataend(); + $ServerCod = $Server->code(); + $ServerMsg = $Server->message(); + if (! $Server->ok()) { + $Server->quit(); + die("\n$0: Posting failed! Response from news server:\n", $ServerCod, ' ', $ServerMsg); + } + $Server->quit(); + } else { + die("\n$0: Posting failed! Response from news server:\n", $ServerCod, ' ', $ServerMsg); + } + return; +} + + +#-------- sub savearticle +# savearticle saves your article to the directory $config{'savedir'} +# +# Receives: +# - $ArticleR: A reference to an array containing the article +sub savearticle { + my ($ArticleR) = @_; + my $timestamp = timelocal(localtime); + (my $ng = $Newsgroups) =~ s#^Newsgroups:\s*([^,\s]+).*#$1#i; + my $gn = join "", map { substr($_,0,1) } (split(/\./, $ng)); + my $filename = $config{'savedir'}."/".$timestamp."-".$gn."-".$$; + open(my $SH, '>', $filename) or die("$0: can't open $filename: $!\n"); + print $SH @$ArticleR; + close($SH) or warn "$0: Couldn't close: $!\n"; + return; +} + + +#-------- sub signarticle +# signarticle signs an article and returns a reference to an array +# containing the whole signed Message. +# +# Receives: +# - $HeaderR: A reference to a hash containing the articles headers. +# - $BodyR: A reference to an array containing the body. +# +# Returns: +# - $MessageRef: A reference to an array containing the whole message. +sub signarticle { + my ($HeaderR, $BodyR) = @_; + my (@pgp_head, @pgp_body, @sign_headers, $pgphead, $pgpbody, $signheaders); + + foreach (@{$config{'pgp-sign-headers'}}) { + if (defined($$HeaderR{lc($_)}) && $$HeaderR{lc($_)} =~ m/^[^\s:]+: .+/o) { + push @sign_headers, $_; + } + } + + $pgpbody = join("", @$BodyR); + + # Delete and create the temporary pgp-Files + unlink $config{'pgptmpf'}.".txt"; + unlink $config{'pgptmpf'}.".txt.asc"; + $signheaders = join(",", @sign_headers); + + $pgphead = "X-Signed-Headers: $signheaders\n"; + foreach my $header (@sign_headers) { + if ($$HeaderR{lc($header)} =~ m/^[^\s:]+: (.+?)\n?$/so) { + $pgphead .= $header.": ".$1."\n"; + } + } + + unless (substr($pgpbody, -1, 1) =~ /\n/) {$pgpbody .= "\n"}; + open(my $FH, '>', $config{'pgptmpf'} . ".txt") or die("$0: can't open ".$config{'pgptmpf'}.": $!\n"); + print $FH $pgphead, "\n", $pgpbody; + print $FH "\n" if ($config{'pgp-version'} =~ m/GPG/io); # workaround a pgp/gpg incompatibility - should IMHO be fixed in pgpverify + close($FH) or warn "$0: Couldn't close TMP: $!\n"; + + # Start PGP, then read the signature; + `$PGPCommand`; + + open($FH, '<', $config{'pgptmpf'} . ".txt.asc") or die("$0: can't open ".$config{'pgptmpf'}.".txt.asc: $!\n"); + local $/ = "\n".$config{'pgpbegin'}."\n"; + $_ = <$FH>; + unless (m/\Q$config{'pgpbegin'}\E$/o) { + unlink $config{'pgptmpf'} . ".txt"; + unlink $config{'pgptmpf'} . ".txt.asc"; + close($FH); + die("$0: ".$config{'pgpbegin'}." not found in ".$config{'pgptmpf'}.".txt.asc\n"); + } + unlink($config{'pgptmpf'} . ".txt") or warn "$0: Couldn't unlink ".$config{'pgptmpf'}.".txt: $!\n"; + + local $/ = "\n"; + $_ = <$FH>; + unless (m/^Version: (\S+)(?:\s(\S+))?/o) { + unlink $config{'pgptmpf'} . ".txt.asc"; + close($FH); + die("$0: didn't find PGP Version line where expected.\n"); + } + if (defined($2)) { + $$HeaderR{$config{'pgpheader'}} = $1."-".$2." ".$signheaders; + } else { + $$HeaderR{$config{'pgpheader'}} = $1." ".$signheaders; + } + do { # skip other pgp headers like + $_ = <$FH>; # "charset:"||"comment:" until empty line + } while ! /^$/; + + while (<$FH>) { + chomp; + last if /^\Q$config{'pgpend'}\E$/; + $$HeaderR{$config{'pgpheader'}} .= "\n\t$_"; + } + $$HeaderR{$config{'pgpheader'}} .= "\n" unless ($$HeaderR{$config{'pgpheader'}} =~ /\n$/s); + + $_ = <$FH>; + unless (eof($FH)) { + unlink $config{'pgptmpf'} . ".txt.asc"; + close($FH); + die("$0: unexpected data following ".$config{'pgpend'}."\n"); + } + close($FH); + unlink $config{'pgptmpf'} . ".txt.asc"; + + my $tmppgpheader = $config{'pgpheader'} . ": " . $$HeaderR{$config{'pgpheader'}}; + delete $$HeaderR{$config{'pgpheader'}}; + + @pgp_head = (); + foreach my $header (@{$config{'pgp-order-headers'}}) { + if ($$HeaderR{$header} && $$HeaderR{$header} ne "\n") { + push(@pgp_head, "$$HeaderR{$header}"); + delete $$HeaderR{$header}; + } + } + + foreach my $header (keys %$HeaderR) { + if ($$HeaderR{$header} && $$HeaderR{$header} ne "\n") { + push(@pgp_head, "$$HeaderR{$header}"); + delete $$HeaderR{$header}; + } + } + + push @pgp_head, ("X-PGP-Hash: " . $config{'digest-algo'} . "\n") if (defined($config{'digest-algo'})); + push @pgp_head, ("X-PGP-Key: " . $config{'pgp-signer'} . "\n"), $tmppgpheader; + undef $tmppgpheader; + + @pgp_body = split(/$/m, $pgpbody); + my @pgpmessage = (@pgp_head, "\n", @pgp_body); + return \@pgpmessage; +} + +#-------- sub buildcancelkey +# buildcancelkey builds the cancel-key based on the configured HASH algorithm. +# +# Receives: +# - $data: The input data. +# - $key: The secret key to be used. +# +# Returns: +# - $cancel_key: The calculated cancel-key. +sub buildcancelkey { + my ($data, $key) = @_; + my $cancel_key; + if ($config{'canlock-algorithm'} eq 'sha1') { + $cancel_key = MIME::Base64::encode(Digest::HMAC_SHA1::hmac_sha1($data, $key), ''); + } elsif ($config{'canlock-algorithm'} eq 'sha256') { + $cancel_key = MIME::Base64::encode(Digest::SHA::hmac_sha256($data, $key), ''); + } else { + $cancel_key = MIME::Base64::encode(Digest::SHA::hmac_sha512($data, $key), ''); + } + return $cancel_key; +} + +#-------- sub buildcancellock +# buildcancellock builds the cancel-lock based on the configured HASH algorithm +# and the given cancel-key. +# +# Receives: +# - $sha_mod: A hint which module to be used for sha1. +# - $cancel_key: The cancel-key for which the lock has to be calculated. +# +# Returns: +# - $cancel_lock: The calculated cancel-lock. +sub buildcancellock { + my ($cancel_key, $sha_module) = @_; + my $cancel_lock; + if ($config{'canlock-algorithm'} eq 'sha1') { + if ($sha_module =~ m/SHA1/) { + $cancel_lock = MIME::Base64::encode(Digest::SHA1::sha1($cancel_key, ''), ''); + } else { + $cancel_lock = MIME::Base64::encode(Digest::SHA::sha1($cancel_key, ''), ''); + } + } elsif ($config{'canlock-algorithm'} eq 'sha256') { + $cancel_lock = MIME::Base64::encode(Digest::SHA::sha256($cancel_key, ''), ''); + } else { + $cancel_lock = MIME::Base64::encode(Digest::SHA::sha512($cancel_key, ''), ''); + } + return $cancel_lock; +} + +sub version { + print "".$pname." ".$version."\n"; + return; +} + +sub usage { + version(); + print "Usage: ".$pname." [OPTS] < article\n"; + print " -4 force connecting via IPv4\n"; + print " -a string set Approved:-header to string\n"; + print " -c string set Control:-header to string\n"; + print " -d string set Distribution:-header to string\n"; + print " -e string set Expires:-header to string\n"; + print " -f string set From:-header to string\n"; + print " -i string list of headers to be ignored for signing\n"; + print " -m string set Message-ID:-header to string\n"; + print " -n string set Newsgroups:-header to string\n"; + print " -o string set Organization:-header to string\n"; + print " -p port use port as NNTP port [default=".$config{'nntp-port'}."]\n"; + print " -r string set Reply-To:-header to string\n"; + print " -s string save signed article to directory string instead of posting\n"; + print " -t string set Subject:-header to string\n"; + print " -v show warnings about missing/disabled features\n"; + print " -w string set Followup-To:-header to string\n"; + print " -x string prepend Path:-header with string\n"; + print " -D enable debugging\n"; + print " -E silently discard empty article\n"; + print " -F string set References:-header to string\n"; + print " -H show help\n"; + print " -I do not add Injection-Date: header\n"; + print " -L do not add Cancel-Lock: / Cancel-Key: headers\n"; + print " -O do not add Organization:-header\n"; + print " -R disallow control messages\n"; + print " -S do not append " . $config{'sig-path'} . "\n"; + print " -T seconds set connection timeout to seconds\n"; + print " -X do not sign article\n"; + print " -Y force authentication on connect\n"; + print " --canlock-algorithm string\n"; + print " digest algorithm for Cancel-Lock (sha1, sha256 or sha512)\n"; + print " --ssl use NNTPS (via port 563) if available\n"; + print " --transform convert to \n"; + print " --version show version\n"; + printf("\nAvailable tinewsrc-vars: %s\n", join(", ", sort keys %config)) if ($config{'verbose'} || $config{'debug'}); + exit 0; +} + +__END__ + +=head1 NAME + +tinews.pl - Post and sign an article via NNTP + +=head1 SYNOPSIS + +B [B] E I + +=head1 DESCRIPTION + +B reads an article on STDIN, signs it via L or +L and posts it to a news server. + +The article shall not contain any raw 8-bit data or it needs to +already have the relevant MIME-headers as B will not +add any MIME-headers nor encode its input. + +If the article contains To:, Cc: or Bcc: headers and mail-actions are +configured it will automatically add a "Posted-And-Mailed: yes" header +to the article and send out the mail-copies. + +If a Cancel-Lock secret file is defined it will automatically add a +Cancel-Lock: (and Cancel-Key: if required) header. + +The input should have unix line endings (, '\n'). Use --B +to convert from to just . + +=head1 OPTIONS +X + +=over 4 + +=item -B<4> | --B +X<-4> X<--iv4> + +Force connecting via IPv4 to the remote NNTP server. + +=item -B C | --B C +X<-a> X<--approved> + +Set the article header field Approved: to the given value. + +=item -B C | --B C +X<-c> X<--control> + +Set the article header field Control: to the given value. + +=item -B C | --B C +X<-d> X<--distribution> + +Set the article header field Distribution: to the given value. + +=item -B C | --B C +X<-e> X<--expires> + +Set the article header field Expires: to the given value. + +=item -B C | --B C +X<-f> X<--from> + +Set the article header field From: to the given value. + +=item -B F
| --B F
+X<-i> X<--ignore-headers> + +Comma separated list of headers that will be ignored during signing. +Usually the following headers will be signed if present: + +From, Newsgroups, Subject, Control, Supersedes, Followup-To, +Date, Injection-Date, Sender, Approved, Message-ID, Reply-To, +Cancel-Key, Also-Control and Distribution. + +Some of them may be altered on the Server (i.e. Cancel-Key) which would +invalid the signature, this option can be used the exclude such headers +if required. + +=item -B C | --B C +X<-m> X<--message-id> + +Set the article header field Message-ID: to the given value. + +=item -B C | --B C +X<-n> X<--newsgroups> + +Set the article header field Newsgroups: to the given value. + +=item -B C | --B C +X<-o> X<--organization> + +Set the article header field Organization: to the given value. + +=item -B

C | --B C +X<-p> X<--port> + +use C as NNTP-port + +=item -B C | --B C +X<-r> X<--reply-to> + +Set the article header field Reply-To: to the given value. + +=item -B F | --B F +X<-s> X<--savedir> + +Save signed article to directory F instead of posting. + +=item -B C | --B C +X<-t> X<--subject> + +Set the article header field Subject: to the given value. + +=item -B | --B +X<-v> X<--verbose> + +Warn about disabled options due to lacking perl-modules or executables and +unreadable files and enable warnings about raw 8-bit data. + +=item -B C | --B C +X<-w> X<--followup-to> + +Set the article header field Followup-To: to the given value. + +=item -B C | --B C +X<-x> X<--path> + +Prepend the article header field Path: with the given value. + +=item -B | -B | --B +X<-D> X<-N> X<--debug> + +Set L to debug mode, enable warnings about raw 8-bit data, +warn about disabled options due to lacking perl-modules or executables and +unreadable files. + +=item -B | --B +X<-E> X<--discard-empty> + +Silently discard an empty article. + +=item -B | --B +X<-F> X<--references> + +Set the article header field References: to the given value. + +=item -B | --B +X<-H> X<--help> + +Show help-page. + +=item -B | --B +X<-I> X<--no-injection-date> + +Do not add Injection-Date: header. + +=item -B | --B +X<-L> X<--no-canlock> + +Do not add Cancel-Lock: / Cancel-Key: headers. + +=item -B | --B +X<-O> X<--no-organization> + +Do not add Organization: header. + +=item -B | --B +X<-R> X<--no-control> + +Restricted mode, disallow control-messages. + +=item -B | --B +X<-s> X<--no-signature> + +Do not append F<$HOME/.signature>. + +=item -B C | --B C +X<-T> X<--timeout> + +Override the connection timeout setting. Default is 120 seconds. + +=item -B | --B +X<-X> X<--no-sign> + +Do not sign the article. + +=item -B | --B +X<-Y> X<--force-auth> + +Force authentication on connect even if not required by the server. + +=item --B C +X<--canlock-algorithm> + +Digest algorithm used for Cancel-Lock: / Cancel-Key: headers. +Supported algorithms are sha1, sha256 and sha512. Default is sha1. + +=item --B | --B +X<--ssl> X<--nntps> + +Use NNTPS (via port 563) if available. This requires a recent version +of L and L. Be aware that no SSL +verification will be done. + +=item --B +X<--transform> + +Convert network line endings () to unix line endings (). + +=item --B +X<--version> + +Show version. + +=item -B -B -B +X<-A> X<-V> X<-W> + +These options are accepted for compatibility reasons but ignored. + +=item -B | --B +X<-h> X<--headers> + +These options are accepted for compatibility reasons but ignored. + +=back + +=head1 EXIT STATUS + +The following exit values are returned: + +=over 4 + +=item S< 0> + +Successful completion. + +=item S + +An error occurred. + +=back + +=head1 ENVIRONMENT +X + +=over 4 + +=item B<$NEWSHOST> +X<$NEWSHOST> X + +Set to override the NNTP server configured in the source or config-file. +It has lower priority than B<$NNTPSERVER> and should be avoided. + +=item B<$NNTPSERVER> +X<$NNTPSERVER> X + +Set to override the NNTP server configured in the source or config-file. +This has higher priority than B<$NEWSHOST>. + +=item B<$NNTPPORT> +X<$NNTPPORT> X + +The NNTP TCP-port to post news to. This variable only needs to be set if the +TCP-port is not 119 (the default). The '-B

' command-line option overrides +B<$NNTPPORT>. + +=item B<$PGPPASS> +X<$PGPPASS> X + +Set to override the passphrase configured in the source (used for +L-2.6.3). + +=item B<$PGPPASSFILE> +X<$PGPPASSFILE> X + +Passphrase file used for L or L. + +=item B<$SIGNER> +X<$SIGNER> X + +Set to override the user-id for signing configured in the source. If you +neither set B<$SIGNER> nor configure it in the source the contents of the +From:-field will be used. + +=item B<$REPLYTO> +X<$REPLYTO> X + +Set the article header field Reply-To: to the return address specified by +the variable if there isn't already a Reply-To: header in the article. +The '-B' command-line option overrides B<$REPLYTO>. + +=item B<$ORGANIZATION> +X<$ORGANIZATION> X + +Set the article header field Organization: to the contents of the variable +if there isn't already an Organization: header in the article. The '-B' +command-line option overrides B<$ORGANIZATION>, The '-B' command-line +option disables it. + +=item B<$DISTRIBUTION> +X<$DISTRIBUTION> X + +Set the article header field Distribution: to the contents of the variable +if there isn't already a Distribution: header in the article. The '-B' +command-line option overrides B<$DISTRIBUTION>. + +=back + +=head1 FILES + +=over 4 + +=item F + +Temporary file used to store the reformatted article. + +=item F + +Temporary file used to store the reformatted and signed article. + +=item F<$PGPPASSFILE> + +The passphrase file to be used for L or L. + +=item F<$HOME/.signature> + +Signature file which will be automatically included. + +=item F<$HOME/.cancelsecret> + +The passphrase file to be used for Cancel-Locks. This feature is turned +off by default. + +=item F<$HOME/.newsauth> + +"nntpserver password [user]" pairs or triples for NNTP servers that require +authorization. First match counts. Any line that starts with "#" is a +comment. Blank lines are ignored. This file should be readable only for the +user as it contains the user's unencrypted password for reading news. If no +matching entry is found F<$HOME/.nntpauth> is checked. + +=item F<$HOME/.nntpauth> + +"nntpserver user password" triples for NNTP servers that require +authorization. First match counts. Lines starting with "#" are skipped and +blank lines are ignored. This file should be readable only for the user as +it contains the user's unencrypted password for reading news. +F<$HOME/.newsauth> is checked first. + +=item F<$XDG_CONFIG_HOME/tinewsrc> F<$HOME/.config/tinewsrc> F<$HOME/.tinewsrc> + +"option=value" configuration pairs, last match counts and only +"value" is case sensitive. Lines that start with "#" are ignored. If the +file contains unencrypted passwords (e.g. nntp-pass or pgp-pass), it +should be readable for the user only. Use -B to get a full list of +all available configuration options. + +=back + +=head1 SECURITY + +If you've configured or entered a password, even if the variable that +contained that password has been erased, it may be possible for someone to +find that password, in plaintext, in a core dump. In short, if serious +security is an issue, don't use this script. + +Be aware that even if NNTPS is used still no SSL verification will be done. + +=head1 NOTES + +B is designed to be used with L-2.6.3, +L-5, L-6, L and L. + +B requires the following standard modules to be installed: +L, L, L and +L. + +NNTPS (NNTP with implicit TLS; RFC 4642 and RFC 8143) may be unavailable +if L is too old or L is missing on +the system. B will fallback to unencrypted NNTP in that case. + +If the Cancel-Lock feature (RFC 8315) is enabled the following additional +modules must be installed: L, L or +L and L. sha256 and sha512 as +algorithms for B are only available with L. + +L users may need to set B<$GPG_TTY>, i.e. + + GPG_TTY=$(tty) + export GPG_TTY + +before using B. See L for details. + +B does not do any MIME encoding, its input should be already +properly encoded and have all relevant headers set. + +=head1 AUTHOR + +Urs Janssen Eurs@tin.orgE, +Marc Brockschmidt Emarc@marcbrockschmidt.deE + +=head1 SEE ALSO + +L, L, L, L, L, +L, L, L, +L, L, L, +L, L + +=cut diff --git a/contrib/yearstats.sh b/contrib/yearstats.sh new file mode 100644 index 0000000..3cc2ab4 --- /dev/null +++ b/contrib/yearstats.sh @@ -0,0 +1,11 @@ +#!/bin/bash +# installation path is /srv/newsstats/, please adjust accordingly +# $1: newsgroup +echo "Stats for $1" +cd /srv/newsstats/ +for year in {2012..2022} +do + echo -n "${year}: " + bin/groupstats.pl -m $year-01:$year-12 -r sums -n $1 +done + diff --git a/doc/ChangeLog b/doc/ChangeLog index 3cced70..ccdeeba 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -21,6 +21,7 @@ NewsStats 0.3.0 (unreleased) * Fix call to GetMaxLength() in cliservstats. * Fix typos in documentation, update sample config file. * Move database creation from install/install.pl to bin/dbcreate.pl + * Add tinews.pl and some shell scripts to /contrib. NewsStats 0.2.0 (2025-05-10) * Redo directory structure: diff --git a/doc/README b/doc/README index 1d608b7..222cdba 100644 --- a/doc/README +++ b/doc/README @@ -54,7 +54,12 @@ Prerequisites Installation instructions - See INSTALL. + See INSTALL. + + Documentation is in /doc, configuration in /etc, the NewsStats + module in /lib and most scripts in /bin, while /contrib has some + sample scripts that may have to be adjusted to work in your + configuration. Getting Started From 5a6a3e58bff6a76dc723bac7b4c0a5275dfb8bdf Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 18 May 2025 17:10:19 +0200 Subject: [PATCH 30/30] Release 0.3.0 Signed-off-by: Thomas Hochstein --- doc/ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index ccdeeba..e6da31e 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,4 @@ -NewsStats 0.3.0 (unreleased) +NewsStats 0.3.0 (2025-05-18) * Extract GroupStats (in gatherstats) to subroutine. * Add ParseHeader() to library. * Add HostStats to gatherstats.