diff --git a/Annex.hs b/Annex.hs index 7625fa8b60..940b69e4be 100644 --- a/Annex.hs +++ b/Annex.hs @@ -108,6 +108,7 @@ data AnnexState = AnnexState , fields :: M.Map String String , cleanup :: M.Map String (Annex ()) , inodeschanged :: Maybe Bool + , useragent :: Maybe String } newState :: Git.Repo -> AnnexState @@ -141,6 +142,7 @@ newState gitrepo = AnnexState , fields = M.empty , cleanup = M.empty , inodeschanged = Nothing + , useragent = Nothing } {- Makes an Annex state object for the specified git repo. diff --git a/Annex/CheckIgnore.hs b/Annex/CheckIgnore.hs index e5626557d5..d45e652bcb 100644 --- a/Annex/CheckIgnore.hs +++ b/Annex/CheckIgnore.hs @@ -25,7 +25,7 @@ checkIgnoreHandle :: Annex (Maybe Git.CheckIgnoreHandle) checkIgnoreHandle = maybe startup return =<< Annex.getState Annex.checkignorehandle where startup = do - v <- inRepo $ Git.checkIgnoreStart + v <- inRepo Git.checkIgnoreStart when (isNothing v) $ warning "The installed version of git is too old for .gitignores to be honored by git-annex." Annex.changeState $ \s -> s { Annex.checkignorehandle = Just v } diff --git a/Annex/Content.hs b/Annex/Content.hs index 25ee4c7db6..da0189c74b 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -43,7 +43,7 @@ import qualified Annex.Queue import qualified Annex.Branch import Utility.DiskFree import Utility.FileMode -import qualified Utility.Url as Url +import qualified Annex.Url as Url import Types.Key import Utility.DataUnits import Utility.CopyFile @@ -275,7 +275,7 @@ moveAnnex key src = withObjectLoc key storeobject storedirect thawContentDir =<< calcRepo (gitAnnexLocation key) thawContent src v <- isAnnexLink f - if (Just key == v) + if Just key == v then do updateInodeCache key src replaceFile f $ liftIO . moveFile src @@ -458,7 +458,7 @@ downloadUrl urls file = go =<< annexWebDownloadCommand <$> Annex.getGitConfig go Nothing = do opts <- map Param . annexWebOptions <$> Annex.getGitConfig headers <- getHttpHeaders - liftIO $ anyM (\u -> Url.download u headers opts file) urls + anyM (\u -> Url.withUserAgent $ Url.download u headers opts file) urls go (Just basecmd) = liftIO $ anyM (downloadcmd basecmd) urls downloadcmd basecmd url = boolSystem "sh" [Param "-c", Param $ gencmd url basecmd] diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs index 6da7fab52c..3de6b12a3f 100644 --- a/Annex/Content/Direct.hs +++ b/Annex/Content/Direct.hs @@ -199,7 +199,7 @@ compareInodeCachesWith = ifM inodesChanged ( return Weakly, return Strongly ) addContentWhenNotPresent :: Key -> FilePath -> FilePath -> Annex () addContentWhenNotPresent key contentfile associatedfile = do v <- isAnnexLink associatedfile - when (Just key == v) $ do + when (Just key == v) $ replaceFile associatedfile $ liftIO . void . copyFileExternal contentfile updateInodeCache key associatedfile diff --git a/Annex/Environment.hs b/Annex/Environment.hs index ae5a5646fc..f22c5f2d49 100644 --- a/Annex/Environment.hs +++ b/Annex/Environment.hs @@ -32,7 +32,7 @@ import Utility.Env checkEnvironment :: Annex () checkEnvironment = do gitusername <- fromRepo $ Git.Config.getMaybe "user.name" - when (gitusername == Nothing || gitusername == Just "") $ + when (isNothing gitusername || gitusername == Just "") $ liftIO checkEnvironmentIO checkEnvironmentIO :: IO () diff --git a/Annex/Exception.hs b/Annex/Exception.hs index 99466a8519..aaa6811a53 100644 --- a/Annex/Exception.hs +++ b/Annex/Exception.hs @@ -13,6 +13,7 @@ module Annex.Exception ( bracketIO, tryAnnex, + tryAnnexIO, throwAnnex, catchAnnex, ) where @@ -24,12 +25,16 @@ import Common.Annex {- Runs an Annex action, with setup and cleanup both in the IO monad. -} bracketIO :: IO v -> (v -> IO b) -> (v -> Annex a) -> Annex a -bracketIO setup cleanup go = M.bracket (liftIO setup) (liftIO . cleanup) go +bracketIO setup cleanup = M.bracket (liftIO setup) (liftIO . cleanup) {- try in the Annex monad -} tryAnnex :: Annex a -> Annex (Either SomeException a) tryAnnex = M.try +{- try in the Annex monad, but only catching IO exceptions -} +tryAnnexIO :: Annex a -> Annex (Either IOException a) +tryAnnexIO = M.try + {- throw in the Annex monad -} throwAnnex :: Exception e => e -> Annex a throwAnnex = M.throw diff --git a/Annex/Link.hs b/Annex/Link.hs index becd7e7ece..30d8c2ae8c 100644 --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -68,9 +68,9 @@ getAnnexLinkTarget file = ifM (coreSymlinks <$> Annex.getGitConfig) -- characters, or whitespace, we -- certianly don't have a link to a -- git-annex key. - if any (`elem` s) "\0\n\r \t" - then return "" - else return s + return $ if any (`elem` s) "\0\n\r \t" + then "" + else s {- Creates a link on disk. - diff --git a/Annex/Quvi.hs b/Annex/Quvi.hs index a79b17d619..b0725bae76 100644 --- a/Annex/Quvi.hs +++ b/Annex/Quvi.hs @@ -14,7 +14,7 @@ import qualified Annex import Utility.Quvi import Utility.Url -withQuviOptions :: forall a. (Query a) -> [CommandParam] -> URLString -> Annex a +withQuviOptions :: forall a. Query a -> [CommandParam] -> URLString -> Annex a withQuviOptions a ps url = do opts <- map Param . annexQuviOptions <$> Annex.getGitConfig liftIO $ a (ps++opts) url diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index 6fd2c556cf..3b1e4b4572 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -42,7 +42,7 @@ sshCachingOptions (host, port) opts = go =<< sshInfo (host, port) -- If the lock pool is empty, this is the first ssh of this -- run. There could be stale ssh connections hanging around -- from a previous git-annex run that was interrupted. - cleanstale = whenM (not . any isLock . M.keys <$> getPool) $ + cleanstale = whenM (not . any isLock . M.keys <$> getPool) sshCleanup {- Returns a filename to use for a ssh connection caching socket, and @@ -57,9 +57,9 @@ sshInfo (host, port) = go =<< sshCacheDir then return (Just socketfile, sshConnectionCachingParams socketfile) else do socketfile' <- liftIO $ relPathCwdToFile socketfile - if valid_unix_socket_path socketfile' - then return (Just socketfile', sshConnectionCachingParams socketfile') - else return (Nothing, []) + return $ if valid_unix_socket_path socketfile' + then (Just socketfile', sshConnectionCachingParams socketfile') + else (Nothing, []) sshConnectionCachingParams :: FilePath -> [CommandParam] sshConnectionCachingParams socketfile = diff --git a/Annex/Url.hs b/Annex/Url.hs new file mode 100644 index 0000000000..0401ffe07b --- /dev/null +++ b/Annex/Url.hs @@ -0,0 +1,27 @@ +{- Url downloading, with git-annex user agent. + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.Url ( + module U, + withUserAgent, + getUserAgent, +) where + +import Common.Annex +import qualified Annex +import Utility.Url as U +import qualified Build.SysConfig as SysConfig + +defaultUserAgent :: U.UserAgent +defaultUserAgent = "git-annex/" ++ SysConfig.packageversion + +getUserAgent :: Annex (Maybe U.UserAgent) +getUserAgent = Annex.getState $ + Just . fromMaybe defaultUserAgent . Annex.useragent + +withUserAgent :: (Maybe U.UserAgent -> IO a) -> Annex a +withUserAgent a = liftIO . a =<< getUserAgent diff --git a/Assistant/Gpg.hs b/Assistant/Gpg.hs new file mode 100644 index 0000000000..a55a0cab73 --- /dev/null +++ b/Assistant/Gpg.hs @@ -0,0 +1,36 @@ +{- git-annex assistant gpg stuff + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-} + +module Assistant.Gpg where + +import Utility.Gpg +import Utility.UserInfo +import Types.Remote (RemoteConfigKey) + +import qualified Data.Map as M + +{- Generates a gpg user id that is not used by any existing secret key -} +newUserId :: IO UserId +newUserId = do + oldkeys <- secretKeys + username <- myUserName + let basekeyname = username ++ "'s git-annex encryption key" + return $ Prelude.head $ filter (\n -> M.null $ M.filter (== n) oldkeys) + ( basekeyname + : map (\n -> basekeyname ++ show n) ([2..] :: [Int]) + ) + +data EnableEncryption = HybridEncryption | SharedEncryption | NoEncryption + deriving (Eq) + +{- Generates Remote configuration for encryption. -} +configureEncryption :: EnableEncryption -> (RemoteConfigKey, String) +configureEncryption SharedEncryption = ("encryption", "shared") +configureEncryption NoEncryption = ("encryption", "none") +configureEncryption HybridEncryption = ("encryption", "hybrid") diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index 4b0a4c7d9f..32a3fd6f52 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -9,49 +9,31 @@ module Assistant.MakeRemote where import Assistant.Common import Assistant.Ssh -import Assistant.Sync import qualified Types.Remote as R import qualified Remote import Remote.List import qualified Remote.Rsync as Rsync +import qualified Remote.GCrypt as GCrypt import qualified Git import qualified Git.Command import qualified Command.InitRemote import Logs.UUID import Logs.Remote import Git.Remote -import Config -import Config.Cost import Creds +import Assistant.Gpg +import Utility.Gpg (KeyId) -import qualified Data.Text as T import qualified Data.Map as M -{- Sets up and begins syncing with a new ssh or rsync remote. -} -makeSshRemote :: Bool -> SshData -> Maybe Cost -> Assistant Remote -makeSshRemote forcersync sshdata mcost = do - r <- liftAnnex $ - addRemote $ maker (sshRepoName sshdata) sshurl - liftAnnex $ maybe noop (setRemoteCost r) mcost - syncRemote r - return r +{- Sets up a new git or rsync remote, accessed over ssh. -} +makeSshRemote :: SshData -> Annex RemoteName +makeSshRemote sshdata = maker (sshRepoName sshdata) (genSshUrl sshdata) where - rsync = forcersync || rsyncOnly sshdata maker - | rsync = makeRsyncRemote + | onlyCapability sshdata RsyncCapable = makeRsyncRemote | otherwise = makeGitRemote - sshurl = T.unpack $ T.concat $ - if rsync - then [u, h, T.pack ":", sshDirectory sshdata, T.pack "/"] - else [T.pack "ssh://", u, h, d, T.pack "/"] - where - u = maybe (T.pack "") (\v -> T.concat [v, T.pack "@"]) $ sshUserName sshdata - h = sshHostName sshdata - d - | T.pack "/" `T.isPrefixOf` sshDirectory sshdata = sshDirectory sshdata - | T.pack "~/" `T.isPrefixOf` sshDirectory sshdata = T.concat [T.pack "/", sshDirectory sshdata] - | otherwise = T.concat [T.pack "/~/", sshDirectory sshdata] - + {- Runs an action that returns a name of the remote, and finishes adding it. -} addRemote :: Annex RemoteName -> Annex Remote addRemote a = do @@ -74,6 +56,16 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $ , ("type", "rsync") ] +{- Inits a gcrypt special remote, and returns its name. -} +makeGCryptRemote :: RemoteName -> String -> KeyId -> Annex RemoteName +makeGCryptRemote remotename location keyid = + initSpecialRemote remotename GCrypt.remote $ M.fromList + [ ("type", "gcrypt") + , ("gitrepo", location) + , configureEncryption HybridEncryption + , ("keyid", keyid) + ] + type SpecialRemoteMaker = RemoteName -> RemoteType -> R.RemoteConfig -> Annex RemoteName {- Inits a new special remote. The name is used as a suggestion, but @@ -126,7 +118,6 @@ makeRemote basename location a = do g <- gitRepo if not (any samelocation $ Git.remotes g) then do - let name = uniqueRemoteName basename 0 g a name return name diff --git a/Assistant/Pairing/MakeRemote.hs b/Assistant/Pairing/MakeRemote.hs index edd27e35a2..144b236a41 100644 --- a/Assistant/Pairing/MakeRemote.hs +++ b/Assistant/Pairing/MakeRemote.hs @@ -12,7 +12,9 @@ import Assistant.Ssh import Assistant.Pairing import Assistant.Pairing.Network import Assistant.MakeRemote +import Assistant.Sync import Config.Cost +import Config import Network.Socket import qualified Data.Text as T @@ -22,7 +24,7 @@ import qualified Data.Text as T setupAuthorizedKeys :: PairMsg -> FilePath -> IO () setupAuthorizedKeys msg repodir = do validateSshPubKey pubkey - unlessM (liftIO $ addAuthorizedKeys False repodir pubkey) $ + unlessM (liftIO $ addAuthorizedKeys True repodir pubkey) $ error "failed setting up ssh authorized keys" where pubkey = remoteSshPubKey $ pairMsgData msg @@ -43,7 +45,9 @@ finishedLocalPairing msg keypair = do , "git-annex-shell -c configlist " ++ T.unpack (sshDirectory sshdata) ] Nothing - void $ makeSshRemote False sshdata (Just semiExpensiveRemoteCost) + r <- liftAnnex $ addRemote $ makeSshRemote sshdata + liftAnnex $ setRemoteCost r semiExpensiveRemoteCost + syncRemote r {- Mostly a straightforward conversion. Except: - * Determine the best hostname to use to contact the host. @@ -63,7 +67,7 @@ pairMsgToSshData msg = do , sshRepoName = genSshRepoName hostname dir , sshPort = 22 , needsPubKey = True - , rsyncOnly = False + , sshCapabilities = [GitAnnexShellCapable, GitCapable, RsyncCapable] } {- Finds the best hostname to use for the host that sent the PairMsg. diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index a623190964..f316aa5008 100644 --- a/Assistant/Ssh.hs +++ b/Assistant/Ssh.hs @@ -1,6 +1,6 @@ {- git-annex assistant ssh utilities - - - Copyright 2012 Joey Hess + - Copyright 2012-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -11,6 +11,7 @@ import Common.Annex import Utility.Tmp import Utility.UserInfo import Utility.Shell +import Utility.Rsync import Git.Remote import Data.Text (Text) @@ -25,10 +26,19 @@ data SshData = SshData , sshRepoName :: String , sshPort :: Int , needsPubKey :: Bool - , rsyncOnly :: Bool + , sshCapabilities :: [SshServerCapability] } deriving (Read, Show, Eq) +data SshServerCapability = GitAnnexShellCapable | GitCapable | RsyncCapable + deriving (Read, Show, Eq) + +hasCapability :: SshData -> SshServerCapability -> Bool +hasCapability d c = c `elem` sshCapabilities d + +onlyCapability :: SshData -> SshServerCapability -> Bool +onlyCapability d c = all (== c) (sshCapabilities d) + data SshKeyPair = SshKeyPair { sshPubKey :: String , sshPrivKey :: String @@ -52,6 +62,48 @@ sshDir = do genSshHost :: Text -> Maybe Text -> String genSshHost host user = maybe "" (\v -> T.unpack v ++ "@") user ++ T.unpack host +{- Generates a ssh or rsync url from a SshData. -} +genSshUrl :: SshData -> String +genSshUrl sshdata = addtrailingslash $ T.unpack $ T.concat $ + if (onlyCapability sshdata RsyncCapable) + then [u, h, T.pack ":", sshDirectory sshdata] + else [T.pack "ssh://", u, h, d] + where + u = maybe (T.pack "") (\v -> T.concat [v, T.pack "@"]) $ sshUserName sshdata + h = sshHostName sshdata + d + | T.pack "/" `T.isPrefixOf` sshDirectory sshdata = sshDirectory sshdata + | T.pack "~/" `T.isPrefixOf` sshDirectory sshdata = T.concat [T.pack "/", sshDirectory sshdata] + | otherwise = T.concat [T.pack "/~/", sshDirectory sshdata] + addtrailingslash s + | "/" `isSuffixOf` s = s + | otherwise = s ++ "/" + +{- Reverses genSshUrl -} +parseSshUrl :: String -> Maybe SshData +parseSshUrl u + | "ssh://" `isPrefixOf` u = fromssh (drop (length "ssh://") u) + | otherwise = fromrsync u + where + mkdata (userhost, dir) = Just $ SshData + { sshHostName = T.pack host + , sshUserName = if null user then Nothing else Just $ T.pack user + , sshDirectory = T.pack dir + , sshRepoName = genSshRepoName host dir + -- dummy values, cannot determine from url + , sshPort = 22 + , needsPubKey = True + , sshCapabilities = [] + } + where + (user, host) = if '@' `elem` userhost + then separate (== '@') userhost + else ("", userhost) + fromrsync s + | not (rsyncUrlIsShell u) = Nothing + | otherwise = mkdata $ separate (== ':') s + fromssh = mkdata . break (== '/') + {- Generates a git remote name, like host_dir or host -} genSshRepoName :: String -> FilePath -> String genSshRepoName host dir @@ -92,12 +144,12 @@ validateSshPubKey pubkey safeincomment c = isAlphaNum c || c == '@' || c == '-' || c == '_' || c == '.' addAuthorizedKeys :: Bool -> FilePath -> SshPubKey -> IO Bool -addAuthorizedKeys rsynconly dir pubkey = boolSystem "sh" - [ Param "-c" , Param $ addAuthorizedKeysCommand rsynconly dir pubkey ] +addAuthorizedKeys gitannexshellonly dir pubkey = boolSystem "sh" + [ Param "-c" , Param $ addAuthorizedKeysCommand gitannexshellonly dir pubkey ] removeAuthorizedKeys :: Bool -> FilePath -> SshPubKey -> IO () -removeAuthorizedKeys rsynconly dir pubkey = do - let keyline = authorizedKeysLine rsynconly dir pubkey +removeAuthorizedKeys gitannexshellonly dir pubkey = do + let keyline = authorizedKeysLine gitannexshellonly dir pubkey sshdir <- sshDir let keyfile = sshdir "authorized_keys" ls <- lines <$> readFileStrict keyfile @@ -110,7 +162,7 @@ removeAuthorizedKeys rsynconly dir pubkey = do - present. -} addAuthorizedKeysCommand :: Bool -> FilePath -> SshPubKey -> String -addAuthorizedKeysCommand rsynconly dir pubkey = intercalate "&&" +addAuthorizedKeysCommand gitannexshellonly dir pubkey = intercalate "&&" [ "mkdir -p ~/.ssh" , intercalate "; " [ "if [ ! -e " ++ wrapper ++ " ]" @@ -122,7 +174,7 @@ addAuthorizedKeysCommand rsynconly dir pubkey = intercalate "&&" , "chmod 600 ~/.ssh/authorized_keys" , unwords [ "echo" - , shellEscape $ authorizedKeysLine rsynconly dir pubkey + , shellEscape $ authorizedKeysLine gitannexshellonly dir pubkey , ">>~/.ssh/authorized_keys" ] ] @@ -141,11 +193,11 @@ addAuthorizedKeysCommand rsynconly dir pubkey = intercalate "&&" runshell var = "exec git-annex-shell -c \"" ++ var ++ "\"" authorizedKeysLine :: Bool -> FilePath -> SshPubKey -> String -authorizedKeysLine rsynconly dir pubkey +authorizedKeysLine gitannexshellonly dir pubkey + | gitannexshellonly = limitcommand ++ pubkey {- TODO: Locking down rsync is difficult, requiring a rather - long perl script. -} - | rsynconly = pubkey - | otherwise = limitcommand ++ pubkey + | otherwise = pubkey where limitcommand = "command=\"GIT_ANNEX_SHELL_DIRECTORY="++shellEscape dir++" ~/.ssh/git-annex-shell\",no-agent-forwarding,no-port-forwarding,no-X11-forwarding " diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index be3bc3c842..445f4753ba 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -319,10 +319,10 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do add change@(InProcessAddChange { keySource = ks }) = catchDefaultIO Nothing <~> do sanitycheck ks $ do - key <- liftAnnex $ do + (mkey, mcache) <- liftAnnex $ do showStart "add" $ keyFilename ks Command.Add.ingest $ Just ks - maybe (failedingest change) (done change $ keyFilename ks) key + maybe (failedingest change) (done change mcache $ keyFilename ks) mkey add _ = return Nothing {- In direct mode, avoid overhead of re-injesting a renamed @@ -349,7 +349,7 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do fastadd change key = do let source = keySource change liftAnnex $ Command.Add.finishIngestDirect key source - done change (keyFilename source) key + done change Nothing (keyFilename source) key removedKeysMap :: InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key) removedKeysMap ct l = do @@ -365,11 +365,11 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do liftAnnex showEndFail return Nothing - done change file key = liftAnnex $ do + done change mcache file key = liftAnnex $ do logStatus key InfoPresent link <- ifM isDirect ( inRepo $ gitAnnexLink file key - , Command.Add.link file key True + , Command.Add.link file key mcache ) whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $ do stageSymlink file =<< hashSymlink link diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index 5a6871fdb7..6313109879 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -81,8 +81,7 @@ transferScannerThread urlrenderer = namedThread "TransferScanner" $ do {- This is a cheap scan for failed transfers involving a remote. -} failedTransferScan :: Remote -> Assistant () failedTransferScan r = do - failed <- liftAnnex $ getFailedTransfers (Remote.uuid r) - liftAnnex $ mapM_ removeFailedTransfer $ map fst failed + failed <- liftAnnex $ clearFailedTransfers (Remote.uuid r) mapM_ retry failed where retry (t, info) @@ -98,7 +97,7 @@ failedTransferScan r = do - key, so it's not redundantly checked here. -} requeue t info requeue t info = queueTransferWhenSmall "retrying failed transfer" (associatedFile info) t r - + {- This is a expensive scan through the full git work tree, finding - files to transfer. The scan is blocked when the transfer queue gets - too large. @@ -118,8 +117,12 @@ expensiveScan :: UrlRenderer -> [Remote] -> Assistant () expensiveScan urlrenderer rs = unless onlyweb $ batch <~> do debug ["starting scan of", show visiblers] + let us = map Remote.uuid rs + + mapM_ (liftAnnex . clearFailedTransfers) us + unwantedrs <- liftAnnex $ S.fromList - <$> filterM inUnwantedGroup (map Remote.uuid rs) + <$> filterM inUnwantedGroup us g <- liftAnnex gitRepo (files, cleanup) <- liftIO $ LsFiles.inRepo [] g diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs index a8e8228b16..625546dfee 100644 --- a/Assistant/WebApp/Configurators.hs +++ b/Assistant/WebApp/Configurators.hs @@ -17,7 +17,7 @@ import Assistant.XMPP.Client {- The main configuration screen. -} getConfigurationR :: Handler Html -getConfigurationR = ifM (inFirstRun) +getConfigurationR = ifM inFirstRun ( redirect FirstRepositoryR , page "Configuration" (Just Configuration) $ do #ifdef WITH_XMPP diff --git a/Assistant/WebApp/Configurators/AWS.hs b/Assistant/WebApp/Configurators/AWS.hs index bf39419527..24c8725c15 100644 --- a/Assistant/WebApp/Configurators/AWS.hs +++ b/Assistant/WebApp/Configurators/AWS.hs @@ -11,7 +11,6 @@ module Assistant.WebApp.Configurators.AWS where import Assistant.WebApp.Common import Assistant.MakeRemote -import Assistant.Sync #ifdef WITH_S3 import qualified Remote.S3 as S3 #endif @@ -22,8 +21,10 @@ import qualified Remote import qualified Types.Remote as Remote import Types.Remote (RemoteConfig) import Types.StandardGroups -import Logs.PreferredContent import Creds +import Assistant.Gpg +import Git.Remote +import Assistant.WebApp.Utility import qualified Data.Text as T import qualified Data.Map as M @@ -93,10 +94,10 @@ awsCredsAForm defcreds = AWSCreds <*> secretAccessKeyField (T.pack . snd <$> defcreds) accessKeyIDField :: Widget -> Maybe Text -> MkAForm Text -accessKeyIDField help def = areq (textField `withNote` help) "Access Key ID" def +accessKeyIDField help = areq (textField `withNote` help) "Access Key ID" accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text -accessKeyIDFieldWithHelp def = accessKeyIDField help def +accessKeyIDFieldWithHelp = accessKeyIDField help where help = [whamlet| @@ -104,7 +105,7 @@ accessKeyIDFieldWithHelp def = accessKeyIDField help def |] secretAccessKeyField :: Maybe Text -> MkAForm Text -secretAccessKeyField def = areq passwordField "Secret Access Key" def +secretAccessKeyField = areq passwordField "Secret Access Key" datacenterField :: AWS.Service -> MkAForm Text datacenterField service = areq (selectFieldList list) "Datacenter" defregion @@ -124,16 +125,13 @@ postAddS3R = awsConfigurator $ do case result of FormSuccess input -> liftH $ do let name = T.unpack $ repoName input - makeAWSRemote initSpecialRemote S3.remote (extractCreds input) name setgroup $ M.fromList + makeAWSRemote initSpecialRemote S3.remote TransferGroup (extractCreds input) name $ M.fromList [ configureEncryption $ enableEncryption input , ("type", "S3") , ("datacenter", T.unpack $ datacenter input) , ("storageclass", show $ storageClass input) ] _ -> $(widgetFile "configurators/adds3") - where - setgroup r = liftAnnex $ - setStandardGroup (Remote.uuid r) TransferGroup #else postAddS3R = error "S3 not supported by this build" #endif @@ -150,15 +148,12 @@ postAddGlacierR = glacierConfigurator $ do case result of FormSuccess input -> liftH $ do let name = T.unpack $ repoName input - makeAWSRemote initSpecialRemote Glacier.remote (extractCreds input) name setgroup $ M.fromList + makeAWSRemote initSpecialRemote Glacier.remote SmallArchiveGroup (extractCreds input) name $ M.fromList [ configureEncryption $ enableEncryption input , ("type", "glacier") , ("datacenter", T.unpack $ datacenter input) ] _ -> $(widgetFile "configurators/addglacier") - where - setgroup r = liftAnnex $ - setStandardGroup (Remote.uuid r) SmallArchiveGroup #else postAddGlacierR = error "S3 not supported by this build" #endif @@ -198,7 +193,7 @@ enableAWSRemote remotetype uuid = do m <- liftAnnex readRemoteLog let name = fromJust $ M.lookup "name" $ fromJust $ M.lookup uuid m - makeAWSRemote enableSpecialRemote remotetype creds name (const noop) M.empty + makeAWSRemote enableSpecialRemote remotetype SmallArchiveGroup creds name M.empty _ -> do description <- liftAnnex $ T.pack <$> Remote.prettyUUID uuid @@ -207,14 +202,11 @@ enableAWSRemote remotetype uuid = do enableAWSRemote _ _ = error "S3 not supported by this build" #endif -makeAWSRemote :: SpecialRemoteMaker -> RemoteType -> AWSCreds -> String -> (Remote -> Handler ()) -> RemoteConfig -> Handler () -makeAWSRemote maker remotetype (AWSCreds ak sk) name setup config = do +makeAWSRemote :: SpecialRemoteMaker -> RemoteType -> StandardGroup -> AWSCreds -> RemoteName -> RemoteConfig -> Handler () +makeAWSRemote maker remotetype defaultgroup (AWSCreds ak sk) name config = do liftIO $ AWS.setCredsEnv (T.unpack ak, T.unpack sk) - r <- liftAnnex $ addRemote $ do + setupCloudRemote defaultgroup Nothing $ maker hostname remotetype config - setup r - liftAssistant $ syncRemote r - redirect $ EditNewCloudRepositoryR $ Remote.uuid r where {- AWS services use the remote name as the basis for a host - name, so filter it to contain valid characters. -} diff --git a/Assistant/WebApp/Configurators/Delete.hs b/Assistant/WebApp/Configurators/Delete.hs index 4a28cd3474..e7c5313636 100644 --- a/Assistant/WebApp/Configurators/Delete.hs +++ b/Assistant/WebApp/Configurators/Delete.hs @@ -22,6 +22,7 @@ import Logs.Trust import Logs.Remote import Logs.PreferredContent import Types.StandardGroups +import Annex.UUID import System.IO.HVFS (SystemFS(..)) import qualified Data.Text as T @@ -29,9 +30,13 @@ import qualified Data.Map as M import System.Path notCurrentRepo :: UUID -> Handler Html -> Handler Html -notCurrentRepo uuid a = go =<< liftAnnex (Remote.remoteFromUUID uuid) +notCurrentRepo uuid a = do + u <- liftAnnex getUUID + if u == uuid + then redirect DeleteCurrentRepositoryR + else go =<< liftAnnex (Remote.remoteFromUUID uuid) where - go Nothing = redirect DeleteCurrentRepositoryR + go Nothing = error "Unknown UUID" go (Just _) = a getDisableRepositoryR :: UUID -> Handler Html diff --git a/Assistant/WebApp/Configurators/Edit.hs b/Assistant/WebApp/Configurators/Edit.hs index 32d0e5ecde..9d3681253b 100644 --- a/Assistant/WebApp/Configurators/Edit.hs +++ b/Assistant/WebApp/Configurators/Edit.hs @@ -62,7 +62,7 @@ getRepoConfig uuid mremote = do Nothing -> (RepoGroupCustom $ unwords $ S.toList groups, Nothing) Just g -> (RepoGroupStandard g, associatedDirectory remoteconfig g) - description <- maybe Nothing (Just . T.pack) . M.lookup uuid <$> uuidMap + description <- fmap T.pack . M.lookup uuid <$> uuidMap syncable <- case mremote of Just r -> return $ remoteAnnexSync $ Remote.gitconfig r @@ -99,7 +99,7 @@ setRepoConfig uuid mremote oldc newc = do , Param $ T.unpack $ repoName oldc , Param name ] - void $ Remote.remoteListRefresh + void Remote.remoteListRefresh liftAssistant updateSyncRemotes when associatedDirectoryChanged $ case repoAssociatedDirectory newc of Nothing -> noop @@ -120,11 +120,9 @@ setRepoConfig uuid mremote oldc newc = do - so avoid queueing a duplicate scan. -} when (repoSyncable newc && not syncableChanged) $ liftAssistant $ case mremote of - Just remote -> do - addScanRemotes True [remote] - Nothing -> do - addScanRemotes True - =<< syncDataRemotes <$> getDaemonStatus + Just remote -> addScanRemotes True [remote] + Nothing -> addScanRemotes True + =<< syncDataRemotes <$> getDaemonStatus when syncableChanged $ changeSyncable mremote (repoSyncable newc) where @@ -242,4 +240,4 @@ encrypted using gpg key:
  • ^{gpgKeyDisplay k (M.lookup k knownkeys)} |] -getRepoEncryption _ _ = [whamlet||] -- local repo +getRepoEncryption _ _ = return () -- local repo diff --git a/Assistant/WebApp/Configurators/IA.hs b/Assistant/WebApp/Configurators/IA.hs index d0d60e25ae..379b696c70 100644 --- a/Assistant/WebApp/Configurators/IA.hs +++ b/Assistant/WebApp/Configurators/IA.hs @@ -20,10 +20,10 @@ import qualified Remote import qualified Types.Remote as Remote import Types.StandardGroups import Types.Remote (RemoteConfig) -import Logs.PreferredContent import Logs.Remote -import qualified Utility.Url as Url +import qualified Annex.Url as Url import Creds +import Assistant.Gpg import qualified Data.Text as T import qualified Data.Map as M @@ -111,7 +111,7 @@ previouslyUsedIACreds = previouslyUsedCredPair AWS.creds S3.remote $ #endif accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text -accessKeyIDFieldWithHelp def = AWS.accessKeyIDField help def +accessKeyIDFieldWithHelp = AWS.accessKeyIDField help where help = [whamlet| @@ -130,7 +130,7 @@ postAddIAR = iaConfigurator $ do case result of FormSuccess input -> liftH $ do let name = escapeBucket $ T.unpack $ itemName input - AWS.makeAWSRemote initSpecialRemote S3.remote (extractCreds input) name setgroup $ + AWS.makeAWSRemote initSpecialRemote S3.remote PublicGroup (extractCreds input) name $ M.fromList $ catMaybes [ Just $ configureEncryption NoEncryption , Just ("type", "S3") @@ -146,9 +146,6 @@ postAddIAR = iaConfigurator $ do , Just ("preferreddir", name) ] _ -> $(widgetFile "configurators/addia") - where - setgroup r = liftAnnex $ - setStandardGroup (Remote.uuid r) PublicGroup #else postAddIAR = error "S3 not supported by this build" #endif @@ -174,7 +171,7 @@ enableIARemote uuid = do m <- liftAnnex readRemoteLog let name = fromJust $ M.lookup "name" $ fromJust $ M.lookup uuid m - AWS.makeAWSRemote enableSpecialRemote S3.remote creds name (const noop) M.empty + AWS.makeAWSRemote enableSpecialRemote S3.remote PublicGroup creds name M.empty _ -> do description <- liftAnnex $ T.pack <$> Remote.prettyUUID uuid @@ -193,7 +190,8 @@ escapeHeader = escapeURIString (\c -> isUnescapedInURI c && c /= ' ') getRepoInfo :: RemoteConfig -> Widget getRepoInfo c = do - exists <- liftIO $ catchDefaultIO False $ fst <$> Url.exists url [] + ua <- liftAnnex Url.getUserAgent + exists <- liftIO $ catchDefaultIO False $ fst <$> Url.exists url [] ua [whamlet| Internet Archive item diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs index 6b96f91485..8e322dcfac 100644 --- a/Assistant/WebApp/Configurators/Local.hs +++ b/Assistant/WebApp/Configurators/Local.hs @@ -38,7 +38,6 @@ import Config import Utility.Gpg import qualified Annex.Branch import qualified Remote.GCrypt as GCrypt -import qualified Git.GCrypt import qualified Types.Remote import qualified Data.Text as T @@ -101,7 +100,7 @@ checkRepositoryPath p = do Nothing -> Right $ Just $ T.pack basepath Just prob -> Left prob where - runcheck (chk, msg) = ifM (chk) ( return $ Just msg, return Nothing ) + runcheck (chk, msg) = ifM chk ( return $ Just msg, return Nothing ) expandTilde home ('~':'/':path) = home path expandTilde _ path = path @@ -114,7 +113,7 @@ checkRepositoryPath p = do - browsed to a directory with git-annex and run it from there. -} defaultRepositoryPath :: Bool -> IO FilePath defaultRepositoryPath firstrun = do - cwd <- liftIO $ getCurrentDirectory + cwd <- liftIO getCurrentDirectory home <- myHomeDir if home == cwd && firstrun then inhome @@ -137,7 +136,7 @@ newRepositoryForm defpath msg = do (Just $ T.pack $ addTrailingPathSeparator defpath) let (err, errmsg) = case pathRes of FormMissing -> (False, "") - FormFailure l -> (True, concat $ map T.unpack l) + FormFailure l -> (True, concatMap T.unpack l) FormSuccess _ -> (False, "") let form = do webAppFormAuthToken @@ -196,8 +195,8 @@ postNewRepositoryR = page "Add another repository" (Just Configuration) $ do mainrepo <- fromJust . relDir <$> liftH getYesod $(widgetFile "configurators/newrepository/combine") -getCombineRepositoryR :: FilePathAndUUID -> Handler Html -getCombineRepositoryR (FilePathAndUUID newrepopath newrepouuid) = do +getCombineRepositoryR :: FilePath -> UUID -> Handler Html +getCombineRepositoryR newrepopath newrepouuid = do r <- combineRepos newrepopath remotename liftAssistant $ syncRemote r redirect $ EditRepositoryR newrepouuid @@ -231,7 +230,7 @@ getAddDriveR :: Handler Html getAddDriveR = postAddDriveR postAddDriveR :: Handler Html postAddDriveR = page "Add a removable drive" (Just Configuration) $ do - removabledrives <- liftIO $ driveList + removabledrives <- liftIO driveList writabledrives <- liftIO $ filterM (canWrite . T.unpack . mountPoint) removabledrives ((res, form), enctype) <- liftH $ runFormPost $ @@ -253,7 +252,7 @@ getConfirmAddDriveR drive = ifM (liftIO $ probeRepoExists dir) mu <- liftIO $ probeUUID dir case mu of Nothing -> maybe askcombine isknownuuid - =<< liftIO (probeGCryptRemoteUUID dir) + =<< liftAnnex (probeGCryptRemoteUUID dir) Just driveuuid -> isknownuuid driveuuid , newrepo ) @@ -276,17 +275,14 @@ getConfirmAddDriveR drive = ifM (liftIO $ probeRepoExists dir) setupDriveModal :: Widget setupDriveModal = $(widgetFile "configurators/adddrive/setupmodal") -genKeyModal :: Widget -genKeyModal = $(widgetFile "configurators/genkeymodal") - getGenKeyForDriveR :: RemovableDrive -> Handler Html -getGenKeyForDriveR drive = withNewSecretKey $ \key -> do +getGenKeyForDriveR drive = withNewSecretKey $ \keyid -> {- Generating a key takes a long time, and - the removable drive may have been disconnected - in the meantime. Check that it is still mounted - before finishing. -} ifM (liftIO $ any (\d -> mountPoint d == mountPoint drive) <$> driveList) - ( getFinishAddDriveR drive (RepoKey key) + ( getFinishAddDriveR drive (RepoKey keyid) , getAddDriveR ) @@ -294,39 +290,22 @@ getFinishAddDriveR :: RemovableDrive -> RepoKey -> Handler Html getFinishAddDriveR drive = go where {- Set up new gcrypt special remote. -} - go (RepoKey keyid) = ifM (liftIO $ inPath "git-remote-gcrypt") - ( makewith $ \_ -> do - r <- liftAnnex $ addRemote $ - initSpecialRemote remotename GCrypt.remote $ M.fromList - [ ("type", "gcrypt") - , ("gitrepo", dir) - , configureEncryption HybridEncryption - , ("keyid", keyid) - ] - return (Types.Remote.uuid r, r) - , page "Encrypt repository" (Just Configuration) $ - $(widgetFile "configurators/needgcrypt") - ) - go NoRepoKey = do - pr <- liftAnnex $ inRepo $ Git.GCrypt.probeRepo dir - case pr of - Git.GCrypt.Decryptable -> do - mu <- liftIO $ probeGCryptRemoteUUID dir - case mu of - Just u -> enablegcryptremote u - Nothing -> error "The drive contains a gcrypt repository that is not a git-annex special remote. This is not supported." - Git.GCrypt.NotDecryptable -> - error $ "The drive contains a git repository that is encrypted with a GnuPG key that you do not have." - Git.GCrypt.NotEncrypted -> makeunencrypted - enablegcryptremote u = do - mname <- liftAnnex $ getGCryptRemoteName u dir - case mname of - Nothing -> error $ "Cannot find configuration for the gcrypt remote at " ++ dir - Just name -> makewith $ const $ do - r <- liftAnnex $ addRemote $ - enableSpecialRemote name GCrypt.remote $ M.fromList - [("gitrepo", dir)] - return (u, r) + go (RepoKey keyid) = whenGcryptInstalled $ makewith $ const $ do + r <- liftAnnex $ addRemote $ + makeGCryptRemote remotename dir keyid + return (Types.Remote.uuid r, r) + go NoRepoKey = checkGCryptRepoEncryption dir makeunencrypted $ do + mu <- liftAnnex $ probeGCryptRemoteUUID dir + case mu of + Just u -> enableexistinggcryptremote u + Nothing -> error "The drive contains a gcrypt repository that is not a git-annex special remote. This is not supported." + enableexistinggcryptremote u = do + remotename' <- liftAnnex $ getGCryptRemoteName u dir + makewith $ const $ do + r <- liftAnnex $ addRemote $ + enableSpecialRemote remotename' GCrypt.remote $ M.fromList + [("gitrepo", dir)] + return (u, r) {- Making a new unencrypted repo, or combining with an existing one. -} makeunencrypted = makewith $ \isnew -> (,) <$> liftIO (initRepo isnew False dir $ Just remotename) @@ -350,7 +329,7 @@ getFinishAddDriveR drive = go - Next call syncRemote to get them in sync. -} combineRepos :: FilePath -> String -> Handler Remote combineRepos dir name = liftAnnex $ do - hostname <- maybe "host" id <$> liftIO getHostname + hostname <- fromMaybe "host" <$> liftIO getHostname hostlocation <- fromRepo Git.repoLocation liftIO $ inDir dir $ void $ makeGitRemote hostname hostlocation addRemote $ makeGitRemote name dir @@ -401,7 +380,7 @@ startFullAssistant path repogroup setup = do u <- initRepo isnew True path Nothing inDir path $ do setStandardGroup u repogroup - maybe noop id setup + fromMaybe noop setup addAutoStartFile path setCurrentDirectory path fromJust $ postFirstRun webapp @@ -461,13 +440,12 @@ initRepo False _ dir desc = inDir dir $ do getUUID initRepo' :: Maybe String -> Annex () -initRepo' desc = do - unlessM isInitialized $ do - initialize desc - {- Ensure branch gets committed right away so it is - - available for merging when a removable drive repo is being - - added. -} - Annex.Branch.commit "update" +initRepo' desc = unlessM isInitialized $ do + initialize desc + {- Ensure branch gets committed right away so it is + - available for merging when a removable drive repo is being + - added. -} + Annex.Branch.commit "update" {- Checks if the user can write to a directory. - @@ -490,11 +468,3 @@ probeUUID :: FilePath -> IO (Maybe UUID) probeUUID dir = catchDefaultIO Nothing $ inDir dir $ do u <- getUUID return $ if u == NoUUID then Nothing else Just u - -{- Gets the UUID of the gcrypt repo at a location, which may not exist. - - Only works if the gcrypt repo was created as a git-annex remote. -} -probeGCryptRemoteUUID :: FilePath -> IO (Maybe UUID) -probeGCryptRemoteUUID dir = catchDefaultIO Nothing $ do - r <- Git.Construct.fromAbsPath dir - (genUUIDInNameSpace gCryptNameSpace <$>) . fst - <$> GCrypt.getGCryptId r diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs index ec3a8e43f1..7f7f172cdf 100644 --- a/Assistant/WebApp/Configurators/Pairing.hs +++ b/Assistant/WebApp/Configurators/Pairing.hs @@ -152,7 +152,7 @@ postFinishLocalPairR msg = promptSecret (Just msg) $ \_ secret -> do where alert = pairRequestAcknowledgedAlert (pairRepo msg) . Just setup repodir = setupAuthorizedKeys msg repodir - cleanup repodir = removeAuthorizedKeys False repodir $ + cleanup repodir = removeAuthorizedKeys True repodir $ remoteSshPubKey $ pairMsgData msg uuid = Just $ pairUUID $ pairMsgData msg #else @@ -300,7 +300,7 @@ secretProblem :: Secret -> Maybe Text secretProblem s | B.null s = Just "The secret phrase cannot be left empty. (Remember that punctuation and white space is ignored.)" | B.length s < 6 = Just "Enter a longer secret phrase, at least 6 characters, but really, a phrase is best! This is not a password you'll need to enter every day." - | s == toSecret sampleQuote = Just "Speaking of foolishness, don't paste in the example I gave. Enter a different phrase, please!" + | s == toSecret sampleQuote = Just "Speaking of foolishness, don't paste in the example I gave. Enter a different phrase, please!" | otherwise = Nothing toSecret :: Text -> Secret diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index 945e2b55c6..9e0ebd23bd 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp configurator for ssh-based remotes - - - Copyright 2012 Joey Hess + - Copyright 2012-2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -11,18 +11,25 @@ module Assistant.WebApp.Configurators.Ssh where import Assistant.WebApp.Common +import Assistant.WebApp.Gpg import Assistant.Ssh import Assistant.MakeRemote -import Utility.Rsync (rsyncUrlIsShell) import Logs.Remote import Remote -import Logs.PreferredContent import Types.StandardGroups import Utility.UserInfo +import Utility.Gpg +import Types.Remote (RemoteConfig) +import Git.Remote +import Assistant.WebApp.Utility +import qualified Remote.GCrypt as GCrypt +import Annex.UUID +import Logs.UUID import qualified Data.Text as T import qualified Data.Map as M import Network.Socket +import Data.Ord sshConfigurator :: Widget -> Handler Html sshConfigurator = page "Add a remote server" (Just Configuration) @@ -47,7 +54,7 @@ mkSshData s = SshData (maybe "" T.unpack $ inputDirectory s) , sshPort = inputPort s , needsPubKey = False - , rsyncOnly = False + , sshCapabilities = [] -- untested } mkSshInput :: SshData -> SshInput @@ -81,7 +88,7 @@ sshInputAForm hostnamefield def = SshInput let h = T.unpack t let canonname = Just $ defaultHints { addrFlags = [AI_CANONNAME] } r <- catchMaybeIO $ getAddrInfo canonname (Just h) Nothing - return $ case catMaybes . map addrCanonName <$> r of + return $ case mapMaybe addrCanonName <$> r of -- canonicalize input hostname if it had no dot Just (fullname:_) | '.' `elem` h -> Right t @@ -96,30 +103,27 @@ sshInputAForm hostnamefield def = SshInput data ServerStatus = UntestedServer | UnusableServer Text -- reason why it's not usable - | UsableRsyncServer - | UsableSshInput + | UsableServer [SshServerCapability] deriving (Eq) -usable :: ServerStatus -> Bool -usable UntestedServer = False -usable (UnusableServer _) = False -usable UsableRsyncServer = True -usable UsableSshInput = True +capabilities :: ServerStatus -> [SshServerCapability] +capabilities (UsableServer cs) = cs +capabilities _ = [] getAddSshR :: Handler Html getAddSshR = postAddSshR postAddSshR :: Handler Html postAddSshR = sshConfigurator $ do - u <- liftIO $ T.pack <$> myUserName + username <- liftIO $ T.pack <$> myUserName ((result, form), enctype) <- liftH $ runFormPost $ renderBootstrap $ sshInputAForm textField $ - SshInput Nothing (Just u) Nothing 22 + SshInput Nothing (Just username) Nothing 22 case result of FormSuccess sshinput -> do s <- liftIO $ testServer sshinput case s of Left status -> showform form enctype status - Right sshdata -> liftH $ redirect $ ConfirmSshR sshdata + Right (sshdata, u) -> liftH $ redirect $ ConfirmSshR sshdata u _ -> showform form enctype UntestedServer where showform form enctype status = $(widgetFile "configurators/ssh/add") @@ -127,64 +131,64 @@ postAddSshR = sshConfigurator $ do sshTestModal :: Widget sshTestModal = $(widgetFile "configurators/ssh/testmodal") -{- To enable an existing rsync special remote, parse the SshInput from - - its rsyncurl, and display a form whose only real purpose is to check - - if ssh public keys need to be set up. From there, we can proceed with - - the usual repo setup; all that code is idempotent. - - - - Note that there's no EnableSshR because ssh remotes are not special - - remotes, and so their configuration is not shared between repositories. - -} +sshSetupModal :: SshData -> Widget +sshSetupModal sshdata = $(widgetFile "configurators/ssh/setupmodal") + getEnableRsyncR :: UUID -> Handler Html getEnableRsyncR = postEnableRsyncR postEnableRsyncR :: UUID -> Handler Html -postEnableRsyncR u = do +postEnableRsyncR = enableSpecialSshRemote getsshinput enableRsyncNet enablersync + where + enablersync sshdata u = redirect $ ConfirmSshR + (sshdata { sshCapabilities = [RsyncCapable] }) u + getsshinput = parseSshUrl <=< M.lookup "rsyncurl" + +{- This only handles gcrypt repositories that are located on ssh servers; + - ones on local drives are handled via another part of the UI. -} +getEnableSshGCryptR :: UUID -> Handler Html +getEnableSshGCryptR = postEnableSshGCryptR +postEnableSshGCryptR :: UUID -> Handler Html +postEnableSshGCryptR u = whenGcryptInstalled $ + enableSpecialSshRemote getsshinput enableRsyncNetGCrypt enablegcrypt u + where + enablegcrypt sshdata _ = prepSsh True sshdata $ \sshdata' -> + sshConfigurator $ + checkExistingGCrypt sshdata' $ + error "Expected to find an encrypted git repository, but did not." + getsshinput = parseSshUrl <=< M.lookup "gitrepo" + +{- To enable a special remote that uses ssh as its transport, + - parse a config key to get its url, and display a form whose + - only real purpose is to check if ssh public keys need to be + - set up. + -} +enableSpecialSshRemote :: (RemoteConfig -> Maybe SshData) -> (SshInput -> RemoteName -> Handler Html) -> (SshData -> UUID -> Handler Html) -> UUID -> Handler Html +enableSpecialSshRemote getsshinput rsyncnetsetup genericsetup u = do m <- fromMaybe M.empty . M.lookup u <$> liftAnnex readRemoteLog - case (parseSshRsyncUrl =<< M.lookup "rsyncurl" m, M.lookup "name" m) of + case (mkSshInput . unmangle <$> getsshinput m, M.lookup "name" m) of (Just sshinput, Just reponame) -> sshConfigurator $ do ((result, form), enctype) <- liftH $ runFormPost $ renderBootstrap $ sshInputAForm textField sshinput case result of FormSuccess sshinput' | isRsyncNet (inputHostname sshinput') -> - void $ liftH $ makeRsyncNet sshinput' reponame (const noop) + void $ liftH $ rsyncnetsetup sshinput' reponame | otherwise -> do s <- liftIO $ testServer sshinput' case s of Left status -> showform form enctype status - Right sshdata -> enable sshdata - { sshRepoName = reponame } + Right (sshdata, _u) -> void $ liftH $ genericsetup + ( sshdata { sshRepoName = reponame } ) u _ -> showform form enctype UntestedServer _ -> redirect AddSshR where + unmangle sshdata = sshdata + { sshHostName = T.pack $ unMangleSshHostName $ + T.unpack $ sshHostName sshdata + } showform form enctype status = do description <- liftAnnex $ T.pack <$> prettyUUID u $(widgetFile "configurators/ssh/enable") - enable sshdata = liftH $ redirect $ ConfirmSshR $ - sshdata { rsyncOnly = True } - -{- Converts a rsyncurl value to a SshInput. But only if it's a ssh rsync - - url; rsync:// urls or bare path names are not supported. - - - - The hostname is stored mangled in the remote log for rsync special - - remotes configured by this webapp. So that mangling has to reversed - - here to get back the original hostname. - -} -parseSshRsyncUrl :: String -> Maybe SshInput -parseSshRsyncUrl u - | not (rsyncUrlIsShell u) = Nothing - | otherwise = Just $ SshInput - { inputHostname = val $ unMangleSshHostName host - , inputUsername = if null user then Nothing else val user - , inputDirectory = val dir - , inputPort = 22 - } - where - val = Just . T.pack - (userhost, dir) = separate (== ':') u - (user, host) = if '@' `elem` userhost - then separate (== '@') userhost - else (userhost, "") {- Test if we can ssh into the server. - @@ -193,33 +197,41 @@ parseSshRsyncUrl u - passwordless login is already enabled, use it. Otherwise, - a special ssh key will need to be generated just for this server. - - - Once logged into the server, probe to see if git-annex-shell is - - available, or rsync. Note that, ~/.ssh/git-annex-shell may be + - Once logged into the server, probe to see if git-annex-shell, + - git, and rsync are available. + - Note that, ~/.ssh/git-annex-shell may be - present, while git-annex-shell is not in PATH. + - + - Also probe to see if there is already a git repository at the location + - with either an annex-uuid or a gcrypt-id set. (If not, returns NoUUID.) -} -testServer :: SshInput -> IO (Either ServerStatus SshData) +testServer :: SshInput -> IO (Either ServerStatus (SshData, UUID)) testServer (SshInput { inputHostname = Nothing }) = return $ Left $ UnusableServer "Please enter a host name." testServer sshinput@(SshInput { inputHostname = Just hn }) = do - status <- probe [sshOpt "NumberOfPasswordPrompts" "0"] - if usable status - then ret status False - else do - status' <- probe [] - if usable status' - then ret status' True - else return $ Left status' + (status, u) <- probe [sshOpt "NumberOfPasswordPrompts" "0"] + case capabilities status of + [] -> do + (status', u') <- probe [] + case capabilities status' of + [] -> return $ Left status' + cs -> ret cs True u' + cs -> ret cs False u where - ret status needspubkey = return $ Right $ (mkSshData sshinput) - { needsPubKey = needspubkey - , rsyncOnly = status == UsableRsyncServer - } + ret cs needspubkey u = do + let sshdata = (mkSshData sshinput) + { needsPubKey = needspubkey + , sshCapabilities = cs + } + return $ Right (sshdata, u) probe extraopts = do let remotecommand = shellWrap $ intercalate ";" [ report "loggedin" , checkcommand "git-annex-shell" + , checkcommand "git" , checkcommand "rsync" , checkcommand shim + , getgitconfig (T.unpack <$> inputDirectory sshinput) ] knownhost <- knownHost hn let sshopts = filter (not . null) $ extraopts ++ @@ -235,21 +247,35 @@ testServer sshinput@(SshInput { inputHostname = Just hn }) = do , remotecommand ] parsetranscript . fst <$> sshTranscript sshopts Nothing - parsetranscript s - | reported "git-annex-shell" = UsableSshInput - | reported shim = UsableSshInput - | reported "rsync" = UsableRsyncServer - | reported "loggedin" = UnusableServer - "Neither rsync nor git-annex are installed on the server. Perhaps you should go install them?" - | otherwise = UnusableServer $ T.pack $ - "Failed to ssh to the server. Transcript: " ++ s + parsetranscript s = + let cs = map snd $ filter (reported . fst) + [ ("git-annex-shell", GitAnnexShellCapable) + , (shim, GitAnnexShellCapable) + , ("git", GitCapable) + , ("rsync", RsyncCapable) + ] + u = fromMaybe NoUUID $ headMaybe $ mapMaybe finduuid $ + map (separate (== '=')) $ lines s + in if null cs + then (UnusableServer unusablereason, u) + else (UsableServer cs, u) where reported r = token r `isInfixOf` s + unusablereason = if reported "loggedin" + then "Neither rsync nor git-annex are installed on the server. Perhaps you should go install them?" + else T.pack $ "Failed to ssh to the server. Transcript: " ++ s + finduuid (k, v) + | k == "annex.uuid" = Just $ toUUID v + | k == GCrypt.coreGCryptId = Just $ genUUIDInNameSpace gCryptNameSpace v + | otherwise = Nothing checkcommand c = "if which " ++ c ++ "; then " ++ report c ++ "; fi" token r = "git-annex-probe " ++ r report r = "echo " ++ token r shim = "~/.ssh/git-annex-shell" + getgitconfig (Just d) + | not (null d) = "cd " ++ shellEscape d ++ " && git config --list" + getgitconfig _ = "echo" {- Runs a ssh command; if it fails shows the user the transcript, - and if it succeeds, runs an action. -} @@ -264,54 +290,124 @@ showSshErr :: String -> Handler Html showSshErr msg = sshConfigurator $ $(widgetFile "configurators/ssh/error") -getConfirmSshR :: SshData -> Handler Html -getConfirmSshR sshdata = sshConfigurator $ - $(widgetFile "configurators/ssh/confirm") +{- The UUID will be NoUUID when the repository does not already exist. -} +getConfirmSshR :: SshData -> UUID -> Handler Html +getConfirmSshR sshdata u + | u == NoUUID = handlenew + | otherwise = handleexisting =<< (M.lookup u <$> liftAnnex uuidMap) + where + handlenew = sshConfigurator $ do + secretkeys <- sortBy (comparing snd) . M.toList + <$> liftIO secretKeys + $(widgetFile "configurators/ssh/confirm") + handleexisting Nothing = sshConfigurator $ + -- Not a UUID we know, so prompt about combining. + $(widgetFile "configurators/ssh/combine") + handleexisting (Just _) = prepSsh False sshdata $ \sshdata' -> do + m <- liftAnnex readRemoteLog + case M.lookup "type" =<< M.lookup u m of + Just "gcrypt" -> combineExistingGCrypt sshdata' u + -- This handles enabling git repositories + -- that already exist. + _ -> makeSshRepo sshdata' + +{- The user has confirmed they want to combine with a ssh repository, + - which is not known to us. So it might be using gcrypt. -} +getCombineSshR :: SshData -> Handler Html +getCombineSshR sshdata = prepSsh False sshdata $ \sshdata' -> + sshConfigurator $ + checkExistingGCrypt sshdata' $ + void $ liftH $ makeSshRepo sshdata' getRetrySshR :: SshData -> Handler () getRetrySshR sshdata = do s <- liftIO $ testServer $ mkSshInput sshdata - redirect $ either (const $ ConfirmSshR sshdata) ConfirmSshR s + redirect $ either (const $ ConfirmSshR sshdata NoUUID) (uncurry ConfirmSshR) s getMakeSshGitR :: SshData -> Handler Html -getMakeSshGitR = makeSsh False setupGroup +getMakeSshGitR sshdata = prepSsh False sshdata makeSshRepo getMakeSshRsyncR :: SshData -> Handler Html -getMakeSshRsyncR = makeSsh True setupGroup +getMakeSshRsyncR sshdata = prepSsh False (rsyncOnly sshdata) makeSshRepo -makeSsh :: Bool -> (Remote -> Handler ()) -> SshData -> Handler Html -makeSsh rsync setup sshdata +rsyncOnly :: SshData -> SshData +rsyncOnly sshdata = sshdata { sshCapabilities = [RsyncCapable] } + +getMakeSshGCryptR :: SshData -> RepoKey -> Handler Html +getMakeSshGCryptR sshdata NoRepoKey = whenGcryptInstalled $ + withNewSecretKey $ getMakeSshGCryptR sshdata . RepoKey +getMakeSshGCryptR sshdata (RepoKey keyid) = whenGcryptInstalled $ + prepSsh True sshdata $ makeGCryptRepo keyid + +{- Detect if the user entered a location with an existing, known + - gcrypt repository, and enable it. Otherwise, runs the action. -} +checkExistingGCrypt :: SshData -> Widget -> Widget +checkExistingGCrypt sshdata nope = ifM (liftIO isGcryptInstalled) + ( checkGCryptRepoEncryption repourl nope $ do + mu <- liftAnnex $ probeGCryptRemoteUUID repourl + case mu of + Just u -> void $ liftH $ + combineExistingGCrypt sshdata u + Nothing -> error "The location contains a gcrypt repository that is not a git-annex special remote. This is not supported." + , nope + ) + where + repourl = genSshUrl sshdata + +{- Enables an existing gcrypt special remote. -} +enableGCrypt :: SshData -> RemoteName -> Handler Html +enableGCrypt sshdata reponame = + setupCloudRemote TransferGroup Nothing $ + enableSpecialRemote reponame GCrypt.remote $ M.fromList + [("gitrepo", genSshUrl sshdata)] + +{- Combining with a gcrypt repository that may not be + - known in remote.log, so probe the gcrypt repo. -} +combineExistingGCrypt :: SshData -> UUID -> Handler Html +combineExistingGCrypt sshdata u = do + reponame <- liftAnnex $ getGCryptRemoteName u repourl + enableGCrypt sshdata reponame + where + repourl = genSshUrl sshdata + +{- Sets up remote repository for ssh, or directory for rsync. -} +prepSsh :: Bool -> SshData -> (SshData -> Handler Html) -> Handler Html +prepSsh newgcrypt sshdata a | needsPubKey sshdata = do keypair <- liftIO genSshKeyPair sshdata' <- liftIO $ setupSshKeyPair keypair sshdata - makeSsh' rsync setup sshdata sshdata' (Just keypair) + prepSsh' newgcrypt sshdata sshdata' (Just keypair) a | sshPort sshdata /= 22 = do sshdata' <- liftIO $ setSshConfig sshdata [] - makeSsh' rsync setup sshdata sshdata' Nothing - | otherwise = makeSsh' rsync setup sshdata sshdata Nothing + prepSsh' newgcrypt sshdata sshdata' Nothing a + | otherwise = prepSsh' newgcrypt sshdata sshdata Nothing a -makeSsh' :: Bool -> (Remote -> Handler ()) -> SshData -> SshData -> Maybe SshKeyPair -> Handler Html -makeSsh' rsync setup origsshdata sshdata keypair = do - sshSetup ["-p", show (sshPort origsshdata), sshhost, remoteCommand] "" $ - makeSshRepo rsync setup sshdata +prepSsh' :: Bool -> SshData -> SshData -> Maybe SshKeyPair -> (SshData -> Handler Html) -> Handler Html +prepSsh' newgcrypt origsshdata sshdata keypair a = sshSetup + [ "-p", show (sshPort origsshdata) + , genSshHost (sshHostName origsshdata) (sshUserName origsshdata) + , remoteCommand + ] "" (a sshdata) where - sshhost = genSshHost (sshHostName origsshdata) (sshUserName origsshdata) remotedir = T.unpack $ sshDirectory sshdata remoteCommand = shellWrap $ intercalate "&&" $ catMaybes [ Just $ "mkdir -p " ++ shellEscape remotedir , Just $ "cd " ++ shellEscape remotedir - , if rsync then Nothing else Just "if [ ! -d .git ]; then git init --bare --shared; fi" - , if rsync then Nothing else Just "git annex init" - , if needsPubKey sshdata - then addAuthorizedKeysCommand (rsync || rsyncOnly sshdata) remotedir . sshPubKey <$> keypair + , if rsynconly then Nothing else Just "if [ ! -d .git ]; then git init --bare --shared; fi" + , if rsynconly || newgcrypt then Nothing else Just "git annex init" + , if needsPubKey origsshdata + then addAuthorizedKeysCommand (hasCapability origsshdata GitAnnexShellCapable) remotedir . sshPubKey <$> keypair else Nothing ] + rsynconly = onlyCapability origsshdata RsyncCapable -makeSshRepo :: Bool -> (Remote -> Handler ()) -> SshData -> Handler Html -makeSshRepo forcersync setup sshdata = do - r <- liftAssistant $ makeSshRemote forcersync sshdata Nothing - setup r - redirect $ EditNewCloudRepositoryR $ Remote.uuid r +makeSshRepo :: SshData -> Handler Html +makeSshRepo sshdata = setupCloudRemote TransferGroup Nothing $ + makeSshRemote sshdata + +makeGCryptRepo :: KeyId -> SshData -> Handler Html +makeGCryptRepo keyid sshdata = setupCloudRemote TransferGroup Nothing $ + makeGCryptRemote (sshRepoName sshdata) (genSshUrl sshdata) keyid getAddRsyncNetR :: Handler Html getAddRsyncNetR = postAddRsyncNetR @@ -320,19 +416,18 @@ postAddRsyncNetR = do ((result, form), enctype) <- runFormPost $ renderBootstrap $ sshInputAForm hostnamefield $ SshInput Nothing Nothing Nothing 22 - let showform status = page "Add a Rsync.net repository" (Just Configuration) $ - $(widgetFile "configurators/addrsync.net") + let showform status = inpage $ + $(widgetFile "configurators/rsync.net/add") case result of FormSuccess sshinput - | isRsyncNet (inputHostname sshinput) -> do - let reponame = genSshRepoName "rsync.net" - (maybe "" T.unpack $ inputDirectory sshinput) - makeRsyncNet sshinput reponame setupGroup + | isRsyncNet (inputHostname sshinput) -> + go sshinput | otherwise -> showform $ UnusableServer "That is not a rsync.net host name." _ -> showform UntestedServer where + inpage = page "Add a Rsync.net repository" (Just Configuration) hostnamefield = textField `withExpandableNote` ("Help", help) help = [whamlet|
    @@ -342,16 +437,51 @@ postAddRsyncNetR = do The host name will be something like "usw-s001.rsync.net", and the # user name something like "7491" |] + go sshinput = do + let reponame = genSshRepoName "rsync.net" + (maybe "" T.unpack $ inputDirectory sshinput) + prepRsyncNet sshinput reponame $ \sshdata -> inpage $ + checkExistingGCrypt sshdata $ do + secretkeys <- sortBy (comparing snd) . M.toList + <$> liftIO secretKeys + $(widgetFile "configurators/rsync.net/encrypt") -makeRsyncNet :: SshInput -> String -> (Remote -> Handler ()) -> Handler Html -makeRsyncNet sshinput reponame setup = do +getMakeRsyncNetSharedR :: SshData -> Handler Html +getMakeRsyncNetSharedR = makeSshRepo . rsyncOnly + +{- Make a gcrypt special remote on rsync.net. -} +getMakeRsyncNetGCryptR :: SshData -> RepoKey -> Handler Html +getMakeRsyncNetGCryptR sshdata NoRepoKey = whenGcryptInstalled $ + withNewSecretKey $ getMakeRsyncNetGCryptR sshdata . RepoKey +getMakeRsyncNetGCryptR sshdata (RepoKey keyid) = whenGcryptInstalled $ + sshSetup [sshhost, gitinit] [] $ makeGCryptRepo keyid sshdata + where + sshhost = genSshHost (sshHostName sshdata) (sshUserName sshdata) + gitinit = "git init --bare " ++ T.unpack (sshDirectory sshdata) + +enableRsyncNet :: SshInput -> String -> Handler Html +enableRsyncNet sshinput reponame = + prepRsyncNet sshinput reponame $ makeSshRepo . rsyncOnly + +enableRsyncNetGCrypt :: SshInput -> RemoteName -> Handler Html +enableRsyncNetGCrypt sshinput reponame = + prepRsyncNet sshinput reponame $ \sshdata -> + checkGCryptRepoEncryption (genSshUrl sshdata) notencrypted $ + enableGCrypt sshdata reponame + where + notencrypted = error "Unexpectedly found a non-encrypted git repository, instead of the expected encrypted git repository." + +{- Prepares rsync.net ssh key, and if successful, runs an action with + - its SshData. -} +prepRsyncNet :: SshInput -> String -> (SshData -> Handler Html) -> Handler Html +prepRsyncNet sshinput reponame a = do knownhost <- liftIO $ maybe (return False) knownHost (inputHostname sshinput) - keypair <- liftIO $ genSshKeyPair + keypair <- liftIO genSshKeyPair sshdata <- liftIO $ setupSshKeyPair keypair $ (mkSshData sshinput) { sshRepoName = reponame , needsPubKey = True - , rsyncOnly = True + , sshCapabilities = [RsyncCapable] } {- I'd prefer to separate commands with && , but - rsync.net's shell does not support that. @@ -371,12 +501,8 @@ makeRsyncNet sshinput reponame setup = do , genSshHost (sshHostName sshdata) (sshUserName sshdata) , remotecommand ] - sshSetup sshopts (sshPubKey keypair) $ - makeSshRepo True setup sshdata + sshSetup sshopts (sshPubKey keypair) $ a sshdata isRsyncNet :: Maybe Text -> Bool isRsyncNet Nothing = False isRsyncNet (Just host) = ".rsync.net" `T.isSuffixOf` T.toLower host - -setupGroup :: Remote -> Handler () -setupGroup r = liftAnnex $ setStandardGroup (Remote.uuid r) TransferGroup diff --git a/Assistant/WebApp/Configurators/WebDAV.hs b/Assistant/WebApp/Configurators/WebDAV.hs index 027abdf78d..6dd5b6ffb7 100644 --- a/Assistant/WebApp/Configurators/WebDAV.hs +++ b/Assistant/WebApp/Configurators/WebDAV.hs @@ -5,7 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, OverloadedStrings #-} +{-# LANGUAGE CPP, TemplateHaskell, OverloadedStrings #-} module Assistant.WebApp.Configurators.WebDAV where @@ -14,12 +14,13 @@ import Creds #ifdef WITH_WEBDAV import qualified Remote.WebDAV as WebDAV import Assistant.MakeRemote -import Assistant.Sync import qualified Remote import Types.Remote (RemoteConfig) import Types.StandardGroups -import Logs.PreferredContent import Logs.Remote +import Assistant.Gpg +import Assistant.WebApp.Utility +import Git.Remote import qualified Data.Map as M #endif @@ -69,7 +70,7 @@ postAddBoxComR = boxConfigurator $ do runFormPost $ renderBootstrap $ boxComAForm defcreds case result of FormSuccess input -> liftH $ - makeWebDavRemote initSpecialRemote "box.com" (toCredPair input) setgroup $ M.fromList + makeWebDavRemote initSpecialRemote "box.com" (toCredPair input) $ M.fromList [ configureEncryption $ enableEncryption input , ("embedcreds", if embedCreds input then "yes" else "no") , ("type", "webdav") @@ -80,9 +81,6 @@ postAddBoxComR = boxConfigurator $ do , ("chunksize", "10mb") ] _ -> $(widgetFile "configurators/addbox.com") - where - setgroup r = liftAnnex $ - setStandardGroup (Remote.uuid r) TransferGroup #else postAddBoxComR = error "WebDAV not supported by this build" #endif @@ -100,7 +98,7 @@ postEnableWebDAVR uuid = do getRemoteCredPairFor "webdav" c (WebDAV.davCreds uuid) case mcreds of Just creds -> webDAVConfigurator $ liftH $ - makeWebDavRemote enableSpecialRemote name creds (const noop) M.empty + makeWebDavRemote enableSpecialRemote name creds M.empty Nothing | "box.com/" `isInfixOf` url -> boxConfigurator $ showform name url @@ -115,7 +113,7 @@ postEnableWebDAVR uuid = do runFormPost $ renderBootstrap $ webDAVCredsAForm defcreds case result of FormSuccess input -> liftH $ - makeWebDavRemote enableSpecialRemote name (toCredPair input) (const noop) M.empty + makeWebDavRemote enableSpecialRemote name (toCredPair input) M.empty _ -> do description <- liftAnnex $ T.pack <$> Remote.prettyUUID uuid @@ -125,13 +123,11 @@ postEnableWebDAVR _ = error "WebDAV not supported by this build" #endif #ifdef WITH_WEBDAV -makeWebDavRemote :: SpecialRemoteMaker -> String -> CredPair -> (Remote -> Handler ()) -> RemoteConfig -> Handler () -makeWebDavRemote maker name creds setup config = do +makeWebDavRemote :: SpecialRemoteMaker -> RemoteName -> CredPair -> RemoteConfig -> Handler () +makeWebDavRemote maker name creds config = do liftIO $ WebDAV.setCredsEnv creds - r <- liftAnnex $ addRemote $ maker name WebDAV.remote config - setup r - liftAssistant $ syncRemote r - redirect $ EditNewCloudRepositoryR $ Remote.uuid r + setupCloudRemote TransferGroup Nothing $ + maker name WebDAV.remote config {- Only returns creds previously used for the same hostname. -} previouslyUsedWebDAVCreds :: String -> Annex (Maybe CredPair) diff --git a/Assistant/WebApp/Configurators/XMPP.hs b/Assistant/WebApp/Configurators/XMPP.hs index d2bc8d8a55..4910a27c6e 100644 --- a/Assistant/WebApp/Configurators/XMPP.hs +++ b/Assistant/WebApp/Configurators/XMPP.hs @@ -151,6 +151,8 @@ buddyListDisplay = do catMaybes . map (buddySummary pairedwith) <$> (getBuddyList <<~ buddyList) $(widgetFile "configurators/xmpp/buddylist") +#else + noop #endif where ident = "buddylist" diff --git a/Assistant/WebApp/DashBoard.hs b/Assistant/WebApp/DashBoard.hs index 1099f0cb0e..86460461fe 100644 --- a/Assistant/WebApp/DashBoard.hs +++ b/Assistant/WebApp/DashBoard.hs @@ -52,7 +52,7 @@ simplifyTransfers [] = [] simplifyTransfers (x:[]) = [x] simplifyTransfers (v@(t1, _):r@((t2, _):l)) | equivilantTransfer t1 t2 = simplifyTransfers (v:l) - | otherwise = v : (simplifyTransfers r) + | otherwise = v : simplifyTransfers r {- Called by client to get a display of currently in process transfers. - @@ -78,7 +78,7 @@ dashboard warnNoScript = do $(widgetFile "dashboard/main") getDashboardR :: Handler Html -getDashboardR = ifM (inFirstRun) +getDashboardR = ifM inFirstRun ( redirect ConfigurationR , page "" (Just DashBoard) $ dashboard True ) @@ -107,7 +107,7 @@ postFileBrowserR = void openFileBrowser {- Used by non-javascript browsers, where clicking on the link actually - opens this page, so we redirect back to the referrer. -} getFileBrowserR :: Handler () -getFileBrowserR = whenM openFileBrowser $ redirectBack +getFileBrowserR = whenM openFileBrowser redirectBack {- Opens the system file browser on the repo, or, as a fallback, - goes to a file:// url. Returns True if it's ok to redirect away @@ -137,14 +137,17 @@ openFileBrowser = do {- Transfer controls. The GET is done in noscript mode and redirects back - to the referring page. The POST is called by javascript. -} getPauseTransferR :: Transfer -> Handler () -getPauseTransferR t = pauseTransfer t >> redirectBack +getPauseTransferR = noscript postPauseTransferR postPauseTransferR :: Transfer -> Handler () -postPauseTransferR t = pauseTransfer t +postPauseTransferR = pauseTransfer getStartTransferR :: Transfer -> Handler () -getStartTransferR t = startTransfer t >> redirectBack +getStartTransferR = noscript postStartTransferR postStartTransferR :: Transfer -> Handler () -postStartTransferR t = startTransfer t +postStartTransferR = startTransfer getCancelTransferR :: Transfer -> Handler () -getCancelTransferR t = cancelTransfer False t >> redirectBack +getCancelTransferR = noscript postCancelTransferR postCancelTransferR :: Transfer -> Handler () -postCancelTransferR t = cancelTransfer False t +postCancelTransferR = cancelTransfer False + +noscript :: (Transfer -> Handler ()) -> Transfer -> Handler () +noscript a t = a t >> redirectBack diff --git a/Assistant/WebApp/Documentation.hs b/Assistant/WebApp/Documentation.hs index 5bdb718510..f0e0703f20 100644 --- a/Assistant/WebApp/Documentation.hs +++ b/Assistant/WebApp/Documentation.hs @@ -38,5 +38,5 @@ getLicenseR = do $(widgetFile "documentation/license") getRepoGroupR :: Handler Html -getRepoGroupR = page "About repository groups" (Just About) $ do +getRepoGroupR = page "About repository groups" (Just About) $ $(widgetFile "documentation/repogroup") diff --git a/Assistant/WebApp/Form.hs b/Assistant/WebApp/Form.hs index 31f7339f22..3446e4fdee 100644 --- a/Assistant/WebApp/Form.hs +++ b/Assistant/WebApp/Form.hs @@ -12,8 +12,8 @@ module Assistant.WebApp.Form where -import Types.Remote (RemoteConfigKey) import Assistant.WebApp.Types +import Assistant.Gpg import Yesod hiding (textField, passwordField) import Yesod.Form.Fields as F @@ -75,9 +75,6 @@ withExpandableNote field (toggle, note) = withNote field $ [whamlet| where ident = "toggle_" ++ toggle -data EnableEncryption = HybridEncryption | SharedEncryption | NoEncryption - deriving (Eq) - {- Adds a check box to an AForm to control encryption. -} #if MIN_VERSION_yesod(1,2,0) enableEncryptionField :: (RenderMessage site FormMessage) => AForm (HandlerT site IO) EnableEncryption @@ -91,9 +88,3 @@ enableEncryptionField = areq (selectFieldList choices) "Encryption" (Just Shared [ ("Encrypt all data", SharedEncryption) , ("Disable encryption", NoEncryption) ] - -{- Generates Remote configuration for encryption. -} -configureEncryption :: EnableEncryption -> (RemoteConfigKey, String) -configureEncryption SharedEncryption = ("encryption", "shared") -configureEncryption NoEncryption = ("encryption", "none") -configureEncryption HybridEncryption = ("encryption", "hybrid") diff --git a/Assistant/WebApp/Gpg.hs b/Assistant/WebApp/Gpg.hs index d549547011..1f6b5cb187 100644 --- a/Assistant/WebApp/Gpg.hs +++ b/Assistant/WebApp/Gpg.hs @@ -5,17 +5,19 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE QuasiQuotes, TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-} module Assistant.WebApp.Gpg where import Assistant.WebApp.Common +import Assistant.Gpg import Utility.Gpg -import Utility.UserInfo import qualified Git.Command import qualified Git.Remote +import qualified Git.Construct import qualified Annex.Branch import qualified Git.GCrypt +import qualified Remote.GCrypt as GCrypt import Assistant.MakeRemote import Logs.Remote @@ -25,27 +27,28 @@ gpgKeyDisplay :: KeyId -> Maybe UserId -> Widget gpgKeyDisplay keyid userid = [whamlet| # - ^{displayname} + $maybe name <- userid + #{name} + $nothing + key id #{keyid} |] - where - displayname = case userid of - Just name | not (null name) -> [whamlet|#{name}|] - _ -> [whamlet|key id #{keyid}|] -{- Generates a gpg user id that is not used by any existing secret key -} -newUserId :: IO UserId -newUserId = do - oldkeys <- secretKeys - username <- myUserName - let basekeyname = username ++ "'s git-annex encryption key" - return $ Prelude.head $ filter (\n -> M.null $ M.filter (== n) oldkeys) - ( basekeyname - : map (\n -> basekeyname ++ show n) ([2..] :: [Int]) - ) +genKeyModal :: Widget +genKeyModal = $(widgetFile "configurators/genkeymodal") + +isGcryptInstalled :: IO Bool +isGcryptInstalled = inPath "git-remote-gcrypt" + +whenGcryptInstalled :: Handler Html -> Handler Html +whenGcryptInstalled a = ifM (liftIO isGcryptInstalled) + ( a + , page "Need git-remote-gcrypt" (Just Configuration) $ + $(widgetFile "configurators/needgcrypt") + ) withNewSecretKey :: (KeyId -> Handler Html) -> Handler Html withNewSecretKey use = do - userid <- liftIO $ newUserId + userid <- liftIO newUserId liftIO $ genSecretKey RSA "" userid maxRecommendedKeySize results <- M.keys . M.filter (== userid) <$> liftIO secretKeys case results of @@ -60,16 +63,34 @@ withNewSecretKey use = do - branch from the gcrypt remote and merges it in, and then looks up - the name. -} -getGCryptRemoteName :: UUID -> String -> Annex (Maybe Git.Remote.RemoteName) +getGCryptRemoteName :: UUID -> String -> Annex Git.Remote.RemoteName getGCryptRemoteName u repoloc = do tmpremote <- uniqueRemoteName "tmpgcryptremote" 0 <$> gitRepo void $ inRepo $ Git.Command.runBool [Params "remote add", Param tmpremote, Param $ Git.GCrypt.urlPrefix ++ repoloc] mname <- ifM (inRepo $ Git.Command.runBool [Param "fetch", Param tmpremote]) ( do - void $ Annex.Branch.forceUpdate + void Annex.Branch.forceUpdate (M.lookup "name" <=< M.lookup u) <$> readRemoteLog , return Nothing ) void $ inRepo $ Git.Remote.remove tmpremote - return mname + maybe missing return mname + where + missing = error $ "Cannot find configuration for the gcrypt remote at " ++ repoloc + +checkGCryptRepoEncryption :: (Monad m, LiftAnnex m) => String -> m a -> m a -> m a +checkGCryptRepoEncryption location notencrypted encrypted = + dispatch =<< liftAnnex (inRepo $ Git.GCrypt.probeRepo location) + where + dispatch Git.GCrypt.Decryptable = encrypted + dispatch Git.GCrypt.NotEncrypted = notencrypted + dispatch Git.GCrypt.NotDecryptable = + error "This git repository is encrypted with a GnuPG key that you do not have." + +{- Gets the UUID of the gcrypt repo at a location, which may not exist. + - Only works if the gcrypt repo was created as a git-annex remote. -} +probeGCryptRemoteUUID :: String -> Annex (Maybe UUID) +probeGCryptRemoteUUID repolocation = do + r <- inRepo $ Git.Construct.fromRemoteLocation repolocation + GCrypt.getGCryptUUID False r diff --git a/Assistant/WebApp/Notifications.hs b/Assistant/WebApp/Notifications.hs index b9da401781..6749abb723 100644 --- a/Assistant/WebApp/Notifications.hs +++ b/Assistant/WebApp/Notifications.hs @@ -80,7 +80,7 @@ getNotifierBuddyListR = notifierUrl BuddyListR getBuddyListBroadcaster getNotifierRepoListR :: RepoSelector -> Handler RepPlain getNotifierRepoListR reposelector = notifierUrl route getRepoListBroadcaster where - route nid = RepoListR $ RepoListNotificationId nid reposelector + route nid = RepoListR nid reposelector getTransferBroadcaster :: Assistant NotificationBroadcaster getTransferBroadcaster = transferNotifier <$> getDaemonStatus diff --git a/Assistant/WebApp/OtherRepos.hs b/Assistant/WebApp/OtherRepos.hs index 5219e8712f..cc1207934a 100644 --- a/Assistant/WebApp/OtherRepos.hs +++ b/Assistant/WebApp/OtherRepos.hs @@ -56,7 +56,7 @@ getSwitchToRepositoryR repo = do ( return url , delayed $ waiturl urlfile ) - listening url = catchBoolIO $ fst <$> Url.exists url [] + listening url = catchBoolIO $ fst <$> Url.exists url [] Nothing delayed a = do threadDelay 100000 -- 1/10th of a second a diff --git a/Assistant/WebApp/Page.hs b/Assistant/WebApp/Page.hs index 8a6828d587..b258fd4593 100644 --- a/Assistant/WebApp/Page.hs +++ b/Assistant/WebApp/Page.hs @@ -38,7 +38,7 @@ firstRunNavBar :: [NavBarItem] firstRunNavBar = [Configuration, About] selectNavBar :: Handler [NavBarItem] -selectNavBar = ifM (inFirstRun) (return firstRunNavBar, return defaultNavBar) +selectNavBar = ifM inFirstRun (return firstRunNavBar, return defaultNavBar) {- A standard page of the webapp, with a title, a sidebar, and that may - be highlighted on the navbar. -} diff --git a/Assistant/WebApp/RepoList.hs b/Assistant/WebApp/RepoList.hs index 9b90a4d563..88169d0ba3 100644 --- a/Assistant/WebApp/RepoList.hs +++ b/Assistant/WebApp/RepoList.hs @@ -24,8 +24,10 @@ import Logs.Trust import Logs.Group import Config import Git.Config +import Git.Remote import Assistant.Sync import Config.Cost +import Utility.NotificationBroadcaster import qualified Git #ifdef WITH_XMPP #endif @@ -33,6 +35,7 @@ import qualified Git import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Text as T +import Data.Function data Actions = DisabledRepoActions @@ -82,8 +85,8 @@ notWanted _ = False - - Returns a div, which will be inserted into the calling page. -} -getRepoListR :: RepoListNotificationId -> Handler Html -getRepoListR (RepoListNotificationId nid reposelector) = do +getRepoListR :: NotificationId -> RepoSelector -> Handler Html +getRepoListR nid reposelector = do waitNotifier getRepoListBroadcaster nid p <- widgetToPageContent $ repoListDisplay reposelector giveUrlRenderer $ [hamlet|^{pageBody p}|] @@ -98,7 +101,7 @@ mainRepoSelector = RepoSelector {- List of cloud repositories, configured and not. -} cloudRepoList :: Widget -cloudRepoList = repoListDisplay $ RepoSelector +cloudRepoList = repoListDisplay RepoSelector { onlyCloud = True , onlyConfigured = False , includeHere = False @@ -156,9 +159,10 @@ repoList reposelector else return l unconfigured = liftAnnex $ do m <- readRemoteLog + g <- gitRepo map snd . catMaybes . filter selectedremote - . map (findinfo m) - <$> (trustExclude DeadTrusted $ M.keys m) + . map (findinfo m g) + <$> trustExclude DeadTrusted (M.keys m) selectedrepo r | Remote.readonly r = False | onlyCloud reposelector = Git.repoIsUrl (Remote.repo r) && not (isXMPPRemote r) @@ -167,7 +171,7 @@ repoList reposelector selectedremote (Just (iscloud, _)) | onlyCloud reposelector = iscloud | otherwise = True - findinfo m u = case M.lookup "type" =<< M.lookup u m of + findinfo m g u = case getconfig "type" of Just "rsync" -> val True EnableRsyncR Just "directory" -> val False EnableDirectoryR #ifdef WITH_S3 @@ -177,11 +181,19 @@ repoList reposelector #ifdef WITH_WEBDAV Just "webdav" -> val True EnableWebDAVR #endif + Just "gcrypt" -> + -- Skip gcrypt repos on removable drives; + -- handled separately. + case getconfig "gitrepo" of + Just rr | remoteLocationIsUrl (parseRemoteLocation rr g) -> + val True EnableSshGCryptR + _ -> Nothing _ -> Nothing where + getconfig k = M.lookup k =<< M.lookup u m val iscloud r = Just (iscloud, (u, DisabledRepoActions $ r u)) list l = liftAnnex $ do - let l' = nubBy (\x y -> fst x == fst y) l + let l' = nubBy ((==) `on` fst) l l'' <- zip <$> Remote.prettyListUUIDs (map fst l') <*> pure l' @@ -247,7 +259,7 @@ getRetryUnfinishedRepositoriesR = do redirect DashboardR where unstall r = do - liftIO $ fixSshKeyPair + liftIO fixSshKeyPair liftAnnex $ setConfig (remoteConfig (Remote.repo r) "ignore") (boolConfig False) diff --git a/Assistant/WebApp/Types.hs b/Assistant/WebApp/Types.hs index 17e7c89b30..618a8dece2 100644 --- a/Assistant/WebApp/Types.hs +++ b/Assistant/WebApp/Types.hs @@ -150,9 +150,6 @@ data RepoSelector = RepoSelector } deriving (Read, Show, Eq) -data RepoListNotificationId = RepoListNotificationId NotificationId RepoSelector - deriving (Read, Show, Eq) - data RemovableDrive = RemovableDrive { diskFree :: Maybe Integer , mountPoint :: Text @@ -163,15 +160,6 @@ data RemovableDrive = RemovableDrive data RepoKey = RepoKey KeyId | NoRepoKey deriving (Read, Show, Eq, Ord) -{- Only needed to work around old-yesod bug that emits a warning message - - when a route has two parameters. -} -data FilePathAndUUID = FilePathAndUUID FilePath UUID - deriving (Read, Show, Eq) - -instance PathPiece FilePathAndUUID where - toPathPiece = pack . show - fromPathPiece = readish . unpack - instance PathPiece RemovableDrive where toPathPiece = pack . show fromPathPiece = readish . unpack @@ -216,10 +204,6 @@ instance PathPiece PairKey where toPathPiece = pack . show fromPathPiece = readish . unpack -instance PathPiece RepoListNotificationId where - toPathPiece = pack . show - fromPathPiece = readish . unpack - instance PathPiece RepoSelector where toPathPiece = pack . show fromPathPiece = readish . unpack diff --git a/Assistant/WebApp/Utility.hs b/Assistant/WebApp/Utility.hs index 027fc26544..fa83631a07 100644 --- a/Assistant/WebApp/Utility.hs +++ b/Assistant/WebApp/Utility.hs @@ -20,19 +20,25 @@ import qualified Remote.List as Remote import qualified Assistant.Threads.Transferrer as Transferrer import Logs.Transfer import qualified Config +import Config.Cost import Config.Files import Git.Config import Assistant.Threads.Watcher import Assistant.NamedThread +import Types.StandardGroups +import Git.Remote +import Logs.PreferredContent +import Assistant.MakeRemote import qualified Data.Map as M import Control.Concurrent import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL) import System.Posix.Process (getProcessGroupIDOf) +import Utility.Yesod {- Use Nothing to change autocommit setting; or a remote to change - its sync setting. -} -changeSyncable :: (Maybe Remote) -> Bool -> Handler () +changeSyncable :: Maybe Remote -> Bool -> Handler () changeSyncable Nothing enable = do liftAnnex $ Config.setConfig key (boolConfig enable) liftIO . maybe noop (`throwTo` signal) @@ -47,7 +53,7 @@ changeSyncable (Just r) True = do liftAssistant $ syncRemote r changeSyncable (Just r) False = do changeSyncFlag r False - liftAssistant $ updateSyncRemotes + liftAssistant updateSyncRemotes {- Stop all transfers to or from this remote. - XXX Can't stop any ongoing scan, or git syncs. -} void $ liftAssistant $ dequeueTransfers tofrom @@ -60,7 +66,7 @@ changeSyncable (Just r) False = do changeSyncFlag :: Remote -> Bool -> Handler () changeSyncFlag r enabled = liftAnnex $ do Config.setConfig key (boolConfig enabled) - void $ Remote.remoteListRefresh + void Remote.remoteListRefresh where key = Config.remoteConfig (Remote.repo r) "sync" @@ -118,3 +124,15 @@ startTransfer t = do getCurrentTransfers :: Handler TransferMap getCurrentTransfers = currentTransfers <$> liftAssistant getDaemonStatus + +{- Runs an action that creates or enables a cloud remote, + - and finishes setting it up, then starts syncing with it, + - and finishes by displaying the page to edit it. -} +setupCloudRemote :: StandardGroup -> Maybe Cost -> Annex RemoteName -> Handler a +setupCloudRemote defaultgroup mcost maker = do + r <- liftAnnex $ addRemote maker + liftAnnex $ do + setStandardGroup (Remote.uuid r) defaultgroup + maybe noop (Config.setRemoteCost r) mcost + liftAssistant $ syncRemote r + redirect $ EditNewCloudRepositoryR $ Remote.uuid r diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes index 0b78e4f623..97540f9a66 100644 --- a/Assistant/WebApp/routes +++ b/Assistant/WebApp/routes @@ -26,7 +26,7 @@ /config/repository/new/androidcamera AndroidCameraRepositoryR GET /config/repository/switcher RepositorySwitcherR GET /config/repository/switchto/#FilePath SwitchToRepositoryR GET -/config/repository/combine/#FilePathAndUUID CombineRepositoryR GET +/config/repository/combine/#FilePath/#UUID CombineRepositoryR GET /config/repository/edit/#UUID EditRepositoryR GET POST /config/repository/edit/new/#UUID EditNewRepositoryR GET POST /config/repository/edit/new/cloud/#UUID EditNewCloudRepositoryR GET POST @@ -40,11 +40,15 @@ /config/repository/add/drive/genkey/#RemovableDrive GenKeyForDriveR GET /config/repository/add/drive/finish/#RemovableDrive/#RepoKey FinishAddDriveR GET /config/repository/add/ssh AddSshR GET POST -/config/repository/add/ssh/confirm/#SshData ConfirmSshR GET +/config/repository/add/ssh/confirm/#SshData/#UUID ConfirmSshR GET /config/repository/add/ssh/retry/#SshData RetrySshR GET /config/repository/add/ssh/make/git/#SshData MakeSshGitR GET /config/repository/add/ssh/make/rsync/#SshData MakeSshRsyncR GET +/config/repository/add/ssh/make/gcrypt/#SshData/#RepoKey MakeSshGCryptR GET +/config/repository/add/ssh/combine/#SshData CombineSshR GET /config/repository/add/cloud/rsync.net AddRsyncNetR GET POST +/config/repository/add/cloud/rsync.net/shared/#SshData MakeRsyncNetSharedR GET +/config/repository/add/cloud/rsync.net/gcrypt/#SshData/#RepoKey MakeRsyncNetGCryptR GET /config/repository/add/cloud/S3 AddS3R GET POST /config/repository/add/cloud/IA AddIAR GET POST /config/repository/add/cloud/glacier AddGlacierR GET POST @@ -63,6 +67,7 @@ /config/repository/pair/xmpp/friend/finish/#PairKey FinishXMPPPairFriendR GET /config/repository/enable/rsync/#UUID EnableRsyncR GET POST +/config/repository/enable/gcrypt/#UUID EnableSshGCryptR GET POST /config/repository/enable/directory/#UUID EnableDirectoryR GET /config/repository/enable/S3/#UUID EnableS3R GET POST /config/repository/enable/IA/#UUID EnableIAR GET POST @@ -87,7 +92,7 @@ /buddylist/#NotificationId BuddyListR GET /notifier/buddylist NotifierBuddyListR GET -/repolist/#RepoListNotificationId RepoListR GET +/repolist/#NotificationId/#RepoSelector RepoListR GET /notifier/repolist/#RepoSelector NotifierRepoListR GET /alert/close/#AlertId CloseAlert GET diff --git a/Backend.hs b/Backend.hs index 2ee14acc61..38314687a5 100644 --- a/Backend.hs +++ b/Backend.hs @@ -27,12 +27,12 @@ import qualified Types.Backend as B import Config -- When adding a new backend, import it here and add it to the list. -import qualified Backend.SHA +import qualified Backend.Hash import qualified Backend.WORM import qualified Backend.URL list :: [Backend] -list = Backend.SHA.backends ++ Backend.WORM.backends ++ Backend.URL.backends +list = Backend.Hash.backends ++ Backend.WORM.backends ++ Backend.URL.backends {- List of backends in the order to try them when storing a new key. -} orderedList :: Annex [Backend] diff --git a/Backend/Hash.hs b/Backend/Hash.hs new file mode 100644 index 0000000000..9cef3cae18 --- /dev/null +++ b/Backend/Hash.hs @@ -0,0 +1,162 @@ +{- git-annex hashing backends + - + - Copyright 2011-2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Backend.Hash (backends) where + +import Common.Annex +import qualified Annex +import Types.Backend +import Types.Key +import Types.KeySource +import Utility.Hash +import Utility.ExternalSHA + +import qualified Build.SysConfig as SysConfig +import qualified Data.ByteString.Lazy as L +import Data.Char + +data Hash = SHAHash HashSize | SkeinHash HashSize +type HashSize = Int + +{- Order is slightly significant; want SHA256 first, and more general + - sizes earlier. -} +hashes :: [Hash] +hashes = concat + [ map SHAHash [256, 1, 512, 224, 384] + , map SkeinHash [256, 512] + ] + +{- The SHA256E backend is the default, so genBackendE comes first. -} +backends :: [Backend] +backends = catMaybes $ map genBackendE hashes ++ map genBackend hashes + +genBackend :: Hash -> Maybe Backend +genBackend hash = Just Backend + { name = hashName hash + , getKey = keyValue hash + , fsckKey = Just $ checkKeyChecksum hash + , canUpgradeKey = Just needsUpgrade + } + +genBackendE :: Hash -> Maybe Backend +genBackendE hash = do + b <- genBackend hash + return $ b + { name = hashNameE hash + , getKey = keyValueE hash + } + +hashName :: Hash -> String +hashName (SHAHash size) = "SHA" ++ show size +hashName (SkeinHash size) = "SKEIN" ++ show size + +hashNameE :: Hash -> String +hashNameE hash = hashName hash ++ "E" + +{- A key is a hash of its contents. -} +keyValue :: Hash -> KeySource -> Annex (Maybe Key) +keyValue hash source = do + let file = contentLocation source + stat <- liftIO $ getFileStatus file + let filesize = fromIntegral $ fileSize stat + s <- hashFile hash file filesize + return $ Just $ stubKey + { keyName = s + , keyBackendName = hashName hash + , keySize = Just filesize + } + +{- Extension preserving keys. -} +keyValueE :: Hash -> KeySource -> Annex (Maybe Key) +keyValueE hash source = keyValue hash source >>= maybe (return Nothing) addE + where + addE k = return $ Just $ k + { keyName = keyName k ++ selectExtension (keyFilename source) + , keyBackendName = hashNameE hash + } + +selectExtension :: FilePath -> String +selectExtension f + | null es = "" + | otherwise = intercalate "." ("":es) + where + es = filter (not . null) $ reverse $ + take 2 $ takeWhile shortenough $ + reverse $ split "." $ filter validExtension $ takeExtensions f + shortenough e = length e <= 4 -- long enough for "jpeg" + +{- A key's checksum is checked during fsck. -} +checkKeyChecksum :: Hash -> Key -> FilePath -> Annex Bool +checkKeyChecksum hash key file = do + fast <- Annex.getState Annex.fast + mstat <- liftIO $ catchMaybeIO $ getFileStatus file + case (mstat, fast) of + (Just stat, False) -> do + let filesize = fromIntegral $ fileSize stat + check <$> hashFile hash file filesize + _ -> return True + where + expected = keyHash key + check s + | s == expected = True + {- A bug caused checksums to be prefixed with \ in some + - cases; still accept these as legal now that the bug has been + - fixed. -} + | '\\' : s == expected = True + | otherwise = False + +keyHash :: Key -> String +keyHash key = dropExtensions (keyName key) + +validExtension :: Char -> Bool +validExtension c + | isAlphaNum c = True + | c == '.' = True + | otherwise = False + +{- Upgrade keys that have the \ prefix on their sha due to a bug, or + - that contain non-alphanumeric characters in their extension. -} +needsUpgrade :: Key -> Bool +needsUpgrade key = "\\" `isPrefixOf` keyHash key || + any (not . validExtension) (takeExtensions $ keyName key) + +hashFile :: Hash -> FilePath -> Integer -> Annex String +hashFile hash file filesize = do + showAction "checksum" + liftIO $ go hash + where + go (SHAHash hashsize) = case shaHasher hashsize filesize of + Left sha -> sha <$> L.readFile file + Right command -> + either error return + =<< externalSHA command hashsize file + go (SkeinHash hashsize) = skeinHasher hashsize <$> L.readFile file + +shaHasher :: HashSize -> Integer -> Either (L.ByteString -> String) String +shaHasher hashsize filesize + | hashsize == 1 = use SysConfig.sha1 sha1 + | hashsize == 256 = use SysConfig.sha256 sha256 + | hashsize == 224 = use SysConfig.sha224 sha224 + | hashsize == 384 = use SysConfig.sha384 sha384 + | hashsize == 512 = use SysConfig.sha512 sha512 + | otherwise = error $ "bad sha size " ++ show hashsize + where + use Nothing hasher = Left $ show . hasher + use (Just c) hasher + {- Use builtin, but slightly slower hashing for + - smallish files. Cryptohash benchmarks 90 to 101% + - faster than external hashers, depending on the hash + - and system. So there is no point forking an external + - process unless the file is large. -} + | filesize < 1048576 = use Nothing hasher + | otherwise = Right c + +skeinHasher :: HashSize -> (L.ByteString -> String) +skeinHasher hashsize + | hashsize == 256 = show . skein256 + | hashsize == 512 = show . skein512 + | otherwise = error $ "bad skein size " ++ show hashsize diff --git a/Backend/SHA.hs b/Backend/SHA.hs deleted file mode 100644 index a735ce1e5b..0000000000 --- a/Backend/SHA.hs +++ /dev/null @@ -1,146 +0,0 @@ -{- git-annex SHA backends - - - - Copyright 2011,2012 Joey Hess - - - - Licensed under the GNU GPL version 3 or higher. - -} - -module Backend.SHA (backends) where - -import Common.Annex -import qualified Annex -import Types.Backend -import Types.Key -import Types.KeySource -import Utility.ExternalSHA - -import qualified Build.SysConfig as SysConfig -import Data.Digest.Pure.SHA -import qualified Data.ByteString.Lazy as L -import Data.Char - -type SHASize = Int - -{- Order is slightly significant; want SHA256 first, and more general - - sizes earlier. -} -sizes :: [Int] -sizes = [256, 1, 512, 224, 384] - -{- The SHA256E backend is the default. -} -backends :: [Backend] -backends = catMaybes $ map genBackendE sizes ++ map genBackend sizes - -genBackend :: SHASize -> Maybe Backend -genBackend size = Just $ Backend - { name = shaName size - , getKey = keyValue size - , fsckKey = Just $ checkKeyChecksum size - , canUpgradeKey = Just $ needsUpgrade - } - -genBackendE :: SHASize -> Maybe Backend -genBackendE size = do - b <- genBackend size - return $ b - { name = shaNameE size - , getKey = keyValueE size - } - -shaName :: SHASize -> String -shaName size = "SHA" ++ show size - -shaNameE :: SHASize -> String -shaNameE size = shaName size ++ "E" - -shaN :: SHASize -> FilePath -> Integer -> Annex String -shaN shasize file filesize = do - showAction "checksum" - liftIO $ case shaCommand shasize filesize of - Left sha -> sha <$> L.readFile file - Right command -> - either error return - =<< externalSHA command shasize file - -shaCommand :: SHASize -> Integer -> Either (L.ByteString -> String) String -shaCommand shasize filesize - | shasize == 1 = use SysConfig.sha1 sha1 - | shasize == 256 = use SysConfig.sha256 sha256 - | shasize == 224 = use SysConfig.sha224 sha224 - | shasize == 384 = use SysConfig.sha384 sha384 - | shasize == 512 = use SysConfig.sha512 sha512 - | otherwise = error $ "bad sha size " ++ show shasize - where - use Nothing sha = Left $ showDigest . sha - use (Just c) sha - {- use builtin, but slower sha for small files - - benchmarking indicates it's faster up to - - and slightly beyond 50 kb files -} - | filesize < 51200 = use Nothing sha - | otherwise = Right c - -{- A key is a checksum of its contents. -} -keyValue :: SHASize -> KeySource -> Annex (Maybe Key) -keyValue shasize source = do - let file = contentLocation source - stat <- liftIO $ getFileStatus file - let filesize = fromIntegral $ fileSize stat - s <- shaN shasize file filesize - return $ Just $ stubKey - { keyName = s - , keyBackendName = shaName shasize - , keySize = Just filesize - } - -{- Extension preserving keys. -} -keyValueE :: SHASize -> KeySource -> Annex (Maybe Key) -keyValueE size source = keyValue size source >>= maybe (return Nothing) addE - where - addE k = return $ Just $ k - { keyName = keyName k ++ selectExtension (keyFilename source) - , keyBackendName = shaNameE size - } - -selectExtension :: FilePath -> String -selectExtension f - | null es = "" - | otherwise = intercalate "." ("":es) - where - es = filter (not . null) $ reverse $ - take 2 $ takeWhile shortenough $ - reverse $ split "." $ filter validExtension $ takeExtensions f - shortenough e = length e <= 4 -- long enough for "jpeg" - -{- A key's checksum is checked during fsck. -} -checkKeyChecksum :: SHASize -> Key -> FilePath -> Annex Bool -checkKeyChecksum size key file = do - fast <- Annex.getState Annex.fast - mstat <- liftIO $ catchMaybeIO $ getFileStatus file - case (mstat, fast) of - (Just stat, False) -> do - let filesize = fromIntegral $ fileSize stat - check <$> shaN size file filesize - _ -> return True - where - sha = keySha key - check s - | s == sha = True - {- A bug caused checksums to be prefixed with \ in some - - cases; still accept these as legal now that the bug has been - - fixed. -} - | '\\' : s == sha = True - | otherwise = False - -keySha :: Key -> String -keySha key = dropExtensions (keyName key) - -validExtension :: Char -> Bool -validExtension c - | isAlphaNum c = True - | c == '.' = True - | otherwise = False - -{- Upgrade keys that have the \ prefix on their sha due to a bug, or - - that contain non-alphanumeric characters in their extension. -} -needsUpgrade :: Key -> Bool -needsUpgrade key = "\\" `isPrefixOf` keySha key || - any (not . validExtension) (takeExtensions $ keyName key) diff --git a/Build/EvilSplicer.hs b/Build/EvilSplicer.hs index 8f203437a9..f40d100331 100644 --- a/Build/EvilSplicer.hs +++ b/Build/EvilSplicer.hs @@ -294,6 +294,8 @@ expandExpressionSplice s lls = concat [before, spliced:padding, end] {- Tweaks code output by GHC in splices to actually build. Yipes. -} mangleCode :: String -> String mangleCode = flip_colon + . remove_unnecessary_type_signatures + . lambdaparenhack . lambdaparens . declaration_parens . case_layout @@ -331,6 +333,12 @@ mangleCode = flip_colon preindent <- many1 $ oneOf " \n" string "\\ " lambdaparams <- restofline + continuedlambdaparams <- many $ try $ do + indent <- many1 $ char ' ' + p <- satisfy isLetter + aram <- many $ satisfy isAlphaNum <|> oneOf "_" + newline + return $ indent ++ p:aram ++ "\n" indent <- many1 $ char ' ' string "-> " firstline <- restofline @@ -342,10 +350,46 @@ mangleCode = flip_colon return $ concat [ prefix:preindent , "(\\ " ++ lambdaparams ++ "\n" + , concat continuedlambdaparams , indent ++ "-> " , lambdaparens $ intercalate "\n" (firstline:lambdalines) , ")\n" ] + + {- Hack to add missing parens in a specific case in yesod + - static route code. + - + - StaticR + - yesod_dispatch_env_a4iDV + - (\ p_a4iE2 r_a4iE3 + - -> r_a4iE3 {Network.Wai.pathInfo = p_a4iE2} + - xrest_a4iDT req_a4iDW)) } + - + - Need to add another paren around the lambda, and close it + - before its parameters. lambdaparens misses this one because + - there is already one paren present. + - + - FIXME: This is a hack. lambdaparens could just always add a + - layer of parens even when a lambda seems to be in parent. + -} + lambdaparenhack = parsecAndReplace $ do + indent <- many1 $ char ' ' + staticr <- string "StaticR" + newline + string indent + yesod_dispatch_env <- restofline + string indent + lambdaprefix <- string "(\\ " + l1 <- restofline + string indent + lambdaarrow <- string " ->" + l2 <- restofline + return $ unlines + [ indent ++ staticr + , indent ++ yesod_dispatch_env + , indent ++ "(" ++ lambdaprefix ++ l1 + , indent ++ lambdaarrow ++ l2 ++ ")" + ] restofline = manyTill (noneOf "\n") newline @@ -439,6 +483,19 @@ mangleCode = flip_colon - declarations. -} declaration_parens = replace "StaticR Route Static" "StaticR (Route Static)" + {- A type signature is sometimes given for an entire lambda, + - which is not properly parenthesized or laid out. This is a + - hack to remove one specific case where this happens and the + - signature is easily inferred, so is just removed. + -} + remove_unnecessary_type_signatures = parsecAndReplace $ do + string " ::" + newline + many1 $ char ' ' + string "Text.Css.Block Text.Css.Resolved" + newline + return "" + {- GHC may add full package and version qualifications for - symbols from unimported modules. We don't want these. - diff --git a/Command/Add.hs b/Command/Add.hs index 245ca2bd6c..e0a8269aa9 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -77,7 +77,7 @@ start file = ifAnnexed file addpresent add -- is present but not yet added to git showStart "add" file liftIO $ removeFile file - next $ next $ cleanup file key =<< inAnnex key + next $ next $ cleanup file key Nothing =<< inAnnex key {- The file that's being added is locked down before a key is generated, - to prevent it from being modified in between. This lock down is not @@ -98,13 +98,13 @@ start file = ifAnnexed file addpresent add - Lockdown can fail if a file gets deleted, and Nothing will be returned. -} lockDown :: FilePath -> Annex (Maybe KeySource) -lockDown file = ifM (crippledFileSystem) +lockDown file = ifM crippledFileSystem ( liftIO $ catchMaybeIO nohardlink , do tmp <- fromRepo gitAnnexTmpDir createAnnexDirectory tmp - unlessM (isDirect) $ liftIO $ - void $ tryIO $ preventWrite file + unlessM isDirect $ + void $ liftIO $ tryIO $ preventWrite file liftIO $ catchMaybeIO $ do (tmpfile, h) <- openTempFile tmp $ relatedTemplate $ takeFileName file @@ -115,7 +115,7 @@ lockDown file = ifM (crippledFileSystem) where nohardlink = do cache <- genInodeCache file - return $ KeySource + return KeySource { keyFilename = file , contentLocation = file , inodeCache = cache @@ -123,7 +123,7 @@ lockDown file = ifM (crippledFileSystem) withhardlink tmpfile = do createLink file tmpfile cache <- genInodeCache tmpfile - return $ KeySource + return KeySource { keyFilename = file , contentLocation = tmpfile , inodeCache = cache @@ -134,8 +134,8 @@ lockDown file = ifM (crippledFileSystem) - In direct mode, leaves the file alone, and just updates bookkeeping - information. -} -ingest :: (Maybe KeySource) -> Annex (Maybe Key) -ingest Nothing = return Nothing +ingest :: Maybe KeySource -> Annex (Maybe Key, Maybe InodeCache) +ingest Nothing = return (Nothing, Nothing) ingest (Just source) = do backend <- chooseBackend $ keyFilename source k <- genKey source backend @@ -147,24 +147,24 @@ ingest (Just source) = do where go k cache = ifM isDirect ( godirect k cache , goindirect k cache ) - goindirect (Just (key, _)) _ = do + goindirect (Just (key, _)) mcache = do catchAnnex (moveAnnex key $ contentLocation source) (undo (keyFilename source) key) liftIO $ nukeFile $ keyFilename source - return $ Just key + return $ (Just key, mcache) goindirect Nothing _ = failure "failed to generate a key" godirect (Just (key, _)) (Just cache) = do addInodeCache key cache finishIngestDirect key source - return $ Just key + return $ (Just key, Just cache) godirect _ _ = failure "failed to generate a key" failure msg = do warning $ keyFilename source ++ " " ++ msg when (contentLocation source /= keyFilename source) $ liftIO $ nukeFile $ contentLocation source - return Nothing + return (Nothing, Nothing) finishIngestDirect :: Key -> KeySource -> Annex () finishIngestDirect key source = do @@ -178,9 +178,10 @@ finishIngestDirect key source = do addContentWhenNotPresent key (keyFilename source) perform :: FilePath -> CommandPerform -perform file = - maybe stop (\key -> next $ cleanup file key True) - =<< ingest =<< lockDown file +perform file = lockDown file >>= ingest >>= go + where + go (Just key, cache) = next $ cleanup file key cache True + go (Nothing, _) = stop {- On error, put the file back so it doesn't seem to have vanished. - This can be called before or after the symlink is in place. -} @@ -199,18 +200,17 @@ undo file key e = do liftIO $ moveFile src file {- Creates the symlink to the annexed content, returns the link target. -} -link :: FilePath -> Key -> Bool -> Annex String -link file key hascontent = flip catchAnnex (undo file key) $ do +link :: FilePath -> Key -> Maybe InodeCache -> Annex String +link file key mcache = flip catchAnnex (undo file key) $ do l <- inRepo $ gitAnnexLink file key replaceFile file $ makeAnnexLink l #ifndef __ANDROID__ - when hascontent $ do - -- touch the symlink to have the same mtime as the - -- file it points to - liftIO $ do - mtime <- modificationTime <$> getFileStatus file - touch file (TimeSpec mtime) False + -- touch symlink to have same time as the original file, + -- as provided in the InodeCache + case mcache of + Just c -> liftIO $ touch file (TimeSpec $ inodeCacheToMtime c) False + Nothing -> noop #endif return l @@ -224,28 +224,28 @@ link file key hascontent = flip catchAnnex (undo file key) $ do - Also, using git add allows it to skip gitignored files, unless forced - to include them. -} -addLink :: FilePath -> Key -> Bool -> Annex () -addLink file key hascontent = ifM (coreSymlinks <$> Annex.getGitConfig) +addLink :: FilePath -> Key -> Maybe InodeCache -> Annex () +addLink file key mcache = ifM (coreSymlinks <$> Annex.getGitConfig) ( do - _ <- link file key hascontent + _ <- link file key mcache params <- ifM (Annex.getState Annex.force) ( return [Param "-f"] , return [] ) Annex.Queue.addCommand "add" (params++[Param "--"]) [file] , do - l <- link file key hascontent + l <- link file key mcache addAnnexLink l file ) -cleanup :: FilePath -> Key -> Bool -> CommandCleanup -cleanup file key hascontent = do +cleanup :: FilePath -> Key -> Maybe InodeCache -> Bool -> CommandCleanup +cleanup file key mcache hascontent = do when hascontent $ logStatus key InfoPresent ifM (isDirect <&&> pure hascontent) ( do l <- inRepo $ gitAnnexLink file key stageSymlink file =<< hashSymlink l - , addLink file key hascontent + , addLink file key mcache ) return True diff --git a/Command/AddUnused.hs b/Command/AddUnused.hs index 21a75137ff..1a178e8d47 100644 --- a/Command/AddUnused.hs +++ b/Command/AddUnused.hs @@ -29,7 +29,7 @@ start = startUnused "addunused" perform perform :: Key -> CommandPerform perform key = next $ do logStatus key InfoPresent - Command.Add.addLink file key False + Command.Add.addLink file key Nothing return True where file = "unused." ++ key2file key diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 8ac0e342f4..951bbdbe88 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -17,8 +17,8 @@ import Backend import qualified Command.Add import qualified Annex import qualified Annex.Queue +import qualified Annex.Url as Url import qualified Backend.URL -import qualified Utility.Url as Url import Annex.Content import Logs.Web import qualified Option @@ -123,7 +123,7 @@ perform relaxed url file = ifAnnexed file addurl geturl next $ return True | otherwise = do headers <- getHttpHeaders - ifM (liftIO $ Url.check url headers $ keySize key) + ifM (Url.withUserAgent $ Url.check url headers $ keySize key) ( do setUrlPresent key url next $ return True @@ -174,7 +174,7 @@ download url file = do size <- ifM (liftIO $ isJust <$> checkDaemon pidfile) ( do headers <- getHttpHeaders - liftIO $ snd <$> Url.exists url headers + snd <$> Url.withUserAgent (Url.exists url headers) , return Nothing ) Backend.URL.fromUrl url size @@ -189,7 +189,7 @@ cleanup url file key mtmp = do when (isJust mtmp) $ logStatus key InfoPresent setUrlPresent key url - Command.Add.addLink file key False + Command.Add.addLink file key Nothing whenM isDirect $ do void $ addAssociatedFile key file {- For moveAnnex to work in direct mode, the symlink @@ -203,7 +203,7 @@ nodownload relaxed url file = do headers <- getHttpHeaders (exists, size) <- if relaxed then pure (True, Nothing) - else liftIO $ Url.exists url headers + else Url.withUserAgent $ Url.exists url headers if exists then do key <- Backend.URL.fromUrl url size diff --git a/Command/ConfigList.hs b/Command/ConfigList.hs index 703d6882d8..c42480200b 100644 --- a/Command/ConfigList.hs +++ b/Command/ConfigList.hs @@ -10,6 +10,8 @@ module Command.ConfigList where import Common.Annex import Command import Annex.UUID +import qualified Git.Config +import Remote.GCrypt (coreGCryptId) def :: [Command] def = [noCommit $ command "configlist" paramNothing seek @@ -21,5 +23,8 @@ seek = [withNothing start] start :: CommandStart start = do u <- getUUID - liftIO $ putStrLn $ "annex.uuid=" ++ fromUUID u + showConfig "annex.uuid" $ fromUUID u + showConfig coreGCryptId =<< fromRepo (Git.Config.get coreGCryptId "") stop + where + showConfig k v = liftIO $ putStrLn $ k ++ "=" ++ v diff --git a/Command/Direct.hs b/Command/Direct.hs index 7835988b46..7485f41ce4 100644 --- a/Command/Direct.hs +++ b/Command/Direct.hs @@ -7,6 +7,8 @@ module Command.Direct where +import Control.Exception.Extensible + import Common.Annex import Command import qualified Git @@ -15,6 +17,7 @@ import qualified Git.LsFiles import Config import Annex.Direct import Annex.Version +import Annex.Exception def :: [Command] def = [notBareRepo $ noDaemonRunning $ @@ -51,10 +54,17 @@ perform = do Nothing -> noop Just a -> do showStart "direct" f - a - showEndOk + r <- tryAnnex a + case r of + Left e -> warnlocked e + Right _ -> showEndOk return Nothing + warnlocked :: SomeException -> Annex () + warnlocked e = do + warning $ show e + warning "leaving this file as-is; correct this problem and run git annex fsck on it" + cleanup :: CommandCleanup cleanup = do showStart "direct" "" diff --git a/Command/EnableRemote.hs b/Command/EnableRemote.hs index 977c80487d..f6a1b819c8 100644 --- a/Command/EnableRemote.hs +++ b/Command/EnableRemote.hs @@ -43,7 +43,7 @@ unknownNameError prefix = do error $ prefix ++ if null names then "" - else " Known special remotes: " ++ intercalate " " names + else " Known special remotes: " ++ unwords names perform :: RemoteType -> UUID -> R.RemoteConfig -> CommandPerform perform t u c = do diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 5e150f936a..980a1e3cf3 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -104,7 +104,7 @@ withIncremental = withValue $ do Nothing -> noop Just started -> do now <- liftIO getPOSIXTime - when (now - realToFrac started >= delta) $ + when (now - realToFrac started >= delta) resetStartTime return True @@ -187,7 +187,7 @@ performAll key backend = check ] check :: [Annex Bool] -> Annex Bool -check cs = all id <$> sequence cs +check cs = and <$> sequence cs {- Checks that the file's link points correctly to the content. - @@ -225,7 +225,7 @@ verifyLocationLog key desc = do {- In direct mode, modified files will show up as not present, - but that is expected and not something to do anything about. -} - if (direct && not present) + if direct && not present then return True else verifyLocationLog' key desc present u (logChange key u) @@ -345,7 +345,7 @@ checkBackend backend key mfile = go =<< isDirect checkBackendRemote :: Backend -> Key -> Remote -> Maybe FilePath -> Annex Bool checkBackendRemote backend key remote = maybe (return True) go where - go file = checkBackendOr (badContentRemote remote) backend key file + go = checkBackendOr (badContentRemote remote) backend key checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> Annex Bool checkBackendOr bad backend key file = @@ -406,7 +406,7 @@ badContentDirect :: FilePath -> Key -> Annex String badContentDirect file key = do void $ liftIO $ catchMaybeIO $ touchFile file logStatus key InfoMissing - return $ "left in place for you to examine" + return "left in place for you to examine" badContentRemote :: Remote -> Key -> Annex String badContentRemote remote key = do diff --git a/Command/GCryptSetup.hs b/Command/GCryptSetup.hs new file mode 100644 index 0000000000..a27e470c1b --- /dev/null +++ b/Command/GCryptSetup.hs @@ -0,0 +1,35 @@ +{- git-annex command + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.GCryptSetup where + +import Common.Annex +import Command +import Annex.UUID +import qualified Remote.GCrypt +import qualified Git + +def :: [Command] +def = [dontCheck repoExists $ noCommit $ + command "gcryptsetup" paramValue seek + SectionPlumbing "sets up gcrypt repository"] + +seek :: [CommandSeek] +seek = [withStrings start] + +start :: String -> CommandStart +start gcryptid = next $ next $ do + g <- gitRepo + u <- getUUID + gu <- Remote.GCrypt.getGCryptUUID True g + if u == NoUUID && gu == Nothing + then if Git.repoIsLocalBare g + then do + void $ Remote.GCrypt.setupRepo gcryptid g + return True + else error "cannot use gcrypt in a non-bare repository" + else error "gcryptsetup permission denied" diff --git a/Command/Get.hs b/Command/Get.hs index 981c2245b8..9adf79393c 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -75,7 +75,7 @@ getKeyFile key afile dest = dispatch =<< Remote.keyPossibilities key ( docopy r (trycopy full rs) , trycopy full rs ) - showlocs = Remote.showLocations key [] $ + showlocs = Remote.showLocations key [] "No other repository is known to contain the file." -- This check is to avoid an ugly message if a remote is a -- drive that is not mounted. diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index e455ebb63d..7f54643c97 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -17,7 +17,7 @@ import Data.Time.Clock import Common.Annex import qualified Annex import Command -import qualified Utility.Url as Url +import qualified Annex.Url as Url import Logs.Web import qualified Option import qualified Utility.Format @@ -50,8 +50,7 @@ perform relaxed cache url = do v <- findEnclosures url case v of Just l | not (null l) -> do - ok <- all id - <$> mapM (downloadEnclosure relaxed cache) l + ok <- and <$> mapM (downloadEnclosure relaxed cache) l unless ok $ feedProblem url "problem downloading item" next $ cleanup url True @@ -103,9 +102,10 @@ findEnclosures url = extract <$> downloadFeed url downloadFeed :: URLString -> Annex (Maybe Feed) downloadFeed url = do showOutput + ua <- Url.getUserAgent liftIO $ withTmpFile "feed" $ \f h -> do fileEncoding h - ifM (Url.download url [] [] f) + ifM (Url.download url [] [] f ua) ( liftIO $ parseFeedString <$> hGetContentsStrict h , return Nothing ) diff --git a/Command/Indirect.hs b/Command/Indirect.hs index f866a93b6f..a2512ea961 100644 --- a/Command/Indirect.hs +++ b/Command/Indirect.hs @@ -8,6 +8,7 @@ module Command.Indirect where import System.PosixCompat.Files +import Control.Exception.Extensible import Common.Annex import Command @@ -22,7 +23,9 @@ import Annex.Content import Annex.CatFile import Annex.Version import Annex.Perms +import Annex.Exception import Init +import qualified Command.Add def :: [Command] def = [notBareRepo $ noDaemonRunning $ @@ -46,7 +49,7 @@ start = ifM isDirect perform :: CommandPerform perform = do showStart "commit" "" - whenM (stageDirect) $ do + whenM stageDirect $ do showOutput void $ inRepo $ Git.Command.runBool [ Param "commit" @@ -87,15 +90,24 @@ perform = do thawContentDir =<< calcRepo (gitAnnexLocation k) cleandirect k -- clean before content directory gets frozen whenM (liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f) $ do - moveAnnex k f - l <- inRepo $ gitAnnexLink f k - liftIO $ createSymbolicLink l f + v <-tryAnnexIO (moveAnnex k f) + case v of + Right _ -> do + l <- inRepo $ gitAnnexLink f k + liftIO $ createSymbolicLink l f + Left e -> catchAnnex (Command.Add.undo f k e) + warnlocked showEndOk + warnlocked :: SomeException -> Annex () + warnlocked e = do + warning $ show e + warning "leaving this file as-is; correct this problem and run git annex add on it" + cleandirect k = do liftIO . nukeFile =<< calcRepo (gitAnnexInodeCache k) liftIO . nukeFile =<< calcRepo (gitAnnexMapping k) - + cleanup :: CommandCleanup cleanup = do setVersion defaultVersion diff --git a/Command/List.hs b/Command/List.hs index 1c424cddc7..fda8f3dc7c 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -22,6 +22,7 @@ import Logs.UUID import Annex.UUID import qualified Option import qualified Annex +import Git.Remote def :: [Command] def = [noCommit $ withOptions [allrepos] $ command "list" paramPaths seek @@ -68,13 +69,12 @@ start l file (key, _) = do liftIO $ putStrLn $ format (map (\(u, _, t) -> (t, S.member u ls)) l) file stop -type RemoteName = String type Present = Bool header :: [(RemoteName, TrustLevel)] -> String -header remotes = (unlines $ zipWith formatheader [0..] remotes) ++ (pipes (length remotes)) +header remotes = unlines (zipWith formatheader [0..] remotes) ++ pipes (length remotes) where - formatheader n (remotename, trustlevel) = (pipes n) ++ remotename ++ (trust trustlevel) + formatheader n (remotename, trustlevel) = pipes n ++ remotename ++ trust trustlevel pipes = flip replicate '|' trust UnTrusted = " (untrusted)" trust _ = "" diff --git a/Command/Map.hs b/Command/Map.hs index c88520b079..41beb4b92b 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -20,7 +20,7 @@ import qualified Annex import Annex.UUID import Logs.UUID import Logs.Trust -import Remote.Helper.Ssh +import qualified Remote.Helper.Ssh as Ssh import qualified Utility.Dot as Dot -- a link from the first repository to the second (its remote) @@ -203,9 +203,9 @@ tryScan r where p = proc cmd $ toCommand params - configlist = onRemote r (pipedconfig, Nothing) "configlist" [] [] + configlist = Ssh.onRemote r (pipedconfig, Nothing) "configlist" [] [] manualconfiglist = do - sshparams <- sshToRepo r [Param sshcmd] + sshparams <- Ssh.toRepo r [Param sshcmd] liftIO $ pipedconfig "ssh" sshparams where sshcmd = cddir ++ " && " ++ diff --git a/Command/Move.hs b/Command/Move.hs index ea8cd7163f..dc501ae0f4 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -38,7 +38,7 @@ start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> C start to from move file (key, _) = start' to from move (Just file) key startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart -startKey to from move key = start' to from move Nothing key +startKey to from move = start' to from move Nothing start' :: Maybe Remote -> Maybe Remote -> Bool -> AssociatedFile -> Key -> CommandStart start' to from move afile key = do diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index afc5882d44..0943c0da7e 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -24,7 +24,7 @@ def = [command "pre-commit" paramPaths seek SectionPlumbing seek :: [CommandSeek] seek = -- fix symlinks to files being committed - [ whenNotDirect $ withFilesToBeCommitted $ whenAnnexed $ Command.Fix.start + [ whenNotDirect $ withFilesToBeCommitted $ whenAnnexed Command.Fix.start -- inject unlocked files into the annex , whenNotDirect $ withFilesUnlockedToBeCommitted startIndirect -- update direct mode mappings for committed files diff --git a/Command/ReKey.hs b/Command/ReKey.hs index d7b277fa69..7448ba97e6 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -66,6 +66,6 @@ cleanup file oldkey newkey = do -- Update symlink to use the new key. liftIO $ removeFile file - Command.Add.addLink file newkey True + Command.Add.addLink file newkey Nothing logStatus newkey InfoPresent return True diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs index c316e2ca54..3b2a8c496a 100644 --- a/Command/RecvKey.hs +++ b/Command/RecvKey.hs @@ -32,7 +32,7 @@ seek = [withKeys start] start :: Key -> CommandStart start key = ifM (inAnnex key) ( error "key is already present in annex" - , fieldTransfer Download key $ \_p -> do + , fieldTransfer Download key $ \_p -> ifM (getViaTmp key go) ( do -- forcibly quit after receiving one key, @@ -72,7 +72,18 @@ start key = ifM (inAnnex key) return $ size == size' if oksize then case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of - Nothing -> return False - Just backend -> maybe (return True) (\a -> a key tmp) + Nothing -> do + warning "recvkey: received key from direct mode repository using unknown backend; cannot check; discarding" + return False + Just backend -> maybe (return True) runfsck (Types.Backend.fsckKey backend) - else return False + else do + warning "recvkey: received key with wrong size; discarding" + return False + where + runfsck check = ifM (check key tmp) + ( return True + , do + warning "recvkey: received key from direct mode repository seems to have changed as it was transferred; discarding" + return False + ) diff --git a/Command/Reinject.hs b/Command/Reinject.hs index 642f38947f..e4abeef3c8 100644 --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -34,7 +34,7 @@ start (src:dest:[]) start _ = error "specify a src file and a dest file" perform :: FilePath -> FilePath -> (Key, Backend) -> CommandPerform -perform src _dest (key, backend) = do +perform src _dest (key, backend) = {- Check the content before accepting it. -} ifM (Command.Fsck.checkKeySizeOr reject key src <&&> Command.Fsck.checkBackendOr reject backend key src) diff --git a/Command/SendKey.hs b/Command/SendKey.hs index afd1ac1e01..039a3d7ca6 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -46,6 +46,6 @@ fieldTransfer direction key a = do ok <- maybe (a $ const noop) (\u -> runTransfer (Transfer direction (toUUID u) key) afile noRetry a) =<< Fields.getField Fields.remoteUUID - if ok - then liftIO exitSuccess - else liftIO exitFailure + liftIO $ if ok + then exitSuccess + else exitFailure diff --git a/Command/Status.hs b/Command/Status.hs index 8872747fbf..290ecd586a 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -17,8 +17,6 @@ import Data.Ord import System.PosixCompat.Files import Common.Annex -import qualified Types.Backend as B -import qualified Types.Remote as R import qualified Remote import qualified Command.Unused import qualified Git @@ -28,7 +26,6 @@ import Utility.DataUnits import Utility.DiskFree import Annex.Content import Types.Key -import Backend import Logs.UUID import Logs.Trust import Remote @@ -116,9 +113,7 @@ selStats fast_stats slow_stats = do -} global_fast_stats :: [Stat] global_fast_stats = - [ supported_backends - , supported_remote_types - , repository_mode + [ repository_mode , remote_list Trusted , remote_list SemiTrusted , remote_list UnTrusted @@ -171,14 +166,6 @@ showStat s = maybe noop calc =<< s (lift . showHeader) desc lift . showRaw =<< a -supported_backends :: Stat -supported_backends = stat "supported backends" $ json unwords $ - return $ map B.name Backend.list - -supported_remote_types :: Stat -supported_remote_types = stat "supported remote types" $ json unwords $ - return $ map R.typename Remote.remoteTypes - repository_mode :: Stat repository_mode = stat "repository mode" $ json id $ lift $ ifM isDirect @@ -238,10 +225,10 @@ transfer_list :: Stat transfer_list = stat "transfers in progress" $ nojson $ lift $ do uuidmap <- Remote.remoteMap id ts <- getTransfers - if null ts - then return "none" - else return $ multiLine $ - map (\(t, i) -> line uuidmap t i) $ sort ts + return $ if null ts + then "none" + else multiLine $ + map (uncurry $ line uuidmap) $ sort ts where line uuidmap t i = unwords [ showLcDirection (transferDirection t) ++ "ing" @@ -340,7 +327,7 @@ emptyKeyData :: KeyData emptyKeyData = KeyData 0 0 0 M.empty emptyNumCopiesStats :: NumCopiesStats -emptyNumCopiesStats = NumCopiesStats $ M.empty +emptyNumCopiesStats = NumCopiesStats M.empty foldKeys :: [Key] -> KeyData foldKeys = foldl' (flip addKey) emptyKeyData diff --git a/Command/Sync.hs b/Command/Sync.hs index d8c6fb8d4e..8b32e550fb 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -86,20 +86,19 @@ syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted ) fastest = fromMaybe [] . headMaybe . Remote.byCost commit :: CommandStart -commit = next $ next $ do - ifM isDirect - ( do - void $ stageDirect - runcommit [] - , runcommit [Param "-a"] - ) +commit = next $ next $ ifM isDirect + ( do + void stageDirect + runcommit [] + , runcommit [Param "-a"] + ) where runcommit ps = do showStart "commit" "" showOutput Annex.Branch.commit "update" -- Commit will fail when the tree is clean, so ignore failure. - let params = (Param "commit") : ps ++ + let params = Param "commit" : ps ++ [Param "-m", Param "git-annex automatic sync"] _ <- inRepo $ tryIO . Git.Command.runQuiet params return True @@ -151,12 +150,12 @@ pullRemote remote branch = do - were committed (or pushed changes, if this is a bare remote), - while the synced/master may have changes that some - other remote synced to this remote. So, merge them both. -} -mergeRemote :: Remote -> (Maybe Git.Ref) -> CommandCleanup +mergeRemote :: Remote -> Maybe Git.Ref -> CommandCleanup mergeRemote remote b = case b of Nothing -> do branch <- inRepo Git.Branch.currentUnsafe - all id <$> (mapM merge $ branchlist branch) - Just _ -> all id <$> (mapM merge =<< tomerge (branchlist b)) + and <$> mapM merge (branchlist branch) + Just _ -> and <$> (mapM merge =<< tomerge (branchlist b)) where merge = mergeFrom . remoteBranch remote tomerge branches = filterM (changed remote) branches @@ -221,7 +220,7 @@ pushBranch remote branch g = tryIO (directpush g) `after` syncpush g mergeAnnex :: CommandStart mergeAnnex = do - void $ Annex.Branch.forceUpdate + void Annex.Branch.forceUpdate stop {- Merges from a branch into the current branch. -} @@ -244,7 +243,7 @@ mergeFrom branch = do mergeDirectCleanup d oldsha newsha _ -> noop return r - runmerge a = ifM (a) + runmerge a = ifM a ( return True , resolveMerge ) @@ -268,7 +267,7 @@ resolveMerge :: Annex Bool resolveMerge = do top <- fromRepo Git.repoPath (fs, cleanup) <- inRepo (LsFiles.unmerged [top]) - merged <- all id <$> mapM resolveMerge' fs + merged <- and <$> mapM resolveMerge' fs void $ liftIO cleanup (deleted, cleanup2) <- inRepo (LsFiles.deleted [top]) @@ -291,7 +290,7 @@ resolveMerge' u withKey LsFiles.valUs $ \keyUs -> withKey LsFiles.valThem $ \keyThem -> do ifM isDirect - ( maybe noop (\k -> removeDirect k file) keyUs + ( maybe noop (`removeDirect` file) keyUs , liftIO $ nukeFile file ) Annex.Queue.addCommand "rm" [Params "--quiet -f --"] [file] @@ -307,14 +306,13 @@ resolveMerge' u makelink keyThem return True file = LsFiles.unmergedFile u - issymlink select = any (select (LsFiles.unmergedBlobType u) ==) - [Just SymlinkBlob, Nothing] + issymlink select = select (LsFiles.unmergedBlobType u) `elem` [Just SymlinkBlob, Nothing] makelink (Just key) = do let dest = mergeFile file key l <- inRepo $ gitAnnexLink dest key replaceFile dest $ makeAnnexLink l stageSymlink dest =<< hashSymlink l - whenM (isDirect) $ + whenM isDirect $ toDirect key dest makelink _ = noop withKey select a = do diff --git a/Command/TransferInfo.hs b/Command/TransferInfo.hs index 4bebdebcd9..93f6c7077a 100644 --- a/Command/TransferInfo.hs +++ b/Command/TransferInfo.hs @@ -36,7 +36,7 @@ seek = [withWords start] -} start :: [String] -> CommandStart start (k:[]) = do - case (file2key k) of + case file2key k of Nothing -> error "bad key" (Just key) -> whenM (inAnnex key) $ do file <- Fields.getField Fields.associatedFile diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index 8da29e211e..5ac9454aad 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -41,7 +41,7 @@ seek = [withField readFdOption convertFd $ \readh -> convertFd :: Maybe String -> Annex (Maybe Handle) convertFd Nothing = return Nothing -convertFd (Just s) = liftIO $ do +convertFd (Just s) = liftIO $ case readish s of Nothing -> error "bad fd" Just fd -> Just <$> fdToHandle fd diff --git a/Command/Unannex.hs b/Command/Unannex.hs index fbeaffa52a..66665f4949 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -46,7 +46,7 @@ performIndirect file key = do -- git as a normal non-annexed file, to thinking that the -- file has been unlocked and needs to be re-annexed. (s, reap) <- inRepo $ LsFiles.staged [file] - when (not $ null s) $ + unless (null s) $ inRepo $ Git.Command.run [ Param "commit" , Param "-q" diff --git a/Command/Unused.hs b/Command/Unused.hs index e6c8e225ca..d49cda54b0 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -293,10 +293,9 @@ withKeysReferencedInGitRef a ref = do forM_ ts $ tKey lookAtWorkingTree >=> maybe noop a liftIO $ void clean where - tKey True = Backend.lookupFile . DiffTree.file >=*> - fmap fst - tKey False = catFile ref . DiffTree.file >=*> - fileKey . takeFileName . encodeW8 . L.unpack + tKey True = fmap fst <$$> Backend.lookupFile . DiffTree.file + tKey False = fileKey . takeFileName . encodeW8 . L.unpack <$$> + catFile ref . DiffTree.file {- Looks in the specified directory for bad/tmp keys, and returns a list - of those that might still have value, or might be stale and removable. diff --git a/Command/Version.hs b/Command/Version.hs index c8507cd5ac..b330d1ff10 100644 --- a/Command/Version.hs +++ b/Command/Version.hs @@ -12,6 +12,10 @@ import Command import qualified Build.SysConfig as SysConfig import Annex.Version import BuildFlags +import qualified Types.Backend as B +import qualified Types.Remote as R +import qualified Remote +import qualified Backend def :: [Command] def = [noCommit $ noRepo showPackageVersion $ dontCheck repoExists $ @@ -25,13 +29,20 @@ start = do v <- getVersion liftIO $ do showPackageVersion - putStrLn $ "local repository version: " ++ fromMaybe "unknown" v - putStrLn $ "default repository version: " ++ defaultVersion - putStrLn $ "supported repository versions: " ++ unwords supportedVersions - putStrLn $ "upgrade supported from repository versions: " ++ unwords upgradableVersions + info "local repository version" $ fromMaybe "unknown" v + info "default repository version" defaultVersion + info "supported repository versions" $ + unwords supportedVersions + info "upgrade supported from repository versions" $ + unwords upgradableVersions stop showPackageVersion :: IO () showPackageVersion = do - putStrLn $ "git-annex version: " ++ SysConfig.packageversion - putStrLn $ "build flags: " ++ unwords buildFlags + info "git-annex version" SysConfig.packageversion + info "build flags" $ unwords buildFlags + info "key/value backends" $ unwords $ map B.name Backend.list + info "remote types" $ unwords $ map R.typename Remote.remoteTypes + +info :: String -> String -> IO () +info k v = putStrLn $ k ++ ": " ++ v diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index 1aa8722c58..dfdcde1345 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -123,14 +123,14 @@ genCfg cfg descs = unlines $ concat [intro, trust, groups, preferredcontent] settings field desc showvals showdefaults = concat [ desc , concatMap showvals $ sort $ map swap $ M.toList $ field cfg - , concatMap (\u -> lcom $ showdefaults u) $ missing field + , concatMap (lcom . showdefaults) $ missing field ] line setting u value = - [ com $ "(for " ++ (fromMaybe "" $ M.lookup u descs) ++ ")" + [ com $ "(for " ++ fromMaybe "" (M.lookup u descs) ++ ")" , unwords [setting, fromUUID u, "=", value] ] - lcom = map (\l -> if "#" `isPrefixOf` l then l else "#" ++ l) + lcom = map (\l -> if "#" `isPrefixOf` l then l else '#' : l) missing field = S.toList $ M.keysSet descs `S.difference` M.keysSet (field cfg) {- If there's a parse error, returns a new version of the file, @@ -139,7 +139,7 @@ parseCfg :: Cfg -> String -> Either String Cfg parseCfg curcfg = go [] curcfg . lines where go c cfg [] - | null (catMaybes $ map fst c) = Right cfg + | null (mapMaybe fst c) = Right cfg | otherwise = Left $ unlines $ badheader ++ concatMap showerr (reverse c) go c cfg (l:ls) = case parse (dropWhile isSpace l) cfg of diff --git a/Command/WebApp.hs b/Command/WebApp.hs index eeb23a164d..6577ce02b3 100644 --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -55,7 +55,7 @@ start = start' True start' :: Bool -> Maybe HostName -> CommandStart start' allowauto listenhost = do - liftIO $ ensureInstalled + liftIO ensureInstalled ifM isInitialized ( go , auto ) stop where @@ -209,7 +209,7 @@ openBrowser mcmd htmlshim realurl outh errh = do , std_err = maybe Inherit UseHandle errh } exitcode <- waitForProcess pid - unless (exitcode == ExitSuccess) $ do + unless (exitcode == ExitSuccess) $ hPutStrLn (fromMaybe stderr errh) "failed to start web browser" {- web.browser is a generic git config setting for a web browser program -} diff --git a/Common.hs b/Common.hs index 5dc3cfbb23..a6203b9a69 100644 --- a/Common.hs +++ b/Common.hs @@ -28,6 +28,7 @@ import Utility.Process as X import Utility.Path as X import Utility.Directory as X import Utility.Monad as X +import Utility.Data as X import Utility.Applicative as X import Utility.FileSystemEncoding as X diff --git a/Config/Cost.hs b/Config/Cost.hs index dc391a5a57..2d94a6b15b 100644 --- a/Config/Cost.hs +++ b/Config/Cost.hs @@ -65,7 +65,7 @@ costBetween x y | x == y = x | x > y = -- avoid fractions unless needed let mid = y + (x - y) / 2 - mid' = fromIntegral ((floor mid) :: Int) + mid' = fromIntegral (floor mid :: Int) in if mid' > y then mid' else mid | otherwise = costBetween y x diff --git a/Config/Files.hs b/Config/Files.hs index 3db2bb74c3..30ed0a3cf0 100644 --- a/Config/Files.hs +++ b/Config/Files.hs @@ -34,7 +34,7 @@ modifyAutoStartFile func = do when (dirs' /= dirs) $ do f <- autoStartFile createDirectoryIfMissing True (parentDir f) - viaTmp writeFile f $ unlines $ dirs' + viaTmp writeFile f $ unlines dirs' {- Adds a directory to the autostart file. If the directory is already - present, it's moved to the top, so it will be used as the default diff --git a/Creds.hs b/Creds.hs index 588d67cfe8..70e00ef34d 100644 --- a/Creds.hs +++ b/Creds.hs @@ -16,10 +16,9 @@ import Crypto import Types.Remote (RemoteConfig, RemoteConfigKey) import Remote.Helper.Encryptable (remoteCipher, embedCreds) #ifndef mingw32_HOST_OS -import Utility.Env (setEnv) +import Utility.Env (setEnv, getEnv) #endif -import System.Environment import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Map as M import Utility.Base64 @@ -101,11 +100,10 @@ getRemoteCredPair c storage = maybe fromcache (return . Just) =<< fromenv {- Gets a CredPair from the environment. -} getEnvCredPair :: CredPairStorage -> IO (Maybe CredPair) getEnvCredPair storage = liftM2 (,) - <$> get uenv - <*> get penv + <$> getEnv uenv + <*> getEnv penv where (uenv, penv) = credPairEnvironment storage - get = catchMaybeIO . getEnv {- Stores a CredPair in the environment. -} setEnvCredPair :: CredPair -> CredPairStorage -> IO () diff --git a/Crypto.hs b/Crypto.hs index f99f8cbf1e..371bbcaf1e 100644 --- a/Crypto.hs +++ b/Crypto.hs @@ -102,7 +102,7 @@ updateEncryptedCipher newkeys encipher@(EncryptedCipher _ variant (KeyIds ks)) = cipher <- decryptCipher encipher encryptCipher cipher variant $ KeyIds ks' where - listKeyIds = mapM (Gpg.findPubKeys >=*> keyIds) >=*> concat + listKeyIds = concat <$$> mapM (keyIds <$$> Gpg.findPubKeys) describeCipher :: StorableCipher -> String describeCipher (SharedCipher _) = "shared cipher" diff --git a/Git/CatFile.hs b/Git/CatFile.hs index bd86ff3260..f7438b4103 100644 --- a/Git/CatFile.hs +++ b/Git/CatFile.hs @@ -18,7 +18,6 @@ module Git.CatFile ( import System.IO import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L -import Data.Digest.Pure.SHA import Data.Char import System.Process (std_out, std_err) import Numeric @@ -31,6 +30,7 @@ import Git.Command import Git.Types import Git.FilePath import qualified Utility.CoProcess as CoProcess +import Utility.Hash data CatFileHandle = CatFileHandle CoProcess.CoProcessHandle Repo @@ -103,7 +103,7 @@ catObjectDetails (CatFileHandle hdl repo) object = CoProcess.query hdl send rece } fileEncoding h content <- L.hGetContents h - let sha = (\s -> length s `seq` s) (showDigest $ sha1 content) + let sha = (\s -> length s `seq` s) (show $ sha1 content) ok <- checkSuccessProcess pid return $ if ok then Just (content, Ref sha) diff --git a/Git/Config.hs b/Git/Config.hs index adc75a2085..a41712addf 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -10,6 +10,7 @@ module Git.Config where import qualified Data.Map as M import Data.Char import System.Process (cwd, env) +import Control.Exception.Extensible import Common import Git @@ -153,3 +154,37 @@ boolConfig False = "false" isBare :: Repo -> Bool isBare r = fromMaybe False $ isTrue =<< getMaybe "core.bare" r + +{- Runs a command to get the configuration of a repo, + - and returns a repo populated with the configuration, as well as the raw + - output of the command. -} +fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, String)) +fromPipe r cmd params = try $ + withHandle StdoutHandle createProcessSuccess p $ \h -> do + fileEncoding h + val <- hGetContentsStrict h + r' <- store val r + return (r', val) + where + p = proc cmd $ toCommand params + +{- Reads git config from a specified file and returns the repo populated + - with the configuration. -} +fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, String)) +fromFile r f = fromPipe r "git" + [ Param "config" + , Param "--file" + , File f + , Param "--list" + ] + +{- Changes a git config setting in the specified config file. + - (Creates the file if it does not already exist.) -} +changeFile :: FilePath -> String -> String -> IO Bool +changeFile f k v = boolSystem "git" + [ Param "config" + , Param "--file" + , File f + , Param k + , Param v + ] diff --git a/Git/Construct.hs b/Git/Construct.hs index 35c77e9d2a..377ddeeaeb 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -23,8 +23,6 @@ module Git.Construct ( checkForRepo, ) where -{-# LANGUAGE CPP #-} - #ifndef mingw32_HOST_OS import System.Posix.User #else @@ -36,6 +34,7 @@ import Network.URI import Common import Git.Types import Git +import Git.Remote import qualified Git.Url as Url import Utility.UserInfo @@ -143,51 +142,10 @@ remoteNamedFromKey k = remoteNamed basename {- Constructs a new Repo for one of a Repo's remotes using a given - location (ie, an url). -} fromRemoteLocation :: String -> Repo -> IO Repo -fromRemoteLocation s repo = gen $ calcloc s +fromRemoteLocation s repo = gen $ parseRemoteLocation s repo where - gen v -#ifdef mingw32_HOST_OS - | dosstyle v = fromRemotePath (dospath v) repo -#endif - | scpstyle v = fromUrl $ scptourl v - | urlstyle v = fromUrl v - | otherwise = fromRemotePath v repo - -- insteadof config can rewrite remote location - calcloc l - | null insteadofs = l - | otherwise = replacement ++ drop (length bestvalue) l - where - replacement = drop (length prefix) $ - take (length bestkey - length suffix) bestkey - (bestkey, bestvalue) = maximumBy longestvalue insteadofs - longestvalue (_, a) (_, b) = compare b a - insteadofs = filterconfig $ \(k, v) -> - startswith prefix k && - endswith suffix k && - startswith v l - filterconfig f = filter f $ - concatMap splitconfigs $ M.toList $ fullconfig repo - splitconfigs (k, vs) = map (\v -> (k, v)) vs - (prefix, suffix) = ("url." , ".insteadof") - urlstyle v = isURI v || ":" `isInfixOf` v && "//" `isInfixOf` v - -- git remotes can be written scp style -- [user@]host:dir - -- but foo::bar is a git-remote-helper location instead - scpstyle v = ":" `isInfixOf` v - && not ("//" `isInfixOf` v) - && not ("::" `isInfixOf` v) - scptourl v = "ssh://" ++ host ++ slash dir - where - (host, dir) = separate (== ':') v - slash d | d == "" = "/~/" ++ d - | "/" `isPrefixOf` d = d - | "~" `isPrefixOf` d = '/':d - | otherwise = "/~/" ++ d -#ifdef mingw32_HOST_OS - -- git on Windows will write a path to .git/config with "drive:", - -- which is not to be confused with a "host:" - dosstyle = hasDrive - dospath = fromInternalGitPath -#endif + gen (RemotePath p) = fromRemotePath p repo + gen (RemoteUrl u) = fromUrl u {- Constructs a Repo from the path specified in the git remotes of - another Repo. -} diff --git a/Git/GCrypt.hs b/Git/GCrypt.hs index f2f38dfa4f..0da68bf24f 100644 --- a/Git/GCrypt.hs +++ b/Git/GCrypt.hs @@ -15,6 +15,7 @@ import Git.Construct import qualified Git.Config as Config import qualified Git.Command as Command import Utility.Gpg +import Git.Remote urlPrefix :: String urlPrefix = "gcrypt::" @@ -66,7 +67,6 @@ probeRepo loc baserepo = do ExitFailure 1 -> NotDecryptable ExitFailure _ -> NotEncrypted -type RemoteName = String type GCryptId = String {- gcrypt gives each encrypted repository a uique gcrypt-id, diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 8a5d4bd6a2..d58fe162ba 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -103,7 +103,7 @@ stagedDetails' ps l repo = do where (metadata, file) = separate (== '\t') s (mode, rest) = separate (== ' ') metadata - readmode = headMaybe . readOct >=*> fst + readmode = fst <$$> headMaybe . readOct {- Returns a list of the files in the specified locations that are staged - for commit, and whose type has changed. -} diff --git a/Git/Remote.hs b/Git/Remote.hs index e853e53cba..3dc6d9e450 100644 --- a/Git/Remote.hs +++ b/Git/Remote.hs @@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Git.Remote where import Common @@ -13,6 +15,8 @@ import qualified Git.Command import qualified Git.BuildVersion import Data.Char +import qualified Data.Map as M +import Network.URI type RemoteName = String @@ -48,3 +52,58 @@ remove remotename = Git.Command.run else "remove" , Param remotename ] + +data RemoteLocation = RemoteUrl String | RemotePath FilePath + +remoteLocationIsUrl :: RemoteLocation -> Bool +remoteLocationIsUrl (RemoteUrl _) = True +remoteLocationIsUrl _ = False + +{- Determines if a given remote location is an url, or a local + - path. Takes the repository's insteadOf configuration into account. -} +parseRemoteLocation :: String -> Repo -> RemoteLocation +parseRemoteLocation s repo = ret $ calcloc s + where + ret v +#ifdef mingw32_HOST_OS + | dosstyle v = RemotePath (dospath v) +#endif + | scpstyle v = RemoteUrl (scptourl v) + | urlstyle v = RemoteUrl v + | otherwise = RemotePath v + -- insteadof config can rewrite remote location + calcloc l + | null insteadofs = l + | otherwise = replacement ++ drop (length bestvalue) l + where + replacement = drop (length prefix) $ + take (length bestkey - length suffix) bestkey + (bestkey, bestvalue) = maximumBy longestvalue insteadofs + longestvalue (_, a) (_, b) = compare b a + insteadofs = filterconfig $ \(k, v) -> + startswith prefix k && + endswith suffix k && + startswith v l + filterconfig f = filter f $ + concatMap splitconfigs $ M.toList $ fullconfig repo + splitconfigs (k, vs) = map (\v -> (k, v)) vs + (prefix, suffix) = ("url." , ".insteadof") + urlstyle v = isURI v || ":" `isInfixOf` v && "//" `isInfixOf` v + -- git remotes can be written scp style -- [user@]host:dir + -- but foo::bar is a git-remote-helper location instead + scpstyle v = ":" `isInfixOf` v + && not ("//" `isInfixOf` v) + && not ("::" `isInfixOf` v) + scptourl v = "ssh://" ++ host ++ slash dir + where + (host, dir) = separate (== ':') v + slash d | d == "" = "/~/" ++ d + | "/" `isPrefixOf` d = d + | "~" `isPrefixOf` d = '/':d + | otherwise = "/~/" ++ d +#ifdef mingw32_HOST_OS + -- git on Windows will write a path to .git/config with "drive:", + -- which is not to be confused with a "host:" + dosstyle = hasDrive + dospath = fromInternalGitPath +#endif diff --git a/GitAnnex/Options.hs b/GitAnnex/Options.hs index 459ee3bf44..596cc138f6 100644 --- a/GitAnnex/Options.hs +++ b/GitAnnex/Options.hs @@ -48,6 +48,8 @@ options = Option.common ++ "skip files smaller than a size" , Option ['T'] ["time-limit"] (ReqArg Limit.addTimeLimit paramTime) "stop after the specified amount of time" + , Option [] ["user-agent"] (ReqArg setuseragent paramName) + "override default User-Agent" , Option [] ["trust-glacier"] (NoArg (Annex.setFlag "trustglacier")) "Trust Amazon Glacier inventory" ] ++ Option.matcher @@ -55,6 +57,7 @@ options = Option.common ++ setnumcopies v = maybe noop (\n -> Annex.changeState $ \s -> s { Annex.forcenumcopies = Just n }) (readish v) + setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v } setgitconfig v = Annex.changeGitRepo =<< inRepo (Git.Config.store v) trustArg t = ReqArg (Remote.forceTrust t) paramRemote diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs index 6f03ac73b9..b5f6804e77 100644 --- a/GitAnnexShell.hs +++ b/GitAnnexShell.hs @@ -19,6 +19,9 @@ import Annex (setField) import qualified Option import Fields import Utility.UserInfo +import Remote.GCrypt (getGCryptUUID) +import qualified Annex +import Init import qualified Command.ConfigList import qualified Command.InAnnex @@ -27,20 +30,22 @@ import qualified Command.RecvKey import qualified Command.SendKey import qualified Command.TransferInfo import qualified Command.Commit +import qualified Command.GCryptSetup cmds_readonly :: [Command] cmds_readonly = concat - [ Command.ConfigList.def - , Command.InAnnex.def - , Command.SendKey.def - , Command.TransferInfo.def + [ gitAnnexShellCheck Command.ConfigList.def + , gitAnnexShellCheck Command.InAnnex.def + , gitAnnexShellCheck Command.SendKey.def + , gitAnnexShellCheck Command.TransferInfo.def ] cmds_notreadonly :: [Command] cmds_notreadonly = concat - [ Command.RecvKey.def - , Command.DropKey.def - , Command.Commit.def + [ gitAnnexShellCheck Command.RecvKey.def + , gitAnnexShellCheck Command.DropKey.def + , gitAnnexShellCheck Command.Commit.def + , Command.GCryptSetup.def ] cmds :: [Command] @@ -50,17 +55,22 @@ cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly options :: [OptDescr (Annex ())] options = Option.common ++ - [ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "local repository uuid" + [ Option [] ["uuid"] (ReqArg checkUUID paramUUID) "local repository uuid" ] where - checkuuid expected = getUUID >>= check + checkUUID expected = getUUID >>= check where check u | u == toUUID expected = noop - check NoUUID = unexpected "uninitialized repository" - check u = unexpected $ "UUID " ++ fromUUID u - unexpected s = error $ - "expected repository UUID " ++ - expected ++ " but found " ++ s + check NoUUID = checkGCryptUUID expected + check u = unexpectedUUID expected u + checkGCryptUUID expected = check =<< getGCryptUUID True =<< gitRepo + where + check (Just u) | u == toUUID expected = noop + check Nothing = unexpected expected "uninitialized repository" + check (Just u) = unexpectedUUID expected u + unexpectedUUID expected u = unexpected expected $ "UUID " ++ fromUUID u + unexpected expected s = error $ + "expected repository UUID " ++ expected ++ " but found " ++ s header :: String header = "git-annex-shell [-c] command [parameters ...] [option ...]" @@ -180,3 +190,11 @@ checkEnv var = do Nothing -> noop Just "" -> noop Just _ -> error $ "Action blocked by " ++ var + +{- Modifies a Command to check that it is run in either a git-annex + - repository, or a repository with a gcrypt-id set. -} +gitAnnexShellCheck :: [Command] -> [Command] +gitAnnexShellCheck = map $ addCheck okforshell . dontCheck repoExists + where + okforshell = unlessM (isInitialized <||> isJust . gcryptId <$> Annex.getGitConfig) $ + error "Not a git-annex or gcrypt repository." diff --git a/Locations.hs b/Locations.hs index 7762afb641..b05cdc0763 100644 --- a/Locations.hs +++ b/Locations.hs @@ -10,6 +10,7 @@ module Locations ( fileKey, keyPaths, keyPath, + objectDir, gitAnnexLocation, gitAnnexLink, gitAnnexMapping, diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 13f94ea20d..24fb940d52 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -262,6 +262,12 @@ getFailedTransfers u = catMaybes <$> (liftIO . getpairs =<< concat <$> findfiles findfiles = liftIO . mapM dirContentsRecursive =<< mapM (fromRepo . failedTransferDir u) [Download, Upload] +clearFailedTransfers :: UUID -> Annex [(Transfer, TransferInfo)] +clearFailedTransfers u = do + failed <- getFailedTransfers u + mapM_ (removeFailedTransfer . fst) failed + return failed + removeFailedTransfer :: Transfer -> Annex () removeFailedTransfer t = do f <- fromRepo $ failedTransferFile t diff --git a/Logs/Transitions.hs b/Logs/Transitions.hs index 783ce5090a..64e9d3344c 100644 --- a/Logs/Transitions.hs +++ b/Logs/Transitions.hs @@ -71,7 +71,7 @@ parseTransitionLine s = TransitionLine <$> pdate ds <*> readish ts ws = words s ts = Prelude.head ws ds = unwords $ Prelude.tail ws - pdate = parseTime defaultTimeLocale "%s%Qs" >=*> utcTimeToPOSIXSeconds + pdate = utcTimeToPOSIXSeconds <$$> parseTime defaultTimeLocale "%s%Qs" combineTransitions :: [Transitions] -> Transitions combineTransitions = S.unions @@ -82,6 +82,5 @@ transitionList = map transition . S.elems {- Typically ran with Annex.Branch.change, but we can't import Annex.Branch - here since it depends on this module. -} recordTransitions :: (FilePath -> (String -> String) -> Annex ()) -> Transitions -> Annex () -recordTransitions changer t = do - changer transitionsLog $ - showTransitions . S.union t . parseTransitionsStrictly "local" +recordTransitions changer t = changer transitionsLog $ + showTransitions . S.union t . parseTransitionsStrictly "local" diff --git a/Makefile b/Makefile index 5b1a6d467e..87b84929f7 100644 --- a/Makefile +++ b/Makefile @@ -160,12 +160,12 @@ osxapp: Build/Standalone Build/OSXMkLibs rm -f tmp/git-annex.dmg.bz2 bzip2 --fast tmp/git-annex.dmg -ANDROID_FLAGS?= +ANDROID_FLAGS?=-f-XMPP # Cross compile for Android. # Uses https://github.com/neurocyte/ghc-android android: Build/EvilSplicer echo "Running native build, to get TH splices.." - if [ ! -e dist/setup/setup ]; then $(CABAL) configure -f"-Production $(ANDROID_FLAGS)" -O0; fi + if [ ! -e dist/setup/setup ]; then $(CABAL) configure -f-Production -O0 $(ANDROID_FLAGS); fi mkdir -p tmp if ! $(CABAL) build --ghc-options=-ddump-splices 2> tmp/dump-splices; then tail tmp/dump-splices >&2; exit 1; fi echo "Setting up Android build tree.." @@ -183,9 +183,9 @@ android: Build/EvilSplicer # Cabal cannot cross compile with custom build type, so workaround. sed -i 's/Build-type: Custom/Build-type: Simple/' tmp/androidtree/git-annex.cabal if [ ! -e tmp/androidtree/dist/setup/setup ]; then \ - cd tmp/androidtree && $$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/bin/cabal configure -f"Android $(ANDROID_FLAGS)"; \ + cd tmp/androidtree && $$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/bin/cabal configure -fAndroid $(ANDROID_FLAGS); \ fi - cd tmp/androidtree && $(CABAL) build + cd tmp/androidtree && $$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/bin/cabal build adb: ANDROID_FLAGS="-Production" $(MAKE) android diff --git a/Remote.hs b/Remote.hs index 25a46b1cb2..8b88a75d99 100644 --- a/Remote.hs +++ b/Remote.hs @@ -56,6 +56,7 @@ import Logs.Trust import Logs.Location hiding (logStatus) import Remote.List import Config +import Git.Remote {- Map from UUIDs of Remotes to a calculated value. -} remoteMap :: (Remote -> a) -> Annex (M.Map UUID a) @@ -68,7 +69,7 @@ remoteMap c = M.fromList . map (\r -> (uuid r, c r)) . uuidDescriptions :: Annex (M.Map UUID String) uuidDescriptions = M.unionWith addName <$> uuidMap <*> remoteMap name -addName :: String -> String -> String +addName :: String -> RemoteName -> String addName desc n | desc == n = desc | null desc = n @@ -76,12 +77,12 @@ addName desc n {- When a name is specified, looks up the remote matching that name. - (Or it can be a UUID.) -} -byName :: Maybe String -> Annex (Maybe Remote) +byName :: Maybe RemoteName -> Annex (Maybe Remote) byName Nothing = return Nothing byName (Just n) = either error Just <$> byName' n {- Like byName, but the remote must have a configured UUID. -} -byNameWithUUID :: Maybe String -> Annex (Maybe Remote) +byNameWithUUID :: Maybe RemoteName -> Annex (Maybe Remote) byNameWithUUID = checkuuid <=< byName where checkuuid Nothing = return Nothing @@ -93,7 +94,7 @@ byNameWithUUID = checkuuid <=< byName else error e | otherwise = return $ Just r -byName' :: String -> Annex (Either String Remote) +byName' :: RemoteName -> Annex (Either String Remote) byName' "" = return $ Left "no remote specified" byName' n = handle . filter matching <$> remoteList where @@ -104,7 +105,7 @@ byName' n = handle . filter matching <$> remoteList {- Looks up a remote by name (or by UUID, or even by description), - and returns its UUID. Finds even remotes that are not configured in - .git/config. -} -nameToUUID :: String -> Annex UUID +nameToUUID :: RemoteName -> Annex UUID nameToUUID "." = getUUID -- special case for current repo nameToUUID "here" = getUUID nameToUUID "" = error "no remote specified" @@ -167,13 +168,19 @@ prettyListUUIDs uuids = do prettyUUID :: UUID -> Annex String prettyUUID u = concat <$> prettyListUUIDs [u] -{- Gets the remote associated with a UUID. - - There's no associated remote when this is the UUID of the local repo. -} +{- Gets the remote associated with a UUID. -} remoteFromUUID :: UUID -> Annex (Maybe Remote) remoteFromUUID u = ifM ((==) u <$> getUUID) ( return Nothing - , Just . fromMaybe (error "Unknown UUID") . M.lookup u <$> remoteMap id + , do + maybe tryharder (return . Just) =<< findinmap ) + where + findinmap = M.lookup u <$> remoteMap id + {- Re-read remote list in case a new remote has popped up. -} + tryharder = do + void remoteListRefresh + findinmap {- Filters a list of remotes to ones that have the listed uuids. -} remotesWithUUID :: [Remote] -> [UUID] -> [Remote] diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 960ed4ada4..1acb35c820 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -10,6 +10,7 @@ module Remote.Bup (remote) where import qualified Data.ByteString.Lazy as L import qualified Data.Map as M import System.Process +import Data.ByteString.Lazy.UTF8 (fromString) import Common.Annex import Types.Remote @@ -21,12 +22,12 @@ import qualified Git.Construct import qualified Git.Ref import Config import Config.Cost -import Remote.Helper.Ssh +import qualified Remote.Helper.Ssh as Ssh import Remote.Helper.Special import Remote.Helper.Encryptable +import Remote.Helper.Messages import Crypto -import Data.ByteString.Lazy.UTF8 (fromString) -import Data.Digest.Pure.SHA +import Utility.Hash import Utility.UserInfo import Annex.Content import Annex.UUID @@ -185,7 +186,7 @@ rollback k bupr = go =<< liftIO (bup2GitRemote bupr) checkPresent :: Git.Repo -> Git.Repo -> Key -> Annex (Either String Bool) checkPresent r bupr k | Git.repoIsUrl bupr = do - showAction $ "checking " ++ Git.repoDescribe r + showChecking r ok <- onBupRemote bupr boolSystem "git" params return $ Right ok | otherwise = liftIO $ catchMsgIO $ @@ -220,7 +221,7 @@ storeBupUUID u buprepo = do onBupRemote :: Git.Repo -> (FilePath -> [CommandParam] -> IO a) -> FilePath -> [CommandParam] -> Annex a onBupRemote r a command params = do - sshparams <- sshToRepo r [Param $ + sshparams <- Ssh.toRepo r [Param $ "cd " ++ dir ++ " && " ++ unwords (command : toCommand params)] liftIO $ a "ssh" sshparams where @@ -277,7 +278,7 @@ bup2GitRemote r bupRef :: Key -> String bupRef k | Git.Ref.legal True shown = shown - | otherwise = "git-annex-" ++ showDigest (sha256 (fromString shown)) + | otherwise = "git-annex-" ++ show (sha256 (fromString shown)) where shown = key2file k diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 1c09e0e3c8..a4bd22829d 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -12,7 +12,6 @@ module Remote.Directory (remote) where import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S import qualified Data.Map as M -import qualified Control.Exception as E import Data.Int import Common.Annex @@ -109,7 +108,7 @@ withCheckedFiles check (Just _) d k a = go $ locations d k ifM (check chunkcount) ( do chunks <- listChunks f <$> readFile chunkcount - ifM (all id <$> mapM check chunks) + ifM (and <$> mapM check chunks) ( a chunks , return False ) , go fs ) @@ -159,7 +158,7 @@ storeSplit' :: MeterUpdate -> Int64 -> [FilePath] -> [S.ByteString] -> [FilePath storeSplit' _ _ [] _ _ = error "ran out of dests" storeSplit' _ _ _ [] c = return $ reverse c storeSplit' meterupdate chunksize (d:dests) bs c = do - bs' <- E.bracket (openFile d WriteMode) hClose $ + bs' <- withFile d WriteMode $ feed zeroBytesProcessed chunksize bs storeSplit' meterupdate chunksize dests bs' (d:c) where @@ -206,7 +205,7 @@ retrieve :: FilePath -> ChunkSize -> Key -> AssociatedFile -> FilePath -> MeterU retrieve d chunksize k _ f p = metered (Just p) k $ \meterupdate -> liftIO $ withStoredFiles chunksize d k $ \files -> catchBoolIO $ do - meteredWriteFileChunks meterupdate f files $ L.readFile + meteredWriteFileChunks meterupdate f files L.readFile return True retrieveEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool @@ -217,7 +216,7 @@ retrieveEncrypted d chunksize (cipher, enck) k f p = metered (Just p) k $ \meter readBytes $ meteredWriteFile meterupdate f return True where - feeder files h = forM_ files $ \file -> L.hPut h =<< L.readFile file + feeder files h = forM_ files $ L.hPut h <=< L.readFile retrieveCheap :: FilePath -> ChunkSize -> Key -> FilePath -> Annex Bool retrieveCheap _ (Just _) _ _ = return False -- no cheap retrieval for chunks diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 27d3686903..8ba640bac5 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -5,10 +5,17 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Remote.GCrypt (remote, gen, getGCryptId) where +module Remote.GCrypt ( + remote, + gen, + getGCryptUUID, + coreGCryptId, + setupRepo +) where import qualified Data.Map as M import qualified Data.ByteString.Lazy as L +import Control.Exception.Extensible import Common.Annex import Types.Remote @@ -27,14 +34,19 @@ import Config.Cost import Remote.Helper.Git import Remote.Helper.Encryptable import Remote.Helper.Special +import Remote.Helper.Messages +import qualified Remote.Helper.Ssh as Ssh import Utility.Metered import Crypto import Annex.UUID import Annex.Ssh import qualified Remote.Rsync import Utility.Rsync +import Utility.Tmp import Logs.Remote +import Logs.Transfer import Utility.Gpg +import Annex.Content remote :: RemoteType remote = RemoteType { @@ -52,9 +64,9 @@ gen gcryptr u c gc = do -- get underlying git repo with real path, not gcrypt path r <- liftIO $ Git.GCrypt.encryptedRemote g gcryptr let r' = r { Git.remoteName = Git.remoteName gcryptr } - (mgcryptid, r'') <- liftIO $ getGCryptId r' - -- doublecheck that local cache matches underlying repo's gcrypt-id - -- (which might not be set) + -- doublecheck that cache matches underlying repo's gcrypt-id + -- (which might not be set), only for local repos + (mgcryptid, r'') <- getGCryptId True r' case (mgcryptid, Git.GCrypt.remoteRepoId g (Git.remoteName gcryptr)) of (Just gcryptid, Just cachedgcryptid) | gcryptid /= cachedgcryptid -> resetup gcryptid r'' @@ -67,7 +79,7 @@ gen gcryptr u c gc = do -- correctly. resetup gcryptid r = do let u' = genUUIDInNameSpace gCryptNameSpace gcryptid - v <- (M.lookup u' <$> readRemoteLog) + v <- M.lookup u' <$> readRemoteLog case (Git.remoteName gcryptr, v) of (Just remotename, Just c') -> do setGcryptEncryption c' remotename @@ -78,22 +90,11 @@ gen gcryptr u c gc = do warning $ "not using unknown gcrypt repository pointed to by remote " ++ Git.repoDescribe r return Nothing -{- gcrypt repos set up by git-annex as special remotes have a - - core.gcrypt-id setting in their config, which can be mapped back to - - the remote's UUID. This only works for local repos. - - (Also returns a version of input repo with its config read.) -} -getGCryptId :: Git.Repo -> IO (Maybe Git.GCrypt.GCryptId, Git.Repo) -getGCryptId r - | Git.repoIsLocalUnknown r = do - r' <- catchDefaultIO r $ Git.Config.read r - return (Git.Config.getMaybe "core.gcrypt-id" r', r') - | otherwise = return (Nothing, r) - gen' :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen' r u c gc = do cst <- remoteCost gc $ if repoCheap r then nearlyCheapRemoteCost else expensiveRemoteCost - (rsynctransport, rsyncurl) <- rsyncTransport r + (rsynctransport, rsyncurl) <- rsyncTransportToObjects r let rsyncopts = Remote.Rsync.genRsyncOpts c gc rsynctransport rsyncurl let this = Remote { uuid = u @@ -119,7 +120,12 @@ gen' r u c gc = do (retrieve this rsyncopts) this -rsyncTransport :: Git.Repo -> Annex ([CommandParam], String) +rsyncTransportToObjects :: Git.Repo -> Annex ([CommandParam], String) +rsyncTransportToObjects r = do + (rsynctransport, rsyncurl, _) <- rsyncTransport r + return (rsynctransport, rsyncurl ++ "/annex/objects") + +rsyncTransport :: Git.Repo -> Annex ([CommandParam], String, AccessMethod) rsyncTransport r | "ssh://" `isPrefixOf` loc = sshtransport $ break (== '/') $ drop (length "ssh://") loc | "//:" `isInfixOf` loc = othertransport @@ -128,9 +134,12 @@ rsyncTransport r where loc = Git.repoLocation r sshtransport (host, path) = do + let rsyncpath = if "/~/" `isPrefixOf` path + then drop 3 path + else path opts <- sshCachingOptions (host, Nothing) [] - return (rsyncShell $ Param "ssh" : opts, host ++ ":" ++ path) - othertransport = return ([], loc) + return (rsyncShell $ Param "ssh" : opts, host ++ ":" ++ rsyncpath, AccessShell) + othertransport = return ([], loc, AccessDirect) noCrypto :: Annex a noCrypto = error "cannot use gcrypt remote without encryption enabled" @@ -155,7 +164,7 @@ gCryptSetup mu c = go $ M.lookup "gitrepo" c {- Run a git fetch and a push to the git repo in order to get - its gcrypt-id set up, so that later git annex commands - - will use the remote as a ggcrypt remote. The fetch is + - will use the remote as a gcrypt remote. The fetch is - needed if the repo already exists; the push is needed - if the repo has not yet been initialized by gcrypt. -} void $ inRepo $ Git.Command.runBool @@ -165,25 +174,85 @@ gCryptSetup mu c = go $ M.lookup "gitrepo" c void $ inRepo $ Git.Command.runBool [ Param "push" , Param remotename - , Param $ show $ Annex.Branch.fullname + , Param $ show Annex.Branch.fullname ] g <- inRepo Git.Config.reRead case Git.GCrypt.remoteRepoId g (Just remotename) of Nothing -> error "unable to determine gcrypt-id of remote" Just gcryptid -> do let u = genUUIDInNameSpace gCryptNameSpace gcryptid - if Just u == mu || mu == Nothing + if Just u == mu || isNothing mu then do - -- Store gcrypt-id in local - -- gcrypt repository, for later - -- double-check. - r <- inRepo $ Git.Construct.fromRemoteLocation gitrepo - when (Git.repoIsLocalUnknown r) $ do - r' <- liftIO $ Git.Config.read r - liftIO $ Git.Command.run [Param "config", Param "core.gcrypt-id", Param gcryptid] r' - gitConfigSpecialRemote u c' "gcrypt" "true" + method <- setupRepo gcryptid =<< inRepo (Git.Construct.fromRemoteLocation gitrepo) + gitConfigSpecialRemote u c' "gcrypt" (fromAccessMethod method) return (c', u) - else error "uuid mismatch" + else error $ "uuid mismatch " ++ show (u, mu, gcryptid) + +{- Sets up the gcrypt repository. The repository is either a local + - repo, or it is accessed via rsync directly, or it is accessed over ssh + - and git-annex-shell is available to manage it. + - + - The GCryptID is recorded in the repository's git config for later use. + - Also, if the git config has receive.denyNonFastForwards set, disable + - it; gcrypt relies on being able to fast-forward branches. + -} +setupRepo :: Git.GCrypt.GCryptId -> Git.Repo -> Annex AccessMethod +setupRepo gcryptid r + | Git.repoIsUrl r = do + (_, _, accessmethod) <- rsyncTransport r + case accessmethod of + AccessDirect -> rsyncsetup + AccessShell -> ifM gitannexshellsetup + ( return AccessShell + , rsyncsetup + ) + | Git.repoIsLocalUnknown r = localsetup =<< liftIO (Git.Config.read r) + | otherwise = localsetup r + where + localsetup r' = do + let setconfig k v = liftIO $ Git.Command.run [Param "config", Param k, Param v] r' + setconfig coreGCryptId gcryptid + setconfig denyNonFastForwards (Git.Config.boolConfig False) + return AccessDirect + + {- As well as modifying the remote's git config, + - create the objectDir on the remote, + - which is needed for direct rsync of objects to work. + -} + rsyncsetup = Remote.Rsync.withRsyncScratchDir $ \tmp -> do + liftIO $ createDirectoryIfMissing True $ tmp objectDir + (rsynctransport, rsyncurl, _) <- rsyncTransport r + let tmpconfig = tmp "config" + void $ liftIO $ rsync $ rsynctransport ++ + [ Param $ rsyncurl ++ "/config" + , Param tmpconfig + ] + liftIO $ do + void $ Git.Config.changeFile tmpconfig coreGCryptId gcryptid + void $ Git.Config.changeFile tmpconfig denyNonFastForwards (Git.Config.boolConfig False) + ok <- liftIO $ rsync $ rsynctransport ++ + [ Params "--recursive" + , Param $ tmp ++ "/" + , Param rsyncurl + ] + unless ok $ + error "Failed to connect to remote to set it up." + return AccessDirect + + {- Ask git-annex-shell to configure the repository as a gcrypt + - repository. May fail if it is too old. -} + gitannexshellsetup = Ssh.onRemote r (boolSystem, False) + "gcryptsetup" [ Param gcryptid ] [] + + denyNonFastForwards = "receive.denyNonFastForwards" + +shellOrRsync :: Remote -> Annex a -> Annex a -> Annex a +shellOrRsync r ashell arsync = case method of + AccessShell -> ashell + _ -> arsync + where + method = toAccessMethod $ fromMaybe "" $ + remoteAnnexGCrypt $ gitconfig r {- Configure gcrypt to use the same list of keyids that - were passed to initremote as its participants. @@ -210,26 +279,32 @@ setGcryptEncryption c remotename = do store :: Remote -> Remote.Rsync.RsyncOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool store r rsyncopts (cipher, enck) k p | not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ - sendwith $ \meterupdate h -> do + metered (Just p) k $ \meterupdate -> spoolencrypted $ \h -> do + let dest = gCryptLocation r enck createDirectoryIfMissing True $ parentDir dest readBytes (meteredWriteFile meterupdate dest) h return True - | Git.repoIsSsh (repo r) = Remote.Rsync.storeEncrypted rsyncopts gpgopts (cipher, enck) k p + | Git.repoIsSsh (repo r) = shellOrRsync r storeshell storersync | otherwise = unsupportedUrl where gpgopts = getGpgEncParams r - dest = gCryptLocation r enck - sendwith a = metered (Just p) k $ \meterupdate -> - Annex.Content.sendAnnex k noop $ \src -> - liftIO $ catchBoolIO $ - encrypt gpgopts cipher (feedFile src) (a meterupdate) + storersync = Remote.Rsync.storeEncrypted rsyncopts gpgopts (cipher, enck) k p + storeshell = withTmp enck $ \tmp -> + ifM (spoolencrypted $ readBytes $ \b -> catchBoolIO $ L.writeFile tmp b >> return True) + ( Ssh.rsyncHelper (Just p) + =<< Ssh.rsyncParamsRemote False r Upload enck tmp Nothing + , return False + ) + spoolencrypted a = Annex.Content.sendAnnex k noop $ \src -> + liftIO $ catchBoolIO $ + encrypt gpgopts cipher (feedFile src) a retrieve :: Remote -> Remote.Rsync.RsyncOpts -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool retrieve r rsyncopts (cipher, enck) k d p | not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do retrievewith $ L.readFile src return True - | Git.repoIsSsh (repo r) = Remote.Rsync.retrieveEncrypted rsyncopts (cipher, enck) k d p + | Git.repoIsSsh (repo r) = shellOrRsync r retrieveshell retrieversync | otherwise = unsupportedUrl where src = gCryptLocation r enck @@ -237,30 +312,89 @@ retrieve r rsyncopts (cipher, enck) k d p a >>= \b -> decrypt cipher (feedBytes b) (readBytes $ meteredWriteFile meterupdate d) + retrieversync = Remote.Rsync.retrieveEncrypted rsyncopts (cipher, enck) k d p + retrieveshell = withTmp enck $ \tmp -> + ifM (Ssh.rsyncHelper (Just p) =<< Ssh.rsyncParamsRemote False r Download enck tmp Nothing) + ( liftIO $ catchBoolIO $ do + decrypt cipher (feedFile tmp) $ + readBytes $ L.writeFile d + return True + , return False + ) remove :: Remote -> Remote.Rsync.RsyncOpts -> Key -> Annex Bool remove r rsyncopts k | not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do - liftIO $ removeDirectoryRecursive (parentDir dest) + liftIO $ removeDirectoryRecursive $ parentDir $ gCryptLocation r k return True - | Git.repoIsSsh (repo r) = Remote.Rsync.remove rsyncopts k + | Git.repoIsSsh (repo r) = shellOrRsync r removeshell removersync | otherwise = unsupportedUrl where - dest = gCryptLocation r k + removersync = Remote.Rsync.remove rsyncopts k + removeshell = Ssh.dropKey (repo r) k checkPresent :: Remote -> Remote.Rsync.RsyncOpts -> Key -> Annex (Either String Bool) checkPresent r rsyncopts k | not $ Git.repoIsUrl (repo r) = - guardUsable (repo r) unknown $ - liftIO $ catchDefaultIO unknown $ + guardUsable (repo r) (cantCheck $ repo r) $ + liftIO $ catchDefaultIO (cantCheck $ repo r) $ Right <$> doesFileExist (gCryptLocation r k) - | Git.repoIsSsh (repo r) = Remote.Rsync.checkPresent (repo r) rsyncopts k + | Git.repoIsSsh (repo r) = shellOrRsync r checkshell checkrsync | otherwise = unsupportedUrl where - unknown = Left $ "unable to check " ++ Git.repoDescribe (repo r) ++ show (repo r) + checkrsync = Remote.Rsync.checkPresent (repo r) rsyncopts k + checkshell = Ssh.inAnnex (repo r) k -{- Annexed objects are stored directly under the top of the gcrypt repo - - (not in annex/objects), and are hashed using lower-case directories for max +{- Annexed objects are hashed using lower-case directories for max - portability. -} gCryptLocation :: Remote -> Key -> FilePath -gCryptLocation r key = Git.repoLocation (repo r) keyPath key hashDirLower +gCryptLocation r key = Git.repoLocation (repo r) objectDir keyPath key hashDirLower + +data AccessMethod = AccessDirect | AccessShell + +fromAccessMethod :: AccessMethod -> String +fromAccessMethod AccessShell = "shell" +fromAccessMethod AccessDirect = "true" + +toAccessMethod :: String -> AccessMethod +toAccessMethod "shell" = AccessShell +toAccessMethod _ = AccessDirect + +getGCryptUUID :: Bool -> Git.Repo -> Annex (Maybe UUID) +getGCryptUUID fast r = (genUUIDInNameSpace gCryptNameSpace <$>) . fst + <$> getGCryptId fast r + +coreGCryptId :: String +coreGCryptId = "core.gcrypt-id" + +{- gcrypt repos set up by git-annex as special remotes have a + - core.gcrypt-id setting in their config, which can be mapped back to + - the remote's UUID. + - + - In fast mode, only checks local repos. To check a remote repo, + - tries git-annex-shell and direct rsync of the git config file. + - + - (Also returns a version of input repo with its config read.) -} +getGCryptId :: Bool -> Git.Repo -> Annex (Maybe Git.GCrypt.GCryptId, Git.Repo) +getGCryptId fast r + | Git.repoIsLocal r || Git.repoIsLocalUnknown r = extract <$> + liftIO (catchMaybeIO $ Git.Config.read r) + | not fast = extract . liftM fst <$> getM (eitherToMaybe <$>) + [ Ssh.onRemote r (Git.Config.fromPipe r, Left undefined) "configlist" [] [] + , getConfigViaRsync r + ] + | otherwise = return (Nothing, r) + where + extract Nothing = (Nothing, r) + extract (Just r') = (Git.Config.getMaybe coreGCryptId r', r') + +getConfigViaRsync :: Git.Repo -> Annex (Either SomeException (Git.Repo, String)) +getConfigViaRsync r = do + (rsynctransport, rsyncurl, _) <- rsyncTransport r + liftIO $ do + withTmpFile "tmpconfig" $ \tmpconfig _ -> do + void $ rsync $ rsynctransport ++ + [ Param $ rsyncurl ++ "/config" + , Param tmpconfig + ] + Git.Config.fromFile r tmpconfig diff --git a/Remote/Git.hs b/Remote/Git.hs index 2802db9ae0..e8ab572816 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -14,8 +14,6 @@ module Remote.Git ( ) where import Common.Annex -import Utility.Rsync -import Remote.Helper.Ssh import Annex.Ssh import Types.Remote import Types.GitConfig @@ -32,7 +30,7 @@ import Annex.Exception import qualified Annex.Content import qualified Annex.BranchState import qualified Annex.Branch -import qualified Utility.Url as Url +import qualified Annex.Url as Url import Utility.Tmp import Config import Config.Cost @@ -45,6 +43,8 @@ import Utility.Metered import Utility.CopyFile #endif import Remote.Helper.Git +import Remote.Helper.Messages +import qualified Remote.Helper.Ssh as Ssh import qualified Remote.GCrypt import Control.Concurrent @@ -143,7 +143,7 @@ tryGitConfigRead :: Git.Repo -> Annex Git.Repo tryGitConfigRead r | haveconfig r = return r -- already read | Git.repoIsSsh r = store $ do - v <- onRemote r (pipedconfig, Left undefined) "configlist" [] [] + v <- Ssh.onRemote r (pipedconfig, Left undefined) "configlist" [] [] case v of Right r' | haveconfig r' -> return r' @@ -165,23 +165,22 @@ tryGitConfigRead r safely a = either (const $ return r) return =<< liftIO (try a :: IO (Either SomeException Git.Repo)) - pipedconfig cmd params = try run :: IO (Either SomeException Git.Repo) - where - run = withHandle StdoutHandle createProcessSuccess p $ \h -> do - fileEncoding h - val <- hGetContentsStrict h - r' <- Git.Config.store val r - when (getUncachedUUID r' == NoUUID && not (null val)) $ do - warningIO $ "Failed to get annex.uuid configuration of repository " ++ Git.repoDescribe r - warningIO $ "Instead, got: " ++ show val - warningIO $ "This is unexpected; please check the network transport!" - return r' - p = proc cmd $ toCommand params + pipedconfig cmd params = do + v <- Git.Config.fromPipe r cmd params + case v of + Right (r', val) -> do + when (getUncachedUUID r' == NoUUID && not (null val)) $ do + warningIO $ "Failed to get annex.uuid configuration of repository " ++ Git.repoDescribe r + warningIO $ "Instead, got: " ++ show val + warningIO $ "This is unexpected; please check the network transport!" + return $ Right r' + Left l -> return $ Left l geturlconfig headers = do + ua <- Url.getUserAgent v <- liftIO $ withTmpFile "git-annex.tmp" $ \tmpfile h -> do hClose h - ifM (Url.downloadQuiet (Git.repoLocation r ++ "/config") headers [] tmpfile) + ifM (Url.downloadQuiet (Git.repoLocation r ++ "/config") headers [] tmpfile ua) ( pipedconfig "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile] , return $ Left undefined ) @@ -211,7 +210,7 @@ tryGitConfigRead r Nothing -> return r Just n -> do whenM (inRepo $ Git.Command.runBool [Param "fetch", Param "--quiet", Param n]) $ - set_ignore $ "does not have git-annex installed" + set_ignore "does not have git-annex installed" return r set_ignore msg = case Git.remoteName r of @@ -241,28 +240,19 @@ inAnnex r key | otherwise = checklocal where checkhttp headers = do - showchecking - liftIO $ ifM (anyM (\u -> Url.check u headers (keySize key)) (keyUrls r key)) + showChecking r + ifM (anyM (\u -> Url.withUserAgent $ Url.check u headers (keySize key)) (keyUrls r key)) ( return $ Right True , return $ Left "not found" ) - checkremote = do - showchecking - onRemote r (check, unknown) "inannex" [Param (key2file key)] [] - where - check c p = dispatch <$> safeSystem c p - dispatch ExitSuccess = Right True - dispatch (ExitFailure 1) = Right False - dispatch _ = unknown - checklocal = guardUsable r unknown $ dispatch <$> check + checkremote = Ssh.inAnnex r key + checklocal = guardUsable r (cantCheck r) $ dispatch <$> check where check = liftIO $ catchMsgIO $ onLocal r $ Annex.Content.inAnnexSafe key dispatch (Left e) = Left e dispatch (Right (Just b)) = Right b - dispatch (Right Nothing) = unknown - unknown = Left $ "unable to check " ++ Git.repoDescribe r - showchecking = showAction $ "checking " ++ Git.repoDescribe r + dispatch (Right Nothing) = cantCheck r keyUrls :: Git.Repo -> Key -> [String] keyUrls r key = map tourl locs @@ -285,12 +275,8 @@ dropKey r key logStatus key InfoMissing Annex.Content.saveState True return True - | Git.repoIsHttp (repo r) = error "dropping from http repo not supported" - | otherwise = commitOnCleanup r $ onRemote (repo r) (boolSystem, False) "dropkey" - [ Params "--quiet --force" - , Param $ key2file key - ] - [] + | Git.repoIsHttp (repo r) = error "dropping from http remote not supported" + | otherwise = commitOnCleanup r $ Ssh.dropKey (repo r) key {- Tries to copy a key's content from a remote's annex to a file. -} copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool @@ -298,7 +284,7 @@ copyFromRemote r key file dest _p = copyFromRemote' r key file dest copyFromRemote' :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool copyFromRemote' r key file dest | not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do - let params = rsyncParams r + let params = Ssh.rsyncParams r u <- getUUID -- run copy from perspective of remote liftIO $ onLocal (repo r) $ do @@ -310,11 +296,12 @@ copyFromRemote' r key file dest upload u key file noRetry (rsyncOrCopyFile params object dest) <&&> checksuccess - | Git.repoIsSsh (repo r) = feedprogressback $ \feeder -> - rsyncHelper (Just feeder) - =<< rsyncParamsRemote r Download key dest file + | Git.repoIsSsh (repo r) = feedprogressback $ \feeder -> do + direct <- isDirect + Ssh.rsyncHelper (Just feeder) + =<< Ssh.rsyncParamsRemote direct r Download key dest file | Git.repoIsHttp (repo r) = Annex.Content.downloadUrl (keyUrls (repo r) key) dest - | otherwise = error "copying from non-ssh, non-http repo not supported" + | otherwise = error "copying from non-ssh, non-http remote not supported" where {- Feed local rsync's progress info back to the remote, - by forking a feeder thread that runs @@ -339,9 +326,9 @@ copyFromRemote' r key file dest u <- getUUID let fields = (Fields.remoteUUID, fromUUID u) : maybe [] (\f -> [(Fields.associatedFile, f)]) file - Just (cmd, params) <- git_annex_shell (repo r) "transferinfo" + Just (cmd, params) <- Ssh.git_annex_shell (repo r) "transferinfo" [Param $ key2file key] fields - v <- liftIO $ (newEmptySV :: IO (MSampleVar Integer)) + v <- liftIO (newEmptySV :: IO (MSampleVar Integer)) tid <- liftIO $ forkIO $ void $ tryIO $ do bytes <- readSV v p <- createProcess $ @@ -352,7 +339,7 @@ copyFromRemote' r key file dest hClose $ stderrHandle p let h = stdinHandle p let send b = do - hPutStrLn h $ show b + hPrint h b hFlush h send bytes forever $ @@ -384,8 +371,10 @@ copyToRemote r key file p guardUsable (repo r) False $ commitOnCleanup r $ copylocal =<< Annex.Content.prepSendAnnex key | Git.repoIsSsh (repo r) = commitOnCleanup r $ - Annex.Content.sendAnnex key noop $ \object -> - rsyncHelper (Just p) =<< rsyncParamsRemote r Upload key object file + Annex.Content.sendAnnex key noop $ \object -> do + direct <- isDirect + Ssh.rsyncHelper (Just p) + =<< Ssh.rsyncParamsRemote direct r Upload key object file | otherwise = error "copying to non-ssh repo not supported" where copylocal Nothing = return False @@ -394,7 +383,7 @@ copyToRemote r key file p -- the remote's Annex, but it needs access to the current -- Annex monad's state. checksuccessio <- Annex.withCurrentState checksuccess - let params = rsyncParams r + let params = Ssh.rsyncParams r u <- getUUID -- run copy from perspective of remote liftIO $ onLocal (repo r) $ ifM (Annex.Content.inAnnex key) @@ -428,7 +417,7 @@ rsyncOrCopyFile rsyncparams src dest p = #else ifM (sameDeviceIds src dest) (docopy, dorsync) where - sameDeviceIds a b = (==) <$> (getDeviceId a) <*> (getDeviceId b) + sameDeviceIds a b = (==) <$> getDeviceId a <*> getDeviceId b getDeviceId f = deviceID <$> liftIO (getFileStatus $ parentDir f) docopy = liftIO $ bracket (forkIO $ watchfilesize zeroBytesProcessed) @@ -446,56 +435,9 @@ rsyncOrCopyFile rsyncparams src dest p = watchfilesize sz _ -> watchfilesize oldsz #endif - dorsync = rsyncHelper (Just p) $ + dorsync = Ssh.rsyncHelper (Just p) $ rsyncparams ++ [File src, File dest] -rsyncHelper :: Maybe MeterUpdate -> [CommandParam] -> Annex Bool -rsyncHelper callback params = do - showOutput -- make way for progress bar - ifM (liftIO $ (maybe rsync rsyncProgress callback) params) - ( return True - , do - showLongNote "rsync failed -- run git annex again to resume file transfer" - return False - ) - -{- Generates rsync parameters that ssh to the remote and asks it - - to either receive or send the key's content. -} -rsyncParamsRemote :: Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam] -rsyncParamsRemote r direction key file afile = do - u <- getUUID - direct <- isDirect - let fields = (Fields.remoteUUID, fromUUID u) - : (Fields.direct, if direct then "1" else "") - : maybe [] (\f -> [(Fields.associatedFile, f)]) afile - Just (shellcmd, shellparams) <- git_annex_shell (repo r) - (if direction == Download then "sendkey" else "recvkey") - [ Param $ key2file key ] - fields - -- Convert the ssh command into rsync command line. - let eparam = rsyncShell (Param shellcmd:shellparams) - let o = rsyncParams r - if direction == Download - then return $ o ++ rsyncopts eparam dummy (File file) - else return $ o ++ rsyncopts eparam (File file) dummy - where - rsyncopts ps source dest - | end ps == [dashdash] = ps ++ [source, dest] - | otherwise = ps ++ [dashdash, source, dest] - dashdash = Param "--" - {- The rsync shell parameter controls where rsync - - goes, so the source/dest parameter can be a dummy value, - - that just enables remote rsync mode. - - For maximum compatability with some patched rsyncs, - - the dummy value needs to still contain a hostname, - - even though this hostname will never be used. -} - dummy = Param "dummy:" - --- --inplace to resume partial files -rsyncParams :: Remote -> [CommandParam] -rsyncParams r = [Params "--progress --inplace"] ++ - map Param (remoteAnnexRsyncOptions $ gitconfig r) - commitOnCleanup :: Remote -> Annex a -> Annex a commitOnCleanup r a = go `after` a where @@ -506,12 +448,12 @@ commitOnCleanup r a = go `after` a Annex.Branch.commit "update" | otherwise = void $ do Just (shellcmd, shellparams) <- - git_annex_shell (repo r) "commit" [] [] + Ssh.git_annex_shell (repo r) "commit" [] [] -- Throw away stderr, since the remote may not -- have a new enough git-annex shell to -- support committing. - liftIO $ catchMaybeIO $ do + liftIO $ catchMaybeIO $ withQuietOutput createProcessSuccess $ proc shellcmd $ toCommand shellparams diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index ecdc6a6565..3726c70839 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -98,7 +98,7 @@ store r k _f p storeHelper r k $ streamMeteredFile src meterupdate storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool -storeEncrypted r (cipher, enck) k p = sendAnnex k (void $ remove r enck) $ \src -> do +storeEncrypted r (cipher, enck) k p = sendAnnex k (void $ remove r enck) $ \src -> metered (Just p) k $ \meterupdate -> storeHelper r enck $ \h -> encrypt (getGpgEncParams r) cipher (feedFile src) @@ -209,7 +209,7 @@ checkPresent r k = do ] glacierAction :: Remote -> [CommandParam] -> Annex Bool -glacierAction r params = runGlacier (config r) (uuid r) params +glacierAction r = runGlacier (config r) (uuid r) runGlacier :: RemoteConfig -> UUID -> [CommandParam] -> Annex Bool runGlacier c u params = go =<< glacierEnv c u @@ -222,7 +222,7 @@ glacierParams :: RemoteConfig -> [CommandParam] -> [CommandParam] glacierParams c params = datacenter:params where datacenter = Param $ "--region=" ++ - (fromJust $ M.lookup "datacenter" c) + fromJust (M.lookup "datacenter" c) glacierEnv :: RemoteConfig -> UUID -> Annex (Maybe [(String, String)]) glacierEnv c u = go =<< getRemoteCredPairFor "glacier" c creds @@ -282,7 +282,7 @@ jobList r keys = go =<< glacierEnv (config r) (uuid r) enckeys <- forM keys $ \k -> maybe k snd <$> cipherKey (config r) k let keymap = M.fromList $ zip enckeys keys - let convert = catMaybes . map (`M.lookup` keymap) + let convert = mapMaybe (`M.lookup` keymap) return (convert succeeded, convert failed) parse c [] = c diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs index 46678de702..c4cec37ea1 100644 --- a/Remote/Helper/Chunked.hs +++ b/Remote/Helper/Chunked.hs @@ -68,7 +68,7 @@ storeChunks key tmp dest chunksize storer recorder finalizer = either onerr retu where go = do stored <- storer tmpdests - when (chunksize /= Nothing) $ do + when (isNothing chunksize) $ do let chunkcount = basef ++ chunkCount recorder chunkcount (show $ length stored) finalizer tmp dest @@ -79,7 +79,7 @@ storeChunks key tmp dest chunksize storer recorder finalizer = either onerr retu basef = tmp ++ keyFile key tmpdests - | chunksize == Nothing = [basef] + | isNothing chunksize = [basef] | otherwise = map (basef ++ ) chunkStream {- Given a list of destinations to use, chunks the data according to the @@ -123,5 +123,5 @@ storeChunked chunksize dests storer content = either onerr return meteredWriteFileChunks :: MeterUpdate -> FilePath -> [v] -> (v -> IO L.ByteString) -> IO () meteredWriteFileChunks meterupdate dest chunks feeder = withBinaryFile dest WriteMode $ \h -> - forM_ chunks $ \c -> - meteredWrite meterupdate h =<< feeder c + forM_ chunks $ + meteredWrite meterupdate h <=< feeder diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs index 7c2bf68ca7..665da1e103 100644 --- a/Remote/Helper/Hooks.hs +++ b/Remote/Helper/Hooks.hs @@ -35,8 +35,8 @@ addHooks' r starthook stophook = r' { storeKey = \k f p -> wrapper $ storeKey r k f p , retrieveKeyFile = \k f d p -> wrapper $ retrieveKeyFile r k f d p , retrieveKeyFileCheap = \k f -> wrapper $ retrieveKeyFileCheap r k f - , removeKey = \k -> wrapper $ removeKey r k - , hasKey = \k -> wrapper $ hasKey r k + , removeKey = wrapper . removeKey r + , hasKey = wrapper . hasKey r } where wrapper = runHooks r' starthook stophook @@ -45,7 +45,7 @@ runHooks :: Remote -> Maybe String -> Maybe String -> Annex a -> Annex a runHooks r starthook stophook a = do dir <- fromRepo gitAnnexRemotesDir let lck = dir remoteid ++ ".lck" - whenM (not . any (== lck) . M.keys <$> getPool) $ do + whenM (notElem lck . M.keys <$> getPool) $ do liftIO $ createDirectoryIfMissing True dir firstrun lck a diff --git a/Remote/Helper/Messages.hs b/Remote/Helper/Messages.hs new file mode 100644 index 0000000000..c4b1966dc8 --- /dev/null +++ b/Remote/Helper/Messages.hs @@ -0,0 +1,17 @@ +{- git-annex remote messages + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Remote.Helper.Messages where + +import Common.Annex +import qualified Git + +showChecking :: Git.Repo -> Annex () +showChecking r = showAction $ "checking " ++ Git.repoDescribe r + +cantCheck :: Git.Repo -> Either String Bool +cantCheck r = Left $ "unable to check " ++ Git.repoDescribe r diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs index f8e9353b77..35655f00b2 100644 --- a/Remote/Helper/Ssh.hs +++ b/Remote/Helper/Ssh.hs @@ -1,6 +1,6 @@ -{- git-annex remote access with ssh +{- git-annex remote access with ssh and git-annex-shell - - - Copyright 2011,2012 Joey Hess + - Copyright 2011-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -12,19 +12,26 @@ import qualified Git import qualified Git.Url import Annex.UUID import Annex.Ssh -import Fields +import Fields (Field, fieldName) +import qualified Fields import Types.GitConfig +import Types.Key +import Remote.Helper.Messages +import Utility.Metered +import Utility.Rsync +import Types.Remote +import Logs.Transfer {- Generates parameters to ssh to a repository's host and run a command. - Caller is responsible for doing any neccessary shellEscaping of the - passed command. -} -sshToRepo :: Git.Repo -> [CommandParam] -> Annex [CommandParam] -sshToRepo repo sshcmd = do +toRepo :: Git.Repo -> [CommandParam] -> Annex [CommandParam] +toRepo r sshcmd = do g <- fromRepo id - let c = extractRemoteGitConfig g (Git.repoDescribe repo) + let c = extractRemoteGitConfig g (Git.repoDescribe r) let opts = map Param $ remoteAnnexSshOptions c - let host = Git.Url.hostuser repo - params <- sshCachingOptions (host, Git.Url.port repo) opts + let host = Git.Url.hostuser r + params <- sshCachingOptions (host, Git.Url.port r) opts return $ params ++ Param host : sshcmd {- Generates parameters to run a git-annex-shell command on a remote @@ -33,17 +40,17 @@ git_annex_shell :: Git.Repo -> String -> [CommandParam] -> [(Field, String)] -> git_annex_shell r command params fields | not $ Git.repoIsUrl r = return $ Just (shellcmd, shellopts ++ fieldopts) | Git.repoIsSsh r = do - uuid <- getRepoUUID r - sshparams <- sshToRepo r [Param $ sshcmd uuid ] + u <- getRepoUUID r + sshparams <- toRepo r [Param $ sshcmd u ] return $ Just ("ssh", sshparams) | otherwise = return Nothing where dir = Git.repoPath r shellcmd = "git-annex-shell" shellopts = Param command : File dir : params - sshcmd uuid = unwords $ + sshcmd u = unwords $ shellcmd : map shellEscape (toCommand shellopts) ++ - uuidcheck uuid ++ + uuidcheck u ++ map shellEscape (toCommand fieldopts) uuidcheck NoUUID = [] uuidcheck (UUID u) = ["--uuid", u] @@ -71,3 +78,69 @@ onRemote r (with, errorval) command params fields = do case s of Just (c, ps) -> liftIO $ with c ps Nothing -> return errorval + +{- Checks if a remote contains a key. -} +inAnnex :: Git.Repo -> Key -> Annex (Either String Bool) +inAnnex r k = do + showChecking r + onRemote r (check, cantCheck r) "inannex" [Param $ key2file k] [] + where + check c p = dispatch <$> safeSystem c p + dispatch ExitSuccess = Right True + dispatch (ExitFailure 1) = Right False + dispatch _ = cantCheck r + +{- Removes a key from a remote. -} +dropKey :: Git.Repo -> Key -> Annex Bool +dropKey r key = onRemote r (boolSystem, False) "dropkey" + [ Params "--quiet --force" + , Param $ key2file key + ] + [] + +rsyncHelper :: Maybe MeterUpdate -> [CommandParam] -> Annex Bool +rsyncHelper callback params = do + showOutput -- make way for progress bar + ifM (liftIO $ (maybe rsync rsyncProgress callback) params) + ( return True + , do + showLongNote "rsync failed -- run git annex again to resume file transfer" + return False + ) + +{- Generates rsync parameters that ssh to the remote and asks it + - to either receive or send the key's content. -} +rsyncParamsRemote :: Bool -> Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam] +rsyncParamsRemote direct r direction key file afile = do + u <- getUUID + let fields = (Fields.remoteUUID, fromUUID u) + : (Fields.direct, if direct then "1" else "") + : maybe [] (\f -> [(Fields.associatedFile, f)]) afile + Just (shellcmd, shellparams) <- git_annex_shell (repo r) + (if direction == Download then "sendkey" else "recvkey") + [ Param $ key2file key ] + fields + -- Convert the ssh command into rsync command line. + let eparam = rsyncShell (Param shellcmd:shellparams) + let o = rsyncParams r + return $ if direction == Download + then o ++ rsyncopts eparam dummy (File file) + else o ++ rsyncopts eparam (File file) dummy + where + rsyncopts ps source dest + | end ps == [dashdash] = ps ++ [source, dest] + | otherwise = ps ++ [dashdash, source, dest] + dashdash = Param "--" + {- The rsync shell parameter controls where rsync + - goes, so the source/dest parameter can be a dummy value, + - that just enables remote rsync mode. + - For maximum compatability with some patched rsyncs, + - the dummy value needs to still contain a hostname, + - even though this hostname will never be used. -} + dummy = Param "dummy:" + +-- --inplace to resume partial files +rsyncParams :: Remote -> [CommandParam] +rsyncParams r = Params "--progress --inplace" : + map Param (remoteAnnexRsyncOptions $ gitconfig r) + diff --git a/Remote/Hook.hs b/Remote/Hook.hs index ba20f35664..21d02c19d8 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -93,7 +93,7 @@ lookupHook hookname action = do command <- getConfig (annexConfig hook) "" if null command then do - fallback <- getConfig (annexConfig $ hookfallback) "" + fallback <- getConfig (annexConfig hookfallback) "" if null fallback then do warning $ "missing configuration for " ++ hook ++ " or " ++ hookfallback diff --git a/Remote/List.hs b/Remote/List.hs index 271ee87945..d53b92912f 100644 --- a/Remote/List.hs +++ b/Remote/List.hs @@ -80,7 +80,7 @@ remoteListRefresh = do remoteList {- Generates a Remote. -} -remoteGen :: (M.Map UUID RemoteConfig) -> RemoteType -> Git.Repo -> Annex (Maybe Remote) +remoteGen :: M.Map UUID RemoteConfig -> RemoteType -> Git.Repo -> Annex (Maybe Remote) remoteGen m t r = do u <- getRepoUUID r g <- fromRepo id diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index f1e6fd85ea..673f7661f3 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -86,7 +86,7 @@ gen r u c gc = do then Just $ rsyncUrl o else Nothing , readonly = False - , globallyAvailable = not $ islocal + , globallyAvailable = not islocal , remotetype = remote } @@ -236,7 +236,7 @@ sendParams = ifM crippledFileSystem {- Runs an action in an empty scratch directory that can be used to build - up trees for rsync. -} -withRsyncScratchDir :: (FilePath -> Annex Bool) -> Annex Bool +withRsyncScratchDir :: (FilePath -> Annex a) -> Annex a withRsyncScratchDir a = do #ifndef mingw32_HOST_OS v <- liftIO getProcessID @@ -262,7 +262,7 @@ rsyncRetrieve o k dest callback = , File dest ] -rsyncRemote :: RsyncOpts -> (Maybe MeterUpdate) -> [CommandParam] -> Annex Bool +rsyncRemote :: RsyncOpts -> Maybe MeterUpdate -> [CommandParam] -> Annex Bool rsyncRemote o callback params = do showOutput -- make way for progress bar ifM (liftIO $ (maybe rsync rsyncProgress callback) ps) diff --git a/Remote/Web.hs b/Remote/Web.hs index 789aab6988..af60beee05 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -19,7 +19,7 @@ import Config.Cost import Logs.Web import Types.Key import Utility.Metered -import qualified Utility.Url as Url +import qualified Annex.Url as Url #ifdef WITH_QUVI import Annex.Quvi import qualified Utility.Quvi as Quvi @@ -118,7 +118,7 @@ checkKey' key us = firsthit us (Right False) $ \u -> do #endif DefaultDownloader -> do headers <- getHttpHeaders - liftIO $ Right <$> Url.check u' headers (keySize key) + Right <$> Url.withUserAgent (Url.check u' headers $ keySize key) where firsthit [] miss _ = return miss firsthit (u:rest) _ a = do diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 97a6d96f9d..ef4a5ed58f 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -181,9 +181,9 @@ checkPresent r k = davAction r noconn go - or perhaps this was an intermittent error. -} onerr url = do v <- davUrlExists url user pass - if v == Right True - then return $ Left $ "failed to read " ++ url - else return v + return $ if v == Right True + then Left $ "failed to read " ++ url + else v withStoredFiles :: Remote diff --git a/Seek.hs b/Seek.hs index b0a6345641..85b266d497 100644 --- a/Seek.hs +++ b/Seek.hs @@ -60,7 +60,7 @@ withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CommandSeek withPathContents a params = map a . concat <$> liftIO (mapM get params) where get p = ifM (isDirectory <$> getFileStatus p) - ( map (\f -> (f, makeRelative p f)) <$> dirContentsRecursive p + ( map (\f -> (f, makeRelative (parentDir p) f)) <$> dirContentsRecursive p , return [(p, takeFileName p)] ) diff --git a/Test.hs b/Test.hs index 17047af5bb..5cf1aea9e3 100644 --- a/Test.hs +++ b/Test.hs @@ -58,6 +58,7 @@ import qualified Utility.InodeCache import qualified Utility.Env import qualified Utility.Matcher import qualified Utility.Exception +import qualified Utility.Hash #ifndef mingw32_HOST_OS import qualified GitAnnex import qualified Remote.Helper.Encryptable @@ -136,6 +137,7 @@ quickcheck = , check "prop_parse_show_log" Logs.Presence.prop_parse_show_log , check "prop_read_show_TrustLevel" Types.TrustLevel.prop_read_show_TrustLevel , check "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog + , check "prop_hashes_stable" Utility.Hash.prop_hashes_stable ] where check desc prop = do diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index 4f2e913319..5db38e68ff 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -42,6 +42,7 @@ data GitConfig = GitConfig , annexCrippledFileSystem :: Bool , annexLargeFiles :: Maybe String , coreSymlinks :: Bool + , gcryptId :: Maybe String } extractGitConfig :: Git.Repo -> GitConfig @@ -68,6 +69,7 @@ extractGitConfig r = GitConfig , annexCrippledFileSystem = getbool (annex "crippledfilesystem") False , annexLargeFiles = getmaybe (annex "largefiles") , coreSymlinks = getbool "core.symlinks" True + , gcryptId = getmaybe "core.gcrypt-id" } where get k def = fromMaybe def $ getmayberead k @@ -104,6 +106,7 @@ data RemoteGitConfig = RemoteGitConfig , remoteAnnexBupRepo :: Maybe String , remoteAnnexBupSplitOptions :: [String] , remoteAnnexDirectory :: Maybe FilePath + , remoteAnnexGCrypt :: Maybe String , remoteAnnexHookType :: Maybe String {- A regular git remote's git repository config. -} , remoteGitConfig :: Maybe GitConfig @@ -127,6 +130,7 @@ extractRemoteGitConfig r remotename = RemoteGitConfig , remoteAnnexBupRepo = getmaybe "buprepo" , remoteAnnexBupSplitOptions = getoptions "bup-split-options" , remoteAnnexDirectory = notempty $ getmaybe "directory" + , remoteAnnexGCrypt = notempty $ getmaybe "gcrypt" , remoteAnnexHookType = notempty $ getmaybe "hooktype" , remoteGitConfig = Nothing } diff --git a/Types/Remote.hs b/Types/Remote.hs index 78008ce06b..918566e8dd 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -18,6 +18,7 @@ import Types.UUID import Types.GitConfig import Config.Cost import Utility.Metered +import Git.Remote type RemoteConfigKey = String type RemoteConfig = M.Map RemoteConfigKey String @@ -42,7 +43,7 @@ data RemoteA a = Remote { -- each Remote has a unique uuid uuid :: UUID, -- each Remote has a human visible name - name :: String, + name :: RemoteName, -- Remotes have a use cost; higher is more expensive cost :: Cost, -- Transfers a key to the remote. diff --git a/Types/StandardGroups.hs b/Types/StandardGroups.hs index 30b8822820..2d977a3579 100644 --- a/Types/StandardGroups.hs +++ b/Types/StandardGroups.hs @@ -77,7 +77,7 @@ preferredContent ClientGroup = lastResort $ preferredContent TransferGroup = lastResort $ "not (inallgroup=client and copies=client:2) and (" ++ preferredContent ClientGroup ++ ")" preferredContent BackupGroup = "include=*" -preferredContent IncrementalBackupGroup = lastResort $ +preferredContent IncrementalBackupGroup = lastResort "include=* and (not copies=incrementalbackup:1)" preferredContent SmallArchiveGroup = lastResort $ "(include=*/archive/* or include=archive/*) and (" ++ preferredContent FullArchiveGroup ++ ")" diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index 9793f04e8a..688f4c5718 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -107,7 +107,7 @@ moveLocationLogs = do dir <- fromRepo Upgrade.V2.gitStateDir ifM (liftIO $ doesDirectoryExist dir) ( mapMaybe oldlog2key - <$> (liftIO $ getDirectoryContents dir) + <$> liftIO (getDirectoryContents dir) , return [] ) move (l, k) = do diff --git a/Utility/Data.hs b/Utility/Data.hs new file mode 100644 index 0000000000..3592582967 --- /dev/null +++ b/Utility/Data.hs @@ -0,0 +1,17 @@ +{- utilities for simple data types + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.Data where + +{- First item in the list that is not Nothing. -} +firstJust :: Eq a => [Maybe a] -> Maybe a +firstJust ms = case dropWhile (== Nothing) ms of + [] -> Nothing + (md:_) -> md + +eitherToMaybe :: Either a b -> Maybe b +eitherToMaybe = either (const Nothing) Just diff --git a/Utility/Exception.hs b/Utility/Exception.hs index 3835d741dd..cf2c615c7e 100644 --- a/Utility/Exception.hs +++ b/Utility/Exception.hs @@ -14,6 +14,7 @@ import qualified Control.Exception as E import Control.Applicative import Control.Monad import System.IO.Error (isDoesNotExistError) +import Utility.Data {- Catches IO errors and returns a Bool -} catchBoolIO :: IO Bool -> IO Bool @@ -54,5 +55,5 @@ tryNonAsync a = (Right <$> a) `catchNonAsync` (return . Left) {- Catches only DoesNotExist exceptions, and lets all others through. -} tryWhenExists :: IO a -> IO (Maybe a) -tryWhenExists a = either (const Nothing) Just <$> +tryWhenExists a = eitherToMaybe <$> tryJust (guard . isDoesNotExistError) a diff --git a/Utility/ExternalSHA.hs b/Utility/ExternalSHA.hs index 21241d302b..adbde795ab 100644 --- a/Utility/ExternalSHA.hs +++ b/Utility/ExternalSHA.hs @@ -1,6 +1,7 @@ {- Calculating a SHA checksum with an external command. - - - This is often faster than using Haskell libraries. + - This is typically a bit faster than using Haskell libraries, + - by around 1% to 10%. Worth it for really big files. - - Copyright 2011-2013 Joey Hess - diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index f9b3d55e83..a2baa74dc6 100644 --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -369,7 +369,7 @@ checkGpgPackets keys str = do (Just (KeyIds ks), ls, []) -> do -- Find the master key associated with the -- encryption subkey. - ks' <- concat <$> mapM (findPubKeys >=*> keyIds) + ks' <- concat <$> mapM (keyIds <$$> findPubKeys) [ k | k:"keyid":_ <- map (reverse . words) ls ] return $ sort (nub ks) == sort (nub ks') _ -> return False diff --git a/Utility/Hash.hs b/Utility/Hash.hs new file mode 100644 index 0000000000..8b25998aeb --- /dev/null +++ b/Utility/Hash.hs @@ -0,0 +1,48 @@ +{- Convenience wrapper around cryptohash. + - + - The resulting Digests can be shown to get a canonical hash encoding. -} + +module Utility.Hash where + +import Crypto.Hash +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Char8 as C8 + +sha1 :: L.ByteString -> Digest SHA1 +sha1 = hashlazy + +sha224 :: L.ByteString -> Digest SHA224 +sha224 = hashlazy + +sha256 :: L.ByteString -> Digest SHA256 +sha256 = hashlazy + +sha384 :: L.ByteString -> Digest SHA384 +sha384 = hashlazy + +sha512 :: L.ByteString -> Digest SHA512 +sha512 = hashlazy + +-- sha3 is not yet fully standardized +--sha3 :: L.ByteString -> Digest SHA3 +--sha3 = hashlazy + +skein256 :: L.ByteString -> Digest Skein256_256 +skein256 = hashlazy + +skein512 :: L.ByteString -> Digest Skein512_512 +skein512 = hashlazy + +{- Check that all the hashes continue to hash the same. -} +prop_hashes_stable :: Bool +prop_hashes_stable = all (\(hasher, result) -> hasher foo == result) + [ (show . sha1, "0beec7b5ea3f0fdbc95d0dd47f3c5bc275da8a33") + , (show . sha224, "0808f64e60d58979fcb676c96ec938270dea42445aeefcd3a4e6f8db") + , (show . sha256, "2c26b46b68ffc68ff99b453c1d30413413422d706483bfa0f98a5e886266e7ae") + , (show . sha384, "98c11ffdfdd540676b1a137cb1a22b2a70350c9a44171d6b1180c6be5cbb2ee3f79d532c8a1dd9ef2e8e08e752a3babb") + , (show . sha512, "f7fbba6e0636f890e56fbbf3283e524c6fa3204ae298382d624741d0dc6638326e282c41be5e4254d8820772c5518a2c5a8c0c7f7eda19594a7eb539453e1ed7") + , (show . skein256, "a04efd9a0aeed6ede40fe5ce0d9361ae7b7d88b524aa19917b9315f1ecf00d33") + , (show . skein512, "fd8956898113510180aa4658e6c0ac85bd74fb47f4a4ba264a6b705d7a8e8526756e75aecda12cff4f1aca1a4c2830fbf57f458012a66b2b15a3dd7d251690a7") + ] + where + foo = L.fromChunks [C8.pack "foo"] diff --git a/Utility/INotify.hs b/Utility/INotify.hs index e9071d906f..ffdad8be33 100644 --- a/Utility/INotify.hs +++ b/Utility/INotify.hs @@ -54,11 +54,12 @@ watchDir i dir ignored hooks -- scan come before real inotify events. lock <- newLock let handler event = withLock lock (void $ go event) - void (addWatch i watchevents dir handler) - `catchIO` failedaddwatch - withLock lock $ - mapM_ scan =<< filter (not . dirCruft) <$> - getDirectoryContents dir + flip catchNonAsync failedwatch $ do + void (addWatch i watchevents dir handler) + `catchIO` failedaddwatch + withLock lock $ + mapM_ scan =<< filter (not . dirCruft) <$> + getDirectoryContents dir where recurse d = watchDir i d ignored hooks @@ -149,12 +150,14 @@ watchDir i dir ignored hooks -- disk full error. | isFullError e = case errHook hooks of - Nothing -> throw e + Nothing -> error $ "failed to add inotify watch on directory " ++ dir ++ " (" ++ show e ++ ")" Just hook -> tooManyWatches hook dir -- The directory could have been deleted. | isDoesNotExistError e = return () | otherwise = throw e + failedwatch e = hPutStrLn stderr $ "failed to add watch on directory " ++ dir ++ " (" ++ show e ++ ")" + tooManyWatches :: (String -> Maybe FileStatus -> IO ()) -> FilePath -> IO () tooManyWatches hook dir = do sysctlval <- querySysctl [Param maxwatches] :: IO (Maybe Integer) diff --git a/Utility/InodeCache.hs b/Utility/InodeCache.hs index 8037c61c86..46ca87bd97 100644 --- a/Utility/InodeCache.hs +++ b/Utility/InodeCache.hs @@ -49,6 +49,9 @@ instance Eq InodeCacheKey where inodeCacheToKey :: InodeComparisonType -> InodeCache -> InodeCacheKey inodeCacheToKey ct (InodeCache prim) = InodeCacheKey ct prim +inodeCacheToMtime :: InodeCache -> EpochTime +inodeCacheToMtime (InodeCache (InodeCachePrim _ _ mtime)) = mtime + showInodeCache :: InodeCache -> String showInodeCache (InodeCache (InodeCachePrim inode size mtime)) = unwords [ show inode diff --git a/Utility/Misc.hs b/Utility/Misc.hs index 48ce4c9294..804a9e4872 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -91,12 +91,6 @@ massReplace vs = go [] vs go (replacement:acc) vs (drop (length val) s) | otherwise = go acc rest s -{- First item in the list that is not Nothing. -} -firstJust :: Eq a => [Maybe a] -> Maybe a -firstJust ms = case dropWhile (== Nothing) ms of - [] -> Nothing - (md:_) -> md - {- Given two orderings, returns the second if the first is EQ and returns - the first otherwise. - diff --git a/Utility/Monad.hs b/Utility/Monad.hs index 4f5a6d2449..1ba43c5f81 100644 --- a/Utility/Monad.hs +++ b/Utility/Monad.hs @@ -53,16 +53,6 @@ ma <&&> mb = ifM ma ( mb , return False ) infixr 3 <&&> infixr 2 <||> -{- Left-to-right Kleisli composition with a pure left/right hand side. -} -(*>=>) :: Monad m => (a -> b) -> (b -> m c) -> (a -> m c) -f *>=> g = return . f >=> g - -(>=*>) :: Monad m => (a -> m b) -> (b -> c) -> (a -> m c) -f >=*> g = f >=> return . g - -{- Same fixity as >=> and <=< -} -infixr 1 *>=>, >=*> - {- Runs an action, passing its value to an observer before returning it. -} observe :: Monad m => (a -> m b) -> m a -> m a observe observer a = do diff --git a/Utility/Url.hs b/Utility/Url.hs index 2f2ec1dc06..baea0fda1e 100644 --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -9,6 +9,7 @@ module Utility.Url ( URLString, + UserAgent, check, exists, download, @@ -27,10 +28,12 @@ type URLString = String type Headers = [String] +type UserAgent = String + {- Checks that an url exists and could be successfully downloaded, - also checking that its size, if available, matches a specified size. -} -check :: URLString -> Headers -> Maybe Integer -> IO Bool -check url headers expected_size = handle <$> exists url headers +check :: URLString -> Headers -> Maybe Integer -> Maybe UserAgent -> IO Bool +check url headers expected_size = handle <$$> exists url headers where handle (False, _) = False handle (True, Nothing) = True @@ -44,8 +47,8 @@ check url headers expected_size = handle <$> exists url headers - Uses curl otherwise, when available, since curl handles https better - than does Haskell's Network.Browser. -} -exists :: URLString -> Headers -> IO (Bool, Maybe Integer) -exists url headers = case parseURIRelaxed url of +exists :: URLString -> Headers -> Maybe UserAgent -> IO (Bool, Maybe Integer) +exists url headers ua = case parseURIRelaxed url of Just u | uriScheme u == "file:" -> do s <- catchMaybeIO $ getFileStatus (unEscapeString $ uriPath u) @@ -54,12 +57,12 @@ exists url headers = case parseURIRelaxed url of Nothing -> dne | otherwise -> if Build.SysConfig.curl then do - output <- readProcess "curl" curlparams + output <- readProcess "curl" $ toCommand curlparams case lastMaybe (lines output) of Just ('2':_:_) -> return (True, extractsize output) _ -> dne else do - r <- request u headers HEAD + r <- request u headers HEAD ua case rspCode r of (2,_,_) -> return (True, size r) _ -> return (False, Nothing) @@ -67,13 +70,12 @@ exists url headers = case parseURIRelaxed url of where dne = return (False, Nothing) - curlparams = - [ "-s" - , "--head" - , "-L" - , url - , "-w", "%{http_code}" - ] ++ concatMap (\h -> ["-H", h]) headers + curlparams = addUserAgent ua $ + [ Param "-s" + , Param "--head" + , Param "-L", Param url + , Param "-w", Param "%{http_code}" + ] ++ concatMap (\h -> [Param "-H", Param h]) headers extractsize s = case lastMaybe $ filter ("Content-Length:" `isPrefixOf`) (lines s) of Just l -> case lastMaybe $ words l of @@ -83,6 +85,11 @@ exists url headers = case parseURIRelaxed url of size = liftM Prelude.read . lookupHeader HdrContentLength . rspHeaders +-- works for both wget and curl commands +addUserAgent :: Maybe UserAgent -> [CommandParam] -> [CommandParam] +addUserAgent Nothing ps = ps +addUserAgent (Just ua) ps = ps ++ [Param "--user-agent", Param ua] + {- Used to download large files, such as the contents of keys. - - Uses wget or curl program for its progress bar. (Wget has a better one, @@ -90,15 +97,15 @@ exists url headers = case parseURIRelaxed url of - would not be appropriate to test at configure time and build support - for only one in. -} -download :: URLString -> Headers -> [CommandParam] -> FilePath -> IO Bool +download :: URLString -> Headers -> [CommandParam] -> FilePath -> Maybe UserAgent -> IO Bool download = download' False {- No output, even on error. -} -downloadQuiet :: URLString -> Headers -> [CommandParam] -> FilePath -> IO Bool +downloadQuiet :: URLString -> Headers -> [CommandParam] -> FilePath -> Maybe UserAgent -> IO Bool downloadQuiet = download' True -download' :: Bool -> URLString -> Headers -> [CommandParam] -> FilePath -> IO Bool -download' quiet url headers options file = +download' :: Bool -> URLString -> Headers -> [CommandParam] -> FilePath -> Maybe UserAgent -> IO Bool +download' quiet url headers options file ua = case parseURIRelaxed url of Just u | uriScheme u == "file:" -> do @@ -119,7 +126,7 @@ download' quiet url headers options file = curl = go "curl" $ headerparams ++ quietopt "-s" ++ [Params "-f -L -C - -# -o"] go cmd opts = boolSystem cmd $ - options++opts++[File file, File url] + addUserAgent ua $ options++opts++[File file, File url] quietopt s | quiet = [Param s] | otherwise = [] @@ -134,13 +141,14 @@ download' quiet url headers options file = - Unfortunately, does not handle https, so should only be used - when curl is not available. -} -request :: URI -> Headers -> RequestMethod -> IO (Response String) -request url headers requesttype = go 5 url +request :: URI -> Headers -> RequestMethod -> Maybe UserAgent -> IO (Response String) +request url headers requesttype ua = go 5 url where go :: Int -> URI -> IO (Response String) go 0 _ = error "Too many redirects " go n u = do rsp <- Browser.browse $ do + maybe noop Browser.setUserAgent ua Browser.setErrHandler ignore Browser.setOutHandler ignore Browser.setAllowRedirects False diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs index f3c0d3a6b3..c078a56439 100644 --- a/Utility/WebApp.hs +++ b/Utility/WebApp.hs @@ -12,6 +12,7 @@ module Utility.WebApp where import Common import Utility.Tmp import Utility.FileMode +import Utility.Hash import qualified Yesod import qualified Network.Wai as Wai @@ -24,7 +25,6 @@ import qualified Data.CaseInsensitive as CI import Network.Socket import Control.Exception import Crypto.Random -import Data.Digest.Pure.SHA import qualified Web.ClientSession as CS import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.UTF8 as L8 @@ -214,7 +214,7 @@ genRandomToken = do return $ case genBytes 512 g of Left e -> error $ "failed to generate secret token: " ++ show e - Right (s, _) -> showDigest $ sha512 $ L.fromChunks [s] + Right (s, _) -> show $ sha512 $ L.fromChunks [s] {- A Yesod isAuthorized method, which checks the auth cgi parameter - against a token extracted from the Yesod application. diff --git a/debian/NEWS b/debian/NEWS index 1c95146912..aad7ccb0b2 100644 --- a/debian/NEWS +++ b/debian/NEWS @@ -1,3 +1,11 @@ +git-annex (4.20130921) unstable; urgency=low + + The layout of gcrypt repositories has changed, and + if you created one you must manually upgrade it. + See /usr/share/doc/git-annex/html/upgrades/gcrypt.html + + -- Joey Hess Tue, 24 Sep 2013 13:55:23 -0400 + git-annex (3.20120123) unstable; urgency=low There was a bug in the handling of directory special remotes that diff --git a/debian/changelog b/debian/changelog index 1aefe75f73..4959d21777 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,42 @@ +git-annex (4.20131002) unstable; urgency=low + + * Note that the layout of gcrypt repositories has changed, and + if you created one you must manually upgrade it. + See http://git-annex.branchable.com/upgrades/gcrypt/ + * webapp: Support setting up and using encrypted git repositories on + any ssh server, as well as on rsync.net. + * git-annex-shell: Added support for operating inside gcrypt repositories. + * Disable receive.denyNonFastForwards when setting up a gcrypt special + remote, since gcrypt needs to be able to fast-forward the master branch. + * import: Preserve top-level directory structure. + * Use cryptohash rather than SHA for hashing when no external hash program + is available. This is a significant speedup for SHA256 on OSX, for + example. + * Added SKEIN256 and SKEIN512 backends. + * Android build redone from scratch, many dependencies updated, + and entire build can now be done using provided scripts. + * assistant: Clear the list of failed transfers when doing a full transfer + scan. This prevents repeated retries to download files that are not + available, or are not referenced by the current git tree. + * indirect, direct: Better behavior when a file is not owned by + the user running the conversion. + * add, import, assistant: Better preserve the mtime of symlinks, + when when adding content that gets deduplicated. + * Send a git-annex user-agent when downloading urls. + Overridable with --user-agent option. + (Not yet done for S3 or WebDAV due to limitations of libraries used.) + * webapp: Fixed a bug where when a new remote is added, one file + may fail to sync to or from it due to the transferrer process not + yet knowing about the new remote. + * OSX: Bundled gpg upgraded, now compatible with config files + written by MacGPG. + * assistant: More robust inotify handling; avoid crashing if a directory + cannot be read. + * Moved list of backends and remote types from status to version + command. + + -- Joey Hess Wed, 02 Oct 2013 16:00:39 -0400 + git-annex (4.20130920~bpo70+1) wheezy-backports; urgency=low * webapp: Initial support for setting up encrypted removable drives. diff --git a/debian/control b/debian/control index 030ae6bd67..417e0ebcbc 100644 --- a/debian/control +++ b/debian/control @@ -9,6 +9,7 @@ Build-Depends: libghc-hslogger-dev, libghc-pcre-light-dev, libghc-sha-dev, + libghc-cryptohash-dev, libghc-regex-tdfa-dev [!mips !mipsel !s390], libghc-dataenc-dev, libghc-utf8-string-dev, diff --git a/doc/assistant/release_notes.mdwn b/doc/assistant/release_notes.mdwn index 5cca797f93..85ca5cb554 100644 --- a/doc/assistant/release_notes.mdwn +++ b/doc/assistant/release_notes.mdwn @@ -1,3 +1,15 @@ +## version 4.20131002 + +Now you can use the webapp to set up an encrypted git repository on a +remote ssh server, or on rsync.net, and use it as a live cloud backup. Or, +use the webapp to make an encrypted git repository on a removable drive, +and store it offsite as a secure backup. + +## version 4.20130920 + +This release is the first to support fully encrypted git repositories +stored on removable drives. This can be set up easily using the webapp. + ## version 4.20130909 This release fixes a crash that could occur when using XMPP with the diff --git a/doc/assistant/rsync.net.encryption.png b/doc/assistant/rsync.net.encryption.png new file mode 100644 index 0000000000..ec751d10d2 Binary files /dev/null and b/doc/assistant/rsync.net.encryption.png differ diff --git a/doc/backends.mdwn b/doc/backends.mdwn index 9abe6eac03..79bacd68e7 100644 --- a/doc/backends.mdwn +++ b/doc/backends.mdwn @@ -21,6 +21,8 @@ can use different ones for different files. but are not concerned about security. * `SHA384`, `SHA384E`, `SHA224`, `SHA224E` -- Hashes for people who like unusual sizes. +* `SKEIN512`, `SKEIN256` -- [Skein hash](http://en.wikipedia.org/wiki/Skein_hash), + a well-regarded SHA3 hash competition finalist. The `annex.backends` git-config setting can be used to list the backends git-annex should use. The first one listed will be used by default when diff --git a/doc/bare_repositories.mdwn b/doc/bare_repositories.mdwn index 86652792b4..7fa0359856 100644 --- a/doc/bare_repositories.mdwn +++ b/doc/bare_repositories.mdwn @@ -31,7 +31,7 @@ Here is a quick example of how to set this up, using `origin` as the remote name On the server: git init --bare bare-annex.git - git annex init origin + cd bare-annex.git && git annex init origin Now configure the remote and do the initial push: diff --git a/doc/bugs/Assistant_stalls_when_adding__47__creating_repo_on_ArchLinux/comment_3_5a89d79395d96c43d7d8a6fd9dc275f1._comment b/doc/bugs/Assistant_stalls_when_adding__47__creating_repo_on_ArchLinux/comment_3_5a89d79395d96c43d7d8a6fd9dc275f1._comment new file mode 100644 index 0000000000..39f0f39b88 --- /dev/null +++ b/doc/bugs/Assistant_stalls_when_adding__47__creating_repo_on_ArchLinux/comment_3_5a89d79395d96c43d7d8a6fd9dc275f1._comment @@ -0,0 +1,248 @@ +[[!comment format=mdwn + username="http://olivier.mehani.name/" + nickname="olivier-mehani" + subject="comment 3" + date="2013-09-30T01:29:50Z" + content=""" +This is when having manually created the local annex, and trying to add a remote one. Surprisingly, I cannot find any reference to the remote server's address or username... + + [2013-09-30 11:14:38 EST] main: starting assistant version 4.20130827 + [2013-09-30 11:14:38 EST] read: git [\"--git-dir=/home/USERNAME/annex/.git\",\"--work-tree=/home/USERNAME/annex\",\"show-ref\",\"git-annex\"] + [2013-09-30 11:14:38 EST] read: xdg-open [\"file:///home/USERNAME/annex/.git/annex/webapp.html\"] + [2013-09-30 11:14:38 EST] read: git [\"--git-dir=/home/USERNAME/annex/.git\",\"--work-tree=/home/USERNAME/annex\",\"show-ref\",\"--hash\",\"refs/heads/git-annex\"] + [2013-09-30 11:14:38 EST] read: git [\"--git-dir=/home/USERNAME/annex/.git\",\"--work-tree=/home/USERNAME/annex\",\"log\",\"refs/heads/git-annex..9d87789505628a2da8347574cc600e358ff76107\",\"--oneline\",\"-n1\"] + [2013-09-30 11:14:38 EST] Merger: watching /home/USERNAME/annex/.git/refs + [2013-09-30 11:14:38 EST] TransferWatcher: watching for transfers + [2013-09-30 11:14:38 EST] read: git [\"--git-dir=/home/USERNAME/annex/.git\",\"--work-tree=/home/USERNAME/annex\",\"ls-tree\",\"-z\",\"--\",\"refs/heads/git-annex\",\"uuid.log\",\"remote.log\",\"trust.log\",\"group.log\",\"preferred-content.log\"] + + No known network monitor available through dbus; falling back to polling + [2013-09-30 11:14:38 EST] read: git [\"--git-dir=/home/USERNAME/annex/.git\",\"--work-tree=/home/USERNAME/annex\",\"ls-tree\",\"-z\",\"--\",\"refs/heads/git-annex\",\"uuid.log\",\"remote.log\",\"trust.log\",\"group.log\",\"preferred-content.log\"] + (scanning...) [2013-09-30 11:14:38 EST] Watcher: Performing startup scan + [2013-09-30 11:14:38 EST] read: git [\"--git-dir=/home/USERNAME/annex/.git\",\"--work-tree=/home/USERNAME/annex\",\"ls-files\",\"--deleted\",\"-z\",\"--\",\"/home/USERNAME/annex\"] + (started...) [2013-09-30 11:14:38 EST] Watcher: watching . + [2013-09-30 11:14:38 EST] MountWatcher: Started DBUS service org.gtk.Private.UDisks2VolumeMonitor to monitor mount events. + [2013-09-30 11:14:39 EST] 127.0.0.1 GET / Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] read: git [\"--git-dir=/home/USERNAME/annex/.git\",\"--work-tree=/home/USERNAME/annex\",\"show-ref\",\"git-annex\"] + [2013-09-30 11:14:39 EST] read: git [\"--git-dir=/home/USERNAME/annex/.git\",\"--work-tree=/home/USERNAME/annex\",\"show-ref\",\"--hash\",\"refs/heads/git-annex\"] + [2013-09-30 11:14:39 EST] read: git [\"--git-dir=/home/USERNAME/annex/.git\",\"--work-tree=/home/USERNAME/annex\",\"log\",\"refs/heads/git-annex..9d87789505628a2da8347574cc600e358ff76107\",\"--oneline\",\"-n1\"] + [2013-09-30 11:14:39 EST] chat: git [\"--git-dir=/home/USERNAME/annex/.git\",\"--work-tree=/home/USERNAME/annex\",\"cat-file\",\"--batch\"] + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /static/css/bootstrap.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /static/css/bootstrap-responsive.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /static/jquery.full.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /static/js/bootstrap-dropdown.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /static/js/bootstrap-modal.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /static/js/bootstrap-collapse.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /static/longpolling.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /static/jquery.ui.core.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /static/jquery.ui.widget.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /static/jquery.ui.mouse.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /static/jquery.ui.sortable.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /static/img/glyphicons-halflings-white.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /static/img/glyphicons-halflings.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /notifier/sidebar Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /notifier/repolist/RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True,%20nudgeAddMore%20=%20True%7D Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /notifier/transfers Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /static/favicon.ico Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /sidebar/NotificationId%200 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /repolist/RepoListNotificationId%20(NotificationId%200)%20(RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True,%20nudgeAddMore%20=%20True%7D) Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /transfers/NotificationId%201 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /transfers/NotificationId%201 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:39 EST] 127.0.0.1 GET /repolist/RepoListNotificationId%20(NotificationId%200)%20(RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True,%20nudgeAddMore%20=%20True%7D) Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:40 EST] 127.0.0.1 GET /sidebar/NotificationId%200 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:40 EST] 127.0.0.1 GET /transfers/NotificationId%201 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:40 EST] 127.0.0.1 GET /transfers/NotificationId%201 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:40 EST] 127.0.0.1 GET /static/favicon.ico Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:14:40 EST] 127.0.0.1 GET /static/favicon.ico Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:16 EST] 127.0.0.1 GET /config Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:16 EST] 127.0.0.1 GET /sidebar/NotificationId%200 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:16 EST] 127.0.0.1 GET /transfers/NotificationId%201 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:16 EST] 127.0.0.1 GET /repolist/RepoListNotificationId%20(NotificationId%200)%20(RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True,%20nudgeAddMore%20=%20True%7D) Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:16 EST] 127.0.0.1 GET /static/css/bootstrap.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:16 EST] 127.0.0.1 GET /static/css/bootstrap-responsive.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:16 EST] 127.0.0.1 GET /static/jquery.full.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:16 EST] 127.0.0.1 GET /static/js/bootstrap-dropdown.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:16 EST] 127.0.0.1 GET /static/js/bootstrap-modal.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:16 EST] 127.0.0.1 GET /static/js/bootstrap-collapse.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:16 EST] 127.0.0.1 GET /static/longpolling.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:16 EST] 127.0.0.1 GET /static/img/glyphicons-halflings-white.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:16 EST] 127.0.0.1 GET /static/img/glyphicons-halflings.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:16 EST] 127.0.0.1 GET /notifier/sidebar Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:17 EST] 127.0.0.1 GET /sidebar/NotificationId%201 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:17 EST] 127.0.0.1 GET /static/favicon.ico Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:17 EST] 127.0.0.1 GET /sidebar/NotificationId%201 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:19 EST] 127.0.0.1 GET /config/addrepository Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:19 EST] 127.0.0.1 GET /static/css/bootstrap.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:19 EST] 127.0.0.1 GET /static/css/bootstrap-responsive.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:19 EST] 127.0.0.1 GET /static/jquery.full.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:19 EST] 127.0.0.1 GET /static/js/bootstrap-dropdown.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:19 EST] 127.0.0.1 GET /static/js/bootstrap-modal.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:19 EST] 127.0.0.1 GET /static/js/bootstrap-collapse.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:19 EST] 127.0.0.1 GET /static/longpolling.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:19 EST] 127.0.0.1 GET /static/jquery.ui.core.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:19 EST] 127.0.0.1 GET /static/jquery.ui.widget.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:19 EST] 127.0.0.1 GET /static/jquery.ui.mouse.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:19 EST] 127.0.0.1 GET /static/jquery.ui.sortable.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:19 EST] 127.0.0.1 GET /static/img/glyphicons-halflings.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:19 EST] 127.0.0.1 GET /static/img/glyphicons-halflings-white.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:19 EST] 127.0.0.1 GET /notifier/sidebar Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:19 EST] 127.0.0.1 GET /notifier/repolist/RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True,%20nudgeAddMore%20=%20False%7D Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:20 EST] 127.0.0.1 GET /sidebar/NotificationId%202 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:20 EST] 127.0.0.1 GET /repolist/RepoListNotificationId%20(NotificationId%201)%20(RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True,%20nudgeAddMore%20=%20False%7D) Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:20 EST] 127.0.0.1 GET /repolist/RepoListNotificationId%20(NotificationId%201)%20(RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True,%20nudgeAddMore%20=%20False%7D) Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:20 EST] 127.0.0.1 GET /static/favicon.ico Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:20 EST] 127.0.0.1 GET /sidebar/NotificationId%202 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:31 EST] 127.0.0.1 GET /config/repository/add/ssh Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:31 EST] 127.0.0.1 GET /repolist/RepoListNotificationId%20(NotificationId%201)%20(RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True,%20nudgeAddMore%20=%20False%7D) Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:31 EST] 127.0.0.1 GET /sidebar/NotificationId%202 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:31 EST] 127.0.0.1 GET /static/css/bootstrap.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:31 EST] 127.0.0.1 GET /static/css/bootstrap-responsive.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:31 EST] 127.0.0.1 GET /static/js/bootstrap-dropdown.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:31 EST] 127.0.0.1 GET /static/jquery.full.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:31 EST] 127.0.0.1 GET /static/js/bootstrap-modal.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:31 EST] 127.0.0.1 GET /static/js/bootstrap-collapse.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:31 EST] 127.0.0.1 GET /static/longpolling.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:32 EST] 127.0.0.1 GET /static/img/glyphicons-halflings-white.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:32 EST] 127.0.0.1 GET /static/img/glyphicons-halflings.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:32 EST] 127.0.0.1 GET /notifier/sidebar Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:32 EST] 127.0.0.1 GET /sidebar/NotificationId%203 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:32 EST] 127.0.0.1 GET /static/favicon.ico Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:32 EST] 127.0.0.1 GET /sidebar/NotificationId%203 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET / Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /static/css/bootstrap.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /static/css/bootstrap-responsive.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /static/jquery.full.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /static/js/bootstrap-dropdown.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /static/js/bootstrap-modal.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /static/js/bootstrap-collapse.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /static/longpolling.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /static/jquery.ui.core.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /static/jquery.ui.widget.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /static/jquery.ui.mouse.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /static/jquery.ui.sortable.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /static/img/glyphicons-halflings-white.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /static/img/glyphicons-halflings.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /notifier/sidebar Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /notifier/repolist/RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True,%20nudgeAddMore%20=%20True%7D Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /notifier/transfers Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /static/favicon.ico Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /sidebar/NotificationId%204 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /repolist/RepoListNotificationId%20(NotificationId%202)%20(RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True,%20nudgeAddMore%20=%20True%7D) Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /transfers/NotificationId%202 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /repolist/RepoListNotificationId%20(NotificationId%202)%20(RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True,%20nudgeAddMore%20=%20True%7D) Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /transfers/NotificationId%202 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:37 EST] 127.0.0.1 GET /sidebar/NotificationId%204 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /about Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /sidebar/NotificationId%204 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /transfers/NotificationId%202 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /repolist/RepoListNotificationId%20(NotificationId%202)%20(RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True,%20nudgeAddMore%20=%20True%7D) Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /static/css/bootstrap.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /static/css/bootstrap-responsive.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /static/jquery.full.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /static/js/bootstrap-dropdown.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /static/js/bootstrap-modal.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /static/js/bootstrap-collapse.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /static/longpolling.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /static/img/glyphicons-halflings-white.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /static/img/glyphicons-halflings.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /notifier/sidebar Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /sidebar/NotificationId%205 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /static/favicon.ico Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:47 EST] 127.0.0.1 GET /sidebar/NotificationId%205 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:50 EST] 127.0.0.1 GET /config Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:50 EST] 127.0.0.1 GET /static/css/bootstrap.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:50 EST] 127.0.0.1 GET /static/css/bootstrap-responsive.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:50 EST] 127.0.0.1 GET /static/jquery.full.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:50 EST] 127.0.0.1 GET /static/js/bootstrap-dropdown.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:50 EST] 127.0.0.1 GET /static/js/bootstrap-modal.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:50 EST] 127.0.0.1 GET /static/js/bootstrap-collapse.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:50 EST] 127.0.0.1 GET /static/longpolling.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:50 EST] 127.0.0.1 GET /static/img/glyphicons-halflings-white.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:50 EST] 127.0.0.1 GET /static/img/glyphicons-halflings.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:50 EST] 127.0.0.1 GET /notifier/sidebar Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:50 EST] 127.0.0.1 GET /sidebar/NotificationId%206 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:50 EST] 127.0.0.1 GET /static/favicon.ico Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:50 EST] 127.0.0.1 GET /sidebar/NotificationId%206 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /config/addrepository Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /static/css/bootstrap.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /static/css/bootstrap-responsive.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /static/jquery.full.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /static/js/bootstrap-dropdown.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /static/js/bootstrap-modal.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /static/js/bootstrap-collapse.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /static/longpolling.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /static/jquery.ui.widget.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /static/jquery.ui.mouse.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /static/jquery.ui.core.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /static/jquery.ui.sortable.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /static/favicon.ico Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /static/img/glyphicons-halflings.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /static/img/glyphicons-halflings-white.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /notifier/sidebar Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /notifier/repolist/RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True,%20nudgeAddMore%20=%20False%7D Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /repolist/RepoListNotificationId%20(NotificationId%203)%20(RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True,%20nudgeAddMore%20=%20False%7D) Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /sidebar/NotificationId%207 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:51 EST] 127.0.0.1 GET /repolist/RepoListNotificationId%20(NotificationId%203)%20(RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True,%20nudgeAddMore%20=%20False%7D) Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:52 EST] 127.0.0.1 GET /sidebar/NotificationId%207 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:56 EST] 127.0.0.1 GET /config/repository/add/ssh Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:56 EST] 127.0.0.1 GET /repolist/RepoListNotificationId%20(NotificationId%203)%20(RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True,%20nudgeAddMore%20=%20False%7D) Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:56 EST] 127.0.0.1 GET /sidebar/NotificationId%207 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:56 EST] 127.0.0.1 GET /static/css/bootstrap-responsive.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:56 EST] 127.0.0.1 GET /static/css/bootstrap.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:56 EST] 127.0.0.1 GET /static/jquery.full.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:56 EST] 127.0.0.1 GET /static/js/bootstrap-dropdown.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:56 EST] 127.0.0.1 GET /static/js/bootstrap-modal.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:56 EST] 127.0.0.1 GET /static/js/bootstrap-collapse.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:56 EST] 127.0.0.1 GET /static/longpolling.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:56 EST] 127.0.0.1 GET /static/favicon.ico Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:56 EST] 127.0.0.1 GET /static/img/glyphicons-halflings-white.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:56 EST] 127.0.0.1 GET /static/img/glyphicons-halflings.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:56 EST] 127.0.0.1 GET /notifier/sidebar Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:56 EST] 127.0.0.1 GET /sidebar/NotificationId%208 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:15:56 EST] 127.0.0.1 GET /sidebar/NotificationId%208 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:23 EST] 127.0.0.1 POST /config/repository/add/ssh Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:23 EST] 127.0.0.1 GET /sidebar/NotificationId%208 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:23 EST] 127.0.0.1 GET /static/css/bootstrap.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:23 EST] 127.0.0.1 GET /static/css/bootstrap-responsive.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:23 EST] 127.0.0.1 GET /static/js/bootstrap-collapse.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:23 EST] 127.0.0.1 GET /static/jquery.full.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:23 EST] 127.0.0.1 GET /static/js/bootstrap-dropdown.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:23 EST] 127.0.0.1 GET /static/js/bootstrap-modal.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:23 EST] 127.0.0.1 GET /static/longpolling.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:23 EST] 127.0.0.1 GET /static/favicon.ico Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:23 EST] 127.0.0.1 GET /static/img/glyphicons-halflings-white.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:23 EST] 127.0.0.1 GET /static/img/glyphicons-halflings.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:23 EST] 127.0.0.1 GET /notifier/sidebar Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:23 EST] 127.0.0.1 GET /sidebar/NotificationId%209 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:23 EST] 127.0.0.1 GET /sidebar/NotificationId%209 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:44 EST] 127.0.0.1 POST /config/repository/add/ssh Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:44 EST] 127.0.0.1 GET /sidebar/NotificationId%209 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:44 EST] 127.0.0.1 GET /static/css/bootstrap-responsive.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:44 EST] 127.0.0.1 GET /static/css/bootstrap.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:44 EST] 127.0.0.1 GET /static/jquery.full.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:44 EST] 127.0.0.1 GET /static/js/bootstrap-dropdown.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:44 EST] 127.0.0.1 GET /static/js/bootstrap-modal.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:44 EST] 127.0.0.1 GET /static/js/bootstrap-collapse.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:44 EST] 127.0.0.1 GET /static/longpolling.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:44 EST] 127.0.0.1 GET /static/favicon.ico Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:44 EST] 127.0.0.1 GET /static/img/glyphicons-halflings.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:44 EST] 127.0.0.1 GET /static/img/glyphicons-halflings-white.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:44 EST] 127.0.0.1 GET /notifier/sidebar Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:45 EST] 127.0.0.1 GET /sidebar/NotificationId%2010 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:16:45 EST] 127.0.0.1 GET /sidebar/NotificationId%2010 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:17:01 EST] 127.0.0.1 GET /shutdown Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:17:01 EST] 127.0.0.1 GET /static/css/bootstrap.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:17:01 EST] 127.0.0.1 GET /static/css/bootstrap-responsive.css Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:17:01 EST] 127.0.0.1 GET /static/jquery.full.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:17:01 EST] 127.0.0.1 GET /static/js/bootstrap-dropdown.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:17:01 EST] 127.0.0.1 GET /static/js/bootstrap-modal.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:17:01 EST] 127.0.0.1 GET /static/js/bootstrap-collapse.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:17:01 EST] 127.0.0.1 GET /static/longpolling.js Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:17:01 EST] 127.0.0.1 GET /static/img/glyphicons-halflings.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:17:01 EST] 127.0.0.1 GET /static/img/glyphicons-halflings-white.png Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:17:01 EST] 127.0.0.1 GET /notifier/sidebar Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:17:01 EST] 127.0.0.1 GET /sidebar/NotificationId%2011 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:17:01 EST] 127.0.0.1 GET /sidebar/NotificationId%2011 Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + [2013-09-30 11:17:02 EST] 127.0.0.1 GET /static/favicon.ico Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0 + + +"""]] diff --git a/doc/bugs/Assistant_stalls_when_adding__47__creating_repo_on_ArchLinux/comment_4_cdd26c71875428dbe3c100944a443d3f._comment b/doc/bugs/Assistant_stalls_when_adding__47__creating_repo_on_ArchLinux/comment_4_cdd26c71875428dbe3c100944a443d3f._comment new file mode 100644 index 0000000000..4ee062a802 --- /dev/null +++ b/doc/bugs/Assistant_stalls_when_adding__47__creating_repo_on_ArchLinux/comment_4_cdd26c71875428dbe3c100944a443d3f._comment @@ -0,0 +1,9 @@ +[[!comment format=mdwn + username="http://olivier.mehani.name/" + nickname="olivier-mehani" + subject="comment 4" + date="2013-09-30T01:31:26Z" + content=""" +Hum, I'm not allowed to upload images: + git-annex-webapp1.png prohibited by allowed_attachments (user is not an admin) +"""]] diff --git a/doc/bugs/Assistant_stalls_when_adding__47__creating_repo_on_ArchLinux/comment_5_76242f5d6c815acd5bd58213bd8bb0fe._comment b/doc/bugs/Assistant_stalls_when_adding__47__creating_repo_on_ArchLinux/comment_5_76242f5d6c815acd5bd58213bd8bb0fe._comment new file mode 100644 index 0000000000..28a0f7cc48 --- /dev/null +++ b/doc/bugs/Assistant_stalls_when_adding__47__creating_repo_on_ArchLinux/comment_5_76242f5d6c815acd5bd58213bd8bb0fe._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="4.153.8.80" + subject="comment 5" + date="2013-09-30T16:13:20Z" + content=""" +I see a lot of activity, which looks like you started up the webapp and it ran displaying stuff for some minutes. I see that you clicked on pages to eg, add a ssh repository. + +So, what then do you mean by saying it stalls? You have still not described whatever problem you are having. +"""]] diff --git a/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__.mdwn b/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__.mdwn index a96aeae20c..a44ecc82eb 100644 --- a/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__.mdwn +++ b/doc/bugs/Error_creating_encrypted_cloud_repository:___34__internal_server_error__34__.mdwn @@ -22,3 +22,7 @@ The operating system is Mac OS X 10.8.4, and the version of git-annex is 4.20130 """]] [[!meta title="OSX bundled gpg does not work with gpg.conf created by MacGPG"]] + +> [[done]]; I have updated the gpg to version 1.4.14 which +> manages to build with the missing features. +> --[[Joey]] diff --git a/doc/bugs/OSX_app_issues/comment_13_cb12d419459e5cac766022ee0697fedc._comment b/doc/bugs/OSX_app_issues/comment_13_cb12d419459e5cac766022ee0697fedc._comment new file mode 100644 index 0000000000..c9e199961f --- /dev/null +++ b/doc/bugs/OSX_app_issues/comment_13_cb12d419459e5cac766022ee0697fedc._comment @@ -0,0 +1,18 @@ +[[!comment format=mdwn + username="John" + ip="109.242.130.160" + subject="runshell typo prevents execution" + date="2013-09-22T00:24:10Z" + content=""" +Using the latest Mountain Lion build available. + +>$ /Applications/git-annex.app/Contents/MacOS/git-annex + +>/Applications/git-annex.app/Contents/MacOS/runshell: line 25: syntax error near unexpected token `&' + +Line 25: +>echo \"** runshell loop detected!\"> &2 + +Fix (obvious but for the sake of completeness): +>echo \"** runshell loop detected!\" >&2 +"""]] diff --git a/doc/bugs/OSX_app_issues/comment_14_c966fa549bc73c52034ac9abc49de52a._comment b/doc/bugs/OSX_app_issues/comment_14_c966fa549bc73c52034ac9abc49de52a._comment new file mode 100644 index 0000000000..df45eb6010 --- /dev/null +++ b/doc/bugs/OSX_app_issues/comment_14_c966fa549bc73c52034ac9abc49de52a._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="4.154.1.250" + subject="comment 14" + date="2013-09-22T14:15:28Z" + content=""" +I have fixed the runshell typo and updated the builds. +"""]] diff --git a/doc/bugs/Unknown_command___39__list__39__.mdwn b/doc/bugs/Unknown_command___39__list__39__.mdwn new file mode 100644 index 0000000000..f08fc6eef2 --- /dev/null +++ b/doc/bugs/Unknown_command___39__list__39__.mdwn @@ -0,0 +1,15 @@ +### Please describe the problem. + +The man page claims there exists a query command 'list' but: + + % git annex list somefile + git-annex: Unknown command 'list' + +### What version of git-annex are you using? On what operating system? + +man page online and git-annex version 4.20130909. + +> Your last line explains the problem. The online man page +> documents the latest release, or in some cases +> unrelased git version. You have a version 2 releases old installed. +> [[done]] --[[Joey]] diff --git a/doc/bugs/Unknown_command___39__list__39__/comment_1_c625d03d1ed2019141ac9202f933466d._comment b/doc/bugs/Unknown_command___39__list__39__/comment_1_c625d03d1ed2019141ac9202f933466d._comment new file mode 100644 index 0000000000..7566dc1ef2 --- /dev/null +++ b/doc/bugs/Unknown_command___39__list__39__/comment_1_c625d03d1ed2019141ac9202f933466d._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://cstork.org/" + nickname="Chris Stork" + subject="News page stopped listing latest releases?" + date="2013-09-30T16:08:18Z" + content=""" +Ah, cabal tells me that 4.20130927 is out now. I missed that because I thought that the [News](http://git-annex.branchable.com/news/) page is 'authoritative' :-) and it's still advertising 4.20130909. Sorry about that. +"""]] diff --git a/doc/bugs/Unknown_command___39__list__39__/comment_2_800e1b6417768bdadda311ebfb5df637._comment b/doc/bugs/Unknown_command___39__list__39__/comment_2_800e1b6417768bdadda311ebfb5df637._comment new file mode 100644 index 0000000000..f8592b5711 --- /dev/null +++ b/doc/bugs/Unknown_command___39__list__39__/comment_2_800e1b6417768bdadda311ebfb5df637._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="4.153.8.80" + subject="comment 2" + date="2013-09-30T16:23:31Z" + content=""" +I've had a bit of a mess with cabal. First my release scripts apparently broke and didn't upload the last 2 releases there. Then when I manually fixed that, hackage has been upgraded to a new version, which is broken and will not accept tarballs > 1 mb. So I had to re-upload git-annex hacked to fit in 1 mb (removing all documentation), and I did so from a current git snapshot. Meh. +"""]] diff --git a/doc/bugs/__34__Configuring_Jabber_Account__34___fails_with_a___34__Network_unreachable__34___error..mdwn b/doc/bugs/__34__Configuring_Jabber_Account__34___fails_with_a___34__Network_unreachable__34___error..mdwn new file mode 100644 index 0000000000..9befd7c801 --- /dev/null +++ b/doc/bugs/__34__Configuring_Jabber_Account__34___fails_with_a___34__Network_unreachable__34___error..mdwn @@ -0,0 +1,39 @@ +### Please describe the problem. + +After setting the username (xyz@gmail.com) and the password the webapp takes several minutes until eventually an error message is displayed stating that: + + Unable to connect to the Jabber server. Maybe you entered the wrong password? (Error message: host gmail.com:5222 failed: connect: does not exist (Network is unreachable)) + +Testing with xyz@xmpp.l.gmail.com yields: + + Unable to connect to the Jabber server. Maybe you entered the wrong password? (Error message: host xmpp.l.google.com:5222 failed: AuthenticationFailure) + +What's strange about that is that the exact same procedure works on a different (Ubuntu-) system with almost no time spend. + +### What steps will reproduce the problem? + +Trying to set up the jabber connection. + +### What version of git-annex are you using? On what operating system? + + git-annex version: 4.20130922-g7dc188a + build flags: Assistant Webapp Pairing Testsuite S3 WebDAV Inotify DBus XMPP Feeds Quvi + (actually a zeroinstall feed from here: http://f12n.de/0install/git-annex-webapp.xml which is based on the standalone build) + +OS: up-to-date ARCH system + + +### Please provide any additional information below. + +[[!format sh """ +# If you can, paste a complete transcript of the problem occurring here. +# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log + +[2013-09-23 19:24:04 CEST] main: starting assistant version 4.20130922-g7dc188a +(scanning...) [2013-09-23 19:24:04 CEST] Watcher: Performing startup scan +(started...) +[2013-09-23 20:18:12 CEST] read: host ["-t","SRV","--","_xmpp-client._tcp.gmail.com"] +.git/annex/daemon.log (END) + +# End of transcript or log. +"""]] diff --git a/doc/bugs/__34__Configuring_Jabber_Account__34___fails_with_a___34__Network_unreachable__34___error./comment_1_6d821af99ab3c83a5b0f52d3713ab8e2._comment b/doc/bugs/__34__Configuring_Jabber_Account__34___fails_with_a___34__Network_unreachable__34___error./comment_1_6d821af99ab3c83a5b0f52d3713ab8e2._comment new file mode 100644 index 0000000000..c2dd31f179 --- /dev/null +++ b/doc/bugs/__34__Configuring_Jabber_Account__34___fails_with_a___34__Network_unreachable__34___error./comment_1_6d821af99ab3c83a5b0f52d3713ab8e2._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="4.152.108.220" + subject="comment 1" + date="2013-09-25T18:27:24Z" + content=""" +Sounds like the SRV lookup is failing. Does `git-annex version` list either DNS or ADNS in the build flags? + +Does `host -t SRV _xmpp-client._tcp.gmail.com` work? +"""]] diff --git a/doc/bugs/__34__Configuring_Jabber_Account__34___fails_with_a___34__Network_unreachable__34___error./comment_2_206b6c8cce8350fc088f01c42fc4715b._comment b/doc/bugs/__34__Configuring_Jabber_Account__34___fails_with_a___34__Network_unreachable__34___error./comment_2_206b6c8cce8350fc088f01c42fc4715b._comment new file mode 100644 index 0000000000..1cb191d8f6 --- /dev/null +++ b/doc/bugs/__34__Configuring_Jabber_Account__34___fails_with_a___34__Network_unreachable__34___error./comment_2_206b6c8cce8350fc088f01c42fc4715b._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawknwkXgi8SnK4QT32ANl3GMKvFLyQGeHqo" + nickname="Florian" + subject="comment 2" + date="2013-09-25T21:19:23Z" + content=""" +Aaaah ok ... the *host* command is not installed by default on Arch Linux. I've installed it ... now it works ... will report it to the package maintainer. +"""]] diff --git a/doc/bugs/__96__git_annex_import__96___clobbers_mtime.mdwn b/doc/bugs/__96__git_annex_import__96___clobbers_mtime.mdwn index ce1c67fee6..7edebe584b 100644 --- a/doc/bugs/__96__git_annex_import__96___clobbers_mtime.mdwn +++ b/doc/bugs/__96__git_annex_import__96___clobbers_mtime.mdwn @@ -58,3 +58,5 @@ mtimes are clobbered with what I think is the time of the first time `git annex` upgrade supported from repository versions: 0 1 2 Debian unstable amd64 + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/__96__git_annex_import__96___clobbers_mtime/comment_4_7235130786e764ec3ad5facfecde62da._comment b/doc/bugs/__96__git_annex_import__96___clobbers_mtime/comment_4_7235130786e764ec3ad5facfecde62da._comment new file mode 100644 index 0000000000..8bc6274f95 --- /dev/null +++ b/doc/bugs/__96__git_annex_import__96___clobbers_mtime/comment_4_7235130786e764ec3ad5facfecde62da._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawl9sYlePmv1xK-VvjBdN-5doOa_Xw-jH4U" + nickname="Richard" + subject="comment 4" + date="2013-09-26T09:08:11Z" + content=""" +Fixed in http://source.git-annex.branchable.com/?p=source.git;a=commitdiff;h=98fc7e8 +"""]] diff --git a/doc/bugs/__96__git_annex_import__96___does_not_work_on_other_git_annex_repositories.mdwn b/doc/bugs/__96__git_annex_import__96___does_not_work_on_other_git_annex_repositories.mdwn new file mode 100644 index 0000000000..622c67cead --- /dev/null +++ b/doc/bugs/__96__git_annex_import__96___does_not_work_on_other_git_annex_repositories.mdwn @@ -0,0 +1,98 @@ +### Please describe the problem. + +`git annex import otherrepo` does not work. + + +### What steps will reproduce the problem? + + richih@eudyptes ~ % mcd killme/git-annex-source + richih@eudyptes ~/killme/git-annex-source % git init; git annex init + Initialized empty Git repository in /home/richih/killme/git-annex-source/.git/ + init ok + (Recording state in git...) + richih@eudyptes (git)-[master] ~/killme/git-annex-source % dd if=/dev/urandom of=foo bs=1M count=1 + 1+0 records in + 1+0 records out + 1048576 bytes (1.0 MB) copied, 0.281043 s, 3.7 MB/s + richih@eudyptes (git)-[master] ~/killme/git-annex-source % git annex add . + add foo (checksum...) ok + (Recording state in git...) + richih@eudyptes (git)-[master] ~/killme/git-annex-source % git commit -m files + [master (root-commit) 8054eeb] files + 1 file changed, 1 insertion(+) + create mode 120000 foo + richih@eudyptes (git)-[master] ~/killme/git-annex-source % mcd ../git-annex-import + richih@eudyptes ~/killme/git-annex-import % git init; git annex init + Initialized empty Git repository in /home/richih/killme/git-annex-import/.git/ + init ok + (Recording state in git...) + richih@eudyptes (git)-[master] ~/killme/git-annex-import % git annex import ../git-annex-source/foo + richih@eudyptes (git)-[master] ~/killme/git-annex-import % ls + +### What version of git-annex are you using? On what operating system? + +4.20130920 on Debian Sid + + +### PS: + +To add insult to injury, this does "work": + + ih@eudyptes (git)-[master] ~/killme/git-annex-import % mcd bar + richih@eudyptes (git)-[master] ~/killme/git-annex-import/bar % git annex import ../../git-annex-source/ + import .git/description (checksum...) ok + import .git/HEAD (checksum...) ok + import .git/config (checksum...) ok + import .git/index (checksum...) ok + import .git/COMMIT_EDITMSG (checksum...) ok + import .git/refs/heads/git-annex (checksum...) ok + import .git/refs/heads/master (checksum...) ok + import .git/hooks/update.sample (checksum...) ok + import .git/hooks/applypatch-msg.sample (checksum...) ok + import .git/hooks/pre-rebase.sample (checksum...) ok + import .git/hooks/pre-commit.sample (checksum...) ok + import .git/hooks/pre-applypatch.sample (checksum...) ok + import .git/hooks/prepare-commit-msg.sample (checksum...) ok + import .git/hooks/commit-msg.sample (checksum...) ok + import .git/hooks/post-update.sample (checksum...) ok + import .git/hooks/pre-push.sample (checksum...) ok + import .git/hooks/pre-commit (checksum...) ok + import .git/info/exclude (checksum...) ok + import .git/objects/4b/825dc642cb6eb9a060e54bf8d69288fbee4904 (checksum...) ok + import .git/objects/a2/6f9bdbe47ada699d537eaa8b6fbfc1e53ef214 (checksum...) ok + import .git/objects/30/4b790d132863d54313e2380bed17e557944f08 (checksum...) ok + import .git/objects/ab/09feaa1b55080f42ccfad8c8bb5612f2397c5a (checksum...) ok + import .git/objects/95/b73ee41ebe8abbd5d8c0c368d1148b5256d4f2 (checksum...) ok + import .git/objects/2e/96f9962c1baf83c563aa59dcc67e19f21d4b1f (checksum...) ok + import .git/objects/74/6306e594874907246b2300b3af22f2805dde3e (checksum...) ok + import .git/objects/5b/11e29d0ef96be4ee73f8dae9b2f525cb808ef1 (checksum...) ok + import .git/objects/fc/0c0dc4d0579a15c20be29186a27feb2ee77304 (checksum...) ok + import .git/objects/73/c38d817e0a9f1ef4699551ae83130edd166364 (checksum...) ok + import .git/objects/c9/80716b5b506515410ca3ad1d88ceae13d8f6f9 (checksum...) ok + import .git/objects/e2/6cb10dbce11f4065c249183bb085d0afc1b55d (checksum...) ok + import .git/objects/80/54eeb150b094b0d8483c43ccf2ddf182c71bd3 (checksum...) ok + import .git/annex/sentinal (checksum...) ok + import .git/annex/sentinal.cache (checksum...) ok + import .git/annex/index (checksum...) ok + import .git/annex/index.lck (checksum...) ok + import .git/annex/journal.lck (checksum...) ok + import .git/annex/objects/F7/zw/SHA256E-s1048576--74f3a1a65df608d1c8ae575f83c6ee21a5aeb1a914ca73f202a881f8c3ba8f59/SHA256E-s1048576--74f3a1a65df608d1c8ae575f83c6ee21a5aeb1a914ca73f202a881f8c3ba8f59 + git-annex: ../../git-annex-source/.git/annex/objects/F7/zw/SHA256E-s1048576--74f3a1a65df608d1c8ae575f83c6ee21a5aeb1a914ca73f202a881f8c3ba8f59/SHA256E-s1048576--74f3a1a65df608d1c8ae575f83c6ee21a5aeb1a914ca73f202a881f8c3ba8f59: rename: permission denied (Permission denied) + failed + import .git/logs/HEAD (checksum...) ok + import .git/logs/refs/heads/git-annex (checksum...) ok + import .git/logs/refs/heads/master (checksum...) ok + (Recording state in git...) + error: Invalid path 'bar/.git/COMMIT_EDITMSG' + error: unable to add bar/.git/COMMIT_EDITMSG to index + fatal: adding files failed + + git-annex: user error (xargs ["-0","git","--git-dir=/home/richih/killme/git-annex-import/.git","--work-tree=/home/richih/killme/git-annex-import","add","--"] exited 123) + failed + git-annex: import: 2 failed + richih@eudyptes (git)-[master] ~/killme/git-annex-import/bar % ls -la + total 0 + drwxr-xr-x 3 richih richih 17 Sep 24 01:45 . + drwxr-xr-x 4 richih richih 38 Sep 24 01:45 .. + drwxr-xr-x 8 richih richih 152 Sep 24 01:45 .git + richih@eudyptes (git)-[master] ~/killme/git-annex-import/bar % diff --git a/doc/bugs/__96__git_annex_import__96___does_not_work_on_other_git_annex_repositories/comment_1_94ccd548c084286163eeb2af1ddc18e3._comment b/doc/bugs/__96__git_annex_import__96___does_not_work_on_other_git_annex_repositories/comment_1_94ccd548c084286163eeb2af1ddc18e3._comment new file mode 100644 index 0000000000..4de9cc10d6 --- /dev/null +++ b/doc/bugs/__96__git_annex_import__96___does_not_work_on_other_git_annex_repositories/comment_1_94ccd548c084286163eeb2af1ddc18e3._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="4.152.108.220" + subject="comment 1" + date="2013-09-25T18:21:25Z" + content=""" +Import skips symlinks and other non-regular files. It would work if the source repository was in direct mode. +"""]] diff --git a/doc/bugs/box.com_never_stops_syncing./comment_9_689ac6a4a305197cf5566f98dab47b4b._comment b/doc/bugs/box.com_never_stops_syncing./comment_9_689ac6a4a305197cf5566f98dab47b4b._comment new file mode 100644 index 0000000000..99a0eb9ae6 --- /dev/null +++ b/doc/bugs/box.com_never_stops_syncing./comment_9_689ac6a4a305197cf5566f98dab47b4b._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="4.153.8.80" + subject="comment 9" + date="2013-09-28T19:34:42Z" + content=""" +Filed a bug on the DAV library about this: +"""]] diff --git a/doc/bugs/encrpyted_ssh_remote_on_macosx.mdwn b/doc/bugs/encrpyted_ssh_remote_on_macosx.mdwn new file mode 100644 index 0000000000..ed269277ca --- /dev/null +++ b/doc/bugs/encrpyted_ssh_remote_on_macosx.mdwn @@ -0,0 +1,42 @@ +### Please describe the problem. +Could not get ssh-askpass running on macosx. +Transfered the publich key with scp. +certificate based ssh from macosx to ssh server (debian testing) works. +After successfull login to ssh server git annex stops with the following errors: + +Browser Error Message: +user error (gpg ["--batch","--no-tty","--use-agent","--quiet","--trust-model","always","--gen-random","--armor","1","512"] exited 2) + +### What steps will reproduce the problem? +1. git annex on debian gnu linux +2. git annex on macosx +3. set up "share with a friend" +4. create rsa keys on macosx "ssh-kegen -t rsa" +5. scp public key to server with hosts encrypted ssh remote +6. configure the server use a encrypted ssh remote in tranport mode + +### What version of git-annex are you using? On what operating system? +current debian testing (20130827) +macosx 20130827 +### Please provide any additional information below. + +[[!format sh """ +# If you can, paste a complete transcript of the problem occurring here. +# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log + +(scanning...) [2013-09-28 17:39:25 CEST] Watcher: Performing startup scan +(started...) [2013-09-28 17:39:26 CEST] XMPPSendPack: Syncing with jlueters +Everything up-to-date +[2013-09-28 17:39:30 CEST] XMPPSendPack: Unable to download files from jlueters. + +(encryption setup) gpg: /Users/lambert/.gnupg/gpg.conf:241: invalid auto-key-locate list +28/Sep/2013:17:40:06 +0200 [Error#yesod-core] user error (gpg ["--batch","--no-tty","--use-agent","--quiet","--trust-model","always","--gen-random","--armor","1","512"] exited 2) @(yesod-core-1.1.8.3:Yesod.Internal.Core ./Yesod/Internal/Core.hs:550:5) +(encryption setup) gpg: /Users/lambert/.gnupg/gpg.conf:241: invalid auto-key-locate list +28/Sep/2013:17:40:48 +0200 [Error#yesod-core] user error (gpg ["--batch","--no-tty","--use-agent","--quiet","--trust-model","always","--gen-random","--armor","1","512"] exited 2) @(yesod-core-1.1.8.3:Yesod.Internal.Core ./Yesod/Internal/Core.hs:550:5) + + + +# End of transcript or log. +"""]] + +> [[dup|done]] --[[Joey]] diff --git a/doc/bugs/encrpyted_ssh_remote_on_macosx/comment_1_46c37aacb7ae41864488fb7c7d87d437._comment b/doc/bugs/encrpyted_ssh_remote_on_macosx/comment_1_46c37aacb7ae41864488fb7c7d87d437._comment new file mode 100644 index 0000000000..948b2c1109 --- /dev/null +++ b/doc/bugs/encrpyted_ssh_remote_on_macosx/comment_1_46c37aacb7ae41864488fb7c7d87d437._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="4.153.8.80" + subject="comment 1" + date="2013-09-29T19:13:59Z" + content=""" +This is a duplicate of this bug report: [[Error_creating_encrypted_cloud_repository: \"internal_server_error\"]] + +To work around, you need to edit ~/.gnupg/gpg.conf and remove or edit the `auto-key-locate` line. +"""]] diff --git a/doc/bugs/git_annex_importfeed_fails.mdwn b/doc/bugs/git_annex_importfeed_fails.mdwn new file mode 100644 index 0000000000..244ed769cd --- /dev/null +++ b/doc/bugs/git_annex_importfeed_fails.mdwn @@ -0,0 +1,64 @@ +### Please describe the problem. + +git annex importfeed fails + +### What steps will reproduce the problem? + +git annex importfeed http://www.tatw.co.uk/podcast.xml + +### On what operating system? + +Ubuntu 12.04, the prebuilt linux tarball + +[[!format sh """ +$ git annex version +git-annex version: 4.20130922-g7dc188a +build flags: Assistant Webapp Pairing Testsuite S3 WebDAV Inotify DBus XMPP Feeds Quvi +local repository version: 3 +default repository version: 3 +supported repository versions: 3 4 +upgrade supported from repository versions: 0 1 2 +"""]] + + +### Please provide any additional information below. + +[[!format sh """ +# If you can, paste a complete transcript of the problem occurring here. +# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log + +$ git annex importfeed http://www.tatw.co.uk/podcast.xml +(checking known urls...) +(Recording state in git...) +importfeed http://www.tatw.co.uk/podcast.xml +--2013-09-27 12:16:09-- http://www.tatw.co.uk/podcast.xml +Résolution de www.tatw.co.uk (www.tatw.co.uk)... 88.190.26.130 +Connexion vers www.tatw.co.uk (www.tatw.co.uk)|88.190.26.130|:80... connecté. +requête HTTP transmise, en attente de la réponse... 200 OK +Longueur: 41267 (40K) [application/xml] +Sauvegarde en : «/tmp/user/2166/feed10670» + +100%[==========================================================================>] 41 267 81,6K/s ds 0,5s + +2013-09-27 12:16:10 (81,6 KB/s) - «/tmp/user/2166/feed10670» sauvegardé [41267/41267] + +addurl Above___Beyond__Group_Therapy/_001_Group_Therapy_Radio_with_Above___Beyond (downloading ...) +failed +addurl Above___Beyond__Group_Therapy/_002_Group_Therapy_Radio_with_Above___Beyond (downloading ...) +failed +addurl Above___Beyond__Group_Therapy/_003_Group_Therapy_Radio_with_Above___Beyond (downloading ...) +failed +addurl Above___Beyond__Group_Therapy/_004_Group_Therapy_Radio_with_Above___Beyond (downloading ...) +failed + +etc + + +# End of transcript or log. +"""]] + +> This is a bug in the feed library: +> And already fixed upstream this morning, so if you need the fix +> immediately, build with cabal. Otherwise fix will percolate out to +> builds eventually. +> [[done]] --[[Joey]] diff --git a/doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn b/doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn index 852db29116..34096d8943 100644 --- a/doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn +++ b/doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn @@ -67,3 +67,12 @@ index 7835988..ed8ea6c 100644 1.7.10.4 """]] + +Any update on this? Why is `-a` used here? -- [[anarcat]] + +> -a is not really the problem. You certianly do usually want +> to commit your changes before converting to direct mode. +> +> [[done]]; now when this happens it catches the exception and +> leaves the file in direct mode, which is the same as it being +> unlocked. --[[Joey]] diff --git a/doc/bugs/git_annex_indirect_can_fail_catastrophically/comment_1_0b085e7e8c8e364f479574bc00c7c394._comment b/doc/bugs/git_annex_indirect_can_fail_catastrophically/comment_1_0b085e7e8c8e364f479574bc00c7c394._comment new file mode 100644 index 0000000000..68814881da --- /dev/null +++ b/doc/bugs/git_annex_indirect_can_fail_catastrophically/comment_1_0b085e7e8c8e364f479574bc00c7c394._comment @@ -0,0 +1,21 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="4.152.108.220" + subject="comment 1" + date="2013-09-25T18:57:25Z" + content=""" +Worse than being stuck partway converted, it fails in such a way that the file you can't write to is left stuck in .git/annex/objects/ without a symlink pointint to it. + +Here is how to recover: + +1. run `git annex direct` +2. run `git annex indirect` +3. run `git annex direct` +4. run `git annex indirect` +5. run `git revert HEAD` +6. run `git annex direct` +7. fix the permission of the file +8. run `git annex indirect` + +Please don't ask me why this works, but it will.. +"""]] diff --git a/doc/bugs/git_version_in_prebuilt_linux_tarball_is_outdated.mdwn b/doc/bugs/git_version_in_prebuilt_linux_tarball_is_outdated.mdwn new file mode 100644 index 0000000000..8aed26bba8 --- /dev/null +++ b/doc/bugs/git_version_in_prebuilt_linux_tarball_is_outdated.mdwn @@ -0,0 +1,8 @@ +### Please describe the problem. +I created a .gitignore file and added it to git annex. In the assistant webapp log, the error "The installed version of git is too old for .gitignores to be honored by git-annex." shows up. According to [[bugs/assistant_ignore_.gitignore/]] this bug should be fixed in a later git version. + +### What steps will reproduce the problem? +Download the current prebuilt linux tarball from [[/install]], extract it, run "./runshell", then "git --version" returns "git version 1.7.10.4" + +### What version of git-annex are you using? On what operating system? +git-annex-standalone-amd64.tar.gz 2013-09-22 09:56 (Linux Ubuntu Precise) diff --git a/doc/bugs/git_version_in_prebuilt_linux_tarball_is_outdated/comment_1_2a5a07498df9d38531d4570f7b463b9a._comment b/doc/bugs/git_version_in_prebuilt_linux_tarball_is_outdated/comment_1_2a5a07498df9d38531d4570f7b463b9a._comment new file mode 100644 index 0000000000..5287ea9358 --- /dev/null +++ b/doc/bugs/git_version_in_prebuilt_linux_tarball_is_outdated/comment_1_2a5a07498df9d38531d4570f7b463b9a._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="http://joeyh.name/" + ip="4.152.108.220" + subject="comment 1" + date="2013-09-25T18:18:49Z" + content=""" +The tarballs are built on Debian stable in order to have an old enough libc to work most places. So I am limited to what is available in stable and backports. Once there is a backport available of git, I will use it. +"""]] diff --git a/doc/bugs/importfeed_fails_when_using_the_option_--lazy_for_specific_podcast.mdwn b/doc/bugs/importfeed_fails_when_using_the_option_--lazy_for_specific_podcast.mdwn new file mode 100644 index 0000000000..0d6bcb05c5 --- /dev/null +++ b/doc/bugs/importfeed_fails_when_using_the_option_--lazy_for_specific_podcast.mdwn @@ -0,0 +1,77 @@ +### Please describe the problem. + +importfeed responds with "failed" when using the option --lazy for specific podcast and no symbolic links get created. However when I don't use the --fast option the podcast enclosures do download and links get created as expected. + +### What steps will reproduce the problem? + +git-annex importfeed --fast http://schoolsucksproject.com/category/podcast/feed/ + +### What version of git-annex are you using? On what operating system? + + Ubuntu + git-annex version: 4.20130802-g1452ac3 + build flags: Assistant Webapp Pairing Testsuite S3 WebDAV Inotify DBus XMPP + local repository version: 3 + default repository version: 3 + supported repository versions: 3 4 + upgrade supported from repository versions: 0 1 2 + +### Please provide any additional information below. + + git-annex importfeed --fast http://schoolsucksproject.com/category/podcast/feed/ + (checking known urls...) + (Recording state in git...) + importfeed http://schoolsucksproject.com/category/podcast/feed/ + --2013-09-28 00:27:25-- http://schoolsucksproject.com/category/podcast/feed/ + Resolving schoolsucksproject.com (schoolsucksproject.com)... 108.162.199.17, 108.162.198.17 + Connecting to schoolsucksproject.com (schoolsucksproject.com)|108.162.199.17|:80... connected. + HTTP request sent, awaiting response... 200 OK + Length: unspecified [text/xml] + Saving to: `/tmp/feed16555' + + 2013-09-28 00:27:28 (217 KB/s) - `/tmp/feed16555' saved [423071] + + addurl School_Sucks_Project___Podcasts/238f__Presence_and_Productivity__6___Tools_For_A_Freed_Mind_and_A_Voluntary_Life_mp3 + unable to access url: http://schoolsucks.podomatic.com/enclosure/2013-09-21T08_21_33-07_00.mp3 + failed + addurl School_Sucks_Project___Podcasts/238e__Presence_and_Productivity__5___Habit_Change_mp3 + unable to access url: http://schoolsucks.podomatic.com/enclosure/2013-09-18T20_40_40-07_00.mp3 + failed + addurl School_Sucks_Project___Podcasts/238d__Presence_and_Productivity__4___Next_Actions__Projects__and_Procrastination_mp3 + unable to access url: http://schoolsucks.podomatic.com/enclosure/2013-09-16T10_10_06-07_00.mp3 + failed + ... + +> (There is no --lazy option. You seem to mean --fast.) +> +> This fine web server rejects the User-Agent used by curl: + +
     
+joey@darkstar:~>curl http://schoolsucks.podomatic.com/enclosure/2013-09-18T20_40_40-07_00.mp3
+Forbidden
+joey@darkstar:~>wget http://schoolsucks.podomatic.com/enclosure/2013-09-18T20_40_40-07_00.mp3
+--2013-09-28 11:18:36--  http://schoolsucks.podomatic.com/enclosure/2013-09-18T20_40_40-07_00.mp3
+Resolving schoolsucks.podomatic.com (schoolsucks.podomatic.com)... 38.99.42.46, 38.110.155.212
+Connecting to schoolsucks.podomatic.com (schoolsucks.podomatic.com)|38.99.42.46|:80... connected.
+HTTP request sent, awaiting response... 200 OK
+
    +
+> git-annex always uses curl for checking file sizes. So the workaround
+> is to use `git annex addurl --relaxed` on this url, which will skip
+> the size check. However, if you only had curl installed, `git-annex get`
+> would again try to use curl to get the file, and would still fail.
+> It only happens to successfully download because git-annex chose
+> to use wget and this site has apparently forgotten to block that.
+> 
+> I don't know if it makes sense for git-annex to vary the user-agent
+> to get around such (incredibly stupid) blocking. It could retry
+> with a random user-agent, but that could be construed as abusive
+> behavior; this site has asked us to go away. The only choices
+> that seem really defensible would be to add a --user-agent
+> switch, and/or to make git-annex set a default user agent header
+> of "git-annex", rather than relying on the curl/wget defaults.
+> --[[Joey]] 
+
+> I've [[done]] what's discussed above, and verified it fixes
+> behavior for this specific server too.
+> --[[Joey]] 
diff --git a/doc/bugs/importfeed_fails_when_using_the_option_--lazy_for_specific_podcast/comment_1_4ccfabbaf75e139b32f6fa6f7bc6a7fe._comment b/doc/bugs/importfeed_fails_when_using_the_option_--lazy_for_specific_podcast/comment_1_4ccfabbaf75e139b32f6fa6f7bc6a7fe._comment
new file mode 100644
index 0000000000..26430ec913
--- /dev/null
+++ b/doc/bugs/importfeed_fails_when_using_the_option_--lazy_for_specific_podcast/comment_1_4ccfabbaf75e139b32f6fa6f7bc6a7fe._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="Remy"
+ ip="82.94.186.146"
+ subject="Thank you very much"
+ date="2013-09-30T08:49:33Z"
+ content="""
+Thank you very much for looking into this! This issue was holding me back from using git-annex as my podcatcher. Hope it helps somebody else as well. 
+"""]]
diff --git a/doc/bugs/merge_causes_out_of_memory_on_large_repos/comment_4_0e32ae0300472c56079cfbcd78a3e386._comment b/doc/bugs/merge_causes_out_of_memory_on_large_repos/comment_4_0e32ae0300472c56079cfbcd78a3e386._comment
new file mode 100644
index 0000000000..d1c447980c
--- /dev/null
+++ b/doc/bugs/merge_causes_out_of_memory_on_large_repos/comment_4_0e32ae0300472c56079cfbcd78a3e386._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawnxlx1UrzVhdy6_gFjzmF42x6QXxBUxg00"
+ nickname="Jakukyo"
+ subject="size of repo"
+ date="2013-09-21T09:32:03Z"
+ content="""
+    $ git ls-tree -r git-annex | wc -l
+    29273
+"""]]
diff --git a/doc/bugs/merge_causes_out_of_memory_on_large_repos/comment_5_e8998716107e7ae8d0e8d332812517ad._comment b/doc/bugs/merge_causes_out_of_memory_on_large_repos/comment_5_e8998716107e7ae8d0e8d332812517ad._comment
new file mode 100644
index 0000000000..272dc2fd2d
--- /dev/null
+++ b/doc/bugs/merge_causes_out_of_memory_on_large_repos/comment_5_e8998716107e7ae8d0e8d332812517ad._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="4.152.108.220"
+ subject="comment 5"
+ date="2013-09-25T18:36:39Z"
+ content="""
+That doesn't look very big, I merge one 3x that large on a 128 mb machine.
+
+I think you will need to either email me privately so I can get a copy of your repository to investigate with ... or you can try to investigate on your own. 
+
+I think the first things I would try to debug this are to look over `git annex merge --debug` and see if I see anything unusual, and then I would probably `git checkout git-annex` in the repository, and wc -l on all the files and see if any file has a lot of lines, or is otherwise very large.
+
+If that found nothing, my next step would be to rebuild git-annex from source with memory profiling enabled, as explained in this book, and try to get a memory profiling graph that explained what was using up the memory. 
+"""]]
diff --git a/doc/bugs/rename:_permission_denied__44___after_direct_mode_switch.mdwn b/doc/bugs/rename:_permission_denied__44___after_direct_mode_switch.mdwn
index 16f243e9a2..c315d47899 100644
--- a/doc/bugs/rename:_permission_denied__44___after_direct_mode_switch.mdwn
+++ b/doc/bugs/rename:_permission_denied__44___after_direct_mode_switch.mdwn
@@ -75,3 +75,7 @@ failed
 git-annex: copy: 1 failed
 camaar%
 """]]
+
+> Put in a fix that works, although perhaps not ideal as I do not
+> understand how the repo got into the original problem state. [[done]]
+> --[[Joey]]
diff --git a/doc/bugs/rename:_permission_denied__44___after_direct_mode_switch/comment_1_14cec6448831c67794b62926a03b2fc5._comment b/doc/bugs/rename:_permission_denied__44___after_direct_mode_switch/comment_1_14cec6448831c67794b62926a03b2fc5._comment
new file mode 100644
index 0000000000..1aef52076b
--- /dev/null
+++ b/doc/bugs/rename:_permission_denied__44___after_direct_mode_switch/comment_1_14cec6448831c67794b62926a03b2fc5._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="4.153.8.80"
+ subject="comment 1"
+ date="2013-09-30T16:47:42Z"
+ content="""
+I was able to cause a permission denied on `git annex direct` if I made the file in .git/annex/objects be owned by an different user than me. I do not know how that could happen in normal operation of git-annex.
+
+
+I have made `git annex direct` catch this exception and continue. So you will get a repository that is switched to direct mode, but with one file that is still a symlink to the content, and if you fix the permissions problem, `git annex fsck` will fix it.
+
+I am curious about any details of how your repository got into the original state..
+"""]]
diff --git a/doc/design/assistant/encrypted_git_remotes.mdwn b/doc/design/assistant/encrypted_git_remotes.mdwn
index 63b7be67a2..915f64d289 100644
--- a/doc/design/assistant/encrypted_git_remotes.mdwn
+++ b/doc/design/assistant/encrypted_git_remotes.mdwn
@@ -3,14 +3,15 @@ using [git-remote-gcrypt](https://github.com/blake2-ppc/git-remote-gcrypt).
 
 There are at least two use cases for this in the assistant:
 
-* Storing an encrypted git repository on a local drive.
+* Storing an encrypted git repository on a local drive. **done**
 * Or on a remote server. This could even allow using github. But more
   likely would be a shell server that has git-annex-shell on it so can
   also store file contents, and which is not trusted with unencrypted data.
+  **done**
 
 git-remote-gcrypt is already usable with git-annex. What's needed is
 to make sure it's installed (ie, get it packaged into distros or embedded
-into git-annex), and make it easy to set up from the webapp.
+into git-annex), and make it easy to set up from the webapp. **done**
 
 Hmm, this will need gpg key creation, so would also be a good opportunity
 to make the webapp allow using that for special remotes too.
@@ -18,4 +19,4 @@ to make the webapp allow using that for special remotes too.
 One change is needed in git-annex core.. It currently does not support
 storing encrypted files on git remotes, only on special remotes. Perhaps
 the way to deal with this is to make it consider git-remote-grypt remotes
-to be a special remote type?
+to be a special remote type? **done**
diff --git a/doc/devblog/day_15-17__Android_rebuild.mdwn b/doc/devblog/day_15-17__Android_rebuild.mdwn
new file mode 100644
index 0000000000..758e2d0977
--- /dev/null
+++ b/doc/devblog/day_15-17__Android_rebuild.mdwn
@@ -0,0 +1,67 @@
+Made a release on Friday. But I had to rebuild the OSX and Linux standalone
+builds today to fix a bug in them.
+
+Spent the past **three days** redoing the whole Android build environment.
+I've been progressively moving from my first hacked up Android build env to
+something more reproducible and sane. Finally I am at the point where I can
+run a shell script (well, actually, 3 shell scripts) and get an Android
+build chroot. It's still not immune to breaking when new versions of
+haskell libs are uploaded, but this is much better, and should be
+maintainable going forward. 
+
+This is a good starting point for getting git-annex into the F-Droid app
+store, or for trying to build with a newer version of the Android SDK and
+NDK, to perhaps get it working on Android 4.3. (Eventually. I am so sick
+of building Android stuff right now..)
+
+Friday was all spent struggling to get ghc-android to build. I had not built
+it successfully since February. I finally did,
+on Saturday, and I have made my own fork of it which builds using a
+known-good snapshot of the current development version of ghc. Building
+this in a Debian stable chroot means that there should be no possibility
+that upstream changes will break the build again.
+
+With ghc built, I moved on to building all the haskell libs git-annex
+needs. Unfortunately my build script for these also has stopped working
+since I made it in April. I failed to pin every package at a defined
+version, and things broke.
+
+So, I redid the build script, and updated all the haskell libs to the
+newest versions while I was at it. I have decided not to pin the library
+versions (at least until I find a foolproof way to do it), so this new
+script will break in the future, but it should break in a way I can fix up
+easily by just refreshing a patch.
+
+The new ghc-android build has a nice feature of at least being able to
+compile Template Haskell code (though still not run it at compile time.
+This made the patching needed in the Haskell libs quite a lot less. Offset
+somewhat by me needing to make general fixes to lots of libs to build with
+ghc head. Including some fun with `==#` changing its type from `Bool` to
+`Int#`. In all, I think I removed around 2.5 thousand lines of patches!
+(Only 6 thousand lines to go...)
+
+Today I improved ghc-android some more so it cross builds several C libraries
+that are needed to build several haskell libraries needed for XMPP.
+I had only ever built those once, and done it by hand, and very hackishly.
+Now they all build automatically too.
+
+And, I put together a script that builds the debian stable chroot and
+installs ghc-android.
+
+And, I hacked on the EvilSplicer (which is sadly still needed) to
+work with the new ghc/yesod/etc.
+
+At this point, I have git-annex successfully building, including the APK!
+
+----
+
+In a bored hour waiting for a compile, I also sped up `git annex add`
+on OSX by I think a factor of 10. Using cryptohash for hash calculation
+now, when external hash programs are not available. It's still a few
+percentage points slower than external hash programs, or I'd use it by
+default.
+
+----
+
+This period of important drudgery was sponsored by an unknown bitcoin
+user, and by Bradley Unterrheiner and Andreas Olsson.
diff --git a/doc/devblog/day_19__moving_on.mdwn b/doc/devblog/day_19__moving_on.mdwn
new file mode 100644
index 0000000000..7f4cd8244a
--- /dev/null
+++ b/doc/devblog/day_19__moving_on.mdwn
@@ -0,0 +1,37 @@
+Finished moving the Android autobuilder over to the new clean build
+environment. Tested the Android app, and it still works. Whew!
+
+There's a small chance that the issue with the Android app not working on
+Android 4.3 has been fixed by this rebuild. I doubt it, but perhaps someone
+can download the daily build and give it another try..
+
+----
+
+I have 7 days left in which I'd like to get remote gcrypt repositories
+working in the assistant. I think that should be fairly easy, but a
+prerequisite for it is making git-annex-shell support being run on a gcrypt
+repository. That's needed so that the assistant's normal locked down ssh
+key setup can also be used for gcrypt repositories.
+
+At the same time, not all gcrypt endpoints will have git-annex-shell
+installed, and it *seems* to make sense to leave in the existing support
+for running raw rsync and git push commands against such a repository. So
+that's going to add some complication.
+
+It will also complicate git-annex-shell to support gcrypt repos. Basically,
+everything it does in git-annex repos will need to be reimplemented in
+gcrypt repositories. Generally in a more simple form; for example it
+doesn't need to (and can't) update location logs in a gcrypt repo.
+
+----
+
+I also need to find a good UI to present the three available choices
+(unencrypted git, encrypted git, encrypted rsync) when setting up a repo
+on a ssh server. I don't want to just remove the encrypted rsync option,
+because it's useful when using xmpp to sync the git repo, and is simpler to
+set up since it uses shared encryption rather than gpg public keys.
+
+My current thought is to offer just 2 choices, encrypted and non-encrypted.
+If they choose encrypted, offer a choice of shared encryption or encrypting
+to a specific key. I think I can word this so it's pretty clear what the
+tradeoffs are.
diff --git a/doc/devblog/day_19__moving_on/comment_1_870106f671f9a055b81e6fc83e0850b5._comment b/doc/devblog/day_19__moving_on/comment_1_870106f671f9a055b81e6fc83e0850b5._comment
new file mode 100644
index 0000000000..b0ed97bcf3
--- /dev/null
+++ b/doc/devblog/day_19__moving_on/comment_1_870106f671f9a055b81e6fc83e0850b5._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawmW0kg4uiMIhSHeVuvJFyo2VYMl7Qoej0s"
+ nickname="Chris"
+ subject="comment 1"
+ date="2013-09-23T20:58:45Z"
+ content="""
+The new version of the Android apk doesn't work for me on my Nexus 4.
+"""]]
diff --git a/doc/devblog/day_19__moving_on/comment_2_fad055c8860385ac6c012f897c96408f._comment b/doc/devblog/day_19__moving_on/comment_2_fad055c8860385ac6c012f897c96408f._comment
new file mode 100644
index 0000000000..f2e754b3ab
--- /dev/null
+++ b/doc/devblog/day_19__moving_on/comment_2_fad055c8860385ac6c012f897c96408f._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawmkBwMWvNKZZCge_YqobCSILPMeK6xbFw8"
+ nickname="develop"
+ subject="comment 2"
+ date="2013-09-24T07:11:31Z"
+ content="""
+Yeah, no joy on Cyanogenmod 10.2(Android 4.3).
+
+Would be pretty surprising if it had worked.
+"""]]
diff --git a/doc/devblog/day_19__moving_on/comment_3_69e47d612159587f080ab761566d1830._comment b/doc/devblog/day_19__moving_on/comment_3_69e47d612159587f080ab761566d1830._comment
new file mode 100644
index 0000000000..206fdd8520
--- /dev/null
+++ b/doc/devblog/day_19__moving_on/comment_3_69e47d612159587f080ab761566d1830._comment
@@ -0,0 +1,18 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawnR6E5iUghMWdUGlbA9CCs8DKaoigMjJXw"
+ nickname="Efraim"
+ subject="not working on my nexus 4 either"
+ date="2013-09-24T07:37:28Z"
+ content="""
+terminal output reads:
+
+Falling back to hardcoded app location; cannot find expected files in /data/app-lib
+
+git annex webapp
+
+u0_a124@mako:/sdcard/git-annex.home $ git annex webpp
+
+CANNOT LINK EXECUTABLE: git-annex invalid R_ARM_COPY relocation against DT_SYMBOLIC shared library libc.so (built with -Bsymbolic?)
+
+1|u0_a124@mako:/sdcard/git-annex.home $
+"""]]
diff --git a/doc/devblog/day_20__gcrypt_and_git-annex-shell.mdwn b/doc/devblog/day_20__gcrypt_and_git-annex-shell.mdwn
new file mode 100644
index 0000000000..0e4142b7c0
--- /dev/null
+++ b/doc/devblog/day_20__gcrypt_and_git-annex-shell.mdwn
@@ -0,0 +1,14 @@
+Added support for gcrypt remotes to git-annex-shell. Now gcrypt special
+remotes probe when they are set up to see if the remote system has a
+suitable git-annex-shell, and if so all commands are sent to it. Kept the
+direct rsync mode working as a fallback.
+
+It turns out I made a bad decision when first adding gcrypt support to
+git-annex. To make implementation marginally easier, I decided to not
+put objects inside the usual `annex/objects` directory in a gcrypt remote.
+But that lack of consistency would have made adding support to
+git-annex-shell a lot harder. So, I decided to change this. Which 
+means that anyone already using gcrypt with git-annex will need to
+[[manually_move_files_around|upgrades/gcrypt]].
+
+Today's work was sponsored by Tobias Nix.
diff --git a/doc/devblog/day_21__bugfix_day.mdwn b/doc/devblog/day_21__bugfix_day.mdwn
new file mode 100644
index 0000000000..a913fce56a
--- /dev/null
+++ b/doc/devblog/day_21__bugfix_day.mdwn
@@ -0,0 +1,5 @@
+Did various bug fixes and followup today. Amazing how a day can vanish that
+way. Made 4 actual improvements.
+
+I still have 46 messages in unanswered backlog. Although only 8 of
+the are from this month.
diff --git a/doc/devblog/day_22__gcrypt_on_rsync.net.mdwn b/doc/devblog/day_22__gcrypt_on_rsync.net.mdwn
new file mode 100644
index 0000000000..2c59517952
--- /dev/null
+++ b/doc/devblog/day_22__gcrypt_on_rsync.net.mdwn
@@ -0,0 +1,20 @@
+Being still a little unsure of the UI and complexity
+for configuring gcrypt on ssh servers, I thought I'd start today with the
+special case of gcrypt on rsync.net. Since rsync.net allows running some git
+commands, gcrypt can be used to make encrypted git repositories on it.
+
+Here's the UI I came up with. It's complicated a bit by needing to explain
+the tradeoffs between the rsync and gcrypt special remotes.
+
+[[!img /assistant/rsync.net.encryption.png]]
+
+This works fine, but I did not get a chance to add support for enabling
+existing gcrypt repos on rsync.net. Anyway, most of the changes to make
+this work will also make it easier to add general support for gcrypt on ssh
+servers.
+
+Also spent a while fixing a bug in git-remote-gcrypt. Oddly 
+`gpg --list-keys --fast-list --fingerprint` does not show the fingerprints
+of some keys.
+
+Today's work was sponsored by Cloudier - Thomas Djärv.
diff --git a/doc/devblog/day_23__GNU_day.mdwn b/doc/devblog/day_23__GNU_day.mdwn
new file mode 100644
index 0000000000..4f5b25ca77
--- /dev/null
+++ b/doc/devblog/day_23__GNU_day.mdwn
@@ -0,0 +1,23 @@
+Worked on making the assistant able to merge in existing encrypted
+git repositories from rsync.net.
+
+This had two parts. First, making the webapp UI where you click to enable a
+known special remote work with these encrypted repos. Secondly, handling
+the case where a user knows they have an encrypted repository on rsync.net,
+so enters in its hostname and path, but git-annex doesn't know about that
+special remote. The second case is important, for example, when the
+encrypted repository is a backup and you're restoring from it. It wouldn't
+do for the assistant, in that case, to make a *new* encrypted repo and
+push it over top of your backup!
+
+Handling that was a neat trick. It has to do quite a lot of probing, including
+downloading the whole encrypted git repo so it can decrypt it and merge it,
+to find out about the special remote configuration used for it. This all
+works with just 2 ssh connections, and only 1 ssh password prompt max.
+
+Next, on to generalizing this rsync.net specific code to work with
+arbitrary ssh servers!
+
+----
+
+Today's work was made possible by [RMS's vision 30 years ago](http://article.olduse.net/771@mit-eddie.UUCP).
diff --git a/doc/devblog/day_24__nearly_done_with_gcrypt.mdwn b/doc/devblog/day_24__nearly_done_with_gcrypt.mdwn
new file mode 100644
index 0000000000..22d3fa70b5
--- /dev/null
+++ b/doc/devblog/day_24__nearly_done_with_gcrypt.mdwn
@@ -0,0 +1,23 @@
+So close to being done with gcrypt support.. But still not quite there.
+
+Today I made the UI changes to support gcrypt when setting up a repository
+on a ssh server, and improved the probing and data types so it can tell
+which options the server supports. Fairly happy with how that is turning
+out.
+
+Have not yet hooked up the new buttons to make gcrypt repos. While I was
+testing that my changes didn't break other stuff, I found a bug in the
+webapp that caused it to sometimes fail to transfer one file to/from a
+remote that was just added, because the transferrer process didn't know
+about the new remote yet, and crashed (and was restarted knowing about it,
+so successfully sent any other files). So got sidetracked on fixing that.
+
+Also did some work to make the gpg bundled with git-annex on OSX be
+compatable with the config files written by MacGPG. At first I was going to
+hack it to not crash on the options it didn't support, but it turned out
+that upgrading to version 1.4.14 actually fixed the problem that was making
+it build without support for DNS.
+
+----
+
+Today's work was sponsored by Thomas Hochstein.
diff --git a/doc/devblog/day_25__finishing_up_gcrypt.mdwn b/doc/devblog/day_25__finishing_up_gcrypt.mdwn
new file mode 100644
index 0000000000..9666282d0e
--- /dev/null
+++ b/doc/devblog/day_25__finishing_up_gcrypt.mdwn
@@ -0,0 +1,25 @@
+Long day, but I did finally finish up with gcrypt support. More or less.
+
+Got both creating and enabling existing gcrypt repositories on ssh servers
+working in the webapp. (But I ran out of time to make it detect when the
+user is manually entering a gcrypt repo that already exists. Should be easy
+so maybe tomorrow.)
+
+Fixed several bugs in git-annex's gcrypt support that turned up in testing.
+Made git-annex ensure that a gcrypt repository does not have
+receive.denyNonFastForwards set, because gcrypt relies on always forcing
+the push of the branch it stores its manifest on. Fixed a bug in
+`git-annex-shell recvkey` when it was receiving a file from an annex in
+direct mode.
+
+Also had to add a new `git annex shell gcryptsetup` command, which is
+needed to make setting up a gcrypt repository work when the assistant
+has set up a locked-down ssh key that can only run git-annex-shell. Painted
+myself into a bit of a corner there.
+
+And tested, tested, tested. So many possibilities and edge cases in this
+part of the code..
+
+----
+
+Today's work was sponsored by Hendrik Müller Hofstede.
diff --git a/doc/devblog/day_26__gcrypt_really_done_this_time.mdwn b/doc/devblog/day_26__gcrypt_really_done_this_time.mdwn
new file mode 100644
index 0000000000..347e4be5f7
--- /dev/null
+++ b/doc/devblog/day_26__gcrypt_really_done_this_time.mdwn
@@ -0,0 +1,17 @@
+Did I say it would be easy to make the webapp detect when a gcrypt repository 
+already existed and enable it? Well, it wasn't exactly hard, but it took
+over 300 lines of code and 3 hours..
+
+So, gcrypt support is done for now. The glaring omission is gpg key
+management for sharing gcrypt repositories between machines and/or people.
+But despite that, I think it's solid, and easy to use, and covers some
+great use cases.
+
+Pushed out a release.
+
+Now I really need to start thinking about
+[[design/assistant/disaster_recovery]].
+
+----
+
+Today's work was sponsored by Dominik Wagenknecht.
diff --git a/doc/forum/Android:_is_constant_high_cpu_usage_to_be_expected__63__/comment_1_7880fc38792a1fcbf3e5c47e8bcaabce._comment b/doc/forum/Android:_is_constant_high_cpu_usage_to_be_expected__63__/comment_1_7880fc38792a1fcbf3e5c47e8bcaabce._comment
new file mode 100644
index 0000000000..28f3dfb925
--- /dev/null
+++ b/doc/forum/Android:_is_constant_high_cpu_usage_to_be_expected__63__/comment_1_7880fc38792a1fcbf3e5c47e8bcaabce._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawmKKg3Vmzk7KwRGRKjHVdtyoj1JfxLX6NM"
+ nickname="Tom"
+ subject="comment 1"
+ date="2013-10-01T17:38:03Z"
+ content="""
+I've had this issue as well. Saw a comment on Joey's blog that implies he knows about it and that a fix will be released soon.
+"""]]
diff --git a/doc/forum/Deleting_Unused_Files_by_Age.mdwn b/doc/forum/Deleting_Unused_Files_by_Age.mdwn
new file mode 100644
index 0000000000..54e93277cc
--- /dev/null
+++ b/doc/forum/Deleting_Unused_Files_by_Age.mdwn
@@ -0,0 +1 @@
+I periodically move unused files to one of my servers. What I would like to do is drop any unused file that has been unused for say more than 6 months? I would like to not drop all unused files.
diff --git a/doc/forum/Import_options.txt b/doc/forum/Import_options.txt
new file mode 100644
index 0000000000..543d1a4ec8
--- /dev/null
+++ b/doc/forum/Import_options.txt
@@ -0,0 +1,14 @@
+Thank you for adding import options to handle duplicates. Very handy when consolidating data from various sources.
+
+Can deletion of the source files be decoupled from annex duplication/deduplication options? For example, I would like to import source files without deleting them and at the same time do not import duplicates.
+
+Better yet, since deletion of source files is potentially dangerous, a delete option could be required for deletion to be performed. Example:
+
+git annex import --deduplicate --delete_all_source_files
+git annex import --deduplicate --delete_source_duplicates
+
+Also, it would be great to have import "status" option which goes over files to be imported and logs their status ( to be imported, duplicate etc. ) without actually performing any changes. It would be great for testing and trial runs.
+
+I hope the above make sense. It would make import feature more flexible.
+
+Cheers, 
diff --git a/doc/forum/Import_options/comment_1_118a5f978090a3909299876a01c0adec._comment b/doc/forum/Import_options/comment_1_118a5f978090a3909299876a01c0adec._comment
new file mode 100644
index 0000000000..3475a0d734
--- /dev/null
+++ b/doc/forum/Import_options/comment_1_118a5f978090a3909299876a01c0adec._comment
@@ -0,0 +1,21 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawkeJKC5Sy0stmcTWyePOLEVv0G-x1yaT_w"
+ nickname="Josef"
+ subject="wishlist"
+ date="2013-09-26T11:11:19Z"
+ content="""
+Posted the above yesterday before realizing that it should probably go to wishlist requests. I am sorry about that.
+
+Basically it is a request to extend import options and perhaps make the options easier to use/understand.
+
+Suggested Import Options:
+
+- source directory,
+- destination directory,
+- deduplicate in annex ( yes, no )
+- delete source files ( yes, no )
+- trial run ( screen output only )
+
+Many thanks for a great product!
+
+"""]]
diff --git a/doc/forum/Import_options/comment_2_21da91f08cb6b28ae3e79ade033db516._comment b/doc/forum/Import_options/comment_2_21da91f08cb6b28ae3e79ade033db516._comment
new file mode 100644
index 0000000000..a3e2596248
--- /dev/null
+++ b/doc/forum/Import_options/comment_2_21da91f08cb6b28ae3e79ade033db516._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawkeJKC5Sy0stmcTWyePOLEVv0G-x1yaT_w"
+ nickname="Josef"
+ subject="Additional Comments"
+ date="2013-09-30T21:33:31Z"
+ content="""
+Imported several thousand files to annex and would like to add the following comments:
+
+- it would be great to have an option to exclude hidden dot files from import,
+
+- empty directories should be deleted when files located in the directories are deleted,
+
+- \"git annex add\" seems to process directories and files alphabetically, unfortunately import processes files in a different order, which makes it hard to predict which files are deleted when deduplicating,
+
+Cheers,
+
+"""]]
diff --git a/doc/forum/Missing_git-annex.linux__47__runshell.mdwn b/doc/forum/Missing_git-annex.linux__47__runshell.mdwn
new file mode 100644
index 0000000000..3ad7e85c13
--- /dev/null
+++ b/doc/forum/Missing_git-annex.linux__47__runshell.mdwn
@@ -0,0 +1,44 @@
+Hi,
+
+I've said up two clients to sync locally as well as over ssh-rsync.
+
+However, locally one client is complaining about missing `runshell` at a location where `git annex` is not installed.  The log is below.  On the assistent overview it just says "unfinished repository".  Note that I am able to ssh into the other machine and from the other machine I'm also able to ssh into this machine.
+
+
+I'm using the latest prebuild binary package (git-annex-bin at Archlinux AUR).  So my `git annex` setup contains 
+
+    $> pacman -Ql git-annex-bin 
+    git-annex-bin /usr/
+    git-annex-bin /usr/bin/
+    git-annex-bin /usr/bin/git-annex
+    git-annex-bin /usr/bin/git-annex-shell
+
+    $> pacman -Qi git-annex-bin # with chops
+    Name           : git-annex-bin
+    Version        : 4.20130909-1
+    Description    : Precompiled version of git-annex, webapp and assistant
+    included.
+    Architecture   : x86_64
+
+Here is a log of one event where it fails to transfer.  
+
+    [2013-09-28 18:06:38 CEST] TransferScanner: queued Upload NoUUID config/emacs.d/ac-l-dict/amsmath-c-a-* Nothing : expensive scan found missing object
+    [2013-09-28 18:06:38 CEST] Transferrer: Transferring: Upload NoUUID config/dotfiles/stardict/dic/stardict-oxford-2.4.2/oxford.ifo Nothing
+    [2013-09-28 18:06:38 CEST] call: git-annex ["transferkeys","--readfd","96","--writefd","94"]
+    [2013-09-28 18:06:38 CEST] read: git ["--git-dir=/home/rasmus/annex/.git","--work-tree=/home/rasmus/annex","show-ref","git-annex"]
+    [2013-09-28 18:06:38 CEST] read: git ["--git-dir=/home/rasmus/annex/.git","--work-tree=/home/rasmus/annex","show-ref","--hash","refs/heads/git-annex"]
+    [2013-09-28 18:06:38 CEST] read: git ["--git-dir=/home/rasmus/annex/.git","--work-tree=/home/rasmus/annex[","log2","0r1e3f-s/0h9e-ad2s8/ g1i8t-annex..90df78a0910a6f2998655e6:06:38 CEST] 127.0.0.1 GET /transfers/NotificationId%201 Mozilla/5.0 (X11; Linux x86_64; rv:26.0) Gecko/20100101 Firefox/26.0 Aurora/26.0a2
+    ea47d478ea0589b54","--oneline","-n1"]
+    [2013-09-28 18:06:38 CEST] read: git ["--git-dir=/home/rasmus/annex/.git","--work-tree=/home/rasmus/annex","log","refs/heads/git-annex..5f6870ed24e5ded1764765bbfef2b85aff046569","--oneline","-n1"]
+    [2013-09-28 18:06:38 CEST] chat: git ["--git-dir=/home/rasmus/annex/.git","--work-tree=/home/rasmus/annex","cat-file","--batch"]
+    [2013-09-28 18:06:38 CEST] read: ssh ["-S","/home/rasmus/annex/.git/annex/ssh/00b8ef4cb08290718ba625d9bd86ca0b","-o","ControlMaster=auto","-o","ControlPersist=yes","-T","rasmus@git-annex-192.168.1.107-rasmus_annex","git-annex-shell 'configlist' '/~/annex/'"]
+    /home/rasmus/.ssh/git-annex-shell: line 4: /opt/git-annex.linux/runshell: No such file or directory
+    [2013-09-28 18:06:38 CEST] call: git ["--git-dir=/home/rasmus/annex/.git","--work-tree=/home/rasmus/annex","fetch","--quiet","192.168.1.107_annex"]
+    [2013-09-28 18:06:38 CEST] 127.0.0.1 GET /transfers/NotificationId%201 Mozilla/5.0 (X11; Linux x86_64; rv:26.0) Gecko/20100101 Firefox/26.0 Aurora/26.0a2
+    [2013-09-28 18:06:38 CEST] 127.0.0.1 GET /log Mozilla/5.0 (X11; Linux x86_64; rv:26.0) Gecko/20100101 Firefox/26.0 Aurora/26.0a2
+    /home/rasmus/.ssh/git-annex-shell: line 4: /opt/git-annex.linux/runshell: No such file or directory
+    fatal: Could not read from remote repository.
+
+    Please make sure you have the correct access rights
+    and the repository exists.
+    git-annex: Unknown UUID
diff --git a/doc/forum/Missing_git-annex.linux__47__runshell/comment_1_f29a5105649579ef15e79d983c4e1f8e._comment b/doc/forum/Missing_git-annex.linux__47__runshell/comment_1_f29a5105649579ef15e79d983c4e1f8e._comment
new file mode 100644
index 0000000000..a10c4aaf0f
--- /dev/null
+++ b/doc/forum/Missing_git-annex.linux__47__runshell/comment_1_f29a5105649579ef15e79d983c4e1f8e._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="4.153.8.80"
+ subject="comment 1"
+ date="2013-09-30T16:08:40Z"
+ content="""
+You apparently at one point installed git-annex from the prebuilt tarball, in `/opt/git-annex.linux/`. It set up a ~/.ssh/git-annex-shell that points to this location. If you no longer have it installed that way, you can remove that file.
+"""]]
diff --git a/doc/forum/Newbie_stuck_at___34__Unable_to_connect_to_the_Jabber_server__34__/comment_3_92a52b523ed4c68b70ddcabc2a050b76._comment b/doc/forum/Newbie_stuck_at___34__Unable_to_connect_to_the_Jabber_server__34__/comment_3_92a52b523ed4c68b70ddcabc2a050b76._comment
new file mode 100644
index 0000000000..9b1d95e788
--- /dev/null
+++ b/doc/forum/Newbie_stuck_at___34__Unable_to_connect_to_the_Jabber_server__34__/comment_3_92a52b523ed4c68b70ddcabc2a050b76._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawmKKg3Vmzk7KwRGRKjHVdtyoj1JfxLX6NM"
+ nickname="Tom"
+ subject="comment 3"
+ date="2013-10-01T18:33:05Z"
+ content="""
+I've got the same issue on Xubuntu 13.04. I installed using this script: https://github.com/zerodogg/scriptbucket/blob/master/gitannex-install
+
+`git-annex version` makes no mention of DNS or ADNS
+
+`host` command is installed on my machine. any suggestions on how best to fix for this setup?
+"""]]
diff --git a/doc/forum/Slightly_finer_control_over_file_whereabouts/comment_5_e884c001a556a0c693d1cc9a97c068ac._comment b/doc/forum/Slightly_finer_control_over_file_whereabouts/comment_5_e884c001a556a0c693d1cc9a97c068ac._comment
new file mode 100644
index 0000000000..50e5cf9afe
--- /dev/null
+++ b/doc/forum/Slightly_finer_control_over_file_whereabouts/comment_5_e884c001a556a0c693d1cc9a97c068ac._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="2001:4830:1600:187::2"
+ subject="comment 5"
+ date="2013-09-20T15:31:18Z"
+ content="""
+Ok. This seems to be a bug in git-annex then. While it's surprisingly difficult to do so, it tries to interpet preferred content expressions in a stable way -- that is, they should not want to get a file when it's missing and then want to drop it when it's present.
+"""]]
diff --git a/doc/forum/Slightly_finer_control_over_file_whereabouts/comment_6_3e8674b5857e4994dfbc26be4f4b2855._comment b/doc/forum/Slightly_finer_control_over_file_whereabouts/comment_6_3e8674b5857e4994dfbc26be4f4b2855._comment
new file mode 100644
index 0000000000..eff5d9339e
--- /dev/null
+++ b/doc/forum/Slightly_finer_control_over_file_whereabouts/comment_6_3e8674b5857e4994dfbc26be4f4b2855._comment
@@ -0,0 +1,25 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="2001:4830:1600:187::2"
+ subject="comment 6"
+ date="2013-09-20T15:36:25Z"
+ content="""
+I tried to reproduce this behavior, but failed. My configuration was 2 repos, A and B, with B the origin of A. A was configured with \"exclude=archive/kronos/*\"
+(also tried \"(exclude=archive/kronos/* ) or (not copies=semitrusted+:1)\")
+
+
    +joey@darkstar:~/tmp/A>git annex get --auto
+joey@darkstar:~/tmp/A>git annex get
+get archive/kronos/foo (from origin...) ok
+(Recording state in git...)
+joey@darkstar:~/tmp/A>git annex drop --auto
+drop archive/kronos/foo ok
+(Recording state in git...)
+joey@darkstar:~/tmp/A>git annex get --auto
+joey@darkstar:~/tmp/A>
+
    
+
+... Which is how you want it to behave.
+
+So I wonder if it's something else in your configuration. The best thing to do would be if you can come up with a series of commands I can follow to build repositories that exhibit the problem.
+"""]]
diff --git a/doc/forum/Slightly_finer_control_over_file_whereabouts/comment_7_7aeabc2e52a39423e83fbd04560e8f91._comment b/doc/forum/Slightly_finer_control_over_file_whereabouts/comment_7_7aeabc2e52a39423e83fbd04560e8f91._comment
new file mode 100644
index 0000000000..145a913e90
--- /dev/null
+++ b/doc/forum/Slightly_finer_control_over_file_whereabouts/comment_7_7aeabc2e52a39423e83fbd04560e8f91._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="2001:4830:1600:187::2"
+ subject="comment 7"
+ date="2013-09-20T15:37:48Z"
+ content="""
+Also, please check if you're running into [[bugs/Handling_of_files_inside_and_outside_archive_directory_at_the_same_time]]
+"""]]
diff --git a/doc/forum/Slightly_finer_control_over_file_whereabouts/comment_8_53b95449cfad2fe0f72d2ad642822c03._comment b/doc/forum/Slightly_finer_control_over_file_whereabouts/comment_8_53b95449cfad2fe0f72d2ad642822c03._comment
new file mode 100644
index 0000000000..d866380f20
--- /dev/null
+++ b/doc/forum/Slightly_finer_control_over_file_whereabouts/comment_8_53b95449cfad2fe0f72d2ad642822c03._comment
@@ -0,0 +1,15 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawnSenxKyE_2Z6Wb-EBMO8FciyRywjx1ZiQ"
+ nickname="Walter"
+ subject="comment 8"
+ date="2013-09-20T20:30:52Z"
+ content="""
+Hmm, that could be it; the same content is both inside and outside the archive directory.
+
+What I really want to do (because maybe I'm not going about this the best way) is to use the assistant not in manual mode, but allow for some repos not having some files.
+I thought by placing them in an archive directory, then they would be dropped, and to get them again, I can just delete from the archive dir, and they will be got (as the file is also outside the archive dir.
+
+But, if that is not going to work, is there a better way to manage that?
+
+By the way, I really appreciate all the work you put into this awesome project.
+"""]]
diff --git a/doc/forum/Slightly_finer_control_over_file_whereabouts/comment_9_a17c102a45e4fc3f101a79acb8eb4081._comment b/doc/forum/Slightly_finer_control_over_file_whereabouts/comment_9_a17c102a45e4fc3f101a79acb8eb4081._comment
new file mode 100644
index 0000000000..56d22c7fdf
--- /dev/null
+++ b/doc/forum/Slightly_finer_control_over_file_whereabouts/comment_9_a17c102a45e4fc3f101a79acb8eb4081._comment
@@ -0,0 +1,18 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawnSenxKyE_2Z6Wb-EBMO8FciyRywjx1ZiQ"
+ nickname="Walter"
+ subject="comment 9"
+ date="2013-09-23T21:58:42Z"
+ content="""
+Thinking about this further, I'm not entirely sure what I want. I think the confusion arises from git-annex sometimes (mostly) caring about file *contents* (ie dependent on the hash of the file), but sometimes (preferred content, not sure of anywhere else) caring about file *location*.
+
+What I think I actually want is a way of specifying locations that are not synced, such that if the file is changed somewhere (on another computer), the new version should not be downloaded. But, if the same content is in another location as well, the behaviour should be stable, I don't know how that should work though.
+
+So, perhaps the best strategy is to have an explicit list of locations that I don't want, in the preferred content expression, if it could cope with files being in and out of some location at the same time. I think this would be easiest if I could avoid manually editing the expression all the time, maybe make a file with a list of file locations, if it would be possible for git-annex to handle that? I think it isn't at the moment, and my haskell is non-existent. That way, I could write some helper to add and remove files from this list. For example `dont-want file1 file2 dir1` would add these locations to a file, and `want file1 file2 dir1` would remove them from this list. Actually, I suppose I could make it just create an appropriate preferred-content expression, and then it doesn't need to support some file of locations.
+
+So, after that ramble, I guess I'm envisaging a preferred content expression like `content=(exclude=path/to/file1 and exclude=path/to/file1 and exclude=path/to/dir1/*) or (some statement about numcopies)`, which I imagine updating whenever I decide I do/don't want some file. The only obstacle to this working is [[bugs/Handling of files inside and outside archive directory at the same time]] (as I understand that bug, could be wrong on the implications of it), meaning (of course) if there are two files with the same content, and I exclude one of them, and not the other, then it both wants and doesn't want the file, and it (and I) get really confused.
+
+I suppose a short-term (well, slow) solution is to find duplicates of files I don't want, and if that exists either add the duplicate to my content expression (to say I don't want it), or remove the one I don't want from the expression (to say I do). This doesn't work well for when the content of one of the files changes (and so they are no longer duplicates), but I think I would search for them each time I generate the expression, so at that time it would no longer find the duplicate.
+
+So, @joey, I guess my question is, what are the chances of that bug being resolved somehow? Or if that is not likely to happen soon, I might try to implement my solution outline from the previous two paragraphs.
+"""]]
diff --git a/doc/forum/Syncing_with_an_encrypted_remote_from_a_different_computer__63__.mdwn b/doc/forum/Syncing_with_an_encrypted_remote_from_a_different_computer__63__.mdwn
new file mode 100644
index 0000000000..9315d92180
--- /dev/null
+++ b/doc/forum/Syncing_with_an_encrypted_remote_from_a_different_computer__63__.mdwn
@@ -0,0 +1,4 @@
+I created an "full archive" repo on my local pc and an encrypted "full backup" repo on Box.com. I 'm copying files on the local repo and they are getting encrypted and uploaded to Box. Superb so far :)
+
+What I am wondering though is, suppose my local pc dies. How do I get the data out of Box unencrypted from a new pc?
+
diff --git a/doc/forum/Syncing_with_an_encrypted_remote_from_a_different_computer__63__/comment_1_cd55d06a4065b9d3f14d50674c3fcaf7._comment b/doc/forum/Syncing_with_an_encrypted_remote_from_a_different_computer__63__/comment_1_cd55d06a4065b9d3f14d50674c3fcaf7._comment
new file mode 100644
index 0000000000..5a5ec35894
--- /dev/null
+++ b/doc/forum/Syncing_with_an_encrypted_remote_from_a_different_computer__63__/comment_1_cd55d06a4065b9d3f14d50674c3fcaf7._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://me.yahoo.com/a/FHnTlSBo1eCGJRwueeKeB6.RCaPbGMPr5jxx8A--#ce0d8"
+ nickname="Hamza"
+ subject="comment 1"
+ date="2013-09-22T21:18:17Z"
+ content="""
+Just clone the repository on another computer or usb drive and enable box.com remote as long as you have the clone of the repo you can download your files back.
+"""]]
diff --git a/doc/forum/Syncing_with_an_encrypted_remote_from_a_different_computer__63__/comment_2_25cbdf478091af9923090e049c432a7d._comment b/doc/forum/Syncing_with_an_encrypted_remote_from_a_different_computer__63__/comment_2_25cbdf478091af9923090e049c432a7d._comment
new file mode 100644
index 0000000000..69db183e28
--- /dev/null
+++ b/doc/forum/Syncing_with_an_encrypted_remote_from_a_different_computer__63__/comment_2_25cbdf478091af9923090e049c432a7d._comment
@@ -0,0 +1,22 @@
+[[!comment format=mdwn
+ username="John"
+ ip="109.242.130.160"
+ subject="comment 2"
+ date="2013-09-22T22:20:22Z"
+ content="""
+Thank you Hamza!
+
+I 'm new on git, so please excuse my trivial questions:
+
+a) I am using the git-annex assistant, is it something I can do from there or is it command line only?
+I googled a bit and from what I can tell, I should make a directory on the usb drive, go there and do 
+> $ git clone /path/to/fullArchiveRepo
+
+Would that be correct?
+
+b) Assuming I 've done it correctly, then I put the USB on a drawer and leave it there for a month. In the meantime, I 've been using the repo on my pc and more files have been archived encrypted on Box.com. Then my local pc dies. When I plug the usb on the new pc, will I be able to recover all the encrypted files, or only those up to 1 month ago?
+
+c) What is the proper process to use the cloned repo on a new pc? Plug the usb drive, open the git-annex assistant and go through the \"create new repo\" but use the path for the existing repo on the usb? Then add another repo from Box (with the same account and the same directory there? Would that work?
+
+Thank you for your time & knowledge! :)
+"""]]
diff --git a/doc/forum/Syncing_with_an_encrypted_remote_from_a_different_computer__63__/comment_3_7e71d355457d6b1a0391d4cdae6895e6._comment b/doc/forum/Syncing_with_an_encrypted_remote_from_a_different_computer__63__/comment_3_7e71d355457d6b1a0391d4cdae6895e6._comment
new file mode 100644
index 0000000000..81de3fc459
--- /dev/null
+++ b/doc/forum/Syncing_with_an_encrypted_remote_from_a_different_computer__63__/comment_3_7e71d355457d6b1a0391d4cdae6895e6._comment
@@ -0,0 +1,16 @@
+[[!comment format=mdwn
+ username="https://me.yahoo.com/a/FHnTlSBo1eCGJRwueeKeB6.RCaPbGMPr5jxx8A--#ce0d8"
+ nickname="Hamza"
+ subject="comment 3"
+ date="2013-09-23T00:34:24Z"
+ content="""
+I do not use the assistant I prefer command line but try adding an USB drive (last I used it it had the option) It should do the clone and init it check the resulting folder if it contains a .git/ folder you have a clone of your git repo.
+
+a) For manual cloning follow http://git-annex.branchable.com/walkthrough/adding_a_remote/
+
+b) you need to keep syncing to the clone too. asistant should automatically sync to that repo. AFAIK asisstant detects when the usb repo is plugged and automatically syncs to it (again I do not use it but I seem to remember one of joey's talks showing that. YMMV)
+
+If you lose all your repos then you lose the keys to un encrypt files they are gone!, if you have a outdated repo you can get the files back using the key stored in it but without the directory structure.
+
+Correct workflow depends on how you use annex. I sync 3 computers with annex so if one dies I can clone the repo from another one. But if you are only using it on a single computer I would use a clone on an external usb drive that is always connected, so you have two clones one on the internal disk and one on the external disk so you can survive one of the drives crashing.
+"""]]
diff --git a/doc/forum/Syncing_with_an_encrypted_remote_from_a_different_computer__63__/comment_4_a73f67f2fcf0762fbd7c8366b3844af6._comment b/doc/forum/Syncing_with_an_encrypted_remote_from_a_different_computer__63__/comment_4_a73f67f2fcf0762fbd7c8366b3844af6._comment
new file mode 100644
index 0000000000..7e649f858c
--- /dev/null
+++ b/doc/forum/Syncing_with_an_encrypted_remote_from_a_different_computer__63__/comment_4_a73f67f2fcf0762fbd7c8366b3844af6._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="4.152.108.220"
+ subject="comment 4"
+ date="2013-09-23T20:18:38Z"
+ content="""
+Other good options to supplement an offline backup drive:
+
+* A clone of the repository on another computer of yours, or on an Adroid tablet or phone.
+* An encrypted git repository stored on a remote ssh server. (Supported by recent git-annex releases, although the assistant does not yet have a UI to set this up it's not very hard to do it manually at the command line and then the assistant will use it.)
+"""]]
diff --git a/doc/forum/can_I_only_add_my_own_files__63__/comment_1_767d647af9d0345f337338d6319071fa._comment b/doc/forum/can_I_only_add_my_own_files__63__/comment_1_767d647af9d0345f337338d6319071fa._comment
new file mode 100644
index 0000000000..80efaf04bd
--- /dev/null
+++ b/doc/forum/can_I_only_add_my_own_files__63__/comment_1_767d647af9d0345f337338d6319071fa._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="4.152.108.220"
+ subject="comment 1"
+ date="2013-09-25T18:42:00Z"
+ content="""
+git-annex needs to be able to lock down files to ensure that nobody can write to them, and to do this it needs to remove the write bit, and you can't remove the write bit from a file you don't own.
+
+Note that if you configure git's core.sharedRepository when making a repository (git init --shared), then all files in both git and git-annex will be group writable. Put you and the other person you wanted to be able to write to the file in a group, and you can both access the repository. So that's the right way to do it.
+"""]]
diff --git a/doc/forum/can_I_only_add_my_own_files__63__/comment_2_0c3306ffb38b97b54e1e0436d12c1876._comment b/doc/forum/can_I_only_add_my_own_files__63__/comment_2_0c3306ffb38b97b54e1e0436d12c1876._comment
new file mode 100644
index 0000000000..5a63a71760
--- /dev/null
+++ b/doc/forum/can_I_only_add_my_own_files__63__/comment_2_0c3306ffb38b97b54e1e0436d12c1876._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="ringprince"
+ ip="134.76.140.110"
+ subject="comment 2"
+ date="2013-09-26T06:32:48Z"
+ content="""
+Thanks a lot.  The solution with --shared was really helpful.
+"""]]
diff --git a/doc/forum/git-annex___38___ikiwiki_experiment.mdwn b/doc/forum/git-annex___38___ikiwiki_experiment.mdwn
new file mode 100644
index 0000000000..5b426a1808
--- /dev/null
+++ b/doc/forum/git-annex___38___ikiwiki_experiment.mdwn
@@ -0,0 +1,28 @@
+Hi,
+
+I've been experimenting with combining [ikiwiki](http://ikiwiki.info) with git-annex and it seems to work. Thought I'd post my process. I've [commented](http://ikiwiki.info/todo/git-annex_support/discussion/) on the ikiwiki website as well but perhaps it'd be of interest to git-annex folks.
+
+I have very little understanding of any of the tools involved and have just attempted to make it work using my limited knowledge. I don't use the web interface for ikiwiki which simplifies things.
+
+The [website in question](http://stockholm.kalleswork.net) just went online and is currently an archive of architectural photographs and the site relies heavily on the ikiwiki osm and album plugins.
+
+### Setting things up
+
+To start with I set up the wiki on the server and git clone to into `$wrkdir` on my laptop. I then initialize a git-annex repo in the `$srcdir` on the server. Leaving the `$gitdir` untouched. The `$scrdir` git-annex repo has to be in `direct` mode. Before doing any syncing I add `annex-ignore = true` and `annex-sync = false` to `.git/config` in the origin repo (`$gitdir`): this is to prevent polluting `$gitdir` with git-annex data. The same process is repeated in the `$wrkdir` on the laptop.
+
+### Pushing and syncing
+
+With this setup I can then `git add remote $srcdir`, `git add $file` and `git-push` mdwn files and other lightweight data from the laptop. While `git annex-add`, `git-annex sync` and `git-annex copy --to $srcdir` jpg's and other heavy files. All pure git commands work as expected with ikiwiki and the website recompiles etc.
+
+### Snags
+
+I'm frequently left with (non-dangling) symlinks in the `$srcdir` despite the annex repo being in direct mode. When this happens `git-annex fsck` sorts things out.
+
+Uploading image files does require a bit of manual work. But as this is done less frequently it's not much of an issue for me. I'm guessing that by doing things it the correct order (whatever that might be) I could avoid some of the manual work.
+
+The thing to keep in mind is to never `git-add` the typechanged annexed files in the $srcdir. In general I never use git commands in the $srcdir.
+
+The main problem is the symlinks though as they demand a manual `git-annex fsck`. I have no idea what causes the symlinks in a direct mode repo.
+
+Any comments? 
+
diff --git a/doc/forum/git-annex___38___ikiwiki_experiment/comment_1_9f74449ec91577dbf6095f4beafac293._comment b/doc/forum/git-annex___38___ikiwiki_experiment/comment_1_9f74449ec91577dbf6095f4beafac293._comment
new file mode 100644
index 0000000000..332f77bcc8
--- /dev/null
+++ b/doc/forum/git-annex___38___ikiwiki_experiment/comment_1_9f74449ec91577dbf6095f4beafac293._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="https://id.koumbit.net/anarcat"
+ ip="72.0.72.144"
+ subject="how about the web interface?"
+ date="2013-09-25T11:09:58Z"
+ content="""
+I understand you do not use the web interface - but what if you did? would it commit all those files into git?
+
+Could we add the git-annex files to a .gitignore file?
+"""]]
diff --git a/doc/forum/git-annex___38___ikiwiki_experiment/comment_2_e034585c8b51cc30b35c1f7ae68205bf._comment b/doc/forum/git-annex___38___ikiwiki_experiment/comment_2_e034585c8b51cc30b35c1f7ae68205bf._comment
new file mode 100644
index 0000000000..2201813fe4
--- /dev/null
+++ b/doc/forum/git-annex___38___ikiwiki_experiment/comment_2_e034585c8b51cc30b35c1f7ae68205bf._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawk3HGoDpnOPob5jOjvIootmkve1-nCpRiI"
+ nickname="Kalle"
+ subject="comment 2"
+ date="2013-09-25T11:58:42Z"
+ content="""
+I have very poor understanding of what ikiwiki actually does behind the scenes including how it uses the $srcdir and $gitdir.
+
+The only way I could see the web interface working would be to use the git-annex content expressions and having the assistant running on the server. That still doesn't prevent large files from being checked into git though? That all depends on which order ikiwiki can be made to do things.
+
+I might be able to test on a local wiki but that would have to wait a while.
+
+
+"""]]
diff --git a/doc/forum/git-annex___38___ikiwiki_experiment/comment_3_fbbd47c3dbe8de24b0df664e4afd5cb8._comment b/doc/forum/git-annex___38___ikiwiki_experiment/comment_3_fbbd47c3dbe8de24b0df664e4afd5cb8._comment
new file mode 100644
index 0000000000..63919bd22d
--- /dev/null
+++ b/doc/forum/git-annex___38___ikiwiki_experiment/comment_3_fbbd47c3dbe8de24b0df664e4afd5cb8._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="4.152.108.220"
+ subject="comment 3"
+ date="2013-09-25T17:03:29Z"
+ content="""
+Interesting experiment.
+
+I don't know why you don't want to let git-annex sync its data to $gitdir.
+
+The symlinks could be occuring because of a bug in direct mode. (I have fixed many past bugs that caused that.) But just as likely it's because ikiwiki will run `git pull` in the srcdir.
+
+I think it would make more sense to use the underlay plugin and keep your annexed repository in a separate underlay. This would guarantee ikiwiki doesn't run git commands in there, and would ensure that nothing done with the web interface could mess with the annex.
+"""]]
diff --git a/doc/forum/git-annex___38___ikiwiki_experiment/comment_4_55da5c3c41c13b08590ce1ff8117cef6._comment b/doc/forum/git-annex___38___ikiwiki_experiment/comment_4_55da5c3c41c13b08590ce1ff8117cef6._comment
new file mode 100644
index 0000000000..6299326a89
--- /dev/null
+++ b/doc/forum/git-annex___38___ikiwiki_experiment/comment_4_55da5c3c41c13b08590ce1ff8117cef6._comment
@@ -0,0 +1,23 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawk3HGoDpnOPob5jOjvIootmkve1-nCpRiI"
+ nickname="Kalle"
+ subject="comment 4"
+ date="2013-09-25T18:28:40Z"
+ content="""
+@Joey
+
+    > I don't know why you don't want to let git-annex sync its data to $gitdir.
+
+Well neither do I! :) It seemed to be the way to avoid duplicating data while still having the images picked up by the ikiwiki album plugin. Wouldn't the files in the $gitdir end up duplicated in $srcdir?
+
+    > The symlinks could be occuring because of a bug in direct mode. 
+    > (I have fixed many past bugs that caused that.) But just as likely
+    > it's because ikiwiki will run git pull in the srcdir.
+
+When you mention it I've had similar problems with my vfat usb annex repos. Using the post-receive merge hook to make files visible for non git-annex devices about town. Nothing I can reliably recreate but I will keep my eye out for bugs.
+
+    > I think it would make more sense to use the underlay plugin and keep 
+    > your annexed repository in a separate underlay. 
+
+Yep that would be ideal. For my usecase the album plugin is vital and I can't understand how album would pick up and deal with images in an underlay dir. This is a bit OT for this site though most of my questions are ikiwiki related.
+"""]]
diff --git a/doc/forum/git-annex___38___ikiwiki_experiment/comment_5_f67823351164ddfe7d595685c3679652._comment b/doc/forum/git-annex___38___ikiwiki_experiment/comment_5_f67823351164ddfe7d595685c3679652._comment
new file mode 100644
index 0000000000..2701bd4af1
--- /dev/null
+++ b/doc/forum/git-annex___38___ikiwiki_experiment/comment_5_f67823351164ddfe7d595685c3679652._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawk3HGoDpnOPob5jOjvIootmkve1-nCpRiI"
+ nickname="Kalle"
+ subject="comment 5"
+ date="2013-09-26T06:56:49Z"
+ content="""
+Turns out using the underlay was a piece of cake! Just mirror the folder structure of the repo in your underlaydir put your jpegs there and off you go. Images are picked up by the album plugin and it all just works. No need to coax git-annex into doing odd stuff.
+
+Thought I'd post this for other ikiwikers.
+"""]]
diff --git a/doc/forum/git-annex___38___ikiwiki_experiment/comment_6_d5cc91164772849d027fed5f962d9000._comment b/doc/forum/git-annex___38___ikiwiki_experiment/comment_6_d5cc91164772849d027fed5f962d9000._comment
new file mode 100644
index 0000000000..1d3abdf5de
--- /dev/null
+++ b/doc/forum/git-annex___38___ikiwiki_experiment/comment_6_d5cc91164772849d027fed5f962d9000._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="https://id.koumbit.net/anarcat"
+ ip="72.0.72.144"
+ subject="step by step?"
+ date="2013-09-26T09:40:57Z"
+ content="""
+So how does this actually work in practice? Is the underlay directory a completely disconnected repository?
+
+Can we have step by step instructions on how to set this up?
+"""]]
diff --git a/doc/forum/git-annex___38___ikiwiki_experiment/comment_7_cb4ec7ed3c39d0649133191a85ea6ab3._comment b/doc/forum/git-annex___38___ikiwiki_experiment/comment_7_cb4ec7ed3c39d0649133191a85ea6ab3._comment
new file mode 100644
index 0000000000..8e387d89a5
--- /dev/null
+++ b/doc/forum/git-annex___38___ikiwiki_experiment/comment_7_cb4ec7ed3c39d0649133191a85ea6ab3._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawk3HGoDpnOPob5jOjvIootmkve1-nCpRiI"
+ nickname="Kalle"
+ subject="comment 7"
+ date="2013-09-26T13:05:53Z"
+ content="""
+@anarcat
+
+    > Can we have step by step instructions on how to set this up?
+
+[I described the ikiwiki album setup](http://ikiwiki.info/forum/ikiwiki_with_album___38___underlay_plugins/) on the ikiwiki website as there are no git-annex tricks anymore. Just standard behaviour.
+
+    > So how does this actually work in practice? Is the underlay directory a 
+    > completely disconnected repository?
+
+Yes they are completely separate repos. Really the underlay dir could be managed in any way you like svn, rsync, ftp etc. I didn't expect the album plugin to pick everything up but apparently it does! Perhaps underlays are completely integrated and appear as 'normal' to all of ikiwiki?
+"""]]
diff --git a/doc/forum/git-annex___38___ikiwiki_experiment/comment_8_86565e5e1508ff1862f88975446650a2._comment b/doc/forum/git-annex___38___ikiwiki_experiment/comment_8_86565e5e1508ff1862f88975446650a2._comment
new file mode 100644
index 0000000000..473551f657
--- /dev/null
+++ b/doc/forum/git-annex___38___ikiwiki_experiment/comment_8_86565e5e1508ff1862f88975446650a2._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="https://id.koumbit.net/anarcat"
+ ip="72.0.72.144"
+ subject="comment 8"
+ date="2013-09-26T13:10:25Z"
+ content="""
+Yes, I believe that is the way the underlay works - the files are just picked up.
+
+As for the ikiwiki forum post - maybe you should move it to the \"tips\" section? :)
+
+Thanks for the documentation!!
+"""]]
diff --git a/doc/forum/git-status_typechange_in_direct_mode.mdwn b/doc/forum/git-status_typechange_in_direct_mode.mdwn
new file mode 100644
index 0000000000..6438fb890d
--- /dev/null
+++ b/doc/forum/git-status_typechange_in_direct_mode.mdwn
@@ -0,0 +1,48 @@
+Hi all,
+
+how can I get rid of all those 'typechange' messages in `git status`
+when in direct mode?
+
+Here is an example session:
+
+    > git init
+    Initialized empty Git repository in /some/path/.git/
+    > git config user.name dtrn
+    > git config user.email drn@drn.com
+    > git annex init
+    init  ok
+    (Recording state in git...)
+    > git annex direct
+    commit
+    # On branch master
+    #
+    # Initial commit
+    #
+    nothing to commit (create/copy files and use "git add" to track)
+    ok
+    direct  ok
+    > dd if=/dev/zero of=testfile.bin count=1000
+    1000+0 records in
+    1000+0 records out
+    512000 bytes (512 kB) copied, 0.00317424 s, 161 MB/s
+    > git annex add testfile.bin
+    add testfile.bin (checksum...) ok
+    (Recording state in git...)
+    > git commit -m "annexed testfile.bin"
+    ok
+    [master (root-commit) 281e740] annexed testfile.bin
+     1 file changed, 1 insertion(+)
+     create mode 120000 testfile.bin
+    >  git status
+    # On branch master
+    # Changes not staged for commit:
+    #   (use "git add ..." to update what will be committed)
+    #   (use "git checkout -- ..." to discard changes in working directory)
+    #
+    #       typechange: testfile.bin
+    #
+    no changes added to commit (use "git add" and/or "git commit -a")
+
+
+Regards,
+Andreas
diff --git a/doc/forum/git-status_typechange_in_direct_mode/comment_1_12c8b67aadbfa2b073e12997a55d49a7._comment b/doc/forum/git-status_typechange_in_direct_mode/comment_1_12c8b67aadbfa2b073e12997a55d49a7._comment
new file mode 100644
index 0000000000..31e476087d
--- /dev/null
+++ b/doc/forum/git-status_typechange_in_direct_mode/comment_1_12c8b67aadbfa2b073e12997a55d49a7._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="2001:4830:1600:187::2"
+ subject="comment 1"
+ date="2013-09-20T15:24:25Z"
+ content="""
+These messages are normal in direct mode. 
+
+They happen because git status does not know about git-annex's direct mode. So it sees a file that has a symlink checked into git, but a normal file in place in the working tree. Thus, its type has changed. Short of hacking or wrapping git, or switching to indirect mode ;), there's not much that can be done about this.
+
+You might want to read [[direct_mode]] for more about this, and some of the problems it can cause when running certian git commands.
+"""]]
diff --git a/doc/forum/git-status_typechange_in_direct_mode/comment_2_005d1b17f3c2ae192aa30c6e5163989e._comment b/doc/forum/git-status_typechange_in_direct_mode/comment_2_005d1b17f3c2ae192aa30c6e5163989e._comment
new file mode 100644
index 0000000000..c598b212fe
--- /dev/null
+++ b/doc/forum/git-status_typechange_in_direct_mode/comment_2_005d1b17f3c2ae192aa30c6e5163989e._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="ringprince"
+ ip="134.76.140.110"
+ subject="comment 2"
+ date="2013-09-20T20:16:47Z"
+ content="""
+Thanks for the info and the quick reply.
+"""]]
diff --git a/doc/git-annex-shell.mdwn b/doc/git-annex-shell.mdwn
index 38659d0e28..c866154acb 100644
--- a/doc/git-annex-shell.mdwn
+++ b/doc/git-annex-shell.mdwn
@@ -60,6 +60,10 @@ first "/~/" or "/~user/" is expanded to the specified home directory.
   This commits any staged changes to the git-annex branch.
   It also runs the annex-content hook.
 
+* gcryptsetup gcryptid
+
+  Sets up a repository as a gcrypt repository.
+
 # OPTIONS
 
 Most options are the same as in git-annex. The ones specific
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index ad74e3441c..c06d1ffe98 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -206,10 +206,9 @@ subdirectories).
 
   Moves files from somewhere outside the git working copy, and adds them to
   the annex. Individual files to import can be specified. 
-  If a directory is specified, all files in it are imported, and any
-  subdirectory structure inside it is preserved.
+  If a directory is specified, the entire directory is imported.
 
-        	git annex import /media/camera/DCIM/
+        	git annex import /media/camera/DCIM/*
 
   By default, importing two files with the same contents from two different
   locations will result in both files being added to the repository.
@@ -825,6 +824,10 @@ subdirectories).
 
   Also, '\\n' is a newline, '\\000' is a NULL, etc.
 
+* `--user-agent=value`
+
+  Overrides the User-Agent to use when downloading files from the web.
+
 * `-c name=value`
 
   Used to override git configuration settings. May be specified multiple times.
@@ -1230,6 +1233,15 @@ Here are all the supported configuration settings.
   Used to identify the XMPP address of a Jabber buddy.
   Normally this is set up by the git-annex assistant when pairing over XMPP.
 
+* `remote..gcrypt`
+
+  Used to identify gcrypt special remotes.
+  Normally this is automatically set up by `git annex initremote`.
+
+  It is set to "true" if this is a gcrypt remote.
+  If the gcrypt remote is accessible over ssh and has git-annex-shell
+  available to manage it, it's set to "shell"
+
 # CONFIGURATION VIA .gitattributes
 
 The key-value backend used when adding a new file to the annex can be
diff --git a/doc/install/Android.mdwn b/doc/install/Android.mdwn
index 6b2cb3a539..c39d115684 100644
--- a/doc/install/Android.mdwn
+++ b/doc/install/Android.mdwn
@@ -19,14 +19,14 @@ of Bath CS department.
 
 ## building it yourself
 
-git-annex can be built for Android, with `make android`. It's not an easy
-process:
+git-annex can be built from source for Android.
 
-* First, install .
-* You will need to have the Android SDK and NDK installed; see
-  `standalone/android/Makefile` to configure the paths to them. You'll also
-  need ant, and the JDK.
-* In `standalone/android/`, run `install-haskell-packages native`
-* You also need to install git and all the utilities listed on [[fromscratch]],
-  on the system doing the building.
-* Then to build the full Android app bundle, use `make androidapp`
+1. Run `standalone/android/buildchroot` as root (requires debootstrap).
+   This builds a chroot with an `androidbuilder` user.
+   The rest of the build will run in this chroot as that user.
+2. Then run `standalone/android/install-haskell-packages`
+   Note that this will break from time to time as new versions of packages
+   are released, and the patches it applies have to be updated when
+   this happens.
+3. Finally, once the chroot is set up, you can build an Android binary
+   with `make android`, and `make androidapp` will build the complete APK.
diff --git a/doc/install/Android/comment_10_225f2c6fe255be93702cfbd4dc172f3b._comment b/doc/install/Android/comment_10_225f2c6fe255be93702cfbd4dc172f3b._comment
new file mode 100644
index 0000000000..f6a71981e6
--- /dev/null
+++ b/doc/install/Android/comment_10_225f2c6fe255be93702cfbd4dc172f3b._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://id.clacke.se/"
+ nickname="clacke"
+ subject="+1 F-Droid"
+ date="2013-09-24T18:36:48Z"
+ content="""
+Availability in F-Droid would be really neat. I imagine the unusual build requirements would require some work though.
+"""]]
diff --git a/doc/install/cabal/comment_19_6f42f9234f9ff6a2ca6bbb4d2643843e._comment b/doc/install/cabal/comment_19_6f42f9234f9ff6a2ca6bbb4d2643843e._comment
new file mode 100644
index 0000000000..27a3e8c620
--- /dev/null
+++ b/doc/install/cabal/comment_19_6f42f9234f9ff6a2ca6bbb4d2643843e._comment
@@ -0,0 +1,44 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawlu7K3h7Ry1uDAU_ERYGuqt0LoGNJqGuRo"
+ nickname="Nathan"
+ subject="Cabal installing git-annex on Ubuntu 12.04 Precise with GHC 7.6.3"
+ date="2013-09-25T22:39:04Z"
+ content="""
+I now realize [there is a Ubuntu 12.04 Precise PPA with a current
+version of
+git-annex](http://git-annex.branchable.com/install/Ubuntu/), so that's
+probably a better choice, but here's how I cabal isntalled git-annex.
+
+1. Apt install non-cabal dependencies:
+
+       sudo aptitude install c2hs libgsasl7-dev libxml2-dev
+
+2. Manually cabal install yesod-platform to avoid the [cryptocipher problem 
+   mentioned above](
+   http://git-annex.branchable.com/install/cabal/#comment-1807da37dc144b572b76aaf4b574bb54):
+
+       cabal install yesod-platform
+
+3. Cabal install git-annex with DNS flag disabled:
+
+       cabal install git-annex -f\"-dns\"
+
+I was getting this error building git-annex before disabling the DNS flag:
+
+    Utility/SRV.hs:70:54:
+        Couldn't match expected type `Maybe
+                                        [(Int, Int, Integer, B8.ByteString)]'
+                    with actual type `Either
+                                        dns-1.0.0:Network.DNS.Internal.DNSError
+                                        [(Int, Int, Int, dns-1.0.0:Network.DNS.Internal.Domain)]'
+        In the third argument of `maybe', namely `r'
+        In the second argument of `($)', namely
+          `maybe [] (orderHosts . map tohosts) r'
+        In a stmt of a 'do' block:
+          return $ maybe [] (orderHosts . map tohosts) r
+
+Looking at Utiltity/SRV.hs, it appears that disabling the DNS flag
+just makes git annex use a different DNS library (ADNS), not
+actually disable DNS lookups.
+
+"""]]
diff --git a/doc/install/fromscratch.mdwn b/doc/install/fromscratch.mdwn
index 64e2fa84e3..7694733c7c 100644
--- a/doc/install/fromscratch.mdwn
+++ b/doc/install/fromscratch.mdwn
@@ -7,6 +7,7 @@ quite a lot.
   * [MissingH](http://github.com/jgoerzen/missingh/wiki)
   * [utf8-string](http://hackage.haskell.org/package/utf8-string)
   * [SHA](http://hackage.haskell.org/package/SHA)
+  * [cryptohash](http://hackage.haskell.org/package/cryptohash)
   * [dataenc](http://hackage.haskell.org/package/dataenc)
   * [monad-control](http://hackage.haskell.org/package/monad-control)
   * [QuickCheck 2](http://hackage.haskell.org/package/QuickCheck)
diff --git a/doc/special_remotes.mdwn b/doc/special_remotes.mdwn
index 88370cf881..6878a1f880 100644
--- a/doc/special_remotes.mdwn
+++ b/doc/special_remotes.mdwn
@@ -28,7 +28,7 @@ The git-annex assistant makes it easy to set up rsync remotes using this last sc
 None of these use cases are particular to particular special remote types. Most special remotes can all be used in these and other ways. It largely doesn't matter for your use what underlying transport the special remote uses.
 
 Here are specific instructions
-for various cloud things:
+for using git-annex with various services:
 
 * [[Amazon_S3|tips/using_Amazon_S3]]
 * [[Amazon_Glacier|tips/using_Amazon_Glacier]]
@@ -43,6 +43,7 @@ for various cloud things:
 * [[Flickr|tips/flickrannex]]
 * [[IMAP|forum/special_remote_for_IMAP]]
 * [[Usenet|forum/nntp__47__usenet special remote]]
+* [chef-vault](https://github.com/3ofcoins/knife-annex/)
 
 ## Unused content on special remotes
 
diff --git a/doc/special_remotes/gcrypt.mdwn b/doc/special_remotes/gcrypt.mdwn
index 06ac3c23eb..f83a953c12 100644
--- a/doc/special_remotes/gcrypt.mdwn
+++ b/doc/special_remotes/gcrypt.mdwn
@@ -29,7 +29,9 @@ gcrypt:
 ## notes
 
 For git-annex to store files in a repository on a remote server, you need
-shell access, and `rsync` must be installed. 
+shell access, and `rsync` must be installed. Those are the minimum
+requirements, but it's also recommended to install git-annex on the remote
+server, so that [[git-annex-shell]] can be used.
 
 While you can use git-remote-gcrypt with servers like github, git-annex
 can't store files on them. In such a case, you can just use
diff --git a/doc/special_remotes/xmpp/comment_5_583ee374bd34fcc9ae26c2fd690e8c47._comment b/doc/special_remotes/xmpp/comment_5_583ee374bd34fcc9ae26c2fd690e8c47._comment
new file mode 100644
index 0000000000..298c4392a8
--- /dev/null
+++ b/doc/special_remotes/xmpp/comment_5_583ee374bd34fcc9ae26c2fd690e8c47._comment
@@ -0,0 +1,73 @@
+[[!comment format=mdwn
+ username="RaspberryPie"
+ ip="37.221.161.234"
+ subject="Nope"
+ date="2013-09-24T22:05:55Z"
+ content="""
+Your guess is right, Joey, I'm configuring by hand as the ARM machine has no webapp. And yes, I'm mostly sure I set up everything correctly. The XMPP account is working, and my configuration of git-annex is all but identical to your example.
+
+Here's what I do. First on the machine with the webapp:
+
+    mkdir ~/test
+    cd ~/test
+    git init
+    git annex init
+    git annex webapp
+
+I set up XMPP from within the webapp. The file ~/test/.git/annex/creds/xmpp is created with the correct credentials. (BTW: The file's default permissions are 620 instead of 600 - is that a bug?)
+
+I add a file or two to the annex for good measure. Then, on the ARM machine:
+
+    mkdir ~/test
+    cd ~/test
+    git init
+    git annex init
+    mkdir .git/annex/creds
+    scp -2 webappmachine:~/test/.git/annex/creds/xmpp .git/annex/creds 
+    chmod 600 .git/annex/creds/xmpp
+    git remote add webappmachine xmpp::login@server
+
+The final step is to edit .git/config on the ARM machine. The [remote] section now looks like this:
+
+    [remote \"webappmachine\"]
+        url = xmpp::login@server
+        fetch = +refs/heads/*:refs/remotes/webappmachine/*
+        annex-uuid = aaaaaaaa-bbbb-cccc-dddddddddddd
+
+where aaaaaaaa-bbbb-cccc-dddddddddddd is the return value of `git config --get annex.uuid` on the webapp machine.
+
+I then run `git annex assistant` on the ARM machine and expect the two machines to synchronize their metadata, e.g. the number of knownn annex keys in the repo. But it doesn't happen.
+
+So I set `debug = true`, restart the assistants and check the log. This is what I get on the webapp machine:
+
+    [2013-09-24 17:45:41 EDT] XMPPClient: connected a5/25577ac4-3248-4c83-8391-bd93708bcf2b
+    [2013-09-24 17:45:41 EDT] XMPPClient: received: [\"Presence from a5/dc9bcde8-fe18-47de-807c-c620019279f2 Just (Element {elementName = Name {nameLocalName = \\"git-annex\\", nameNamespace = Just \\"git-annex\\", namePrefix = Nothing}, elementAttributes = [(Name {nameLocalName = \\"query\\", nameNamespace = Nothing, namePrefix = Nothing},[ContentText \\"\\"])], elementNodes = []})\",\"QueryPresence\"]
+    [2013-09-24 17:45:42 EDT] XMPPClient: received: [\"Presence from a5/900e3b6e-a7f4-4a6a-8d12-ed94de429258 Just (Element {elementName = Name {nameLocalName = \\"git-annex\\", nameNamespace = Just \\"git-annex\\", namePrefix = Nothing}, elementAttributes = [(Name {nameLocalName = \\"push\\", nameNamespace = Nothing, namePrefix = Nothing},[ContentText \\"43357474-abbb-4667-a334-e4615ea6d4a2\\"])], elementNodes = []})\",\"NotifyPush [UUID \\"43357474-abbb-4667-a334-e4615ea6d4a2\\"]\"]
+    [2013-09-24 17:45:42 EDT] XMPPClient: push notification for
+    [2013-09-24 17:45:42 EDT] read: git [\"--git-dir=/home/pi/test/.git\",\"--work-tree=/home/pi/test\",\"symbolic-ref\",\"HEAD\"]
+    [2013-09-24 17:45:42 EDT] read: git [\"--git-dir=/home/pi/test/.git\",\"--work-tree=/home/pi/test\",\"show-ref\",\"refs/heads/master\"]
+    [2013-09-24 17:45:42 EDT] XMPPClient: received: [\"Pushing \\"a59\\" (CanPush (UUID \\"d50c4cc9-e7c0-4ef0-84c6-f11012051eb9\\") [34f875cc7fa1198414f93990af9ab78e6cee893e,6fad42234060361435d6cf2ab4bd40e438c2d05c])\"]
+    [2013-09-24 17:45:42 EDT] read: git [\"--git-dir=/home/pi/test/.git\",\"--work-tree=/home/pi/test\",\"show-ref\",\"git-annex\"]
+    [2013-09-24 17:45:42 EDT] read: git [\"--git-dir=/home/pi/test/.git\",\"--work-tree=/home/pi/test\",\"show-ref\",\"--hash\",\"refs/heads/git-annex\"]
+    [2013-09-24 17:45:42 EDT] read: git [\"--git-dir=/home/pi/test/.git\",\"--work-tree=/home/pi/test\",\"log\",\"refs/heads/git-annex..6fad42234060361435d6cf2ab4bd40e438c2d05c\",\"--oneline\",\"-n1\"]
+    [2013-09-24 17:45:42 EDT] chat: git [\"--git-dir=/home/pi/test/.git\",\"--work-tree=/home/pi/test\",\"cat-file\",\"--batch\"]
+    [2013-09-24 17:45:42 EDT] XMPPClient: received: [\"Ignorable Presence from a5/25577ac4-3248-4c83-8391-bd93708bcf2b Just (Element {elementName = Name {nameLocalName = \\"git-annex\\", nameNamespace = Just \\"git-annex\\", namePrefix = Nothing}, elementAttributes = [], elementNodes = []})\"]
+    [2013-09-24 17:45:42 EDT] XMPPClient: received: [\"Unknown message\"]
+    [2013-09-24 17:45:42 EDT] XMPPClient: received: [\"Pushing \\"a59\\" (PushRequest (UUID \\"d50c4cc9-e7c0-4ef0-84c6-f11012051eb9\\"))\"]
+    [2013-09-24 17:45:42 EDT] XMPPSendPack: started running push Pushing \"a59\" (PushRequest (UUID \"d50c4cc9-e7c0-4ef0-84c6-f11012051eb9\"))
+    [2013-09-24 17:45:42 EDT] read: git [\"--git-dir=/home/pi/test/.git\",\"--work-tree=/home/pi/test\",\"symbolic-ref\",\"HEAD\"]
+    [2013-09-24 17:45:42 EDT] XMPPClient: received: [\"Ignorable Presence from a5/25577ac4-3248-4c83-8391-bd93708bcf2b Just (Element {elementName = Name {nameLocalName = \\"git-annex\\", nameNamespace = Just \\"git-annex\\", namePrefix = Nothing}, elementAttributes = [], elementNodes = []})\"]
+    [2013-09-24 17:45:42 EDT] read: git [\"--git-dir=/home/pi/test/.git\",\"--work-tree=/home/pi/test\",\"show-ref\",\"refs/heads/master\"]
+    [2013-09-24 17:45:42 EDT] call: git [\"--git-dir=/home/pi/test/.git\",\"--work-tree=/home/pi/test\",\"branch\",\"-f\",\"synced/master\"]
+    [2013-09-24 17:45:42 EDT] XMPPSendPack: finished running push Pushing \"a59\" (PushRequest (UUID \"d50c4cc9-e7c0-4ef0-84c6-f11012051eb9\")) False
+
+And from then on, in two-minute intervals:
+
+    [2013-09-24 17:47:42 EDT] XMPPClient: received: [\"Unknown message\"]
+    [2013-09-24 17:49:42 EDT] XMPPClient: received: [\"Unknown message\"]
+    [2013-09-24 17:51:42 EDT] XMPPClient: received: [\"Unknown message\"]
+    
+The log on the ARM machine is rather unhelpful. Actually it doesn't even contain the string \"XMPP\". This looks to me like the webapp machine tries to communicate via Jabber but doesn't get any intelligible answer. And this is the reason I wondered whether the problem lies with my self-compiled ARM git-annex  binary. I actually spent a while compiling 4.20130909 with all flags but webapp and webdav, but the result is still the same. 
+
+Any other ideas what I'm doing wrong here?
+"""]]
diff --git a/doc/special_remotes/xmpp/comment_6_8f0b5bba1271d031a67e7f0c175d67d5._comment b/doc/special_remotes/xmpp/comment_6_8f0b5bba1271d031a67e7f0c175d67d5._comment
new file mode 100644
index 0000000000..750e0874a4
--- /dev/null
+++ b/doc/special_remotes/xmpp/comment_6_8f0b5bba1271d031a67e7f0c175d67d5._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="4.152.108.220"
+ subject="comment 6"
+ date="2013-09-25T18:13:24Z"
+ content="""
+If you're not getting an \"XMPPClient: connected\", then my guess would be that your git-annex build's XMPP is screwed up somehow. For example, if it hung forever when connecting to the XMPP server, it would never get as far as printing that message. (If it tried and failed to connect, you'd get a message about the connection having failed.)
+"""]]
diff --git a/doc/special_remotes/xmpp/comment_7_ac7acbded03325b015959d82ae77faf1._comment b/doc/special_remotes/xmpp/comment_7_ac7acbded03325b015959d82ae77faf1._comment
new file mode 100644
index 0000000000..0ad65336b7
--- /dev/null
+++ b/doc/special_remotes/xmpp/comment_7_ac7acbded03325b015959d82ae77faf1._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="RaspberryPie"
+ ip="46.165.221.166"
+ subject="comment 7"
+ date="2013-09-26T03:46:18Z"
+ content="""
+I see. Is there a way to check whether the build is corrupt? The build logs gave me nothing. 
+
+Anyway, XMPP is not the most important feature to me. It still bugs me though that it doesn't work when it should.  
+"""]]
diff --git a/doc/tips/fully_encrypted_git_repositories_with_gcrypt.mdwn b/doc/tips/fully_encrypted_git_repositories_with_gcrypt.mdwn
index 567976d96a..5559acfaec 100644
--- a/doc/tips/fully_encrypted_git_repositories_with_gcrypt.mdwn
+++ b/doc/tips/fully_encrypted_git_repositories_with_gcrypt.mdwn
@@ -50,14 +50,18 @@ the gpg key used to encrypt it, and then:
 
 ## encrypted git-annex repository on a ssh server
 
-If you have a ssh server that has git-annex and rsync installed, you can
-set up an encrypted repository there. Works just like the encrypted drive
-except without the cable.
+If you have a ssh server that has rsync installed, you can set up an
+encrypted repository there. Works just like the encrypted drive except
+without the cable.
 
 First, on the server, run:
 
 	git init --bare encryptedrepo
 
+(Also, install git-annex on the server if it's possible & easy to do so.
+While this will work without git-annex being installed on the server, it
+is recommended to have it installed.)
+
 Now, in your existing git-annex repository:
 
 	git annex initremote encryptedrepo type=gcrypt gitrepo=ssh://my.server/home/me/encryptedrepo keyid=$mykey
diff --git a/doc/tips/offline_archive_drives.mdwn b/doc/tips/offline_archive_drives.mdwn
new file mode 100644
index 0000000000..3f073dbcba
--- /dev/null
+++ b/doc/tips/offline_archive_drives.mdwn
@@ -0,0 +1,68 @@
+After you've used git-annex for a while, you will have data in your repository
+that you don't want to keep in the limited disk space of a laptop or a server,
+but that you don't want to entirely delete.
+
+This is where git-annex's support for offline archive drives shines.
+You can move old files to an archive drive, which can be kept offline if
+it's not practical to keep it spinning. Better, you can move old files to
+two or more archive drives, in case one of them later fails to spin up.  
+(One consideration when [[future_proofing]] your archive.)
+
+To set up an archive drive, you can take any removable drive, format
+it with a filesystem you'll be able to read some years later, and then follow
+the [[walkthrough]] to set up a repository on it that is a git remote of 
+the repository in your computer you want to archive. In short:
+
+	cd /media/archive
+	git clone ~/annex
+	cd ~/annex
+	git remote add archivedrive /media/archive/annex
+	git annex sync archive
+
+Don't forget to  tell git-annex this is an archive drive (or perhaps a backup
+drive). Also, give the drive a description that matches something you write on
+its label, so you can find it later:
+
+	git annex group archivedrive archive
+	git annex describe archivedrive "my first archive drive (SATA)"
+
+Or you can use the assistant to set up the drive for you.  
+(Nice video tutorial here: [[videos/git-annex_assistant_archiving]])
+
+(Keeping the archive drive in an offsite location? Consider encrypting
+it! See [[fully_encrypted_git_repositories_with_gcrypt].])
+
+Then, when the archive drive is plugged in, you can easily copy files to
+it:
+
+	cd ~/annex
+	git-annex copy --auto --to archivedrive
+
+Or, if you're using the assistant, it will automatically notice when the drive
+gets plugged in and copy files that need to be archived.
+
+When you want to get rid of the local file, leaving only the copy on the
+archive, you can just:
+
+	git annex drop file
+
+The archive drive has to be plugged in for this to work, so git-annex
+can verify it still has the file. If you had configured git-annex to
+always store 2 [[copies]], it will need 2 archive drives plugged in.
+You may find it useful to configure a [[trust]] setting for the drive to
+avoid needing to haul it out of storage to drop a file.
+
+Now the really nice thing. When your archive drive gets filled up, you
+can simply remove it, store it somewhere safe, and replace it with a new
+drive, which can be mounted at the same location for simplicity. Set up
+the new drive the same way described above, and use it to archive even more
+files.
+
+Finally, when you want to access one of the files you archived, you can
+just ask for it:
+
+	git annex get file
+
+If necessary git-annex will tell you which archive drive you need to
+pull out of storage to get the file back. This is where the description
+you entered earlier comes in handy.
diff --git a/doc/tips/shared_git_annex_directory_between_multiple_users.mdwn b/doc/tips/shared_git_annex_directory_between_multiple_users.mdwn
index 61f02ab3c1..5ca3b45ec9 100644
--- a/doc/tips/shared_git_annex_directory_between_multiple_users.mdwn
+++ b/doc/tips/shared_git_annex_directory_between_multiple_users.mdwn
@@ -36,3 +36,4 @@ See also
 
  * [[tips/setup a public repository on a web site]]
  * [[news/version 4.20130909]]
+ * [[bugs/acl not honoured in rsync remote]]: why this does not work on encrypted remotes
diff --git a/doc/tips/using_gitolite_with_git-annex/comment_14_7d4d4515218d1259d32be3baeb5ee56e._comment b/doc/tips/using_gitolite_with_git-annex/comment_14_7d4d4515218d1259d32be3baeb5ee56e._comment
new file mode 100644
index 0000000000..048dfa6986
--- /dev/null
+++ b/doc/tips/using_gitolite_with_git-annex/comment_14_7d4d4515218d1259d32be3baeb5ee56e._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawkSbvo_NbY-ev1VKtzwo7nEqUmvRO6rXGA"
+ nickname="François"
+ subject="comment 14"
+ date="2013-09-22T18:30:45Z"
+ content="""
+@khaije
+
+Could you paste your config file? Here is mine: http://paste.debian.net/44856/
+I don't have any COMMANDS array. Could you elaborate your modifications please?
+
+Thanks.
+"""]]
diff --git a/doc/todo/redundancy_stats_in_status/comment_2_686ced0684d10511caf07953c64cd5b6._comment b/doc/todo/redundancy_stats_in_status/comment_2_686ced0684d10511caf07953c64cd5b6._comment
new file mode 100644
index 0000000000..a4711b2a3a
--- /dev/null
+++ b/doc/todo/redundancy_stats_in_status/comment_2_686ced0684d10511caf07953c64cd5b6._comment
@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="4.152.108.220"
+ subject="comment 2"
+ date="2013-09-25T18:03:55Z"
+ content="""
+`git annex status .` or otherwise running it with a directory has recently started walking all the location logs for all files in the directory in order to display variance from configured numcopies. It would be easy to add a redundancy counter to that.
+
+It would slow down the global status when not passed a directory to add redundancy info there. Maybe local is enough?
+"""]]
diff --git a/doc/todo/wishlist:_archive_from_remote_with_the_least_free_space/comment_2_21a249cedca1ceb80d10784004735524._comment b/doc/todo/wishlist:_archive_from_remote_with_the_least_free_space/comment_2_21a249cedca1ceb80d10784004735524._comment
new file mode 100644
index 0000000000..d2b29c2396
--- /dev/null
+++ b/doc/todo/wishlist:_archive_from_remote_with_the_least_free_space/comment_2_21a249cedca1ceb80d10784004735524._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawmOsy6nbvPyXLd--qqjPMLnVIzxgZwtKlQ"
+ nickname="Nicolas"
+ subject="comment 2"
+ date="2013-09-20T19:03:13Z"
+ content="""
+I was not thinking of removable drives, but only of \"client\" repositories. Ideally, git-annex would query the remaining space of all connected client repositories to choose on which repositories to drop a copy.
+"""]]
diff --git a/doc/todo/wishlist:_display_name_of_object_when_addWatcher_gets_a_permission_denied.mdwn b/doc/todo/wishlist:_display_name_of_object_when_addWatcher_gets_a_permission_denied.mdwn
index 004194a79a..837f0a587d 100644
--- a/doc/todo/wishlist:_display_name_of_object_when_addWatcher_gets_a_permission_denied.mdwn
+++ b/doc/todo/wishlist:_display_name_of_object_when_addWatcher_gets_a_permission_denied.mdwn
@@ -1 +1,6 @@
 When addWatcher gets a permission denied, it would be helpful to display the name of the object on which the permission was denied, in the error message which shows in the webapp.
+
+> I have made the inotify code more robust; now it doesn't crash if it
+> cannot read a directory or a file, and only logs a warning, which includes
+> the directory name.
+> [[done]] --[[Joey]] 
diff --git a/doc/todo/wishlist:_display_name_of_object_when_addWatcher_gets_a_permission_denied/comment_1_d2665e7347689b520d37561cfddf0aa8._comment b/doc/todo/wishlist:_display_name_of_object_when_addWatcher_gets_a_permission_denied/comment_1_d2665e7347689b520d37561cfddf0aa8._comment
new file mode 100644
index 0000000000..de0528855e
--- /dev/null
+++ b/doc/todo/wishlist:_display_name_of_object_when_addWatcher_gets_a_permission_denied/comment_1_d2665e7347689b520d37561cfddf0aa8._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="4.152.108.220"
+ subject="comment 1"
+ date="2013-09-25T18:47:13Z"
+ content="""
+This is an exception from the inotify library, which is what contains the `addWatch` function. I catch and display the exception. Since `addWatch` is only passed a directory to watch, the most I could do is tack on the name of the directory when displaying the exception. That does not seem likely to be much help?
+"""]]
diff --git a/doc/todo/wishlist:_display_name_of_object_when_addWatcher_gets_a_permission_denied/comment_2_db153571a32fb072453ed583e3e9ccf4._comment b/doc/todo/wishlist:_display_name_of_object_when_addWatcher_gets_a_permission_denied/comment_2_db153571a32fb072453ed583e3e9ccf4._comment
new file mode 100644
index 0000000000..e0199a42d5
--- /dev/null
+++ b/doc/todo/wishlist:_display_name_of_object_when_addWatcher_gets_a_permission_denied/comment_2_db153571a32fb072453ed583e3e9ccf4._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawl-g0hYpGY11pBP_42lHh5GWTyFuB4UwH8"
+ nickname="Nicolas"
+ subject="comment 2"
+ date="2013-09-25T23:08:56Z"
+ content="""
+Well, of course it would not be as helpful as if the inotify exception would contain the name of the exact object on which it got a permission denied (would this be a valid wishlist request for inotify?), but I think that displaying the name of the directory would already be better than nothing.
+"""]]
diff --git a/doc/todo/wishlist:_use_hardlinks_for_local_clones.mdwn b/doc/todo/wishlist:_use_hardlinks_for_local_clones.mdwn
new file mode 100644
index 0000000000..4b06944222
--- /dev/null
+++ b/doc/todo/wishlist:_use_hardlinks_for_local_clones.mdwn
@@ -0,0 +1,9 @@
+as far as I know, if you `git clone` locally a git-annex enabled repository, it will not have all the files available. you would need to use `git annex get` and all files would be copied over, wasting a significant amount of space.
+
+`git-clone` has this `--local` flags which hardlinks objects in `.git/objects`, but also, maybe more interestingly, has a `--shared` option to simply tell git to look in another repo for objects. it seems to me git-annex could leverage those functionalities to avoid file duplication when using local repositories.
+
+this would be especially useful for [ikiwiki](http://ikiwiki.info/forum/ikiwiki_and_big_files).
+
+This is a [[wishlist]], but I would also welcome implementation pointers to do this myself, thanks! --[[anarcat]]
+
+> [[dup|done]]
diff --git a/doc/todo/wishlist:_use_hardlinks_for_local_clones/comment_1_85064fafe472a5bd395d60ce8f7acb56._comment b/doc/todo/wishlist:_use_hardlinks_for_local_clones/comment_1_85064fafe472a5bd395d60ce8f7acb56._comment
new file mode 100644
index 0000000000..4ef5f8414e
--- /dev/null
+++ b/doc/todo/wishlist:_use_hardlinks_for_local_clones/comment_1_85064fafe472a5bd395d60ce8f7acb56._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="4.152.108.220"
+ subject="comment 1"
+ date="2013-09-25T17:14:28Z"
+ content="""
+git-annex uses cp --reflink=auto. So on a filesystem supporting COW file copies, like btrfs, `git annex get` will not use any disk space when getting from the same filesystem.
+
+I do not like the idea of using hardlinks, because changing the file in one repository would change it in the other, which may not be desired.
+
+[[union_mounting]] seems to cover this item pretty well, so I will close this as a duplicate.
+"""]]
diff --git a/doc/upgrades/gcrypt.mdwn b/doc/upgrades/gcrypt.mdwn
new file mode 100644
index 0000000000..65f80f86e0
--- /dev/null
+++ b/doc/upgrades/gcrypt.mdwn
@@ -0,0 +1,25 @@
+Unfortunately the initial gcrypt repository layout had to be changed
+after git-annex version 4.20130920. If you have an encrypted git repository
+created using version 4.20130920 or 4.20130909, you need to manually
+upgrade it.
+
+If you look at the contents of your gcrypt repository, you will
+see a bare git repository, with a few three-letter subdirectories,
+which are where git-annex stores its encrypted file contents:
+
+
    +27f/  branches/  description  hooks/  objects/
+HEAD  config     f37/         info/   refs/
+
    
+
+In the example above, the subdirectories are `27f` and `f37`.
+
+All you need to do to transition is move those subdirectories
+into an `annex/objects` directory.
+
+	mkdir annex ; mkdir annex/objects ; mv 27f f37 annex/objects
+
+Probably those are the only 3 letter things inside your git repository,
+so this will probably work:
+
+	mkdir annex ; mkdir annex/objects ; mv ??? annex/objects
diff --git a/doc/upgrades/gcrypt/comment_1_606c1527735996ae671f78948e4ad84b._comment b/doc/upgrades/gcrypt/comment_1_606c1527735996ae671f78948e4ad84b._comment
new file mode 100644
index 0000000000..8805f4a8d3
--- /dev/null
+++ b/doc/upgrades/gcrypt/comment_1_606c1527735996ae671f78948e4ad84b._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawmj3kEGlCiy_Y-wb6AIBBnJ0B_SiPHV5Bo"
+ nickname="Thomas"
+ subject="small omission"
+ date="2013-09-25T04:59:03Z"
+ content="""
+In your second example, `mv ??? annex` has to be `mv ??? annex/objects`, I think.
+"""]]
diff --git a/doc/use_case/Bob.mdwn b/doc/use_case/Bob.mdwn
index 42d10ea975..7a90cdd119 100644
--- a/doc/use_case/Bob.mdwn
+++ b/doc/use_case/Bob.mdwn
@@ -1,7 +1,7 @@
 ### use case: The Archivist
 
-Bob has many drives to archive his data, most of them kept offline, in a
-safe place.
+Bob has many drives to archive his data, most of them 
+[[kept offline|tips/offline_archive_drives]], in a safe place.
 
 With git-annex, Bob has a single directory tree that includes all
 his files, even if their content is being stored offline. He can
diff --git a/doc/users/anarcat.mdwn b/doc/users/anarcat.mdwn
index e8a1d7f002..c7054ff198 100644
--- a/doc/users/anarcat.mdwn
+++ b/doc/users/anarcat.mdwn
@@ -1,4 +1,4 @@
-Miaou.
+I use git-annex to manage huge files, mostly video and audio attached to other git repositories (such as presentations), but I also use git-annex to manage my music collection across multiple devices. I also use it to manage the `ISO` images I download, podcasts, and youtube videos.
 
 See .
 
diff --git a/doc/users/chrysn.mdwn b/doc/users/chrysn.mdwn
index f5c07b88b3..ba42615678 100644
--- a/doc/users/chrysn.mdwn
+++ b/doc/users/chrysn.mdwn
@@ -1,5 +1,11 @@
 * **name**: chrysn
 * **website**: 
-* **uses git-annex for**: managing the family's photos (and possibly videos and music in the future)
-* **likes git-annex because**: it adds a layer of commit semantics over a regular file system without keeping everything in duplicate locally
-* **would like git-annex to**: not be required any more as git itself learns to use cow filesystems to avoid abundant disk usage and gets better with sparser checkouts (git-annex might then still be a simpler tool that watches over what can be safely dropped for a sparser checkout)
+* **uses git-annex for** managing the family's photos (and possibly videos and music in the future).
+* **likes git-annex because** it adds a layer of commit semantics over a regular file system without keeping everything in duplicate locally.
+* **would like git-annex not to** be required any more at all when
+  * git itself learns to use cow filesystems to avoid abundant disk usage, and
+  * git gets better with shallow clones.
+
+    git-annex might then still be a simpler tool that watches over what can be safely dropped from a particular shallow clone
+
+    (the issues with shallow clones seem to relate primarily to shallow history; i haven't read anything about what would happen if all commits were checked out, but not all trees and blobs)
diff --git a/git-annex.cabal b/git-annex.cabal
index 136b6de4f7..969f91d458 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -1,5 +1,5 @@
 Name: git-annex
-Version: 4.20130920
+Version: 4.20131002
 Cabal-Version: >= 1.8
 License: GPL-3
 Maintainer: Joey Hess 
@@ -76,7 +76,7 @@ Executable git-annex
   Build-Depends: MissingH, hslogger, directory, filepath,
    containers, utf8-string, network (>= 2.0), mtl (>= 2),
    bytestring, old-locale, time, HTTP,
-   extensible-exceptions, dataenc, SHA, process, json,
+   extensible-exceptions, dataenc, SHA, cryptohash, process, json,
    base (>= 4.5 && < 4.8), monad-control, MonadCatchIO-transformers,
    IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process,
    SafeSemaphore, uuid, random, dlist, unix-compat
@@ -134,8 +134,12 @@ Executable git-annex
         CPP-Options: -DWITH_FSEVENTS
       else
         if (! os(windows) && ! os(solaris) && ! os(linux))
-          CPP-Options: -DWITH_KQUEUE
-          C-Sources: Utility/libkqueue.c
+          if flag(Android)
+            Build-Depends: hinotify
+            CPP-Options: -DWITH_INOTIFY
+          else
+            CPP-Options: -DWITH_KQUEUE
+            C-Sources: Utility/libkqueue.c
 
   if os(linux) && flag(Dbus)
     Build-Depends: dbus (>= 0.10.3)
diff --git a/standalone/android/Makefile b/standalone/android/Makefile
index 39b8df0546..4d15bc38b7 100644
--- a/standalone/android/Makefile
+++ b/standalone/android/Makefile
@@ -2,22 +2,21 @@
 # and builds the Android app.
 
 # Add Android cross-compiler to PATH (as installed by ghc-android)
-# (This directory also needs to have a cc that is a symlink to the prefixed
-# gcc cross-compiler executable.)
 ANDROID_CROSS_COMPILER?=$(HOME)/.ghc/android-14/arm-linux-androideabi-4.7/bin
 PATH:=$(ANDROID_CROSS_COMPILER):$(PATH)
 
 # Paths to the Android SDK and NDK.
-export ANDROID_SDK_ROOT?=$(HOME)/tmp/adt-bundle-linux-x86/sdk
-export ANDROID_NDK_ROOT?=$(HOME)/tmp/android-ndk-r8d
+export ANDROID_SDK_ROOT?=$(HOME)/.android/adt-bundle-linux-x86/sdk
+export ANDROID_NDK_ROOT?=$(HOME)/.android/android-ndk
 
 # Where to store the source tree used to build utilities. This
 # directory will be created by `make source`.
-GIT_ANNEX_ANDROID_SOURCETREE?=$(HOME)/tmp/android-sourcetree
+GIT_ANNEX_ANDROID_SOURCETREE?=$(HOME)/.android/git-annex-sourcetree
 
 GITTREE=$(GIT_ANNEX_ANDROID_SOURCETREE)/git/installed-tree
 
 build: start
+	if [ ! -e "$(GIT_ANNEX_ANDROID_SOURCETREE)" ]; then $(MAKE) source; fi
 	$(MAKE) $(GIT_ANNEX_ANDROID_SOURCETREE)/openssl/build-stamp
 	$(MAKE) $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh/build-stamp
 	$(MAKE) $(GIT_ANNEX_ANDROID_SOURCETREE)/busybox/build-stamp
@@ -85,7 +84,9 @@ $(GIT_ANNEX_ANDROID_SOURCETREE)/openssl/build-stamp:
 	touch $@
 
 $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh/build-stamp: openssh.patch openssh.config.h
-	cd $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh && git reset --hard
+	# This is a known-good version that the patch works with.
+	# TODO: Upgrade
+	cd $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh && git reset --hard 0a8617ed5af2f0248d0e9648e26b224e16ada742
 	cd $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh && ./configure --host=arm-linux-androideabi --with-ssl-dir=../openssl --without-openssl-header-check
 	cat openssh.patch | (cd $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh && patch -p1)
 	cp openssh.config.h $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh/config.h
@@ -105,7 +106,8 @@ $(GIT_ANNEX_ANDROID_SOURCETREE)/git/build-stamp:
 	touch $@
 
 $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync/build-stamp: rsync.patch
-	cat rsync.patch | (cd $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync && git reset --hard origin/master && git am)
+	# This is a known-good version that the patch works with.
+	cat rsync.patch | (cd $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync && git reset --hard eec26089b1c7bdbb260674480ffe6ece257bca63 && git am)
 	cp $(GIT_ANNEX_ANDROID_SOURCETREE)/automake/lib/config.sub $(GIT_ANNEX_ANDROID_SOURCETREE)/automake/lib/config.guess $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync/
 	cd $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync && ./configure --host=arm-linux-androideabi --disable-locale --disable-iconv-open --disable-iconv --disable-acl-support --disable-xattr-support
 	cd $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync && $(MAKE)
@@ -119,7 +121,8 @@ $(GIT_ANNEX_ANDROID_SOURCETREE)/gnupg/build-stamp:
 	touch $@
 
 $(GIT_ANNEX_ANDROID_SOURCETREE)/term/build-stamp: term.patch icons
-	cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term && git reset --hard
+	# This is a known-good version that the patch works with.
+	cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term && git reset --hard 3d34b3c42295c215b62e70f3ee696dd664ba08ce
 	cat term.patch | (cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term && patch -p1)
 	(cd icons && tar c .) | (cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term/res && tar x)
 	# This renaming has a purpose. It makes the path to the app's
@@ -129,21 +132,21 @@ $(GIT_ANNEX_ANDROID_SOURCETREE)/term/build-stamp: term.patch icons
 	# app, if it's also installed.
 	cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term && find -name .git -prune -o -type f -print0 | xargs -0 perl -pi -e 's/jackpal/ga/g'
 	cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term && perl -pi -e 's/Terminal Emulator/Git Annex/g' res/*/strings.xml
-	cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term && tools/update.sh >/dev/null 2>&1
+	cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term && echo y | tools/update.sh
 	touch $@
 
 source: $(GIT_ANNEX_ANDROID_SOURCETREE)
 
 $(GIT_ANNEX_ANDROID_SOURCETREE):
 	mkdir -p $(GIT_ANNEX_ANDROID_SOURCETREE)
-	git clone --bare git://git.savannah.gnu.org/automake.git $(GIT_ANNEX_ANDROID_SOURCETREE)/automake
-	git clone --bare git://git.debian.org/git/d-i/busybox $(GIT_ANNEX_ANDROID_SOURCETREE)/busybox
-	git clone --bare git://git.kernel.org/pub/scm/git/git.git $(GIT_ANNEX_ANDROID_SOURCETREE)/git
-	git clone --bare git://git.samba.org/rsync.git $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync
-	git clone --bare git://git.gnupg.org/gnupg.git $(GIT_ANNEX_ANDROID_SOURCETREE)/gnupg
-	git clone --bare git://git.openssl.org/openssl $(GIT_ANNEX_ANDROID_SOURCETREE)/openssl
-	git clone --bare git://github.com/CyanogenMod/android_external_openssh.git $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh
-	git clone --bare git://github.com/jackpal/Android-Terminal-Emulator.git $(GIT_ANNEX_ANDROID_SOURCETREE)/term
+	git clone git://git.savannah.gnu.org/automake.git $(GIT_ANNEX_ANDROID_SOURCETREE)/automake
+	git clone git://git.debian.org/git/d-i/busybox $(GIT_ANNEX_ANDROID_SOURCETREE)/busybox
+	git clone git://git.kernel.org/pub/scm/git/git.git $(GIT_ANNEX_ANDROID_SOURCETREE)/git
+	git clone git://git.samba.org/rsync.git $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync
+	git clone git://git.gnupg.org/gnupg.git $(GIT_ANNEX_ANDROID_SOURCETREE)/gnupg
+	git clone git://git.openssl.org/openssl $(GIT_ANNEX_ANDROID_SOURCETREE)/openssl
+	git clone git://github.com/CyanogenMod/android_external_openssh.git $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh
+	git clone git://github.com/jackpal/Android-Terminal-Emulator.git $(GIT_ANNEX_ANDROID_SOURCETREE)/term
 
 clean:
 	rm -rf $(GITTREE)
diff --git a/standalone/android/buildchroot b/standalone/android/buildchroot
new file mode 100755
index 0000000000..b759ae6ce0
--- /dev/null
+++ b/standalone/android/buildchroot
@@ -0,0 +1,26 @@
+#!/bin/sh
+set -e
+if [ "$(whoami)" != root ]; then
+	echo "Must run this as root!" >&2
+	exit 1
+fi
+
+debootstrap --arch=i386 stable debian-stable-android
+cp $0-inchroot debian-stable-android/tmp
+cp $0-inchroot-asuser debian-stable-android/tmp
+
+# Don't use these vars in the chroot.
+unset TMP
+unset TEMP
+unset TMPDIR
+unset TEMPDIR
+
+chroot debian-stable-android "tmp/$(basename $0)-inchroot"
+
+echo
+echo
+echo "debian-stable-android is set up, with a user androidbuilder"
+echo "your next step is probably to check out git-annex in this chroot"
+echo "and run standalone/android/install-haskell-packages"
+echo
+echo
diff --git a/standalone/android/buildchroot-inchroot b/standalone/android/buildchroot-inchroot
new file mode 100755
index 0000000000..1229f5b168
--- /dev/null
+++ b/standalone/android/buildchroot-inchroot
@@ -0,0 +1,25 @@
+#!/bin/sh
+# Runs inside the chroot set up by buildchroot
+set -e
+if [ "$(whoami)" != root ]; then
+	echo "Must run this as root!" >&2
+	exit 1
+fi
+
+# java needs this mounted to work
+mount -t proc proc /proc
+
+echo "deb-src http://ftp.us.debian.org/debian stable main" >> /etc/apt/sources.list
+apt-get update
+apt-get -y install build-essential ghc git libncurses5-dev cabal-install
+apt-get -y install llvm-3.0 # not 3.1; buggy on arm. 3.2 is ok too
+apt-get -y install ca-certificates curl file m4 autoconf zlib1g-dev
+apt-get -y install libgnutls-dev libxml2-dev libgsasl7-dev pkg-config c2hs
+apt-get -y install ant default-jdk rsync wget gnupg lsof
+apt-get -y install gettext unzip
+apt-get clean
+wget http://snapshot.debian.org/archive/debian/20130903T155330Z/pool/main/a/automake-1.14/automake_1.14-1_all.deb
+dpkg -i automake*.deb
+rm *.deb
+useradd androidbuilder --create-home
+su androidbuilder -c $0-asuser
diff --git a/standalone/android/buildchroot-inchroot-asuser b/standalone/android/buildchroot-inchroot-asuser
new file mode 100755
index 0000000000..2cd77b6b7c
--- /dev/null
+++ b/standalone/android/buildchroot-inchroot-asuser
@@ -0,0 +1,39 @@
+#!/bin/sh
+# Runs inside the chroot set up by buildchroot, as the user it creates
+set -e
+
+cd
+rm -rf .ghc .cabal
+cabal update
+cabal install happy alex --bindir=$HOME/bin
+PATH=$HOME/bin:$PATH
+export PATH
+mkdir -p .android
+cd .android
+git clone https://github.com/joeyh/ghc-android
+cd ghc-android
+git checkout stable-ghc-snapshot
+./build
+
+# This saves 2 gb, and the same sources are in build-*/ghc
+rm -rf stage0
+
+# Set up android SDK where the git-annex android Makefile
+# expects to find it.
+cd ..
+ln -s ghc-android/android-ndk-* android-ndk
+wget http://dl.google.com/android/adt/adt-bundle-linux-x86-20130917.zip
+unzip adt*.zip
+rm adt*.zip
+mv adt-bundle-linux-x86-* adt-bundle-linux-x86
+rm -rf adt-bundle-linux-x86/eclipse
+
+# The git-annex android Makefile needs this cc symlink.
+ln -s arm-linux-androideabi-gcc \
+	$HOME/.ghc/android-14/arm-linux-androideabi-4.7/bin/cc
+
+cd
+git clone git://git-annex.branchable.com/ git-annex
+
+git config --global user.email androidbuilder@example.com
+git config --global user.name androidbuilder
diff --git a/standalone/android/clean-haskell-packages b/standalone/android/clean-haskell-packages
new file mode 100755
index 0000000000..bffdf00bba
--- /dev/null
+++ b/standalone/android/clean-haskell-packages
@@ -0,0 +1,6 @@
+#!/bin/sh
+# Removes all currently installed cross-compiled haskell packages
+# except those part of ghc.
+# Useful if the build failed.
+rm -f $(grep -l $HOME/.ghc/android-14/arm-linux-androideabi-4.7/.cabal/lib/ $HOME/.ghc/android-14/arm-linux-androideabi-4.7/lib/*-ghc-*/package.conf.d/*.conf)
+$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/bin/ghc-pkg recache
diff --git a/standalone/android/evilsplicer-headers.hs b/standalone/android/evilsplicer-headers.hs
index 35a20a001b..ee4d6f1a37 100644
--- a/standalone/android/evilsplicer-headers.hs
+++ b/standalone/android/evilsplicer-headers.hs
@@ -6,6 +6,7 @@
  - ** DO NOT COMMIT ** 
  -}
 import qualified Data.Monoid
+import qualified Data.Set
 import qualified Data.Map
 import qualified Data.Map as Data.Map.Base
 import qualified Data.Foldable
@@ -16,12 +17,16 @@ import qualified Text.Hamlet
 import qualified Text.Julius
 import qualified Text.Css
 import qualified "blaze-markup" Text.Blaze.Internal
-import qualified Yesod.Widget
+import qualified Yesod.Core.Widget
 import qualified Yesod.Routes.TH.Types
 import qualified Yesod.Routes.Dispatch
 import qualified WaiAppStatic.Storage.Embedded
+import qualified WaiAppStatic.Storage.Embedded.Runtime
 import qualified Data.FileEmbed
 import qualified Data.ByteString.Internal
+import qualified Data.Text.Encoding
+import qualified Network.Wai
+import qualified Yesod.Core.Types
 {- End EvilSplicer headers. -}
 
 
diff --git a/standalone/android/haskell-patches/DAV_0.3-0001-build-without-TH.patch b/standalone/android/haskell-patches/DAV_0.3-0001-build-without-TH.patch
deleted file mode 100644
index 3fbf764c2d..0000000000
--- a/standalone/android/haskell-patches/DAV_0.3-0001-build-without-TH.patch
+++ /dev/null
@@ -1,306 +0,0 @@
-From d195f807dac2351d29aeff00d2aee3e151eb82e3 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 18 Apr 2013 19:37:28 -0400
-Subject: [PATCH] build without TH
-
-Used the EvilSplicer to expand the TH
-
-Left off CmdArgs to save time.
----
- DAV.cabal                       |   20 +----
- Network/Protocol/HTTP/DAV.hs    |   53 ++++++++++---
- Network/Protocol/HTTP/DAV/TH.hs |  167 ++++++++++++++++++++++++++++++++++++++-
- 3 files changed, 207 insertions(+), 33 deletions(-)
-
-diff --git a/DAV.cabal b/DAV.cabal
-index 774d4e5..8b85133 100644
---- a/DAV.cabal
-+++ b/DAV.cabal
-@@ -38,25 +38,7 @@ library
-                      , transformers >= 0.3
-                      , xml-conduit >= 1.0          && <= 1.1
-                      , xml-hamlet >= 0.4           && <= 0.5
--executable hdav
--  main-is:           hdav.hs
--  ghc-options:       -Wall
--  build-depends:       base >= 4.5                 && <= 5
--                     , bytestring
--                     , bytestring
--                     , case-insensitive >= 0.4
--                     , cmdargs >= 0.9
--                     , containers
--                     , http-conduit >= 1.4
--                     , http-types >= 0.7
--                     , lens >= 3.0
--                     , lifted-base >= 0.1
--                     , mtl >= 2.1
--                     , network >= 2.3
--                     , resourcet >= 0.3
--                     , transformers >= 0.3
--                     , xml-conduit >= 1.0          && <= 1.1
--                     , xml-hamlet >= 0.4           && <= 0.5
-+                     , text
- 
- source-repository head
-   type:     git
-diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs
-index 02e5d15..c0be362 100644
---- a/Network/Protocol/HTTP/DAV.hs
-+++ b/Network/Protocol/HTTP/DAV.hs
-@@ -52,7 +52,8 @@ import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, unautho
- 
- import qualified Text.XML as XML
- import Text.XML.Cursor (($/), (&/), element, node, fromDocument, checkName)
--import Text.Hamlet.XML (xml)
-+import Text.Hamlet.XML
-+import qualified Data.Text
- 
- import Data.CaseInsensitive (mk)
- 
-@@ -246,18 +247,48 @@ makeCollection url username password = withDS url username password $
- propname :: XML.Document
- propname = XML.Document (XML.Prologue [] Nothing []) root []
-     where
--        root = XML.Element "D:propfind" (Map.fromList [("xmlns:D", "DAV:")]) [xml|
--
--|]
-+        root = XML.Element "D:propfind" (Map.fromList [("xmlns:D", "DAV:")])  $         concat
-+          [[XML.NodeElement
-+              (XML.Element
-+                 (XML.Name
-+                    (Data.Text.pack "D:allprop") Nothing Nothing)
-+                 Map.empty
-+                 (concat []))]]
-+
- 
- locky :: XML.Document
- locky = XML.Document (XML.Prologue [] Nothing []) root []
-     where
--        root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")]) [xml|
--
--  
--
--  
--Haskell DAV user
--|]
-+        root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")])  $         concat
-+          [[XML.NodeElement
-+              (XML.Element
-+                 (XML.Name
-+                    (Data.Text.pack "D:lockscope") Nothing Nothing)
-+                 Map.empty
-+                 (concat
-+                    [[XML.NodeElement
-+                        (XML.Element
-+                           (XML.Name
-+                              (Data.Text.pack "D:exclusive") Nothing Nothing)
-+                           Map.empty
-+                           (concat []))]]))],
-+           [XML.NodeElement
-+              (XML.Element
-+                 (XML.Name
-+                    (Data.Text.pack "D:locktype") Nothing Nothing)
-+                 Map.empty
-+                 (concat
-+                    [[XML.NodeElement
-+                        (XML.Element
-+                           (XML.Name (Data.Text.pack "D:write") Nothing Nothing)
-+                           Map.empty
-+                           (concat []))]]))],
-+           [XML.NodeElement
-+              (XML.Element
-+                 (XML.Name (Data.Text.pack "D:owner") Nothing Nothing)
-+                 Map.empty
-+                 (concat
-+                    [[XML.NodeContent
-+                        (Data.Text.pack "Haskell DAV user")]]))]]
-+
- 
-diff --git a/Network/Protocol/HTTP/DAV/TH.hs b/Network/Protocol/HTTP/DAV/TH.hs
-index 036a2bc..4d3c0f4 100644
---- a/Network/Protocol/HTTP/DAV/TH.hs
-+++ b/Network/Protocol/HTTP/DAV/TH.hs
-@@ -16,11 +16,13 @@
- -- You should have received a copy of the GNU General Public License
- -- along with this program.  If not, see .
- 
--{-# LANGUAGE TemplateHaskell #-}
-+{-# LANGUAGE RankNTypes  #-}
- 
- module Network.Protocol.HTTP.DAV.TH where
- 
--import Control.Lens (makeLenses)
-+import Control.Lens
-+import qualified Control.Lens.Type
-+import qualified Data.Functor
- import qualified Data.ByteString as B
- import Network.HTTP.Conduit (Manager, Request)
- 
-@@ -33,4 +35,163 @@ data DAVContext a = DAVContext {
-   , _basicusername :: B.ByteString
-   , _basicpassword :: B.ByteString
- }
--makeLenses ''DAVContext
-+allowedMethods ::
-+  forall a_a4Oo.
-+  Control.Lens.Type.Lens' (DAVContext a_a4Oo) [B.ByteString]
-+allowedMethods
-+  _f_a5tt
-+  (DAVContext __allowedMethods'_a5tu
-+              __baseRequest_a5tw
-+              __complianceClasses_a5tx
-+              __httpManager_a5ty
-+              __lockToken_a5tz
-+              __basicusername_a5tA
-+              __basicpassword_a5tB)
-+  = ((\ __allowedMethods_a5tv
-+        -> DAVContext
-+             __allowedMethods_a5tv
-+             __baseRequest_a5tw
-+             __complianceClasses_a5tx
-+             __httpManager_a5ty
-+             __lockToken_a5tz
-+             __basicusername_a5tA
-+             __basicpassword_a5tB)
-+     Data.Functor.<$> (_f_a5tt __allowedMethods'_a5tu))
-+{-# INLINE allowedMethods #-}
-+baseRequest ::
-+  forall a_a4Oo a_a5tC.
-+  Control.Lens.Type.Lens (DAVContext a_a4Oo) (DAVContext a_a5tC) (Request a_a4Oo) (Request a_a5tC)
-+baseRequest
-+  _f_a5tD
-+  (DAVContext __allowedMethods_a5tE
-+              __baseRequest'_a5tF
-+              __complianceClasses_a5tH
-+              __httpManager_a5tI
-+              __lockToken_a5tJ
-+              __basicusername_a5tK
-+              __basicpassword_a5tL)
-+  = ((\ __baseRequest_a5tG
-+        -> DAVContext
-+             __allowedMethods_a5tE
-+             __baseRequest_a5tG
-+             __complianceClasses_a5tH
-+             __httpManager_a5tI
-+             __lockToken_a5tJ
-+             __basicusername_a5tK
-+             __basicpassword_a5tL)
-+     Data.Functor.<$> (_f_a5tD __baseRequest'_a5tF))
-+{-# INLINE baseRequest #-}
-+basicpassword ::
-+  forall a_a4Oo.
-+  Control.Lens.Type.Lens' (DAVContext a_a4Oo) B.ByteString
-+basicpassword
-+  _f_a5tM
-+  (DAVContext __allowedMethods_a5tN
-+              __baseRequest_a5tO
-+              __complianceClasses_a5tP
-+              __httpManager_a5tQ
-+              __lockToken_a5tR
-+              __basicusername_a5tS
-+              __basicpassword'_a5tT)
-+  = ((\ __basicpassword_a5tU
-+        -> DAVContext
-+             __allowedMethods_a5tN
-+             __baseRequest_a5tO
-+             __complianceClasses_a5tP
-+             __httpManager_a5tQ
-+             __lockToken_a5tR
-+             __basicusername_a5tS
-+             __basicpassword_a5tU)
-+     Data.Functor.<$> (_f_a5tM __basicpassword'_a5tT))
-+{-# INLINE basicpassword #-}
-+basicusername ::
-+  forall a_a4Oo.
-+  Control.Lens.Type.Lens' (DAVContext a_a4Oo) B.ByteString
-+basicusername
-+  _f_a5tV
-+  (DAVContext __allowedMethods_a5tW
-+              __baseRequest_a5tX
-+              __complianceClasses_a5tY
-+              __httpManager_a5tZ
-+              __lockToken_a5u0
-+              __basicusername'_a5u1
-+              __basicpassword_a5u3)
-+  = ((\ __basicusername_a5u2
-+        -> DAVContext
-+             __allowedMethods_a5tW
-+             __baseRequest_a5tX
-+             __complianceClasses_a5tY
-+             __httpManager_a5tZ
-+             __lockToken_a5u0
-+             __basicusername_a5u2
-+             __basicpassword_a5u3)
-+     Data.Functor.<$> (_f_a5tV __basicusername'_a5u1))
-+{-# INLINE basicusername #-}
-+complianceClasses ::
-+  forall a_a4Oo.
-+  Control.Lens.Type.Lens' (DAVContext a_a4Oo) [B.ByteString]
-+complianceClasses
-+  _f_a5u4
-+  (DAVContext __allowedMethods_a5u5
-+              __baseRequest_a5u6
-+              __complianceClasses'_a5u7
-+              __httpManager_a5u9
-+              __lockToken_a5ua
-+              __basicusername_a5ub
-+              __basicpassword_a5uc)
-+  = ((\ __complianceClasses_a5u8
-+        -> DAVContext
-+             __allowedMethods_a5u5
-+             __baseRequest_a5u6
-+             __complianceClasses_a5u8
-+             __httpManager_a5u9
-+             __lockToken_a5ua
-+             __basicusername_a5ub
-+             __basicpassword_a5uc)
-+     Data.Functor.<$> (_f_a5u4 __complianceClasses'_a5u7))
-+{-# INLINE complianceClasses #-}
-+httpManager ::
-+  forall a_a4Oo. Control.Lens.Type.Lens' (DAVContext a_a4Oo) Manager
-+httpManager
-+  _f_a5ud
-+  (DAVContext __allowedMethods_a5ue
-+              __baseRequest_a5uf
-+              __complianceClasses_a5ug
-+              __httpManager'_a5uh
-+              __lockToken_a5uj
-+              __basicusername_a5uk
-+              __basicpassword_a5ul)
-+  = ((\ __httpManager_a5ui
-+        -> DAVContext
-+             __allowedMethods_a5ue
-+             __baseRequest_a5uf
-+             __complianceClasses_a5ug
-+             __httpManager_a5ui
-+             __lockToken_a5uj
-+             __basicusername_a5uk
-+             __basicpassword_a5ul)
-+     Data.Functor.<$> (_f_a5ud __httpManager'_a5uh))
-+{-# INLINE httpManager #-}
-+lockToken ::
-+  forall a_a4Oo.
-+  Control.Lens.Type.Lens' (DAVContext a_a4Oo) (Maybe B.ByteString)
-+lockToken
-+  _f_a5um
-+  (DAVContext __allowedMethods_a5un
-+              __baseRequest_a5uo
-+              __complianceClasses_a5up
-+              __httpManager_a5uq
-+              __lockToken'_a5ur
-+              __basicusername_a5ut
-+              __basicpassword_a5uu)
-+  = ((\ __lockToken_a5us
-+        -> DAVContext
-+             __allowedMethods_a5un
-+             __baseRequest_a5uo
-+             __complianceClasses_a5up
-+             __httpManager_a5uq
-+             __lockToken_a5us
-+             __basicusername_a5ut
-+             __basicpassword_a5uu)
-+     Data.Functor.<$> (_f_a5um __lockToken'_a5ur))
-+{-# INLINE lockToken #-}
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/DAV_build-without-TH.patch b/standalone/android/haskell-patches/DAV_build-without-TH.patch
new file mode 100644
index 0000000000..b871fa9efe
--- /dev/null
+++ b/standalone/android/haskell-patches/DAV_build-without-TH.patch
@@ -0,0 +1,377 @@
+From 2b5fc33607720d0cccd7d8f9cb7232042ead73e6 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sun, 22 Sep 2013 00:36:56 +0000
+Subject: [PATCH] expand TH
+
+used the EvilSplicer
++ manual fix ups
+---
+ DAV.cabal                                  |   20 +--
+ Network/Protocol/HTTP/DAV.hs               |   73 ++++++-----
+ Network/Protocol/HTTP/DAV/TH.hs            |  196 +++++++++++++++++++++++++++-
+ dist/build/HSDAV-0.4.1.o                   |  Bin 140080 -> 0 bytes
+ dist/build/Network/Protocol/HTTP/DAV.hi    |  Bin 34549 -> 57657 bytes
+ dist/build/Network/Protocol/HTTP/DAV.o     |  Bin 160248 -> 201932 bytes
+ dist/build/Network/Protocol/HTTP/DAV/TH.hi |  Bin 17056 -> 18733 bytes
+ dist/build/Network/Protocol/HTTP/DAV/TH.o  |  Bin 19672 -> 28120 bytes
+ dist/build/autogen/Paths_DAV.hs            |   18 ++-
+ dist/build/autogen/cabal_macros.h          |   45 +++----
+ dist/build/libHSDAV-0.4.1.a                |  Bin 200082 -> 260188 bytes
+ dist/package.conf.inplace                  |    2 -
+ dist/setup-config                          |    2 -
+ 13 files changed, 266 insertions(+), 90 deletions(-)
+ delete mode 100644 dist/build/HSDAV-0.4.1.o
+ delete mode 100644 dist/package.conf.inplace
+ delete mode 100644 dist/setup-config
+
+diff --git a/DAV.cabal b/DAV.cabal
+index 06b3a8b..90368c6 100644
+--- a/DAV.cabal
++++ b/DAV.cabal
+@@ -38,25 +38,7 @@ library
+                      , transformers >= 0.3
+                      , xml-conduit >= 1.0          && <= 1.2
+                      , xml-hamlet >= 0.4           && <= 0.5
+-executable hdav
+-  main-is:           hdav.hs
+-  ghc-options:       -Wall
+-  build-depends:       base >= 4.5                 && <= 5
+-                     , bytestring
+-                     , bytestring
+-                     , case-insensitive >= 0.4
+-                     , containers
+-                     , http-conduit >= 1.9.0
+-                     , http-types >= 0.7
+-                     , lens >= 3.0
+-                     , lifted-base >= 0.1
+-                     , mtl >= 2.1
+-                     , network >= 2.3
+-                     , optparse-applicative
+-                     , resourcet >= 0.3
+-                     , transformers >= 0.3
+-                     , xml-conduit >= 1.0          && <= 1.2
+-                     , xml-hamlet >= 0.4           && <= 0.5
++                     , text
+ 
+ source-repository head
+   type:     git
+diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs
+index 8ffc270..d064a8f 100644
+--- a/Network/Protocol/HTTP/DAV.hs
++++ b/Network/Protocol/HTTP/DAV.hs
+@@ -28,12 +28,12 @@ module Network.Protocol.HTTP.DAV (
+   , deleteContent
+   , moveContent
+   , makeCollection
+-  , caldavReport
+   , module Network.Protocol.HTTP.DAV.TH
+ ) where
+ 
+ import Network.Protocol.HTTP.DAV.TH
+ 
++import qualified Data.Text
+ import Control.Applicative (liftA2)
+ import Control.Exception.Lifted (catchJust, finally, bracketOnError)
+ import Control.Lens ((.~), (^.))
+@@ -200,11 +200,6 @@ props2patch = XML.renderLBS XML.def . patch . props . fromDocument
+                    , "{DAV:}supportedlock"
+                    ]
+ 
+-caldavReportM :: MonadResourceBase m => DAVState m XML.Document
+-caldavReportM = do
+-    let ahs = [(hContentType, "application/xml; charset=\"utf-8\"")]
+-    calrresp <- davRequest "REPORT" ahs (xmlBody calendarquery)
+-    return $ (XML.parseLBS_ def . responseBody) calrresp
+ 
+ getProps :: String -> B.ByteString -> B.ByteString -> Maybe Depth -> IO XML.Document
+ getProps url username password md = withDS url username password md getPropsM
+@@ -246,9 +241,6 @@ moveContent :: String -> B.ByteString -> B.ByteString -> B.ByteString -> IO ()
+ moveContent url newurl username password = withDS url username password Nothing $
+     moveContentM newurl
+ 
+-caldavReport :: String -> B.ByteString -> B.ByteString -> IO XML.Document
+-caldavReport url username password = withDS url username password (Just Depth1) $ caldavReportM
+-
+ -- | Creates a WebDAV collection, which is similar to a directory.
+ --
+ -- Returns False if the collection could not be made due to an intermediate
+@@ -264,28 +256,45 @@ makeCollection url username password = withDS url username password Nothing $
+ propname :: XML.Document
+ propname = XML.Document (XML.Prologue [] Nothing []) root []
+     where
+-        root = XML.Element "D:propfind" (Map.fromList [("xmlns:D", "DAV:")]) [xml|
+-
+-|]
+-
++        root = XML.Element "D:propfind" (Map.fromList [("xmlns:D", "DAV:")])  $         concat
++          [[XML.NodeElement
++              (XML.Element
++                 (XML.Name
++                    (Data.Text.pack "D:allprop") Nothing Nothing)
++                 Map.empty
++                 (concat []))]]
+ locky :: XML.Document
+ locky = XML.Document (XML.Prologue [] Nothing []) root []
+-    where
+-        root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")]) [xml|
+-
+-  
+-
+-  
+-Haskell DAV user
+-|]
+-
+-calendarquery :: XML.Document
+-calendarquery = XML.Document (XML.Prologue [] Nothing []) root []
+-    where
+-        root = XML.Element "C:calendar-query" (Map.fromList [("xmlns:D", "DAV:"),("xmlns:C", "urn:ietf:params:xml:ns:caldav")]) [xml|
+-
+-  
+-  
+-
+-  
+-|]
++ where
++  root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")])  $ concat
++   [[XML.NodeElement
++       (XML.Element
++          (XML.Name
++             (Data.Text.pack "D:lockscope") Nothing Nothing)
++          Map.empty
++          (concat
++             [[XML.NodeElement
++                 (XML.Element
++                    (XML.Name
++                       (Data.Text.pack "D:exclusive") Nothing Nothing)
++                    Map.empty
++                    (concat []))]]))],
++    [XML.NodeElement
++       (XML.Element
++          (XML.Name
++             (Data.Text.pack "D:locktype") Nothing Nothing)
++          Map.empty
++          (concat
++             [[XML.NodeElement
++                 (XML.Element
++                    (XML.Name (Data.Text.pack "D:write") Nothing Nothing)
++                    Map.empty
++                    (concat []))]]))],
++    [XML.NodeElement
++       (XML.Element
++          (XML.Name (Data.Text.pack "D:owner") Nothing Nothing)
++          Map.empty
++          (concat
++             [[XML.NodeContent
++                 (Data.Text.pack "Haskell DAV user")]]))]]
++
+diff --git a/Network/Protocol/HTTP/DAV/TH.hs b/Network/Protocol/HTTP/DAV/TH.hs
+index 9fb3495..18b8df7 100644
+--- a/Network/Protocol/HTTP/DAV/TH.hs
++++ b/Network/Protocol/HTTP/DAV/TH.hs
+@@ -20,7 +20,8 @@
+ 
+ module Network.Protocol.HTTP.DAV.TH where
+ 
+-import Control.Lens (makeLenses)
++import qualified Control.Lens.Type
++import qualified Data.Functor
+ import qualified Data.ByteString as B
+ import Network.HTTP.Conduit (Manager, Request)
+ 
+@@ -46,4 +47,195 @@ data DAVContext a = DAVContext {
+   , _basicpassword :: B.ByteString
+   , _depth :: Maybe Depth
+ }
+-makeLenses ''DAVContext
++allowedMethods ::
++  Control.Lens.Type.Lens' (DAVContext a_a4I4) [B.ByteString]
++allowedMethods
++  _f_a5GM
++  (DAVContext __allowedMethods'_a5GN
++              __baseRequest_a5GP
++              __complianceClasses_a5GQ
++              __httpManager_a5GR
++              __lockToken_a5GS
++              __basicusername_a5GT
++              __basicpassword_a5GU
++              __depth_a5GV)
++  = ((\ __allowedMethods_a5GO
++        -> DAVContext
++             __allowedMethods_a5GO
++             __baseRequest_a5GP
++             __complianceClasses_a5GQ
++             __httpManager_a5GR
++             __lockToken_a5GS
++             __basicusername_a5GT
++             __basicpassword_a5GU
++             __depth_a5GV)
++     Data.Functor.<$> (_f_a5GM __allowedMethods'_a5GN))
++{-# INLINE allowedMethods #-}
++baseRequest ::
++  Control.Lens.Type.Lens (DAVContext a_a4I4) (DAVContext a_a5GW) (Request a_a4I4) (Request a_a5GW)
++baseRequest
++  _f_a5GX
++  (DAVContext __allowedMethods_a5GY
++              __baseRequest'_a5GZ
++              __complianceClasses_a5H1
++              __httpManager_a5H2
++              __lockToken_a5H3
++              __basicusername_a5H4
++              __basicpassword_a5H5
++              __depth_a5H6)
++  = ((\ __baseRequest_a5H0
++        -> DAVContext
++             __allowedMethods_a5GY
++             __baseRequest_a5H0
++             __complianceClasses_a5H1
++             __httpManager_a5H2
++             __lockToken_a5H3
++             __basicusername_a5H4
++             __basicpassword_a5H5
++             __depth_a5H6)
++     Data.Functor.<$> (_f_a5GX __baseRequest'_a5GZ))
++{-# INLINE baseRequest #-}
++basicpassword ::
++  Control.Lens.Type.Lens' (DAVContext a_a4I4) B.ByteString
++basicpassword
++  _f_a5H7
++  (DAVContext __allowedMethods_a5H8
++              __baseRequest_a5H9
++              __complianceClasses_a5Ha
++              __httpManager_a5Hb
++              __lockToken_a5Hc
++              __basicusername_a5Hd
++              __basicpassword'_a5He
++              __depth_a5Hg)
++  = ((\ __basicpassword_a5Hf
++        -> DAVContext
++             __allowedMethods_a5H8
++             __baseRequest_a5H9
++             __complianceClasses_a5Ha
++             __httpManager_a5Hb
++             __lockToken_a5Hc
++             __basicusername_a5Hd
++             __basicpassword_a5Hf
++             __depth_a5Hg)
++     Data.Functor.<$> (_f_a5H7 __basicpassword'_a5He))
++{-# INLINE basicpassword #-}
++basicusername ::
++  Control.Lens.Type.Lens' (DAVContext a_a4I4) B.ByteString
++basicusername
++  _f_a5Hh
++  (DAVContext __allowedMethods_a5Hi
++              __baseRequest_a5Hj
++              __complianceClasses_a5Hk
++              __httpManager_a5Hl
++              __lockToken_a5Hm
++              __basicusername'_a5Hn
++              __basicpassword_a5Hp
++              __depth_a5Hq)
++  = ((\ __basicusername_a5Ho
++        -> DAVContext
++             __allowedMethods_a5Hi
++             __baseRequest_a5Hj
++             __complianceClasses_a5Hk
++             __httpManager_a5Hl
++             __lockToken_a5Hm
++             __basicusername_a5Ho
++             __basicpassword_a5Hp
++             __depth_a5Hq)
++     Data.Functor.<$> (_f_a5Hh __basicusername'_a5Hn))
++{-# INLINE basicusername #-}
++complianceClasses ::
++  Control.Lens.Type.Lens' (DAVContext a_a4I4) [B.ByteString]
++complianceClasses
++  _f_a5Hr
++  (DAVContext __allowedMethods_a5Hs
++              __baseRequest_a5Ht
++              __complianceClasses'_a5Hu
++              __httpManager_a5Hw
++              __lockToken_a5Hx
++              __basicusername_a5Hy
++              __basicpassword_a5Hz
++              __depth_a5HA)
++  = ((\ __complianceClasses_a5Hv
++        -> DAVContext
++             __allowedMethods_a5Hs
++             __baseRequest_a5Ht
++             __complianceClasses_a5Hv
++             __httpManager_a5Hw
++             __lockToken_a5Hx
++             __basicusername_a5Hy
++             __basicpassword_a5Hz
++             __depth_a5HA)
++     Data.Functor.<$> (_f_a5Hr __complianceClasses'_a5Hu))
++{-# INLINE complianceClasses #-}
++depth ::
++  Control.Lens.Type.Lens' (DAVContext a_a4I4) (Maybe Depth)
++depth
++  _f_a5HB
++  (DAVContext __allowedMethods_a5HC
++              __baseRequest_a5HD
++              __complianceClasses_a5HE
++              __httpManager_a5HF
++              __lockToken_a5HG
++              __basicusername_a5HH
++              __basicpassword_a5HI
++              __depth'_a5HJ)
++  = ((\ __depth_a5HK
++        -> DAVContext
++             __allowedMethods_a5HC
++             __baseRequest_a5HD
++             __complianceClasses_a5HE
++             __httpManager_a5HF
++             __lockToken_a5HG
++             __basicusername_a5HH
++             __basicpassword_a5HI
++             __depth_a5HK)
++     Data.Functor.<$> (_f_a5HB __depth'_a5HJ))
++{-# INLINE depth #-}
++httpManager ::
++  Control.Lens.Type.Lens' (DAVContext a_a4I4) Manager
++httpManager
++  _f_a5HL
++  (DAVContext __allowedMethods_a5HM
++              __baseRequest_a5HN
++              __complianceClasses_a5HO
++              __httpManager'_a5HP
++              __lockToken_a5HR
++              __basicusername_a5HS
++              __basicpassword_a5HT
++              __depth_a5HU)
++  = ((\ __httpManager_a5HQ
++        -> DAVContext
++             __allowedMethods_a5HM
++             __baseRequest_a5HN
++             __complianceClasses_a5HO
++             __httpManager_a5HQ
++             __lockToken_a5HR
++             __basicusername_a5HS
++             __basicpassword_a5HT
++             __depth_a5HU)
++     Data.Functor.<$> (_f_a5HL __httpManager'_a5HP))
++{-# INLINE httpManager #-}
++lockToken ::
++  Control.Lens.Type.Lens' (DAVContext a_a4I4) (Maybe B.ByteString)
++lockToken
++  _f_a5HV
++  (DAVContext __allowedMethods_a5HW
++              __baseRequest_a5HX
++              __complianceClasses_a5HY
++              __httpManager_a5HZ
++              __lockToken'_a5I0
++              __basicusername_a5I2
++              __basicpassword_a5I3
++              __depth_a5I4)
++  = ((\ __lockToken_a5I1
++        -> DAVContext
++             __allowedMethods_a5HW
++             __baseRequest_a5HX
++             __complianceClasses_a5HY
++             __httpManager_a5HZ
++             __lockToken_a5I1
++             __basicusername_a5I2
++             __basicpassword_a5I3
++             __depth_a5I4)
++     Data.Functor.<$> (_f_a5HV __lockToken'_a5I0))
++{-# INLINE lockToken #-}
diff --git a/standalone/android/haskell-patches/HTTP_4000.2.8-0001-build-with-base-4.8.patch b/standalone/android/haskell-patches/HTTP_4000.2.8-0001-build-with-base-4.8.patch
index 3114653f2a..dfcdc387f1 100644
--- a/standalone/android/haskell-patches/HTTP_4000.2.8-0001-build-with-base-4.8.patch
+++ b/standalone/android/haskell-patches/HTTP_4000.2.8-0001-build-with-base-4.8.patch
@@ -1,31 +1,25 @@
-From 32d0741c64e6bd280e46f7c452db9462fbac05f9 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Tue, 7 May 2013 18:21:04 -0400
-Subject: [PATCH] fix build
+From 5c57c4ae7dac0c1aa940005f5ea55fdcd4fcd1f5 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sat, 21 Sep 2013 22:46:42 +0000
+Subject: [PATCH] fix build with new base
 
 ---
- HTTP.cabal |    4 ++--
- 1 file changed, 2 insertions(+), 2 deletions(-)
+ HTTP.cabal |    2 +-
+ 1 file changed, 1 insertion(+), 1 deletion(-)
 
 diff --git a/HTTP.cabal b/HTTP.cabal
-index 76cb5d6..edddf26 100644
+index 76cb5d6..bb38f24 100644
 --- a/HTTP.cabal
 +++ b/HTTP.cabal
-@@ -85,12 +85,12 @@ Library
+@@ -85,7 +85,7 @@ Library
                   Network.HTTP.Utils
                   Paths_HTTP
    GHC-options: -fwarn-missing-signatures -Wall
 -  Build-depends: base >= 2 && < 4.7, network < 2.5, parsec
-+  Build-depends: base >= 2 && < 4.8, network < 2.5, parsec
++  Build-depends: base >= 2 && < 4.9, network < 2.5, parsec
    Extensions: FlexibleInstances
    if flag(old-base)
      Build-depends: base < 3
-   else
--    Build-depends: base >= 3, array, old-time, bytestring
-+    Build-depends: base >= 3, array, old-time, bytestring (>= 0.10.3.0)
- 
-   if flag(mtl1)
-     Build-depends: mtl >= 1.1 && < 1.2
 -- 
 1.7.10.4
 
diff --git a/standalone/android/haskell-patches/MonadCatchIO-transformers_hack-to-get-to-build-with-new-ghc.patch b/standalone/android/haskell-patches/MonadCatchIO-transformers_hack-to-get-to-build-with-new-ghc.patch
new file mode 100644
index 0000000000..9881d35d6e
--- /dev/null
+++ b/standalone/android/haskell-patches/MonadCatchIO-transformers_hack-to-get-to-build-with-new-ghc.patch
@@ -0,0 +1,56 @@
+From 083c9d135ec68316db173235994c63603ad76444 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sat, 21 Sep 2013 23:01:35 +0000
+Subject: [PATCH] hack to get to build with new ghc
+
+Copied the old implemenations of block and unblock from old Control.Exception
+since these deprecated functions have now been removed.
+---
+ MonadCatchIO-transformers.cabal |    2 +-
+ src/Control/Monad/CatchIO.hs    |   13 +++++++++++--
+ 2 files changed, 12 insertions(+), 3 deletions(-)
+
+diff --git a/MonadCatchIO-transformers.cabal b/MonadCatchIO-transformers.cabal
+index fe6674d..b9f559f 100644
+--- a/MonadCatchIO-transformers.cabal
++++ b/MonadCatchIO-transformers.cabal
+@@ -26,4 +26,4 @@ Library
+   Exposed-Modules:
+     Control.Monad.CatchIO
+   Hs-Source-Dirs:  src
+-  Ghc-options:     -Wall
++  Ghc-options:     -Wall -fglasgow-exts
+diff --git a/src/Control/Monad/CatchIO.hs b/src/Control/Monad/CatchIO.hs
+index 62afb83..853996b 100644
+--- a/src/Control/Monad/CatchIO.hs
++++ b/src/Control/Monad/CatchIO.hs
+@@ -19,6 +19,9 @@ where
+ import           Prelude hiding ( catch )
+ import           Control.Applicative                          ((<$>))
+ import qualified Control.Exception.Extensible      as E
++import qualified Control.Exception.Base      as E
++import GHC.Base (maskAsyncExceptions#)
++import GHC.IO (unsafeUnmask, IO(..))
+ 
+ import           Control.Monad.IO.Class                       (MonadIO,liftIO)
+ 
+@@ -51,8 +54,14 @@ class MonadIO m => MonadCatchIO m where
+ 
+ instance MonadCatchIO IO where
+   catch   = E.catch
+-  block   = E.block
+-  unblock = E.unblock
++  block   = oldblock
++  unblock = oldunblock
++
++oldblock :: IO a -> IO a
++oldblock (IO io) = IO $ maskAsyncExceptions# io
++
++oldunblock :: IO a -> IO a
++oldunblock = unsafeUnmask
+ 
+ -- | Warning: this instance is somewhat contentious.
+ -- 
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/SafeSemaphore_fix-build-with-new-base.patch b/standalone/android/haskell-patches/SafeSemaphore_fix-build-with-new-base.patch
new file mode 100644
index 0000000000..a79ca519a5
--- /dev/null
+++ b/standalone/android/haskell-patches/SafeSemaphore_fix-build-with-new-base.patch
@@ -0,0 +1,36 @@
+From 010db89634eb0f64e7961581e65da3acbb2b9f3d Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sat, 21 Sep 2013 22:05:41 +0000
+Subject: [PATCH] fix build with new base
+
+---
+ src/Control/Concurrent/MSampleVar.hs |    6 +-----
+ 1 file changed, 1 insertion(+), 5 deletions(-)
+
+diff --git a/src/Control/Concurrent/MSampleVar.hs b/src/Control/Concurrent/MSampleVar.hs
+index d029c64..16ad6c5 100644
+--- a/src/Control/Concurrent/MSampleVar.hs
++++ b/src/Control/Concurrent/MSampleVar.hs
+@@ -30,7 +30,7 @@ module Control.Concurrent.MSampleVar
+ import Control.Monad(void,join)
+ import Control.Concurrent.MVar(MVar,newMVar,newEmptyMVar,tryTakeMVar,takeMVar,putMVar,withMVar,isEmptyMVar)
+ import Control.Exception(mask_)
+-import Data.Typeable(Typeable1(typeOf1),mkTyCon,mkTyConApp)
++import Data.Typeable(mkTyConApp)
+ 
+ -- |
+ -- Sample variables are slightly different from a normal 'MVar':
+@@ -62,10 +62,6 @@ data MSampleVar a = MSampleVar { readQueue :: MVar ()
+                                , lockedStore :: MVar (MVar a) }
+   deriving (Eq)
+ 
+-instance Typeable1 MSampleVar where
+-  typeOf1 _ = mkTyConApp tc []
+-    where tc = mkTyCon "MSampleVar"
+-
+ 
+ -- | 'newEmptySV' allocates a new MSampleVar in an empty state.  No futher
+ -- allocation is done when using the 'MSampleVar'.
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/aeson_0.6.1.0_0001-disable-TH.patch b/standalone/android/haskell-patches/aeson_0.6.1.0_0001-disable-TH.patch
deleted file mode 100644
index 787caf45cc..0000000000
--- a/standalone/android/haskell-patches/aeson_0.6.1.0_0001-disable-TH.patch
+++ /dev/null
@@ -1,24 +0,0 @@
-From b220c377941d0b1271cf525a8d06bb8e48196d2b Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:29:04 -0400
-Subject: [PATCH] disable TH
-
----
- aeson.cabal |    1 -
- 1 file changed, 1 deletion(-)
-
-diff --git a/aeson.cabal b/aeson.cabal
-index 242aa67..275aa49 100644
---- a/aeson.cabal
-+++ b/aeson.cabal
-@@ -99,7 +99,6 @@ library
-     Data.Aeson.Generic
-     Data.Aeson.Parser
-     Data.Aeson.Types
--    Data.Aeson.TH
- 
-   other-modules:
-     Data.Aeson.Functions
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/async_2.0.1.4_0001-allow-building-with-unreleased-ghc.patch b/standalone/android/haskell-patches/async_fix-build-with-new-ghc.patch
similarity index 59%
rename from standalone/android/haskell-patches/async_2.0.1.4_0001-allow-building-with-unreleased-ghc.patch
rename to standalone/android/haskell-patches/async_fix-build-with-new-ghc.patch
index e959941b8c..727720ad43 100644
--- a/standalone/android/haskell-patches/async_2.0.1.4_0001-allow-building-with-unreleased-ghc.patch
+++ b/standalone/android/haskell-patches/async_fix-build-with-new-ghc.patch
@@ -1,14 +1,14 @@
-From 55f424de9946c4d1d89837bb18698437aecfcfa4 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:29:16 -0400
-Subject: [PATCH] allow building with unreleased ghc
+From 0035f0366e426af213244b2eb25ffb63cb9e74d0 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sun, 22 Sep 2013 06:14:50 +0000
+Subject: [PATCH] fix build with new ghc
 
 ---
  async.cabal |    2 +-
  1 file changed, 1 insertion(+), 1 deletion(-)
 
 diff --git a/async.cabal b/async.cabal
-index 8e47d9d..ff317c7 100644
+index 8e47d9d..98e6312 100644
 --- a/async.cabal
 +++ b/async.cabal
 @@ -70,7 +70,7 @@ source-repository head
@@ -16,7 +16,7 @@ index 8e47d9d..ff317c7 100644
  library
      exposed-modules:     Control.Concurrent.Async
 -    build-depends:       base >= 4.3 && < 4.7, stm >= 2.2 && < 2.5
-+    build-depends:       base >= 4.3 && < 4.8, stm >= 2.2 && < 2.5
++    build-depends:       base >= 4.3 && < 4.9, stm >= 2.2 && < 2.5
  
  test-suite test-async
      type:       exitcode-stdio-1.0
diff --git a/standalone/android/haskell-patches/bloomfilter_fix-build-with-newer-base.patch b/standalone/android/haskell-patches/bloomfilter_fix-build-with-newer-base.patch
new file mode 100644
index 0000000000..d2f783a7f4
--- /dev/null
+++ b/standalone/android/haskell-patches/bloomfilter_fix-build-with-newer-base.patch
@@ -0,0 +1,26 @@
+From 09bcaf4f203c39c967a6951d56fd015347bb5dae Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sat, 21 Sep 2013 21:57:21 +0000
+Subject: [PATCH] fix build with newer base
+
+---
+ Data/BloomFilter/Array.hs |    3 ++-
+ 1 file changed, 2 insertions(+), 1 deletion(-)
+
+diff --git a/Data/BloomFilter/Array.hs b/Data/BloomFilter/Array.hs
+index e085bbe..d94757a 100644
+--- a/Data/BloomFilter/Array.hs
++++ b/Data/BloomFilter/Array.hs
+@@ -3,7 +3,8 @@
+ 
+ module Data.BloomFilter.Array (newArray) where
+ 
+-import Control.Monad.ST (ST, unsafeIOToST)
++import Control.Monad.ST (ST)
++import Control.Monad.ST.Unsafe (unsafeIOToST)
+ import Data.Array.Base (MArray, STUArray(..), unsafeNewArray_)
+ #if __GLASGOW_HASKELL__ >= 704
+ import Foreign.C.Types (CInt(..), CSize(..))
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/case-insensitive_0.4.0.1_0001-allow-building-with-unreleased-ghc.patch b/standalone/android/haskell-patches/case-insensitive_0.4.0.1_0001-allow-building-with-unreleased-ghc.patch
deleted file mode 100644
index 2d7c45089a..0000000000
--- a/standalone/android/haskell-patches/case-insensitive_0.4.0.1_0001-allow-building-with-unreleased-ghc.patch
+++ /dev/null
@@ -1,27 +0,0 @@
-From efd0e93de82c0b5554a4f3a4517e6127f405f6da Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:29:36 -0400
-Subject: [PATCH] allow building with unreleased ghc
-
----
- case-insensitive.cabal |    4 ++--
- 1 file changed, 2 insertions(+), 2 deletions(-)
-
-diff --git a/case-insensitive.cabal b/case-insensitive.cabal
-index a73479d..18a1a51 100644
---- a/case-insensitive.cabal
-+++ b/case-insensitive.cabal
-@@ -25,8 +25,8 @@ source-repository head
- 
- Library
-   GHC-Options: -Wall
--  build-depends: base       >= 3   && < 4.6
--               , bytestring >= 0.9 && < 0.10
-+  build-depends: base       >= 3   && < 4.8
-+               , bytestring >= 0.9 && < 0.15
-                , text       >= 0.3 && < 0.12
-                , hashable   >= 1.0 && < 1.2
-   exposed-modules: Data.CaseInsensitive
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/certificate_1.3.7-0001-support-Android-cert-store.patch b/standalone/android/haskell-patches/certificate_1.3.7-0001-support-Android-cert-store.patch
deleted file mode 100644
index 5f772bfdfe..0000000000
--- a/standalone/android/haskell-patches/certificate_1.3.7-0001-support-Android-cert-store.patch
+++ /dev/null
@@ -1,37 +0,0 @@
-From 3779c75175e895f94b21341ebd6361e9d6af54fd Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 9 May 2013 12:36:23 -0400
-Subject: [PATCH] support Android cert store
-
-Android puts it in a different place and has only hashed files.
-See https://github.com/vincenthz/hs-certificate/issues/19
----
- System/Certificate/X509/Unix.hs | 5 +++--
- 1 file changed, 3 insertions(+), 2 deletions(-)
-
-diff --git a/System/Certificate/X509/Unix.hs b/System/Certificate/X509/Unix.hs
-index 8463465..74e9503 100644
---- a/System/Certificate/X509/Unix.hs
-+++ b/System/Certificate/X509/Unix.hs
-@@ -35,7 +35,8 @@ import qualified Control.Exception as E
- import Data.Char
- 
- defaultSystemPath :: FilePath
--defaultSystemPath = "/etc/ssl/certs/"
-+defaultSystemPath = "/system/etc/security/cacerts/"
-+--defaultSystemPath = "/etc/ssl/certs/"
- 
- envPathOverride :: String
- envPathOverride = "SYSTEM_CERTIFICATE_PATH"
-@@ -47,7 +48,7 @@ listDirectoryCerts path = (map (path ) . filter isCert <$> getDirectoryConten
-                         && isDigit (s !! 9)
-                         && (s !! 8) == '.'
-                         && all isHexDigit (take 8 s)
--          isCert x = (not $ isPrefixOf "." x) && (not $ isHashedFile x)
-+          isCert x = (not $ isPrefixOf "." x)
- 
- getSystemCertificateStore :: IO CertificateStore
- getSystemCertificateStore = makeCertificateStore . concat <$> (getSystemPath >>= listDirectoryCerts >>= mapM readCertificates)
--- 
-1.8.2.rc3
-
diff --git a/standalone/android/haskell-patches/cipher-aes_0.1.7-0001-fix-cross-build.patch b/standalone/android/haskell-patches/cipher-aes_0.1.7-0001-fix-cross-build.patch
deleted file mode 100644
index fab0ae6ef7..0000000000
--- a/standalone/android/haskell-patches/cipher-aes_0.1.7-0001-fix-cross-build.patch
+++ /dev/null
@@ -1,34 +0,0 @@
-From d456247000ab839a1d32749717f4f8f92e37dbba Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Tue, 7 May 2013 17:45:45 -0400
-Subject: [PATCH] fix cross build
-
----
- cipher-aes.cabal |    5 +----
- 1 file changed, 1 insertion(+), 4 deletions(-)
-
-diff --git a/cipher-aes.cabal b/cipher-aes.cabal
-index 02ddfd0..eb916e3 100644
---- a/cipher-aes.cabal
-+++ b/cipher-aes.cabal
-@@ -31,16 +31,13 @@ Extra-Source-Files:  Tests/*.hs
- 
- Library
-   Build-Depends:     base >= 4 && < 5
--                   , bytestring
-+                   , bytestring >= 0.10.3.0
-   Exposed-modules:   Crypto.Cipher.AES
-   ghc-options:       -Wall
-   C-sources:         cbits/aes_generic.c
-                      cbits/aes.c
-                      cbits/gf.c
-                      cbits/cpu.c
--  if os(linux) && (arch(i386) || arch(x86_64))
--    CC-options:      -mssse3 -maes -mpclmul -DWITH_AESNI
--    C-sources:       cbits/aes_x86ni.c
- 
- Test-Suite test-cipher-aes
-   type:              exitcode-stdio-1.0
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/comonad_cross-build.patch b/standalone/android/haskell-patches/comonad_cross-build.patch
new file mode 100644
index 0000000000..e0317926fd
--- /dev/null
+++ b/standalone/android/haskell-patches/comonad_cross-build.patch
@@ -0,0 +1,25 @@
+From 2cb43c46d345341d1aa77c4b2a88514c056d3122 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sat, 21 Sep 2013 22:25:18 +0000
+Subject: [PATCH] cross build
+
+---
+ comonad.cabal |    2 +-
+ 1 file changed, 1 insertion(+), 1 deletion(-)
+
+diff --git a/comonad.cabal b/comonad.cabal
+index e01f1a7..e807e05 100644
+--- a/comonad.cabal
++++ b/comonad.cabal
+@@ -13,7 +13,7 @@ copyright:     Copyright (C) 2008-2013 Edward A. Kmett,
+                Copyright (C) 2004-2008 Dave Menendez
+ synopsis:      Haskell 98 compatible comonads
+ description:   Haskell 98 compatible comonads
+-build-type:    Custom
++build-type:    Simple
+ extra-source-files:
+   .gitignore
+   .travis.yml
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/dns_0.3.6-0001-use-getprop-to-get-dns-server.patch b/standalone/android/haskell-patches/dns_0.3.6-0001-use-getprop-to-get-dns-server.patch
deleted file mode 100644
index 069bdd20a3..0000000000
--- a/standalone/android/haskell-patches/dns_0.3.6-0001-use-getprop-to-get-dns-server.patch
+++ /dev/null
@@ -1,73 +0,0 @@
-From 8459f93270c7a6e8a2ebd415db2110a66bf1ec41 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Wed, 15 May 2013 20:31:14 -0400
-Subject: [PATCH] use getprop to get dns server
-
----
- Network/DNS/Resolver.hs |   13 +++++++++++--
- dns.cabal               |    4 ++++
- 2 files changed, 15 insertions(+), 2 deletions(-)
-
-diff --git a/Network/DNS/Resolver.hs b/Network/DNS/Resolver.hs
-index 70ab9ed..9b27336 100644
---- a/Network/DNS/Resolver.hs
-+++ b/Network/DNS/Resolver.hs
-@@ -41,6 +41,8 @@ import Network.Socket.ByteString.Lazy
- import Prelude hiding (lookup)
- import System.Random
- import System.Timeout
-+import System.Process (readProcess) 
-+import System.Directory
- 
- #if mingw32_HOST_OS == 1
- import Network.Socket (send)
-@@ -73,7 +75,7 @@ data ResolvConf = ResolvConf {
- -}
- defaultResolvConf :: ResolvConf
- defaultResolvConf = ResolvConf {
--    resolvInfo = RCFilePath "/etc/resolv.conf"
-+    resolvInfo = RCFilePath "/system/etc/resolv.conf"
-   , resolvTimeout = 3 * 1000 * 1000
-   , resolvBufsize = 512
- }
-@@ -111,7 +113,14 @@ makeResolvSeed conf = ResolvSeed <$> addr
-   where
-     addr = case resolvInfo conf of
-         RCHostName numhost -> makeAddrInfo numhost
--        RCFilePath file -> toAddr <$> readFile file >>= makeAddrInfo
-+        RCFilePath file -> do
-+		exists <- doesFileExist file
-+		if exists
-+			then toAddr <$> readFile file >>= makeAddrInfo
-+			else do
-+				s <- readProcess "getprop" ["net.dns1"] ""
-+				makeAddrInfo $ takeWhile (/= '\n') s
-+				
-     toAddr cs = let l:_ = filter ("nameserver" `isPrefixOf`) $ lines cs
-                 in extract l
-     extract = reverse . dropWhile isSpace . reverse . dropWhile isSpace . drop 11
-diff --git a/dns.cabal b/dns.cabal
-index 40671f6..2c19734 100644
---- a/dns.cabal
-+++ b/dns.cabal
-@@ -34,6 +34,8 @@ library
-                       , network >= 2.3
-                       , network-conduit
-                       , random
-+                      , process
-+                      , directory
-   else
-     Build-Depends:      base >= 4 && < 5
-                       , attoparsec
-@@ -49,6 +51,8 @@ library
-                       , network-bytestring
-                       , network-conduit
-                       , random
-+                      , process
-+                      , directory
- Source-Repository head
-   Type:                 git
-   Location:             git://github.com/kazu-yamamoto/dns.git
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/entropy_cross-build.patch b/standalone/android/haskell-patches/entropy_cross-build.patch
new file mode 100644
index 0000000000..d09cd13ecb
--- /dev/null
+++ b/standalone/android/haskell-patches/entropy_cross-build.patch
@@ -0,0 +1,25 @@
+From 35c6718205e9d7f5e5fc44578ea6a9971beac151 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sat, 21 Sep 2013 23:32:18 +0000
+Subject: [PATCH] cross build
+
+---
+ entropy.cabal |    2 +-
+ 1 file changed, 1 insertion(+), 1 deletion(-)
+
+diff --git a/entropy.cabal b/entropy.cabal
+index 45e4705..17553d8 100644
+--- a/entropy.cabal
++++ b/entropy.cabal
+@@ -14,7 +14,7 @@ category:       Data, Cryptography
+ homepage:       https://github.com/TomMD/entropy
+ bug-reports:    https://github.com/TomMD/entropy/issues
+ stability:      stable
+-build-type:     Custom
++build-type:     Simple
+ cabal-version:  >= 1.6
+ tested-with:    GHC == 6.12.1
+ data-files:
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/file-embed_0.0.4.7-0001-remove-TH-and-export-one-symbol-used-by-TH.patch b/standalone/android/haskell-patches/file-embed_0.0.4.7-0001-remove-TH-and-export-one-symbol-used-by-TH.patch
deleted file mode 100644
index ff50d3947e..0000000000
--- a/standalone/android/haskell-patches/file-embed_0.0.4.7-0001-remove-TH-and-export-one-symbol-used-by-TH.patch
+++ /dev/null
@@ -1,193 +0,0 @@
-From 256ff157005f44c97fa5affe2ed9655815b3788e Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Mon, 15 Apr 2013 12:38:22 -0400
-Subject: [PATCH] remove TH and export one symbol used by TH
-
----
- Data/.FileEmbed.hs.swp | Bin 16384 -> 0 bytes
- Data/FileEmbed.hs      |  80 +++----------------------------------------------
- 2 files changed, 4 insertions(+), 76 deletions(-)
- delete mode 100644 Data/.FileEmbed.hs.swp
-
-diff --git a/Data/.FileEmbed.hs.swp b/Data/.FileEmbed.hs.swp
-deleted file mode 100644
-index 1b2ddbfaa71697e9df3869555aee8c97ca7ea0cb..0000000000000000000000000000000000000000
-GIT binary patch
-literal 0
-HcmV?d00001
-
-literal 16384
-zcmeHNZEPGz8J?z;l0w=5RfRyn>$8>HBX?)xk`I~qq+D`I3}?sToJzq>+`YRw-^O>l
-z*WKCLCgwvzNFb1);!ir*%6;!D~AU?_ukSIa|0TNP$5Jm93GrM~q
-zjuRvP0NRxw-|fsh@60^&&O0;jTz%?+xp_KLykFqiFT`)B+;d-jZzZDh-@^(gRkt_UayqggyLH(tOcke!Zz&#`JZUR?@)Xi5oLp=NyHc47r3|DD
-z?1q6*wF*b~iTkJDJT;yfqgTJ`{BBC6GARQo11SS311SS311SS311SS31OG=1sNNp&
-zPxNOGa0R$6!tMCX1MiLA@sU0$11SS311SS311SS311SS311SS311SS311SUlqYT(h
-zA*RvxX$}D3{-0w2zq&_=9|B(oJ`TJeP{1ls23`y71@-_h+%3fOz|Vo70p9>V3^ahF
-zz%+0#un)Kc_}e}qegu3C_%d)6aDW-$b-)X+5aMazbHMw6w*zCq9^f|M$M{{sb>Io$
-zDsTmu2a3QOfxq4*#4mxL0AB%~0z$wCs=#SrKk&!BLOct68+a6001g9(fV+S@fnUE&
-zh$n$h0-pdb0VUu*;P-b5@f+Y7;Bnwnz!hK(r~;F~i!T-8@4!!iYruDb&jKF=LO=l}
-z;0?g*f#>cJ;yXYO7zh6R5+S|?d;oYSa0ECE>;;}ffaVv#4}hnDCxOR-j{zSATEGS1
-zUf>TH+wTKwz-8bZPyu+%$AEi)y8$7HpN>=%&@2UQZ=IZNDccep(X*R1=Uo!Qv&r|F
-z8Jcqy6-rc7zT>V&%DFV2<%^snec$sb!$18fCO`ckYgMW_*Oh*5hAw!aPtCB~-K3yr
-zHzc*~fa+4Z)bM;i>?!JSs<)EY;NTk@!fF`JX
-zv>3Y3yhZ_fP_B{J(t=EaWs>r`cn*w|i$SmBsN>)V!d0{a3W`nN>yg!w?y722*IsoR
-zIjW1e6I2H&$qQI17t5PU8d6Ln`|m=;if3thDtR$n3Za#w9SzTI*ou}jEt$zvX1`)S~V9(`4Css&o76R4UEVgY_)e>q`~-uF1^iL|+^_<~`SLQkP~+I={=s
-zQKTEGGGiGjn24J*LHx6xfM%%a_<^B28kDZxn%k4fsOc5bDaxmfoNn(4&sEY@h7~A^-}^l#
-z*HdSlW)ntrY@$T4n56TGuod$b)sPe1mtjh|;#q2X16deQ?%kpd`@|>?exEx_%T}C_
-zAF|EdMR<`&z3$E|k4;n?*OJNf^GB+*K;<2^xw8u^N_Kl4Tger;-!<9kSkw6<`KcV7z2los87-D+PCek^
-zLl^t`BV)Id&9Qw(oi{T8dSa_%FN!%qBdTt0YlQ+WwVi
-z5TP1|9a6r;`r+!bsHn?+u{b<1RC87c7s9Hdxqiz@s(
-z&mpowdKmc5BeJu}oNw~lAK)LB{f5_+n)igwzE@B9jBNhq1`no6rCl4irbtf|X4vqp
-zUvI{*7Dx!zZ!yFAm#@QA$LdCS8sPUoVK>0m3)8&CbN$AgMgvyc3^2>}HcT%Rmc`3k
-zP7G(yoh_bs1G^>33iaor^jn_aojaRIj`m|j9_|@V2ph5h`=_K3FLA!tDZ&YN9PDji
-z1XyIT5cXS;h+xyWj!Z1PxqP(7Cwg`?yW$D>@1um>WBF*@ryYg0SS%ISYxYFEiQ)Z;
-znW(&iYb6}dsP&eOTj4jgNnKZn#VT{r8*
-z&X#?XFyGG&*MNnFtZ4Pi^Il%AO25j@;8oca8J01^i@wvX4i&g{iw^N(!YVCZ_{ie5
-zIB%RNe<-~0>X+BPHsP{ryQ`tSDvM{#s#IJ$Q><;e%HA*@I!Ehm>Bnt#+{>VxS=BY=
-zF&#KzxYPQmQR9=wZiq~pO$3+rCXmD$p;&ojyI7Us(3D+IYBZJ+RUdm_{YsR08vSk=
-zg^`cMe#7hbcnT}0D@E69hWM^0nzj=5q~c0poT|qcPM<%1x
-z(gJ+`e*))O7w26*|L5^>9q0OIfiD6d0UiM^0B;5E1O9|_{L{cS;4xqcI0Wnm{(>|7
-zmw?Xzp9a=}67W3E?$?2D0$%_Kcn$C(&g|EKEnpEi415pg^Q*w;fe!&Iz!6{^xE=T%
-z+WHLe7{KlB0_l@7kTQ@mkTQ@mkTQ@m@ZZS*MbFzpgaMiW!X4$}y6-5-8#zuowaEXY
-zO(D^Or`kBev0xM}pL2t-)p8mRLO6q=aT5mD!ELj%WS92}IBf8pMleGe4v*>U5U#dd
-z8>({f!okrwx^0Nk@8+Ii=#C-#?_Dw^w;EPm;t(zeFDmK?6|dF8x(Pv&6-7o7z1H^=
-zp6{&cwkmJVyo6NW|1E4~>r)#MRJ
-zMs2LC=hGcn)&p|kwa&PDJQgEt$EO3jZUuIaqSKi^9_lz
-z9hWDvK4Heq9If<{sAr2sLAk_D|
-z`qc+J6D-CzXMwU2H^e;Cr|*ba{SoCH#C(s9#asr$L#))
- 
---- | Embed a single file in your source code.
----
---- > import qualified Data.ByteString
---- >
---- > myFile :: Data.ByteString.ByteString
---- > myFile = $(embedFile "dirName/fileName")
--embedFile :: FilePath -> Q Exp
--embedFile fp =
--#if MIN_VERSION_template_haskell(2,7,0)
--    qAddDependentFile fp >>
--#endif
--  (runIO $ B.readFile fp) >>= bsToExp
--
---- | Embed a directory recusrively in your source code.
----
---- > import qualified Data.ByteString
---- >
---- > myDir :: [(FilePath, Data.ByteString.ByteString)]
---- > myDir = $(embedDir "dirName")
--embedDir :: FilePath -> Q Exp
--embedDir fp = do
--    typ <- [t| [(FilePath, B.ByteString)] |]
--    e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp))
--    return $ SigE e typ
--
- -- | Get a directory tree in the IO monad.
- --
- -- This is the workhorse of 'embedDir'
- getDir :: FilePath -> IO [(FilePath, B.ByteString)]
- getDir = fileList
- 
--pairToExp :: FilePath -> (FilePath, B.ByteString) -> Q Exp
--pairToExp _root (path, bs) = do
--#if MIN_VERSION_template_haskell(2,7,0)
--    qAddDependentFile $ _root ++ '/' : path
--#endif
--    exp' <- bsToExp bs
--    return $! TupE [LitE $ StringL path, exp']
--
--bsToExp :: B.ByteString -> Q Exp
--bsToExp bs = do
--    helper <- [| stringToBs |]
--    let chars = B8.unpack bs
--    return $! AppE helper $! LitE $! StringL chars
--
- stringToBs :: String -> B.ByteString
- stringToBs = B8.pack
- 
-@@ -123,23 +68,6 @@ padSize i =
-     let s = show i
-      in replicate (sizeLen - length s) '0' ++ s
- 
--#if MIN_VERSION_template_haskell(2,5,0)
--dummySpace :: Int -> Q Exp
--dummySpace space = do
--    let size = padSize space
--    let start = magic ++ size
--    let chars = LitE $ StringPrimL $
--#if MIN_VERSION_template_haskell(2,6,0)
--            map (toEnum . fromEnum) $
--#endif
--            start ++ replicate space '0'
--    let len = LitE $ IntegerL $ fromIntegral $ length start + space
--    upi <- [|unsafePerformIO|]
--    pack <- [|unsafePackAddressLen|]
--    getInner' <- [|getInner|]
--    return $ getInner' `AppE` (upi `AppE` (pack `AppE` len `AppE` chars))
--#endif
--
- inject :: B.ByteString -- ^ bs to inject
-        -> B.ByteString -- ^ original BS containing dummy
-        -> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space
--- 
-1.8.2.rc3
-
diff --git a/standalone/android/haskell-patches/file-embed_export-TH-symbols.patch b/standalone/android/haskell-patches/file-embed_export-TH-symbols.patch
new file mode 100644
index 0000000000..865cbe3cc6
--- /dev/null
+++ b/standalone/android/haskell-patches/file-embed_export-TH-symbols.patch
@@ -0,0 +1,25 @@
+From fdbd29ce6e8ff11f721f9e74cac1f4ca14e6773d Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sun, 22 Sep 2013 07:06:33 +0000
+Subject: [PATCH] export TH symbols
+
+---
+ Data/FileEmbed.hs |    2 ++
+ 1 file changed, 2 insertions(+)
+
+diff --git a/Data/FileEmbed.hs b/Data/FileEmbed.hs
+index c17f082..6654f60 100644
+--- a/Data/FileEmbed.hs
++++ b/Data/FileEmbed.hs
+@@ -26,6 +26,8 @@ module Data.FileEmbed
+ #endif
+     , inject
+     , injectFile
++    -- used by TH (pointlessly)
++    , stringToBs
+     ) where
+ 
+ import Language.Haskell.TH.Syntax
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/gnuidn_fix-build-with-new-base.patch b/standalone/android/haskell-patches/gnuidn_fix-build-with-new-base.patch
new file mode 100644
index 0000000000..ff9d8f2458
--- /dev/null
+++ b/standalone/android/haskell-patches/gnuidn_fix-build-with-new-base.patch
@@ -0,0 +1,50 @@
+From afdec6c9e66211a0ac8419fffe191b059d1fd00c Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sun, 22 Sep 2013 17:24:33 +0000
+Subject: [PATCH] fix build with new base
+
+---
+ Data/Text/IDN/IDNA.chs       |    1 +
+ Data/Text/IDN/Punycode.chs   |    1 +
+ Data/Text/IDN/StringPrep.chs |    1 +
+ 3 files changed, 3 insertions(+)
+
+diff --git a/Data/Text/IDN/IDNA.chs b/Data/Text/IDN/IDNA.chs
+index ed29ee4..dbb4ba5 100644
+--- a/Data/Text/IDN/IDNA.chs
++++ b/Data/Text/IDN/IDNA.chs
+@@ -31,6 +31,7 @@ import Foreign
+ import Foreign.C
+ 
+ import Data.Text.IDN.Internal
++import System.IO.Unsafe
+ 
+ #include 
+ #include 
+diff --git a/Data/Text/IDN/Punycode.chs b/Data/Text/IDN/Punycode.chs
+index 24b5fa6..4e62555 100644
+--- a/Data/Text/IDN/Punycode.chs
++++ b/Data/Text/IDN/Punycode.chs
+@@ -32,6 +32,7 @@ import Data.List (unfoldr)
+ import qualified Data.ByteString as B
+ import qualified Data.Text as T
+ 
++import System.IO.Unsafe
+ import Foreign
+ import Foreign.C
+ 
+diff --git a/Data/Text/IDN/StringPrep.chs b/Data/Text/IDN/StringPrep.chs
+index 752dc9e..5e9fd84 100644
+--- a/Data/Text/IDN/StringPrep.chs
++++ b/Data/Text/IDN/StringPrep.chs
+@@ -39,6 +39,7 @@ import qualified Data.ByteString as B
+ import qualified Data.Text as T
+ import qualified Data.Text.Encoding as TE
+ 
++import System.IO.Unsafe
+ import Foreign
+ import Foreign.C
+ 
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/hS3_0.5.7_0001-fix-build.patch b/standalone/android/haskell-patches/hS3_0.5.7_0001-fix-build.patch
deleted file mode 100644
index c0158c0f40..0000000000
--- a/standalone/android/haskell-patches/hS3_0.5.7_0001-fix-build.patch
+++ /dev/null
@@ -1,23 +0,0 @@
-From 643b3c9fd95967c5911107f46498cd851e68f97d Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Tue, 7 May 2013 18:26:33 -0400
-Subject: [PATCH] fix build
-
----
- hS3.cabal |    3 ---
- 1 file changed, 3 deletions(-)
-
-diff --git a/hS3.cabal b/hS3.cabal
-index 35f7496..e04bf65 100644
---- a/hS3.cabal
-+++ b/hS3.cabal
-@@ -44,6 +44,3 @@ Library
-         Network.AWS.AWSConnection,
-         Network.AWS.Authentication,
-         Network.AWS.ArrowUtils
--
--Executable     hs3
--  main-is:        hS3.hs
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/hamlet_1.1.6.1_0001-remove-TH.patch b/standalone/android/haskell-patches/hamlet_1.1.6.1_0001-remove-TH.patch
deleted file mode 100644
index 1c511a1321..0000000000
--- a/standalone/android/haskell-patches/hamlet_1.1.6.1_0001-remove-TH.patch
+++ /dev/null
@@ -1,294 +0,0 @@
-From b2c677ed39f1aca3a1111691ba51b26f7fd414a4 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Wed, 8 May 2013 01:50:58 -0400
-Subject: [PATCH] remove TH
-
----
- Text/Hamlet.hs |  219 ++------------------------------------------------------
- hamlet.cabal   |    2 +-
- 2 files changed, 7 insertions(+), 214 deletions(-)
-
-diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs
-index 4ac870a..63b8555 100644
---- a/Text/Hamlet.hs
-+++ b/Text/Hamlet.hs
-@@ -11,35 +11,26 @@
- module Text.Hamlet
-     ( -- * Plain HTML
-       Html
--    , shamlet
--    , shamletFile
--    , xshamlet
--    , xshamletFile
-       -- * Hamlet
-     , HtmlUrl
--    , hamlet
--    , hamletFile
--    , xhamlet
--    , xhamletFile
-       -- * I18N Hamlet
-     , HtmlUrlI18n
--    , ihamlet
--    , ihamletFile
-       -- * Type classes
-     , ToAttributes (..)
-       -- * Internal, for making more
-     , HamletSettings (..)
-     , NewlineStyle (..)
--    , hamletWithSettings
--    , hamletFileWithSettings
-     , defaultHamletSettings
-     , xhtmlHamletSettings
-     , Env (..)
-     , HamletRules (..)
--    , hamletRules
--    , ihamletRules
--    , htmlRules
-     , CloseStyle (..)
-+    , condH
-+    , maybeH
-+
-+    -- referred to in TH splices
-+    , attrsToHtml
-+    , asHtmlUrl
-     ) where
- 
- import Text.Shakespeare.Base
-@@ -90,14 +81,6 @@ type HtmlUrl url = Render url -> Html
- -- | A function generating an 'Html' given a message translator and a URL rendering function.
- type HtmlUrlI18n msg url = Translate msg -> Render url -> Html
- 
--docsToExp :: Env -> HamletRules -> Scope -> [Doc] -> Q Exp
--docsToExp env hr scope docs = do
--    exps <- mapM (docToExp env hr scope) docs
--    case exps of
--        [] -> [|return ()|]
--        [x] -> return x
--        _ -> return $ DoE $ map NoBindS exps
--
- unIdent :: Ident -> String
- unIdent (Ident s) = s
- 
-@@ -159,169 +142,9 @@ recordToFieldNames conStr = do
-   [fields] <- return [fields | RecC name fields <- cons, name == conName]
-   return [fieldName | (fieldName, _, _) <- fields]
- 
--docToExp :: Env -> HamletRules -> Scope -> Doc -> Q Exp
--docToExp env hr scope (DocForall list idents inside) = do
--    let list' = derefToExp scope list
--    (pat, extraScope) <- bindingPattern idents
--    let scope' = extraScope ++ scope
--    mh <- [|F.mapM_|]
--    inside' <- docsToExp env hr scope' inside
--    let lam = LamE [pat] inside'
--    return $ mh `AppE` lam `AppE` list'
--docToExp env hr scope (DocWith [] inside) = do
--    inside' <- docsToExp env hr scope inside
--    return $ inside'
--docToExp env hr scope (DocWith ((deref, idents):dis) inside) = do
--    let deref' = derefToExp scope deref
--    (pat, extraScope) <- bindingPattern idents
--    let scope' = extraScope ++ scope
--    inside' <- docToExp env hr scope' (DocWith dis inside)
--    let lam = LamE [pat] inside'
--    return $ lam `AppE` deref'
--docToExp env hr scope (DocMaybe val idents inside mno) = do
--    let val' = derefToExp scope val
--    (pat, extraScope) <- bindingPattern idents
--    let scope' = extraScope ++ scope
--    inside' <- docsToExp env hr scope' inside
--    let inside'' = LamE [pat] inside'
--    ninside' <- case mno of
--                    Nothing -> [|Nothing|]
--                    Just no -> do
--                        no' <- docsToExp env hr scope no
--                        j <- [|Just|]
--                        return $ j `AppE` no'
--    mh <- [|maybeH|]
--    return $ mh `AppE` val' `AppE` inside'' `AppE` ninside'
--docToExp env hr scope (DocCond conds final) = do
--    conds' <- mapM go conds
--    final' <- case final of
--                Nothing -> [|Nothing|]
--                Just f -> do
--                    f' <- docsToExp env hr scope f
--                    j <- [|Just|]
--                    return $ j `AppE` f'
--    ch <- [|condH|]
--    return $ ch `AppE` ListE conds' `AppE` final'
--  where
--    go :: (Deref, [Doc]) -> Q Exp
--    go (d, docs) = do
--        let d' = derefToExp scope d
--        docs' <- docsToExp env hr scope docs
--        return $ TupE [d', docs']
--docToExp env hr scope (DocCase deref cases) = do
--    let exp_ = derefToExp scope deref
--    matches <- mapM toMatch cases
--    return $ CaseE exp_ matches
--  where
--    readMay s =
--        case reads s of
--            (x, ""):_ -> Just x
--            _ -> Nothing
--    toMatch (idents, inside) = do
--        let pat = case map unIdent idents of
--                    ["_"] -> WildP
--                    [str]
--                        | Just i <- readMay str -> LitP $ IntegerL i
--                    strs -> let (constr:fields) = map mkName strs
--                            in ConP constr (map VarP fields)
--        insideExp <- docsToExp env hr scope inside
--        return $ Match pat (NormalB insideExp) []
--docToExp env hr v (DocContent c) = contentToExp env hr v c
--
--contentToExp :: Env -> HamletRules -> Scope -> Content -> Q Exp
--contentToExp _ hr _ (ContentRaw s) = do
--    os <- [|preEscapedText . pack|]
--    let s' = LitE $ StringL s
--    return $ hrFromHtml hr `AppE` (os `AppE` s')
--contentToExp _ hr scope (ContentVar d) = do
--    str <- [|toHtml|]
--    return $ hrFromHtml hr `AppE` (str `AppE` derefToExp scope d)
--contentToExp env hr scope (ContentUrl hasParams d) =
--    case urlRender env of
--        Nothing -> error "URL interpolation used, but no URL renderer provided"
--        Just wrender -> wrender $ \render -> do
--            let render' = return render
--            ou <- if hasParams
--                    then [|\(u, p) -> $(render') u p|]
--                    else [|\u -> $(render') u []|]
--            let d' = derefToExp scope d
--            pet <- [|toHtml|]
--            return $ hrFromHtml hr `AppE` (pet `AppE` (ou `AppE` d'))
--contentToExp env hr scope (ContentEmbed d) = hrEmbed hr env $ derefToExp scope d
--contentToExp env hr scope (ContentMsg d) =
--    case msgRender env of
--        Nothing -> error "Message interpolation used, but no message renderer provided"
--        Just wrender -> wrender $ \render ->
--            return $ hrFromHtml hr `AppE` (render `AppE` derefToExp scope d)
--contentToExp _ hr scope (ContentAttrs d) = do
--    html <- [|attrsToHtml . toAttributes|]
--    return $ hrFromHtml hr `AppE` (html `AppE` derefToExp scope d)
--
--shamlet :: QuasiQuoter
--shamlet = hamletWithSettings htmlRules defaultHamletSettings
--
--xshamlet :: QuasiQuoter
--xshamlet = hamletWithSettings htmlRules xhtmlHamletSettings
--
--htmlRules :: Q HamletRules
--htmlRules = do
--    i <- [|id|]
--    return $ HamletRules i ($ (Env Nothing Nothing)) (\_ b -> return b)
--
--hamlet :: QuasiQuoter
--hamlet = hamletWithSettings hamletRules defaultHamletSettings
--
--xhamlet :: QuasiQuoter
--xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings
--
- asHtmlUrl :: HtmlUrl url -> HtmlUrl url
- asHtmlUrl = id
- 
--hamletRules :: Q HamletRules
--hamletRules = do
--    i <- [|id|]
--    let ur f = do
--            r <- newName "_render"
--            let env = Env
--                    { urlRender = Just ($ (VarE r))
--                    , msgRender = Nothing
--                    }
--            h <- f env
--            return $ LamE [VarP r] h
--    return $ HamletRules i ur em
--  where
--    em (Env (Just urender) Nothing) e = do
--        asHtmlUrl' <- [|asHtmlUrl|]
--        urender $ \ur' -> return ((asHtmlUrl' `AppE` e) `AppE` ur')
--    em _ _ = error "bad Env"
--
--ihamlet :: QuasiQuoter
--ihamlet = hamletWithSettings ihamletRules defaultHamletSettings
--
--ihamletRules :: Q HamletRules
--ihamletRules = do
--    i <- [|id|]
--    let ur f = do
--            u <- newName "_urender"
--            m <- newName "_mrender"
--            let env = Env
--                    { urlRender = Just ($ (VarE u))
--                    , msgRender = Just ($ (VarE m))
--                    }
--            h <- f env
--            return $ LamE [VarP m, VarP u] h
--    return $ HamletRules i ur em
--  where
--    em (Env (Just urender) (Just mrender)) e =
--          urender $ \ur' -> mrender $ \mr -> return (e `AppE` mr `AppE` ur')
--    em _ _ = error "bad Env"
--
--hamletWithSettings :: Q HamletRules -> HamletSettings -> QuasiQuoter
--hamletWithSettings hr set =
--    QuasiQuoter
--        { quoteExp = hamletFromString hr set
--        }
--
- data HamletRules = HamletRules
-     { hrFromHtml :: Exp
-     , hrWithEnv :: (Env -> Q Exp) -> Q Exp
-@@ -333,36 +156,6 @@ data Env = Env
-     , msgRender :: Maybe ((Exp -> Q Exp) -> Q Exp)
-     }
- 
--hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp
--hamletFromString qhr set s = do
--    hr <- qhr
--    case parseDoc set s of
--        Error s' -> error s'
--        Ok (_mnl, d) -> hrWithEnv hr $ \env -> docsToExp env hr [] d
--
--hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp
--hamletFileWithSettings qhr set fp = do
--#ifdef GHC_7_4
--    qAddDependentFile fp
--#endif
--    contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp
--    hamletFromString qhr set contents
--
--hamletFile :: FilePath -> Q Exp
--hamletFile = hamletFileWithSettings hamletRules defaultHamletSettings
--
--xhamletFile :: FilePath -> Q Exp
--xhamletFile = hamletFileWithSettings hamletRules xhtmlHamletSettings
--
--shamletFile :: FilePath -> Q Exp
--shamletFile = hamletFileWithSettings htmlRules defaultHamletSettings
--
--xshamletFile :: FilePath -> Q Exp
--xshamletFile = hamletFileWithSettings htmlRules xhtmlHamletSettings
--
--ihamletFile :: FilePath -> Q Exp
--ihamletFile = hamletFileWithSettings ihamletRules defaultHamletSettings
--
- varName :: Scope -> String -> Exp
- varName _ "" = error "Illegal empty varName"
- varName scope v@(_:_) = fromMaybe (strToExp v) $ lookup (Ident v) scope
-diff --git a/hamlet.cabal b/hamlet.cabal
-index 73fa6a8..4348508 100644
---- a/hamlet.cabal
-+++ b/hamlet.cabal
-@@ -50,7 +50,7 @@ library
-                    , text             >= 0.7     && < 0.12
-                    , containers       >= 0.2
-                    , blaze-builder    >= 0.2     && < 0.4
--                   , process          >= 1.0     && < 1.2
-+                   , process          >= 1.0     && < 1.3
-                    , blaze-html       >= 0.5     && < 0.6
-                    , blaze-markup     >= 0.5.1   && < 0.6
- 
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/hamlet_export-TH-splice-stuff.patch b/standalone/android/haskell-patches/hamlet_export-TH-splice-stuff.patch
new file mode 100644
index 0000000000..a446fa18fc
--- /dev/null
+++ b/standalone/android/haskell-patches/hamlet_export-TH-splice-stuff.patch
@@ -0,0 +1,28 @@
+From 9819f4b387679c889f1259f9fd969513aa2efcf2 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sun, 22 Sep 2013 03:51:06 +0000
+Subject: [PATCH] export TH splice stuff
+
+---
+ Text/Hamlet.hs |    5 +++++
+ 1 file changed, 5 insertions(+)
+
+diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs
+index 6568d6c..687dec4 100644
+--- a/Text/Hamlet.hs
++++ b/Text/Hamlet.hs
+@@ -40,6 +40,11 @@ module Text.Hamlet
+     , ihamletRules
+     , htmlRules
+     , CloseStyle (..)
++    -- referred to by TH splices
++    , asHtmlUrl
++    , maybeH
++    , condH
++    , attrsToHtml
+     ) where
+ 
+ import Text.Shakespeare.Base
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/lens_3.8.5-0001-build-without-TH.patch b/standalone/android/haskell-patches/lens_various-hacking-to-cross-build.patch
similarity index 54%
rename from standalone/android/haskell-patches/lens_3.8.5-0001-build-without-TH.patch
rename to standalone/android/haskell-patches/lens_various-hacking-to-cross-build.patch
index 62efccc322..734da87084 100644
--- a/standalone/android/haskell-patches/lens_3.8.5-0001-build-without-TH.patch
+++ b/standalone/android/haskell-patches/lens_various-hacking-to-cross-build.patch
@@ -1,27 +1,30 @@
-From bbb49942123f06a36b170966e445692297f71d26 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 18 Apr 2013 19:14:30 -0400
-Subject: [PATCH] build without TH
+From 3141355f14d6acb9382bebcf8723c411be5aa62f Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sun, 22 Sep 2013 00:31:39 +0000
+Subject: [PATCH] various hacking to cross build
 
 ---
- lens.cabal                          | 13 +------------
- src/Control/Exception/Lens.hs       |  2 +-
- src/Control/Lens.hs                 |  6 +++---
- src/Control/Lens/Equality.hs        |  4 ++--
- src/Control/Lens/Fold.hs            |  6 +++---
- src/Control/Lens/Internal.hs        |  2 +-
- src/Control/Lens/Internal/Zipper.hs |  2 +-
- src/Control/Lens/Iso.hs             |  2 --
- src/Control/Lens/Lens.hs            |  2 +-
- src/Control/Lens/Operators.hs       |  2 +-
- src/Control/Lens/Plated.hs          |  2 +-
- src/Control/Lens/Setter.hs          |  2 --
- src/Control/Lens/TH.hs              |  2 +-
- src/Data/Data/Lens.hs               |  6 +++---
- 14 files changed, 19 insertions(+), 34 deletions(-)
+ lens.cabal                             |   12 +-----------
+ src/Control/Exception/Lens.hs          |    2 +-
+ src/Control/Lens.hs                    |    6 +++---
+ src/Control/Lens/Equality.hs           |    4 ++--
+ src/Control/Lens/Fold.hs               |    6 +++---
+ src/Control/Lens/Internal.hs           |    2 +-
+ src/Control/Lens/Internal/Exception.hs |   26 +-------------------------
+ src/Control/Lens/Internal/Instances.hs |   14 --------------
+ src/Control/Lens/Internal/Zipper.hs    |    2 +-
+ src/Control/Lens/Iso.hs                |    2 --
+ src/Control/Lens/Lens.hs               |    2 +-
+ src/Control/Lens/Operators.hs          |    2 +-
+ src/Control/Lens/Plated.hs             |    2 +-
+ src/Control/Lens/Prism.hs              |    2 --
+ src/Control/Lens/Setter.hs             |    2 --
+ src/Control/Lens/TH.hs                 |    2 +-
+ src/Data/Data/Lens.hs                  |    6 +++---
+ 17 files changed, 20 insertions(+), 74 deletions(-)
 
 diff --git a/lens.cabal b/lens.cabal
-index a06b3ce..a654b3d 100644
+index 2a94e1e..1f9a4b7 100644
 --- a/lens.cabal
 +++ b/lens.cabal
 @@ -10,7 +10,7 @@ stability:     provisional
@@ -33,15 +36,7 @@ index a06b3ce..a654b3d 100644
  tested-with:   GHC == 7.0.4, GHC == 7.4.1, GHC == 7.4.2, GHC == 7.6.1, GHC == 7.7.20121213, GHC == 7.7.20130117
  synopsis:      Lenses, Folds and Traversals
  description:
-@@ -171,7 +171,6 @@ library
-     containers                >= 0.4.0    && < 0.6,
-     distributive              >= 0.3      && < 1,
-     filepath                  >= 1.2.0.0  && < 1.4,
--    generic-deriving          == 1.4.*,
-     ghc-prim,
-     hashable                  >= 1.1.2.3  && < 1.3,
-     MonadCatchIO-transformers >= 0.3      && < 0.4,
-@@ -233,14 +232,12 @@ library
+@@ -238,14 +238,12 @@ library
      Control.Lens.Review
      Control.Lens.Setter
      Control.Lens.Simple
@@ -56,7 +51,7 @@ index a06b3ce..a654b3d 100644
      Control.Parallel.Strategies.Lens
      Control.Seq.Lens
      Data.Array.Lens
-@@ -264,12 +261,8 @@ library
+@@ -269,12 +267,8 @@ library
      Data.Typeable.Lens
      Data.Vector.Lens
      Data.Vector.Generic.Lens
@@ -69,7 +64,7 @@ index a06b3ce..a654b3d 100644
      Numeric.Lens
  
    if flag(safe)
-@@ -368,7 +361,6 @@ test-suite doctests
+@@ -373,7 +367,6 @@ test-suite doctests
        deepseq,
        doctest        >= 0.9.1,
        filepath,
@@ -77,7 +72,7 @@ index a06b3ce..a654b3d 100644
        mtl,
        nats,
        parallel,
-@@ -394,7 +386,6 @@ benchmark plated
+@@ -399,7 +392,6 @@ benchmark plated
      comonad,
      criterion,
      deepseq,
@@ -85,7 +80,7 @@ index a06b3ce..a654b3d 100644
      lens,
      transformers
  
-@@ -429,7 +420,6 @@ benchmark unsafe
+@@ -434,7 +426,6 @@ benchmark unsafe
      comonads-fd,
      criterion,
      deepseq,
@@ -93,7 +88,7 @@ index a06b3ce..a654b3d 100644
      lens,
      transformers
  
-@@ -446,6 +436,5 @@ benchmark zipper
+@@ -451,6 +442,5 @@ benchmark zipper
      comonads-fd,
      criterion,
      deepseq,
@@ -101,7 +96,7 @@ index a06b3ce..a654b3d 100644
      lens,
      transformers
 diff --git a/src/Control/Exception/Lens.hs b/src/Control/Exception/Lens.hs
-index 5c26d4e..9909132 100644
+index 4bc3926..28f55be 100644
 --- a/src/Control/Exception/Lens.hs
 +++ b/src/Control/Exception/Lens.hs
 @@ -112,7 +112,7 @@ import Prelude
@@ -114,7 +109,7 @@ index 5c26d4e..9909132 100644
  -- $setup
  -- >>> :set -XNoOverloadedStrings
 diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs
-index 8481e44..74700ae 100644
+index 242c3c1..2ab9cdb 100644
 --- a/src/Control/Lens.hs
 +++ b/src/Control/Lens.hs
 @@ -59,7 +59,7 @@ module Control.Lens
@@ -157,10 +152,10 @@ index 982c2d7..3a3fe1a 100644
  -- $setup
  -- >>> import Control.Lens
 diff --git a/src/Control/Lens/Fold.hs b/src/Control/Lens/Fold.hs
-index ae5100d..467eb37 100644
+index 32a4073..cc7da1e 100644
 --- a/src/Control/Lens/Fold.hs
 +++ b/src/Control/Lens/Fold.hs
-@@ -161,9 +161,9 @@ import Data.Traversable
+@@ -163,9 +163,9 @@ import Data.Traversable
  -- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g
  -- >>> let timingOut :: NFData a => a -> IO a; timingOut = fmap (fromMaybe (error "timeout")) . timeout (5*10^6) . evaluate . force
  
@@ -183,6 +178,90 @@ index 295662e..539642d 100644
  
 -{-# ANN module "HLint: ignore Use import/export shortcut" #-}
 +
+diff --git a/src/Control/Lens/Internal/Exception.hs b/src/Control/Lens/Internal/Exception.hs
+index 387203e..8bea89b 100644
+--- a/src/Control/Lens/Internal/Exception.hs
++++ b/src/Control/Lens/Internal/Exception.hs
+@@ -36,6 +36,7 @@ import Data.Monoid
+ import Data.Proxy
+ import Data.Reflection
+ import Data.Typeable
++import Data.Typeable
+ import System.IO.Unsafe
+ 
+ ------------------------------------------------------------------------------
+@@ -128,18 +129,6 @@ class Handleable e (m :: * -> *) (h :: * -> *) | h -> e m where
+   handler_ l = handler l . const
+   {-# INLINE handler_ #-}
+ 
+-instance Handleable SomeException IO Exception.Handler where
+-  handler = handlerIO
+-
+-instance Handleable SomeException m (CatchIO.Handler m) where
+-  handler = handlerCatchIO
+-
+-handlerIO :: forall a r. Getting (First a) SomeException a -> (a -> IO r) -> Exception.Handler r
+-handlerIO l f = reify (preview l) $ \ (_ :: Proxy s) -> Exception.Handler (\(Handling a :: Handling a s IO) -> f a)
+-
+-handlerCatchIO :: forall m a r. Getting (First a) SomeException a -> (a -> m r) -> CatchIO.Handler m r
+-handlerCatchIO l f = reify (preview l) $ \ (_ :: Proxy s) -> CatchIO.Handler (\(Handling a :: Handling a s m) -> f a)
+-
+ ------------------------------------------------------------------------------
+ -- Helpers
+ ------------------------------------------------------------------------------
+@@ -159,21 +148,8 @@ supply = unsafePerformIO $ newIORef 0
+ -- | This permits the construction of an \"impossible\" 'Control.Exception.Handler' that matches only if some function does.
+ newtype Handling a s (m :: * -> *) = Handling a
+ 
+--- the m parameter exists simply to break the Typeable1 pattern, so we can provide this without overlap.
+--- here we simply generate a fresh TypeRep so we'll fail to compare as equal to any other TypeRep.
+-instance Typeable (Handling a s m) where
+-  typeOf _ = unsafePerformIO $ do
+-    i <- atomicModifyIORef supply $ \a -> let a' = a + 1 in a' `seq` (a', a)
+-    return $ mkTyConApp (mkTyCon3 "lens" "Control.Lens.Internal.Exception" ("Handling" ++ show i)) []
+-  {-# INLINE typeOf #-}
+-
+ -- The @Handling@ wrapper is uninteresting, and should never be thrown, so you won't get much benefit here.
+ instance Show (Handling a s m) where
+   showsPrec d _ = showParen (d > 10) $ showString "Handling ..."
+   {-# INLINE showsPrec #-}
+ 
+-instance Reifies s (SomeException -> Maybe a) => Exception (Handling a s m) where
+-  toException _ = SomeException HandlingException
+-  {-# INLINE toException #-}
+-  fromException = fmap Handling . reflect (Proxy :: Proxy s)
+-  {-# INLINE fromException #-}
+diff --git a/src/Control/Lens/Internal/Instances.hs b/src/Control/Lens/Internal/Instances.hs
+index 6783f33..17715ce 100644
+--- a/src/Control/Lens/Internal/Instances.hs
++++ b/src/Control/Lens/Internal/Instances.hs
+@@ -24,26 +24,12 @@ import Data.Traversable
+ -- Orphan Instances
+ -------------------------------------------------------------------------------
+ 
+-instance Foldable ((,) b) where
+-  foldMap f (_, a) = f a
+-
+ instance Foldable1 ((,) b) where
+   foldMap1 f (_, a) = f a
+ 
+-instance Traversable ((,) b) where
+-  traverse f (b, a) = (,) b <$> f a
+-
+ instance Traversable1 ((,) b) where
+   traverse1 f (b, a) = (,) b <$> f a
+ 
+-instance Foldable (Either a) where
+-  foldMap _ (Left _) = mempty
+-  foldMap f (Right a) = f a
+-
+-instance Traversable (Either a) where
+-  traverse _ (Left b) = pure (Left b)
+-  traverse f (Right a) = Right <$> f a
+-
+ instance Foldable (Const m) where
+   foldMap _ _ = mempty
+ 
 diff --git a/src/Control/Lens/Internal/Zipper.hs b/src/Control/Lens/Internal/Zipper.hs
 index 95875b7..76060be 100644
 --- a/src/Control/Lens/Internal/Zipper.hs
@@ -197,12 +276,12 @@ index 95875b7..76060be 100644
  ------------------------------------------------------------------------------
  -- * Jacket
 diff --git a/src/Control/Lens/Iso.hs b/src/Control/Lens/Iso.hs
-index 62d40ef..235511a 100644
+index 1152af4..80c3175 100644
 --- a/src/Control/Lens/Iso.hs
 +++ b/src/Control/Lens/Iso.hs
-@@ -70,8 +70,6 @@ import Data.Profunctor.Unsafe
- import Unsafe.Coerce
- #endif
+@@ -82,8 +82,6 @@ import Data.Maybe
+ import Data.Profunctor
+ import Data.Profunctor.Unsafe
  
 -{-# ANN module "HLint: ignore Use on" #-}
 -
@@ -210,12 +289,12 @@ index 62d40ef..235511a 100644
  -- >>> :set -XNoOverloadedStrings
  -- >>> import Control.Lens
 diff --git a/src/Control/Lens/Lens.hs b/src/Control/Lens/Lens.hs
-index ff2a45f..5401ec4 100644
+index b26cc06..6f84943 100644
 --- a/src/Control/Lens/Lens.hs
 +++ b/src/Control/Lens/Lens.hs
-@@ -120,7 +120,7 @@ import Data.Profunctor
- import Data.Profunctor.Rep
+@@ -126,7 +126,7 @@ import Data.Profunctor.Rep
  import Data.Profunctor.Unsafe
+ import Data.Void
  
 -{-# ANN module "HLint: ignore Use ***" #-}
 +
@@ -223,17 +302,17 @@ index ff2a45f..5401ec4 100644
  -- $setup
  -- >>> :set -XNoOverloadedStrings
 diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs
-index d88cb49..fa7b37e 100644
+index 11868e0..475c945 100644
 --- a/src/Control/Lens/Operators.hs
 +++ b/src/Control/Lens/Operators.hs
-@@ -107,4 +107,4 @@ import Control.Lens.Review
+@@ -108,4 +108,4 @@ import Control.Lens.Review
  import Control.Lens.Setter
  import Control.Lens.Zipper
  
 -{-# ANN module "HLint: ignore Use import/export shortcut" #-}
 +
 diff --git a/src/Control/Lens/Plated.hs b/src/Control/Lens/Plated.hs
-index 07d9212..27070c0 100644
+index a8c4d20..cef574e 100644
 --- a/src/Control/Lens/Plated.hs
 +++ b/src/Control/Lens/Plated.hs
 @@ -95,7 +95,7 @@ import           Data.Data.Lens
@@ -245,6 +324,19 @@ index 07d9212..27070c0 100644
  
  -- | A 'Plated' type is one where we know how to extract its immediate self-similar children.
  --
+diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs
+index 45b5cfe..88c7ff9 100644
+--- a/src/Control/Lens/Prism.hs
++++ b/src/Control/Lens/Prism.hs
+@@ -53,8 +53,6 @@ import Unsafe.Coerce
+ import Data.Profunctor.Unsafe
+ #endif
+ 
+-{-# ANN module "HLint: ignore Use camelCase" #-}
+-
+ -- $setup
+ -- >>> :set -XNoOverloadedStrings
+ -- >>> import Control.Lens
 diff --git a/src/Control/Lens/Setter.hs b/src/Control/Lens/Setter.hs
 index 2acbfa6..4a12c6b 100644
 --- a/src/Control/Lens/Setter.hs
@@ -259,7 +351,7 @@ index 2acbfa6..4a12c6b 100644
  -- >>> import Control.Lens
  -- >>> import Control.Monad.State
 diff --git a/src/Control/Lens/TH.hs b/src/Control/Lens/TH.hs
-index fbf4adb..ee723d7 100644
+index a05eb07..49218b5 100644
 --- a/src/Control/Lens/TH.hs
 +++ b/src/Control/Lens/TH.hs
 @@ -87,7 +87,7 @@ import Language.Haskell.TH
@@ -289,5 +381,5 @@ index cf1e7c9..b39dacf 100644
  -- $setup
  -- >>> :set -XNoOverloadedStrings
 -- 
-1.8.2.rc3
+1.7.10.4
 
diff --git a/standalone/android/haskell-patches/libxml-sax_0.7.3-0001-static-link-with-libxml2.patch b/standalone/android/haskell-patches/libxml-sax_0.7.3-0001-static-link-with-libxml2.patch
deleted file mode 100644
index 752f601cc7..0000000000
--- a/standalone/android/haskell-patches/libxml-sax_0.7.3-0001-static-link-with-libxml2.patch
+++ /dev/null
@@ -1,27 +0,0 @@
-From 9d53e3fa4516a948a6e84987e9c1c9fd07f973bf Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Sun, 21 Apr 2013 15:44:51 -0400
-Subject: [PATCH] static link with libxml2
-
-This requires libxml2.a (and no .so) be installed in the ugly hardcoded
-lib dir. When built this way, the haskell library will link the
-C library into executables with no further options.
----
- libxml-sax.cabal |    1 +
- 1 file changed, 1 insertion(+)
-
-diff --git a/libxml-sax.cabal b/libxml-sax.cabal
-index 5edfdb6..338bc55 100644
---- a/libxml-sax.cabal
-+++ b/libxml-sax.cabal
-@@ -31,6 +31,7 @@ library
-   hs-source-dirs: lib
-   ghc-options: -Wall -O2
-   cc-options: -Wall
-+  LD-Options: -L /home/joey/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/sysroot/usr/lib/
- 
-   build-depends:
-       base >= 4.1 && < 5.0
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/lifted-base_0.2.0.2_0001-hacked-for-newer-ghc.patch b/standalone/android/haskell-patches/lifted-base_0.2.0.2_0001-hacked-for-newer-ghc.patch
deleted file mode 100644
index b61dc17ba9..0000000000
--- a/standalone/android/haskell-patches/lifted-base_0.2.0.2_0001-hacked-for-newer-ghc.patch
+++ /dev/null
@@ -1,163 +0,0 @@
-From 4bb0de1e6213ec925820c8b9cc3ff5f3c3c72d7a Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:31:27 -0400
-Subject: [PATCH] hacked for newer ghc
-
----
- Control/Concurrent/Lifted.hs |    2 +-
- Control/Exception/Lifted.hs  |   11 ++--------
- Setup.hs                     |   46 ++----------------------------------------
- lifted-base.cabal            |    9 ++++-----
- 4 files changed, 9 insertions(+), 59 deletions(-)
-
-diff --git a/Control/Concurrent/Lifted.hs b/Control/Concurrent/Lifted.hs
-index 4bc58a8..e4445e6 100644
---- a/Control/Concurrent/Lifted.hs
-+++ b/Control/Concurrent/Lifted.hs
-@@ -124,7 +124,7 @@ import Control.Concurrent.SampleVar.Lifted
- #endif
- import Control.Exception.Lifted ( throwTo
- #if MIN_VERSION_base(4,6,0)
--                                , SomeException, try, mask
-+                                , SomeException, try
- #endif
-                                 )
- #include "inlinable.h"
-diff --git a/Control/Exception/Lifted.hs b/Control/Exception/Lifted.hs
-index 871cda7..0b9d8b7 100644
---- a/Control/Exception/Lifted.hs
-+++ b/Control/Exception/Lifted.hs
-@@ -50,8 +50,8 @@ module Control.Exception.Lifted
-       -- |The following functions allow a thread to control delivery of
-       -- asynchronous exceptions during a critical region.
- #if MIN_VERSION_base(4,3,0)
--    , mask, mask_
--    , uninterruptibleMask, uninterruptibleMask_
-+    , mask_
-+    , uninterruptibleMask_
-     , getMaskingState
- #if MIN_VERSION_base(4,4,0)
-     , allowInterrupt
-@@ -266,10 +266,6 @@ evaluate = liftBase ∘ E.evaluate
- --------------------------------------------------------------------------------
- 
- #if MIN_VERSION_base(4,3,0)
---- |Generalized version of 'E.mask'.
--mask ∷ MonadBaseControl IO m ⇒ ((∀ a. m a → m a) → m b) → m b
--mask = liftBaseOp E.mask ∘ liftRestore
--{-# INLINABLE mask #-}
- 
- liftRestore ∷ MonadBaseControl IO m
-             ⇒ ((∀ a.  m a →  m a) → b)
-@@ -283,9 +279,6 @@ mask_ = liftBaseOp_ E.mask_
- {-# INLINABLE mask_ #-}
- 
- -- |Generalized version of 'E.uninterruptibleMask'.
--uninterruptibleMask ∷ MonadBaseControl IO m ⇒ ((∀ a. m a → m a) → m b) → m b
--uninterruptibleMask = liftBaseOp E.uninterruptibleMask ∘ liftRestore
--{-# INLINABLE uninterruptibleMask #-}
- 
- -- |Generalized version of 'E.uninterruptibleMask_'.
- uninterruptibleMask_ ∷ MonadBaseControl IO m ⇒ m a → m a
-diff --git a/Setup.hs b/Setup.hs
-index 33956e1..9a994af 100644
---- a/Setup.hs
-+++ b/Setup.hs
-@@ -1,44 +1,2 @@
--#! /usr/bin/env runhaskell
--
--{-# LANGUAGE NoImplicitPrelude, UnicodeSyntax #-}
--
--module Main (main) where
--
--
---------------------------------------------------------------------------------
---- Imports
---------------------------------------------------------------------------------
--
---- from base
--import System.IO ( IO )
--
---- from cabal
--import Distribution.Simple ( defaultMainWithHooks
--                           , simpleUserHooks
--                           , UserHooks(haddockHook)
--                           )
--
--import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
--import Distribution.Simple.Program        ( userSpecifyArgs )
--import Distribution.Simple.Setup          ( HaddockFlags )
--import Distribution.PackageDescription    ( PackageDescription(..) )
--
--
---------------------------------------------------------------------------------
---- Cabal setup program which sets the CPP define '__HADDOCK __' when haddock is run.
---------------------------------------------------------------------------------
--
--main ∷ IO ()
--main = defaultMainWithHooks hooks
--  where
--    hooks = simpleUserHooks { haddockHook = haddockHook' }
--
---- Define __HADDOCK__ for CPP when running haddock.
--haddockHook' ∷ PackageDescription → LocalBuildInfo → UserHooks → HaddockFlags → IO ()
--haddockHook' pkg lbi =
--  haddockHook simpleUserHooks pkg (lbi { withPrograms = p })
--  where
--    p = userSpecifyArgs "haddock" ["--optghc=-D__HADDOCK__"] (withPrograms lbi)
--
--
---- The End ---------------------------------------------------------------------
-+import Distribution.Simple
-+main = defaultMain
-diff --git a/lifted-base.cabal b/lifted-base.cabal
-index 54ef418..8da5086 100644
---- a/lifted-base.cabal
-+++ b/lifted-base.cabal
-@@ -9,7 +9,7 @@ Copyright:           (c) 2011-2012 Bas van Dijk, Anders Kaseorg
- Homepage:            https://github.com/basvandijk/lifted-base
- Bug-reports:         https://github.com/basvandijk/lifted-base/issues
- Category:            Control
--Build-type:          Custom
-+Build-type:          Simple
- Cabal-version:       >= 1.9.2
- Description:         @lifted-base@ exports IO operations from the base library lifted to
-                      any instance of 'MonadBase' or 'MonadBaseControl'.
-@@ -37,7 +37,6 @@ Library
-   Exposed-modules: Control.Exception.Lifted
-                    Control.Concurrent.MVar.Lifted
-                    Control.Concurrent.Chan.Lifted
--                   Control.Concurrent.Lifted
-                    Data.IORef.Lifted
-                    System.Timeout.Lifted
-   if impl(ghc < 7.6)
-@@ -46,7 +45,7 @@ Library
-                    Control.Concurrent.QSemN.Lifted
-                    Control.Concurrent.SampleVar.Lifted
- 
--  Build-depends: base                 >= 3     && < 4.7
-+  Build-depends: base                 >= 3     && < 4.8
-                , base-unicode-symbols >= 0.1.1 && < 0.3
-                , transformers-base    >= 0.4   && < 0.5
-                , monad-control        >= 0.3   && < 0.4
-@@ -64,7 +63,7 @@ test-suite test-lifted-base
-   hs-source-dirs: test
- 
-   build-depends: lifted-base
--               , base                 >= 3     && < 4.7
-+               , base                 >= 3     && < 4.8
-                , transformers         >= 0.2   && < 0.4
-                , transformers-base    >= 0.4   && < 0.5
-                , monad-control        >= 0.3   && < 0.4
-@@ -87,7 +86,7 @@ benchmark bench-lifted-base
-   ghc-options:    -O2
- 
-   build-depends: lifted-base
--               , base          >= 3   && < 4.7
-+               , base          >= 3   && < 4.8
-                , transformers  >= 0.2 && < 0.4
-                , criterion     >= 0.5 && < 0.7
-                , monad-control >= 0.3 && < 0.4
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/lifted-base_crossbuild.patch b/standalone/android/haskell-patches/lifted-base_crossbuild.patch
new file mode 100644
index 0000000000..945aee4913
--- /dev/null
+++ b/standalone/android/haskell-patches/lifted-base_crossbuild.patch
@@ -0,0 +1,25 @@
+From 8a98fa29048b508c64d5bb1e03ef89bfad8adc01 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sat, 21 Sep 2013 21:34:17 +0000
+Subject: [PATCH] crossbuild
+
+---
+ lifted-base.cabal |    2 +-
+ 1 file changed, 1 insertion(+), 1 deletion(-)
+
+diff --git a/lifted-base.cabal b/lifted-base.cabal
+index 24f2860..3bef225 100644
+--- a/lifted-base.cabal
++++ b/lifted-base.cabal
+@@ -9,7 +9,7 @@ Copyright:           (c) 2011-2012 Bas van Dijk, Anders Kaseorg
+ Homepage:            https://github.com/basvandijk/lifted-base
+ Bug-reports:         https://github.com/basvandijk/lifted-base/issues
+ Category:            Control
+-Build-type:          Custom
++Build-type:          Simple
+ Cabal-version:       >= 1.8
+ Description:         @lifted-base@ exports IO operations from the base library lifted to
+                      any instance of 'MonadBase' or 'MonadBaseControl'.
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/monad-control_0.3.1.4_0001-build-with-newer-ghc.patch b/standalone/android/haskell-patches/monad-control_0.3.1.4_0001-build-with-newer-ghc.patch
deleted file mode 100644
index ee1c996d80..0000000000
--- a/standalone/android/haskell-patches/monad-control_0.3.1.4_0001-build-with-newer-ghc.patch
+++ /dev/null
@@ -1,25 +0,0 @@
-From 3dde0175096903207c9774d8f6bba9b81ab6c2f9 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:31:45 -0400
-Subject: [PATCH] build with newer ghc
-
----
- monad-control.cabal |    2 +-
- 1 file changed, 1 insertion(+), 1 deletion(-)
-
-diff --git a/monad-control.cabal b/monad-control.cabal
-index 2e3eb46..b12ffaf 100644
---- a/monad-control.cabal
-+++ b/monad-control.cabal
-@@ -56,7 +56,7 @@ Library
- 
-   Exposed-modules: Control.Monad.Trans.Control
- 
--  Build-depends: base                 >= 3     && < 4.7
-+  Build-depends: base                 >= 3     && < 4.8
-                , base-unicode-symbols >= 0.1.1 && < 0.3
-                , transformers         >= 0.2   && < 0.4
-                , transformers-base    >= 0.4.1 && < 0.5
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/monad-logger_0.2.3.2_0001-remove-TH-logging-stuff.patch b/standalone/android/haskell-patches/monad-logger_0.2.3.2_0001-remove-TH-logging-stuff.patch
deleted file mode 100644
index e684c67a79..0000000000
--- a/standalone/android/haskell-patches/monad-logger_0.2.3.2_0001-remove-TH-logging-stuff.patch
+++ /dev/null
@@ -1,124 +0,0 @@
-From ca88563e63cc31f0b96b00d3a4fe1f0c56b1e1eb Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:32:01 -0400
-Subject: [PATCH] remove TH logging stuff
-
----
- Control/Monad/Logger.hs |   76 -----------------------------------------------
- monad-logger.cabal      |    2 +-
- 2 files changed, 1 insertion(+), 77 deletions(-)
-
-diff --git a/Control/Monad/Logger.hs b/Control/Monad/Logger.hs
-index fd1282b..80b8ed9 100644
---- a/Control/Monad/Logger.hs
-+++ b/Control/Monad/Logger.hs
-@@ -27,18 +27,6 @@ module Control.Monad.Logger
-     , LoggingT (..)
-     , runStderrLoggingT
-     , runStdoutLoggingT
--    -- * TH logging
--    , logDebug
--    , logInfo
--    , logWarn
--    , logError
--    , logOther
--    -- * TH logging with source
--    , logDebugS
--    , logInfoS
--    , logWarnS
--    , logErrorS
--    , logOtherS
-     ) where
- 
- import Language.Haskell.TH.Syntax (Lift (lift), Q, Exp, Loc (..), qLocation)
-@@ -91,13 +79,6 @@ import Control.Monad.Writer.Class ( MonadWriter (..) )
- data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text
-     deriving (Eq, Prelude.Show, Prelude.Read, Ord)
- 
--instance Lift LogLevel where
--    lift LevelDebug = [|LevelDebug|]
--    lift LevelInfo = [|LevelInfo|]
--    lift LevelWarn = [|LevelWarn|]
--    lift LevelError = [|LevelError|]
--    lift (LevelOther x) = [|LevelOther $ pack $(lift $ unpack x)|]
--
- type LogSource = Text
- 
- class Monad m => MonadLogger m where
-@@ -128,63 +109,6 @@ instance (MonadLogger m, Monoid w) => MonadLogger (Strict.WriterT w m) where DEF
- instance (MonadLogger m, Monoid w) => MonadLogger (Strict.RWST r w s m) where DEF
- #undef DEF
- 
--logTH :: LogLevel -> Q Exp
--logTH level =
--    [|monadLoggerLog $(qLocation >>= liftLoc) $(lift level) . (id :: Text -> Text)|]
--
---- | Generates a function that takes a 'Text' and logs a 'LevelDebug' message. Usage:
----
---- > $(logDebug) "This is a debug log message"
--logDebug :: Q Exp
--logDebug = logTH LevelDebug
--
---- | See 'logDebug'
--logInfo :: Q Exp
--logInfo = logTH LevelInfo
---- | See 'logDebug'
--logWarn :: Q Exp
--logWarn = logTH LevelWarn
---- | See 'logDebug'
--logError :: Q Exp
--logError = logTH LevelError
--
---- | Generates a function that takes a 'Text' and logs a 'LevelOther' message. Usage:
----
---- > $(logOther "My new level") "This is a log message"
--logOther :: Text -> Q Exp
--logOther = logTH . LevelOther
--
--liftLoc :: Loc -> Q Exp
--liftLoc (Loc a b c (d1, d2) (e1, e2)) = [|Loc
--    $(lift a)
--    $(lift b)
--    $(lift c)
--    ($(lift d1), $(lift d2))
--    ($(lift e1), $(lift e2))
--    |]
--
---- | Generates a function that takes a 'LogSource' and 'Text' and logs a 'LevelDebug' message. Usage:
----
---- > $logDebug "SomeSource" "This is a debug log message"
--logDebugS :: Q Exp
--logDebugS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelDebug (b :: Text)|]
--
---- | See 'logDebugS'
--logInfoS :: Q Exp
--logInfoS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelInfo (b :: Text)|]
---- | See 'logDebugS'
--logWarnS :: Q Exp
--logWarnS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelWarn (b :: Text)|]
---- | See 'logDebugS'
--logErrorS :: Q Exp
--logErrorS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelError (b :: Text)|]
--
---- | Generates a function that takes a 'LogSource', a level name and a 'Text' and logs a 'LevelOther' message. Usage:
----
---- > $logOther "SomeSource" "My new level" "This is a log message"
--logOtherS :: Q Exp
--logOtherS = [|\src level msg -> monadLoggerLogSource $(qLocation >>= liftLoc) src (LevelOther level) (msg :: Text)|]
--
- -- | Monad transformer that adds a new logging function.
- --
- -- Since 0.2.2
-diff --git a/monad-logger.cabal b/monad-logger.cabal
-index ab71424..fa3d292 100644
---- a/monad-logger.cabal
-+++ b/monad-logger.cabal
-@@ -24,4 +24,4 @@ library
-                      , transformers-base
-                      , monad-control
-                      , mtl
--                     , bytestring
-+                     , bytestring >= 0.10.3.0
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/network-conduit_0.6.2.2_0001-NoDelay-does-not-work-on-Android.patch b/standalone/android/haskell-patches/network-conduit_0.6.2.2_0001-NoDelay-does-not-work-on-Android.patch
deleted file mode 100644
index 35bafa774f..0000000000
--- a/standalone/android/haskell-patches/network-conduit_0.6.2.2_0001-NoDelay-does-not-work-on-Android.patch
+++ /dev/null
@@ -1,43 +0,0 @@
-From 3e05f3a3bf886c302fb6d6caa7ee92cf9736b6ad Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:33:45 -0400
-Subject: [PATCH] NoDelay does not work on Android
-
-(I think the other change is no-op)
----
- Data/Conduit/Network/Utils.hs |    6 +++---
- 1 file changed, 3 insertions(+), 3 deletions(-)
-
-diff --git a/Data/Conduit/Network/Utils.hs b/Data/Conduit/Network/Utils.hs
-index 32a7286..01ff84e 100644
---- a/Data/Conduit/Network/Utils.hs
-+++ b/Data/Conduit/Network/Utils.hs
-@@ -6,14 +6,14 @@ module Data.Conduit.Network.Utils
-     , getSocket
-     ) where
- 
--import Network.Socket (AddrInfo, Socket, SocketType)
-+import Network.Socket (Socket, SocketType)
- import qualified Network.Socket as NS
- import Data.String (IsString (fromString))
- import Control.Exception (bracketOnError, IOException)
- import qualified Control.Exception as E
- 
- -- | Attempt to connect to the given host/port using given @SocketType@.
--getSocket :: String -> Int -> SocketType -> IO (Socket, AddrInfo)
-+getSocket :: String -> Int -> SocketType -> IO (Socket, NS.AddrInfo)
- getSocket host' port' sockettype = do
-     let hints = NS.defaultHints {
-                           NS.addrFlags = [NS.AI_ADDRCONFIG]
-@@ -93,7 +93,7 @@ bindPort p s sockettype = do
-         sockOpts =
-             case sockettype of
-                 NS.Datagram -> [(NS.ReuseAddr,1)]
--                _           -> [(NS.NoDelay,1), (NS.ReuseAddr,1)]
-+                _           -> [(NS.ReuseAddr,1)] -- Android seems to not have NoDelay
- 
-         theBody addr =
-           bracketOnError
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/network-protocol-xmpp_0.4.4-0001-avoid-using-gnuidn.patch b/standalone/android/haskell-patches/network-protocol-xmpp_0.4.4-0001-avoid-using-gnuidn.patch
deleted file mode 100644
index 26734fa708..0000000000
--- a/standalone/android/haskell-patches/network-protocol-xmpp_0.4.4-0001-avoid-using-gnuidn.patch
+++ /dev/null
@@ -1,60 +0,0 @@
-From d15ae2193eff9cd38ebce641279996233434b50f Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Sun, 21 Apr 2013 16:05:53 -0400
-Subject: [PATCH] avoid using gnuidn
-
-IDN is only used to handle the domain name part of a XMPP server JID.
-Which seems not worth the bloat on Android.
----
- lib/Network/Protocol/XMPP/JID.hs |   11 ++++-------
- network-protocol-xmpp.cabal      |    1 -
- 2 files changed, 4 insertions(+), 8 deletions(-)
-
-diff --git a/lib/Network/Protocol/XMPP/JID.hs b/lib/Network/Protocol/XMPP/JID.hs
-index 91745e0..2a50409 100644
---- a/lib/Network/Protocol/XMPP/JID.hs
-+++ b/lib/Network/Protocol/XMPP/JID.hs
-@@ -29,7 +29,6 @@ module Network.Protocol.XMPP.JID
- 
- import qualified Data.Text
- import           Data.Text (Text)
--import qualified Data.Text.IDN.StringPrep as SP
- import           Data.String (IsString, fromString)
- 
- newtype Node = Node { strNode :: Text }
-@@ -85,16 +84,14 @@ parseJID str = maybeJID where
- 		then Just Nothing
- 		else fmap Just (f x)
- 	maybeJID = do
--		preppedNode <- nullable node (stringprepM SP.xmppNode)
--		preppedDomain <- stringprepM SP.nameprep domain
--		preppedResource <- nullable resource (stringprepM SP.xmppResource)
-+		preppedNode <- nullable node (stringprepM id)
-+		preppedDomain <- stringprepM id domain
-+		preppedResource <- nullable resource (stringprepM id)
- 		return $ JID
- 			(fmap Node preppedNode)
- 			(Domain preppedDomain)
- 			(fmap Resource preppedResource)
--	stringprepM p x = case SP.stringprep p SP.defaultFlags x of
--		Left _ -> Nothing
--		Right y -> Just y
-+	stringprepM p x = Just x
- 
- parseJID_ :: Text -> JID
- parseJID_ text = case parseJID text of
-diff --git a/network-protocol-xmpp.cabal b/network-protocol-xmpp.cabal
-index 807cda9..3aaad67 100644
---- a/network-protocol-xmpp.cabal
-+++ b/network-protocol-xmpp.cabal
-@@ -30,7 +30,6 @@ library
-   build-depends:
-       base >= 4.0 && < 5.0
-     , bytestring >= 0.9
--    , gnuidn >= 0.2 && < 0.3
-     , gnutls >= 0.1.4 && < 0.3
-     , gsasl >= 0.3 && < 0.4
-     , libxml-sax >= 0.7 && < 0.8
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/persistent-template_stub-out.patch b/standalone/android/haskell-patches/persistent-template_stub-out.patch
new file mode 100644
index 0000000000..6b7b62bd4a
--- /dev/null
+++ b/standalone/android/haskell-patches/persistent-template_stub-out.patch
@@ -0,0 +1,25 @@
+From 0b9df0de3aa45918a2a9226a2da6be4680276419 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sun, 22 Sep 2013 03:31:55 +0000
+Subject: [PATCH] stub out
+
+---
+ persistent-template.cabal |    2 +-
+ 1 file changed, 1 insertion(+), 1 deletion(-)
+
+diff --git a/persistent-template.cabal b/persistent-template.cabal
+index 8216ce7..f23234b 100644
+--- a/persistent-template.cabal
++++ b/persistent-template.cabal
+@@ -23,7 +23,7 @@ library
+                    , containers
+                    , aeson
+                    , monad-logger
+-    exposed-modules: Database.Persist.TH
++    exposed-modules: 
+     ghc-options:     -Wall
+     if impl(ghc >= 7.4)
+        cpp-options: -DGHC_7_4
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch b/standalone/android/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch
index 38cecc5c72..300975b83c 100644
--- a/standalone/android/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch
+++ b/standalone/android/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch
@@ -1,71 +1,32 @@
-From 8fddef803ee9191ca15363283b7e4d5af4c70f3a Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:34:10 -0400
+From 760fa2c5044ae38bee8114ff84c625ac59f35c6f Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sun, 22 Sep 2013 00:03:55 +0000
 Subject: [PATCH] disable TH
 
 ---
- Database/Persist/GenericSql/Internal.hs |    6 +-----
- Database/Persist/GenericSql/Raw.hs      |    5 ++---
- 2 files changed, 3 insertions(+), 8 deletions(-)
+ Database/Persist/Sql/Raw.hs |    2 --
+ 1 file changed, 2 deletions(-)
 
-diff --git a/Database/Persist/GenericSql/Internal.hs b/Database/Persist/GenericSql/Internal.hs
-index f109887..5273398 100644
---- a/Database/Persist/GenericSql/Internal.hs
-+++ b/Database/Persist/GenericSql/Internal.hs
-@@ -14,7 +14,6 @@ module Database.Persist.GenericSql.Internal
-     , createSqlPool
-     , mkColumns
-     , Column (..)
--    , logSQL
-     , InsertSqlResult (..)
-     ) where
- 
-@@ -33,7 +32,7 @@ import Data.Monoid (Monoid, mappend, mconcat)
- import Database.Persist.EntityDef
- import qualified Data.Conduit as C
- import Language.Haskell.TH.Syntax (Q, Exp)
--import Control.Monad.Logger (logDebugS)
-+
- import Data.Maybe (mapMaybe, listToMaybe)
- import Data.Int (Int64)
- 
-@@ -197,6 +196,3 @@ tableColumn t s = go $ entityColumns t
-         | x == s = ColumnDef x y z
-         | otherwise = go rest
- -}
--
--logSQL :: Q Exp
--logSQL = [|\sql_foo params_foo -> $logDebugS (T.pack "SQL") $ T.pack $ show (sql_foo :: Text) ++ " " ++ show (params_foo :: [PersistValue])|]
-diff --git a/Database/Persist/GenericSql/Raw.hs b/Database/Persist/GenericSql/Raw.hs
-index e4bf9f4..3da8fa0 100644
---- a/Database/Persist/GenericSql/Raw.hs
-+++ b/Database/Persist/GenericSql/Raw.hs
-@@ -26,7 +26,6 @@ import Database.Persist.GenericSql.Internal hiding (execute, withStmt)
- import Database.Persist.Store (PersistValue)
- import Data.IORef
- import Control.Monad.IO.Class
--import Control.Monad.Logger (logDebugS)
- import Control.Monad.Trans.Reader
- import qualified Data.Map as Map
- import Control.Applicative (Applicative)
-@@ -134,7 +133,7 @@ withStmt :: (MonadSqlPersist m, MonadResource m)
+diff --git a/Database/Persist/Sql/Raw.hs b/Database/Persist/Sql/Raw.hs
+index 73189dd..6efebea 100644
+--- a/Database/Persist/Sql/Raw.hs
++++ b/Database/Persist/Sql/Raw.hs
+@@ -22,7 +22,6 @@ rawQuery :: (MonadSqlPersist m, MonadResource m)
           -> [PersistValue]
           -> Source m [PersistValue]
- withStmt sql vals = do
+ rawQuery sql vals = do
 -    lift $ $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals
-+    -- lift $  pack $ show sql ++ " " ++ show vals
      conn <- lift askSqlConn
      bracketP
-         (getStmt' conn sql)
-@@ -146,7 +145,7 @@ execute x y = liftM (const ()) $ executeCount x y
+         (getStmtConn conn sql)
+@@ -34,7 +33,6 @@ rawExecute x y = liftM (const ()) $ rawExecuteCount x y
  
- executeCount :: MonadSqlPersist m => Text -> [PersistValue] -> m Int64
- executeCount sql vals = do
+ rawExecuteCount :: MonadSqlPersist m => Text -> [PersistValue] -> m Int64
+ rawExecuteCount sql vals = do
 -    $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals
-+    -- pack $ show sql ++ " " ++ show vals
      stmt <- getStmt sql
-     res <- liftIO $ I.execute stmt vals
-     liftIO $ reset stmt
+     res <- liftIO $ stmtExecute stmt vals
+     liftIO $ stmtReset stmt
 -- 
 1.7.10.4
 
diff --git a/standalone/android/haskell-patches/primitive_fix-build-with-new-ghc.patch b/standalone/android/haskell-patches/primitive_fix-build-with-new-ghc.patch
new file mode 100644
index 0000000000..3f12965c17
--- /dev/null
+++ b/standalone/android/haskell-patches/primitive_fix-build-with-new-ghc.patch
@@ -0,0 +1,96 @@
+From 2b1ee45058b0d6db90f77e4859d01d1e8434906c Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sat, 21 Sep 2013 23:11:51 +0000
+Subject: [PATCH] fix build with new ghc
+
+---
+ Data/Primitive/Array.hs     |    2 +-
+ Data/Primitive/ByteArray.hs |    2 +-
+ Data/Primitive/MutVar.hs    |    4 ++--
+ Data/Primitive/Types.hs     |   13 +++++++------
+ 4 files changed, 11 insertions(+), 10 deletions(-)
+
+diff --git a/Data/Primitive/Array.hs b/Data/Primitive/Array.hs
+index b82dcac..b28abea 100644
+--- a/Data/Primitive/Array.hs
++++ b/Data/Primitive/Array.hs
+@@ -106,7 +106,7 @@ unsafeThawArray (Array arr#)
+ sameMutableArray :: MutableArray s a -> MutableArray s a -> Bool
+ {-# INLINE sameMutableArray #-}
+ sameMutableArray (MutableArray arr#) (MutableArray brr#)
+-  = sameMutableArray# arr# brr#
++  = tagToEnum# (sameMutableArray# arr# brr#)
+ 
+ -- | Copy a slice of an immutable array to a mutable array.
+ copyArray :: PrimMonad m
+diff --git a/Data/Primitive/ByteArray.hs b/Data/Primitive/ByteArray.hs
+index 2a47254..3a1ed6e 100644
+--- a/Data/Primitive/ByteArray.hs
++++ b/Data/Primitive/ByteArray.hs
+@@ -99,7 +99,7 @@ mutableByteArrayContents (MutableByteArray arr#)
+ sameMutableByteArray :: MutableByteArray s -> MutableByteArray s -> Bool
+ {-# INLINE sameMutableByteArray #-}
+ sameMutableByteArray (MutableByteArray arr#) (MutableByteArray brr#)
+-  = sameMutableByteArray# arr# brr#
++  = tagToEnum# (sameMutableByteArray# arr# brr#)
+ 
+ -- | Convert a mutable byte array to an immutable one without copying. The
+ -- array should not be modified after the conversion.
+diff --git a/Data/Primitive/MutVar.hs b/Data/Primitive/MutVar.hs
+index 9745ec7..eb654c9 100644
+--- a/Data/Primitive/MutVar.hs
++++ b/Data/Primitive/MutVar.hs
+@@ -23,7 +23,7 @@ module Data.Primitive.MutVar (
+ ) where
+ 
+ import Control.Monad.Primitive ( PrimMonad(..), primitive_ )
+-import GHC.Prim ( MutVar#, sameMutVar#, newMutVar#,
++import GHC.Prim ( MutVar#, sameMutVar#, newMutVar#, tagToEnum#,
+                   readMutVar#, writeMutVar#, atomicModifyMutVar# )
+ import Data.Typeable ( Typeable )
+ 
+@@ -33,7 +33,7 @@ data MutVar s a = MutVar (MutVar# s a)
+   deriving ( Typeable )
+ 
+ instance Eq (MutVar s a) where
+-  MutVar mva# == MutVar mvb# = sameMutVar# mva# mvb#
++  MutVar mva# == MutVar mvb# = tagToEnum# (sameMutVar# mva# mvb#)
+ 
+ -- | Create a new 'MutVar' with the specified initial value
+ newMutVar :: PrimMonad m => a -> m (MutVar (PrimState m) a)
+diff --git a/Data/Primitive/Types.hs b/Data/Primitive/Types.hs
+index 7568f0c..d961e97 100644
+--- a/Data/Primitive/Types.hs
++++ b/Data/Primitive/Types.hs
+@@ -20,6 +20,7 @@ module Data.Primitive.Types (
+ import Control.Monad.Primitive
+ import Data.Primitive.MachDeps
+ import Data.Primitive.Internal.Operations
++import GHC.Prim (tagToEnum#)
+ 
+ import GHC.Base (
+     unsafeCoerce#,
+@@ -48,14 +49,14 @@ import Data.Primitive.Internal.Compat ( mkNoRepType )
+ data Addr = Addr Addr# deriving ( Typeable )
+ 
+ instance Eq Addr where
+-  Addr a# == Addr b# = eqAddr# a# b#
+-  Addr a# /= Addr b# = neAddr# a# b#
++  Addr a# == Addr b# = tagToEnum# (eqAddr# a# b#)
++  Addr a# /= Addr b# = tagToEnum# (neAddr# a# b#)
+ 
+ instance Ord Addr where
+-  Addr a# > Addr b# = gtAddr# a# b#
+-  Addr a# >= Addr b# = geAddr# a# b#
+-  Addr a# < Addr b# = ltAddr# a# b#
+-  Addr a# <= Addr b# = leAddr# a# b#
++  Addr a# > Addr b# = tagToEnum# (gtAddr# a# b#)
++  Addr a# >= Addr b# = tagToEnum# (geAddr# a# b#)
++  Addr a# < Addr b# = tagToEnum# (ltAddr# a# b#)
++  Addr a# <= Addr b# = tagToEnum# (leAddr# a# b#)
+ 
+ instance Data Addr where
+   toConstr _ = error "toConstr"
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/process_fix-build-with-new-ghc.patch b/standalone/android/haskell-patches/process_fix-build-with-new-ghc.patch
new file mode 100644
index 0000000000..a790a316da
--- /dev/null
+++ b/standalone/android/haskell-patches/process_fix-build-with-new-ghc.patch
@@ -0,0 +1,24 @@
+From 0b0d4250cfce44b1a03b50458b4122370ab349ce Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sat, 21 Sep 2013 21:50:51 +0000
+Subject: [PATCH] fix build with new ghc
+
+---
+ System/Process/Internals.hs |    1 +
+ 1 file changed, 1 insertion(+)
+
+diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs
+index a73c6fc..6676a72 100644
+--- a/System/Process/Internals.hs
++++ b/System/Process/Internals.hs
+@@ -61,6 +61,7 @@ import Control.Concurrent
+ import Control.Exception
+ import Foreign.C
+ import Foreign
++import System.IO.Unsafe
+ 
+ # ifdef __GLASGOW_HASKELL__
+ 
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/resourcet_0.4.4_0001-hack-to-build-with-hacked-up-lifted-base-which-is-cu.patch b/standalone/android/haskell-patches/resourcet_0.4.4_0001-hack-to-build-with-hacked-up-lifted-base-which-is-cu.patch
deleted file mode 100644
index bcf3439fac..0000000000
--- a/standalone/android/haskell-patches/resourcet_0.4.4_0001-hack-to-build-with-hacked-up-lifted-base-which-is-cu.patch
+++ /dev/null
@@ -1,44 +0,0 @@
-From c10ab80793a21dce0c7516725e1ca3b36a87aa25 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:35:08 -0400
-Subject: [PATCH] hack to build with hacked up lifted-base, which is currently
- lacking a mask
-
----
- Control/Monad/Trans/Resource.hs |    6 +++---
- 1 file changed, 3 insertions(+), 3 deletions(-)
-
-diff --git a/Control/Monad/Trans/Resource.hs b/Control/Monad/Trans/Resource.hs
-index d209dd8..61ab349 100644
---- a/Control/Monad/Trans/Resource.hs
-+++ b/Control/Monad/Trans/Resource.hs
-@@ -5,7 +5,7 @@
- {-# LANGUAGE TypeFamilies #-}
- {-# LANGUAGE RankNTypes #-}
- {-# LANGUAGE CPP #-}
--{-# LANGUAGE DeriveDataTypeable #-}
-+{-# LANGUAGE DeriveDataTypeable, ImpredicativeTypes #-}
- #if __GLASGOW_HASKELL__ >= 704
- {-# LANGUAGE ConstraintKinds #-}
- #endif
-@@ -554,7 +554,7 @@ GOX(Monoid w, Strict.WriterT w)
- --
- -- Since 0.3.0
- resourceForkIO :: MonadBaseControl IO m => ResourceT m () -> ResourceT m ThreadId
--resourceForkIO (ResourceT f) = ResourceT $ \r -> L.mask $ \restore ->
-+resourceForkIO (ResourceT f) = ResourceT $ \r ->
-     -- We need to make sure the counter is incremented before this call
-     -- returns. Otherwise, the parent thread may call runResourceT before
-     -- the child thread increments, and all resources will be freed
-@@ -565,7 +565,7 @@ resourceForkIO (ResourceT f) = ResourceT $ \r -> L.mask $ \restore ->
-         (liftBaseDiscard forkIO $ bracket_
-             (return ())
-             (stateCleanup r)
--            (restore $ f r))
-+            (return ()))
- 
- -- | A @Monad@ based on some monad which allows running of some 'IO' actions,
- -- via unsafe calls. This applies to 'IO' and 'ST', for instance.
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/shakespeare-css_1.0.2_0001-remove-TH.patch b/standalone/android/haskell-patches/shakespeare-css_1.0.2_0001-remove-TH.patch
index f868197a8c..1c82eaeadf 100644
--- a/standalone/android/haskell-patches/shakespeare-css_1.0.2_0001-remove-TH.patch
+++ b/standalone/android/haskell-patches/shakespeare-css_1.0.2_0001-remove-TH.patch
@@ -1,15 +1,13 @@
-From 8f058e84892a8c4202275f524f74bd6a7097ad40 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Wed, 8 May 2013 02:07:15 -0400
+From 05d0b6e6d2f84cd8ff53b8ee3e42021fa02fe8e4 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sat, 21 Sep 2013 23:21:52 +0000
 Subject: [PATCH] remove TH
 
 ---
- Text/Cassius.hs       |   23 --------------
- Text/Css.hs           |   84 -------------------------------------------------
- Text/CssCommon.hs     |    4 ---
- Text/Lucius.hs        |   30 +-----------------
- shakespeare-css.cabal |    2 +-
- 5 files changed, 2 insertions(+), 141 deletions(-)
+ Text/Cassius.hs   |   23 -----------------------
+ Text/CssCommon.hs |    4 ----
+ Text/Lucius.hs    |   30 +-----------------------------
+ 3 files changed, 1 insertion(+), 56 deletions(-)
 
 diff --git a/Text/Cassius.hs b/Text/Cassius.hs
 index ce05374..ae56b0a 100644
@@ -64,117 +62,6 @@ index ce05374..ae56b0a 100644
  -- | Determine which identifiers are used by the given template, useful for
  -- creating systems like yesod devel.
  cassiusUsedIdentifiers :: String -> [(Deref, VarType)]
-diff --git a/Text/Css.hs b/Text/Css.hs
-index 8e6fc09..401a166 100644
---- a/Text/Css.hs
-+++ b/Text/Css.hs
-@@ -108,19 +108,6 @@ cssUsedIdentifiers toi2b parseBlocks s' =
-         (scope, rest') = go rest
-     go' (k, v) = k ++ v
- 
--cssFileDebug :: Bool -- ^ perform the indent-to-brace conversion
--             -> Q Exp -> Parser [TopLevel] -> FilePath -> Q Exp
--cssFileDebug toi2b parseBlocks' parseBlocks fp = do
--    s <- fmap TL.unpack $ qRunIO $ readUtf8File fp
--#ifdef GHC_7_4
--    qAddDependentFile fp
--#endif
--    let vs = cssUsedIdentifiers toi2b parseBlocks s
--    c <- mapM vtToExp vs
--    cr <- [|cssRuntime toi2b|]
--    parseBlocks'' <- parseBlocks'
--    return $ cr `AppE` parseBlocks'' `AppE` (LitE $ StringL fp) `AppE` ListE c
--
- combineSelectors :: Selector -> Selector -> Selector
- combineSelectors a b = do
-     a' <- a
-@@ -202,17 +189,6 @@ cssRuntime toi2b parseBlocks fp cd render' = unsafePerformIO $ do
- 
-     addScope scope = map (DerefIdent . Ident *** CDPlain . fromString) scope ++ cd
- 
--vtToExp :: (Deref, VarType) -> Q Exp
--vtToExp (d, vt) = do
--    d' <- lift d
--    c' <- c vt
--    return $ TupE [d', c' `AppE` derefToExp [] d]
--  where
--    c :: VarType -> Q Exp
--    c VTPlain = [|CDPlain . toCss|]
--    c VTUrl = [|CDUrl|]
--    c VTUrlParam = [|CDUrlParam|]
--
- getVars :: Monad m => [(String, String)] -> Content -> m [(Deref, VarType)]
- getVars _ ContentRaw{} = return []
- getVars scope (ContentVar d) =
-@@ -268,68 +244,8 @@ compressBlock (Block x y blocks) =
-     cc (ContentRaw a:ContentRaw b:c) = cc $ ContentRaw (a ++ b) : c
-     cc (a:b) = a : cc b
- 
--blockToCss :: Name -> Scope -> Block -> Q Exp
--blockToCss r scope (Block sel props subblocks) =
--    [|(:) (Css' $(selectorToBuilder r scope sel) $(listE $ map go props))
--      . foldr (.) id $(listE $ map subGo subblocks)
--    |]
--  where
--    go (x, y) = tupE [contentsToBuilder r scope x, contentsToBuilder r scope y]
--    subGo (Block sel' b c) =
--        blockToCss r scope $ Block sel'' b c
--      where
--        sel'' = combineSelectors sel sel'
--
--selectorToBuilder :: Name -> Scope -> Selector -> Q Exp
--selectorToBuilder r scope sels =
--    contentsToBuilder r scope $ intercalate [ContentRaw ","] sels
--
--contentsToBuilder :: Name -> Scope -> [Content] -> Q Exp
--contentsToBuilder r scope contents =
--    appE [|mconcat|] $ listE $ map (contentToBuilder r scope) contents
--
--contentToBuilder :: Name -> Scope -> Content -> Q Exp
--contentToBuilder _ _ (ContentRaw x) =
--    [|fromText . pack|] `appE` litE (StringL x)
--contentToBuilder _ scope (ContentVar d) =
--    case d of
--        DerefIdent (Ident s)
--            | Just val <- lookup s scope -> [|fromText . pack|] `appE` litE (StringL val)
--        _ -> [|toCss|] `appE` return (derefToExp [] d)
--contentToBuilder r _ (ContentUrl u) =
--    [|fromText|] `appE`
--        (varE r `appE` return (derefToExp [] u) `appE` listE [])
--contentToBuilder r _ (ContentUrlParam u) =
--    [|fromText|] `appE`
--        ([|uncurry|] `appE` varE r `appE` return (derefToExp [] u))
--
- type Scope = [(String, String)]
- 
--topLevelsToCassius :: [TopLevel] -> Q Exp
--topLevelsToCassius a = do
--    r <- newName "_render"
--    lamE [varP r] $ appE [|CssNoWhitespace . foldr ($) []|] $ fmap ListE $ go r [] a
--  where
--    go _ _ [] = return []
--    go r scope (TopBlock b:rest) = do
--        e <- [|(++) $ map Css ($(blockToCss r scope b) [])|]
--        es <- go r scope rest
--        return $ e : es
--    go r scope (TopAtBlock name s b:rest) = do
--        let s' = contentsToBuilder r scope s
--        e <- [|(:) $ AtBlock $(lift name) $(s') $(blocksToCassius r scope b)|]
--        es <- go r scope rest
--        return $ e : es
--    go r scope (TopAtDecl dec cs:rest) = do
--        e <- [|(:) $ AtDecl $(lift dec) $(contentsToBuilder r scope cs)|]
--        es <- go r scope rest
--        return $ e : es
--    go r scope (TopVar k v:rest) = go r ((k, v) : scope) rest
--
--blocksToCassius :: Name -> Scope -> [Block] -> Q Exp
--blocksToCassius r scope a = do
--    appE [|foldr ($) []|] $ listE $ map (blockToCss r scope) a
--
- renderCss :: Css -> TL.Text
- renderCss css =
-     toLazyText $ mconcat $ map go tops-- FIXME use a foldr
 diff --git a/Text/CssCommon.hs b/Text/CssCommon.hs
 index 719e0a8..8c40e8c 100644
 --- a/Text/CssCommon.hs
@@ -192,10 +79,10 @@ index 719e0a8..8c40e8c 100644
 -mkSizeType "ExSize" "ex"
 -mkSizeType "PixelSize" "px"
 diff --git a/Text/Lucius.hs b/Text/Lucius.hs
-index b71614e..a902e1c 100644
+index 89328bd..0a1cf5e 100644
 --- a/Text/Lucius.hs
 +++ b/Text/Lucius.hs
-@@ -6,12 +6,8 @@
+@@ -8,12 +8,8 @@
  {-# OPTIONS_GHC -fno-warn-missing-fields #-}
  module Text.Lucius
      ( -- * Parsing
@@ -203,13 +90,13 @@ index b71614e..a902e1c 100644
 -    , luciusFile
 -    , luciusFileDebug
 -    , luciusFileReload
+       -- ** Mixins
+-    , luciusMixin
++     luciusMixin
+     , Mixin
        -- ** Runtime
--    , luciusRT
-+      luciusRT
-     , luciusRT'
-     , -- * Datatypes
-       Css
-@@ -31,11 +27,8 @@ module Text.Lucius
+     , luciusRT
+@@ -40,11 +36,8 @@ module Text.Lucius
      , AbsoluteUnit (..)
      , AbsoluteSize (..)
      , absoluteSize
@@ -221,9 +108,9 @@ index b71614e..a902e1c 100644
        -- * Internal
      , parseTopLevels
      , luciusUsedIdentifiers
-@@ -57,18 +50,6 @@ import Data.Either (partitionEithers)
- import Data.Monoid (mconcat)
+@@ -66,18 +59,6 @@ import Data.Monoid (mconcat)
  import Data.List (isSuffixOf)
+ import Control.Arrow (second)
  
 --- |
 ---
@@ -240,7 +127,7 @@ index b71614e..a902e1c 100644
  whiteSpace :: Parser ()
  whiteSpace = many whiteSpace1 >> return ()
  
-@@ -179,15 +160,6 @@ parseComment = do
+@@ -217,15 +198,6 @@ parseComment = do
      _ <- manyTill anyChar $ try $ string "*/"
      return $ ContentRaw ""
  
@@ -253,22 +140,9 @@ index b71614e..a902e1c 100644
 -luciusFileDebug = cssFileDebug False [|parseTopLevels|] parseTopLevels
 -luciusFileReload = luciusFileDebug
 -
- parseTopLevels :: Parser [TopLevel]
+ parseTopLevels :: Parser [TopLevel Unresolved]
  parseTopLevels =
      go id
-diff --git a/shakespeare-css.cabal b/shakespeare-css.cabal
-index de2497b..874a3b5 100644
---- a/shakespeare-css.cabal
-+++ b/shakespeare-css.cabal
-@@ -33,7 +33,7 @@ library
-                    , shakespeare      >= 1.0     && < 1.1
-                    , template-haskell
-                    , text             >= 0.11.1.1 && < 0.12
--                   , process          >= 1.0      && < 1.2
-+                   , process          >= 1.0      && < 1.3
-                    , parsec           >= 2        && < 4
-                    , transformers
- 
 -- 
 1.7.10.4
 
diff --git a/standalone/android/haskell-patches/shakespeare-i18n_1.0.0.2_0001-remove-TH.patch b/standalone/android/haskell-patches/shakespeare-i18n_1.0.0.2_0001-remove-TH.patch
deleted file mode 100644
index 60528db0dd..0000000000
--- a/standalone/android/haskell-patches/shakespeare-i18n_1.0.0.2_0001-remove-TH.patch
+++ /dev/null
@@ -1,162 +0,0 @@
-From b128412ecee9677b788abecbbf1fd1edd447eea2 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:35:59 -0400
-Subject: [PATCH] remove TH
-
----
- Text/Shakespeare/I18N.hs |  130 +---------------------------------------------
- 1 file changed, 1 insertion(+), 129 deletions(-)
-
-diff --git a/Text/Shakespeare/I18N.hs b/Text/Shakespeare/I18N.hs
-index 1b486ed..aa5e358 100644
---- a/Text/Shakespeare/I18N.hs
-+++ b/Text/Shakespeare/I18N.hs
-@@ -51,10 +51,7 @@
- --
- -- You can also adapt those instructions for use with other systems.
- module Text.Shakespeare.I18N
--    ( mkMessage
--    , mkMessageFor
--    , mkMessageVariant
--    , RenderMessage (..)
-+    ( RenderMessage (..)
-     , ToMessage (..)
-     , SomeMessage (..)
-     , Lang
-@@ -115,133 +112,8 @@ type Lang = Text
- --
- --  3. create a 'RenderMessage' instance
- --
--mkMessage :: String   -- ^ base name to use for translation type
--          -> FilePath -- ^ subdirectory which contains the translation files
--          -> Lang     -- ^ default translation language
--          -> Q [Dec]
--mkMessage dt folder lang =
--    mkMessageCommon True "Msg" "Message" dt dt folder lang
- 
- 
---- | create 'RenderMessage' instance for an existing data-type
--mkMessageFor :: String     -- ^ master translation data type
--             -> String     -- ^ existing type to add translations for
--             -> FilePath   -- ^ path to translation folder
--             -> Lang       -- ^ default language
--             -> Q [Dec]
--mkMessageFor master dt folder lang = mkMessageCommon False "" "" master dt folder lang
--
---- | create an additional set of translations for a type created by `mkMessage`
--mkMessageVariant :: String     -- ^ master translation data type
--                 -> String     -- ^ existing type to add translations for
--                 -> FilePath   -- ^ path to translation folder
--                 -> Lang       -- ^ default language
--                 -> Q [Dec]
--mkMessageVariant master dt folder lang = mkMessageCommon False "Msg" "Message" master dt folder lang
--
---- |used by 'mkMessage' and 'mkMessageFor' to generate a 'RenderMessage' and possibly a message data type
--mkMessageCommon :: Bool      -- ^ generate a new datatype from the constructors found in the .msg files
--                -> String    -- ^ string to append to constructor names
--                -> String    -- ^ string to append to datatype name
--                -> String    -- ^ base name of master datatype
--                -> String    -- ^ base name of translation datatype
--                -> FilePath  -- ^ path to translation folder
--                -> Lang      -- ^ default lang
--                -> Q [Dec]
--mkMessageCommon genType prefix postfix master dt folder lang = do
--    files <- qRunIO $ getDirectoryContents folder
--    (_files', contents) <- qRunIO $ fmap (unzip . catMaybes) $ mapM (loadLang folder) files
--#ifdef GHC_7_4
--    mapM_ qAddDependentFile _files'
--#endif
--    sdef <-
--        case lookup lang contents of
--            Nothing -> error $ "Did not find main language file: " ++ unpack lang
--            Just def -> toSDefs def
--    mapM_ (checkDef sdef) $ map snd contents
--    let mname = mkName $ dt ++ postfix
--    c1 <- fmap concat $ mapM (toClauses prefix dt) contents
--    c2 <- mapM (sToClause prefix dt) sdef
--    c3 <- defClause
--    return $
--     ( if genType 
--       then ((DataD [] mname [] (map (toCon dt) sdef) []) :)
--       else id)
--        [ InstanceD
--            []
--            (ConT ''RenderMessage `AppT` (ConT $ mkName master) `AppT` ConT mname)
--            [ FunD (mkName "renderMessage") $ c1 ++ c2 ++ [c3]
--            ]
--        ]
--
--toClauses :: String -> String -> (Lang, [Def]) -> Q [Clause]
--toClauses prefix dt (lang, defs) =
--    mapM go defs
--  where
--    go def = do
--        a <- newName "lang"
--        (pat, bod) <- mkBody dt (prefix ++ constr def) (map fst $ vars def) (content def)
--        guard <- fmap NormalG [|$(return $ VarE a) == pack $(lift $ unpack lang)|]
--        return $ Clause
--            [WildP, ConP (mkName ":") [VarP a, WildP], pat]
--            (GuardedB [(guard, bod)])
--            []
--
--mkBody :: String -- ^ datatype
--       -> String -- ^ constructor
--       -> [String] -- ^ variable names
--       -> [Content]
--       -> Q (Pat, Exp)
--mkBody dt cs vs ct = do
--    vp <- mapM go vs
--    let pat = RecP (mkName cs) (map (varName dt *** VarP) vp)
--    let ct' = map (fixVars vp) ct
--    pack' <- [|Data.Text.pack|]
--    tomsg <- [|toMessage|]
--    let ct'' = map (toH pack' tomsg) ct'
--    mapp <- [|mappend|]
--    let app a b = InfixE (Just a) mapp (Just b)
--    e <-
--        case ct'' of
--            [] -> [|mempty|]
--            [x] -> return x
--            (x:xs) -> return $ foldl' app x xs
--    return (pat, e)
--  where
--    toH pack' _ (Raw s) = pack' `AppE` SigE (LitE (StringL s)) (ConT ''String)
--    toH _ tomsg (Var d) = tomsg `AppE` derefToExp [] d
--    go x = do
--        let y = mkName $ '_' : x
--        return (x, y)
--    fixVars vp (Var d) = Var $ fixDeref vp d
--    fixVars _ (Raw s) = Raw s
--    fixDeref vp (DerefIdent (Ident i)) = DerefIdent $ Ident $ fixIdent vp i
--    fixDeref vp (DerefBranch a b) = DerefBranch (fixDeref vp a) (fixDeref vp b)
--    fixDeref _ d = d
--    fixIdent vp i =
--        case lookup i vp of
--            Nothing -> i
--            Just y -> nameBase y
--
--sToClause :: String -> String -> SDef -> Q Clause
--sToClause prefix dt sdef = do
--    (pat, bod) <- mkBody dt (prefix ++ sconstr sdef) (map fst $ svars sdef) (scontent sdef)
--    return $ Clause
--        [WildP, ConP (mkName "[]") [], pat]
--        (NormalB bod)
--        []
--
--defClause :: Q Clause
--defClause = do
--    a <- newName "sub"
--    c <- newName "langs"
--    d <- newName "msg"
--    rm <- [|renderMessage|]
--    return $ Clause
--        [VarP a, ConP (mkName ":") [WildP, VarP c], VarP d]
--        (NormalB $ rm `AppE` VarE a `AppE` VarE c `AppE` VarE d)
--        []
--
- toCon :: String -> SDef -> Con
- toCon dt (SDef c vs _) =
-     RecC (mkName $ "Msg" ++ c) $ map go vs
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/shakespeare-js_1.1.2_0001-remove-TH.patch b/standalone/android/haskell-patches/shakespeare-js_1.1.2_0001-remove-TH.patch
deleted file mode 100644
index 98a16ae079..0000000000
--- a/standalone/android/haskell-patches/shakespeare-js_1.1.2_0001-remove-TH.patch
+++ /dev/null
@@ -1,308 +0,0 @@
-From 332c71b3f6bc4786b914e675020a23c492beee5a Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Tue, 7 May 2013 19:28:06 -0400
-Subject: [PATCH] remove TH
-
----
- Text/Coffee.hs     |   54 -------------------------------------------------
- Text/Julius.hs     |   56 ++++-----------------------------------------------
- Text/Roy.hs        |   54 -------------------------------------------------
- Text/TypeScript.hs |   57 +---------------------------------------------------
- 4 files changed, 5 insertions(+), 216 deletions(-)
-
-diff --git a/Text/Coffee.hs b/Text/Coffee.hs
-index 2481936..3f7f9c3 100644
---- a/Text/Coffee.hs
-+++ b/Text/Coffee.hs
-@@ -51,14 +51,6 @@ module Text.Coffee
-       -- ** Template-Reading Functions
-       -- | These QuasiQuoter and Template Haskell methods return values of
-       -- type @'JavascriptUrl' url@. See the Yesod book for details.
--      coffee
--    , coffeeFile
--    , coffeeFileReload
--    , coffeeFileDebug
--
--#ifdef TEST_EXPORT
--    , coffeeSettings
--#endif
-     ) where
- 
- import Language.Haskell.TH.Quote (QuasiQuoter (..))
-@@ -66,49 +58,3 @@ import Language.Haskell.TH.Syntax
- import Text.Shakespeare
- import Text.Julius
- 
--coffeeSettings :: Q ShakespeareSettings
--coffeeSettings = do
--  jsettings <- javascriptSettings
--  return $ jsettings { varChar = '%'
--  , preConversion = Just PreConvert {
--      preConvert = ReadProcess "coffee" ["-spb"]
--    , preEscapeIgnoreBalanced = "'\"`"     -- don't insert backtacks for variable already inside strings or backticks.
--    , preEscapeIgnoreLine = "#"            -- ignore commented lines
--    , wrapInsertion = Just WrapInsertion { 
--        wrapInsertionIndent = Just "  "
--      , wrapInsertionStartBegin = "(("
--      , wrapInsertionSeparator = ", "
--      , wrapInsertionStartClose = ") =>"
--      , wrapInsertionEnd = ")"
--      , wrapInsertionApplyBegin = "("
--      , wrapInsertionApplyClose = ")\n"
--      }
--    }
--  }
--
---- | Read inline, quasiquoted CoffeeScript.
--coffee :: QuasiQuoter
--coffee = QuasiQuoter { quoteExp = \s -> do
--    rs <- coffeeSettings
--    quoteExp (shakespeare rs) s
--    }
--
---- | Read in a CoffeeScript template file. This function reads the file once, at
---- compile time.
--coffeeFile :: FilePath -> Q Exp
--coffeeFile fp = do
--    rs <- coffeeSettings
--    shakespeareFile rs fp
--
---- | Read in a CoffeeScript template file. This impure function uses
---- unsafePerformIO to re-read the file on every call, allowing for rapid
---- iteration.
--coffeeFileReload :: FilePath -> Q Exp
--coffeeFileReload fp = do
--    rs <- coffeeSettings
--    shakespeareFileReload rs fp
--
---- | Deprecated synonym for 'coffeeFileReload'
--coffeeFileDebug :: FilePath -> Q Exp
--coffeeFileDebug = coffeeFileReload
--{-# DEPRECATED coffeeFileDebug "Please use coffeeFileReload instead." #-}
-diff --git a/Text/Julius.hs b/Text/Julius.hs
-index 230eac3..1a0376f 100644
---- a/Text/Julius.hs
-+++ b/Text/Julius.hs
-@@ -14,17 +14,8 @@ module Text.Julius
-       -- ** Template-Reading Functions
-       -- | These QuasiQuoter and Template Haskell methods return values of
-       -- type @'JavascriptUrl' url@. See the Yesod book for details.
--      js
--    , julius
--    , juliusFile
--    , jsFile
--    , juliusFileDebug
--    , jsFileDebug
--    , juliusFileReload
--    , jsFileReload
--
-       -- * Datatypes
--    , JavascriptUrl
-+      JavascriptUrl
-     , Javascript (..)
-     , RawJavascript (..)
- 
-@@ -37,9 +28,11 @@ module Text.Julius
-     , renderJavascriptUrl
- 
-       -- ** internal, used by 'Text.Coffee'
--    , javascriptSettings
-       -- ** internal
-     , juliusUsedIdentifiers
-+
-+      -- used by TH splices
-+    , asJavascriptUrl
-     ) where
- 
- import Language.Haskell.TH.Quote (QuasiQuoter (..))
-@@ -101,47 +94,6 @@ instance RawJS TL.Text where rawJS = RawJavascript . fromLazyText
- instance RawJS Builder where rawJS = RawJavascript
- instance RawJS Bool where rawJS = RawJavascript . toJavascript
- 
--javascriptSettings :: Q ShakespeareSettings
--javascriptSettings = do
--  toJExp <- [|toJavascript|]
--  wrapExp <- [|Javascript|]
--  unWrapExp <- [|unJavascript|]
--  asJavascriptUrl' <- [|asJavascriptUrl|]
--  return $ defaultShakespeareSettings { toBuilder = toJExp
--  , wrap = wrapExp
--  , unwrap = unWrapExp
--  , modifyFinalValue = Just asJavascriptUrl'
--  }
--
--js, julius :: QuasiQuoter
--js = QuasiQuoter { quoteExp = \s -> do
--    rs <- javascriptSettings
--    quoteExp (shakespeare rs) s
--    }
--
--julius = js
--
--jsFile, juliusFile :: FilePath -> Q Exp
--jsFile fp = do
--    rs <- javascriptSettings
--    shakespeareFile rs fp
--
--juliusFile = jsFile
--
--
--jsFileReload, juliusFileReload :: FilePath -> Q Exp
--jsFileReload fp = do
--    rs <- javascriptSettings
--    shakespeareFileReload rs fp
--
--juliusFileReload = jsFileReload
--
--jsFileDebug, juliusFileDebug :: FilePath -> Q Exp
--juliusFileDebug = jsFileReload
--{-# DEPRECATED juliusFileDebug "Please use juliusFileReload instead." #-}
--jsFileDebug = jsFileReload
--{-# DEPRECATED jsFileDebug "Please use jsFileReload instead." #-}
--
- -- | Determine which identifiers are used by the given template, useful for
- -- creating systems like yesod devel.
- juliusUsedIdentifiers :: String -> [(Deref, VarType)]
-diff --git a/Text/Roy.hs b/Text/Roy.hs
-index cf09cec..870c9f6 100644
---- a/Text/Roy.hs
-+++ b/Text/Roy.hs
-@@ -23,13 +23,6 @@ module Text.Roy
-       -- ** Template-Reading Functions
-       -- | These QuasiQuoter and Template Haskell methods return values of
-       -- type @'JavascriptUrl' url@. See the Yesod book for details.
--      roy
--    , royFile
--    , royFileReload
--
--#ifdef TEST_EXPORT
--    , roySettings
--#endif
-     ) where
- 
- import Language.Haskell.TH.Quote (QuasiQuoter (..))
-@@ -37,50 +30,3 @@ import Language.Haskell.TH.Syntax
- import Text.Shakespeare
- import Text.Julius
- 
---- | The Roy language compiles down to Javascript.
---- We do this compilation once at compile time to avoid needing to do it during the request.
---- We call this a preConversion because other shakespeare modules like Lucius use Haskell to compile during the request instead rather than a system call.
--roySettings :: Q ShakespeareSettings
--roySettings = do
--  jsettings <- javascriptSettings
--  return $ jsettings { varChar = '#'
--  , preConversion = Just PreConvert {
--      preConvert = ReadProcess "roy" ["--stdio"]
--    , preEscapeIgnoreBalanced = "'\""
--    , preEscapeIgnoreLine = "//"
--    , wrapInsertion = Nothing
--    {-
--    Just WrapInsertion { 
--        wrapInsertionIndent = Just "  "
--      , wrapInsertionStartBegin = "(\\"
--      , wrapInsertionSeparator = " "
--      , wrapInsertionStartClose = " ->\n"
--      , wrapInsertionEnd = ")"
--      , wrapInsertionApplyBegin = " "
--      , wrapInsertionApplyClose = ")\n"
--      }
--      -}
--    }
--  }
--
---- | Read inline, quasiquoted Roy.
--roy :: QuasiQuoter
--roy = QuasiQuoter { quoteExp = \s -> do
--    rs <- roySettings
--    quoteExp (shakespeare rs) s
--    }
--
---- | Read in a Roy template file. This function reads the file once, at
---- compile time.
--royFile :: FilePath -> Q Exp
--royFile fp = do
--    rs <- roySettings
--    shakespeareFile rs fp
--
---- | Read in a Roy template file. This impure function uses
---- unsafePerformIO to re-read the file on every call, allowing for rapid
---- iteration.
--royFileReload :: FilePath -> Q Exp
--royFileReload fp = do
--    rs <- roySettings
--    shakespeareFileReload rs fp
-diff --git a/Text/TypeScript.hs b/Text/TypeScript.hs
-index 34bf4bf..30c5388 100644
---- a/Text/TypeScript.hs
-+++ b/Text/TypeScript.hs
-@@ -53,65 +53,10 @@
- --
- -- 2. TypeScript: 
- module Text.TypeScript
--    ( -- * Functions
--      -- ** Template-Reading Functions
--      -- | These QuasiQuoter and Template Haskell methods return values of
--      -- type @'JavascriptUrl' url@. See the Yesod book for details.
--      tsc
--    , typeScriptFile
--    , typeScriptFileReload
--
--#ifdef TEST_EXPORT
--    , typeScriptSettings
--#endif
-+    (
-     ) where
- 
- import Language.Haskell.TH.Quote (QuasiQuoter (..))
- import Language.Haskell.TH.Syntax
- import Text.Shakespeare
- import Text.Julius
--
---- | The TypeScript language compiles down to Javascript.
---- We do this compilation once at compile time to avoid needing to do it during the request.
---- We call this a preConversion because other shakespeare modules like Lucius use Haskell to compile during the request instead rather than a system call.
--typeScriptSettings :: Q ShakespeareSettings
--typeScriptSettings = do
--  jsettings <- javascriptSettings
--  return $ jsettings { varChar = '#'
--  , preConversion = Just PreConvert {
--      preConvert = ReadProcess "sh" ["-c", "TMP_IN=$(mktemp XXXXXXXXXX.ts); TMP_OUT=$(mktemp XXXXXXXXXX.js); cat /dev/stdin > ${TMP_IN} && tsc --out ${TMP_OUT} ${TMP_IN} && cat ${TMP_OUT}; rm ${TMP_IN} && rm ${TMP_OUT}"]
--    , preEscapeIgnoreBalanced = "'\""
--    , preEscapeIgnoreLine = "//"
--    , wrapInsertion = Just WrapInsertion { 
--        wrapInsertionIndent = Nothing
--      , wrapInsertionStartBegin = ";(function("
--      , wrapInsertionSeparator = ", "
--      , wrapInsertionStartClose = "){"
--      , wrapInsertionEnd = "})"
--      , wrapInsertionApplyBegin = "("
--      , wrapInsertionApplyClose = ");\n"
--      }
--    }
--  }
--
---- | Read inline, quasiquoted TypeScript
--tsc :: QuasiQuoter
--tsc = QuasiQuoter { quoteExp = \s -> do
--    rs <- typeScriptSettings
--    quoteExp (shakespeare rs) s
--    }
--
---- | Read in a Roy template file. This function reads the file once, at
---- compile time.
--typeScriptFile :: FilePath -> Q Exp
--typeScriptFile fp = do
--    rs <- typeScriptSettings
--    shakespeareFile rs fp
--
---- | Read in a Roy template file. This impure function uses
---- unsafePerformIO to re-read the file on every call, allowing for rapid
---- iteration.
--typeScriptFileReload :: FilePath -> Q Exp
--typeScriptFileReload fp = do
--    rs <- typeScriptSettings
--    shakespeareFileReload rs fp
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/shakespeare-js_TH-exports.patch b/standalone/android/haskell-patches/shakespeare-js_TH-exports.patch
new file mode 100644
index 0000000000..3ddbadaf19
--- /dev/null
+++ b/standalone/android/haskell-patches/shakespeare-js_TH-exports.patch
@@ -0,0 +1,25 @@
+From 40182bfb77ba16beab0da95b664d2c052d5fcad6 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sun, 22 Sep 2013 04:53:30 +0000
+Subject: [PATCH] TH exports
+
+---
+ Text/Julius.hs |    2 ++
+ 1 file changed, 2 insertions(+)
+
+diff --git a/Text/Julius.hs b/Text/Julius.hs
+index 3a9f83e..2b98f30 100644
+--- a/Text/Julius.hs
++++ b/Text/Julius.hs
+@@ -40,6 +40,8 @@ module Text.Julius
+     , javascriptSettings
+       -- ** internal
+     , juliusUsedIdentifiers
++      -- used by TH
++    , asJavascriptUrl
+     ) where
+ 
+ import Language.Haskell.TH.Quote (QuasiQuoter (..))
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch b/standalone/android/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch
index aa30b255a5..51443b5d4e 100644
--- a/standalone/android/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch
+++ b/standalone/android/haskell-patches/shakespeare_1.0.3_0001-export-symbol-used-by-TH-splices.patch
@@ -1,139 +1,26 @@
-From 3cb1056782c29b0b68bdcff8fa49d3ea92126956 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Mon, 15 Apr 2013 16:46:15 -0400
-Subject: [PATCH] export symbol used by TH splices
+From 4a75a2f0d77168aa3115b991284a5120484e18f0 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sun, 22 Sep 2013 04:59:21 +0000
+Subject: [PATCH] TH exports
 
 ---
- Text/.Shakespeare.hs.swp | Bin 24576 -> 0 bytes
- Text/Shakespeare.hs      |   2 ++
- 2 files changed, 2 insertions(+)
- delete mode 100644 Text/.Shakespeare.hs.swp
-
-diff --git a/Text/.Shakespeare.hs.swp b/Text/.Shakespeare.hs.swp
-deleted file mode 100644
-index 4d6cd6a0295fdfb59f32a66b4af556c0630dd5b0..0000000000000000000000000000000000000000
-GIT binary patch
-literal 0
-HcmV?d00001
-
-literal 24576
-zcmeI4e~et$RmWd`KnqD)L_(BS5xTW4?M$;fu@g0M7u$*LtdmXsW9?l#wDxBEJo9Gf
-z#WU|s-h1QO^^dk7RGJp46wwy`NCj0Y(S!!1AgEe}NKk}8ErJRNG@z(KqJ@T13Q|#9
-zR6ghact2*x>kWSanvuTVnRm}U_uO;OJ@?*o&-2-xr{<5SdmDFqe16RHu3haOfAZ_E
-z_a3Fwww7
-z0}~BQG%(S?|0fM({p-CS(4lL=qu?5g>-pOOzWx0}{5=c)#QwgHzc+z9s33JFpNR%0
-z8klHcqJfD9CK{M%V4{JE1|}MqXkem&i3TPb_}{AmzvX$m5$_9fi0A%aVgN6{(es`I
-zzX&dZcYzu3y*GH??}AT&_ks{CfP2BM;5zUML4hxWFM!X2XTa0oxI;GN(`@b5q3
-zdEW+q1)c*R0v`lD@F2Ja+zkHk^`6%R`@wf#=Xt*dj)L33^FQo)>);_U2fj-nMfm&Z@;M38Pg{=v0;4eAEh}Oh1S2h`)X|
-zaMUe7^VK8erq$k&-{go$)yw+d5jmw@!>_`_lJ=8eE^Ye#V16}jZGhf}|gJeHq%I3sW^nO}B(&sBOwLMuVwp$B8=cC!v3~8z{d^Yb`{L(y$e%RNGLh
-zAjzeZ#-zQ6{PbKv@6P+(K>$gF-lS_ukPf=ptg3Cl=wH?vSz7N0i$-HjKN78?4mw5;
-zOwXx?8hL_1s6wHyZrIeiQE^+iN`qM^PJ>+3lor~9s3{7pl~RjV=*x;o-N7V6;={*;lR=J&F23q6JsMS|4#z5o|G5(pQD1n;kz|g;l(OBq%sbz3nkM^ph9XCf`ziHH63zL|5=(x`Mn
-zie|KtTKTh}$2ewz>J3mMYOzdOnp9L#a8WHY5CQ66$6_DHg3T-nGbNrt&#s}ru6lkb
-z-IGZY_?REM327$~zo2`jJM~D%8MJ5<9Wdo_Co1*Z*bC;I#D23gt@Z4;&imBGN+6XP
-zsb?pa)=zw_xf#q#7j=VczBC0NJ;&&fxCMGwcpwjF=k?Vx@c
-z^gSLsbekfjS5M^Ok
-zH?374L@iuErXM8y2=x3&wR$SnL?fnCh0-rodOocRH)Fg?Oa~L?Y~R(#Rc*AYhUbaj
-zJH#lS%-XwEyU(K0?)iPSbht5y`r?;%U?+Y{iiHf4Y86%?dA{JY7|iTb^T*thiY9vT
-zdF>O*sg4J*ru&L!kDE3hKQV}?YT7D^lecwTmb-F8$G6r_-%qe!=~gm`7UW05uhYw(
-zDS)YZFmMG~d`_MAcP%rnbY(FfB+cNc-wWi|X$qI+%N)xdOf;{#Bw>R1GU}J40Wk>E
-zhFu)7@r2bxrYAG#wAq_1dl@T(;gHBGEmfMfKLwFyx_@g7Jtk+&o?vku7t?DjBylrH
-zS-)lI><_&p$@IeQU{lTmv$Hi-B`LKrI#RCi@qynB+aZSh06V3IrakOmz+b1B$|h8r
-zV9^m+@#c>;PDbJ*RBfRDE*S4Qf2{5(bu&leC=OedM|sPQ1B0;3yiqm#Wm>h9xF_Xx
-zZ#z>eY`cnw-7;Xkdt>RL#^O4@Xst0X`;o}+rr!3jt=@8E{^-i7xf6@?$BwQzzq-;f
-z3x4gc>D|*ia{;f+bdzRP4WBr-DUaiW7-Oj&ANXmgzth7;qn_8%3NRMKFo!)=Gb<-s
-z1H|
-z>!7QH1U~z>(gauxvJCZ@I>=JqYwIzwtyQ-C<$}BhN?`~!c}
-zE{B-7?AFeS8}V5SGZd#He3NYVwAbM~&%z7LQMb8*_TfP{9Hb5J;>>n+Y+(t*UR-(b
-zp@V9s9mO+4KZ$0-NEVnbm1p|Cu#Hl+edh8eHF{y1qL>*p+HDoYhxZ?S@Z|mn=hTUy
-z87Hkrn4SmyWE{c4g@wF{yw;&^uokjAn`f6KXP+^Q@zg^k=xM;ft>&Uh%@+2oZaR8&sXp3ob|s5J`T=;IZy}Jf|sECb?^k}fd_!py%9`4
-z6Aer>Fwww70}~BQG%(S?L<18IOf)djz(fQ8M>L>HpA`x01v;3wgBy%^s9NfdJJhyW
-zx$X#>62P5160U{OHhqY9H6NCUd(D)nUR{{9;KN`YoCT5>um`*e{2M`qFM*!{_kdf#8^BHACGPou
-z1AGkp97w=%@HTKOxCPt{zQ$euv*118GB^YFfZM@$xa)rryZ}B0o&uM^Nw5TN0sqN8
-z|I6S>@KMkK?*O-gf8gH#x4_dN0Y|_bxB~K08cP4p&4sIOn+8zRrWWd)0Op?18#c8w
-zQbi`SDO7v*X(n~$Lc(LX9p%iA>~EWHsD^mWxa&Bf&6~)(g3Ij7?e?hPu%W
-zJjS+Lv?=YnPo3y17Q8zeZZYNm_RrW;~1!6FNlzJW^d@|vON+Tb$7Tv6&MeJ+{YH%2H#kA|~m6?9V*
-zNmqo6SPQ#{<~p#%*M5~n-8SLqaRHiDA)Cn8G$OH(sv5V#
-zOUWRR;k9gv_0{d`Ae+J@{4=}qZ2iCU$MW@
-z%$UUEnb}@YUQvepwwkt5j*(C^-E(Q589^;?{!42=|0UyNB+}B@M#q|qwlA~Os?c89
-zx)#JoCT=_s*N9rKoibj=jvCh7%$RyrqOG=Jyp&dq+|7_#l-e$FrMot}F6ObOX2thb
-z3)ihO#i&M#cDN3R>DSg|dkddgb>Rxl*an4qZMO7def9#)kFRuk8Nuw{Y=Z!FKJNrG
-z)qRIkG4vZM?HK3fRPH@xDyJ$*>nc^L*EC8$#5J(>2&`}n&6t7}wQZY`bz`L~k5b`h
-zPFwMpJ+JJBb9YcPhY88ViidT@C3cyN7B*%PG{t{4Nf?#f0H+<1F>gxo;b>tlylUe8
-zr`6o!gTHn6&(I>#27oON%-$p>8UU5}?SMrNGBpQikuc
-zCzsLY4*d}K9#!uauxa!EhACl)lf%Bv|=O3jF)t>(74Dk14nO7ChpvtIqvFA1I*D~isu9iZex;Z
-zxu(_Fk%as}9J?%mK{O;uSaOjH_8XsMu}e;=5IRHPp)6RoRSa5w3D5lLMYlNSPxbT~
-zH}qo-g7Z>kv#s3c5*zZ7JYhXlG7a-gA-A8()0MQO##BZUpZAlox_+=L3986%XSy^t
-zj_!a?8{U*|j#I{_1f;nn*%lgH3|M+4*+rH3$@!lny7#o4DLMb2<e
-z&%v|cBj8bR8~6@q_s@Y}1-}B;z%rNyH-OJ@X8#57UJ!s5miiEDR>HGK=S|PeE(MPM(`qM
-z`ric4fEDm|@HNi#zXU!4?ganAS^jUq3*ZCbeV_^M0Y3?@1z%+>WIR4CW0HTwgxqH<
-zfv|-x`Kn_hNxDR_LtxP;PJdenY{}A=$FxepI$6?SN1mijH{?0m0=DV8ZAAy&2ZAdN}1mOL_@WPFL;5c`0h1d!~z6GieF@e{jxo?X|g
-z+-i89-9%C?PCXzE{&yB=r44bw%#GYEx;c`?rN|#F}bITFChvVt>G%S&hp>mVe
-zQE6dIbapZ_cQ0O+W(&EhGj+_^o8^)Q#1^P~YRPEg65o&;t?9pJFD*ZG&pnsyD2aDR
-zkIf%FJb!eKvtjexl+INflWw|})pky+UAv~$U3CtQLb=y@7W-SwSHGGfc4{}VRa2=(
-zGisZJGvoxwdCR=$!*}!UPfDh#vn5v0G|)%ug3wZx?kY5uK8{PMO)~#ZgsUCiKH9T~
-z{=$JWE41AJRU1Hu($TS1DYI1vSBX4~tgP>Vr`j^bQ{t&>jNO<7?7G{}L}L^GBEY)W==6B601}3#WEPUQX5)|f}sSMOQePggeLaXEY>HZdNVpwNi`+JfKOKT
-zW0~=A+nMAHOJ816)pIJ;jMG|PctyQ!GSmbiv3Qr)u&ouEmum^pkkc@$
-zw#m&VrMmx{u&J%gPFTffSIcHAo>@*W5;6-uS6@+S&5%ay{F
-cT45AdikYcun%oMsfwvWjb+Ig{u-NAPH%ay)TmS$7
+ Text/Shakespeare.hs |    3 +++
+ 1 file changed, 3 insertions(+)
 
 diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs
-index d300951..fabbf66 100644
+index 9eb06a2..1290ab1 100644
 --- a/Text/Shakespeare.hs
 +++ b/Text/Shakespeare.hs
-@@ -22,6 +22,8 @@ module Text.Shakespeare
+@@ -23,6 +23,9 @@ module Text.Shakespeare
+     , Deref
+     , Parser
+ 
++    -- used by TH
++    , pack'
++
  #ifdef TEST_EXPORT
      , preFilter
  #endif
-+    -- used by TH splices
-+    , pack'
-     ) where
- 
- import Data.List (intersperse)
 -- 
-1.8.2.rc3
+1.7.10.4
 
diff --git a/standalone/android/haskell-patches/shakespeare_1.0.3_0001-remove-TH.patch b/standalone/android/haskell-patches/shakespeare_1.0.3_0001-remove-TH.patch
deleted file mode 100644
index 5a5b8eeb82..0000000000
--- a/standalone/android/haskell-patches/shakespeare_1.0.3_0001-remove-TH.patch
+++ /dev/null
@@ -1,208 +0,0 @@
-From 10484c5f68431349b249f07517c392c4a90bdb05 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Wed, 8 May 2013 01:47:19 -0400
-Subject: [PATCH] remove TH
-
----
- Text/Shakespeare.hs      |  109 ----------------------------------------------
- Text/Shakespeare/Base.hs |   28 ------------
- shakespeare.cabal        |    2 +-
- 3 files changed, 1 insertion(+), 138 deletions(-)
-
-diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs
-index 7750135..fabbf66 100644
---- a/Text/Shakespeare.hs
-+++ b/Text/Shakespeare.hs
-@@ -12,11 +12,7 @@ module Text.Shakespeare
-     , WrapInsertion (..)
-     , PreConversion (..)
-     , defaultShakespeareSettings
--    , shakespeare
--    , shakespeareFile
--    , shakespeareFileReload
-     -- * low-level
--    , shakespeareFromString
-     , shakespeareUsedIdentifiers
-     , RenderUrl
-     , VarType
-@@ -135,39 +131,6 @@ defaultShakespeareSettings = ShakespeareSettings {
-   , modifyFinalValue = Nothing
- }
- 
--instance Lift PreConvert where
--    lift (PreConvert convert ignore comment wrapInsertion) =
--        [|PreConvert $(lift convert) $(lift ignore) $(lift comment) $(lift wrapInsertion)|]
--
--instance Lift WrapInsertion where
--    lift (WrapInsertion indent sb sep sc e ab ac) =
--        [|WrapInsertion $(lift indent) $(lift sb) $(lift sep) $(lift sc) $(lift e) $(lift ab) $(lift ac)|]
--
--instance Lift PreConversion where
--    lift (ReadProcess command args) =
--        [|ReadProcess $(lift command) $(lift args)|]
--    lift Id = [|Id|]
--
--instance Lift ShakespeareSettings where
--    lift (ShakespeareSettings x1 x2 x3 x4 x5 x6 x7 x8 x9) =
--        [|ShakespeareSettings
--            $(lift x1) $(lift x2) $(lift x3)
--            $(liftExp x4) $(liftExp x5) $(liftExp x6) $(lift x7) $(lift x8) $(liftMExp x9)|]
--      where
--        liftExp (VarE n) = [|VarE $(liftName n)|]
--        liftExp (ConE n) = [|ConE $(liftName n)|]
--        liftExp _ = error "liftExp only supports VarE and ConE"
--        liftMExp Nothing = [|Nothing|]
--        liftMExp (Just e) = [|Just|] `appE` liftExp e
--        liftName (Name (OccName a) b) = [|Name (OccName $(lift a)) $(liftFlavour b)|]
--        liftFlavour NameS = [|NameS|]
--        liftFlavour (NameQ (ModName a)) = [|NameQ (ModName $(lift a))|]
--        liftFlavour (NameU _) = error "liftFlavour NameU" -- [|NameU $(lift $ fromIntegral a)|]
--        liftFlavour (NameL _) = error "liftFlavour NameL" -- [|NameU $(lift $ fromIntegral a)|]
--        liftFlavour (NameG ns (PkgName p) (ModName m)) = [|NameG $(liftNS ns) (PkgName $(lift p)) (ModName $(lift m))|]
--        liftNS VarName = [|VarName|]
--        liftNS DataName = [|DataName|]
--
- type QueryParameters = [(TS.Text, TS.Text)]
- type RenderUrl url = (url -> QueryParameters -> TS.Text)
- type Shakespeare url = RenderUrl url -> Builder
-@@ -302,54 +265,6 @@ pack' = TS.pack
- {-# NOINLINE pack' #-}
- #endif
- 
--contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp
--contentsToShakespeare rs a = do
--    r <- newName "_render"
--    c <- mapM (contentToBuilder r) a
--    compiledTemplate <- case c of
--        -- Make sure we convert this mempty using toBuilder to pin down the
--        -- type appropriately
--        []  -> fmap (AppE $ wrap rs) [|mempty|]
--        [x] -> return x
--        _   -> do
--              mc <- [|mconcat|]
--              return $ mc `AppE` ListE c
--    fmap (maybe id AppE $ modifyFinalValue rs) $
--        if justVarInterpolation rs
--            then return compiledTemplate
--            else return $ LamE [VarP r] compiledTemplate
--      where
--        contentToBuilder :: Name -> Content -> Q Exp
--        contentToBuilder _ (ContentRaw s') = do
--            ts <- [|fromText . pack'|]
--            return $ wrap rs `AppE` (ts `AppE` LitE (StringL s'))
--        contentToBuilder _ (ContentVar d) =
--            return $ wrap rs `AppE` (toBuilder rs `AppE` derefToExp [] d)
--        contentToBuilder r (ContentUrl d) = do
--            ts <- [|fromText|]
--            return $ wrap rs `AppE` (ts `AppE` (VarE r `AppE` derefToExp [] d `AppE` ListE []))
--        contentToBuilder r (ContentUrlParam d) = do
--            ts <- [|fromText|]
--            up <- [|\r' (u, p) -> r' u p|]
--            return $ wrap rs `AppE` (ts `AppE` (up `AppE` VarE r `AppE` derefToExp [] d))
--        contentToBuilder r (ContentMix d) =
--            return $ derefToExp [] d `AppE` VarE r
--
--shakespeare :: ShakespeareSettings -> QuasiQuoter
--shakespeare r = QuasiQuoter { quoteExp = shakespeareFromString r }
--
--shakespeareFromString :: ShakespeareSettings -> String -> Q Exp
--shakespeareFromString r str = do
--    s <- qRunIO $ preFilter r str
--    contentsToShakespeare r $ contentFromString r s
--
--shakespeareFile :: ShakespeareSettings -> FilePath -> Q Exp
--shakespeareFile r fp = do
--#ifdef GHC_7_4
--    qAddDependentFile fp
--#endif
--    readFileQ fp >>= shakespeareFromString r
--
- data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin
- 
- getVars :: Content -> [(Deref, VarType)]
-@@ -369,30 +284,6 @@ data VarExp url = EPlain Builder
- shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)]
- shakespeareUsedIdentifiers settings = concatMap getVars . contentFromString settings
- 
--shakespeareFileReload :: ShakespeareSettings -> FilePath -> Q Exp
--shakespeareFileReload rs fp = do
--    str <- readFileQ fp
--    s <- qRunIO $ preFilter rs str
--    let b = shakespeareUsedIdentifiers rs s
--    c <- mapM vtToExp b
--    rt <- [|shakespeareRuntime|]
--    wrap' <- [|\x -> $(return $ wrap rs) . x|]
--    r' <- lift rs
--    return $ wrap' `AppE` (rt `AppE` r' `AppE` (LitE $ StringL fp) `AppE` ListE c)
--  where
--    vtToExp :: (Deref, VarType) -> Q Exp
--    vtToExp (d, vt) = do
--        d' <- lift d
--        c' <- c vt
--        return $ TupE [d', c' `AppE` derefToExp [] d]
--      where
--        c :: VarType -> Q Exp
--        c VTPlain = [|EPlain . $(return $ toBuilder rs)|]
--        c VTUrl = [|EUrl|]
--        c VTUrlParam = [|EUrlParam|]
--        c VTMixin = [|\x -> EMixin $ \r -> $(return $ unwrap rs) $ x r|]
--
--
- shakespeareRuntime :: ShakespeareSettings -> FilePath -> [(Deref, VarExp url)] -> Shakespeare url
- shakespeareRuntime rs fp cd render' = unsafePerformIO $ do
-     str <- readFileUtf8 fp
-diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs
-index 7c96898..ef769b1 100644
---- a/Text/Shakespeare/Base.hs
-+++ b/Text/Shakespeare/Base.hs
-@@ -52,34 +52,6 @@ data Deref = DerefModulesIdent [String] Ident
-            | DerefTuple [Deref]
-     deriving (Show, Eq, Read, Data, Typeable, Ord)
- 
--instance Lift Ident where
--    lift (Ident s) = [|Ident|] `appE` lift s
--instance Lift Deref where
--    lift (DerefModulesIdent v s) = do
--        dl <- [|DerefModulesIdent|]
--        v' <- lift v
--        s' <- lift s
--        return $ dl `AppE` v' `AppE` s'
--    lift (DerefIdent s) = do
--        dl <- [|DerefIdent|]
--        s' <- lift s
--        return $ dl `AppE` s'
--    lift (DerefBranch x y) = do
--        x' <- lift x
--        y' <- lift y
--        db <- [|DerefBranch|]
--        return $ db `AppE` x' `AppE` y'
--    lift (DerefIntegral i) = [|DerefIntegral|] `appE` lift i
--    lift (DerefRational r) = do
--        n <- lift $ numerator r
--        d <- lift $ denominator r
--        per <- [|(%) :: Int -> Int -> Ratio Int|]
--        dr <- [|DerefRational|]
--        return $ dr `AppE` InfixE (Just n) per (Just d)
--    lift (DerefString s) = [|DerefString|] `appE` lift s
--    lift (DerefList x) = [|DerefList $(lift x)|]
--    lift (DerefTuple x) = [|DerefTuple $(lift x)|]
--
- derefParens, derefCurlyBrackets :: UserParser a Deref
- derefParens        = between (char '(') (char ')') parseDeref
- derefCurlyBrackets = between (char '{') (char '}') parseDeref
-diff --git a/shakespeare.cabal b/shakespeare.cabal
-index 01c8d5d..0fff966 100644
---- a/shakespeare.cabal
-+++ b/shakespeare.cabal
-@@ -27,7 +27,7 @@ library
-                    , template-haskell
-                    , parsec           >= 2       && < 4
-                    , text             >= 0.7     && < 0.12
--                   , process          >= 1.0     && < 1.2
-+                   , process          >= 1.0     && < 1.3
- 
-     exposed-modules: 
-                      Text.Shakespeare
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/skein_hardcode_little-endian.patch b/standalone/android/haskell-patches/skein_hardcode_little-endian.patch
new file mode 100644
index 0000000000..788d8e5210
--- /dev/null
+++ b/standalone/android/haskell-patches/skein_hardcode_little-endian.patch
@@ -0,0 +1,24 @@
+From 3a04b41ffce4e4e87b0fedd3a1e3434a3f06cc76 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sun, 22 Sep 2013 00:18:12 +0000
+Subject: [PATCH] hardcode little endian
+
+---
+ c_impl/optimized/skein_port.h |    1 +
+ 1 file changed, 1 insertion(+)
+
+diff --git a/c_impl/optimized/skein_port.h b/c_impl/optimized/skein_port.h
+index a2d0fc2..6929bb0 100644
+--- a/c_impl/optimized/skein_port.h
++++ b/c_impl/optimized/skein_port.h
+@@ -45,6 +45,7 @@ typedef uint64_t        u64b_t;             /* 64-bit unsigned integer */
+  * platform-specific code instead (e.g., for big-endian CPUs).
+  *
+  */
++#define SKEIN_NEED_SWAP  (0)
+ #ifndef SKEIN_NEED_SWAP /* compile-time "override" for endianness? */
+ 
+ #include "brg_endian.h"                     /* get endianness selection */
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/socks_0.4.2_0001-remove-IPv6-stuff.patch b/standalone/android/haskell-patches/socks_0.4.2_0001-remove-IPv6-stuff.patch
index 5a343d8759..fc95695735 100644
--- a/standalone/android/haskell-patches/socks_0.4.2_0001-remove-IPv6-stuff.patch
+++ b/standalone/android/haskell-patches/socks_0.4.2_0001-remove-IPv6-stuff.patch
@@ -1,43 +1,29 @@
-From abab0f8202998a3e88c5dc5f67a8245da6c174b3 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:36:20 -0400
+From 28e6a6599ee91e15aa7b2f9d25433490f192f22e Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sat, 21 Sep 2013 23:17:29 +0000
 Subject: [PATCH] remove IPv6 stuff
 
 ---
- Network/Socks5.hs         |    1 -
- Network/Socks5/Command.hs |   16 ++--------------
- Network/Socks5/Types.hs   |    3 +--
- Network/Socks5/Wire.hs    |    2 --
- 4 files changed, 3 insertions(+), 19 deletions(-)
+ Network/Socks5/Command.hs  |    8 +-------
+ Network/Socks5/Conf.hs     |    1 -
+ Network/Socks5/Lowlevel.hs |    1 -
+ Network/Socks5/Types.hs    |   18 +-----------------
+ Network/Socks5/Wire.hs     |    2 --
+ 5 files changed, 2 insertions(+), 28 deletions(-)
 
-diff --git a/Network/Socks5.hs b/Network/Socks5.hs
-index 67b0060..80efb9c 100644
---- a/Network/Socks5.hs
-+++ b/Network/Socks5.hs
-@@ -54,7 +54,6 @@ socksConnectAddr :: Socket -> SockAddr -> SockAddr -> IO ()
- socksConnectAddr sock sockserver destaddr = withSocks sock sockserver $ do
- 	case destaddr of
- 		SockAddrInet p h      -> socks5ConnectIPV4 sock h p >> return ()
--		SockAddrInet6 p _ h _ -> socks5ConnectIPV6 sock h p >> return ()
- 		_                     -> error "unsupported unix sockaddr type"
- 
- -- | connect a new socket to the socks server, and connect the stream to a FQDN
 diff --git a/Network/Socks5/Command.hs b/Network/Socks5/Command.hs
-index 2952706..db994c9 100644
+index 8ce06ec..222d954 100644
 --- a/Network/Socks5/Command.hs
 +++ b/Network/Socks5/Command.hs
-@@ -9,9 +9,8 @@
- --
- module Network.Socks5.Command
- 	( socks5Establish
--	, socks5ConnectIPV4
--	, socks5ConnectIPV6
- 	, socks5ConnectDomainName
-+	, socks5ConnectIPV4 
- 	-- * lowlevel interface
- 	, socks5Rpc
- 	) where
-@@ -23,7 +22,7 @@ import qualified Data.ByteString as B
+@@ -12,7 +12,6 @@ module Network.Socks5.Command
+     , Connect(..)
+     , Command(..)
+     , connectIPV4
+-    , connectIPV6
+     , connectDomainName
+     -- * lowlevel interface
+     , rpc
+@@ -28,7 +27,7 @@ import qualified Data.ByteString as B
  import qualified Data.ByteString.Char8 as BC
  import Data.Serialize
  
@@ -46,50 +32,92 @@ index 2952706..db994c9 100644
  import Network.Socket.ByteString
  
  import Network.Socks5.Types
-@@ -46,17 +45,6 @@ socks5ConnectIPV4 socket hostaddr port = onReply <$> socks5Rpc socket request
- 		onReply (SocksAddrIPV4 h, p) = (h, p)
- 		onReply _                    = error "ipv4 requested, got something different"
+@@ -64,11 +63,6 @@ connectIPV4 socket hostaddr port = onReply <$> rpc_ socket (Connect $ SocksAddre
+     where onReply (SocksAddrIPV4 h, p) = (h, p)
+           onReply _                    = error "ipv4 requested, got something different"
  
--socks5ConnectIPV6 :: Socket -> HostAddress6 -> PortNumber -> IO (HostAddress6, PortNumber)
--socks5ConnectIPV6 socket hostaddr6 port = onReply <$> socks5Rpc socket request
--	where
--		request = SocksRequest
--			{ requestCommand  = SocksCommandConnect
--			, requestDstAddr  = SocksAddrIPV6 hostaddr6
--			, requestDstPort  = fromIntegral port
--			}
--		onReply (SocksAddrIPV6 h, p) = (h, p)
--		onReply _                    = error "ipv6 requested, got something different"
+-connectIPV6 :: Socket -> HostAddress6 -> PortNumber -> IO (HostAddress6, PortNumber)
+-connectIPV6 socket hostaddr6 port = onReply <$> rpc_ socket (Connect $ SocksAddress (SocksAddrIPV6 hostaddr6) port)
+-    where onReply (SocksAddrIPV6 h, p) = (h, p)
+-          onReply _                    = error "ipv6 requested, got something different"
 -
  -- TODO: FQDN should only be ascii, maybe putting a "fqdn" data type
  -- in front to make sure and make the BC.pack safe.
- socks5ConnectDomainName :: Socket -> String -> PortNumber -> IO (SocksAddr, PortNumber)
+ connectDomainName :: Socket -> String -> PortNumber -> IO (SocksHostAddress, PortNumber)
+diff --git a/Network/Socks5/Conf.hs b/Network/Socks5/Conf.hs
+index c29ff7b..007d382 100644
+--- a/Network/Socks5/Conf.hs
++++ b/Network/Socks5/Conf.hs
+@@ -47,5 +47,4 @@ defaultSocksConfFromSockAddr sockaddr = SocksConf server SocksVer5
+     where server       = SocksAddress haddr port
+           (haddr,port) = case sockaddr of
+                              SockAddrInet p h      -> (SocksAddrIPV4 h, p)
+-                             SockAddrInet6 p _ h _ -> (SocksAddrIPV6 h, p)
+                              _                     -> error "unsupported unix sockaddr type"
+diff --git a/Network/Socks5/Lowlevel.hs b/Network/Socks5/Lowlevel.hs
+index c10d9b9..2c3d59c 100644
+--- a/Network/Socks5/Lowlevel.hs
++++ b/Network/Socks5/Lowlevel.hs
+@@ -17,7 +17,6 @@ resolveToSockAddr :: SocksAddress -> IO SockAddr
+ resolveToSockAddr (SocksAddress sockHostAddr port) =
+     case sockHostAddr of
+         SocksAddrIPV4 ha       -> return $ SockAddrInet port ha
+-        SocksAddrIPV6 ha6      -> return $ SockAddrInet6 port 0 ha6 0
+         SocksAddrDomainName bs -> do he <- getHostByName (BC.unpack bs)
+                                      return $ SockAddrInet port (hostAddress he)
+ 
 diff --git a/Network/Socks5/Types.hs b/Network/Socks5/Types.hs
-index 5dc7d5e..12dea99 100644
+index 7fbec25..17c7c83 100644
 --- a/Network/Socks5/Types.hs
 +++ b/Network/Socks5/Types.hs
-@@ -17,7 +17,7 @@ module Network.Socks5.Types
+@@ -19,7 +19,7 @@ module Network.Socks5.Types
  import Data.ByteString (ByteString)
  import Data.Word
  import Data.Data
--import Network.Socket (HostAddress, HostAddress6)
-+import Network.Socket (HostAddress)
+-import Network.Socket (HostAddress, HostAddress6, PortNumber)
++import Network.Socket (HostAddress, PortNumber)
  import Control.Exception
+ import qualified Data.ByteString.Char8 as BC
+ import Numeric (showHex)
+@@ -53,12 +53,10 @@ data SocksMethod =
+ data SocksHostAddress =
+       SocksAddrIPV4 !HostAddress
+     | SocksAddrDomainName !ByteString
+-    | SocksAddrIPV6 !HostAddress6
+     deriving (Eq,Ord)
  
- data SocksCommand =
-@@ -38,7 +38,6 @@ data SocksMethod =
- data SocksAddr =
- 	  SocksAddrIPV4 HostAddress
- 	| SocksAddrDomainName ByteString
--	| SocksAddrIPV6 HostAddress6
- 	deriving (Show,Eq)
+ instance Show SocksHostAddress where
+     show (SocksAddrIPV4 ha)       = "SocksAddrIPV4(" ++ showHostAddress ha ++ ")"
+-    show (SocksAddrIPV6 ha6)      = "SocksAddrIPV6(" ++ showHostAddress6 ha6 ++ ")"
+     show (SocksAddrDomainName dn) = "SocksAddrDomainName(" ++ BC.unpack dn ++ ")"
  
- data SocksReply =
+ -- | Converts a HostAddress to a String in dot-decimal notation
+@@ -69,20 +67,6 @@ showHostAddress num = concat [show q1, ".", show q2, ".", show q3, ".", show q4]
+         (num''',q3) = num'' `quotRem` 256
+         (_,q4)      = num''' `quotRem` 256
+ 
+--- | Converts a IPv6 HostAddress6 to standard hex notation
+-showHostAddress6 :: HostAddress6 -> String
+-showHostAddress6 (a,b,c,d) =
+-    (concat . intersperse ":" . map (flip showHex ""))
+-        [p1,p2,p3,p4,p5,p6,p7,p8]
+-    where (a',p2) = a `quotRem` 65536
+-          (_,p1)  = a' `quotRem` 65536
+-          (b',p4) = b `quotRem` 65536
+-          (_,p3)  = b' `quotRem` 65536
+-          (c',p6) = c `quotRem` 65536
+-          (_,p5)  = c' `quotRem` 65536
+-          (d',p8) = d `quotRem` 65536
+-          (_,p7)  = d' `quotRem` 65536
+-
+ -- | Describe a Socket address on the SOCKS protocol
+ data SocksAddress = SocksAddress !SocksHostAddress !PortNumber
+     deriving (Show,Eq,Ord)
 diff --git a/Network/Socks5/Wire.hs b/Network/Socks5/Wire.hs
-index 2cfed52..d3bd9c5 100644
+index 3ab95a8..2881988 100644
 --- a/Network/Socks5/Wire.hs
 +++ b/Network/Socks5/Wire.hs
-@@ -41,12 +41,10 @@ data SocksResponse = SocksResponse
+@@ -46,12 +46,10 @@ data SocksResponse = SocksResponse
  
  getAddr 1 = SocksAddrIPV4 <$> getWord32be
  getAddr 3 = SocksAddrDomainName <$> (getWord8 >>= getByteString . fromIntegral)
@@ -101,7 +129,7 @@ index 2cfed52..d3bd9c5 100644
 -putAddr (SocksAddrIPV6 (a,b,c,d)) = putWord8 4 >> mapM_ putWord32host [a,b,c,d]
  
  getSocksRequest 5 = do
- 	cmd <- toEnum . fromIntegral <$> getWord8
+     cmd <- toEnum . fromIntegral <$> getWord8
 -- 
 1.7.10.4
 
diff --git a/standalone/android/haskell-patches/split_0.2.1.2_0001-modify-to-build-with-unreleased-ghc.patch b/standalone/android/haskell-patches/split_0.2.1.2_0001-modify-to-build-with-unreleased-ghc.patch
deleted file mode 100644
index 472ccd6785..0000000000
--- a/standalone/android/haskell-patches/split_0.2.1.2_0001-modify-to-build-with-unreleased-ghc.patch
+++ /dev/null
@@ -1,25 +0,0 @@
-From 2feaef797641587a3da83753ee17d20e712c79cf Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:36:30 -0400
-Subject: [PATCH] modify to build with unreleased ghc
-
----
- split.cabal |    2 +-
- 1 file changed, 1 insertion(+), 1 deletion(-)
-
-diff --git a/split.cabal b/split.cabal
-index 2183c3e..29b9b32 100644
---- a/split.cabal
-+++ b/split.cabal
-@@ -51,7 +51,7 @@ Source-repository head
- 
- Library
-   ghc-options:       -Wall
--  build-depends:     base <4.7
-+  build-depends:     base <4.8
-   exposed-modules:   Data.List.Split, Data.List.Split.Internals
-   default-language:  Haskell2010
-   Hs-source-dirs:    src
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/syb_0.3.7_0001-hack-for-cross-compiling.patch b/standalone/android/haskell-patches/syb_0.3.7_0001-hack-for-cross-compiling.patch
deleted file mode 100644
index e18d6127fe..0000000000
--- a/standalone/android/haskell-patches/syb_0.3.7_0001-hack-for-cross-compiling.patch
+++ /dev/null
@@ -1,25 +0,0 @@
-From c40fe2c484096c5de4cac8ca14a0ca5d892999f7 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:36:43 -0400
-Subject: [PATCH] hack for cross-compiling
-
----
- syb.cabal |    2 +-
- 1 file changed, 1 insertion(+), 1 deletion(-)
-
-diff --git a/syb.cabal b/syb.cabal
-index 0aee93d..0a645c6 100644
---- a/syb.cabal
-+++ b/syb.cabal
-@@ -17,7 +17,7 @@ description:
- 
- category:               Generics
- stability:              provisional
--build-type:             Custom
-+build-type:             Simple
- cabal-version:          >= 1.6
- 
- extra-source-files:     tests/*.hs,
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/unix-time_0.1.4_0001-hacks-for-android.patch b/standalone/android/haskell-patches/unix-time_0.1.4_0001-hacks-for-android.patch
deleted file mode 100644
index cff7e76e37..0000000000
--- a/standalone/android/haskell-patches/unix-time_0.1.4_0001-hacks-for-android.patch
+++ /dev/null
@@ -1,81 +0,0 @@
-From 4023b952871ad2bc248db887716d06932ac0dbb9 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Wed, 8 May 2013 14:00:19 -0400
-Subject: [PATCH] hacks for android
-
----
- cbits/conv.c    |    4 +---
- unix-time.cabal |   28 ++--------------------------
- 2 files changed, 3 insertions(+), 29 deletions(-)
-
-diff --git a/cbits/conv.c b/cbits/conv.c
-index 3b6a129..5a68f91 100644
---- a/cbits/conv.c
-+++ b/cbits/conv.c
-@@ -1,5 +1,3 @@
--#include "config.h"
--
- #if IS_LINUX
- /* Linux cheats AC_CHECK_FUNCS(strptime_l), sigh. */
- #define THREAD_SAFE 0
-@@ -51,7 +49,7 @@ time_t c_parse_unix_time_gmt(char *fmt, char *src) {
- #else
-     strptime(src, fmt, &dst);
- #endif
--    return timegm(&dst);
-+    return NULL; /* timegm(&dst); */
- }
- 
- void c_format_unix_time(char *fmt, time_t src, char* dst, int siz) {
-diff --git a/unix-time.cabal b/unix-time.cabal
-index a905d63..f32d952 100644
---- a/unix-time.cabal
-+++ b/unix-time.cabal
-@@ -8,7 +8,7 @@ Synopsis:               Unix time parser/formatter and utilities
- Description:            Fast parser\/formatter\/utilities for Unix time
- Category:               Data
- Cabal-Version:          >= 1.10
--Build-Type:             Configure
-+Build-Type:             Simple
- Extra-Source-Files:     cbits/conv.c cbits/config.h.in configure configure.ac
- Extra-Tmp-Files:        config.log config.status autom4te.cache cbits/config.h
- 
-@@ -21,34 +21,10 @@ Library
-                         Data.UnixTime.Types
-                         Data.UnixTime.Sys
-   Build-Depends:        base >= 4 && < 5
--                      , bytestring
-+                      , bytestring (>= 0.10.3.0)
-                       , old-time
-   C-Sources:            cbits/conv.c
- 
--Test-Suite doctests
--  Type:                 exitcode-stdio-1.0
--  HS-Source-Dirs:       test
--  Ghc-Options:          -threaded -Wall
--  Main-Is:              doctests.hs
--  Build-Depends:        base
--                      , doctest >= 0.9.3
--
--Test-Suite spec
--  Type:                 exitcode-stdio-1.0
--  Default-Language:     Haskell2010
--  Hs-Source-Dirs:       test
--  Ghc-Options:          -Wall
--  Main-Is:              Spec.hs
--  Other-Modules:        UnixTimeSpec
--  Build-Depends:        base
--                      , bytestring
--                      , hspec
--                      , old-locale
--                      , old-time
--                      , QuickCheck
--                      , time
--                      , unix-time
--
- Source-Repository head
-   Type:                 git
-   Location:             https://github.com/kazu-yamamoto/unix-time
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/unix-time_hack-for-Bionic.patch b/standalone/android/haskell-patches/unix-time_hack-for-Bionic.patch
new file mode 100644
index 0000000000..80b509f5f3
--- /dev/null
+++ b/standalone/android/haskell-patches/unix-time_hack-for-Bionic.patch
@@ -0,0 +1,25 @@
+From eff7034f0c9f80fd30c9d8952b3fd0a343adccc8 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Mon, 23 Sep 2013 00:12:35 +0000
+Subject: [PATCH] hack for Bionic
+
+---
+ cbits/conv.c |    2 +-
+ 1 file changed, 1 insertion(+), 1 deletion(-)
+
+diff --git a/cbits/conv.c b/cbits/conv.c
+index 7ff7b87..2e4c870 100644
+--- a/cbits/conv.c
++++ b/cbits/conv.c
+@@ -55,7 +55,7 @@ time_t c_parse_unix_time_gmt(char *fmt, char *src) {
+ #else
+     strptime(src, fmt, &dst);
+ #endif
+-    return timegm(&dst);
++    return NULL; /* timegm(&dst); (not in Bionic) */
+ }
+ 
+ size_t c_format_unix_time(char *fmt, time_t src, char* dst, int siz) {
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/unix_2.6.0.1_0001-remove-stuff-not-available-on-Android.patch b/standalone/android/haskell-patches/unix_2.6.0.1_0001-remove-stuff-not-available-on-Android.patch
deleted file mode 100644
index ff1da944cf..0000000000
--- a/standalone/android/haskell-patches/unix_2.6.0.1_0001-remove-stuff-not-available-on-Android.patch
+++ /dev/null
@@ -1,91 +0,0 @@
-From abca378462337ca0eb13a7e4d3073cb96a50d36c Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:37:23 -0400
-Subject: [PATCH] remove stuff not available on Android
-
----
- System/Posix/Resource.hsc        |    4 ++++
- System/Posix/Terminal/Common.hsc |   29 +++--------------------------
- 2 files changed, 7 insertions(+), 26 deletions(-)
-
-diff --git a/System/Posix/Resource.hsc b/System/Posix/Resource.hsc
-index 6651998..2615b1e 100644
---- a/System/Posix/Resource.hsc
-+++ b/System/Posix/Resource.hsc
-@@ -101,7 +101,9 @@ packResource ResourceTotalMemory   = (#const RLIMIT_AS)
- #endif
- 
- unpackRLimit :: CRLim -> ResourceLimit
-+#if 0
- unpackRLimit (#const RLIM_INFINITY)  = ResourceLimitInfinity
-+#endif
- #ifdef RLIM_SAVED_MAX
- unpackRLimit (#const RLIM_SAVED_MAX) = ResourceLimitUnknown
- unpackRLimit (#const RLIM_SAVED_CUR) = ResourceLimitUnknown
-@@ -109,7 +111,9 @@ unpackRLimit (#const RLIM_SAVED_CUR) = ResourceLimitUnknown
- unpackRLimit other = ResourceLimit (fromIntegral other)
- 
- packRLimit :: ResourceLimit -> Bool -> CRLim
-+#if 0
- packRLimit ResourceLimitInfinity _     = (#const RLIM_INFINITY)
-+#endif
- #ifdef RLIM_SAVED_MAX
- packRLimit ResourceLimitUnknown  True  = (#const RLIM_SAVED_CUR)
- packRLimit ResourceLimitUnknown  False = (#const RLIM_SAVED_MAX)
-diff --git a/System/Posix/Terminal/Common.hsc b/System/Posix/Terminal/Common.hsc
-index 3a6254d..32a22f2 100644
---- a/System/Posix/Terminal/Common.hsc
-+++ b/System/Posix/Terminal/Common.hsc
-@@ -419,11 +419,7 @@ foreign import ccall unsafe "tcsendbreak"
- -- | @drainOutput fd@ calls @tcdrain@ to block until all output
- --   written to @Fd@ @fd@ has been transmitted.
- drainOutput :: Fd -> IO ()
--drainOutput (Fd fd) = throwErrnoIfMinus1_ "drainOutput" (c_tcdrain fd)
--
--foreign import ccall unsafe "tcdrain"
--  c_tcdrain :: CInt -> IO CInt
--
-+drainOutput (Fd fd) = error "drainOutput not implemented"
- 
- data QueueSelector
-   = InputQueue		-- TCIFLUSH
-@@ -434,16 +430,7 @@ data QueueSelector
- --   pending input and\/or output for @Fd@ @fd@,
- --   as indicated by the @QueueSelector@ @queues@.
- discardData :: Fd -> QueueSelector -> IO ()
--discardData (Fd fd) queue =
--  throwErrnoIfMinus1_ "discardData" (c_tcflush fd (queue2Int queue))
--  where
--    queue2Int :: QueueSelector -> CInt
--    queue2Int InputQueue  = (#const TCIFLUSH)
--    queue2Int OutputQueue = (#const TCOFLUSH)
--    queue2Int BothQueues  = (#const TCIOFLUSH)
--
--foreign import ccall unsafe "tcflush"
--  c_tcflush :: CInt -> CInt -> IO CInt
-+discardData (Fd fd) queue = error "discardData not implemented"
- 
- data FlowAction
-   = SuspendOutput	-- ^ TCOOFF
-@@ -455,17 +442,7 @@ data FlowAction
- --   flow of data on @Fd@ @fd@, as indicated by
- --   @action@.
- controlFlow :: Fd -> FlowAction -> IO ()
--controlFlow (Fd fd) action =
--  throwErrnoIfMinus1_ "controlFlow" (c_tcflow fd (action2Int action))
--  where
--    action2Int :: FlowAction -> CInt
--    action2Int SuspendOutput = (#const TCOOFF)
--    action2Int RestartOutput = (#const TCOON)
--    action2Int TransmitStop  = (#const TCIOFF)
--    action2Int TransmitStart = (#const TCION)
--
--foreign import ccall unsafe "tcflow"
--  c_tcflow :: CInt -> CInt -> IO CInt
-+controlFlow (Fd fd) action = error "controlFlow not implemented"
- 
- -- | @getTerminalProcessGroupID fd@ calls @tcgetpgrp@ to
- --   obtain the @ProcessGroupID@ of the foreground process group 
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/unordered-containers_fix-build-with-new-ghc.patch b/standalone/android/haskell-patches/unordered-containers_fix-build-with-new-ghc.patch
new file mode 100644
index 0000000000..7c0774e67f
--- /dev/null
+++ b/standalone/android/haskell-patches/unordered-containers_fix-build-with-new-ghc.patch
@@ -0,0 +1,32 @@
+From 2d1f0027ae1ca56bbf4449887cf3bc61dc1c8e84 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sat, 21 Sep 2013 22:32:01 +0000
+Subject: [PATCH] fix build with new ghc
+
+---
+ Data/HashMap/Base.hs |    4 ++--
+ 1 file changed, 2 insertions(+), 2 deletions(-)
+
+diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
+index 6a77df4..93a384d 100644
+--- a/Data/HashMap/Base.hs
++++ b/Data/HashMap/Base.hs
+@@ -86,7 +86,7 @@ import qualified Data.List as L
+ import Data.Monoid (Monoid(mempty, mappend))
+ import Data.Traversable (Traversable(..))
+ import Data.Word (Word)
+-import GHC.Exts ((==#), build, reallyUnsafePtrEquality#)
++import GHC.Exts ((==#), build, reallyUnsafePtrEquality#, tagToEnum#)
+ import Prelude hiding (filter, foldr, lookup, map, null, pred)
+ 
+ import qualified Data.HashMap.Array as A
+@@ -1072,5 +1072,5 @@ fullNodeMask = complement (complement 0 `unsafeShiftL` maxChildren)
+ -- | Check if two the two arguments are the same value.  N.B. This
+ -- function might give false negatives (due to GC moving objects.)
+ ptrEq :: a -> a -> Bool
+-ptrEq x y = reallyUnsafePtrEquality# x y ==# 1#
++ptrEq x y = tagToEnum# (reallyUnsafePtrEquality# x y ==# 1#)
+ {-# INLINE ptrEq #-}
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/vector_0.10.0.1_0001-disable-optimisation-that-breaks-when-cross-compilin.patch b/standalone/android/haskell-patches/vector_0.10.0.1_0001-disable-optimisation-that-breaks-when-cross-compilin.patch
deleted file mode 100644
index aa50d9c938..0000000000
--- a/standalone/android/haskell-patches/vector_0.10.0.1_0001-disable-optimisation-that-breaks-when-cross-compilin.patch
+++ /dev/null
@@ -1,25 +0,0 @@
-From 3a4ee8091ba9da44f9f4a04522a5ff45fabe70d9 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:37:56 -0400
-Subject: [PATCH] disable optimisation that breaks when cross-compiling
-
-This needs TH to work actually.
----
- Data/Vector/Fusion/Stream/Monadic.hs |    1 -
- 1 file changed, 1 deletion(-)
-
-diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs
-index 51fec75..b089b3d 100644
---- a/Data/Vector/Fusion/Stream/Monadic.hs
-+++ b/Data/Vector/Fusion/Stream/Monadic.hs
-@@ -101,7 +101,6 @@ import GHC.Exts ( SpecConstrAnnotation(..) )
- 
- data SPEC = SPEC | SPEC2
- #if __GLASGOW_HASKELL__ >= 700
--{-# ANN type SPEC ForceSpecConstr #-}
- #endif
- 
- emptyStream :: String
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/vector_hack-to-build-with-new-ghc.patch b/standalone/android/haskell-patches/vector_hack-to-build-with-new-ghc.patch
new file mode 100644
index 0000000000..4c08be4f92
--- /dev/null
+++ b/standalone/android/haskell-patches/vector_hack-to-build-with-new-ghc.patch
@@ -0,0 +1,130 @@
+From af259b521574b734a7a0b1b3e9e6868df33ebdb9 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sat, 21 Sep 2013 23:47:47 +0000
+Subject: [PATCH] hack to build with new ghc
+
+---
+ Data/Vector.hs                       |    1 -
+ Data/Vector/Fusion/Stream/Monadic.hs |    1 -
+ Data/Vector/Generic.hs               |   10 ++--------
+ Data/Vector/Primitive.hs             |    1 -
+ Data/Vector/Storable.hs              |    1 -
+ Data/Vector/Unboxed/Base.hs          |   15 +--------------
+ 6 files changed, 3 insertions(+), 26 deletions(-)
+
+diff --git a/Data/Vector.hs b/Data/Vector.hs
+index 138b2db..92c4387 100644
+--- a/Data/Vector.hs
++++ b/Data/Vector.hs
+@@ -215,7 +215,6 @@ instance Data a => Data (Vector a) where
+   toConstr _   = error "toConstr"
+   gunfold _ _  = error "gunfold"
+   dataTypeOf _ = G.mkType "Data.Vector.Vector"
+-  dataCast1    = G.dataCast
+ 
+ type instance G.Mutable Vector = MVector
+ 
+diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs
+index 51fec75..b089b3d 100644
+--- a/Data/Vector/Fusion/Stream/Monadic.hs
++++ b/Data/Vector/Fusion/Stream/Monadic.hs
+@@ -101,7 +101,6 @@ import GHC.Exts ( SpecConstrAnnotation(..) )
+ 
+ data SPEC = SPEC | SPEC2
+ #if __GLASGOW_HASKELL__ >= 700
+-{-# ANN type SPEC ForceSpecConstr #-}
+ #endif
+ 
+ emptyStream :: String
+diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs
+index 78f7260..f4ea80a 100644
+--- a/Data/Vector/Generic.hs
++++ b/Data/Vector/Generic.hs
+@@ -157,7 +157,7 @@ module Data.Vector.Generic (
+   showsPrec, readPrec,
+ 
+   -- ** @Data@ and @Typeable@
+-  gfoldl, dataCast, mkType
++  gfoldl, mkType
+ ) where
+ 
+ import           Data.Vector.Generic.Base
+@@ -194,7 +194,7 @@ import Prelude hiding ( length, null,
+                         showsPrec )
+ 
+ import qualified Text.Read as Read
+-import Data.Typeable ( Typeable1, gcast1 )
++import Data.Typeable ( gcast1 )
+ 
+ #include "vector.h"
+ 
+@@ -2019,9 +2019,3 @@ gfoldl f z v = z fromList `f` toList v
+ mkType :: String -> DataType
+ {-# INLINE mkType #-}
+ mkType = mkNoRepType
+-
+-dataCast :: (Vector v a, Data a, Typeable1 v, Typeable1 t)
+-         => (forall d. Data  d => c (t d)) -> Maybe  (c (v a))
+-{-# INLINE dataCast #-}
+-dataCast f = gcast1 f
+-
+diff --git a/Data/Vector/Primitive.hs b/Data/Vector/Primitive.hs
+index 5f59bae..06e84c3 100644
+--- a/Data/Vector/Primitive.hs
++++ b/Data/Vector/Primitive.hs
+@@ -188,7 +188,6 @@ instance (Data a, Prim a) => Data (Vector a) where
+   toConstr _   = error "toConstr"
+   gunfold _ _  = error "gunfold"
+   dataTypeOf _ = G.mkType "Data.Vector.Primitive.Vector"
+-  dataCast1    = G.dataCast
+ 
+ 
+ type instance G.Mutable Vector = MVector
+diff --git a/Data/Vector/Storable.hs b/Data/Vector/Storable.hs
+index f9928e4..a17e3d6 100644
+--- a/Data/Vector/Storable.hs
++++ b/Data/Vector/Storable.hs
+@@ -194,7 +194,6 @@ instance (Data a, Storable a) => Data (Vector a) where
+   toConstr _   = error "toConstr"
+   gunfold _ _  = error "gunfold"
+   dataTypeOf _ = G.mkType "Data.Vector.Storable.Vector"
+-  dataCast1    = G.dataCast
+ 
+ type instance G.Mutable Vector = MVector
+ 
+diff --git a/Data/Vector/Unboxed/Base.hs b/Data/Vector/Unboxed/Base.hs
+index 00350cb..c13ea20 100644
+--- a/Data/Vector/Unboxed/Base.hs
++++ b/Data/Vector/Unboxed/Base.hs
+@@ -31,7 +31,7 @@ import Data.Word ( Word, Word8, Word16, Word32, Word64 )
+ import Data.Int  ( Int8, Int16, Int32, Int64 )
+ import Data.Complex
+ 
+-import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp,
++import Data.Typeable ( mkTyConApp,
+ #if MIN_VERSION_base(4,4,0)
+                        mkTyCon3
+ #else
+@@ -65,19 +65,6 @@ vectorTyCon = mkTyCon3 "vector"
+ vectorTyCon m s = mkTyCon $ m ++ "." ++ s
+ #endif
+ 
+-instance Typeable1 Vector where
+-  typeOf1 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") []
+-
+-instance Typeable2 MVector where
+-  typeOf2 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable" "MVector") []
+-
+-instance (Data a, Unbox a) => Data (Vector a) where
+-  gfoldl       = G.gfoldl
+-  toConstr _   = error "toConstr"
+-  gunfold _ _  = error "gunfold"
+-  dataTypeOf _ = G.mkType "Data.Vector.Unboxed.Vector"
+-  dataCast1    = G.dataCast
+-
+ -- ----
+ -- Unit
+ -- ----
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/wai-app-static_1.3.1-remove-TH.patch b/standalone/android/haskell-patches/wai-app-static_deal-with-TH.patch
similarity index 54%
rename from standalone/android/haskell-patches/wai-app-static_1.3.1-remove-TH.patch
rename to standalone/android/haskell-patches/wai-app-static_deal-with-TH.patch
index 30bf5256a0..d9860f922c 100644
--- a/standalone/android/haskell-patches/wai-app-static_1.3.1-remove-TH.patch
+++ b/standalone/android/haskell-patches/wai-app-static_deal-with-TH.patch
@@ -1,16 +1,19 @@
-From c18ae75852b1340ca502528138bf421659f61a3d Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Mon, 15 Apr 2013 12:44:15 -0400
-Subject: [PATCH] remove TH
+From 432a8fc47bb11cf8fd0a832e033cfb94a6332dbe Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sun, 22 Sep 2013 07:29:39 +0000
+Subject: [PATCH] deal with TH
+
+Export modules referenced by it.
 
 Should not need these icons in git-annex, so not worth using the Evil
 Splicer.
 ---
- Network/Wai/Application/Static.hs | 4 ----
- 1 file changed, 4 deletions(-)
+ Network/Wai/Application/Static.hs |    4 ----
+ wai-app-static.cabal              |    2 +-
+ 2 files changed, 1 insertion(+), 5 deletions(-)
 
 diff --git a/Network/Wai/Application/Static.hs b/Network/Wai/Application/Static.hs
-index 3195fbb..b48aa01 100644
+index 3f07391..75709b7 100644
 --- a/Network/Wai/Application/Static.hs
 +++ b/Network/Wai/Application/Static.hs
 @@ -33,8 +33,6 @@ import Control.Monad.IO.Class (liftIO)
@@ -31,6 +34,21 @@ index 3195fbb..b48aa01 100644
  staticAppPieces ss rawPieces req = liftIO $ do
      case toPieces rawPieces of
          Just pieces -> checkPieces ss pieces req >>= response
+diff --git a/wai-app-static.cabal b/wai-app-static.cabal
+index ec22813..e944caa 100644
+--- a/wai-app-static.cabal
++++ b/wai-app-static.cabal
+@@ -56,9 +56,9 @@ library
+                      WaiAppStatic.Storage.Embedded
+                      WaiAppStatic.Listing
+                      WaiAppStatic.Types
+-    other-modules:   Util
+                      WaiAppStatic.Storage.Embedded.Runtime
+                      WaiAppStatic.Storage.Embedded.TH
++    other-modules:   Util
+     ghc-options:     -Wall
+     extensions:     CPP
+ 
 -- 
-1.8.2.rc3
+1.7.10.4
 
diff --git a/standalone/android/haskell-patches/wai-extra_1.3.2.1_0001-disable-CGI-module.patch b/standalone/android/haskell-patches/wai-extra_1.3.2.1_0001-disable-CGI-module.patch
deleted file mode 100644
index 7d5d6e2ba2..0000000000
--- a/standalone/android/haskell-patches/wai-extra_1.3.2.1_0001-disable-CGI-module.patch
+++ /dev/null
@@ -1,26 +0,0 @@
-From dc6d0128e666dcab07ddee56a22a4177ebfc0c7b Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:38:33 -0400
-Subject: [PATCH] disable CGI module
-
-I don't need it and it failed to build.
----
- wai-extra.cabal |    2 +-
- 1 file changed, 1 insertion(+), 1 deletion(-)
-
-diff --git a/wai-extra.cabal b/wai-extra.cabal
-index 9e9f0fc..007dd0f 100644
---- a/wai-extra.cabal
-+++ b/wai-extra.cabal
-@@ -44,7 +44,7 @@ Library
-                    , void                      >= 0.5      && < 0.6
-                    , stringsearch              >= 0.3      && < 0.4
- 
--  Exposed-modules:   Network.Wai.Handler.CGI
-+  Exposed-modules:
-                      Network.Wai.Middleware.AcceptOverride
-                      Network.Wai.Middleware.Autohead
-                      Network.Wai.Middleware.CleanPath
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/xml-hamlet_0.4.0.3-0001-remove-TH-code.patch b/standalone/android/haskell-patches/xml-hamlet_0.4.0.3-0001-remove-TH-code.patch
deleted file mode 100644
index e6bda563df..0000000000
--- a/standalone/android/haskell-patches/xml-hamlet_0.4.0.3-0001-remove-TH-code.patch
+++ /dev/null
@@ -1,108 +0,0 @@
-From 3e988dec5ea248611d07d59914e3eb131dc6a165 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 18 Apr 2013 17:44:46 -0400
-Subject: [PATCH] remove TH code
-
----
- Text/Hamlet/XML.hs | 81 +-----------------------------------------------------
- 1 file changed, 1 insertion(+), 80 deletions(-)
-
-diff --git a/Text/Hamlet/XML.hs b/Text/Hamlet/XML.hs
-index f587410..bf8ce9e 100644
---- a/Text/Hamlet/XML.hs
-+++ b/Text/Hamlet/XML.hs
-@@ -1,8 +1,7 @@
- {-# LANGUAGE TemplateHaskell #-}
- {-# OPTIONS_GHC -fno-warn-missing-fields #-}
- module Text.Hamlet.XML
--    ( xml
--    , xmlFile
-+    (
-     ) where
- 
- import Language.Haskell.TH.Syntax
-@@ -18,81 +17,3 @@ import Data.String (fromString)
- import qualified Data.Foldable as F
- import Data.Maybe (fromMaybe)
- import qualified Data.Map as Map
--
--xml :: QuasiQuoter
--xml = QuasiQuoter { quoteExp = strToExp }
--
--xmlFile :: FilePath -> Q Exp
--xmlFile = strToExp . TL.unpack <=< qRunIO . readUtf8File
--
--strToExp :: String -> Q Exp
--strToExp s =
--    case parseDoc s of
--        Error e -> error e
--        Ok x -> docsToExp [] x
--
--docsToExp :: Scope -> [Doc] -> Q Exp
--docsToExp scope docs = [| concat $(fmap ListE $ mapM (docToExp scope) docs) |]
--
--docToExp :: Scope -> Doc -> Q Exp
--docToExp scope (DocTag name attrs cs) =
--    [| [ X.NodeElement (X.Element ($(liftName name)) $(mkAttrs scope attrs) $(docsToExp scope cs))
--       ] |]
--docToExp _ (DocContent (ContentRaw s)) = [| [ X.NodeContent (pack $(lift s)) ] |]
--docToExp scope (DocContent (ContentVar d)) = [| [ X.NodeContent $(return $ derefToExp scope d) ] |]
--docToExp scope (DocContent (ContentEmbed d)) = return $ derefToExp scope d
--docToExp scope (DocForall deref ident@(Ident ident') inside) = do
--    let list' = derefToExp scope deref
--    name <- newName ident'
--    let scope' = (ident, VarE name) : scope
--    inside' <- docsToExp scope' inside
--    let lam = LamE [VarP name] inside'
--    [| F.concatMap $(return lam) $(return list') |]
--docToExp scope (DocWith [] inside) = docsToExp scope inside
--docToExp scope (DocWith ((deref, ident@(Ident name)):dis) inside) = do
--    let deref' = derefToExp scope deref
--    name' <- newName name
--    let scope' = (ident, VarE name') : scope
--    inside' <- docToExp scope' (DocWith dis inside)
--    let lam = LamE [VarP name'] inside'
--    return $ lam `AppE` deref'
--docToExp scope (DocMaybe deref ident@(Ident name) just nothing) = do
--    let deref' = derefToExp scope deref
--    name' <- newName name
--    let scope' = (ident, VarE name') : scope
--    inside' <- docsToExp scope' just
--    let inside'' = LamE [VarP name'] inside'
--    nothing' <-
--        case nothing of
--            Nothing -> [| [] |]
--            Just n -> docsToExp scope n
--    [| maybe $(return nothing') $(return inside'') $(return deref') |]
--docToExp scope (DocCond conds final) = do
--    unit <- [| () |]
--    body <- fmap GuardedB $ mapM go $ conds ++ [(DerefIdent $ Ident "otherwise", fromMaybe [] final)]
--    return $ CaseE unit [Match (TupP []) body []]
--  where
--    go (deref, inside) = do
--        inside' <- docsToExp scope inside
--        return (NormalG $ derefToExp scope deref, inside')
--
--mkAttrs :: Scope -> [(Maybe Deref, String, [Content])] -> Q Exp
--mkAttrs _ [] = [| Map.empty |]
--mkAttrs scope ((mderef, name, value):rest) = do
--    rest' <- mkAttrs scope rest
--    this <- [| Map.insert $(liftName name) (T.concat $(fmap ListE $ mapM go value)) |]
--    let with = [| $(return this) $(return rest') |]
--    case mderef of
--        Nothing -> with
--        Just deref -> [| if $(return $ derefToExp scope deref) then $(with) else $(return rest') |]
--  where
--    go (ContentRaw s) = [| pack $(lift s) |]
--    go (ContentVar d) = return $ derefToExp scope d
--    go ContentEmbed{} = error "Cannot use embed interpolation in attribute value"
--
--liftName :: String -> Q Exp
--liftName s = do
--    X.Name local mns _ <- return $ fromString s
--    case mns of
--        Nothing -> [| X.Name (pack $(lift $ unpack local)) Nothing Nothing |]
--        Just ns -> [| X.Name (pack $(lift $ unpack local)) (Just $ pack $(lift $ unpack ns)) Nothing |]
--- 
-1.8.2.rc3
-
diff --git a/standalone/android/haskell-patches/yesod-auth_don-t-really-build.patch b/standalone/android/haskell-patches/yesod-auth_don-t-really-build.patch
new file mode 100644
index 0000000000..7016e001ce
--- /dev/null
+++ b/standalone/android/haskell-patches/yesod-auth_don-t-really-build.patch
@@ -0,0 +1,34 @@
+From 3eb7b0a42099721dc19363ac41319efeed4ac5f9 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sun, 22 Sep 2013 05:19:53 +0000
+Subject: [PATCH] don't really build
+
+---
+ yesod-auth.cabal |   11 +----------
+ 1 file changed, 1 insertion(+), 10 deletions(-)
+
+diff --git a/yesod-auth.cabal b/yesod-auth.cabal
+index 591ced5..11217be 100644
+--- a/yesod-auth.cabal
++++ b/yesod-auth.cabal
+@@ -52,16 +52,7 @@ library
+                    , safe
+                    , time
+ 
+-    exposed-modules: Yesod.Auth
+-                     Yesod.Auth.BrowserId
+-                     Yesod.Auth.Dummy
+-                     Yesod.Auth.Email
+-                     Yesod.Auth.OpenId
+-                     Yesod.Auth.Rpxnow
+-                     Yesod.Auth.HashDB
+-                     Yesod.Auth.Message
+-                     Yesod.Auth.GoogleEmail
+-    other-modules:   Yesod.Auth.Routes
++    exposed-modules: 
+     ghc-options:     -Wall
+ 
+ source-repository head
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/yesod-core_1.1.8_0001-remove-TH.patch b/standalone/android/haskell-patches/yesod-core_1.1.8_0001-remove-TH.patch
deleted file mode 100644
index fd641a1aa3..0000000000
--- a/standalone/android/haskell-patches/yesod-core_1.1.8_0001-remove-TH.patch
+++ /dev/null
@@ -1,476 +0,0 @@
-From 801f6dea3be43113400e41aabb443456fffcd227 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:39:40 -0400
-Subject: [PATCH 1/2] remove TH
-
----
- Yesod/Core.hs           |   10 ----
- Yesod/Dispatch.hs       |  119 +----------------------------------------------
- Yesod/Handler.hs        |   27 +----------
- Yesod/Internal/Cache.hs |    5 --
- Yesod/Internal/Core.hs  |  119 +++++------------------------------------------
- Yesod/Widget.hs         |   29 ------------
- 6 files changed, 13 insertions(+), 296 deletions(-)
-
-diff --git a/Yesod/Core.hs b/Yesod/Core.hs
-index 7268d6c..ce04b7d 100644
---- a/Yesod/Core.hs
-+++ b/Yesod/Core.hs
-@@ -21,16 +21,6 @@ module Yesod.Core
-     , unauthorizedI
-       -- * Logging
-     , LogLevel (..)
--    , logDebug
--    , logInfo
--    , logWarn
--    , logError
--    , logOther
--    , logDebugS
--    , logInfoS
--    , logWarnS
--    , logErrorS
--    , logOtherS
-       -- * Sessions
-     , SessionBackend (..)
-     , defaultClientSessionBackend
-diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs
-index 1e19388..dd37475 100644
---- a/Yesod/Dispatch.hs
-+++ b/Yesod/Dispatch.hs
-@@ -6,20 +6,9 @@
- {-# LANGUAGE MultiParamTypeClasses #-}
- module Yesod.Dispatch
-     ( -- * Quasi-quoted routing
--      parseRoutes
--    , parseRoutesNoCheck
--    , parseRoutesFile
--    , parseRoutesFileNoCheck
--    , mkYesod
--    , mkYesodSub
-       -- ** More fine-grained
--    , mkYesodData
--    , mkYesodSubData
--    , mkYesodDispatch
--    , mkYesodSubDispatch
--    , mkDispatchInstance
-       -- ** Path pieces
--    , PathPiece (..)
-+      PathPiece (..)
-     , PathMultiPiece (..)
-     , Texts
-       -- * Convert to WAI
-@@ -52,117 +41,11 @@ import Data.Monoid (mappend)
- import qualified Data.ByteString as S
- import qualified Blaze.ByteString.Builder
- import Network.HTTP.Types (status301)
--import Yesod.Routes.TH
- import Yesod.Content (chooseRep)
--import Yesod.Routes.Parse
- import System.Log.FastLogger (Logger)
- 
- type Texts = [Text]
- 
---- | Generates URL datatype and site function for the given 'Resource's. This
---- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter.
---- Use 'parseRoutes' to create the 'Resource's.
--mkYesod :: String -- ^ name of the argument datatype
--        -> [ResourceTree String]
--        -> Q [Dec]
--mkYesod name = fmap (uncurry (++)) . mkYesodGeneral name [] [] False
--
---- | Generates URL datatype and site function for the given 'Resource's. This
---- is used for creating subsites, /not/ sites. See 'mkYesod' for the latter.
---- Use 'parseRoutes' to create the 'Resource's. In general, a subsite is not
---- executable by itself, but instead provides functionality to
---- be embedded in other sites.
--mkYesodSub :: String -- ^ name of the argument datatype
--           -> Cxt
--           -> [ResourceTree String]
--           -> Q [Dec]
--mkYesodSub name clazzes =
--    fmap (uncurry (++)) . mkYesodGeneral name' rest clazzes True
--  where
--    (name':rest) = words name
--
---- | Sometimes, you will want to declare your routes in one file and define
---- your handlers elsewhere. For example, this is the only way to break up a
---- monolithic file into smaller parts. Use this function, paired with
---- 'mkYesodDispatch', to do just that.
--mkYesodData :: String -> [ResourceTree String] -> Q [Dec]
--mkYesodData name res = mkYesodDataGeneral name [] False res
--
--mkYesodSubData :: String -> Cxt -> [ResourceTree String] -> Q [Dec]
--mkYesodSubData name clazzes res = mkYesodDataGeneral name clazzes True res
--
--mkYesodDataGeneral :: String -> Cxt -> Bool -> [ResourceTree String] -> Q [Dec]
--mkYesodDataGeneral name clazzes isSub res = do
--    let (name':rest) = words name
--    (x, _) <- mkYesodGeneral name' rest clazzes isSub res
--    let rname = mkName $ "resources" ++ name
--    eres <- lift res
--    let y = [ SigD rname $ ListT `AppT` (ConT ''ResourceTree `AppT` ConT ''String)
--            , FunD rname [Clause [] (NormalB eres) []]
--            ]
--    return $ x ++ y
--
---- | See 'mkYesodData'.
--mkYesodDispatch :: String -> [ResourceTree String] -> Q [Dec]
--mkYesodDispatch name = fmap snd . mkYesodGeneral name [] [] False
--
--mkYesodSubDispatch :: String -> Cxt -> [ResourceTree String] -> Q [Dec]
--mkYesodSubDispatch name clazzes = fmap snd . mkYesodGeneral name' rest clazzes True 
--  where (name':rest) = words name
--
--mkYesodGeneral :: String                   -- ^ foundation type
--               -> [String]                 -- ^ arguments for the type
--               -> Cxt                      -- ^ the type constraints
--               -> Bool                     -- ^ it this a subsite
--               -> [ResourceTree String]
--               -> Q([Dec],[Dec])
--mkYesodGeneral name args clazzes isSub resS = do
--     subsite        <- sub
--     masterTypeSyns <- if isSub then return   [] 
--                                else sequence [handler, widget]
--     renderRouteDec <- mkRenderRouteInstance subsite res
--     dispatchDec    <- mkDispatchInstance context sub master res
--     return (renderRouteDec ++ masterTypeSyns, dispatchDec)
--  where sub     = foldl appT subCons subArgs
--        master  = if isSub then (varT $ mkName "master") else sub
--        context = if isSub then cxt $ yesod : map return clazzes
--                           else return []
--        yesod   = classP ''Yesod [master]
--        handler = tySynD (mkName "Handler") [] [t| GHandler $master $master    |]
--        widget  = tySynD (mkName "Widget")  [] [t| GWidget  $master $master () |]
--        res     = map (fmap parseType) resS
--        subCons = conT $ mkName name
--        subArgs = map (varT. mkName) args
--        
---- | If the generation of @'YesodDispatch'@ instance require finer
---- control of the types, contexts etc. using this combinator. You will
---- hardly need this generality. However, in certain situations, like
---- when writing library/plugin for yesod, this combinator becomes
---- handy.
--mkDispatchInstance :: CxtQ                -- ^ The context
--                   -> TypeQ               -- ^ The subsite type
--                   -> TypeQ               -- ^ The master site type
--                   -> [ResourceTree a]    -- ^ The resource
--                   -> DecsQ
--mkDispatchInstance context sub master res = do
--  logger <- newName "logger"
--  let loggerE = varE logger
--      loggerP = VarP logger
--      yDispatch = conT ''YesodDispatch `appT` sub `appT` master
--      thisDispatch = do
--            Clause pat body decs <- mkDispatchClause
--                                    [|yesodRunner   $loggerE |]
--                                    [|yesodDispatch $loggerE |]
--                                    [|fmap chooseRep|]
--                                    res
--            return $ FunD 'yesodDispatch
--                         [ Clause (loggerP:pat)
--                                  body
--                                  decs
--                         ]
--      in sequence [instanceD context yDispatch [thisDispatch]]
--        
--
- -- | Convert the given argument into a WAI application, executable with any WAI
- -- handler. This is the same as 'toWaiAppPlain', except it includes two
- -- middlewares: GZIP compression and autohead. This is the
-diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs
-index 1997bdb..98c915c 100644
---- a/Yesod/Handler.hs
-+++ b/Yesod/Handler.hs
-@@ -42,7 +42,6 @@ module Yesod.Handler
-     , RedirectUrl (..)
-     , redirect
-     , redirectWith
--    , redirectToPost
-       -- ** Errors
-     , notFound
-     , badMethod
-@@ -100,7 +99,6 @@ module Yesod.Handler
-     , getMessageRender
-       -- * Per-request caching
-     , CacheKey
--    , mkCacheKey
-     , cacheLookup
-     , cacheInsert
-     , cacheDelete
-@@ -172,7 +170,7 @@ import System.Log.FastLogger
- import Control.Monad.Logger
- 
- import qualified Yesod.Internal.Cache as Cache
--import Yesod.Internal.Cache (mkCacheKey, CacheKey)
-+import Yesod.Internal.Cache (CacheKey)
- import qualified Data.IORef as I
- import Control.Exception.Lifted (catch)
- import Control.Monad.Trans.Control
-@@ -937,29 +935,6 @@ newIdent = do
-     put x { ghsIdent = i' }
-     return $ T.pack $ 'h' : show i'
- 
---- | Redirect to a POST resource.
----
---- This is not technically a redirect; instead, it returns an HTML page with a
---- POST form, and some Javascript to automatically submit the form. This can be
---- useful when you need to post a plain link somewhere that needs to cause
---- changes on the server.
--redirectToPost :: RedirectUrl master url => url -> GHandler sub master a
--redirectToPost url = do
--    urlText <- toTextUrl url
--    hamletToRepHtml [hamlet|
--$newline never
--$doctype 5
--
--
--    
--        Redirecting...
--    <body onload="document.getElementById('form').submit()">
--        <form id="form" method="post" action=#{urlText}>
--            <noscript>
--                <p>Javascript has been disabled; please click on the button below to be redirected.
--            <input type="submit" value="Continue">
--|] >>= sendResponse
--
- -- | Converts the given Hamlet template into 'Content', which can be used in a
- -- Yesod 'Response'.
- hamletToContent :: HtmlUrl (Route master) -> GHandler sub master Content
-diff --git a/Yesod/Internal/Cache.hs b/Yesod/Internal/Cache.hs
-index 4aec0d2..fdef9d7 100644
---- a/Yesod/Internal/Cache.hs
-+++ b/Yesod/Internal/Cache.hs
-@@ -3,7 +3,6 @@
- module Yesod.Internal.Cache
-     ( Cache
-     , CacheKey
--    , mkCacheKey
-     , lookup
-     , insert
-     , delete
-@@ -24,10 +23,6 @@ newtype Cache = Cache (Map.IntMap Any)
- 
- newtype CacheKey a = CacheKey Int
- 
---- | Generate a new 'CacheKey'. Be sure to give a full type signature.
--mkCacheKey :: Q Exp
--mkCacheKey = [|CacheKey|] `appE` (LitE . IntegerL . fromIntegral . hashUnique <$> runIO newUnique)
--
- lookup :: CacheKey a -> Cache -> Maybe a
- lookup (CacheKey i) (Cache m) = unsafeCoerce <$> Map.lookup i m
- 
-diff --git a/Yesod/Internal/Core.hs b/Yesod/Internal/Core.hs
-index c4a9796..90c05fc 100644
---- a/Yesod/Internal/Core.hs
-+++ b/Yesod/Internal/Core.hs
-@@ -44,7 +44,6 @@ module Yesod.Internal.Core
- 
- import Yesod.Content
- import Yesod.Handler hiding (lift, getExpires)
--import Control.Monad.Logger (logErrorS)
- 
- import Yesod.Routes.Class
- import Data.Time (UTCTime, addUTCTime, getCurrentTime)
-@@ -165,22 +164,7 @@ class RenderRoute a => Yesod a where
- 
-     -- | Applies some form of layout to the contents of a page.
-     defaultLayout :: GWidget sub a () -> GHandler sub a RepHtml
--    defaultLayout w = do
--        p <- widgetToPageContent w
--        mmsg <- getMessage
--        hamletToRepHtml [hamlet|
--$newline never
--$doctype 5
--
--<html>
--    <head>
--        <title>#{pageTitle p}
--        ^{pageHead p}
--    <body>
--        $maybe msg <- mmsg
--            <p .message>#{msg}
--        ^{pageBody p}
--|]
-+    defaultLayout w = error "defaultLayout not implemented"
- 
-     -- | Override the rendering function for a particular URL. One use case for
-     -- this is to offload static hosting to a different domain name to avoid
-@@ -521,46 +505,11 @@ applyLayout' title body = fmap chooseRep $ defaultLayout $ do
- 
- -- | The default error handler for 'errorHandler'.
- defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep
--defaultErrorHandler NotFound = do
--    r <- waiRequest
--    let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
--    applyLayout' "Not Found"
--        [hamlet|
--$newline never
--<h1>Not Found
--<p>#{path'}
--|]
--defaultErrorHandler (PermissionDenied msg) =
--    applyLayout' "Permission Denied"
--        [hamlet|
--$newline never
--<h1>Permission denied
--<p>#{msg}
--|]
--defaultErrorHandler (InvalidArgs ia) =
--    applyLayout' "Invalid Arguments"
--        [hamlet|
--$newline never
--<h1>Invalid Arguments
--<ul>
--    $forall msg <- ia
--        <li>#{msg}
--|]
--defaultErrorHandler (InternalError e) = do
--    $logErrorS "yesod-core" e
--    applyLayout' "Internal Server Error"
--        [hamlet|
--$newline never
--<h1>Internal Server Error
--<pre>#{e}
--|]
--defaultErrorHandler (BadMethod m) =
--    applyLayout' "Bad Method"
--        [hamlet|
--$newline never
--<h1>Method Not Supported
--<p>Method <code>#{S8.unpack m}</code> not supported
--|]
-+defaultErrorHandler NotFound = error "Not Found"
-+defaultErrorHandler (PermissionDenied msg) = error "Permission Denied"
-+defaultErrorHandler (InvalidArgs ia) = error "Invalid Arguments"
-+defaultErrorHandler (InternalError e) = error "Internal Server Error"
-+defaultErrorHandler (BadMethod m) = error "Bad Method"
- 
- -- | Return the same URL if the user is authorized to see it.
- --
-@@ -616,45 +565,10 @@ widgetToPageContent w = do
-     -- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing
-     -- the asynchronous loader means your page doesn't have to wait for all the js to load
-     let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
--        regularScriptLoad = [hamlet|
--$newline never
--$forall s <- scripts
--    ^{mkScriptTag s}
--$maybe j <- jscript
--    $maybe s <- jsLoc
--        <script src="#{s}">
--    $nothing
--        <script>^{jelper j}
--|]
--
--        headAll = [hamlet|
--$newline never
--\^{head'}
--$forall s <- stylesheets
--    ^{mkLinkTag s}
--$forall s <- css
--    $maybe t <- right $ snd s
--        $maybe media <- fst s
--            <link rel=stylesheet media=#{media} href=#{t}>
--        $nothing
--            <link rel=stylesheet href=#{t}>
--    $maybe content <- left $ snd s
--        $maybe media <- fst s
--            <style media=#{media}>#{content}
--        $nothing
--            <style>#{content}
--$case jsLoader master
--  $of BottomOfBody
--  $of BottomOfHeadAsync asyncJsLoader
--      ^{asyncJsLoader asyncScripts mcomplete}
--  $of BottomOfHeadBlocking
--      ^{regularScriptLoad}
--|]
--    let bodyScript = [hamlet|
--$newline never
--^{body}
--^{regularScriptLoad}
--|]
-+        regularScriptLoad = error "TODO"
-+
-+        headAll = error "TODO"
-+    let bodyScript = error "TODO"
- 
-     return $ PageContent title headAll (case jsLoader master of
-       BottomOfBody -> bodyScript
-@@ -696,18 +610,7 @@ jsonArray = unsafeLazyByteString . encode . Array . Vector.fromList . map String
- 
- -- | For use with setting 'jsLoader' to 'BottomOfHeadAsync'
- loadJsYepnope :: Yesod master => Either Text (Route master) -> [Text] -> Maybe (HtmlUrl (Route master)) -> (HtmlUrl (Route master))
--loadJsYepnope eyn scripts mcomplete =
--  [hamlet|
--$newline never
--    $maybe yn <- left eyn
--        <script src=#{yn}>
--    $maybe yn <- right eyn
--        <script src=@{yn}>
--    $maybe complete <- mcomplete
--        <script>yepnope({load:#{jsonArray scripts},complete:function(){^{complete}}});
--    $nothing
--        <script>yepnope({load:#{jsonArray scripts}});
--|]
-+loadJsYepnope eyn scripts mcomplete = error "TODO"
- 
- asyncHelper :: (url -> [x] -> Text)
-          -> [Script (url)]
-diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs
-index bd94bd3..bf79150 100644
---- a/Yesod/Widget.hs
-+++ b/Yesod/Widget.hs
-@@ -15,8 +15,6 @@ module Yesod.Widget
-       GWidget
-     , PageContent (..)
-       -- * Special Hamlet quasiquoter/TH for Widgets
--    , whamlet
--    , whamletFile
-     , ihamletToRepHtml
-       -- * Convert to Widget
-     , ToWidget (..)
-@@ -54,7 +52,6 @@ module Yesod.Widget
-     , addScriptEither
-       -- * Internal
-     , unGWidget
--    , whamletFileWithSettings
-     ) where
- 
- import Data.Monoid
-@@ -274,32 +271,6 @@ data PageContent url = PageContent
-     , pageBody :: HtmlUrl url
-     }
- 
--whamlet :: QuasiQuoter
--whamlet = NP.hamletWithSettings rules NP.defaultHamletSettings
--
--whamletFile :: FilePath -> Q Exp
--whamletFile = NP.hamletFileWithSettings rules NP.defaultHamletSettings
--
--whamletFileWithSettings :: NP.HamletSettings -> FilePath -> Q Exp
--whamletFileWithSettings = NP.hamletFileWithSettings rules
--
--rules :: Q NP.HamletRules
--rules = do
--    ah <- [|toWidget|]
--    let helper qg f = do
--            x <- newName "urender"
--            e <- f $ VarE x
--            let e' = LamE [VarP x] e
--            g <- qg
--            bind <- [|(>>=)|]
--            return $ InfixE (Just g) bind (Just e')
--    let ur f = do
--            let env = NP.Env
--                    (Just $ helper [|liftW getUrlRenderParams|])
--                    (Just $ helper [|liftM (toHtml .) $ liftW getMessageRender|])
--            f env
--    return $ NP.HamletRules ah ur $ \_ b -> return $ ah `AppE` b
--
- -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
- ihamletToRepHtml :: RenderMessage master message
-                  => HtmlUrlI18n message (Route master)
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/yesod-core_1.1.8_0002-replaced-TH-in-Yesod.Internal.Core.patch b/standalone/android/haskell-patches/yesod-core_1.1.8_0002-replaced-TH-in-Yesod.Internal.Core.patch
deleted file mode 100644
index af0b3d15b6..0000000000
--- a/standalone/android/haskell-patches/yesod-core_1.1.8_0002-replaced-TH-in-Yesod.Internal.Core.patch
+++ /dev/null
@@ -1,267 +0,0 @@
-From 9ae3db0b3292b53715232fecec3c5e2bf03b89cd Mon Sep 17 00:00:00 2001
-From: Joey Hess <joey@kitenet.net>
-Date: Fri, 1 Mar 2013 01:02:53 -0400
-Subject: [PATCH 2/2] replaced TH in Yesod.Internal.Core
-
-Done by running a build with -ddump-splices and manually pasting in the
-spliced code, and then modifying it until it compiles.
-
-(This predated the Evil Splicer, and both this and the previous patch need
-to be redone to use it.)
----
- Yesod/Internal/Core.hs |  211 +++++++++++++++++++++++++++++++++++++++++++++---
- 1 file changed, 201 insertions(+), 10 deletions(-)
-
-diff --git a/Yesod/Internal/Core.hs b/Yesod/Internal/Core.hs
-index 90c05fc..b9a0ae8 100644
---- a/Yesod/Internal/Core.hs
-+++ b/Yesod/Internal/Core.hs
-@@ -96,6 +96,9 @@ import System.Log.FastLogger (Logger, mkLogger, loggerDate, LogStr (..), loggerP
- import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther), LogSource)
- import System.Log.FastLogger.Date (ZonedDate)
- import System.IO (stdout)
-+import qualified Data.Foldable
-+import qualified Text.Blaze.Internal
-+import qualified Text.Hamlet
- 
- yesodVersion :: String
- yesodVersion = showVersion Paths_yesod_core.version
-@@ -164,7 +167,28 @@ class RenderRoute a => Yesod a where
- 
-     -- | Applies some form of layout to the contents of a page.
-     defaultLayout :: GWidget sub a () -> GHandler sub a RepHtml
--    defaultLayout w = error "defaultLayout not implemented"
-+    defaultLayout w = do
-+        p <- widgetToPageContent w
-+        mmsg <- getMessage
-+        hamletToRepHtml $ \ _render_ay88 -> do { id
-+                ((Text.Blaze.Internal.preEscapedText . T.pack)
-+                   "<!DOCTYPE html>\n<html><head><title>");
-+              id (TBH.toHtml (pageTitle p));
-+              id ((Text.Blaze.Internal.preEscapedText . T.pack) "");
-+              id (pageHead p) _render_ay88;
-+              id ((Text.Blaze.Internal.preEscapedText . T.pack) "");
-+              Text.Hamlet.maybeH
-+                mmsg
-+                (\ msg_ay89
-+                   -> do { id
-+                             ((Text.Blaze.Internal.preEscapedText . T.pack)
-+                                "
    ");
-+                           id (TBH.toHtml msg_ay89);
-+                           id ((Text.Blaze.Internal.preEscapedText . T.pack) "
    ") })
-+                Nothing;
-+              id (pageBody p) _render_ay88;
-+              id
-+                ((Text.Blaze.Internal.preEscapedText . T.pack) "") }
- 
-     -- | Override the rendering function for a particular URL. One use case for
-     -- this is to offload static hosting to a different domain name to avoid
-@@ -505,11 +529,45 @@ applyLayout' title body = fmap chooseRep $ defaultLayout $ do
- 
- -- | The default error handler for 'errorHandler'.
- defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep
--defaultErrorHandler NotFound = error "Not Found"
--defaultErrorHandler (PermissionDenied msg) = error "Permission Denied"
--defaultErrorHandler (InvalidArgs ia) = error "Invalid Arguments"
--defaultErrorHandler (InternalError e) = error "Internal Server Error"
--defaultErrorHandler (BadMethod m) = error "Bad Method"
-+defaultErrorHandler NotFound = do
-+    r <- waiRequest
-+    let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
-+    applyLayout' "Not Found" $ \ _render_ayac -> do { id
-+                ((Text.Blaze.Internal.preEscapedText . T.pack)
-+                   "
    Not Found
    ");
-+              id (TBH.toHtml path');
-+              id ((Text.Blaze.Internal.preEscapedText . T.pack) "
    ") }
-+defaultErrorHandler (PermissionDenied msg) =
-+    applyLayout' "Permission Denied" $  \ _render_ayah -> do { id
-+                ((Text.Blaze.Internal.preEscapedText . T.pack)
-+                   "
    Permission denied
    ");
-+              id (TBH.toHtml msg);
-+              id ((Text.Blaze.Internal.preEscapedText . T.pack) "
    ") }
-+defaultErrorHandler (InvalidArgs ia) =
-+    applyLayout' "Invalid Arguments" $  \ _render_ayam -> do { id
-+                ((Text.Blaze.Internal.preEscapedText . T.pack)
-+                   "
    Invalid Arguments
      ");
-+              Data.Foldable.mapM_
-+                (\ msg_ayan
-+                   -> do { id ((Text.Blaze.Internal.preEscapedText . T.pack) "
    • ");
-+                           id (TBH.toHtml msg_ayan);
-+                           id ((Text.Blaze.Internal.preEscapedText . T.pack) "
      • ") })
-+                ia;
-+              id ((Text.Blaze.Internal.preEscapedText . T.pack) "
    ") }
-+defaultErrorHandler (InternalError e) = do
-+    applyLayout' "Internal Server Error" $  \ _render_ayau -> do { id
-+                ((Text.Blaze.Internal.preEscapedText . T.pack)
-+                   "
    Internal Server Error
    ");
-+              id (TBH.toHtml e);
-+              id ((Text.Blaze.Internal.preEscapedText . T.pack) "
    ") }
-+defaultErrorHandler (BadMethod m) =
-+    applyLayout' "Bad Method" $ \ _render_ayaz -> do { id
-+                ((Text.Blaze.Internal.preEscapedText . T.pack)
-+                   "
    Method Not Supported
    Method ");
-+              id (TBH.toHtml (S8.unpack m));
-+              id
-+                ((Text.Blaze.Internal.preEscapedText . T.pack)
-+                   " not supported
    ") }
- 
- -- | Return the same URL if the user is authorized to see it.
- --
-@@ -565,10 +623,99 @@ widgetToPageContent w = do
-     -- modernizr should be at the end of the  http://www.modernizr.com/docs/#installing
-     -- the asynchronous loader means your page doesn't have to wait for all the js to load
-     let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
--        regularScriptLoad = error "TODO"
--
--        headAll = error "TODO"
--    let bodyScript = error "TODO"
-+        regularScriptLoad =  \ _render_aybs -> do { Data.Foldable.mapM_
-+                (\ s_aybt
-+                   -> id (mkScriptTag s_aybt) _render_aybs)
-+                scripts;
-+              Text.Hamlet.maybeH
-+                jscript
-+                (\ j_aybu
-+                   -> Text.Hamlet.maybeH
-+                        jsLoc
-+                        (\ s_aybv
-+                           -> do { id
-+                                     ((Text.Blaze.Internal.preEscapedText . T.pack)
-+                                        "") })
-+                        (Just
-+                           (do { id
-+                                   ((Text.Blaze.Internal.preEscapedText . T.pack) "") })))
-+                Nothing }
-+
-+        headAll = \ _render_aybz  -> do
-+            { id head' _render_aybz;
-+              Data.Foldable.mapM_
-+                (\ s_aybA -> id (mkLinkTag s_aybA) _render_aybz)
-+                stylesheets;
-+              Data.Foldable.mapM_
-+                (\ s_aybB
-+                   -> do { Text.Hamlet.maybeH
-+                             (right (snd s_aybB))
-+                             (\ t_aybC
-+                                -> Text.Hamlet.maybeH
-+                                     (fst s_aybB)
-+                                     (\ media_aybD
-+                                        -> do { id
-+                                                  ((Text.Blaze.Internal.preEscapedText . T.pack)
-+                                                     "") })
-+                                     (Just
-+                                        (do { id
-+                                                ((Text.Blaze.Internal.preEscapedText . T.pack)
-+                                                   "") })))
-+                             Nothing;
-+                           Text.Hamlet.maybeH
-+                             (left (snd s_aybB))
-+                             (\ content_aybE
-+                                -> Text.Hamlet.maybeH
-+                                     (fst s_aybB)
-+                                     (\ media_aybF
-+                                        -> do { id
-+                                                  ((Text.Blaze.Internal.preEscapedText . T.pack)
-+                                                     "") })
-+                                     (Just
-+                                        (do { id
-+                                                ((Text.Blaze.Internal.preEscapedText . T.pack)
-+                                                   "") })))
-+                             Nothing })
-+                css;
-+              case jsLoader master of
-+                BottomOfBody -> return ()
-+                BottomOfHeadAsync asyncJsLoader -> id (asyncJsLoader asyncScripts mcomplete) _render_aybz
-+                BottomOfHeadBlocking -> id regularScriptLoad _render_aybz
-+            }
-+
-+    let bodyScript = \ _render_aybL -> do {
-+              id body _render_aybL;
-+              id regularScriptLoad _render_aybL }
- 
-     return $ PageContent title headAll (case jsLoader master of
-       BottomOfBody -> bodyScript
-@@ -611,6 +758,50 @@ jsonArray = unsafeLazyByteString . encode . Array . Vector.fromList . map String
- -- | For use with setting 'jsLoader' to 'BottomOfHeadAsync'
- loadJsYepnope :: Yesod master => Either Text (Route master) -> [Text] -> Maybe (HtmlUrl (Route master)) -> (HtmlUrl (Route master))
- loadJsYepnope eyn scripts mcomplete = error "TODO"
-+{-
-+    \ _render_aybU
-+      -> do { Text.Hamlet.maybeH
-+                (left eyn)
-+                (\ yn_aybV
-+                   -> do { id
-+                             ((Text.Blaze.Internal.preEscapedText . T.pack) "") })
-+                Nothing;
-+              Text.Hamlet.maybeH
-+                (right eyn)
-+                (\ yn_aybW
-+                   -> do { id
-+                             ((Text.Blaze.Internal.preEscapedText . T.pack) "") })
-+                Nothing;
-+              Text.Hamlet.maybeH
-+                mcomplete
-+                (\ complete_aybY
-+                   -> do { id
-+                             ((Text.Blaze.Internal.preEscapedText . T.pack)
-+                                "") })
-+                (Just
-+                   (do { id
-+                           ((Text.Blaze.Internal.preEscapedText . T.pack)
-+                              "") })) }
-+-}
- 
- asyncHelper :: (url -> [x] -> Text)
-          -> [Script (url)]
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/yesod-core_1.1.8_0003-exports-for-TH-splices.patch b/standalone/android/haskell-patches/yesod-core_1.1.8_0003-exports-for-TH-splices.patch
deleted file mode 100644
index 440b57ac8b..0000000000
--- a/standalone/android/haskell-patches/yesod-core_1.1.8_0003-exports-for-TH-splices.patch
+++ /dev/null
@@ -1,26 +0,0 @@
-From b7e01a2fded6575678db234e1f2de1f104f11376 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Mon, 15 Apr 2013 15:25:07 -0400
-Subject: [PATCH 3/3] exports for TH splices
-
----
- Yesod/Widget.hs | 3 +++
- 1 file changed, 3 insertions(+)
-
-diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs
-index bf79150..01ae294 100644
---- a/Yesod/Widget.hs
-+++ b/Yesod/Widget.hs
-@@ -52,6 +52,9 @@ module Yesod.Widget
-     , addScriptEither
-       -- * Internal
-     , unGWidget
-+
-+    -- used by TH code
-+    , liftW
-     ) where
- 
- import Data.Monoid
--- 
-1.8.2.rc3
-
diff --git a/standalone/android/haskell-patches/yesod-core_expand_TH.patch b/standalone/android/haskell-patches/yesod-core_expand_TH.patch
new file mode 100644
index 0000000000..9ea21f625d
--- /dev/null
+++ b/standalone/android/haskell-patches/yesod-core_expand_TH.patch
@@ -0,0 +1,427 @@
+From 9e15d4af1f53c76a402ec1782e0306a4bee7eec7 Mon Sep 17 00:00:00 2001
+From: foo 
+Date: Sun, 22 Sep 2013 04:03:56 +0000
+Subject: [PATCH] expad TH
+
+used EvilSplicer
+Has to remove some logger TH splices which didn't come out.
+---
+ Yesod/Core.hs              |    2 -
+ Yesod/Core/Class/Yesod.hs  |  247 ++++++++++++++++++++++++++++++--------------
+ Yesod/Core/Dispatch.hs     |    7 --
+ Yesod/Core/Handler.hs      |   24 ++---
+ Yesod/Core/Internal/Run.hs |    2 -
+ Yesod/Core/Widget.hs       |    2 +
+ 6 files changed, 181 insertions(+), 103 deletions(-)
+
+diff --git a/Yesod/Core.hs b/Yesod/Core.hs
+index 12e59d5..f1ff21c 100644
+--- a/Yesod/Core.hs
++++ b/Yesod/Core.hs
+@@ -94,8 +94,6 @@ module Yesod.Core
+     , JavascriptUrl
+     , renderJavascriptUrl
+       -- ** Cassius/Lucius
+-    , cassius
+-    , lucius
+     , CssUrl
+     , renderCssUrl
+     ) where
+diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs
+index cf02a1a..3f1e88e 100644
+--- a/Yesod/Core/Class/Yesod.hs
++++ b/Yesod/Core/Class/Yesod.hs
+@@ -9,6 +9,10 @@ import           Yesod.Core.Content
+ import           Yesod.Core.Handler
+ 
+ import           Yesod.Routes.Class
++import qualified Text.Blaze.Internal
++import qualified Control.Monad.Logger
++import qualified Text.Hamlet
++import qualified Data.Foldable
+ 
+ import           Blaze.ByteString.Builder           (Builder)
+ import           Blaze.ByteString.Builder.Char.Utf8 (fromText)
+@@ -87,18 +91,27 @@ class RenderRoute site => Yesod site where
+     defaultLayout w = do
+         p <- widgetToPageContent w
+         mmsg <- getMessage
+-        giveUrlRenderer [hamlet|
+-            $newline never
+-            $doctype 5
+-            
+-                
+-                    #{pageTitle p}
+-                    ^{pageHead p}
+-                <body>
+-                    $maybe msg <- mmsg
+-                        <p .message>#{msg}
+-                    ^{pageBody p}
+-            |]
++        giveUrlRenderer  $         \ _render_aHra
++          -> do { id
++                    ((Text.Blaze.Internal.preEscapedText . T.pack)
++                       "<!DOCTYPE html>\n<html><head><title>");
++                  id (TBH.toHtml (pageTitle p));
++                  id ((Text.Blaze.Internal.preEscapedText . T.pack) "");
++                  Text.Hamlet.asHtmlUrl (pageHead p) _render_aHra;
++                  id ((Text.Blaze.Internal.preEscapedText . T.pack) "");
++                  Text.Hamlet.maybeH
++                    mmsg
++                    (\ msg_aHrb
++                       -> do { id
++                                 ((Text.Blaze.Internal.preEscapedText . T.pack)
++                                    "
    ");
++                               id (TBH.toHtml msg_aHrb);
++                               id ((Text.Blaze.Internal.preEscapedText . T.pack) "
    ") })
++                    Nothing;
++                  Text.Hamlet.asHtmlUrl (pageBody p) _render_aHra;
++                  id
++                    ((Text.Blaze.Internal.preEscapedText . T.pack) "") }
++
+ 
+     -- | Override the rendering function for a particular URL. One use case for
+     -- this is to offload static hosting to a different domain name to avoid
+@@ -356,45 +369,103 @@ widgetToPageContent w = do
+     -- modernizr should be at the end of the  http://www.modernizr.com/docs/#installing
+     -- the asynchronous loader means your page doesn't have to wait for all the js to load
+     let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
+-        regularScriptLoad = [hamlet|
+-            $newline never
+-            $forall s <- scripts
+-                ^{mkScriptTag s}
+-            $maybe j <- jscript
+-                $maybe s <- jsLoc
+-                    ") })
++                            (Just
++                               (do { id
++                                       ((Text.Blaze.Internal.preEscapedText . T.pack) "") })))
++                    Nothing }
++
++
++        headAll =         \ _render_aHsW
++          -> do { Text.Hamlet.asHtmlUrl head' _render_aHsW;
++                  Data.Foldable.mapM_
++                    (\ s_aHsX -> Text.Hamlet.asHtmlUrl (mkLinkTag s_aHsX) _render_aHsW)
++                    stylesheets;
++                  Data.Foldable.mapM_
++                    (\ s_aHsY
++                       -> do { Text.Hamlet.maybeH
++                                 (right (snd s_aHsY))
++                                 (\ t_aHsZ
++                                    -> Text.Hamlet.maybeH
++                                         (fst s_aHsY)
++                                         (\ media_aHt0
++                                            -> do { id
++                                                      ((Text.Blaze.Internal.preEscapedText . T.pack)
++                                                         "") })
++                                         (Just
++                                            (do { id
++                                                    ((Text.Blaze.Internal.preEscapedText . T.pack)
++                                                       "") })))
++                                 Nothing;
++                               Text.Hamlet.maybeH
++                                 (left (snd s_aHsY))
++                                 (\ content_aHt1
++                                    -> Text.Hamlet.maybeH
++                                         (fst s_aHsY)
++                                         (\ media_aHt2
++                                            -> do { id
++                                                      ((Text.Blaze.Internal.preEscapedText . T.pack)
++                                                         "") })
++                                         (Just
++                                            (do { id
++                                                    ((Text.Blaze.Internal.preEscapedText . T.pack)
++                                                       "") })))
++                                 Nothing })
++                    css;
++                  case jsLoader master of {
++                    BottomOfBody -> return ()
++                    ; BottomOfHeadAsync asyncJsLoader_aHt3
++                      -> Text.Hamlet.asHtmlUrl
++                           (asyncJsLoader_aHt3 asyncScripts mcomplete) _render_aHsW
++                    ; BottomOfHeadBlocking
++                      -> Text.Hamlet.asHtmlUrl regularScriptLoad _render_aHsW } }
++
++    let bodyScript =     \ _render_aHt8 -> do { Text.Hamlet.asHtmlUrl body _render_aHt8;
++              Text.Hamlet.asHtmlUrl regularScriptLoad _render_aHt8 }
++
+ 
+     return $ PageContent title headAll $
+         case jsLoader master of
+@@ -424,10 +495,13 @@ defaultErrorHandler NotFound = selectRep $ do
+         r <- waiRequest
+         let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
+         setTitle "Not Found"
+-        toWidget [hamlet|
+-            
    Not Found
+-            
    #{path'}
+-        |]
++        toWidget  $         \ _render_aHte
++          -> do { id
++                    ((Text.Blaze.Internal.preEscapedText . T.pack)
++                       "
    Not Found
    \n
    ");
++                  id (TBH.toHtml path');
++                  id ((Text.Blaze.Internal.preEscapedText . T.pack) "
    ") }
++
+     provideRep $ return $ object ["message" .= ("Not Found" :: Text)]
+ 
+ -- For API requests.
+@@ -437,10 +511,11 @@ defaultErrorHandler NotFound = selectRep $ do
+ defaultErrorHandler NotAuthenticated = selectRep $ do
+     provideRep $ defaultLayout $ do
+         setTitle "Not logged in"
+-        toWidget [hamlet|
+-            
    Not logged in
+-            
    Set the authRoute and the user will be redirected there.
+-        |]
++        toWidget  $         \ _render_aHti
++          -> id
++               ((Text.Blaze.Internal.preEscapedText . T.pack)
++                  "
    Not logged in
    \n
    Set the authRoute and the user will be redirected there.
    ")
++
+ 
+     provideRep $ do
+         -- 401 *MUST* include a WWW-Authenticate header
+@@ -462,10 +537,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
+ defaultErrorHandler (PermissionDenied msg) = selectRep $ do
+     provideRep $ defaultLayout $ do
+         setTitle "Permission Denied"
+-        toWidget [hamlet|
+-            
    Permission denied
+-            
    #{msg}
+-        |]
++        toWidget  $         \ _render_aHtq
++          -> do { id
++                    ((Text.Blaze.Internal.preEscapedText . T.pack)
++                       "
    Permission denied
    \n
    ");
++                  id (TBH.toHtml msg);
++                  id ((Text.Blaze.Internal.preEscapedText . T.pack) "
    ") }
++
+     provideRep $
+         return $ object $ [
+           "message" .= ("Permission Denied. " <> msg)
+@@ -474,30 +552,43 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do
+ defaultErrorHandler (InvalidArgs ia) = selectRep $ do
+     provideRep $ defaultLayout $ do
+         setTitle "Invalid Arguments"
+-        toWidget [hamlet|
+-            
    Invalid Arguments
+-            
      
+-                $forall msg <- ia
+-                    
    • #{msg}
+-        |]
++        toWidget  $         \ _render_aHtv
++          -> do { id
++                    ((Text.Blaze.Internal.preEscapedText . T.pack)
++                       "
      Invalid Arguments
      \n
        ");
++                  Data.Foldable.mapM_
++                    (\ msg_aHtw
++                       -> do { id ((Text.Blaze.Internal.preEscapedText . T.pack) "
      • ");
++                               id (TBH.toHtml msg_aHtw);
++                               id ((Text.Blaze.Internal.preEscapedText . T.pack) "
        • ") })
++                    ia;
++                  id ((Text.Blaze.Internal.preEscapedText . T.pack) "
      ") }
++
+     provideRep $ return $ object ["message" .= ("Invalid Arguments" :: Text), "errors" .= ia]
+ defaultErrorHandler (InternalError e) = do
+-    $logErrorS "yesod-core" e
+     selectRep $ do
+         provideRep $ defaultLayout $ do
+             setTitle "Internal Server Error"
+-            toWidget [hamlet|
+-                
      Internal Server Error
+-                
      #{e}
+-            |]
++            toWidget  $             \ _render_aHtC
++              -> do { id
++                        ((Text.Blaze.Internal.preEscapedText . T.pack)
++                           "
      Internal Server Error
      \n
      ");
++                      id (TBH.toHtml e);
++                      id ((Text.Blaze.Internal.preEscapedText . T.pack) "
      ") }
++
+         provideRep $ return $ object ["message" .= ("Internal Server Error" :: Text), "error" .= e]
+ defaultErrorHandler (BadMethod m) = selectRep $ do
+     provideRep $ defaultLayout $ do
+         setTitle"Bad Method"
+-        toWidget [hamlet|
+-            
      Method Not Supported
+-            
      Method #{S8.unpack m} not supported
+-        |]
++        toWidget  $         \ _render_aHtH
++          -> do { id
++                    ((Text.Blaze.Internal.preEscapedText . T.pack)
++                       "
      Method Not Supported
      \n
      Method ");
++                  id (TBH.toHtml (S8.unpack m));
++                  id
++                    ((Text.Blaze.Internal.preEscapedText . T.pack)
++                       " not supported
      ") }
++
+     provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= m]
+ 
+ asyncHelper :: (url -> [x] -> Text)
+diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs
+index 335a15c..4ca05da 100644
+--- a/Yesod/Core/Dispatch.hs
++++ b/Yesod/Core/Dispatch.hs
+@@ -123,13 +123,6 @@ toWaiApp site = do
+                 , yreSite = site
+                 , yreSessionBackend = sb
+                 }
+-    messageLoggerSource
+-        site
+-        logger
+-        $(qLocation >>= liftLoc)
+-        "yesod-core"
+-        LevelInfo
+-        (toLogStr ("Application launched" :: S.ByteString))
+     middleware <- mkDefaultMiddlewares logger
+     return $ middleware $ toWaiAppYre yre
+ 
+diff --git a/Yesod/Core/Handler.hs b/Yesod/Core/Handler.hs
+index f3b1799..d819b04 100644
+--- a/Yesod/Core/Handler.hs
++++ b/Yesod/Core/Handler.hs
+@@ -152,7 +152,7 @@ import qualified Control.Monad.Trans.Writer    as Writer
+ 
+ import           Control.Monad.IO.Class        (MonadIO, liftIO)
+ import           Control.Monad.Trans.Resource  (MonadResource, liftResourceT)
+-
++import qualified Text.Blaze.Internal
+ import qualified Network.HTTP.Types            as H
+ import qualified Network.Wai                   as W
+ import Control.Monad.Trans.Class (lift)
+@@ -710,19 +710,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
+                -> m a
+ redirectToPost url = do
+     urlText <- toTextUrl url
+-    giveUrlRenderer [hamlet|
+-$newline never
+-$doctype 5
+-
+-
+-    
+-        Redirecting...
+-    <body onload="document.getElementById('form').submit()">
+-        <form id="form" method="post" action=#{urlText}>
+-            <noscript>
+-                <p>Javascript has been disabled; please click on the button below to be redirected.
+-            <input type="submit" value="Continue">
+-|] >>= sendResponse
++    giveUrlRenderer  $     \ _render_awps
++      -> do { id
++                ((Text.Blaze.Internal.preEscapedText . T.pack)
++                   "<!DOCTYPE html>\n<html><head><title>Redirecting...
      ") }
++ >>= sendResponse
+ 
+ -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
+ hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html
+diff --git a/Yesod/Core/Internal/Run.hs b/Yesod/Core/Internal/Run.hs
+index 35f1d3f..8b92e99 100644
+--- a/Yesod/Core/Internal/Run.hs
++++ b/Yesod/Core/Internal/Run.hs
+@@ -122,8 +122,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
+        -> ErrorResponse
+        -> YesodApp
+ safeEh log' er req = do
+-    liftIO $ log' $(qLocation >>= liftLoc) "yesod-core" LevelError
+-           $ toLogStr $ "Error handler errored out: " ++ show er
+     return $ YRPlain
+         H.status500
+         []
+diff --git a/Yesod/Core/Widget.hs b/Yesod/Core/Widget.hs
+index be97764..874f018 100644
+--- a/Yesod/Core/Widget.hs
++++ b/Yesod/Core/Widget.hs
+@@ -47,6 +47,8 @@ module Yesod.Core.Widget
+     , handlerToWidget
+       -- * Internal
+     , whamletFileWithSettings
++      -- used by TH
++    , asWidgetT
+     ) where
+ 
+ import Data.Monoid
+-- 
+1.7.10.4
+
diff --git a/standalone/android/haskell-patches/yesod-default_1.1.3.2_0001-remove-TH.patch b/standalone/android/haskell-patches/yesod-default_1.1.3.2_0001-remove-TH.patch
deleted file mode 100644
index e6048ee0a4..0000000000
--- a/standalone/android/haskell-patches/yesod-default_1.1.3.2_0001-remove-TH.patch
+++ /dev/null
@@ -1,102 +0,0 @@
-From 8ff7908799eb69d440168ff3df1fe3187879df33 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Thu, 28 Feb 2013 23:39:57 -0400
-Subject: [PATCH] remove TH
-
----
- Yesod/Default/Util.hs |   61 +------------------------------------------------
- 1 file changed, 1 insertion(+), 60 deletions(-)
-
-diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs
-index 578b9bc..178e342 100644
---- a/Yesod/Default/Util.hs
-+++ b/Yesod/Default/Util.hs
-@@ -5,8 +5,6 @@
- module Yesod.Default.Util
-     ( addStaticContentExternal
-     , globFile
--    , widgetFileNoReload
--    , widgetFileReload
-     , TemplateLanguage (..)
-     , defaultTemplateLanguages
-     , WidgetFileSettings
-@@ -21,9 +19,6 @@ import Yesod.Core -- purposely using complete import so that Haddock will see ad
- import Control.Monad (when, unless)
- import System.Directory (doesFileExist, createDirectoryIfMissing)
- import Language.Haskell.TH.Syntax
--import Text.Lucius (luciusFile, luciusFileReload)
--import Text.Julius (juliusFile, juliusFileReload)
--import Text.Cassius (cassiusFile, cassiusFileReload)
- import Text.Hamlet (HamletSettings, defaultHamletSettings)
- import Data.Maybe (catMaybes)
- import Data.Default (Default (def))
-@@ -72,13 +67,7 @@ data TemplateLanguage = TemplateLanguage
- 
- defaultTemplateLanguages :: HamletSettings -> [TemplateLanguage]
- defaultTemplateLanguages hset =
--    [ TemplateLanguage False "hamlet"  whamletFile' whamletFile'
--    , TemplateLanguage True  "cassius" cassiusFile  cassiusFileReload
--    , TemplateLanguage True  "julius"  juliusFile   juliusFileReload
--    , TemplateLanguage True  "lucius"  luciusFile   luciusFileReload
--    ]
--  where
--    whamletFile' = whamletFileWithSettings hset
-+    [ ]
- 
- data WidgetFileSettings = WidgetFileSettings
-     { wfsLanguages :: HamletSettings -> [TemplateLanguage]
-@@ -87,51 +76,3 @@ data WidgetFileSettings = WidgetFileSettings
- 
- instance Default WidgetFileSettings where
-     def = WidgetFileSettings defaultTemplateLanguages defaultHamletSettings
--
--widgetFileNoReload :: WidgetFileSettings -> FilePath -> Q Exp
--widgetFileNoReload wfs x = combine "widgetFileNoReload" x False $ wfsLanguages wfs $ wfsHamletSettings wfs
--
--widgetFileReload :: WidgetFileSettings -> FilePath -> Q Exp
--widgetFileReload wfs x = combine "widgetFileReload" x True $ wfsLanguages wfs $ wfsHamletSettings wfs
--
--combine :: String -> String -> Bool -> [TemplateLanguage] -> Q Exp
--combine func file isReload tls = do
--    mexps <- qmexps
--    case catMaybes mexps of
--        [] -> error $ concat
--            [ "Called "
--            , func
--            , " on "
--            , show file
--            , ", but no template were found."
--            ]
--        exps -> return $ DoE $ map NoBindS exps
--  where
--    qmexps :: Q [Maybe Exp]
--    qmexps = mapM go tls
--
--    go :: TemplateLanguage -> Q (Maybe Exp)
--    go tl = whenExists file (tlRequiresToWidget tl) (tlExtension tl) ((if isReload then tlReload else tlNoReload) tl)
--
--whenExists :: String
--           -> Bool -- ^ requires toWidget wrap
--           -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp)
--whenExists = warnUnlessExists False
--
--warnUnlessExists :: Bool
--                 -> String
--                 -> Bool -- ^ requires toWidget wrap
--                 -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp)
--warnUnlessExists shouldWarn x wrap glob f = do
--    let fn = globFile glob x
--    e <- qRunIO $ doesFileExist fn
--    when (shouldWarn && not e) $ qRunIO $ putStrLn $ "widget file not found: " ++ fn
--    if e
--        then do
--            ex <- f fn
--            if wrap
--                then do
--                    tw <- [|toWidget|]
--                    return $ Just $ tw `AppE` ex
--                else return $ Just ex
--        else return Nothing
--- 
-1.7.10.4
-
diff --git a/standalone/android/haskell-patches/yesod-form_1.2.1.1-0001-prepare-for-Evil-Splicer.patch b/standalone/android/haskell-patches/yesod-form_1.2.1.1-0001-prepare-for-Evil-Splicer.patch
deleted file mode 100644
index c24055b1f0..0000000000
--- a/standalone/android/haskell-patches/yesod-form_1.2.1.1-0001-prepare-for-Evil-Splicer.patch
+++ /dev/null
@@ -1,83 +0,0 @@
-From a603bac40f0a0f6232fbfb056a778860270101de Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Mon, 15 Apr 2013 15:59:56 -0400
-Subject: [PATCH 1/2] prepare for Evil Splicer
-
----
- Yesod/Form/Functions.hs | 3 +--
- evilsplicer-headers.hs  | 9 +++++++++
- yesod-form.cabal        | 5 +++--
- 3 files changed, 13 insertions(+), 4 deletions(-)
- create mode 100644 evilsplicer-headers.hs
-
-diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs
-index db3e493..89eb1e8 100644
---- a/Yesod/Form/Functions.hs
-+++ b/Yesod/Form/Functions.hs
-@@ -54,10 +54,9 @@ import Text.Blaze (Markup, toMarkup)
- #define toHtml toMarkup
- import Yesod.Handler (GHandler, getRequest, runRequestBody, newIdent, getYesod)
- import Yesod.Core (RenderMessage, SomeMessage (..))
--import Yesod.Widget (GWidget, whamlet)
-+import Yesod.Widget (GWidget)
- import Yesod.Request (reqToken, reqWaiRequest, reqGetParams, languages)
- import Network.Wai (requestMethod)
--import Text.Hamlet (shamlet)
- import Data.Monoid (mempty)
- import Data.Maybe (listToMaybe, fromMaybe)
- import Yesod.Message (RenderMessage (..))
-diff --git a/evilsplicer-headers.hs b/evilsplicer-headers.hs
-new file mode 100644
-index 0000000..865d043
---- /dev/null
-+++ b/evilsplicer-headers.hs
-@@ -0,0 +1,9 @@
-+import qualified Data.Text.Lazy.Builder
-+import qualified Text.Shakespeare
-+import qualified Text.Hamlet
-+import qualified Data.Monoid
-+import qualified Text.Julius
-+import qualified "blaze-markup" Text.Blaze.Internal
-+import qualified "blaze-markup" Text.Blaze as Text.Blaze.Markup
-+import qualified Yesod.Widget
-+import qualified Data.Foldable
-diff --git a/yesod-form.cabal b/yesod-form.cabal
-index a0d2a80..ae99ddc 100644
---- a/yesod-form.cabal
-+++ b/yesod-form.cabal
-@@ -18,7 +18,7 @@ library
-                    , yesod-persistent      >= 1.1      && < 1.2
-                    , time                  >= 1.1.4
-                    , hamlet                >= 1.1      && < 1.2
--                   , shakespeare-css       >= 1.0      && < 1.1
-+                   , shakespeare-css       == 1.0.2
-                    , shakespeare-js        >= 1.0.2    && < 1.2
-                    , persistent            >= 1.0      && < 1.2
-                    , template-haskell
-@@ -37,6 +37,7 @@ library
-                    , attoparsec            >= 0.10     && < 0.11
-                    , crypto-api            >= 0.8      && < 0.11
-                    , aeson
-+                   , shakespeare
- 
-     exposed-modules: Yesod.Form
-                      Yesod.Form.Class
-@@ -45,7 +46,6 @@ library
-                      Yesod.Form.Input
-                      Yesod.Form.Fields
-                      Yesod.Form.Jquery
--                     Yesod.Form.Nic
-                      Yesod.Form.MassInput
-                      Yesod.Form.I18n.English
-                      Yesod.Form.I18n.Portuguese
-@@ -56,6 +56,7 @@ library
-                      Yesod.Form.I18n.Japanese
-                      -- FIXME Yesod.Helpers.Crud
-     ghc-options:     -Wall
-+    Extensions: PackageImports
- 
- test-suite test
-     type: exitcode-stdio-1.0
--- 
-1.8.2.rc3
-
diff --git a/standalone/android/haskell-patches/yesod-form_1.2.1.1-0002-expand-TH.patch b/standalone/android/haskell-patches/yesod-form_1.2.1.1-0002-expand-TH.patch
deleted file mode 100644
index 3ce48e5fcb..0000000000
--- a/standalone/android/haskell-patches/yesod-form_1.2.1.1-0002-expand-TH.patch
+++ /dev/null
@@ -1,1606 +0,0 @@
-From f98c22ec71695537e0e008a0bd54affdf8a60f64 Mon Sep 17 00:00:00 2001
-From: Joey Hess 
-Date: Mon, 15 Apr 2013 17:35:57 -0400
-Subject: [PATCH 2/2] expand TH
-
-Used the EvilSplicer, and then some manual fixups, as it is apparently
-buggy. Also a few module import fixes.
----
- Yesod/Form/Fields.hs    | 623 ++++++++++++++++++++++++++++++++++++++----------
- Yesod/Form/Functions.hs | 240 +++++++++++++++----
- Yesod/Form/Jquery.hs    | 141 ++++++++---
- Yesod/Form/MassInput.hs | 228 ++++++++++++++----
- Yesod/Form/Nic.hs       |  59 ++++-
- 5 files changed, 1042 insertions(+), 249 deletions(-)
-
-diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs
-index 7917ce2..db76ea2 100644
---- a/Yesod/Form/Fields.hs
-+++ b/Yesod/Form/Fields.hs
-@@ -46,11 +46,22 @@ module Yesod.Form.Fields
-     , optionsEnum
-     ) where
- 
-+import qualified Data.Text.Lazy.Builder
-+import qualified Text.Shakespeare
-+import qualified Data.Monoid
-+import qualified Text.Julius
-+import qualified "blaze-markup" Text.Blaze.Internal
-+import qualified "blaze-markup" Text.Blaze as Text.Blaze.Internal
-+import qualified "blaze-html" Text.Blaze.Html
-+import qualified Yesod.Widget
-+import qualified Text.Css
-+import qualified Control.Monad
-+import qualified Data.Foldable
- import Yesod.Form.Types
- import Yesod.Form.I18n.English
- import Yesod.Form.Functions (parseHelper)
- import Yesod.Handler (getMessageRender)
--import Yesod.Widget (toWidget, whamlet, GWidget)
-+import Yesod.Widget (toWidget, GWidget)
- import Yesod.Message (RenderMessage (renderMessage), SomeMessage (..))
- import Text.Hamlet
- import Text.Blaze (ToMarkup (toMarkup), preEscapedToMarkup, unsafeByteString)
-@@ -108,10 +119,24 @@ intField = Field
-             Right (a, "") -> Right a
-             _ -> Left $ MsgInvalidInteger s
- 
--    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
--$newline never
--
--|]
-+    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_amMY
-+      -> do { id
-+                ((Text.Blaze.Internal.preEscapedText . pack) "") }
-+
-     , fieldEnctype = UrlEncoded
-     }
-   where
-@@ -125,10 +150,24 @@ doubleField = Field
-             Right (a, "") -> Right a
-             _ -> Left $ MsgInvalidNumber s
- 
--    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
--$newline never
--
--|]
-+    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_amNa
-+      -> do { id
-+                ((Text.Blaze.Internal.preEscapedText . pack) "") }
-+
-     , fieldEnctype = UrlEncoded
-     }
-   where showVal = either id (pack . show)
-@@ -136,10 +175,24 @@ $newline never
- dayField :: RenderMessage master FormMessage => Field sub master Day
- dayField = Field
-     { fieldParse = parseHelper $ parseDate . unpack
--    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
--$newline never
--
--|]
-+    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_amNk
-+      -> do { id
-+                ((Text.Blaze.Internal.preEscapedText . pack) "") }
-+
-     , fieldEnctype = UrlEncoded
-     }
-   where showVal = either id (pack . show)
-@@ -147,10 +200,23 @@ $newline never
- timeField :: RenderMessage master FormMessage => Field sub master TimeOfDay
- timeField = Field
-     { fieldParse = parseHelper parseTime
--    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
--$newline never
--
--|]
-+    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_amNx
-+      -> do { id
-+                ((Text.Blaze.Internal.preEscapedText . pack) "") }
-+
-     , fieldEnctype = UrlEncoded
-     }
-   where
-@@ -163,10 +229,18 @@ $newline never
- htmlField :: RenderMessage master FormMessage => Field sub master Html
- htmlField = Field
-     { fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance
--    , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
--$newline never
--") }
-+
-     , fieldEnctype = UrlEncoded
-     }
-   where showVal = either id (pack . renderHtml)
-@@ -192,10 +266,18 @@ instance ToHtml Textarea where
- textareaField :: RenderMessage master FormMessage => Field sub master Textarea
- textareaField = Field
-     { fieldParse = parseHelper $ Right . Textarea
--    , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
--$newline never
--") }
-+
-     , fieldEnctype = UrlEncoded
-     }
- 
-@@ -203,10 +285,19 @@ hiddenField :: (PathPiece p, RenderMessage master FormMessage)
-             => Field sub master p
- hiddenField = Field
-     { fieldParse = parseHelper $ maybe (Left MsgValueRequired) Right . fromPathPiece
--    , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
--$newline never
--
--|]
-+    , fieldView = \theId name attrs val _isReq -> toWidget  $     \ _render_amNZ
-+      -> do { id
-+                ((Text.Blaze.Internal.preEscapedText . pack)
-+                   "") }
-+
-     , fieldEnctype = UrlEncoded
-     }
- 
-@@ -214,20 +305,50 @@ textField :: RenderMessage master FormMessage => Field sub master Text
- textField = Field
-     { fieldParse = parseHelper $ Right
-     , fieldView = \theId name attrs val isReq ->
--        [whamlet|
--$newline never
--
--|]
-+        do { toWidget
-+               ((Text.Blaze.Internal.preEscapedText . pack) "") }
-+
-     , fieldEnctype = UrlEncoded
-     }
- 
- passwordField :: RenderMessage master FormMessage => Field sub master Text
- passwordField = Field
-     { fieldParse = parseHelper $ Right
--    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
--$newline never
--
--|]
-+    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_amOg
-+      -> do { id
-+                ((Text.Blaze.Internal.preEscapedText . pack) "") }
-+
-     , fieldEnctype = UrlEncoded
-     }
- 
-@@ -305,10 +426,24 @@ emailField = Field
-                 then Right s
-                 else Left $ MsgInvalidEmail s
- #endif
--    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
--$newline never
--
--|]
-+    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_amOO
-+      -> do { id
-+                ((Text.Blaze.Internal.preEscapedText . pack) "") }
-+
-     , fieldEnctype = UrlEncoded
-     }
- 
-@@ -317,20 +452,60 @@ searchField :: RenderMessage master FormMessage => AutoFocus -> Field sub master
- searchField autoFocus = Field
-     { fieldParse = parseHelper Right
-     , fieldView = \theId name attrs val isReq -> do
--        [whamlet|\
--$newline never
--
--|]
-+        do { toWidget
-+               ((Text.Blaze.Internal.preEscapedText . pack) "") }
-+
-         when autoFocus $ do
-           -- we want this javascript to be placed immediately after the field
--          [whamlet|
--$newline never
--") }
-+
-+          toWidget  $           \ _render_amP5
-+            -> (Text.Css.CssNoWhitespace
-+                . (foldr ($) []))
-+                 [((++)
-+                   $ (map
-+                        Text.Css.Css
-+                        ((((:)
-+                             (Text.Css.Css'
-+                                (Data.Monoid.mconcat [toCss theId])
-+                                [(Data.Monoid.mconcat
-+                                    [(Text.Css.fromText
-+                                      . Text.Css.pack)
-+                                       "-webkit-appearance"], 
-+                                  Data.Monoid.mconcat
-+                                    [(Text.Css.fromText
-+                                      . Text.Css.pack)
-+                                       "textfield"])]))
-+                          . (foldr (.) id []))
-+                           [])))]
-+
-     , fieldEnctype = UrlEncoded
-     }
- 
-@@ -341,10 +516,25 @@ urlField = Field
-             Nothing -> Left $ MsgInvalidUrl s
-             Just _ -> Right s
-     , fieldView = \theId name attrs val isReq ->
--        [whamlet|
--$newline never
--
--|]
-+        do { toWidget
-+               ((Text.Blaze.Internal.preEscapedText . pack) "") }
-+
-     , fieldEnctype = UrlEncoded
-     }
- 
-@@ -353,18 +543,48 @@ selectFieldList = selectField . optionsPairs
- 
- selectField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
- selectField = selectFieldHelper
--    (\theId name attrs inside -> [whamlet|
--$newline never
--");
-+         toWidget inside;
-+         toWidget
-+           ((Text.Blaze.Internal.preEscapedText . pack) "") })
-+ -- outside
-+    (\_theId _name isSel ->     do { toWidget
-+           ((Text.Blaze.Internal.preEscapedText . pack)
-+              "") })
-+ -- onOpt
-+    (\_theId _name _attrs value isSel text ->     do { toWidget
-+           ((Text.Blaze.Internal.preEscapedText . pack) "") })
-+ -- inside
- 
- multiSelectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master [a]
- multiSelectFieldList = multiSelectField . optionsPairs
-@@ -385,12 +605,40 @@ multiSelectField ioptlist =
-     view theId name attrs val isReq = do
-         opts <- fmap olOptions $ lift ioptlist
-         let selOpts = map (id &&& (optselected val)) opts
--        [whamlet|
--$newline never
--            ");
-+             Data.Foldable.mapM_
-+               (\ (opt_amPV, optsel_amPW)
-+                  -> do { toWidget
-+                            ((Text.Blaze.Internal.preEscapedText . pack) "") })
-+               selOpts;
-+             toWidget
-+               ((Text.Blaze.Internal.preEscapedText . pack) "") }
-+
-         where
-             optselected (Left _) _ = False
-             optselected (Right vals) opt = (optionInternalValue opt) `elem` vals
-@@ -400,41 +648,140 @@ radioFieldList = radioField . optionsPairs
- 
- radioField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
- radioField = selectFieldHelper
--    (\theId _name _attrs inside -> [whamlet|
--$newline never
--
      ^{inside}
--|])
--    (\theId name isSel -> [whamlet|
--$newline never
--