Compare commits
5 Commits
0748466811
...
61d3e490da
| Author | SHA1 | Date |
|---|---|---|
|
|
61d3e490da | |
|
|
86536a2f22 | |
|
|
34a6d94324 | |
|
|
ff17490b35 | |
|
|
afa9f2e172 |
|
|
@ -389,6 +389,11 @@ Built with:
|
||||||
|
|
||||||
Special thanks to all contributors and the Common Lisp community.
|
Special thanks to all contributors and the Common Lisp community.
|
||||||
|
|
||||||
|
* Credits
|
||||||
|
|
||||||
|
** Icons
|
||||||
|
- [[https://www.flaticon.com/free-icons/cycle][Cycle icons created by meaicon - Flaticon]] (sync.png reconnect button)
|
||||||
|
|
||||||
---
|
---
|
||||||
|
|
||||||
*Last Updated: 2025-10-26*
|
*Last Updated: 2025-10-26*
|
||||||
|
|
|
||||||
|
|
@ -742,6 +742,8 @@
|
||||||
;; Front page - regular view by default
|
;; Front page - regular view by default
|
||||||
(define-page front-page #@"/" ()
|
(define-page front-page #@"/" ()
|
||||||
"Main front page"
|
"Main front page"
|
||||||
|
;; Register this visitor for geo stats (captures real IP from X-Forwarded-For)
|
||||||
|
(register-web-listener)
|
||||||
(clip:process-to-string
|
(clip:process-to-string
|
||||||
(load-template "front-page")
|
(load-template "front-page")
|
||||||
:title "ASTEROID RADIO"
|
:title "ASTEROID RADIO"
|
||||||
|
|
@ -784,6 +786,8 @@
|
||||||
;; Persistent audio player frame (bottom frame)
|
;; Persistent audio player frame (bottom frame)
|
||||||
(define-page audio-player-frame #@"/audio-player-frame" ()
|
(define-page audio-player-frame #@"/audio-player-frame" ()
|
||||||
"Persistent audio player frame (bottom of page)"
|
"Persistent audio player frame (bottom of page)"
|
||||||
|
;; Register this visitor for geo stats (captures real IP from X-Forwarded-For)
|
||||||
|
(register-web-listener)
|
||||||
(clip:process-to-string
|
(clip:process-to-string
|
||||||
(load-template "audio-player-frame")
|
(load-template "audio-player-frame")
|
||||||
:stream-base-url *stream-base-url*
|
:stream-base-url *stream-base-url*
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,9 @@
|
||||||
#!/usr/bin/env bash
|
#!/usr/bin/env bash
|
||||||
|
|
||||||
export ASTEROID_STREAM_URL='http://ice.asteroid.radio'
|
# Ensure you copy this file to 'environment.sh' in this directory, and
|
||||||
|
# change it to match your own stream configuration.
|
||||||
|
|
||||||
|
export ASTEROID_STREAM_URL='http://localhost:8080'
|
||||||
|
|
||||||
# source this file prior to starting the asteroid containers. Set the
|
# source this file prior to starting the asteroid containers. Set the
|
||||||
# DB name and access params here.
|
# DB name and access params here.
|
||||||
|
|
@ -34,6 +34,13 @@
|
||||||
(defvar *active-listeners* (make-hash-table :test 'equal)
|
(defvar *active-listeners* (make-hash-table :test 'equal)
|
||||||
"Hash table tracking active listeners by IP hash")
|
"Hash table tracking active listeners by IP hash")
|
||||||
|
|
||||||
|
;;; Web request listener tracking (real IPs from X-Forwarded-For)
|
||||||
|
(defvar *web-listeners* (make-hash-table :test 'equal)
|
||||||
|
"Hash table tracking listeners by session - stores real IP from web requests")
|
||||||
|
|
||||||
|
(defvar *web-listener-timeout* 300
|
||||||
|
"Seconds before a web listener is considered inactive (5 minutes)")
|
||||||
|
|
||||||
;;; Geo lookup cache (IP hash -> country code)
|
;;; Geo lookup cache (IP hash -> country code)
|
||||||
(defvar *geo-cache* (make-hash-table :test 'equal)
|
(defvar *geo-cache* (make-hash-table :test 'equal)
|
||||||
"Cache of IP hash to country code mappings")
|
"Cache of IP hash to country code mappings")
|
||||||
|
|
@ -57,6 +64,65 @@
|
||||||
(format nil "~a-~a" (get-universal-time) (random 1000000))))
|
(format nil "~a-~a" (get-universal-time) (random 1000000))))
|
||||||
(subseq (ironclad:byte-array-to-hex-string (ironclad:produce-digest digest)) 0 32)))
|
(subseq (ironclad:byte-array-to-hex-string (ironclad:produce-digest digest)) 0 32)))
|
||||||
|
|
||||||
|
;;; Web Listener Tracking (using real IPs from X-Forwarded-For)
|
||||||
|
|
||||||
|
(defun get-real-client-ip ()
|
||||||
|
"Get the real client IP from the current request.
|
||||||
|
Radiance automatically extracts X-Forwarded-For into (remote *request*)."
|
||||||
|
(when (boundp '*request*)
|
||||||
|
(let ((ip (remote *request*)))
|
||||||
|
;; Filter out private/internal IPs
|
||||||
|
(when (and ip
|
||||||
|
(not (string= ip "unknown"))
|
||||||
|
(not (search "172." ip))
|
||||||
|
(not (search "192.168." ip))
|
||||||
|
(not (search "10." ip))
|
||||||
|
(not (search "127." ip)))
|
||||||
|
ip))))
|
||||||
|
|
||||||
|
(defun register-web-listener ()
|
||||||
|
"Register current web request as an active listener.
|
||||||
|
Call this from player page or stream-related API endpoints."
|
||||||
|
(let ((ip (get-real-client-ip)))
|
||||||
|
(when ip
|
||||||
|
(let ((ip-hash (hash-ip-address ip)))
|
||||||
|
;; Use IP hash as key (no session required)
|
||||||
|
(setf (gethash ip-hash *web-listeners*)
|
||||||
|
(list :ip ip
|
||||||
|
:ip-hash ip-hash
|
||||||
|
:last-seen (get-universal-time)))
|
||||||
|
;; Do geo lookup and cache it
|
||||||
|
(unless (gethash ip-hash *geo-cache*)
|
||||||
|
(let ((geo (lookup-geoip ip)))
|
||||||
|
(when geo
|
||||||
|
(setf (gethash ip-hash *geo-cache*)
|
||||||
|
(list :country (getf geo :country-code)
|
||||||
|
:city (getf geo :city)
|
||||||
|
:region (getf geo :region)
|
||||||
|
:time (get-universal-time))))))
|
||||||
|
ip-hash))))
|
||||||
|
|
||||||
|
(defun cleanup-stale-web-listeners ()
|
||||||
|
"Remove web listeners that haven't been seen recently."
|
||||||
|
(let ((cutoff (- (get-universal-time) *web-listener-timeout*))
|
||||||
|
(to-remove nil))
|
||||||
|
(maphash (lambda (ip-hash data)
|
||||||
|
(when (< (getf data :last-seen) cutoff)
|
||||||
|
(push ip-hash to-remove)))
|
||||||
|
*web-listeners*)
|
||||||
|
(dolist (ip-hash to-remove)
|
||||||
|
(remhash ip-hash *web-listeners*))))
|
||||||
|
|
||||||
|
(defun get-active-web-listener-ips ()
|
||||||
|
"Get list of real IPs from active web listeners."
|
||||||
|
(cleanup-stale-web-listeners)
|
||||||
|
(let ((ips nil))
|
||||||
|
(maphash (lambda (session-id data)
|
||||||
|
(declare (ignore session-id))
|
||||||
|
(push (getf data :ip) ips))
|
||||||
|
*web-listeners*)
|
||||||
|
(remove-duplicates ips :test #'string=)))
|
||||||
|
|
||||||
;;; GeoIP Lookup
|
;;; GeoIP Lookup
|
||||||
|
|
||||||
(defun lookup-geoip (ip-address)
|
(defun lookup-geoip (ip-address)
|
||||||
|
|
@ -350,7 +416,7 @@
|
||||||
country))))))
|
country))))))
|
||||||
|
|
||||||
(defun collect-geo-stats-for-mount (mount)
|
(defun collect-geo-stats-for-mount (mount)
|
||||||
"Collect geo stats for all listeners on a mount"
|
"Collect geo stats for all listeners on a mount (from Icecast - may show proxy IPs)"
|
||||||
(let ((listclients-xml (fetch-icecast-listclients mount)))
|
(let ((listclients-xml (fetch-icecast-listclients mount)))
|
||||||
(when listclients-xml
|
(when listclients-xml
|
||||||
(let ((ips (extract-listener-ips listclients-xml))
|
(let ((ips (extract-listener-ips listclients-xml))
|
||||||
|
|
@ -365,6 +431,24 @@
|
||||||
(update-geo-stats country count))
|
(update-geo-stats country count))
|
||||||
country-counts)))))
|
country-counts)))))
|
||||||
|
|
||||||
|
(defun collect-geo-stats-from-web-listeners ()
|
||||||
|
"Collect geo stats from web listeners (uses real IPs from X-Forwarded-For)"
|
||||||
|
(cleanup-stale-web-listeners)
|
||||||
|
(let ((country-counts (make-hash-table :test 'equal)))
|
||||||
|
;; Count listeners by country from cached geo data
|
||||||
|
(maphash (lambda (session-id data)
|
||||||
|
(declare (ignore session-id))
|
||||||
|
(let* ((ip-hash (getf data :ip-hash))
|
||||||
|
(cached-geo (gethash ip-hash *geo-cache*))
|
||||||
|
(country (when cached-geo (getf cached-geo :country))))
|
||||||
|
(when country
|
||||||
|
(incf (gethash country country-counts 0)))))
|
||||||
|
*web-listeners*)
|
||||||
|
;; Store each country's count
|
||||||
|
(maphash (lambda (country count)
|
||||||
|
(update-geo-stats country count))
|
||||||
|
country-counts)))
|
||||||
|
|
||||||
(defun poll-and-store-stats ()
|
(defun poll-and-store-stats ()
|
||||||
"Single poll iteration: fetch stats and store"
|
"Single poll iteration: fetch stats and store"
|
||||||
(let ((stats (fetch-icecast-stats)))
|
(let ((stats (fetch-icecast-stats)))
|
||||||
|
|
@ -375,10 +459,9 @@
|
||||||
(listeners (getf source :listeners)))
|
(listeners (getf source :listeners)))
|
||||||
(when mount
|
(when mount
|
||||||
(store-listener-snapshot mount listeners)
|
(store-listener-snapshot mount listeners)
|
||||||
;; Collect geo stats if there are listeners
|
(log:debug "Stored snapshot: ~a = ~a listeners" mount listeners)))))))
|
||||||
(when (and listeners (> listeners 0))
|
;; Collect geo stats from web listeners (uses real IPs from X-Forwarded-For)
|
||||||
(collect-geo-stats-for-mount mount))
|
(collect-geo-stats-from-web-listeners))
|
||||||
(log:debug "Stored snapshot: ~a = ~a listeners" mount listeners))))))))
|
|
||||||
|
|
||||||
(defun stats-polling-loop ()
|
(defun stats-polling-loop ()
|
||||||
"Main polling loop - runs in background thread"
|
"Main polling loop - runs in background thread"
|
||||||
|
|
|
||||||
|
|
@ -112,7 +112,7 @@
|
||||||
(left (/ (- (ps:@ screen width) width) 2))
|
(left (/ (- (ps:@ screen width) width) 2))
|
||||||
(top (/ (- (ps:@ screen height) height) 2))
|
(top (/ (- (ps:@ screen height) height) 2))
|
||||||
(features (+ "width=" width ",height=" height ",left=" left ",top=" top
|
(features (+ "width=" width ",height=" height ",left=" left ",top=" top
|
||||||
",resizable=yes,scrollbars=no,status=no,menubar=no,toolbar=no,location=no")))
|
",resizable=yes,scrollbars=no,status=no,menubar=no,toolbar=no,location=no")))
|
||||||
|
|
||||||
;; Open popout window
|
;; Open popout window
|
||||||
(setf *popout-window*
|
(setf *popout-window*
|
||||||
|
|
@ -314,77 +314,77 @@
|
||||||
;; Error handler
|
;; Error handler
|
||||||
(ps:chain audio-element
|
(ps:chain audio-element
|
||||||
(add-event-listener "error"
|
(add-event-listener "error"
|
||||||
(lambda (err)
|
(lambda (err)
|
||||||
(incf *stream-error-count*)
|
(incf *stream-error-count*)
|
||||||
(ps:chain console (log "Stream error:" err))
|
(ps:chain console (log "Stream error:" err))
|
||||||
|
|
||||||
(if (< *stream-error-count* 3)
|
(if (< *stream-error-count* 3)
|
||||||
;; Auto-retry for first few errors
|
;; Auto-retry for first few errors
|
||||||
(progn
|
(progn
|
||||||
(show-stream-status (+ "⚠️ Stream error. Reconnecting... (attempt " *stream-error-count* ")") "warning")
|
(show-stream-status (+ "⚠️ Stream error. Reconnecting... (attempt " *stream-error-count* ")") "warning")
|
||||||
(setf *reconnect-timeout*
|
(setf *reconnect-timeout*
|
||||||
(set-timeout reconnect-stream 3000)))
|
(set-timeout reconnect-stream 3000)))
|
||||||
;; Too many errors, show manual reconnect
|
;; Too many errors, show manual reconnect
|
||||||
(progn
|
(progn
|
||||||
(show-stream-status "❌ Stream connection lost. Click Reconnect to try again." "error")
|
(show-stream-status "❌ Stream connection lost. Click Reconnect to try again." "error")
|
||||||
(show-reconnect-button))))))
|
(show-reconnect-button))))))
|
||||||
|
|
||||||
;; Stalled handler
|
;; Stalled handler
|
||||||
(ps:chain audio-element
|
(ps:chain audio-element
|
||||||
(add-event-listener "stalled"
|
(add-event-listener "stalled"
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(ps:chain console (log "Stream stalled"))
|
(ps:chain console (log "Stream stalled"))
|
||||||
(show-stream-status "⚠️ Stream stalled. Attempting to recover..." "warning")
|
(show-stream-status "⚠️ Stream stalled. Attempting to recover..." "warning")
|
||||||
(setf *reconnect-timeout*
|
(setf *reconnect-timeout*
|
||||||
(set-timeout
|
(set-timeout
|
||||||
(lambda ()
|
(lambda ()
|
||||||
;; Only reconnect if still stalled
|
;; Only reconnect if still stalled
|
||||||
(when (ps:@ audio-element paused)
|
(when (ps:@ audio-element paused)
|
||||||
(reconnect-stream)))
|
(reconnect-stream)))
|
||||||
5000)))))
|
5000)))))
|
||||||
|
|
||||||
;; Waiting handler (buffering)
|
;; Waiting handler (buffering)
|
||||||
(ps:chain audio-element
|
(ps:chain audio-element
|
||||||
(add-event-listener "waiting"
|
(add-event-listener "waiting"
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(ps:chain console (log "Stream buffering..."))
|
(ps:chain console (log "Stream buffering..."))
|
||||||
(show-stream-status "⏳ Buffering..." "info"))))
|
(show-stream-status "⏳ Buffering..." "info"))))
|
||||||
|
|
||||||
;; Playing handler - clear any error states
|
;; Playing handler - clear any error states
|
||||||
(ps:chain audio-element
|
(ps:chain audio-element
|
||||||
(add-event-listener "playing"
|
(add-event-listener "playing"
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(setf *stream-error-count* 0)
|
(setf *stream-error-count* 0)
|
||||||
(hide-stream-status)
|
(hide-stream-status)
|
||||||
(hide-reconnect-button)
|
(hide-reconnect-button)
|
||||||
(when *reconnect-timeout*
|
(when *reconnect-timeout*
|
||||||
(clear-timeout *reconnect-timeout*)
|
(clear-timeout *reconnect-timeout*)
|
||||||
(setf *reconnect-timeout* nil)))))
|
(setf *reconnect-timeout* nil)))))
|
||||||
|
|
||||||
;; Pause handler - track when paused for long pause detection
|
;; Pause handler - track when paused for long pause detection
|
||||||
(ps:chain audio-element
|
(ps:chain audio-element
|
||||||
(add-event-listener "pause"
|
(add-event-listener "pause"
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(setf *last-play-attempt* (ps:chain |Date| (now))))))
|
(setf *last-play-attempt* (ps:chain |Date| (now))))))
|
||||||
|
|
||||||
;; Play handler - detect long pauses that need reconnection
|
;; Play handler - detect long pauses that need reconnection
|
||||||
(ps:chain audio-element
|
(ps:chain audio-element
|
||||||
(add-event-listener "play"
|
(add-event-listener "play"
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(let ((pause-duration (- (ps:chain |Date| (now)) *last-play-attempt*)))
|
(let ((pause-duration (- (ps:chain |Date| (now)) *last-play-attempt*)))
|
||||||
;; If paused for more than 30 seconds, reconnect to get fresh stream
|
;; If paused for more than 30 seconds, reconnect to get fresh stream
|
||||||
(when (> pause-duration 30000)
|
(when (> pause-duration 30000)
|
||||||
(ps:chain console (log "Long pause detected, reconnecting for fresh stream..."))
|
(ps:chain console (log "Long pause detected, reconnecting for fresh stream..."))
|
||||||
(reconnect-stream))))))
|
(reconnect-stream))))))
|
||||||
|
|
||||||
;; Spectrum analyzer hooks
|
;; Spectrum analyzer hooks
|
||||||
(when (ps:@ window |initSpectrumAnalyzer|)
|
(when (ps:@ window |initSpectrumAnalyzer|)
|
||||||
(ps:chain audio-element (add-event-listener "play"
|
(ps:chain audio-element (add-event-listener "play"
|
||||||
(lambda () (ps:chain window (init-spectrum-analyzer))))))
|
(lambda () (ps:chain window (init-spectrum-analyzer))))))
|
||||||
|
|
||||||
(when (ps:@ window |stopSpectrumAnalyzer|)
|
(when (ps:@ window |stopSpectrumAnalyzer|)
|
||||||
(ps:chain audio-element (add-event-listener "pause"
|
(ps:chain audio-element (add-event-listener "pause"
|
||||||
(lambda () (ps:chain window (stop-spectrum-analyzer)))))))
|
(lambda () (ps:chain window (stop-spectrum-analyzer)))))))
|
||||||
|
|
||||||
(defun redirect-when-frame ()
|
(defun redirect-when-frame ()
|
||||||
(let* ((path (ps:@ window location pathname))
|
(let* ((path (ps:@ window location pathname))
|
||||||
|
|
@ -399,49 +399,49 @@
|
||||||
|
|
||||||
;; Initialize on page load
|
;; Initialize on page load
|
||||||
(ps:chain document
|
(ps:chain document
|
||||||
(add-event-listener
|
(add-event-listener
|
||||||
"DOMContentLoaded"
|
"DOMContentLoaded"
|
||||||
(lambda ()
|
(lambda ()
|
||||||
;; Update stream information
|
;; Update stream information
|
||||||
(update-stream-information)
|
(update-stream-information)
|
||||||
|
|
||||||
;; Periodically update stream info if in frameset
|
;; Periodically update stream info if in frameset
|
||||||
(let ((is-frameset-page (not (= (ps:@ window parent) (ps:@ window self)))))
|
(let ((is-frameset-page (not (= (ps:@ window parent) (ps:@ window self)))))
|
||||||
(when is-frameset-page
|
(when is-frameset-page
|
||||||
(set-interval update-stream-information 1000)))
|
(set-interval update-stream-information 10000)))
|
||||||
|
|
||||||
;; Update now playing
|
;; Update now playing
|
||||||
(update-now-playing)
|
(update-now-playing)
|
||||||
|
|
||||||
;; Attach event listeners to audio element
|
;; Attach event listeners to audio element
|
||||||
(let ((audio-element (ps:chain document (get-element-by-id "live-audio"))))
|
(let ((audio-element (ps:chain document (get-element-by-id "live-audio"))))
|
||||||
(when audio-element
|
(when audio-element
|
||||||
(attach-audio-event-listeners audio-element)))
|
(attach-audio-event-listeners audio-element)))
|
||||||
|
|
||||||
;; Check frameset preference
|
;; Check frameset preference
|
||||||
(let ((path (ps:@ window location pathname))
|
(let ((path (ps:@ window location pathname))
|
||||||
(is-frameset-page (not (= (ps:@ window parent) (ps:@ window self)))))
|
(is-frameset-page (not (= (ps:@ window parent) (ps:@ window self)))))
|
||||||
(when (and (= (ps:chain local-storage (get-item "useFrameset")) "true")
|
(when (and (= (ps:chain local-storage (get-item "useFrameset")) "true")
|
||||||
(not is-frameset-page)
|
(not is-frameset-page)
|
||||||
(ps:chain path (includes "/asteroid")))
|
(ps:chain path (includes "/asteroid")))
|
||||||
(setf (ps:@ window location href) "/asteroid/frameset"))
|
(setf (ps:@ window location href) "/asteroid/frameset"))
|
||||||
|
|
||||||
(redirect-when-frame)))))
|
(redirect-when-frame)))))
|
||||||
|
|
||||||
;; Update now playing every 5 seconds
|
;; Update now playing every 5 seconds
|
||||||
(set-interval update-now-playing 5000)
|
(set-interval update-now-playing 5000)
|
||||||
|
|
||||||
;; Listen for messages from popout window
|
;; Listen for messages from popout window
|
||||||
(ps:chain window
|
(ps:chain window
|
||||||
(add-event-listener
|
(add-event-listener
|
||||||
"message"
|
"message"
|
||||||
(lambda (event)
|
(lambda (event)
|
||||||
(cond
|
(cond
|
||||||
((= (ps:@ event data type) "popout-opened")
|
((= (ps:@ event data type) "popout-opened")
|
||||||
(update-popout-button t))
|
(update-popout-button t))
|
||||||
((= (ps:@ event data type) "popout-closed")
|
((= (ps:@ event data type) "popout-closed")
|
||||||
(update-popout-button nil)
|
(update-popout-button nil)
|
||||||
(setf *popout-window* nil))))))
|
(setf *popout-window* nil))))))
|
||||||
|
|
||||||
;; Check if popout is still open periodically
|
;; Check if popout is still open periodically
|
||||||
(set-interval
|
(set-interval
|
||||||
|
|
|
||||||
Binary file not shown.
|
After Width: | Height: | Size: 904 B |
|
|
@ -29,7 +29,7 @@
|
||||||
<span class="now-playing-mini" id="mini-now-playing">Loading...</span>
|
<span class="now-playing-mini" id="mini-now-playing">Loading...</span>
|
||||||
|
|
||||||
<button id="reconnect-btn" onclick="reconnectStream()" class="persistent-reconnect-btn" title="Reconnect if audio stops working">
|
<button id="reconnect-btn" onclick="reconnectStream()" class="persistent-reconnect-btn" title="Reconnect if audio stops working">
|
||||||
🔄
|
<img src="/asteroid/static/icons/sync.png" alt="Reconnect" style="width: 18px; height: 18px; vertical-align: middle; filter: invert(48%) sepia(79%) saturate(2476%) hue-rotate(86deg) brightness(118%) contrast(119%);">
|
||||||
</button>
|
</button>
|
||||||
|
|
||||||
<button onclick="disableFramesetMode()" class="persistent-disable-btn">
|
<button onclick="disableFramesetMode()" class="persistent-disable-btn">
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue