Feature/private pages (PR 579 rebased)

data/Help.page

@@ -93,7 +93,7 @@ highlighted in yellow, and deletions will be crossed out with a horizontal
 line.  Clicking on the description of changes will take you to the page
 as it existed after those changes.  To revert the page to the revision
 you're currently looking at, just click the "revert" button at the bottom
-of the page, then "Save". 
+of the page, then "Save".
 
 ## Deleting a page
 
@@ -123,3 +123,11 @@ picture into a (markdown-formatted) page as follows: `![fido](fido.jpg)`.
 If you uploaded a PDF `projection.pdf`, you can insert a link to it
 using:  `[projection](projection.pdf)`.
 
+# Private content
+
+By default, wiki content is accessible to all users, whether authenticated
+or not. However, it is possible to define pages or directories as private.
+In this case, you'll need to be authenticated to access them. Only the
+**content** of files will be inaccessible, the name of these files will
+remain visible in "All pages" or in "Recent activity".
+

data/default.conf

@@ -128,6 +128,13 @@ no-edit: Help
 # specifies pages that cannot be edited through the web interface.
 # Leave blank to allow every page to be edited.
 
+private-pages:
+# specifies a comma-separated list of page paths that are considered
+# private, i.e not accessible for anonymous users. This setting overrides
+# any other require-authentication setting, visitors to private pages must
+# be logged in. Full paths and wildcards are both available, meaning that
+# Dir/Page, Dir/* and */Page will all blacklist the Dir/Page page.
+
 default-summary:
 # specifies text to be used in the change description if the author
 # leaves the "description" field blank.  If default-summary is blank

gitit.cabal

@@ -172,7 +172,8 @@ Library
                      network-uri >= 2.6,
                      network >= 2.6 && < 3.2,
                      network-bsd >= 2.8.1 && < 2.9,
-                     doctemplates >= 0.7.1
+                     doctemplates >= 0.7.1,
+                     Glob >= 0.7.9
   if flag(plugins)
     exposed-modules: Network.Gitit.Interface
     build-depends:   ghc, ghc-paths

src/Network/Gitit.hs

@@ -141,8 +141,9 @@ wiki conf = do
   let staticHandler = withExpiresHeaders $
         serveDirectory' static `mplus` serveDirectory' defaultStatic
   let debugHandler' = msum [debugHandler | debugMode conf]
+  let privatePageHandler = unlessPrivatePage (authenticate ForRead showPage) (authenticate Never showPage)
   let handlers = debugHandler' `mplus` authHandler conf `mplus`
-                 authenticate ForRead (msum wikiHandlers)
+                 privatePageHandler `mplus` (msum wikiHandlers)
   let fs = filestoreFromConfig conf
   let ws = WikiState { wikiConfig = conf, wikiFileStore = fs }
   if compressResponses conf

src/Network/Gitit/Config.hs

@@ -108,6 +108,7 @@ extractConfig cp = do
       cfFrontPage <- get cp "DEFAULT" "front-page"
       cfNoEdit <- get cp "DEFAULT" "no-edit"
       cfNoDelete <- get cp "DEFAULT" "no-delete"
+      cfPrivatePages <- get cp "DEFAULT" "private-pages"
       cfDefaultSummary <- get cp "DEFAULT" "default-summary"
       cfDeleteSummary <- get cp "DEFAULT" "delete-summary"
       cfDisableRegistration <- get cp "DEFAULT" "disable-registration"
@@ -207,6 +208,7 @@ extractConfig cp = do
         , frontPage            = cfFrontPage
         , noEdit               = splitCommaList cfNoEdit
         , noDelete             = splitCommaList cfNoDelete
+        , privatePages         = splitCommaList cfPrivatePages
         , defaultSummary       = cfDefaultSummary
         , deleteSummary        = cfDeleteSummary
         , disableRegistration  = cfDisableRegistration

src/Network/Gitit/Framework.hs

@@ -24,9 +24,11 @@ module Network.Gitit.Framework (
                                , authenticateUserThat
                                , authenticate
                                , getLoggedInUser
+                               , redirectToLogin
                                -- * Combinators to exclude certain actions
                                , unlessNoEdit
                                , unlessNoDelete
+                               , unlessPrivatePage
                                -- * Guards for routing
                                , guardCommand
                                , guardPath
@@ -70,6 +72,7 @@ import Skylighting (syntaxesByFilename, defaultSyntaxMap)
 import Data.Maybe (fromJust, fromMaybe)
 import Data.List (intercalate, isPrefixOf, isInfixOf)
 import System.FilePath ((<.>), takeExtension, takeFileName)
+import qualified System.FilePath.Glob as G
 import Text.ParserCombinators.Parsec
 import Network.URL (decString, encString)
 import Network.URI (isUnescapedInURI)
@@ -99,6 +102,13 @@ authenticateUserThat predicate level handler = do
                             else error "Not authorized."
      else handler
 
+-- | Redirects a request to login view, used as a failure handler.
+redirectToLogin :: Handler
+redirectToLogin = do
+  rq <- askRq
+  let url = rqUri rq ++ rqQuery rq
+  tempRedirect ("/_login?" ++ urlEncodeVars [("destination", url)]) $ toResponse ()
+
 -- | Run the handler after setting @REMOTE_USER@ with the user from
 -- the session.
 withUserFromSession :: Handler -> Handler
@@ -186,6 +196,22 @@ unlessNoDelete responder fallback = withData $ \(params :: Params) -> do
      then withMessages ("Page cannot be deleted." : pMessages params) fallback
      else responder
 
+-- | @unlessPrivatePage responder fallback@ runs @responder@ unless the
+-- page is specified as private in configuration; in that case, runs
+-- @fallback@
+unlessPrivatePage :: Handler
+                  -> Handler
+                  -> Handler
+unlessPrivatePage responder fallback =
+  withData $ \(params :: Params) -> do
+    cfg <- getConfig
+    page <- getPage
+    let patterns = privatePages cfg
+    let pageMatchingPatterns = ((flip G.match page) . G.compile)
+    if ((not . null) patterns) && (any pageMatchingPatterns patterns)
+      then fallback
+      else responder
+
 -- | Returns the current path (subtracting initial commands like @\/_edit@).
 getPath :: ServerMonad m => m String
 getPath = liftM (intercalate "/" . rqPaths) askRq

src/Network/Gitit/Types.hs

@@ -159,7 +159,9 @@ data Config = Config {
   -- | Pages that cannot be edited via web
   noEdit               :: [String],
   -- | Pages that cannot be deleted via web
-  noDelete             :: [String],
+  noDelete              :: [String],
+  -- | Pages that cannot be viewed by anonymous users.
+  privatePages          :: [String],
   -- | Default summary if description left blank
   defaultSummary       :: String,
   -- | Delete summary