diff --git a/resources/templates/edit-user.html b/resources/templates/edit-user.html
new file mode 100644
index 0000000..ab0d3ec
--- /dev/null
+++ b/resources/templates/edit-user.html
@@ -0,0 +1,32 @@
+{% extends "templates/base.html" %}
+
+{% block content %}
+
+{% endblock %}
diff --git a/resources/templates/edit-users.html b/resources/templates/edit-users.html
new file mode 100644
index 0000000..674f981
--- /dev/null
+++ b/resources/templates/edit-users.html
@@ -0,0 +1,21 @@
+{% extends "templates/base.html" %}
+
+{% block content %}
+
+{% endblock %}
diff --git a/resources/templates/passwd.html b/resources/templates/passwd.html
index 9a10df6..7e587a2 100644
--- a/resources/templates/passwd.html
+++ b/resources/templates/passwd.html
@@ -3,20 +3,20 @@
diff --git a/resources/templates/wiki.html b/resources/templates/wiki.html
index d04fb25..7bf616f 100644
--- a/resources/templates/wiki.html
+++ b/resources/templates/wiki.html
@@ -2,10 +2,12 @@
{% block content %}
+ {% if editable %}
- {{content|safe}}
+ {% endif %}
+ {{content|safe}}
{% endblock %}
diff --git a/src/smeagol/authenticate.clj b/src/smeagol/authenticate.clj
index 0b4c959..38d17f9 100644
--- a/src/smeagol/authenticate.clj
+++ b/src/smeagol/authenticate.clj
@@ -33,28 +33,50 @@
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; the relative path to the password file.
+(def password-file-path (str (io/resource-path) "../passwd"))
+
+
+(defn- get-users
+ "Get the whole content of the password file as a clojure map"
+ []
+ (read-string (slurp password-file-path)))
+
+
(defn authenticate
"Return `true` if this `username`/`password` pair match, `false` otherwise"
[username password]
- (let [path (str (io/resource-path) "../passwd")
- users (read-string (slurp path))
- user ((keyword username) users)]
- (timbre/info (str "Authenticating " username " against " path))
+ (let [user ((keyword username) (get-users))]
+ (timbre/info (str "Authenticating " username " against " password-file-path))
(and user
+ (:password user)
(or
(.equals (:password user) password)
(password/check password (:password user))))))
+
(defn get-email
"Return the email address associated with this `username`."
[username]
- (let [path (str (io/resource-path) "../passwd")
- users (read-string (slurp path))
- user ((keyword username) users)]
- (if user (:email user))))
+ (if username
+ (let [user ((keyword username) (get-users))]
+ (:email user))))
+
+
+(defn get-admin
+ "Return a flag indicating whether the user with this username is an administrator."
+ [username]
+ (if username
+ (let [user ((keyword username) (get-users))]
+ (:admin user))))
+
+(defn evaluate-password
+ "Evaluate whether this proposed password is suitable for use."
+ ([pass1 pass2]
+ (and pass1 (>= (count pass1) 8) (.equals pass1 pass2)))
+ ([password]
+ (evaluate-password password password)))
-;;; TODO: worth locking the passwd file to prevent corruption if two simultaneous threads
-;;; try to write it. See http://stackoverflow.com/questions/6404717/idiomatic-file-locking-in-clojure
(defn change-pass
"Change the password for the user with this `username` and `oldpass` to this `newpass`.
@@ -62,24 +84,89 @@
password will be encrypted."
[username oldpass newpass]
(timbre/info (format "Changing password for user %s" username))
- (let [path (str (io/resource-path) "../passwd")
- users (read-string (slurp path))
+ (let [users (get-users)
keywd (keyword username)
- user (if users (keywd users))
+ user (keywd users)
email (:email user)]
(try
(cond
- (and user
- (or
- (.equals (:password user) oldpass)
- (password/check oldpass (:password user))))
- (do
- (spit path
- (assoc (dissoc users keywd) keywd
- {:password (password/encrypt newpass) :email email}))
- true))
+ (and user
+ (or
+ (.equals (:password user) oldpass)
+ (password/check oldpass (:password user))))
+ (do
+ (locking password-file-path
+ (spit password-file-path
+ (merge users
+ {keywd
+ (merge user
+ {:password (password/encrypt newpass)})})))
+ (timbre/info (str "Successfully changed password for user " username))
+ true))
(catch Exception any
(timbre/error
- (format "Changing password failed for user %s failed: %s (%s)"
- username (.getName (.getClass any)) (.getMessage any)))
+ (format "Changing password failed for user %s failed: %s (%s)"
+ username (.getName (.getClass any)) (.getMessage any)))
+ false))))
+
+
+(defn list-users
+ "Return, as strings, the names of the currently known users."
+ []
+ (map name (keys (get-users))))
+
+
+(defn fetch-user-details
+ "Return the map of features of this user, if any."
+ [username]
+ (if
+ (and username (> (count (str username)) 0))
+ ((keyword username) (get-users))))
+
+
+(defn add-user
+ "Add a user to the passwd file with this username, initial password and email address and admin flag."
+ [username newpass email admin]
+ (let [users (get-users)
+ user ((keyword username) users)
+ password (if
+ (and newpass (evaluate-password newpass))
+ (password/encrypt newpass))
+ details {:email email
+ :admin (if
+ (and (string? admin) (> (count admin) 0))
+ true
+ false)}
+ ;; if we have a valid password we want to include it in the details to update.
+ full-details (if password
+ (merge details {:password password})
+ details)]
+ (try
+ (locking password-file-path
+ (spit password-file-path
+ (merge users
+ {(keyword username) (merge user full-details)}))
+ (timbre/info (str "Successfully added user " username))
+ true)
+ (catch Exception any
+ (timbre/error
+ (format "Adding user %s failed: %s (%s)"
+ username (.getName (.getClass any)) (.getMessage any)))
+ false))))
+
+
+(defn delete-user
+ "Delete the user with this `username` from the password file."
+ [username]
+ (let [users (get-users)]
+ (try
+ (locking password-file-path
+ (spit password-file-path
+ (dissoc users (keyword username)))
+ (timbre/info (str "Successfully deleted user " username))
+ true)
+ (catch Exception any
+ (timbre/error
+ (format "Deleting user %s failed: %s (%s)"
+ username (.getName (.getClass any)) (.getMessage any)))
false))))
diff --git a/src/smeagol/handler.clj b/src/smeagol/handler.clj
index 421f9e0..4f23c41 100644
--- a/src/smeagol/handler.clj
+++ b/src/smeagol/handler.clj
@@ -54,10 +54,6 @@
an app server such as Tomcat
put any initialization code here"
[]
- (timbre/set-config!
- {:min-level :debug
- :enabled? true
- :output-fn timbre/default-output-fn})
(timbre/merge-config!
{:appenders
{:rotor (rotor/rotor-appender
diff --git a/src/smeagol/routes/admin.clj b/src/smeagol/routes/admin.clj
new file mode 100644
index 0000000..4fd45ca
--- /dev/null
+++ b/src/smeagol/routes/admin.clj
@@ -0,0 +1,84 @@
+(ns ^{:doc "Render all the main pages of a very simple Wiki engine."
+ :author "Simon Brooke"}
+ smeagol.routes.admin
+ (:require [clojure.walk :refer :all]
+ [noir.session :as session]
+ [taoensso.timbre :as timbre]
+ [smeagol.authenticate :as auth]
+ [smeagol.layout :as layout]
+ [smeagol.util :as util]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; Smeagol: a very simple Wiki engine.
+;;;;
+;;;; This program is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU General Public License
+;;;; as published by the Free Software Foundation; either version 2
+;;;; of the License, or (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;;; USA.
+;;;;
+;;;; Copyright (C) 2016 Simon Brooke
+;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defn edit-users
+ "Put a list of users on-screen for editing."
+ [request]
+ (let [params (keywordize-keys (:params request))
+ user (session/get :user)]
+ (layout/render "edit-users.html"
+ (merge (util/standard-params request)
+ {:title "Select user to edit"
+ :users (auth/list-users)}))))
+
+(defn delete-user
+ "Delete a user."
+ [request]
+ (let [params (keywordize-keys (:params request))
+ target (:target params)
+ deleted (auth/delete-user target)
+ message (if deleted (str "Successfully deleted user " target))
+ error (if (not deleted) (str "Could not delete user " target))]
+ (layout/render "edit-users.html"
+ (merge (util/standard-params request)
+ {:title "Select user to edit"
+ :message message
+ :error error
+ :users (auth/list-users)}))))
+
+
+(defn edit-user
+ "Put an individual user's details on screen for editing."
+ [request]
+ (let [params (keywordize-keys (:params request))
+ target (:target params)
+ pass1 (:pass1 params)
+ password (if (and pass1 (auth/evaluate-password pass1 (:pass2 params))) pass1)
+ stored (if (:email params)
+ (auth/add-user target password (:email params) (:admin params)))
+ message (if stored (str "User " target " was stored successfully."))
+ error (if (and (:email params) (not stored))
+ (str "User " target " was not stored."))
+ details (auth/fetch-user-details target)]
+ (if message
+ (timbre/info message))
+ (if error
+ (timbre/warn error))
+ (layout/render "edit-user.html"
+ (merge (util/standard-params request)
+ {:title (str "Edit user " target)
+ :message message
+ :error error
+ :target target
+ :details details}))))
diff --git a/src/smeagol/routes/params.clj b/src/smeagol/routes/params.clj
new file mode 100644
index 0000000..e69de29
diff --git a/src/smeagol/routes/wiki.clj b/src/smeagol/routes/wiki.clj
index 5a5a555..d95b1d9 100644
--- a/src/smeagol/routes/wiki.clj
+++ b/src/smeagol/routes/wiki.clj
@@ -3,10 +3,9 @@
smeagol.routes.wiki
(:require [clojure.walk :refer :all]
[clojure.java.io :as cjio]
- [clojure.string :as cs]
+ [cemerick.url :refer (url url-encode url-decode)]
[compojure.core :refer :all]
[clj-jgit.porcelain :as git]
- [cemerick.url :refer (url url-encode url-decode)]
[markdown.core :as md]
[noir.io :as io]
[noir.response :as response]
@@ -17,7 +16,8 @@
[smeagol.diff2html :as d2h]
[smeagol.layout :as layout]
[smeagol.util :as util]
- [smeagol.history :as hist]))
+ [smeagol.history :as hist]
+ [smeagol.routes.admin :as admin]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
@@ -42,19 +42,6 @@
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defn local-links
- "Rewrite text in `html-src` surrounded by double square brackets as a local link into this wiki."
- [^String html-src]
- (cs/replace html-src #"\[\[[^\[\]]*\]\]"
- #(let [text (clojure.string/replace %1 #"[\[\]]" "")
- encoded (url-encode text)
- ;; I use '\_' to represent '_' in wiki markup, because
- ;; '_' is meaningful in Markdown. However, this needs to
- ;; be stripped out when interpreting local links.
- munged (cs/replace encoded #"%26%2395%3B" "_")]
- (format "
%s" munged text))))
-
-
(defn get-git-repo
"Get the git repository for my content, creating it if necessary"
[]
@@ -100,18 +87,20 @@
src-text (:src params)
page (or (:page params) default)
file-path (str (io/resource-path) "content/" page suffix)
- exists? (.exists (cjio/as-file file-path))]
- (if (not exists?) (timbre/info (format "File '%s' not found; creating a new file" file-path)))
+ exists? (.exists (cjio/as-file file-path))
+ user (session/get :user)]
+ (if (not exists?)
+ (timbre/info (format "File '%s' not found; creating a new file" file-path))
+ (timbre/info (format "Opening '%s' for editing" file-path)))
(cond src-text (process-source params suffix)
true
(layout/render template
- {:title (str "Edit " page)
- :page page
- :side-bar (local-links (util/md->html side-bar))
- :header (local-links (util/md->html "/content/_header.md"))
- :content (if exists? (io/slurp-resource (str "/content/" page suffix)) "")
- :user (session/get :user)
- :exists exists?})))))
+ (merge (util/standard-params request)
+ {:title (str "Edit " page)
+ :page page
+ :side-bar (util/local-links (util/md->html side-bar))
+ :content (if exists? (io/slurp-resource (str "/content/" page suffix)) "")
+ :exists exists?}))))))
(defn edit-css-page
@@ -129,15 +118,15 @@
file-path (str (io/resource-path) file-name)
exists? (.exists (clojure.java.io/as-file file-path))]
(cond exists?
- (layout/render "wiki.html"
- {:title page
- :page page
- :side-bar (local-links (util/md->html "/content/_side-bar.md"))
- :header (local-links (util/md->html "/content/_header.md"))
- :content (local-links (util/md->html file-name))
- :user (session/get :user)
- :version (System/getProperty "smeagol.version")})
- true (response/redirect (str "/edit?page=" page)))))
+ (do
+ (timbre/info (format "Showing page '%s'" page))
+ (layout/render "wiki.html"
+ (merge (util/standard-params request)
+ {:title page
+ :page page
+ :content (util/local-links (util/md->html file-name))
+ :editable true})))
+ true (response/redirect (str "edit?page=" page)))))
(defn history-page
@@ -149,11 +138,10 @@
file-name (str page ".md")
repo-path (str (io/resource-path) "/content/")]
(layout/render "history.html"
- {:title (str "History of " page)
- :page page
- :side-bar (local-links (util/md->html "/content/_side-bar.md"))
- :header (local-links (util/md->html "/content/_header.md"))
- :history (hist/find-history repo-path file-name)})))
+ (merge (util/standard-params request)
+ {:title (str "History of " page)
+ :page page
+ :history (hist/find-history repo-path file-name)}))))
(defn version-page
@@ -165,17 +153,13 @@
file-name (str page ".md")
repo-path (str (io/resource-path) "/content/")]
(layout/render "wiki.html"
- {:title (str "Version " version " of " page)
- :page page
- :side-bar (local-links
- (util/md->html "/content/_side-bar.md"))
- :header (local-links
- (util/md->html "/content/_header.md"))
- :content (local-links
- (md/md-to-html-string
- (hist/fetch-version
- repo-path file-name version)))
- :user (session/get :user)})))
+ (merge (util/standard-params request)
+ {:title (str "Version " version " of " page)
+ :page page
+ :content (util/local-links
+ (md/md-to-html-string
+ (hist/fetch-version
+ repo-path file-name version)))}))))
(defn diff-page
@@ -187,14 +171,10 @@
file-name (str page ".md")
repo-path (str (io/resource-path) "/content/")]
(layout/render "wiki.html"
- {:title (str "Changes since version " version " of " page)
- :page page
- :side-bar (local-links
- (util/md->html "/content/_side-bar.md"))
- :header (local-links
- (util/md->html "/content/_header.md"))
- :content (d2h/diff2html (hist/diff repo-path file-name version))
- :user (session/get :user)})))
+ (merge (util/standard-params request)
+ {:title (str "Changes since version " version " of " page)
+ :page page
+ :content (d2h/diff2html (hist/diff repo-path file-name version))}))))
(defn auth-page
@@ -218,11 +198,12 @@
(response/redirect redirect-to))
true
(layout/render "auth.html"
+ (merge (util/standard-params request)
{:title (if user (str "Logout " user) "Log in")
:redirect-to ((:headers request) "referer")
- :side-bar (local-links (util/md->html "/content/_side-bar.md"))
- :header (local-links (util/md->html "/content/_header.md"))
- :user user}))))
+ :side-bar (util/local-links (util/md->html "/content/_side-bar.md"))
+ :header (util/local-links (util/md->html "/content/_header.md"))
+ :user user})))))
(defn passwd-page
@@ -233,28 +214,32 @@
pass1 (:pass1 params)
pass2 (:pass2 params)
user (session/get :user)
- length (if pass1 (count pass1) 0)
message (cond
- (nil? oldpass) nil
- (and pass1 (>= length 8) (.equals pass1 pass2) (auth/change-pass user oldpass pass2))
- "Your password was changed"
- (< length 8) "You proposed password wasn't long enough: 8 characters required"
- (not (= pass1 pass2)) "Your proposed passwords don't match"
- true "Your password was not changed")] ;; but I don't know why...
+ (nil? oldpass) nil
+ (and (auth/evaluate-password pass1 pass2) (auth/change-pass user oldpass pass2))
+ "Your password was changed"
+ (< (count pass1) 8) "You proposed password wasn't long enough: 8 characters required"
+ (not (= pass1 pass2)) "Your proposed passwords don't match"
+ true "Your password was not changed")] ;; but I don't know why...
(layout/render "passwd.html"
- {:title (str "Change passord for " user)
- :side-bar (local-links (util/md->html "/content/_side-bar.md"))
- :header (local-links (util/md->html "/content/_header.md"))
- :message message})))
+ (merge (util/standard-params request)
+ {:title (str "Change passord for " user)
+ :side-bar (util/local-links (util/md->html "/content/_side-bar.md"))
+ :header (util/local-links (util/md->html "/content/_header.md"))
+ :message message}))))
(defroutes wiki-routes
(GET "/wiki" request (wiki-page request))
(GET "/" request (wiki-page request))
+ (GET "/delete-user" request (route/restricted (admin/delete-user request)))
(GET "/edit" request (route/restricted (edit-page request)))
(POST "/edit" request (route/restricted (edit-page request)))
(GET "/edit-css" request (route/restricted (edit-css-page request)))
(POST "/edit-css" request (route/restricted (edit-css-page request)))
+ (GET "/edit-users" request (route/restricted (admin/edit-users request)))
+ (GET "/edit-user" request (route/restricted (admin/edit-user request)))
+ (POST "/edit-user" request (route/restricted (admin/edit-user request)))
(GET "/history" request (history-page request))
(GET "/version" request (version-page request))
(GET "/changes" request (diff-page request))
diff --git a/src/smeagol/util.clj b/src/smeagol/util.clj
index 791b77b..8a45339 100644
--- a/src/smeagol/util.clj
+++ b/src/smeagol/util.clj
@@ -1,8 +1,12 @@
(ns ^{:doc "Miscellaneous utility functions supporting Smeagol."
:author "Simon Brooke"}
smeagol.util
- (:require [noir.io :as io]
- [markdown.core :as md]))
+ (:require [clojure.string :as cs]
+ [cemerick.url :refer (url url-encode url-decode)]
+ [noir.io :as io]
+ [noir.session :as session]
+ [markdown.core :as md]
+ [smeagol.authenticate :as auth]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
@@ -31,3 +35,28 @@
"reads a markdown file from public/md and returns an HTML string"
[filename]
(md/md-to-html-string (io/slurp-resource filename)))
+
+
+(defn local-links
+ "Rewrite text in `html-src` surrounded by double square brackets as a local link into this wiki."
+ [^String html-src]
+ (cs/replace html-src #"\[\[[^\[\]]*\]\]"
+ #(let [text (clojure.string/replace %1 #"[\[\]]" "")
+ encoded (url-encode text)
+ ;; I use '\_' to represent '_' in wiki markup, because
+ ;; '_' is meaningful in Markdown. However, this needs to
+ ;; be stripped out when interpreting local links.
+ munged (cs/replace encoded #"%26%2395%3B" "_")]
+ (format "
%s" munged text))))
+
+
+(defn standard-params
+ "Return a map of standard parameters to pass to the template renderer."
+ [request]
+ (let [user (session/get :user)]
+ {:user user
+ :admin (auth/get-admin user)
+ :side-bar (local-links (md->html "/content/_side-bar.md"))
+ :header (local-links (md->html "/content/_header.md"))
+ :version (System/getProperty "smeagol.version")}))
+