From 157c0dffd1ff29307f418b3a3c25e589e832f640 Mon Sep 17 00:00:00 2001 From: Thomas Hochstein Date: Sun, 29 Jun 2025 12:23:25 +0200 Subject: [PATCH] Add addpost.pl. Signed-off-by: Thomas Hochstein --- bin/addpost.pl | 250 +++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeLog | 1 + 2 files changed, 251 insertions(+) create mode 100644 bin/addpost.pl diff --git a/bin/addpost.pl b/bin/addpost.pl new file mode 100644 index 0000000..da4c940 --- /dev/null +++ b/bin/addpost.pl @@ -0,0 +1,250 @@ +#! /usr/bin/perl +# +# addpost.pl +# +# This script will add dropped feedlog data from a single posting. +# +# 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 ParseHeaders); +require '/usr/lib/news/innshellvars.pl'; + +use Date::Format; +use DBI; +use Encode qw(encode); +use Getopt::Long qw(GetOptions); +Getopt::Long::config ('bundling'); + +################################# Subroutines ################################## + +# taken from cancelwatch.pl by Ralf Doeblitz +sub safe_pipe_fork($) { + my ($pid, $sleep_count); + my $name=shift; + + do { + $pid = open(KID, $name); + unless (defined $pid) { + warn "cannot fork: $!"; + die "bailing out" if $sleep_count++ > 6; + sleep 10; + } + } until defined $pid; + + return ($pid); +} + +# taken from cancelwatch.pl by Ralf Doeblitz +sub safe_pipe_read(@) { + my @cmd = @_; + my $pid = safe_pipe_fork('-|'); + + if ($pid) { # parent + my @a=; + close KID or die "child exited: $?"; + return @a; + } else { + exec { $cmd[0] } @cmd; + exit -1; + } +} +################################# Main program ################################# + +### read commandline options +my ($OptRawDB,$OptConfFile); +GetOptions ('rawdb=s' => \$OptRawDB, + 'conffile=s' => \$OptConfFile, + 'h|help' => \&ShowPOD, + 'V|version' => \&ShowVersion) or exit 1; + +### read configuration +my %Conf = %{ReadConfig($OptConfFile)}; + +### override configuration via commandline options +my %ConfOverride; +$ConfOverride{'DBTableRaw'} = $OptRawDB if $OptRawDB; +&OverrideConfig(\%Conf,\%ConfOverride); + +### init database +my $DBHandle = InitDB(\%Conf,1); +my $DBRaw = sprintf('%s.%s',$Conf{'DBDatabase'},$Conf{'DBTableRaw'}); + +### parsing data --------------------------------------------------------------- +# feedlog will get $Mid, $Timestamp, $Token, $Size, $Peer, $Path, $Newsgroups and $Headers + +# get MID from @ARGV +my $Mid = $ARGV[0]; +&Bleat(2, "No Message-ID given!\nUsage: addpost.pl ") if !$Mid; + +# get storage token from MID +my ($Token) = safe_pipe_read("$inn::newsbin/grephistory", $Mid); +chomp($Token); + +# get arrival time from history +my $Timestamp; +open(my $HISTORY, '<', $inn::history) + or die "Can't open $inn::history: $!"; +while (<$HISTORY>) +{ + next unless /$Token/; + $_ =~ /^\[.+\]\s+(\d+)~/; + $Timestamp = $1; +} + +# get headers, $Path and $Newsgroups +my @Headers = safe_pipe_read("$inn::newsbin/sm", '-H', $Token); +my $Headers = join("", @Headers); +my %Header = ParseHeaders(split(/\n/,$Headers)); +my $Path = $Header{'path'}; +my $Newsgroups = $Header{'newsgroups'}; +# get $Peer +$Path =~ /^news.szaf.org!([^!]+)/; +my $Peer = $1; +# get size +my @Article = safe_pipe_read("$inn::newsbin/sm", $Token); +my $Article = join("", @Article); +my $Size = length($Article); + +# convert headers to UTF-8, if necessary +$Headers = encode('utf-8', $Headers) if ($Headers =~ /[\x80-\x{ffff}]/); + +# parse timestamp to day (YYYY-MM-DD) and to MySQL timestamp +my $Day = time2str("%Y-%m-%d", $Timestamp); +my $Date = time2str("%Y-%m-%d %H:%M:%S", $Timestamp); + +### write to database +my $DBQuery = $DBHandle->prepare(sprintf("INSERT INTO %s.%s (day,date,mid, + timestamp,token,size,peer,path, + newsgroups,headers) + VALUES (?,?,?,?,?,?,?,?,?,?)", + $Conf{'DBDatabase'}, + $Conf{'DBTableRaw'})); + +if (!$DBQuery->execute($Day, $Date, $Mid, $Timestamp, $Token, $Size, $Peer, + $Path, $Newsgroups, $Headers)) { + &Bleat(2, sprintf('Database error %s while processing %s: %s', + $DBI::err, $Mid, $DBI::errstr)); +}; +$DBQuery->finish; + +### close handles +close $HISTORY; +$DBHandle->disconnect; + +__END__ + +################################ Documentation ################################# + +=head1 NAME + +addpost - add data for a single posting to a database + +=head1 SYNOPSIS + +B [B<-Vh>] [B<--conffile> I] [B<--rawdb> I] I + +=head1 REQUIREMENTS + +See L. + +=head1 DESCRIPTION + +This script will log overview data and complete headers to a database +table for further examination for a single posting, identified by its +Message-ID. It's intended to add postings dropped by F. + +=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 L for an overview of possible configuration options. + +You can override the database written to by using the B<--rawdb> +option. + +=head1 OPTIONS + +=over 3 + +=item B<-V>, B<--version> + +Display version and copyright information and exit. + +=item B<-h>, B<--help> + +Display this man page and exit. + +=item B<--conffile> I + +Read configuration from I instead of F. + +=item B<--rawdb> I (raw data table) + +Override I from F. + +=back + +=head1 INSTALLATION + +See L. + +=head1 EXAMPLES + +Add a posting with Message-ID: + + addposts -- '' + +=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! + +=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 diff --git a/doc/ChangeLog b/doc/ChangeLog index b746a27..e42df3b 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -2,6 +2,7 @@ NewsStats 0.5.0 (unreleased) * Change install path from /srv/ to /opt/. * dbcreate: Change raw table to InnoDB and utf8mb4. * feedlog: Fix errors when saving unencoded 8bit headers. + * Add addpost (to add post data dropped by feedlog). NewsStats 0.4.0 (2025-06-02) * Reformat $Conf{TLH} for GroupStats only.