sws 0.3.1.2 → 0.4.0.0
raw patch · 4 files changed
+78/−52 lines, 4 filesdep +cryptonitedep −asn1-encodingdep −asn1-typesdep −crypto-pubkeydep ~basedep ~bytestringdep ~directory
Dependencies added: cryptonite
Dependencies removed: asn1-encoding, asn1-types, crypto-pubkey, crypto-random, pem, x509
Dependency ranges changed: base, bytestring, directory, filepath, hourglass, http-types, network, resourcet, transformers, wai, wai-extra, wai-middleware-static, warp, warp-tls
Files
- CHANGELOG.md +6/−0
- Main.hs +37/−29
- README.md +2/−1
- sws.cabal +33/−22
CHANGELOG.md view
@@ -1,6 +1,12 @@ # Change Log All notable changes to this project will be documented in this file. +## 0.4.0.0 - 2017-09-10+### Changed+- Upper bound bumps.+### Removed+- TLS certificate generation. The functionality was removed from the crypto library this depends upon.+ ## 0.3.1.2 - 2015-08-25 ### Changed - Upper bound bumps.
Main.hs view
@@ -16,7 +16,7 @@ import System.Console.GetOpt ( getOpt, usageInfo, OptDescr(..), ArgDescr(..), ArgOrder(..) ) -- base import System.Directory ( getDirectoryContents, doesDirectoryExist, getModificationTime, copyFile ) -- directory import System.Environment ( getArgs ) -- base-import System.FilePath ( (</>) ) -- filepath+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@@ -32,22 +32,24 @@ import Network.Wai.Middleware.Static ( staticPolicy, addBase, isNotAbsolute, noDots, Policy, tryPolicy ) -- wai-middleware-static import Network.Wai.Parse ( tempFileBackEnd, parseRequestBody, fileName, fileContent ) -- wai-extra +import Crypto.Random ( getSystemDRG, randomBytesGenerate, SystemDRG ) -- cryptonite+ -- For certificate generation.-import Crypto.PubKey.RSA ( generate ) -- crypto-pubkey-import Crypto.PubKey.RSA.PKCS15 ( sign ) -- crypto-pubkey-import Crypto.PubKey.HashDescr ( hashDescrSHA256 ) -- crypto-pubkey-import Crypto.Random ( EntropyPool, createEntropyPool, cprgCreate, cprgGenerate, SystemRNG ) -- crypto-random-import Data.ASN1.OID ( getObjectID ) -- asn1-types-import Data.ASN1.Types ( toASN1, {- for work-around -} ASN1Object ) -- asn1-types-import Data.ASN1.BinaryEncoding ( DER(DER) ) -- asn1-encoding-import Data.ASN1.Encoding ( encodeASN1' ) -- asn1-encoding-import qualified Data.PEM as PEM -- pem-import qualified Data.X509 as X509 -- x509+-- import Crypto.PubKey.RSA ( generate ) -- crypto-pubkey+-- import Crypto.PubKey.RSA.PKCS15 ( sign ) -- crypto-pubkey+-- import Crypto.PubKey.HashDescr ( hashDescrSHA256 ) -- crypto-pubkey+-- import Data.ASN1.OID ( getObjectID ) -- asn1-types+-- import Data.ASN1.Types ( toASN1, {- for work-around -} ASN1Object ) -- asn1-types+-- import Data.ASN1.BinaryEncoding ( DER(DER) ) -- asn1-encoding+-- import Data.ASN1.Encoding ( encodeASN1' ) -- asn1-encoding+-- import qualified Data.PEM as PEM -- pem+-- import qualified Data.X509 as X509 -- x509 import qualified Data.Hourglass as HG -- hourglass import qualified System.Hourglass as HG -- hourglass+ -- for work-around-import Data.ASN1.Types ( ASN1(..), ASN1ConstructionType(..), ASN1TimeType(..) )-import Data.ASN1.Types.Lowlevel ( ASN1Class(..) )+-- import Data.ASN1.Types ( ASN1(..), ASN1ConstructionType(..), ASN1TimeType(..) )+-- import Data.ASN1.Types.Lowlevel ( ASN1Class(..) ) -- For STUN import Control.Concurrent ( forkIO, threadDelay ) -- base@@ -61,7 +63,7 @@ -- Not future things: CGI etc of any sort, "extensibility" -- vERSION :: String-vERSION = "0.3.1.2"+vERSION = "0.4.0.0" -- STUN code @@ -109,6 +111,7 @@ certExpiryInDays :: Int64 certExpiryInDays = 30 +{- -- Temporary work-around for bug in x509. newtype CertificateWorkaround = CW X509.Certificate deriving ( Eq, Show )@@ -131,12 +134,14 @@ instance ASN1Object CertificateWorkaround where toASN1 (CW cert) = (encodeCertificateHeader cert ++) -- End work-around code+-} -generateCert :: Options -> HG.DateTime -> SystemRNG -> (Warp.TLSSettings, SystemRNG)+{-+generateCert :: Options -> HG.DateTime -> SystemDRG -> (Warp.TLSSettings, SystemDRG) generateCert opts now g = ((Warp.tlsSettingsMemory (PEM.pemWriteBS pemCert) (PEM.pemWriteBS pemKey)) { Warp.onInsecure = Warp.DenyInsecure (fromString "Use HTTPS") }, g'') where later = HG.timeAdd now (HG.Hours (24*certExpiryInDays))- (bs, g') = cprgGenerate 8 g -- generate 8 random bytes for the serial number+ (bs, g') = randomBytesGenerate 8 g -- generate 8 random bytes for the serial number ((pk, sk), g'') = generate g' rsaSizeInBytes rsaPublicExponent serialNum = BS.foldl' (\a w -> a*256 + fromIntegral w) 0 bs cn = getObjectID X509.DnCommonName@@ -158,6 +163,7 @@ keyBytes = encodeASN1' DER (toASN1 sk []) pemCert = PEM.PEM (fromString "CERTIFICATE") [] certBytes -- This is a mite silly. Wrap in PEM just to immediately unwrap... pemKey = PEM.PEM (fromString "RSA PRIVATE KEY") [] keyBytes+-} -- File upload @@ -192,7 +198,7 @@ fileDetails label f = liftA2 (renderFile label f) (doesDirectoryExist f) (getModificationTime f) `catchIOError` \_ -> return (fromString "") renderFile label path isDirectory modTime = LBS.concat $ map fromString [- "<tr><td>", if isDirectory then "d" else "f", "</td><td><a href=\"/", path, "\">", label, "</a></td><td>", show modTime, "</td></tr>"+ "<tr><td>", if isDirectory then "d" else "f", "</td><td><a href=\"/", makeRelative baseDir path, "\">", label, "</a></td><td>", show modTime, "</td></tr>" ] container xs = 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;}form { display: " ++ (if allowWrites then "inherit" else "none") ++ ";}</style></head><body><div class=\"list\"><table><tr><td></td><td>Name</td><td>Last Modified</td></tr>")@@ -246,7 +252,7 @@ optRealm = "", optUserName = fromString "guest", optPassword = BS.empty,- optHTTPS = True,+ optHTTPS = False, --True, optHost = "localhost", optCertificate = "", optKeyFile = "",@@ -286,15 +292,17 @@ "Require the given password. (Default: generated)", 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 "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 }) "FILE")+ 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 }) "FILE")+ 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."@@ -340,8 +348,8 @@ serve (Options { optHelp = True }) _ = putStrLn $ usageInfo usageHeader options serve opts dir = do now <- HG.dateCurrent- g <- fmap cprgCreate createEntropyPool- let (prePW, g') = cprgGenerate 8 g -- generate 8 random bytes for the password if needed+ g <- getSystemDRG + let (prePW, g') = randomBytesGenerate 8 g -- generate 8 random bytes for the password if needed 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@@ -384,15 +392,15 @@ $ app404 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- putStrLn "Generating a self-signed certificate. Use --no-https to disable HTTPS."- 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+ -- | optHTTPS opts = \app -> do+ -- when (not $ optQuiet opts) $ do+ -- putStrLn "Generating a self-signed certificate. Use --no-https to disable HTTPS."+ -- 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") } - (tlsMemSettings, _) = generateCert opts now g+ Warp.onInsecure = Warp.DenyInsecure (fromString "Use HTTPS") } + -- (tlsMemSettings, _) = generateCert opts now g certProvided = not (null (optCertificate opts)) && not (null (optKeyFile opts)) policy = basePolicy <> addBase dir
README.md view
@@ -9,7 +9,8 @@ main goals. It has no config files, and only a few, if any, easily provided command line parameters should be necessary. If convenience and security conflict, I'm willing to sacrifice a little convenience for security, but only a little. Often such conflicts are largely resolvable. For example, requiring a password and using TLS improve security, but-making a password or a certificate are inconvenient, so `sws` can generate these.+making a password or a certificate are inconvenient, so `sws` can generate these. *Currently, support for generating+a certificate is removed.* ### Use-case 1: xkcd scenario
sws.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.3.1.2+version: 0.4.0.0 -- A short (one-line) description of the package. synopsis: A simple web server for serving directories, similar to weborf.@@ -36,7 +36,7 @@ maintainer: derek.a.elkins@gmail.com -- A copyright notice.-copyright: Copyright (c) 2014-2015 Derek Elkins+copyright: Copyright (c) 2014-2017 Derek Elkins category: Web @@ -65,27 +65,38 @@ -- other-extensions: -- Other library packages from which modules are imported.+ -- build-depends: + -- base >=4.6 && <4.10,+ -- bytestring(==0.10.*), + -- cryptonite(==0.24.*),+ -- directory(==1.3.*), + -- filepath >=1.3 && <1.5, + -- http-types(==0.9.*), + -- hourglass(==0.2.*),+ -- network(==2.6.*),+ -- resourcet(==1.1.*),+ -- transformers(==0.5.*),+ -- warp >=3.0 && <3.3,+ -- warp-tls >=3.0.1.2 && <3.3, + -- wai >=3.0 && <3.3,+ -- wai-middleware-static >=0.6 && <0.9, + -- wai-extra >=3.0.3 && <3.1 build-depends: - asn1-types(==0.3.*),- asn1-encoding(==0.9.*),- base >=4.6 && <4.9,- bytestring(==0.10.*), - crypto-pubkey(==0.2.*),- crypto-random(==0.0.*),- directory(==1.2.*), - filepath >=1.3 && <1.5, - http-types(==0.8.*), - hourglass(==0.2.*),- network(==2.6.*),- pem(==0.2.*),- resourcet(==1.1.*),- transformers(==0.4.*),- warp >=3.0 && <3.2,- warp-tls >=3.0.1.2 && <3.2, - wai(==3.0.*),- wai-middleware-static >=0.6 && <0.8, - wai-extra >=3.0.3 && <3.1,- x509(==1.5.*)+ base >= 4.9.1 && < 4.10,+ bytestring >= 0.10.8 && < 0.11,+ cryptonite >= 0.24 && < 0.25,+ directory >= 1.3.0 && < 1.4,+ filepath >= 1.4.1 && < 1.5,+ hourglass >= 0.2.10 && < 0.3,+ http-types >= 0.9.1 && < 0.10,+ network >= 2.6.3 && < 2.7,+ resourcet >= 1.1.9 && < 1.2,+ transformers >= 0.5.2 && < 0.6,+ wai >= 3.2.1 && < 3.3,+ wai-extra >= 3.0.20 && < 3.1,+ wai-middleware-static >= 0.8.1 && < 0.9,+ warp >= 3.2.13 && < 3.3,+ warp-tls >= 3.2.4 && < 3.3 -- Directories containing source files. -- hs-source-dirs: