aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ChangeLog.md6
-rw-r--r--LICENSE20
-rw-r--r--README.md49
-rw-r--r--Setup.hs2
-rw-r--r--juandelacosa.cabal46
-rw-r--r--src/Application.hs52
-rw-r--r--src/Main.hs67
-rw-r--r--src/Server.hs78
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
+
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..f754880
--- /dev/null
+++ b/LICENSE
@@ -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
+