1 ;;; ntlm.el --- NTLM (NT LanManager) authentication support
3 ;; Copyright (C) 2001 Taro Kawagishi
4 ;; Author: Taro Kawagishi <tarok@transpulse.org>
5 ;; Keywords: NTLM, SASL
7 ;; Created: February 2001
9 ;; This program is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; This program is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with this program; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
26 ;; This library is a direct translation of the Samba release 2.2.0
27 ;; implementation of Windows NT and LanManager compatible password
30 ;; Interface functions:
32 ;; ntlm-build-auth-request
33 ;; This will return a binary string, which should be used in the
34 ;; base64 encoded form and it is the caller's responsibility to encode
35 ;; the returned string with base64.
37 ;; ntlm-build-auth-response
38 ;; It is the caller's responsibility to pass a base64 decoded string
39 ;; (which will be a binary string) as the first argument and to
40 ;; encode the returned string with base64. The second argument user
41 ;; should be given in user@domain format.
43 ;; ntlm-get-password-hashes
46 ;; NTLM authentication procedure example:
48 ;; 1. Open a network connection to the Exchange server at the IMAP port (143)
49 ;; 2. Receive an opening message such as:
50 ;; "* OK Microsoft Exchange IMAP4rev1 server version 5.5.2653.7 (XXXX) ready"
51 ;; 3. Ask for IMAP server capability by sending "NNN capability"
52 ;; 4. Receive a capability message such as:
53 ;; "* CAPABILITY IMAP4 IMAP4rev1 IDLE LITERAL+ LOGIN-REFERRALS MAILBOX-REFERRALS NAMESPACE AUTH=NTLM"
54 ;; 5. Ask for NTLM authentication by sending a string
55 ;; "NNN authenticate ntlm"
56 ;; 6. Receive continuation acknowledgment "+"
57 ;; 7. Send NTLM authentication request generated by 'ntlm-build-auth-request
58 ;; 8. Receive NTLM challenge string following acknowledgment "+"
59 ;; 9. Generate response to challenge by 'ntlm-build-auth-response
60 ;; (here two hash function values of the user password are encrypted)
61 ;; 10. Receive authentication completion message such as
62 ;; "NNN OK AUTHENTICATE NTLM completed."
70 ;;; NTLM authentication interface functions
72 (defun ntlm-build-auth-request (user &optional domain)
73 "Return the NTLM authentication request string for USER and DOMAIN.
74 USER is a string representing a user name to be authenticated and
75 DOMAIN is a NT domain. USER can include a NT domain part as in
76 user@domain where the string after @ is used as the domain if DOMAIN
79 (let ((request-ident (concat "NTLMSSP" (make-string 1 0)))
80 (request-msgType (concat (make-string 1 1) (make-string 3 0)))
82 (request-flags (concat (make-string 1 7) (make-string 1 178)
86 (when (string-match "@" user)
88 (setq domain (substring user (1+ (match-beginning 0)))))
89 (setq user (substring user 0 (match-beginning 0))))
90 ;; set fields offsets within the request struct
91 (setq lu (length user))
92 (setq ld (length domain))
93 (setq off-u 32) ;offset to the string 'user
94 (setq off-d (+ 32 lu)) ;offset to the string 'domain
95 ;; pack the request struct in a string
96 (concat request-ident ;8 bytes
97 request-msgType ;4 bytes
98 request-flags ;4 bytes
99 (md4-pack-int16 lu) ;user field, count field
100 (md4-pack-int16 lu) ;user field, max count field
101 (md4-pack-int32 (cons 0 off-u)) ;user field, offset field
102 (md4-pack-int16 ld) ;domain field, count field
103 (md4-pack-int16 ld) ;domain field, max count field
104 (md4-pack-int32 (cons 0 off-d)) ;domain field, offset field
109 (defun ntlm-build-auth-response (challenge user password-hashes)
110 "Return the response string to a challenge string CHALLENGE given by
111 the NTLM based server for the user USER and the password hash list
112 PASSWORD-HASHES. NTLM uses two hash values which are represented
113 by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
114 (list (smb-passwd-hash password) (ntlm-md4hash password))"
115 (let* ((rchallenge (string-as-unibyte challenge))
116 ;; get fields within challenge struct
117 ;;(ident (substring rchallenge 0 8)) ;ident, 8 bytes
118 ;;(msgType (substring rchallenge 8 12)) ;msgType, 4 bytes
119 (uDomain (substring rchallenge 12 20)) ;uDomain, 8 bytes
120 (flags (substring rchallenge 20 24)) ;flags, 4 bytes
121 (challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes
122 uDomain-len uDomain-offs
123 ;; response struct and its fields
124 lmRespData ;lmRespData, 24 bytes
125 ntRespData ;ntRespData, 24 bytes
126 domain ;ascii domain string
127 lu ld off-lm off-nt off-d off-u off-w off-s)
128 ;; extract domain string from challenge string
129 (setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2)))
130 (setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8)))
132 (ntlm-unicode2ascii (substring challenge
134 (+ (cdr uDomain-offs) uDomain-len))
136 ;; overwrite domain in case user is given in <user>@<domain> format
137 (when (string-match "@" user)
138 (setq domain (substring user (1+ (match-beginning 0))))
139 (setq user (substring user 0 (match-beginning 0))))
141 ;; generate response data
143 (smb-owf-encrypt (car password-hashes) challengeData))
145 (smb-owf-encrypt (cadr password-hashes) challengeData))
147 ;; get offsets to fields to pack the response struct in a string
148 (setq lu (length user))
149 (setq ld (length domain))
150 (setq off-lm 64) ;offset to string 'lmResponse
151 (setq off-nt (+ 64 24)) ;offset to string 'ntResponse
152 (setq off-d (+ 64 48)) ;offset to string 'uDomain
153 (setq off-u (+ 64 48 (* 2 ld))) ;offset to string 'uUser
154 (setq off-w (+ 64 48 (* 2 (+ ld lu)))) ;offset to string 'uWks
155 (setq off-s (+ 64 48 (* 2 (+ ld lu lu)))) ;offset to string 'sessionKey
156 ;; pack the response struct in a string
157 (concat "NTLMSSP\0" ;response ident field, 8 bytes
158 (md4-pack-int32 '(0 . 3)) ;response msgType field, 4 bytes
160 ;; lmResponse field, 8 bytes
161 ;;AddBytes(response,lmResponse,lmRespData,24);
162 (md4-pack-int16 24) ;len field
163 (md4-pack-int16 24) ;maxlen field
164 (md4-pack-int32 (cons 0 off-lm)) ;field offset
166 ;; ntResponse field, 8 bytes
167 ;;AddBytes(response,ntResponse,ntRespData,24);
168 (md4-pack-int16 24) ;len field
169 (md4-pack-int16 24) ;maxlen field
170 (md4-pack-int32 (cons 0 off-nt)) ;field offset
172 ;; uDomain field, 8 bytes
173 ;;AddUnicodeString(response,uDomain,domain);
174 ;;AddBytes(response, uDomain, udomain, 2*ld);
175 (md4-pack-int16 (* 2 ld)) ;len field
176 (md4-pack-int16 (* 2 ld)) ;maxlen field
177 (md4-pack-int32 (cons 0 off-d)) ;field offset
179 ;; uUser field, 8 bytes
180 ;;AddUnicodeString(response,uUser,u);
181 ;;AddBytes(response, uUser, uuser, 2*lu);
182 (md4-pack-int16 (* 2 lu)) ;len field
183 (md4-pack-int16 (* 2 lu)) ;maxlen field
184 (md4-pack-int32 (cons 0 off-u)) ;field offset
186 ;; uWks field, 8 bytes
187 ;;AddUnicodeString(response,uWks,u);
188 (md4-pack-int16 (* 2 lu)) ;len field
189 (md4-pack-int16 (* 2 lu)) ;maxlen field
190 (md4-pack-int32 (cons 0 off-w)) ;field offset
192 ;; sessionKey field, 8 bytes
193 ;;AddString(response,sessionKey,NULL);
194 (md4-pack-int16 0) ;len field
195 (md4-pack-int16 0) ;maxlen field
196 (md4-pack-int32 (cons 0 (- off-s off-lm))) ;field offset
198 ;; flags field, 4 bytes
202 lmRespData ;lmResponse, 24 bytes
203 ntRespData ;ntResponse, 24 bytes
204 (ntlm-ascii2unicode domain ;unicode domain string, 2*ld bytes
206 (ntlm-ascii2unicode user ;unicode user string, 2*lu bytes
208 (ntlm-ascii2unicode user ;unicode user string, 2*lu bytes
212 (defun ntlm-get-password-hashes (password)
213 "Return a pair of SMB hash and NT MD4 hash of the given password PASSWORD"
214 (list (smb-passwd-hash password)
215 (ntlm-md4hash password)))
217 (defun ntlm-ascii2unicode (str len)
218 "Convert an ASCII string into a NT Unicode string, which is
219 little-endian utf16."
220 (let ((utf (make-string (* 2 len) 0)) (i 0) val)
221 (while (and (< i len)
222 (not (zerop (setq val (aref str i)))))
223 (aset utf (* 2 i) val)
224 (aset utf (1+ (* 2 i)) 0)
228 (defun ntlm-unicode2ascii (str len)
229 "Extract 7 bits ASCII part of a little endian utf16 string STR of length LEN."
230 (let ((buf (make-string len 0)) (i 0) (j 0))
232 (aset buf i (logand (aref str j) 127)) ;(string-to-number "7f" 16)
237 (defun smb-passwd-hash (passwd)
238 "Return the SMB password hash string of 16 bytes long for the given password
239 string PASSWD. PASSWD is truncated to 14 bytes if longer."
240 (let ((len (min (length passwd) 14)))
242 (concat (substring (upcase passwd) 0 len) ;fill top 14 bytes with passwd
243 (make-string (- 15 len) 0)))))
245 (defun smb-owf-encrypt (passwd c8)
246 "Return the response string of 24 bytes long for the given password
247 string PASSWD based on the DES encryption. PASSWD is of at most 14
248 bytes long and the challenge string C8 of 8 bytes long."
249 (let ((len (min (length passwd) 16)) p22)
250 (setq p22 (concat (substring passwd 0 len) ;fill top 16 bytes with passwd
251 (make-string (- 22 len) 0)))
252 (smbdes-e-p24 p22 c8)))
254 (defun smbdes-e-p24 (p22 c8)
255 "Return a 24 bytes hashed string for a 21 bytes string P22 and a 8 bytes
257 (concat (smbhash c8 p22 t) ;hash first 8 bytes of p22
258 (smbhash c8 (substring p22 7) t)
259 (smbhash c8 (substring p22 14) t)))
261 (defconst smb-sp8 [75 71 83 33 64 35 36 37])
263 (defun smbdes-e-p16 (p15)
264 "Return a 16 bytes hashed string for a 15 bytes string P15."
265 (concat (smbhash smb-sp8 p15 t) ;hash of first 8 bytes of p15
266 (smbhash smb-sp8 (substring p15 7) t) ;hash of last 8 bytes of p15
269 (defun smbhash (in key forw)
270 "Return the hash string of length 8 for a string IN of length 8 and
271 a string KEY of length 8. FORW is t or nil."
272 (let ((out (make-string 8 0))
273 outb ;string of length 64
274 (inb (make-string 64 0))
275 (keyb (make-string 64 0))
276 (key2 (smb-str-to-key key))
279 (unless (zerop (logand (aref in (/ i 8)) (lsh 1 (- 7 (% i 8)))))
281 (unless (zerop (logand (aref key2 (/ i 8)) (lsh 1 (- 7 (% i 8)))))
284 (setq outb (smb-dohash inb keyb forw))
287 (unless (zerop (aref outb i))
288 (setq aa (aref out (/ i 8)))
290 (logior aa (lsh 1 (- 7 (% i 8))))))
294 (defun smb-str-to-key (str)
295 "Return a string of length 8 for the given string STR of length 7."
296 (let ((key (make-string 8 0))
298 (aset key 0 (lsh (aref str 0) -1))
300 (lsh (logand (aref str 0) 1) 6)
301 (lsh (aref str 1) -2)))
303 (lsh (logand (aref str 1) 3) 5)
304 (lsh (aref str 2) -3)))
306 (lsh (logand (aref str 2) 7) 4)
307 (lsh (aref str 3) -4)))
309 (lsh (logand (aref str 3) 15) 3)
310 (lsh (aref str 4) -5)))
312 (lsh (logand (aref str 4) 31) 2)
313 (lsh (aref str 5) -6)))
315 (lsh (logand (aref str 5) 63) 1)
316 (lsh (aref str 6) -7)))
317 (aset key 7 (logand (aref str 6) 127))
319 (aset key i (lsh (aref key i) 1))
323 (defconst smb-perm1 [57 49 41 33 25 17 9
332 (defconst smb-perm2 [14 17 11 24 1 5
341 (defconst smb-perm3 [58 50 42 34 26 18 10 2
342 60 52 44 36 28 20 12 4
343 62 54 46 38 30 22 14 6
344 64 56 48 40 32 24 16 8
345 57 49 41 33 25 17 9 1
346 59 51 43 35 27 19 11 3
347 61 53 45 37 29 21 13 5
348 63 55 47 39 31 23 15 7])
350 (defconst smb-perm4 [32 1 2 3 4 5
359 (defconst smb-perm5 [16 7 20 21
368 (defconst smb-perm6 [40 8 48 16 56 24 64 32
369 39 7 47 15 55 23 63 31
370 38 6 46 14 54 22 62 30
371 37 5 45 13 53 21 61 29
372 36 4 44 12 52 20 60 28
373 35 3 43 11 51 19 59 27
374 34 2 42 10 50 18 58 26
375 33 1 41 9 49 17 57 25])
377 (defconst smb-sc [1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 1])
379 (defconst smb-sbox [[[14 4 13 1 2 15 11 8 3 10 6 12 5 9 0 7]
380 [ 0 15 7 4 14 2 13 1 10 6 12 11 9 5 3 8]
381 [ 4 1 14 8 13 6 2 11 15 12 9 7 3 10 5 0]
382 [15 12 8 2 4 9 1 7 5 11 3 14 10 0 6 13]]
383 [[15 1 8 14 6 11 3 4 9 7 2 13 12 0 5 10]
384 [ 3 13 4 7 15 2 8 14 12 0 1 10 6 9 11 5]
385 [ 0 14 7 11 10 4 13 1 5 8 12 6 9 3 2 15]
386 [13 8 10 1 3 15 4 2 11 6 7 12 0 5 14 9]]
387 [[10 0 9 14 6 3 15 5 1 13 12 7 11 4 2 8]
388 [13 7 0 9 3 4 6 10 2 8 5 14 12 11 15 1]
389 [13 6 4 9 8 15 3 0 11 1 2 12 5 10 14 7]
390 [ 1 10 13 0 6 9 8 7 4 15 14 3 11 5 2 12]]
391 [[ 7 13 14 3 0 6 9 10 1 2 8 5 11 12 4 15]
392 [13 8 11 5 6 15 0 3 4 7 2 12 1 10 14 9]
393 [10 6 9 0 12 11 7 13 15 1 3 14 5 2 8 4]
394 [ 3 15 0 6 10 1 13 8 9 4 5 11 12 7 2 14]]
395 [[ 2 12 4 1 7 10 11 6 8 5 3 15 13 0 14 9]
396 [14 11 2 12 4 7 13 1 5 0 15 10 3 9 8 6]
397 [ 4 2 1 11 10 13 7 8 15 9 12 5 6 3 0 14]
398 [11 8 12 7 1 14 2 13 6 15 0 9 10 4 5 3]]
399 [[12 1 10 15 9 2 6 8 0 13 3 4 14 7 5 11]
400 [10 15 4 2 7 12 9 5 6 1 13 14 0 11 3 8]
401 [ 9 14 15 5 2 8 12 3 7 0 4 10 1 13 11 6]
402 [ 4 3 2 12 9 5 15 10 11 14 1 7 6 0 8 13]]
403 [[ 4 11 2 14 15 0 8 13 3 12 9 7 5 10 6 1]
404 [13 0 11 7 4 9 1 10 14 3 5 12 2 15 8 6]
405 [ 1 4 11 13 12 3 7 14 10 15 6 8 0 5 9 2]
406 [ 6 11 13 8 1 4 10 7 9 5 0 15 14 2 3 12]]
407 [[13 2 8 4 6 15 11 1 10 9 3 14 5 0 12 7]
408 [ 1 15 13 8 10 3 7 4 12 5 6 11 0 14 9 2]
409 [ 7 11 4 1 9 12 14 2 0 6 10 13 15 3 5 8]
410 [ 2 1 14 7 4 10 8 13 15 12 9 0 3 5 6 11]]])
412 (defsubst string-permute (in perm n)
413 "Return a string of length N for a string IN and a permutation vector
414 PERM of size N. The length of IN should be height of PERM."
415 (let ((i 0) (out (make-string n 0)))
417 (aset out i (aref in (- (aref perm i) 1)))
421 (defsubst string-lshift (str count len)
422 "Return a string by circularly shifting a string STR by COUNT to the left.
423 length of STR is LEN."
424 (let ((c (% count len)))
425 (concat (substring str c len) (substring str 0 c))))
427 (defsubst string-xor (in1 in2 n)
428 "Return exclusive-or of sequences in1 and in2"
429 (let ((w (make-string n 0)) (i 0))
431 (aset w i (logxor (aref in1 i) (aref in2 i)))
435 (defun smb-dohash (in key forw)
436 "Return the hash value for a string IN and a string KEY.
437 Length of IN and KEY are 64. FORW non nill means forward, nil means
439 (let (pk1 ;string of length 56
440 c ;string of length 28
441 d ;string of length 28
442 cd ;string of length 56
443 (ki (make-vector 16 0)) ;vector of string of length 48
444 pd1 ;string of length 64
445 l ;string of length 32
446 r ;string of length 32
447 rl ;string of length 64
449 (setq pk1 (string-permute key smb-perm1 56))
450 (setq c (substring pk1 0 28))
451 (setq d (substring pk1 28 56))
455 (setq c (string-lshift c (aref smb-sc i) 28))
456 (setq d (string-lshift d (aref smb-sc i) 28))
457 (setq cd (concat (substring c 0 28) (substring d 0 28)))
458 (aset ki i (string-permute cd smb-perm2 48))
461 (setq pd1 (string-permute in smb-perm3 64))
463 (setq l (substring pd1 0 32))
464 (setq r (substring pd1 32 64))
467 (let (er ;string of length 48
468 erk ;string of length 48
469 (b (make-vector 8 0)) ;vector of strings of length 6
470 cb ;string of length 32
471 pcb ;string of length 32
472 r2 ;string of length 32
475 (setq er (string-permute r smb-perm4 48))
476 (setq erk (string-xor er
477 (aref ki (if forw i (- 15 i)))
482 (aset b j (substring erk jj (+ jj 6)))
487 (setq m (logior (lsh (aref bj 0) 1) (aref bj 5)))
488 (setq n (logior (lsh (aref bj 1) 3)
493 (setq sbox-jmn (aref (aref (aref smb-sbox j) m) n))
496 (if (zerop (logand sbox-jmn (lsh 1 (- 3 k))))
504 (setq cb (concat cb (substring (aref b j) 0 4)))
507 (setq pcb (string-permute cb smb-perm5 32))
508 (setq r2 (string-xor l pcb 32))
512 (setq rl (concat r l))
513 (string-permute rl smb-perm6 64)))
515 (defun ntlm-md4hash (passwd)
516 "Return the 16 bytes MD4 hash of a string PASSWD after converting it
517 into a Unicode string. PASSWD is truncated to 128 bytes if longer."
519 ;; Password cannot be longer than 128 characters
520 (setq len (length passwd))
523 ;; Password must be converted to NT unicode
524 (setq wpwd (ntlm-ascii2unicode passwd len))
525 ;; Calculate length in bytes
531 ;;; ntlm.el ends here