Compare commits
No commits in common. "6e23efe1e46281440b9afe5dd9e2dcee64743526" and "edf9326007a8668ddd45f245ecc47c3a5a190e28" have entirely different histories.
6e23efe1e4
...
edf9326007
|
|
@ -29,11 +29,6 @@
|
|||
:bordeaux-threads
|
||||
:drakma
|
||||
:cl-cron
|
||||
;; CL-Streamer (replaces Icecast + Liquidsoap)
|
||||
:cl-streamer
|
||||
:cl-streamer/encoder
|
||||
:cl-streamer/aac-encoder
|
||||
:cl-streamer/harmony
|
||||
;; radiance interfaces
|
||||
:i-log4cl
|
||||
:i-postmodern
|
||||
|
|
@ -69,7 +64,6 @@
|
|||
(:file "user-management")
|
||||
(:file "playlist-management")
|
||||
(:file "stream-control")
|
||||
(:file "stream-harmony")
|
||||
(:file "playlist-scheduler")
|
||||
(:file "listener-stats")
|
||||
(:file "user-profile")
|
||||
|
|
|
|||
226
asteroid.lisp
226
asteroid.lisp
|
|
@ -442,13 +442,11 @@
|
|||
;; Load into in-memory queue
|
||||
(let ((count (load-queue-from-m3u-file))
|
||||
(channel-name (get-curated-channel-name)))
|
||||
;; Skip/switch to new playlist
|
||||
(if *harmony-pipeline*
|
||||
(harmony-load-playlist playlist-path)
|
||||
(handler-case
|
||||
(liquidsoap-command "stream-queue_m3u.skip")
|
||||
(error (e)
|
||||
(format *error-output* "Warning: Could not skip track: ~a~%" e))))
|
||||
;; Skip current track to trigger crossfade to new playlist
|
||||
(handler-case
|
||||
(liquidsoap-command "stream-queue_m3u.skip")
|
||||
(error (e)
|
||||
(format *error-output* "Warning: Could not skip track: ~a~%" e)))
|
||||
(api-output `(("status" . "success")
|
||||
("message" . ,(format nil "Loaded playlist: ~a" name))
|
||||
("count" . ,count)
|
||||
|
|
@ -570,74 +568,48 @@
|
|||
(error () seconds-str)))
|
||||
|
||||
(define-api asteroid/liquidsoap/status () ()
|
||||
"Get stream status - uses Harmony pipeline when available, falls back to Liquidsoap"
|
||||
"Get Liquidsoap status including uptime and current track"
|
||||
(require-role :admin)
|
||||
(with-error-handling
|
||||
(if *harmony-pipeline*
|
||||
(let ((status (harmony-get-status)))
|
||||
(api-output `(("status" . "success")
|
||||
("backend" . "harmony")
|
||||
("uptime" . "n/a")
|
||||
("metadata" . ,(getf status :current-track))
|
||||
("remaining" . "n/a")
|
||||
("listeners" . ,(getf status :listeners))
|
||||
("queue_length" . ,(getf status :queue-length)))))
|
||||
(let ((uptime (liquidsoap-command "uptime"))
|
||||
(metadata-raw (liquidsoap-command "output.icecast.1.metadata"))
|
||||
(remaining-raw (liquidsoap-command "output.icecast.1.remaining")))
|
||||
(api-output `(("status" . "success")
|
||||
("backend" . "liquidsoap")
|
||||
("uptime" . ,(string-trim '(#\Space #\Newline #\Return) uptime))
|
||||
("metadata" . ,(parse-liquidsoap-metadata metadata-raw))
|
||||
("remaining" . ,(format-remaining-time
|
||||
(string-trim '(#\Space #\Newline #\Return) remaining-raw)))))))))
|
||||
(let ((uptime (liquidsoap-command "uptime"))
|
||||
(metadata-raw (liquidsoap-command "output.icecast.1.metadata"))
|
||||
(remaining-raw (liquidsoap-command "output.icecast.1.remaining")))
|
||||
(api-output `(("status" . "success")
|
||||
("uptime" . ,(string-trim '(#\Space #\Newline #\Return) uptime))
|
||||
("metadata" . ,(parse-liquidsoap-metadata metadata-raw))
|
||||
("remaining" . ,(format-remaining-time
|
||||
(string-trim '(#\Space #\Newline #\Return) remaining-raw))))))))
|
||||
|
||||
(define-api asteroid/liquidsoap/skip () ()
|
||||
"Skip the current track"
|
||||
"Skip the current track in Liquidsoap"
|
||||
(require-role :admin)
|
||||
(with-error-handling
|
||||
(if *harmony-pipeline*
|
||||
(progn
|
||||
(harmony-skip-track)
|
||||
(api-output `(("status" . "success")
|
||||
("message" . "Track skipped (Harmony)"))))
|
||||
(let ((result (liquidsoap-command "stream-queue_m3u.skip")))
|
||||
(api-output `(("status" . "success")
|
||||
("message" . "Track skipped")
|
||||
("result" . ,(string-trim '(#\Space #\Newline #\Return) result))))))))
|
||||
(let ((result (liquidsoap-command "stream-queue_m3u.skip")))
|
||||
(api-output `(("status" . "success")
|
||||
("message" . "Track skipped")
|
||||
("result" . ,(string-trim '(#\Space #\Newline #\Return) result)))))))
|
||||
|
||||
(define-api asteroid/liquidsoap/reload () ()
|
||||
"Force playlist reload"
|
||||
"Force Liquidsoap to reload the playlist"
|
||||
(require-role :admin)
|
||||
(with-error-handling
|
||||
(if *harmony-pipeline*
|
||||
(let* ((playlist-path (get-stream-queue-path))
|
||||
(count (harmony-load-playlist playlist-path)))
|
||||
(api-output `(("status" . "success")
|
||||
("message" . ,(format nil "Playlist reloaded (~A tracks via Harmony)" count)))))
|
||||
(let ((result (liquidsoap-command "stream-queue_m3u.reload")))
|
||||
(api-output `(("status" . "success")
|
||||
("message" . "Playlist reloaded")
|
||||
("result" . ,(string-trim '(#\Space #\Newline #\Return) result))))))))
|
||||
(let ((result (liquidsoap-command "stream-queue_m3u.reload")))
|
||||
(api-output `(("status" . "success")
|
||||
("message" . "Playlist reloaded")
|
||||
("result" . ,(string-trim '(#\Space #\Newline #\Return) result)))))))
|
||||
|
||||
(define-api asteroid/liquidsoap/restart () ()
|
||||
"Restart the streaming backend"
|
||||
"Restart the Liquidsoap Docker container"
|
||||
(require-role :admin)
|
||||
(with-error-handling
|
||||
(if *harmony-pipeline*
|
||||
(progn
|
||||
(stop-harmony-streaming)
|
||||
(start-harmony-streaming)
|
||||
(api-output `(("status" . "success")
|
||||
("message" . "Harmony pipeline restarted"))))
|
||||
(let ((result (uiop:run-program
|
||||
"docker restart asteroid-liquidsoap"
|
||||
:output :string
|
||||
:error-output :string
|
||||
:ignore-error-status t)))
|
||||
(api-output `(("status" . "success")
|
||||
("message" . "Liquidsoap container restarting")
|
||||
("result" . ,result)))))))
|
||||
(let ((result (uiop:run-program
|
||||
"docker restart asteroid-liquidsoap"
|
||||
:output :string
|
||||
:error-output :string
|
||||
:ignore-error-status t)))
|
||||
(api-output `(("status" . "success")
|
||||
("message" . "Liquidsoap container restarting")
|
||||
("result" . ,result))))))
|
||||
|
||||
(define-api asteroid/icecast/restart () ()
|
||||
"Restart the Icecast Docker container"
|
||||
|
|
@ -853,7 +825,7 @@
|
|||
"Main front page"
|
||||
;; Register this visitor for geo stats (captures real IP from X-Forwarded-For)
|
||||
(register-web-listener)
|
||||
(let ((now-playing-stats (get-now-playing-stats)))
|
||||
(let ((now-playing-stats (icecast-now-playing *stream-base-url*)))
|
||||
(clip:process-to-string
|
||||
(load-template "front-page")
|
||||
:title "ASTEROID RADIO"
|
||||
|
|
@ -1010,31 +982,25 @@
|
|||
|
||||
;; Status check functions
|
||||
(defun check-icecast-status ()
|
||||
"Check if streaming backend is running.
|
||||
Uses Harmony pipeline status when available, falls back to Icecast HTTP check."
|
||||
(if *harmony-pipeline*
|
||||
"🟢 Running (cl-streamer)"
|
||||
(handler-case
|
||||
(let ((response (drakma:http-request (format nil "~a/status-json.xsl" *stream-base-url*)
|
||||
:want-stream nil
|
||||
:connection-timeout 2)))
|
||||
(if response "🟢 Running" "🔴 Not Running"))
|
||||
(error () "🔴 Not Running"))))
|
||||
"Check if Icecast server is running and accessible"
|
||||
(handler-case
|
||||
(let ((response (drakma:http-request (format nil "~a/status-json.xsl" *stream-base-url*)
|
||||
:want-stream nil
|
||||
:connection-timeout 2)))
|
||||
(if response "🟢 Running" "🔴 Not Running"))
|
||||
(error () "🔴 Not Running")))
|
||||
|
||||
(defun check-liquidsoap-status ()
|
||||
"Check if Liquidsoap is running via Docker.
|
||||
Returns N/A when using cl-streamer."
|
||||
(if *harmony-pipeline*
|
||||
"⚪ N/A (using cl-streamer)"
|
||||
(handler-case
|
||||
(let* ((output (with-output-to-string (stream)
|
||||
(uiop:run-program '("docker" "ps" "--filter" "name=liquidsoap" "--format" "{{.Status}}")
|
||||
:output stream
|
||||
:error-output nil
|
||||
:ignore-error-status t)))
|
||||
(running-p (search "Up" output)))
|
||||
(if running-p "🟢 Running" "🔴 Not Running"))
|
||||
(error () "🔴 Not Running"))))
|
||||
"Check if Liquidsoap is running via Docker"
|
||||
(handler-case
|
||||
(let* ((output (with-output-to-string (stream)
|
||||
(uiop:run-program '("docker" "ps" "--filter" "name=liquidsoap" "--format" "{{.Status}}")
|
||||
:output stream
|
||||
:error-output nil
|
||||
:ignore-error-status t)))
|
||||
(running-p (search "Up" output)))
|
||||
(if running-p "🟢 Running" "🔴 Not Running"))
|
||||
(error () "🔴 Not Running")))
|
||||
|
||||
;; Admin page (requires authentication)
|
||||
(define-page admin #@"/admin" ()
|
||||
|
|
@ -1382,48 +1348,41 @@
|
|||
("stream-url" . ,(format nil "~a/asteroid.mp3" *stream-base-url*))
|
||||
("stream-status" . "live"))))
|
||||
|
||||
;; Live stream status
|
||||
;; Live stream status from Icecast
|
||||
(define-api-with-limit asteroid/icecast-status () ()
|
||||
"Get live stream status. Uses Harmony pipeline when available, falls back to Icecast."
|
||||
"Get live status from Icecast server"
|
||||
(with-error-handling
|
||||
(if *harmony-pipeline*
|
||||
;; Return status from cl-streamer directly
|
||||
(let* ((now-playing (get-now-playing-stats "asteroid.mp3"))
|
||||
(title (if now-playing (cdr (assoc :title now-playing)) "Unknown"))
|
||||
(listeners (or (cl-streamer:get-listener-count) 0)))
|
||||
(let* ((icecast-url (format nil "~a/admin/stats.xml" *stream-base-url*))
|
||||
(response (drakma:http-request icecast-url
|
||||
:want-stream nil
|
||||
:basic-authorization '("admin" "asteroid_admin_2024"))))
|
||||
(if response
|
||||
(let ((xml-string (if (stringp response)
|
||||
response
|
||||
(babel:octets-to-string response :encoding :utf-8))))
|
||||
;; Simple XML parsing to extract source information
|
||||
;; Look for <source mount="/asteroid.mp3"> sections and extract title, listeners, etc.
|
||||
(multiple-value-bind (match-start match-end)
|
||||
(cl-ppcre:scan "<source mount=\"/asteroid\\.mp3\">" xml-string)
|
||||
(if match-start
|
||||
(let* ((source-section (subseq xml-string match-start
|
||||
(or (cl-ppcre:scan "</source>" xml-string :start match-start)
|
||||
(length xml-string))))
|
||||
(titlep (cl-ppcre:all-matches "<title>" source-section))
|
||||
(listenersp (cl-ppcre:all-matches "<listeners>" source-section))
|
||||
(title (if titlep (cl-ppcre:regex-replace-all ".*<title>(.*?)</title>.*" source-section "\\1") "Unknown"))
|
||||
(listeners (if listenersp (cl-ppcre:regex-replace-all ".*<listeners>(.*?)</listeners>.*" source-section "\\1") "0")))
|
||||
;; Return JSON in format expected by frontend
|
||||
(api-output
|
||||
`(("icestats" . (("source" . (("listenurl" . ,(format nil "~a/asteroid.mp3" *stream-base-url*))
|
||||
("title" . ,title)
|
||||
("listeners" . ,(parse-integer listeners :junk-allowed t)))))))))
|
||||
;; No source found, return empty
|
||||
(api-output
|
||||
`(("icestats" . (("source" . nil))))))))
|
||||
(api-output
|
||||
`(("icestats" . (("source" . (("listenurl" . ,(format nil "~a/asteroid.mp3" *stream-base-url*))
|
||||
("title" . ,title)
|
||||
("listeners" . ,listeners))))))))
|
||||
;; Fallback: poll Icecast XML
|
||||
(let* ((icecast-url (format nil "~a/admin/stats.xml" *stream-base-url*))
|
||||
(response (drakma:http-request icecast-url
|
||||
:want-stream nil
|
||||
:basic-authorization '("admin" "asteroid_admin_2024"))))
|
||||
(if response
|
||||
(let ((xml-string (if (stringp response)
|
||||
response
|
||||
(babel:octets-to-string response :encoding :utf-8))))
|
||||
(multiple-value-bind (match-start match-end)
|
||||
(cl-ppcre:scan "<source mount=\"/asteroid\\.mp3\">" xml-string)
|
||||
(declare (ignore match-end))
|
||||
(if match-start
|
||||
(let* ((source-section (subseq xml-string match-start
|
||||
(or (cl-ppcre:scan "</source>" xml-string :start match-start)
|
||||
(length xml-string))))
|
||||
(titlep (cl-ppcre:all-matches "<title>" source-section))
|
||||
(listenersp (cl-ppcre:all-matches "<listeners>" source-section))
|
||||
(title (if titlep (cl-ppcre:regex-replace-all ".*<title>(.*?)</title>.*" source-section "\\1") "Unknown"))
|
||||
(listeners (if listenersp (cl-ppcre:regex-replace-all ".*<listeners>(.*?)</listeners>.*" source-section "\\1") "0")))
|
||||
(api-output
|
||||
`(("icestats" . (("source" . (("listenurl" . ,(format nil "~a/asteroid.mp3" *stream-base-url*))
|
||||
("title" . ,title)
|
||||
("listeners" . ,(parse-integer listeners :junk-allowed t)))))))))
|
||||
(api-output
|
||||
`(("icestats" . (("source" . nil))))))))
|
||||
(api-output
|
||||
`(("error" . "Could not connect to Icecast server"))
|
||||
:status 503))))))
|
||||
`(("error" . "Could not connect to Icecast server"))
|
||||
:status 503)))))
|
||||
|
||||
;;; Listener Statistics API Endpoints
|
||||
|
||||
|
|
@ -1567,23 +1526,4 @@
|
|||
;; TODO: Add auto-scan on startup once database timing issues are resolved
|
||||
;; For now, use the "Scan Library" button in the admin interface
|
||||
|
||||
;; Start cl-streamer audio pipeline (replaces Icecast + Liquidsoap)
|
||||
(format t "Starting cl-streamer audio pipeline...~%")
|
||||
(handler-case
|
||||
(progn
|
||||
(start-harmony-streaming)
|
||||
;; Load the current playlist and start playing
|
||||
(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
|
||||
:crossfade-duration 3.0)
|
||||
(format t "~A tracks loaded from stream-queue.m3u~%" (length file-list))))))
|
||||
(format t "📡 Stream: ~a/asteroid.mp3~%" *stream-base-url*)
|
||||
(format t "📡 Stream: ~a/asteroid.aac~%" *stream-base-url*))
|
||||
(error (e)
|
||||
(format t "⚠️ Could not start streaming: ~a~%" e)
|
||||
(format t " (Web server will run without streaming)~%")))
|
||||
|
||||
(run-server))
|
||||
|
|
|
|||
|
|
@ -10,17 +10,7 @@
|
|||
#:play-file
|
||||
#:play-list
|
||||
#:pipeline-server
|
||||
#:make-streaming-server
|
||||
;; Track state & control
|
||||
#:pipeline-current-track
|
||||
#:pipeline-on-track-change
|
||||
#:pipeline-skip
|
||||
#:pipeline-queue-files
|
||||
#:pipeline-get-queue
|
||||
#:pipeline-clear-queue
|
||||
;; Metadata helpers
|
||||
#:read-audio-metadata
|
||||
#:format-display-title))
|
||||
#:make-streaming-server))
|
||||
|
||||
(in-package #:cl-streamer/harmony)
|
||||
|
||||
|
|
@ -104,20 +94,7 @@
|
|||
(mount-path :initarg :mount-path :accessor pipeline-mount-path :initform "/stream.mp3")
|
||||
(sample-rate :initarg :sample-rate :accessor pipeline-sample-rate :initform 44100)
|
||||
(channels :initarg :channels :accessor pipeline-channels :initform 2)
|
||||
(running :initform nil :accessor pipeline-running-p)
|
||||
;; Track state
|
||||
(current-track :initform nil :accessor pipeline-current-track
|
||||
:documentation "Plist of current track: (:title :artist :album :file :display-title)")
|
||||
(on-track-change :initarg :on-track-change :initform nil
|
||||
:accessor pipeline-on-track-change
|
||||
:documentation "Callback (lambda (pipeline track-info)) called on track change")
|
||||
;; Playlist queue & skip control
|
||||
(file-queue :initform nil :accessor pipeline-file-queue
|
||||
:documentation "List of file entries to play after current playlist")
|
||||
(queue-lock :initform (bt:make-lock "pipeline-queue-lock")
|
||||
:reader pipeline-queue-lock)
|
||||
(skip-flag :initform nil :accessor pipeline-skip-flag
|
||||
:documentation "Set to T to skip the current track")))
|
||||
(running :initform nil :accessor pipeline-running-p)))
|
||||
|
||||
(defun make-audio-pipeline (&key encoder stream-server (mount-path "/stream.mp3")
|
||||
(sample-rate 44100) (channels 2))
|
||||
|
|
@ -179,43 +156,6 @@
|
|||
(log:info "Audio pipeline stopped")
|
||||
pipeline)
|
||||
|
||||
;;; ---- Pipeline Control ----
|
||||
|
||||
(defun pipeline-skip (pipeline)
|
||||
"Skip the current track. The play-list loop will detect this and advance."
|
||||
(setf (pipeline-skip-flag pipeline) t)
|
||||
(log:info "Skip requested"))
|
||||
|
||||
(defun pipeline-queue-files (pipeline file-entries &key (position :end))
|
||||
"Add file entries to the pipeline queue.
|
||||
Each entry is a string (path) or plist (:file path :title title).
|
||||
POSITION is :end (append) or :next (prepend)."
|
||||
(bt:with-lock-held ((pipeline-queue-lock pipeline))
|
||||
(case position
|
||||
(:next (setf (pipeline-file-queue pipeline)
|
||||
(append file-entries (pipeline-file-queue pipeline))))
|
||||
(t (setf (pipeline-file-queue pipeline)
|
||||
(append (pipeline-file-queue pipeline) file-entries)))))
|
||||
(log:info "Queued ~A files (~A)" (length file-entries) position))
|
||||
|
||||
(defun pipeline-get-queue (pipeline)
|
||||
"Get the current file queue (copy)."
|
||||
(bt:with-lock-held ((pipeline-queue-lock pipeline))
|
||||
(copy-list (pipeline-file-queue pipeline))))
|
||||
|
||||
(defun pipeline-clear-queue (pipeline)
|
||||
"Clear the file queue."
|
||||
(bt:with-lock-held ((pipeline-queue-lock pipeline))
|
||||
(setf (pipeline-file-queue pipeline) nil))
|
||||
(log:info "Queue cleared"))
|
||||
|
||||
(defun pipeline-pop-queue (pipeline)
|
||||
"Pop the next entry from the file queue (internal use)."
|
||||
(bt:with-lock-held ((pipeline-queue-lock pipeline))
|
||||
(pop (pipeline-file-queue pipeline))))
|
||||
|
||||
;;; ---- Metadata ----
|
||||
|
||||
(defun read-audio-metadata (file-path)
|
||||
"Read metadata (artist, title, album) from an audio file using taglib.
|
||||
Returns a plist (:artist ... :title ... :album ...) or NIL on failure."
|
||||
|
|
@ -250,15 +190,6 @@
|
|||
(dolist (output (drain-outputs (pipeline-drain pipeline)))
|
||||
(cl-streamer:set-now-playing (cdr output) display-title)))
|
||||
|
||||
(defun notify-track-change (pipeline track-info)
|
||||
"Update pipeline state and fire the on-track-change callback."
|
||||
(setf (pipeline-current-track pipeline) track-info)
|
||||
(when (pipeline-on-track-change pipeline)
|
||||
(handler-case
|
||||
(funcall (pipeline-on-track-change pipeline) pipeline track-info)
|
||||
(error (e)
|
||||
(log:warn "Track change callback error: ~A" e)))))
|
||||
|
||||
(defun play-file (pipeline file-path &key (mixer :music) title (on-end :free)
|
||||
(update-metadata t))
|
||||
"Play an audio file through the pipeline.
|
||||
|
|
@ -271,19 +202,12 @@
|
|||
(let* ((path (pathname file-path))
|
||||
(server (pipeline-harmony-server pipeline))
|
||||
(harmony:*server* server)
|
||||
(tags (read-audio-metadata path))
|
||||
(display-title (format-display-title path title))
|
||||
(track-info (list :file (namestring path)
|
||||
:display-title display-title
|
||||
:artist (getf tags :artist)
|
||||
:title (getf tags :title)
|
||||
:album (getf tags :album))))
|
||||
(display-title (format-display-title path title)))
|
||||
(when update-metadata
|
||||
(update-all-mounts-metadata pipeline display-title)
|
||||
(notify-track-change pipeline track-info))
|
||||
(update-all-mounts-metadata pipeline display-title))
|
||||
(let ((voice (harmony:play path :mixer mixer :on-end on-end)))
|
||||
(log:info "Now playing: ~A" display-title)
|
||||
(values voice display-title track-info))))
|
||||
(values voice display-title))))
|
||||
|
||||
(defun voice-remaining-seconds (voice)
|
||||
"Return estimated seconds remaining for a voice, or NIL if unknown."
|
||||
|
|
@ -307,91 +231,64 @@
|
|||
do (setf (mixed:volume voice) (max 0.0 (min 1.0 (float vol))))
|
||||
(sleep step-time))))
|
||||
|
||||
(defun next-entry (pipeline file-list-ref)
|
||||
"Get the next entry to play: from file-list first, then from the queue.
|
||||
FILE-LIST-REF is a cons cell whose car is the remaining file list.
|
||||
Returns an entry or NIL if nothing to play."
|
||||
(or (pop (car file-list-ref))
|
||||
(pipeline-pop-queue pipeline)))
|
||||
|
||||
(defun play-list (pipeline file-list &key (crossfade-duration 3.0)
|
||||
(fade-in 2.0)
|
||||
(fade-out 2.0)
|
||||
(loop-queue nil))
|
||||
(fade-out 2.0))
|
||||
"Play a list of file paths sequentially through the pipeline.
|
||||
Each entry can be a string (path) or a plist (:file path :title title).
|
||||
CROSSFADE-DURATION is how early to start the next track (seconds).
|
||||
FADE-IN/FADE-OUT control the volume ramp durations.
|
||||
Both voices play simultaneously through the mixer during crossfade.
|
||||
When LOOP-QUEUE is T, waits for new queue entries instead of stopping."
|
||||
Both voices play simultaneously through the mixer during crossfade."
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(let ((prev-voice nil)
|
||||
(idx 0)
|
||||
(remaining-list (list (copy-list file-list))))
|
||||
(loop while (pipeline-running-p pipeline)
|
||||
for entry = (next-entry pipeline remaining-list)
|
||||
do (cond
|
||||
;; No entry and loop mode: wait for queue
|
||||
((and (null entry) loop-queue)
|
||||
(sleep 1))
|
||||
;; No entry: done
|
||||
((null entry)
|
||||
(return))
|
||||
;; Play the entry
|
||||
(t
|
||||
(multiple-value-bind (path title)
|
||||
(if (listp entry)
|
||||
(values (getf entry :file) (getf entry :title))
|
||||
(values entry nil))
|
||||
(handler-case
|
||||
(let* ((server (pipeline-harmony-server pipeline))
|
||||
(harmony:*server* server))
|
||||
(multiple-value-bind (voice display-title track-info)
|
||||
(play-file pipeline path :title title
|
||||
:on-end :disconnect
|
||||
:update-metadata (null prev-voice))
|
||||
(when voice
|
||||
;; If this isn't the first track, crossfade
|
||||
(when (and prev-voice (> idx 0))
|
||||
(setf (mixed:volume voice) 0.0)
|
||||
(let ((fade-thread
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(volume-ramp prev-voice 0.0 fade-out)
|
||||
(harmony:stop prev-voice))
|
||||
:name "cl-streamer-fadeout")))
|
||||
(volume-ramp voice 1.0 fade-in)
|
||||
(bt:join-thread fade-thread))
|
||||
;; Crossfade done — now update metadata & notify
|
||||
(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)
|
||||
(loop while (and (pipeline-running-p pipeline)
|
||||
(not (mixed:done-p voice))
|
||||
(not (pipeline-skip-flag pipeline)))
|
||||
for remaining = (voice-remaining-seconds voice)
|
||||
when (and remaining
|
||||
(<= remaining crossfade-duration)
|
||||
(not (mixed:done-p voice)))
|
||||
do (setf prev-voice voice)
|
||||
(return)
|
||||
do (sleep 0.1))
|
||||
;; Handle skip
|
||||
(when (pipeline-skip-flag pipeline)
|
||||
(setf (pipeline-skip-flag pipeline) nil)
|
||||
(setf prev-voice voice)
|
||||
(log:info "Skipping current track"))
|
||||
;; If track ended naturally (no crossfade), clean up
|
||||
(when (mixed:done-p voice)
|
||||
(harmony:stop voice)
|
||||
(setf prev-voice nil))
|
||||
(incf idx))))
|
||||
(error (e)
|
||||
(log:warn "Error playing ~A: ~A" path e)
|
||||
(sleep 1)))))))
|
||||
(let ((prev-voice nil))
|
||||
(loop for entry in file-list
|
||||
for idx from 0
|
||||
while (pipeline-running-p pipeline)
|
||||
do (multiple-value-bind (path title)
|
||||
(if (listp entry)
|
||||
(values (getf entry :file) (getf entry :title))
|
||||
(values entry nil))
|
||||
(handler-case
|
||||
(let* ((server (pipeline-harmony-server pipeline))
|
||||
(harmony:*server* server))
|
||||
(multiple-value-bind (voice display-title)
|
||||
(play-file pipeline path :title title
|
||||
:on-end :disconnect
|
||||
:update-metadata (null prev-voice))
|
||||
(when voice
|
||||
;; If this isn't the first track, crossfade
|
||||
(when (and prev-voice (> idx 0))
|
||||
(setf (mixed:volume voice) 0.0)
|
||||
;; Fade in new voice and fade out old voice in parallel
|
||||
(let ((fade-thread
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(volume-ramp prev-voice 0.0 fade-out)
|
||||
(harmony:stop prev-voice))
|
||||
:name "cl-streamer-fadeout")))
|
||||
(volume-ramp voice 1.0 fade-in)
|
||||
(bt:join-thread fade-thread))
|
||||
;; Now the crossfade is done, update metadata
|
||||
(update-all-mounts-metadata pipeline display-title))
|
||||
;; Wait for track to approach its end
|
||||
(sleep 0.5)
|
||||
(loop while (and (pipeline-running-p pipeline)
|
||||
(not (mixed:done-p voice)))
|
||||
for remaining = (voice-remaining-seconds voice)
|
||||
when (and remaining
|
||||
(<= remaining crossfade-duration)
|
||||
(not (mixed:done-p voice)))
|
||||
do (setf prev-voice voice)
|
||||
(return)
|
||||
do (sleep 0.1))
|
||||
;; If track ended naturally (no crossfade), clean up
|
||||
(when (mixed:done-p voice)
|
||||
(harmony:stop voice)
|
||||
(setf prev-voice nil)))))
|
||||
(error (e)
|
||||
(log:warn "Error playing ~A: ~A" path e)
|
||||
(sleep 1)))))
|
||||
;; Clean up last voice
|
||||
(when prev-voice
|
||||
(let ((harmony:*server* (pipeline-harmony-server pipeline)))
|
||||
|
|
|
|||
|
|
@ -50,8 +50,6 @@
|
|||
(format stream "icy-br: ~A~C~C" bitrate #\Return #\Linefeed)
|
||||
(when metaint
|
||||
(format stream "icy-metaint: ~A~C~C" metaint #\Return #\Linefeed))
|
||||
(format stream "Access-Control-Allow-Origin: *~C~C" #\Return #\Linefeed)
|
||||
(format stream "Access-Control-Allow-Headers: Origin, Accept, Content-Type, Icy-MetaData~C~C" #\Return #\Linefeed)
|
||||
(format stream "Cache-Control: no-cache, no-store~C~C" #\Return #\Linefeed)
|
||||
(format stream "Connection: close~C~C" #\Return #\Linefeed)
|
||||
(format stream "~C~C" #\Return #\Linefeed)
|
||||
|
|
|
|||
|
|
@ -122,13 +122,7 @@
|
|||
:external-format :latin-1)))
|
||||
(handler-case
|
||||
(let* ((request-line (read-line stream))
|
||||
(headers (read-http-headers stream))
|
||||
(method (first (split-sequence:split-sequence #\Space request-line))))
|
||||
;; Handle CORS preflight
|
||||
(when (string-equal method "OPTIONS")
|
||||
(send-cors-preflight stream)
|
||||
(ignore-errors (usocket:socket-close client-socket))
|
||||
(return-from handle-client))
|
||||
(headers (read-http-headers stream)))
|
||||
(multiple-value-bind (path wants-meta)
|
||||
(parse-icy-request request-line headers)
|
||||
(let ((mount (gethash path (server-mounts server))))
|
||||
|
|
@ -184,13 +178,8 @@
|
|||
(stream (client-stream client))
|
||||
(chunk-size 4096)
|
||||
(chunk (make-array chunk-size :element-type '(unsigned-byte 8))))
|
||||
;; For MP3, burst recent data for fast playback start.
|
||||
;; For AAC, start from current position — AAC requires ADTS frame alignment
|
||||
;; and burst data from mid-stream causes browser decode errors.
|
||||
(setf (client-read-pos client)
|
||||
(if (string= (mount-content-type mount) "audio/aac")
|
||||
(buffer-current-pos buffer)
|
||||
(buffer-burst-start buffer)))
|
||||
;; Start from burst position for fast playback
|
||||
(setf (client-read-pos client) (buffer-burst-start buffer))
|
||||
(loop while (client-active-p client)
|
||||
do (multiple-value-bind (bytes-read new-pos)
|
||||
(buffer-read-from buffer (client-read-pos client) chunk)
|
||||
|
|
@ -206,8 +195,7 @@
|
|||
(write-sequence chunk stream :end bytes-read))
|
||||
(force-output stream))
|
||||
(error (e)
|
||||
(log:warn "Client stream error on ~A: ~A"
|
||||
(mount-path mount) e)
|
||||
(log:debug "Client stream error: ~A" e)
|
||||
(setf (client-active-p client) nil)
|
||||
(return)))))))))
|
||||
|
||||
|
|
@ -233,16 +221,6 @@
|
|||
(incf (client-bytes-since-meta client) bytes-remaining)
|
||||
(setf pos length)))))))
|
||||
|
||||
(defun send-cors-preflight (stream)
|
||||
"Send a CORS preflight response for OPTIONS requests."
|
||||
(format stream "HTTP/1.1 204 No Content~C~C" #\Return #\Linefeed)
|
||||
(format stream "Access-Control-Allow-Origin: *~C~C" #\Return #\Linefeed)
|
||||
(format stream "Access-Control-Allow-Methods: GET, OPTIONS~C~C" #\Return #\Linefeed)
|
||||
(format stream "Access-Control-Allow-Headers: Origin, Accept, Content-Type, Icy-MetaData, Range~C~C" #\Return #\Linefeed)
|
||||
(format stream "Access-Control-Max-Age: 86400~C~C" #\Return #\Linefeed)
|
||||
(format stream "~C~C" #\Return #\Linefeed)
|
||||
(force-output stream))
|
||||
|
||||
(defun send-404 (stream path)
|
||||
"Send a 404 response for unknown mount points."
|
||||
(format stream "HTTP/1.1 404 Not Found~C~C" #\Return #\Linefeed)
|
||||
|
|
|
|||
|
|
@ -14,10 +14,9 @@ if ! docker info > /dev/null 2>&1; then
|
|||
exit 1
|
||||
fi
|
||||
|
||||
# Start services (postgres only - cl-streamer replaces Icecast + Liquidsoap)
|
||||
echo "🔧 Starting postgres..."
|
||||
docker compose up -d postgres
|
||||
# docker compose up -d # Uncomment to start all services (Icecast + Liquidsoap)
|
||||
# Start services
|
||||
echo "🔧 Starting services..."
|
||||
docker compose up -d
|
||||
|
||||
# Wait and show status
|
||||
sleep 3
|
||||
|
|
@ -26,10 +25,8 @@ echo "📊 Service Status:"
|
|||
docker compose ps
|
||||
|
||||
echo ""
|
||||
echo "🎵 Asteroid Radio database is ready!"
|
||||
echo "📡 Streaming is handled by cl-streamer (start from Lisp REPL)"
|
||||
# Legacy Icecast URLs (no longer used):
|
||||
# echo "📡 High Quality MP3: http://localhost:8000/asteroid.mp3"
|
||||
# echo "📡 High Quality AAC: http://localhost:8000/asteroid.aac"
|
||||
# echo "📡 Low Quality MP3: http://localhost:8000/asteroid-low.mp3"
|
||||
# echo "🔧 Admin Panel: http://localhost:8000/admin/"
|
||||
echo "🎵 Asteroid Radio is now streaming!"
|
||||
echo "📡 High Quality MP3: http://localhost:8000/asteroid.mp3"
|
||||
echo "📡 High Quality AAC: http://localhost:8000/asteroid.aac"
|
||||
echo "📡 Low Quality MP3: http://localhost:8000/asteroid-low.mp3"
|
||||
echo "🔧 Admin Panel: http://localhost:8000/admin/"
|
||||
|
|
|
|||
|
|
@ -5,9 +5,8 @@
|
|||
|
||||
echo "🛑 Stopping Asteroid Radio Docker Services..."
|
||||
|
||||
# Stop services (postgres only - cl-streamer replaces Icecast + Liquidsoap)
|
||||
docker compose down postgres
|
||||
# docker compose down # Uncomment to stop all services
|
||||
# Stop services
|
||||
docker compose down
|
||||
|
||||
# if we really need to clean everything and start fresh, run the
|
||||
# following commands:
|
||||
|
|
|
|||
|
|
@ -93,22 +93,23 @@
|
|||
(:track-id . ,(find-track-by-title title))
|
||||
(:favorite-count . ,(or (get-track-favorite-count title) 1))))))))
|
||||
|
||||
(defun get-now-playing-stats (&optional (mount "asteroid.mp3"))
|
||||
"Get now-playing stats from Harmony pipeline, falling back to Icecast.
|
||||
Returns an alist with :listenurl, :title, :listeners, :track-id, :favorite-count."
|
||||
(or (harmony-now-playing mount)
|
||||
(icecast-now-playing *stream-base-url* mount)))
|
||||
|
||||
(define-api-with-limit asteroid/partial/now-playing (&optional mount) (:limit 10 :timeout 1)
|
||||
"Get Partial HTML with live now-playing status.
|
||||
"Get Partial HTML with live status from Icecast server.
|
||||
Optional MOUNT parameter specifies which stream to get metadata from.
|
||||
Uses Harmony pipeline when available, falls back to Icecast."
|
||||
Always polls both streams to keep recently played lists updated."
|
||||
(with-error-handling
|
||||
(let* ((mount-name (or mount "asteroid.mp3"))
|
||||
(now-playing-stats (get-now-playing-stats mount-name)))
|
||||
;; Always poll both streams to keep recently played lists updated
|
||||
(dummy-curated (when (not (string= mount-name "asteroid.mp3"))
|
||||
(icecast-now-playing *stream-base-url* "asteroid.mp3")))
|
||||
(dummy-shuffle (when (not (string= mount-name "asteroid-shuffle.mp3"))
|
||||
(icecast-now-playing *stream-base-url* "asteroid-shuffle.mp3")))
|
||||
(now-playing-stats (icecast-now-playing *stream-base-url* mount-name)))
|
||||
(if now-playing-stats
|
||||
(let* ((title (cdr (assoc :title now-playing-stats)))
|
||||
(favorite-count (or (get-track-favorite-count title) 0)))
|
||||
;; TODO: it should be able to define a custom api-output for this
|
||||
;; (api-output <clip-parser> :format "html"))
|
||||
(setf (header "Content-Type") "text/html")
|
||||
(clip:process-to-string
|
||||
(load-template "partial/now-playing")
|
||||
|
|
@ -127,7 +128,7 @@
|
|||
Optional MOUNT parameter specifies which stream to get metadata from."
|
||||
(with-error-handling
|
||||
(let* ((mount-name (or mount "asteroid.mp3"))
|
||||
(now-playing-stats (get-now-playing-stats mount-name)))
|
||||
(now-playing-stats (icecast-now-playing *stream-base-url* mount-name)))
|
||||
(if now-playing-stats
|
||||
(progn
|
||||
(setf (header "Content-Type") "text/plain")
|
||||
|
|
@ -143,7 +144,7 @@
|
|||
(register-web-listener)
|
||||
(with-error-handling
|
||||
(let* ((mount-name (or mount "asteroid.mp3"))
|
||||
(now-playing-stats (get-now-playing-stats mount-name)))
|
||||
(now-playing-stats (icecast-now-playing *stream-base-url* mount-name)))
|
||||
(if now-playing-stats
|
||||
(let* ((title (cdr (assoc :title now-playing-stats)))
|
||||
(favorite-count (or (get-track-favorite-count title) 0))
|
||||
|
|
|
|||
|
|
@ -476,25 +476,16 @@
|
|||
location-counts)))
|
||||
|
||||
(defun poll-and-store-stats ()
|
||||
"Single poll iteration: fetch stats and store.
|
||||
Uses cl-streamer listener counts when Harmony is running, falls back to Icecast."
|
||||
(if *harmony-pipeline*
|
||||
;; Get listener counts directly from cl-streamer
|
||||
(dolist (mount '("/asteroid.mp3" "/asteroid.aac"))
|
||||
(let ((listeners (cl-streamer:get-listener-count mount)))
|
||||
(when (and listeners (> listeners 0))
|
||||
(store-listener-snapshot mount listeners)
|
||||
(log:debug "Stored snapshot: ~a = ~a listeners" mount listeners))))
|
||||
;; Fallback: poll Icecast
|
||||
(let ((stats (fetch-icecast-stats)))
|
||||
(when stats
|
||||
(let ((sources (parse-icecast-sources stats)))
|
||||
(dolist (source sources)
|
||||
(let ((mount (getf source :mount))
|
||||
(listeners (getf source :listeners)))
|
||||
(when mount
|
||||
(store-listener-snapshot mount listeners)
|
||||
(log:debug "Stored snapshot: ~a = ~a listeners" mount listeners))))))))
|
||||
"Single poll iteration: fetch stats and store"
|
||||
(let ((stats (fetch-icecast-stats)))
|
||||
(when stats
|
||||
(let ((sources (parse-icecast-sources stats)))
|
||||
(dolist (source sources)
|
||||
(let ((mount (getf source :mount))
|
||||
(listeners (getf source :listeners)))
|
||||
(when mount
|
||||
(store-listener-snapshot 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))
|
||||
|
||||
|
|
|
|||
|
|
@ -27,10 +27,12 @@
|
|||
(defun get-current-mount-for-recently-played ()
|
||||
(let ((channel (get-current-channel))
|
||||
(quality (get-current-quality)))
|
||||
(cond
|
||||
((= quality "low") "asteroid.mp3")
|
||||
((= quality "mp3") "asteroid.mp3")
|
||||
(t "asteroid.aac"))))
|
||||
(if (= channel "shuffle")
|
||||
"asteroid-shuffle.mp3"
|
||||
(cond
|
||||
((= quality "low") "asteroid-low.mp3")
|
||||
((= quality "mp3") "asteroid.mp3")
|
||||
(t "asteroid.aac")))))
|
||||
|
||||
;; Update recently played tracks display
|
||||
(defun update-recently-played ()
|
||||
|
|
@ -41,7 +43,7 @@
|
|||
(then (lambda (result)
|
||||
;; Radiance wraps API responses in a data envelope
|
||||
(let ((data (or (ps:@ result data) result)))
|
||||
(if (and (= (ps:@ data status) "success")
|
||||
(if (and (equal (ps:@ data status) "success")
|
||||
(ps:@ data tracks)
|
||||
(> (ps:@ data tracks length) 0))
|
||||
(let ((list-el (ps:chain document (get-element-by-id "recently-played-list"))))
|
||||
|
|
|
|||
|
|
@ -149,23 +149,28 @@
|
|||
;; ========================================
|
||||
|
||||
;; Get stream configuration for a given channel and quality
|
||||
;; With cl-streamer, both channels use the same stream mounts -
|
||||
;; channel switching loads a different playlist server-side
|
||||
;; Curated channel has multiple quality options, shuffle has only one
|
||||
(defun get-stream-config (stream-base-url channel quality)
|
||||
(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.mp3")
|
||||
:type "audio/mpeg"
|
||||
:format "MP3 128kbps Stereo"
|
||||
:mount "asteroid.mp3"))))
|
||||
(ps:getprop config quality)))
|
||||
(let ((curated-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")))
|
||||
(shuffle-config (ps:create :url (+ stream-base-url "/asteroid-shuffle.mp3")
|
||||
:type "audio/mpeg"
|
||||
:format "Shuffle MP3 96kbps"
|
||||
:mount "asteroid-shuffle.mp3")))
|
||||
(if (= channel "shuffle")
|
||||
shuffle-config
|
||||
(ps:getprop curated-config quality))))
|
||||
|
||||
;; Get current channel from selector or localStorage
|
||||
(defun get-current-channel ()
|
||||
|
|
@ -667,52 +672,101 @@
|
|||
(defvar *reconnect-timeout* nil)
|
||||
(defvar *is-reconnecting* false)
|
||||
|
||||
;; Reconnect stream - reuses existing audio element to preserve user gesture context
|
||||
;; Reconnect stream - recreates audio element to fix wedged state
|
||||
(defun reconnect-stream ()
|
||||
(ps:chain console (log "Reconnecting stream..."))
|
||||
(show-status "🔄 Reconnecting..." false)
|
||||
|
||||
(let* ((audio (ps:chain document (get-element-by-id "persistent-audio")))
|
||||
(source (ps:chain document (get-element-by-id "audio-source")))
|
||||
(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-channel (get-current-channel))
|
||||
(stream-quality (get-current-quality))
|
||||
(config (get-stream-config stream-base-url stream-channel stream-quality)))
|
||||
|
||||
(unless audio
|
||||
(unless (and container old-audio)
|
||||
(show-status "❌ Could not reconnect - reload page" true)
|
||||
(setf *is-reconnecting* false)
|
||||
(return-from reconnect-stream nil))
|
||||
|
||||
(ps:chain console (log "Saving volume:" (ps:@ audio volume) "muted:" (ps:@ audio muted)))
|
||||
|
||||
;; Reset spectrum analyzer if it exists
|
||||
(when (ps:@ window reset-spectrum-analyzer)
|
||||
(ps:chain window (reset-spectrum-analyzer)))
|
||||
|
||||
;; Reload source on existing element (preserves user gesture context)
|
||||
(ps:chain audio (pause))
|
||||
(if source
|
||||
;; Update existing source element
|
||||
(progn
|
||||
(setf (ps:@ source src) (+ (ps:@ config url) "?t=" (ps:chain (ps:new (*Date)) (get-time))))
|
||||
(setf (ps:@ source type) (ps:@ config type)))
|
||||
;; Create source if missing
|
||||
(let ((new-source (ps:chain document (create-element "source"))))
|
||||
(setf (ps:@ new-source id) "audio-source")
|
||||
(setf (ps:@ new-source src) (+ (ps:@ config url) "?t=" (ps:chain (ps:new (*Date)) (get-time))))
|
||||
(setf (ps:@ new-source type) (ps:@ config type))
|
||||
(ps:chain audio (append-child new-source))))
|
||||
|
||||
;; Reload and play
|
||||
(ps:chain audio (load))
|
||||
(setf *is-reconnecting* false)
|
||||
(set-timeout
|
||||
(lambda ()
|
||||
(ps:chain audio (play)
|
||||
(catch (lambda (error)
|
||||
(ps:chain console (log "Reconnect play failed:" error))))))
|
||||
200)))
|
||||
;; 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 - reset flag so error handler can catch failures
|
||||
(setf *is-reconnecting* false)
|
||||
(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))
|
||||
;; Retry with exponential backoff
|
||||
(incf *stream-error-count*)
|
||||
(if (< *stream-error-count* 5)
|
||||
(let ((delay (* 2000 *stream-error-count*)))
|
||||
(show-status (+ "⚠️ Reconnect failed, retrying in " (/ delay 1000) "s...") true)
|
||||
(setf *is-reconnecting* false)
|
||||
(setf *reconnect-timeout*
|
||||
(set-timeout (lambda () (reconnect-stream)) delay)))
|
||||
(progn
|
||||
(setf *is-reconnecting* false)
|
||||
(show-status "❌ Could not reconnect. Click play to try again." true)))))))
|
||||
300)))))
|
||||
|
||||
;; Simple reconnect for popout player (just reload and play)
|
||||
(defun simple-reconnect (audio-element)
|
||||
|
|
|
|||
|
|
@ -68,26 +68,18 @@
|
|||
(values skip-ok reload-ok)))
|
||||
|
||||
(defun load-scheduled-playlist (playlist-name)
|
||||
"Load a playlist by name and trigger playback.
|
||||
Uses Harmony pipeline when available, falls back to Liquidsoap."
|
||||
"Load a playlist by name, copying it to stream-queue.m3u and triggering playback."
|
||||
(let ((playlist-path (merge-pathnames playlist-name (get-playlists-directory))))
|
||||
(if (probe-file playlist-path)
|
||||
(progn
|
||||
(copy-playlist-to-stream-queue playlist-path)
|
||||
(load-queue-from-m3u-file)
|
||||
(if *harmony-pipeline*
|
||||
;; Use cl-streamer directly
|
||||
(let ((count (harmony-load-playlist playlist-path)))
|
||||
(if count
|
||||
(log:info "Scheduler loaded ~a (~a tracks via Harmony)" playlist-name count)
|
||||
(log:error "Scheduler failed to load ~a via Harmony" playlist-name)))
|
||||
;; Fallback to Liquidsoap
|
||||
(multiple-value-bind (skip-ok reload-ok)
|
||||
(liquidsoap-reload-and-skip)
|
||||
(if (and reload-ok skip-ok)
|
||||
(log:info "Scheduler loaded ~a" playlist-name)
|
||||
(log:error "Scheduler failed to switch to ~a (reload:~a skip:~a)"
|
||||
playlist-name reload-ok skip-ok))))
|
||||
(multiple-value-bind (skip-ok reload-ok)
|
||||
(liquidsoap-reload-and-skip)
|
||||
(if (and reload-ok skip-ok)
|
||||
(log:info "Scheduler loaded ~a" playlist-name)
|
||||
(log:error "Scheduler failed to switch to ~a (reload:~a skip:~a)"
|
||||
playlist-name reload-ok skip-ok)))
|
||||
t)
|
||||
(progn
|
||||
(log:error "Scheduler playlist not found: ~a" playlist-name)
|
||||
|
|
|
|||
|
|
@ -1,202 +0,0 @@
|
|||
;;;; stream-harmony.lisp - CL-Streamer / Harmony integration for Asteroid Radio
|
||||
;;;; Replaces the Icecast + Liquidsoap stack with in-process audio streaming.
|
||||
;;;; Provides the same data interface to frontend-partials and admin APIs.
|
||||
|
||||
(in-package :asteroid)
|
||||
|
||||
;;; ---- Configuration ----
|
||||
|
||||
(defvar *harmony-pipeline* nil
|
||||
"The active cl-streamer/harmony audio pipeline.")
|
||||
|
||||
(defvar *harmony-stream-port* 8000
|
||||
"Port for the cl-streamer HTTP stream server.")
|
||||
|
||||
(defvar *harmony-mp3-encoder* nil
|
||||
"MP3 encoder instance.")
|
||||
|
||||
(defvar *harmony-aac-encoder* nil
|
||||
"AAC encoder instance.")
|
||||
|
||||
;;; ---- M3U Playlist Loading ----
|
||||
|
||||
(defun m3u-to-file-list (m3u-path)
|
||||
"Parse an M3U playlist file and return a list of host file paths.
|
||||
Converts Docker paths (/app/music/...) back to host paths.
|
||||
Skips comment lines and blank lines."
|
||||
(when (probe-file m3u-path)
|
||||
(with-open-file (stream m3u-path :direction :input)
|
||||
(loop for line = (read-line stream nil)
|
||||
while line
|
||||
for trimmed = (string-trim '(#\Space #\Tab #\Return #\Newline) line)
|
||||
unless (or (string= trimmed "")
|
||||
(and (> (length trimmed) 0) (char= (char trimmed 0) #\#)))
|
||||
collect (convert-from-docker-path trimmed)))))
|
||||
|
||||
;;; ---- Track Change Callback ----
|
||||
|
||||
(defun on-harmony-track-change (pipeline track-info)
|
||||
"Called by cl-streamer when a track changes.
|
||||
Updates recently-played lists and finds the track in the database."
|
||||
(declare (ignore pipeline))
|
||||
(let* ((display-title (getf track-info :display-title))
|
||||
(artist (getf track-info :artist))
|
||||
(title (getf track-info :title))
|
||||
(file-path (getf track-info :file))
|
||||
(track-id (or (find-track-by-title display-title)
|
||||
(find-track-by-file-path file-path))))
|
||||
(when (and display-title
|
||||
(not (string= display-title "Unknown")))
|
||||
;; Update recently played (curated stream)
|
||||
(add-recently-played (list :title display-title
|
||||
:artist artist
|
||||
:song title
|
||||
:timestamp (get-universal-time)
|
||||
:track-id track-id)
|
||||
:curated)
|
||||
(setf *last-known-track-curated* display-title))
|
||||
(log:info "Track change: ~A (track-id: ~A)" display-title track-id)))
|
||||
|
||||
(defun find-track-by-file-path (file-path)
|
||||
"Find a track in the database by file path. Returns track ID or nil."
|
||||
(when file-path
|
||||
(handler-case
|
||||
(with-db
|
||||
(postmodern:query
|
||||
(:limit
|
||||
(:select '_id :from 'tracks
|
||||
:where (:= 'file-path file-path))
|
||||
1)
|
||||
:single))
|
||||
(error () nil))))
|
||||
|
||||
;;; ---- Now-Playing Data Source ----
|
||||
;;; These functions provide the same data that icecast-now-playing returned,
|
||||
;;; but sourced directly from cl-streamer's pipeline state.
|
||||
|
||||
(defun harmony-now-playing (&optional (mount "asteroid.mp3"))
|
||||
"Get now-playing information from cl-streamer pipeline.
|
||||
Returns an alist compatible with the icecast-now-playing format,
|
||||
or NIL if the pipeline is not running."
|
||||
(when (and *harmony-pipeline*
|
||||
(cl-streamer/harmony:pipeline-current-track *harmony-pipeline*))
|
||||
(let* ((track-info (cl-streamer/harmony:pipeline-current-track *harmony-pipeline*))
|
||||
(display-title (or (getf track-info :display-title) "Unknown"))
|
||||
(listeners (cl-streamer:get-listener-count))
|
||||
(track-id (or (find-track-by-title display-title)
|
||||
(find-track-by-file-path (getf track-info :file)))))
|
||||
`((:listenurl . ,(format nil "~A/~A" *stream-base-url* mount))
|
||||
(:title . ,display-title)
|
||||
(:listeners . ,(or listeners 0))
|
||||
(:track-id . ,track-id)
|
||||
(:favorite-count . ,(or (get-track-favorite-count display-title) 0))))))
|
||||
|
||||
;;; ---- Pipeline Lifecycle ----
|
||||
|
||||
(defun start-harmony-streaming (&key (port *harmony-stream-port*)
|
||||
(mp3-bitrate 128000)
|
||||
(aac-bitrate 128000))
|
||||
"Start the cl-streamer pipeline with MP3 and AAC outputs.
|
||||
Should be called once during application startup."
|
||||
(when *harmony-pipeline*
|
||||
(log:warn "Harmony streaming already running")
|
||||
(return-from start-harmony-streaming *harmony-pipeline*))
|
||||
|
||||
;; Start the stream server
|
||||
(cl-streamer:start :port port)
|
||||
|
||||
;; Add mount points
|
||||
(cl-streamer:add-mount cl-streamer:*server* "/asteroid.mp3"
|
||||
:content-type "audio/mpeg"
|
||||
:bitrate 128
|
||||
:name "Asteroid Radio MP3")
|
||||
(cl-streamer:add-mount cl-streamer:*server* "/asteroid.aac"
|
||||
:content-type "audio/aac"
|
||||
:bitrate 128
|
||||
:name "Asteroid Radio AAC")
|
||||
|
||||
;; Create encoders
|
||||
(setf *harmony-mp3-encoder*
|
||||
(cl-streamer:make-mp3-encoder :bitrate (floor mp3-bitrate 1000)
|
||||
:sample-rate 44100
|
||||
:channels 2))
|
||||
(setf *harmony-aac-encoder*
|
||||
(cl-streamer:make-aac-encoder :bitrate aac-bitrate
|
||||
:sample-rate 44100
|
||||
:channels 2))
|
||||
|
||||
;; Create pipeline with track-change callback
|
||||
(setf *harmony-pipeline*
|
||||
(cl-streamer/harmony:make-audio-pipeline
|
||||
:encoder *harmony-mp3-encoder*
|
||||
:stream-server cl-streamer:*server*
|
||||
:mount-path "/asteroid.mp3"))
|
||||
|
||||
;; Add AAC output
|
||||
(cl-streamer/harmony:add-pipeline-output *harmony-pipeline*
|
||||
*harmony-aac-encoder*
|
||||
"/asteroid.aac")
|
||||
|
||||
;; Set the track-change callback
|
||||
(setf (cl-streamer/harmony:pipeline-on-track-change *harmony-pipeline*)
|
||||
#'on-harmony-track-change)
|
||||
|
||||
;; Start the audio pipeline
|
||||
(cl-streamer/harmony:start-pipeline *harmony-pipeline*)
|
||||
|
||||
(log:info "Harmony streaming started on port ~A (MP3 + AAC)" port)
|
||||
*harmony-pipeline*)
|
||||
|
||||
(defun stop-harmony-streaming ()
|
||||
"Stop the cl-streamer pipeline and stream server."
|
||||
(when *harmony-pipeline*
|
||||
(cl-streamer/harmony:stop-pipeline *harmony-pipeline*)
|
||||
(setf *harmony-pipeline* nil))
|
||||
(when *harmony-mp3-encoder*
|
||||
(cl-streamer:close-encoder *harmony-mp3-encoder*)
|
||||
(setf *harmony-mp3-encoder* nil))
|
||||
(when *harmony-aac-encoder*
|
||||
(cl-streamer:close-aac-encoder *harmony-aac-encoder*)
|
||||
(setf *harmony-aac-encoder* nil))
|
||||
(cl-streamer:stop)
|
||||
(log:info "Harmony streaming stopped"))
|
||||
|
||||
;;; ---- Playlist Control (replaces Liquidsoap commands) ----
|
||||
|
||||
(defun harmony-load-playlist (m3u-path)
|
||||
"Load and start playing an M3U playlist through the Harmony pipeline.
|
||||
Converts Docker paths to host paths and feeds them to play-list."
|
||||
(when *harmony-pipeline*
|
||||
(let ((file-list (m3u-to-file-list m3u-path)))
|
||||
(when file-list
|
||||
;; Clear any existing queue and load new files
|
||||
(cl-streamer/harmony:pipeline-clear-queue *harmony-pipeline*)
|
||||
(cl-streamer/harmony:pipeline-queue-files *harmony-pipeline*
|
||||
(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))
|
||||
(length file-list)))))
|
||||
|
||||
(defun harmony-skip-track ()
|
||||
"Skip the current track (crossfades to next)."
|
||||
(when *harmony-pipeline*
|
||||
(cl-streamer/harmony:pipeline-skip *harmony-pipeline*)
|
||||
t))
|
||||
|
||||
(defun harmony-get-status ()
|
||||
"Get current pipeline status (replaces liquidsoap status)."
|
||||
(if *harmony-pipeline*
|
||||
(let ((track (cl-streamer/harmony:pipeline-current-track *harmony-pipeline*))
|
||||
(listeners (cl-streamer:get-listener-count)))
|
||||
(list :running t
|
||||
:current-track (getf track :display-title)
|
||||
:artist (getf track :artist)
|
||||
:title (getf track :title)
|
||||
:album (getf track :album)
|
||||
:listeners listeners
|
||||
:queue-length (length (cl-streamer/harmony:pipeline-get-queue
|
||||
*harmony-pipeline*))))
|
||||
(list :running nil)))
|
||||
Loading…
Reference in New Issue