[Emacs-diffs] master fc6004e: * lisp/net/ntlm.el: Use lexical-binding

[Stefan Monnier]

branch: master
commit fc6004e61760d3bd3e27b593c318e634a221652c
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * lisp/net/ntlm.el: Use lexical-binding
    
    (ntlm-string-as-unibyte): Remove.
    (ntlm-build-auth-response): Use encode-coding-string instead.
    (ntlm-build-auth-request, ntlm-build-auth-response, ntlm-ascii2unicode)
    (ntlm-smb-owf-encrypt, ntlm-smb-hash, ntlm-smb-dohash, ntlm-md4hash):
    Use fewer setq more Lisp-style.
---
 lisp/net/ntlm.el | 168 ++++++++++++++++++++++++++-----------------------------
 1 file changed, 79 insertions(+), 89 deletions(-)

diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index 7a68c68..142c375 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -1,4 +1,4 @@
-;;; ntlm.el --- NTLM (NT LanManager) authentication support
+;;; ntlm.el --- NTLM (NT LanManager) authentication support  -*- 
lexical-binding:t -*-
 
 ;; Copyright (C) 2001, 2007-2018 Free Software Foundation, Inc.
 
@@ -106,7 +106,7 @@ is not given."
        (request-flags (concat (make-string 1 7) (make-string 1 130)
                               (make-string 1 8) (make-string 1 0)))
                                        ;0x07 0x82 0x08 0x00
-       lu ld off-d off-u)
+       )
     (when (and user (string-match "@" user))
       (unless domain
        (setq domain (substring user (1+ (match-beginning 0)))))
@@ -115,10 +115,10 @@ is not given."
       ;; set "negotiate domain supplied" bit
       (aset request-flags 1 (logior (aref request-flags 1) ?\x10)))
     ;; set fields offsets within the request struct
-    (setq lu (length user))
-    (setq ld (length domain))
-    (setq off-u 32)                    ;offset to the string 'user
-    (setq off-d (+ 32 lu))             ;offset to the string 'domain
+    (let* ((lu (length user))
+           (ld (length domain))
+           (off-u 32)           ;offset to the string 'user
+           (off-d (+ 32 lu)))   ;offset to the string 'domain
     ;; pack the request struct in a string
     (concat request-ident                      ;8 bytes
            request-msgType                     ;4 bytes
@@ -131,24 +131,20 @@ is not given."
            (md4-pack-int32 (cons 0 off-d))     ;domain field, offset field
            user                                ;buffer field
            domain                              ;buffer field
-           )))
-
-(eval-when-compile
-  (defmacro ntlm-string-as-unibyte (string)
-    (if (fboundp 'string-as-unibyte)
-       `(string-as-unibyte ,string)
-      string)))
+           ))))
 
 (defun ntlm-compute-timestamp ()
   "Compute an NTLMv2 timestamp.
 Return a unibyte string representing the number of tenths of a
 microsecond since January 1, 1601 as a 64-bit little-endian
 signed integer."
+  ;; FIXME: This can likely be significantly simplified using the new
+  ;; bignums support!
   (let* ((s-to-tenths-of-us "mul(add(lsh($1,16),$2),10000000)")
         (us-to-tenths-of-us "mul($3,10)")
         (ps-to-tenths-of-us "idiv($4,100000)")
         (tenths-of-us-since-jan-1-1601
-         (apply 'calc-eval (concat "add(add(add("
+         (apply #'calc-eval (concat "add(add(add("
                                    s-to-tenths-of-us ","
                                    us-to-tenths-of-us "),"
                                    ps-to-tenths-of-us "),"
@@ -157,12 +153,12 @@ signed integer."
                                    "116444736000000000)")
                 'rawnum (encode-time nil 'list)))
         result-bytes)
-    (dotimes (byte 8)
+    (dotimes (_byte 8)
       (push (calc-eval "and($1,16#FF)" 'rawnum tenths-of-us-since-jan-1-1601)
            result-bytes)
       (setq tenths-of-us-since-jan-1-1601
            (calc-eval "rsh($1,8,64)" 'rawnum tenths-of-us-since-jan-1-1601)))
-    (apply 'unibyte-string (nreverse result-bytes))))
+    (apply #'unibyte-string (nreverse result-bytes))))
 
 (defun ntlm-generate-nonce ()
   "Generate a random nonce, not to be used more than once.
@@ -177,7 +173,13 @@ the NTLM based server for the user USER and the password 
hash list
 PASSWORD-HASHES.  NTLM uses two hash values which are represented
 by PASSWORD-HASHES.  PASSWORD-HASHES should be a return value of
  (list (ntlm-smb-passwd-hash password) (ntlm-md4hash password))"
-  (let* ((rchallenge (ntlm-string-as-unibyte challenge))
+  (let* ((rchallenge (if (multibyte-string-p challenge)
+                         (progn
+                           ;; FIXME: Maybe it would be better to
+                           ;; signal an error.
+                           (message "Incorrect challenge string type in 
ntlm-build-auth-response")
+                           (encode-coding-string challenge 'binary))
+                       challenge))
         ;; get fields within challenge struct
         ;;(ident (substring rchallenge 0 8))   ;ident, 8 bytes
         ;;(msgType (substring rchallenge 8 12))        ;msgType, 4 bytes
@@ -188,20 +190,16 @@ by PASSWORD-HASHES.  PASSWORD-HASHES should be a return 
value of
                                        ;0x07 0x82 0x08 0x00
         (flags (substring rchallenge 20 24))   ;flags, 4 bytes
         (challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes
-        uDomain-len uDomain-offs
-        ;; response struct and its fields
+         ;; Extract domain string from challenge string.
+        ;;(uDomain-len (md4-unpack-int16 (substring uDomain 0 2)))
+         (uDomain-offs (md4-unpack-int32 (substring uDomain 4 8)))
+        ;; Response struct and its fields.
         lmRespData                     ;lmRespData, 24 bytes
         ntRespData                     ;ntRespData, variable length
-        domain                         ;ascii domain string
-        workstation                    ;ascii workstation string
-        ll ln lu ld lw off-lm off-nt off-u off-d off-w)
-    ;; extract domain string from challenge string
-    (setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2)))
-    (setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8)))
-    ;; match Mozilla behavior, which is to send an empty domain string
-    (setq domain "")
-    ;; match Mozilla behavior, which is to send "WORKSTATION"
-    (setq workstation "WORKSTATION")
+         ;; Match Mozilla behavior, which is to send an empty domain string
+        (domain "")                    ;ascii domain string
+         ;; Match Mozilla behavior, which is to send "WORKSTATION".
+        (workstation "WORKSTATION"))    ;ascii workstation string
     ;; overwrite domain in case user is given in <user>@<domain> format
     (when (string-match "@" user)
       (setq domain (substring user (1+ (match-beginning 0))))
@@ -260,13 +258,11 @@ by PASSWORD-HASHES.  PASSWORD-HASHES should be a return 
value of
       ;; so just treat it the same as levels 0 and 1
       ;; check if "negotiate NTLM2 key" flag is set in type 2 message
       (if (not (zerop (logand (aref flags 2) 8)))
-         (let (randomString
-               sessionHash)
-           ;; generate NTLM2 session response data
-           (setq randomString (ntlm-generate-nonce))
-           (setq sessionHash (secure-hash 'md5
+         ;; generate NTLM2 session response data
+         (let* ((randomString (ntlm-generate-nonce))
+                (sessionHash (secure-hash 'md5
                                           (concat challengeData randomString)
-                                          nil nil t))
+                                          nil nil t)))
            (setq sessionHash (substring sessionHash 0 8))
            (setq lmRespData (concat randomString (make-string 16 0)))
            (setq ntRespData (ntlm-smb-owf-encrypt
@@ -278,16 +274,16 @@ by PASSWORD-HASHES.  PASSWORD-HASHES should be a return 
value of
              (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData))))
 
     ;; get offsets to fields to pack the response struct in a string
-    (setq ll (length lmRespData))
-    (setq ln (length ntRespData))
-    (setq lu (length user))
-    (setq ld (length domain))
-    (setq lw (length workstation))
-    (setq off-u 64)                    ;offset to string 'uUser
-    (setq off-d (+ off-u (* 2 lu)))    ;offset to string 'uDomain
-    (setq off-w (+ off-d (* 2 ld)))    ;offset to string 'uWks
-    (setq off-lm (+ off-w (* 2 lw)))   ;offset to string 'lmResponse
-    (setq off-nt (+ off-lm ll))                ;offset to string 'ntResponse
+    (let* ((ll (length lmRespData))
+           (ln (length ntRespData))
+           (lu (length user))
+           (ld (length domain))
+           (lw (length workstation))
+           (off-u 64)                  ;offset to string 'uUser
+           (off-d (+ off-u (* 2 lu)))  ;offset to string 'uDomain
+           (off-w (+ off-d (* 2 ld)))  ;offset to string 'uWks
+           (off-lm (+ off-w (* 2 lw))) ;offset to string 'lmResponse
+           (off-nt (+ off-lm ll)))      ;offset to string 'ntResponse
     ;; pack the response struct in a string
     (concat "NTLMSSP\0"                                ;response ident field, 
8 bytes
            (md4-pack-int32 '(0 . 3))           ;response msgType field, 4 bytes
@@ -341,7 +337,7 @@ by PASSWORD-HASHES.  PASSWORD-HASHES should be a return 
value of
            (ntlm-ascii2unicode workstation lw) ;Unicode workstation, 2*lw bytes
            lmRespData                          ;lmResponse, 24 bytes
            ntRespData                          ;ntResponse, ln bytes
-           )))
+           ))))
 
 (defun ntlm-get-password-hashes (password)
   "Return a pair of SMB hash and NT MD4 hash of the given password PASSWORD."
@@ -351,7 +347,10 @@ by PASSWORD-HASHES.  PASSWORD-HASHES should be a return 
value of
 (defun ntlm-ascii2unicode (str len)
   "Convert an ASCII string into a NT Unicode string, which is
 little-endian utf16."
-  (let ((utf (make-string (* 2 len) 0)) (i 0) val)
+  ;; FIXME: Can't we use encode-coding-string with a `utf-16le' coding system?
+  (let ((utf (make-string (* 2 len) 0))
+        (i 0)
+        val)
     (while (and (< i len)
                (not (zerop (setq val (aref str i)))))
       (aset utf (* 2 i) val)
@@ -380,9 +379,9 @@ string PASSWD.  PASSWD is truncated to 14 bytes if longer."
   "Return the response string of 24 bytes long for the given password
 string PASSWD based on the DES encryption.  PASSWD is of at most 14
 bytes long and the challenge string C8 of 8 bytes long."
-  (let ((len (min (length passwd) 16)) p22)
-    (setq p22 (concat (substring passwd 0 len) ;fill top 16 bytes with passwd
-                     (make-string (- 22 len) 0)))
+  (let* ((len (min (length passwd) 16))
+         (p22 (concat (substring passwd 0 len) ;Fill top 16 bytes with passwd.
+                     (make-string (- 22 len) 0))))
     (ntlm-smb-des-e-p24 p22 c8)))
 
 (defun ntlm-smb-des-e-p24 (p22 c8)
@@ -404,26 +403,26 @@ string C8."
   "Return the hash string of length 8 for a string IN of length 8 and
 a string KEY of length 8.  FORW is t or nil."
   (let ((out (make-string 8 0))
-       outb                            ;string of length 64
        (inb (make-string 64 0))
        (keyb (make-string 64 0))
        (key2 (ntlm-smb-str-to-key key))
-       (i 0) aa)
+       (i 0))
     (while (< i 64)
       (unless (zerop (logand (aref in (/ i 8)) (ash 1 (- 7 (% i 8)))))
        (aset inb i 1))
       (unless (zerop (logand (aref key2 (/ i 8)) (ash 1 (- 7 (% i 8)))))
        (aset keyb i 1))
       (setq i (1+ i)))
-    (setq outb (ntlm-smb-dohash inb keyb forw))
-    (setq i 0)
-    (while (< i 64)
-      (unless (zerop (aref outb i))
-       (setq aa (aref out (/ i 8)))
-       (aset out (/ i 8)
-             (logior aa (ash 1 (- 7 (% i 8))))))
-      (setq i (1+ i)))
-    out))
+    (let ((outb (ntlm-smb-dohash inb keyb forw))
+          aa)
+      (setq i 0)
+      (while (< i 64)
+        (unless (zerop (aref outb i))
+         (setq aa (aref out (/ i 8)))
+         (aset out (/ i 8)
+               (logior aa (ash 1 (- 7 (% i 8))))))
+        (setq i (1+ i)))
+      out)))
 
 (defun ntlm-smb-str-to-key (str)
   "Return a string of length 8 for the given string STR of length 7."
@@ -570,27 +569,22 @@ length of STR is LEN."
   "Return the hash value for a string IN and a string KEY.
 Length of IN and KEY are 64.  FORW non-nil means forward, nil means
 backward."
-  (let (pk1                            ;string of length 56
-       c                               ;string of length 28
-       d                               ;string of length 28
-       cd                              ;string of length 56
-       (ki (make-vector 16 0))         ;vector of string of length 48
-       pd1                             ;string of length 64
-       l                               ;string of length 32
-       r                               ;string of length 32
-       rl                              ;string of length 64
-       (i 0) (j 0) (k 0))
-    (setq pk1 (ntlm-string-permute key ntlm-smb-perm1 56))
-    (setq c (substring pk1 0 28))
-    (setq d (substring pk1 28 56))
-
-    (setq i 0)
-    (while (< i 16)
+  (let* ((pk1 (ntlm-string-permute key ntlm-smb-perm1 56)) ;string of length 56
+        (c (substring pk1 0 28))       ;string of length 28
+        (d (substring pk1 28 56))      ;string of length 28
+        cd                             ;string of length 56
+        (ki (make-vector 16 0))        ;vector of string of length 48
+        pd1                            ;string of length 64
+        l                              ;string of length 32
+        r                              ;string of length 32
+        rl                             ;string of length 64
+        (i 0) (j 0) (k 0))
+
+    (dotimes (i 16)
       (setq c (ntlm-string-lshift c (aref ntlm-smb-sc i) 28))
       (setq d (ntlm-string-lshift d (aref ntlm-smb-sc i) 28))
       (setq cd (concat (substring c 0 28) (substring d 0 28)))
-      (aset ki i (ntlm-string-permute cd ntlm-smb-perm2 48))
-      (setq i (1+ i)))
+      (aset ki i (ntlm-string-permute cd ntlm-smb-perm2 48)))
 
     (setq pd1 (ntlm-string-permute in ntlm-smb-perm3 64))
 
@@ -649,16 +643,12 @@ backward."
 (defun ntlm-md4hash (passwd)
   "Return the 16 bytes MD4 hash of a string PASSWD after converting it
 into a Unicode string.  PASSWD is truncated to 128 bytes if longer."
-  (let (len wpwd)
-    ;; Password cannot be longer than 128 characters
-    (setq len (length passwd))
-    (if (> len 128)
-       (setq len 128))
-    ;; Password must be converted to NT Unicode
-    (setq wpwd (ntlm-ascii2unicode passwd len))
-    ;; Calculate length in bytes
-    (setq len (* len 2))
-    (md4 wpwd len)))
+  (let* ((len (min (length passwd) 128)) ;Pwd can't be > than 128 characters.
+         ;; Password must be converted to NT Unicode.
+         (wpwd (ntlm-ascii2unicode passwd len)))
+    (md4 wpwd
+         ;; Calculate length in bytes.
+         (* len 2))))
 
 (provide 'ntlm)