Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
This is a program that will recursively monitor a directory for changed files. When it detects a changed file, it will use scp to upload that file to a server. This is nice for being able to edit files on your local computer and have them automatically synced to a remove computer as soon as you :w them in vim.
#!/usr/bin/env runhaskell -Wall
import Control.Concurrent (threadDelay, forkIO)
import Control.Concurrent.MVar
import Control.Monad (liftM, filterM)
import Data.List (isPrefixOf, (\\))
import HSH.ShellEquivs (glob)
import System.Directory (canonicalizePath, getCurrentDirectory, doesFileExist)
--import System.Environment (getArgs)
import System.FilePath ((</>))
import System.FilePath.Posix (makeRelative)
import System.IO.HVFS.Utils (SystemFS(..))
import System.KQueue.HighLevel (watchFile, EventType(..), Watcher)
import System.Path (recurseDir)
import System.Process (rawSystem)
data ShouldSync = ShouldSync | ShouldNotSync deriving (Eq)
watch :: MVar (EventType, FilePath) -> FilePath -> IO Watcher
watch chan file =
let handler ev = putMVar chan (ev, file)
in watchFile file handler
listen :: MVar (EventType, FilePath) -> IO ()
listen chan = do
(event, file) <- takeMVar chan
scpFile "" file event
listen chan
excludeFiles :: String -> Bool
excludeFiles "." = True
excludeFiles ".." = True
excludeFiles file | ".git" `isPrefixOf` file = True
| otherwise = False
getAllFilesToMonitor :: IO [FilePath]
getAllFilesToMonitor = do
currentDir <- getCurrentDirectory
files <- recurseDir SystemFS currentDir
let filteredFiles = filter (not . excludeFiles) $ map (makeRelative currentDir) files
normalFiles <- filterM doesFileExist filteredFiles
return normalFiles
updateFilesToMonitor :: MVar (EventType, FilePath) -> [FilePath] -> ShouldSync -> IO ()
updateFilesToMonitor chan oldFiles shouldSync = do
allFiles <- getAllFilesToMonitor
let newFiles = allFiles \\ oldFiles
_ <- mapM (putStrLn . ("new file found: " ++)) newFiles
_ <- mapM (watch chan) newFiles
_ <- mapM (\filename -> if shouldSync == ShouldSync then scpFile "" filename Created else putStr "") newFiles
threadDelay (3 * 1000000)
updateFilesToMonitor chan allFiles ShouldSync
main :: IO ()
main = do
--args <- getArgs
chan <- newEmptyMVar
_ <- forkIO $ updateFilesToMonitor chan [] ShouldNotSync
listen chan
scpFile :: FilePath -> FilePath -> EventType -> IO ()
scpFile _ _ Deleted = return ()
scpFile _ filename _ =
do
putStrLn ("rsyncing " ++ filename ++ "...")
sshKey <- (head `liftM` glob "~/.ssh/path/to/ssh/key") >>= canonicalizePath
_ <- rawSystem "scp" ["-r", "-i", sshKey, "-P", "2222", filename, "user@host:some/path/" </> filename]
return ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment