packages feed

fswait (empty) → 1.0.0

raw patch · 5 files changed

+283/−0 lines, 5 filesdep +basedep +hinotifydep +optparse-applicativesetup-changed

Dependencies added: base, hinotify, optparse-applicative, optparse-generic, semigroups, stm, system-filepath, text, time-units, turtle

Files

+ LICENSE view
@@ -0,0 +1,24 @@+Copyright (c) 2017 Parnell Springmeyer+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:+    * Redistributions of source code must retain the above copyright notice,+      this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright notice,+      this list of conditions and the following disclaimer in the documentation+      and/or other materials provided with the distribution.+    * Neither the name of Gabriel Gonzalez nor the names of other contributors+      may be used to endorse or promote products derived from this software+      without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,64 @@+# Welcome!++[![Build Status](https://travis-ci.org/ixmatus/fswait.png)](https://travis-ci.org/ixmatus/fswait)++`fswait` is a utility for blocking on the observation of a filesystem event for+a path with a timeout.++This is useful when you need to block the execution of a separate program on the+creation (or some other filesystem event) of a filepath but you want that block+constrained by a timeout.++A common use-case is in systemd services, some daemons may need a socket or some+other file to exist before starting and it is common to write shell code to+implement that check-and-wait-with-timeout.++This tool makes that pattern more easily expressed as a command line utility+call that also supports observing _many different_ filesystem events for the+specified path.++```bash+$ fswait --path /etc/someconfig.ini --modify --create && echo 'Do something!'+observing Create Modify for /home/parnell/Desktop/test.sh+the window for an observation is 120s+Created {isDirectory = False, filePath = "someconfig.ini"}+Do something!+```++When an observation occurs, the utility will return immediately with an exit+code of 0 and print the observed event.++If the timeout window is reached without an observation occurring, an exit code+of 1 is returned.++```bash+$ fswait --help+Wait and observe events on the filesystem for a path, with a timeout++Usage: fswait [--timeout Seconds] --path FILEPATH [--exists] (--access |+              --modify | --attrib | --close | --closeWrite | --closeNoWrite |+              --open | --move | --moveIn | --moveOut | --moveSelf | --create |+              --delete | --onlyDir | --noSymlink | --maskAdd | --oneShot |+              --all) ([--access]... | [--modify]... | [--attrib]... |+              [--close]... | [--closeWrite]... | [--closeNoWrite]... |+              [--open]... | [--move]... | [--moveIn]... | [--moveOut]... |+              [--moveSelf]... | [--create]... | [--delete]... | [--onlyDir]... |+              [--noSymlink]... | [--maskAdd]... | [--oneShot]... | [--all]...)++Available options:+  -h,--help                Show this help text+  --timeout Seconds        Window to observe a filesystem event (default: 120s,+                           negative values wait indefinitely)+  --path FILEPATH          Observe filesystem events for path+  --exists                 Return immediately if the filepath already exists+```++# Installing++If you have Nix you can install it using:++```shell+$ nix-env --install --attr fswait release.nix+```++
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ fswait.cabal view
@@ -0,0 +1,45 @@+name:                fswait+version:             1.0.0+synopsis:            Wait and observe events on the filesystem for a path, with a timeout+homepage:            https://github.com/ixmatus/fswait+Bug-Reports:         https://github.com/ixmatus/fswait/issues+license:             BSD3+license-file:        LICENSE+author:              Parnell Springmeyer+maintainer:          parnell@digitalmentat.com+copyright:           2017 Parnell Springmeyer+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10+Tested-With:         GHC == 7.10.2, GHC == 8.0.1+Category:            Tools+Description:+    @fswait@ is a utility for blocking on the observation of a+    filesystem event for a path with a timeout.+    .+    The primary use-case for this is in system startup scripts that+    depend on the existence of some file or directory that will be+    created by another system service or job.++Source-Repository head+    Type:     git+    Location: https://github.com/ixmatus/fswait+++executable fswait+  main-is:             Main.hs+  ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N+  build-depends:+                base                 >= 4.8     && < 5+              , optparse-generic     >= 1.1.5   && < 1.2+              , optparse-applicative >= 0.12    && < 0.14+              , system-filepath      >= 0.3.1   && < 0.5+              , turtle               >= 1.2.8   && < 1.3+              , time-units           >= 1.0.0   && < 2.0+              , stm                  >= 2.4.4.1 && < 2.5+              , hinotify             >= 0.3     && < 0.4+              , semigroups           >= 0.18    && < 0.19+              , text                 >= 0.11    && < 1.3++  hs-source-dirs:      src+  default-language:    Haskell2010
+ src/Main.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE DataKinds          #-}+{-# LANGUAGE DeriveAnyClass     #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE LambdaCase         #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeOperators      #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main where++import           Control.Applicative          (empty, (<|>))+import           Control.Concurrent           (threadDelay)+import qualified Control.Concurrent.STM       as STM+import qualified Control.Concurrent.STM.TMVar as TMVar+import           Control.Monad                (when)+import           Data.List.NonEmpty           (NonEmpty)+import qualified Data.List.NonEmpty           as NonEmpty+import           Data.Maybe                   (fromMaybe)+import           Data.Monoid                  ((<>))+import qualified Data.Text                    as Text+import qualified Data.Time.Units              as Time.Units+import qualified Filesystem.Path              as Path+import qualified Filesystem.Path.CurrentOS    as Path+import qualified Options.Applicative          as Options+import           Options.Generic+import           System.INotify               as INotify+import qualified System.Timeout+import           Turtle                       (ExitCode (..), fp, s, void, (%))+import qualified Turtle++data Options w = Options+  { timeout :: w ::: Maybe Time.Units.Second <?> "Window to observe a filesystem event (default: 120s, negative values wait indefinitely)"+  , path    :: w ::: Path.FilePath           <?> "Observe filesystem events for path"+  , exists  :: w ::: Bool                    <?> "Return immediately if the filepath already exists"+  , events  :: w ::: NonEmpty EventVariety   <?> "Observable event"+  } deriving (Generic)++instance ParseRecord (Options Wrapped)+deriving instance Show (Options Unwrapped)++instance ParseRecord Time.Units.Second where+  parseRecord = fmap getOnly parseRecord+instance ParseFields Time.Units.Second+instance ParseField Time.Units.Second where+  parseField h n =+    fmap (Time.Units.fromMicroseconds . (*μ))+      (Options.option Options.auto $+       (  Options.metavar "Seconds"+       <> foldMap (Options.long . Text.unpack) n+       <> foldMap (Options.help . Text.unpack) h+       )+      )++deriving instance Show EventVariety+instance ParseRecord EventVariety where+  parseRecord = fmap getOnly parseRecord+instance ParseFields EventVariety+instance ParseField EventVariety where+  parseField _ _ =+        Options.flag' Access       (Options.long "access")+    <|> Options.flag' Modify       (Options.long "modify")+    <|> Options.flag' Attrib       (Options.long "attrib")+    <|> Options.flag' Close        (Options.long "close")+    <|> Options.flag' CloseWrite   (Options.long "closeWrite")+    <|> Options.flag' CloseNoWrite (Options.long "closeNoWrite")+    <|> Options.flag' Open         (Options.long "open")+    <|> Options.flag' Move         (Options.long "move")+    <|> Options.flag' MoveIn       (Options.long "moveIn")+    <|> Options.flag' MoveOut      (Options.long "moveOut")+    <|> Options.flag' MoveSelf     (Options.long "moveSelf")+    <|> Options.flag' Create       (Options.long "create")+    <|> Options.flag' Delete       (Options.long "delete")+    <|> Options.flag' OnlyDir      (Options.long "onlyDir")+    <|> Options.flag' NoSymlink    (Options.long "noSymlink")+    <|> Options.flag' MaskAdd      (Options.long "maskAdd")+    <|> Options.flag' OneShot      (Options.long "oneShot")+    <|> Options.flag' AllEvents    (Options.long "all")++μ :: Integer+μ = 10 ^ (6 :: Integer)++main :: IO ()+main = do+  Options{..} <- unwrapRecord "Wait and observe events on the filesystem for a path, with a timeout"++  when exists $ do+    pathExists <- Turtle.testfile path+    when pathExists $ do+      Turtle.err $ Turtle.format ("exists: "%fp) path+      Turtle.exit ExitSuccess++  mvar <- STM.atomically TMVar.newEmptyTMVar++  let eventSet  = NonEmpty.toList (NonEmpty.nub events)+  let watchdir  = Path.encodeString (Path.directory path)+  let watchfile = Path.encodeString (Path.filename path)+  let timeout'  = fromMaybe (Time.Units.fromMicroseconds (120 * μ)) timeout+  let eventsStr = Text.unwords $ fmap (Text.pack . show) eventSet++  let eventObservation =+        STM.atomically (TMVar.tryTakeTMVar mvar) >>= \case+          Nothing -> threadDelay 500000 >> eventObservation+          Just ev -> pure ev++  let writeEvent = STM.atomically . TMVar.tryPutTMVar mvar+  let fileEvent f e | f == watchfile = void (writeEvent e)+                    | otherwise      = empty++  let maybeFileEvent f e =+        case f of+          Nothing -> empty+          Just filepath+            | filepath == watchfile+              -> void (writeEvent e)+            | otherwise+              -> empty++  Turtle.err $ Turtle.format ("observing "%s%" for "%fp) eventsStr path++  let timeoutWindow | timeout' > 0 = Text.pack (show timeout')+                    | otherwise    = "indefinite"+  Turtle.err $ Turtle.format ("the window for an observation is "%s) timeoutWindow++  let doWatch =+        withINotify (\i -> do+          wid <- addWatch i eventSet watchdir $ \case+            ev@Accessed{..}   -> maybeFileEvent maybeFilePath ev+            ev@Attributes{..} -> maybeFileEvent maybeFilePath ev+            ev@Closed{..}     -> maybeFileEvent maybeFilePath ev+            ev@Created{..}    -> fileEvent filePath ev+            ev@Deleted{..}    -> fileEvent filePath ev+            ev@Modified{..}   -> maybeFileEvent maybeFilePath ev+            ev@MovedIn{..}    -> fileEvent filePath ev+            ev@MovedOut{..}   -> fileEvent filePath ev+            ev@Opened{..}     -> maybeFileEvent maybeFilePath ev+            ev                -> void (writeEvent ev)+          ev <- eventObservation+          removeWatch wid+          pure ev)++  System.Timeout.timeout+   (fromIntegral $ Time.Units.toMicroseconds timeout')+   doWatch >>= \case+    Nothing -> Turtle.exit (ExitFailure 1)+    Just ev -> Turtle.echo (Text.pack $ show ev)