summaryrefslogtreecommitdiff
path: root/lib/Kiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Kiki.hs')
-rw-r--r--lib/Kiki.hs186
1 files changed, 95 insertions, 91 deletions
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index a683a91..27ebbcd 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -1,50 +1,51 @@
1{-# LANGUAGE CPP #-} 1{-# LANGUAGE CPP #-}
2{-# LANGUAGE OverloadedStrings #-} 2{-# LANGUAGE OverloadedStrings #-}
3module Kiki where 3module Kiki where
4 4
5import Control.Applicative 5import Control.Applicative
6import Control.Arrow 6import Control.Arrow
7import Control.Concurrent 7import Control.Concurrent
8import Control.Exception 8import Control.Exception
9import Control.Monad 9import Control.Monad
10import Data.ASN1.BinaryEncoding 10import Data.ASN1.BinaryEncoding
11import Data.ASN1.Encoding 11import Data.ASN1.Encoding
12import Data.ASN1.Types 12import Data.ASN1.Types
13import Data.Binary 13import Data.Binary
14import Data.Char 14import Data.Bool
15import Data.List 15import Data.Char
16import Data.Maybe 16import Data.List
17import Data.Monoid 17import Data.Maybe
18import Data.OpenPGP 18import Data.Monoid
19import Data.OpenPGP.Util 19import Data.OpenPGP
20import Data.Ord 20import Data.OpenPGP.Util
21import System.Directory 21import Data.Ord
22import System.FilePath.Posix as FilePath 22import qualified Data.Traversable as T (mapM)
23import System.IO 23import System.Directory
24import System.IO.Temp 24import System.FilePath.Posix as FilePath
25import System.IO.Error 25import System.IO
26import System.Posix.IO as Posix (createPipe) 26import System.IO.Error
27import System.Posix.User 27import System.IO.Temp
28import System.Process 28import System.Posix.Files
29import System.Posix.Files 29import System.Posix.IO as Posix (createPipe)
30import qualified Data.Traversable as T (mapM) 30import System.Posix.User
31import System.Process
31#if defined(VERSION_memory) 32#if defined(VERSION_memory)
32import qualified Data.ByteString.Char8 as S8 33import Data.ByteArray.Encoding
33import Data.ByteArray.Encoding 34import qualified Data.ByteString.Char8 as S8
34#elif defined(VERSION_dataenc) 35#elif defined(VERSION_dataenc)
35import qualified Codec.Binary.Base64 as Base64 36import qualified Codec.Binary.Base64 as Base64
36#endif 37#endif
37import qualified Data.ByteString.Lazy as L 38import qualified Data.ByteString.Lazy as L
38import qualified Data.ByteString.Lazy.Char8 as Char8 39import qualified Data.ByteString.Lazy.Char8 as Char8
39import qualified Data.Map.Strict as Map 40import qualified Data.Map.Strict as Map
40import qualified SSHKey as SSH 41import Network.Socket
41import Network.Socket -- (SockAddr) 42import ProcessUtils
42import ProcessUtils 43import qualified SSHKey as SSH
43 44
44import GnuPGAgent (Query(..)) 45import CommandLine
45import CommandLine 46import DotLock
46import KeyRing 47import GnuPGAgent (Query (..))
47import DotLock 48import KeyRing
48 49
49withAgent :: [PassphraseSpec] -> [PassphraseSpec] 50withAgent :: [PassphraseSpec] -> [PassphraseSpec]
50withAgent [] = [PassphraseAgent] 51withAgent [] = [PassphraseAgent]
@@ -97,7 +98,7 @@ refresh root homepass = do
97 pth -> Just pth 98 pth -> Just pth
98 case r of 99 case r of
99 KikiSuccess rt -> refreshCache rt mroot 100 KikiSuccess rt -> refreshCache rt mroot
100 _ -> return () -- XXX: silent fail? 101 _ -> return () -- XXX: silent fail?
101 102
102data CommonArgsParsed = CommonArgsParsed { cap_homespec :: Maybe String, cap_passfd :: Maybe InputFile } 103data CommonArgsParsed = CommonArgsParsed { cap_homespec :: Maybe String, cap_passfd :: Maybe InputFile }
103 104
@@ -145,15 +146,12 @@ outputReport report = do
145 146
146importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> SymmetricAlgorithm -> IO () 147importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> SymmetricAlgorithm -> IO ()
147importAndRefresh root cmn cipher = do 148importAndRefresh root cmn cipher = do
148 let rootdir = do guard (root "x" /= "x") 149 let rootdir = do guard (root "x" /= "x")
149 Just $ root "" 150 Just $ root ""
150 151 me <- getEffectiveUserID
151 me <- getEffectiveUserID 152 let noChrootArg = rootdir == Nothing
152 153 bUnprivileged = (me/=0) && noChrootArg
153 let noChrootArg = rootdir == Nothing 154 bool id (error "--chroot requires an argument") (rootdir==Just "") $ do
154 bUnprivileged = (me/=0) && noChrootArg
155 if rootdir==Just "" then error "--chroot requires an argument" else do
156
157 let homespec = mplus (slash <$> rootdir <*> cap_homespec cmn) 155 let homespec = mplus (slash <$> rootdir <*> cap_homespec cmn)
158 (fmap (++"/root/.gnupg") rootdir) 156 (fmap (++"/root/.gnupg") rootdir)
159 sshkeygen size = Just $ concat [ "mkdir -p \"$(dirname $file)\" && " 157 sshkeygen size = Just $ concat [ "mkdir -p \"$(dirname $file)\" && "
@@ -173,10 +171,7 @@ importAndRefresh root cmn cipher = do
173 171
174 let passfd = cap_passfd cmn 172 let passfd = cap_passfd cmn
175 173
176 (torgen,pwds) <- 174 (torgen,pwds) <- bool id (const $ return (Generate 0 $ GenRSA $ 1024 `div` 8, [])) $ do
177 if gotsec
178 then return (Generate 0 $ GenRSA $ 1024 `div` 8, [])
179 else do
180 {- ssh-keygen to create master key... 175 {- ssh-keygen to create master key...
181 let mkpath = home ++ "/master-key" 176 let mkpath = home ++ "/master-key"
182 mkdirFor mkpath 177 mkdirFor mkpath
@@ -255,30 +250,38 @@ importAndRefresh root cmn cipher = do
255 250
256 -- First, we ensure that the tor key exists and is imported 251 -- First, we ensure that the tor key exists and is imported
257 -- so that we know where to put the strongswan key. 252 -- so that we know where to put the strongswan key.
258 let strm = StreamInfo { typ = KeyRingFile 253 let strm =
259 , fill = KF_None 254 StreamInfo
260 , spill = KF_All 255 { typ = KeyRingFile
261 , access = AutoAccess 256 , fill = KF_None
262 , initializer = NoCreate 257 , spill = KF_All
263 , transforms = [] } 258 , access = AutoAccess
264 buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp 259 , initializer = NoCreate
265 , fill = rtyp 260 , transforms = []
266 , spill = KF_All 261 }
267 , access = AutoAccess 262 buildStreamInfo rtyp ftyp =
268 , initializer = NoCreate 263 StreamInfo
269 , transforms = [] } 264 { typ = ftyp
265 , fill = rtyp
266 , spill = KF_All
267 , access = AutoAccess
268 , initializer = NoCreate
269 , transforms = [] }
270 peminfo bits usage = 270 peminfo bits usage =
271 StreamInfo { typ = PEMFile 271 StreamInfo
272 , fill = KF_None -- KF_Match usage 272 { typ = PEMFile
273 , spill = KF_Match usage 273 , fill = KF_None -- KF_Match usage
274 , access = Sec 274 , spill = KF_Match usage
275 , initializer = Internal (GenRSA $ bits `div` 8) 275 , access = Sec
276 , transforms = [] 276 , initializer = Internal (GenRSA $ bits `div` 8)
277 } 277 , transforms = []
278 }
278 sshcpath = fromMaybe "" rootdir ++ osHomeDir ++ ".ssh/id_rsa" 279 sshcpath = fromMaybe "" rootdir ++ osHomeDir ++ ".ssh/id_rsa"
279 sshspath = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key" 280 sshspath = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key"
280 op = KeyRingOperation 281 op =
281 { opFiles = Map.fromList $ 282 KeyRingOperation
283 { opFiles =
284 Map.fromList $
282 [ ( HomeSec, buildStreamInfo KF_All KeyRingFile ) 285 [ ( HomeSec, buildStreamInfo KF_All KeyRingFile )
283 , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } ) 286 , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } )
284 , ( torgen , case torgen of 287 , ( torgen , case torgen of
@@ -295,18 +298,19 @@ importAndRefresh root cmn cipher = do
295 , ( Generate 2 (GenRSA (4096 `div` 8)), strm { spill = KF_Match "encrypt" }) 298 , ( Generate 2 (GenRSA (4096 `div` 8)), strm { spill = KF_Match "encrypt" })
296 , ( Generate 3 (GenRSA (4096 `div` 8)), strm { spill = KF_Match "sign" }) 299 , ( Generate 3 (GenRSA (4096 `div` 8)), strm { spill = KF_Match "sign" })
297 ] 300 ]
298 , opPassphrases = withAgent $ pwds ++ do pfd <- maybeToList passfd 301 , opPassphrases = withAgent $ pwds ++ do pfd <- maybeToList passfd
299 return $ PassphraseSpec Nothing Nothing pfd 302 return $ PassphraseSpec Nothing Nothing pfd
300 , opHome = homespec 303 , opHome = homespec
301 , opTransforms = [] 304 , opTransforms = []
302 } 305 }
303 -- doNothing = return () 306 -- doNothing = return ()
304 nop = KeyRingOperation 307 nop =
305 { opFiles = Map.empty 308 KeyRingOperation
306 , opPassphrases = withAgent $ do pfd <- maybeToList passfd 309 { opFiles = Map.empty
307 return $ PassphraseSpec Nothing Nothing pfd 310 , opPassphrases = withAgent $ do pfd <- maybeToList passfd
308 , opHome=homespec, opTransforms = [] 311 return $ PassphraseSpec Nothing Nothing pfd
309 } 312 , opHome=homespec, opTransforms = []
313 }
310 -- if bUnprivileged then doNothing else mkdirFor torpath 314 -- if bUnprivileged then doNothing else mkdirFor torpath
311 KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op) 315 KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op)
312 outputReport report 316 outputReport report
@@ -656,16 +660,16 @@ slash "" ('/':xs) = '/':xs
656slash "" xs = '/':xs 660slash "" xs = '/':xs
657slash (y:ys) xs = y:slash ys xs 661slash (y:ys) xs = y:slash ys xs
658 662
659opt_chroot :: Args (FilePath -> FilePath) 663dashdashChroot :: Args (FilePath -> FilePath)
660opt_chroot = pure (\r a -> slash r a) <*> arg "--chroot" <|> pure id 664dashdashChroot = pure (\r a -> slash r a) <*> arg "--chroot" <|> pure id
661 665
662opt_homedir :: Args CommonArgsParsed 666dashdashHomedir :: Args CommonArgsParsed
663opt_homedir = CommonArgsParsed 667dashdashHomedir = CommonArgsParsed
664 <$> optional (arg "--homedir") 668 <$> optional (arg "--homedir")
665 <*> optional (FileDesc <$> read <$> arg "--passphrase-fd") 669 <*> optional (FileDesc <$> read <$> arg "--passphrase-fd")
666 670
667opt_cipher :: Args SymmetricAlgorithm 671dashdashCipher :: Args SymmetricAlgorithm
668opt_cipher = fromMaybe CAST5 <$> optional (cipherFromString <$> arg "--cipher") 672dashdashCipher = fromMaybe CAST5 <$> optional (cipherFromString <$> arg "--cipher")
669 673
670kikiOptions :: ( [(String,Int)], [String] ) 674kikiOptions :: ( [(String,Int)], [String] )
671kikiOptions = ( ss, ps ) 675kikiOptions = ( ss, ps )