{-|
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | 'ord' a 'Word8'
asciiOrd :: Char -> Word8
asciiOrd :: Char -> Word8
asciiOrd = forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 forall {a}. (Ord a, Num a) => a -> Bool
inBounds Int
lower
    then forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lower
    else Word8
w
  where inBounds :: a -> Bool
inBounds a
i = a
i forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: Word8) Bool -> Bool -> Bool
&&
          a
i forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word8)
        lower :: Int
        lower :: Int
lower = Char -> Int
ord forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
asciiChr forall a b. (a -> b) -> a -> b
$ Word8
w

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

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

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

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

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

-- | prop> boolToMaybe True x == Just x
--   prop> boolToMaybe False x == Nothing
boolToMaybe :: Bool -> a -> Maybe a
boolToMaybe :: forall a. Bool -> a -> Maybe a
boolToMaybe Bool
True  a
a = forall a. a -> Maybe a
Just a
a
boolToMaybe Bool
False 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 :: [Char] -> IO ()
dropPrivileges [Char]
username = do
  UserEntry
user <- [Char] -> IO UserEntry
getUserEntryForName [Char]
username
  GroupID -> IO ()
setGroupID forall a b. (a -> b) -> a -> b
$ UserEntry -> GroupID
userGroupID UserEntry
user
  UserID -> IO ()
setUserID forall a b. (a -> b) -> a -> b
$ UserEntry -> UserID
userID UserEntry
user