webapp: remove configurators for obsolste cloud storage services

* webapp: Remove configurator for box.com repository, since their webdav support is going away at the end of this January. * webapp: Remove configurator for gitlab, which stopped supporting git-annex some time ago. This commit was sponsored by Brock Spratlen on Patreon.
2019-01-22 11:48:35 -04:00 · 2019-01-22 11:48:35 -04:00 · 9a4406e5e7
commit 9a4406e5e7
parent e0b3ba3819
8 changed files with 20 additions and 262 deletions
--- a/Assistant/WebApp/Configurators/Ssh.hs
+++ b/Assistant/WebApp/Configurators/Ssh.hs
@ -213,9 +213,7 @@ enableSshRemote :: (RemoteConfig -> Maybe SshData) -> (SshInput -> RemoteName ->
 enableSshRemote getsshdata rsyncnetsetup genericsetup u = do
 	m <- fromMaybe M.empty . M.lookup u <$> liftAnnex readRemoteLog
 	case (unmangle <$> getsshdata m, M.lookup "name" m) of
-		(Just sshdata, Just reponame)
-			| isGitLab sshdata -> enableGitLab sshdata
-			| otherwise -> sshConfigurator $ do
+		(Just sshdata, Just reponame) -> sshConfigurator $ do
 			((result, form), enctype) <- liftH $
 				runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
 					sshInputAForm textField $ mkSshInput sshdata
@ -675,110 +673,3 @@ prepRsyncNet sshinput reponame a = do
 isRsyncNet :: Maybe Text -> Bool
 isRsyncNet Nothing = False
 isRsyncNet (Just host) = ".rsync.net" `T.isSuffixOf` T.toLower host
-
-data GitLabUrl = GitLabUrl { unGitLabUrl :: Text }
-
-badGitLabUrl :: Text
-badGitLabUrl = "Bad SSH clone url. Expected something like: git@gitlab.com:yourlogin/annex.git"
-
-parseGitLabUrl :: GitLabUrl -> Maybe SshData
-parseGitLabUrl (GitLabUrl t) = 
-	let (u, r) = separate (== '@') (T.unpack t)
-	    (h, p) = separate (== ':') r
-	in if null u || null h || null p
-		then Nothing
-		else Just $ SshData
-			{ sshHostName = T.pack h
-			, sshUserName = Just (T.pack u)
-			, sshDirectory = T.pack p
-			, sshRepoName = genSshRepoName h p
-			, sshPort = 22
-			, needsPubKey = False
-			, sshCapabilities = 
-				[ GitAnnexShellCapable
-				, GitCapable
-				, PushCapable
-				]
-			, sshRepoUrl = Just (T.unpack t)
-			}
-
-isGitLab :: SshData -> Bool
-isGitLab d = T.pack "gitlab.com" `T.isSuffixOf` (T.toLower (sshHostName d))
-
-toGitLabUrl :: SshData -> GitLabUrl
-toGitLabUrl d = GitLabUrl $ T.concat
-	[ fromMaybe (T.pack "git") (sshUserName d)
-	, T.pack "@"
-	, sshHostName d
-	, T.pack ":"
-	, sshDirectory d
-	]
-
-{- Try to ssh into the gitlab server, verify we can access the repository,
- - and get the uuid of the repository, if it already has one.
- -
- - A repository on gitlab won't be initialized as a git-annex repo 
- - unless a git-annex branch was already pushed to it. So, if
- - git-annex-shell fails to work that's probably why; verify if
- - the server is letting us ssh in by running git send-pack
- - (in dry run mode). -}
-testGitLabUrl :: GitLabUrl -> Annex (ServerStatus, Maybe SshData, UUID)
-testGitLabUrl glu = case parseGitLabUrl glu of
-	Nothing -> return (UnusableServer badGitLabUrl, Nothing, NoUUID)
-	Just sshdata -> 
-		checkor sshdata $ do
-			(sshdata', keypair) <- liftIO $ setupSshKeyPair sshdata
-			checkor sshdata' $ 
-				return (ServerNeedsPubKey (sshPubKey keypair), Just sshdata', NoUUID)
-  where
-	checkor sshdata ora = do
-		u <- probeuuid sshdata
-		if u /= NoUUID
-			then return (UsableServer (sshCapabilities sshdata), Just sshdata, u)
-			else ifM (verifysshworks sshdata)
-				( return (UsableServer (sshCapabilities sshdata), Just sshdata, NoUUID)
-				, ora
-				)
-	probeuuid sshdata = do
-		r <- inRepo $ Git.Construct.fromRemoteLocation (fromJust $ sshRepoUrl sshdata)
-		getUncachedUUID . either (const r) fst <$>
-			Remote.Helper.Ssh.onRemote NoConsumeStdin r
-				(Git.Config.fromPipe r, return (Left $ error "configlist failed"))
-				"configlist" [] []
-	verifysshworks sshdata = inRepo $ Git.Command.runBool
-		[ Param "send-pack"
-		, Param (fromJust $ sshRepoUrl sshdata)
-		, Param "--dry-run"
-		, Param "--force"
-		, Param (fromRef Annex.Branch.name)
-		]
-
-gitLabUrlAForm :: Maybe GitLabUrl -> AForm Handler GitLabUrl
-gitLabUrlAForm defval = GitLabUrl <$> areq check_input (bfs "SSH clone url") (unGitLabUrl <$> defval)
-  where
-	check_input = checkBool (isJust . parseGitLabUrl . GitLabUrl)
-		badGitLabUrl textField
-
-getAddGitLabR :: Handler Html
-getAddGitLabR = postAddGitLabR
-postAddGitLabR :: Handler Html
-postAddGitLabR = promptGitLab Nothing
-
-promptGitLab :: Maybe GitLabUrl -> Handler Html
-promptGitLab defval = sshConfigurator $ do
-	((result, form), enctype) <- liftH $
-		runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $
-			gitLabUrlAForm defval
-	case result of
-		FormSuccess gitlaburl -> do
-			(status, msshdata, u) <- liftAnnex $ testGitLabUrl gitlaburl
-			case (status, msshdata) of
-				(UsableServer _, Just sshdata) ->
-					liftH $ redirect $ ConfirmSshR sshdata u
-				_ -> showform form enctype status
-		_ -> showform form enctype UntestedServer
-  where
-	showform form enctype status = $(widgetFile "configurators/gitlab.com/add")
-
-enableGitLab :: SshData -> Handler Html
-enableGitLab = promptGitLab . Just . toGitLabUrl
--- a/Assistant/WebApp/Configurators/WebDAV.hs
+++ b/Assistant/WebApp/Configurators/WebDAV.hs
@ -30,9 +30,6 @@ import Network.URI
 webDAVConfigurator :: Widget -> Handler Html
 webDAVConfigurator = page "Add a WebDAV repository" (Just Configuration)

-boxConfigurator :: Widget -> Handler Html
-boxConfigurator = page "Add a Box.com repository" (Just Configuration)
-
 data WebDAVInput = WebDAVInput
 	{ user :: Text
 	, password :: Text
@ -44,14 +41,6 @@ data WebDAVInput = WebDAVInput
 toCredPair :: WebDAVInput -> CredPair
 toCredPair input = (T.unpack $ user input, T.unpack $ password input)

-boxComAForm :: Maybe CredPair -> MkAForm WebDAVInput
-boxComAForm defcreds = WebDAVInput
-	<$> areq textField (bfs "Username or Email") (T.pack . fst <$> defcreds)
-	<*> areq passwordField (bfs "Box.com Password") (T.pack . snd <$> defcreds)
-	<*> areq checkBoxField "Share this account with other devices and friends?" (Just True)
-	<*> areq textField (bfs "Directory") (Just "annex")
-	<*> enableEncryptionField
-
 webDAVCredsAForm :: Maybe CredPair -> MkAForm WebDAVInput
 webDAVCredsAForm defcreds = WebDAVInput
 	<$> areq textField (bfs "Username or Email") (T.pack . fst <$> defcreds)
@ -60,32 +49,6 @@ webDAVCredsAForm defcreds = WebDAVInput
 	<*> pure T.empty
 	<*> pure NoEncryption -- not used!

-getAddBoxComR :: Handler Html
-getAddBoxComR = postAddBoxComR
-postAddBoxComR :: Handler Html
-#ifdef WITH_WEBDAV
-postAddBoxComR = boxConfigurator $ do
-	defcreds <- liftAnnex $ previouslyUsedWebDAVCreds "box.com"
-	((result, form), enctype) <- liftH $
-		runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout
-			$ boxComAForm defcreds
-	case result of
-		FormSuccess input -> liftH $ 
-			makeWebDavRemote initSpecialRemote "box.com" (toCredPair input) $ M.fromList
-				[ configureEncryption $ enableEncryption input
-				, ("embedcreds", if embedCreds input then "yes" else "no")
-				, ("type", "webdav")
-				, ("url", "https://dav.box.com/dav/" ++ T.unpack (directory input))
-				-- Box.com has a max file size of 100 mb, but
-				-- using smaller chunks has better memory
-				-- performance.
-				, ("chunk", "10mb")
-				]
-		_ -> $(widgetFile "configurators/addbox.com")
-#else
-postAddBoxComR = giveup "WebDAV not supported by this build"
-#endif
-
 getEnableWebDAVR :: UUID -> Handler Html
 getEnableWebDAVR = postEnableWebDAVR
 postEnableWebDAVR :: UUID -> Handler Html
@ -101,11 +64,7 @@ postEnableWebDAVR uuid = do
 	case mcreds of
 		Just creds -> webDAVConfigurator $ liftH $
 			makeWebDavRemote enableSpecialRemote name creds M.empty
-		Nothing
-			| "box.com/" `isInfixOf` url ->
-				boxConfigurator $ showform name url
-			| otherwise ->
-				webDAVConfigurator $ showform name url
+		Nothing -> webDAVConfigurator $ showform name url
  where
 	showform name url = do
 		defcreds <- liftAnnex $ 
--- a/Assistant/WebApp/routes
+++ b/Assistant/WebApp/routes
@ -55,8 +55,6 @@
 /config/repository/add/cloud/S3 AddS3R GET POST
 /config/repository/add/cloud/IA AddIAR GET POST
 /config/repository/add/cloud/glacier AddGlacierR GET POST
-/config/repository/add/cloud/box.com AddBoxComR GET POST
-/config/repository/add/cloud/gitlab.com AddGitLabR GET POST

 /config/repository/pair/local/start StartLocalPairR GET POST
 /config/repository/pair/local/running/#SecretReminder RunningLocalPairR GET
--- a/4
+++ b/4
@ -39,6 +39,10 @@ git-annex (7.20181212) UNRELEASED; urgency=medium
  * Windows: If 64 bit git is installed, use it when installing git-annex.
    (However, rsync still won't work and this is still not the documented way
    to install it.)
+  * webapp: Remove configurator for box.com repository, since their
+    webdav support is going away at the end of this January.
+  * webapp: Remove configurator for gitlab, which stopped supporting git-annex
+    some time ago.

 -- Joey Hess <id@joeyh.name>  Tue, 18 Dec 2018 12:24:52 -0400

--- a/git-annex.cabal
+++ b/git-annex.cabal
@ -209,7 +209,6 @@ Extra-Source-Files:
  templates/configurators/edit/webrepository.hamlet
  templates/configurators/edit/repository.hamlet
  templates/configurators/unused.hamlet
-  templates/configurators/addbox.com.hamlet
  templates/configurators/ssh/testmodal.hamlet
  templates/configurators/ssh/expiredpassword.hamlet
  templates/configurators/ssh/error.hamlet
@ -228,7 +227,6 @@ Extra-Source-Files:
  templates/configurators/addrepository/wormholepairing.hamlet
  templates/configurators/rsync.net/add.hamlet
  templates/configurators/rsync.net/encrypt.hamlet
-  templates/configurators/gitlab.com/add.hamlet
  templates/configurators/needgcrypt.hamlet
  templates/configurators/needtor.hamlet
  templates/configurators/needmagicwormhole.hamlet
--- a/templates/configurators/addbox.com.hamlet
+++ b/templates/configurators/addbox.com.hamlet
@ -1,28 +0,0 @@
-<div .col-sm-9>
-  <div .content-box>
-    <h2>
-      Adding a Box.com repository
-    <p>
-      <a href="http://box.com">Box.com</a> offers a small quantity of storage #
-      for free, and larger quantities for a fee.
-    <p>
-      Even a small amount of free storage is useful, as a transfer point #
-      between your repositories.
-    <p>
-      <form method="post" .form-horizontal enctype=#{enctype}>
-        <fieldset>
-          ^{form}
-          ^{webAppFormAuthToken}
-          <div .form-group>
-            <div .col-sm-10 .col-sm-offset-2>
-              <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
-                Add repository
-<div .modal .fade #workingmodal>
-  <div .modal-dialog>
-    <div .modal-content>
-      <div .modal-header>
-        <h3>
-          Making repository ...
-      <div .modal-body>
-        <p>
-          Setting up your Box.com repository. This could take a minute.
--- a/templates/configurators/addrepository/cloud.hamlet
+++ b/templates/configurators/addrepository/cloud.hamlet
@ -1,17 +1,3 @@
-<h3>
-  <a href="@{AddGitLabR}">
-    <span .glyphicon .glyphicon-plus-sign>
-    \ Gitlab.com
-<p>
-  Hosts git-annex repositories for free.
-
-<h3>
-  <a href="@{AddBoxComR}">
-    <span .glyphicon .glyphicon-plus-sign>
-    \ Box.com
-<p>
-  Provides free storage for small amounts of data.
-
 <h3>
  <a href="@{AddRsyncNetR}">
    <span .glyphicon .glyphicon-plus-sign>
--- a/templates/configurators/gitlab.com/add.hamlet
+++ b/templates/configurators/gitlab.com/add.hamlet
@ -1,50 +0,0 @@
-<div .col-sm-9>
-  <div .content-box>
-    <h2>
-      Adding a GitLab.com repository
-    <p>
-      <a href="http://gitlab.com/">
-        GitLab.com #
-      provides free public and private git repositories, and supports #
-      git-annex. While the amount of data that can be stored there is limited #
-      (<a href="https://about.gitlab.com/gitlab-com/">to 10 gb currently</a>), #
-      it's enough for smaller repositories, #
-      or as a transfer point between larger repositories.
-    <p>
-      $case status
-        $of UnusableServer msg
-          <div .alert .alert-danger>
-            <span .glyphicon .glyphicon-warning-sign>
-            \ #{msg}
-        $of ServerNeedsPubKey pubkey
-          <div .alert>
-            <span .glyphicon .glyphicon-warning-sign>
-            \ You need to configure GitLab to accept a SSH public key.
-            <p>
-              Open a tab to #
-                <a href="https://gitlab.com/profile/keys" target="_blank">
-                  https://gitlab.com/profile/keys
-              and copy and paste this public key into it:
-              <pre>
-                #{pubkey}
-            <p>
-              Once you have added the key to GitLab, come back to this page #
-              to finish setting up the repository.
-        $of _
-          <p>
-            You can sign up for an account on #
-            <a href="http://gitlab.com/">
-              GitLab.com #
-            and create a git repository that you want to use with git-annex, #
-            or find an existing git-annex repository to share with.
-          <p>
-           Copy the GitLab repository's SSH clone url into the form below.
-      <form method="post" .form-horizontal enctype=#{enctype}>
-        <fieldset>
-          ^{form}
-          ^{webAppFormAuthToken}
-          <div .form-group>
-            <div .col-sm-10 .col-sm-offset-2>
-              <button .btn .btn-primary type=submit onclick="$('#setupmodal').modal('show');">
-                Use this gitlab.com repository
-^{sshTestModal}