Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
161 lines (116 sloc) 4.49 KB
#include "HsOpenSSL.h"
module OpenSSL.ASN1
( ASN1_OBJECT
, obj2nid
, nid2sn
, nid2ln
, ASN1_STRING
, peekASN1String
, ASN1_INTEGER
, peekASN1Integer
, withASN1Integer
, ASN1_TIME
, peekASN1Time
, withASN1Time
)
where
import Control.Exception
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Data.Time.Format
import Foreign
import Foreign.C
import OpenSSL.BIO
import OpenSSL.BN
import OpenSSL.Utils
import System.Locale
{- ASN1_OBJECT --------------------------------------------------------------- -}
data ASN1_OBJECT
foreign import ccall unsafe "OBJ_obj2nid"
obj2nid :: Ptr ASN1_OBJECT -> IO CInt
foreign import ccall unsafe "OBJ_nid2sn"
_nid2sn :: CInt -> IO CString
foreign import ccall unsafe "OBJ_nid2ln"
_nid2ln :: CInt -> IO CString
nid2sn :: CInt -> IO String
nid2sn nid = _nid2sn nid >>= peekCString
nid2ln :: CInt -> IO String
nid2ln nid = _nid2ln nid >>= peekCString
{- ASN1_STRING --------------------------------------------------------------- -}
data ASN1_STRING
peekASN1String :: Ptr ASN1_STRING -> IO String
peekASN1String strPtr
= do buf <- (#peek ASN1_STRING, data ) strPtr
len <- (#peek ASN1_STRING, length) strPtr :: IO CInt
peekCStringLen (buf, fromIntegral len)
{- ASN1_INTEGER -------------------------------------------------------------- -}
data ASN1_INTEGER
foreign import ccall unsafe "HsOpenSSL_M_ASN1_INTEGER_new"
_ASN1_INTEGER_new :: IO (Ptr ASN1_INTEGER)
foreign import ccall unsafe "HsOpenSSL_M_ASN1_INTEGER_free"
_ASN1_INTEGER_free :: Ptr ASN1_INTEGER -> IO ()
foreign import ccall unsafe "ASN1_INTEGER_to_BN"
_ASN1_INTEGER_to_BN :: Ptr ASN1_INTEGER -> Ptr BIGNUM -> IO (Ptr BIGNUM)
foreign import ccall unsafe "BN_to_ASN1_INTEGER"
_BN_to_ASN1_INTEGER :: Ptr BIGNUM -> Ptr ASN1_INTEGER -> IO (Ptr ASN1_INTEGER)
peekASN1Integer :: Ptr ASN1_INTEGER -> IO Integer
peekASN1Integer intPtr
= allocaBN $ \ bn ->
do _ASN1_INTEGER_to_BN intPtr (unwrapBN bn)
>>= failIfNull_
peekBN bn
allocaASN1Integer :: (Ptr ASN1_INTEGER -> IO a) -> IO a
allocaASN1Integer
= bracket _ASN1_INTEGER_new _ASN1_INTEGER_free
withASN1Integer :: Integer -> (Ptr ASN1_INTEGER -> IO a) -> IO a
withASN1Integer int m
= withBN int $ \ bn ->
allocaASN1Integer $ \ intPtr ->
do _BN_to_ASN1_INTEGER (unwrapBN bn) intPtr
>>= failIfNull_
m intPtr
{- ASN1_TIME ---------------------------------------------------------------- -}
data ASN1_TIME
foreign import ccall unsafe "HsOpenSSL_M_ASN1_TIME_new"
_ASN1_TIME_new :: IO (Ptr ASN1_TIME)
foreign import ccall unsafe "HsOpenSSL_M_ASN1_TIME_free"
_ASN1_TIME_free :: Ptr ASN1_TIME -> IO ()
foreign import ccall unsafe "ASN1_TIME_set"
_ASN1_TIME_set :: Ptr ASN1_TIME -> CTime -> IO (Ptr ASN1_TIME)
foreign import ccall unsafe "ASN1_TIME_print"
_ASN1_TIME_print :: Ptr BIO_ -> Ptr ASN1_TIME -> IO CInt
peekASN1Time :: Ptr ASN1_TIME -> IO UTCTime -- asn1/t_x509.c
peekASN1Time time
= do bio <- newMem
withBioPtr bio $ \ bioPtr ->
_ASN1_TIME_print bioPtr time
>>= failIf_ (/= 1)
timeStr <- bioRead bio
case parseTime locale "%b %e %H:%M:%S %Y %Z" timeStr of
Just utc -> return utc
Nothing -> fail ("peekASN1Time: failed to parse time string: " ++ timeStr)
where
locale :: TimeLocale
locale = TimeLocale {
wDays = undefined
, months = [ (undefined, x)
| x <- [ "Jan", "Feb", "Mar", "Apr", "May", "Jun"
, "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
]
]
, intervals = undefined
, amPm = undefined
, dateTimeFmt = undefined
, dateFmt = undefined
, timeFmt = undefined
, time12Fmt = undefined
}
allocaASN1Time :: (Ptr ASN1_TIME -> IO a) -> IO a
allocaASN1Time
= bracket _ASN1_TIME_new _ASN1_TIME_free
withASN1Time :: UTCTime -> (Ptr ASN1_TIME -> IO a) -> IO a
withASN1Time utc m
= allocaASN1Time $ \ time ->
do _ASN1_TIME_set time (fromIntegral (round $ utcTimeToPOSIXSeconds utc :: Integer))
>>= failIfNull_
m time
Jump to Line
Something went wrong with that request. Please try again.