summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2016-04-24 03:41:20 -0400
committerjoe <joe@jerkface.net>2016-04-24 03:41:20 -0400
commit51bc655f4b0acb30ff873c8c32c9aacb1408258e (patch)
treecb06e8bd7b190de4c9d7ab3722c48aa676b127bf
parent9baaf54aa426416e23fe79dee1d6812d1635f9a2 (diff)
init-key now checks cross-certification before exporting ipsec keys.
-rw-r--r--KeyRing.hs48
-rw-r--r--kiki.hs20
2 files changed, 43 insertions, 25 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 53a1a34..0fbf2c2 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -99,6 +99,7 @@ module KeyRing
99 , KeySpec(..) 99 , KeySpec(..)
100 , getHostnames 100 , getHostnames
101 , secretPemFromPacket 101 , secretPemFromPacket
102 , getCrossSignedSubkeys
102 ) where 103 ) where
103 104
104import System.Environment 105import System.Environment
@@ -3328,27 +3329,12 @@ flattenUid :: FilePath -> Bool -> (String,([SigAndTrust],OriginMap)) -> [MappedP
3328flattenUid fname ispub (str,(sigs,om)) = 3329flattenUid fname ispub (str,(sigs,om)) =
3329 (mappedPacket "" $ UserIDPacket str) {locations=om} : concatSort fname head (unsig fname ispub) sigs 3330 (mappedPacket "" $ UserIDPacket str) {locations=om} : concatSort fname head (unsig fname ispub) sigs
3330 3331
3331getHostnames :: KeyData -> (SockAddr, ([L.ByteString],[L.ByteString])) 3332getCrossSignedSubkeys :: Packet -> Map.Map KeyKey SubKey -> String -> [Packet]
3332getHostnames (KeyData topmp _ uids subs) = (addr,(onames,othernames)) 3333getCrossSignedSubkeys topk subs tag = do
3333 where
3334 othernames = do
3335 mp <- flattenAllUids "" True uids
3336 let p = packet mp
3337 guard $ isSignaturePacket p
3338 uh <- unhashed_subpackets p
3339 case uh of
3340 NotationDataPacket True "hostname@" v
3341 -> return $ Char8.pack v
3342 _ -> mzero
3343
3344 addr = fingerdress topk
3345 -- name = fromMaybe "" $ listToMaybe onames -- TODO: more than one tor key?
3346 topk = packet topmp
3347 torkeys = do
3348 SubKey k sigs <- Map.elems subs 3334 SubKey k sigs <- Map.elems subs
3349 let subk = packet k 3335 let subk = packet k
3350 let sigs' = do 3336 let sigs' = do
3351 torsig <- filter (has_tag "tor") $ map (packet . fst) sigs 3337 torsig <- filter (has_tag tag) $ map (packet . fst) sigs
3352 sig <- (signatures $ Message [topk,subk,torsig]) 3338 sig <- (signatures $ Message [topk,subk,torsig])
3353 let v = verify (Message [topk]) sig 3339 let v = verify (Message [topk]) sig
3354 -- Require parent's signature 3340 -- Require parent's signature
@@ -3364,9 +3350,35 @@ getHostnames (KeyData topmp _ uids subs) = (addr,(onames,othernames))
3364 return torsig 3350 return torsig
3365 guard (not $ null sigs') 3351 guard (not $ null sigs')
3366 return subk 3352 return subk
3353 where
3367 has_tag tag p = isSignaturePacket p 3354 has_tag tag p = isSignaturePacket p
3368 && or [ tag `elem` mapMaybe usage (hashed_subpackets p) 3355 && or [ tag `elem` mapMaybe usage (hashed_subpackets p)
3369 , tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) ] 3356 , tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) ]
3357
3358
3359-- |
3360-- Returns (ip6 fingerprint address,(onion names,other host names))
3361--
3362-- Requires a validly cross-signed tor key for each onion name returned.
3363-- (Signature checks are performed.)
3364getHostnames :: KeyData -> (SockAddr, ([L.ByteString],[L.ByteString]))
3365getHostnames (KeyData topmp _ uids subs) = (addr,(onames,othernames))
3366 where
3367 othernames = do
3368 mp <- flattenAllUids "" True uids
3369 let p = packet mp
3370 guard $ isSignaturePacket p
3371 uh <- unhashed_subpackets p
3372 case uh of
3373 NotationDataPacket True "hostname@" v
3374 -> return $ Char8.pack v
3375 _ -> mzero
3376
3377 addr = fingerdress topk
3378 -- name = fromMaybe "" $ listToMaybe onames -- TODO: more than one tor key?
3379 topk = packet topmp
3380 torkeys = getCrossSignedSubkeys topk subs "tor"
3381
3370 -- subkeyPacket (SubKey k _ ) = k 3382 -- subkeyPacket (SubKey k _ ) = k
3371 onames :: [L.ByteString] 3383 onames :: [L.ByteString]
3372 onames = map ( (<> ".onion") 3384 onames = map ( (<> ".onion")
diff --git a/kiki.hs b/kiki.hs
index 865e551..4aa5885 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -1573,6 +1573,7 @@ kiki "init-key" args = do
1573 let writeFileWARNING fname bs = do 1573 let writeFileWARNING fname bs = do
1574 --TODO 1574 --TODO
1575 hPutStrLn stderr $ fname ++ ": DID NOT CHECK TRUST (TODO)" 1575 hPutStrLn stderr $ fname ++ ": DID NOT CHECK TRUST (TODO)"
1576 writeFile fname bs
1576 flip (maybe $ warn "missing working key?") (rtGrip rt) $ \grip -> do 1577 flip (maybe $ warn "missing working key?") (rtGrip rt) $ \grip -> do
1577 gotc <- doesFileExist (sshcpathpub) 1578 gotc <- doesFileExist (sshcpathpub)
1578 when (not gotc) $ do 1579 when (not gotc) $ do
@@ -1596,18 +1597,21 @@ kiki "init-key" args = do
1596 notme kd = keykey (keyPacket kd) /= kk 1597 notme kd = keykey (keyPacket kd) /= kk
1597 1598
1598 installConctact kd = do 1599 installConctact kd = do
1600 -- The getHostnames command requires a valid cross-signed tor key
1601 -- for each onion name returned in (_,(ns,_)).
1599 let (_,(ns,_)) = getHostnames kd 1602 let (_,(ns,_)) = getHostnames kd
1600 contactname = fmap Char8.unpack $ listToMaybe ns 1603 contactname = fmap Char8.unpack $ listToMaybe ns -- only first onion name.
1601 flip (maybe $ return ()) contactname $ \contactname -> do 1604 flip (maybe $ return ()) contactname $ \contactname -> do
1605
1602 let cpath = interp (Map.singleton "onion" contactname) contactipsec0 1606 let cpath = interp (Map.singleton "onion" contactname) contactipsec0
1603 kspec = ( KeyGrip $ fingerprint $ keyPacket kd 1607 their_master = packet $ keyMappedPacket kd
1604 , Just "strongswan" ) 1608 -- We find all cross-certified ipsec keys for the given cross-certified onion name.
1605 mbk = selectPublicKey kspec $ Map.singleton (keykey $ keyPacket kd) kd 1609 ipsecs = sortOn (Down . timestamp)
1606 flip (maybe $ return ()) mbk $ \k -> do 1610 $ getCrossSignedSubkeys their_master (keySubKeys kd) "strongswan"
1611 forM_ (take 1 ipsecs) $ \k -> do
1607 goti <- doesFileExist (cpath) 1612 goti <- doesFileExist (cpath)
1608 when (not goti) $ do 1613 when (not goti) $ do
1609 either warn (writeFileWARNING $ cpath) 1614 either warn (writeFile cpath) $ pemFromPacket k
1610 $ pemFromPacket k
1611 1615
1612 mapM_ installConctact cs 1616 mapM_ installConctact cs
1613 1617
@@ -1850,6 +1854,8 @@ commands =
1850 , ( "tar", "import or export system key files in tar format" ) 1854 , ( "tar", "import or export system key files in tar format" )
1851 ] 1855 ]
1852 1856
1857-- |
1858-- interpolate %var patterns in a string.
1853interp vars raw = es >>= interp1 1859interp vars raw = es >>= interp1
1854 where 1860 where
1855 gs = groupBy (\_ c -> c/='%') raw 1861 gs = groupBy (\_ c -> c/='%') raw