suporte não libera recurso quando está dentro da thread

8

Estou tendo problemas com o de Haskell bracket: ao ser executado dentro de um segundo argumento de um segmento bifurcado (usando forkFinally) bracket, o cálculo que libera recursos não é executado quando o programa termina.

Aqui está o código que ilustra o problema (sei que, nesse caso específico, eu poderia desativar o buffer para gravar no arquivo imediatamente):

import           System.IO
import           Control.Exception              ( bracket
                                                , throwTo
                                                )

import           Control.Concurrent             ( forkFinally
                                                , threadDelay
                                                )
main = do
  threadId <- forkFinally
    (writeToFile "first_file")
    (\ex -> putStrLn $ "Exception occurred: " ++ show ex)
  putStrLn "Press enter to exit"
  _ <- getLine
  putStrLn "Bye!"

writeToFile :: FilePath -> IO ()
writeToFile file = bracket
  (openFile file AppendMode)
  (\fileHandle -> do
    putStrLn $ "\nClosing handle " ++ show fileHandle
    hClose fileHandle
  )
  (\fileHandle -> mapM_ (addNrAndWait fileHandle) [1 ..])

addNrAndWait :: Handle -> Int -> IO ()
addNrAndWait fileHandle nr =
  let nrStr = show nr
  in  do
        putStrLn $ "Appending " ++ nrStr
        hPutStrLn fileHandle nrStr
        threadDelay 1000000

A computação que libera recursos (e grava no console) nunca é chamada:

putStrLn $ "\nClosing handle " ++ show fileHandle
hClose fileHandle

Tornar o programa único, removendo o código de bifurcação, elimina maino problema e o identificador do arquivo é fechado ao finalizar o programa com Ctrl+ c:

main = writeToFile "first_file"

Como garantir que o código de liberação de recurso bracketseja executado ao usar vários threads?

Matthias Braun
fonte

Respostas:

5

usando throwTo

Aparentemente, o encadeamento criado com forkFinallynunca recebe uma exceção lançada e, portanto, o código de liberação de recursos de bracketnunca é executado.

Podemos corrigir isso fazendo isso manualmente usando throwTo threadId ThreadKilled:

import           Control.Exception              ( bracket
                                                , throwTo
                                                , AsyncException(ThreadKilled)
                                                )

import           Control.Concurrent             ( forkFinally
                                                , threadDelay
                                                )
main = do
  threadId <- forkFinally
    (writeToFile "first_file")
    (\ex -> putStrLn $ "Exception occurred: " ++ show ex)
  putStrLn "Press enter to exit"
  _ <- getLine
  throwTo threadId ThreadKilled
  putStrLn "Bye!"
Matthias Braun
fonte
Como o @ChrisSmith aponta, você precisa aguardar a conclusão do thread filho, ou haverá uma condição de corrida. (Você pode ver a condição da corrida adicionando um pequeno threadDelayantes da impressão "Closing handle".) #
301 KA KAhrhr
5

A causa raiz do problema aqui é que, quando mainsai, seu processo simplesmente morre. Ele não espera por nenhum outro segmento que você criou para concluir. Portanto, em seu código original, você criou um thread para gravar no arquivo, mas não foi permitido concluir.

Se você deseja eliminar o fio, mas forçá-lo a limpar, use throwTocomo fez aqui. Se você deseja que o encadeamento termine, precisará aguardar isso antes do mainretorno. Consulte Como forçar o encadeamento principal a aguardar o término de todos os encadeamentos filhos no Haskell

Chris Smith
fonte
0

usando async

Tornar o getLinebloco principal indefinidamente indefinido não funciona bem com nohup: Ele falhará com

<stdin>: hGetLine: invalid argument (Bad file descriptor)

Como uma alternativa ao getLinee throwTo, você pode usar async's funções :

import           Control.Concurrent.Async       ( withAsync, wait )

main = withAsync (writeToFile "first_file") wait

Isso permite executar o programa com nohup ./theProgram-exe &¹, por exemplo, em um servidor via SSH .

async também brilha ao executar várias tarefas simultaneamente:

import           Control.Concurrent.Async       ( race_ )

main = race_ (writeToFile "first_file") (writeToFile "second_file")

A função race_executa duas tarefas simultaneamente e aguarda até que o primeiro resultado chegue. Com o nosso encerramento writeToFile, nunca haverá um resultado regular, mas se uma das tarefas gerar uma exceção, a outra será cancelada também. Isso é útil para executar um servidor HTTP e HTTPS simultaneamente, por exemplo.

Para desligar o programa de maneira limpa - dando aos threads a chance de liberar recursos bracket-, eu envio o sinal SIGINT :

pkill --signal SIGINT theProgram-exe

Manuseando SIGTERM

Para também finalizar threads normalmente em um SIGTERM , podemos instalar um manipulador que captará o sinal:

import           Control.Concurrent.Async       ( withAsync
                                                , wait
                                                , cancel
                                                , Async
                                                )
import           System.Posix.Signals

main = withAsync
  (writeToFile "first_file")
  (\asy -> do
    cancelOnSigTerm asy
    wait asy
  )

cancelOnSigTerm :: Async a -> IO Handler
cancelOnSigTerm asy = installHandler
  sigTERM
  (Catch $ do
    putStrLn "Caught SIGTERM"
    -- Throws an AsyncCancelled excepion to the forked thread, allowing
    -- it to release resources via bracket
    cancel asy
  )
  Nothing

Agora, nosso programa liberará seus recursos bracketao receber o SIGTERM:

pkill theProgram-exe

Aqui está o equivalente a duas tarefas simultâneas com suporte para o SIGTERM:

import           Control.Concurrent.Async       ( withAsync
                                                , wait
                                                , cancel
                                                , Async
                                                , waitEither_
                                                )
import           System.Posix.Signals

main = raceWith_ cancelOnSigTerm
                 (writeToFile "first_file")
                 (writeToFile "second_file")

raceWith_ :: (Async a -> IO b) -> IO a -> IO a -> IO ()
raceWith_ f left right = withAsync left $ \a -> withAsync right $ \b -> do
  f a
  f b
  waitEither_ a b

Para saber mais sobre o tópico do Haskell assíncrono, dê uma olhada na Programação Paralela e Concorrente no Haskell, de Simon Marlow.


¹ Ligue stack buildpara obter um executável em, por exemplo,.stack-work/dist/x86_64-linux-tinfo6/Cabal-2.4.0.1/build/theProgram-exe/theProgram-exe

Matthias Braun
fonte