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:

  1. (defun shoutcast (request entity)
  2.   (with-http-response
  3.       (request entity :content-type "audio/MP3" :timeout *timeout-seconds*)
  4.     (prepare-icy-response request *metadata-interval*)
  5.     (let ((wants-metadata-p (header-slot-value request :icy-metadata)))
  6.       (with-http-body (request entity)
  7.         (play-songs 
  8.          (request-socket request)
  9.          (find-song-source *song-source-type* request)
  10.          (if wants-metadata-p *metadata-interval*))))))

Then publish that function under the path /stream.mp3 like this:4

  1. (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.

  1. (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.5 You also need, in order to work around a bug in iTunes, to tell AllegroServe not to use chunked transfer-encoding.6 The functions request-reply-protocol-string, request-uri, and reply-header-slot-value are all part of AllegroServe.

  1. (defun prepare-icy-response (request metadata-interval)
  2.   (setf (request-reply-protocol-string request) "ICY")
  3.   (loop for (k v) in (reverse
  4.        `((:|icy-metaint| ,(princ-to-string metadata-interval))
  5.          (:|icy-notice1| "<BR>This stream blah blah blah<BR>")
  6.          (:|icy-notice2| "More blah")
  7.          (:|icy-name|    "MyLispShoutcastServer")
  8.          (:|icy-genre|   "Unknown")
  9.          (:|icy-url|     ,(request-uri request))
  10.          (:|icy-pub|     "1")))
  11.      do (setf (reply-header-slot-value request k) v))
  12.   ;; iTunes, despite claiming to speak HTTP/1.1, doesn't understand
  13.   ;; chunked Transfer-encoding. Grrr. So we just turn it off.
  14.   (turn-off-chunked-transfer-encoding request))
  16. (defun turn-off-chunked-transfer-encoding (request)
  17.   (setf (request-reply-strategy request)
  18.         (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.

  1. (defparameter *metadata-interval* (expt 2 12))
  3. (defparameter *song-source-type* 'singleton)

The function play-songs itself doesn’t do much—it loops calling the function play-current, which does all the heavy lifting of sending the contents of a single MP3 file, skipping the ID3 tag and embedding ICY metadata. The only wrinkle is that you need to keep track of when to send the metadata.

Since you must send metadata chunks at a fixed intervals, regardless of when you happen to switch from one MP3 file to the next, each time you call play-current you need to tell it when the next metadata is due, and when it returns, it must tell you the same thing so you can pass the information to the next call to play-current. If play-current gets **NIL** from the song source, it returns **NIL**, which allows the play-songs **LOOP** to end.

In addition to handling the looping, play-songs also provides a **HANDLER-CASE** to trap the error that will be signaled when the MP3 client disconnects from the server and one of the writes to the socket, down in play-current, fails. Since the **HANDLER-CASE** is outside the **LOOP**, handling the error will break out of the loop, allowing play-songs to return.

  1. (defun play-songs (stream song-source metadata-interval)
  2.   (handler-case 
  3.       (loop
  4.          for next-metadata = metadata-interval
  5.          then (play-current 
  6.                stream 
  7.                song-source
  8.                next-metadata
  9.                metadata-interval)
  10.          while next-metadata)
  11.     (error (e) (format *trace-output* "Caught error in play-songs: ~a" e))))

Finally, you’re ready to implement play-current, which actually sends the Shoutcast data. The basic idea is that you get the current song from the song source, open the song’s file, and then loop reading data from the file and writing it to the socket until either you reach the end of the file or the current song is no longer the current song.

There are only two complications: One is that you need to make sure you send the metadata at the correct interval. The other is that if the file starts with an ID3 tag, you want to skip it. If you don’t worry too much about I/O efficiency, you can implement play-current like this:

  1. (defun play-current (out song-source next-metadata metadata-interval)
  2.   (let ((song (current-song song-source)))
  3.     (when song
  4.       (let ((metadata (make-icy-metadata (title song))))
  5.         (with-open-file (mp3 (file song))
  6.           (unless (file-position mp3 (id3-size song))
  7.             (error "Can't skip to position ~d in ~a" (id3-size song) (file song)))
  8.           (loop for byte = (read-byte mp3 nil nil)
  9.              while (and byte (still-current-p song song-source)) do
  10.                (write-byte byte out)
  11.                (decf next-metadata)
  12.              when (and (zerop next-metadata) metadata-interval) do
  13.                (write-sequence metadata out)
  14.                (setf next-metadata metadata-interval))
  16.           (maybe-move-to-next-song song song-source)))
  17.       next-metadata)))

This function gets the current song from the song source and gets a buffer containing the metadata it’ll need to send by passing the title to make-icy-metadata. Then it opens the file and skips past the ID3 tag using the two-argument form of **FILE-POSITION**. Then it commences reading bytes from the file and writing them to the request stream.7

It’ll break out of the loop either when it reaches the end of the file or when the song source’s current song changes out from under it. In the meantime, whenever next-metadata gets to zero (if you’re supposed to send metadata at all), it writes metadata to the stream and resets next-metadata. Once it finishes the loop, it checks to see if the song is still the song source’s current song; if it is, that means it broke out of the loop because it read the whole file, in which case it tells the song source to move to the next song. Otherwise, it broke out of the loop because someone changed the current song out from under it, and it just returns. In either case, it returns the number of bytes left before the next metadata is due so it can be passed in the next call to play-current.8

The function make-icy-metadata, which takes the title of the current song and generates an array of bytes containing a properly formatted chunk of ICY metadata, is also straightforward.9

  1. (defun make-icy-metadata (title)
  2.   (let* ((text (format nil "StreamTitle='~a';" (substitute #\Space #\' title)))
  3.          (blocks (ceiling (length text) 16))
  4.          (buffer (make-array (1+ (* blocks 16))
  5.                              :element-type '(unsigned-byte 8)
  6.                              :initial-element 0)))
  7.     (setf (aref buffer 0) blocks)
  8.     (loop 
  9.        for char across text
  10.        for i from 1 
  11.        do (setf (aref buffer i) (char-code char)))
  12.     buffer))

Depending on how your particular Lisp implementation handles its streams, and also how many MP3 clients you want to serve at once, the simple version of play-current may or may not be efficient enough.

The potential problem with the simple implementation is that you have to call **READ-BYTE** and **WRITE-BYTE** for every byte you transfer. It’s possible that each call may result in a relatively expensive system call to read or write one byte. And even if Lisp implements its own streams with internal buffering so not every call to **READ-BYTE** or **WRITE-BYTE** results in a system call, function calls still aren’t free. In particular, in implementations that provide user-extensible streams using so-called Gray Streams, **READ-BYTE** and **WRITE-BYTE** may result in a generic function call under the covers to dispatch on the class of the stream argument. While generic function dispatch is normally speedy enough that you don’t have to worry about it, it’s a bit more expensive than a nongeneric function call and thus not something you necessarily want to do several million times in a few minutes if you can avoid it.

A more efficient, if slightly more complex, way to implement play-current is to read and write multiple bytes at a time using the functions **READ-SEQUENCE** and **WRITE-SEQUENCE**. This also gives you a chance to match your file reads with the natural block size of the file system, which will likely give you the best disk throughput. Of course, no matter what buffer size you use, keeping track of when to send the metadata becomes a bit more complicated. A more efficient version of play-current that uses **READ-SEQUENCE** and **WRITE-SEQUENCE** might look like this:

  1. (defun play-current (out song-source next-metadata metadata-interval)
  2.   (let ((song (current-song song-source)))
  3.     (when song
  4.       (let ((metadata (make-icy-metadata (title song)))
  5.             (buffer (make-array size :element-type '(unsigned-byte 8))))
  6.         (with-open-file (mp3 (file song))
  7.           (labels ((write-buffer (start end)
  8.                      (if metadata-interval
  9.                        (write-buffer-with-metadata start end)
  10.                        (write-sequence buffer out :start start :end end)))
  12.                    (write-buffer-with-metadata (start end)
  13.                      (cond
  14.                        ((> next-metadata (- end start))
  15.                         (write-sequence buffer out :start start :end end)
  16.                         (decf next-metadata (- end start)))
  17.                        (t 
  18.                         (let ((middle (+ start next-metadata)))
  19.                           (write-sequence buffer out :start start :end middle)
  20.                           (write-sequence metadata out)
  21.                           (setf next-metadata metadata-interval)
  22.                           (write-buffer-with-metadata middle end))))))
  24.             (multiple-value-bind (skip-blocks skip-bytes)
  25.                 (floor (id3-size song) (length buffer))
  27.               (unless (file-position mp3 (* skip-blocks (length buffer)))
  28.                 (error "Couldn't skip over ~d ~d byte blocks."
  29.                        skip-blocks (length buffer)))
  31.               (loop for end = (read-sequence buffer mp3) 
  32.                  for start = skip-bytes then 0
  33.                  do (write-buffer start end)
  34.                  while (and (= end (length buffer))
  35.                             (still-current-p song song-source)))
  37.               (maybe-move-to-next-song song song-source)))))
  38.       next-metadata)))

Now you’re ready to put all the pieces together. In the next chapter you’ll write a Web interface to the Shoutcast server developed in this chapter, using the MP3 database from Chapter 27 as the source of songs.

1The version of XMMS shipped with Red Hat 8.0 and 9.0 and Fedora no longer knows how to play MP3s because the folks at Red Hat were worried about the licensing issues related to the MP3 codec. To get an XMMS with MP3 support on these versions of Linux, you can grab the source from http://www.xmms.org and build it yourself. Or, see http://www.fedorafaq.org/#xmms-mp3 for information about other possibilities.

2To further confuse matters, there’s a different streaming protocol called Icecast. There seems to be no connection between the ICY header used by Shoutcast and the Icecast protocol.

3Technically, the implementation in this chapter will also be manipulated from two threads—the AllegroServe thread running the Shoutcast server and the REPL thread. But you can live with the race condition for now. I’ll discuss how to use locking to make code thread safe in the next chapter.

4Another 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.

5Shoutcast 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.

6The 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.

7Most MP3-playing software will display the metadata somewhere in the user interface. However, the XMMS program on Linux by default doesn’t. To get XMMS to display Shoutcast metadata, press Ctrl+P to see the Preferences pane. Then in the Audio I/O Plugins tab (the leftmost tab in version 1.2.10), select the MPEG Layer 1/2/3 Player (libmpg123.so) and hit the Configure button. Then select the Streaming tab on the configuration window, and at the bottom of the tab in the SHOUTCAST/Icecast section, check the “Enable SHOUTCAST/Icecast title streaming” box.

8Folks coming to Common Lisp from Scheme might wonder why play-current can’t just call itself recursively. In Scheme that would work fine since Scheme implementations are required by the Scheme specification to support “an unbounded number of active tail calls.” Common Lisp implementations are allowed to have this property, but it isn’t required by the language standard. Thus, in Common Lisp the idiomatic way to write loops is with a looping construct, not with recursion.

9This function assumes, as has other code you’ve written, that your Lisp implementation’s internal character encoding is ASCII or a superset of ASCII, so you can use **CHAR-CODE** to translate Lisp **CHARACTER** objects to bytes of ASCII data.