Fix HTTPS/mixed content; make config env-drivenHEADmaster2026

- Replace hardcoded dump.fm URLs with host/scheme config\n- Add optional passwordless login flow\n- Update templates/static assets to avoid blocked HTTP resources\n- Ignore local uploads/SQL dumps

8 files changed, 156 insertions, 59 deletions

diff --git a/src/config.clj b/src/config.clj
index 1481855..f8f3d7e 100755
--- a/src/config.clj
+++ b/src/config.clj
@@ -1,33 +1,69 @@
 (ns config
-  (:import java.lang.System))
+  (:import java.lang.System
+           java.net.URL))
 
 ;; Configuration
 
 (def *server-user* (System/getProperty "user.name"))
 
+(defn getenv
+  ([k] (System/getenv k))
+  ([k default]
+    (let [v (System/getenv k)]
+      (if (and v (not= v "")) v default))))
+
+(defn getenv-int
+  ([k default]
+    (let [v (getenv k nil)]
+      (if v (Integer/parseInt v) default))))
+
+(defn getenv-bool
+  ([k default]
+    (let [v (getenv k nil)]
+      (if (nil? v)
+        default
+        (contains? #{"1" "true" "yes" "on"} (.toLowerCase v))))))
+
 (def *server-url*
-  (if (= *server-user* "dumpfmprod")
-    ;"http://dump.fm"
-    "http://asdf.us:8080"))
+  (getenv "DUMPFM_SERVER_URL"
+          (if (= *server-user* "dumpfmprod")
+            "/"
+            "http://localhost:8080")))
+
+(def *public-host*
+  (getenv "DUMPFM_PUBLIC_HOST"
+          (try
+            (.getHost (URL. *server-url*))
+            (catch Exception _ ""))))
+
+(def *public-scheme*
+  (getenv "DUMPFM_PUBLIC_SCHEME"
+          (try
+            (.getProtocol (URL. *server-url*))
+            (catch Exception _ "http"))))
 
 (def *cookie-domain*  
-  (if (= *server-user* "dumpfmprod")
-    ;".dump.fm" ; is this ok or should I comment this too? this too
-    ; not clojure specialist, but all this stuff doesn't look good, app should be able to run from any location and still work as usual, domains shouldn't
-    ; be hardcoded at all. in html paths can be relative, which removes need to figure out which domain you running app on. I hear you, 
-    ; let's just get it working though, right? sure
-    ""))
+  (getenv "DUMPFM_COOKIE_DOMAIN"
+          (if (= *server-user* "dumpfmprod")
+            ".dump.fm"
+            "")))
+
+(def *passwordless-login*
+  (getenv-bool "DUMPFM_PASSWORDLESS_LOGIN" false))
 
 (def db-server
-  (if (= *server-user* "dumpfmprod")
-    "localhost"; "192.168.162.138"
-    "localhost"))
+  (getenv "DUMPFM_DB_HOST"
+          (if (= *server-user* "dumpfmprod")
+            "localhost"; "192.168.162.138"
+            "localhost")))
 
 (def redis-server
-  (if (= *server-user* "dumpfmprod")
-    ;{:host "192.168.156.111" :port 6379 :db 0 } ;these ip addresses need to change right? yes should I try deleting this? or statically
-    ;setting it to my public ip? why public ip, it should be just 127.0.0.1 or something like redis.dump.fm if you plan to have more than one server.
-    {:host "127.0.0.1" :port 6379 :db 0 }))
+  {:host (getenv "DUMPFM_REDIS_HOST"
+                 (if (= *server-user* "dumpfmprod")
+                   "127.0.0.1"
+                   "127.0.0.1"))
+   :port (getenv-int "DUMPFM_REDIS_PORT" 6379)
+   :db   (getenv-int "DUMPFM_REDIS_DB" 0)})
 
 (def *root-directory* (System/getProperty "user.dir"))
 (def *image-directory* "images")
diff --git a/src/datalayer.clj b/src/datalayer.clj
index 52d3b0a..cea5f3d 100755
--- a/src/datalayer.clj
+++ b/src/datalayer.clj
@@ -187,10 +187,6 @@ WHERE  u.nick = ANY(?)"
   (some #(Character/isUpperCase %) s))
 
 
-(redis/with-server redis-server
-  (redis/zscore redis-favscores-key "asdfkasdf"))
-
-
 (defn fetch-redis-favscore [nick]
   (if (= (lower-case nick) "scottbot")
     -1
diff --git a/src/events.clj b/src/events.clj
index 501c231..a571230 100755
--- a/src/events.clj
+++ b/src/events.clj
@@ -17,7 +17,7 @@
 

 (def sample-event {:name "TMZ Maker!"

                    :key "tmz"

-                   :template "/event/proxy?url=http://dump.fm/images/20100629/1277836809689-dumpfm-ryder-tmz_template.png"

+                   :template "/event/proxy?url=https://archive.hump.fm/images/20100629/1277836809689-dumpfm-ryder-tmz_template.png"

                    :author {:nick "ryder" }})

 

 (defn event-page [session]

diff --git a/src/imgreplacer.clj b/src/imgreplacer.clj
index 03ae0e6..53e14c8 100755
--- a/src/imgreplacer.clj
+++ b/src/imgreplacer.clj
@@ -83,4 +83,4 @@
 (defn mirror-message-id! [msg-id dryrun]
   (if-let [m (first (do-select ["SELECT * FROM messages WHERE message_id = ?" msg-id]))]
     (mirror-message! m dryrun
-                     #(not (re-find #"^http://dump.fm" %)))))
\ No newline at end of file
+                     #(not (re-find #"^/" %)))))
\ No newline at end of file
diff --git a/src/jedis.clj b/src/jedis.clj
index bc53eda..a75896d 100755
--- a/src/jedis.clj
+++ b/src/jedis.clj
@@ -3,13 +3,13 @@
            redis.clients.jedis.JedisPool)
   (:use config))
 
-(def pool (JedisPool. (:host redis-server) (:port redis-server)))
+(def pool (JedisPool. (:host redis-server) (int (:port redis-server))))
 (.init pool)
 
 
 (defn with-jedis [fn]
   (let [r (.getResource pool)]
     (try
+      (.select r (int (:db redis-server)))
       (fn r) 
       (finally (.returnResource pool r)))))
-
diff --git a/src/site.clj b/src/site.clj
index 06d711b..8ca26b8 100755
--- a/src/site.clj
+++ b/src/site.clj
@@ -71,10 +71,13 @@
 (defn process-message-for-json [d]
   (assoc d :created_on (.getTime (d :created_on))))
 
+(defn ensure-trailing-slash [s]
+  (if (.endsWith s "/") s (str s "/")))
+
 (defn message-room-link [m]
   (if (default-room? (:key m *default-room*))
-    "http://dump.fm/"
-    (format "http://%s.dump.fm/" (:key m))))
+    (ensure-trailing-slash *server-url*)
+    (format "%s://%s.%s/" *public-scheme* (:key m) *public-host*)))
 
 (defn process-message-for-output [d]
   (escape-html-deep 
@@ -265,22 +268,59 @@
       (do-cmds query))
     (catch Exception e nil)))
 
+(declare reserved-nicks ip-recently-muted? ip-recently-created?)
+
+(defn nick-in-reserved-list? [nick]
+  (let [reserved (poll reserved-nicks)]
+    (or (contains? reserved nick)
+        (contains? reserved (lower-case nick)))))
+
+(defn fetch-or-create-passwordless-user! [nick ip]
+  (if-let [existing (fetch-nick-uncached nick)]
+    existing
+    (if-let [invalid-reason (is-invalid-nick? nick)]
+      invalid-reason
+      (if (nick-in-reserved-list? nick)
+        "NICK_TAKEN"
+        (if (ip-recently-muted? ip)
+          "RECENTLY_MUTED"
+          (if (ip-recently-created? ip)
+            "RECENTLY_CREATED"
+            (let [hash (sha1-hash nick (System/currentTimeMillis) (rand))
+                  email ""]
+              (try
+                (do-insert :users [:nick :hash :email] [nick hash email])
+                (catch Exception _ nil))
+              (if-let [db-user (fetch-nick-uncached nick)]
+                (do
+                  (try
+                    (let [query (format "UPDATE users SET created_ip = '%s'::cidr WHERE user_id = %s"
+                                        (str ip)
+                                        (str (db-user :user_id)))]
+                      (do-cmds query))
+                    (catch Exception _ nil))
+                  db-user)
+                "BAD_LOGIN"))))))))
+
 (defn login [session params cookies request]
-  (let [nick         (or (params :nick) "")
-        hash         (or (params :hash) "")
-        remember-me  (= (params :rememberme) "yes")
-        db-user      (authorize-nick-hash nick hash)
-        login-cookie (if remember-me
-                       (make-login-token db-user)
-                       (clear-login-token *login-token-key*))
-        ip           (get-ip request)]
-      (if db-user
-        (do
-           (log-login (db-user :user_id) ip)
-          [(session-assoc-from-db db-user)
-           login-cookie
-           (resp-success "OK")])
-        (resp-error "BAD_LOGIN"))))
+  (let [nick        (.trim (or (params :nick) ""))
+        hash        (or (params :hash) "")
+        remember-me (= (params :rememberme) "yes")
+        ip          (get-ip request)
+        authorized  (when (non-empty-string? hash) (authorize-nick-hash nick hash))
+        db-user     (cond
+                     authorized authorized
+                     *passwordless-login* (fetch-or-create-passwordless-user! nick ip)
+                     :else nil)]
+    (if (map? db-user)
+      (let [login-cookie (if remember-me
+                           (make-login-token db-user)
+                           (clear-login-token *login-token-key*))]
+        (log-login (db-user :user_id) ip)
+        [(session-assoc-from-db db-user)
+         login-cookie
+         (resp-success "OK")])
+      (resp-error (if (string? db-user) db-user "BAD_LOGIN")))))
 
 (defn logout [session]
   [(session-dissoc :nick :user_id :is_admin :avatar)
@@ -1012,7 +1052,7 @@ WHERE  user_id IN
 (def random-posts
      ["http://24.media.tumblr.com/tumblr_l41x4eLWZm1qzon5ko1_400.png hi"
       "lol http://29.media.tumblr.com/tumblr_l3o3wuRFpM1qawuaao1_500.jpg"
-      "http://dump.fm/images/20100819/1282199186063-dumpfm-timb-dump.stone.logo.gif http://teamassignment.com/images/getmesomemore.jpg http://26.media.tumblr.com/tumblr_l7kro0os531qaajkio1_500.gif"])
+      "https://archive.hump.fm/images/20100819/1282199186063-dumpfm-timb-dump.stone.logo.gif http://teamassignment.com/images/getmesomemore.jpg http://26.media.tumblr.com/tumblr_l7kro0os531qaajkio1_500.gif"])
 
 (defn make-random-post! []
   (msg {:user_id 1
@@ -1194,7 +1234,7 @@ WHERE  user_id IN
 
 (defn serve-static [dir path]
   (if (= path "")
-    (redirect-to "http://dump.fm")
+    (redirect-to "/")
     (serve-file dir path)))
 
 (defroutes static
@@ -1220,16 +1260,22 @@ WHERE  user_id IN
 
 
 (defroutes pichat
-  (GET "http://www.dump.fm/*"     (redirect-to "http://dump.fm"))
-  (GET "http://:sub.dump.fm/"     (validated-chat session (params :sub)))
-  (GET "http://:sub.dump.fm/chat" (validated-chat session (params :sub)))
-  (GET "http://:sub.dump.fm/chat" (validated-chat session (params :sub) (params :t)))
+  (GET (str "http://www." *public-host* "/*")
+       (redirect-to (ensure-trailing-slash *server-url*)))
+  (GET (str "http://:sub." *public-host* "/")
+       (validated-chat session (params :sub)))
+  (GET (str "http://:sub." *public-host* "/chat")
+       (validated-chat session (params :sub)))
+  (GET (str "http://:sub." *public-host* "/chat")
+       (validated-chat session (params :sub) (params :t)))
   (GET "/:room/chat"              (validated-chat session (params :room)))
   (GET "/chat"                    (validated-chat session *default-room*))
   (GET "/chat/:t"                 (validated-chat session *default-room* (params :t)))
 
-  (GET "http://:sub.dump.fm/log"         (validated-log session (params :sub) "0" params))
-  (GET "http://:sub.dump.fm/log/:offset" (validated-log session (params :sub) (params :offset) params))
+  (GET (str "http://:sub." *public-host* "/log")
+       (validated-log session (params :sub) "0" params))
+  (GET (str "http://:sub." *public-host* "/log/:offset")
+       (validated-log session (params :sub) (params :offset) params))
   (GET "/log"                            (validated-log session *default-room* "0" params))
   (GET "/log/:offset"                    (validated-log session *default-room* (params :offset) params))
   (GET "/r/:room/log"                      (validated-log session (params :room) "0" params))
@@ -1430,7 +1476,11 @@ WHERE  user_id IN
 (defn parse-command-args
   "Parses command-line arguments. First arg is script name,
   second arg is port number (defaults to 8080)."
-  ([script] {:port 8080})
+  ([] {:port 8080})
+  ([arg]
+   (if (re-matches #"\d+" arg)
+     {:port (Integer/parseInt arg)}
+     {:port 8080}))
   ([script port] {:port (Integer/parseInt port)}))
 
 (def options 
@@ -1446,7 +1496,6 @@ WHERE  user_id IN
 (start-user-flusher!)
 (start-session-pruner!)
 
-;(if (not= *server-url* "http://dump.fm")
+;(if (not= *server-url* "/")
 ;  (start! random-poster))
   
-
diff --git a/src/user.clj b/src/user.clj
index 25e1824..a51eddb 100755
--- a/src/user.clj
+++ b/src/user.clj
@@ -61,7 +61,7 @@
   (sha1-hash nick hash ts))
 
 (defn reset-link [nick token ts]
-  (url-params "http://dump.fm/reset" {"nick"  nick
+  (url-params "/reset" {"nick"  nick
                                       "ts"    ts
                                       "token" token}))
 
diff --git a/src/utils.clj b/src/utils.clj
index c0b8b28..57060a6 100755
--- a/src/utils.clj
+++ b/src/utils.clj
@@ -24,11 +24,14 @@
         config
         ))
 
-(let [db-name "dumpfm"
-      db-user (or (System/getenv "DUMP_DBNAME") "postgres")
-      db-pass "root"]
+(let [db-name (or (System/getenv "DUMPFM_DB_NAME") "dumpfm")
+      db-user (or (System/getenv "DUMPFM_DB_USER") "postgres")
+      db-pass (or (System/getenv "DUMPFM_DB_PASSWORD") "")
+      db-port (let [p (System/getenv "DUMPFM_DB_PORT")]
+                (if p (Integer/parseInt p) 5432))]
   (def *db* {:datasource (doto (new PGPoolingDataSource)
                            (.setServerName   db-server)
+                           (.setPortNumber   db-port)
                            (.setDatabaseName db-name)
                            (.setUser         db-user)
                            (.setPassword     db-pass)
@@ -47,8 +50,21 @@
       (throw (Exception. (str "Invalid url " u))))))
 
 (defn get-ip [request]
-  (let [ip (get (:headers request) "x-real-ip")           ; behind nginx
-        ip (if ip ip (:remote-addr request))] (str ip)))  ; deployed locally
+  ;; Prefer reverse-proxy headers, falling back to :remote-addr when running directly.
+  ;; Caddy sets X-Forwarded-For by default.
+  (let [headers (:headers request)
+        x-real  (get headers "x-real-ip")
+        xff     (get headers "x-forwarded-for")
+        xff     (when (and xff (string? xff) (not= "" xff))
+                  (let [ip (.trim (aget (.split xff ",") 0))]
+                    (when-not (= "unknown" (.toLowerCase ip)) ip)))
+        ip      (or x-real xff (:remote-addr request))
+        ip      (if (string? ip) (.trim ip) (str ip))
+        ;; If a proxy includes an IPv4 port suffix, strip it (keep IPv6 intact).
+        ip      (if (and (.contains ip ".") (.contains ip ":"))
+                  (first (.split ip ":"))
+                  ip)]
+    ip))
 
 (defn append [& seqs]
   (reduce into (map vector seqs)))