(title :reader title :initarg :title)
(id3-size :reader id3-size :initarg :id3-size)))
The value returned by current-song (and thus the first argument to still-current-p and maybe-move-to-next-song) will be an instance of song.
In addition, you need to define a generic function that the server can use to find a song source based on the type of source desired and the request object. Methods will specialize the type parameter in order to return different kinds of song source and will pull whatever information they need from the request object to determine which source to return.
(defgeneric find-song-source (type request)
(:documentation "Find the song-source of the given type for the given request."))
However, for the purposes of this chapter, you can use a trivial implementation of this interface that always uses the same object, a simple queue of song objects that you can manipulate from the REPL. You can start by defining a class, simple-song-queue, and a global variable, *songs*, that holds an instance of this class.
(defclass simple-song-queue ()
((songs :accessor songs :initform (make-array 10 :adjustable t :fill-pointer 0))
(index :accessor index :initform 0)))
(defparameter *songs* (make-instance 'simple-song-queue))
Then you can define a method on find-song-source that specializes type with an EQL specializer on the symbol singleton and returns the instance stored in *songs*.
(defmethod find-song-source ((type (eql 'singleton)) request)
(declare (ignore request))
*songs*)
Now you just need to implement methods on the three generic functions that the Shoutcast server will use.
(defmethod current-song ((source simple-song-queue))
(when (array-in-bounds-p (songs source) (index source))
(aref (songs source) (index source))))
(defmethod still-current-p (song (source simple-song-queue))
(eql song (current-song source)))
(defmethod maybe-move-to-next-song (song (source simple-song-queue))
(when (still-current-p song source)
(incf (index source))))
And for testing purposes you should provide a way to add songs to this queue.
(defun add-file-to-songs (file)
(vector-push-extend (file->song file) (songs *songs*)))
(defun file->song (file)
(let ((id3 (read-id3 file)))
(make-instance
'song
:file (namestring (truename file))
:title (format nil "~a by ~a from ~a" (song id3) (artist id3) (album id3))
:id3-size (size id3))))
Implementing Shoutcast
Now you're ready to implement the Shoutcast server. Since the Shoutcast protocol is loosely based on HTTP, you can implement the server as a function within AllegroServe. However, since you need to interact with some of the low-level features of AllegroServe, you can't use the define-url-function macro from Chapter 26. Instead, you need to write a regular function that looks like this:
(defun shoutcast (request entity)
(with-http-response
(request entity :content-type "audio/MP3" :timeout *timeout-seconds*)
(prepare-icy-response request *metadata-interval*)
(let ((wants-metadata-p (header-slot-value request :icy-metadata)))
(with-http-body (request entity)
(play-songs
(request-socket request)
(find-song-source *song-source-type* request)
(if wants-metadata-p *metadata-interval*))))))
Then publish that function under the path /stream.mp3 like this:[300]
(publish :path "/stream.mp3" :function 'shoutcast)
In the call to with-http-response, in addition to the usual request and entity arguments, you need to pass :content-type and :timeout arguments. The :content-type argument tells AllegroServe how to set the Content-Type header it sends. And the :timeout argument specifies the number of seconds AllegroServe gives the function to generate its response. By default AllegroServe times out each request after five minutes. Because you're going to stream an essentially endless sequence of MP3s, you need much more time. There's no way to tell AllegroServe to never time out the request, so you should set it to the value of *timeout-seconds*, which you can define to some suitably large value such as the number of seconds in ten years.
(defparameter *timeout-seconds* (* 60 60 24 7 52 10))
Then, within the body of the with-http-response and before the call to with-http-body that will cause the response headers to be sent, you need to manipulate the reply that AllegroServe will send. The function prepare-icy-response encapsulates the necessary manipulations: changing the protocol string from the default of "HTTP" to "ICY" and adding the Shoutcast-specific headers.[301] You also need, in order to work around a bug in iTunes, to tell AllegroServe not to use chunked transfer-encoding.[302] The functions request-reply-protocol-string, request-uri, and reply-header-slot-value are all part of AllegroServe.
(defun prepare-icy-response (request metadata-interval)
(setf (request-reply-protocol-string request) "ICY")
(loop for (k v) in (reverse
`((:|icy-metaint| ,(princ-to-string metadata-interval))
(:|icy-notice1| "<BR>This stream blah blah blah<BR>")
(:|icy-notice2| "More blah")
(:|icy-name| "MyLispShoutcastServer")
(:|icy-genre| "Unknown")
(:|icy-url| ,(request-uri request))
(:|icy-pub| "1")))
do (setf (reply-header-slot-value request k) v))
;; iTunes, despite claiming to speak HTTP/1.1, doesn't understand
;; chunked Transfer-encoding. Grrr. So we just turn it off.
(turn-off-chunked-transfer-encoding request))
(defun turn-off-chunked-transfer-encoding (request)
(setf (request-reply-strategy request)
(remove :chunked (request-reply-strategy request))))
Within the with-http-body of shoutcast, you actually stream the MP3 data. The function play-songs takes the stream to which it should write the data, the song source, and the metadata interval it should use or NIL if the client doesn't want metadata. The stream is the socket obtained from the request object, the song source is obtained by calling find-song-source, and the metadata interval comes from the global variable *metadata-interval*. The type of song source is controlled by the variable *song-source-type*, which for now you can set to singleton in order to use the simple-song-queue you implemented previously.
300
Another thing you may want to do while working on this code is to evaluate the form (net.aserve::debug-on :notrap). This tells AllegroServe to not trap errors signaled by your code, which will allow you to debug them in the normal Lisp debugger. In SLIME this will pop up a SLIME debugger buffer just like any other error.
301
Shoutcast headers are usually sent in lowercase, so you need to escape the names of the keyword symbols used to identify them to AllegroServe to keep the Lisp reader from converting them to all uppercase. Thus, you'd write :|icy-metaint| rather than :icy-metaint. You could also write :\i\c\y-\m\e\t\a\i\n\t, but that'd be silly.
302
The function turn-off-chunked-transfer-encoding is a bit of a kludge. There's no way to turn off chunked transfer encoding via AllegroServe's official APIs without specifying a content length because any client that advertises itself as an HTTP/1.1 client, which iTunes does, is supposed to understand it. But this does the trick.