Peter Siebel - Practical Common Lisp

To represent the information about a song that the Shoutcast server needs, you can define a class, song, with slots to hold the name of the MP3 file, the title to send in the Shoutcast metadata, and the size of the ID3 tag so you can skip it when serving up the file.

(defclass song ()

((file :reader file :initarg :file)

(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-pand 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 typeparameter 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-sourcethat specializes typewith an EQL specializer on the symbol singletonand 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))))

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-functionmacro 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.mp3like this: [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.

(publish :path "/stream.mp3" :function 'shoutcast)

In the call to with-http-response, in addition to the usual requestand entityarguments, you need to pass :content-typeand :timeoutarguments. The :content-typeargument tells AllegroServe how to set the Content-Type header it sends. And the :timeoutargument 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-responseand before the call to with-http-bodythat will cause the response headers to be sent, you need to manipulate the reply that AllegroServe will send. The function prepare-icy-responseencapsulates the necessary manipulations: changing the protocol string from the default of "HTTP" to "ICY" and adding the Shoutcast-specific headers. [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. You also need, in order to work around a bug in iTunes, to tell AllegroServe not to use chunked transfer-encoding . [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. The functions request-reply-protocol-string, request-uri, and reply-header-slot-valueare 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| "
This stream blah blah blah
")

(:|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))