4df856688dccfc3f466a4863c495585edd880500
[gnus] / lisp / ntlm.el
1 ;;; ntlm.el --- NTLM (NT LanManager) authentication support
2
3 ;; Copyright (C) 2001, 2007-2014 Free Software Foundation, Inc.
4
5 ;; Author: Taro Kawagishi <tarok@transpulse.org>
6 ;; Keywords: NTLM, SASL
7 ;; Version: 1.00
8 ;; Created: February 2001
9
10 ;; This file is part of GNU Emacs.
11
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.
16
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 PUR1POSE.  See the
20 ;; GNU General Public License for more details.
21
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/>.
24
25 ;;; Commentary:
26
27 ;; This library is a direct translation of the Samba release 2.2.0
28 ;; implementation of Windows NT and LanManager compatible password
29 ;; encryption.
30 ;;
31 ;; Interface functions:
32 ;;
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.
37 ;;
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.
43 ;;
44 ;; ntlm-get-password-hashes
45 ;;
46 ;;
47 ;; NTLM authentication procedure example:
48 ;;
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."
64
65 ;;; Code:
66
67 (require 'md4)
68
69 ;;;
70 ;;; NTLM authentication interface functions
71
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
77 is not given."
78   (interactive)
79   (let ((request-ident (concat "NTLMSSP" (make-string 1 0)))
80         (request-msgType (concat (make-string 1 1) (make-string 3 0)))
81                                         ;0x01 0x00 0x00 0x00
82         (request-flags (concat (make-string 1 7) (make-string 1 178)
83                                (make-string 1 8) (make-string 1 0)))
84                                         ;0x07 0xb2 0x08 0x00
85         lu ld off-d off-u)
86     (when (string-match "@" user)
87       (unless domain
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
105             user                        ;buffer field
106             domain              ;buffer field
107             )))
108
109 (eval-when-compile
110   (defmacro ntlm-string-as-unibyte (string)
111     (if (fboundp 'string-as-unibyte)
112         `(string-as-unibyte ,string)
113       string)))
114
115 (defun ntlm-build-auth-response (challenge user password-hashes)
116   "Return the response string to a challenge string CHALLENGE given by
117 the NTLM based server for the user USER and the password hash list
118 PASSWORD-HASHES.  NTLM uses two hash values which are represented
119 by PASSWORD-HASHES.  PASSWORD-HASHES should be a return value of
120  (list (ntlm-smb-passwd-hash password) (ntlm-md4hash password))"
121   (let* ((rchallenge (ntlm-string-as-unibyte challenge))
122          ;; get fields within challenge struct
123          ;;(ident (substring rchallenge 0 8))   ;ident, 8 bytes
124          ;;(msgType (substring rchallenge 8 12))        ;msgType, 4 bytes
125          (uDomain (substring rchallenge 12 20)) ;uDomain, 8 bytes
126          (flags (substring rchallenge 20 24))   ;flags, 4 bytes
127          (challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes
128          uDomain-len uDomain-offs
129          ;; response struct and its fields
130          lmRespData                     ;lmRespData, 24 bytes
131          ntRespData                     ;ntRespData, 24 bytes
132          domain                         ;ascii domain string
133          lu ld off-lm off-nt off-d off-u off-w off-s)
134     ;; extract domain string from challenge string
135     (setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2)))
136     (setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8)))
137     (setq domain
138           (ntlm-unicode2ascii (substring challenge
139                                          (cdr uDomain-offs)
140                                          (+ (cdr uDomain-offs) uDomain-len))
141                               (/ uDomain-len 2)))
142     ;; overwrite domain in case user is given in <user>@<domain> format
143     (when (string-match "@" user)
144       (setq domain (substring user (1+ (match-beginning 0))))
145       (setq user (substring user 0 (match-beginning 0))))
146
147     ;; check if "negotiate NTLM2 key" flag is set in type 2 message
148     (if (not (zerop (logand (aref flags 2) 8)))
149         (let (randomString
150               sessionHash)
151           ;; generate NTLM2 session response data
152           (setq randomString (string-make-unibyte
153                               (concat
154                                (make-string 1 (random 256))
155                                (make-string 1 (random 256))
156                                (make-string 1 (random 256))
157                                (make-string 1 (random 256))
158                                (make-string 1 (random 256))
159                                (make-string 1 (random 256))
160                                (make-string 1 (random 256))
161                                (make-string 1 (random 256)))))
162           (setq sessionHash (secure-hash 'md5
163                                          (concat challengeData randomString)
164                                          nil nil t))
165           (setq sessionHash (substring sessionHash 0 8))
166
167           (setq lmRespData (concat randomString (make-string 16 0)))
168           (setq ntRespData (ntlm-smb-owf-encrypt
169                             (cadr password-hashes) sessionHash)))
170       (progn
171         ;; generate response data
172         (setq lmRespData
173               (ntlm-smb-owf-encrypt (car password-hashes) challengeData))
174         (setq ntRespData
175               (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData))))
176
177     ;; get offsets to fields to pack the response struct in a string
178     (setq lu (length user))
179     (setq ld (length domain))
180     (setq off-lm 64)                    ;offset to string 'lmResponse
181     (setq off-nt (+ 64 24))             ;offset to string 'ntResponse
182     (setq off-d (+ 64 48))              ;offset to string 'uDomain
183     (setq off-u (+ 64 48 (* 2 ld)))     ;offset to string 'uUser
184     (setq off-w (+ 64 48 (* 2 (+ ld lu)))) ;offset to string 'uWks
185     (setq off-s (+ 64 48 (* 2 (+ ld lu lu)))) ;offset to string 'sessionKey
186     ;; pack the response struct in a string
187     (concat "NTLMSSP\0"                 ;response ident field, 8 bytes
188             (md4-pack-int32 '(0 . 3))   ;response msgType field, 4 bytes
189
190             ;; lmResponse field, 8 bytes
191             ;;AddBytes(response,lmResponse,lmRespData,24);
192             (md4-pack-int16 24)         ;len field
193             (md4-pack-int16 24)         ;maxlen field
194             (md4-pack-int32 (cons 0 off-lm)) ;field offset
195
196             ;; ntResponse field, 8 bytes
197             ;;AddBytes(response,ntResponse,ntRespData,24);
198             (md4-pack-int16 24)         ;len field
199             (md4-pack-int16 24)         ;maxlen field
200             (md4-pack-int32 (cons 0 off-nt)) ;field offset
201
202             ;; uDomain field, 8 bytes
203             ;;AddUnicodeString(response,uDomain,domain);
204             ;;AddBytes(response, uDomain, udomain, 2*ld);
205             (md4-pack-int16 (* 2 ld))   ;len field
206             (md4-pack-int16 (* 2 ld))   ;maxlen field
207             (md4-pack-int32 (cons 0 off-d)) ;field offset
208
209             ;; uUser field, 8 bytes
210             ;;AddUnicodeString(response,uUser,u);
211             ;;AddBytes(response, uUser, uuser, 2*lu);
212             (md4-pack-int16 (* 2 lu))   ;len field
213             (md4-pack-int16 (* 2 lu))   ;maxlen field
214             (md4-pack-int32 (cons 0 off-u)) ;field offset
215
216             ;; uWks field, 8 bytes
217             ;;AddUnicodeString(response,uWks,u);
218             (md4-pack-int16 (* 2 lu))   ;len field
219             (md4-pack-int16 (* 2 lu))   ;maxlen field
220             (md4-pack-int32 (cons 0 off-w)) ;field offset
221
222             ;; sessionKey field, 8 bytes
223             ;;AddString(response,sessionKey,NULL);
224             (md4-pack-int16 0)          ;len field
225             (md4-pack-int16 0)          ;maxlen field
226             (md4-pack-int32 (cons 0 (- off-s off-lm))) ;field offset
227
228             ;; flags field, 4 bytes
229             flags                       ;
230
231             ;; buffer field
232             lmRespData                  ;lmResponse, 24 bytes
233             ntRespData                  ;ntResponse, 24 bytes
234             (ntlm-ascii2unicode domain  ;Unicode domain string, 2*ld bytes
235                                 (length domain)) ;
236             (ntlm-ascii2unicode user    ;Unicode user string, 2*lu bytes
237                                 (length user)) ;
238             (ntlm-ascii2unicode user    ;Unicode user string, 2*lu bytes
239                                 (length user)) ;
240             )))
241
242 (defun ntlm-get-password-hashes (password)
243   "Return a pair of SMB hash and NT MD4 hash of the given password PASSWORD."
244   (list (ntlm-smb-passwd-hash password)
245         (ntlm-md4hash password)))
246
247 (defun ntlm-ascii2unicode (str len)
248   "Convert an ASCII string into a NT Unicode string, which is
249 little-endian utf16."
250   (let ((utf (make-string (* 2 len) 0)) (i 0) val)
251     (while (and (< i len)
252                 (not (zerop (setq val (aref str i)))))
253       (aset utf (* 2 i) val)
254       (aset utf (1+ (* 2 i)) 0)
255       (setq i (1+ i)))
256     utf))
257
258 (defun ntlm-unicode2ascii (str len)
259   "Extract 7 bits ASCII part of a little endian utf16 string STR of length LEN."
260   (let ((buf (make-string len 0)) (i 0) (j 0))
261     (while (< i len)
262       (aset buf i (logand (aref str j) 127)) ;(string-to-number "7f" 16)
263       (setq i (1+ i)
264             j (+ 2 j)))
265     buf))
266
267 (defun ntlm-smb-passwd-hash (passwd)
268   "Return the SMB password hash string of 16 bytes long for the given password
269 string PASSWD.  PASSWD is truncated to 14 bytes if longer."
270   (let ((len (min (length passwd) 14)))
271     (ntlm-smb-des-e-p16
272      (concat (substring (upcase passwd) 0 len) ;fill top 14 bytes with passwd
273              (make-string (- 15 len) 0)))))
274
275 (defun ntlm-smb-owf-encrypt (passwd c8)
276   "Return the response string of 24 bytes long for the given password
277 string PASSWD based on the DES encryption.  PASSWD is of at most 14
278 bytes long and the challenge string C8 of 8 bytes long."
279   (let ((len (min (length passwd) 16)) p22)
280     (setq p22 (concat (substring passwd 0 len) ;fill top 16 bytes with passwd
281                       (make-string (- 22 len) 0)))
282     (ntlm-smb-des-e-p24 p22 c8)))
283
284 (defun ntlm-smb-des-e-p24 (p22 c8)
285   "Return a 24 bytes hashed string for a 21 bytes string P22 and a 8 bytes
286 string C8."
287   (concat (ntlm-smb-hash c8 p22 t)              ;hash first 8 bytes of p22
288           (ntlm-smb-hash c8 (substring p22 7) t)
289           (ntlm-smb-hash c8 (substring p22 14) t)))
290
291 (defconst ntlm-smb-sp8 [75 71 83 33 64 35 36 37])
292
293 (defun ntlm-smb-des-e-p16 (p15)
294   "Return a 16 bytes hashed string for a 15 bytes string P15."
295   (concat (ntlm-smb-hash ntlm-smb-sp8 p15 t)    ;hash of first 8 bytes of p15
296           (ntlm-smb-hash ntlm-smb-sp8           ;hash of last 8 bytes of p15
297                          (substring p15 7) t)))
298
299 (defun ntlm-smb-hash (in key forw)
300   "Return the hash string of length 8 for a string IN of length 8 and
301 a string KEY of length 8.  FORW is t or nil."
302   (let ((out (make-string 8 0))
303         outb                            ;string of length 64
304         (inb (make-string 64 0))
305         (keyb (make-string 64 0))
306         (key2 (ntlm-smb-str-to-key key))
307         (i 0) aa)
308     (while (< i 64)
309       (unless (zerop (logand (aref in (/ i 8)) (lsh 1 (- 7 (% i 8)))))
310         (aset inb i 1))
311       (unless (zerop (logand (aref key2 (/ i 8)) (lsh 1 (- 7 (% i 8)))))
312         (aset keyb i 1))
313       (setq i (1+ i)))
314     (setq outb (ntlm-smb-dohash inb keyb forw))
315     (setq i 0)
316     (while (< i 64)
317       (unless (zerop (aref outb i))
318         (setq aa (aref out (/ i 8)))
319         (aset out (/ i 8)
320               (logior aa (lsh 1 (- 7 (% i 8))))))
321       (setq i (1+ i)))
322     out))
323
324 (defun ntlm-smb-str-to-key (str)
325   "Return a string of length 8 for the given string STR of length 7."
326   (let ((key (make-string 8 0))
327         (i 7))
328     (aset key 0 (lsh (aref str 0) -1))
329     (aset key 1 (logior
330                  (lsh (logand (aref str 0) 1) 6)
331                  (lsh (aref str 1) -2)))
332     (aset key 2 (logior
333                  (lsh (logand (aref str 1) 3) 5)
334                  (lsh (aref str 2) -3)))
335     (aset key 3 (logior
336                  (lsh (logand (aref str 2) 7) 4)
337                  (lsh (aref str 3) -4)))
338     (aset key 4 (logior
339                  (lsh (logand (aref str 3) 15) 3)
340                  (lsh (aref str 4) -5)))
341     (aset key 5 (logior
342                  (lsh (logand (aref str 4) 31) 2)
343                  (lsh (aref str 5) -6)))
344     (aset key 6 (logior
345                  (lsh (logand (aref str 5) 63) 1)
346                  (lsh (aref str 6) -7)))
347     (aset key 7 (logand (aref str 6) 127))
348     (while (>= i 0)
349       (aset key i (lsh (aref key i) 1))
350       (setq i (1- i)))
351     key))
352
353 (defconst ntlm-smb-perm1 [57 49 41 33 25 17  9
354                      1 58 50 42 34 26 18
355                      10  2 59 51 43 35 27
356                      19 11  3 60 52 44 36
357                      63 55 47 39 31 23 15
358                      7 62 54 46 38 30 22
359                      14  6 61 53 45 37 29
360                      21 13  5 28 20 12  4])
361
362 (defconst ntlm-smb-perm2 [14 17 11 24  1  5
363                      3 28 15  6 21 10
364                      23 19 12  4 26  8
365                      16  7 27 20 13  2
366                      41 52 31 37 47 55
367                      30 40 51 45 33 48
368                      44 49 39 56 34 53
369                      46 42 50 36 29 32])
370
371 (defconst ntlm-smb-perm3 [58 50 42 34 26 18 10  2
372                      60 52 44 36 28 20 12  4
373                      62 54 46 38 30 22 14  6
374                      64 56 48 40 32 24 16  8
375                      57 49 41 33 25 17  9  1
376                      59 51 43 35 27 19 11  3
377                      61 53 45 37 29 21 13  5
378                      63 55 47 39 31 23 15  7])
379
380 (defconst ntlm-smb-perm4 [32  1  2  3  4  5
381                      4  5  6  7  8  9
382                      8  9 10 11 12 13
383                      12 13 14 15 16 17
384                      16 17 18 19 20 21
385                      20 21 22 23 24 25
386                      24 25 26 27 28 29
387                      28 29 30 31 32  1])
388
389 (defconst ntlm-smb-perm5 [16  7 20 21
390                      29 12 28 17
391                      1 15 23 26
392                      5 18 31 10
393                      2  8 24 14
394                      32 27  3  9
395                      19 13 30  6
396                      22 11  4 25])
397
398 (defconst ntlm-smb-perm6 [40  8 48 16 56 24 64 32
399                      39  7 47 15 55 23 63 31
400                      38  6 46 14 54 22 62 30
401                      37  5 45 13 53 21 61 29
402                      36  4 44 12 52 20 60 28
403                      35  3 43 11 51 19 59 27
404                      34  2 42 10 50 18 58 26
405                      33  1 41  9 49 17 57 25])
406
407 (defconst ntlm-smb-sc [1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 1])
408
409 (defconst ntlm-smb-sbox [[[14  4 13  1  2 15 11  8  3 10  6 12  5  9  0  7]
410                      [ 0 15  7  4 14  2 13  1 10  6 12 11  9  5  3  8]
411                      [ 4  1 14  8 13  6  2 11 15 12  9  7  3 10  5  0]
412                      [15 12  8  2  4  9  1  7  5 11  3 14 10  0  6 13]]
413                     [[15  1  8 14  6 11  3  4  9  7  2 13 12  0  5 10]
414                      [ 3 13  4  7 15  2  8 14 12  0  1 10  6  9 11  5]
415                      [ 0 14  7 11 10  4 13  1  5  8 12  6  9  3  2 15]
416                      [13  8 10  1  3 15  4  2 11  6  7 12  0  5 14  9]]
417                     [[10  0  9 14  6  3 15  5  1 13 12  7 11  4  2  8]
418                      [13  7  0  9  3  4  6 10  2  8  5 14 12 11 15  1]
419                      [13  6  4  9  8 15  3  0 11  1  2 12  5 10 14  7]
420                      [ 1 10 13  0  6  9  8  7  4 15 14  3 11  5  2 12]]
421                     [[ 7 13 14  3  0  6  9 10  1  2  8  5 11 12  4 15]
422                      [13  8 11  5  6 15  0  3  4  7  2 12  1 10 14  9]
423                      [10  6  9  0 12 11  7 13 15  1  3 14  5  2  8  4]
424                      [ 3 15  0  6 10  1 13  8  9  4  5 11 12  7  2 14]]
425                     [[ 2 12  4  1  7 10 11  6  8  5  3 15 13  0 14  9]
426                      [14 11  2 12  4  7 13  1  5  0 15 10  3  9  8  6]
427                      [ 4  2  1 11 10 13  7  8 15  9 12  5  6  3  0 14]
428                      [11  8 12  7  1 14  2 13  6 15  0  9 10  4  5  3]]
429                     [[12  1 10 15  9  2  6  8  0 13  3  4 14  7  5 11]
430                      [10 15  4  2  7 12  9  5  6  1 13 14  0 11  3  8]
431                      [ 9 14 15  5  2  8 12  3  7  0  4 10  1 13 11  6]
432                      [ 4  3  2 12  9  5 15 10 11 14  1  7  6  0  8 13]]
433                     [[ 4 11  2 14 15  0  8 13  3 12  9  7  5 10  6  1]
434                      [13  0 11  7  4  9  1 10 14  3  5 12  2 15  8  6]
435                      [ 1  4 11 13 12  3  7 14 10 15  6  8  0  5  9  2]
436                      [ 6 11 13  8  1  4 10  7  9  5  0 15 14  2  3 12]]
437                     [[13  2  8  4  6 15 11  1 10  9  3 14  5  0 12  7]
438                      [ 1 15 13  8 10  3  7  4 12  5  6 11  0 14  9  2]
439                      [ 7 11  4  1  9 12 14  2  0  6 10 13 15  3  5  8]
440                      [ 2  1 14  7  4 10  8 13 15 12  9  0  3  5  6 11]]])
441
442 (defsubst ntlm-string-permute (in perm n)
443   "Return a string of length N for a string IN and a permutation vector
444 PERM of size N.  The length of IN should be height of PERM."
445   (let ((i 0) (out (make-string n 0)))
446     (while (< i n)
447       (aset out i (aref in (- (aref perm i) 1)))
448       (setq i (1+ i)))
449     out))
450
451 (defsubst ntlm-string-lshift (str count len)
452   "Return a string by circularly shifting a string STR by COUNT to the left.
453 length of STR is LEN."
454   (let ((c (% count len)))
455     (concat (substring str c len) (substring str 0 c))))
456
457 (defsubst ntlm-string-xor (in1 in2 n)
458   "Return exclusive-or of sequences in1 and in2"
459   (let ((w (make-string n 0)) (i 0))
460     (while (< i n)
461       (aset w i (logxor (aref in1 i) (aref in2 i)))
462       (setq i (1+ i)))
463     w))
464
465 (defun ntlm-smb-dohash (in key forw)
466   "Return the hash value for a string IN and a string KEY.
467 Length of IN and KEY are 64.  FORW non-nil means forward, nil means
468 backward."
469   (let (pk1                             ;string of length 56
470         c                               ;string of length 28
471         d                               ;string of length 28
472         cd                              ;string of length 56
473         (ki (make-vector 16 0))         ;vector of string of length 48
474         pd1                             ;string of length 64
475         l                               ;string of length 32
476         r                               ;string of length 32
477         rl                              ;string of length 64
478         (i 0) (j 0) (k 0))
479     (setq pk1 (ntlm-string-permute key ntlm-smb-perm1 56))
480     (setq c (substring pk1 0 28))
481     (setq d (substring pk1 28 56))
482
483     (setq i 0)
484     (while (< i 16)
485       (setq c (ntlm-string-lshift c (aref ntlm-smb-sc i) 28))
486       (setq d (ntlm-string-lshift d (aref ntlm-smb-sc i) 28))
487       (setq cd (concat (substring c 0 28) (substring d 0 28)))
488       (aset ki i (ntlm-string-permute cd ntlm-smb-perm2 48))
489       (setq i (1+ i)))
490
491     (setq pd1 (ntlm-string-permute in ntlm-smb-perm3 64))
492
493     (setq l (substring pd1 0 32))
494     (setq r (substring pd1 32 64))
495
496     (setq i 0)
497     (let (er                            ;string of length 48
498           erk                           ;string of length 48
499           (b (make-vector 8 0))         ;vector of strings of length 6
500           cb                            ;string of length 32
501           pcb                           ;string of length 32
502           r2                            ;string of length 32
503           jj m n bj sbox-jmn)
504       (while (< i 16)
505         (setq er (ntlm-string-permute r ntlm-smb-perm4 48))
506         (setq erk (ntlm-string-xor er
507                        (aref ki (if forw i (- 15 i)))
508                        48))
509         (setq j 0)
510         (while (< j 8)
511           (setq jj (* 6 j))
512           (aset b j (substring erk jj (+ jj 6)))
513           (setq j (1+ j)))
514         (setq j 0)
515         (while (< j 8)
516           (setq bj (aref b j))
517           (setq m (logior (lsh (aref bj 0) 1) (aref bj 5)))
518           (setq n (logior (lsh (aref bj 1) 3)
519                           (lsh (aref bj 2) 2)
520                           (lsh (aref bj 3) 1)
521                           (aref bj 4)))
522           (setq k 0)
523           (setq sbox-jmn (aref (aref (aref ntlm-smb-sbox j) m) n))
524           (while (< k 4)
525             (aset bj k
526                   (if (zerop (logand sbox-jmn (lsh 1 (- 3 k))))
527                       0 1))
528             (setq k (1+ k)))
529           (setq j (1+ j)))
530
531         (setq j 0)
532         (setq cb nil)
533         (while (< j 8)
534           (setq cb (concat cb (substring (aref b j) 0 4)))
535           (setq j (1+ j)))
536
537         (setq pcb (ntlm-string-permute cb ntlm-smb-perm5 32))
538         (setq r2 (ntlm-string-xor l pcb 32))
539         (setq l r)
540         (setq r r2)
541         (setq i (1+ i))))
542     (setq rl (concat r l))
543     (ntlm-string-permute rl ntlm-smb-perm6 64)))
544
545 (defun ntlm-md4hash (passwd)
546   "Return the 16 bytes MD4 hash of a string PASSWD after converting it
547 into a Unicode string.  PASSWD is truncated to 128 bytes if longer."
548   (let (len wpwd)
549     ;; Password cannot be longer than 128 characters
550     (setq len (length passwd))
551     (if (> len 128)
552         (setq len 128))
553     ;; Password must be converted to NT Unicode
554     (setq wpwd (ntlm-ascii2unicode passwd len))
555     ;; Calculate length in bytes
556     (setq len (* len 2))
557     (md4 wpwd len)))
558
559 (provide 'ntlm)
560
561 ;;; ntlm.el ends here