1 -- Copyright (C) 2004 David Roundy
    2 --
    3 -- This program is free software; you can redistribute it and/or modify
    4 -- it under the terms of the GNU General Public License as published by
    5 -- the Free Software Foundation; either version 2, or (at your option)
    6 -- any later version.
    7 --
    8 -- This program is distributed in the hope that it will be useful,
    9 -- but WITHOUT ANY WARRANTY; without even the implied warranty of
   10 -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   11 -- GNU General Public License for more details.
   12 --
   13 -- You should have received a copy of the GNU General Public License
   14 -- along with this program; see the file COPYING.  If not, write to
   15 -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
   16 -- Boston, MA 02110-1301, USA.
   17 
   18 module Darcs.CheckFileSystem ( can_I_use_mmap ) where
   19 
   20 import System.Directory ( removeFile, removeDirectory, setCurrentDirectory,
   21                           createDirectory,
   22                         )
   23 import Control.Exception ( block )
   24 
   25 import Darcs.Utils ( withCurrentDirectory )
   26 import Darcs.Lock ( withOpenTemp )
   27 
   28 -- Beware that the below test will return true in any directory where we
   29 -- don't have write permission.  This is risky, but means we'll do the
   30 -- right thing in the common case where we're dealing with posix
   31 -- filesystems and directories in which we don't have permission to write.
   32 
   33 can_I_remove_open_files :: IO Bool
   34 can_I_remove_open_files = block $ 
   35    (withOpenTemp $ \ (_,f) ->
   36        (do { removeFile f; return True}) `catch` \_ -> return False)
   37    `catch` \_ -> return True
   38 
   39 can_I_remove_directories_holding_open_files :: IO Bool
   40 can_I_remove_directories_holding_open_files = block $
   41    (do createDirectory "darcs_testing_for_nfs"
   42        okay <- (withCurrentDirectory "darcs_testing_for_nfs" $
   43                 do withOpenTemp $ \ (_,f) -> 
   44                        (do removeFile f
   45                            setCurrentDirectory ".."
   46                            removeDirectory "darcs_testing_for_nfs"
   47                            return True
   48                        ) `catch` \_ -> return False
   49                ) `catch` \_ -> return True
   50        removeDirectory "darcs_testing_for_nfs" `catch` \_ -> return ()
   51        return okay
   52    ) `catch` \_ -> return True
   53 
   54 can_I_use_mmap :: IO Bool
   55 can_I_use_mmap = do a <- can_I_remove_open_files
   56                     if a then can_I_remove_directories_holding_open_files
   57                          else return False
   58 
   59