summaryrefslogtreecommitdiff
path: root/lib/Types.hs
blob: 86836e0b25caf9605a743be9fb19abe98a379fd2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
{-# LANGUAGE DeriveFunctor #-}
module Types where

import           Data.Map as Map (Map)
import qualified Data.Map as Map
import           Data.OpenPGP
import           Data.OpenPGP.Util
import           FunctorToMaybe
import qualified Data.ByteString.Lazy as L
import qualified System.Posix.Types as Posix

-- | This type describes an idempotent transformation (merge or import) on a
-- set of GnuPG keyrings and other key files.
data KeyRingOperation = KeyRingOperation
    { opFiles :: Map InputFile StreamInfo
    -- ^ Indicates files to be read or updated.
    , opPassphrases :: [PassphraseSpec]
    -- ^ Indicates files or file descriptors where passphrases can be found.
    , opTransforms :: [Transform]
    -- ^ Transformations to be performed on the key pool after all files have
    -- been read and before any have been written.
    , opHome :: Maybe FilePath
    -- ^ If provided, this is the directory where the 'HomeSec' and 'HomePub'
    -- files reside.  Otherwise, the evironment variable $GNUPGHOME is consulted
    -- and if that is not set, it falls back to $HOME/.gnupg.
    }
 deriving (Eq,Show)

data InputFile = HomeSec
               -- ^ A file named secring.gpg located in the home directory.
               -- See 'opHome'.
               | HomePub
               -- ^ A file named pubring.gpg located in the home directory.
               -- See 'opHome'.
               | ArgFile FilePath
               -- ^ Contents will be read or written from the specified path.
               | FileDesc Posix.Fd
               -- ^ Contents will be read or written from the specified file
               -- descriptor.
               | Pipe Posix.Fd Posix.Fd
               -- ^ Contents will be read from the first descriptor and updated
               -- content will be writen to the second. Note: Don't use Pipe
               -- for 'Wallet' files. (TODO: Wallet support)
               | Generate Int GenerateKeyParams
               -- ^ New key packets will be generated if there is no
               -- matching content already in the key pool. The integer is
               -- a unique id number so that multiple generations can be
               -- inserted into 'opFiles'
 deriving (Eq,Ord,Show)

-- | This type describes how 'runKeyRing' will treat a file.
data StreamInfo = StreamInfo
    { access :: Access
    -- ^ Indicates whether the file is allowed to contain secret information.
    , typ :: FileType
    -- ^ Indicates the format and content type of the file.
    , fill :: KeyFilter
    -- ^ This filter controls what packets will be inserted into a file.
    , spill :: KeyFilter
    --
    -- ^ Use this to indicate whether or not a file's contents should be
    -- available for updating other files.  Note that although its type is
    -- 'KeyFilter', it is usually interpretted as a boolean flag.  Details
    -- depend on 'typ' and are as follows:
    --
    -- 'KeyRingFile':
    --
    --  * 'KF_None' - The file's contents will not be shared.
    --
    --  * otherwise - The file's contents will be shared.
    --
    -- 'PEMFile':
    --
    --  * 'KF_None'  - The file's contents will not be shared.
    --
    --  * 'KF_Match' - The file's key will be shared with the specified owner
    --  key and usage tag.  If 'fill' is also a 'KF_Match', then it must be
    --  equal to this value; changing the usage or owner of a key is not
    --  supported via the fill/spill mechanism.
    --
    --  * otherwise  - Unspecified.  Do not use.
    --
    -- 'WalletFile':
    --
    --  * The 'spill' setting is ignored and the file's contents are shared.
    --  (TODO)
    --
    -- 'Hosts': 
    --
    --  * The 'spill' setting is ignored and the file's contents are shared.
    --  (TODO)
    --
    , initializer :: Initializer
    -- ^ If 'typ' is 'PEMFile' and an 'External' 'initializer' string is set,
    -- then it is interpretted as a shell command that may be used to create
    -- the key if it does not exist.
    , transforms :: [Transform]
    -- ^ Per-file transformations that occur before the contents of a file are
    -- spilled into the common pool.
    }
 deriving (Eq,Show)


-- | This type is used to indicate where to obtain passphrases.
data PassphraseSpec = PassphraseSpec
    { passSpecRingFile :: Maybe FilePath
    -- ^ If not Nothing, the passphrase is to be used for packets
    -- from this file.
    , passSpecKeySpec :: Maybe String
    -- ^ Non-Nothing value reserved for future use.
    -- (TODO: Use this to implement per-key passphrase associations).
    , passSpecPassFile :: InputFile
    -- ^ The passphrase will be read from this file or file descriptor.
    }
    -- | Use this to carry pasphrases from a previous run.
    | PassphraseMemoizer PacketTranscoder
    | PassphraseAgent

instance Show PassphraseSpec where
    show (PassphraseSpec a b c) = "PassphraseSpec "++show (a,b,c)
    show (PassphraseMemoizer _) = "PassphraseMemoizer"
instance Eq PassphraseSpec where
    PassphraseSpec a b c == PassphraseSpec d e f
        = and [a==d,b==e,c==f]
    _ == _
        = False



data Transform =
        Autosign
        -- ^ This operation will make signatures for any tor-style UID
        -- that matches a tor subkey and thus can be authenticated without
        -- requring the judgement of a human user.
        --
        -- A tor-style UID is one of the following form:
        --
        -- > Anonymous <root@HOSTNAME.onion>
        | DeleteSubkeyByFingerprint String
        -- ^ Delete the subkey specified by the given fingerprint and any
        -- associated signatures on that key.
        | DeleteSubkeyByUsage String
        -- ^ Delete the subkey specified by the given fingerprint and any
        -- associated signatures on that key.
 deriving (Eq,Ord,Show)

-- | Use this type to indicate whether a file of type 'KeyRingFile' is expected
-- to contain secret or public PGP key packets.  Note that it is not supported
-- to mix both in the same file and that the secret key packets include all of
-- the information contained in their corresponding public key packets.
data Access = AutoAccess -- ^ secret or public as appropriate based on existing content.
                         --   (see 'rtRingAccess')
            | Sec        -- ^ secret information
            | Pub        -- ^ public information
 deriving (Eq,Ord,Show)

data FileType = KeyRingFile
              | PEMFile
              | WalletFile
              | DNSPresentation
              | Hosts
              | SshFile
 deriving (Eq,Ord,Enum,Show)

-- type UsageTag = String
data Initializer = NoCreate | Internal GenerateKeyParams | External String | WarnMissing String
 deriving (Eq,Ord,Show)



type PacketTranscoder = (SymmetricAlgorithm,S2K) -> MappedPacket -> IO (KikiCondition Packet)
type PacketDecrypter = MappedPacket -> IO (KikiCondition Packet)

-- | Note that the documentation here is intended for when this value is
-- assigned to 'fill'.  For other usage, see 'spill'.
data KeyFilter = KF_None -- ^ No keys will be imported.
               | KF_Match String -- ^ Only the key that matches the spec will be imported.
               | KF_Subkeys   -- ^ Subkeys will be imported if their owner key is
                              -- already in the ring.  TODO: Even if their signatures
                              -- are bad?
               | KF_Authentic -- ^ Keys are imported if they belong to an authenticated
                              -- identity (signed or self-authenticating).
               | KF_All -- ^ All keys will be imported.
  deriving (Eq,Ord,Show)

-- | The position and acces a packet had before the operation
data OriginFlags = OriginFlags
        { originallyPublic :: Bool
        -- ^ false if SecretKeyPacket
        , originalNum :: Int
        -- ^ packets are numbered, starting from 1..
        } deriving Show

type OriginMap = Map FilePath OriginFlags

type MappedPacket = OriginMapped Packet
data OriginMapped a = MappedPacket
        { packet :: a
        , locations :: OriginMap
        } deriving Show
instance Functor OriginMapped where
    fmap f (MappedPacket x ls) = MappedPacket (f x) ls

origin :: Packet -> Int -> OriginFlags
origin p n = OriginFlags ispub n
 where
    ispub = case p of
                    SecretKeyPacket {} -> False
                    _                  -> True

mappedPacket :: FilePath -> Packet -> MappedPacket
mappedPacket filename p = MappedPacket
    { packet = p
    , locations = Map.singleton filename (origin p (-1))
    }

mappedPacketWithHint :: FilePath -> Packet -> Int -> MappedPacket
mappedPacketWithHint filename p hint = MappedPacket
    { packet = p
    , locations = Map.singleton filename (origin p hint)
    }


-- | This type is used to indicate success or failure
-- and in the case of success, return the computed object.
-- The 'FunctorToMaybe' class is implemented to facilitate
-- branching on failture.
data KikiCondition a = KikiSuccess a
    | FailedToLock [FilePath]
    | BadPassphrase
    | FailedToMakeSignature
    | CantFindHome
    | AmbiguousKeySpec FilePath
    | CannotImportMasterKey
    | NoWorkingKey
 deriving ( Functor, Show )

instance FunctorToMaybe KikiCondition where
    functorToMaybe (KikiSuccess a) = Just a
    functorToMaybe _               = Nothing

instance Applicative KikiCondition where
    pure a  = KikiSuccess a
    f <*> a =
        case functorToEither f of
            Right f  -> case functorToEither a of
                            Right a  -> pure (f a)
                            Left err -> err
            Left err -> err

data InputFileContext = InputFileContext
    { homesecPath :: FilePath
    , homepubPath :: FilePath
    }


-- | The 'KeyKey'-type is used to store the information of a key
--   which is used for finger-printing and as a lookup key into
--   maps.  This type may be changed to an actual fingerprint in
--   in the future.
type KeyKey = [L.ByteString]

keykey :: Packet -> KeyKey
keykey key =
    -- Note: The key's timestamp is normally included in it's fingerprint.
    --       This is undesirable for kiki because it causes the same
    --       key to be imported multiple times and show as apparently
    --       distinct keys with different fingerprints.
    --       Thus, we will remove the timestamp.
    fingerprint_material (key {timestamp=0}) -- TODO: smaller key?

isKey :: Packet -> Bool
isKey (PublicKeyPacket {}) = True
isKey (SecretKeyPacket {}) = True
isKey _                    = False

isSecretKey :: Packet -> Bool
isSecretKey (SecretKeyPacket {}) = True
isSecretKey _                    = False


isUserID :: Packet -> Bool
isUserID (UserIDPacket {}) = True
isUserID _                 = False

isTrust :: Packet -> Bool
isTrust (TrustPacket {}) = True
isTrust _                = False

-- matchpr computes the fingerprint of the given key truncated to
-- be the same lenght as the given fingerprint for comparison.
--
-- matchpr fp = Data.List.Extra.takeEnd (length fp)
--
matchpr :: String -> Packet -> String
matchpr fp k = reverse $ zipWith const (reverse (fingerprint k)) fp