Wolfgang Jeltsch pushed to branch wip/jeltsch/obtaining-os-handles at Glasgow Haskell Compiler / GHC

Commits:

1 changed file:

Changes:

  • libraries/base/src/GHC/IO/Handle.hs
    1 1
     {-# LANGUAGE Safe #-}
    
    2
    +{-# LANGUAGE CPP #-}
    
    3
    +{-# LANGUAGE RankNTypes #-}
    
    2 4
     
    
    3 5
     -- |
    
    4 6
     --
    
    ... ... @@ -14,7 +16,8 @@
    14 16
     --
    
    15 17
     
    
    16 18
     module GHC.IO.Handle
    
    17
    -    (Handle,
    
    19
    +    (-- * Portable operations
    
    20
    +     Handle,
    
    18 21
          BufferMode(..),
    
    19 22
          mkFileHandle,
    
    20 23
          mkDuplexHandle,
    
    ... ... @@ -70,7 +73,239 @@ module GHC.IO.Handle
    70 73
          hGetBuf,
    
    71 74
          hGetBufNonBlocking,
    
    72 75
          hPutBuf,
    
    73
    -     hPutBufNonBlocking
    
    74
    -     ) where
    
    76
    +     hPutBufNonBlocking,
    
    77
    +
    
    78
    +     -- * Obtaining file descriptors and Windows handles
    
    79
    +     withReadingFileDescriptor,
    
    80
    +     withWritingFileDescriptor,
    
    81
    +     withReadingWindowsHandle,
    
    82
    +     withWritingWindowsHandle
    
    83
    +
    
    84
    +     -- ** Caveats
    
    85
    +     -- $with-ref-caveats
    
    86
    +) where
    
    75 87
     
    
    76 88
     import GHC.Internal.IO.Handle
    
    89
    +
    
    90
    +import GHC.Internal.Control.Monad (return)
    
    91
    +import GHC.Internal.Control.Exception (mask)
    
    92
    +import GHC.Internal.Data.Function (const, (.), ($))
    
    93
    +import GHC.Internal.Data.Functor (fmap)
    
    94
    +import GHC.Internal.Data.Maybe (Maybe (Nothing), maybe)
    
    95
    +#if defined(mingw32_HOST_OS)
    
    96
    +import GHC.Internal.Data.Maybe (Maybe (Just))
    
    97
    +#endif
    
    98
    +import GHC.Internal.Data.List ((++))
    
    99
    +import GHC.Internal.Data.String (String)
    
    100
    +import GHC.Internal.Data.Typeable (Typeable, cast)
    
    101
    +import GHC.Internal.System.IO (IO)
    
    102
    +import GHC.Internal.IO.FD (fdFD)
    
    103
    +#if defined(mingw32_HOST_OS)
    
    104
    +import GHC.Internal.IO.Windows.Handle
    
    105
    +       (
    
    106
    +           NativeHandle,
    
    107
    +           ConsoleHandle,
    
    108
    +           IoHandle,
    
    109
    +           toHANDLE
    
    110
    +       )
    
    111
    +#endif
    
    112
    +import GHC.Internal.IO.Handle.Types (Handle__)
    
    113
    +import GHC.Internal.IO.Handle.Internals
    
    114
    +       (
    
    115
    +           wantReadableHandle_,
    
    116
    +           wantWritableHandle,
    
    117
    +           flushBuffer
    
    118
    +       )
    
    119
    +import GHC.Internal.IO.Exception
    
    120
    +       (
    
    121
    +           IOErrorType (IllegalOperation),
    
    122
    +           IOException (IOError),
    
    123
    +           ioException
    
    124
    +       )
    
    125
    +import GHC.Internal.Foreign.Ptr (Ptr)
    
    126
    +import GHC.Internal.Foreign.C.Types (CInt)
    
    127
    +
    
    128
    +-- * Obtaining file descriptors and Windows handles
    
    129
    +
    
    130
    +{-|
    
    131
    +    Obtains from a handle an underlying operating-system reference for reading
    
    132
    +    or writing and executes a user-provided action on it. The Haskell-side
    
    133
    +    buffers of the handle are flushed before this action is run. While this
    
    134
    +    action is executed, further operations on the handle are blocked to a degree
    
    135
    +    that interference with this action is prevented.
    
    136
    +
    
    137
    +    See [below](#with-ref-caveats) for caveats regarding this operation.
    
    138
    +-}
    
    139
    +withRef :: (Handle -> (Handle__ -> IO a) -> IO a)
    
    140
    +           -- ^ Obtaining of an appropriately prepared handle side from a handle
    
    141
    +        -> (forall d. Typeable d => d -> IO r)
    
    142
    +           -- ^ Conversion of a device into an operating-system reference
    
    143
    +        -> Handle
    
    144
    +           -- ^ The handle to use
    
    145
    +        -> (r -> IO a)
    
    146
    +           -- ^ The action to execute on the operating-system reference
    
    147
    +        -> IO a
    
    148
    +withRef withHandleSide getRef handle act
    
    149
    +    = mask $ \ withOriginalMaskingState ->
    
    150
    +      withHandleSide handle $ \ handleSide -> do
    
    151
    +          ref <- getRef handleSide
    
    152
    +          flushBuffer handleSide
    
    153
    +          withOriginalMaskingState $ act ref
    
    154
    +{-
    
    155
    +    The public operations that use 'withRef' provide 'withHandleSide' arguments
    
    156
    +    that perform masking. Still, we have to use 'mask' here, in order do obtain
    
    157
    +    the operation that restores the original masking state. The user-provided
    
    158
    +    action should be executed with this original masking state, as there is no
    
    159
    +    inherent reason to generally perform it with masking in place. The masking
    
    160
    +    that the 'withHandleSide' arguments perform is only for safely accessing
    
    161
    +    internal handle data and thus constitutes an implementation detail; it has
    
    162
    +    nothing to do with the user-provided action.
    
    163
    +-}
    
    164
    +{-
    
    165
    +    The order of actions in 'withRef' is such that any exception from 'getRef'
    
    166
    +    is thrown before the flushing of the Haskell-side buffers.
    
    167
    +-}
    
    168
    +
    
    169
    +{-|
    
    170
    +    Yields the result of another operation if that operation succeeded, and
    
    171
    +    otherwise throws an exception that signals that the other operation failed
    
    172
    +    because a certain I/O subsystem is not in use.
    
    173
    +-}
    
    174
    +requiringSubsystem :: String
    
    175
    +                      -- ^ The name of the required subsystem
    
    176
    +                   -> Maybe a
    
    177
    +                      -- ^ The result of the other operation if it succeeded
    
    178
    +                   -> IO a
    
    179
    +requiringSubsystem subsystemName
    
    180
    +    = maybe (ioException subsystemRequired) return
    
    181
    +    where
    
    182
    +
    
    183
    +    subsystemRequired :: IOException
    
    184
    +    subsystemRequired = IOError Nothing
    
    185
    +                                IllegalOperation
    
    186
    +                                ""
    
    187
    +                                (subsystemName ++ " I/O subsystem required")
    
    188
    +                                Nothing
    
    189
    +                                Nothing
    
    190
    +
    
    191
    +{-|
    
    192
    +    Obtains the POSIX file descriptor of a device if the POSIX I/O subsystem is
    
    193
    +    in use, and throws an exception otherwise.
    
    194
    +-}
    
    195
    +getFileDescriptor :: Typeable d => d -> IO CInt
    
    196
    +getFileDescriptor = requiringSubsystem "POSIX" . fmap fdFD . cast
    
    197
    +
    
    198
    +{-|
    
    199
    +    Obtains the Windows handle of a device if the Windows I/O subsystem is in
    
    200
    +    use, and throws an exception otherwise.
    
    201
    +-}
    
    202
    +getWindowsHandle :: Typeable d => d -> IO (Ptr ())
    
    203
    +getWindowsHandle = requiringSubsystem "native" . toMaybeWindowsHandle where
    
    204
    +
    
    205
    +    toMaybeWindowsHandle :: Typeable d => d -> Maybe (Ptr ())
    
    206
    +#if defined(mingw32_HOST_OS)
    
    207
    +    toMaybeWindowsHandle dev
    
    208
    +        | Just nativeHandle <- cast dev :: Maybe (IoHandle NativeHandle)
    
    209
    +            = Just (toHANDLE nativeHandle)
    
    210
    +        | Just consoleHandle <- cast dev :: Maybe (IoHandle ConsoleHandle)
    
    211
    +            = Just (toHANDLE consoleHandle)
    
    212
    +        | otherwise
    
    213
    +            = Nothing
    
    214
    +    {-
    
    215
    +        This is inspired by the implementation of
    
    216
    +        'System.Win32.Types.withHandleToHANDLENative'.
    
    217
    +    -}
    
    218
    +#else
    
    219
    +    toMaybeWindowsHandle = const Nothing
    
    220
    +#endif
    
    221
    +
    
    222
    +{-|
    
    223
    +    Obtains from a handle a POSIX file descriptor for reading and executes a
    
    224
    +    user-provided action on it. The Haskell-side buffers of the handle are
    
    225
    +    flushed before this action is run. While this action is executed, further
    
    226
    +    operations on the handle are blocked to a degree that interference with this
    
    227
    +    action is prevented.
    
    228
    +
    
    229
    +    If the I/O subsystem in use is not the POSIX one, an exception is thrown.
    
    230
    +
    
    231
    +    See [below](#with-ref-caveats) for caveats regarding this operation.
    
    232
    +-}
    
    233
    +withReadingFileDescriptor :: Handle -> (CInt -> IO a) -> IO a
    
    234
    +withReadingFileDescriptor
    
    235
    +    = withRef (wantReadableHandle_ "withReadingFileDescriptor")
    
    236
    +              getFileDescriptor
    
    237
    +
    
    238
    +{-|
    
    239
    +    Obtains from a handle a POSIX file descriptor for writing and executes a
    
    240
    +    user-provided action on it. The Haskell-side buffers of the handle are
    
    241
    +    flushed before this action is run. While this action is executed, further
    
    242
    +    operations on the handle are blocked to a degree that interference with this
    
    243
    +    action is prevented.
    
    244
    +
    
    245
    +    If the I/O subsystem in use is not the POSIX one, an exception is thrown.
    
    246
    +
    
    247
    +    See [below](#with-ref-caveats) for caveats regarding this operation.
    
    248
    +-}
    
    249
    +withWritingFileDescriptor :: Handle -> (CInt -> IO a) -> IO a
    
    250
    +withWritingFileDescriptor
    
    251
    +    = withRef (wantWritableHandle "withWritingFileDescriptor")
    
    252
    +              getFileDescriptor
    
    253
    +
    
    254
    +{-|
    
    255
    +    Obtains from a Haskell handle a Windows handle for reading and executes a
    
    256
    +    user-provided action on it. The Haskell-side buffers of the Haskell handle
    
    257
    +    are flushed before this action is run. While this action is executed,
    
    258
    +    further operations on the handle are blocked to a degree that interference
    
    259
    +    with this action is prevented.
    
    260
    +
    
    261
    +    If the I/O subsystem in use is not the Windows one, an exception is thrown.
    
    262
    +
    
    263
    +    See [below](#with-ref-caveats) for caveats regarding this operation.
    
    264
    +-}
    
    265
    +withReadingWindowsHandle :: Handle -> (Ptr () -> IO a) -> IO a
    
    266
    +withReadingWindowsHandle
    
    267
    +    = withRef (wantReadableHandle_ "withReadingWindowsHandle")
    
    268
    +              getWindowsHandle
    
    269
    +
    
    270
    +{-|
    
    271
    +    Obtains from a Haskell handle a Windows handle for writing and executes a
    
    272
    +    user-provided action on it. The Haskell-side buffers of the Haskell handle
    
    273
    +    are flushed before this action is run. While this action is executed,
    
    274
    +    further operations on the handle are blocked to a degree that interference
    
    275
    +    with this action is prevented.
    
    276
    +
    
    277
    +    If the I/O subsystem in use is not the Windows one, an exception is thrown.
    
    278
    +
    
    279
    +    See [below](#with-ref-caveats) for caveats regarding this operation.
    
    280
    +-}
    
    281
    +withWritingWindowsHandle :: Handle -> (Ptr () -> IO a) -> IO a
    
    282
    +withWritingWindowsHandle
    
    283
    +    = withRef (wantWritableHandle "withWritingWindowsHandle")
    
    284
    +              getWindowsHandle
    
    285
    +
    
    286
    +-- ** Caveats
    
    287
    +
    
    288
    +{-$with-ref-caveats
    
    289
    +    #with-ref-caveats#There are the following caveats regarding each of the
    
    290
    +    above operations:
    
    291
    +
    
    292
    +      * The flushing of buffers can fail if the given handle is readable but not
    
    293
    +        seekable.
    
    294
    +
    
    295
    +      * If the operation is performed as part of an action executed by
    
    296
    +        'unsafePerformIO', 'unsafeInterleaveIO', or one of their “dupable”
    
    297
    +        variants and the user-provided action receives an asychnchronous
    
    298
    +        exception and does not catch it, then the following happens:
    
    299
    +
    
    300
    +          - Before the overall computation is suspended, the blocking of handle
    
    301
    +            operations is removed.
    
    302
    +
    
    303
    +          - When the computation is later resumed due to another evaluation
    
    304
    +            attempt, the blocking of handle operations is reinstantiated, the
    
    305
    +            Haskell-side buffers are flushed again, and the user-provided action
    
    306
    +            is run from the beginning.
    
    307
    +
    
    308
    +        Repeating the previously executed part of the user-provided action
    
    309
    +        cannot be avoided apparently. See the @[async]@ note in the source code
    
    310
    +        of "GHC.Internal.IO.Handle.Internals" for further explanation.
    
    311
    +-}