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/player.rkt
+10 -10
View File
@@ -1126,7 +1126,7 @@
(string-downcase app-id)))
(define store (open-playlist-store playlist-keystore))
(define stored-tabs
(load-user-playlists store "local" libraries))
(load-user-playlists store "anonymous" libraries))
(let* ((library (and (pair? libraries) (car libraries)))
(browser-entries
(if library
@@ -1142,7 +1142,7 @@
(selected-index 0)
(contexts (make-hash))
(initial-context (playlist-context tabs selected-index)))
(hash-set! contexts "local" initial-context)
(hash-set! contexts "anonymous" initial-context)
(define value
(player libraries
(remove-duplicates normalized-agent-ids string=?)
@@ -1175,7 +1175,7 @@
(make-hash)
store
contexts
"local"
"anonymous"
dlna-port))
value))
@@ -1185,7 +1185,7 @@
; post : Cached DLNA playback information has been incorporated.
; result : A JSON-compatible hash.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (player-state->jsexpr value #:username [username "local"])
(define (player-state->jsexpr value #:username [username "anonymous"])
(define normalized (normal-playlist-username username))
(call-with-semaphore
(player-command-lock value)
@@ -1264,7 +1264,7 @@
"playlist-clear" "tab-add" "tab-select" "tab-rename"
"tab-delete" "play"))
(define (player-command! value command data #:username [username "local"])
(define (player-command! value command data #:username [username "anonymous"])
(define normalized (normal-playlist-username username))
(call-with-semaphore
(player-command-lock value)
@@ -1488,7 +1488,7 @@
; post : Player state remains unchanged.
; result : Artwork bytes and MIME type, or #f when unavailable.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (player-track-artwork value artwork-id #:username [username "local"])
(define (player-track-artwork value artwork-id #:username [username "anonymous"])
(define item
(call-with-semaphore
(player-command-lock value)
@@ -1757,10 +1757,10 @@
"tab-rename"
(hasheq 'index 1 'name "Hans favorieten")
#:username "hans")
(define local-after-hans
(player-state->jsexpr example-player #:username "local"))
(check-equal? (length (hash-ref local-after-hans 'tabs)) 1)
(check-equal? (length (hash-ref local-after-hans 'tracks)) 2)
(define anonymous-after-hans
(player-state->jsexpr example-player #:username "anonymous"))
(check-equal? (length (hash-ref anonymous-after-hans 'tabs)) 1)
(check-equal? (length (hash-ref anonymous-after-hans 'tracks)) 2)
(player-close! example-player)
(define restored-player
private/server.rkt
+19 -2
View File
@@ -54,7 +54,6 @@
(let ((user (auth-request-user current-auth request)))
(json-response
(hasheq 'enabled (auth-enabled? current-auth)
'local (auth-request-local? current-auth request)
'authenticated (and user #t)
'username (or user 'null)))))
@@ -215,6 +214,24 @@
(regexp-match? #px"^/api/(?:auth|agent)(?:/|$)"
(request-path request)))
(define (response-add-header value extra-header)
(response (response-code value)
(response-message value)
(response-seconds value)
(response-mime value)
(cons extra-header (response-headers value))
(response-output value)))
(define (dispatch-api request)
(define value (api-dispatch request))
(define renewed-cookie
(and (not (regexp-match? #px"^/api/agent(?:/|$)"
(request-path request)))
(auth-renewal-cookie current-auth request)))
(if renewed-cookie
(response-add-header value (header #"Set-Cookie" renewed-cookie))
value))
(define (dispatch request)
(cond
((and (bytes=? (request-method request) #"POST")
@@ -225,7 +242,7 @@
#:code 415))
((or (public-api-request? request)
(auth-request-user current-auth request))
(api-dispatch request))
(dispatch-api request))
(else
(json-response
(hasheq 'error "Aanmelden is vereist"
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")))