mirror of
https://github.com/penpot/penpot.git
synced 2026-09-23 12:26:17 +00:00
260 lines
9.3 KiB
Clojure
260 lines
9.3 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 SUBSIDIARY SL
|
|
|
|
(ns app.util.ssrf
|
|
"URL/host validation to prevent Server-Side Request Forgery.
|
|
|
|
The blocklist covers the standard JVM InetAddress classifications plus
|
|
explicit ranges: IPv6 ULA, IPv4-mapped loopback, cloud metadata,
|
|
operator-supplied CIDRs and the IPv6 transition mechanisms NAT64, 6to4
|
|
and Teredo."
|
|
(:require
|
|
[app.common.exceptions :as ex]
|
|
[app.common.logging :as l]
|
|
[app.config :as cf]
|
|
[cuerdas.core :as str])
|
|
(:import
|
|
com.google.common.net.InetAddresses
|
|
java.net.InetAddress
|
|
java.net.UnknownHostException
|
|
java.net.URI))
|
|
|
|
(def ^:private allowed-schemes
|
|
#{"http" "https"})
|
|
|
|
(def ^:private cloud-metadata-ips
|
|
"Exact IP addresses for cloud metadata services."
|
|
#{"169.254.169.254"
|
|
"fd00:ec2::254"})
|
|
|
|
(def ^:private extra-blocked-ranges
|
|
"CIDR ranges not covered by standard JDK InetAddress predicates.
|
|
Each entry is [base-address prefix-length]."
|
|
;; Carrier-grade NAT
|
|
[[100 64 0 0 10]
|
|
;; RFC 6890 / documentation / reserved
|
|
[192 0 0 0 24]
|
|
[192 0 2 0 24]
|
|
[198 18 0 0 15]
|
|
[198 51 100 0 24]
|
|
[203 0 113 0 24]
|
|
;; Reserved / future-use (broadcast and above)
|
|
[240 0 0 0 4]])
|
|
|
|
(defn- ip4-to-long
|
|
"Convert a 4-element byte array (IPv4) to a 32-bit long."
|
|
^long [^bytes bs]
|
|
(bit-or (bit-shift-left (bit-and (aget bs 0) 0xFF) 24)
|
|
(bit-shift-left (bit-and (aget bs 1) 0xFF) 16)
|
|
(bit-shift-left (bit-and (aget bs 2) 0xFF) 8)
|
|
(bit-and (aget bs 3) 0xFF)))
|
|
|
|
(defn- prefix-mask
|
|
"Return a 32-bit mask for the given prefix length."
|
|
^long [^long prefix-len]
|
|
(if (zero? prefix-len)
|
|
0
|
|
(bit-shift-left (unsigned-bit-shift-right 0xFFFFFFFF (- 32 prefix-len)) (- 32 prefix-len))))
|
|
|
|
(defn- in-cidr4?
|
|
"Check if an IPv4 address (as byte array) falls within a CIDR range
|
|
specified as [a b c d prefix-len]."
|
|
[^bytes addr [^long a ^long b ^long c ^long d ^long prefix-len]]
|
|
(let [base (bit-or (bit-shift-left (bit-and a 0xFF) 24)
|
|
(bit-shift-left (bit-and b 0xFF) 16)
|
|
(bit-shift-left (bit-and c 0xFF) 8)
|
|
(bit-and d 0xFF))
|
|
mask (prefix-mask prefix-len)
|
|
ip-val (ip4-to-long addr)]
|
|
(= (bit-and ip-val mask) (bit-and base mask))))
|
|
|
|
(defn- parse-cidr*
|
|
"Parse a CIDR string like '10.0.0.0/8' into [a b c d prefix-len]. Throws on invalid input."
|
|
[^String cidr]
|
|
(let [parts (str/split cidr #"/" 2)
|
|
prefix-len (when (= 2 (count parts))
|
|
(parse-long (nth parts 1)))]
|
|
(when-not prefix-len
|
|
(ex/raise :type :internal
|
|
:code :invalid-cidr
|
|
:hint (str "invalid CIDR notation: " cidr)))
|
|
(let [octets (str/split (first parts) #"\.")]
|
|
(when (not= 4 (count octets))
|
|
(ex/raise :type :internal
|
|
:code :invalid-cidr
|
|
:hint (str "invalid CIDR notation (expected IPv4): " cidr)))
|
|
(let [[a b c d] (map parse-long octets)]
|
|
(when (or (nil? a) (nil? b) (nil? c) (nil? d)
|
|
(not (<= 0 a 255)) (not (<= 0 b 255))
|
|
(not (<= 0 c 255)) (not (<= 0 d 255))
|
|
(not (<= 0 prefix-len 32)))
|
|
(ex/raise :type :internal
|
|
:code :invalid-cidr
|
|
:hint (str "invalid CIDR notation: " cidr)))
|
|
[a b c d prefix-len]))))
|
|
|
|
(defn parse-cidr
|
|
"Parse a CIDR string like '10.0.0.0/8' into [a b c d prefix-len].
|
|
Returns nil and logs a warning on invalid input."
|
|
[^String cidr]
|
|
(try
|
|
(parse-cidr* cidr)
|
|
(catch Exception _
|
|
(l/warn :hint "ignoring invalid CIDR" :cidr cidr)
|
|
nil)))
|
|
|
|
(defonce ^:dynamic extra-blocked-cidrs
|
|
(into #{} (keep parse-cidr) (cf/get :ssrf-extra-blocked-cidrs #{})))
|
|
|
|
(defn- ipv6-ula?
|
|
"Check if an IPv6 address is in the Unique Local Address range (fc00::/7)."
|
|
[^InetAddress addr]
|
|
(let [bs (.getAddress addr)]
|
|
(and (>= (alength bs) 16)
|
|
(= (bit-and (aget bs 0) 0xFE) 0xFC))))
|
|
|
|
(defn- ipv4-mapped-loopback?
|
|
"Check if an IPv4-mapped IPv6 address maps to loopback (::ffff:127.x.x.x)."
|
|
[^InetAddress addr]
|
|
(let [bs (.getAddress addr)]
|
|
(and (= (alength bs) 16)
|
|
;; Check it's an IPv4-mapped address: ::ffff:x.x.x.x
|
|
(= (aget bs 10) (byte -1)) ;; 0xFF
|
|
(= (aget bs 11) (byte -1)) ;; 0xFF
|
|
;; Check the embedded IPv4 is loopback (127.x.x.x)
|
|
(= (bit-and (aget bs 12) 0xFF) 127))))
|
|
|
|
(defn- transition-prefix
|
|
"Classify a 16-byte IPv6 address into its transition mechanism:
|
|
:nat64 (64:ff9b::/96), :6to4 (2002::/16), :teredo (2001:0000::/32) or nil."
|
|
[^bytes bs]
|
|
(let [b0 (bit-and (aget bs 0) 0xFF)
|
|
b1 (bit-and (aget bs 1) 0xFF)
|
|
b2 (bit-and (aget bs 2) 0xFF)
|
|
b3 (bit-and (aget bs 3) 0xFF)]
|
|
(cond
|
|
(and (= b0 0x00) (= b1 0x64) (= b2 0xFF) (= b3 0x9B)) :nat64
|
|
(and (= b0 0x20) (= b1 0x02)) :6to4
|
|
(and (= b0 0x20) (= b1 0x01) (= b2 0x00) (= b3 0x00)) :teredo
|
|
:else nil)))
|
|
|
|
(defn- blocked-address?
|
|
"Check if an InetAddress should be blocked. Returns true if blocked."
|
|
[^InetAddress addr]
|
|
(or
|
|
(.isAnyLocalAddress addr) ;; 0.0.0.0 or ::
|
|
(.isLoopbackAddress addr) ;; 127/8 or ::1
|
|
(.isLinkLocalAddress addr) ;; 169.254/16 or fe80::/10
|
|
(.isSiteLocalAddress addr) ;; 10/8, 172.16/12, 192.168/16
|
|
(.isMulticastAddress addr)
|
|
|
|
;; IPv6 ULA (fc00::/7)
|
|
(ipv6-ula? addr)
|
|
|
|
;; IPv4-mapped loopback
|
|
(ipv4-mapped-loopback? addr)
|
|
|
|
;; Cloud metadata IPs (exact match)
|
|
(contains? cloud-metadata-ips (.getHostAddress addr))
|
|
|
|
;; Extra blocked CIDRs (IPv4 only) and IPv6 transition mechanisms
|
|
(let [bs (.getAddress addr)]
|
|
(if (= (alength bs) 4)
|
|
(or (some #(in-cidr4? bs %) extra-blocked-ranges)
|
|
(some #(in-cidr4? bs %) extra-blocked-cidrs))
|
|
;; IPv6 transition mechanisms (NAT64/6to4/Teredo): the range is
|
|
;; rejected outright.
|
|
(boolean (when (= (alength bs) 16)
|
|
(transition-prefix bs)))))))
|
|
|
|
(defn resolve-host
|
|
"Resolve a hostname to all InetAddress objects. Wraps InetAddress/getAllByName
|
|
so it can be stubbed in tests."
|
|
[^String hostname]
|
|
(try
|
|
(InetAddress/getAllByName hostname)
|
|
(catch UnknownHostException _
|
|
nil)))
|
|
|
|
(defn validate-uri
|
|
"Validates `uri-or-string`:
|
|
- scheme must be http or https,
|
|
- host must resolve to at least one address, and
|
|
- **every** resolved address must NOT be in the blocklist
|
|
(loopback, link-local, site-local, multicast, any-local,
|
|
cloud-metadata 169.254.169.254, IPv6 ULA fc00::/7, IPv6 transition
|
|
mechanisms NAT64 64:ff9b::/96, 6to4 2002::/16 and Teredo
|
|
2001:0000::/32, IPv4-mapped IPv6 of any blocked IPv4,
|
|
plus operator-supplied CIDRs).
|
|
When the host is an IP literal (decimal/octal/hex/IPv6) it is
|
|
normalized via `com.google.common.net.InetAddresses` before the
|
|
check.
|
|
Hosts in `:ssrf-allowed-hosts` (case-insensitive exact match) bypass
|
|
the IP check.
|
|
Throws `ex/raise :type :validation :code :ssrf-blocked-target` with
|
|
a hint that does NOT echo the resolved IP (avoid info leak)."
|
|
[uri-or-string]
|
|
(let [uri (if (instance? URI uri-or-string)
|
|
uri-or-string
|
|
(URI. (str uri-or-string)))
|
|
scheme (.getScheme uri)
|
|
host (.getHost uri)]
|
|
|
|
;; Validate scheme
|
|
(when (or (nil? scheme)
|
|
(not (contains? allowed-schemes (str/lower scheme))))
|
|
(ex/raise :type :validation
|
|
:code :ssrf-blocked-target
|
|
:hint "url scheme is not allowed"
|
|
:uri (str uri)
|
|
:scheme scheme))
|
|
|
|
;; Validate host presence
|
|
(when (or (nil? host) (str/blank? host))
|
|
(ex/raise :type :validation
|
|
:code :ssrf-blocked-target
|
|
:hint "url host is missing"
|
|
:uri (str uri)
|
|
:host host))
|
|
|
|
;; Check allowlist
|
|
(let [allowed-hosts (cf/get :ssrf-allowed-hosts #{})
|
|
host-lower (str/lower host)]
|
|
|
|
(when-not (contains? allowed-hosts host-lower)
|
|
;; Normalize the host: if it looks like an IP literal, normalize it
|
|
;; via Guava to catch decimal/octal/hex encodings
|
|
(let [normalized (if (InetAddresses/isInetAddress host)
|
|
(InetAddresses/forString host)
|
|
nil)
|
|
host-to-resolve (if normalized
|
|
(.getHostAddress ^InetAddress normalized)
|
|
host)
|
|
addresses (resolve-host host-to-resolve)]
|
|
|
|
(when (or (nil? addresses) (zero? (alength addresses)))
|
|
(ex/raise :type :validation
|
|
:code :ssrf-blocked-target
|
|
:hint "uri host could not be resolved"
|
|
:uri (str uri)))
|
|
|
|
;; All-or-nothing: if ANY resolved address is blocked, reject
|
|
(when (some blocked-address? (seq addresses))
|
|
(ex/raise :type :validation
|
|
:code :ssrf-blocked-target
|
|
:hint "uri target is not allowed"
|
|
:uri (str uri))))))
|
|
(str uri)))
|
|
|
|
(defn safe-url?
|
|
"Predicate version of `validate-uri`. Returns `true` if safe."
|
|
[uri-or-string]
|
|
(try
|
|
(validate-uri uri-or-string)
|
|
true
|
|
(catch Exception _
|
|
false)))
|