juandelacosa (empty) → 0.0.1

raw patch · 8 files changed

+320/−0 lines, 8 filesdep +basedep +base64-bytestringdep +bytestringsetup-changed

Dependencies added: base, base64-bytestring, bytestring, case-insensitive, docopt, entropy, http-types, mysql, mysql-simple, network, raw-strings-qq, resource-pool, unix, wai, warp

Files

• ChangeLog.md +6/−0
• LICENSE +20/−0
• README.md +49/−0
• Setup.hs +2/−0
• juandelacosa.cabal +46/−0
• src/Application.hs +52/−0
• src/Main.hs +67/−0
• src/Server.hs +78/−0

@@ -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.

@@ -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.+

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -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+

@@ -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+

@@ -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+

@@ -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+