summaryrefslogtreecommitdiff
path: root/Types
diff options
context:
space:
mode:
Diffstat (limited to 'Types')
-rw-r--r--Types/Crypto.hs10
-rw-r--r--Types/GitConfig.hs8
-rw-r--r--Types/Key.hs12
-rw-r--r--Types/Limit.hs20
-rw-r--r--Types/Remote.hs14
-rw-r--r--Types/ScheduledActivity.hs69
-rw-r--r--Types/StandardGroups.hs2
-rw-r--r--Types/TrustLevel.hs2
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)