summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/KeyRing.hs44
1 files changed, 25 insertions, 19 deletions
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index c7fcebc..5cd5c71 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -1829,27 +1829,31 @@ insertSubkey transcode kk (KeyData top topsigs uids subs) tags inputfile key0 =
1829 tops2k = s2k $ packet top 1829 tops2k = s2k $ packet top
1830 doDecrypt = transcode (Unencrypted,S2K 100 "") 1830 doDecrypt = transcode (Unencrypted,S2K 100 "")
1831 fname = resolveForReport Nothing inputfile 1831 fname = resolveForReport Nothing inputfile
1832 wkun <- doDecrypt top 1832 subkk = keykey key0
1833 try wkun $ \wkun -> do 1833 istor = do
1834 key' <- transcode (topcipher,tops2k) $ mappedPacket "" key0 1834 guard ("tor" `elem` mapMaybe usage tags)
1835 try key' $ \key -> do 1835 return $ torUIDFromKey key0
1836 let subkk = keykey key 1836 addOrigin (SubKey mp sigs) =
1837 (is_new, subkey) = maybe (True, SubKey (mappedPacket fname key)
1838 [])
1839 ( (False,) . addOrigin )
1840 (Map.lookup subkk subs)
1841 where
1842 addOrigin (SubKey mp sigs) =
1843 let mp' = mp 1837 let mp' = mp
1844 { locations = Map.insert fname 1838 { locations = Map.insert fname
1845 (origin (packet mp) (-1)) 1839 (origin (packet mp) (-1))
1846 (locations mp) } 1840 (locations mp) }
1847 in SubKey mp' sigs 1841 in SubKey mp' sigs
1848 subs' = Map.insert subkk subkey subs
1849 1842
1850 istor = do 1843 subkey_result <- do
1851 guard ("tor" `elem` mapMaybe usage tags) 1844 case Map.lookup subkk subs of
1852 return $ torUIDFromKey key 1845 Just sub -> return $ KikiSuccess (False,addOrigin sub,Nothing)
1846 Nothing -> do
1847 wkun' <- doDecrypt top
1848 try wkun' $ \wkun -> do
1849 key' <- transcode (topcipher,tops2k) $ mappedPacket "" key0
1850 try key' $ \key -> do
1851 return $ KikiSuccess (True, SubKey (mappedPacket fname key) [], Just (wkun,key))
1852
1853
1854 try subkey_result $ \(is_new,subkey,decrypted) -> do
1855
1856 let subs' = Map.insert subkk subkey subs
1853 1857
1854 uids' <- flip (maybe $ return $ KikiSuccess (uids,[])) istor $ \idstr -> do 1858 uids' <- flip (maybe $ return $ KikiSuccess (uids,[])) istor $ \idstr -> do
1855 let has_torid = do 1859 let has_torid = do
@@ -1860,10 +1864,12 @@ insertSubkey transcode kk (KeyData top topsigs uids subs) tags inputfile key0 =
1860 signatures_over $ verify (Message [packet top]) s 1864 signatures_over $ verify (Message [packet top]) s
1861 flip (flip maybe $ const $ return $ KikiSuccess (uids,[])) has_torid $ do 1865 flip (flip maybe $ const $ return $ KikiSuccess (uids,[])) has_torid $ do
1862 1866
1863 let keyflags = keyFlags wkun (map packet $ flattenAllUids fname True uids) 1867 let keyflags = keyFlags (error "dummy argument (insertSubkey)") (map packet $ flattenAllUids fname True uids)
1864 uid = UserIDPacket idstr 1868 uid = UserIDPacket idstr
1865 -- sig_ov = fst $ torsig g (packet top) wkun uid timestamp keyflags 1869 -- sig_ov = fst $ torsig g (packet top) wkun uid timestamp keyflags
1866 tor_ov = makeInducerSig (packet top) wkun uid keyflags 1870 tor_ov = makeInducerSig (packet top) (packet top) uid keyflags
1871 wkun' <- maybe (doDecrypt top) (return . KikiSuccess . fst) decrypted
1872 try wkun' $ \wkun -> do
1867 sig_ov <- pgpSign (Message [wkun]) 1873 sig_ov <- pgpSign (Message [wkun])
1868 tor_ov 1874 tor_ov
1869 SHA1 1875 SHA1
@@ -1882,7 +1888,7 @@ insertSubkey transcode kk (KeyData top topsigs uids subs) tags inputfile key0 =
1882 1888
1883 let SubKey subkey_p subsigs = subkey 1889 let SubKey subkey_p subsigs = subkey
1884 wk = packet top 1890 wk = packet top
1885 (xs',minsig,ys') = findTag tags wk key subsigs 1891 (xs',minsig,ys') = findTag tags wk key0 subsigs
1886 doInsert mbsig = do 1892 doInsert mbsig = do
1887 -- NEW SUBKEY BINDING SIGNATURE 1893 -- NEW SUBKEY BINDING SIGNATURE
1888 -- XXX: Here I assume that key0 is the unencrypted version 1894 -- XXX: Here I assume that key0 is the unencrypted version
@@ -1898,7 +1904,7 @@ insertSubkey transcode kk (KeyData top topsigs uids subs) tags inputfile key0 =
1898 1904
1899 report <- let f = if is_new then (++[(fname,YieldSecretKeyPacket s)]) 1905 report <- let f = if is_new then (++[(fname,YieldSecretKeyPacket s)])
1900 else id 1906 else id
1901 s = show (fmap fst minsig,fingerprint key) 1907 s = show (fmap fst minsig,fingerprint key0)
1902 in return (f report) 1908 in return (f report)
1903 1909
1904 case minsig of 1910 case minsig of