diff options
| -rw-r--r-- | Assistant/Ssh.hs | 25 | ||||
| -rw-r--r-- | Makefile | 4 | ||||
| -rw-r--r-- | debian/changelog | 3 | ||||
| -rw-r--r-- | doc/bugs/Cannot_sync_repos_setup_using_webapp:___34__git-annex-shell:_Only_allowed_to_access___126____47__foo_not___126____47__bar__47____34__.mdwn | 3 | ||||
| -rw-r--r-- | standalone/android/evilsplicer-headers.hs | 2 | ||||
| -rw-r--r-- | standalone/android/haskell-patches/yesod-routes-1.1.2_0001-remove-TH-and-export-module-used-by-TH-splices.patch (renamed from standalone/android/haskell-patches/yesod-routes-1.1.2_0001-remove-TH-hack-job.patch) | 141 |
6 files changed, 77 insertions, 101 deletions
diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index 487f62c91..5312eaf77 100644 --- a/Assistant/Ssh.hs +++ b/Assistant/Ssh.hs @@ -210,18 +210,27 @@ setSshConfig sshdata config = do , ("Port", show $ sshPort sshdata) ] +{- This hostname is specific to a given repository on the ssh host, + - so it is based on the real hostname, the username, and the directory. + -} mangleSshHostName :: SshData -> String -mangleSshHostName sshdata = "git-annex-" ++ host ++ (maybe "-" ('-':) user) +mangleSshHostName sshdata = "git-annex-" ++ T.unpack (sshHostName sshdata) + ++ "-" ++ filter safe extra where - host = T.unpack $ sshHostName sshdata - user = T.unpack <$> sshUserName sshdata + extra = join "_" $ map T.unpack $ catMaybes + [ sshUserName sshdata + , Just $ sshDirectory sshdata + ] + safe c + | isAlphaNum c = True + | c == '_' = True + | otherwise = False +{- Extracts the real hostname from a mangled ssh hostname. -} unMangleSshHostName :: String -> String -unMangleSshHostName h - | "git-annex-" `isPrefixOf` h = join "-" (beginning $ drop 2 dashbits) - | otherwise = h - where - dashbits = split "-" h +unMangleSshHostName h = case split "-" h of + ("git":"annex":rest) -> join "-" (beginning rest) + _ -> h {- Does ssh have known_hosts data for a hostname? -} knownHost :: Text -> IO Bool @@ -52,7 +52,7 @@ test: git-annex # hothasktags chokes on some tempolate haskell etc, so ignore errors tags: - find . | grep -v /.git/ | grep -v /dist/ | grep -v /doc/ | egrep '\.hs$$' | xargs hothasktags > tags 2>/dev/null + find . | grep -v /.git/ | grep -v /tmp/ | grep -v /dist/ | grep -v /doc/ | egrep '\.hs$$' | xargs hothasktags > tags 2>/dev/null # If ikiwiki is available, build static html docs suitable for being # shipped in the software package. @@ -174,7 +174,7 @@ android: Build/EvilSplicer # and not overwritten.) cp -uR tmp/splices/* tmp/androidtree # Some additional dependencies needed by the expanded splices. - sed -i 's/^ Build-Depends: / Build-Depends: yesod-core, shakespeare-js, shakespeare, blaze-markup, /' tmp/androidtree/git-annex.cabal + sed -i 's/^ Build-Depends: / Build-Depends: yesod-routes, yesod-core, shakespeare-css, shakespeare-js, shakespeare, blaze-markup, /' tmp/androidtree/git-annex.cabal # 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 \ diff --git a/debian/changelog b/debian/changelog index 54e1c5e80..023a3e7d6 100644 --- a/debian/changelog +++ b/debian/changelog @@ -36,6 +36,9 @@ git-annex (4.20130406) UNRELEASED; urgency=low * Avoid using runghc, as that needs ghci. * webapp: When a repository's group is changed, rescan for transfers. * webapp: Added animations. + * webapp: Include the repository directory in the mangled hostname and + ssh key name, so that a locked down ssh key for one repository is not + re-used when setting up additional repositories on the same server. -- Joey Hess <joeyh@debian.org> Sat, 06 Apr 2013 15:24:15 -0400 diff --git a/doc/bugs/Cannot_sync_repos_setup_using_webapp:___34__git-annex-shell:_Only_allowed_to_access___126____47__foo_not___126____47__bar__47____34__.mdwn b/doc/bugs/Cannot_sync_repos_setup_using_webapp:___34__git-annex-shell:_Only_allowed_to_access___126____47__foo_not___126____47__bar__47____34__.mdwn index ba538abff..4d1154650 100644 --- a/doc/bugs/Cannot_sync_repos_setup_using_webapp:___34__git-annex-shell:_Only_allowed_to_access___126____47__foo_not___126____47__bar__47____34__.mdwn +++ b/doc/bugs/Cannot_sync_repos_setup_using_webapp:___34__git-annex-shell:_Only_allowed_to_access___126____47__foo_not___126____47__bar__47____34__.mdwn @@ -24,3 +24,6 @@ Machine 2: Ubuntu 12.04 with Git-Annex 4.20130405 installed using cabal. ###Please provide any additional information below. +> [[done]]; when setting up a new repo it will now use +> a ssh key that is different for each repository on the host. +> --[[Joey]] diff --git a/standalone/android/evilsplicer-headers.hs b/standalone/android/evilsplicer-headers.hs index 16f98216b..29fe5caa7 100644 --- a/standalone/android/evilsplicer-headers.hs +++ b/standalone/android/evilsplicer-headers.hs @@ -10,9 +10,11 @@ import qualified Data.Text.Lazy.Builder import qualified Text.Shakespeare import qualified Text.Hamlet import qualified Text.Julius +import qualified Text.Css import qualified "blaze-markup" Text.Blaze.Internal import qualified Data.Monoid import qualified Yesod.Widget +import qualified Yesod.Routes.TH.Types {- End EvilSplicer headers. -} diff --git a/standalone/android/haskell-patches/yesod-routes-1.1.2_0001-remove-TH-hack-job.patch b/standalone/android/haskell-patches/yesod-routes-1.1.2_0001-remove-TH-and-export-module-used-by-TH-splices.patch index 1d6538e02..33bcff447 100644 --- a/standalone/android/haskell-patches/yesod-routes-1.1.2_0001-remove-TH-hack-job.patch +++ b/standalone/android/haskell-patches/yesod-routes-1.1.2_0001-remove-TH-and-export-module-used-by-TH-splices.patch @@ -1,21 +1,20 @@ -From bf9b294fd3a4ae4e550844504f3ac4ed0dc226c0 Mon Sep 17 00:00:00 2001 +From 06176b0f3dbbe559490f0971e0db205287793286 Mon Sep 17 00:00:00 2001 From: Joey Hess <joey@kitenet.net> -Date: Thu, 28 Feb 2013 23:40:44 -0400 -Subject: [PATCH] remove TH (hack job) +Date: Mon, 15 Apr 2013 21:01:12 -0400 +Subject: [PATCH] remove TH and export module used by TH splices --- - Yesod/Routes/Overlap.hs | 74 ---------- - Yesod/Routes/Parse.hs | 115 --------------- - Yesod/Routes/TH.hs | 12 -- - Yesod/Routes/TH/Dispatch.hs | 344 ------------------------------------------- - Yesod/Routes/TH/Types.hs | 84 ----------- - yesod-routes.cabal | 22 --- - 6 files changed, 651 deletions(-) + Yesod/Routes/Overlap.hs | 74 ---------- + Yesod/Routes/Parse.hs | 115 --------------- + Yesod/Routes/TH.hs | 12 -- + Yesod/Routes/TH/Dispatch.hs | 344 -------------------------------------------- + Yesod/Routes/TH/Types.hs | 16 --- + yesod-routes.cabal | 21 --- + 6 files changed, 582 deletions(-) delete mode 100644 Yesod/Routes/Overlap.hs delete mode 100644 Yesod/Routes/Parse.hs delete mode 100644 Yesod/Routes/TH.hs delete mode 100644 Yesod/Routes/TH/Dispatch.hs - delete mode 100644 Yesod/Routes/TH/Types.hs diff --git a/Yesod/Routes/Overlap.hs b/Yesod/Routes/Overlap.hs deleted file mode 100644 @@ -587,100 +586,58 @@ index a52f69a..0000000 - isDynamic _ = False - here = map VarE here' ++ [routeFromDynamics rest name ys'] diff --git a/Yesod/Routes/TH/Types.hs b/Yesod/Routes/TH/Types.hs -deleted file mode 100644 -index 52cd446..0000000 +index 52cd446..18208d3 100644 --- a/Yesod/Routes/TH/Types.hs -+++ /dev/null -@@ -1,84 +0,0 @@ --{-# LANGUAGE TemplateHaskell #-} --module Yesod.Routes.TH.Types -- ( -- * Data types -- Resource (..) -- , ResourceTree (..) -- , Piece (..) -- , Dispatch (..) -- , CheckOverlap -- -- ** Helper functions -- , resourceMulti -- , resourceTreePieces -- , resourceTreeName -- ) where -- --import Language.Haskell.TH.Syntax --import Control.Arrow (second) -- --data ResourceTree typ = ResourceLeaf (Resource typ) | ResourceParent String [(CheckOverlap, Piece typ)] [ResourceTree typ] -- --resourceTreePieces :: ResourceTree typ -> [(CheckOverlap, Piece typ)] --resourceTreePieces (ResourceLeaf r) = resourcePieces r --resourceTreePieces (ResourceParent _ x _) = x -- --resourceTreeName :: ResourceTree typ -> String --resourceTreeName (ResourceLeaf r) = resourceName r --resourceTreeName (ResourceParent x _ _) = x -- --instance Functor ResourceTree where -- fmap f (ResourceLeaf r) = ResourceLeaf (fmap f r) -- fmap f (ResourceParent a b c) = ResourceParent a (map (second $ fmap f) b) $ map (fmap f) c -- ++++ b/Yesod/Routes/TH/Types.hs +@@ -29,10 +29,6 @@ instance Functor ResourceTree where + fmap f (ResourceLeaf r) = ResourceLeaf (fmap f r) + fmap f (ResourceParent a b c) = ResourceParent a (map (second $ fmap f) b) $ map (fmap f) c + -instance Lift t => Lift (ResourceTree t) where - lift (ResourceLeaf r) = [|ResourceLeaf $(lift r)|] - lift (ResourceParent a b c) = [|ResourceParent $(lift a) $(lift b) $(lift c)|] - --data Resource typ = Resource -- { resourceName :: String -- , resourcePieces :: [(CheckOverlap, Piece typ)] -- , resourceDispatch :: Dispatch typ -- } -- deriving Show -- --type CheckOverlap = Bool -- --instance Functor Resource where -- fmap f (Resource a b c) = Resource a (map (second $ fmap f) b) (fmap f c) -- + data Resource typ = Resource + { resourceName :: String + , resourcePieces :: [(CheckOverlap, Piece typ)] +@@ -45,9 +41,6 @@ type CheckOverlap = Bool + instance Functor Resource where + fmap f (Resource a b c) = Resource a (map (second $ fmap f) b) (fmap f c) + -instance Lift t => Lift (Resource t) where - lift (Resource a b c) = [|Resource $(lift a) $(lift b) $(lift c)|] - --data Piece typ = Static String | Dynamic typ -- deriving Show -- --instance Functor Piece where -- fmap _ (Static s) = (Static s) -- fmap f (Dynamic t) = Dynamic (f t) -- + data Piece typ = Static String | Dynamic typ + deriving Show + +@@ -55,10 +48,6 @@ instance Functor Piece where + fmap _ (Static s) = (Static s) + fmap f (Dynamic t) = Dynamic (f t) + -instance Lift t => Lift (Piece t) where - lift (Static s) = [|Static $(lift s)|] - lift (Dynamic t) = [|Dynamic $(lift t)|] - --data Dispatch typ = -- Methods -- { methodsMulti :: Maybe typ -- ^ type of the multi piece at the end -- , methodsMethods :: [String] -- ^ supported request methods -- } -- | Subsite -- { subsiteType :: typ -- , subsiteFunc :: String -- } -- deriving Show -- --instance Functor Dispatch where -- fmap f (Methods a b) = Methods (fmap f a) b -- fmap f (Subsite a b) = Subsite (f a) b -- + data Dispatch typ = + Methods + { methodsMulti :: Maybe typ -- ^ type of the multi piece at the end +@@ -74,11 +63,6 @@ instance Functor Dispatch where + fmap f (Methods a b) = Methods (fmap f a) b + fmap f (Subsite a b) = Subsite (f a) b + -instance Lift t => Lift (Dispatch t) where - lift (Methods Nothing b) = [|Methods Nothing $(lift b)|] - lift (Methods (Just t) b) = [|Methods (Just $(lift t)) $(lift b)|] - lift (Subsite t b) = [|Subsite $(lift t) $(lift b)|] - --resourceMulti :: Resource typ -> Maybe typ --resourceMulti Resource { resourceDispatch = Methods (Just t) _ } = Just t --resourceMulti _ = Nothing + resourceMulti :: Resource typ -> Maybe typ + resourceMulti Resource { resourceDispatch = Methods (Just t) _ } = Just t + resourceMulti _ = Nothing diff --git a/yesod-routes.cabal b/yesod-routes.cabal -index eb367b3..0984dfe 100644 +index eb367b3..dc6a12c 100644 --- a/yesod-routes.cabal +++ b/yesod-routes.cabal -@@ -23,29 +23,7 @@ library +@@ -23,31 +23,10 @@ library , path-pieces >= 0.1 && < 0.2 exposed-modules: Yesod.Routes.Dispatch @@ -690,9 +647,9 @@ index eb367b3..0984dfe 100644 - Yesod.Routes.Overlap - other-modules: Yesod.Routes.TH.Dispatch - Yesod.Routes.TH.RenderRoute -- Yesod.Routes.TH.Types -- ghc-options: -Wall -- + Yesod.Routes.TH.Types + ghc-options: -Wall + -test-suite runtests - type: exitcode-stdio-1.0 - main-is: main.hs @@ -707,9 +664,11 @@ index eb367b3..0984dfe 100644 - , containers - , template-haskell - , path-pieces - ghc-options: -Wall - +- ghc-options: -Wall +- source-repository head + type: git + location: https://github.com/yesodweb/yesod -- -1.7.10.4 +1.8.2.rc3 |