diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/KeyRing.hs | 33 |
1 files changed, 24 insertions, 9 deletions
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs index bb8b598..fc21122 100644 --- a/lib/KeyRing.hs +++ b/lib/KeyRing.hs | |||
@@ -17,10 +17,11 @@ | |||
17 | {-# LANGUAGE CPP #-} | 17 | {-# LANGUAGE CPP #-} |
18 | {-# LANGUAGE TupleSections #-} | 18 | {-# LANGUAGE TupleSections #-} |
19 | {-# LANGUAGE ViewPatterns #-} | 19 | {-# LANGUAGE ViewPatterns #-} |
20 | {-# LANGUAGE PatternGuards #-} | ||
20 | {-# LANGUAGE OverloadedStrings #-} | 21 | {-# LANGUAGE OverloadedStrings #-} |
21 | {-# LANGUAGE DeriveFunctor #-} | 22 | {-# LANGUAGE DeriveFunctor #-} |
22 | {-# LANGUAGE DoAndIfThenElse #-} | 23 | {-# LANGUAGE DoAndIfThenElse #-} |
23 | {-# LANGUAGE NoPatternGuards #-} | 24 | {-# LANGUAGE PatternGuards #-} |
24 | {-# LANGUAGE ForeignFunctionInterface #-} | 25 | {-# LANGUAGE ForeignFunctionInterface #-} |
25 | module KeyRing | 26 | module KeyRing |
26 | ( | 27 | ( |
@@ -347,8 +348,8 @@ spillable (spill -> KF_None) = False | |||
347 | spillable _ = True | 348 | spillable _ = True |
348 | 349 | ||
349 | isMutable :: StreamInfo -> Bool | 350 | isMutable :: StreamInfo -> Bool |
350 | isMutable (fill -> KF_None) = False | 351 | isMutable stream | KF_None <- fill stream = False |
351 | isMutable _ = True | 352 | isMutable _ = True |
352 | 353 | ||
353 | isring :: FileType -> Bool | 354 | isring :: FileType -> Bool |
354 | isring (KeyRingFile {}) = True | 355 | isring (KeyRingFile {}) = True |
@@ -1411,9 +1412,9 @@ writeHostsFiles | |||
1411 | -> IO [(FilePath, KikiReportAction)] | 1412 | -> IO [(FilePath, KikiReportAction)] |
1412 | writeHostsFiles krd ctx (hostdbs0,hostdbs,u1,gpgnames,outgoing_names) = do | 1413 | writeHostsFiles krd ctx (hostdbs0,hostdbs,u1,gpgnames,outgoing_names) = do |
1413 | let hns = files isMutableHosts | 1414 | let hns = files isMutableHosts |
1414 | isMutableHosts (fill -> KF_None) = False | 1415 | isMutableHosts stream | KF_None <- fill stream = False |
1415 | isMutableHosts (typ -> Hosts) = True | 1416 | isMutableHosts stream | Hosts <- typ stream = True |
1416 | isMutableHosts _ = False | 1417 | isMutableHosts _ = False |
1417 | files istyp = do | 1418 | files istyp = do |
1418 | (f,stream) <- Map.toList (opFiles krd) | 1419 | (f,stream) <- Map.toList (opFiles krd) |
1419 | guard (istyp stream) | 1420 | guard (istyp stream) |
@@ -2011,9 +2012,9 @@ writeWalletKeys :: KeyRingOperation -> KeyDB -> Maybe Packet -> IO (KikiConditio | |||
2011 | writeWalletKeys krd db wk = do | 2012 | writeWalletKeys krd db wk = do |
2012 | let cs = db `coinKeysOwnedBy` wk | 2013 | let cs = db `coinKeysOwnedBy` wk |
2013 | -- export wallet keys | 2014 | -- export wallet keys |
2014 | isMutableWallet (fill -> KF_None) = False | 2015 | isMutableWallet stream | KF_None <- fill stream = False |
2015 | isMutableWallet (typ -> WalletFile {}) = True | 2016 | isMutableWallet stream | WalletFile {} <- typ stream = True |
2016 | isMutableWallet _ = False | 2017 | isMutableWallet _ = False |
2017 | files pred = do | 2018 | files pred = do |
2018 | (f,stream) <- Map.toList (opFiles krd) | 2019 | (f,stream) <- Map.toList (opFiles krd) |
2019 | guard (pred stream) | 2020 | guard (pred stream) |
@@ -3080,6 +3081,20 @@ findTag tag topk subkey subsigs = (xs',minsig,ys') | |||
3080 | return ( null $ tag \\ hshed, sig) | 3081 | return ( null $ tag \\ hshed, sig) |
3081 | 3082 | ||
3082 | mkUsage :: String -> SignatureSubpacket | 3083 | mkUsage :: String -> SignatureSubpacket |
3084 | mkUsage tag | Just flags <- lookup tag specials | ||
3085 | = KeyFlagsPacket | ||
3086 | { certify_keys = fromEnum flags .&. 0x1 /= 0 | ||
3087 | , sign_data = fromEnum flags .&. 0x2 /= 0 | ||
3088 | , encrypt_communication = fromEnum flags .&. 0x4 /= 0 | ||
3089 | , encrypt_storage = fromEnum flags .&. 0x8 /= 0 | ||
3090 | , split_key = False | ||
3091 | , authentication = False | ||
3092 | , group_key = False | ||
3093 | } | ||
3094 | where | ||
3095 | flagsets = [Special .. VouchSignEncrypt] | ||
3096 | specials = map (\f -> (usageString f, f)) flagsets | ||
3097 | |||
3083 | mkUsage tag = NotationDataPacket | 3098 | mkUsage tag = NotationDataPacket |
3084 | { human_readable = True | 3099 | { human_readable = True |
3085 | , notation_name = "usage@" | 3100 | , notation_name = "usage@" |