diff options
-rw-r--r-- | kiki.hs | 85 |
1 files changed, 56 insertions, 29 deletions
@@ -22,7 +22,7 @@ import Data.Maybe | |||
22 | import Data.OpenPGP | 22 | import Data.OpenPGP |
23 | import Data.Ord | 23 | import Data.Ord |
24 | import Data.Text.Encoding | 24 | import Data.Text.Encoding |
25 | -- import System.Posix.User | 25 | import System.Posix.User |
26 | import System.FilePath.Posix | 26 | import System.FilePath.Posix |
27 | import System.Directory | 27 | import System.Directory |
28 | import System.Environment | 28 | import System.Environment |
@@ -1137,8 +1137,8 @@ kiki "init-key" args | "--help" `elem` args = do | |||
1137 | , " | --chroot=ROOTDIR ] ..."] | 1137 | , " | --chroot=ROOTDIR ] ..."] |
1138 | return () | 1138 | return () |
1139 | kiki "init-key" args = do | 1139 | kiki "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) |