← Back to branch summary

~ubuntu-branches/ubuntu/trusty/haskell-hopenpgp/trusty-proposed

« back to all changes in this revision

Viewing changes to Codec/Encryption/OpenPGP/Serialize.hs

  • Committer: Package Import Robot
  • Author(s): Clint Adams
  • Date: 2014-02-02 12:36:09 UTC
  • mfrom: (1.1.18)
  • mto: This revision was merged to the branch mainline in revision 29.
  • Revision ID: package-import@ubuntu.com-20140202123609-y238l2hvkq8z4zra
New upstream version.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Codec/Encryption/OpenPGP/Serialize.hs
507
507
getPkt = do
508
508
    (t, pl) <- getPacketTypeAndPayload
509
509
    case runGet (getPkt' t (B.length pl)) pl of
510
 
        Left e -> fail e
 
510
        Left e -> return $! BrokenPacketPkt e t pl
511
511
        Right p -> return p
512
512
    where
513
513
        getPkt' :: Word8 -> Int -> Get Pkt
519
519
                          remainder <- remaining
520
520
                          mpib <- getBytes remainder
521
521
                          case runGet (many getMPI) mpib of
522
 
                              Left e -> error e
 
522
                              Left e -> fail ("PKESK MPIs " ++ e)
523
523
                              Right sk -> return $ PKESKPkt pv (EightOctetKeyId eokeyid) (toFVal pkalgo) sk
524
524
            | t == 2 = do
525
525
                          remainder <- remaining
526
526
                          bs <- getBytes remainder
527
527
                          case runGet get bs of
528
 
                              Left e -> error e
 
528
                              Left e -> fail ("signature packet " ++ e)
529
529
                              Right sp -> return $ SignaturePkt sp
530
530
            | t == 3 = do
531
531
                          pv <- getWord8
548
548
                                                       ska <- getSKAddendum pkp
549
549
                                                       return $ SecretKeyPkt pkp ska
550
550
                          case ps of
551
 
                              Left err -> error err
 
551
                              Left err -> fail ("secret key " ++ err)
552
552
                              Right key -> return key
553
553
            | t == 6 = do
554
554
                          pkp <- getPKPayload
559
559
                                                       ska <- getSKAddendum pkp
560
560
                                                       return $ SecretSubkeyPkt pkp ska
561
561
                          case ps of
562
 
                              Left err -> error err
 
562
                              Left err -> fail ("secret subkey " ++ err)
563
563
                              Right key -> return key
564
564
            | t == 8 = do
565
565
                          ca <- getWord8
590
590
            | t == 17 = do
591
591
                        bs <- getBytes len
592
592
                        case runGet (many getUserAttrSubPacket) bs of
593
 
                            Left err -> error err
 
593
                            Left err -> fail ("user attribute " ++ err)
594
594
                            Right uas -> return $ UserAttributePkt uas
595
595
            | t == 18 = do
596
596
                          pv <- getWord8 -- should be 1
745
745
    putWord8 (0xc0 .|. t) -- FIXME: restrict t
746
746
    putPacketLength . fromIntegral . B.length $ payload
747
747
    putByteString payload
 
748
putPkt (BrokenPacketPkt _ t payload) = putPkt (OtherPacketPkt t payload)
748
749
 
749
750
getMPI :: Get MPI
750
751
getMPI = do mpilen <- getWord16be
751
 
            bs <- getByteString ((fromIntegral (mpilen - 1) `div` 8) + 1)
 
752
            bs <- getByteString (fromIntegral (mpilen + 7) `div` 8)
752
753
            return $ MPI (beBSToInteger bs)
753
754
 
754
755
getPubkey :: PubKeyAlgorithm -> Get PKey
767
768
                                MPI g <- get
768
769
                                MPI y <- get
769
770
                                return $ ElGamalPubKey [p,g,y]
770
 
getPubkey t = fail ("Unsupported pubkey type " ++ show t)
 
771
getPubkey _ = UnknownPKey <$> (getByteString =<< remaining)
771
772
 
772
773
putPubkey :: PKey -> Put
 
774
putPubkey (UnknownPKey bs) = put bs
773
775
putPubkey p = mapM_ put (pubkeyToMPIs p)
774
776
 
775
777
getSecretKey :: PKPayload -> Get SKey
1155
1157
            remainder <- remaining
1156
1158
            mpib <- getBytes remainder
1157
1159
            case runGet (many getMPI) mpib of
1158
 
                Left e -> error e
 
1160
                Left e -> fail ("v3 sig MPIs " ++ e)
1159
1161
                Right mpis -> return $ SigV3 (toFVal st) ctime (EightOctetKeyId eok) (toFVal pka) (toFVal ha) left16 mpis
1160
1162
        4 -> do
1161
1163
            st <- getWord8
1164
1166
            hlen <- getWord16be
1165
1167
            hb <- getBytes (fromIntegral hlen)
1166
1168
            let hashed = case runGet (many getSigSubPacket) hb of
1167
 
                            Left err -> error err
 
1169
                            Left err -> fail ("v4 sig hasheds " ++ err)
1168
1170
                            Right h -> h
1169
1171
            ulen <- getWord16be
1170
1172
            ub <- getBytes (fromIntegral ulen)
1171
1173
            let unhashed = case runGet (many getSigSubPacket) ub of
1172
 
                            Left err -> error err
 
1174
                            Left err -> fail ("v4 sig unhasheds " ++ err)
1173
1175
                            Right u -> u
1174
1176
            left16 <- getWord16be
1175
1177
            remainder <- remaining
1176
1178
            mpib <- getBytes remainder
1177
1179
            case runGet (many getMPI) mpib of
1178
 
                    Left e -> error e
 
1180
                    Left e -> fail ("v4 sig MPIs " ++ e)
1179
1181
                    Right mpis -> return $ SigV4 (toFVal st) (toFVal pka) (toFVal ha) hashed unhashed left16 mpis
1180
1182
        _ -> do
1181
1183
            remainder <- remaining