1 ;;; ntlm.el --- NTLM (NT LanManager) authentication support
3 ;; Copyright (C) 2001, 2007-2015 Free Software Foundation, Inc.
5 ;; Author: Taro Kawagishi <tarok@transpulse.org>
6 ;; Keywords: NTLM, SASL
8 ;; Created: February 2001
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;; This library is a direct translation of the Samba release 2.2.0
28 ;; implementation of Windows NT and LanManager compatible password
31 ;; Interface functions:
33 ;; ntlm-build-auth-request
34 ;; This will return a binary string, which should be used in the
35 ;; base64 encoded form and it is the caller's responsibility to encode
36 ;; the returned string with base64.
38 ;; ntlm-build-auth-response
39 ;; It is the caller's responsibility to pass a base64 decoded string
40 ;; (which will be a binary string) as the first argument and to
41 ;; encode the returned string with base64. The second argument user
42 ;; should be given in user@domain format.
44 ;; ntlm-get-password-hashes
47 ;; NTLM authentication procedure example:
49 ;; 1. Open a network connection to the Exchange server at the IMAP port (143)
50 ;; 2. Receive an opening message such as:
51 ;; "* OK Microsoft Exchange IMAP4rev1 server version 5.5.2653.7 (XXXX) ready"
52 ;; 3. Ask for IMAP server capability by sending "NNN capability"
53 ;; 4. Receive a capability message such as:
54 ;; "* CAPABILITY IMAP4 IMAP4rev1 IDLE LITERAL+ LOGIN-REFERRALS MAILBOX-REFERRALS NAMESPACE AUTH=NTLM"
55 ;; 5. Ask for NTLM authentication by sending a string
56 ;; "NNN authenticate ntlm"
57 ;; 6. Receive continuation acknowledgment "+"
58 ;; 7. Send NTLM authentication request generated by 'ntlm-build-auth-request
59 ;; 8. Receive NTLM challenge string following acknowledgment "+"
60 ;; 9. Generate response to challenge by 'ntlm-build-auth-response
61 ;; (here two hash function values of the user password are encrypted)
62 ;; 10. Receive authentication completion message such as
63 ;; "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)
83 (make-string 1 8) (make-string 1 0)))
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
110 (defmacro ntlm-string-as-unibyte (string)
111 (if (fboundp 'string-as-unibyte)
112 `(string-as-unibyte ,string)
114 (defmacro ntlm-string-make-unibyte (string)
115 (if (fboundp 'string-make-unibyte)
116 `(string-make-unibyte ,string)
120 (autoload 'sha1 "sha1")
121 (if (fboundp 'secure-hash)
122 (defalias 'ntlm-secure-hash 'secure-hash)
123 (defun ntlm-secure-hash (algorithm object &optional start end binary)
124 "Return the secure hash of OBJECT, a buffer or string.
125 ALGORITHM is a symbol specifying the hash to use: md5, sha1.
127 The two optional arguments START and END are positions specifying for
128 which part of OBJECT to compute the hash. If nil or omitted, uses the
131 If BINARY is non-nil, returns a string in binary form."
132 (cond ((eq algorithm 'md5)
134 (let* ((hex (md5 object start end))
139 (push (ntlm-string-make-unibyte
142 (substring hex beg (setq beg (+ beg 2)))
145 (apply #'concat (nreverse rest)))
146 (md5 object start end)))
147 ((eq algorithm 'sha1)
148 (sha1 object start end binary))
150 (error "(ntlm-secure-hash) Unsupported algorithm: %s"
153 (defun ntlm-build-auth-response (challenge user password-hashes)
154 "Return the response string to a challenge string CHALLENGE given by
155 the NTLM based server for the user USER and the password hash list
156 PASSWORD-HASHES. NTLM uses two hash values which are represented
157 by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
158 (list (ntlm-smb-passwd-hash password) (ntlm-md4hash password))"
159 (let* ((rchallenge (ntlm-string-as-unibyte challenge))
160 ;; get fields within challenge struct
161 ;;(ident (substring rchallenge 0 8)) ;ident, 8 bytes
162 ;;(msgType (substring rchallenge 8 12)) ;msgType, 4 bytes
163 (uDomain (substring rchallenge 12 20)) ;uDomain, 8 bytes
164 (flags (substring rchallenge 20 24)) ;flags, 4 bytes
165 (challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes
166 uDomain-len uDomain-offs
167 ;; response struct and its fields
168 lmRespData ;lmRespData, 24 bytes
169 ntRespData ;ntRespData, 24 bytes
170 domain ;ascii domain string
171 lu ld off-lm off-nt off-d off-u off-w off-s)
172 ;; extract domain string from challenge string
173 (setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2)))
174 (setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8)))
176 (ntlm-unicode2ascii (substring challenge
178 (+ (cdr uDomain-offs) uDomain-len))
180 ;; overwrite domain in case user is given in <user>@<domain> format
181 (when (string-match "@" user)
182 (setq domain (substring user (1+ (match-beginning 0))))
183 (setq user (substring user 0 (match-beginning 0))))
185 ;; check if "negotiate NTLM2 key" flag is set in type 2 message
186 (if (not (zerop (logand (aref flags 2) 8)))
189 ;; generate NTLM2 session response data
190 (setq randomString (ntlm-string-make-unibyte
192 (make-string 1 (random 256))
193 (make-string 1 (random 256))
194 (make-string 1 (random 256))
195 (make-string 1 (random 256))
196 (make-string 1 (random 256))
197 (make-string 1 (random 256))
198 (make-string 1 (random 256))
199 (make-string 1 (random 256)))))
200 (setq sessionHash (ntlm-secure-hash
201 'md5 (concat challengeData randomString)
203 (setq sessionHash (substring sessionHash 0 8))
205 (setq lmRespData (concat randomString (make-string 16 0)))
206 (setq ntRespData (ntlm-smb-owf-encrypt
207 (cadr password-hashes) sessionHash)))
209 ;; generate response data
211 (ntlm-smb-owf-encrypt (car password-hashes) challengeData))
213 (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData))))
215 ;; get offsets to fields to pack the response struct in a string
216 (setq lu (length user))
217 (setq ld (length domain))
218 (setq off-lm 64) ;offset to string 'lmResponse
219 (setq off-nt (+ 64 24)) ;offset to string 'ntResponse
220 (setq off-d (+ 64 48)) ;offset to string 'uDomain
221 (setq off-u (+ 64 48 (* 2 ld))) ;offset to string 'uUser
222 (setq off-w (+ 64 48 (* 2 (+ ld lu)))) ;offset to string 'uWks
223 (setq off-s (+ 64 48 (* 2 (+ ld lu lu)))) ;offset to string 'sessionKey
224 ;; pack the response struct in a string
225 (concat "NTLMSSP\0" ;response ident field, 8 bytes
226 (md4-pack-int32 '(0 . 3)) ;response msgType field, 4 bytes
228 ;; lmResponse field, 8 bytes
229 ;;AddBytes(response,lmResponse,lmRespData,24);
230 (md4-pack-int16 24) ;len field
231 (md4-pack-int16 24) ;maxlen field
232 (md4-pack-int32 (cons 0 off-lm)) ;field offset
234 ;; ntResponse field, 8 bytes
235 ;;AddBytes(response,ntResponse,ntRespData,24);
236 (md4-pack-int16 24) ;len field
237 (md4-pack-int16 24) ;maxlen field
238 (md4-pack-int32 (cons 0 off-nt)) ;field offset
240 ;; uDomain field, 8 bytes
241 ;;AddUnicodeString(response,uDomain,domain);
242 ;;AddBytes(response, uDomain, udomain, 2*ld);
243 (md4-pack-int16 (* 2 ld)) ;len field
244 (md4-pack-int16 (* 2 ld)) ;maxlen field
245 (md4-pack-int32 (cons 0 off-d)) ;field offset
247 ;; uUser field, 8 bytes
248 ;;AddUnicodeString(response,uUser,u);
249 ;;AddBytes(response, uUser, uuser, 2*lu);
250 (md4-pack-int16 (* 2 lu)) ;len field
251 (md4-pack-int16 (* 2 lu)) ;maxlen field
252 (md4-pack-int32 (cons 0 off-u)) ;field offset
254 ;; uWks field, 8 bytes
255 ;;AddUnicodeString(response,uWks,u);
256 (md4-pack-int16 (* 2 lu)) ;len field
257 (md4-pack-int16 (* 2 lu)) ;maxlen field
258 (md4-pack-int32 (cons 0 off-w)) ;field offset
260 ;; sessionKey field, 8 bytes
261 ;;AddString(response,sessionKey,NULL);
262 (md4-pack-int16 0) ;len field
263 (md4-pack-int16 0) ;maxlen field
264 (md4-pack-int32 (cons 0 (- off-s off-lm))) ;field offset
266 ;; flags field, 4 bytes
270 lmRespData ;lmResponse, 24 bytes
271 ntRespData ;ntResponse, 24 bytes
272 (ntlm-ascii2unicode domain ;Unicode domain string, 2*ld bytes
274 (ntlm-ascii2unicode user ;Unicode user string, 2*lu bytes
276 (ntlm-ascii2unicode user ;Unicode user string, 2*lu bytes
280 (defun ntlm-get-password-hashes (password)
281 "Return a pair of SMB hash and NT MD4 hash of the given password PASSWORD."
282 (list (ntlm-smb-passwd-hash password)
283 (ntlm-md4hash password)))
285 (defun ntlm-ascii2unicode (str len)
286 "Convert an ASCII string into a NT Unicode string, which is
287 little-endian utf16."
288 (let ((utf (make-string (* 2 len) 0)) (i 0) val)
289 (while (and (< i len)
290 (not (zerop (setq val (aref str i)))))
291 (aset utf (* 2 i) val)
292 (aset utf (1+ (* 2 i)) 0)
296 (defun ntlm-unicode2ascii (str len)
297 "Extract 7 bits ASCII part of a little endian utf16 string STR of length LEN."
298 (let ((buf (make-string len 0)) (i 0) (j 0))
300 (aset buf i (logand (aref str j) 127)) ;(string-to-number "7f" 16)
305 (defun ntlm-smb-passwd-hash (passwd)
306 "Return the SMB password hash string of 16 bytes long for the given password
307 string PASSWD. PASSWD is truncated to 14 bytes if longer."
308 (let ((len (min (length passwd) 14)))
310 (concat (substring (upcase passwd) 0 len) ;fill top 14 bytes with passwd
311 (make-string (- 15 len) 0)))))
313 (defun ntlm-smb-owf-encrypt (passwd c8)
314 "Return the response string of 24 bytes long for the given password
315 string PASSWD based on the DES encryption. PASSWD is of at most 14
316 bytes long and the challenge string C8 of 8 bytes long."
317 (let ((len (min (length passwd) 16)) p22)
318 (setq p22 (concat (substring passwd 0 len) ;fill top 16 bytes with passwd
319 (make-string (- 22 len) 0)))
320 (ntlm-smb-des-e-p24 p22 c8)))
322 (defun ntlm-smb-des-e-p24 (p22 c8)
323 "Return a 24 bytes hashed string for a 21 bytes string P22 and a 8 bytes
325 (concat (ntlm-smb-hash c8 p22 t) ;hash first 8 bytes of p22
326 (ntlm-smb-hash c8 (substring p22 7) t)
327 (ntlm-smb-hash c8 (substring p22 14) t)))
329 (defconst ntlm-smb-sp8 [75 71 83 33 64 35 36 37])
331 (defun ntlm-smb-des-e-p16 (p15)
332 "Return a 16 bytes hashed string for a 15 bytes string P15."
333 (concat (ntlm-smb-hash ntlm-smb-sp8 p15 t) ;hash of first 8 bytes of p15
334 (ntlm-smb-hash ntlm-smb-sp8 ;hash of last 8 bytes of p15
335 (substring p15 7) t)))
337 (defun ntlm-smb-hash (in key forw)
338 "Return the hash string of length 8 for a string IN of length 8 and
339 a string KEY of length 8. FORW is t or nil."
340 (let ((out (make-string 8 0))
341 outb ;string of length 64
342 (inb (make-string 64 0))
343 (keyb (make-string 64 0))
344 (key2 (ntlm-smb-str-to-key key))
347 (unless (zerop (logand (aref in (/ i 8)) (lsh 1 (- 7 (% i 8)))))
349 (unless (zerop (logand (aref key2 (/ i 8)) (lsh 1 (- 7 (% i 8)))))
352 (setq outb (ntlm-smb-dohash inb keyb forw))
355 (unless (zerop (aref outb i))
356 (setq aa (aref out (/ i 8)))
358 (logior aa (lsh 1 (- 7 (% i 8))))))
362 (defun ntlm-smb-str-to-key (str)
363 "Return a string of length 8 for the given string STR of length 7."
364 (let ((key (make-string 8 0))
366 (aset key 0 (lsh (aref str 0) -1))
368 (lsh (logand (aref str 0) 1) 6)
369 (lsh (aref str 1) -2)))
371 (lsh (logand (aref str 1) 3) 5)
372 (lsh (aref str 2) -3)))
374 (lsh (logand (aref str 2) 7) 4)
375 (lsh (aref str 3) -4)))
377 (lsh (logand (aref str 3) 15) 3)
378 (lsh (aref str 4) -5)))
380 (lsh (logand (aref str 4) 31) 2)
381 (lsh (aref str 5) -6)))
383 (lsh (logand (aref str 5) 63) 1)
384 (lsh (aref str 6) -7)))
385 (aset key 7 (logand (aref str 6) 127))
387 (aset key i (lsh (aref key i) 1))
391 (defconst ntlm-smb-perm1 [57 49 41 33 25 17 9
400 (defconst ntlm-smb-perm2 [14 17 11 24 1 5
409 (defconst ntlm-smb-perm3 [58 50 42 34 26 18 10 2
410 60 52 44 36 28 20 12 4
411 62 54 46 38 30 22 14 6
412 64 56 48 40 32 24 16 8
413 57 49 41 33 25 17 9 1
414 59 51 43 35 27 19 11 3
415 61 53 45 37 29 21 13 5
416 63 55 47 39 31 23 15 7])
418 (defconst ntlm-smb-perm4 [32 1 2 3 4 5
427 (defconst ntlm-smb-perm5 [16 7 20 21
436 (defconst ntlm-smb-perm6 [40 8 48 16 56 24 64 32
437 39 7 47 15 55 23 63 31
438 38 6 46 14 54 22 62 30
439 37 5 45 13 53 21 61 29
440 36 4 44 12 52 20 60 28
441 35 3 43 11 51 19 59 27
442 34 2 42 10 50 18 58 26
443 33 1 41 9 49 17 57 25])
445 (defconst ntlm-smb-sc [1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 1])
447 (defconst ntlm-smb-sbox [[[14 4 13 1 2 15 11 8 3 10 6 12 5 9 0 7]
448 [ 0 15 7 4 14 2 13 1 10 6 12 11 9 5 3 8]
449 [ 4 1 14 8 13 6 2 11 15 12 9 7 3 10 5 0]
450 [15 12 8 2 4 9 1 7 5 11 3 14 10 0 6 13]]
451 [[15 1 8 14 6 11 3 4 9 7 2 13 12 0 5 10]
452 [ 3 13 4 7 15 2 8 14 12 0 1 10 6 9 11 5]
453 [ 0 14 7 11 10 4 13 1 5 8 12 6 9 3 2 15]
454 [13 8 10 1 3 15 4 2 11 6 7 12 0 5 14 9]]
455 [[10 0 9 14 6 3 15 5 1 13 12 7 11 4 2 8]
456 [13 7 0 9 3 4 6 10 2 8 5 14 12 11 15 1]
457 [13 6 4 9 8 15 3 0 11 1 2 12 5 10 14 7]
458 [ 1 10 13 0 6 9 8 7 4 15 14 3 11 5 2 12]]
459 [[ 7 13 14 3 0 6 9 10 1 2 8 5 11 12 4 15]
460 [13 8 11 5 6 15 0 3 4 7 2 12 1 10 14 9]
461 [10 6 9 0 12 11 7 13 15 1 3 14 5 2 8 4]
462 [ 3 15 0 6 10 1 13 8 9 4 5 11 12 7 2 14]]
463 [[ 2 12 4 1 7 10 11 6 8 5 3 15 13 0 14 9]
464 [14 11 2 12 4 7 13 1 5 0 15 10 3 9 8 6]
465 [ 4 2 1 11 10 13 7 8 15 9 12 5 6 3 0 14]
466 [11 8 12 7 1 14 2 13 6 15 0 9 10 4 5 3]]
467 [[12 1 10 15 9 2 6 8 0 13 3 4 14 7 5 11]
468 [10 15 4 2 7 12 9 5 6 1 13 14 0 11 3 8]
469 [ 9 14 15 5 2 8 12 3 7 0 4 10 1 13 11 6]
470 [ 4 3 2 12 9 5 15 10 11 14 1 7 6 0 8 13]]
471 [[ 4 11 2 14 15 0 8 13 3 12 9 7 5 10 6 1]
472 [13 0 11 7 4 9 1 10 14 3 5 12 2 15 8 6]
473 [ 1 4 11 13 12 3 7 14 10 15 6 8 0 5 9 2]
474 [ 6 11 13 8 1 4 10 7 9 5 0 15 14 2 3 12]]
475 [[13 2 8 4 6 15 11 1 10 9 3 14 5 0 12 7]
476 [ 1 15 13 8 10 3 7 4 12 5 6 11 0 14 9 2]
477 [ 7 11 4 1 9 12 14 2 0 6 10 13 15 3 5 8]
478 [ 2 1 14 7 4 10 8 13 15 12 9 0 3 5 6 11]]])
480 (defsubst ntlm-string-permute (in perm n)
481 "Return a string of length N for a string IN and a permutation vector
482 PERM of size N. The length of IN should be height of PERM."
483 (let ((i 0) (out (make-string n 0)))
485 (aset out i (aref in (- (aref perm i) 1)))
489 (defsubst ntlm-string-lshift (str count len)
490 "Return a string by circularly shifting a string STR by COUNT to the left.
491 length of STR is LEN."
492 (let ((c (% count len)))
493 (concat (substring str c len) (substring str 0 c))))
495 (defsubst ntlm-string-xor (in1 in2 n)
496 "Return exclusive-or of sequences in1 and in2"
497 (let ((w (make-string n 0)) (i 0))
499 (aset w i (logxor (aref in1 i) (aref in2 i)))
503 (defun ntlm-smb-dohash (in key forw)
504 "Return the hash value for a string IN and a string KEY.
505 Length of IN and KEY are 64. FORW non-nil means forward, nil means
507 (let (pk1 ;string of length 56
508 c ;string of length 28
509 d ;string of length 28
510 cd ;string of length 56
511 (ki (make-vector 16 0)) ;vector of string of length 48
512 pd1 ;string of length 64
513 l ;string of length 32
514 r ;string of length 32
515 rl ;string of length 64
517 (setq pk1 (ntlm-string-permute key ntlm-smb-perm1 56))
518 (setq c (substring pk1 0 28))
519 (setq d (substring pk1 28 56))
523 (setq c (ntlm-string-lshift c (aref ntlm-smb-sc i) 28))
524 (setq d (ntlm-string-lshift d (aref ntlm-smb-sc i) 28))
525 (setq cd (concat (substring c 0 28) (substring d 0 28)))
526 (aset ki i (ntlm-string-permute cd ntlm-smb-perm2 48))
529 (setq pd1 (ntlm-string-permute in ntlm-smb-perm3 64))
531 (setq l (substring pd1 0 32))
532 (setq r (substring pd1 32 64))
535 (let (er ;string of length 48
536 erk ;string of length 48
537 (b (make-vector 8 0)) ;vector of strings of length 6
538 cb ;string of length 32
539 pcb ;string of length 32
540 r2 ;string of length 32
543 (setq er (ntlm-string-permute r ntlm-smb-perm4 48))
544 (setq erk (ntlm-string-xor er
545 (aref ki (if forw i (- 15 i)))
550 (aset b j (substring erk jj (+ jj 6)))
555 (setq m (logior (lsh (aref bj 0) 1) (aref bj 5)))
556 (setq n (logior (lsh (aref bj 1) 3)
561 (setq sbox-jmn (aref (aref (aref ntlm-smb-sbox j) m) n))
564 (if (zerop (logand sbox-jmn (lsh 1 (- 3 k))))
572 (setq cb (concat cb (substring (aref b j) 0 4)))
575 (setq pcb (ntlm-string-permute cb ntlm-smb-perm5 32))
576 (setq r2 (ntlm-string-xor l pcb 32))
580 (setq rl (concat r l))
581 (ntlm-string-permute rl ntlm-smb-perm6 64)))
583 (defun ntlm-md4hash (passwd)
584 "Return the 16 bytes MD4 hash of a string PASSWD after converting it
585 into a Unicode string. PASSWD is truncated to 128 bytes if longer."
587 ;; Password cannot be longer than 128 characters
588 (setq len (length passwd))
591 ;; Password must be converted to NT Unicode
592 (setq wpwd (ntlm-ascii2unicode passwd len))
593 ;; Calculate length in bytes
599 ;;; ntlm.el ends here