/
sasl-scram.el
260 lines (227 loc) · 8.7 KB
/
sasl-scram.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
;;; sasl-scram.el --- Compute SCRAM-MD5. -*- lexical-binding: t -*-
;; Copyright (C) 1999 Shuhei KOBAYASHI
;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
;; Kenichi OKADA <okada@opaopa.org>
;; Keywords: SCRAM-MD5, HMAC-MD5, SASL, IMAP, POP, ACAP
;; This file is part of FLIM (Faithful Library about Internet Message).
;; This program 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 2, or
;; (at your option) any later version.
;; This program 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 this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; This program is implemented from draft-newman-auth-scram-03.txt.
;;
;; It is caller's responsibility to base64-decode challenges and
;; base64-encode responses in IMAP4 AUTHENTICATE command.
;;
;; Passphrase should be longer than 16 bytes. (See RFC 2195)
;; Examples.
;;
;; (sasl-scram-md5-make-security-info nil t 0)
;; => "^A^@^@^@"
;;
;; (base64-encode-string
;; (sasl-scram-md5-make-client-msg-2
;; (base64-decode-string "dGVzdHNhbHQBAAAAaW1hcEBlbGVhbm9yLmlubm9zb2Z0LmNvbQBqaGNOWmxSdVBiemlGcCt2TFYrTkN3")
;; (base64-decode-string "AGNocmlzADx0NG40UGFiOUhCMEFtL1FMWEI3MmVnQGVsZWFub3IuaW5ub3NvZnQuY29tPg==")
;; (sasl-scram-md5-make-salted-pass
;; "secret stuff" "testsalt")
;; (sasl-scram-md5-make-security-info nil t 0)))
;; => "AQAAAMg9jU8CeB4KOfk7sUhSQPs="
;;
;; (base64-encode-string
;; (sasl-scram-md5-make-server-msg-2
;; (base64-decode-string "dGVzdHNhbHQBAAAAaW1hcEBlbGVhbm9yLmlubm9zb2Z0LmNvbQBqaGNOWmxSdVBiemlGcCt2TFYrTkN3")
;; (base64-decode-string "AGNocmlzADx0NG40UGFiOUhCMEFtL1FMWEI3MmVnQGVsZWFub3IuaW5ub3NvZnQuY29tPg==")
;; (sasl-scram-md5-make-security-info nil t 0)
;; "testsalt"
;; (sasl-scram-md5-make-salted-pass
;; "secret stuff" "testsalt")))
;; => "U0odqYw3B7XIIW0oSz65OQ=="
;;; Code:
(require 'sasl)
(require 'hmac-md5)
(defvar sasl-scram-md5-unique-id-function
sasl-unique-id-function)
(defconst sasl-scram-md5-steps
'(ignore ;no initial response
sasl-scram-md5-response-1
sasl-scram-md5-response-2
sasl-scram-md5-authenticate-server))
(defmacro sasl-scram-md5-security-info-no-security-layer (security-info)
`(eq (logand (aref ,security-info 0) 1) 1))
(defmacro sasl-scram-md5-security-info-integrity-protection-layer (security-info)
`(eq (logand (aref ,security-info 0) 2) 2))
(defmacro sasl-scram-md5-security-info-buffer-size (security-info)
`(let ((ssecinfo ,security-info))
(+ (lsh (aref ssecinfo 1) 16)
(lsh (aref ssecinfo 2) 8)
(aref ssecinfo 3))))
(defun sasl-scram-md5-make-security-info (integrity-protection-layer
no-security-layer buffer-size)
(let ((csecinfo (make-string 4 0)))
(when integrity-protection-layer
(aset csecinfo 0 2))
(if no-security-layer
(aset csecinfo 0 (logior (aref csecinfo 0) 1))
(aset csecinfo 1
(ash (logand buffer-size (ash 255 16)) -16))
(aset csecinfo 2
(ash (logand buffer-size (ash 255 8)) -8))
(aset csecinfo 3 (logand buffer-size 255)))
csecinfo))
(defun sasl-scram-md5-make-unique-nonce () ; 8*OCTET, globally unique.
;; For example, concatenated string of process-identifier, system-clock,
;; sequence-number, random-number, and domain-name.
(let* ((sasl-unique-id-function sasl-scram-md5-unique-id-function)
(id (sasl-unique-id)))
(unwind-protect
(concat "<" id "@" (system-name) ">")
(fillarray id 0))))
(defun sasl-scram-md5-xor-string (str1 str2)
;; (length str1) == (length str2) == (length dst) == 16 (in SCRAM-MD5)
(let* ((len (length str1))
(dst (make-string len 0))
(pos 0))
(while (< pos len)
(aset dst pos (logxor (aref str1 pos) (aref str2 pos)))
(setq pos (1+ pos)))
dst))
(defun sasl-scram-md5-make-client-msg-1 (authenticate-id &optional authorize-id nonce)
"Make an initial client message from AUTHENTICATE-ID and AUTHORIZE-ID.
If AUTHORIZE-ID is the same as AUTHENTICATE-ID, it may be omitted."
(concat authorize-id "\0" authenticate-id "\0"
(or nonce
(sasl-scram-md5-make-unique-nonce))))
(defun sasl-scram-md5-parse-server-msg-1 (server-msg-1)
"Parse SERVER-MSG-1 and return a list of (SALT SECURITY-INFO SERVICE-ID)."
(if (and (> (length server-msg-1) 16)
(eq (string-match "[^@]+@[^\0]+\0" server-msg-1 12) 12))
(list (substring server-msg-1 0 8) ; salt
(substring server-msg-1 8 12) ; server-security-info
(substring server-msg-1 ; service-id
12 (1- (match-end 0))))
(sasl-error (format "Unexpected response: %s" server-msg-1))))
(defun sasl-scram-md5-server-salt (server-msg-1)
(car (sasl-scram-md5-parse-server-msg-1 server-msg-1)))
(defun sasl-scram-md5-make-salted-pass (passphrase salt)
(hmac-md5 salt passphrase))
(defun sasl-scram-md5-make-client-key (salted-pass)
(md5-binary salted-pass))
(defun sasl-scram-md5-make-client-verifier (client-key)
(md5-binary client-key))
(defun sasl-scram-md5-make-shared-key (server-msg-1
client-msg-1
client-security-info
client-verifier)
(let (buff)
(unwind-protect
(hmac-md5
(setq buff
(concat server-msg-1 client-msg-1 client-security-info))
client-verifier)
(fillarray buff 0))))
(defun sasl-scram-md5-make-client-proof (client-key shared-key)
(sasl-scram-md5-xor-string client-key shared-key))
(defun sasl-scram-md5-make-client-msg-2 (server-msg-1
client-msg-1
salted-pass
client-security-info)
(let (client-proof client-key shared-key client-verifier)
(setq client-key
(sasl-scram-md5-make-client-key salted-pass))
(setq client-verifier
(sasl-scram-md5-make-client-verifier client-key))
(setq shared-key
(unwind-protect
(sasl-scram-md5-make-shared-key
server-msg-1
client-msg-1
client-security-info
client-verifier)
(fillarray client-verifier 0)))
(setq client-proof
(unwind-protect
(sasl-scram-md5-make-client-proof
client-key shared-key)
(fillarray client-key 0)
(fillarray shared-key 0)))
(unwind-protect
(concat
client-security-info
client-proof)
(fillarray client-proof 0))))
(defun sasl-scram-md5-make-server-msg-2 (server-msg-1
client-msg-1
client-security-info
salt salted-pass)
(let ((server-salt
(hmac-md5 salt salted-pass))
buff)
(unwind-protect
(hmac-md5
(setq buff
(concat
client-msg-1
server-msg-1
client-security-info))
server-salt)
(fillarray server-salt 0)
(fillarray buff 0))))
(defun sasl-scram-md5-response-1 (client _step)
(sasl-client-set-property
client 'client-msg-1
(sasl-scram-md5-make-client-msg-1
(sasl-client-name client)
(sasl-client-property client 'authorize-id)
(sasl-client-property client 'nonce))))
(defun sasl-scram-md5-response-2 (client step)
(let* ((server-msg-1
(sasl-client-set-property
client 'server-msg-1
(sasl-step-data step)))
(salted-pass
(sasl-client-set-property
client 'salted-pass
(sasl-scram-md5-make-salted-pass
(sasl-read-passphrase
(format "SCRAM-MD5 passphrase for %s: "
(sasl-client-name client)))
(sasl-scram-md5-server-salt server-msg-1)))))
(sasl-client-set-property
client 'client-msg-2
(sasl-scram-md5-make-client-msg-2
server-msg-1
(sasl-client-property client 'client-msg-1)
salted-pass
(or (sasl-client-property client 'client-security-info)
(sasl-scram-md5-make-security-info nil t 0))))))
(defun sasl-scram-md5-authenticate-server (client step)
(let ((server-msg-2
(sasl-client-set-property
client 'server-msg-2
(sasl-step-data step)))
(server-msg-1
(sasl-client-property client 'server-msg-1)))
(if (string= server-msg-2
(sasl-scram-md5-make-server-msg-2
server-msg-1
(sasl-client-property client 'client-msg-1)
(or (sasl-client-property client 'client-security-info)
(sasl-scram-md5-make-security-info nil t 0))
(sasl-scram-md5-server-salt server-msg-1)
(sasl-client-property client 'salted-pass)))
" "
(sasl-error "SCRAM-MD5: authenticate server failed."))))
(put 'sasl-scram 'sasl-mechanism
(sasl-make-mechanism "SCRAM-MD5" sasl-scram-md5-steps))
(provide 'sasl-scram)
;;; sasl-scram.el ends here