move file
This commit is contained in:
parent
95a2ef910e
commit
1809a0d13a
111
Gemini.hs
111
Gemini.hs
|
@ -1,111 +0,0 @@
|
|||
module Gemini where
|
||||
|
||||
import Data.ByteString.UTF8
|
||||
import Data.Text
|
||||
import Network.Mime
|
||||
import System.Directory (doesFileExist, doesDirectoryExist)
|
||||
import Text.Regex
|
||||
import Text.Regex.PCRE
|
||||
import Control.Exception
|
||||
|
||||
|
||||
getFile :: FilePath -> IO (Maybe String)
|
||||
getFile s = do
|
||||
result <- try (readFile s) :: IO (Either SomeException String)
|
||||
case result of
|
||||
Left ex -> return Nothing
|
||||
Right ex -> return (pure ex)
|
||||
|
||||
-- return components of the url
|
||||
-- gemini:// | hostname | uri | ? | query
|
||||
parse_url :: String -> [[String]]
|
||||
parse_url url =
|
||||
(sanitize_uri url) =~ "^(gemini:\\/\\/)([^\\/]*)\\/?([^\\?]*)(\\?)?(.*)?(\\r\\n)$"
|
||||
|
||||
-- remove any .. in the uri that could escape the location
|
||||
sanitize_uri :: String -> String
|
||||
sanitize_uri path =
|
||||
subRegex (mkRegex "\\.\\.\\/") path ""
|
||||
|
||||
|
||||
-- return a file as a string
|
||||
read_file :: String -> IO String
|
||||
read_file path = do
|
||||
text <- readFile path
|
||||
pure text
|
||||
|
||||
-- read from stdin
|
||||
get_request :: IO String
|
||||
get_request = do
|
||||
stdin <- getContents
|
||||
pure stdin
|
||||
|
||||
data Gemini = MkGemini
|
||||
{ domain :: String
|
||||
, file :: String
|
||||
, query :: String
|
||||
}
|
||||
|
||||
data Answer = MkAnswer
|
||||
{ code :: Int
|
||||
, lang :: String
|
||||
, content :: String
|
||||
, mime :: String
|
||||
}
|
||||
|
||||
get_mime :: String -> String
|
||||
get_mime filename
|
||||
| (fileNameExtensions (pack filename)) == [(pack "gmi" :: Extension)] = "text/gemini"
|
||||
| (fileNameExtensions (pack filename)) == [(pack "gemini" :: Extension)] = "text/gemini"
|
||||
| otherwise = (toString (defaultMimeLookup (pack filename)))
|
||||
|
||||
|
||||
parse_to_gemini :: [[String]] -> Gemini
|
||||
parse_to_gemini tab =
|
||||
MkGemini
|
||||
{ domain = tab!!0!!2
|
||||
, file = tab!!0!!3
|
||||
, query = tab!!0!!5
|
||||
}
|
||||
|
||||
create_answer :: Gemini -> String -> String -> IO Answer
|
||||
create_answer (MkGemini domain file query) language basedir = do
|
||||
content <- getFile $ basedir ++ file
|
||||
case content of
|
||||
Just x -> return (MkAnswer
|
||||
{ code = 20
|
||||
, lang = language
|
||||
, mime = get_mime file
|
||||
, content = x
|
||||
})
|
||||
Nothing -> do
|
||||
content' <- getFile $ basedir ++ file ++ "index.gmi"
|
||||
case content' of
|
||||
Just y -> return (MkAnswer
|
||||
{ code = 20
|
||||
, lang = language
|
||||
, mime = get_mime $ file ++ "index.gmi"
|
||||
, content = y
|
||||
})
|
||||
Nothing -> do
|
||||
isdir <- doesDirectoryExist $ basedir ++ file
|
||||
if isdir
|
||||
then return (MkAnswer
|
||||
{ code = 31
|
||||
, lang = ""
|
||||
, mime = "/" ++ file ++ "/"
|
||||
, content = ""
|
||||
})
|
||||
else return (MkAnswer
|
||||
{ code = 50
|
||||
, lang = language
|
||||
, mime = ""
|
||||
, content = "error ici " ++ basedir ++ file ++ "/index.gmi"
|
||||
})
|
||||
|
||||
make_reply :: Answer -> String
|
||||
make_reply (MkAnswer code lang content mime)
|
||||
| lang /= "" = (show code) ++ " " ++ mime ++ "; lang=" ++ lang ++ " \r\n"
|
||||
| code == 20 && lang == "" = (show code) ++ " " ++ mime ++ "; \r\n"
|
||||
| code == 31 = "31 " ++ mime ++ "\r\n"
|
||||
| otherwise = "50\r\n"
|
Loading…
Reference in New Issue