From 8d9d2b33b1ee1b7fd9de17c73d6b3d3889d11e5e Mon Sep 17 00:00:00 2001 From: Glenn Thompson Date: Sun, 8 Mar 2026 12:08:09 +0300 Subject: [PATCH] Phase 4: Extract cl-streamer to standalone repository MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Replace in-tree cl-streamer/ with git submodule pointing to glenneth1/cl-streamer (https://github.com/glenneth1/cl-streamer). ASDF discovers cl-streamer via source-registry :tree scan — no config changes needed. Submodule tracks master branch. Build verified: all cl-streamer systems load from submodule. --- .gitmodules | 4 + cl-streamer | 1 + cl-streamer/README.org | 295 ------------- cl-streamer/aac-encoder.lisp | 145 ------- cl-streamer/buffer.lisp | 87 ---- cl-streamer/cl-streamer.asd | 43 -- cl-streamer/cl-streamer.lisp | 38 -- cl-streamer/conditions.lisp | 20 - cl-streamer/encoder.lisp | 107 ----- cl-streamer/fdkaac-ffi.lisp | 165 -------- cl-streamer/fdkaac-shim.c | 101 ----- cl-streamer/harmony-backend.lisp | 702 ------------------------------- cl-streamer/icy-protocol.lisp | 58 --- cl-streamer/lame-ffi.lisp | 92 ---- cl-streamer/libfdkaac-shim.so | Bin 15840 -> 0 bytes cl-streamer/package.lisp | 92 ---- cl-streamer/protocol.lisp | 171 -------- cl-streamer/stream-server.lisp | 286 ------------- cl-streamer/test-stream.lisp | 92 ---- 19 files changed, 5 insertions(+), 2494 deletions(-) create mode 100644 .gitmodules create mode 160000 cl-streamer delete mode 100644 cl-streamer/README.org delete mode 100644 cl-streamer/aac-encoder.lisp delete mode 100644 cl-streamer/buffer.lisp delete mode 100644 cl-streamer/cl-streamer.asd delete mode 100644 cl-streamer/cl-streamer.lisp delete mode 100644 cl-streamer/conditions.lisp delete mode 100644 cl-streamer/encoder.lisp delete mode 100644 cl-streamer/fdkaac-ffi.lisp delete mode 100644 cl-streamer/fdkaac-shim.c delete mode 100644 cl-streamer/harmony-backend.lisp delete mode 100644 cl-streamer/icy-protocol.lisp delete mode 100644 cl-streamer/lame-ffi.lisp delete mode 100755 cl-streamer/libfdkaac-shim.so delete mode 100644 cl-streamer/package.lisp delete mode 100644 cl-streamer/protocol.lisp delete mode 100644 cl-streamer/stream-server.lisp delete mode 100644 cl-streamer/test-stream.lisp diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..888a49c --- /dev/null +++ b/.gitmodules @@ -0,0 +1,4 @@ +[submodule "cl-streamer"] + path = cl-streamer + url = git@github.com:glenneth1/cl-streamer.git + branch = master diff --git a/cl-streamer b/cl-streamer new file mode 160000 index 0000000..e1f1139 --- /dev/null +++ b/cl-streamer @@ -0,0 +1 @@ +Subproject commit e1f113976b146894f8ac5e8fea5ba34c953db7e0 diff --git a/cl-streamer/README.org b/cl-streamer/README.org deleted file mode 100644 index 3219377..0000000 --- a/cl-streamer/README.org +++ /dev/null @@ -1,295 +0,0 @@ -#+TITLE: CL-Streamer -#+AUTHOR: Glenn Thompson -#+DATE: 2026-02-03 - -* Overview - -CL-Streamer is a native Common Lisp audio streaming server built to replace -the Icecast + Liquidsoap stack in [[https://asteroid.radio][Asteroid Radio]]. It provides HTTP audio -streaming with ICY metadata, multi-format encoding (MP3 and AAC), and -real-time audio processing via [[https://shirakumo.github.io/harmony/][Harmony]] and [[https://shirakumo.github.io/cl-mixed/][cl-mixed]] — all in a single Lisp -process. - -The goal is to eliminate the Docker/C service dependencies (Icecast, Liquidsoap) -and bring the entire audio pipeline under the control of the Lisp application. -This means playlist management, stream encoding, metadata, listener stats, and -the web frontend all live in one process and can interact directly. - -* Why Replace Icecast + Liquidsoap? - -The current Asteroid Radio stack runs three separate services in Docker: - -- *Liquidsoap* — reads the playlist, decodes audio, applies crossfade, - encodes to MP3/AAC, pushes to Icecast -- *Icecast* — receives encoded streams, serves them to listeners over HTTP - with ICY metadata -- *PostgreSQL* — stores playlist state, listener stats, etc. - -This works, but has significant friction: - -- *Operational complexity* — three Docker containers to manage, with - inter-service communication over HTTP and Telnet -- *Playlist control* — Liquidsoap reads an M3U file; the Lisp app writes it - and pokes Liquidsoap via Telnet to reload. Clunky round-trip for - something that should be a function call -- *Metadata* — requires polling Icecast's admin XML endpoint to get - listener stats, then correlating with our own data -- *Crossfade/transitions* — configured in Liquidsoap's DSL, not - accessible to the application logic -- *No live mixing* — adding DJ input or live mixing requires more - Liquidsoap configuration and another audio path - -With CL-Streamer, the Lisp process *is* the streaming server: - -- =play-list= and =play-file= are function calls, not Telnet commands -- ICY metadata updates are immediate — =(set-now-playing mount title)= -- Listener connections are tracked in-process, no XML polling needed -- Crossfade parameters can be changed at runtime -- Future: live DJ input via Harmony's mixer, with the same encoder pipeline - -* Architecture - -#+begin_example -┌──────────────────────────────────────────────────────────┐ -│ Lisp Process │ -│ │ -│ ┌─────────┐ ┌──────────────┐ ┌─────────────────┐ │ -│ │ Harmony │───▶│ streaming- │───▶│ MP3 Encoder │ │ -│ │ (decode, │ │ drain │ │ (LAME FFI) │─┼──▶ /stream.mp3 -│ │ mix, │ │ (float→s16 │ └─────────────────┘ │ -│ │ effects)│ │ conversion) │ ┌─────────────────┐ │ -│ └─────────┘ └──────────────┘───▶│ AAC Encoder │ │ -│ ▲ │ (FDK-AAC shim) │─┼──▶ /stream.aac -│ │ └─────────────────┘ │ -│ ┌─────────┐ ┌─────────────────┐ │ -│ │ Playlist │ ICY metadata ──────▶│ HTTP Server │ │ -│ │ Manager │ Listener stats ◀────│ (usocket) │ │ -│ └─────────┘ └─────────────────┘ │ -└──────────────────────────────────────────────────────────┘ -#+end_example - -** Harmony Integration - -[[https://shirakumo.github.io/harmony/][Harmony]] is Shinmera's Common Lisp audio framework built on top of cl-mixed. -It handles audio decoding (FLAC, MP3, OGG, etc.), sample rate conversion, -mixing, and effects processing. - -CL-Streamer connects to Harmony by replacing the default audio output drain -with a custom =streaming-drain= that intercepts the mixed audio data. -Instead of sending PCM to a sound card, we: - -1. Read interleaved IEEE 754 single-float samples from Harmony's pack buffer -2. Convert to signed 16-bit PCM -3. Feed to all registered encoders (MP3 via LAME, AAC via FDK-AAC) -4. Write encoded bytes to per-mount broadcast ring buffers -5. HTTP clients read from these buffers with burst-on-connect - -Both voices (e.g., during crossfade) play through the same Harmony mixer -and are automatically summed before reaching the drain — the encoders see -a single mixed signal. - -** The FDK-AAC C Shim - -SBCL's signal handlers conflict with FDK-AAC's internal memory access patterns. -When FDK-AAC touches certain memory during =aacEncOpen= or =aacEncEncode=, -SBCL's SIGSEGV handler intercepts it before FDK-AAC's own handler can run, -causing a recursive signal fault. - -The solution is a thin C shim (=fdkaac-shim.c=, compiled to =libfdkaac-shim.so=) -that wraps all FDK-AAC calls: - -- =fdkaac_open_and_init= — opens the encoder, sets all parameters (AOT, - sample rate, channels, bitrate, transport format, afterburner), and - runs the initialisation call, all from C -- =fdkaac_encode= — sets up the buffer descriptors (=AACENC_BufDesc=) and - calls =aacEncEncode=, returning encoded ADTS frames -- =fdkaac_close= — closes the encoder handle - -The Lisp side calls these via CFFI and never touches FDK-AAC directly. -This avoids the signal handler conflict entirely. - -Note: one subtle bug was that FDK-AAC's =OUT_BITSTREAM_DATA= constant is -=3=, not =1=. Getting this wrong causes =aacEncEncode= to return error 96 -with no useful error message. The fix was to use the proper enum constants -from =aacenc_lib.h= rather than hardcoded integers. - -Additionally, the AAC encoder uses a PCM accumulation buffer to feed -FDK-AAC exact =frameLength=-sized chunks (1024 frames for AAC-LC). Feeding -arbitrary chunk sizes from Harmony's real-time callback produces audio -artefacts. - -To rebuild the shim: - -#+begin_src sh -gcc -shared -fPIC -o libfdkaac-shim.so fdkaac-shim.c -lfdk-aac -#+end_src - -** Broadcast Buffer - -Each mount point has a ring buffer (=broadcast-buffer=) that acts as a -single-producer, multi-consumer queue. The encoder writes encoded audio -in, and each connected client reads from its own position. - -- Never blocks the producer — slow clients lose data rather than stalling - the encoder -- Burst-on-connect — new clients receive ~4 seconds of recent audio - immediately for fast playback start -- Condition variable signalling for efficient client wakeup - -** ICY Metadata Protocol - -The server implements the SHOUTcast/Icecast ICY metadata protocol: - -- Responds to =Icy-MetaData: 1= requests with metadata-interleaved streams -- Injects metadata blocks at the configured =metaint= byte interval -- =set-now-playing= updates the metadata for a mount, picked up by all - connected clients on their next metadata interval - -* Current Status - -*Working and tested:* - -- [X] HTTP streaming server with multiple mount points -- [X] MP3 encoding via LAME (128kbps, configurable) -- [X] AAC encoding via FDK-AAC with C shim (128kbps ADTS, configurable) -- [X] Harmony audio backend with custom streaming drain -- [X] Real-time float→s16 PCM conversion and dual-encoder output -- [X] ICY metadata protocol (set-now-playing on track change) -- [X] Broadcast ring buffer with burst-on-connect -- [X] Sequential playlist playback with reliable track-end detection -- [X] Crossfade between tracks (3s overlap, 2s fade-in/out) -- [X] Multi-format simultaneous output (MP3 + AAC from same source) - -*Remaining work:* - -- [ ] Read file metadata (artist, title, album) from FLAC/MP3 tags via - cl-taglib and feed to ICY metadata (currently uses filename) -- [ ] Flush AAC accumulation buffer at track boundaries for clean transitions -- [ ] Integration with Asteroid Radio's playlist/queue system (replace - Liquidsoap Telnet control with direct function calls) -- [ ] Integration with Asteroid Radio's listener statistics (replace - Icecast admin XML polling with in-process tracking) -- [ ] Live DJ input via Harmony mixer (replace Liquidsoap's input sources) -- [ ] Stream quality variants (low bitrate MP3, shuffle stream, etc.) -- [ ] Robustness: auto-restart on encoder errors, watchdog, graceful - degradation - -* Integration with Asteroid Radio - -The plan is to load CL-Streamer as an ASDF system within the main Asteroid -Radio Lisp image. The web application (Radiance) and the streaming server -share the same process: - -- *Playlist control* — the web app's queue management calls =play-list= - and =play-file= directly, no IPC needed -- *Now playing* — track changes call =set-now-playing=, which is - immediately visible to all connected ICY-metadata clients -- *Listener stats* — the stream server tracks connections in-process; - the web app reads them directly for the admin dashboard -- *Tag metadata* — cl-taglib (already a dependency of Asteroid) reads - FLAC/MP3 tags and passes artist/title/album to ICY metadata - -This eliminates the Docker containers for Icecast and Liquidsoap entirely. -The only external service is PostgreSQL for persistent data. - -* File Structure - -| File | Purpose | -|----------------------+--------------------------------------------------| -| =cl-streamer.asd= | ASDF system definition | -| =package.lisp= | Package and exports | -| =cl-streamer.lisp= | Top-level API (start, stop, add-mount, etc.) | -| =stream-server.lisp=| HTTP server, client connections, ICY responses | -| =buffer.lisp= | Broadcast ring buffer (single-producer, multi-consumer) | -| =icy-protocol.lisp= | ICY metadata encoding and injection | -| =conditions.lisp= | Error condition types | -| =encoder.lisp= | MP3 encoder (LAME wrapper) | -| =lame-ffi.lisp= | CFFI bindings for libmp3lame | -| =aac-encoder.lisp= | AAC encoder with frame accumulation buffer | -| =fdkaac-ffi.lisp= | CFFI bindings for FDK-AAC (via shim) | -| =fdkaac-shim.c= | C shim for FDK-AAC (avoids SBCL signal conflicts)| -| =libfdkaac-shim.so= | Compiled shim shared library | -| =harmony-backend.lisp= | Harmony integration: streaming-drain, crossfade, playlist | -| =test-stream.lisp= | End-to-end test: playlist with MP3 + AAC output | - -* Dependencies - -** Lisp Libraries - -- [[https://github.com/Shinmera/harmony][harmony]] — audio framework (decode, mix, effects) -- [[https://github.com/Shinmera/cl-mixed][cl-mixed]] — low-level audio mixing -- [[https://github.com/Shinmera/cl-mixed-flac][cl-mixed-flac]] — FLAC decoding -- [[https://github.com/Shinmera/cl-mixed-mpg123][cl-mixed-mpg123]] — MP3 decoding -- [[https://common-lisp.net/project/cffi/][cffi]] — C foreign function interface -- [[https://github.com/usocket/usocket][usocket]] — socket networking -- [[https://edicl.github.io/flexi-streams/][flexi-streams]] — flexible stream types -- [[https://github.com/sharplispers/log4cl][log4cl]] — logging -- [[https://gitlab.common-lisp.net/alexandria/alexandria][alexandria]] — utility library -- [[https://sionescu.github.io/bordeaux-threads/][bordeaux-threads]] — portable threading - -** C Libraries - -- [[https://lame.sourceforge.io/][libmp3lame]] — MP3 encoding -- [[https://github.com/mstorsjo/fdk-aac][libfdk-aac]] — AAC encoding (via C shim) - -* Quick Start - -#+begin_src common-lisp -;; Load the systems -(ql:quickload '(:cl-streamer :cl-streamer/encoder - :cl-streamer/aac-encoder :cl-streamer/harmony)) - -;; Start the HTTP server -(cl-streamer:start :port 8000) - -;; Add mount points -(cl-streamer:add-mount cl-streamer:*server* "/stream.mp3" - :content-type "audio/mpeg" - :bitrate 128 - :name "Asteroid Radio MP3") -(cl-streamer:add-mount cl-streamer:*server* "/stream.aac" - :content-type "audio/aac" - :bitrate 128 - :name "Asteroid Radio AAC") - -;; Create encoders -(defvar *mp3* (cl-streamer:make-mp3-encoder :sample-rate 44100 - :channels 2 - :bitrate 128)) -(defvar *aac* (cl-streamer:make-aac-encoder :sample-rate 44100 - :channels 2 - :bitrate 128000)) - -;; Create pipeline with both outputs -(defvar *pipeline* (cl-streamer/harmony:make-audio-pipeline - :encoder *mp3* - :stream-server cl-streamer:*server* - :mount-path "/stream.mp3")) -(cl-streamer/harmony:add-pipeline-output *pipeline* *aac* "/stream.aac") -(cl-streamer/harmony:start-pipeline *pipeline*) - -;; Play a playlist with crossfade -(cl-streamer/harmony:play-list *pipeline* '("/path/to/track1.flac" - "/path/to/track2.flac") - :crossfade-duration 3.0 - :fade-in 2.0 - :fade-out 2.0) - -;; Or play individual files -(cl-streamer/harmony:play-file *pipeline* "/path/to/track.flac" - :title "Artist - Track Name") - -;; Update now-playing metadata -(cl-streamer:set-now-playing "/stream.mp3" "Artist - Track Title") - -;; Check listeners -(cl-streamer:get-listener-count) - -;; Stop everything -(cl-streamer/harmony:stop-pipeline *pipeline*) -(cl-streamer:stop) -#+end_src - -* License - -AGPL-3.0 diff --git a/cl-streamer/aac-encoder.lisp b/cl-streamer/aac-encoder.lisp deleted file mode 100644 index 3645155..0000000 --- a/cl-streamer/aac-encoder.lisp +++ /dev/null @@ -1,145 +0,0 @@ -(in-package #:cl-streamer) - -(defclass aac-encoder () - ((handle :initform nil :accessor encoder-handle) - (sample-rate :initarg :sample-rate :accessor aac-encoder-sample-rate :initform 44100) - (channels :initarg :channels :accessor aac-encoder-channels :initform 2) - (bitrate :initarg :bitrate :accessor aac-encoder-bitrate :initform 128000) - (aot :initarg :aot :accessor aac-encoder-aot :initform :aot-aac-lc) - (out-buffer :initform nil :accessor aac-encoder-out-buffer) - (out-buffer-size :initform (* 1024 8) :accessor aac-encoder-out-buffer-size) - (frame-length :initform 1024 :accessor aac-encoder-frame-length) - (pcm-accum :initform nil :accessor aac-encoder-pcm-accum - :documentation "Accumulation buffer for PCM samples (signed-byte 16), frame-length * channels elements.") - (pcm-accum-pos :initform 0 :accessor aac-encoder-pcm-accum-pos - :documentation "Number of samples currently accumulated."))) - -(defun make-aac-encoder (&key (sample-rate 44100) (channels 2) (bitrate 128000)) - "Create an AAC encoder with the specified parameters. - BITRATE is in bits per second (e.g., 128000 for 128kbps)." - (let ((encoder (make-instance 'aac-encoder - :sample-rate sample-rate - :channels channels - :bitrate bitrate))) - (initialize-aac-encoder encoder) - encoder)) - -(defun initialize-aac-encoder (encoder) - "Initialize the FDK-AAC encoder with current settings. - Uses C shim to avoid SBCL signal handler conflicts with FDK-AAC." - (cffi:with-foreign-objects ((handle-ptr :pointer) - (frame-length-ptr :int) - (max-out-bytes-ptr :int)) - (let ((result (fdkaac-open-and-init handle-ptr - (aac-encoder-sample-rate encoder) - (aac-encoder-channels encoder) - (aac-encoder-bitrate encoder) - 2 ; AOT: AAC-LC - 2 ; TRANSMUX: ADTS - 1 ; AFTERBURNER: on - frame-length-ptr - max-out-bytes-ptr))) - (unless (zerop result) - (error 'encoding-error :format :aac - :message (format nil "fdkaac_open_and_init failed: ~A" result))) - (setf (encoder-handle encoder) (cffi:mem-ref handle-ptr :pointer)) - (setf (aac-encoder-frame-length encoder) (cffi:mem-ref frame-length-ptr :int)) - (setf (aac-encoder-out-buffer-size encoder) (cffi:mem-ref max-out-bytes-ptr :int)))) - (setf (aac-encoder-out-buffer encoder) - (cffi:foreign-alloc :unsigned-char :count (aac-encoder-out-buffer-size encoder))) - ;; Initialize PCM accumulation buffer (frame-length * channels samples) - (let ((accum-size (* (aac-encoder-frame-length encoder) - (aac-encoder-channels encoder)))) - (setf (aac-encoder-pcm-accum encoder) - (make-array accum-size :element-type '(signed-byte 16) :initial-element 0)) - (setf (aac-encoder-pcm-accum-pos encoder) 0)) - (log:info "AAC encoder initialized: ~Akbps, ~AHz, ~A channels, frame-length=~A" - (floor (aac-encoder-bitrate encoder) 1000) - (aac-encoder-sample-rate encoder) - (aac-encoder-channels encoder) - (aac-encoder-frame-length encoder)) - encoder) - -(defun close-aac-encoder (encoder) - "Close the AAC encoder and free resources." - (when (encoder-handle encoder) - (cffi:with-foreign-object (handle-ptr :pointer) - (setf (cffi:mem-ref handle-ptr :pointer) (encoder-handle encoder)) - (fdkaac-close handle-ptr)) - (setf (encoder-handle encoder) nil)) - (when (aac-encoder-out-buffer encoder) - (cffi:foreign-free (aac-encoder-out-buffer encoder)) - (setf (aac-encoder-out-buffer encoder) nil))) - -(defun encode-one-aac-frame (encoder) - "Encode a single frame from the accumulation buffer. - Returns a byte vector of AAC data, or an empty vector." - (let* ((handle (encoder-handle encoder)) - (channels (aac-encoder-channels encoder)) - (frame-length (aac-encoder-frame-length encoder)) - (accum (aac-encoder-pcm-accum encoder)) - (out-buf (aac-encoder-out-buffer encoder)) - (out-buf-size (aac-encoder-out-buffer-size encoder)) - (total-samples (* frame-length channels)) - (pcm-bytes (* total-samples 2))) - (cffi:with-pointer-to-vector-data (pcm-ptr accum) - (cffi:with-foreign-object (bytes-written-ptr :int) - (let ((result (fdkaac-encode handle pcm-ptr pcm-bytes total-samples - out-buf out-buf-size bytes-written-ptr))) - (unless (zerop result) - (error 'encoding-error :format :aac - :message (format nil "aacEncEncode failed: ~A" result))) - (let ((bytes-written (cffi:mem-ref bytes-written-ptr :int))) - (if (> bytes-written 0) - (let ((result-vec (make-array bytes-written :element-type '(unsigned-byte 8)))) - (loop for i below bytes-written - do (setf (aref result-vec i) (cffi:mem-aref out-buf :unsigned-char i))) - result-vec) - (make-array 0 :element-type '(unsigned-byte 8))))))))) - -(defun encode-aac-pcm (encoder pcm-samples num-samples) - "Encode PCM samples (16-bit signed interleaved) to AAC. - Accumulates samples and encodes in exact frame-length chunks. - Returns a byte vector of AAC data (ADTS frames). - Uses C shim to avoid SBCL signal handler conflicts." - (let* ((channels (aac-encoder-channels encoder)) - (frame-samples (* (aac-encoder-frame-length encoder) channels)) - (accum (aac-encoder-pcm-accum encoder)) - (input-total (* num-samples channels)) - (input-pos 0) - (output-chunks nil)) - ;; Copy input samples into accumulation buffer, encoding whenever full - (loop while (< input-pos input-total) - for space-left = (- frame-samples (aac-encoder-pcm-accum-pos encoder)) - for copy-count = (min space-left (- input-total input-pos)) - do (replace accum pcm-samples - :start1 (aac-encoder-pcm-accum-pos encoder) - :end1 (+ (aac-encoder-pcm-accum-pos encoder) copy-count) - :start2 input-pos - :end2 (+ input-pos copy-count)) - (incf (aac-encoder-pcm-accum-pos encoder) copy-count) - (incf input-pos copy-count) - ;; When accumulation buffer is full, encode one frame - (when (= (aac-encoder-pcm-accum-pos encoder) frame-samples) - (let ((encoded (encode-one-aac-frame encoder))) - (when (> (length encoded) 0) - (push encoded output-chunks))) - (setf (aac-encoder-pcm-accum-pos encoder) 0))) - ;; Concatenate all encoded chunks into one result vector - (if (null output-chunks) - (make-array 0 :element-type '(unsigned-byte 8)) - (let* ((total-bytes (reduce #'+ output-chunks :key #'length)) - (result (make-array total-bytes :element-type '(unsigned-byte 8))) - (pos 0)) - (dolist (chunk (nreverse output-chunks)) - (replace result chunk :start1 pos) - (incf pos (length chunk))) - result)))) - -;;; ---- Protocol Methods ---- - -(defmethod encoder-encode ((encoder aac-encoder) pcm-buffer num-samples) - (encode-aac-pcm encoder pcm-buffer num-samples)) - -(defmethod encoder-close ((encoder aac-encoder)) - (close-aac-encoder encoder)) diff --git a/cl-streamer/buffer.lisp b/cl-streamer/buffer.lisp deleted file mode 100644 index b146b85..0000000 --- a/cl-streamer/buffer.lisp +++ /dev/null @@ -1,87 +0,0 @@ -(in-package #:cl-streamer) - -;;; ---- Broadcast Ring Buffer ---- -;;; Single-producer, multi-consumer circular buffer. -;;; The writer advances write-pos; each client has its own read cursor. -;;; Old data is overwritten when the buffer wraps — slow clients lose data -;;; rather than blocking the producer (appropriate for live streaming). - -(defclass broadcast-buffer () - ((data :initarg :data :accessor buffer-data) - (size :initarg :size :reader buffer-size) - (write-pos :initform 0 :accessor buffer-write-pos) - (lock :initform (bt:make-lock "broadcast-buffer-lock") :reader buffer-lock) - (not-empty :initform (bt:make-condition-variable :name "buffer-not-empty") - :reader buffer-not-empty) - (burst-size :initarg :burst-size :reader buffer-burst-size - :initform (* 64 1024) - :documentation "Bytes of recent data to send on new client connect"))) - -(defun make-ring-buffer (size) - "Create a broadcast ring buffer with SIZE bytes capacity." - (make-instance 'broadcast-buffer - :data (make-array size :element-type '(unsigned-byte 8)) - :size size)) - -(defun buffer-write (buffer data &key (start 0) (end (length data))) - "Write bytes into the broadcast buffer. Never blocks; overwrites old data." - (let ((len (- end start))) - (when (> len 0) - (bt:with-lock-held ((buffer-lock buffer)) - (let ((write-pos (buffer-write-pos buffer)) - (size (buffer-size buffer)) - (buf-data (buffer-data buffer))) - (loop for i from start below end - for j = (mod write-pos size) then (mod (1+ j) size) - do (setf (aref buf-data j) (aref data i)) - finally (setf (buffer-write-pos buffer) (+ write-pos len)))) - (bt:condition-notify (buffer-not-empty buffer)))) - len)) - -(defun buffer-read-from (buffer read-pos output &key (start 0) (end (length output))) - "Read bytes from BUFFER starting at READ-POS into OUTPUT. - Returns (values bytes-read new-read-pos). - READ-POS is the client's absolute position in the stream." - (let ((requested (- end start))) - (bt:with-lock-held ((buffer-lock buffer)) - (let* ((write-pos (buffer-write-pos buffer)) - (size (buffer-size buffer)) - (buf-data (buffer-data buffer)) - ;; Clamp read-pos: if client is too far behind, skip ahead - (oldest-available (max 0 (- write-pos size))) - (effective-read (max read-pos oldest-available)) - (available (- write-pos effective-read)) - (to-read (min requested available))) - (if (> to-read 0) - (progn - (loop for i from start below (+ start to-read) - for j = (mod effective-read size) then (mod (1+ j) size) - do (setf (aref output i) (aref buf-data j))) - (values to-read (+ effective-read to-read))) - (values 0 effective-read)))))) - -(defun buffer-wait-for-data (buffer read-pos) - "Block until new data is available past READ-POS." - (bt:with-lock-held ((buffer-lock buffer)) - (loop while (<= (buffer-write-pos buffer) read-pos) - do (bt:condition-wait (buffer-not-empty buffer) (buffer-lock buffer))))) - -(defun buffer-current-pos (buffer) - "Return the current write position (for new client burst start)." - (bt:with-lock-held ((buffer-lock buffer)) - (buffer-write-pos buffer))) - -(defun buffer-burst-start (buffer) - "Return a read position that gives BURST-SIZE bytes of recent data. - This lets new clients start playing immediately." - (bt:with-lock-held ((buffer-lock buffer)) - (let* ((write-pos (buffer-write-pos buffer)) - (size (buffer-size buffer)) - (oldest (max 0 (- write-pos size))) - (burst-start (max oldest (- write-pos (buffer-burst-size buffer))))) - burst-start))) - -(defun buffer-clear (buffer) - "Clear the buffer." - (bt:with-lock-held ((buffer-lock buffer)) - (setf (buffer-write-pos buffer) 0))) diff --git a/cl-streamer/cl-streamer.asd b/cl-streamer/cl-streamer.asd deleted file mode 100644 index 6036aa5..0000000 --- a/cl-streamer/cl-streamer.asd +++ /dev/null @@ -1,43 +0,0 @@ -(asdf:defsystem #:cl-streamer - :description "Common Lisp audio streaming server for Asteroid Radio" - :author "Glenn Thompson " - :license "AGPL-3.0" - :version "0.1.0" - :serial t - :depends-on (#:alexandria - #:bordeaux-threads - #:iolib - #:flexi-streams - #:split-sequence - #:log4cl) - :components ((:file "package") - (:file "conditions") - (:file "buffer") - (:file "icy-protocol") - (:file "stream-server") - (:file "cl-streamer") - (:file "protocol"))) - -(asdf:defsystem #:cl-streamer/harmony - :description "Harmony audio backend for cl-streamer" - :depends-on (#:cl-streamer - #:harmony - #:cl-mixed - #:cl-mixed-mpg123 - #:cl-mixed-flac - #:taglib) - :components ((:file "harmony-backend"))) - -(asdf:defsystem #:cl-streamer/encoder - :description "Audio encoding for cl-streamer (LAME MP3)" - :depends-on (#:cl-streamer - #:cffi) - :components ((:file "lame-ffi") - (:file "encoder"))) - -(asdf:defsystem #:cl-streamer/aac-encoder - :description "AAC encoding for cl-streamer (FDK-AAC)" - :depends-on (#:cl-streamer - #:cffi) - :components ((:file "fdkaac-ffi") - (:file "aac-encoder"))) diff --git a/cl-streamer/cl-streamer.lisp b/cl-streamer/cl-streamer.lisp deleted file mode 100644 index 608aee2..0000000 --- a/cl-streamer/cl-streamer.lisp +++ /dev/null @@ -1,38 +0,0 @@ -(in-package #:cl-streamer) - -(defvar *server* nil - "The global stream server instance.") - -(defun ensure-server (&key (port *default-port*)) - "Ensure a server instance exists, creating one if needed." - (unless *server* - (setf *server* (make-stream-server :port port))) - *server*) - -(defun start (&key (port *default-port*)) - "Start the streaming server with default configuration." - (let ((server (ensure-server :port port))) - (start-server server))) - -(defun stop () - "Stop the streaming server." - (when *server* - (stop-server *server*))) - -(defun write-audio-data (mount-path data &key (start 0) (end (length data))) - "Write audio data to a mount point's buffer. - This is called by the audio pipeline to feed encoded audio." - (let* ((server (ensure-server)) - (mount (gethash mount-path (server-mounts server)))) - (when mount - (buffer-write (mount-buffer mount) data :start start :end end)))) - -(defun set-now-playing (mount-path title &optional url) - "Update the now-playing metadata for a mount point." - (let ((server (ensure-server))) - (update-metadata server mount-path :title title :url url))) - -(defun get-listener-count (&optional mount-path) - "Get the current listener count." - (let ((server (ensure-server))) - (listener-count server mount-path))) diff --git a/cl-streamer/conditions.lisp b/cl-streamer/conditions.lisp deleted file mode 100644 index 5257041..0000000 --- a/cl-streamer/conditions.lisp +++ /dev/null @@ -1,20 +0,0 @@ -(in-package #:cl-streamer) - -(define-condition streamer-error (error) - ((message :initarg :message :reader streamer-error-message)) - (:report (lambda (c stream) - (format stream "Streamer error: ~A" (streamer-error-message c))))) - -(define-condition connection-error (streamer-error) - ((client :initarg :client :reader connection-error-client)) - (:report (lambda (c stream) - (format stream "Connection error for ~A: ~A" - (connection-error-client c) - (streamer-error-message c))))) - -(define-condition encoding-error (streamer-error) - ((format :initarg :format :reader encoding-error-format)) - (:report (lambda (c stream) - (format stream "Encoding error (~A): ~A" - (encoding-error-format c) - (streamer-error-message c))))) diff --git a/cl-streamer/encoder.lisp b/cl-streamer/encoder.lisp deleted file mode 100644 index 8baa68a..0000000 --- a/cl-streamer/encoder.lisp +++ /dev/null @@ -1,107 +0,0 @@ -(in-package #:cl-streamer) - -(defclass mp3-encoder () - ((lame :initform nil :accessor encoder-lame) - (sample-rate :initarg :sample-rate :accessor encoder-sample-rate :initform 44100) - (channels :initarg :channels :accessor encoder-channels :initform 2) - (bitrate :initarg :bitrate :accessor encoder-bitrate :initform 128) - (quality :initarg :quality :accessor encoder-quality :initform 5) - (mp3-buffer :initform nil :accessor encoder-mp3-buffer) - (mp3-buffer-size :initform (* 1024 8) :accessor encoder-mp3-buffer-size))) - -(defun make-mp3-encoder (&key (sample-rate 44100) (channels 2) (bitrate 128) (quality 5)) - "Create an MP3 encoder with the specified parameters. - QUALITY: 0=best/slowest, 9=worst/fastest. 5 is good default." - (let ((encoder (make-instance 'mp3-encoder - :sample-rate sample-rate - :channels channels - :bitrate bitrate - :quality quality))) - (initialize-encoder encoder) - encoder)) - -(defun initialize-encoder (encoder) - "Initialize the LAME encoder with current settings." - (let ((lame (lame-init))) - (when (cffi:null-pointer-p lame) - (error 'encoding-error :format :mp3 :message "Failed to initialize LAME")) - (setf (encoder-lame encoder) lame) - (lame-set-in-samplerate lame (encoder-sample-rate encoder)) - (lame-set-out-samplerate lame (encoder-sample-rate encoder)) - (lame-set-num-channels lame (encoder-channels encoder)) - (lame-set-mode lame (if (= (encoder-channels encoder) 1) :mono :joint-stereo)) - (lame-set-brate lame (encoder-bitrate encoder)) - (lame-set-quality lame (encoder-quality encoder)) - (lame-set-vbr lame :vbr-off) - (let ((result (lame-init-params lame))) - (when (< result 0) - (lame-close lame) - (error 'encoding-error :format :mp3 - :message (format nil "LAME init-params failed: ~A" result)))) - (setf (encoder-mp3-buffer encoder) - (cffi:foreign-alloc :unsigned-char :count (encoder-mp3-buffer-size encoder))) - (log:info "MP3 encoder initialized: ~Akbps, ~AHz, ~A channels" - (encoder-bitrate encoder) - (encoder-sample-rate encoder) - (encoder-channels encoder)) - encoder)) - -(defun close-encoder (encoder) - "Close the encoder and free resources." - (when (encoder-lame encoder) - (lame-close (encoder-lame encoder)) - (setf (encoder-lame encoder) nil)) - (when (encoder-mp3-buffer encoder) - (cffi:foreign-free (encoder-mp3-buffer encoder)) - (setf (encoder-mp3-buffer encoder) nil))) - -(defun encode-pcm-interleaved (encoder pcm-samples num-samples) - "Encode interleaved PCM samples (16-bit signed) to MP3. - PCM-SAMPLES should be a (simple-array (signed-byte 16) (*)). - Returns a byte vector of MP3 data." - (let* ((lame (encoder-lame encoder)) - (mp3-buf (encoder-mp3-buffer encoder)) - (mp3-buf-size (encoder-mp3-buffer-size encoder))) - (cffi:with-pointer-to-vector-data (pcm-ptr pcm-samples) - (let ((bytes-written (lame-encode-buffer-interleaved - lame pcm-ptr num-samples mp3-buf mp3-buf-size))) - (cond - ((< bytes-written 0) - (error 'encoding-error :format :mp3 - :message (format nil "Encode failed: ~A" bytes-written))) - ((= bytes-written 0) - (make-array 0 :element-type '(unsigned-byte 8))) - (t - (let ((result (make-array bytes-written :element-type '(unsigned-byte 8)))) - (loop for i below bytes-written - do (setf (aref result i) (cffi:mem-aref mp3-buf :unsigned-char i))) - result))))))) - -(defun encode-flush (encoder) - "Flush any remaining MP3 data from the encoder. - Call this when done encoding to get final frames." - (let* ((lame (encoder-lame encoder)) - (mp3-buf (encoder-mp3-buffer encoder)) - (mp3-buf-size (encoder-mp3-buffer-size encoder))) - (let ((bytes-written (lame-encode-flush lame mp3-buf mp3-buf-size))) - (if (> bytes-written 0) - (let ((result (make-array bytes-written :element-type '(unsigned-byte 8)))) - (loop for i below bytes-written - do (setf (aref result i) (cffi:mem-aref mp3-buf :unsigned-char i))) - result) - (make-array 0 :element-type '(unsigned-byte 8)))))) - -(defun lame-version () - "Return the LAME library version string." - (get-lame-version)) - -;;; ---- Protocol Methods ---- - -(defmethod encoder-encode ((encoder mp3-encoder) pcm-buffer num-samples) - (encode-pcm-interleaved encoder pcm-buffer num-samples)) - -(defmethod encoder-flush ((encoder mp3-encoder)) - (encode-flush encoder)) - -(defmethod encoder-close ((encoder mp3-encoder)) - (close-encoder encoder)) diff --git a/cl-streamer/fdkaac-ffi.lisp b/cl-streamer/fdkaac-ffi.lisp deleted file mode 100644 index fde989d..0000000 --- a/cl-streamer/fdkaac-ffi.lisp +++ /dev/null @@ -1,165 +0,0 @@ -(in-package #:cl-streamer) - -(cffi:define-foreign-library libfdkaac - (:unix (:or "libfdk-aac.so.2" "libfdk-aac.so")) - (:darwin "libfdk-aac.dylib") - (:windows "libfdk-aac.dll") - (t (:default "libfdk-aac"))) - -(cffi:use-foreign-library libfdkaac) - -;; Shim library for safe NULL-pointer init call (SBCL/CFFI crashes on NULL args to aacEncEncode) -(eval-when (:compile-toplevel :load-toplevel :execute) - (let ((shim-path (merge-pathnames "libfdkaac-shim.so" - (asdf:system-source-directory :cl-streamer/aac-encoder)))) - (cffi:load-foreign-library shim-path))) - -(cffi:defctype aac-encoder-handle :pointer) - -(cffi:defcenum aac-encoder-param - (:aacenc-aot #x0100) - (:aacenc-bitrate #x0101) - (:aacenc-bitratemode #x0102) - (:aacenc-samplerate #x0103) - (:aacenc-sbr-mode #x0104) - (:aacenc-granule-length #x0105) - (:aacenc-channelmode #x0106) - (:aacenc-channelorder #x0107) - (:aacenc-sbr-ratio #x0108) - (:aacenc-afterburner #x0200) - (:aacenc-bandwidth #x0203) - (:aacenc-transmux #x0300) - (:aacenc-header-period #x0301) - (:aacenc-signaling-mode #x0302) - (:aacenc-tpsubframes #x0303) - (:aacenc-protection #x0306) - (:aacenc-ancillary-bitrate #x0500) - (:aacenc-metadata-mode #x0600)) - -(cffi:defcenum aac-encoder-error - (:aacenc-ok #x0000) - (:aacenc-invalid-handle #x0020) - (:aacenc-memory-error #x0021) - (:aacenc-unsupported-parameter #x0022) - (:aacenc-invalid-config #x0023) - (:aacenc-init-error #x0040) - (:aacenc-init-aac-error #x0041) - (:aacenc-init-sbr-error #x0042) - (:aacenc-init-tp-error #x0043) - (:aacenc-init-meta-error #x0044) - (:aacenc-encode-error #x0060) - (:aacenc-encode-eof #x0080)) - -(cffi:defcenum aac-channel-mode - (:mode-invalid -1) - (:mode-unknown 0) - (:mode-1 1) - (:mode-2 2) - (:mode-1-2 3) - (:mode-1-2-1 4) - (:mode-1-2-2 5) - (:mode-1-2-2-1 6) - (:mode-1-2-2-2-1 7)) - -(cffi:defcenum aac-transmux - (:tt-unknown -1) - (:tt-raw 0) - (:tt-adif 1) - (:tt-adts 2) - (:tt-latm-mcp1 6) - (:tt-latm-mcp0 7) - (:tt-loas 10)) - -(cffi:defcenum aac-aot - (:aot-none -1) - (:aot-null 0) - (:aot-aac-main 1) - (:aot-aac-lc 2) - (:aot-aac-ssr 3) - (:aot-aac-ltp 4) - (:aot-sbr 5) - (:aot-aac-scal 6) - (:aot-er-aac-lc 17) - (:aot-er-aac-ld 23) - (:aot-er-aac-eld 39) - (:aot-ps 29) - (:aot-mp2-aac-lc 129) - (:aot-mp2-sbr 132)) - -(cffi:defcstruct aacenc-buf-desc - (num-bufs :int) - (bufs :pointer) - (buf-ids :pointer) - (buf-sizes :pointer) - (buf-el-sizes :pointer)) - -(cffi:defcstruct aacenc-in-args - (num-in-samples :int) - (num-ancillary-bytes :int)) - -(cffi:defcstruct aacenc-out-args - (num-out-bytes :int) - (num-in-samples :int) - (num-ancillary-bytes :int)) - -(cffi:defcstruct aacenc-info-struct - (max-out-buf-bytes :uint) - (max-ancillary-bytes :uint) - (in-buf-fill-level :uint) - (input-channels :uint) - (frame-length :uint) - (encoder-delay :uint) - (conf-buf :pointer) - (conf-size :uint)) - -(cffi:defcfun ("aacEncOpen" aac-enc-open) :int - (ph-aac-encoder :pointer) - (enc-modules :uint) - (max-channels :uint)) - -(cffi:defcfun ("aacEncClose" aac-enc-close) :int - (ph-aac-encoder :pointer)) - -(cffi:defcfun ("aacEncEncode" aac-enc-encode) :int - (h-aac-encoder aac-encoder-handle) - (in-buf-desc :pointer) - (out-buf-desc :pointer) - (in-args :pointer) - (out-args :pointer)) - -(cffi:defcfun ("aacEncInfo" aac-enc-info) :int - (h-aac-encoder aac-encoder-handle) - (p-info :pointer)) - -(cffi:defcfun ("aacEncoder_SetParam" aac-encoder-set-param) :int - (h-aac-encoder aac-encoder-handle) - (param aac-encoder-param) - (value :uint)) - -(cffi:defcfun ("aacEncoder_GetParam" aac-encoder-get-param) :uint - (h-aac-encoder aac-encoder-handle) - (param aac-encoder-param)) - -;; Shim: all FDK-AAC calls go through C to avoid SBCL signal handler conflicts -(cffi:defcfun ("fdkaac_open_and_init" fdkaac-open-and-init) :int - (out-handle :pointer) - (sample-rate :int) - (channels :int) - (bitrate :int) - (aot :int) - (transmux :int) - (afterburner :int) - (out-frame-length :pointer) - (out-max-out-bytes :pointer)) - -(cffi:defcfun ("fdkaac_encode" fdkaac-encode) :int - (handle :pointer) - (pcm-buf :pointer) - (pcm-bytes :int) - (num-samples :int) - (out-buf :pointer) - (out-buf-size :int) - (out-bytes-written :pointer)) - -(cffi:defcfun ("fdkaac_close" fdkaac-close) :void - (ph :pointer)) diff --git a/cl-streamer/fdkaac-shim.c b/cl-streamer/fdkaac-shim.c deleted file mode 100644 index d8dc5c5..0000000 --- a/cl-streamer/fdkaac-shim.c +++ /dev/null @@ -1,101 +0,0 @@ -/* Shim for FDK-AAC encoder initialization. - SBCL's signal handlers conflict with FDK-AAC's internal memory access, - causing recursive SIGSEGV when calling aacEncEncode or aacEncOpen from - CFFI. This shim does the entire open+configure+init from C. */ - -#include -#include - -/* Open, configure, and initialize an AAC encoder entirely from C. - Returns 0 on success, or the FDK-AAC error code on failure. - On success, *out_handle is set, and *out_frame_length / *out_max_out_bytes - are filled from aacEncInfo. */ -int fdkaac_open_and_init(HANDLE_AACENCODER *out_handle, - int sample_rate, int channels, int bitrate, - int aot, int transmux, int afterburner, - int *out_frame_length, int *out_max_out_bytes) { - HANDLE_AACENCODER handle = NULL; - AACENC_ERROR err; - AACENC_InfoStruct info; - - err = aacEncOpen(&handle, 0, channels); - if (err != AACENC_OK) return (int)err; - - if ((err = aacEncoder_SetParam(handle, AACENC_AOT, aot)) != AACENC_OK) goto fail; - if ((err = aacEncoder_SetParam(handle, AACENC_SAMPLERATE, sample_rate)) != AACENC_OK) goto fail; - if ((err = aacEncoder_SetParam(handle, AACENC_CHANNELMODE, channels == 1 ? MODE_1 : MODE_2)) != AACENC_OK) goto fail; - if ((err = aacEncoder_SetParam(handle, AACENC_CHANNELORDER, 1)) != AACENC_OK) goto fail; - if ((err = aacEncoder_SetParam(handle, AACENC_BITRATE, bitrate)) != AACENC_OK) goto fail; - if ((err = aacEncoder_SetParam(handle, AACENC_TRANSMUX, transmux)) != AACENC_OK) goto fail; - if ((err = aacEncoder_SetParam(handle, AACENC_AFTERBURNER, afterburner)) != AACENC_OK) goto fail; - - err = aacEncEncode(handle, NULL, NULL, NULL, NULL); - if (err != AACENC_OK) goto fail; - - memset(&info, 0, sizeof(info)); - err = aacEncInfo(handle, &info); - if (err != AACENC_OK) goto fail; - - *out_handle = handle; - *out_frame_length = info.frameLength; - *out_max_out_bytes = info.maxOutBufBytes; - return 0; - -fail: - aacEncClose(&handle); - return (int)err; -} - -/* Encode PCM samples to AAC. - pcm_buf: interleaved signed 16-bit PCM - pcm_bytes: size of pcm_buf in bytes - out_buf: output buffer for AAC data - out_buf_size: size of out_buf in bytes - out_bytes_written: set to actual bytes written on success - Returns 0 on success, FDK-AAC error code on failure. */ -int fdkaac_encode(HANDLE_AACENCODER handle, - void *pcm_buf, int pcm_bytes, - int num_samples, - void *out_buf, int out_buf_size, - int *out_bytes_written) { - AACENC_BufDesc in_desc = {0}, out_desc = {0}; - AACENC_InArgs in_args = {0}; - AACENC_OutArgs out_args = {0}; - AACENC_ERROR err; - - void *in_ptr = pcm_buf; - INT in_id = IN_AUDIO_DATA; - INT in_size = pcm_bytes; - INT in_el_size = sizeof(INT_PCM); - - in_desc.numBufs = 1; - in_desc.bufs = &in_ptr; - in_desc.bufferIdentifiers = &in_id; - in_desc.bufSizes = &in_size; - in_desc.bufElSizes = &in_el_size; - - void *out_ptr = out_buf; - INT out_id = OUT_BITSTREAM_DATA; - INT out_size = out_buf_size; - INT out_el_size = 1; - - out_desc.numBufs = 1; - out_desc.bufs = &out_ptr; - out_desc.bufferIdentifiers = &out_id; - out_desc.bufSizes = &out_size; - out_desc.bufElSizes = &out_el_size; - - in_args.numInSamples = num_samples; - in_args.numAncBytes = 0; - - err = aacEncEncode(handle, &in_desc, &out_desc, &in_args, &out_args); - if (err != AACENC_OK) return (int)err; - - *out_bytes_written = out_args.numOutBytes; - return 0; -} - -/* Close an encoder handle. */ -void fdkaac_close(HANDLE_AACENCODER *ph) { - aacEncClose(ph); -} diff --git a/cl-streamer/harmony-backend.lisp b/cl-streamer/harmony-backend.lisp deleted file mode 100644 index ce57ca3..0000000 --- a/cl-streamer/harmony-backend.lisp +++ /dev/null @@ -1,702 +0,0 @@ -(defpackage #:cl-streamer/harmony - (:use #:cl #:alexandria) - (:local-nicknames (#:harmony #:org.shirakumo.fraf.harmony) - (#:mixed #:org.shirakumo.fraf.mixed)) - ;; Import protocol generics — we define methods on these - (:import-from #:cl-streamer - #:pipeline-start - #:pipeline-stop - #:pipeline-running-p - #:pipeline-play-file - #:pipeline-play-list - #:pipeline-skip - #:pipeline-queue-files - #:pipeline-get-queue - #:pipeline-clear-queue - #:pipeline-current-track - #:pipeline-listener-count - #:pipeline-update-metadata - #:pipeline-add-hook - #:pipeline-remove-hook - #:pipeline-fire-hook) - (:export #:audio-pipeline - #:make-audio-pipeline - #:make-pipeline - #:make-encoder-for-format - #:add-pipeline-output - ;; Re-export protocol generics so callers can use cl-streamer/harmony:X - #:pipeline-start - #:pipeline-stop - #:pipeline-running-p - #:pipeline-play-file - #:pipeline-play-list - #:pipeline-skip - #:pipeline-queue-files - #:pipeline-get-queue - #:pipeline-clear-queue - #:pipeline-current-track - #:pipeline-listener-count - #:pipeline-update-metadata - #:pipeline-add-hook - #:pipeline-remove-hook - #:pipeline-fire-hook - ;; Pipeline state accessors - #:pipeline-encoders - #:pipeline-owns-server-p - ;; Backward-compatible aliases (delegate to protocol generics) - #:start-pipeline - #:stop-pipeline - #:play-file - #:play-list - ;; Harmony-specific (not in protocol) - #:pipeline-server - #:make-streaming-server - #:pipeline-on-track-change - #:pipeline-pending-playlist-path - #:pipeline-on-playlist-change - ;; Metadata helpers - #:read-audio-metadata - #:format-display-title - #:update-all-mounts-metadata - ;; DJ support - #:pipeline-harmony-server - #:volume-ramp - #:pipeline-stop-all-voices)) - -(in-package #:cl-streamer/harmony) - -;;; ---- Streaming Drain ---- -;;; Custom drain that captures PCM from Harmony's pack buffer -;;; and feeds it to the encoder/stream server, replacing the -;;; dummy drain which just discards audio data. - -(defclass streaming-drain (mixed:drain) - ((outputs :initarg :outputs :accessor drain-outputs :initform nil - :documentation "List of (encoder . mount-path) pairs") - (channels :initarg :channels :accessor drain-channels :initform 2))) - -(defun drain-add-output (drain encoder mount-path) - "Add an encoder/mount pair to the drain." - (push (cons encoder mount-path) (drain-outputs drain))) - -(defun drain-remove-output (drain mount-path) - "Remove an encoder/mount pair by mount path." - (setf (drain-outputs drain) - (remove mount-path (drain-outputs drain) :key #'cdr :test #'string=))) - -(defmethod mixed:free ((drain streaming-drain))) - -(defmethod mixed:start ((drain streaming-drain))) - -(defmethod mixed:mix ((drain streaming-drain)) - "Read interleaved s16 PCM from the pack buffer, encode to all outputs. - The pack is created with :encoding :int16, so cl-mixed converts float→s16 in C. - Layout: L0lo L0hi R0lo R0hi L1lo L1hi R1lo R1hi ... (interleaved stereo, 2 bytes/sample)" - (mixed:with-buffer-tx (data start size (mixed:pack drain)) - (when (> size 0) - (let* ((channels (drain-channels drain)) - (bytes-per-sample 2) ; int16 = 2 bytes - (total-samples (floor size bytes-per-sample)) - (num-samples (floor total-samples channels)) - (pcm-buffer (make-array (* num-samples channels) - :element-type '(signed-byte 16)))) - ;; Read s16 PCM directly — no conversion needed, cl-mixed did it - (cffi:with-pointer-to-vector-data (ptr data) - (loop for i below (* num-samples channels) - for byte-offset = (+ start (* i bytes-per-sample)) - do (setf (aref pcm-buffer i) (cffi:mem-ref ptr :int16 byte-offset)))) - ;; Feed PCM to all encoder/mount pairs - (dolist (output (drain-outputs drain)) - (let ((encoder (car output)) - (mount-path (cdr output))) - (handler-case - (let ((encoded (encode-for-output encoder pcm-buffer num-samples))) - (when (> (length encoded) 0) - (cl-streamer:write-audio-data mount-path encoded))) - (error (e) - (log:warn "Encode error for ~A: ~A" mount-path e))))))) - ;; Sleep for most of the audio duration (leave headroom for encoding) - (let* ((channels (drain-channels drain)) - (bytes-per-frame (* channels 2)) ; 2 bytes per sample (int16) - (frames (floor size bytes-per-frame)) - (samplerate (mixed:samplerate (mixed:pack drain)))) - (when (> frames 0) - (sleep (* 0.9 (/ frames samplerate))))) - (mixed:finish size))) - -(defgeneric encode-for-output (encoder pcm-buffer num-samples) - (:documentation "Encode PCM samples using the given encoder. Returns byte vector.")) - -(defmethod encode-for-output ((encoder cl-streamer::mp3-encoder) pcm-buffer num-samples) - (cl-streamer:encode-pcm-interleaved encoder pcm-buffer num-samples)) - -(defmethod encode-for-output ((encoder cl-streamer::aac-encoder) pcm-buffer num-samples) - (cl-streamer:encode-aac-pcm encoder pcm-buffer num-samples)) - -(defmethod mixed:end ((drain streaming-drain))) - -;;; ---- Audio Pipeline ---- - -(defclass audio-pipeline () - ((harmony-server :initform nil :accessor pipeline-harmony-server) - (drain :initform nil :accessor pipeline-drain) - (stream-server :initarg :stream-server :accessor pipeline-server) - (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) - ;; 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") - (pending-playlist-path :initform nil :accessor pipeline-pending-playlist-path - :documentation "Playlist path queued by scheduler, applied when tracks start playing") - (on-playlist-change :initarg :on-playlist-change :initform nil - :accessor pipeline-on-playlist-change - :documentation "Callback (lambda (pipeline playlist-path)) called when scheduler playlist starts") - ;; Hook system - (hooks :initform (make-hash-table :test 'eq) :reader pipeline-hooks - :documentation "Hash table mapping event keywords to lists of hook functions") - ;; Encoder & server ownership (Phase 2) - (encoders :initform nil :accessor pipeline-encoders - :documentation "List of (encoder . mount-path) pairs owned by the pipeline") - (owns-server :initform nil :accessor pipeline-owns-server-p - :documentation "T if pipeline created the server and should stop it on shutdown"))) - -(defun make-audio-pipeline (&key encoder stream-server (mount-path "/stream.mp3") - (sample-rate 44100) (channels 2)) - "Create an audio pipeline connecting Harmony to the stream server via an encoder. - The initial encoder/mount-path pair is added as the first output. - Additional outputs can be added with add-pipeline-output." - (let ((pipeline (make-instance 'audio-pipeline - :stream-server stream-server - :mount-path mount-path - :sample-rate sample-rate - :channels channels))) - (when encoder - (setf (slot-value pipeline 'drain) - (make-instance 'streaming-drain :channels channels)) - (drain-add-output (pipeline-drain pipeline) encoder mount-path)) - pipeline)) - -(defun make-encoder-for-format (format &key (bitrate 128) (sample-rate 44100) (channels 2)) - "Create an encoder for the given FORMAT keyword (:mp3 or :aac)." - (ecase format - (:mp3 (cl-streamer:make-mp3-encoder :bitrate bitrate - :sample-rate sample-rate - :channels channels)) - (:aac (cl-streamer:make-aac-encoder :bitrate (* bitrate 1000) - :sample-rate sample-rate - :channels channels)))) - -(defun content-type-for-format (format) - "Return the MIME content type for FORMAT keyword." - (ecase format - (:mp3 "audio/mpeg") - (:aac "audio/aac"))) - -(defun make-pipeline (&key (port 8000) (sample-rate 44100) (channels 2) outputs server) - "Create a complete streaming pipeline from a declarative spec. - PORT: stream server port (ignored if SERVER is provided). - OUTPUTS: list of output specs, each a plist: - (:format :mp3 :mount \"/stream.mp3\" :bitrate 128 :name \"My Stream\") - SERVER: an existing stream-server instance (optional). - If NIL, a new server is created and owned by the pipeline. - - Example: - (make-pipeline :port 8000 - :outputs '((:format :mp3 :mount \"/radio.mp3\" :bitrate 128 - :name \"Radio MP3\") - (:format :aac :mount \"/radio.aac\" :bitrate 128 - :name \"Radio AAC\"))) - - Returns the pipeline (already wired, but not started — call pipeline-start)." - (let* ((owns-server (null server)) - (srv (or server - (let ((s (cl-streamer:make-stream-server :port port))) - (cl-streamer:start-server s) - ;; Set global so write-audio-data/set-now-playing work - (setf cl-streamer:*server* s) - s))) - (pipeline (make-instance 'audio-pipeline - :stream-server srv - :sample-rate sample-rate - :channels channels)) - (encoders nil)) - (setf (pipeline-owns-server-p pipeline) owns-server) - ;; Create drain - (setf (pipeline-drain pipeline) - (make-instance 'streaming-drain :channels channels)) - ;; Process each output spec - (dolist (spec outputs) - (let* ((format (getf spec :format)) - (mount (getf spec :mount)) - (bitrate (or (getf spec :bitrate) 128)) - (name (or (getf spec :name) "CL-Streamer")) - (genre (or (getf spec :genre) "Various")) - (content-type (or (getf spec :content-type) - (content-type-for-format format))) - (encoder (make-encoder-for-format format - :bitrate bitrate - :sample-rate sample-rate - :channels channels))) - ;; Add mount point to server - (cl-streamer:add-mount srv mount - :content-type content-type - :bitrate bitrate - :name name - :genre genre) - ;; Wire encoder to drain - (drain-add-output (pipeline-drain pipeline) encoder mount) - (push (cons encoder mount) encoders))) - (setf (pipeline-encoders pipeline) (nreverse encoders)) - (log:info "Pipeline configured: ~A outputs on port ~A" - (length outputs) (if owns-server port (cl-streamer::server-port srv))) - pipeline)) - -(defun add-pipeline-output (pipeline encoder mount-path) - "Add an additional encoder/mount output to the pipeline. - Can be called before or after start-pipeline." - (unless (pipeline-drain pipeline) - (setf (pipeline-drain pipeline) - (make-instance 'streaming-drain :channels (pipeline-channels pipeline)))) - (drain-add-output (pipeline-drain pipeline) encoder mount-path)) - -(defmethod pipeline-start ((pipeline audio-pipeline)) - "Start the audio pipeline - initializes Harmony with our streaming drain." - (when (%pipeline-running pipeline) - (error "Pipeline already running")) - (mixed:init) - (let* ((server (harmony:make-simple-server - :name "CL-Streamer" - :samplerate (pipeline-sample-rate pipeline) - :latency 0.05 - :drain :dummy - :output-channels (pipeline-channels pipeline))) - (output (harmony:segment :output server)) - (old-drain (harmony:segment :drain output)) - (drain (pipeline-drain pipeline))) - ;; Replace the default float packer with an int16 packer. - ;; cl-mixed handles float→s16 conversion in C (faster than our Lisp loop). - (let* ((old-packer (harmony:segment :packer output)) - (new-packer (mixed:make-packer - :encoding :int16 - :channels (pipeline-channels pipeline) - :samplerate (pipeline-sample-rate pipeline) - :frames (* 2 (harmony::buffersize server))))) - ;; Connect upmix → new packer (same wiring as old) - (harmony:connect (harmony:segment :upmix output) T new-packer T) - ;; Withdraw old packer and float drain, add new int16 packer and our drain - (mixed:withdraw old-drain output) - (mixed:withdraw old-packer output) - (mixed:add new-packer output) - (setf (mixed:pack drain) (mixed:pack new-packer)) - (mixed:add drain output)) - (setf (pipeline-harmony-server pipeline) server) - (mixed:start server)) - (setf (%pipeline-running pipeline) t) - (log:info "Audio pipeline started with streaming drain (~A outputs)" - (length (drain-outputs (pipeline-drain pipeline)))) - pipeline) - -(defmethod pipeline-stop ((pipeline audio-pipeline)) - "Stop the audio pipeline. Cleans up owned encoders and server." - (setf (%pipeline-running pipeline) nil) - (when (pipeline-harmony-server pipeline) - (mixed:end (pipeline-harmony-server pipeline)) - (setf (pipeline-harmony-server pipeline) nil)) - ;; Close owned encoders - (dolist (pair (pipeline-encoders pipeline)) - (handler-case - (cl-streamer:encoder-close (car pair)) - (error (e) (log:debug "Error closing encoder for ~A: ~A" (cdr pair) e)))) - (setf (pipeline-encoders pipeline) nil) - ;; Stop owned server - (when (pipeline-owns-server-p pipeline) - (handler-case - (cl-streamer:stop-server (pipeline-server pipeline)) - (error (e) (log:debug "Error stopping server: ~A" e))) - (setf (pipeline-owns-server-p pipeline) nil)) - (log:info "Audio pipeline stopped") - pipeline) - -;;; ---- Pipeline Control ---- - -(defmethod pipeline-skip ((pipeline audio-pipeline)) - "Skip the current track. The play-list loop will detect this and advance." - (setf (pipeline-skip-flag pipeline) t) - (log:info "Skip requested")) - -(defmethod pipeline-queue-files ((pipeline audio-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)) - -(defmethod pipeline-get-queue ((pipeline audio-pipeline)) - "Get the current file queue (copy)." - (bt:with-lock-held ((pipeline-queue-lock pipeline)) - (copy-list (pipeline-file-queue pipeline)))) - -(defmethod pipeline-clear-queue ((pipeline audio-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-stop-all-voices (pipeline) - "Immediately stop all active voices on the Harmony mixer. - Used by DJ session to silence the auto-playlist before mixing." - (let ((server (pipeline-harmony-server pipeline))) - (when server - (let ((harmony:*server* server)) - (dolist (voice (harmony:voices server)) - (handler-case - (progn - (setf (mixed:volume voice) 0.0) - (harmony:stop voice)) - (error (e) - (log:debug "Error stopping voice: ~A" e)))) - (log:info "All voices stopped on mixer"))))) - -(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 ensure-simple-string (s) - "Coerce S to a simple-string if it's a string, or return NIL. - Coerce first to guarantee simple-string before any string operations, - since SBCL's string-trim may require simple-string input." - (when (stringp s) - (let ((simple (coerce s 'simple-string))) - (string-trim '(#\Space #\Nul) simple)))) - -(defun safe-tag (fn audio-file) - "Safely read a tag field, coercing to simple-string. Returns NIL on any error." - (handler-case - (ensure-simple-string (funcall fn audio-file)) - (error () nil))) - -(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." - (handler-case - (let ((audio-file (audio-streams:open-audio-file (namestring file-path)))) - (list :artist (safe-tag #'abstract-tag:artist audio-file) - :title (safe-tag #'abstract-tag:title audio-file) - :album (safe-tag #'abstract-tag:album audio-file))) - (error (e) - (log:debug "Could not read tags from ~A: ~A" file-path e) - nil))) - -(defun format-display-title (file-path &optional explicit-title) - "Build a display title for ICY metadata. - If EXPLICIT-TITLE is given, use it. - Otherwise read tags from the file: 'Artist - Title' or fall back to filename." - (or explicit-title - (let ((tags (read-audio-metadata file-path))) - (if tags - (let ((artist (getf tags :artist)) - (title (getf tags :title))) - (cond ((and artist title (not (string= artist "")) - (not (string= title ""))) - (format nil "~A - ~A" artist title)) - (title title) - (artist artist) - (t (pathname-name (pathname file-path))))) - (pathname-name (pathname file-path)))))) - -(defun update-all-mounts-metadata (pipeline display-title) - "Update ICY metadata on all mount points." - (dolist (output (drain-outputs (pipeline-drain pipeline))) - (cl-streamer:set-now-playing (cdr output) display-title))) - -(defmethod pipeline-update-metadata ((pipeline audio-pipeline) title) - "Update ICY metadata on all mount points (protocol method)." - (update-all-mounts-metadata pipeline title)) - -(defun notify-track-change (pipeline track-info) - "Update pipeline state and fire hooks + legacy callback." - (setf (%pipeline-current-track pipeline) track-info) - ;; Fire hook system (Phase 2) - (pipeline-fire-hook pipeline :track-change track-info) - ;; Legacy callback (backward compat) - (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. - The file will be decoded by Harmony and encoded for streaming. - If TITLE is given, update ICY metadata with it. - Otherwise reads tags from the file via taglib. - FILE-PATH can be a string or pathname. - ON-END is passed to harmony:play (default :free). - UPDATE-METADATA controls whether ICY metadata is updated immediately." - (let* ((path-string (etypecase file-path - (string file-path) - (pathname (namestring file-path)))) - ;; Use parse-native-namestring to prevent SBCL from interpreting - ;; brackets as wildcard patterns. Standard (pathname ...) turns - ;; "[FLAC]" into a wild component with non-simple strings, which - ;; causes SIMPLE-ARRAY errors in cl-flac's CFFI calls. - (path (sb-ext:parse-native-namestring path-string)) - (server (pipeline-harmony-server pipeline)) - (harmony:*server* server) - (tags (read-audio-metadata path)) - (display-title (format-display-title path title)) - (track-info (list :file path-string - :display-title display-title - :artist (getf tags :artist) - :title (getf tags :title) - :album (getf tags :album)))) - (when update-metadata - (update-all-mounts-metadata pipeline display-title) - (notify-track-change pipeline track-info)) - (let ((voice (harmony:play path :mixer mixer :on-end on-end))) - (if update-metadata - (log:info "Now playing: ~A" display-title) - (log:info "Loading next: ~A" display-title)) - (values voice display-title track-info)))) - -(defun voice-remaining-seconds (voice) - "Return estimated seconds remaining for a voice, or NIL if unknown." - (handler-case - (let ((pos (mixed:frame-position voice)) - (total (mixed:frame-count voice)) - (sr (mixed:samplerate voice))) - (when (and pos total sr (> total 0) (> sr 0)) - (/ (- total pos) sr))) - (error () nil))) - -(defun volume-ramp (voice target-volume duration &key (steps 20)) - "Smoothly ramp a voice's volume to TARGET-VOLUME over DURATION seconds. - Runs in the calling thread (blocks for DURATION seconds)." - (let* ((start-volume (mixed:volume voice)) - (delta (- target-volume start-volume)) - (step-time (/ duration steps))) - (loop for i from 1 to steps - for fraction = (/ i steps) - for vol = (+ start-volume (* delta fraction)) - do (setf (mixed:volume voice) (max 0.0 (min 1.0 (float vol)))) - (sleep step-time)))) - -(defun drain-queue-into-remaining (pipeline remaining-ref current-list-ref) - "If the scheduler has queued tracks, drain them all into remaining-ref, - replacing any current remaining tracks. Also update current-list-ref - so loop-queue replays the scheduler's playlist, not the original. - Returns T if new tracks were loaded, NIL otherwise." - (let ((first (pipeline-pop-queue pipeline))) - (when first - (let ((all-queued (list first))) - ;; Drain remaining queue entries - (loop for item = (pipeline-pop-queue pipeline) - while item do (push item all-queued)) - (setf all-queued (nreverse all-queued)) - (log:info "Scheduler playlist taking over: ~A tracks" (length all-queued)) - ;; Replace remaining list and update current for loop-queue - (setf (car remaining-ref) all-queued) - (setf (car current-list-ref) (copy-list all-queued)) - ;; Fire hooks + legacy callback so app layer updates metadata - (let ((playlist-path (pipeline-pending-playlist-path pipeline))) - (when playlist-path - ;; Fire hook system (Phase 2) - (pipeline-fire-hook pipeline :playlist-change playlist-path) - ;; Legacy callback (backward compat) - (when (pipeline-on-playlist-change pipeline) - (handler-case - (funcall (pipeline-on-playlist-change pipeline) - pipeline playlist-path) - (error (e) - (log:warn "Playlist change callback error: ~A" e)))) - (setf (pipeline-pending-playlist-path pipeline) nil))) - t)))) - -(defun next-entry (pipeline remaining-ref current-list-ref) - "Get the next entry to play. Checks scheduler queue first (drains all into remaining), - then pops from remaining-ref. - REMAINING-REF is a cons cell whose car is the remaining file list. - CURRENT-LIST-REF is a cons cell whose car is the full current playlist (for loop-queue)." - (drain-queue-into-remaining pipeline remaining-ref current-list-ref) - (pop (car remaining-ref))) - -(defun play-list (pipeline file-list &key (crossfade-duration 3.0) - (fade-in 2.0) - (fade-out 2.0) - (loop-queue nil)) - "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, repeats the playlist from the start when tracks run out. - Scheduler-queued tracks take priority over the repeat cycle." - (bt:make-thread - (lambda () - (handler-case - (let ((prev-voice nil) - (idx 0) - (remaining-list (list (copy-list file-list))) - (current-list (list (copy-list file-list)))) - (loop while (%pipeline-running pipeline) - for entry = (next-entry pipeline remaining-list current-list) - do (cond - ;; No entry and loop mode: re-queue current playlist - ((and (null entry) loop-queue) - (log:info "Playlist ended, repeating from start (~A tracks)" - (length (car current-list))) - (setf (car remaining-list) (copy-list (car current-list)))) - ;; 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) - (handler-case - (play-file pipeline path :title title - :on-end :disconnect - :update-metadata (null prev-voice)) - (error (retry-err) - ;; Retry once after brief delay for transient FLAC init errors - (log:debug "Retrying ~A after init error: ~A" - (pathname-name (pathname path)) retry-err) - (sleep 0.2) - (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 — brief pause so listeners perceive - ;; the new track before UI updates - (sleep 1.0) - (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) - ;; Log initial track duration info - (let ((initial-remaining (voice-remaining-seconds voice))) - (log:info "Track duration check: remaining=~A pos=~A total=~A sr=~A" - initial-remaining - (ignore-errors (mixed:frame-position voice)) - (ignore-errors (mixed:frame-count voice)) - (ignore-errors (mixed:samplerate voice)))) - (loop while (and (%pipeline-running 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 (log:info "Crossfade trigger: ~,1Fs remaining" remaining) - (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))))))) - ;; Clean up last voice - (when prev-voice - (let ((harmony:*server* (pipeline-harmony-server pipeline))) - (volume-ramp prev-voice 0.0 fade-out) - (harmony:stop prev-voice)))) - (error (e) - (log:error "play-list thread crashed: ~A" e)))) - :name "cl-streamer-playlist")) - -;;; ---- Backward-Compatible Aliases ---- -;;; These allow existing code using cl-streamer/harmony:start-pipeline etc. -;;; to continue working while we transition to the protocol generics. - -(defun start-pipeline (pipeline) - "Start the audio pipeline. Alias for (pipeline-start pipeline)." - (pipeline-start pipeline)) - -(defun stop-pipeline (pipeline) - "Stop the audio pipeline. Alias for (pipeline-stop pipeline)." - (pipeline-stop pipeline)) - -;;; ---- Protocol Method Implementations ---- - -(defmethod pipeline-running-p ((pipeline audio-pipeline)) - "Return T if the pipeline is currently running." - (%pipeline-running pipeline)) - -(defmethod pipeline-current-track ((pipeline audio-pipeline)) - "Return the current track info plist, or NIL." - (%pipeline-current-track pipeline)) - -(defmethod pipeline-listener-count ((pipeline audio-pipeline) &optional mount) - "Return the listener count from the stream server." - (cl-streamer:get-listener-count mount)) - -;;; ---- Hook System ---- - -(defmethod pipeline-add-hook ((pipeline audio-pipeline) event function) - "Register FUNCTION to be called when EVENT occurs. - Events: :track-change, :playlist-change" - (push function (gethash event (pipeline-hooks pipeline))) - (log:debug "Hook added for ~A" event)) - -(defmethod pipeline-remove-hook ((pipeline audio-pipeline) event function) - "Remove FUNCTION from the hook list for EVENT." - (setf (gethash event (pipeline-hooks pipeline)) - (remove function (gethash event (pipeline-hooks pipeline)))) - (log:debug "Hook removed for ~A" event)) - -(defmethod pipeline-fire-hook ((pipeline audio-pipeline) event &rest args) - "Fire all hooks registered for EVENT." - (dolist (fn (gethash event (pipeline-hooks pipeline))) - (handler-case - (apply fn pipeline args) - (error (e) - (log:warn "Hook error (~A): ~A" event e))))) - diff --git a/cl-streamer/icy-protocol.lisp b/cl-streamer/icy-protocol.lisp deleted file mode 100644 index ff45dab..0000000 --- a/cl-streamer/icy-protocol.lisp +++ /dev/null @@ -1,58 +0,0 @@ -(in-package #:cl-streamer) - -(defparameter *default-metaint* 16000 - "Default ICY metadata interval in bytes.") - -(defclass icy-metadata () - ((title :initarg :title :accessor icy-metadata-title :initform nil) - (url :initarg :url :accessor icy-metadata-url :initform nil))) - -(defun make-icy-metadata (&key title url) - "Create an ICY metadata object." - (make-instance 'icy-metadata :title title :url url)) - -(defun encode-icy-metadata (metadata) - "Encode metadata into ICY protocol format. - Returns a byte vector with length prefix." - (let* ((stream-title (or (icy-metadata-title metadata) "")) - (stream-url (or (icy-metadata-url metadata) "")) - (meta-string (format nil "StreamTitle='~A';StreamUrl='~A';" - stream-title stream-url)) - (meta-bytes (flexi-streams:string-to-octets meta-string :external-format :utf-8)) - (meta-len (length meta-bytes)) - (padded-len (* 16 (ceiling meta-len 16))) - (length-byte (floor padded-len 16)) - (result (make-array (1+ padded-len) :element-type '(unsigned-byte 8) - :initial-element 0))) - (setf (aref result 0) length-byte) - (replace result meta-bytes :start1 1) - result)) - -(defun parse-icy-request (request-line headers) - "Parse an ICY/HTTP request. Returns (values mount-point wants-metadata-p). - HEADERS is an alist of (name . value) pairs." - (let* ((parts (split-sequence:split-sequence #\Space request-line)) - (path (second parts)) - (icy-metadata-header (cdr (assoc "icy-metadata" headers :test #'string-equal)))) - (values path - (and icy-metadata-header - (string= icy-metadata-header "1"))))) - -(defun write-icy-response-headers (stream &key content-type metaint - (name "CL-Streamer") - (genre "Various") - (bitrate 128)) - "Write ICY/HTTP response headers to STREAM." - (format stream "HTTP/1.1 200 OK~C~C" #\Return #\Linefeed) - (format stream "Content-Type: ~A~C~C" content-type #\Return #\Linefeed) - (format stream "icy-name: ~A~C~C" name #\Return #\Linefeed) - (format stream "icy-genre: ~A~C~C" genre #\Return #\Linefeed) - (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) - (force-output stream)) diff --git a/cl-streamer/lame-ffi.lisp b/cl-streamer/lame-ffi.lisp deleted file mode 100644 index 2ff4409..0000000 --- a/cl-streamer/lame-ffi.lisp +++ /dev/null @@ -1,92 +0,0 @@ -(in-package #:cl-streamer) - -(cffi:define-foreign-library liblame - (:unix (:or "libmp3lame.so.0" "libmp3lame.so")) - (:darwin "libmp3lame.dylib") - (:windows "libmp3lame.dll") - (t (:default "libmp3lame"))) - -(cffi:use-foreign-library liblame) - -(cffi:defctype lame-global-flags :pointer) - -(cffi:defcenum lame-vbr-mode - (:vbr-off 0) - (:vbr-mt 1) - (:vbr-rh 2) - (:vbr-abr 3) - (:vbr-mtrh 4) - (:vbr-default 4)) - -(cffi:defcenum lame-mode - (:stereo 0) - (:joint-stereo 1) - (:dual-channel 2) - (:mono 3)) - -(cffi:defcfun ("lame_init" lame-init) lame-global-flags) - -(cffi:defcfun ("lame_close" lame-close) :int - (gfp lame-global-flags)) - -(cffi:defcfun ("lame_set_in_samplerate" lame-set-in-samplerate) :int - (gfp lame-global-flags) - (rate :int)) - -(cffi:defcfun ("lame_set_out_samplerate" lame-set-out-samplerate) :int - (gfp lame-global-flags) - (rate :int)) - -(cffi:defcfun ("lame_set_num_channels" lame-set-num-channels) :int - (gfp lame-global-flags) - (channels :int)) - -(cffi:defcfun ("lame_set_mode" lame-set-mode) :int - (gfp lame-global-flags) - (mode lame-mode)) - -(cffi:defcfun ("lame_set_quality" lame-set-quality) :int - (gfp lame-global-flags) - (quality :int)) - -(cffi:defcfun ("lame_set_brate" lame-set-brate) :int - (gfp lame-global-flags) - (brate :int)) - -(cffi:defcfun ("lame_set_VBR" lame-set-vbr) :int - (gfp lame-global-flags) - (vbr-mode lame-vbr-mode)) - -(cffi:defcfun ("lame_set_VBR_quality" lame-set-vbr-quality) :int - (gfp lame-global-flags) - (quality :float)) - -(cffi:defcfun ("lame_init_params" lame-init-params) :int - (gfp lame-global-flags)) - -(cffi:defcfun ("lame_encode_buffer_interleaved" lame-encode-buffer-interleaved) :int - (gfp lame-global-flags) - (pcm :pointer) - (num-samples :int) - (mp3buf :pointer) - (mp3buf-size :int)) - -(cffi:defcfun ("lame_encode_buffer" lame-encode-buffer) :int - (gfp lame-global-flags) - (buffer-l :pointer) - (buffer-r :pointer) - (num-samples :int) - (mp3buf :pointer) - (mp3buf-size :int)) - -(cffi:defcfun ("lame_encode_flush" lame-encode-flush) :int - (gfp lame-global-flags) - (mp3buf :pointer) - (mp3buf-size :int)) - -(cffi:defcfun ("lame_get_lametag_frame" lame-get-lametag-frame) :size - (gfp lame-global-flags) - (buffer :pointer) - (size :size)) - -(cffi:defcfun ("get_lame_version" get-lame-version) :string) diff --git a/cl-streamer/libfdkaac-shim.so b/cl-streamer/libfdkaac-shim.so deleted file mode 100755 index 54ff8d25f6d15f68996ebeb99552fdcca69bcfba..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 15840 zcmeHOeQX@X6`woj!;lXf>ZEQ`ks~D~X~|(6l7`ZhOYC*lV3Ux<2&AIT*>{ewIp0}# zd*C1iOr3*V4_Bv3p-`!6L{kw}N)XtU=gDu>j}g zVwu#PGb8#~t$w}*F%`8IPi@Sls^Z=Bjd_+HQH!?A0Bk*A*veJ6ALzHd|}g(4RV+fwg|^!9EaXL_qRo_ z4nKTo>C}5*%NB|^P)71|VAq$ypQ(UT9Dy?WKd7LetAHP^fPb?Bo~eM}0z81jU0MLF zbc5hKa9oeO{RMT=532t8mBPgm%jg7MD9Rskkp79KlEpJZ6~oxmn@kvKGn_IFLl~{Q z+Kosw72Oj{o6*#+_NI6;5#1H;j7Ke5d5O{0A2zyUiEupjXjF7Z_J+ee*{_ zhhuSWFKQX9*1M!`Jk|+*EgBD|lfgy-Ue-2^@}M`zHc(iV%L!TLxt7FVi?YTF;C^4pJ)6$*nJ%oQKr=Mit$>7ZwyJXV4V4L zcUd^yJIb{L#vC|514wYefnO^%t<$&zU*Nz+$YSVcK@BAdR6B6Ghq=^-tQzUd8(9hJ z9k}y36ma0`r$<_>cHn%?BxrEpNU&GD40svvGT>#v%Yc^wF9ZMg8F;Veh7a|@OVxUQ z?wMPK(6b|^zci)~zEXWwUVCZ%uK|}<{TAn%6(Q7!?;+XbcnM|I%f!=EadJ%Z!^G3n zZgNEOKO>%|bd$#={}bYA3ORXL^3M}bQ@hE6l5$ZLi@tPF_&=qGDg?>!xukR$X=8B%1($D<;F8$1OmF|00fBlMC2M2EiEeF-5 z@$Q-xc)4YJ%E!Q_Rj?JAbshTPreSCbJ@=-$NY8JY2fVc8D4>Zh1o!IP%c%MuI@=wr zS#f~EAU`3|J;Rf~$vx2RfDb*le_~X-OnSvNdF`^^HKymr^fTiK%_6y%^}IF#ZZuR+ zYJ=Kk-{AhsUwrKKLgAsa>?4=C$Zpy{*-buFe}{H4^M$Kv1&TFxQ^!tG%kI{wZ@AI> zujWoRI{y^e6t`Se86COMZv9BnSHKnDoKfagFjuiWap^b$({rc$;Wu~Er1POZIuFHh zZq8+UBpHf;AdmHWF8hF04WPOm)rg*-vud^UqD|j6qK|3^>0_Jc>WNz0N2n1OM3Ur=+$KVqz(lpb*hxk%}$+d00&P~*uKpC zVKAaNcbM)MX+rOFB2{|-@uvhd{#!0-7Qh-IvOdX+F|rB9*QbW+EG-=M9*o* zQ6+6uPoXM%JEx5xhja-*2S(*>LQmv;maZq4rC~Fgl|xc`m;cN}`UaqW0Z!zg&uQbR z$`O{sBWg(MLt!ePr5xq7gQMEhFh^MXk^A<8=;1MaD03K1Q(jwh)6^Tqe^QHdiwvHo zGu>U1Enb($h{(&ls?K$H+2gQPT{d_LeXxI8&uh}_k0B|%hMz3^_ssqUqmaDfWx&gT zmjN#WUIx4jcp30Az!~r@ueuYjzk>gy`(sjpBqcU4GMK`Tf#8 zBvzRN62L+K(4g;L%uV_Y@EJgqsTvd|*-0z_InOJz*0>-?O>3SM`}>pbaQjmk2M*y|7J{fY|9 z-@j5y5;I{Qx<9b`5v7vE8Lu11o?v`frl&3l3 z9r=;VDWP%Z$NJ&JsvVZqD16L?(?1VLpT{-pZ$!l>mWoiwLbzX=C4QYfE-k4Ldr=`j ze4jA>h}5sO$2sG)-n(4_gYaVtm;b{6_IrgdSL>_g|1N-y<0$9< zE#N+^V%Kj(#Z}7bPeaF#yP5A>Ho1a|4~w_C9~obOMES6S+dW?DWCGDU0oJtW%~F4f zooAM=lX#ur`;l=IxS#$T;_Am%-~m>0&?xY7>(3umxO<)XQxbPLP}S!v;3t(I_d52o zzylw5BmPjq&l?r+w<_QtRKR_BaH*j%tMw(o%f)jm@RhSP71Nb6JF&Pvu``$yGwbXP zv)90a^+Ys{)$Ng_u_vDF49AU#nM|dPaHd~$C42kgQ8O9|Hk8+()%P(YoJxiF8PSB9 z+9$fPtUhW)GQGX~VB+B9di>d{a>4%EbWf}|*dx= z+Mv{VUcvJg_CmjdG*@DKd!nQaxp&|>l;keM&0FJJm#`LtQ43A z?Z7NYY|m~Fxa@fz!Ia+%Sl=E0x0OBTUj&qWw`6wW_G z&!ghJ|0?aLWPP{&NeC9>;PJulJG_6*t3mM*{vM* wtH9`enBFNletv$?dn3n=s$DLuv#NKyoO8RZNUsa!>{o8EG^SZmQMdiS0p (length line) 1)) - for colon-pos = (position #\: line) - when colon-pos - collect (cons (string-trim '(#\Space #\Return) (subseq line 0 colon-pos)) - (string-trim '(#\Space #\Return) (subseq line (1+ colon-pos)))))) - -(defun serve-stream (server client-socket stream mount wants-meta) - "Serve audio stream to a client." - (let ((client (make-instance 'client-connection - :socket client-socket - :stream stream - :mount mount - :wants-metadata wants-meta))) - (bt:with-lock-held ((server-clients-lock server)) - (push client (server-clients server))) - (log:info "Client connected to ~A (metadata: ~A)" - (mount-path mount) wants-meta) - (write-icy-response-headers stream - :content-type (mount-content-type mount) - :metaint (when wants-meta *default-metaint*) - :name (mount-name mount) - :genre (mount-genre mount) - :bitrate (mount-bitrate mount)) - (unwind-protect - (stream-to-client client) - (setf (client-active-p client) nil) - (ignore-errors (close client-socket)) - (bt:with-lock-held ((server-clients-lock server)) - (setf (server-clients server) - (remove client (server-clients server)))) - (log:info "Client disconnected from ~A" (mount-path mount))))) - -(defun stream-to-client (client) - "Stream audio data to a client from the broadcast buffer. - Starts with a burst of recent data for fast playback start." - (let* ((mount (client-mount client)) - (buffer (mount-buffer mount)) - (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))) - (loop while (client-active-p client) - do (multiple-value-bind (bytes-read new-pos) - (buffer-read-from buffer (client-read-pos client) chunk) - (if (zerop bytes-read) - ;; No data yet — wait for producer - (buffer-wait-for-data buffer (client-read-pos client)) - (progn - (setf (client-read-pos client) new-pos) - (handler-case - (progn - (if (client-wants-metadata-p client) - (write-with-metadata client chunk bytes-read) - (write-sequence chunk stream :end bytes-read)) - (force-output stream)) - (iolib:socket-connection-reset-error () - (setf (client-active-p client) nil) - (return)) - (isys:ewouldblock () - ;; Write timeout — stale client - (log:warn "Write timeout on ~A, disconnecting stale client" - (mount-path mount)) - (setf (client-active-p client) nil) - (return)) - (error (e) - (log:warn "Client stream error on ~A: ~A" - (mount-path mount) e) - (setf (client-active-p client) nil) - (return))))))))) - -(defun write-with-metadata (client data length) - "Write audio data with ICY metadata injection." - (let* ((stream (client-stream client)) - (mount (client-mount client)) - (metaint *default-metaint*) - (pos 0)) - (loop while (< pos length) - do (let ((bytes-until-meta (- metaint (client-bytes-since-meta client))) - (bytes-remaining (- length pos))) - (if (<= bytes-until-meta bytes-remaining) - (progn - (write-sequence data stream :start pos :end (+ pos bytes-until-meta)) - (incf pos bytes-until-meta) - (setf (client-bytes-since-meta client) 0) - (let ((meta-bytes (bt:with-lock-held ((mount-metadata-lock mount)) - (encode-icy-metadata (mount-metadata mount))))) - (write-sequence meta-bytes stream))) - (progn - (write-sequence data stream :start pos :end length) - (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) - (format stream "Content-Type: text/plain~C~C" #\Return #\Linefeed) - (format stream "~C~C" #\Return #\Linefeed) - (format stream "Mount point not found: ~A~%" path) - (force-output stream)) diff --git a/cl-streamer/test-stream.lisp b/cl-streamer/test-stream.lisp deleted file mode 100644 index e014046..0000000 --- a/cl-streamer/test-stream.lisp +++ /dev/null @@ -1,92 +0,0 @@ -;;; End-to-end streaming test with playlist (MP3 + AAC) -;;; Usage: sbcl --load test-stream.lisp -;;; -;;; Then open in VLC or browser: -;;; http://localhost:8000/stream.mp3 (MP3 128kbps) -;;; http://localhost:8000/stream.aac (AAC 128kbps) -;;; ICY metadata will show track names as they change. - -(push #p"/home/glenn/SourceCode/harmony/" asdf:*central-registry*) -(push #p"/home/glenn/SourceCode/asteroid/cl-streamer/" asdf:*central-registry*) - -(ql:quickload '(:cl-streamer :cl-streamer/encoder :cl-streamer/aac-encoder :cl-streamer/harmony)) - -(format t "~%=== CL-Streamer Playlist Test (MP3 + AAC) ===~%") -(format t "LAME version: ~A~%" (cl-streamer::lame-version)) - -;; 1. Create and start stream server -(format t "~%[1] Starting stream server on port 8000...~%") -(cl-streamer:start :port 8000) - -;; 2. Add mount points -(format t "[2] Adding mount points...~%") -(cl-streamer:add-mount cl-streamer:*server* "/stream.mp3" - :content-type "audio/mpeg" - :bitrate 128 - :name "Asteroid Radio MP3") -(cl-streamer:add-mount cl-streamer:*server* "/stream.aac" - :content-type "audio/aac" - :bitrate 128 - :name "Asteroid Radio AAC") - -;; 3. Create encoders -(format t "[3] Creating encoders...~%") -(defvar *mp3-encoder* (cl-streamer:make-mp3-encoder :sample-rate 44100 - :channels 2 - :bitrate 128)) -(defvar *aac-encoder* (cl-streamer:make-aac-encoder :sample-rate 44100 - :channels 2 - :bitrate 128000)) - -;; 4. Create and start audio pipeline with both outputs -(format t "[4] Starting audio pipeline with Harmony (MP3 + AAC)...~%") -(defvar *pipeline* (cl-streamer/harmony:make-audio-pipeline - :encoder *mp3-encoder* - :stream-server cl-streamer:*server* - :mount-path "/stream.mp3" - :sample-rate 44100 - :channels 2)) - -;; Add AAC as second output -(cl-streamer/harmony:add-pipeline-output *pipeline* *aac-encoder* "/stream.aac") - -(cl-streamer/harmony:start-pipeline *pipeline*) - -;; 5. Build a playlist from the music library -(format t "[5] Building playlist from music library...~%") -(defvar *music-dir* #p"/home/glenn/SourceCode/asteroid/music/library/") - -(defvar *playlist* - (let ((files nil)) - (dolist (dir (directory (merge-pathnames "*/" *music-dir*))) - (dolist (flac (directory (merge-pathnames "**/*.flac" dir))) - (push (list :file (namestring flac)) files))) - ;; Shuffle and take first 10 tracks - (subseq (alexandria:shuffle (copy-list files)) - 0 (min 10 (length files))))) - -(format t "Queued ~A tracks:~%" (length *playlist*)) -(dolist (entry *playlist*) - (format t " ~A~%" (getf entry :file))) - -;; 6. Start playlist playback -(format t "~%[6] Starting playlist...~%") -(cl-streamer/harmony:play-list *pipeline* *playlist* - :crossfade-duration 3.0 - :fade-in 2.0 - :fade-out 2.0) - -(format t "~%=== Stream is live! ===~%") -(format t "MP3: http://localhost:8000/stream.mp3~%") -(format t "AAC: http://localhost:8000/stream.aac~%") -(format t "~%Press Enter to stop...~%") - -(read-line) - -;; Cleanup -(format t "Stopping...~%") -(cl-streamer/harmony:stop-pipeline *pipeline*) -(cl-streamer:close-encoder *mp3-encoder*) -(cl-streamer:close-aac-encoder *aac-encoder*) -(cl-streamer:stop) -(format t "Done.~%")