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
18module Darcs.Repository.Prefs
19    ( addToPreflist
20    , deleteSources
21    , getPreflist
22    , setPreflist
23    , getGlobal
24    , environmentHelpHome
25    , defaultrepo
26    , getDefaultRepo
27    , addRepoSource
28    , getPrefval
29    , setPrefval
30    , changePrefval
31    , defPrefval
32    , writeDefaultPrefs
33    , boringRegexps
34    , isBoring
35    , FileType(..)
36    , filetypeFunction
37    , getCaches
38    , globalCacheDir
39    , globalPrefsDirDoc
40    , globalPrefsDir
41    , getMotd
42    , showMotd
43    , prefsUrl
44    , prefsDirPath
45    , prefsFilePath
46    , getPrefLines -- exported for darcsden, don't remove
47    -- * documentation of prefs files
48    , prefsFilesHelp
49    ) where
50
51import Darcs.Prelude
52
53import Control.Exception ( catch )
54import Control.Monad ( unless, when, liftM )
55import Data.Char ( toUpper )
56import Data.List ( nub, isPrefixOf, union, lookup )
57import Data.Maybe ( isJust, fromMaybe, mapMaybe, catMaybes, maybeToList )
58import qualified Control.Exception as C
59import qualified Data.ByteString       as B  ( empty, null, hPut, ByteString )
60import qualified Data.ByteString.Char8 as BC ( unpack )
61import System.Directory ( getAppUserDataDirectory, doesDirectoryExist,
62                          createDirectory, doesFileExist )
63import System.Environment ( getEnvironment )
64import System.FilePath.Posix ( normalise, dropTrailingPathSeparator, (</>) )
65import System.IO.Error ( isDoesNotExistError, catchIOError )
66import System.IO ( stdout, stderr )
67import System.Info ( os )
68import System.Posix.Files ( getFileStatus, fileOwner )
69import Text.Regex ( Regex, mkRegex, matchRegex )
70
71import Darcs.Repository.Cache ( Cache, mkCache, CacheType(..), CacheLoc(..),
72                                WritableOrNot(..) )
73import Darcs.Util.External ( gzFetchFilePS , fetchFilePS, Cachable(..))
74import Darcs.Repository.Flags
75    ( UseCache (..)
76    , DryRun (..)
77    , SetDefault (..)
78    , InheritDefault (..)
79    , RemoteRepos (..)
80    )
81import Darcs.Util.Lock( readTextFile, writeTextFile )
82import Darcs.Util.Exception ( catchall )
83import Darcs.Util.Global ( darcsdir, debugMessage )
84import Darcs.Util.Path ( AbsolutePath, ioAbsolute, toFilePath,
85                         getCurrentDirectory )
86import Darcs.Util.Printer( hPutDocLn, text )
87import Darcs.Util.URL ( isValidLocalPath )
88import Darcs.Util.File ( osxCacheDir, xdgCacheDir, removeFileMayNotExist )
89
90windows,osx :: Bool
91windows = "mingw" `isPrefixOf` os -- GHC under Windows is compiled with mingw
92osx     = os == "darwin"
93
94writeDefaultPrefs :: IO ()
95writeDefaultPrefs = do
96    setPreflist "boring" defaultBoring
97    setPreflist "binaries" defaultBinaries
98    setPreflist "motd" []
99
100defaultBoring :: [String]
101defaultBoring = map ("# " ++) boringFileInternalHelp ++
102    [ ""
103    , "### compiler and interpreter intermediate files"
104    , "# haskell (ghc) interfaces"
105    , "\\.hi$", "\\.hi-boot$", "\\.o-boot$"
106    , "# object files"
107    , "\\.o$","\\.o\\.cmd$"
108    , "# profiling haskell"
109    , "\\.p_hi$", "\\.p_o$"
110    , "# haskell program coverage resp. profiling info"
111    , "\\.tix$", "\\.prof$"
112    , "# fortran module files"
113    , "\\.mod$"
114    , "# linux kernel"
115    , "\\.ko\\.cmd$","\\.mod\\.c$"
116    , "(^|/)\\.tmp_versions($|/)"
117    , "# *.ko files aren't boring by default because they might"
118    , "# be Korean translations rather than kernel modules"
119    , "# \\.ko$"
120    , "# python, emacs, java byte code"
121    , "\\.py[co]$", "\\.elc$","\\.class$"
122    , "# objects and libraries; lo and la are libtool things"
123    , "\\.(obj|a|exe|so|lo|la)$"
124    , "# compiled zsh configuration files"
125    , "\\.zwc$"
126    , "# Common LISP output files for CLISP and CMUCL"
127    , "\\.(fas|fasl|sparcf|x86f)$"
128    , ""
129    , "### build and packaging systems"
130    , "# cabal intermediates"
131    , "\\.installed-pkg-config"
132    , "\\.setup-config"
133    , "# standard cabal build dir, might not be boring for everybody"
134    , "# ^dist(/|$)"
135    , "# autotools"
136    , "(^|/)autom4te\\.cache($|/)", "(^|/)config\\.(log|status)$"
137    , "# microsoft web expression, visual studio metadata directories"
138    , "\\_vti_cnf$"
139    , "\\_vti_pvt$"
140    , "# gentoo tools"
141    , "\\.revdep-rebuild.*"
142    , "# generated dependencies"
143    , "^\\.depend$"
144    , ""
145    , "### version control systems"
146    , "# cvs"
147    , "(^|/)CVS($|/)","\\.cvsignore$"
148    , "# cvs, emacs locks"
149    , "^\\.#"
150    , "# rcs"
151    , "(^|/)RCS($|/)", ",v$"
152    , "# subversion"
153    , "(^|/)\\.svn($|/)"
154    , "# mercurial"
155    , "(^|/)\\.hg($|/)"
156    , "# git"
157    , "(^|/)\\.git($|/)"
158    , "# bzr"
159    , "\\.bzr$"
160    , "# sccs"
161    , "(^|/)SCCS($|/)"
162    , "# darcs"
163    , "(^|/)"++darcsdir++"($|/)", "(^|/)\\.darcsrepo($|/)"
164    , "# gnu arch"
165    , "(^|/)(\\+|,)"
166    , "(^|/)vssver\\.scc$"
167    , "\\.swp$","(^|/)MT($|/)"
168    , "(^|/)\\{arch\\}($|/)","(^|/).arch-ids($|/)"
169    , "# bitkeeper"
170    , "(^|/)BitKeeper($|/)","(^|/)ChangeSet($|/)"
171    , ""
172    , "### miscellaneous"
173    , "# backup files"
174    , "~$","\\.bak$","\\.BAK$"
175    , "# patch originals and rejects"
176    , "\\.orig$", "\\.rej$"
177    , "# X server"
178    , "\\..serverauth.*"
179    , "# image spam"
180    , "\\#", "(^|/)Thumbs\\.db$"
181    , "# vi, emacs tags"
182    , "(^|/)(tags|TAGS)$"
183    , "#(^|/)\\.[^/]"
184    , "# core dumps"
185    , "(^|/|\\.)core$"
186    , "# partial broken files (KIO copy operations)"
187    , "\\.part$"
188    , "# waf files, see http://code.google.com/p/waf/"
189    , "(^|/)\\.waf-[[:digit:].]+-[[:digit:]]+($|/)"
190    , "(^|/)\\.lock-wscript$"
191    , "# mac os finder"
192    , "(^|/)\\.DS_Store$"
193    , "# emacs saved sessions (desktops)"
194    , "(^|.*/)\\.emacs\\.desktop(\\.lock)?$"
195    , " # stack"
196    , "(^|/)\\.stack-work($|/)"
197    ]
198
199boringFileInternalHelp :: [String]
200boringFileInternalHelp =
201    [ "This file contains a list of extended regular expressions, one per"
202    , "line. A file path matching any of these expressions will be filtered"
203    , "out during `darcs add`, or when the `--look-for-adds` flag is passed"
204    , "to `darcs whatsnew` and `record`. The entries in "
205        ++ globalPrefsDirDoc ++ "boring (if"
206    , "it exists) supplement those in this file."
207    , ""
208    , "Blank lines, and lines beginning with an octothorpe (#) are ignored."
209    , "See regex(7) for a description of extended regular expressions."
210    ]
211
212-- | The path of the global preference directory; @~/.darcs@ on Unix,
213-- and @%APPDATA%/darcs@ on Windows.
214globalPrefsDir :: IO (Maybe FilePath)
215globalPrefsDir = do
216    env <- getEnvironment
217    case lookup "DARCS_TESTING_PREFS_DIR" env of
218        Just d -> return (Just d)
219        Nothing -> Just `fmap` getAppUserDataDirectory "darcs"
220                   `catchall` return Nothing
221
222-- | The relative path of the global preference directory; @~/.darcs@ on Unix,
223-- and @%APPDATA%/darcs@ on Windows. This is used for online documentation.
224globalPrefsDirDoc :: String
225globalPrefsDirDoc | windows   = "%APPDATA%\\darcs\\"
226                  | otherwise = "~/.darcs/"
227
228environmentHelpHome :: ([String], [String])
229environmentHelpHome =
230    ( ["HOME", "APPDATA"]
231    , [ "Per-user preferences are set in $HOME/.darcs (on Unix) or"
232      , "%APPDATA%/darcs (on Windows).  This is also the default location of"
233      , "the cache."
234      ]
235    )
236
237getGlobal :: String -> IO [String]
238getGlobal f = do
239    dir <- globalPrefsDir
240    case dir of
241        (Just d) -> getPreffile $ d </> f
242        Nothing -> return []
243
244globalCacheDir :: IO (Maybe FilePath)
245globalCacheDir | windows   = ((</> "cache2") `fmap`) `fmap` globalPrefsDir
246               | osx       = ((</> "darcs") `fmap`) `fmap` osxCacheDir
247               | otherwise = ((</> "darcs") `fmap`) `fmap` xdgCacheDir
248
249-- |tryMakeBoringRegexp attempts to create a Regex from a given String. The
250-- evaluation is forced, to ensure any malformed exceptions are thrown here,
251-- and not later.
252tryMakeBoringRegexp :: String -> IO (Maybe Regex)
253tryMakeBoringRegexp input = regex `C.catch` handleBadRegex
254  where
255    regex = C.evaluate (Just $! mkRegex input)
256
257    handleBadRegex :: C.SomeException -> IO (Maybe Regex)
258    handleBadRegex _ = hPutDocLn stderr warning >> return Nothing
259
260    warning = text $ "Warning: Ignored invalid boring regex: " ++ input
261
262-- |boringRegexps returns a list of the boring regexps, from the local and
263-- global prefs/boring files. Any invalid regexps are filtered, preventing an
264-- exception in (potentially) pure code, when the regexps are used.
265boringRegexps :: IO [Regex]
266boringRegexps = do
267    borefile <- defPrefval "boringfile" (darcsdir ++ "/prefs/boring")
268    localBores <- getPrefLines borefile `catchall` return []
269    globalBores <- getGlobal "boring"
270    liftM catMaybes $ mapM tryMakeBoringRegexp $ localBores ++ globalBores
271
272isBoring :: IO (FilePath -> Bool)
273isBoring = do
274  regexps <- boringRegexps
275  return $ \file -> any (\r -> isJust $ matchRegex r file) regexps
276
277noncomments :: [String] -> [String]
278noncomments = filter nonComment
279  where
280    nonComment "" = False
281    nonComment ('#' : _) = False
282    nonComment _ = True
283
284getPrefLines :: FilePath -> IO [String]
285getPrefLines f = removeCRsCommentsAndConflicts `fmap` readTextFile f
286  where
287    removeCRsCommentsAndConflicts =
288        filter notconflict . noncomments . map stripCr
289    startswith [] _ = True
290    startswith (x : xs) (y : ys) = x == y && startswith xs ys
291    startswith _ _ = False
292    notconflict l
293        | startswith "v v v v v v v" l = False
294        | startswith "*************" l = False
295        | startswith "^ ^ ^ ^ ^ ^ ^" l = False
296        | otherwise = True
297    stripCr ""     = ""
298    stripCr "\r"   = ""
299    stripCr (c : cs) = c : stripCr cs
300
301doNormalise :: FilePath -> FilePath
302doNormalise = dropTrailingPathSeparator . normalise
303
304data FileType = BinaryFile
305              | TextFile
306              deriving (Eq)
307
308-- | The lines that will be inserted into @_darcs/prefs/binaries@ when
309-- @darcs init@ is run.  Hence, a list of comments, blank lines and
310-- regular expressions (ERE dialect).
311--
312-- Note that while this matches .gz and .GZ, it will not match .gZ,
313-- i.e. it is not truly case insensitive.
314defaultBinaries :: [String]
315defaultBinaries = map ("# "++) binariesFileInternalHelp ++
316    [ "\\." ++ regexToMatchOrigOrUpper e ++ "$" | e <- extensions ]
317  where
318    regexToMatchOrigOrUpper e = "(" ++ e ++ "|" ++ map toUpper e ++ ")"
319    extensions =
320        [ "a"
321        , "bmp"
322        , "bz2"
323        , "doc"
324        , "elc"
325        , "exe"
326        , "gif"
327        , "gz"
328        , "iso"
329        , "jar"
330        , "jpe?g"
331        , "mng"
332        , "mpe?g"
333        , "p[nbgp]m"
334        , "pdf"
335        , "png"
336        , "pyc"
337        , "so"
338        , "tar"
339        , "tgz"
340        , "tiff?"
341        , "z"
342        , "zip"
343        ]
344
345binariesFileInternalHelp :: [String]
346binariesFileInternalHelp =
347    [ "This file contains a list of extended regular expressions, one per"
348    , "line.  A file path matching any of these expressions is assumed to"
349    , "contain binary data (not text). The entries in "
350        ++ globalPrefsDirDoc ++ "binaries (if"
351    , "it exists) supplement those in this file."
352    , ""
353    , "Blank lines, and lines beginning with an octothorpe (#) are ignored."
354    , "See regex(7) for a description of extended regular expressions."
355    ]
356
357filetypeFunction :: IO (FilePath -> FileType)
358filetypeFunction = do
359    binsfile <- defPrefval "binariesfile" (darcsdir ++ "/prefs/binaries")
360    bins <- getPrefLines binsfile
361            `catch`
362            (\e -> if isDoesNotExistError e then return [] else ioError e)
363    gbs <- getGlobal "binaries"
364    let binaryRegexes = map mkRegex (bins ++ gbs)
365        isBinary f = any (\r -> isJust $ matchRegex r f) binaryRegexes
366        ftf f = if isBinary $ doNormalise f then BinaryFile else TextFile
367    return ftf
368
369findPrefsDirectory :: IO (Maybe String)
370findPrefsDirectory = do
371    inDarcsRepo <- doesDirectoryExist darcsdir
372    return $ if inDarcsRepo
373                 then Just $ darcsdir ++ "/prefs/"
374                 else Nothing
375
376withPrefsDirectory :: (String -> IO ()) -> IO ()
377withPrefsDirectory job = findPrefsDirectory >>= maybe (return ()) job
378
379addToPreflist :: String -> String -> IO ()
380addToPreflist pref value = withPrefsDirectory $ \prefs -> do
381    hasprefs <- doesDirectoryExist prefs
382    unless hasprefs $ createDirectory prefs
383    pl <- getPreflist pref
384    writeTextFile (prefs ++ pref) . unlines $ union [value] pl
385
386getPreflist :: String -> IO [String]
387getPreflist p = findPrefsDirectory >>=
388                maybe (return []) (\prefs -> getPreffile $ prefs ++ p)
389
390getPreffile :: FilePath -> IO [String]
391getPreffile f = do
392    hasprefs <- doesFileExist f
393    if hasprefs then getPrefLines f else return []
394
395setPreflist :: String -> [String] -> IO ()
396setPreflist p ls = withPrefsDirectory $ \prefs -> do
397    haspref <- doesDirectoryExist prefs
398    when haspref $
399        writeTextFile (prefs ++ p) (unlines ls)
400
401defPrefval :: String -> String -> IO String
402defPrefval p d = fromMaybe d `fmap` getPrefval p
403
404getPrefval :: String -> IO (Maybe String)
405getPrefval p = do
406    pl <- getPreflist prefsDir
407    return $ case map snd $ filter ((== p) . fst) $ map (break (== ' ')) pl of
408                 [val] -> case words val of
409                    [] -> Nothing
410                    _ -> Just $ tail val
411                 _ -> Nothing
412
413setPrefval :: String -> String -> IO ()
414setPrefval p v = do
415    pl <- getPreflist prefsDir
416    setPreflist prefsDir $ updatePrefVal pl p v
417
418updatePrefVal :: [String] -> String -> String -> [String]
419updatePrefVal prefList p newVal =
420    filter ((/= p) . fst . break (== ' ')) prefList ++ [p ++ " " ++ newVal]
421
422changePrefval :: String -> String -> String -> IO ()
423changePrefval p f t = do
424    pl <- getPreflist prefsDir
425    ov <- getPrefval p
426    let newval = maybe t (\old -> if old == f then t else old) ov
427    setPreflist prefsDir $ updatePrefVal pl p newval
428
429fixRepoPath :: String -> IO FilePath
430fixRepoPath p
431    | isValidLocalPath p = toFilePath `fmap` ioAbsolute p
432    | otherwise = return p
433
434defaultrepo :: RemoteRepos -> AbsolutePath -> [String] -> IO [String]
435defaultrepo (RemoteRepos rrepos) _ [] =
436  do case rrepos of
437       [] -> maybeToList `fmap` getDefaultRepo
438       rs -> mapM fixRepoPath rs
439defaultrepo _ _ r = return r
440
441getDefaultRepo :: IO (Maybe String)
442getDefaultRepo = do
443    defaults <- getPreflist defaultRepoPref
444    case defaults of
445         [] -> return Nothing
446         (d : _) -> Just `fmap` fixRepoPath d
447
448defaultRepoPref :: String
449defaultRepoPref = "defaultrepo"
450
451-- | addRepoSource adds a new entry to _darcs/prefs/repos and sets it as default
452--   in _darcs/prefs/defaultrepo, unless --no-set-default or --dry-run is passed,
453--   or it is the same repository as the current one.
454addRepoSource :: String
455              -> DryRun
456              -> RemoteRepos
457              -> SetDefault
458              -> InheritDefault
459              -> Bool
460              -> IO ()
461addRepoSource r isDryRun (RemoteRepos rrepos) setDefault inheritDefault isInteractive = (do
462    olddef <- getPreflist defaultRepoPref
463    newdef <- newDefaultRepo
464    let shouldDoIt = null noSetDefault && greenLight
465        greenLight = shouldAct && not rIsTmp && (olddef /= [newdef] || olddef == [])
466    -- the nuance here is that we should only notify when the reason we're not
467    -- setting default is the --no-set-default flag, not the various automatic
468    -- show stoppers
469    if shouldDoIt
470       then setPreflist defaultRepoPref [newdef]
471       else when (True `notElem` noSetDefault && greenLight && inheritDefault == NoInheritDefault) $
472                putStr . unlines $ setDefaultMsg
473    addToPreflist "repos" newdef) `catchall` return ()
474  where
475    shouldAct = isDryRun == NoDryRun
476    rIsTmp = r `elem` rrepos
477    noSetDefault = case setDefault of
478                       NoSetDefault x -> [x]
479                       _ -> []
480    setDefaultMsg =
481        [ "By the way, to change the default remote repository to"
482        , "      " ++ r ++ ","
483        , "you can " ++
484          (if isInteractive then "quit now and " else "") ++
485          "issue the same command with the --set-default flag."
486        ]
487    newDefaultRepo :: IO String
488    newDefaultRepo = case inheritDefault of
489      YesInheritDefault -> getRemoteDefaultRepo
490      NoInheritDefault -> return r
491    -- TODO It would be nice if --inherit-default could be made to work with
492    -- arbitrary remote repos; for security reasons we currently allow only
493    -- repos on the same host which must also be owned by ourselves. This is
494    -- because the defaultrepo file is read and written as a text file, and
495    -- therefore encoded in the user's locale encoding. See
496    -- http://bugs.darcs.net/issue2627 for a more detailed discussion.
497    getRemoteDefaultRepo
498      | isValidLocalPath r = do
499          sameOwner r "." >>= \case
500            True -> do
501              defs <-
502                getPreffile (r </> darcsdir </> "prefs/defaultrepo")
503                `catchIOError`
504                const (return [r])
505              case defs of
506                defrepo:_ -> do
507                  debugMessage "using defaultrepo of remote"
508                  return defrepo
509                [] -> return r
510            False -> return r
511      | otherwise = return r
512    sameOwner p q =
513      (==) <$> (fileOwner <$> getFileStatus p) <*> (fileOwner <$> getFileStatus q)
514
515-- | delete references to other repositories.
516--   Used when cloning to a ssh destination.
517--   Assume the current working dir is the repository.
518deleteSources :: IO ()
519deleteSources = do let prefsdir = darcsdir ++ "/prefs/"
520                   removeFileMayNotExist (prefsdir ++ "sources")
521                   removeFileMayNotExist (prefsdir ++ "repos")
522
523getCaches :: UseCache -> String -> IO Cache
524getCaches useCache repodir = do
525    here <- parsehs `fmap` getPreffile sourcesFile
526    there <- (parsehs . lines . BC.unpack)
527             `fmap`
528             (gzFetchFilePS (repodir </> sourcesFile) Cachable
529              `catchall` return B.empty)
530    globalcachedir <- globalCacheDir
531    let globalcache = if nocache
532                          then []
533                          else case globalcachedir of
534                              Nothing -> []
535                              Just d -> [Cache Directory Writable d]
536    globalsources <- parsehs `fmap` getGlobal "sources"
537    thisdir <- getCurrentDirectory
538    let thisrepo = [Cache Repo Writable $ toFilePath thisdir]
539        thatrepo = [Cache Repo NotWritable repodir]
540        tempCache = nub $ thisrepo ++ globalcache ++ globalsources ++ here
541                          ++ thatrepo ++ filterExternalSources there
542    return $ mkCache tempCache
543  where
544    sourcesFile = darcsdir ++ "/prefs/sources"
545
546    parsehs = mapMaybe readln . noncomments
547
548    readln l
549        | "repo:" `isPrefixOf` l = Just (Cache Repo NotWritable (drop 5 l))
550        | nocache = Nothing
551        | "cache:" `isPrefixOf` l = Just (Cache Directory Writable (drop 6 l))
552        | "readonly:" `isPrefixOf` l =
553            Just (Cache Directory NotWritable (drop 9 l))
554        | otherwise = Nothing
555
556    nocache = useCache == NoUseCache
557
558    filterExternalSources there =
559        if isValidLocalPath repodir
560            then there
561            else filter (not . isValidLocalPath . cacheSource) there
562
563-- | Fetch and return the message of the day for a given repository.
564getMotd :: String -> IO B.ByteString
565getMotd repo = fetchFilePS motdPath (MaxAge 600) `catchall` return B.empty
566  where
567    motdPath = repo ++ "/" ++ darcsdir ++ "/prefs/motd"
568
569-- | Display the message of the day for a given repository,
570showMotd :: String -> IO ()
571showMotd repo = do
572    motd <- getMotd repo
573    unless (B.null motd) $ do
574        B.hPut stdout motd
575        putStrLn $ replicate 22 '*'
576
577prefsUrl :: FilePath -> String
578prefsUrl r = r ++ "/"++darcsdir++"/prefs"
579
580prefsDir :: FilePath
581prefsDir = "prefs"
582
583prefsDirPath :: FilePath
584prefsDirPath = darcsdir </> prefsDir
585
586prefsFilePath :: FilePath
587prefsFilePath = prefsDirPath </> "prefs"
588
589prefsFilesHelp :: [(String,String)]
590prefsFilesHelp  =
591    [ ("motd", unlines
592      [ "The `_darcs/prefs/motd` file may contain a 'message of the day' which"
593      , "will be displayed to users who clone or pull from the repository without"
594      , "the `--quiet` option."])
595    , ("email", unlines
596      [ "The `_darcs/prefs/email` file is used to provide the e-mail address for"
597      , "your repository that others will use when they `darcs send` a patch back"
598      , "to you. The contents of the file should simply be an e-mail address."])
599    , ("post", unlines
600      [ "If `_darcs/prefs/post` exists in the target repository, `darcs send ` will"
601      , "upload to the URL contained in that file, which may either be a `mailto:`"
602      , "URL, or an `http://` URL. In the latter case, the patch is posted to that URL."])
603    , ("author", unlines
604      [ "The `_darcs/prefs/author` file contains the email address (or name) to"
605      , "be used as the author when patches are recorded in this repository,"
606      , "e.g. `David Roundy <droundy@abridgegame.org>`. This file overrides the"
607      , "contents of the environment variables `$DARCS_EMAIL` and `$EMAIL`."])
608    , ("defaults", unlines
609      [ "Default options for darcs commands. Each line of this file has the"
610      , "following form:"
611      , ""
612      , "    COMMAND FLAG VALUE"
613      , ""
614      , "where `COMMAND` is either the name of the command to which the default"
615      , "applies, or `ALL` to indicate that the default applies to all commands"
616      , "accepting that flag. The `FLAG` term is the name of the long argument"
617      , "option with or without the `--`, i.e. `verbose` or `--verbose`."
618      , "Finally, the `VALUE` option can be omitted if the flag does not involve"
619      , "a value. If the value has spaces in it, use single quotes, not double"
620      , "quotes, to surround it. Each line only takes one flag. To set multiple"
621      , "defaults for the same command (or for `ALL` commands), use multiple lines."
622      , ""
623      , "Options listed in the defaults file are just that: defaults. You can"
624      , "override any default on the command line."
625      , ""
626      , "Note that the use of `ALL` easily can have unpredicted consequences,"
627      , "especially if commands in newer versions of darcs accepts flags that"
628      , "they did not in previous versions. Only use safe flags with `ALL`."
629      , ""
630      , "For example, if your system clock is bizarre, you could instruct darcs to"
631      , "always ignore the file modification times by adding the following line:"
632      , ""
633      , "    ALL ignore-times"
634      , ""
635      , "There are some options which are meant specifically for use in"
636      , "`_darcs/prefs/defaults`. One of them is `--disable`. As the name"
637      , "suggests, this option will disable every command that got it as"
638      , "argument. So, if you are afraid that you could damage your repositories"
639      , "by inadvertent use of a command like amend, add the following line:"
640      , ""
641      , "    amend disable"
642      , ""
643      , "A global defaults file can be created with the name"
644      , "`.darcs/defaults` in your home directory. In case of conflicts,"
645      , "the defaults for a specific repository take precedence."
646      ])
647    , ("boring", unlines
648      [ "The `_darcs/prefs/boring` file may contain a list of regular expressions"
649      , "describing files, such as object files, that you do not expect to add to"
650      , "your project. A newly created repository has a boring file that includes"
651      , "many common source control, backup, temporary, and compiled files."
652      , ""
653      , "You may want to have the boring file under version control. To do this"
654      , "you can use darcs setpref to set the value 'boringfile' to the name of"
655      , "your desired boring file (e.g. `darcs setpref boringfile .boring`, where"
656      , "`.boring` is the repository path of a file that has been darcs added to"
657      , "your repository). The boringfile preference overrides"
658      , "`_darcs/prefs/boring`, so be sure to copy that file to the boringfile."
659      , ""
660      , "You can also set up a 'boring' regexps file in your home directory, named"
661      , "`~/.darcs/boring`, which will be used with all of your darcs repositories."
662      , ""
663      , "Any file not already managed by darcs and whose repository path"
664      , "matches any of the boring regular expressions is"
665      , "considered boring. The boring file is used to filter the files provided"
666      , "to darcs add, to allow you to use a simple `darcs add newdir newdir/*`"
667      , "without accidentally adding a bunch of object files. It is also used"
668      , "when the `--look-for-adds` flag is given to whatsnew or record. Note"
669      , "that once a file has been added to darcs, it is not considered boring,"
670      , "even if it matches the boring file filter."])
671    , ("binaries", unlines
672      [ "The `_darcs/prefs/binaries` file may contain a list of regular"
673      , "expressions describing files that should be treated as binary files rather"
674      , "than text files. Darcs automatically treats files containing characters"
675      , "`^Z` or `NULL` within the first 4096 bytes as being binary files."
676      , "You probably will want to have the binaries file under version control."
677      , "To do this you can use `darcs setpref` to set the value 'binariesfile'"
678      , "to the name of your desired binaries file"
679      , "(e.g. `darcs setpref binariesfile ./.binaries`, where `.binaries` is a"
680      , "file that has been darcs added to your repository). As with the boring"
681      , "file, you can also set up a `~/.darcs/binaries` file if you like."])
682    , ("defaultrepo", unlines
683      [ "Contains the URL of the default remote repository used by commands `pull`,"
684      , "`push`, `send` and `optimize relink`. Darcs edits this file automatically"
685      , "or when the flag `--set-default` is used."])
686    , ("sources", unlines
687      [ "Besides the defaultrepo, darcs also keeps track of any other locations"
688      , "used in commands for exchanging patches (e.g. push, pull, send)."
689      , "These are subsequently used as alternatives from which to download"
690      , "patches. The file contains lines such as:"
691      , ""
692      , "    cache:/home/droundy/.cache/darcs"
693      , "    readonly:/home/otheruser/.cache/darcs"
694      , "    repo:http://darcs.net"
695      , ""
696      , "The prefix `cache:` indicates that darcs can use this as a read-write"
697      , "cache for patches, `read-only:` indicates a cache that is only"
698      , "readable, and `repo:` denotes a (possibly remote) repository. The order"
699      , "of the entries is immaterial: darcs will always try local paths before"
700      , "remote ones, and only local ones will be used as potentially writable."
701      , ""
702      , "A global cache is enabled by default in your home directory under"
703      , "`.cache/darcs` (older versions of darcs used `.darcs/cache` for this),"
704      , "or `$XDG_CACHE_HOME/darcs` if the environment variable is set, see"
705      , "https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html."
706      , "The cache allows darcs to avoid re-downloading patches (for example, when"
707      , "doing a second darcs clone of the same repository), and also allows darcs"
708      , "to use hard links to reduce disk usage."
709      , ""
710      , "Note that the cache directory should reside on the same filesystem as"
711      , "your repositories, so you may need to vary this. You can also use"
712      , "multiple cache directories on different filesystems, if you have several"
713      , "filesystems on which you use darcs."
714      , ""
715      , "While darcs automatically adds entries to `_darcs/prefs/sources`, it does"
716      , "not currently remove them. If one or more of the entries aren't accessible"
717      , "(e.g. because they resided on a removable media), then darcs will bugger"
718      , "you with a hint, suggesting you remove those entries. This is done because"
719      , "certain systems have extremely long timeouts associated with some remotely"
720      , "accessible media (e.g. NFS over automounter on Linux), which can slow down"
721      , "darcs operations considerably. On the other hand, when you clone a repo"
722      , "with --lazy from a no longer accessible location, then the hint may give"
723      , "you an idea where the patches could be found, so you can try to restore"
724      , "access to them."
725      ])
726    , ("tmpdir", unlines
727      [ "By default temporary directories are created in `/tmp`, or if that doesn't"
728      , "exist, in `_darcs` (within the current repo).  This can be overridden by"
729      , "specifying some other directory in the file `_darcs/prefs/tmpdir` or the"
730      , "environment variable `$DARCS_TMPDIR` or `$TMPDIR`."])
731    , ("prefs", unlines
732      [ "Contains the preferences set by the command `darcs setprefs`."
733      , "Do not edit manually."])
734    ]
735