Developed by 
Developed by - {% i18n sortable %} -
-| {% i18n user-title-prefix %} | -{% i18n edit-col-hdr %} | -{% i18n del-col-hdr %} | +||||||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| {% i18n edit-col-hdr %} | {% i18n del-col-hdr %} | |
|---|---|---|
| {% i18n del-col-hdr %} {{user}} | ||
| {% i18n add-user-label %} | +||
| {% i18n add-user-label %} | ++ | |
-
-
-
-
-
-{% endblock %}
diff --git a/resources/templates/upload.html b/resources/templates/upload.html
index 3e63f17..a91865e 100644
--- a/resources/templates/upload.html
+++ b/resources/templates/upload.html
@@ -1,27 +1,22 @@
{% extends "templates/base.html" %}
{% block content %}
- {% i18n sortable %} -
-| Name | -Uploaded | -Type this | -To get this | -
|---|---|---|---|
| {{entry.base-name}} | -{{entry.modified}} | -- {% if entry.is-image %}  {% else %} [{{entry.name|capitalize}}](uploads/{{entry.resource}}) {% endif %} - | -
- {% if entry.is-image %} |
-
- {% if uploaded|not-empty %}
- {% for upload in uploaded %}
- {% if upload.is-image %}
-
-
- {% endfor %} +
{% endblock %}
diff --git a/resources/templates/wiki.html b/resources/templates/wiki.html
index 81634ea..0a4b1ec 100644
--- a/resources/templates/wiki.html
+++ b/resources/templates/wiki.html
@@ -1,10 +1,15 @@
{% extends "templates/base.html" %}
{% block extra-headers %}
- {% for script in scripts %}
- {% endfor %}
- {% for style in styles %}
- {% endfor %}
+ {% style "vendor/mermaid/dist/mermaid.css" %}
+
+
+ {% script "vendor/vega-lite/build/vega-lite.js" %}
+
+
+ {% script "vendor/mermaid/dist/mermaid.js" %}
{% endblock %}
{% block content %}
diff --git a/resources/test/test_extension.md b/resources/test/test_extension.md
deleted file mode 100644
index 1f43160..0000000
--- a/resources/test/test_extension.md
+++ /dev/null
@@ -1,7 +0,0 @@
-# This is a test
-
-```test
-the quick brown fox jumped over the lazy dog
-```
-
-This concludes the test.
diff --git a/resources/test/test_local_links.md b/resources/test/test_local_links.md
deleted file mode 100644
index 659f03a..0000000
--- a/resources/test/test_local_links.md
+++ /dev/null
@@ -1,6 +0,0 @@
-# This is a test
-
-[[Local link]]
-[Not a local link](http://nowhere.at.al)
-
-This concludes the test.
diff --git a/resources/translations.edn b/resources/translations.edn
deleted file mode 100644
index e69de29..0000000
diff --git a/src/smeagol/authenticate.clj b/src/smeagol/authenticate.clj
index 02cf57b..e4219e9 100644
--- a/src/smeagol/authenticate.clj
+++ b/src/smeagol/authenticate.clj
@@ -5,7 +5,7 @@
[environ.core :refer [env]]
[noir.io :as io]
[smeagol.configuration :refer [config]]
- [taoensso.timbre :as log]))
+ [taoensso.timbre :as timbre]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
@@ -37,8 +37,6 @@
;; the relative path to the password file.
(def password-file-path
- "Path to the password file."
- ;; TODO: portability; elegance. Not very happy with this.
(or
(:passwd config)
(str (io/resource-path) "../passwd")))
@@ -54,7 +52,7 @@
"Return `true` if this `username`/`password` pair match, `false` otherwise"
[username password]
(let [user ((keyword username) (get-users))]
- (log/info (str "Authenticating " username " against " password-file-path))
+ (timbre/info (str "Authenticating " username " against " password-file-path))
(and user
(:password user)
(or
@@ -94,7 +92,7 @@
Return `true` if password was successfully changed. Subsequent to user change, their
password will be encrypted."
[username oldpass newpass]
- (log/info (format "Changing password for user %s" username))
+ (timbre/info (format "Changing password for user %s" username))
(let [users (get-users)
keywd (keyword username)
user (keywd users)
@@ -112,10 +110,10 @@
{keywd
(merge user
{:password (password/encrypt newpass)})})))
- (log/info (str "Successfully changed password for user " username))
+ (timbre/info (str "Successfully changed password for user " username))
true))
(catch Exception any
- (log/error any
+ (timbre/error any
(format "Changing password failed for user %s failed: %s (%s)"
username (.getName (.getClass any)) (.getMessage any)))
false))))
@@ -140,7 +138,7 @@
`email` address and `admin` flag; *or*, modify an existing user. Return true
if user is successfully stored, false otherwise."
[username newpass email admin]
- (log/info "Trying to add user " username)
+ (timbre/info "Trying to add user " username)
(cond
(not (string? username)) (throw (Exception. "Username must be a string."))
(zero? (count username)) (throw (Exception. "Username cannot be zero length"))
@@ -162,10 +160,10 @@
(locking password-file-path
(spit password-file-path
(assoc users (keyword username) (merge user full-details)))
- (log/info "Successfully added user " username)
+ (timbre/info "Successfully added user " username)
true)
(catch Exception any
- (log/error any
+ (timbre/error any
(format "Adding user %s failed: %s (%s)"
username (.getName (.getClass any)) (.getMessage any)))
false)))))
@@ -179,10 +177,10 @@
(locking password-file-path
(spit password-file-path
(dissoc users (keyword username)))
- (log/info (str "Successfully deleted user " username))
+ (timbre/info (str "Successfully deleted user " username))
true)
(catch Exception any
- (log/error any
+ (timbre/error any
(format "Deleting user %s failed: %s (%s)"
username (.getName (.getClass any)) (.getMessage any)))
false))))
diff --git a/src/smeagol/configuration.clj b/src/smeagol/configuration.clj
index 469f338..f4631f9 100644
--- a/src/smeagol/configuration.clj
+++ b/src/smeagol/configuration.clj
@@ -5,7 +5,7 @@
[clojure.string :as s]
[environ.core :refer [env]]
[noir.io :as io]
- [taoensso.timbre :as log]))
+ [taoensso.timbre :as timbre]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
@@ -73,7 +73,7 @@
and optionally a key :transform, whose value is a function of one
argument to be used to transform the value of that key."
[m tuples]
- (log/debug
+ (timbre/debug
"transform-map:\n"
(with-out-str (clojure.pprint/pprint m)))
(reduce
@@ -100,52 +100,38 @@
'( {:from :smeagol-content-dir :to :content-dir}
{:from :smeagol-default-locale :to :default-locale}
{:from :smeagol-formatters :to :formatters :transform read-string}
- {:from :smeagol-js-from :to :extensions-from :transform to-keyword}
{:from :smeagol-log-level :to :log-level :transform to-keyword}
{:from :smeagol-passwd :to :passwd}
{:from :smeagol-site-title :to :site-title}))
-(def build-config
+(defn build-config
+ []
"The actual configuration, as a map. The idea here is that the config
file is read (if it is specified and present), but that individual
values can be overridden by environment variables."
- (memoize (fn []
- (try
- (log/info (str "Reading configuration from " config-file-path))
- (let [file-contents (try
- (read-string (slurp config-file-path))
- (catch Exception x
- (log/error
- (str
- "Failed to read configuration from "
- config-file-path
- " because: "
- (type x)
- "; "
- (.getMessage x)))
- {}))
- config (merge
- file-contents
- (transform-map
- (from-env-vars
- :smeagol-content-dir
- :smeagol-default-locale
- :smeagol-formatters
- :smeagol-js-from
- :smeagol-log-level
- :smeagol-passwd
- :smeagol-site-title)
- config-env-transforms))]
- (if (env :dev)
- (log/debug
- "Loaded configuration\n"
- (with-out-str (clojure.pprint/pprint config))))
- config)
- (catch Exception any
- (log/error any "Could not load configuration")
- {})))))
+ (try
+ (let [file-contents (try
+ (read-string (slurp config-file-path))
+ (catch Exception _ {}))
+ config (merge
+ file-contents
+ (transform-map
+ (from-env-vars
+ :smeagol-content-dir
+ :smeagol-default-locale
+ :smeagol-formatters
+ :smeagol-log-level
+ :smeagol-passwd
+ :smeagol-site-title)
+ config-env-transforms))]
+ (if (env :dev)
+ (timbre/debug
+ "Loaded configuration\n"
+ (with-out-str (clojure.pprint/pprint config))))
+ config)
+ (catch Exception any
+ (timbre/error any "Could not load configuration")
+ {})))
-(def config
- "The actual configuration, as a map."
- (build-config))
+(def config (build-config))
diff --git a/src/smeagol/extensions/mermaid.clj b/src/smeagol/extensions/mermaid.clj
deleted file mode 100644
index 6185b5d..0000000
--- a/src/smeagol/extensions/mermaid.clj
+++ /dev/null
@@ -1,85 +0,0 @@
-(ns ^{:doc "Mermaid formatter for Semagol's extendsible markdown format."
- :author "Simon Brooke"}
- smeagol.extensions.mermaid
- (:require [smeagol.extensions.utils :refer :all]
- [taoensso.timbre :as log]))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; 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) 2017 Simon Brooke
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; Graphs can now be embedded in a page using the
-;;;; [Mermaid](https://mermaid-js.github.io/mermaid/#/) graph description
-;;;; language. The graph description should start with a line comprising three
-;;;; back-ticks and then the word `mermaid`, and end with a line comprising just
-;;;; three backticks.
-;;;;
-;;;; Here's an example culled from the Mermaid documentation.
-;;;;
-;;;; ### GANTT Chart
-;;;;
-;;;; ```mermaid
-;;;; gantt
-;;;; dateFormat YYYY-MM-DD
-;;;; title Adding GANTT diagram functionality to mermaid
-;;;; section A section
-;;;; Completed task :done, des1, 2014-01-06,2014-01-08
-;;;; Active task :active, des2, 2014-01-09, 3d
-;;;; Future task : des3, after des2, 5d
-;;;; Future task2 : des4, after des3, 5d
-;;;; section Critical tasks
-;;;; Completed task in the critical line :crit, done, 2014-01-06,24h
-;;;; Implement parser and jison :crit, done, after des1, 2d
-;;;; Create tests for parser :crit, active, 3d
-;;;; Future task in critical line :crit, 5d
-;;;; Create tests for renderer :2d
-;;;; Add to mermaid :1d
-;;;; ```
-;;;;
-;;;; Mermaid graph specifications can also be loaded from URLs. Here's another
-;;;; example.
-;;;;
-;;;; ### Class Diagram
-;;;;
-;;;; ```mermaid
-;;;; http://localhost:3000/data/classes.mermaid
-;;;; ```
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(defn process-mermaid
- "If this `url-or-graph-spec` is a valid URL, it is assumed to point to a plain
- text file pointing to a valid `graph-spec`; otherwise, it is expected to BE a
- valid `graph-spec`.
-
- Lightly mung this `graph-spec`, assumed to be a mermaid specification."
- [^String url-or-graph-spec ^Integer index]
- (let [data (resource-url-or-data->data url-or-graph-spec)
- graph-spec (:data data)]
- (log/info "Retrieved graph-spec from " (:from data) " `" ((:from data) data) "`")
- (str "
-
+ {% if uploaded %}
+ {% if is-image %}
+
+ 
-
- {% i18n file-upload-link-text %}:
+ 
+
+ {% i18n file-upload-link-text %}:
- [{{upload.filename}}]({{upload.resource}})
-
-
- {% endfor %} +
[Uploaded file](uploads/{{uploaded}})
+
+ {% endif %}
{% else %}
{% endif %}
- - Your uploaded files are listed here. -
\n"
- graph-spec
- "\n
")))
-
-;; (fs/file? (str (nio/resource-path) "data/classes.mermaid"))
-;; (slurp (str (nio/resource-path) "data/classes.mermaid"))
diff --git a/src/smeagol/extensions/photoswipe.clj b/src/smeagol/extensions/photoswipe.clj
deleted file mode 100644
index d145943..0000000
--- a/src/smeagol/extensions/photoswipe.clj
+++ /dev/null
@@ -1,176 +0,0 @@
-(ns ^{:doc "Photoswipe gallery formatter for Semagol's extendsible markdown
- format."
- :author "Simon Brooke"}
- smeagol.extensions.photoswipe
- (:require [clojure.data.json :as json]
- [clojure.java.io :as cio]
- [clojure.string :as cs]
- [image-resizer.util :refer [buffered-image dimensions]]
- [instaparse.core :as insta]
- [me.raynes.fs :as fs]
- [noir.io :as io]
- [smeagol.configuration :refer [config]]
- [smeagol.extensions.utils :refer :all]
- [smeagol.util :refer [content-dir upload-dir]]
- [taoensso.timbre :as log]))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; 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) 2017 Simon Brooke
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn process-full-photoswipe
- "Process a specification for a photoswipe gallery, using a JSON
- specification based on that documented on the Photoswipe website."
- [^String spec ^Integer index]
- (str
- "\n"
- (slurp
- (str (io/resource-path) "html-includes/photoswipe-boilerplate.html"))
- "
-
-
- "))
-
-
-(def simple-grammar
- "Parser to transform a sequence of Markdown image links into something we
- can build into JSON. Yes, this could all have been done with regexes, but
- they are very inscrutable."
- (insta/parser "SLIDE := START-CAPTION title END-CAPTION src END-SRC;
- START-CAPTION := '' ;
- title := #'[^]]*' ;
- src := #'[^)]*' ;
- SPACE := #'[\\r\\n\\W]*'"))
-
-(defn- simplify
- [tree]
- (if
- (coll? tree)
- (case (first tree)
- :SLIDE (remove empty? (map simplify (rest tree)))
- :title tree
- :src tree
- :START-CAPTION nil
- :END-CAPTION nil
- :END-SRC nil
- (remove empty? (map simplify tree)))))
-
-(defn slide-merge-dimensions
- "If this `slide` appears to be local, return it decorated with the
- dimensions of the image it references."
- [slide]
- (let [url (:src slide)
- dimensions (try
- (if (uploaded? url)
- (dimensions
- (buffered-image (cio/file upload-dir (fs/base-name url)))))
- (catch Exception x (.getMessage x)))]
- (if dimensions
- (assoc slide :w (first dimensions) :h (nth dimensions 1))
- (do
- (log/warn "Failed to fetch dimensions of image " url)
- slide))))
-
-;; (slide-merge-dimensions
-;; {:title "Frost on a gate, Laurieston",
-;; :src "content/uploads/g1.jpg"})
-
-(defn- process-simple-slide
- [slide-spec]
- (let [s (simplify (simple-grammar slide-spec))
- s'(zipmap (map first s) (map #(nth % 1) s))
- thumbsizes (:thumbnails config)
- thumbsize (first
- (sort
- #(> (%1 thumbsizes) (%2 thumbsizes))
- (keys thumbsizes)))
- url (:url s')
- thumb (if
- (and
- (uploaded? url)
- thumbsize)
- (let [p (str (cio/file "uploads" (name thumbsize) (fs/base-name url)))
- p' (cio/file content-dir p)]
- (if
- (and (fs/exists? p') (fs/readable? p'))
- p)))]
- (slide-merge-dimensions
- (if thumb
- (assoc s' :msrc thumb)
- s'))))
-
-(def process-simple-photoswipe
- "Process a simplified specification for a photoswipe gallery, comprising just
- a sequence of MarkDown image links. This is REALLY expensive to do, we don't
- want to do it often. Hence memoised."
- (memoize
- (fn
- [^String spec ^Integer index]
- (process-full-photoswipe
- (json/write-str
- {:slides (map
- process-simple-slide
- (re-seq #"!\[[^(]*\([^)]*\)" spec))
- ;; TODO: better to split slides in instaparse
- :options { :timeToIdle 100 }
- :openImmediately true}) index))))
-
-;; (map
-;; process-simple-slide
-;; (re-seq #"!\[[^(]*\([^)]*\)"
-;; "
-;; 
-;; 
-;; "))
-
-;; (process-simple-photoswipe
-;; "
-;; 
-;; 
-;; "
-;; 1)
-
-(defn process-photoswipe
- "Process a Photoswipe specification which may conform either to the
- `full` or the `simple` syntax."
- [^String url-or-pswp-spec ^Integer index]
- (let [data (resource-url-or-data->data url-or-pswp-spec)
- spec (cs/trim (:data data))]
- (if
- (cs/starts-with? spec "![")
- (process-simple-photoswipe spec index)
- (process-full-photoswipe spec index))))
diff --git a/src/smeagol/extensions/test.clj b/src/smeagol/extensions/test.clj
deleted file mode 100644
index ffe5c1a..0000000
--- a/src/smeagol/extensions/test.clj
+++ /dev/null
@@ -1,10 +0,0 @@
-(ns ^{:doc "Very simple extension for testing the extension processing flow."
- :author "Simon Brooke"}
- smeagol.extensions.test)
-
-
-(def process-test-return-value "")
-
-(defn process-test
- [^String fragment ^Integer index]
- process-test-return-value)
diff --git a/src/smeagol/extensions/utils.clj b/src/smeagol/extensions/utils.clj
deleted file mode 100644
index cfa4546..0000000
--- a/src/smeagol/extensions/utils.clj
+++ /dev/null
@@ -1,94 +0,0 @@
-(ns ^{:doc "Utility functions useful to extension processors."
- :author "Simon Brooke"}
- smeagol.extensions.utils
- (:require [cemerick.url :refer (url url-encode url-decode)]
- [clj-yaml.core :as yaml]
- [clojure.data.json :as json]
- [clojure.java.io :as cjio]
- [clojure.string :as cs]
- [me.raynes.fs :as fs]
- [noir.io :as io]
- [smeagol.configuration :refer [config]]
- [taoensso.timbre :as log]
- [smeagol.util :refer [content-dir upload-dir]]))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; 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) 2017 Simon Brooke
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def resource-url-or-data->data
- "Interpret this `resource-url-or-data` string as data to be digested by a
- `process-extension` function. It may be a URL or the pathname of a local
- resource, in which case the content should be fetched; or it may just be
- the data itself.
-
- Returns a map with a key `:from` whose value may be `:url`, `:resource` or
- `:text`, and a key `:data` whose value is the data. There will be an
- additional key being the value of the `:from` key, whose value will be the
- source of the data."
- (memoize
- (fn [^String resource-url-or-data]
- (let [default {:from :text
- :text resource-url-or-data
- :data resource-url-or-data}]
- (try
- (try
- ;; is it a URL?
- (let [url (str (url resource-url-or-data))
- result (slurp url)]
- {:from :url
- :url url
- :data result})
- (catch java.net.MalformedURLException _
- ;; no. So is it a path to a local resource?
- (let [t (cs/trim resource-url-or-data)
- r (str (io/resource-path) t)]
- (if
- (fs/file? r)
- {:from :resource
- :resource t
- :data (slurp r)}
- default))))
- (catch Exception x
- (log/error
- "Could not read mermaid graph specification from `"
- (cs/trim resource-url-or-data)
- "` because "
- (.getName (.getClass x))
- (.getMessage x) )
- default))))))
-
-(defn uploaded?
- "Does this `url` string appear to be one that has been uploaded to our
- `uploads` directory?"
- [url]
- (and
- (cs/starts-with? (str url) "content/uploads")
- (fs/exists? (cjio/file upload-dir (fs/base-name url)))))
-
-;; (uploaded? "content/uploads/g1.jpg")
-
-(defn yaml->json
- "Rewrite this string, assumed to be in YAML format, as JSON."
- [^String yaml-src]
- (json/write-str (yaml/parse-string yaml-src)))
-
diff --git a/src/smeagol/extensions/vega.clj b/src/smeagol/extensions/vega.clj
deleted file mode 100644
index 1a8a8bd..0000000
--- a/src/smeagol/extensions/vega.clj
+++ /dev/null
@@ -1,84 +0,0 @@
-(ns ^{:doc "Format vega/vis extensions to Semagol's extended markdown format."
- :author "Simon Brooke"}
- smeagol.extensions.vega
- (:require [smeagol.extensions.utils :refer :all]
- [taoensso.timbre :as log]))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; 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) 2017 Simon Brooke
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; Inspired by [visdown](https://visdown.com/) and
-;;;; [vega-lite](https://vega.github.io/vega-lite/docs/), the Vega formatter
-;;;; allows you to embed vega data visualisations into Smeagol pages. The graph
-;;;; description should start with a line comprising three back-ticks and then
-;;;; the word '`vega`', and end with a line comprising just three backticks.
-;;;;
-;;;; Here's an example cribbed in its entirety from
-;;;; [here](http://visdown.amitkaps.com/london):
-;;;;
-;;;; ### Flight punctuality at London airports
-;;;;
-;;;; ```vega
-;;;; data:
-;;;; url: "data/london.csv"
-;;;; transform:
-;;;; -
-;;;; filter: datum.year == 2016
-;;;; mark: rect
-;;;; encoding:
-;;;; x:
-;;;; type: nominal
-;;;; field: source
-;;;; y:
-;;;; type: nominal
-;;;; field: dest
-;;;; color:
-;;;; type: quantitative
-;;;; field: flights
-;;;; aggregate: sum
-;;;; ```
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn process-vega
- "If this `src-resource-or-url` is a valid URL, it is assumed to point to a
- plain text file pointing to valid `vega-src`; otherwise, it is expected to
- BE a valid `vega-src`.
-
- Process this `vega-src` string, assumed to be in YAML format, into a
- specification of a Vega chart, and add the plumbing to render it."
- [^String src-resource-or-url ^Integer index]
- (let [data (resource-url-or-data->data src-resource-or-url)
- vega-src (:data data)]
- (log/info "Retrieved vega-src from " (:from data) " `" ((:from data) data) "`")
- (str
- "\n"
- "")))
diff --git a/src/smeagol/formatting.clj b/src/smeagol/formatting.clj
index 8f0d92b..6a874c8 100644
--- a/src/smeagol/formatting.clj
+++ b/src/smeagol/formatting.clj
@@ -1,4 +1,4 @@
-(ns ^{:doc "Format Semagol's extended markdown format."
+(ns ^{:doc "Format Semagol's enhanced markdown format."
:author "Simon Brooke"}
smeagol.formatting
(:require [clojure.data.json :as json]
@@ -6,12 +6,7 @@
[cemerick.url :refer (url url-encode url-decode)]
[clj-yaml.core :as yaml]
[markdown.core :as md]
- [smeagol.configuration :refer [config]]
- [smeagol.extensions.mermaid :refer [process-mermaid]]
- [smeagol.extensions.photoswipe :refer [process-photoswipe]]
- [smeagol.extensions.vega :refer [process-vega]]
- [smeagol.local-links :refer :all]
- [taoensso.timbre :as log]))
+ [smeagol.configuration :refer [config]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
@@ -45,26 +40,70 @@
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Error to show if text to be rendered is nil.
+(def no-text-error "No text: does the file exist?")
+
+
+(defn local-links
+ "Rewrite text in `html-src` surrounded by double square brackets as a local link into this wiki."
+ [^String html-src]
+ (if 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)))
+ no-text-error))
+
+
+(defn yaml->json
+ "Rewrite this string, assumed to be in YAML format, as JSON."
+ [^String yaml-src]
+ (json/write-str (yaml/parse-string yaml-src)))
+
+
(declare process-text)
+(defn process-vega
+ "Process this `vega-src` string, assumed to be in YAML format, into a specification
+ of a Vega chart, and add the plumbing to render it."
+ [^String vega-src ^Integer index]
+ (str
+ "\n"
+ ""))
+
+
+(defn process-mermaid
+ "Lightly mung this `graph-spec`, assumed to be a mermaid specification."
+ [^String graph-spec ^Integer index]
+ (str "\n"
+ graph-spec
+ "\n
"))
+
+
(defn process-backticks
"Effectively, escape the backticks surrounding this `text`, by protecting them
- from the `process-text` filter.
-
- **NOTE** that it is not expected that this function forms part of a stable
- API."
+ from the `md->html` filter."
[^String text ^Integer index]
(str "```" (.trim text) "\n```")) (defn get-first-token - "Return the first space-separated token of the first line of this `string`, - or `nil` if there is none." + "Return the first space-separated token of this `string`." [^String string] - (try - (if string (first (cs/split (first (cs/split-lines string)) #"[^a-zA-Z0-9]+"))) - (catch NullPointerException _ nil))) + (if string (first (cs/split string #"[^a-zA-Z0-9]+")))) (defn- process-markdown-fragment @@ -73,11 +112,8 @@ As with `process-text`, this function returns a map with two top-level keys: `:inclusions`, a map of constructed keywords to inclusion specifications, and `:text`, an HTML text string with the keywords present where the - corresponding inclusion should be inserted. - - **NOTE** that it is not expected that this function forms part of a stable - API." - [^Integer index ^clojure.lang.Associative result ^String fragment fragments processed] + corresponding inclusion should be inserted." + [index result fragment fragments processed] (process-text (inc index) result @@ -85,90 +121,62 @@ (cons fragment processed))) -(defn deep-merge - "Cripped in its entirety from [here](https://clojuredocs.org/clojure.core/merge)." - [v & vs] - (letfn [(rec-merge [v1 v2] - (if (and (map? v1) (map? v2)) - (merge-with deep-merge v1 v2) - v2))] - (if (some identity vs) - (reduce #(rec-merge %1 %2) v vs) - (last vs)))) - - (defn- apply-formatter "Within the context of `process-text`, process a fragment for which an explicit - `formatter` has been identified, and then recurse back into `process-text` to - process the remainder of the fragments. Arguments are as for `process-text`, q.v., - the addition of - - * `fragment` the current fragment to be processed; - * `token` the identifier of the extension processor to be applied; - * `formatter` the actual extension processor to be applied. + §formatter has been identified. As with `process-text`, this function returns a map with two top-level keys: `:inclusions`, a map of constructed keywords to inclusion specifications, and `:text`, an HTML text string with the keywords present where the - corresponding inclusion should be inserted. - - **NOTE** that it is not expected that this function forms part of a stable - API." - [^Integer index - ^clojure.lang.Associative result - fragments - processed - ^String fragment - ^String token - formatter] + corresponding inclusion should be inserted." + [index result fragments processed fragment token formatter] (let - [inky (keyword (str "inclusion-" index)) - fkey (keyword token)] + [kw (keyword (str "inclusion-" index))] (process-text (inc index) - (deep-merge - result - {:inclusions {inky (eval (list formatter (subs fragment (count token)) index))} - :extensions {fkey (-> config :formatters fkey)}}) - (rest fragments) - (cons inky processed)))) + (assoc-in result [:inclusions kw] (apply formatter (list (subs fragment (count token)) index))) + (rest fragments) + (cons kw processed)))) -(defn- reassemble-text - "Reassemble these processed strings into a complete text, and process it as - Markdown. +(defn process-text + "Process this `text`, assumed to be markdown potentially containing both local links + and YAML visualisation specifications, and return a map comprising JSON visualisation + specification, and HTML text with markers for where those should be reinserted. - **NOTE** that it is not expected that this function forms part of a stable - API." - [result processed] - (assoc result :text - (local-links - (md/md-to-html-string - (cs/join "\n\n" (reverse processed)) - :heading-anchors true)))) + The map has two top-level keys: `:inclusions`, a map of constructed keywords to + inclusion specifications, and `:text`, an HTML text string with the keywords + present where the corresponding inclusion should be inserted." + ([^String text] + (process-text 0 {:inclusions {}} (cs/split (or text "") #"```") '())) + ([index result fragments processed] + (let [fragment (first fragments) + ;; if I didn't find a formatter for a back-tick marked fragment, + ;; I need to put the backticks back in. + remarked (if (odd? index) (str "```" fragment "\n```") fragment) + first-token (get-first-token fragment) + formatter (eval ((:formatters config) first-token))] + (cond + (empty? fragments) + (assoc result :text + (local-links + (md/md-to-html-string + (cs/join "\n\n" (reverse processed)) + :heading-anchors true))) + formatter + (apply-formatter index result fragments processed fragment first-token formatter) + true + (process-markdown-fragment index result remarked (rest fragments) processed))))) -(defn- reintegrate-inclusions - "Given a map of the form produced by `process-text`, return a map based on - that map with the key `:content` bound to a string of HTML text - with the inclusions (if any) generated by extension processors reintegrated. - - **NOTE** that it is not expected that this function forms part of a stable - API." +(defn reintegrate-inclusions + "Given a map of the form produced by `process-text`, return a string of HTML text + with the inclusions (if any) reintegrated." ([processed-text] - (assoc - processed-text - :content - (reintegrate-inclusions - (:inclusions processed-text) - (:text processed-text)))) + (reintegrate-inclusions (:inclusions processed-text) (:text processed-text))) ([inclusions text] (let [ks (keys inclusions)] (if (empty? (keys inclusions)) - ;; TODO: this is one opportunity to add scripts at the end of the - ;; constructed text. I've a feeling that that would be a mistake and - ;; that instead we should hand back a map comprising the text and the - ;; keys of the extensions text (let [kw (first ks)] (reintegrate-inclusions @@ -179,89 +187,9 @@ (cs/replace (kw inclusions) "\\/" "/")))))))) -(defn- process-text - "Process extension fragments in this text. Arguments are: - * `index`, the index number of the current fragment; - * `result`, a context within which the final result is being accumulated; - * `fragments`, a sequence of the fragments of the original text which have - not yet been processed; - * `processed`, a reverse sequence of the fragments of the original text - which have already been processed. - - Returns a map derived from `result` enhanced with the accumulated result. - - **NOTE** that it is not expected that this function forms part of a stable - API." - [^Integer index ^clojure.lang.Associative result fragments processed] - (let [fragment (first fragments) - ;; if I didn't find a formatter for a back-tick marked fragment, - ;; I need to put the backticks back in. - remarked (if (odd? index) (str "```" fragment "\n```") fragment) - first-token (get-first-token fragment) - kw (if-not (empty? first-token) (keyword first-token)) - formatter (if - kw - (try - (read-string (-> config :formatters kw :formatter)) - (catch Exception _ - (do - (log/info "No formatter found for extension `" kw "`") - ;; no extension registered - there sometimes won't be, - ;; and it doesn't matter - nil))))] - (cond - (empty? fragments) - ;; We've come to the end of the list of fragments. Reassemble them into - ;; a single HTML text and pass it back. - (reassemble-text result processed) - formatter - (apply-formatter index result fragments processed fragment first-token formatter) - true - (process-markdown-fragment index result remarked (rest fragments) processed)))) - (defn md->html - "Process the source text (assumed to be the value of the key `:source` in this - `context`, expected to be a full HTTP request map, so that extensions may in - future potentially have access to things like `accepts-*` headers. - - The source is assumed to be markdown potentially containing both local links - and extension specifications, and return a map with top-level keys: - * `:content`, the HTML content of the page to serve; and - * `:extensions`, being a subset of the `:formatters` map from - `smeagol.configuration/config` covering the extensions actually used in the - generated content." - [^clojure.lang.Associative context] - (reintegrate-inclusions - (process-text - 0 - (assoc context :extensions #{}) - (cs/split (or (:source context) "") #"```") - '()))) - - -;; (def first-token "pswp") -;; (def kw (keyword "pswp")) -;; (def fragment "pswp -;;  -;;  -;;  -;; ") -;; (def index 0) -;; (def formatter (read-string (-> config :formatters kw :formatter))) -;; formatter -;; (eval (list formatter (subs fragment (count first-token)) index)) -;; (process-photoswipe (subs fragment (count first-token)) index) - -;; (process-text -;; {:source "pswp -;;  -;;  -;;  -;; "} ) - -;; (process-text {:source (slurp (clojure.java.io/file smeagol.util/content-dir "Extensible Markup.md"))}) - - - + "Take this markdown source, and return HTML." + [md-src] + (reintegrate-inclusions (process-text md-src))) diff --git a/src/smeagol/handler.clj b/src/smeagol/handler.clj index db580e6..d25e415 100644 --- a/src/smeagol/handler.clj +++ b/src/smeagol/handler.clj @@ -16,7 +16,7 @@ [smeagol.routes.wiki :refer [wiki-routes]] [smeagol.middleware :refer [load-middleware]] [smeagol.session-manager :as session-manager] - [taoensso.timbre :as log] + [taoensso.timbre :as timbre] [taoensso.timbre.appenders.3rd-party.rotor :as rotor])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -55,9 +55,9 @@ "destroy will be called when your application shuts down, put any clean up code here" [] - (log/info "smeagol is shutting down...") + (timbre/info "smeagol is shutting down...") (cronj/shutdown! session-manager/cleanup-job) - (log/info "shutdown complete!")) + (timbre/info "shutdown complete!")) (defn init @@ -67,7 +67,7 @@ put any initialization code here" [] (try - (log/merge-config! + (timbre/merge-config! {:appenders {:rotor (rotor/rotor-appender {:path "smeagol.log" @@ -80,10 +80,10 @@ (cronj/start! session-manager/cleanup-job) (if (env :dev) (parser/cache-off!)) ;;start the expired session cleanup job - (log/info "\n-=[ smeagol started successfully" + (timbre/info "\n-=[ smeagol started successfully" (when (env :dev) "using the development profile") "]=-") (catch Exception any - (log/error any "Failure during startup") + (timbre/error any "Failure during startup") (destroy)))) ;; timeout sessions after 30 minutes @@ -97,7 +97,6 @@ [xss-protection?] (-> site-defaults (update-in [:session] merge session-defaults) - (dissoc :static) (assoc-in [:security :anti-forgery] xss-protection?))) diff --git a/src/smeagol/history.clj b/src/smeagol/history.clj index e567db3..aca6dbe 100644 --- a/src/smeagol/history.clj +++ b/src/smeagol/history.clj @@ -1,10 +1,10 @@ (ns ^{:doc "Explore the history of a page." :author "Simon Brooke"} smeagol.history - (:require [clj-jgit.porcelain :as git] + (:require [taoensso.timbre :as timbre] + [clj-jgit.porcelain :as git] [clj-jgit.internal :as i] - [clj-jgit.querying :as q] - [taoensso.timbre :as log]) + [clj-jgit.querying :as q]) (:import [org.eclipse.jgit.api Git] [org.eclipse.jgit.lib Repository ObjectId] [org.eclipse.jgit.revwalk RevCommit RevTree RevWalk] @@ -39,7 +39,7 @@ "If this `log-entry` contains a reference to this `file-path`, return the entry; else nil." [^String log-entry ^String file-path] - (log/info (format "searching '%s' for '%s'" log-entry file-path)) + (timbre/info (format "searching '%s' for '%s'" log-entry file-path)) (cond (seq (filter (fn* [p1__341301#] (= (first p1__341301#) file-path)) (:changed_files log-entry))) log-entry)) @@ -54,7 +54,6 @@ (try (git/load-repo git-directory-path) (catch java.io.FileNotFoundException fnf - (log/info "Initialising Git repository at" git-directory-path) (git/git-init git-directory-path) (let [repo (git/load-repo git-directory-path)] (git/git-add-and-commit repo "Initial commit") diff --git a/src/smeagol/include.clj b/src/smeagol/include.clj deleted file mode 100644 index 8f8a017..0000000 --- a/src/smeagol/include.clj +++ /dev/null @@ -1,61 +0,0 @@ -(ns ^{:doc "Functions related to the include of markdown-paged in a given markdown." - :author "Michael Jerger"} - smeagol.include - (:require - [clojure.string :as cs] - [schema.core :as s] - [com.stuartsierra.component :as component] - [smeagol.include.parse :as parse] - [smeagol.include.resolve :as resolve] - [smeagol.include.indent :as indent])) - -(s/defrecord Includer - [resolver]) - -(defprotocol IncludeMd - (expand-include-md - [includer md-src] - "return a markdown containing resolved includes")) - -(s/defn - do-expand-one-include :- s/Str - [includer :- Includer - include :- parse/IncludeLink - md-src :- s/Str] - (let [{:keys [uri replace indent-heading indent-list]} include] - (cs/replace-first - md-src - (re-pattern (cs/escape - replace - {\[ "\\[" - \] "\\]" - \( "\\(" - \) "\\)"})) - (indent/do-indent-list - indent-list - (indent/do-indent-heading - indent-heading - (resolve/resolve-md (:resolver includer) uri)))))) - -(s/defn - do-expand-includes :- s/Str - [includer :- Includer - includes :- [parse/IncludeLink] - md-src :- s/Str] - (loop [loop-includes includes - result md-src] - (if (empty? loop-includes) - result - (recur - (rest loop-includes) - (do-expand-one-include includer (first loop-includes) result))))) - -(extend-type Includer - IncludeMd - (expand-include-md [includer md-src] - (do-expand-includes includer (parse/parse-include-md md-src) md-src))) - -(s/defn - new-includer - [] - (map->Includer {})) diff --git a/src/smeagol/include/indent.clj b/src/smeagol/include/indent.clj deleted file mode 100644 index f92a69c..0000000 --- a/src/smeagol/include/indent.clj +++ /dev/null @@ -1,58 +0,0 @@ -(ns ^{:doc "Functions related to the include of markdown-paged - handling the -list & heading indents of includes. This namespaces is implementation detail for -smeagol.include and not inteded for direct usage." - :author "Michael Jerger"} - smeagol.include.indent - (:require - [clojure.string :as cs] - [schema.core :as s])) - -(s/defn - parse-list - [md-resolved :- s/Str] - (distinct - (into - (re-seq #"((^|\R? *)([\*\+-] ))" md-resolved) - (re-seq #"((^|\R? *)([0-9]+\. ))" md-resolved)))) - -(s/defn - parse-heading - [md-resolved :- s/Str] - (distinct - (re-seq #"((^|\R?)(#+ ))" md-resolved))) - -(s/defn - do-indent :- s/Str - [indent :- s/Num - indentor :- s/Str - elements - md-resolved :- s/Str] - (loop [result md-resolved - elements elements] - (if (empty? elements) - result - (let [element (first elements) - replace (nth element 1) - start (nth element 2) - end (nth element 3)] - (recur - (cs/replace - result - (re-pattern (cs/escape - replace - {\* "\\*" - \n "\\n"})) - (str start (apply str (repeat indent indentor)) end)) - (rest elements)))))) - -(s/defn - do-indent-heading :- s/Str - [indent :- s/Num - md-resolved :- s/Str] - (do-indent indent "#" (parse-heading md-resolved) md-resolved)) - -(s/defn - do-indent-list :- s/Str - [indent :- s/Num - md-resolved :- s/Str] - (do-indent indent " " (parse-list md-resolved) md-resolved)) diff --git a/src/smeagol/include/parse.clj b/src/smeagol/include/parse.clj deleted file mode 100644 index 0016252..0000000 --- a/src/smeagol/include/parse.clj +++ /dev/null @@ -1,50 +0,0 @@ -(ns ^{:doc "Functions related to the include of markdown-paged - parsing of -include links. This namespaces is implementation detail for -smeagol.include and not inteded for direct usage." - :author "Michael Jerger"} - smeagol.include.parse - (:require - [schema.core :as s])) - -(def IncludeLink - {:replace s/Str - :uri s/Str - :indent-heading s/Num - :indent-list s/Num}) - -(s/defn - convert-indent-to-int :- s/Num - [indents :- [s/Str]] - (if (some? indents) - (Integer/valueOf (nth indents 2)) - 0)) - -(s/defn - parse-indent-list - [md-src :- s/Str] - (re-matches #".*(:indent-list (\d)).*" md-src)) - -(s/defn - parse-indent-heading - [md-src :- s/Str] - (re-matches #".*(:indent-heading (\d)).*" md-src)) - -(s/defn - parse-include-link - [md-src :- s/Str] - (re-seq #".*(&\[\w*(.*)\w*\]\((.*)\)).*" md-src)) - -(s/defn - parse-include-md :- [IncludeLink] - [md-src :- s/Str] - (vec - (map - (fn [parse-element] - (let [replace (nth parse-element 1) - uri (nth parse-element 3) - indents-text (nth parse-element 2)] - {:replace replace - :uri uri - :indent-heading (convert-indent-to-int (parse-indent-heading indents-text)) - :indent-list (convert-indent-to-int (parse-indent-list indents-text))})) - (parse-include-link md-src)))) diff --git a/src/smeagol/include/resolve.clj b/src/smeagol/include/resolve.clj deleted file mode 100644 index 266a276..0000000 --- a/src/smeagol/include/resolve.clj +++ /dev/null @@ -1,46 +0,0 @@ -(ns ^{:doc "Functions related to the include of markdown-paged - providing -a plugable load-content componet. This namespaces is implementation detail for -smeagol.include and not inteded for direct usage." - :author "Michael Jerger"} - smeagol.include.resolve - (:require - [schema.core :as s] - [com.stuartsierra.component :as component])) - -(s/defrecord Resolver - [type :- s/Keyword - local-base-dir :- s/Str]) - -;As schema doesn't support s/defprotocol we use the dispatcher for annotation & validation. -(s/defn dispatch-by-resolver-type :- s/Keyword - "Dispatcher for different resolver implementations." - [resolver :- Resolver - uri :- s/Str] - (:type resolver)) - -(defmulti do-resolve-md - "Multimethod return a markdown file content for given uri." - dispatch-by-resolver-type) -(s/defmethod do-resolve-md :default - [resolver :- Resolver - uri :- s/Str] - (throw (Exception. (str "No implementation for " resolver)))) - -(defprotocol ResolveMd - (resolve-md - [resolver uri] - "return a markfown file content for given uri.")) - -(extend-type Resolver - ResolveMd - (resolve-md [resolver uri] - (s/validate s/Str uri) - (s/validate s/Str (do-resolve-md resolver uri)))) - -(s/defn - new-resolver - ([type :- s/Keyword] - (map->Resolver {:type type :local-base-dir nil})) - ([type :- s/Keyword - local-base-dir :- s/Str] - (map->Resolver {:type type :local-base-dir local-base-dir}))) diff --git a/src/smeagol/include/resolve_local_file.clj b/src/smeagol/include/resolve_local_file.clj deleted file mode 100644 index a603f8a..0000000 --- a/src/smeagol/include/resolve_local_file.clj +++ /dev/null @@ -1,31 +0,0 @@ -(ns ^{:doc "Functions related to the include of markdown-paged - providing -a plugable load-local-include-links componet. This namespaces is implementation detail for -smeagol.include and not inteded for direct usage." - :author "Michael Jerger"} - smeagol.include.resolve-local-file - (:require - [schema.core :as s] - [smeagol.include.resolve :as resolve] - [com.stuartsierra.component :as component] - [clojure.java.io :as cjio] - [taoensso.timbre :as timbre])) - -(s/defmethod resolve/do-resolve-md :local-file - [resolver - uri :- s/Str] - (let [file-name uri - file-path (cjio/file (:local-base-dir resolver) file-name) - exists? (.exists (clojure.java.io/as-file file-path))] - (cond exists? - (do - (timbre/info (format "Including page '%s' from file '%s'" uri file-path)) - (slurp file-path)) - :else - (do - (timbre/info (format "Page '%s' not found at '%s'" uri file-path)) - (str "include not found at " file-path))))) - -(s/defn - new-resolver - [local-base-dir :- s/Str] - (resolve/new-resolver :local-file local-base-dir)) diff --git a/src/smeagol/layout.clj b/src/smeagol/layout.clj index 0fa5334..34a7d0a 100644 --- a/src/smeagol/layout.clj +++ b/src/smeagol/layout.clj @@ -12,7 +12,8 @@ [selmer.parser :as parser] [smeagol.configuration :refer [config]] [smeagol.sanity :refer :all] - [smeagol.util :as util])) + [smeagol.util :as util] + [taoensso.timbre :as timbre])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -37,11 +38,7 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(def template-path - "Path to the resource directory in which Selmer templates are stored. These - should be in a place which is not editable from the Wiki, otherwise - users may break things which they cannot subsequently fix!" - "templates/") +(def template-path "templates/") (parser/add-tag! :csrf-field (fn [_ _] (anti-forgery-field))) @@ -52,14 +49,10 @@ (fn [args context-map] (let [messages (:i18n context-map) default (or (second args) (first args))] - (if (map? messages) (or (messages (keyword (first args))) default) - default)))) + (if (map? messages) (or (messages (keyword (first args))) default) default)))) -(deftype RenderableTemplate -;; Boilerplate from Luminus. Load a template file into an object which may -;; be rendered. - [template params] +(deftype RenderableTemplate [template params] Renderable (render [this request] (try @@ -83,8 +76,6 @@ (defn render - "Boilerplate from Luminus. Render an HTML page based on this `template` and - these `params`. Returns HTML source as a string." [template & [params]] (try (RenderableTemplate. template params) diff --git a/src/smeagol/local_links.clj b/src/smeagol/local_links.clj deleted file mode 100644 index f1bed0b..0000000 --- a/src/smeagol/local_links.clj +++ /dev/null @@ -1,50 +0,0 @@ -(ns ^{:doc "Format Semagol's local links." - :author "Simon Brooke"} - smeagol.local-links - (:require [clojure.data.json :as json] - [clojure.string :as cs] - [cemerick.url :refer (url url-encode url-decode)])) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; -;;;; 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) 2017 Simon Brooke -;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Error to show if text to be rendered is nil. -;; TODO: this should go through i18n -(def no-text-error "No text: does the file exist?") - - -(defn local-links - "Rewrite text in `html-src` surrounded by double square brackets as a local link into this wiki." - [^String html-src] - (if html-src - (cs/replace html-src #"\[\[[^\[\]]*\]\]" - #(let [text (cs/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))) - no-text-error)) - - diff --git a/src/smeagol/middleware.clj b/src/smeagol/middleware.clj index 4ca288d..82ccb59 100644 --- a/src/smeagol/middleware.clj +++ b/src/smeagol/middleware.clj @@ -1,17 +1,12 @@ (ns ^{:doc "In truth, boilerplate provided by LuminusWeb." :author "Simon Brooke"} smeagol.middleware - (:require [environ.core :refer [env]] - [noir-exception.core :refer [wrap-internal-error]] + (:require [taoensso.timbre :as timbre] + [environ.core :refer [env]] + [selmer.middleware :refer [wrap-error-page]] [prone.middleware :refer [wrap-exceptions]] [ring.middleware.anti-forgery :refer [wrap-anti-forgery]] - [ring.middleware.file :refer [wrap-file]] - [ring.middleware.resource :refer [wrap-resource]] - [ring.middleware.content-type :refer [wrap-content-type]] - [ring.middleware.not-modified :refer [wrap-not-modified]] - [selmer.middleware :refer [wrap-error-page]] - [smeagol.util :as util] - [taoensso.timbre :as log])) + [noir-exception.core :refer [wrap-internal-error]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -39,7 +34,7 @@ (defn log-request [handler] (fn [req] - (log/debug req) + (timbre/debug req) (handler req))) @@ -49,12 +44,7 @@ (def production-middleware - [#(wrap-internal-error % :log (fn [e] (log/error e))) - #(wrap-resource % "public") - #(wrap-file % util/content-dir - {:index-files? false :prefer-handler? true}) - #(wrap-content-type %) - #(wrap-not-modified %)]) + [#(wrap-internal-error % :log (fn [e] (timbre/error e)))]) (defn load-middleware [] diff --git a/src/smeagol/routes/admin.clj b/src/smeagol/routes/admin.clj index a092f63..106ca35 100644 --- a/src/smeagol/routes/admin.clj +++ b/src/smeagol/routes/admin.clj @@ -33,7 +33,7 @@ (defn edit-users - "Render a page showing a list of users for editing." + "Put a list of users on-screen for editing." [request] (let [params (keywordize-keys (:params request)) user (session/get :user)] @@ -43,8 +43,7 @@ :users (auth/list-users)})))) (defn delete-user - "Render a form allowing a user to be deleted; and - process that form.." + "Delete a user." [request] (let [params (keywordize-keys (:params request)) target (:target params) @@ -60,8 +59,7 @@ (defn edit-user - "Render a form showing an individual user's details for editing; and - process that form." + "Put an individual user's details on screen for editing." [request] (let [params (keywordize-keys (:params request))] (try diff --git a/src/smeagol/routes/wiki.clj b/src/smeagol/routes/wiki.clj index 27ec424..fe80349 100644 --- a/src/smeagol/routes/wiki.clj +++ b/src/smeagol/routes/wiki.clj @@ -4,34 +4,23 @@ (:require [cemerick.url :refer (url url-encode url-decode)] [clj-jgit.porcelain :as git] [clojure.java.io :as cjio] - [clojure.pprint :refer [pprint]] [clojure.string :as cs] [clojure.walk :refer :all] [compojure.core :refer :all] - [java-time :as jt] - [markdown.core :as md] - [me.raynes.fs :as fs] [noir.io :as io] [noir.response :as response] [noir.util.route :as route] [noir.session :as session] [smeagol.authenticate :as auth] - [smeagol.configuration :refer [config]] [smeagol.diff2html :as d2h] [smeagol.formatting :refer [md->html]] [smeagol.history :as hist] [smeagol.layout :as layout] - [smeagol.local-links :refer :all] [smeagol.routes.admin :as admin] [smeagol.sanity :refer [show-sanity-check-error]] [smeagol.util :as util] [smeagol.uploads :as ul] - [taoensso.timbre :as log] - [com.stuartsierra.component :as component] - [smeagol.configuration :refer [config]] - [smeagol.include.resolve-local-file :as resolve] - [smeagol.include :as include] - [smeagol.util :refer [content-dir local-url]])) + [taoensso.timbre :as timbre])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -60,7 +49,6 @@ "Process `source-text` and save it to the specified `file-path`, committing it to Git and finally redirecting to wiki-page." [params suffix request] - (log/trace (format "process-source: '%s'" request)) (let [source-text (:src params) page (:page params) file-name (str page suffix) @@ -70,7 +58,7 @@ user (session/get :user) email (auth/get-email user) summary (format "%s: %s" user (or (:summary params) "no summary"))] - (log/info (format "Saving %s's changes ('%s') to %s in file '%s'" user summary page file-path)) + (timbre/info (format "Saving %s's changes ('%s') to %s in file '%s'" user summary page file-path)) (spit file-path source-text) (git/git-add git-repo file-name) (git/git-commit git-repo summary {:name user :email email}) @@ -100,19 +88,16 @@ user (session/get :user)] (if-not exists? - (log/info + (timbre/info (format "File '%s' not found; creating a new file" file-path)) - (log/info (format "Opening '%s' for editing" file-path))) + (timbre/info (format "Opening '%s' for editing" file-path))) (cond src-text (process-source params suffix request) true (layout/render template (merge (util/standard-params request) {:title (str (util/get-message :edit-title-prefix request) " " page) :page page - :side-bar (md/md-to-html-string - (local-links - (slurp (cjio/file content-dir side-bar))) - :heading-anchors true) + :side-bar (md->html (slurp (cjio/file util/content-dir side-bar))) :content (if exists? (slurp file-path) "") :exists exists?}))))))) @@ -123,106 +108,26 @@ (edit-page request "stylesheet" ".css" "edit-css.html" "_edit-side-bar.md")) -(def md-include-system - "Allowing Markdown includes. Unfortunately the contributor who contributed - this didn't document it, and I haven't yet worked out how it works. TODO: - investigate and document." - (component/start - (component/system-map - :resolver (resolve/new-resolver util/content-dir) - :includer (component/using - (include/new-includer) - [:resolver])))) - - -(defn preferred-source - "Here, `component` is expected to be a map with two keys, `:local` and - `:remote`. If the value of `:extensions-from` in `config.edn` is remote - AND the value of `:remote` is not nil, then the value of `:remote` will - be returned. Otherwise, if the value of `:local` is nil and the value of - `:remote` is non-nil, the value of `:remote` will be returned. By default, - the value of `:local` will be returned." - [component ks] - (try - (let [l (:local component) - l' (if-not (empty? l) (local-url l) l) - r (:remote component)] - (cond - (= (:extensions-from config) :remote) - (if (empty? r) l' r) - (empty? l') r - :else l')) - (catch Exception any - (log/error "Failed to find appropriate source for component" ks "because:" any) - nil))) - -;; (preferred-source {:local "vendor/node_modules/photoswipe/dist/photoswipe.min.js", -;; :remote "https://cdnjs.cloudflare.com/ajax/libs/photoswipe/4.1.3/photoswipe.min.js"} :core) - -(defn collect-preferred - "Collect preferred variants of resources required by extensions used in the - page described in this `processed-text`." - ([processed-text] - (concat - (collect-preferred processed-text :scripts) - (collect-preferred processed-text :styles))) - ([processed-text resource-type] - (reduce - concat - (map - (fn [extension-key] - (map - (fn [requirement] - (let [r (preferred-source - (-> processed-text :extensions extension-key - resource-type requirement) - requirement)] - (if (empty? r) - (log/warn "Found no valid URL for requirement" - requirement "of extension" extension-key)) - r)) - (keys (-> processed-text :extensions extension-key resource-type)))) - (keys (:extensions processed-text)))))) - -;; (cjio/file content-dir "vendor/node_modules/photoswipe/dist/photoswipe.min.js") - -;; (def processed-text (md->html {:source (slurp "resources/public/content/Simplified example gallery.md" )})) - -;; (preferred-source (-> processed-text :extensions :pswp :scripts :core) :pswp) - -;; (-> processed-text :extensions) - -;; (collect-preferred processed-text :scripts) - (defn wiki-page "Render the markdown page specified in this `request`, if any. If none found, redirect to edit-page" [request] - (log/trace (format "wiki-page: '%s'" request)) (or (show-sanity-check-error) (let [params (keywordize-keys (:params request)) - page (or (:page params) util/start-page (util/get-message :default-page-title "Introduction" request)) + page (or (:page params) (util/get-message :default-page-title "Introduction" request)) file-name (str page ".md") file-path (cjio/file util/content-dir file-name) exists? (.exists (clojure.java.io/as-file file-path))] - (if exists? - (do - (log/info (format "Showing page '%s' from file '%s'" page file-path)) - (let [processed-text (md->html - (assoc request :source - (include/expand-include-md - (:includer md-include-system) - (slurp file-path))))] - (layout/render "wiki.html" - (merge (util/standard-params request) - processed-text - {:title page - :scripts (collect-preferred processed-text :scripts) - :styles (collect-preferred processed-text :styles) - :page page - :editable true})))) - ;else - (response/redirect (str "/edit?page=" page)))))) + (cond exists? + (do + (timbre/info (format "Showing page '%s' from file '%s'" page file-path)) + (layout/render "wiki.html" + (merge (util/standard-params request) + {:title page + :page page + :content (md->html (slurp file-path)) + :editable true}))) + true (response/redirect (str "/edit?page=" page)))))) (defn history-page @@ -233,105 +138,42 @@ page (url-decode (or (:page params) (util/get-message :default-page-title request))) file-name (str page ".md") repo-path util/content-dir] - (log/info (format "Showing history of page '%s'" page)) + (timbre/info (format "Showing history of page '%s'" page)) (layout/render "history.html" (merge (util/standard-params request) - {:title (str (util/get-message :history-title-prefix request) - " " page) + {:title (str "History of " page) :page page :history (hist/find-history repo-path file-name)})))) -;;;; this next section is all stuff supporting the list-uploads page, and maybe -;;;; should be moved to its own file. - -(def image-extns - "File name extensions suggesting files which can be considered to be images." - #{".gif" ".jpg" ".jpeg" ".png"}) - -(defn format-instant - "Format this `unix-time`, expected to be a Long, into something human readable. - If `template` is supplied, use that as the formatting template as specified for - java.time.Formatter. Assumes system default timezone. Returns a string." - ([^Long unix-time] - (format-instant unix-time "dd MMMM YYYY")) - ([^Long unix-time ^String template] - (jt/format - (java-time/formatter template) - (java.time.LocalDateTime/ofInstant - (java-time/instant unix-time) - (java.time.ZoneOffset/systemDefault))))) - -(defn list-uploads-page - "Render a list of all uploaded files" - [request] - (let - [params (keywordize-keys (:params request)) - files - (sort-by - (juxt :name (fn [x] (- 0 (count (:resource x))))) - (map - #(zipmap - [:base-name :is-image :modified :name :resource] - [(fs/base-name %) - (if - (and (fs/extension %) - (image-extns (cs/lower-case (fs/extension %)))) - true false) - (if - (fs/mod-time %) - (format-instant (fs/mod-time %))) - (fs/name %) - (util/local-url %)]) - (remove - #(or (cs/starts-with? (fs/name %) ".") - (fs/directory? %)) - (file-seq (clojure.java.io/file util/upload-dir)))))] - (log/info (with-out-str (pprint files))) - (layout/render - "list-uploads.html" - (merge (util/standard-params request) - {:title (str - (util/get-message :list-files request) - (if - (:search params) - (str " " (util/get-message :matching request)))) - :search (:search params) - :files (if - (:search params) - (try - (let [pattern (re-pattern (:search params))] - (filter - #(re-find pattern (:base-name %)) - files)) - (catch Exception _ files)) - files) - })))) - - -;;;; end of list-uploads section ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (defn upload-page "Render a form to allow the upload of a file." [request] (let [params (keywordize-keys (:params request)) - data-path (str util/content-dir "/uploads/") + data-path (str (io/resource-path) "/content/uploads/") 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) summary (format "%s: %s" user (or (:summary params) "no summary"))] -;; TODO: Get this working! it MUST work! -;; (if-not -;; (empty? uploaded) -;; (do -;; (map -;; #(git/git-add git-repo (str :resource %)) -;; (remove nil? uploaded)) -;; (git/git-commit git-repo summary {:name user :email (auth/get-email user)}))) + (if + uploaded + (do + (git/git-add git-repo uploaded) + (git/git-commit git-repo summary {:name user :email (auth/get-email user)}))) (layout/render "upload.html" (merge (util/standard-params request) {:title (util/get-message :file-upload-title request) - :uploaded uploaded})))) + :uploaded uploaded + :is-image (and + uploaded + (or + (cs/ends-with? uploaded ".gif") + (cs/ends-with? uploaded ".jpg") + (cs/ends-with? uploaded ".jpeg") + (cs/ends-with? uploaded ".png") + (cs/ends-with? uploaded ".GIF") + (cs/ends-with? uploaded ".JPG") + (cs/ends-with? uploaded ".PNG")))})))) (defn version-page @@ -342,7 +184,7 @@ version (:version params) file-name (str page ".md") content (hist/fetch-version util/content-dir file-name version)] - (log/info (format "Showing version '%s' of page '%s'" version page)) + (timbre/info (format "Showing version '%s' of page '%s'" version page)) (layout/render "wiki.html" (merge (util/standard-params request) {:title (str (util/get-message :vers-col-hdr request) " " version " " (util/get-message :of request) " " page) @@ -357,7 +199,7 @@ page (url-decode (or (:page params) (util/get-message :default-page-title request))) version (:version params) file-name (str page ".md")] - (log/info (format "Showing diff between version '%s' of page '%s' and current" version page)) + (timbre/info (format "Showing diff between version '%s' of page '%s' and current" version page)) (layout/render "wiki.html" (merge (util/standard-params request) {:title @@ -375,22 +217,20 @@ (defn auth-page - "Render the authentication (login) page" + "Render the auth page" [request] (or (show-sanity-check-error) - (let [params (keywordize-keys (:params request)) - form-params (keywordize-keys (:form-params request)) - username (:username form-params) - password (:password form-params) - action (:action form-params) + (let [params (keywordize-keys (:form-params request)) + username (:username params) + password (:password params) + action (:action params) user (session/get :user) - redirect-to (:redirect-to params)] - (if redirect-to (log/info (str "After auth, redirect to: " redirect-to))) + redirect-to (or (:redirect-to params) "/wiki")] (cond (= action (util/get-message :logout-label request)) (do - (log/info (str "User " user " logging out")) + (timbre/info (str "User " user " logging out")) (session/remove! :user) (response/redirect redirect-to)) (and username password (auth/authenticate username password)) @@ -403,23 +243,8 @@ {:title (if user (str (util/get-message :logout-link request) " " user) (util/get-message :login-link request)) - :redirect-to redirect-to})))))) + :redirect-to ((:headers request) "referer")})))))) -(defn wrap-restricted-redirect - ;; TODO: this is not idiomatic, and it's too late to write something idiomatic just now - ;; TODO TODO: it's also not working. - [f request] - (route/restricted - (apply - f - (if - (-> request :params :redirect-to) ;; a redirect target has already been set - request - ;; else merge a redirect target into the params - (let - [redirect-to (if (:uri request) - (cs/join "?" [(:uri request) (:query-string request)]))] - (assoc-in request [:params :redirect-to] redirect-to)))))) (defn passwd-page "Render a page to change the user password" @@ -445,10 +270,8 @@ (defroutes wiki-routes + (GET "/wiki" request (wiki-page request)) (GET "/" request (wiki-page request)) - (GET "/auth" request (auth-page request)) - (POST "/auth" request (auth-page request)) - (GET "/changes" request (diff-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))) @@ -458,12 +281,11 @@ (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 "/list-uploads" request (route/restricted (list-uploads-page request))) - (POST "/list-uploads" request (route/restricted (list-uploads-page request))) (GET "/version" request (version-page request)) + (GET "/changes" request (diff-page request)) + (GET "/auth" request (auth-page request)) + (POST "/auth" request (auth-page request)) (GET "/passwd" request (passwd-page request)) (POST "/passwd" request (passwd-page request)) (GET "/upload" request (route/restricted (upload-page request))) - (POST "/upload" request (route/restricted (upload-page request))) - (GET "/wiki" request (wiki-page request)) - ) + (POST "/upload" request (route/restricted (upload-page request)))) diff --git a/src/smeagol/sanity.clj b/src/smeagol/sanity.clj index e0a57f3..1e3430e 100644 --- a/src/smeagol/sanity.clj +++ b/src/smeagol/sanity.clj @@ -1,7 +1,5 @@ (ns ^{:doc "Functions related to sanity checks and error reporting in conditions - where the environment may not be sane. Generally, the functions in this - file are called (via `sanity-check-installation`, which is the only - supported entry point) at first start-up." + where the environment may not be sane." :author "Simon Brooke"} smeagol.sanity (:import (java.util Locale)) diff --git a/src/smeagol/uploads.clj b/src/smeagol/uploads.clj index a6912e0..27ddceb 100644 --- a/src/smeagol/uploads.clj +++ b/src/smeagol/uploads.clj @@ -1,20 +1,10 @@ (ns ^{:doc "Handle file uploads." :author "Simon Brooke"} smeagol.uploads + (:import [java.io File]) (:require [clojure.string :as cs] - [clojure.java.io :as io] - [image-resizer.core :refer [resize]] - [image-resizer.util :refer :all] - [me.raynes.fs :as fs] - [noir.io :as nio] - [smeagol.configuration :refer [config]] - [smeagol.util :as util] - [taoensso.timbre :as log]) - (:import [java.io File] - [java.awt Image] - [java.awt.image RenderedImage BufferedImageOp] - [javax.imageio ImageIO ImageWriter ImageWriteParam IIOImage] - [javax.imageio.stream FileImageOutputStream])) + [noir.io :as io] + [taoensso.timbre :as timbre])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -39,97 +29,36 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(def image-file-extns - "Extensions of file types we will attempt to thumbnail. GIF is excluded - because by default the javax.imageio package can read GIF, PNG, and JPEG - images but can only write PNG and JPEG images." - #{".jpg" ".jpeg" ".png"}) +;; No longer used as uploaded files now go into Git. +;; (defn avoid-name-collisions +;; "Find a filename within this `path`, based on this `file-name`, that does not +;; reference an existing file. It is assumed that `path` ends with a path separator. +;; Returns a filename hwich does not currently reference a file within the path." +;; [path file-name] +;; (if (.exists (File. (str path file-name))) +;; (let [parts (cs/split file-name #"\.") +;; prefix (cs/join "." (butlast parts)) +;; suffix (last parts)] +;; (first +;; (filter #(not (.exists (File. (str path %)))) +;; (map #(str prefix "." % "." suffix) (range))))) +;; file-name)) -(defn read-image - "Reads a BufferedImage from source, something that can be turned into - a file with clojure.java.io/file" - [source] - (ImageIO/read (io/file source))) - -(defn write-image - "Writes img, a RenderedImage, to dest, something that can be turned into - a file with clojure.java.io/file. - Takes the following keys as options: - :format - :gif, :jpg, :png or anything supported by ImageIO - :quality - for JPEG images, a number between 0 and 100" - [^RenderedImage img dest & {:keys [format quality] :or {format :jpg}}] - (log/info "Writing to " dest) - (let [fmt (subs (fs/extension (cs/lower-case dest)) 1) - iw (doto ^ImageWriter (first - (iterator-seq - (ImageIO/getImageWritersByFormatName - fmt))) - (.setOutput (FileImageOutputStream. (io/file dest)))) - iw-param (doto ^ImageWriteParam (.getDefaultWriteParam iw) - (.setCompressionMode ImageWriteParam/MODE_EXPLICIT) - (.setCompressionQuality (float (/ (or quality 75) 100)))) - iio-img (IIOImage. img nil nil)] - (.write iw nil iio-img iw-param))) - -(def image? - "True if the file at this `filename` appears as though it may be an image" - (memoize - (fn [filename] - (image-file-extns (fs/extension (cs/lower-case (str filename))))))) - -(defn auto-thumbnail - "For each of the thumbnail sizes in the configuration, create a thumbnail - for the file with this `filename` on this `path`, provided that it is a - scalable image and is larger than the size." - ([^String path ^String filename] - (if - (image? filename) - (let [original (buffered-image (File. (str path filename)))] ;; fs/file? - (map - #(auto-thumbnail path filename % original) - (keys (config :thumbnails)))) - (log/info filename " cannot be thumbnailed."))) - ([^String path ^String filename size ^RenderedImage image] - (let [s (-> config :thumbnails size) - d (dimensions image) - p (io/file path (name size) filename)] - (if (and (integer? s) (some #(> % s) d)) - (do - (write-image (resize image s s) p) - (log/info "Created a " size " thumbnail of " filename) - {:size size :filename filename :location (str p) :is-image true}) - (log/info filename "is smaller than " s "x" s " and was not scaled to " size))))) (defn store-upload "Store an upload both to the file system and to the database. The issue with storing an upload is moving it into place. If `params` are passed as a map, it is expected that this is a map from - an HTTP POST operation of a form with type `multipart/form-data`. - - On success, returns the file object uploaded." + an HTTP POST operation of a form with type `multipart/form-data`." [params path] (let [upload (:upload params) tmp-file (:tempfile upload) filename (:filename upload)] - (log/info + (timbre/info (str "Storing upload file: " upload)) - (log/debug - (str "store-upload mv file: " tmp-file " to: " path filename)) - (if tmp-file - (try - (let [p (io/file path filename)] - (.renameTo tmp-file p) - (map - #(assoc % :resource (subs (:location %) (inc (count util/content-dir)))) - (remove - nil? - (cons - {:size :original - :filename filename - :location (str p) - :is-image (and (image? filename) true)} - (remove nil? (or (auto-thumbnail path filename) '())))))) - (catch Exception x - (log/error (str "Failed to move " tmp-file " to " path filename "; " (type x) ": " (.getMessage x))) - (throw x))) - (throw (Exception. "No file found?"))))) + (if tmp-file + (do + (.renameTo tmp-file + (File. (str path filename))) + filename) + (throw (Exception. "No file found?"))))) diff --git a/src/smeagol/util.clj b/src/smeagol/util.clj index 6989681..015a5db 100644 --- a/src/smeagol/util.clj +++ b/src/smeagol/util.clj @@ -2,17 +2,14 @@ :author "Simon Brooke"} smeagol.util (:require [clojure.java.io :as cjio] - [clojure.string :as cs] [environ.core :refer [env]] - [markdown.core :as md] - [me.raynes.fs :as fs] [noir.io :as io] [noir.session :as session] [scot.weft.i18n.core :as i18n] [smeagol.authenticate :as auth] [smeagol.configuration :refer [config]] - [smeagol.local-links :refer :all] - [taoensso.timbre :as log])) + [smeagol.formatting :refer [md->html]] + [taoensso.timbre :as timbre])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -38,99 +35,11 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(def start-page - "The page to load on startup, taken from configuration." - (:start-page config)) - (def content-dir - "The absolute path to the directory in which Wiki content (i.e., Markdown - files) are stored." - (str - (fs/absolute - (or - (:content-dir config) - (cjio/file (io/resource-path) "content"))))) + (or + (:content-dir config) + (cjio/file (io/resource-path) "content"))) -(def upload-dir - "The absolute path to the directory in which uploaded files are stored." - (str (cjio/file content-dir "uploads"))) - -(def local-url-base - "Essentially, the slash-terminated absolute path of the `public` resource - directory." - (let [a (str (fs/absolute content-dir))] - (subs a 0 (- (count a) (count "content"))))) - -(defn not-servable-reason - "As a string, the reason this `file-path` cannot safely be served, or `nil` - if it is safe to serve. This reason may be logged, but should *not* be - shown to remote users, as it would allow file system probing." - [file-path] - (try - (let [path (if - (cs/starts-with? (str file-path) "/") - file-path - (cjio/file local-url-base file-path))] - (cond - (cs/includes? file-path "..") - (cs/join " " file-path - "Attempts to ascend the file hierarchy are disallowed.") - (not (cs/starts-with? path local-url-base)) - (cs/join " " [path "is not servable"]) - (not (fs/exists? path)) - (cs/join " " [path "does not exist"]) - (not (fs/readable? path)) - (cs/join " " [path "is not readable"]))) - (catch Exception any (cs/join " " file-path "is not servable because" (.getMessage any))))) - - -;; (not-servable-reason "/home/simon/workspace/smeagol/resources/public/content/vendor/node_modules/photoswipe/dist/photoswipe.min.js") -;; (not-servable-reason "/root/froboz") - -(defn local-url? - "True if this `file-path` can be served as a local URL, else false." - [file-path] - (try - (if - (empty? (not-servable-reason file-path)) - true - (do - (log/error - "In `smeagol.util/local-url? `" file-path "` is not a servable resource.") - false)) - (catch Exception any - (log/error - "In `smeagol.util/local-url `" file-path "` is not a servable resource:" any) - false))) - -(defn local-url - "Return a local URL for this `file-path`, or a deliberate 404 if none - can be safely served." - ;; TODO: this actually returns a relative URL relative to local-url-base. - ;; That's not quite what we want because in Tomcat contexts the absolute - ;; URL may be different. We *ought* to be able to extract the offset from the - ;; servlet context, but it may be simpler to jam it in the config. - [file-path] - (try - (let [path (if - (cs/starts-with? file-path local-url-base) - (subs file-path (count local-url-base)) - file-path) - problem (not-servable-reason path)] - (if - (empty? problem) - path - (do - (log/error - "In `smeagol.util/local-url `" file-path "` is not a servable resource.") - (str "404-not-found?path=" file-path)))) - (catch Exception any - (log/error - "In `smeagol.util/local-url `" file-path "` is not a servable resource:" any) - (str "404-not-found?path=" file-path)))) - -;; (local-url? "vendor/node_modules/photoswipe/dist/photoswipe.min.js") -;; (local-url? "/home/simon/workspace/smeagol/resources/public/vendor/node_modules/photoswipe/dist/photoswipe.min.js") (defn standard-params "Return a map of standard parameters to pass to the template renderer." @@ -138,43 +47,37 @@ (let [user (session/get :user)] {:user user :admin (auth/get-admin user) - :js-from (:js-from config) - :side-bar (md/md-to-html-string - (local-links - (slurp (cjio/file content-dir "_side-bar.md"))) - :heading-anchors true) - :header (md/md-to-html-string - (local-links - (slurp (cjio/file content-dir "_header.md"))) - :heading-anchors true) + :side-bar (md->html (slurp (cjio/file content-dir "_side-bar.md"))) + :header (md->html (slurp (cjio/file content-dir "_header.md"))) :version (System/getProperty "smeagol.version")})) -(def get-messages +(defn- raw-get-messages "Return the most acceptable messages collection we have given the `Accept-Language` header in this `request`." - (memoize - (fn [request] - (let [specifier ((:headers request) "accept-language") - messages (try - (i18n/get-messages specifier "i18n" "en-GB") - (catch Exception any - (log/error - any - (str - "Failed to parse accept-language header '" - specifier - "'")) - {}))] + [request] + (let [specifier ((:headers request) "accept-language") + messages (try + (i18n/get-messages specifier "i18n" "en-GB") + (catch Exception any + (timbre/error + any + (str + "Failed to parse accept-language header " + specifier)) + {}))] (merge messages - config))))) + config))) + + +(def get-messages (memoize raw-get-messages)) (defn get-message "Return the message with this `message-key` from this `request`. - if not found, return this `default`, if provided; else return the - `message-key`." + if not found, return this `default`, if provided; else return the + `message-key`." ([message-key request] (get-message message-key message-key request)) ([message-key default request] diff --git a/test/smeagol/test/formatting.clj b/test/smeagol/test/formatting.clj index 18769cd..2887047 100644 --- a/test/smeagol/test/formatting.clj +++ b/test/smeagol/test/formatting.clj @@ -1,43 +1,12 @@ (ns smeagol.test.formatting (:require [clojure.test :refer :all] - [clojure.string :as cs] - [smeagol.formatting :refer :all] - [smeagol.extensions.test :refer :all] - [smeagol.local-links :refer :all])) + [smeagol.formatting :refer [local-links no-text-error]])) -(deftest test-apply-formatter - (testing "apply-formatter" - (let [actual (-> (apply-formatter - 3 - {:inclusions {}} - '() - '() - "test -  -  -  - " - "test" - smeagol.extensions.test/process-test) - :inclusions - :inclusion-3) - expected ""] - (is (= actual expected))))) - -(deftest test-md->html - (let [actual (:content (md->html - {:source - (cs/join - "\n" - ["# This is a test" - "" - "```test" - "" - "```" - "" - "This concludes the test"])} )) - expected (str - "
This is a test
" - "" - "This concludes the test
")] - (is (= expected actual)))) +(deftest test-local-links + (testing "Rewriting of local links" + (is (= (local-links nil) no-text-error) "Should NOT fail with a no pointer exception!") + (is (= (local-links "") "") "Empty string should pass through unchanged.") + (is (= (local-links "[[froboz]]") "froboz") "Local link should be rewritten.") + (let [text (str "# This is a heading" + "[This is a foreign link](http://to.somewhere)")] + (is (= (local-links text) text) "Foreign links should be unchanged")))) diff --git a/test/smeagol/test/include.clj b/test/smeagol/test/include.clj deleted file mode 100644 index 3a037f1..0000000 --- a/test/smeagol/test/include.clj +++ /dev/null @@ -1,106 +0,0 @@ -(ns smeagol.test.include - (:require [clojure.test :refer :all] - [schema.core :as s] - [com.stuartsierra.component :as component] - [smeagol.include.resolve :as resolve] - [smeagol.include :as sut])) - -(def include-simple - "# Heading1 -&[](./simple.md)") - -(def include-surounding-simple - "# Heading1 -Some surounding &[](./simple.md) text") - -(def include-heading-0 - "# Heading1 -&[:indent-heading 0](./with-heading.md)") - -(def include-heading-list-1 - "# Heading1 -&[:indent-heading 1 :indent-list 1](./with-heading-and-list.md)") - -(def include-heading-list-0 - "# Heading1 -&[:indent-list 0 :indent-heading 0](./with-heading-and-list.md)") - -(def include-invalid-indent - "# Heading1 -&[ invalid input should default to indent 0 ](./simple.md)") - -(def include-spaced-indent - "# Heading1 -&[ :indent-heading 2 :indent-list 33 ](./with-heading-and-list.md)") - -(def multi - "# Heading1 -&[ :indent-heading 2 :indent-list 33 ](./with-heading-and-list.md) -some text -&[](./simple.md) -more text.") - -(s/defmethod resolve/do-resolve-md :test-mock - [resolver - uri :- s/Str] - (cond - (= uri "./simple.md") "Simple content." - (= uri "./with-heading-and-list.md") "# Heading2 -some text -* List - -## Heading 3 -more text")) - - - -(def system-under-test - (component/start - (component/system-map - :resolver (resolve/new-resolver :test-mock) - :includer (component/using - (sut/new-includer) - [:resolver])))) - -(deftest test-expand-include-md - (testing "The whole integration of include" - (is - (= "# Heading" - (sut/expand-include-md (:includer system-under-test) "# Heading"))) - (is - (= "# Heading1 -Simple content." - (sut/expand-include-md - (:includer system-under-test) - include-simple))) - (is - (= "# Heading1 -Some surounding Simple content. text" - (sut/expand-include-md - (:includer system-under-test) - include-surounding-simple))) - (is - (= "# Heading1 -# Heading2 -some text -* List - -## Heading 3 -more text" - (sut/expand-include-md - (:includer system-under-test) - include-heading-list-0))) - (is - (= "# Heading1 -### Heading2 -some text - * List - -#### Heading 3 -more text -some text -Simple content. -more text." - (sut/expand-include-md - (:includer system-under-test) - multi))))) diff --git a/test/smeagol/test/include/indent.clj b/test/smeagol/test/include/indent.clj deleted file mode 100644 index b4ca363..0000000 --- a/test/smeagol/test/include/indent.clj +++ /dev/null @@ -1,35 +0,0 @@ -(ns smeagol.test.include.indent - (:require [clojure.test :refer :all] - [smeagol.include.indent :as sut])) - -(deftest test-parse-heading - (testing - (is (= '(["# " "# " "" "# "]) - (sut/parse-heading "# h1"))) - (is (= '(["\n# " "\n# " "\n" "# "]) - (sut/parse-heading "\n# h1"))))) - -(deftest test-indent-heading - (testing - (is (= "# h1" - (sut/do-indent-heading 0 "# h1"))) - (is (= "### h1" - (sut/do-indent-heading 2 "# h1"))) - (is (= "\n### h1" - (sut/do-indent-heading 2 "\n# h1"))))) - -(deftest test-parse-list - (testing - (is (= '([" * " " * " " " "* "]) - (sut/parse-list " * list"))) - (is (= '(["\n * " "\n * " "\n " "* "]) - (sut/parse-list "\n * list"))))) - -(deftest test-indent-list - (testing - (is (= " * list" - (sut/do-indent-list 0 " * list"))) - (is (= " * list" - (sut/do-indent-list 2 " * list"))) - (is (= "\n * list" - (sut/do-indent-list 2 "\n * list"))))) diff --git a/test/smeagol/test/include/parse.clj b/test/smeagol/test/include/parse.clj deleted file mode 100644 index af27abf..0000000 --- a/test/smeagol/test/include/parse.clj +++ /dev/null @@ -1,91 +0,0 @@ -(ns smeagol.test.include.parse - (:require [clojure.test :refer :all] - [schema.core :as s] - [smeagol.include.parse :as sut])) - -(def include-simple - "# Heading1 -&[](./simple.md)") - -(def include-surounding-simple - "# Heading1 -Some surounding &[](./simple.md) text") - -(def include-heading-0 - "# Heading1 -&[:indent-heading 0](./with-heading.md)") - -(def include-heading-list-1 - "# Heading1 -&[:indent-heading 1 :indent-list 1](./with-heading-and-list.md)") - -(def include-heading-list-0 - "# Heading1 -&[:indent-list 0 :indent-heading 0](./with-heading-and-list.md)") - -(def include-invalid-indent - "# Heading1 -&[ invalid input should default to indent 0 ](./simple.md)") - -(def include-spaced-indent - "# Heading1 -&[ :indent-heading 2 :indent-list 33 ](./with-heading-and-list.md)") - -(def multi - "# Heading1 -&[ :indent-heading 2 :indent-list 33 ](./with-heading-and-list.md) -some text -&[](./simple.md) -more text.") - - -(deftest test-parse-include-md - (testing "parse include links" - (is - (= [] - (sut/parse-include-md "# Heading"))) - (is - (= [{:replace "&[](./simple.md)" :uri "./simple.md", :indent-heading 0, :indent-list 0}] - (sut/parse-include-md - include-simple))) - (is - (= [{:replace "&[](./simple.md)" :uri "./simple.md", :indent-heading 0, :indent-list 0}] - (sut/parse-include-md - include-surounding-simple))) - (is - (= [{:replace "&[:indent-heading 0](./with-heading.md)" :uri "./with-heading.md", :indent-heading 0, :indent-list 0}] - (sut/parse-include-md - include-heading-0))) - (is - (= [{:replace - "&[:indent-heading 1 :indent-list 1](./with-heading-and-list.md)" - :uri "./with-heading-and-list.md", :indent-heading 1, :indent-list 1}] - (sut/parse-include-md - include-heading-list-1))) - (is - (= [{:replace - "&[:indent-list 0 :indent-heading 0](./with-heading-and-list.md)" - :uri "./with-heading-and-list.md", :indent-heading 0, :indent-list 0}] - (sut/parse-include-md - include-heading-list-0))) - (is - (= [{:replace - "&[ invalid input should default to indent 0 ](./simple.md)" - :uri "./simple.md", :indent-heading 0, :indent-list 0}] - (sut/parse-include-md - include-invalid-indent))) - (is - (= [{:replace - "&[ :indent-heading 2 :indent-list 33 ](./with-heading-and-list.md)" - :uri "./with-heading-and-list.md", :indent-heading 2, :indent-list 3}] - (sut/parse-include-md - include-spaced-indent))) - (is - (= [{:replace - "&[ :indent-heading 2 :indent-list 33 ](./with-heading-and-list.md)" - :uri "./with-heading-and-list.md", - :indent-heading 2, - :indent-list 3} - {:replace "&[](./simple.md)" :uri "./simple.md", :indent-heading 0, :indent-list 0}] - (sut/parse-include-md - multi))))) diff --git a/test/smeagol/test/include/resolve.clj b/test/smeagol/test/include/resolve.clj deleted file mode 100644 index 4da32ed..0000000 --- a/test/smeagol/test/include/resolve.clj +++ /dev/null @@ -1,8 +0,0 @@ -(ns smeagol.test.include.resolve - (:require [clojure.test :refer :all] - [smeagol.include.resolve :as sut])) - -(deftest test-local-links - (testing "Rewriting of local links" - (is (thrown? Exception - (sut/resolve-md (sut/new-resolver (:default)) "./some-uri.md"))))) diff --git a/test/smeagol/test/local_links.clj b/test/smeagol/test/local_links.clj deleted file mode 100644 index dc3682d..0000000 --- a/test/smeagol/test/local_links.clj +++ /dev/null @@ -1,19 +0,0 @@ -(ns smeagol.test.local-links - (:require [clojure.test :refer :all] - [clojure.string :as cs] - [smeagol.local-links :refer [local-links no-text-error]] - [smeagol.extensions.test :refer :all] - [smeagol.local-links :refer :all])) - -(deftest test-local-links - (testing "Rewriting of local links" - (is (= (local-links nil) no-text-error) "Should NOT fail with a no pointer exception!") - (is (= (local-links "") "") "Empty string should pass through unchanged.") - (is (= (local-links "[[froboz]]") "froboz") "Local link should be rewritten.") - (let [text (str "# This is a heading" - "[This is a foreign link](http://to.somewhere)")] - (is (= (local-links text) text) "Foreign links should be unchanged")) - (let [text (cs/trim (slurp "resources/test/test_local_links.md")) - actual (local-links text) - expected "# This is a test\n\nLocal link\n[Not a local link](http://nowhere.at.al)\n\nThis concludes the test."] - (is (= actual expected)))))