Practical Common Lisp

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

(defparameter *metadata-interval* (expt 2 12))
(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