diff options
-rw-r--r-- | kiki.hs | 104 |
1 files changed, 77 insertions, 27 deletions
@@ -1258,12 +1258,42 @@ kiki "merge" [] = do | |||
1258 | , " ( --home[=HOMEDIR]" | 1258 | , " ( --home[=HOMEDIR]" |
1259 | , " | --type=(keyring|pem|wallet|hosts|dns)" | 1259 | , " | --type=(keyring|pem|wallet|hosts|dns)" |
1260 | , " | --access=[auto|secret|public]" | 1260 | , " | --access=[auto|secret|public]" |
1261 | , " | --flow=(fill|spill|sync)[,(subkeys|match=SPEC)]" | 1261 | , " | --flow=(fill|spill|sync)[,(subkeys|signed|match=SPEC)]" |
1262 | , " | --create=CMD" | 1262 | , " | --create=(rsa:SIZE|cmd:CMD)" |
1263 | , " | --autosign[=no]" | 1263 | , " | --autosign[=no]" |
1264 | , " | --delete=FINGERPRINT" | 1264 | , " | --delete=FINGERPRINT" |
1265 | , " | --delete-usage=TAG" | ||
1265 | , " | --" | 1266 | , " | --" |
1266 | , " | FILE ) ..."] | 1267 | , " | FILE ) ..." |
1268 | , "" | ||
1269 | , "OPERANDS" | ||
1270 | , "" | ||
1271 | , " --home[=HOMEDIR] A symbolic operand that is a place holder for two files:" | ||
1272 | , " HOMEDIR/{secring.gpg,pubring.gpg}" | ||
1273 | , " HOMEDIR defaults to your GnuPG home directory." | ||
1274 | , "" | ||
1275 | , " FILE A path to a key file to read or update." | ||
1276 | , "" | ||
1277 | , "MODIFIERS" | ||
1278 | , "" | ||
1279 | , " --type=(keyring|pem|wallet|hosts|dns)" | ||
1280 | , " The type of the following file. Unlike other modifiers," | ||
1281 | , " This modifier remains in effect accross multiple operands" | ||
1282 | , " unless another --type instance is seen. The default type" | ||
1283 | , " is keyring." | ||
1284 | , "" | ||
1285 | , " --access=[auto|secret|public]" | ||
1286 | , "" | ||
1287 | , " --flow=(fill|spill|sync)[,(subkeys|signed|match=SPEC)]" | ||
1288 | , "" | ||
1289 | , " --create=(rsa:SIZE|cmd:CMD)" | ||
1290 | , "" | ||
1291 | , " --autosign[=no]" | ||
1292 | , "" | ||
1293 | , " --delete=FINGERPRINT" | ||
1294 | , "" | ||
1295 | , " --delete-usage=TAG" | ||
1296 | ] | ||
1267 | kiki "merge" args | "--help" `elem` args = do | 1297 | kiki "merge" args | "--help" `elem` args = do |
1268 | kiki "merge" [] | 1298 | kiki "merge" [] |
1269 | -- TODO: more help | 1299 | -- TODO: more help |
@@ -1276,14 +1306,14 @@ kiki "merge" args = do | |||
1276 | forM_ report $ \(fname,act) -> do | 1306 | forM_ report $ \(fname,act) -> do |
1277 | putStrLn $ fname ++ ": " ++ reportString act | 1307 | putStrLn $ fname ++ ": " ++ reportString act |
1278 | where | 1308 | where |
1279 | (_,(_,op)) = foldl' buildOp (True,(flow,noop)) args | 1309 | (_,(_,op)) = foldl' buildOp (True,(flow0,noop)) args |
1280 | noop = KeyRingOperation | 1310 | noop = KeyRingOperation |
1281 | { opFiles = Map.empty | 1311 | { opFiles = Map.empty |
1282 | , opTransforms = [] | 1312 | , opTransforms = [] |
1283 | , opHome = Nothing | 1313 | , opHome = Nothing |
1284 | , opPassphrases = [] | 1314 | , opPassphrases = [] |
1285 | } | 1315 | } |
1286 | flow = StreamInfo | 1316 | flow0 = StreamInfo |
1287 | { access = AutoAccess | 1317 | { access = AutoAccess |
1288 | , typ = KeyRingFile | 1318 | , typ = KeyRingFile |
1289 | , spill = KF_None | 1319 | , spill = KF_None |
@@ -1291,25 +1321,24 @@ kiki "merge" args = do | |||
1291 | , initializer = NoCreate | 1321 | , initializer = NoCreate |
1292 | , transforms = [] | 1322 | , transforms = [] |
1293 | } | 1323 | } |
1294 | updateFlow fil spil mtch flow = spill' $ fill' $ flow | 1324 | updateFlow :: Bool -> Bool -> KeyFilter -> StreamInfo -> StreamInfo |
1325 | updateFlow fil spil val flow = spill' $ fill' $ flow | ||
1295 | where | 1326 | where |
1296 | fill' flow = flow { fill = if fil then val else KF_None } | 1327 | fill' flow = flow { fill = if fil then val else fill flow } |
1297 | spill' flow = flow { spill = if spil then val else KF_None } | 1328 | spill' flow = flow { spill = if spil then val else spill flow } |
1298 | val = either (\subkeys -> if subkeys then KF_Subkeys else KF_All) | 1329 | |
1299 | KF_Match | 1330 | parseFlow :: String -> Maybe ((Bool,Bool),KeyFilter) |
1300 | mtch | 1331 | parseFlow spec = do |
1301 | 1332 | guard $ null bads | |
1302 | parseFlow :: String -> Maybe ((Bool,Bool),Either Bool String) | 1333 | Just ( ( "spill" `elem` goods |
1303 | parseFlow spec = | 1334 | || "sync" `elem` goods |
1304 | if null bads | 1335 | , "fill" `elem` goods |
1305 | then Just ( ( "spill" `elem` goods | 1336 | || "sync" `elem` goods ) |
1306 | || "sync" `elem` goods | 1337 | , case match of |
1307 | , "fill" `elem` goods | 1338 | Just spec -> KF_Match spec |
1308 | || "sync" `elem` goods ) | 1339 | Nothing |
1309 | , maybe (Left $ "subkeys" `elem` goods) | 1340 | | "signed" `elem` goods -> KF_Authentic |
1310 | Right | 1341 | | "subkeys" `elem` goods -> KF_Subkeys ) |
1311 | match ) | ||
1312 | else Nothing | ||
1313 | where | 1342 | where |
1314 | ws = case groupBy (\_ c->c/=',') spec of | 1343 | ws = case groupBy (\_ c->c/=',') spec of |
1315 | w:xs -> w:map (drop 1) xs | 1344 | w:xs -> w:map (drop 1) xs |
@@ -1319,6 +1348,7 @@ kiki "merge" args = do | |||
1319 | acceptable "spill" = True | 1348 | acceptable "spill" = True |
1320 | acceptable "fill" = True | 1349 | acceptable "fill" = True |
1321 | acceptable "sync" = True | 1350 | acceptable "sync" = True |
1351 | acceptable "signed" = True | ||
1322 | acceptable "subkeys" = True | 1352 | acceptable "subkeys" = True |
1323 | acceptable s | "match=" `isPrefixOf` s = True | 1353 | acceptable s | "match=" `isPrefixOf` s = True |
1324 | acceptable _ = False | 1354 | acceptable _ = False |
@@ -1328,13 +1358,17 @@ kiki "merge" args = do | |||
1328 | 1358 | ||
1329 | doFile :: StreamInfo -> KeyRingOperation -> FilePath -> (StreamInfo,KeyRingOperation) | 1359 | doFile :: StreamInfo -> KeyRingOperation -> FilePath -> (StreamInfo,KeyRingOperation) |
1330 | doFile flow op fname = | 1360 | doFile flow op fname = |
1331 | ( flow | 1361 | ( flow0 { typ = typ flow } -- everything resets except for --type |
1332 | , op { opFiles= Map.insert (ArgFile fname) flow (opFiles op) }) | 1362 | , op { opFiles= Map.insert (ArgFile fname) flow (opFiles op) }) |
1333 | 1363 | ||
1334 | doDelete :: String -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation) | 1364 | doDelete :: String -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation) |
1335 | doDelete fp flow op = ( flow | 1365 | doDelete fp flow op = ( flow |
1336 | , op { opTransforms = opTransforms op ++ [DeleteSubkeyByFingerprint fp] } ) | 1366 | , op { opTransforms = opTransforms op ++ [DeleteSubkeyByFingerprint fp] } ) |
1337 | 1367 | ||
1368 | doDeleteUsage :: String -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation) | ||
1369 | doDeleteUsage tag flow op = ( flow | ||
1370 | , op { opTransforms = opTransforms op ++ [DeleteSubkeyByUsage tag] } ) | ||
1371 | |||
1338 | doAutosign :: Bool -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation) | 1372 | doAutosign :: Bool -> StreamInfo -> KeyRingOperation -> (StreamInfo,KeyRingOperation) |
1339 | doAutosign True flow op = | 1373 | doAutosign True flow op = |
1340 | if Map.null (opFiles op) | 1374 | if Map.null (opFiles op) |
@@ -1364,6 +1398,7 @@ kiki "merge" args = do | |||
1364 | case parsed of | 1398 | case parsed of |
1365 | Right fname -> doFile flow op fname | 1399 | Right fname -> doFile flow op fname |
1366 | Left ("delete",Just fp) -> doDelete fp flow op | 1400 | Left ("delete",Just fp) -> doDelete fp flow op |
1401 | Left ("delete-usage",Just tag) -> doDeleteUsage tag flow op | ||
1367 | Left ("autosign",Nothing) -> doAutosign True flow op | 1402 | Left ("autosign",Nothing) -> doAutosign True flow op |
1368 | Left ("autosign",Just "y") -> doAutosign True flow op | 1403 | Left ("autosign",Just "y") -> doAutosign True flow op |
1369 | Left ("autosign",Just "yes") -> doAutosign True flow op | 1404 | Left ("autosign",Just "yes") -> doAutosign True flow op |
@@ -1372,9 +1407,24 @@ kiki "merge" args = do | |||
1372 | Left ("autosign",Just "no") -> doAutosign False flow op | 1407 | Left ("autosign",Just "no") -> doAutosign False flow op |
1373 | Left ("autosign",Just "false")-> doAutosign False flow op | 1408 | Left ("autosign",Just "false")-> doAutosign False flow op |
1374 | Left ("passphrase-fd",Just pass) -> doPassphrase flow op pass | 1409 | Left ("passphrase-fd",Just pass) -> doPassphrase flow op pass |
1375 | Left ("create",Just cmd) -> | 1410 | Left ("create",Nothing) -> |
1376 | ( flow { initializer = if null cmd then NoCreate else External cmd } | 1411 | ( flow { initializer = Internal (GenRSA (4096 `div` 8)) } |
1377 | , op ) | 1412 | , op ) |
1413 | Left ("create",Just cmd) | ||
1414 | | "cmd:" `isPrefixOf` cmd | ||
1415 | -> ( flow { initializer = case drop 4 cmd of | ||
1416 | [] -> NoCreate | ||
1417 | extern -> External extern } | ||
1418 | , op ) | ||
1419 | Left ("create",Just cmd) | ||
1420 | | "rsa:" `isPrefixOf` cmd | ||
1421 | -> ( flow { initializer = case drop 4 cmd of | ||
1422 | [] -> NoCreate | ||
1423 | bits -> | ||
1424 | case takeWhile isDigit bits of | ||
1425 | [] -> NoCreate | ||
1426 | digits -> Internal (GenRSA (read digits `div` 8)) } | ||
1427 | , op ) | ||
1378 | Left ("type",Just "keyring") -> ( flow { typ = KeyRingFile } , op ) | 1428 | Left ("type",Just "keyring") -> ( flow { typ = KeyRingFile } , op ) |
1379 | Left ("type",Just "pem" ) -> ( flow { typ = PEMFile } , op ) | 1429 | Left ("type",Just "pem" ) -> ( flow { typ = PEMFile } , op ) |
1380 | Left ("type",Just "wallet" ) -> ( flow { typ = WalletFile } , op ) | 1430 | Left ("type",Just "wallet" ) -> ( flow { typ = WalletFile } , op ) |
@@ -1398,7 +1448,7 @@ kiki "merge" args = do | |||
1398 | Just ( (spil,fil), mtch ) -> | 1448 | Just ( (spil,fil), mtch ) -> |
1399 | ( updateFlow fil spil mtch flow | 1449 | ( updateFlow fil spil mtch flow |
1400 | , op ) | 1450 | , op ) |
1401 | Nothing -> error "Valid flow words are: spill,fill,sync,subkeys or match=KEYSPEC" | 1451 | Nothing -> error "Valid flow words are: spill,fill,sync,signed,subkeys or match=KEYSPEC" |
1402 | Left (option,_) -> error $ "Unrecognized option: " ++ option | 1452 | Left (option,_) -> error $ "Unrecognized option: " ++ option |
1403 | 1453 | ||
1404 | kiki "init" args | "--help" `elem` args = do | 1454 | kiki "init" args | "--help" `elem` args = do |