[Haskell-cafe] Double free-ing (was: Reading from a process)

[Mitar]

Hi!

On Thu, Dec 17, 2009 at 5:28 AM, Jason Dusek <jason.dusek at gmail.com> wrote:
>  It seems like the message delimiter to me because you keep
>  buffering till you receive it.

Hm, true. I have changed code to this:

getLastMyData :: MySate (Maybe MyData)
getLastMyData = do
  p <- gets process
  case p of
    Nothing                                              -> fail "No process"
    Just (MyProcess processOut processPid processBuffer) -> do
      processRunning <- io $ getProcessExitCode processPid
      case processRunning of
        Just _ -> processExited
        _      -> do
          ret <- io $ tryJust (guard . isEOFError) $ slurpMyData
processOut processBuffer
          case ret of
            Left _                           -> processExited -- EOF
            Right (datalist, currentBuffer) -> do
              modify (\s -> s { process = Just (MyProcess processOut
processPid currentBuffer) })
              if null datalist
                then return Nothing
                else return $ Just $ head datalist -- MyData is stored
in the reverse order so head is the last MyData from the process

slurpMyData :: Handle -> DataBuffer -> IO ([MyData], DataBuffer)
slurpMyData = slurpMyData' []
  where slurpMyData' datalist h buffer@(DataBuffer capacity array
bytecount) = do
          ready <- hReady h
          if not ready
            then return (datalist, buffer)
            else do
              let array' = advancePtr array bytecount
              count <- hGetBufNonBlocking h array' (capacity - bytecount)
              let bytecount' = bytecount + count
              chars <- peekArray bytecount' array
              let (d, rest) = readData . dataToString $ chars
                  rest'     = stringToData rest
              if null d
                then if length rest' == capacity
                       then error "Invalid data from the process"
                       else return (datalist, buffer)
                else do
                  assert (length rest' <= capacity) $ pokeArray array rest'
                  let buffer' = DataBuffer capacity array (length rest')
                  slurpMyData' (d ++ datalist) h buffer'

readData :: String -> ([MyData], String)
readData = readData' []
  where readData' datalist ""     = (datalist, "")
        readData' datalist string = case reads string of
                                      [(x, rest)] -> readData' ((head
x):datalist) rest -- x is a list and currently it has only one element
                                      []          -> (datalist,
string) -- we probably do not have enough data to read MyData properly
                                      _           -> error "Ambiguous
parse from the process"

And now it works. I just do not like using malloc and free.

And talking about free, I have now a problem of double freeing this
buffer. I am getting it after I send ctrl-c to the main process (with
underlying process I am communicating with). I am freeing it in
processExited:

processExited :: MyState a
processExited = do
  terminateDataProcess
  fail "Process exited"

terminateDataProcess :: MyState ()
terminateDataProcess = do
  p <- gets process
  case p of
    Just (MyProcess _ processPid (DataBuffer _ array _)) -> do
      modify (\s -> s { process = Nothing })
      io $ free array
      io $ terminateProcess processPid
    _                                                     -> return ()

So I run processExited if there is EOF from underlying process. But I
also run terminateDataProcess in a bracket I am calling getLastMyData.
Code is like this:

bracket initDataProcess terminateDataProcess (... read getLastMyData
repeatedly and process it ...)

Why I am getting this double free-ing errors? Should I introduce some
locks on terminateDataProcess?

I am using Linux 2.6.30 amd64 and 6.10.4.


Mitar