1 % Copyright (C) 2002-2003 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 19 \begin{code} 20 {-# OPTIONS_GHC -cpp -fglasgow-exts #-} 21 {-# LANGUAGE CPP #-} 22 23 #include "gadts.h" 24 25 module Darcs.Repository.Prefs ( add_to_preflist, get_preflist, set_preflist, 26 get_global, environmentHelpHome, 27 defaultrepo, set_defaultrepo, 28 get_prefval, set_prefval, change_prefval, 29 def_prefval, 30 write_default_prefs, 31 boring_regexps, boring_file_filter, darcsdir_filter, 32 FileType(..), filetype_function, 33 getCaches, 34 binaries_file_help 35 ) where 36 37 import System.IO.Error ( isDoesNotExistError ) 38 import Control.Monad ( unless, when, mplus ) 39 import Text.Regex ( Regex, mkRegex, matchRegex, ) 40 import Data.Char ( toUpper ) 41 import Data.Maybe ( isJust, catMaybes ) 42 import Data.List ( nub, isPrefixOf, union ) 43 import System.Directory ( getAppUserDataDirectory ) 44 import System.FilePath ( (</>) ) 45 import System.Environment ( getEnvironment ) 46 47 import Darcs.Flags ( DarcsFlag( NoCache, NoSetDefault, DryRun, Ephemeral, RemoteRepo ) ) 48 import Darcs.RepoPath ( AbsolutePath, ioAbsolute, toFilePath, getCurrentDirectory ) 49 import Darcs.Utils ( catchall, stripCr ) 50 import Darcs.IO ( ReadableDirectory(..), WriteableDirectory(..) ) 51 import Darcs.Patch.FileName ( fp2fn ) 52 import Darcs.External ( gzFetchFilePS, Cachable( Cachable ) ) 53 import qualified Data.ByteString.Char8 as BC ( unpack ) 54 import qualified Data.ByteString as B ( empty ) 55 import Darcs.Global ( darcsdir ) 56 import Darcs.Repository.Cache ( Cache(..), CacheType(..), CacheLoc(..), 57 WritableOrNot(..) ) 58 import Darcs.URL ( is_file ) 59 \end{code} 60 61 \section{prefs} 62 63 The \verb!_darcs! directory contains a \verb!prefs! directory. This 64 directory exists simply to hold user configuration settings specific to 65 this repository. The contents of this directory are intended to be 66 modifiable by the user, although in some cases a mistake in such a 67 modification may cause darcs to behave strangely. 68 69 70 71 \input{Darcs/ArgumentDefaults.lhs} 72 73 \begin{code} 74 write_default_prefs :: IO () 75 write_default_prefs = do set_preflist "boring" default_boring 76 set_preflist "binaries" default_binaries 77 set_preflist "motd" [] 78 \end{code} 79 80 \paragraph{repos} 81 The \verb!_darcs/prefs/repos! file contains a list of repositories you have 82 pulled from or pushed to, and is used for autocompletion of pull and push 83 commands in bash. Feel free to delete any lines from this list that might 84 get in there, or to delete the file as a whole. 85 86 \paragraph{author}\label{author_prefs} 87 The \verb!_darcs/prefs/author! file contains the email address (or name) to 88 be used as the author when patches are recorded in this repository, 89 e.g.\ \verb!David Roundy <droundy@abridgegame.org>!. This 90 file overrides the contents of the environment variables 91 \verb!$DARCS_EMAIL! and \verb!$EMAIL!. 92 93 \paragraph{boring}\label{boring} 94 The \verb!_darcs/prefs/boring! file may contain a list of regular 95 expressions describing files, such as object files, that you do not expect 96 to add to your project. As an example, the boring file that I use with 97 my darcs repository is: 98 \begin{verbatim} 99 \.hi$ 100 \.o$ 101 ^\.[^/] 102 ^_ 103 ~$ 104 (^|/)CVS($|/) 105 \end{verbatim} 106 A newly created repository has a longer boring file that 107 includes many common source control, backup, temporary, and compiled files. 108 109 You may want to have the boring file under version 110 control. To do this you can use darcs setpref to set the value 111 ``boringfile'' to the name of your desired boring file 112 (e.g.\ \verb-darcs setpref boringfile .boring-, where \verb-.boring- 113 is the repository path of a file 114 that has been 115 darcs added to your repository). The boringfile preference overrides 116 \verb!_darcs/prefs/boring!, so be sure to copy that file to the boringfile. 117 118 You can also set up a ``boring'' regexps 119 file in your home directory, named \verb!~/.darcs/boring!, 120 on MS Windows~\ref{ms_win}, which will be 121 used with all of your darcs repositories. 122 123 Any file not already managed by darcs and whose repository path (such 124 as \verb!manual/index.html!) matches any of 125 the boring regular expressions is considered boring. The boring file is 126 used to filter the files provided to darcs add, to allow you to use a 127 simple \verb-darcs add newdir newdir/*- 128 without accidentally adding a bunch of 129 object files. It is also used when the \verb!--look-for-adds! flag is 130 given to whatsnew or record. 131 Note that once a file has been added to darcs, it is not considered 132 boring, even if it matches the boring file filter. 133 134 \begin{code} 135 {-# NOINLINE default_boring #-} 136 default_boring :: [String] 137 default_boring = ["# Boring file regexps:", 138 "", 139 "### compiler and interpreter intermediate files", 140 "# haskell (ghc) interfaces", 141 "\\.hi$", "\\.hi-boot$", "\\.o-boot$", 142 "# object files", 143 "\\.o$","\\.o\\.cmd$", 144 "# profiling haskell", 145 "\\.p_hi$", "\\.p_o$", 146 "# haskell program coverage resp. profiling info", 147 "\\.tix$", "\\.prof$", 148 "# fortran module files", 149 "\\.mod$", 150 "# linux kernel", 151 "\\.ko\\.cmd$","\\.mod\\.c$", 152 "(^|/)\\.tmp_versions($|/)", 153 "# *.ko files aren't boring by default because they might", 154 "# be Korean translations rather than kernel modules", 155 "# \\.ko$", 156 "# python, emacs, java byte code", 157 "\\.py[co]$", "\\.elc$","\\.class$", 158 "# objects and libraries; lo and la are libtool things", 159 "\\.(obj|a|exe|so|lo|la)$", 160 "# compiled zsh configuration files", 161 "\\.zwc$", 162 "# Common LISP output files for CLISP and CMUCL", 163 "\\.(fas|fasl|sparcf|x86f)$", 164 "", 165 "### build and packaging systems", 166 "# cabal intermediates", 167 "\\.installed-pkg-config", 168 "\\.setup-config", 169 "# standard cabal build dir, might not be boring for everybody", 170 "# ^dist(/|$)", 171 "# autotools", 172 "(^|/)autom4te\\.cache($|/)", "(^|/)config\\.(log|status)$", 173 "# microsoft web expression, visual studio metadata directories", 174 "\\_vti_cnf$", 175 "\\_vti_pvt$", 176 "# gentoo tools", 177 "\\.revdep-rebuild.*", 178 "# generated dependencies", 179 "^\\.depend$", 180 "", 181 "### version control systems", 182 "# cvs", 183 "(^|/)CVS($|/)","\\.cvsignore$", 184 "# cvs, emacs locks", 185 "^\\.#", 186 "# rcs", 187 "(^|/)RCS($|/)", ",v$", 188 "# subversion", 189 "(^|/)\\.svn($|/)", 190 "# mercurial", 191 "(^|/)\\.hg($|/)", 192 "# git", 193 "(^|/)\\.git($|/)", 194 "# bzr", 195 "\\.bzr$", 196 "# sccs", 197 "(^|/)SCCS($|/)", 198 "# darcs", 199 "(^|/)"++darcsdir++"($|/)", "(^|/)\\.darcsrepo($|/)", 200 "^\\.darcs-temp-mail$", 201 "-darcs-backup[[:digit:]]+$", 202 "# gnu arch", 203 "(^|/)(\\+|,)", 204 "(^|/)vssver\\.scc$", 205 "\\.swp$","(^|/)MT($|/)", 206 "(^|/)\\{arch\\}($|/)","(^|/).arch-ids($|/)", 207 "# bitkeeper", 208 "(^|/)BitKeeper($|/)","(^|/)ChangeSet($|/)", 209 "", 210 "### miscellaneous", 211 "# backup files", 212 "~$","\\.bak$","\\.BAK$", 213 "# patch originals and rejects", 214 "\\.orig$", "\\.rej$", 215 "# X server", 216 "\\..serverauth.*", 217 "# image spam", 218 "\\#", "(^|/)Thumbs\\.db$", 219 "# vi, emacs tags", 220 "(^|/)(tags|TAGS)$", 221 "#(^|/)\\.[^/]", 222 "# core dumps", 223 "(^|/|\\.)core$", 224 "# partial broken files (KIO copy operations)", 225 "\\.part$", 226 "# waf files, see http://code.google.com/p/waf/", 227 "(^|/)\\.waf-[[:digit:].]+-[[:digit:]]+($|/)", 228 "(^|/)\\.lock-wscript$", 229 "# mac os finder", 230 "(^|/)\\.DS_Store$" ] 231 232 darcsdir_filter :: [FilePath] -> [FilePath] 233 darcsdir_filter = filter (not.is_darcsdir) 234 is_darcsdir :: FilePath -> Bool 235 is_darcsdir ('.':'/':f) = is_darcsdir f 236 is_darcsdir "." = True 237 is_darcsdir "" = True 238 is_darcsdir ".." = True 239 is_darcsdir "../" = True 240 is_darcsdir fp = darcsdir `isPrefixOf` fp 241 242 -- | The path of the global preference directory; @~/.darcs@ on Unix, 243 -- and @%APPDATA%/darcs@ on Windows. 244 global_prefs_dir :: IO (Maybe FilePath) 245 global_prefs_dir = do 246 env <- getEnvironment 247 case lookup "DARCS_TESTING_PREFS_DIR" env of 248 Just d -> return (Just d) 249 Nothing -> (getAppUserDataDirectory "darcs" >>= return.Just) 250 `catchall` (return Nothing) 251 252 environmentHelpHome :: ([String], [String]) 253 environmentHelpHome = (["HOME", "APPDATA"], [ 254 "Per-user preferences are set in $HOME/.darcs (on Unix) or", 255 "%APPDATA%/darcs (on Windows). This is also the default location of", 256 "the cache."]) 257 258 get_global :: String -> IO [String] 259 get_global f = do 260 dir <- global_prefs_dir 261 case dir of 262 (Just d) -> get_preffile $ d </> f 263 Nothing -> return [] 264 265 global_cache_dir :: IO (Maybe FilePath) 266 global_cache_dir = slash_cache `fmap` global_prefs_dir 267 where slash_cache = fmap (</> "cache") 268 269 boring_regexps :: IO [Regex] 270 boring_regexps = do 271 borefile <- def_prefval "boringfile" (darcsdir ++ "/prefs/boring") 272 bores <- get_lines borefile `catchall` return [] 273 gbs <- get_global "boring" 274 return $ map mkRegex $ bores ++ gbs 275 276 boring_file_filter :: IO ([FilePath] -> [FilePath]) 277 boring_file_filter = boring_regexps >>= return . actual_boring_file_filter 278 279 noncomments :: [String] -> [String] 280 noncomments ss = filter is_ok ss 281 where is_ok "" = False 282 is_ok ('#':_) = False 283 is_ok _ = True 284 285 get_lines :: ReadableDirectory m => FilePath -> m [String] 286 get_lines f = (notconflicts . noncomments . map stripCr . lines) 287 `fmap` mReadBinFile (fp2fn f) 288 where notconflicts = filter nc 289 startswith [] _ = True 290 startswith (x:xs) (y:ys) | x == y = startswith xs ys 291 startswith _ _ = False 292 nc l | startswith "v v v v v v v" l = False 293 nc l | startswith "*************" l = False 294 nc l | startswith "^ ^ ^ ^ ^ ^ ^" l = False 295 nc _ = True 296 297 -- | From a list of paths, filter out any that are within @_darcs@ or 298 -- match a boring regexp. 299 actual_boring_file_filter :: [Regex] -> [FilePath] -> [FilePath] 300 actual_boring_file_filter regexps files = filter (not . boring . normalize) files 301 where boring file = is_darcsdir file || 302 any (\regexp -> isJust $ matchRegex regexp file) regexps 303 304 normalize :: FilePath -> FilePath 305 normalize ('.':'/':f) = normalize f 306 normalize f = normalize_helper $ reverse f 307 where 308 normalize_helper ('/':rf) = normalize_helper rf 309 normalize_helper rf = reverse rf 310 \end{code} 311 312 \paragraph{binaries} 313 The \verb!_darcs/prefs/binaries! file may contain a list of regular 314 expressions describing files that should be treated as binary files rather 315 than text files. Darcs automatically treats files containing 316 \verb!^Z\! or \verb!'\0'! within the first 4096 bytes as being binary files. 317 You probably will want to have the binaries file under 318 version control. To do this you can use darcs setpref to set the value 319 ``binariesfile'' to the name of your desired binaries file 320 (e.g.\ \verb'darcs setpref binariesfile ./.binaries', where 321 \verb'.binaries' is a file that has been 322 darcs added to your repository). As with the boring file, you can also set 323 up a \verb!~/.darcs/binaries! file if you like, on MS Windows~\ref{ms_win}. 324 325 \begin{code} 326 data FileType = BinaryFile | TextFile 327 deriving (Eq) 328 329 {-# NOINLINE default_binaries #-} 330 -- | The lines that will be inserted into @_darcs/prefs/binaries@ when 331 -- @darcs init@ is run. Hence, a list of comments, blank lines and 332 -- regular expressions (ERE dialect). 333 -- 334 -- Note that while this matches .gz and .GZ, it will not match .gZ, 335 -- i.e. it is not truly case insensitive. 336 default_binaries :: [String] 337 default_binaries = help ++ 338 ["\\.(" ++ e ++ "|" ++ map toUpper e ++ ")$" | e <- extensions ] 339 where extensions = ["a","bmp","bz2","doc","elc","exe","gif","gz","iso", 340 "jar","jpe?g","mng","mpe?g","p[nbgp]m","pdf","png", 341 "pyc","so","tar","tgz","tiff?","z","zip"] 342 help = map ("# "++) binaries_file_help 343 344 binaries_file_help :: [String] 345 binaries_file_help = 346 ["This file contains a list of extended regular expressions, one per", 347 "line. A file path matching any of these expressions is assumed to", 348 "contain binary data (not text). The entries in ~/.darcs/binaries (if", 349 "it exists) supplement those in this file.", 350 "", 351 "Blank lines, and lines beginning with an octothorpe (#) are ignored.", 352 "See regex(7) for a description of extended regular expressions."] 353 354 filetype_function :: IO (FilePath -> FileType) 355 filetype_function = do 356 binsfile <- def_prefval "binariesfile" (darcsdir ++ "/prefs/binaries") 357 bins <- get_lines binsfile `catch` 358 (\e-> if isDoesNotExistError e then return [] else ioError e) 359 gbs <- get_global "binaries" 360 regexes <- return (map (\r -> mkRegex r) (bins ++ gbs)) 361 let isbin f = or $ map (\r -> isJust $ matchRegex r f) regexes 362 ftf f = if isbin $ normalize f then BinaryFile else TextFile 363 in 364 return ftf 365 366 -- this avoids a circular dependency with Repository 367 prefsDirectory :: ReadableDirectory m => m String 368 prefsDirectory = 369 do darcs <- mDoesDirectoryExist $ fp2fn darcsdir 370 if darcs 371 then return $ darcsdir ++ "/prefs/" 372 else fail $ "Directory " ++ darcsdir ++ "/ does not exist!" 373 374 withPrefsDirectory :: ReadableDirectory m => (String -> m ()) -> m () 375 withPrefsDirectory j = do prefs <- prefsDirectory `mplus` return "x" 376 when (prefs /= "x") $ j prefs 377 378 add_to_preflist :: WriteableDirectory m => String -> String -> m () 379 add_to_preflist p s = withPrefsDirectory $ \prefs -> do 380 hasprefs <- mDoesDirectoryExist $ fp2fn prefs 381 unless hasprefs $ mCreateDirectory $ fp2fn prefs 382 pl <- get_preflist p 383 mWriteBinFile (fp2fn $ prefs ++ p) $ unlines $ union [s] pl 384 385 get_preflist :: ReadableDirectory m => String -> m [String] 386 get_preflist p = do prefs <- prefsDirectory `mplus` return "x" 387 if (prefs /= "x") then get_preffile $ prefs ++ p 388 else return [] 389 390 get_preffile :: ReadableDirectory m => FilePath -> m [String] 391 get_preffile f = do 392 hasprefs <- mDoesFileExist (fp2fn f) 393 if hasprefs 394 then get_lines f 395 else return [] 396 397 set_preflist :: WriteableDirectory m => String -> [String] -> m () 398 set_preflist p ls = withPrefsDirectory $ \prefs -> do 399 haspref <- mDoesDirectoryExist $ fp2fn prefs 400 if haspref 401 then mWriteBinFile (fp2fn $ prefs ++ p) (unlines ls) 402 else return () 403 404 def_prefval :: String -> String -> IO String 405 def_prefval p d = do 406 pv <- get_prefval p 407 case pv of Nothing -> return d 408 Just v -> return v 409 410 get_prefval :: ReadableDirectory m => String -> m (Maybe String) 411 get_prefval p = 412 do pl <- get_preflist "prefs" 413 case map snd $ filter ((==p).fst) $ map (break (==' ')) pl of 414 [val] -> case words val of 415 [] -> return Nothing 416 _ -> return $ Just $ tail val 417 _ -> return Nothing 418 419 set_prefval :: WriteableDirectory m => String -> String -> m () 420 set_prefval p v = do pl <- get_preflist "prefs" 421 set_preflist "prefs" $ 422 filter ((/=p).fst.(break (==' '))) pl ++ [p++" "++v] 423 424 change_prefval :: WriteableDirectory m => String -> String -> String -> m () 425 change_prefval p f t = 426 do pl <- get_preflist "prefs" 427 ov <- get_prefval p 428 newval <- case ov of 429 Nothing -> return t 430 Just old -> if old == f then return t else return old 431 set_preflist "prefs" $ 432 filter ((/=p).fst.(break(==' '))) pl ++ [p++" "++newval] 433 434 defaultrepo :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String] 435 defaultrepo opts _ [] = 436 do let fixR r | not (is_file r) = return r 437 | otherwise = do absr <- ioAbsolute r 438 return $ toFilePath absr 439 case [r | RemoteRepo r <- opts] of 440 [] -> do defrepo <- get_preflist "defaultrepo" 441 case defrepo of 442 [r] -> (:[]) `fmap` fixR r 443 _ -> return [] 444 rs -> mapM fixR rs 445 defaultrepo _ _ r = return r 446 447 set_defaultrepo :: String -> [DarcsFlag] -> IO () 448 set_defaultrepo r opts = do doit <- if (NoSetDefault `notElem` opts && DryRun `notElem` opts && r_is_not_tmp) 449 then return True 450 else do olddef <- 451 get_preflist "defaultrepo" 452 return (olddef == []) 453 when doit 454 (set_preflist "defaultrepo" [r]) 455 add_to_preflist "repos" r 456 `catchall` return () -- we don't care if this fails! 457 where 458 r_is_not_tmp = not $ r `elem` [x | RemoteRepo x <- opts] 459 \end{code} 460 461 \paragraph{email} 462 The \verb!_darcs/prefs/email! file is used to provide the e-mail address for your 463 repository that others will use when they \verb!darcs send! a patch back to you. 464 The contents of the file should simply be an e-mail address. 465 466 467 \paragraph{sources} 468 The \verb!_darcs/prefs/sources! file is used to indicate alternative 469 locations from which to download patches when using a ``hashed'' 470 repository. This file contains lines such as: 471 \begin{verbatim} 472 cache:/home/droundy/.darcs/cache 473 readonly:/home/otheruser/.darcs/cache 474 repo:http://darcs.net 475 \end{verbatim} 476 This would indicate that darcs should first look in 477 \verb!/home/droundy/.darcs/cache! for patches that might be missing, and if 478 the patch isn't there, it should save a copy there for future use. In that 479 case, darcs will look in \verb!/home/otheruser/.darcs/cache! to see if that 480 user might have downloaded a copy, but won't try to save a copy there, of 481 course. Finally, it will look in \verb!http://darcs.net!. Note that the 482 \verb!sources! file can also exist in \verb!~/.darcs/!. Also note that the 483 sources mentioned in your \verb!sources! file will be tried \emph{before} 484 the repository you are pulling from. This can be useful in avoiding 485 downloading patches multiple times when you pull from a remote repository 486 to more than one local repository. 487 488 We strongly advise that you enable a global cache directory, which will 489 allow darcs to avoid re-downloading patches (for example, when doing a 490 second darcs get of the same repository), and also allows darcs to use hard 491 links to reduce disk usage. To do this, simply 492 \begin{verbatim} 493 mkdir -p $HOME/.darcs/cache 494 echo cache:$HOME/.darcs/cache > $HOME/.darcs/sources 495 \end{verbatim} 496 Note that the cache directory should reside on the same filesystem as your 497 repositories, so you may need to vary this. You can also use multiple 498 cache directories on different filesystems, if you have several filesystems 499 on which you use darcs. 500 501 On MS Windows~\ref{ms_win}) 502 503 \begin{code} 504 getCaches :: [DarcsFlag] -> String -> IO Cache 505 getCaches opts repodir = 506 do here <- parsehs `fmap` get_preffile (darcsdir ++ "/prefs/sources") 507 there <- (parsehs . lines . BC.unpack) `fmap` 508 (gzFetchFilePS (repodir ++ "/" ++ darcsdir ++ "/prefs/sources") Cachable 509 `catchall` return B.empty) 510 globalcachedir <- global_cache_dir 511 let globalcache = case (nocache,globalcachedir) of 512 (True,_) -> [] 513 (_,Just d) -> [Cache Directory Writable d] 514 _ -> [] 515 globalsources <- parsehs `fmap` get_global "sources" 516 thisdir <- getCurrentDirectory 517 let thisrepo = if Ephemeral `elem` opts 518 then [Cache Repo NotWritable $ toFilePath thisdir] 519 else [Cache Repo Writable $ toFilePath thisdir] 520 return $ Ca $ nub $ thisrepo ++ globalcache ++ globalsources ++ 521 here ++ [Cache Repo NotWritable repodir] ++ there 522 where 523 parsehs = catMaybes . map readln . noncomments 524 readln l | take 5 l == "repo:" = Just (Cache Repo NotWritable (drop 5 l)) 525 | take 9 l == "thisrepo:" = Just (Cache Repo Writable (drop 9 l)) 526 | nocache = Nothing 527 | take 6 l == "cache:" = Just (Cache Directory Writable (drop 6 l)) 528 | take 9 l == "readonly:" = Just (Cache Directory NotWritable (drop 9 l)) 529 | otherwise = Nothing 530 nocache = NoCache `elem` opts 531 532 \end{code} 533