packages feed

sws 0.4.0.1 → 0.4.1.0

raw patch · 4 files changed

+161/−97 lines, 4 files

Files

CHANGELOG.md view
@@ -1,6 +1,12 @@ # Change Log All notable changes to this project will be documented in this file. +## 0.4.1.0 - 2018-02-14+### Added+- Upload only mode.+- Options to control STUN.+- Options to control what happens when a file is uploaded which already exists.+ ## 0.4.0.0 - 2017-09-10 ### Changed - Upper bound bumps.
Main.hs view
@@ -14,12 +14,12 @@ import Data.Monoid ( (<>) ) -- base import Data.String ( fromString ) -- base import System.Console.GetOpt ( getOpt, usageInfo, OptDescr(..), ArgDescr(..), ArgOrder(..) ) -- base-import System.Directory ( getDirectoryContents, doesDirectoryExist, getModificationTime, copyFile  ) -- directory+import System.Directory ( getDirectoryContents, doesDirectoryExist, getModificationTime, copyFile, doesFileExist ) -- directory import System.Environment ( getArgs ) -- base-import System.FilePath ( makeRelative, (</>) ) -- filepath-import System.IO ( putStrLn, hPutStrLn, hPutStr, stderr ) -- base-import System.IO.Error ( catchIOError ) -- base-import Network.HTTP.Types.Status ( status200, status403, status404 ) -- http-types+import System.FilePath ( makeRelative, (</>), takeDirectory, takeFileName ) -- filepath+import System.IO ( putStrLn, hPutStrLn, hPutStr, stderr, hClose, openBinaryTempFileWithDefaultPermissions ) -- base+import System.IO.Error ( userError, ioError, catchIOError, isUserError, ioeGetErrorString ) -- base+import Network.HTTP.Types.Status ( status200, status403, status404, status409 ) -- http-types import Network.HTTP.Types.Method ( methodPost ) -- http-types import Network.Wai ( Application, Middleware, requestMethod, rawPathInfo, responseLBS ) -- wai import qualified Network.Wai.Handler.Warp as Warp -- warp@@ -63,43 +63,37 @@ -- Not future things: CGI etc of any sort, "extensibility" -- vERSION :: String-vERSION = "0.4.0.0"+vERSION = "0.4.1.0"  -- STUN code --- TODO: Make these parameters.-stunHost :: String-stunHost = "stun.l.google.com"--stunPort :: Net.PortNumber-stunPort = 19302 -- Usually 3478+sendStun :: Options -> [Word8] -> Net.Socket -> IO ()+sendStun opts tId s = do -- TODO: Perhaps add check that length tId == 12+    [stunAddr] <- fmap (take 1 . hostAddresses) (getHostByName (optStunHost opts)) -- TODO: maybe have an option to list all addresses+    Net.sendTo s bytes (Net.SockAddrInet (optStunPort opts) stunAddr) >> return ()+  where bytes = BS.pack ([0x00, 0x01, 0x00, 0x00, -- Type Binding, Size 0+                          0x21, 0x12, 0xA4, 0x42] -- Magic Cookie+                         ++ tId) -- Transaction ID (should be cryptographically random and unique) -sendStun :: Net.Socket -> IO ()-sendStun s = do-    [stunAddr] <- fmap (take 1 . hostAddresses) (getHostByName stunHost) -- TODO: maybe have an option to list all addresses-    Net.sendTo s bytes (Net.SockAddrInet stunPort stunAddr) >> return ()-  where bytes = BS.pack [0x00, 0x01, 0x00, 0x00, -- Type Binding, Size 0-                         0x21, 0x12, 0xA4, 0x42, -- Magic Cookie-                         0x00, 0x00, 0x00, 0x00, -- Transaction ID (should be cryptographically random-                         0x00, 0x00, 0x00, 0x00, -- and unique, but who cares?)-                         0x00, 0x00, 0x00, 0x00]-    -recvStun :: Net.Socket -> IO [Word8]-recvStun s = do -- Assuming successful XOR-MAPPED-ADDRESS response.  See RFC5389. TODO: Don't assume so much.+recvStun :: [Word8] -> Net.Socket -> IO [Word8]+recvStun tId s = do -- Assuming successful XOR-MAPPED-ADDRESS response.  See RFC5389. TODO: Don't assume so much.     (bytes, addr) <- Net.recvFrom s 576+    -- TODO: Check for error, then, if successful, check for XOR-MAPPED-ADDRESS response type and appropriate length.+    let tId' = BS.unpack $ BS.take 12 $ BS.drop 8 bytes+    when (tId /= tId') $ ioError (userError "Mismatched Transaction ID in STUN response.")     let [b0, b1, b2, b3] = BS.unpack $ BS.drop 28 bytes     return [b0 `xor` 0x21, b1 `xor` 0x12, b2 `xor` 0xA4, b3 `xor` 0x42]-    -doStun :: IO (Maybe [Word8]) -- TODO: add bracket-doStun = do++doStun :: Options -> [Word8] -> IO (Maybe [Word8]) -- TODO: add bracket+doStun opts tId = do     s <- Net.socket Net.AF_INET Net.Datagram Net.defaultProtocol     v <- newEmptyMVar-    forkIO (recvStun s >>= putMVar v)-    sendStun s+    forkIO (recvStun tId s >>= putMVar v)+    sendStun opts tId s     threadDelay 1000000 -- wait a second     Net.close s     tryTakeMVar v-    + -- Certificate generation code  rsaPublicExponent :: Integer@@ -153,7 +147,7 @@                   X509.certSerial = serialNum,                   X509.certSignatureAlg = sigAlg,                   X509.certIssuerDN = dn,-                  X509.certValidity = (HG.timeAdd now (HG.Hours (-24)), later), +                  X509.certValidity = (HG.timeAdd now (HG.Hours (-24)), later),                   X509.certSubjectDN = dn,                   X509.certPubKey = X509.PubKeyRSA pk,                   X509.certExtensions = X509.Extensions Nothing@@ -167,22 +161,43 @@  -- File upload -update :: Options -> Policy -> Middleware-update opts policy app req k = do-    when (requestMethod req == methodPost) $ do+update :: Options -> Policy -> (String -> String -> IO ()) -> Middleware+update opts policy copyFileFn app req k = do+    if requestMethod req == methodPost then (do         runResourceT $ do             (_, fs) <- withInternalState (\s -> parseRequestBody (tempFileBackEnd s) req)-            let fs' = map (tryPolicy policy . CBS.unpack . BS.tail . ((rawPathInfo req <> fromString "/") <>) . fileName . snd) fs-            let prefix = CBS.unpack (BS.tail (rawPathInfo req))+            -- If UploadOnly then ignore the path part of the URL, i.e. only write the file to the base directory.+            let prefix = if optUploadOnly opts then "" else CBS.unpack (BS.tail (rawPathInfo req))+            liftIO $ when (optVerbose opts) $ putStrLn (CBS.unpack (BS.tail (rawPathInfo req)))             liftIO $ forM_ fs $ \(_, f) ->                 case tryPolicy policy (prefix </> CBS.unpack (fileName f)) of                     Nothing -> return ()                     Just tgt -> do                         let src = fileContent f                         when (optVerbose opts) $ putStrLn ("Saving " ++ src ++ " to " ++ tgt)-                        copyFile src tgt-    app req k -- We execute the next Application regardless so that we return a listing after the POST completes.+                        copyFileFn src tgt+        app req k) -- We execute the next Application regardless so that we return a listing after the POST completes.+          `catchIOError` \e -> if isUserError e then k (responseLBS status409 [] (LBS.fromChunks [CBS.pack $ ioeGetErrorString e])) else ioError e+      else+        app req k +overwriteFile :: String -> String -> IO ()+overwriteFile = copyFile++errorOnOverwriteFile :: String -> String -> IO ()+errorOnOverwriteFile src tgt = do -- TODO: This has a race condition.+    exists <- doesFileExist tgt+    if exists then do+        ioError $ userError "Attempting to overwrite an existing file."+      else do+        copyFile src tgt++renameOnOverwriteFile :: String -> String -> IO ()+renameOnOverwriteFile src tgt = do+    (tgt, h) <- openBinaryTempFileWithDefaultPermissions (takeDirectory tgt) (takeFileName tgt)+    hClose h+    copyFile src tgt+ -- Directory listing  -- TODO: Make this less fugly.@@ -205,38 +220,67 @@              <> LBS.concat xs              <> fromString ("</table></div><form enctype=\"multipart/form-data\" method=\"post\" action=\"\">File: <input type=\"file\" name=\"file\" required=\"required\" multiple=\"multiple\"><input type=\"submit\" value=\"Upload\"></form><div class=\"foot\">sws" ++ vERSION ++ "</div></body></html>") +uploadForm :: Options -> Policy -> Middleware+uploadForm opts policy app req k = do+    when (optVerbose opts) $ putStrLn $ "Rendering upload form"+    k (responseLBS status200 [] html)+  where html = fromString ("<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\"><html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\"><head><meta charset=\"utf-8\"><title>sws</title><style type=\"text/css\">a, a:active {text-decoration: none; color: blue;}a:visited {color: #48468F;}a:hover, a:focus {text-decoration: underline; color: red;}body {background-color: #F5F5F5;}h2 {margin-bottom: 12px;}table {margin-left: 12px;}th, td { font: 90% monospace; text-align: left;}th { font-weight: bold; padding-right: 14px; padding-bottom: 3px;}td {padding-right: 14px;}td.s, th.s {text-align: right;}div.list { background-color: white; border-top: 1px solid #646464; border-bottom: 1px solid #646464; padding-top: 10px; padding-bottom: 14px;}div.foot { font: 90% monospace; color: #787878; padding-top: 4px;}</style></head><body><form enctype=\"multipart/form-data\" method=\"post\" action=\"\">File: <input type=\"file\" name=\"file\" required=\"required\" multiple=\"multiple\"><input type=\"submit\" value=\"Upload\"></form><div class=\"foot\">sws" ++ vERSION ++ "</div></body></html>")+ -- Option handling +data OverwriteOption = Overwrite | ErrorOnOverwrite | RenameOnOverwrite++instance Show OverwriteOption where+    show Overwrite = "allow"+    show ErrorOnOverwrite = "error"+    show RenameOnOverwrite = "rename"++instance Read OverwriteOption where+    readsPrec _ ('a':'l':'l':'o':'w':s) = [(Overwrite, s)]+    readsPrec _ ('e':'r':'r':'o':'r':s) = [(ErrorOnOverwrite, s)]+    readsPrec _ ('r':'e':'n':'a':'m':'e':s) = [(RenameOnOverwrite, s)]+    readsPrec _ _ = []++overwritePolicy :: OverwriteOption -> String -> String -> IO ()+overwritePolicy Overwrite = overwriteFile+overwritePolicy ErrorOnOverwrite = errorOnOverwriteFile+overwritePolicy RenameOnOverwrite = renameOnOverwriteFile+ data Options = Options {-    optPort :: Int,+    optPort :: !Int, -    optHelp :: Bool,-    optVerbose :: Bool,-    optQuiet :: Bool,+    optHelp :: !Bool,+    optVerbose :: !Bool,+    optQuiet :: !Bool, -    optCompress :: Bool,+    optCompress :: !Bool, -    optDirectoryListings :: Bool,+    optDirectoryListings :: !Bool, -    optLocalOnly :: Bool,+    optLocalOnly :: !Bool, -    optGetIP :: Bool,+    optGetIP :: !Bool,+    optStunHost :: !String,+    optStunPort :: !Net.PortNumber, -    optHeaders :: [String], +    optHeaders :: ![String],      -- Basic authentication options-    optAuthentication :: Bool,-    optRealm :: String,-    optUserName :: BS.ByteString, -- some default could be chosen-    optPassword :: BS.ByteString, -- maybe we could generate and display one rather than requiring this+    optAuthentication :: !Bool,+    optRealm :: !String,+    optUserName :: !BS.ByteString, -- some default could be chosen+    optPassword :: !BS.ByteString, -- maybe we could generate and display one rather than requiring this      -- HTTPS options-    optHTTPS :: Bool,-    optHost :: String,-    optCertificate :: FilePath,-    optKeyFile :: FilePath,-    optAllowUploads :: Bool }+    optHTTPS :: !Bool,+    optHost :: !String,+    optCertificate :: !FilePath,+    optKeyFile :: !FilePath, +    optAllowUploads :: !Bool,+    optUploadOnly :: !Bool,+    optOverwriteOption :: !OverwriteOption}+ defOptions :: Options defOptions = Options {     optPort = 3000,@@ -247,65 +291,78 @@     optDirectoryListings = True,     optLocalOnly = False,     optGetIP = True,+    optStunHost = "stun.l.google.com",+    optStunPort = 19302 ,     optHeaders = [],     optAuthentication = True,     optRealm = "",     optUserName = fromString "guest",     optPassword = BS.empty,     optHTTPS = False, --True,-    optHost = "localhost", +    optHost = "localhost",     optCertificate = "",     optKeyFile = "",-    optAllowUploads = False }+    optAllowUploads = False,+    optUploadOnly = False,+    optOverwriteOption = ErrorOnOverwrite}  options :: [OptDescr (Options -> Options)] options = [-    Option "p" ["port"] (ReqArg (\p opt -> opt { optPort = read p }) "NUM") +    Option "p" ["port"] (ReqArg (\p opt -> opt { optPort = read p }) "NUM")         ("Port to listen on. (Default: " ++ (show $ optPort defOptions) ++ ")"),-    Option "h?" ["help", "version"] (NoArg (\opt -> opt { optHelp = True })) +    Option "h?" ["help", "version"] (NoArg (\opt -> opt { optHelp = True }))         "Print usage.",-    Option "V" ["verbose"] (NoArg (\opt -> opt { optVerbose = True })) +    Option "V" ["verbose"] (NoArg (\opt -> opt { optVerbose = True }))         "Print diagnostic output.",-    Option "q" ["quiet"] (NoArg (\opt -> opt { optQuiet = True })) +    Option "q" ["quiet"] (NoArg (\opt -> opt { optQuiet = True }))         "Only output access log information.",-    Option "l" ["local"] (NoArg (\opt -> opt { optLocalOnly = True })) +    Option "l" ["local"] (NoArg (\opt -> opt { optLocalOnly = True }))         "Only accept connections from localhost.",-    Option "" ["no-stun"] (NoArg (\opt -> opt { optGetIP = False })) +    Option "" ["no-stun"] (NoArg (\opt -> opt { optGetIP = False }))         "Don't attempt to get the public IP via STUN.",-    Option "d" ["dev-mode"] (NoArg (\opt -> opt { optGetIP = False, optLocalOnly = True, optAuthentication = False, optHTTPS = False })) +    Option "" ["stun-host"] (ReqArg (\h opt -> opt { optStunHost = h }) "URL")+        ("Stun host. (Default: \"" ++ optStunHost defOptions ++ "\")"),+    Option "" ["stun-port"] (ReqArg (\p opt -> opt { optStunPort = read p }) "PORT")+        ("Stun port. Usually 3478. (Default: " ++ show (optStunPort defOptions) ++ ")"),+    Option "d" ["dev-mode"] (NoArg (\opt -> opt { optGetIP = False, optLocalOnly = True, optAuthentication = False, optHTTPS = False }))         "Equivalent to --local --no-auth --no-https --no-stun.",-    Option "P" ["public"] (NoArg (\opt -> opt { optAuthentication = False, optHTTPS = False })) +    Option "P" ["public"] (NoArg (\opt -> opt { optAuthentication = False, optHTTPS = False }))         "Equivalent to --no-auth --no-https.",     Option "X" [] (ReqArg (\h opt -> opt { optHeaders = h : optHeaders opt }) "HEADER")         "Add HEADER to all server responses.",-    Option "z" ["gzip", "compress"] (NoArg (\opt -> opt { optCompress = True })) +    Option "z" ["gzip", "compress"] (NoArg (\opt -> opt { optCompress = True }))         "Enable compression. (Default)",-    Option "" ["no-compress"] (NoArg (\opt -> opt { optCompress = False })) +    Option "" ["no-compress"] (NoArg (\opt -> opt { optCompress = False }))         "Disable compression.",-    Option "" ["no-listings"] (NoArg (\opt -> opt { optDirectoryListings = False })) +    Option "" ["no-listings"] (NoArg (\opt -> opt { optDirectoryListings = False }))         "Don't list directory contents.",-    Option "" ["no-auth"] (NoArg (\opt -> opt { optAuthentication = False })) +    Option "" ["no-auth"] (NoArg (\opt -> opt { optAuthentication = False }))         "Don't require a password.",-    Option "r" ["realm"] (ReqArg (\r opt -> opt { optRealm = r }) "REALM") +    Option "r" ["realm"] (ReqArg (\r opt -> opt { optRealm = r }) "REALM")         "Set the authentication realm. (Default: \"\")",-    Option "" ["password"] (ReqArg (\pw opt -> opt { optPassword = fromString pw }) "PASSWORD") +    Option "" ["password"] (ReqArg (\pw opt -> opt { optPassword = fromString pw }) "PASSWORD")         "Require the given password. (Default: generated)",-    Option "u" ["username"] (ReqArg (\u opt -> opt { optUserName = fromString u }) "USERNAME") +    Option "u" ["username"] (ReqArg (\u opt -> opt { optUserName = fromString u }) "USERNAME")         ("Require the given username. (Default: " ++ show (optUserName defOptions)  ++ ")"),     {--    Option "s" ["secure"] (NoArg (\opt -> opt { optHTTPS = True })) -        "Enable HTTPS. (Default)", -    Option "" ["no-https"] (NoArg (\opt -> opt { optHTTPS = False })) -        "Disable HTTPS.", +    Option "s" ["secure"] (NoArg (\opt -> opt { optHTTPS = True }))+        "Enable HTTPS. (Default)",+    Option "" ["no-https"] (NoArg (\opt -> opt { optHTTPS = False }))+        "Disable HTTPS.",     -}-    Option "H" ["host"] (ReqArg (\host opt -> opt { optHost = host }) "HOST") +    Option "H" ["host"] (ReqArg (\host opt -> opt { optHost = host }) "HOST")         ("Host name to use for generated certificate. (Default: " ++ show (optHost defOptions) ++ ")"),     Option "" ["certificate"] (ReqArg (\f opt -> opt { optCertificate = f, optHTTPS = True }) "FILE")         "The path to the server certificate.",     Option "" ["key-file"] (ReqArg (\f opt -> opt { optKeyFile = f, optHTTPS = True }) "FILE")         "The path to the private key for the certificate.",     Option "w" ["allow-uploads", "writable"] (NoArg (\opt -> opt { optAllowUploads = True }))-        "Allow files to be uploaded."+        "Allow files to be uploaded.",+    Option "U" ["upload-only"] (NoArg (\opt -> opt { optUploadOnly = True }))+        "Only serve an upload form and do not serve any files.",+    Option "" ["overwrite"] (ReqArg (\overwriteOption opt -> opt { optOverwriteOption = read overwriteOption })+                                    (show Overwrite++","++show ErrorOnOverwrite++","++show RenameOnOverwrite))+        ("Policy when uploaded file name conflicts with existing file name. (Default: \"" ++ show (optOverwriteOption defOptions) ++ "\")")  ]  -- TODO: KeyFile w/o Certificate and vice-versa, KeyFile/Certificate without HTTPS,@@ -328,7 +385,7 @@ app404 req k = k (responseLBS status404 [] (fromString "File Not Found"))  explodeHostAddress :: Net.HostAddress -> [Word8]-explodeHostAddress h = [fromIntegral h, +explodeHostAddress h = [fromIntegral h,                         fromIntegral (h `unsafeShiftR` 8),                         fromIntegral (h `unsafeShiftR` 16),                         fromIntegral (h `unsafeShiftR` 24)]@@ -342,21 +399,22 @@ base32Encode = let table = fromString "0123456789abcdefghijklmnopqrstuv"                    go i | i == 0 = Nothing                         | otherwise = Just (BS.index table (fromIntegral (i .&. 0x1F)), i `unsafeShiftR` 5)-    in \bs -> fst $ BS.unfoldrN 13 go $ BS.foldl' (\a w -> a*256 + fromIntegral w) (0 :: Integer) bs +    in \bs -> fst $ BS.unfoldrN 13 go $ BS.foldl' (\a w -> a*256 + fromIntegral w) (0 :: Integer) bs  serve :: Options -> String -> IO () serve (Options { optHelp = True }) _ = putStrLn $ usageInfo usageHeader options serve opts dir = do     now <- HG.dateCurrent-    g <- getSystemDRG +    g <- getSystemDRG     let (prePW, g') = randomBytesGenerate 8 g -- generate 8 random bytes for the password if needed+        (stunTID, g'') = randomBytesGenerate 12 g' -- generate 12 random bytes for STUN Transaction ID         pw = if not (BS.null (optPassword opts)) then optPassword opts else base32Encode prePW         headers = map ((\(x,y) -> (x, BS.drop 2 y)) . BS.breakSubstring (fromString ": ") . fromString) (optHeaders opts)     case validateOptions opts of         Just err -> hPutStrLn stderr err         Nothing -> do             when (not $ optQuiet opts) $ do-                putStr "Private Address: " +                putStr "Private Address: "                 if optLocalOnly opts then do                     putStrLn (prettyAddress (optHTTPS opts) [127,0,0,1] (optPort opts))                   else do@@ -365,11 +423,11 @@                     forM_ addrs $ \ip -> putStrLn (prettyAddress (optHTTPS opts) (explodeHostAddress ip) (optPort opts))                  when (optGetIP opts && not (optLocalOnly opts)) $ do-                    mip <- doStun +                    mip <- doStun opts (BS.unpack stunTID)                     case mip of-                        Nothing -> hPutStrLn stderr "Finding public IP failed." -                        Just ip -> do -                            putStr "Public Address: " +                        Nothing -> hPutStrLn stderr "Finding public IP failed."+                        Just ip -> do+                            putStr "Public Address: "                             putStrLn (prettyAddress (optHTTPS opts) ip (optPort opts))                  when (optAuthentication opts && not (BS.null (optUserName opts))) $@@ -378,19 +436,19 @@                     putStrLn $ "Generated password is: " ++ CBS.unpack pw                     putStrLn "Use --no-auth if password protection is not desired." -            runner now g'+            runner now g''                 $ enableIf (optVerbose opts) logStdout                 $ enableIf (optLocalOnly opts) (local (responseLBS status403 [] LBS.empty))-                $ enableIf (optAuthentication opts) -                    (basicAuth (\u p -> return $ optUserName opts == u && pw == p) +                $ enableIf (optAuthentication opts)+                    (basicAuth (\u p -> return $ optUserName opts == u && pw == p)                                (fromString $ optRealm opts))                 $ enableIf (optCompress opts) (gzip def { gzipFiles = GzipCompress })                 $ enableIf (not (null headers)) (addHeaders headers)-                $ enableIf (optAllowUploads opts) (update opts policy)-                $ staticPolicy policy +                $ enableIf (optAllowUploads opts || optUploadOnly opts) (update opts policy (overwritePolicy (optOverwriteOption opts)))+                $ (if optUploadOnly opts then uploadForm opts policy else staticPolicy policy)                 $ enableIf (optDirectoryListings opts) (directoryListing opts dir)                 $ app404-  where runner now g | optHTTPS opts && certProvided +  where runner now g | optHTTPS opts && certProvided                         = Warp.runTLS tlsFileSettings (Warp.setPort (optPort opts) Warp.defaultSettings)                      -- | optHTTPS opts = \app -> do                      --    when (not $ optQuiet opts) $ do@@ -398,8 +456,8 @@                      --        putStrLn "Users will get warnings and will be vulnerable to man-in-the-middle attacks."                      --    Warp.runTLS tlsMemSettings (Warp.setPort (optPort opts) Warp.defaultSettings) app                      | otherwise = Warp.run (optPort opts)-            where tlsFileSettings = (Warp.tlsSettings (optCertificate opts) (optKeyFile opts)) { -                        Warp.onInsecure = Warp.DenyInsecure (fromString "Use HTTPS") } +            where tlsFileSettings = (Warp.tlsSettings (optCertificate opts) (optKeyFile opts)) {+                        Warp.onInsecure = Warp.DenyInsecure (fromString "Use HTTPS") }                   -- (tlsMemSettings, _) = generateCert opts now g                   certProvided = not (null (optCertificate opts)) && not (null (optKeyFile opts)) 
README.md view
@@ -16,7 +16,7 @@      You want to send a large file to someone.  You browse to the directory containing it, type "`sws`", and give them your public IP.  They browse to it and download.  Maybe they are the ones sending the file, but aren't "technical".-You browse to an empty directory, type "`sws -w`", and give them your public IP.  They browse to it and upload.+You browse to an empty directory, type "`sws -w`" or "`sws -U`", and give them your public IP.  They browse to it and upload.  In reality, you need to figure out what your public IP is and open a port in your firewall.  `sws` will currently use Google's STUN server to attempt to figure out your public IP.
sws.cabal view
@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.4.0.1+version:             0.4.1.0  -- A short (one-line) description of the package. synopsis:            A simple web server for serving directories, similar to weborf.