lisp/auth-source-pass.el

   1 ;;; auth-source-pass.el --- Integrate auth-source with password-store -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2015, 2017-2018 Free Software Foundation, Inc.
   4
   5 ;; Author: Damien Cassou <damien@cassou.me>,
   6 ;;         Nicolas Petton <nicolas@petton.fr>
   7 ;; Version: 4.0.1
   8 ;; Package-Requires: ((emacs "25"))
   9 ;; Url: https://github.com/DamienCassou/auth-password-store
  10 ;; Created: 07 Jun 2015
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  26
  27 ;;; Commentary:
  28
  29 ;; Integrates password-store (http://passwordstore.org/) within
  30 ;; auth-source.
  31
  32 ;;; Code:
  33
  34 (require 'seq)
  35 (eval-when-compile (require 'subr-x))
  36 (eval-when-compile
  37   (require 'cl-lib))
  38 (require 'auth-source)
  39 (require 'url-parse)
  40
  41 (cl-defun auth-source-pass-search (&rest spec
  42                                          &key backend type host user port
  43                                          &allow-other-keys)
  44   "Given a property list SPEC, return search matches from the :backend.
  45 See `auth-source-search' for details on SPEC."
  46   (cl-assert (or (null type) (eq type (oref backend type)))
  47              t "Invalid password-store search: %s %s")
  48   (when (consp host)
  49     (warn "auth-source-pass ignores all but first host in spec.")
  50     ;; Take the first non-nil item of the list of hosts
  51     (setq host (seq-find #'identity host)))
  52   (cond ((eq host t)
  53          (warn "auth-source-pass does not handle host wildcards.")
  54          nil)
  55         ((null host)
  56          ;; Do not build a result, as none will match when HOST is nil
  57          nil)
  58         (t
  59          (list (auth-source-pass--build-result host port user)))))
  60
  61 (defun auth-source-pass--build-result (host port user)
  62   "Build auth-source-pass entry matching HOST, PORT and USER."
  63   (let ((entry (auth-source-pass--find-match host user port)))
  64     (when entry
  65       (let ((retval (list
  66                      :host host
  67                      :port (or (auth-source-pass-get "port" entry) port)
  68                      :user (or (auth-source-pass-get "user" entry) user)
  69                      :secret (lambda () (auth-source-pass-get 'secret entry)))))
  70         (auth-source-pass--do-debug "return %s as final result (plus hidden password)"
  71                                     (seq-subseq retval 0 -2)) ;; remove password
  72         retval))))
  73
  74 ;;;###autoload
  75 (defun auth-source-pass-enable ()
  76   "Enable auth-source-password-store."
  77   ;; To add password-store to the list of sources, evaluate the following:
  78   (add-to-list 'auth-sources 'password-store)
  79   ;; clear the cache (required after each change to #'auth-source-pass-search)
  80   (auth-source-forget-all-cached))
  81
  82 (defvar auth-source-pass-backend
  83   (auth-source-backend
  84    (when (<= emacs-major-version 25) "password-store")
  85    :source "." ;; not used
  86    :type 'password-store
  87    :search-function #'auth-source-pass-search)
  88   "Auth-source backend for password-store.")
  89
  90 (defun auth-source-pass-backend-parse (entry)
  91   "Create a password-store auth-source backend from ENTRY."
  92   (when (eq entry 'password-store)
  93     (auth-source-backend-parse-parameters entry auth-source-pass-backend)))
  94
  95 (if (boundp 'auth-source-backend-parser-functions)
  96     (add-hook 'auth-source-backend-parser-functions #'auth-source-pass-backend-parse)
  97   (advice-add 'auth-source-backend-parse :before-until #'auth-source-pass-backend-parse))
  98
  99 \f
 100 (defun auth-source-pass-get (key entry)
 101   "Return the value associated to KEY in the password-store entry ENTRY.
 102
 103 ENTRY is the name of a password-store entry.
 104 The key used to retrieve the password is the symbol `secret'.
 105
 106 The convention used as the format for a password-store file is
 107 the following (see http://www.passwordstore.org/#organization):
 108
 109 secret
 110 key1: value1
 111 key2: value2"
 112   (let ((data (auth-source-pass-parse-entry entry)))
 113     (or (cdr (assoc key data))
 114         (and (string= key "user")
 115              (cdr (assoc "username" data))))))
 116
 117 (defun auth-source-pass--read-entry (entry)
 118   "Return a string with the file content of ENTRY."
 119   (with-temp-buffer
 120     (insert-file-contents (expand-file-name
 121                            (format "%s.gpg" entry)
 122                            "~/.password-store"))
 123     (buffer-substring-no-properties (point-min) (point-max))))
 124
 125 (defun auth-source-pass-parse-entry (entry)
 126   "Return an alist of the data associated with ENTRY.
 127
 128 ENTRY is the name of a password-store entry."
 129   (let ((file-contents (ignore-errors (auth-source-pass--read-entry entry))))
 130     (and file-contents
 131          (cons `(secret . ,(auth-source-pass--parse-secret file-contents))
 132                (auth-source-pass--parse-data file-contents)))))
 133
 134 (defun auth-source-pass--parse-secret (contents)
 135   "Parse the password-store data in the string CONTENTS and return its secret.
 136 The secret is the first line of CONTENTS."
 137   (car (split-string contents "\\\n" t)))
 138
 139 (defun auth-source-pass--parse-data (contents)
 140   "Parse the password-store data in the string CONTENTS and return an alist.
 141 CONTENTS is the contents of a password-store formatted file."
 142   (let ((lines (split-string contents "\\\n" t "\\\s")))
 143     (seq-remove #'null
 144                 (mapcar (lambda (line)
 145                           (let ((pair (mapcar (lambda (s) (string-trim s))
 146                                               (split-string line ":"))))
 147                             (when (> (length pair) 1)
 148                               (cons (car pair)
 149                                     (mapconcat #'identity (cdr pair) ":")))))
 150                         (cdr lines)))))
 151
 152 (defun auth-source-pass--do-debug (&rest msg)
 153   "Call `auth-source-do-debug` with MSG and a prefix."
 154   (apply #'auth-source-do-debug
 155          (cons (concat "auth-source-pass: " (car msg))
 156                (cdr msg))))
 157
 158 (defun auth-source-pass--select-one-entry (entries user)
 159   "Select one entry from ENTRIES by searching for a field matching USER."
 160   (let ((number (length entries))
 161         (entry-with-user
 162          (and user
 163               (seq-find (lambda (entry)
 164                           (string-equal (auth-source-pass-get "user" entry) user))
 165                         entries))))
 166     (auth-source-pass--do-debug "found %s matches: %s" number
 167                                 (mapconcat #'identity entries ", "))
 168     (if entry-with-user
 169         (progn
 170           (auth-source-pass--do-debug "return %s as it contains matching user field"
 171                                       entry-with-user)
 172           entry-with-user)
 173       (auth-source-pass--do-debug "return %s as it is the first one" (car entries))
 174       (car entries))))
 175
 176 (defun auth-source-pass--entry-valid-p (entry)
 177   "Return t iff ENTRY can be opened.
 178 Also displays a warning if not.  This function is slow, don't call it too
 179 often."
 180   (if (auth-source-pass-parse-entry entry)
 181       t
 182     (auth-source-pass--do-debug "entry '%s' is not valid" entry)
 183     nil))
 184
 185 ;; TODO: add tests for that when `assess-with-filesystem' is included
 186 ;; in Emacs
 187 (defun auth-source-pass-entries ()
 188   "Return a list of all password store entries."
 189   (let ((store-dir (expand-file-name "~/.password-store/")))
 190     (mapcar
 191      (lambda (file) (file-name-sans-extension (file-relative-name file store-dir)))
 192      (directory-files-recursively store-dir "\.gpg$"))))
 193
 194 (defun auth-source-pass--find-all-by-entry-name (entryname user)
 195   "Search the store for all entries either matching ENTRYNAME/USER or ENTRYNAME.
 196 Only return valid entries as of `auth-source-pass--entry-valid-p'."
 197   (seq-filter (lambda (entry)
 198                 (and
 199                  (or
 200                   (let ((components-host-user
 201                          (member entryname (split-string entry "/"))))
 202                     (and (= (length components-host-user) 2)
 203                          (string-equal user (cadr components-host-user))))
 204                   (string-equal entryname (file-name-nondirectory entry)))
 205                  (auth-source-pass--entry-valid-p entry)))
 206               (auth-source-pass-entries)))
 207
 208 (defun auth-source-pass--find-one-by-entry-name (entryname user)
 209   "Search the store for an entry matching ENTRYNAME.
 210 If USER is non nil, give precedence to entries containing a user field
 211 matching USER."
 212   (auth-source-pass--do-debug "searching for '%s' in entry names (user: %s)"
 213                               entryname
 214                               user)
 215   (let ((matching-entries (auth-source-pass--find-all-by-entry-name entryname user)))
 216     (pcase (length matching-entries)
 217       (0 (auth-source-pass--do-debug "no match found")
 218          nil)
 219       (1 (auth-source-pass--do-debug "found 1 match: %s" (car matching-entries))
 220          (car matching-entries))
 221       (_ (auth-source-pass--select-one-entry matching-entries user)))))
 222
 223 (defun auth-source-pass--find-match (host user port)
 224   "Return a password-store entry name matching HOST, USER and PORT.
 225
 226 Disambiguate between user provided inside HOST (e.g., user@server.com) and
 227 inside USER by giving priority to USER.  Same for PORT."
 228   (let* ((url (url-generic-parse-url (if (string-match-p ".*://" host)
 229                                          host
 230                                        (format "https://%s" host)))))
 231     (auth-source-pass--find-match-unambiguous
 232      (or (url-host url) host)
 233      (or user (url-user url))
 234      ;; url-port returns 443 (because of the https:// above) by default
 235      (or port (number-to-string (url-port url))))))
 236
 237 (defun auth-source-pass--find-match-unambiguous (hostname user port)
 238   "Return a password-store entry name matching HOSTNAME, USER and PORT.
 239 If many matches are found, return the first one.  If no match is found,
 240 return nil.
 241
 242 HOSTNAME should not contain any username or port number."
 243   (or
 244    (and user port (auth-source-pass--find-one-by-entry-name (format "%s@%s:%s" user hostname port) user))
 245    (and user (auth-source-pass--find-one-by-entry-name (format "%s@%s" user hostname) user))
 246    (and port (auth-source-pass--find-one-by-entry-name (format "%s:%s" hostname port) nil))
 247    (auth-source-pass--find-one-by-entry-name hostname user)
 248    ;; if that didn't work, remove subdomain: foo.bar.com -> bar.com
 249    (let ((components (split-string hostname "\\.")))
 250      (when (= (length components) 3)
 251        ;; start from scratch
 252        (auth-source-pass--find-match-unambiguous
 253         (mapconcat 'identity (cdr components) ".")
 254         user
 255         port)))))
 256
 257 (provide 'auth-source-pass)
 258 ;;; auth-source-pass.el ends here