gitit 0.3.2 → 0.3.3
raw patch · 6 files changed
+126/−91 lines, 6 files
Files
- Gitit.hs +106/−78
- README.markdown +6/−7
- css/screen.css +7/−1
- data/template.html +2/−2
- gitit.cabal +2/−1
- js/preview.js +3/−2
Gitit.hs view
@@ -38,7 +38,7 @@ import qualified Text.XHtml as X ( password, method ) import Data.List (intersect, intersperse, intercalate, sort, nub, sortBy, isSuffixOf) import Data.Maybe (fromMaybe, fromJust, mapMaybe, isNothing)-import Data.ByteString.UTF8 (fromString)+import Data.ByteString.UTF8 (fromString, toString) import qualified Data.ByteString.Lazy.UTF8 as L (fromString) import qualified Data.Map as M import Data.Ord (comparing)@@ -51,20 +51,23 @@ import Data.Char (isAlphaNum, isAlpha) import Control.Monad.Reader import qualified Data.ByteString.Lazy as B-import Network.HTTP (urlEncodeVars, urlEncode)+import Network.HTTP (urlEncodeVars, urlEncode, urlDecode) import System.Console.GetOpt import System.Exit import Text.Highlighting.Kate-import Text.StringTemplate as T+import qualified Text.StringTemplate as T import Data.IORef import System.IO.Unsafe (unsafePerformIO) gititVersion :: String-gititVersion = "0.3.2"+gititVersion = "0.3.3" -template :: IORef (StringTemplate String)-template = unsafePerformIO $ newIORef $ newSTMP "" -- initialize template to empty string+sessionTime :: Int+sessionTime = 60 * 60 -- session will expire 1 hour after page request +template :: IORef (T.StringTemplate String)+template = unsafePerformIO $ newIORef $ T.newSTMP "" -- initialize template to empty string+ main :: IO () main = do argv <- getArgs@@ -75,7 +78,7 @@ initializeWiki conf -- initialize template templ <- liftIO $ readFile (templateFile conf)- writeIORef template (newSTMP templ)+ writeIORef template (T.newSTMP templ) control <- startSystemState entryPoint update $ SetConfig conf -- read user file and update state@@ -227,21 +230,21 @@ , handlePath "_login" GET loginUserForm , handlePath "_login" POST loginUser , handlePath "_logout" GET logoutUser- , handlePath "_upload" GET (ifLoggedIn "" uploadForm)- , handlePath "_upload" POST (ifLoggedIn "" uploadFile)+ , handlePath "_upload" GET (ifLoggedIn uploadForm)+ , handlePath "_upload" POST (ifLoggedIn uploadFile) , handlePath "_random" GET randomPage , withCommand "showraw" [ handlePage GET showRawPage ] , withCommand "history" [ handlePage GET showPageHistory, handle (not . isPage) GET showFileHistory ]- , withCommand "edit" [ handlePage GET $ unlessNoEdit $ ifLoggedIn "?edit" editPage ]+ , withCommand "edit" [ handlePage GET $ unlessNoEdit $ ifLoggedIn editPage ] , withCommand "diff" [ handlePage GET showPageDiff, handle isSourceCode GET showFileDiff ] , withCommand "export" [ handlePage POST exportPage, handlePage GET exportPage ] , withCommand "cancel" [ handlePage POST showPage ] , withCommand "discuss" [ handlePage GET discussPage ]- , withCommand "update" [ handlePage POST $ unlessNoEdit $ ifLoggedIn "?edit" updatePage ]- , withCommand "delete" [ handlePage GET $ unlessNoDelete $ ifLoggedIn "?delete" confirmDelete,- handlePage POST $ unlessNoDelete $ ifLoggedIn "?delete" deletePage ]+ , withCommand "update" [ handlePage POST $ unlessNoEdit $ ifLoggedIn updatePage ]+ , withCommand "delete" [ handlePage GET $ unlessNoDelete $ ifLoggedIn confirmDelete,+ handlePage POST $ unlessNoDelete $ ifLoggedIn deletePage ] , handleSourceCode , handleAny , handlePage GET showPage@@ -252,6 +255,8 @@ , pPassword2 :: String , pRevision :: String , pDestination :: String+ , pReferer :: Maybe String+ , pUri :: String , pForUser :: String , pSince :: String , pRaw :: String@@ -285,7 +290,7 @@ rv <- look "revision" `mplus` return "HEAD" fu <- look "forUser" `mplus` return "" si <- look "since" `mplus` return ""- ds <- look "destination" `mplus` return ""+ ds <- (lookCookieValue "destination") `mplus` return "/" ra <- look "raw" `mplus` return "" lt <- look "limit" `mplus` return "100" pa <- look "patterns" `mplus` return ""@@ -313,6 +318,8 @@ , pForUser = fu , pSince = si , pDestination = ds+ , pReferer = Nothing -- this gets set by handle...+ , pUri = "" -- this gets set by handle... , pRaw = ra , pLimit = read lt , pPatterns = words pa@@ -333,7 +340,8 @@ , pAccessCode = ac , pUser = "" -- this gets set by ifLoggedIn... , pConfirm = cn- , pSessionKey = sk }+ , pSessionKey = sk+ } getLoggedInUser :: MonadIO m => Params -> m (Maybe String) getLoggedInUser params = do@@ -369,28 +377,35 @@ then showPage page (params { pMessages = ("Page cannot be deleted." : pMessages params) }) else responder page params -ifLoggedIn :: String -> (String -> Params -> Web Response) -> (String -> Params -> Web Response)-ifLoggedIn fallback responder =+ifLoggedIn :: (String -> Params -> Web Response) -> (String -> Params -> Web Response)+ifLoggedIn responder = \page params -> do user <- getLoggedInUser params case user of- Nothing -> seeOther ("/_login?" ++ urlEncodeVars [("destination", page ++ fallback)]) $ - toResponse $ p << "You must be logged in to perform this action."+ Nothing -> do+ loginUserForm page (params { pReferer = Just $ pUri params }) Just u -> do usrs <- query AskUsers let e = case M.lookup u usrs of Just usr -> uEmail usr Nothing -> error $ "User '" ++ u ++ "' not found."+ -- give the user another hour...+ addCookie sessionTime (mkCookie "sid" (show $ fromJust $ pSessionKey params)) responder page (params { pUser = u, pEmail = e }) handle :: (String -> Bool) -> Method -> (String -> Params -> Web Response) -> Handler handle pathtest meth responder =- uriRest $ \uri -> let path' = uriPath uri- in if pathtest path'- then withData $ \params ->- [ withRequest $ \req -> if rqMethod req == meth- then responder path' params- else noHandle ]- else anyRequest noHandle+ withRequest $ \req -> let uri = urlDecode $ rqUri req ++ rqQuery req+ path' = uriPath uri+ referer = case M.lookup (fromString "referer") (rqHeaders req) of+ Just r -> if null (hValue r)+ then Nothing+ else Just $ toString $ head $ hValue r+ _ -> Nothing+ in if pathtest path' && rqMethod req == meth+ then unServerPartT+ (withData $ \params ->+ [ anyRequest $ responder path' (params { pReferer = referer, pUri = uri }) ]) req+ else noHandle -- | Returns path portion of URI, without initial /. -- Consecutive spaces are collapsed. We don't want to distinguish 'Hi There' and 'Hi There'.@@ -660,9 +675,9 @@ let since = pSince params `orIfNull` "1 month ago" let forUser = pForUser params hist <- gitLog since forUser []- let filesFor files = intersperse (primHtmlChar "nbsp") $ map- (\file -> anchor ! [href $ urlForPage file ++ "?history"] << file) $ map- (\file -> if ".page" `isSuffixOf` file then dropExtension file else file) files+ let filesFor files revis = intersperse (primHtmlChar "nbsp") $ map+ (\file -> anchor ! [href $ urlForPage file ++ "?diff&from=" ++ revis ++ "^" ++ "&to=" ++ revis] << file) $ map+ (\file -> if ".page" `isSuffixOf` file then dropExtension file else file) files let heading = h1 << ("Recent changes" ++ if null forUser then "" else (" by " ++ forUser)) let contents = ulist ! [theclass "history"] << map (\entry -> li << [thespan ! [theclass "date"] << logDate entry, stringToHtml " (",@@ -670,7 +685,7 @@ anchor ! [href $ "/_activity?" ++ urlEncodeVars [("forUser", logAuthor entry)]] << (logAuthor entry), stringToHtml "): ", thespan ! [theclass "subject"] << logSubject entry, stringToHtml " (",- thespan ! [theclass "files"] << filesFor (logFiles entry),+ thespan ! [theclass "files"] << filesFor (logFiles entry) (logRevision entry), stringToHtml ")"]) hist formattedPage (defaultPageLayout { pgShowPageTools = False, pgTabs = [], pgTitle = "Recent changes" }) page params (heading +++ contents) @@ -689,9 +704,10 @@ '+' -> thespan ! [theclass "added"] << [tail l, "\n"] '-' -> thespan ! [theclass "deleted"] << [tail l, "\n"] _ -> thespan << [tail l, "\n"]- let formattedDiff = thespan ! [theclass "detail"] << ("Changes from " ++ from) ++++ let formattedDiff = h2 ! [theclass "revision"] << ("Changes from " ++ from) +++ pre ! [theclass "diff"] << map diffLineToHtml (drop 5 $ lines rawDiff)- formattedPage defaultPageLayout page (params { pRevision = to }) formattedDiff+ formattedPage (defaultPageLayout { pgTabs = DiffTab : pgTabs defaultPageLayout, pgSelectedTab = DiffTab })+ page (params { pRevision = to }) formattedDiff editPage :: String -> Params -> Web Response editPage page params = do@@ -712,11 +728,13 @@ [sha1Box, textarea ! [cols "80", name "editedText", identifier "editedText"] << contents, br, label << "Description of changes:", br,- textfield "logMsg" ! [size "76", value logMsg],+ textfield "logMsg" ! [value logMsg], submit "update" "Save", primHtmlChar "nbsp",- submit "cancel" "Discard", br,+ submit "cancel" "Discard", primHtmlChar "nbsp",+ input ! [thetype "button", theclass "editButton", identifier "previewButton",+ strAttr "onClick" "updatePreviewPane();", strAttr "style" "display: none;", value "Preview" ], thediv ! [ identifier "previewpane" ] << noHtml ]- formattedPage (defaultPageLayout { pgShowPageTools = False, pgSelectedTab = EditTab, + formattedPage (defaultPageLayout { pgShowPageTools = False, pgSelectedTab = EditTab, pgScripts = ["preview.js"], pgTitle = ("Editing " ++ page) }) page (params {pMessages = messages}) editForm confirmDelete :: String -> Params -> Web Response@@ -846,7 +864,7 @@ , pgSelectedTab :: Tab } -data Tab = ViewTab | EditTab | HistoryTab | DiscussTab deriving (Eq, Show)+data Tab = ViewTab | EditTab | HistoryTab | DiscussTab | DiffTab deriving (Eq, Show) defaultPageLayout :: PageLayout defaultPageLayout = PageLayout@@ -877,12 +895,15 @@ else li let origPage s = if ":discuss" `isSuffixOf` s then take (length s - 8) s else s let linkForTab HistoryTab = Just $ tabli HistoryTab << anchor ! [href $ urlForPage page ++ "?revision=" ++ revision ++ "&history"] << "history"+ linkForTab DiffTab = Just $ tabli DiffTab << anchor ! [href ""] << "diff" linkForTab ViewTab = if isDiscussPage page then Just $ tabli DiscussTab << anchor ! [href $ urlForPage $ origPage page] << "page" else Just $ tabli ViewTab << anchor ! [href $ urlForPage page ++ if revision == "HEAD" then "" else "?revision=" ++ revision] << "view" linkForTab DiscussTab = if isDiscussPage page then Just $ tabli ViewTab << anchor ! [href $ urlForPage page] << "discuss"- else Just $ tabli DiscussTab << anchor ! [href $ urlForPage page ++ "?discuss"] << "discuss"+ else if isPage page+ then Just $ tabli DiscussTab << anchor ! [href $ urlForPage page ++ "?discuss"] << "discuss"+ else Nothing linkForTab EditTab = if isPage page then Just $ tabli EditTab << anchor ! [href $ urlForPage page ++ "?edit&revision=" ++ revision ++ if revision == "HEAD" then "" else "&" ++ urlEncodeVars [("logMsg", "Revert to " ++ revision)]] <<@@ -898,43 +919,47 @@ else ulist ! [theclass "messages"] << map (li <<) messages templ <- liftIO $ readIORef template let filledTemp = T.render $- setAttribute "pagetitle" pageTitle $- setAttribute "javascripts" javascriptlinks $- setAttribute "pagename" page $+ T.setAttribute "pagetitle" pageTitle $+ T.setAttribute "javascripts" javascriptlinks $+ T.setAttribute "pagename" page $ (case user of- Just u -> setAttribute "user" u+ Just u -> T.setAttribute "user" u Nothing -> id) $- (if isPage page then setAttribute "ispage" "true" else id) $- (if pgShowPageTools layout then setAttribute "pagetools" "true" else id) $- (if pPrintable params then setAttribute "printable" "true" else id) $- (if pRevision params == "HEAD" then id else setAttribute "nothead" "true") $- setAttribute "revision" revision $- setAttribute "sha1" sha1 $- setAttribute "searchbox" (renderHtmlFragment searchbox) $- setAttribute "exportbox" (renderHtmlFragment $ exportBox page params) $- setAttribute "tabs" (renderHtmlFragment tabs) $- setAttribute "messages" (renderHtmlFragment htmlMessages) $- setAttribute "content" (renderHtmlFragment htmlContents) $+ (if isPage page then T.setAttribute "ispage" "true" else id) $+ (if pgShowPageTools layout then T.setAttribute "pagetools" "true" else id) $+ (if pPrintable params then T.setAttribute "printable" "true" else id) $+ (if pRevision params == "HEAD" then id else T.setAttribute "nothead" "true") $+ T.setAttribute "revision" revision $+ T.setAttribute "sha1" sha1 $+ T.setAttribute "searchbox" (renderHtmlFragment searchbox) $+ T.setAttribute "exportbox" (renderHtmlFragment $ exportBox page params) $+ T.setAttribute "tabs" (renderHtmlFragment tabs) $+ T.setAttribute "messages" (renderHtmlFragment htmlMessages) $+ T.setAttribute "content" (renderHtmlFragment htmlContents) $ templ ok $ setContentType "text/html" $ toResponse filledTemp -- user authentication-loginForm :: Params -> Html-loginForm params =- let destination = pDestination params- in gui "" ! [identifier "loginForm"] << fieldset <<- [ textfield "sha1" ! [thestyle "display: none", value destination]- , label << "Username ", textfield "username" ! [size "15"], stringToHtml " "- , label << "Password ", X.password "password" ! [size "15"], stringToHtml " "- , submit "login" "Login"] +++- p << [ stringToHtml "If you do not have an account, "- , anchor ! [href ("/_register?" ++ urlEncodeVars [("destination", destination)])] << "click here to get one." ]+loginForm :: Html+loginForm =+ gui "/_login" ! [identifier "loginForm"] << fieldset <<+ [ label << "Username ", textfield "username" ! [size "15"], stringToHtml " "+ , label << "Password ", X.password "password" ! [size "15"], stringToHtml " "+ , submit "login" "Login"] ++++ p << [ stringToHtml "If you do not have an account, "+ , anchor ! [href "/_register"] << "click here to get one." ] loginUserForm :: String -> Params -> Web Response-loginUserForm _ params = formattedPage (defaultPageLayout { pgShowPageTools = False, pgTabs = [], pgTitle = "Login" }) "_login" params $ loginForm params+loginUserForm page params =+ addCookie (60 * 10) (mkCookie "destination" $ substitute " " "%20" $ fromMaybe "/" $ pReferer params) >>+ loginUserForm' page params +loginUserForm' :: String -> Params -> Web Response+loginUserForm' page params =+ formattedPage (defaultPageLayout { pgShowPageTools = False, pgTabs = [], pgTitle = "Login" }) page params loginForm+ loginUser :: String -> Params -> Web Response-loginUser _ params = do+loginUser page params = do let uname = pUsername params let pword = pPassword params let destination = pDestination params@@ -944,27 +969,30 @@ if allowed then do key <- update $ NewSession (SessionData uname)- addCookie (3600) (mkCookie "sid" (show key))- seeOther ("/" ++ substitute " " "%20" destination) $ toResponse $ p << ("Welcome, " ++ uname)+ addCookie sessionTime (mkCookie "sid" (show key))+ addCookie 0 (mkCookie "destination" "") -- remove unneeded destination cookie+ seeOther destination $ toResponse $ p << ("Welcome, " ++ uname) else- loginUserForm "_login" (params { pMessages = "Authentication failed." : pMessages params })+ loginUserForm' page (params { pMessages = "Authentication failed." : pMessages params }) logoutUser :: String -> Params -> Web Response logoutUser _ params = do let key = pSessionKey params- let destination = pDestination params+ let destination = substitute " " "%20" $ fromMaybe "/" $ pReferer params case key of- Just k -> update $ DelSession k+ Just k -> do+ update $ DelSession k+ addCookie 0 (mkCookie "sid" "") -- make cookie expire immediately, effectively deleting it Nothing -> return ()- seeOther ("/" ++ substitute " " "%20" destination) $ toResponse $ p << "You have been logged out."+ seeOther destination $ toResponse "You have been logged out." registerForm :: Web Html registerForm = do cfg <- query GetConfig let accessQ = case accessQuestion cfg of- Nothing -> noHtml- Just (prompt, _) -> label << prompt +++ br +++- X.password "accessCode" ! [size "15"] +++ br+ Nothing -> noHtml+ Just (prompt, _) -> label << prompt +++ br ++++ X.password "accessCode" ! [size "15"] +++ br return $ gui "" ! [identifier "loginForm"] << fieldset << [ accessQ , label << "Username (at least 3 letters or digits):", br@@ -978,10 +1006,10 @@ , submit "register" "Register" ] registerUserForm :: String -> Params -> Web Response-registerUserForm _ params = do- let page = "_register"- regForm <- registerForm- formattedPage (defaultPageLayout { pgShowPageTools = False, pgTabs = [], pgTitle = "Register for an account" }) page params regForm+registerUserForm _ params =+ addCookie (60 * 10) (mkCookie "destination" $ substitute " " "%20" $ fromMaybe "/" $ pReferer params) >>+ registerForm >>=+ formattedPage (defaultPageLayout { pgShowPageTools = False, pgTabs = [], pgTitle = "Register for an account" }) "_register" params registerUser :: String -> Params -> Web Response registerUser _ params = do@@ -1012,7 +1040,7 @@ then do let passwordHash = showDigest $ sha512 $ L.fromString $ passwordSalt cfg ++ pword update $ AddUser uname (User { uUsername = uname, uPassword = passwordHash, uEmail = email })- loginUser "/" (params { pUsername = uname, pPassword = pword })+ loginUser "/" (params { pUsername = uname, pPassword = pword, pEmail = email }) else formattedPage (defaultPageLayout { pgShowPageTools = False, pgTabs = [], pgTitle = "Register for an account" }) page (params { pMessages = errors }) regForm
README.markdown view
@@ -38,15 +38,14 @@ that pandoc is compiled with support for it. First, make sure your system has the [pcre][] library installed. Then: - cabal install pandoc -fhighlighting--You can skip this step if you don't care about highlighting support.+ cabal update+ cabal install -fhighlighting pandoc gitit -You can now install the latest release of gitit:+If you don't care about highlighting support, you can just do: - cabal update cabal install gitit +These commands will install the latest released version of gitit. To install a version of gitit checked out from the repository, change to the gitit directory and type: @@ -250,8 +249,8 @@ Reporting bugs ============== -There is no bug tracker as yet, so report bugs directly to the author,-jgm at berkeley . edu+Bugs may be reported (and feature requests filed) at+<http://code.google.com/p/gitit/issues/list>. Acknowledgements ================
css/screen.css view
@@ -179,7 +179,7 @@ body a.noicon { background:none; padding:0; margin:0; } /* Make sure the icons are not cut */-a[href^="http:"], a[href^="mailto:"],+a[href^="http:"], a[href^="https:"], a[href^="mailto:"], a[href$=".pdf"], a[href$=".doc"], a[href$=".xls"], a[href$=".rss"], a[href$=".rdf"], a[href^="aim:"] { padding:2px 22px 2px 0;@@ -190,6 +190,7 @@ /* External links */ a[href^="http:"] { background-image: url(../img/icons/external.png); padding-right: 14px; }+a[href^="https:"] { background-image: url(../img/icons/external.png); padding-right: 14px; } a[href^="mailto:"] { background-image: url(../img/icons/email.png); } /* Files */@@ -362,6 +363,11 @@ #editform textarea { height: 25em; width: 98%;+}+#editform #logMsg {+ width: 98%;+ margin-right: 1em;+ margin-bottom: 0.3em; } .added { background-color: yellow; } .deleted { text-decoration: line-through; color: gray; }
data/template.html view
@@ -50,9 +50,9 @@ </div> <div id="userbox"> $if(user)$- <a href="/_logout?destination=$pagename$">Logout $user$</a>+ <a href="/_logout">Logout $user$</a> $else$- <a href="/_login?destination=$pagename$">Login</a> • <a href="/_register?destination=$pagename$">Get an account</a>+ <a href="/_login">Login</a> • <a href="/_register">Get an account</a> $endif$ </div> <div id="maincol">
gitit.cabal view
@@ -1,5 +1,5 @@ name: gitit-version: 0.3.2+version: 0.3.3 Cabal-version: >= 1.2 build-type: Simple synopsis: Wiki using HAppS, git, and pandoc.@@ -19,6 +19,7 @@ license-file: LICENSE author: John MacFarlane maintainer: jgm@berkeley.edu+bug-reports: http://code.google.com/p/gitit/issues/list homepage: http://github.com/jgm/gitit/tree/master stability: experimental data-files: css/screen.css, css/print.css, css/ie.css, css/hk-pyg.css,
js/preview.js view
@@ -4,5 +4,6 @@ $("#previewpane").fadeIn(1000); }; $(document).ready(function(){- $("#previewpane").before("<a onClick=\"updatePreviewPane();\">Preview</a>");-});+ $("#previewButton").show();+ });+