getting files via http working!
This commit is contained in:
parent
cad916d926
commit
a36c39ad0a
3 changed files with 18 additions and 5 deletions
10
Annex.hs
10
Annex.hs
|
@ -14,6 +14,7 @@ module Annex (
|
||||||
|
|
||||||
import System.Posix.Files
|
import System.Posix.Files
|
||||||
import System.Directory
|
import System.Directory
|
||||||
|
import Data.String.Utils
|
||||||
import GitRepo
|
import GitRepo
|
||||||
import Utility
|
import Utility
|
||||||
import Locations
|
import Locations
|
||||||
|
@ -23,9 +24,14 @@ import UUID
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Types
|
import Types
|
||||||
|
|
||||||
{- An annexed file's content is stored somewhere under .git/annex/ -}
|
{- An annexed file's content is stored somewhere under .git/annex/,
|
||||||
|
- based on the key. Since the symlink is user-visible, the filename
|
||||||
|
- used should be as close to the key as possible, in case the key is a
|
||||||
|
- filename or url. Just escape "/" in the key name, to keep a flat
|
||||||
|
- tree of files and avoid issues with files ending with "/" etc. -}
|
||||||
annexLocation :: GitRepo -> Key -> FilePath
|
annexLocation :: GitRepo -> Key -> FilePath
|
||||||
annexLocation repo key = gitDir repo ++ "/annex/" ++ key
|
annexLocation repo key = gitDir repo ++ "/annex/" ++ (transform key)
|
||||||
|
where transform s = replace "/" "%" $ replace "%" "%%" s
|
||||||
|
|
||||||
{- On startup, examine the git repo, prepare it, and record state for
|
{- On startup, examine the git repo, prepare it, and record state for
|
||||||
- later. -}
|
- later. -}
|
||||||
|
|
|
@ -102,7 +102,7 @@ lookupKey state backend file = do
|
||||||
k <- readFile (backendFile state backend file)
|
k <- readFile (backendFile state backend file)
|
||||||
return $ chomp k
|
return $ chomp k
|
||||||
where
|
where
|
||||||
chomp s = if (endswith s "\n")
|
chomp s = if (endswith "\n" s)
|
||||||
then (reverse . (drop 1) . reverse) s
|
then (reverse . (drop 1) . reverse) s
|
||||||
else s
|
else s
|
||||||
|
|
||||||
|
|
|
@ -3,6 +3,8 @@
|
||||||
|
|
||||||
module BackendUrl (backend) where
|
module BackendUrl (backend) where
|
||||||
|
|
||||||
|
import System.Posix.Process
|
||||||
|
import IO
|
||||||
import Types
|
import Types
|
||||||
|
|
||||||
backend = Backend {
|
backend = Backend {
|
||||||
|
@ -17,11 +19,16 @@ backend = Backend {
|
||||||
keyValue :: State -> FilePath -> IO (Maybe Key)
|
keyValue :: State -> FilePath -> IO (Maybe Key)
|
||||||
keyValue repo file = return Nothing
|
keyValue repo file = return Nothing
|
||||||
|
|
||||||
-- cannot change urls
|
-- cannot change url contents
|
||||||
dummyStore :: State -> FilePath -> Key -> IO Bool
|
dummyStore :: State -> FilePath -> Key -> IO Bool
|
||||||
dummyStore repo file url = return False
|
dummyStore repo file url = return False
|
||||||
dummyRemove :: State -> Key -> IO Bool
|
dummyRemove :: State -> Key -> IO Bool
|
||||||
dummyRemove state url = return False
|
dummyRemove state url = return False
|
||||||
|
|
||||||
downloadUrl :: State -> Key -> FilePath -> IO Bool
|
downloadUrl :: State -> Key -> FilePath -> IO Bool
|
||||||
downloadUrl state url file = error "downloadUrl unimplemented"
|
downloadUrl state url file = do
|
||||||
|
putStrLn $ "download: " ++ url
|
||||||
|
result <- try $ executeFile "curl" True ["-o", file, url] Nothing
|
||||||
|
case (result) of
|
||||||
|
Left _ -> return False
|
||||||
|
Right _ -> return True
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue