hans/rkt-web-player
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

users need always login

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-28 13:19:30 +02:00
parent cd16e3ae42
commit 1316e49456
9 changed files with 129 additions and 96 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/users.rkt
+54 -31
View File
@@ -14,18 +14,20 @@
make-auth-manager
auth-manager?
auth-enabled?
auth-request-local?
auth-request-user
auth-login!
auth-logout!
auth-session-cookie
auth-renewal-cookie
auth-expired-cookie)
(struct ip-network (address prefix) #:transparent)
(struct session (username [last-seen #:mutable]) #:transparent)
(struct session
(username [last-seen #:mutable] [last-cookie-renewal #:mutable])
#:transparent)
(struct failures ([attempts #:mutable] [started #:mutable]) #:transparent)
(struct auth-manager
(users local-networks trusted-proxies session-seconds sessions failed lock)
(users trusted-proxies session-seconds sessions failed lock)
#:transparent)
(define password-kdf
@@ -136,11 +138,6 @@
(define (auth-enabled? manager)
(positive? (hash-count (auth-manager-users manager))))
(define (auth-request-local? manager request)
(ormap (lambda (network)
(network-contains? network (request-address manager request)))
(auth-manager-local-networks manager)))
(define (request-session-token request)
(for/or ((cookie (in-list (request-cookies request))))
(and (string=? (client-cookie-name cookie) session-cookie-name)
@@ -156,7 +153,6 @@
(define (auth-request-user manager request)
(cond
((not (auth-enabled? manager)) "anonymous")
((auth-request-local? manager request) "local")
(else
(let ((token (request-session-token request))
(now (current-seconds)))
@@ -215,7 +211,7 @@
(prune-sessions! manager now)
(hash-set! (auth-manager-sessions manager)
token
(session normalized now))
(session normalized now now))
token)
(begin
(record-failure! manager address now)
@@ -237,6 +233,30 @@
token
(auth-manager-session-seconds manager))))
;; Return a refreshed cookie at most once per half session lifetime. The
;; server-side inactivity timer is updated on every authenticated request, but
;; limiting Set-Cookie avoids rewriting it for every one-second player poll.
(define (auth-renewal-cookie manager request)
(and (auth-enabled? manager)
(let ((token (request-session-token request))
(now (current-seconds)))
(and token
(call-with-semaphore
(auth-manager-lock manager)
(lambda ()
(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)))))))))
(define (auth-expired-cookie)
(string->bytes/utf-8
(format
@@ -244,14 +264,9 @@
session-cookie-name)))
(define (make-auth-manager user-pairs
#:local-networks
[local-network-values
'("127.0.0.0/8" "::1/128"
"10.0.0.0/8" "172.16.0.0/12"
"192.168.0.0/16")]
#:trusted-proxies
[trusted-proxy-values '("127.0.0.0/8" "::1/128")]
#:session-seconds [session-seconds 43200])
#:session-seconds [session-seconds 604800])
(unless (exact-positive-integer? session-seconds)
(raise-argument-error 'make-auth-manager "exact-positive-integer?"
session-seconds))
@@ -277,7 +292,6 @@
(hash-set! users (string-downcase (string-trim (car entry)))
(cdr entry)))
(auth-manager users
(map parse-network local-network-values)
(map parse-network trusted-proxy-values)
session-seconds
(make-hash)
@@ -297,30 +311,35 @@
(define manager
(make-auth-manager
(list (cons "Hans" test-hash))
#:local-networks '("192.168.1.0/24")
#:trusted-proxies '("127.0.0.1/32")))
(define (test-request peer [headers '()])
(request #"GET" (string->url "http://example.test/api/state")
headers (delay '()) #f "127.0.0.1" 80 peer))
(check-true (auth-request-local? manager (test-request "192.168.1.42")))
(check-false (auth-request-local? manager (test-request "192.168.2.42")))
(check-true
(auth-request-local?
manager
(test-request "127.0.0.1"
(list (header #"X-Forwarded-For" #"198.51.100.2, 192.168.1.8")))))
(check-false
(auth-request-local?
manager
(test-request "198.51.100.2"
(list (header #"X-Forwarded-For" #"192.168.1.8")))))
(define remote (test-request "198.51.100.2"))
;; Local and remote browser requests follow the same login path.
(check-false (auth-request-user manager (test-request "127.0.0.1")))
(check-equal?
(request-address
manager
(test-request
"127.0.0.1"
(list (header #"X-Forwarded-For"
#"198.51.100.8, 203.0.113.9"))))
"203.0.113.9")
(check-equal?
(request-address
manager
(test-request
"198.51.100.2"
(list (header #"X-Forwarded-For" #"203.0.113.9"))))
"198.51.100.2")
(define token
(auth-login! manager remote "hans" "correct horse battery staple"))
(check-true (string? token))
(check-true
(regexp-match? #rx#"Max-Age=604800" (auth-session-cookie manager token)))
(define authenticated
(test-request
"198.51.100.2"
@@ -329,6 +348,10 @@
(string->bytes/utf-8
(format "~a=~a" session-cookie-name token))))))
(check-equal? (auth-request-user manager authenticated) "hans")
(define stored-session (hash-ref (auth-manager-sessions manager) token))
(set-session-last-cookie-renewal! stored-session 0)
(check-true (bytes? (auth-renewal-cookie manager authenticated)))
(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")))