From c2e771561d583b61767c1c4879a251f1e0f836fe Mon Sep 17 00:00:00 2001
From: simon <simon@journeyman.cc>
Date: Wed, 26 Jul 2017 16:51:31 +0100
Subject: [PATCH] #17: Fix.

---
 resources/config.edn            |  4 +++
 resources/templates/base.html   |  3 +-
 resources/templates/upload.html | 34 ++++++++++++++++++
 src/smeagol/routes/wiki.clj     | 26 ++++++++++++++
 src/smeagol/uploads.clj         | 64 +++++++++++++++++++++++++++++++++
 5 files changed, 130 insertions(+), 1 deletion(-)
 create mode 100644 resources/templates/upload.html
 create mode 100644 src/smeagol/uploads.clj

diff --git a/resources/config.edn b/resources/config.edn
index 6afb713..3930d1c 100644
--- a/resources/config.edn
+++ b/resources/config.edn
@@ -65,6 +65,10 @@
  :edit-users-title      "Select user to edit"
                                         ;; title of edit users page
  :email-prompt          "Email address" ;; text of the email widget prompt on edit user page
+ :file-upload-link-text "You may link to this file using a link of the form"
+                                        ;; Text introducing the link to an uploaded file
+ :file-upload-prompt    "File to upload" ;; prompt string for the file upload widget
+ :file-upload-title     "Upload a file" ;; title for the file upload page
  :is-admin-prompt       "Is administrator?"
  :home-link             "Home"          ;; text of the home link on the menu
  :login-label           "Log in!"       ;; text of the login widget on the login page
diff --git a/resources/templates/base.html b/resources/templates/base.html
index 754b31d..8d980d8 100644
--- a/resources/templates/base.html
+++ b/resources/templates/base.html
@@ -6,6 +6,7 @@
     <meta http-equiv="X-UA-Compatible" content="IE=edge">
     <meta name="viewport" content="width=device-width, initial-scale=1">
     <link href="{{servlet-context}}/content/stylesheet.css" media="screen" rel="stylesheet" type="text/css" />
+    <link href="{{servlet-context}}/css/print.css" media="print" rel="stylesheet" type="text/css" />
     {% block extra-headers %}
     {% endblock %}
   </head>
@@ -20,6 +21,7 @@
           <li class="{{edit-users-selected}}"><a href="{{servlet-context}}/edit-users">{{config.edit-users-link}}</a></li>
           {% endif %}
           {% if user %}
+          <li class="{{upload-selected}}"><a href="upload">{{config.file-upload-title}}</a></li>
           <li class="{{passwd-selected}}"><a href="passwd">{{config.change-pass-link}}</a></li>
           <li class="user" id="user">{{config.logged-in-as}} {{user}}</li>
           <li class="{{auth-selected}}"><a href="{{servlet-context}}/auth">
@@ -90,4 +92,3 @@
     <footer>
   </body>
 </html>
-
diff --git a/resources/templates/upload.html b/resources/templates/upload.html
new file mode 100644
index 0000000..ece03f4
--- /dev/null
+++ b/resources/templates/upload.html
@@ -0,0 +1,34 @@
+{% extends "templates/base.html" %}
+{% block content %}
+        Uploaded: {{uploaded}}; is-image: {{is-image}}
+        <div id="content" class="auth">
+        {% if uploaded %}
+          {% if is-image %}
+            <img alt="Uploaded image" src="uploads/{{uploaded}}"/>
+
+            <p>
+              {{config.file-upload-link-text}}:
+
+              <code>![Uploaded image](uploads/{{uploaded}})</code>
+            </p>
+          {% else %}
+            <p>
+              {{config.file-upload-link-text}}:
+
+              <code>[Uploaded file](uploads/{{uploaded}})</code>
+            </p>
+          {% endif %}
+        {% else %}
+            <form action="{{servlet-context}}/upload" enctype="multipart/form-data" method="POST">
+                <p class="widget">
+                    <label for="upload">{{config.file-upload-prompt}}</label>
+                    <input name="upload" id="upload" type="file" required/>
+                </p>
+                <p class="widget">
+                    <label for="submit">{{config.save-prompt}}</label>
+                    <input name="submit" id="submit" type="submit" class="action" value="{{config.save-label}}"/>
+                </p>
+            </form>
+        {% endif %}
+        </div>
+{% endblock %}
diff --git a/src/smeagol/routes/wiki.clj b/src/smeagol/routes/wiki.clj
index 85f6dd9..e67b6e9 100644
--- a/src/smeagol/routes/wiki.clj
+++ b/src/smeagol/routes/wiki.clj
@@ -3,6 +3,7 @@
   smeagol.routes.wiki
   (:require [clojure.walk :refer :all]
             [clojure.java.io :as cjio]
+            [clojure.string :as cs]
             [cemerick.url :refer (url url-encode url-decode)]
             [compojure.core :refer :all]
             [clj-jgit.porcelain :as git]
@@ -17,6 +18,7 @@
             [smeagol.formatting :refer [md->html]]
             [smeagol.layout :as layout]
             [smeagol.util :as util]
+            [smeagol.uploads :as ul]
             [smeagol.history :as hist]
             [smeagol.routes.admin :as admin]))
 
@@ -145,6 +147,28 @@
                            :page page
                            :history (md->html (hist/find-history repo-path file-name))}))))
 
+(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) "/uploads/")
+        upload (:upload params)
+        uploaded (if upload (ul/store-upload params))]
+    (layout/render "upload.html"
+                   (merge (util/standard-params request)
+                          {:title (:file-upload-title layout/config)
+                           :uploaded uploaded
+                           :is-image (and
+                                       uploaded
+                                       (or
+                                         (cs/ends-with? uploaded ".gif")
+                                         (cs/ends-with? uploaded ".jpg")
+                                         (cs/ends-with? uploaded ".jpeg")
+                                         (cs/ends-with? uploaded ".png")
+                                         (cs/ends-with? uploaded ".GIF")
+                                         (cs/ends-with? uploaded ".JPG")
+                                         (cs/ends-with? uploaded ".PNG")))}))))
+
 
 (defn version-page
   "Render a specific historical version of a page"
@@ -246,4 +270,6 @@
   (POST "/auth" request (auth-page request))
   (GET "/passwd" request (passwd-page request))
   (POST "/passwd" request (passwd-page request))
+  (GET "/upload" request (upload-page request))
+  (POST "/upload" request (upload-page request))
   )
diff --git a/src/smeagol/uploads.clj b/src/smeagol/uploads.clj
new file mode 100644
index 0000000..dbc31af
--- /dev/null
+++ b/src/smeagol/uploads.clj
@@ -0,0 +1,64 @@
+(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]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;;; 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 avoid-name-collisions
+  "Find a filename within this `path`, based on this `file-name`, that does not
+   reference an existing file. It is assumed that `path` ends with a path separator.
+   Returns a filename hwich does not currently reference a file within the path."
+  [path file-name]
+  (if (.exists (File. (str path file-name)))
+    (let [parts (cs/split file-name #"\.")
+          prefix (cs/join "." (butlast parts))
+          suffix (last parts)]
+      (first
+       (filter #(not (.exists (File. (str path %))))
+               (map #(str prefix "." % "." suffix) (range)))))
+    file-name))
+
+
+(defn 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`."
+  [params]
+  (let [upload (:upload params)
+        tmp-file (:tempfile upload)
+        path (str (io/resource-path) "uploads/")
+        filename (avoid-name-collisions path (:filename upload))]
+    (timbre/info
+      (str "Storing upload file: " upload))
+      (if tmp-file
+        (do
+          (.renameTo tmp-file
+                     (File. (str path filename)))
+          filename)
+        (throw (Exception. "No file found?")))))