summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Kiki.hs172
1 files changed, 157 insertions, 15 deletions
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index ec34542..1682811 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -1,26 +1,29 @@
1{-# LANGUAGE CPP #-} 1{-# LANGUAGE CPP #-}
2module Kiki where 2module Kiki where
3 3
4import Control.Monad
5import Control.Applicative 4import Control.Applicative
5import Control.Arrow
6import Control.Monad
7import Data.ASN1.BinaryEncoding
8import Data.ASN1.Encoding
9import Data.ASN1.Types
10import Data.Binary
6import Data.List 11import Data.List
7import Data.Maybe 12import Data.Maybe
13import Data.OpenPGP
14import Data.OpenPGP.Util
8import Data.Ord 15import Data.Ord
9import System.Directory 16import System.Directory
10import System.FilePath.Posix 17import System.FilePath.Posix
11import System.IO 18import System.IO
12import Data.OpenPGP 19import System.Posix.User
13import Data.OpenPGP.Util
14import qualified Data.Map.Strict as Map
15import qualified Codec.Binary.Base64 as Base64 20import qualified Codec.Binary.Base64 as Base64
16import Data.ASN1.BinaryEncoding
17import Data.ASN1.Encoding
18import Data.ASN1.Types
19import qualified Data.ByteString.Lazy as L 21import qualified Data.ByteString.Lazy as L
20import qualified Data.ByteString.Lazy.Char8 as Char8 22import qualified Data.ByteString.Lazy.Char8 as Char8
23import qualified Data.Map.Strict as Map
24import qualified SSHKey as SSH
21 25
22import CommandLine 26import CommandLine
23import qualified SSHKey as SSH
24import KeyRing 27import KeyRing
25 28
26-- | 29-- |
@@ -70,6 +73,139 @@ minimalOp cap = op
70 , opHome = cap_homespec cap 73 , opHome = cap_homespec cap
71 } 74 }
72 75
76run :: [String] -> Args (IO ()) -> IO ()
77run args x =
78 case runArgs (parseInvocation (uncurry fancy kikiOptions "") args) x of
79 Left e -> hPutStrLn stderr $ usageErrorMessage e
80 Right io -> io
81
82importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> IO ()
83importAndRefresh root cmn = do
84 let rootdir = do guard (root "x" /= "x")
85 Just $ root ""
86
87 me <- getEffectiveUserID
88
89 let noChrootArg = rootdir == Nothing
90 bUnprivileged = (me/=0) && noChrootArg
91 if rootdir==Just "" then error "--chroot requires an argument" else do
92
93 let homespec = mplus (slash <$> rootdir <*> cap_homespec cmn)
94 (fmap (++"/root/.gnupg") rootdir)
95 sshkeygen size = Just $ concat [ "mkdir -p \"$(dirname $file)\" && "
96 , "ssh-keygen -P \"\" -q -f $file -b "
97 , show size ]
98 mkdirFor path = do
99 let dir = takeDirectory path
100 -- putStrLn $ "mkdirFor " ++ show dir
101 createDirectoryIfMissing True dir
102 -- ssl = Just "mkdir -p \"$(dirname $file)\" && openssl genrsa -out $file 1024"
103 (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec
104 osHomeDir <- if bUnprivileged then getHomeDirectory else return "/root"
105 putStrLn $ "gnupg home = " ++ show (home,secring,pubring,mbwk)
106 putStrLn $ "os home = " ++ show osHomeDir
107 -- gnupg home = ("TESTS/tmpgh","TESTS/tmpgh/secring.gpg","TESTS/tmpgh/pubring.gpg",Nothing)
108 -- os home = "/root"
109
110
111 -- Generate secring.gpg if it does not exist...
112 gotsec <- doesFileExist secring
113 when (not gotsec) $ do
114 {- ssh-keygen to create master key...
115 let mkpath = home ++ "/master-key"
116 mkdirFor mkpath
117 e <- systemEnv [ ("file",mkpath) ] (fromJust $ sshkeygen 4096)
118 case e of
119 ExitFailure num -> error "ssh-keygen failed to create master key"
120 ExitSuccess -> return ()
121 [PEMPacket mk] <- readSecretPEMFile (ArgFile mkpath)
122 writeInputFileL (InputFileContext secring pubring)
123 HomeSec
124 ( encode $ Message [mk { is_subkey = False }] )
125 -}
126 master <- (\k -> k { is_subkey = False }) <$> generateKey (GenRSA $ 4096 `div` 8 )
127 mkdirFor secring
128 writeInputFileL (InputFileContext secring pubring)
129 HomeSec
130 $ encode $ Message [master { is_subkey = False}]
131
132 gotpub <- doesFileExist pubring
133 when (not gotpub) $ do
134 mkdirFor pubring
135 writeInputFileL (InputFileContext secring pubring)
136 HomePub
137 ( encode $ Message [] )
138
139 -- Old paths..
140 --
141 -- Private
142 -- pem tor /var/lib/tor/samizdat/private_key
143 -- pem ssh-client %(home)/.ssh/id_rsa
144 -- pem ssh-server /etc/ssh/ssh_host_rsa_key
145 -- pem ipsec /etc/ipsec.d/private/%(onion).pem
146
147 -- Public
148 -- ssh-client %(home)/.ssh/id_rsa.pub
149 -- ssh-server /etc/ssh/ssh_host_rsa_key.pub
150 -- ipsec /etc/ipsec.d/certs/%(onion).pem
151
152 -- First, we ensure that the tor key exists and is imported
153 -- so that we know where to put the strongswan key.
154 let passfd = cap_passfd cmn
155 strm = StreamInfo { typ = KeyRingFile
156 , fill = KF_None
157 , spill = KF_All
158 , access = AutoAccess
159 , initializer = NoCreate
160 , transforms = [] }
161 buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp
162 , fill = rtyp
163 , spill = KF_All
164 , access = AutoAccess
165 , initializer = NoCreate
166 , transforms = [] }
167 peminfo bits usage =
168 StreamInfo { typ = PEMFile
169 , fill = KF_None -- KF_Match usage
170 , spill = KF_Match usage
171 , access = Sec
172 , initializer = Internal (GenRSA $ bits `div` 8)
173 , transforms = []
174 }
175 sshcpath = fromMaybe "" rootdir ++ osHomeDir ++ ".ssh/id_rsa"
176 sshspath = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key"
177 op = KeyRingOperation
178 { opFiles = Map.fromList $
179 [ ( HomeSec, buildStreamInfo KF_All KeyRingFile )
180 , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } )
181 , ( Generate 0 (GenRSA (1024 `div` 8)), strm { spill = KF_Match "tor" })
182 , ( Generate 1 (GenRSA (1024 `div` 8)), strm { spill = KF_Match "ipsec" })
183 , ( ArgFile sshcpath, (peminfo 2048 "ssh-client") )
184 , ( ArgFile sshspath, (peminfo 2048 "ssh-server") )
185 ]
186 , opPassphrases = do pfd <- maybeToList passfd
187 return $ PassphraseSpec Nothing Nothing pfd
188 , opHome = homespec
189 , opTransforms = []
190 }
191 -- doNothing = return ()
192 nop = KeyRingOperation
193 { opFiles = Map.empty
194 , opPassphrases = do pfd <- maybeToList passfd
195 return $ PassphraseSpec Nothing Nothing pfd
196 , opHome=homespec, opTransforms = []
197 }
198 -- if bUnprivileged then doNothing else mkdirFor torpath
199 KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op)
200 forM_ report $ \(fname,act) -> do
201 putStrLn $ fname ++ ": " ++ reportString act
202 rt <- case rt of
203 BadPassphrase ->
204 error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)"
205 _ -> unconditionally $ return rt
206
207 when (not bUnprivileged) $ refreshCache rt rootdir
208
73 209
74refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO () 210refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO ()
75refreshCache rt rootdir = do 211refreshCache rt rootdir = do
@@ -172,10 +308,6 @@ sshblobFromPacket k = blob
172 bs = SSH.keyblob (n,e) 308 bs = SSH.keyblob (n,e)
173 blob = Char8.unpack bs 309 blob = Char8.unpack bs
174 310
175ㄧhomedir = Kiki.CommonArgsParsed
176 <$> optional (arg "--homedir")
177 <*> optional (FileDesc <$> read <$> arg "--passphrase-fd")
178
179replaceSshServerKeys root cmn = do 311replaceSshServerKeys root cmn = do
180 let homepass' = cmn { cap_homespec = fmap root (cap_homespec cmn) } 312 let homepass' = cmn { cap_homespec = fmap root (cap_homespec cmn) }
181 replaceSSH op = op { opFiles = files } 313 replaceSSH op = op { opFiles = files }
@@ -194,12 +326,22 @@ replaceSshServerKeys root cmn = do
194 pth -> Just pth 326 pth -> Just pth
195 err -> hPutStrLn stderr $ errorString err 327 err -> hPutStrLn stderr $ errorString err
196 328
197ㄧchroot :: Args (FilePath -> FilePath)
198ㄧchroot = pure (\r a -> slash r a) <*> arg "--chroot" <|> pure id
199
200slash :: String -> String -> String 329slash :: String -> String -> String
201slash "/" ('/':xs) = '/':xs 330slash "/" ('/':xs) = '/':xs
202slash "" ('/':xs) = '/':xs 331slash "" ('/':xs) = '/':xs
203slash "" xs = '/':xs 332slash "" xs = '/':xs
204slash (y:ys) xs = y:slash ys xs 333slash (y:ys) xs = y:slash ys xs
205 334
335ㄧchroot :: Args (FilePath -> FilePath)
336ㄧchroot = pure (\r a -> slash r a) <*> arg "--chroot" <|> pure id
337
338ㄧhomedir :: Args CommonArgsParsed
339ㄧhomedir = CommonArgsParsed
340 <$> optional (arg "--homedir")
341 <*> optional (FileDesc <$> read <$> arg "--passphrase-fd")
342
343kikiOptions :: ( [(String,Int)], [String] )
344kikiOptions = ( ss, ps )
345 where
346 ss = [("--chroot",1),("--passphrase-fd",1),("--homedir",1)]
347 ps = []