Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-12 15:51:37 -05:00
Code Issues Activity

🐛 Fix possible bug in domain whitelisting checking.

Browse source
This commit is contained in:
Andrey Antukh 2021-05-25 21:19:13 +02:00
parent e5d4755619
commit 08dce3bcdc
4 changed files with 39 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
backend/src/app/config.clj
View file

@ -84,7 +84,6 @@
:allow-demo-users true
:registration-enabled true
:registration-domain-whitelist ""
:telemetry-enabled false
:telemetry-uri "https://telemetry.penpot.app/"
@ -161,7 +160,7 @@
(s/def ::profile-complaint-threshold ::us/integer)
(s/def ::public-uri ::us/string)
(s/def ::redis-uri ::us/string)
(s/def ::registration-domain-whitelist ::us/string)
(s/def ::registration-domain-whitelist ::us/set-of-str)
(s/def ::registration-enabled ::us/boolean)
(s/def ::rlimits-image ::us/integer)
(s/def ::rlimits-password ::us/integer)

20
backend/src/app/rpc/mutations/profile.clj
View file

@ -60,9 +60,10 @@
(ex/raise :type :restriction
:code :registration-disabled))
(when-not (email-domain-in-whitelist? (cfg/get :registration-domain-whitelist) (:email params))
(when-let [domains (cfg/get :registration-domain-whitelist)]
(when-not (email-domain-in-whitelist? domains (:email params))
(ex/raise :type :validation
:code :email-domain-is-not-allowed))
:code :email-domain-is-not-allowed)))
(when-not (:terms-privacy params)
(ex/raise :type :validation
@ -137,14 +138,15 @@
::audit/profile-id (:id profile)})))))
(defn email-domain-in-whitelist?
"Returns true if email's domain is in the given whitelist or if given
whitelist is an empty string."
[whitelist email]
(if (str/empty-or-nil? whitelist)
"Returns true if email's domain is in the given whitelist or if
given whitelist is an empty string."
[domains email]
(if (or (empty? domains)
(nil? domains))
true
(let [domains (str/split whitelist #",\s*")
domain (second (str/split email #"@" 2))]
(contains? (set domains) domain))))
(let [[_ candidate] (-> (str/lower email)
(str/split #"@" 2))]
(contains? domains candidate))))
(def ^:private sql:profile-existence
"select exists (select * from profile

4
backend/tests/app/tests/test_services_profile.clj
View file

@ -179,10 +179,10 @@
))
(t/deftest registration-domain-whitelist
(let [whitelist "gmail.com, hey.com, ya.ru"]
(let [whitelist #{"gmail.com" "hey.com" "ya.ru"}]
(t/testing "allowed email domain"
(t/is (true? (profile/email-domain-in-whitelist? whitelist "username@ya.ru")))
(t/is (true? (profile/email-domain-in-whitelist? "" "username@somedomain.com"))))
(t/is (true? (profile/email-domain-in-whitelist? #{} "username@somedomain.com"))))
(t/testing "not allowed email domain"
(t/is (false? (profile/email-domain-in-whitelist? whitelist "username@somedomain.com"))))))

37
common/app/common/spec.cljc
View file

@ -137,29 +137,34 @@
;; --- SPEC: email
(def email-re #"[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+")
(let [re #"[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+"
cfn (fn [v]
(s/def ::email
(s/conformer
(fn [v]
(if (string? v)
(if-let [matches (re-seq re v)]
(if-let [matches (re-seq email-re v)]
(first matches)
(do ::s/invalid))
::s/invalid))]
(s/def ::email (s/conformer cfn str)))
::s/invalid))
str))
;; --- SPEC: set-of-str
(letfn [(conformer [s]
(cond
(string? s) (into #{} (str/split s #"\s*,\s*"))
(set? s) (if (every? string? s)
s
::s/invalid)
:else ::s/invalid))
(unformer [s]
(str/join "," s))]
(s/def ::set-of-str (s/conformer conformer unformer)))
(s/def ::set-of-str
(s/conformer
(fn [s]
(let [xform (comp
(filter string?)
(remove str/empty?)
(remove str/blank?))]
(cond
(string? s) (->> (str/split s #"\s*,\s*")
(into #{} xform))
(set? s) (into #{} xform s)
:else ::s/invalid)))
(fn [s]
(str/join "," s))))
;; --- Macros