Crossfade timing, scheduler fix, playback resume, auth noise cleanup

- Delay metadata/track-change notification by 1s after crossfade completes
- Log 'Loading next:' instead of 'Now playing:' during crossfade prep
- Add diagnostic logging: track duration check, crossfade trigger time
- harmony-load-playlist defaults to skip=nil: scheduler queues tracks
  without interrupting current playback
- Save current track to .playback-state.lisp on each track change,
  resume from saved position on restart
- Replace ~50 format-t debug statements in auth with log:info/log:warn
- Remove password hash logging for security
- Add .playback-state.lisp to .gitignore
This commit is contained in:
Glenn Thompson 2026-03-04 00:23:25 +03:00
parent 6e23efe1e4
commit d66d4fe46c
6 changed files with 137 additions and 123 deletions

1
.gitignore vendored
View File

@ -66,3 +66,4 @@ playlists/stream-queue.m3u
/test-postgres-db.lisp
/userdump.csv
.envrc
.playback-state.lisp

View File

@ -1572,14 +1572,16 @@
(handler-case
(progn
(start-harmony-streaming)
;; Load the current playlist and start playing
;; Load the current playlist and start playing (resume from saved position)
(let ((playlist-path (get-stream-queue-path)))
(when (probe-file playlist-path)
(let ((file-list (m3u-to-file-list playlist-path)))
(when file-list
(cl-streamer/harmony:play-list *harmony-pipeline* file-list
(let* ((file-list (m3u-to-file-list playlist-path))
(resumed-list (when file-list (resume-from-saved-state file-list))))
(when resumed-list
(cl-streamer/harmony:play-list *harmony-pipeline* resumed-list
:crossfade-duration 3.0)
(format t "~A tracks loaded from stream-queue.m3u~%" (length file-list))))))
(format t "~A tracks loaded from stream-queue.m3u (~A remaining after resume)~%"
(length file-list) (length resumed-list))))))
(format t "📡 Stream: ~a/asteroid.mp3~%" *stream-base-url*)
(format t "📡 Stream: ~a/asteroid.aac~%" *stream-base-url*))
(error (e)

View File

@ -14,27 +14,21 @@
(if user
(progn
;; Login successful - store user ID in session
(format t "Login successful for user: ~a~%" (dm:field user "username"))
(log:info "Login successful for user: ~a" (dm:field user "username"))
(handler-case
(progn
(let* ((user-id (dm:id user))
(user-role (dm:field user "role"))
(redirect-path (cond
;; Admin users go to admin dashboard
((string-equal user-role "admin") "/admin")
;; All other users go to their profile
(t "/profile"))))
(format t "User ID from DB: ~a~%" user-id)
(format t "User role: ~a, redirecting to: ~a~%" user-role redirect-path)
(setf (session:field "user-id") user-id)
(format t "User ID #~a persisted in session.~%" (session:field "user-id"))
(radiance:redirect redirect-path)))
(radiance:redirect redirect-path))
(error (e)
(format t "Session error: ~a~%" e)
(log:warn "Session error during login: ~a" e)
"Login successful but session error occurred")))
;; Login failed - show form with error
(progn
(format t "Login unsuccessful for user: ~a~%" username)
(log:info "Login failed for user: ~a" username)
(clip:process-to-string
(load-template "login")
:title "Asteroid Radio - Login"
@ -168,7 +162,7 @@
(define-api asteroid/user/activate (user-id active) ()
"API endpoint for setting the active state of an user account"
(format t "Activation of user: #~a set to ~a~%" user-id active)
(log:info "Activation of user: #~a set to ~a" user-id active)
(require-role :admin)
(with-error-handling
(let ((user (when user-id
@ -200,7 +194,7 @@
(define-api asteroid/user/role (user-id role) ()
"API endpoint for setting the access role of an user account"
(format t "Role of user: #~a set to ~a~%" user-id role)
(log:info "Role of user: #~a set to ~a" user-id role)
(require-role :admin)
(with-error-handling
(let ((user (when user-id

View File

@ -282,7 +282,9 @@
(update-all-mounts-metadata pipeline display-title)
(notify-track-change pipeline track-info))
(let ((voice (harmony:play path :mixer mixer :on-end on-end)))
(if update-metadata
(log:info "Now playing: ~A" display-title)
(log:info "Loading next: ~A" display-title))
(values voice display-title track-info))))
(defun voice-remaining-seconds (voice)
@ -363,12 +365,21 @@
:name "cl-streamer-fadeout")))
(volume-ramp voice 1.0 fade-in)
(bt:join-thread fade-thread))
;; Crossfade done — now update metadata & notify
;; Crossfade done — brief pause so listeners perceive
;; the new track before UI updates
(sleep 1.0)
(update-all-mounts-metadata pipeline display-title)
(notify-track-change pipeline track-info))
;; Wait for track to approach its end (or skip)
(setf (pipeline-skip-flag pipeline) nil)
(sleep 0.5)
;; Log initial track duration info
(let ((initial-remaining (voice-remaining-seconds voice)))
(log:info "Track duration check: remaining=~A pos=~A total=~A sr=~A"
initial-remaining
(ignore-errors (mixed:frame-position voice))
(ignore-errors (mixed:frame-count voice))
(ignore-errors (mixed:samplerate voice))))
(loop while (and (pipeline-running-p pipeline)
(not (mixed:done-p voice))
(not (pipeline-skip-flag pipeline)))
@ -376,7 +387,8 @@
when (and remaining
(<= remaining crossfade-duration)
(not (mixed:done-p voice)))
do (setf prev-voice voice)
do (log:info "Crossfade trigger: ~,1Fs remaining" remaining)
(setf prev-voice voice)
(return)
do (sleep 0.1))
;; Handle skip

View File

@ -18,6 +18,60 @@
(defvar *harmony-aac-encoder* nil
"AAC encoder instance.")
(defvar *harmony-state-file*
(merge-pathnames ".playback-state.lisp" (asdf:system-source-directory :asteroid))
"File to persist current playback position across restarts.")
;;; ---- Playback State Persistence ----
(defun save-playback-state (track-file-path)
"Save the current track file path to the state file.
Called on each track change so we can resume after restart."
(handler-case
(with-open-file (s *harmony-state-file*
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(prin1 (list :track-file track-file-path
:timestamp (get-universal-time))
s))
(error (e)
(log:warn "Could not save playback state: ~A" e))))
(defun load-playback-state ()
"Load the saved playback state. Returns plist or NIL."
(handler-case
(when (probe-file *harmony-state-file*)
(with-open-file (s *harmony-state-file* :direction :input)
(read s nil nil)))
(error (e)
(log:warn "Could not load playback state: ~A" e)
nil)))
(defun resume-from-saved-state (file-list)
"Given a playlist FILE-LIST, find the saved track and return the list
starting from the NEXT track after it. Returns the full list if no
saved state or track not found."
(let ((state (load-playback-state)))
(if state
(let* ((saved-file (getf state :track-file))
(pos (position saved-file file-list :test #'string=)))
(if pos
(let ((remaining (nthcdr (1+ pos) file-list)))
(if remaining
(progn
(log:info "Resuming after track ~A (~A of ~A)"
(file-namestring saved-file) (1+ pos) (length file-list))
remaining)
;; Was the last track — start from beginning
(progn
(log:info "Last saved track was final in playlist, starting from beginning")
file-list)))
(progn
(log:info "Saved track not found in current playlist, starting from beginning")
file-list)))
file-list)))
;;; ---- M3U Playlist Loading ----
(defun m3u-to-file-list (m3u-path)
@ -55,6 +109,9 @@
:track-id track-id)
:curated)
(setf *last-known-track-curated* display-title))
;; Persist current track for resume-on-restart
(when file-path
(save-playback-state file-path))
(log:info "Track change: ~A (track-id: ~A)" display-title track-id)))
(defun find-track-by-file-path (file-path)
@ -163,9 +220,11 @@
;;; ---- Playlist Control (replaces Liquidsoap commands) ----
(defun harmony-load-playlist (m3u-path)
(defun harmony-load-playlist (m3u-path &key (skip nil))
"Load and start playing an M3U playlist through the Harmony pipeline.
Converts Docker paths to host paths and feeds them to play-list."
Converts Docker paths to host paths and feeds them to play-list.
When SKIP is T, immediately crossfade to the new playlist.
When SKIP is NIL (default), queue tracks to play after the current track."
(when *harmony-pipeline*
(let ((file-list (m3u-to-file-list m3u-path)))
(when file-list
@ -175,9 +234,11 @@
(mapcar (lambda (path)
(list :file path))
file-list))
;; Skip current track to trigger crossfade into new playlist
(cl-streamer/harmony:pipeline-skip *harmony-pipeline*)
(log:info "Loaded playlist ~A (~A tracks)" m3u-path (length file-list))
;; Only skip if explicitly requested
(when skip
(cl-streamer/harmony:pipeline-skip *harmony-pipeline*))
(log:info "Loaded playlist ~A (~A tracks~A)" m3u-path (length file-list)
(if skip ", skipping to start" ""))
(length file-list)))))
(defun harmony-skip-track ()

View File

@ -20,53 +20,38 @@
(dm:field user "last-login") nil)
(handler-case
(db:with-transaction ()
(format t "Inserting user data: ~a~%" user)
(let ((result (dm:insert user)))
(format t "Insert result: ~a~%" result)
(format t "User created: ~a (~a)~%" username role)
(log:info "User created: ~a (~a)" username role)
t))
(error (e)
(format t "Error creating user ~a: ~a~%" username e)
(log:warn "Error creating user ~a: ~a" username e)
nil))))
(defun find-user-by-username (username)
"Find a user by username"
(format t "Searching for user: ~a~%" username)
(let ((user (dm:get-one "USERS" (db:query (:= 'username username)))))
(when user
(format t "Found user '~a' with id #~a~%" username (dm:id user))
user)))
user))
(defun find-user-by-id (user-id)
"Find a user by ID"
(format t "Looking for user with ID: ~a (type: ~a)~%" user-id (type-of user-id))
(let* ((user-id (if (stringp user-id)
(parse-integer user-id)
user-id))
(user (dm:get-one "USERS" (db:query (:= '_id user-id)))))
(when user
(format t "Found user '~a' with id #~a~%"
(dm:field user "username")
(dm:id user))
user)))
user))
(defun authenticate-user (username password)
"Authenticate a user with username and password"
(format t "Attempting to authenticate user: ~a~%" username)
(log:info "Authentication attempt for user: ~a" username)
(let ((user (find-user-by-username username)))
(format t "User found: ~a~%" (if user "YES" "NO"))
(when user
(let ((user-active (dm:field user "active"))
(user-password (dm:field user "password-hash")))
(handler-case
(progn
(format t "User active: ~a~%" user-active)
(format t "Password hash from DB: ~a~%" user-password)
(format t "Password verification: ~a~%"
(verify-password password user-password)))
(verify-password password user-password)
(error (e)
(format t "Error during user data access: ~a~%" e)))
(log:warn "Error during user authentication: ~a" e)))
(when (and (= 1 user-active)
(verify-password password user-password))
;; Update last login using data-model (database agnostic)
@ -77,7 +62,7 @@
;; Use data-model-save to normalize all timestamp fields before saving
(data-model-save user))
(error (e)
(format t "Warning: Could not update last-login: ~a~%" e)))
(log:warn "Could not update last-login: ~a" e)))
user)))))
(defun hash-password (password)
@ -89,9 +74,6 @@
(defun verify-password (password hash)
"Verify a password against its hash"
(let ((computed-hash (hash-password password)))
(format t "Computed hash: ~a~%" computed-hash)
(format t "Stored hash: ~a~%" hash)
(format t "Match: ~a~%" (string= computed-hash hash))
(string= computed-hash hash)))
(defun reset-user-password (username new-password)
@ -101,33 +83,26 @@
(handler-case
(let ((new-hash (hash-password new-password))
(user-id (dm:id user)))
(format t "Resetting password for user: ~a (ID: ~a, type: ~a)~%" username user-id (type-of user-id))
(format t "Old hash: ~a~%" (dm:field user "password-hash"))
(format t "New hash: ~a~%" new-hash)
(log:info "Resetting password for user: ~a" username)
;; Try direct update with uppercase field name to match stored case
(setf (dm:field user "password-hash") new-hash)
;; (dm:save user)
(data-model-save user)
;; Verify the update worked
(let ((updated-user (find-user-by-username username)))
(format t "Verification - fetching user again...~%")
(let ((updated-hash (dm:field updated-user "password-hash")))
(format t "Updated password hash in DB: ~a~%" updated-hash)
(format t "Expected hash: ~a~%" new-hash)
(let ((match (string= updated-hash new-hash)))
(format t "Password update match: ~a~%" match)
(if match
(if (string= updated-hash new-hash)
(progn
(format t "Password reset successful for user: ~a~%" username)
(log:info "Password reset successful for user: ~a" username)
t)
(progn
(format t "Password reset FAILED - hash didn't update~%")
nil))))))
(log:warn "Password reset FAILED for user: ~a" username)
nil)))))
(error (e)
(format t "Error resetting password for ~a: ~a~%" username e)
(log:warn "Error resetting password for ~a: ~a" username e)
nil))
(progn
(format t "User not found: ~a~%" username)
(log:warn "User not found for password reset: ~a" username)
nil))))
(defun user-has-role-p (user role)
@ -135,7 +110,6 @@
(when user
(let* ((role-value (dm:field user "role"))
(user-role (intern (string-upcase role-value) :keyword)))
(format t "User role: ~a, checking against: ~a~%" user-role role)
(or (eq user-role role)
(and (eq role :listener) (member user-role '(:dj :admin)))
(and (eq role :dj) (eq user-role :admin))))))
@ -144,13 +118,10 @@
"Get the currently authenticated user from session"
(handler-case
(let ((user-id (session:field "user-id")))
(format t "Session user-id: ~a~%" user-id)
(when user-id
(let ((user (find-user-by-id user-id)))
(format t "Found user: ~a~%" (if user "YES" "NO"))
user)))
(find-user-by-id user-id)))
(error (e)
(format t "Error getting current user: ~a~%" e)
(log:warn "Error getting current user: ~a" e)
nil)))
(defun get-current-user-id ()
@ -179,8 +150,6 @@
;; Check for "api/" anywhere in the path
(is-api-request (if api t (or (search "/api/" uri)
(search "api/" uri)))))
(format t "Authentication check - User ID: ~a, URI: ~a, Is API: ~a~%"
user-id uri (if is-api-request "YES" "NO"))
(if user-id
t ; Authenticated - return T to continue
;; Not authenticated - emit error and signal to stop processing
@ -188,14 +157,11 @@
(if is-api-request
;; API request - return JSON error with 401 status using api-output
(progn
(format t "Authentication failed - returning JSON 401~%")
(api-output `(("status" . "error")
("message" . "Authentication required"))
:status 401))
;; Page request - redirect to login
(progn
(format t "Authentication failed - redirecting to login~%")
(radiance:redirect "/login")))))))
(radiance:redirect "/login"))))))
(defun require-role (role &key (api nil))
"Require user to have a specific role.
@ -209,22 +175,14 @@
(is-api-request (if api t (or (search "/api/" uri)
(and (>= (length uri) 4)
(string= "api/" (subseq uri 0 4)))))))
(format t "Current user for role check: ~a~%" (if current-user "FOUND" "NOT FOUND"))
(format t "Request URI: ~a, Is API: ~a~%" uri (if is-api-request "YES" "NO"))
(when current-user
(format t "User has role ~a: ~a~%" role (user-has-role-p current-user role)))
(if (and current-user (user-has-role-p current-user role))
t ; Authorized - return T to continue
;; Not authorized - emit error
(if is-api-request
;; API request - return NIL (caller will handle JSON error)
(progn
(format t "Role check failed - authorization denied~%")
nil)
nil
;; Page request - redirect to login (redirect doesn't return)
(progn
(format t "Role check failed - redirecting to login~%")
(radiance:redirect "/asteroid/login"))))))
(radiance:redirect "/asteroid/login")))))
(defun update-user-role (user-id new-role)
"Update a user's role"
@ -236,9 +194,9 @@
;; (dm:save user)
(data-model-save user)
t)
(format t "Could not find user with id #~a~%" user-id)))
(log:warn "Could not find user with id #~a" user-id)))
(error (e)
(format t "Error updating user role: ~a~%" e)
(log:warn "Error updating user role: ~a" e)
nil)))
(defun deactivate-user (user-id)
@ -248,10 +206,10 @@
(setf (dm:field user "active") 0)
;; (dm:save user)
(data-model-save user)
(format t "Deactivated user ~a~%" user-id)
(log:info "Deactivated user ~a" user-id)
t)
(error (e)
(format t "Error deactivating user: ~a~%" e)
(log:warn "Error deactivating user: ~a" e)
nil)))
(defun activate-user (user-id)
@ -261,21 +219,15 @@
(setf (dm:field user "active") 1)
;; (dm:save user)
(data-model-save user)
(format t "Activated user ~a~%" user-id)
(log:info "Activated user ~a" user-id)
t)
(error (e)
(format t "Error activating user: ~a~%" e)
(log:warn "Error activating user: ~a" e)
nil)))
(defun get-all-users ()
"Get all users from database"
(format t "Getting all users from database...~%")
(let ((users (dm:get "USERS" (db:query :all))))
(format t "Total users in database: ~a~%" (length users))
(dolist (user users)
(format t "User: ~a~%" (dm:field user "username"))
(format t "User _id field: ~a (type: ~a)~%" (dm:id user) (type-of (dm:id user))))
users))
(dm:get "USERS" (db:query :all)))
(defun get-user-stats ()
"Get user statistics"
@ -300,27 +252,20 @@
(string= role "admin")))
(get-all-users))))
(unless existing-admins
(format t "~%Creating default admin user...~%")
(format t "Username: admin~%")
(format t "Password: asteroid123~%")
(format t "Please change this password after first login!~%~%")
(log:info "Creating default admin user (admin / asteroid123) - change password after first login!")
(create-user "admin" "admin@asteroid.radio" "asteroid123" :role :admin :active t))))
(defun initialize-user-system ()
"Initialize the user management system"
(format t "Initializing user management system...~%")
;; Skip database check at startup - database queries hang with current setup
(format t "Skipping admin creation check - database already initialized~%")
(format t "User management initialization complete.~%")
(log:info "Initializing user management system")
;; Try immediate initialization first
#+nil
(handler-case
(progn
(format t "Setting up user management...~%")
(create-default-admin)
(format t "User management initialization complete.~%"))
(log:info "User management initialization complete."))
(error (e)
(format t "Database not ready, will retry in background: ~a~%" e)
(log:info "Database not ready, will retry in background: ~a" e)
;; Fallback to delayed initialization
(bt:make-thread
(lambda ()
@ -329,12 +274,11 @@
(sleep 3)) ; Give database more time to initialize
(handler-case
(progn
(format t "Retrying user management setup...~%")
(create-default-admin)
(format t "User management initialization complete.~%")
(log:info "User management initialization complete.")
(return))
(error (e)
(format t "Error initializing user system: ~a~%" e)))))
(log:warn "Error initializing user system: ~a" e)))))
:name "user-init"))))
(defun dump-users (users)