251 lines
6 KiB
Perl
Executable file
251 lines
6 KiB
Perl
Executable file
#! /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 <thh@thh.name>
|
|
#
|
|
# 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=<KID>;
|
|
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 <Message-ID>") 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<addlog> [B<-Vh>] [B<--conffile> I<filename>] [B<--rawdb> I<database table>] I<Message-ID>
|
|
|
|
=head1 REQUIREMENTS
|
|
|
|
See L<doc/README>.
|
|
|
|
=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<feedlog>.
|
|
|
|
=head2 Configuration
|
|
|
|
B<feedlog> will read its configuration from F<newsstats.conf> which
|
|
should be present in etc/ via Config::Auto or from a configuration file
|
|
submitted by the B<--conffile> option.
|
|
|
|
See L<doc/INSTALL> 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<filename>
|
|
|
|
Read configuration from I<filename> instead of F<newsstats.conf>.
|
|
|
|
=item B<--rawdb> I<table> (raw data table)
|
|
|
|
Override I<DBTableRaw> from F<newsstats.conf>.
|
|
|
|
=back
|
|
|
|
=head1 INSTALLATION
|
|
|
|
See L<doc/INSTALL>.
|
|
|
|
=head1 EXAMPLES
|
|
|
|
Add a posting with Message-ID: <mylocalpart@domain.example>
|
|
|
|
addposts -- '<mylocalpart@domain.example>'
|
|
|
|
=head1 FILES
|
|
|
|
=over 4
|
|
|
|
=item F<bin/addlog.pl>
|
|
|
|
The script itself.
|
|
|
|
=item F<lib/NewsStats.pm>
|
|
|
|
Library functions for the NewsStats package.
|
|
|
|
=item F<etc/newsstats.conf>
|
|
|
|
Runtime configuration file.
|
|
|
|
=back
|
|
|
|
=head1 BUGS
|
|
|
|
Please report any bugs or feature requests to the author or use the
|
|
bug tracker at L<https://code.virtcomm.de/thh/newsstats/issues>!
|
|
|
|
=back
|
|
|
|
This script is part of the B<NewsStats> package.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Thomas Hochstein <thh@thh.name>
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
Copyright (c) 2025 Thomas Hochstein <thh@thh.name>
|
|
|
|
This program is free software; you may redistribute it and/or modify it
|
|
under the same terms as Perl itself.
|
|
|
|
=cut
|