From fbf6a0af61587b9c7a01e17a3dd55cff3c0afae5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABl=20Depreeuw?= Date: Wed, 20 Jun 2018 19:32:10 +0200 Subject: [PATCH] Complete chapter 31 --- 31-final-project/fingerd/LICENSE | 30 +++++ 31-final-project/fingerd/README.md | 27 +++++ 31-final-project/fingerd/Setup.hs | 2 + 31-final-project/fingerd/finger.db | Bin 0 -> 16384 bytes 31-final-project/fingerd/fingerd.cabal | 69 +++++++++++ 31-final-project/fingerd/lib/UserDB.hs | 147 ++++++++++++++++++++++++ 31-final-project/fingerd/src/AddUser.hs | 45 ++++++++ 31-final-project/fingerd/src/Debug.hs | 29 +++++ 31-final-project/fingerd/src/Main.hs | 136 ++++++++++++++++++++++ 31-final-project/fingerd/stack.yaml | 65 +++++++++++ 31-final-project/fingerd/user.json | Bin 0 -> 146 bytes 11 files changed, 550 insertions(+) create mode 100644 31-final-project/fingerd/LICENSE create mode 100644 31-final-project/fingerd/README.md create mode 100644 31-final-project/fingerd/Setup.hs create mode 100644 31-final-project/fingerd/finger.db create mode 100644 31-final-project/fingerd/fingerd.cabal create mode 100644 31-final-project/fingerd/lib/UserDB.hs create mode 100644 31-final-project/fingerd/src/AddUser.hs create mode 100644 31-final-project/fingerd/src/Debug.hs create mode 100644 31-final-project/fingerd/src/Main.hs create mode 100644 31-final-project/fingerd/stack.yaml create mode 100644 31-final-project/fingerd/user.json diff --git a/31-final-project/fingerd/LICENSE b/31-final-project/fingerd/LICENSE new file mode 100644 index 0000000..7b3198d --- /dev/null +++ b/31-final-project/fingerd/LICENSE @@ -0,0 +1,30 @@ +Copyright Gaël Depreeuw (c) 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Gaël Depreeuw nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/31-final-project/fingerd/README.md b/31-final-project/fingerd/README.md new file mode 100644 index 0000000..b06a071 --- /dev/null +++ b/31-final-project/fingerd/README.md @@ -0,0 +1,27 @@ +# fingerd + +## Excercise 1 + +Add new user: + +```shell +sudo sqlite3 finger.db +> insert into users values(Null, 'foo', '/bin/sh', '/home/foo', 'Foo Bar', '1234'); +> select * from users; +1|gdp|/bin/sh|/home/gdp|Gaël Depreeuw|555-123-4567 +2|foo|/bin/sh|/home/foo|Foo Bar|1234 +``` + +Update existing user: + +```shell +sudo sqlite3 finger.db +> update users set phone='n/a' where id=1 +> select * from users; +1|gdp|/bin/sh|/home/gdp|Gaël Depreeuw|n/a +2|foo|/bin/sh|/home/foo|Foo Bar|1234 +``` + +## Excercise 2 + +see [src/AddUser.hs](./src/AddUser.hs) \ No newline at end of file diff --git a/31-final-project/fingerd/Setup.hs b/31-final-project/fingerd/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/31-final-project/fingerd/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/31-final-project/fingerd/finger.db b/31-final-project/fingerd/finger.db new file mode 100644 index 0000000000000000000000000000000000000000..03aa2803f0fa2ed968825ac2674cca3afb29b540 GIT binary patch literal 16384 zcmeI(KX21O7zXfjoTg2sa7a<*N&#{ms2VlF^iSx7L`qE+wGC}>Br-+U_DU=qJGB!* z+2ETnv+y05kYHi##>mKk1RJj}WJo2ZPKC#ceZKSiT%4aLpOhyDyWT*FlQ8PZfmmbL znPIR8LNLZ=Xiw8V-V8dq*dJf}TRX$<+<2ekKbd*$6XUn|XKJuP00Izz00bZa0SG_< z0uX=z1TH18Z)U9JWurZihrWtWeR{F&#OidYf}@Mw^uwl8a~`>dJyoV; z>2=wdwk*qdv!Ul4#wv>SAvKZLL$g9GdB>vOaGhct*bT%4GvXPR0W1KCEem4w8 z^OQ=djCJ2Km=_$Ymw$eg91cR=@94Yitmwuh=;ZyL<@iT7#pfBH=U@0+e#W;i^#~A# z00bZa0SG_<0uX=z1Rwwb2wW+F3Y%v6;=i}Q z-rKmFrt+J`iuK&<*@s?WzoK#-qk$c-C$^N>3svNYVXRhGDYj@*qEIYYhceQMae(@p zG7^u%kgC?Jizz*GVeTXhCugPsDiTzj6q0UM3)7MXO}tRbKRfPEOq}$$<%f4Z-Aq4H zYWO0sM`MFApijgKmY;|fB*y_009U<00RHHK*r3^&{D;; znKx(+BAv9fv|uJJtsJE2a+X#Ea-?MNAB;ZOAOHafKmY;|fB*y_009U<00I#Bmjtqg KX&L%|0O{Y9`@WU{ literal 0 HcmV?d00001 diff --git a/31-final-project/fingerd/fingerd.cabal b/31-final-project/fingerd/fingerd.cabal new file mode 100644 index 0000000..4198b4e --- /dev/null +++ b/31-final-project/fingerd/fingerd.cabal @@ -0,0 +1,69 @@ +name: fingerd +version: 0.1.0.0 +synopsis: Simple project template +description: Please see README.md +homepage: https://github.com/Mithror/fingerd#readme +license: BSD3 +license-file: LICENSE +author: Gaël Depreeuw +maintainer: gael.depreeuw@gmail.com +copyright: Copyright (c) 2018 Gaël Depreeuw +category: daemon +build-type: Simple +cabal-version: >=1.10 +extra-source-files: README.md + +library + hs-source-dirs: lib + exposed-modules: UserDB + default-language: Haskell2010 + build-depends: base >= 4.7 && < 5 + , bytestring + , network + , raw-strings-qq + , sqlite-simple + , text + , aeson + +-- library userdb-internal +-- hs-source-dirs: lib +-- exposed-modules: UserDB.Internal +-- default-language: Haskell2010 +-- build-depends: base >= 4.7 && < 5 +-- , bytestring +-- , network +-- , raw-strings-qq +-- , sqlite-simple +-- , text + +executable debug + ghc-options: -Wall + hs-source-dirs: src + main-is: Debug.hs + default-language: Haskell2010 + build-depends: base >= 4.7 && < 5 + , network + +executable adduser + ghc-options: -Wall + hs-source-dirs: src + main-is: AddUser.hs + default-language: Haskell2010 + build-depends: base >= 4.7 && < 5 + , sqlite-simple + , text + , fingerd + +executable fingerd + ghc-options: -Wall + hs-source-dirs: src + main-is: Main.hs + default-language: Haskell2010 + build-depends: base >= 4.7 && < 5 + , bytestring + , network + , raw-strings-qq + , sqlite-simple + , text + , fingerd + , aeson \ No newline at end of file diff --git a/31-final-project/fingerd/lib/UserDB.hs b/31-final-project/fingerd/lib/UserDB.hs new file mode 100644 index 0000000..bf46b03 --- /dev/null +++ b/31-final-project/fingerd/lib/UserDB.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE OverloadedStrings #-} +-- {-# LANGUAGE QuasiQuotes #-} + +module UserDB + ( User(..), getSingleUser, getAllUsers, addUser, updateUser) + where + +import Control.Exception +import Data.Text (Text) +-- import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Database.SQLite.Simple hiding (close) +import Database.SQLite.Simple as SQLite +-- import Database.SQLite.Simple.Types +import Data.Typeable +-- import Text.RawString.QQ +import Data.Maybe (catMaybes) +import Data.List (intersperse) +import Data.String (fromString) +import Data.Aeson + +data User = + User { + userId :: Integer + , username :: Text + , shell :: Text + , homeDirectory :: Text + , realName :: Text + , phone :: Text + } deriving (Eq, Show) + +instance FromRow User where + fromRow = User <$> field + <*> field + <*> field + <*> field + <*> field + <*> field + +instance ToRow User where + toRow (User id_ uname sh hDir rName ph) = + toRow (id_, uname, sh, hDir, rName, ph) + +instance FromJSON User where + parseJSON = withObject "User" $ \v -> User 0 + <$> v .: "username" + <*> v .: "shell" + <*> v .: "homeDirectory" + <*> v .: "realName" + <*> v .: "phone" + +-- createUsers :: Query +-- createUsers = [r| +-- CREATE TABLE IF NOT EXISTS users +-- (id INTEGER PRIMARY KEY AUTOINCREMENT, +-- username TEXT UNIQUE, +-- shell TEXT, homeDirectory TEXT, +-- realName TEXT, phone TEXT) +-- |] + +insertUser :: Query +insertUser = "INSERT INTO users VALUES (?, ?, ?, ?, ?, ?)" + +allUsers :: Query +allUsers = "SELECT * from users" + +getUserQuery :: Query +getUserQuery = "SELECT * from users where username = ?" + +data DuplicateData = DuplicateData deriving (Eq, Show, Typeable) + +instance Exception DuplicateData + +-- type UserRow = (Null, Text, Text, Text, Text, Text) + +getUser :: Connection -> Text -> IO (Maybe User) +getUser conn uname = do + results <- query conn getUserQuery (Only uname) + case results of + [] -> return $ Nothing + [user] -> return $ Just user + _ -> throwIO DuplicateData + +addUser :: User -> IO Bool +addUser u = do + conn <- getConnection + n <- query conn hasUser (Only $ username u) :: IO [Only Integer] + b <- case n of + [] -> (execute conn insertUser $ toRow u) >> return True + _ -> return False + rows <- query_ conn allUsers + mapM_ print (rows :: [User]) + SQLite.close conn + return b + +-- createDatabase :: IO () +-- createDatabase = do +-- conn <- getConnection +-- execute_ conn createUsers +-- SQLite.close conn + +getConnection :: IO Connection +getConnection = open "finger.db" + +getSingleUser :: Text -> IO (Maybe User) +getSingleUser name = do + conn <- getConnection + result <- getUser conn name + SQLite.close conn + return result + +getAllUsers :: IO [User] +getAllUsers = do + conn <- getConnection + rows <- query_ conn allUsers + SQLite.close conn + return rows + +hasUser :: Query +hasUser = "SELECT 1 FROM users where username = ?" + +updateUser :: String + -> Maybe String + -> Maybe String + -> Maybe String + -> Maybe String + -> IO Bool +updateUser name sh hDir rName ph = do + let xs = [sh, hDir, rName, ph] + columns = zip ["shell", "homeDirectory", "realName", "phone"] xs + newData = catMaybes $ fmap sequenceA columns + case newData of + [] -> return True + ys -> do + let pairs = fmap (\(a,b) -> a ++ "=\"" ++ b ++ "\"" ) ys + part = concat $ intersperse "," pairs + full = "update users set " ++ part + ++ " where username = \"" ++ name ++ "\"" + conn <- getConnection + n <- query conn hasUser (Only name) :: IO [Only Integer] + b <- case n of + [] -> return False + _ -> execute conn (fromString full) (Only name) >> return True + SQLite.close conn + return b + +-- updateU :: User -> IO () +-- update \ No newline at end of file diff --git a/31-final-project/fingerd/src/AddUser.hs b/31-final-project/fingerd/src/AddUser.hs new file mode 100644 index 0000000..9228896 --- /dev/null +++ b/31-final-project/fingerd/src/AddUser.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import UserDB + +import Data.Text (Text) +import qualified Data.Text as T +import System.Environment (getArgs) +import System.IO (hSetBuffering, BufferMode(..), stdout) +import Data.String (fromString) + +addUser' :: Text -> IO () +addUser' name = do + s <- fmap fromString $ putStr "Shell: " >> getLine + h <- fmap fromString $ putStr "Home Dir: " >> getLine + r <- fmap fromString $ putStr "Real name: " >> getLine + p <- fmap fromString $ putStr "Phone no.: " >> getLine + b <- addUser $ User 0 name s h r p + case b of + True -> putStrLn "User succesfully added." + False -> putStrLn "User already exists" + +updateUser' :: Text -> IO () +updateUser' name = do + let f "" = Nothing + f a = Just a + putStrLn "Use blank if you don't want to update." + s <- fmap f $ putStr "Shell: " >> getLine + h <- fmap f $ putStr "Home Dir: " >> getLine + r <- fmap f $ putStr "Real name: " >> getLine + p <- fmap f $ putStr "Phone no.: " >> getLine + b <- updateUser (T.unpack name) s h r p + case b of + True -> putStrLn "User succesfully updated." + False -> putStrLn "No such user found." + +main :: IO () +main = do + hSetBuffering stdout NoBuffering + args <- getArgs + case args of + ["add", name] -> addUser' $ T.pack name + ["update", name] -> updateUser' $ T.pack name + _ -> putStrLn "add | update " \ No newline at end of file diff --git a/31-final-project/fingerd/src/Debug.hs b/31-final-project/fingerd/src/Debug.hs new file mode 100644 index 0000000..3f33e5a --- /dev/null +++ b/31-final-project/fingerd/src/Debug.hs @@ -0,0 +1,29 @@ +module Main where + +import Control.Monad (forever) +import Network.Socket hiding (recv) +import Network.Socket.ByteString (recv, sendAll) + +logAndEcho :: Socket -> IO () +logAndEcho sock = forever $ do + (soc, _) <- accept sock + printAndKickback soc + sClose soc + where printAndKickback conn = do + msg <- recv conn 1024 + print msg + sendAll conn msg + + +main :: IO () +main = withSocketsDo $ do + addrinfos <- getAddrInfo + (Just (defaultHints {addrFlags = [AI_PASSIVE]})) + Nothing + (Just "79") + let serveraddr = head addrinfos + sock <- socket (addrFamily serveraddr) Stream defaultProtocol + bindSocket sock (addrAddress serveraddr) + listen sock 1 + logAndEcho sock + sClose sock \ No newline at end of file diff --git a/31-final-project/fingerd/src/Main.hs b/31-final-project/fingerd/src/Main.hs new file mode 100644 index 0000000..7c92c8e --- /dev/null +++ b/31-final-project/fingerd/src/Main.hs @@ -0,0 +1,136 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import UserDB (User(..), getAllUsers, getSingleUser, addUser) + +import Control.Concurrent +-- import Control.Concurrent.MVar +import Control.Monad (forever) +import Data.List (intersperse) +import Data.Text (Text) +import qualified Data.Text as T +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Network.Socket hiding ({-close,-} recv) +import Network.Socket.ByteString (recv, sendAll) +import Data.Aeson + +getAllUsers' :: MVar Bool -> IO [User] +getAllUsers' m = do + m' <- takeMVar m + users <- getAllUsers + putMVar m m' + return users + +addUser' :: MVar Bool -> User -> IO () +addUser' m u = do + m' <- takeMVar m + b <- addUser u + print b + putMVar m m' + +formatUser :: User -> ByteString +formatUser (User _ uname sh homeDir rName _) = BS.concat + [ "Login: ", e uname, "\t\t\t\t" + , "Name: ", e rName, "\n" + , "Directory: ", e homeDir, "\t\t\t" + , "Shell: ", e sh, "\n"] + where e = encodeUtf8 + +returnUsers :: Socket -> MVar Bool -> IO () +returnUsers soc m = do + rows <- getAllUsers-- m + let usernames = map username rows + newlineSeparated = T.concat $ intersperse "\n" usernames + sendAll soc (encodeUtf8 newlineSeparated) + +returnUser :: Socket -> Text -> IO () +returnUser soc uname = do + maybeUser <- getSingleUser uname + case maybeUser of + Nothing -> do + putStrLn $ "Couldn't find matching user for username: " ++ show uname + return () + Just user -> sendAll soc (formatUser user) + +handleQuery :: Socket -> MVar Bool -> IO () +handleQuery soc m = do + msg <- recv soc 1024 + case msg of + "\r\n" -> returnUsers soc m + name -> returnUser soc (decodeUtf8 name) + +handleQueries :: Socket -> MVar Bool -> IO () +handleQueries sock m = forever $ do + (soc, _) <- accept sock + putStrLn "Got connection, handling query" + handleQuery soc m + Network.Socket.close soc -- sClose soc is deprecated + +fingerd :: MVar Bool -> IO () +fingerd m = do + withSocketsDo $ do + addrinfos <- getAddrInfo (Just (defaultHints {addrFlags = [AI_PASSIVE]})) + Nothing + (Just "79") + let serveraddr = head addrinfos + sock <- socket (addrFamily serveraddr) Stream defaultProtocol + Network.Socket.bind sock (addrAddress serveraddr) + -- bindSocket sock (addrAddress serveraddr) is deprecated + listen sock 1 + -- only one connection open at a time + handleQueries sock m + Network.Socket.close sock -- sClose sock is deprecated + +recvJson :: Socket -> IO ByteString +recvJson soc = do + msg <- recv soc 1024 + let l = BS.length msg + case l of + 0 -> do + msg' <- recvJson soc + return $ msg `BS.append` msg' + _ -> case BS.last msg of + 0 -> return $ BS.take (l - 1) msg + _ -> do + msg' <- recvJson soc + return $ msg `BS.append` msg' + -- return msg + +handleRequest :: Socket -> MVar Bool -> IO () +handleRequest sock m = forever $ do + (soc, _) <- accept sock + putStrLn "Woohoo!" + j <- recvJson soc + print j + case decode (BSL.fromStrict j) of + Nothing -> putStrLn "Cannot decode." + (Just u) -> do + putStrLn $ "Decoded User: " ++ show u + addUser' m u + Network.Socket.close soc -- sClose soc is deprecated + +add :: MVar Bool -> IO () +add m = do + withSocketsDo $ do + addrinfos <- getAddrInfo (Just (defaultHints {addrFlags = [AI_PASSIVE]})) + Nothing + (Just "4242") + let serveraddr = head addrinfos + sock <- socket (addrFamily serveraddr) Stream defaultProtocol + Network.Socket.bind sock (addrAddress serveraddr) + -- bindSocket sock (addrAddress serveraddr) is deprecated + listen sock 1 + -- only one connection open at a time + handleRequest sock m + Network.Socket.close sock -- sClose sock is deprecated + +main :: IO () +-- main = createDatabase +main = do + m <- newMVar True + _ <- forkIO $ add m + fingerd m \ No newline at end of file diff --git a/31-final-project/fingerd/stack.yaml b/31-final-project/fingerd/stack.yaml new file mode 100644 index 0000000..cc7c18a --- /dev/null +++ b/31-final-project/fingerd/stack.yaml @@ -0,0 +1,65 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: lts-11.13 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver +# using the same syntax as the packages field. +# (e.g., acme-missiles-0.3) +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.7" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor \ No newline at end of file diff --git a/31-final-project/fingerd/user.json b/31-final-project/fingerd/user.json new file mode 100644 index 0000000000000000000000000000000000000000..5d58d2e4789e12698861148eb1c59ad13c5d0d27 GIT binary patch literal 146 zcmb>CQUC&_(&E&jyu{p8B?T)5rNqQUB^`)(aYkxR4p>k>BR@A)zc@o5CI#ZVWEQ0+ zm*f{!A}ImthN~$`P0aCw8S9v+;0V)PkddDUvCP!eRM*hRSl7hV%v_19mWu%Z{vITQ literal 0 HcmV?d00001