diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,10 @@ +0.1.2 +===== + +* Rewrite to use `optparse-applicative` instead of `docopt`. +* Rewrite to use `getAddrInfo` instead of `inet_addr`. + + 0.1.1 ===== diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ =============== HTTP server for managing [MariaDB](http://mariadb.org/) users. -Designed to work behind [Sproxy](https://github.com/zalora/sproxy) +Designed to work behind [Sproxy](http://hackage.haskell.org/package/sproxy2). and assuming users' logins are their email addresses (MariaDB allows up to 80 characters). @@ -17,7 +17,7 @@ Installation ============ - $ git clone https://github.com/zalora/juandelacosa.git + $ git clone https://github.com/ip1981/juandelacosa.git $ cd juandelacosa $ cabal install @@ -25,19 +25,19 @@ ===== 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] - - -d, --datadir=DIR Data directory including static files [default: ] - - -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) + Usage: juandelacosa [-f|--file FILE] [-g|--group STRING] [-d|--datadir DIR] + [(-p|--port INT) | (-s|--socket PATH)] - -h, --help Show this message + Available options: + -f,--file FILE Read this MySQL client config file + -g,--group STRING Read this options group in the above file + (default: "client") + -d,--datadir DIR Data directory including static files + (default: "/home/pashev/.cabal/share/x86_64-linux-ghc-8.8.4/juandelacosa-0.1.2") + -p,--port INT listen on this TCP port (localhost only) + -s,--socket PATH Listen on this UNIX-socket + (default: "/tmp/juandelacosa.sock") + -h,--help Show this help text Database Privileges @@ -53,6 +53,6 @@ Screenshots =========== ![Reset Password](./screenshots/resetpassword.png) -![Password Chnaged](./screenshots/passwordchanged.png) +![Password Changed](./screenshots/passwordchanged.png) ![No Account](./screenshots/noaccout.png) diff --git a/juandelacosa.cabal b/juandelacosa.cabal --- a/juandelacosa.cabal +++ b/juandelacosa.cabal @@ -1,59 +1,62 @@ -name: juandelacosa -version: 0.1.1 -synopsis: Manage users in MariaDB >= 10.1.1 +name: juandelacosa +version: 0.1.2 +cabal-version: 1.20 +license: MIT +license-file: LICENSE +copyright: 2016, Zalora South East Asia Pte. Ltd +maintainer: Igor Pashev +author: Igor Pashev +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 -maintainer: Igor Pashev -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 + 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). + +category: Databases, Web +build-type: Simple data-files: - index.html - static/external/bootstrap/css/*.min.css - static/external/bootstrap/js/*.min.js - static/external/jquery-2.2.4.min.js - static/juandelacosa.js + index.html + static/external/bootstrap/css/*.min.css + static/external/bootstrap/js/*.min.js + static/external/jquery-2.2.4.min.js + static/juandelacosa.js +extra-source-files: + README.md + ChangeLog.md + source-repository head - type: git - location: https://github.com/zalora/juandelacosa.git + type: git + location: https://github.com/ip1981/juandelacosa.git executable juandelacosa - default-language: Haskell2010 - ghc-options: -Wall -static - hs-source-dirs: src - main-is: Main.hs + main-is: Main.hs + hs-source-dirs: src other-modules: - Application - LogFormat - Server - build-depends: - base >= 4.8 && < 50 - , base64-bytestring >= 1.0 - , bytestring >= 0.10 - , data-default-class - , docopt >= 0.7 - , entropy >= 0.3 - , fast-logger - , http-types >= 0.9 - , interpolatedstring-perl6 >= 1.0 - , mtl >= 2.2 - , mysql >= 0.1 - , mysql-simple >= 0.2 - , network >= 2.6 - , resource-pool >= 0.2 - , scotty >= 0.10 - , text >= 1.2 - , unix >= 2.7 - , wai >= 3.2 - , wai-extra >= 3.0 - , wai-middleware-static >= 0.8 - , warp >= 3.2 + Application + LogFormat + Server + default-language: Haskell2010 + ghc-options: -Wall -static + build-depends: + base >=4.8 && <50, + base64-bytestring >=1.0, + bytestring >=0.10, + data-default-class -any, + entropy >=0.3, + fast-logger -any, + http-types >=0.9, + mtl >=2.2, + mysql >=0.1, + mysql-simple >=0.2, + network >=2.6, + optparse-applicative >=0.13.0.0, + resource-pool >=0.2, + scotty >=0.10, + text >=1.2, + unix >=2.7, + wai >=3.2, + wai-extra >=3.0, + wai-middleware-static >=0.8, + warp >=3.2 diff --git a/src/Application.hs b/src/Application.hs --- a/src/Application.hs +++ b/src/Application.hs @@ -10,6 +10,7 @@ import Data.ByteString.Base64 (encode) import Data.Default.Class (def) import Data.Pool (Pool, withResource) +import Data.Text.Lazy (Text, toLower) import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8) import Database.MySQL.Simple (Connection, Only(..), query, execute) import Network.HTTP.Types (notFound404, badRequest400) @@ -36,14 +37,10 @@ juanDeLaCosa :: Pool Connection -> Middleware -> FilePath -> ScottyM () juanDeLaCosa p logger dataDir = do - let - index_html = dataDir ++ "/" ++ "index.html" - middleware logger middleware $ staticPolicy (hasPrefix "static" >-> addBase dataDir) - get "/" $ file index_html - get "/index.html" $ file index_html + get "/" $ file (dataDir ++ "/" ++ "index.html") post "/resetMyPassword" $ apiResetMyPassword p get "/whoAmI" $ apiWhoAmI p @@ -53,7 +50,8 @@ apiWhoAmI p = header "From" >>= \case Nothing -> status badRequest400 >> text "Missing header `From'" - Just login -> do + Just email -> do + let login = emailToLogin email [ Only n ] <- withDB p $ \c -> query c "SELECT COUNT(*) FROM mysql.user WHERE User=? AND Host='%'" [ LBS.toStrict . encodeUtf8 $ login ] @@ -65,7 +63,8 @@ apiResetMyPassword p = header "From" >>= \case Nothing -> status badRequest400 >> text "Missing header `From'" - Just login -> do + Just email -> do + let login = emailToLogin email password <- liftIO $ BS.takeWhile (/= '=') . encode <$> getEntropy 13 _ <- withDB p $ \c -> execute c "SET PASSWORD FOR ?@'%' = PASSWORD(?)" [ LBS.toStrict . encodeUtf8 $ login, password ] @@ -74,4 +73,7 @@ withDB :: Pool Connection -> (Connection -> IO a) -> ActionM a withDB p a = liftIO $ withResource p (liftIO . a) + +emailToLogin :: Text -> Text +emailToLogin = toLower diff --git a/src/LogFormat.hs b/src/LogFormat.hs --- a/src/LogFormat.hs +++ b/src/LogFormat.hs @@ -12,7 +12,7 @@ import System.Log.FastLogger (LogStr, toLogStr) import qualified Data.ByteString.Char8 as BS --- Sligthly modified Common Log Format. +-- Sligthly modified Combined Log Format. -- User ID extracted from the From header. logFormat :: BS.ByteString -> Request -> Status -> Maybe Integer -> LogStr logFormat t req st msize = "" diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,73 +1,113 @@ -{-# LANGUAGE QuasiQuotes #-} - -module Main ( - main -) where +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 (getDataDir, version) -- from cabal -import System.Environment (getArgs) -import Text.InterpolatedString.Perl6 (qc) -import qualified System.Console.Docopt.NoTH as O - -import Server (server) - -usage :: IO String -usage = do - dataDir <- getDataDir - return $ - "juandelacosa " ++ showVersion version - ++ " manage MariaDB user and roles" ++ [qc| +import System.IO.Unsafe (unsafePerformIO) -Usage: - juandelacosa [options] +import Options.Applicative + ( Parser + , (<**>) + , (<|>) + , auto + , execParser + , fullDesc + , header + , help + , helper + , info + , long + , metavar + , option + , optional + , short + , showDefault + , strOption + , value + ) -Options: - -f, --file=MYCNF Read this MySQL client config file - -g, --group=GROUP Read this options group in the above file [default: client] +import Server (Listen(Port, Socket), server) - -d, --datadir=DIR Data directory including static files [default: {dataDir}] +data Config = + Config + { file :: Maybe FilePath + , group :: String + , datadir :: FilePath + , listen :: Listen + } - -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) +parseListen :: Parser Listen +parseListen = port <|> socket + where + port = + Port <$> + option + auto + (long "port" <> + short 'p' <> + metavar "INT" <> help "listen on this TCP port (localhost only)") + socket = + Socket <$> + option + auto + (long "socket" <> + short 's' <> + metavar "PATH" <> + value "/tmp/juandelacosa.sock" <> + showDefault <> help "Listen on this UNIX-socket") - -h, --help Show this message +{-# NOINLINE dataDir #-} +dataDir :: FilePath +dataDir = unsafePerformIO getDataDir -|] +parseConfig :: Parser Config +parseConfig = + Config <$> + optional + (strOption + (long "file" <> + short 'f' <> metavar "FILE" <> help "Read this MySQL client config file")) <*> + strOption + (long "group" <> + short 'g' <> + metavar "STRING" <> + value "client" <> + showDefault <> help "Read this options group in the above file") <*> + strOption + (long "datadir" <> + short 'd' <> + metavar "DIR" <> + value dataDir <> + showDefault <> help "Data directory including static files") <*> + parseListen -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" - datadir = fromJust $ O.getArg args $ O.longOption "datadir" - -- 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 datadir +run :: Config -> IO () +run cfg = do + let myInfo = + ConnectInfo + { connectDatabase = "" + , connectHost = "" + , connectOptions = + case file cfg of + Nothing -> [] + Just f -> + [ReadDefaultFile f, ReadDefaultGroup (pack $ group cfg)] + , connectPassword = "" + , connectPath = "" + , connectPort = 0 + , connectSSL = Nothing + , connectUser = "" + } + server (listen cfg) myInfo (datadir cfg) +main :: IO () +main = run =<< execParser opts + where + opts = info (parseConfig <**> helper) (fullDesc <> header desc) + desc = + "juandelacosa " ++ + showVersion version ++ " - manage MariaDB user and roles" diff --git a/src/Server.hs b/src/Server.hs --- a/src/Server.hs +++ b/src/Server.hs @@ -1,67 +1,94 @@ module Server -( - server -) where + ( Listen(..) + , server + ) where -import Control.Exception.Base (throwIO, catch, bracket) +import Control.Exception.Base (bracket, catch, throwIO) import Data.Bits ((.|.)) import Data.Pool (createPool, destroyAllResources) import Database.MySQL.Base (ConnectInfo) -import Network.Socket (socket, setSocketOption, bind, listen, close, - maxListenQueue, getSocketName, inet_addr, Family(AF_UNIX, AF_INET), - SocketType(Stream), SocketOption(ReuseAddr), Socket, SockAddr(SockAddrUnix, - SockAddrInet)) -import Network.Wai.Handler.Warp (Port, defaultSettings, runSettingsSocket) +import qualified Database.MySQL.Simple as MySQL +import Network.Socket + ( AddrInfoFlag(AI_NUMERICSERV) + , Family(AF_UNIX) + , SockAddr(SockAddrUnix) + , Socket + , SocketOption(ReuseAddr) + , SocketType(Stream) + , addrAddress + , addrFamily + , addrFlags + , addrProtocol + , addrSocketType + , bind + , close + , defaultHints + , getAddrInfo + , getSocketName + , listen + , maxListenQueue + , setSocketOption + , socket + ) +import Network.Wai.Handler.Warp (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 System.Posix.Files + ( groupReadMode + , groupWriteMode + , ownerReadMode + , ownerWriteMode + , removeLink + , setFileMode + , socketMode + ) import Application (app) -type Listen = Either Port FilePath - +data Listen + = Socket FilePath + | Port Int server :: Listen -> ConnectInfo -> FilePath -> IO () server socketSpec mysqlConnInfo dataDir = 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 - hPutStrLn stderr $ "Static files from `" ++ dataDir ++ "'" - runSettingsSocket defaultSettings sock =<< app mysql dataDir) - + (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 + hPutStrLn stderr $ "Static files from `" ++ dataDir ++ "'" + runSettingsSocket defaultSettings sock =<< app mysql dataDir) createSocket :: Listen -> IO Socket -createSocket (Right path) = do +createSocket (Socket path) = do removeIfExists path sock <- socket AF_UNIX Stream 0 bind sock $ SockAddrUnix path - setFileMode path $ socketMode - .|. ownerWriteMode .|. ownerReadMode - .|. groupWriteMode .|. groupReadMode + 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 +createSocket (Port port) = do + addr:_ <- getAddrInfo (Just hints) (Just "localhost") (Just svc) + sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) setSocketOption sock ReuseAddr 1 - addr <- inet_addr "127.0.0.1" - bind sock $ SockAddrInet (fromIntegral port) addr + bind sock $ addrAddress addr hPutStrLn stderr $ "Listening on localhost:" ++ show port return sock - + where + svc = show port + hints = defaultHints {addrFlags = [AI_NUMERICSERV], addrSocketType = Stream} closeSocket :: Socket -> IO () closeSocket sock = do @@ -71,10 +98,9 @@ SockAddrUnix path -> removeIfExists path _ -> return () - removeIfExists :: FilePath -> IO () removeIfExists fileName = removeLink fileName `catch` handleExists - where handleExists e - | isDoesNotExistError e = return () - | otherwise = throwIO e - + where + handleExists e + | isDoesNotExistError e = return () + | otherwise = throwIO e diff --git a/static/juandelacosa.js b/static/juandelacosa.js --- a/static/juandelacosa.js +++ b/static/juandelacosa.js @@ -8,7 +8,7 @@ var passwordMessage = $('#passwordMessage'); var resetPassword = $('#resetPassword'); - document.title = window.location.hostname + ' - ' + 'Juan De La Cosa'; + document.title = window.location.hostname + ' — ' + 'Juan De La Cosa'; (function whoAmI() { $.ajax({ @@ -29,7 +29,7 @@ infoAlert.removeClass().addClass('alert alert-info'); setTimeout(whoAmI, 60 * 1000); } else { - infoHead.text('An error has occured'); + infoHead.text('An error has occurred'); infoAlert.text((0 == jqXHR.readyState) ? 'Service unavailable' : errorThrown); infoAlert.removeClass().addClass('alert alert-danger');