mirror of
https://github.com/journeyman-cc/smeagol.git
synced 2026-04-12 18:05:06 +00:00
#32: Fix, and it's rather wonderful.
This commit is contained in:
parent
b6a2bdd4bc
commit
420dcb8016
4 changed files with 382 additions and 42 deletions
|
|
@ -23,7 +23,7 @@
|
|||
|
||||
;;; en-GB.edn: English-language messages.
|
||||
;;; This is essentially all the text in the chrome - that which isn't editable
|
||||
;;; through the wiki itself
|
||||
;;; through the wiki itself; and the test in the sanity check report.
|
||||
|
||||
;; ; ; ; ; ; ; ; ; ;
|
||||
{:add-user-label "Add new user" ;; label for the add user link on edit users page
|
||||
|
|
@ -46,6 +46,12 @@
|
|||
;; error text if proposed password is too short
|
||||
:chpass-title-prefix "Change password for"
|
||||
;; prefix for title of change password page
|
||||
:content-dir "The content directory"
|
||||
;; used in sanity check report
|
||||
:content-dir-exists "The content directory exists"
|
||||
;; used in sanity check report
|
||||
:content-dir-is-dir "The content directory is a directory"
|
||||
;; used in sanity check report
|
||||
:cookies-about "About cookies" ;; about cookies text
|
||||
:cookies-more "This website stores session information as a 'cookie' on your browser. This helps us show you the content you want to see. This cookie does not identify you, and cannot be read by other websites. It is deleted by your browser as soon as you leave this site. This website does not use any third party cookies, so your visit here cannot be tracked by other websites."
|
||||
;; more about cookies text
|
||||
|
|
@ -57,6 +63,8 @@
|
|||
;; confirmation message on deletion of user
|
||||
:diff-title-prefix "Changes since version"
|
||||
;; prefix for the header of the changes page
|
||||
:does-not-exist "does not exist"
|
||||
;; (of a file or directory); used in sanity check report
|
||||
:edit-col-hdr "Edit" ;; header for edit column on edit users page
|
||||
:edit-page-link "Edit this page"
|
||||
;; text of the edit page link on the content frame
|
||||
|
|
@ -65,12 +73,21 @@
|
|||
:edit-users-title "Select user to edit"
|
||||
;; title of edit users page
|
||||
:email-prompt "Email address" ;; text of the email widget prompt on edit user page
|
||||
:file-or-directory "File or directory"
|
||||
;; used in sanity check report
|
||||
:file-upload-link-text "You may link to this file using a link of the form"
|
||||
;; Text introducing the link to an uploaded file
|
||||
:file-upload-prompt "File to upload" ;; prompt string for the file upload widget
|
||||
:file-upload-title "Upload a file" ;; title for the file upload page
|
||||
:is-admin-prompt "Is administrator?"
|
||||
:here "here" ;; used in sanity check report
|
||||
:home-link "Home" ;; text of the home link on the menu
|
||||
:is-not-directory "is not a directory"
|
||||
;; (of a file or directory) used in sanity check report
|
||||
:is-not-readable "is not readable"
|
||||
;; (of a file or directory) used in sanity check report
|
||||
:is-not-writable "is not writable"
|
||||
;; (of a file or directory) used in sanity check report
|
||||
:login-label "Log in!" ;; text of the login widget on the login page
|
||||
:login-link "Log in" ;; text of the login link on the menu
|
||||
:login-prompt "To edit this wiki"
|
||||
|
|
@ -83,9 +100,15 @@
|
|||
:history-title-prefix "History of" ;; prefix of the title on the history page
|
||||
:new-pass-prompt "New password" ;; text of the new password widget prompt on the change
|
||||
;; password and edit user pages
|
||||
:no-admin-users "There are no users in the 'passwd' file with administrative privileges"
|
||||
;; used in sanity check report
|
||||
:old-pass-prompt "Your password"
|
||||
;; text of the old password widget prompt on the change
|
||||
;; password page, and password widget on login page
|
||||
:password-file "the password ('passwd') file"
|
||||
;; used in sanity check report
|
||||
:problems-found "problems were found"
|
||||
;; used in sanity check report
|
||||
:rpt-pass-prompt "And again" ;; text of the new password widget prompt on the change
|
||||
;; password and edit user pages
|
||||
:save-prompt "When you have finished editing"
|
||||
|
|
@ -94,6 +117,17 @@
|
|||
:save-label "Save!" ;; text of the save widget itself
|
||||
:save-user-fail "Failed to store user"
|
||||
:save-user-success "Successfully stored user"
|
||||
:see-documentation "For more information please see documentation "
|
||||
;; used in sanity check report
|
||||
:smeagol-not-initialised
|
||||
"Smeagol is not initialised correctly"
|
||||
;; title of the sanity check report
|
||||
:smeagol-misconfiguration
|
||||
"Smeagol has been unable to find some of the resources on which it depends,
|
||||
possibly because of misconfiguration or missing environment variables."
|
||||
;; used in sanity check report
|
||||
:user-lacks-field "User record in the passwd file lacks a field"
|
||||
;; used in sanity check report
|
||||
:username-prompt "Username" ;; text of the username widget prompt on edit user page
|
||||
;; text of the is admin widget prompt on edit user page
|
||||
:user-title-prefix "Edit user" ;; prefix for title of edit user page
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ del {
|
|||
color: red;
|
||||
}
|
||||
|
||||
div.content, form, p, pre, h1, h2, h3, h4, h5 {
|
||||
div.content, div.error, div.message, form, p, pre, h1, h2, h3, h4, h5 {
|
||||
padding: 0.1em 5% 0 5%;
|
||||
}
|
||||
|
||||
|
|
@ -42,6 +42,14 @@ dl, menu, ol, table, ul {
|
|||
margin: 0.25em 5%;
|
||||
}
|
||||
|
||||
dt {
|
||||
font-weight: bold;
|
||||
}
|
||||
|
||||
dd {
|
||||
font-style: italic;
|
||||
}
|
||||
|
||||
/* footer of the page - not-editable, provided by Smeagol */
|
||||
footer {
|
||||
border-top: thin solid gray;
|
||||
|
|
|
|||
|
|
@ -2,7 +2,8 @@
|
|||
:author "Simon Brooke"}
|
||||
smeagol.configuration
|
||||
(:require [environ.core :refer [env]]
|
||||
[noir.io :as io]))
|
||||
[noir.io :as io]
|
||||
[taoensso.timbre :as timbre]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;
|
||||
|
|
@ -49,4 +50,5 @@
|
|||
(try
|
||||
(read-string (slurp config-file-path))
|
||||
(catch Exception any
|
||||
(throw (Exception. "Could not load configuration" any)))))
|
||||
(timbre/error "Could not load configuration" any)
|
||||
{})))
|
||||
|
|
|
|||
|
|
@ -1,9 +1,13 @@
|
|||
(ns ^{:doc "Functions related to sanity checks and error reporting in conditions where the environment may not be sane."
|
||||
:author "Simon Brooke"}
|
||||
smeagol.sanity
|
||||
(:import (java.util Locale))
|
||||
(:require [clojure.java.io :as cjio]
|
||||
[clojure.string :as string]
|
||||
[hiccup.core :refer [html]]
|
||||
[smeagol.configuration :refer [config]]
|
||||
[scot.weft.i18n.core :as i18n]
|
||||
[smeagol.authenticate :refer [password-file-path]]
|
||||
[smeagol.configuration :refer [config-file-path config]]
|
||||
[smeagol.util :as util]
|
||||
[taoensso.timbre :as timbre]))
|
||||
|
||||
|
|
@ -30,47 +34,197 @@
|
|||
;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
;; The general idea behind the 'check-' functions in this file is that, if the
|
||||
;; check passes, they return true; if it fails, they return a map of problems found.
|
||||
;; the map comprises keys bound to 'explanation' lists of keywords and strings. If
|
||||
;; internationalisation is available, the keywords will then be translated into
|
||||
;; localised strings for presentation to the user; but if it isn't available,
|
||||
;; the keywords need to be human readable. Sanity checking ought to work even
|
||||
;; when the installation is quite badly broken.
|
||||
|
||||
(defn check-exists
|
||||
"Check this `path` exists. If so, return `true`; if not, return a map
|
||||
containing this `problem-key` bound to a list explaining the problem."
|
||||
[path problem-key]
|
||||
(if-not
|
||||
(.exists (cjio/as-file path))
|
||||
{problem-key (list :file-or-directory path :does-not-exist)}
|
||||
true))
|
||||
|
||||
|
||||
(defn check-is-dir
|
||||
"Check this `path` is a directory. If so, return `true`; if not, return a map
|
||||
containing this `problem-key` bound to a list explaining the problem."
|
||||
[path problem-key]
|
||||
(if-not
|
||||
(.isDirectory (cjio/as-file path))
|
||||
{problem-key (list :file-or-directory path :is-not-directory)}
|
||||
true))
|
||||
|
||||
|
||||
(defn check-can-write
|
||||
"Check this `path` is writable. If so, return `true`; if not, return a map
|
||||
containing this `problem-key` bound to a list explaining the problem."
|
||||
[path problem-key]
|
||||
(if-not
|
||||
(.canWrite (cjio/as-file path))
|
||||
{problem-key (list :file-or-directory path :is-not-writable)}
|
||||
true))
|
||||
|
||||
|
||||
(defn check-can-read
|
||||
"Check this `path` is readable. If so, return `true`; if not, return a map
|
||||
containing this `problem-key` bound to a list explaining the problem."
|
||||
[path problem-key]
|
||||
(if-not
|
||||
(.canRead (cjio/as-file path))
|
||||
{problem-key (list :file-or-directory path :is-not-readable)}
|
||||
true))
|
||||
|
||||
|
||||
(defn check-with-protection
|
||||
"Apply this `check` to this `path` and `problem-key`; if no exception is thrown, return
|
||||
the result. If an exception is thrown, return a map comprising a problem-key bound to
|
||||
an explanation which includes the exception."
|
||||
[check problem-key & args]
|
||||
(try
|
||||
(apply check args)
|
||||
(catch Exception ex
|
||||
{problem-key (list problem-key args ex)})))
|
||||
|
||||
|
||||
(defn compound-check-results
|
||||
[& results]
|
||||
(let [problems (remove true? results)]
|
||||
(if (empty? problems) true (apply merge problems))))
|
||||
|
||||
|
||||
(defn check-can-read-and-write
|
||||
"Check this `path` is both readable and writable. If so, return `true`;
|
||||
if not, return a map containing this `problem-key` bound to a list explaining
|
||||
the problem."
|
||||
[path problem-key]
|
||||
(compound-check-results
|
||||
(check-with-protection check-exists :file-or-directory path (keyword (str (name problem-key) "-exists")))
|
||||
(check-with-protection check-can-read :file-or-directory path (keyword (str (name problem-key) "-can-read")))
|
||||
(check-with-protection check-can-write :file-or-directory path (keyword (str (name problem-key) "-can-write")))))
|
||||
|
||||
|
||||
(defn check-content-dir
|
||||
"Check that the content directory exists and is populated. Throw exception
|
||||
if not."
|
||||
[]
|
||||
(try
|
||||
(let [directory (cjio/as-file util/content-dir)]
|
||||
(if
|
||||
(.isDirectory directory)
|
||||
true
|
||||
(throw (Exception. (str "Content directory '" util/content-dir "' is not a directory"))))
|
||||
(if
|
||||
(.canWrite directory)
|
||||
true
|
||||
(throw (Exception. (str "Content directory '" util/content-dir "' is not writable")))))
|
||||
(catch Exception any
|
||||
(throw (Exception. (str "Content directory '" util/content-dir "' does not exist") any))))
|
||||
(try
|
||||
(doall
|
||||
"Check that `path` exists and is populated as a valid content directory. Return true
|
||||
if so, else a map of all problems found. If `path` is not supplied, default to the
|
||||
configured content directory."
|
||||
([path]
|
||||
(compound-check-results
|
||||
(check-with-protection check-exists :file-or-directory path :content-dir-exists)
|
||||
(check-with-protection check-is-dir :file-or-directory path :content-dir-is-dir)
|
||||
(check-can-read-and-write path :content-dir)
|
||||
(apply compound-check-results
|
||||
(map
|
||||
#(let
|
||||
[path (cjio/file util/content-dir %)]
|
||||
(timbre/info "Checking the existence of " path)
|
||||
(slurp path))
|
||||
["_side-bar.md" "_edit-side-bar.md" "_header.md"]))
|
||||
(timbre/info "Content directory '" util/content-dir "' check completed.")
|
||||
(catch Exception any
|
||||
(throw (Exception. (str "Content directory '" util/content-dir "' is not initialised") any)))))
|
||||
#(check-can-read-and-write
|
||||
(cjio/file path (str "_" % ".md"))
|
||||
%)
|
||||
["side-bar" "edit-side-bar" "header" ]))))
|
||||
([]
|
||||
(check-content-dir util/content-dir)))
|
||||
|
||||
|
||||
(defn- raw-sanity-check-installation
|
||||
"Actually do the sanity check."
|
||||
[]
|
||||
(timbre/info "Running sanity check")
|
||||
(check-content-dir)
|
||||
(config :test)
|
||||
(timbre/info "Sanity check completed"))
|
||||
(defn check-password-member-field
|
||||
"Check that this `member` map, expected to be an entry from the passwd
|
||||
file whose key was `user-key`, has this `field` and if not return a
|
||||
problem explanation with this `problem-key`."
|
||||
[member field user-key problem-key]
|
||||
(if
|
||||
(and (map? member) (member field))
|
||||
true
|
||||
{problem-key (list :user-lacks-field user-key field)}))
|
||||
|
||||
|
||||
;;; We memoise the sanity check so that although it is called for every wiki
|
||||
;;; page, it is only actually evaluated once.
|
||||
(def sanity-check-installation (memoize raw-sanity-check-installation))
|
||||
(defn check-password-member
|
||||
"Check that this `member` map, expected to be an entry from the passwd
|
||||
file whose key was `user-key`, has all the required fields and if not
|
||||
return a problem explanation with this `problem-key`."
|
||||
[member user-key problem-key]
|
||||
(apply
|
||||
compound-check-results
|
||||
(map
|
||||
#(check-password-member-field
|
||||
member
|
||||
%
|
||||
user-key
|
||||
(keyword
|
||||
(string/join
|
||||
"-"
|
||||
(list
|
||||
(name problem-key)
|
||||
(name user-key)
|
||||
(name %)))))
|
||||
[:email :password])))
|
||||
|
||||
|
||||
(defn check-password-members
|
||||
"Check that all entries in this `passwd-content` have the required fields."
|
||||
[passwd-content]
|
||||
(apply
|
||||
compound-check-results
|
||||
(map
|
||||
#(check-password-member (passwd-content %) % :missing-field)
|
||||
(keys passwd-content))))
|
||||
|
||||
|
||||
(defn check-at-least-one-admin
|
||||
"Check that there is at least one user in this `passwd-content` who has
|
||||
`:admin` set to `true`."
|
||||
[passwd-content]
|
||||
(if
|
||||
(empty?
|
||||
(remove
|
||||
nil?
|
||||
(map
|
||||
#(:admin (passwd-content %))
|
||||
(keys passwd-content))))
|
||||
{:no-admin-users '(:no-admin-users)}
|
||||
true))
|
||||
|
||||
|
||||
(defn check-password-file
|
||||
"Check that the file at this `path` is a valid passwd file."
|
||||
[path]
|
||||
(let [content (read-string (slurp path))]
|
||||
(compound-check-results
|
||||
(check-can-read-and-write path :password-file)
|
||||
(check-password-members content)
|
||||
(check-at-least-one-admin content))))
|
||||
|
||||
|
||||
(defn check-config
|
||||
"Check that the file at this `path` is a valid configuration file"
|
||||
[path]
|
||||
(let [content (try
|
||||
(read-string (slurp path))
|
||||
(catch Exception any {}))]
|
||||
(compound-check-results
|
||||
(check-with-protection check-exists :file-or-directory path :config-exists)
|
||||
(check-with-protection check-can-read :file-or-directory path :config-can-read)
|
||||
(if-not
|
||||
(:site-title content)
|
||||
{:site-title-not-configured :site-title-not-configured}
|
||||
true)
|
||||
(if-not
|
||||
(:default-locale content)
|
||||
{:default-locale-not-configured :default-locale-not-configured}
|
||||
true))))
|
||||
|
||||
|
||||
(defn check-everything
|
||||
([content-dir config-path passwd-path]
|
||||
(compound-check-results
|
||||
(check-content-dir content-dir)
|
||||
(check-config config-path)
|
||||
(check-password-file passwd-path)))
|
||||
([]
|
||||
(check-everything util/content-dir config-file-path password-file-path)))
|
||||
|
||||
|
||||
(defn- get-causes
|
||||
|
|
@ -82,6 +236,148 @@
|
|||
'()))
|
||||
|
||||
|
||||
;; ExplanationPart is a protocol for ensuring that everything which may form part of a
|
||||
;; problem explanation can be formatted into hiccup, so that it can be converted by
|
||||
;; hiccup into HTML. The reason for using Hiccup rather than Selmer is that in
|
||||
;; sanity check I don't want to be dependent on the existance of templates.
|
||||
;; (Also, I personally like Hiccup better, although I know it's too geeky for most
|
||||
;; people)
|
||||
(defprotocol ExplanationPart
|
||||
"things which may be parts of explanations need mechanisms for reducing
|
||||
themselves to natural language where possible"
|
||||
(as-hiccup [this dictionary] "Return `this` as a hiccup-formatted structure."))
|
||||
|
||||
(extend-protocol ExplanationPart
|
||||
nil
|
||||
(as-hiccup [this dictionary] "")
|
||||
|
||||
clojure.lang.Keyword
|
||||
(as-hiccup [this dictionary] (str (or (this dictionary)(string/replace (name this) "-" " ")) " "))
|
||||
|
||||
clojure.lang.PersistentList
|
||||
(as-hiccup [this dictionary] (apply vector (cons :div (map #(as-hiccup % dictionary) this))))
|
||||
|
||||
clojure.lang.PersistentVector
|
||||
(as-hiccup [this dictionary] (apply vector (cons :div (map #(as-hiccup % dictionary) this))))
|
||||
|
||||
clojure.lang.PersistentArrayMap
|
||||
(as-hiccup [this dictionary]
|
||||
(apply
|
||||
vector
|
||||
(cons
|
||||
:dl
|
||||
(map
|
||||
#(list [:dt (as-hiccup % dictionary)]
|
||||
[:dd (as-hiccup (this %) dictionary)])
|
||||
(keys this)))))
|
||||
|
||||
clojure.lang.PersistentHashMap
|
||||
(as-hiccup [this dictionary]
|
||||
(apply
|
||||
vector
|
||||
(cons
|
||||
:dl
|
||||
(map
|
||||
#(list [:dt (as-hiccup % dictionary)]
|
||||
[:dd (as-hiccup (this %) dictionary)])
|
||||
(keys this)))))
|
||||
|
||||
java.lang.String
|
||||
(as-hiccup [this dictionary] (str this " "))
|
||||
|
||||
java.lang.StackTraceElement
|
||||
(as-hiccup [this dictionary]
|
||||
[:li this])
|
||||
|
||||
java.lang.Exception
|
||||
(as-hiccup [this dictionary]
|
||||
;; OK, this is the interesting one
|
||||
(apply
|
||||
vector
|
||||
(cons
|
||||
:div
|
||||
(cons
|
||||
{:class "sanity-exception"}
|
||||
(map
|
||||
(fn [x]
|
||||
[:div
|
||||
{:class "sanity-cause"}
|
||||
(.getMessage x)
|
||||
[:div {:class "sanity-stacktrace"}
|
||||
(apply
|
||||
vector
|
||||
(cons
|
||||
:ol
|
||||
(map
|
||||
as-hiccup
|
||||
(.getStackTrace x)
|
||||
dictionary)))]])
|
||||
(get-causes this))))))
|
||||
java.lang.Object
|
||||
(as-hiccup [this dictionary] (str this " ")))
|
||||
|
||||
|
||||
(defn sanity-check-report
|
||||
[problems]
|
||||
(let [locale (Locale/getDefault)
|
||||
locale-specifier (str (.getLanguage locale) "-" (.getCountry locale))
|
||||
messages (try
|
||||
(i18n/get-messages locale-specifier "i18n" "en-GB")
|
||||
(catch Exception any {}))]
|
||||
(html
|
||||
[:html
|
||||
[:head
|
||||
[:title (as-hiccup :smeagol-not-initialised messages)]
|
||||
[:link {:href "/content/stylesheet.css" :rel "stylesheet"}]]
|
||||
[:body
|
||||
[:header
|
||||
[:div {:id "nav"} " "]
|
||||
[:h1 (as-hiccup :smeagol-not-initialised messages)]
|
||||
[:p " "]]
|
||||
[:div {:id "error" :class "error"}
|
||||
[:div {:class "error"}
|
||||
(as-hiccup [(count (keys problems)) :problems-found] messages)]]
|
||||
[:div {:id "main-container" :class "sanity-check-report"}
|
||||
[:p (as-hiccup :smeagol-misconfiguration messages)]
|
||||
(as-hiccup problems messages)
|
||||
[:p (as-hiccup :see-documentation messages)
|
||||
[:a
|
||||
{:href
|
||||
"https://github.com/journeyman-cc/smeagol/blob/develop/resources/public/content/Deploying%20Smeagol.md"}
|
||||
(as-hiccup :here messages)]]]
|
||||
[:footer
|
||||
[:div {:id "credits"}
|
||||
[:div
|
||||
[:img {:height "16" :width "16" :alt "one wiki to rule them all" :src "img/smeagol.png"}]
|
||||
" One Wiki to rule them all || Smeagol wiki engine || "
|
||||
[:img
|
||||
{:height "16" :width "16"
|
||||
:alt "The Web Engineering Factory & Toolworks"
|
||||
:src "http://www.weft.scot/images/weft.logo.64.png"}]
|
||||
" Developed by "
|
||||
[:a {:href "http://www.weft.scot/"}"WEFT"]]]]]])))
|
||||
|
||||
|
||||
(defn- raw-sanity-check-installation
|
||||
"Actually do the sanity check."
|
||||
[]
|
||||
(timbre/info "Running sanity check")
|
||||
(let [result (check-everything)]
|
||||
(if
|
||||
(map? result)
|
||||
(do
|
||||
(timbre/warn "Sanity check completed; " (count (keys result)) " problem(s) found")
|
||||
(sanity-check-report result))
|
||||
(do
|
||||
(timbre/info "Sanity check completed; no problem(s) found")
|
||||
nil))))
|
||||
|
||||
|
||||
;; We memoise the sanity check so that although it is called for every wiki
|
||||
;; page, it is only actually evaluated once.
|
||||
(def sanity-check-installation (memoize raw-sanity-check-installation))
|
||||
|
||||
|
||||
(defn show-sanity-check-error
|
||||
"Generate an error page in a way which should work even when everything else is broken.
|
||||
If no argument is passed, run the sanity check and if it fails return page contents;
|
||||
|
|
@ -103,10 +399,10 @@
|
|||
(cons :ol
|
||||
(map #(vector :li (.getMessage %))
|
||||
(get-causes error))))
|
||||
[:p "For more information please see documentation "
|
||||
[:p :see-documentation
|
||||
[:a {:href "https://github.com/journeyman-cc/smeagol/blob/develop/resources/public/content/Deploying%20Smeagol.md"} "here"]]]]))
|
||||
([]
|
||||
(try
|
||||
(sanity-check-installation)
|
||||
nil
|
||||
(catch Exception any (show-sanity-check-error any)))))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue