sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2025-01-01 09:14:51 +09:00
Code Issues Activity

Do some checks on the host in FedURI parsing

Browse source 
Until now, there were some simple host checks when verifying the HTTP sig,
meant to forbid hosts that are IP addresses, local hosts, and maybe other weird
cases. These checks moved to Network.FedURI, so now FedURIs in general aren't
allowed to have such hosts. The host type is still `Text` though, for now.
This commit is contained in:
fr33domlover 2019-04-28 09:47:32 +00:00
parent 342467297a
commit 1fcec035f0
2 changed files with 10 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
src/Network/FedURI.hs
View file

@ -38,6 +38,7 @@ import Prelude
import Control.Monad ((<=<)) import Control.Monad ((<=<))
import Data.Aeson import Data.Aeson
import Data.Bifunctor (bimap, first) import Data.Bifunctor (bimap, first)
import Data.Char
import Data.Hashable import Data.Hashable
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Text (Text) import Data.Text (Text)
@ -53,6 +54,7 @@ import qualified Data.Text as T (pack, unpack, stripPrefix)
-- * The scheme is HTTPS -- * The scheme is HTTPS
-- * The authority part is present -- * The authority part is present
-- * The authority part doesn't have userinfo -- * The authority part doesn't have userinfo
-- * The authority host needs to match certain rules
-- * The authority part doesn't have a port number -- * The authority part doesn't have a port number
-- * There is no query part -- * There is no query part
-- * A fragment part may be present -- * A fragment part may be present
@ -96,6 +98,12 @@ parseFedURI t = do
if p == "" if p == ""
then Right () then Right ()
else Left "URI has non-empty port" else Left "URI has non-empty port"
if any (== '.') h
then Right ()
else Left "Host doesn't contain periods"
if any isAsciiLetter h
then Right ()
else Left "Host doesn't contain ASCII letters"
if uriQuery uri == "" if uriQuery uri == ""
then Right () then Right ()
else Left "URI query is non-empty" else Left "URI query is non-empty"
@ -104,6 +112,8 @@ parseFedURI t = do
, furiPath = T.pack $ uriPath uri , furiPath = T.pack $ uriPath uri
, furiFragment = T.pack $ uriFragment uri , furiFragment = T.pack $ uriFragment uri
} }
where
isAsciiLetter c = isAsciiLower c || isAsciiUpper c
toURI :: FedURI -> URI toURI :: FedURI -> URI
toURI (FedURI h p f) = URI toURI (FedURI h p f) = URI

4
src/Vervis/Foundation.hs
View file

@ -777,10 +777,6 @@ instance YesodHttpSig App where
Left e -> throwE $ "keyId in Sig header isn't a valid FedURI: " ++ e Left e -> throwE $ "keyId in Sig header isn't a valid FedURI: " ++ e
Right u -> return u Right u -> return u
checkHost h = do 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 home <- getsYesod $ appInstanceHost . appSettings
when (h == home) $ when (h == home) $
throwE "Received HTTP signed request from the instance's host" throwE "Received HTTP signed request from the instance's host"