diff options
Diffstat (limited to 'Types')
-rw-r--r-- | Types/Crypto.hs | 10 | ||||
-rw-r--r-- | Types/GitConfig.hs | 8 | ||||
-rw-r--r-- | Types/Key.hs | 12 | ||||
-rw-r--r-- | Types/Limit.hs | 20 | ||||
-rw-r--r-- | Types/Remote.hs | 14 | ||||
-rw-r--r-- | Types/ScheduledActivity.hs | 69 | ||||
-rw-r--r-- | Types/StandardGroups.hs | 2 | ||||
-rw-r--r-- | Types/TrustLevel.hs | 2 |
8 files changed, 127 insertions, 10 deletions
diff --git a/Types/Crypto.hs b/Types/Crypto.hs index e97d02ba8..1a9a7774a 100644 --- a/Types/Crypto.hs +++ b/Types/Crypto.hs @@ -8,6 +8,7 @@ module Types.Crypto ( Cipher(..), StorableCipher(..), + EncryptedCipherVariant(..), KeyIds(..), Mac(..), readMac, @@ -22,9 +23,12 @@ import Data.Digest.Pure.SHA import Utility.Gpg (KeyIds(..)) -- XXX ideally, this would be a locked memory region -newtype Cipher = Cipher String +data Cipher = Cipher String | MacOnlyCipher String -data StorableCipher = EncryptedCipher String KeyIds | SharedCipher String +data StorableCipher = EncryptedCipher String EncryptedCipherVariant KeyIds + | SharedCipher String + deriving (Ord, Eq) +data EncryptedCipherVariant = Hybrid | PubKey deriving (Ord, Eq) {- File names are (client-side) MAC'ed on special remotes. @@ -66,4 +70,4 @@ calcMac mac = case mac of HmacSha384 -> showDigest $* hmacSha384 HmacSha512 -> showDigest $* hmacSha512 where - ($*) g f x y = g $ f x y + ($*) g f x y = g $ f x y diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index d5d234ca9..b573a9a25 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -37,10 +37,13 @@ data GitConfig = GitConfig , annexAutoCommit :: Bool , annexDebug :: Bool , annexWebOptions :: [String] + , annexQuviOptions :: [String] , annexWebDownloadCommand :: Maybe String , annexCrippledFileSystem :: Bool , annexLargeFiles :: Maybe String + , annexFsckNudge :: Bool , coreSymlinks :: Bool + , gcryptId :: Maybe String } extractGitConfig :: Git.Repo -> GitConfig @@ -62,10 +65,13 @@ extractGitConfig r = GitConfig , annexAutoCommit = getbool (annex "autocommit") True , annexDebug = getbool (annex "debug") False , annexWebOptions = getwords (annex "web-options") + , annexQuviOptions = getwords (annex "quvi-options") , annexWebDownloadCommand = getmaybe (annex "web-download-command") , annexCrippledFileSystem = getbool (annex "crippledfilesystem") False , annexLargeFiles = getmaybe (annex "largefiles") + , annexFsckNudge = getbool (annex "fscknudge") True , coreSymlinks = getbool "core.symlinks" True + , gcryptId = getmaybe "core.gcrypt-id" } where get k def = fromMaybe def $ getmayberead k @@ -102,6 +108,7 @@ data RemoteGitConfig = RemoteGitConfig , remoteAnnexBupRepo :: Maybe String , remoteAnnexBupSplitOptions :: [String] , remoteAnnexDirectory :: Maybe FilePath + , remoteAnnexGCrypt :: Maybe String , remoteAnnexHookType :: Maybe String {- A regular git remote's git repository config. -} , remoteGitConfig :: Maybe GitConfig @@ -125,6 +132,7 @@ extractRemoteGitConfig r remotename = RemoteGitConfig , remoteAnnexBupRepo = getmaybe "buprepo" , remoteAnnexBupSplitOptions = getoptions "bup-split-options" , remoteAnnexDirectory = notempty $ getmaybe "directory" + , remoteAnnexGCrypt = notempty $ getmaybe "gcrypt" , remoteAnnexHookType = notempty $ getmaybe "hooktype" , remoteGitConfig = Nothing } diff --git a/Types/Key.hs b/Types/Key.hs index a0c6d83bc..598d5ed20 100644 --- a/Types/Key.hs +++ b/Types/Key.hs @@ -14,7 +14,8 @@ module Types.Key ( key2file, file2key, - prop_idempotent_key_encode + prop_idempotent_key_encode, + prop_idempotent_key_decode ) where import System.Posix.Types @@ -59,7 +60,9 @@ key2file Key { keyBackendName = b, keySize = s, keyMtime = m, keyName = n } = _ ?: _ = "" file2key :: FilePath -> Maybe Key -file2key s = if key == Just stubKey then Nothing else key +file2key s + | key == Just stubKey || (keyName <$> key) == Just "" || (keyBackendName <$> key) == Just "" = Nothing + | otherwise = key where key = startbackend stubKey s @@ -81,10 +84,13 @@ file2key s = if key == Just stubKey then Nothing else key instance Arbitrary Key where arbitrary = Key - <$> arbitrary + <$> (listOf1 $ elements $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_\r\n \t") <*> (listOf1 $ elements ['A'..'Z']) -- BACKEND <*> ((abs <$>) <$> arbitrary) -- size cannot be negative <*> arbitrary prop_idempotent_key_encode :: Key -> Bool prop_idempotent_key_encode k = Just k == (file2key . key2file) k + +prop_idempotent_key_decode :: FilePath -> Bool +prop_idempotent_key_decode f = maybe True (\k -> key2file k == f) (file2key f) diff --git a/Types/Limit.hs b/Types/Limit.hs new file mode 100644 index 000000000..4436f6953 --- /dev/null +++ b/Types/Limit.hs @@ -0,0 +1,20 @@ +{- types for limits + - + - Copyright 2013 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Types.Limit where + +import Common.Annex +import Types.FileMatcher + +import qualified Data.Set as S + +type MkLimit = String -> Either String MatchFiles + +type AssumeNotPresent = S.Set UUID +type MatchFiles = AssumeNotPresent -> FileInfo -> Annex Bool diff --git a/Types/Remote.hs b/Types/Remote.hs index 8492be06d..8a94dcc05 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -18,6 +18,8 @@ import Types.UUID import Types.GitConfig import Config.Cost import Utility.Metered +import Git.Types +import Utility.SafeCommand type RemoteConfigKey = String type RemoteConfig = M.Map RemoteConfigKey String @@ -29,9 +31,9 @@ data RemoteTypeA a = RemoteType { -- enumerates remotes of this type enumerate :: a [Git.Repo], -- generates a remote of this type - generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (RemoteA a), + generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (Maybe (RemoteA a)), -- initializes or changes a remote - setup :: UUID -> RemoteConfig -> a RemoteConfig + setup :: Maybe UUID -> RemoteConfig -> a (RemoteConfig, UUID) } instance Eq (RemoteTypeA a) where @@ -42,7 +44,7 @@ data RemoteA a = Remote { -- each Remote has a unique uuid uuid :: UUID, -- each Remote has a human visible name - name :: String, + name :: RemoteName, -- Remotes have a use cost; higher is more expensive cost :: Cost, -- Transfers a key to the remote. @@ -63,6 +65,12 @@ data RemoteA a = Remote { hasKeyCheap :: Bool, -- Some remotes can provide additional details for whereis. whereisKey :: Maybe (Key -> a [String]), + -- Some remotes can run a fsck operation on the remote, + -- without transferring all the data to the local repo + -- The parameters are passed to the fsck command on the remote. + remoteFsck :: Maybe ([CommandParam] -> a (IO Bool)), + -- Runs an action to repair the remote's git repository. + repairRepo :: Maybe (a Bool -> a (IO Bool)), -- a Remote has a persistent configuration store config :: RemoteConfig, -- git repo for the Remote diff --git a/Types/ScheduledActivity.hs b/Types/ScheduledActivity.hs new file mode 100644 index 000000000..b683409ce --- /dev/null +++ b/Types/ScheduledActivity.hs @@ -0,0 +1,69 @@ +{- git-annex scheduled activities + - + - Copyright 2013 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Types.ScheduledActivity where + +import Common +import Utility.Scheduled +import Utility.HumanTime +import Types.UUID + +import Data.Either + +data ScheduledActivity + = ScheduledSelfFsck Schedule Duration + | ScheduledRemoteFsck UUID Schedule Duration + deriving (Eq, Read, Show, Ord) + +{- Activities that run on a remote, within a time window, so + - should be run when the remote gets connected. -} +connectActivityUUID :: ScheduledActivity -> Maybe UUID +connectActivityUUID (ScheduledRemoteFsck u (Schedule _ AnyTime) _) = Just u +connectActivityUUID _ = Nothing + +getSchedule :: ScheduledActivity -> Schedule +getSchedule (ScheduledSelfFsck s _) = s +getSchedule (ScheduledRemoteFsck _ s _) = s + +getDuration :: ScheduledActivity -> Duration +getDuration (ScheduledSelfFsck _ d) = d +getDuration (ScheduledRemoteFsck _ _ d) = d + +fromScheduledActivity :: ScheduledActivity -> String +fromScheduledActivity (ScheduledSelfFsck s d) = unwords + [ "fsck self", fromDuration d, fromSchedule s ] +fromScheduledActivity (ScheduledRemoteFsck u s d) = unwords + [ "fsck", fromUUID u, fromDuration d, fromSchedule s ] + +toScheduledActivity :: String -> Maybe ScheduledActivity +toScheduledActivity = eitherToMaybe . parseScheduledActivity + +parseScheduledActivity :: String -> Either String ScheduledActivity +parseScheduledActivity s = case words s of + ("fsck":"self":d:rest) -> qualified $ ScheduledSelfFsck + <$> parseSchedule (unwords rest) + <*> getduration d + ("fsck":u:d:rest) -> qualified $ ScheduledRemoteFsck + <$> pure (toUUID u) + <*> parseSchedule (unwords rest) + <*> getduration d + _ -> qualified $ Left "unknown activity" + where + qualified (Left e) = Left $ e ++ " in \"" ++ s ++ "\"" + qualified v = v + getduration d = maybe (Left $ "failed to parse duration \""++d++"\"") Right (parseDuration d) + +fromScheduledActivities :: [ScheduledActivity] -> String +fromScheduledActivities = intercalate "; " . map fromScheduledActivity + +parseScheduledActivities :: String -> Either String [ScheduledActivity] +parseScheduledActivities s + | null bad = Right good + | otherwise = Left $ intercalate "; " bad + where + (bad, good) = partitionEithers $ + map parseScheduledActivity $ split "; " s diff --git a/Types/StandardGroups.hs b/Types/StandardGroups.hs index 30b882282..2d977a357 100644 --- a/Types/StandardGroups.hs +++ b/Types/StandardGroups.hs @@ -77,7 +77,7 @@ preferredContent ClientGroup = lastResort $ preferredContent TransferGroup = lastResort $ "not (inallgroup=client and copies=client:2) and (" ++ preferredContent ClientGroup ++ ")" preferredContent BackupGroup = "include=*" -preferredContent IncrementalBackupGroup = lastResort $ +preferredContent IncrementalBackupGroup = lastResort "include=* and (not copies=incrementalbackup:1)" preferredContent SmallArchiveGroup = lastResort $ "(include=*/archive/* or include=archive/*) and (" ++ preferredContent FullArchiveGroup ++ ")" diff --git a/Types/TrustLevel.hs b/Types/TrustLevel.hs index 27325cd2b..a72dbb8c6 100644 --- a/Types/TrustLevel.hs +++ b/Types/TrustLevel.hs @@ -17,6 +17,8 @@ import qualified Data.Map as M import Types.UUID +-- This order may seem backwards, but we generally want to list dead +-- remotes last and trusted ones first. data TrustLevel = Trusted | SemiTrusted | UnTrusted | DeadTrusted deriving (Eq, Enum, Ord, Bounded) |