glenn
/
asteroid
mirror of https://github.com/glenneth1/asteroid.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Phase 4: Extract cl-streamer to standalone repository 

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.
This commit is contained in:
Glenn Thompson 2026-03-08 12:08:09 +03:00
parent 2e86dc4a88
commit 8d9d2b33b1
19 changed files with 5 additions and 2494 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitmodules vendored Normal file
View File

@ -0,0 +1,4 @@
[submodule "cl-streamer"]
path = cl-streamer
url = git@github.com:glenneth1/cl-streamer.git
branch = master

1
cl-streamer Submodule

@ -0,0 +1 @@
Subproject commit e1f113976b146894f8ac5e8fea5ba34c953db7e0

295
cl-streamer/README.org
View File

@ -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

145
cl-streamer/aac-encoder.lisp
View File

@ -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))

87
cl-streamer/buffer.lisp
View File

@ -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)))

43
cl-streamer/cl-streamer.asd
View File

@ -1,43 +0,0 @@
(asdf:defsystem #:cl-streamer
:description "Common Lisp audio streaming server for Asteroid Radio"
:author "Glenn Thompson <glenn@asteroid.radio>"
: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")))

38
cl-streamer/cl-streamer.lisp
View File

@ -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)))

20
cl-streamer/conditions.lisp
View File

@ -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)))))

107
cl-streamer/encoder.lisp
View File

@ -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))

165
cl-streamer/fdkaac-ffi.lisp
View File

@ -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))

101
cl-streamer/fdkaac-shim.c
View File

@ -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 <fdk-aac/aacenc_lib.h>
#include <string.h>
/* 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);
}

702
cl-streamer/harmony-backend.lisp
View File

@ -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)))))

58
cl-streamer/icy-protocol.lisp
View File

@ -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))

92
cl-streamer/lame-ffi.lisp
View File

@ -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)

BIN
cl-streamer/libfdkaac-shim.so
View File

Binary file not shown.

92
cl-streamer/package.lisp
View File

@ -1,92 +0,0 @@
(defpackage #:cl-streamer
(:use #:cl #:alexandria)
(:export
;; Conditions
#:streamer-error
#:connection-error
#:encoding-error
;; Buffer
#:broadcast-buffer
#:make-ring-buffer
#:buffer-write
#:buffer-read-from
#:buffer-wait-for-data
#:buffer-current-pos
#:buffer-burst-start
#:buffer-clear
;; ICY Protocol
#:icy-metadata
#:make-icy-metadata
#:icy-metadata-title
#:icy-metadata-url
#:encode-icy-metadata
#:icy-metaint
;; Stream Server
#:stream-server
#:make-stream-server
#:start-server
#:stop-server
#:server-running-p
#:add-mount
#:remove-mount
#:update-metadata
#:listener-count
;; Main API
#:*server*
#:*default-port*
#:*default-metaint*
#:start
#:stop
#:write-audio-data
#:set-now-playing
#:get-listener-count
;; Encoder
#:make-mp3-encoder
#:close-encoder
#:encode-pcm-interleaved
#:encode-flush
#:lame-version
;; AAC Encoder
#:make-aac-encoder
#:close-aac-encoder
#:encode-aac-pcm
;; Protocol — Server
#:server-start
#:server-stop
#:server-running-p
#:server-add-mount
#:server-remove-mount
#:server-update-metadata
#:server-listener-count
#:server-write-audio
;; Protocol — Pipeline
#: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
;; Protocol — Pipeline Hooks
#:pipeline-add-hook
#:pipeline-remove-hook
#:pipeline-fire-hook
;; Protocol — Encoder
#:encoder-encode
#:encoder-flush
#:encoder-close))

171
cl-streamer/protocol.lisp
View File

@ -1,171 +0,0 @@
;;;; protocol.lisp - Protocol definitions for cl-streamer
;;;; Defines the generic function protocol that decouples application code
;;;; from specific backend implementations (Harmony, encoders, server).
;;;;
;;;; Applications program against these generics; backends provide methods.
(in-package #:cl-streamer)
;;; ============================================================
;;; Stream Server Protocol
;;; ============================================================
;;; The stream server handles HTTP connections, mount points,
;;; ICY metadata injection, and client lifecycle.
(defgeneric server-start (server)
(:documentation "Start the stream server, begin accepting connections."))
(defgeneric server-stop (server)
(:documentation "Stop the stream server, disconnect all clients."))
(defgeneric server-running-p (server)
(:documentation "Return T if the server is currently running."))
(defgeneric server-add-mount (server path &key content-type bitrate name genre buffer-size)
(:documentation "Add a mount point to the server. Returns the mount-point object."))
(defgeneric server-remove-mount (server path)
(:documentation "Remove a mount point from the server."))
(defgeneric server-update-metadata (server path &key title url)
(:documentation "Update ICY metadata for a mount point."))
(defgeneric server-listener-count (server &optional path)
(:documentation "Return the number of connected listeners.
If PATH is given, count only listeners on that mount."))
(defgeneric server-write-audio (server mount-path data &key start end)
(:documentation "Write encoded audio data to a mount point's broadcast buffer."))
;;; ============================================================
;;; Audio Pipeline Protocol
;;; ============================================================
;;; The pipeline connects an audio source (e.g. Harmony) to
;;; encoders and the stream server. It manages playback,
;;; queueing, crossfading, and metadata propagation.
(defgeneric pipeline-start (pipeline)
(:documentation "Start the audio pipeline."))
(defgeneric pipeline-stop (pipeline)
(:documentation "Stop the audio pipeline."))
(defgeneric pipeline-running-p (pipeline)
(:documentation "Return T if the pipeline is currently running."))
(defgeneric pipeline-play-file (pipeline file-path &key title)
(:documentation "Play a single audio file through the pipeline.
Returns (values voice display-title track-info)."))
(defgeneric pipeline-play-list (pipeline file-list &key crossfade-duration
fade-in fade-out
loop-queue)
(:documentation "Play a list of files sequentially with crossfading.
Each entry can be a string (path) or plist (:file path :title title).
Runs in a background thread."))
(defgeneric pipeline-skip (pipeline)
(:documentation "Skip the currently playing track."))
(defgeneric pipeline-queue-files (pipeline file-entries &key position)
(:documentation "Add file entries to the playback queue.
POSITION is :end (append, default) or :next (prepend)."))
(defgeneric pipeline-get-queue (pipeline)
(:documentation "Return a copy of the current playback queue."))
(defgeneric pipeline-clear-queue (pipeline)
(:documentation "Clear the playback queue."))
(defgeneric pipeline-current-track (pipeline)
(:documentation "Return the current track info plist, or NIL.
Plist keys: :file :display-title :artist :title :album"))
(defgeneric pipeline-listener-count (pipeline &optional mount)
(:documentation "Return the listener count (delegates to the server)."))
(defgeneric pipeline-update-metadata (pipeline title)
(:documentation "Update ICY metadata on all mount points."))
;;; ============================================================
;;; Pipeline Hook Protocol
;;; ============================================================
;;; Hooks replace direct slot access for callbacks.
;;; Events: :track-change, :playlist-change
(defgeneric pipeline-add-hook (pipeline event function)
(:documentation "Register FUNCTION to be called when EVENT occurs.
Events:
:track-change — (lambda (pipeline track-info))
:playlist-change — (lambda (pipeline playlist-path))"))
(defgeneric pipeline-remove-hook (pipeline event function)
(:documentation "Remove FUNCTION from the hook list for EVENT."))
(defgeneric pipeline-fire-hook (pipeline event &rest args)
(:documentation "Fire all hooks registered for EVENT with ARGS.
Called internally by the pipeline implementation."))
;;; ============================================================
;;; Encoder Protocol
;;; ============================================================
;;; Encoders convert PCM audio data into a streaming format
;;; (MP3, AAC, Opus, etc).
(defgeneric encoder-encode (encoder pcm-buffer num-samples)
(:documentation "Encode PCM samples. Returns encoded byte vector.
PCM-BUFFER is a (signed-byte 16) array of interleaved stereo samples.
NUM-SAMPLES is the number of sample frames (not individual samples)."))
(defgeneric encoder-flush (encoder)
(:documentation "Flush any remaining data from the encoder. Returns byte vector."))
(defgeneric encoder-close (encoder)
(:documentation "Release encoder resources."))
;;; ============================================================
;;; Default method implementations
;;; ============================================================
;;; Server protocol — default methods on the existing stream-server class
;;; These delegate to the existing functions so nothing breaks.
(defmethod server-start ((server stream-server))
(start-server server))
(defmethod server-stop ((server stream-server))
(stop-server server))
(defmethod server-running-p ((server stream-server))
(slot-value server 'running))
(defmethod server-add-mount ((server stream-server) path
&key (content-type "audio/mpeg")
(bitrate 128)
(name "CL-Streamer")
(genre "Various")
(buffer-size (* 1024 1024)))
(add-mount server path
:content-type content-type
:bitrate bitrate
:name name
:genre genre
:buffer-size buffer-size))
(defmethod server-remove-mount ((server stream-server) path)
(remove-mount server path))
(defmethod server-update-metadata ((server stream-server) path &key title url)
(update-metadata server path :title title :url url))
(defmethod server-listener-count ((server stream-server) &optional path)
(listener-count server path))
(defmethod server-write-audio ((server stream-server) mount-path data
&key (start 0) (end (length data)))
(let ((mount (gethash mount-path (server-mounts server))))
(when mount
(buffer-write (mount-buffer mount) data :start start :end end))))
;;; Encoder protocol methods are defined in encoder.lisp and aac-encoder.lisp
;;; alongside their respective class definitions (separate ASDF subsystems).

286
cl-streamer/stream-server.lisp
View File

@ -1,286 +0,0 @@
(in-package #:cl-streamer)
(defparameter *default-port* 8000
"Default port for the streaming server.")
(defparameter *client-write-timeout* 30
"Seconds before a stale client write is abandoned.")
(defclass stream-server ()
((port :initarg :port :accessor server-port :initform *default-port*)
(socket :initform nil :accessor server-socket)
(running :initform nil :accessor server-running-p)
(mounts :initform (make-hash-table :test 'equal) :accessor server-mounts)
(clients :initform nil :accessor server-clients)
(clients-lock :initform (bt:make-lock "clients-lock") :reader server-clients-lock)
(accept-thread :initform nil :accessor server-accept-thread)))
(defclass mount-point ()
((path :initarg :path :accessor mount-path)
(content-type :initarg :content-type :accessor mount-content-type
:initform "audio/mpeg")
(bitrate :initarg :bitrate :accessor mount-bitrate :initform 128)
(name :initarg :name :accessor mount-name :initform "CL-Streamer")
(genre :initarg :genre :accessor mount-genre :initform "Various")
(buffer :initarg :buffer :accessor mount-buffer)
(metadata :initform (make-icy-metadata) :accessor mount-metadata)
(metadata-lock :initform (bt:make-lock "metadata-lock") :reader mount-metadata-lock)))
(defclass client-connection ()
((socket :initarg :socket :accessor client-socket)
(stream :initarg :stream :accessor client-stream)
(mount :initarg :mount :accessor client-mount)
(wants-metadata :initarg :wants-metadata :accessor client-wants-metadata-p)
(bytes-since-meta :initform 0 :accessor client-bytes-since-meta)
(read-pos :initform 0 :accessor client-read-pos
:documentation "Client's absolute position in the broadcast buffer")
(thread :initform nil :accessor client-thread)
(active :initform t :accessor client-active-p)))
(defun make-stream-server (&key (port *default-port*))
"Create a new stream server instance."
(make-instance 'stream-server :port port))
(defun add-mount (server path &key (content-type "audio/mpeg")
(bitrate 128)
(name "CL-Streamer")
(genre "Various")
(buffer-size (* 1024 1024)))
"Add a mount point to the server."
(let ((mount (make-instance 'mount-point
:path path
:content-type content-type
:bitrate bitrate
:name name
:genre genre
:buffer (make-ring-buffer buffer-size))))
(setf (gethash path (server-mounts server)) mount)
mount))
(defun remove-mount (server path)
"Remove a mount point from the server."
(remhash path (server-mounts server)))
(defun update-metadata (server path &key title url)
"Update the metadata for a mount point."
(let ((mount (gethash path (server-mounts server))))
(when mount
(bt:with-lock-held ((mount-metadata-lock mount))
(let ((meta (mount-metadata mount)))
(when title (setf (icy-metadata-title meta) title))
(when url (setf (icy-metadata-url meta) url)))))))
(defun listener-count (server &optional path)
"Return the number of connected listeners.
If PATH is specified, count only listeners on that mount."
(bt:with-lock-held ((server-clients-lock server))
(if path
(count-if (lambda (c) (and (client-active-p c)
(string= path (mount-path (client-mount c)))))
(server-clients server))
(count-if #'client-active-p (server-clients server)))))
(defun configure-client-socket (socket)
"Set socket options on an accepted client connection.
Enables SO_KEEPALIVE for stale connection detection and
TCP_NODELAY for low-latency streaming."
(setf (iolib:socket-option socket :keep-alive) t)
(setf (iolib:socket-option socket :tcp-nodelay) t)
;; SO_SNDTIMEO for write timeout — detect stale clients
(setf (iolib:socket-option socket :send-timeout) *client-write-timeout*))
(defun start-server (server)
"Start the streaming server."
(when (server-running-p server)
(error 'streamer-error :message "Server already running"))
(setf (server-socket server)
(iolib:make-socket :connect :passive
:address-family :internet
:type :stream
:local-host "0.0.0.0"
:local-port (server-port server)
:reuse-address t
:backlog 128))
(setf (server-running-p server) t)
(setf (server-accept-thread server)
(bt:make-thread (lambda () (accept-loop server))
:name "cl-streamer-accept"))
(log:info "CL-Streamer started on port ~A" (server-port server))
server)
(defun stop-server (server)
"Stop the streaming server."
(setf (server-running-p server) nil)
(bt:with-lock-held ((server-clients-lock server))
(dolist (client (server-clients server))
(setf (client-active-p client) nil)
(ignore-errors (close (client-socket client)))))
(ignore-errors (close (server-socket server)))
(log:info "CL-Streamer stopped")
server)
(defun accept-loop (server)
"Main accept loop for incoming connections."
(loop while (server-running-p server)
do (handler-case
(let ((client-socket (iolib:accept-connection (server-socket server))))
(handler-case
(configure-client-socket client-socket)
(error (e)
(log:debug "Socket option error: ~A" e)))
(bt:make-thread (lambda () (handle-client server client-socket))
:name "cl-streamer-client"))
(iolib:socket-connection-aborted-error ()
;; Client disconnected before we accepted — skip
nil)
(error (e)
(unless (server-running-p server)
(return))
(log:warn "Accept error: ~A" e)))))
(defun handle-client (server client-socket)
"Handle a single client connection.
The iolib socket is a dual-channel gray stream supporting both
binary and character I/O."
(let ((stream (flexi-streams:make-flexi-stream
client-socket
: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 (close client-socket))
(return-from handle-client))
(multiple-value-bind (path wants-meta)
(parse-icy-request request-line headers)
(let ((mount (gethash path (server-mounts server))))
(if mount
(serve-stream server client-socket stream mount wants-meta)
(progn
(log:debug "404 for path: ~A" path)
(send-404 stream path))))))
(error (e)
(log:debug "Client error: ~A" e)
(ignore-errors (close client-socket))))))
(defun read-http-headers (stream)
"Read HTTP headers from STREAM. Returns alist of (name . value)."
(loop for line = (read-line stream nil nil)
while (and line (> (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))

92
cl-streamer/test-stream.lisp
View File

@ -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.~%")