lio-0.9.1.0: Labeled IO Information Flow Control Library

Safe HaskellTrustworthy

LIO.Handle

Contents

Description

This module abstracts the basic file Handle methods provided by the system library, and provides a LabeledHandle type that can be manipulated from within the LIO Monad. A LabeledHandle is imply a file Handle with an associated label that is used to track and control the information flowing from and to the file. The API exposed by this module is analogous to System.IO, and the functions mainly differ in taking an additional label and enforcing IFC.

The actual storage of labeled files is handled by the LIO.FS module. The filesystem is implemented as a file store in which labels are associated with files and directories (using extended attributes).

IMPORTANT: To use the labeled filesystem you must use evalWithRootFS (or other initializers from LIO.FS.TCB), otherwise any actions built using the combinators of this module will crash.

An example use case shown below:

  main = dcEvalWithRoot "/tmp/lioFS" $ do
    createDirectoryP p lsecrets "secrets"
    writeFileP p ("secrets" </> "alice" ) "I like Bob!"
      where p = ...
            lsecrets = ....

The file store for the labeled filesystem (see LIO.FS) will be created in /tmp/lioFS, but this is transparent and the user can think of the filesystem as having root /. Note that for this to work the filesystem must be mounted with the user_xattr option. For example, on GNU/Linux:

 mount -o rw,noauto,user,sync,noexec,user_xattr /dev/sdb1 /tmp/lioFS

In the current version of the filesystem, there is no notion of changeable current working directory in the LIO Monad, nor symbolic links.

Synopsis

Documentation

evalWithRootFSSource

Arguments

:: SLabel l 
=> FilePath

Filesystem root

-> Maybe l

Label of root

-> LIO l a

LIO action

-> LIOState l

Initial state

-> IO a 

Same as evalLIO, but takes two additional parameters corresponding to the path of the labeled filesystem store and the label of the root. If the labeled filesystem store does not exist, it is created at the specified path with the root having the supplied label. If the filesystem does exist, the supplied label is ignored and thus unnecessary. However, if the root label is not provided and the filesystem has not been initialized, a FSRootNeedLabel exception will be thrown.

type SLabel l = (Label l, Serialize l)Source

Constraintfor serializable labels

type SMonadLIO l m = (SLabel l, MonadLIO l m)Source

Serialize MonadLIO

LIO Handle

data Handle

Haskell defines operations to read and write characters from and to files, represented by values of type Handle. Each value of this type is a handle: a record used by the Haskell run-time system to manage I/O with file system objects. A handle has at least the following properties:

  • whether it manages input or output or both;
  • whether it is open, closed or semi-closed;
  • whether the object is seekable;
  • whether buffering is disabled, or enabled on a line or block basis;
  • a buffer (whose length may be zero).

Most handles will also have a current I/O position indicating where the next input or output operation will occur. A handle is readable if it manages only input or both input and output; likewise, it is writable if it manages only output or both input and output. A handle is open when first allocated. Once it is closed it can no longer be used for either input or output, though an implementation cannot re-use its storage while references remain to it. Handles are in the Show and Eq classes. The string produced by showing a handle is system dependent; it should include enough information to identify the handle for debugging. A handle is equal according to == only to itself; no attempt is made to compare the internal state of different handles for equality.

data BufferMode

Three kinds of buffering are supported: line-buffering, block-buffering or no-buffering. These modes have the following effects. For output, items are written out, or flushed, from the internal buffer according to the buffer mode:

  • line-buffering: the entire output buffer is flushed whenever a newline is output, the buffer overflows, a hFlush is issued, or the handle is closed.
  • block-buffering: the entire buffer is written out whenever it overflows, a hFlush is issued, or the handle is closed.
  • no-buffering: output is written immediately, and never stored in the buffer.

An implementation is free to flush the buffer more frequently, but not less frequently, than specified above. The output buffer is emptied as soon as it has been written out.

Similarly, input occurs according to the buffer mode for the handle:

  • line-buffering: when the buffer for the handle is not empty, the next item is obtained from the buffer; otherwise, when the buffer is empty, characters up to and including the next newline character are read into the buffer. No characters are available until the newline character is available or the buffer is full.
  • block-buffering: when the buffer for the handle becomes empty, the next block of data is read into the buffer.
  • no-buffering: the next input item is read and returned. The hLookAhead operation implies that even a no-buffered handle may require a one-character buffer.

The default buffering mode when a handle is opened is implementation-dependent and may depend on the file system object which is attached to that handle. For most implementations, physical files will normally be block-buffered and terminals will normally be line-buffered.

Constructors

NoBuffering

buffering is disabled if possible.

LineBuffering

line-buffering should be enabled if possible.

BlockBuffering (Maybe Int)

block-buffering should be enabled if possible. The size of the buffer is n items if the argument is Just n and is otherwise implementation-dependent.

File operations

openFileSource

Arguments

:: SMonadLIO l m 
=> Maybe l

Label of file if created

-> FilePath

File to open

-> IOMode

Mode

-> m (LabeledHandle l) 

Given a set of privileges, a (maybe) new label of a file, a filepath, and the IO mode, open (and possibly create) the file. If the file exists, the supplied label is not necessary; otherwise it must be supplied. The current label is raised to reflect all the traversed directories. Additionally the label of the file (new or existing) must be between the current label and clearance, as imposed by guardAlloc. If the file is created, it is further required that the current computation be able to write to the containing directory, as imposed by guardWrite.

openFilePSource

Arguments

:: (SMonadLIO l m, Priv l p) 
=> p

Privileges

-> Maybe l

Label of file if created

-> FilePath

File to open

-> IOMode

Mode

-> m (LabeledHandle l) 

Same as openFile, but uses privileges when traversing directories and performing IFC checks.

hClose :: SMonadLIO l m => LabeledHandle l -> m ()Source

Close a file handle. Must be able to write to the the labeled handle, as checkd by guardWrite.

hCloseP :: (SMonadLIO l m, Priv l p) => p -> LabeledHandle l -> m ()Source

Close a labeled file handle.

hFlush :: SMonadLIO l m => LabeledHandle l -> m ()Source

Flush a file handle. Must be able to write to the the labeled handle, as checkd by guardWrite.

hFlushP :: (SMonadLIO l m, Priv l p) => p -> LabeledHandle l -> m ()Source

Flush a labeled file handle.

class Monad m => HandleOps h b m whereSource

Class used to abstract reading and writing from and to handles, respectively.

Methods

hGet :: h -> Int -> m bSource

hGetNonBlocking :: h -> Int -> m bSource

hGetContents :: h -> m bSource

hGetLine :: h -> m bSource

hPut :: h -> b -> m ()Source

hPutStr :: h -> b -> m ()Source

hPutStrLn :: h -> b -> m ()Source

hGetPSource

Arguments

:: (Priv l p, Serialize l, HandleOps Handle b IO) 
=> p

Privileges

-> LabeledHandle l

Labeled handle

-> Int

Number of bytes to read

-> LIO l b 

Read n bytes from the labeled handle, using privileges when performing label comparisons and tainting.

hGetNonBlockingP :: (Priv l p, Serialize l, HandleOps Handle b IO) => p -> LabeledHandle l -> Int -> LIO l bSource

Same as hGetP, but will not block waiting for data to become available. Instead, it returns whatever data is available. Privileges are used in the label comparisons and when raising the current label.

hGetContentsP :: (Priv l p, Serialize l, HandleOps Handle b IO) => p -> LabeledHandle l -> LIO l bSource

Read the entire labeled handle contents and close handle upon reading EOF. Privileges are used in the label comparisons and when raising the current label.

hGetLineP :: (Priv l p, Serialize l, HandleOps Handle b IO) => p -> LabeledHandle l -> LIO l bSource

Read the a line from a labeled handle.

hPutP :: (Priv l p, Serialize l, HandleOps Handle b IO) => p -> LabeledHandle l -> b -> LIO l ()Source

Output the given (Byte)String to the specified labeled handle. Privileges are used in the label comparisons and when raising the current label.

hPutStrP :: (Priv l p, Serialize l, HandleOps Handle b IO) => p -> LabeledHandle l -> b -> LIO l ()Source

Synonym for hPutP.

hPutStrLnP :: (Priv l p, Serialize l, HandleOps Handle b IO) => p -> LabeledHandle l -> b -> LIO l ()Source

Output the given (Byte)String with an appended newline to the specified labeled handle. Privileges are used in the label comparisons and when raising the current label.

Special cases

readFile :: (HandleOps Handle b IO, SLabel l) => FilePath -> LIO l bSource

Reads a file and returns the contents of the file as a ByteString.

readFileP :: (HandleOps Handle b IO, Priv l p, Serialize l) => p -> FilePath -> LIO l bSource

Same as readFile but uses privilege in opening the file.

writeFile :: (HandleOps Handle b IO, SLabel l) => l -> FilePath -> b -> LIO l ()Source

Write a ByteString to the given filepath with the supplied label.

writeFileP :: (HandleOps Handle b IO, Priv l p, Serialize l) => p -> l -> FilePath -> b -> LIO l ()Source

Same as writeFile but uses privilege when opening, writing and closing the file.

Directory operations

getDirectoryContents :: SMonadLIO l m => FilePath -> m [FilePath]Source

Get the contents of a directory. The current label is raised to the join of the current label and that of all the directories traversed to the leaf directory. Note that, unlike the standard Haskell getDirectoryContents, we first normalise the path by collapsing all the ..'s. The function uses unlabelFilePath when raising the current label and thus may throw an exception if the clearance is too low. Note: The current LIO filesystem does not support links.

getDirectoryContentsPSource

Arguments

:: (SMonadLIO l m, Priv l p) 
=> p

Privilege

-> FilePath

Directory

-> m [FilePath] 

Same as getDirectoryContents, but uses privileges when raising the current label.

createDirectory :: SMonadLIO l m => l -> FilePath -> m ()Source

Create a directory at the supplied path with the given label. The given label must be bounded by the the current label and clearance, as checked by guardAlloc. The current label (after traversing the filesystem to the directory path) must flow to the supplied label, which must, in turn, flow to the current label as required by guardWrite.

createDirectoryPSource

Arguments

:: (SMonadLIO l m, Priv l p) 
=> p

Privilege

-> l

Label of new directory

-> FilePath

Path of directory

-> m () 

Same as createDirectory, but uses privileges when raising the current label and checking IFC restrictions.

Settinggetting handle statussettings

hSetBuffering :: SMonadLIO l m => LabeledHandle l -> BufferMode -> m ()Source

Set the buffering mode

hSetBufferingP :: (SMonadLIO l m, Priv l p) => p -> LabeledHandle l -> BufferMode -> m ()Source

Set the buffering mode

hGetBuffering :: SMonadLIO l m => LabeledHandle l -> m BufferModeSource

Get the buffering mode

hGetBufferingP :: (SMonadLIO l m, Priv l p) => p -> LabeledHandle l -> m BufferModeSource

Get the buffering mode

hSetBinaryMode :: SMonadLIO l m => LabeledHandle l -> Bool -> m ()Source

Select binary mode (True) or text mode (False)

hSetBinaryModeP :: (SMonadLIO l m, Priv l p) => p -> LabeledHandle l -> Bool -> m ()Source

Select binary mode (True) or text mode (False)

hIsEOF :: SMonadLIO l m => LabeledHandle l -> m BoolSource

End of file.

hIsEOFP :: (SMonadLIO l m, Priv l p) => p -> LabeledHandle l -> m BoolSource

End of file.

hIsOpen :: SMonadLIO l m => LabeledHandle l -> m BoolSource

Is handle open.

hIsOpenP :: (SMonadLIO l m, Priv l p) => p -> LabeledHandle l -> m BoolSource

Is handle open.

hIsClosed :: SMonadLIO l m => LabeledHandle l -> m BoolSource

Is handle closed.

hIsClosedP :: (SMonadLIO l m, Priv l p) => p -> LabeledHandle l -> m BoolSource

Is handle closed.

hIsReadable :: SMonadLIO l m => LabeledHandle l -> m BoolSource

Is handle readable.

hIsReadableP :: (SMonadLIO l m, Priv l p) => p -> LabeledHandle l -> m BoolSource

Is handle readable.

hIsWritable :: SMonadLIO l m => LabeledHandle l -> m BoolSource

Is handle writable.

hIsWritableP :: (SMonadLIO l m, Priv l p) => p -> LabeledHandle l -> m BoolSource

Is handle writable.