diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,24 @@ +Copyright (c) 2012, Peter van den Brand +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. Redistributions in binary + form must reproduce the above copyright notice, this list of conditions and + the following disclaimer in the documentation and/or other materials + provided with the distribution. Neither the name of the owner nor + the names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hoovie.cabal b/hoovie.cabal new file mode 100644 --- /dev/null +++ b/hoovie.cabal @@ -0,0 +1,56 @@ +Name: hoovie +Version: 0.1 +Synopsis: Haskell Media Server +Description: Haskell Media Server +Category: Media +License: BSD3 +License-File: LICENSE +Author: Peter van den Brand +Maintainer: peter@vdbrand.nl +Stability: Experimental +Build-Type: Simple +Cabal-Version: >= 1.6 +Homepage: https://bitbucket.org/pvdbrand/hoovie +Bug-Reports: https://bitbucket.org/pvdbrand/hoovie/issues + +Source-Repository head + Type: mercurial + Location: ssh://hg@bitbucket.org/pvdbrand/hoovie + +Source-Repository this + Type: mercurial + Location: ssh://hg@bitbucket.org/pvdbrand/hoovie + Tag: 0.1 + +Executable hoovie + Hs-Source-Dirs: src + Main-is: Main.hs + GHC-Options: -threaded -Wall -fwarn-tabs -funbox-strict-fields + + Build-Depends: + network-multicast, + time, + old-locale >= 1.0.0, + network >= 2.0, + unix >= 2.0, + xml >= 1.3 && < 2.0, + base >= 4 && < 5.0, + bytestring >= 0.9.1 && < 0.11, + mtl >= 2 && < 3.0, + snap-core >= 0.9.2 && < 0.10, + snap-server >= 0.9.2 && < 0.10, + enumerator >= 0.4.15 && < 0.5, + process >= 1.1.0 && < 1.2, + blaze-builder >= 0.3.1 && < 0.4, + network-info >= 0.2 && < 0.3, + file-embed >= 0.0.4 && < 0.1, + configurator >= 0.2 && < 0.3, + text >= 0.11 && < 1.0, + directory >= 1.1 && < 1.2, + filepath >= 1.3 && < 1.4, + HDBC >= 2.3 && < 2.4, + HDBC-sqlite3 >= 2.3 && < 2.4, + transformers >= 0.3 && < 0.4, + old-time >= 1.1 && < 1.2, + regex-compat >= 0.95 && < 1.0 + diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Network.Socket (withSocketsDo) +import System.Posix.Signals (installHandler, sigPIPE, Handler(Ignore)) +import Data.List (find) +import Data.Maybe (catMaybes) +import Control.Exception (bracket) +import Network.Info (getNetworkInterfaces, NetworkInterface(..), MAC(..), IPv4(..)) +import System.Directory (getUserDocumentsDirectory, getAppUserDataDirectory, createDirectoryIfMissing) +import System.Environment (getArgs) +import System.FilePath (joinPath) + +import qualified Data.Text as T +import qualified Data.Configurator as C +import qualified Data.Configurator.Types as CT + +import Hoovie.Server + +main :: IO () +main = withSocketsDo $ do + _ <- installHandler sigPIPE Ignore Nothing + args <- getArgs + path <- getDefaultPath + db <- getDefaultDatabase + + --files <- listFiles ["/home/peter/movies"] ["avi", "mp4"] + --let x = map (getTitle . fst) files + --putStrLn $ concat $ intersperse "\n" x + + config <- C.load $ [ C.Optional "/etc/hoovie.conf", C.Optional "$(HOME)/.hoovie.conf" ] ++ map C.Required args + port <- C.lookupDefault 8123 config "listen.port" + iface <- C.lookupDefault "auto" config "listen.interface" + paths <- C.lookupDefault path config "paths" + dbFile <- C.lookupDefault db config "database" + + iface' <- case iface of + "auto" -> getDefaultNetworkInterface + iname -> getInterfaceByName iname + case iface' of + Nothing -> do + putStrLn "The network interface does not exist or has no IP address." + putStrLn "Please make sure the network is configured correctly." + Just ni -> do + bracket (startHoovieServer $ HoovieService ni port (toStringList paths) dbFile) + (stopHoovieServer) + (\_ -> getChar >> return ()) + +toStringList :: CT.Value -> [String] +toStringList (CT.List values) = catMaybes $ map CT.convert values +toStringList _ = [] + +getDefaultDatabase :: IO FilePath +getDefaultDatabase = do + path <- getAppUserDataDirectory "hoovie" + createDirectoryIfMissing True path + return $ joinPath [path, "hoovie.db"] + +getDefaultPath :: IO CT.Value +getDefaultPath = do + path <- getUserDocumentsDirectory + return $ CT.List [CT.String $ T.pack path] + +getDefaultNetworkInterface :: IO (Maybe NetworkInterface) +getDefaultNetworkInterface = do + interfaces <- getNetworkInterfaces + return $ find (\i -> mac i /= MAC 0 0 0 0 0 0 && ipv4 i /= IPv4 0) interfaces + +getInterfaceByName :: String -> IO (Maybe NetworkInterface) +getInterfaceByName interface = do + interfaces <- getNetworkInterfaces + return $ find (\i -> name i == interface && mac i /= MAC 0 0 0 0 0 0 && ipv4 i /= IPv4 0) interfaces +