{-|
Module      : Network.Gopher.Util
Stability   : experimental
Portability : POSIX

Helper utilities used within the library and the server which also could be useful for other application code.
-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Gopher.Util (
  -- * Security
    sanitizePath
  , sanitizeIfNotUrl
  , dropPrivileges
  -- * String Encoding
  , asciiOrd
  , asciiChr
  , asciiToLower
  , uEncode
  , uDecode
  -- * Misc Helpers
  , stripNewline
  , boolToMaybe
  ) where

import Data.ByteString (ByteString ())
import qualified Data.ByteString as B
import Data.Char (ord, chr, toLower)
import qualified Data.String.UTF8 as U
import Data.Word (Word8 ())
import System.FilePath.Posix.ByteString (RawFilePath, normalise, joinPath, splitPath)
import System.Posix.User

-- | 'chr' a 'Word8'
asciiChr :: Word8 -> Char
asciiChr :: Word8 -> Char
asciiChr = Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | 'ord' a 'Word8'
asciiOrd :: Char -> Word8
asciiOrd :: Char -> Word8
asciiOrd = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

-- | Transform a 'Word8' to lowercase if the solution is in bounds.
asciiToLower :: Word8 -> Word8
asciiToLower :: Word8 -> Word8
asciiToLower Word8
w =
  if Int -> Bool
forall a. (Ord a, Num a) => a -> Bool
inBounds Int
lower
    then Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lower
    else Word8
w
  where inBounds :: a -> Bool
inBounds a
i = a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
forall a. Bounded a => a
minBound :: Word8) Bool -> Bool -> Bool
&&
          a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
forall a. Bounded a => a
maxBound :: Word8)
        lower :: Int
        lower :: Int
lower = Char -> Int
ord (Char -> Int) -> (Word8 -> Char) -> Word8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toLower (Char -> Char) -> (Word8 -> Char) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
asciiChr (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
w

-- | Encode a 'String' to a UTF-8 'ByteString'
uEncode :: String -> ByteString
uEncode :: String -> ByteString
uEncode = [Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> (String -> [Word8]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Word8]
U.encode

-- | Decode a UTF-8 'ByteString' to a 'String'
uDecode :: ByteString -> String
uDecode :: ByteString -> String
uDecode = (String, [(Error, Int)]) -> String
forall a b. (a, b) -> a
fst ((String, [(Error, Int)]) -> String)
-> (ByteString -> (String, [(Error, Int)])) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> (String, [(Error, Int)])
U.decode ([Word8] -> (String, [(Error, Int)]))
-> (ByteString -> [Word8])
-> ByteString
-> (String, [(Error, Int)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack

-- | Strip @\\r@ and @\\n@ from 'ByteString's
stripNewline :: ByteString -> ByteString
stripNewline :: ByteString -> ByteString
stripNewline ByteString
s
  | ByteString -> Bool
B.null ByteString
s           = ByteString
B.empty
  | ByteString -> Word8
B.head ByteString
s Word8 -> [Word8] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
    ((Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) String
"\n\r") = ByteString -> ByteString
stripNewline (ByteString -> ByteString
B.tail ByteString
s)
  | Bool
otherwise          = ByteString -> Word8
B.head ByteString
s Word8 -> ByteString -> ByteString
`B.cons` ByteString -> ByteString
stripNewline (ByteString -> ByteString
B.tail ByteString
s)

-- | Normalise a path and prevent <https://en.wikipedia.org/wiki/Directory_traversal_attack directory traversal attacks>.
sanitizePath :: RawFilePath -> RawFilePath
sanitizePath :: ByteString -> ByteString
sanitizePath = [ByteString] -> ByteString
joinPath
  ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ByteString
p -> ByteString
p ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
".." Bool -> Bool -> Bool
&& ByteString
p ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
".")
  ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
splitPath (ByteString -> [ByteString])
-> (ByteString -> ByteString) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
normalise

-- | Use 'sanitizePath' except if the path starts with @URL:@
--   in which case the original string is returned.
sanitizeIfNotUrl :: RawFilePath -> RawFilePath
sanitizeIfNotUrl :: ByteString -> ByteString
sanitizeIfNotUrl ByteString
path =
  if ByteString
"URL:" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
path
    then ByteString
path
    else ByteString -> ByteString
sanitizePath ByteString
path

-- | prop> boolToMaybe True x == Just x
--   prop> boolToMaybe False x == Nothing
boolToMaybe :: Bool -> a -> Maybe a
boolToMaybe :: Bool -> a -> Maybe a
boolToMaybe Bool
True  a
a = a -> Maybe a
forall a. a -> Maybe a
Just a
a
boolToMaybe Bool
False a
_ = Maybe a
forall a. Maybe a
Nothing

-- | Call 'setGroupID' and 'setUserID' to switch to
--   the given user and their primary group.
--   Requires special privileges.
--   Will raise an exception if either the user
--   does not exist or the current user has no
--   permission to change UID/GID.
dropPrivileges :: String -> IO ()
dropPrivileges :: String -> IO ()
dropPrivileges String
username = do
  UserEntry
user <- String -> IO UserEntry
getUserEntryForName String
username
  GroupID -> IO ()
setGroupID (GroupID -> IO ()) -> GroupID -> IO ()
forall a b. (a -> b) -> a -> b
$ UserEntry -> GroupID
userGroupID UserEntry
user
  UserID -> IO ()
setUserID (UserID -> IO ()) -> UserID -> IO ()
forall a b. (a -> b) -> a -> b
$ UserEntry -> UserID
userID UserEntry
user