Getting ShortWriteException when Uploading File and Temporal Folder doesn't exist

[roman]

For some reason, when using the handleFileUploads function and specifying a folder that doesn't exist on the file system, the code throws a ShortWriteException error

To replicate:

• generate a Snap project using snap init
• put the form.html in the resources/static folder
• put the Site.hs in the src/ folder
• run the Snap app
• go to http://localhost:8000/new
• upload any file you want
• check the logs/error.log

Here is the gist with the source code to use:

https://gist.github.com/826286

[lpsmith]

I'm getting a ShortWriteException when I fstat the temporary directory. I can even comment out the upload code and get the error. I don't get this error if I comment out the fstat and the logic that depends on the result (which is just to check that the directory exists and that permissions are sufficiently strict)

Unfortunately, I have not yet been able to create a small-ish program that reproduces this error.

[lpsmith]

It looks like this particular issue has been partially fixed with this commit. In the particular case that the temp directory doesn't exist, I get the following lines in the error.log file:

[17/Apr/2011:14:27:45 -0400] A web handler threw an exception. Details:
/tmp/web-dbms: openBinaryTempFile: does not exist (No such file or directory)
[17/Apr/2011:14:28:05 -0400] A web handler threw an exception. Details:
/tmp/web-dbms: openBinaryTempFile: does not exist (No such file or directory)

Unfortuately, these exceptions are not consistent with programmer generated exceptions, which (in my case) would display the exception to the end user. If the directory does not exist, then the end-user gets a empty response.

I have code that currently looks like this, though, to ensure that the temporary directory exists and has sufficiently strict permissions: (Unfortunately this code is Unix-dependent)

import System.Posix

ensureTempDirectory :: FilePath -> IO ()
ensureTempDirectory tmpdir = do
    tmp <- getFileStatus tmpdir
    if not (isDirectory tmp)
     then error
            ("Temporary Directory path already exists and is not a directory: "
             ++ tmpdir)
     else do
       myUid <- getEffectiveUserID
       if not (fileOwner tmp == myUid && fileMode tmp .&. 0o777 == 0o700)
        then error ("Temporary Directory permission error: " ++ tmpdir ++
                " must be owned by the web-dbms process with permissions 700")
        else return ()
  `catch` \(err :: IOError) -> do
    if isDoesNotExistError err
     then createDirectory tmpdir 0o700
     else throw err

uploadPostHandler :: B8.ByteString -> Session -> Snap ()
uploadPostHandler table_name session = do
  let tmpdir = B8.unpack Config.tempDirectory
  liftIO $ ensureTempDirectory tmpdir
  handleFileUploads tmpdir defaultUploadPolicy
     ...