criu-rpc (empty) → 0.0.1

raw patch · 4 files changed

+238/−0 lines, 4 filesdep +basedep +criu-rpc-typesdep +lens-familysetup-changed

Dependencies added: base, criu-rpc-types, lens-family, network, process, proto-lens, text, unix

Files

LICENSE +20/−0
Setup.hs +2/−0
criu-rpc.cabal +38/−0
src/Criu.hs +178/−0

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2017 wayofthepie++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ criu-rpc.cabal view

@@ -0,0 +1,38 @@+-- Initial respawn.cabal generated by cabal init.  For further+-- documentation, see http://haskell.org/cabal/users-guide/++name:                criu-rpc+version:             0.0.1+synopsis:            CRIU RPC client.+description:         Low level client for the CRIU RPC API.+bug-reports:         https://github.com/wayofthepie/haskell-criu-rpc/issues+license:             MIT+license-file:        LICENSE+author:              wayofthepie+maintainer:          wayofthepie@gmail.com+copyright:           Stephen O'Brien+category:            criu+build-type:          Simple+cabal-version:       >=1.10++source-repository head+  type: git+  location: https://github.com/wayofthepie/haskell-criu-rpc.git++library+  exposed-modules:+    Criu++  -- other-modules:+  -- other-extensions:+  build-depends:+    base >=4.9 && <5+    , criu-rpc-types >= 0.0.0.2 && < 1.0+    , lens-family >= 1.2.1 && < 1.3+    , process+    , proto-lens+    , network+    , text+    , unix+  hs-source-dirs:      src+  default-language:    Haskell2010

+ src/Criu.hs view

@@ -0,0 +1,178 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Module      : Criu+-- Description : Convenience functions for the CRIU RPC API.+-- Copyright   : (C) 2017 Stephen O'Brien+-- License     : MIT (see the file LICENSE)+-- Maintainer  : Stephen O'Brien <wayofthepie@gmail.com>+-- Stability   : experimental+--+-- This module contains some convenience functions and types for building+-- requests to, and actually calling, the Checkpoint/Restore In Userspace+-- (criu) RPC API - see <https://criu.org/RPC>.++module Criu (+  -- * Request+  -- $requests+  callCriu+  , callCriu'+  -- ** Request Builders+  -- $requestbuilders+  , checkRequest+  , dumpRequest+  , dumpRequestOpts+  , openDir+  , closeDirFd+  ) where++import Control.Exception.Base (IOException, bracket, try)+import GHC.Int+import Lens.Family2 ((.~))+import Data.ProtoLens (build, decodeMessage, encodeMessage)+import Proto.Criu.Rpc+import Network.Socket (Family(AF_UNIX), SocketType(SeqPacket), SockAddr(SockAddrUnix), close, connect, socket)+import Network.Socket.ByteString (recv, send)+import System.Posix.IO+import System.Posix.Types++{- $requests+The simplest example of a call to CRIU is a __/check/__ request. For convenience+this module re-exports some libraries used for building 'Criu_req's.++To build a __/check/__ request:++@+> let checkRequest = build  (type' .~ CHECK)  :: Criu_req+Criu_req {+  _Criu_req'type' = CHECK+  , _Criu_req'opts = Nothing+  , _Criu_req'notifySuccess = Nothing+  , _Criu_req'keepOpen = Nothing+  , _Criu_req'features = Nothing+  }+@++'checkRequest' is also a function exposed in this module. To send that request:++@+> let checkRequest = build  (type' .~ CHECK)  :: Criu_req+> callCriu "\/var\/tmp\/criu_service.socket" checkRequest+Right (+  Criu_resp+    { _Criu_resp'type' = CHECK+    , _Criu_resp'success = True+    , _Criu_resp'dump = Nothing+    , _Criu_resp'restore = Nothing+    , _Criu_resp'notify = Nothing+    , _Criu_resp'ps = Nothing+    , _Criu_resp'crErrno = Nothing+    , _Criu_resp'features = Nothing+    , _Criu_resp'crErrmsg = Nothing+    }+)+@++'callCriu' may throw an 'IOException', to wrap these, specifically,+in 'Either' use 'callCriu'' instead.+-}+++-- | Send a request to a criu service, but wraps up IOExceptions in an `Either`.+callCriu' :: FilePath -> Criu_req -> IO (Either String Criu_resp)+callCriu' fp req = do+  eitherResp <- try (callCriu fp req)+  case eitherResp of+    Right resp -> pure resp+    Left (e :: IOException) -> pure . Left . show $ e+++-- | Send request to a criu service. Takes a filepath to the criu service+-- socket and a criu request. Returns an `Either` of the response or a+-- `String` representing an error if there is an issue decoding the+-- response from the criu service.+callCriu :: FilePath -> Criu_req -> IO (Either String Criu_resp)+callCriu fp req = do+  resp <- withSocket $ \sock -> do+    connect sock (SockAddrUnix fp)+    send sock (encodeMessage req)+    recv sock 1024+  pure (decodeMessage resp :: Either String Criu_resp)+ where+  withSocket f = bracket+    (socket AF_UNIX SeqPacket 0)+    (close)+    (\sock -> f sock)+++-- | Build some options.+criuOpts :: Int32 -> Int32 -> Criu_opts+criuOpts procId dirFd =+  build ((imagesDirFd .~ dirFd) . (pid .~ procId) . (shellJob .~ True))+{- $requestbuilders+To build 'Criu_req''s you will need '.~' from "Lens.Family2", 'build' from+"Data.ProtoLens" and of course the lenses and types from "Proto.Criu.Rpc".++Above we saw a simple /check/ request, the next example is a /dump/ request. This one is+a bit more complex. Criu requires the file descriptor of an open directory when issuing a+/dump/ request to it. This is the directory where it will /dump/ the process tree and all+necessary information about the process. Below we set the pid to __/11612/__ and we also set+__/shellJob/__ to 'True', which tells criu that the process we want to dump is running in a shell.++@+> fd <- getDirFdAsInt "\/var\/tmp\/dump"+> let dumpReqOpts = build ((imagesDirFd .~ fd) . (pid .~ 11612) . (shellJob .~ True)) :: Criu_opts+> let dumpRequest = build ((type' .~ DUMP) . (opts .~ dumpReqOpts)) :: Criu_req+> callCriu' "\/var\/tmp\/criu_service.socket" dumpRequest+Right (+  Criu_resp {+    _Criu_resp'type' = DUMP+    , _Criu_resp'success = True+    , _Criu_resp'dump = Just (+      Criu_dump_resp {+        _Criu_dump_resp'restored = Just False+      }+    ), _Criu_resp'restore = Nothing+    , _Criu_resp'notify = Nothing+    , _Criu_resp'ps = Nothing+    , _Criu_resp'crErrno = Nothing+    , _Criu_resp'features = Nothing+    , _Criu_resp'crErrmsg = Nothing+    })+@+-}+++-- | Builds a check request.+checkRequest :: Criu_req+checkRequest = build (type' .~ CHECK)+++-- | Builds a dump request from the give Criu_opts.+dumpRequest :: Criu_opts -> Criu_req+dumpRequest options = build ((type' .~ DUMP) . (opts .~ options))+++-- | Builds a minimal dump based 'Criu_opts' from a file descriptor pointing to+-- the location of the open directory you wish to dump the process tree and+-- the pid of the process tree you wish to dump. Note that really the only+-- requirement is to set 'imagesDirFd', not setting the pid will dump the+-- /calling/ process, this is not something that seems likely when using+-- this client.+dumpRequestOpts :: Fd -> Int32 -> Criu_opts+dumpRequestOpts fd procId =+  build ((imagesDirFd .~ (fromIntegral fd)) . (pid .~ procId))++-- | Open a directory, returning its file descriptor.+-- Caution - make sure to close the file descriptor! Can use 'closeDirFd'.+openDir :: FilePath -> IO Fd+openDir dir =+  openFd dir ReadOnly Nothing (OpenFileFlags False False False False False)+++-- | A convenience method, can be used to close the 'FD' returned by 'openDir'.+-- This is literally just "System.Posix.IO"'s 'closeFd'.+closeDirFd :: Fd -> IO ()+closeDirFd = closeFd++