hadoop-tools 0.2 → 0.3
raw patch · 2 files changed
+268/−243 lines, 2 filesdep +attoparsecdep +exceptionsdep +hadoop-rpcdep −cerealdep −cereal-conduitdep −conduit
Dependencies added: attoparsec, exceptions, hadoop-rpc, vector
Dependencies removed: cereal, cereal-conduit, conduit, conduit-extra, directory, network, network-simple, socks, unix, unordered-containers, xmlhtml
Files
- hadoop-tools.cabal +19/−22
- src/Main.hs +249/−221
hadoop-tools.cabal view
@@ -1,14 +1,15 @@-name: hadoop-tools-version: 0.2-synopsis: Tools for working with Hadoop.-description: Tools for working with Hadoop.-license: Apache-2.0-license-file: LICENSE-author: Jacob Stanley, Conrad Parker-maintainer: Jacob Stanley <jacob@stanley.io>-category: Data-build-type: Simple-cabal-version: >= 1.10+name: hadoop-tools+version: 0.3+synopsis: Fast command line tools for working with Hadoop.+description: Fast command line tools for working with Hadoop.+homepage: http://github.com/jystic/hadoop-tools+license: Apache-2.0+license-file: LICENSE+author: Jacob Stanley, Conrad Parker+maintainer: Jacob Stanley <jacob@stanley.io>+category: Data+build-type: Simple+cabal-version: >= 1.10 executable hh default-language: Haskell2010@@ -16,30 +17,26 @@ main-is: Main.hs hs-source-dirs: src + ghc-options: -funbox-strict-fields+ ghc-prof-options: -auto-all -caf-all+ other-modules: Paths_hadoop_tools build-depends: base >= 4.7 && < 5+ , attoparsec >= 0.12 , boxes >= 0.1 , bytestring >= 0.10- , cereal >= 0.4- , cereal-conduit >= 0.7- , conduit >= 1.2- , conduit-extra >= 1.1 , configurator >= 0.3- , directory >= 1.2+ , exceptions >= 0.6 , filepath >= 1.3- , network >= 2.5- , network-simple >= 0.4+ , hadoop-rpc >= 0.1 , old-locale >= 1.0 , optparse-applicative >= 0.10 , protobuf >= 0.2.0.4- , socks >= 0.5 , split >= 0.2 , text >= 1.1 , time >= 1.4 , transformers >= 0.4- , unix >= 2.7- , unordered-containers >= 0.2- , xmlhtml >= 0.2.3.2+ , vector >= 0.10
src/Main.hs view
@@ -3,43 +3,38 @@ module Main (main) where -import Control.Exception (SomeException, handle, throwIO)+import Control.Exception (SomeException, bracket) import Control.Monad+import Control.Monad.Catch (handle, throwM) import Control.Monad.IO.Class (MonadIO, liftIO)-+import qualified Data.Attoparsec.ByteString.Char8 as Atto import Data.Bits ((.&.), shiftR)+import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B+import Data.Char (ord) import Data.Foldable (foldMap)-import qualified Data.HashMap.Lazy as H-import Data.List (intercalate)-import Data.List (isPrefixOf)-import Data.List.Split (splitOn)-import Data.Maybe (fromMaybe, maybeToList, mapMaybe, listToMaybe)-import Data.Text (Text)+import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T-import qualified Data.Text.Read as T import Data.Time import Data.Time.Clock.POSIX+import qualified Data.Vector as V import Data.Word (Word16, Word32, Word64) import qualified Data.Configurator as C import Data.Configurator.Types (Worth(..))-import System.Environment (getEnv, lookupEnv)+import System.Environment (getEnv) import System.FilePath.Posix+import System.IO import System.IO.Unsafe (unsafePerformIO) import System.Locale (defaultTimeLocale)-import System.Posix.User (getEffectiveUserName)-import Text.PrettyPrint.Boxes hiding ((<>))-import Text.XmlHtml--import Data.Conduit (handleC)-import Data.ProtocolBuffers-import Data.ProtocolBuffers.Orphans ()+import Text.PrettyPrint.Boxes hiding ((<>), (//)) -import Hadoop.Protobuf.Hdfs-import Hadoop.Rpc+import Data.Hadoop.Configuration (getHadoopConfig)+import Data.Hadoop.Types+import Network.Hadoop.Hdfs hiding (runHdfs)+import Network.Hadoop.Read import Options.Applicative hiding (Success) @@ -51,19 +46,31 @@ main :: IO () main = do cmd <- execParser optsParser- handle printError (runRemote cmd)+ case cmd of+ SubIO io -> io+ SubHdfs hdfs -> handle printError (runHdfs hdfs) where optsParser = info (helper <*> options) (fullDesc <> header "hh - Blazing fast interaction with HDFS") -runRemote :: Remote a -> IO a-runRemote remote = do+runHdfs :: Hdfs a -> IO a+runHdfs hdfs = do+ config <- getConfig+ runHdfs' config hdfs++getConfig :: IO HadoopConfig+getConfig = do hdfsUser <- getHdfsUser nameNode <- getNameNode socksProxy <- getSocksProxy - let run = maybe runTcp runSocks socksProxy- run nameNode hdfsUser remote+ liftM ( set hdfsUser (\c x -> c { hcUser = x })+ . set nameNode (\c x -> c { hcNameNodes = [x] })+ . set socksProxy (\c x -> c { hcProxy = Just x })+ ) getHadoopConfig+ where+ set :: Maybe a -> (b -> a -> b) -> b -> b+ set m f c = maybe c (f c) m ------------------------------------------------------------------------ @@ -73,33 +80,15 @@ return (home </> ".hh") {-# NOINLINE configPath #-} -getHdfsUser :: IO User-getHdfsUser = attempt [fromEnv, fromCfg] fromUnix- where- fromEnv :: IO (Maybe User)- fromEnv = fmap T.pack <$> lookupEnv "HADOOP_USER_NAME"-- fromCfg :: IO (Maybe User)- fromCfg = C.load [Optional configPath] >>= flip C.lookup "hdfs.user"-- fromUnix :: IO User- fromUnix = T.pack <$> getEffectiveUserName--getNameNode :: IO NameNode-getNameNode = attempt [fromHadoopCfg, fromUserCfg] explode- where- fromHadoopCfg :: IO (Maybe NameNode)- fromHadoopCfg = listToMaybe . maybe [] id <$> readHadoopNameNodes-- fromUserCfg :: IO (Maybe NameNode)- fromUserCfg = do- cfg <- C.load [Optional configPath]- host <- C.lookup cfg "namenode.host"- port <- C.lookupDefault 8020 cfg "namenode.port"- return (Endpoint <$> host <*> pure port)+getHdfsUser :: IO (Maybe User)+getHdfsUser = C.load [Optional configPath] >>= flip C.lookup "hdfs.user" - explode :: IO a- explode = error $ "could not find namenode details in /etc/hadoop/conf/ or " <> configPath+getNameNode :: IO (Maybe NameNode)+getNameNode = do+ cfg <- C.load [Optional configPath]+ host <- C.lookup cfg "namenode.host"+ port <- C.lookupDefault 8020 cfg "namenode.port"+ return (Endpoint <$> host <*> pure port) getSocksProxy :: IO (Maybe SocksProxy) getSocksProxy = do@@ -109,100 +98,42 @@ Nothing -> return Nothing Just host -> Just . Endpoint host <$> C.lookupDefault 1080 cfg "proxy.port" -attempt :: Monad m => [m (Maybe a)] -> m a -> m a-attempt [] def = def-attempt (io:ios) def = io >>= \mx -> case mx of- Just x -> return x- Nothing -> attempt ios def- ------------------------------------------------------------------------ -type HadoopConfig = H.HashMap Text Text--readHadoopNameNodes :: IO (Maybe [NameNode])-readHadoopNameNodes = do- cfg <- H.union <$> readHadoopConfig "/etc/hadoop/conf/core-site.xml"- <*> readHadoopConfig "/etc/hadoop/conf/hdfs-site.xml"- return $ resolveNameNode cfg <$> (stripProto =<< H.lookup fsDefaultNameKey cfg)- where- proto = "hdfs://"- fsDefaultNameKey = "fs.defaultFS"- nameNodesPrefix = "dfs.ha.namenodes."- rpcAddressPrefix = "dfs.namenode.rpc-address."-- stripProto :: Text -> Maybe Text- stripProto uri | proto `T.isPrefixOf` uri = Just (T.drop (T.length proto) uri)- | otherwise = Nothing-- resolveNameNode :: HadoopConfig -> Text -> [NameNode]- resolveNameNode cfg name = case parseEndpoint name of- Just ep -> [ep] -- contains "host:port" directly- Nothing -> mapMaybe (\nn -> lookupAddress cfg $ name <> "." <> nn)- (lookupNameNodes cfg name)-- lookupNameNodes :: HadoopConfig -> Text -> [Text]- lookupNameNodes cfg name = maybe [] id- $ T.splitOn "," <$> H.lookup (nameNodesPrefix <> name) cfg-- lookupAddress :: HadoopConfig -> Text -> Maybe Endpoint- lookupAddress cfg name = parseEndpoint =<< H.lookup (rpcAddressPrefix <> name) cfg-- parseEndpoint :: Text -> Maybe Endpoint- parseEndpoint ep = Endpoint host <$> port- where- host = T.takeWhile (/= ':') ep- port = either (const Nothing) (Just . fst)- $ T.decimal $ T.drop (T.length host + 1) ep--readHadoopConfig :: FilePath -> IO HadoopConfig-readHadoopConfig path = do- exml <- parseXML path <$> B.readFile path- case exml of- Left _ -> return H.empty- Right xml -> return (toHashMap (docContent xml))- where- toHashMap = H.fromList . mapMaybe fromNode- . concatMap (descendantElementsTag "property")-- fromNode n = (,) <$> (nodeText <$> childElementTag "name" n)- <*> (nodeText <$> childElementTag "value" n)--------------------------------------------------------------------------- workingDirConfigPath :: FilePath workingDirConfigPath = unsafePerformIO $ do home <- getEnv "HOME" return (home </> ".hhwd") {-# NOINLINE workingDirConfigPath #-} -getDefaultWorkingDir :: MonadIO m => m FilePath-getDefaultWorkingDir = liftIO $ (("/user" </>) . T.unpack) <$> getHdfsUser+getDefaultWorkingDir :: MonadIO m => m HdfsPath+getDefaultWorkingDir = liftIO $ (("/user" //) . T.encodeUtf8 . hcUser) <$> getConfig -getWorkingDir :: MonadIO m => m FilePath+getWorkingDir :: MonadIO m => m HdfsPath getWorkingDir = liftIO $ handle onError- $ T.unpack . T.takeWhile (/= '\n')- <$> T.readFile workingDirConfigPath+ $ B.takeWhile (/= '\n')+ <$> B.readFile workingDirConfigPath where- onError :: SomeException -> IO FilePath+ onError :: SomeException -> IO HdfsPath onError = const getDefaultWorkingDir -setWorkingDir :: MonadIO m => FilePath -> m ()-setWorkingDir path = liftIO $ T.writeFile workingDirConfigPath- $ T.pack path <> "\n"+setWorkingDir :: MonadIO m => HdfsPath -> m ()+setWorkingDir path = liftIO $ B.writeFile workingDirConfigPath+ $ path <> "\n" -getAbsolute :: MonadIO m => FilePath -> m FilePath+getAbsolute :: MonadIO m => HdfsPath -> m HdfsPath getAbsolute path = liftIO (normalizePath <$> getPath) where- getPath = if "/" `isPrefixOf` path+ getPath = if "/" `B.isPrefixOf` path then return path- else getWorkingDir >>= \pwd -> return (pwd </> path)+ else getWorkingDir >>= \pwd -> return (pwd // path) -normalizePath :: FilePath -> FilePath-normalizePath = intercalate "/" . dropAbsParentDir . splitOn "/"+normalizePath :: HdfsPath -> HdfsPath+normalizePath = B.intercalate "/" . dropAbsParentDir . B.split '/' -dropAbsParentDir :: [FilePath] -> [FilePath]+dropAbsParentDir :: [HdfsPath] -> [HdfsPath] dropAbsParentDir [] = error "dropAbsParentDir: not an absolute path"-dropAbsParentDir (p : ps) = p : (reverse $ fst $ go [] ps)+dropAbsParentDir (p : ps) = p : reverse (fst $ go [] ps) where go [] (".." : ys) = go [] ys go (_ : xs) (".." : ys) = go xs ys@@ -212,21 +143,28 @@ ------------------------------------------------------------------------ data SubCommand = SubCommand- { subName :: String+ { subName :: String , subDescription :: String- , subMethod :: Parser (Remote ())+ , subMethod :: Parser SubMethod } -sub :: SubCommand -> Mod CommandFields (Remote ())+data SubMethod = SubIO (IO ())+ | SubHdfs (Hdfs ())++sub :: SubCommand -> Mod CommandFields SubMethod sub SubCommand{..} = command subName (info subMethod $ progDesc subDescription) -options :: Parser (Remote ())+options :: Parser SubMethod options = subparser (foldMap sub allSubCommands) allSubCommands :: [SubCommand] allSubCommands =- [ subChDir+ [ subCat+ , subChDir+ , subChMod , subDiskUsage+ -- , subFind+ , subGet , subList , subMkDir , subPwd@@ -241,83 +179,151 @@ completeDir :: Mod ArgumentFields a completeDir = completer (fileCompletion (== Dir)) <> metavar "DIRECTORY" +bstr :: Monad m => String -> m ByteString+bstr x = B.pack `liftM` str x++subCat :: SubCommand+subCat = SubCommand "cat" "Print the contents of a file to stdout" go+ where+ go = cat <$> many (argument bstr (completePath <> help "the file to cat"))+ cat paths = SubHdfs $ mapM_ (hdfsCat <=< getAbsolute) paths+ subChDir :: SubCommand subChDir = SubCommand "cd" "Change working directory" go where- go = cd <$> optional (argument str (completeDir <> help "the directory to change to"))- cd mpath = do+ go = cd <$> optional (argument bstr (completeDir <> help "the directory to change to"))+ cd mpath = SubHdfs $ do path <- getAbsolute =<< maybe getDefaultWorkingDir return mpath- mls <- getListing path- liftIO $ case mls of- Nothing -> putStrLn $ "Directory does not exist: " <> path- Just _ -> setWorkingDir path+ _ <- getListingOrFail path+ setWorkingDir path +subChMod :: SubCommand+subChMod = SubCommand "chmod" "Change permissions" go+ where+ go = chmod <$> argument bstr (help "permissions mode")+ <*> argument bstr (completeDir <> help "the file/directory to chmod")+ chmod modeS path = either+ (\_ -> error $ "Unknown mode" ++ B.unpack modeS)+ (\mode -> SubHdfs $ modifyPerms mode path)+ (Atto.parseOnly parseMode modeS)++ parseMode = octal++ octal :: Atto.Parser Word16+ octal = B.foldl' step 0 `fmap` Atto.takeWhile1 isDig+ where+ isDig w = w >= '0' && w <= '7'+ step a w = a * 8 + fromIntegral (ord w - 48)++ modifyPerms :: Word16 -> HdfsPath -> Hdfs ()+ modifyPerms mode path = do+ absPath <- getAbsolute path+ info <- getFileInfo absPath+ case info of+ Nothing -> fail $ unwords ["No such file", B.unpack absPath]+ Just FileStatus{..} -> do+ {-+ liftIO . putStrLn . unwords $ ["Setting perms on", B.unpack absPath]+ liftIO . putStrLn . unwords $ ["OLD:", formatMode fsFileType fsPermission]+ liftIO . putStrLn . unwords $ ["NEW:", formatMode fsFileType mode]+ -}+ setPermissions (fromIntegral mode) absPath+ subDiskUsage :: SubCommand subDiskUsage = SubCommand "du" "Show the amount of space used by file or directory" go where- go = du <$> optional (argument str (completePath <> help "the file/directory to check the usage of"))- du path = printDiskUsage =<< getAbsolute (maybe "" id path)+ go = du <$> optional (argument bstr (completePath <> help "the file/directory to check the usage of"))+ du path = SubHdfs $ printDiskUsage =<< getAbsolute (fromMaybe "" path) +subFind :: SubCommand+subFind = SubCommand "find" "Recursively search a directory tree" go+ where+ go = find <$> (argument bstr (completeDir <> help "the path to recursively search"))+ <*> (optional (option bstr (long "name" <> metavar "FILENAME"+ <> help "the file name to match exactly")))+ find path mexpr = SubHdfs $ do+ absPath <- getAbsolute path+ printFindResults absPath $ maybe (const True) feq mexpr++ feq expr FileStatus{..} = expr == fsPath++subGet :: SubCommand+subGet = SubCommand "get" "Get a file" go+ where+ go = get <$> argument bstr (completePath <> help "source file")+ <*> optional (argument str (completePath <> help "destination file"))+ get src mdst = SubHdfs $ do+ let dst = fromMaybe (takeFileName $ B.unpack src) mdst+ absSrc <- getAbsolute src+ mReadHandle <- openRead absSrc+ let doRead readHandle = liftIO $ bracket+ (openFile dst WriteMode)+ (hClose)+ (\writeHandle -> hdfsMapM_ (B.hPut writeHandle) readHandle)+ maybe (return ()) doRead mReadHandle+ subList :: SubCommand subList = SubCommand "ls" "List the contents of a directory" go where- go = ls <$> (optional (argument str (completeDir <> help "the directory to list")))- ls path = printListing =<< getAbsolute (fromMaybe "" path)+ go = ls <$> optional (argument bstr (completeDir <> help "the directory to list"))+ ls path = SubHdfs $ printListing =<< getAbsolute (fromMaybe "" path) subMkDir :: SubCommand subMkDir = SubCommand "mkdir" "Create a directory in the specified location" go where- go = mkdir <$> argument str (completeDir <> help "the directory to create")- <*> switch (short 'p' <> help "create intermediate directories")- mkdir path parent = do+ go = mkdir <$> argument bstr (completeDir <> help "the directory to create")+ <*> switch (short 'p' <> help "create intermediate directories")+ mkdir path parent = SubHdfs $ do absPath <- getAbsolute path- ok <- mkdirs absPath parent- unless ok $ liftIO . putStrLn $ "Failed to create: " <> absPath+ ok <- mkdirs parent absPath+ unless ok $ liftIO . B.putStrLn $ "Failed to create: " <> absPath subPwd :: SubCommand subPwd = SubCommand "pwd" "Print working directory" go where- go = pure pwd- pwd = liftIO . putStrLn =<< getWorkingDir+ go = pure $ SubIO $ B.putStrLn =<< getWorkingDir subRemove :: SubCommand subRemove = SubCommand "rm" "Delete a file or directory" go where- go = rm <$> argument str (completePath <> help "the file/directory to remove")- <*> switch (short 'r' <> help "recursively remove the whole file hierarchy")- rm path recursive = do+ go = rm <$> argument bstr (completePath <> help "the file/directory to remove")+ <*> switch (short 'r' <> help "recursively remove the whole file hierarchy")+ rm path recursive = SubHdfs $ do absPath <- getAbsolute path- ok <- delete absPath recursive- unless ok $ liftIO . putStrLn $ "Failed to remove: " <> absPath+ ok <- delete recursive absPath+ unless ok $ liftIO . B.putStrLn $ "Failed to remove: " <> absPath subRename :: SubCommand subRename = SubCommand "mv" "Rename a file or directory" go where- go = mv <$> argument str (completePath <> help "source file/directory")- <*> argument str (completePath <> help "destination file/directory")- <*> switch (short 'f' <> help "overwrite destination if it exists")- mv src dst force = do+ go = mv <$> argument bstr (completePath <> help "source file/directory")+ <*> argument bstr (completePath <> help "destination file/directory")+ <*> switch (short 'f' <> help "overwrite destination if it exists")+ mv src dst force = SubHdfs $ do absSrc <- getAbsolute src absDst <- getAbsolute dst- rename absSrc absDst force+ rename force absSrc absDst subVersion :: SubCommand subVersion = SubCommand "version" "Show version information" go where- go = pure $ liftIO $ putStrLn $ "hh version " <> showVersion version+ go = pure $ SubIO $ putStrLn $ "hh version " <> showVersion version ------------------------------------------------------------------------ fileCompletion :: (FileType -> Bool) -> Completer-fileCompletion p = mkCompleter $ \path -> handle ignore $ runRemote $ do- let (dir, _) = splitFileName' path- ls <- getListing =<< getAbsolute dir+fileCompletion p = mkCompleter $ \spath -> handle ignore $ runHdfs $ do+ let dir = B.pack $ fst $ splitFileName' spath+ path = B.pack spath - return $ filter (path `isPrefixOf`)- . map (displayPath dir)- . filter (p . get fsFileType)- . concatMap (get dlPartialListing)- . maybeToList $ ls+ ls <- getListing' =<< getAbsolute dir++ return $ V.toList+ . V.map B.unpack+ . V.filter (path `B.isPrefixOf`)+ . V.map (displayPath dir)+ . V.filter (p . fsFileType)+ $ ls where ignore (RemoteError _ _) = return [] @@ -325,69 +331,65 @@ ("./", f) -> ("", f) (d, f) -> (d, f) -displayPath :: FilePath -> FileStatus -> FilePath-displayPath parent file = parent </> B.unpack (get fsPath file) <> suffix+displayPath :: HdfsPath -> FileStatus -> HdfsPath+displayPath parent file = parent // fsPath file <> suffix where- suffix = case get fsFileType file of+ suffix = case fsFileType file of Dir -> "/" _ -> "" ------------------------------------------------------------------------ -printDiskUsage :: FilePath -> Remote ()+printDiskUsage :: HdfsPath -> Hdfs () printDiskUsage path = do- mls <- getListing path- case mls of- Nothing -> liftIO $ putStrLn $ "File/directory does not exist: " <> path- Just ls -> do- let files = map (displayPath path) (get dlPartialListing ls)- css <- zip files <$> mapM getDirSize files+ ls <- getListingOrFail path - let col a f = vcat a (map (text . f) css)+ let files = V.map (displayPath path) ls+ css <- V.zip files <$> V.mapM getDirSize files - liftIO $ do- printBox $ col right snd- <+> col left fst+ let col a f = vcat a (map (text . f) (V.toList css))++ liftIO $ printBox $ col right snd+ <+> col left (B.unpack . fst) where- getDirSize f = handleC (\e -> if isAccessDenied e then return "-" else liftIO (throwIO e))- (formatSize . get csLength <$> getContentSummary f)+ getDirSize f = handle (\e -> if isAccessDenied e then return "-" else throwM e)+ (formatSize . csLength <$> getContentSummary f) -printListing :: FilePath -> Remote ()+printListing :: HdfsPath -> Hdfs () printListing path = do- mls <- getListing path- case mls of- Nothing -> liftIO . putStrLn $ "Directory does not exist: " <> path- Just ls -> do- let getPerms = fromIntegral . get fpPerm . get fsPermission- getBlockRepl = fromMaybe 0 . get fsBlockReplication-- hdfs2utc ms = posixSecondsToUTCTime (fromIntegral ms / 1000)- getModTime = hdfs2utc . get fsModificationTime+ ls <- getListingOrFail path - -- TODO: Fetch rest of partial listing- xs = get dlPartialListing ls- col a f = vcat a (map (text . f) xs)+ let hdfs2utc ms = posixSecondsToUTCTime (fromIntegral ms / 1000)+ getModTime = hdfs2utc . fsModificationTime - liftIO $ do- putStrLn $ "Found " <> show (length xs) <> " items"+ col a f = vcat a (map (text . f) (V.toList ls)) - printBox $ col left (\x -> formatMode (get fsFileType x) (getPerms x))- <+> col right (formatBlockRepl . getBlockRepl)- <+> col left (T.unpack . get fsOwner)- <+> col left (T.unpack . get fsGroup)- <+> col right (formatSize . get fsLength)- <+> col right (formatUTC . getModTime)- <+> col left (T.unpack . T.decodeUtf8 . get fsPath)+ liftIO $ do+ putStrLn $ "Found " <> show (V.length ls) <> " items" -------------------------------------------------------------------------+ printBox $ col left (\x -> formatMode (fsFileType x) (fsPermission x))+ <+> col right (formatBlockReplication . fsBlockReplication)+ <+> col left (T.unpack . fsOwner)+ <+> col left (T.unpack . fsGroup)+ <+> col right (formatSize . fsLength)+ <+> col right (formatUTC . getModTime)+ <+> col left (T.unpack . T.decodeUtf8 . fsPath) -get :: HasField a => (t -> a) -> t -> FieldType a-get f x = getField (f x)+printFindResults :: HdfsPath -> (FileStatus -> Bool) -> Hdfs ()+printFindResults path cond = handle (liftIO . printError) $ do+ ls <- getListingOrFail path+ V.mapM_ printMatch ls+ where+ printMatch :: FileStatus -> Hdfs ()+ printMatch fs@FileStatus{..} = do+ let path' = displayPath path fs+ when (cond fs) (liftIO $ B.putStrLn path')+ case fsFileType of+ Dir -> printFindResults path' cond+ _ -> return () ------------------------------------------------------------------------ -type Perms = Word16- formatSize :: Word64 -> String formatSize b | b <= 0 = "0" | b < 1000 = show b <> "B"@@ -396,22 +398,22 @@ | b < 1000000000000 = show (b `div` 1000000000) <> "G" | otherwise = show (b `div` 1000000000000) <> "T" -formatBlockRepl :: Word32 -> String-formatBlockRepl x | x == 0 = "-"- | otherwise = show x+formatBlockReplication :: Word16 -> String+formatBlockReplication x | x == 0 = "-"+ | otherwise = show x formatUTC :: UTCTime -> String formatUTC = formatTime defaultTimeLocale "%Y-%m-%d %H:%M" -formatMode :: FileType -> Perms -> String-formatMode File = ("-" <>) . formatPerms-formatMode Dir = ("d" <>) . formatPerms-formatMode SymLink = ("l" <>) . formatPerms+formatMode :: FileType -> Permission -> String+formatMode File = ("-" <>) . formatPermission+formatMode Dir = ("d" <>) . formatPermission+formatMode SymLink = ("l" <>) . formatPermission -formatPerms :: Perms -> String-formatPerms perms = format (perms `shiftR` 6)- <> format (perms `shiftR` 3)- <> format perms+formatPermission :: Permission -> String+formatPermission perms = format (perms `shiftR` 6)+ <> format (perms `shiftR` 3)+ <> format perms where format p = conv 0x4 "r" p <> conv 0x2 "w" p@@ -424,8 +426,9 @@ printError :: RemoteError -> IO () printError (RemoteError subject body)- | oneLiner = T.putStrLn firstLine- | otherwise = T.putStrLn subject >> T.putStrLn body+ | oneLiner = T.putStrLn firstLine+ | T.null body = T.putStrLn subject+ | otherwise = T.putStrLn subject >> T.putStrLn body where oneLiner = subject `elem` [ "org.apache.hadoop.security.AccessControlException" , "org.apache.hadoop.fs.FileAlreadyExistsException"@@ -434,3 +437,28 @@ isAccessDenied :: RemoteError -> Bool isAccessDenied (RemoteError s _) = s == "org.apache.hadoop.security.AccessControlException"++------------------------------------------------------------------------++infixr 5 //++(//) :: HdfsPath -> HdfsPath -> HdfsPath+(//) xs ys | B.null xs = ys+ | B.null ys = xs+ | B.head ys == '/' = ys+ | B.last xs == '/' = xs <> ys+ | otherwise = xs <> "/" <> ys++trimEnd :: Char -> ByteString -> ByteString+trimEnd b bs | B.null bs = B.empty+ | B.last bs == b = trimEnd b (B.init bs)+ | otherwise = bs++------------------------------------------------------------------------++getListingOrFail :: HdfsPath -> Hdfs (V.Vector FileStatus)+getListingOrFail path = do+ mls <- getListing path+ case mls of+ Nothing -> throwM $ RemoteError ("File/directory does not exist: " <> T.decodeUtf8 path) T.empty+ Just ls -> return ls