diff options
Diffstat (limited to 'KeyRing.hs')
-rw-r--r-- | KeyRing.hs | 32 |
1 files changed, 31 insertions, 1 deletions
@@ -893,7 +893,7 @@ buildKeyDB :: (MappedPacket -> IO (KikiCondition Packet)) | |||
893 | ([Hosts.Hosts], | 893 | ([Hosts.Hosts], |
894 | [Hosts.Hosts], | 894 | [Hosts.Hosts], |
895 | Hosts.Hosts, | 895 | Hosts.Hosts, |
896 | [(SockAddr, ([ByteString], [ByteString]))], | 896 | [(SockAddr, (KeyKey, KeyKey))], |
897 | [SockAddr]) ) | 897 | [SockAddr]) ) |
898 | ,[(FilePath,KikiReportAction)])) | 898 | ,[(FilePath,KikiReportAction)])) |
899 | buildKeyDB doDecrypt secring pubring grip0 keyring = do | 899 | buildKeyDB doDecrypt secring pubring grip0 keyring = do |
@@ -1735,6 +1735,7 @@ sigpackets typ hashed unhashed = return $ | |||
1735 | 0 -- Word16 -- Left 16 bits of the signed hash value | 1735 | 0 -- Word16 -- Left 16 bits of the signed hash value |
1736 | [] -- [MPI] | 1736 | [] -- [MPI] |
1737 | 1737 | ||
1738 | secretToPublic :: Packet -> Packet | ||
1738 | secretToPublic pkt@(SecretKeyPacket {}) = | 1739 | secretToPublic pkt@(SecretKeyPacket {}) = |
1739 | PublicKeyPacket { version = version pkt | 1740 | PublicKeyPacket { version = version pkt |
1740 | , timestamp = timestamp pkt | 1741 | , timestamp = timestamp pkt |
@@ -1763,6 +1764,8 @@ slurpWIPKeys stamp cs = | |||
1763 | in maybe (ks,b58:js) (\(net,Message [k])->((net,k):ks,js)) mb | 1764 | in maybe (ks,b58:js) (\(net,Message [k])->((net,k):ks,js)) mb |
1764 | 1765 | ||
1765 | 1766 | ||
1767 | decode_btc_key :: | ||
1768 | Enum timestamp => timestamp -> String -> Maybe (Word8, Message) | ||
1766 | decode_btc_key timestamp str = do | 1769 | decode_btc_key timestamp str = do |
1767 | (network_id,us) <- base58_decode str | 1770 | (network_id,us) <- base58_decode str |
1768 | return . (network_id,) $ Message $ do | 1771 | return . (network_id,) $ Message $ do |
@@ -1853,8 +1856,10 @@ readPacketsFromFile fname = do | |||
1853 | return $ decode input | 1856 | return $ decode input |
1854 | #endif | 1857 | #endif |
1855 | 1858 | ||
1859 | now :: IO Integer | ||
1856 | now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime | 1860 | now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime |
1857 | 1861 | ||
1862 | signature_time :: SignatureOver -> Word32 | ||
1858 | signature_time ov = case if null cs then ds else cs of | 1863 | signature_time ov = case if null cs then ds else cs of |
1859 | [] -> minBound | 1864 | [] -> minBound |
1860 | xs -> last (sort xs) | 1865 | xs -> last (sort xs) |
@@ -1866,6 +1871,7 @@ signature_time ov = case if null cs then ds else cs of | |||
1866 | creationTime (SignatureCreationTimePacket t) = [t] | 1871 | creationTime (SignatureCreationTimePacket t) = [t] |
1867 | creationTime _ = [] | 1872 | creationTime _ = [] |
1868 | 1873 | ||
1874 | splitAtMinBy :: (t -> t -> Ordering) -> [t] -> ([t], [t]) | ||
1869 | splitAtMinBy comp xs = minimumBy comp' xxs | 1875 | splitAtMinBy comp xs = minimumBy comp' xxs |
1870 | where | 1876 | where |
1871 | xxs = zip (inits xs) (tails xs) | 1877 | xxs = zip (inits xs) (tails xs) |
@@ -1876,6 +1882,14 @@ splitAtMinBy comp xs = minimumBy comp' xxs | |||
1876 | 1882 | ||
1877 | 1883 | ||
1878 | 1884 | ||
1885 | findTag :: | ||
1886 | String | ||
1887 | -> Packet | ||
1888 | -> Packet | ||
1889 | -> [(MappedPacket, b)] | ||
1890 | -> ([(MappedPacket, b)], | ||
1891 | Maybe (Bool, (MappedPacket, b)), | ||
1892 | [(MappedPacket, b)]) | ||
1879 | findTag tag wk subkey subsigs = (xs',minsig,ys') | 1893 | findTag tag wk subkey subsigs = (xs',minsig,ys') |
1880 | where | 1894 | where |
1881 | vs = map (\sig -> | 1895 | vs = map (\sig -> |
@@ -1905,6 +1919,14 @@ findTag tag wk subkey subsigs = (xs',minsig,ys') | |||
1905 | return (tag `elem` ks, sig) | 1919 | return (tag `elem` ks, sig) |
1906 | 1920 | ||
1907 | 1921 | ||
1922 | makeSig :: | ||
1923 | (MappedPacket -> IO (KikiCondition Packet)) | ||
1924 | -> MappedPacket | ||
1925 | -> [Char] | ||
1926 | -> MappedPacket | ||
1927 | -> [Char] | ||
1928 | -> Maybe (MappedPacket, Map.Map k a) | ||
1929 | -> IO (KikiCondition ((MappedPacket, Map.Map k a), [KikiReportAction])) | ||
1908 | makeSig doDecrypt top fname subkey_p tag mbsig = do | 1930 | makeSig doDecrypt top fname subkey_p tag mbsig = do |
1909 | let wk = packet top | 1931 | let wk = packet top |
1910 | wkun <- doDecrypt top | 1932 | wkun <- doDecrypt top |
@@ -2036,18 +2058,21 @@ origin p n = OriginFlags ispub n | |||
2036 | SecretKeyPacket {} -> False | 2058 | SecretKeyPacket {} -> False |
2037 | _ -> True | 2059 | _ -> True |
2038 | 2060 | ||
2061 | mappedPacket :: FilePath -> Packet -> MappedPacket | ||
2039 | mappedPacket filename p = MappedPacket | 2062 | mappedPacket filename p = MappedPacket |
2040 | { packet = p | 2063 | { packet = p |
2041 | , usage_tag = Nothing | 2064 | , usage_tag = Nothing |
2042 | , locations = Map.singleton filename (origin p (-1)) | 2065 | , locations = Map.singleton filename (origin p (-1)) |
2043 | } | 2066 | } |
2044 | 2067 | ||
2068 | keykey :: Packet -> KeyKey | ||
2045 | keykey key = | 2069 | keykey key = |
2046 | -- Note: The key's timestamp is included in it's fingerprint. | 2070 | -- Note: The key's timestamp is included in it's fingerprint. |
2047 | -- Therefore, the same key with a different timestamp is | 2071 | -- Therefore, the same key with a different timestamp is |
2048 | -- considered distinct using this keykey implementation. | 2072 | -- considered distinct using this keykey implementation. |
2049 | fingerprint_material (key {timestamp=0}) -- TODO: smaller key? | 2073 | fingerprint_material (key {timestamp=0}) -- TODO: smaller key? |
2050 | 2074 | ||
2075 | uidkey :: Packet -> String | ||
2051 | uidkey (UserIDPacket str) = str | 2076 | uidkey (UserIDPacket str) = str |
2052 | 2077 | ||
2053 | merge :: KeyDB -> FilePath -> Message -> KeyDB | 2078 | merge :: KeyDB -> FilePath -> Message -> KeyDB |
@@ -2207,8 +2232,11 @@ unsig fname isPublic (sig,trustmap) = | |||
2207 | asMapped n p = let m = mappedPacket fname p | 2232 | asMapped n p = let m = mappedPacket fname p |
2208 | in m { locations = fmap (\x->x {originalNum=n}) (locations m) } | 2233 | in m { locations = fmap (\x->x {originalNum=n}) (locations m) } |
2209 | 2234 | ||
2235 | concatSort :: | ||
2236 | FilePath -> ([a] -> MappedPacket) -> (b -> [a]) -> [b] -> [a] | ||
2210 | concatSort fname getp f = concat . sortByHint fname getp . map f | 2237 | concatSort fname getp f = concat . sortByHint fname getp . map f |
2211 | 2238 | ||
2239 | sortByHint :: FilePath -> (a -> MappedPacket) -> [a] -> [a] | ||
2212 | sortByHint fname f = sortBy (comparing gethint) | 2240 | sortByHint fname f = sortBy (comparing gethint) |
2213 | where | 2241 | where |
2214 | gethint = maybe defnum originalNum . Map.lookup fname . locations . f | 2242 | gethint = maybe defnum originalNum . Map.lookup fname . locations . f |
@@ -2369,9 +2397,11 @@ fingerdress topk = maybe zero id $ Hosts.inet_pton addr_str | |||
2369 | colons (a:b:c:d:xs@(_:_)) = [a,b,c,d,':'] ++ colons xs | 2397 | colons (a:b:c:d:xs@(_:_)) = [a,b,c,d,':'] ++ colons xs |
2370 | colons xs = xs | 2398 | colons xs = xs |
2371 | 2399 | ||
2400 | backsig :: SignatureSubpacket -> Maybe Packet | ||
2372 | backsig (EmbeddedSignaturePacket s) = Just s | 2401 | backsig (EmbeddedSignaturePacket s) = Just s |
2373 | backsig _ = Nothing | 2402 | backsig _ = Nothing |
2374 | 2403 | ||
2404 | socketFamily :: SockAddr -> Family | ||
2375 | socketFamily (SockAddrInet _ _) = AF_INET | 2405 | socketFamily (SockAddrInet _ _) = AF_INET |
2376 | socketFamily (SockAddrInet6 _ _ _ _) = AF_INET6 | 2406 | socketFamily (SockAddrInet6 _ _ _ _) = AF_INET6 |
2377 | socketFamily (SockAddrUnix _) = AF_UNIX | 2407 | socketFamily (SockAddrUnix _) = AF_UNIX |