1 #lang racket 2 3 (provide authentication-credentials-defined? 4 make-auth-dispatch) 5 6 (require web-server/http 7 web-server/http/basic-auth) 8 9 (define ferti-user (make-parameter (getenv "FERTI_USER"))) 10 (define ferti-pass (make-parameter (getenv "FERTI_PASS"))) 11 12 (define (authentication-credentials-defined?) 13 (and (ferti-user) (ferti-pass))) 14 15 (define (make-auth-dispatch handler) 16 (if (authentication-credentials-defined?) 17 (lambda (req) 18 (if (authorized? req) 19 (handler req) 20 (unauthorized-response))) 21 (error 22 'authentication 23 "Undefined authentication credentials (FERTI_USER and FERTI_PASS environment variables)"))) 24 25 (define (authorized? req) 26 (match (request->basic-credentials req) 27 [(cons user-b pass-b) 28 (define user (bytes->string/utf-8 user-b)) 29 (define pass (bytes->string/utf-8 pass-b)) 30 (and (string=? user (ferti-user)) (string=? pass (ferti-pass)))] 31 [_ #f])) 32 33 (define (unauthorized-response) 34 (response 401 35 #"Unauthorized" 36 (current-seconds) 37 TEXT/HTML-MIME-TYPE 38 (list (make-basic-auth-header (format "Basic Auth Test: ~a" (gensym)))) 39 void)) 40