Commits

Luke Plant committed 2a03ece

Added processor to do redirects if client request was through 'blog.cgi'

Comments (0)

Files changed (3)

src/Blog/Processors.hs

+module Blog.Processors
+    (canonicalUri
+    ) where
+
+import Data.List (isPrefixOf)
+import Web.Request
+import Web.Response
+import qualified Blog.Settings as Settings
+
+
+canonicalUri view req =
+    let uri' = requestUriRaw req
+    in case uri' of
+         Nothing -> view req
+         Just uri -> if Settings.prog_uri `isPrefixOf` uri
+                     then let canonUri = Settings.root_url ++ drop (length Settings.prog_uri + length "/") uri
+                          in return $ Just $ redirectResponse canonUri
+                     else view req

src/Blog/Routes.hs

 module Blog.Routes where
 
 import Blog.Views
+import Blog.Processors
 import Web.Framework
 import Web.Framework.Processors (addSlashRedirectProcessor)
 import Web.GenUtils (apply)
 -- even if the matcher will not succeed, so this should only be done
 -- for processors which either require this behaviour, or are low
 -- enough overhead to be done anyway.
-procs = [addSlashRedirectProcessor]
+procs = [ addSlashRedirectProcessor
+        , canonicalUri
+        ]
 
 views = map (apply procs) views'

src/Blog/settingslocal.hs

 
 sqlite_path = "/home/luke/httpd/lukeplant.me.uk/web/cgi-bin/data/test1.db"
 root_url = "/testblog/"
+prog_uri = "/cgi-bin/blog.cgi" -- Used for redirecting
 
 -- Testing
 testdb_sqlite_path = "/home/luke/devel/haskell/haskellblog/testsuite/test.db"