diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -91,7 +91,7 @@ ifSymlink :: (TreeItem -> Annex a) -> (TreeItem -> Annex a) -> TreeItem -> Annex a ifSymlink issymlink notsymlink ti@(TreeItem _f m _s) - | toBlobType m == Just SymlinkBlob = issymlink ti + | toTreeItemType m == Just TreeSymlink = issymlink ti | otherwise = notsymlink ti noAdjust :: TreeItem -> Annex (Maybe TreeItem) @@ -101,7 +101,7 @@ adjustToPointer ti@(TreeItem f _m s) = catKey s >>= \case Just k -> do Database.Keys.addAssociatedFile k f - Just . TreeItem f (fromBlobType FileBlob) + Just . TreeItem f (fromTreeItemType TreeFile) <$> hashPointerFile k Nothing -> return (Just ti) @@ -114,7 +114,7 @@ absf <- inRepo $ \r -> absPath $ fromTopFilePath f r linktarget <- calcRepo $ gitannexlink absf k - Just . TreeItem f (fromBlobType SymlinkBlob) + Just . TreeItem f (fromTreeItemType TreeSymlink) <$> hashSymlink linktarget Nothing -> return (Just ti) diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs --- a/Annex/AutoMerge.hs +++ b/Annex/AutoMerge.hs @@ -23,7 +23,7 @@ import qualified Git.Ref import qualified Git import qualified Git.Branch -import Git.Types (BlobType(..), fromBlobType) +import Git.Types (TreeItemType(..), fromTreeItemType) import Git.FilePath import Config import Annex.ReplaceFile @@ -185,21 +185,23 @@ Just sha -> catKey sha Nothing -> return Nothing - islocked select = select (LsFiles.unmergedBlobType u) == Just SymlinkBlob + islocked select = select (LsFiles.unmergedTreeItemType u) == Just TreeSymlink combinedmodes = case catMaybes [ourmode, theirmode] of [] -> Nothing l -> Just (combineModes l) where - ourmode = fromBlobType <$> LsFiles.valUs (LsFiles.unmergedBlobType u) - theirmode = fromBlobType <$> LsFiles.valThem (LsFiles.unmergedBlobType u) + ourmode = fromTreeItemType + <$> LsFiles.valUs (LsFiles.unmergedTreeItemType u) + theirmode = fromTreeItemType + <$> LsFiles.valThem (LsFiles.unmergedTreeItemType u) makeannexlink key select | islocked select = makesymlink key dest | otherwise = makepointer key dest destmode where dest = variantFile file key - destmode = fromBlobType <$> select (LsFiles.unmergedBlobType u) + destmode = fromTreeItemType <$> select (LsFiles.unmergedTreeItemType u) stagefile :: FilePath -> Annex FilePath stagefile f @@ -242,11 +244,11 @@ =<< fromRepo (UpdateIndex.lsSubTree b item) -- Update the work tree to reflect the graft. - unless inoverlay $ case (selectwant (LsFiles.unmergedBlobType u), selectunwant (LsFiles.unmergedBlobType u)) of + unless inoverlay $ case (selectwant (LsFiles.unmergedTreeItemType u), selectunwant (LsFiles.unmergedTreeItemType u)) of -- Symlinks are never left in work tree when -- there's a conflict with anything else. -- So, when grafting in a symlink, we must create it: - (Just SymlinkBlob, _) -> do + (Just TreeSymlink, _) -> do case selectwant' (LsFiles.unmergedSha u) of Nothing -> noop Just sha -> do @@ -254,7 +256,7 @@ replacewithsymlink item link -- And when grafting in anything else vs a symlink, -- the work tree already contains what we want. - (_, Just SymlinkBlob) -> noop + (_, Just TreeSymlink) -> noop _ -> ifM (withworktree item (liftIO . doesDirectoryExist)) -- a conflict between a file and a directory -- leaves the directory, so since a directory diff --git a/Annex/Branch.hs b/Annex/Branch.hs --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -463,7 +463,7 @@ sha <- Git.HashObject.hashFile h path hPutStrLn jlogh file streamer $ Git.UpdateIndex.updateIndexLine - sha FileBlob (asTopFilePath $ fileJournal file) + sha TreeFile (asTopFilePath $ fileJournal file) genstream dir h jh jlogh streamer -- Clean up the staged files, as listed in the temp log file. -- The temp file is used to avoid needing to buffer all the @@ -573,7 +573,7 @@ ChangeFile content' -> do sha <- hashBlob content' Annex.Queue.addUpdateIndex $ Git.UpdateIndex.pureStreamer $ - Git.UpdateIndex.updateIndexLine sha FileBlob (asTopFilePath file) + Git.UpdateIndex.updateIndexLine sha TreeFile (asTopFilePath file) apply rest file content' trustmap PreserveFile -> apply rest file content trustmap diff --git a/Annex/Link.hs b/Annex/Link.hs --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -120,11 +120,11 @@ stagePointerFile :: FilePath -> Maybe FileMode -> Sha -> Annex () stagePointerFile file mode sha = Annex.Queue.addUpdateIndex =<< - inRepo (Git.UpdateIndex.stageFile sha blobtype file) + inRepo (Git.UpdateIndex.stageFile sha treeitemtype file) where - blobtype - | maybe False isExecutable mode = ExecutableBlob - | otherwise = FileBlob + treeitemtype + | maybe False isExecutable mode = TreeExecutable + | otherwise = TreeFile writePointerFile :: FilePath -> Key -> Maybe FileMode -> IO () writePointerFile file k mode = do diff --git a/Annex/View.hs b/Annex/View.hs --- a/Annex/View.hs +++ b/Annex/View.hs @@ -19,7 +19,6 @@ import qualified Git.Ref import Git.UpdateIndex import Git.Sha -import Annex.HashObject import Git.Types import Git.FilePath import Annex.WorkTree @@ -29,7 +28,6 @@ import Logs.MetaData import Logs.View import Utility.Glob -import Utility.FileMode import Types.Command import CmdLine.Action @@ -327,8 +325,9 @@ narrowView :: View -> Annex Git.Branch narrowView = applyView' viewedFileReuse getViewedFileMetaData -{- Go through each file in the currently checked out branch. - - If the file is not annexed, skip it, unless it's a dotfile in the top. +{- Go through each staged file. + - If the file is not annexed, skip it, unless it's a dotfile in the top, + - or a file in a dotdir in the top. - Look up the metadata of annexed files, and generate any ViewedFiles, - and stage them. - @@ -337,39 +336,32 @@ applyView' :: MkViewedFile -> (FilePath -> MetaData) -> View -> Annex Git.Branch applyView' mkviewedfile getfilemetadata view = do top <- fromRepo Git.repoPath - (l, clean) <- inRepo $ Git.LsFiles.inRepo [top] + (l, clean) <- inRepo $ Git.LsFiles.stagedDetails [top] liftIO . nukeFile =<< fromRepo gitAnnexViewIndex uh <- withViewIndex $ inRepo Git.UpdateIndex.startUpdateIndex - forM_ l $ \f -> do + forM_ l $ \(f, sha, mode) -> do topf <- inRepo (toTopFilePath f) - go uh topf =<< lookupFile f + go uh topf sha (toTreeItemType =<< mode) =<< lookupFile f liftIO $ do void $ stopUpdateIndex uh void clean genViewBranch view where genviewedfiles = viewedFiles view mkviewedfile -- enables memoization - go uh topf (Just k) = do + + go uh topf _sha _mode (Just k) = do metadata <- getCurrentMetaData k let f = getTopFilePath topf let metadata' = getfilemetadata f `unionMetaData` metadata forM_ (genviewedfiles f metadata') $ \fv -> do f' <- fromRepo $ fromTopFilePath $ asTopFilePath fv stagesymlink uh f' =<< calcRepo (gitAnnexLink f' k) - go uh topf Nothing - | "." `isPrefixOf` getTopFilePath topf = do - f <- fromRepo $ fromTopFilePath topf - s <- liftIO $ getSymbolicLinkStatus f - if isSymbolicLink s - then stagesymlink uh f =<< liftIO (readSymbolicLink f) - else do - sha <- hashFile f - let blobtype = if isExecutable (fileMode s) - then ExecutableBlob - else FileBlob - liftIO . Git.UpdateIndex.streamUpdateIndex' uh - =<< inRepo (Git.UpdateIndex.stageFile sha blobtype f) - | otherwise = noop + go uh topf (Just sha) (Just treeitemtype) Nothing + | "." `isPrefixOf` getTopFilePath topf = + liftIO $ Git.UpdateIndex.streamUpdateIndex' uh $ + pureStreamer $ updateIndexLine sha treeitemtype topf + go _ _ _ _ _ = noop + stagesymlink uh f linktarget = do sha <- hashSymlink linktarget liftIO . Git.UpdateIndex.streamUpdateIndex' uh diff --git a/Annex/WorkTree.hs b/Annex/WorkTree.hs --- a/Annex/WorkTree.hs +++ b/Annex/WorkTree.hs @@ -71,9 +71,9 @@ =<< catKey (Git.LsTree.sha i) liftIO $ void cleanup where - isregfile i = case Git.Types.toBlobType (Git.LsTree.mode i) of - Just Git.Types.FileBlob -> True - Just Git.Types.ExecutableBlob -> True + isregfile i = case Git.Types.toTreeItemType (Git.LsTree.mode i) of + Just Git.Types.TreeFile -> True + Just Git.Types.TreeExecutable -> True _ -> False add i k = do let tf = Git.LsTree.file i diff --git a/Backend/Hash.hs b/Backend/Hash.hs --- a/Backend/Hash.hs +++ b/Backend/Hash.hs @@ -150,25 +150,40 @@ | c == '.' = True | otherwise = False -{- Upgrade keys that have the \ prefix on their sha due to a bug, or - - that contain non-alphanumeric characters in their extension. -} +{- Upgrade keys that have the \ prefix on their hash due to a bug, or + - that contain non-alphanumeric characters in their extension. + - + - Also, for a while migrate from eg SHA256E to SHA256 resulted in a SHA256 + - key that contained an extension inside its keyName. Upgrade those + - keys, removing the extension. + -} needsUpgrade :: Key -> Bool -needsUpgrade key = "\\" `isPrefixOf` keyHash key || - any (not . validInExtension) (takeExtensions $ keyName key) +needsUpgrade key = or + [ "\\" `isPrefixOf` keyHash key + , any (not . validInExtension) (takeExtensions $ keyName key) + , not (hasExt (keyVariety key)) && keyHash key /= keyName key + ] trivialMigrate :: Key -> Backend -> AssociatedFile -> Maybe Key trivialMigrate oldkey newbackend afile {- Fast migration from hashE to hash backend. -} - | migratable && hasExt newvariety = Just $ oldkey + | migratable && hasExt oldvariety = Just $ oldkey { keyName = keyHash oldkey , keyVariety = newvariety } {- Fast migration from hash to hashE backend. -} - | migratable && hasExt oldvariety = case afile of + | migratable && hasExt newvariety = case afile of AssociatedFile Nothing -> Nothing AssociatedFile (Just file) -> Just $ oldkey { keyName = keyHash oldkey ++ selectExtension file , keyVariety = newvariety + } + {- Upgrade to fix bad previous migration that created a + - non-extension preserving key, with an extension + - in its keyName. -} + | newvariety == oldvariety && not (hasExt oldvariety) && + keyHash oldkey /= keyName oldkey = Just $ oldkey + { keyName = keyHash oldkey } | otherwise = Nothing where diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,33 @@ +git-annex (6.20180529) upstream; urgency=medium + + * Prevent haskell http-client from decompressing gzip files, so downloads + of such files works the same as it used to with wget and curl. + * Workaround for bug in an old version of cryptonite that broke https + downloads, by using curl for downloads when git-annex is built with it. + * view, vadd: Fix crash when a git submodule has a name starting with a dot. + * Don't allow entering a view with staged or unstaged changes. + * move: --force was accidentially enabling two unrelated behaviors + since 6.20180427. The older behavior, which has never been well + documented and seems almost entirely useless, has been removed. + * copy: --force no longer does anything. + * migrate: Fix bug in migration between eg SHA256 and SHA256E, + that caused the extension to be included in SHA256 keys, + and omitted from SHA256E keys. + (Bug introduced in version 6.20170214) + * migrate: Check for above bug when migrating from SHA256 to SHA256 + (and same for SHA1 to SHA1 etc), and remove the extension that should + not be in the SHA256 key. + * fsck: Detect and warn when keys need an upgrade, either to fix up + from the above migrate bug, or to add missing size information + (a long ago transition), or because of a few other past key related + bugs. + * git-annex-shell: GIT_ANNEX_SHELL_APPENDONLY makes it allow writes, + but not deletion of annexed content. Note that securing pushes to + the git repository is left up to the user. + * setpresentkey: Added --batch support. + + -- Joey Hess Tue, 29 May 2018 13:05:26 -0400 + git-annex (6.20180509) upstream; urgency=medium * The old git-annex Android app is now deprecated in favor of running diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs --- a/CmdLine/GitAnnexShell.hs +++ b/CmdLine/GitAnnexShell.hs @@ -17,6 +17,7 @@ import CmdLine.GitAnnexShell.Checks import CmdLine.GitAnnexShell.Fields import Remote.GCrypt (getGCryptUUID) +import P2P.Protocol (ServerMode(..)) import qualified Command.ConfigList import qualified Command.InAnnex @@ -30,38 +31,43 @@ import qualified Command.GCryptSetup import qualified Command.P2PStdIO -cmds_readonly :: [Command] -cmds_readonly = - [ Command.ConfigList.cmd - , gitAnnexShellCheck Command.InAnnex.cmd - , gitAnnexShellCheck Command.LockContent.cmd - , gitAnnexShellCheck Command.SendKey.cmd - , gitAnnexShellCheck Command.TransferInfo.cmd - , gitAnnexShellCheck Command.NotifyChanges.cmd - ] +import qualified Data.Map as M -cmds_notreadonly :: [Command] -cmds_notreadonly = - [ gitAnnexShellCheck Command.RecvKey.cmd - , gitAnnexShellCheck Command.DropKey.cmd - , gitAnnexShellCheck Command.Commit.cmd - , Command.GCryptSetup.cmd +cmdsMap :: M.Map ServerMode [Command] +cmdsMap = M.fromList $ map mk + [ (ServeReadOnly, readonlycmds) + , (ServeAppendOnly, appendcmds) + , (ServeReadWrite, allcmds) ] + where + readonlycmds = + [ Command.ConfigList.cmd + , gitAnnexShellCheck Command.InAnnex.cmd + , gitAnnexShellCheck Command.LockContent.cmd + , gitAnnexShellCheck Command.SendKey.cmd + , gitAnnexShellCheck Command.TransferInfo.cmd + , gitAnnexShellCheck Command.NotifyChanges.cmd + -- p2pstdio checks the enviroment variables to + -- determine the security policy to use + , gitAnnexShellCheck Command.P2PStdIO.cmd + ] + appendcmds = readonlycmds ++ + [ gitAnnexShellCheck Command.RecvKey.cmd + , gitAnnexShellCheck Command.Commit.cmd + ] + allcmds = + [ gitAnnexShellCheck Command.DropKey.cmd + , Command.GCryptSetup.cmd + ] --- Commands that can operate readonly or not; they use checkNotReadOnly. -cmds_readonly_capable :: [Command] -cmds_readonly_capable = - [ gitAnnexShellCheck Command.P2PStdIO.cmd - ] + mk (s, l) = (s, map (adddirparam . noMessages) l) + adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c } -cmds_readonly_safe :: [Command] -cmds_readonly_safe = cmds_readonly ++ cmds_readonly_capable +cmdsFor :: ServerMode -> [Command] +cmdsFor = fromMaybe [] . flip M.lookup cmdsMap -cmds :: [Command] -cmds = map (adddirparam . noMessages) - (cmds_readonly ++ cmds_notreadonly ++ cmds_readonly_capable) - where - adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c } +cmdsList :: [Command] +cmdsList = concat $ M.elems cmdsMap globalOptions :: [GlobalOption] globalOptions = @@ -101,17 +107,19 @@ | otherwise = external c builtins :: [String] -builtins = map cmdname cmds +builtins = map cmdname cmdsList builtin :: String -> String -> [String] -> IO () builtin cmd dir params = do - unless (cmd `elem` map cmdname cmds_readonly_safe) + unless (cmd `elem` map cmdname (cmdsFor ServeReadOnly)) checkNotReadOnly + unless (cmd `elem` map cmdname (cmdsFor ServeAppendOnly)) + checkNotAppendOnly checkDirectory $ Just dir let (params', fieldparams, opts) = partitionParams params rsyncopts = ("RsyncOptions", unwords opts) fields = rsyncopts : filter checkField (parseFields fieldparams) - dispatch False (cmd : params') cmds globalOptions fields mkrepo + dispatch False (cmd : params') cmdsList globalOptions fields mkrepo "git-annex-shell" "Restricted login shell for git-annex only SSH access" where @@ -161,6 +169,6 @@ | otherwise = False failure :: IO () -failure = giveup $ "bad parameters\n\n" ++ usage h cmds +failure = giveup $ "bad parameters\n\n" ++ usage h cmdsList where h = "git-annex-shell [-c] command [parameters ...] [option ...]" diff --git a/CmdLine/GitAnnexShell/Checks.hs b/CmdLine/GitAnnexShell/Checks.hs --- a/CmdLine/GitAnnexShell/Checks.hs +++ b/CmdLine/GitAnnexShell/Checks.hs @@ -26,6 +26,12 @@ checkNotReadOnly :: IO () checkNotReadOnly = checkEnv readOnlyEnv +appendOnlyEnv :: String +appendOnlyEnv = "GIT_ANNEX_SHELL_APPENDONLY" + +checkNotAppendOnly :: IO () +checkNotAppendOnly = checkEnv appendOnlyEnv + checkEnv :: String -> IO () checkEnv var = checkEnvSet var >>= \case False -> noop diff --git a/Command/DiffDriver.hs b/Command/DiffDriver.hs --- a/Command/DiffDriver.hs +++ b/Command/DiffDriver.hs @@ -85,8 +85,8 @@ check rOldFile rOldMode (\r f -> r { rOldFile = f }) req >>= check rNewFile rNewMode (\r f -> r { rNewFile = f }) where - check getfile getmode setfile r = case readBlobType (getmode r) of - Just SymlinkBlob -> do + check getfile getmode setfile r = case readTreeItemType (getmode r) of + Just TreeSymlink -> do v <- getAnnexLinkTarget' (getfile r) False case fileKey . takeFileName =<< v of Nothing -> return r diff --git a/Command/Fsck.hs b/Command/Fsck.hs --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -129,6 +129,7 @@ , verifyWorkTree key file , checkKeySize key keystatus ai , checkBackend backend key keystatus afile + , checkKeyUpgrade backend key ai afile , checkKeyNumCopies key afile numcopies ] where @@ -408,6 +409,31 @@ , "); " , msg ] + +{- Check for keys that are upgradable. + - + - Warns and suggests the user migrate, but does not migrate itself, + - because migration can cause more disk space to be used, and makes + - worktree changes that need to be committed. + -} +checkKeyUpgrade :: Backend -> Key -> ActionItem -> AssociatedFile -> Annex Bool +checkKeyUpgrade backend key ai (AssociatedFile (Just file)) = + case Types.Backend.canUpgradeKey backend of + Just a | a key -> do + warning $ concat + [ actionItemDesc ai key + , ": Can be upgraded to an improved key format. " + , "You can do so by running: git annex migrate --backend=" + , formatKeyVariety (keyVariety key) ++ " " + , file + ] + return True + _ -> return True +checkKeyUpgrade _ _ _ (AssociatedFile Nothing) = + -- Don't suggest migrating without a filename, because + -- while possible to do, there is no actual benefit from + -- doing that in this situation. + return True {- Runs the backend specific check on a key's content object. - diff --git a/Command/Move.hs b/Command/Move.hs --- a/Command/Move.hs +++ b/Command/Move.hs @@ -186,15 +186,13 @@ next $ fromPerform src removewhen key afile fromOk :: Remote -> Key -> Annex Bool -fromOk src key = go =<< Annex.getState Annex.force +fromOk src key + | Remote.hasKeyCheap src = + either (const checklog) return =<< haskey + | otherwise = checklog where - go True = either (const $ return True) return =<< haskey - go False - | Remote.hasKeyCheap src = - either (const expensive) return =<< haskey - | otherwise = expensive haskey = Remote.hasKey src key - expensive = do + checklog = do u <- getUUID remotes <- Remote.keyPossibilities key return $ u /= Remote.uuid src && elem src remotes diff --git a/Command/P2PStdIO.hs b/Command/P2PStdIO.hs --- a/Command/P2PStdIO.hs +++ b/Command/P2PStdIO.hs @@ -26,10 +26,13 @@ start :: UUID -> CommandStart start theiruuid = do - servermode <- liftIO $ - Checks.checkEnvSet Checks.readOnlyEnv >>= return . \case - True -> P2P.ServeReadOnly - False -> P2P.ServeReadWrite + servermode <- liftIO $ do + ro <- Checks.checkEnvSet Checks.readOnlyEnv + ao <- Checks.checkEnvSet Checks.appendOnlyEnv + return $ case (ro, ao) of + (True, _) -> P2P.ServeReadOnly + (False, True) -> P2P.ServeAppendOnly + (False, False) -> P2P.ServeReadWrite myuuid <- getUUID conn <- stdioP2PConnection <$> Annex.gitRepo let server = do diff --git a/Command/SetPresentKey.hs b/Command/SetPresentKey.hs --- a/Command/SetPresentKey.hs +++ b/Command/SetPresentKey.hs @@ -16,19 +16,40 @@ command "setpresentkey" SectionPlumbing "change records of where key is present" (paramPair paramKey (paramPair paramUUID "[1|0]")) - (withParams seek) + (seek <$$> optParser) -seek :: CmdParams -> CommandSeek -seek = withWords start +data SetPresentKeyOptions = SetPresentKeyOptions + { params :: CmdParams + , batchOption :: BatchMode + } -start :: [String] -> CommandStart -start (ks:us:vs:[]) = do +optParser :: CmdParamsDesc -> Parser SetPresentKeyOptions +optParser desc = SetPresentKeyOptions + <$> cmdParams desc + <*> parseBatchOption + +seek :: SetPresentKeyOptions -> CommandSeek +seek o = case batchOption o of + Batch -> batchInput + (parseKeyStatus . words) + (batchCommandAction . start) + NoBatch -> either giveup (commandAction . start) + (parseKeyStatus $ params o) + +data KeyStatus = KeyStatus Key UUID LogStatus + +parseKeyStatus :: [String] -> Either String KeyStatus +parseKeyStatus (ks:us:vs:[]) = do + k <- maybe (Left "bad key") Right (file2key ks) + let u = toUUID us + s <- maybe (Left "bad value") Right (parseStatus vs) + return $ KeyStatus k u s +parseKeyStatus _ = Left "Bad input. Expected: key uuid value" + +start :: KeyStatus -> CommandStart +start (KeyStatus k u s) = do showStartKey "setpresentkey" k (mkActionItem k) - next $ perform k (toUUID us) s - where - k = fromMaybe (giveup "bad key") (file2key ks) - s = fromMaybe (giveup "bad value") (parseStatus vs) -start _ = giveup "Wrong number of parameters" + next $ perform k u s perform :: Key -> UUID -> LogStatus -> CommandPerform perform k u s = next $ do diff --git a/Command/Status.hs b/Command/Status.hs --- a/Command/Status.hs +++ b/Command/Status.hs @@ -43,8 +43,8 @@ start o locs = do (l, cleanup) <- inRepo $ getStatus ps locs getstatus <- ifM isDirect - ( return statusDirect - , return $ \s -> pure (Just s) + ( return (maybe (pure Nothing) statusDirect . simplifiedStatus) + , return (pure . simplifiedStatus) ) forM_ l $ \s -> maybe noop displayStatus =<< getstatus s ifM (liftIO cleanup) @@ -56,10 +56,16 @@ Nothing -> [] Just s -> [Param $ "--ignore-submodules="++s] +-- Prefer to show unstaged status in this simplified status. +simplifiedStatus :: StagedUnstaged Status -> Maybe Status +simplifiedStatus (StagedUnstaged { unstaged = Just s }) = Just s +simplifiedStatus (StagedUnstaged { staged = Just s }) = Just s +simplifiedStatus _ = Nothing + displayStatus :: Status -> Annex () --- renames not shown in this simplified status +-- Renames not shown in this simplified status displayStatus (Renamed _ _) = noop -displayStatus s = do +displayStatus s = do let c = statusChar s absf <- fromRepo $ fromTopFilePath (statusFile s) f <- liftIO $ relPathCwdToFile absf diff --git a/Command/View.hs b/Command/View.hs --- a/Command/View.hs +++ b/Command/View.hs @@ -12,6 +12,9 @@ import qualified Git.Command import qualified Git.Ref import qualified Git.Branch +import qualified Git.LsFiles as LsFiles +import Git.FilePath +import Git.Status import Types.View import Annex.View import Logs.View @@ -28,14 +31,43 @@ start [] = giveup "Specify metadata to include in view" start ps = do showStart' "view" Nothing - view <- mkView ps - go view =<< currentView + ifM safeToEnterView + ( do + view <- mkView ps + go view =<< currentView + , giveup "Not safe to enter view." + ) where go view Nothing = next $ perform view go view (Just v) | v == view = stop | otherwise = giveup "Already in a view. Use the vfilter and vadd commands to further refine this view." +safeToEnterView :: Annex Bool +safeToEnterView = do + (l, cleanup) <- inRepo $ getStatus [] [] + case filter dangerous l of + [] -> liftIO cleanup + _ -> do + warning "Your uncommitted changes would be lost when entering a view." + void $ liftIO cleanup + return False + where + dangerous (StagedUnstaged { staged = Nothing, unstaged = Nothing }) = False + -- Untracked files will not be affected by entering a view, + -- so are not dangerous. + dangerous (StagedUnstaged { staged = Just (Untracked _), unstaged = Nothing }) = False + dangerous (StagedUnstaged { unstaged = Just (Untracked _), staged = Nothing }) = False + dangerous (StagedUnstaged { unstaged = Just (Untracked _), staged = Just (Untracked _) }) = False + -- Staged changes would have their modifications either be + -- lost when entering a view, or committed as part of the view. + -- Either is dangerous because upon leaving the view; the staged + -- changes would be lost. + dangerous (StagedUnstaged { staged = Just _ }) = True + -- Unstaged changes to annexed files would get lost when entering a + -- view. + dangerous (StagedUnstaged { unstaged = Just _ }) = True + perform :: View -> CommandPerform perform view = do showAction "searching" @@ -65,15 +97,21 @@ when ok $ do setView view {- A git repo can easily have empty directories in it, - - and this pollutes the view, so remove them. -} - top <- fromRepo Git.repoPath - liftIO $ removeemptydirs top + - and this pollutes the view, so remove them. + - (However, emptry directories used by submodules are not + - removed.) -} + top <- liftIO . absPath =<< fromRepo Git.repoPath + (l, cleanup) <- inRepo $ + LsFiles.notInRepoIncludingEmptyDirectories False [top] + forM_ l (removeemptydir top) + liftIO $ void cleanup unlessM (liftIO $ doesDirectoryExist here) $ do showLongNote (cwdmissing top) return ok where - removeemptydirs top = mapM_ (tryIO . removeDirectory) - =<< dirTreeRecursiveSkipping (".git" `isSuffixOf`) top + removeemptydir top d = do + p <- inRepo $ toTopFilePath d + liftIO $ tryIO $ removeDirectory (top getTopFilePath p) cwdmissing top = unlines [ "This view does not include the subdirectory you are currently in." , "Perhaps you should: cd " ++ top diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -1,6 +1,6 @@ {- git ls-files interface - - - Copyright 2010,2012 Joey Hess + - Copyright 2010-2018 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -8,6 +8,7 @@ module Git.LsFiles ( inRepo, notInRepo, + notInRepoIncludingEmptyDirectories, allFiles, deleted, modified, @@ -44,10 +45,14 @@ {- Scans for files at the specified locations that are not checked into git. -} notInRepo :: Bool -> [FilePath] -> Repo -> IO ([FilePath], IO Bool) -notInRepo include_ignored l repo = pipeNullSplit params repo +notInRepo = notInRepo' [] + +notInRepo' :: [CommandParam] -> Bool -> [FilePath] -> Repo -> IO ([FilePath], IO Bool) +notInRepo' ps include_ignored l repo = pipeNullSplit params repo where params = concat [ [ Param "ls-files", Param "--others"] + , ps , exclude , [ Param "-z", Param "--" ] , map File l @@ -56,6 +61,11 @@ | include_ignored = [] | otherwise = [Param "--exclude-standard"] +{- Scans for files at the specified locations that are not checked into + - git. Empty directories are included in the result. -} +notInRepoIncludingEmptyDirectories :: Bool -> [FilePath] -> Repo -> IO ([FilePath], IO Bool) +notInRepoIncludingEmptyDirectories = notInRepo' [Param "--directory"] + {- Finds all files in the specified locations, whether checked into git or - not. -} allFiles :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) @@ -184,9 +194,9 @@ data Unmerged = Unmerged { unmergedFile :: FilePath - , unmergedBlobType :: Conflicting BlobType + , unmergedTreeItemType :: Conflicting TreeItemType , unmergedSha :: Conflicting Sha - } deriving (Show) + } {- Returns a list of the files in the specified locations that have - unresolved merge conflicts. @@ -213,23 +223,23 @@ data InternalUnmerged = InternalUnmerged { isus :: Bool , ifile :: FilePath - , iblobtype :: Maybe BlobType + , itreeitemtype :: Maybe TreeItemType , isha :: Maybe Sha - } deriving (Show) + } parseUnmerged :: String -> Maybe InternalUnmerged parseUnmerged s | null file = Nothing | otherwise = case words metadata of - (rawblobtype:rawsha:rawstage:_) -> do + (rawtreeitemtype:rawsha:rawstage:_) -> do stage <- readish rawstage :: Maybe Int if stage /= 2 && stage /= 3 then Nothing else do - blobtype <- readBlobType rawblobtype + treeitemtype <- readTreeItemType rawtreeitemtype sha <- extractSha rawsha return $ InternalUnmerged (stage == 2) file - (Just blobtype) (Just sha) + (Just treeitemtype) (Just sha) _ -> Nothing where (metadata, file) = separate (== '\t') s @@ -239,12 +249,12 @@ reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest where (rest, sibi) = findsib i is - (blobtypeA, blobtypeB, shaA, shaB) - | isus i = (iblobtype i, iblobtype sibi, isha i, isha sibi) - | otherwise = (iblobtype sibi, iblobtype i, isha sibi, isha i) + (treeitemtypeA, treeitemtypeB, shaA, shaB) + | isus i = (itreeitemtype i, itreeitemtype sibi, isha i, isha sibi) + | otherwise = (itreeitemtype sibi, itreeitemtype i, isha sibi, isha i) new = Unmerged { unmergedFile = ifile i - , unmergedBlobType = Conflicting blobtypeA blobtypeB + , unmergedTreeItemType = Conflicting treeitemtypeA treeitemtypeB , unmergedSha = Conflicting shaA shaB } findsib templatei [] = ([], removed templatei) @@ -253,6 +263,6 @@ | otherwise = (l:ls, removed templatei) removed templatei = templatei { isus = not (isus templatei) - , iblobtype = Nothing + , itreeitemtype = Nothing , isha = Nothing } diff --git a/Git/Repair.hs b/Git/Repair.hs --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -396,10 +396,10 @@ void cleanup return $ map fst3 bad where - reinject (file, Just sha, Just mode) = case toBlobType mode of + reinject (file, Just sha, Just mode) = case toTreeItemType mode of Nothing -> return Nothing - Just blobtype -> Just <$> - UpdateIndex.stageFile sha blobtype file r + Just treeitemtype -> Just <$> + UpdateIndex.stageFile sha treeitemtype file r reinject _ = return Nothing newtype GoodCommits = GoodCommits (S.Set Sha) diff --git a/Git/Status.hs b/Git/Status.hs --- a/Git/Status.hs +++ b/Git/Status.hs @@ -1,6 +1,6 @@ {- git status interface - - - Copyright 2015 Joey Hess + - Copyright 2015-2018 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -20,6 +20,11 @@ | TypeChanged TopFilePath | Untracked TopFilePath +data StagedUnstaged a = StagedUnstaged + { staged :: Maybe a + , unstaged :: Maybe a + } + statusChar :: Status -> Char statusChar (Modified _) = 'M' statusChar (Deleted _) = 'D' @@ -36,35 +41,32 @@ statusFile (TypeChanged f) = f statusFile (Untracked f) = f -parseStatusZ :: [String] -> [Status] +parseStatusZ :: [String] -> [StagedUnstaged Status] parseStatusZ = go [] where go c [] = reverse c go c (x:xs) = case x of - (sindex:sworktree:' ':f) -> - -- Look at both the index and worktree status, - -- preferring worktree. - case cparse sworktree <|> cparse sindex of - Just mks -> go (mks (asTopFilePath f) : c) xs - Nothing -> if sindex == 'R' - -- In -z mode, the name the - -- file was renamed to comes - -- first, and the next component - -- is the old filename. - then case xs of - (oldf:xs') -> go (Renamed (asTopFilePath oldf) (asTopFilePath f) : c) xs' - _ -> go c [] - else go c xs + (sstaged:sunstaged:' ':f) -> + case (cparse sstaged f xs, cparse sunstaged f xs) of + ((vstaged, xs1), (vunstaged, xs2)) -> + let v = StagedUnstaged + { staged = vstaged + , unstaged = vunstaged + } + xs' = fromMaybe xs (xs1 <|> xs2) + in go (v : c) xs' _ -> go c xs - cparse 'M' = Just Modified - cparse 'A' = Just Added - cparse 'D' = Just Deleted - cparse 'T' = Just TypeChanged - cparse '?' = Just Untracked - cparse _ = Nothing + cparse 'M' f _ = (Just (Modified (asTopFilePath f)), Nothing) + cparse 'A' f _ = (Just (Added (asTopFilePath f)), Nothing) + cparse 'D' f _ = (Just (Deleted (asTopFilePath f)), Nothing) + cparse 'T' f _ = (Just (TypeChanged (asTopFilePath f)), Nothing) + cparse '?' f _ = (Just (Untracked (asTopFilePath f)), Nothing) + cparse 'R' f (oldf:xs) = + (Just (Renamed (asTopFilePath oldf) (asTopFilePath f)), Just xs) + cparse _ _ _ = (Nothing, Nothing) -getStatus :: [CommandParam] -> [FilePath] -> Repo -> IO ([Status], IO Bool) +getStatus :: [CommandParam] -> [FilePath] -> Repo -> IO ([StagedUnstaged Status], IO Bool) getStatus ps fs r = do (ls, cleanup) <- pipeNullSplit ps' r return (parseStatusZ ls, cleanup) diff --git a/Git/Types.hs b/Git/Types.hs --- a/Git/Types.hs +++ b/Git/Types.hs @@ -1,6 +1,6 @@ {- git data types - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2018 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -77,32 +77,36 @@ readObjectType "tree" = Just TreeObject readObjectType _ = Nothing -{- Types of blobs. -} -data BlobType = FileBlob | ExecutableBlob | SymlinkBlob +{- Types of items in a tree. -} +data TreeItemType = TreeFile | TreeExecutable | TreeSymlink | TreeSubmodule deriving (Eq) -{- Git uses magic numbers to denote the type of a blob. -} -instance Show BlobType where - show FileBlob = "100644" - show ExecutableBlob = "100755" - show SymlinkBlob = "120000" +{- Git uses magic numbers to denote the type of a tree item. -} +readTreeItemType :: String -> Maybe TreeItemType +readTreeItemType "100644" = Just TreeFile +readTreeItemType "100755" = Just TreeExecutable +readTreeItemType "120000" = Just TreeSymlink +readTreeItemType "160000" = Just TreeSubmodule +readTreeItemType _ = Nothing -readBlobType :: String -> Maybe BlobType -readBlobType "100644" = Just FileBlob -readBlobType "100755" = Just ExecutableBlob -readBlobType "120000" = Just SymlinkBlob -readBlobType _ = Nothing +fmtTreeItemType :: TreeItemType -> String +fmtTreeItemType TreeFile = "100644" +fmtTreeItemType TreeExecutable = "100755" +fmtTreeItemType TreeSymlink = "120000" +fmtTreeItemType TreeSubmodule = "160000" -toBlobType :: FileMode -> Maybe BlobType -toBlobType 0o100644 = Just FileBlob -toBlobType 0o100755 = Just ExecutableBlob -toBlobType 0o120000 = Just SymlinkBlob -toBlobType _ = Nothing +toTreeItemType :: FileMode -> Maybe TreeItemType +toTreeItemType 0o100644 = Just TreeFile +toTreeItemType 0o100755 = Just TreeExecutable +toTreeItemType 0o120000 = Just TreeSymlink +toTreeItemType 0o160000 = Just TreeSubmodule +toTreeItemType _ = Nothing -fromBlobType :: BlobType -> FileMode -fromBlobType FileBlob = 0o100644 -fromBlobType ExecutableBlob = 0o100755 -fromBlobType SymlinkBlob = 0o120000 +fromTreeItemType :: TreeItemType -> FileMode +fromTreeItemType TreeFile = 0o100644 +fromTreeItemType TreeExecutable = 0o100755 +fromTreeItemType TreeSymlink = 0o120000 +fromTreeItemType TreeSubmodule = 0o160000 data Commit = Commit { commitTree :: Sha diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs --- a/Git/UnionMerge.hs +++ b/Git/UnionMerge.hs @@ -91,7 +91,7 @@ where [_colonmode, _bmode, asha, bsha, _status] = words info use sha = return $ Just $ - updateIndexLine sha FileBlob $ asTopFilePath file + updateIndexLine sha TreeFile $ asTopFilePath file -- We don't know how the file is encoded, but need to -- split it into lines to union merge. Using the -- FileSystemEncoding for this is a hack, but ensures there diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -83,14 +83,19 @@ {- Generates a line suitable to be fed into update-index, to add - a given file with a given sha. -} -updateIndexLine :: Sha -> BlobType -> TopFilePath -> String -updateIndexLine sha filetype file = - show filetype ++ " blob " ++ fromRef sha ++ "\t" ++ indexPath file +updateIndexLine :: Sha -> TreeItemType -> TopFilePath -> String +updateIndexLine sha treeitemtype file = concat + [ fmtTreeItemType treeitemtype + , " blob " + , fromRef sha + , "\t" + , indexPath file + ] -stageFile :: Sha -> BlobType -> FilePath -> Repo -> IO Streamer -stageFile sha filetype file repo = do +stageFile :: Sha -> TreeItemType -> FilePath -> Repo -> IO Streamer +stageFile sha treeitemtype file repo = do p <- toTopFilePath file repo - return $ pureStreamer $ updateIndexLine sha filetype p + return $ pureStreamer $ updateIndexLine sha treeitemtype p {- A streamer that removes a file from the index. -} unstageFile :: FilePath -> Repo -> IO Streamer @@ -106,13 +111,13 @@ stageSymlink file sha repo = do !line <- updateIndexLine <$> pure sha - <*> pure SymlinkBlob + <*> pure TreeSymlink <*> toTopFilePath file repo return $ pureStreamer line {- A streamer that applies a DiffTreeItem to the index. -} stageDiffTreeItem :: Diff.DiffTreeItem -> Streamer -stageDiffTreeItem d = case toBlobType (Diff.dstmode d) of +stageDiffTreeItem d = case toTreeItemType (Diff.dstmode d) of Nothing -> unstageFile' (Diff.file d) Just t -> pureStreamer $ updateIndexLine (Diff.dstsha d) t (Diff.file d) diff --git a/P2P/Protocol.hs b/P2P/Protocol.hs --- a/P2P/Protocol.hs +++ b/P2P/Protocol.hs @@ -411,13 +411,21 @@ return ServerContinue handler _ = return ServerUnexpected -data ServerMode = ServeReadOnly | ServeReadWrite +data ServerMode + = ServeReadOnly + -- ^ Allow reading, but not writing. + | ServeAppendOnly + -- ^ Allow reading, and storing new objects, but not deleting objects. + | ServeReadWrite + -- ^ Full read and write access. + deriving (Eq, Ord) -- | Serve the protocol, with a peer that has authenticated. serveAuthed :: ServerMode -> UUID -> Proto () serveAuthed servermode myuuid = void $ serverLoop handler where readonlyerror = net $ sendMessage (ERROR "this repository is read-only; write access denied") + appendonlyerror = net $ sendMessage (ERROR "this repository is append-only; removal denied") handler (VERSION theirversion) = do let v = min theirversion maxProtocolVersion net $ setProtocolVersion v @@ -439,22 +447,15 @@ ServeReadWrite -> do sendSuccess =<< local (removeContent key) return ServerContinue + ServeAppendOnly -> do + appendonlyerror + return ServerContinue ServeReadOnly -> do readonlyerror return ServerContinue handler (PUT af key) = case servermode of - ServeReadWrite -> do - have <- local $ checkContentPresent key - if have - then net $ sendMessage ALREADY_HAVE - else do - let sizer = tmpContentSize key - let storer = \o l b v -> unVerified $ - storeContent key af o l b v - (ok, _v) <- receiveContent Nothing nullMeterUpdate sizer storer PUT_FROM - when ok $ - local $ setPresent key myuuid - return ServerContinue + ServeReadWrite -> handleput af key + ServeAppendOnly -> handleput af key ServeReadOnly -> do readonlyerror return ServerContinue @@ -467,6 +468,10 @@ let goahead = net $ relayService service case (servermode, service) of (ServeReadWrite, _) -> goahead + (ServeAppendOnly, UploadPack) -> goahead + -- git protocol could be used to overwrite + -- refs or something, so don't allow + (ServeAppendOnly, ReceivePack) -> readonlyerror (ServeReadOnly, UploadPack) -> goahead (ServeReadOnly, ReceivePack) -> readonlyerror -- After connecting to git, there may be unconsumed data @@ -478,6 +483,19 @@ net $ sendMessage (CHANGED refs) return ServerContinue handler _ = return ServerUnexpected + + handleput af key = do + have <- local $ checkContentPresent key + if have + then net $ sendMessage ALREADY_HAVE + else do + let sizer = tmpContentSize key + let storer = \o l b v -> unVerified $ + storeContent key af o l b v + (ok, _v) <- receiveContent Nothing nullMeterUpdate sizer storer PUT_FROM + when ok $ + local $ setPresent key myuuid + return ServerContinue sendContent :: Key -> AssociatedFile -> Offset -> MeterUpdate -> Proto Bool sendContent key af offset@(Offset n) p = go =<< local (contentSize key) diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -1402,7 +1402,7 @@ check_is_link f what = do git_annex_expectoutput "find" ["--include=*", f] [Git.FilePath.toInternalGitPath f] l <- annexeval $ Annex.inRepo $ Git.LsTree.lsTreeFiles Git.Ref.headRef [f] - all (\i -> Git.Types.toBlobType (Git.LsTree.mode i) == Just Git.Types.SymlinkBlob) l + all (\i -> Git.Types.toTreeItemType (Git.LsTree.mode i) == Just Git.Types.TreeSymlink) l @? (what ++ " " ++ f ++ " lost symlink bit after merge: " ++ show l) {- A v6 unlocked file that conflicts with a locked file should be resolved diff --git a/Utility/Url.hs b/Utility/Url.hs --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -90,7 +90,13 @@ UrlOptions useragent reqheaders urldownloader applyrequest manager where urldownloader = if null reqparams +#if MIN_VERSION_cryptonite(0,6,0) then DownloadWithConduit +#else + -- Work around for old cryptonite bug that broke tls. + -- https://github.com/vincenthz/hs-tls/issues/109 + then DownloadWithCurl reqparams +#endif else DownloadWithCurl reqparams applyrequest = \r -> r { requestHeaders = requestHeaders r ++ addedheaders } addedheaders = uaheader ++ otherheaders @@ -278,11 +284,20 @@ downloadconduit req = catchMaybeIO (getFileSize file) >>= \case Nothing -> runResourceT $ do - resp <- http req (httpManager uo) + resp <- http req' (httpManager uo) if responseStatus resp == ok200 then store zeroBytesProcessed WriteMode resp else showrespfailure resp - Just sz -> resumeconduit req sz + Just sz -> resumeconduit req' sz + where + -- Override http-client's default decompression of gzip + -- compressed files. We want the unmodified file content. + req' = req + { requestHeaders = (hAcceptEncoding, "identity") : + filter ((/= hAcceptEncoding) . fst) + (requestHeaders req) + , decompress = const False + } alreadydownloaded sz s h = s == requestedRangeNotSatisfiable416 && case lookup hContentRange h of @@ -322,7 +337,8 @@ _ -> show he #else let msg = case he of - StatusCodeException status _ _ -> statusMessage status + StatusCodeException status _ _ -> + B8.toString (statusMessage status) _ -> show he #endif hPutStrLn stderr $ "download failed: " ++ msg diff --git a/doc/git-annex-copy.mdwn b/doc/git-annex-copy.mdwn --- a/doc/git-annex-copy.mdwn +++ b/doc/git-annex-copy.mdwn @@ -46,12 +46,6 @@ already has content. This can be faster, but might skip copying content to the remote in some cases. -* `--force` - - When copying content from a remote, ignore location tracking information - and always check if the remote has content. Can be useful if the location - tracking information is out of date. - * `--all` `-A` Rather than specifying a filename or path to copy, this option can be diff --git a/doc/git-annex-move.mdwn b/doc/git-annex-move.mdwn --- a/doc/git-annex-move.mdwn +++ b/doc/git-annex-move.mdwn @@ -69,12 +69,6 @@ already has content. This can be faster, but might skip moving content to the remote in some cases. -* `--force` - - When moving content from a remote, ignore location tracking information - and always check if the remote has content. Can be useful if the location - tracking information is out of date. - * file matching options The [[git-annex-matching-options]](1) diff --git a/doc/git-annex-setpresentkey.mdwn b/doc/git-annex-setpresentkey.mdwn --- a/doc/git-annex-setpresentkey.mdwn +++ b/doc/git-annex-setpresentkey.mdwn @@ -14,6 +14,13 @@ Use 1 to indicate the key is present, or 0 to indicate the key is not present. +# OPTIONS + +* `--batch` + + Enables batch mode, in which lines are read from stdin. + The line format is "key uuid [1|0]" + # SEE ALSO [[git-annex]](1) diff --git a/doc/git-annex-shell.mdwn b/doc/git-annex-shell.mdwn --- a/doc/git-annex-shell.mdwn +++ b/doc/git-annex-shell.mdwn @@ -129,7 +129,8 @@ * GIT_ANNEX_SHELL_READONLY - If set, disallows any command that could modify the repository. + If set, disallows any action that could modify the git-annex + repository. Note that this does not prevent passing commands on to git-shell. For that, you also need ... @@ -137,6 +138,19 @@ * GIT_ANNEX_SHELL_LIMITED If set, disallows running git-shell to handle unknown commands. + +* GIT_ANNEX_SHELL_APPENDONLY + + If set, allows data to be written to the git-annex repository, + but does not allow data to be removed from it. + + Note that this does not prevent passing commands on to git-shell, + so you will have to separately configure git to reject pushes that + overwrite branches or are otherwise not appends. The git pre-receive + hook may be useful for accomplishing this. + + It's a good idea to enable annex.securehashesonly in a repository + that's set up this way. * GIT_ANNEX_SHELL_DIRECTORY diff --git a/git-annex.cabal b/git-annex.cabal --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 6.20180509 +Version: 6.20180529 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess