Haskell lazy I/O y cierre de archivos

lazy-evaluation

Question

He escrito un pequeño programa de Haskell para imprimir las sumas de comprobación MD5 de todos los archivos en el directorio actual (se busca recursivamente). Básicamente una versión de Haskell de md5deep . Todo está bien y excelente, excepto si el directorio actual tiene una gran cantidad de archivos, en cuyo caso recibo un error como:

<program>: <currentFile>: openBinaryFile: resource exhausted (Too many open files)

Parece que la pereza de Haskell está causando que no cierre los archivos, incluso después de que se haya completado su línea de salida correspondiente.

El código relevante está abajo. La función de interés es getList .

import qualified Data.ByteString.Lazy as BS

main :: IO ()
main = putStr . unlines =<< getList "."

getList :: FilePath -> IO [String]
getList p =
    let getFileLine path = liftM (/c -> (hex $ hash $ BS.unpack c) ++ " " ++ path) (BS.readFile path)
    in mapM getFileLine =<< getRecursiveContents p

hex :: [Word8] -> String
hex = concatMap (/x -> printf "%0.2x" (toInteger x))

getRecursiveContents :: FilePath -> IO [FilePath]
-- ^ Just gets the paths to all the files in the given directory.

¿Hay alguna idea sobre cómo podría resolver este problema?

El programa completo está disponible aquí: http://haskell.pastebin.com/PAZm0Dcb

Edición: tengo muchos archivos que no caben en la memoria RAM, por lo que no estoy buscando una solución que lea todo el archivo en la memoria de una vez.

Answer 1

unsafeInterleaveIO?

Otra solución que me viene a la mente es usar unsafeInterleaveIO de System.IO.Unsafe . Vea la respuesta de Tomasz Zielonka en este hilo en Haskell Cafe.

Difiere una operación de entrada-salida (abrir un archivo) hasta que realmente se requiere. Por lo tanto, es posible evitar abrir todos los archivos a la vez y, en cambio, leerlos y procesarlos secuencialmente (abrirlos perezosamente).

Ahora, creo, mapM getFileLine abre todos los archivos pero no comienza a leerlos hasta que se putStr . unlines putStr . unlines . Por lo tanto, muchos thunks con manejadores de archivos abiertos flotan alrededor, este es el problema. (Por favor, corríjame si estoy equivocado).

Un ejemplo

Un ejemplo modificado con unsafeInterleaveIO está ejecutando en un directorio de 100 GB durante varios minutos, en espacio constante.

getList :: FilePath -> IO [String]
getList p =
  let getFileLine path =
        liftM (/c -> (show . md5 $ c) ++ " " ++ path)
        (unsafeInterleaveIO $ BS.readFile path)
  in mapM getFileLine =<< getRecursiveContents p 

(Cambié para la implementación pureMD5 del hash)

PD: No estoy seguro de si este es un buen estilo. Creo que las soluciones con iteraciones y IO estrictas son mejores, pero esta es más rápida de hacer. Lo uso en scripts pequeños, pero temo confiar en un programa más grande.

Answer 2

EDITAR: lo siento, pensé que el problema era con los archivos, no con la lectura / recorrido. Ignora esto.

No hay problema, solo abra explícitamente el archivo (openFile), lea el contenido (Data.ByteString.Lazy.hGetContents), realice el hash md5 (let! H = md5 contents) y cierre el archivo explícitamente (hClose).

Answer 3

Edit: mi suposición era que el usuario estaba abriendo miles de archivos muy pequeños, resulta que son muy grandes. La pereza será esencial.

Bueno, necesitarás usar un mecanismo de IO diferente. Ya sea:

• IO estricta (procesar los archivos con Data.ByteString o System.IO.Strict
• o, Iteratee IO (solo para expertos en este momento).

También recomiendo encarecidamente que no se use ''desempaquetar'', ya que eso destruye el beneficio de usar secuencias de bytes.

Por ejemplo, puede reemplazar su perezoso IO con System.IO.Strict, dando como resultado:

import qualified System.IO.Strict as S

getList :: FilePath -> IO [String]
getList p = mapM getFileLine =<< getRecursiveContents p
    where
        getFileLine path = liftM (/c -> (hex (hash c)) ++ " " ++ path)
                                 (S.readFile path)

Answer 4

El problema es que mapM no es tan perezoso como parece: da como resultado una lista completa con un elemento por ruta de archivo. Y el archivo IO que está utilizando es perezoso, por lo que obtiene una lista con un archivo abierto por cada ruta de archivo.

La solución más sencilla en este caso es forzar la evaluación del hash para cada ruta de archivo. Una forma de hacerlo es con Control.Exception.evaluate :

getFileLine path = do
  theHash <- liftM (/c -> (hex $ hash $ BS.unpack c) ++ " " ++ path) (BS.readFile path)
  evaluate theHash

Como han señalado otros, estamos trabajando en un reemplazo para el enfoque actual de la IO perezosa que es más general pero aún así simple.

Answer 5

Lazy IO es muy propenso a los errores.

Como Dons sugirió, debe utilizar estricto IO.

Puede usar una herramienta como Iteratee para ayudarlo a estructurar un código de IO estricto. Mi herramienta favorita para este trabajo son las listas monádicas.

import Control.Monad.ListT (ListT) -- List
import Control.Monad.IO.Class (liftIO) -- transformers
import Data.Binary (encode) -- binary
import Data.Digest.Pure.MD5 -- pureMD5
import Data.List.Class (repeat, takeWhile, foldlL) -- List
import System.IO (IOMode(ReadMode), openFile, hClose)
import qualified Data.ByteString.Lazy as BS
import Prelude hiding (repeat, takeWhile)

hashFile :: FilePath -> IO BS.ByteString
hashFile =
    fmap (encode . md5Finalize) . foldlL md5Update md5InitialContext . strictReadFileChunks 1024

strictReadFileChunks :: Int -> FilePath -> ListT IO BS.ByteString
strictReadFileChunks chunkSize filename =
    takeWhile (not . BS.null) $ do
        handle <- liftIO $ openFile filename ReadMode
        repeat () -- this makes the lines below loop
        chunk <- liftIO $ BS.hGet handle chunkSize
        when (BS.null chunk) . liftIO $ hClose handle
        return chunk

Utilicé el paquete "pureMD5" aquí porque "Crypto" no parece ofrecer una implementación md5 de "transmisión".

Las listas ListT / ListT provienen del paquete "List" en hackage (la lista T de transformers y mtl están ListT y tampoco vienen con funciones útiles como takeWhile )

Answer 6

No necesita utilizar ninguna forma especial de hacer IO, solo necesita cambiar el orden en el que hace las cosas. Entonces, en lugar de abrir todos los archivos y luego procesar el contenido, abre un archivo e imprime una línea de salida a la vez.

import Data.Digest.Pure.MD5 (md5)
import qualified Data.ByteString.Lazy as BS

main :: IO ()
main = mapM_ (/path -> putStrLn . fileLine path =<< BS.readFile path) 
   =<< getRecursiveContents "."

fileLine :: FilePath -> BS.ByteString -> String
fileLine path c = hash c ++ " " ++ path

hash :: BS.ByteString -> String 
hash = show . md5

Por cierto, estoy usando un hash lib md5 diferente, la diferencia no es significativa.

Lo principal que está pasando aquí es la línea:

mapM_ (/path -> putStrLn . fileLine path =<< BS.readFile path)

Está abriendo un solo archivo, está consumiendo todo el contenido del archivo e imprimiendo una línea de salida. Cierra el archivo porque consume todo el contenido del archivo. Anteriormente, se demoraba cuando se consumía el archivo, lo que se retrasaba cuando se cerraba el archivo.

Si no está seguro de estar consumiendo todas las entradas pero quiere asegurarse de que el archivo se cierre de todas formas, puede usar la función withFile de System.IO :

mapM_ (/path -> withFile path ReadMode $ /hnd -> do
                  c <- BS.hGetContents hnd
                  putStrLn (fileLine path c))

La función withFile abre el archivo y pasa el identificador de archivo a la función de cuerpo. Garantiza que el archivo se cierre cuando el cuerpo vuelva. Este patrón "withBlah" es muy común cuando se trata de recursos caros. Este patrón de recursos es directamente compatible con System.Exception.bracket .

Answer 7

NOTA: He editado mi código ligeramente para reflejar los consejos en la respuesta de Duncan Coutts . Incluso después de esta edición, su respuesta es obviamente mucho mejor que la mía, y parece que no se queda sin memoria de la misma manera.

Aquí está mi rápido intento de una versión basada en Iteratee . Cuando lo ejecuto en un directorio con aproximadamente 2,000 archivos pequeños (30-80K) es aproximadamente 30 veces más rápido que su versión aquí y parece que usa un poco menos de memoria.

Por alguna razón, parece que se queda sin memoria en archivos muy grandes; no comprendo Iteratee suficientemente bien como para ser capaz de decir por qué con facilidad.

module Main where

import Control.Monad.State
import Data.Digest.Pure.MD5
import Data.List (sort)
import Data.Word (Word8) 
import System.Directory 
import System.FilePath ((</>))
import qualified Data.ByteString.Lazy as BS

import qualified Data.Iteratee as I
import qualified Data.Iteratee.WrappedByteString as IW

evalIteratee path = evalStateT (I.fileDriver iteratee path) md5InitialContext

iteratee :: I.IterateeG IW.WrappedByteString Word8 (StateT MD5Context IO) MD5Digest
iteratee = I.IterateeG chunk
  where
    chunk s@(I.EOF Nothing) =
      get >>= /ctx -> return $ I.Done (md5Finalize ctx) s
    chunk (I.Chunk c) = do
      modify $ /ctx -> md5Update ctx $ BS.fromChunks $ (:[]) $ IW.unWrap c
      return $ I.Cont (I.IterateeG chunk) Nothing

fileLine :: FilePath -> MD5Digest -> String
fileLine path c = show c ++ " " ++ path

main = mapM_ (/path -> putStrLn . fileLine path =<< evalIteratee path) 
   =<< getRecursiveContents "."

getRecursiveContents :: FilePath -> IO [FilePath]
getRecursiveContents topdir = do
  names <- getDirectoryContents topdir

  let properNames = filter (`notElem` [".", ".."]) names

  paths <- concatForM properNames $ /name -> do
    let path = topdir </> name

    isDirectory <- doesDirectoryExist path
    if isDirectory
      then getRecursiveContents path
      else do
        isFile <- doesFileExist path
        if isFile
          then return [path]
          else return []

  return (sort paths)

concatForM :: (Monad m) => [a1] -> (a1 -> m [a]) -> m [a]
concatForM xs f = liftM concat (forM xs f)

Tenga en cuenta que necesitará el paquete iteratee y el pureMD5 de pureMD5 . (Y mis disculpas si he hecho algo horrible aquí, soy un principiante con esto).