X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/35668bfd4f74e7bc0d5bc83ceb310ea6b93ea3e3..f10533854f4c7bb54247a11981191bf37b70cb36:/packages/url-http-ntlm/url-http-ntlm.el

diff --git a/packages/url-http-ntlm/url-http-ntlm.el b/packages/url-http-ntlm/url-http-ntlm.el
index 026a73912..58622ad48 100644
--- a/packages/url-http-ntlm/url-http-ntlm.el
+++ b/packages/url-http-ntlm/url-http-ntlm.el
@@ -1,12 +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.2
 ;; Keywords: comm, data, processes, hypermedia
 ;; Homepage: https://code.google.com/p/url-http-ntlm/
-;; Package-Requires: ((ntlm "2.0.0"))
+;; 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
@@ -40,6 +41,7 @@
 ;;; Code:
 (require 'url-auth)
 (require 'url-http)
+(require 'url-util)
 (require 'mail-parse)
 (require 'cl-lib)
 (require 'ntlm)
@@ -47,9 +49,25 @@
 ;; Remove authorization after redirect.
 (when (and (boundp 'emacs-major-version)
 	   (< emacs-major-version 25))
-  (require (intern (format "url-http-ntlm-parse-headers-%d.%d"
-			   emacs-major-version
-			   emacs-minor-version))))
+  (defvar url-http-ntlm--parsing-headers nil)
+  (defadvice url-http-parse-headers (around clear-authorization activate)
+    (let ((url-http-ntlm--parsing-headers t))
+      ad-do-it))
+  (defadvice url-http-handle-authentication (around clear-authorization
+						    activate)
+    (let ((url-http-ntlm--parsing-headers nil))
+      ad-do-it))
+  (defadvice url-retrieve-internal (before clear-authorization activate)
+    (when (and url-http-ntlm--parsing-headers
+	       (eq url-request-extra-headers url-http-extra-headers))
+      ;; This retrieval is presumably in response to a redirect.
+      ;; Do not automatically include an authorization header in the
+      ;; redirect.  If needed it will be regenerated by the relevant
+      ;; auth scheme when the new request happens.
+      (setq url-http-extra-headers
+	    (cl-remove "Authorization"
+		       url-http-extra-headers :key #'car :test #'equal))
+      (setq url-request-extra-headers url-http-extra-headers))))
 
 
 ;;; Private variables.
@@ -134,7 +152,7 @@ PROMPT and ARGS come from `url-ntlm-auth''s caller,
 `url-get-authentication'.  Their meaning depends on the current
 implementation - this function is well and truly coupled.
 
-url-get-authentication' calls `url-ntlm-auth' once when checking
+`url-get-authentication' calls `url-ntlm-auth' once when checking
 what authentication schemes are supported (PROMPT and ARGS are
 nil), and then twice for every stage of the handshake: the first
 time PROMPT is nil, the second, t; ARGS contains the server
@@ -146,9 +164,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)))
@@ -259,6 +283,7 @@ 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