diff --git a/System/Crypto/Pkcs11.chs b/System/Crypto/Pkcs11.chs --- a/System/Crypto/Pkcs11.chs +++ b/System/Crypto/Pkcs11.chs @@ -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) diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -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 diff --git a/hspkcs11.cabal b/hspkcs11.cabal --- a/hspkcs11.cabal +++ b/hspkcs11.cabal @@ -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