]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/url-http-ntlm/url-http-ntlm.el
url-http-ntlm.el: Bump version to 2.0.1
[gnu-emacs-elpa] / packages / url-http-ntlm / url-http-ntlm.el
index c0af6dda19eb4927f13ecccb29d4190e02a5157a..a1e1663b86e2174ee588682412560201a3329983 100644 (file)
@@ -1,10 +1,13 @@
 ;;; url-http-ntlm.el --- NTLM authentication for the url library
 
-;; Copyright (C) 2008, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2016 Free Software Foundation, Inc.
 
 ;; Author: Tom Schutzer-Weissmann <tom.weissmann@gmail.com>
 ;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
+;; Version: 2.0.1
 ;; Keywords: comm, data, processes, hypermedia
+;; Homepage: https://code.google.com/p/url-http-ntlm/
+;; Package-Requires: ((cl-lib "0.5") (ntlm "2.0.0"))
 
 ;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -38,6 +41,7 @@
 ;;; Code:
 (require 'url-auth)
 (require 'url-http)
+(require 'url-util)
 (require 'mail-parse)
 (require 'cl-lib)
 (require 'ntlm)
@@ -59,7 +63,7 @@ hashes>\).
 The hashes are built using `ntlm-get-password-hashes'.")
 
 (defvar url-http-ntlm--last-args nil
-  "Stores the last `url-http-ntlm--get-stage' arguments and return value.
+  "The last `url-http-ntlm--get-stage' arguments and result.
 This is used to detect multiple calls.")
 (make-variable-buffer-local 'url-http-ntlm--last-args)
 
@@ -68,8 +72,7 @@ This is used to detect multiple calls.")
 Keys are urls, entries are (START-TIME . COUNTER).")
 
 (defvar url-http-ntlm--default-users nil
-  "An alist that maps each server to the default username for
-that server.")
+  "An alist that stores one default username per server.")
 
 \f
 ;;; Private functions.
@@ -89,7 +92,7 @@ that server.")
                  (puthash url-string (cons start-time (1+ counter))
                           url-http-ntlm--loop-timer-counter)
                ;; Error detected, so remove entry and clear.
-               (url-http-ntlm--authorisation url-string :clear)
+               (url-http-ntlm--authorization url-string :clear)
                (remhash url-string url-http-ntlm--loop-timer-counter)
                (error
                 (format (concat "Access rate to %s is too high,"
@@ -145,9 +148,15 @@ response's \"WWW-Authenticate\" header, munged by
         (auth-header      (assoc "Authorization" url-http-extra-headers))
         (case-fold-search t)
         stage)
+    (url-debug 'url-http-ntlm "Buffer: %s" (current-buffer))
+    (url-debug 'url-http-ntlm "Arguments: %s" args)
+    (url-debug 'url-http-ntlm "Previous arguments: %s" url-http-ntlm--last-args)
     (if (eq args (car url-http-ntlm--last-args))
        ;; multiple calls, return the same argument we returned last time
-       (cdr url-http-ntlm--last-args)
+       (progn
+         (url-debug 'url-http-ntlm "Returning previous result: %s"
+                    (cdr url-http-ntlm--last-args))
+         (cdr url-http-ntlm--last-args))
       (let ((stage
             (cond ((and auth-header (string-match response-rxp
                                                   (cdr auth-header)))
@@ -164,7 +173,7 @@ response's \"WWW-Authenticate\" header, munged by
        (setq url-http-ntlm--last-args (cons args stage))
        stage))))
 
-(defun url-http-ntlm--authorisation (url &optional clear realm)
+(defun url-http-ntlm--authorization (url &optional clear realm)
   "Get or clear NTLM authentication details for URL.
 If CLEAR is non-nil, clear any saved credentials for server.
 Otherwise, return the credentials, prompting the user if
@@ -197,12 +206,14 @@ stored credentials are not affected."
              (and stored user (not (equal user (cl-second (car stored)))))
              (not stored))
          (let* ((user* (or user
+                           (url-do-auth-source-search server type :user)
                            (read-string (url-auth-user-prompt url realm)
                                         (or user (user-real-login-name)))))
                 (pass* (if both
                            pass
-                         (read-passwd (format "Password [for %s]: "
-                                              (url-recreate-url url)))))
+                         (or (url-do-auth-source-search server type :secret)
+                             (read-passwd (format "Password [for %s]: "
+                                                  (url-recreate-url url))))))
                 (key   (list type user* server port))
                 (entry `(,key . (,(ntlm-get-password-hashes pass*)))))
            (unless both
@@ -220,7 +231,8 @@ stored credentials are not affected."
        stored))))
 
 (defun url-http-ntlm--get-challenge ()
-  "Return the NTLM Type-2 message in the WWW-Authenticate header, if present."
+  "Return the NTLM Type-2 message in the WWW-Authenticate header.
+Return nil if the NTLM Type-2 message is not present."
   (save-restriction
     (mail-narrow-to-head)
     (let ((www-authenticate (mail-fetch-field "www-authenticate")))
@@ -238,6 +250,7 @@ stored credentials are not affected."
 
 \f
 ;;; Public function called by `url-get-authentication'.
+;;;###autoload
 (defun url-ntlm-auth (url &optional prompt overwrite realm args)
   "Return an NTLM HTTP authorization header.
 Get the contents of the Authorization header for a HTTP response
@@ -254,12 +267,13 @@ the server's last response.  These are used by
   (url-http-ntlm--ensure-keepalive)
   (let* ((user-url (url-http-ntlm--ensure-user url))
         (stage (url-http-ntlm--get-stage args)))
+    (url-debug 'url-http-ntlm "Stage: %s" stage)
     (cl-case stage
       ;; NTLM Type 1 message: the request
       (:request
        (url-http-ntlm--detect-loop user-url)
        (cl-destructuring-bind (&optional key hash)
-          (url-http-ntlm--authorisation user-url nil realm)
+          (url-http-ntlm--authorization user-url nil realm)
         (when (cl-third key)
           (url-http-ntlm--string
            (ntlm-build-auth-request (cl-second key) (cl-third key))))))
@@ -268,16 +282,17 @@ the server's last response.  These are used by
        (url-http-ntlm--detect-loop user-url)
        (let ((challenge (url-http-ntlm--get-challenge)))
         (cl-destructuring-bind (key hash)
-            (url-http-ntlm--authorisation user-url nil realm)
+            (url-http-ntlm--authorization user-url nil realm)
           (url-http-ntlm--string
            (ntlm-build-auth-response challenge
                                      (cl-second key)
                                      hash)))))
       (:error
-       (url-http-ntlm--authorisation user-url :clear)))))
+       (url-http-ntlm--authorization user-url :clear)))))
 
 \f
 ;;; Register `url-ntlm-auth' HTTP authentication method.
+;;;###autoload
 (url-register-auth-scheme "ntlm" nil 8)
 
 (provide 'url-http-ntlm)