summaryrefslogtreecommitdiff
path: root/kiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'kiki.hs')
-rw-r--r--kiki.hs19
1 files changed, 16 insertions, 3 deletions
diff --git a/kiki.hs b/kiki.hs
index 2433d4e..ef8986d 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -65,7 +65,7 @@ import Data.Char
65import Control.Arrow (first,second) 65import Control.Arrow (first,second)
66import Data.Traversable hiding (mapM,forM,sequence) 66import Data.Traversable hiding (mapM,forM,sequence)
67import qualified Data.Traversable as Traversable (mapM,forM,sequence) 67import qualified Data.Traversable as Traversable (mapM,forM,sequence)
68import System.Console.CmdArgs 68-- import System.Console.CmdArgs
69-- import System.Posix.Time 69-- import System.Posix.Time
70import Data.Time.Clock.POSIX 70import Data.Time.Clock.POSIX
71import Data.Monoid ((<>)) 71import Data.Monoid ((<>))
@@ -263,12 +263,14 @@ rsaPrivateKeyFromPacket pkt@(SecretKeyPacket {}) = do
263rsaPrivateKeyFromPacket _ = Nothing 263rsaPrivateKeyFromPacket _ = Nothing
264 264
265 265
266{-
266getPackets :: IO [Packet] 267getPackets :: IO [Packet]
267getPackets = do 268getPackets = do
268 input <- L.getContents 269 input <- L.getContents
269 case decodeOrFail input of 270 case decodeOrFail input of
270 Right (_,_,Message pkts) -> return pkts 271 Right (_,_,Message pkts) -> return pkts
271 Left (_,_,_) -> return [] 272 Left (_,_,_) -> return []
273-}
272 274
273 275
274secretToPublic pkt@(SecretKeyPacket {}) = 276secretToPublic pkt@(SecretKeyPacket {}) =
@@ -638,10 +640,11 @@ modifyUID other = other
638 640
639todo = error "unimplemented" 641todo = error "unimplemented"
640 642
641-- TODO: switch to System.Environment.lookupEnv 643#if MIN_VERSION_base(4,6,0)
642-- when linking against newer base libraries. 644#else
643lookupEnv var = 645lookupEnv var =
644 handleIO_ (return Nothing) $ fmap Just (getEnv var) 646 handleIO_ (return Nothing) $ fmap Just (getEnv var)
647#endif
645 648
646unmaybe def = fmap (maybe def id) 649unmaybe def = fmap (maybe def id)
647 650
@@ -690,10 +693,14 @@ readPacketsFromFile :: FilePath -> IO Message
690readPacketsFromFile fname = do 693readPacketsFromFile fname = do
691 -- warn $ fname ++ ": reading..." 694 -- warn $ fname ++ ": reading..."
692 input <- L.readFile fname 695 input <- L.readFile fname
696#if MIN_VERSION_binary(0,6,4)
693 return $ 697 return $
694 case decodeOrFail input of 698 case decodeOrFail input of
695 Right (_,_,msg ) -> msg 699 Right (_,_,msg ) -> msg
696 Left (_,_,_) -> trace (fname++": read fail") $ Message [] 700 Left (_,_,_) -> trace (fname++": read fail") $ Message []
701#else
702 return $ decode input
703#endif
697 704
698lockFiles fs = do 705lockFiles fs = do
699 let dolock f = do 706 let dolock f = do
@@ -949,11 +956,13 @@ readKeyFromFile False "PEM" fname = do
949 } 956 }
950readKeyFromFile is_public fmt filename = error ("unimplemented key type: "++fmt) 957readKeyFromFile is_public fmt filename = error ("unimplemented key type: "++fmt)
951 958
959{-
952getPassphrase cmd = 960getPassphrase cmd =
953 case passphrase_fd cmd of 961 case passphrase_fd cmd of
954 Just fd -> do pwh <- fdToHandle (toEnum fd) 962 Just fd -> do pwh <- fdToHandle (toEnum fd)
955 fmap trimCR $ S.hGetContents pwh 963 fmap trimCR $ S.hGetContents pwh
956 Nothing -> return "" 964 Nothing -> return ""
965-}
957 966
958 967
959#define HOMEOPTION (def &= explicit &= name "homedir" &= typDir ) 968#define HOMEOPTION (def &= explicit &= name "homedir" &= typDir )
@@ -1355,12 +1364,14 @@ cross_merge doDecrypt grip0 keyrings wallets f = do
1355 return () 1364 return ()
1356 1365
1357 1366
1367{-
1358data Arguments = 1368data Arguments =
1359 Cross_Merge { homedir :: Maybe FilePath 1369 Cross_Merge { homedir :: Maybe FilePath
1360 , passphrase_fd :: Maybe Int 1370 , passphrase_fd :: Maybe Int
1361 , files :: [FilePath] 1371 , files :: [FilePath]
1362 } 1372 }
1363 deriving (Show, Data, Typeable) 1373 deriving (Show, Data, Typeable)
1374-}
1364 1375
1365toLast f [] = [] 1376toLast f [] = []
1366toLast f [x] = [f x] 1377toLast f [x] = [f x]
@@ -2479,6 +2490,7 @@ main = do
2479 where topair (x:xs) = (x,xs) 2490 where topair (x:xs) = (x,xs)
2480 return $ lookup "default-key" config >>= listToMaybe 2491 return $ lookup "default-key" config >>= listToMaybe
2481 2492
2493 {-
2482 getPGPEnviron cmd = do 2494 getPGPEnviron cmd = do
2483 (homedir,secring,pubring,grip) <- getHomeDir (homedir cmd) 2495 (homedir,secring,pubring,grip) <- getHomeDir (homedir cmd)
2484 (Message sec) <- readPacketsFromFile secring 2496 (Message sec) <- readPacketsFromFile secring
@@ -2487,6 +2499,7 @@ main = do
2487 ; _ -> False }) 2499 ; _ -> False })
2488 sec 2500 sec
2489 return (homedir,sec, grip `mplus` fmap fingerprint (listToMaybe keys)) 2501 return (homedir,sec, grip `mplus` fmap fingerprint (listToMaybe keys))
2502 -}
2490 2503
2491 getTorKeys pub = do 2504 getTorKeys pub = do
2492 xs <- groupBindings pub 2505 xs <- groupBindings pub