lisp/erc/erc-capab.el

   1 ;;; erc-capab.el --- support for dancer-ircd and hyperion's CAPAB
   2
   3 ;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: emacs-devel@gnu.org
   6
   7 ; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; This file defines the ERC module `erc-capab-identify', which allows
  25 ;; flagging of unidentified users on servers running dancer-ircd or
  26 ;; hyperion.  freenode.net supports this capability, for example.
  27
  28 ;; With CAPAB IDENTIFY-MSG and IDENTIFY-CTCP enabled, messages from
  29 ;; users who have identified themselves to NickServ will have a plus
  30 ;; sign and messages from unidentified users will have a minus sign
  31 ;; added as a prefix.  Note that it is not necessary for your nickname
  32 ;; to be identified in order to receive these marked messages.
  33
  34 ;; The plus or minus sign is removed from the message, and a prefix,
  35 ;; `erc-capab-identify-prefix', is inserted in the front of the user's
  36 ;; nickname if the nickname is not identified.
  37
  38 ;; Please note that once this has been enabled on a server, there is no
  39 ;; way to tell the server to stop sending marked messages.  If you
  40 ;; disable this module, it will continue removing message flags, but the
  41 ;; unidentified nickname prefix will not be added to messages.
  42
  43 ;; Visit <http://freenode.net/faq.shtml#spoofing> and
  44 ;; <http://freenode.net/faq.shtml#registering> to find further
  45 ;; explanations of this capability.
  46
  47 ;; From freenode.net's web site (not there anymore) on how to mark
  48 ;; unidentified users:
  49 ;; "We recommend that you add an asterisk before the nick, and
  50 ;;  optionally either highlight or colorize the line in some
  51 ;;  appropriate fashion, if the user is not identified."
  52
  53 ;;; Usage:
  54
  55 ;; Put the following in your init file.
  56
  57 ;; (require 'erc-capab)
  58 ;; (erc-capab-identify-mode 1)
  59
  60 ;; `erc-capab-identify-prefix' will now be added to the beginning of
  61 ;; unidentified users' nicknames.  The default is an asterisk, "*".
  62 ;; You can customize the prefix and the face used to display it,
  63 ;; `erc-capab-identify-unidentified'.  If the value of
  64 ;; `erc-capab-identify-prefix' is nil or you disable this module (see
  65 ;; `erc-capab-identify-disable'), no prefix will be inserted, but the
  66 ;; flag sent by the server will still be stripped.
  67
  68 ;;; Code:
  69
  70 (require 'erc)
  71
  72 ;;; Customization:
  73
  74 (defgroup erc-capab nil
  75   "Support for dancer-ircd's CAPAB settings."
  76   :group 'erc)
  77
  78 (defcustom erc-capab-identify-prefix "*"
  79   "The prefix used for unidentified users.
  80
  81 If you change this from the default \"*\", be sure to use a
  82 character not found in IRC nicknames to avoid confusion."
  83   :group 'erc-capab
  84   :type '(choice string (const nil)))
  85
  86 (defface erc-capab-identify-unidentified '((t)) ; same as `erc-default-face'
  87   "Face to use for `erc-capab-identify-prefix'."
  88   :group 'erc-capab
  89   :group 'erc-faces)
  90
  91 ;;; Define module:
  92
  93 ;;;###autoload (autoload 'erc-capab-identify-mode "erc-capab" nil t)
  94 (define-erc-module capab-identify nil
  95   "Handle dancer-ircd's CAPAB IDENTIFY-MSG and IDENTIFY-CTCP."
  96   ;; append so that `erc-server-parameters' is already set by `erc-server-005'
  97   ((add-hook 'erc-server-005-functions 'erc-capab-identify-setup t)
  98    (add-hook 'erc-server-290-functions 'erc-capab-identify-activate)
  99    (add-hook 'erc-server-PRIVMSG-functions
 100              'erc-capab-identify-remove/set-identified-flag)
 101    (add-hook 'erc-server-NOTICE-functions
 102              'erc-capab-identify-remove/set-identified-flag)
 103    (add-hook 'erc-insert-modify-hook 'erc-capab-identify-add-prefix t)
 104    (mapc (lambda (buffer)
 105            (when buffer
 106              (with-current-buffer buffer (erc-capab-identify-setup))))
 107          (erc-buffer-list 'erc-open-server-buffer-p)))
 108   ((remove-hook 'erc-server-005-functions 'erc-capab-identify-setup)
 109    (remove-hook 'erc-server-290-functions 'erc-capab-identify-activate)
 110    ;; we don't remove the `erc-capab-identify-remove/set-identified-flag' hooks
 111    ;; because there doesn't seem to be a way to tell the server to turn it off
 112    (remove-hook 'erc-insert-modify-hook 'erc-capab-identify-add-prefix)))
 113
 114 ;;; Variables:
 115
 116 (defvar erc-capab-identify-activated nil
 117   "CAPAB IDENTIFY-MSG has been activated.")
 118 (make-variable-buffer-local 'erc-capab-identify-activated)
 119
 120 (defvar erc-capab-identify-sent nil
 121   "CAPAB IDENTIFY-MSG and IDENTIFY-CTCP messages have been sent.")
 122 (make-variable-buffer-local 'erc-capab-identify-sent)
 123
 124 ;;; Functions:
 125
 126 (defun erc-capab-identify-setup (&optional proc parsed)
 127   "Set up CAPAB IDENTIFY on the current server.
 128
 129 Optional argument PROC is the current server's process.
 130 Optional argument PARSED is the current message, a response struct.
 131
 132 These arguments are sent to this function when called as a hook in
 133 `erc-server-005-functions'."
 134   (unless erc-capab-identify-sent
 135     (erc-capab-identify-send-messages)))
 136
 137 (defun erc-capab-identify-send-messages ()
 138   "Send CAPAB IDENTIFY messages if the server supports it."
 139   (when (and (stringp erc-server-version)
 140              (string-match "^\\(dancer-ircd\\|hyperion\\)" erc-server-version)
 141              ;; could possibly check for '("IRCD" . "dancer") in
 142              ;; `erc-server-parameters' instead of looking for a specific name
 143              ;; in `erc-server-version'
 144              (assoc "CAPAB" erc-server-parameters))
 145     (erc-log "Sending CAPAB IDENTIFY-MSG and IDENTIFY-CTCP")
 146     (erc-server-send "CAPAB IDENTIFY-MSG")
 147     (erc-server-send "CAPAB IDENTIFY-CTCP")
 148     (setq erc-capab-identify-sent t)))
 149
 150
 151 (defun erc-capab-identify-activate (proc parsed)
 152   "Set `erc-capab-identify-activated' and display an activation message.
 153
 154 PROC is the current server's process.
 155 PARSED is an `erc-parsed' response struct."
 156   (when (or (string= "IDENTIFY-MSG" (erc-response.contents parsed))
 157             (string= "IDENTIFY-CTCP" (erc-response.contents parsed)))
 158     (setq erc-capab-identify-activated t)
 159     (erc-display-message
 160      parsed 'notice 'active (format "%s activated"
 161                                     (erc-response.contents parsed)))))
 162
 163 (defun erc-capab-identify-remove/set-identified-flag (proc parsed)
 164   "Remove PARSED message's id flag and add the `erc-identified' text property.
 165
 166 PROC is the current server's process.
 167 PARSED is an `erc-parsed' response struct."
 168   (let ((msg (erc-response.contents parsed)))
 169     (when (and erc-capab-identify-activated
 170                (string-match "^\\([-\\+]\\)\\(.+\\)$" msg))
 171       (setf (erc-response.contents parsed)
 172             (if erc-capab-identify-mode
 173                 (erc-propertize (match-string 2 msg)
 174                                 'erc-identified
 175                                 (if (string= (match-string 1 msg) "+")
 176                                     1
 177                                   0))
 178               (match-string 2 msg)))
 179       nil)))
 180
 181 (defun erc-capab-identify-add-prefix ()
 182   "Add `erc-capab-identify-prefix' to nickname if user is unidentified."
 183   (when (and erc-capab-identify-prefix
 184              (erc-with-server-buffer erc-capab-identify-activated))
 185     (goto-char (or (erc-find-parsed-property) (point-min)))
 186     (let ((nickname (erc-capab-identify-get-unidentified-nickname
 187                      (erc-get-parsed-vector (point)))))
 188       (when (and nickname
 189                  (goto-char (point-min))
 190                  ;; assuming the first use of `nickname' is the sender's nick
 191                  (re-search-forward (regexp-quote nickname) nil t))
 192         (goto-char (match-beginning 0))
 193         (insert (erc-propertize erc-capab-identify-prefix
 194                                 'face 'erc-capab-identify-unidentified))))))
 195
 196 (defun erc-capab-identify-get-unidentified-nickname (parsed)
 197   "Return the nickname of the user if unidentified.
 198 PARSED is an `erc-parsed' response struct."
 199   (when (and (erc-response-p parsed)
 200              (equal 0 (get-text-property 0 'erc-identified
 201                                      (erc-response.contents parsed))))
 202     (let ((nickuserhost (erc-get-parsed-vector-nick parsed)))
 203       (when nickuserhost
 204        (nth 0 (erc-parse-user nickuserhost))))))
 205
 206 (provide 'erc-capab)
 207
 208 ;;; erc-capab.el ends here