🎉 Add resource usage limits.

backend/src/app/config.clj

@@ -36,7 +36,8 @@
    :storage-s3-region :eu-central-1
    :storage-s3-bucket "penpot-devenv-assets-pre"
 
-   :image-process-max-threads 2
+   :rlimits-password 10
+   :rlimits-image 2
 
    :smtp-enabled false
    :smtp-default-reply-to "no-reply@example.com"
@@ -109,7 +110,8 @@
 (s/def ::public-uri ::us/string)
 (s/def ::backend-uri ::us/string)
 
-(s/def ::image-process-max-threads ::us/integer)
+(s/def ::rlimits-password ::us/integer)
+(s/def ::rlimits-image ::us/integer)
 
 (s/def ::google-client-id ::us/string)
 (s/def ::google-client-secret ::us/string)
@@ -161,7 +163,6 @@
                    ::http-server-debug
                    ::http-server-port
                    ::http-server-cors
-                   ::image-process-max-threads
                    ::ldap-auth-avatar-attribute
                    ::ldap-auth-base-dn
                    ::ldap-auth-email-attribute
@@ -179,6 +180,8 @@
                    ::registration-domain-whitelist
                    ::registration-enabled
                    ::secret-key
+                   ::rlimits-password
+                   ::rlimits-image
                    ::smtp-default-from
                    ::smtp-default-reply-to
                    ::smtp-enabled

backend/src/app/main.clj

@@ -97,6 +97,19 @@
     {:metrics (ig/ref :app.metrics/metrics)
      :svgc    (ig/ref :app.svgparse/svgc)}
 
+    ;; RLimit definition for password hashing
+    :app.rlimits/password
+    (:rlimits-password cfg/config)
+
+    ;; RLimit definition for image processing
+    :app.rlimits/image
+    (:rlimits-image cfg/config)
+
+    ;; A collection of rlimits as hash-map.
+    :app.rlimits/all
+    {:password (ig/ref :app.rlimits/password)
+     :image    (ig/ref :app.rlimits/image)}
+
     :app.rpc/rpc
     {:pool    (ig/ref :app.db/pool)
      :session (ig/ref :app.http.session/session)
@@ -104,6 +117,7 @@
      :metrics (ig/ref :app.metrics/metrics)
      :storage (ig/ref :app.storage/storage)
      :redis   (ig/ref :app.redis/redis)
+     :rlimits (ig/ref :app.rlimits/all)
      :svgc    (ig/ref :app.svgparse/svgc)}
 
     :app.notifications/handler
@@ -283,7 +297,11 @@
        :name    "telemetry"}})))
 
 (defmethod ig/init-key :default [_ data] data)
-(defmethod ig/prep-key :default [_ data] (d/without-nils data))
+(defmethod ig/prep-key :default
+  [_ data]
+  (if (map? data)
+    (d/without-nils data)
+    data))
 
 (def system nil)
 

backend/src/app/media.clj

@@ -10,27 +10,24 @@
 (ns app.media
   "Media postprocessing."
   (:require
+   [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.media :as cm]
-   [app.common.data :as d]
    [app.common.spec :as us]
    [app.config :as cfg]
-   [app.util.http :as http]
+   [app.rlimits :as rlm]
    [app.svgparse :as svg]
-   [clojure.core.async :as a]
+   [app.util.http :as http]
    [clojure.java.io :as io]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [datoteka.core :as fs])
   (:import
    java.io.ByteArrayInputStream
-   java.util.concurrent.Semaphore
    org.im4java.core.ConvertCmd
    org.im4java.core.IMOperation
    org.im4java.core.Info))
 
-(def semaphore (Semaphore. (:image-process-max-threads cfg/config 1)))
-
 ;; --- Generic specs
 
 (s/def :internal.http.upload/filename ::us/string)
@@ -174,20 +171,14 @@
             :hint (str "No impl found for process cmd:" cmd)))
 
 (defn run
-  [params]
-  (try
-    (.acquire semaphore)
-    (let [res (a/<!! (a/thread
-                       (try
-                         (process params)
-                         (catch Throwable e
-                           e))))]
-      (if (instance? Throwable res)
-        (throw res)
-        res))
-    (finally
-      (.release semaphore))))
-
+  [{:keys [rlimits]} params]
+  (us/assert map? rlimits)
+  (let [rlimit (get rlimits :image)]
+    (when-not rlimit
+      (ex/raise :type :internal
+                :code :rlimit-not-configured
+                :hint ":image rlimit not configured"))
+    (rlm/execute rlimit (process params))))
 
 ;; --- Utility functions
 
@@ -197,23 +188,3 @@
     (ex/raise :type :validation
               :code :media-type-not-allowed
               :hint "Seems like you are uploading an invalid media object")))
-
-(defn download-media-object
-  [url]
-  (let [result (http/get! url {:as :byte-array})
-        data   (:body result)
-        content-type (get (:headers result) "content-type")
-        format (cm/mtype->format content-type)]
-    (if (nil? format)
-      (ex/raise :type :validation
-                :code :media-type-not-allowed
-                :hint "Seems like the url points to an invalid media object.")
-      (let [tempfile  (fs/create-tempfile)
-            filename  (fs/name tempfile)]
-        (with-open [ostream (io/output-stream tempfile)]
-          (.write ostream data))
-        {:filename filename
-         :size (count data)
-         :tempfile tempfile
-         :content-type content-type}))))
-

backend/src/app/rlimits.clj

@@ -0,0 +1,48 @@
+;; 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/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020-2021 UXBOX Labs SL
+
+(ns app.rlimits
+  "Resource usage limits (in other words: semaphores)."
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig])
+  (:import
+   java.util.concurrent.Semaphore))
+
+(s/def ::rlimit  #(instance? Semaphore %))
+(s/def ::rlimits (s/map-of ::us/keyword ::rlimit))
+
+(derive ::password ::instance)
+(derive ::image ::instance)
+
+(defmethod ig/pre-init-spec ::instance [_]
+  (s/spec int?))
+
+(defmethod ig/init-key ::instance
+  [_ permits]
+  (Semaphore. (int permits)))
+
+(defn acquire!
+  [sem]
+  (.acquire ^Semaphore sem))
+
+(defn release!
+  [sem]
+  (.release ^Semaphore sem))
+
+(defmacro execute
+  [rlinst & body]
+  `(try
+     (acquire! ~rlinst)
+     ~@body
+     (finally
+       (release! ~rlinst))))
+

backend/src/app/rpc.clj

@@ -9,11 +9,12 @@
 
 (ns app.rpc
   (:require
-   [app.common.exceptions :as ex]
    [app.common.data :as d]
+   [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.db :as db]
    [app.metrics :as mtx]
+   [app.rlimits :as rlm]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]
    [clojure.tools.logging :as log]
@@ -51,18 +52,38 @@
     (cond->> {:status 200 :body result}
       (fn? (:transform-response mdata)) ((:transform-response mdata) request))))
 
-(defn- wrap-impl
-  [f mdata cfg prefix]
-  (let [mreg  (get-in cfg [:metrics :registry])
-        mobj  (mtx/create
-               {:name (-> (str "rpc_" (name prefix) "_" (::sv/name mdata) "_response_millis")
-                          (str/replace "-" "_"))
-                :registry mreg
-                :type :summary
-                :help (str/format "Service '%s' response time in milliseconds." (::sv/name mdata))})
-        f     (mtx/wrap-summary f mobj)
-        spec  (or (::sv/spec mdata) (s/spec any?))]
+(defn- wrap-with-metrics
+  [cfg f mdata prefix]
+  (let [mreg (get-in cfg [:metrics :registry])
+        mobj (mtx/create
+              {:name (-> (str "rpc_" (name prefix) "_" (::sv/name mdata) "_response_millis")
+                         (str/replace "-" "_"))
+               :registry mreg
+               :type :summary
+               :help (str/fmt "Service '%s' response time in milliseconds." (::sv/name mdata))})]
+    (mtx/wrap-summary f mobj)))
 
+;; Wrap the rpc handler with a semaphore if it is specified in the
+;; metadata asocciated with the handler.
+(defn- wrap-with-rlimits
+  [cfg f mdata]
+  (if-let [key (:rlimit mdata)]
+    (let [rlinst (get-in cfg [:rlimits key])]
+      (when-not rlinst
+        (ex/raise :type :internal
+                  :code :rlimit-not-configured
+                  :hint (str/fmt "%s rlimit not configured" key)))
+      (log/debugf "Adding rlimit to '%s' rpc handler." (::sv/name mdata))
+      (fn [cfg params]
+        (rlm/execute rlinst (f cfg params))))
+    f))
+
+(defn- wrap-impl
+  [cfg f mdata prefix]
+  (let [f     (wrap-with-rlimits cfg f mdata)
+        f     (wrap-with-metrics cfg f mdata prefix)
+        spec  (or (::sv/spec mdata)
+                  (s/spec any?))]
     (log/debugf "Registering '%s' command to rpc service." (::sv/name mdata))
     (fn [params]
       (when (and (:auth mdata true) (not (uuid? (:profile-id params))))
@@ -75,7 +96,7 @@
   [cfg prefix vfn]
   (let [mdata (meta vfn)]
     [(keyword (::sv/name mdata))
-     (wrap-impl (deref vfn) mdata cfg prefix)]))
+     (wrap-impl cfg (deref vfn) mdata prefix)]))
 
 (defn- resolve-query-methods
   [cfg]
@@ -108,7 +129,7 @@
 (s/def ::tokens fn?)
 
 (defmethod ig/pre-init-spec ::rpc [_]
-  (s/keys :req-un [::db/pool ::storage ::session ::tokens ::mtx/metrics]))
+  (s/keys :req-un [::db/pool ::storage ::session ::tokens ::mtx/metrics ::rlm/rlimits]))
 
 (defmethod ig/init-key ::rpc
   [_ cfg]

backend/src/app/rpc/mutations/media.clj

@@ -7,8 +7,6 @@
 ;;
 ;; Copyright (c) 2020-2021 UXBOX Labs SL
 
-;; TODO: move to file namespace, there are no media concept separated from file.
-
 (ns app.rpc.mutations.media
   (:require
    [app.common.exceptions :as ex]
@@ -18,9 +16,11 @@
    [app.db :as db]
    [app.media :as media]
    [app.rpc.queries.teams :as teams]
-   [app.util.storage :as ust]
-   [app.util.services :as sv]
    [app.storage :as sto]
+   [app.util.http :as http]
+   [app.util.services :as sv]
+   [app.util.storage :as ust]
+   [clojure.java.io :as io]
    [clojure.spec.alpha :as s]
    [datoteka.core :as fs]))
 
@@ -67,6 +67,27 @@
   [info]
   (= (:mtype info) "image/svg+xml"))
 
+;; TODO: we need to properly delete temporary files.
+(defn- download-media
+  [url]
+  (let [result (http/get! url {:as :byte-array})
+        data   (:body result)
+        content-type (get (:headers result) "content-type")
+        format (cm/mtype->format content-type)]
+    (if (nil? format)
+      (ex/raise :type :validation
+                :code :media-type-not-allowed
+                :hint "Seems like the url points to an invalid media object.")
+      (let [tempfile  (fs/create-tempfile)
+            filename  (fs/name tempfile)]
+        (with-open [ostream (io/output-stream tempfile)]
+          (.write ostream data))
+        {:filename filename
+         :size (count data)
+         :tempfile tempfile
+         :content-type content-type}))))
+
+
 (defn create-file-media-object
   [{:keys [conn storage svgc] :as cfg} {:keys [id file-id is-local name content] :as params}]
   (media/validate-media-type (:content-type content))
@@ -74,14 +95,14 @@
         source-path  (fs/path (:tempfile content))
         source-mtype (:content-type content)
 
-        source-info  (media/run {:cmd :info :input {:path source-path :mtype source-mtype}})
+        source-info  (media/run cfg {:cmd :info :input {:path source-path :mtype source-mtype}})
 
         thumb        (when (and (not (svg-image? source-info))
                                 (big-enough-for-thumbnail? source-info))
-                       (media/run (assoc thumbnail-options
-                                         :cmd :generic-thumbnail
-                                         :input {:mtype (:mtype source-info)
-                                                 :path source-path})))
+                       (media/run cfg (assoc thumbnail-options
+                                             :cmd :generic-thumbnail
+                                             :input {:mtype (:mtype source-info)
+                                                     :path source-path})))
 
         image        (if (= (:mtype source-info) "image/svg+xml")
                        (let [data (svgc (slurp source-path))]
@@ -116,11 +137,10 @@
   (db/with-atomic [conn pool]
     (let [file (select-file-for-update conn file-id)]
       (teams/check-edition-permissions! conn profile-id (:team-id file))
-      (let [content (media/download-media-object url)
+      (let [content (download-media url)
             params' (merge params {:content content
                                    :name (or name (:filename content))})]
 
-        ;; TODO: schedule to delete the tempfile created by media/download-media-object
         (-> (assoc cfg :conn conn)
             (create-file-media-object params'))))))
 

backend/src/app/rpc/mutations/profile.clj

@@ -54,7 +54,7 @@
   (s/keys :req-un [::email ::password ::fullname]
           :opt-un [::token]))
 
-(sv/defmethod ::register-profile {:auth false}
+(sv/defmethod ::register-profile {:auth false :rlimit :password}
   [{:keys [pool tokens session storage] :as cfg} {:keys [token] :as params}]
   (when-not (:registration-enabled cfg/config)
     (ex/raise :type :restriction
@@ -200,7 +200,7 @@
   (s/keys :req-un [::email ::password]
           :opt-un [::scope]))
 
-(sv/defmethod ::login {:auth false}
+(sv/defmethod ::login {:auth false :rlimit :password}
   [{:keys [pool] :as cfg} {:keys [email password scope] :as params}]
   (letfn [(check-password [profile password]
             (when (= (:password profile) "!")
@@ -292,7 +292,7 @@
 (s/def ::update-profile-password
   (s/keys :req-un [::profile-id ::password ::old-password]))
 
-(sv/defmethod ::update-profile-password
+(sv/defmethod ::update-profile-password {:rlimit :password}
   [{:keys [pool] :as cfg} {:keys [password profile-id] :as params}]
   (db/with-atomic [conn pool]
     (validate-password! conn params)
@@ -315,8 +315,8 @@
   (media/validate-media-type (:content-type file))
   (db/with-atomic [conn pool]
     (let [profile (db/get-by-id conn :profile profile-id)
-          _       (media/run {:cmd :info :input {:path (:tempfile file)
-                                                 :mtype (:content-type file)}})
+          _       (media/run cfg {:cmd :info :input {:path (:tempfile file)
+                                                     :mtype (:content-type file)}})
           photo   (teams/upload-photo cfg params)
           storage (assoc storage :conn conn)]
 
@@ -398,7 +398,7 @@
 (s/def ::recover-profile
   (s/keys :req-un [::token ::password]))
 
-(sv/defmethod ::recover-profile {:auth false}
+(sv/defmethod ::recover-profile {:auth false :rlimit :password}
   [{:keys [pool tokens] :as cfg} {:keys [token password]}]
   (letfn [(validate-token [token]
             (let [tdata (tokens :verify {:token token :iss :password-recovery})]

backend/src/app/rpc/mutations/teams.clj

@@ -249,8 +249,8 @@
   (db/with-atomic [conn pool]
     (teams/check-edition-permissions! conn profile-id team-id)
     (let [team    (teams/retrieve-team conn profile-id team-id)
-          _       (media/run {:cmd :info :input {:path (:tempfile file)
-                                                 :mtype (:content-type file)}})
+          _       (media/run cfg {:cmd :info :input {:path (:tempfile file)
+                                                     :mtype (:content-type file)}})
           photo   (upload-photo cfg params)]
 
       ;; Schedule deletion of old photo
@@ -265,11 +265,11 @@
       (assoc team :photo-id (:id photo)))))
 
 (defn upload-photo
-  [{:keys [storage]} {:keys [file]}]
+  [{:keys [storage] :as cfg} {:keys [file]}]
   (let [prefix (-> (bn/random-bytes 8)
                    (bc/bytes->b64u)
                    (bc/bytes->str))
-        thumb  (media/run
+        thumb  (media/run cfg
                  {:cmd :profile-thumbnail
                   :format :jpeg
                   :quality 85