From 20131e89870ad889a76d44cb8ffcba3fbe00ecc1 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 25 Apr 2016 03:11:42 -0400 Subject: Changed "init" command to cokiki (/var/cache/kiki) design. --- kiki.hs | 184 ++++++++++++++++++++++++++++------------------------------------ 1 file changed, 79 insertions(+), 105 deletions(-) (limited to 'kiki.hs') diff --git a/kiki.hs b/kiki.hs index e4d8e23..2ea702f 100644 --- a/kiki.hs +++ b/kiki.hs @@ -53,7 +53,7 @@ import Control.Arrow (first,second) import Data.Monoid ( (<>) ) import Data.Binary.Put -import Data.OpenPGP.Util (verify,fingerprint) +import Data.OpenPGP.Util (verify,fingerprint,generateKey, GenerateKeyParams(..)) import ScanningParser import PEM import DotLock @@ -1048,7 +1048,7 @@ buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp , fill = rtyp , spill = KF_All , access = AutoAccess - , initializer = Nothing + , initializer =NoCreate , transforms = [] } @@ -1105,7 +1105,7 @@ sync bExport bImport bSecret cmdarg args_raw = do then DNSPresentation else PEMFile , access = if bSecret then Sec else Pub - , initializer = cmd' + , initializer = maybe NoCreate External cmd' , transforms = [] } ) else if isNothing cmd' @@ -1233,7 +1233,7 @@ kiki "show" args = do streaminfo = StreamInfo { fill = KF_None , typ = KeyRingFile , spill = KF_All - , initializer = Nothing + , initializer = NoCreate , access = AutoAccess , transforms = [] } @@ -1317,7 +1317,7 @@ kiki "merge" args = do , typ = KeyRingFile , spill = KF_None , fill = KF_None - , initializer = Nothing + , initializer = NoCreate , transforms = [] } updateFlow fil spil mtch flow = spill' $ fill' $ flow @@ -1402,7 +1402,7 @@ kiki "merge" args = do Left ("autosign",Just "false")-> doAutosign False flow op Left ("passphrase-fd",Just pass) -> doPassphrase flow op pass Left ("create",Just cmd) -> - ( flow { initializer = if null cmd then Nothing else Just cmd } + ( flow { initializer = if null cmd then NoCreate else External cmd } , op ) Left ("type",Just "keyring") -> ( flow { typ = KeyRingFile } , op ) Left ("type",Just "pem" ) -> ( flow { typ = PEMFile } , op ) @@ -1480,8 +1480,11 @@ kiki "init" args = do (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec osHomeDir <- if bUnprivileged then getHomeDirectory else return "/root" -- putStrLn $ "home = " ++ show (home,secring,pubring,mbwk) + + -- Generate secring.gpg if it does not exist... gotsec <- doesFileExist secring when (not gotsec) $ do + {- ssh-keygen to create master key... let mkpath = home ++ "/master-key" mkdirFor mkpath e <- systemEnv [ ("file",mkpath) ] (fromJust $ sshkeygen 4096) @@ -1492,12 +1495,20 @@ kiki "init" args = do writeInputFileL (InputFileContext secring pubring) HomeSec ( encode $ Message [mk { is_subkey = False }] ) + -} + master <- generateKey (GenRSA $ 4096 `div` 8 ) + writeInputFileL (InputFileContext secring pubring) + HomeSec + $ encode $ Message [master { is_subkey = False}] + gotpub <- doesFileExist pubring when (not gotpub) $ do writeInputFileL (InputFileContext secring pubring) HomePub ( encode $ Message [] ) + -- Old paths.. + -- -- Private -- pem tor /var/lib/tor/samizdat/private_key -- pem ssh-client %(home)/.ssh/id_rsa @@ -1509,18 +1520,6 @@ kiki "init" args = do -- ssh-server /etc/ssh/ssh_host_rsa_key.pub -- ipsec /etc/ipsec.d/certs/%(onion).pem - -- TODO: These should be read from a configuration file. - -- (use SimpleConfig) - let torpath = fromMaybe "" rootdir ++ "/var/lib/tor/samizdat/private_key" - sshcpath0 = fromMaybe "" rootdir ++ osHomeDir ".ssh" "id_rsa" - sshspath0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key" - ipsecpath0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/private/%(onion).pem" - sshcpathpub0 = fromMaybe "" rootdir ++ osHomeDir ".ssh" "id_rsa.pub" - sshspathpub0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key.pub" - ipsecpathpub0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem" - contactipsec0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem" - - -- First, we ensure that the tor key exists and is imported -- so that we know where to put the strongswan key. let passfd = fmap (FileDesc . read) $ lookup "passphrase-fd" args @@ -1528,34 +1527,40 @@ kiki "init" args = do , fill = rtyp , spill = KF_All , access = AutoAccess - , initializer = Nothing + , initializer = NoCreate , transforms = [] } peminfo bits usage = StreamInfo { typ = PEMFile , fill = KF_Match usage , spill = KF_Match usage , access = Sec - , initializer = sshkeygen bits + , initializer = Internal (GenRSA $ bits `div` 8) , transforms = [] } + sshcpath = fromMaybe "" rootdir ++ osHomeDir ++ ".ssh/id_rsa" + sshspath = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key" op = KeyRingOperation { opFiles = Map.fromList $ [ ( HomeSec, buildStreamInfo KF_All KeyRingFile ) , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } ) - , ( ArgFile torpath, peminfo 1024 "tor" ) ] + , ( Generate (GenRSA (1024 `div` 8)), peminfo 1024 "tor" ) + , ( Generate (GenRSA (1024 `div` 8)), peminfo 1024 "ipsec" ) + , ( ArgFile sshcpath, (peminfo 2048 "ssh-client") { fill = KF_None } ) + , ( ArgFile sshspath, (peminfo 2048 "ssh-server") { fill = KF_None } ) + ] , opPassphrases = do pfd <- maybeToList passfd return $ PassphraseSpec Nothing Nothing pfd , opHome = homespec , opTransforms = [] } - doNothing = return () + -- doNothing = return () nop = KeyRingOperation { opFiles = Map.empty , opPassphrases = do pfd <- maybeToList passfd return $ PassphraseSpec Nothing Nothing pfd , opHome=homespec, opTransforms = [] } - if bUnprivileged then doNothing else mkdirFor torpath + -- if bUnprivileged then doNothing else mkdirFor torpath KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op) forM_ report $ \(fname,act) -> do putStrLn $ fname ++ ": " ++ reportString act @@ -1564,87 +1569,7 @@ kiki "init" args = do error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" _ -> unconditionally $ return rt - -- Now import, export, or generate the remaining secret keys. - let oname' = do wk <- rtWorkingKey rt - onionNameForContact (keykey wk) (rtKeyDB rt) - if (oname' == Nothing) && (not bUnprivileged) then error "Missing tor key" else do - let oname = fromMaybe "" oname' - let [ sshcpath, sshcpathpub ] = {- map (interp (Map.fromList [("onion",oname)]))-} [ sshcpath0, sshcpathpub0 ] - [ sshspath , ipsecpath ] = map (interp (Map.fromList [("onion",oname)])) [ sshspath0, ipsecpath0 ] - [ sshspathpub, ipsecpathpub ] - = map (interp (Map.fromList [("onion",oname)])) - [ sshspathpub0, ipsecpathpub0 ] - let opPriv = op - { opFiles = Map.fromList $ - [ ( HomeSec, buildStreamInfo KF_All KeyRingFile ) - , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } ) - , ( ArgFile ipsecpath, peminfo 1024 "ipsec" ) - , ( ArgFile sshcpath, peminfo 2048 "ssh-client" ) - , ( ArgFile sshspath, peminfo 2048 "ssh-server" ) ] - , opPassphrases = [ PassphraseMemoizer (rtPassphrases rt) ] - } - opUnPriv = op - { opFiles = Map.fromList $ - [ ( HomeSec, buildStreamInfo KF_All KeyRingFile ) - , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } ) - , ( ArgFile sshcpath, peminfo 2048 "ssh-client" ) - ] - , opPassphrases = [ PassphraseMemoizer (rtPassphrases rt) ] - } - mapM_ mkdirFor $ [sshcpath,sshcpathpub] ++ if not bUnprivileged then [sshspath,ipsecpath,sshspathpub,ipsecpathpub] else [] - KikiResult rt report <- runKeyRing (if bUnprivileged then opUnPriv else opPriv) - forM_ report $ \(fname,act) -> do - putStrLn $ fname ++ ": " ++ reportString act - rt <- case rt of - BadPassphrase -> - error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" - _ -> unconditionally $ return rt - - -- Finally, export public keys if they do not exist. - let writeFileWARNING fname bs = do - --TODO - hPutStrLn stderr $ fname ++ ": DID NOT CHECK TRUST (TODO)" - writeFile fname bs - flip (maybe $ warn "missing working key?") (rtGrip rt) $ \grip -> do - gotc <- doesFileExist (sshcpathpub) - when (not gotc) $ do - either warn (writeFile sshcpathpub) - $ show_ssh' "ssh-client" grip (rtKeyDB rt) - if (not bUnprivileged) - then do - goth <- doesFileExist (sshspathpub) - when (not goth) $ do - either warn (writeFile $ sshspathpub) - $ show_ssh' "ssh-host" grip (rtKeyDB rt) - goti <- doesFileExist (ipsecpathpub) - when (not goti) $ do - either warn (writeFile $ ipsecpathpub) - $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket - else return () - - - let cs = filter notme (Map.elems $ rtKeyDB rt) - kk = keykey (fromJust $ rtWorkingKey rt) - notme kd = keykey (keyPacket kd) /= kk - - installConctact kd = do - -- The getHostnames command requires a valid cross-signed tor key - -- for each onion name returned in (_,(ns,_)). - let (_,(ns,_)) = getHostnames kd - contactname = fmap Char8.unpack $ listToMaybe ns -- only first onion name. - flip (maybe $ return ()) contactname $ \contactname -> do - - let cpath = interp (Map.singleton "onion" contactname) contactipsec0 - their_master = packet $ keyMappedPacket kd - -- We find all cross-certified ipsec keys for the given cross-certified onion name. - ipsecs = sortOn (Down . timestamp) - $ getCrossSignedSubkeys their_master (keySubKeys kd) "ipsec" - forM_ (take 1 ipsecs) $ \k -> do - goti <- doesFileExist (cpath) - when (not goti) $ do - either warn (writeFile cpath) $ pemFromPacket k - - mapM_ installConctact cs + when (not bUnprivileged) $ refreshCache rt rootdir kiki "delete" args | "--help" `elem` args = do putStr . unlines $ @@ -1721,6 +1646,55 @@ kiki "tar" args = do ["-A":_] -> putStrLn "unimplemented." -- import tar file? _ -> kiki "tar" ["--help"] +refreshCache rt rootdir = do + + let mkpath pth = fromMaybe "" rootdir ++ "/var/cache/kiki/"++pth + + write f bs = do + createDirectoryIfMissing True $ takeDirectory f + writeFile f bs + + let oname' = do wk <- rtWorkingKey rt + -- XXX unnecessary signature check + onionNameForContact (keykey wk) (rtKeyDB rt) + bUnprivileged = False -- TODO + if (oname' == Nothing) && (not bUnprivileged) then error "Missing tor key" else do + let oname = fromMaybe "" oname' + -- sshcpathpub0 = fromMaybe "" rootdir ++ osHomeDir ".ssh" "id_rsa.pub" + -- sshspathpub0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key.pub" + -- contactipsec0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem" + + -- Finally, export public keys if they do not exist. + flip (maybe $ warn "missing working key?") (rtGrip rt) $ \grip -> do + either warn (write $ mkpath "root/.ssh/id_rsa.pub") + $ show_ssh' "ssh-client" grip (rtKeyDB rt) + either warn (write $ mkpath "ssh_host_rsa_key.pub") + $ show_ssh' "ssh-server" grip (rtKeyDB rt) + either warn (write $ mkpath "ipsec.d/certs/" ++ oname++".pem") + $ show_pem' "ipsec" grip (rtKeyDB rt) pemFromPacket + + let cs = filter notme (Map.elems $ rtKeyDB rt) + kk = keykey (fromJust $ rtWorkingKey rt) + notme kd = keykey (keyPacket kd) /= kk + + installConctact kd = do + -- The getHostnames command requires a valid cross-signed tor key + -- for each onion name returned in (_,(ns,_)). + let (_,(ns,_)) = getHostnames kd + contactname = fmap Char8.unpack $ listToMaybe ns -- only first onion name. + flip (maybe $ return ()) contactname $ \contactname -> do + + let cpath = interp (Map.singleton "onion" contactname) "ipsec.d/certs/%(onion).pem" + their_master = packet $ keyMappedPacket kd + -- We find all cross-certified ipsec keys for the given cross-certified onion name. + ipsecs = sortOn (Down . timestamp) + $ getCrossSignedSubkeys their_master (keySubKeys kd) "ipsec" + forM_ (take 1 ipsecs) $ \k -> do + either warn (write $ mkpath cpath) $ pemFromPacket k + + mapM_ installConctact cs + + tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root" where ipsecs = do @@ -1831,7 +1805,7 @@ minimalOp cap = op streaminfo = StreamInfo { fill = KF_None , typ = KeyRingFile , spill = KF_All - , initializer = Nothing + , initializer = NoCreate , access = AutoAccess , transforms = [] } -- cgit v1.2.3