diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 8632886..452869b 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -25,6 +25,7 @@ import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe import Crypto.Error (CryptoFailable (..)) import Crypto.PubKey.Ed25519 (PublicKey, publicKey, signature, verify) +import Data.Char import Data.Either (isRight) import Data.HashMap.Strict (HashMap) import Data.Maybe (fromJust) @@ -52,7 +53,7 @@ import qualified Data.ByteString.Lazy as BL (ByteString) import qualified Data.HashMap.Strict as M (lookup, insert) import qualified Yesod.Core.Unsafe as Unsafe --import qualified Data.CaseInsensitive as CI -import Data.Text as T (pack, intercalate, concat) +import qualified Data.Text as T --import qualified Data.Text.Encoding as TE import Network.HTTP.Signature hiding (Algorithm (..)) @@ -621,6 +622,7 @@ instance YesodHttpSig App where toSeconds = toTimeUnit httpVerifySig (Verification malgo (KeyId keyid) input (Signature signature)) = fmap HttpSigVerResult $ runExceptT $ do (host, luKey) <- f2l <$> parseKeyId keyid + checkHost host mluActorHeader <- getActorHeader host manager <- getsYesod appHttpManager (inboxOrVkid, vkd) <- do @@ -702,6 +704,16 @@ instance YesodHttpSig App where case parseFedURI =<< (first displayException . decodeUtf8') k of Left e -> throwE $ "keyId in Sig header isn't a valid FedURI: " ++ e Right u -> return u + checkHost h = do + unless (T.any (== '.') h) $ + throwE "Host doesn't contain periods" + unless (T.any isAsciiLetter h) $ + throwE "Host doesn't contain ASCII letters" + home <- getsYesod $ appInstanceHost . appSettings + when (h == home) $ + throwE "Received HTTP signed request from the instance's host" + where + isAsciiLetter c = isAsciiLower c || isAsciiUpper c getActorHeader host = do bs <- lookupHeaders hActivityPubActor case bs of