Created
June 21, 2012 08:39
-
-
Save bizenn/2964611 to your computer and use it in GitHub Desktop.
Authentication support on rfc.http, but only BASIC.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
diff --git a/lib/rfc/http.scm b/lib/rfc/http.scm | |
index e9f3fa4..b7eb9a0 100644 | |
--- a/lib/rfc/http.scm | |
+++ b/lib/rfc/http.scm | |
@@ -50,6 +50,7 @@ | |
(use srfi-13) | |
(use rfc.822) | |
(use rfc.uri) | |
+ (use rfc.base64) | |
(use gauche.net) | |
(use gauche.parameter) | |
(use gauche.charconv) | |
@@ -242,7 +243,7 @@ | |
[request-uri (ensure-request-uri request-uri enc)]) | |
(receive (code headers body) | |
(request-response method conn host request-uri sender receiver | |
- `(:user-agent ,user-agent ,@opts) enc) | |
+ `(:user-agent ,user-agent ,@(http-auth-headers conn) ,@opts) enc) | |
(or (and-let* ([ (not no-redirect) ] | |
[ (string-prefix? "3" code) ] | |
[h (case redirect-handler | |
@@ -778,5 +779,20 @@ | |
;; authentication handling | |
;; | |
+(define-method slot-unbound (_ (obj <http-connection>) name) | |
+ (case name | |
+ ((auth-handler auth-user auth-password) #f) | |
+ (else (next-method)))) | |
+ | |
+(define (http-auth-headers conn) | |
+ (or (and-let* ((auth-handler (ref conn 'auth-handler))) | |
+ (auth-handler conn)) | |
+ '())) | |
+ | |
+(define (http-basic-auth-handler conn) | |
+ (and-let* ((user (ref conn 'auth-user)) | |
+ (password (or (ref conn 'auth-user) ""))) | |
+ `(:authorization ,(format "Basic ~a" (base64-encode-string #`",|user|:,|password|"))))) | |
+ | |
;; dummy - to be written | |
-(define (http-default-auth-handler . _) #f) | |
+(define http-default-auth-handler http-basic-auth-handler) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment