FIX #1258: document that openTempFile is secure(ish)

[ghc-base.git] / System / IO.hs

diff --git a/System/IO.hs b/System/IO.hs
index f2b9090..a887d99 100644 (file)
--- a/System/IO.hs
+++ b/System/IO.hs
@@ -419,9 +419,22 @@ hSetBinaryMode _ _ = return ()
 #ifndef __NHC__
 -- | The function creates a temporary file in ReadWrite mode.
 -- The created file isn\'t deleted automatically, so you need to delete it manually.
+--
+-- The file is creates with permissions such that only the current
+-- user can read/write it.
+--
+-- With some exceptions (see below), the file will be created securely
+-- in the sense that an attacker should not be able to cause
+-- openTempFile to overwrite another file on the filesystem using your
+-- credentials, by putting symbolic links (on Unix) in the place where
+-- the temporary file is to be created.  On Unix the @O_CREAT@ and
+-- @O_EXCL@ flags are used to prevent this attack, but note that
+-- @O_EXCL@ is sometimes not supported on NFS filesystems, so if you
+-- rely on this behaviour it is best to use local filesystems only.
+--
 openTempFile :: FilePath   -- ^ Directory in which to create the file
              -> String     -- ^ File name template. If the template is \"foo.ext\" then
-                           -- the create file will be \"fooXXX.ext\" where XXX is some
+                           -- the created file will be \"fooXXX.ext\" where XXX is some
                            -- random number.
              -> IO (FilePath, Handle)
 openTempFile tmp_dir template = openTempFile' "openTempFile" tmp_dir template False
@@ -438,9 +451,19 @@ openTempFile' loc tmp_dir template binary = do
     -- We split off the last extension, so we can use .foo.ext files
     -- for temporary files (hidden on Unix OSes). Unfortunately we're
     -- below filepath in the hierarchy here.
-    (prefix,suffix) = case break (== '.') $ reverse template of
-                          (rev_suffix, rev_prefix) ->
-                              (reverse rev_prefix, reverse rev_suffix)
+    (prefix,suffix) = 
+       case break (== '.') $ reverse template of
+         -- First case: template contains no '.'s. Just re-reverse it.
+         (rev_suffix, "")       -> (reverse rev_suffix, "")
+         -- Second case: template contains at least one '.'. Strip the
+         -- dot from the prefix and prepend it to the suffix (if we don't
+         -- do this, the unique number will get added after the '.' and
+         -- thus be part of the extension, which is wrong.)
+         (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)
+         -- Otherwise, something is wrong, because (break (== '.')) should
+         -- always return a pair with either the empty string or a string
+         -- beginning with '.' as the second component.
+         _                      -> error "bug in System.IO.openTempFile"
 
     oflags1 = rw_flags .|. o_EXCL
 
@@ -452,7 +475,7 @@ openTempFile' loc tmp_dir template binary = do
 
     findTempName x = do
       fd <- withCString filepath $ \ f ->
-              c_open f oflags 0o666
+              c_open f oflags 0o600
       if fd < 0 
        then do
          errno <- getErrno
@@ -468,7 +491,15 @@ openTempFile' loc tmp_dir template binary = do
         return (filepath, h)
       where
         filename        = prefix ++ show x ++ suffix
-        filepath        = tmp_dir ++ [pathSeparator] ++ filename
+        filepath        = tmp_dir `combine` filename
+
+        -- XXX bits copied from System.FilePath, since that's not available here
+        combine a b
+                  | null b = a
+                  | null a = b
+                  | last a == pathSeparator = a ++ b
+                  | otherwise = a ++ [pathSeparator] ++ b
+
 #if __HUGS__
         fdToHandle fd   = openFd (fromIntegral fd) False ReadWriteMode binary
 #endif