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