From 2e2bdf9c6ce1cd66ba5cfe1a42786a6f486b7969 Mon Sep 17 00:00:00 2001
From: eta <eta@theta.eu.org>
Date: Sun, 8 Nov 2020 18:38:19 +0000
Subject: feat(panettone): announce newly created issues using irccat

- The new PANETTONE.IRC package contains the SEND-IRC-NOTIFICATION function,
  which opens a new TCP socket to irccat (if it's running and configured) in
  order to announce the creation of new issues.
- The IRCCATHOST and IRCCATPORT environment variables must be set for this to
  work.
- Additionally, the ISSUECHANNEL environment variable may be used to direct
  announcements at a given channel (otherwise it'll just use the first one).

Change-Id: I429a66f24d0f80ed10db173d6af7105fb1d3d023
Reviewed-on: https://cl.tvl.fyi/c/depot/+/2077
Tested-by: BuildkiteCI
Reviewed-by: glittershark <grfn@gws.fyi>
---
 web/panettone/default.nix        |  1 +
 web/panettone/src/irc.lisp       | 24 ++++++++++++++++++++++++
 web/panettone/src/packages.lisp  |  5 +++++
 web/panettone/src/panettone.lisp | 12 ++++++++----
 4 files changed, 38 insertions(+), 4 deletions(-)
 create mode 100644 web/panettone/src/irc.lisp

(limited to 'web/panettone')

diff --git a/web/panettone/default.nix b/web/panettone/default.nix
index 3ff8ca55ec..8d112901ec 100644
--- a/web/panettone/default.nix
+++ b/web/panettone/default.nix
@@ -26,6 +26,7 @@ depot.nix.buildLisp.program {
     ./src/css.lisp
     ./src/authentication.lisp
     ./src/model.lisp
+    ./src/irc.lisp
     ./src/panettone.lisp
   ];
 
diff --git a/web/panettone/src/irc.lisp b/web/panettone/src/irc.lisp
new file mode 100644
index 0000000000..a54112811f
--- /dev/null
+++ b/web/panettone/src/irc.lisp
@@ -0,0 +1,24 @@
+;;;; Using irccat to send IRC notifications
+
+(in-package :panettone.irc)
+
+(defun get-irccat-config ()
+  "Reads the IRCCATHOST and IRCCATPORT environment variables, and returns them as two values if they both exist (otherwise, returns NIL)."
+  (destructuring-bind (host port)
+      (mapcar #'uiop:getenvp '("IRCCATHOST" "IRCCATPORT"))
+    (when (and host port)
+      (values host (parse-integer port)))))
+
+(defun send-irc-notification (body &key channel)
+  "Sends BODY to the IRC channel CHANNEL (starting with #), if an IRCCat server is configured (using the IRCCATHOST and IRCCATPORT environment variables)
+If CHANNEL is NIL, sends the BODY to the first channel configured in the IRCCat configuration.
+May signal a condition if sending fails."
+  (multiple-value-bind (irchost ircport)
+      (get-irccat-config)
+    (when irchost
+      (let ((socket (socket-connect irchost ircport)))
+        (unwind-protect
+             (progn
+               (format (socket-stream socket) "~@[~A ~]~A~%" channel body)
+               (finish-output (socket-stream socket)))
+          (ignore-errors (socket-close socket)))))))
diff --git a/web/panettone/src/packages.lisp b/web/panettone/src/packages.lisp
index 1a8453055f..87285fa34d 100644
--- a/web/panettone/src/packages.lisp
+++ b/web/panettone/src/packages.lisp
@@ -7,6 +7,10 @@
   (:use :cl :lass)
   (:export :styles))
 
+(defpackage panettone.irc
+  (:use :cl :usocket)
+  (:export :send-irc-notification))
+
 (defpackage :panettone.authentication
   (:nicknames :authn)
   (:use :cl :panettone.util :klatre)
@@ -47,5 +51,6 @@
    :id :subject :body :author-dn :issue-id :status :created-at
    :field :previous-value :new-value :acting-user-dn
    :issue-comments :num-comments :issue-events)
+  (:import-from :panettone.irc :send-irc-notification)
   (:shadow :next)
   (:export :start-pannetone :config :main))
diff --git a/web/panettone/src/panettone.lisp b/web/panettone/src/panettone.lisp
index cef3572214..9135bcf8dd 100644
--- a/web/panettone/src/panettone.lisp
+++ b/web/panettone/src/panettone.lisp
@@ -450,10 +450,14 @@
       (render/issue-form
        (make-instance 'model:issue :subject subject :body body)
        "Subject is required")
-      (progn
-        (model:create-issue :subject subject
-                            :body body
-                            :author-dn (dn *user*))
+      (let ((issue
+              (model:create-issue :subject subject
+                                  :body body
+                                  :author-dn (dn *user*))))
+        (send-irc-notification (format nil "b/~A: \"~A\" opened by ~A - https://b.tvl.fyi/issues/~A"
+                                       (issue-id issue) subject (dn *user*)
+                                       (issue-id issue))
+                               :channel (uiop:getenvp "ISSUECHANNEL"))
         (hunchentoot:redirect "/"))))
 
 (defroute show-issue
-- 
cgit 1.4.1