summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--kiki.hs85
1 files changed, 56 insertions, 29 deletions
diff --git a/kiki.hs b/kiki.hs
index d05424f..c80f2cc 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -22,7 +22,7 @@ import Data.Maybe
22import Data.OpenPGP 22import Data.OpenPGP
23import Data.Ord 23import Data.Ord
24import Data.Text.Encoding 24import Data.Text.Encoding
25-- import System.Posix.User 25import System.Posix.User
26import System.FilePath.Posix 26import System.FilePath.Posix
27import System.Directory 27import System.Directory
28import System.Environment 28import System.Environment
@@ -1137,8 +1137,8 @@ kiki "init-key" args | "--help" `elem` args = do
1137 , " | --chroot=ROOTDIR ] ..."] 1137 , " | --chroot=ROOTDIR ] ..."]
1138 return () 1138 return ()
1139kiki "init-key" args = do 1139kiki "init-key" args = do
1140 {-
1141 me <- getEffectiveUserID 1140 me <- getEffectiveUserID
1141 {-
1142 if me/=0 then error "This command requires root." else do 1142 if me/=0 then error "This command requires root." else do
1143 -} 1143 -}
1144 let as = lefts $ map splitArg args 1144 let as = lefts $ map splitArg args
@@ -1146,6 +1146,8 @@ kiki "init-key" args = do
1146 bads = map fst as \\ ["passphrase-fd","home","chroot"] 1146 bads = map fst as \\ ["passphrase-fd","home","chroot"]
1147 if not (null bads) then error ("Bad option: " ++ unwords bads) else do 1147 if not (null bads) then error ("Bad option: " ++ unwords bads) else do
1148 let rootdir = fmap (fromMaybe "") $ lookup "chroot" as 1148 let rootdir = fmap (fromMaybe "") $ lookup "chroot" as
1149 let noChrootArg = rootdir == Nothing
1150 bUnprivileged = (me/=0) && noChrootArg
1149 if rootdir==Just "" then error "--chroot requires an argument" else do 1151 if rootdir==Just "" then error "--chroot requires an argument" else do
1150 -- maybe id fchroot rootdir $ do 1152 -- maybe id fchroot rootdir $ do
1151 args <- return $ map (second $ fromMaybe "") as 1153 args <- return $ map (second $ fromMaybe "") as
@@ -1161,6 +1163,7 @@ kiki "init-key" args = do
1161 createDirectoryIfMissing True dir 1163 createDirectoryIfMissing True dir
1162 -- ssl = Just "mkdir -p \"$(dirname $file)\" && openssl genrsa -out $file 1024" 1164 -- ssl = Just "mkdir -p \"$(dirname $file)\" && openssl genrsa -out $file 1024"
1163 (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec 1165 (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec
1166 osHomeDir <- if bUnprivileged then getHomeDirectory else return "/root"
1164 -- putStrLn $ "home = " ++ show (home,secring,pubring,mbwk) 1167 -- putStrLn $ "home = " ++ show (home,secring,pubring,mbwk)
1165 gotsec <- doesFileExist secring 1168 gotsec <- doesFileExist secring
1166 when (not gotsec) $ do 1169 when (not gotsec) $ do
@@ -1183,10 +1186,10 @@ kiki "init-key" args = do
1183 -- TODO: These should be read from a configuration file. 1186 -- TODO: These should be read from a configuration file.
1184 -- (use SimpleConfig) 1187 -- (use SimpleConfig)
1185 let torpath = fromMaybe "" rootdir ++ "/var/lib/tor/samizdat/private_key" 1188 let torpath = fromMaybe "" rootdir ++ "/var/lib/tor/samizdat/private_key"
1186 sshcpath0 = fromMaybe "" rootdir ++ "/root/.ssh/id_rsa" 1189 sshcpath0 = fromMaybe "" rootdir ++ osHomeDir </> ".ssh" </>"id_rsa"
1187 sshspath0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key" 1190 sshspath0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key"
1188 ipsecpath0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/private/%(onion).pem" 1191 ipsecpath0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/private/%(onion).pem"
1189 sshcpathpub0 = fromMaybe "" rootdir ++ "/root/.ssh/id_rsa.pub" 1192 sshcpathpub0 = fromMaybe "" rootdir ++ osHomeDir </> ".ssh" </> "id_rsa.pub"
1190 sshspathpub0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key.pub" 1193 sshspathpub0 = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key.pub"
1191 ipsecpathpub0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem" 1194 ipsecpathpub0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem"
1192 contactipsec0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem" 1195 contactipsec0 = fromMaybe "" rootdir ++ "/etc/ipsec.d/certs/%(onion).pem"
@@ -1219,22 +1222,33 @@ kiki "init-key" args = do
1219 , opHome = homespec 1222 , opHome = homespec
1220 , opTransforms = [] 1223 , opTransforms = []
1221 } 1224 }
1222 mkdirFor torpath 1225 doNothing = return ()
1223 KikiResult rt report <- runKeyRing op 1226 nop = KeyRingOperation
1227 { opFiles = Map.empty
1228 , opPassphrases = do pfd <- maybeToList passfd
1229 return $ PassphraseSpec Nothing Nothing pfd
1230 , opHome=homespec, opTransforms = []
1231 }
1232 if bUnprivileged then doNothing else mkdirFor torpath
1233 KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op)
1224 forM_ report $ \(fname,act) -> do 1234 forM_ report $ \(fname,act) -> do
1225 putStrLn $ fname ++ ": " ++ reportString act 1235 putStrLn $ fname ++ ": " ++ reportString act
1226 rt <- unconditionally $ return rt 1236 rt <- case rt of
1237 BadPassphrase ->
1238 error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)"
1239 _ -> unconditionally $ return rt
1227 1240
1228 -- Now import, export, or generate the remaining secret keys. 1241 -- Now import, export, or generate the remaining secret keys.
1229 let oname = do wk <- rtWorkingKey rt 1242 let oname' = do wk <- rtWorkingKey rt
1230 onionNameForContact (keykey wk) (rtKeyDB rt) 1243 onionNameForContact (keykey wk) (rtKeyDB rt)
1231 flip (maybe $ error "Missing tor key") oname $ \oname -> do 1244 if (oname' == Nothing) && (not bUnprivileged) then error "Missing tor key" else do
1232 let [ sshcpath , sshspath , ipsecpath, 1245 let oname = fromMaybe "" oname'
1233 sshcpathpub, sshspathpub, ipsecpathpub ] 1246 let [ sshcpath, sshcpathpub ] = {- map (interp (Map.fromList [("onion",oname)]))-} [ sshcpath0, sshcpathpub0 ]
1234 = map (interp (Map.fromList [("onion",oname)])) 1247 [ sshspath , ipsecpath ] = map (interp (Map.fromList [("onion",oname)])) [ sshspath0, ipsecpath0 ]
1235 [ sshcpath0, sshspath0, ipsecpath0 1248 [ sshspathpub, ipsecpathpub ]
1236 , sshcpathpub0, sshspathpub0, ipsecpathpub0 ] 1249 = map (interp (Map.fromList [("onion",oname)]))
1237 let op2 = op 1250 [ sshspathpub0, ipsecpathpub0 ]
1251 let opPriv = op
1238 { opFiles = Map.fromList $ 1252 { opFiles = Map.fromList $
1239 [ ( HomeSec, buildStreamInfo KF_All KeyRingFile ) 1253 [ ( HomeSec, buildStreamInfo KF_All KeyRingFile )
1240 , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } ) 1254 , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } )
@@ -1243,12 +1257,22 @@ kiki "init-key" args = do
1243 , ( ArgFile sshspath, peminfo 2048 "ssh-server" ) ] 1257 , ( ArgFile sshspath, peminfo 2048 "ssh-server" ) ]
1244 , opPassphrases = [ PassphraseMemoizer (rtPassphrases rt) ] 1258 , opPassphrases = [ PassphraseMemoizer (rtPassphrases rt) ]
1245 } 1259 }
1246 forM_ [sshcpath,sshspath,ipsecpath 1260 opUnPriv = op
1247 ,sshcpathpub,sshspathpub,ipsecpathpub] mkdirFor 1261 { opFiles = Map.fromList $
1248 KikiResult rt report <- runKeyRing op2 1262 [ ( HomeSec, buildStreamInfo KF_All KeyRingFile )
1263 , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } )
1264 , ( ArgFile sshcpath, peminfo 2048 "ssh-client" )
1265 ]
1266 , opPassphrases = [ PassphraseMemoizer (rtPassphrases rt) ]
1267 }
1268 mapM_ mkdirFor $ [sshcpath,sshcpathpub] ++ if not bUnprivileged then [sshspath,ipsecpath,sshspathpub,ipsecpathpub] else []
1269 KikiResult rt report <- runKeyRing (if bUnprivileged then opUnPriv else opPriv)
1249 forM_ report $ \(fname,act) -> do 1270 forM_ report $ \(fname,act) -> do
1250 putStrLn $ fname ++ ": " ++ reportString act 1271 putStrLn $ fname ++ ": " ++ reportString act
1251 rt <- unconditionally $ return rt 1272 rt <- case rt of
1273 BadPassphrase ->
1274 error "Operation requires correct passphrase. (Hint: Use --passphrase-fd=0 to input it on stdin.)"
1275 _ -> unconditionally $ return rt
1252 1276
1253 -- Finally, export public keys if they do not exist. 1277 -- Finally, export public keys if they do not exist.
1254 flip (maybe $ warn "missing working key?") (rtGrip rt) $ \grip -> do 1278 flip (maybe $ warn "missing working key?") (rtGrip rt) $ \grip -> do
@@ -1256,15 +1280,18 @@ kiki "init-key" args = do
1256 when (not gotc) $ do 1280 when (not gotc) $ do
1257 either warn (writeFile sshcpathpub) 1281 either warn (writeFile sshcpathpub)
1258 $ show_ssh' "ssh-client" grip (rtKeyDB rt) 1282 $ show_ssh' "ssh-client" grip (rtKeyDB rt)
1259 goth <- doesFileExist (sshspathpub) 1283 if (not bUnprivileged)
1260 when (not goth) $ do 1284 then do
1261 either warn (writeFile $ sshspathpub) 1285 goth <- doesFileExist (sshspathpub)
1262 $ show_ssh' "ssh-host" grip (rtKeyDB rt) 1286 when (not goth) $ do
1263 1287 either warn (writeFile $ sshspathpub)
1264 goti <- doesFileExist (ipsecpathpub) 1288 $ show_ssh' "ssh-host" grip (rtKeyDB rt)
1265 when (not goti) $ do 1289 goti <- doesFileExist (ipsecpathpub)
1266 either warn (writeFile $ ipsecpathpub) 1290 when (not goti) $ do
1267 $ show_pem' "strongswan" grip (rtKeyDB rt) 1291 either warn (writeFile $ ipsecpathpub)
1292 $ show_pem' "strongswan" grip (rtKeyDB rt)
1293 else return ()
1294
1268 1295
1269 let cs = filter notme (Map.elems $ rtKeyDB rt) 1296 let cs = filter notme (Map.elems $ rtKeyDB rt)
1270 kk = keykey (fromJust $ rtWorkingKey rt) 1297 kk = keykey (fromJust $ rtWorkingKey rt)