diff --git a/hoovie.cabal b/hoovie.cabal --- a/hoovie.cabal +++ b/hoovie.cabal @@ -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, diff --git a/src/Hoovie/Messages.hs b/src/Hoovie/Messages.hs new file mode 100644 --- /dev/null +++ b/src/Hoovie/Messages.hs @@ -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 "" + +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 + diff --git a/src/Hoovie/Monitor.hs b/src/Hoovie/Monitor.hs new file mode 100644 --- /dev/null +++ b/src/Hoovie/Monitor.hs @@ -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 + diff --git a/src/Hoovie/Resource.hs b/src/Hoovie/Resource.hs new file mode 100644 --- /dev/null +++ b/src/Hoovie/Resource.hs @@ -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) + diff --git a/src/Hoovie/SOAP.hs b/src/Hoovie/SOAP.hs new file mode 100644 --- /dev/null +++ b/src/Hoovie/SOAP.hs @@ -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 + + diff --git a/src/Hoovie/SSDP.hs b/src/Hoovie/SSDP.hs new file mode 100644 --- /dev/null +++ b/src/Hoovie/SSDP.hs @@ -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)) + diff --git a/src/Hoovie/Server.hs b/src/Hoovie/Server.hs new file mode 100644 --- /dev/null +++ b/src/Hoovie/Server.hs @@ -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 + diff --git a/src/Hoovie/Stream.hs b/src/Hoovie/Stream.hs new file mode 100644 --- /dev/null +++ b/src/Hoovie/Stream.hs @@ -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) + diff --git a/src/Hoovie/Transcode.hs b/src/Hoovie/Transcode.hs new file mode 100644 --- /dev/null +++ b/src/Hoovie/Transcode.hs @@ -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 + diff --git a/src/Hoovie/Util.hs b/src/Hoovie/Util.hs new file mode 100644 --- /dev/null +++ b/src/Hoovie/Util.hs @@ -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 + diff --git a/static/UPnP_AV_ConnectionManager_1.0.xml b/static/UPnP_AV_ConnectionManager_1.0.xml new file mode 100644 --- /dev/null +++ b/static/UPnP_AV_ConnectionManager_1.0.xml @@ -0,0 +1,182 @@ + + + + 1 + 0 + + + + GetCurrentConnectionInfo + + + ConnectionID + in + A_ARG_TYPE_ConnectionID + + + RcsID + out + A_ARG_TYPE_RcsID + + + AVTransportID + out + A_ARG_TYPE_AVTransportID + + + ProtocolInfo + out + A_ARG_TYPE_ProtocolInfo + + + PeerConnectionManager + out + A_ARG_TYPE_ConnectionManager + + + PeerConnectionID + out + A_ARG_TYPE_ConnectionID + + + Direction + out + A_ARG_TYPE_Direction + + + Status + out + A_ARG_TYPE_ConnectionStatus + + + + + ConnectionComplete + + + ConnectionID + in + A_ARG_TYPE_ConnectionID + + + + + PrepareForConnection + + + RemoteProtocolInfo + in + A_ARG_TYPE_ProtocolInfo + + + PeerConnectionManager + in + A_ARG_TYPE_ConnectionManager + + + PeerConnectionID + in + A_ARG_TYPE_ConnectionID + + + Direction + in + A_ARG_TYPE_Direction + + + ConnectionID + out + A_ARG_TYPE_ConnectionID + + + AVTransportID + out + A_ARG_TYPE_AVTransportID + + + RcsID + out + A_ARG_TYPE_RcsID + + + + + GetProtocolInfo + + + Source + out + SourceProtocolInfo + + + Sink + out + SinkProtocolInfo + + + + + GetCurrentConnectionIDs + + + ConnectionIDs + out + CurrentConnectionIDs + + + + + + + A_ARG_TYPE_ProtocolInfo + string + + + A_ARG_TYPE_ConnectionStatus + string + + OK + ContentFormatMismatch + InsufficientBandwidth + UnreliableChannel + Unknown + + + + SinkProtocolInfo + string + + + A_ARG_TYPE_AVTransportID + i4 + + + A_ARG_TYPE_RcsID + i4 + + + A_ARG_TYPE_ConnectionID + i4 + + + A_ARG_TYPE_ConnectionManager + string + + + SourceProtocolInfo + string + + + A_ARG_TYPE_Direction + string + + Input + Output + + + + CurrentConnectionIDs + string + + + diff --git a/static/UPnP_AV_ContentDirectory_1.0.xml b/static/UPnP_AV_ContentDirectory_1.0.xml new file mode 100644 --- /dev/null +++ b/static/UPnP_AV_ContentDirectory_1.0.xml @@ -0,0 +1,241 @@ + + + + 1 + 0 + + + + GetSystemUpdateID + + + Id + out + SystemUpdateID + + + + + Search + + + ContainerID + in + A_ARG_TYPE_ObjectID + + + SearchCriteria + in + A_ARG_TYPE_SearchCriteria + + + Filter + in + A_ARG_TYPE_Filter + + + StartingIndex + in + A_ARG_TYPE_Index + + + RequestedCount + in + A_ARG_TYPE_Count + + + SortCriteria + in + A_ARG_TYPE_SortCriteria + + + Result + out + A_ARG_TYPE_Result + + + NumberReturned + out + A_ARG_TYPE_Count + + + TotalMatches + out + A_ARG_TYPE_Count + + + UpdateID + out + A_ARG_TYPE_UpdateID + + + + + GetSearchCapabilities + + + SearchCaps + out + SearchCapabilities + + + + + GetSortCapabilities + + + SortCaps + out + SortCapabilities + + + + + Browse + + + ObjectID + in + A_ARG_TYPE_ObjectID + + + BrowseFlag + in + A_ARG_TYPE_BrowseFlag + + + Filter + in + A_ARG_TYPE_Filter + + + StartingIndex + in + A_ARG_TYPE_Index + + + RequestedCount + in + A_ARG_TYPE_Count + + + SortCriteria + in + A_ARG_TYPE_SortCriteria + + + Result + out + A_ARG_TYPE_Result + + + NumberReturned + out + A_ARG_TYPE_Count + + + TotalMatches + out + A_ARG_TYPE_Count + + + UpdateID + out + A_ARG_TYPE_UpdateID + + + + + + + A_ARG_TYPE_SortCriteria + string + + + A_ARG_TYPE_TransferLength + string + + + TransferIDs + string + + + A_ARG_TYPE_UpdateID + ui4 + + + A_ARG_TYPE_SearchCriteria + string + + + A_ARG_TYPE_Filter + string + + + ContainerUpdateIDs + string + + + A_ARG_TYPE_Result + string + + + A_ARG_TYPE_Index + ui4 + + + A_ARG_TYPE_TransferID + ui4 + + + A_ARG_TYPE_TagValueList + string + + + A_ARG_TYPE_URI + uri + + + A_ARG_TYPE_ObjectID + string + + + SortCapabilities + string + + + SearchCapabilities + string + + + A_ARG_TYPE_Count + ui4 + + + A_ARG_TYPE_BrowseFlag + string + + BrowseMetadata + BrowseDirectChildren + + + + SystemUpdateID + ui4 + + + A_ARG_TYPE_TransferStatus + string + + COMPLETED + ERROR + IN_PROGRESS + STOPPED + + + + A_ARG_TYPE_TransferTotal + string + + + diff --git a/static/get-protocol-info.xml b/static/get-protocol-info.xml new file mode 100644 --- /dev/null +++ b/static/get-protocol-info.xml @@ -0,0 +1,6 @@ + + + +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/*:* + + diff --git a/static/get-search-capabilities.xml b/static/get-search-capabilities.xml new file mode 100644 --- /dev/null +++ b/static/get-search-capabilities.xml @@ -0,0 +1,6 @@ + + + + + + diff --git a/static/get-sort-capabilities.xml b/static/get-sort-capabilities.xml new file mode 100644 --- /dev/null +++ b/static/get-sort-capabilities.xml @@ -0,0 +1,6 @@ + + + + + + diff --git a/static/get-system-update-id.xml b/static/get-system-update-id.xml new file mode 100644 --- /dev/null +++ b/static/get-system-update-id.xml @@ -0,0 +1,8 @@ + + + + +1 + + + diff --git a/static/hoovie.jpg b/static/hoovie.jpg new file mode 100644 Binary files /dev/null and b/static/hoovie.jpg differ diff --git a/static/hoovie.png b/static/hoovie.png new file mode 100644 Binary files /dev/null and b/static/hoovie.png differ