diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-03-30 19:32:58 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-03-30 19:35:30 -0400 |
commit | f1a6e00a3107317d551c27459194aff3317919f4 (patch) | |
tree | 7ec2a98fd4a4ad0308792c8bb4c52ece424c43d0 /Annex | |
parent | 0862a7f3a3823a925f86bf2c33d67db05a2781e8 (diff) |
multicast: New command, uses uftp to multicast annexed files, for eg a classroom setting.
This commit was supported by the NSF-funded DataLad project.
Diffstat (limited to 'Annex')
-rw-r--r-- | Annex/Multicast.hs | 41 |
1 files changed, 41 insertions, 0 deletions
diff --git a/Annex/Multicast.hs b/Annex/Multicast.hs new file mode 100644 index 000000000..16aa1bd33 --- /dev/null +++ b/Annex/Multicast.hs @@ -0,0 +1,41 @@ +{- git-annex multicast receive callback + - + - Copyright 2017 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.Multicast where + +import Config.Files +import Utility.Env +import Utility.PartialPrelude + +import System.Process +import System.IO +import GHC.IO.Handle.FD + +multicastReceiveEnv :: String +multicastReceiveEnv = "GIT_ANNEX_MULTICAST_RECEIVE" + +multicastCallbackEnv :: IO (FilePath, [(String, String)], Handle) +multicastCallbackEnv = do + gitannex <- readProgramFile + (rfd, wfd) <- createPipeFd + rh <- fdToHandle rfd + environ <- addEntry multicastReceiveEnv (show wfd) <$> getEnvironment + return (gitannex, environ, rh) + +-- This is run when uftpd has received a file. Rather than move +-- the file into the annex here, which would require starting up the +-- Annex monad, parsing git config, and verifying the content, simply +-- output to the specified FD the filename. This keeps the time +-- that uftpd is not receiving the next file as short as possible. +runMulticastReceive :: [String] -> String -> IO () +runMulticastReceive ("-I":_sessionid:fs) hs = case readish hs of + Just fd -> do + h <- fdToHandle fd + mapM_ (hPutStrLn h) fs + hClose h + Nothing -> return () +runMulticastReceive _ _ = return () |