| {% 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 %} | ||
@@ -9,26 +15,31 @@
-
-
| Name | Uploaded | Type this | -To get this | +To get this |
|---|---|---|---|---|
| {{entry.base-name}} | {{entry.modified}} | - {% if entry.is-image %}  {% else %} [{{entry.name|capitalize}}](uploads/{{entry.base-name}}) {% endif %} + {% if entry.is-image %}  {% else %} [{{entry.name|capitalize}}](uploads/{{entry.resource}}) {% endif %} |
- {% if entry.is-image %} |
-
- {% if uploaded %}
- {% if is-image %}
-
+
+ {% endfor %} {% else %}
"))
+
+
+(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 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? (cio/file upload-dir (fs/base-name url)))))
+
+;; (uploaded? "content/uploads/g1.jpg")
+
+(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
+ [^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..c73d086
--- /dev/null
+++ b/src/smeagol/extensions/utils.clj
@@ -0,0 +1,85 @@
+(ns ^{:doc "Utility functions useful to extension processors."
+ :author "Simon Brooke"}
+ smeagol.extensions.utils
+ (:require [cemerick.url :refer (url url-encode url-decode)]
+ [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: 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 content-dir
+ (str
+ (fs/absolute
+ (or
+ (:content-dir config)
+ (cjio/file (io/resource-path) "content")))))
+
+(def upload-dir
+ (str (cjio/file content-dir "uploads")))
+
+(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))))))
diff --git a/src/smeagol/extensions/vega.clj b/src/smeagol/extensions/vega.clj
new file mode 100644
index 0000000..49edea0
--- /dev/null
+++ b/src/smeagol/extensions/vega.clj
@@ -0,0 +1,91 @@
+(ns ^{:doc "Format vega/vis extensions to Semagol's extended markdown format."
+ :author "Simon Brooke"}
+ smeagol.extensions.vega
+ (:require [clojure.data.json :as json]
+ [clj-yaml.core :as yaml]
+ [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 yaml->json
+ "Rewrite this string, assumed to be in YAML format, as JSON."
+ [^String yaml-src]
+ (json/write-str (yaml/parse-string yaml-src)))
+
+(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 8fe3697..3617514 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,62 +45,12 @@
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 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 (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))
-
-
-(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 "
-
+ {% if uploaded|not-empty %}
+ {% for upload in uploaded %}
+ {% if upload.is-image %}
+
+
- {% 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 %}
\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."
[^String text ^Integer index]
(str "```" (.trim text) "\n```")) @@ -103,7 +58,9 @@ (defn get-first-token "Return the first space-separated token of this `string`." [^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 @@ -113,7 +70,7 @@ `: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] + [^Integer index ^clojure.lang.Associative result ^String fragment fragments processed] (process-text (inc index) result @@ -121,62 +78,73 @@ (cons fragment processed))) -(defn- apply-formatter +(defn deep-merge [v & vs] + "Cripped in its entirety from https://clojuredocs.org/clojure.core/merge." + (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. 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] + [^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. - - 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 reassemble-text + "Reassemble these processed strings into a complete text, and process it as + Markdown." + [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." ([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 +155,74 @@ (cs/replace (kw inclusions) "\\/" "/")))))))) +(defn process-text + [^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 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. + + 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." + [^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 9cbaca5..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 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/layout.clj b/src/smeagol/layout.clj index 34a7d0a..920a9b1 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])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; 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 92cfac0..4ca288d 100644 --- a/src/smeagol/middleware.clj +++ b/src/smeagol/middleware.clj @@ -1,17 +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]] [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]] - [noir-exception.core :refer [wrap-internal-error]] - [smeagol.util :as util])) + [selmer.middleware :refer [wrap-error-page]] + [smeagol.util :as util] + [taoensso.timbre :as log])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -39,7 +39,7 @@ (defn log-request [handler] (fn [req] - (timbre/debug req) + (log/debug req) (handler req))) @@ -49,7 +49,7 @@ (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}) diff --git a/src/smeagol/routes/wiki.clj b/src/smeagol/routes/wiki.clj index a8e13ce..a5d4fde 100644 --- a/src/smeagol/routes/wiki.clj +++ b/src/smeagol/routes/wiki.clj @@ -4,6 +4,7 @@ (: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] @@ -14,6 +15,7 @@ [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] @@ -22,10 +24,12 @@ [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.include :as include] + [smeagol.util :refer [content-dir local-url]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -54,7 +58,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] - (timbre/trace (format "process-source: '%s'" request)) + (log/trace (format "process-source: '%s'" request)) (let [source-text (:src params) page (:page params) file-name (str page suffix) @@ -64,7 +68,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}) @@ -94,16 +98,16 @@ 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->html (assoc request :source (slurp (cjio/file util/content-dir side-bar)))) :content (if exists? (slurp file-path) "") :exists exists?}))))))) @@ -115,6 +119,9 @@ (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) @@ -122,10 +129,66 @@ (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 + ([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] - (timbre/trace (format "wiki-page: '%s'" request)) + (log/trace (format "wiki-page: '%s'" request)) (or (show-sanity-check-error) (let [params (keywordize-keys (:params request)) @@ -133,19 +196,24 @@ 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 - (include/expand-include-md - (:includer md-include-system) - (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 @@ -156,10 +224,11 @@ 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 (util/get-message :history-title-prefix request) + {:title (str (util/get-message :history-title-prefix request) + " " page) :page page :history (hist/find-history repo-path file-name)})))) @@ -173,7 +242,7 @@ 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 "EEEE, dd MMMM YYYY")) + (format-instant unix-time "dd MMMM YYYY")) ([^Long unix-time ^String template] (jt/format (java-time/formatter template) @@ -186,24 +255,27 @@ [request] (let [params (keywordize-keys (:params request)) - data-path (str util/content-dir "/uploads/") files - (map - #(zipmap - [:base-name :is-image :modified :name] - [(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 %)]) - (remove - #(or (cs/starts-with? (fs/name %) ".") - (fs/directory? %)) - (file-seq (clojure.java.io/file data-path))))] + (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) @@ -224,6 +296,7 @@ files) })))) + ;;;; end of list-uploads section ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn upload-page @@ -236,20 +309,18 @@ 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 (str data-path (fs/name 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 (if uploaded (fs/base-name uploaded)) - :is-image (if - uploaded - (image-extns - (cs/lower-case - (fs/extension uploaded))))})))) + :uploaded uploaded})))) (defn version-page "Render a specific historical version of a page" @@ -259,7 +330,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) @@ -274,7 +345,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 @@ -303,11 +374,11 @@ action (:action form-params) user (session/get :user) redirect-to (:redirect-to params)] - (if redirect-to (timbre/info (str "After auth, redirect to: " redirect-to))) + (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)) diff --git a/src/smeagol/uploads.clj b/src/smeagol/uploads.clj index 7cadaea..34f43c3 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,21 +39,65 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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? + (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. @@ -56,17 +110,25 @@ (let [upload (:upload params) tmp-file (:tempfile upload) filename (:filename upload)] - (timbre/info + (log/info (str "Storing upload file: " upload)) - (timbre/debug + (log/debug (str "store-upload mv file: " tmp-file " to: " path filename)) (if tmp-file (try - (do - (.renameTo tmp-file - (File. (str path filename))) - (File. (str path filename))) + (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 - (timbre/error (str "Failed to move " tmp-file " to " path filename "; " (type x) ": " (.getMessage 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 c3ce6d4..86fdfac 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])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -39,10 +42,91 @@ (:start-page config)) (def content-dir - (or - (:content-dir config) - (cjio/file (io/resource-path) "content"))) + (str + (fs/absolute + (or + (:content-dir config) + (cjio/file (io/resource-path) "content"))))) +(def upload-dir + (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." @@ -51,38 +135,42 @@ {:user user :admin (auth/get-admin user) :js-from (:js-from config) - :side-bar (md->html (slurp (cjio/file content-dir "_side-bar.md"))) - :header (md->html (slurp (cjio/file content-dir "_header.md"))) + :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/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)))))