Developed by 
Developed by | {% i18n edit-col-hdr %} | {% i18n del-col-hdr %} | +|||||||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| {% i18n user-title-prefix %} | +{% 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 a91865e..3e63f17 100644
--- a/resources/templates/upload.html
+++ b/resources/templates/upload.html
@@ -1,22 +1,27 @@
{% 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 %}
- {% if is-image %}
-
+
+ {% endfor %} {% else %} {% endif %} +
{% endblock %}
diff --git a/resources/templates/wiki.html b/resources/templates/wiki.html
index 0a4b1ec..81634ea 100644
--- a/resources/templates/wiki.html
+++ b/resources/templates/wiki.html
@@ -1,15 +1,10 @@
{% extends "templates/base.html" %}
{% block extra-headers %}
- {% style "vendor/mermaid/dist/mermaid.css" %}
-
-
- {% script "vendor/vega-lite/build/vega-lite.js" %}
-
-
- {% script "vendor/mermaid/dist/mermaid.js" %}
+ {% for script in scripts %}
+ {% endfor %}
+ {% for style in styles %}
+ {% endfor %}
{% endblock %}
{% block content %}
diff --git a/resources/test/test_extension.md b/resources/test/test_extension.md
new file mode 100644
index 0000000..1f43160
--- /dev/null
+++ b/resources/test/test_extension.md
@@ -0,0 +1,7 @@
+# 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
new file mode 100644
index 0000000..659f03a
--- /dev/null
+++ b/resources/test/test_local_links.md
@@ -0,0 +1,6 @@
+# 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
new file mode 100644
index 0000000..e69de29
diff --git a/src/smeagol/authenticate.clj b/src/smeagol/authenticate.clj
index e4219e9..02cf57b 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 timbre]))
+ [taoensso.timbre :as log]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
@@ -37,6 +37,8 @@
;; 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")))
@@ -52,7 +54,7 @@
"Return `true` if this `username`/`password` pair match, `false` otherwise"
[username password]
(let [user ((keyword username) (get-users))]
- (timbre/info (str "Authenticating " username " against " password-file-path))
+ (log/info (str "Authenticating " username " against " password-file-path))
(and user
(:password user)
(or
@@ -92,7 +94,7 @@
Return `true` if password was successfully changed. Subsequent to user change, their
password will be encrypted."
[username oldpass newpass]
- (timbre/info (format "Changing password for user %s" username))
+ (log/info (format "Changing password for user %s" username))
(let [users (get-users)
keywd (keyword username)
user (keywd users)
@@ -110,10 +112,10 @@
{keywd
(merge user
{:password (password/encrypt newpass)})})))
- (timbre/info (str "Successfully changed password for user " username))
+ (log/info (str "Successfully changed password for user " username))
true))
(catch Exception any
- (timbre/error any
+ (log/error any
(format "Changing password failed for user %s failed: %s (%s)"
username (.getName (.getClass any)) (.getMessage any)))
false))))
@@ -138,7 +140,7 @@
`email` address and `admin` flag; *or*, modify an existing user. Return true
if user is successfully stored, false otherwise."
[username newpass email admin]
- (timbre/info "Trying to add user " username)
+ (log/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"))
@@ -160,10 +162,10 @@
(locking password-file-path
(spit password-file-path
(assoc users (keyword username) (merge user full-details)))
- (timbre/info "Successfully added user " username)
+ (log/info "Successfully added user " username)
true)
(catch Exception any
- (timbre/error any
+ (log/error any
(format "Adding user %s failed: %s (%s)"
username (.getName (.getClass any)) (.getMessage any)))
false)))))
@@ -177,10 +179,10 @@
(locking password-file-path
(spit password-file-path
(dissoc users (keyword username)))
- (timbre/info (str "Successfully deleted user " username))
+ (log/info (str "Successfully deleted user " username))
true)
(catch Exception any
- (timbre/error any
+ (log/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 f4631f9..469f338 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 timbre]))
+ [taoensso.timbre :as log]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
@@ -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]
- (timbre/debug
+ (log/debug
"transform-map:\n"
(with-out-str (clojure.pprint/pprint m)))
(reduce
@@ -100,38 +100,52 @@
'( {: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}))
-(defn build-config
- []
+(def 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."
- (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")
- {})))
+ (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")
+ {})))))
-(def config (build-config))
+(def config
+ "The actual configuration, as a map."
+ (build-config))
diff --git a/src/smeagol/extensions/mermaid.clj b/src/smeagol/extensions/mermaid.clj
new file mode 100644
index 0000000..6185b5d
--- /dev/null
+++ b/src/smeagol/extensions/mermaid.clj
@@ -0,0 +1,85 @@
+(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 "
- 
+
- {% i18n file-upload-link-text %}:
+
+ This is the {{upload.size|name}} file. {% i18n file-upload-link-text %}:
-
-
- {% i18n file-upload-link-text %}:
+ 
+
+ {% i18n file-upload-link-text %}:
- [Uploaded file](uploads/{{uploaded}})
-
[{{upload.filename}}]({{upload.resource}})
+
+ {% endif %}
+ +
+ {% endfor %} {% 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
new file mode 100644
index 0000000..d145943
--- /dev/null
+++ b/src/smeagol/extensions/photoswipe.clj
@@ -0,0 +1,176 @@
+(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
new file mode 100644
index 0000000..ffe5c1a
--- /dev/null
+++ b/src/smeagol/extensions/test.clj
@@ -0,0 +1,10 @@
+(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
new file mode 100644
index 0000000..cfa4546
--- /dev/null
+++ b/src/smeagol/extensions/utils.clj
@@ -0,0 +1,94 @@
+(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
new file mode 100644
index 0000000..1a8a8bd
--- /dev/null
+++ b/src/smeagol/extensions/vega.clj
@@ -0,0 +1,84 @@
+(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 6a874c8..8f0d92b 100644
--- a/src/smeagol/formatting.clj
+++ b/src/smeagol/formatting.clj
@@ -1,4 +1,4 @@
-(ns ^{:doc "Format Semagol's enhanced markdown format."
+(ns ^{:doc "Format Semagol's extended markdown format."
:author "Simon Brooke"}
smeagol.formatting
(:require [clojure.data.json :as json]
@@ -6,7 +6,12 @@
[cemerick.url :refer (url url-encode url-decode)]
[clj-yaml.core :as yaml]
[markdown.core :as md]
- [smeagol.configuration :refer [config]]))
+ [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]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
@@ -40,70 +45,26 @@
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 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 `md->html` filter."
+ from the `process-text` filter.
+
+ **NOTE** that it is not expected that this function forms part of a stable
+ API."
[^String text ^Integer index]
(str "```" (.trim text) "\n```")) (defn get-first-token - "Return the first space-separated token of this `string`." + "Return the first space-separated token of the first line of this `string`, + or `nil` if there is none." [^String string] - (if string (first (cs/split string #"[^a-zA-Z0-9]+")))) + (try + (if string (first (cs/split (first (cs/split-lines string)) #"[^a-zA-Z0-9]+"))) + (catch NullPointerException _ nil))) (defn- process-markdown-fragment @@ -112,8 +73,11 @@ 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." - [index result fragment fragments processed] + 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] (process-text (inc index) result @@ -121,62 +85,90 @@ (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. + `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. 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." - [index result fragments processed fragment token formatter] + 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] (let - [kw (keyword (str "inclusion-" index))] + [inky (keyword (str "inclusion-" index)) + fkey (keyword token)] (process-text (inc index) - (assoc-in result [:inclusions kw] (apply formatter (list (subs fragment (count token)) index))) - (rest fragments) - (cons kw processed)))) + (deep-merge + result + {:inclusions {inky (eval (list formatter (subs fragment (count token)) index))} + :extensions {fkey (-> config :formatters fkey)}}) + (rest fragments) + (cons inky processed)))) -(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. +(defn- reassemble-text + "Reassemble these processed strings into a complete text, and process it as + Markdown. - 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))))) + **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)))) -(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." +(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." ([processed-text] - (reintegrate-inclusions (:inclusions processed-text) (:text processed-text))) + (assoc + processed-text + :content + (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 @@ -187,9 +179,89 @@ (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 - "Take this markdown source, and return HTML." - [md-src] - (reintegrate-inclusions (process-text md-src))) + "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"))}) + + + diff --git a/src/smeagol/handler.clj b/src/smeagol/handler.clj index d25e415..db580e6 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 timbre] + [taoensso.timbre :as log] [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" [] - (timbre/info "smeagol is shutting down...") + (log/info "smeagol is shutting down...") (cronj/shutdown! session-manager/cleanup-job) - (timbre/info "shutdown complete!")) + (log/info "shutdown complete!")) (defn init @@ -67,7 +67,7 @@ put any initialization code here" [] (try - (timbre/merge-config! + (log/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 - (timbre/info "\n-=[ smeagol started successfully" + (log/info "\n-=[ smeagol started successfully" (when (env :dev) "using the development profile") "]=-") (catch Exception any - (timbre/error any "Failure during startup") + (log/error any "Failure during startup") (destroy)))) ;; timeout sessions after 30 minutes @@ -97,6 +97,7 @@ [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 aca6dbe..e567db3 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 [taoensso.timbre :as timbre] - [clj-jgit.porcelain :as git] + (:require [clj-jgit.porcelain :as git] [clj-jgit.internal :as i] - [clj-jgit.querying :as q]) + [clj-jgit.querying :as q] + [taoensso.timbre :as log]) (: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] - (timbre/info (format "searching '%s' for '%s'" log-entry file-path)) + (log/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,6 +54,7 @@ (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 new file mode 100644 index 0000000..8f8a017 --- /dev/null +++ b/src/smeagol/include.clj @@ -0,0 +1,61 @@ +(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 new file mode 100644 index 0000000..f92a69c --- /dev/null +++ b/src/smeagol/include/indent.clj @@ -0,0 +1,58 @@ +(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 new file mode 100644 index 0000000..0016252 --- /dev/null +++ b/src/smeagol/include/parse.clj @@ -0,0 +1,50 @@ +(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 new file mode 100644 index 0000000..266a276 --- /dev/null +++ b/src/smeagol/include/resolve.clj @@ -0,0 +1,46 @@ +(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 new file mode 100644 index 0000000..a603f8a --- /dev/null +++ b/src/smeagol/include/resolve_local_file.clj @@ -0,0 +1,31 @@ +(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 34a7d0a..0fa5334 100644 --- a/src/smeagol/layout.clj +++ b/src/smeagol/layout.clj @@ -12,8 +12,7 @@ [selmer.parser :as parser] [smeagol.configuration :refer [config]] [smeagol.sanity :refer :all] - [smeagol.util :as util] - [taoensso.timbre :as timbre])) + [smeagol.util :as util])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -38,7 +37,11 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(def template-path "templates/") +(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/") (parser/add-tag! :csrf-field (fn [_ _] (anti-forgery-field))) @@ -49,10 +52,14 @@ (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 [template params] +(deftype RenderableTemplate +;; Boilerplate from Luminus. Load a template file into an object which may +;; be rendered. + [template params] Renderable (render [this request] (try @@ -76,6 +83,8 @@ (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 new file mode 100644 index 0000000..f1bed0b --- /dev/null +++ b/src/smeagol/local_links.clj @@ -0,0 +1,50 @@ +(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 82ccb59..4ca288d 100644 --- a/src/smeagol/middleware.clj +++ b/src/smeagol/middleware.clj @@ -1,12 +1,17 @@ (ns ^{:doc "In truth, boilerplate provided by LuminusWeb." :author "Simon Brooke"} smeagol.middleware - (:require [taoensso.timbre :as timbre] - [environ.core :refer [env]] - [selmer.middleware :refer [wrap-error-page]] + (:require [environ.core :refer [env]] + [noir-exception.core :refer [wrap-internal-error]] [prone.middleware :refer [wrap-exceptions]] [ring.middleware.anti-forgery :refer [wrap-anti-forgery]] - [noir-exception.core :refer [wrap-internal-error]])) + [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])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -34,7 +39,7 @@ (defn log-request [handler] (fn [req] - (timbre/debug req) + (log/debug req) (handler req))) @@ -44,7 +49,12 @@ (def production-middleware - [#(wrap-internal-error % :log (fn [e] (timbre/error e)))]) + [#(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 %)]) (defn load-middleware [] diff --git a/src/smeagol/routes/admin.clj b/src/smeagol/routes/admin.clj index 106ca35..a092f63 100644 --- a/src/smeagol/routes/admin.clj +++ b/src/smeagol/routes/admin.clj @@ -33,7 +33,7 @@ (defn edit-users - "Put a list of users on-screen for editing." + "Render a page showing a list of users for editing." [request] (let [params (keywordize-keys (:params request)) user (session/get :user)] @@ -43,7 +43,8 @@ :users (auth/list-users)})))) (defn delete-user - "Delete a user." + "Render a form allowing a user to be deleted; and + process that form.." [request] (let [params (keywordize-keys (:params request)) target (:target params) @@ -59,7 +60,8 @@ (defn edit-user - "Put an individual user's details on screen for editing." + "Render a form showing an individual user's details for editing; and + process that form." [request] (let [params (keywordize-keys (:params request))] (try diff --git a/src/smeagol/routes/wiki.clj b/src/smeagol/routes/wiki.clj index fe80349..27ec424 100644 --- a/src/smeagol/routes/wiki.clj +++ b/src/smeagol/routes/wiki.clj @@ -4,23 +4,34 @@ (: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 timbre])) + [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]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -49,6 +60,7 @@ "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) @@ -58,7 +70,7 @@ user (session/get :user) email (auth/get-email user) summary (format "%s: %s" user (or (:summary params) "no summary"))] - (timbre/info (format "Saving %s's changes ('%s') to %s in file '%s'" user summary page file-path)) + (log/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}) @@ -88,16 +100,19 @@ user (session/get :user)] (if-not exists? - (timbre/info + (log/info (format "File '%s' not found; creating a new file" file-path)) - (timbre/info (format "Opening '%s' for editing" file-path))) + (log/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->html (slurp (cjio/file util/content-dir side-bar))) + :side-bar (md/md-to-html-string + (local-links + (slurp (cjio/file content-dir side-bar))) + :heading-anchors true) :content (if exists? (slurp file-path) "") :exists exists?}))))))) @@ -108,26 +123,106 @@ (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/get-message :default-page-title "Introduction" request)) + page (or (:page params) util/start-page (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))] - (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)))))) + (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)))))) (defn history-page @@ -138,42 +233,105 @@ page (url-decode (or (:page params) (util/get-message :default-page-title request))) file-name (str page ".md") repo-path util/content-dir] - (timbre/info (format "Showing history of page '%s'" page)) + (log/info (format "Showing history of page '%s'" page)) (layout/render "history.html" (merge (util/standard-params request) - {:title (str "History of " page) + {:title (str (util/get-message :history-title-prefix request) + " " 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 (io/resource-path) "/content/uploads/") + data-path (str util/content-dir "/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"))] - (if - uploaded - (do - (git/git-add git-repo uploaded) - (git/git-commit git-repo summary {:name user :email (auth/get-email user)}))) +;; 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)}))) (layout/render "upload.html" (merge (util/standard-params request) {:title (util/get-message :file-upload-title request) - :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")))})))) + :uploaded uploaded})))) (defn version-page @@ -184,7 +342,7 @@ version (:version params) file-name (str page ".md") content (hist/fetch-version util/content-dir file-name version)] - (timbre/info (format "Showing version '%s' of page '%s'" version page)) + (log/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) @@ -199,7 +357,7 @@ page (url-decode (or (:page params) (util/get-message :default-page-title request))) version (:version params) file-name (str page ".md")] - (timbre/info (format "Showing diff between version '%s' of page '%s' and current" version page)) + (log/info (format "Showing diff between version '%s' of page '%s' and current" version page)) (layout/render "wiki.html" (merge (util/standard-params request) {:title @@ -217,20 +375,22 @@ (defn auth-page - "Render the auth page" + "Render the authentication (login) page" [request] (or (show-sanity-check-error) - (let [params (keywordize-keys (:form-params request)) - username (:username params) - password (:password params) - action (:action params) + (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) user (session/get :user) - redirect-to (or (:redirect-to params) "/wiki")] + redirect-to (:redirect-to params)] + (if redirect-to (log/info (str "After auth, redirect to: " redirect-to))) (cond (= action (util/get-message :logout-label request)) (do - (timbre/info (str "User " user " logging out")) + (log/info (str "User " user " logging out")) (session/remove! :user) (response/redirect redirect-to)) (and username password (auth/authenticate username password)) @@ -243,8 +403,23 @@ {:title (if user (str (util/get-message :logout-link request) " " user) (util/get-message :login-link request)) - :redirect-to ((:headers request) "referer")})))))) + :redirect-to redirect-to})))))) +(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" @@ -270,8 +445,10 @@ (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))) @@ -281,11 +458,12 @@ (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)))) + (POST "/upload" request (route/restricted (upload-page request))) + (GET "/wiki" request (wiki-page request)) + ) diff --git a/src/smeagol/sanity.clj b/src/smeagol/sanity.clj index 1e3430e..e0a57f3 100644 --- a/src/smeagol/sanity.clj +++ b/src/smeagol/sanity.clj @@ -1,5 +1,7 @@ (ns ^{:doc "Functions related to sanity checks and error reporting in conditions - where the environment may not be sane." + 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." :author "Simon Brooke"} smeagol.sanity (:import (java.util Locale)) diff --git a/src/smeagol/uploads.clj b/src/smeagol/uploads.clj index 27ddceb..a6912e0 100644 --- a/src/smeagol/uploads.clj +++ b/src/smeagol/uploads.clj @@ -1,10 +1,20 @@ (ns ^{:doc "Handle file uploads." :author "Simon Brooke"} smeagol.uploads - (:import [java.io File]) (:require [clojure.string :as cs] - [noir.io :as io] - [taoensso.timbre :as timbre])) + [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])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -29,36 +39,97 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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)) +(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"}) +(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`." + an HTTP POST operation of a form with type `multipart/form-data`. + + On success, returns the file object uploaded." [params path] (let [upload (:upload params) tmp-file (:tempfile upload) filename (:filename upload)] - (timbre/info + (log/info (str "Storing upload file: " upload)) - (if tmp-file - (do - (.renameTo tmp-file - (File. (str path filename))) - filename) - (throw (Exception. "No file found?"))))) + (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?"))))) diff --git a/src/smeagol/util.clj b/src/smeagol/util.clj index 015a5db..6989681 100644 --- a/src/smeagol/util.clj +++ b/src/smeagol/util.clj @@ -2,14 +2,17 @@ :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.formatting :refer [md->html]] - [taoensso.timbre :as timbre])) + [smeagol.local-links :refer :all] + [taoensso.timbre :as log])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -35,11 +38,99 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(def content-dir - (or - (:content-dir config) - (cjio/file (io/resource-path) "content"))) +(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"))))) + +(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." @@ -47,37 +138,43 @@ (let [user (session/get :user)] {:user user :admin (auth/get-admin user) - :side-bar (md->html (slurp (cjio/file content-dir "_side-bar.md"))) - :header (md->html (slurp (cjio/file content-dir "_header.md"))) + :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) :version (System/getProperty "smeagol.version")})) -(defn- raw-get-messages +(def get-messages "Return the most acceptable messages collection we have given the `Accept-Language` header in this `request`." - [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)) - {}))] + (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 + "'")) + {}))] (merge messages - config))) - - -(def get-messages (memoize raw-get-messages)) + config))))) (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 2887047..18769cd 100644 --- a/test/smeagol/test/formatting.clj +++ b/test/smeagol/test/formatting.clj @@ -1,12 +1,43 @@ (ns smeagol.test.formatting (:require [clojure.test :refer :all] - [smeagol.formatting :refer [local-links no-text-error]])) + [clojure.string :as cs] + [smeagol.formatting :refer :all] + [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")))) +(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)))) diff --git a/test/smeagol/test/include.clj b/test/smeagol/test/include.clj new file mode 100644 index 0000000..3a037f1 --- /dev/null +++ b/test/smeagol/test/include.clj @@ -0,0 +1,106 @@ +(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 new file mode 100644 index 0000000..b4ca363 --- /dev/null +++ b/test/smeagol/test/include/indent.clj @@ -0,0 +1,35 @@ +(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 new file mode 100644 index 0000000..af27abf --- /dev/null +++ b/test/smeagol/test/include/parse.clj @@ -0,0 +1,91 @@ +(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 new file mode 100644 index 0000000..4da32ed --- /dev/null +++ b/test/smeagol/test/include/resolve.clj @@ -0,0 +1,8 @@ +(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 new file mode 100644 index 0000000..dc3682d --- /dev/null +++ b/test/smeagol/test/local_links.clj @@ -0,0 +1,19 @@ +(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)))))