2011-09-28 18:03:59 +00:00
|
|
|
{- git ls-tree interface
|
|
|
|
-
|
|
|
|
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
|
|
|
module Git.LsTree (
|
2011-09-28 20:43:10 +00:00
|
|
|
TreeItem(..),
|
2011-09-29 23:04:24 +00:00
|
|
|
lsTree,
|
add ConfigMonitor thread
Monitors git-annex branch for changes, which are noticed by the Merger
thread whenever the branch ref is changed (either due to an incoming push,
or a local change), and refreshes cached config values for modified config
files.
Rate limited to run no more often than once per minute. This is important
because frequent git-annex branch changes happen when files are being
added, or transferred, etc.
A primary use case is that, when preferred content changes are made,
and get pushed to remotes, the remotes start honoring those settings.
Other use cases include propigating repository description and trust
changes to remotes, and learning when a remote has added a new special
remote, so the webapp can present the GUI to enable that special remote
locally.
Also added a uuid.log cache. All other config files already had caches.
2012-10-20 20:37:06 +00:00
|
|
|
lsTreeFiles,
|
2011-09-29 23:04:24 +00:00
|
|
|
parseLsTree
|
2011-09-28 18:03:59 +00:00
|
|
|
) where
|
|
|
|
|
|
|
|
import Numeric
|
|
|
|
import Control.Applicative
|
2011-09-28 18:14:52 +00:00
|
|
|
import System.Posix.Types
|
2011-09-28 18:03:59 +00:00
|
|
|
|
2011-12-20 18:37:53 +00:00
|
|
|
import Common
|
2011-09-30 03:43:42 +00:00
|
|
|
import Git
|
2011-12-14 19:56:11 +00:00
|
|
|
import Git.Command
|
2012-12-10 18:36:57 +00:00
|
|
|
import Git.Sha
|
2011-12-13 19:22:43 +00:00
|
|
|
import qualified Git.Filename
|
2011-09-28 18:03:59 +00:00
|
|
|
|
|
|
|
data TreeItem = TreeItem
|
2011-09-28 18:14:52 +00:00
|
|
|
{ mode :: FileMode
|
2011-09-29 23:04:24 +00:00
|
|
|
, typeobj :: String
|
2011-09-28 18:03:59 +00:00
|
|
|
, sha :: String
|
|
|
|
, file :: FilePath
|
|
|
|
} deriving Show
|
|
|
|
|
add ConfigMonitor thread
Monitors git-annex branch for changes, which are noticed by the Merger
thread whenever the branch ref is changed (either due to an incoming push,
or a local change), and refreshes cached config values for modified config
files.
Rate limited to run no more often than once per minute. This is important
because frequent git-annex branch changes happen when files are being
added, or transferred, etc.
A primary use case is that, when preferred content changes are made,
and get pushed to remotes, the remotes start honoring those settings.
Other use cases include propigating repository description and trust
changes to remotes, and learning when a remote has added a new special
remote, so the webapp can present the GUI to enable that special remote
locally.
Also added a uuid.log cache. All other config files already had caches.
2012-10-20 20:37:06 +00:00
|
|
|
{- Lists the complete contents of a tree. -}
|
improve type signatures with a Ref newtype
In git, a Ref can be a Sha, or a Branch, or a Tag. I added type aliases for
those. Note that this does not prevent mixing up of eg, refs and branches
at the type level. Since git really doesn't care, except rare cases like
git update-ref, or git tag -d, that seems ok for now.
There's also a tree-ish, but let's just use Ref for it. A given Sha or Ref
may or may not be a tree-ish, depending on the object type, so there seems
no point in trying to represent it at the type level.
2011-11-16 06:23:34 +00:00
|
|
|
lsTree :: Ref -> Repo -> IO [TreeItem]
|
2011-11-08 19:34:10 +00:00
|
|
|
lsTree t repo = map parseLsTree <$>
|
2012-10-04 22:47:31 +00:00
|
|
|
pipeNullSplitZombie [Params "ls-tree --full-tree -z -r --", File $ show t] repo
|
2011-09-28 18:03:59 +00:00
|
|
|
|
add ConfigMonitor thread
Monitors git-annex branch for changes, which are noticed by the Merger
thread whenever the branch ref is changed (either due to an incoming push,
or a local change), and refreshes cached config values for modified config
files.
Rate limited to run no more often than once per minute. This is important
because frequent git-annex branch changes happen when files are being
added, or transferred, etc.
A primary use case is that, when preferred content changes are made,
and get pushed to remotes, the remotes start honoring those settings.
Other use cases include propigating repository description and trust
changes to remotes, and learning when a remote has added a new special
remote, so the webapp can present the GUI to enable that special remote
locally.
Also added a uuid.log cache. All other config files already had caches.
2012-10-20 20:37:06 +00:00
|
|
|
{- Lists specified files in a tree. -}
|
|
|
|
lsTreeFiles :: Ref -> [FilePath] -> Repo -> IO [TreeItem]
|
|
|
|
lsTreeFiles t fs repo = map parseLsTree <$>
|
|
|
|
pipeNullSplitZombie ([Params "ls-tree -z --", File $ show t] ++ map File fs) repo
|
|
|
|
|
2011-09-28 18:03:59 +00:00
|
|
|
{- Parses a line of ls-tree output.
|
|
|
|
- (The --long format is not currently supported.) -}
|
support all filename encodings with ghc 7.4
Under ghc 7.4, this seems to be able to handle all filename encodings
again. Including filename encodings that do not match the LANG setting.
I think this will not work with earlier versions of ghc, it uses some ghc
internals.
Turns out that ghc 7.4 has a special filesystem encoding that it uses when
reading/writing filenames (as FilePaths). This encoding is documented
to allow "arbitrary undecodable bytes to be round-tripped through it".
So, to get FilePaths from eg, git ls-files, set the Handle that is reading
from git to use this encoding. Then things basically just work.
However, I have not found a way to make Text read using this encoding.
Text really does assume unicode. So I had to switch back to using String
when reading/writing data to git. Which is a pity, because it's some
percent slower, but at least it works.
Note that stdout and stderr also have to be set to this encoding, or
printing out filenames that contain undecodable bytes causes a crash.
IMHO this is a misfeature in ghc, that the user can pass you a filename,
which you can readFile, etc, but that default, putStr of filename may
cause a crash!
Git.CheckAttr gave me special trouble, because the filenames I got back
from git, after feeding them in, had further encoding breakage.
Rather than try to deal with that, I just zip up the input filenames
with the attributes. Which must be returned in the same order queried
for this to work.
Also of note is an apparent GHC bug I worked around in Git.CheckAttr. It
used to forkProcess and feed git from the child process. Unfortunatly,
after this forkProcess, accessing the `files` variable from the parent
returns []. Not the value that was passed into the function. This screams
of a bad bug, that's clobbering a variable, but for now I just avoid
forkProcess there to work around it. That forkProcess was itself only added
because of a ghc bug, #624389. I've confirmed that the test case for that
bug doesn't reproduce it with ghc 7.4. So that's ok, except for the new ghc
bug I have not isolated and reported. Why does this simple bit of code
magnet the ghc bugs? :)
Also, the symlink touching code is currently broken, when used on utf-8
filenames in a non-utf-8 locale, or probably on any filename containing
undecodable bytes, and I temporarily commented it out.
2012-02-03 19:12:41 +00:00
|
|
|
parseLsTree :: String -> TreeItem
|
2011-09-30 02:31:20 +00:00
|
|
|
parseLsTree l = TreeItem
|
support all filename encodings with ghc 7.4
Under ghc 7.4, this seems to be able to handle all filename encodings
again. Including filename encodings that do not match the LANG setting.
I think this will not work with earlier versions of ghc, it uses some ghc
internals.
Turns out that ghc 7.4 has a special filesystem encoding that it uses when
reading/writing filenames (as FilePaths). This encoding is documented
to allow "arbitrary undecodable bytes to be round-tripped through it".
So, to get FilePaths from eg, git ls-files, set the Handle that is reading
from git to use this encoding. Then things basically just work.
However, I have not found a way to make Text read using this encoding.
Text really does assume unicode. So I had to switch back to using String
when reading/writing data to git. Which is a pity, because it's some
percent slower, but at least it works.
Note that stdout and stderr also have to be set to this encoding, or
printing out filenames that contain undecodable bytes causes a crash.
IMHO this is a misfeature in ghc, that the user can pass you a filename,
which you can readFile, etc, but that default, putStr of filename may
cause a crash!
Git.CheckAttr gave me special trouble, because the filenames I got back
from git, after feeding them in, had further encoding breakage.
Rather than try to deal with that, I just zip up the input filenames
with the attributes. Which must be returned in the same order queried
for this to work.
Also of note is an apparent GHC bug I worked around in Git.CheckAttr. It
used to forkProcess and feed git from the child process. Unfortunatly,
after this forkProcess, accessing the `files` variable from the parent
returns []. Not the value that was passed into the function. This screams
of a bad bug, that's clobbering a variable, but for now I just avoid
forkProcess there to work around it. That forkProcess was itself only added
because of a ghc bug, #624389. I've confirmed that the test case for that
bug doesn't reproduce it with ghc 7.4. So that's ok, except for the new ghc
bug I have not isolated and reported. Why does this simple bit of code
magnet the ghc bugs? :)
Also, the symlink touching code is currently broken, when used on utf-8
filenames in a non-utf-8 locale, or probably on any filename containing
undecodable bytes, and I temporarily commented it out.
2012-02-03 19:12:41 +00:00
|
|
|
{ mode = fst $ Prelude.head $ readOct m
|
|
|
|
, typeobj = t
|
|
|
|
, sha = s
|
|
|
|
, file = Git.Filename.decode f
|
2011-09-30 02:31:20 +00:00
|
|
|
}
|
2012-12-13 04:24:19 +00:00
|
|
|
where
|
|
|
|
-- l = <mode> SP <type> SP <sha> TAB <file>
|
|
|
|
-- All fields are fixed, so we can pull them out of
|
|
|
|
-- specific positions in the line.
|
|
|
|
(m, past_m) = splitAt 7 l
|
|
|
|
(t, past_t) = splitAt 4 past_m
|
2012-12-13 04:29:06 +00:00
|
|
|
(s, past_s) = splitAt shaSize $ Prelude.tail past_t
|
2012-12-13 04:24:19 +00:00
|
|
|
f = Prelude.tail past_s
|