diff --git a/src/Vervis/Ssh.hs b/src/Vervis/Ssh.hs
index c452175..f1b7957 100644
--- a/src/Vervis/Ssh.hs
+++ b/src/Vervis/Ssh.hs
@@ -53,6 +53,7 @@ import qualified Formatting as F
 import Vervis.Model
 import Vervis.Model.Ident
 import Vervis.Model.Role
+import Vervis.Path
 import Vervis.Settings
 
 -------------------------------------------------------------------------------
@@ -69,8 +70,8 @@ type SshChanDB = SqlPersistT Channel
 type SshSessDB = SqlPersistT Session
 
 data RepoSpec
-    = SpecUserRepo Text Text
-    | SpecRepo Text
+    = SpecUserRepo ShrIdent RpIdent
+    | SpecRepo RpIdent
     deriving Show
 
 data Action
@@ -145,15 +146,15 @@ darcsRepoSpecP = f <$>
                  part <*>
                  optional (char '/' *> optional (part <* optional (char '/')))
     where
-    f sharer (Just (Just repo)) = SpecUserRepo sharer repo
-    f repo _                    = SpecRepo repo
+    f sharer (Just (Just repo)) = SpecUserRepo (text2shr sharer) (text2rp repo)
+    f repo _                    = SpecRepo (text2rp repo)
     part = takeWhile1 $ \ c -> c /= '/' && c /= '\''
 
 gitRepoSpecP :: Parser RepoSpec
 gitRepoSpecP = f <$> (msh *> part) <*> optional (char '/' *> part)
     where
-    f repo Nothing       = SpecRepo repo
-    f sharer (Just repo) = SpecUserRepo sharer repo
+    f repo Nothing       = SpecRepo (text2rp repo)
+    f sharer (Just repo) = SpecUserRepo (text2shr sharer) (text2rp repo)
     part = takeWhile1 $ \ c -> c /= '/' && c /= '\''
     msh  = optional (satisfy $ \ c -> c == '/' || c == '~')
 
@@ -177,17 +178,16 @@ detectAction (Execute s) =
         Right action -> Right action
 detectAction _           = Left "Unsupported channel request"
 
-resolveSpec :: RepoSpec -> Channel (Text, Text)
+resolveSpec :: RepoSpec -> Channel (ShrIdent, RpIdent)
 resolveSpec (SpecUserRepo u r) = return (u, r)
 resolveSpec (SpecRepo r) = do
-    u <- T.pack . authUser <$> askAuthDetails
+    u <- text2shr . T.pack . authUser <$> askAuthDetails
     return (u, r)
 
-resolveSpec' :: FilePath -> RepoSpec -> Channel (Text, Text, FilePath)
-resolveSpec' repoDir spec = do
+resolveSpec' :: FilePath -> RepoSpec -> Channel (ShrIdent, RpIdent, FilePath)
+resolveSpec' root spec = do
     (u, r) <- resolveSpec spec
-    let repoPath = repoDir </> T.unpack u </> T.unpack r
-    return (u, r, repoPath)
+    return (u, r, repoDir root u r)
 
 execute :: FilePath -> [String] -> Channel ()
 execute cmd args = do
@@ -204,24 +204,33 @@ execute cmd args = do
             (verifyPipe mIn, verifyPipe mOut, verifyPipe mErr, ph)
     spawnProcess $ verifyPipes <$> createProcess config
 
-whenDarcsRepoExists :: FilePath -> Channel ActionResult -> Channel ActionResult
-whenDarcsRepoExists repoPath action = do
-    looksGood <- liftIO $ doesDirectoryExist $ repoPath </> "_darcs"
+whenRepoExists
+    :: Text
+    -> (FilePath -> IO Bool)
+    -> Bool
+    -> FilePath
+    -> Channel ActionResult
+    -> Channel ActionResult
+whenRepoExists vcs checkFS checkedDB repoPath action = do
+    looksGood <- liftIO $ checkFS repoPath
     if looksGood
         then action
-        else return $ ARFail "No such darcs repository"
+        else do
+            when checkedDB $ lift $ $logErrorS src $
+                T.concat [vcs, " repo not found! ", T.pack repoPath]
+            return $ ARFail $ T.concat ["No such ", vcs, " repository"]
 
-whenGitRepoExists :: FilePath -> Channel ActionResult -> Channel ActionResult
-whenGitRepoExists repoPath action = do
-    looksGood <- liftIO $ isRepo $ fromString repoPath
-    if looksGood
-        then action
-        else return $ ARFail "No such git repository"
+whenDarcsRepoExists
+    :: Bool -> FilePath -> Channel ActionResult -> Channel ActionResult
+whenDarcsRepoExists =
+    whenRepoExists "Darcs" $ doesDirectoryExist . (</> "_darcs")
 
-canPushTo :: Text -> Text -> Channel Bool
-canPushTo shr' rp' = do
-    let shr = text2shr shr'
-        rp = text2rp rp'
+whenGitRepoExists
+    :: Bool -> FilePath -> Channel ActionResult -> Channel ActionResult
+whenGitRepoExists = whenRepoExists "Git" $ isRepo . fromString
+
+canPushTo :: ShrIdent -> RpIdent -> Channel Bool
+canPushTo shr rp = do
     pid <- authId <$> askAuthDetails
     ma <- runChanDB $ runMaybeT $ do
         Entity sid _sharer <- MaybeT $ getBy $ UniqueSharer shr
@@ -241,27 +250,27 @@ runAction repoDir _wantReply action =
     case action of
         DarcsTransferMode spec -> do
             (_sharer, _repo, repoPath) <- resolveSpec' repoDir spec
-            whenDarcsRepoExists repoPath $ do
+            whenDarcsRepoExists False repoPath $ do
                 execute "darcs" ["transfer-mode", "--repodir", repoPath]
                 return ARProcess
         DarcsApply spec -> do
             (sharer, repo, repoPath) <- resolveSpec' repoDir spec
             can <- canPushTo sharer repo
             if can
-                then whenDarcsRepoExists repoPath $ do
+                then whenDarcsRepoExists True repoPath $ do
                     execute "darcs" ["apply", "--all", "--repodir", repoPath]
                     return ARProcess
                 else return $ ARFail "You can't push to this repository"
         GitUploadPack spec -> do
             (_sharer, _repo, repoPath) <- resolveSpec' repoDir spec
-            whenGitRepoExists repoPath $ do
+            whenGitRepoExists False repoPath $ do
                 execute "git-upload-pack" [repoPath]
                 return ARProcess
         GitReceivePack spec -> do
             (sharer, repo, repoPath) <- resolveSpec' repoDir spec
             can <- canPushTo sharer repo
             if can
-                then whenGitRepoExists repoPath $ do
+                then whenGitRepoExists True repoPath $ do
                     execute "git-receive-pack" [repoPath]
                     return ARProcess
                 else return $ ARFail "You can't push to this repository"