diff --git a/hums.cabal b/hums.cabal
--- a/hums.cabal
+++ b/hums.cabal
@@ -1,5 +1,5 @@
 Name:                hums
-Version:             0.2.6
+Version:             0.3.0
 Synopsis:            Haskell UPnP Media Server
 Description:         A simple UPnP Media Server.
   .
@@ -23,10 +23,12 @@
                      containers >= 0.1.0.1,
                      uuid >= 1.0.0,
                      bytestring >= 0.9.0.1,
+                     utf8-string == 0.3.*,
                      MissingH >= 1.0.1,
-                     hxt >= 8.3.1 && < 8.6,
+                     hxt == 9.*,
                      ConfigFile >= 1.0.5,
-                     mtl >= 1.1.0.2,
+                     mtl >= 1.1.0.2, 
+                     transformers == 0.2.*,
                      network-bytestring >= 0.1.2.1 && <0.2
 data-dir:            data
 data-files:          hums.cfg 
@@ -35,7 +37,7 @@
                      www/services/ContentDirectory/description.xml
 
 Executable:          hums
-Extensions:          Arrows
+Extensions:          Arrows GeneralizedNewtypeDeriving
 ghc-options:         -Wall -fno-warn-unused-matches -threaded
 hs-source-dirs:      src
 Main-is:             Main.hs
@@ -45,8 +47,9 @@
                      URIExtra
                      SimpleServiceDiscoveryProtocol
                      HttpExtra
-                     RegexExtra
+                     HttpMonad
                      Service
+                     Handlers
                      Configuration
                      Soap
                      DirectoryUtils
diff --git a/src/DirectoryUtils.hs b/src/DirectoryUtils.hs
--- a/src/DirectoryUtils.hs
+++ b/src/DirectoryUtils.hs
@@ -33,8 +33,13 @@
 walkTree :: a -> (a -> a -> FilePath -> IO a) -> FilePath -> IO a
 walkTree s0 f d = do
   -- FIXME: Need to detect loops!
-  -- Get files and directories in directory.
-  allNames <- getDirectoryContents d
+  -- Get files and directories in directory. If that fails
+  -- we just pretend there are none.
+  allNames <- catch 
+              (getDirectoryContents d) 
+              (\e -> do
+                  putStrLn $ "Error retrieving directory contents: " ++ show e -- Log errors
+                  return [])
   -- Filter out the special directories.
   let names = sort $ filter (not . isSpecialDirectory) allNames
   -- Produce full names.
@@ -43,12 +48,19 @@
   foldM traverse s0 fullNames
   where 
     traverse s n = do
-                    isDirectory <- doesDirectoryExist n
-                    if isDirectory then do
-                         s' <- f s0 s n
-                         walkTree s' f n
-                      else
-                         f s0 s n
+      isFile <- doesFileExist n
+      case isFile of
+        True -> f s0 s n
+        False -> do
+          isDirectory <- doesDirectoryExist n
+          case isDirectory of
+            True -> do 
+              s' <- f s0 s n
+              walkTree s' f n
+            False -> do
+              -- Not a directory nor an existing file. Conclusion: A dead symlink.
+              putStrLn $ "Ignoring dead symbolic link: " ++ (show n)
+              return s
 
     isSpecialDirectory ".." = True
     isSpecialDirectory "." = True
diff --git a/src/Handlers.hs b/src/Handlers.hs
new file mode 100644
--- /dev/null
+++ b/src/Handlers.hs
@@ -0,0 +1,221 @@
+{-
+    hums - The Haskell UPnP Server
+    Copyright (C) 2009 Bardur Arantsson <bardur@scientician.net>
+
+    This program is free software: you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+module Handlers ( rootDescriptionHandler
+                , staticHandler
+                , serviceControlHandler
+                , contentHandler
+                , fallbackHandler
+                ) where
+
+import Soap
+import Configuration
+import Network.HTTP.Base
+import Network.HTTP.Headers
+import Network.StreamSocket()
+import Service
+import Text.Regex
+import Text.Printf
+import Action
+import System.IO (withFile, hFileSize, IOMode(..))
+import MimeType
+import Object
+import HttpExtra
+import System.FilePath
+import Data.Maybe (isJust)
+import Data.IORef
+import HttpMonad
+import Control.Monad.Trans.Class (lift)
+import Data.ByteString.UTF8 (fromString)
+import Control.Monad.IO.Class (MonadIO)
+
+type State = (Configuration, MediaServerConfiguration, ApplicationInformation, [DeviceType], IORef Objects)
+
+{-
+
+   RFC2616 (HTTP/1.1) compliance issues:
+
+     - No conditional range support.
+     - Can only handle single ranges.
+     - Negative range indexes are not supported.
+     - Handling of invalid range specifications is non-compliant.
+
+   It does work well enough for the PS3 though :).
+
+-}
+
+
+hCanonicalizeRanges :: Integer -> [(Maybe Integer, Maybe Integer)] -> [(Integer,Integer)]
+hCanonicalizeRanges fsz ranges =
+  map f ranges
+  where
+    f (lo,hi) = do
+      let lo' = case lo of
+                  Just x -> x
+                  Nothing -> 0
+      let hi' = case hi of
+                  Just x -> x
+                  Nothing -> fsz - 1
+      (lo', hi')
+
+fileSize :: FilePath -> IO Integer
+fileSize fp =
+  withFile fp ReadMode $ \h -> hFileSize h
+
+serveStaticFile :: String -> FilePath -> HttpT IO ()
+serveStaticFile mimeType fp = do
+  logMessage $ printf "Serving file '%s'..." fp
+  -- Do we have a range header?
+  hs <- fmap getHeaders getRequest
+  let ranges =
+          case lookupHeader HdrRange hs of
+            Just value -> parseRangeHeader value
+            Nothing    -> []       -- Whole file
+
+  -- Set up the common headers.
+  addHeader (Header HdrContentType mimeType)
+  addHeader (Header (HdrCustom "Accept-Ranges") "bytes")
+  addHeader (Header HdrConnection "close")
+
+  -- Serve the ranges.
+  fsz <- lift $ fileSize fp
+  let ranges' = hCanonicalizeRanges fsz ranges
+  serveFile fsz ranges'
+  where
+    serveFile fsz [] = do
+        -- Set the headers for full transfer.
+        setResponseCode OK
+        setContentLength $ Just fsz
+        -- Send the file contents.
+        writeFileToBody fp 0 fsz
+    serveFile fsz [(rLow,rHigh)] = do
+        -- Set the headers for partial content.
+        setResponseCode PartialContent
+        setContentLength $ Just (rHigh-rLow+1)
+        addHeader (Header HdrContentRange $ printf "%d-%d/%d" rLow rHigh fsz)
+        -- Send the file contents.
+        writeFileToBody fp rLow $ fromInteger $ rHigh - rLow + 1
+    serveFile _ _ =
+        -- This requires multipart/byteranges, but we don't support that as of yet.
+        sendError NotImplemented
+
+
+-- Regular expressions for avoiding relative URLs. These
+-- are overly conservative, but what the heck...
+dotDotSlash :: Regex
+dotDotSlash = mkRegex "\\.\\./"
+slashDotDot :: Regex
+slashDotDot = mkRegex "/\\.\\."
+
+-- Handler for the root description.
+rootDescriptionHandler :: State -> [String] -> HttpT IO ()
+rootDescriptionHandler (c,mc,ai,s,_) gs = do
+  logMessage "Got request for root description."
+  xml <- lift $ generateDescriptionXml c mc s
+  sendXml xml
+  logMessage "Sent root description."
+
+-- Handle static files.
+staticHandler :: String -> [String] -> HttpT IO ()
+staticHandler root gs = do
+  logMessage $ "Got request for static content: " ++ show gs
+  case gs of
+    [p] -> if isJust (matchRegex dotDotSlash p) ||     -- Reject relative URLs.
+              isJust (matchRegex slashDotDot p) then
+             sendError InternalServerError
+           else
+             serveStaticFile mimeType fp
+           where
+             fp = root </> p
+             mimeType = guessMimeType fp
+    _ ->
+      sendError InternalServerError
+
+-- Handle requests for content.
+contentHandler :: State -> [String] -> HttpT IO ()
+contentHandler (c,mc,ai,s,objects_) gs = do
+  objects <- lift $ readIORef objects_     -- Current snapshot of object tree.
+  case gs of
+    [oid] -> do
+          logMessage $ printf "Got request for CONTENT for objectId=%s" oid
+          -- Serve the file which the object maps to.
+          case findByObjectId oid objects of
+               Just o ->
+                 serveStaticFile mt fp
+                   where
+                     od = getObjectData o
+                     fp = objectFileName od
+                     mt = objectMimeType od
+               Nothing ->
+                 sendError NotFound
+    _ ->
+      sendError InternalServerError
+
+-- Handle requests for device CONTROL urls.
+serviceControlHandler :: State -> DeviceType -> [String] -> HttpT IO ()
+serviceControlHandler (c,mc,ai,s,objects_) deviceType gs = do
+  objects <- lift $ readIORef objects_      -- Current snapshot of object tree.
+  logMessage $ printf "Got request for CONTROL for service '%s'" $ deviceTypeToString deviceType
+  -- Parse the SOAP request
+  requestXml <- fmap rqBody getRequest
+  logMessage $ printf "Request: %s" requestXml
+  action <- lift $ parseControlSoapXml requestXml
+  logMessage $ printf "Action: %s" $ show action
+  -- Deal with the action
+  case action of
+    Just a -> do
+      xml_ <- case a of
+        ContentDirectoryAction_ cda  -> handleCDA deviceType cda objects
+        ConnectionManagerAction_ cma -> handleCMA cma
+      return ()
+    Nothing ->
+      sendError NotImplemented
+  where
+    handleCDA st a objects = do
+      xml <- lift $ generateActionResponseXml c st objects a
+      logMessage $ printf "Response: %s" $ xml
+      sendXml xml
+    handleCMA _ =
+      -- TODO: This should really be implemented as it is required by
+      -- the specification. However, the PS3 doesn't seem to use it at
+      -- all so I don't have any way to test an implementation anyway.
+      sendError NotImplemented
+
+
+-- Last resort handler.
+fallbackHandler :: HttpT IO ()
+fallbackHandler = do
+  r <- getRequest
+  logMessage $ printf "Fallback handler got request: %s" $ show r
+  sendError InternalServerError
+
+-- Send an empty error response.
+sendError :: Monad m => HttpResponseCode -> HttpT m ()
+sendError c = do
+  setResponseCode c
+  setContentLength $ Just 0
+  addHeader (Header HdrConnection "close")
+
+-- Send generated XML.
+sendXml :: (Monad m, MonadIO m, Functor m) => String -> HttpT m ()
+sendXml xml = do
+  setResponseCode OK
+  setContentLength $ Just $ toEnum $ length xml
+  addHeader (Header HdrConnection "close")
+  addHeader (Header HdrContentType "text/xml")
+  writeToBody $ fromString $ xml
diff --git a/src/HttpMonad.hs b/src/HttpMonad.hs
new file mode 100644
--- /dev/null
+++ b/src/HttpMonad.hs
@@ -0,0 +1,139 @@
+module HttpMonad ( HttpT
+                 , runHttp
+                 , HttpResponseCode(..)
+                 , addHeader
+                 , setResponseCode
+                 , setContentLength
+                 , writeToBody
+                 , writeFileToBody
+                 , logMessage
+                 , getRequest
+                 , ifRegex
+                 ) where
+
+import Control.Monad.Trans.Class (MonadTrans(..))
+import Control.Monad.Trans.State.Strict
+import Control.Monad.Trans.Reader
+import Control.Applicative
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad (unless)
+import Network.HTTP.Base (ResponseCode, Response(..), Request(..), urlDecode)
+import Network.HTTP.Headers (Header(..), HeaderName(..))
+import Network.StreamSocket()
+import Network.URI (uriPath)
+import Data.ByteString (ByteString)
+import Data.ByteString.UTF8 (fromString)
+import SendFile (sendFile)
+import Text.Printf (printf)
+import Text.Regex (matchRegex, mkRegex)
+
+-- HTTP response codes.
+data HttpResponseCode = OK
+                      | PartialContent
+                      | NotFound
+                      | InternalServerError
+                      | NotImplemented
+
+-- Convert HTTP response code to a numeric code and string.
+mapStatusCode :: HttpResponseCode -> (ResponseCode, String)
+mapStatusCode OK                  = ((2,0,0), "OK")
+mapStatusCode NotFound            = ((4,0,4), "Not Found")
+mapStatusCode InternalServerError = ((5,0,4), "Internal Server Error")
+mapStatusCode NotImplemented      = ((5,0,1), "Not Implemented")
+mapStatusCode PartialContent      = ((2,0,6), "Partial Content")
+
+-- State of the HTTP writer monad.
+data HttpState =
+  HttpState { hHeaders :: [Header]
+                  , hHeadersFlushed :: Bool
+                  , hStatusCode :: HttpResponseCode
+                  , hOutput :: ByteString -> IO ()
+                  }
+
+type Req = Request String
+
+-- Newtype wrapper for HttpT for implementation hiding.
+newtype HttpT m a = HttpT { unHttp :: ReaderT Req (StateT HttpState m) a }
+                        deriving (Functor, Monad)
+
+-- Instances
+instance MonadTrans HttpT where
+   lift m = HttpT $ (lift . lift) m
+
+-- Run a Http computation.
+runHttp :: (Functor m, Monad m, MonadIO m) => (ByteString -> IO ()) -> Request String -> HttpT m a -> m a
+runHttp output request m = do
+  evalStateT (runReaderT (unHttp m') request) s0
+  where
+    s0 = HttpState [] False OK output
+    m' = do
+      a <- m
+      flushHeaders -- Just in case we haven't written any data.
+      return a
+
+-- Add header to the response.
+addHeader :: Monad m => Header -> HttpT m ()
+addHeader header = HttpT $ do
+  lift $ modify $ \st -> st { hHeaders = header : hHeaders st }
+
+-- Set content length.
+setContentLength :: Monad m => Maybe Integer -> HttpT m ()
+setContentLength (Just n) = addHeader (Header HdrContentLength $ printf "%d" n) -- FIXME: Replace!
+setContentLength Nothing  = return () -- FIXME: Remove!
+
+
+-- Flush all the headers.
+flushHeaders :: (Functor m, Monad m, MonadIO m) => HttpT m ()
+flushHeaders = HttpT $ lift $ do
+  -- Ignore if already flushed.
+  alreadyFlushed <- hHeadersFlushed <$> get
+  unless alreadyFlushed $ do
+    -- Generate the headers.
+    output <- hOutput <$> get
+    headers <- hHeaders <$> get
+    (code,reason) <- fmap mapStatusCode $ hStatusCode <$> get
+    let sResponse = show $ Response { rspCode = code
+                                    , rspReason = reason
+                                    , rspHeaders = headers
+                                    , rspBody = "" }
+    -- Output the headers.
+    lift $ liftIO $ output $ fromString sResponse
+    -- We've flushed the headers.
+    modify (\s -> s { hHeadersFlushed = True })
+
+-- Set the response code.
+setResponseCode :: Monad m => HttpResponseCode -> HttpT m ()
+setResponseCode c = HttpT $ lift $ do
+  modify $ \st -> st { hStatusCode = c }
+
+-- Write to body.
+writeToBody :: (Functor m, MonadIO m, Monad m) => ByteString -> HttpT m ()
+writeToBody buf = HttpT $ do
+  output <- lift $ hOutput <$> get
+  unHttp $ flushHeaders
+  lift $ liftIO $ output buf
+
+-- Write the contents of a file to body.
+writeFileToBody :: (Functor m, MonadIO m, Monad m) => FilePath -> Integer -> Integer -> HttpT m ()
+writeFileToBody buf offset count = HttpT $ do
+  output <- lift $ hOutput <$> get
+  unHttp $ flushHeaders
+  lift $ liftIO $ sendFile output buf offset count
+
+-- Logging.
+logMessage :: (Monad m, MonadIO m) => String -> HttpT m ()
+logMessage s = HttpT $ liftIO $ putStrLn s
+
+-- Get request.
+getRequest :: (Functor m, Monad m) => HttpT m (Request String)
+getRequest = HttpT $ ask
+
+-- Match request prefix.
+ifRegex :: (Functor m, Monad m) => String -> ([String] -> HttpT m ()) -> HttpT m () -> HttpT m ()
+ifRegex r ifMatch ifNoMatch = do
+  request <- getRequest
+  case matchRegex re $ urlDecode $ uriPath $ rqURI request of
+    Just gs -> ifMatch gs
+    Nothing -> ifNoMatch
+  where
+    re = mkRegex r
diff --git a/src/HttpServer.hs b/src/HttpServer.hs
--- a/src/HttpServer.hs
+++ b/src/HttpServer.hs
@@ -17,18 +17,9 @@
 -}
 
 module HttpServer ( runHttpServer
-                  , UrlHandler
-                  , sendHeaders
-                  , sendErrorResponse
-                  , sendOkHeaders
-                  , sendBody
-                  , sendXmlResponse
-                  , sendPartialContentHeaders
-                  , HttpError(..)
                   ) where
 
 import Network.HTTP.Base
-import Network.HTTP.Headers
 import Network.HTTP.Stream
 import Network.Socket
 import Network.StreamSocket()
@@ -36,19 +27,13 @@
 import Control.Concurrent
 import Control.Exception
 import Data.Word
-import Text.Regex
-import Text.Printf
-import Network.URI
-import RegexExtra
+import HttpMonad (HttpT, runHttp)
+import Network.Socket.ByteString (sendAll)
 
 -- Request handlers.
-type RequestHandler = 
+type RequestHandler =
     Socket -> Request String -> IO ()
 
--- URL handlers.
-type UrlHandler = 
-    Socket -> Request String -> [String] -> IO ()
-
 runHttpServer' :: RequestHandler -> Word16 -> IO ()
 runHttpServer' r p = do
   let p' = fromIntegral p :: PortNumber
@@ -62,7 +47,7 @@
 acceptConnection :: Socket -> RequestHandler -> IO ()
 acceptConnection listenSocket r = do
   (s,_) <- accept listenSocket
-  _ <- forkIO $ bracket 
+  _ <- forkIO $ bracket
              (return s)
              sClose
              (handleHttpConnection r)
@@ -75,78 +60,8 @@
       Left _ -> error "Error reading request"
       Right req -> r c req
 
-
-sendHeaders :: Socket -> ResponseCode -> String -> [Header] -> IO ()
-sendHeaders conn rCode rReason rHeaders = do
-  let rsp = Response { rspCode = rCode
-                     , rspReason = rReason
-                     , rspHeaders = rHeaders
-                     , rspBody = "" }
-  _ <- writeBlock conn $ show rsp      -- Writes headers only + CRLF.
-  return ()
-
--- Write data to body of request. May be called multiple times after
--- sendHeaders has been called.
-sendBody :: Stream s => s -> String -> IO ()
-sendBody conn body = do
-    _ <- writeBlock conn body
-    return ()
-
-
-
-myRequestHandler :: [(Regex, UrlHandler)] -> Socket -> Request String -> IO ()
-myRequestHandler hs s r =
-  case dispatch hs (urlDecode $ uriPath $ rqURI r) of
-    Nothing -> sendErrorResponse  s InternalServerError []
-    Just (h,gs) -> h s r gs
-
-
-runHttpServer :: [(Regex, UrlHandler)] -> Word16 -> IO ()
-runHttpServer = runHttpServer' . myRequestHandler
-
-{-
-
-   Response generator functions.
-
--}
-
-sendOkHeaders :: Socket -> [Header] -> Integer -> IO ()
-sendOkHeaders conn hs contentLength =
-    let h1 = Header HdrContentLength $ printf "%d" contentLength in
-    let h2 = Header HdrConnection "close" in
-    sendHeaders conn (2,0,0) "OK" (h1 : h2 : hs)
-
-sendPartialContentHeaders :: Socket -> [Header] -> (Integer,Integer) -> Integer -> IO ()
-sendPartialContentHeaders conn hs (rLow,rHigh) entitySize =
-    let h1 = Header HdrContentLength $ printf "%d" (rHigh-rLow+1) in
-    let h2 = Header HdrContentRange $ printf "%d-%d/%d" rLow rHigh entitySize in
-    let h3 = Header HdrConnection "close" in
-    sendHeaders conn (2,0,6) "Partial Content" (h1 : h2 : h3 : hs)
- 
-
-
-sendXmlResponse :: Socket -> [Header] -> String -> IO ()
-sendXmlResponse conn hs xml = do
-     sendOkHeaders conn ( Header HdrContentType "text/xml" : hs ) $ toEnum $ length xml
-     sendBody conn xml
-
-
-
-
-
-data HttpError = NotFound
-               | InternalServerError
-               | NotImplemented
-           
-
-sendErrorResponse :: Socket -> HttpError -> [Header] -> IO ()
-sendErrorResponse conn e hs =
-  sendHeaders conn c r
-                  ([ Header HdrContentLength "0"
-                   , Header HdrConnection "close"
-                   ] ++ hs)
+runHttpServer :: HttpT IO () -> Word16 -> IO ()
+runHttpServer handler = runHttpServer' myRequestHandler
   where
-    (c,r) = case e of
-              NotFound -> ((4,0,4),"NOT FOUND") 
-              InternalServerError -> ((5,0,4), "INTERNAL SERVER ERROR")
-              NotImplemented -> ((5,0,1), "NOT IMPLEMENTED")
+    myRequestHandler :: Socket -> Request String -> IO ()
+    myRequestHandler s r = runHttp (sendAll s) r $ handler
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -16,36 +16,28 @@
     along with this program.  If not, see <http://www.gnu.org/licenses/>.
 -}
 
-import Soap
 import Network.Utils
 import SimpleServiceDiscoveryProtocol
-import Configuration 
-import Network.HTTP.Base
-import Network.HTTP.Headers
+import Configuration
 import Network.StreamSocket()
 import Control.Concurrent
 import HttpServer
 import Service
-import Text.Regex
 import Text.Printf
-import Action
-import System.IO (withFile, hFileSize, IOMode(..))
 import qualified Data.UUID as U
 import qualified Data.UUID.V1 as U1
-import MimeType
 import Object
-import HttpExtra
 import Control.Monad.Error
 import System.FilePath
-import Data.Maybe (fromJust, isJust)
+import Data.Maybe (fromJust)
 import Data.ConfigFile
 import Paths_hums
 import Data.IORef
-import Network.Socket (Socket)
-import SendFile (sendFile')
+import Handlers
+import HttpMonad (ifRegex)
 
 defaultMediaServerConfiguration :: String -> MediaServerConfiguration
-defaultMediaServerConfiguration uuid_ = 
+defaultMediaServerConfiguration uuid_ =
     MediaServerConfiguration { uuid = uuid_
                              , friendlyName = "hums"
                              , manufacturer = "Bardur Arantsson"
@@ -58,189 +50,6 @@
                              , upc = Nothing
                              }
 
-type State = (Configuration, MediaServerConfiguration, ApplicationInformation, [DeviceType], IORef Objects)
-
-
-rootDescriptionHandler :: State -> Socket -> Request String -> [String] -> IO ()
-rootDescriptionHandler (c,mc,ai,s,_) conn r gs = do
-  putStrLn "Got request for root description."
-  xml <- generateDescriptionXml c mc s
-  putStrLn "Generated root description."
-  sendXmlResponse conn (getExtraHeaders ai) xml
-  putStrLn "Send root description."
-
-hCopyBytes :: FilePath -> Socket -> Integer -> Integer -> IO ()
-hCopyBytes src dst ofs len = do
-  putStrLn $ printf "Sending %d bytes..." len
-  sendFile' dst src ofs len
-
--- Copy a set of ranges between two handles.
-hCopyRanges :: FilePath -> Socket -> [(Integer,Integer)] -> IO ()
-hCopyRanges src conn ranges =
-  mapM_ copyRange ranges
-  where
-    copyRange (lo, hi) = hCopyBytes src conn lo $ fromInteger $ hi - lo + 1
-
-{-
-
-   RFC2616 (HTTP/1.1) compliance issues:
-
-     - No conditional range support.
-     - Can only handle single ranges.
-     - Negative range indexes are not supported.
-     - Handling of invalid range specifications is non-compliant.
-
-   It does work well enough for the PS3 though :).
-
--}
-
-
-hCanonicalizeRanges :: Integer -> [(Maybe Integer, Maybe Integer)] -> [(Integer,Integer)]
-hCanonicalizeRanges fsz ranges =
-  map f ranges
-  where 
-    f (lo,hi) = do
-      let lo' = case lo of 
-                  Just x -> x
-                  Nothing -> 0
-      let hi' = case hi of
-                  Just x -> x
-                  Nothing -> fsz - 1
-      (lo', hi')
-
-fileSize :: FilePath -> IO Integer
-fileSize fp = 
-  withFile fp ReadMode $ \h -> hFileSize h
-
-serveStaticFile :: Socket -> [Header] -> String -> FilePath -> IO ()
-serveStaticFile conn hs mimeType fp = do
-  putStrLn $ printf "Serving file '%s'..." fp
-
-  -- Do we have a range header?
-  let ranges = 
-          case lookupHeader HdrRange hs of
-            Just value -> parseRangeHeader value
-            Nothing    -> []       -- Whole file
-
-  -- Serve the ranges.
-  fsz <- fileSize fp
-  let ranges' = hCanonicalizeRanges fsz ranges
-  serveFile fsz ranges'
-  where 
-    ohs = [ Header HdrContentType mimeType ]
-    serveFile :: Integer -> [(Integer,Integer)] -> IO ()
-    serveFile fsz [] = do
-        -- No range given (or all ranges were invalid), so we handle regularly.
-        sendOkHeaders conn ohs fsz
-        hCopyBytes fp conn 0 fsz
-    serveFile fsz [r] = do
-        -- Send headers
-        sendPartialContentHeaders conn ohs r fsz
-        -- Copy data from ranges into body.
-        hCopyRanges fp conn [r]
-    serveFile _ _ =
-        -- This requires multipart/byteranges, but we don't support that
-        -- as of yet.
-        error "Cannot handle multiple ranges in a single request."
-
-
--- Regular expressions for avoiding relative URLs. These
--- are overly conservative, but what the heck...
-dotDotSlash :: Regex
-dotDotSlash = mkRegex "\\.\\./"
-slashDotDot :: Regex
-slashDotDot = mkRegex "/\\.\\." 
-
--- Handle static files.
-staticHandler :: String -> Socket -> Request String -> [String] -> IO ()
-staticHandler root conn req gs = do
-    putStrLn $ "Got request for static content: " ++ show gs
-    case gs of
-      [p] -> if isJust (matchRegex dotDotSlash p) ||     -- Reject relative URLs.
-                isJust (matchRegex slashDotDot p) then
-                 sendErrorResponse conn InternalServerError []
-               else
-                   serveStaticFile conn (getHeaders req) mimeType fp
-             where 
-               fp = root </> p
-               mimeType = guessMimeType fp
-      _ -> sendErrorResponse conn InternalServerError []
-    
-
-
--- TODO: Should we generate a DATE header?
-getExtraHeaders :: ApplicationInformation -> [ Header ]
-getExtraHeaders ai = [ Header (HdrCustom "contentFeatures.dlna.org") ""
-                     , Header (HdrCustom "EXT") ""
-                     , Header (HdrCustom "Server") (getServerHeaderValue ai)
-                     , Header (HdrCustom "Accept-Ranges") "bytes"
-                     ]
-
-contentHandler :: State -> Socket -> Request String -> [String] -> IO ()
-contentHandler (c,mc,ai,s,objects_) conn r gs = do
-  objects <- readIORef objects_     -- Current snapshot of object tree.
-  case gs of
-    [oid] -> do
-            putStrLn $ printf "Got request for CONTENT for objectId=%s" oid
-            -- Serve the file which the object maps to.
-            -- FIXME: Return 404 error code if file has disappeared.
-            case findByObjectId oid objects of
-                 Just o -> serveStaticFile conn (getHeaders r) mt fp
-                           where 
-                             od = getObjectData o
-                             fp = objectFileName od
-                             mt = objectMimeType od
-                 Nothing -> sendErrorResponse conn NotFound []
-
-    _ -> sendErrorResponse conn InternalServerError []
-
-
-
-serviceControlHandler :: State -> Socket -> Request String -> [String] -> IO ()
-serviceControlHandler (c,mc,ai,s,objects_) conn r gs = do
-  objects <- readIORef objects_      -- Current snapshot of object tree.
-  case gs of
-    [sn] -> do
-            putStrLn $ printf "Got request for CONTROL for service '%s'" sn
-            case stringToDeviceType sn of
-              Just dt -> do
-                -- Parse the SOAP request
-                let requestXml = rqBody r
-                action <- parseControlSoapXml requestXml
-                -- Deal with the action
-                case action of
-                  Just a -> do
-                    x <- case a of
-                           ContentDirectoryAction_ cda -> handleCDA dt cda objects
-                           ConnectionManagerAction_ cma -> handleCMA cma
-                    putStrLn $ printf "Response:\n\n%s\n\n" x
-                    sendXmlResponse conn (getExtraHeaders ai) x
-                  Nothing -> 
-                      sendErrorResponse conn NotImplemented []
-              Nothing -> do
-                  putStrLn $ printf "Asked about unknown service '%s'" sn
-                  sendErrorResponse conn NotImplemented []
-    _ ->
-      -- Mapped to our URL space, but not parseable? 
-      sendErrorResponse conn NotFound []
-  where
-    handleCDA st a objects =
-        generateActionResponseXml c st objects a
-    handleCMA _ =
-      -- TODO: This should really be implemented as it is required by
-      -- the specification. However, the PS3 doesn't seem to use it at
-      -- all so I don't have any way to test an implementation anyway.
-      error "Not implemented"
-
-
-
-fallbackHandler :: Socket -> Request String -> [String] -> IO ()
-fallbackHandler conn r gs = do
-    putStrLn "Fallback handler got request:"
-    print r
-    sendErrorResponse conn InternalServerError []
-
-
 periodicUpdate :: IORef a -> (IO a) -> IO ()
 periodicUpdate a doUpdate =
   forever $ do
@@ -248,14 +57,12 @@
     writeIORef a =<< doUpdate  -- Atomic replace
 
 scanOnce :: String -> IO Objects
-scanOnce directory = do 
+scanOnce directory = do
     putStrLn $ printf "Scanning directory '%s'" directory
     objects <- scanDirectory directory
     putStrLn $ printf "Scanning completed"
     return objects
 
-
-
 main :: IO ()
 main = niceSocketsDo $ do
       -- Get the data directory.
@@ -269,7 +76,7 @@
       let scanOnce' = scanOnce $ rootDirectory c
       defaultObjects_ <- scanOnce'
       defaultObjects <- newIORef defaultObjects_
-     
+
       -- Get the application information.
       appInfo <- getApplicationInformation
 
@@ -280,19 +87,19 @@
       let services = [ ContentDirectoryDevice, ConnectionManagerDevice ]
       let st = (c,mc,appInfo,services, defaultObjects)
 
-      let dispatchTable = 
-              [ (mkRegex "^/description\\.xml$", rootDescriptionHandler st)
-              , (mkRegex "^/static/(.*)$", staticHandler $ dataDirectory </> "www")
-              , (mkRegex "^/dynamic/services/([^/]+)/control/?$", serviceControlHandler st)
-              , (mkRegex "^/content/([0-9a-f,]+)$", contentHandler st)
-              , (mkRegex "(.*)", fallbackHandler)
-              ]
+      let handlers =
+            ifRegex "^/description\\.xml$" (rootDescriptionHandler st) $
+            ifRegex "^/static/(.*)$" (staticHandler $ dataDirectory </> "www") $
+            ifRegex "^/dynamic/services/ContentDirectory/control/?$" (serviceControlHandler st ContentDirectoryDevice) $
+            ifRegex "^/dynamic/services/ConnectionManager/control/?$" (serviceControlHandler st ConnectionManagerDevice) $
+            ifRegex "^/content/([0-9a-f,]+)$" (contentHandler st) $
+            fallbackHandler
 
       -- Start serving.
       putStrLn "Establishing HTTP server..."
-      _ <- forkIO $ runHttpServer dispatchTable $ httpServerPort c
+      _ <- forkIO $ runHttpServer handlers $ httpServerPort c
       _ <- putStrLn "Done."
-      
+
       -- Start broadcasting alive messages.
       putStrLn "Establishing notification broadcaster..."
       _ <- forkIO $ sendNotifyForever appInfo c mc
diff --git a/src/Object.hs b/src/Object.hs
--- a/src/Object.hs
+++ b/src/Object.hs
@@ -33,6 +33,7 @@
 import Action
 import Data.Map (Map)
 import qualified Data.Map as Map
+import Data.List (isPrefixOf)
 import DirectoryUtils
 import System.FilePath
 import MimeType
@@ -40,8 +41,6 @@
 import System.Posix
 import Text.Printf
 import StorableExtra
-import Text.Regex
-import RegexExtra
 
 -- Root object id is defined by CD/§2.7.4.2.
 rootObjectId :: ObjectId
@@ -52,11 +51,11 @@
 rootObjectParentId = "-1"
 
 -- Dispatch table for selecting item type from MIME type.
-objectTypeTable :: [(Regex, ObjectType)]
-objectTypeTable = [ (mkRegex "^video/.*", ItemVideoMovie)
-                  , (mkRegex "^audio/.*", ItemMusicTrack)
-                  , (mkRegex "^inode/directory$", ContainerStorageFolder)
-                  ]
+mimeTypeToObjectType :: String -> Maybe ObjectType
+mimeTypeToObjectType s | ("video/" `isPrefixOf` s) = Just ItemVideoMovie
+mimeTypeToObjectType s | ("audio/" `isPrefixOf` s) = Just ItemMusicTrack
+mimeTypeToObjectType s | ("inode/directory"  == s) = Just ContainerStorageFolder
+mimeTypeToObjectType _ = Nothing
 
 -- An Objects is an abstract data type containing a set of
 -- objects.
@@ -156,9 +155,9 @@
   -- Construct object data.
   let objectData = MkObjectData kp _title fp sz lastModified mimeType
   -- Add the directory entry to the current accumulator.
-  return $ case dispatch objectTypeTable mimeType of
-             Just (objectType,_) -> (oid, (objectType,objectData)) : objects
-             Nothing -> objects
+  return $ case mimeTypeToObjectType mimeType of
+    Just objectType -> (oid, (objectType,objectData)) : objects
+    Nothing -> objects
   where
     round' :: Rational -> Int64          -- Dummy to avoid warning
     round' = round
diff --git a/src/RegexExtra.hs b/src/RegexExtra.hs
deleted file mode 100644
--- a/src/RegexExtra.hs
+++ /dev/null
@@ -1,39 +0,0 @@
-{-
-    hums - The Haskell UPnP Server
-    Copyright (C) 2009 Bardur Arantsson <bardur@scientician.net>
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
--}
-
-module RegexExtra ( dispatch )
-    where
-
-import Text.Regex
-
-dispatch :: [(Regex, a)] -> String -> Maybe (a, [String])
-dispatch t s = 
-    case findFirst f t of
-      Nothing -> Nothing
-      Just (v,gs) -> Just (v, gs)
-    where
-      f (r,v) = case matchRegex r s of
-                  Just gs -> Just (v,gs)
-                  Nothing -> Nothing
-                
-findFirst :: (a -> Maybe b) -> [a] -> Maybe b
-findFirst _ [] = Nothing
-findFirst f (x:xs) =
-    case f x of
-      Just v -> Just v
-      Nothing -> findFirst f xs
diff --git a/src/SendFile.hs b/src/SendFile.hs
--- a/src/SendFile.hs
+++ b/src/SendFile.hs
@@ -16,19 +16,16 @@
     along with this program.  If not, see <http://www.gnu.org/licenses/>.
 -}
 
---
--- This exists because Network.Socket.SendFile isn't usable on Linux as of 0.4.
---
-module SendFile ( sendFile' 
+module SendFile ( sendFile
                 ) where
 
-import Data.ByteString as BS (hGet, length)
-import Network.Socket.ByteString (sendAll)
-import Network.Socket (Socket)
+import Data.ByteString (hGet, ByteString)
+import qualified Data.ByteString as BS
 import System.IO (hSeek, withFile, IOMode(..), SeekMode(..))
 
-sendFile' :: Socket -> FilePath -> Integer -> Integer -> IO ()
-sendFile' outs inp off count = do
+-- Send contents of a file.
+sendFile :: (ByteString -> IO ()) -> FilePath -> Integer -> Integer -> IO ()
+sendFile output inp off count = do
   withFile inp ReadMode (\h -> do
     hSeek h AbsoluteSeek off
     rsend h count)
@@ -36,5 +33,5 @@
           rsend h reqBytes = do
               let bytes = min 32768 reqBytes :: Integer
               buf <- hGet h (fromIntegral bytes)
-              sendAll outs buf
+              output buf
               rsend h (reqBytes - (fromIntegral $ BS.length buf))
diff --git a/src/Service.hs b/src/Service.hs
--- a/src/Service.hs
+++ b/src/Service.hs
@@ -19,10 +19,10 @@
 module Service ( generateDescriptionXml
                , generateActionResponseXml
                , DeviceType(..)
-               , stringToDeviceType
+               , deviceTypeToString
                ) where
-    
-import Text.XML.HXT.Arrow
+
+import Text.XML.HXT.Core
 import Text.Printf
 import Configuration
 import Action
@@ -34,9 +34,6 @@
 import MimeType
 import URIExtra
 
-defaultEncodingAttributes :: Attributes
-defaultEncodingAttributes = [ (a_output_encoding, utf8) ]
-
 myQuote :: String -> String
 myQuote =        -- TODO: There *must* be a better way to achieve our quoting needs.
     concatMap f
@@ -48,7 +45,7 @@
 
 
 sanitizeXmlChars :: String -> String
-sanitizeXmlChars = 
+sanitizeXmlChars =
     map f
     where
       f '<' = '_'
@@ -65,21 +62,16 @@
 data DeviceType = MediaServer
                 | ContentDirectoryDevice
                 | ConnectionManagerDevice
-                  
+
 deviceTypeToString :: DeviceType -> String
 deviceTypeToString ContentDirectoryDevice = "ContentDirectory"
 deviceTypeToString ConnectionManagerDevice = "ConnectionManager"
 deviceTypeToString MediaServer = "MediaServer"
 
-stringToDeviceType :: String -> Maybe DeviceType
-stringToDeviceType "ContentDirectory" = Just ContentDirectoryDevice
-stringToDeviceType "ConnectionManager" = Just ConnectionManagerDevice
-stringToDeviceType _ = Nothing
-
 serviceNs :: ArrowXml a => String -> DeviceType -> a XmlTree XmlTree
-serviceNs prefix st = 
+serviceNs prefix st =
     sattr an av
-    where 
+    where
       an = printf "xmlns:%s" prefix
       av = printf "urn:schemas-upnp-org:service:%s:1" $ deviceTypeToString st
 
@@ -89,11 +81,11 @@
 -- Generate the icon list.
 generateIconList :: ArrowXml a => Bool -> a XmlTree XmlTree
 generateIconList False = cmt " omitted device icon list "
-generateIconList True = 
-    selem "iconList" 
+generateIconList True =
+    selem "iconList"
               [ selem "icon"
                 [ selem "mimetype" [ txt $ guessMimeType imageUrl ]
-                , selem "width"    [ txt "240" ] 
+                , selem "width"    [ txt "240" ]
                 , selem "height"   [ txt "240" ]
                 , selem "url"      [ txt imageUrl ]
                 ]
@@ -102,21 +94,21 @@
       imageUrl = "/static/images/hums.jpg"
 
 generateServiceList :: ArrowXml a => [DeviceType] -> a XmlTree XmlTree
-generateServiceList services = 
+generateServiceList services =
     selem "serviceList" $ map generateService services
     where
       generateService service =
-          selem "service" 
+          selem "service"
                     [ selem "serviceType" [txt $ serviceNs' service]
                     , selem "serviceId" [txt $ printf "urn:upnp-org:serviceId:%s" dt]
                     , selem "SCPDURL" [txt $ printf "/static/services/%s/description.xml" dt]
                     , selem "controlURL" [txt $ printf "/dynamic/services/%s/control/" dt]
-	            , selem "eventSubURL" [txt $ printf "/dynamic/services/%s/event/" dt]
+                    , selem "eventSubURL" [txt $ printf "/dynamic/services/%s/event/" dt]
                     ]
           where dt = deviceTypeToString service
 
 generateDescription :: ArrowXml a => Configuration -> MediaServerConfiguration -> [DeviceType] -> a XmlTree XmlTree
-generateDescription c mc services = 
+generateDescription c mc services =
     root []
      [ mkelem "root" [sattr "xmlns" "urn:schemas-upnp-org:device-1-0"]
        [ selem "specVersion"
@@ -149,9 +141,9 @@
       presentationUrl = "index.html"
 
 -- Transform an XmlTree to a string.
-generateXml :: Attributes -> IOSLA (XIOState ()) XmlTree XmlTree -> IO String
-generateXml as a = do
-  xml <- runX (a >>> writeDocumentToString (addEntries as defaultEncodingAttributes))
+generateXml :: SysConfigList -> IOSLA (XIOState ()) XmlTree XmlTree -> IO String
+generateXml conf a = do
+  xml <- runX (a >>> writeDocumentToString (withOutputEncoding utf8 : conf))
   return $ concat xml
 
 generateDescriptionXml :: Configuration -> MediaServerConfiguration -> [DeviceType] -> IO String
@@ -161,7 +153,7 @@
 
 generateResponseXml :: [IOSLA (XIOState ()) XmlTree XmlTree] -> IO String
 generateResponseXml =
-  generateXml [(a_output_xml,v_0)] . generateSoapEnvelope
+  generateXml [ withOutputPLAIN ] . generateSoapEnvelope
 
 generateBrowseResponseXml :: Configuration -> DeviceType -> Objects -> BrowseAction -> IO String
 
@@ -175,7 +167,7 @@
                ]
              ]
   generateResponseXml body
-  where 
+  where
     didl = mkDidl [generateObjectElement cfg os (oid,o)]
     oid = objectId bps
     o = findExistingByObjectId oid os -- TODO: Might handle non-existing objects better.
@@ -191,7 +183,7 @@
                ]
              ]
   generateResponseXml body
-  where 
+  where
     oid = objectId bps
     si = startingIndex bps
     rc = requestedCount bps
@@ -216,20 +208,20 @@
 
 generateActionResponseXml _ st _ ContentDirectoryGetSearchCapabilities =
   generateXml [] $ generateSoapEnvelope body
-  where 
+  where
     body = [ mkelem "u:GetSearchCapabilitiesResponse" [ serviceNs "u" st ]
              [ selem "SearchCaps" [ txt "" ] ]   -- No search capabilities (CD/§2.5.18)
            ]
 
 generateActionResponseXml _ st _ ContentDirectoryGetSortCapabilities =
   generateXml [] $ generateSoapEnvelope body
-  where 
+  where
     body = [ mkelem "u:GetSortCapabilitiesResponse" [ serviceNs "u" st ]
              [ selem "SortCaps" [ txt "" ] ]   -- No sorting capabilities (CD/§2.5.19)
            ]
 
 generateSoapEnvelope :: ArrowXml a => [a XmlTree XmlTree] -> a XmlTree XmlTree
-generateSoapEnvelope b = 
+generateSoapEnvelope b =
     root []
       [ mkelem "s:Envelope" [ soapNs, soapEncodingStyle ]
         [ selem "s:Body" b ]
@@ -241,7 +233,7 @@
 
 
 generateObjectElement :: ArrowXml a => Configuration -> Objects -> (ObjectId, Object) -> a XmlTree XmlTree
-generateObjectElement cfg objects (oid, o) = 
+generateObjectElement cfg objects (oid, o) =
     mkelem en (as ++ eas)
      ([ selem "dc:title" [ txt $ sanitizeXmlChars $ objectTitle od ]
       , selem "upnp:class" [ txt $ getObjectClassName o ]
@@ -250,7 +242,7 @@
       od = getObjectData o
       en = getObjectElementName o
       ee = generateExtraElements cfg (oid,o)
-      as = [ sattr "id" oid 
+      as = [ sattr "id" oid
            , sattr "parentID" $ objectParentId od
            ]
       eas = generateExtraAttributes objects (oid,o)
@@ -266,14 +258,14 @@
 
 -- Generate content URL
 generateContentUrl :: ArrowXml a => Configuration -> ObjectId -> a XmlTree XmlTree
-generateContentUrl cfg oid = 
+generateContentUrl cfg oid =
     txt $ show $ mkURI ["content", oid] $ httpServerBase cfg
 
 -- Generate any extra elements for any given object.
 generateExtraElements :: ArrowXml a => Configuration -> (ObjectId, Object) -> [a XmlTree XmlTree]
 generateExtraElements _ (oid, (Container,_)) = []
 generateExtraElements _ (oid, (ContainerStorageFolder,_)) = []
-generateExtraElements cfg (oid, (ItemMusicTrack,d)) = 
+generateExtraElements cfg (oid, (ItemMusicTrack,d)) =
     [ mkelem "res" [ sattr "protocolInfo" protocolInfo
                    , sattr "size" $ printf "%d" $ objectFileSize d ] -- TODO: should be disabled by Transcoding flag!
       [ generateContentUrl cfg oid ]
@@ -283,7 +275,7 @@
       protocolInfo = generateProtocolInfo cfg False mimeType Nothing  -- TODO: profileId
 
 generateExtraElements cfg (oid, (ItemVideoMovie,d)) =
-    [ mkelem "res" [ sattr "protocolInfo" protocolInfo 
+    [ mkelem "res" [ sattr "protocolInfo" protocolInfo
                    , sattr "size" $ printf "%d" $ objectFileSize d ] -- TODO: should be disabled by Transcoding flag!
       [ generateContentUrl cfg oid ]
     ]
@@ -298,7 +290,7 @@
 generateProtocolInfo :: Configuration -> Bool -> String -> Maybe String -> String
 generateProtocolInfo cfg transcode mimeType profileId =
     protocolPrefix ++ protocolSuffix
-    where 
+    where
       playSpeed = 1 :: Int           -- DLNA play speed: Normal
       conversionFlags =              -- DLNA conversion flags
           if transcode then 1 else 0 :: Int
@@ -318,10 +310,10 @@
                 , ("DLNA.ORG_PN", dlnaProfileName cfg)
                 , ("DLNA.ORG_FLAGS" , Just $ printf "%08x%024x" flags (0 :: Int32) ) ]
       protocolPrefix = "http-get:*:" ++ mimeType ++ ":"
-      protocolSuffix = 
+      protocolSuffix =
           if useDlna cfg then
               join ";" $ mapMaybe (\(n,v) -> mapMaybe1 (printf "%s=%s" n) v) fields
-          else 
+          else
               "*"
       -- Protocol constants.
       _DLNA_ORG_FLAG_SENDER_PACED              = bit 31 :: Int32
diff --git a/src/Soap.hs b/src/Soap.hs
--- a/src/Soap.hs
+++ b/src/Soap.hs
@@ -19,17 +19,9 @@
 module Soap ( parseControlSoapXml
             ) where
 
-import Text.XML.HXT.Arrow
+import Text.XML.HXT.Core
 import Action
 
--- ContentDirectory XML name space
-nsContentDirectory :: String
-nsContentDirectory = "urn:schemas-upnp-org:service:ContentDirectory:1"
-
--- ConnectionManager XML name space
-nsConnectionManager :: String
-nsConnectionManager = "urn:schemas-upnp-org:service:ConnectionManager:1"
-
 -- Utility functions for parsing XML.
 atTag :: ArrowXml a => String -> a XmlTree XmlTree
 atTag tag = deep (isElem >>> hasLocalPart tag)
@@ -42,7 +34,7 @@
 textAtTag tag = atTag tag >>> text
 
 numberAtTag :: (ArrowXml a, Num b, Read b) => String -> a XmlTree b
-numberAtTag tag = 
+numberAtTag tag =
     atTag tag >>> text >>> arr read
 
 -- Parse the "Browse Flag". CD/§2.5.6
@@ -61,9 +53,9 @@
 -}
 parseCDBrowse :: ArrowXml a => a XmlTree ContentDirectoryAction
 parseCDBrowse =
-    atTag "Browse" >>> hasNamespaceUri nsContentDirectory >>>
+    atTag "Browse" >>>
           proc l -> do
-            oid        <- textAtTag "ObjectID"  
+            oid        <- textAtTag "ObjectID"
                  `orElse` textAtTag "ContainerID" {- XBox-360 -}  -< l
             bf         <- parseBrowseFlag                           -< l
             flt        <- textAtTag "Filter"                        -< l
@@ -72,24 +64,24 @@
             sc         <- textAtTag "SortCriteria"                  -< l
             returnA    -< let bps = BrowseParameters oid flt si rq sc in
                             ContentDirectoryBrowse $ bf bps
-      
+
 parseCDSearchCapabilities :: ArrowXml a => a XmlTree ContentDirectoryAction
 parseCDSearchCapabilities =
-    atTag "GetSearchCapabilities" >>> hasNamespaceUri nsContentDirectory >>>
+    atTag "GetSearchCapabilities" >>>
           proc _ -> returnA -< ContentDirectoryGetSearchCapabilities
 
 parseCDGetSortCapabilities :: ArrowXml a => a XmlTree ContentDirectoryAction
 parseCDGetSortCapabilities =
-    atTag "GetSortCapabilities" >>> hasNamespaceUri nsContentDirectory >>>
+    atTag "GetSortCapabilities" >>>
           proc _ -> returnA -< ContentDirectoryGetSortCapabilities
 
 parseCDGetSystemUpdateId :: ArrowXml a => a XmlTree ContentDirectoryAction
 parseCDGetSystemUpdateId =
-    atTag "GetSystemUpdateID" >>> hasNamespaceUri nsContentDirectory >>>
+    atTag "GetSystemUpdateID" >>>
           proc _ -> returnA -< ContentDirectoryGetSystemUpdateId
 
 parseContentDirectoryQueryXml :: ArrowXml a => a XmlTree Action
-parseContentDirectoryQueryXml = 
+parseContentDirectoryQueryXml =
     proc l -> do
       x <- helper    -< l
       returnA -< ContentDirectoryAction_ x
@@ -104,28 +96,28 @@
 
 -}
 parseCMGetProtocolInfo :: ArrowXml a => a XmlTree ConnectionManagerAction
-parseCMGetProtocolInfo = 
-    atTag "GetProtocolInfo" >>> hasNamespaceUri nsConnectionManager >>>
+parseCMGetProtocolInfo =
+    atTag "GetProtocolInfo" >>>
           proc _ -> returnA -< ConnectionManagerGetProtocolInfo
 
 parseCMPrepareForConnection :: ArrowXml a => a XmlTree ConnectionManagerAction
-parseCMPrepareForConnection = 
-    atTag "PrepareForConnection" >>> hasNamespaceUri nsConnectionManager >>>
+parseCMPrepareForConnection =
+    atTag "PrepareForConnection" >>>
           proc _ -> returnA -< ConnectionManagerPrepareForConnection
 
 parseCMConnectionComplete :: ArrowXml a => a XmlTree ConnectionManagerAction
-parseCMConnectionComplete = 
-    atTag "ConnectionComplete" >>> hasNamespaceUri nsConnectionManager >>>
+parseCMConnectionComplete =
+    atTag "ConnectionComplete" >>>
           proc _ -> returnA -< ConnectionManagerConnectionComplete
 
 parseCMGetCurrentConnectionIDs :: ArrowXml a => a XmlTree ConnectionManagerAction
-parseCMGetCurrentConnectionIDs = 
-    atTag "GetCurrentConnectionIDs" >>> hasNamespaceUri nsConnectionManager >>>
+parseCMGetCurrentConnectionIDs =
+    atTag "GetCurrentConnectionIDs" >>>
           proc _ -> returnA -< ConnectionManagerGetCurrentConnectionIDs
 
 parseCMGetCurrentConnectionInfo :: ArrowXml a => a XmlTree ConnectionManagerAction
-parseCMGetCurrentConnectionInfo = 
-    atTag "GetCurrentConnectionInfo" >>> hasNamespaceUri nsConnectionManager >>>
+parseCMGetCurrentConnectionInfo =
+    atTag "GetCurrentConnectionInfo" >>>
           proc _ -> returnA -< ConnectionManagerGetCurrentConnectionInfo
 
 parseConnectionManagerQueryXml :: ArrowXml a => a XmlTree Action
@@ -140,7 +132,7 @@
                                      `orElse` parseCMGetCurrentConnectionInfo
 
 parseQueryXml :: ArrowXml a => a XmlTree Action
-parseQueryXml = 
+parseQueryXml =
     parseContentDirectoryQueryXml `orElse` parseConnectionManagerQueryXml
 
 {-
@@ -149,15 +141,15 @@
 
 -}
 
-
-
 parseControlSoapXml :: String -> IO (Maybe Action)
 parseControlSoapXml xml = do
-    as <- runX $ readString inAttributes xml >>> parseQueryXml
+    as <- runX $ readString conf xml >>> parseQueryXml
     case as of
       (a:_) -> return $ Just a
       _     -> return $ Nothing
     where
-      inAttributes = [ (a_validate, v_0)
-                     , (a_check_namespaces, v_1) 
-                     ]
+      conf :: SysConfigList
+      conf = [ withValidate no
+             , withCheckNamespaces False
+             , withTrace 3
+             ]