Browse Source

Add the ability to change modes (on a basic level)

- Does what it says on the tin; you can add/remove +o or +v
  access from people now!
  - It's not a perfect 1:1 mapping, but it works...
eta 2 years ago
  1. 32
  2. 2
  3. 39


@ -3,6 +3,7 @@
(define-symbol-macro systype-join 1)
(define-symbol-macro systype-part 2)
(define-symbol-macro systype-topic 3)
(define-symbol-macro systype-mode 4)
;; CLOS doesn't let us subclass things that have POMO:DAO-CLASS as their
;; metaclass -- presumably because that doesn't make much sense, as such
@ -15,6 +16,7 @@
(defclass db-join-message (db-system-message) ())
(defclass db-part-message (db-system-message) ())
(defclass db-topic-message (db-system-message) ())
(defclass db-mode-message (db-system-message) ())
(defgeneric db-message-command (msg)
(:documentation "Gets the IRC message command (a string) for the given MSG object (which is either a MESSAGE or a SYSTEM-MESSAGE)."))
@ -58,6 +60,9 @@
(defmethod db-message-source ((m db-topic-message))
(get-user-source (dbm-user-ref m)))
(defmethod db-message-source ((m db-mode-message))
(get-user-source (dbm-user-ref m)))
(defmethod db-message-command ((m db-join-message))
(declare (ignore m)) "JOIN")
@ -67,6 +72,9 @@
(defmethod db-message-command ((m db-topic-message))
(declare (ignore m)) "TOPIC")
(defmethod db-message-command ((m db-mode-message))
(declare (ignore m)) "MODE")
(defmethod db-message-command ((m db-message))
(if (dbm-body m)
(if (dbm-is-notice m) "NOTICE" "PRIVMSG")
@ -105,6 +113,13 @@
(assert gcname () "DB-TOPIC-MESSAGE has a groupchat with no directory entry")
`(,gcname ,body)))
(defmethod db-message-parameters ((m db-mode-message) client)
(let ((gcname (get-groupchat-name (dbm-groupchat-ref m)))
(target-nick (message-source-nick (get-user-source (dbm-target-user-ref m))))
(body (dbm-body m)))
(assert gcname () "DB-MODE-MESSAGE has a groupchat with no directory entry")
`(,gcname ,body ,target-nick)))
(defmethod db-message-tags ((message db-message) client)
(let ((tags (when (client-supports-capability-p client :message-tags)
(irc:parse-tags nil (dbm-tags message))))
@ -138,6 +153,11 @@
"Invalid SYSTYPE-TOPIC system message")
(change-class syst 'db-topic-message)
((eql type systype-mode)
(assert (and (dbm-user-ref syst) (dbm-groupchat-ref syst) (dbm-body syst) (dbm-target-user-ref syst)) ()
"Invalid SYSTYPE-TOPIC system message")
(change-class syst 'db-mode-message)
(t (error "Invalid system message type ~A" type)))))
(defun insert-db-join-message (uid gcid)
@ -151,6 +171,18 @@ Returns the inserted message object."
:groupchat-ref (format nil "~A" gcid))))
(pomo:insert-dao message)))
(defun insert-db-mode-message (uid gcid mode-changes target-uid)
"Insert a MODE message into the database, describing how the user with ID UID has executed MODE-CHANGES on the user with ID TARGET-UID.
Returns the inserted message object."
(let ((message (make-instance 'db-system-message
:msgid (format nil "~A" (uuid:make-v4-uuid))
:type systype-mode
:body mode-changes
:user-ref uid
:target-user-ref target-uid
:groupchat-ref (format nil "~A" gcid))))
(pomo:insert-dao message)))
(defun insert-db-part-message (uid gcid body)
"Insert a PART message into the database, describing how the user with ID UID has just left the groupchat with ID GCID.
Returns the inserted message object."


@ -25,6 +25,8 @@
(err-cannotsendtochan "404")
(rpl-channelmodeis "324")
(err-chanoprivsneeded "482" "You don't have sufficient permissions to do that.")
(err-usernotinchannel "441" "They aren't in that channel")
(err-unknownmode "472" "is unknown mode char to me")
(err-notonchannel "442" "You're not in that channel")
(err-nicklocked "902")
(rpl-saslsuccess "903")


@ -278,6 +278,45 @@ Stolen from"
(find-numeric 'rpl-channelmodeis)
:params `(,(first params) "+nt")))))))
(defun decode-mode-op (op)
"Decodes a mode operation (e.g. +o/+v) for a user to a symbol representing a role. Returns this symbol, and another value indicating whether this mode is to be added (T) or not (NIL).
If the operation is unrecognized (or too complex for this basic implementation), throws a user error."
(unless (and (eql (length op) 2)
(find (elt op 0) '(#\+ #\-))
(find (elt op 1) '(#\o #\v)))
(raise-user-error 'err-unknownmode op))
(ecase (elt op 1)
(#\o :operator)
(#\v :voiced-user))
(equal (elt op 0) #\+)))
(defmethod handle-irc-message ((c registered-irc-client) (msg msg-mode-set))
(with-accessors ((params message-parameters)) msg
(with-accessors ((uid client-userid)) c
;; This just supports commands of the form
;; MODE #channel +o/-o/+v/-v USER
;; for now.
(unless (eql (length params) 3)
(raise-user-error 'err-needmoreparams))
(pomo:with-logical-transaction ()
(multiple-value-bind (role added-p)
(decode-mode-op (second params))
(let ((gcid (get-groupchat-target (first params)))
(target (query-user-target (third params)))
;; It's hard to map the semantics of -o/-v exactly.
;; Here, we just interpret removing a role as setting
;; your role back to :USER.
(new-role (if added-p role :user)))
(unless target
(raise-user-error 'err-nosuchnick))
(check-groupchat-member gcid uid)
(unless (groupchat-member-p gcid target)
(raise-user-error 'err-usernotinchannel))
(update-groupchat-membership gcid target new-role)
(insert-db-mode-message uid gcid (second params) target)
(defmethod handle-irc-message ((c registered-irc-client) (msg msg-topic-query))
(with-accessors ((params message-parameters)) msg
(with-accessors ((uid client-userid)) c