# Termbin.com clone (commandline pastebin)

For fun I decided to write a 'real' Haskell program. The intention of the program is that it listens on a socket on a given port for input. The client can send some raw text on it and the server generates a paste for it.

As an example:

### Client

dino :: ~ % echo "Schoolbus" | nc call-cc.be 9999
http://call-cc.be/files/3DFJC


### Server

./carte -d /var/www/ssl/files -p 9999 -h call-cc.be/files


In the above example, the url the client got back will point to a raw textfile that contains "Schoolbus".

In particular, I think there might be a more decent way to thread the configuration through the entire program. Now I use a StateT monad, but it is only useful for the loop and randId function. Maybe the State transformer is a bit of overkill?

And a second thing I have been wondering about. Should I worry about exploits? Should I sanitize the input or some sort? I would like to actually deploy this on my server so I would like to be safe.

And finally, I am unsure how I can exploit the typesystem more thorougly for my arguments. For example, now all my arguments have the same type, namely Arguments. The problem is that, in my code I could write code like (h (Port 1234)), which typechecks but is not correct and will throw a runtime error. I think I might have cut some corners here.

module Main where
import           Base36
import           Control.Concurrent
import           Data.Char
import           Data.List
import           Data.Time.Clock.POSIX
import           Network
import           System.Directory
import           System.Environment
import           System.FilePath.Posix
import           System.IO
import           System.Random
import           Text.Printf

data Data = D { rnd :: StdGen, opts :: Opts }

main :: IO ()
main = do t    <- currentTimeSeconds
opts <- liftM buildOpts getArgs
putStrLn $printf "Config: %s" (show opts) withSocketsDo$
do s <- listenOn (PortNumber $fromInteger . p . port$ opts)
evalStateT (loop s) (D (mkStdGen t) opts)
return ()

----------------------
-- Argument Parsing --
----------------------

data Opts = Opts { port :: Arguments, host :: Arguments, files :: Arguments }
deriving (Show, Eq)

data Arguments
= Port     { p :: Integer }
| HostName { h :: String  }
| FileDir  { dir :: String  }
deriving (Show, Eq)

parseArg as arg constr process  deflt =
let args = take 2 . dropWhile (/= arg) $as in case args of [arg, opts] -> constr (process opts) _ -> constr deflt parsePort as = parseArg as "-p" Port read 5001 parseHost as = parseArg as "-h" HostName id "localhost" parseFileDir as = parseArg as "-d" FileDir id "." buildOpts args = Opts { port = parsePort args, host = parseHost args, files = parseFileDir args } buildFileUrl url id = if last url == '/' then url ++ id else url ++ "/" ++ id --------------------- -- Socket handling -- --------------------- loop :: Socket -> StateT Data IO () loop s = do (h,_,_) <- lift$ accept s
id      <- randId
conf    <- liftM opts get
lift . forkIO $process h id conf loop s process :: Handle -> String -> Opts -> IO () process hdl id opts = do d <- eatData hdl [] let filepath = combine (dir . files$ opts) id
saveToDisk filepath d
hPutStrLn hdl $buildFileUrl (h . host$ opts) id
hFlush hdl
hClose hdl

eatData :: Handle -> [String] -> IO [String]
eatData handle ls =
do l <- hGetLine handle
end <- hIsEOF handle
if end
then return $l:ls else eatData handle$ l:ls

saveToDisk :: FilePath -> [String] -> IO ()
saveToDisk fp ls = do path <- canonicalizePath fp
putStrLn $printf "Writing file to %s" path writeFile path (intercalate "\n" ls) -------------------------- -- Random ID generation -- -------------------------- randId :: StateT Data IO String randId = do d <- get let (str, gen') = random (rnd d) put (d { rnd = gen' }) return$ base36 str

currentTimeSeconds :: IO Int
currentTimeSeconds = round fmap getPOSIXTime


# Argument Parsing

As you noted, your options/arguments code is a little off-kilter. If you check out some argument parsing libraries on Hackage (search “argument” for a pretty good sample) the design space will probably serve as a good guide for how to structure your application configuration value, and help you from reinventing argument parsing all on your own!

I like optparse-applicative myself, which allows you to build a fully featured command line utility interface with just a few simple combinators. E.g., you get nicely formatted usage info basically for free!

Start by defining a configuration datatype with fields that have the actual values you're looking to capture.

data Configuration =
Configuration
{ port  :: Int
, url   :: String
, files :: String
} deriving (Show)


Next we'll define a Parser for Configuration values by building one out of Parsers for its component values. The applicative combinator pattern used here is a common style that you'll run into in many other places, notably including aeson when parsing JSON values.

import Options.Applicative

portParser :: Parser Int
portParser =
( short 'p'      -- a short name i.e. "-p"
<> long "port"    -- a long name i.e. "--port"
<> metavar "PORT" -- a symbolic name in the help text
<> value 5001     -- a default value
<> help "The PORT on which to listen for connections" )

urlParser :: Parser String
urlParser =
strOption
( short 'u'
<> long "url"
<> metavar "URL"
<> value "localhost"
<> help "The root url for building links to files" )

filesParser :: Parser String
filesParser =
strOption
( short 'd'
<> long "dir"
<> metavar "DIRECTORY"
<> value "."
<> help "The DIRECTORY in which to store pastes" )

configuration :: Parser Configuration
configuration =
Configuration
<$> portParser <*> urlParser <*> filesParser  Then this parser can be used from the entry point of your program. A few extra annotations gets us a very robust, fully featured parser. main :: IO () main = execParser prog >>= print -- print for testing purposes where prog = info (helper <*> configuration) ( fullDesc <> progDesc "Start a paste server" <> header "carte - a socket based paste server" )  Now we can test out this argument parser on the command line. [nix-shell:~/misc/codereview/133747]$ ./carte -h
carte - a socket based paste server

Usage: carte [-p|--port PORT] [-u|--url URL] [-d|--dir DIRECTORY]
Start a paste server

Available options:
-h,--help                Show this help text
-p,--port PORT           The PORT on which to listen for connections
-u,--url URL             The root url for building links to files
-d,--dir DIRECTORY       The DIRECTORY in which to store pastes

[nix-shell:~/misc/codereview/133747]$./carte --url="example.com" -d files Configuration {port = 5001, url = "example.com", files = "files"}  # State I think you'll be happier with your state passing if you reexamine which functions need what data and where the responsibility lies for calculating certain values. Consider your processing pipeline. The most essential single job it needs to perform is reading bytes out of a handle and putting those bytes to another handle. -- | Writes data from first Handle to second Handle until EOF -- is encountered. The Handles are not closed. pipe :: Handle -> Handle -> IO () pipe source sink = undefined -- Implementation left for later consideration  This is important because it captures essential functionality in the most direct manner possible. Functions like this are reusable components that can be built into larger solutions in easily comprehensible ways. E.g., receiveFile :: Handle -> FilePath -> IO () receiveFile source filepath = withBinaryFile filepath WriteMode (pipe source) notify :: Handle -> URL -> IO () notify source url = undefined newKey :: (Monad m) => StateT StdGen m String newKey = -- Essentially unchanged from randId handleUploader :: Handle -> StateT StdGen (ReaderT Configuration IO) () handleUploader source = do key <- newKey baseUrl <- asks url fileDir <- asks files void . liftIO$ do
receiveFile source (fileDir </> key) -- Assumes (</>) ~= buildFileUrl
notify source (baseUrl </> key)      -- Use whichever actual appropriate combinator
hClose source


# Security

You might receive an infinite stream of junk data, filling up your disk (if it doesn't first exhaust your memory due to mishandling of lazy IO).

Misbehaving clients might connect and then squat on the connection, not sending anything or closing the pipe, depriving your server of resources.

Depending on how you serve the files you receive, there's currently nothing to prevent you from re-serving e.g. a binary executable from a malicious uploader. You then become a file dump, and attract all sorts of nefarious users.

File hosting is tricky.

# Other Libraries

For resource handling with strict upper bounds and more friendly interfaces, you might want to check out pipes, pipes-bytestring and network-simple.

For web frameworks, there's ample choice these days. I use servant in my daily work.

# Miscellania

In loop, liftM opts get is just gets opts on StateTs.

In saveToDisk, intercalate "\n" is the same thing as unlines.

In currentTimeSeconds, use <$> which is an infix synonym for fmap. If you're using a recent version of GHC it should already be available in the Prelude. If not, import Data.Functor. • Woa. This answer was really helpful. I have learned a lot just by pushing the changes through. Thanks for the pointers. The network-simple library seems to offer some stuff to limit the upload size as well. Thanks for everything! :) Jul 5, 2016 at 13:03 If you used lens, randId would be zoom rnd$ base36 <$> StateT random Using Control.Monad.Loops, eatData hdl [] is untilM (hGetLine handle) (hIsEOF handle), except that the list is the right way round. Replacing loop s with forever$ loop s allows you to remove the last line, and thus the recursion, in loop's definition.

Prepending void \$ to withSocketsDo allows you to remove the return ().

getStdGen skips getting system time.

Control.Monad.Random's MonadRandom allows you to require ability to generate random numbers in exactly the upwards call hierarchy of randId if you use mtl-style type signatures. You won't even need to specify that it is actually provided by IO (except in main), giving type level gurantees that you aren't using IO except for random numbers. Then you can wholly reduce Data to Opts.