hoovie 0.1 → 0.1.1
raw patch · 18 files changed
+1391/−2 lines, 18 filesbinary-added
Files
- hoovie.cabal +23/−2
- src/Hoovie/Messages.hs +208/−0
- src/Hoovie/Monitor.hs +193/−0
- src/Hoovie/Resource.hs +16/−0
- src/Hoovie/SOAP.hs +97/−0
- src/Hoovie/SSDP.hs +188/−0
- src/Hoovie/Server.hs +72/−0
- src/Hoovie/Stream.hs +54/−0
- src/Hoovie/Transcode.hs +78/−0
- src/Hoovie/Util.hs +13/−0
- static/UPnP_AV_ConnectionManager_1.0.xml +182/−0
- static/UPnP_AV_ContentDirectory_1.0.xml +241/−0
- static/get-protocol-info.xml +6/−0
- static/get-search-capabilities.xml +6/−0
- static/get-sort-capabilities.xml +6/−0
- static/get-system-update-id.xml +8/−0
- static/hoovie.jpg binary
- static/hoovie.png binary
hoovie.cabal view
@@ -1,5 +1,5 @@ Name: hoovie-Version: 0.1+Version: 0.1.1 Synopsis: Haskell Media Server Description: Haskell Media Server Category: Media@@ -13,6 +13,16 @@ Homepage: https://bitbucket.org/pvdbrand/hoovie Bug-Reports: https://bitbucket.org/pvdbrand/hoovie/issues +Extra-Source-Files:+ static/UPnP_AV_ConnectionManager_1.0.xml+ static/UPnP_AV_ContentDirectory_1.0.xml+ static/get-protocol-info.xml+ static/get-sort-capabilities.xml+ static/get-system-update-id.xml+ static/get-search-capabilities.xml+ static/hoovie.png+ static/hoovie.jpg+ Source-Repository head Type: mercurial Location: ssh://hg@bitbucket.org/pvdbrand/hoovie@@ -20,12 +30,23 @@ Source-Repository this Type: mercurial Location: ssh://hg@bitbucket.org/pvdbrand/hoovie- Tag: 0.1+ Tag: 0.1.1 Executable hoovie Hs-Source-Dirs: src Main-is: Main.hs GHC-Options: -threaded -Wall -fwarn-tabs -funbox-strict-fields++ Other-Modules:+ Hoovie.Transcode,+ Hoovie.Util,+ Hoovie.SOAP,+ Hoovie.SSDP,+ Hoovie.Messages,+ Hoovie.Stream,+ Hoovie.Server,+ Hoovie.Monitor,+ Hoovie.Resource Build-Depends: network-multicast,
+ src/Hoovie/Messages.hs view
@@ -0,0 +1,208 @@+module Hoovie.Messages (+ BrowseType(..),+ hoovieXml,+ browseResponse,+ contentDirectoryEvent,+ connectionManagerEvent+ ) where++import Text.XML.Light (QName(..), CData(..), CDataKind(..), Content(..), Element(..), Attr(..), showContent)+import Data.Time.Format (formatTime)+import System.Locale (defaultTimeLocale)+import Text.Printf (printf)+import Data.Time (UTCTime(..), fromGregorian, secondsToDiffTime)+import Data.List (sortBy)+import Data.Ord (comparing)++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC++import Hoovie.Resource++-- some helpers+infixr 9 !+(!) :: String -> String -> QName+"" ! name = QName name Nothing Nothing+ns ! name = QName name Nothing (Just ns)++infixr 8 ~=+(~=) :: QName -> String -> Attr+name ~= value = Attr name value++tag :: QName -> [Attr] -> [Content] -> Content+tag n as cs = Elem $ Element n as cs Nothing++text :: String -> [Content]+text s = [Text (CData CDataText s Nothing)]++xmlHeader :: B.ByteString+xmlHeader = BC.pack "<?xml version=\"1.0\" encoding=\"utf-8\"?>"++asString :: Content -> B.ByteString+asString x = xmlHeader `B.append` (BC.pack $ showContent x)++envelope :: Content -> Content+envelope xs = + tag ("s"!"Envelope") ["xmlns"!"s" ~= "http://schemas.xmlsoap.org/soap/envelope/", "s"!"encodingStyle" ~= "http://schemas.xmlsoap.org/soap/encoding/"] [+ tag ("s"!"Body") [] [xs]+ ]++-- actual messages+hoovieXml :: String -> String -> String -> B.ByteString+hoovieXml url uuid pngUri = asString $+ tag (""!"root") ["xmlns"!"dlna" ~= "urn:schemas-dlna-org:device-1-0", ""!"xmlns" ~= "urn:schemas-upnp-org:device-1-0"] [+ tag (""!"specVersion") [] [+ tag (""!"major") [] $ text "1",+ tag (""!"minor") [] $ text "0"+ ],+ tag (""!"URLBase") [] $ text url,+ tag (""!"device") [] [+ tag ("dlna"!"X_DLNADOC") ["xmlns"!"dlna" ~= "urn:schemas-dlna-org:device-1-0"] $ text "DMS-1.50",+ tag ("dlna"!"X_DLNADOC") ["xmlns"!"dlna" ~= "urn:schemas-dlna-org:device-1-0"] $ text "M-DMS-1.50",+ tag (""!"deviceType") [] $ text "urn:schemas-upnp-org:device:MediaServer:1",+ tag (""!"friendlyName") [] $ text "Hoovie",+ tag (""!"manufacturer") [] $ text "hoovie.org",+ tag (""!"manufacturerURL") [] $ text "http://www.hoovie.org",+ tag (""!"modelDescription") [] $ text "Hoovie - The Haskell Media Server",+ tag (""!"modelName") [] $ text "Hoovie",+ tag (""!"modelNumber") [] $ text "01",+ tag (""!"modelURL") [] $ text "http://www.hoovie.org",+ tag (""!"serialNumber") [] $ text "",+ tag (""!"UPC") [] $ text "",+ tag (""!"UDN") [] $ text ("uuid:" ++ uuid),+ tag (""!"presentationURL") [] $ text (url ++ "/index.html"),+ tag (""!"iconList") [] [+ tag (""!"icon") [] [+ tag (""!"mimetype") [] $ text "image/png",+ tag (""!"width") [] $ text "128",+ tag (""!"height") [] $ text "128",+ tag (""!"depth") [] $ text "32",+ tag (""!"url") [] $ text ('/' : pngUri)+ ]+ ],+ tag (""!"serviceList") [] [+ tag (""!"service") [] [+ tag (""!"serviceType") [] $ text "urn:schemas-upnp-org:service:ContentDirectory:1",+ tag (""!"serviceId") [] $ text "urn:upnp-org:serviceId:ContentDirectory",+ tag (""!"SCPDURL") [] $ text "/static/UPnP_AV_ContentDirectory_1.0.xml",+ tag (""!"controlURL") [] $ text "/upnp/control/content_directory",+ tag (""!"eventSubURL") [] $ text "/upnp/event/content_directory"+ ],+ tag (""!"service") [] [+ tag (""!"serviceType") [] $ text "urn:schemas-upnp-org:service:ConnectionManager:1",+ tag (""!"serviceId") [] $ text "urn:upnp-org:serviceId:ConnectionManager",+ tag (""!"SCPDURL") [] $ text "/static/UPnP_AV_ConnectionManager_1.0.xml",+ tag (""!"controlURL") [] $ text "/upnp/control/connection_manager",+ tag (""!"eventSubURL") [] $ text "/upnp/event/connection_manager"+ ]+ ]+ ]+ ]+ +data BrowseType = BrowseObject+ | BrowseChildren+ deriving (Eq, Ord, Show)++data DIDLItem = Folder { foObjectId :: String, foParentId :: String, foTitle :: String, foChildCount :: Int } + | Video { viResource :: Resource } + deriving (Eq, Ord, Show)++browseResponse :: String -> [Resource] -> BrowseType -> String -> Int -> Int -> Int -> B.ByteString+browseResponse url resources browseType objectId start count updateId = asString $ envelope $+ let (object, children) = getObject resources objectId+ items = if browseType == BrowseObject then [object] else children+ total = length items + in tag ("u"!"BrowseResponse") ["xmlns"!"u" ~= "urn:schemas-upnp-org:service:ContentDirectory:1"] [+ tag (""!"Result") [] $ text (showContent $ didl url items start count),+ tag (""!"NumberReturned") [] $ text (show $ min count total),+ tag (""!"TotalMatches") [] $ text (show total),+ tag (""!"UpdateID") [] $ text (show updateId)+ ]+++defaultDate :: UTCTime+defaultDate = UTCTime (fromGregorian 2001 1 1) (secondsToDiffTime 0)++rootId, latestId, allId :: String+rootId = "0"+latestId = "latest"+allId = "all"++rootFolder, latestFolder, allFolder :: [Resource] -> DIDLItem+rootFolder _ = Folder rootId "0" "Movies" 2+latestFolder resources = Folder latestId "0" "Latest" (min 10 $ length resources)+allFolder resources = Folder allId "0" "All" (length resources)++getObject :: [Resource] -> String -> (DIDLItem, [DIDLItem])+getObject resources objectId + | objectId == rootId = (rootFolder resources, [ latestFolder resources, allFolder resources ])+ | objectId == latestId = (latestFolder resources, latestItems resources)+ | objectId == allId = (allFolder resources, allItems resources)+ | otherwise = (rootFolder resources, [])++latestItems :: [Resource] -> [DIDLItem]+latestItems resources = map Video $ take 10 $ sortBy (flip $ comparing reDate) resources++allItems :: [Resource] -> [DIDLItem]+allItems resources = map Video $ sortBy (comparing reTitle) resources++didl :: String -> [DIDLItem] -> Int -> Int -> Content+didl url items start count = + tag (""!"DIDL-Lite") [""!"xmlns" ~= "urn:schemas-upnp-org:metadata-1-0/DIDL-Lite/", "xmlns"!"dc" ~= "http://purl.org/dc/elements/1.1/", "xmlns"!"upnp" ~= "urn:schemas-upnp-org:metadata-1-0/upnp/"] $+ (map (didlItem url) . take count . drop start $ items)++didlItem :: String -> DIDLItem -> Content+didlItem url (Folder fid pid title count) = + tag (""!"container") [""!"id" ~= fid, ""!"childCount" ~= show count, ""!"parentID" ~= pid, ""!"restricted" ~= "true"] [+ tag (""!"res") [""!"protocolInfo" ~= "http-get:*:image/jpeg:DLNA.ORG_PN=JPEG_TN"] $ text (url ++ "/folder/" ++ fid),+ tag ("dc"!"title") [] $ text title,+ tag ("dc"!"date") [] $ text (formatDate defaultDate),+ tag ("upnp"!"class") [] $ text "object.container.storageFolder"+ ]+didlItem url (Video resource) = + let rid = show $ reID resource in+ tag (""!"item") [""!"id" ~= ("0$" ++ rid), ""!"parentID" ~= "0", ""!"restricted" ~= "true"] [+ tag ("dc"!"title") [] $ text (reTitle resource),+ tag ("dc"!"date") [] $ text (formatDate $ reDate resource),+ tag ("upnp"!"class") [] $ text "object.item.videoItem",+ tag ("upnp"!"albumArtURI") ["xmlns"!"dlna" ~= "urn:schemas-dlna-org:metadata-1-0/", "dlna"!"profileID" ~= "JPEG_TN"] $ text (url ++ "/icon/" ++ rid),++ tag (""!"res") [""!"protocolInfo" ~= "http-get:*:image/jpeg:DLNA.ORG_PN=JPEG_TN"+ ] $ text (url ++ "/icon/" ++ rid),++ tag (""!"res") [ "xmlns"!"dlna" ~= "urn:schemas-dlna-org:metadata-1-0/"+ , ""!"protocolInfo" ~= "http-get:*:video/mpeg:DLNA.ORG_PN=MPEG_PS_NTSC;DLNA.ORG_OP=10"+ , ""!"duration" ~= (formatDuration $ reDuration resource)+ , ""!"resolution" ~= (formatResolution $ reResolution resource)+ , ""!"bitrate" ~= (show $ reBitrate resource)+ , ""!"nrAudioChannels" ~= (show $ reBitrate resource)+ , ""!"sampleFrequency" ~= (show $ reSampleFreq resource)+ ] $ text (url ++ "/stream/" ++ rid)+ ]+++connectionManagerEvent :: B.ByteString+connectionManagerEvent = asString $+ tag ("e"!"propertyset") ["xmlns"!"e" ~= "urn:schemas-upnp-org:event-1-0", "xmlns"!"s" ~= "urn:schemas-upnp-org:service:ConnectionManager:1"] [+ tag ("e"!"property") [] [ tag (""!"SinkProtocolInfo") [] [] ],+ tag ("e"!"property") [] [ tag (""!"SourceProtocolInfo") [] [] ],+ tag ("e"!"property") [] [ tag (""!"CurrentConnectionIDs") [] [] ]+ ]++contentDirectoryEvent :: B.ByteString+contentDirectoryEvent = asString $+ tag ("e"!"propertyset") ["xmlns"!"e" ~= "urn:schemas-upnp-org:event-1-0", "xmlns"!"s" ~= "urn:schemas-upnp-org:service:ContentDirectory:1"] [+ tag ("e"!"property") [] [ tag (""!"TransferIDs") [] [] ],+ tag ("e"!"property") [] [ tag (""!"ContainerUpdateIDs") [] [] ],+ tag ("e"!"property") [] [ tag (""!"SystemUpdateID") [] (text "1") ]+ ]++formatDate :: UTCTime -> String+formatDate = formatTime defaultTimeLocale "%FT%T"++formatDuration :: Int -> String+formatDuration d = printf "%02d:%02d:%02d.00" (d `div` 3600) ((d `div` 60) `mod` 60) (d `mod` 60)++formatResolution :: (Int, Int) -> String+formatResolution (x, y) = printf "%dx%d" x y+
+ src/Hoovie/Monitor.hs view
@@ -0,0 +1,193 @@+module Hoovie.Monitor (+ MonitorHandle,+ startMonitor,+ stopMonitor,+ getResources,+ getResourceById+ ) where++import Prelude hiding (catch)++import Control.Concurrent (forkIO, ThreadId, killThread, threadDelay)+import System.Directory (getDirectoryContents, doesDirectoryExist, doesFileExist, canonicalizePath, getModificationTime)+import System.FilePath (joinPath, dropExtension, takeFileName)+import Control.Monad (filterM, forever, forM_)+import Control.Exception (bracket, finally, catch)+import Control.Exception.Base (SomeException)+import Data.List (isSuffixOf)+import Data.Maybe (mapMaybe)+import Data.Time (UTCTime(..))+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import System.Time (ClockTime(..))+import Text.Regex (Regex, subRegex, mkRegex)++import Database.HDBC+import Database.HDBC.Sqlite3+import Debug.Trace++import Hoovie.Resource++supportedExtensions :: [String]+supportedExtensions = ["avi", "mp4"]++data MonitorHandle = MonitorHandle ThreadId++startMonitor :: [FilePath] -> FilePath -> IO MonitorHandle+startMonitor paths db = do+ pid <- forkIO $ monitor paths db+ return $ MonitorHandle pid++stopMonitor :: MonitorHandle -> IO ()+stopMonitor (MonitorHandle pid) = killThread pid++monitor :: [FilePath] -> FilePath -> IO ()+monitor paths db = forever $ (scan paths db `catch` logError) `finally` (threadDelay (5 * 1000000))++scan :: [FilePath] -> FilePath -> IO ()+scan paths db = listFiles paths supportedExtensions >>= syncDb db++logError :: SomeException -> IO ()+logError e = putStrLn $ show e++safely :: (Connection -> IO a) -> Connection -> IO a+safely f conn = handleSqlError $ f conn++withDb :: FilePath -> (Connection -> IO a) -> IO a+withDb db f = bracket (connectSqlite3 db)+ (safely disconnect)+ (safely f)++getResources :: FilePath -> IO [Resource]+getResources db = withDb db $ \conn -> do+ rows <- quickQuery' conn "SELECT id, filename, title, mod_date FROM files" []+ return $ mapMaybe toResource rows++getResourceById :: FilePath -> Maybe Int -> IO (Maybe Resource)+getResourceById _ Nothing = return Nothing+getResourceById db (Just rid) = withDb db $ \conn -> do+ rows <- quickQuery' conn "SELECT id, filename, title, mod_date FROM files WHERE id=?" [toSql rid]+ return $ case rows of+ [] -> Nothing+ (a:_) -> toResource a++toResource :: [SqlValue] -> Maybe Resource+toResource row = + case row of+ [sqlId, sqlFilename, sqlTitle, sqlModDate] -> do+ rid <- fromSql sqlId+ filename <- fromSql sqlFilename+ title <- fromSql sqlTitle+ modDate <- fromSql sqlModDate+ return $ Resource rid filename title modDate 4000 (688, 304) 102912 2 48000+ _ -> Nothing++fromResource :: Resource -> [SqlValue]+fromResource resource = + let conv f = toSql (f resource)+ in [ conv reFilename+ , conv reTitle+ , conv reDate+ -- , conv reDuration+ -- , conv reResolution+ -- , conv reBitrate+ -- , conv reAudioChannels+ -- , conv reSampleFreq+ ]++syncDb :: FilePath -> [(FilePath, UTCTime)] -> IO ()+syncDb db files = withDb db $ sync files++sync :: [(FilePath, UTCTime)] -> Connection -> IO ()+sync files conn = do+ _ <- run conn "CREATE TABLE IF NOT EXISTS files (id INTEGER PRIMARY KEY, filename TEXT NOT NULL, title TEXT NOT NULL, mod_date DATETIME)" []+ rows <- quickQuery' conn "SELECT id, filename, mod_date FROM files" []+ deleteDeletedFiles files rows conn+ insertNewFiles files rows conn+ count <- quickQuery' conn "SELECT COUNT(*) FROM files" []+ putStrLn $ "Updated database: #files = " ++ show count+ commit conn++deleteDeletedFiles :: [(FilePath, UTCTime)] -> [[SqlValue]] -> Connection -> IO ()+deleteDeletedFiles files rows conn = do+ let toKeep = [ (Just f, Just d) | (f, d) <- files ]+ let toDelete = [ [sqlId] | [sqlId, sqlFile, sqlModDate] <- rows, not $ (fromSql sqlFile, fromSql sqlModDate) `elem` toKeep ]+ runAll conn "DELETE FROM files WHERE id=?" toDelete+ trace ("DELETED FILES: " ++ show toDelete) (return ())++insertNewFiles :: [(FilePath, UTCTime)] -> [[SqlValue]] -> Connection -> IO ()+insertNewFiles files rows conn = do+ let inDatabase = [ (fromSql sqlFile, fromSql sqlModDate) | [_, sqlFile, sqlModDate] <- rows ]+ let toInsert = [ f | f <- files, not $ f `elem` inDatabase ]+ resources <- mapM fromFile toInsert+ runAll conn "INSERT INTO files (filename, title, mod_date) VALUES (?, ?, ?)" $ map fromResource resources+ trace ("INSERTED FILES: " ++ show resources) (return ())+ +runAll :: Connection -> String -> [[SqlValue]] -> IO ()+runAll conn sql paramList = forM_ paramList $ \params -> quickQuery' conn sql params++fromFile :: (FilePath, UTCTime) -> IO Resource+fromFile (filename, modDate) = return $ Resource (-1) filename (getTitle filename) modDate 4000 (688, 304) 102912 2 48000++-- this function is no longer needed if we can upgrade to directory-1.2+toUTC :: ClockTime -> UTCTime+toUTC (TOD p _) = posixSecondsToUTCTime (fromIntegral p)++getTitle :: FilePath -> String+getTitle = replaceAll replacements . dropExtension . takeFileName++replacements :: [(Regex, String)]+replacements = map (\(p, v) -> (mkRegex p, v)) [+ ("\\b[Ww][Ww][Ww]\\.[^.]+\\.[A-Za-z]{1,3}\\b", ""),+ ("\\b[Bb][Rr][Rr][Ii][Pp]\\b", ""),+ ("\\b[Dd][Vv][Dd][Rr][Ii][Pp]\\b", ""),+ ("\\b[Dd][Vv][Dd][Rr]\\b", ""),+ ("\\b[Hh][Dd][Tt][Vv]\\b", ""),+ ("\\b[Xx][Vv][Ii][Dd]\\b", ""),+ ("\\b[Xx]264\\b", ""),+ ("\\b[Aa][Cc]3-5.1\\b", ""),+ ("\\b[Aa][Cc]3\\b", ""),+ ("\\b480[Pp]\\b", " "),+ ("\\b720[Pp]\\b", " "),+ ("\\b1080[Pp]\\b", " "),+ ("[.,-]", " "),+ ("\\([ ]*\\)", ""),+ ("\\[[^]]*\\]", ""),+ ("\\{[^}]*\\}", ""),+ ("^[ ]+", ""),+ ("[ ]+$", ""),+ (" [ ]+", " ")+ ]++replaceAll :: [(Regex, String)] -> String -> String+replaceAll ((p, v):ps) s = replaceAll ps $ subRegex p s v+replaceAll [] s = s++listFiles :: [FilePath] -> [String] -> IO [(FilePath, UTCTime)]+listFiles paths extensions = trace ("Scanning: " ++ show paths) $ concatMapM list paths+ where+ list :: FilePath -> IO [(FilePath, UTCTime)]+ list path = do+ exists <- doesDirectoryExist path+ if not exists + then return []+ else do+ contents <- getDirectoryContents path+ full <- mapM canonicalizePath [ joinPath [path, name] | name <- contents, name /= ".", name /= ".." ]+ dirs <- filterM doesDirectoryExist full+ files <- filterM doesFileExist $ filter (hasExtension extensions) full+ result <- mapM addModificationTime files+ subdir <- concatMapM list dirs+ return $ result ++ subdir++addModificationTime :: FilePath -> IO (FilePath, UTCTime)+addModificationTime path = do+ dt <- getModificationTime path+ return (path, toUTC dt)++hasExtension :: [String] -> FilePath -> Bool+hasExtension (e:es) path = e `isSuffixOf` path || hasExtension es path+hasExtension _ _ = False++concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]+concatMapM f xs = mapM f xs >>= return . concat+
+ src/Hoovie/Resource.hs view
@@ -0,0 +1,16 @@+module Hoovie.Resource where++import Data.Time (UTCTime)++data Resource = Resource {+ reID :: Int,+ reFilename :: String,+ reTitle :: String,+ reDate :: UTCTime,+ reDuration :: Int,+ reResolution :: (Int, Int),+ reBitrate :: Int,+ reAudioChannels :: Int,+ reSampleFreq :: Int+ } deriving (Eq, Ord, Show)+
+ src/Hoovie/SOAP.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+module Hoovie.SOAP (+ hoovieXmlUri,+ soapHandler,+ staticSendFile+ ) where++import Text.XML.Light (parseXMLDoc, findElement, QName(..), Element(..), strContent)+import Text.XML.Light.Lexer (XmlSource)+import Data.String (IsString)+import Data.FileEmbed (embedFile)+import Control.Applicative ((<|>))+import Control.Monad.IO.Class (liftIO)++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC++import Snap.Core++import Hoovie.Messages+import Hoovie.Monitor+import Hoovie.Util++hoovieXmlUri :: String+hoovieXmlUri = "static/hoovie.xml"++hooviePngUri :: String+hooviePngUri = "static/hoovie.png"++soapHandler :: String -> String -> FilePath -> Snap ()+soapHandler url uuid db =+ path "static/UPnP_AV_ConnectionManager_1.0.xml" (staticSendXml $(embedFile "static/UPnP_AV_ConnectionManager_1.0.xml")) <|>+ path "static/UPnP_AV_ContentDirectory_1.0.xml" (staticSendXml $(embedFile "static/UPnP_AV_ContentDirectory_1.0.xml")) <|>+ path (BC.pack hoovieXmlUri) (staticSendXml $ hoovieXml url uuid hooviePngUri) <|>+ path (BC.pack hooviePngUri) (staticSendFile "image/png" $(embedFile "static/hoovie.png")) <|>+ subscribeAction uuid <|>+ soapAction url db++subscribeAction :: String -> Snap ()+subscribeAction uuid = method (Method "SUBSCRIBE") (+ path "upnp/event/connection_manager" (staticSendEvent uuid $ connectionManagerEvent) <|>+ path "upnp/event/content_directory" (staticSendEvent uuid $ contentDirectoryEvent))++soapAction :: String -> FilePath -> Snap ()+soapAction url db = method POST $ do+ action <- getsRequest (getHeader "SOAPACTION")+ case action of+ Nothing -> pass+ Just a -> handleSoapAction url db a++staticSendEvent :: String -> B.ByteString -> Snap ()+staticSendEvent uuid bytes = do+ modifyResponse $ setHeader "SID" (BC.pack $ "uuid:" ++ uuid)+ . setHeader "TIMEOUT" "Second-1800"+ staticSendXml bytes++staticSendXml :: B.ByteString -> Snap ()+staticSendXml = staticSendFile "text/xml; charset=\"utf-8\""++staticSendFile :: String -> B.ByteString -> Snap ()+staticSendFile contentType bytes = do+ modifyResponse $ setContentLength (fromIntegral $ B.length bytes)+ . setContentType (BC.pack contentType)+ writeBS bytes++handleSoapAction :: (Eq a, Data.String.IsString a) => String -> FilePath -> a -> Snap ()+handleSoapAction _ _ "\"urn:schemas-upnp-org:service:ConnectionManager:1#GetProtocolInfo\"" = staticSendXml $(embedFile "static/get-protocol-info.xml")+handleSoapAction _ _ "\"urn:schemas-upnp-org:service:ContentDirectory:1#GetSortCapabilities\"" = staticSendXml $(embedFile "static/get-sort-capabilities.xml")+handleSoapAction _ _ "\"urn:schemas-upnp-org:service:ContentDirectory:1#GetSearchCapabilities\"" = staticSendXml $(embedFile "static/get-search-capabilities.xml")+handleSoapAction _ _ "\"urn:schemas-upnp-org:service:ContentDirectory:1#GetSystemUpdateID\"" = staticSendXml $(embedFile "static/get-system-update-id.xml")+handleSoapAction url db "\"urn:schemas-upnp-org:service:ContentDirectory:1#Browse\"" = do+ body <- getRequestBody+ case parseBrowseRequest body of+ Just (objectId, start, count, browseFlag) -> do+ resources <- liftIO $ getResources db+ staticSendXml $ browseResponse url resources (if browseFlag == "BrowseMetadata" then BrowseObject else BrowseChildren) objectId start count 1+ Nothing -> pass+handleSoapAction _ _ _ = pass++parseBrowseRequest :: XmlSource s => s -> Maybe (String, Int, Int, String)+parseBrowseRequest xml = do+ doc <- parseXMLDoc xml+ objectId <- getTagValue doc $ QName "ObjectID" Nothing Nothing+ startIndexStr <- getTagValue doc $ QName "StartingIndex" Nothing Nothing+ reqCountStr <- getTagValue doc $ QName "RequestedCount" Nothing Nothing+ browseFlag <- getTagValue doc $ QName "BrowseFlag" Nothing Nothing+ -- filter <- getTagValue doc $ QName "Filter" Nothing Nothing+ startIndex <- maybeRead startIndexStr+ reqCount <- maybeRead reqCountStr+ return (objectId, startIndex, reqCount, browseFlag)++getTagValue :: Element -> QName -> Maybe String+getTagValue doc item = case findElement item doc of+ Nothing -> Nothing+ Just el -> Just $ strContent el++
+ src/Hoovie/SSDP.hs view
@@ -0,0 +1,188 @@+module Hoovie.SSDP (+ SSDPServiceItem(..),+ SSDPService(..),+ SSDPHandle,+ startSsdpServer,+ stopSsdpServer,+ getUUID,+ getURL+ ) where++import Network.Socket (socket, sendTo, recvFrom, sClose, SockAddr, Family(AF_INET), SocketType(Datagram), PortNumber)+import Network.Multicast (setTimeToLive, multicastSender, multicastReceiver, addMembership)+import Control.Exception.Base (bracket)+import Control.Concurrent (forkIO, ThreadId, killThread, threadDelay)+import Control.Monad (forever, forM_)+import Data.List (intercalate, isPrefixOf, isInfixOf)+import Data.Time.Clock (getCurrentTime)+import Data.Time.Format (formatTime)+import System.Locale (defaultTimeLocale)+import Network.Info (NetworkInterface, MAC(..), mac, ipv4)+import Text.Printf (printf)++-- TODO+-- * stop instead of kill threads, and send byebye+-- * catch all exceptions in the threads to make sure they keep running++data SSDPServiceItem = SSDPMediaServer+ | SSDPContentDirectory+ | SSDPConnectionManager+ deriving (Eq, Ord, Show)++data SSDPService = SSDPService { + ssInterface :: NetworkInterface,+ ssPort :: Int,+ ssURI :: String,+ ssProductName :: String,+ ssProductVersion :: String,+ ssServiceItems :: [SSDPServiceItem]+ } deriving (Show)++data SSDPHandle = SSDPHandle ThreadId ThreadId String String++ssdpIP :: String+ssdpIP = "239.255.255.250"++ssdpPort :: PortNumber+ssdpPort = 1900++serviceUri :: SSDPServiceItem -> String+serviceUri SSDPMediaServer = "urn:schemas-upnp-org:device:MediaServer:1"+serviceUri SSDPContentDirectory = "urn:schemas-upnp-org:service:ContentDirectory:1"+serviceUri SSDPConnectionManager = "urn:schemas-upnp-org:service:ConnectionManager:1"++startSsdpServer :: SSDPService -> IO SSDPHandle+startSsdpServer (SSDPService interface port uri productName productVersion services) = do+ let uuid = getUUIDFromMacAddress interface+ let server = "Linux/2.6 UPnP/1.0 " ++ productName ++ "/" ++ productVersion+ let base = "http://" ++ show (ipv4 interface) ++ ":" ++ show port+ let url = base ++ uri+ a <- forkIO $ sendAlive uuid url server services+ b <- forkIO $ listen uuid url server services+ return $ SSDPHandle a b base uuid++stopSsdpServer :: SSDPHandle -> IO ()+stopSsdpServer (SSDPHandle a b _ _) = do+ killThread a+ killThread b++getUUID :: SSDPHandle -> String+getUUID (SSDPHandle _ _ _ uuid) = uuid++getURL :: SSDPHandle -> String+getURL (SSDPHandle _ _ url _) = url++getUUIDFromMacAddress :: NetworkInterface -> String+getUUIDFromMacAddress interface =+ toUUID $ if mac interface == MAC 0 0 0 0 0 0+ then MAC 18 29 53 79 76 25+ else mac interface+ where+ toUUID (MAC a b c d e f) = take 16 $ "35" ++ (printf "%02d%02d%02d%02d%02d%02d" a b c d e f) ++ "53"++messageTypes :: String -> [SSDPServiceItem] -> [String]+messageTypes uuid services = ["upnp:rootdevice", uuid] ++ map serviceUri services++listen :: String -> String -> String -> [SSDPServiceItem] -> IO ()+listen uuid url server services = forever $ do+ (msg, addr) <- receive+ -- putStr msg+ if "M-SEARCH" `isPrefixOf` msg + then forM_ (messageTypes uuid services) $ \msgType -> do if msgType `isInfixOf` msg then sendDiscover uuid url server addr msgType else return ()+ else return ()+ +getRFC1123Date :: IO String+getRFC1123Date = do+ -- rfc1123-date = wkday "," SP date1 SP time SP "GMT"+ -- wkday = "Mon" | "Tue" | "Wed" | "Thu" | "Fri" | "Sat" | "Sun"+ -- date1 = 2DIGIT SP month SP 4DIGIT ; day month year (e.g., 02 Jun 1982)+ -- time = 2DIGIT ":" 2DIGIT ":" 2DIGIT ; 00:00:00 - 23:59:59+ -- Example: Sun, 06 Nov 1994 08:49:37 GMT+ now <- getCurrentTime+ return $ formatTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S GMT" now++sendDiscover :: String -> String -> String -> SockAddr -> String -> IO ()+sendDiscover uuid url server addr st = do+ date <- getRFC1123Date+ sendReply addr $ makeMessage "HTTP/1.1 200 OK" [+ ("CACHE-CONTROL", "max-age=1800"),+ ("DATE", date),+ ("EXT", ""),+ ("LOCATION", url),+ ("SERVER", server),+ ("ST", (if st == uuid then "uuid:" else "") ++ st),+ ("USN", "uuid:" ++ uuid ++ (if st == uuid then "" else "::" ++ st)),+ ("Content-Length", "0")+ ]++sendAlive :: String -> String -> String -> [SSDPServiceItem] -> IO ()+sendAlive uuid url server services = forever $ do+ send $ map (makeAliveMessage uuid url server) (messageTypes uuid services)+ threadDelay 600000000++makeAliveMessage :: String -> String -> String -> String -> String+makeAliveMessage uuid url server nt = makeMessage "NOTIFY * HTTP/1.1" [+ ("HOST", "239.255.255.250:1900"),+ ("CACHE-CONTROL", "max-age=1800"),+ ("LOCATION", url),+ ("NT", (if nt == uuid then "uuid:" else "") ++ nt),+ ("NTS", "ssdp:alive"),+ ("SERVER", server),+ ("USN", "uuid:" ++ uuid ++ (if nt == uuid then "" else "::" ++ nt))+ ]++-- makeByebyeMessage :: String -> String -> String+-- makeByebyeMessage uuid nt = makeMessage "NOTIFY * HTTP/1.1" [+-- ("HOST", "239.255.255.250:1900"),+-- ("NT", nt),+-- ("NTS", "ssdp:byebye"),+-- ("USN", if nt == uuid then uuid else uuid ++ "::" ++ nt)+-- ]++makeMessage :: String -> [(String, String)] -> String+makeMessage method headers = + method ++ "\r\n" +++ (intercalate "\r\n" [ key ++ ": " ++ value | (key, value) <- headers ]) +++ "\r\n\r\n"++sendReply :: SockAddr -> String -> IO ()+sendReply addr message = do+ bracket+ (socket AF_INET Datagram 0)+ (sClose)+ (\sock -> forM_ ([1..3] :: [Int]) $ \_ -> do+ go sock message+ threadDelay 500000)+ where+ go _ [] = return ()+ go sock msg = do + sent <- sendTo sock msg addr+ go sock $ drop sent msg++send :: [String] -> IO ()+send messages = do+ bracket+ (multicastSender ssdpIP ssdpPort)+ (sClose . fst)+ (\(sock, addr) -> do+ setTimeToLive sock 4+ addMembership sock ssdpIP+ forM_ ([1..3] :: [Int]) $ \_ -> do+ forM_ messages $ \m -> do+ go sock addr m+ threadDelay 500000)+ where+ go _ _ [] = return ()+ go sock addr msg = do + sent <- sendTo sock msg addr+ go sock addr $ drop sent msg++receive :: IO (String, SockAddr)+receive = do+ bracket+ (multicastReceiver ssdpIP ssdpPort)+ (sClose)+ (\sock -> do + (msg, _, addr) <- recvFrom sock 1024+ return (msg, addr))+
+ src/Hoovie/Server.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+module Hoovie.Server (+ HoovieService(..),+ HoovieServerHandle,+ startHoovieServer,+ stopHoovieServer+ ) where++import Control.Concurrent (forkIO, ThreadId, killThread)+import Data.List (intersperse)+import Debug.Trace (trace)+import Network.Info (NetworkInterface, ipv4)+import Control.Applicative ((<|>))+import Data.FileEmbed (embedFile)++import qualified Data.ByteString.Char8 as BC++import Snap.Core+import Snap.Http.Server++import Hoovie.SSDP+import Hoovie.SOAP+import Hoovie.Stream+import Hoovie.Monitor++data HoovieService = HoovieService {+ hsInterface :: NetworkInterface,+ hsPort :: Int,+ hsPaths :: [FilePath],+ hsDatabase :: FilePath+ } deriving (Show)++data HoovieServerHandle = HoovieServerHandle ThreadId SSDPHandle MonitorHandle++snapConfig :: MonadSnap m => String -> Int -> Config m a+snapConfig ip port = ( setLocale "en_US"+ . setPort port+ . setBind (BC.pack ip)+ ) emptyConfig++startHoovieServer :: HoovieService -> IO HoovieServerHandle+startHoovieServer (HoovieService interface port paths db) = do+ mon <- startMonitor paths db+ ssdp <- startSsdpServer $ SSDPService interface port ('/':hoovieXmlUri) "Hoovie" "0.1" [SSDPMediaServer, SSDPContentDirectory, SSDPConnectionManager]+ http <- forkIO $ httpServe (snapConfig (show $ ipv4 interface) port) (site (getURL ssdp) (getUUID ssdp) db)+ return $ HoovieServerHandle http ssdp mon++stopHoovieServer :: HoovieServerHandle -> IO ()+stopHoovieServer (HoovieServerHandle http ssdp mon) = do+ stopSsdpServer ssdp+ stopMonitor mon+ killThread http++site :: String -> String -> FilePath -> Snap ()+site url uuid db =+ logRequest <|>+ soapHandler url uuid db <|>+ route [("stream/:id", streamHandler db),+ ("folder/:id", iconHandler),+ ("icon/:id", iconHandler)]++iconHandler :: Snap ()+iconHandler = do+ -- rid <- getParam "id"+ staticSendFile "image/jpg" $(embedFile "static/hoovie.jpg")++logRequest :: Snap a+logRequest = do+ request <- getRequest+ trace (show (rqMethod request) ++ " " ++ show (rqURI request) ++ "\n" +++ concat (intersperse "\n" ([" " ++ show k ++ ": " ++ show v | (k, v) <- listHeaders $ headers request]))) pass+
+ src/Hoovie/Stream.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}+module Hoovie.Stream (+ streamHandler+ ) where++import Control.Monad (when)+import Control.Monad.IO.Class (liftIO)+import Data.Maybe (fromJust)++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC++import Snap.Core+import Debug.Trace++import Hoovie.Transcode+import Hoovie.Monitor+import Hoovie.Util+import Hoovie.Resource++streamHandler :: FilePath -> Snap ()+streamHandler db = do+ request <- getRequest+ rid <- getParam "id"+ resource <- liftIO $ getResourceById db (maybe Nothing maybeReadBS rid)+ if resource /= Nothing && getHeader "TransferMode.DLNA.org" request == Just "Streaming" + then streamResource $ fromJust resource+ else pass+ +streamResource :: Resource -> Snap ()+streamResource resource = do+ request <- getRequest+ modifyResponse $ setHeader "TransferMode.DLNA.org" "Streaming"+ . setHeader "Content-Type" "video/mpeg"+ . setHeader "ContentFeatures.DLNA.ORG" "DLNA.ORG_PN=MPEG_PS_NTSC;DLNA.ORG_OP=10;DLNA.ORG_CI=0;DLNA.ORG_FLAGS=01700000000000000000000000000000"+ . setHeader "Accept-Ranges" "bytes"+ . setHeader "Connection" "keep-alive"++ let timeRange = case getHeader "TimeSeekRange.dlna.org" request of+ Nothing -> (Nothing, Nothing)+ Just range -> parseTimeRange range++ when (rqMethod request == HEAD) $ do+ modifyResponse $ setContentLength 0+ when (rqMethod request == GET) $ do+ modifyResponse $ setResponseBody (transcode timeRange $ reFilename resource)++parseTimeRange :: B.ByteString -> (Maybe Double, Maybe Double)+parseTimeRange s = let (start, stop) = BC.break (== '-') $ BC.drop 1 $ BC.dropWhile (/= '=') s+ in (parseTime start, parseTime $ BC.drop 1 stop)++parseTime :: B.ByteString -> Maybe Double+parseTime s = trace (show s) $ maybeRead (BC.unpack s)+
+ src/Hoovie/Transcode.hs view
@@ -0,0 +1,78 @@+module Hoovie.Transcode where++import Data.Maybe+import System.Process+import Data.Enumerator+import Blaze.ByteString.Builder+import Debug.Trace++import qualified Data.ByteString as B+import qualified Control.Exception as Exc+import qualified System.IO as IO+import qualified GHC.IO.Exception as E++-- mencoder -ss 0 '/home/peter/movies/[UsaBit.com] - The.Pirates.Band.of.Misfits.2012.DVDRip.XviD-PTpOWeR/The.Pirates.Band.of.Misfits.2012.DVDRip.XviD-PTpOWeR.avi' -msglevel statusline=2 -oac lavc -of mpeg -mpegopts format=mpeg2:muxrate=500000:vbuf_size=1194:abuf_size=64 -ovc lavc -channels 6 -lavdopts debug=0:threads=4 -lavcopts autoaspect=1:vcodec=mpeg2video:acodec=ac3:abitrate=448:threads=4:keyint=5:vqscale=1:vqmin=2:vrc_maxrate=54000:vrc_buf_size=1835 -font /usr/share/fonts/truetype/ttf-dejavu/DejaVuSans.ttf -subfont-text-scale 3 -subfont-outline 1 -subfont-blur 1 -subpos 98 -fontconfig -sid 100 -ofps 24000/1001 -sub '/home/peter/movies/[UsaBit.com] - The.Pirates.Band.of.Misfits.2012.DVDRip.XviD-PTpOWeR/The.Pirates.Band.of.Misfits.2012.DVDRip.XviD-PTpOWeR.srt' -lavdopts fast -mc 0 -noskip -af lavcresample=48000 -srate 48000 -o movie.avi++transcode :: (Maybe Double, Maybe Double)+ -> FilePath+ -> Enumerator Builder IO b+transcode range filename step = do+ trace ("transcode: " ++ show range) (return ())+ (_, hOut, _, encoder) <- tryIO $ createProcess ((ffmpeg range filename) { std_out = CreatePipe, create_group = True })+ case hOut of+ Nothing -> do+ Iteratee $ Exc.throw (E.IOError Nothing E.IllegalOperation "" "could not start transcoding" Nothing (Just filename))+ Just h -> do+ let iter = streamFromHandle h step+ Iteratee $ Exc.finally (Exc.catch (runIteratee iter) (\err -> trace (show (err :: Exc.IOException)) (Exc.throwIO err))) (IO.hClose h >> interruptProcessGroupOf encoder)++simpleCat :: String -> CreateProcess+simpleCat filename = proc "cat" [filename]++ffmpeg :: (Maybe Double, Maybe Double) -> String -> CreateProcess+ffmpeg (start, stop) filename = + let startArg = case start of+ Just pos -> ["-ss", show pos]+ Nothing -> []+ stopArg = case stop of+ Just pos -> ["-t", show $ max (1 :: Int) (floor $ pos - (fromMaybe 0.0 start))]+ Nothing -> []+ in proc "avconv" $+ startArg +++ [ "-i", filename+ , "-target", "ntsc-vcd"+ , "-loglevel", "quiet" ] +++ stopArg +++ [ "pipe:1" ]++mencoder :: String -> CreateProcess+mencoder filename =+ proc "mencoder" [+ "-ss", "0", + filename,+ "-msglevel", "all=-1", --"statusline=2", + "-oac", "lavc", + "-of", "mpeg", + "-mpegopts", "format=mpeg2:muxrate=500000:vbuf_size=1194:abuf_size=64", + "-ovc", "lavc", + "-channels", "6", + "-lavdopts", "debug=0:threads=4", + "-lavcopts", "autoaspect=1:vcodec=mpeg2video:acodec=ac3:abitrate=448:threads=4:keyint=5:vqscale=1:vqmin=2:vrc_maxrate=54000:vrc_buf_size=1835", + "-sid", "100", + "-ofps", "24000/1001", + "-lavdopts", "fast", + "-mc", "0", + "-noskip", + "-af", "lavcresample=48000", + "-srate", "48000", + "-o", "/dev/stdout"]++streamFromHandle :: IO.Handle+ -> Enumerator Builder IO b+streamFromHandle h = checkContinue0 $ \loop k -> do+ -- bytes <- tryIO (getBytes h 4096)+ bytes <- tryIO $ Exc.catch (B.hGet h 4096) (\err -> trace (show (err :: Exc.IOException)) (Exc.throwIO err))+ if B.null bytes+ then trace "No data left!!!" $ continue k+ else k (Chunks [fromByteString bytes]) >>== loop+
+ src/Hoovie/Util.hs view
@@ -0,0 +1,13 @@+module Hoovie.Util where++import Data.Maybe (listToMaybe)++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC++maybeRead :: Read b => String -> Maybe b+maybeRead a = fmap fst . listToMaybe . reads $ a++maybeReadBS :: B.ByteString -> Maybe Int+maybeReadBS a = fmap fst $ BC.readInt a+
+ static/UPnP_AV_ConnectionManager_1.0.xml view
@@ -0,0 +1,182 @@+<?xml version="1.0" encoding="utf-8"?>+<scpd xmlns="urn:schemas-upnp-org:service-1-0">+ <specVersion>+ <major>1</major>+ <minor>0</minor>+ </specVersion>+ <actionList>+ <action>+ <name>GetCurrentConnectionInfo</name>+ <argumentList>+ <argument>+ <name>ConnectionID</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_ConnectionID</relatedStateVariable>+ </argument>+ <argument>+ <name>RcsID</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_RcsID</relatedStateVariable>+ </argument>+ <argument>+ <name>AVTransportID</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_AVTransportID</relatedStateVariable>+ </argument>+ <argument>+ <name>ProtocolInfo</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_ProtocolInfo</relatedStateVariable>+ </argument>+ <argument>+ <name>PeerConnectionManager</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_ConnectionManager</relatedStateVariable>+ </argument>+ <argument>+ <name>PeerConnectionID</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_ConnectionID</relatedStateVariable>+ </argument>+ <argument>+ <name>Direction</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_Direction</relatedStateVariable>+ </argument>+ <argument>+ <name>Status</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_ConnectionStatus</relatedStateVariable>+ </argument>+ </argumentList>+ </action>+ <action>+ <name>ConnectionComplete</name>+ <argumentList>+ <argument>+ <name>ConnectionID</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_ConnectionID</relatedStateVariable>+ </argument>+ </argumentList>+ </action>+ <action>+ <name>PrepareForConnection</name>+ <argumentList>+ <argument>+ <name>RemoteProtocolInfo</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_ProtocolInfo</relatedStateVariable>+ </argument>+ <argument>+ <name>PeerConnectionManager</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_ConnectionManager</relatedStateVariable>+ </argument>+ <argument>+ <name>PeerConnectionID</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_ConnectionID</relatedStateVariable>+ </argument>+ <argument>+ <name>Direction</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_Direction</relatedStateVariable>+ </argument>+ <argument>+ <name>ConnectionID</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_ConnectionID</relatedStateVariable>+ </argument>+ <argument>+ <name>AVTransportID</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_AVTransportID</relatedStateVariable>+ </argument>+ <argument>+ <name>RcsID</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_RcsID</relatedStateVariable>+ </argument>+ </argumentList>+ </action>+ <action>+ <name>GetProtocolInfo</name>+ <argumentList>+ <argument>+ <name>Source</name>+ <direction>out</direction>+ <relatedStateVariable>SourceProtocolInfo</relatedStateVariable>+ </argument>+ <argument>+ <name>Sink</name>+ <direction>out</direction>+ <relatedStateVariable>SinkProtocolInfo</relatedStateVariable>+ </argument>+ </argumentList>+ </action>+ <action>+ <name>GetCurrentConnectionIDs</name>+ <argumentList>+ <argument>+ <name>ConnectionIDs</name>+ <direction>out</direction>+ <relatedStateVariable>CurrentConnectionIDs</relatedStateVariable>+ </argument>+ </argumentList>+ </action>+ </actionList>+ <serviceStateTable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_ProtocolInfo</name>+ <dataType>string</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_ConnectionStatus</name>+ <dataType>string</dataType>+ <allowedValueList>+ <allowedValue>OK</allowedValue>+ <allowedValue>ContentFormatMismatch</allowedValue>+ <allowedValue>InsufficientBandwidth</allowedValue>+ <allowedValue>UnreliableChannel</allowedValue>+ <allowedValue>Unknown</allowedValue>+ </allowedValueList>+ </stateVariable>+ <stateVariable sendEvents="yes">+ <name>SinkProtocolInfo</name>+ <dataType>string</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_AVTransportID</name>+ <dataType>i4</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_RcsID</name>+ <dataType>i4</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_ConnectionID</name>+ <dataType>i4</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_ConnectionManager</name>+ <dataType>string</dataType>+ </stateVariable>+ <stateVariable sendEvents="yes">+ <name>SourceProtocolInfo</name>+ <dataType>string</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_Direction</name>+ <dataType>string</dataType>+ <allowedValueList>+ <allowedValue>Input</allowedValue>+ <allowedValue>Output</allowedValue>+ </allowedValueList>+ </stateVariable>+ <stateVariable sendEvents="yes">+ <name>CurrentConnectionIDs</name>+ <dataType>string</dataType>+ </stateVariable>+ </serviceStateTable>+</scpd>
+ static/UPnP_AV_ContentDirectory_1.0.xml view
@@ -0,0 +1,241 @@+<?xml version="1.0" encoding="utf-8"?>+<scpd xmlns="urn:schemas-upnp-org:service-1-0">+ <specVersion>+ <major>1</major>+ <minor>0</minor>+ </specVersion>+ <actionList>+ <action>+ <name>GetSystemUpdateID</name>+ <argumentList>+ <argument>+ <name>Id</name>+ <direction>out</direction>+ <relatedStateVariable>SystemUpdateID</relatedStateVariable>+ </argument>+ </argumentList>+ </action>+ <action>+ <name>Search</name>+ <argumentList>+ <argument>+ <name>ContainerID</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_ObjectID</relatedStateVariable>+ </argument>+ <argument>+ <name>SearchCriteria</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_SearchCriteria</relatedStateVariable>+ </argument>+ <argument>+ <name>Filter</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_Filter</relatedStateVariable>+ </argument>+ <argument>+ <name>StartingIndex</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_Index</relatedStateVariable>+ </argument>+ <argument>+ <name>RequestedCount</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_Count</relatedStateVariable>+ </argument>+ <argument>+ <name>SortCriteria</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_SortCriteria</relatedStateVariable>+ </argument>+ <argument>+ <name>Result</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_Result</relatedStateVariable>+ </argument>+ <argument>+ <name>NumberReturned</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_Count</relatedStateVariable>+ </argument>+ <argument>+ <name>TotalMatches</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_Count</relatedStateVariable>+ </argument>+ <argument>+ <name>UpdateID</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_UpdateID</relatedStateVariable>+ </argument>+ </argumentList>+ </action>+ <action>+ <name>GetSearchCapabilities</name>+ <argumentList>+ <argument>+ <name>SearchCaps</name>+ <direction>out</direction>+ <relatedStateVariable>SearchCapabilities</relatedStateVariable>+ </argument>+ </argumentList>+ </action>+ <action>+ <name>GetSortCapabilities</name>+ <argumentList>+ <argument>+ <name>SortCaps</name>+ <direction>out</direction>+ <relatedStateVariable>SortCapabilities</relatedStateVariable>+ </argument>+ </argumentList>+ </action>+ <action>+ <name>Browse</name>+ <argumentList>+ <argument>+ <name>ObjectID</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_ObjectID</relatedStateVariable>+ </argument>+ <argument>+ <name>BrowseFlag</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_BrowseFlag</relatedStateVariable>+ </argument>+ <argument>+ <name>Filter</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_Filter</relatedStateVariable>+ </argument>+ <argument>+ <name>StartingIndex</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_Index</relatedStateVariable>+ </argument>+ <argument>+ <name>RequestedCount</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_Count</relatedStateVariable>+ </argument>+ <argument>+ <name>SortCriteria</name>+ <direction>in</direction>+ <relatedStateVariable>A_ARG_TYPE_SortCriteria</relatedStateVariable>+ </argument>+ <argument>+ <name>Result</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_Result</relatedStateVariable>+ </argument>+ <argument>+ <name>NumberReturned</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_Count</relatedStateVariable>+ </argument>+ <argument>+ <name>TotalMatches</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_Count</relatedStateVariable>+ </argument>+ <argument>+ <name>UpdateID</name>+ <direction>out</direction>+ <relatedStateVariable>A_ARG_TYPE_UpdateID</relatedStateVariable>+ </argument>+ </argumentList>+ </action>+ </actionList>+ <serviceStateTable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_SortCriteria</name>+ <dataType>string</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_TransferLength</name>+ <dataType>string</dataType>+ </stateVariable>+ <stateVariable sendEvents="yes">+ <name>TransferIDs</name>+ <dataType>string</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_UpdateID</name>+ <dataType>ui4</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_SearchCriteria</name>+ <dataType>string</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_Filter</name>+ <dataType>string</dataType>+ </stateVariable>+ <stateVariable sendEvents="yes">+ <name>ContainerUpdateIDs</name>+ <dataType>string</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_Result</name>+ <dataType>string</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_Index</name>+ <dataType>ui4</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_TransferID</name>+ <dataType>ui4</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_TagValueList</name>+ <dataType>string</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_URI</name>+ <dataType>uri</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_ObjectID</name>+ <dataType>string</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>SortCapabilities</name>+ <dataType>string</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>SearchCapabilities</name>+ <dataType>string</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_Count</name>+ <dataType>ui4</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_BrowseFlag</name>+ <dataType>string</dataType>+ <allowedValueList>+ <allowedValue>BrowseMetadata</allowedValue>+ <allowedValue>BrowseDirectChildren</allowedValue>+ </allowedValueList>+ </stateVariable>+ <stateVariable sendEvents="yes">+ <name>SystemUpdateID</name>+ <dataType>ui4</dataType>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_TransferStatus</name>+ <dataType>string</dataType>+ <allowedValueList>+ <allowedValue>COMPLETED</allowedValue>+ <allowedValue>ERROR</allowedValue>+ <allowedValue>IN_PROGRESS</allowedValue>+ <allowedValue>STOPPED</allowedValue>+ </allowedValueList>+ </stateVariable>+ <stateVariable sendEvents="no">+ <name>A_ARG_TYPE_TransferTotal</name>+ <dataType>string</dataType>+ </stateVariable>+ </serviceStateTable>+</scpd>
+ static/get-protocol-info.xml view
@@ -0,0 +1,6 @@+<?xml version="1.0" encoding="utf-8"?>+<s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/" s:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">+<s:Body>+<u:GetProtocolInfoResponse xmlns:u="urn:schemas-upnp-org:service:ConnectionManager:1"><Source>http-get:*:image/jpeg:DLNA.ORG_PN=JPEG_SM,http-get:*:image/jpeg:DLNA.ORG_PN=JPEG_MED,http-get:*:image/jpeg:DLNA.ORG_PN=JPEG_LRG,http-get:*:audio/mpeg:DLNA.ORG_PN=MP3,http-get:*:audio/L16:DLNA.ORG_PN=LPCM,http-get:*:video/mpeg:DLNA.ORG_PN=AVC_TS_HD_24_AC3_ISO;SONY.COM_PN=AVC_TS_HD_24_AC3_ISO,http-get:*:video/vnd.dlna.mpeg-tts:DLNA.ORG_PN=AVC_TS_HD_24_AC3;SONY.COM_PN=AVC_TS_HD_24_AC3,http-get:*:video/vnd.dlna.mpeg-tts:DLNA.ORG_PN=AVC_TS_HD_24_AC3_T;SONY.COM_PN=AVC_TS_HD_24_AC3_T,http-get:*:video/vnd.dlna.mpeg-tts:DLNA.ORG_PN=MPEG_PS_PAL,http-get:*:video/vnd.dlna.mpeg-tts:DLNA.ORG_PN=MPEG_PS_NTSC,http-get:*:video/vnd.dlna.mpeg-tts:DLNA.ORG_PN=MPEG_TS_SD_50_L2_T,http-get:*:video/vnd.dlna.mpeg-tts:DLNA.ORG_PN=MPEG_TS_SD_60_L2_T,http-get:*:video/mpeg:DLNA.ORG_PN=MPEG_TS_SD_EU_ISO,http-get:*:video/vnd.dlna.mpeg-tts:DLNA.ORG_PN=MPEG_TS_SD_EU,http-get:*:video/vnd.dlna.mpeg-tts:DLNA.ORG_PN=MPEG_TS_SD_EU_T,http-get:*:video/vnd.dlna.mpeg-tts:DLNA.ORG_PN=MPEG_TS_SD_50_AC3_T,http-get:*:video/mpeg:DLNA.ORG_PN=MPEG_TS_HD_50_L2_ISO;SONY.COM_PN=HD2_50_ISO,http-get:*:video/vnd.dlna.mpeg-tts:DLNA.ORG_PN=MPEG_TS_SD_60_AC3_T,http-get:*:video/mpeg:DLNA.ORG_PN=MPEG_TS_HD_60_L2_ISO;SONY.COM_PN=HD2_60_ISO,http-get:*:video/vnd.dlna.mpeg-tts:DLNA.ORG_PN=MPEG_TS_HD_50_L2_T;SONY.COM_PN=HD2_50_T,http-get:*:video/vnd.dlna.mpeg-tts:DLNA.ORG_PN=MPEG_TS_HD_60_L2_T;SONY.COM_PN=HD2_60_T,http-get:*:video/mpeg:DLNA.ORG_PN=AVC_TS_HD_50_AC3_ISO;SONY.COM_PN=AVC_TS_HD_50_AC3_ISO,http-get:*:video/vnd.dlna.mpeg-tts:DLNA.ORG_PN=AVC_TS_HD_50_AC3;SONY.COM_PN=AVC_TS_HD_50_AC3,http-get:*:video/mpeg:DLNA.ORG_PN=AVC_TS_HD_60_AC3_ISO;SONY.COM_PN=AVC_TS_HD_60_AC3_ISO,http-get:*:video/vnd.dlna.mpeg-tts:DLNA.ORG_PN=AVC_TS_HD_60_AC3;SONY.COM_PN=AVC_TS_HD_60_AC3,http-get:*:video/vnd.dlna.mpeg-tts:DLNA.ORG_PN=AVC_TS_HD_50_AC3_T;SONY.COM_PN=AVC_TS_HD_50_AC3_T,http-get:*:video/vnd.dlna.mpeg-tts:DLNA.ORG_PN=AVC_TS_HD_60_AC3_T;SONY.COM_PN=AVC_TS_HD_60_AC3_T,http-get:*:video/x-mp2t-mphl-188:*,http-get:*:*:*,http-get:*:video/*:*,http-get:*:audio/*:*,http-get:*:image/*:*</Source><Sink></Sink></u:GetProtocolInfoResponse>+</s:Body>+</s:Envelope>
+ static/get-search-capabilities.xml view
@@ -0,0 +1,6 @@+<?xml version="1.0" encoding="utf-8"?>+<s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/" s:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">+<s:Body>+<u:GetSearchCapabilitiesResponse xmlns:u="urn:schemas-upnp-org:service:ContentDirectory:1"><SearchCaps></SearchCaps></u:GetSearchCapabilitiesResponse>+</s:Body>+</s:Envelope>
+ static/get-sort-capabilities.xml view
@@ -0,0 +1,6 @@+<?xml version="1.0" encoding="utf-8"?>+<s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/" s:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">+<s:Body>+<u:GetSortCapabilitiesResponse xmlns:u="urn:schemas-upnp-org:service:ContentDirectory:1"><SortCaps></SortCaps></u:GetSortCapabilitiesResponse>+</s:Body>+</s:Envelope>
+ static/get-system-update-id.xml view
@@ -0,0 +1,8 @@+<?xml version="1.0" encoding="utf-8"?>+<s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/" s:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">+<s:Body>+<u:GetSystemUpdateIDResponse xmlns:u="urn:schemas-upnp-org:service:ContentDirectory:1">+<Id>1</Id>+</u:GetSystemUpdateIDResponse>+</s:Body>+</s:Envelope>
+ static/hoovie.jpg view
binary file changed (absent → 5475 bytes)
+ static/hoovie.png view
binary file changed (absent → 4323 bytes)