Tidy-up and robustness; no major functional change.

project.clj

@@ -8,9 +8,7 @@
                  [com.cemerick/url "0.1.1"]
                  [com.fzakaria/slf4j-timbre "0.3.7"]
                  [com.taoensso/encore "2.92.0"]
-                 [com.cemerick/url "0.1.1"]
                  [com.taoensso/timbre "4.10.0"]
-                 [com.fzakaria/slf4j-timbre "0.3.7"]
                  [com.taoensso/tower "3.0.2" :exclusions [com.taoensso/encore]]
                  [crypto-password "0.2.0"]
                  [environ "1.1.0"]

resources/passwd

@@ -1 +1 @@
-{:admin {:admin true, :email "info@weft.scot", :password "admin"}, :jenny {:email "jenny@auchencairn.org", :admin false, :password "$s0$f0801$1uniQfftB37G5e5GklJANQ==$kQ0+/YcCuaz2x5iYjwhNlDlnWX/exE/8pSC+R4C0WvQ="}}
+{:admin {:admin true, :email "info@weft.scot", :password "admin"}}

resources/public/content/stylesheet.css

@@ -265,6 +265,14 @@ th {
   padding: 0 2em 0 0;
 }
 
+.sanity-cause .sanity-stacktrace {
+  display: none;
+}
+
+.sanity-cause:hover .sanity-stacktrace {
+  display: block;
+}
+
 .vega-bindings, .vega-actions {
   font-size: 66%;
 }

src/smeagol/authenticate.clj

@@ -38,7 +38,7 @@
 (def password-file-path
   (or
     (env :smeagol-passwd)
-    (str (clojure.java.io/resource "passwd"))))
+    (str (io/resource-path) "../passwd")))
 
 
 (defn- get-users
@@ -112,7 +112,7 @@
         (timbre/info (str "Successfully changed password for user " username))
           true))
       (catch Exception any
-        (timbre/error
+        (timbre/error any
           (format "Changing password failed for user %s failed: %s (%s)"
                   username (.getName (.getClass any)) (.getMessage any)))
         false))))
@@ -162,7 +162,7 @@
                (timbre/info  "Successfully added user " username)
                true)
              (catch Exception any
-               (timbre/error
+               (timbre/error any
                  (format "Adding user %s failed: %s (%s)"
                          username (.getName (.getClass any)) (.getMessage any)))
                false)))))
@@ -179,7 +179,7 @@
         (timbre/info (str "Successfully deleted user " username))
         true)
       (catch Exception any
-        (timbre/error
+        (timbre/error any
           (format "Deleting user %s failed: %s (%s)"
                   username (.getName (.getClass any)) (.getMessage any)))
         false))))

src/smeagol/configuration.clj

@@ -37,7 +37,6 @@
 ;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-
 (def config-file-path
   "The relative path to the config file."
   (or
@@ -50,5 +49,5 @@
   (try
     (read-string (slurp config-file-path))
     (catch Exception any
-      (timbre/error "Could not load configuration" any)
+      (timbre/error any "Could not load configuration")
       {})))

src/smeagol/handler.clj

@@ -76,7 +76,7 @@
     (timbre/info "\n-=[ smeagol started successfully"
                  (when (env :dev) "using the development profile") "]=-")
     (catch Exception any
-      (timbre/error "Failure during startup" any)
+      (timbre/error any "Failure during startup")
       (destroy))))
 
 ;; timeout sessions after 30 minutes

src/smeagol/routes/admin.clj

@@ -98,7 +98,7 @@
                                :details details
                                :users (auth/list-users)})))
       (catch Exception any
-        (timbre/error (.getMessage any))
+        (timbre/error any)
         (layout/render "edit-user.html"
                        (merge (util/standard-params request)
                               {:title (str (:edit-title-prefix (util/get-messages request)) " " (:target params))

src/smeagol/routes/wiki.clj

@@ -45,13 +45,6 @@
 ;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-
-(defn get-git-repo
-  "Get the git repository for my content, creating it if necessary"
-  []
-  (hist/load-or-init-repo util/content-dir))
-
-
 (defn process-source
   "Process `source-text` and save it to the specified `file-path`, committing it
   to Git and finally redirecting to wiki-page."
@@ -61,7 +54,7 @@
         file-name (str page suffix)
         file-path (cjio/file util/content-dir file-name)
         exists? (.exists (cjio/as-file file-path))
-        git-repo (get-git-repo)
+        git-repo (hist/load-or-init-repo util/content-dir)
         user (session/get :user)
         email (auth/get-email user)
         summary (format "%s: %s" user (or (:summary params) "no summary"))]
@@ -157,7 +150,7 @@
   [request]
   (let [params (keywordize-keys (:params request))
         data-path (str (io/resource-path) "/content/uploads/")
-        git-repo (get-git-repo)
+        git-repo (hist/load-or-init-repo util/content-dir)
         upload (:upload params)
         uploaded (if upload (ul/store-upload params data-path))
         user (session/get :user)

src/smeagol/sanity.clj

@@ -252,13 +252,28 @@
   (as-hiccup [this dictionary] "")
 
   clojure.lang.Keyword
-  (as-hiccup [this dictionary]  (str (or (this dictionary)(string/replace (name this) "-" " ")) " "))
+  (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))))
+  (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))))
+  (as-hiccup [this dictionary]
+             (apply
+               vector
+               (cons
+                 :div
+                 (map #(as-hiccup % dictionary) this))))
 
   clojure.lang.PersistentArrayMap
   (as-hiccup [this dictionary]
@@ -296,66 +311,94 @@
                vector
                (cons
                  :div
-                     (cons
+                 (cons
-                       {:class "sanity-exception"}
+                   {:class "sanity-exception"}
-              (map
+                   (map
-                (fn [x]
+                     (fn [x]
-                  [:div
+                       [:div
-                   {:class "sanity-cause"}
+                        {:class "sanity-cause"}
-                   (.getMessage x)
+                        [:h2 (.getMessage x)]
-                   [:div {:class "sanity-stacktrace"}
+                        [:div {:class "sanity-stacktrace"}
-                    (apply
+                         (apply
-                      vector
+                           vector
-                      (cons
+                           (cons
-                        :ol
+                             :ol
-                        (map
+                             (map
-                          as-hiccup
+                               as-hiccup
-                          (.getStackTrace x)
+                               (.getStackTrace x)
-                          dictionary)))]])
+                               dictionary)))]])
-                (get-causes this))))))
+                     (get-causes this))))))
   java.lang.Object
   (as-hiccup [this dictionary] (str this " ")))
 
 
-(defn sanity-check-report
+(defn get-locale-messages
-  [problems]
+  "Get messages for the server-side locale."
+  []
   (let [locale (Locale/getDefault)
-        locale-specifier (str (.getLanguage locale) "-" (.getCountry locale))
+        locale-specifier (str (.getLanguage locale) "-" (.getCountry locale))]
-        messages (try
+    (try
-                   (i18n/get-messages locale-specifier "i18n" "en-GB")
+      (i18n/get-messages locale-specifier "i18n" "en-GB")
-                   (catch Exception any {}))]
+      (catch Exception any {}))))
+
+
+;; Prepackaged hiccup sub-units
+(defn as-hiccup-head
+  [messages]
+  [:head
+   [:title (as-hiccup :smeagol-not-initialised messages)]
+   [:link {:href "/content/stylesheet.css" :rel "stylesheet"}]])
+
+
+(defn as-hiccup-header
+  [messages]
+  [:header
+   [:div {:id "nav"} " "]
+   [:h1 (as-hiccup :smeagol-not-initialised messages)]
+   [:p " "]])
+
+
+(defn as-hiccup-see-doc
+  [messages]
+  [:p (as-hiccup :see-documentation messages)
+   [:a
+    {:href
+     "https://github.com/journeyman-cc/smeagol/wiki/Deploying-Smeagol"}
+    (as-hiccup :here messages)] "."])
+
+
+(defn as-hiccup-footer
+  [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 sanity-check-report
+  "Convert this `problem` report into a nicely formatted HTML page"
+  [problems]
+  (let [messages (get-locale-messages)]
     (html
       [:html
-       [:head
+       (as-hiccup-head messages)
-        [:title (as-hiccup :smeagol-not-initialised messages)]
-        [:link {:href "/content/stylesheet.css" :rel "stylesheet"}]]
        [:body
-        [:header
+        (as-hiccup-header messages)
-         [:div {:id "nav"} " "]
+        [:div {:id "error"}
-         [:h1 (as-hiccup :smeagol-not-initialised messages)]
+         [:p {:class "error"}
-         [:p " "]]
+          (rest (as-hiccup [(count (keys problems)) :problems-found] messages))]]
-        [: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)
+         (as-hiccup-see-doc messages)]
-          [:a
+        (as-hiccup-footer messages)]])))
-           {:href
-            "https://github.com/journeyman-cc/smeagol/blob/master/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
@@ -383,26 +426,26 @@
   If no argument is passed, run the sanity check and if it fails return page contents;
   if `error` is passed, just return page content describing the error."
   ([error]
-   (html
+   (let [messages (get-locale-messages)]
-     [:html
+     (html
-      [:head
+       [:html
-       [:title "Smeagol is not initialised correctly"]
+        (as-hiccup-head messages)
-       [:link {:href "/content/stylesheet.css" :rel "stylesheet"}]]
+        [:body
-      [:body
+         (as-hiccup-header messages)
-       [:header
+         [:div {:id "error"}
-        [:h1 "Smeagol is not initialised correctly"]]
+          [:p {:class "error"} (.getMessage error)]]
-       [:div {:id "error"}
+         [:div {:id "main-container" :class "sanity-check-report"}
-        [:p {:class "error"} (.getMessage error)]]
+          [:p  (as-hiccup :smeagol-misconfiguration messages)]
-       [:p "There was a problem launching Smeagol probably because of misconfiguration:"]
+          (as-hiccup error messages)
-       (apply
+          (as-hiccup-see-doc messages)]
-         vector
+         (as-hiccup-footer messages)]])))
-         (cons :ol
-               (map #(vector :li (.getMessage %))
-                    (get-causes error))))
-       [:p :see-documentation
-        [:a {:href "https://github.com/journeyman-cc/smeagol/blob/develop/resources/public/content/Deploying%20Smeagol.md"} "here"]]]]))
   ([]
    (try
      (sanity-check-installation)
-     (catch Exception any (show-sanity-check-error any)))))
+     (catch Exception any
+       (timbre/error any "Failure during sanity check")
+       (show-sanity-check-error any)))))
+
+(show-sanity-check-error (Exception. "That's insane!"))
+
 

src/smeagol/util.clj

@@ -8,7 +8,8 @@
             [scot.weft.i18n.core :as i18n]
             [smeagol.authenticate :as auth]
             [smeagol.configuration :refer [config]]
-            [smeagol.formatting :refer [md->html]]))
+            [smeagol.formatting :refer [md->html]]
+            [taoensso.timbre :as timbre]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;
@@ -55,12 +56,19 @@
   "Return the most acceptable messages collection we have given the
   `Accept-Language` header in this `request`."
   [request]
-  (merge
+  (let [specifier ((:headers request) "accept-language")
-    (i18n/get-messages
+        messages (try
-      ((:headers request) "accept-language")
+                   (i18n/get-messages specifier "i18n" "en-GB")
-      "i18n"
+                   (catch Exception any
-      "en-GB")
+                     (timbre/error
-    config))
+                       any
+                       (str
+                         "Failed to parse accept-language header "
+                         specifier))
+                     {}))]
+    (merge
+      messages
+      config)))
 
 
 (def get-messages (memoize raw-get-messages))