feat(panettone): Bring back + fix irccat issue creation announcement

This reverts commit e1067b1497.

The original issue here was misusing ISSUE-ID instead of ID, but also
the associated username for the message should've been CN instead of DN

Change-Id: I1629c0cb7597ff2ee2867f27870378eecdafe126
Reviewed-on: https://cl.tvl.fyi/c/depot/+/2125
Tested-by: BuildkiteCI
Reviewed-by: eta <eta@theta.eu.org>

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
   ];
 

web/panettone/src/irc.lisp

@@ -0,0 +1,26 @@
+;;;; 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"
+  (destructuring-bind (host port)
+      (mapcar #'uiop:getenvp '("IRCCATHOST" "IRCCATPORT"))
+    (if (and host port)
+        (values host (parse-integer port))
+        (values "localhost" 4722))))
+
+(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).
+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)))))))

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))

web/panettone/src/panettone.lisp

@@ -450,10 +450,15 @@
       (render/issue-form
        (make-instance 'model:issue :subject subject :body body)
        "Subject is required")
-      (progn
+      (let ((issue
               (model:create-issue :subject subject
                                   :body body
-                            :author-dn (dn *user*))
+                                  :author-dn (dn *user*))))
+        (send-irc-notification (format nil "b/~A: \"~A\" opened by ~A - https://b.tvl.fyi/issues/~A"
+                                       (id issue) subject (cn *user*)
+                                       (id issue))
+                               :channel (or (uiop:getenvp "ISSUECHANNEL")
+                                            "##tvl-dev"))
         (hunchentoot:redirect "/"))))
 
 (defroute show-issue
@@ -571,8 +576,8 @@
 
 (comment
  (setq hunchentoot:*catch-errors-p* nil)
- ;; to setup an ssh tunnel to ldap+cheddar for development:
- ;; ssh -NL 3899:localhost:389 -L 4238:localhost:4238 whitby.tvl.fyi
+ ;; to setup an ssh tunnel to ldap+cheddar+irccat for development:
+ ;; ssh -NL 3899:localhost:389 -L 4238:localhost:4238 -L 4722:localhost:4722 whitby.tvl.fyi
  (start-panettone :port 6161
                   :ldap-port 3899
                   :session-secret "session-secret")