Skip to content

Commit b6080f3

Browse files
committed
disable Basic Auth to remove dependency on deprecated crypt library
#1153 (comment)
1 parent 7a1b0c4 commit b6080f3

File tree

2 files changed

+5
-53
lines changed

2 files changed

+5
-53
lines changed

hackage-server.cabal

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -441,9 +441,6 @@ library lib-server
441441
if flag(cabal-parsers)
442442
build-depends: cabal-parsers ^>= 0
443443

444-
if !os(darwin)
445-
extra-libraries: crypt
446-
447444
----------------------------------------------------------------------------
448445

449446
common exe-defaults

src/Distribution/Server/Features/LegacyPasswds/Auth.hs

Lines changed: 5 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -8,21 +8,14 @@ module Distribution.Server.Features.LegacyPasswds.Auth (
88
import Distribution.Server.Framework.AuthTypes
99
import Distribution.Server.Framework.Error
1010
import Distribution.Server.Framework.MemSize
11-
import Distribution.Server.Users.Types (UserId, UserName(..), UserInfo)
11+
import Distribution.Server.Users.Types (UserId, UserInfo)
1212
import qualified Distribution.Server.Users.Users as Users
13-
import Distribution.Server.Framework.AuthCrypt (BasicAuthInfo(..))
1413

1514
import Happstack.Server
1615

17-
import qualified Data.ByteString.Base64 as Base64
18-
import Control.Monad
1916
import Data.SafeCopy (base, deriveSafeCopy)
2017
import Data.Typeable (Typeable)
2118

22-
import Foreign.C.String
23-
import System.IO.Unsafe (unsafePerformIO)
24-
import Control.Concurrent.MVar (MVar, newMVar, withMVar)
25-
2619
import qualified Data.ByteString.Char8 as BS -- TODO: Verify that we don't need to worry about UTF8 here
2720

2821
---------------------------
@@ -42,24 +35,6 @@ newtype HtPasswdHash = HtPasswdHash String
4235

4336
$(deriveSafeCopy 0 'base ''HtPasswdHash)
4437

45-
checkCryptAuthInfo :: HtPasswdHash -> BasicAuthInfo -> Bool
46-
checkCryptAuthInfo (HtPasswdHash hash) (BasicAuthInfo _ _ (PasswdPlain passwd))
47-
= crypt passwd hash == hash
48-
49-
foreign import ccall unsafe "crypt" cCrypt :: CString-> CString -> CString
50-
51-
crypt :: String -- ^ Payload
52-
-> String -- ^ Salt
53-
-> String -- ^ Hash
54-
crypt key seed = unsafePerformIO $ withMVar cryptMVar $ \_ -> do
55-
k <- newCAString key
56-
s <- newCAString seed
57-
peekCAString $ cCrypt k s
58-
59-
cryptMVar :: MVar ()
60-
cryptMVar = unsafePerformIO $ newMVar ()
61-
{-# NOINLINE cryptMVar #-}
62-
6338
--------------------
6439
-- HTTP Basic auth
6540
--
@@ -83,32 +58,12 @@ guardAuthenticated realm users getHtPasswdHash = do
8358
| otherwise
8459
= Nothing
8560

61+
-- basic auth is deprecated:
62+
-- https://github.com/haskell/hackage-server/issues/1153#issuecomment-1370308832
8663
checkBasicAuth :: Users.Users -> (UserId -> Maybe HtPasswdHash) -> RealmName -> BS.ByteString
8764
-> Either AuthError (UserId, UserInfo, PasswdPlain)
88-
checkBasicAuth users getHtPasswdHash realm ahdr = do
89-
authInfo <- getBasicAuthInfo realm ahdr ?! UnrecognizedAuthError
90-
let uname = basicUsername authInfo
91-
(uid, uinfo) <- Users.lookupUserName uname users ?! NoSuchUserError
92-
passwdhash <- getHtPasswdHash uid ?! NoSuchUserError
93-
guard (checkCryptAuthInfo passwdhash authInfo) ?! PasswordMismatchError
94-
return (uid, uinfo, basicPasswd authInfo)
95-
96-
getBasicAuthInfo :: RealmName -> BS.ByteString -> Maybe BasicAuthInfo
97-
getBasicAuthInfo realm authHeader
98-
| Just (username, pass) <- splitHeader authHeader
99-
= Just BasicAuthInfo {
100-
basicRealm = realm,
101-
basicUsername = UserName username,
102-
basicPasswd = PasswdPlain pass
103-
}
104-
| otherwise = Nothing
105-
where
106-
splitHeader h = case Base64.decode h of
107-
Left _ -> Nothing
108-
Right xs ->
109-
case break (':' ==) $ BS.unpack xs of
110-
(username, ':' : pass) -> Just (username, pass)
111-
_ -> Nothing
65+
checkBasicAuth _ _ _ _ =
66+
Left UnrecognizedAuthError
11267

11368
setBasicAuthChallenge :: RealmName -> ServerPartE ()
11469
setBasicAuthChallenge (RealmName realmName) = do

0 commit comments

Comments
 (0)