diff options
author | joe <joe@jerkface.net> | 2014-07-31 22:04:42 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2014-07-31 22:04:42 -0400 |
commit | b08068c787f8f69271cd7d9f7480e88a988acbff (patch) | |
tree | 988fb8473d2195b1868dc738801fde6444a99c24 /kiki.hs | |
parent | 1e92b09448a61b715b8a7394ede0062d5a2efb45 (diff) |
init-key command
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 121 |
1 files changed, 120 insertions, 1 deletions
@@ -22,6 +22,9 @@ 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 | ||
26 | import System.FilePath.Posix | ||
27 | import System.Directory | ||
25 | import System.Environment | 28 | import System.Environment |
26 | import System.Exit | 29 | import System.Exit |
27 | import System.IO (hPutStrLn,stderr) | 30 | import System.IO (hPutStrLn,stderr) |
@@ -38,6 +41,7 @@ import Data.Binary.Put (putWord32be,runPut,putByteString) | |||
38 | import Data.Time.Clock.POSIX ( posixSecondsToUTCTime ) | 41 | import Data.Time.Clock.POSIX ( posixSecondsToUTCTime ) |
39 | import Data.Monoid ( (<>) ) | 42 | import Data.Monoid ( (<>) ) |
40 | 43 | ||
44 | import Data.OpenPGP.Util (verify,fingerprint) | ||
41 | import ScanningParser | 45 | import ScanningParser |
42 | import PEM | 46 | import PEM |
43 | import DotLock | 47 | import DotLock |
@@ -45,7 +49,8 @@ import LengthPrefixedBE | |||
45 | import KeyRing | 49 | import KeyRing |
46 | import Base58 | 50 | import Base58 |
47 | import qualified CryptoCoins | 51 | import qualified CryptoCoins |
48 | import Data.OpenPGP.Util (verify,fingerprint) | 52 | -- import Chroot |
53 | import ProcessUtils | ||
49 | 54 | ||
50 | -- {-# ANN module ("HLint: ignore Eta reduce"::String) #-} | 55 | -- {-# ANN module ("HLint: ignore Eta reduce"::String) #-} |
51 | -- {-# ANN module ("HLint: ignore Use camelCase"::String) #-} | 56 | -- {-# ANN module ("HLint: ignore Use camelCase"::String) #-} |
@@ -138,6 +143,7 @@ fpmatch grip key = | |||
138 | listKeys pkts = listKeysFiltered [] pkts | 143 | listKeys pkts = listKeysFiltered [] pkts |
139 | 144 | ||
140 | listKeysFiltered grips pkts = do | 145 | listKeysFiltered grips pkts = do |
146 | -- FIXME: Will not show any output when there are no subkeys. | ||
141 | let (certs,bs) = getBindings pkts | 147 | let (certs,bs) = getBindings pkts |
142 | as = accBindings bs | 148 | as = accBindings bs |
143 | defaultkind (k:_) hs = k | 149 | defaultkind (k:_) hs = k |
@@ -1105,6 +1111,118 @@ kiki "merge" args = do | |||
1105 | Nothing -> error "Valid flow words are: spill,fill,sync,subkeys or match=KEYSPEC" | 1111 | Nothing -> error "Valid flow words are: spill,fill,sync,subkeys or match=KEYSPEC" |
1106 | Left (option,_) -> error $ "Unrecognized option: " ++ option | 1112 | Left (option,_) -> error $ "Unrecognized option: " ++ option |
1107 | 1113 | ||
1114 | kiki "init-key" args | "--help" `elem` args = do | ||
1115 | putStr . unlines $ | ||
1116 | [ "kiki init-key [ --passphrase-fd=FD" | ||
1117 | , " | --home[=HOMEDIR]" | ||
1118 | , " | --chroot=ROOTDIR ] ..."] | ||
1119 | return () | ||
1120 | kiki "init-key" args = do | ||
1121 | {- | ||
1122 | me <- getEffectiveUserID | ||
1123 | if me/=0 then error "This command requires root." else do | ||
1124 | -} | ||
1125 | let as = lefts $ map splitArg args | ||
1126 | lefts = mapMaybe isLeft where { isLeft (Left x) = Just x; isLeft _ = Nothing } | ||
1127 | bads = map fst as \\ ["passphrase-fd","home","chroot"] | ||
1128 | if not (null bads) then error ("Bad option: " ++ unwords bads) else do | ||
1129 | let rootdir = fmap (fromMaybe "") $ lookup "chroot" as | ||
1130 | if rootdir==Just "" then error "--chroot requires an argument" else do | ||
1131 | -- maybe id fchroot rootdir $ do | ||
1132 | args <- return $ map (second $ fromMaybe "") as | ||
1133 | |||
1134 | let homespec = mplus ( (++) <$> rootdir <*> lookup "home" args ) | ||
1135 | (fmap (++"/root/.gnupg") rootdir) | ||
1136 | sshkeygen size = Just $ concat [ "mkdir -p \"$(dirname $file)\" && " | ||
1137 | , "ssh-keygen -P \"\" -q -f $file -b " | ||
1138 | , show size ] | ||
1139 | mkdirFor path = do | ||
1140 | let dir = takeDirectory path | ||
1141 | putStrLn $ "mkdirFor " ++ show dir | ||
1142 | createDirectoryIfMissing True dir | ||
1143 | -- ssl = Just "mkdir -p \"$(dirname $file)\" && openssl genrsa -out $file 1024" | ||
1144 | (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec | ||
1145 | putStrLn $ "home = " ++ show (home,secring,pubring,mbwk) | ||
1146 | gotsec <- doesFileExist secring | ||
1147 | when (not gotsec) $ do | ||
1148 | let mkpath = home ++ "/master-key" | ||
1149 | mkdirFor mkpath | ||
1150 | e <- systemEnv [ ("file",mkpath) ] (fromJust $ sshkeygen 4096) | ||
1151 | case e of | ||
1152 | ExitFailure num -> error "ssh-keygen failed to create master key" | ||
1153 | ExitSuccess -> return () | ||
1154 | [PEMPacket mk] <- readSecretPEMFile (ArgFile mkpath) | ||
1155 | writeInputFileL (InputFileContext secring pubring) | ||
1156 | HomeSec | ||
1157 | ( encode $ Message [mk { is_subkey = False }] ) | ||
1158 | gotpub <- doesFileExist pubring | ||
1159 | when (not gotpub) $ do | ||
1160 | writeInputFileL (InputFileContext secring pubring) | ||
1161 | HomePub | ||
1162 | ( encode $ Message [] ) | ||
1163 | |||
1164 | -- First, we ensure that the tor key exists and is imported | ||
1165 | -- so that we know where to put the strongswan key. | ||
1166 | let torpath = fromMaybe "" rootdir ++ "/var/lib/tor/samizdat/private_key" | ||
1167 | passfd = fmap (FileDesc . read) $ lookup "passphrase-fd" args | ||
1168 | buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp | ||
1169 | , fill = rtyp | ||
1170 | , spill = KF_All | ||
1171 | , access = AutoAccess | ||
1172 | , initializer = Nothing | ||
1173 | , transforms = [] } | ||
1174 | peminfo bits usage = | ||
1175 | StreamInfo { typ = PEMFile | ||
1176 | , fill = KF_Match usage | ||
1177 | , spill = KF_Match usage | ||
1178 | , access = Sec | ||
1179 | , initializer = sshkeygen bits | ||
1180 | , transforms = [] | ||
1181 | } | ||
1182 | op = KeyRingOperation | ||
1183 | { opFiles = Map.fromList $ | ||
1184 | [ ( HomeSec, buildStreamInfo KF_All KeyRingFile ) | ||
1185 | , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } ) | ||
1186 | , ( ArgFile torpath, peminfo 1024 "tor" ) ] | ||
1187 | , opPassphrases = do pfd <- maybeToList passfd | ||
1188 | return $ PassphraseSpec Nothing Nothing pfd | ||
1189 | , opHome = homespec | ||
1190 | , opTransforms = [] | ||
1191 | } | ||
1192 | mkdirFor torpath | ||
1193 | KikiResult rt report <- runKeyRing op | ||
1194 | forM_ report $ \(fname,act) -> do | ||
1195 | putStrLn $ fname ++ ": " ++ reportString act | ||
1196 | rt <- unconditionally $ return rt | ||
1197 | |||
1198 | -- Now import, export, or generate the remaining secret keys. | ||
1199 | let oname = do wk <- rtWorkingKey rt | ||
1200 | onionNameForContact (keykey wk) (rtKeyDB rt) | ||
1201 | flip (maybe $ error "Missing tor key") oname $ \oname -> do | ||
1202 | let sshcpath = fromMaybe "" rootdir ++ "/root/.ssh/id_rsa" | ||
1203 | sshspath = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key" | ||
1204 | ipsecpath = fromMaybe "" rootdir ++ "/etc/ipsec.d/private/"++oname++".pem" | ||
1205 | op2 = op | ||
1206 | { opFiles = Map.fromList $ | ||
1207 | [ ( HomeSec, buildStreamInfo KF_All KeyRingFile ) | ||
1208 | , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } ) | ||
1209 | , ( ArgFile ipsecpath, peminfo 1024 "strongswan" ) | ||
1210 | , ( ArgFile sshcpath, peminfo 2048 "ssh-client" ) | ||
1211 | , ( ArgFile sshspath, peminfo 2048 "ssh-server" ) ] | ||
1212 | } | ||
1213 | forM_ [sshcpath,sshspath,ipsecpath] mkdirFor | ||
1214 | KikiResult rt report <- runKeyRing op2 | ||
1215 | forM_ report $ \(fname,act) -> do | ||
1216 | putStrLn $ fname ++ ": " ++ reportString act | ||
1217 | rt <- unconditionally $ return rt | ||
1218 | |||
1219 | -- Finally, export public keys if they do not exist. | ||
1220 | -- TODO | ||
1221 | -- makepub ssh-client "$ROOT/root/.ssh/id_rsa.pub" | ||
1222 | -- makepub ssh-host "$ROOT/etc/ssh/ssh_host_rsa_key.pub" | ||
1223 | |||
1224 | return () | ||
1225 | |||
1108 | splitArg :: String -> Either (String,Maybe String) String | 1226 | splitArg :: String -> Either (String,Maybe String) String |
1109 | splitArg arg = | 1227 | splitArg arg = |
1110 | case hyphens of | 1228 | case hyphens of |
@@ -1132,6 +1250,7 @@ commands = | |||
1132 | , ( "export-public", "import (public) information into your keyring" ) | 1250 | , ( "export-public", "import (public) information into your keyring" ) |
1133 | , ( "working-key", "show the current working master key and its subkeys" ) | 1251 | , ( "working-key", "show the current working master key and its subkeys" ) |
1134 | , ( "merge", "low level import/export operation" ) | 1252 | , ( "merge", "low level import/export operation" ) |
1253 | , ( "init-key", "initialize the samizdat key ring") | ||
1135 | ] | 1254 | ] |
1136 | 1255 | ||
1137 | main = do | 1256 | main = do |