From 2d001913d97ccc05af3b062b42b0df8b155d2a73 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Sat, 6 Jul 2019 15:19:04 -0400 Subject: Minor cleanup, comments. --- lib/Kiki.hs | 174 ++++++++++++++++++++++++++++++------------------------------ 1 file changed, 88 insertions(+), 86 deletions(-) (limited to 'lib/Kiki.hs') diff --git a/lib/Kiki.hs b/lib/Kiki.hs index e67c805..eabd8ed 100644 --- a/lib/Kiki.hs +++ b/lib/Kiki.hs @@ -14,6 +14,7 @@ import Data.ASN1.Types import Data.Binary import Data.Bool import Data.Char +import Data.Functor import Data.List import Data.Maybe import Data.OpenPGP @@ -155,6 +156,35 @@ mkdirFor path = do let dir = takeDirectory path createDirectoryIfMissing True dir + +-- | Useful default KeyRingFile StreamInfo. +strm :: StreamInfo +strm = StreamInfo + { typ = KeyRingFile + , fill = KF_None + , spill = KF_All + , access = AutoAccess + , initializer = NoCreate + , transforms = [] + } + +-- | Convenience constructor for StreamInfo +buildStreamInfo :: KeyFilter -> FileType -> StreamInfo +buildStreamInfo rtyp ftyp = strm { typ = ftyp , fill = rtyp } + +-- | Convenience constuctor for Streaminfo generating a tagged subkey. +peminfo :: Int -- ^ bits + -> String -- ^ subkey tag. + -> StreamInfo +peminfo bits usage = StreamInfo + { typ = PEMFile + , fill = KF_None -- KF_Match usage + , spill = KF_Match usage + , access = Sec + , initializer = Internal (GenRSA $ bits `div` 8) + , transforms = [] + } + importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> SymmetricAlgorithm -> IO () importAndRefresh root cmn cipher = do let rootdir = do guard (root "x" /= "x") @@ -165,54 +195,57 @@ importAndRefresh root cmn cipher = do bool id (error "--chroot requires an argument") (rootdir==Just "") $ do let homespec = mplus (slash <$> rootdir <*> cap_homespec cmn) (fmap (++"/root/.gnupg") rootdir) + passfd = cap_passfd cmn (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec osHomeDir <- if bUnprivileged then getHomeDirectory else return "/root" - old_umask <- setFileCreationMask(0o077); - -- Generate secring.gpg if it does not exist... + old_umask <- setFileCreationMask 0o077 -- Keyring files need to be created with proper mask. gotsec <- doesFileExist secring - - let passfd = cap_passfd cmn - (torgen,pwds) <- bool id (const $ return (Generate 0 $ GenRSA $ 1024 `div` 8, [])) gotsec $ do - {- ssh-keygen to create master key... - let mkpath = home ++ "/master-key" - mkdirFor mkpath - e <- systemEnv [ ("file",mkpath) ] (fromJust $ sshkeygen 4096) - case e of - ExitFailure num -> error "ssh-keygen failed to create master key" - ExitSuccess -> return () - [PEMPacket mk] <- readSecretPEMFile (ArgFile mkpath) - writeInputFileL (InputFileContext secring pubring) - HomeSec - ( encode $ Message [mk { is_subkey = False }] ) - -} - master_un <- (\k -> MappedPacket (k { is_subkey = False }) Map.empty) <$> generateKey (GenRSA $ 4096 `div` 8 ) + -- We have no secring.gpg (and thus no master key). + -- Since 'runKeyRing' cannot currently cope with this situation, we will + -- generate a master-key and very minimal secring.gpg file. + master_un <- generateKey (GenRSA $ 4096 `div` 8 ) + <&> \k -> MappedPacket (k { is_subkey = False }) -- Set as master-key. + Map.empty -- Packet occurs in no files. + -- The user may desire the master key is encrypted on disk but this + -- requires a password prompt. In order to have a decent prompt, it'd + -- be nice if we could display the .onion hostname for the key. + -- Therefore, we generate the tor key early. tor_un <- generateKey (GenRSA $ 1024 `div` 8 ) + -- However, we'll postpone writing the tor key to the keyring and + -- instead have the later all-in-one call to runKeyRing take care of + -- it. That interface does not currently provide a way to accept + -- in-memory input, so we'll create a fifo stream for it to read the + -- key in PEM format. (read_tor,write_tor) <- Posix.createPipe - do rs <- writeKeyToFile (streaminfo { typ = PEMFile, access = Sec, spill = KF_Match "tor", fill = KF_All }) (FileDesc write_tor) tor_un - -- outputReport $ map (first show) rs - return () - cipher's2k <- do - IteratedSaltedS2K _ salt _ <- randomS2K SHA1 - -- (cipher {- AES128 -}, IteratedSaltedS2K SHA1 4073382889203176146 7864320) - return $ (cipher {- AES128 -}, IteratedSaltedS2K SHA1 salt (15 * 2^19)) + rs <- writeKeyToFile (streaminfo { typ = PEMFile + , access = Sec + , spill = KF_Match "tor" + , fill = KF_All }) + (FileDesc write_tor) + tor_un + -- -- Currently disabled: show warnings and errors from the PEM generation. + -- outputReport $ map (first show) rs + let ctx = InputFileContext secring pubring - main_passwds = withAgent $ do pfd <- maybeToList passfd - return $ PassphraseSpec Nothing Nothing pfd - passwordop = KeyRingOperation - { opFiles = Map.empty - , opPassphrases = main_passwds - , opHome = homespec - , opTransforms = [] - } - let uidentry = Map.singleton (keykey $ packet master_un) - $ master_un { packet = Query (packet master_un) - (torUIDFromKey tor_un) - Nothing - } - transcoder <- makeMemoizingDecrypter passwordop ctx (Just master_un, uidentry) - master0 <- transcoder cipher's2k master_un + -- Here we encrypt the master-key if neccessary. If no --passphrase-fd option + -- was used, the user will receive prompts from gpg-agent. + (master0,transcoder) <- do + let main_passwds = withAgent $ do pfd <- maybeToList passfd + return $ PassphraseSpec Nothing Nothing pfd + uidentry = Map.singleton (keykey $ packet master_un) + $ master_un { packet = Query (packet master_un) + (torUIDFromKey tor_un) + Nothing } + cipher's2k <- do + IteratedSaltedS2K _ salt _ <- randomS2K SHA1 + return $ (cipher {- AES128 -}, IteratedSaltedS2K SHA1 salt (15 * 2^19)) + transcoder <- makeMemoizingDecrypter main_passwds ctx (Just master_un, uidentry) + master <- transcoder cipher's2k master_un + return (master,transcoder) + + -- Finally, we write-out the secring.gpg file. case master0 of KikiSuccess master -> do mkdirFor secring @@ -229,7 +262,17 @@ importAndRefresh root cmn cipher = do HomeSec $ encode $ Message [packet master_un] putStrLn "Wrote master key" + -- FIXME: Why are we re-generating the tor key here? Does this + -- code get triggered when the user cancels the agent prompt? + -- If so, he's likely canceling encryption, not the .onion name + -- he was already shown. return (Generate 0 (GenRSA $ 1024 `div` 8 ), []) + + -- If the public ring does not exist, then creating an empty file is + -- sufficient to satisfy 'runKeyRing'. However, as we've already generated + -- a key above, GnuPG will not like the unsynced state we are leaving these + -- files. It's important at this point that, 'runKeyRing' actually occurs + -- to fix things up. gotpub <- doesFileExist pubring when (not gotpub) $ do mkdirFor pubring @@ -237,49 +280,9 @@ importAndRefresh root cmn cipher = do HomePub ( encode $ Message [] ) - setFileCreationMask(old_umask); - -- Old paths.. - -- - -- Private - -- pem tor /var/lib/tor/samizdat/private_key - -- pem ssh-client %(home)/.ssh/id_rsa - -- pem ssh-server /etc/ssh/ssh_host_rsa_key - -- pem ipsec /etc/ipsec.d/private/%(onion).pem - - -- Public - -- ssh-client %(home)/.ssh/id_rsa.pub - -- ssh-server /etc/ssh/ssh_host_rsa_key.pub - -- ipsec /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 strm = - StreamInfo - { typ = KeyRingFile - , fill = KF_None - , spill = KF_All - , access = AutoAccess - , initializer = NoCreate - , transforms = [] - } - buildStreamInfo rtyp ftyp = - StreamInfo - { typ = ftyp - , fill = rtyp - , spill = KF_All - , access = AutoAccess - , initializer = NoCreate - , transforms = [] } - peminfo bits usage = - StreamInfo - { typ = PEMFile - , fill = KF_None -- KF_Match usage - , spill = KF_Match usage - , access = Sec - , initializer = Internal (GenRSA $ bits `div` 8) - , transforms = [] - } - sshcpath = fromMaybe "" rootdir ++ osHomeDir ++ ".ssh/id_rsa" + setFileCreationMask old_umask -- We're done creating keyring files, so restore umask. + + let sshcpath = fromMaybe "" rootdir ++ osHomeDir ++ ".ssh/id_rsa" sshspath = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key" op = KeyRingOperation @@ -306,7 +309,6 @@ importAndRefresh root cmn cipher = do , opHome = homespec , opTransforms = [] } - -- doNothing = return () nop = KeyRingOperation { opFiles = Map.empty @@ -314,14 +316,14 @@ importAndRefresh root cmn cipher = do return $ PassphraseSpec Nothing Nothing pfd , opHome=homespec, opTransforms = [] } - -- if bUnprivileged then doNothing else mkdirFor torpath + -- Run the all-in-one operation that generates or imports all subkeys. KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op) outputReport report rt <- case rt of BadPassphrase -> error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)" _ -> unconditionally $ return rt - + -- Finally, we update /var/cache/kiki. when (not bUnprivileged) $ refreshCache rt rootdir -- Installs the cert file for the peer to the filesystem, and returns an -- cgit v1.2.3