mirror of
https://github.com/penpot/penpot.git
synced 2026-08-19 11:19:10 +00:00
c4dd04353f
Add sanitize-svg function that removes dangerous elements and attributes: - script tags - foreignObject elements - Event handler attributes (onload, onmouseover, etc.) - javascript: URLs from href/xlink:href attributes Apply sanitization in process-main-image before storing SVG files. AI-assisted-by: mimo-v2.5-pro
367 lines
14 KiB
Clojure
367 lines
14 KiB
Clojure
;; This Source Code Form is subject to the terms of the Mozilla Public
|
|
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
|
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
|
;;
|
|
;; Copyright (c) KALEIDOS INC Sucursal en España SL
|
|
|
|
(ns app.media.local
|
|
"Local media processing via ImageMagick and FontForge shell commands."
|
|
(:require
|
|
[app.common.exceptions :as ex]
|
|
[app.common.logging :as l]
|
|
[app.common.media :as cm]
|
|
[app.common.schema :as sm]
|
|
[app.common.time :as ct]
|
|
[app.config :as cf]
|
|
[app.media.svg :as svg]
|
|
[app.media.validation :as validation]
|
|
[app.storage.tmp :as tmp]
|
|
[app.util.shell :as shell]
|
|
[buddy.core.bytes :as bb]
|
|
[buddy.core.codecs :as bc]
|
|
[clojure.string]
|
|
[cuerdas.core :as str]
|
|
[datoteka.fs :as fs]
|
|
[datoteka.io :as io]))
|
|
|
|
(defmulti process (fn [_system params] (:cmd params)))
|
|
|
|
(defmethod process :default
|
|
[_system {:keys [cmd] :as params}]
|
|
(ex/raise :type :internal
|
|
:code :not-implemented
|
|
:hint (str/fmt "No impl found for local process cmd: %s" cmd)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; IMAGE THUMBNAILS
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(def ^:private schema:thumbnail-params
|
|
[:map {:title "ThumbnailParams"}
|
|
[:input validation/schema:input]
|
|
[:format [:enum :jpeg :webp :png]]
|
|
[:quality [:int {:min 1 :max 100}]]
|
|
[:width :int]
|
|
[:height :int]])
|
|
|
|
(def ^:private check-thumbnail-params
|
|
(sm/check-fn schema:thumbnail-params))
|
|
|
|
;; Related info on how thumbnails generation
|
|
;; http://www.imagemagick.org/Usage/thumbnails/
|
|
|
|
(def ^:private imagemagick-default-env
|
|
"Default environment variables for ImageMagick resource limits.
|
|
These are the soft ceiling — policy.xml is the hard ceiling."
|
|
{"MAGICK_THREAD_LIMIT" "2"
|
|
"MAGICK_MEMORY_LIMIT" "256MiB"
|
|
"MAGICK_MAP_LIMIT" "512MiB"
|
|
"MAGICK_AREA_LIMIT" "128MP"
|
|
"MAGICK_DISK_LIMIT" "1GiB"
|
|
"MAGICK_TIME_LIMIT" "30"})
|
|
|
|
(defn- get-imagemagick-env
|
|
"Returns environment variables for ImageMagick commands.
|
|
Reads individual PENPOT_IMAGEMAGICK_* config values, falling back to defaults."
|
|
[]
|
|
(let [thread (cf/get :imagemagick-thread-limit)
|
|
memory (cf/get :imagemagick-memory-limit)
|
|
map-l (cf/get :imagemagick-map-limit)
|
|
area (cf/get :imagemagick-area-limit)
|
|
disk (cf/get :imagemagick-disk-limit)
|
|
time (cf/get :imagemagick-time-limit)
|
|
width (cf/get :imagemagick-width-limit)
|
|
height (cf/get :imagemagick-height-limit)]
|
|
(cond-> imagemagick-default-env
|
|
thread (assoc "MAGICK_THREAD_LIMIT" thread)
|
|
memory (assoc "MAGICK_MEMORY_LIMIT" memory)
|
|
map-l (assoc "MAGICK_MAP_LIMIT" map-l)
|
|
area (assoc "MAGICK_AREA_LIMIT" area)
|
|
disk (assoc "MAGICK_DISK_LIMIT" disk)
|
|
time (assoc "MAGICK_TIME_LIMIT" time)
|
|
width (assoc "MAGICK_WIDTH_LIMIT" width)
|
|
height (assoc "MAGICK_HEIGHT_LIMIT" height))))
|
|
|
|
(defn- exec-magick!
|
|
"Execute an ImageMagick command with resource limits.
|
|
`args` is a vector of string arguments to pass to `magick`."
|
|
[system args]
|
|
(let [cmd (into ["magick"] args)
|
|
result (shell/exec! system
|
|
:cmd cmd
|
|
:env (get-imagemagick-env)
|
|
:timeout 60)]
|
|
(when (not= 0 (:exit result))
|
|
(ex/raise :type :validation
|
|
:code :invalid-image
|
|
:hint (str "ImageMagick command failed: " (:err result))
|
|
:cmd cmd
|
|
:exit (:exit result)))
|
|
result))
|
|
|
|
(defn- generic-process
|
|
[system {:keys [input format convert-args] :as params}]
|
|
(let [{:keys [path mtype]} input
|
|
format (or format (cm/mtype->format mtype))
|
|
ext (cm/format->extension format)
|
|
tmp (tmp/tempfile :prefix "penpot.media." :suffix ext)
|
|
args (into [(str path)] (conj (vec convert-args) (str tmp)))]
|
|
(exec-magick! system args)
|
|
(assoc params
|
|
:format format
|
|
:mtype (cm/format->mtype format)
|
|
:size (fs/size tmp)
|
|
:data tmp)))
|
|
|
|
(defmethod process :generic-thumbnail
|
|
[system params]
|
|
(let [{:keys [quality width height] :as params}
|
|
(check-thumbnail-params params)]
|
|
(generic-process system
|
|
(assoc params
|
|
:convert-args ["-auto-orient" "-strip"
|
|
"-thumbnail" (str width "x" height ">")
|
|
"-quality" (str quality)]))))
|
|
|
|
(defmethod process :profile-thumbnail
|
|
[system params]
|
|
(let [{:keys [quality width height] :as params}
|
|
(check-thumbnail-params params)]
|
|
(generic-process system
|
|
(assoc params
|
|
:convert-args ["-auto-orient" "-strip"
|
|
"-thumbnail" (str width "x" height "^")
|
|
"-gravity" "center"
|
|
"-extent" (str width "x" height)
|
|
"-quality" (str quality)]))))
|
|
|
|
(defn- get-dimensions-with-orientation [system ^String path]
|
|
;; Image magick doesn't give info about exif rotation so we use the identify command
|
|
;; If we are processing an animated gif we use the first frame with -scene 0
|
|
(let [dim-result (exec-magick! system ["identify" "-format" "%w %h\n" path])
|
|
orient-result (exec-magick! system ["identify" "-format" "%[EXIF:Orientation]\n" path])]
|
|
(when (= 0 (:exit dim-result))
|
|
(let [[w h] (-> (:out dim-result)
|
|
str/trim
|
|
(clojure.string/split #"\s+")
|
|
(->> (mapv #(Integer/parseInt %))))
|
|
orientation-exit (:exit orient-result)
|
|
orientation (-> orient-result :out str/trim)]
|
|
(if (= 0 orientation-exit)
|
|
(case orientation
|
|
("6" "8") {:width h :height w} ; Rotated 90 or 270 degrees
|
|
{:width w :height h}) ; Normal or unknown orientation
|
|
{:width w :height h}))))) ; If orientation can't be read, use dimensions as-is
|
|
|
|
(defmethod process :info
|
|
[system {:keys [input] :as params}]
|
|
(let [{:keys [path mtype] :as input} (validation/check-input input)]
|
|
(if (= mtype "image/svg+xml")
|
|
(let [info (some-> path slurp svg/parse-svg svg/get-basic-info-from-svg)]
|
|
(when-not info
|
|
(ex/raise :type :validation
|
|
:code :invalid-svg-file
|
|
:hint "uploaded svg does not provides dimensions"))
|
|
(merge input info {:ts (ct/now) :size (fs/size path)}))
|
|
|
|
(let [path-str (str path)
|
|
identify-res (exec-magick! system ["identify" "-format" "image/%[magick]\n" path-str])
|
|
;; identify prints one line per frame (animated GIFs, etc.); we take the first one
|
|
mtype' (if (zero? (:exit identify-res))
|
|
(-> identify-res
|
|
:out
|
|
str/trim
|
|
(str/split #"\s+" 2)
|
|
first
|
|
str/lower)
|
|
(ex/raise :type :validation
|
|
:code :invalid-image
|
|
:hint "invalid image"))
|
|
{:keys [width height]}
|
|
(or (get-dimensions-with-orientation system path-str)
|
|
(do
|
|
(l/warn "Failed to read image dimensions with orientation" {:path path})
|
|
(ex/raise :type :validation
|
|
:code :invalid-image
|
|
:hint "invalid image")))]
|
|
(when (and (string? mtype)
|
|
(not= (str/lower mtype) mtype'))
|
|
(ex/raise :type :validation
|
|
:code :media-type-mismatch
|
|
:hint (str "Seems like you are uploading a file whose content does not match the extension."
|
|
"Expected: " mtype ". Got: " mtype')))
|
|
(assoc input
|
|
:width width
|
|
:height height
|
|
:size (fs/size path)
|
|
:ts (ct/now))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; FONTS
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn- get-font-prlimit
|
|
"Returns resource limits for font processing tools, read from config."
|
|
[]
|
|
{:mem (cf/get :font-process-mem)
|
|
:cpu (cf/get :font-process-cpu)})
|
|
|
|
(defn- get-font-timeout
|
|
"Returns the wall-clock timeout for font processing, read from config."
|
|
[]
|
|
(cf/get :font-process-timeout))
|
|
|
|
(defn- exec-font!
|
|
"Execute a font processing command with resource limits.
|
|
`args` is a vector of string arguments."
|
|
[system args]
|
|
(shell/exec! system
|
|
:cmd args
|
|
:prlimit (get-font-prlimit)
|
|
:timeout (get-font-timeout)))
|
|
|
|
(defmethod process :generate-fonts
|
|
[system {:keys [input] :as params}]
|
|
(letfn [(ttf->otf [data]
|
|
(let [finput (tmp/tempfile :prefix "penpot.font." :suffix "")
|
|
foutput (fs/path (str finput ".otf"))]
|
|
(try
|
|
(io/write* finput data)
|
|
(let [res (exec-font! system ["fontforge" "-lang=ff" "-c"
|
|
(str/fmt "Open('%s'); Generate('%s')"
|
|
(str finput)
|
|
(str foutput))])]
|
|
(when (zero? (:exit res))
|
|
foutput))
|
|
(finally
|
|
(fs/delete finput)))))
|
|
|
|
(otf->ttf [data]
|
|
(let [finput (tmp/tempfile :prefix "penpot.font." :suffix "")
|
|
foutput (fs/path (str finput ".ttf"))]
|
|
(try
|
|
(io/write* finput data)
|
|
(let [res (exec-font! system ["fontforge" "-lang=ff" "-c"
|
|
(str/fmt "Open('%s'); Generate('%s')"
|
|
(str finput)
|
|
(str foutput))])]
|
|
(when (zero? (:exit res))
|
|
foutput))
|
|
(finally
|
|
(fs/delete finput)))))
|
|
|
|
(ttf-or-otf->woff [data]
|
|
(let [finput (tmp/tempfile :prefix "penpot.font." :suffix "")
|
|
foutput (fs/path (str finput ".woff"))]
|
|
(try
|
|
(io/write* finput data)
|
|
(let [res (exec-font! system ["sfnt2woff" (str finput)])]
|
|
(when (zero? (:exit res))
|
|
foutput))
|
|
(finally
|
|
(fs/delete finput)))))
|
|
|
|
(woff->sfnt [data]
|
|
(let [finput (tmp/tempfile :prefix "penpot" :suffix "")]
|
|
(try
|
|
(io/write* finput data)
|
|
(let [res (shell/exec! system
|
|
:cmd ["woff2sfnt" (str finput)]
|
|
:out-enc :bytes
|
|
:prlimit (get-font-prlimit)
|
|
:timeout (get-font-timeout))]
|
|
(when (zero? (:exit res))
|
|
(:out res)))
|
|
(finally
|
|
(fs/delete finput)))))
|
|
|
|
(woff2->sfnt [data]
|
|
;; woff2_decompress outputs to same directory with .ttf extension
|
|
(let [finput (tmp/tempfile :prefix "penpot.font." :suffix ".woff2")
|
|
foutput (fs/path (str/replace (str finput) #"\.woff2$" ".ttf"))]
|
|
(try
|
|
(io/write* finput data)
|
|
(let [res (exec-font! system ["woff2_decompress" (str finput)])]
|
|
(if (zero? (:exit res))
|
|
foutput
|
|
(do
|
|
(when (fs/exists? foutput)
|
|
(fs/delete foutput))
|
|
nil)))
|
|
(finally
|
|
(fs/delete finput)))))
|
|
|
|
;; Documented here:
|
|
;; https://docs.microsoft.com/en-us/typography/opentype/spec/otff#table-directory
|
|
(get-sfnt-type [data]
|
|
(let [buff (bb/slice data 0 4)
|
|
type (bc/bytes->hex buff)]
|
|
(case type
|
|
"4f54544f" :otf
|
|
"00010000" :ttf
|
|
(ex/raise :type :internal
|
|
:code :unexpected-data
|
|
:hint "unexpected font data"))))
|
|
|
|
(gen-if-nil [val factory]
|
|
(if (nil? val)
|
|
(factory)
|
|
val))]
|
|
|
|
(let [current (into #{} (keys input))]
|
|
(cond
|
|
(contains? current "font/ttf")
|
|
(let [data (get input "font/ttf")]
|
|
(-> input
|
|
(update "font/otf" gen-if-nil #(ttf->otf data))
|
|
(update "font/woff" gen-if-nil #(ttf-or-otf->woff data))))
|
|
|
|
(contains? current "font/otf")
|
|
(let [data (get input "font/otf")]
|
|
(-> input
|
|
(update "font/woff" gen-if-nil #(ttf-or-otf->woff data))
|
|
(assoc "font/ttf" (otf->ttf data))))
|
|
|
|
(contains? current "font/woff")
|
|
(let [data (get input "font/woff")
|
|
sfnt (woff->sfnt data)]
|
|
(when-not sfnt
|
|
(ex/raise :type :validation
|
|
:code :invalid-woff-file
|
|
:hint "invalid woff file"))
|
|
(let [stype (get-sfnt-type sfnt)]
|
|
(cond-> input
|
|
true
|
|
(-> (assoc "font/woff" data))
|
|
|
|
(= stype :otf)
|
|
(-> (assoc "font/otf" sfnt)
|
|
(assoc "font/ttf" (otf->ttf sfnt)))
|
|
|
|
(= stype :ttf)
|
|
(-> (assoc "font/otf" (ttf->otf sfnt))
|
|
(assoc "font/ttf" sfnt)))))
|
|
|
|
(contains? current "font/woff2")
|
|
(let [data (get input "font/woff2")
|
|
foutput (woff2->sfnt data)]
|
|
(when-not foutput
|
|
(ex/raise :type :validation
|
|
:code :invalid-woff2-file
|
|
:hint "invalid woff2 file"))
|
|
(try
|
|
(let [sfnt (io/read* foutput)
|
|
type (get-sfnt-type sfnt)]
|
|
(cond-> input
|
|
(= type :otf)
|
|
(-> (assoc "font/otf" sfnt)
|
|
(assoc "font/ttf" (otf->ttf sfnt))
|
|
(update "font/woff" gen-if-nil #(ttf-or-otf->woff sfnt)))
|
|
|
|
(= type :ttf)
|
|
(-> (assoc "font/ttf" sfnt)
|
|
(assoc "font/otf" (ttf->otf sfnt))
|
|
(update "font/woff" gen-if-nil #(ttf-or-otf->woff sfnt)))))
|
|
(finally
|
|
(fs/delete foutput))))))))
|