summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--keys.hs85
1 files changed, 16 insertions, 69 deletions
diff --git a/keys.hs b/keys.hs
index 00116f8..5f0da17 100644
--- a/keys.hs
+++ b/keys.hs
@@ -3,6 +3,7 @@
3{-# LANGUAGE OverloadedStrings #-} 3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE RankNTypes #-} 4{-# LANGUAGE RankNTypes #-}
5{-# LANGUAGE FlexibleInstances #-} 5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE DeriveDataTypeable #-}
6module Main where 7module Main where
7 8
8import Debug.Trace 9import Debug.Trace
@@ -28,9 +29,6 @@ import qualified Crypto.PubKey.RSA as RSA
28import Data.ASN1.Types 29import Data.ASN1.Types
29import Data.ASN1.Encoding 30import Data.ASN1.Encoding
30import Data.ASN1.BinaryEncoding 31import Data.ASN1.BinaryEncoding
31import System.Console.CmdTheLine as CmdTheLine
32import System.Console.CmdTheLine.GetOpt
33import System.Console.GetOpt
34import Control.Applicative 32import Control.Applicative
35import System.Environment 33import System.Environment
36import System.Directory 34import System.Directory
@@ -39,6 +37,7 @@ import ControlMaybe
39import Data.Char 37import Data.Char
40import Control.Arrow (second) 38import Control.Arrow (second)
41import Data.Traversable 39import Data.Traversable
40import System.Console.CmdArgs
42 41
43data RSAPublicKey = RSAKey MPI MPI 42data RSAPublicKey = RSAKey MPI MPI
44 43
@@ -352,74 +351,12 @@ todo = error "unimplemented"
352lookupEnv var = 351lookupEnv var =
353 handleIO_ (return Nothing) $ fmap Just (getEnv var) 352 handleIO_ (return Nothing) $ fmap Just (getEnv var)
354 353
355homedir :: Term (IO String)
356homedir = envhomedir <$> opt_homedir
357 where
358 envhomedir opt = do
359 gnupghome <- lookupEnv "GNUPGHOME" >>=
360 \d -> return $ d >>= guard . (/="") >> d
361 home <- lookupEnv "HOME" >>=
362 \d -> return $ d >>= guard . (/="") >> d
363 {-
364 home <- flip fmap getHomeDirectory $
365 \d -> fmap (const d) $ guard (d/="")
366 -}
367 let homegnupg = (++"/.gnupg") <$> home
368 return $ maybe "" id (opt `mplus` gnupghome `mplus` homegnupg)
369
370opt_homedir = optDescrToTerm $ Option
371 "" ["homedir"]
372 (ReqArg id "dir")
373 (concat
374 [ "path to pubring.gpg"
375 , " and secring.gpg"
376 , " (default = ${GNUPGHOME:-$HOME/.gnupg})" ])
377
378opt_options = optDescrToTerm $ Option
379 "" ["options"]
380 (ReqArg id "file")
381 $ concat
382 [ "Read options from file and do not try to read"
383 , " them from the default options file in the"
384 , " homedir (see --homedir). This option is"
385 , " ignored if used in an options file."
386 , " The default options file is the first existing"
387 , " out of keys.conf, gpg.conf-2, and gpg.conf."]
388
389opt_default_key = optDescrToTerm $ Option
390 "" ["default-key"]
391 (ReqArg id "name")
392 $ concat
393 [ "Use name as the default key to sign with. If"
394 , " this option is not used, the default key is"
395 , " the first key found in the secret keyring."]
396
397opt_list_secret_keys = optDescrToTerm $ Option
398 "K" ["list-secret-keys"]
399 (NoArg ())
400 $ concat
401 [ "List all keys from the secret keyrings." ]
402
403
404unmaybe def = fmap (maybe def id) 354unmaybe def = fmap (maybe def id)
405 355
406opt_secret_keyring = expandPath <$> unmaybe "" opt_homedir <*> prim
407 where
408 -- TODO: alow multiple instances of --secret-keyring
409 -- See: System.Console.CmdTheLine.Arg.vFlagAll
410 prim = unmaybe "secring.gpg" . optDescrToTerm $ Option
411 "" ["secret-keyring"]
412 (ReqArg id "file")
413 $ concat
414 [ "Utilize secret keys in the specified file."
415 , "(default: secring.gpg)" ]
416
417expandPath path (c:cs) | c/='/' = path ++ "/" ++ (c:cs) 356expandPath path (c:cs) | c/='/' = path ++ "/" ++ (c:cs)
418 | otherwise = c:cs 357 | otherwise = c:cs
419expandPath path [] = [] 358expandPath path [] = []
420 359
421secret_packets :: Term (IO Message)
422secret_packets = readPacketsFromFile <$> opt_secret_keyring
423 360
424readPacketsFromFile :: FilePath -> IO Message 361readPacketsFromFile :: FilePath -> IO Message
425readPacketsFromFile fname = do 362readPacketsFromFile fname = do
@@ -437,6 +374,7 @@ parseOptionFile fname = do
437 notComment cs = not (all isSpace cs) 374 notComment cs = not (all isSpace cs)
438 return ys 375 return ys
439 376
377{-
440options_from_file :: 378options_from_file ::
441 (forall a. [String] -> Term a -> IO (Either EvalExit a)) 379 (forall a. [String] -> Term a -> IO (Either EvalExit a))
442 -> Term b 380 -> Term b
@@ -592,9 +530,18 @@ multiCommand ti choices =
592 selectAction cmd choices = 530 selectAction cmd choices =
593 fromJust $ lookup (cmd::Command) choices 531 fromJust $ lookup (cmd::Command) choices
594 strip (cmd,(action,_)) = fmap (cmd,) action 532 strip (cmd,(action,_)) = fmap (cmd,) action
533-}
534
535data Keys =
536 List
537 | AutoSign {input :: FilePath, output :: FilePath}
538 deriving (Show, Data, Typeable)
595 539
596main = do 540main = do
597 let version = defTI { termName = "keys", CmdTheLine.version = "0.1" } 541 args <- cmdArgs $ modes [List &= help "list keys",AutoSign (def &= argPos 1
598 q <- uncurry runChoiceWithOptionsFile $ multiCommand version 542 &= typFile )
599 [ cmdlist, cmdautosign ] 543 (def &=argPos 2
600 return () 544 &= typFile)]
545 &= summary "keys - a pgp key editing utility"
546 putStrLn $ show args
547