hspkcs11 0.2 → 0.3

raw patch · 3 files changed

+199/−18 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• System/Crypto/Pkcs11.chs +186/−16
• Test.hs +11/−1
• hspkcs11.cabal +2/−1

@@ -3,11 +3,9 @@     -- * Library     Library,     loadLibrary,+    releaseLibrary,      -- ** Reading library information-    Version,-    versionMajor,-    versionMinor,     Info,     getInfo,     infoCryptokiVersion,@@ -62,9 +60,16 @@     -- ** Searching objects     findObjects,     -- ** Reading object attributes+    getTokenFlag,+    getPrivateFlag,+    getSensitiveFlag,+    getEncryptFlag,+    getDecryptFlag,+    getWrapFlag,+    getUnwrapFlag,+    getSignFlag,     getModulus,     getPublicExponent,-    getDecryptFlag,      -- * Key generation     generateKeyPair,@@ -75,6 +80,11 @@     -- * Encryption/decryption     decrypt,     encrypt,++    -- * Misc+    Version,+    versionMajor,+    versionMinor, ) where import Foreign import Foreign.Marshal.Utils@@ -104,6 +114,7 @@ type ObjectHandle = {#type CK_OBJECT_HANDLE#} type SlotId = Int type Rv = {#type CK_RV#}+type CK_BBOOL = {#type CK_BBOOL#} type CK_BYTE = {#type CK_BYTE#} type CK_FLAGS = {#type CK_FLAGS#} type GetFunctionListFunPtr = {#type CK_C_GetFunctionList#}@@ -141,10 +152,14 @@     {#set CK_VERSION->minor#} p (fromIntegral $ versionMinor x)  data Info = Info {+    -- | Cryptoki interface version number, for compatibility with future revisions of this interface     infoCryptokiVersion :: Version,+    -- | ID of the Cryptoki library manufacturer     infoManufacturerId :: String,+    -- | bit flags reserved for future versions. Must be zero for this version     infoFlags :: Int,     infoLibraryDescription :: String,+    -- | Cryptoki library version number     infoLibraryVersion :: Version } deriving (Show) @@ -165,6 +180,8 @@                  infoLibraryDescription=libraryDescription,                  infoLibraryVersion=libVer                  }+  poke p v = do+    error "not implemented"   peekInfo :: Ptr Info -> IO Info@@ -174,6 +191,7 @@ data SlotInfo = SlotInfo {     slotInfoDescription :: String,     slotInfoManufacturerId :: String,+    -- | bit flags indicating capabilities and status of the slot as defined in https://www.cryptsoft.com/pkcs11doc/v220/pkcs11__all_8h.html#aCK_SLOT_INFO     slotInfoFlags :: Int,     slotInfoHardwareVersion :: Version,     slotInfoFirmwareVersion :: Version@@ -194,6 +212,8 @@                      slotInfoHardwareVersion=hwVer,                      slotInfoFirmwareVersion=fwVer                      }+  poke p v = do+    error "not implemented"   data TokenInfo = TokenInfo {@@ -201,6 +221,7 @@     tokenInfoManufacturerId :: String,     tokenInfoModel :: String,     tokenInfoSerialNumber :: String,+    -- | bit flags indicating capabilities and status of the device as defined in https://www.cryptsoft.com/pkcs11doc/v220/pkcs11__all_8h.html#aCK_TOKEN_INFO     tokenInfoFlags :: Int--,     --tokenInfoHardwareVersion :: Version,     --tokenInfoFirmwareVersion :: Version@@ -226,7 +247,10 @@                           --tokenInfoFirmwareVersion=fwVer                           } +    poke p v = do+        error "not implemented" + data MechInfo = MechInfo {     mechInfoMinKeySize :: Int,     mechInfoMaxKeySize :: Int,@@ -255,6 +279,8 @@ instance Storable Mech where     sizeOf _ = {#sizeof CK_MECHANISM_TYPE#} + {#sizeof CK_VOID_PTR#} + {#sizeof CK_ULONG#}     alignment _ = 1+    peek p = do+        error "not implemented"     poke p x = do         poke (p `plusPtr` 0) (fromEnum $ mechType x)         poke (p `plusPtr` {#sizeof CK_MECHANISM_TYPE#}) (mechParamPtr x :: {#type CK_VOID_PTR#})@@ -467,19 +493,123 @@  {#enum define AttributeType {     CKA_CLASS as ClassType,-    CKA_KEY_TYPE as KeyTypeType,+    CKA_TOKEN as TokenType,+    CKA_PRIVATE as PrivateType,     CKA_LABEL as LabelType,-    CKA_MODULUS_BITS as ModulusBitsType,-    CKA_MODULUS as ModulusType,+    CKA_APPLICATION as ApplicationType,+    CKA_VALUE as ValueType,+    CKA_OBJECT_ID as ObjectType,+    CKA_CERTIFICATE_TYPE as CertificateType,+    CKA_ISSUER as IssuerType,+    CKA_SERIAL_NUMBER as SerialNumberType,+    CKA_AC_ISSUER as AcIssuerType,+    CKA_OWNER as OwnerType,+    CKA_ATTR_TYPES as AttrTypesType,+    CKA_TRUSTED as TrustedType,+    CKA_CERTIFICATE_CATEGORY as CertificateCategoryType,+    CKA_JAVA_MIDP_SECURITY_DOMAIN as JavaMidpSecurityDomainType,+    CKA_URL as UrlType,+    CKA_HASH_OF_SUBJECT_PUBLIC_KEY as HashOfSubjectPublicKeyType,+    CKA_HASH_OF_ISSUER_PUBLIC_KEY as HashOfIssuerPublicKeyType,+    CKA_CHECK_VALUE as CheckValueType,++    CKA_KEY_TYPE as KeyTypeType,+    CKA_SUBJECT as SubjectType,+    CKA_ID as IdType,+    CKA_SENSITIVE as SensitiveType,+    CKA_ENCRYPT as EncryptType,+    CKA_DECRYPT as DecryptType,+    CKA_WRAP as WrapType,+    CKA_UNWRAP as UnwrapType,+    CKA_SIGN as SignType,+    CKA_SIGN_RECOVER as SignRecoverType,+    CKA_VERIFY as VerifyType,+    CKA_VERIFY_RECOVER as VerifyRecoverType,+    CKA_DERIVE as DeriveType,+    CKA_START_DATE as StartDateType,+    CKA_END_DATE as EndDataType,     CKA_PUBLIC_EXPONENT as PublicExponentType,     CKA_PRIVATE_EXPONENT as PrivateExponentType,+    CKA_MODULUS as ModulusType,+    CKA_MODULUS_BITS as ModulusBitsType,     CKA_PRIME_1 as Prime1Type,     CKA_PRIME_2 as Prime2Type,     CKA_EXPONENT_1 as Exponent1Type,     CKA_EXPONENT_2 as Exponent2Type,     CKA_COEFFICIENT as CoefficientType,-    CKA_TOKEN as TokenType,-    CKA_DECRYPT as DecryptType++    CKA_PRIME_BITS as PrimeBitsType,+    CKA_SUBPRIME_BITS as SubPrimeBitsType,++    CKA_VALUE_BITS as ValueBitsType,+    CKA_VALUE_LEN as ValueLenType,+    CKA_EXTRACTABLE as ExtractableType,+    CKA_LOCAL as LocalType,+    CKA_NEVER_EXTRACTABLE as NeverExtractableType,+    CKA_ALWAYS_SENSITIVE as AlwaysSensitiveType,+    CKA_KEY_GEN_MECHANISM as KeyGenMechanismType,++    CKA_MODIFIABLE as ModifiableType,++    -- CKA_ECDSA_PARAMS is deprecated in v2.11,+    -- CKA_EC_PARAMS is preferred.+    CKA_ECDSA_PARAMS as EcdsaParamsType,+    CKA_EC_PARAMS as EcParamsType,++    CKA_EC_POINT as EcPointType,++    -- CKA_SECONDARY_AUTH, CKA_AUTH_PIN_FLAGS,+    -- are new for v2.10. Deprecated in v2.11 and onwards.+    CKA_SECONDARY_AUTH as SecondaryAuthType,+    CKA_AUTH_PIN_FLAGS as AuthPinFlagsType,++    CKA_ALWAYS_AUTHENTICATE as AlwaysAuthenticateType,++    CKA_WRAP_WITH_TRUSTED    as WrapWithTrustedType,+    CKA_WRAP_TEMPLATE        as WrapTemplateType,+    CKA_UNWRAP_TEMPLATE      as UnwrapTemplateType,+    CKA_DERIVE_TEMPLATE      as DeriveTemplateType,++    CKA_OTP_FORMAT                as OtpFormatType,+    CKA_OTP_LENGTH                as OtpLengthType,+    CKA_OTP_TIME_INTERVAL         as OtpTimeIntervalType,+    CKA_OTP_USER_FRIENDLY_MODE    as OtpUserFriendlyModeType,+    CKA_OTP_CHALLENGE_REQUIREMENT as OtpChallengeRequirementType,+    CKA_OTP_TIME_REQUIREMENT      as OtpTimeRequirementType,+    CKA_OTP_COUNTER_REQUIREMENT   as OtpCounterRequirementType,+    CKA_OTP_PIN_REQUIREMENT       as OtpPinRequirementType,+    CKA_OTP_COUNTER               as OtpCounterType,+    CKA_OTP_TIME                  as OtpTimeType,+    CKA_OTP_USER_IDENTIFIER       as OtpUserIdentifierType,+    CKA_OTP_SERVICE_IDENTIFIER    as OtpServiceIdentifierType,+    CKA_OTP_SERVICE_LOGO          as OtpServiceLogoType,+    CKA_OTP_SERVICE_LOGO_TYPE     as OtpServiceLogoTypeType,++    CKA_GOSTR3410_PARAMS          as GostR3410ParamsType,+    CKA_GOSTR3411_PARAMS          as GostR3411ParamsType,+    CKA_GOST28147_PARAMS          as Gost28147ParamsType,++    CKA_HW_FEATURE_TYPE    as HwFeatureTypeType,+    CKA_RESET_ON_INIT      as ResetOnInitType,+    CKA_HAS_RESET          as HasResetType,++    CKA_PIXEL_X                     as PixelXType,+    CKA_PIXEL_Y                     as PixelYType,+    CKA_RESOLUTION                  as ResolutionType,+    CKA_CHAR_ROWS                   as CharRowsType,+    CKA_CHAR_COLUMNS                as CharColumnsType,+    CKA_COLOR                       as ColorType,+    CKA_BITS_PER_PIXEL              as BitPerPixelType,+    CKA_CHAR_SETS                   as CharSetsType,+    CKA_ENCODING_METHODS            as EncodingMethodsType,+    CKA_MIME_TYPES                  as MimeTypesType,+    CKA_MECHANISM_TYPE              as MechanismTypeType,+    CKA_REQUIRED_CMS_ATTRIBUTES     as RequiredCmsAttributesType,+    CKA_DEFAULT_CMS_ATTRIBUTES      as DefaultCmsAttributesType,+    CKA_SUPPORTED_CMS_ATTRIBUTES    as SupportedCmsAttributesType,+    CKA_ALLOWED_MECHANISMS          as AllowedMechanismsType,++    CKA_VENDOR_DEFINED     as VendorDefinedType     } deriving (Show, Eq) #}  data Attribute = Class ClassType@@ -488,6 +618,7 @@     | ModulusBits Int     | Token Bool     | Decrypt Bool+    | Sign Bool     | Modulus Integer     | PublicExponent Integer     deriving (Show)@@ -584,6 +715,9 @@ _llAttrToAttr (LlAttribute DecryptType ptr len) = do     val <- peek (castPtr ptr :: Ptr {#type CK_BBOOL#})     return $ Decrypt(val /= 0)+_llAttrToAttr (LlAttribute SignType ptr len) = do+    val <- peek (castPtr ptr :: Ptr {#type CK_BBOOL#})+    return $ Sign(val /= 0)   -- High level API starts here@@ -598,6 +732,9 @@ data Session = Session SessionHandle FunctionListPtr  +-- | Load PKCS#11 dynamically linked library+--+-- > lib <- loadLibrary "/path/to/dll.so" loadLibrary :: String -> IO Library loadLibrary libraryPath = do     lib <- dlopen libraryPath []@@ -617,6 +754,7 @@     dlclose $ libraryHandle lib  +-- | Returns general information about Cryptoki getInfo :: Library -> IO Info getInfo (Library _ functionListPtr) = do     (rv, info) <- getInfo' functionListPtr@@ -625,6 +763,11 @@         else return info  +-- | Allows to obtain a list of slots in the system+--+-- > slotsIds <- getSlotList lib True 10+--+-- In this example retrieves list of, at most 10 (third parameter) slot identifiers with tokens present (second parameter is set to True) getSlotList :: Library -> Bool -> Int -> IO [SlotId] getSlotList (Library _ functionListPtr) active num = do     (rv, slots) <- getSlotList' functionListPtr active num@@ -633,6 +776,9 @@         else return $ map (fromIntegral) slots  +-- | Obtains information about a particular slot in the system+--+-- > slotInfo <- getSlotInfo lib slotId getSlotInfo :: Library -> SlotId -> IO SlotInfo getSlotInfo (Library _ functionListPtr) slotId = do     (rv, slotInfo) <- getSlotInfo' functionListPtr slotId@@ -641,6 +787,9 @@         else return slotInfo  +-- | Obtains information about a particular token in the system+--+-- > tokenInfo <- getTokenInfo lib slotId getTokenInfo :: Library -> SlotId -> IO TokenInfo getTokenInfo (Library _ functionListPtr) slotId = do     (rv, slotInfo) <- getTokenInfo' functionListPtr slotId@@ -713,6 +862,24 @@         else return (pubKeyHandle, privKeyHandle)  +_getAttr :: Session -> ObjectHandle -> AttributeType -> Ptr x -> IO ()+_getAttr (Session sessionHandle functionListPtr) objHandle attrType valPtr = do+    alloca $ \attrPtr -> do+        poke attrPtr (LlAttribute attrType (castPtr valPtr) (fromIntegral $ sizeOf valPtr))+        rv <- {#call unsafe CK_FUNCTION_LIST.C_GetAttributeValue#} functionListPtr sessionHandle objHandle attrPtr 1+        if rv /= 0+            then fail $ "failed to get attribute: " ++ (rvToStr rv)+            else return ()+++getBoolAttr :: Session -> ObjectHandle -> AttributeType -> IO Bool+getBoolAttr sess objHandle attrType = do+    alloca $ \valuePtr -> do+        _getAttr sess objHandle attrType (valuePtr :: Ptr CK_BBOOL)+        val <- peek valuePtr+        return $ toBool val++ getObjectAttr :: Session -> ObjectHandle -> AttributeType -> IO Attribute getObjectAttr (Session sessionHandle functionListPtr) objHandle attrType = do     alloca $ \attrPtr -> do@@ -729,10 +896,14 @@                     _llAttrToAttr llAttr  -getDecryptFlag :: Session -> ObjectHandle -> IO Bool-getDecryptFlag sess objHandle = do-    (Decrypt v) <- getObjectAttr sess objHandle DecryptType-    return v+getTokenFlag sess objHandle = getBoolAttr sess objHandle TokenType+getPrivateFlag sess objHandle = getBoolAttr sess objHandle PrivateType+getSensitiveFlag sess objHandle = getBoolAttr sess objHandle SensitiveType+getEncryptFlag sess objHandle = getBoolAttr sess objHandle EncryptType+getDecryptFlag sess objHandle = getBoolAttr sess objHandle DecryptType+getWrapFlag sess objHandle = getBoolAttr sess objHandle WrapType+getUnwrapFlag sess objHandle = getBoolAttr sess objHandle UnwrapType+getSignFlag sess objHandle = getBoolAttr sess objHandle SignType  getModulus :: Session -> ObjectHandle -> IO Integer getModulus sess objHandle = do@@ -1132,8 +1303,6 @@ decrypt mechType (Session sessionHandle functionListPtr) obj encData = do     _decryptInit mechType (Session sessionHandle functionListPtr) obj     unsafeUseAsCStringLen encData $ \(encDataPtr, encDataLen) -> do-        putStrLn $ "in data len " ++ (show encDataLen)-        putStrLn $ show encData         allocaBytes encDataLen $ \outDataPtr -> do             alloca $ \outDataLenPtr -> do                 poke outDataLenPtr (fromIntegral encDataLen)@@ -1188,6 +1357,7 @@                             return unwrappedKey  +-- | Obtains a list of mechanism types supported by a token getMechanismList :: Library -> SlotId -> Int -> IO [Int] getMechanismList (Library _ functionListPtr) slotId maxMechanisms = do     (rv, types) <- _getMechanismList functionListPtr slotId maxMechanisms@@ -1196,7 +1366,7 @@         else return $ map (fromIntegral) types  --- | Retrieves mechanism info+-- | Obtains information about a particular mechanism possibly supported by a token getMechanismInfo :: Library -> SlotId -> MechType -> IO MechInfo getMechanismInfo (Library _ functionListPtr) slotId mechId = do     (rv, types) <- _getMechanismInfo functionListPtr slotId (fromEnum mechId)

@@ -49,10 +49,18 @@         objects <- findObjects sess [Class PrivateKey, Label "key"]         putStrLn $ show objects         let objId = head objects+        getTokenFlag sess objId+        getPrivateFlag sess objId+        getSensitiveFlag sess objId+        --getEncryptFlag sess objId+        decryptFlag <- getDecryptFlag sess objId+        --getWrapFlag sess objId+        getUnwrapFlag sess objId+        signFlag <- getSignFlag sess objId         mod <- getModulus sess objId         pubExp <- getPublicExponent sess objId-        decryptFlag <- getDecryptFlag sess objId         putStrLn $ show decryptFlag+        putStrLn $ show signFlag         putStrLn $ showHex mod ""         putStrLn $ showHex pubExp ""         rng <- newGenIO :: IO SystemRandom@@ -78,3 +86,5 @@         decAes <- decrypt AesEcb sess unwrappedKeyHandle encryptedMessage         putStrLn $ show decAes         logout sess++    releaseLibrary lib

@@ -1,5 +1,5 @@ name:           hspkcs11-version:        0.2+version:        0.3 synopsis:       Wrapper for PKCS #11 interface description:    This package allows to call PKCS#11 provider libraries.  PKCS#11 is a C interface specification for cryptography providers, such as crypto tokens and HSMs homepage:       https://github.com/denisenkom/hspkcs11@@ -27,6 +27,7 @@     Default-language:  Haskell2010  executable pkcs11-tests+    build-tools:   c2hs     main-is:            Test.hs     Include-dirs: include     other-modules:      System.Crypto.Pkcs11