Skip to content
Browse files

Started YubiKey FFI

  • Loading branch information...
1 parent ab90ef9 commit 1dbac75cb5a36e066dc104057d9ba2833da9b6f7 @Detegr committed Feb 26, 2014
Showing with 88 additions and 7 deletions.
  1. +10 −3 src/TapiPass.hs
  2. +72 −0 src/YubiKey.hs
  3. +6 −4 tapiPass.cabal
View
13 src/TapiPass.hs
@@ -7,15 +7,22 @@ import Control.Monad.ST.Safe
import Data.Text
import Data.Maybe (fromMaybe)
import qualified Data.Text.IO as TIO
+import Control.Monad.Trans.Error (runErrorT)
-type TapiPassHT s = HT.HashTable s Text Text
+import YubiKey
+{-
hashTest :: ST s Text
hashTest = do
ht <- HT.new :: ST s (HT.HashTable s Text Text)
HT.insert ht "key" "val"
mb <- HT.lookup ht "key"
- return $ fromMaybe "nothing" mb
+ return $ fromMaybe "nothing" mb
+-}
main :: IO()
-main = TIO.putStrLn $ runST hashTest
+main = do
+ ok <- runErrorT $ withYubiKey $ \_ -> putStrLn "YubiKey found"
+ case ok of
+ Right _ -> putStrLn "YubiKey was found and function ran correcltly"
+ Left err -> putStrLn $ "Error: " ++ err
View
72 src/YubiKey.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module YubiKey(withYubiKey) where
+
+import Foreign.C.String
+import Foreign.C.Types
+import Foreign.Storable (peek)
+import Foreign.Ptr
+import Control.Monad.Trans.Error
+import Control.Monad.Trans.Class (lift)
+
+type YkKeyPtr = ()
+type YubiKey = Ptr YkKeyPtr
+
+data YubiKeyError = YK_EUSBERR | YK_NOERROR deriving Eq
+instance Enum YubiKeyError where
+ toEnum i = case i of
+ 1 -> YK_EUSBERR
+ _ -> YK_NOERROR
+ fromEnum YK_EUSBERR = 1
+
+foreign import ccall "yk_init" yk_init :: IO CInt
+foreign import ccall "yk_release" yk_release :: IO CInt
+
+foreign import ccall "yk_open_first_key" yk_open_first_key :: IO YubiKey
+foreign import ccall "yk_close_key" yk_close_key :: YubiKey -> IO CInt
+foreign import ccall "yk_check_firmware_version" yk_check_firmware_version :: YubiKey -> IO CInt
+
+foreign import ccall "_yk_errno_location" _yk_errno_location :: IO (Ptr CInt)
+foreign import ccall "yk_strerror" yk_strerror :: CInt -> IO CString
+foreign import ccall "yk_usb_strerror" yk_usb_strerror :: IO CString
+
+ykStrError :: IO String
+ykStrError = _yk_errno_location >>= peek >>= ykCheckError >>= peekCString
+
+ykCheckError :: CInt -> IO CString
+ykCheckError i
+ | toEnum (fromIntegral i) == YK_EUSBERR = yk_usb_strerror
+ | otherwise = yk_strerror i
+
+ykGetError :: a -> CInt -> ErrorT String IO a
+ykGetError _ 0 = lift ykStrError >>= fail
+ykGetError ret _ = return ret
+
+ykInit :: ErrorT String IO ()
+ykInit = lift yk_init >>= ykGetError ()
+
+ykOpenFirstKey :: ErrorT String IO YubiKey
+ykOpenFirstKey = do
+ key <- lift yk_open_first_key
+ if key == nullPtr
+ then ykGetError key 0
+ else return key
+
+ykCheckFirwareVersion :: YubiKey -> ErrorT String IO ()
+ykCheckFirwareVersion yk = lift (yk_check_firmware_version yk) >>= ykGetError ()
+
+ykCloseKey :: YubiKey -> ErrorT String IO ()
+ykCloseKey yk = lift (yk_close_key yk) >>= ykGetError ()
+
+ykRelease :: ErrorT String IO ()
+ykRelease = lift yk_release >>= ykGetError ()
+
+withYubiKey :: (YubiKey -> IO a) -> ErrorT String IO a
+withYubiKey f = do
+ ykInit
+ yk <- ykOpenFirstKey
+ ykCheckFirwareVersion yk
+ val <- lift $ f yk
+ ykCloseKey yk
+ ykRelease
+ return val
View
10 tapiPass.cabal
@@ -3,7 +3,7 @@
name: tapiPass
version: 0.1.0.0
-synopsis: Password manager in Haskell supporting Yubikey in challenge-response mode
+synopsis: Password manager in Haskell supporting YubiKey in challenge-response mode
-- description:
homepage: http://tapiiri.in
license: MIT
@@ -17,9 +17,11 @@ build-type: Simple
cabal-version: >=1.10
executable tapiPass
- main-is: src/TapiPass.hs
- -- other-modules:
+ main-is: TapiPass.hs
+ other-modules: YubiKey
-- other-extensions:
build-depends: base >=4.5 && <4.6, hashtables >= 1.1.2.1, text, transformers, hashable
- -- hs-source-dirs:
+ hs-source-dirs: src
default-language: Haskell2010
+ extra-libraries: ykpers-1
+ extra-lib-dirs: yubikey-personalization/.libs

0 comments on commit 1dbac75

Please sign in to comment.
Something went wrong with that request. Please try again.