Changed pgpSign to return a Maybe in case a signature cannot be made.

2 files changed, 11 insertions, 7 deletions

diff --git a/OpenPGP.hs b/OpenPGP.hs
index 7fef0b5..75054b3 100644
--- a/OpenPGP.hs
+++ b/OpenPGP.hs
@@ -10,6 +10,7 @@ import Data.OpenPGP.CryptoAPI (verify,fingerprint,sign,decryptSecretKey)
 import Data.Time.Clock.POSIX
 import Control.Applicative ( (<$>) )
 import Crypto.Random (newGenIO,SystemRandom)
+import ControlMaybe
 
 now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime
 
@@ -32,11 +33,12 @@ pgpSign ::
     -> OpenPGP.SignatureOver -- ^ Data to sign, and optional signature packet
     -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature
     -> String                -- ^ KeyID of key to choose
-    -> IO OpenPGP.SignatureOver
-pgpSign seckeys dta hash_algo keyid = do
+    -> IO (Maybe OpenPGP.SignatureOver)
+pgpSign seckeys dta hash_algo keyid =
+    handleIO_ (return Nothing) $ do
     timestamp <- now
     g <- newGenIO :: IO SystemRandom
     let sigs = map (stampit timestamp) $ signatures_over dta
         dta' = dta { signatures_over = sigs }
     let (r,g') = sign seckeys dta' hash_algo keyid timestamp g
-    return r
+    return (Just r)
diff --git a/kiki.hs b/kiki.hs
index 3dc0edd..8e49086 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -1674,7 +1674,7 @@ doImportG doDecrypt db m0 tag fname key = do
                                   SHA1
                                   (fingerprint wkun)
                 flip (maybe $ warn "Failed to make signature" >> return uids)
-                     (listToMaybe $ signatures_over sig_ov)
+                     (sig_ov >>= listToMaybe . signatures_over)
                      $ \sig -> do
                 let om = Map.singleton fname (origin sig (-1))
                     trust = Map.empty
@@ -1706,7 +1706,7 @@ makeSig doDecrypt top fname subkey_p tag mbsig = do
     let grip = fingerprint wk
         addOrigin new_sig = do
             flip (maybe $ error "Failed to make signature.") 
-                 (listToMaybe $ signatures_over new_sig) 
+                 (new_sig >>= listToMaybe . signatures_over) 
                  $ \new_sig -> do
             let mp' = MappedPacket new_sig (Map.singleton fname (origin new_sig (-1)))
             return (mp', Map.empty)
@@ -1738,8 +1738,9 @@ makeSig doDecrypt top fname subkey_p tag mbsig = do
                                                      [IssuerPacket subgrip]))
                         SHA1
                         subgrip
-    let unhashed0 = ( IssuerPacket (fingerprint wk)
-                     : map EmbeddedSignaturePacket (signatures_over back_sig))
+    let iss = IssuerPacket (fingerprint wk)
+        cons_iss back_sig = iss : map EmbeddedSignaturePacket (signatures_over back_sig)
+        unhashed0 = maybe [iss] cons_iss back_sig
 
     new_sig <- pgpSign (Message [wkun])
                        (SubkeySignature wk
@@ -2212,6 +2213,7 @@ main = do
                                                                    . keykey))
                           vs
         additional new_sig = do
+            new_sig <- maybeToList new_sig
             guard $ {- trace (unlines $ [ "selfsigs = "++show (map ((\(_,_,k)->fingerprint k)) selfsigs)
                                      , " for mainkey = "++fingerprint mainpubkey] )
                         -}