]> code.delx.au - gnu-emacs/blob - lisp/net/ntlm.el
delx.au / code / gnu-emacs / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Update docs for `customize-mode'
[gnu-emacs] / lisp / net / ntlm.el
1 ;;; ntlm.el --- NTLM (NT LanManager) authentication support
2
3 ;; Copyright (C) 2001, 2007-2016 Free Software Foundation, Inc.
4
5 ;; Author: Taro Kawagishi <tarok@transpulse.org>
6 ;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
7 ;; Keywords: NTLM, SASL, comm
8 ;; Version: 2.0.0
9 ;; Created: February 2001
10
11 ;; This file is part of GNU Emacs.
12
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
17
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
22
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25
26 ;;; Commentary:
27
28 ;; This library is a direct translation of the Samba release 2.2.0
29 ;; implementation of Windows NT and LanManager compatible password
30 ;; encryption.
31 ;;
32 ;; Interface functions:
33 ;;
34 ;; ntlm-build-auth-request
35 ;; This will return a binary string, which should be used in the
36 ;; base64 encoded form and it is the caller's responsibility to encode
37 ;; the returned string with base64.
38 ;;
39 ;; ntlm-build-auth-response
40 ;; It is the caller's responsibility to pass a base64 decoded string
41 ;; (which will be a binary string) as the first argument and to
42 ;; encode the returned string with base64. The second argument user
43 ;; should be given in user@domain format.
44 ;;
45 ;; ntlm-get-password-hashes
46 ;;
47 ;;
48 ;; NTLM authentication procedure example:
49 ;;
50 ;; 1. Open a network connection to the Exchange server at the IMAP port (143)
51 ;; 2. Receive an opening message such as:
52 ;; "* OK Microsoft Exchange IMAP4rev1 server version 5.5.2653.7 (XXXX) ready"
53 ;; 3. Ask for IMAP server capability by sending "NNN capability"
54 ;; 4. Receive a capability message such as:
55 ;; "* CAPABILITY IMAP4 IMAP4rev1 IDLE LITERAL+ LOGIN-REFERRALS MAILBOX-REFERRALS NAMESPACE AUTH=NTLM"
56 ;; 5. Ask for NTLM authentication by sending a string
57 ;; "NNN authenticate ntlm"
58 ;; 6. Receive continuation acknowledgment "+"
59 ;; 7. Send NTLM authentication request generated by 'ntlm-build-auth-request
60 ;; 8. Receive NTLM challenge string following acknowledgment "+"
61 ;; 9. Generate response to challenge by 'ntlm-build-auth-response
62 ;; (here two hash function values of the user password are encrypted)
63 ;; 10. Receive authentication completion message such as
64 ;; "NNN OK AUTHENTICATE NTLM completed."
65
66 ;;; Code:
67
68 (require 'md4)
69 (require 'hmac-md5)
70 (require 'calc)
71
72 (defgroup ntlm nil
73 "NTLM (NT LanManager) authentication."
74 :version "25.1"
75 :group 'comm)
76
77 (defcustom ntlm-compatibility-level 5
78 "The NTLM compatibility level.
79 Ordered from 0, the oldest, least-secure level through 5, the
80 newest, most-secure level. Newer servers may reject lower
81 levels. At levels 3 through 5, send LMv2 and NTLMv2 responses.
82 At levels 0, 1 and 2, send LM and NTLM responses.
83
84 In this implementation, levels 0, 1 and 2 are the same (old,
85 insecure), and levels 3, 4 and 5 are the same (new, secure). If
86 NTLM authentication isn't working at level 5, try level 0. The
87 other levels are only present because other clients have six
88 levels."
89 :type '(choice (const 0) (const 1) (const 2) (const 3) (const 4) (const 5)))
90
91 ;;;
92 ;;; NTLM authentication interface functions
93
94 (defun ntlm-build-auth-request (user &optional domain)
95 "Return the NTLM authentication request string for USER and DOMAIN.
96 USER is a string representing a user name to be authenticated and
97 DOMAIN is a NT domain. USER can include a NT domain part as in
98 user@domain where the string after @ is used as the domain if DOMAIN
99 is not given."
100 (interactive)
101 (let ((request-ident (concat "NTLMSSP" (make-string 1 0)))
102 (request-msgType (concat (make-string 1 1) (make-string 3 0)))
103 ;0x01 0x00 0x00 0x00
104 (request-flags (concat (make-string 1 7) (make-string 1 178)
105 (make-string 1 8) (make-string 1 0)))
106 ;0x07 0xb2 0x08 0x00
107 lu ld off-d off-u)
108 (when (string-match "@" user)
109 (unless domain
110 (setq domain (substring user (1+ (match-beginning 0)))))
111 (setq user (substring user 0 (match-beginning 0))))
112 ;; set fields offsets within the request struct
113 (setq lu (length user))
114 (setq ld (length domain))
115 (setq off-u 32) ;offset to the string 'user
116 (setq off-d (+ 32 lu)) ;offset to the string 'domain
117 ;; pack the request struct in a string
118 (concat request-ident ;8 bytes
119 request-msgType ;4 bytes
120 request-flags ;4 bytes
121 (md4-pack-int16 lu) ;user field, count field
122 (md4-pack-int16 lu) ;user field, max count field
123 (md4-pack-int32 (cons 0 off-u)) ;user field, offset field
124 (md4-pack-int16 ld) ;domain field, count field
125 (md4-pack-int16 ld) ;domain field, max count field
126 (md4-pack-int32 (cons 0 off-d)) ;domain field, offset field
127 user ;buffer field
128 domain ;buffer field
129 )))
130
131 (eval-when-compile
132 (defmacro ntlm-string-as-unibyte (string)
133 (if (fboundp 'string-as-unibyte)
134 `(string-as-unibyte ,string)
135 string)))
136
137 (defun ntlm-compute-timestamp ()
138 "Compute an NTLMv2 timestamp.
139 Return a unibyte string representing the number of tenths of a
140 microsecond since January 1, 1601 as a 64-bit little-endian
141 signed integer."
142 (let* ((s-to-tenths-of-us "mul(add(lsh($1,16),$2),10000000)")
143 (us-to-tenths-of-us "mul($3,10)")
144 (ps-to-tenths-of-us "idiv($4,100000)")
145 (tenths-of-us-since-jan-1-1601
146 (apply 'calc-eval (concat "add(add(add("
147 s-to-tenths-of-us ","
148 us-to-tenths-of-us "),"
149 ps-to-tenths-of-us "),"
150 ;; tenths of microseconds between
151 ;; 1601-01-01 and 1970-01-01
152 "116444736000000000)")
153 ;; add trailing zeros to support old current-time formats
154 'rawnum (append (current-time) '(0 0))))
155 result-bytes)
156 (dotimes (byte 8)
157 (push (calc-eval "and($1,16#FF)" 'rawnum tenths-of-us-since-jan-1-1601)
158 result-bytes)
159 (setq tenths-of-us-since-jan-1-1601
160 (calc-eval "rsh($1,8,64)" 'rawnum tenths-of-us-since-jan-1-1601)))
161 (apply 'unibyte-string (nreverse result-bytes))))
162
163 (defun ntlm-generate-nonce ()
164 "Generate a random nonce, not to be used more than once.
165 Return a random eight byte unibyte string."
166 (unibyte-string
167 (random 256) (random 256) (random 256) (random 256)
168 (random 256) (random 256) (random 256) (random 256)))
169
170 (defun ntlm-build-auth-response (challenge user password-hashes)
171 "Return the response string to a challenge string CHALLENGE given by
172 the NTLM based server for the user USER and the password hash list
173 PASSWORD-HASHES. NTLM uses two hash values which are represented
174 by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
175 (list (ntlm-smb-passwd-hash password) (ntlm-md4hash password))"
176 (let* ((rchallenge (ntlm-string-as-unibyte challenge))
177 ;; get fields within challenge struct
178 ;;(ident (substring rchallenge 0 8)) ;ident, 8 bytes
179 ;;(msgType (substring rchallenge 8 12)) ;msgType, 4 bytes
180 (uDomain (substring rchallenge 12 20)) ;uDomain, 8 bytes
181 (flags (substring rchallenge 20 24)) ;flags, 4 bytes
182 (challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes
183 uDomain-len uDomain-offs
184 ;; response struct and its fields
185 lmRespData ;lmRespData, 24 bytes
186 ntRespData ;ntRespData, variable length
187 domain ;ascii domain string
188 lu ld ln off-lm off-nt off-d off-u off-w off-s)
189 ;; extract domain string from challenge string
190 (setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2)))
191 (setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8)))
192 (setq domain
193 (ntlm-unicode2ascii (substring challenge
194 (cdr uDomain-offs)
195 (+ (cdr uDomain-offs) uDomain-len))
196 (/ uDomain-len 2)))
197 ;; overwrite domain in case user is given in <user>@<domain> format
198 (when (string-match "@" user)
199 (setq domain (substring user (1+ (match-beginning 0))))
200 (setq user (substring user 0 (match-beginning 0))))
201
202 (unless (and (integerp ntlm-compatibility-level)
203 (>= ntlm-compatibility-level 0)
204 (<= ntlm-compatibility-level 5))
205 (error "Invalid ntlm-compatibility-level value"))
206 (if (and (>= ntlm-compatibility-level 3)
207 (<= ntlm-compatibility-level 5))
208 ;; extract target information block, if it is present
209 (if (< (cdr uDomain-offs) 48)
210 (error "Failed to find target information block")
211 (let* ((targetInfo-len (md4-unpack-int16 (substring rchallenge
212 40 42)))
213 (targetInfo-offs (md4-unpack-int32 (substring rchallenge
214 44 48)))
215 (targetInfo (substring rchallenge
216 (cdr targetInfo-offs)
217 (+ (cdr targetInfo-offs)
218 targetInfo-len)))
219 (upcase-user (upcase (ntlm-ascii2unicode user (length user))))
220 (ntlmv2-hash (hmac-md5 (concat upcase-user
221 (ntlm-ascii2unicode
222 domain (length domain)))
223 (cadr password-hashes)))
224 (nonce (ntlm-generate-nonce))
225 (blob (concat (make-string 2 1)
226 (make-string 2 0) ; blob signature
227 (make-string 4 0) ; reserved value
228 (ntlm-compute-timestamp) ; timestamp
229 nonce ; client nonce
230 (make-string 4 0) ; unknown
231 targetInfo ; target info
232 (make-string 4 0))) ; unknown
233 ;; for reference: LMv2 interim calculation
234 ;; (lm-interim (hmac-md5 (concat challengeData nonce)
235 ;; ntlmv2-hash))
236 (nt-interim (hmac-md5 (concat challengeData blob)
237 ntlmv2-hash)))
238 ;; for reference: LMv2 field, but match other clients that
239 ;; send all zeros
240 ;; (setq lmRespData (concat lm-interim nonce))
241 (setq lmRespData (make-string 24 0))
242 (setq ntRespData (concat nt-interim blob))))
243 ;; compatibility level is 2, 1 or 0
244 ;; level 2 should be treated specially but it's not clear how,
245 ;; so just treat it the same as levels 0 and 1
246 ;; check if "negotiate NTLM2 key" flag is set in type 2 message
247 (if (not (zerop (logand (aref flags 2) 8)))
248 (let (randomString
249 sessionHash)
250 ;; generate NTLM2 session response data
251 (setq randomString (ntlm-generate-nonce))
252 (setq sessionHash (secure-hash 'md5
253 (concat challengeData randomString)
254 nil nil t))
255 (setq sessionHash (substring sessionHash 0 8))
256 (setq lmRespData (concat randomString (make-string 16 0)))
257 (setq ntRespData (ntlm-smb-owf-encrypt
258 (cadr password-hashes) sessionHash)))
259 ;; generate response data
260 (setq lmRespData
261 (ntlm-smb-owf-encrypt (car password-hashes) challengeData))
262 (setq ntRespData
263 (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData))))
264
265 ;; get offsets to fields to pack the response struct in a string
266 (setq lu (length user))
267 (setq ld (length domain))
268 (setq ln (length ntRespData))
269 (setq off-lm 64) ;offset to string 'lmResponse
270 (setq off-nt (+ 64 24)) ;offset to string 'ntResponse
271 (setq off-d (+ 64 24 ln)) ;offset to string 'uDomain
272 (setq off-u (+ 64 24 ln (* 2 ld))) ;offset to string 'uUser
273 (setq off-w (+ 64 24 ln (* 2 (+ ld lu)))) ;offset to string 'uWks
274 (setq off-s (+ 64 24 ln (* 2 (+ ld lu lu)))) ;offset to string 'sessionKey
275 ;; pack the response struct in a string
276 (concat "NTLMSSP\0" ;response ident field, 8 bytes
277 (md4-pack-int32 '(0 . 3)) ;response msgType field, 4 bytes
278
279 ;; lmResponse field, 8 bytes
280 ;;AddBytes(response,lmResponse,lmRespData,24);
281 (md4-pack-int16 24) ;len field
282 (md4-pack-int16 24) ;maxlen field
283 (md4-pack-int32 (cons 0 off-lm)) ;field offset
284
285 ;; ntResponse field, 8 bytes
286 ;;AddBytes(response,ntResponse,ntRespData,ln);
287 (md4-pack-int16 ln) ;len field
288 (md4-pack-int16 ln) ;maxlen field
289 (md4-pack-int32 (cons 0 off-nt)) ;field offset
290
291 ;; uDomain field, 8 bytes
292 ;;AddUnicodeString(response,uDomain,domain);
293 ;;AddBytes(response, uDomain, udomain, 2*ld);
294 (md4-pack-int16 (* 2 ld)) ;len field
295 (md4-pack-int16 (* 2 ld)) ;maxlen field
296 (md4-pack-int32 (cons 0 off-d)) ;field offset
297
298 ;; uUser field, 8 bytes
299 ;;AddUnicodeString(response,uUser,u);
300 ;;AddBytes(response, uUser, uuser, 2*lu);
301 (md4-pack-int16 (* 2 lu)) ;len field
302 (md4-pack-int16 (* 2 lu)) ;maxlen field
303 (md4-pack-int32 (cons 0 off-u)) ;field offset
304
305 ;; uWks field, 8 bytes
306 ;;AddUnicodeString(response,uWks,u);
307 (md4-pack-int16 (* 2 lu)) ;len field
308 (md4-pack-int16 (* 2 lu)) ;maxlen field
309 (md4-pack-int32 (cons 0 off-w)) ;field offset
310
311 ;; sessionKey field, 8 bytes
312 ;;AddString(response,sessionKey,NULL);
313 (md4-pack-int16 0) ;len field
314 (md4-pack-int16 0) ;maxlen field
315 (md4-pack-int32 (cons 0 (- off-s off-lm))) ;field offset
316
317 ;; flags field, 4 bytes
318 flags ;
319
320 ;; buffer field
321 lmRespData ;lmResponse, 24 bytes
322 ntRespData ;ntResponse, 24 bytes
323 (ntlm-ascii2unicode domain ;Unicode domain string, 2*ld bytes
324 (length domain)) ;
325 (ntlm-ascii2unicode user ;Unicode user string, 2*lu bytes
326 (length user)) ;
327 (ntlm-ascii2unicode user ;Unicode user string, 2*lu bytes
328 (length user)) ;
329 )))
330
331 (defun ntlm-get-password-hashes (password)
332 "Return a pair of SMB hash and NT MD4 hash of the given password PASSWORD."
333 (list (ntlm-smb-passwd-hash password)
334 (ntlm-md4hash password)))
335
336 (defun ntlm-ascii2unicode (str len)
337 "Convert an ASCII string into a NT Unicode string, which is
338 little-endian utf16."
339 (let ((utf (make-string (* 2 len) 0)) (i 0) val)
340 (while (and (< i len)
341 (not (zerop (setq val (aref str i)))))
342 (aset utf (* 2 i) val)
343 (aset utf (1+ (* 2 i)) 0)
344 (setq i (1+ i)))
345 utf))
346
347 (defun ntlm-unicode2ascii (str len)
348 "Extract 7 bits ASCII part of a little endian utf16 string STR of length LEN."
349 (let ((buf (make-string len 0)) (i 0) (j 0))
350 (while (< i len)
351 (aset buf i (logand (aref str j) 127)) ;(string-to-number "7f" 16)
352 (setq i (1+ i)
353 j (+ 2 j)))
354 buf))
355
356 (defun ntlm-smb-passwd-hash (passwd)
357 "Return the SMB password hash string of 16 bytes long for the given password
358 string PASSWD. PASSWD is truncated to 14 bytes if longer."
359 (let ((len (min (length passwd) 14)))
360 (ntlm-smb-des-e-p16
361 (concat (substring (upcase passwd) 0 len) ;fill top 14 bytes with passwd
362 (make-string (- 15 len) 0)))))
363
364 (defun ntlm-smb-owf-encrypt (passwd c8)
365 "Return the response string of 24 bytes long for the given password
366 string PASSWD based on the DES encryption. PASSWD is of at most 14
367 bytes long and the challenge string C8 of 8 bytes long."
368 (let ((len (min (length passwd) 16)) p22)
369 (setq p22 (concat (substring passwd 0 len) ;fill top 16 bytes with passwd
370 (make-string (- 22 len) 0)))
371 (ntlm-smb-des-e-p24 p22 c8)))
372
373 (defun ntlm-smb-des-e-p24 (p22 c8)
374 "Return a 24 bytes hashed string for a 21 bytes string P22 and a 8 bytes
375 string C8."
376 (concat (ntlm-smb-hash c8 p22 t) ;hash first 8 bytes of p22
377 (ntlm-smb-hash c8 (substring p22 7) t)
378 (ntlm-smb-hash c8 (substring p22 14) t)))
379
380 (defconst ntlm-smb-sp8 [75 71 83 33 64 35 36 37])
381
382 (defun ntlm-smb-des-e-p16 (p15)
383 "Return a 16 bytes hashed string for a 15 bytes string P15."
384 (concat (ntlm-smb-hash ntlm-smb-sp8 p15 t) ;hash of first 8 bytes of p15
385 (ntlm-smb-hash ntlm-smb-sp8 ;hash of last 8 bytes of p15
386 (substring p15 7) t)))
387
388 (defun ntlm-smb-hash (in key forw)
389 "Return the hash string of length 8 for a string IN of length 8 and
390 a string KEY of length 8. FORW is t or nil."
391 (let ((out (make-string 8 0))
392 outb ;string of length 64
393 (inb (make-string 64 0))
394 (keyb (make-string 64 0))
395 (key2 (ntlm-smb-str-to-key key))
396 (i 0) aa)
397 (while (< i 64)
398 (unless (zerop (logand (aref in (/ i 8)) (lsh 1 (- 7 (% i 8)))))
399 (aset inb i 1))
400 (unless (zerop (logand (aref key2 (/ i 8)) (lsh 1 (- 7 (% i 8)))))
401 (aset keyb i 1))
402 (setq i (1+ i)))
403 (setq outb (ntlm-smb-dohash inb keyb forw))
404 (setq i 0)
405 (while (< i 64)
406 (unless (zerop (aref outb i))
407 (setq aa (aref out (/ i 8)))
408 (aset out (/ i 8)
409 (logior aa (lsh 1 (- 7 (% i 8))))))
410 (setq i (1+ i)))
411 out))
412
413 (defun ntlm-smb-str-to-key (str)
414 "Return a string of length 8 for the given string STR of length 7."
415 (let ((key (make-string 8 0))
416 (i 7))
417 (aset key 0 (lsh (aref str 0) -1))
418 (aset key 1 (logior
419 (lsh (logand (aref str 0) 1) 6)
420 (lsh (aref str 1) -2)))
421 (aset key 2 (logior
422 (lsh (logand (aref str 1) 3) 5)
423 (lsh (aref str 2) -3)))
424 (aset key 3 (logior
425 (lsh (logand (aref str 2) 7) 4)
426 (lsh (aref str 3) -4)))
427 (aset key 4 (logior
428 (lsh (logand (aref str 3) 15) 3)
429 (lsh (aref str 4) -5)))
430 (aset key 5 (logior
431 (lsh (logand (aref str 4) 31) 2)
432 (lsh (aref str 5) -6)))
433 (aset key 6 (logior
434 (lsh (logand (aref str 5) 63) 1)
435 (lsh (aref str 6) -7)))
436 (aset key 7 (logand (aref str 6) 127))
437 (while (>= i 0)
438 (aset key i (lsh (aref key i) 1))
439 (setq i (1- i)))
440 key))
441
442 (defconst ntlm-smb-perm1 [57 49 41 33 25 17 9
443 1 58 50 42 34 26 18
444 10 2 59 51 43 35 27
445 19 11 3 60 52 44 36
446 63 55 47 39 31 23 15
447 7 62 54 46 38 30 22
448 14 6 61 53 45 37 29
449 21 13 5 28 20 12 4])
450
451 (defconst ntlm-smb-perm2 [14 17 11 24 1 5
452 3 28 15 6 21 10
453 23 19 12 4 26 8
454 16 7 27 20 13 2
455 41 52 31 37 47 55
456 30 40 51 45 33 48
457 44 49 39 56 34 53
458 46 42 50 36 29 32])
459
460 (defconst ntlm-smb-perm3 [58 50 42 34 26 18 10 2
461 60 52 44 36 28 20 12 4
462 62 54 46 38 30 22 14 6
463 64 56 48 40 32 24 16 8
464 57 49 41 33 25 17 9 1
465 59 51 43 35 27 19 11 3
466 61 53 45 37 29 21 13 5
467 63 55 47 39 31 23 15 7])
468
469 (defconst ntlm-smb-perm4 [32 1 2 3 4 5
470 4 5 6 7 8 9
471 8 9 10 11 12 13
472 12 13 14 15 16 17
473 16 17 18 19 20 21
474 20 21 22 23 24 25
475 24 25 26 27 28 29
476 28 29 30 31 32 1])
477
478 (defconst ntlm-smb-perm5 [16 7 20 21
479 29 12 28 17
480 1 15 23 26
481 5 18 31 10
482 2 8 24 14
483 32 27 3 9
484 19 13 30 6
485 22 11 4 25])
486
487 (defconst ntlm-smb-perm6 [40 8 48 16 56 24 64 32
488 39 7 47 15 55 23 63 31
489 38 6 46 14 54 22 62 30
490 37 5 45 13 53 21 61 29
491 36 4 44 12 52 20 60 28
492 35 3 43 11 51 19 59 27
493 34 2 42 10 50 18 58 26
494 33 1 41 9 49 17 57 25])
495
496 (defconst ntlm-smb-sc [1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 1])
497
498 (defconst ntlm-smb-sbox [[[14 4 13 1 2 15 11 8 3 10 6 12 5 9 0 7]
499 [ 0 15 7 4 14 2 13 1 10 6 12 11 9 5 3 8]
500 [ 4 1 14 8 13 6 2 11 15 12 9 7 3 10 5 0]
501 [15 12 8 2 4 9 1 7 5 11 3 14 10 0 6 13]]
502 [[15 1 8 14 6 11 3 4 9 7 2 13 12 0 5 10]
503 [ 3 13 4 7 15 2 8 14 12 0 1 10 6 9 11 5]
504 [ 0 14 7 11 10 4 13 1 5 8 12 6 9 3 2 15]
505 [13 8 10 1 3 15 4 2 11 6 7 12 0 5 14 9]]
506 [[10 0 9 14 6 3 15 5 1 13 12 7 11 4 2 8]
507 [13 7 0 9 3 4 6 10 2 8 5 14 12 11 15 1]
508 [13 6 4 9 8 15 3 0 11 1 2 12 5 10 14 7]
509 [ 1 10 13 0 6 9 8 7 4 15 14 3 11 5 2 12]]
510 [[ 7 13 14 3 0 6 9 10 1 2 8 5 11 12 4 15]
511 [13 8 11 5 6 15 0 3 4 7 2 12 1 10 14 9]
512 [10 6 9 0 12 11 7 13 15 1 3 14 5 2 8 4]
513 [ 3 15 0 6 10 1 13 8 9 4 5 11 12 7 2 14]]
514 [[ 2 12 4 1 7 10 11 6 8 5 3 15 13 0 14 9]
515 [14 11 2 12 4 7 13 1 5 0 15 10 3 9 8 6]
516 [ 4 2 1 11 10 13 7 8 15 9 12 5 6 3 0 14]
517 [11 8 12 7 1 14 2 13 6 15 0 9 10 4 5 3]]
518 [[12 1 10 15 9 2 6 8 0 13 3 4 14 7 5 11]
519 [10 15 4 2 7 12 9 5 6 1 13 14 0 11 3 8]
520 [ 9 14 15 5 2 8 12 3 7 0 4 10 1 13 11 6]
521 [ 4 3 2 12 9 5 15 10 11 14 1 7 6 0 8 13]]
522 [[ 4 11 2 14 15 0 8 13 3 12 9 7 5 10 6 1]
523 [13 0 11 7 4 9 1 10 14 3 5 12 2 15 8 6]
524 [ 1 4 11 13 12 3 7 14 10 15 6 8 0 5 9 2]
525 [ 6 11 13 8 1 4 10 7 9 5 0 15 14 2 3 12]]
526 [[13 2 8 4 6 15 11 1 10 9 3 14 5 0 12 7]
527 [ 1 15 13 8 10 3 7 4 12 5 6 11 0 14 9 2]
528 [ 7 11 4 1 9 12 14 2 0 6 10 13 15 3 5 8]
529 [ 2 1 14 7 4 10 8 13 15 12 9 0 3 5 6 11]]])
530
531 (defsubst ntlm-string-permute (in perm n)
532 "Return a string of length N for a string IN and a permutation vector
533 PERM of size N. The length of IN should be height of PERM."
534 (let ((i 0) (out (make-string n 0)))
535 (while (< i n)
536 (aset out i (aref in (- (aref perm i) 1)))
537 (setq i (1+ i)))
538 out))
539
540 (defsubst ntlm-string-lshift (str count len)
541 "Return a string by circularly shifting a string STR by COUNT to the left.
542 length of STR is LEN."
543 (let ((c (% count len)))
544 (concat (substring str c len) (substring str 0 c))))
545
546 (defsubst ntlm-string-xor (in1 in2 n)
547 "Return exclusive-or of sequences in1 and in2"
548 (let ((w (make-string n 0)) (i 0))
549 (while (< i n)
550 (aset w i (logxor (aref in1 i) (aref in2 i)))
551 (setq i (1+ i)))
552 w))
553
554 (defun ntlm-smb-dohash (in key forw)
555 "Return the hash value for a string IN and a string KEY.
556 Length of IN and KEY are 64. FORW non-nil means forward, nil means
557 backward."
558 (let (pk1 ;string of length 56
559 c ;string of length 28
560 d ;string of length 28
561 cd ;string of length 56
562 (ki (make-vector 16 0)) ;vector of string of length 48
563 pd1 ;string of length 64
564 l ;string of length 32
565 r ;string of length 32
566 rl ;string of length 64
567 (i 0) (j 0) (k 0))
568 (setq pk1 (ntlm-string-permute key ntlm-smb-perm1 56))
569 (setq c (substring pk1 0 28))
570 (setq d (substring pk1 28 56))
571
572 (setq i 0)
573 (while (< i 16)
574 (setq c (ntlm-string-lshift c (aref ntlm-smb-sc i) 28))
575 (setq d (ntlm-string-lshift d (aref ntlm-smb-sc i) 28))
576 (setq cd (concat (substring c 0 28) (substring d 0 28)))
577 (aset ki i (ntlm-string-permute cd ntlm-smb-perm2 48))
578 (setq i (1+ i)))
579
580 (setq pd1 (ntlm-string-permute in ntlm-smb-perm3 64))
581
582 (setq l (substring pd1 0 32))
583 (setq r (substring pd1 32 64))
584
585 (setq i 0)
586 (let (er ;string of length 48
587 erk ;string of length 48
588 (b (make-vector 8 0)) ;vector of strings of length 6
589 cb ;string of length 32
590 pcb ;string of length 32
591 r2 ;string of length 32
592 jj m n bj sbox-jmn)
593 (while (< i 16)
594 (setq er (ntlm-string-permute r ntlm-smb-perm4 48))
595 (setq erk (ntlm-string-xor er
596 (aref ki (if forw i (- 15 i)))
597 48))
598 (setq j 0)
599 (while (< j 8)
600 (setq jj (* 6 j))
601 (aset b j (substring erk jj (+ jj 6)))
602 (setq j (1+ j)))
603 (setq j 0)
604 (while (< j 8)
605 (setq bj (aref b j))
606 (setq m (logior (lsh (aref bj 0) 1) (aref bj 5)))
607 (setq n (logior (lsh (aref bj 1) 3)
608 (lsh (aref bj 2) 2)
609 (lsh (aref bj 3) 1)
610 (aref bj 4)))
611 (setq k 0)
612 (setq sbox-jmn (aref (aref (aref ntlm-smb-sbox j) m) n))
613 (while (< k 4)
614 (aset bj k
615 (if (zerop (logand sbox-jmn (lsh 1 (- 3 k))))
616 0 1))
617 (setq k (1+ k)))
618 (setq j (1+ j)))
619
620 (setq j 0)
621 (setq cb nil)
622 (while (< j 8)
623 (setq cb (concat cb (substring (aref b j) 0 4)))
624 (setq j (1+ j)))
625
626 (setq pcb (ntlm-string-permute cb ntlm-smb-perm5 32))
627 (setq r2 (ntlm-string-xor l pcb 32))
628 (setq l r)
629 (setq r r2)
630 (setq i (1+ i))))
631 (setq rl (concat r l))
632 (ntlm-string-permute rl ntlm-smb-perm6 64)))
633
634 (defun ntlm-md4hash (passwd)
635 "Return the 16 bytes MD4 hash of a string PASSWD after converting it
636 into a Unicode string. PASSWD is truncated to 128 bytes if longer."
637 (let (len wpwd)
638 ;; Password cannot be longer than 128 characters
639 (setq len (length passwd))
640 (if (> len 128)
641 (setq len 128))
642 ;; Password must be converted to NT Unicode
643 (setq wpwd (ntlm-ascii2unicode passwd len))
644 ;; Calculate length in bytes
645 (setq len (* len 2))
646 (md4 wpwd len)))
647
648 (provide 'ntlm)
649
650 ;;; ntlm.el ends here