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
This commit is contained in:
parent
ff17490b35
commit
34a6d94324
|
|
@ -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*
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
Loading…
Reference in New Issue