This repository has been archived by the owner on Jan 18, 2020. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 55
/
ASN1.hsc
166 lines (119 loc) · 4.48 KB
/
ASN1.hsc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
{- -*- haskell -*- -}
-- #hide
#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 Control.Monad
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 Int
foreign import ccall unsafe "OBJ_nid2sn"
_nid2sn :: Int -> IO CString
foreign import ccall unsafe "OBJ_nid2ln"
_nid2ln :: Int -> IO CString
nid2sn :: Int -> IO String
nid2sn nid = _nid2sn nid >>= peekCString
nid2ln :: Int -> 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
peekCStringLen (buf, 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 -> BigNum -> IO BigNum
foreign import ccall unsafe "BN_to_ASN1_INTEGER"
_BN_to_ASN1_INTEGER :: BigNum -> Ptr ASN1_INTEGER -> IO (Ptr ASN1_INTEGER)
peekASN1Integer :: Ptr ASN1_INTEGER -> IO Integer
peekASN1Integer intPtr
= allocaBN $ \ bn ->
do _ASN1_INTEGER_to_BN intPtr bn
>>= failIfNull
peekBN bn
allocaASN1Integer :: (Ptr ASN1_INTEGER -> IO a) -> IO a
allocaASN1Integer m
= bracket _ASN1_INTEGER_new _ASN1_INTEGER_free m
withASN1Integer :: Integer -> (Ptr ASN1_INTEGER -> IO a) -> IO a
withASN1Integer int m
= withBN int $ \ bn ->
allocaASN1Integer $ \ intPtr ->
do _BN_to_ASN1_INTEGER 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 Int
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 m
= bracket _ASN1_TIME_new _ASN1_TIME_free m
withASN1Time :: UTCTime -> (Ptr ASN1_TIME -> IO a) -> IO a
withASN1Time utc m
= allocaASN1Time $ \ time ->
do _ASN1_TIME_set time (fromIntegral $ round $ utcTimeToPOSIXSeconds utc)
>>= failIfNull
m time