Compare commits

...

5 Commits

Author SHA1 Message Date
Glenn Thompson 61d3e490da Add Credits section with icon attribution
Attribution for sync.png icon from Flaticon (meaicon)
2025-12-12 08:57:07 -05:00
Glenn Thompson 86536a2f22 Replace reconnect button emoji with sync icon
- Add static/icons/sync.png (24x24px)
- Use CSS filter to make icon green to match player theme
2025-12-12 08:57:07 -05:00
Glenn Thompson 34a6d94324 Refactor geo stats to use real IPs from web requests
Instead of relying on Icecast's listener IPs (which show proxy IPs
behind HAProxy), capture real client IPs from X-Forwarded-For header
when users visit the front page or audio player frame.

Radiance automatically extracts X-Forwarded-For into (remote *request*).

Changes:
- Add *web-listeners* hash table to track visitors with real IPs
- Add register-web-listener to capture IPs during page requests
- Add collect-geo-stats-from-web-listeners for polling
- Call register-web-listener from front-page and audio-player-frame
- Filter out private/internal IPs (172.x, 192.168.x, 10.x, 127.x)
- Remove session requirement - use IP hash as key for anonymous visitors
2025-12-12 08:57:07 -05:00
Brian O'Reilly ff17490b35 Don't track site specific configuration in the repository. 2025-12-10 15:06:50 -05:00
Brian O'Reilly afa9f2e172 increase the polling interval for #'update-stream-information 2025-12-10 14:57:54 -05:00
7 changed files with 184 additions and 89 deletions

View File

@ -389,6 +389,11 @@ Built with:
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*

View File

@ -742,6 +742,8 @@
;; Front page - regular view by default
(define-page 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
(load-template "front-page")
:title "ASTEROID RADIO"
@ -784,6 +786,8 @@
;; Persistent audio player frame (bottom frame)
(define-page audio-player-frame #@"/audio-player-frame" ()
"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
(load-template "audio-player-frame")
:stream-base-url *stream-base-url*

View File

@ -1,6 +1,9 @@
#!/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
# DB name and access params here.

View File

@ -34,6 +34,13 @@
(defvar *active-listeners* (make-hash-table :test 'equal)
"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)
(defvar *geo-cache* (make-hash-table :test 'equal)
"Cache of IP hash to country code mappings")
@ -57,6 +64,65 @@
(format nil "~a-~a" (get-universal-time) (random 1000000))))
(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
(defun lookup-geoip (ip-address)
@ -350,7 +416,7 @@
country))))))
(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)))
(when listclients-xml
(let ((ips (extract-listener-ips listclients-xml))
@ -365,6 +431,24 @@
(update-geo-stats country count))
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 ()
"Single poll iteration: fetch stats and store"
(let ((stats (fetch-icecast-stats)))
@ -375,10 +459,9 @@
(listeners (getf source :listeners)))
(when mount
(store-listener-snapshot mount listeners)
;; Collect geo stats if there are listeners
(when (and listeners (> listeners 0))
(collect-geo-stats-for-mount mount))
(log:debug "Stored snapshot: ~a = ~a listeners" mount listeners))))))))
(log:debug "Stored snapshot: ~a = ~a listeners" mount listeners)))))))
;; Collect geo stats from web listeners (uses real IPs from X-Forwarded-For)
(collect-geo-stats-from-web-listeners))
(defun stats-polling-loop ()
"Main polling loop - runs in background thread"

View File

@ -112,7 +112,7 @@
(left (/ (- (ps:@ screen width) width) 2))
(top (/ (- (ps:@ screen height) height) 2))
(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
(setf *popout-window*
@ -314,77 +314,77 @@
;; Error handler
(ps:chain audio-element
(add-event-listener "error"
(lambda (err)
(incf *stream-error-count*)
(ps:chain console (log "Stream error:" err))
(if (< *stream-error-count* 3)
;; Auto-retry for first few errors
(progn
(show-stream-status (+ "⚠️ Stream error. Reconnecting... (attempt " *stream-error-count* ")") "warning")
(setf *reconnect-timeout*
(set-timeout reconnect-stream 3000)))
;; Too many errors, show manual reconnect
(progn
(show-stream-status "❌ Stream connection lost. Click Reconnect to try again." "error")
(show-reconnect-button))))))
(lambda (err)
(incf *stream-error-count*)
(ps:chain console (log "Stream error:" err))
(if (< *stream-error-count* 3)
;; Auto-retry for first few errors
(progn
(show-stream-status (+ "⚠️ Stream error. Reconnecting... (attempt " *stream-error-count* ")") "warning")
(setf *reconnect-timeout*
(set-timeout reconnect-stream 3000)))
;; Too many errors, show manual reconnect
(progn
(show-stream-status "❌ Stream connection lost. Click Reconnect to try again." "error")
(show-reconnect-button))))))
;; Stalled handler
(ps:chain audio-element
(add-event-listener "stalled"
(lambda ()
(ps:chain console (log "Stream stalled"))
(show-stream-status "⚠️ Stream stalled. Attempting to recover..." "warning")
(setf *reconnect-timeout*
(set-timeout
(lambda ()
;; Only reconnect if still stalled
(when (ps:@ audio-element paused)
(reconnect-stream)))
5000)))))
(lambda ()
(ps:chain console (log "Stream stalled"))
(show-stream-status "⚠️ Stream stalled. Attempting to recover..." "warning")
(setf *reconnect-timeout*
(set-timeout
(lambda ()
;; Only reconnect if still stalled
(when (ps:@ audio-element paused)
(reconnect-stream)))
5000)))))
;; Waiting handler (buffering)
(ps:chain audio-element
(add-event-listener "waiting"
(lambda ()
(ps:chain console (log "Stream buffering..."))
(show-stream-status "⏳ Buffering..." "info"))))
(lambda ()
(ps:chain console (log "Stream buffering..."))
(show-stream-status "⏳ Buffering..." "info"))))
;; Playing handler - clear any error states
(ps:chain audio-element
(add-event-listener "playing"
(lambda ()
(setf *stream-error-count* 0)
(hide-stream-status)
(hide-reconnect-button)
(when *reconnect-timeout*
(clear-timeout *reconnect-timeout*)
(setf *reconnect-timeout* nil)))))
(lambda ()
(setf *stream-error-count* 0)
(hide-stream-status)
(hide-reconnect-button)
(when *reconnect-timeout*
(clear-timeout *reconnect-timeout*)
(setf *reconnect-timeout* nil)))))
;; Pause handler - track when paused for long pause detection
(ps:chain audio-element
(add-event-listener "pause"
(lambda ()
(setf *last-play-attempt* (ps:chain |Date| (now))))))
(lambda ()
(setf *last-play-attempt* (ps:chain |Date| (now))))))
;; Play handler - detect long pauses that need reconnection
(ps:chain audio-element
(add-event-listener "play"
(lambda ()
(let ((pause-duration (- (ps:chain |Date| (now)) *last-play-attempt*)))
;; If paused for more than 30 seconds, reconnect to get fresh stream
(when (> pause-duration 30000)
(ps:chain console (log "Long pause detected, reconnecting for fresh stream..."))
(reconnect-stream))))))
(lambda ()
(let ((pause-duration (- (ps:chain |Date| (now)) *last-play-attempt*)))
;; If paused for more than 30 seconds, reconnect to get fresh stream
(when (> pause-duration 30000)
(ps:chain console (log "Long pause detected, reconnecting for fresh stream..."))
(reconnect-stream))))))
;; Spectrum analyzer hooks
(when (ps:@ window |initSpectrumAnalyzer|)
(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|)
(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 ()
(let* ((path (ps:@ window location pathname))
@ -399,49 +399,49 @@
;; Initialize on page load
(ps:chain document
(add-event-listener
"DOMContentLoaded"
(lambda ()
;; Update stream information
(update-stream-information)
;; Periodically update stream info if in frameset
(let ((is-frameset-page (not (= (ps:@ window parent) (ps:@ window self)))))
(when is-frameset-page
(set-interval update-stream-information 1000)))
;; Update now playing
(update-now-playing)
;; Attach event listeners to audio element
(let ((audio-element (ps:chain document (get-element-by-id "live-audio"))))
(when audio-element
(attach-audio-event-listeners audio-element)))
;; Check frameset preference
(let ((path (ps:@ window location pathname))
(is-frameset-page (not (= (ps:@ window parent) (ps:@ window self)))))
(when (and (= (ps:chain local-storage (get-item "useFrameset")) "true")
(not is-frameset-page)
(ps:chain path (includes "/asteroid")))
(setf (ps:@ window location href) "/asteroid/frameset"))
(redirect-when-frame)))))
(add-event-listener
"DOMContentLoaded"
(lambda ()
;; Update stream information
(update-stream-information)
;; Periodically update stream info if in frameset
(let ((is-frameset-page (not (= (ps:@ window parent) (ps:@ window self)))))
(when is-frameset-page
(set-interval update-stream-information 10000)))
;; Update now playing
(update-now-playing)
;; Attach event listeners to audio element
(let ((audio-element (ps:chain document (get-element-by-id "live-audio"))))
(when audio-element
(attach-audio-event-listeners audio-element)))
;; Check frameset preference
(let ((path (ps:@ window location pathname))
(is-frameset-page (not (= (ps:@ window parent) (ps:@ window self)))))
(when (and (= (ps:chain local-storage (get-item "useFrameset")) "true")
(not is-frameset-page)
(ps:chain path (includes "/asteroid")))
(setf (ps:@ window location href) "/asteroid/frameset"))
(redirect-when-frame)))))
;; Update now playing every 5 seconds
(set-interval update-now-playing 5000)
;; Listen for messages from popout window
(ps:chain window
(add-event-listener
"message"
(lambda (event)
(cond
((= (ps:@ event data type) "popout-opened")
(update-popout-button t))
((= (ps:@ event data type) "popout-closed")
(update-popout-button nil)
(setf *popout-window* nil))))))
(add-event-listener
"message"
(lambda (event)
(cond
((= (ps:@ event data type) "popout-opened")
(update-popout-button t))
((= (ps:@ event data type) "popout-closed")
(update-popout-button nil)
(setf *popout-window* nil))))))
;; Check if popout is still open periodically
(set-interval

BIN
static/icons/sync.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 904 B

View File

@ -29,7 +29,7 @@
<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">
🔄
<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 onclick="disableFramesetMode()" class="persistent-disable-btn">