~mplscorwin/git-udp-syndicate

7c9c91e916bdf249c7d54d0018f65c9a2502d9f7 — Corwin Brust 4 months ago b7532e6
add an IRC relay
1 files changed, 279 insertions(+), 0 deletions(-)

A udp-to-irc.pl
A udp-to-irc.pl => udp-to-irc.pl +279 -0
@@ 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__