refactoring
This commit is contained in:
+259
-158
@@ -2,7 +2,7 @@
|
||||
|
||||
(require crypto
|
||||
crypto/argon2
|
||||
net/private/ip
|
||||
net/ip
|
||||
racket/contract
|
||||
racket/list
|
||||
racket/random
|
||||
@@ -22,10 +22,16 @@
|
||||
auth-renewal-cookie
|
||||
auth-expired-cookie)
|
||||
|
||||
(struct ip-network (address prefix) #:transparent)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Internal data
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;; Holds one authenticated browser session and its two activity timestamps.
|
||||
(struct session
|
||||
(username [last-seen #:mutable] [last-cookie-renewal #:mutable])
|
||||
#:transparent)
|
||||
|
||||
;;; Holds the failed-login count and start time for one client address.
|
||||
(struct failures ([attempts #:mutable] [started #:mutable]) #:transparent)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -33,6 +39,8 @@
|
||||
; pre : Constructor fields contain normalized and parsed internal values.
|
||||
; post : Creating or recognizing a value does not change external state.
|
||||
; result : auth-manager? recognizes values used by the authentication API.
|
||||
; internals: users and trusted-proxies are immutable configuration references;
|
||||
; sessions and failed hold mutable login state protected by lock.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(struct auth-manager
|
||||
(users trusted-proxies session-seconds sessions failed lock)
|
||||
@@ -53,11 +61,20 @@
|
||||
(define failure-window-seconds 300)
|
||||
(define maximum-failures 5)
|
||||
|
||||
(define ipv4-mapped-prefix
|
||||
#"\0\0\0\0\0\0\0\0\0\0\377\377")
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Provided password functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Create an Argon2id password hash for configuration storage.
|
||||
; pre : Password is a string containing at least twelve characters.
|
||||
; post : No module state is changed.
|
||||
; result : A salted Argon2id hash encoded as a string.
|
||||
; internals: pwhash uses password-kdf with password-parameters to generate the
|
||||
; encoded hash, including its random salt and Argon2 parameters.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (make-password-hash password)
|
||||
(-> string? string?)
|
||||
@@ -76,125 +93,165 @@
|
||||
; pre : Password and encoded are arbitrary values.
|
||||
; post : No module state is changed.
|
||||
; result : #t only when both values are strings and the password matches.
|
||||
; internals: pwhash-verify checks the encoded Argon2id value. Malformed hashes
|
||||
; are treated as a failed match rather than escaping as exceptions.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (password-hash-valid? password encoded)
|
||||
(-> any/c any/c boolean?)
|
||||
(and (string? password)
|
||||
(string? encoded)
|
||||
(with-handlers ((exn:fail? (λ (_) #f)))
|
||||
(pwhash-verify password-kdf
|
||||
(string->bytes/utf-8 password)
|
||||
encoded))))
|
||||
(if (and (string? password) (string? encoded))
|
||||
(with-handlers ((exn:fail? (λ (_) #f)))
|
||||
(pwhash-verify password-kdf
|
||||
(string->bytes/utf-8 password)
|
||||
encoded))
|
||||
#f))
|
||||
|
||||
(define (normal-ip-bytes value)
|
||||
(define raw
|
||||
(ip-address->bytes (make-ip-address value)))
|
||||
;; Normalize IPv4-mapped IPv6 addresses to four bytes.
|
||||
(if (and (= (bytes-length raw) 16)
|
||||
(for/and ((index (in-range 10)))
|
||||
(zero? (bytes-ref raw index)))
|
||||
(= (bytes-ref raw 10) #xff)
|
||||
(= (bytes-ref raw 11) #xff))
|
||||
(subbytes raw 12)
|
||||
raw))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Supporting functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;; Parses an address and normalizes an IPv4-mapped IPv6 value to IPv4.
|
||||
(define (normal-ip-address value)
|
||||
(let* ((address (make-ip-address value))
|
||||
(raw (ip-address->bytes address))
|
||||
(ipv4-mapped?
|
||||
(and (= (bytes-length raw) 16)
|
||||
(bytes=? (subbytes raw 0 12) ipv4-mapped-prefix))))
|
||||
(if ipv4-mapped?
|
||||
(bytes->ipv4-address (subbytes raw 12))
|
||||
address)))
|
||||
|
||||
;;; Parses one configured IP address or CIDR value as a public net/ip network.
|
||||
(define (parse-network value)
|
||||
(define parts (string-split (string-trim value) "/"))
|
||||
(unless (member (length parts) '(1 2))
|
||||
(raise-argument-error 'make-auth-manager "IP address or CIDR network" value))
|
||||
(define address
|
||||
(with-handlers ((exn:fail?
|
||||
(λ (_)
|
||||
(raise-argument-error
|
||||
'make-auth-manager
|
||||
"IP address or CIDR network"
|
||||
value))))
|
||||
(normal-ip-bytes (car parts))))
|
||||
(define maximum (* 8 (bytes-length address)))
|
||||
(define prefix
|
||||
(if (= (length parts) 2)
|
||||
(string->number (cadr parts))
|
||||
maximum))
|
||||
(unless (and (exact-nonnegative-integer? prefix)
|
||||
(<= prefix maximum))
|
||||
(raise-argument-error 'make-auth-manager "IP address or CIDR network" value))
|
||||
(ip-network address prefix))
|
||||
(let ((parts (string-split (string-trim value) "/")))
|
||||
(unless (member (length parts) '(1 2))
|
||||
(raise-argument-error
|
||||
'make-auth-manager
|
||||
"IP address or CIDR network"
|
||||
value))
|
||||
(let* ((address
|
||||
(with-handlers ((exn:fail?
|
||||
(λ (_)
|
||||
(raise-argument-error
|
||||
'make-auth-manager
|
||||
"IP address or CIDR network"
|
||||
value))))
|
||||
(normal-ip-address (car parts))))
|
||||
(maximum (ip-address-size address))
|
||||
(prefix
|
||||
(if (= (length parts) 2)
|
||||
(string->number (cadr parts))
|
||||
maximum)))
|
||||
(unless (and (exact-nonnegative-integer? prefix)
|
||||
(<= prefix maximum))
|
||||
(raise-argument-error
|
||||
'make-auth-manager
|
||||
"IP address or CIDR network"
|
||||
value))
|
||||
(make-network address prefix))))
|
||||
|
||||
;;; Checks whether an address belongs to one configured trusted network.
|
||||
(define (network-contains? network address-string)
|
||||
(with-handlers ((exn:fail? (λ (_) #f)))
|
||||
(define candidate (normal-ip-bytes address-string))
|
||||
(define expected (ip-network-address network))
|
||||
(and (= (bytes-length candidate) (bytes-length expected))
|
||||
(let-values (((whole remainder)
|
||||
(quotient/remainder (ip-network-prefix network) 8)))
|
||||
(and (for/and ((index (in-range whole)))
|
||||
(= (bytes-ref candidate index)
|
||||
(bytes-ref expected index)))
|
||||
(or (zero? remainder)
|
||||
(let ((mask
|
||||
(bitwise-and #xff
|
||||
(arithmetic-shift #xff (- remainder 8)))))
|
||||
(= (bitwise-and (bytes-ref candidate whole) mask)
|
||||
(bitwise-and (bytes-ref expected whole) mask)))))))))
|
||||
(network-member network (normal-ip-address address-string))))
|
||||
|
||||
;;; Reads one request header as a UTF-8 string when present.
|
||||
(define (header-string request name)
|
||||
(let ((value (headers-assq* name (request-headers/raw request))))
|
||||
(and value
|
||||
(bytes->string/utf-8 (header-value value)))))
|
||||
|
||||
;;; Checks whether an address belongs to any configured trusted proxy network.
|
||||
(define (trusted-proxy? manager address)
|
||||
(ormap (λ (network) (network-contains? network address))
|
||||
(auth-manager-trusted-proxies manager)))
|
||||
|
||||
;;; Resolves the effective client address, honoring only a trusted proxy header.
|
||||
(define (request-address manager request)
|
||||
(define peer (request-client-ip request))
|
||||
(define forwarded
|
||||
(and (trusted-proxy? manager peer)
|
||||
(header-string request #"X-Forwarded-For")))
|
||||
(if forwarded
|
||||
;; A trusted reverse proxy appends the address it observed. Earlier
|
||||
;; values can have been supplied by the untrusted client.
|
||||
(string-trim (last (string-split forwarded ",")))
|
||||
peer))
|
||||
(let* ((peer (request-client-ip request))
|
||||
(forwarded
|
||||
(and (trusted-proxy? manager peer)
|
||||
(header-string request #"X-Forwarded-For"))))
|
||||
(if forwarded
|
||||
;; A trusted reverse proxy appends the address it observed. Earlier
|
||||
;; values can have been supplied by the untrusted client.
|
||||
(string-trim (last (string-split forwarded ",")))
|
||||
peer)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Extracts the session token from the request cookies when present.
|
||||
(define (request-session-token request)
|
||||
(let ((cookie
|
||||
(findf
|
||||
(λ (value)
|
||||
(string=? (client-cookie-name value) session-cookie-name))
|
||||
(request-cookies request))))
|
||||
(if cookie
|
||||
(client-cookie-value cookie)
|
||||
#f)))
|
||||
|
||||
;;; Removes every browser session whose idle lifetime has elapsed.
|
||||
(define (prune-sessions! manager now)
|
||||
(for-each
|
||||
(λ (token)
|
||||
(let ((value (hash-ref (auth-manager-sessions manager) token)))
|
||||
(when (> (- now (session-last-seen value))
|
||||
(auth-manager-session-seconds manager))
|
||||
(hash-remove! (auth-manager-sessions manager) token))))
|
||||
(hash-keys (auth-manager-sessions manager))))
|
||||
|
||||
;;; Checks and, when necessary, resets the failure window for one address.
|
||||
(define (failure-blocked? manager address now)
|
||||
(let ((value (hash-ref (auth-manager-failed manager) address #f)))
|
||||
(cond
|
||||
((eq? value #f) #f)
|
||||
((> (- now (failures-started value)) failure-window-seconds)
|
||||
(hash-remove! (auth-manager-failed manager) address)
|
||||
#f)
|
||||
(else
|
||||
(>= (failures-attempts value) maximum-failures)))))
|
||||
|
||||
;;; Adds one failed login to the current address window or starts a new window.
|
||||
(define (record-failure! manager address now)
|
||||
(let ((value (hash-ref (auth-manager-failed manager) address #f)))
|
||||
(if (and value
|
||||
(<= (- now (failures-started value)) failure-window-seconds))
|
||||
(set-failures-attempts! value (add1 (failures-attempts value)))
|
||||
(hash-set! (auth-manager-failed manager)
|
||||
address
|
||||
(failures 1 now)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Provided authentication functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Report whether browser authentication is configured.
|
||||
; pre : Manager is an auth-manager.
|
||||
; post : Manager remains unchanged.
|
||||
; result : #t when at least one configured user can log in, otherwise #f.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (auth-enabled? manager)
|
||||
(-> auth-manager? boolean?)
|
||||
(positive? (hash-count (auth-manager-users manager))))
|
||||
|
||||
(define (request-session-token request)
|
||||
(for/or ((cookie (in-list (request-cookies request))))
|
||||
(and (string=? (client-cookie-name cookie) session-cookie-name)
|
||||
(client-cookie-value cookie))))
|
||||
|
||||
(define (prune-sessions! manager now)
|
||||
(for ((token (in-list (hash-keys (auth-manager-sessions manager)))))
|
||||
(let ((value (hash-ref (auth-manager-sessions manager) token)))
|
||||
(when (> (- now (session-last-seen value))
|
||||
(auth-manager-session-seconds manager))
|
||||
(hash-remove! (auth-manager-sessions manager) token)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Resolve the browser user represented by a request cookie.
|
||||
; pre : Manager is an auth-manager and request is an HTTP request.
|
||||
; post : Expired sessions are removed and a valid session's last-seen time
|
||||
; is updated.
|
||||
; result : "anonymous" when authentication is disabled, the normalized
|
||||
; username for a valid session, or #f when login is required.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; internals: request-session-token finds the cookie. The manager lock protects
|
||||
; prune-sessions! and the session lookup; a valid lookup updates its
|
||||
; idle timestamp before returning the stored username.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (auth-request-user manager request)
|
||||
(-> auth-manager? request? (or/c #f string?))
|
||||
(cond
|
||||
((not (auth-enabled? manager)) "anonymous")
|
||||
(else
|
||||
(let ((token (request-session-token request))
|
||||
(now (current-seconds)))
|
||||
(and token
|
||||
(if (not (auth-enabled? manager))
|
||||
"anonymous"
|
||||
(let ((token (request-session-token request))
|
||||
(now (current-seconds)))
|
||||
(if (eq? token #f)
|
||||
#f
|
||||
(call-with-semaphore
|
||||
(auth-manager-lock manager)
|
||||
(λ ()
|
||||
@@ -202,28 +259,11 @@
|
||||
(let ((value (hash-ref (auth-manager-sessions manager)
|
||||
token
|
||||
#f)))
|
||||
(and value
|
||||
(begin
|
||||
(set-session-last-seen! value now)
|
||||
(session-username value)))))))))))
|
||||
|
||||
(define (failure-blocked? manager address now)
|
||||
(define value (hash-ref (auth-manager-failed manager) address #f))
|
||||
(and value
|
||||
(if (> (- now (failures-started value)) failure-window-seconds)
|
||||
(begin
|
||||
(hash-remove! (auth-manager-failed manager) address)
|
||||
#f)
|
||||
(>= (failures-attempts value) maximum-failures))))
|
||||
|
||||
(define (record-failure! manager address now)
|
||||
(define value (hash-ref (auth-manager-failed manager) address #f))
|
||||
(if (and value
|
||||
(<= (- now (failures-started value)) failure-window-seconds))
|
||||
(set-failures-attempts! value (+ 1 (failures-attempts value)))
|
||||
(hash-set! (auth-manager-failed manager)
|
||||
address
|
||||
(failures 1 now))))
|
||||
(if value
|
||||
(begin
|
||||
(set-session-last-seen! value now)
|
||||
(session-username value))
|
||||
#f))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Authenticate credentials and start a browser session.
|
||||
@@ -232,8 +272,11 @@
|
||||
; post : A valid login creates a new session; a failed login updates the
|
||||
; rate-limit state for the effective client address.
|
||||
; result : A new opaque token, #f for invalid credentials, or 'rate-limited.
|
||||
; internals: Unknown users follow the same Argon2id verification path as known
|
||||
; users to reduce username-dependent timing differences.
|
||||
; internals: request-address selects the rate-limit key and failure-blocked?
|
||||
; checks its window while the manager lock is held. Unknown users
|
||||
; verify against dummy-password-hash to reduce username-dependent
|
||||
; timing differences. Success creates a session; failure delegates
|
||||
; to record-failure!.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (auth-login! manager request username password)
|
||||
(-> auth-manager?
|
||||
@@ -274,6 +317,8 @@
|
||||
; pre : Manager is an auth-manager and request is an HTTP request.
|
||||
; post : The matching server-side session is removed when it exists.
|
||||
; result : Void.
|
||||
; internals: request-session-token finds the cookie and the manager lock
|
||||
; protects removal from the shared session hash.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (auth-logout! manager request)
|
||||
(-> auth-manager? request? void?)
|
||||
@@ -290,6 +335,8 @@
|
||||
; post : Manager remains unchanged.
|
||||
; result : A Secure, HttpOnly, SameSite=Strict Set-Cookie value whose Max-Age
|
||||
; equals the configured session lifetime.
|
||||
; internals: format combines session-cookie-name, token and the manager's
|
||||
; configured lifetime into the complete Set-Cookie header value.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (auth-session-cookie manager token)
|
||||
(-> auth-manager? string? bytes?)
|
||||
@@ -307,37 +354,48 @@
|
||||
; last-cookie-renewal time is advanced.
|
||||
; result : A fresh Set-Cookie value after half the configured lifetime has
|
||||
; elapsed, otherwise #f.
|
||||
; internals: The server idle timer moves on every authenticated request, while
|
||||
; this half-life threshold prevents the one-second player poll from
|
||||
; returning Set-Cookie every second.
|
||||
; internals: request-session-token identifies the session. The manager lock
|
||||
; protects prune-sessions! and the renewal timestamp. A half-life
|
||||
; threshold prevents the one-second player poll from returning a
|
||||
; new cookie every second.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (auth-renewal-cookie manager request)
|
||||
(-> auth-manager? request? (or/c #f bytes?))
|
||||
(and (auth-enabled? manager)
|
||||
(let ((token (request-session-token request))
|
||||
(now (current-seconds)))
|
||||
(and token
|
||||
(call-with-semaphore
|
||||
(auth-manager-lock manager)
|
||||
(λ ()
|
||||
(prune-sessions! manager now)
|
||||
(let ((value
|
||||
(hash-ref (auth-manager-sessions manager) token #f)))
|
||||
(and value
|
||||
(>= (- now (session-last-cookie-renewal value))
|
||||
(max 1
|
||||
(quotient
|
||||
(auth-manager-session-seconds manager)
|
||||
2)))
|
||||
(begin
|
||||
(set-session-last-cookie-renewal! value now)
|
||||
(auth-session-cookie manager token))))))))))
|
||||
(if (not (auth-enabled? manager))
|
||||
#f
|
||||
(let ((token (request-session-token request))
|
||||
(now (current-seconds)))
|
||||
(if (eq? token #f)
|
||||
#f
|
||||
(call-with-semaphore
|
||||
(auth-manager-lock manager)
|
||||
(λ ()
|
||||
(prune-sessions! manager now)
|
||||
(let ((value
|
||||
(hash-ref (auth-manager-sessions manager) token #f)))
|
||||
(if value
|
||||
(let* ((elapsed
|
||||
(- now
|
||||
(session-last-cookie-renewal value)))
|
||||
(renewal-interval
|
||||
(max 1
|
||||
(quotient
|
||||
(auth-manager-session-seconds manager)
|
||||
2))))
|
||||
(if (< elapsed renewal-interval)
|
||||
#f
|
||||
(begin
|
||||
(set-session-last-cookie-renewal! value now)
|
||||
(auth-session-cookie manager token))))
|
||||
#f))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Encode deletion of the browser session cookie.
|
||||
; pre : None.
|
||||
; post : No module state is changed.
|
||||
; result : A Secure, HttpOnly, SameSite=Strict Set-Cookie value with Max-Age 0.
|
||||
; internals: format uses session-cookie-name and an empty value to instruct the
|
||||
; browser to remove the cookie immediately.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (auth-expired-cookie)
|
||||
(-> bytes?)
|
||||
@@ -354,6 +412,10 @@
|
||||
; post : No external state is changed; session and rate-limit tables start
|
||||
; empty.
|
||||
; result : A new auth-manager with normalized usernames and parsed networks.
|
||||
; internals: Each user entry is validated and copied into a case-insensitive
|
||||
; hash. parse-network converts trusted-proxy-values through the
|
||||
; public net/ip API; fresh hashes and a semaphore protect sessions
|
||||
; and failed-login windows.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (make-auth-manager
|
||||
user-pairs
|
||||
@@ -367,33 +429,33 @@
|
||||
(unless (exact-positive-integer? session-seconds)
|
||||
(raise-argument-error 'make-auth-manager "exact-positive-integer?"
|
||||
session-seconds))
|
||||
(define users (make-hash))
|
||||
(for ((entry (in-list user-pairs)))
|
||||
(unless (and (pair? entry)
|
||||
(string? (car entry))
|
||||
(string? (cdr entry)))
|
||||
(raise-argument-error
|
||||
'make-auth-manager
|
||||
"(listof (cons/c string? string?))"
|
||||
user-pairs))
|
||||
(when (string=? (string-trim (car entry)) "")
|
||||
(raise-arguments-error
|
||||
'make-auth-manager
|
||||
"username must not be empty"
|
||||
"username" (car entry)))
|
||||
(unless (regexp-match? #px"^[$]argon2id[$]" (cdr entry))
|
||||
(raise-arguments-error
|
||||
'make-auth-manager
|
||||
"user password is not an Argon2id hash"
|
||||
"username" (car entry)))
|
||||
(hash-set! users (string-downcase (string-trim (car entry)))
|
||||
(cdr entry)))
|
||||
(auth-manager users
|
||||
(map parse-network trusted-proxy-values)
|
||||
session-seconds
|
||||
(make-hash)
|
||||
(make-hash)
|
||||
(make-semaphore 1)))
|
||||
(let ((users (make-hash)))
|
||||
(for-each
|
||||
(λ (entry)
|
||||
(let ((username (string-trim (car entry)))
|
||||
(password-hash (cdr entry)))
|
||||
(when (string=? username "")
|
||||
(raise-arguments-error
|
||||
'make-auth-manager
|
||||
"username must not be empty"
|
||||
"username" (car entry)))
|
||||
(unless (regexp-match? #px"^[$]argon2id[$]" password-hash)
|
||||
(raise-arguments-error
|
||||
'make-auth-manager
|
||||
"user password is not an Argon2id hash"
|
||||
"username" (car entry)))
|
||||
(hash-set! users (string-downcase username) password-hash)))
|
||||
user-pairs)
|
||||
(auth-manager users
|
||||
(map parse-network trusted-proxy-values)
|
||||
session-seconds
|
||||
(make-hash)
|
||||
(make-hash)
|
||||
(make-semaphore 1))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Tests for module users.rkt
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(module+ test
|
||||
(require net/url
|
||||
@@ -410,6 +472,20 @@
|
||||
(list (cons "Hans" test-hash))
|
||||
#:trusted-proxies '("127.0.0.1/32")))
|
||||
|
||||
(check-true
|
||||
(network-contains? (parse-network "192.0.2.0/24") "192.0.2.18"))
|
||||
(check-false
|
||||
(network-contains? (parse-network "192.0.2.0/24") "192.0.3.18"))
|
||||
(check-true
|
||||
(network-contains? (parse-network "2001:db8::/32") "2001:db8::12"))
|
||||
(check-true
|
||||
(network-contains? (parse-network "127.0.0.0/8")
|
||||
"0:0:0:0:0:ffff:7f00:1"))
|
||||
(check-exn exn:fail:contract?
|
||||
(λ () (parse-network "192.0.2.1/33")))
|
||||
(check-exn exn:fail:contract?
|
||||
(λ () (parse-network "not-an-address")))
|
||||
|
||||
(define (test-request peer [headers '()])
|
||||
(request #"GET" (string->url "http://example.test/api/state")
|
||||
headers (delay '()) #f "127.0.0.1" 80 peer))
|
||||
@@ -432,6 +508,13 @@
|
||||
"198.51.100.2"
|
||||
(list (header #"X-Forwarded-For" #"203.0.113.9"))))
|
||||
"198.51.100.2")
|
||||
(check-equal?
|
||||
(request-address
|
||||
manager
|
||||
(test-request
|
||||
"0:0:0:0:0:ffff:7f00:1"
|
||||
(list (header #"X-Forwarded-For" #"203.0.113.9"))))
|
||||
"203.0.113.9")
|
||||
(define token
|
||||
(auth-login! manager remote "hans" "correct horse battery staple"))
|
||||
(check-true (string? token))
|
||||
@@ -451,4 +534,22 @@
|
||||
(check-false (auth-renewal-cookie manager authenticated))
|
||||
(auth-logout! manager authenticated)
|
||||
(check-false (auth-request-user manager authenticated))
|
||||
(check-false (auth-login! manager remote "hans" "wrong password")))
|
||||
(check-false (auth-login! manager remote "hans" "wrong password"))
|
||||
|
||||
(let ((limited-manager (make-auth-manager '())))
|
||||
(for-each
|
||||
(λ (_) (record-failure! limited-manager "192.0.2.1" 100))
|
||||
(range maximum-failures))
|
||||
(check-true (failure-blocked? limited-manager "192.0.2.1" 100))
|
||||
(check-false
|
||||
(failure-blocked? limited-manager
|
||||
"192.0.2.1"
|
||||
(+ 101 failure-window-seconds))))
|
||||
|
||||
(let ((session-manager (make-auth-manager '() #:session-seconds 10)))
|
||||
(hash-set! (auth-manager-sessions session-manager)
|
||||
"expired"
|
||||
(session "hans" 0 0))
|
||||
(prune-sessions! session-manager 11)
|
||||
(check-false
|
||||
(hash-has-key? (auth-manager-sessions session-manager) "expired"))))
|
||||
|
||||
Reference in New Issue
Block a user