diff --git a/asteroid.asd b/asteroid.asd index d60e402..147bde0 100644 --- a/asteroid.asd +++ b/asteroid.asd @@ -53,6 +53,8 @@ (:file "users") (:file "admin") (:file "player") + (:file "stream-player") + (:file "frameset-utils") (:file "spectrum-analyzer"))) (:file "stream-media") (:file "user-management") diff --git a/asteroid.lisp b/asteroid.lisp index 405fd43..0deaa97 100644 --- a/asteroid.lisp +++ b/asteroid.lisp @@ -868,6 +868,26 @@ (format t "ERROR generating recently-played.js: ~a~%" e) (format nil "// Error generating JavaScript: ~a~%" e)))) + ;; Serve ParenScript-compiled stream-player.js + ((string= path "js/stream-player.js") + (setf (content-type *response*) "application/javascript") + (handler-case + (let ((js (generate-stream-player-js))) + (if js js "// Error: No JavaScript generated")) + (error (e) + (format t "ERROR generating stream-player.js: ~a~%" e) + (format nil "// Error generating JavaScript: ~a~%" e)))) + + ;; Serve ParenScript-compiled frameset-utils.js + ((string= path "js/frameset-utils.js") + (setf (content-type *response*) "application/javascript") + (handler-case + (let ((js (generate-frameset-utils-js))) + (if js js "// Error: No JavaScript generated")) + (error (e) + (format t "ERROR generating frameset-utils.js: ~a~%" e) + (format nil "// Error generating JavaScript: ~a~%" e)))) + ;; Serve regular static file (t (serve-file (merge-pathnames (format nil "static/~a" path) diff --git a/docker/asteroid-radio-docker.liq b/docker/asteroid-radio-docker.liq index 5e8615f..556f570 100644 --- a/docker/asteroid-radio-docker.liq +++ b/docker/asteroid-radio-docker.liq @@ -6,7 +6,7 @@ # Allow running as root in Docker set("init.allow_root", true) -# Set log level for debugging +# Set log level (4 = warning, suppresses info messages including telnet noise) log.level.set(4) # Audio buffering settings to prevent choppiness diff --git a/listener-stats.lisp b/listener-stats.lisp index da6bc67..b355185 100644 --- a/listener-stats.lisp +++ b/listener-stats.lisp @@ -266,7 +266,9 @@ (log:error "Session cleanup failed: ~a" e)))) (defun update-geo-stats (country-code listener-count &optional city) - "Update geo stats for today, optionally including city" + "Update geo stats for today, optionally including city. + listener_count tracks peak concurrent listeners (max seen today). + listen_minutes increments by 1 per poll (approximates total listen time)." (when country-code (handler-case (with-db @@ -275,7 +277,7 @@ (format nil "INSERT INTO listener_geo_stats (date, country_code, city, listener_count, listen_minutes) VALUES (CURRENT_DATE, '~a', ~a, ~a, 1) ON CONFLICT (date, country_code, city) - DO UPDATE SET listener_count = listener_geo_stats.listener_count + ~a, + DO UPDATE SET listener_count = GREATEST(listener_geo_stats.listener_count, ~a), listen_minutes = listener_geo_stats.listen_minutes + 1" country-code city-sql listener-count listener-count)))) (error (e) diff --git a/parenscript/admin.lisp b/parenscript/admin.lisp index a1a58aa..b2487a6 100644 --- a/parenscript/admin.lisp +++ b/parenscript/admin.lisp @@ -27,6 +27,7 @@ (load-playlist-list) (load-current-queue) (refresh-liquidsoap-status) + (setup-stats-refresh) ;; Update Liquidsoap status every 10 seconds (set-interval refresh-liquidsoap-status 10000)))) @@ -854,6 +855,244 @@ (ps:chain console (error "Error restarting Icecast:" error)) (alert "Error restarting Icecast"))))) + ;; ======================================== + ;; Listener Statistics + ;; ======================================== + + ;; Refresh listener stats from API + (defun refresh-listener-stats () + (let ((status-el (ps:chain document (get-element-by-id "stats-status")))) + (when status-el + (setf (ps:@ status-el text-content) "Loading..."))) + + (ps:chain + (fetch "/api/asteroid/stats/current") + (then (lambda (response) (ps:chain response (json)))) + (then (lambda (result) + (let ((data (or (ps:@ result data) result))) + (if (and (= (ps:@ data status) "success") (ps:@ data listeners)) + (progn + ;; Process listener data - get most recent for each mount + (let ((mounts (ps:create))) + (ps:chain (ps:@ data listeners) + (for-each (lambda (item) + ;; item is [mount, "/asteroid.mp3", listeners, 1, timestamp, 123456] + (let ((mount (ps:getprop item 1)) + (listeners (ps:getprop item 3)) + (timestamp (ps:getprop item 5))) + (when (or (not (ps:getprop mounts mount)) + (> timestamp (ps:@ (ps:getprop mounts mount) timestamp))) + (setf (ps:getprop mounts mount) + (ps:create :listeners listeners :timestamp timestamp))))))) + + ;; Update UI + (let ((mp3 (or (and (ps:getprop mounts "/asteroid.mp3") + (ps:@ (ps:getprop mounts "/asteroid.mp3") listeners)) 0)) + (aac (or (and (ps:getprop mounts "/asteroid.aac") + (ps:@ (ps:getprop mounts "/asteroid.aac") listeners)) 0)) + (low (or (and (ps:getprop mounts "/asteroid-low.mp3") + (ps:@ (ps:getprop mounts "/asteroid-low.mp3") listeners)) 0))) + + (let ((mp3-el (ps:chain document (get-element-by-id "listeners-mp3"))) + (aac-el (ps:chain document (get-element-by-id "listeners-aac"))) + (low-el (ps:chain document (get-element-by-id "listeners-low"))) + (total-el (ps:chain document (get-element-by-id "listeners-total"))) + (updated-el (ps:chain document (get-element-by-id "stats-updated"))) + (status-el (ps:chain document (get-element-by-id "stats-status")))) + + (when mp3-el (setf (ps:@ mp3-el text-content) mp3)) + (when aac-el (setf (ps:@ aac-el text-content) aac)) + (when low-el (setf (ps:@ low-el text-content) low)) + (when total-el (setf (ps:@ total-el text-content) (+ mp3 aac low))) + (when updated-el + (setf (ps:@ updated-el text-content) + (ps:chain (ps:new (-date)) (to-locale-time-string)))) + (when status-el (setf (ps:@ status-el text-content) "")))))) + (let ((status-el (ps:chain document (get-element-by-id "stats-status")))) + (when status-el + (setf (ps:@ status-el text-content) "No data available"))))))) + (catch (lambda (error) + (ps:chain console (error "Error fetching stats:" error)) + (let ((status-el (ps:chain document (get-element-by-id "stats-status")))) + (when status-el + (setf (ps:@ status-el text-content) "Error loading stats"))))))) + + ;; ======================================== + ;; Geo Statistics + ;; ======================================== + + ;; Track expanded countries + (defvar *expanded-countries* (ps:new (-set))) + + ;; Convert country code to flag emoji + (defun country-to-flag (country-code) + (if (or (not country-code) (not (= (ps:@ country-code length) 2))) + "🌍" + (let ((code-points (ps:chain (ps:chain country-code (to-upper-case)) + (split "") + (map (lambda (char) + (+ 127397 (ps:chain char (char-code-at 0)))))))) + (ps:chain -string (from-code-point (ps:@ code-points 0) (ps:@ code-points 1)))))) + + ;; Refresh geo stats from API + (defun refresh-geo-stats () + (ps:chain + (fetch "/api/asteroid/stats/geo?days=7") + (then (lambda (response) (ps:chain response (json)))) + (then (lambda (result) + (let ((data (or (ps:@ result data) result)) + (tbody (ps:chain document (get-element-by-id "geo-stats-body")))) + (when tbody + (if (and (= (ps:@ data status) "success") + (ps:@ data geo) + (> (ps:@ (ps:@ data geo) length) 0)) + (progn + (setf (ps:@ tbody inner-h-t-m-l) + (ps:chain (ps:@ data geo) + (map (lambda (item) + (let* ((country (or (ps:@ item country_code) (ps:getprop item 0))) + (listeners (or (ps:@ item total_listeners) (ps:getprop item 1) 0)) + (minutes (or (ps:@ item total_minutes) (ps:getprop item 2) 0)) + (is-expanded (ps:chain *expanded-countries* (has country))) + (arrow (if is-expanded "▼" "▶"))) + (+ "" + "" arrow " " (country-to-flag country) " " country "" + "" listeners "" + "" minutes "" + "" + "" + "
" + "")))) + (join ""))) + ;; Re-fetch cities for expanded countries + (ps:chain *expanded-countries* + (for-each (lambda (country) + (fetch-cities country))))) + (setf (ps:@ tbody inner-h-t-m-l) + "No geo data yet")))))) + (catch (lambda (error) + (ps:chain console (error "Error fetching geo stats:" error)) + (let ((tbody (ps:chain document (get-element-by-id "geo-stats-body")))) + (when tbody + (setf (ps:@ tbody inner-h-t-m-l) + "Error loading geo data"))))))) + + ;; Toggle city display for a country + (defun toggle-country-cities (country) + (let ((city-row (ps:chain document (get-element-by-id (+ "cities-" country)))) + (country-row (ps:chain document (query-selector (+ "tr[data-country=\"" country "\"]")))) + (arrow (when country-row (ps:chain country-row (query-selector ".expand-arrow"))))) + + (if (ps:chain *expanded-countries* (has country)) + (progn + (ps:chain *expanded-countries* (delete country)) + (when city-row (setf (ps:@ city-row style display) "none")) + (when arrow (setf (ps:@ arrow text-content) "▶"))) + (progn + (ps:chain *expanded-countries* (add country)) + (when city-row (setf (ps:@ city-row style display) "table-row")) + (when arrow (setf (ps:@ arrow text-content) "▼")) + (fetch-cities country))))) + + ;; Fetch cities for a country + (defun fetch-cities (country) + (let ((container (ps:chain document (get-element-by-id (+ "city-container-" country))))) + (when container + (setf (ps:@ container inner-h-t-m-l) + "
Loading cities...
") + + (ps:chain + (fetch (+ "/api/asteroid/stats/geo/cities?country=" country "&days=7")) + (then (lambda (response) (ps:chain response (json)))) + (then (lambda (result) + (let ((data (or (ps:@ result data) result))) + (if (and (= (ps:@ data status) "success") + (ps:@ data cities) + (> (ps:@ (ps:@ data cities) length) 0)) + (setf (ps:@ container inner-h-t-m-l) + (+ "" + (ps:chain (ps:@ data cities) + (map (lambda (city) + (+ "" + "" + "" + "" + ""))) + (join "")) + "
└ " (ps:@ city city) "" (ps:@ city listeners) "" (ps:@ city minutes) "
")) + (setf (ps:@ container inner-h-t-m-l) + "
No city data
"))))) + (catch (lambda (error) + (ps:chain console (error "Error fetching cities:" error)) + (setf (ps:@ container inner-h-t-m-l) + "
Error loading cities
"))))))) + + ;; ======================================== + ;; Admin Password Reset + ;; ======================================== + + (defun reset-user-password (event) + (ps:chain event (prevent-default)) + + (let ((username (ps:@ (ps:chain document (get-element-by-id "reset-username")) value)) + (new-password (ps:@ (ps:chain document (get-element-by-id "reset-new-password")) value)) + (confirm-password (ps:@ (ps:chain document (get-element-by-id "reset-confirm-password")) value)) + (message-div (ps:chain document (get-element-by-id "reset-password-message")))) + + ;; Client-side validation + (when (< (ps:@ new-password length) 8) + (setf (ps:@ message-div text-content) "New password must be at least 8 characters") + (setf (ps:@ message-div class-name) "message error") + (return nil)) + + (when (not (= new-password confirm-password)) + (setf (ps:@ message-div text-content) "Passwords do not match") + (setf (ps:@ message-div class-name) "message error") + (return nil)) + + ;; Send request to API + (let ((form-data (ps:new (-form-data)))) + (ps:chain form-data (append "username" username)) + (ps:chain form-data (append "new-password" new-password)) + + (ps:chain + (fetch "/api/asteroid/admin/reset-password" + (ps:create :method "POST" :body form-data)) + (then (lambda (response) (ps:chain response (json)))) + (then (lambda (data) + (if (or (= (ps:@ data status) "success") + (and (ps:@ data data) (= (ps:@ (ps:@ data data) status) "success"))) + (progn + (setf (ps:@ message-div text-content) + (+ "Password reset successfully for user: " username)) + (setf (ps:@ message-div class-name) "message success") + (ps:chain (ps:chain document (get-element-by-id "admin-reset-password-form")) (reset))) + (progn + (setf (ps:@ message-div text-content) + (or (ps:@ data message) + (and (ps:@ data data) (ps:@ (ps:@ data data) message)) + "Failed to reset password")) + (setf (ps:@ message-div class-name) "message error"))))) + (catch (lambda (error) + (ps:chain console (error "Error resetting password:" error)) + (setf (ps:@ message-div text-content) "Error resetting password") + (setf (ps:@ message-div class-name) "message error")))))) + + nil) + + ;; ======================================== + ;; Auto-refresh and Initialization for Stats + ;; ======================================== + + ;; Setup stats auto-refresh (called from DOMContentLoaded) + (defun setup-stats-refresh () + ;; Initial load + (refresh-listener-stats) + (refresh-geo-stats) + ;; Auto-refresh intervals + (set-interval refresh-listener-stats 30000) + (set-interval refresh-geo-stats 60000)) + ;; Make functions globally accessible for onclick handlers (setf (ps:@ window go-to-page) go-to-page) (setf (ps:@ window previous-page) previous-page) @@ -866,6 +1105,11 @@ (setf (ps:@ window move-track-down) move-track-down) (setf (ps:@ window remove-from-queue) remove-from-queue) (setf (ps:@ window add-to-queue) add-to-queue) + (setf (ps:@ window toggle-country-cities) toggle-country-cities) + (setf (ps:@ window reset-user-password) reset-user-password) + (setf (ps:@ window refresh-listener-stats) refresh-listener-stats) + (setf (ps:@ window refresh-geo-stats) refresh-geo-stats) + (setf (ps:@ window setup-stats-refresh) setup-stats-refresh) )) "Compiled JavaScript for admin dashboard - generated at load time") diff --git a/parenscript/frameset-utils.lisp b/parenscript/frameset-utils.lisp new file mode 100644 index 0000000..ce1ab3d --- /dev/null +++ b/parenscript/frameset-utils.lisp @@ -0,0 +1,18 @@ +;;;; frameset-utils.lisp - ParenScript for frameset utilities +;;;; Frame-busting and other frameset-related functionality + +(in-package #:asteroid) + +(defparameter *frameset-utils-js* + (ps:ps* + '(progn + ;; Prevent nested framesets - break out if we're already in a frame + ;; This runs immediately (not on DOMContentLoaded) to prevent flicker + (when (not (= (ps:@ window self) (ps:@ window top))) + (setf (ps:@ (ps:@ window top) location href) + (ps:@ (ps:@ window self) location href))))) + "Compiled JavaScript for frameset utilities - generated at load time") + +(defun generate-frameset-utils-js () + "Generate JavaScript code for frameset utilities" + *frameset-utils-js*) diff --git a/parenscript/stream-player.lisp b/parenscript/stream-player.lisp new file mode 100644 index 0000000..ffe883b --- /dev/null +++ b/parenscript/stream-player.lisp @@ -0,0 +1,453 @@ +;;;; stream-player.lisp - ParenScript for persistent stream player +;;;; Handles audio-player-frame and popout-player stream reconnect logic + +(in-package #:asteroid) + +(defparameter *stream-player-js* + (ps:ps* + '(progn + + ;; ======================================== + ;; Stream Configuration + ;; ======================================== + + ;; Get stream configuration for a given quality + (defun get-stream-config (stream-base-url encoding) + (let ((config (ps:create + :aac (ps:create :url (+ stream-base-url "/asteroid.aac") + :type "audio/aac" + :format "AAC 96kbps Stereo" + :mount "asteroid.aac") + :mp3 (ps:create :url (+ stream-base-url "/asteroid.mp3") + :type "audio/mpeg" + :format "MP3 128kbps Stereo" + :mount "asteroid.mp3") + :low (ps:create :url (+ stream-base-url "/asteroid-low.mp3") + :type "audio/mpeg" + :format "MP3 64kbps Stereo" + :mount "asteroid-low.mp3")))) + (ps:getprop config encoding))) + + ;; ======================================== + ;; Stream Quality Selection + ;; ======================================== + + ;; Change stream quality + (defun change-stream-quality () + (let* ((selector (or (ps:chain document (get-element-by-id "stream-quality")) + (ps:chain document (get-element-by-id "popout-stream-quality")))) + (stream-base-url (ps:@ (ps:chain document (get-element-by-id "stream-base-url")) value)) + (config (get-stream-config stream-base-url (ps:@ selector value))) + (audio-element (or (ps:chain document (get-element-by-id "persistent-audio")) + (ps:chain document (get-element-by-id "live-audio")))) + (source-element (ps:chain document (get-element-by-id "audio-source")))) + + ;; Save preference + (ps:chain local-storage (set-item "stream-quality" (ps:@ selector value))) + + (let ((was-playing (not (ps:@ audio-element paused)))) + (setf (ps:@ source-element src) (ps:@ config url)) + (setf (ps:@ source-element type) (ps:@ config type)) + (ps:chain audio-element (load)) + + (when was-playing + (ps:chain audio-element (play) + (catch (lambda (e) + (ps:chain console (log "Autoplay prevented:" e))))))))) + + ;; ======================================== + ;; Now Playing Updates + ;; ======================================== + + ;; Update mini now playing display (for persistent player frame) + (defun update-mini-now-playing () + (ps:chain + (fetch "/api/asteroid/partial/now-playing-inline") + (then (lambda (response) + (if (ps:@ response ok) + (ps:chain response (text)) + ""))) + (then (lambda (text) + (let ((el (ps:chain document (get-element-by-id "mini-now-playing")))) + (when el + (setf (ps:@ el text-content) text))))) + (catch (lambda (error) + (ps:chain console (log "Could not fetch now playing:" error)))))) + + ;; Update popout now playing display (parses artist - title) + (defun update-popout-now-playing () + (ps:chain + (fetch "/api/asteroid/partial/now-playing-inline") + (then (lambda (response) + (if (ps:@ response ok) + (ps:chain response (text)) + ""))) + (then (lambda (html) + (let* ((parser (ps:new (-d-o-m-parser))) + (doc (ps:chain parser (parse-from-string html "text/html"))) + (track-text (or (ps:@ doc body text-content) + (ps:@ doc body inner-text) + "")) + (parts (ps:chain track-text (split " - ")))) + (if (>= (ps:@ parts length) 2) + (progn + (let ((artist-el (ps:chain document (get-element-by-id "popout-track-artist"))) + (title-el (ps:chain document (get-element-by-id "popout-track-title")))) + (when artist-el + (setf (ps:@ artist-el text-content) (ps:chain (aref parts 0) (trim)))) + (when title-el + (setf (ps:@ title-el text-content) + (ps:chain (ps:chain parts (slice 1) (join " - ")) (trim)))))) + (progn + (let ((title-el (ps:chain document (get-element-by-id "popout-track-title"))) + (artist-el (ps:chain document (get-element-by-id "popout-track-artist")))) + (when title-el + (setf (ps:@ title-el text-content) (ps:chain track-text (trim)))) + (when artist-el + (setf (ps:@ artist-el text-content) "Asteroid Radio")))))))) + (catch (lambda (error) + (ps:chain console (error "Error updating now playing:" error)))))) + + ;; ======================================== + ;; Status Display + ;; ======================================== + + ;; Show status message + (defun show-status (message is-error) + (let ((status (ps:chain document (get-element-by-id "stream-status")))) + (when status + (setf (ps:@ status text-content) message) + (setf (ps:@ status style display) "block") + (setf (ps:@ status style background) (if is-error "#550000" "#005500")) + (setf (ps:@ status style color) (if is-error "#ff6666" "#66ff66")) + (unless is-error + (set-timeout (lambda () + (setf (ps:@ status style display) "none")) + 3000))))) + + ;; Hide status message + (defun hide-status () + (let ((status (ps:chain document (get-element-by-id "stream-status")))) + (when status + (setf (ps:@ status style display) "none")))) + + ;; ======================================== + ;; Stream Reconnect Logic + ;; ======================================== + + ;; Error retry counter and reconnect state + (defvar *stream-error-count* 0) + (defvar *reconnect-timeout* nil) + (defvar *is-reconnecting* false) + + ;; Reconnect stream - recreates audio element to fix wedged state + (defun reconnect-stream () + (ps:chain console (log "Reconnecting stream...")) + (show-status "🔄 Reconnecting..." false) + + (let* ((container (ps:chain document (query-selector ".persistent-player"))) + (old-audio (ps:chain document (get-element-by-id "persistent-audio"))) + (stream-base-url (ps:@ (ps:chain document (get-element-by-id "stream-base-url")) value)) + (stream-quality (or (ps:chain local-storage (get-item "stream-quality")) "aac")) + (config (get-stream-config stream-base-url stream-quality))) + + (unless (and container old-audio) + (show-status "❌ Could not reconnect - reload page" true) + (return)) + + ;; Save current volume and muted state + (let ((saved-volume (ps:@ old-audio volume)) + (saved-muted (ps:@ old-audio muted))) + (ps:chain console (log "Saving volume:" saved-volume "muted:" saved-muted)) + + ;; Reset spectrum analyzer if it exists + (when (ps:@ window reset-spectrum-analyzer) + (ps:chain window (reset-spectrum-analyzer))) + + ;; Stop and remove old audio + (ps:chain old-audio (pause)) + (setf (ps:@ old-audio src) "") + (ps:chain old-audio (load)) + + ;; Create new audio element + (let ((new-audio (ps:chain document (create-element "audio")))) + (setf (ps:@ new-audio id) "persistent-audio") + (setf (ps:@ new-audio controls) true) + (setf (ps:@ new-audio preload) "metadata") + (setf (ps:@ new-audio cross-origin) "anonymous") + + ;; Restore volume and muted state + (setf (ps:@ new-audio volume) saved-volume) + (setf (ps:@ new-audio muted) saved-muted) + + ;; Create source + (let ((source (ps:chain document (create-element "source")))) + (setf (ps:@ source id) "audio-source") + (setf (ps:@ source src) (ps:@ config url)) + (setf (ps:@ source type) (ps:@ config type)) + (ps:chain new-audio (append-child source))) + + ;; Replace old audio with new + (ps:chain old-audio (replace-with new-audio)) + + ;; Re-attach event listeners + (attach-audio-listeners new-audio) + + ;; Try to play + (set-timeout + (lambda () + (ps:chain new-audio (play) + (then (lambda () + (ps:chain console (log "Reconnected successfully")) + (show-status "✓ Reconnected!" false) + ;; Reinitialize spectrum analyzer + (when (ps:@ window init-spectrum-analyzer) + (set-timeout (lambda () + (ps:chain window (init-spectrum-analyzer))) + 500)) + ;; Also try in content frame + (set-timeout + (lambda () + (ps:try + (let ((content-frame (ps:@ (ps:@ window parent) frames "content-frame"))) + (when (and content-frame (ps:@ content-frame init-spectrum-analyzer)) + (when (ps:@ content-frame reset-spectrum-analyzer) + (ps:chain content-frame (reset-spectrum-analyzer))) + (ps:chain content-frame (init-spectrum-analyzer)) + (ps:chain console (log "Spectrum analyzer reinitialized in content frame")))) + (:catch (e) + (ps:chain console (log "Could not reinit spectrum in content frame:" e))))) + 600))) + (catch (lambda (err) + (ps:chain console (log "Reconnect play failed:" err)) + (show-status "Click play to start stream" false))))) + 300))))) + + ;; Simple reconnect for popout player (just reload and play) + (defun simple-reconnect (audio-element) + (ps:chain audio-element (load)) + (ps:chain audio-element (play) + (catch (lambda (err) + (ps:chain console (log "Reconnect failed:" err)))))) + + ;; Attach event listeners to audio element + (defun attach-audio-listeners (audio-element) + (ps:chain audio-element + (add-event-listener "waiting" + (lambda () + (ps:chain console (log "Audio buffering..."))))) + + (ps:chain audio-element + (add-event-listener "playing" + (lambda () + (ps:chain console (log "Audio playing")) + (hide-status) + (setf *stream-error-count* 0) + (setf *is-reconnecting* false) + (when *reconnect-timeout* + (clear-timeout *reconnect-timeout*) + (setf *reconnect-timeout* nil))))) + + (ps:chain audio-element + (add-event-listener "error" + (lambda (e) + (ps:chain console (error "Audio error:" e)) + (unless *is-reconnecting* + (setf *stream-error-count* (+ *stream-error-count* 1)) + ;; Calculate delay with exponential backoff (3s, 6s, 12s, max 30s) + (let ((delay (ps:chain -math (min (* 3000 (ps:chain -math (pow 2 (- *stream-error-count* 1)))) 30000)))) + (show-status (+ "⚠️ Stream error. Reconnecting in " (/ delay 1000) "s... (attempt " *stream-error-count* ")") true) + (setf *is-reconnecting* true) + (setf *reconnect-timeout* + (set-timeout (lambda () (reconnect-stream)) delay))))))) + + (ps:chain audio-element + (add-event-listener "stalled" + (lambda () + (unless *is-reconnecting* + (ps:chain console (log "Audio stalled, will auto-reconnect in 5 seconds...")) + (show-status "⚠️ Stream stalled - reconnecting..." true) + (setf *is-reconnecting* true) + (set-timeout + (lambda () + (if (< (ps:@ audio-element ready-state) 3) + (reconnect-stream) + (setf *is-reconnecting* false))) + 5000))))) + + ;; Handle ended event - stream shouldn't end, so reconnect + (ps:chain audio-element + (add-event-listener "ended" + (lambda () + (unless *is-reconnecting* + (ps:chain console (log "Stream ended unexpectedly, reconnecting...")) + (show-status "⚠️ Stream ended - reconnecting..." true) + (setf *is-reconnecting* true) + (set-timeout (lambda () (reconnect-stream)) 2000))))) + + ;; Handle pause event - detect browser throttling muted streams + (ps:chain audio-element + (add-event-listener "pause" + (lambda () + ;; If paused while muted and we didn't initiate it, browser may have throttled + (when (and (ps:@ audio-element muted) (not *is-reconnecting*)) + (ps:chain console (log "Stream paused while muted (possible browser throttling), will reconnect in 3 seconds...")) + (show-status "⚠️ Stream paused - reconnecting..." true) + (setf *is-reconnecting* true) + (set-timeout (lambda () (reconnect-stream)) 3000)))))) + + ;; Attach simple listeners for popout player + (defun attach-popout-listeners (audio-element) + (defvar *popout-error-count* 0) + (defvar *popout-reconnect-timeout* nil) + (defvar *popout-is-reconnecting* false) + + (ps:chain audio-element + (add-event-listener "playing" + (lambda () + (ps:chain console (log "Audio playing")) + (setf *popout-error-count* 0) + (setf *popout-is-reconnecting* false) + (when *popout-reconnect-timeout* + (clear-timeout *popout-reconnect-timeout*) + (setf *popout-reconnect-timeout* nil))))) + + (ps:chain audio-element + (add-event-listener "error" + (lambda (e) + (ps:chain console (error "Audio error:" e)) + (unless *popout-is-reconnecting* + (setf *popout-error-count* (+ *popout-error-count* 1)) + (let ((delay (ps:chain -math (min (* 3000 (ps:chain -math (pow 2 (- *popout-error-count* 1)))) 30000)))) + (ps:chain console (log (+ "Stream error. Reconnecting in " (/ delay 1000) "s... (attempt " *popout-error-count* ")"))) + (setf *popout-is-reconnecting* true) + (setf *popout-reconnect-timeout* + (set-timeout (lambda () (simple-reconnect audio-element)) delay))))))) + + (ps:chain audio-element + (add-event-listener "stalled" + (lambda () + (unless *popout-is-reconnecting* + (ps:chain console (log "Stream stalled, will auto-reconnect in 5 seconds...")) + (setf *popout-is-reconnecting* true) + (set-timeout + (lambda () + (if (< (ps:@ audio-element ready-state) 3) + (simple-reconnect audio-element) + (setf *popout-is-reconnecting* false))) + 5000))))) + + (ps:chain audio-element + (add-event-listener "ended" + (lambda () + (unless *popout-is-reconnecting* + (ps:chain console (log "Stream ended unexpectedly, reconnecting...")) + (setf *popout-is-reconnecting* true) + (set-timeout (lambda () (simple-reconnect audio-element)) 2000))))) + + (ps:chain audio-element + (add-event-listener "pause" + (lambda () + (when (and (ps:@ audio-element muted) (not *popout-is-reconnecting*)) + (ps:chain console (log "Stream paused while muted (possible browser throttling), reconnecting...")) + (setf *popout-is-reconnecting* true) + (set-timeout (lambda () (simple-reconnect audio-element)) 3000)))))) + + ;; ======================================== + ;; Frameset Mode + ;; ======================================== + + ;; Disable frameset mode function + (defun disable-frameset-mode () + ;; Clear preference + (ps:chain local-storage (remove-item "useFrameset")) + ;; Redirect parent window to regular view + (setf (ps:@ (ps:@ window parent) location href) "/asteroid/")) + + ;; ======================================== + ;; Popout Window Communication + ;; ======================================== + + ;; Notify parent window that popout is open + (defun notify-popout-opened () + (when (and (ps:@ window opener) (not (ps:@ (ps:@ window opener) closed))) + (ps:chain (ps:@ window opener) (post-message (ps:create :type "popout-opened") "*")))) + + ;; Notify parent when closing + (defun notify-popout-closing () + (when (and (ps:@ window opener) (not (ps:@ (ps:@ window opener) closed))) + (ps:chain (ps:@ window opener) (post-message (ps:create :type "popout-closed") "*")))) + + ;; ======================================== + ;; Initialization + ;; ======================================== + + ;; Initialize persistent player (audio-player-frame) + (defun init-persistent-player () + (let ((audio-element (ps:chain document (get-element-by-id "persistent-audio")))) + (when audio-element + ;; Try to enable low-latency mode if supported + (when (ps:@ navigator media-session) + (setf (ps:@ navigator media-session metadata) + (ps:new (-media-metadata + (ps:create :title "Asteroid Radio Live Stream" + :artist "Asteroid Radio" + :album "Live Broadcast"))))) + + ;; Attach event listeners + (attach-audio-listeners audio-element) + + ;; Restore user quality preference + (let ((selector (ps:chain document (get-element-by-id "stream-quality"))) + (stream-quality (or (ps:chain local-storage (get-item "stream-quality")) "aac"))) + (when (and selector (not (= (ps:@ selector value) stream-quality))) + (setf (ps:@ selector value) stream-quality) + (ps:chain selector (dispatch-event (ps:new (-event "change")))))) + + ;; Start now playing updates + (set-timeout update-mini-now-playing 1000) + (set-interval update-mini-now-playing 10000)))) + + ;; Initialize popout player + (defun init-popout-player () + (let ((audio-element (ps:chain document (get-element-by-id "live-audio")))) + (when audio-element + ;; Attach event listeners + (attach-popout-listeners audio-element) + + ;; Start now playing updates + (update-popout-now-playing) + (set-interval update-popout-now-playing 10000) + + ;; Notify parent window + (notify-popout-opened) + + ;; Setup close notification + (ps:chain window (add-event-listener "beforeunload" notify-popout-closing))))) + + ;; Make functions globally accessible + (setf (ps:@ window get-stream-config) get-stream-config) + (setf (ps:@ window change-stream-quality) change-stream-quality) + (setf (ps:@ window reconnect-stream) reconnect-stream) + (setf (ps:@ window disable-frameset-mode) disable-frameset-mode) + (setf (ps:@ window init-persistent-player) init-persistent-player) + (setf (ps:@ window init-popout-player) init-popout-player) + (setf (ps:@ window update-mini-now-playing) update-mini-now-playing) + (setf (ps:@ window update-popout-now-playing) update-popout-now-playing) + + ;; Auto-initialize on DOMContentLoaded based on which elements exist + (ps:chain document + (add-event-listener + "DOMContentLoaded" + (lambda () + ;; Check for persistent player (audio-player-frame) + (when (ps:chain document (get-element-by-id "persistent-audio")) + (init-persistent-player)) + ;; Check for popout player + (when (ps:chain document (get-element-by-id "live-audio")) + (init-popout-player))))))) + "Compiled JavaScript for stream player - generated at load time") + +(defun generate-stream-player-js () + "Generate JavaScript code for the stream player" + *stream-player-js*) diff --git a/template/admin.ctml b/template/admin.ctml index 0b8a27d..ebb3c2f 100644 --- a/template/admin.ctml +++ b/template/admin.ctml @@ -279,209 +279,6 @@ - + diff --git a/template/audio-player-frame.ctml b/template/audio-player-frame.ctml index 522ab7b..4fce603 100644 --- a/template/audio-player-frame.ctml +++ b/template/audio-player-frame.ctml @@ -4,6 +4,7 @@ +
@@ -40,288 +41,6 @@ - + diff --git a/template/frameset-wrapper.ctml b/template/frameset-wrapper.ctml index 648e2b4..2e60556 100644 --- a/template/frameset-wrapper.ctml +++ b/template/frameset-wrapper.ctml @@ -4,12 +4,7 @@ ASTEROID RADIO - + diff --git a/template/popout-player.ctml b/template/popout-player.ctml index 735f15c..5cbf75d 100644 --- a/template/popout-player.ctml +++ b/template/popout-player.ctml @@ -6,6 +6,7 @@ +
@@ -47,160 +48,6 @@
- + diff --git a/template/profile.ctml b/template/profile.ctml index d7157ad..44e1de1 100644 --- a/template/profile.ctml +++ b/template/profile.ctml @@ -183,11 +183,6 @@ - + diff --git a/user-management.lisp b/user-management.lisp index 164f020..acfa1c6 100644 --- a/user-management.lisp +++ b/user-management.lisp @@ -186,7 +186,10 @@ (let* ((current-user (get-current-user)) (uri (radiance:path (radiance:uri *request*))) ;; Use explicit flag if provided, otherwise auto-detect from URI - (is-api-request (if api t (search "/api/" uri)))) + ;; Check both "/api/" and "api/" since path may or may not have leading slash + (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