cl-postgres/scram.lisp

   1 ;;;; -*- Mode: LISP; Syntax: Ansi-Common-Lisp; Base: 10; Package: CL-POSTGRES; -*-
   2 (in-package :cl-postgres)
   3
   4 ;; For more information about the PostgreSQL scocket protocol, see
   5 ;; http://www.postgresql.org/docs/current/interactive/protocol.html
   6 ;;
   7 ;; Postgresql Scram Documentation is at
   8 ;; https://www.postgresql.org/docs/current/protocol.html
   9 ;; https://www.postgresql.org/docs/current/protocol-overview.html
  10 ;; https://www.postgresql.org/docs/current/protocol-flow.html
  11 ;; https://www.postgresql.org/docs/current/sasl-authentication.html
  12 ;; https://www.postgresql.org/docs/current/protocol-message-types.html
  13 ;; https://www.postgresql.org/docs/current/protocol-message-formats.html
  14 ;;
  15
  16 ;; Scram Functions following the specifications here:
  17 ;; RFC 5802 https://tools.ietf.org/html/rfc5802
  18 ;; RFC 7677 https://tools.ietf.org/html/rfc7677
  19
  20 ;;  From RFC 7677
  21 ;;  This is a simple example of a SCRAM-SHA-256 authentication exchange
  22 ;;  when the client doesn't support channel bindings.  The username
  23 ;;    'user' and password 'pencil' are being used.
  24 ;;
  25 ;;   C: n,,n=user,r=rOprNGfwEbeRWgbNEkqO
  26 ;;   S: r=rOprNGfwEbeRWgbNEkqO%hvYDpWUa2RaTCAfuxFIlj)hNlF$k0,
  27 ;;      s=W22ZaJ0SNY7soEsUEjb6gQ==,i=4096
  28 ;;   C: c=biws,r=rOprNGfwEbeRWgbNEkqO%hvYDpWUa2RaTCAfuxFIlj)hNlF$k0,
  29 ;;      p=dHzbZapWIk4jUhN+Ute9ytag9zjfMHgsqmmiz7AndVQ=
  30 ;;   S: v=6rriTRBi23WpRR/wtup+mMhUZUn/dB5nLTJRsjl95G4=
  31
  32 ;; Reminder if the string has an '=' sign at the end, it is probably encoded in
  33 ;; base64 and the equal signs are there for padding.
  34 ;; Reminder (cl-base64:string-to-base64-string "abcde") "YWJjZGU="
  35 ;; (cl-base64:base64-string-to-usb8-array
  36 ;;   (cl-base64:string-to-base64-string "abcde"))
  37 ;; #(97 98 99 100 101)
  38
  39 ;; (cl-postgres-trivial-utf-8:utf-8-bytes-to-string
  40 ;;   (cl-base64:base64-string-to-usb8-array
  41 ;;     (cl-base64:string-to-base64-string "abcde")))
  42 ;; "abcde"
  43 ;;  ":=": The variable on the left-hand side represents the octet
  44 ;;        string resulting from the expression on the right-hand side.
  45
  46 ;;   o  "+": Octet string concatenation.
  47
  48 ;;     o  "[ ]": A portion of an expression enclosed in "[" and "]" may not
  49 ;;        be included in the result under some circumstances.  See the
  50 ;;        associated text for a description of those circumstances.
  51
  52 ;;     o  Normalize(str): Apply the SASLprep profile [RFC4013] of the
  53 ;;        "stringprep" algorithm [RFC3454] as the normalization algorithm to
  54 ;;        a UTF-8 [RFC3629] encoded "str".  The resulting string is also in
  55 ;;        UTF-8.  When applying SASLprep, "str" is treated as a "stored
  56 ;;        strings", which means that unassigned Unicode codepoints are
  57 ;;        prohibited (see Section 7 of [RFC3454]).  Note that
  58 ;;        implementations MUST either implement SASLprep or disallow use of
  59 ;;        non US-ASCII Unicode codepoints in "str".
  60
  61 ;;     o  HMAC(key, str): Apply the HMAC keyed hash algorithm (defined in
  62 ;;        [RFC2104]) using the octet string represented by "key" as the key
  63 ;;        and the octet string "str" as the input string.  The size of the
  64 ;;        result is the hash result size for the hash function in use.  For
  65 ;;        example, it is 20 octets for SHA-1 (see [RFC3174]).
  66
  67 ;;     o  H(str): Apply the cryptographic hash function to the octet string
  68 ;;        "str", producing an octet string as a result.  The size of the
  69 ;;        result depends on the hash result size for the hash function in
  70 ;;        use.
  71
  72 ;;     o  XOR: Apply the exclusive-or operation to combine the octet string
  73 ;;        on the left of this operator with the octet string on the right of
  74 ;;        this operator.  The length of the output and each of the two
  75 ;;        inputs will be the same for this use.
  76
  77 ;;     o  Hi(str, salt, i):
  78
  79 ;;       U1   := HMAC(str, salt + INT(1))
  80 ;;       U2   := HMAC(str, U1)
  81 ;;       ...
  82 ;;       Ui-1 := HMAC(str, Ui-2)
  83 ;;       Ui   := HMAC(str, Ui-1)
  84
  85 ;;       Hi := U1 XOR U2 XOR ... XOR Ui
  86
  87 ;;        where "i" is the iteration count, "+" is the string concatenation
  88 ;;        operator, and INT(g) is a 4-octet encoding of the integer g, most
  89 ;;        significant octet first.
  90
  91 ;;        Hi() is, essentially, PBKDF2 [RFC2898] with HMAC() as the
  92 ;;        pseudorandom function (PRF) and with dkLen == output length of
  93 ;;        HMAC() == output length of H().
  94
  95 ;;     SaltedPassword  := Hi(Normalize(password), salt, i)
  96 ;;     ClientKey       := HMAC(SaltedPassword, "Client Key")
  97 ;;     StoredKey       := H(ClientKey)
  98 ;;     AuthMessage     := client-first-message-bare + "," +
  99 ;;                        server-first-message + "," +
 100 ;;                        client-final-message-without-proof
 101 ;;     ClientSignature := HMAC(StoredKey, AuthMessage)
 102 ;;     ClientProof     := ClientKey XOR ClientSignature
 103 ;;     ServerKey       := HMAC(SaltedPassword, "Server Key")
 104 ;;     ServerSignature := HMAC(ServerKey, AuthMessage)
 105
 106
 107 ;;     Messages
 108
 109 ;;     RFC 5802 names four consecutive messages between server and client:
 110
 111 ;;     client-first -  The client-first message consists of a gs2-cbind-flag,
 112 ;;                     the desired username, and a randomly generated client
 113 ;;                     nonce cnonce.
 114 ;;     server-first -  The server appends to this client nonce its own nonce
 115 ;;                     snonce, and adds it to the server-first message, which
 116 ;;                     also contains a salt used by the server for salting the
 117 ;;                     user's password hash, and an iteration count indicator it
 118 ;;     client-final -  After that the client sends the client-final message,
 119 ;;                     which contains c-bind-input, the concatenation of the
 120 ;;                     client and the server nonce, and cproof.
 121 ;;     server-final -  The communication closes with the server-final message,
 122 ;;                     which contains the server proof sproof.
 123
 124 ;;     Salted password - The salted password spassword is calculated as follows:
 125
 126 ;;         spassword = Hi(password, salt, iterations)
 127
 128 ;;     where Hi(p,s,i) is defined as PBKDF2 (HMAC, p, s, i, output length of H).
 129
 130 ;;     Proofs - The client and the server prove to each other they have the same
 131 ;;              Auth variable, consisting of:
 132
 133 ;;         Auth = client-first, server-first, client-final-without-proof
 134
 135 ;;     The proofs are calculated as follows:
 136
 137 ;;         ckey = HMAC(spassword, 'Client Key')
 138 ;;         skey = HMAC(spassword, 'Server Key')
 139
 140 ;;         cproof = ckey XOR HMAC(H(ckey), Auth)
 141 ;;         sproof = HMAC(skey, Auth)
 142
 143 ;;     where the XOR operation is applied to byte strings of the same length,
 144 ;;     H(ckey) is a normal hash of ckey. 'Client Key' and 'Server Key' are
 145 ;;     verbatim strings.
 146
 147 ;;     Stored password - The stored password is equal to H(ckey). In the
 148 ;;                       algorithm above, the client proves knowledge of ckey,
 149 ;;                       which is then hashed and compared against what is
 150 ;;                       stored on the server.
 151
 152 ;;     For every user, the server only has to store the username, H(ckey), skey,
 153 ;;     salt, and it, but not the clear text password itself.
 154
 155
 156 (deftype octet () '(unsigned-byte 8))
 157 (deftype octet-vector () '(simple-array octet (*)))
 158 (deftype index () `(integer 0 ,array-total-size-limit))
 159
 160 (declaim (ftype (function (index) octet-vector) make-octet-vector)
 161          (inline make-octet-vector))
 162 (defun make-octet-vector (len)
 163   (make-array (the index len)
 164               :element-type 'octet
 165               :initial-element 0))
 166
 167 ;; pjb suggestion. Also
 168 ;;sabra: errors such as Array index -8 out of bounds for #(0 … 0) .  may be cryptic.  Better provide a condition with an error message such: vector too long for pad-octet-vector.
 169 (defun pad-octet-vector (vector &optional (desired-length 32))
 170   "Takes an octet-vector and, if it is shorter than the SIZE parameter,
 171 pads it to the SIZE parameter by adding 0 entries at the beginning."
 172   (let ((length (length vector)))
 173     (if (= desired-length length)
 174         vector
 175         (let ((result (make-octet-vector desired-length)))
 176           (replace result vector :start1 (- desired-length length))))))
 177 #|
 178 ;; no-defun-allowed + beach + flip214 suggestion
 179 (defun pad-octet-vector (vector &key (desired-length 32) (padding 0))
 180   (let ((vector-length (length vector)))
 181     (if (>= vector-length length)
 182         vector
 183         (replace (make-array desired-length :initial-element padding)
 184                  vector
 185                  :start1 (- desired-length vector-length)))))
 186 |#
 187 (defun gen-client-nonce (&optional (nonce-length 32))
 188   "Generate a random alphanumeric nonce with a default length of 32."
 189   (let* ((chars "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
 190          (chars-length 62)
 191          (client-nonce (make-string nonce-length))
 192          (crypto:*prng* (crypto:make-prng :os :seed :random)))
 193     (dotimes (i nonce-length)
 194       (setf (aref client-nonce i)
 195             (aref chars
 196                   (crypto:strong-random chars-length))))
 197     client-nonce))
 198
 199 (defun gen-client-initial-response (user-name client-nonce)
 200   (when (not user-name) (setf user-name ""))
 201   (format nil "n,,n=~a,r=~a" (saslprep-normalize user-name) client-nonce))
 202
 203 (defun gen-salted-password (password server-salt iterations
 204                             &key (digest :sha256) (salt-type :byte-array))
 205   "Takes an password (must be an ascii string) and server salt (by default
 206 presumed byte-array but can be set for :string or :hex) and an integer
 207 iterations. Digest is presumed to be :sha256 but can be set to other valid
 208 ironclad digests. returns a byte-array"
 209   (case salt-type
 210     (:string (setf server-salt
 211                    (ironclad:ascii-string-to-byte-array server-salt)))
 212     (:byte-array t)
 213     (:base64-string (setf server-salt (cl-base64:base64-string-to-usb8-array
 214                                        server-salt)))
 215     (:hex (setf server-salt (ironclad:hex-string-to-byte-array server-salt)))
 216     (t (cerror "Please enter valid salt-type"
 217                "unknown salt-type in gen-salted-password")))
 218   (ironclad:pbkdf2-hash-password
 219    (ironclad:ascii-string-to-byte-array (saslprep-normalize password))
 220    :salt server-salt
 221    :digest digest
 222    :iterations iterations))
 223
 224 (defun split-server-response (response)
 225   "Takes an array of bytes which are encoded in base64,  It should return a list
 226 of three alists of the form:
 227  ((\"r\" . \"odaUyoz0GpB5GxXLfe2Y8SVjZEosREsxzxhtXY1jiNebxJlohG8IRD1v\")
 228  (\"s\" . \"HV25Sl/1VAUF7k+Ddv42dQ==\") (\"i\" . \"4096\") where \"r\" is the
 229  server nonce,
 230  \"s\" is a base64 encoded salt and \"i\" is the number of iterations for the
 231  hash digest.
 232
 233  We do not use split-sequence building the cons cell because the equal sign can
 234  appear in the nonce or salt itself."
 235   (loop :for x
 236           :in (split-sequence:split-sequence #\,
 237                                              (clp-utf8:utf-8-bytes-to-string
 238                                               response))
 239         :collect (let ((split-on (position #\= x)))
 240                    (cons (subseq x 0 split-on)
 241                          (subseq x (1+ split-on))))))
 242
 243 (defun validate-server-nonce (server-nonce client-nonce)
 244   "checks whether the server-nonce begins with the client-nonce. Both need to be
 245 normal strings."
 246   (when (not (= 0 (search client-nonce server-nonce)))
 247     (error 'protocol-violation
 248            :message "Client-nonce not found at beginning of server-nonce")))
 249
 250 (defun parse-scram-server-first-response (response client-nonce
 251                                           &key (response-type
 252                                                 :base64-usb8-array))
 253   "Takes a server response and a client-nonce. If the server response is not in
 254 the form of an array of bytes which are encoded in base64, the response type
 255 must be specified as either :base64-string or :utf8-string. The client-nonce
 256 should be a normal utf8 string.
 257
 258 It returns the server-response as a normal string, the server-provided-salt as a
 259 normal string, and the server-iterations as an integer"
 260   (cond ((eq response-type :base64-usb8-array) nil)
 261         ((eq response-type :utf8-string)
 262          (setf response
 263                (cl-base64:base64-string-to-usb8-array
 264                 (cl-base64:string-to-base64-string response))))
 265         ((eq response-type :base64-string)
 266          (setf response (cl-base64:base64-string-to-usb8-array response)))
 267         (t (cerror "Invalid response type for parse-scram-server-first-response.
 268 Must be one of :base64-usb8-array, :utf8-string or :base64-string"
 269                    response-type)))
 270
 271   (let* ((split-response (split-server-response response))
 272          (server-nonce (cdr (assoc "r" split-response :test 'equal)))
 273          (server-nonce-validated (validate-server-nonce server-nonce
 274                                                         client-nonce))
 275          (server-salt (cdr (assoc "s" split-response :test 'equal)))
 276          (server-iterations (parse-integer (cdr (assoc "i" split-response
 277                                                        :test 'equal))))
 278          (num-of-split (length split-response)))
 279     (when (not (= 3 num-of-split))
 280       (error 'protocol-error
 281              :message (format nil "There was an error in parsing the server
 282 response. Parsing had ~a results instead of 3" num-of-split)))
 283     (values server-nonce server-salt server-iterations)))
 284
 285 (defun gen-client-key (salted-password
 286                        &optional (message "Client Key") (sha-method :sha256))
 287   "Returns a byte array"
 288   (when (stringp salted-password)
 289     (setf salted-password (ironclad:ascii-string-to-byte-array salted-password)))
 290   (ironclad:hmac-digest
 291    (ironclad:update-hmac
 292     (ironclad:make-hmac salted-password sha-method)
 293     (ironclad:ascii-string-to-byte-array message))))
 294
 295 (defun gen-stored-key (client-key)
 296   (ironclad:digest-sequence :sha256 client-key))
 297
 298 (defun gen-auth-message (client-initial-response server-response
 299                          final-message-part1)
 300   "Currently assumes all parameters are normal strings"
 301   (format nil "~a,~a,~a"
 302           (if (and (search "n,," client-initial-response)
 303                    (= 0 (search "n,," client-initial-response)))
 304               (subseq client-initial-response 3)
 305               client-initial-response)
 306           server-response
 307           final-message-part1))
 308
 309 (defun gen-client-signature (stored-key auth-message
 310                              &optional (sha-method :sha256))
 311   (ironclad:hmac-digest
 312    (ironclad:update-hmac
 313     (ironclad:make-hmac stored-key sha-method)
 314     (ironclad:ascii-string-to-byte-array auth-message))))
 315
 316 (defun gen-client-proof (client-key client-signature)
 317   "The eventual client-proof needs to be base64 encoded"
 318   (let* ((int (logxor (ironclad:octets-to-integer client-key)
 319                       (ironclad:octets-to-integer client-signature)))
 320          (octet-arry (ironclad:integer-to-octets int)))
 321     (pad-octet-vector octet-arry 32)))
 322
 323 (defun get-server-key (salted-password &optional (message "Server Key"))
 324   (gen-client-signature salted-password message))
 325
 326 (defun get-server-signature (server-key auth-message)
 327   (gen-client-signature server-key auth-message))
 328
 329 (defun gen-final-message-part-1 (server-nonce)
 330   "Assumes the server-nonce is a utf8 string"
 331   (format nil "c=biws,r=~a" server-nonce))
 332
 333 (defun gen-final-message (final-message-part1 client-proof)
 334   "Assuming client-proof is in a usb8 array, returns client-proof as part of the
 335 final message as a base64 string"
 336   (format nil "~a,p=~a" final-message-part1
 337           (cl-base64:usb8-array-to-base64-string client-proof)))
 338
 339 (defun aggregated-gen-final-client-message (user-name client-nonce
 340                                             server-message password
 341                                             &key (response-type
 342                                                   :base64-usb8-array)
 343                                               (salt-type :base64-string))
 344   "Takes a user-name, a client-nonce, a server response and a password. If the
 345 server response is not in the form of an array of bytes which are encoded in
 346 base64, the response type must be specified as either :base64-string or
 347 :utf8-string. The client-nonce should be a normal utf8 string.
 348 It returns the server-response as a normal string, the server-provided-salt as
 349 a normal string, and the server-iterations as an integer.
 350
 351 The allowed response-types are :base64-string, :base64-usb8-array and
 352 :utf8-string."
 353   (multiple-value-bind (server-nonce server-salt server-iterations)
 354       (parse-scram-server-first-response server-message client-nonce
 355                                          :response-type response-type)
 356     (let* ((final-message-part-1 (gen-final-message-part-1 server-nonce))
 357            (client-initial-response
 358              (gen-client-initial-response user-name client-nonce))
 359            (salted-password
 360              (gen-salted-password password server-salt server-iterations
 361                                   :salt-type salt-type))
 362            (client-key (gen-client-key salted-password))
 363            (stored-key (gen-stored-key client-key))
 364            (auth-message
 365              (gen-auth-message client-initial-response server-message
 366                                final-message-part-1))
 367            (client-signature (gen-client-signature stored-key auth-message))
 368            (client-proof (gen-client-proof client-key client-signature))
 369            (final-client-message
 370              (gen-final-message final-message-part-1 client-proof))
 371            (server-key (get-server-key salted-password))
 372            (server-signature (cl-base64:usb8-array-to-base64-string
 373                               (get-server-signature server-key auth-message))))
 374       (values final-client-message server-signature))))