diff options
| -rw-r--r-- | ChangeLog.md | 6 | ||||
| -rw-r--r-- | LICENSE | 20 | ||||
| -rw-r--r-- | README.md | 49 | ||||
| -rw-r--r-- | Setup.hs | 2 | ||||
| -rw-r--r-- | juandelacosa.cabal | 46 | ||||
| -rw-r--r-- | src/Application.hs | 52 | ||||
| -rw-r--r-- | src/Main.hs | 67 | ||||
| -rw-r--r-- | src/Server.hs | 78 |
8 files changed, 320 insertions, 0 deletions
diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 index 0000000..50f80eb --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,6 @@ +0.0.1 +===== + +* Initial version +* Only reset user password on any request + @@ -0,0 +1,20 @@ +Copyright (c) 2016, Zalora South East Asia Pte. Ltd + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..67eb6fb --- /dev/null +++ b/README.md @@ -0,0 +1,49 @@ +Juan de la Cosa +=============== + +HTTP server for managing [MariaDB](http://mariadb.org/) users. +Designed to work behind [Sproxy](https://github.com/zalora/sproxy) +and assuming users' logins are their email addresses +(MariaDB allows up to 80 characters). + +Currently it only let users get new passwords. + +Requirements +============ +Juan de la Cosa is written in Haskell with [GHC](http://www.haskell.org/ghc/). +All required Haskell libraries are listed in [juandelacosa.cabal](juandelacosa.cabal). +Use [cabal-install](http://www.haskell.org/haskellwiki/Cabal-Install) +to fetch and build all pre-requisites automatically. + +Installation +============ + $ git clone https://github.com/zalora/juandelacosa.git + $ cd juandelacosa + $ cabal install + +Usage +===== +Type `juandelacosa --help` to see usage summary: + + Usage: + juandelacosa [options] + + Options: + -f, --file=MYCNF Read this MySQL client config file + -g, --group=GROUP Read this options group in the above file [default: client] + + -s, --socket=SOCK Listen on this UNIX-socket [default: /tmp/juandelacosa.sock] + -p, --port=PORT Instead of UNIX-socket, listen on this TCP port (localhost) + + -h, --help Show this message + +Example: + + $ juandelacosa -p 8080 + $ curl http://localhost:8080 -H 'From: jack.frost@example.com' + Tiw7CdJOmYxJBZ7J + +The above request will change the password for 'jack.frost@example.com'@'%' +and return the new password to user. Once it's behind Sproxy +any user can get a new password in a secure way. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/juandelacosa.cabal b/juandelacosa.cabal new file mode 100644 index 0000000..95dd77a --- /dev/null +++ b/juandelacosa.cabal @@ -0,0 +1,46 @@ +name: juandelacosa +version: 0.0.1 +synopsis: Manage users in MariaDB >= 10.1.1 +description: + HTTP server for managing MariaDB users. Designed to work behind + Sproxy and assuming users' logins are their email addresses + (MariaDB allows up to 80 characters). +license: MIT +license-file: LICENSE +author: Igor Pashev <pashev.igor@gmail.com> +maintainer: Igor Pashev <pashev.igor@gmail.com> +copyright: 2016, Zalora South East Asia Pte. Ltd +category: Databases, Web +build-type: Simple +extra-source-files: README.md ChangeLog.md +cabal-version: >= 1.20 + +source-repository head + type: git + location: https://github.com/zalora/juandelacosa.git + +executable juandelacosa + default-language: Haskell2010 + ghc-options: -Wall -static + hs-source-dirs: src + main-is: Main.hs + other-modules: + Application + , Server + build-depends: + base >= 4.8 && < 5 + , base64-bytestring >= 1.0 + , bytestring >= 0.10 + , case-insensitive >= 1.2 + , docopt >= 0.7 + , entropy >= 0.3 + , http-types >= 0.9 + , mysql >= 0.1 + , mysql-simple >= 0.2 + , network >= 2.6 + , raw-strings-qq >= 1.0 + , resource-pool >= 0.2 + , unix >= 2.7 + , wai >= 3.2 + , warp >= 3.2 + diff --git a/src/Application.hs b/src/Application.hs new file mode 100644 index 0000000..0ac37cf --- /dev/null +++ b/src/Application.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Application +( + app +) where + +import Data.ByteString.Base64 (encode) +import Data.Pool (Pool, withResource) +import Database.MySQL.Simple (Connection, execute) +import Network.HTTP.Types (status200, badRequest400, Header) +import Network.HTTP.Types.Header (hContentType) +import Network.Wai (Application, requestHeaders, responseLBS, Response) +import System.Entropy (getEntropy) +import System.IO (stderr) +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Lazy.Char8 as LBS +import qualified Data.CaseInsensitive as CI + + +app :: Pool Connection -> Application +app p request respond = do + let + headers = requestHeaders request + from = readHeader "From" headers + case from of + Just login -> apiResetPassword p login >>= respond + Nothing -> respond $ responseLBS + badRequest400 + [(hContentType, "text/plain")] + "Missing the From header" + + +apiResetPassword :: Pool Connection -> BS.ByteString -> IO Response +apiResetPassword p login = withResource p $ + \c -> do + blab ["SET PASSWORD FOR '", login, "'@'%'"] + password <- BS.takeWhile (/= '=') . encode <$> getEntropy 12 + _ <- execute c "SET PASSWORD FOR ?@'%' = PASSWORD(?)" [ login, password ] + return $ responseLBS + status200 + [(hContentType, "text/plain")] + (LBS.fromStrict password) + + +readHeader :: BS.ByteString -> [Header] -> Maybe BS.ByteString +readHeader h = lookup (CI.mk h) + + +blab :: [BS.ByteString] -> IO () +blab = BS.hPutStrLn stderr . BS.concat + diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..58ae99f --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Main ( + main +) where + +import Data.ByteString.Char8 (pack) +import Data.Maybe (fromJust) +import Data.Version (showVersion) +import Database.MySQL.Base (ConnectInfo(..)) +import Database.MySQL.Base.Types (Option(ReadDefaultFile, ReadDefaultGroup)) +import Paths_juandelacosa (version) -- from cabal +import System.Environment (getArgs) +import Text.RawString.QQ (r) +import qualified System.Console.Docopt.NoTH as O + +import Server (server) + +usage :: String +usage = "juandelacosa " ++ showVersion version + ++ " manage MariaDB user and roles" ++ [r| + +Usage: + juandelacosa [options] + +Options: + -f, --file=MYCNF Read this MySQL client config file + -g, --group=GROUP Read this options group in the above file [default: client] + + -s, --socket=SOCK Listen on this UNIX-socket [default: /tmp/juandelacosa.sock] + -p, --port=PORT Instead of UNIX-socket, listen on this TCP port (localhost) + + -h, --help Show this message + +|] + +main :: IO() +main = do + doco <- O.parseUsageOrExit usage + args <- O.parseArgsOrExit doco =<< getArgs + if args `O.isPresent` O.longOption "help" + then putStrLn $ O.usage doco + else do + let + file = O.getArg args $ O.longOption "file" + group = fromJust $ O.getArg args $ O.longOption "group" + port = O.getArg args $ O.longOption "port" + socket = fromJust $ O.getArg args $ O.longOption "socket" + -- XXX: mysql package maps empty strings to NULL + -- which is what we need, see documentation for mysql_real_connect() + let myInfo = ConnectInfo { + connectDatabase = "", + connectHost = "", + connectOptions = case file of + Nothing -> [] + Just f -> [ ReadDefaultFile f, ReadDefaultGroup (pack group) ], + connectPassword = "", + connectPath = "", + connectPort = 0, + connectSSL = Nothing, + connectUser = "" + } + let listen = case port of + Nothing -> Right socket + Just p -> Left $ read p + server listen myInfo + diff --git a/src/Server.hs b/src/Server.hs new file mode 100644 index 0000000..3ecb642 --- /dev/null +++ b/src/Server.hs @@ -0,0 +1,78 @@ +module Server +( + server +) where + +import Control.Exception.Base (throwIO, catch, bracket) +import Data.Bits ((.|.)) +import Data.Pool (createPool, destroyAllResources) +import Database.MySQL.Base (ConnectInfo) +import Network.Socket (socket, bind, listen, close, maxListenQueue, + getSocketName, inet_addr, + Family(AF_UNIX, AF_INET), SocketType(Stream), + Socket, SockAddr(SockAddrUnix, SockAddrInet)) +import Network.Wai.Handler.Warp (Port, defaultSettings, runSettingsSocket) +import System.IO (hPutStrLn, stderr) +import System.IO.Error (isDoesNotExistError) +import System.Posix.Files (removeLink, setFileMode, socketMode, + ownerReadMode, ownerWriteMode, groupReadMode, groupWriteMode) +import qualified Database.MySQL.Simple as MySQL + +import Application (app) + +type Listen = Either Port FilePath + + +server :: Listen -> ConnectInfo -> IO () +server socketSpec mysqlConnInfo = + bracket + ( do + sock <- createSocket socketSpec + mysql <- createPool + (MySQL.connect mysqlConnInfo) + MySQL.close + 1 -- stripes + 60 -- keep alive (seconds) + 10 -- max connections + return (sock, mysql) ) + ( \(sock, mysql) -> do + closeSocket sock + destroyAllResources mysql ) + ( \(sock, mysql) -> do + listen sock maxListenQueue + runSettingsSocket defaultSettings sock (app mysql) ) + + +createSocket :: Listen -> IO Socket +createSocket (Right path) = do + removeIfExists path + sock <- socket AF_UNIX Stream 0 + bind sock $ SockAddrUnix path + setFileMode path $ socketMode + .|. ownerWriteMode .|. ownerReadMode + .|. groupWriteMode .|. groupReadMode + hPutStrLn stderr $ "Listening on UNIX socket `" ++ path ++ "'" + return sock +createSocket (Left port) = do + sock <- socket AF_INET Stream 0 + addr <- inet_addr "127.0.0.1" + bind sock $ SockAddrInet (fromIntegral port) addr + hPutStrLn stderr $ "Listening on localhost:" ++ show port + return sock + + +closeSocket :: Socket -> IO () +closeSocket sock = do + name <- getSocketName sock + close sock + case name of + SockAddrUnix path -> removeIfExists path + _ -> return () + + +removeIfExists :: FilePath -> IO () +removeIfExists fileName = removeLink fileName `catch` handleExists + where handleExists e + | isDoesNotExistError e = return () + | otherwise = throwIO e + |