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
|
{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, CPP #-}
--------------------------------------------------------------------
-- |
-- Module : Network.Curl.Types
-- Copyright : (c) Galois Inc 2007-2009
-- License : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@galois.com>
-- Stability : provisional
-- Portability: portable
--
-- Basic set of types for the Haskell curl binding, including the
-- @Curl@ handle type which holds the C library stateful connection
-- handle along with a set of cleanup actions tht should be performed
-- upon shutting down the curl session.
--
--------------------------------------------------------------------
module Network.Curl.Types
( CurlH, URLString, Port, Long, LLong, Slist_
, Curl, curlPrim, mkCurl, mkCurlWithCleanup
, OptionMap, shareCleanup, runCleanup, updateCleanup
) where
import Network.Curl.Debug
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Concurrent ( addForeignPtrFinalizer )
import Data.Word
import Control.Concurrent
import Data.Maybe(fromMaybe)
import qualified Data.IntMap as M
import Data.IORef
-- import System.IO
data Curl_
type CurlH = Ptr Curl_
type URLString = String
type Port = Long
type Long = Word32
type LLong = Word64
data Slist_
data Curl = Curl
{ curlH :: MVar (ForeignPtr Curl_) -- libcurl is not thread-safe.
, curlCleanup :: IORef OptionMap -- deallocate Haskell curl data
}
-- | Execute a "primitve" curl operation.
-- NOTE: See warnings about the use of 'withForeginPtr'.
curlPrim :: Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
curlPrim c f = withMVar (curlH c) $ \ h ->
withForeignPtr h $ f $ curlCleanup c
-- | Allocates a Haskell handle from a C handle.
mkCurl :: CurlH -> IO Curl
mkCurl h = mkCurlWithCleanup h om_empty
-- | Allocates a Haskell handle from a C handle.
mkCurlWithCleanup :: CurlH -> OptionMap -> IO Curl
mkCurlWithCleanup h clean = do
debug "ALLOC: CURL"
v2 <- newIORef clean
fh <- newForeignPtr_ h
v1 <- newMVar fh
let new_h = Curl { curlH = v1, curlCleanup = v2 }
let fnalizr = do
debug "FREE: CURL"
easy_cleanup h
runCleanup v2
Foreign.Concurrent.addForeignPtrFinalizer fh fnalizr
return new_h
-- Admin code for cleaning up marshalled data.
-- Note that these functions assume that they are running atomically,
-- so access to them should be protected by a lock.
--------------------------------------------------------------------------------
runCleanup :: IORef OptionMap -> IO ()
runCleanup r = do m <- readIORef r
om_cleanup m
writeIORef r om_empty
shareCleanup :: IORef OptionMap -> IO OptionMap
shareCleanup r = do old <- readIORef r
new <- om_dup old
writeIORef r new
return new
updateCleanup :: IORef OptionMap -> Int -> IO () -> IO ()
updateCleanup r option act = writeIORef r =<< om_set option act =<< readIORef r
-- Maps that associate curl options with IO actions to
-- perform cleanup for them.
--------------------------------------------------------------------------------
type OptionMap = M.IntMap (IO ())
-- | An empty option map.
om_empty :: OptionMap
om_empty = M.empty
-- | Set the IO action for an option,
-- executing the previvous action, if there was one.
om_set :: Int -> IO () -> OptionMap -> IO OptionMap
om_set opt new_act old_map =
do fromMaybe (return ()) old_act
return new_map
where
(old_act,new_map) = M.insertLookupWithKey (\_ a _ -> a) opt new_act old_map
-- | Execute all IO actions in the map.
om_cleanup :: OptionMap -> IO ()
om_cleanup m = sequence_ (M.elems m)
-- | Replace the actions in a map, with actions that
-- will only be executed the second time they are invoked.
om_dup :: OptionMap -> IO OptionMap
om_dup old_map = M.fromList `fmap` mapM dup (M.assocs old_map)
where dup (x,old_io) = do new_io <- shareIO old_io
return (x,new_io)
-- Share a cleanup action. When we share cleanup duty between two handles
-- we need to ensure that the first handle to perform the cleanup will do
-- nothing (because the other handle still needs the resources).
shareIO :: IO () -> IO (IO ())
shareIO act =
do v <- newMVar False
let new_act = do b <- takeMVar v
if b then act else putMVar v True
return new_act
--------------------------------------------------------------------------------
{- UNUSED:
-- FFI for inalizers.
-- | Make a finalizer from an IO action.
mkIOfin :: IO a -> IO (FinalizerPtr b)
mkIOfin m = mfix (\ptr -> ioFinalizer (m >> freeHaskellFunPtr ptr))
foreign import ccall "wrapper"
ioFinalizer :: IO () -> IO (FinalizerPtr a)
-}
foreign import ccall
"curl/curl.h curl_easy_cleanup" easy_cleanup :: CurlH -> IO ()
|
