diff --git a/web/panettone/default.nix b/web/panettone/default.nix index 3ff8ca55e..8d112901e 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 000000000..c94b0d2f4 --- /dev/null +++ b/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))))))) diff --git a/web/panettone/src/packages.lisp b/web/panettone/src/packages.lisp index 1a8453055..87285fa34 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 cef357221..49492363f 100644 --- a/web/panettone/src/panettone.lisp +++ b/web/panettone/src/panettone.lisp @@ -450,10 +450,15 @@ (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" + (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")