@@ 0,0 1,279 @@
+#!/petroglyph/perl/bin/perl
+# Copyright 2023 Corwin Brust <corwin@bru.st>
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+#
+# General Public License for more details.
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see https://www.gnu.org/licenses/.
+#
+# Syndicate commit meesages sent via UDP from git post-receive hooks
+# to IRC channels given they satisfy filter criteria.
+#
+# We get five items, space separated:
+# PROJECT CONTEXT REVISION AUTHOR MESSAGE
+#
+# PROJECT: the repository name
+# CONTEXT: the branch/tag
+# REVISION: the new commit hash (given as $newrev)
+# AUTHOR: the local name of the author (not the commiter)
+# MESSAGE: the first line of the commit message
+#
+# In order to filter and format the messages as we relay them to IRC,
+# we construct an interum object, an href with the keys matching the
+# field names above converted to lower case, and perform the following
+# transformations:
+#
+# 1. trim MESSAGE removing trailing spaces and leading [;*\s]+
+# 2. add a URL pointing to a CGIT log page for REVISION
+# 3. truncate REVISION to six characters
+
+use strict;
+use warnings qw[all];
+use feature qw[say];
+use experimental qw[signatures];
+no warnings q[experimental];
+
+use Future::AsyncAwait;
+
+use IO::Async::Loop;
+use IO::Async::Socket;
+use Net::Async::WebSocket::Client;
+use Net::Async::IRC;
+
+use File::Basename qw[basename dirname];
+
+## the program should not buffer output
+STDOUT->autoflush;
+
+## boiler-plate: I define these vars for most programs
+my ( $PROGRAM ) = basename $0, qw[.pl]; # udp-to-irc.pl
+my $VERSION = '0.0.50';
+
+# any truthy value for more output, sent to STDERR
+my $DEBUG = $ENV{CC_DEBUG} // 1;
+
+# handy for testing to avoid connecting to IRC
+my $IRC_ENABLED = $ENV{CC_NO_IRC} ? 0 : 1;
+
+# this this program we actually need a CGIT host
+my $SVHOST = $ENV{CC_CGIT_HOST} // q(https://git.sv.gnu.org);
+
+# ensure SVHOST taken from URI doesn't end with a /
+$SVHOST =~ s/\/$//;
+
+# format to construct CGIT URLs, params are:
+# 0 1 2
+# PROJECT CONTEXT REVISION
+my $CGIT_LOG_BASEURI = $SVHOST . q(/cgit/%s.git/commit/?h=%s&id=%s);
+
+# ZZZ allow overriding these from the environment (or config)?
+my $IRC_TEXT_FORMAT = q/[%s@%s] %s %s (%s)/;
+my @IRC_TEXT_FORMAT_FIELDS = qw[
+ context
+ revision
+ message
+ url
+ author
+];
+
+# here is some configuration
+my ( %Config ) = (
+
+ # used for the (write only) bot's connection
+ irc => {
+ host => 'irc.libera.chat',
+ port => 6697,
+ nick => 'gliphy',
+ realname => $ENV{CC_PROG} || $PROGRAM,
+ pass => ( $ENV{CC_IRC_PW} || undef ),
+ },
+
+ # the UDP listener
+ udp => {
+ port => ( $ENV{CC_UDP_PORT} || 17980 ),
+ accept_hosts => {},
+ reject_hosts => {},
+ },
+
+ # channel to message filter assocations
+ projects => {
+ '#emacs-dev' => {
+ # keys are the fields of successfully parsed message
+ # values may be:
+ # WORKING =>
+ # STRING exact match required
+ # TODO =>
+ # REGEX e.g created with QR
+ # SUBREF receives $parsed_href and $sender_addr
+ # AREF a list of zero or more of any of these
+ project => 'emacs',
+ },
+ },
+);
+
+{
+ # cache existance of reject and accept lists
+ my $no_accept_list = %{ $Config{udp}{accept_hosts} } < 1;
+ my $no_acls_exist = $no_accept_list && %{ $Config{udp}{reject_hosts} } < 1;
+
+ sub can_accept_host ($addr) {
+ return unless $addr;
+ return 1 if $no_acls_exist;
+ return 1 if $no_accept_list and not exists $Config{udp}{reject_hosts}{$addr};
+ return 1 if $Config{udp}{accept_hosts}{$addr};
+ }
+
+ sub build_message ($o) {
+ # rtrim text
+ $o->{message} =~ s/[\s.]+$//m;
+ # ltrim text of semi-colon, star, and space like chars
+ $o->{message} =~ s/^[\s;*]+//s;
+
+ # create a URL
+ $o->{url} = sprintf(
+ $CGIT_LOG_BASEURI,
+ $o->{project},
+ $o->{context},
+ $o->{revision},
+ );
+
+ # take just the first few characters of the revision
+ $o->{revision} = substr( $o->{revision}, 0, 6);
+ return $o;
+ }
+
+ sub parse_dgram ( $dgram, $addr ) {
+ my ( $project, $context, $revision, $author, $logline ) =
+ split /[\s]+/ms, $dgram, 5;
+
+ # content validations
+ unless ($project
+ and $context
+ and $revision
+ and $author
+ and $logline
+ and $revision =~ /^\b[0-9a-f]{5,40}$/) {
+ $DEBUG and warn 'ERR1:',$addr,qq[\Q$dgram\E],"\n";
+ return;
+ }
+
+ return build_message( {
+ project => $project,
+ context => $context,
+ revision => $revision,
+ author => $author,
+ message => $logline,
+ });
+ }
+
+ sub dgram_to_message ($dgram, $addr, $check=undef, $success=undef){
+ chomp($dgram);
+ $DEBUG and warn 'RECV:', $dgram, "\n";
+ return unless $dgram;
+
+ unless ( can_accept_host( $addr ) ) {
+ $DEBUG and warn 'HOST:',$addr,qq[\Q$dgram\E],"\n";
+ return;
+ }
+
+ my $message = parse_dgram( $dgram, $addr ) or return;
+ unless (not $check or $check->( $message, $addr )) {
+ $DEBUG and warn 'RJCT:',$addr,qq[\Q$dgram\E],"\n";
+ return;
+ }
+
+ $success->( $message, $addr ) if $success;
+ return $message;
+ }
+}
+
+## start
+my $loop = IO::Async::Loop->new;
+
+## create an IRC client
+my $irc;
+if ($IRC_ENABLED) {
+ $irc = Net::Async::IRC->new;
+ $loop->add( $irc );
+}
+
+## setup the UDP listener
+my $socket = IO::Async::Socket->new(
+ on_recv => sub {
+ my ( $self, $dgram, $addr ) = @_;
+
+ my $message = dgram_to_message( $dgram, $addr )
+ # ZZZ: fail2ban?
+ or return;
+
+ for my $room (keys %{ $Config{projects} }) {
+ for my $field (keys %{ $Config{projects}{ $room } }) {
+ return unless exists $message->{$field};
+ return unless $message->{$field} eq $Config{projects}{$room}{$field};
+ }
+ my $text = sprintf(
+ $IRC_TEXT_FORMAT,
+ map {
+ $message->{$_}
+ } @IRC_TEXT_FORMAT_FIELDS,
+ );
+ if ($IRC_ENABLED) {
+
+ $irc->do_PRIVMSG(
+ target => $room,
+ text => $text,
+ );
+
+ say qq(SENT $room $text);
+ }
+ else { # IRC is disabled, so testing
+ say qq(OKAY $room $text)
+ }
+ }
+ }
+);
+$loop->add( $socket );
+
+say "Starting $PROGRAM ..";
+
+# connect to IRC
+if ($irc) {
+ delete $Config{irc}->{pass} unless $Config{irc}->{pass};
+ await $irc->login(
+ %{ $Config{irc} },
+ on_login => sub {
+ $DEBUG and say q(joining ), join ', ', keys %{ $Config{projects} };
+
+ for my $room (keys %{ $Config{projects} }) {
+ $irc->send_message(
+ Protocol::IRC::Message->new(
+ "JOIN",
+ undef,
+ $room
+ ),
+ );
+ say "joined $room";
+ }
+ });
+}
+
+# start the UDP socket listener
+$socket->bind(
+ service => $Config{udp}{port},
+ socktype => 'dgram'
+)->then(sub{
+ say "$PROGRAM: listening on $Config{udp}{port}"
+})->get;
+
+# main engine start
+$loop->run;
+
+__END__