;;; erc-sasl.el --- SASL for ERC -*- lexical-binding: t -*-

;; Copyright (C) 2022 Free Software Foundation, Inc.
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; WARNING: this is a naive/hack (non-IRCv3) implementation of SASL.
;; Please see bug#49860, which adds full 3.2 capability negotiation.

;; Various ERC implementations of the PLAIN mechanism have surfaced
;; over the years, the first possibly being:
;;
;; https://lists.gnu.org/archive/html/erc-discuss/2012-02/msg00001.html
;;
;; This module would not exist without this and other pioneering
;; efforts.
;;
;; FIXME move the following to doc/misc/erc.texi
;;
;; Regardless of the mechanism or server, you'll likely have to be
;; registered before first use.  Refer to the network's own
;; instructions for details.  If you're new to IRC and using a
;; bouncer, know that you almost certainly won't be needing SASL for
;; the client -> bouncer connection.
;;
;; Note that `sasl' is a "local" ERC module (effectively introduced in
;; ERC 5.5).  This means invoking `erc-sasl-mode' manually or calling
;; `erc-update-modules' won't do any good.  Instead, simply add `sasl'
;; to `erc-modules' or `let'-bind it while calling `erc-tls', and SASL
;; will be enabled for the current connection.  But before that,
;; please explore all custom options that pertain to your chosen
;; mechanism.
;;
;; Password-based mechanisms:
;;
;;   Here, "password" refers to your account password, which is
;;   usually your NickServ password.  This often differs from any
;;   connection (server) password given to `erc-tls' via its :password
;;   arg.  To make this work, customize both `erc-sasl-user' and
;;   `erc-sasl-password' or bind them when invoking `erc-tls'.
;;
;;   When `erc-sasl-password' is a string, it's used unconditionally.
;;   When it's a non-nil symbol, like Libera.Chat, it's used as the
;;   host param in an auth-source query.  When it's nil and a session
;;   ID is on file (see `erc-tls'), the ID is instead used for the
;;   host param.  The value of `erc-sasl-user' is always specified for
;;   the user (login) param.  See the info node "(erc) Connecting" for
;;   specifics.
;;
;;   If no password can be determined, a non-nil connection password
;;   will be tried (but this may change, so please don't rely on it).
;;
;; EXTERNAL (with Client TLS Certificate):
;;
;;   1. Specify the `:client-certificate' param when opening a new
;;      connection, which is typically done by calling `emacs-tls'.
;;      See (info "(erc) Connecting").
;;
;;   2. Ensure you've registered your fingerprint with the network and
;;      (re)connect.  The fingerprint is usually a SHA1 or SHA256
;;      digest in either "normalized" or "openssl" forms.  The first
;;      is lowercase without delims ("deadbeef") and the second
;;      uppercase with colon seps ("DE:AD:BE:EF").
;;
;;   There's no reason to send your password after registering.  Note
;;   that most ircds will allow you to authenticate with a client cert
;;   but without the hassle of SASL (meaning you may not need this
;;   module).
;;
;; ECDSA-NIST256P-CHALLENGE:
;;
;;   Use something else if at all possible.  This currently requires
;;   the openssl command-line utility.  On servers running Atheme
;;   services, add your public key with NickServ like so:
;;
;;   /msg NickServ set property
;;     pubkey AgGZmlYTUjJlea/BVz7yrjJ6gysiAPaQxzeUzTH4hd5j
;;
;;   (You may not need the "property" subcommand.)
;;
;;
;; TODO
;;
;; - Implement pseudo PASSWORD mechanism that chooses the strongest
;;   available mechanism for you.
;;
;; - Maybe provide explicit authz.  Currently, there's only an obscure
;;   customizable function option for SCRAM and nothing for plain.

;;; Code:
(require 'erc-backend)
(require 'rx)
(require 'sasl)
(require 'sasl-scram-rfc)
(require 'sasl-scram-sha256 nil t)

(defgroup erc-sasl nil
  "SASL for ERC."
  :group 'erc
  :package-version '(ERC . "5.4")) ; FIXME increment on next release

(defcustom erc-sasl-mechanism nil
  "SASL mechanism to connect with.
Note that any value other than nil or `external' likely requires
`erc-sasl-user' and `erc-sasl-password'."
  :type '(choice (const nil)
                 (const plain)
                 (const external)
                 (const scram-sha-1)
                 (const scram-sha-256)
                 (const scram-sha-512)
                 (const ecdsa-nist256p-challenge)))

(defcustom erc-sasl-user nil
  "Optional account username to send when authenticating.
This is also referred to as the authentication identity, or
\"authcid\".  When nil, applicable mechanisms will use the
session's current nick."
  :type '(choice string (const nil)))

(defcustom erc-sasl-password nil
  "Optional account password to send when authenticating.
When the value is a string, it's used unconditionally.  As a
special case, when the value is a non-nil symbol, it's used as
the value of the `:host' field in an auth-source query, provided
`erc-sasl-auth-source-function' is set to a function.  When
nil, a non-nil \"session password\" will be tried, likely one
given as the `:password' argument to `erc-tls'.  As a last
resort, the user will be prompted for input."
  :type '(choice (const nil) string symbol))

(defcustom erc-sasl-auth-source-function nil
  "Function to query auth-source for an SASL password.
Called with keyword params known to `auth-source-search', which
may include a non-nil `erc-sasl-user' for the `:user' field
and a non-nil `erc-sasl-password' for the `:host' field, when
the latter option is a symbol instead of a string.  In return,
ERC expects a string to send as the SASL password, or nil, to
move on to the next approach, as described in the doc string for
the option `erc-sasl-password'.  See info node `(erc)
Connecting' for details on ERC's auth-source integration."
  :type '(choice (const erc-auth-source-search)
                 (const nil)
                 function))

(defcustom erc-sasl-ecdsa-private-key nil
  "Private signing key file for ECDSA-NIST256P-CHALLENGE."
  :type '(choice (const nil) string))

(defcustom erc-sasl-authzid nil
  "SASL authorization identity.
Generally unneeded for normal use.  Some test frameworks and
aberrant servers may want this to match `erc-sasl-user'."
  :type '(choice (const nil) string))


;; Analogous to what erc-backend does to persist opening params.
(defvar-local erc-sasl--options nil)

;; Session-local (server buffer) SASL subproto state
(defvar-local erc-sasl--state nil)

(cl-defstruct erc-sasl--state
  "Holder for client object and subproto state."
  (client nil :type vector)
  (step nil :type vector)
  (pending nil :type string))

(defun erc-sasl--read-password (prompt)
  "Return configured option or server password.
PROMPT is passed to `read-passwd' if necessary."
  ;; Copying prevent `sasl-plain-response' from clobbering
  (if-let
      ((found
        (or (and-let* ((pass (alist-get 'password erc-sasl--options))
                       ((stringp pass))
                       (pass)))
            (and erc-sasl-auth-source-function
                 (let ((user (alist-get 'user erc-sasl--options))
                       (host (alist-get 'password erc-sasl--options)))
                   (apply erc-sasl-auth-source-function
                          `(,@(and user (list :user user))
                            ,@(and host (list :host (symbol-name host)))))))
            erc-session-password)))
      (copy-sequence found)
    (read-passwd prompt)))

(defun erc-sasl--plain-response (client steps)
  "Call `sasl-plain-response' with CLIENT and STEPS."
  (let ((sasl-read-passphrase #'erc-sasl--read-password))
    (sasl-plain-response client steps)))

(declare-function erc-compat--sasl-scram--client-final-message "erc-compat"
                  (hash-fun block-length hash-length client step))

(defun erc-sasl--scram-sha-hack-client-final-message (&rest args)
  "Call `sasl-scram--client-final-message' with args.
Pass HASH-FUN, BLOCK-LENGTH, HASH-LENGTH, CLIENT, and STEP
directly upstream."
  ;; In the future (29+), we'll hopefully be able to call
  ;; `sasl-scram--client-final-message' directly
  (require 'erc-compat)
  (let ((sasl-read-passphrase #'erc-sasl--read-password))
    (apply #'erc-compat--sasl-scram--client-final-message args)))

(defun erc-sasl--scram-sha-1-client-final-message (client step)
  "Prepare CLIENT's final message with STEP."
  (erc-sasl--scram-sha-hack-client-final-message 'sha1 64 20 client step))

(defun erc-sasl--scram-sha-256-client-final-message (client step)
  "Prepare CLIENT's final message with STEP."
  (erc-sasl--scram-sha-hack-client-final-message 'sasl-scram-sha256 64 32
                                                    client step))

(defun erc-sasl--scram-sha512 (object &optional start end binary)
  "Pass OBJECT, START, END, and BINARY to `secure-hash'."
  (secure-hash 'sha512 object start end binary))

(defun erc-sasl--scram-sha-512-client-final-message (client step)
  "Prepare CLIENT's final message with STEP."
  (erc-sasl--scram-sha-hack-client-final-message
   #'erc-sasl--scram-sha512 128 64 client step))

(defun erc-sasl--scram-sha-512-authenticate-server (client step)
  "Call `sasl-scram--authenticate-server' with CLIENT and STEP."
  (sasl-scram--authenticate-server
   #'erc-sasl--scram-sha512 128 64 client step))

(defun erc-sasl--ecdsa-first (client _step)
  "Return CLIENT name."
  (sasl-client-name client))

;; FIXME do this with gnutls somehow
(defun erc-sasl--ecdsa-sign (_client step)
  "Return signed challenge for CLIENT and STEP."
  (let ((challenge (sasl-step-data step)))
    (with-temp-buffer
      (set-buffer-multibyte nil)
      (insert challenge)
      (call-process-region (point-min) (point-max)
                           "openssl" 'delete t nil "pkeyutl" "-inkey"
                           (alist-get 'ecdsa-private-key erc-sasl--options)
                           "-sign")
      (buffer-string))))

;; This API may seem roundabout, but the "template method" here is
;; one that we provide, namely `erc-sasl--authenticate-handler'.

(pcase-dolist
    (`(,name . ,steps)
     '(("PLAIN"
        erc-sasl--plain-response)
       ("EXTERNAL"
        ignore)
       ("SCRAM-SHA-1"
        erc-compat--sasl-scram-client-first-message
        erc-sasl--scram-sha-1-client-final-message
        sasl-scram-sha-1-authenticate-server)
       ("SCRAM-SHA-256"
        erc-compat--sasl-scram-client-first-message
        erc-sasl--scram-sha-256-client-final-message
        sasl-scram-sha-256-authenticate-server)
       ("SCRAM-SHA-512"
        erc-compat--sasl-scram-client-first-message
        erc-sasl--scram-sha-512-client-final-message
        erc-sasl--scram-sha-512-authenticate-server)
       ("ECDSA-NIST256P-CHALLENGE"
        erc-sasl--ecdsa-first
        erc-sasl--ecdsa-sign)))
  (let ((feature (intern (concat "erc-sasl-" (downcase name)))))
    (put feature 'sasl-mechanism (sasl-make-mechanism name steps))
    (provide feature)))

(cl-defgeneric erc-sasl--create-client (mechanism)
  "Create and return a new SASL client object for MECHANISM."
  (let ((sasl-mechanism-alist (copy-sequence sasl-mechanism-alist))
        (sasl-mechanisms sasl-mechanisms)
        (name (upcase (symbol-name mechanism)))
        (feature (intern (concat "erc-sasl-" (symbol-name mechanism))))
        client)
    (setf (alist-get name sasl-mechanism-alist nil nil #'equal) `(,feature))
    (cl-pushnew name sasl-mechanisms :test #'equal)
    (setq client (sasl-make-client (sasl-find-mechanism `(,name))
                                   (or (alist-get 'user erc-sasl--options)
                                       (erc-downcase (erc-current-nick)))
                                   "N/A" "N/A"))
    (sasl-client-set-property client 'authenticator-name
                              (alist-get 'authzid erc-sasl--options))
    client))

;; Oragono doesn't like when authzid (if present) does not match
;; the authcid.  TODO see if this still true.

(cl-defmethod erc-sasl--create-client ((_m (eql plain)))
  "Create and return new SASL PLAIN client object.
See message breakdown at
https://tools.ietf.org/html/rfc4616#section-2."
  (let* ((sans (remq (assoc "PLAIN" sasl-mechanism-alist)
                     sasl-mechanism-alist))
         (sasl-mechanism-alist (cons '("PLAIN" erc-sasl-plain) sans))
         (authc (or (alist-get 'user erc-sasl--options)
                    (erc-downcase (erc-current-nick))))
         (port (if (numberp erc-session-port)
                   (number-to-string erc-session-port)
                 "0"))
         ;; In most cases, `erc-server-announced-name' won't be known.
         (host (or erc-server-announced-name erc-session-server))
         (mech (sasl-find-mechanism '("PLAIN")))
         (client (sasl-make-client mech authc port host)))
    (sasl-client-set-property client 'authenticator-name
                              (alist-get 'authzid erc-sasl--options))
    client))

(cl-defmethod erc-sasl--create-client ((m (eql scram-sha-256)))
  "Create a SCRAM-SHA-256 client."
  (unless (featurep 'sasl-scram-sha256)
    (user-error "SASL mechanism %s unsupported" m))
  (cl-call-next-method))

(cl-defmethod erc-sasl--create-client ((m (eql scram-sha-512)))
  "Create a SCRAM-SHA-512 client."
  (unless (featurep 'sasl-scram-sha256)
    (user-error "SASL mechanism %s unsupported" m))
  (cl-call-next-method))

(cl-defmethod erc-sasl--create-client ((_ (eql ecdsa-nist256p-challenge)))
  "Create a ECDSA-NIST256P-CHALLENGE client."
  (unless (executable-find "openssl")
    (user-error "Could not find openssl command-line utility"))
  (unless (and (alist-get 'ecdsa-private-key erc-sasl--options)
               (file-exists-p (alist-get 'ecdsa-private-key
                                         erc-sasl--options)))
    (user-error "Could not find `erc-sasl-ecdsa-private-key'"))
  (cl-call-next-method))

(defun erc-sasl--init ()
  (setq erc-sasl--state (make-erc-sasl--state)
        erc-sasl--options `((user . ,erc-sasl-user)
                            (password . ,erc-sasl-password)
                            (mechanism . ,erc-sasl-mechanism)
                            (ecdsa-private-key . ,erc-sasl-ecdsa-private-key)
                            (authzid . ,erc-sasl-authzid))))

(defun erc-sasl--mechanism-offered-p (offered)
  "Non-nil when mechanism OFFERED by server."
  (string-match-p (rx-to-string
                   `(: (| bot ",")
                       ,(symbol-name
                         (alist-get 'mechanism erc-sasl--options))
                       (| eot ",")))
                  (downcase offered)))

(defun erc-sasl--add-hook ()
  (add-hook 'erc-server-AUTHENTICATE-functions
            #'erc-sasl--authenticate-handler 0 t))

(defun erc-sasl--remove-hook ()
  (remove-hook 'erc-server-AUTHENTICATE-functions
               #'erc-sasl--authenticate-handler t))

(defun erc-sasl--authenticate-handler (_proc parsed)
  "Handle PARSED `erc-response' from server.
Maybe transition to next state."
  (if-let* ((response (car (erc-response.command-args parsed)))
            ((= 400 (length response))))
      (cl-callf (lambda (s) (concat s response))
          (erc-sasl--state-pending erc-sasl--state))
    (cl-assert response t)
    (when (string= "+" response)
      (setq response ""))
    (setf response (base64-decode-string
                    (concat (erc-sasl--state-pending erc-sasl--state) response))
          (erc-sasl--state-pending erc-sasl--state) nil)
    ;; The server is done sending, so our turn
    (let ((client (erc-sasl--state-client erc-sasl--state))
          (step (erc-sasl--state-step erc-sasl--state))
          data)
      (when step
        (sasl-step-set-data step response))
      (setq step (setf (erc-sasl--state-step erc-sasl--state)
                       (sasl-next-step client step))
            data (sasl-step-data step))
      (when (string= data "")
        (setq data nil))
      (when data
        (setq data (base64-encode-string data t)))
      ;; No need for : because no spaces (right?)
      (erc-server-send (concat "AUTHENTICATE " (or data "+"))))))

(erc-define-catalog
 'english
 '((s902 . "ERR_NICKLOCKED nick %n unavailable: %s")
   (s904 . "ERR_SASLFAIL (authentication failed) %s")
   (s905 . "ERR SASLTOOLONG (credentials too long) %s")
   (s906 . "ERR_SASLABORTED (authentication aborted) %s")
   (s907 . "ERR_SASLALREADY (already authenticated) %s")
   (s908 . "RPL_SASLMECHS (unsupported mechanism %m) %s")))

(define-erc-module sasl nil
  "Non-IRCv3 (dumb) SASL support for ERC.
Needless to say, this doesn't solicit or validate a suite of
supported mechanisms.  See bug#49860 for a full, CAP 3.2-aware
implementation, currently a WIP as of ERC 5.5."
  ((unless erc--target
     (erc-sasl--add-hook)
     (erc-sasl--init)
     (let* ((mech (alist-get 'mechanism erc-sasl--options))
            (client (erc-sasl--create-client mech)))
       (unless client
         (erc-display-error-notice nil (format "Unknown mechanism: %s" mech))
         (erc-error "Unknown mechanism: %s" mech))
       (setf (erc-sasl--state-client erc-sasl--state) client))))
  ((erc-sasl--remove-hook)
   (kill-local-variable 'erc-sasl--options))
  'local)

;; FIXME use generic mechanism instead of hooks after bug#49860.
(define-erc-response-handler (AUTHENTICATE)
  "Maybe authenticate to server." nil)

;; FIXME do something decisive here
(define-erc-response-handler (902)
  "Handle a ERR_NICKLOCKED response." nil
  (let ((nick (car (erc-response.command-args parsed)))
        (msg (erc-response.contents parsed)))
    (erc-display-message parsed '(notice error) 'active 's902 ?n nick ?s msg)))

(define-erc-response-handler (903)
  "Handle a RPL_SASLSUCCESS response." nil
  (when erc-sasl-mode
    (unless erc-server-connected
      (erc-server-send "CAP END")))
  (erc-handle-unknown-server-response proc parsed))

(define-erc-response-handler (904 905 906 907 908)
  "Handle various SASL-related error responses." nil
  (let* ((msg (intern (format "s%s" (erc-response.command parsed))))
         (args `(parsed (notice error) active ,msg
                        ,@(when (string= "908" (erc-response.command parsed))
                            (list '?m
                                  (alist-get 'mechanism erc-sasl--options)))
                        ?s ,(erc-response.contents parsed))))
    (apply #'erc-display-message args))
  (when (member (erc-response.command parsed) '("904" "905" "906"))
    (run-hook-with-args 'erc-quit-hook proc)
    (delete-process proc)
    (erc-error "Disconnected from %s; please review SASL settings" proc)))

(cl-defmethod erc--register-connection (&context (erc-sasl-mode (eql t)))
  "Send speculative/pipelined CAP and AUTHENTICATE and hope for the best."
  (erc-server-send "CAP REQ :sasl")
  (erc-login)
  (let* ((c (erc-sasl--state-client erc-sasl--state))
         (m (sasl-mechanism-name (sasl-client-mechanism c))))
    (erc-server-send (format "AUTHENTICATE %s" m))))

(provide 'erc-sasl)
;;; erc-sasl.el ends here
;;
;; Local Variables:
;; generated-autoload-file: "erc-loaddefs.el"
;; End: