diff options
-rw-r--r-- | lib/KeyRing.hs | 44 |
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 |