From e8a75a8fdb30111f3feb3d5505787dbdab8a6e1e Mon Sep 17 00:00:00 2001 From: Aditya Manthramurthy Date: Tue, 28 Mar 2017 16:27:23 +0530 Subject: [PATCH] Add bucket and object name validation (#45) --- minio-hs.cabal | 2 + src/Network/Minio/API.hs | 73 ++++++++++++++++++++++++++++------ src/Network/Minio/Errors.hs | 4 +- src/Network/Minio/XmlParser.hs | 6 +-- test/LiveServer.hs | 2 +- test/Network/Minio/API/Test.hs | 50 +++++++++++++++++++++++ test/Spec.hs | 5 ++- 7 files changed, 123 insertions(+), 19 deletions(-) create mode 100644 test/Network/Minio/API/Test.hs diff --git a/minio-hs.cabal b/minio-hs.cabal index e95620d..6075922 100644 --- a/minio-hs.cabal +++ b/minio-hs.cabal @@ -106,6 +106,7 @@ test-suite minio-hs-live-server-test , Network.Minio.S3API , Network.Minio.Sign.V4 , Network.Minio.Utils + , Network.Minio.API.Test , Network.Minio.XmlGenerator , Network.Minio.XmlGenerator.Test , Network.Minio.XmlParser @@ -215,6 +216,7 @@ test-suite minio-hs-test , Network.Minio.S3API , Network.Minio.Sign.V4 , Network.Minio.Utils + , Network.Minio.API.Test , Network.Minio.XmlGenerator , Network.Minio.XmlGenerator.Test , Network.Minio.XmlParser diff --git a/src/Network/Minio/API.hs b/src/Network/Minio/API.hs index 240f830..5a6ad26 100644 --- a/src/Network/Minio/API.hs +++ b/src/Network/Minio/API.hs @@ -22,13 +22,20 @@ module Network.Minio.API , executeRequest , mkStreamRequest , getLocation + + , isValidBucketName + , checkBucketNameValidity + , isValidObjectName + , checkObjectNameValidity ) where import qualified Data.Conduit as C import Data.Conduit.Binary (sourceHandleRange) import Data.Default (def) import qualified Data.Map as Map +import qualified Data.Char as C import qualified Data.Text as T +import qualified Data.ByteString as B import Network.HTTP.Conduit (Response) import qualified Network.HTTP.Conduit as NC import qualified Network.HTTP.Types as HT @@ -87,23 +94,21 @@ discoverRegion ri = runMaybeT $ do buildRequest :: RequestInfo -> Minio NC.Request buildRequest ri = do - {- - If ListBuckets/MakeBucket/GetLocation then use connectRegion ci - Else If discovery off use connectRegion ci - Else { + maybe (return ()) checkBucketNameValidity $ riBucket ri + maybe (return ()) checkObjectNameValidity $ riObject ri - // Here discovery is on - Lookup region in regionMap - If present use that - Else getLocation - } - -} ci <- asks mcConnInfo - region <- if | not $ riNeedsLocation ri -> -- getService/makeBucket/getLocation - -- don't need location + + -- getService/makeBucket/getLocation -- don't need + -- location + region <- if | not $ riNeedsLocation ri -> return $ Just $ connectRegion ci - | not $ connectAutoDiscoverRegion ci -> -- if autodiscovery of location is disabled by user + + -- if autodiscovery of location is disabled by user + | not $ connectAutoDiscoverRegion ci -> return $ Just $ connectRegion ci + + -- discover the region for the request | otherwise -> discoverRegion ri regionHost <- case region of @@ -149,3 +154,45 @@ mkStreamRequest ri = do req <- buildRequest ri mgr <- asks mcConnManager http req mgr + +-- Bucket name validity check according to AWS rules. +isValidBucketName :: Bucket -> Bool +isValidBucketName bucket = + not (or [ len < 3 || len > 63 + , or (map labelCheck labels) + , or (map labelCharsCheck labels) + , isIPCheck + ]) + where + len = T.length bucket + labels = T.splitOn "." bucket + + -- does label `l` fail basic checks of length and start/end? + labelCheck l = T.length l == 0 || T.head l == '-' || T.last l == '-' + + -- does label `l` have non-allowed characters? + labelCharsCheck l = isJust $ T.find (\x -> not (C.isAsciiLower x || + x == '-' || + C.isDigit x)) l + + -- does label `l` have non-digit characters? + labelNonDigits l = isJust $ T.find (not . C.isDigit) l + labelAsNums = map (not . labelNonDigits) labels + + -- check if bucket name looks like an IP + isIPCheck = and labelAsNums && length labelAsNums == 4 + +-- Throws exception iff bucket name is invalid according to AWS rules. +checkBucketNameValidity :: MonadThrow m => Bucket -> m () +checkBucketNameValidity bucket = + when (not $ isValidBucketName bucket) $ + throwM $ MErrVInvalidBucketName bucket + +isValidObjectName :: Object -> Bool +isValidObjectName object = + T.length object > 0 && B.length (encodeUtf8 object) <= 1024 + +checkObjectNameValidity :: MonadThrow m => Object -> m () +checkObjectNameValidity object = + when (not $ isValidObjectName object) $ + throwM $ MErrVInvalidObjectName object diff --git a/src/Network/Minio/Errors.hs b/src/Network/Minio/Errors.hs index ac7a66f..e47b3ff 100644 --- a/src/Network/Minio/Errors.hs +++ b/src/Network/Minio/Errors.hs @@ -34,7 +34,9 @@ data MErrV = MErrVSinglePUTSizeExceeded Int64 | MErrVInvalidSrcObjByteRange (Int64, Int64) | MErrVCopyObjSingleNoRangeAccepted | MErrVRegionNotSupported Text - | MErrXmlParse Text + | MErrVXmlParse Text + | MErrVInvalidBucketName Text + | MErrVInvalidObjectName Text deriving (Show, Eq) instance Exception MErrV diff --git a/src/Network/Minio/XmlParser.hs b/src/Network/Minio/XmlParser.hs index 9015fc9..048e1d0 100644 --- a/src/Network/Minio/XmlParser.hs +++ b/src/Network/Minio/XmlParser.hs @@ -50,12 +50,12 @@ uncurry4 f (a, b, c, d) = f a b c d -- | Parse time strings from XML parseS3XMLTime :: (MonadThrow m) => Text -> m UTCTime -parseS3XMLTime = either (throwM . MErrXmlParse) return +parseS3XMLTime = either (throwM . MErrVXmlParse) return . parseTimeM True defaultTimeLocale s3TimeFormat . T.unpack parseDecimal :: (MonadThrow m, Integral a) => Text -> m a -parseDecimal numStr = either (throwM . MErrXmlParse . show) return $ fst <$> decimal numStr +parseDecimal numStr = either (throwM . MErrVXmlParse . show) return $ fst <$> decimal numStr parseDecimals :: (MonadThrow m, Integral a) => [Text] -> m [a] parseDecimals numStr = forM numStr parseDecimal @@ -64,7 +64,7 @@ s3Elem :: Text -> Axis s3Elem = element . s3Name parseRoot :: (MonadThrow m) => LByteString -> m Cursor -parseRoot = either (throwM . MErrXmlParse . show) (return . fromDocument) +parseRoot = either (throwM . MErrVXmlParse . show) (return . fromDocument) . parseLBS def -- | Parse the response XML of a list buckets call. diff --git a/test/LiveServer.hs b/test/LiveServer.hs index d280291..6e16cc2 100644 --- a/test/LiveServer.hs +++ b/test/LiveServer.hs @@ -111,7 +111,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server" step "makeBucket with an invalid bucket name and check for appropriate exception." invalidMBE <- MC.try $ makeBucket "invalidBucketName" Nothing case invalidMBE of - Left exn -> liftIO $ exn @?= InvalidBucketName + Left exn -> liftIO $ exn @?= MErrVInvalidBucketName "invalidBucketName" _ -> return () step "getLocation works" diff --git a/test/Network/Minio/API/Test.hs b/test/Network/Minio/API/Test.hs new file mode 100644 index 0000000..e6a8a74 --- /dev/null +++ b/test/Network/Minio/API/Test.hs @@ -0,0 +1,50 @@ +-- +-- Minio Haskell SDK, (C) 2017 Minio, Inc. +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- + +module Network.Minio.API.Test + ( bucketNameValidityTests + , objectNameValidityTests + ) where + +import Test.Tasty +import Test.Tasty.HUnit + +import Lib.Prelude + +import Network.Minio.API + +assertBool' = assertBool "Test failed!" + +bucketNameValidityTests :: TestTree +bucketNameValidityTests = testGroup "Bucket Name Validity Tests" + [ testCase "Too short 1" $ assertBool' $ not $ isValidBucketName "" + , testCase "Too short 2" $ assertBool' $ not $ isValidBucketName "ab" + , testCase "Too long 1" $ assertBool' $ not $ isValidBucketName "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , testCase "Has upper case" $ assertBool' $ not $ isValidBucketName "ABCD" + , testCase "Has punctuation" $ assertBool' $ not $ isValidBucketName "abc,2" + , testCase "Has hyphen at end" $ assertBool' $ not $ isValidBucketName "abc-" + , testCase "Has consecutive dot" $ assertBool' $ not $ isValidBucketName "abck..eedg" + , testCase "Looks like IP" $ assertBool' $ not $ isValidBucketName "10.0.0.1" + , testCase "Valid bucket name 1" $ assertBool' $ isValidBucketName "abcd.pqeq.rea" + , testCase "Valid bucket name 2" $ assertBool' $ isValidBucketName "abcdedgh1d" + , testCase "Valid bucket name 3" $ assertBool' $ isValidBucketName "abc-de-dg-h1d" + ] + +objectNameValidityTests :: TestTree +objectNameValidityTests = testGroup "Object Name Validity Tests" + [ testCase "Empty name" $ assertBool' $ not $ isValidObjectName "" + , testCase "Has unicode characters" $ assertBool' $ isValidObjectName "日本国" + ] diff --git a/test/Spec.hs b/test/Spec.hs index ead94d7..25b5a73 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -21,6 +21,7 @@ import qualified Data.List as L import Lib.Prelude +import Network.Minio.API.Test import Network.Minio.PutObject import Network.Minio.XmlGenerator.Test import Network.Minio.XmlParser.Test @@ -110,4 +111,6 @@ qcProps = testGroup "(checked by QuickCheck)" ] unitTests :: TestTree -unitTests = testGroup "Unit tests" [xmlGeneratorTests, xmlParserTests] +unitTests = testGroup "Unit tests" [xmlGeneratorTests, xmlParserTests, + bucketNameValidityTests, + objectNameValidityTests]