refactoring volgens skill
This commit is contained in:
+76
-57
@@ -3,6 +3,7 @@
|
||||
(require crypto
|
||||
crypto/argon2
|
||||
net/private/ip
|
||||
racket/contract
|
||||
racket/list
|
||||
racket/random
|
||||
racket/string
|
||||
@@ -58,7 +59,8 @@
|
||||
; post : No module state is changed.
|
||||
; result : A salted Argon2id hash encoded as a string.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (make-password-hash password)
|
||||
(define/contract (make-password-hash password)
|
||||
(-> string? string?)
|
||||
(unless (and (string? password)
|
||||
(>= (string-length password) 12))
|
||||
(raise-argument-error
|
||||
@@ -75,10 +77,11 @@
|
||||
; post : No module state is changed.
|
||||
; result : #t only when both values are strings and the password matches.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (password-hash-valid? password encoded)
|
||||
(define/contract (password-hash-valid? password encoded)
|
||||
(-> any/c any/c boolean?)
|
||||
(and (string? password)
|
||||
(string? encoded)
|
||||
(with-handlers ((exn:fail? (lambda (_) #f)))
|
||||
(with-handlers ((exn:fail? (λ (_) #f)))
|
||||
(pwhash-verify password-kdf
|
||||
(string->bytes/utf-8 password)
|
||||
encoded))))
|
||||
@@ -101,7 +104,7 @@
|
||||
(raise-argument-error 'make-auth-manager "IP address or CIDR network" value))
|
||||
(define address
|
||||
(with-handlers ((exn:fail?
|
||||
(lambda (_)
|
||||
(λ (_)
|
||||
(raise-argument-error
|
||||
'make-auth-manager
|
||||
"IP address or CIDR network"
|
||||
@@ -118,7 +121,7 @@
|
||||
(ip-network address prefix))
|
||||
|
||||
(define (network-contains? network address-string)
|
||||
(with-handlers ((exn:fail? (lambda (_) #f)))
|
||||
(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))
|
||||
@@ -140,7 +143,7 @@
|
||||
(bytes->string/utf-8 (header-value value)))))
|
||||
|
||||
(define (trusted-proxy? manager address)
|
||||
(ormap (lambda (network) (network-contains? network address))
|
||||
(ormap (λ (network) (network-contains? network address))
|
||||
(auth-manager-trusted-proxies manager)))
|
||||
|
||||
(define (request-address manager request)
|
||||
@@ -160,7 +163,8 @@
|
||||
; post : Manager remains unchanged.
|
||||
; result : #t when at least one configured user can log in, otherwise #f.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (auth-enabled? manager)
|
||||
(define/contract (auth-enabled? manager)
|
||||
(-> auth-manager? boolean?)
|
||||
(positive? (hash-count (auth-manager-users manager))))
|
||||
|
||||
(define (request-session-token request)
|
||||
@@ -183,7 +187,8 @@
|
||||
; result : "anonymous" when authentication is disabled, the normalized
|
||||
; username for a valid session, or #f when login is required.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (auth-request-user manager request)
|
||||
(define/contract (auth-request-user manager request)
|
||||
(-> auth-manager? request? (or/c #f string?))
|
||||
(cond
|
||||
((not (auth-enabled? manager)) "anonymous")
|
||||
(else
|
||||
@@ -192,7 +197,7 @@
|
||||
(and token
|
||||
(call-with-semaphore
|
||||
(auth-manager-lock manager)
|
||||
(lambda ()
|
||||
(λ ()
|
||||
(prune-sessions! manager now)
|
||||
(let ((value (hash-ref (auth-manager-sessions manager)
|
||||
token
|
||||
@@ -230,34 +235,39 @@
|
||||
; internals: Unknown users follow the same Argon2id verification path as known
|
||||
; users to reduce username-dependent timing differences.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (auth-login! manager request username password)
|
||||
(define address (request-address manager request))
|
||||
(define now (current-seconds))
|
||||
(define normalized (string-downcase (string-trim username)))
|
||||
(call-with-semaphore
|
||||
(auth-manager-lock manager)
|
||||
(lambda ()
|
||||
(if (failure-blocked? manager address now)
|
||||
'rate-limited
|
||||
(let* ((stored (hash-ref (auth-manager-users manager)
|
||||
normalized
|
||||
#f))
|
||||
(valid?
|
||||
(password-hash-valid?
|
||||
password
|
||||
(or stored dummy-password-hash))))
|
||||
(if (and stored valid?)
|
||||
(let ((token
|
||||
(bytes->hex-string (crypto-random-bytes 32))))
|
||||
(hash-remove! (auth-manager-failed manager) address)
|
||||
(prune-sessions! manager now)
|
||||
(hash-set! (auth-manager-sessions manager)
|
||||
token
|
||||
(session normalized now now))
|
||||
token)
|
||||
(begin
|
||||
(record-failure! manager address now)
|
||||
#f)))))))
|
||||
(define/contract (auth-login! manager request username password)
|
||||
(-> auth-manager?
|
||||
request?
|
||||
string?
|
||||
string?
|
||||
(or/c #f 'rate-limited string?))
|
||||
(let ((address (request-address manager request))
|
||||
(now (current-seconds))
|
||||
(normalized (string-downcase (string-trim username))))
|
||||
(call-with-semaphore
|
||||
(auth-manager-lock manager)
|
||||
(λ ()
|
||||
(if (failure-blocked? manager address now)
|
||||
'rate-limited
|
||||
(let* ((stored (hash-ref (auth-manager-users manager)
|
||||
normalized
|
||||
#f))
|
||||
(valid?
|
||||
(password-hash-valid?
|
||||
password
|
||||
(or stored dummy-password-hash))))
|
||||
(if (and stored valid?)
|
||||
(let ((token
|
||||
(bytes->hex-string (crypto-random-bytes 32))))
|
||||
(hash-remove! (auth-manager-failed manager) address)
|
||||
(prune-sessions! manager now)
|
||||
(hash-set! (auth-manager-sessions manager)
|
||||
token
|
||||
(session normalized now now))
|
||||
token)
|
||||
(begin
|
||||
(record-failure! manager address now)
|
||||
#f))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : End the browser session named by the request cookie.
|
||||
@@ -265,12 +275,13 @@
|
||||
; post : The matching server-side session is removed when it exists.
|
||||
; result : Void.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (auth-logout! manager request)
|
||||
(define/contract (auth-logout! manager request)
|
||||
(-> auth-manager? request? void?)
|
||||
(let ((token (request-session-token request)))
|
||||
(when token
|
||||
(call-with-semaphore
|
||||
(auth-manager-lock manager)
|
||||
(lambda ()
|
||||
(λ ()
|
||||
(hash-remove! (auth-manager-sessions manager) token))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -280,7 +291,8 @@
|
||||
; result : A Secure, HttpOnly, SameSite=Strict Set-Cookie value whose Max-Age
|
||||
; equals the configured session lifetime.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (auth-session-cookie manager token)
|
||||
(define/contract (auth-session-cookie manager token)
|
||||
(-> auth-manager? string? bytes?)
|
||||
(string->bytes/utf-8
|
||||
(format
|
||||
"~a=~a; Path=/; Max-Age=~a; Secure; HttpOnly; SameSite=Strict"
|
||||
@@ -299,7 +311,8 @@
|
||||
; this half-life threshold prevents the one-second player poll from
|
||||
; returning Set-Cookie every second.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (auth-renewal-cookie manager request)
|
||||
(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)))
|
||||
@@ -308,17 +321,17 @@
|
||||
(auth-manager-lock manager)
|
||||
(λ ()
|
||||
(prune-sessions! manager now)
|
||||
(define 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)))))))))
|
||||
(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))))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Encode deletion of the browser session cookie.
|
||||
@@ -326,7 +339,8 @@
|
||||
; post : No module state is changed.
|
||||
; result : A Secure, HttpOnly, SameSite=Strict Set-Cookie value with Max-Age 0.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (auth-expired-cookie)
|
||||
(define/contract (auth-expired-cookie)
|
||||
(-> bytes?)
|
||||
(string->bytes/utf-8
|
||||
(format
|
||||
"~a=; Path=/; Max-Age=0; Secure; HttpOnly; SameSite=Strict"
|
||||
@@ -341,10 +355,15 @@
|
||||
; empty.
|
||||
; result : A new auth-manager with normalized usernames and parsed networks.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (make-auth-manager user-pairs
|
||||
#:trusted-proxies
|
||||
[trusted-proxy-values '("127.0.0.0/8" "::1/128")]
|
||||
#:session-seconds [session-seconds 604800])
|
||||
(define/contract (make-auth-manager
|
||||
user-pairs
|
||||
#:trusted-proxies
|
||||
[trusted-proxy-values '("127.0.0.0/8" "::1/128")]
|
||||
#:session-seconds [session-seconds 604800])
|
||||
(->* ((listof (cons/c string? string?)))
|
||||
(#:trusted-proxies (listof string?)
|
||||
#:session-seconds exact-positive-integer?)
|
||||
auth-manager?)
|
||||
(unless (exact-positive-integer? session-seconds)
|
||||
(raise-argument-error 'make-auth-manager "exact-positive-integer?"
|
||||
session-seconds))
|
||||
|
||||
Reference in New Issue
Block a user