summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2019-02-16 10:41:13 +0300
committerdefanor <defanor@uberspace.net>2019-02-16 10:41:13 +0300
commit3c00d9f42a26808c6c1763f93f78371b318c5b06 (patch)
treec78bf463b0bbc58ce1514f7ee598fbf6b52c1276
parentd13259f1d4d78a4fd5c5873275416516d6e7d65b (diff)
downloadpgxhtml-3c00d9f42a26808c6c1763f93f78371b318c5b06.zip
pgxhtml-3c00d9f42a26808c6c1763f93f78371b318c5b06.tar.gz
pgxhtml-3c00d9f42a26808c6c1763f93f78371b318c5b06.tar.bz2
Request credentials on password-related failures
-rw-r--r--Main.hsc16
-rw-r--r--README.md3
2 files changed, 13 insertions, 6 deletions
diff --git a/Main.hsc b/Main.hsc
index 092fbf7..ea3d50c 100644
--- a/Main.hsc
+++ b/Main.hsc
@@ -253,6 +253,10 @@ respond' code headers content = do
respond :: Int -> BS.ByteString -> IO ()
respond c = respond' c []
+requireAuth :: IO ()
+requireAuth = respond' 401
+ ["WWW-Authenticate:Basic realm=\"Protected area\", charset=\"UTF-8\""]
+ ""
-- * Main routines
@@ -291,7 +295,12 @@ serve xsltDirectory ioc ps = case lookup "q" ps of
errMsg <- maybe [] (\m -> [("message", m)]) <$> errorMessage c
redb 500 $ ("exec_status", BS.pack (show rs)) : errMsg
Nothing -> redb 500 [("message", "Failed to execute the query")]
- _ -> redb 500 [("message", "Database connection failed")]
+ _ -> do
+ pNeeded <- connectionNeedsPassword c
+ pUsed <- connectionUsedPassword c
+ if pNeeded || pUsed
+ then requireAuth
+ else redb 500 [("message", "Database connection failed")]
_ -> respError 418 [("message", "No query is provided")]
where
xsltPath = xsltDirectory </>
@@ -317,8 +326,5 @@ main = do
(Just "on", Just (l, p)) ->
serve xsltDir (connectdb (connString [("user", l), ("password", p)]))
ps
- (Just "on", Nothing) ->
- respond' 401
- ["WWW-Authenticate:Basic realm=\"Protected area\", charset=\"UTF-8\""]
- ""
+ (Just "on", Nothing) -> requireAuth
_ -> serve xsltDir (connectdb "") ps)
diff --git a/README.md b/README.md
index d0ee97e..8be957f 100644
--- a/README.md
+++ b/README.md
@@ -69,7 +69,8 @@ since they are of little use with HTML 5 forms.
Presence of `auth=on` in the URL query requires HTTP basic
authentication, and the provided credentials are used directly for
-PostgreSQL authentication.
+PostgreSQL authentication. HTTP authentication also gets requested if
+a database failure was password-related.
### Web server